CTITLEJSWRTE -- JOBGEN SPACE ALGORITHM 00010000 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA AUTHOR R. MCMILLAN 00020000 CA DESIGNER R. MCMILLAN 00030000 CA LANGUAGE FORTRAN 00040000 CA SYSTEM IBM AND CRAY 00050000 CA WRITTEN 10-28-75 00060000 C REVISED 4-09-79 PKC. COPIED CODE FROM JSSPAC AND ADDED 00070000 C VPRO AND TSUM. 00080000 C REVISED 4-23-79 REM. USE IABS IN SELT CALCULATION. 00090000 C REVISED 9-06-79 JGM - ADDED MXLNS AND INCREASED SECDRY FOR 00100000 C HISTORY RECORDS. 00110000 C REVISED 9-24-79 REM. DELETE CHECK FOR "SP" ON ACCT CARD. 00120000 C REVISED 9-26-79 REM. DELETE CHECK FOR "D" ON LINE CARD WHEN 00130000 C ALLOCATING FOR ALL SHOTPOINTS. 00140000 C REVISED 11-27-79 JGM.- ADDED 3D LINE COUNT TO SELT CODE 00150000 C REVISED 01-18-80 PKC. CHANGED COVA AND ADDED COVE AND NMOC. 00160000 C REVISED 02-06-80 PKC. MOVED COVE BEFORE COVA. 00170000 C REVISED 12-08-80 PKC. CHANGED USE OF LCSI TO LCPI. 00180000 C REVISED 01-13-82 JBC. CORRECTED TSUM CALCULATION FOR 00190000 C 'PAD' OPTION 00200000 C ADDED VSUM SPACE CALCULATION 00210000 C REVISED 01-27-82 JBC. CHANGED SPACE CALCULATION OF 'SELT' 00220000 C NOW CALCULATES SPACE FOR 'TRC' OPTION 00230000 C REVISED 02-08-82 RDK. INSERT CHECK FOR VSPD TO PRECEDE TSUM. 00240000 C REVISED 02-11-82 JBC. CORRECTED TSUM ERROR 00250000 C REVISED 02-16-82 RDK. PASS VSPD CHECK ON TO NEXT PROCESS WHEN 00260000 C RESEQUENCE-ONLY OPTION INVOKED. 00270000 C REVISED 03-15-82 RDK. ADD ENTRY FOR ZMIG. 00280000 C REVISED 03-22-82 JBC. ADDED CHECK IN TSUM FOR NOSUM OPTION 00290000 C REVISED 04-01-82 JBC. ADDED CODE IN TSUM FOR LINEAR INTERPOLATION00300000 C REVISED 04-23-82 JBC. CALCULATE SECDRY FOR PANL 00310000 C ROUND UP SECDRY FOR ALL PROCESSES 00320000 C REVISED 05-18-82 JBC. ADDED CODE IN 'VSUM' FOR 'TRC' OPTION 00330000 C REVISED 06-22-82 SAS. UPGRADED 'TSUM' FOR NEW CARD FORMAT TO 00340000 C INCLUDE RECEIVER LOCATION SUMMING. 00350000 C ALSO FIXED 'VSUM' TO INCLUDE SPACE FOR 00360000 C PARTIAL SUM. 00370000 C REVISED 06-30-82 SAS. ADDED ENTRY FOR STKW 00380000 C REVISED 08-26-82 JBC. ADDED CODE IN 'STAK' FOR COMMON SHOTPOINT 00390000 C AND COMMON RECEIVER STACK 00400000 C REVISED 08-31-82 JBC. CORRECTED ERROR IN 'TSUM' CALCULATIONS 00410000 C REVISED 09-23-82 SAS. ADDED 'VSUM' CHECK FOR CXGS OPTION. 00420000 C REVISED 11-09-82 JBC. CORRECTED ERROR IN 'SELT' CALCULATIONS 00430000 C REVISED 03-21-83 REM. CHANGE NSP TO LCANSP FROM LINE CARD. 00440000 C REVISED 06-23-83 RDK. ADDED ENTRY FOR D3NT. 00450000 C REVISED 07-18-83 JBC. ADDED CODE TO CHECK FOR 'WRIT' 00460000 C OVERRIDE CARD 'CTL'. IF FOUND 00470000 C THE MAXIMUM NUMBER OF TRACES TO 00480000 C WRIT FROM THE 'CTL' CARD WILL OVERRIDE 00490000 C JSWRTE CALCULATIONS. 00500000 C REVISED 08-09-83 CMP. ADDED WIN CARD TO FLTR. 00510000 C REVISED 08-29-83 CMP. FIX BUG IF NOSORT OPTION IN FLTR. 00520000 C REVISED 09-23-83 ESN. REMOVED BRANCH AFTER LABEL 5100 SO 00530000 C 'PRIMRY' IS ALWAYS MULTIPLIED BY MXLNS. 00540000 C REVISED 09-28-84 ESN. ADDED ENTRY FOR STOC. 00550000 C REVISED 10-03-84 REP. CONVERT TO VS FORTRAN. 00560000 C REVISED 02-15-85 TRA. ADDED ENTRY FOR SCDA,SCDB,SCDC COMBINED. 00570000 C REVISED 02-15-85 TRA. ADDED ENTRY FOR DDEC. 00580000 C REVISED 09-11-85 ESN/RDK. CONVERT TO DUAL PATH IBM/CRAY. 00590000 C REVISED 12-31-85 REM. ADD CHECK OF PLOT PARAMETERS. ALSO CHANGE 00600000 C TO USE CHARACTER VARIABLES 00610000 C REVISED 06-19-86 CMP. MODIFIED SELT TRC ENTRY TO ACCEPT '-' IN 00620000 C A SEPARATE FIELD. 00630000 C REVISED 08-18-86 REM. ADD OFFAP AS PLOT TYPE. 00640000 C REVISED 06-03-87 REM. ADD DISK ADDRESS TO PARAMETERS FOR USPMCK. 00650000 C REVISED 06-09-88 RDK. ADDED ENTRY FOR TRAK. 00660000 C REVISED 07-07-88 DRS. ADDED ENTRY FOR VSPW AND VSPV 00670000 C REVISED 01-13-89 LWC. ADDED ENTRY FOR VELA. 00680000 C REVISED 07-21-89 JJC. ADDED ENTRY FOR RAMR. 00690000 C REVISED 09-18-89 JJC. ADDED ENTRY FOR MPFK. 00700000 C REVISED 12-04-89 ESN. CHANGE VELA FROM LCTPSP TO LCMXFD 00710000 C REVISED 12-05-89 ESN. ADD IN WT3D. 00720000 C REVISED 07-14-92 ESN. CORRECT RAMR ERROR MESSAGE. 00730000 CA 00740000 CA 00750000 CA CALL JSWRTE (KPNA, KPRNO, OCCUR, BLKSIZ, PRIMRY, SECDRY, 00760000 CA RLSE, CONTG, ERCODE) 00770000 CA INPUT KPNA = PROCESS NAME A4 00780000 CA INPUT KPRNO = PROCESS NUMBER I4 00790000 CA INPUT OCCUR = OCCURRENCE NUMBER FOR PROCESS KPNA WITH I4 00800000 CA THIS SAME KPRNO 00810000 CA INPUT VALUE 00820000 CA I / O BLKSIZ= BLOCK SIZE (BYTES) PTTHLB + 4*LCRL/LCPI I4 00830000 CA I / O PRIMRY= PRIMARY ALLOCATION (BLOCKS) 0 I4 00840000 CA I / O SECDRY= SECONDARY ALLOCATION (BLOCKS) 0 I4 00850000 CA I / O RLSE = RELEASE PARAMETER PTABMSTR I4 00860000 CA I / O CONTG = CONTIGUOUS SPACE PARAMETER PTABMSTR I4 00870000 CA I / O ERCODE= ERROR CODE (= 16 IF NOT ABLE 0 I4 00880000 CA TO COMPUTE THE REQUIRED PARAMETERS) 00890000 CA 00900000 CA LINE CARD RECORD LENGTH 00910000 CA INPUT BLKSIZ = 4 --------------------------- + TRACE HEADER LENGTH00920000 CA LINE CARD PROCESSING INTERVAL 00930000 CA 00940000 CA COMPUTES NUMBER OF OUTPUT RECORDS REQUIRED FOR A 'WRIT' PROCESS. 00950000 C 00960000 C 00970000 C EJECT 00980000 C INTEGER ARRAYS -- LOCAL 00990000 C 01000000 C CARD(20) = DATA CARD ARRAY 01010000 C 01020000 C EJECT 01030000 C 01040000 SUBROUTINE JSWRTE(KPNA, KPRNO, OCCUR, BLKSIZ, PRIMRY, SECDRY, 01050000 * RLSE, CONTG, ERCODE) 01060000 C 01070000 IMPLICIT INTEGER (A-Z) 01080000 C 01090000 C INTEGER ARRAYS -- LOCAL 01100000 C 01110000 INTEGER CARD (20) 01120000 C 01130000 C INTEGER CONSTANTS -- LOCAL 01140000 C 01150000 CHARACTER*4 BLANK 01160000 CHARACTER*4 DPMODE 01170000 INTEGER IPR 01180000 CHARACTER*16 JAPNMS 01190000 CHARACTER*4 MODE 01200000 CHARACTER*4 MODE0 01210000 CHARACTER*4 MODE1 01220000 CHARACTER*4 MODE2 01230000 CHARACTER*4 MODE3 01240000 INTEGER NOCARD 01250000 CHARACTER*4 PMODE 01260000 CHARACTER*4 PROC 01270000 CHARACTER*4 SCDA 01280000 CHARACTER*4 SCDB 01290000 CHARACTER*4 SCDC 01300000 CHARACTER*4 SPMODE 01310000 CHARACTER*4 STYPE 01320000 CHARACTER*4 TRC 01330000 C 01340000 REAL DP 01350000 REAL HDIST 01360000 REAL RDIST 01370000 REAL PMAX 01380000 REAL FMAX 01390000 REAL SF 01400000 REAL X1 01410000 REAL XN 01420000 REAL DX 01430000 C 01440000 C INITIALIZATION 01450000 C 01460000 DATA BLANK / ' ' / 01470000 DATA DPMODE / 'D ' / 01480000 DATA IPR / 6 / 01490000 DATA MODE / ' ' / 01500000 DATA MODE0 / '0 ' / 01510000 DATA MODE1 / '1 ' / 01520000 DATA MODE2 / '2 ' / 01530000 DATA MODE3 / '3 ' / 01540000 DATA MPFK / 'MPFK' / 01550000 DATA NOCARD / 0 / 01560000 DATA PANL / 'PANL' / 01570000 DATA QUAD / 'QUAD' / 01580000 DATA RAMR / 'RAMR' / 01590000 DATA SCDA / 'SCDA' / 01600000 DATA SCDB / 'SCDB' / 01610000 DATA SCDC / 'SCDC' / 01620000 DATA SPMODE / 'S ' / 01630000 DATA TRC / 'TRC ' / 01640000 DATA ZMIG / 'ZMIG' / 01650000 C 01660000 ERCODE = 0 01670000 C 01680000 C GET LINE CARD PARAMETERS 01690000 C 01700000 DA = 1 01710000 CALL FORC ('LINE',0,DA,CARD, *8000 )01720000 C 01730000 LCTPSP = S1CVBN(CARD,36,5) 01740000 LCMXFD = S1CVBN(CARD,61,5) 01750000 IF (LCMXFD .EQ. 0) LCMXFD = LCTPSP 01760000 PMODE = 'LS ' 01770000 IF (S1CPCH (CARD,6,' ',1,1).NE.0) CALL S1MVCH (CARD,6,PMODE,1,1) 01780000 IF (S1CPCH (CARD,7,' ',1,1).NE.0) CALL S1MVCH (CARD,7,PMODE,2,1) 01790000 LCBGSP = S1CVBN (CARD, 11, 5) 01800000 LCENSP = S1CVBN (CARD, 16, 5) 01810000 LCNSP = S1CVBN (CARD, 31, 5) 01820000 RLENG = S1CVBN (CARD, 41, 5) 01830000 PI = S1CVBN (CARD, 51, 5) 01840000 NOSAMP = RLENG / PI 01850000 LCANSP = S1CVBN(CARD, 66, 5) 01860000 MXLNS = S1CVBN(CARD, 71, 5) 01870000 IF (MXLNS .LE. 0) MXLNS = 1 01880000 C 01890000 C CHECK FOR WRIT OR WT3D OVERRIDE CARD 01900000 C ==================================== 01910000 C 01920000 ISPACE = 0 01930000 5 CALL FORC(KPNA, KPRNO, DA, CARD, * 8) 01940000 IF (S1CPCH(CARD, 8,'CTL', 1, 3) .NE. 0) GO TO 5 01950000 ISPACE = S1CVBN(CARD,11,10) 01960000 8 CONTINUE 01970000 IF (ISPACE .EQ. 0) GO TO 9 01980000 PRIMRY = ISPACE 01990000 GO TO 5300 02000000 9 CONTINUE 02010000 C 02020000 C 02030000 C 02040000 C 02050000 C PROCESS = WRIT 02060000 C ============== 02070000 C 02080000 C ================================= 02090000 C COMPUTE THE PRIMARY AND SECONDARY 02100000 C ALLOCATION FOR WRIT 02110000 C ================================= 02120000 C 02130000 C 02140000 C====================================================================== 02150000 C CHECK PROC CARDS FOR 'PANL' PROCESS 02160000 C====================================================================== 02170000 C 02180000 CALL JSPAC1 (KPNA, KPRNO, OCCUR, 'PANL', SKPRNO) 02190000 IF (SKPRNO .EQ. -1) GO TO 30 02200000 IF (SKPRNO .EQ. -2) GO TO 8030 02210000 C 02220000 C PANL IS PRESENT. COMPUTE SPACE ACCORDINGLY. 02230000 C 02240000 DAC = 1 02250000 NOC = 0 02260000 JSMXFD = LCMXFD 02270000 CALL JSPAC1 (KPNA, KPRNO, OCCUR, 'STAK', PKPRNO) 02280000 IF (PKPRNO .EQ. 0) JSMXFD = 1 02290000 C 02300000 SKPNA = PANL 02310000 10 CALL FORC ('PANL', SKPRNO, DAC, CARD, *20) 02320000 NOC = NOC + 1 02330000 IF (NOC .NE. 1) GO TO 10 02340000 PMODE = BLANK 02350000 CALL S1MVCH (CARD, 7, PMODE, 1, 1) 02360000 SPT = S1CVBN(CARD, 11, 5) 02370000 EPT = S1CVBN(CARD, 16, 5) 02380000 NPANEL = S1CVBN(CARD, 21, 5) 02390000 IF (SPT .LE. 0 .OR. EPT .LE. 0) GO TO 10 02400000 IF (PMODE .NE. DPMODE .AND. PMODE .NE. SPMODE) GO TO 10 02410000 PRIMRY = (IABS(EPT - SPT) + 1) * NPANEL 02420000 IF (PMODE .EQ. DPMODE) PRIMRY = PRIMRY * JSMXFD 02430000 IF (PMODE .EQ. SPMODE) PRIMRY = PRIMRY * LCTPSP 02440000 GO TO 10 02450000 20 IF (NOC .EQ. 0) GO TO 8020 02460000 GO TO 5300 02470000 C 02480000 C=======================================================================02490000 C CHECK PROC CARDS FOR 'QUAD' PROCESS 02500000 C=======================================================================02510000 C 02520000 30 CALL JSPAC1 (KPNA, KPRNO, OCCUR, 'QUAD', SKPRNO) 02530000 IF (SKPRNO .EQ. -1) GO TO 51 02540000 IF (SKPRNO .EQ. -2) GO TO 8030 02550000 C 02560000 C QUAD IS PRESENT. COMPUTE SPACE ACCORDINGLY. 02570000 C 02580000 DA = 1 02590000 NOCARD = 0 02600000 SKPNA = QUAD 02610000 40 CALL FORC ('QUAD', SKPRNO, DA, CARD, *50) 02620000 IF (S1CPCH (CARD, 8, BLANK, 1, 3) .NE. 0) GO TO 50 02630000 NOCARD = NOCARD + 1 02640000 SDP = S1CVBN (CARD, 11, 5) 02650000 EDP = S1CVBN (CARD, 16, 5) 02660000 PRIMRY = PRIMRY + 6*(EDP - SDP + 1) 02670000 GO TO 40 02680000 50 IF (NOCARD .EQ. 0) GO TO 8020 02690000 C 02700000 GO TO 5300 02710000 C 02720000 C=======================================================================02730000 C CHECK PROC CARDS FOR 'ZMIG' PROCESS 02740000 C=======================================================================02750000 C 02760000 51 CALL JSPAC1 (KPNA, KPRNO, OCCUR, 'ZMIG', SKPRNO) 02770000 IF (SKPRNO .EQ. -1) GO TO 55 02780000 IF (SKPRNO .EQ. -2) GO TO 8030 02790000 C 02800000 C ZMIG IS PRESENT. COMPUTE SPACE ACCORDINGLY. 02810000 C 02820000 DA = 1 02830000 NOCARD = 0 02840000 SKPNA = ZMIG 02850000 52 CALL FORC ('ZMIG', SKPRNO, DA, CARD, *53) 02860000 IF (S1CPCH (CARD, 8, BLANK, 1, 3) .NE. 0) GO TO 52 02870000 INM = 1 02880000 IF (S1CPCH (CARD,37, 'BOTH', 1, 4) .EQ. 0) INM = 2 02890000 C 02900000 NOCARD = NOCARD + 1 02910000 SDP = S1CVBN (CARD, 11, 5) 02920000 EDP = S1CVBN (CARD, 16, 5) 02930000 PRIMRY = PRIMRY + INM*(EDP - SDP + 1) 02940000 GO TO 52 02950000 53 IF (NOCARD .EQ. 0) GO TO 8020 02960000 C 02970000 GO TO 5300 02980000 C=======================================================================02990000 C CHECK PROC CARDS FOR 'MPFK' PROCESS 03000000 C=======================================================================03010000 C 03020000 55 CALL JSPAC1(KPNA,KPRNO,OCCUR,'MPFK',SKPRNO) 03030000 IF(SKPRNO .EQ. -1) GO TO 60 03040000 IF(SKPRNO .EQ. -2) GO TO 8030 03050000 C 03060000 C MPFK IS PRESENT. COMPUTE SPACE ACCORDINGLY. 03070000 C 03080000 DA = 1 03090000 NOCARD = 0 03100000 SKPNA = MPFK 03110000 56 CALL FORC('MPFK', SKPRNO, DA, CARD, * 57) 03120000 IF(S1CPCH(CARD, 8, BLANK, 1, 3) .NE. 0) GO TO 56 03130000 NOCARD = NOCARD + 1 03140000 IS1 = S1CVBN(CARD, 11, 5) 03150000 ISN = S1CVBN(CARD, 16, 5) 03160000 IF (ISN .LE. IS1) ISN = IS1 03170000 IVN = S1CVBN(CARD, 41, 5) 03180000 IF (IVN .EQ. 0) IVN = 1 03190000 C 03200000 PRIMRY = (ISN-IS1+1) * IVN 03210000 C 03220000 57 IF (NOCARD .EQ. 0) GO TO 8020 03230000 C 03240000 GO TO 5300 03250000 C 03260000 C=======================================================================03270000 C CHECK PROC CARDS FOR 'FLTR' PROCESS 03280000 C IT IS NECESSARY TO MAKE THIS CHECK BEFORE 03290000 C LOOKING FOR 'STAK' 03300000 C=======================================================================03310000 C 03320000 60 CALL JSPAC1 (KPNA,KPRNO,OCCUR,'FLTR',SKPRNO) 03330000 IF (SKPRNO .EQ. -1) GO TO 140 03340000 IF (SKPRNO .EQ. -2) GO TO 8030 03350000 C 03360000 C HAVE A FLTR - MUST CHECK CARDS FOR FILTER PANELS 03370000 C 03380000 DA = 1 03390000 C 03400000 70 CALL FORC ('FLTR', SKPRNO, DA, CARD, *8090) 03410000 IF (S1CPCH(CARD,8,' ',1,3) .EQ. 0) GO TO 70 03420000 IF (S1CPCH(CARD,8,'WIN',1,3) .EQ. 0) GO TO 70 03430000 IF (S1CPCH(CARD,8,'PIN',1,3) .EQ. 0) GO TO 80 03440000 IF (S1CPCH(CARD,8,'OP',1,2) .EQ. 0) GO TO 140 03450000 IF (S1CPCH(CARD,8,'FBP',1,3) .EQ. 0) GO TO 140 03460000 FLID = S1CVBN(CARD,11,5) 03470000 75 CALL FORC ('FLTR', SKPRNO, DA, CARD, *140) 03480000 IF (S1CPCH(CARD,8,'WIN',1,3) .EQ. 0) GO TO 75 03490000 IF (S1CVBN(CARD,11,5) .NE. FLID) GO TO 140 03500000 C 03510000 C HAVE FILTER PANELS 03520000 C 03530000 80 DA = 1 03540000 CALL FORC ('FLTR', SKPRNO, DA, CARD, *90) 03550000 CALL S1MVCH(CARD,7,MODE,1,1) 03560000 IF (S1CPCH(MODE,1,' ',1,1) .EQ. 0) 03570000 * CALL S1MVCH(PMODE,2,MODE,1,1) 03580000 MAXTR = LCTPSP 03590000 IF (S1CPCH(MODE,1,'D',1,1) .EQ. 0) MAXTR = LCMXFD 03600000 CALL JSPAC1 (KPNA, KPRNO, OCCUR, 'STAK', TKPRNO) 03610000 IF (TKPRNO .GE. 0) MAXTR = 1 03620000 CALL JSPAC1 (KPNA, KPRNO, OCCUR, 'CSTK', TKPRNO) 03630000 IF (TKPRNO .GE. 0) MAXTR = 1 03640000 MAXNTR = 0 03650000 DA = 1 03660000 C 03670000 90 CALL FORC ('FLTR', SKPRNO, DA, CARD, *130) 03680000 IF (S1CPCH(CARD,8,' ',1,3) .NE. 0) GO TO 90 03690000 SPT = S1CVBN (CARD,11,5) 03700000 EPT = S1CVBN (CARD,16,5) 03710000 IF (EPT .EQ. 0) EPT = SPT 03720000 PANTR = (IABS(EPT - SPT) + 1) * MAXTR 03730000 C 03740000 IF (S1CVBN(CARD,21,5) .EQ. 0) GO TO 95 03750000 C 03760000 C CHECK FOR 3-D LINE RANGE 03770000 C 03780000 LNST = S1CVBN (CARD, 66, 5) 03790000 LNEN = S1CVBN (CARD, 71, 5) 03800000 NLINES = LNEN - LNST + 1 03810000 IF (NLINES .EQ. 1) NLINES = MXLNS 03820000 C 03830000 PANTR = PANTR * NLINES 03840000 C 03850000 WID = S1CVBN(CARD, 21, 5) 03860000 DA3 = 1 03870000 92 CALL FORC ('FLTR', SKPRNO, DA3, CARD, *120) 03880000 IF (S1CPCH(CARD, 8, 'WIN', 1, 3) .NE. 0) GO TO 92 03890000 IF (S1CVBN(CARD, 11, 5) .NE. WID) GO TO 92 03900000 C 03910000 95 FLID = S1CVBN (CARD,26,5) 03920000 NPAN = 0 03930000 DA1 = 1 03940000 C 03950000 100 CALL FORC ('FLTR', SKPRNO, DA1, CARD, *120) 03960000 IF (S1CPCH(CARD,8,' ',1,3) .EQ. 0) GO TO 100 03970000 IF (S1CPCH(CARD,8,'WIN',1,3) .EQ. 0) GO TO 100 03980000 IF (S1CVBN(CARD,11,5) .NE. FLID) GO TO 100 03990000 IF (S1CPCH(CARD,8,'PIN',1,3) .EQ. 0) GO TO 110 04000000 NPAN = NPAN + 1 04010000 GO TO 100 04020000 C 04030000 110 NPAN = S1CVBN (CARD,36,5) 04040000 C 04050000 120 MAXNTR = MAXNTR + NPAN * PANTR 04060000 GO TO 90 04070000 C 04080000 130 PRIMRY = MAXNTR 04090000 C 04100000 GO TO 5300 04110000 C 04120000 C=======================================================================04130000 C CHECK PROC CARDS FOR 'STAK' PROCESS 04140000 C=======================================================================04150000 C 04160000 140 CALL JSPAC1 (KPNA,KPRNO,OCCUR,'STAK',SKPRNO) 04170000 C 04180000 IF (SKPRNO .GE. 0) GO TO 150 04190000 IF (SKPRNO .EQ. -1) GO TO 180 04200000 GO TO 5400 04210000 C 04220000 C CALCULATE SPACE FOR STACKED TRACES 04230000 C 04240000 150 DA = 1 04250000 MIN = 999999 04260000 MAX = -999999 04270000 160 CALL FORC ('STAK', SKPRNO, DA, CARD, *170) 04280000 IF (S1CPCH(CARD,7,'S',1,1) .NE. 0) GO TO 162 04290000 PRIMRY = LCNSP 04300000 GO TO 5300 04310000 162 IF (S1CPCH(CARD,7,'R',1,1) .NE. 0) GO TO 165 04320000 PRIMRY = 6000 04330000 GO TO 5300 04340000 165 N = S1CVBN(CARD, 11, 5) 04350000 IF (N .GT. MAX) MAX = N 04360000 IF (N .LT. MIN) MIN = N 04370000 N = S1CVBN(CARD, 16, 5) 04380000 IF (N .EQ. 0) GO TO 160 04390000 IF (N .GT. MAX) MAX = N 04400000 IF (N .LT. MIN) MIN = N 04410000 GO TO 160 04420000 C 04430000 170 IF (MAX .EQ. -999999) GO TO 8060 04440000 PRIMRY = MAX - MIN + 1 04450000 C 04460000 GO TO 5200 04470000 C 04480000 C=======================================================================04490000 C CHECK PROC CARDS FOR 'CSTK' PROCESS 04500000 C=======================================================================04510000 C 04520000 180 CALL JSPAC1 (KPNA,KPRNO,OCCUR,'CSTK',SKPRNO) 04530000 C 04540000 IF (SKPRNO .GE. 0) GO TO 190 04550000 IF (SKPRNO .EQ. -1) GO TO 211 04560000 GO TO 5400 04570000 C 04580000 C CALCULATE SPACE FOR STACKED TRACES 04590000 C 04600000 190 DA = 1 04610000 MIN = 999999 04620000 MAX = -999999 04630000 200 CALL FORC ('CSTK', SKPRNO, DA, CARD, *210) 04640000 N = S1CVBN(CARD, 11, 5) 04650000 IF (N .GT. MAX) MAX = N 04660000 IF (N .LT. MIN) MIN = N 04670000 N = S1CVBN(CARD, 16, 5) 04680000 IF (N .EQ. 0) GO TO 200 04690000 IF (N .GT. MAX) MAX = N 04700000 IF (N .LT. MIN) MIN = N 04710000 GO TO 200 04720000 C 04730000 210 IF (MAX .EQ. -999999) GO TO 8065 04740000 PRIMRY = MAX - MIN + 1 04750000 C 04760000 GO TO 5200 04770000 C 04780000 C=======================================================================04790000 C CHECK PROC CARDS FOR 'STKW' PROCESS 04800000 C=======================================================================04810000 C 04820000 211 CALL JSPAC1 (KPNA,KPRNO,OCCUR,'STKW',SKPRNO) 04830000 C 04840000 IF (SKPRNO .GE. 0) GO TO 212 04850000 IF (SKPRNO .EQ. -1) GO TO 215 04860000 GO TO 5400 04870000 C 04880000 C CALCULATE SPACE FOR STACKED TRACES 04890000 C 04900000 212 DA = 1 04910000 MIN = 999999 04920000 MAX = -999999 04930000 213 CALL FORC ('STKW', SKPRNO, DA, CARD, *214) 04940000 N = S1CVBN(CARD, 11, 5) 04950000 IF (N .GT. MAX) MAX = N 04960000 IF (N .LT. MIN) MIN = N 04970000 N = S1CVBN(CARD, 16, 5) 04980000 IF (N .EQ. 0) GO TO 213 04990000 IF (N .GT. MAX) MAX = N 05000000 IF (N .LT. MIN) MIN = N 05010000 GO TO 213 05020000 C 05030000 214 IF (MAX .EQ. -999999) GO TO 8067 05040000 PRIMRY = MAX - MIN + 1 05050000 C 05060000 GO TO 5200 05070000 C 05080000 C=======================================================================05090000 C CHECK PROC CARDS FOR 'STOC' PROCESS 05100000 C=======================================================================05110000 C 05120000 215 CALL JSPAC1 (KPNA,KPRNO,OCCUR,'STOC',SKPRNO) 05130000 C 05140000 IF (SKPRNO .GE. 0) GO TO 216 05150000 IF (SKPRNO .EQ. -1) GO TO 220 05160000 GO TO 5400 05170000 C 05180000 C CALCULATE SPACE FOR STACKED TRACES 05190000 C 05200000 216 DA = 1 05210000 MIN = 999999 05220000 MAX = -999999 05230000 217 CALL FORC ('STOC', SKPRNO, DA, CARD, *218) 05240000 N = S1CVBN(CARD, 11, 5) 05250000 IF (N .GT. MAX) MAX = N 05260000 IF (N .LT. MIN) MIN = N 05270000 N = S1CVBN(CARD, 16, 5) 05280000 IF (N .EQ. 0) GO TO 217 05290000 IF (N .GT. MAX) MAX = N 05300000 IF (N .LT. MIN) MIN = N 05310000 GO TO 217 05320000 C 05330000 218 IF (MAX .EQ. -999999) GO TO 8068 05340000 PRIMRY = MAX - MIN + 1 05350000 C 05360000 GO TO 5200 05370000 C 05380000 C====================================================================== 05390000 C CHECK PROC CARDS FOR 'CVAN' PROCESS 05400000 C====================================================================== 05410000 C 05420000 220 CALL JSPAC1 (KPNA,KPRNO,OCCUR,'CVAN',SKPRNO) 05430000 IF (SKPRNO .GE. 0) GO TO 230 05440000 IF (SKPRNO .EQ. -1) GO TO 290 05450000 GO TO 5400 05460000 C 05470000 C HAVE A CVAN - MUST GET CARDS 05480000 C 05490000 230 DA = 1 05500000 CALL FORC ('CVAN', SKPRNO, DA, CARD, *8040) 05510000 CALL S1MVCH (CARD, 23, TYPE, 1, 3) 05520000 NVEL = S1CVBN (CARD, 26, 5) 05530000 PRIMRY = S1CVBN (CARD, 76, 5) 05540000 IF (PRIMRY .NE. 0) GO TO 280 05550000 CALL S1MVCH (CARD, 7, MODE, 1, 1) 05560000 IF (S1CPCH(MODE,1,' ',1,1) .EQ. 0) 05570000 * CALL S1MVCH(PMODE,2,MODE,1,1) 05580000 C 05590000 C SUM SHOTPOINTS OR DEPTH POINTS TO BE PROCESSED 05600000 C 05610000 NSUM = 0 05620000 240 SPT = S1CVBN(CARD,11,5) 05630000 EPT = S1CVBN(CARD,16,5) 05640000 IF (EPT .EQ. 0) EPT = SPT 05650000 NSUM = NSUM + IABS(EPT - SPT) + 1 05660000 CALL FORC ('CVAN', SKPRNO, DA, CARD, *250) 05670000 GO TO 240 05680000 C 05690000 250 IF (S1CPCH(TYPE,1,'UVS',1,3) .EQ. 0) GO TO 260 05700000 C 05710000 C CALCULATE FOR 'SVS' AND 'STS' 05720000 C 05730000 PRIMRY = NVEL * NSUM 05740000 GO TO 5200 05750000 C 05760000 C CALCULATE FOR 'UVS' 05770000 C 05780000 260 IF (S1CPCH(MODE,1,'D',1,1) .EQ. 0) GO TO 270 05790000 C 'UVS' - SHOTPOINT MODE 05800000 C 05810000 IF (NSUM .GT. LCANSP) NSUM = LCANSP 05820000 PRIMRY = NVEL * NSUM * LCTPSP 05830000 GO TO 5200 05840000 C 'UVS' - DEPTH POINT MODE 05850000 270 PRIMRY = NVEL * NSUM * LCMXFD 05860000 GO TO 5200 05870000 C PRIMARY BLOCKS SPECIFIED ON CVAN CARD 05880000 280 PRIMRY = PRIMRY + (PRIMRY / (NVEL - 1)) 05890000 GO TO 5200 05900000 C 05910000 C=======================================================================05920000 C CHECK PROC CARDS FOR 'COVE' PROCESS 05930000 C=======================================================================05940000 C 05950000 290 CALL JSPAC1 (KPNA,KPRNO,OCCUR,'COVE',SKPRNO) 05960000 IF (SKPRNO .GE. 0) GO TO 300 05970000 IF (SKPRNO .EQ. -1) GO TO 330 05980000 GO TO 5400 05990000 C 06000000 C CALCULATE SPACE FOR VELOCITY OUTPUTS 06010000 C 06020000 300 DA = 1 06030000 TOTTSV = 0 06040000 NUMOUT = 5 06050000 C 06060000 310 CALL FORC ('COVE',SKPRNO,DA,CARD, *320) 06070000 IF (S1CPCH(CARD,8,' ',1,3) .NE. 0) GO TO 310 06080000 SPT = S1CVBN(CARD,11,5) 06090000 EPT = S1CVBN(CARD,16,5) 06100000 IF (EPT .EQ. 0) EPT = SPT 06110000 TOTTSV = TOTTSV + EPT - SPT + 1 06120000 GO TO 310 06130000 C 06140000 320 IF (TOTTSV .EQ. 0) GO TO 8200 06150000 PRIMRY = TOTTSV * NUMOUT + NUMOUT 06160000 GO TO 5200 06170000 C 06180000 C=======================================================================06190000 C CHECK PROC CARDS FOR 'COVA' PROCESS 06200000 C=======================================================================06210000 C 06220000 330 CALL JSPAC1 (KPNA,KPRNO,OCCUR,'COVA',SKPRNO) 06230000 IF (SKPRNO .GE. 0) GO TO 340 06240000 IF (SKPRNO .EQ. -1) GO TO 370 06250000 GO TO 5400 06260000 C 06270000 C CALCULATE SPACE FOR VELOCITY OUTPUTS 06280000 C 06290000 340 DA = 1 06300000 TOTTSV = 0 06310000 NUMOUT = 30 06320000 C 06330000 350 CALL FORC ('COVA',SKPRNO,DA,CARD, *360) 06340000 IF (S1CPCH(CARD,8,' ',1,3) .NE. 0) GO TO 350 06350000 SPT = S1CVBN(CARD,11,5) 06360000 EPT = S1CVBN(CARD,16,5) 06370000 IF (EPT .EQ. 0) EPT = SPT 06380000 TOTTSV = TOTTSV + EPT - SPT + 1 06390000 GO TO 350 06400000 C 06410000 360 IF (TOTTSV .EQ. 0) GO TO 8100 06420000 PRIMRY = TOTTSV * NUMOUT + NUMOUT 06430000 GO TO 5200 06440000 C 06450000 C=======================================================================06460000 C CHECK PROC CARDS FOR VPRO PROCESS 06470000 C=======================================================================06480000 C 06490000 370 CALL JSPAC1 (KPNA,KPRNO,OCCUR,'VPRO', SKPRNO) 06500000 IF (SKPRNO .GE. 0) GO TO 380 06510000 IF (SKPRNO .EQ. -1) GO TO 391 06520000 GO TO 5400 06530000 C 06540000 C GET VPRO CARDS 06550000 C 06560000 380 DA = 1 06570000 PRIMRY = 0 06580000 C 06590000 390 CALL FORC ('VPRO',SKPRNO,DA,CARD, *5200) 06600000 N = S1CVBN (CARD, 11, 5) 06610000 M = S1CVBN (CARD, 16, 5) 06620000 IF (M .EQ. 0) M = N 06630000 PRIMRY = PRIMRY + IABS(M-N) + 1 06640000 GO TO 390 06650000 C 06660000 C=======================================================================06670000 C CHECK PROC CARDS FOR 'VSPD' PROCESS 06680000 C=======================================================================06690000 C 06700000 391 CALL JSPAC1 (KPNA, KPRNO, OCCUR, 'VSPD', SKPRNO) 06710000 IF (SKPRNO .GE. 0) GO TO 392 06720000 IF (SKPRNO .EQ. -1) GO TO 400 06730000 GO TO 5400 06740000 C 06750000 C PROVIDE SUFFICIENT SPACE FOR TWO COPIES OF INPUT 06760000 C IF FL1 CARD IS PRESENT 06770000 C 06780000 392 DA = 1 06790000 393 CALL FORC ('VSPD', SKPRNO, DA, CARD, *395 )06800000 IF (S1CPCH(CARD, 8, ' ', 1, 3) .NE. 0) GO TO 394 06810000 SPT1 = S1CVBN(CARD,11,5) 06820000 EPT1 = S1CVBN(CARD,16,5) 06830000 NTIN1= S1CVBN(CARD,21,5) 06840000 IF(NTIN1.LE.0) NTIN1=MAX0(LCTPSP,LCMXFD) 06850000 SPT2 = S1CVBN(CARD,31,5) 06860000 EPT2 = S1CVBN(CARD,36,5) 06870000 NTIN2= S1CVBN(CARD,41,5) 06880000 IF(NTIN2.LE.0) NTIN2=MAX0(LCTPSP,LCMXFD) 06890000 C 06900000 NREC = IABS(EPT1-SPT1) + 1 06910000 NREC = NREC*NTIN1 06920000 NREC = NREC + (IABS(EPT2-SPT2)+1)*NTIN2 06930000 TREC = 0 06940000 GO TO 393 06950000 C 06960000 394 IF (S1CPCH(CARD, 8, 'FL1 ', 1, 3) .NE. 0) GO TO 393 06970000 TREC = 2*NREC 06980000 C 06990000 395 IF(TREC.LE.0) GO TO 400 07000000 PRIMRY = TREC 07010000 GO TO 5300 07020000 C 07030000 C=======================================================================07040000 C CHECK PROC CARDS FOR 'TSUM' PROCESS 07050000 C=======================================================================07060000 C 07070000 400 CALL JSPAC1 (KPNA,KPRNO,OCCUR,'TSUM', SKPRNO) 07080000 IF (SKPRNO .GE. 0) GO TO 410 07090000 IF (SKPRNO .EQ. -1) GO TO 450 07100000 GO TO 5400 07110000 C 07120000 C IF PADDING OR NOSUM , THEN NO REDUCTION 07130000 C 07140000 410 DA = 1 07150000 C 07160000 420 CALL FORC ('TSUM',SKPRNO, DA, CARD, *430) 07170000 IF (S1CPCH(CARD,28,'PAD',1,3) .EQ. 0) GO TO 450 07180000 IF (S1CPCH(CARD, 8,' ',1,3) .NE. 0) GO TO 420 07190000 IF (S1CPCH(CARD,23,'LOC',1,3) .EQ. 0) GO TO 450 07200000 IF (S1CPCH(CARD,41,' ',1,5) .EQ. 0) GO TO 420 07210000 N = S1CVBN(CARD,41,5) 07220000 DDA = 1 07230000 425 CALL FORC('TSUM',SKPRNO,DDA,CARD, *5200) 07240000 IF(S1CPCH(CARD,8,'NMO',1,3) .NE. 0) GO TO 425 07250000 M = S1CVBN(CARD,11,5) 07260000 IF (M .NE. N) GO TO 425 07270000 IF( S1CPCH(CARD,21,' ',1,5) .NE. 0) GO TO 450 07280000 GO TO 420 07290000 C 07300000 C GET INFORMATION FROM 'TSUM' CARDS 07310000 C 07320000 430 DA = 1 07330000 PRIMRY = 0 07340000 C 07350000 435 CALL FORC ('TSUM',SKPRNO,DA,CARD, *5200) 07360000 IF (S1CPCH(CARD,8,' ',1,3) .NE. 0) GO TO 435 07370000 N = S1CVBN(CARD,11,5) 07380000 M = S1CVBN(CARD,16,5) 07390000 IF (M .EQ. 0) M = N 07400000 TPS = LCTPSP 07410000 IF (S1CPCH(CARD, 7,'D',1,1) .EQ. 0) TPS = LCMXFD 07420000 INTFLG = 1 07430000 IF (S1CPCH(CARD ,6,'L',1,1) .EQ. 0) INTFLG = 1 07440000 IF (S1CPCH(CARD ,6,'N',1,1) .EQ. 0) INTFLG = 2 07450000 IF (S1CPCH(PMODE,1,'N',1,1) .EQ. 0) INTFLG = 2 07460000 CALL S1MVCH(CARD,23,STYPE,1,3) 07470000 IF(S1CPCH(STYPE,1,' ',1,3).EQ.0) STYPE = TRC 07480000 SUMID = S1CVBN(CARD,26,5) 07490000 C 07500000 DDA = 1 07510000 440 CALL FORC ('TSUM',SKPRNO,DDA,CARD, *435) 07520000 IF (S1CPCH(CARD,8,STYPE,1,3) .NE. 0) GO TO 440 07530000 ID = S1CVBN(CARD,11,5) 07540000 IF (ID .NE. SUMID) GO TO 440 07550000 C 07560000 CISSM = S1CVBN(CARD, 41, 5) 07570000 IF (CISSM .EQ. 0) CISSM = 1 07580000 NSUMOT = TPS / CISSM + 1 07590000 GO TO (441, 445) ,INTFLG 07600000 C 07610000 441 IF (PRIMRY .EQ. 0) SAVE = N + 1 07620000 PRIMRY = PRIMRY + NSUMOT*(IABS(M-N)+IABS(SAVE-N)) 07630000 SAVE = M 07640000 GO TO 435 07650000 445 PRIMRY = PRIMRY + NSUMOT*(IABS(M-N)+1) 07660000 GO TO 435 07670000 C 07680000 C=======================================================================07690000 C CHECK PROC CARDS FOR 'NMOC' PROCESS 07700000 C=======================================================================07710000 C 07720000 450 CALL JSPAC1 (KPNA, KPRNO, OCCUR, 'NMOC', SKPRNO) 07730000 IF (SKPRNO .GE. 0) GO TO 460 07740000 IF (SKPRNO .EQ. -1) GO TO 500 07750000 GO TO 5400 07760000 C 07770000 C IF 'VFU' THEN NEED TO ADD SPACE FOR AUX. TRACE 07780000 C 07790000 460 DA = 1 07800000 470 CALL FORC ('NMOC', SKPRNO, DA, CARD, *500) 07810000 IF (S1CPCH(CARD, 53, 'VFU', 1, 3) .NE. 0) GO TO 470 07820000 C 07830000 PRIMRY = (LCTPSP + 1) * LCANSP 07840000 GO TO 5200 07850000 C 07860000 C=======================================================================07870000 C CHECK PROC CARDS FOR 'VSUM' PROCESS 07880000 C=======================================================================07890000 C 07900000 500 CALL JSPAC1(KPNA,KPRNO,OCCUR,'VSUM',SKPRNO) 07910000 IF(SKPRNO .GE. 0) GO TO 510 07920000 IF(SKPRNO .EQ. -1) GO TO 600 07930000 GO TO 5400 07940000 510 DA = 1 07950000 PRIMRY = 0 07960000 C 07970000 C GET INFORMATION FROM 'VSUM' CARDS 07980000 C 07990000 520 CALL FORC('VSUM',SKPRNO,DA,CARD, *5300) 08000000 IF (S1CPCH(CARD,8,' ',1,3) .NE. 0) GO TO 520 08010000 IF (S1CPCH(CARD,62,'CXGS',1,4) .EQ. 0) GO TO 600 08020000 CALL S1MVCH( CARD, 7, MODE, 2, 1) 08030000 IF (S1CPCH( MODE, 2,' ',1,1) .EQ. 0) MODE = PMODE 08040000 C 08050000 530 SAVE = 0 08060000 SDP = S1CVBN(CARD,11,5) 08070000 EDP = S1CVBN(CARD,16,5) 08080000 IF (EDP .EQ. 0) EDP = SDP 08090000 NSUM = S1CVBN(CARD,31,5) 08100000 NINC = S1CVBN(CARD,36,5) 08110000 SINC = S1CVBN(CARD,41,5) 08120000 IF (NINC .EQ. 0) NINC = 1 08130000 IF (SINC .EQ. 0) SINC = 1 08140000 C 08150000 C CHECK CARDS FOR 'TRC' 08160000 C 08170000 NTRC = 0 08180000 IF (S1CPCH( CARD, 23, 'TRC', 1, 3) .NE. 0) GO TO 570 08190000 ID = S1CVBN (CARD,26,5) 08200000 DDA = 1 08210000 550 CALL FORC ('VSUM', SKPRNO, DDA, CARD, * 570) 08220000 IF (S1CPCH(CARD, 8, 'TRC', 1, 3) .NE. 0) GO TO 550 08230000 IDD = S1CVBN (CARD,11,5) 08240000 IF (IDD .NE. ID) GO TO 550 08250000 DO 560 I = 21,80,5 08260000 ITRC = S1CVBN(CARD,I,5) 08270000 IF (ITRC .EQ. 0) GO TO 560 08280000 IF (ITRC .LT. 0) NTRC = NTRC + (IABS(ITRC)-SAVE) - 1 08290000 NTRC = NTRC + 1 08300000 SAVE = ITRC 08310000 560 CONTINUE 08320000 GO TO 550 08330000 570 MAXTR = NTRC 08340000 IF (MAXTR .LE. 0) MAXTR = LCTPSP 08350000 IF (S1CPCH(MODE, 2, 'D', 1, 1) .EQ. 0 .AND. NTRC .EQ. 0) 08360000 * MAXTR = LCMXFD 08370000 C 08380000 C CALCULATE SPACE FOR 'VSUM' 08390000 C 08400000 NSUMOT=((IABS(EDP-SDP)+1)-(NSUM*NINC-(NINC-1)))/SINC+2 08410000 PRIMRY = PRIMRY + NSUMOT*MAXTR 08420000 580 CALL FORC ('VSUM', SKPRNO, DA, CARD, * 5300) 08430000 IF (S1CPCH( CARD, 8, ' ', 1, 3) .NE. 0) GO TO 580 08440000 GO TO 530 08450000 C 08460000 C=======================================================================08470000 C CHECK PROC CARDS FOR 'D3NT' PROCESS 08480000 C=======================================================================08490000 C 08500000 600 CALL JSPAC1 (KPNA, KPRNO, OCCUR, 'D3NT', SKPRNO) 08510000 IF (SKPRNO .GE. 0) GO TO 610 08520000 IF (SKPRNO .EQ. -1) GO TO 700 08530000 GO TO 5400 08540000 C 08550000 C IF RESOLUTION ENHANCEMENT PERFORMED, OUTPUT > INPUT 08560000 C 08570000 610 DA = 1 08580000 620 CALL FORC ('D3NT', SKPRNO, DA, CARD, *700) 08590000 IF (S1CPCH(CARD, 8, ' ', 1, 3) .NE. 0) GO TO 620 08600000 C 08610000 BCDP = S1CVBN (CARD, 11, 5) 08620000 ECDP = S1CVBN (CARD, 16, 5) 08630000 IF ( ECDP.EQ.0 ) ECDP = BCDP 08640000 RES = S1CVBN (CARD, 41, 5) 08650000 IF ( S1CPCH(CARD,42,' ',1,4).EQ.0 ) RES =1 08660000 MODE = MODE0 08670000 IF ( RES.EQ.0 ) GO TO 630 08680000 IF ( S1CPCH(CARD,62,' ',1,4).EQ.0 ) MODE=MODE1 08690000 IF ( S1CPCH(CARD,62,'XDIR',1,4).EQ.0 ) MODE=MODE1 08700000 IF ( S1CPCH(CARD,62,'YDIR',1,4).EQ.0 ) MODE=MODE2 08710000 IF ( S1CPCH(CARD,62,'BOTH',1,4).EQ.0 ) MODE=MODE3 08720000 C 08730000 630 BLNN = S1CVBN (CARD, 66, 5) 08740000 ELNN = S1CVBN (CARD, 71, 5) 08750000 IF ( ELNN.EQ.0 ) ELNN = BLNN 08760000 C 08770000 NXM = IABS(ECDP - BCDP) + 1 08780000 NYM = IABS(ELNN - BLNN) + 1 08790000 IBTX = 0 08800000 IBTY = 0 08810000 IF (MODE.NE.MODE2) IBTX = RES 08820000 IF (MODE.NE.MODE1) IBTY = RES 08830000 NXD = NXM + (NXM-1)*IBTX 08840000 NYD = NYM + (NYM-1)*IBTY 08850000 C 08860000 PRIMRY = NXD*NYD 08870000 GO TO 5300 08880000 C 08890000 C=======================================================================08900000 C CHECK PROC CARDS FOR 'SCDA' 'SCDB' OR 'SCDC' PROCESS 08910000 C=======================================================================08920000 700 PROC = SCDA 08930000 PRIMRY = 0 08940000 C 08950000 710 CALL JSPAC1 (KPNA, KPRNO, OCCUR, PROC, SKPRNO) 08960000 IF (SKPRNO .GE. 0) GO TO 720 08970000 IF (SKPRNO .EQ. -1) GO TO 730 08980000 GO TO 5400 08990000 C 09000000 720 PRIMRY = MAX0(PRIMRY,(LCTPSP*2*LCANSP)) 09010000 PRIMRY = MAX0(PRIMRY,(LCMXFD*2*LCANSP)) 09020000 GO TO 5200 09030000 C 09040000 730 IF(PROC.EQ.SCDB) THEN 09050000 PROC = SCDC 09060000 GO TO 710 09070000 END IF 09080000 IF(PROC.EQ.SCDA) THEN 09090000 PROC = SCDB 09100000 GO TO 710 09110000 END IF 09120000 C 09130000 C=======================================================================09140000 C CHECK PROC CARDS FOR 'DDEC' PROCESS 09150000 C=======================================================================09160000 C 09170000 CALL JSPAC1 (KPNA, KPRNO, OCCUR, 'DDEC', SKPRNO) 09180000 IF (SKPRNO .GE. 0) GO TO 770 09190000 IF (SKPRNO .EQ. -1) GO TO 800 09200000 GO TO 5400 09210000 C 09220000 770 PRIMRY = (MAX0(LCMXFD,LCTPSP) * 2) * LCANSP 09230000 GO TO 5200 09240000 C 09250000 C=======================================================================09260000 C CHECK PROC CARDS FOR 'TRAK' PROCESS 09270000 C=======================================================================09280000 C 09290000 800 CALL JSPAC1 (KPNA, KPRNO, OCCUR, 'TRAK', SKPRNO) 09300000 IF (SKPRNO .GE. 0) GO TO 810 09310000 IF (SKPRNO .EQ. -1) GO TO 850 09320000 GO TO 5400 09330000 C 09340000 C IF 'ONN' THEN NEED TO ADD SPACE FOR AUX. TRACE 09350000 C 09360000 810 DA = 1 09370000 AUXTRC = 0 09380000 820 CALL FORC ('TRAK', SKPRNO, DA, CARD, *850) 09390000 IF (S1CPCH(CARD, 8, ' ', 1, 3) .NE. 0) GO TO 820 09400000 IF (S1CPCH(CARD, 58, 'ONN', 1, 3) .EQ. 0) AUXTRC = 1 09410000 C 09420000 PRIMRY = (LCTPSP + AUXTRC) * LCANSP 09430000 GO TO 5200 09440000 C 09450000 C=======================================================================09460000 C CHECK PROC CARDS FOR 'VELA' PROCESS 09470000 C=======================================================================09480000 C 09490000 850 CALL JSPAC1 (KPNA, KPRNO, OCCUR, 'VELA', SKPRNO) 09500000 IF (SKPRNO .GE. 0) GO TO 860 09510000 IF (SKPRNO .EQ. -1) GO TO 900 09520000 GO TO 5400 09530000 C 09540000 860 CONTINUE 09550000 PRIMRY = (LCMXFD * LCANSP) * 1.25 09560000 C 09570000 GO TO 5200 09580000 C 09590000 C=======================================================================09600000 C CHECK PROC CARDS FOR 'VSPW' PROCESS 09610000 C=======================================================================09620000 C 09630000 900 CALL JSPAC1(KPNA,KPRNO,OCCUR,'VSPW',SKPRNO) 09640000 IF(SKPRNO .GE. 0) GO TO 910 09650000 IF(SKPRNO .EQ. -1) GO TO 1000 09660000 GO TO 5400 09670000 910 DA = 1 09680000 PRIMRY = 0 09690000 MAXTR = LCTPSP 09700000 C 09710000 C GET INFORMATION FROM 'VSPW' CARDS 09720000 C 09730000 920 CALL FORC('VSPW',SKPRNO,DA,CARD, *5300) 09740000 IF (S1CPCH(CARD,8,' ',1,3) .NE. 0) GO TO 920 09750000 CALL S1MVCH( CARD, 7, MODE, 2, 1) 09760000 IF (S1CPCH( MODE, 2,' ',1,1) .EQ. 0) MODE = PMODE 09770000 C 09780000 930 SAVE = 0 09790000 SDP = S1CVBN(CARD,11,5) 09800000 EDP = S1CVBN(CARD,16,5) 09810000 IF (EDP .EQ. 0) EDP = SDP 09820000 NSUM = S1CVBN(CARD,21,5) 09830000 NINC = S1CVBN(CARD,26,5) 09840000 SINC = S1CVBN(CARD,31,5) 09850000 IF (NINC .EQ. 0) NINC = 1 09860000 IF (SINC .EQ. 0) SINC = 1 09870000 C 09880000 C 09890000 C CALCULATE SPACE FOR 'VSPW' 09900000 C 09910000 NSUMOT=((IABS(EDP-SDP)+1)-(NSUM*NINC-(NINC-1)))/SINC+2 09920000 PRIMRY = PRIMRY + NSUMOT*MAXTR 09930000 980 CALL FORC ('VSPW', SKPRNO, DA, CARD, * 5300) 09940000 IF (S1CPCH( CARD, 8, ' ', 1, 3) .NE. 0) GO TO 980 09950000 GO TO 930 09960000 C 09970000 C=======================================================================09980000 C CHECK PROC CARDS FOR 'VSPV' PROCESS 09990000 C=======================================================================10000000 C 10010000 1000 CALL JSPAC1(KPNA,KPRNO,OCCUR,'VSPV',SKPRNO) 10020000 IF(SKPRNO .GE. 0) GO TO 1010 10030000 IF(SKPRNO .EQ. -1) GO TO 1100 10040000 GO TO 5400 10050000 1010 DA = 1 10060000 PRIMRY = 250 10070000 C 10080000 C GET INFORMATION FROM 'VSPV' CARDS 10090000 C 10100000 1020 CALL FORC('VSPV',SKPRNO,DA,CARD, *5300) 10110000 IF (S1CPCH(CARD,8,' ',1,3) .NE. 0) GO TO 1020 10120000 C 10130000 SDP = S1CVBN(CARD,11,5) 10140000 EDP = S1CVBN(CARD,16,5) 10150000 NVET = S1CVBN(CARD,21,5) 10160000 IF(NVET .LE. 0) NVET = 5 10170000 NTPV = S1CVBN(CARD,26,5) 10180000 IF(NTPV .LE. 0) NTPV = 4 10190000 PRIMARY = 2*(EDP-SDP + 1) + NVET*NTPV 10200000 GO TO 5300 10210000 C 10220000 C=======================================================================10230000 C CHECK PROC CARDS FOR 'RAMR' PROCESS 10240000 C=======================================================================10250000 C 10260000 1100 CALL JSPAC1(KPNA,KPRNO,OCCUR,'RAMR',SKPRNO) 10270000 IF(SKPRNO .EQ. -1) GO TO 4000 10280000 IF(SKPRNO .EQ. -2) GO TO 8030 10290000 C 10300000 C RAMR IS PRESENT. COMPUTE SPACE ACCORDINGLY. 10310000 C 10320000 DA = 1 10330000 NOCARD = 0 10340000 SKPNA = RAMR 10350001 1110 CALL FORC('RAMR', SKPRNO, DA, CARD, *1130) 10360000 IF(S1CPCH(CARD, 8, BLANK, 1, 3) .NE. 0) GO TO 1110 10370000 NOCARD = NOCARD + 1 10380000 IS1 = S1CVBN(CARD, 11, 5) 10390000 ISN = S1CVBN(CARD, 16, 5) 10400000 CALL USCHFT(CARD, 26, 5, FMAX) 10410000 IL = S1CVBN(CARD, 41, 5) 10420000 CALL USCHFT(CARD, 46, 5, DP) 10430000 CALL S1MVCH(CARD, 7, MODE, 1, 1) 10440000 IF (S1CPCH(MODE, 1, ' ', 1, 1) .EQ. 0) 10450000 * CALL S1MVCH(PMODE, 2, MODE, 1, 1) 10460000 MAXTR = LCTPSP 10470000 IF (S1CPCH(MODE, 1, 'D', 1, 1) .EQ. 0) MAXTR = LCMXFD 10480000 IF (S1CPCH(MODE, 1, 'T', 1, 1) .EQ. 0) MAXTR = IABS(ISN-IS1) + 1 10490000 C 10500000 CALL S1FMAG ( NOSAMP, MAG, N2) 10510000 MAG = MAG + IL 10520000 N2 = 2 ** MAG 10530000 SF = 1000. / (FLOAT(PI) * FLOAT(N2)) 10540000 IF (FMAX .EQ. 0) FMAX = SF * FLOAT(N2/2) 10550000 IF (DP .EQ. 0) DP = 500. / FMAX 10560000 C 10570000 DA = 1 10580000 NOCARD = 0 10590000 SKPNA = RAMR 10600000 1120 CALL FORC('RAMR', SKPRNO, DA, CARD, *1130) 10610000 IF (S1CPCH(CARD, 8, 'DST', 1, 3) .NE. 0) GO TO 1120 10620000 NOCARD = NOCARD + 1 10630000 C 10640000 CALL USCHFT (CARD, 11, 5, X1) 10650000 CALL USCHFT (CARD, 16, 5, XN) 10660000 CALL USCHFT (CARD, 21, 5, DX) 10670000 C 10680000 NX = 1 + NINT((XN-X1) / DX) 10690000 NX = MAX0(NX, MAXTR) 10700000 RDIST = XN 10710000 HDIST = .4142136 * RDIST 10720000 PMAX = 1.E3*HDIST / (FMAX*DX) 10730000 C 10740000 NP = 1 + NINT(PMAX/DP) 10750000 NX = MAX0 ( NX, NP) 10760000 PRIMRY = (ISN-IS1+1) * NX 10770000 C 10780000 1130 IF (NOCARD .EQ. 0) GO TO 8020 10790000 C 10800000 GO TO 5300 10810000 C 10820000 C 10830000 C====================================================================== 10840000 C AS THE VERY LAST TEST AND ONLY IF NONE OF THE 10850000 C OTHER PROCESSES HAVE BEEN FOUND, LOOK FOR SELT. 10860000 C ANY OTHER NEW PROCESSES ADDED SHOULD PROBABLY 10870000 C BE ADDED BEFORE SELT. 10880000 C====================================================================== 10890000 C 10900000 4000 CALL JSPAC1 (KPNA, KPRNO, OCCUR, 'SELT', SKPRNO) 10910000 IF (SKPRNO .EQ. -1) GO TO 5100 10920000 IF (SKPRNO .LT. -1) GO TO 8030 10930000 C 10940000 C CALCULATE SPACE FOR SELECTED RANGE 10950000 C 10960000 PRIMRY = 0 10970000 DA = 1 10980000 4100 CALL FORC ('SELT', SKPRNO, DA, CARD, *8010) 10990000 IF (S1CPCH(CARD,8,' ',1,3) .NE. 0) GO TO 4100 11000000 CALL S1MVCH (CARD, 7, MODE, 2, 1) 11010000 IF (S1CPCH(MODE,2,' ',1,1) .EQ. 0) MODE = PMODE 11020000 C 11030000 4300 SAVE = 0 11040000 LNS = 0 11050000 SPT = S1CVBN (CARD, 11, 5) 11060000 EPT = S1CVBN (CARD, 16, 5) 11070000 IF (EPT .EQ. 0) EPT = SPT 11080000 NSUM = S1CVBN (CARD, 31, 5) 11090000 IF (NSUM .EQ. 0) NSUM = 1 11100000 SINC = S1CVBN (CARD, 41, 5) 11110000 IF (SINC .EQ. 0) SINC = 1 11120000 NPTS = ((IABS(EPT - SPT) + SINC) / SINC) * NSUM 11130000 LS = S1CVBN (CARD, 66, 5) 11140000 IF (LS .EQ. 0) GO TO 4400 11150000 LE = S1CVBN (CARD, 71, 5) 11160000 IF (LE .EQ. 0) LE = LS 11170000 C 11180000 LINC = S1CVBN (CARD, 76, 5) 11190000 IF (LINC .EQ. 0) LINC = 1 11200000 LNS = ((LE - LS ) + LINC) / LINC 11210000 4400 NTRC = 0 11220000 C 11230000 C CHECK CARDS FOR 'TRC' 11240000 C 11250000 IF (S1CPCH(CARD,23,'TRC',1,3) .NE. 0) GO TO 4700 11260000 ID = S1CVBN(CARD,26,5) 11270000 DDA = 1 11280000 4500 CALL FORC('SELT',SKPRNO,DDA,CARD, *4700) 11290000 IF (S1CPCH(CARD,8,'TRC',1,3) .NE. 0) GO TO 4500 11300000 IDD = S1CVBN(CARD,11,5) 11310000 IF (IDD .NE. ID) GO TO 4500 11320000 INEG = 0 11330000 DO 4600 11340000 *I = 21,80,5 11350000 ITRC = S1CVBN(CARD,I,5) 11360000 IF (NTRC .GT. 0 .AND. S1CPCH(CARD,I,' -',1,5) .EQ. 0) THEN 11370000 INEG=1 11380000 GO TO 4600 11390000 END IF 11400000 IF (ITRC .EQ. 0) GO TO 4600 11410000 IF (ITRC .LT. 0 .OR. INEG .EQ. 1) 11420000 * NTRC = NTRC + IABS((IABS(ITRC)-SAVE))-1 11430000 INEG = 0 11440000 NTRC = NTRC + 1 11450000 SAVE = ITRC 11460000 4600 CONTINUE 11470000 GO TO 4500 11480000 4700 MAXTR = NTRC 11490000 IF (MAXTR .LE. 0) MAXTR = LCTPSP 11500000 IF (S1CPCH(MODE,2,'D',1,1) .EQ. 0 .AND. NTRC .EQ. 0) 11510000 * MAXTR = LCMXFD 11520000 IF (S1CPCH(MODE,2,'S',1,1) .EQ. 0 .AND. NPTS .GT. LCANSP) 11530000 * NPTS = LCANSP 11540000 IF (LNS .EQ. 0) LNS = MXLNS 11550000 PRIMRY = PRIMRY + NPTS*MAXTR*LNS 11560000 C 11570000 C 11580000 4800 CALL FORC ('SELT', SKPRNO, DA, CARD, *5300) 11590000 IF (S1CPCH(CARD,8,' ',1,3) .NE. 0) GO TO 4800 11600000 GO TO 4300 11610000 C 11620000 C CALCULATE SPACE FOR ALL SHOTPOINTS (UNSTACKED) 11630000 C 11640000 5100 PRIMRY = LCTPSP * LCANSP 11650000 C 11660000 5200 PRIMRY = PRIMRY*MXLNS 11670000 5300 SECDRY = .03 * PRIMRY + .999 11680000 C 11690000 C CHECK FOR WT3D AND PLOT PARAMETERS IF NECESSARY 11700000 C (ONLY IN JOBGEN; NOT SPARC) 11710000 C 11720000 CALL JPSNAM (JAPNMS) 11730000 IF (JAPNMS(9:12) .NE. 'SEIS' .AND. 11740000 * JAPNMS(9:12) .NE. 'STEP') GO TO 5500 11750000 C 11760000 C CHECK FOR WT3D 11770000 C 11780000 IF (S1CPCH(KPNA,1,'WT3D',1,4) .EQ. 0) THEN 11790000 IF (BLKSIZ .GT. 0) THEN 11800000 I = 32752/BLKSIZ 11810000 BLKSIZ = I*BLKSIZ + 8 11820000 PRIMRY = (PRIMRY-1)/I + 1 11830000 SECDRY = (SECDRY-1)/I + 1 11840000 ENDIF 11850000 ENDIF 11860000 C 11870000 C CHECK FOR ONLINE, OFFLINE, OR NO PLOTTING 11880000 C 11890000 DAC = 1 11900000 PLOTW = 36 11910000 C 11920000 5310 CALL FORC (KPNA, KPRNO, DAC, CARD, * 5500 )11930000 IF (S1CPCH(CARD, 8, BLANK, 1, 3) .NE. 0) GO TO 5310 11940000 OTYPE = -1 11950000 IF (S1CPCH(CARD, 76, 'OFESP', 1, 5) .EQ. 0) OTYPE = 0 11960000 IF (S1CPCH(CARD, 76, 'ONESP', 1, 5) .EQ. 0) GO TO 5320 11970000 IF (S1CPCH(CARD, 76, ' ESP', 1, 5) .EQ. 0) OTYPE = 2 11980000 IF (S1CPCH(CARD, 76, ' ', 1, 5) .EQ. 0) OTYPE = 2 11990000 IF (S1CPCH(CARD, 76, 'OFTAD', 1, 5) .EQ. 0) OTYPE = 3 12000000 IF (S1CPCH(CARD, 76, 'ONFAP', 1, 5) .EQ. 0) OTYPE = 3 12010000 IF (S1CPCH(CARD, 76, 'OFFAP', 1, 5) .EQ. 0) OTYPE = 3 12020000 IF (S1CPCH(CARD, 76, 'OFEBR', 1, 5) .EQ. 0) OTYPE = 3 12030000 IF (S1CPCH(CARD, 40, 'S', 1, 1) .EQ. 0 .AND. 12040000 * S1CPCH(CARD, 76, 'OFEBR', 1, 5) .EQ. 0) OTYPE = 4 12050000 IF (OTYPE .EQ. -1) GO TO 5500 12060000 IF (OTYPE .EQ. 4) THEN 12070000 WRITE (IPR, 98210) 12080000 GO TO 5400 12090000 END IF 12100000 GO TO 5330 12110000 C 12120000 5320 OTYPE = 1 12130000 IF (S1CPCH(CARD, 54, '22', 1, 2) .EQ. 0) PLOTW = 20 12140000 IF (S1CPCH(CARD, 54, '42', 1, 2) .EQ. 0) PLOTW = 42 12150000 C 12160000 C 12170000 5330 DAP = 1 12180000 CALL USPMCK(OTYPE,RLENG,PI,KPNA,KPRNO,IPR,KPRTF,PLOTW,DAP) 12190000 IF (KPRTF .LT. 0) GO TO 5400 12200000 GO TO 5500 12210000 C 12220000 C 12230000 5400 ERCODE = 16 12240000 C 12250000 5500 CONTINUE 12260000 C 12270000 RETURN 12280000 C 12290000 C ERROR MESSAGES 12300000 C 12310000 8000 WRITE (IPR, 98000) KPNA, KPRNO 12320000 GO TO 5400 12330000 C 12340000 8010 WRITE (IPR, 98010) KPNA, KPRNO, SKPRNO 12350000 GO TO 5400 12360000 C 12370000 8020 WRITE (IPR, 98020) SKPNA, SKPRNO 12380000 GO TO 5400 12390000 C 12400000 8030 WRITE (IPR, 98030) KPNA, KPRNO 12410000 GO TO 5400 12420000 C 12430000 8040 WRITE (IPR, 98040) KPNA, KPRNO, SKPRNO 12440000 GO TO 5400 12450000 C 12460000 C8050 WRITE (IPR, 98050) KPNA, KPRNO 12470000 C GO TO 5400 12480000 C 12490000 8060 WRITE (IPR, 98060) KPNA, KPRNO, SKPRNO 12500000 GO TO 5400 12510000 C 12520000 8065 WRITE (IPR, 98065) KPNA, KPRNO, SKPRNO 12530000 GO TO 5400 12540000 C 12550000 8067 WRITE (IPR, 98067) KPNA, KPRNO, SKPRNO 12560000 GO TO 5400 12570000 C 12580000 8068 WRITE (IPR, 98068) KPNA, KPRNO, SKPRNO 12590000 GO TO 5400 12600000 C 12610000 8090 WRITE (IPR, 98090) KPNA, KPRNO, SKPRNO 12620000 GO TO 5400 12630000 C 12640000 8100 WRITE (IPR, 98100) KPNA, KPRNO, SKPRNO 12650000 GO TO 5400 12660000 C 12670000 8200 WRITE (IPR, 98200) KPNA, KPRNO, SKPRNO 12680000 GO TO 5400 12690000 C 12700000 98000 FORMAT (/' *** JSWRTE DID NOT FIND LINE CARD') 12710000 C 12720000 98010 FORMAT (/' *** JSWRTE WHEN PROCESSING ',A4,I1, 12730000 * ' COULD NOT FIND DATA CARDS FOR SELT',I1) 12740000 C 12750000 98020 FORMAT (/' *** NO CARD PRESENT FOR PROC = ',A4,I1) 12760000 C 12770000 98030 FORMAT (/' *** PROCESS ',A4,I1,' IS NOT ON A PROC CARD') 12780000 C 12790000 98040 FORMAT (/' *** JSWRTE WHEN PROCESSING ',A4,I1, 12800000 * ' COULD NOT FIND DATA CARDS FOR CVAN',I1) 12810000 C 12820000 C8050 FORMAT (/' *** NO ACCT CARD PRESENT FOR PROC = ',A4,I1) 12830000 C 12840000 98060 FORMAT (/' *** JSWRTE WHEN PROCESSING ',A4,I1, 12850000 * ' COULD NOT FIND DATA CARDS FOR STAK',I1) 12860000 C 12870000 98065 FORMAT (/' *** JSWRTE WHEN PROCESSING ',A4,I1, 12880000 * ' COULD NOT FIND DATA CARDS FOR CSTK',I1) 12890000 C 12900000 98067 FORMAT (/' *** JSWRTE WHEN PROCESSING ',A4,I1, 12910000 * ' COULD NOT FIND DATA CARDS FOR STKW',I1) 12920000 C 12930000 98068 FORMAT (/' *** JSWRTE WHEN PROCESSING ',A4,I1, 12940000 * ' COULD NOT FIND DATA CARDS FOR STOC',I1) 12950000 C 12960000 98090 FORMAT (/' *** JSWRTE WHEN PROCESSING ',A4,I1, 12970000 * ' COULD NOT FIND DATA CARDS FOR FLTR',I1) 12980000 C 12990000 98100 FORMAT (/' *** JSWRTE WHEN PROCESSING ',A4,I1, 13000000 * ' COULD NOT FIND DATA CARDS FOR COVA',I1) 13010000 C 13020000 98200 FORMAT (/' *** JSWRTE WHEN PROCESSING ',A4,I1, 13030000 * ' COULD NOT FIND DATA CARDS FOR COVE',I1) 13040000 C 13050000 98210 FORMAT (/' *** JSWRTE WHEN PROCESSING ',A4,I1, 13060000 * ' SPOOLING NOT ALLOWED WITH OFEBR') 13070000 END 13080000