CTITLEJSREFF -- STORAGE ALLOCATION CALCULATIONS FOR REFF 00010000 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA AUTHOR DANIEL POLAK 00020000 CA DESIGNER DANIEL POLAK 00030000 CA LANGUAGE VS FORTRAN (77) 00040000 CA SYSTEM IBM AND CRAY 00050000 CA WRITTEN 09-26-85 00060000 C REVISED 06-11-87 DPH. CONVERT TO CRAY 00070000 C REVISED 06-24-88 TJT. MADE LCGRPI FLOATING PT. CHANGE PERMANENT 00071000 CA 00072000 CA 00073000 CA CALL JSREFF (KPNA, KPRNO, IPR, THL, LCNSP, LCTPSP, LCPI, LCGRPI, 00074000 CA URBYTE, URKBYT, PSIZE, CSIZE, IERR) 00075000 CA 00076000 CA IN/OUT ARGUMENT TYPE DESCRIPTION 00077000 CA 00078000 CA IN KPNA I4 PROCESS NAME 00079000 CA IN KPRNO I4 PROCESS OCCURANCE NUMBER 00080000 CA IN IPR I4 PRINT UNIT NUMBER 00090000 CA IN THL I4 TRACE HEADER LENGTH 00100000 CA IN LCNSP I4 LINE CARD NUMBER OF SHOTPOINTS 00110000 CA IN LCTPSP I4 LINE CARD TRACES PER SHOT 00120000 CA IN LCPI I4 LINE CARD PROCESSING SAMPLE INTERVAL 00130000 CA IN LCGRPI R4 LINE CARD GROUP INTERVAL 00140000 CA IN/OUT URBYTE I4 UNRESERVED COMMON REQUIREMENT IN BYTES 00150000 CA IN/OUT URKBYT I4 UNRESERVED COMMON REQUIREMENT IN K-BYTES 00160000 CA OUT PSIZE I4 PROGRAM SIZE (K-BYTES) 00170000 CA OUT CSIZE I4 SIZE OF RESERVED BLANK COMMON 00180000 CA REQUIRED (K-BYTES) 00190000 CA OUT IERR I4 ERROR FLAG 00200000 CA 0 FOR NO ERROR 00210000 CA 1 FOR ERROR 00220000 CA 00230000 C ===================================================================== 00240000 C 00250000 SUBROUTINE JSREFF (KPNA, KPRNO, IPR, THL, LCNSP, LCTPSP, LCPI, 00260000 * LCGRPI, URBYTE, URKBYT, PSIZE, CSIZE, IERR) 00270000 C 00280000 IMPLICIT INTEGER (A-Z) 00290000 C 00300000 REAL LCGRPI 00300100 C 00301000 PARAMETER (FLEN=301, MXHOR=15, NFPPH=5) 00310000 C 00320000 C INTEGER ARRAY -- LOCAL 00330000 C 00340000 INTEGER ICOM (8000) 00350000 C 00360000 C CHARACTER VARIABLES 00370000 C 00380000 CHARACTER*80 CARD 00390000 CHARACTER*2 DIST 00400000 C 00410000 C READ DATA CARD(1) 00420000 C 00430000 IF (0 .EQ. 1) CALL GETMN2 00440000 NXX = 0 00450000 NCARD = 1 00460000 C 00470000 10 CALL FORC (KPNA, KPRNO, NCARD, CARD, * 8000 )00480000 IF (CARD(8:10) .NE. ' ') GO TO 10 00490000 TOPHRZ = S1CVBN (CARD, 21, 5) 00500000 BEGHRZ = S1CVBN (CARD, 26, 5) 00510000 ENDHRZ = S1CVBN (CARD, 31, 5) 00520000 IF (ENDHRZ .EQ. 0) ENDHRZ = BEGHRZ 00530000 NLAYER = ENDHRZ - BEGHRZ + 1 00540000 NHORZN = ENDHRZ - TOPHRZ + 1 00550000 C 00560000 C GET THE MODE OF OPERATION 00570000 C 00580000 IF (CARD(36:40) .EQ. 'DATAT' .OR. 00590000 * CARD(36:40) .EQ. ' ') THEN 00600000 OPMODE = -2 00610000 ELSE IF (CARD(36:40) .EQ. 'DATAG') THEN 00620000 OPMODE = -1 00630000 ELSE IF (CARD(36:40) .EQ. ' GEOM') THEN 00640000 OPMODE = 1 00650000 ELSE IF (CARD(36:40) .EQ. ' TIME') THEN 00660000 OPMODE = 2 00670000 ELSE IF (CARD(36:40) .EQ. ' DATA') THEN 00680000 OPMODE = 3 00690000 ELSE IF (CARD(36:40) .EQ. ' ALL') THEN 00700000 OPMODE = -3 00710000 ELSE 00720000 OPMODE = -2 00730000 END IF 00740000 C 00750000 C GET THE DIFFRACTIONS FLAG 00760000 C 00770000 IF (CARD(51:55) .EQ. 'NODIF' .OR. 00780000 * CARD(51:55) .EQ. ' ') THEN 00790000 IDIFF = 1 00800000 ELSE IF (CARD(51:55) .EQ. ' DIFF') THEN 00810000 IDIFF = 2 00820000 ELSE 00830000 IDIFF = 1 00840000 END IF 00850000 C 00860000 C GET THE GLOBAL FILE DATASET NUMBER 00870000 C 00880000 GLDSN = S1CVBN (CARD, 56, 10) 00890000 C 00900000 C GET THE DEPTH MODEL FLAG 00910000 C 00920000 IF (CARD(76:80) .EQ. ' MLRS' .OR. 00930000 * CARD(76:80) .EQ. ' ') THEN 00940000 MODFLG = 1 00950000 ELSE IF (CARD(76:80) .EQ. ' USER') THEN 00960000 MODFLG = 2 00970000 ELSE 00980000 MODFLG = 1 00990000 END IF 01000000 C 01010000 C READ THE 'WAV' DATA CARD 01020000 C 01030000 LW = 0 01040000 NW = 0 01050000 C 01060000 IF (OPMODE .EQ. 3 .OR. OPMODE .LT. 0) THEN 01070000 NCARD = 1 01080000 C 01090000 20 CALL FORC (KPNA, KPRNO, NCARD, CARD, * 30 )01100000 IF (CARD(8:10) .NE. 'WAV') GO TO 20 01110000 LW = S1CVBN (CARD, 26, 5) 01120000 NW = S1CVBN (CARD, 31, 5) 01130000 C 01140000 30 IF (LW .EQ. 0) LW = 100 01150000 IF (NW .EQ. 0) NW = 10 01160000 LW = LW / LCPI 01170000 END IF 01180000 C 01190000 C READ THE 'MOD' DATA CARD 01200000 C 01210000 IF (OPMODE .NE. 1) THEN 01220000 NCARD = 1 01230000 IDX = 0 01240000 C 01250000 40 CALL FORC (KPNA, KPRNO, NCARD, CARD, * 50 )01260000 IF (CARD(8:10) .NE. 'MOD') GO TO 40 01270000 IDX = S1CVBN (CARD, 36, 5) 01280000 END IF 01290000 C 01300000 50 IF (IDX .EQ. 0) IDX = 70 01310000 IF (IDX .LT. 0) IDX = -1 * IDX 01320000 C 01330000 C COUNT THE NUMBER OF 'FLT'DATA CARDS 01340000 C 01350000 NHFILT = 0 01360000 C 01370000 IF (GLDSN .NE. 0 .OR. MODFLG .EQ. 1) THEN 01380000 NCARD = 1 01390000 C 01400000 60 CALL FORC (KPNA, KPRNO, NCARD, CARD, * 70 )01410000 IF (CARD(8:10) .NE. 'FLT') GO TO 60 01420000 NHFILT = NHFILT + 1 01430000 GO TO 60 01440000 END IF 01450000 C 01460000 C READ THE FIRST RECORD OF THE GLOBAL FILE FOR SOME SIZE INFORMATION01470000 C 01480000 70 IF (GLDSN .GT. 0) THEN 01490000 C 01500000 C GET THE DISTRICT NUMBER FROM THE ACCT CARD 01510000 C 01520000 NCARD = 1 01530000 CALL FORC ('ACCT', 0, NCARD, CARD, * 8010 )01540000 DIST = CARD(14:15) 01550000 CALL JSTXGL (KPNA, KPRNO, GLDSN, DIST, IPR, IER, ICOM) 01560000 C 01570000 IF (IER .EQ. -1) GO TO 8020 01580000 NXX = ICOM(41) 01590000 END IF 01600000 C 01610000 C COMPUTE THE RESERVED COMMON STORAGE REQUIREMENT 01620000 C 01630000 NGPS = 2 * (LCNSP + LCTPSP) 01640000 NCDP = NGPS 01650000 NTRCE = LCNSP * LCTPSP 01660000 C 01670000 NOWDS = 4 * NTRCE * NHORZN + 2 * NW * LW + NXX + FLEN + 200 + 01680000 * NHFILT * NFPPH 01690000 CSIZE = (4 * NOWDS + 1023) / 1024 01700000 C 01710000 C COMPUTE THE UNRESERVED COMMON STORAGE REQUIREMENT 01720000 C 01730000 SPREAD = (LCTPSP + 10) * 100 01740000 NRAY = (SPREAD / IDX) * IDIFF 01750000 LFOUR = 0 01760000 I1 = 0 01770000 I2 = 0 01780000 I3 = 0 01790000 I4 = 0 01800000 IF (OPMODE .LT. 0 .OR. OPMODE .EQ. 3) 01810000 * CALL S1FMAG (NW*LW, MAG, LFOUR) 01820000 C 01830000 COM = NGPS * LCNSP / 2 + LCTPSP * LCNSP / 2 + NCDP * LCNSP / 2 + 01840000 * 5 * LCNSP + 3 * NGPS + 2 * NCDP + 6 * LCTPSP + 4 * NRAY + 01850000 * LCTPSP * MXHOR + 2 * LFOUR 01860000 C 01870000 I1 = 2 * (LCNSP + NGPS) 01880000 C 01890000 IF (GLDSN .GT. 0) THEN 01900000 I2 = 2 * (NXX * NHORZN + MAX0(NXX, FLEN)) 01910000 ELSE IF (MODFLG .EQ. 1) THEN 01920000 NGRID = 2 * NGPS 01930000 I3 = 3 * FLEN + NGRID * (2 * NHORZN + 2) 01940000 ELSE IF (GLDSN .LE. 0 .AND. MODFLG .EQ. 2) THEN 01950000 I4 = 3 * (LCNSP + NGPS) 01960000 END IF 01970000 C 01980000 COM = COM + MAX0 (I1, I2, I3, I4) 01990000 COM = ((4 * COM + 1023) / 1024) * 1024 02000000 IF (COM .LE. URBYTE) COM = 0 02010000 C 02020000 IF (COM .NE. 0) THEN 02030000 SVCOM = COM 02040000 COM = COM - URBYTE 02050000 COM = (COM + 1023) / 1024 02060000 URBYTE = SVCOM 02070000 URKBYT = URBYTE / 1024 02080000 END IF 02090000 C 02100000 CSIZE = CSIZE + COM 02110000 PSIZE = 100 02120000 IERR = 0 02130000 RETURN 02140000 C 02150000 C ERROR EXIT 02160000 C 02170000 8000 WRITE (IPR, 9000) KPNA, KPRNO 02180000 GO TO 8020 02190000 C 02200000 8010 WRITE (IPR, 9010) KPNA, KPRNO 02210000 GO TO 8020 02220000 C 02230000 8020 IERR = 1 02240000 RETURN 02250000 C 02260000 C FORMAT STATEMENTS 02270000 C 02280000 9000 FORMAT (/5X,'*** JSREFF*** NO DATA CARD(1) FOUND FOR ',A4,I1) 02290000 C 02300000 9010 FORMAT (/5X,'*** JSREFF*** NO ACCT CARD FOUND FOR PROC = ',A4,I1) 02310000 END 02320000