CTITLEJSVFFK - JOBGEN REGION & BLANK COMMMON FOR PROCESSES VFFK 00010000 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA AUTHOR J. C. SUN 00020000 CA DESIGNER J. C. SUN 00030000 CA LANGUAGE FORTRAN 00040001 CA SYSTEM IBM AND CRAY 00050001 CA WRITTEN 11-05-86 00060000 C REVISED 02-29-88 WRF ALLOCATE CORRECT STORAGE FOR LOCAL 00070000 C AND TRACE USED BY THE DRIVER SDVFFK 00080000 C REVISED 06-15-88 FAC CHANGED LCGRPI FROM INTEGER TO REAL 00090000 C REVISED 08-88-30 JJC ADDED TO GET LINE CARD PARAMETERS. 00100000 C REVISED 11-13-89 RDK FOR CFT77 COMPATIBILITY ON CRAY. 00110000 C REVISED 09-17-90 ESN FORCE INC TO NEAREST MULTIPLT OF LCPI.00120000 C REVISED 10-11-90 ESN CORRECT DEFAULTING OF INC 00130002 CA 00140000 CA 00150000 CA CALL JSVFFK (KPNA, KPRNO, OCCUR, PSIZE, CSIZE, UCSIZE, ERCODE) 00160000 CA 00170000 CA INPUT KPNA = PROCESS NAME A4 00180000 CA INPUT KPRNO = PROCESS NUMBER I4 00190000 CA INPUT OCCUR = OCCURRENCE NUMBER FOR PROCESS KPNA WITH I4 00200000 CA KPRNO 00210000 CA OUTPUT PSIZE = REGION SIZE OF PROGRAM IN -KBYTES I4 00220000 CA OUTPUT CSIZE = RESERVED BLANK COMMON SIZE IN WORDS I4 00230000 CA OUTPUT UCSIZE = UNRESERVED BLANK COMMON SIZE IN WORDS I4 00240000 CA OUTPUT ERCODE = ERROR CODE (=16 IF NOT ABLE TO COMPUTE I4 00250000 CA THE REQUIRED PARAMETERS) 00260000 CA 00270000 CA 00280000 CA COMPUTES THE PROGRAM SIZE (PSIZE) AND AMOUNT OF BLANK COMMON 00290000 CA (CSIZE) NEEDED BY SPARC DEVELOPMENT PROCESS VFFK REQUIRING 00300000 CA SPECIAL CALCULATIONS. 00310000 CA JSVFFK IS AN EXTENSION OF SUBROUTINE JSRND. 00320000 C 00330000 C 00340000 C 00350000 C EJECT 00360000 C 00370000 SUBROUTINE JSVFFK (KPNA, KPRNO, OCCUR, PSIZE, CSIZE, UCSIZE, 00380000 * ERCODE) 00390000 C 00400000 IMPLICIT INTEGER (A-Z) 00410000 C 00420000 C EXTERNAL FOIP 00430000 C 00440000 C SET UP PARAMETER STATEMENT FOR LLOCAL STORAGE 00450000 C 00460000 PARAMETER (LLOCAL = 150) 00470000 C 00480000 CHARACTER*4 KPNA 00490000 CHARACTER*80 CARD 00500000 C 00510000 C 00520000 C REAL CONSTANTS -- LOCAL 00530000 C 00540000 REAL DT,FMAX,FNYQ,AFFR 00550000 C 00560000 C COMMON AREA LINCOM -- VALUES RETRIEVED FROM LINE CARD IN JSRND 00570000 C 00580000 COMMON /LINCOM/ LCTPSP 00590000 COMMON /LINCOM/ LCMXFD 00600000 COMMON /LINCOM/ LCBGSP 00610000 COMMON /LINCOM/ LCENSP 00620000 COMMON /LINCOM/ LCNSP 00630000 COMMON /LINCOM/ LCRLEN 00640000 COMMON /LINCOM/ LCSI 00650000 COMMON /LINCOM/ LCPI 00660000 COMMON /LINCOM/ LCGRPI 00670000 REAL LCGRPI 00680000 COMMON /LINCOM/ LCANSP 00690000 COMMON /LINCOM/ LCMXLN 00700000 COMMON /LINCOM/ NOSAMP 00710000 C 00720000 DATA FCF / 1 / 00730000 DATA IPR / 98 / 00740000 DATA THL / 190 / 00750000 C 00760000 C 00770000 C 00780000 IF (1.EQ.2) CALL FOIP 00790000 C 00800000 C 00810000 C SET STORAGE FOR PROGRAM CODE 00820000 C 00830000 PSIZE = 100 00840000 C 00850000 C 00860000 ICC = 0 00870000 C 00880000 C GET LINE CARD PARAMETERS 00890000 C 00900000 DA = 1 00910000 CALL FORC ('LINE', 0, DA, CARD, * 9200 )00920000 C 00930000 LCTPSP = S1CVBN (CARD, 36, 5) 00940000 LCMXFD = S1CVBN (CARD, 61, 5) 00950000 IF (LCMXFD .EQ. 0) LCMXFD = LCTPSP 00960000 CALL S1MVCH ('LS', 1, PMODE, 1, 2) 00970000 IF (S1CPCH (CARD, 6, ' ', 1, 1) .NE. 0) 00980000 * CALL S1MVCH (CARD, 6, PMODE, 1, 1) 00990000 IF (S1CPCH (CARD, 7, ' ', 1, 1) .NE. 0) 01000000 * CALL S1MVCH (CARD, 7, PMODE, 2, 1) 01010000 C 01020000 LCBGSP = S1CVBN (CARD, 11, 5) 01030000 LCENSP = S1CVBN (CARD, 16, 5) 01040000 LCNSP = S1CVBN (CARD, 31, 5) 01050000 LCRLEN = S1CVBN (CARD, 41, 5) 01060000 LCSI = S1CVBN (CARD, 46, 5) 01070000 LCPI = S1CVBN (CARD, 51, 5) 01080000 C 01090000 IF (LCPI .EQ. 0) LCPI = LCSI 01100000 C 01110000 CALL USCHFT (CARD, 56, 5, LCGRPI) 01120000 01130000 NOSAMP = LCRLEN / LCPI 01140000 NS = NOSAMP 01150000 LCANSP = S1CVBN (CARD, 66, 5) 01160000 LCMXLN = S1CVBN (CARD, 71, 5) 01170000 IF (LCMXLN .EQ. 0) LCMXLN = 1 01180000 C 01190000 C 01200000 DA = 1 01210000 100 CALL FORC(KPNA, KPRNO, DA, CARD, *110) 01220000 IF ( CARD(8:10) .NE. ' ' ) GO TO 100 01230000 C 01240000 C 01250000 C 01260000 INC = S1CVBN(CARD,31,5) 01270000 IF (CARD(31:35) .EQ. ' ') INC = LCPI 01280002 INC = (INC+LCPI/2) / LCPI * LCPI 01290000 ISTART= S1CVBN(CARD,36,5) 01300000 IEND = S1CVBN(CARD,41,5) 01310000 IFHI = S1CVBN(CARD,46,5) 01320000 C 01330000 DT=FLOAT(LCPI)*1.E-3 01340000 NSAMP = NS 01350000 FNYQ=.5/DT 01360000 IF (CARD(36:40) .EQ. ' ') ISTART = 0 01370000 IF (CARD(41:45) .EQ. ' ') IEND = NS*LCPI 01380000 IF (CARD(46:50) .EQ. ' ') IFHI = 0.6*FNYQ + 0.5 01390000 IF (CARD(56:60) .EQ. ' ') NSUM = 1 01400000 IF (NSUM .LE. 1) NSUM = 1 01410000 FMAX=IFHI 01420000 C 01430000 IEND = MIN0(IEND,(NS-1)*LCPI) 01440000 NSEMB = (IEND - ISTART)/INC + 1 01450000 ITTL = NSEMB 01460000 C 01470000 C 01480000 AFFR=AMAX1(0.6,(FMAX/FNYQ)) 01490000 N2W=IFIX(ALOG(FLOAT(NS)*1.17*AFFR)/ALOG(2.))+2 01500000 NW=2**N2W 01510000 C 01520000 WRITE(IPR,6001) NW,NS,LCMXFD,THL,ITTL 01530000 6001 FORMAT(/,' NW =',I10,/, 01540000 + ' NS =',I10,/, 01550000 + ' LCMXFD=',I10,/, 01560000 + ' THL =',I10,/, 01570000 + ' ITTL =',I10) 01580000 C 01590000 C 01600000 C INITIALIZE RESERVED COMMON STORAGE INDEX 01610000 C 01620000 IC = 1 01630000 C 01640000 C ALLOCATE STORAGE FOR LOCAL IN THE DRIVER SDVFFK 01650000 C 01660000 ICC = IC + LLOCAL 01670000 C 01680000 C ALLOCATE STORAGE FOR KPVOLS FOR REEL INFORMATION. THE DRIVER 01690000 C SAVES 513 WORDS FOR THIS WHETHER OR NOT AN OUTPUT PROCESS IN 01700000 C THE CASE OF SPARC SHELL DRIVER 01710000 C 01720000 ICC = ICC + 513 01730000 C 01740000 C ALLOCATE STORAGE FOR THE SHELL DRIVER TO STORE INPUT TRACE 01750000 C 01760000 ICC = ICC + THL + NS 01770000 C 01780000 C ALLOCATE STORAGE FOR AN INTERPOLATED VELOCITY TRACE FOR THE 01790000 C SHELL DRIVER WHETHER 'VEL' CARDS ARE NEEDED OR NOT 01800000 C 01810000 ICC = ICC + NS + 1 01820000 C 01830000 CWRF IWORK = 1 01840000 IWORK = ICC + 1 01850000 IOUT = IWORK + NS 01860000 IHOLD = IOUT + NS 01870000 IAVE = IHOLD + ITTL*LCMXFD 01880000 K1 = IAVE + NS 01890000 IVEL = K1 + 2*NW 01900000 ICC = IVEL+LCMXFD 01910000 WRITE(IPR,6002) IWORK,IOUT, 01920000 + IHOLD,IAVE,K1,IVEL,ICC 01930000 6002 FORMAT(/,' IWORK =',I10,/, 01940000 + ' IOUT =',I10,/, 01950000 + ' IHOLD =',I10,/, 01960000 + ' IAVE =',I10,/, 01970000 + ' K1 =',I10,/, 01980000 + ' IVEL =',I10,/, 01990000 + ' ICC =',I10) 02000000 110 CONTINUE 02010000 IF(ICC.EQ.0) GO TO 9100 02020000 C 02030000 C ADD FIVE WORDS SINCE THE SHELL DRIVER WHICH ROUNDS UP TO THE 02040000 C NEXT COMPLEX DOUBLE WORD BOUNDARY 02050000 C 02060000 CSIZE = ICC + 5 02070000 C 02080000 C 02090000 C 02100000 C 02110000 C PART 3. COMPUTE UNRESERVED BLANK COMMON SIZE IN WORDS (UCSIZE) 02120000 C 02130000 C THIS VALUE IS THE TOTAL NUMBER OF WORDS USED IN UNRESERVED BLANK 02140000 C COMMON I.E. SCRATCH AREA OR 'SA' FOR SPARC 'SHELLS'. 02150000 C 02160000 UCSIZE = 0 02170000 C 02180000 C 02190000 C 02200000 C 02210000 C 02220000 WRITE(IPR,9000) PSIZE,CSIZE,UCSIZE 02230000 9000 FORMAT(/5X,'JSVFFK COMPLETED PSIZE = ',I5,' CSIZE = ',I10, 02240000 + ' UCSIZE = ',I5) 02250000 GO TO 9500 02260000 C 02270000 C 02280000 C 02290000 9100 ERCODE = 16 02300000 WRITE(IPR,9900) 02310000 GO TO 9500 02320000 C 02330000 9200 WRITE( IPR, 9910 ) 02340000 ERCODE = 16 02350000 C 02360000 9500 RETURN 02370000 C 02380000 C ERROR MESSAGES 02390000 C 02400000 9900 FORMAT (/' *** FROM JSVFFK ERROR IN CORE CALCULATION') 02410000 C 02420000 9910 FORMAT(2(/1X,130('*'))/' *****',120X,'*****'/ 02430000 * ' *****',45X,'FATAL ERROR: MISSING LINE CARD',45X, 02440000 * '*****'/' *****',120X,'*****',2(/1X,130('*'))) 02450000 C 02460000 C 02470000 END 02480000