CTITLEJSSPAC -- JOBGEN SPACE ALGORITHM 00010000 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA AUTHOR J. MENDEKE 00020000 CA DESIGNER J. MENDEKE 00030000 CA LANGUAGE VS FORTRAN 00040000 CA WRITTEN 7-28-75 00050000 C REVISED 10-28-75 BY R. MCMILLAN TO ADD COMPUTATION FOR WRIT. 00060000 C REVISED 10-29-75 BY J. MENDEKE - ADDED PROC(3)=COST 00070000 C REVISED 11-17-75 BY W.J.BROWN - ADDED PROC(4)=VDSP 00080000 C REVISED 1-02-76 BY R.E.MCMILLAN TO ADD OCCUR TO PARAMETER LIST 00090000 C REVISED 1-08-76 BY W.J.BROWN - ADDED PROC(5)=RAMS 00100000 C REVISED 2-24-76 BY R. MCMILLAN -ADDED PROC(6)=CVAN 00110000 C AND CHANGED WRIT TO REFLECT CVAN. 00120000 C REVISED 3-02-76 BY R. MCMILLAN TO CHANGE WRIT 00130000 C CALCULATION FOR STACKED DATA. 00140000 C REVISED 3-10-76 BY R. MCMILLAN -ADDED PROC(7)=ZWRK 00150000 C AND PROC(8)=ZWRT 00160000 C REVISED 3-18-76 BY W.J.BROWN - FIXED A DEFAULT IN RAMS SECTION 00170000 C REVISED 4-28-76 BY R. MCMILLAN - FIXED A DEFAULT IN CVAN AND 00180000 C WRIT SECTIONS AND CHANGED WRIT FOR UNSTACKED 00190000 C DATA. 00200000 C REVISED 4-28-76 BY J. MENDEKE -ADDED PROC(9)=VSUM 00210000 C ALSO DEFAULTED PMODE TO 'LS'. 00220000 C REVISED 5-26-76 BY W.V. REDWINE - ADDED PROC(10) = LRAC 00230000 C REVISED 5-26-76 BY D.D. REED - ADDED PROC(11) = SCON 00240000 C REVISED 6-02-76 BY R.C. DECKER - ADDED PROC(12) = REMT 00250000 C REVISED 6-21-76 BY R. MCMILLAN - ADDED PROC(13) = FANF 00260000 C REVISED 6-23-76 BY W.J.BROWN - ADDED PROC(14) = GDSP 00270000 C REVISED 8-09-76 BY J. MENDEKE - ADDED PROC(15) = GVAN 00280000 C REVISED 10-11-76 BY W.J.BROWN - CHANGED ERROR FACTOR TO 200 TKS00290000 C IN GDSP. 00300000 C REVISED 11-18-76 MENDEKE - CHANGED GATH 00310000 C REVISED 11-29-76 MENDEKE - ADDED SECONDARY TO GATH 00320000 C REVISED 12-05-76 MENDEKE - CHANGED GATH 00330000 C REVISED 12-09-76 MENDEKE - CHANGED GVAN TO VELA AND GDSP TO VELD.00340000 C REVISED 12-15-76 D.D.REED - CHANGED SCON TO WRITE 00350000 C RECORDS FOR PILOT ITERATION. 00360000 C REVISED 12-22-76 MENDEKE - ADDED GMAP 00370000 C REVISED 1-03-77 BY W.J.BROWN - FIXED A DEFAULT IN 00380000 C RAMS. 00390000 C REVISED 1-06-77 D.D.REED - FIXED SCON TO WRITE 00400000 C OUT SHIFTED TRACES FOR PILOT ITER. 00410000 C REVISED 1-10-77 MCMILLAN - ADDED MIGR. 00420000 C REVISED 1-20-77 MCMILLAN - CHANGED MIGR. 00430000 C REVISED 2-10-77 MENDEKE - FIX OF VELD. 00440000 C REVISED 2-16-77 MENDEKE - FIX OF VELD. 00450000 C REVISED 3-08-77 MENDEKE - FIX OF VELD 00460000 C REVISED 3-11-77 D.D.REED - ADDED KONG AND SKIM 00470000 C REVISED 3-25-77 D.D.REED - FIXED SCON TO ALLOW 00480000 C FOR MXDPPP DEFAULT 00490000 C REVISED 4-06-77 MENDEKE - VELD CHANGE 00500000 C REVISED 4-11-77 MENDEKE - VELD CHANGE 00510000 C REVISED 4-12-77 MENDEKE - VELD AGAIN 00520000 C REVISED 5-11-77 MENDEKE -ADDED CSTK 00530000 C REVISED 6-21-77 MCMILLAN - ADDED FLTR AND CHANGED 00540000 C WRIT FOR FLTR. 00550000 C REVISED 6-23-77 WHIPPLE - ADDED SELT 00560000 C REVISED 6-30-77 MENDEKE - ADDED CSTK CODE TO WRIT 00570000 C REVISED 8-29-77 WHIPPLE - CHANGED VELD FOR RASTER 00580000 C OUTPUT. 00590000 C REVISED 9-19-77 MCMILLAN - MADE SEPARATE ROUTINES 00600000 C FOR VELA, VELD, MIGR, 00610000 C AND FLTR SO JSSPAC 00620000 C WOULD COMPILE. 00630000 C REVISED 9-21-77 MENDEKE - ADDED CHECK FOR CSTK IN 00640000 C WRIT AND RAMS 00650000 C REVISED 9-21-77 DECKER - ADDED PLGP 00660000 C REVISED 10-10-77 REED - ADDED TRAC 00670000 C REVISED 1-16-78 MCMILLAN - FIX FANF FOR 'S' MODE 00680000 C REVISED 1-23-78 COLLINS - ADDED QUAD, PROC(25). 00690000 C REVISED 1-23-78 DECKER - ADDED DELA, PROC(26). 00700000 C REVISED 2-15-78 COLLINS - ADDED QUAD TO WRIT. 00710000 C RENUMBERED STATEMENTS. 00720000 C REVISED 2-28-78 COLLINS - ADDED READ, PROC(27). 00730000 C REVISED 2-28-78 DECKER - FIX REMT. 00740000 C REVISED 2-28-78 MCMILLAN - ADDED DMIG, PROC(28). 00750000 C REVISED 3--3-78 COLLINS - REVISED QUAD FORMULAS. 00760000 C REVISED 3-29-78 DECKER - ADDED MIGE (PROC(29)) 00770000 C REVISED 4-13-78 MENDEKE - CHANGED GATH 00780000 C REVISED 6-02-78 DECKER - ADDED VELB, DTRC. 00790000 C REVISED 6-27-78 COLLINS - PANL ADDED. 00800000 C REVISED 6-27-78 COLLINS - PANL ADDED TO WRIT. 00810000 C REVISED 7-03-78 COOPER - COVA ADDED, COVA ALSO ADDED TO WRIT. 00820000 C REVISED 7-14-78 COOPER - CHANGED COVA. 00830000 C REVISED 8-16-78 FAC. PANL, SECDRY = 1. 00840000 C REVISED 8-22-78 COOPER - CHANGED COVA. 00850000 C REVISED 8-24-78 COOPER - CHANGED COVA-ADDED SUMMING INCREMENT. 00860000 C REVISED 9-12-78 COOPER - CHANGED WRIT-COVA CALC. 00870000 C REVISED 11-06-78 COOPER - ADDED SECOND WORK FILE 00880000 C TO CVAN. REDUCED FIRST CVAN WORK 00890000 C FILE TO MAX. RANGE (^ ALL RANGES). 00900000 C REVISED 12-05-78 REM. SELT ADDED AS LAST RESORT TO WRIT. 00910000 C REVISED 12-08-78 REM. VSUM, SECDRY = 1. 00920000 C REVISED 12-18-78 FAC. QUAD, SECDRY = 1. 00930000 C REVISED 12-20-78 GCW. ADDED SECOND WORK FILE TO SELT. 00940000 C REVISED 12-29-78 REM. ADD NO RELEASE OPTION TO 1ST 00950000 C CVAN WORK FILE AND ADD SECOND 00960000 C WORK FILE TO FANF. 00970000 C REVISED 1-16-79 PKC. ADDED EDIT AND DELETED LRAC, SKIM, & KONG. 00980000 C REVISED 2-21-79 FAC. READ PRIMARY RAISED TO 600. 00990000 C REVISED 3-15-79 REM. FIX WRIT ALLOCATION FOR SELT IN SP MODE. 01000000 C REVISED 4-04-79 PKC. ADDED VPRO AND TSUM TO WRIT ALLOCATION, 01010000 C CREATED JSWRTE. ALSO ADDED TSUM. 01020000 C REVISED 4-10-79 PKC. CHANGED TSUM ALLOCATION TO DO DP MODE. 01030000 C REVISED 4-17-79 MENDEKE - CHANGED GATH FOR CST OPTION 01040000 C REVISED 6-25-79 MENDEKE - CHANGED GATH FOR 99999 OVERRIDE 01050000 C REVISED 2-26-79 MENDEKE - ADDED DG3D CODE 01060000 C REVISED 8-29-79 COOPER - OPTIMIZED BUFSIZ FOR EDIT. 01070000 C REVISED 9-06-79 DECKER - DELETED SCON -- ADDED DSTK 01080000 C REVISED 9-24-79 REM. DELETE CHECK FOR "SP" ON ACCT CARD. 01090000 C REVISED 9-25-79 REM. DELETE CHECK FOR "SP" IN CVAN-UVS. 01100000 C REVISED 9-25-79 REP. ADD SECOND WORKFILE TO TRAC. 01110000 C REVISED 11-21-79 JGM. CHANGED GMAP. 01120000 C REVISED 12-13-79 CWC. ADDED RARS PROCESS. 01130000 C REVISED 12-27-79 REM. RESET FCTRAC FLAG. 01140000 C REVISED 01-18-80 PKC. CHANGED COVA AND ADDED COVE. 01150000 C REVISED 01-29-80 RCD. ADDED SCAN. 01160000 C REVISED 01-31-80 PKC. CHANGED VSUM FOR FILE MODE. 01170000 C REVISED 02-01-80 REP. ADD WORKFILE TO WRIT IF SPOOLING. 01180000 C REVISED 03-19-80 RCD. ADDED SECOND WORK FILE TO SCAN 01190000 C REVISED 03-20-80 SAS. ADDED CVPL PROCESS 01200000 C REVISED 03-25-80 BNM. ADDED MG3D PROCESS 01210000 C REVISED 04-29-80 PKC. CHANGED COVE TO INPUT 30 TRACES. 01220000 C REVISED 05-07-80 DJP. ADDED TMIX PROCESS 01230000 C REVISED 05-08-80 REM. FIX FANF FOR 8000 WORD BUFFER. 01240000 C REVISED 05-12-80 SAS. INCREASED EDIT ALLOCATION FOR ARES 01250000 C RESIDUAL STATICS OPTION. 01260000 C REVISED 05-13-80 SAS. INCREASED TRAC SECONDARY WORK FILE 01270000 C ALLOCATION. 01280000 C REVISED 05-27-80 PKC. ADDED CD3D AS OUTPUT PROCESS. 01290000 C REVISED 06-17-80 BJB. DOUBLED READ WORK FILE ALLOCATION. 01300000 C REVISED 07-30-80 SAS. ADDED FRAN VARIAN WORK SPACE. 01310000 C REVISED 08-04-80 SAS. ADDED SRVY OUTPUT SPACE. 01320000 C REVISED 08-20-80 RCD. ADDED PROCESS DSUM 01330000 C REVISED 09-08-80 HHL. ADDED MG45 PROCESS. 01340000 C REVISED 09-26-80 WPB. ADDED R&D PROCESS. 01350000 C REVISED 10-01-80 REM. ADD TRAX WHICH POINTS SCAN. 01360000 C REVISED 10-06-80 REM. CALC NOSAMP BASED ON PI NOT SI. 01370000 C REVISED 10-20-80 WPB. MODIFIED SPACE ALLOCATIONS FOR R & D 01380000 C PROCESS 01390000 C REVISED 10-20-80 RDK. CORRECTIONS TO SPACE FOR MG3D. 01400000 C REVISED 11-19-80 DJP. ADDED LAGX PROCESS 01410000 C REVISED 12-18-80 RDK. ADDED VSPA AND VSPB. 01420000 C REVISED 12-30-80 DJP. ADDED AMPS AND SP3D 01430000 C REVISED 12-30-80 BNM. ADDED VTPA AND VTPD 01440000 C REVISED 01-12-81 RFE. ADDED ERROR CHECK FOR BLOCKSIZE 01450000 C LENGTH OF FANF AND FLTR. 01460000 C REVISED 01-28-81 RDK. CHANGES TO VSPA. 01470000 C REVISED 03-06-81 DJP. ADDED M2FK AND INCREASED LABELS FOR RETURN,01480000 C ERROR EXIT, AND R&D PROCESSES. 01490000 C REVISED 03-13-81 PKC. ADDED QULR. 01500000 C REVISED 03-25-81 RDK. ADDED VSPD. 01510000 C REVISED 04-10-81 DJP. ADDED M3FK. 01520000 C REVISED 05-20-81 PKC. CORRECTED QULR FOR MORE THAN ONE OUTPUT. 01530000 C REVISED 06-25-81 PKC. CORRECTED QULR FOR DEPTH POINT SPACING. 01540000 C REVISED 06-30-81 RDK. ADDED "RES" SPARC SHELL SERIES FOR WPB. 01550000 C REVISED 06-30-81 RDK. MOVED ZMIG TO PRODUCTION SPARC; 01560000 C REDIMENSIONED ARRAY PROC. 01570000 C REVISED 07-24-81 RCD. ADDED SURF AND DTRX (REMOVED SCAN & DTRC). 01580000 C REVISED 10-06-81 DJP. INCREASE PRIMARY IN FANF FOR JOBS NEEDING 01590000 C A SPATIAL FFT LENGTH > 2048. 01600000 C REVISED 10-12-81 RDK. MOVED FANA TO PRODUCTION SPARC. 01610000 C REVISED 12-11-81 RDK. ADDED ENTRY FOR DCNX. 01620000 C REVISED 12-31-81 DJP. CHANGED FANA FOR NEW DISPLAY CODES. 01630000 C REVISED 01-04-82 DJP. ADDED CALL TO JSPAC2 AND MOVED ZMIG, FANA, 01640000 C AND DCNX TO JSPAC2. ALSO ADDED 'ARC' 01650000 C SERIES FOR WPB. 01660000 C REVISED 02-03-82 JBC. READ PRIMRY INCREASED TO 1800 01670000 C REVISED 02-16-82 RDK. MODIFY SPACE FOR VSPD. 01680000 C REVISED 04-12-82 RDK. ADD ENTRY FOR M345 (POINTS TO MG3D). 01690000 C MODIFY CODE FOR NEW VERSION OF VSPA. 01700000 C REVISED 05-12-82 NTS. ADD ENTRY FOR STAP (POINTS TO EDIT). 01710000 C REVISED 06-17-82 WPB. ADDED R&D PROCESS. 01720000 C REVISED 10-28-82 ESN. MODIFIED TRAC ENTRY FOR LARGER BLKSIZ 01730000 C ON FIRST WORK FILE. 01740000 C REVISED 11-17-82 WPB. ADDED THE SEG & CDP SERIES TO PROCESS 01750000 C STREAM. 01760000 C REVISED 02-14-83 RDK. ADD THIRD WORKFILE FOR VSPA. 01770000 C REVISED 02-17-83 RDK. ADD R MODE CAPABILITY TO FANF. 01780000 C REVISED 03-22-83 REM. CHANGE USE OF ACNSP TO LCANSP. 01790000 C REVISED 04-25-83 JBC. CORRECTED ERROR IN SURF. 01800000 C REVISED 06-14-83 RDK. ADDED 'GAS' AND 'OIL' SPARC SHELL SERIES 01810000 C FOR WPB. 01820000 C REVISED 06-15-83 CMP. GIVE READ WORKFILE A SECONDARY ALLOCATION. 01830000 C REVISED 08-01-83 RDK. CORRECT PRIMARY ALLOCATION IN SURF FOR RCD.01840000 C REVISED 09-13-83 FAC. REMOVE WORK FILE FROM WRIT. 01850000 C REVISED 01-05-84 NTS. CORRECT FFT LENGTH CALCULATION FOR 'FANF'. 01860000 C REVISED 04-23-84 RDK. ADD ENTRY FOR SCDB (POINTS TO 'SURF'). 01870000 C DEFAULT VECTOR LENGTH TO 100. 01880000 C REVISED 06-19-84 RDK. ADD NEW R&D SPARC SHELL SERIES 'PRC' AND 01890000 C 'PAT' FOR RCD. 01900000 C REVISED 06-28-84 ESN. FANF FILES NOT NEEDED -- DYNAMIC 01910000 C ALLOCATION USED. 01920000 C REVISED 08-02-84 JMP. EDIT WORKFILE NO LONGER NEEDED. 01930000 C REVISED 09-14-84 CMP. ADD VERSATEC CAPABILITY TO CD3D,QULR,SP3D. 01940000 C REVISED 10-08-84 RDK. ADD 'VIS' SPARC SHELL SERIES FOR DPRFAC. 01950000 C R&D PROCESS ENTRY REVISIONS FOR DPRFAC. 01960000 C REVISED 10-15-84 REP. CONVERT TO VS FORTRAN. 01970000 C REVISED 11-08-84 PKC. CHANGED GATH OVERRIDE FOR 3D. 01980000 C REVISED 12-17-84 RDK. CHANGES TO R&D ENTRY FOR F. COADY. 01990000 C REVISED 01-15-85 RDK. MORE CHANGES TO R&D ENTRY FOR F. COADY. 02000000 C REVISED 02-15-85 TRA. CORRECT SCDB ALLOCATION. 02010000 C REVISED 03-18-85 RDK. ADDED 'IBM' AND 'AOG' SPARC SHELL SERIES 02020000 C FOR F. A. COADY. 02030000 C REVISED 04-30-85 DWD1.DELETED ENTRY FOR DG3D. 02040000 C REVISED 05-06-85 RKG. MADE CHANGES TO ALLOW SPC CARD USEFUL FOR 02050000 C ALL PROCESSES. 02060000 C REVISED 05-24-85 PKC. CORRECTED GATH FOR 3D & 99999 BOTH ENTERED.02070000 C REVISED 06-18-85 DCB. DELETED ENTRY FOR RAMS. WORK SPACE IS NOW 02080000 C DYNAMICALLY ALLOCATED WITHIN SDRAMS. 02090000 C REVISED 08-05-85 REP. CHANGE TRAX FOR ONE WORKFILE AND ADD 'AXSR'02100000 C TO STAP. 02110000 C REVISED 04-11-86 REM. ADD FCRND TO PARAMETER LIST FOR JSPAC2. 02120000 C REVISED 09-30-86 PKC. REMOVED FLTR ENTRY. 02130000 C REVISED 10-06-86 PKC. REMOVE WORKFILE ALLOCATION FOR QULR AND 02140000 C REMOVED CD3D ENTRY. 02150000 C REVISED 02-11-87 JMP. DO NOT RESET ERCODE TO 0 IF ERCODE IS 16. 02160000 C COMMENT OUT CODE AT STATEMENT 8100 TO REMOVE 02170000 C FORTRAN DIAGNOSTIC ERROR MESSAGE. 02180000 C REVISED 02-24-87 REM. BECAUSE OF DYNAMIC ALLOCATION, DELETE CODE 02190000 C FOR: DMIG,M2FK,M3FK,QUAD,VSPB,VSPD. ALSO CSTK, 02200000 C COST,CVAN,PANL,TMIX,VSUM. ADJUST QULR. 02210000 C REVISED 03-03-87 REM. BECAUSE OF DYNAMIC ALLOCATION, DELETE CODE 02220000 C FOR: GATH,FANF,VELA,MIGR,SELT,TRAC,RARS,CVPL, 02230000 C MG45,STAP,READ. ALSO OLD R&D: VDSP,DSTK,MIGE, 02240000 C VTPA,SURF,VELB; PER MICK COADY. 02250000 C REVISED 03-11-87 REM. BECAUSE OF DYNAMIC ALLOCATION OR NO LONGER 02260000 C BEING USED, DELETE CODE FOR:ZWRK,ZWRT,DSUM,PLGP,02270000 C DELA,DTRX,TRAX,LAGX,AMPS,SP3D,VTPD,SCDB. 02280000 C REVISED 04-07-87 REM. BECAUSE OF DYNAMIC ALLOCATION OR NO LONGER 02290000 C BEING USED, DELETE CODE FOR:GMAP,COVA,COVE,MG3D,02300000 C M345. 02310000 C REVISED 04-13-87 REM. DELETE TSUM BECAUSE OF DYNAMIC ALLOCATION. 02320000 C REVISED 04-15-87 REM. MOVE PROCESSES VZ2D,HZAD,TFAD,FD3D,CRDA 02330000 C FROM JSPAC2 SO JSPAC2 MAY BE DELETED. 02340000 C REVISED 04-27-87 REM. DELETE VSPA BECAUSE OF DYNAMIC ALLOCATION. 02350000 C REVISED 04-29-87 RSH. INCREASE CRDA FILE SIZE MAX TO 500MB 02360000 C REVISED 05-14-87 REM. RE-ADD GDSP AND VSPA BECAUSE OF JUSTIFY. 02370000 C REVISED 09-22-87 REP. ADD AIED FOR OUTPUT FILE ALLOCATION ON CRAY02380000 C REVISED 12-01-87 REP. FIX DEFAULT OF RPI IN AIED ENTRY. 02390000 C REVISED 12-17-87 REM. FIX ALL COLOR PROCESSES FOR NREC AND BLKSIZ02400000 C REVISED 06-24-88 TJT. MADE LCGRPI FLOATING PT. CHANGE PERMANENT 02410000 C REVISED 11-30-89 ESN. ADD IN WT3D. 02420000 C REVISED 02-01-90 LWC. ADD SPACE FOR META OPTION IN FANA 02430000 C REVISED 10-08-90 ESN. ADD IN CORA. 02440000 C REVISED 07-02-91 ESN. DECLARE SCL AND MXSCL REAL FOR FANA MAX1. 02450004 CA 02460000 CA 02470000 CA CALL JSSPAC (KPNA, KPRNO, OCCUR, BLKSIZ, PRIMRY, SECDRY, 02480000 CA RLSE, CONTG, ERCODE, FCRND) 02490000 CA INPUT KPNA = PROCESS NAME A4 02500000 CA INPUT KPRNO = PROCESS NUMBER I4 02510000 CA INPUT OCCUR = OCCURRENCE NUMBER FOR PROCESS KPNA WITH I4 02520000 CA THIS SAME KPRNO 02530000 CA INPUT VALUE 02540000 CA I / O BLKSIZ= BLOCK SIZE (BYTES) PTTHLB + 4*LCRL/LCSI I4 02550000 CA I / O PRIMRY= PRIMARY ALLOCATION (BLOCKS) 0 I4 02560000 CA I / O SECDRY= SECONDARY ALLOCATION (BLOCKS) 0 I4 02570000 CA I / O RLSE = RELEASE PARAMETER PTABMSTR I4 02580000 CA I / O CONTG = CONTIGUOUS SPACE PARAMETER PTABMSTR I4 02590000 CA I / O ERCODE= ERROR CODE (= 16 IF NOT ABLE 0 I4 02600000 CA TO COMPUTE THE REQUIRED PARAMETERS) 02610000 CA I FCRND = FILE CODE (1=WORK FILE 1 02620000 CA 2=WORK FILE 2 02630000 CA 3=WORK FILE 3 02640000 CA 4=PLOT FILE ) 02650000 CA 02660000 CA LINE CARD RECORD LENGTH 02670000 CA INPUT BLKSIZ = 4 ------------------------- + TRACE HEADER LENGTH. 02680000 CA LINE CARD SAMPLE INTERVAL 02690000 CA 02700000 CA COMPUTES DISK SPACE ATTRIBUTES FOR PROCESSES REQUIRING 02710000 CA A DISK FILE. 02720000 C 02730000 C 02740000 C EJECT 02750000 C INTEGER ARRAYS -- LOCAL 02760000 C 02770000 C CARD(20) = DATA CARD ARRAY 02780000 C PROC(58) = PROCESS NAMES 02790000 C 02800000 C EJECT 02810000 C 02820000 SUBROUTINE JSSPAC (KPNA, KPRNO, OCCUR, BLKSIZ, PRIMRY, SECDRY, 02830000 * RLSE, CONTG, ERCODE, FCRND) 02840000 C 02850000 IMPLICIT INTEGER (A-Z) 02860000 C 02870000 C INTEGER ARRAYS -- LOCAL 02880000 CHARACTER*4 PROC (58) /'FANA','WRIT','AIED','WT3D','CORA', 02890000 * ' ','VZ2D',' ',' ',' ', 02900000 * ' ',' ',' ','VELD',' ', 02910000 * ' ',' ',' ',' ',' ', 02920000 * ' ','HZAD','TFAD','FD3D',' ', 02930000 * ' ','CRDA',' ',' ',' ', 02940000 * ' ',' ',' ',' ',' ', 02950000 * ' ',' ',' ',' ',' ', 02960000 * 'FRAN','SRVY',' ',' ',' ', 02970000 * 'VSPA',' ',' ',' ',' ', 02980000 * ' ',' ','QULR',' ',' ', 02990000 * ' ',' ',' ' / 03000000 C 58 03010000 INTEGER CARD (20) 03020000 C 03030000 C CHARACTER & INTEGER CONSTANTS -- LOCAL 03040000 C 03050000 CHARACTER*4 KPNA 03060000 CHARACTER*4 RLSE 03070000 CHARACTER*4 BLANK / ' ' / 03080000 INTEGER FCF / 1 / 03090000 INTEGER FCTFAD / 0 / 03100000 INTEGER IPR / 6 / 03110000 CHARACTER*4 NO / 'N ' / 03120000 INTEGER THL / 190 / 03130000 REAL LCGRPI 03140000 REAL SCL 03150002 REAL MXSCL 03160002 C 03170000 C 03180000 ERCODE = 0 03190000 IF (FCF .EQ. 0) GO TO 9700 03200000 FCF = 0 03210000 C 03220000 C GET LINE CARD PARAMETERS 03230000 C 03240000 DA = 1 03250000 CALL FORC ('LINE', 0, DA, CARD, * 8000 )03260000 C 03270000 LCTPSP = S1CVBN (CARD, 36, 5) 03280000 LCMXFD = S1CVBN (CARD, 61, 5) 03290000 IF (LCMXFD .EQ. 0) LCMXFD = LCTPSP 03300000 CALL S1MVCH ('LS', 1, PMODE, 1, 2) 03310000 IF (S1CPCH (CARD, 6, ' ', 1, 1) .NE. 0) 03320000 * CALL S1MVCH (CARD, 6, PMODE, 1, 1) 03330000 IF (S1CPCH (CARD, 7, ' ', 1, 1) .NE. 0) 03340000 * CALL S1MVCH (CARD, 7, PMODE, 2, 1) 03350000 LCBGSP = S1CVBN (CARD, 11, 5) 03360000 LCENSP = S1CVBN (CARD, 16, 5) 03370000 LCNSP = S1CVBN (CARD, 31, 5) 03380000 RLENG = S1CVBN (CARD, 41, 5) 03390000 SI = S1CVBN (CARD, 46, 5) 03400000 PI = S1CVBN (CARD, 51, 5) 03410000 CTJT LCGRPI = S1CVBN (CARD, 56, 5) 03420000 CALL USCHFT (CARD, 56, 5, LCGRPI) 03430000 LCANSP = S1CVBN (CARD, 66, 5) 03440000 LCMXLN = S1CVBN (CARD, 71, 5) 03450000 NOSAMP = RLENG / PI 03460000 C 03470000 C 03480000 C **************** 03490000 C PROCESS R & D 03500000 C **************** 03510000 C 03520000 C ******************** 03530000 C COMPUTES ALLOCATIONS 03540000 C ******************** 03550000 C 03560000 9700 DA = 1 03570000 PRIMRY = 1 03580000 SECDRY = 1 03590000 C 03600000 C 03610000 9710 CALL FORC (KPNA, KPRNO, DA, CARD, * 5 )03620000 IF (S1CPCH (CARD, 8, 'SPC', 1, 3) .NE. 0) GO TO 9710 03630000 C 03640000 9720 IF (FCRND. EQ. 1) ICOL = 26 03650000 IF (FCRND. EQ. 2) ICOL = 41 03660000 IF (FCRND. EQ. 3) ICOL = 56 03670000 IF (FCRND. EQ. 4) GO TO 5 03680000 C 03690000 IF (S1CPCH (CARD, ICOL , ' ', 1, 5) .EQ. 0 .AND. 03700000 * S1CPCH (CARD, ICOL+5 , ' ', 1, 5) .EQ. 0 .AND. 03710000 * S1CPCH (CARD, ICOL+10 , ' ', 1, 5) .EQ. 0 ) GO TO 5 03720000 C 03730000 IGP = S1CVBN (CARD, ICOL, 5) 03740000 ITPG = S1CVBN (CARD, ICOL+ 5, 5) 03750000 IBS = S1CVBN (CARD, ICOL+10, 5) 03760000 IF (IGP .EQ. 0) IGP = 1 03770000 IF (ITPG .EQ. 0) ITPG = 1 03780000 IF (IBS .NE. 0) BLKSIZ = IBS * 4 03790000 C 03800000 PRIMRY = IGP * ITPG 03810000 SECDRY = 1 03820000 CKG 03830000 C WRITE(6,34343) FCRND,KPNA,KPRNO,BLKSIZ,PRIMRY,SECDRY 03840000 C4343 FORMAT('0 FCRND,KPNA,KPRNO BLKSIZ P S ',I5,2X,A4,5I5) 03850000 CKG 03860000 GO TO 9900 03870000 C 03880000 C 03890000 C 03900000 C 03910000 C FIND THE PROCESS 03920000 C ================ 03930000 C 03940000 5 CONTINUE 03950000 IF (KPNA .EQ. PROC (1)) GO TO 100 03960000 IF (KPNA .EQ. PROC (2)) GO TO 200 03970000 IF (KPNA .EQ. PROC (3)) GO TO 300 03980000 IF (KPNA .EQ. PROC (4)) GO TO 200 03990000 IF (KPNA .EQ. PROC (5)) GO TO 500 04000000 CREM1 IF (KPNA .EQ. PROC (6)) GO TO 600 04010000 IF (KPNA .EQ. PROC (7)) GO TO 700 04020000 CREM3 IF (KPNA .EQ. PROC (8)) GO TO 800 04030000 CREM1 IF (KPNA .EQ. PROC (9)) GO TO 900 04040000 CREM2 IF (KPNA .EQ. PROC(11)) GO TO 300 04050000 CREM3 IF (KPNA .EQ. PROC(12)) GO TO 2600 04060000 CREM2 IF (KPNA .EQ. PROC(13)) GO TO 1300 04070000 IF (KPNA .EQ. PROC(14)) GO TO 1400 04080000 CREM2 IF (KPNA .EQ. PROC(15)) GO TO 1500 04090000 CREM4 IF (KPNA .EQ. PROC(16)) GO TO 1600 04100000 CREM2 IF (KPNA .EQ. PROC(17)) GO TO 1700 04110000 CREM5 IF (KPNA .EQ. PROC(18)) GO TO 1800 04120000 CDWD1 IF (KPNA .EQ. PROC(19)) GO TO 1900 04130000 CREM1 IF (KPNA .EQ. PROC(20)) GO TO 2000 04140000 IF (KPNA .EQ. PROC(22)) GO TO 2200 04150000 IF (KPNA .EQ. PROC(23)) GO TO 2300 04160000 IF (KPNA .EQ. PROC(24)) GO TO 2300 04170000 CREM1 IF (KPNA .EQ. PROC(25)) GO TO 2500 04180000 CREM3 IF (KPNA .EQ. PROC(26)) GO TO 2600 04190000 IF (KPNA .EQ. PROC(27)) GO TO 2700 04200000 CREM1 IF (KPNA .EQ. PROC(28)) GO TO 2800 04210000 CREM2 IF (KPNA .EQ. PROC(29)) GO TO 1700 04220000 CREM2 IF (KPNA .EQ. PROC(30)) GO TO 1500 04230000 CREM3 IF (KPNA .EQ. PROC(31)) GO TO 4400 04240000 CREM1 IF (KPNA .EQ. PROC(32)) GO TO 3200 04250000 CREM4 IF (KPNA .EQ. PROC(33)) GO TO 3300 04260000 CREM2 IF (KPNA .EQ. PROC(34)) GO TO 3400 04270000 CREM4 IF (KPNA .EQ. PROC(35)) GO TO 3500 04280000 CREM2 IF (KPNA .EQ. PROC(36)) GO TO 3600 04290000 CREM2 IF (KPNA .EQ. PROC(37)) GO TO 3700 04300000 CREM4 IF (KPNA .EQ. PROC(38)) GO TO 3800 04310000 CREM1 IF (KPNA .EQ. PROC(39)) GO TO 3900 04320000 IF (KPNA .EQ. PROC(41)) GO TO 4100 04330000 IF (KPNA .EQ. PROC(42)) GO TO 4200 04340000 CREM2 IF (KPNA .EQ. PROC(43)) GO TO 1700 04350000 CREM3 IF (KPNA .EQ. PROC(44)) GO TO 4475 04360000 CREM3 IF (KPNA .EQ. PROC(45)) GO TO 4500 04370000 IF (KPNA .EQ. PROC(46)) GO TO 4600 04380000 CREM1 IF (KPNA .EQ. PROC(47)) GO TO 4700 04390000 CREM3 IF (KPNA .EQ. PROC(48)) GO TO 4800 04400000 CREM3 IF (KPNA .EQ. PROC(49)) GO TO 4000 04410000 CREM3 IF (KPNA .EQ. PROC(50)) GO TO 5000 04420000 CREM2 IF (KPNA .EQ. PROC(51)) GO TO 5100 04430000 CREM1 IF (KPNA .EQ. PROC(52)) GO TO 5200 04440000 IF (KPNA .EQ. PROC(53)) GO TO 5300 04450000 CREM1 IF (KPNA .EQ. PROC(54)) GO TO 5400 04460000 CREM1 IF (KPNA .EQ. PROC(55)) GO TO 5200 04470000 CREM4 IF (KPNA .EQ. PROC(56)) GO TO 3800 04480000 CREM2 IF (KPNA .EQ. PROC(57)) GO TO 1000 04490000 CREM3 IF (KPNA .EQ. PROC(58)) GO TO 3600 04500000 C 04510000 C 04520000 C PROCESS NOT FOUND 04530000 C 04540000 WRITE (IPR, 98050) KPNA, KPRNO 04550000 C 04560000 C CHECK FOR UNIRAS COLOR PLOT FILE ALLOCATION 04570000 C 04580000 PRIMRY = 5000 04590000 C 04600000 C DETERMINE IF ON-LINE(VERSATEC) OR OFF-LINE(APPLICON) COLOR PLOT 04610000 C 04620000 DARND = 1 04630000 CALL FORC (KPNA, KPRNO, DARND, CARD, *9900) 04640000 IF (S1CPCH (CARD, 76, 'ONCOL', 1, 5) .EQ. 0) THEN 04650000 PRIMRY = 2700 04660000 BLKSIZ = 23400 04670000 END IF 04680000 IF (S1CPCH (CARD, 76, 'OFCOL', 1, 5) .EQ. 0) BLKSIZ = 1296 04690000 C 04700000 CKG 04710000 C WRITE(6,22222) FCRND,KPNA,KPRNO,BLKSIZ,PRIMRY,SECDRY,ERCODE 04720000 CKG 04730000 GO TO 9900 04740000 C 04750000 C ================= 04760000 C 2. PROCESS = FANA 04770000 C ================= 04780000 C 04790000 C =============================================== 04800000 C COMPUTE PRIMARY ALLOCATION FOR FANA OUTPUT FILE 04810000 C AND WORK FILE 04820000 C =============================================== 04830000 C 04840000 C 04850000 C DETERMINE TYPE OF PLOTTER OUTPUT 04860000 C 04870000 100 XAXIS = 25 04880000 YAXIS = 17 04890000 DA = 1 04900000 C 04910000 110 CALL FORC (KPNA, KPRNO, DA, CARD, * 8030 )04920000 IF (S1CPCH (CARD, 8, BLANK, 1, 3) .NE. 0) GO TO 110 04930000 IF (S1CPCH (CARD, 76, ' ', 1, 5) .EQ. 0) GO TO 130 04940000 IF (S1CPCH (CARD, 78, 'ESP', 1, 3) .EQ. 0) GO TO 130 04950000 IF (S1CPCH (CARD, 78, 'COL', 1, 3) .EQ. 0) GO TO 160 04960000 IF (S1CPCH (CARD, 78, 'TAD', 1, 3) .EQ. 0) GO TO 130 04970000 IF (S1CPCH (CARD, 78, 'ETA', 1, 3) .EQ. 0) GO TO 170 04980000 GO TO 110 04990000 C 05000000 130 NUMOUT = S1CVBN (CARD, 56, 5) 05010000 IF ( NUMOUT .LE. 0 ) NUMOUT = 2 05020000 HA = 1 05030000 C 05040000 140 CALL FORC (KPNA, KPRNO, DA, CARD, * 150 )05050000 IF (S1CPCH (CARD, 8, 'PLT', 1, 3) .NE. 0) GO TO 140 05060000 CALL USCHFT (CARD, 21, 5, SCL ) 05070000 CALL USCHFT (CARD, 26, 5, MXSCL) 05080000 IF( SCL .LE. 0.0) SCL = 15.0 05090000 IF(MXSCL .LE. 0.0) MXSCL = 15.0 05100000 XAXIS = MAX1( SCL + 10.999, FLOAT(XAXIS)) 05110000 YAXIS = MAX1(MXSCL + 2.999, FLOAT(YAXIS)) 05120000 GO TO 140 05130000 C 05140000 C TIADD OR VARIAN PLOTS 05150000 C 05160000 150 BLKSIZ = 8192 05170000 PRIMRY = (10000 * XAXIS * YAXIS / 8 + BLKSIZ - 1) / BLKSIZ 05180000 PRIMRY = PRIMRY * NUMOUT 05190000 SECDRY = 10 05200000 RLSE = NO 05210000 GO TO 9900 05220000 C 05230000 C COLOR PLOTS 05240000 C 05250000 160 NUMOUT = S1CVBN (CARD, 56, 5) 05260000 IF (NUMOUT .LE. 0) GO TO 8040 05270000 C 05280000 C SET BLKSIZE AND PRIMRY FOR VERSATEC. 05290000 C 05300000 BLKSIZ = 23400 05310000 PRIMRY = 2700 05320000 GO TO 180 05330000 C 05340000 170 BLKSIZ = 1296 05350000 PRIMRY = 5000 05360000 C 05370000 180 CONTINUE 05380000 GO TO 9900 05390000 C 05400000 C 05410000 C 2. PROCESS = WRIT AND WT3D 05420000 C ======================= 05430000 C 05440000 C ================================= 05450000 C COMPUTE THE PRIMARY AND SECONDARY 05460000 C ALLOCATION FOR WRIT 05470000 C ================================= 05480000 C 05490000 200 CONTINUE 05500000 C SET SPACE TO ZERO, IN CASE NOTHING IS COMPUTED ON THIS CALL, OR 05510000 C IN CASE TOTAL IS ACCUMULATED FOR ALL OCCURRENCES (SPOOL MEMBERS) 05520000 C OF A SPOOLED OUTPUT FILE. 05530000 PRIMRY = 0 05540000 SECDRY = 0 05550000 C 05560000 C CHECK FOR SPOOLING. 05570000 DA = 1 05580000 CALL FORC (KPNA, KPRNO, DA, CARD, *8020) 05590000 IF (S1CPCH(CARD, 40, 'S', 1, 1) .EQ. 0) GO TO 210 05600000 C 05610000 C NOT SPOOLING, NORMAL CASE. 05620000 CALL JSWRTE (KPNA, KPRNO, OCCUR, BLKSIZ, PRIMRY, SECDRY, 05630000 * RLSE, CONTG, ERCODE) 05640000 GO TO 9900 05650000 C 05660000 C SPOOLING. SPACE FOR ALL OCCURRENCES (SPOOL MEMBERS) FOR A 05670000 C PARTICULAR KPNA AND KPRNO IS CALCULATED AT FIRST OCCURRENCE. 05680000 C IF THIS IS NOT FIRST OCCURRENCE, EXIT. 05690000 210 IF (OCCUR .GT. 1) GO TO 9900 05700000 C 05710000 C ACCUMULATE SPACE TOTAL FOR ALL OCCURRENCES. 05720000 DO 220 05730000 * J = 1, 99 05740000 CALL JSPAC1 (KPNA, KPRNO, J, 'WRIT', SKPRNO) 05750000 IF ( SKPRNO .EQ. -2 ) GO TO 9900 05760000 IF ( SKPRNO .EQ. -3 ) GO TO 9800 05770000 CALL JSWRTE (KPNA, KPRNO, J, BLKSIZ, PRIMRT, SECDRT, 05780000 * RLSE, CONTG, ERCODE) 05790000 PRIMRY = PRIMRY + PRIMRT 05800000 SECDRY = SECDRY + SECDRT 05810000 220 CONTINUE 05820000 GO TO 9900 05830000 C 05840000 C 05850000 C300 3 -11-20. PROCESS = COST AND CSTK AND DSTK 05860000 C ====================== 05870000 C 3. PROCESS = AIED 05880000 C ====================== 05890000 C 05900000 300 CONTINUE 05910000 C 05920000 C READ ALL THE FIRST TYPE DATA CARDS TO GET NUMBER OF RECORDS TO BE 05930000 C PROCESSED 05940000 C 05950000 MXNSP = 0 05960000 NSP = 0 05970000 DA = 1 05980000 2815 CALL FORC (KPNA, KPRNO, DA, CARD, *2820) 05990000 IF (S1CPCH(CARD, 8, ' ', 1, 3) .NE. 0) GO TO 2815 06000000 IF (DA .EQ. 2) RPI = S1CVBN(CARD, 56, 5) 06010000 BEGFN = S1CVBN(CARD, 11, 5) 06020000 ENDFN = S1CVBN(CARD, 16, 5) 06030000 IF (ENDFN .EQ. 0) ENDFN = BEGFN 06040000 NSP = NSP + IABS(ENDFN-BEGFN) + 1 06050000 GO TO 2815 06060000 C CALCULATE NUMBER OF INCHES OF PLOT TO DETERMINE PRIMRY SPACE 06070000 2820 CONTINUE 06080000 IF (RPI .LE. 0) RPI = 500 06090000 BLKSIZ = 8192 06100000 PRIMRY = ((NSP * 100 / RPI) + 10) / .5 + 20 06110000 IF (PRIMRY .LT. 6000) PRIMRY = 6000 06120000 SECDRY = 10 06130000 GO TO 9900 06140000 C 06150000 C ======================= 06160000 C 2-24-87. DELETED USE OF COST AND CSTK. 06170000 C 3- 3-87. DELETED USE OF DSTK (ALL CODE DELETED) 06180000 C 06190000 C 06200000 C400 4. PROCESS = VDSP - DELETED 3-3-87 06210000 C ============== 06220000 C 06230000 C 06240000 C ================= 06250000 C 5. PROCESS = CORA 06260000 C ================= 06270000 C 06280000 C =================================== 06290000 C COMPUTE PRIMARY ALLOCATION FOR CORA 06300000 C =================================== 06310000 C 06320000 500 CONTINUE 06330000 BLKSIZ = 8192 06340000 PRIMRY = 100 06350000 C 06360000 GO TO 9900 06370000 C 06380000 C 600 6. PROCESS = CVAN - DELETED 2-24-87 06390000 C ============== 06400000 C 06410000 C 06420000 C ================= 06430000 C 7. PROCESS = VZ2D 06440000 C ================= 06450000 C 06460000 C =================================== 06470000 C COMPUTE PRIMARY ALLOCATION FOR VZ2D 06480000 C =================================== 06490000 C 06500000 700 DA = 1 06510000 C 06520000 710 CALL FORC (KPNA, KPRNO, DA, CARD, * 8030 )06530000 IF (S1CPCH (CARD, 8, BLANK, 1, 3) .NE. 0) GO TO 710 06540000 IF (S1CPCH (CARD, 76, ' ', 1, 5) .EQ. 0) GO TO 720 06550000 IF (S1CPCH (CARD, 78, 'ESP', 1, 3) .EQ. 0) GO TO 720 06560000 IF (S1CPCH (CARD, 78, 'COL', 1, 3) .EQ. 0) GO TO 730 06570000 GO TO 710 06580000 C 06590000 C VARIAN OUTPUT 06600000 C 06610000 720 BLKSIZ = 8192 06620000 PRIMRY = 6000 06630000 SECDRY = 10 06640000 GO TO 9900 06650000 C 06660000 C APPLICON OUTPUT 06670000 C 06680000 730 BLKSIZ = 1296 06690000 PRIMRY = 5000 06700000 GO TO 9900 06710000 C 06720000 C 800 7 AND 8. PROCESS = ZWRK AND ZWRT - DELETED 3-11-87 06730000 C ======================= 06740000 C 06750000 C 06760000 C 06770000 C 06780000 C 900 9. PROCESS = VSUM - DELETED 2-24-87 06790000 C ============== 06800000 C 06810000 C =============== 06820000 C1000 57. PROCESS = STAP - DELETED 3-3-87 06830000 C =============== 06840000 C 06850000 C 06860000 C ======================= 06870000 C1200 12 AND 23. PROCESS = REMT AND PLGP - DELETED 3-11-87 06880000 C ======================= 06890000 C 06900000 C 06910000 C ============== 06920000 C1300 13. PROCESS = FANF - DELETED 3-3-87 06930000 C ============== 06940000 C 06950000 C 06960000 C 14. PROCESS = VELD 06970000 C ============== 06980000 C 06990000 C ========================================= 07000000 C COMPUTE THE PRIMARY ALLOCATION FOR THE 07010000 C OUTPUT PLOT FILE. 07020000 C ============================================ 07030000 C 07040000 1400 CALL JSVELD (KPNA, KPRNO, OCCUR, BLKSIZ, PRIMRY, SECDRY, 07050000 * RLSE, CONTG, ERCODE) 07060000 C 07070000 GO TO 9900 07080000 C 07090000 C 07100000 C 07110000 C1500 15. PROCESS = VELA - DELETED 3-3-87 07120000 C ============== 07130000 C 07140000 C 07150000 C 07160000 C1600 16. PROCESS = GMAP - DELETED 4/7/87 07170000 C ============== 07180000 C 07190000 C 07200000 C ============================ 07210000 C1700 17&29&43. PROCESS = MIGR & MIGE & MG45 - DELETED 3-3-87 07220000 C ============================ 07230000 C 07240000 C 07250000 C1800 18. PROCESS = TSUM - DELETED 4/13/87 07260000 C ============== 07270000 C 07280000 C 07290000 C ================= 07300000 C 22.PROCESS = HZAD 07310000 C ================= 07320000 C 3-11-87 WORK FILE DELETED. 07330000 C ============================================ 07340000 C COMPUTE PRIMARY ALLOCATION FOR HZAD OUTPUT FILE 07350000 C ============================================ 07360000 C 07370000 C 07380000 C COLOR PLOTS 07390000 C 07400000 2200 DA = 1 07410000 2230 CALL FORC (KPNA, KPRNO, DA, CARD, * 9900 )07420000 IF (S1CPCH (CARD, 8, ' ', 1, 3) .NE. 0) GO TO 2230 07430000 C 07440000 IF (S1CPCH (CARD, 76, 'ONCOL', 1, 5) .EQ. 0) GO TO 2240 07450000 C 07460000 BLKSIZ = 1296 07470000 PRIMRY = 1 07480000 GO TO 9900 07490000 C 07500000 2240 BLKSIZ = 23400 07510000 PRIMRY = 2700 07520000 GO TO 9900 07530000 C 07540000 C 07550000 C 07560000 C 07570000 C ========================= 07580000 C 23.PROCESS = TFAD OR FD3D 07590000 C ========================= 07600000 C 07610000 C ============================================= 07620000 C COMPUTE PRIMARY ALLOCATION FOR TFAD/FD3D FILE 07630000 C ============================================= 07640000 C 07650000 2300 IF (FCTFAD .NE. 0) GO TO 2325 07660000 C 07670000 C 07680000 DA = 1 07690000 MXDP = 0 07700000 OKNT = 0 07710000 NUMOUT = 0 07720000 C 07730000 2310 CALL FORC (KPNA, KPRNO, DA, CARD, * 2320 )07740000 IF (S1CPCH (CARD, 8, ' ', 1, 3) .NE. 0) GO TO 2310 07750000 C 07760000 SDP = S1CVBN(CARD, 11, 5) 07770000 EDP = S1CVBN(CARD, 16, 5) 07780000 IF (EDP .EQ. 0) EDP = SDP 07790000 NDP = EDP - SDP + 1 07800000 C 07810000 IF (NDP .GT. MXDP) MXDP = NDP 07820000 C 07830000 NUMOUT = NUMOUT + S1CVBN(CARD,56,5) 07840000 COUT IF (NUMOUT .LE. 0) GO TO 8040 07850000 GO TO 2310 07860000 C 07870000 C 07880000 2320 NREC = MXDP * 2 07890000 IF (NUMOUT.LE.0) NUMOUT=1 07900000 C 07910000 C 07920000 C BLKSIZ = 4 * NOSAMP 07930000 C PRIMRY = NREC 07940000 C SECDRY = 10 07950000 FCTFAD = 1 07960000 C GO TO 9900 07970000 C 07980000 C COLOR PLOTS 07990000 C 08000000 2325 DA = 1 08010000 2330 CALL FORC (KPNA, KPRNO, DA, CARD, * 9900 )08020000 IF (S1CPCH (CARD, 8, ' ', 1, 3) .NE. 0) GO TO 2330 08030000 C 08040000 OKNT = OKNT + 1 08050000 IF (OKNT .EQ. NUMOUT) FCTFAD = 0 08060000 C 08070000 IF (S1CPCH (CARD, 76, 'ONCOL', 1, 5) .EQ. 0) GO TO 2340 08080000 C 08090000 BLKSIZ = 1296 08100000 PRIMRY = 1 08110000 GO TO 9900 08120000 C 08130000 2340 BLKSIZ = 23400 08140000 PRIMRY = 2700 08150000 GO TO 9900 08160000 C 08170000 C 08180000 C2400 24. PROCESS = TRAC - DELETED 3-3-87 08190000 C ============== 08200000 C 08210000 C 08220000 C2500 25. PROCESS = QUAD - DELETED 2-24-87 08230000 C ============== 08240000 C 08250000 C 08260000 C2600 26. PROCESS = DELA - DELETED 3-11-87 08270000 C ============== 08280000 C 08290000 C 08300000 C ======================= 08310000 C 27. PROCESS = CRDA 08320000 C ======================= 08330000 C 08340000 C ========================================== 08350000 C ASSIGN THE OUTPUT FILE SIZES FOR CRDA 08360000 C ========================================== 08370000 C 08380000 C 08390000 C READ IN FIRST CARD 08400000 C 08410000 2700 DA = 1 08420000 C 08430000 2710 CALL FORC( KPNA, KPRNO, DA , CARD, *8030 )08440000 IF( S1CPCH(CARD,8,' ',1,3) .NE. 0) GO TO 2710 08450000 C 08460000 C MAKE SURE DATA SET TYPE IS I 08470000 C 08480000 IF (S1CPCH(CARD,40,'I',1,1) .NE. 0) THEN 08490000 WRITE (IPR, 27900) KPNA, KPRNO, CARD 08500000 27900 FORMAT (/' *** JSSPAC ERROR FOR PROC = ',A4,I1/5X,20A4/ 08510000 * ' *** DATA SET TYPE MUST BE "I".') 08520000 GO TO 9800 08530000 END IF 08540000 C 08550000 C CHECK FOR RECORD LENGTH OVERRIDE 08560000 C 08570000 IF (S1CPCH(CARD,21,' ',1,5) .NE. 0) 08580000 * BLKSIZ = ((S1CVBN(CARD,21,5) / PI) + THL) * 4 08590000 C 08600000 CALL JSWRTE (KPNA, KPRNO, OCCUR, BLKSIZ, PRIMRY, SECDRY, 08610000 * RLSE, CONTG, ERCODE) 08620000 C 08630000 IF (PRIMRY*BLKSIZ .GT. 500000000) THEN 08640000 WRITE (IPR, 27910) KPNA, KPRNO 08650000 27910 FORMAT (/' *** JSSPAC ERROR FOR PROC = ',A4,I1/ 08660000 * ' *** SPACE REQUESTED EXCEEDS ALLOWABLE ON INTERACTIVE')08670000 GO TO 9800 08680000 END IF 08690000 C 08700000 GO TO 9900 08710000 C 08720000 C 08730000 C2800 28. PROCESS = DMIG - DELETED 2-24-87 08740000 C ============== 08750000 C 08760000 C 08770000 C3200 32. PROCESS = PANL - DELETED 2-24-87 08780000 C ============== 08790000 C 08800000 C 08810000 C3300 33. PROCESS = COVA - DELETED 4/7/87 08820000 C ============== 08830000 C 08840000 C 08850000 C3400 34. PROCESS = RARS - DELETED 3-3-87 08860000 C ============== 08870000 C 08880000 C 08890000 C3500 35. PROCESS = COVE - DELETED 4/7/87 08900000 C ============== 08910000 C 08920000 C 08930000 C ============== 08940000 C3600 36. PROCESS = SURF OR SCDB 08950000 C ============== 08960000 C 3-3-87 DELETED USE BY SURF. 08970000 C 3-11-87 DELETED USE BY SCDB. 08980000 C 08990000 C 09000000 C 09010000 C ============== 09020000 C3700 37. PROCESS = CVPL - DELETED 3-3-87 09030000 C ============== 09040000 C 09050000 C 09060000 C 09070000 C ====================== 09080000 C3800 38. PROCESS = MG3D OR M345 - DELETED 4/7/87 09090000 C ====================== 09100000 C 09110000 C 09120000 C ============== 09130000 C3900 39. PROCESS = TMIX - DELETED 2-24-87 09140000 C ============== 09150000 C 09160000 C 09170000 C ===================== 09180000 C4000 49. PROCESS = SP3D - DELETED 3-11-87 09190000 C ===================== 09200000 C 09210000 C 09220000 C ============== 09230000 C 41. PROCESS = FRAN 09240000 C ============== 09250000 C 09260000 C ======================================= 09270000 C COMPUTE THE PRIMARY ALLOCATION FOR FRAN 09280000 C ======================================= 09290000 C 09300000 C 09310000 4100 CALL JSFRAN (KPNA, KPRNO, OCCUR, BLKSIZ, PRIMRY, SECDRY, 09320000 * RLSE, CONTG, ERCODE) 09330000 C 09340000 GO TO 9900 09350000 C 09360000 C 09370000 C 42. PROCESS = SRVY 09380000 C ============== 09390000 C 09400000 C ======================================= 09410000 C COMPUTE THE PRIMARY ALLOCATION FOR SRVY 09420000 C ======================================= 09430000 C 09440000 C GET SRVY CARD PARAMETERS 09450000 C 09460000 4200 DA = 1 09470000 CALL FORC (KPNA, KPRNO, DA, CARD, * 8020 )09480000 SECDRY = LCTPSP 09490000 NSP = LCANSP 09500000 C 09510000 PRIMRY = NSP * LCTPSP * .05 09520000 IF (PRIMRY .LT. 6000) PRIMRY = 6000 09530000 BLKSIZ = 8192 09540000 C 09550000 GO TO 9900 09560000 C 09570000 C ===================== 09580000 C4400 31. PROCESS = DTRX - DELETED 3-11-87 09590000 C ===================== 09600000 C 09610000 C 09620000 C ===================== 09630000 C4475 44. PROCESS = TRAX - DELETED 3-11-87 09640000 C ===================== 09650000 C 09660000 C 09670000 C ============== 09680000 C4500 45. PROCESS = LAGX - DELETED 3-11-87 09690000 C ============== 09700000 C 09710000 C 09720000 C 09730000 C 09740000 C ============== 09750000 C 46. PROCESS = VSPA 09760000 C ============== 09770000 C 09780000 C ============================================ 09790000 C COMPUTE ALLOCATIONS FOR 3 WORKFILES FOR VSPA 09800000 C ============================================ 09810000 C 09820000 C 09830000 4600 DA = 1 09840000 NPLT = 0 09850000 PLTL = 400 09860000 C 09870000 4620 CALL FORC (KPNA, KPRNO, DA, CARD, * 4650 )09880000 C 09890000 4625 IF (S1CPCH(CARD,8,'PLT',1,3).NE.0) GO TO 4620 09900000 NPLT = NPLT + 1 09910000 GO TO 4620 09920000 C 09930000 C ********** OUTPUT FILE ********** 09940000 C 09950000 4650 BLKSIZ = 8192 09960000 PRIMRY = 100*PLTL 09970000 PRIMRY = ((NPLT/2)*328*PRIMRY)/BLKSIZ + 1 09980000 SECDRY = 10 09990000 RLSE = NO 10000000 GO TO 9900 10010000 C 10020000 C 10030000 C 10040000 C ============== 10050000 C4700 47. PROCESS = VSPB - DELETED 2-24-87 10060000 C ============== 10070000 C 10080000 C 10090000 C ============== 10100000 C4800 48. PROCESS = AMPS - DELETED 3-11-87 10110000 C ============== 10120000 C 10130000 C 10140000 C ============== 10150000 C5000 50. PROCESS = VTPD - DELETED 3-11-87 10160000 C ============== 10170000 C 10180000 C 10190000 C ============== 10200000 C5100 51. PROCESS = VTPA - DELETED 3-3-87 10210000 C ============== 10220000 C 10230000 C 10240000 C ===================== 10250000 C5200 52. & 54. PROCESS = M2FK & M3FK - DELETED 2-24-87 10260000 C ===================== 10270000 C 10280000 C 10290000 C 53. PROCESS = QULR 10300000 C ============== 10310000 C 10320000 C =============================================== 10330000 C COMPUTE PRIMARY ALLOCATION FOR QULR OUTPUT FILE 10340000 C AND WORK FILE 10350000 C =============================================== 10360000 C 10370000 5300 DA = 1 10380000 5320 CALL FORC (KPNA, KPRNO, DA, CARD, * 8020 )10390000 IF (S1CPCH (CARD, 8, BLANK, 1, 3) .NE. 0) GO TO 5320 10400000 IF (S1CPCH (CARD, 76, 'ONCOL', 1, 5) .EQ. 0) GO TO 5330 10410000 BLKSIZ = 1296 10420000 PRIMRY = 5000 10430000 GO TO 9900 10440000 C 10450000 5330 BLKSIZ = 23400 10460000 PRIMRY = 2700 10470000 GO TO 9900 10480000 C 10490000 C ============== 10500000 C5400 54. PROCESS = VSPD - DELETED 2-24-87 10510000 C ============== 10520000 C 10530000 C 10540000 C 10550000 9800 ERCODE = 16 10560000 C 10570000 9900 CONTINUE 10580000 CKG 10590000 C WRITE(6,66666) PRIMRY,SECDRY,BLKSIZ 10600000 C6666 FORMAT(1X,' PRIMRY,SECDRY,BLKSIZ ',3I9) 10610000 CKG 10620000 RETURN 10630000 C 10640000 C ERROR MESSAGES 10650000 C 10660000 8000 WRITE (IPR, 98000) KPNA, KPRNO 10670000 GO TO 9800 10680000 C 10690000 8020 WRITE (IPR, 98020) KPNA, KPRNO 10700000 GO TO 9800 10710000 C 10720000 8030 WRITE (IPR, 98030) KPNA, KPRNO 10730000 GO TO 9800 10740000 C 10750000 8040 WRITE (IPR, 98040) KPNA, KPRNO 10760000 GO TO 9800 10770000 C 10780000 C 10790000 98000 FORMAT (/' *** JSSPAC DID NOT FIND LINE CARD') 10800000 C 10810000 98020 FORMAT (/' *** NO CARD PRESENT FOR PROC = ',A4,I1) 10820000 C 10830000 98030 FORMAT (/' *** NO CARD PRESENT FOR PROC = ',A4,I1) 10840000 C 10850000 98040 FORMAT (/' *** NUMBER OF OUTPUTS TO GENERATE IS REQUIRED FOR ', 10860000 * 'PROCESS ',A4,I1) 10870000 C 10880000 98050 FORMAT (/' *** NO PROCESS FOUND IN JSSPAC FOR ',A4,I1, 10890000 * /' *** DEFAULT VALUES WILL BE USED *** ') 10900000 END 10910000