CTITLEJSCOR3 -- REGION AND BLANK COMMMON ALGORITHM 00010000 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA AUTHOR S. SVATEK 00020000 CA DESIGNER R. MCMILLAN 00030000 CA LANGUAGE FORTRAN 00040000 CA SYSTEM IBM AND CRAY 00050000 CA WRITTEN 12-23-82 00060000 C REVISED 12-23-82 SAS. ADDED PROCESS ENTRY FOR GEOM. 00070000 C ALSO MOVED R&D CATCH-ALL ENTRY (RNDX 00080000 C THRU CDPX) FROM JSCORE. 00090000 C REVISED 02-02-83 NTS. ADDED ENTRY FOR PROCESS RANL. 00100000 C REVISED 03-15-83 RDK. ADDED ENTRIES FOR ZMPS AND ACHK. 00110000 C REVISED 03-21-83 REM. GET LCANSP FROM LINE CARD AND DELETE 00120000 C READING OF ACCT CARD. 00130000 C REVISED 04-04-83 RDK. ENTRIES FOR TXGL AND VZ3D ADDED BY DJP.00140000 C ADDED ENTRY FOR NEW PROCESS TINT. 00150000 C REVISED 04-25-83 RDK. CHANGE ZMPS TO DECODE SHOT SPACING FROM00160000 C CARD COLS 56-60. 00170000 C REVISED 06-23-83 RDK. ADDED NEW SPARC SHELL SERIES 'OIL' AND 00180000 C 'GAS' FOR WPB; ADDED ENTRY FOR PROCESS 00190000 C D3NT. 00200000 C REVISED 07-11-83 PKC. ADDED ENTRY FOR VF3D. 00210000 C REVISED 08-08-83 PKC. CORRECTED VF3D ENTRY. 00220000 C REVISED 08-11-83 RDK. ADDED GDPH,GDPI. 00230000 C REVISED 08-22-83 PKC. UPPED VF3D PSIZE AND CORRECTED MXVALS. 00240000 C REVISED 09-06-83 PKC. CHANGED VF3D CALC.S FOR DP/LINE RANGES.00250000 C REVISED 10-17-83 NTS. ADD ENTRY FOR SPEW.(SPECTRAL WHITENING)00260000 C REVISED 11-01-83 PKC. ADDED ENTRY FOR DG3D. UPPED PSIZE OF 00270000 C GEOM AND VF3D. 00280000 C REVISED 12-14-83 RDK. ADDED ENTRIES FOR REJH, VSPF, DATM, 00290000 C VSPG, ALGN. 00300000 C REVISED 12-29-83 CMP. ADDED ENTRY FOR GDSP. 00310000 C REVISED 01-10-84 ESN. ADDED ENTRY FOR TSLC. 00320000 C REVISED 01-27-84 PKC. ADJUSTED GEOM FOR NEW COMMON. 00330000 C REVISED 02-28-84 PKC. ADJUSTED VF3D FOR NEW PERMANENT FILE. 00340000 C REVISED 03-01-84 PKC. ADJUSTED VF3D FOR IOC CARDS. 00350000 C REVISED 03-09-84 RDK. ADDED ENTRY FOR OPAP. 00360000 C REVISED 04-03-84 CMP. UPPED PSIZE FOR GDSP. 00370000 C REVISED 04-23-84 RDK. ADDED ENTRIES FOR SCDA,SCDC,VSPH,LWST, 00380000 C TXDP,REFM. CORRECTED 'URKBYT' CALCU- 00390000 C LATION IN RANL,TINT,D3NT. CORRECTED 00400000 C 'COM' AND 'URKBYT' CALC. IN SPEW. 00410000 C INSERT NEW CODE FOR 'TXGL'. 00420000 C REVISED 05-03-84 CMP. CORRECTED VF3D ENTRY. 00430000 C REVISED 05-03-84 RDK. EQUIVALENCE XCOM TO COM FOR REFM,ETC. 00440000 C REVISED 05-07-84 RDK. REVISE OPAP FOR NEW PROGRAM CHANGES. 00450000 C INCREASE CSIZE FOR SCDA. 00460000 C GET DISTRICT NO. FROM ACCT CARD TO 00470000 C INITIATE DSN SEARCH IN JSTXGL. 00480000 C REVISED 06-14-84 PKC ADDED NINA AND REWROTE GEOM. 00490000 C REVISED 06-19-84 RDK ADDED 'PRC' AND 'PAT' R&D SPARC SHELL 00500000 C SERIES FOR RCD. 00510000 C REVISED 07-24-84 RKG ADDED ENTRY FOR GM3D AND STAT. 00520000 C REVISED 07-25-84 RKG CORRECTED ERROR WITH GM3D COMPUTATION. 00530000 C REVISED 07-27-84 RKG CORRECTED ERROR THAT CAUSED RECEIVER 00540000 C BUFFERS TO BE TOO SMALL. 00550000 C REVISED 08-06-84 RKG ADDED ERROR MESSAGE WHEN SUBROUTINE 00560000 C IS CALLED FOR PROCESS STAT WITHOUT 00570000 C GM3D HAVING BEEN CALLED PREVIOUSLY. 00580000 C CORRECTED PROBLEM WITH CALCULATIONS 00590000 C RECEIVER ADVANCE WAS 0. 00600000 C REVISED 08-06-84 RDK REPLACE ALL OCCURRENCES OF '96' FOR 00610000 C TRACE HEADER LENGTH WITH 'PTTHL'. 00620000 C ALSO ADD ENTRY FOR 'CNAY'. 00630000 C REVISED 08-20-84 RKG CORRECTED ERROR WITH SHOTPOINT ADVANCE.00640000 C REVISED 08-27-84 RDK INITIALIZE PTTHL TO 190. 00650000 C REVISED 09-14-84 CMP REMOVE R&D PROCESSES TO JSCOR4 AND 00660000 C ADD CALL TO JSCOR4 IF PROCESS MISSING. 00670000 C REVISED 10-02-84 PKC MODIFIED NINA AND GEOM FOR PRODUCTION. 00680000 C REVISED 10-29-84 PKC MODIFIED VF3D FOR RANGES ON INPUT. 00690000 C REVISED 12-17-84 PKC UPPED VF3D PSIZE FOR UNIRAS 84.2. 00700000 C REVISED 04-30-85 DWD MODIFIED DG3D FOR BLOCKING. 00710000 C REVISED 06-28-85 CBB MODIFIED NX AND XLEN CALCULATIONS 00720000 C IN TXGL TO INCLUDE NGAP. 00730000 C REVISED 06-28-85 RKG ADDED REVISION OF CBB (6/28) TO 00740000 C PRODUCTION VERSION OF JSCOR3, ADDED 00750000 C NAMES FOR TXGF, LWSA, AND REFS. 00760000 C INCREASE MNRVI FOR 3-D GEOMETRY. 00770000 C REVISED 07-10-85 MJM CHANGED MAXCRK ALLOCATION IN GM3D. 00780000 C REVISED 07-10-85 DCB MODIFIED CALCULATION OF UNRESERVED 00790000 C REVISED 07-16-85 RKG ADDED CHANGES FROM CBB FOR TXDP. 00800000 C ADDED ALIAS OF TXMP (BRANCHES TO SAME 00810000 C CODE AS TXDP). 00820000 C REVISED 08-20-85 LBL REWRIT ENTRY FOR CNAY. 00830000 C REVISED 08-20-85 PKC CHANGED GEOM AND NINA FOR PACKING CODE.00840000 C REVISED 10-10-85 RKG ADDED RFST. 00850000 C REVISED 11-18-85 MJM CHANGED LCIT CALCULATION FOR SPEW. 00860000 C REVISED 01-09-86 ESN INCREASE PSIZE FOR OPAP FROM 30K TO 60K00870000 C REVISED 01-15-86 PKC INCREASE PSIZE FOR NINA. 00880000 C REVISED 03-03-86 JBC MODIFIED TO TAKE ABSOLUTE VALUE OF 00890000 C XMAX-XMIN FOR TXMP. 00900000 C REVISED 03-04-86 JBC INCREASE CSIZE FOR RFST. 00910000 C REVISED 09-10-86 REM. ADD RSIZE TO PARAMETER LIST. 00920000 C REVISED 09-12-86 DJP. CHANGED CNAY FOR 2-MODE FILTERING 00930000 C REVISED 09-12-86 REM. INCREASE PSIZE FOR SPEW. 00940000 C REVISED 09-16-86 RDK. REVISE PSIZE, CSIZE FOR GDPI. 00950000 C REVISED 10-27-86 PKC. ADD RSIZE TO VF3D. 00960000 C REVISED 01-20-87 CMP. INCREASE PSIZE FOR GM3D. 00970000 C REVISED 01-20-87 PKC. INCREASE PSIZE/RSIZE FOR VF3D (5.3). 00980000 C REVISED 04-13-87 REM. DELETE ENTRY FOR RANL AND TINT. 00990000 C REVISED 05-13-87 RDK. REVISIONS TO CNAY FOR NEW RELEASE. 01000000 C REVISED 06-05-87 DPH. MODIFY DATA STATEMENTS TO RUN ON CRAY, 01010000 C CHANGE C*4 DECLARATIONS TO INTEGER, 01020000 C AND REPLACE VARIABLE SUFFIX $ WITH Z. 01030000 C REVISED 03-11-88 TJT. ADD MEMORY TABLE ARRAY IN GEOM IF 01040000 C BORROWING OPTION. 01050000 C INCREASE SPACE IN NINA FOR DATA BLOCK 01060000 C USED IN SELECT OPTION. 01070000 C REVISED 04-28-88 TJT. MADE LCGRPI FLOATING POINT. 01080000 C REVISED 05-04-88 TJT. ADD MEMORY CALC. FOR COUPLING IN GEOM 01090000 C AND BLKSIZE CHANGES FOR NINA. 01100000 C REVISED 06-02-88 TJT. CHANGED GM3D FUDGE FACTOR TO BE CALC- 01110000 C ULATED AS NEEDED NOT CONSTANT 451,4451.01120000 C REVISED 06-15-88 LWC. CORRECT A FLOATING POINT ROUND OFF 01130000 C PROBLEM THAT MADE RCMAX A DIFFERENT 01140000 C VALUE ON THE CRAY THAN ON THE IBM. 01150000 C REVISED 11-10-88 TJT. ADD WRIT MEMORY REQUIREMENTS. 01160000 C REVISED 11-16-88 TJT. MODIFY WRIT MEMORY REQUIREMENTS. 01170000 C REVISED 11-17-88 TJT. ADD MEMORY REQUIREMENTS FOR LA3D. 01180000 C REVISED 11-23-88 TJT. INCREASE MEMORY REQUIREMENTS FOR GDSP. 01190000 C REVISED 01-16-89 TJT. INCREASE MEMORY REQUIREMENTS FOR LA3D 01200000 C IN USING AREAL PILOT. 01210000 C REVISED 01-20-89 TJT. CHANGE MEMORY REQUIREMENTS FOR SPGEOM. 01220000 C REVISED 01-24-89 TJT. CHANGE MEMORY REQUIREMENTS FOR SPGM3D. 01230000 C REVISED 02-10-89 TJT. GEOM-INCR. NO. OF LINES = 400 TO 1500. 01240000 C REVISED 02-10-89 TJT. GDSP-FIX MEMORY CALC. FOR 3-D LINES. 01250000 C REVISED 02-24-89 TJT. GM3D-ADD SPELEV ARRAY. 01260000 C REVISED 05-03-89 LWC. ADD SPACE TO CNAY BECAUSE OF TAPER. 01270000 C ADD SPACE TO GM3D. 01280000 C REVISED 07-11-89 ESN. ADDED RESOLUTION ENHANCEMENT 01290000 C CAPABILITY TO VF3D. 01300000 C REVISED 08-29-89 TJT. INCREASE MEMORY REQUIREMENTS FOR LA3D 01310000 C IN USING AREAL PILOT. 01320000 C INCREASE MEMORY REQUIREMENTS FOR GDSP 01330000 C IN USING SHOTPT/LINENAME XREF TABLE. 01340000 C REVISED 09-26-89 LWC. ADD SOME MORE SPACE FOR CNAY. 01350000 C REVISED 10-06-89 LWC. ADD SOME MORE SPACE FOR SPEW. 01360000 C REVISED 11-13-89 RDK. FOR CFT77 COMPATIBILITY ON THE CRAY. 01370000 C REVISED 11-30-89 ESN. ADD WT3D. 01380000 C REVISED 12-11-89 TJT. INCREASE MEMORY REQUIREMENTS FOR GDSP. 01390000 C REVISED 01-02-90 TJT. INCREASE MEMORY REQUIREMENTS FOR LA3D. 01400000 C REVISED 06-20-90 ESN. CORRECT LA3D ENTRY TO DEFAULT NUMBER 01410000 C OF FILTER POINTS IF NOT SUPPLIED. 01420000 C REVISED 10-03-90 CLJ LA3D, CORRECT NUMBER OF FILTER POINTS 01430000 C WHEN COMPUTED FROM LOW PASS AND HIGH 01440000 C PASS FREQUENCY VALUES 01450000 C REVISED 01-17-91 CLJ LA3D, INCREASE SIZE FOR EXTERNAL PILOT,01460000 C SECONDARY PEAK, AND OFFSET RANGES 01470000 C REVISED 03-01-92 JJC ADDED ENTRY FOR NEW PROCESSES FXIN & 01480000 C EQMO. 01490000 C REVISED 03-12-92 ESN CORRECT ENTRIES FOR WRIT AND SPEW. 01500000 C REVISED 03-27-92 ESN CORRECT GEOM ENTRY FOR BINNING. 01510000 CA 01520000 CA 01530000 CA CALL JSCOR3 (KPNA, KPRNO, OCCUR, BLKSIZ, PSIZE, CSIZE, RSIZE, 01540000 CA ERCODE, URBYTE, URKBYT) 01550000 CA 01560000 CA INPUT KPNA = PROCESS NAME A4 01570000 CA INPUT KPRNO = PROCESS NUMBER I4 01580000 CA INPUT OCCUR = OCCURRENCE NUMBER FOR PROCESS KPNA WITH I4 01590000 CA KPRNO 01600000 CA INPUT BLKSIZ= BLOCK SIZE (BYTES) I4 01610000 CA OUTPUT PSIZE = REGION SIZE OF PROGRAM IN K-BYTES I4 01620000 CA OUTPUT CSIZE = BLANK COMMON SIZE IN K-BYTES I4 01630000 CA OUTPUT RSIZE = EXTRA REGION SIZE IN K-BYTES I4 01640000 CA OUTPUT ERCODE= ERROR CODE (=16 IF NOT ABLE TO COMPUTE I4 01650000 CA THE REQUIRED PARAMETERS) 01660000 CA IN/OUT URBYTE= DYNAMICALLY REVISED UNRESERVED COMMON 01670000 CA REQUIRED BY INDIVIDUAL PROCESSES (BYTES) 01680000 CA IN/OUT URKBYT= DYNAMICALLY REVISED UNRESERVED COMMON 01690000 CA REQUIRED BY INDIVIDUAL PROCESSES(K-BYTES) 01700000 CA 01710000 CA 01720000 CA COMPUTES THE PROGRAM SIZE AND AMOUNT OF BLANK COMMON NEEDED FOR 01730000 CA PROCESSES REQUIRING SPECIAL CALCULATIONS. JSCOR3 IS AN EXTEN- 01740000 CA SION OF SUBROUTINE JSCOR2, WHICH CANNOT BE ENLARGED UNDER FORTH 01750000 CA (12-23-82). 01760000 C 01770000 C 01780000 C INTEGER ARRAYS -- LOCAL 01790000 C 01800000 C CARD(20) = DATA CARD ARRAY 01810000 C PROC(40) = PROCESS NAMES 01820000 C 01830000 C EJECT 01840000 C 01850000 SUBROUTINE JSCOR3 (KPNA, KPRNO, OCCUR, BLKSIZ, PSIZE, CSIZE, 01860000 * RSIZE, ERCODE, URBYTE, URKBYT) 01870000 C 01880000 IMPLICIT INTEGER (A-Z) 01890000 C 01900000 C INTEGER ARRAYS -- LOCAL 01910000 C 01920000 INTEGER PROC (40) 01930000 INTEGER KPNA 01940000 C 01950000 INTEGER CARD (20) 01960000 CHARACTER*80 CARD1 01970000 INTEGER BLNKC(20) 01980000 INTEGER PFLAGS ( 7) 01990000 C 02000000 DIMENSION ICOM (8000) 02010000 C 02020000 C INTEGER CONSTANTS -- LOCAL 02030000 C 02040000 INTEGER FCF 02050000 INTEGER IPR 02060000 INTEGER MAXSPS 02070000 INTEGER PTTHL 02080000 C 02090000 INTEGER TRUE 02100000 INTEGER FALSE 02110000 INTEGER SEMB 02120000 INTEGER MODL 02130000 INTEGER T0QC 02140000 INTEGER RC 02150000 INTEGER REFL 02160000 INTEGER EMER 02170000 INTEGER ONEW 02180000 INTEGER TWOW 02190000 C 02200000 CHARACTER*5 BLANKF 02210000 CHARACTER*4 GMODE 02220000 C 02230000 C 02240000 C 02250000 C REAL VARIABLES -- LOCAL 02260000 C 02270000 REAL DPSCLE 02280000 REAL DX 02290000 REAL FLO 02300000 REAL FHI 02310000 C--CONVERT LCGRPI TO FLOATING POINT 02320000 REAL LCGRPI 02330000 REAL VSCLE 02340000 REAL XLEN 02350000 REAL XMAX 02360000 REAL XMIN 02370000 REAL XPLEN 02380000 REAL XSCLE 02390000 REAL YLEN 02400000 REAL TSCLE 02410000 REAL ZZTEMP 02420000 REAL ZMAX 02430000 REAL ZMIN 02440000 REAL ZSCLE 02450000 REAL XLN 02460000 REAL YLN 02470000 REAL XSCL 02480000 REAL YSCL 02490000 CKG 02500000 REAL CDFI 02510000 REAL CDFII 02520000 REAL LINT 02530000 REAL RVINT 02540000 REAL RVINC 02550000 REAL RVADV 02560000 REAL SPADV 02570000 REAL RVADVZ 02580000 REAL SPADVZ 02590000 REAL CDFPRV 02600000 C 02610000 C REAL ARRAYS--LOCAL 02620000 C 02630000 REAL XCOM (8000) 02640000 EQUIVALENCE ( XCOM(1), ICOM(1) ) 02650000 C 02660000 C REAL FUNCTION 02670000 C 02680000 REAL FLOAT 02690000 REAL FNTNT 02700000 REAL FSR 02710000 C 02720000 C 02730000 INTEGER BLANK 02740000 C 02750000 DATA PROC /'GEOM','WRIT','ZMPS','ACHK','TXGL', 02760000 * 'VZ3D','LA3D','D3NT','VF3D','GDPH', 02770000 * 'GDPI','SPEW','DG3D','REJH','VSPF', 02780000 * 'DATM','VSPG','ALGN','GDSP','TSLC', 02790000 * 'OPAP','SCDA','SCDC','VSPH','LWST', 02800000 * 'TXDP','REFM','NINA','GM3D','STAT', 02810000 * 'CNAY','TXGF','LWSA','REFS','TXMP', 02820000 * 'RFST','WT3D','FXIN','EQMO',' ' / 02830000 C 02840000 DATA PFLAGS /7*0/ 02850000 DATA FCF /1/ 02860000 DATA IPR /6/ 02870000 DATA MAXSPS /0/ 02880000 C TRACE HEADER LENGTH FOR CRAY IS ONLY 02890000 C 95 WORDS, BUT WE LEAVE PTTHL AT 190 FOR 02900000 C COMPATIBILITY WITH IBM - DPH 6/10/87. 02910000 DATA PTTHL /190/ 02920000 DATA TRUE / 1 / 02930000 DATA FALSE / 0 / 02940000 DATA SEMB / 1 / 02950000 DATA MODL / 2 / 02960000 DATA T0QC / 3 / 02970000 DATA RC / 4 / 02980000 DATA REFL / 4 / 02990000 DATA EMER / 5 / 03000000 DATA ONEW / 6 / 03010000 DATA TWOW / 7 / 03020000 C 03030000 DATA BLANK / ' ' / 03040000 C 03050000 DATA BLANKF/ ' ' / 03060000 C 03070000 C 03080000 CKG******************************************************************** 03090000 C WRITE(6,99001) KPNA 03100000 99001 FORMAT(1X,' JUST ENTERED JSCOR3M NAME = ',A4) 03110000 CKG******************************************************************** 03120000 C 03130000 C 03140000 C 03150000 C 03160000 ERCODE = 0 03170000 IF (FCF .EQ. 0) GO TO 5 03180000 FCF = 0 03190000 C 03200000 C GET ACCT CARD DIST CODE 03210000 C 03220000 DA = 1 03230000 CALL FORC ('ACCT', 0, DA, CARD, * 8000 )03240000 CALL S1MVCH (CARD, 14, DIST, 3, 2) 03250000 C 03260000 C GET LINE CARD PARAMETERS 03270000 C 03280000 DA = 1 03290000 CALL FORC ('LINE', 0, DA, CARD, * 8000 )03300000 C 03310000 LCTPSP = S1CVBN (CARD, 36, 5) 03320000 LCMXFD = S1CVBN (CARD, 61, 5) 03330000 IF (LCMXFD .EQ. 0) LCMXFD = LCTPSP 03340000 CALL S1MVCH ('LS', 1, PMODE, 1, 2) 03350000 IF (S1CPCH (CARD, 6, ' ', 1, 1) .NE. 0) 03360000 * CALL S1MVCH (CARD, 6, PMODE, 1, 1) 03370000 IF (S1CPCH (CARD, 7, ' ', 1, 1) .NE. 0) 03380000 * CALL S1MVCH (CARD, 7, PMODE, 2, 1) 03390000 C 03400000 LCBGSP = S1CVBN (CARD, 11, 5) 03410000 LCENSP = S1CVBN (CARD, 16, 5) 03420000 LCNSP = S1CVBN (CARD, 31, 5) 03430000 RLENG = S1CVBN (CARD, 41, 5) 03440000 LCSI = S1CVBN (CARD, 46, 5) 03450000 LCPI = S1CVBN (CARD, 51, 5) 03460000 C--CONVERT LCGRPI TO FLOATING POINT 03470000 CC LCGRPI = S1CVBN (CARD, 56, 5) 03480000 CALL USCHFT (CARD, 56, 5, LCGRPI) 03490000 IF (LCPI .EQ. 0) GO TO 9800 03500000 NOSAMP = RLENG / LCPI 03510000 LCANSP = S1CVBN (CARD, 66, 5) 03520000 LCMXLN = S1CVBN (CARD, 71, 5) 03530000 IF (LCMXLN .EQ. 0) LCMXLN = 1 03540000 C 03550000 C FIND THE PROCESS 03560000 C ================ 03570000 C 03580000 5 IF (KPNA .EQ. PROC(1)) GO TO 100 03590000 IF (KPNA .EQ. PROC(2)) GO TO 200 03600000 IF (KPNA .EQ. PROC(3)) GO TO 300 03610000 IF (KPNA .EQ. PROC(4)) GO TO 400 03620000 IF (KPNA .EQ. PROC(5)) GO TO 500 03630000 IF (KPNA .EQ. PROC(6)) GO TO 600 03640000 IF (KPNA .EQ. PROC(7)) GO TO 700 03650000 IF (KPNA .EQ. PROC(8)) GO TO 800 03660000 IF (KPNA .EQ. PROC(9)) GO TO 900 03670000 IF (KPNA .EQ. PROC(10))GO TO 1000 03680000 IF (KPNA .EQ. PROC(11))GO TO 1000 03690000 IF (KPNA .EQ. PROC(12))GO TO 1200 03700000 IF (KPNA .EQ. PROC(13))GO TO 1300 03710000 IF (KPNA .EQ. PROC(14))GO TO 1400 03720000 IF (KPNA .EQ. PROC(15))GO TO 1500 03730000 IF (KPNA .EQ. PROC(16))GO TO 1600 03740000 IF (KPNA .EQ. PROC(17))GO TO 1700 03750000 IF (KPNA .EQ. PROC(18))GO TO 1800 03760000 IF (KPNA .EQ. PROC(19))GO TO 1900 03770000 IF (KPNA .EQ. PROC(20))GO TO 2000 03780000 IF (KPNA .EQ. PROC(21))GO TO 2100 03790000 IF (KPNA .EQ. PROC(22))GO TO 2200 03800000 IF (KPNA .EQ. PROC(23))GO TO 2300 03810000 IF (KPNA .EQ. PROC(24))GO TO 2400 03820000 IF (KPNA .EQ. PROC(25))GO TO 2500 03830000 IF (KPNA .EQ. PROC(26))GO TO 2600 03840000 IF (KPNA .EQ. PROC(27))GO TO 2700 03850000 IF (KPNA .EQ. PROC(28))GO TO 2800 03860000 IF (KPNA .EQ. PROC(29))GO TO 2900 03870000 IF (KPNA .EQ. PROC(30))GO TO 3000 03880000 IF (KPNA .EQ. PROC(31))GO TO 3100 03890000 CKG 03900000 IF (KPNA .EQ. PROC(32))GO TO 500 03910000 IF (KPNA .EQ. PROC(33))GO TO 2500 03920000 IF (KPNA .EQ. PROC(34))GO TO 2700 03930000 IF (KPNA .EQ. PROC(35))GO TO 2600 03940000 IF (KPNA .EQ. PROC(36))GO TO 2700 03950000 IF (KPNA .EQ. PROC(37))GO TO 200 03960000 IF (KPNA .EQ. PROC(38))GO TO 3800 03970000 IF (KPNA .EQ. PROC(39))GO TO 3900 03980000 CKG 03990000 C 04000000 C PROCESS NOT IDENTIFIED IN JSCOR3--CHECK JSCOR4 04010000 C 04020000 CALL JSCOR4 ( KPNA, KPRNO, OCCUR, BLKSIZ, 04030000 * PSIZE, CSIZE, RSIZE, ERCODE, URBYTE, URKBYT ) 04040000 C 04050000 GO TO 9900 04060000 C 04070000 C ============== 04080000 C 1. PROCESS = GEOM 04090000 C ============== 04100000 C 04110000 C =========================================== 04120000 C COMPUTE THE REGION AND COMMON SIZE FOR GEOM 04130000 C =========================================== 04140000 C 04150000 100 PSIZE = 220 04160000 DA = 1 04170000 NWPHBK = 7936 04180000 DSSW = 0 04190000 BNSW = 0 04200000 BRSW = 0 04210000 DPSW = 0 04220000 CPSW = 0 04230000 CRSW = 0 04240000 WZSW = 1 04250000 NLINE = 1500 04260000 IF (LCMXLN .GT. 1500) NLINE = LCMXLN 04270000 C 04280000 C SET GEOM LIMITATIONS (1,000,000 CDPS & 250000 RVS) 04290000 C 04300000 NDP = 1000000 04310000 NCR = 250000 04320000 NWZ = NCR 04330000 C 04340000 C READ THE GEOM CARDS AND SET FLAGS 04350000 C 04360000 110 CALL FORC (KPNA, KPRNO, DA, CARD, * 130 )04370000 IF (S1CPCH (CARD, 8, ' ', 1, 3) .EQ. 0) THEN 04380000 IF (S1CPCH(CARD,26,' ',1,5) .NE. 0) BNSW = 1 04390000 ENDIF 04400000 IF (S1CPCH (CARD, 8, 'DPB', 1, 3) .EQ. 0) DPSW = 1 04410000 IF (S1CPCH (CARD, 8, 'CRB', 1, 3) .EQ. 0) CRSW = 1 04420000 IF (S1CPCH (CARD, 8, 'DIS', 1, 3) .EQ. 0) DSSW = 1 04430000 IF (S1CPCH (CARD, 8, 'BOR', 1, 3) .EQ. 0) BRSW = 1 04440000 IF (S1CPCH (CARD, 8, 'BIN', 1, 3) .EQ. 0) BNSW = 1 04450000 IF (S1CPCH (CARD, 8, 'CUP', 1, 3) .EQ. 0) CPSW = 1 04460000 GO TO 110 04470000 C 04480000 130 COM = NWPHBK + 3 + LCTPSP + (10 * LCMXFD) + (DSSW * LCTPSP) + 04490000 * (48 * NLINE) + (BRSW * 44 * LCMXFD) + (BRSW * 8000) + 04500000 * (CPSW * 44 * LCMXFD) + (CPSW * 8000) + 04510000 * (CRSW * NCR) + (WZSW * NWZ) 04520000 IF(DPSW .EQ. 1 .OR. BRSW .EQ. 1 .OR. CPSW .EQ. 1) COM = COM + NDP 04530000 IF(BNSW .EQ. 1 .OR. BRSW .EQ. 1) COM = COM + NDP * 2 04540000 C 04550000 COM = 4 * COM 04560000 IF (COM .LE. URBYTE) COM = 0 04570000 IF (COM .EQ. 0) GO TO 9900 04580000 SVCOM = COM 04590000 COM = COM - URBYTE 04600000 URBYTE = SVCOM 04610000 URKBYT = URBYTE / 1024 04620000 C 04630000 CSIZE = (COM + 1023) / 1024 04640000 C 04650000 GO TO 9900 04660000 C 04670000 C ============== 04680000 C PROCESS = RANL - DELETED 4/13/87 04690000 C ============== 04700000 C 04710000 C ======================= 04720000 C 2. PROCESS = WRIT AND WT3D 04730000 C ======================= 04740000 C 04750000 200 NOWRDS = 2002 04760000 IF(LCMXLN .GT. NOWRDS) NOWRDS = LCMXLN 04770000 C-----SPACE FOR SUMMARY ARRAYS 04780000 NOWRDS = NOWRDS * 6 04790000 C-----INCLUDE DLOCAL AND EXTRAS 04800000 NOWRDS = NOWRDS + 320 + 527 04810000 COM = 180000 04820000 IF(COM .LE. URBYTE) COM = 0 04830000 IF(COM .EQ. 0) GO TO 210 04840000 SVCOM = COM 04850000 COM = COM - URBYTE 04860000 URBYTE = SVCOM 04870000 URKBYT = URBYTE / 1024 04880000 C 04890000 210 CSIZE = (COM + 4 * NOWRDS + 1023) / 1024 04900000 GO TO 9900 04910000 C 04920000 C ============== 04930000 C 3. PROCESS = ZMPS 04940000 C ============== 04950000 C 04960000 C =========================================== 04970000 C COMPUTE THE REGION AND COMMON SIZE FOR ZMPS 04980000 C =========================================== 04990000 C 05000000 300 PSIZE = 55 05010000 DA = 1 05020000 NOC = 0 05030000 NUMS = 0 05040000 C 05050000 310 CALL FORC ( KPNA, KPRNO, DA, CARD, * 320) 05060000 IF (S1CPCH(CARD,8,' ',1,3).NE. 0 ) GO TO 310 05070000 NOC = NOC + 1 05080000 SPT = S1CVBN ( CARD, 11, 5 ) 05090000 EPT = S1CVBN ( CARD, 16, 5 ) 05100000 N = IABS(EPT-SPT) + 1 05110000 NUMS = MAX0( NUMS, N) 05120000 CALL USCHFT ( CARD, 26, 5, FLO ) 05130000 CALL USCHFT ( CARD, 31, 5, FHI ) 05140000 SPSPC = S1CVBN ( CARD, 56, 5 ) 05150000 GO TO 310 05160000 C 05170000 320 BUFSIZ = 8000 05180000 NZ = 1000 05190000 WAVSIZ = 50000 05200000 NX = INT(NUMS*(SPSPC/LCGRPI) + LCTPSP + 0.5) 05210000 NOM = INT((FHI-FLO)*FLOAT(RLENG/1000)) + 1 05220000 NTPB = MAX0(192,2*LCTPSP) 05230000 NT = INT(NOSAMP*1.04) 05240000 CALL S1FMAG ( NT, NEXP, NTT ) 05250000 C 05260000 IMEM0 = 8*NX + NZ + NOM + NX*NUMS 05270000 IMEM2 = NX*34 + 2*BUFSIZ + 2*WAVSIZ 05280000 IMEM3 = BUFSIZ + 4*NOM*NTPB + 2*NTT 05290000 IMEM = IMEM0 + MAX0(IMEM2,IMEM3) 05300000 C 05310000 IF ( NOC .EQ. 0 ) GO TO 8020 05320000 COM = 4*IMEM 05330000 IF ( COM .LE. URBYTE ) COM = 0 05340000 IF ( COM .EQ. 0 ) GO TO 330 05350000 SVCOM = COM 05360000 COM = COM - URBYTE 05370000 URBYTE = SVCOM 05380000 URKBYT = URBYTE / 1024 05390000 C 05400000 330 CSIZE = BLKSIZ + 2000 05410000 CSIZE =(CSIZE + COM + 1023 )/ 1024 05420000 C 05430000 GO TO 9900 05440000 C 05450000 C ============== 05460000 C 4. PROCESS = ACHK 05470000 C ============== 05480000 C 05490000 C =========================================== 05500000 C COMPUTE THE REGION AND COMMON SIZE FOR ACHK 05510000 C =========================================== 05520000 C 05530000 400 PSIZE = 15 05540000 CSIZE = 2000 05550000 CSIZE =(CSIZE + 1023 )/ 1024 05560000 C 05570000 GO TO 9900 05580000 C 05590000 C ====================== 05600000 C 5. PROCESS = TXGL OR TXGF 05610000 C ====================== 05620000 C 05630000 C =========================================== 05640000 C COMPUTE THE REGION AND COMMON SIZE FOR TXGF 05650000 C =========================================== 05660000 C 05670000 500 DA = 1 05680000 NOC = 0 05690000 COM = 0 05700000 NWORDS = 0 05710000 C 05720000 C READ THE FIRST TXGF CARD 05730000 C 05740000 510 CALL FORC (KPNA, KPRNO, DA, CARD, * 520 )05750000 IF (S1CPCH (CARD, 8, ' ', 1, 3) .NE. 0) GO TO 510 05760000 NOC = NOC + 1 05770000 C 05780000 C READ THE CARD (1) PARAMETERS 05790000 C 05800000 NSHOT = S1CVBN (CARD, 31, 5) 05810000 IF (NSHOT .EQ. 0) NSHOT = LCNSP 05820000 NCDPS = S1CVBN (CARD, 36, 5) 05830000 IF (NCDPS .EQ. 0) NCDPS = 2 * (NSHOT + LCTPSP) 05840000 NCABLE = S1CVBN (CARD, 41, 5) 05850000 IF (NCABLE .EQ. 0) NCABLE = 2 05860000 NUMSR = S1CVBN (CARD, 46, 5) 05870000 NGAP = S1CVBN (CARD, 71, 5) 05880000 IF (NUMSR .EQ. 0) NUMSR = 2 * (NSHOT + LCTPSP) 05890000 NLAYRS = S1CVBN (CARD, 51, 5) 05900000 CALL USCHFT (CARD, 61, 5, DX) 05910000 IF (S1CPCH (CARD, 61, ' ', 1, 5) .EQ. 0) DX = LCGRPI 05920000 C 05930000 520 IF (NOC .EQ. 0) GO TO 8020 05940000 C 05950000 C CALCULATE GEOMETRY AND SIZE PARAMETERS 05960000 C 05970000 CC NDEC = FLOAT(LCGRPI) / DX + 0.5 05980000 NDEC = INT(LCGRPI / DX + 0.5) 05990000 NX = (LCTPSP + NGAP - 1) * NDEC * NCABLE 06000000 NY = 1 06010000 NTRCE = NSHOT * LCTPSP 06020000 NHOR = NLAYRS + 1 06030000 NGF = NSHOT * (LCTPSP + 1) 06040000 XLEN = (NSHOT + LCTPSP + NGAP - 2) * LCGRPI + NX * DX 06050000 NXX = INT(XLEN / DX + 0.5) 06060000 NWORDS = NXX + 5 * NTRCE + 4 * NHOR * NXX + NGF + NGF / 2 + 06070000 * 4 * NUMSR + NHOR + 2 * (NTRCE / 2 + 1) + 3 * NCDPS + 06080000 * 100 06090000 C 06100000 CSIZE = (4 * NWORDS + 1023) / 1024 06110000 PSIZE = 35 06120000 C 06130000 GO TO 9900 06140000 C 06150000 C ============== 06160000 C 6. PROCESS = VZ3D 06170000 C ============== 06180000 C 06190000 C =========================================== 06200000 C COMPUTE THE REGION AND COMMON SIZE FOR VZ3D 06210000 C =========================================== 06220000 C 06230000 600 DA = 1 06240000 NOC = 0 06250000 COM = 0 06260000 NWORDS = 0 06270000 NHORZN = 0 06280000 NXPNTS = 0 06290000 NY = 0 06300000 C 06310000 C READ THE VZ3D 'ZVI' CARDS 06320000 C 06330000 610 CALL FORC (KPNA, KPRNO, DA, CARD, * 630 )06340000 IF (S1CPCH (CARD, 8, 'ZVI', 1, 3) .NE. 0) GO TO 610 06350000 NOC = NOC + 1 06360000 HRZN = S1CVBN (CARD, 11, 5) 06370000 LINENO = S1CVBN (CARD, 16, 5) 06380000 IF (HRZN .GT. NHORZN) NHORZN = HRZN 06390000 IF (LINENO .GT. NY) NY = LINENO 06400000 C 06410000 DO 620 I = 21, 80, 20 06420000 CDP = S1CVBN (CARD, I, 5) 06430000 IF (CDP .GT. NXPNTS) NXPNTS = CDP 06440000 C 06450000 620 CONTINUE 06460000 C 06470000 GO TO 610 06480000 C 06490000 630 IF (NOC .EQ. 0) GO TO 8020 06500000 C 06510000 C CALCULATE THE UNRESERVED COMMON REQUIREMENT 06520000 C 06530000 COM = 5 * NXPNTS * NY + 12 * NOC 06540000 COM = 4 * COM 06550000 IF (COM .LE. URBYTE) COM = 0 06560000 IF (COM .EQ. 0) GO TO 640 06570000 SVCOM = COM 06580000 COM = COM - URBYTE 06590000 URBYTE = SVCOM 06600000 URKBYT = URBYTE / 1024 06610000 C 06620000 640 CSIZE = (COM + 4 * NWORDS + 1023) / 1024 06630000 PSIZE = 25 06640000 GO TO 9900 06650000 C 06660000 C ============== 06670000 C PROCESS = TINT - DELETED 4/13/87 06680000 C ============== 06690000 C 06700000 C ============== 06710000 C 7. PROCESS = LA3D 06720000 C ============== 06730000 C 06740000 C =========================================== 06750000 C COMPUTE THE REGION AND COMMON SIZE FOR LA3D 06760000 C =========================================== 06770000 C 06780000 700 DA = 1 06790000 701 CALL FORC (KPNA, KPRNO, DA, CARD, * 8020 )06800000 IF (S1CPCH(CARD,8,' ',1,3).NE. 0 ) GO TO 701 06810000 SCDP = S1CVBN (CARD, 11, 5) 06820000 ECDP = S1CVBN (CARD, 16, 5) 06830000 LINSTR = S1CVBN (CARD, 66, 5) 06840000 LINEND = S1CVBN (CARD, 71, 5) 06850000 NLINE = LINEND - LINSTR + 1 06860000 DA = 1 06870000 702 CALL FORC (KPNA, KPRNO, DA, CARD, * 8020 )06880000 IF (S1CPCH(CARD,8,'GEN',1,3).NE. 0 ) GO TO 702 06890000 NLNPP = S1CVBN (CARD, 21, 5) 06900000 NDPPP = S1CVBN (CARD, 26, 5) 06910000 MAXSFT = S1CVBN (CARD, 31, 5) 06920000 STIME = S1CVBN (CARD, 41, 5) 06930000 ETIME = S1CVBN (CARD, 46, 5) 06940000 IFILT = S1CVBN (CARD, 51, 5) 06950000 FSR = LCPI 06960000 SSMPL = STIME / FSR + 1.5 06970000 ESMPL = ETIME / FSR + 1.5 06980000 NSMPL = ESMPL - SSMPL + 1 06990000 IF(NLNPP .EQ. 0) NLNPP = 1 07000000 IF(NDPPP .EQ. 0) NDPPP = 3 07010000 MAXDP = (ECDP - SCDP + 1) * NLNPP 07020000 NPTS = 0 07030000 C 07040000 IF (IFILT .NE. 0) THEN 07050000 DA = 1 07060000 703 CALL FORC (KPNA, KPRNO, DA, CARD, * 8020 )07070000 IF (S1CPCH(CARD,8,'TZF',1,3).NE. 0 ) GO TO 703 07080000 JFILT = S1CVBN (CARD, 11, 5) 07090000 IF (JFILT .NE. IFILT) GO TO 703 07100000 NPTS = S1CVBN (CARD, 36, 5) 07110000 IF (NPTS .EQ. 0) THEN 07120000 LP = S1CVBN(CARD,21,5) 07130000 HP = S1CVBN(CARD,26,5) 07140000 NPTS = 20000 / (HP-LP+1.0) + 0.5 07150000 IF (NPTS .LT. 300) NPTS = 300 07160000 IF (NPTS .GT. RLENG) NPTS = RLENG 07170000 NPTS = NPTS / FSR 07180000 ENDIF 07190000 IF (MOD(NPTS,2) .EQ. 0) NPTS = NPTS + 1 07200000 ENDIF 07210000 C 07220000 C FOR FILTER APPLICATION WE NEED THE LARGER WINDOW SIZE 07230000 C THE ORIGINAL WINDOW IS PADDED SYMMETRICALLY BY NPTS/2. 07240000 C 07250000 SSSMPL = SSMPL - NPTS/2 07260000 IF (SSSMPL .LT. 1 ) SSSMPL = 1 07270000 EESMPL = ESMPL + NPTS/2 07280000 IF (EESMPL .GT. NOSAMP) EESMPL = NOSAMP 07290000 IF (SSSMPL .EQ. 1) EESMPL = NSMPL + NPTS 07300000 IF (EESMPL .EQ. NOSAMP) SSSMPL = NOSAMP - (NSMPL + NPTS) 07310000 C 07320000 C CALCULATE THE LENGTH OF THE LARGER WINDOW FOR FILTER APPLICATION 07330000 C 07340000 NNSMPL = EESMPL - SSSMPL + 1 07350000 LAG = MAXSFT / FSR + 0.5 07360000 L = NNSMPL + LAG + LAG 07370000 FFTLEN = 4 07380000 C 07390000 710 IF (FFTLEN .GE. L) GO TO 720 07400000 FFTLEN = FFTLEN + FFTLEN 07410000 GO TO 710 07420000 C 07430000 C--RESERVED MEMORY 07440000 C 07450000 720 MX = NLNPP * NDPPP * LCMXFD 07460000 NSAMP = MAX0(NOSAMP,NNSMPL) 07470000 C 07480000 C DATA SET FLAT FILE 07490000 C DLOCAL NAMES BUFFER THL SVTRC,SUMTR,PLTS 07500000 NWORDS = 275 + 15 + 5860 + 190 + (MX+2) * NSAMP + 07510000 C 07520000 C LAGOLD,COROLD,LAGNEW, 07530000 C CORNEW,SPEAK,LAGCOR,AMP TRACES 07540000 * (8 * LCMXFD) + (LCMXFD+5)*(FFTLEN+2) + 07550000 C 07560000 C FILT 07570000 C PARMS OPER XCORFN LINTAB 07580000 * 100 + NSAMP + (LAG*2+1)*LCMXFD + NLINE + 07590000 C 07600000 C CDPTAB, EPI 07610000 C PTAL 07620000 * (2 * MAXDP) + 8192 07630000 C 07640000 C--SCRATCH MEMORY 07650000 C 07660000 C WORK ARRAY 07670000 C XDST,SORT, SATCOR FFT'S WORK ARRAY 07680000 C COR,& STATIC AND FILTER FOR SAPSTK 07690000 COM = (LCMXFD * 4) + FFTLEN*10 + NSAMP 07700000 C 07710000 C WRITE (6,8123) NWORDS,MX,NSAMP,LCMXFD,FFTLEN,NSAMP,LAG,NLINE, 07720000 C * MAXDP,COM,NLNPP,NDPPP 07730000 C8123 FORMAT (2X,' NWORDS MX NSAMP LCMXFD', 07740000 C * ' FFTLEN NSAMP LAG NLINE', 07750000 C * ' MAXDP COM NLNPP NDPPP',/, 07760000 C * 2X,12I10) 07770000 C 07780000 COM = COM * 4 07790000 IF (COM .LE. URBYTE) COM = 0 07800000 IF (COM .EQ. 0) GO TO 730 07810000 SVCOM = COM 07820000 COM = COM - URBYTE 07830000 URBYTE = SVCOM 07840000 URKBYT = URBYTE / 1024 07850000 C 07860000 730 CSIZE = (NWORDS * 4 + COM + 1023) / 1024 07870000 PSIZE = 15 07880000 GO TO 9900 07890000 C 07900000 C ============== 07910000 C 8. PROCESS = D3NT 07920000 C ============== 07930000 C 07940000 C =========================================== 07950000 C COMPUTE THE REGION AND COMMON SIZE FOR D3NT 07960000 C =========================================== 07970000 C 07980000 800 PSIZE = 25 07990000 CSIZE = 2000 08000000 DA = 1 08010000 NOC = 0 08020000 C 08030000 810 CALL FORC ( KPNA, KPRNO, DA, CARD, * 820) 08040000 IF (S1CPCH(CARD,8,' ',1,3).NE. 0 ) GO TO 810 08050000 NOC = NOC + 1 08060000 C 08070000 SPT = S1CVBN(CARD,11, 5) 08080000 EPT = S1CVBN(CARD,16, 5) 08090000 IF(EPT.EQ.0) EPT = SPT 08100000 NMAX = IABS(EPT-SPT)+1 08110000 C 08120000 NCOF = S1CVBN(CARD,31, 5) 08130000 IF(NCOF.LE.0) NCOF=6 08140000 C 08150000 BLNN = S1CVBN(CARD,66, 5) 08160000 ELNN = S1CVBN(CARD,71, 5) 08170000 IF(ELNN.EQ.0) ELNN=BLNN 08180000 LMAX = IABS(ELNN-BLNN)+1 08190000 C 08200000 GO TO 810 08210000 C 08220000 820 IF ( NOC .EQ. 0 ) GO TO 8020 08230000 COM = (NCOF+2)*BLKSIZ 08240000 IF ( COM .LE. URBYTE ) COM = 0 08250000 IF ( COM .EQ. 0 ) GO TO 840 08260000 SVCOM = COM 08270000 COM = COM - URBYTE 08280000 URBYTE = SVCOM 08290000 URKBYT = URBYTE / 1024 08300000 C 08310000 840 CSIZE = CSIZE + 4*(LMAX*NMAX + NCOF) 08320000 CSIZE =(CSIZE + COM + 1023 )/ 1024 08330000 C 08340000 GO TO 9900 08350000 C 08360000 C ============== 08370000 C 9. PROCESS = VF3D 08380000 C ============== 08390000 C 08400000 C =========================================== 08410000 C COMPUTE THE REGION AND COMMON SIZE FOR VF3D 08420000 C =========================================== 08430000 C 08440000 900 PSIZE = 1300 08450000 RSIZE = 1500 08460000 MXVALS = 0 08470000 MXSAVE = 0 08480000 HRZNEW = 0 08490000 HRZOLD = 0 08500000 NL = 0 08510000 ND = 0 08520000 BEGDP = 99999 08530000 ENDDP = 0 08540000 BEGLN = 99999 08550000 ENDLN = 0 08560000 DA1 = 1 08570000 C 08580000 C FIND MAX NO. OF LINES AND DEPTHPOINTS 08590000 C 08600000 910 CALL FORC (KPNA, KPRNO, DA1, CARD, *930 ) 08610000 IF (S1CPCH(CARD, 8, ' C', 1,3) .EQ. 0) GO TO 910 08620000 IF (S1CPCH(CARD, 8, ' ', 1,3) .EQ. 0) GO TO 925 08630000 IF (S1CPCH(CARD, 8, 'GEN', 1,3) .EQ. 0) GO TO 910 08640000 IF (S1CPCH(CARD, 8, 'RES', 1,3) .EQ. 0) GO TO 910 08650000 C 08660000 LNO = S1CVBN (CARD, 16, 5) 08670000 IF (LNO .LT. BEGLN) BEGLN = LNO 08680000 IF (LNO .GT. ENDLN) ENDLN = LNO 08690000 C 08700000 HRZNEW = S1CVBN (CARD, 11, 5) 08710000 IF (HRZOLD .EQ. HRZNEW) GO TO 915 08720000 IF (MXVALS .GT. MXSAVE) MXSAVE = MXVALS 08730000 MXVALS = 0 08740000 HRZOLD = HRZNEW 08750000 C 08760000 915 DO 920 08770000 * I = 21, 80, 15 08780000 IF (S1CPCH(CARD,I,' ',1,5) .EQ. 0) GO TO 920 08790000 DP = S1CVBN (CARD, I, 5) 08800000 IF (DP .LT. BEGDP) BEGDP = DP 08810000 IF (DP .GT. ENDDP) ENDDP = DP 08820000 MXVALS = MXVALS + 1 08830000 C 08840000 920 CONTINUE 08850000 C 08860000 GO TO 910 08870000 C 08880000 C CHECK FOR INPUTING ONLY 08890000 C 08900000 925 IF (S1CPCH(CARD,22,'OUTV',1,4) .EQ. 0) GO TO 910 08910000 BEGDP = 0 08920000 BEGLN = 0 08930000 ENDDP = 0 08940000 ENDLN = 0 08950000 MXVALS = 0 08960000 MXSAVE = 0 08970000 C 08980000 930 IF (MXVALS .GT. MXSAVE) MXSAVE = MXVALS 08990000 C 09000000 C FIND RESOLUTION ENHANCEMENT PARAMETERS 09010000 C 09020000 RESCDP = 0 09030000 RESLIN = 0 09040000 DA1 = 1 09050000 935 CALL FORC (KPNA, KPRNO, DA1, CARD, *940 ) 09060000 IF (S1CPCH(CARD, 8, 'RES', 1,3) .NE. 0) GO TO 935 09070000 C 09080000 RESCDP = S1CVBN (CARD, 21, 5) 09090000 IF (S1CPCH(CARD,21,' ',1,5) .EQ. 0) RESCDP = 1 09100000 C 09110000 RESLIN = S1CVBN (CARD, 26, 5) 09120000 IF (S1CPCH(CARD,26,' ',1,5) .EQ. 0) RESLIN = 1 09130000 C 09140000 940 CONTINUE 09150000 C 09160000 ND = ENDDP - BEGDP + 1 09170000 IF (RESCDP .GT. 0) THEN 09180000 ND = ND + (ND-1)*RESCDP 09190000 ENDIF 09200000 NL = ENDLN - BEGLN + 1 09210000 IF (RESLIN .GT. 0) THEN 09220000 NL = NL + (NL-1)*RESLIN 09230000 ENDIF 09240000 C 09250000 CSIZE = (7 * MXSAVE + 4 * ND * NL) * 4 + 3120 * 4 09260000 IF (NL .EQ. 1) CSIZE = CSIZE + BEGDP * 2 09270000 CSIZE = (CSIZE + 1023) / 1024 09280000 C 09290000 GO TO 9900 09300000 C 09310000 C =================== 09320000 C 10. PROCESS = GDPH/GDPI 09330000 C =================== 09340000 C 09350000 C ============================================= 09360000 C PASS THE REGION AND COMMON SIZE FOR GDPH/GDPI 09370000 C ============================================= 09380000 C 09390000 1000 PSIZE = 400 09400000 CSIZE = 25 09410000 C 09420000 GO TO 9900 09430000 C 09440000 C 09450000 C ============== 09460000 C 12. PROCESS = SPEW 09470000 C ============== 09480000 C 09490000 C =========================================== 09500000 C COMPUTE THE REGION AND COMMON SIZE FOR SPEW 09510000 C =========================================== 09520000 C 09530000 1200 PSIZE = 33 09540000 C 09550000 CALL S1FMAG(NOSAMP,MAG, LFOUR ) 09560000 C 09570000 C AN APPROXIMATION IS MADE TO THE SPACE NEEDED FOR 09580000 C THE OPERATORS BY ASSUMING THE LENGTH WILL NEVER BE 09590000 C GREATER THAN 4*FFT LENGTH OF ENTIRE TRACE. 09600000 C 09610000 C 09620000 COM = 8*LFOUR 09630000 LLOCAL = 120 09640000 MAXCOF = 5000 09650000 LCIT = 200*30 + 405 09660000 LCCW = 100 09670000 COM = COM + LLOCAL + MAXCOF + NOSAMP + LCIT + LCCW + PTTHL 09680000 COM = COM*4 09690000 APLEN = 10*NOSAMP + 5*LFOUR + 2*MAXCOF + 35 09700000 APLEN = APLEN * 4 09710000 IF ( APLEN .LE. URBYTE ) APLEN = 0 09720000 IF ( APLEN .EQ. 0 ) GO TO 1280 09730000 IF (APLEN .GT. URBYTE) URBYTE = APLEN 09740000 URKBYT = URBYTE / 1024 09750000 C 09760000 1280 CSIZE =(BLKSIZ + COM + 1023 )/ 1024 09770000 GO TO 9900 09780000 C 09790000 C 09800000 C ============== 09810000 C 13. PROCESS = DG3D 09820000 C ============== 09830000 C 09840000 C =========================================== 09850000 C COMPUTE THE REGION AND COMMON SIZE FOR DG3D 09860000 C =========================================== 09870000 C 09880000 1300 PSIZE = 10 09890000 LWBUF = 5934 09900000 DA1 = 1 09910000 C 09920000 C FIND BEGINNING/ENDING DEPTH POINT/LINE 09930000 C 09940000 1310 CALL FORC (KPNA, KPRNO, DA1, CARD, *1330) 09950000 BEGDP = S1CVBN (CARD, 11, 5) 09960000 ENDDP = S1CVBN (CARD, 16, 5) 09970000 IF (ENDDP .EQ. 0) ENDDP = BEGDP 09980000 BEGLN = S1CVBN (CARD, 66, 5) 09990000 ENDLN = S1CVBN (CARD, 71, 5) 10000000 IF (ENDLN .EQ. 0) ENDLN = BEGLN 10010000 NODPS = ENDDP - BEGDP + 1 10020000 NOLNS = ENDLN - BEGLN + 1 10030000 C 10040000 C CHECK FOR DIAGONAL LINES BEING GENERATED 10050000 C 10060000 DO 1320 I = 21,23 10070000 IF (S1CPCH(CARD,I,'DND',1,3) .EQ. 0) NOLNS = NODPS + NOLNS - 1 10080000 IF (S1CPCH(CARD,I,'UPD',1,3) .EQ. 0) NOLNS = NODPS + NOLNS - 1 10090000 1320 CONTINUE 10100000 C 10110000 1330 CSIZE = 3 * LCMXFD + NODPS * NOLNS + 2 * LWBUF + 12 10120000 CSIZE = (CSIZE*4 + 1023) / 1024 10130000 GO TO 9900 10140000 C 10150000 C ============== 10160000 C 14. PROCESS = REJH 10170000 C ============== 10180000 C 10190000 1400 PSIZE = 15 10200000 CSIZE = 02 10210000 GO TO 9900 10220000 C 10230000 C ============== 10240000 C 15. PROCESS = VSPF 10250000 C ============== 10260000 C 10270000 1500 PSIZE = 12 10280000 CSIZE = 06 10290000 GO TO 9900 10300000 C 10310000 C ============== 10320000 C 16. PROCESS = DATM 10330000 C ============== 10340000 C 10350000 1600 PSIZE = 20 10360000 CSIZE = 02 10370000 GO TO 9900 10380000 C 10390000 C ============== 10400000 C 17. PROCESS = VSPG 10410000 C ============== 10420000 C 10430000 1700 PSIZE = 15 10440000 CSIZE = 10 10450000 GO TO 9900 10460000 C 10470000 C ============== 10480000 C 18. PROCESS = ALGN 10490000 C ============== 10500000 C 10510000 1800 PSIZE = 15 10520000 CSIZE = 150 10530000 GO TO 9900 10540000 C 10550000 C ============== 10560000 C 19. PROCESS = GDSP 10570000 C ============== 10580000 C 10590000 C =========================================== 10600000 C COMPUTE THE REGION AND COMMON SIZE FOR GDSP 10610000 C =========================================== 10620000 C 10630000 C 10640000 1900 PSIZE = 45 10650000 CSIZE = 0 10660000 C 10670000 DA = 1 10680000 NDIV = 0 10690000 NOC = 0 10700000 MNPT = 999999 10710000 MXPT = -999999 10720000 NWORDS = 0 10730000 C 10740000 1910 CALL FORC (KPNA, KPRNO, DA, CARD, * 1920 )10750000 IF (S1CPCH (CARD, 8, ' ', 1, 3) .NE. 0) GO TO 1910 10760000 CALL S1MVCH(BLANK, 1, GMODE, 1, 4) 10770000 CALL S1MVCH(CARD , 7, GMODE, 1, 1) 10780000 IF (GMODE .EQ. ' ') CALL S1MVCH(PMODE , 2, GMODE, 1, 1) 10790000 C 10800000 IF (GMODE .EQ. 'D') THEN 10810000 C DEPTH MODE 10820000 LNST = S1CVBN(CARD, 66, 5) 10830000 LNEN = S1CVBN(CARD, 71, 5) 10840000 NLINES = LNEN - LNST + 1 10850000 IF(LCMXLN .GT. NLINES) NLINES = LCMXLN 10860000 NPRIME = NLINES * 20 10870000 ELSE 10880000 C SHOT MODE 10890000 NLINES = LCMXLN 10900000 IF(NLINES .EQ. 0) NLINES = 1 10910000 NPRIME = LCANSP / 50 10920000 ENDIF 10930000 C 10940000 NOC = NOC + 1 10950000 C 10960000 POINT = S1CVBN(CARD, 11, 5) 10970000 IF (POINT .LT. MNPT) MNPT = POINT 10980000 POINT = S1CVBN(CARD, 16, 5) 10990000 IF (POINT .GT. MXPT) MXPT = POINT 11000000 C 11010000 1920 IF (NOC .EQ. 0) GO TO 8020 11020000 NPTS = MXPT - MNPT + 1 11030000 DA = 1 11040000 C 11050000 1930 CALL FORC (KPNA, KPRNO, DA, CARD, * 1940 )11060000 IF (S1CPCH (CARD, 8, 'SRR', 1, 3) .NE. 0 .AND. 11070000 * S1CPCH (CARD, 8, 'SRV', 1, 3) .NE. 0) GO TO 1930 11080000 C 11090000 NWORDS = NOSAMP + NPRIME * 6 11100000 IF (S1CPCH (CARD, 8, 'SRV', 1, 3) .NE. 0) GO TO 1930 11110000 IF (S1CPCH (CARD,51, 'PRINT', 1, 5) .EQ. 0) 11120000 *NWORDS = NWORDS + LCANSP/50*3 + (LCANSP/50+1)*LCANSP 11130000 C 11140000 1940 DA = 1 11150000 1945 CALL FORC (KPNA, KPRNO, DA, CARD, * 1950 )11160000 IF (S1CPCH (CARD, 8, 'DPT', 1, 3) .NE. 0) GO TO 1945 11170000 C 11180000 MTXSZ = NPTS * NLINES 11190000 NMTX = 1 11200000 C ***(REAL*8)***11210000 IF (S1CPCH (CARD, 33, 'YES', 1, 3) .EQ. 0) NMTX = NMTX + 4 11220000 C 11230000 NWORDS = NWORDS + NMTX * MTXSZ + NOSAMP 11240000 C 11250000 1950 DA = 1 11260000 1955 CALL FORC (KPNA, KPRNO, DA, CARD, * 1980 )11270000 IF (S1CPCH (CARD, 8, 'GRD', 1, 3) .NE. 0) GO TO 1955 11280000 C 11290000 MTXSZ = NPTS * NLINES 11300000 IF (S1CPCH(CARD, 23, 'YES', 1, 3) .NE. 0 .AND. 11310000 * S1CPCH(CARD, 21, ' ', 1, 5) .NE. 0 .AND. 11320000 * S1CPCH(CARD, 36, ' ', 1, 5) .EQ. 0 .AND. 11330000 * S1CPCH(CARD, 28, 'YES', 1, 3) .NE. 0) GO TO 1960 11340000 C 11350000 NDIV = S1CVBN(CARD, 31, 5) 11360000 IF (NDIV .LE. 0 .OR. NDIV .GT. 8) NDIV = 4 11370000 NWORDS = NWORDS + NDIV * MTXSZ 11380000 GO TO 1970 11390000 C 11400000 1960 IF (S1CPCH(CARD, 43, 'YES', 1, 3) .EQ. 0 ) 11410000 * NWORDS = NWORDS + MTXSZ 11420000 C 11430000 1970 IF (S1CPCH(CARD, 48, 'YES', 1, 3) .EQ. 0 ) 11440000 * NWORDS = NWORDS + MTXSZ 11450000 C 11460000 1980 NWORDS = NWORDS + 6 * NPRIME 11470000 CSIZE = (4 * NWORDS + 1023)/1024 11480000 GO TO 9900 11490000 C 11500000 C ============== 11510000 C 20. PROCESS = TSLC 11520000 C ============== 11530000 C 11540000 C =========================================== 11550000 C COMPUTE THE REGION AND COMMON SIZE FOR TSLC 11560000 C =========================================== 11570000 C 11580000 C 11590000 2000 PSIZE = 40 11600000 CSIZE = 0 11610000 C 11620000 DA = 1 11630000 NOC = 0 11640000 NWORDS = 0 11650000 C 11660000 2010 CALL FORC (KPNA, KPRNO, DA, CARD, * 2020 )11670000 IF (S1CPCH (CARD, 8, ' ', 1, 3) .NE. 0) GO TO 2010 11680000 C 11690000 NOC = NOC + 1 11700000 C RANGE 11710000 BCDPN = S1CVBN(CARD, 11, 5) 11720000 ECDPN = S1CVBN(CARD, 16, 5) 11730000 C 11740000 2020 IF (NOC .EQ. 0) GO TO 8020 11750000 C START TIME 11760000 STTIME = S1CVBN(CARD,21,5) 11770000 STTIME = STTIME / LCPI + 1 11780000 C END TIME 11790000 ENTIME = S1CVBN(CARD,26,5) 11800000 ENTIME = ENTIME / LCPI + 1 11810000 C DELTA TIME 11820000 DLTIME = S1CVBN(CARD,31,5) 11830000 DLTIME = DLTIME / LCPI 11840000 C MODE (1=XDIR, 2=YDIR) 11850000 MODE = -1 11860000 I1 = S1CPCH(CARD,36,'XDIR',1,4) 11870000 I2 = S1CPCH(CARD,37,'XDIR',1,4) 11880000 IF (I1 .EQ. 0 .OR. I2 .EQ. 0) MODE = 1 11890000 I1 = S1CPCH(CARD,36,'YDIR',1,4) 11900000 I2 = S1CPCH(CARD,36,'YDIR',1,4) 11910000 IF (I1 .EQ. 0 .OR. I2 .EQ. 0) MODE = 2 11920000 IF (MODE .EQ. -1) MODE = 1 11930000 C BEGINNING LINE 11940000 BLNN = S1CVBN(CARD,66,5) 11950000 IF (BLNN .EQ. 0) BLNN = 1 11960000 C ENDING LINE 11970000 ELNN = S1CVBN(CARD,71,5) 11980000 IF (ELNN .EQ. 0) ELNN = BLNN 11990000 C 12000000 NXM = ECDPN - BCDPN + 1 12010000 NYM = ELNN - BLNN + 1 12020000 C 12030000 NTIME = (ENTIME - STTIME) / DLTIME + 1 12040000 C 12050000 NA = NXM 12060000 IF (MODE .EQ. 2) NA = NYM 12070000 C 12080000 NWORDS = NA + NTIME * NA 12090000 C 12100000 CSIZE = (4 * NWORDS + 1023)/1024 12110000 GO TO 9900 12120000 C 12130000 C 12140000 C ======================= 12150000 C 21. PROCESS = OPAP 12160000 C ======================= 12170000 C 12180000 C =========================================== 12190000 C COMPUTE THE REGION AND COMMON SIZE FOR OPAP 12200000 C =========================================== 12210000 C 12220000 C 12230000 2100 PSIZE = 60 12240000 COM = 75 12250000 CSIZE = 35 12260000 COM = COM *4000 12270000 CSIZE = CSIZE*4000 12280000 C 12290000 C 12300000 C CONVERT TO K-BYTES 12310000 C 12320000 IF (COM .LE. URBYTE) COM = 0 12330000 IF (COM .EQ. 0) GO TO 2140 12340000 SVCOM = COM 12350000 COM = COM - URBYTE 12360000 URBYTE = SVCOM 12370000 URKBYT = URBYTE / 1024 12380000 C 12390000 2140 CSIZE = (CSIZE + COM + 1023) / 1024 12400000 GO TO 9900 12410000 C 12420000 C ============== 12430000 C 22. PROCESS = SCDA 12440000 C ============== 12450000 C 12460000 2200 PSIZE = 50 12470000 CSIZE = 35 12480000 GO TO 9900 12490000 C 12500000 C ============== 12510000 C 23. PROCESS = SCDC 12520000 C ============== 12530000 C 12540000 2300 PSIZE =100 12550000 CSIZE =120 12560000 GO TO 9900 12570000 C 12580000 C ============== 12590000 C 24. PROCESS = VSPH 12600000 C ============== 12610000 C 12620000 2400 PSIZE =200 12630000 CSIZE = 40 12640000 GO TO 9900 12650000 C 12660000 C ====================== 12670000 C 25. PROCESS = LWSA OR LWST 12680000 C ====================== 12690000 C 12700000 C =========================================== 12710000 C COMPUTE THE REGION AND COMMON SIZE FOR LWSA 12720000 C =========================================== 12730000 C 12740000 2500 DA = 1 12750000 COM = 0 12760000 C 12770000 C READ THE FIRST LWSA CARD 12780000 C 12790000 2510 CALL FORC (KPNA, KPRNO, DA, CARD, * 8020 )12800000 IF (S1CPCH (CARD, 8, ' ', 1, 3) .NE. 0) GO TO 2510 12810000 IF (S1CPCH (CARD, 7, 'S', 1, 1) .EQ. 0) PMODE = 0 12820000 IF (S1CPCH (CARD, 7, 'D', 1, 1) .EQ. 0) PMODE = 1 12830000 DSN = S1CVBN (CARD, 26, 10) 12840000 C 12850000 C READ THE FIRST RECORD OF THE GLOBAL FILE FOR SIZE INFORMATION 12860000 C 12870000 CALL JSTXGL (KPNA, KPRNO, DSN, DIST, IPR, IER, ICOM) 12880000 IF (IER .EQ. -1) GO TO 9800 12890000 LEN = ICOM(41) 12900000 NHOR = ICOM(52) 12910000 NSHOT = ICOM(59) 12920000 NG = ICOM(60) 12930000 NA = ICOM(71) 12940000 NUMSR = ICOM(72) 12950000 NCDPS = ICOM(73) 12960000 NTRCE = NSHOT * NG 12970000 C 12980000 C COUNT THE 'DTM' CARDS 12990000 C 13000000 DA = 1 13010000 NOC = 0 13020000 C 13030000 2520 CALL FORC (KPNA, KPRNO, DA, CARD, *2530 )13040000 IF (S1CPCH (CARD, 8, 'DTM', 1, 3) .NE. 0) GO TO 2520 13050000 NOC = NOC + 1 13060000 GO TO 2520 13070000 C 13080000 C CALCULATE THE RESERVED COMMON REQUIREMENT 13090000 C 13100000 2530 NWORDS = 2 * NOC + LEN + NA + 4 * NUMSR + NHOR + NCDPS + 100 + 13110000 * 2 * ((NTRCE / 2) + NCDPS + 1) 13120000 IF (PMODE .EQ. 0) NWORDS = NWORDS + (NSHOT * (NG + 1)) / 2 + 1 13130000 C 13140000 C CALCULATE THE UNRESERVED COMMON REQUIREMENT 13150000 C 13160000 COM = 6 * NOC + LEN + 4 * LEN * NHOR 13170000 COM = 4 * COM 13180000 IF (COM .LE. URBYTE) COM = 0 13190000 IF (COM .EQ. 0) GO TO 2540 13200000 SVCOM = COM 13210000 COM = COM - URBYTE 13220000 URBYTE = SVCOM 13230000 URKBYT = URBYTE / 1024 13240000 C 13250000 2540 CSIZE = (COM + 4 * NWORDS + 1023) / 1024 13260000 PSIZE = 20 13270000 GO TO 9900 13280000 C 13290000 C ============== 13300000 C 26. PROCESS = TXDP 13310000 C ============== 13320000 C 13330000 C =========================================== 13340000 C COMPUTE THE REGION AND COMMON SIZE FOR TXDP 13350000 C =========================================== 13360000 C 13370000 2600 DA = 1 13380000 COM = 0 13390000 C 13400000 C READ THE FIRST TXDP CARD 13410000 C 13420000 2610 CALL FORC (KPNA, KPRNO, DA, CARD, * 8020 )13430000 IF (S1CPCH (CARD, 8, ' ', 1, 3) .NE. 0) GO TO 2610 13440000 IF (S1CPCH (CARD, 7, 'S', 1, 1) .EQ. 0) PMODE = 0 13450000 IF (S1CPCH (CARD, 7, 'D', 1, 1) .EQ. 0) PMODE = 1 13460000 C 13470000 C GET THE GLOBAL FILE NUMBER 13480000 C 13490000 DSN = S1CVBN (CARD, 56, 10) 13500000 C 13510000 C ****** READ THE 'PLT' CARD AND IDENTIFY THE DISPLAY TYPES ******* 13520000 C 13530000 DA = 1 13540000 2615 CALL FORC (KPNA, KPRNO, DA, CARD, * 2620 )13550000 IF (S1CPCH (CARD, 8, 'PLT', 1, 3) .NE. 0) GO TO 2615 13560000 IF (S1CPCH (CARD, 12, 'SEMB', 1, 4) .EQ. 0) PFLAGS(SEMB) = TRUE 13570000 IF (S1CPCH (CARD, 17, 'MODL', 1, 4) .EQ. 0) PFLAGS(MODL) = TRUE 13580000 IF (S1CPCH (CARD, 22, 'T0QC', 1, 4) .EQ. 0) PFLAGS(T0QC) = TRUE 13590000 IF (S1CPCH (CARD, 27, 'REFL', 1, 4) .EQ. 0) PFLAGS(REFL) = TRUE 13600000 IF (S1CPCH (CARD, 32, 'EMER', 1, 4) .EQ. 0) PFLAGS(EMER) = TRUE 13610000 IF (S1CPCH (CARD, 37, 'ONEW', 1, 4) .EQ. 0) PFLAGS(ONEW) = TRUE 13620000 IF (S1CPCH (CARD, 42, 'TWOW', 1, 4) .EQ. 0) PFLAGS(TWOW) = TRUE 13630000 C 13640000 C READ THE FIRST RECORD OF THE GLOBAL FILE FOR SOME SIZE INFORMATION13650000 C 13660000 2620 CALL JSTXGL (KPNA, KPRNO, DSN, DIST, IPR, IER, ICOM) 13670000 IF (IER .EQ. -1) GO TO 9800 13680000 NTEE = ICOM(31) 13690000 NFTX = ICOM(36) 13700000 NXX = ICOM(41) 13710000 NHOR = ICOM(43) 13720000 XMIN = XCOM(53) 13730000 DX = XCOM(55) 13740000 NCABLE = ICOM(58) 13750000 NSHOT = ICOM(59) 13760000 NG = ICOM(60) 13770000 NA = ICOM(71) 13780000 NUMSR = ICOM(72) 13790000 NCDPS = ICOM(73) 13800000 VELMIN = ICOM(74) 13810000 VELMAX = ICOM(75) 13820000 VELINC = ICOM(76) 13830000 XMAX = XCOM(77) 13840000 LYR = ICOM(78) 13850000 THORZ = ICOM(81) 13860000 T0NCDP = ICOM(98) 13870000 FCDPN = ICOM(99) 13880000 NTRCE = NG * NSHOT 13890000 C 13900000 C ******************** READ THE TXDP 'SEM' CARD ******************* 13910000 C 13920000 IF (PFLAGS(SEMB) .EQ. FALSE) GO TO 2652 13930000 DA = 1 13940000 NOC = 0 13950000 C 13960000 2640 CALL FORC (KPNA, KPRNO, DA, CARD, * 2650 )13970000 IF (S1CPCH (CARD, 8, 'SEM', 1, 3) .NE. 0) GO TO 2640 13980000 NOC = NOC + 1 13990000 CALL USCHFT (CARD, 26, 5, VSCLE) 14000000 IF (S1CPCH (CARD, 26, ' ', 1, 5) .EQ. 0) VSCLE = 1.0 14010000 CALL USCHFT (CARD, 31, 5, DPSCLE) 14020000 IF (S1CPCH (CARD, 31, ' ', 1, 5) .EQ. 0) DPSCLE = 12.0 14030000 NSMTH = S1CVBN (CARD, 71, 5) 14040000 N = 0 14050000 IF (S1CPCH (CARD, 51, ' ', 1, 5) .NE. 0) N = N + 1 14060000 IF (S1CPCH (CARD, 56, ' ', 1, 5) .NE. 0) N = N + 1 14070000 IF (S1CPCH (CARD, 61, ' ', 1, 5) .NE. 0) N = N + 1 14080000 IF (S1CPCH (CARD, 66, ' ', 1, 5) .NE. 0) N = N + 1 14090000 IF (IABS(NSMTH) .GT. 1) N = 2 * N 14100000 IF (VELINC .NE. 0) NVELS = (VELMAX - VELMIN) / VELINC + 1 14110000 C 14120000 2650 IF (NOC .NE. 0) GO TO 2652 14130000 VSCLE = 1.0 14140000 DPSCLE = 12.0 14150000 N = 1 14160000 NVELS = 100 14170000 C 14180000 C ****************** READ THE TXDP 'DEP' CARD ********************* 14190000 C 14200000 2652 IF (PFLAGS(MODL) .EQ. FALSE) GO TO 2658 14210000 DA = 1 14220000 NOC = 0 14230000 C 14240000 2654 CALL FORC (KPNA, KPRNO, DA, CARD, * 2656 )14250000 IF (S1CPCH (CARD, 8, 'DEP', 1, 3) .NE. 0) GO TO 2654 14260000 NOC = NOC + 1 14270000 ZMIN = S1CVBN (CARD, 11, 5) 14280000 ZMAX = S1CVBN (CARD, 16, 5) 14290000 IF (ZMAX .EQ. 0) ZMAX = 20000 14300000 CALL USCHFT (CARD, 31, 5, XSCLE) 14310000 IF (S1CPCH (CARD, 31, ' ', 1, 5) .EQ. 0) XSCLE = 1000.0 14320000 CALL USCHFT (CARD, 41, 5, ZSCLE) 14330000 IF (S1CPCH (CARD, 41, ' ', 1, 5) .EQ. 0) ZSCLE = 1000.0 14340000 C 14350000 2656 IF (NOC .NE. 0) GO TO 2658 14360000 ZMIN = 0 14370000 ZMAX = 20000 14380000 XSCLE = 1000.0 14390000 ZSCLE = 1000.0 14400000 C 14410000 C ******************** READ THE TXDP 'TQC' CARD ******************* 14420000 C 14430000 2658 IF (PFLAGS(T0QC) .EQ. FALSE) GO TO 2664 14440000 DA = 1 14450000 NOC = 0 14460000 C 14470000 2660 CALL FORC (KPNA, KPRNO, DA, CARD, * 2662 )14480000 IF (S1CPCH (CARD, 8, 'TQC', 1, 3) .NE. 0) GO TO 2660 14490000 NOC = NOC + 1 14500000 CSCLE = S1CVBN (CARD, 36, 5) 14510000 IF (CSCLE .EQ. 0) CSCLE = 5 14520000 CALL USCHFT (CARD, 41, 5, TSCLE) 14530000 IF (S1CPCH (CARD, 41, ' ', 1, 5) .EQ. 0) TSCLE = 300.0 14540000 C 14550000 2662 IF (NOC .NE. 0) GO TO 2664 14560000 TSCLE = 300.0 14570000 CSCLE = 5 14580000 C 14590000 C ****************** READ THE TXDP 'REF' CARD ********************* 14600000 C 14610000 2664 IF (PFLAGS(REFL) .EQ. FALSE) GO TO 2670 14620000 DA = 1 14630000 NOC = 0 14640000 C 14650000 2666 CALL FORC (KPNA, KPRNO, DA, CARD, * 2668 )14660000 IF (S1CPCH (CARD, 8, 'REF', 1, 3) .NE. 0) GO TO 2666 14670000 NOC = NOC + 1 14680000 CALL USCHFT (CARD, 36, 5, XRSCLE) 14690000 IF (S1CPCH (CARD, 36, ' ', 1, 5) .EQ. 0) XRSCLE = 5000.0 14700000 C 14710000 2668 IF (NOC .NE. 0) GO TO 2670 14720000 XRSCLE = 5000.0 14730000 C 14740000 C ****************** READ THE TXDP 'EM1' CARD ********************* 14750000 C 14760000 2670 IF (PFLAGS(EMER) .EQ. FALSE) GO TO 2676 14770000 DA = 1 14780000 NOC = 0 14790000 C 14800000 2672 CALL FORC (KPNA, KPRNO, DA, CARD, * 2674 )14810000 IF (S1CPCH (CARD, 8, 'EM1', 1, 3) .NE. 0) GO TO 2672 14820000 NOC = NOC + 1 14830000 CALL USCHFT (CARD, 16, 5, XESCLE) 14840000 IF (S1CPCH (CARD, 16, ' ', 1, 5) .EQ. 0) XESCLE = 5000.0 14850000 C 14860000 2674 IF (NOC .NE. 0) GO TO 2676 14870000 XESCLE = 5000.0 14880000 C 14890000 C ******************** READ THE TXDP 'ONE' CARD ******************* 14900000 C 14910000 2676 IF (PFLAGS(ONEW) .EQ. FALSE) GO TO 2679 14920000 DA = 1 14930000 NOC = 0 14940000 C 14950000 2677 CALL FORC (KPNA, KPRNO, DA, CARD, * 2678 )14960000 IF (S1CPCH (CARD, 8, 'ONE', 1, 3) .NE. 0) GO TO 2677 14970000 NOC = NOC + 1 14980000 CALL USCHFT (CARD, 36, 5, XOSCLE) 14990000 IF (S1CPCH (CARD, 36, ' ', 1, 5) .EQ. 0) XOSCLE = 5000.0 15000000 C 15010000 2678 IF (NOC .NE. 0) GO TO 2679 15020000 XOSCLE = 5000.0 15030000 C 15040000 C ******************** READ THE TXDP 'TWO' CARD ******************* 15050000 C 15060000 2679 IF (PFLAGS(TWOW) .EQ. FALSE) GO TO 2683 15070000 DA = 1 15080000 NOC = 0 15090000 C 15100000 2680 CALL FORC (KPNA, KPRNO, DA, CARD, * 2682 )15110000 IF (S1CPCH (CARD, 8, 'TWO', 1, 3) .NE. 0) GO TO 2680 15120000 NOC = NOC + 1 15130000 CALL USCHFT (CARD, 36, 5, XWSCLE) 15140000 IF (S1CPCH (CARD, 36, ' ', 1, 5) .EQ. 0) XWSCLE = 5000.0 15150000 WRITE (6,2621) XMIN, XMAX 15160000 2621 FORMAT (' %%%%% XMIN, XMAX:', 2F11.3) 15170000 WRITE (6,2629) XWSCLE 15180000 2629 FORMAT (' %%%%% XWSCLE:', F11.3) 15190000 C 15200000 2682 IF (NOC .NE. 0) GO TO 2683 15210000 XWSCLE = 5000.0 15220000 C 15230000 C ***************** CALCULATE THE PLOT BUFFER SIZE **************** 15240000 C 15250000 2683 XLEN = 12.0 15260000 YLEN = 5.0 15270000 C 15280000 C PLOT SIZE FOR THE SEMBLANCE PLOT 15290000 C 15300000 IF (PFLAGS(SEMB) .EQ. FALSE) GO TO 2692 15310000 XPLEN = (VELMAX - VELMIN) * (VSCLE * 0.001) + 4.0 15320000 XLEN = N * (XPLEN + 1.0) + XLEN 15330000 YLEN = AMAX1(NCDPS / DPSCLE, YLEN) 15340000 C 15350000 C PLOT SIZE FOR THE MODEL PLOTS 15360000 C 15370000 2692 IF (PFLAGS(MODL) .EQ. FALSE) GO TO 2693 15380000 XLEN = 2 * (ABS(XMAX - XMIN) / XSCLE + 4.0) + XLEN 15390000 YLEN = AMAX1(ABS(ZMAX - ZMIN) / ZSCLE, YLEN) 15400000 C 15410000 C PLOT SIZE FOR T0QC PLOT 15420000 C 15430000 2693 IF (PFLAGS(T0QC) .EQ. FALSE) GO TO 2694 15440000 XLEN = NCDPS / CSCLE + XLEN 15450000 CKG YLEN = AMAX1(5000 / TSCLE, YLEN) THIS STMT CAUSED A COMP ERROR 15460000 ZZTEMP = 5000./ TSCLE 15470000 IF (ZZTEMP.GT.YLEN) YLEN = ZZTEMP 15480000 C 15490000 C PLOT SIZE FOR RC PLOT 15500000 C 15510000 2694 IF (PFLAGS(REFL) .EQ. FALSE) GO TO 2695 15520000 XLEN = ((XMAX - XMIN) / XRSCLE + 4.0) + XLEN 15530000 YLEN = AMAX1(34., YLEN) 15540000 C 15550000 C PLOT SIZE FOR EMER PLOT 15560000 C 15570000 2695 IF (PFLAGS(EMER) .EQ. FALSE) GO TO 2696 15580000 XLEN = 4 * ((XMAX - XMIN) / XESCLE + 4.0) + XLEN 15590000 YLEN = AMAX1(34., YLEN) 15600000 C 15610000 C PLOT SIZE FOR ONEW PLOT 15620000 C 15630000 2696 IF (PFLAGS(ONEW) .EQ. FALSE) GO TO 2697 15640000 CC NDEC = FLOAT(LCGRPI) / DX + 0.5 15650000 NDEC = INT(LCGRPI / DX + 0.5) 15660000 RNDEC = FLOAT(NDEC) 15670000 CC DX = FLOAT(LCGRPI) / RNDEC 15680000 DX = LCGRPI / RNDEC 15690000 ONEL = NG * NDEC * NCABLE 15700000 WRITE (6,2626) NTEE, NA, ONEL 15710000 2626 FORMAT (' %%%%% NTEE NA ONEL:', 3I11) 15720000 XLEN = (NA/10 + 1) * ((ONEL * DX) / XOSCLE + 3.0) + XLEN 15730000 YLEN = AMAX1(34., YLEN) 15740000 C 15750000 C PLOT SIZE FOR TWOW PLOT 15760000 C 15770000 2697 IF (PFLAGS(TWOW) .EQ. FALSE) GO TO 2698 15780000 CC TWDX = 2 * LCGRPI 15790000 TWDX = 2.0 * LCGRPI 15800000 TWDX = INT((T0NCDP/10 + 1) * ((LCMXFD * TWDX) / XWSCLE + 3.0)) 15810000 WRITE (6,2627) LCGRPI, LCMXFD, T0NCDP, XWSCLE, TWDX 15820000 2627 FORMAT (' %%%%% (T0NCDP/10 + 1)*((LCMXFD*TWDX)/XWSCLE +3.0)',/, 15830000 * ' %%%%% LCGRPI, LCMXFD, T0NCDP, XWSCLE, XLEN:',/, 15840000 * 6X,F8.2,2I8,2F8.1) 15850000 CC * 6X,3I8,2F8.1) 15860000 XLEN = TWDX + XLEN 15870000 YLEN = AMAX1(34., YLEN) 15880000 C 15890000 C CALCULATE BUFFER SIZE FOR SUMMATION OF PLOTS 15900000 C 15910000 2698 IF (YLEN .LT. 12.0) YLEN = 12.0 15920000 NXSCTR = INT(XLEN * (200.0 / 256.0) + 1.0) 15930000 NYSCTR = INT(YLEN * (200.0 / 7040.0) + 1.0) 15940000 ILENTH = 101 * NXSCTR * NYSCTR 15950000 C 15960000 C CALCULATE THE RESERVED COMMON REQUIREMENT 15970000 C 15980000 NWORDS = NXX + ILENTH + NCDPS + 600 15990000 C 16000000 C CALCULATE THE UNRESERVED COMMON REQUIREMENT 16010000 C 16020000 IF (PFLAGS(SEMB) .EQ. TRUE) COM = COM + IABS(NSMTH) + 16030000 * 2 * (NVELS * NCDPS + NVELS) 16040000 IF (PFLAGS(MODL) .EQ. TRUE .OR. PFLAGS(RC) .EQ. TRUE) 16050000 * COM = COM + 4 * NXX * NHOR 16060000 IF (PFLAGS(T0QC) .EQ. TRUE) COM = COM + THORZ * T0NCDP 16070000 IF (PFLAGS(EMER) .EQ. TRUE) COM = COM + 4 * NA 16080000 IF (PFLAGS(ONEW) .EQ. TRUE) COM = COM + NTEE 16090000 IF (PFLAGS(TWOW) .EQ. TRUE) COM = COM + NFTX*LYR + NCDPS 16100000 COM = COM + (3*NUMSR) + (NUMSR+NHOR) + (NTRCE+4) + ((NCDPS+1)*3) 16110000 COM = 4 * COM 16120000 C 16130000 IF (COM .LE. URBYTE) COM = 0 16140000 IF (COM .EQ. 0) GO TO 2699 16150000 SVCOM = COM 16160000 COM = COM - URBYTE 16170000 URBYTE = SVCOM 16180000 URKBYT = URBYTE / 1024 16190000 C 16200000 2699 CSIZE = (COM + 4 * NWORDS + 1023) / 1024 16210000 PSIZE = 25 16220000 GO TO 9900 16230000 C 16240000 C ====================== 16250000 C 27. PROCESS = REFS OR REFM 16260000 C ====================== 16270000 C 16280000 C =========================================== 16290000 C COMPUTE THE REGION AND COMMON SIZE FOR REFS 16300000 C =========================================== 16310000 C 16320000 2700 DA = 1 16330000 COM = 0 16340000 C 16350000 C READ THE SECOND REFS CARD 16360000 C 16370000 2710 CALL FORC (KPNA, KPRNO, DA, CARD, * 8020 )16380000 IF (S1CPCH (CARD, 8, 'FIL', 1, 3) .NE. 0) GO TO 2710 16390000 NXX = S1CVBN (CARD, 46, 5) 16400000 DSN = S1CVBN (CARD, 31, 10) 16410000 C 16420000 C READ THE FIRST RECORD OF THE GLOBAL FILE FOR SIZE INFORMATION 16430000 C 16440000 CALL JSTXGL (KPNA, KPRNO, DSN, DIST, IPR, IER, ICOM) 16450000 IF (IER .EQ. -1) GO TO 9800 16460000 LEN = ICOM(41) 16470000 NHOR = ICOM(30) + 1 16480000 NSHOT = ICOM(59) 16490000 NG = ICOM(60) 16500000 NUMSR = ICOM(72) 16510000 NCDPS = ICOM(73) 16520000 NTRCE = NSHOT * NG 16530000 L1 = NUMSR + NHOR + NTRCE + NCDPS + 3 16540000 L2 = 4 * LEN * NHOR 16550000 C 16560000 C***********************************************************************16570000 C WRITE(6,88899) NXX,LEN,NHOR,NSHOT,NG,NUMSR,DSN,NCDPS,NTRCE,L1,L2, 16580000 C * NXX,LEN,NHOR,NSHOT,NG,NUMSR,DSN,NCDPS,NTRCE,L1,L2 16590000 C8899 FORMAT('0NXX,LEN,NHOR,NSHOT,NG,NUMSR,DSN,NCDPS,NTRCE,L1,L2 ', 16600000 C * /, 1X, 11I9 ,/,1X ,11Z9) 16610000 C***********************************************************************16620000 C 16630000 L1 = MAX0 (L1, L2) 16640000 LEN = MAX0 (LEN, NXX) 16650000 C 16660000 C 16670000 C READ THE 'PLT' DATA CARD IF 'RFST' IS REQUESTED 16680000 C 16690000 DAC = 1 16700000 ILENTH = 0 16710000 C 16720000 IF (KPNA .EQ. PROC(36) ) THEN 16730000 C 16740000 2747 CALL FORC (KPNA, KPRNO, DAC, CARD1, *2748 )16750000 IF (CARD1(8:10) .NE. 'PLT') GO TO 2747 16760000 C 16770000 C READ THE CARD 16780000 C 16790000 READ(CARD1,FMT='(20X,2F5.0)') 16800000 * XSCL, YSCL 16810000 C 16820000 IF (XSCL .EQ. 0.0) XSCL = 6.0 16830000 IF (YSCL .EQ. 0.0) YSCL = 100.0 16840000 C 16850000 XLN = FLOAT (NCDPS) / XSCL 16860000 YLN = 30 16870000 NXSCTR = INT(XLN * (200. / 256.) + 1.0) 16880000 NYSCTR = INT(YLN * (200. / 7040.) + 1.0) 16890000 ILENTH = 101 * NXSCTR * NYSCTR 16900000 C 16910000 LEN = MAX0 (LEN, ILENTH) 16920000 C 16930000 C***********************************************************************16940000 C WRITE(6,77899) LEN,ILENTH,XSCL,YSCL,XLN,YLN,NCDPS 16950000 C7899 FORMAT('0 LEN,ILENTH,XSCL,YSCL,XLN,YLN,NCDPS' ,2I9,4F6.1,I5) 16960000 C***********************************************************************16970000 C 16980000 C 16990000 2748 CONTINUE 17000000 C 17010000 ENDIF 17020000 C 17030000 C 17040000 C 17050000 C CALCULATE THE UNRESERVED COMMON REQUIREMENT 17060000 C 17070000 COM = LEN + 1.5 * (NSHOT * (NG + 1)) + 3 * NUMSR + L1 + 17080000 * 4 * NSHOT + 15 * NCDPS + 500 17090000 COM = 4 * COM 17100000 IF (COM .LE. URBYTE) COM = 0 17110000 IF (COM .EQ. 0) GO TO 2740 17120000 SVCOM = COM 17130000 COM = COM - URBYTE 17140000 URBYTE = SVCOM 17150000 URKBYT = URBYTE / 1024 17160000 C 17170000 2740 CSIZE = (COM + 1023) / 1024 + 100 17180000 PSIZE = 100 17190000 GO TO 9900 17200000 C 17210000 C 17220000 C 17230000 C 17240000 C ============== 17250000 C 28. PROCESS = NINA 17260000 C ============== 17270000 C 17280000 C =========================================== 17290000 C COMPUTE THE REGION AND COMMON SIZE FOR NINA 17300000 C =========================================== 17310000 C 17320000 2800 PSIZE = 51 17330000 DA = 1 17340000 BLKWDS = 8190 17350000 BLKLEN = 23424 17360000 LRECLW = 110 17370000 NLINE = 400 17380000 IF (LCMXLN .GT. 400) NLINE = LCMXLN 17390000 C 17400000 COM = (2 * BLKLEN) + (BLKWDS + LRECLW + NLINE*24) * 4 17410000 C 17420000 IF (COM .LE. URBYTE) COM = 0 17430000 IF (COM .EQ. 0) GO TO 9900 17440000 SVCOM = COM 17450000 COM = COM - URBYTE 17460000 URBYTE = SVCOM 17470000 URKBYT = URBYTE / 1024 17480000 C 17490000 CSIZE = (COM + 1023) / 1024 17500000 GO TO 9900 17510000 C 17520000 C 17530000 C 17540000 C ============== 17550000 C 29. PROCESS = GM3D 17560000 C ============== 17570000 C 17580000 C =========================================== 17590000 C COMPUTE THE REGION AND COMMON SIZE FOR GM3D 17600000 C =========================================== 17610000 C 17620000 2900 DA = 1 17630000 COM = 0 17640000 C 17650000 C SET CONSTANTS USED 17660000 C 17670000 DA1 = 1 17680000 MNRVI = 451 17690000 NTRCS = LCTPSP * 2 17700000 IF(NTRCS .GT. MNRVI) MNRVI = NTRCS 17710000 C 17720000 C COMPUTE THE NUMBER OF RECEIVERS AND CDF'S ON THE LINE 17730000 C 17740000 CALL ARSET (BLNKC, 20, BLANK) 17750000 C 17760000 C READ CARD ' ' (FIRST CARD) 17770000 C 17780000 1 CALL FORC (KPNA, KPRNO, DA1, CARD, *2910) 17790000 CKG WRITE(IPR,2) CARD 17800000 CKG 2 FORMAT(10X,20A4) 17810000 IF ( S1CPCH (CARD, 1, KPNA , 1, 4) .NE. 0 .OR. 17820000 * S1CPCH (CARD, 8, ' ', 1, 3) .NE. 0 ) GO TO 1 17830000 C 17840000 LINT = 0 17850000 IF ( S1CPCH (CARD, 21, BLNKC, 1, 5) .NE. 0 ) 17860000 *LINT = S1CVBN ( CARD, 21, 5 ) / 100.0 17870000 C 17880000 RVINT = 1.0 17890000 IF ( S1CPCH (CARD, 11, BLNKC, 1, 5) .NE. 0 ) 17900000 *RVINT = S1CVBN ( CARD, 11, 5 ) / 100.0 17910000 C 17920000 CDFI = 0.0 17930000 IF ( S1CPCH (CARD, 16, BLNKC, 1, 5) .NE. 0 ) 17940000 * CALL USCHFT ( CARD, 16, 5, CDFI ) 17950000 IF ( CDFI .EQ. 0.0 ) CDFI = 50.0 17960000 CDFII = CDFI / 100.0 17970000 CDFPRV = RVINT / CDFII 17980000 C 17990000 C MNOPL - CROOKED PROFILE SMOOTHING LENGTH (REQUIRES LARGER WORK ARRAYS)18000000 C 18010000 MNOPL = 0 18020000 IF ( S1CPCH (CARD, 76, BLNKC, 1, 5) .NE. 0 ) 18030000 *MNOPL = S1CVBN ( CARD, 76, 5 ) 18040000 C 18050000 C READ 'ALP' CARD(2) 18060000 C 18070000 NPLIN = 1 18080000 DA1 = 1 18090000 IF (LINT.LE.0) GO TO 34 18100000 32 CALL FORC(KPNA, KPRNO, DA1, CARD, *34) 18110000 IF (S1CPCH(CARD,8,'ALP',1,3) .NE. 0) GO TO 32 18120000 NPLIN = S1CVBN(CARD,16,5) 18130000 IF(NPLIN .LE. 0) NPLIN = 1 18140000 CTJT MNRVI =4451 18150000 C 18160000 34 CONTINUE 18170000 C 18180000 DA1 = 1 18190000 RCMIN = 9999999 18200000 RCMAX = 0 18210000 SUMGRP = 0 18220000 NCFS = 0 18230000 STSPNZ = 0 18240000 SPNIBZ = 0 18250000 STFILZ = 0 18260000 ENFILZ = 0 18270000 SPADVZ = 0 18280000 RVADVZ = 0 18290000 INKNTZ = 0 18300000 DPFLAG = 0 18310000 CRFLAG = 0 18320000 MXNSSR = 0 18330000 NSSR = 0 18340000 C 18350000 C SEARCH FOR 'CFS' OR 'DSP' CARDS 18360000 C 18370000 10 CALL FORC (KPNA, KPRNO, DA1, CARD, *2910) 18380000 CKG WRITE(IPR,2) CARD 18390000 IF ( S1CPCH (CARD, 8, 'CFS', 1, 3) .EQ. 0 ) GO TO 3 18400000 IF ( S1CPCH (CARD, 8, 'COS', 1, 3) .EQ. 0 ) GO TO 3 18410000 C 18420000 IF ( S1CPCH (CARD, 8, 'DSP', 1, 3) .NE. 0 ) GO TO 10 18430000 C 18440000 C CARD 'DSP' FOUND 18450000 C 18460000 IF ( S1CPCH (CARD,28, 'DPD', 1, 3) .EQ. 0 .OR. 18470000 * S1CPCH (CARD,33, 'DPS', 1, 3) .EQ. 0 ) DPFLAG = 1 18480000 C 18490000 IF ( S1CPCH (CARD,38, 'CRD', 1, 3) .EQ. 0 .OR. 18500000 * S1CPCH (CARD,43, 'CRS', 1, 3) .EQ. 0 ) CRFLAG = 1 18510000 C 18520000 GO TO 10 18530000 3 CONTINUE 18540000 C 18550000 C NCFS - NO. OF CFS CARDS READ 18560000 C 18570000 NCFS = NCFS + 1 18580000 C 18590000 C 18600000 C CARD 'CFS' FOUND 18610000 C 18620000 C 18630000 IF ( S1CPCH (CARD, 11, BLNKC, 1, 5) .NE. 0 ) 18640000 *STSPNO = S1CVBN ( CARD, 11, 5 ) 18650000 IF ( S1CPCH (CARD, 11, BLNKC, 1, 5) .EQ. 0 ) 18660000 *STSPNO = STSPNZ 18670000 C 18680000 IF ( S1CPCH (CARD, 16, BLNKC, 1, 5) .NE. 0 ) 18690000 *SPNIBN = S1CVBN ( CARD, 16, 5 ) 18700000 IF ( S1CPCH (CARD, 16, BLNKC, 1, 5) .EQ. 0 ) 18710000 *SPNIBN = SPNIBZ 18720000 C 18730000 IF ( S1CPCH (CARD, 21, BLNKC, 1, 5) .NE. 0 ) 18740000 *STFILE = S1CVBN ( CARD, 21, 5 ) 18750000 C 18760000 IF ( S1CPCH (CARD, 26, BLNKC, 1, 5) .NE. 0 ) 18770000 *ENFILE = S1CVBN ( CARD, 26, 5 ) 18780000 IF ( S1CPCH (CARD, 26, BLNKC, 1, 5) .EQ. 0 ) 18790000 *ENFILE = STFILE 18800000 C 18810000 IF ( S1CPCH (CARD, 31, BLNKC, 1, 5) .NE. 0 ) 18820000 *SPADV = S1CVBN ( CARD, 31, 5 ) / 100.0 18830000 IF ( S1CPCH (CARD, 31, BLNKC, 1, 5) .EQ. 0 ) 18840000 *SPADV = SPADVZ 18850000 C 18860000 IF ( S1CPCH (CARD, 36, BLNKC, 1, 5) .NE. 0 ) 18870000 *RVADV = S1CVBN ( CARD, 36, 5 ) / 100.0 18880000 IF ( S1CPCH (CARD, 36, BLNKC, 1, 5) .EQ. 0 ) 18890000 *RVADV = RVADVZ 18900000 C 18910000 RCFLAG = 1 18920000 IF ( S1CPCH (CARD, 46, BLNKC, 1, 5) .NE. 0 ) 18930000 *RCSTN = S1CVBN ( CARD, 46, 5 ) 18940000 IF ( S1CPCH (CARD, 46, BLNKC, 1, 5) .EQ. 0 ) 18950000 *RCFLAG = 0 18960000 C 18970000 IF ( S1CPCH (CARD, 76, BLNKC, 1, 5) .NE. 0 ) 18980000 *INKNTR = S1CVBN ( CARD, 76, 5 ) 18990000 IF ( INKNTR .EQ. 0 ) INKNTR = 1 19000000 C 19010000 STSPNZ = STSPNO 19020000 SPNIBZ = SPNIBN 19030000 STFILZ = STFILE 19040000 ENFILZ = ENFILE 19050000 SPADVZ = SPADV 19060000 RVADVZ = RVADV 19070000 INKNTZ = INKNTR 19080000 C 19090000 RVINC = RVADV / RVINT 19100000 IF (RVINC .EQ. 0.0) RVINC = 1.0 19110000 C 19120000 C***********************************************************************19130000 C 19140000 C SAVE THE VALUES FOR THE FIRST, LAST RECEIVER LOCATIONS DEFINED 19150000 C ON CFS CARD. 19160000 C 19170000 C NSSR - NO. OF SHOTS AT THE SAME RECEIVER 19180000 C MXNSSR - MAXIMUM NO. OF SHOTS AT A RECEIVER 19190000 C 19200000 C 19210000 C CLOSEST REC CLOSEST REC 19220000 C TO LAST SHOT TO LAST SHOT 19230000 C ------------ ------------ 19240000 C THIS CARD RCL1 RCF1 19250000 C 19260000 C PREV CARD RCL2 RCF2 19270000 C 19280000 IF (RCFLAG.EQ.1) RCF1 = RCSTN 19290000 IF (RCFLAG.EQ.0) RCF1 = RCL2 + ( RVADV + SIGN(.5,RVADV) ) 19300000 C 19310000 IF (RCFLAG.EQ.0 .AND. ABS(SPADV) .GT. ABS(RVADV) ) 19320000 * RCF1 = RCL2 + ( SPADV + SIGN(.5,SPADV) ) 19330000 C 19340000 NFILE = (ENFILE - STFILE) / INKNTR 19350000 RCL1 = RCF1 + NFILE * (RVINC+.0001) 19360000 C 19370000 IF (RVADV.NE.0.0) NSSR = 0 19380000 IF (RVADV.EQ.0.0) NSSR = NSSR + NFILE 19390000 IF (NSSR.GT.MXNSSR) MXNSSR = NSSR 19400000 C 19410000 IF (NCFS.EQ.1) RCF2 = RCF1 19420000 IF (NCFS.EQ.1) RCL2 = RCL1 19430000 C 19440000 C IF RC INCREMENT IS .LT. 0, THEN SWAP RCF1 AND RCL1 SO THAT LARGER 19450000 C VALUE IS IN RCL1 19460000 C 19470000 CKG IF (RCF1.LE.RCL1) GO TO 21 19480000 C 19490000 CKG TEMP = RCF1 19500000 CKG RCF1 = RCL1 19510000 CKG RCL1 = TEMP 19520000 C 19530000 CKG21 CONTINUE 19540000 C 19550000 C COMPARE RCF1 AND RCL1 TO RCMIN, IF LESS RESET 19560000 C 19570000 IF (RCF1.LT.RCMIN) RCMIN = RCF1 19580000 IF (RCL1.LT.RCMIN) RCMIN = RCL1 19590000 C 19600000 C COMPARE RCL1 AND RCF1 TO RCMAX, IF .GT. THEN RESET 19610000 C 19620000 IF (RCL1.GT.RCMAX) RCMAX = RCL1 19630000 IF (RCF1.GT.RCMAX) RCMAX = RCF1 19640000 C 19650000 C RESET RCF2 AND RCL2 19660000 C 19670000 RCF2 = RCF1 19680000 RCL2 = RCL1 19690000 C 19700000 GO TO 10 19710000 C 19720000 2910 CONTINUE 19730000 C 19740000 C NOW YOU KNOW THE NUMBER OF RECEIVER GROUPS ON THE LINE 19750000 C ADD 2 TIMES NO. OF TRACES IN CABLE (START AND END) IN CASE OF 19760000 C WEIRD SHOOTING GEOMETRY, AND A FUDGE FACTOR OF 451 (MNRVI) 19770000 C 19780000 CTJT 19790000 C WRITE(6,*) ' RCMAX/RCMIN/NPLIN',RCMAX,RCMIN,NPLIN 19800000 IF(NPLIN .GT. 1) MNRVI = MNRVI + RCMAX 19810000 CTJT 19820000 SUMGRP = IABS(RCMAX-RCMIN) + 1 + MNRVI + 2*LCTPSP 19830000 C 19840000 C MULTIPLY THIS BY NUMBER OF PARALLEL RECEIVER LINES (IF 3-D CASE) 19850000 C 19860000 IF (LINT.GT.0) SUMGRP = SUMGRP * NPLIN 19870000 C 19880000 C#######################################################################19890000 C#######################################################################19900000 C#######################################################################19910000 C 19920000 C 19930000 C DETERMINE THE LENGTHS OF THE ARRAYS 19940000 C 19950000 MAXDPS = SUMGRP * CDFPRV + .5 19960000 C 19970000 MAXSPS = LCNSP 19980000 C 19990000 MAXRVS = SUMGRP 20000000 C 20010000 MAXTRC = LCTPSP 20020000 C 20030000 IF (DPFLAG.EQ.1) MAXTRC = MAX0 (LCMXFD,MAXTRC) 20040000 C 20050000 M = 0 20060000 IF (CRFLAG.EQ.1) M = LCTPSP * 2 + MXNSSR 20070000 IF (CRFLAG.EQ.1) MAXTRC = MAX0 (M,MAXTRC) 20080000 C 20090000 C 20100000 C 20110000 THL = 190 20120000 C 20130000 MAXCRK = MAXSPS 20140000 IF(MNOPL.GT.0) MAXCRK = MAX0(SUMGRP,MAXDPS) 20150000 C 20160000 C 20170000 C NOW ADD UP THE TOTAL AMOUNT OF SPACE REQUIRED 20180000 C 20190000 C 20200000 C CALCULATE THE UNRESERVED COMMON REQUIREMENT 20210000 C 20220000 COM = ( MAXSPS * 12 ) + ( MAXRVS * 9 ) + MAXDPS + 20230000 * ( MAXTRC * 7 ) + ( MAXCRK * 5 ) + THL 20240000 C 20250000 COMTMP = ( MAXSPS * 11 ) + ( MAXRVS * 15.5 ) + 20260000 * ( MAXCRK * 4 ) + THL + .50 20270000 C 20280000 IF (COMTMP .GT. COM) COM = COMTMP 20290000 C 20300000 COM = 4 * COM 20310000 C 20320000 IF (COM .LE. URBYTE) COM = 0 20330000 IF (COM .EQ. 0) GO TO 2995 20340000 SVCOM = COM 20350000 COM = COM - URBYTE 20360000 URBYTE = SVCOM 20370000 URKBYT = URBYTE / 1024 20380000 C 20390000 2995 CSIZE = (COM + 1023) / 1024 20400000 PSIZE = 102 20410000 GO TO 9900 20420000 C 20430000 C 20440000 C 20450000 C 20460000 C 20470000 C 20480000 C 20490000 C ============== 20500000 C 30. PROCESS = STAT 20510000 C ============== 20520000 C 20530000 C =========================================== 20540000 C COMPUTE THE REGION AND COMMON SIZE FOR STAT 20550000 C =========================================== 20560000 C 20570000 3000 CONTINUE 20580000 C 20590000 C 20600000 C MAKE SURE THAT JSCOR3 WAS CALLED PREVIOUSLY FOR GM3D 20610000 C 20620000 IF (MAXSPS .EQ. 0) GO TO 8030 20630000 C 20640000 C 20650000 C 20660000 C CALCULATE THE UNRESERVED COMMON REQUIREMENT 20670000 C 20680000 C 20690000 MAXSP2 = (MAXSPS + 1) / 2 20700000 MAXRV2 = (MAXRVS + 1) / 2 20710000 MAXDS = MAXSPS 20720000 IF (MAXDPS .GT. MAXSPS) MAXDS = MAXDPS 20730000 MAXDS2 = (MAXDS + 1) / 2 20740000 COM = 9 * MAXSPS + 2 * MAXSP2 + 2 * MAXDS + 3 * MAXRVS + 20750000 * 2 * MAXRV2 + MAXDS2 20760000 C 20770000 C 20780000 C 20790000 COM = 4 * COM 20800000 C 20810000 IF (COM .LE. URBYTE) COM = 0 20820000 IF (COM .EQ. 0) GO TO 3005 20830000 SVCOM = COM 20840000 COM = COM - URBYTE 20850000 URBYTE = SVCOM 20860000 URKBYT = URBYTE / 1024 20870000 C 20880000 3005 CSIZE = (COM + 1023) / 1024 20890000 PSIZE = 36 20900000 GO TO 9900 20910000 C 20920000 C ============== 20930000 C 31. PROCESS = CNAY 20940000 C ============== 20950000 C 20960000 C =========================================== 20970000 C COMPUTE THE REGION AND COMMON SIZE FOR CNAY 20980000 C =========================================== 20990000 C 21000000 3100 PSIZE = 40 21010000 CALL S1FMAG (NOSAMP, MFFT, NFFT) 21020000 N2UMAX = -999999 21030000 NFMAX = -999999 21040000 NOC = 0 21050000 C 21060000 DARNG = 1 21070000 3105 CALL FORC (KPNA, KPRNO, DARNG, CARD, * 3170 )21080000 IF (S1CPCH (CARD, 8, ' ', 1, 3) .NE. 0) GO TO 3105 21090000 C 21100000 NOC = NOC + 1 21110000 IDFVP = S1CVBN (CARD, 51, 5) 21120000 N2U = S1CVBN (CARD, 21, 5) 21130000 IF (N2U .GT. N2UMAX) N2UMAX = N2U 21140000 C 21150000 M = 1 21160000 COUNT = 0 21170000 DAC = 1 21180000 C 21190000 C 21200000 3106 CALL FORC (KPNA, KPRNO, DAC, CARD, * 3130 )21210000 IF ( .NOT. (S1CPCH (CARD, 8, 'FVP', 1, 3) .EQ. 0 .AND. 21220000 * S1CVBN (CARD, 11, 5) .EQ. IDFVP)) GO TO 3106 21230000 C 21240000 CALL ARMVE(CARD(1), CARD1, 10) 21250000 C 21260000 IF (CARD1(16:20) .NE. BLANKF) THEN 21270000 READ (CARD1(16:20), 9040) FNTNT 21280000 NTNT = FNTNT * 10.0 + .0001 21290000 ELSE 21300000 NTNT = 2 21310000 ENDIF 21320000 C 21330000 IF (NTNT .EQ. 1) N2U = N2U + (4 * N2U) / 5 + 1 21340000 IF (NTNT .EQ. 2) N2U = N2U + (3 * N2U) / 5 + 1 21350000 IF (NTNT .EQ. 4) N2U = N2U + N2U / 3 + 1 21360000 IF (N2U .GT. N2UMAX) N2UMAX = N2U 21370000 C 21380000 C SINCE N2UMAX IS APPROXIMATE, ADD ONE. 21390000 N2UMAX = N2UMAX + 1 21400000 C 21410000 DAC = 1 21420000 C 21430000 3110 CALL FORC (KPNA, KPRNO, DAC, CARD, * 3130 )21440000 IF ( .NOT. (S1CPCH (CARD, 8, 'FVP', 1, 3) .EQ. 0 .AND. 21450000 * S1CVBN (CARD, 11, 5) .EQ. IDFVP)) GO TO 3110 21460000 C 21470000 N = 21 21480000 DO 3120 JJJ = 1, 6 21490000 IF (S1CPCH (CARD, N, ' ', 1, 5) .EQ. 0) GO TO 3120 21500000 CALL USCHFT (CARD, N , 5, XCOM(M )) 21510000 CALL USCHFT (CARD, N + 5, 5, XCOM(M+1)) 21520000 COUNT = COUNT + 1 21530000 M = M + 2 21540000 3120 N = N + 10 21550000 C 21560000 GO TO 3110 21570000 C 21580000 3130 CONTINUE 21590000 C 21600000 NF = INT((XCOM(COUNT*2-1)-XCOM(1))/((500./LCPI)/(NFFT/2))) + 1 21610000 IF (NF .GT. NFMAX) NFMAX = NF 21620000 C 21630000 C 21640000 C 21650000 M = 1 21660000 COUNT = 0 21670000 DAC = 1 21680000 C 21690000 3140 CALL FORC (KPNA, KPRNO, DAC, CARD, * 3160 )21700000 IF ( .NOT. (S1CPCH (CARD, 8, 'FV2', 1, 3) .EQ. 0 .AND. 21710000 * S1CVBN (CARD, 11, 5) .EQ. IDFVP)) GO TO 3140 21720000 C 21730000 N = 21 21740000 DO 3150 JJJ = 1, 6 21750000 IF (S1CPCH (CARD, N, ' ', 1, 5) .EQ. 0) GO TO 3150 21760000 CALL USCHFT (CARD, N , 5, XCOM(M )) 21770000 CALL USCHFT (CARD, N + 5, 5, XCOM(M+1)) 21780000 COUNT = COUNT + 1 21790000 M = M + 2 21800000 3150 N = N + 10 21810000 C 21820000 GO TO 3140 21830000 C 21840000 3160 CONTINUE 21850000 C 21860000 NF = INT((XCOM(COUNT*2-1)-XCOM(1))/((500./LCPI)/(NFFT/2))) + 1 21870000 IF (NF .GT. NFMAX) NFMAX = NF 21880000 C 21890000 GO TO 3105 21900000 C 21910000 3170 IF (NOC .EQ. 0) GO TO 8020 21920000 C 21930000 NXSEMX = 30 21940000 FVPMAX = 50 21950000 LEN = NOSAMP + 190 21960000 C 21970000 NOWDS = 160 + 50 + 50 + LEN 21980000 NOWDS = NOWDS + 4*N2UMAX + 6*NFMAX + 2*NFMAX*N2UMAX + 21990000 * LEN*N2UMAX + 3*NXSEMX + 4*FVPMAX + 30 22000000 C 22010000 COM = (NFFT + 2) + 500 22020000 COM = COM * 4 22030000 C 22040000 IF (COM .LE. URBYTE) COM = 0 22050000 IF (COM .EQ. 0) GO TO 3180 22060000 SVCOM = COM 22070000 COM = COM - URBYTE 22080000 URBYTE = SVCOM 22090000 URKBYT = URBYTE / 1024 22100000 C 22110000 3180 CSIZE = (COM + NOWDS*4 + 1023) / 1024 22120000 C 22130000 C WRITE (IPR, 3190) CSIZE, COM, NOWDS, N2UMAX, NFMAX, NOSAMP 22140000 C3190 FORMAT(1X,' CSIZE, COM, NOWDS,N2UMAX, NFMAX, NOSAMP ',/, 22150000 C * 1X,6I7 ) 22160000 C 22170000 GO TO 9900 22180000 C 22190000 C ============== 22200000 C 38. PROCESS = FXIN 22210000 C ============== 22220000 C 22230000 C ======================================= 22240000 C SET THE REGION AND COMMON SIZE FOR FXIN 22250000 C ======================================= 22260000 C 22270000 3800 CONTINUE 22280000 CALL JSFXIN (KPNA, KPRNO, OCCUR, PSIZE, CSIZE, UCSIZE, ERCODE) 22290000 C 22300000 C TO CALCULATE UNRESERVED BLANK COMMON 22310000 C 22320000 COM = UCSIZE * 4 22330000 IF(COM .GT. URBYTE) THEN 22340000 SVCOM = COM 22350000 COM = COM - URBYTE 22360000 URBYTE = SVCOM 22370000 URKBYT = (URBYTE + 1023) / 1024 22380000 ELSE 22390000 COM = 0 22400000 ENDIF 22410000 C 22420000 CSIZE = (CSIZE * 4 + COM + 1023) / 1024 22430000 GO TO 9900 22440000 C 22450000 C ============== 22460000 C 39. PROCESS = EQMO 22470000 C ============== 22480000 C 22490000 C ======================================= 22500000 C SET THE REGION AND COMMON SIZE FOR EQMO 22510000 C ======================================= 22520000 C 22530000 3900 CONTINUE 22540000 CALL JSEQMO (KPNA, KPRNO, OCCUR, PSIZE, CSIZE, UCSIZE, ERCODE) 22550000 C 22560000 C TO CALCULATE UNRESERVED BLANK COMMON 22570000 C 22580000 COM = UCSIZE * 4 22590000 IF(COM .GT. URBYTE) THEN 22600000 SVCOM = COM 22610000 COM = COM - URBYTE 22620000 URBYTE = SVCOM 22630000 URKBYT = (URBYTE + 1023) / 1024 22640000 ELSE 22650000 COM = 0 22660000 ENDIF 22670000 C 22680000 CSIZE = (CSIZE * 4 + COM + 1023) / 1024 22690000 GO TO 9900 22700000 C 22710000 C 22720000 C 22730000 C ************* DO NOT ENTER NEXT PROCESS HERE ************** 22740000 C ASSOCIATED CODE FOR NEW PROCESSES SHOULD BE ADDED TO JSCOR4 22750000 C *********************************************************** 22760000 C 22770000 C 22780000 C 22790000 C 22800000 C 22810000 C 22820000 C 22830000 9800 ERCODE = 16 22840000 C 22850000 9900 RETURN 22860000 C 22870000 C ERROR MESSAGES 22880000 C 22890000 8000 WRITE (IPR, 9000) KPNA, KPRNO 22900000 GO TO 9800 22910000 C 22920000 8020 WRITE (IPR, 9020) KPNA, KPRNO 22930000 GO TO 9800 22940000 C 22950000 C 22960000 8030 WRITE (IPR, 9030) KPNA, KPRNO 22970000 GO TO 9800 22980000 C 22990000 9000 FORMAT (/' *** NO LINE OR ACCT CARD IN JSCORE FOR PROC = ', 23000000 * A4,I1) 23010000 C 23020000 9020 FORMAT (/' *** NO CARD PRESENT IN JSCORE FOR PROC = ',A4,I1) 23030000 C 23040000 9030 FORMAT (/' *** JSCORE CANNOT BE CALLED FOR PROCESS = ',A4,I1, 23050000 * ' WITHOUT PROCESS GM3D BEING REQUESTED ON PROC CARD ',///) 23060000 C 23070000 9040 FORMAT (F5.0) 23080000 C 23090000 C 23100000 C DEBUG UNIT(6),TRACE,INIT( 23110000 C * SUMGRP, MAXDPS,MAXSPS, MAXRVS, MAXTRC ) 23120000 C 23130000 C DEBUG UNIT(6),TRACE,INIT 23140000 C DEBUG UNIT(6),TRACE, 23150000 C * INIT(IPR,DA1,CDFI,CDFII,RCMIN,RCMAX,SUMGRP,NGRP, 23160000 C * COM, PSIZE, CSIZE, RVINC, RVADV, LINT, 23170000 C * STSPNO,SPNIBN, STFILE, ENFILE, SPADV , INKNTR, RCF1,RCF2,RCL1, 23180000 C * RCL2, KPRNO,KPNA, TEMP, MNRVI,MAXDPS,MAXSPS, MAXRVS, MAXTRC , 23190000 C * M,NSSP,MXNSSR,CRFLAG,DPFLAG) 23200000 C 23210000 C AT 1 23220000 C TRACE ON 23230000 C AT 100 23240000 C TRACE OFF 23250000 C 23260000 C 23270000 END 23280000