CTITLEJSCORE -- REGION AND BLANK COMMMON 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 02-24-76 00060000 C REVISED 03-24-76 J. MENDEKE - ADDED 'NMOC' CODE 00070000 C REVISED 04-28-76 J. MENDEKE - ADDED 'COST' CODE 00080000 C REVISED 04-28-76 J. MENDEKE - ADDED 'VSUM' CODE 00090000 C REVISED 05-05-76 W.J. BROWN - ADDED 'DPTH' CODE 00100000 C REVISED 05-26-76 W.V. REDWINE - ADDED 'LRAC' CODE 00110000 C REVISED 05-26-76 D.D. REED - ADDED 'SCON' CODE 00120000 C REVISED 06-02-76 R.C. DECKER - ADDED 'REMT' CODE 00130000 C REVISED 06-22-76 W.J. BROWN - ADDED 'TRCS' CODE 00140000 C REVISED 07-13-76 R.E. MCMILLAN - ADDED 'FANF' CODE 00150000 C REVISED 07-20-76 R.E. MCMILLAN - CHANGED CSIZE IN 'SCON' TO 00160000 C K-BYTES 00170000 C REVISED 08-10-76 J. MENDEKE - ADDED 'GVAN' CODE 00180000 C REVISED 08-25-76 W. BROWN - ADDED 'GDSP' CODE 00190000 C REVISED 10-29-76 MENDEKE - PSIZE FOR NMOC,COST,TRCS AND DPTH. 00200000 C REVISED 11-16-76 D.D. REED - INCREASED CSIZE FOR 'SCON' TO ADD 00210000 C Y, REJECTION AND WEIGHTING ARRAY SPACE. 00220000 C REVISED 11-18-76 MENDEKE - ADDED 'GATH' CODE 00230000 C REVISED 12-08-76 DECKER - ADDED 'DDEC' AND 'SLOG' 00240000 C REVISED 12-09-76 MENDEKE - CHANGED GVAN TO VELA AND GDSP TO VELD.00250000 C REVISED 12-15-76 D.D.REED - CHANGED CSIZE FOR SCON VERSION WITH 00260000 C PILOT OPTIONS & ITER. 00270000 C REVISED 12-22-76 MENDEKE - ADDED GMAP 00280000 C REVISED 1-06-77 D.D.REED - ADDED ARRAYS TO SCON FOR PILOT 00290000 C OPTIONS. 00300000 C REVISED 1-10-77 MCMILLAN - ADDED MIGR 00310000 C REVISED 1-20-77 MCMILLAN - CHANGED MIGR 00320000 C REVISED 2-17-77 D.D. REED - ADDED ARRAYS TO SCON FOR RENUMBERING00330000 C SCHEME. 00340000 C REVISED 2-25-77 MENDEKE - CHANGED GATH 00350000 C REVISED 3-10-77 MENDEKE - ADDED STAK AND EDIT 00360000 C REVISED 3-11-77 D.D.REED - ADDED KONG AND SKIM 00370000 C REVISED 3-25-77 D.D.REED - CHANGED SCON 00380000 C REVISED 4-06-77 D.D.REED - CHANGED SCON AGAIN 00390000 C REVISED 4-21-77 D.D.REED - ADDED TO SCON, KONG, AND SKIM 00400000 C REVISED 4-27-77 J. MENDEKE- FIXED PMODE 00410000 C REVISED 5-13-77 R.MCMILLAN - FIXED MIGR FOR ARRAY LENGTH 00420000 C REVISED 5-20-77 MENDEKE - ADDED CSTK 00430000 C REVISED 6-22-77 MCMILLAN - ADDED FLTR. 00440000 C REVISED 6-27-77 WHIPPLE - ADDED SELT 00450000 C REVISED 9-21-77 DECKER - ADDED PLGP 00460000 C REVISED 10-10-77 REED - ADDED TRAC 00470000 C REVISED 10-19-77 WHIPPLE - 32K MORE FOR VELD 00480000 C REVISED 11-10-77 COOPER - CHANGED CSIZE ON STAK 00490000 C REVISED 01-13-78 MCMILLAN - FIX FANF FOR 'S' MODE 00500000 C REVISED 01-16-78 COOPER - ADDED ERROR CHECK TO VELA 00510000 C REVISED 01-31-78 COOPER - CHANGED VELA AND TRAC 00520000 C REVISED 03-01-78 MCMILLAN - ADDED DMIG 00530000 C REVISED 03-29-78 DECKER - ADDED MIGE 00540000 C REVISED 04-13-78 MENDEKE - CHANGED NMOC, GATH,DCON 00550000 C REVISED 05-02-78 DECKER - CHANGED REMT AND PLGP 00560000 C REVISED 05-18-78 DECKER - ADDED DCAN 00570000 C REVISED 06-02-78 DECKER - ADDED VELB,DTRC 00580000 C REVISED 06-14-78 MCMILLAN - CHANGED DMIG, FANF, AND FLTR FOR 00590000 C ADDED COMMON FOR 3838 00600000 C REVISED 06-14-78 COOPER - CHANGED CVAN 00610000 C REVISED 07-03-78 COOPER - ADDED COVA 00620000 C REVISED 07-13-78 MCMILLAN - ADDED SIGS 00630000 C REVISED 08-16-78 MCMILLAN - ADDED SPEC 00640000 C REVISED 11-06-78 COOPER - REDUCED CVAN TO MAXIMUM NO. OF 00650000 C VELOCITIES FOR ALL CVANS. 00660000 C REVISED 11-17-78 MCMILLAN - REDUCED COMMON FOR MIGR AND CHANGED 00670000 C PROGRAM SIZE FOR FLTR. 00680000 C REVISED 12-04-78 COOPER - DELETED LRAC, KONG AND SKIM. ALSO ADDED00690000 C URKBYT,URBYTE - AND CHECKS TO SEE IF AMOUNT OF 00700000 C UNRESERVED IS GREATER THAN THESE. IF NOT 00710000 C NOTHING IS DONE, IF SO THEN ONLY THAT PART OVER 00720000 C IS ALLOCATED. 00730000 C REVISED 12-20-78 MCMILLAN - CHANGE NAME OF SIGS TO SIGD. 00740000 C REVISED 12-20-78 WHIPPLE - REDUCE COMMON FOR SELT. 00750000 C REVISED 12-29-78 MCMILLAN - REDUCE COMMON FOR FANF. 00760000 C REVISED 1-22-79 COOPER - REDUCE COMMON FOR EDIT. 00770000 C REVISED 3-15-79 MCMILLAN - FIX COMMON FOR FANF. 00780000 C REVISED 3-20-79 MCMILLAN - FIX FANF FOR BYTES INSTEAD OF WORDS. 00790000 C REVISED 4-04-79 MCMILLAN - ADDED 1 TO CGRANG IN TRAC. 00800000 C REVISED 4-04-79 COOPER - ADDED TSUM. 00810000 C REVISED 4-17-79 MENDEKE - CHANGED GATH FOR CST OPTION. 00820000 C REVISED 8-13-79 MCMILLAN - FIX SELT FOR UNRESERVED COMMON UESD. 00830000 C REVISED 8-14-79 MCMILLAN - FIX CALL FROM FORP TO FORC IN SELT. 00840000 C REVISED 9-06-79 DECKER - DELETED SCON -- ADDED DSTK 00850000 C REVISED 9-24-79 REM. DELETE CHECK FOR "SP" ON ACCT CARD. 00860000 C REVISED 9-28-79 SAS. INCREASED VELD PSIZE FOR AUXILLIARY 00870000 C SEISMIC TRACE DISPLAY CAPABILITY. 00880000 C REVISED 10-25-79 REP. CHANGE TRAC RESERVED & UNRESERVED. 00890000 C REVISED 10-29-79 REP. REMOVE PTTHL FROM EQUATION FOR TRAC. 00900000 C REVISED 11-20-79 REM. CHANGE FANF FOR 8000 WORD BUFFER. 00910000 C REVISED 12-13-79 CWC. ADDED RARS 00920000 C REVISED 01-03-80 JGM. CHANGED GMAP 00930000 C REVISED 01-08-80 JGM. CHANGED GMAP 00940000 C REVISED 01-21-80 PKC. CHANGED COVA AND ADDED COVE. 00950000 C REVISED 01-30-80 RCD. ADDED SCAN 00960000 C REVISED 02-01-80 RCD. FIXED SCAN 00970000 C REVISED 03-19-80 RCD. CHANGED MEMORY ALLOCATION 00980000 C REVISED 03-20-80 SAS. ADDED CVPL PROCESS. 00990000 C REVISED 03-25-80 BNM. ADDED MG3D PROCESS. 01000000 C REVISED 04-28-80 PKC. ADDED CD3D PROCESS. 01010000 C REVISED 05-05-80 RCD. CHANGED SCAN. 01020000 C REVISED 05-19-80 PKC. CHANGED CD3D. 01030000 C REVISED 05-31-80 SAS. ADDED SRVY PROCESS. 01040000 C REVISED 08-29-80 DJP. ADDED ZDCN PROCESS. 01050000 C REVISED 09-04-80 REM. ADD READ FOR RESAMPLE. 01060000 C REVISED 09-04-80 HHL. ADDED MG45 PROCESS. 01070000 C REVISED 09-10-80 REM. FIX READ BY DEFINING LCSI. 01080000 C REVISED 09-25-80 WPB. ADDED R&D PROCESS. 01090000 C REVISED 10-01-80 REM. ADD TRAX WHICH POINTS TO SCAN. 01100000 C REVISED 10-13-80 PKC. CHANGED EDIT, CVPL, SRVY. 01110000 C REVISED 10-20-80 WPB. MODIFIED THE COMMON & REGION SIZE PROCEDURE01120000 C REVISED 10-20-80 RDK. CORRECTIONS TO MG3D. 01130000 C REVISED 11-21-80 DJP. ADDED LAGX AND SEPARATE CODE FROM SCAN 01140000 C FOR TRAX 01150000 C REVISED 12-18-80 RDK. ADDED VSPB. 01160000 C REVISED 12-30-80 DJP. ADDED AMPS AND SP3D 01170000 C REVISED 12-30-80 BNM. ADDED VTPA AND VTPD 01180000 C REVISED 1-20-81 RDK. MODIFY VSPB; ADD VSPA. 01190000 C REVISED 1-26-81 DJP. MODIFY AMPS AND SP3D 01200000 C REVISED 2-17-81 DJP. MODIFY AMPS 01210000 C REVISED 3-06-81 DJP. ADDED M2FK AND INCREASED LABELS FOR RETURN,01220000 C ERROR EXIT, AND R&D PROCESSES. 01230000 C REVISED 3-13-81 PKC. ADDED QULR. 01240000 C REVISED 3-24-81 SAS. CORRECTED M2FK CORE ALLOCATION ALGORITHM. 01250000 C REVISED 3-31-81 RDK. ADDED VSPC AND VSPD; REDIMENSIONED PROC. 01260000 C REVISED 4-10-81 DJP. ADDED M3FK 01270000 C REVISED 6-15-81 HHL. CORRECTED MG45 CORE ALLOCATION ALGORITHM. 01280000 C REVISED 6-30-81 RDK. ADDED "RES" SPARC SHELL SERIES FOR WPB. 01290000 C REVISED 6-30-81 RDK. MOVED ZMIG TO PRODUCTION SPARC. 01300000 C REVISED 7-24-81 RCD. ADDED SURF AND DTRX (REMOVED REMT & DTRC). 01310000 C REVISED 8-17-81 DJP. CHANGED TRAC FOR FILTER OPTION AND MULTI- 01320000 C TRACE CORRELATION. ALSO ADDED SP2D. 01330000 C REVISED 10-08-81 DJP. CHANGED FANF TO REDUCE UNRES. COMMON FOR 01340000 C JOBS NEEDING A SPATIAL FFT LENGTH > 2048. ALSO 01350000 C CHANGED SP2D TO ALLOW PLOT OF STATICS FROM STAT.01360000 C REVISED 10-12-81 RDK. MOVED FANA TO PRODUCTION SPARC. 01370000 C ADDED CALL TO JSCOR2. 01380000 C MOVED CODE FOR ZMIG & SP2D TO JSCOR2. 01390000 C REVISED 12-07-81 DJP. MODIFIED AMPS FOR MULTI-LAG CORRELATION AND01400000 C FOR MORE THAN ONE CORRELATION AT A TIME IN 01410000 C THE ARRAY PROCESSOR. 01420000 C REVISED 12-09-81 DJP. SET MINIMUM FFT LENGTH FOR CORRELATION IN 01430000 C TRAC TO 128. 01440000 C REVISED 12-31-81 DJP. ADDED 'ARC' SERIES FOR WPB. 01450000 C REVISED 01-08-82 JBC. ADDED CODE TO READ CSTK CARDS FOR 01460000 C BETTER CALCULATION OF RESERVE COMMON 01470000 C MOVED CODE FOR QULR,VSPC & VSPD 01480000 C TO JSCOR2 01490000 C REVISED 03-03-82 DJP. CHANGED TSUM. 01500000 C REVISED 04-02-82 JBC. CHANGED TSUM FOR VELOCITY INTERPOLATION 01510000 C REVISED 04-05-82 SAS. MODIFIED CVAN UNRESERVED BLANK COMMON 01520000 C ALLOCATION. 01530000 C REVISED 04-12-82 RDK. ADDED ENTRY FOR M345 (POINTS TO MG3D). 01540000 C MODIFIED CODE FOR NEW VERSION OF VSPA. 01550000 C REVISED 05-12-82 NTS. ADDED ENTRY FOR STAP (POINTS TO EDIT). 01560000 C REVISED 06-04-82 PKC. UPPED PSIZE OF READ. 01570000 C REVISED 06-17-82 WPB. CHANGE R & D RESERVED AND UNRESERVED 01580000 C BLANK COMMON ALLOCATIONS. 01590000 C REVISED 08-26-82 SAS. INCREASED ZDCN ALLOCATION FOR AP3838 01600000 C CONVERSION. 01610000 C REVISED 10-18-82 SAS. ADDED IDCN TO EXISTING SIGD ENTRY. 01620000 C REVISED 11-04-82 ESN. INCREASED RESERVED TRAC ALLOCATION BY 01630000 C 16007 FOR BLOCKED I/O ROUTINES. 01640000 C REVISED 11-09-82 SAS. INCREASED VSUM ALLOCATION FOR 'SKP' 01650000 C CARD UPGRADE. 01660000 C REVISED 11-17-82 WPB. ADDED ENTRIES SEG & CDP TO RESEARCH 01670000 C SECTION. 01680000 C REVISED 11-30-82 PKC. UPPED PSIZE OF GATH AND STAP. 01690000 C REVISED 12-15-82 JBC. CHANGED COMMON SIZE TO USE NOWDS IF 01700000 C LCPI .EQ. LCSI, OTHERWISE USE NOWDS 01710000 C RAISED TO THE NEXT POWER OF TWO NEEDED 01720000 C FOR RESAMPLING. 01730000 C REVISED 12-23-82 SAS MOVED R&D CATCH-ALL PROCESS ENTRY 01740000 C (RNDX THRU CDPX) TO JSCOR3. 01750000 C REVISED 02-14-83 RDK REVISED SPACE/SIZE CALCULATION FOR VSPA. 01760000 C INCREASED PSIZE FOR FANF. 01770000 C REVISED 02-23-83 ESN CORRECTED TRAC PARAMETER PILOTL VALUE. 01780000 C REVISED 03-05-83 PKC UPPED PSIZE OF FLTR,NMOC,READ, AND STAK. 01790000 C REVISED 03-21-83 REM CHANGE USE OF ACNSP TO LCANSP. 01800000 C REVISED 03-28-83 JBC ADDED 'R' MODE CAPABILITY TO FANF. 01810000 C REVISED 09-12-83 JBC CORRECTED ERROR IN GATH FOR 3-D LINES. 01820000 C REVISED 10-10-83 NTS CORRECTED ERROR IN CSIZE CALCULATION 01830000 C FOR NMOC. 01840000 C REVISED 10-10-83 NTS CORRECTED ERROR IN CSIZE CALCULATION 01850000 C FOR M2FK. 01860000 C REVISED 01-05-84 NTS CORRECTED ERROR IN FFT CALCULATION 01870000 C FOR FANF. 01880000 C REVISED 03-02-84 JBC UPPED PSIZE OF SIGD TO 36. 01890000 C REVISED 04-23-84 RDK ADDED ENTRY FOR SCDB (POINTS TO SURF). 01900000 C REVISED 06-25-84 CMP INCREASE BLANK COMMON FOR CD3D (UNIRAS) 01910000 C REVISED 06-27-84 ESN MODIFIED FANF ENTRY FOR BLOCKING, 01920000 C PERCENT ADDITIONS TO DATA CARD. 01930000 C REVISED 08-15-84 RDK REPLACE ALL OCCURRENCES OF '96' FOR TRACE 01940000 C HEADER LENGTH WITH 'THL'. 01950000 C REVISED 08-27-84 RDK INITIALIZE THL TO 190. 01960000 C REVISED 09-04-84 JMP CREATE SEPARATE ENTRY FOR EDIT. ELIMINATE 01970000 C 'ARES' CORE CALCULATION FROM EDIT CORESIZE.01980000 C REVISED 09-14-84 CMP BUMP PSIZE OF CD3D. 01990000 C REVISED 12-17-84 PKC BUMP PSIZE OF CD3D FOR UNIRAS 84.2. 02000000 C REVISED 12-19-84 LBL READ ACCT CARD TO DETERMINE COMPUTER ID. 02010000 C ALLOCATE LARGER BLANK COMMON FOR MIGR AND 02020000 C MG45 IF SYSTEM=CRAY. 02030000 C REVISED 01-18-85 TRA ELIMINATE WARNING MESSAGES ON SYSTEM TYPE. 02040000 C REVISED 01-21-85 TRA REFIGURE SCDB CORE WITH DEFAULTS. 02050000 C REVISED 03-18-85 RDK INCREASE FLTR PSIZE TO 33; ALLOCATE CSIZE 02060000 C FOR 4 WINDOWS MAX. 02070000 C REVISED 03-27-85 LBL ENLARGE LBUF FOR CRAY ROUTE IN FANF. 02080000 C REVISED 05-06-85 RKG CHANGED TO MAKE SPC CARD USEFUL FOR ALL 02090000 C PROCESSES. 02100000 C REVISED 05-20-85 RKG IF BLANK SPACE CARD IS INPUT, THE DEFAULT 02110000 C PARAMETERS WILL BE USED. 02120000 C REVISED 05-28-85 RKS INCREASE VELD PSIZE FROM 60 T0 75. 02130000 C MAJOR VELD REVISION FOR SEISET AND HTRACE. 02140000 C REVISED 06-10-85 LBL INCREASE MEMORY ALLOCATION FOR FANF IF 02150000 C SYSTEM=CRAY. 02160000 C REVISED 08-05-85 REP CHANGE TRAX FOR BUFFERED ARRAYS AND ADD 02170000 C 'AXSR' OPTION TO STAP. 02180000 C REVISED 10-04-85 RDK REVISED PSIZE AND CSIZE FOR READ, 02190000 C WHICH WAS GROSSLY OUT OF DATE. 02200000 C REVISED 11-08-85 ESN MODIFY STAP ENTRY FOR PICK FILE ACCESS. 02210000 C REVISED 01-09-86 JMP CHANGE READ PSIZE TO 68K. 02220000 C REVISED 01-13-86 ESN MODIFY STAP ENTRY SINCE 'NPICK' OPTION 02230000 C WILL NOT REQUIRE PICK FILE TO BE READ. 02240000 C REVISED 03-06-86 JMP ADD CORE FOR 1 TRACE-LENGTH SCRATCH 02250000 C ARRAY TO TRAC. 02260000 C REVISED 05-20-86 RDK MODIFY VELA FOR EXECUTION ON CRAY. 02270000 C REVISED 07-02-86 JMP CHANGE CSTK TO USE LCPI INSTEAD OF LCSI 02280000 C REVISED 07-16-86 JMP FORCE AMPS TO USE AN FFTLEN OF AT LEAST 02290000 C 128. 02300000 C REVISED 07-29-86 CMP INCREASE VELA PSIZE. 02310000 C REVISED 08-15-86 CMP FIX VELA COMMON CALC. FOR TVM CARD. 02320000 C REVISED 09-04-86 REM INCREASE PSIZE FOR AMPS AND TRAC. 02330000 C REVISED 09-10-86 REM ADD RSIZE TO PARAMETER LIST. 02340000 C REVISED 09-12-86 ESN INCREASE CVAN COM IF ON THE CRAY. 02350000 C REVISED 09-15-86 REM INCREASE PSIZE FOR:SELT,CVAN,GATH,NMOC, 02360000 C FANF,CVPL,MIRG/MG45,M2FK,DMIG,DDEC,&ZDCN. 02370000 C REVISED 09-18-86 CMP INCREASE PSIZE FOR READ. 02380000 C REVISED 09-25-86 REM MODIFY PSIZE FOR:DPTH/TRCS,SPEC/SIGD/IDCN, 02390000 C VELD,STAK,TSUM/VSUM,AND VSPA. 02400000 C REVISED 10-06-86 PKC ADDED RSIZE TO CD3D. 02410000 C REVISED 10-09-86 REM MODIFY PSIZE FOR: EDIT & GMAP. 02420000 C REVISED 10-09-86 PKC MODIFY PSIZE FOR: CD3D - NEW UNIRAS. 02430000 C REVISED 12-01-86 PKC MODIFY PSIZE FOR: CD3D - NEW DRIVER. 02440000 C REVISED 12-08-86 JMP CHANGE READ RESAMPLING ALLOCATION TO 02450000 C ALLOW FOR IMAGINARY COMPONENTS. 02460000 C REVISED 12-10-86 ESN DETERMINE SYSTEM BY STEP BEING EXECUTED. 02470000 C REVISED 01-26-87 PKC MODIFY PSIZE FOR: CD3D - NEW UNIRAS 5.3. 02480000 C REVISED 02-09-87 PKC UPDATE SP3D FOR REWRITTEN CODE. 02490000 C REVISED 02-10-87 ESN INCREASE CSIZE FOR TRAC FOR SAVING PILOT 02500000 C TRACES IN MEMORY. 02510000 C REVISED 04-01-87 CMP REWRITE GATH ENTRY FOR REDUCED I/O. 02520000 C REVISED 04-06-87 JMP ADD TRACE BUFFER IN READ FOR WGC4 ON CRAY. 02530000 C REVISED 04-13-87 REM DELETE OLD PROCESSES:DSTK,SURF,COVE,PLGP, 02540000 C MIGE,VELD,DTRX,COVA,MG3D,VTPA,VTPD,M345, 02550000 C VCOM,DCAN,SCAN. 02560000 C REVISED 04-13-87 CMP INCREASE COM FOR CVAN ON CRAY. 02570000 C REVISED 05-04-87 ESN CORRECT TRAC RESERVED MEMORY ALLOCATION 02580000 C THROUGH USE OF MX2 FOR PILOT FLAG .NE. 1. 02590000 C REVISED 06-05-87 DPH MODIFY DATA STATEMENTS TO RUN ON CRAY; 02600000 C ALSO CHANGE C*4 DECLARATIONS TO INTEGER. 02610000 C REVISED 06-16-87 DPH ADD /SYSTEM/ COMMON AND DELETE LOCAL 02620000 C INITIALIZATION OF PARAMETER "SYSTEM"; 02630000 C ALSO CHANGE IPR SETTING FROM 6 TO 98. 02640000 C REVISED 07-23-87 CMP MODIFY ENTRY FOR SCDB TO INCLUDE LCMXLN. 02650000 C REVISED 09-01-87 PKC ADD ENTRY FOR STKP. 02660000 C REVISED 03-29-88 ESN ADD ENTRY FOR SISG. 02670000 C REVISED 04-04-88 TJT MAKE LCGRPI REAL. 02680000 C REVISED 07-19-88 TJT MODIFY STAP FOR GLIA/3D MEMORY CALC. 02690000 C REVISED 07-21-88 TJT MODIFY SELT FOR SELECTION BY LINE NAME. 02700000 C REVISED 09-21-88 MCD MODIFY TO ADD NEW 'PHAS' PROCESS. 02710000 C REVISED 11-03-88 ESN ADD TR3D AND TS3D AND MODIFY STAP. 02720000 C REVISED 12-08-88 TJT MODIFY READ MEMORY REQUIREMENTS. 02730000 C REVISED 12-13-88 ESN ADD VDAT. 02740000 C REVISED 01-05-89 ESN CORRECT STAP ENTRY FOR AXSR. 02750000 C REVISED 01-18-89 ESN ADD DPDE. 02760000 C REVISED 02-27-89 REM ADD CRDA. 02770000 C REVISED 04-13-89 ESN MODIFY DPDE ENTRY FOR ROLL-ALONG. 02780000 C REVISED 07-17-89 ESN ADD SORT, MU3D, AND PIKL PROCESSES. 02790000 C REVISED 09-20-89 LWC CORRECT PROBLEM KEEPING ROUTINE FROM 02800000 C FINDING COMMON NEEDED FOR SPEC. 02810000 C REVISED 11-13-89 RDK FOR CFT77 COMPATIBILITY ON THE CRAY. 02820000 C REVISED 11-17-89 ESN CORRECT GATH ENTRY FOR NDPS=NDPS*NOLNS. 02830000 C REVISED 12-06-89 ESN CORRECT SORT ENTRY FOR ABSOLUTE VALUE OF 02840000 C NUMBER OF FILES. 02850000 C REVISED 12-12-89 ESN CORRECT GATH ENTRY FOR WRAPAROUND SPACE. 02860000 C REVISED 12-18-89 RDK ADD PATH FOR 'ORDR' (SAME AS GATH). 02870000 C REVISED 04-05-90 ESN ALLOW SP3D TO HANDLE MORE THAN 99999 02880000 C RECEIVERS. ALLOW 'K' SPECIFICATION FOR 02890000 C TR3D MAX NUMBER OF RECEIVERS. 02900000 C REVISED 05-04-90 ESN CORRECT GATH ENTRY FOR 3-D AND COS. 02910000 C REVISED 06-09-90 ESN ADD CS3D. 02920000 C REVISED 09-18-90 CLJ ADD A SEPARATE ENTRY FOR 'ORDR' AND CORRECT02930000 C THE MEMORY ALLOCATION 02940000 C REVISED 10-03-90 CLJ GATH, CORRECT ALLOCATION TO INCLUDE ALL 02950000 C TRACES WHEN A 'COS' GATHER PRECEEDS THIS 02960000 C GATHER IN CURRENT JOB 02970000 C REVISED 10-11-90 ESN CORRECT SORT ENTRY FOR NUMBER OF SORTS. 02980000 C REVISED 10-23-90 ESN CHANGE SORT ENTRY TO REDUCE SPACE. 02990000 C REVISED 01-21-91 ESN ADD P100. 03000000 C REVISED 04-04-91 ESN FOR EDIT, MULTIPLY MXGPS BY LCMXLN. 03010000 C REVISED 04-12-91 ESN ADD GA3D. 03020000 C REVISED 08-22-91 ESN DOUBLE MEMORY REQUIRED FOR SRVY. 03030000 C REVISED 10-17-91 ESN ADD VSHF. 03040000 C REVISED 11-19-91 ESN CORRECT VSUM ENTRY. 03050000 C REVISED 12-22-91 JJC ADD ALTO. 03060000 C REVISED 06-03-92 ESN MODIFY SCDB ENTRY TO READ MAX NUMBER OF 03070000 C TRACES FROM DATA CARD. 03080000 C REVISED 01-14-93 ESN UP THE LIMIT OF TRACES IN GATH TO GO 03090000 C TO DISK FROM 500000 TO 999999. 03100000 C REVISED 03-18-93 ESN CORRECT GATH MEM ALLOCATION FOR 3-D AND 03110002 C NOT COS. 03120002 CA 03130000 CA CALL JSCORE (KPNA,KPRNO,OCCUR,BLKSIZ,PSIZE,CSIZE,RSIZE,ERCODE) 03140000 CA INPUT KPNA = PROCESS NAME A4 03150000 CA INPUT KPRNO = PROCESS NUMBER I4 03160000 CA INPUT OCCUR = OCCURRENCE NUMBER FOR PROCESS KPNA WITH I4 03170000 CA KPRNO 03180000 CA INPUT BLKSIZ= BLOCK SIZE (BYTES) I4 03190000 CA OUTPUT PSIZE = REGION SIZE OF PROGRAM IN K-BYTES I4 03200000 CA OUTPUT CSIZE = BLANK COMMON SIZE IN K-BYTES I4 03210000 CA OUTPUT RSIZE = EXTRA REGION SIZE IN K-BYTES I4 03220000 CA OUTPUT ERCODE= ERROR CODE (=16 IF NOT ABLE TO COMPUTE I4 03230000 CA THE REQUIRED PARAMETERS) 03240000 CA 03250000 CA 03260000 CA COMPUTES THE PROGRAM SIZE AND AMOUNT OF BLANK COMMON NEEDED FOR 03270000 CA PROCESSES REQUIRING SPECIAL CALCULATIONS. 03280000 C 03290000 C 03300000 C INTEGER ARRAYS -- LOCAL 03310000 C 03320000 C CARD(20) = DATA CARD ARRAY 03330000 C PROC(60) = PROCESS NAMES 03340000 C 03350000 C EJECT 03360000 C 03370000 SUBROUTINE JSCORE (KPNA,KPRNO,OCCUR,BLKSIZ,PSIZE,CSIZE,RSIZE, 03380000 * ERCODE) 03390000 C 03400000 IMPLICIT INTEGER (A-Z) 03410000 C 03420000 COMMON /SYSTEM/ SYSTEM 03430000 COMMON /SYSTEM/ SYBYPW 03440000 COMMON /SYSTEM/ SYLOCF 03450000 COMMON /SYSTEM/ JAPNMS 03460000 C 03470000 INTEGER JAPNMS (4) 03480000 C 03490000 C INTEGER ARRAYS -- LOCAL 03500000 C 03510000 INTEGER PROC (60) 03520000 INTEGER CARD (20) 03530000 INTEGER CARD2 (20) 03540000 C 03550000 C INTEGER CONSTANTS -- LOCAL 03560000 C 03570000 INTEGER BLANK 03580000 INTEGER BMS 03590000 INTEGER CRAY 03600000 INTEGER DDNAME 03610000 INTEGER EDMODE 03620000 INTEGER FCF 03630000 INTEGER IBM 03640000 INTEGER IFLAG 03650000 INTEGER IPR 03660000 INTEGER KPNA 03670000 INTEGER LNMODE 03680000 INTEGER MIGRSV 03690000 INTEGER MXPORT 03700000 INTEGER SIS 03710000 INTEGER SYSTEM 03720000 INTEGER THL 03730000 INTEGER VASCN 03740000 C 03750000 C REAL VARIABLES -- LOCAL 03760000 C 03770000 REAL FNYQ 03780000 REAL FRACN 03790000 REAL LCGRPI 03800000 C 03810000 C THIS VARIABLE IS USED TO DETERMINE THE AMOUNT OF 03820000 C UNRESERVED COMMON TO ALLOCATE. IT IS EQUAL TO THE 03830000 C BLANK COMMON OVERHEAD SPECIFIED IN PTABMSTR MINUS 100 03840000 C 03850000 INTEGER URKBYT 03860000 C 03870000 C LOGICAL VARIABLES -- LOCAL 03880000 C 03890000 LOGICAL TRACF 03900000 LOGICAL WGC4RD 03910000 C 03920000 DATA PROC /'CVAN','STKP','NMOC','COST','VSUM', 03930000 * 'DPTH','TSUM','SISG','VDAT','TRCS', 03940000 * 'FANF','VELA','VELD','GATH','DDEC', 03950000 * 'SLOG','GMAP','MIGR','STAK','EDIT', 03960000 * 'RARS','DPDE','CSTK','FLTR','SELT', 03970000 * 'CRDA','TRAC','DMIG','SORT','DCON', 03980000 * 'TR3D','TS3D','MU3D','PIKL','SIGD', 03990000 * 'SPEC','CS3D','CVPL','P100','CD3D', 04000000 * 'SRVY','ZDCN','READ','MG45','TRAX', 04010000 * 'LAGX','VSPB','AMPS','SP3D','PHAS', 04020000 * 'GA3D','VSPA','M2FK','M3FK','VSHF', 04030000 * 'STAP','IDCN','SCDB','ORDR','ALTO' / 04040000 C 04050000 DATA BLANK /' '/ 04060000 DATA BMS /' BMS '/ 04070000 DATA CRAY /'CRAY '/ 04080000 DATA IBM /'IBM '/ 04090000 DATA SIS /' SIS '/ 04100000 C 04110000 DATA FCF /1/ 04120000 DATA IPR /98/ 04130000 DATA IFLAG /0/ 04140000 DATA MIGRSV /0/ 04150000 DATA MXPORT /400/ 04160000 DATA THL /190/ 04170000 DATA URKBYT /300/ 04180000 C 04190000 DATA TRACF /.FALSE./ 04200000 C 04210000 C 04220000 C 04230000 RSIZE = 0 04240000 ERCODE = 0 04250000 IF (FCF .EQ. 0) GO TO 9700 04260000 FCF = 0 04270000 C 04280000 C GET LINE CARD PARAMETERS 04290000 C 04300000 DA = 1 04310000 CALL FORC ('LINE', 0, DA, CARD, * 8000 )04320000 C 04330000 LCTPSP = S1CVBN (CARD, 36, 5) 04340000 LCMXFD = S1CVBN (CARD, 61, 5) 04350000 IF (LCMXFD .EQ. 0) LCMXFD = LCTPSP 04360000 CALL S1MVCH ('LS', 1, PMODE, 1, 2) 04370000 IF (S1CPCH(CARD,6,' ',1,1) .NE. 0) CALL S1MVCH(CARD,6,PMODE,1,1) 04380000 IF (S1CPCH(CARD,7,' ',1,1) .NE. 0) CALL S1MVCH(CARD,7,PMODE,2,1) 04390000 C 04400000 LCBGSP = S1CVBN (CARD, 11, 5) 04410000 LCENSP = S1CVBN (CARD, 16, 5) 04420000 LCNSP = S1CVBN (CARD, 31, 5) 04430000 RLENG = S1CVBN (CARD, 41, 5) 04440000 LCRL = RLENG 04450003 LCSI = S1CVBN (CARD, 46, 5) 04460000 LCPI = S1CVBN (CARD, 51, 5) 04470000 CC LCGRPI = S1CVBN (CARD, 56, 5) 04480000 CALL USCHFT (CARD, 56, 5, LCGRPI) 04490000 IF (LCPI .EQ. 0) GO TO 9800 04500000 NOSAMP = RLENG / LCPI 04510000 URBYTE = URKBYT * 1024 04520000 LCANSP = S1CVBN (CARD, 66, 5) 04530000 LCMXLN = S1CVBN (CARD, 71, 5) 04540000 IF (LCMXLN .EQ. 0) LCMXLN = 1 04550000 C 04560000 C 04570000 C ======================================================== 04580000 C COMPUTES REGION AND COMMON SIZE FOR R & D PROCESSES 04590000 C READ THE "SPC" CARD FOR ANY PROCESS (IF PRESENT) 04600000 C ======================================================== 04610000 CKG 04620000 C 1 WRITE(6,99999) KPNA, KPRNO,KPNA,KPRNO 04630000 C9999 FORMAT('0 JUST BEFORE 9700 ',A4,I6,2Z9) 04640000 CKG 04650000 C 04660000 C 04670000 C 04680000 9700 DA = 1 04690000 PSIZE = 500 04700000 CSIZE = 0 04710000 9710 CALL FORC (KPNA, KPRNO, DA, CARD, * 5 )04720000 CKG 04730000 C WRITE(6,89999) DA, CARD 04740000 C9999 FORMAT('0 JUST AFTER 9710 DA ',I7, 20A4) 04750000 CKG 04760000 IF (S1CPCH (CARD, 8, 'SPC', 1, 3).NE. 0) GO TO 9710 04770000 IF (S1CPCH (KPNA, 1,'SPEC', 1, 4).EQ. 0) GO TO 9710 04780000 CKG 04790000 C WRITE(6,99998) CARD 04800000 C9998 FORMAT('0 SPACE CARD FOUND ',20A4) 04810000 CKG 04820000 C 04830000 C 04840000 IF (S1CPCH (CARD,11, ' ', 1, 5) .EQ. 0 .AND. 04850000 * S1CPCH (CARD,16, ' ', 1, 5) .EQ. 0 .AND. 04860000 * S1CPCH (CARD,21, ' ', 1, 5) .EQ. 0 ) GO TO 9900 04870000 C 04880000 C 04890000 ICORE = S1CVBN (CARD, 11, 5) 04900000 IBCOM = S1CVBN (CARD, 16, 5) 04910000 ISCOM = S1CVBN (CARD, 21, 5) 04920000 IF (ICORE .EQ. 0) ICORE = 500 04930000 CSIZE = IBCOM 04940000 PSIZE = ICORE 04950000 COM = ISCOM 04960000 IF (COM .LE. URKBYT) COM = 0 04970000 IF (COM .EQ. 0) GO TO 9720 04980000 SVCOM = COM 04990000 COM = COM - URKBYT 05000000 URKBYT = SVCOM 05010000 URBYTE = URKBYT * 1024 05020000 9720 CSIZE = CSIZE + COM 05030000 CKG 05040000 C WRITE(6,99997) CSIZE,PSIZE,COM,URKBYT 05050000 C9997 FORMAT('0 CSIZE PSIZE COM URKBYT ',4I9) 05060000 CKG 05070000 GO TO 9900 05080000 C 05090000 C FIND THE PROCESS 05100000 C ================ 05110000 C 05120000 5 IF (KPNA .EQ. PROC(1)) GO TO 100 05130000 IF (KPNA .EQ. PROC(2)) GO TO 200 05140000 IF (KPNA .EQ. PROC(3)) GO TO 300 05150000 IF (KPNA .EQ. PROC(4)) GO TO 400 05160000 IF (KPNA .EQ. PROC(5)) GO TO 500 05170000 IF (KPNA .EQ. PROC(6)) GO TO 600 05180000 IF (KPNA .EQ. PROC(7)) GO TO 700 05190000 IF (KPNA .EQ. PROC(8)) GO TO 800 05200000 IF (KPNA .EQ. PROC(9)) GO TO 900 05210000 IF (KPNA .EQ. PROC(10)) GO TO 600 05220000 IF (KPNA .EQ. PROC(11)) GO TO 1100 05230000 IF (KPNA .EQ. PROC(12)) GO TO 1200 05240000 IF (KPNA .EQ. PROC(13)) GO TO 1300 05250000 IF (KPNA .EQ. PROC(14)) GO TO 1400 05260000 IF (KPNA .EQ. PROC(15)) GO TO 1500 05270000 IF (KPNA .EQ. PROC(16)) GO TO 1600 05280000 IF (KPNA .EQ. PROC(17)) GO TO 1700 05290000 IF (KPNA .EQ. PROC(18)) GO TO 1800 05300000 IF (KPNA .EQ. PROC(19)) GO TO 400 05310000 IF (KPNA .EQ. PROC(20)) GO TO 1900 05320000 IF (KPNA .EQ. PROC(21)) GO TO 2100 05330000 IF (KPNA .EQ. PROC(22)) GO TO 2200 05340000 IF (KPNA .EQ. PROC(23)) GO TO 2300 05350000 IF (KPNA .EQ. PROC(24)) GO TO 2400 05360000 IF (KPNA .EQ. PROC(25)) GO TO 2500 05370000 IF (KPNA .EQ. PROC(26)) GO TO 2600 05380000 IF (KPNA .EQ. PROC(27)) GO TO 2700 05390000 IF (KPNA .EQ. PROC(28)) GO TO 2800 05400000 IF (KPNA .EQ. PROC(29)) GO TO 2900 05410000 IF (KPNA .EQ. PROC(30)) GO TO 3000 05420000 IF (KPNA .EQ. PROC(31)) GO TO 3100 05430000 IF (KPNA .EQ. PROC(32)) GO TO 3200 05440000 IF (KPNA .EQ. PROC(33)) GO TO 3300 05450000 IF (KPNA .EQ. PROC(34)) GO TO 3400 05460000 IF (KPNA .EQ. PROC(35)) GO TO 3500 05470000 IF (KPNA .EQ. PROC(36)) GO TO 3500 05480000 IF (KPNA .EQ. PROC(37)) GO TO 3700 05490000 IF (KPNA .EQ. PROC(38)) GO TO 3800 05500000 IF (KPNA .EQ. PROC(39)) GO TO 3900 05510000 IF (KPNA .EQ. PROC(40)) GO TO 4000 05520000 IF (KPNA .EQ. PROC(41)) GO TO 4100 05530000 IF (KPNA .EQ. PROC(42)) GO TO 4200 05540000 IF (KPNA .EQ. PROC(43)) GO TO 4300 05550000 IF (KPNA .EQ. PROC(44)) GO TO 1800 05560000 IF (KPNA .EQ. PROC(45)) GO TO 4500 05570000 IF (KPNA .EQ. PROC(46)) GO TO 4600 05580000 IF (KPNA .EQ. PROC(47)) GO TO 4700 05590000 IF (KPNA .EQ. PROC(48)) GO TO 4800 05600000 IF (KPNA .EQ. PROC(49)) GO TO 4900 05610000 IF (KPNA .EQ. PROC(50)) GO TO 5000 05620000 IF (KPNA .EQ. PROC(51)) GO TO 1400 05630000 IF (KPNA .EQ. PROC(52)) GO TO 5200 05640000 IF (KPNA .EQ. PROC(53)) GO TO 5300 05650000 IF (KPNA .EQ. PROC(54)) GO TO 5300 05660000 IF (KPNA .EQ. PROC(55)) GO TO 5500 05670000 IF (KPNA .EQ. PROC(56)) GO TO 2000 05680000 IF (KPNA .EQ. PROC(57)) GO TO 3500 05690000 IF (KPNA .EQ. PROC(58)) GO TO 5800 05700000 IF (KPNA .EQ. PROC(59)) GO TO 5900 05710000 IF (KPNA .EQ. PROC(60)) GO TO 2400 05720000 C 05730000 C PROCESS NOT IDENTIFIED IN JSCORE--CHECK JSCOR2 05740000 C 05750000 CALL JSCOR2 ( KPNA, KPRNO, OCCUR, BLKSIZ, 05760000 * PSIZE, CSIZE, RSIZE, ERCODE, URBYTE, URKBYT ) 05770000 C 05780000 GO TO 9900 05790000 C 05800000 C 1. PROCESS = CVAN 05810000 C ============== 05820000 C 05830000 C =========================================== 05840000 C COMPUTE THE REGION AND COMMON SIZE FOR CVAN 05850000 C =========================================== 05860000 C 05870000 100 PSIZE = 37 05880000 CSIZE = (5 * BLKSIZ + 1023) / 1024 05890000 C 05900000 C GET CVAN CARD PARAMETERS 05910000 C 05920000 DA = 1 05930000 CALL FORC (KPNA, KPRNO, DA, CARD, * 8020 )05940000 IF (S1CPCH(CARD,23,'UVS',1,3) .EQ. 0) GO TO 9900 05950000 NVEL = S1CVBN (CARD, 26, 5) 05960000 C 05970000 C CALCULATE COMMON SIZE AND CONVERT TO K-BYTES 05980000 C 05990000 C ASSUME NUMBLK = 12 AND ALLOCATE SPACE FOR 4 NOSAMP BUFFERS 06000000 C FOR SUM/DIVISOR AREAS AND FOR APPLYING VELOCITY + 3838 WORK 06010000 C 06020000 COM = (2 * NVEL + 16) * 4 * NOSAMP + 5000 06030000 IF (S1CPCH(SYSTEM,1,'CRAY',1,4) .EQ. 0) 06040000 * COM = COM + (33 + (6+5+2)*NOSAMP)*4 06050000 C CALCULATE COMMON SIZE AND CONVERT TO K-BYTES 06060000 C 06070000 COM = (COM + 1023) / 1024 06080000 IF (COM .LE. URKBYT) COM = 0 06090000 IF (COM .EQ. 0) GO TO 110 06100000 SVCOM = COM 06110000 COM = COM - URKBYT 06120000 URKBYT = SVCOM 06130000 URBYTE = URKBYT * 1024 06140000 C 06150000 110 CSIZE = CSIZE + COM 06160000 GO TO 9900 06170000 C 06180000 C 200 2. PROCESS = STKP 06190000 C ============== 06200000 C 06210000 C ========================================================== 06220000 C COMPUTE THE REGION AND COMMON SIZE FOR STKP 06230000 C ========================================================== 06240000 C 06250000 200 PSIZE = 24 06260000 CSIZE = 650 06270000 NSSP = LCANSP 06280000 NTRCS = NSSP * LCTPSP 06290000 NGPS = 3 * NSSP + 2 * LCTPSP 06300000 NDPS = 2 * NGPS 06310000 CSIZE = CSIZE + 6 * NSSP + 4 * NGPS + 4 * NTRCS + 5 * NDPS 06320000 CSIZE = (CSIZE*4 + 1023) / 1024 06330000 GO TO 9900 06340000 C 06350000 C 3. PROCESS = NMOC 06360000 C 06370000 C ========================================================== 06380000 C COMPUTE THE REGION AND COMMON SIZE FOR NMOC 06390000 C ========================================================== 06400000 C 06410000 300 PSIZE = 25 06420000 LAP = 4000 06430000 CSIZE = (BLKSIZ * 7 + LAP + 1023 )/1024 06440000 GO TO 9900 06450000 C 06460000 C 06470000 C 4. PROCESS = COST 06480000 C 19. PROCESS = STAK 06490000 C ============== 06500000 C 06510000 C ==================================================== 06520000 C COMPUTE THE REGION AND COMMON SIZE FOR COST AND STAK 06530000 C ==================================================== 06540000 C 06550000 400 PSIZE = 66 06560000 CSIZE = (BLKSIZ * 5 + 1023) / 1024 06570000 GO TO 9900 06580000 C 06590000 C 06600000 C 06610000 C 06620000 C 5. PROCESS = VSUM 06630000 C ============== 06640000 C 06650000 C =========================================== 06660000 C COMPUTE THE REGION AND COMMON SIZE FOR VSUM 06670000 C =========================================== 06680000 C 06690000 500 PSIZE = 57 06700000 C 06710000 CSIZE1 = 13 * BLKSIZ + 5 * LCTPSP + 2 * THL + LCNSP 06720000 * + 2000 06730000 CSIZE2 = 0 06740000 C 06750000 DA = 1 06760000 510 CALL FORC (KPNA, KPRNO, DA, CARD, * 590 )06770000 IF (S1CPCH(CARD,8,'CXG',1,3) .NE. 0) GO TO 510 06780000 CSIZE2 = LCMXFD*(LCMXFD*9+2) 06790000 C 06800000 590 CSIZE = (4*CSIZE1 + 4*CSIZE2 + 1023) / 1024 06810000 GO TO 9900 06820000 C 06830000 C 6. PROCESS = DPTH 06840000 C 10. PROCESS = TRCS 06850000 C ============== 06860000 C 06870000 C ========================================================== 06880000 C COMPUTE THE REGION AND COMMON SIZE FOR DPTH OR TRCS 06890000 C ========================================================== 06900000 C 06910000 600 PSIZE = 17 06920000 CSIZE = BLKSIZ * 4 / 1024 06930000 GO TO 9900 06940000 C 06950000 C 06960000 C 06970000 C 06980000 C 7. PROCESS = TSUM 06990000 C ============== 07000000 C 07010000 C =========================================== 07020000 C COMPUTE THE REGION AND COMMON SIZE FOR TSUM 07030000 C =========================================== 07040000 C 07050000 700 PSIZE = 57 07060000 CSIZE = (13 * BLKSIZ + 5 * LCTPSP + 2 * THL + LCNSP 07070000 * + 2000 + 1023) / 1024 07080000 GO TO 9900 07090000 C 07100000 C 8. PROCESS = SISG 07110000 C ============== 07120000 C 07130000 C =========================================== 07140000 C COMPUTE THE REGION AND COMMON SIZE FOR SISG 07150000 C =========================================== 07160000 C 07170000 800 PSIZE = 15 07180000 DA = 1 07190000 C 07200000 810 CALL FORC (KPNA, KPRNO, DA, CARD, * 8020 )07210000 IF (S1CPCH(CARD,8,' ',1,3) .NE. 0) GO TO 810 07220000 R1 = S1CVBN (CARD, 11, 5) 07230000 R2 = S1CVBN (CARD, 16, 5) 07240000 NCDP = R2 - R1 + 1 07250000 LINE1 = S1CVBN (CARD, 66, 5) 07260000 LINE2 = S1CVBN (CARD, 71, 5) 07270000 NLINE = LINE2 - LINE1 + 1 07280000 C 07290000 CSIZE = (NCDP*NLINE*8 + 1023) / 1024 07300000 GO TO 9900 07310000 C 07320000 C 9. PROCESS = VDAT 07330000 C ============== 07340000 C 07350000 C =========================================== 07360000 C COMPUTE THE REGION AND COMMON SIZE FOR VDAT 07370000 C =========================================== 07380000 C 07390000 900 PSIZE = 15 07400000 DA = 1 07410000 C 07420000 910 CALL FORC (KPNA, KPRNO, DA, CARD, * 8020 )07430000 IF (S1CPCH(CARD,8,' ',1,3) .NE. 0) GO TO 910 07440000 R1 = S1CVBN (CARD, 11, 5) 07450000 R2 = S1CVBN (CARD, 16, 5) 07460000 NCDP = R2 - R1 + 1 07470000 LINE1 = S1CVBN (CARD, 66, 5) 07480000 LINE2 = S1CVBN (CARD, 71, 5) 07490000 NLINE = LINE2 - LINE1 + 1 07500000 C 07510000 CSIZE = (NCDP*NLINE*4 + 1023) / 1024 07520000 GO TO 9900 07530000 C 07540000 C ======================= 07550000 C 900 9 AND 26. PROCESS = PLGP - DELETED 4/13/87 07560000 C ======================= 07570000 C 07580000 C 07590000 C ============== 07600000 C 11. PROCESS = FANF 07610000 C ============== 07620000 C 07630000 C =========================================== 07640000 C COMPUTE THE REGION AND COMMON SIZE FOR FANF 07650000 C =========================================== 07660000 C 07670000 C 07680000 1100 PSIZE = 51 07690000 CSIZE = BLKSIZ + 1040 07700000 NCARD = 0 07710000 DA = 1 07720000 C 07730000 1110 CALL FORC (KPNA, KPRNO, DA, CARD, * 8020 )07740000 IF (S1CPCH(CARD,8,' ',1,3) .NE. 0) GO TO 1110 07750000 CALL S1MVCH(CARD,7,MODE,1,1) 07760000 IF (S1CPCH(MODE,1,' ',1,1) .EQ. 0) 07770000 * CALL S1MVCH(PMODE,2,MODE,1,1) 07780000 C 07790000 C READ BLOCKING AND PERCENT INCREASE PARAMETERS 07800000 C 07810000 C % SPATIAL INCREASE 07820000 PERCXI = S1CVBN(CARD,61,5) 07830000 IF (S1CPCH(CARD,61,' ',1,5) .EQ. 0) PERCXI = 20 07840000 C % TIME INCREASE 07850000 PERCTI = S1CVBN(CARD,66,5) 07860000 IF (S1CPCH(CARD,66,' ',1,5) .EQ. 0) PERCTI = 20 07870000 C NSAVE 07880000 NSAVEP = S1CVBN(CARD,71,5) 07890000 IF (S1CPCH(CARD,71,' ',1,5) .EQ. 0) NSAVEP = -1 07900000 C NI 07910000 NIPREP = S1CVBN(CARD,76,5) 07920000 IF (S1CPCH(CARD,76,' ',1,5) .EQ. 0) NIPREP = -1 07930000 C 07940000 C DETERMINE NUMBER OF TRACES TO BE PROCESSED 07950000 C AT A TIME 07960000 C 07970000 NTR = LCTPSP 07980000 IF (S1CPCH(MODE,1,'R',1,1) .EQ. 0) NTR = 2 * NTR 07990000 IF (S1CPCH(MODE,1,'D',1,1) .NE. 0) GO TO 1140 08000000 NTR = LCMXFD 08010000 C 08020000 1120 SPT = S1CVBN(CARD,11,5) 08030000 EPT = S1CVBN(CARD,16,5) 08040000 IF (EPT .EQ. 0) EPT = SPT 08050000 IF (IABS(EPT-SPT) + 1 .GT. NTR) NTR = IABS(EPT-SPT) + 1 08060000 NCARD = NCARD + 1 08070000 C 08080000 1130 CALL FORC (KPNA, KPRNO, DA, CARD, * 1135 )08090000 IF (S1CPCH(CARD,8,' ',1,3) .EQ. 0) GO TO 1120 08100000 GO TO 1130 08110000 C 08120000 C IF MORE THAN ONE RANGE CARD SUPPLIED WITH 08130000 C DEPTH POINT MODE, ASSUME PRE-STACK DATA 08140000 C 08150000 1135 IF (NCARD .GT. 1) NTR = LCMXFD 08160000 C 08170000 1140 CONTINUE 08180000 C 08190000 C TO CALCULATE FFT FOR X AND Y, INCREASE NOSAMP AND NTR BY XX% TO 08200000 C AVOID THE PROBLEM OF WRAP AROUND WHEN PLOTTING IS DONE AFTER FANF.08210000 C ( CHANGES BY NTS. 01/05/84; FURTHER CHANGES BY ESN 05/23/84) 08220000 C 08230000 NNSAMP = INT(NOSAMP * ((100+PERCTI)/100.0)) 08240000 CALL S1FMAG (NNSAMP, MAGX, LFOURX) 08250000 IF ( LFOURX .GT. 8192 ) LFOURX = 8192 08260000 LFOURX = LFOURX + 2 08270000 C 08280000 NNR = INT(NTR * ((100+PERCXI)/100.0)) 08290000 CALL S1FMAG (NNR , MAGY, LFOURY) 08300000 IF ( LFOURY .GT. 8192 ) LFOURY = 8192 08310000 C 08320000 I = 0 08330000 CLBL 08340000 IF (SYSTEM .EQ. IBM ) LBUF = 8190 08350000 IF (SYSTEM .EQ. CRAY ) LBUF = 16380 08360000 CLBL 08370000 C 08380000 1143 NSAVE = INT(SQRT((1.0*LBUF*LFOURY)/LFOURX)) 08390000 IF (NSAVE. LT. 1) NSAVE = 1 08400000 IF (NSAVEP .GT. 0) NSAVE = NSAVEP 08410000 C 08420000 NI = LBUF / NSAVE 08430000 IF (NIPREP .GT. 0) NI = NIPREP 08440000 NI = (NI/2) * 2 08450000 NSAVE = LBUF / NI 08460000 IF (NSAVE. LT. 1) NSAVE = 1 08470000 IF (NSAVEP .GT. 0) NSAVE = NSAVEP 08480000 C 08490000 NBUF = (LFOURY + NSAVE - 1) / NSAVE 08500000 N2FFT = NI / 2 08510000 LBUF = 2 * N2FFT * NSAVE 08520000 NBUFA = (LFOURY + LBUF - 1) / LBUF 08530000 C 08540000 I = I + 1 08550000 IF (I .GE. 2) GO TO 1146 08560000 LBUF = (LFOURY + NBUFA - 1) / NBUFA 08570000 CLBL 08580000 IF(SYSTEM .EQ. IBM ) LBUF = ( 8190 / LBUF) * LBUF 08590000 IF(SYSTEM .EQ. CRAY ) LBUF = (16380 / LBUF) * LBUF 08600000 CLBL 08610000 GO TO 1143 08620000 C 08630000 1146 IF (LFOURX .GE. LFOURY) CSIZE = CSIZE + 4 * (LFOURX + 2 + NTR) 08640000 IF (LFOURX .LT. LFOURY) CSIZE = CSIZE + 4 * (LFOURY + 2 + NTR) 08650000 CESN COM = NBUF * LBUF + 2 * NBUF * NSAVE + 2 * LFOURY + NBUFA * LBUF 08660000 COM = NBUF * LBUF + 2 * NBUF * NSAVE + 4 * LFOURY 08670000 IF (COM .LT. (NSAVE * LFOURX + LBUF)) 08680000 * COM = NSAVE * LFOURX + LBUF 08690000 CLBL 08700000 IF (SYSTEM .EQ. CRAY) COM = COM + MAX0 (LFOURX, LFOURY) 08710000 CLBL 08720000 COM = 4 * COM 08730000 IF (COM .LE. URBYTE) COM = 0 08740000 IF (COM .EQ. 0) GO TO 1150 08750000 SVCOM = COM 08760000 COM = COM - URBYTE 08770000 URBYTE = SVCOM 08780000 URKBYT = URBYTE / 1024 08790000 C 08800000 C CONVERT TO K-BYTES 08810000 C 08820000 1150 CSIZE = (CSIZE + COM + 1023) / 1024 08830000 GO TO 9900 08840000 C 08850000 C 08860000 C 08870000 C 08880000 C 12 AND 32. PROCESS = VELA AND VELB 08890000 C ======================= 08900000 C VELB DELETED 4/13/87 08910000 C =========================================== 08920000 C COMPUTE THE REGION AND COMMON SIZE FOR VELA 08930000 C =========================================== 08940000 C 08950000 1200 DA = 1 08960000 NOC = 0 08970000 MXWIN = 0 08980000 MININC = 999 08990000 VASCN = SIS 09000000 MXVELS = 0 09010000 MXUV = 0 09020000 MNLV = 99999 09030000 C 09040000 C 09050000 1230 CALL FORC (KPNA,KPRNO,DA,CARD, * 1234) 09060000 IF (S1CPCH(CARD,8,'SCN',1,3) .NE. 0) GO TO 1230 09070000 NOC = NOC + 1 09080000 IF (S1CPCH(CARD,23,'BMS',1,3) .EQ. 0) VASCN = BMS 09090000 WLEN = S1CVBN (CARD,31,5) 09100000 IF (WLEN .GT. MXWIN) MXWIN = WLEN 09110000 WINC = S1CVBN (CARD,36,5) 09120000 IF (WINC .LT. MININC) MININC = WINC 09130000 TSLV = S1CVBN (CARD,46,5) 09140000 TSUV = S1CVBN (CARD,51,5) 09150000 IF (S1CVBN(CARD,66,5) .GT. TSUV)TSUV = S1CVBN(CARD,66,5) 09160000 VINC = S1CVBN(CARD,26,5) 09170000 MVELS = (TSUV - TSLV) / VINC + 1 09180000 IF ( MVELS .GT. MXVELS ) MXVELS = MVELS 09190000 C 09200000 GO TO 1230 09210000 C 09220000 1234 DA = 1 09230000 1235 CALL FORC (KPNA,KPRNO,DA,CARD, * 1240) 09240000 IF (S1CPCH(CARD,8,'TVM',1,3) .NE. 0) GO TO 1235 09250000 C 09260000 DO 1236 09270000 * I = 26, 71, 15 09280000 LV = S1CVBN (CARD,I,5) 09290000 IF (LV .EQ. 0) GO TO 1236 09300000 IF (LV .LT. MNLV) MNLV = LV 09310000 1236 CONTINUE 09320000 C 09330000 DO 1237 09340000 * I = 31, 76, 15 09350000 UV = S1CVBN (CARD,I,5) 09360000 IF (UV .EQ. 0) GO TO 1237 09370000 IF (UV .GT. MXUV) MXUV = UV 09380000 1237 CONTINUE 09390000 C 09400000 IF (MININC .EQ. 0) GO TO 9800 09410000 MVELS = (MXUV - MNLV) / MININC + 1 09420000 IF ( MVELS .GT. MXVELS ) MXVELS = MVELS 09430000 C 09440000 GO TO 1235 09450000 C 09460000 1240 IF (NOC .EQ. 0) GO TO 8020 09470000 CSIZE = BLKSIZ * 6 09480000 PSIZE = 30 09490000 C 09500000 C COMPUTE THE COMMON 09510000 C 09520000 IF (MXVELS .EQ. 0 .OR. MXVELS .EQ. 1 .OR. MININC .EQ. 999) 09530000 * GO TO 9800 09540000 C 09550000 MININC = MININC / LCPI 09560000 MXWIN = MXWIN / LCPI 09570000 NSPASS = 76000 / MXVELS 09580000 NSPASS = NSPASS/MININC*MININC + 1 09590000 IF (NSPASS .GT. NOSAMP) NSPASS = NOSAMP / MININC * MININC + 1 09600000 C 09610000 NWPASS = NSPASS / MININC + 1 09620000 MUTZ = MXVELS * NWPASS * 3 09630000 C 09640000 IF(VASCN .EQ. SIS) COM = (120000+MUTZ+MXVELS*MXWIN+MXVELS)*4 09650000 C 09660000 IF(VASCN .EQ. BMS) COM = (NWPASS * MXWIN * MXVELS)*4 09670000 C 09680000 IF(SYSTEM.EQ.CRAY) COM = COM + BLKSIZ * 5 + 400 09690000 C 09700000 IF (COM .LE. URBYTE) COM = 0 09710000 IF (COM .EQ. 0) GO TO 1250 09720000 SVCOM = COM 09730000 COM = COM - URBYTE 09740000 URBYTE = SVCOM 09750000 URKBYT = URBYTE / 1024 09760000 C 09770000 1250 CSIZE = (CSIZE + COM + 1023) / 1024 09780000 C 09790000 GO TO 9900 09800000 C 09810000 C ============== 09820000 C 13. PROCESS = VELD 09830000 C ============== 09840000 C 09850000 C =========================================== 09860000 C COMPUTE THE REGION AND COMMON SIZE FOR VELD 09870000 C =========================================== 09880000 C 09890000 C 09900000 1300 CALL JSPAC1 (KPNA, KPRNO, OCCUR, 'VELA', SKPRNO) 09910000 C 09920000 IF ( SKPRNO .GE. 0 ) GO TO 1310 09930000 IF ( SKPRNO .EQ.-1 ) GO TO 1320 09940000 IF ( SKPRNO .EQ.-2 ) GO TO 8010 09950000 C 09960000 C VELA PRESENT 09970000 C 09980000 1310 PSIZE = 78 09990000 MXTIME = NOSAMP / MININC 10000000 CSIZE = ( BLKSIZ * 6 + 4096 * 4 + MXTIME*MXVELS*4 ) / 1024 + 32 10010000 GO TO 9900 10020000 C 10030000 C NO VELA PRESENT 10040000 C 10050000 1320 PSIZE = 78 10060000 CSIZE = ( BLKSIZ * 6 + 60000 ) / 1024 + 32 10070000 GO TO 9900 10080000 C 10090000 C 10100000 C 14. PROCESS = GATH AND GA3D 10110000 C ======================= 10120000 C 10130000 C ==================================================== 10140000 C COMPUTE THE REGION AND COMMON SIZE FOR GATH AND GA3D 10150000 C ==================================================== 10160000 C 10170000 1400 PSIZE = 17 10180000 C 10190000 C GET GATH/GA3D CARD PARAMETERS 10200000 C 10210000 DA = 1 10220000 CALL FORC (KPNA, KPRNO, DA, CARD, * 8020 )10230000 C 10240000 DPS = S1CVBN (CARD, 11, 5) 10250000 DPE = S1CVBN (CARD, 16, 5) 10260000 IF (DPE .EQ. 0) DPE = DPS 10270000 NDPS = DPE - DPS + 1 10280000 C CHECK FOR 3D 10290000 LNST = S1CVBN (CARD, 66, 5) 10300000 LNEN = S1CVBN (CARD, 71, 5) 10310000 IF (LNEN .EQ. 0) LNEN = LNST 10320000 NOLNS = LNEN - LNST + 1 10330000 NDPS = NDPS * NOLNS 10340000 C 10350000 MAXDA = 0 10360000 WRAPAR = S1CVBN (CARD, 76, 5) 10370000 C 10380000 NCOMP = S1CVBN (CARD, 46, 5) 10390000 IF (NCOMP .EQ. 0) NCOMP = 1 10400000 C 10410000 MAXTRC = LCMXFD 10420000 IF (S1CPCH (CARD, 23, 'CR',1,2) .EQ. 0) MAXTRC = LCMXFD * 2 10430000 IF (S1CPCH (CARD, 23, 'CS',1,2) .EQ. 0) MAXTRC = LCTPSP 10440000 IF (S1CPCH (CARD, 23, 'CC',1,2) .EQ. 0) MAXTRC = LCNSP 10450000 MAXTRC = MAXTRC * NCOMP 10460000 IF (NCOMP .GT. 1) GO TO 1430 10470000 C 10480000 MAXDA = (MAXTRC + 8) * LCTPSP 10490000 C 10500000 IF (WRAPAR .EQ. 99999 .OR. 10510000 * S1CPCH (CARD, 23, 'COS', 1, 3) .EQ. 0 .OR. 10520000 * S1CPCH (CARD, 23, 'CST', 1, 3) .EQ. 0 .OR. 10530000 * S1CPCH (KPNA, 1, 'GA3D',1, 4) .EQ. 0) THEN 10540000 MAXDA = MAX(LCNSP,LCANSP) * LCTPSP 10550000 GO TO 1430 10560000 ENDIF 10570000 C 10580001 IF (S1CPCH(CARD,23,'COS',1,3) .NE. 0) THEN 10590001 IF (LNST .GT. 0) THEN 10600001 MAXDA = WRAPAR * LCTPSP 10610001 GO TO 1430 10620001 ENDIF 10630001 ENDIF 10640001 C 10650000 IF (WRAPAR .NE. 0) THEN 10660000 MAXDA = WRAPAR 10670000 GO TO 1430 10680000 ENDIF 10690000 C 10700000 C IF THE NUMBER OF DISK ADDRESSES REQUIRED IS GREATER THAN 10710000 C 999999 AND YOU ARE GOING TO THE CRAY, REREAD THE TRACES 10720000 C TO SORT THE TRACES RATHER THAN DOING AN IN CORE SORT. 10730000 C NOTE THAT IF THIS LIMIT IS CHANGED, A CHANGE IS ALSO REQUIRED 10740000 C IN SDGATH AND SDGA3D. 10750000 C 10760000 1430 CONTINUE 10770000 IF (SYSTEM .EQ. CRAY .AND. MAXDA .GT. 999999) MAXDA = 0 10780000 C 10790000 C SEARCH CURRENT PROCESSING FOR GATH. 10800000 C IF MOST RECENT GATHER WAS COMMON OFFSET, 10810000 C THEN ALLOCATE ENOUGH WORKSPACE FOR ALL TRACES. 10820000 C 10830000 DAC = 1 10840000 CALL JSPAC1('GATH',KPRNO,OCCUR,'GATH',SKPNA) 10850000 IF ( SKPNA .GE. 0 ) THEN 10860000 CALL FORC('GATH',SKPNA,DAC,CARD2, *1450) 10870000 IF (S1CPCH(CARD2,23,'COS',1,3) .EQ. 0) THEN 10880000 MAXDA = MAX(LCNSP,LCANSP) * LCTPSP * NCOMP 10890000 ENDIF 10900000 END IF 10910000 C 10920000 1450 CONTINUE 10930000 IF (S1CPCH(CARD,23,'COS',1,3) .EQ. 0) THEN 10940000 NWORDS = 80+ 20*LCTPSP*NOLNS + 3*(NDPS+LCTPSP)*NCOMP + 2*MAXDA10950000 ELSE 10960000 IF (S1CPCH(CARD,23,'CST',1,3) .EQ. 0) NDPS = LCNSP 10970000 NWORDS = 80 + 2*NDPS + 3*MAXTRC + 2*MAXDA 10980000 ENDIF 10990000 C 11000000 CSIZE = (NWORDS * 4 + 1023) / 1024 11010000 C 11020000 GO TO 9900 11030000 C 11040000 C 11050000 C 11060000 C 15. PROCESS = DDEC 11070000 C ============== 11080000 C 11090000 C =========================================== 11100000 C COMPUTE THE REGION AND COMMON SIZE FOR DDEC 11110000 C =========================================== 11120000 C 11130000 1500 CSIZE = 0 11140000 IF(IFLAG.NE.0) GO TO 1570 11150000 IFLAG = 1 11160000 C 11170000 MIL = 0 11180000 MAXW = 0 11190000 KN = 0 11200000 DA = 1 11210000 C 11220000 1510 CALL FORC (KPNA, KN, DA, CARD, * 1520 )11230000 IF(S1CPCH(CARD,8,' ',1,3).EQ.0) GO TO 1530 11240000 IF(S1CPCH(CARD,8,'INT ',1,3).EQ.0) GO TO 1540 11250000 GO TO 1510 11260000 C 11270000 1520 KN = KN + 1 11280000 DA = 1 11290000 IF(KN .LE. 9) GO TO 1510 11300000 GO TO 1560 11310000 C 11320000 C WE HAVE BLANKS IN COLS 8-9-10. 11330000 C FIND MAX WAVELET LENGTH. 11340000 C 11350000 C 11360000 1530 KWMAX = S1CVBN (CARD,46,5) 11370000 IF(IABS(KWMAX) .GT. MAXW) MAXW = IABS(KWMAX) 11380000 GO TO 1510 11390000 C 11400000 C WE HAVE A WINDOW CARD. 11410000 C FIND MAX WINDOW LENGTH. 11420000 C 11430000 C 11440000 1540 DO 1550 I = 21, 80, 15 11450000 IL = S1CVBN (CARD,I,5) 11460000 IH = S1CVBN (CARD,I+5,5) 11470000 LEN = IH-IL 11480000 IF(LEN .GT. MIL) MIL = LEN 11490000 1550 CONTINUE 11500000 C 11510000 GO TO 1510 11520000 C 11530000 1560 MAXW = MAXW/LCPI + 1 11540000 MIL = MIL /LCPI + 1 11550000 NN = MAXW/2 + MIL/2 + MAXW 11560000 NPR = (NN*(NN+1)) / 2 11570000 C 11580000 CSIZE = (40 + MAXW + NPR + MIL + (10*NN)) * 4 11590000 C 11600000 1570 CSIZE = (CSIZE + (BLKSIZ*2) + 10000 + 1023) / 1024 11610000 PSIZE = 122 11620000 GO TO 9900 11630000 C 11640000 C 11650000 C 16. PROCESS = SLOG 11660000 C ============== 11670000 C 11680000 C ======================================= 11690000 C COMPUTE REGION AND COMMON SIZE FOR SLOG 11700000 C ======================================= 11710000 C 11720000 1600 PSIZE = 50 11730000 CSIZE = ((BLKSIZ*6) + 1023) / 1024 11740000 GO TO 9900 11750000 C 11760000 C 11770000 C 17. PROCESS = GMAP 11780000 C ============== 11790000 C 11800000 C ======================================= 11810000 C COMPUTE REGION AND COMMON SIZE FOR GMAP 11820000 C ======================================= 11830000 C 11840000 1700 PSIZE = 20 11850000 CSIZE = 0 11860000 MXSPS = LCNSP 11870000 MXGPS = (LCTPSP + LCMXFD) / LCMXFD 11880000 IF (MXGPS .EQ. 0) MXGPS = 1 11890000 MXGPS = MXGPS * LCNSP + 2 * LCTPSP 11900000 MXDPS = MXGPS 11910000 IF (LCMXLN .EQ. 1) GO TO 1710 11920000 MXDPS = LCMXLN * LCMXLN 11930000 MXGPS = 5000 11940000 1710 COM =(12*MXSPS +12*MXGPS +BLKSIZ + 4*MXDPS)/1024 11950000 IF (COM .LE. URKBYT) COM = 0 11960000 IF (COM .EQ. 0) GO TO 9900 11970000 SVCOM = COM 11980000 CSIZE = COM - URKBYT 11990000 URKBYT = SVCOM 12000000 URBYTE = URKBYT * 1024 12010000 C 12020000 GO TO 9900 12030000 C 12040000 C ================================ 12050000 C 18./29./44. PROCESS = MIGR AND MIGE AND MG45 12060000 C ================================ 12070000 C MIGE DELETED 4/13/87 12080000 C =========================================== 12090000 C COMPUTE THE REGION AND COMMON SIZE FOR MIGR 12100000 C =========================================== 12110000 C 12120000 C 12130000 1800 PSIZE = 28 12140000 CSIZE = BLKSIZ 12150000 DA = 1 12160000 MAX1 = -999999 12170000 MIN1 = 999999 12180000 IXMEM = 0 12190000 C 12200000 1810 CALL FORC (KPNA, KPRNO, DA, CARD, * 8020 )12210000 IF (S1CPCH(CARD,8,' ',1,3) .NE. 0) GO TO 1810 12220000 C 12230000 C DETERMINE NUMBER OF TRACES TO BE PROCESSED 12240000 C AT A TIME 12250000 C 12260000 SPT = S1CVBN (CARD, 11, 5) 12270000 EPT = S1CVBN (CARD, 16, 5) 12280000 IF (EPT .EQ. 0) EPT = SPT 12290000 IF (SPT .LT. MIN1) MIN1 = SPT 12300000 IF (SPT .GT. MAX1) MAX1 = SPT 12310000 IF (EPT .LT. MIN1) MIN1 = EPT 12320000 IF (EPT .GT. MAX1) MAX1 = EPT 12330000 NZT = S1CVBN (CARD, 36, 5) 12340000 IF (S1CPCH(KPNA,1,'MG45',1,4) .EQ. 0) GO TO 1815 12350000 IF (S1CPCH(CARD,36,' ',1,5) .EQ. 0) NZT = 12 12360000 GO TO 1818 12370000 1815 IF (S1CPCH(CARD,36,' ',1,5) .EQ. 0) NZT = 100 12380000 1818 NSAVE = S1CVBN (CARD, 71, 5) 12390000 NI = S1CVBN (CARD, 76, 5) 12400000 DELTAZ = S1CVBN (CARD, 31, 5) 12410000 IF (S1CPCH(CARD,31,' ',1,5) .EQ. 0) DELTAZ = 40 12420000 DELTAZ = DELTAZ / LCPI 12430000 C 12440000 1820 CALL FORC (KPNA, KPRNO, DA, CARD, * 1830 )12450000 IF (S1CPCH(CARD,8,' ',1,3) .NE. 0) GO TO 1820 12460000 SPT = S1CVBN (CARD, 11, 5) 12470000 IF (SPT .LT. MIN1) MIN1 = SPT 12480000 IF (SPT .GT. MAX1) MAX1 = SPT 12490000 EPT = S1CVBN (CARD, 16, 5) 12500000 IF (EPT .EQ. 0) GO TO 1820 12510000 IF (EPT .LT. MIN1) MIN1 = EPT 12520000 IF (EPT .GT. MAX1) MAX1 = EPT 12530000 GO TO 1820 12540000 C 12550000 1830 NTR = MAX1 - MIN1 + 1 12560000 NB = NTR + 2 * NZT 12570000 IF (NSAVE .NE. 0) GO TO 1840 12580000 NSAVE = 32 12590000 IF (NTR .LE. 16) NSAVE = 16 12600000 1840 IF (NI .EQ. 0) NI = 1500 / NSAVE 12610000 IF (S1CPCH(KPNA,1,'MG45',1,4) .NE. 0) GO TO 1848 12620000 NI = DELTAZ 12630000 ND = (NOSAMP - 1) / DELTAZ+1 12640000 IWP3 = ND + 3 12650000 NIP3 = NI + 3 12660000 IXMEM = 4 * NB * IWP3 12670000 * + 2 * NB * NIP3 12680000 * + 9 * NB 12690000 1848 NBUF = (NB + NSAVE - 1) / NSAVE 12700000 LBUF = NI * NSAVE 12710000 NBUFA = (NB + LBUF - 1) / LBUF 12720000 CSIZE = CSIZE + 4 * NBUF * LBUF 12730000 TEMP = 4 * (NSAVE*NOSAMP + 7*NB + 2*NBUFA*LBUF + 420 + IXMEM) 12740000 IF (SYSTEM.EQ.CRAY) 12750000 *TEMP = 4 * (NSAVE*NOSAMP +13*NB + 2*NBUFA*LBUF + 420 + IXMEM) 12760000 IF (TEMP .LE. MIGRSV) GO TO 1850 12770000 CSIZE = CSIZE + TEMP - MIGRSV 12780000 MIGRSV = TEMP 12790000 C 12800000 C CONVERT TO K-BYTES 12810000 C 12820000 1850 CSIZE = (CSIZE + 1023) / 1024 12830000 GO TO 9900 12840000 C 12850000 C 12860000 C 20. PROCESS = EDIT 12870000 C ===================== 12880000 C 12890000 C ============================================ 12900000 C COMPUTE THE REGION AND COMMON SIZE FOR EDIT 12910000 C ============================================ 12920000 C 12930000 1900 CONTINUE 12940000 C 12950000 C CORE CALCULATION FOR EDIT 12960000 C 12970000 PSIZE = 15 12980000 NWDAT = 0 12990000 NWRAN = 0 13000000 C 13010000 C GET PROCESSING MODE OF LINE CARD. 13020000 C 13030000 LNMODE = BLANK 13040000 CALL S1MVCH(PMODE, 2, LNMODE, 1, 1) 13050000 C 13060000 C SET UP TRACES PER SHOT, MAX GROUPS PER SHOT 13070000 C 13080000 TPS = LCTPSP 13090000 MXGPS = LCTPSP 13100000 C 13110000 C 'FUDGE FACTOR' OF 50% ON MXGPS 13120000 C 13130000 MXGPS = 1.5 * MXGPS 13140000 C 13150000 C 'FUDGE FACTOR' OF LCMXLN ON MXGPS 13160000 C 13170000 MXGPS = LCMXLN * MXGPS 13180000 C 13190000 C FLAG FOR 1ST BLANK EDIT CARD. 13200000 C 13210000 IFIRST = 0 13220000 C 13230000 DA = 1 13240000 1910 CONTINUE 13250000 C 13260000 C LOOP THROUGH ALL EDIT CARDS 13270000 C 13280000 CALL FORC (KPNA, KPRNO, DA, CARD, * 1990 )13290000 C 13300000 C CHECK CARD TYPE 13310000 C 13320000 IF (S1CPCH(CARD, 8, ' ', 1, 3) .NE. 0) GO TO 1930 13330000 IF (IFIRST .EQ. 1) GO TO 1910 13340000 IFIRST = 1 13350000 C 13360000 C FIRST BLANK EDIT CARD. CHECK PROCESSING MODE. 13370000 C 13380000 EDMODE = BLANK 13390000 CALL S1MVCH(CARD, 7, EDMODE, 1, 1) 13400000 IF (EDMODE .EQ. BLANK) EDMODE = LNMODE 13410000 IF (S1CPCH(EDMODE, 1, 'D', 1, 1) .NE. 0) GO TO 1920 13420000 C 13430000 C PROCESSING MODE IS 'D'. RESET TPS, MXGPS. 13440000 C 13450000 TPS = LCMXFD 13460000 MXGPS = LCMXFD 13470000 1920 CONTINUE 13480000 C 13490000 C CALCULATE LENGTH OF BUFFERS USED BY EDIT. THESE ARE 13500000 C POINTED TO BY THE ARRAY 'CAT' IN SDEDIT. 13510000 C 13520000 NWCAT = 99 + TPS + 2*MXGPS 13530000 C 13540000 C READ NEXT CARD. 13550000 C 13560000 GO TO 1910 13570000 1930 CONTINUE 13580000 C 13590000 C NON-BLANK CARD. CALCULATE CORE REQUIRED FOR EDIT 13600000 C DISK ADDRESS TABLES ( 2 WORDS PER NON-BLANK CARD). 13610000 C 13620000 NWDAT = NWDAT + 2 13630000 C 13640000 C CALCULATE AMOUNT REQUIRED FOR PROCESSING RANGE TABLES. 13650000 C 13660000 C (THIS IS APPROXIMATED BY COUNTING 2 WORDS PER CARD). 13670000 C 13680000 NWRAN = NWRAN + 2 13690000 C 13700000 C READ NEXT CARD. 13710000 C 13720000 GO TO 1910 13730000 1990 CONTINUE 13740000 C 13750000 C THROUGH WITH ALL EDIT CARDS. SUM UP CORE SIZE. 13760000 C 13770000 NWORDS = NWCAT + NWDAT + NWRAN 13780000 C 13790000 C ROUND IT UP TO THE NEAREST K-BYTE. 13800000 C 13810000 NBYTES = NWORDS * 4 13820000 CSIZE = (NBYTES + 1023) / 1024 13830000 GO TO 9900 13840000 C 13850000 C 13860000 C 56. PROCESS = STAP 13870000 C ===================== 13880000 C 13890000 C ============================================ 13900000 C COMPUTE THE REGION AND COMMON SIZE FOR STAP 13910000 C ============================================ 13920000 C 13930000 2000 PSIZE = 30 13940000 CSIZE = 1 13950000 ARESE = 0 13960000 AXSRE = 0 13970000 APICK = 0 13980000 NOC = 0 13990000 NDPS = 0 14000000 NLNS = 0 14010000 NOLN = 10000 14020000 GLIA = 0 14030000 C 14040000 DA = 1 14050000 2010 CALL FORC (KPNA, KPRNO, DA, CARD, * 2020 )14060000 IF (S1CPCH(CARD, 8,' ',1,3) .NE. 0) GO TO 2010 14070000 IF (S1CPCH(CARD,27,'ARES',1,4) .EQ. 0) ARESE = 1 14080000 IF (S1CPCH(CARD,27,'AXSR',1,4) .EQ. 0) ARESE = 1 14090000 IF (S1CPCH(CARD,27,'AXSR',1,4) .EQ. 0) AXSRE = 1 14100000 IF (S1CPCH(CARD,27,'GLIA',1,4) .EQ. 0) GLIA = 1 14110000 IF (S1CPCH(CARD,26,' PICK',1,5) .EQ. 0) GO TO 2013 14120000 GO TO 2017 14130000 2013 APICK = APICK + 1 14140000 IF (APICK .EQ. 1) CALL S1MVCH (CARD, 53, DDNAME, 1, 8) 14150000 2017 NOC = NOC + 1 14160000 EDP = S1CVBN (CARD, 16, 5) 14170000 IF (EDP .GT. NDPS) NDPS = EDP 14180000 LINMIN = S1CVBN (CARD, 66, 5) 14190000 LINMAX = S1CVBN (CARD, 71, 5) 14200000 IF (LINMAX-LINMIN+1 .GT. NLNS) NLNS = LINMAX-LINMIN+1 14210000 GO TO 2010 14220000 2020 IF (NOC .EQ. 0) GO TO 8020 14230000 C 14240000 MXGPS = (LCTPSP + LCMXFD) / LCMXFD 14250000 IF (MXGPS .EQ. 0) MXGPS = 1 14260000 MXGPS = MXGPS * LCNSP + 2 * LCTPSP 14270000 IF (S1CPCH(CARD, 7, 'S', 1, 1) .EQ. 0) NDPS = MXGPS 14280000 CSIZE = CSIZE + (8*NDPS + 1023)/1024 14290000 C FOR 'ARES' & 'AXSR' OPTIONS 14300000 IF (ARESE .EQ. 0) GO TO 2030 14310000 CSIZE = CSIZE + 8 14320000 IF (AXSRE .EQ. 0) GO TO 2030 14330000 CSIZE = CSIZE + (NDPS*NLNS*4+1023) / 1024 14340000 2030 CONTINUE 14350000 C FOR 'PICK' OPTION 14360000 IF (APICK .EQ. 0) GO TO 2040 14370000 CSIZE = CSIZE + (((LCNSP+1)/2+LCTPSP*LCNSP)*4+1023) / 1024 14380000 2040 CONTINUE 14390000 IF (GLIA .EQ. 1) THEN 14400000 CSIZE = (((3*NOLN+2*LCNSP+2*LCTPSP+3)*4)+1023) / 1024 14410000 ENDIF 14420000 C 14430000 GO TO 9900 14440000 C 14450000 C 21. PROCESS = RARS 14460000 C ============== 14470000 C 14480000 C =========================================== 14490000 C COMPUTE THE REGION AND COMMON SIZE FOR RARS 14500000 C =========================================== 14510000 C 14520000 2100 PSIZE = 15 14530000 CSIZE = ( BLKSIZ + 1023 ) / 1024 14540000 GO TO 9900 14550000 C 14560000 C 14570000 C 22. PROCESS = DPDE 14580000 C ===================== 14590000 C 14600000 C ============================================ 14610000 C COMPUTE THE REGION AND COMMON SIZE FOR DPDE 14620000 C ============================================ 14630000 C 14640000 2200 PSIZE = 15 14650000 CSIZE = 1 14660000 NOC = 0 14670000 NDPS = 0 14680000 NLNS = 0 14690000 C 14700000 DA = 1 14710000 2210 CALL FORC (KPNA, KPRNO, DA, CARD, * 8020 )14720000 IF (S1CPCH(CARD, 8,' ',1,3) .NE. 0) GO TO 2210 14730000 R1 = S1CVBN(CARD,11,5) 14740000 R2 = S1CVBN(CARD,16,5) 14750000 NLNSM = S1CVBN(CARD,26,5) 14760000 NDPS = R2 - R1 + 1 14770000 IF (NDPS .LT. 0) NDPS = 1 14780000 L1 = S1CVBN(CARD,66,5) 14790000 L2 = S1CVBN(CARD,71,5) 14800000 NLNS = L2 - L1 + 1 14810000 IF (NLNS .LT. 0) NLNS = 1 14820000 CSIZE = CSIZE + ((5*NDPS*NLNS + 2*(THL+NOSAMP) + 14830000 * NLNSM) * 4 + 1023) / 1024 14840000 C 14850000 GO TO 9900 14860000 C 14870000 C 14880000 C 8 AND 23. PROCESS = CSTK AND DSTK 14890000 C ============== 14900000 C DSTK DELETED 4/13/87 14910000 C =========================================== 14920000 C COMPUTE THE REGION AND COMMON SIZE FOR CSTK 14930000 C =========================================== 14940000 C 14950000 2300 PSIZE = 25 14960000 DA = 1 14970000 MXSHFT = 0 14980000 MXWLEN = 0 14990000 MXNOWS = 0 15000000 NOC = 0 15010000 C 15020000 C READ PARAMETERS OFF CARDS 15030000 C 15040000 2310 CALL FORC( KPNA,KPRNO,DA,CARD, * 2350 ) 15050000 IF (S1CPCH(CARD,8,' ',1,3) .NE. 0) GO TO 2320 15060000 NOC = NOC + 1 15070000 TSTSFT = S1CVBN( CARD,31,5) 15080000 IF (MXSHFT .LT. TSTSFT) MXSHFT = TSTSFT 15090000 GO TO 2310 15100000 2320 IF ( NOC .EQ. 0) GO TO 8020 15110000 IF (S1CPCH(CARD,8,'WIN',1,3) .NE. 0) GO TO 8020 15120000 TSTNOW = 0 15130000 DO 2330 15140000 * I = 21,80,10 15150000 TSTLEN = S1CVBN( CARD,I+5,5) - S1CVBN( CARD,I,5) 15160000 IF (TSTLEN .EQ. 0) GO TO 2340 15170000 IF (MXWLEN .LT. TSTLEN) MXWLEN = TSTLEN 15180000 TSTNOW = TSTNOW + 1 15190000 2330 CONTINUE 15200000 2340 IF (MXNOWS .LT. TSTNOW) MXNOWS = TSTNOW 15210000 GO TO 2310 15220000 C 15230000 C COMPUTE RESERVED COMMON 15240000 C 15250000 2350 IF (MXWLEN .EQ. 0 ) GO TO 8020 15260000 PILOTL = (MXWLEN + MXSHFT*2)/LCPI + 1 15270000 CSIZE=2*MXNOWS*PILOTL+5*BLKSIZ+LCMXFD*(4+2*MXNOWS+BLKSIZ+LCMXFD) 15280000 CSIZE = ( CSIZE + 1023) / 1024 15290000 GO TO 9900 15300000 C 15310000 C ==================== 15320000 C 24. PROCESS = FLTR / ALTO 15330000 C ==================== 15340000 C 15350000 C ================================================== 15360000 C COMPUTE THE REGION AND COMMON SIZE FOR FLTR / ALTO 15370000 C ================================================== 15380000 C 15390000 C 15400000 2400 PSIZE = 50 15410000 CALL S1FMAG (NOSAMP, MAG, LFOUR) 15420000 C 15430000 C AN APPROXIMATION IS MADE TO THE SPACE NEEDED FOR 15440000 C THE OPERATORS BY ASSUMING THE LENGTH WILL NEVER 15450000 C BE GREATER THAN 2 * FFT LENGTH OF ENTIRE TRACE 15460000 C (3 OF THESE AREAS ARE REQUIRED) 15470000 C 15480000 COM = 4 * (4 * LFOUR) 15490000 IF (COM .LE. URBYTE) COM = 0 15500000 IF (COM .EQ. 0) GO TO 2410 15510000 SVCOM = COM 15520000 COM = COM - URBYTE 15530000 URBYTE = SVCOM 15540000 URKBYT = URBYTE / 1024 15550000 C 15560000 2410 CSIZE = (BLKSIZ + 4*(4 * LFOUR + 400) + COM + 1023) / 1024 15570000 GO TO 9900 15580000 C 15590000 C ============== 15600000 C 25. PROCESS = SELT 15610000 C ============== 15620000 C 15630000 C =========================================== 15640000 C COMPUTE THE REGION AND COMMON SIZE FOR SELT 15650000 C =========================================== 15660000 C 15670000 C 15680000 C 15690000 2500 CONTINUE 15700000 PSIZE = 14 15710000 CSIZE = BLKSIZ 15720000 DA = 1 15730000 COUNT = 0 15740000 NAM = 0 15750000 C 15760000 2510 CALL FORC (KPNA, KPRNO, DA, CARD, * 2520 )15770000 C--CK FOR NAM CARDS 15780000 IF(S1CPCH(CARD,8,'NAM',1,3) .EQ. 0) THEN 15790000 DO 2515 I=21, 80, 10 15800000 IF(S1CPCH(CARD,I,' ',1,10) .NE. 0) NAM = NAM + 1 15810000 2515 CONTINUE 15820000 ENDIF 15830000 C 15840000 IF (S1CPCH(CARD,8,' ',1,3) .NE. 0) GO TO 2510 15850000 IF (S1CPCH(CARD,51,' ',1,5) .EQ. 0) GO TO 2510 15860000 IF (COUNT .EQ. 0) COUNT = 4 15870000 IF (S1CPCH(CARD,53,'PRT',1,3) .EQ. 0) COUNT = 12 15880000 GO TO 2510 15890000 C 15900000 2520 COM = 4 * COUNT * NOSAMP 15910000 COM = COM + 4 * NAM * 3 15920000 IF (COM .LE. URBYTE) COM = 0 15930000 IF (COM .EQ. 0) GO TO 2530 15940000 SVCOM = COM 15950000 COM = COM - URBYTE 15960000 URBYTE = SVCOM 15970000 URKBYT = URBYTE / 1024 15980000 C 15990000 2530 CSIZE = (CSIZE + COM + 1023) / 1024 16000000 GO TO 9900 16010000 C 16020000 C 26. PROCESS = CRDA 16030000 C ============== 16040000 C 16050000 C =========================================== 16060000 C COMPUTE THE REGION AND COMMON SIZE FOR CRDA 16070000 C =========================================== 16080000 C 1 TRACE ARRAY + ENOUGH SPACE FOR DEFAULT TRACE HEADER ELEMENTS 16090000 C IN DIRECTORY (44) 16100000 2600 PSIZE = 19 16110000 CSIZE = ( BLKSIZ + 44 + 1023 ) / 1024 16120000 GO TO 9900 16130000 C 16140000 C 27 AND 33. PROCESS = TRAC AND DTRC 16150000 C ======================= 16160000 C 16170000 C 16180000 C =========================================== 16190000 C COMPUTE THE REGION AND COMMON SIZE FOR TRAC 16200000 C =========================================== 16210000 C 16220000 C CHECK TRAC FLAG, IF SET PSIZE HAS BEEN COMPUTED 16230000 C ON A PREVIOUS CALL 16240000 C 16250000 2700 IF (TRACF) GO TO 2710 16260000 PSIZE = 91 16270000 GO TO 2720 16280000 C 16290000 2710 PSIZE = 0 16300000 C 16310000 2720 CSIZE = 0 16320000 CS = 0 16330000 MAXCS = 0 16340000 C 16350000 2730 NOC = 0 16360000 C 16370000 C FIND MAX CSIZE FOR ALL TRAC PROCESS NUMBERS 16380000 C 16390000 DO 2780 16400000 * I = 1, 10 16410000 MINCDP = 999999 16420000 MAXCDP = -999999 16430000 MXNWIN = 0 16440000 MXOPER = 0 16450000 MAXSHF = 0 16460000 MXWLEN = 0 16470000 SCGR = 999999 16480000 ECGR = -999999 16490000 MXDPPP = -999999 16500000 NTRACC = 0 16510000 DA = 1 16520000 MAXMAX = -999999 16530000 MX2 = 1 16540000 C 16550000 C READ A TRAC CARD - GET MAX SHIFT, WINDOW ID, 16560000 C START AND END GATHER # 16570000 C 16580000 2740 IF (.NOT. TRACF) CALL FORC (KPNA, I-1, DA, CARD, * 2770 )16590000 IF (TRACF) CALL FORC (KPNA, KPRNO, DA, CARD, * 2770 )16600000 IF (S1CPCH (CARD, 8, ' ', 1, 3) .NE. 0) GO TO 2740 16610000 NTRACC = NTRACC + 1 16620000 SHFT = S1CVBN (CARD, 31, 5) 16630000 IF (SHFT .GT. MAXSHF) MAXSHF = SHFT 16640000 WINID = S1CVBN (CARD, 21, 5) 16650000 SGAT = S1CVBN (CARD, 11, 5) 16660000 EGAT = S1CVBN (CARD, 16, 5) 16670000 DPPP = S1CVBN (CARD, 26, 5) 16680000 IF (S1CPCH (CARD, 26, ' ', 1, 5) .EQ. 0) DPPP = 3 16690000 IF (DPPP .GT. MXDPPP) MXDPPP = DPPP 16700000 FLTRID = S1CVBN (CARD, 36, 5) 16710000 MAXRS = S1CVBN (CARD, 56, 5) 16720000 IF (MAXRS .GT. MAXMAX) MAXMAX = MAXRS 16730000 IF (NTRACC .EQ. 1) PLTCOD = S1CVBN (CARD, 80, 1) 16740000 IF (NTRACC .EQ. 1 .AND. S1CPCH(CARD, 80, ' ', 1, 1) .EQ. 0) 16750000 * PLTCOD = 1 16760000 IF (PLTCOD .NE. 1) MX2 = 2 16770000 IF (EGAT .EQ. 0) EGAT = SGAT 16780000 GAT1 = MIN(SGAT,EGAT) 16790000 GAT2 = MAX(SGAT,EGAT) 16800000 IF (GAT1 .LT. SCGR) SCGR = GAT1 16810000 IF (GAT2 .GT. ECGR) ECGR = GAT2 16820000 DA2 = 1 16830000 C 16840000 C READ WIN CARD TO GET MAX # OF WINDOWS, MAX WINDOW 16850000 C LENGTH 16860000 C 16870000 2750 IF (.NOT. TRACF) CALL FORC (KPNA, I-1, DA2, CARD, * 2770 )16880000 IF (TRACF) CALL FORC (KPNA, KPRNO, DA2, CARD, * 2770 )16890000 IF (S1CPCH(CARD, 8, 'WIN', 1, 3) .NE. 0) GO TO 2750 16900000 ID = S1CVBN (CARD, 11, 5) 16910000 IF (WINID .NE. ID) GO TO 2750 16920000 C 16930000 DO 2760 16940000 * J = 21, 60, 10 16950000 WINS = S1CVBN(CARD, J, 5) 16960000 WINE = S1CVBN(CARD, J+5, 5) 16970000 IF (WINS .EQ. 0 .AND. WINE .EQ. 0) GO TO 2762 16980000 WINLEN = WINE - WINS 16990000 WINLEN = IABS(WINLEN) 17000000 IF (MXWLEN .LT. WINLEN) MXWLEN = WINLEN 17010000 2760 CONTINUE 17020000 C 17030000 2762 NWIN = (J-21) / 10 17040000 IF (NWIN .GT. MXNWIN) MXNWIN = NWIN 17050000 IF (FLTRID .EQ. 0) GO TO 2740 17060000 C 17070000 C READ THE TZF CARD TO GET THE OPERATOR LENGTH 17080000 C 17090000 DA3 = 1 17100000 C 17110000 2765 IF (.NOT. TRACF) CALL FORC (KPNA, I-1, DA3, CARD, * 2770 )17120000 IF (TRACF) CALL FORC (KPNA, KPRNO, DA3, CARD, * 2770 )17130000 IF (S1CPCH(CARD, 8, 'TZF', 1, 3) .NE. 0) GO TO 2765 17140000 IF (S1CVBN(CARD, 11, 5) .NE. FLTRID) GO TO 2765 17150000 LP = S1CVBN (CARD, 21, 5) 17160000 HP = S1CVBN (CARD, 26, 5) 17170000 OPER = S1CVBN (CARD, 36, 5) 17180000 IF (OPER .NE. 0) GO TO 2768 17190000 OPER = INT(20000.0 / (HP - LP + 1.0) + 0.5) 17200000 IF (OPER .LT. 300) OPER = 300 17210000 IF (OPER .GT. RLENG) OPER = RLENG 17220000 C 17230000 2768 IF (OPER .GT. MXOPER) MXOPER = OPER 17240000 GO TO 2740 17250000 C 17260000 C WAS THERE A CARD FOUND FOR THIS PROCESS # 17270000 C 17280000 2770 IF (DA .EQ. 1) GO TO 2775 17290000 NOC = NOC + 1 17300000 C 17310000 C BRANCH OUT OF LOOP IF ONLY CALCULATING RESERVED. 17320000 C 17330000 CGRANG = ECGR - SCGR + 1 17340000 MAXNUM = MAXMAX 17350000 IF (MAXMAX .NE. 0) GO TO 2772 17360000 MAXNUM = CGRANG + LCMXFD 17370000 C 17380000 2772 LEN = NOSAMP + (MXOPER / LCPI) + 1 17390000 CALL S1FMAG (LEN, MAG, FFTLEN) 17400000 IF (FFTLEN .LT. 128) FFTLEN = 128 17410000 FFTLEN = FFTLEN + 2 17420000 PILOTL = (MXWLEN + 2 * MAXSHF) / LCPI + 2 17430000 CALL S1FMAG (PILOTL, MAG, FFTLN2) 17440000 IF (FFTLN2 .LT. 128) FFTLN2 = 128 17450000 FFTLN2 = FFTLN2 + 2 17460000 IF (TRACF) GO TO 2790 17470000 C 17480000 C CS = MAXIMUM UNRESERVED SPACE REQUIRED FOR ANY TRAC 17490000 C 17500000 MXNXCR = 1 17510000 IF (PLTCOD .EQ. 1) MXNXCR = ((256 * MXPORT) - 215 - 17520000 * 2 * FFTLN2) / FFTLN2 17530000 IF (MXNXCR .GT. LCMXFD) MXNXCR = LCMXFD 17540000 LEN = (MXNXCR + 1) * FFTLN2 17550000 IF (NOSAMP + 14 .GT. LEN) LEN = NOSAMP + 14 17560000 IF (FLTRID .NE. 0 .AND. FFTLEN .GT. LEN) LEN = FFTLEN 17570000 CS = MXNWIN * 7 * PILOTL + MXNWIN * MXNXCR * PILOTL 17580000 * + 4 * NOSAMP 17590000 * + 2 * (LCMXFD * MXNWIN) + LCMXFD + (LCMXFD+3) / 4 17600000 * + 4 * (CGRANG + MAXNUM) 17610000 * + 30 * (3 + MXDPPP) + 3 * THL + 40 + LEN 17620000 IF (PLTCOD .EQ. 1) CS = CS + MXNXCR * MXNWIN * PILOTL 17630000 IF (CS .LT. 12*(CGRANG+MAXNUM)) CS = 12 * (CGRANG + MAXNUM) 17640000 IF (S1CPCH(SYSTEM, 1, IBM , 1, 4) .NE. 0) CS =CS + NOSAMP 17650000 IF (CS .GT. MAXCS) MAXCS = CS 17660000 DA = 1 17670000 C 17680000 2775 IF (TRACF) GO TO 8020 17690000 C 17700000 2780 CONTINUE 17710000 TRACF = .TRUE. 17720000 GO TO 2730 17730000 C 17740000 2790 IF (NOC .EQ. 0) GO TO 9800 17750000 CSIZE = 200 + 750 + 10 * NTRACC + 5 * (CGRANG + MAXNUM) 17760000 * + 24552 + CGRANG + 2 * LCNSP + (NOSAMP + THL) * (MX2*MXDPPP + 1) 17770000 * + 6 * MAXNUM + FFTLEN + 25 + 16007 17780000 C 17790000 IF (MAXCS .LE. URBYTE/4) MAXCS = 0 17800000 IF (MAXCS .EQ. 0) GO TO 2795 17810000 SVCOM = MAXCS 17820000 MAXCS = MAXCS - URBYTE/4 17830000 URBYTE = SVCOM * 4 17840000 URKBYT = URBYTE / 1024 17850000 C 17860000 2795 CSIZE = (4 * (MAXCS + CSIZE) + 1023) / 1024 17870000 C 17880000 GO TO 9900 17890000 C 17900000 C ============== 17910000 C 28. PROCESS = DMIG 17920000 C ============== 17930000 C 17940000 C =========================================== 17950000 C COMPUTE THE REGION AND COMMON SIZE FOR DMIG 17960000 C =========================================== 17970000 C 17980000 C 17990000 2800 PSIZE = 29 18000000 CSIZE = 3 * BLKSIZ + 4 * (4 * NOSAMP) + 2096 18010000 DA = 1 18020000 NWGHT = 0 18030000 C 18040000 2810 CALL FORC (KPNA, KPRNO, DA, CARD, * 2830 )18050000 IF (S1CPCH(CARD,8,' ',1,3) .NE. 0) GO TO 2820 18060000 IF (S1CPCH(CARD,58,'WGT',1,3) .EQ. 0) NWGHT = 1 18070000 GO TO 2810 18080000 C 18090000 2820 IF (S1CPCH(CARD,8,'XXX',1,3) .NE. 0) GO TO 2810 18100000 IF (S1CPCH(CARD,11,' ',1,5) .NE. 0) NWGHT = 1 18110000 C 18120000 2830 IF (NWGHT .NE. 0) CSIZE = CSIZE + 6 * (4 * NOSAMP) 18130000 C 18140000 C CONVERT TO K-BYTES 18150000 C 18160000 CSIZE = (CSIZE + 1023) / 1024 18170000 GO TO 9900 18180000 C 18190000 C ============== 18200000 C 29. PROCESS = SORT 18210000 C ============== 18220000 C 18230000 C =========================================== 18240000 C COMPUTE THE REGION AND COMMON SIZE FOR SORT 18250000 C =========================================== 18260000 C 18270000 C 18280000 2900 PSIZE = 15 18290000 C 18300000 DA = 1 18310000 2910 CALL FORC (KPNA, KPRNO, DA, CARD, * 8020 )18320000 IF (S1CPCH(CARD, 8,' ',1,3) .NE. 0) GO TO 2910 18330000 C 18340000 CALL S1MVCH (CARD,7,MODE,1,1) 18350000 IF (S1CPCH(MODE,1,' ',1,1) .EQ. 0) MODE = LNMODE 18360000 MAXFLD = LCTPSP 18370000 IF (S1CPCH(MODE,1,'S',1,1) .EQ. 0) MAXFLD = LCTPSP 18380000 IF (S1CPCH(MODE,1,'D',1,1) .EQ. 0) MAXFLD = LCMXFD 18390000 C 18400000 R1 = S1CVBN(CARD,11,5) 18410000 R2 = S1CVBN(CARD,16,5) 18420000 NDPS = R2 - R1 + 1 18430000 NDPS = IABS(NDPS) 18440000 IF (NDPS .LT. 0) NDPS = 1 18450000 C 18460000 VOLUME = 1 18470000 IF (S1CPCH(CARD,31,' ',1,5) .EQ. 0) VOLUME = 1 18480000 IF (S1CPCH(CARD,31,'MODE ',1,5) .EQ. 0) VOLUME = 1 18490000 IF (S1CPCH(CARD,31,' MODE',1,5) .EQ. 0) VOLUME = 1 18500000 IF (S1CPCH(CARD,31,'LINE ',1,5) .EQ. 0) VOLUME = 2 18510000 IF (S1CPCH(CARD,31,' LINE',1,5) .EQ. 0) VOLUME = 2 18520000 IF (S1CPCH(CARD,31,'ALL ',1,5) .EQ. 0) VOLUME = 3 18530000 IF (S1CPCH(CARD,31,' ALL ',1,5) .EQ. 0) VOLUME = 3 18540000 IF (S1CPCH(CARD,31,' ALL',1,5) .EQ. 0) VOLUME = 3 18550000 C 18560000 L1 = S1CVBN(CARD,66,5) 18570000 L2 = S1CVBN(CARD,71,5) 18580000 NLNS = L2 - L1 + 1 18590000 IF (NLNS .LT. 0) NLNS = 1 18600000 C 18610000 MAXTRC = S1CVBN(CARD, 36, 5) 18620000 IF (MAXTRC .LE. 0) THEN 18630000 IF (VOLUME .EQ. 1) THEN 18640000 NREC = MAXFLD 18650000 ELSE IF (VOLUME .EQ. 2) THEN 18660000 NREC = MAXFLD * NDPS 18670000 ELSE IF (VOLUME .EQ. 3) THEN 18680000 NREC = MAXFLD * NDPS * NLNS 18690000 ENDIF 18700000 ELSE 18710000 NREC = 1000 * MAXTRC 18720000 ENDIF 18730000 C 18740000 DA = 1 18750000 NSORT = 0 18760000 2930 CALL FORC (KPNA, KPRNO, DA, CARD, * 2940 )18770000 NSORT = NSORT + 1 18780000 GO TO 2930 18790000 2940 CONTINUE 18800000 C 18810000 CSIZE = NREC + NSORT*NREC + THL + NOSAMP + 100 18820000 C 18830000 C CONVERT TO K-BYTES 18840000 C 18850000 CSIZE = (4*CSIZE + 1023) / 1024 18860000 GO TO 9900 18870000 C 18880000 C 18890000 C ============== 18900000 C 30. PROCESS = DCON 18910000 C ============== 18920000 C 18930000 C =========================================== 18940000 C COMPUTE THE REGION AND COMMON SIZE FOR DCON 18950000 C =========================================== 18960000 C 18970000 C 18980000 3000 PSIZE = 20 18990000 CSIZE = 1 19000000 DA = 1 19010000 LFOUR = 3 * BLKSIZ 19020000 COM = 0 19030000 CALL FORC (KPNA, KPRNO, DA, CARD, * 8020 )19040000 C 19050000 DO 3010 19060000 *I = 21, 80, 15 19070000 FLID = S1CVBN (CARD, I+5, 5) 19080000 IF (FLID .EQ. 0) GO TO 3010 19090000 COM = COM + LFOUR 19100000 C 19110000 3010 CONTINUE 19120000 C 19130000 C CONVERT TO K-BYTES 19140000 C 19150000 IF (COM .LE. URBYTE) COM = 0 19160000 IF (COM .EQ. 0) GO TO 3020 19170000 SVCOM = COM 19180000 COM = COM - URBYTE 19190000 URBYTE = SVCOM 19200000 URKBYT = URBYTE / 1024 19210000 C 19220000 3020 CSIZE = (CSIZE + COM + 1023) / 1024 19230000 GO TO 9900 19240000 C 19250000 C ============== 19260000 C 31. PROCESS = TR3D 19270000 C ============== 19280000 C 19290000 C =========================================== 19300000 C COMPUTE THE REGION AND COMMON SIZE FOR TR3D 19310000 C =========================================== 19320000 C 19330000 3100 CONTINUE 19340000 MINCDP = 99999 19350000 MAXCDP = 0 19360000 MINLIN = 99999 19370000 MAXLIN = 0 19380000 NOC = 0 19390000 DA = 1 19400000 C 19410000 3110 CALL FORC(KPNA, KPRNO, DA, CARD, * 3115 )19420000 IF (S1CPCH(CARD, 8, ' ', 1, 3) .NE. 0) GO TO 3110 19430000 NOC = NOC + 1 19440000 NCDP1 = S1CVBN (CARD, 11, 5) 19450000 IF (MINCDP .GT. NCDP1) MINCDP = NCDP1 19460000 NCDP2 = S1CVBN (CARD, 16, 5) 19470000 IF (MAXCDP .LT. NCDP2) MAXCDP = NCDP2 19480000 LINE1 = S1CVBN (CARD, 66, 5) 19490000 IF (MINLIN .GT. LINE1) MINLIN = LINE1 19500000 LINE2 = S1CVBN (CARD, 71, 5) 19510000 IF (MAXLIN .LT. LINE2) MAXLIN = LINE2 19520000 GO TO 3110 19530000 C 19540000 3115 IF (NOC .LE. 0) GO TO 8020 19550000 LD = MAXCDP - MINCDP + 1 19560000 NLINE = MAXLIN - MINLIN + 1 19570000 DA = 1 19580000 C 19590000 3120 CALL FORC (KPNA, KPRNO, DA, CARD, * 8020 )19600000 IF (S1CPCH(CARD, 8, 'ANL', 1, 3) .NE. 0) GO TO 3120 19610000 MAXNS = S1CVBN (CARD, 21,5) 19620000 IF (S1CPCH(CARD,30,'K',1,1) .EQ. 0) THEN 19630000 MAXNR = S1CVBN (CARD, 26,4) 19640000 MAXNR = MAXNR * 1000 19650000 ELSE 19660000 MAXNR = S1CVBN (CARD, 26,5) 19670000 ENDIF 19680000 NWIND = 1 19690000 C WORK BUFFER FOR INPUT DATA SETS (8190 WORDS) 19700000 WBUFLN = 8190 19710000 LWBUF = 48000 19720000 BUFSIZ = 8000 19730000 NWORDS = 600 + WBUFLN + LWBUF + 6 * BUFSIZ 19740000 * + 5 * NLINE * LD * NWIND 19750000 * + NLINE * NWIND 19760000 * + LD * NLINE 19770000 * + 2 * NWIND 19780000 * + NLINE 19790000 * + 3 * MAXNR 19800000 * + 4 * MAXNS 19810000 * + 4 * (MAXNS + MAXNR) 19820000 COM = 6 * (MAXNR + MAXNS) 19830000 * + 10 * NLINE * LD 19840000 COM = COM * 4 19850000 IF (COM.LE.URBYTE) COM = 0 19860000 IF(COM .EQ. 0) GO TO 3130 19870000 SVCOM = COM 19880000 COM = COM - URBYTE 19890000 URBYTE = SVCOM 19900000 URKBYT = URBYTE / 1024 19910000 C 19920000 3130 CSIZE = (NWORDS * 4 + COM + 1023) / 1024 19930000 PSIZE = 30 19940000 GO TO 9900 19950000 C 19960000 C ============== 19970000 C 32. PROCESS = TS3D 19980000 C ============== 19990000 C 20000000 C =========================================== 20010000 C COMPUTE THE REGION AND COMMON SIZE FOR TS3D 20020000 C =========================================== 20030000 C 20040000 3200 CONTINUE 20050000 MINCDP = 99999 20060000 MAXCDP = 0 20070000 MINLIN = 99999 20080000 MAXLIN = 0 20090000 NOC = 0 20100000 DA = 1 20110000 C 20120000 3210 CALL FORC(KPNA, KPRNO, DA, CARD, * 3215 )20130000 IF (S1CPCH(CARD, 8, ' ', 1, 3) .NE. 0) GO TO 3210 20140000 NOC = NOC + 1 20150000 NCDP1 = S1CVBN (CARD, 11, 5) 20160000 IF (MINCDP .GT. NCDP1) MINCDP = NCDP1 20170000 NCDP2 = S1CVBN (CARD, 16, 5) 20180000 IF (MAXCDP .LT. NCDP2) MAXCDP = NCDP2 20190000 LINE1 = S1CVBN (CARD, 66, 5) 20200000 IF (MINLIN .GT. LINE1) MINLIN = LINE1 20210000 LINE2 = S1CVBN (CARD, 71, 5) 20220000 IF (MAXLIN .LT. LINE2) MAXLIN = LINE2 20230000 GO TO 3210 20240000 C 20250000 3215 IF (NOC .NE. 1) GO TO 8020 20260000 LD = MAXCDP - MINCDP + 1 20270000 NLINE = MAXLIN - MINLIN + 1 20280000 DA = 1 20290000 C 20300000 NWORDS = 100 + 8 * NLINE * LD 20310000 COM = 0 20320000 C 20330000 3230 CSIZE = (NWORDS * 4 + COM + 1023) / 1024 20340000 PSIZE = 30 20350000 GO TO 9900 20360000 C 20370000 C ============== 20380000 C 33. PROCESS = MU3D 20390000 C ============== 20400000 C 20410000 C =========================================== 20420000 C COMPUTE THE REGION AND COMMON SIZE FOR MU3D 20430000 C =========================================== 20440000 C 20450000 C 20460000 3300 PSIZE = 15 20470000 C 20480000 DA = 1 20490000 3310 CALL FORC (KPNA, KPRNO, DA, CARD, * 8020 )20500000 IF (S1CPCH(CARD, 8,' ',1,3) .NE. 0) GO TO 3310 20510000 C 20520000 R1 = S1CVBN(CARD,11,5) 20530000 R2 = S1CVBN(CARD,16,5) 20540000 NDPS = R2 - R1 + 1 20550000 IF (NDPS .LT. 0) NDPS = 1 20560000 C 20570000 L1 = S1CVBN(CARD,66,5) 20580000 L2 = S1CVBN(CARD,71,5) 20590000 NLNS = L2 - L1 + 1 20600000 IF (NLNS .LT. 0) NLNS = 1 20610000 C 20620000 CSIZE = NDPS * NLNS + 200 20630000 C 20640000 C CONVERT TO K-BYTES 20650000 C 20660000 CSIZE = (4*CSIZE + 1023) / 1024 20670000 GO TO 9900 20680000 C 20690000 C 20700000 C 34. PROCESS = PIKL 20710000 C ============== 20720000 C 20730000 C ============================================ 20740000 C COMPUTE THE REGION AND COMMON SIZE FOR PIKL 20750000 C ============================================ 20760000 C 20770000 3400 PSIZE = 30 20780000 CSIZE = 1 20790000 NOC = 0 20800000 C 20810000 DA = 1 20820000 3410 CALL FORC (KPNA, KPRNO, DA, CARD, * 3420 )20830000 IF (S1CPCH(CARD, 8,' ',1,3) .NE. 0) GO TO 3410 20840000 NOC = NOC + 1 20850000 GO TO 3410 20860000 3420 IF (NOC .EQ. 0) GO TO 8020 20870000 C 20880000 CSIZE = CSIZE + (((LCNSP+1)/2+LCTPSP*LCNSP)*4+1023) / 1024 20890000 C 20900000 GO TO 9900 20910000 C 20920000 C =============================== 20930000 C 35. 36. & 57. PROCESS = SIGD , SPEC, AND IDCN 20940000 C =============================== 20950000 C 20960000 C ===================================================== 20970000 C COMPUTE THE REGION AND COMMON SIZE FOR SIGD/SPEC/IDCN 20980000 C ===================================================== 20990000 C 21000000 C 21010000 3500 PSIZE = 51 21020000 CALL S1FMAG (NOSAMP, MAG, LFOUR) 21030000 C 21040000 C AN APPROXIMATION IS MADE TO THE SPACE NEEDED FOR 21050000 C THE OPERATOR BY ASSUMING THE LENGTH WILL NEVER 21060000 C BE GREATER THAN 2 * FFT LENGTH OF ENTIRE TRACE 21070000 C (2 OF THESE AREAS ARE REQUIRED) 21080000 C 21090000 CSIZE = (BLKSIZ + 4*(4 * LFOUR + 400) + 1023) / 1024 21100000 GO TO 9900 21110000 C 21120000 C ============== 21130000 C 37. PROCESS = CS3D 21140000 C ============== 21150000 C 21160000 C =========================================== 21170000 C COMPUTE THE REGION AND COMMON SIZE FOR CS3D 21180000 C =========================================== 21190000 C 21200000 3700 PSIZE = 20 21210000 COM = 8190 + 2 * (THL+NOSAMP) + 140 + LCMXFD 21220000 C 21230000 CSIZE = (COM + 1023) / 1024 21240000 C 21250000 GO TO 9900 21260000 C 21270000 C ============== 21280000 C 38. PROCESS = CVPL 21290000 C ============== 21300000 C 21310000 C =========================================== 21320000 C COMPUTE THE REGION AND COMMON SIZE FOR CVPL 21330000 C =========================================== 21340000 C 21350000 3800 PSIZE = 21 21360000 CSIZE = 0 21370000 C 21380000 LNPBUF = 16380 21390000 COM = LNPBUF + 96 21400000 IF (COM .LE. URBYTE) COM = 0 21410000 IF (COM .EQ. 0) GO TO 3810 21420000 SVCOM = COM 21430000 COM = COM - URBYTE 21440000 URBYTE = SVCOM 21450000 URKBYT = URBYTE / 1024 21460000 CSIZE = CSIZE + (COM + 1023) / 1024 21470000 C 21480000 CKG 21490000 C WRITE(6,77777) CSIZE,PSIZE,URKBYT,URBYTE 21500000 C7777 FORMAT('0 CSIZE PSIZE URKBYT URBYTE ',4I9) 21510000 C 21520000 3810 GO TO 9900 21530000 C 21540000 C ============== 21550000 C 39. PROCESS = P100 21560000 C ============== 21570000 C 21580000 C =========================================== 21590000 C COMPUTE THE REGION AND COMMON SIZE FOR P100 21600000 C =========================================== 21610000 C 21620000 C 21630000 3900 PSIZE = 15 21640000 C 21650000 DA = 1 21660000 3910 CALL FORC (KPNA, KPRNO, DA, CARD, * 8020 )21670000 IF (S1CPCH(CARD, 8,' ',1,3) .NE. 0) GO TO 3910 21680000 C 21690000 MAXFLD = LCMXFD 21700000 C 21710000 R1 = S1CVBN(CARD,11,5) 21720000 R2 = S1CVBN(CARD,16,5) 21730000 NDPS = R2 - R1 + 1 21740000 NDPS = IABS(NDPS) 21750000 IF (NDPS .LT. 0) NDPS = 1 21760000 C 21770000 CSIZE = NDPS * (MAXFLD*2+1) + THL + 100 21780000 C 21790000 C CONVERT TO K-BYTES 21800000 C 21810000 CSIZE = (4*CSIZE + 1023) / 1024 21820000 GO TO 9900 21830000 C 21840000 C 21850000 C ============== 21860000 C 40. PROCESS = CD3D 21870000 C ============== 21880000 C 21890000 C =========================================== 21900000 C COMPUTE THE REGION AND COMMON SIZE FOR CD3D 21910000 C =========================================== 21920000 C 21930000 C UNIRAS 5.3 SIZE IS APPROXIMATELY 2900K 21940000 4000 PSIZE = 3070 21950000 CSIZE = 0 21960000 RSIZE = 200 21970000 C 21980000 COM = 228 21990000 DA = 1 22000000 C 22010000 4010 CALL FORC (KPNA, KPRNO, DA, CARD, * 8020 ) 22020000 IF (S1CPCH(CARD,8,' ',1,3) .NE. 0) GO TO 4010 22030000 C 22040000 SDP = S1CVBN (CARD, 11, 5) 22050000 EDP = S1CVBN (CARD, 16, 5) 22060000 NODP = EDP - SDP + 1 22070000 C 22080000 SLNNO = S1CVBN (CARD, 66, 5) 22090000 ELNNO = S1CVBN (CARD, 71, 5) 22100000 NOLN = ELNNO - SLNNO + 1 22110000 C 22120000 COM = (COM + (NODP+1) * NOLN) * 4 22130000 IF (COM .LE. URBYTE) COM = 0 22140000 IF (COM .EQ. 0) GO TO 4020 22150000 SVCOM = COM 22160000 COM = COM - URBYTE 22170000 URBYTE = SVCOM 22180000 URKBYT = URBYTE / 1024 22190000 C 22200000 CSIZE = (COM + 1023) / 1024 22210000 4020 GO TO 9900 22220000 C 22230000 C 22240000 C ============== 22250000 C 41. PROCESS = SRVY 22260000 C ============== 22270000 C 22280000 C =========================================== 22290000 C COMPUTE THE REGION AND COMMON SIZE FOR SRVY 22300000 C =========================================== 22310000 C 22320000 C 22330000 4100 PSIZE = 30 22340000 CSIZE = 0 22350000 C 22360000 LNPBUF = 816380 22370000 COM = LNPBUF + 96 22380000 IF (COM .LE. URBYTE) COM = 0 22390000 IF (COM .EQ. 0) GO TO 4110 22400000 SVCOM = COM 22410000 COM = COM - URBYTE 22420000 URBYTE = SVCOM 22430000 URKBYT = URBYTE / 1024 22440000 CSIZE = CSIZE + (COM + 1023) / 1024 22450000 4110 GO TO 9900 22460000 C 22470000 C ============== 22480000 C 42. PROCESS = ZDCN 22490000 C ============== 22500000 C 22510000 C =========================================== 22520000 C COMPUTE THE REGION AND COMMON SIZE FOR ZDCN 22530000 C =========================================== 22540000 C 22550000 C 22560000 4200 PSIZE = 27 22570000 CALL S1FMAG (NOSAMP, MAG, LFOUR) 22580000 C 22590000 CSIZE = LFOUR * 4 22600000 C 22610000 C AN APPROXIMATION TO THE SPACE NEEDED IS MADE BY 22620000 C ASSUMING THE LENGTH WILL NEVER BE GREATER THAN 22630000 C SEVEN TIMES THE FFT LENGTH IF THE ENTIRE TRACE IS 22640000 C TRANSFORMED. ORIGINALLY IT WAS THREE TIME, HOWEVER, 22650000 C FOUR ADDITIONAL UNRESERVED PLOT BUFFERS AND ONE 22660000 C RESERVED BUFFER WERE NEEDED FOR AP3838 CONVERSION. 22670000 C 22680000 COM = 7 * (4 * LFOUR) 22690000 IF (COM .LE. URBYTE) COM = 0 22700000 IF (COM .EQ. 0) GO TO 4210 22710000 SVCOM = COM 22720000 COM = COM - URBYTE 22730000 URBYTE = SVCOM 22740000 URKBYT = URBYTE / 1024 22750000 C 22760000 4210 CSIZE = (CSIZE + COM + 1023) / 1024 22770000 GO TO 9900 22780000 C 22790000 C 22800000 C ============== 22810000 C 43. PROCESS = READ 22820000 C ============== 22830000 C 22840000 C =========================================== 22850000 C COMPUTE THE REGION AND COMMON SIZE FOR READ 22860000 C =========================================== 22870000 C 22880000 C 22890000 4300 PSIZE = 95 22900000 NOWDS = RLENG / MIN0(LCSI, LCPI) 22910000 C 22920000 C ALLOCATE MEMORY FOR FFT WHEN RESAMPLING 22930000 C 22940000 IF ( LCSI .NE. LCPI) THEN 22950000 CALL S1FMAG (NOWDS, MAG, NOWDS) 22960000 IF (LCPI .LT. LCSI) NOWDS = 2 * NOWDS 22970000 NOWDS = NOWDS + 2 22980000 ENDIF 22990000 C 23000000 NOWDS = NOWDS + THL + 102 23010000 IF (NOWDS .LT.1000) NOWDS = 1000 23020000 C 23030000 C ADD A TRACE BUFFER FOR SCRATCH WHEN READING WGC4 DATA ON CRAY 23040000 C 23050000 IF (SYSTEM .EQ. CRAY) THEN 23060000 WGC4RD = .FALSE. 23070000 DA = 1 23080000 C 23090000 4310 CONTINUE 23100000 CALL FORC('READ', 0, DA, CARD, * 4320) 23110000 IF (S1CPCH(CARD, 51, 'WGC4 ', 1, 5) .EQ. 0) WGC4RD = .TRUE. 23120000 GO TO 4310 23130000 C 23140000 4320 CONTINUE 23150000 C 23160000 IF (WGC4RD) NOWDS = NOWDS + LCRL / LCSI 23170000 ENDIF 23180000 C 23190000 DA = 1 23200000 CALL FORC('GM3D', 0, DA, CARD, * 4330 )23210000 NOWDS = NOWDS + 3*LCNSP 23220000 C 23230000 4330 CONTINUE 23240000 MAXLIN = 0 23250000 DA = 1 23260000 4340 CALL FORC ('READ', 0, DA, CARD, *4350) 23270000 C---------GET MAXIMUM 3-D LINE NUMBER 23280000 IF (S1CPCH(CARD, 8, ' ', 1, 3) .NE. 0) THEN 23290000 LINENO = S1CVBN(CARD, 16, 5) 23300000 IF(LINENO .GT. MAXLIN) MAXLIN = LINENO 23310000 ENDIF 23320000 GO TO 4340 23330000 4350 CONTINUE 23340000 MAXLIN = MAX0 (MAXLIN, LCMXLN) 23350000 NOWDS = NOWDS + MAXLIN 23360000 C 23370000 4400 CSIZE = (4 * NOWDS + 1023) / 1024 23380000 GO TO 9900 23390000 C 23400000 C ============== 23410000 C 45. PROCESS = TRAX 23420000 C ============== 23430000 C 23440000 C =========================================== 23450000 C COMPUTE THE REGION AND COMMON SIZE FOR TRAX 23460000 C =========================================== 23470000 C 23480000 4500 CONTINUE 23490000 DA = 1 23500000 C 23510000 4510 CALL FORC(KPNA, KPRNO, DA, CARD, * 8020 )23520000 IF (S1CPCH(CARD, 8, ' ', 1, 3) .NE. 0) GO TO 4510 23530000 NCDP1 = S1CVBN (CARD, 11, 5) 23540000 NCDP2 = S1CVBN (CARD, 16, 5) 23550000 LD = NCDP2 - NCDP1 + 1 23560000 LINE1 = S1CVBN (CARD, 66, 5) 23570000 LINE2 = S1CVBN (CARD, 71, 5) 23580000 NLINE = LINE2 - LINE1 + 1 23590000 DA = 1 23600000 C 23610000 4520 CALL FORC (KPNA, KPRNO, DA, CARD, * 8020 )23620000 IF (S1CPCH(CARD, 8, ' ', 1, 3) .EQ. 0) GO TO 4520 23630000 MAXNS = S1CVBN (CARD, 21,5) 23640000 MAXNR = S1CVBN (CARD, 26,5) 23650000 NWIND = 1 23660000 C WORK BUFFER FOR FOBLOCK (TRACE HEADERS AND THREE SAMPLES) 23670000 TRLN = 3 + THL 23680000 WBUFLN = 47472 / TRLN * TRLN 23690000 NWORDS = 130 + 48000 + 48 23700000 * + 5 * NLINE * LD * NWIND 23710000 * + NWIND * NLINE + 2 * NWIND + NLINE 23720000 * + 3 * MAXNR + 4 * MAXNS + 4 * (MAXNS + MAXNR) 23730000 * + WBUFLN 23740000 COM = (MAXNR + MAXNS) * 6 + LD * (NLINE) * 10 23750000 COM = COM * 4 23760000 IF (COM.LE.URBYTE) COM = 0 23770000 IF(COM .EQ. 0) GO TO 4530 23780000 SVCOM = COM 23790000 COM = COM - URBYTE 23800000 URBYTE = SVCOM 23810000 URKBYT = URBYTE / 1024 23820000 C 23830000 4530 CSIZE = (NWORDS * 4 + COM + 1023) / 1024 23840000 PSIZE = 30 23850000 GO TO 9900 23860000 C 23870000 C ============== 23880000 C 46. PROCESS = LAGX 23890000 C ============== 23900000 C 23910000 C =========================================== 23920000 C COMPUTE THE REGION AND COMMON SIZE FOR LAGX 23930000 C =========================================== 23940000 C 23950000 4600 DA = 1 23960000 NT = LCANSP * LCTPSP 23970000 CALL FORC (KPNA, KPRNO, DA, CARD, * 8020 )23980000 NDPPP = S1CVBN (CARD, 26, 5) 23990000 MAXSFT = S1CVBN (CARD, 31, 5) 24000000 STIME = S1CVBN (CARD, 41, 5) 24010000 ETIME = S1CVBN (CARD, 46, 5) 24020000 SSMPL = STIME / LCPI + 1 24030000 ESMPL = ETIME / LCPI + 1 24040000 NSMPL = ESMPL - SSMPL + 1 24050000 LAG = MAXSFT / LCPI 24060000 L = NSMPL + 2 * LAG 24070000 FFTLEN = 4 24080000 C 24090000 4610 IF (FFTLEN .GE. L) GO TO 4620 24100000 FFTLEN = FFTLEN * 2 24110000 GO TO 4610 24120000 C 24130000 4620 MXNXCR = (256 * MXPORT - 200 - 2 * (FFTLEN + 2)) / (FFTLEN + 2) 24140000 NWORDS = 300 + (NDPPP + 1) * NSMPL + NDPPP + 24 * LCMXFD 24150000 * + (MXNXCR + 1) * (FFTLEN + 2) + MXNXCR 24160000 * + MXNXCR * (2 * LAG + 1) + 200 24170000 C 24180000 COM = LCMXFD + NSMPL + 2 * MXNXCR 24190000 COM = COM * 4 24200000 IF (COM .LE. URBYTE) COM = 0 24210000 IF (COM .EQ. 0) GO TO 4630 24220000 SVCOM = COM 24230000 COM = COM - URBYTE 24240000 URBYTE = SVCOM 24250000 URKBYT = URBYTE / 1024 24260000 C 24270000 4630 CSIZE = (NWORDS * 4 + COM + 1023) / 1024 24280000 PSIZE = 15 24290000 GO TO 9900 24300000 C 24310000 C ============== 24320000 C 47. PROCESS = VSPB 24330000 C ============== 24340000 C 24350000 C ================================ 24360000 C COMPUTE THE COMMON SIZE FOR VSPB 24370000 C ================================ 24380000 C 24390000 4700 CONTINUE 24400000 C 24410000 CALL S1FMAG(NOSAMP,NNC,NNCL) 24420000 CSIZE =(( 8*NNCL 24430000 * +25+2 24440000 * +MAX0(LCNSP,LCENSP-LCBGSP+1,LCANSP))*4 24450000 * +1023)/1024 24460000 PSIZE = 15 24470000 GO TO 9900 24480000 C 24490000 C ============== 24500000 C 48. PROCESS = AMPS 24510000 C ============== 24520000 C 24530000 C ================================ 24540000 C COMPUTE THE COMMON SIZE FOR AMPS 24550000 C ================================ 24560000 C 24570000 4800 DA = 1 24580000 LP = 15 24590000 NOC = 0 24600000 MINCDP = 999999 24610000 MAXCDP = -999999 24620000 MAXNUM = -999999 24630000 MAXSHF = 0 24640000 MXNWIN = 0 24650000 MXWLEN = 0 24660000 C 24670000 4810 CALL FORC (KPNA, KPRNO, DA, CARD, * 4850 )24680000 IF (S1CPCH(CARD, 8, ' ', 1, 2) .NE. 0) GO TO 4810 24690000 NOC = NOC + 1 24700000 SDPT = S1CVBN (CARD, 11, 5) 24710000 EDPT = S1CVBN (CARD, 16, 5) 24720000 IF (EDPT .EQ. 0) EDPT = SDPT 24730000 IF (MINCDP .GT. SDPT) MINCDP = SDPT 24740000 IF (MINCDP .GT. EDPT) MINCDP = EDPT 24750000 IF (MAXCDP .LT. SDPT) MAXCDP = SDPT 24760000 IF (MAXCDP .LT. EDPT) MAXCDP = EDPT 24770000 WINID = S1CVBN (CARD, 21, 5) 24780000 NUMSR = S1CVBN (CARD, 26, 5) 24790000 IF (MAXNUM .LT. NUMSR) MAXNUM = NUMSR 24800000 SHFT = S1CVBN (CARD, 56, 5) 24810000 IF (SHFT .GT. MAXSHF) MAXSHF = SHFT 24820000 DA2 = 1 24830000 C 24840000 C READ THE WIN CARD TO GET THE MAXIMUM WINDOW LENGTH 24850000 C AND THE MAXIMUM NUMBER OF WINDOWS 24860000 C 24870000 4820 CALL FORC (KPNA, KPRNO, DA2, CARD, * 4850 )24880000 IF (S1CPCH(CARD, 8, 'WIN', 1, 3) .NE. 0) GO TO 4820 24890000 ID = S1CVBN (CARD, 11, 5) 24900000 IF (WINID .NE. ID) GO TO 4820 24910000 C 24920000 DO 4830 24930000 * J = 21, 60, 10 24940000 WINS = S1CVBN (CARD, J, 5) 24950000 WINE = S1CVBN (CARD, J+5, 5) 24960000 IF (WINS .EQ. 0 .AND. WINE .EQ. 0) GO TO 4840 24970000 WINLEN = IABS(WINE - WINS) 24980000 IF (WINLEN .GT. MXWLEN) MXWLEN = WINLEN 24990000 C 25000000 4830 CONTINUE 25010000 C 25020000 4840 NWIN = (J - 21) / 10 25030000 IF (NWIN .GT. MXNWIN) MXNWIN = NWIN 25040000 GO TO 4810 25050000 C 25060000 4850 IF (NOC .EQ. 0) GO TO 8020 25070000 IF (MAXNUM .LE. 0) MAXNUM = MAXCDP - MINCDP + 1 + LCMXFD 25080000 C 25090000 C CALCULATE THE AMOUNT OF RESERVED COMMON NEEDED 25100000 C 25110000 NWORDS = 4 * (MAXCDP - MINCDP + 1 + MAXNUM) + 24700 + 7 * MAXNUM +25120000 * 2 * (MAXCDP - MINCDP + 1 + LCNSP + THL + NOSAMP) + 215 25130000 C 25140000 C CALCULATE THE CORRELATION FUNCTION AND FFT LENGTHS 25150000 C 25160000 LEN = (MXWLEN + 2 * MAXSHF) / LCPI + 1 25170000 CALL S1FMAG (LEN, MAG, FFTLEN) 25180000 FFTLEN = MAX0(FFTLEN, 128) 25190000 FFTLEN = FFTLEN + 2 25200000 MXNXCR = ((256 * MXPORT) - 215 - 2 * FFTLEN) / FFTLEN 25210000 IF (MXNXCR .GT. LCMXFD) MXNXCR = LCMXFD 25220000 C 25230000 C CALCULATE THE AMOUNT OF UNRESERVED COMMON NEEDED 25240000 C 25250000 COM = 3 * LP + THL + NOSAMP + 9 * LCMXFD + 25260000 * 12 * (MAXCDP - MINCDP + 1 + MAXNUM) + 25270000 * MXNXCR * ((MAXSHF / LCPI) * 2 + 1) + 25280000 * MXNXCR * MXNWIN * LEN + (MXNXCR + 1) * FFTLEN 25290000 C 25300000 COM = COM * 4 25310000 IF (COM .LE. URBYTE) COM = 0 25320000 IF (COM .EQ. 0) GO TO 4860 25330000 SVCOM = COM 25340000 COM = COM - URBYTE 25350000 URBYTE = SVCOM 25360000 URKBYT = URBYTE / 1024 25370000 C 25380000 4860 CSIZE = (NWORDS * 4 + COM + 1023) / 1024 25390000 PSIZE = 61 25400000 GO TO 9900 25410000 C 25420000 C ============== 25430000 C 49. PROCESS = SP3D 25440000 C ============== 25450000 C 25460000 C =========================================== 25470000 C COMPUTE THE REGION AND COMMON SIZE FOR SP3D 25480000 C =========================================== 25490000 C 25500000 C 25510000 C UNIRAS = 2900 25520000 4900 PSIZE = 2930 25530000 CSIZE = 0 25540000 RSIZE = 1000 25550000 COM = 0 25560000 DA = 1 25570000 C 25580000 4910 CALL FORC (KPNA, KPRNO, DA, CARD, * 8020 ) 25590000 IF (S1CPCH(CARD, 8, 'PRM', 1, 3) .NE. 0) GO TO 4910 25600000 C 25610000 MAXNS = S1CVBN (CARD, 61, 5) 25620000 IF (S1CPCH(CARD,70,'K',1,1) .EQ. 0) THEN 25630000 MAXNR = S1CVBN (CARD, 66, 4) 25640000 MAXNR = 1000 * MAXNR 25650000 ELSE 25660000 MAXNR = S1CVBN (CARD, 66, 5) 25670000 ENDIF 25680000 IF (MAXNS .EQ. 0) MAXNS = LCNSP 25690000 IF (MAXNR .EQ. 0) MAXNR = LCTPSP + LCNSP * 2 25700000 SPACE = MAX0(MAXNS, MAXNR) 25710000 NWORDS = 7 * MAXNS + 6 * MAXNR + 600 25720000 C 25730000 C CHECK UNRESERVED USAGE FOR ENOUGH SPACE 25740000 COM = (COM + 18225 + 3*SPACE) * 4 25750000 IF (COM .LE. URBYTE) COM = 0 25760000 IF (COM .EQ. 0) GO TO 4920 25770000 SVCOM = COM 25780000 COM = COM - URBYTE 25790000 URBYTE = SVCOM 25800000 URKBYT = URBYTE / 1024 25810000 C 25820000 4920 CSIZE = (4 * NWORDS + COM + 1023) / 1024 25830000 GO TO 9900 25840000 C 25850000 C ============== 25860000 C5000 50. PROCESS = VTPA - DELETED 4/13/87 25870000 C ============== 25880000 C USING THIS SPOT FOR PROCESS PHAS - 9/21/88 25890000 C 25900000 C ============== 25910000 C 50. PROCESS = PHAS 25920000 C ============== 25930000 C 25940000 5000 CONTINUE 25950000 PSIZE = 17 25960000 CALL S1FMAG (NOSAMP,MAG,LFOUR) 25970000 COM = 4 * (4 * LFOUR) 25980000 CSIZE = (COM + 1023) / 1024 25990000 GO TO 9900 26000000 C 26010000 C 26020000 C ============== 26030000 C5100 51. PROCESS = VTPD - DELETED 4/13/87 26040000 C ============== 26050000 C 26060000 C 26070000 C ============== 26080000 C 52. PROCESS = VSPA 26090000 C ============== 26100000 C 26110000 C =========================================== 26120000 C COMPUTE THE REGION AND COMMON SIZE FOR VSPA 26130000 C =========================================== 26140000 C 26150000 C 26160000 5200 PSIZE = 64 26170000 CSIZE = 9100 + 2*BLKSIZ 26180000 DA = 1 26190000 NMAX = 0 26200000 TABLNG = 30 26210000 FFTL = 0 26220000 C 26230000 5210 CALL FORC (KPNA, KPRNO, DA, CARD, * 5230 ) 26240000 C 26250000 IF (S1CPCH(CARD,8,' ',1,3).NE.0) GO TO 5220 26260000 C 26270000 SPT = S1CVBN(CARD, 11, 5) 26280000 EPT = S1CVBN(CARD, 16, 5) 26290000 IF(EPT.LE.0) EPT=SPT 26300000 N = (IABS(EPT-SPT) + 1) * MAX0(LCTPSP,LCMXFD) 26310000 NMAX = MAX0(NMAX, N) 26320000 GO TO 5210 26330000 C 26340000 5220 IF (S1CPCH(CARD,8,'ANA ',1,3).NE.0) GO TO 5210 26350000 WLIN = S1CVBN(CARD,26,5) 26360000 WLIN = WLIN/LCPI + 1 26370000 CALL S1FMAG(WLIN,LWIN,LOG) 26380000 FFTL = MAX0(FFTL,2*LWIN) 26390000 GO TO 5210 26400000 C 26410000 5230 COM = 4*MAX0(NMAX*TABLNG,12*FFTL) 26420000 IF (COM .LE. URBYTE) COM = 0 26430000 IF (COM .EQ. 0) GO TO 5240 26440000 SVCOM = COM 26450000 COM = COM - URBYTE 26460000 URBYTE = SVCOM 26470000 URKBYT = URBYTE / 1024 26480000 C 26490000 5240 CSIZE = CSIZE + 4*NMAX*TABLNG 26500000 CSIZE = (CSIZE + COM + 1023) / 1024 26510000 GO TO 9900 26520000 C 26530000 C ===================== 26540000 C 53. & 54. PROCESS = M2FK & M3FK 26550000 C ===================== 26560000 C 26570000 C =================================================== 26580000 C COMPUTE THE REGION AND COMMON SIZE FOR M2FK OR M3FK 26590000 C =================================================== 26600000 C 26610000 5300 DA = 1 26620000 NOC = 0 26630000 MAXCDP = -999999 26640000 MINCDP = 999999 26650000 MAXLN = -999999 26660000 MINLN = 999999 26670000 FNYQ = 500. / LCPI 26680000 C 26690000 5310 CALL FORC (KPNA, KPRNO, DA, CARD, * 5320 )26700000 IF (S1CPCH(CARD, 8, ' ', 1, 2) .NE. 0) GO TO 5310 26710000 NOC = NOC + 1 26720000 SDPT = S1CVBN (CARD, 11, 5) 26730000 EDPT = S1CVBN (CARD, 16, 5) 26740000 IF (EDPT .EQ. 0) EDPT = SDPT 26750000 IF (MINCDP .GT. SDPT) MINCDP = SDPT 26760000 IF (MINCDP .GT. EDPT) MINCDP = EDPT 26770000 IF (MAXCDP .LT. SDPT) MAXCDP = SDPT 26780000 IF (MAXCDP .LT. EDPT) MAXCDP = EDPT 26790000 SLNNO = S1CVBN (CARD, 66, 5) 26800000 ELNNO = S1CVBN (CARD, 71, 5) 26810000 IF (ELNNO .EQ. 0) ELNNO = SLNNO 26820000 IF (MINLN .GT. SLNNO) MINLN = SLNNO 26830000 IF (MINLN .GT. ELNNO) MINLN = ELNNO 26840000 IF (MAXLN .LT. SLNNO) MAXLN = SLNNO 26850000 IF (MAXLN .LT. ELNNO) MAXLN = ELNNO 26860000 IF (NOC .NE. 1) GO TO 5310 26870000 MXFREQ = S1CVBN (CARD, 36, 5) 26880000 IF (MXFREQ .EQ. 0) MXFREQ = 0.6 * FNYQ + 0.5 26890000 GO TO 5310 26900000 C 26910000 5320 IF (NOC .EQ. 0) GO TO 8020 26920000 FRACN = MXFREQ / FNYQ 26930000 IF (FRACN .LT. 0.5) FRACN = 0.5 26940000 FRACN = FRACN + 0.1 26950000 IF (FRACN .GT. 1.0) FRACN = 1.0 26960000 NSMPL = 1.17 * NOSAMP * FRACN + 0.5 26970000 NX = MAXCDP - MINCDP + 1 26980000 NY = MAXLN - MINLN + 1 26990000 C 27000000 C FIND THE FFT LENGTHS IN TIME AND SPACE 27010000 C 27020000 CALL S1FMAG (NSMPL, MAG, LFOUR) 27030000 CALL S1FMAG (NX, MAGX, LFOURX) 27040000 CALL S1FMAG (NY, MAGY, LFOURY) 27050000 LFOUR = 2 * LFOUR 27060000 FRACN = 1.1 * NX 27070000 IF (LFOURX .LT. INT(FRACN+0.5)) LFOURX = 2 * LFOURX 27080000 FRACN = 1.1 * NY 27090000 IF (LFOURY .LT. INT(FRACN+0.5)) LFOURY = 2 * LFOURY 27100000 FFTLEN = LFOUR 27110000 IF (FFTLEN .LT. LFOURX) FFTLEN = LFOURX 27120000 IF (FFTLEN .LT. LFOURY) FFTLEN = LFOURY 27130000 C 27140000 COM = 100 + 4 * NOSAMP + THL + 526338 + 1200 + 4 * FFTLEN 27150000 COM = 4 * COM 27160000 IF (COM .LE. URBYTE) COM = 0 27170000 IF (COM .EQ. 0) GO TO 5330 27180000 SVCOM = COM 27190000 COM = COM - URBYTE 27200000 URBYTE = SVCOM 27210000 URKBYT = URBYTE / 1024 27220000 C 27230000 5330 CSIZE = ( BLKSIZ + COM + 1023) / 1024 27240000 PSIZE = 22 27250000 GO TO 9900 27260000 C 27270000 C 55. PROCESS = VSHF 27280000 C ============== 27290000 C 27300000 C =========================================== 27310000 C COMPUTE THE REGION AND COMMON SIZE FOR VSHF 27320000 C =========================================== 27330000 C 27340000 5500 PSIZE = 15 27350000 DA = 1 27360000 C 27370000 5510 CALL FORC (KPNA, KPRNO, DA, CARD, * 8020 )27380000 IF (S1CPCH(CARD,8,' ',1,3) .NE. 0) GO TO 5510 27390000 R1 = S1CVBN (CARD, 11, 5) 27400000 R2 = S1CVBN (CARD, 16, 5) 27410000 NCDP = R2 - R1 + 1 27420000 LINE1 = S1CVBN (CARD, 66, 5) 27430000 LINE2 = S1CVBN (CARD, 71, 5) 27440000 NLINE = LINE2 - LINE1 + 1 27450000 C 27460000 CSIZE = (2*NCDP*NLINE*4 + 1023) / 1024 27470000 GO TO 9900 27480000 C 27490000 C 27500000 C ============== 27510000 C 58. PROCESS = SURF & SCDB 27520000 C ============== 27530000 C SURF DELETED 4/13/87 27540000 C 27550000 C =========================================== 27560000 C COMPUTE THE REGION AND COMMON SIZE FOR SURF 27570000 C =========================================== 27580000 C 27590000 5800 CONTINUE 27600000 DA = 1 27610000 C 27620000 5810 CALL FORC(KPNA, KPRNO, DA, CARD, * 8020 )27630000 IF (S1CPCH(CARD, 8, ' ', 1, 3) .NE. 0) GO TO 5810 27640000 NCDP1 = S1CVBN (CARD, 11, 5) 27650000 NCDP2 = S1CVBN (CARD, 16, 5) 27660000 LD = NCDP2 - NCDP1 + 1 27670000 LINE1 = S1CVBN (CARD, 66, 5) 27680000 LINE2 = S1CVBN (CARD, 71, 5) 27690000 NLINE = LINE2 - LINE1 + 1 27700000 NT = S1CVBN (CARD, 76, 5) 27710000 NT = NT * 1000 27720000 IF (NT .LE. 0) NT = LCANSP * LCTPSP * LCMXLN 27730000 DA = 1 27740000 C 27750000 MAXNS=0 27760000 MAXNR=0 27770000 5820 CALL FORC (KPNA, KPRNO, DA, CARD, * 5825 )27780000 IF (S1CPCH(CARD, 8, 'ANL', 1, 3) .NE. 0) GO TO 5820 27790000 MAXNS = S1CVBN (CARD, 21,5) 27800000 MAXNR = S1CVBN (CARD, 26,5) 27810000 5825 IF (MAXNS .EQ. 0) MAXNS=(LD+LCMXFD)*NLINE 27820000 IF (MAXNR .EQ. 0) MAXNR=(LD+LCMXFD)*NLINE 27830000 C 27840000 NWIND = 1 27850000 C 27860000 NWORDS = 90 + 40000 + 5 * NLINE * LD * NWIND + 27870000 * 2 * NWIND * NLINE + 2 * NWIND + 6 * (MAXNS + MAXNR) + 50 - MAXNR 27880000 C 27890000 COM = NT * 5 + (MAXNR + MAXNS) * 6 + LD * (NLINE) * 20 27900000 COM = COM * 4 27910000 IF (COM.LE.URBYTE) COM = 0 27920000 IF(COM .EQ. 0) GO TO 5830 27930000 SVCOM = COM 27940000 COM = COM - URBYTE 27950000 URBYTE = SVCOM 27960000 URKBYT = URBYTE / 1024 27970000 C 27980000 5830 CSIZE = (NWORDS * 4 + COM + 1023) / 1024 27990000 PSIZE = 30 28000000 GO TO 9900 28010000 C 28020000 C 28030000 C 59. PROCESS = ORDR 28040000 C ============== 28050000 C 28060000 C =========================================== 28070000 C COMPUTE THE REGION AND COMMON SIZE FOR ORDR 28080000 C =========================================== 28090000 C 28100000 5900 PSIZE = 17 28110000 C 28120000 C GET ORDR CARD PARAMETERS 28130000 C 28140000 DA = 1 28150000 CALL FORC (KPNA, KPRNO, DA, CARD, * 8020 )28160000 C 28170000 DPS = S1CVBN (CARD, 11, 5) 28180000 DPE = S1CVBN (CARD, 16, 5) 28190000 IF (DPE .EQ. 0) DPE = DPS 28200000 NDPS = DPE - DPS + 1 28210000 C CHECK FOR 3D 28220000 LNST = S1CVBN (CARD, 66, 5) 28230000 LNEN = S1CVBN (CARD, 71, 5) 28240000 IF (LNEN .EQ. 0) LNEN = LNST 28250000 NOLNS = LNEN - LNST + 1 28260000 NDPS = NDPS * NOLNS 28270000 C 28280000 NCOMP = S1CVBN (CARD, 21, 5) 28290000 IF (NCOMP .EQ. 0) NCOMP = 1 28300000 C 28310000 MAXTRC = LCMXFD 28320000 MAXTRC = MAXTRC * NCOMP 28330000 C 28340000 MAXDA = MAX(LCNSP,LCANSP) * LCTPSP * NCOMP 28350000 C 28360000 NWORDS = 2*NDPS + 3*MAXTRC + 2*MAXDA 28370000 C 28380000 CSIZE = (NWORDS * 4 + 1023) / 1024 28390000 C 28400000 GO TO 9900 28410000 C 28420000 C 28430000 C *********************************************************** 28440000 C ************* DO NOT ENTER NEXT PROCESS HERE ************** 28450000 C ASSOCIATED CODE FOR NEW PROCESSES SHOULD BE ADDED TO JSCOR2 28460000 C *********************************************************** 28470000 C 28480000 C 28490000 C 28500000 9800 ERCODE = 16 28510000 C 28520000 9900 RETURN 28530000 C 28540000 C ERROR MESSAGES 28550000 C 28560000 8000 WRITE (IPR, 9000 ) KPNA,KPRNO 28570000 GO TO 9800 28580000 C 28590000 8010 WRITE (IPR, 9010 ) KPNA,KPRNO 28600000 GO TO 9800 28610000 C 28620000 8020 WRITE (IPR, 9020 ) KPNA,KPRNO 28630000 GO TO 9800 28640000 C 28650000 9000 FORMAT (/' *** NO LINE OR ACCT CARD IN JSCORE FOR PROC = ', 28660000 * A4,I1) 28670000 C 28680000 9010 FORMAT (/' *** NO PROCESS FOUND IN JSCORE PROC = ',A4,I1) 28690000 C 28700000 9020 FORMAT (/' *** NO CARD PRESENT IN JSCORE FOR PROC = ',A4,I1) 28710000 C 28720000 9030 FORMAT (/' *** PICK FILE ERROR FOR PROC = ',A4,I1, 28730000 * '. ERR, ERIN =', 2Z10) 28740000 C 28750000 END 28760000