CTITLEJSCOR4 -- REGION AND BLANK COMMMON ALGORITHM 00010000 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA AUTHOR C. PARKER 00020000 CA DESIGNER R. MCMILLAN 00030000 CA LANGUAGE FORTRAN 00040000 CA SYSTEM IBM AND CRAY 00050000 CA WRITTEN 09-14-84 00060000 C REVISED 09-14-84 CMP. ADDED ENTRIES FOR CPRO, HZAD. 00070000 C ALSO MOVED R&D CATCH-ALL ENTRY (RNDX 00080000 C THRU CDPX) FROM JSCOR3. 00090000 C REVISED 09-19-84 ESN. ADDED ENTRIES FOR STOC. 00100000 C REVISED 09-27-84 ESN. MODIFIED ENTRY FOR STOC FOR DISK. 00110000 C REVISED 09-28-84 ESN. MODIFIED STOC FOR TRACE HEADER SAVE 00120000 C ON DISK. 00130000 C REVISED 11-13-84 TRA. ADDED ENTRIES FOR QCMP. 00140000 C REVISED 11-14-84 TRA. FIXED BUG. IPR WAS NOT DEFINED. 00150000 C REVISED 11-14-84 TRA. CHANGED DATA STATEMENTS TO INTEGER. 00160000 C REVISED 12-17-84 PKC. UPPED PSIZE OF CPRO & HZAD FOR UNI842. 00170000 C REVISED 03-18-85 RDK. ADDED 'VIS', 'IBM' AND 'AOG' SPARC 00180000 C SHELL SERIES FOR F. A. COADY. 00190000 C REVISED 03-22-85 LBL. ADDED ENTRY FOR CNAX. 00200000 C REVISED 05-15-85 RKG. REMOVED REFERENCES TO R&D PROCESSES 00210000 C AND THE SPC CARD. 00220000 C REVISED 05-13-85 TRA. FIXED BUG IN QCMP RESERVED AND SCRATCH.00230000 C REVISED 05-13-85 TRA. FIXED BUG IN CNAX RESERVED COMMON. 00240000 C REVISED 05-20-85 RKG. CHANGED TO ALLOW UNKNOWN PROCESS TO 00250000 C USE THE DEFAULT VALUES. 00260000 C REVISED 05-21 85 TRA. FIXED BUG IN QCMP RESERVED AND SCRATCH.00270000 C REVISED 05-22-85 TRA. FIXED BUG IN CNAX RESERVED AND SCRATCH.00280000 C REVISED 05-23-85 RDK. ADD ENTRY FOR DMFK (JDMO) ON CRAY. 00290000 C REVISED 06-06-85 RDK. ADD ENTRY FOR VSPI (GEOA) ON IBM. 00300000 C REVISED 06-18-85 ESN. ADD ENTRY FOR MI3D ON CRAY. 00310000 C REVISED 06-25-85 RDK. ADD ENTRIES FOR NMOD, TFAD, MGVA, 00320000 C VSPK, SWAT, CRAN, DD3D. 00330000 C REVISED 07-10-85 RKG. ADD ENTRY FOR RSQC. 00340000 C REVISED 07-24-85 RDK. ADD ENTRY FOR MIGK. 00350000 C REVISED 08-12-85 LBL. REWRIT ENTRY FOR PRODUCTION CNAX. 00360000 C REVISED 09-17-85 RDK. ADD ENTRY FOR WRPF. 00370000 C REVISED 11-13-85 BNM. ADD ENTRY FOR CMWD. 00380000 C REVISED 12-03-85 LBL. CHANGE ICC SIZE FOR NEW RESAMPLE 00390000 C SCHEME--DMFK. 00400000 C REVISED 12-17-85 RDK. ADD KMIG, OBIS, AND SWET (NEW). 00410000 C REVISED 01-07-86 LBL. REWRITE QCMP ENTRY FOR PRODUCTION 00420000 C REVISED 01-10-86 BNM. CHANGE ENTRY NAME CMWD TO COMD 00430000 C REVISED 01-30-86 RDK. MODIFY SWET FOR D, S, OR F MODES. 00440000 C REVISED 02-04-86 BNM ADD ENTRY FOR SMIG. 00450000 C REVISED 02-07-86 JBC ADD ENTRY FOR RTQC. 00460000 C REVISED 03-12-86 LBL DMFK PRODUCTION RELEASE 00470000 C REVISED 05-01-86 ESN/LBL. MODIFY STOC FOR PRODUCTION RELEASE.00480000 C REVISED 05-19-86 ESN/LBL. ADD IN PICK ENTRY. 00490000 C REVISED 06-06-86 DJP ADD ENTRY FOR BSUM AND REFF. 00500000 COADY REVISED 07-28-86 FAC ADDED JSRND ENTRY FOR SPARC DEVELOP- 00510000 C MENT PROCESSES. 00520000 C REVISED 08-05-86 RDK SWITCH ENTRIES FOR SWAT AND SWET. 00530000 C REVISED 09-10-86 REM. ADD RSIZE TO PARAMETER AND INCREASE 00540000 C PSIZE OF CNAX. 00550000 C REVISED 09-12-86 REP ADD AIED. 00560000 C REVISED 09-15-86 ESN INCREASE CSIZE OF PICK. 00570000 C REVISED 10-09-86 REM. MODIFY PSIZE FOR SMIG, QCMP, & WRPF. 00580000 C REVISED 10-09-86 PKC. MODIFY PSIZE FOR CPRO,HZAD (NEW UNIRAS)00590000 C REVISED 10-27-86 REP ADDED WORKFILES TO AIED 00600000 C REVISED 10-29-86 FAC. ADDED RSIZE PARAMETER TO JSRND CALL 00610000 C REVISED 11-18-86 ESN. ADD RSIZE TO TFAD. 00620000 C REVISED 11-24-86 REP. EXPAND COM ALLOCATION FOR AIED. 00630000 C REVISED 12-01-86 PKC. ADDED CPRO PROFILE OPTIONS. INCREASED 00640000 C PSIZE FOR HZAD, TFAD, & RTQC FOR NEW UNIRAS 00650000 C DRIVER (ADDED 600K). 00660000 C REVISED 12-10-86 ESN. DETERMINE SYSTEM BY STEP BEING EXECUTED00670000 C REVISED 12-31-86 MJM. ADD VCOR 00680000 C REVISED 01-22-87 PKC. MODIFY PSIZE FOR CPRO,HZAD (5.3 UNIRAS)00690000 C REVISED 02-04-87 ESN. ALLOCATE UNRESERVED BLANK COMMON FOR 00700000 C AP WORK AREA IN WRPF. 00710000 C REVISED 03-24-87 RDK. ADD ENTRY FOR TDIF. 00720000 C REVISED 04-01-87 PKC. ADD ENTRY FOR HPLT. 00730000 C REVISED 04-02-87 JMP. ADD ENTRY FOR LITH. 00740000 C REVISED 04-13-87 REM. DELETE OLD PROCESSES MGVA,SWET,RSQC,MIGK. 00750000 C CORRECT VCOR (DAWORK TO DAWRK). 00760000 C REVISED 04-21-87 MJM. MODIFY QCMP CALCULATION TO USE A LARGER 00770000 C T/Q (.06 --> .25) 00780000 C REVISED 05-14-87 PKC. MAKE CPRO LOOK AT THE DECIMATION FACTOR. 00790000 C ALSO CHECK FOR REGION TOO LARGE. 00800000 C REVISED 05-19-87 MJM. REMOVE SOME OLD DEBUG PRINT FROM CNAX. 00810000 C REVISED 06-05-87 DPH. MODIFY DATA STATEMENTS TO RUN ON CRAY; 00820000 C ALSO CHANGE C*4 DECLARATIONS TO INTEGER. 00830000 C REVISED 06-16-87 DPH. ADD /SYSTEM/ COMMON AND DELETE LOCAL 00840000 C INITIALIZATION OF PARAMETER "SYSTEM"; 00850000 C ALSO CHANGE SETTING OF IPR FROM 6 TO 98. 00860000 C REVISED 07-13-87 MJM. SIMPLIFY JSCOR ENTRY AND MODIFY FOR THE 00870000 C NEW VCOR OPTIONS. 00880000 C REVISED 07-14-87 CMP. FIX BUF2SZ COMPUTATION FOR CPRO ENTRY. 00890000 C REVISED 07-28-87 ESN. USE THE CRAY SIZE COMPUTATION FOR SMIG 00900000 C FOR ALL JOBS BECAUSE OF THE IBM TRI-D 00910000 C ESSL IMPLEMENTATION. 00920000 C REVISED 08-31-87 ESN. ADD ENTRY FOR SM3D. 00930000 C REVISED 09-22-87 REP. REVISE COM ALLOCATION FOR AIED. 00940000 C REVISED 12-04-87 LWC. ADDED TRACE LENGTH TO COMMON SPACE NEEDED 00950000 C FOR DMFK. 00960000 C REVISED 12-14-87 RDK. ADD MTCA. 00970000 C REVISED 01-11-88 ESN. MODIFY DMFK MAXIMUM MEMORY SO THAT 6500K 00980000 C IS USED ON CRAY AND 16000K ON THE IBM. 00990000 C REVISED 02-22-88 RDK. ADD CORA. 01000000 C REVISED 05-03-88 RDK. ADD TRAK. 01010000 C LWC. REVISE SPACE FOR LITH (ADD 2 TRACES). 01020000 C REVISED 05-09-88 TJT. CHANGE LCGRPI TO FLOATING POINT. 01030000 C REVISED 07-01-88 ESN. ADD UMIG. 01040000 C REVISED 07-07-88 DRS. ADD VSPW AND VSPV 01050000 C REVISED 07-22-88 JJC. ADD TFAN. 01060000 C REVISED 07-27-88 JJC. ADD MLRS. 01070000 C REVISED 08-26-88 JJC. ADD MPFK, VCFK, VFFK, AND VSFK. 01080000 C REVISED 10-24-88 JJC. ADD RAVE AND DM3D. 01090000 C REVISED 02-22-89 JJC. ADD CNAC, RAMR, ZM3D, AND AVEL. 01100000 C REVISED 05-04-89 LWC. ADD MORE SPACE FOR HZAD. 01110000 C REVISED 06-30-89 LWC. CHANGE WAY SPACE IS FOUND FOR HZAD. 01120000 C REVISED 07-12-89 LWC. ADD MORE SPACE (7500 WORDS) FOR CORA. 01130000 C REVISED 10-22-89 JJC. ADD AVOP. 01140000 C REVISED 11-13-89 RDK. FOR CFT77 COMPATIBILITY ON THE CRAY. 01150000 C REVISED 12-04-89 ESN. ENABLE INCROS PARAMETER FOR CPRO FOR 01160000 C IN-LINE OR CROSS-LINE PLOTTING. 01170000 C REVISED 05-09-90 CLJ CORRECT COMMON SPACE CALCULATION WHEN 01180000 C THE DEPTH POINT NUMBERS ARE DECREASING 01190000 C REVISED 07-18-90 CLJ ADD ENTRY FOR NEW PROCESSES ZM2D & EGEN 01200000 C REVISED 10-18-90 CLJ ADD ENTRY FOR NEW PROCESS PRCP 01210000 C REVISED 10-22-90 CLJ ADD ENTRY FOR NEW PROCESS FX3D 01220000 C REVISED 10-25-90 CLJ REVISE SPACE FOR TRAK WITHOUT REFERENCE TO 01230000 C TO VPSS REGION SIZE 01240000 C REVISED 08-02-91 ESN EXPAND HPLT CALCULATION TO INCLUDE DF18 IF 01250000 C DF6 IS BLANK. 01260000 C REVISED 12-17-91 JJC ADD ENTRY FOR NEW PROCESS VADM & VDDM. 01270000 C REVISED 12-31-91 CLJ ADD ENTRY FOR NEW PROCESSES SURF & SURG 01280000 C REVISED 01-04-92 JJC ADD 'PNR' AND 'PNE' OPTION IN TFAN 01290000 C REVISED 01-07-92 WRF ADD ENTRY FOR NEW PROCESS ANST 01300000 C REVISED 01-10-92 WRF ADD ENTRY FOR NEW PROCESS LMPA 01310000 C REVISED 01-23-92 JJC ADD ENTRY FOR NEW PROCESS TRIM 01320000 C REVISED 03-30-92 JJC ADD ENTRY FOR NEW PROCESS FF3D 01330000 C REVISED 06-04-92 WRF ADD ENTRY FOR NEW PROCESS XSMP 01340000 C REVISED 08-21-92 ESN ADD ENTRY FOR NEW PROCESS FF2D 01350000 CA 01360000 CA 01370000 CA CALL JSCOR4 (KPNA, KPRNO, OCCUR, BLKSIZ, PSIZE, CSIZE, RSIZE, 01380000 CA ERCODE, URBYTE, URKBYT) 01390000 CA 01400000 CA INPUT KPNA = PROCESS NAME A4 01410000 CA INPUT KPRNO = PROCESS NUMBER I4 01420000 CA INPUT OCCUR = OCCURRENCE NUMBER FOR PROCESS KPNA WITH I4 01430000 CA KPRNO 01440000 CA INPUT BLKSIZ= BLOCK SIZE (BYTES) I4 01450000 CA OUTPUT PSIZE = REGION SIZE OF PROGRAM IN K-BYTES I4 01460000 CA OUTPUT CSIZE = BLANK COMMON SIZE IN K-BYTES I4 01470000 CA OUTPUT RSIZE = EXTRA REGION SIZE IN K-BYTES I4 01480000 CA OUTPUT ERCODE= ERROR CODE (=16 IF NOT ABLE TO COMPUTE I4 01490000 CA THE REQUIRED PARAMETERS) 01500000 CA IN/OUT URBYTE= DYNAMICALLY REVISED UNRESERVED COMMON 01510000 CA REQUIRED BY INDIVIDUAL PROCESSES (BYTES) 01520000 CA IN/OUT URKBYT= DYNAMICALLY REVISED UNRESERVED COMMON 01530000 CA REQUIRED BY INDIVIDUAL PROCESSES(K-BYTES) 01540000 CA 01550000 CA 01560000 CA COMPUTES THE PROGRAM SIZE AND AMOUNT OF BLANK COMMON NEEDED FOR 01570000 CA PROCESSES REQUIRING SPECIAL CALCULATIONS. JSCOR4 IS AN EXTEN- 01580000 CA SION OF SUBROUTINE JSCOR3, WHICH CANNOT BE ENLARGED UNDER FORTH 01590000 CA (09-14-84). 01600000 C 01610000 C 01620000 C INTEGER ARRAYS -- LOCAL 01630000 C 01640000 C CARD(20) = DATA CARD ARRAY 01650000 C PROC(60) = PROCESS NAMES 01660000 C 01670000 C EJECT 01680000 C 01690000 SUBROUTINE JSCOR4 (KPNA, KPRNO, OCCUR, BLKSIZ, PSIZE, CSIZE, 01700000 * RSIZE, ERCODE, URBYTE, URKBYT) 01710000 C 01720000 IMPLICIT INTEGER (A-Z) 01730000 C 01740000 COMMON /SYSTEM/ SYSTEM 01750000 COMMON /SYSTEM/ SYBYPW 01760000 COMMON /SYSTEM/ SYLOCF 01770000 COMMON /SYSTEM/ JAPNMS 01780000 C 01790000 INTEGER JAPNMS (4) 01800000 C 01810000 C INTEGER ARRAYS -- LOCAL 01820000 C 01830000 INTEGER CARD (20) 01840000 DIMENSION ICOM (8000) 01850000 INTEGER PROC (65) 01860000 C 01870000 C CHARACTER CONSTANTS -- LOCAL 01880000 C 01890000 CHARACTER*5 BLANK 01900000 CHARACTER*80 CARD2 01910000 C 01920000 C LOGICAL CONSTANTS -- LOCAL 01930000 C 01940000 LOGICAL TRCCON 01950000 C 01960000 C INTEGER CONSTANTS -- LOCAL 01970000 C 01980000 INTEGER CRAY 01990000 INTEGER FCF 02000000 INTEGER IPR 02010000 INTEGER KPNA 02020000 INTEGER MIGRSV 02030000 INTEGER SYSTEM 02040000 INTEGER THL 02050000 C 02060000 C REAL CONSTANTS -- LOCAL 02070000 C 02080000 REAL DF 02090000 REAL FH 02100000 REAL FL 02110000 REAL LCGRPI 02120000 REAL PI 02130000 REAL SAMPSP 02140000 REAL TRLEN 02150000 C 02160000 C REAL ARRAYS--LOCAL 02170000 C 02180000 REAL XCOM (8000) 02190000 EQUIVALENCE ( XCOM(1), ICOM(1) ) 02200000 C 02210000 C REAL FUNCTION 02220000 C 02230000 REAL ALOG 02240000 REAL FLOAT 02250000 C 02260000 C DATA STATEMENTS 02270000 C 02280000 DATA PROC /'CPRO','HZAD','STOC','QCMP','CNAX', 02290000 * 'DMFK','VSPI','MI3D','NMOD','TFAD', 02300000 * 'TFAN','VSPK','CNAC','CRAN','DD3D', 02310000 * 'RTQC',' ','WRPF','COMD','OBIS', 02320000 * 'SWAT','KMIG','SMIG','UMIG','PICK', 02330000 * 'BSUM','REFF','AIED','VCOR','TDIF', 02340000 * 'HPLT','LITH','SM3D','MTCA','CORA', 02350000 * 'TRAK','VSPW','VSPV','MLRS','MPFK', 02360000 * 'VCFK','VFFK','VSFK','RAVE','DM3D', 02370000 * 'RAMR','ZM3D','AVEL','AVOP','ZM2D', 02380000 * 'EGEN','PRCP','FX3D','VADM','VDDM', 02390000 * 'SURF','SURG','ANST','LMPA','TRIM', 02400000 * 'FF3D','XSMP','FF2D',' ',' ' / 02410000 C 02420000 DATA BLANK / ' '/ 02430000 DATA CRAY / 'CRAY' / 02440000 DATA FCF / 1 / 02450000 DATA IPR / 98 / 02460000 DATA MIGRSV / 0 / 02470000 DATA PI / 3.1415926 / 02480000 DATA THL / 190 / 02490000 C 02500000 C INITIALIZATION 02510000 C 02520000 ERCODE = 0 02530000 IF (FCF .EQ. 0) GO TO 5 02540000 FCF = 0 02550000 C 02560000 C GET ACCT CARD DIST CODE 02570000 C 02580000 DA = 1 02590000 CALL FORC ('ACCT', 0, DA, CARD, * 8000 )02600000 CALL S1MVCH (CARD, 14, DIST, 3, 2) 02610000 C 02620000 C GET LINE CARD PARAMETERS 02630000 C 02640000 DA = 1 02650000 CALL FORC ('LINE', 0, DA, CARD, * 8000 )02660000 C 02670000 LCTPSP = S1CVBN (CARD, 36, 5) 02680000 LCMXFD = S1CVBN (CARD, 61, 5) 02690000 IF (LCMXFD .EQ. 0) LCMXFD = LCTPSP 02700000 CALL S1MVCH ('LS', 1, PMODE, 1, 2) 02710000 IF (S1CPCH (CARD, 6, ' ', 1, 1) .NE. 0) 02720000 * CALL S1MVCH (CARD, 6, PMODE, 1, 1) 02730000 IF (S1CPCH (CARD, 7, ' ', 1, 1) .NE. 0) 02740000 * CALL S1MVCH (CARD, 7, PMODE, 2, 1) 02750000 C 02760000 LCBGSP = S1CVBN (CARD, 11, 5) 02770000 LCENSP = S1CVBN (CARD, 16, 5) 02780000 LCNSP = S1CVBN (CARD, 31, 5) 02790000 RLENG = S1CVBN (CARD, 41, 5) 02800000 LCSI = S1CVBN (CARD, 46, 5) 02810000 LCPI = S1CVBN (CARD, 51, 5) 02820000 C MAKE LCGRPI FLOATING POINT 02830000 CC LCGRPI = S1CVBN (CARD, 56, 5) 02840000 CALL USCHFT (CARD, 56, 5, LCGRPI) 02850000 IF (LCPI .EQ. 0) GO TO 9800 02860000 NOSAMP = RLENG / LCPI 02870000 LCANSP = S1CVBN (CARD, 66, 5) 02880000 LCMXLN = S1CVBN (CARD, 71, 5) 02890000 IF (LCMXLN .EQ. 0) LCMXLN = 1 02900000 C 02910000 C FIND THE PROCESS 02920000 C ================ 02930000 C 02940000 5 IF (KPNA .EQ. PROC(1)) GO TO 100 02950000 IF (KPNA .EQ. PROC(2)) GO TO 200 02960000 IF (KPNA .EQ. PROC(3)) GO TO 300 02970000 IF (KPNA .EQ. PROC(4)) GO TO 400 02980000 IF (KPNA .EQ. PROC(5)) GO TO 500 02990000 IF (KPNA .EQ. PROC(6)) GO TO 600 03000000 IF (KPNA .EQ. PROC(7)) GO TO 700 03010000 IF (KPNA .EQ. PROC(8)) GO TO 800 03020000 IF (KPNA .EQ. PROC(9)) GO TO 900 03030000 IF (KPNA .EQ.PROC(10)) GO TO 1000 03040000 IF (KPNA .EQ.PROC(11)) GO TO 1100 03050000 IF (KPNA .EQ.PROC(12)) GO TO 1200 03060000 IF (KPNA .EQ.PROC(13)) GO TO 1300 03070000 IF (KPNA .EQ.PROC(14)) GO TO 1400 03080000 IF (KPNA .EQ.PROC(15)) GO TO 1500 03090000 IF (KPNA .EQ.PROC(16)) GO TO 1600 03100000 CREM1 IF (KPNA .EQ.PROC(17)) GO TO 1700 03110000 IF (KPNA .EQ.PROC(18)) GO TO 1800 03120000 IF (KPNA .EQ.PROC(19)) GO TO 1900 03130000 IF (KPNA .EQ.PROC(20)) GO TO 2000 03140000 IF (KPNA .EQ.PROC(21)) GO TO 2100 03150000 IF (KPNA .EQ.PROC(22)) GO TO 2200 03160000 IF (KPNA .EQ.PROC(23)) GO TO 2300 03170000 IF (KPNA .EQ.PROC(24)) GO TO 2300 03180000 IF (KPNA .EQ.PROC(25)) GO TO 2500 03190000 IF (KPNA .EQ.PROC(26)) GO TO 2600 03200000 IF (KPNA .EQ.PROC(27)) GO TO 2700 03210000 IF (KPNA .EQ.PROC(28)) GO TO 2800 03220000 IF (KPNA .EQ.PROC(29)) GO TO 2900 03230000 IF (KPNA .EQ.PROC(30)) GO TO 3000 03240000 IF (KPNA .EQ.PROC(31)) GO TO 3100 03250000 IF (KPNA .EQ.PROC(32)) GO TO 3200 03260000 IF (KPNA .EQ.PROC(33)) GO TO 3300 03270000 IF (KPNA .EQ.PROC(34)) GO TO 3400 03280000 IF (KPNA .EQ.PROC(35)) GO TO 3400 03290000 IF (KPNA .EQ.PROC(36)) GO TO 3600 03300000 IF (KPNA .EQ.PROC(37)) GO TO 3700 03310000 IF (KPNA .EQ.PROC(38)) GO TO 3800 03320000 IF (KPNA .EQ.PROC(39)) GO TO 3900 03330000 IF (KPNA .EQ.PROC(40)) GO TO 4000 03340000 IF (KPNA .EQ.PROC(41)) GO TO 4100 03350000 IF (KPNA .EQ.PROC(42)) GO TO 4200 03360000 IF (KPNA .EQ.PROC(43)) GO TO 4300 03370000 IF (KPNA .EQ.PROC(44)) GO TO 4400 03380000 IF (KPNA .EQ.PROC(45)) GO TO 4500 03390000 IF (KPNA .EQ.PROC(46)) GO TO 4600 03400000 IF (KPNA .EQ.PROC(47)) GO TO 4700 03410000 IF (KPNA .EQ.PROC(48)) GO TO 4800 03420000 IF (KPNA .EQ.PROC(49)) GO TO 4900 03430000 IF (KPNA .EQ.PROC(50)) GO TO 5000 03440000 IF (KPNA .EQ.PROC(51)) GO TO 5100 03450000 IF (KPNA .EQ.PROC(52)) GO TO 5200 03460000 IF (KPNA .EQ.PROC(53)) GO TO 5300 03470000 IF (KPNA .EQ.PROC(54)) GO TO 5400 03480000 IF (KPNA .EQ.PROC(55)) GO TO 5500 03490000 IF (KPNA .EQ.PROC(56)) GO TO 5600 03500000 IF (KPNA .EQ.PROC(57)) GO TO 5700 03510000 IF (KPNA .EQ.PROC(58)) GO TO 5800 03520000 IF (KPNA .EQ.PROC(59)) GO TO 5900 03530000 IF (KPNA .EQ.PROC(60)) GO TO 6000 03540000 IF (KPNA .EQ.PROC(61)) GO TO 6100 03550000 IF (KPNA .EQ.PROC(62)) GO TO 6200 03560000 IF (KPNA .EQ.PROC(63)) GO TO 6300 03570000 COADY 03580000 GO TO 9700 03590000 C 03600000 C 03610000 C 03620000 C 03630000 C ======================= 03640000 C 1. PROCESS = CPRO 03650000 C ======================= 03660000 C 03670000 C =========================================== 03680000 C COMPUTE THE REGION AND COMMON SIZE FOR CPRO 03690000 C =========================================== 03700000 C 03710000 C 03720000 C PSIZE IS LARGE BECAUSE IT INCLUDES THE SIZE FOR UNIRAS (2900) 03730000 100 PSIZE = 3025 03740000 NOC = 0 03750000 DA = 1 03760000 MXNDP = 0 03770000 MXLN = 0 03780000 BUF1SZ= 0 03790000 BUF2SZ= 0 03800000 BUF3SZ= 0 03810000 NW = 0 03820000 TIME = 0 03830000 RVEL = 0 03840000 DPTH = 0 03850000 IVEL = 0 03860000 C 03870000 110 CALL FORC (KPNA, KPRNO, DA, CARD, * 120 )03880000 IF ( S1CPCH(CARD,8,' ',1,3) .NE. 0 ) GO TO 110 03890000 NOC = NOC + 1 03900000 C 03910000 C COMPUTE THE MAXIMUM NUMBER OF DEPTH POINTS PER RANGE 03920000 C 03930000 SDP = S1CVBN(CARD, 11, 5) 03940000 EDP = S1CVBN(CARD, 16, 5) 03950000 IF (EDP .EQ. 0) EDP = SDP 03960000 NDP = EDP - SDP + 1 03970000 IF (NDP .GT. MXNDP) MXNDP = NDP 03980000 C 03990000 SLN = S1CVBN(CARD, 66, 5) 04000000 ELN = S1CVBN(CARD, 71, 5) 04010000 IF (ELN .EQ. 0) ELN = SLN 04020000 NLN = ELN - SLN + 1 04030000 IF (NLN .GT. MXLN) MXLN = NLN 04040000 GO TO 110 04050000 C 04060000 120 IF (NOC .EQ. 0) GO TO 8020 04070000 DA = 1 04080000 C 04090000 C CHECK FOR A V3D CARD AND COMPUTE CORE REQUIREMENTS 04100000 C 04110000 121 CALL FORC (KPNA, KPRNO, DA, CARD, * 126 )04120000 IF ( S1CPCH(CARD,8,'V3D',1,3) .NE. 0 ) GO TO 121 04130000 C 04140000 NRPL = 1 04150000 C 04160000 C COMPUTE THE NUMBER OF ANNOTATION BUFFERS REQUIRED FOR EACH LINE 04170000 C 04180000 DO 125 04190000 * I = 31, 35 04200000 C 04210000 IF (S1CPCH(CARD, 12, 'TIME', 1, 4) .NE. 0 .AND. 04220000 * S1CPCH(CARD, 12, 'ISTM', 1, 4) .NE. 0 .AND. 04230000 * S1CPCH(CARD, 12, 'ISVL', 1, 4) .NE. 0 .AND. 04240000 C * S1CPCH(CARD,I,'T',1,1) .EQ. 0) TIME = 1 04250000 * S1CPCH(CARD,1,'T',1,1) .EQ. 0) TIME = 1 04260000 C 04270000 IF (S1CPCH(CARD, 12, 'RVEL', 1, 4) .NE. 0 .AND. 04280000 * S1CPCH(CARD, 12, 'ISTM', 1, 4) .NE. 0 .AND. 04290000 * S1CPCH(CARD, 12, 'ISVL', 1, 4) .NE. 0 .AND. 04300000 C * S1CPCH(CARD,I,'V',1,1) .EQ. 0) RVEL = 1 04310000 * S1CPCH(CARD,1,'V',1,1) .EQ. 0) RVEL = 1 04320000 C 04330000 IF (S1CPCH(CARD, 12, 'DPTH', 1, 4) .NE. 0 .AND. 04340000 C * S1CPCH(CARD,I,'D',1,1) .EQ. 0) DPTH = 1 04350000 * S1CPCH(CARD,1,'D',1,1) .EQ. 0) DPTH = 1 04360000 C 04370000 IF (S1CPCH(CARD, 12, 'IVEL', 1, 4) .NE. 0 .AND. 04380000 C * S1CPCH(CARD,I,'I',1,1) .EQ. 0) IVEL = 1 04390000 * S1CPCH(CARD,1,'I',1,1) .EQ. 0) IVEL = 1 04400000 C 04410000 125 CONTINUE 04420000 C 04430000 126 NRPL = TIME + RVEL + DPTH + IVEL 04440000 C 04450000 130 CONTINUE 04460000 C 04470000 C COMPUTE THE NUMBER OF PLOTS TO BE GENERATED 04480000 C 04490000 MINP = S1CVBN(CARD, 66, 5) 04500000 MAXP = S1CVBN(CARD, 71, 5) 04510000 INCP = S1CVBN(CARD, 76, 5) 04520000 IF (MAXP .EQ. 0) MAXP = MINP 04530000 IF (INCP .EQ. 0) INCP = 1 04540000 NPLOTS = (MAXP - MINP) / INCP + 1 04550000 C 04560000 C COMPUTE THE SIZE OF THE BUFFER FOR HOLDING VALUES TO BE ANNOTATED 04570000 C 04580000 BUF1SZ = MXNDP * NPLOTS * NRPL 04590000 C 04600000 C COMPUTE THE SIZE OF THE BUFFER FOR CONTOURING 04610000 C 04620000 C 04630000 BUF2SZ = MXNDP * MXLN 04640000 C 04650000 MINCOL = S1CVBN (CARD, 46, 5) 04660000 MAXCOL = S1CVBN (CARD, 51, 5) 04670000 INCCOL = S1CVBN (CARD, 56, 5) 04680000 IF (INCCOL .EQ. 0) INCCOL = 100 04690000 NCOLOR = (MAXCOL - MINCOL) / INCCOL + 2 04700000 NW = (2*MXNDP*MXLN*NCOLOR)/32 + 1 04710000 C 04720000 132 DA = 1 04730000 C 04740000 C CHECK FOR A PRO CARD AND COMPUTE CORE REQUIREMENTS 04750000 C 04760000 133 CALL FORC (KPNA, KPRNO, DA, CARD, * 134 )04770000 IF ( S1CPCH(CARD,8,'PRO',1,3) .NE. 0 ) GO TO 133 04780000 C 04790000 C COMPUTE THE NUMBER OF BUFFERS REQUIRED FOR EACH LINE 04800000 C 04810000 NRPL = 0 04820000 IF (S1CPCH(CARD, 12, 'TIME', 1, 4) .NE. 0) NRPL = 1 04830000 C 04840000 BUF1SZ = NRPL * 22 * MXNDP 04850000 C 04860000 TYPEIN = 1 04870000 IF (S1CPCH(CARD, 16,' ', 1, 5) .EQ. 0) TYPEIN = 1 04880000 IF (S1CPCH(CARD, 17, 'VELF', 1, 4) .EQ. 0) TYPEIN = 1 04890000 IF (S1CPCH(CARD, 17, 'VF3D', 1, 4) .EQ. 0) TYPEIN = 2 04900000 IF (S1CPCH(CARD, 17, 'OTHR', 1, 4) .EQ. 0) TYPEIN = 1 04910000 DECFAC = S1CVBN (CARD, 76, 5) 04920000 IF (DECFAC .EQ. 0) DECFAC = 4 04930000 NVERTS = NOSAMP / DECFAC 04940000 C 04950000 INCROS = 0 04960000 IF (S1CVBN(CARD, 21, 5) .LT. 0) INCROS = 1 04970000 C 04980000 IF (TYPEIN .EQ. 1) BUF2SZ = NOSAMP + MXNDP*NVERTS + MXNDP 04990000 IF (TYPEIN .EQ. 2) THEN 05000000 IF (INCROS .EQ. 0) THEN 05010000 BUF2SZ = 2*MXNDP*22 + MXNDP*NVERTS 05020000 ELSE 05030000 BUF2SZ = 2*MXLN*22 + MXLN*NVERTS 05040000 ENDIF 05050000 ENDIF 05060000 C 05070000 MINCOL = S1CVBN (CARD, 46, 5) 05080000 MAXCOL = S1CVBN (CARD, 51, 5) 05090000 INCCOL = S1CVBN (CARD, 56, 5) 05100000 IF (INCCOL .EQ. 0) INCCOL = 100 05110000 NCOLOR = (MAXCOL - MINCOL) / INCCOL + 2 05120000 NW = (2*MXNDP*NVERTS*NCOLOR)/32 + 1 05130000 C 05140000 134 DA = 1 05150000 C 05160000 C CHECK FOR CTL CARD 05170000 C 05180000 135 CALL FORC (KPNA, KPRNO, DA, CARD, * 150 )05190000 IF ( S1CPCH(CARD,8,'CTL',1,3) .NE. 0 ) GO TO 135 05200000 C 05210000 C COMPUTE THE SIZE OF THE WORK AREA FOR 3D PERSPECTIVE PLOTS 05220000 C 05230000 SIZE = MAX(MXLN,MXNDP) 05240000 BUF3SZ = SIZE * 4 05250000 C 05260000 C CONVERT TO K-BYTES 05270000 C 05280000 150 CONTINUE 05290000 NWORDS = MAX(BUF1SZ,BUF2SZ) + BUF3SZ 05300000 CSIZE = 4 * NWORDS 05310000 COM = CSIZE 05320000 C 05330000 IF (COM .LE. URBYTE) COM = 0 05340000 IF (COM .EQ. 0) GO TO 160 05350000 SVCOM = COM 05360000 COM = COM - URBYTE 05370000 URBYTE = SVCOM 05380000 URKBYT = URBYTE / 1024 05390000 C 05400000 160 CSIZE = (COM + 1023)/1024 05410000 RSIZE = (NW*4 + 1023)/1024 + 300 05420000 IF (CSIZE+PSIZE+RSIZE .GT. 32000) THEN 05430000 WRITE (IPR, 9040) 05440000 GO TO 9800 05450000 ENDIF 05460000 C 05470000 GO TO 9900 05480000 C 05490000 C 05500000 C 05510000 C ======================= 05520000 C 2. PROCESS = HZAD 05530000 C ======================= 05540000 C 05550000 C =========================================== 05560000 C COMPUTE THE REGION AND COMMON SIZE FOR HZAD 05570000 C =========================================== 05580000 C 05590000 C 05600000 C PSIZE IS LARGE BECAUSE IT INCLUDES THE SIZE FOR UNIRAS (2900) 05610000 200 PSIZE = 3075 05620000 NOC = 0 05630000 DA = 1 05640000 MXNDP = 0 05650000 MXNTR = LCMXFD 05660000 MTRXSZ = 0 05670000 BUF1SZ = 0 05680000 C 05690000 210 CALL FORC (KPNA, KPRNO, DA, CARD, * 220 )05700000 IF ( S1CPCH(CARD,8,' ',1,3) .NE. 0 ) GO TO 210 05710000 NOC = NOC + 1 05720000 C 05730000 C COMPUTE THE MAXIMUM NUMBER OF DEPTH POINTS PER RANGE 05740000 C 05750000 SDP = S1CVBN(CARD, 11, 5) 05760000 EDP = S1CVBN(CARD, 16, 5) 05770000 IF (EDP .EQ. 0) EDP = SDP 05780000 C TAKE ABSOLUTE VALUE IN CASE 05790000 C WE HAVE DECREASING DP NUMBERS 05800000 NDP = ABS(EDP - SDP) + 1 05810000 IF (NDP .GT. MXNDP) MXNDP = NDP 05820000 IF (DA .NE. 2) GO TO 210 05830000 IF (S1CPCH (' ', 1, CARD, 7, 1) .EQ. 0) 05840000 * CALL S1MVCH (PMODE, 2, MODE, 4, 1) 05850000 IF (S1CPCH (' ', 1, CARD, 7, 1) .NE. 0) 05860000 * CALL S1MVCH (CARD, 7, MODE, 4, 1) 05870000 IF (S1CPCH (MODE, 4, 'S', 1, 1) .EQ. 0) MXNTR = LCTPSP 05880000 GO TO 210 05890000 C 05900000 220 IF (NOC .EQ. 0) GO TO 8020 05910000 MTRXSZ = MXNTR * MXNDP 05920000 DA = 1 05930000 C 05940000 C COMPUTE THE SIZE OF THE WORK AREA FOR 3D PERSPECTIVE PLOTS 05950000 C 05960000 230 CALL FORC (KPNA, KPRNO, DA, CARD, * 240 )05970000 IF (S1CPCH(CARD,8,'DSP',1,3) .NE. 0 ) GO TO 230 05980000 IF (S1CPCH(CARD,61,' ',1,15) .EQ. 0) GO TO 240 05990000 SIZE = MAX(MXNTR,MXNDP) 06000000 BUF1SZ = SIZE * 4 06010000 06020000 C 06030000 C CONVERT TO K-BYTES 06040000 C 06050000 240 CONTINUE 06060000 NWORDS = 2*NOSAMP + 2*MXNDP + 2*MTRXSZ + BUF1SZ + 160 06070000 CSIZE = 4 * NWORDS 06080000 COM = 0 06090000 C 06100000 IF (COM .LE. URBYTE) COM = 0 06110000 IF (COM .EQ. 0) GO TO 260 06120000 SVCOM = COM 06130000 COM = COM - URBYTE 06140000 URBYTE = SVCOM 06150000 URKBYT = URBYTE / 1024 06160000 C 06170000 C 06180000 260 CSIZE = (CSIZE + COM + 1023)/1024 06190000 C 06200000 GO TO 9900 06210000 C 06220000 C 06230000 C 06240000 C ======================= 06250000 C 3. PROCESS = STOC 06260000 C ======================= 06270000 C 06280000 C =========================================== 06290000 C COMPUTE THE REGION AND COMMON SIZE FOR STOC 06300000 C =========================================== 06310000 C 06320000 C 06330000 300 PSIZE = 20 06340000 NOC = 0 06350000 DA = 1 06360000 MNDP = 999999999 06370000 MXDP =-999999999 06380000 C 06390000 310 CALL FORC (KPNA, KPRNO, DA, CARD, * 320 )06400000 IF ( S1CPCH(CARD,8,' ',1,3) .NE. 0 ) GO TO 310 06410000 NOC = NOC + 1 06420000 C 06430000 C COMPUTE THE MAXIMUM DEPTH POINT RANGE 06440000 C 06450000 SDP = S1CVBN(CARD, 11, 5) 06460000 EDP = S1CVBN(CARD, 16, 5) 06470000 IXI = S1CVBN(CARD, 21, 5) 06480000 IF (EDP .EQ. 0) EDP = SDP 06490000 IF (SDP .LT. MNDP) MNDP = SDP 06500000 IF (EDP .GT. MXDP) MXDP = EDP 06510000 IF (IXI .EQ. 0) IXI = 1 06520000 C 06530000 NPRMAX = 1500 06540000 IF (S1CPCH (CARD, 56, ' ', 1, 5) .NE. 0) 06550000 * NPRMAX = S1CVBN (CARD, 56, 5) 06560000 C 06570000 NXMAX = 5000 06580000 IF (S1CPCH (CARD, 61, ' ', 1, 5) .NE. 0) 06590000 * NXMAX = S1CVBN (CARD, 61, 5) 06600000 C 06610000 NHMAX = 500 06620000 IF (S1CPCH (CARD, 66, ' ', 1, 5) .NE. 0) 06630000 * NHMAX = S1CVBN (CARD, 66, 5) 06640000 C 06650000 GO TO 310 06660000 C 06670000 320 IF (NOC .EQ. 0) GO TO 8020 06680000 C 06690000 C COMPUTE THE SIZE OF THE WORK AREA 06700000 C 06710000 NX = (MXDP - MNDP)/IXI + 1 06720000 NT = NOSAMP 06730000 NT1 = NT + 1 06740000 NX2 = NX + 2 06750000 NTNX = NT1 * NX2 06760000 C 06770000 NFILE = NTNX / (NPRMAX*1000) + 1 06780000 NPR = NTNX 06790000 IF (NFILE .EQ. 1) GO TO 330 06800000 NXFL = NX / NFILE + 1 06810000 NXFL2 = NXFL + 2 06820000 NPR = NXFL2 * NT1 06830000 330 CONTINUE 06840000 C 06850000 KA = THL + 1 06860000 KB = KA + NX2 06870000 KC = KB + NT 06880000 KD = KC + NT 06890000 KF = KD + NT 06900000 KE = KF + NT1 06910000 NWORDS = KE + NPR + 1 06920000 NWORDS = NWORDS + 3*NXMAX + NHMAX + THL + NOSAMP + 200 06930000 C 06940000 C CONVERT TO K-BYTES 06950000 C 06960000 CSIZE = 4 * NWORDS 06970000 C COM = CSIZE 06980000 COM = 0 06990000 C 07000000 IF (COM .LE. URBYTE) COM = 0 07010000 IF (COM .EQ. 0) GO TO 360 07020000 SVCOM = COM 07030000 COM = COM - URBYTE 07040000 URBYTE = SVCOM 07050000 URKBYT = URBYTE / 1024 07060000 C 07070000 C 07080000 360 CSIZE = (CSIZE + COM + 1023)/1024 07090000 C 07100000 GO TO 9900 07110000 C 07120000 C 07130000 C 07140000 C 07150000 C ======================= 07160000 C 4. PROCESS = QCMP 07170000 C ======================= 07180000 C 07190000 C =========================================== 07200000 C COMPUTE THE REGION AND COMMON SIZE FOR QCMP 07210000 C =========================================== 07220000 C 07230000 C REAL ARG XCOM(1) 07240000 C REAL DBDIF XCOM(2) 07250000 C REAL FH XCOM(3) 07260000 C REAL TOQINC XCOM(4) 07270000 C REAL TOQMX XCOM(5) 07280000 C REAL DT XCOM(6) 07290000 C 07300000 400 PSIZE = 35 07310000 C 07320000 C***** CALCULATE LENGTH OF FILTER 07330000 C 07340000 XCOM(6) = LCPI / 1000. 07350000 XCOM(3) = 1./(2.*XCOM(6)) 07360000 LFLTR = 200 07370000 NFPTS = LFLTR / LCPI 07380000 IF (MOD (NFPTS, 2) .EQ. 0) NFPTS = NFPTS - 1 07390000 C 07400000 C***** CALCULATE NUMBER OF FILTERS 07410000 C 07420000 XCOM(5) = 0.25 07430000 XCOM(2) = 1. 07440000 XCOM(1) = 10.0**(XCOM(2)/20.) 07450000 XCOM(4) = ALOG(XCOM(1)) / (PI*XCOM(3)) 07460000 NFLTR = INT(XCOM(5) / XCOM(4) + 0.5) 07470000 C 07480000 C***** FIND MAX NQ AND NCPT 07490000 C 07500000 NQMAX = 0 07510000 NCPTMX = 0 07520000 DAC = 1 07530000 420 CALL FORC (KPNA, KPRNO, DAC, CARD, *430) 07540000 IF (S1CPCH (CARD, 8, ' ', 1, 3) .NE. 0) GO TO 420 07550000 NQ = S1CVBN(CARD, 21, 5) 07560000 NCPT = S1CVBN(CARD, 46, 5) 07570000 IF (NQ .GT. NQMAX) NQMAX = NQ 07580000 IF (NCPT .GT. NCPTMX) NCPTMX = NCPT 07590000 GO TO 420 07600000 430 CONTINUE 07610000 C 07620000 C***** TOTAL RESERVED WORDS 07630000 C 07640000 NOWDS = NQMAX + NCPTMX*(NQMAX+1) + NFPTS*NFLTR + 3*4096 07650000 C 07660000 C***** UNRESERVED BLANK COMMON IS 4 TIMES N (DON'T CONFUSE WITH 4-BYTE) 07670000 C 07680000 CALL S1FMAG (NOSAMP, M, N) 07690000 COM = (1+1+1+1) * N 07700000 COM = 4 * N 07710000 C 07720000 IF (COM .LE. URBYTE) COM = 0 07730000 IF (COM .EQ. 0) GO TO 480 07740000 SVCOM = COM 07750000 COM = COM - URBYTE 07760000 URBYTE = SVCOM 07770000 URKBYT = URBYTE / 1024 07780000 C 07790000 480 CSIZE = (COM + 4*NOWDS + 1023) / 1024 07800000 C 07810000 GO TO 9900 07820000 C 07830000 C 07840000 C 07850000 C ======================= 07860000 C 5. PROCESS = CNAX 07870000 C ======================= 07880000 C 07890000 C =========================================== 07900000 C COMPUTE THE REGION AND COMMON SIZE FOR CNAX 07910000 C =========================================== 07920000 C 07930000 C 07940000 C REAL PCNT ====> XCOM(2) 07950000 C REAL VMN ====> XCOM(3) 07960000 C REAL VMX ====> XCOM(4) 07970000 C REAL DLV ====> XCOM(5) 07980000 C REAL FMN ====> XCOM(6) 07990000 C REAL FMX ====> XCOM(7) 08000000 C REAL DLF ====> XCOM(9) 08010000 C 08020000 500 CONTINUE 08030000 C 08040000 PSIZE = 31 08050000 C 08060000 DA = 1 08070000 510 CALL FORC(KPNA, KPRNO, DA, CARD, *8020) 08080000 IF (S1CPCH (CARD, 8, 'ANA', 1, 3) .NE. 0) GO TO 510 08090000 C 08100000 CALL USCHFT (CARD, 16, 5, XCOM(2)) 08110000 CALL USCHFT (CARD, 31, 5, XCOM(3)) 08120000 CALL USCHFT (CARD, 36, 5, XCOM(4)) 08130000 CALL USCHFT (CARD, 41, 5, XCOM(5)) 08140000 CALL USCHFT (CARD, 46, 5, XCOM(6)) 08150000 CALL USCHFT (CARD, 51, 5, XCOM(7)) 08160000 C 08170000 IF (XCOM(7) .GT. 500./LCPI) XCOM(7) = 500. / LCPI 08180000 NDUM = INT(NOSAMP * (100.+ XCOM(2)) / 100. + 0.5) 08190000 CALL S1FMAG (NDUM, M, N) 08200000 C 08210000 XCOM(9) = (500./LCPI)/(N/2) 08220000 C 08230000 540 IF1 = INT(XCOM(6) / XCOM(9)+0.0001) + 1 08240000 IFF = INT(XCOM(7) / XCOM(9)+0.0001) + 1 08250000 NF = IFF - IF1 + 1 08260000 IF (NF .LT. 300) GO TO 550 08270000 XCOM(9) = XCOM(9) * 2. 08280000 GO TO 540 08290000 550 CONTINUE 08300000 C 08310000 560 NV = INT((XCOM(4) - XCOM(3)) / XCOM(5) + 1.5) 08320000 IF (NV .LT. 250) GO TO 570 08330000 XCOM(5) = XCOM(5) * 2. 08340000 GO TO 560 08350000 570 CONTINUE 08360000 C 08370000 NOWDS = 3*NF*NV + 160 + 512 + 50 + 50 + 190 + NOSAMP 08380000 COM = (N + 2) + 100 08390000 COM = 4 * COM 08400000 C 08410000 IF (COM .LE. URBYTE) COM = 0 08420000 IF (COM .EQ. 0) GO TO 580 08430000 SVCOM = COM 08440000 COM = COM - URBYTE 08450000 URBYTE = SVCOM 08460000 URKBYT = URBYTE / 1024 08470000 C 08480000 580 CSIZE = (COM + 4*NOWDS + 1023) / 1024 08490000 08500000 C 08510000 GO TO 9900 08520000 C 08530000 C ======================= 08540000 C 6. PROCESS = DMFK 08550000 C ======================= 08560000 C 08570000 C =========================================== 08580000 C COMPUTE THE REGION AND COMMON SIZE FOR DMFK 08590000 C =========================================== 08600000 C 08610000 C 08620000 600 PSIZE = 100 08630000 NOC = 0 08640000 ND = 0 08650000 IFHI = 0 08660000 MEMORY = 0 08670000 DA = 1 08680000 C 08690000 610 CALL FORC (KPNA, KPRNO, DA, CARD, * 620 )08700000 IF ( S1CPCH(CARD,8,' ',1,3) .NE. 0 ) GO TO 610 08710000 NOC = NOC + 1 08720000 C 08730000 C COMPUTE THE MAXIMUM DEPTH POINT RANGE 08740000 C 08750000 NX = S1CVBN(CARD, 21, 5) 08760000 ND = S1CVBN(CARD, 41, 5) 08770000 IFHI = S1CVBN(CARD, 46, 5) 08780000 MEMORY = S1CVBN(CARD, 66, 5) 08790000 IF(ND .EQ. 0) ND = 20 08800000 IF(IFHI .EQ. 0) IFHI = 62 08810000 IF(MEMORY .EQ. 0) THEN 08820000 IF (S1CPCH(SYSTEM,1,'IBM',1,3) .EQ. 0) THEN 08830000 MEMORY = 16000 08840000 ELSE 08850000 MEMORY = 6500 08860000 ENDIF 08870000 ENDIF 08880000 C 08890000 IF(NX.GT.0) GO TO 610 08900000 N1 = S1CVBN(CARD, 11, 5) 08910000 N2 = S1CVBN(CARD, 16, 5) 08920000 NX = N2 - N1 + 1 08930000 GO TO 610 08940000 C 08950000 620 IF (NOC .EQ. 0) GO TO 8020 08960000 C 08970000 C COMPUTE THE SIZE OF THE WORK AREA 08980000 C THE NUMBER OF RESERVED WORDS OF COMMON 08990000 C 09000000 NS = NOSAMP 09010000 IFCTR=INT(500./FLOAT(LCPI)/IFHI) 09020000 IFCTR=2**IFIX(ALOG(FLOAT(IFCTR))/ALOG(2.)) 09030000 IFCTR=MAX0(IFCTR,1) 09040000 NT=NS/IFCTR 09050000 NT1=NT+1 09060000 ND1=ND+1 09070000 C 09080000 CALL S1FMAG(NT,N2W,NW) 09090000 NWO=NW*IFCTR 09100000 C 09110000 NFILE=1 09120000 MX=NX 09130000 C 09140000 630 CONTINUE 09150000 C 09160000 MX1=MX+1 09170000 N2KX=IFIX(ALOG(FLOAT(MX)*1.1)/ALOG(2.))+1 09180000 NKX = 2**N2KX 09190000 NKX2 = NKX+2 09200000 NKXD21= NKX/2+1 09210000 IF(NFILE.EQ.1) NKX0=NKX 09220000 C 09230000 KA=1 09240000 KB=KA+3*NKX+4 09250000 KK3=KB+5*NW 09260000 KK2=KK3+3*NW+4 09270000 KC=KB+5*NW 09280000 IF(IFCTR.NE.1) KC=KK2+3*NWO+4 09290000 KD=KC+NT 09300000 KE=KD+ND1 09310000 KF=KE+NKXD21 09320000 KG=KF+NT*NKX2 09330000 KH=KG+ND 09340000 KI=KH+NT*ND 09350000 KJ=KI+NT*ND 09360000 KK=KJ+MAX0(NKX2,NT1) 09370000 KL=KK+MAX0(NKX2,NT1) 09380000 KM=KL+NT 09390000 KN=KM+NT 09400000 KO=KN+NT 09410000 KP=KO+NT 09420000 KQ=KP+MAX0(2*NW,NKX2) 09430000 C 09440000 C ICC IS THE NUMBER OF RESERVED WORDS OF COMMON NEEDED 09450000 C 09460000 ICC=KQ + 2*NWO + NOSAMP + THL 09470000 C 09480000 KNRA=ICC*4/1024+1 09490000 C 09500000 C KNRA IS THE NUMBER OF RESERVED WORDS IN KILOBYTES 09510000 C 09520000 IF(KNRA .LT. MEMORY) GO TO 640 09530000 NFILE=NFILE+1 09540000 MX=INT(NKX0/1.1/NFILE)-1 09550000 GO TO 630 09560000 C 09570000 640 CONTINUE 09580000 C 09590000 NWORDS = ICC 09600000 C 09610000 C SET UP COMMON REQUIREMENTS 09620000 C 09630000 C CSIZE IS NUMBER OF BYTES OF RESERVED COMMON 09640000 C 09650000 CSIZE = 4 * NWORDS 09660000 C 09670000 C NO UNRESERVED COMMON NEEDED, SO SET UP A MINIMUM 09680000 C AMOUNT AT 500 WORDS 09690000 C 09700000 COM = 4 * 500 09710000 C 09720000 IF (COM .LE. URBYTE) COM = 0 09730000 IF (COM .EQ. 0) GO TO 660 09740000 SVCOM = COM 09750000 COM = COM - URBYTE 09760000 URBYTE = SVCOM 09770000 URKBYT = URBYTE / 1024 09780000 C 09790000 C 09800000 660 CSIZE = (CSIZE + COM + 1023)/1024 09810000 C 09820000 GO TO 9900 09830000 C 09840000 C ======================= 09850000 C 7. PROCESS = VSPI 09860000 C ======================= 09870000 C 09880000 C =========================================== 09890000 C ASSIGN THE REGION AND COMMON SIZE FOR VSPI 09900000 C =========================================== 09910000 C 09920000 C 09930000 700 PSIZE = 300 09940000 CSIZE = 20 09950000 GO TO 9900 09960000 C 09970000 C ======================= 09980000 C 8. PROCESS = MI3D 09990000 C ======================= 10000000 C 10010000 C =========================================== 10020000 C ASSIGN THE REGION AND COMMON SIZE FOR MI3D 10030000 C =========================================== 10040000 C 10050000 C 10060000 800 DA = 1 10070000 PSIZE = 30 10080000 CSIZE = BLKSIZ 10090000 C 10100000 CALL FORC (KPNA, KPRNO, DA, CARD, * 8020 )10110000 C 10120000 C PICK OFF PARAMETERS FROM PROCESS CARD 10130000 C 10140000 BCDP = S1CVBN (CARD, 11, 5) 10150000 ECDP = S1CVBN (CARD, 16, 5) 10160000 STEPSZ = S1CVBN (CARD, 31, 5) 10170000 IF (S1CPCH(CARD,31,' ',1,5) .EQ. 0) STEPSZ = 40 10180000 IBTL = S1CVBN (CARD, 36, 5) 10190000 IF (S1CPCH(CARD,36,' ',1,5) .EQ. 0) IBTL = 6 10200000 IBTR = S1CVBN (CARD, 41, 5) 10210000 IF (S1CPCH(CARD,41,' ',1,5) .EQ. 0) IBTR = 6 10220000 BLNN = S1CVBN (CARD, 66, 5) 10230000 ELNN = S1CVBN (CARD, 71, 5) 10240000 C 10250000 NXM = ECDP - BCDP + 1 10260000 NYM = ELNN - BLNN + 1 10270000 NTR = NXM 10280000 IF (S1CPCH(CARD,61,'YDIR',1,4) .EQ. 0) NTR = NYM 10290000 IF (S1CPCH(CARD,62,'YDIR',1,4) .EQ. 0) NTR = NYM 10300000 C 10310000 NB = NTR + IBTL + IBTR 10320000 NSAVE = 32 10330000 IF (NTR .LE. 16) NSAVE = 16 10340000 NI = 1500 / NSAVE 10350000 C 10360000 NBUF = (NB+NSAVE-1) / NSAVE 10370000 LBUF = NI * NSAVE 10380000 NBUFA = (NB+LBUF-1) / LBUF 10390000 C 10400000 CSIZE = CSIZE + 4 * NBUF * LBUF 10410000 TEMP = 4 * (NSAVE*NOSAMP + 13*NB + 2*NBUFA*LBUF + 420) 10420000 C 10430000 CSIZE = CSIZE + TEMP 10440000 CSIZE = (CSIZE + 1023) / 1024 10450000 C 10460000 GO TO 9900 10470000 C 10480000 C ======================= 10490000 C 9. PROCESS = NMOD 10500000 C ======================= 10510000 C 10520000 C =========================================== 10530000 C ASSIGN THE REGION AND COMMON SIZE FOR NMOD 10540000 C =========================================== 10550000 C 10560000 C 10570000 900 PSIZE = 60 10580000 CSIZE = (NOSAMP*40 + 4000 + 1023)/1024 10590000 GO TO 9900 10600000 C 10610000 C ======================= 10620000 C 10. PROCESS = TFAD 10630000 C ======================= 10640000 C 10650000 C =========================================== 10660000 C ASSIGN THE REGION AND COMMON SIZE FOR TFAD 10670000 C =========================================== 10680000 C 10690000 C 10700000 C PSIZE IS LARGE BECAUSE IT INCLUDES THE SIZE FOR UNIRAS (2400) 10710000 1000 PSIZE = 2600 10720000 RSIZE = 200 10730000 DA = 1 10740000 C 10750000 1010 CALL FORC (KPNA, KPRNO, DA, CARD, * 8020 )10760000 C 10770000 C PICK OFF PARAMETERS FROM PROCESS CARD 10780000 C 10790000 IF (S1CPCH(CARD,8,'ANA',1,3).NE.0) GO TO 1010 10800000 C 10810000 CALL USCHFT(CARD,21,5, FL ) 10820000 CALL USCHFT(CARD,26,5, FH ) 10830000 CALL USCHFT(CARD,31,5, DF ) 10840000 C 10850000 IF (FH.LE.0.) GO TO 8020 10860000 IF (DF.LE.0.) GO TO 8020 10870000 C 10880000 NFFT = INT(1000./(DF*LCPI)+0.01) 10890000 CALL S1FMAG (NFFT,NEXP,NFFT) 10900000 NDF = INT((FH-FL)*NFFT*LCPI/1000. + 1.05) 10910000 CSIZE = (940*NDF + 255)/256 10920000 C 10930000 GO TO 9900 10940000 C 10950000 C ======================= 10960000 C 11. PROCESS = TFAN 10970000 C ======================= 10980000 C 10990000 C =========================================== 11000000 C ASSIGN THE REGION AND COMMON SIZE FOR TFAN 11010000 C =========================================== 11020000 C 11030000 C 11040000 C PSIZE IS LARGE BECAUSE IT INCLUDES THE SIZE FOR UNIRAS (2900) 11050000 1100 PSIZE = 3000 11060000 DA = 1 11070000 NOC = 0 11080000 C 11090000 C X-AXIS PLOT SIZE MAX 50 INCHES, OR 50*25.4/0.8 PIXELS 11100000 C 11110000 PLTMAX = 50 * 25.4/0.8 11120000 C 11130000 C 11140000 1110 CALL FORC (KPNA, KPRNO, DA, CARD, * 1120 )11150000 IF (S1CPCH(CARD,8,' ',1,3) .NE. 0) GO TO 1110 11160000 NOC = NOC + 1 11170000 ITYPE = 0 11180000 IF (S1CPCH(CARD, 21, 'ANE', 1, 3) .EQ. 0) ITYPE = 1 11190000 IF (S1CPCH(CARD, 22, 'ANE', 1, 3) .EQ. 0) ITYPE = 1 11200000 IF (S1CPCH(CARD, 23, 'ANE', 1, 3) .EQ. 0) ITYPE = 1 11210000 C 11220000 IF (S1CPCH(CARD, 21, 'PNE', 1, 3) .EQ. 0) ITYPE = 1 11230000 IF (S1CPCH(CARD, 22, 'PNE', 1, 3) .EQ. 0) ITYPE = 1 11240000 IF (S1CPCH(CARD, 23, 'PNE', 1, 3) .EQ. 0) ITYPE = 1 11250000 C 11260000 1120 IF (NOC .EQ. 0) GO TO 8020 11270000 C 11280000 DA = 1 11290000 NOC = 0 11300000 1130 CALL FORC (KPNA, KPRNO, DA, CARD, * 1140 )11310000 C 11320000 C PICK OFF PARAMETERS FROM PROCESS CARD 11330000 C 11340000 IF (ITYPE .NE. 1) THEN 11350000 IF ( (S1CPCH(CARD,8,'ANR',1,3).NE.0 ) .AND. 11360000 + (S1CPCH(CARD,8,'PNR',1,3).NE.0 ) ) GO TO 1130 11370000 NOC = NOC + 1 11380000 ELSE 11390000 IF ( (S1CPCH(CARD,8,'ANE',1,3).NE.0 ) .AND. 11400000 + (S1CPCH(CARD,8,'PNE',1,3).NE.0 ) ) GO TO 1130 11410000 NOC = NOC + 1 11420000 ENDIF 11430000 C 11440000 IF (S1CPCH(CARD, 21, ' ', 1, 5) .EQ. 0) THEN 11450000 NFL = 0 11460000 ELSE 11470000 NFL = S1CVBN (CARD, 21, 5) 11480000 ENDIF 11490000 C 11500000 IF (S1CPCH(CARD, 26, ' ', 1, 5) .EQ. 0) THEN 11510000 NFH = 120 11520000 ELSE 11530000 NFH = S1CVBN (CARD, 26, 5) 11540000 ENDIF 11550000 C 11560000 IF (S1CPCH(CARD, 31, ' ', 1, 5) .EQ. 0) THEN 11570000 DF = 0.25 11580000 ELSE 11590000 CALL USCHFT (CARD, 31, 5, DF) 11600000 ENDIF 11610000 C 11620000 IF (S1CPCH(CARD, 46, ' ', 1, 5) .EQ. 0) THEN 11630000 WLEN = 200 11640000 ELSE 11650000 WLEN = S1CVBN (CARD, 46, 5) 11660000 ENDIF 11670000 C 11680000 IF (ITYPE .EQ. 1) THEN 11690000 IF (S1CPCH(CARD,61,' ',1,5) .EQ. 0) THEN 11700000 OFFNO = LCMXFD 11710000 ELSE 11720000 OFFNO = S1CVBN (CARD, 61, 5) 11730000 ENDIF 11740000 ENDIF 11750000 C 11760000 1140 IF (NOC .EQ. 0) GO TO 8020 11770000 IF (NFH.LE.0) GO TO 8020 11780000 IF (DF.LE.0.) GO TO 8020 11790000 C 11800000 NFFT = INT(1000./(DF*LCPI)+0.001) 11810000 CALL S1FMAG (NFFT,NEXP,NFFT) 11820000 NFFT2 = NFFT * 2 11830000 NPTS = WLEN / LCPI 11840000 NDF = INT((NFH-NFL+1)*NFFT*LCPI/1000. + 1.05) 11850000 IF (ITYPE .NE. 1) THEN 11860000 CSIZE = PLTMAX*NDF + NPTS*2 + PLTMAX 11870000 ELSE 11880000 CSIZE = PLTMAX*NDF + NPTS*2 + PLTMAX*OFFNO + OFFNO 11890000 ENDIF 11900000 C 11910000 C UNRESERVED BLANK COMMON 11920000 C 11930000 COM = (NFFT2 + NDF) * 4 11940000 IF (COM .GT. URBYTE) THEN 11950000 SVCOM = COM 11960000 COM = COM - URBYTE 11970000 URBYTE = SVCOM 11980000 URKBYT = (URBYTE + 1023) / 1024 11990000 ELSE 12000000 COM = 0 12010000 ENDIF 12020000 C 12030000 CSIZE = (CSIZE * 4 + COM + 1023) / 1024 12040000 GO TO 9900 12050000 C 12060000 C 12070000 C ======================= 12080000 C 12. PROCESS = VSPK 12090000 C ======================= 12100000 C 12110000 C =========================================== 12120000 C ASSIGN THE REGION AND COMMON SIZE FOR VSPK 12130000 C =========================================== 12140000 C 12150000 C 12160000 1200 PSIZE = 150 12170000 CSIZE = (1440 + BLKSIZ + 1023)/1024 12180000 GO TO 9900 12190000 C 12200000 C ======================= 12210000 C 13. PROCESS = CNAC 12220000 C ======================= 12230000 C 12240000 1300 CONTINUE 12250000 CALL JSCNAC (KPNA, KPRNO, OCCUR, PSIZE, CSIZE, UCSIZE, ERCODE) 12260000 C 12270000 C TO INCLUDE THE SIZE FOR UNIRAS (2900) 12280000 C 12290000 PSIZE = PSIZE + 2900 12300000 C 12310000 C TO CALCULATE UNRESERVED BLANK COMMON 12320000 C 12330000 COM = UCSIZE * 4 12340000 IF(COM .GT. URBYTE) THEN 12350000 SVCOM = COM 12360000 COM = COM - URBYTE 12370000 URBYTE = SVCOM 12380000 URKBYT = (URBYTE + 1023) / 1024 12390000 ELSE 12400000 COM = 0 12410000 ENDIF 12420000 C 12430000 CSIZE = (CSIZE * 4 + COM + 1023) / 1024 12440000 GO TO 9900 12450000 C 12460000 C ======================= 12470000 C 14. PROCESS = CRAN 12480000 C ======================= 12490000 C 12500000 C =========================================== 12510000 C ASSIGN THE REGION AND COMMON SIZE FOR CRAN 12520000 C =========================================== 12530000 C 12540000 C 12550000 1400 PSIZE = 300 12560000 CSIZE = 450 12570000 GO TO 9900 12580000 C 12590000 C 12600000 C 12610000 C ======================= 12620000 C 15. PROCESS = DD3D 12630000 C ======================= 12640000 C 12650000 C =========================================== 12660000 C COMPUTE THE REGION AND COMMON SIZE FOR DD3D 12670000 C =========================================== 12680000 C 12690000 C 12700000 1500 PSIZE = 20 12710000 DA = 1 12720000 NOC = 0 12730000 MNDP = 999999999 12740000 MXDP =-999999999 12750000 MNLN = 999999999 12760000 MXLN =-999999999 12770000 C 12780000 1510 CALL FORC (KPNA, KPRNO, DA, CARD, * 1520 )12790000 IF ( S1CPCH(CARD,8,' ',1,3) .NE. 0 ) GO TO 1510 12800000 C 12810000 C COMPUTE THE MAXIMUM DEPTH POINT RANGE 12820000 C 12830000 NOC = NOC + 1 12840000 C 12850000 SDP = S1CVBN(CARD, 11, 5) 12860000 EDP = S1CVBN(CARD, 16, 5) 12870000 IF (EDP .EQ. 0) EDP = SDP 12880000 IF (SDP .LT. MNDP) MNDP = SDP 12890000 IF (EDP .GT. MXDP) MXDP = EDP 12900000 C 12910000 SLN = S1CVBN(CARD, 66, 5) 12920000 ELN = S1CVBN(CARD, 71, 5) 12930000 IF (ELN .EQ. 0) ELN = SLN 12940000 IF (SLN .LT. MNLN) MNLN = SLN 12950000 IF (ELN .GT. MXLN) MXLN = ELN 12960000 C 12970000 GO TO 1510 12980000 C 12990000 1520 IF (NOC .EQ. 0) GO TO 8020 13000000 C 13010000 C COMPUTE THE SIZE OF THE WORK AREA 13020000 C 13030000 NL = MXLN - MNLN + 1 13040000 ND = MXDP - MNDP + 1 13050000 IF ( NL.EQ.1) NOWDS = 11*ND 13060000 IF ( NL.NE.1) NOWDS = 43*ND*NL + ND + NL 13070000 C 13080000 C CONVERT TO K-BYTES 13090000 C 13100000 CSIZE = 4 * NOWDS 13110000 COM = CSIZE 13120000 C 13130000 IF (COM .LE. URBYTE) COM = 0 13140000 IF (COM .EQ. 0) GO TO 1530 13150000 SVCOM = COM 13160000 COM = COM - URBYTE 13170000 URBYTE = SVCOM 13180000 URKBYT = URBYTE / 1024 13190000 C 13200000 C 13210000 1530 CSIZE = (COM + 1023)/1024 13220000 C 13230000 GO TO 9900 13240000 C 13250000 C 13260000 C ======================= 13270000 C 16. PROCESS = RSQC AND RTQC 13280000 C ======================= 13290000 C RSQC DELETED 4/13/87 13300000 C =========================================== 13310000 C COMPUTE THE REGION AND COMMON SIZE FOR RSQC 13320000 C =========================================== 13330000 C 13340000 C 13350000 C PSIZE IS LARGE BECAUSE IT INCLUDES THE SIZE FOR UNIRAS (2400) 13360000 1600 PSIZE = 3000 13370000 C CONVERT TO K-BYTES 13380000 C 13390000 CSIZE = 4 * 1024000 13400000 COM = CSIZE 13410000 C 13420000 IF (COM .LE. URBYTE) COM = 0 13430000 IF (COM .EQ. 0) GO TO 1630 13440000 SVCOM = COM 13450000 COM = COM - URBYTE 13460000 URBYTE = SVCOM 13470000 URKBYT = URBYTE / 1024 13480000 C 13490000 C 13500000 1630 CSIZE = (COM + 1023)/1024 13510000 C 13520000 GO TO 9900 13530000 C 13540000 C 13550000 C 13560000 C ======================= 13570000 C1700 17. PROCESS = MIGK - DELETED 4/13/87 13580000 C ======================= 13590000 C 13600000 C 13610000 C 13620000 C 13630000 C ======================= 13640000 C 18. PROCESS = WRPF 13650000 C ======================= 13660000 C 13670000 C =========================================== 13680000 C COMPUTE THE REGION AND COMMON SIZE FOR WRPF 13690000 C =========================================== 13700000 C 13710000 C 13720000 1800 PSIZE = 48 13730000 C 13740000 DA = 1 13750000 NOC = 0 13760000 NMX = 0 13770000 TRLEN = NOSAMP + THL 13780000 C 13790000 1810 CALL FORC (KPNA, KPRNO, DA, CARD, * 1820 )13800000 IF ( S1CPCH(CARD,8,' ',1,3) .NE. 0 ) GO TO 1810 13810000 C 13820000 C COMPUTE THE DEPTH POINT RANGE 13830000 C 13840000 NOC = NOC + 1 13850000 C 13860000 SDP = S1CVBN(CARD, 11, 5) 13870000 EDP = S1CVBN(CARD, 16, 5) 13880000 IF (EDP .EQ. 0) EDP = SDP 13890000 C 13900000 NOP = S1CVBN(CARD, 31, 5) 13910000 IF (NOP.EQ.0) NOP = 7 13920000 NMX = MAX0(NMX,NOP) 13930000 C 13940000 GO TO 1810 13950000 C 13960000 1820 IF (NOC.LE.0) GO TO 8020 13970000 C 13980000 C CALCULATE THE RESERVED COMMON REQUIREMENT 13990000 C 14000000 NWORDS = (NMX+1)*(TRLEN+4) + 14010000 * TRLEN + 14020000 * 2500 14030000 C 14040000 C CALCULATE THE UNRESERVED COMMON REQUIREMENT 14050000 C 14060000 COM = (NMX+8) * NOSAMP + 50000 + 5 * NOSAMP 14070000 COM = COM * 4 14080000 IF (COM .LE. URBYTE) COM = 0 14090000 IF (COM .EQ. 0) GO TO 1830 14100000 SVCOM = COM 14110000 COM = COM - URBYTE 14120000 URBYTE = SVCOM 14130000 URKBYT = URBYTE / 1024 14140000 C 14150000 1830 CSIZE = (COM + 4 * NWORDS + 1023) / 1024 14160000 C 14170000 GO TO 9900 14180000 C 14190000 C 14200000 C 14210000 C ======================= 14220000 C 19. PROCESS = COMD 14230000 C ======================= 14240000 C 14250000 C =========================================== 14260000 C COMPUTE THE REGION AND COMMON SIZE FOR COMD 14270000 C =========================================== 14280000 C 14290000 C 14300000 1900 PSIZE = 20 14310000 DA = 1 14320000 NOC = 0 14330000 C 14340000 1910 CALL FORC (KPNA, KPRNO, DA, CARD, * 8020 )14350000 IF ( S1CPCH(CARD,8,' ',1,3) .NE. 0 ) GO TO 1910 14360000 C 14370000 C 14380000 C COMPUTE THE SIZE OF THE RESERVED AREA 14390000 C 14400000 NOSPTS = LCNSP 14410000 NOPANS = LCNSP 14420000 BLOCK = 32760 14430000 LOCAL = 75 14440000 RANGE = 100 14450000 C 14460000 C CONVERT TO K-BYTES 14470000 C 14480000 COM = 6 * NOSPTS + 14490000 * THL + 14500000 * BLOCK + 14510000 * 3 * NOPANS + 14520000 * LOCAL + 14530000 * RANGE 14540000 C 14550000 C 14560000 CSIZE = (4*COM + 1023)/1024 14570000 C 14580000 GO TO 9900 14590000 C 14600000 C 14610000 C 14620000 C ======================= 14630000 C 20. PROCESS = OBIS 14640000 C ======================= 14650000 C 14660000 C =========================================== 14670000 C COMPUTE THE REGION AND COMMON SIZE FOR OBIS 14680000 C =========================================== 14690000 C 14700000 C 14710000 2000 PSIZE = 20 14720000 C 14730000 COM = 5*(BLKSIZ/4) + 5200 14740000 CSIZE = (4*COM + 1023)/1024 14750000 C 14760000 GO TO 9900 14770000 C 14780000 C 14790000 C 14800000 C ======================= 14810000 C 21. PROCESS = SWAT 14820000 C ======================= 14830000 C 14840000 C =========================================== 14850000 C COMPUTE THE REGION AND COMMON SIZE FOR SWAT 14860000 C =========================================== 14870000 C 14880000 C 14890000 2100 PSIZE = 15 14900000 DA = 1 14910000 C 14920000 2110 CALL FORC (KPNA, KPRNO, DA, CARD, * 8020 )14930000 IF ( S1CPCH(CARD,8,' ',1,3) .NE. 0 ) GO TO 2110 14940000 C 14950000 MAXTRC = MAX0(LCMXFD,LCTPSP) 14960000 C 14970000 IF ( S1CPCH(CARD,7,' ' ,1,1) .EQ. 0 ) MAXTRC = LCMXFD 14980000 IF ( S1CPCH(CARD,7,'D' ,1,1) .EQ. 0 ) MAXTRC = LCMXFD 14990000 IF ( S1CPCH(CARD,7,'S' ,1,1) .EQ. 0 ) MAXTRC = LCTPSP 15000000 C 15010000 NMX = MAXTRC + 4 15020000 COM = NMX*(BLKSIZ/4) + 200 15030000 CSIZE = (4*COM + 1023)/1024 15040000 C 15050000 GO TO 9900 15060000 C 15070000 C 15080000 C 15090000 C ======================= 15100000 C 22. PROCESS = KMIG 15110000 C ======================= 15120000 C 15130000 C =========================================== 15140000 C COMPUTE THE REGION AND COMMON SIZE FOR KMIG 15150000 C =========================================== 15160000 C 15170000 C 15180000 2200 PSIZE = 35 15190000 DA = 1 15200000 NOC = 0 15210000 C 15220000 2210 CALL FORC (KPNA, KPRNO, DA, CARD, * 8020 )15230000 IF ( S1CPCH(CARD,8,' ',1,3) .NE. 0 ) GO TO 2210 15240000 C 15250000 C COMPUTE THE MAXIMUM DEPTH POINT RANGE 15260000 C 15270000 NOC = NOC + 1 15280000 C 15290000 SDP = S1CVBN(CARD, 11, 5) 15300000 EDP = S1CVBN(CARD, 16, 5) 15310000 IF (EDP .EQ. 0) EDP = SDP 15320000 C 15330000 NOP = S1CVBN(CARD, 41, 5) 15340000 IF (NOP.EQ.0) NOP = 1 15350000 WGT = 1 15360000 IF (S1CPCH(CARD,56,'NOWGT',1,5).EQ.0) WGT=0 15370000 C 15380000 CALL S1FMAG ( NOSAMP, MAG, LFOUR ) 15390000 C 15400000 C 15410000 C COMPUTE THE SIZE OF THE RESERVED AREA 15420000 C 15430000 NOP1 = NOP + 1 15440000 NOP2 = 2*NOP + 1 15450000 C 15460000 C CONVERT TO K-BYTES 15470000 C 15480000 COM = 6*(BLKSIZ/4) + 15490000 * 2*LFOUR + 15500000 * WGT*NOP1*NOSAMP + 15510000 * NOP2*(BLKSIZ/4) + 15520000 * 1000 15530000 C 15540000 C 15550000 CSIZE = (4*COM + 1023)/1024 15560000 C 15570000 GO TO 9900 15580000 C 15590000 C 15600000 C ================================ 15610000 C 23. PROCESS = SMIG AND UMIG 15620000 C ================================ 15630000 C 15640000 C ==================================================== 15650000 C COMPUTE THE REGION AND COMMON SIZE FOR SMIG AND UMIG 15660000 C ==================================================== 15670000 C 15680000 C 15690000 2300 PSIZE = 20 15700000 CSIZE = BLKSIZ 15710000 DA = 1 15720000 MAX1 = -999999 15730000 MIN1 = 999999 15740000 IXMEM = 0 15750000 C 15760000 2310 CALL FORC (KPNA, KPRNO, DA, CARD, * 8020 )15770000 IF (S1CPCH(CARD,8,' ',1,3) .NE. 0) GO TO 2310 15780000 C 15790000 C DETERMINE NUMBER OF TRACES TO BE PROCESSED 15800000 C AT A TIME 15810000 C 15820000 SPT = S1CVBN (CARD, 11, 5) 15830000 EPT = S1CVBN (CARD, 16, 5) 15840000 IF (EPT .EQ. 0) EPT = SPT 15850000 IF (SPT .LT. MIN1) MIN1 = SPT 15860000 IF (SPT .GT. MAX1) MAX1 = SPT 15870000 IF (EPT .LT. MIN1) MIN1 = EPT 15880000 IF (EPT .GT. MAX1) MAX1 = EPT 15890000 NZT = S1CVBN (CARD, 36, 5) 15900000 IF (S1CPCH(CARD,36,' ',1,5) .EQ. 0) NZT = 24 15910000 2318 NSAVE = S1CVBN (CARD, 71, 5) 15920000 NI = S1CVBN (CARD, 76, 5) 15930000 DELTAZ = S1CVBN (CARD, 31, 5) 15940000 IF (S1CPCH(CARD,31,' ',1,5) .EQ. 0) DELTAZ = 20 15950000 DELTAZ = DELTAZ / LCPI 15960000 C 15970000 2320 CALL FORC (KPNA, KPRNO, DA, CARD, * 2330 )15980000 IF (S1CPCH(CARD,8,' ',1,3) .NE. 0) GO TO 2320 15990000 SPT = S1CVBN (CARD, 11, 5) 16000000 IF (SPT .LT. MIN1) MIN1 = SPT 16010000 IF (SPT .GT. MAX1) MAX1 = SPT 16020000 EPT = S1CVBN (CARD, 16, 5) 16030000 IF (EPT .EQ. 0) GO TO 2320 16040000 IF (EPT .LT. MIN1) MIN1 = EPT 16050000 IF (EPT .GT. MAX1) MAX1 = EPT 16060000 GO TO 2320 16070000 C 16080000 2330 NTR = MAX1 - MIN1 + 1 16090000 NB = NTR + 2 * NZT 16100000 IF (NSAVE .NE. 0) GO TO 2340 16110000 NSAVE = 32 16120000 IF (NTR .LE. 16) NSAVE = 16 16130000 2340 IF (NI .EQ. 0) NI = 1500 / NSAVE 16140000 NBUF = (NB + NSAVE - 1) / NSAVE 16150000 LBUF = NI * NSAVE 16160000 NBUFA = (NB + LBUF - 1) / LBUF 16170000 CSIZE = CSIZE + 4 * NBUF * LBUF 16180000 TEMP = 4 * (NSAVE*NOSAMP +13*NB + 2*NBUFA*LBUF + 420 + IXMEM) 16190000 IF (TEMP .LE. MIGRSV) GO TO 2350 16200000 CSIZE = CSIZE + TEMP - MIGRSV 16210000 MIGRSV = TEMP 16220000 C 16230000 C CONVERT TO K-BYTES 16240000 C 16250000 2350 CSIZE = (CSIZE + 1023) / 1024 16260000 GO TO 9900 16270000 C 16280000 C 16290000 C 16300000 C ======================= 16310000 C 25. PROCESS = PICK 16320000 C ======================= 16330000 C 16340000 C =========================================== 16350000 C COMPUTE THE REGION AND COMMON SIZE FOR PICK 16360000 C =========================================== 16370000 C 16380000 C 16390000 2500 PSIZE = 100 16400000 MXFOLD = LCTPSP 16410000 LEN = NOSAMP 16420000 TRL = THL + LEN 16430000 I20 = 20 16440000 I400 = I20*I20 16450000 NSEGMX = MXFOLD/5 16460000 NSEGMX = MIN0(7, NSEGMX) 16470000 NSHOT = 7 16480000 NSHOT = MIN0(NSHOT, 7) 16490000 NSHHF = NSHOT/2 16500000 NSHOT = 2*NSHHF + 1 16510000 C 16520000 C 16530000 IN10 = 1 16540000 C ----------------------------------- IHDR 16550000 IN11 = MXFOLD*LEN + IN10 16560000 C ----------------------------------- JSHT 16570000 IND1 = MXFOLD*THL + IN11 16580000 C ----------------------------------- EX 16590000 IND2 = MXFOLD*I400 + IND1 16600000 C ----------------------------------- T4,Y 16610000 IN22 = 3*I400 + IND2 16620000 C ----------------------------------- YY 16630000 IN23 = MAX0(MXFOLD, LEN) + IN22 16640000 C ----------------------------------- YC 16650000 IN24 = MAX0(MXFOLD*I400, LEN) + IN23 16660000 C ----------------------------------- T6 16670000 IN26 = MAX0(MXFOLD, I400) + IN24 16680000 C ----------------------------------- LPOS 16690000 IN27 = MXFOLD + IN26 16700000 C ----------------------------------- ILHT 16710000 IN28 = MXFOLD*I400 + IN27 16720000 C ----------------------------------- NPOS 16730000 IN29 = 3*I400 + IN28 16740000 C ----------------------------------- JJM 16750000 IN30 = MXFOLD + IN29 16760000 C ----------------------------------- TAP 16770000 IN31 = I20 + IN30 16780000 C ----------------------------------- RP1 16790000 IN45 = LEN + IN31 16800000 C ----------------------------------- IRP2 16810000 IN32 = I20 + IN45 16820000 C ----------------------------------- JM 16830000 IN43 = I20 + IN32 16840000 C ----------------------------------- IT2 16850000 IN33 = I20 + IN43 16860000 C ----------------------------------- ISHT 16870000 IN34 = MAX0(MXFOLD, I400) + IN33 16880000 C ----------------------------------- IT1 16890000 IN35 = MAX0(MXFOLD, I400) + IN34 16900000 C ----------------------------------- JPOS 16910000 IN36 = MXFOLD*I400 + IN35 16920000 C ----------------------------------- NSHT 16930000 IN37 = MAX0(MXFOLD, I400) + IN36 16940000 C ----------------------------------- MSHT 16950000 IN38 = 3*I400 + IN37 16960000 C ----------------------------------- SNR 16970000 IN39 = I20 + IN38 16980000 C ----------------------------------- KTR 16990000 IKTR = MXFOLD + IN39 17000000 C ----------------------------------- KT1 17010000 IKT1 = MXFOLD + IKTR 17020000 C ----------------------------------- THRESH 17030000 ITHR = MXFOLD + IKT1 17040000 C ----------------------------------- 17050000 IND5 = 2 + ITHR 17060000 C-----------------------------XCD 17070000 INXD = IND5 + TRL 17080000 C-----------------------------ILCD 17090000 INLD = INXD + NSEGMX 17100000 C ----------------------------XOFF 17110000 INXT = INLD + MXFOLD*NSHOT 17120000 C-----------------------------TIME 17130000 INX2 = INXT + MXFOLD*NSHOT*2 17140000 C-----------------------------X1 17150000 INX1 = INX2 + MXFOLD*NSHOT*2 17160000 C-----------------------------T1 17170000 INT1 = INX1 + MXFOLD*NSHOT*2 17180000 C ----------------------------T2 17190000 INT2 = INT1 + MXFOLD*NSHOT 17200000 C ----------------------------T3 17210000 INT3 = INT2 + MXFOLD*NSHOT 17220000 C-----------------------------XPOS 17230000 INXP = INT3 + MXFOLD 17240000 C-----------------------------NSTA 17250000 INNS = INXP + NSHOT 17260000 C-----------------------------ISPL 17270000 ISPL = INNS + NSHOT 17280000 C-----------------------------XNAR 17290000 IN25 = ISPL + 2*NSHOT 17300000 C-----------------------------XFAR 17310000 IN44 = IN25 + NSHOT 17320000 C-----------------------------ISXY 17330000 IN40 = IN44 + NSHOT 17340000 C-----------------------------X2 17350000 INXX = IN40 + 4*NSHOT 17360000 C-----------------------------XT 17370000 INTX = INXX + MXFOLD*NSHHF 17380000 C-----------------------------ISG 17390000 INS1 = INTX + MXFOLD 17400000 C-----------------------------X00 17410000 INI1 = INS1 + 2*NSHOT 17420000 C-----------------------------A00 17430000 INJ1 = INI1 + NSEGMX*2*NSHOT 17440000 C-----------------------------B00 17450000 INK1 = INJ1 + NSEGMX*2 17460000 C-----------------------------X0 17470000 INI0 = INK1 + NSEGMX*2 17480000 C-----------------------------A0 17490000 INJ0 = INI0 + NSEGMX 17500000 C-----------------------------B0 17510000 INK0 = INJ0 + NSEGMX 17520000 C-----------------------------IX 17530000 INX0 = INK0 + NSEGMX 17540000 C-----------------------------YJ 17550000 INYJ = INX0 + NSEGMX 17560000 C-----------------------------GK 17570000 INGK = INYJ + MXFOLD*NSHHF 17580000 C-----------------------------SXC 17590000 ISXC = INGK + NSEGMX 17600000 C-----------------------------SXC2 17610000 IXC2 = ISXC + NSEGMX 17620000 C-----------------------------SXCD 17630000 IXCD = IXC2 + NSEGMX 17640000 C-----------------------------SD 17650000 INSD = IXCD + NSEGMX 17660000 C-----------------------------JN 17670000 ININ = INSD + NSEGMX 17680000 C-----------------------------AL 17690000 INAL = ININ + NSEGMX + 1 17700000 C-----------------------------WK 17710000 INWK = INAL+MAX0((NSEGMX+1)*(NSEGMX+2)/2,(NSEGMX+6)*MXFOLD*NSHHF) 17720000 C-----------------------------WK1 17730000 IWK1 = INWK+MAX0((NSEGMX+1)*(NSEGMX+8)/2,2*(NSEGMX+3),MXFOLD*I20) 17740000 C-----------------------------IN 17750000 INDI = IWK1 + MAX0 ((NSEGMX+2)*2, MXFOLD*I20) 17760000 C-----------------------------AA 17770000 INDJ = INDI + NSEGMX 17780000 C-----------------------------BB 17790000 INDK = INDJ + NSEGMX 17800000 C-----------------------------X 17810000 INII = INDK + NSEGMX 17820000 C-----------------------------A 17830000 INJJ = INII + NSEGMX 17840000 C-----------------------------B 17850000 INKK = INJJ + NSEGMX 17860000 C----------------------------- 17870000 IND0 = INKK + NSEGMX 17880000 C 17890000 C 17900000 NWORDS = IND0 + MAX0(TRL, (3+NSEGMX+MXFOLD)*2+1) + 2000 17910000 C 17920000 C CONVERT TO K-BYTES 17930000 C 17940000 CSIZE = 4 * NWORDS 17950000 COM = CSIZE 17960000 C 17970000 IF (COM .LE. URBYTE) COM = 0 17980000 IF (COM .EQ. 0) GO TO 2510 17990000 SVCOM = COM 18000000 COM = COM - URBYTE 18010000 URBYTE = SVCOM 18020000 URKBYT = URBYTE / 1024 18030000 C 18040000 C 18050000 2510 CSIZE = (CSIZE + COM + 1023)/1024 18060000 C 18070000 GO TO 9900 18080000 C 18090000 C 18100000 C ============== 18110000 C 26. PROCESS = BSUM 18120000 C ============== 18130000 C 18140000 C =========================================== 18150000 C COMPUTE THE REGION AND COMMON SIZE FOR BSUM 18160000 C =========================================== 18170000 C 18180000 C 18190000 2600 DA = 1 18200000 NOC = 0 18210000 MAXBUF = 100000 18220000 MXSLCI = 0 18230000 MXSPSA = 0 18240000 MXNTBF = MAXBUF / NOSAMP 18250000 NWORDS = 0 18260000 SFLAG = 0 18270000 STATID = 0 18280000 C 18290000 2610 CALL FORC (KPNA, KPRNO, DA, CARD2, * 2620 )18300000 IF (S1CPCH (CARD2, 8, ' ', 1, 3) .NE. 0) GO TO 2610 18310000 NOC = NOC + 1 18320000 CALL USCHFT (CARD2, 31, 5, SLFTWD) 18330000 CALL USCHFT (CARD2, 36, 5, SRGTWD) 18340000 SLFTWD = ABS(SLFTWD) 18350000 SRGTWD = ABS(SRGTWD) 18360000 ISLOCI = S1CVBN (CARD2, 46, 5) 18370000 SSMI = S1CVBN (CARD2, 51, 5) 18380000 IF (CARD2(46:50) .EQ. BLANK(1:5)) ISLOCI = 1 18390000 IF (CARD2(51:55) .EQ. BLANK(1:5)) SSMI = 1 18400000 ISLOCI = IABS(ISLOCI) 18410000 NSPSA = INT((SLFTWD + SRGTWD) / (ISLOCI * SSMI) + 1.0) 18420000 IF (NSPSA .GT. MXSPSA) MXSPSA = NSPSA 18430000 IF (ISLOCI .GT. MXSLCI) MXSLCI = ISLOCI 18440000 IF (CARD2(76:80) .NE. BLANK(1:5)) STATID = S1CVBN (CARD2, 76, 5) 18450000 GO TO 2610 18460000 C 18470000 2620 IF (NOC .EQ. 0) GO TO 8020 18480000 C 18490000 C READ THE REC DATA CARD 18500000 C 18510000 DA = 1 18520000 MXRAPT = 0 18530000 MXRPRA = 0 18540000 C 18550000 2630 CALL FORC (KPNA, KPRNO, DA, CARD2, * 2640 )18560000 IF (S1CPCH (CARD2, 8, 'REC', 1, 3) .NE. 0) GO TO 2630 18570000 CALL USCHFT (CARD2, 31, 5, RLFTWD) 18580000 CALL USCHFT (CARD2, 36, 5, RRGTWD) 18590000 RLFTWD = ABS(RLFTWD) 18600000 RRGTWD = ABS(RRGTWD) 18610000 RCNTRI = S1CVBN (CARD2, 41, 5) 18620000 IRLOCI = S1CVBN (CARD2, 46, 5) 18630000 CALL USCHFT (CARD2, 51, 5, RSMI) 18640000 IF (CARD2(41:45) .EQ. BLANK(1:5)) RCNTRI = 1 18650000 IF (CARD2(46:50) .EQ. BLANK(1:5)) IRLOCI = 1 18660000 IF (CARD2(51:55) .EQ. BLANK(1:5)) RSMI = 1.0 18670000 NRAPTR = INT((RLFTWD + RRGTWD) / RCNTRI + 1.0) 18680000 NRPRA = INT((RLFTWD + RRGTWD) / (IABS(IRLOCI) * RSMI) + 1.0) 18690000 IF (NRAPTR .GT. MXRAPT) MXRAPT = NRAPTR 18700000 IF (NRPRA .GT. MXRPRA) MXRPRA = NRPRA 18710000 GO TO 2630 18720000 C 18730000 C READ THE WRK DATA CARD(S) 18740000 C 18750000 2640 IF (STATID .NE. 0) THEN 18760000 DA = 1 18770000 C 18780000 2650 CALL FORC (KPNA, KPRNO, DA, CARD2, * 2660 )18790000 IF (CARD2(8:10) .NE. 'WRK') GO TO 2650 18800000 IF (CARD2(18:20) .EQ. 'DIP') GO TO 2650 18810000 IF (STATID .NE. S1CVBN(CARD2, 11, 5)) GO TO 2650 18820000 C 18830000 C READ THE FIRST RECORD OF THE PERMANENT FILE FOR SIZE INFORMATION 18840000 C 18850000 DSN = S1CVBN (CARD2, 26, 10) 18860000 C 18870000 IF (DSN .GT. 0) THEN 18880000 CALL JSTXGL (KPNA, KPRNO, DSN, DIST, IPR, IER, ICOM) 18890000 IF (IER .EQ. -1) GO TO 9800 18900000 NWORDS = NWORDS + 2 * (ICOM(3) - ICOM(4) + 1) 18910000 GO TO 2650 18920000 C 18930000 C GET SIZE INFORMATION FROM THE CARD FOR AUX. TRACE PROCESSING 18940000 C 18950000 ELSE 18960000 MXIRCV = S1CVBN (CARD2, 51, 5) 18970000 MXISRC = S1CVBN (CARD2, 56, 5) 18980000 MXRRCV = S1CVBN (CARD2, 61, 5) 18990000 MXRSRC = S1CVBN (CARD2, 66, 5) 19000000 IF (MXISRC .EQ. 0) MXISRC = LCNSP 19010000 NWORDS = NWORDS + 2 * (MXIRCV + MXISRC + MXRRCV + MXRSRC) 19020000 END IF 19030000 C 19040000 END IF 19050000 C 19060000 C CALCULATE THE RESERVED COMMON REQUIREMENT 19070000 C 19080000 2660 MAXDA = MXSPSA * LCTPSP 19090000 NWORDS = NWORDS + 8 * NOSAMP + 4 * THL + LCNSP + 6 * 114 + 19100000 * 3 * 24 + (MXRAPT + 3) * MAXDA + 4 * MXSLCI + 5 * MXSPSA +19110000 * 4 * LCTPSP + LCNSP * LCTPSP + 130 + 200 19120000 C 19130000 C CALCULATE THE UNRESERVED COMMON REQUIREMENT 19140000 C 19150000 MXTPBF = MXRPRA * MXSPSA 19160000 IF (MXTPBF .GT. MXNTBF) MXTPBF = MXNTBF 19170000 IF (MXTPBF .LT. 1) MXTPBF = 1 19180000 COM = MXTPBF * (NOSAMP + 5) + 6 * NOSAMP 19190000 COM = COM * 4 19200000 IF (COM .LE. URBYTE) COM = 0 19210000 IF (COM .EQ. 0) GO TO 2670 19220000 SVCOM = COM 19230000 COM = COM - URBYTE 19240000 URBYTE = SVCOM 19250000 URKBYT = URBYTE / 1024 19260000 C 19270000 2670 CSIZE = (COM + 4 * NWORDS + 1023) / 1024 19280000 PSIZE = 25 19290000 GO TO 9900 19300000 C 19310000 C ======================= 19320000 C 27. PROCESS = REFF 19330000 C ======================= 19340000 C 19350000 C =========================================== 19360000 C COMPUTE THE REGION AND COMMON SIZE FOR REFF 19370000 C =========================================== 19380000 C 19390000 C 19400000 2700 CALL JSREFF (KPNA, KPRNO, IPR, THL, LCNSP, LCTPSP, LCPI, LCGRPI, 19410000 * URBYTE, URKBYT, PSIZE, CSIZE, IERR) 19420000 IF (IERR .NE. 0) GO TO 9800 19430000 GO TO 9900 19440000 C 19450000 C 19460000 C ======================= 19470000 C 28. PROCESS = AIED 19480000 C ======================= 19490000 C 19500000 C =========================================== 19510000 C COMPUTE THE REGION AND COMMON SIZE FOR AIED 19520000 C =========================================== 19530000 C 19540000 C 19550000 2800 PSIZE = 62 19560000 DA = 1 19570000 CALL FORC (KPNA, KPRNO, DA, CARD, *8020) 19580000 C READ PROCESS MODE 19590000 IF (S1CPCH (CARD, 7, ' ' , 1, 1) .EQ. 0) 19600000 * CALL S1MVCH (PMODE, 2, CARD, 7, 1) 19610000 IF (S1CPCH (CARD, 7, 'F' , 1, 1) .EQ. 0) NTR = LCTPSP 19620000 IF (S1CPCH (CARD, 7, 'S' , 1, 1) .EQ. 0) NTR = LCTPSP 19630000 IF (S1CPCH (CARD, 7, 'D' , 1, 1) .EQ. 0) NTR = LCMXFD 19640000 C FIND CORRECT ANA CARD 19650000 ANAID = S1CVBN(CARD, 11, 5) 19660000 2810 CALL FORC (KPNA, KPRNO, DA, CARD, *8020) 19670000 IF (S1CPCH (CARD, 8, 'ANA' , 1, 1) .NE. 0) GO TO 2810 19680000 C READ WINDOW LENGTH FOR ANALYSIS 19690000 WLEN = S1CVBN(CARD, 56, 5) / LCPI 19700000 IF(WLEN .EQ. 0) WLEN = 300 / LCPI 19710000 IF (WLEN .GT. NOSAMP) WLEN = NOSAMP 19720000 C READ ANALYSIS WINDOW TAPER LENGTH 19730000 TAPER = S1CVBN(CARD, 61, 5) 19740000 IF (TAPER .EQ. 0) THEN 19750000 TAPER = (WLEN * LCPI) / 10 19760000 IF (TAPER .GT. 100) TAPER = 100 19770000 END IF 19780000 TAPER = TAPER / LCPI 19790000 IF (NOSAMP .EQ. WLEN) TAPER = 0 19800000 C READ WINDOW OVERLAP PERCENTAGE 19810000 WOVLP = (S1CVBN(CARD, 66, 5)) 19820000 IF (WOVLP .EQ. 0) WOVLP = 50 19830000 C READ LAG SHIFT FOR CROSS CORRELATION OF AMPLITUDES AND FORCE ODD 19840000 SHIFT = (S1CVBN(CARD, 36, 5)) / LCPI 19850000 IF (SHIFT .EQ. 0) SHIFT = 10 / LCPI 19860000 C 19870000 NW = (NOSAMP - (WLEN*WOVLP/100)) / (WLEN*(100-WOVLP) / 100) 19880000 C 19890000 CALL S1FMAG (NOSAMP, FFTMAG, L4T) 19900000 CALL S1FMAG (WLNT, FFTMAG, L4W) 19910000 IF (L4T .GT. L4W*NW) THEN 19920000 L4M = L4T 19930000 ELSE 19940000 L4M = L4W * NW 19950000 END IF 19960000 COM =((THL+(3*L4M)+SHIFT) 19970000 + + (NTR*(7*2+(NW*3*2))) 19980000 + + (NTR*((7*2+1)+(NW*(3*2+1)))) )*4 19990000 IF (COM .GT. URBYTE) THEN 20000000 COM = COM - URBYTE 20010000 URBYTE = URBYTE + COM 20020000 URKBYT = (URBYTE+1023) / 1024 20030000 ELSE 20040000 COM = 0 20050000 END IF 20060000 CSIZE = NTR*((4+7) + (NW*(2+3))) 20070000 * + (L4T/2+1) + 2*NOSAMP + NW*WLEN 20080000 * + COM / 4 20090000 * + 200 20100000 CSIZE = (CSIZE*4 + 1023) / 1024 20110000 PSIZE = 200 20120000 C 20130000 GO TO 9900 20140000 C 20150000 C 20160000 C ======================= 20170000 C 29. PROCESS = VCOR 20180000 C ======================= 20190000 C 20200000 C =========================================== 20210000 C COMPUTE THE REGION AND COMMON SIZE FOR VCOR 20220000 C =========================================== 20230000 C 20240000 C 20250000 2900 CONTINUE 20260000 PSIZE=300 20270000 OPLEN = 300 20280000 NFAUX = 2000 20290000 SAMPSP = 1.0/LCPI 20300000 NMNPHL = OPLEN*SAMPSP 20310000 LCRL = RLENG 20320000 DA = 1 20330000 2910 CALL FORC (KPNA, KPRNO, DA, CARD, *8020) 20340000 IF (S1CPCH (CARD, 8, ' ' , 1, 1) .NE. 0) GO TO 2910 20350000 LENSWP = S1CVBN(CARD, 31, 5) 20360000 OUTPUT = S1CVBN(CARD, 41, 5) 20370000 IBIAS = S1CVBN(CARD, 46, 5) 20380000 MAXSHI = MAX(S1CVBN(CARD, 51, 5),500) * SAMPSP 20390000 NSWPTS = LENSWP*SAMPSP + 1 20400000 NSAMPS = LCRL/LCPI 20410000 C 20420000 C COMPUTE NSWPTS 20430000 C 20440000 NSWPTS = LENSWP*SAMPSP + 1 20450000 C 20460000 C COMPUTE LENFFT 20470000 C 20480000 CALL S1FMAG(NSAMPS+MAXSHI+IBIAS,IMAG,LENFFT) 20490000 C 20500000 C COMPUTE NOPTS 20510000 C 20520000 NOPTS = OPLEN * SAMPSP + 1 20530000 C 20540000 C COMPUTE NSAMPO 20550000 C 20560000 NSAMP1 = OUTPUT*SAMPSP 20570000 C 20580000 NLAGS = (NSAMPS - IBIAS - NSWPTS + 1) 20590000 NSAMP2 = NLAGS 20600000 C 20610000 NSAMPO = MAX(NSAMP1,NSAMP2) 20620000 C 20630000 C COMPUTE NPTS 20640000 C 20650000 NPTS = MAX(601,(LENFFT-2)/2) 20660000 C 20670000 C TOTAL THESE FOR TOTAL MEMORY NECESSARY 20680000 C 20690000 MTOT = NPTS + NOPTS + NSAMPO + NSWPTS 20700000 C WORK ARRAYS 20710000 * + 11*LENFFT 20720000 COM = MTOT*4 20730000 C 20740000 CSIZE = (2000 + COM + 1023)/1024 20750000 GO TO 9900 20760000 C 20770000 C 20780000 C ======================= 20790000 C 30. PROCESS = TDIF 20800000 C ======================= 20810000 C 20820000 C ======================================= 20830000 C SET THE REGION AND COMMON SIZE FOR TDIF 20840000 C ======================================= 20850000 C 20860000 C 20870000 3000 PSIZE = 10 20880000 COM = BLKSIZ + 1000 20890000 CSIZE = (COM + 1023)/1024 20900000 C 20910000 GO TO 9900 20920000 C 20930000 C ======================= 20940000 C 31. PROCESS = HPLT 20950000 C ======================= 20960000 C 20970000 C =========================================== 20980000 C COMPUTE THE REGION AND COMMON SIZE FOR HPLT 20990000 C =========================================== 21000000 C 21010000 C 21020000 C PSIZE IS LARGE BECAUSE IT INCLUDES THE SIZE FOR UNIRAS (2900) 21030000 3100 PSIZE = 2950 21040000 NSSP = LCNSP 21050000 NGPS = (LCNSP + LCTPSP) * 2 21060000 NDPS = NGPS 21070000 CSIZE = 8737 21080000 FLAG3D = 0 21090000 DA = 1 21100000 C 21110000 3110 CALL FORC (KPNA, KPRNO, DA, CARD2, *3120) 21120000 IF (S1CPCH (CARD2, 8, 'PRM' , 1, 3) .NE. 0) GO TO 3110 21130000 MAXNP = S1CVBN (CARD2, 11, 5) 21140000 IF (CARD2(12:15) .EQ. 'SHOT') MAXNP = NSSP 21150000 IF (CARD2(12:15) .EQ. 'RCVR') MAXNP = NGPS 21160000 IF (CARD2(12:15) .EQ. ' CDP') MAXNP = NDPS 21170000 IF (CARD2(12:15) .EQ. 'DPLN') MAXNP = NDPS * LCMXLN 21180000 IF (CARD2(12:15) .EQ. 'STRC') MAXNP = NSSP * LCTPSP 21190000 IF (CARD2(12:15) .EQ. 'DTRC') MAXNP = NDPS * LCMXFD 21200000 IF (CARD2(11:15) .EQ. ' ')MAXNP = S1CVBN(CARD2,71,10) 21210000 CSIZE = CSIZE + 3 * MAXNP 21220000 IF (CARD2(32:35) .EQ. 'GR3D') FLAG3D = 1 21230000 IF (CARD2(32:35) .EQ. 'CN3D') FLAG3D = 1 21240000 GO TO 3110 21250000 C CALCULATE UNRESERVED 21260000 3120 COM = FLAG3D * 80000 * 4 21270000 IF (COM .LE. URBYTE) COM = 0 21280000 IF (COM .EQ. 0) GO TO 3220 21290000 SVCOM = COM 21300000 COM = COM - URBYTE 21310000 URBYTE = SVCOM 21320000 URKBYT = (URBYTE+1023) / 1024 21330000 C 21340000 3220 CSIZE = (CSIZE * 4 + COM + 1023) / 1024 21350000 GO TO 9900 21360000 C 21370000 C ======================= 21380000 C 32. PROCESS = LITH 21390000 C ======================= 21400000 C 21410000 C =========================================== 21420000 C COMPUTE THE REGION AND COMMON SIZE FOR LITH 21430000 C =========================================== 21440000 C 21450000 C 21460000 3200 CONTINUE 21470000 C 21480000 PSIZE = 34 21490000 LOCAL = 70 21500000 NWCOM = 2 * LCTPSP * NOSAMP + LOCAL + 12 * NOSAMP + 3 * THL 21510000 CSIZE = (4 * NWCOM + 1023) / 1024 21520000 GO TO 9900 21530000 C 21540000 C ======================= 21550000 C 33. PROCESS = SM3D 21560000 C ======================= 21570000 C 21580000 C =========================================== 21590000 C ASSIGN THE REGION AND COMMON SIZE FOR SM3D 21600000 C =========================================== 21610000 C 21620000 C 21630000 3300 DA = 1 21640000 PSIZE = 30 21650000 CSIZE = BLKSIZ 21660000 C 21670000 CALL FORC (KPNA, KPRNO, DA, CARD, * 8020 )21680000 C 21690000 C PICK OFF PARAMETERS FROM PROCESS CARD 21700000 C 21710000 BCDP = S1CVBN (CARD, 11, 5) 21720000 ECDP = S1CVBN (CARD, 16, 5) 21730000 STEPSZ = S1CVBN (CARD, 31, 5) 21740000 IF (S1CPCH(CARD,31,' ',1,5) .EQ. 0) STEPSZ = 20 21750000 IBTL = S1CVBN (CARD, 36, 5) 21760000 IF (S1CPCH(CARD,36,' ',1,5) .EQ. 0) IBTL = 24 21770000 IBTR = S1CVBN (CARD, 41, 5) 21780000 IF (S1CPCH(CARD,41,' ',1,5) .EQ. 0) IBTR = 24 21790000 BLNN = S1CVBN (CARD, 66, 5) 21800000 ELNN = S1CVBN (CARD, 71, 5) 21810000 C 21820000 NXM = ECDP - BCDP + 1 21830000 NYM = ELNN - BLNN + 1 21840000 NTR = NXM 21850000 IF (S1CPCH(CARD,61,'YDIR',1,4) .EQ. 0) NTR = NYM 21860000 IF (S1CPCH(CARD,62,'YDIR',1,4) .EQ. 0) NTR = NYM 21870000 C 21880000 NB = NTR + IBTL + IBTR 21890000 NSAVE = 32 21900000 IF (NTR .LE. 16) NSAVE = 16 21910000 NI = 1500 / NSAVE 21920000 C 21930000 NBUF = (NB+NSAVE-1) / NSAVE 21940000 LBUF = NI * NSAVE 21950000 NBUFA = (NB+LBUF-1) / LBUF 21960000 C 21970000 CSIZE = CSIZE + 4 * NBUF * LBUF 21980000 TEMP = 4 * (NSAVE*NOSAMP + 13*NB + 2*NBUFA*LBUF + 420) 21990000 C 22000000 CSIZE = CSIZE + TEMP 22010000 CSIZE = (CSIZE + 1023) / 1024 22020000 C 22030000 GO TO 9900 22040000 C 22050000 C 22060000 C ======================= 22070000 C 34. PROCESS = MTCA OR CORA 22080000 C ======================= 22090000 C 22100000 C ======================================= 22110000 C SET THE REGION AND COMMON SIZE FOR MTCA 22120000 C ======================================= 22130000 C 22140000 C 22150000 3400 PSIZE = 50 22160000 CSIZE = 11690 + NOSAMP 22170000 C 22180000 TEMPO = 2*NOSAMP 22190000 CALL S1FMAG ( TEMPO,MAG,LFOUR ) 22200000 LFOUR = LFOUR+2 22210000 COM = 30*LFOUR 22220000 C 22230000 C CALCULATE UNRESERVED 22240000 COM = COM * 4 22250000 IF (COM .LE. URBYTE) COM = 0 22260000 IF (COM .EQ. 0) GO TO 3410 22270000 SVCOM = COM 22280000 COM = COM - URBYTE 22290000 URBYTE = SVCOM 22300000 URKBYT = (URBYTE+1023) / 1024 22310000 C 22320000 3410 CSIZE = (CSIZE * 4 + COM + 1023) / 1024 22330000 GO TO 9900 22340000 C 22350000 C ======================= 22360000 C 36. PROCESS = TRAK 22370000 C ======================= 22380000 C 22390000 C 22400000 C =========================================== 22410000 C COMPUTE THE REGION AND COMMON SIZE FOR TRAK 22420000 C =========================================== 22430000 C 22440000 C CHECK TRAK FLAG, IF SET PSIZE HAS BEEN COMPUTED 22450000 C ON A PREVIOUS CALL 22460000 C 22470000 3600 CONTINUE 22480000 C 22490000 PSIZE = 95 22500000 CSIZE = 0 22510000 CS = 0 22520000 MAXCS = 0 22530000 NOC = 0 22540000 NTRAKC = 0 22550000 DA = 1 22560000 MX2 = 1 22570000 SCGR = 999999 22580000 ECGR = -999999 22590000 MXDPPP = -999999 22600000 MAXMAX = -999999 22610000 MXNWIN = 0 22620000 MXOPER = 0 22630000 MAXSHF = 0 22640000 MXWLEN = 0 22650000 TRCCON = .FALSE. 22660000 AUXOUT = 0 22670000 TRAKIN = 0 22680000 C 22690000 C READ A TRAK CARD - GET MAX SHIFT, WINDOW ID, 22700000 C START AND END GATHER # 22710000 C 22720000 3640 CALL FORC (KPNA, KPRNO, DA, CARD, * 3670 )22730000 IF (S1CPCH (CARD, 8, ' ', 1, 3) .NE. 0) GO TO 3640 22740000 C 22750000 NTRAKC = NTRAKC + 1 22760000 NOC = NOC + 1 22770000 SHFT = S1CVBN (CARD, 46, 5) 22780000 IF (SHFT .GT. MAXSHF) MAXSHF = SHFT 22790000 WINID = 0 22800000 IF (S1CPCH (CARD, 21, ' NONE', 1, 5) .NE. 0) 22810000 *WINID = S1CVBN (CARD, 21, 5) 22820000 SGAT = S1CVBN (CARD, 11, 5) 22830000 EGAT = S1CVBN (CARD, 16, 5) 22840000 IF (EGAT .EQ. 0) EGAT = SGAT 22850000 GAT1 = MIN(SGAT,EGAT) 22860000 GAT2 = MAX(SGAT,EGAT) 22870000 IF (GAT1 .LT. SCGR) SCGR = GAT1 22880000 IF (GAT2 .GT. ECGR) ECGR = GAT2 22890000 IF (S1CPCH (CARD, 26, ' ', 1, 10) .NE. 0) TRAKIN = 1 22900000 DPPP = S1CVBN (CARD, 41, 5) 22910000 IF (S1CPCH (CARD, 41, ' ', 1, 5) .EQ. 0) DPPP = 3 22920000 IF (DPPP .GT. MXDPPP) MXDPPP = DPPP 22930000 FLTRID = S1CVBN (CARD, 51, 5) 22940000 IF (S1CPCH (CARD, 56, ' ONN', 1, 5) .EQ. 0) AUXOUT = 1 22950000 IF (TRCCON) GO TO 3650 22960000 C 22970000 C READ CON CARD TO GET CONSTANT PARAMETERS 22980000 C THERE SHOULD ONLY BE ONE OF THEM........ 22990000 C 23000000 23010000 DA2 = 1 23020000 3645 CALL FORC (KPNA, KPRNO, DA2, CARD, * 8020 )23030000 IF (S1CPCH(CARD, 8, 'CON', 1, 3) .NE. 0) GO TO 3645 23040000 MAXRS = S1CVBN (CARD, 36, 5) 23050000 IF (MAXRS .GT. MAXMAX) MAXMAX = MAXRS 23060000 PLTCOD = S1CVBN (CARD, 66, 5) 23070000 IF (S1CPCH (CARD, 66, ' ', 1, 5) .EQ. 0) PLTCOD = 1 23080000 IF (PLTCOD.NE.1) MX2 = 2 23090000 TRCCON = .TRUE. 23100000 C 23110000 C READ WIN CARD TO GET MAX # OF WINDOWS, MAX WINDOW 23120000 C LENGTH 23130000 C 23140000 3650 CONTINUE 23150000 IF (WINID .EQ. 0) GO TO 3640 23160000 C 23170000 DA3 = 1 23180000 3655 CALL FORC (KPNA, KPRNO, DA3, CARD, * 8020 )23190000 IF (S1CPCH(CARD, 8, 'WIN', 1, 3) .NE. 0) GO TO 3655 23200000 ID = S1CVBN (CARD, 11, 5) 23210000 IF (WINID .NE. ID) GO TO 3655 23220000 C 23230000 DO 3660 23240000 * J = 21, 60, 10 23250000 WINS = S1CVBN(CARD, J, 5) 23260000 WINE = S1CVBN(CARD, J+5, 5) 23270000 IF (WINS .EQ. 0 .AND. WINE .EQ. 0) GO TO 3662 23280000 WINLEN = WINE - WINS 23290000 WINLEN = IABS(WINLEN) 23300000 IF (MXWLEN .LT. WINLEN) MXWLEN = WINLEN 23310000 3660 CONTINUE 23320000 C 23330000 3662 NWIN = (J-21) / 10 23340000 IF (NWIN .GT. MXNWIN) MXNWIN = NWIN 23350000 C 23360000 IF (FLTRID .EQ. 0) GO TO 3640 23370000 C 23380000 C READ THE TZF CARD TO GET THE OPERATOR LENGTH 23390000 C 23400000 DA4 = 1 23410000 C 23420000 3665 CALL FORC (KPNA, KPRNO, DA4, CARD, * 8020 )23430000 IF (S1CPCH(CARD, 8, 'TZF', 1, 3) .NE. 0) GO TO 3665 23440000 IF (S1CVBN(CARD, 11, 5) .NE. FLTRID) GO TO 3665 23450000 LP = S1CVBN (CARD, 21, 5) 23460000 HP = S1CVBN (CARD, 26, 5) 23470000 OPER = S1CVBN (CARD, 36, 5) 23480000 IF (OPER .NE. 0) GO TO 3668 23490000 OPER = INT(20000.0 / (HP - LP + 1.0) + 0.5) 23500000 IF (OPER .LT. 300) OPER = 300 23510000 IF (OPER .GT. RLENG) OPER = RLENG 23520000 3668 IF (OPER .GT. MXOPER) MXOPER = OPER 23530000 GO TO 3640 23540000 C 23550000 C WAS THERE A CARD FOUND FOR THIS PROCESS # 23560000 C 23570000 3670 CONTINUE 23580000 IF (NOC.LE.0) GO TO 9800 23590000 C 23600000 CGRANG = ECGR - SCGR + 1 23610000 MAXNUM = MAXMAX 23620000 IF (MAXMAX .EQ. 0) MAXNUM = CGRANG + LCMXFD 23630000 LEN = NOSAMP + (MXOPER / LCPI) + 1 23640000 CALL S1FMAG (LEN, MAG, FFTLEN) 23650000 IF (FFTLEN .LT. 128) FFTLEN = 128 23660000 FFTLEN = FFTLEN + 2 23670000 PILOTL = (MXWLEN + 2 * MAXSHF) / LCPI + 2 23680000 CALL S1FMAG (PILOTL, MAG, FFTLN2) 23690000 IF (FFTLN2 .LT. 128) FFTLN2 = 128 23700000 FFTLN2 = FFTLN2 + 2 23710000 C 23720000 C CS = MAXIMUM UNRESERVED SPACE REQUIRED FOR ANY TRAK 23730000 C 23740000 MXNXCR = 1 23750000 IF (PLTCOD .EQ. 1) MXNXCR = 20 23760000 IF (MXNXCR .GT. LCMXFD) MXNXCR = LCMXFD 23770000 LEN = (MXNXCR + 1) * FFTLN2 23780000 IF (NOSAMP + 14 .GT. LEN) LEN = NOSAMP + 14 23790000 IF (FLTRID .NE. 0 .AND. FFTLEN .GT. LEN) LEN = FFTLEN 23800000 CS = MXNWIN * 7 * PILOTL + MXNWIN * MXNXCR * PILOTL 23810000 * + 4 * NOSAMP 23820000 * + 2 * (LCMXFD * MXNWIN) + LCMXFD + (LCMXFD+3) / 4 23830000 * + 4 * (CGRANG + MAXNUM) 23840000 * + 30 * (3 + MXDPPP) + 3 * THL + 40 + LEN 23850000 * + TRAKIN * 8192 23860000 * + AUXOUT * 2 * NOSAMP 23870000 IF (PLTCOD .EQ. 1) CS = CS + MXNXCR * MXNWIN * PILOTL 23880000 IF (CS .LT. 12*(CGRANG+MAXNUM)) CS = 12 * (CGRANG + MAXNUM) 23890000 IF (S1CPCH(SYSTEM, 1, IBM , 1, 4) .NE. 0) CS =CS + NOSAMP 23900000 MAXCS = CS 23910000 C 23920000 CSIZE = 200 + 750 + 10 * NTRAKC + 5 * (CGRANG + MAXNUM) 23930000 * + 24552 + CGRANG + 2 * LCNSP + (NOSAMP + THL) * (MX2*MXDPPP + 1) 23940000 * + 6 * MAXNUM + FFTLEN + 25 + 16007 23950000 * + (NOSAMP + THL) * CGRANG * AUXOUT 23960000 C 23970000 IF (MAXCS .LE. URBYTE/4) MAXCS = 0 23980000 IF (MAXCS .EQ. 0) GO TO 3695 23990000 SVCOM = MAXCS 24000000 MAXCS = MAXCS - URBYTE/4 24010000 URBYTE = SVCOM * 4 24020000 URKBYT = URBYTE / 1024 24030000 C 24040000 3695 CSIZE = (4 * (MAXCS + CSIZE) + 1023) / 1024 24050000 C 24060000 GO TO 9900 24070000 C 24080000 C ============== 24090000 C 37. PROCESS = VSPW 24100000 C ============== 24110000 C 24120000 C ======================================= 24130000 C SET THE REGION AND COMMON SIZE FOR VSPW 24140000 C ======================================= 24150000 C 24160000 3700 RCOM = 4*BLKSIZ + 1600 24170000 COM = 4*BLKSIZ 24180000 C 24190000 IF(COM .GT. URBYTE) THEN 24200000 SVCOM = COM 24210000 COM = COM - URBYTE 24220000 URBYTE = SVCOM 24230000 URKBYT = URBYTE/1024 24240000 ELSE 24250000 COM = 0 24260000 ENDIF 24270000 C 24280000 CSIZE = (RCOM + COM + 1023)/1024 24290000 GO TO 9900 24300000 C 24310000 C 24320000 C ============== 24330000 C 38. PROCESS = VSPV 24340000 C ============== 24350000 C 24360000 C ======================================= 24370000 C SET THE REGION AND COMMON SIZE FOR VSPV 24380000 C ======================================= 24390000 C 24400000 3800 RCOM = 4*BLKSIZ + 1600 24410000 COM = 4*BLKSIZ 24420000 C 24430000 IF(COM .GT. URBYTE) THEN 24440000 SVCOM = COM 24450000 COM = COM - URBYTE 24460000 URBYTE = SVCOM 24470000 URKBYT = URBYTE/1024 24480000 ELSE 24490000 COM = 0 24500000 ENDIF 24510000 C 24520000 CSIZE = (RCOM + COM + 1023)/1024 24530000 GO TO 9900 24540000 C 24550000 C 24560000 C ============== 24570000 C 39. PROCESS = MLRS 24580000 C ============== 24590000 C 24600000 C ======================================= 24610000 C SET THE REGION AND COMMON SIZE FOR MLRS 24620000 C ======================================= 24630000 C 24640000 3900 CONTINUE 24650000 CALL JSMLRS (KPNA, KPRNO, OCCUR, PSIZE, CSIZE, UCSIZE, ERCODE) 24660000 C 24670000 C TO INCLUDE THE SIZE FOR UNIRAS (2900) 24680000 C 24690000 PSIZE = PSIZE + 2900 24700000 C 24710000 C TO CALCULATE UNRESERVED BLANK COMMON 24720000 C 24730000 COM = UCSIZE * 4 24740000 IF(COM .GT. URBYTE) THEN 24750000 SVCOM = COM 24760000 COM = COM - URBYTE 24770000 URBYTE = SVCOM 24780000 URKBYT = (URBYTE + 1023) / 1024 24790000 ELSE 24800000 COM = 0 24810000 ENDIF 24820000 C 24830000 CSIZE = (CSIZE * 4 + COM + 1023) / 1024 24840000 GO TO 9900 24850000 C 24860000 C 24870000 C ============== 24880000 C 40. PROCESS = MPFK 24890000 C ============== 24900000 C 24910000 C ======================================= 24920000 C SET THE REGION AND COMMON SIZE FOR MPFK 24930000 C ======================================= 24940000 C 24950000 4000 CONTINUE 24960000 CALL JSMPFK (KPNA, KPRNO, OCCUR, PSIZE, CSIZE, UCSIZE, ERCODE) 24970000 C 24980000 C TO CALCULATE UNRESERVED BLANK COMMON 24990000 C 25000000 COM = UCSIZE * 4 25010000 IF(COM .GT. URBYTE) THEN 25020000 SVCOM = COM 25030000 COM = COM - URBYTE 25040000 URBYTE = SVCOM 25050000 URKBYT = (URBYTE + 1023) / 1024 25060000 ELSE 25070000 COM = 0 25080000 ENDIF 25090000 C 25100000 CSIZE = (CSIZE * 4 + COM + 1023) / 1024 25110000 GO TO 9900 25120000 C 25130000 C 25140000 C ============== 25150000 C 41. PROCESS = VCFK 25160000 C ============== 25170000 C 25180000 C ======================================= 25190000 C SET THE REGION AND COMMON SIZE FOR VCFK 25200000 C ======================================= 25210000 C 25220000 4100 CONTINUE 25230000 CALL JSVCFK (KPNA, KPRNO, OCCUR, PSIZE, CSIZE, UCSIZE, ERCODE) 25240000 C 25250000 C TO CALCULATE UNRESERVED BLANK COMMON 25260000 C 25270000 COM = UCSIZE * 4 25280000 IF(COM .GT. URBYTE) THEN 25290000 SVCOM = COM 25300000 COM = COM - URBYTE 25310000 URBYTE = SVCOM 25320000 URKBYT = (URBYTE + 1023) / 1024 25330000 ELSE 25340000 COM = 0 25350000 ENDIF 25360000 C 25370000 CSIZE = (CSIZE * 4 + COM + 1023) / 1024 25380000 GO TO 9900 25390000 C 25400000 C 25410000 C ============== 25420000 C 42. PROCESS = VFFK 25430000 C ============== 25440000 C 25450000 C ======================================= 25460000 C SET THE REGION AND COMMON SIZE FOR VFFK 25470000 C ======================================= 25480000 C 25490000 4200 CONTINUE 25500000 CALL JSVFFK (KPNA, KPRNO, OCCUR, PSIZE, CSIZE, UCSIZE, ERCODE) 25510000 C 25520000 C TO CALCULATE UNRESERVED BLANK COMMON 25530000 C 25540000 COM = UCSIZE * 4 25550000 IF(COM .GT. URBYTE) THEN 25560000 SVCOM = COM 25570000 COM = COM - URBYTE 25580000 URBYTE = SVCOM 25590000 URKBYT = (URBYTE + 1023) / 1024 25600000 ELSE 25610000 COM = 0 25620000 ENDIF 25630000 C 25640000 CSIZE = (CSIZE * 4 + COM + 1023) / 1024 25650000 GO TO 9900 25660000 C 25670000 C 25680000 C ============== 25690000 C 43. PROCESS = VSFK 25700000 C ============== 25710000 C 25720000 C ======================================= 25730000 C SET THE REGION AND COMMON SIZE FOR VSFK 25740000 C ======================================= 25750000 C 25760000 4300 CONTINUE 25770000 CALL JSVSFK (KPNA, KPRNO, OCCUR, PSIZE, CSIZE, UCSIZE, ERCODE) 25780000 C 25790000 C TO CALCULATE UNRESERVED BLANK COMMON 25800000 C 25810000 COM = UCSIZE * 4 25820000 IF(COM .GT. URBYTE) THEN 25830000 SVCOM = COM 25840000 COM = COM - URBYTE 25850000 URBYTE = SVCOM 25860000 URKBYT = (URBYTE + 1023) / 1024 25870000 ELSE 25880000 COM = 0 25890000 ENDIF 25900000 C 25910000 CSIZE = (CSIZE * 4 + COM + 1023) / 1024 25920000 GO TO 9900 25930000 C 25940000 C 25950000 C ============== 25960000 C 44. PROCESS = RAVE 25970000 C ============== 25980000 C 25990000 C ======================================= 26000000 C SET THE REGION AND COMMON SIZE FOR RAVE 26010000 C ======================================= 26020000 C 26030000 4400 CONTINUE 26040000 CALL JSRAVE (KPNA, KPRNO, OCCUR, PSIZE, CSIZE, UCSIZE, ERCODE) 26050000 C 26060000 C TO CALCULATE UNRESERVED BLANK COMMON 26070000 C 26080000 COM = UCSIZE * 4 26090000 IF(COM .GT. URBYTE) THEN 26100000 SVCOM = COM 26110000 COM = COM - URBYTE 26120000 URBYTE = SVCOM 26130000 URKBYT = (URBYTE + 1023) / 1024 26140000 ELSE 26150000 COM = 0 26160000 ENDIF 26170000 C 26180000 CSIZE = (CSIZE * 4 + COM + 1023) / 1024 26190000 GO TO 9900 26200000 C 26210000 C 26220000 C ============== 26230000 C 45. PROCESS = DM3D 26240000 C ============== 26250000 C 26260000 C ======================================= 26270000 C SET THE REGION AND COMMON SIZE FOR DM3D 26280000 C ======================================= 26290000 C 26300000 4500 CONTINUE 26310000 CALL JSDM3D (KPNA, KPRNO, OCCUR, PSIZE, CSIZE, UCSIZE, ERCODE) 26320000 C 26330000 C TO CALCULATE UNRESERVED BLANK COMMON 26340000 C 26350000 COM = UCSIZE * 4 26360000 IF(COM .GT. URBYTE) THEN 26370000 SVCOM = COM 26380000 COM = COM - URBYTE 26390000 URBYTE = SVCOM 26400000 URKBYT = (URBYTE + 1023) / 1024 26410000 ELSE 26420000 COM = 0 26430000 ENDIF 26440000 C 26450000 CSIZE = (CSIZE * 4 + COM + 1023) / 1024 26460000 GO TO 9900 26470000 C 26480000 C 26490000 C ============== 26500000 C 46. PROCESS = RAMR 26510000 C ============== 26520000 C 26530000 C ======================================= 26540000 C SET THE REGION AND COMMON SIZE FOR RAMR 26550000 C ======================================= 26560000 C 26570000 4600 CONTINUE 26580000 CALL JSRAMR (KPNA, KPRNO, OCCUR, PSIZE, CSIZE, UCSIZE, ERCODE) 26590000 C 26600000 C TO CALCULATE UNRESERVED BLANK COMMON 26610000 C 26620000 COM = UCSIZE * 4 26630000 IF(COM .GT. URBYTE) THEN 26640000 SVCOM = COM 26650000 COM = COM - URBYTE 26660000 URBYTE = SVCOM 26670000 URKBYT = (URBYTE + 1023) / 1024 26680000 ELSE 26690000 COM = 0 26700000 ENDIF 26710000 C 26720000 CSIZE = (CSIZE * 4 + COM + 1023) / 1024 26730000 GO TO 9900 26740000 C 26750000 C 26760000 C ============== 26770000 C 47. PROCESS = ZM3D 26780000 C ============== 26790000 C 26800000 C ======================================= 26810000 C SET THE REGION AND COMMON SIZE FOR ZM3D 26820000 C ======================================= 26830000 C 26840000 4700 CONTINUE 26850000 CALL JSZM3D (KPNA, KPRNO, OCCUR, PSIZE, CSIZE, UCSIZE, ERCODE) 26860000 C 26870000 C TO CALCULATE UNRESERVED BLANK COMMON 26880000 C 26890000 COM = UCSIZE * 4 26900000 IF(COM .GT. URBYTE) THEN 26910000 SVCOM = COM 26920000 COM = COM - URBYTE 26930000 URBYTE = SVCOM 26940000 URKBYT = (URBYTE + 1023) / 1024 26950000 ELSE 26960000 COM = 0 26970000 ENDIF 26980000 C 26990000 CSIZE = (CSIZE * 4 + COM + 1023) / 1024 27000000 GO TO 9900 27010000 C 27020000 C 27030000 C ============== 27040000 C 48. PROCESS = AVEL 27050000 C ============== 27060000 C 27070000 C ======================================= 27080000 C SET THE REGION AND COMMON SIZE FOR AVEL 27090000 C ======================================= 27100000 C 27110000 4800 CONTINUE 27120000 CALL JSAVEL (KPNA, KPRNO, OCCUR, PSIZE, CSIZE, UCSIZE, ERCODE) 27130000 C 27140000 C TO CALCULATE UNRESERVED BLANK COMMON 27150000 C 27160000 COM = UCSIZE * 4 27170000 IF(COM .GT. URBYTE) THEN 27180000 SVCOM = COM 27190000 COM = COM - URBYTE 27200000 URBYTE = SVCOM 27210000 URKBYT = (URBYTE + 1023) / 1024 27220000 ELSE 27230000 COM = 0 27240000 ENDIF 27250000 C 27260000 CSIZE = (CSIZE * 4 + COM + 1023) / 1024 27270000 GO TO 9900 27280000 C ============== 27290000 C 49. PROCESS = AVOP 27300000 C ============== 27310000 C 27320000 C ======================================= 27330000 C SET THE REGION AND COMMON SIZE FOR AVOP 27340000 C ======================================= 27350000 C 27360000 4900 CONTINUE 27370000 CALL JSAVOP (KPNA, KPRNO, OCCUR, PSIZE, CSIZE, UCSIZE, ERCODE) 27380000 C 27390000 C TO INCLUDE THE SIZE FOR UNIRAS (2900) 27400000 C 27410000 PSIZE = PSIZE + 2900 27420000 C 27430000 C TO CALCULATE UNRESERVED BLANK COMMON 27440000 C 27450000 COM = UCSIZE * 4 27460000 IF(COM .GT. URBYTE) THEN 27470000 SVCOM = COM 27480000 COM = COM - URBYTE 27490000 URBYTE = SVCOM 27500000 URKBYT = (URBYTE + 1023) / 1024 27510000 ELSE 27520000 COM = 0 27530000 ENDIF 27540000 C 27550000 CSIZE = (CSIZE * 4 + COM + 1023) / 1024 27560000 GO TO 9900 27570000 C 27580000 C 27590000 C ============== 27600000 C 50. PROCESS = ZM2D 27610000 C ============== 27620000 C 27630000 C ======================================= 27640000 C SET THE REGION AND COMMON SIZE FOR ZM2D 27650000 C ======================================= 27660000 C 27670000 5000 CONTINUE 27680000 CALL JSZM2D (KPNA, KPRNO, OCCUR, PSIZE, CSIZE, UCSIZE, ERCODE) 27690000 C 27700000 C TO CALCULATE UNRESERVED BLANK COMMON 27710000 C 27720000 COM = UCSIZE * 4 27730000 IF(COM .GT. URBYTE) THEN 27740000 SVCOM = COM 27750000 COM = COM - URBYTE 27760000 URBYTE = SVCOM 27770000 URKBYT = (URBYTE + 1023) / 1024 27780000 ELSE 27790000 COM = 0 27800000 ENDIF 27810000 C 27820000 CSIZE = (CSIZE * 4 + COM + 1023) / 1024 27830000 GO TO 9900 27840000 C 27850000 C 27860000 C ============== 27870000 C 51. PROCESS = EGEN 27880000 C ============== 27890000 C 27900000 C ======================================= 27910000 C SET THE REGION AND COMMON SIZE FOR EGEN 27920000 C ======================================= 27930000 C 27940000 5100 CONTINUE 27950000 CALL JSEGEN (KPNA, KPRNO, OCCUR, PSIZE, CSIZE, UCSIZE, ERCODE) 27960000 C 27970000 C TO CALCULATE UNRESERVED BLANK COMMON 27980000 C 27990000 COM = UCSIZE * 4 28000000 IF(COM .GT. URBYTE) THEN 28010000 SVCOM = COM 28020000 COM = COM - URBYTE 28030000 URBYTE = SVCOM 28040000 URKBYT = (URBYTE + 1023) / 1024 28050000 ELSE 28060000 COM = 0 28070000 ENDIF 28080000 C 28090000 CSIZE = (CSIZE * 4 + COM + 1023) / 1024 28100000 GO TO 9900 28110000 C 28120000 C 28130000 C ============== 28140000 C 52. PROCESS = PRCP 28150000 C ============== 28160000 C 28170000 C ======================================= 28180000 C SET THE REGION AND COMMON SIZE FOR PRCP 28190000 C ======================================= 28200000 C 28210000 5200 CONTINUE 28220000 CALL JSPRCP (KPNA, KPRNO, OCCUR, PSIZE, CSIZE, UCSIZE, ERCODE) 28230000 C 28240000 C TO CALCULATE UNRESERVED BLANK COMMON 28250000 C 28260000 COM = UCSIZE * 4 28270000 IF(COM .GT. URBYTE) THEN 28280000 SVCOM = COM 28290000 COM = COM - URBYTE 28300000 URBYTE = SVCOM 28310000 URKBYT = (URBYTE + 1023) / 1024 28320000 ELSE 28330000 COM = 0 28340000 ENDIF 28350000 C 28360000 CSIZE = (CSIZE * 4 + COM + 1023) / 1024 28370000 GO TO 9900 28380000 C 28390000 C 28400000 C ============== 28410000 C 53. PROCESS = FX3D 28420000 C ============== 28430000 C 28440000 C ======================================= 28450000 C SET THE REGION AND COMMON SIZE FOR FX3D 28460000 C ======================================= 28470000 C 28480000 5300 CONTINUE 28490000 CALL JSFX3D (KPNA, KPRNO, OCCUR, PSIZE, CSIZE, UCSIZE, ERCODE) 28500000 C 28510000 C TO CALCULATE UNRESERVED BLANK COMMON 28520000 C 28530000 COM = UCSIZE * 4 28540000 IF(COM .GT. URBYTE) THEN 28550000 SVCOM = COM 28560000 COM = COM - URBYTE 28570000 URBYTE = SVCOM 28580000 URKBYT = (URBYTE + 1023) / 1024 28590000 ELSE 28600000 COM = 0 28610000 ENDIF 28620000 C 28630000 CSIZE = (CSIZE * 4 + COM + 1023) / 1024 28640000 GO TO 9900 28650000 C 28660000 C 28670000 C 28680000 C ============== 28690000 C 54. PROCESS = VADM 28700000 C ============== 28710000 C 28720000 C ======================================= 28730000 C SET THE REGION AND COMMON SIZE FOR VADM 28740000 C ======================================= 28750000 C 28760000 5400 CONTINUE 28770000 CALL JSVADM (KPNA, KPRNO, OCCUR, PSIZE, CSIZE, UCSIZE, ERCODE) 28780000 C 28790000 C TO CALCULATE UNRESERVED BLANK COMMON 28800000 C 28810000 COM = UCSIZE * 4 28820000 IF(COM .GT. URBYTE) THEN 28830000 SVCOM = COM 28840000 COM = COM - URBYTE 28850000 URBYTE = SVCOM 28860000 URKBYT = (URBYTE + 1023) / 1024 28870000 ELSE 28880000 COM = 0 28890000 ENDIF 28900000 C 28910000 CSIZE = (CSIZE * 4 + COM + 1023) / 1024 28920000 GO TO 9900 28930000 C 28940000 C 28950000 C 28960000 C ============== 28970000 C 55. PROCESS = VDDM 28980000 C ============== 28990000 C 29000000 C ======================================= 29010000 C SET THE REGION AND COMMON SIZE FOR VDDM 29020000 C ======================================= 29030000 C 29040000 5500 CONTINUE 29050000 CALL JSVDDM (KPNA, KPRNO, OCCUR, PSIZE, CSIZE, UCSIZE, ERCODE) 29060000 C 29070000 C TO CALCULATE UNRESERVED BLANK COMMON 29080000 C 29090000 COM = UCSIZE * 4 29100000 IF(COM .GT. URBYTE) THEN 29110000 SVCOM = COM 29120000 COM = COM - URBYTE 29130000 URBYTE = SVCOM 29140000 URKBYT = (URBYTE + 1023) / 1024 29150000 ELSE 29160000 COM = 0 29170000 ENDIF 29180000 C 29190000 CSIZE = (CSIZE * 4 + COM + 1023) / 1024 29200000 GO TO 9900 29210000 C 29220000 C 29230000 C 29240000 C ============== 29250000 C 56. PROCESS = SURF 29260000 C ============== 29270000 C 29280000 C ======================================= 29290000 C SET THE REGION AND COMMON SIZE FOR SURF 29300000 C ======================================= 29310000 C 29320000 5600 CONTINUE 29330000 CALL JSSURF (KPNA, KPRNO, OCCUR, PSIZE, CSIZE, UCSIZE, ERCODE) 29340000 C 29350000 C TO CALCULATE UNRESERVED BLANK COMMON 29360000 C 29370000 COM = UCSIZE * 4 29380000 IF(COM .GT. URBYTE) THEN 29390000 SVCOM = COM 29400000 COM = COM - URBYTE 29410000 URBYTE = SVCOM 29420000 URKBYT = (URBYTE + 1023) / 1024 29430000 ELSE 29440000 COM = 0 29450000 ENDIF 29460000 C 29470000 CSIZE = (CSIZE * 4 + COM + 1023) / 1024 29480000 GO TO 9900 29490000 C 29500000 C 29510000 C 29520000 C ============== 29530000 C 57. PROCESS = SURG 29540000 C ============== 29550000 C 29560000 C ======================================= 29570000 C SET THE REGION AND COMMON SIZE FOR SURG 29580000 C ======================================= 29590000 C 29600000 5700 CONTINUE 29610000 CALL JSSURG (KPNA, KPRNO, OCCUR, PSIZE, CSIZE, UCSIZE, ERCODE) 29620000 C 29630000 C TO CALCULATE UNRESERVED BLANK COMMON 29640000 C 29650000 COM = UCSIZE * 4 29660000 IF(COM .GT. URBYTE) THEN 29670000 SVCOM = COM 29680000 COM = COM - URBYTE 29690000 URBYTE = SVCOM 29700000 URKBYT = (URBYTE + 1023) / 1024 29710000 ELSE 29720000 COM = 0 29730000 ENDIF 29740000 C 29750000 CSIZE = (CSIZE * 4 + COM + 1023) / 1024 29760000 GO TO 9900 29770000 C 29780000 C 29790000 C ============== 29800000 C 58. PROCESS = ANST 29810000 C ============== 29820000 C 29830000 C ======================================= 29840000 C SET THE REGION AND COMMON SIZE FOR ANST 29850000 C ======================================= 29860000 C 29870000 5800 CONTINUE 29880000 CALL JSANST (KPNA, KPRNO, OCCUR, PSIZE, CSIZE, UCSIZE, ERCODE) 29890000 C 29900000 C TO CALCULATE UNRESERVED BLANK COMMON 29910000 C 29920000 COM = UCSIZE * 4 29930000 IF(COM .GT. URBYTE) THEN 29940000 SVCOM = COM 29950000 COM = COM - URBYTE 29960000 URBYTE = SVCOM 29970000 URKBYT = (URBYTE + 1023) / 1024 29980000 ELSE 29990000 COM = 0 30000000 ENDIF 30010000 C 30020000 CSIZE = (CSIZE * 4 + COM + 1023) / 1024 30030000 GO TO 9900 30040000 C 30050000 C 30060000 C ============== 30070000 C 59. PROCESS = LMPA 30080000 C ============== 30090000 C 30100000 C ======================================= 30110000 C SET THE REGION AND COMMON SIZE FOR LMPA 30120000 C ======================================= 30130000 C 30140000 5900 CONTINUE 30150000 CALL JSLMPA (KPNA, KPRNO, OCCUR, PSIZE, CSIZE, UCSIZE, ERCODE) 30160000 C 30170000 C TO CALCULATE UNRESERVED BLANK COMMON 30180000 C 30190000 COM = UCSIZE * 4 30200000 IF(COM .GT. URBYTE) THEN 30210000 SVCOM = COM 30220000 COM = COM - URBYTE 30230000 URBYTE = SVCOM 30240000 URKBYT = (URBYTE + 1023) / 1024 30250000 ELSE 30260000 COM = 0 30270000 ENDIF 30280000 C 30290000 CSIZE = (CSIZE * 4 + COM + 1023) / 1024 30300000 GO TO 9900 30310000 C 30320000 C ============== 30330000 C 60. PROCESS = TRIM 30340000 C ============== 30350000 C 30360000 C ======================================= 30370000 C SET THE REGION AND COMMON SIZE FOR TRIM 30380000 C ======================================= 30390000 C 30400000 6000 CONTINUE 30410000 CALL JSTRIM (KPNA, KPRNO, OCCUR, PSIZE, CSIZE, UCSIZE, ERCODE) 30420000 C 30430000 C TO CALCULATE UNRESERVED BLANK COMMON 30440000 C 30450000 COM = UCSIZE * 4 30460000 IF(COM .GT. URBYTE) THEN 30470000 SVCOM = COM 30480000 COM = COM - URBYTE 30490000 URBYTE = SVCOM 30500000 URKBYT = (URBYTE + 1023) / 1024 30510000 ELSE 30520000 COM = 0 30530000 ENDIF 30540000 C 30550000 CSIZE = (CSIZE * 4 + COM + 1023) / 1024 30560000 GO TO 9900 30570000 C 30580000 C 30590000 C ============== 30600000 C 61. PROCESS = FF3D 30610000 C ============== 30620000 C 30630000 C ======================================= 30640000 C SET THE REGION AND COMMON SIZE FOR FF3D 30650000 C ======================================= 30660000 C 30670000 6100 CONTINUE 30680000 CALL JSFF3D (KPNA, KPRNO, OCCUR, PSIZE, CSIZE, UCSIZE, ERCODE) 30690000 C 30700000 C TO CALCULATE UNRESERVED BLANK COMMON 30710000 C 30720000 COM = UCSIZE * 4 30730000 IF(COM .GT. URBYTE) THEN 30740000 SVCOM = COM 30750000 COM = COM - URBYTE 30760000 URBYTE = SVCOM 30770000 URKBYT = (URBYTE + 1023) / 1024 30780000 ELSE 30790000 COM = 0 30800000 ENDIF 30810000 C 30820000 CSIZE = (CSIZE * 4 + COM + 1023) / 1024 30830000 GO TO 9900 30840000 C 30850000 C 30860000 C ============== 30870000 C 62. PROCESS = XSMP 30880000 C ============== 30890000 C 30900000 C ======================================= 30910000 C SET THE REGION AND COMMON SIZE FOR XSMP 30920000 C ======================================= 30930000 C 30940000 6200 CONTINUE 30950000 CALL JSXSMP (KPNA, KPRNO, OCCUR, PSIZE, CSIZE, UCSIZE, ERCODE) 30960000 C 30970000 C TO CALCULATE UNRESERVED BLANK COMMON 30980000 C 30990000 COM = UCSIZE * 4 31000000 IF(COM .GT. URBYTE) THEN 31010000 SVCOM = COM 31020000 COM = COM - URBYTE 31030000 URBYTE = SVCOM 31040000 URKBYT = (URBYTE + 1023) / 1024 31050000 ELSE 31060000 COM = 0 31070000 ENDIF 31080000 C 31090000 CSIZE = (CSIZE * 4 + COM + 1023) / 1024 31100000 GO TO 9900 31110000 C 31120000 C 31130000 C ============== 31140000 C 63. PROCESS = FF2D 31150000 C ============== 31160000 C 31170000 C ======================================= 31180000 C SET THE REGION AND COMMON SIZE FOR FF3D 31190000 C ======================================= 31200000 C 31210000 6300 CONTINUE 31220000 CALL JSFF3D (KPNA, KPRNO, OCCUR, PSIZE, CSIZE, UCSIZE, ERCODE) 31230000 C 31240000 C TO CALCULATE UNRESERVED BLANK COMMON 31250000 C 31260000 COM = UCSIZE * 4 31270000 IF(COM .GT. URBYTE) THEN 31280000 SVCOM = COM 31290000 COM = COM - URBYTE 31300000 URBYTE = SVCOM 31310000 URKBYT = (URBYTE + 1023) / 1024 31320000 ELSE 31330000 COM = 0 31340000 ENDIF 31350000 C 31360000 CSIZE = (CSIZE * 4 + COM + 1023) / 1024 31370000 GO TO 9900 31380000 C 31390000 C **************************************************************** 31400000 C *********** ENTER NEXT PROCESS IN PROC(63) AND ADD ************* 31410000 C *********** ASSOCIATED CODE HERE ************* 31420000 C **************************************************************** 31430000 C 31440000 C 31450000 COADY ***************************************************************** 31460000 C *********** PROCESS NAME NOT FOUND. CHECK TO SEE IF ************* 31470000 C *********** R&D PROCESS. ************* 31480000 C ***************************************************************** 31490000 C 31500000 C 31510000 C 31520000 9700 CALL JSRND(KPNA, KPRNO, OCCUR, BLKSIZ, PSIZE, CSIZE, RSIZE, 31530000 + ERCODE, URBYTE, URKBYT) 31540000 C 31550000 GO TO 9900 31560000 C 31570000 C 31580000 C 31590000 C 31600000 9800 ERCODE = 16 31610000 C 31620000 9900 RETURN 31630000 C 31640000 C ERROR MESSAGES 31650000 C 31660000 8000 WRITE (IPR, 9000) KPNA, KPRNO 31670000 GO TO 9800 31680000 C 31690000 8020 WRITE (IPR, 9020) KPNA, KPRNO 31700000 GO TO 9800 31710000 C 31720000 C FORMATS 31730000 C 31740000 9000 FORMAT (/' *** NO LINE OR ACCT CARD IN JSCORE FOR PROC = ', 31750000 * A4,I1) 31760000 C 31770000 9020 FORMAT (/' *** NO CARD PRESENT IN JSCORE FOR PROC = ',A4,I1) 31780000 C 31790000 9040 FORMAT (/' *** MAXIMUM REGION SIZE WILL BE EXCEEDED, REDUCE CPRO',31800000 * ' PLOT SIZE ***') 31810000 C 31820000 END 31830000