CTITLESDALTO -- ALTERATION OF FILTER OPERATORS 00010000 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA AUTHOR BOK BYUN 00020000 CA DESIGNER R. MCMILLAN/BOK BYUN 00030000 CA LANGUAGE FORTRAN 00040000 CA SYSTEM IBM AND CRAY 00050000 CA WRITTEN 02-01-91 00060000 C REVISED 11-01-90 BSB. CHANGED NAME FROM ALTO 00070000 C REVISED 11-21-90 BSB. ADDED 'UNC' OPTION FOR UNCORRELATION 00080000 C AND CHANGED BBAND2 TO SABBAND 00090000 C REVISED 12-21-91 JJC. MODIFIED TO MEET EDP STANDARDS. 00100000 C REVISED 08/27/92 REM. IMPROVE EFFICIENCY OF DO LOOP FOR APPL. 00110000 C START TIMES. 00120000 CA 00130000 CA 00140000 CA CALL SDALTO (INH, INTR, OH, OTR) 00150000 CA INPUT INH = INPUT HEADER MIXED I2, I4, R4, R8 00160000 CA INPUT INTR = INPUT TRACE R4 00170000 CA OUTPUT OH = OUTPUT HEADER MIXED I2, I4, R4, R8 00180000 CA OUTPUT OTR = OUTPUT TRACE R4 00190000 CA 00200000 CA 00210000 CA THIS PROCESS DRIVER DEVELOPS A TIME DOMAIN FILTER AND APPLIES 00220000 CA IT IN THE FREQUENCY DOMAIN. IT IS CAPABLE OF OUTPUTTING FILTER 00230000 CA PANELS. 00240000 CA 00250000 CA DEBUG LEVEL 1 WILL DUMP DLOCAL THROUGH THE FIRST FILTER VALUE 00260000 CA TABLE (UP TO "TAB2"). THESE VALUES ARE PRINTED ONLY FOR DEBUG 00270000 CA LEVEL 1. NO OTHER DEBUG LEVELS ARE USED. 00280000 C 00290000 C EJECT IF ABSTRACT NEEDS A PAGE EJECT PUT 'A' IN COLUMN 2. 00300000 C 00310000 C LOCAL OR INTERNAL ARRAYS. 00320000 C 00330000 C DATTR ( 96) = DATA ATTRIBUTES STORAGE I4 00340000 C DENTRY ( 104) = PARAMETER STORAGE I4 00350000 C DEPTHP ( 2) = CHARACTER STRING "DEPTH PT" I4 00360000 C DLOCAL ( 100) = LOCAL VARIABLES STORAGE I4 00370000 C IND ( 8) = HOLDS INDEXES TO TRACE WINDOWS I4 00380000 C INH ( 1) = INPUT TRACE HEADER I4 00390000 C INTR ( 1) = INPUT TRACE AREA R4 00400000 C OH ( 1) = OUTPUT TRACE HEADER I4 00410000 C OTR ( 1) = OUTPUT TRACE AREA R4 00420000 C PAR ( 12) = USED TO PASS PARAMETERS TO ROUTINE TO SPLIT I4 00430000 C AND RECOMBINE THE TRACE 00440000 C PSHOT ( 24) = PROCESSED SHOTPOINTS OR DEPTH POINTS I4 00450000 C SHOTPT ( 2) = CHARACTER STRING "SHOT PT " I4 00460000 C TYPPNT ( 2) = SET TO EITHER DEPTHP OR SHOTPT I4 00470000 C 00480000 C LOCAL OR INTERNAL VARIABLES AND CONSTANTS. 00490000 C 00500000 C CDP = COMMON DEPTH POINT ENSEMBLE NUMBER I4 00510000 C DAP = COUNTER FOR PARAMETER READ AND WRITE SUBROUTINE I4 00520000 C DAWRK = DISK ADDRESS FOR DIRECT READS FROM WORK FILE I4 00530000 C DAWRK1 = USED TO TEMPORARILY HOLD DAWRK FOR ACTUAL READ I4 00540000 C GATH = GATHER OR SHOTPOINT ORDER I4 00550000 C IC = UNRESERVED SCRATCH TRACE-BLOCK INDEX I4 00560000 C INTF = FLAG INDICATING INTERPOLATION IS NECESSARY ON I4 00570000 C PARAMETERS 00580000 C LLOCAL = LENGTH OF DLOCAL ( =100) I4 00590000 C LRANG = 3-D LINE RANGE I2 00600000 C MAXNTR = MAXIMUM NUMBER OF TRACES IN ANY ONE FILTER PANEL SET I4 00610000 C MUTE = AMOUNT OF MUTE, IN SAMPLES, TO APPLY AFTER MOVEOUT I4 00620000 C MTFLG = FLAG TO REAPPLY MUTES AFTER FILTER I4 00630000 C MXNPAN = MAXIMUM NUMBER OF PANELS IN ANY SET I4 00640000 C NOPAR = NUMBER OF PARAMETERS I4 00650000 C NOSAMP = NUMBER OF SAMPLE POINTS I4 00660000 C NOWDS = APPROXIMATE NUMBER OF WORDS OF MEMORY NEEDED FOR I4 00670000 C THIS PROCESS 00680000 C NS = NUMBER OF SHOT OR DEPTH POINTS IN PSHOT I4 00690000 C NTRO = COUNT OF FILTER PANELS THAT HAVE BEEN OUTPUT I4 00700000 C NUMOP = RESERVED COMMON INDEX FOR FIRST WORD TRANSMITTED TO I4 00710000 C TO 3838 00720000 C NWORDS = NUMBER OF WORDS TRANSMITTED TO 3838 FOR OPERATORS I4 00730000 C OPER = RESERVED COMMON INDEX FOR START OF OPERATORS I4 00740000 C PMODE = PROCESSING MODE I4 00750000 C RANG = POINTER TO PROCESSING RANGE I4 00760000 C RANGE = POINTER TO END OF PROCESSING RANGE I4 00770000 C RANGM1 = RANGE - 1 I4 00780000 C RLENG = RECORD LENGTH I4 00790000 C SAMPR = SAMPLE INTERVAL IN MS. I4 00800000 C SEQDA = DISK ADDRESS FOR SEQUENTIAL WRITE I4 00810000 C SHOT = ENERGY SOURCE POINT NUMBER I4 00820000 C SHOTL = LAST SHOT POINT I4 00830000 C SHOTT = EITHER CDP OR SHOTPOINT NUMBER I4 00840000 C SPLOCN = SHOT POINT LOCATION I4 00850000 C SPT = STARTING POINT I4 00860000 C TAB1 = RESERVED COMMON INDEX FOR FIRST PARAMETER TABLE I4 00870000 C TAB2 = RESERVED COMMON INDEX FOR SECOND PARAMETER TABLE - I4 00880000 C CONVERTED TO AN INCREMENT TABLE. USED ONLY FOR TIME 00890000 C VARYING FILTER APPLICATION 00900000 C TAB3 = RESERVED COMMON INDEX FOR CURRENT PARAMETERS. USED I4 00910000 C ONLY FOR TIME VARYING FILTER APPLICATION 00920000 C THL = TRACE HEADER LENGTH IN WORDS I4 00930000 C TICD = TRACE IDENTIFICATION CODE I4 00940000 C TNS = TOTAL NUMBER OF SHOT OR DEPTH POINTS PROCESSED I4 00950000 C TTEMP = POINTER TO BLANK COMMON TO AREA USED TO SAVE A TRACE I4 00960000 C TTLEN = LENGTH OF TRACE AND HEADER IN BYTES I4 00970000 C WTRDP = REFERENCE WATER DEPTH I4 00980000 C WTRVEL = WATER VELOCITY I4 00990000 C 01000000 C MODFLT = SPECTRUM MODE FOR FILTER PANEL INPUT I4 01010000 C MODOPR = SPECTRUM MODE OF INPUT OPERATOR I4 01020000 C 01030000 C FRHLR = START FREQ FOR SEARCHING FOR HILE NOISE SPIKES (HZ) I4 01040000 C HIREJ = APPROX FREQ BANDWIDTH OF HIGH LINE NOISE TO REJECT I4 01050000 C DBCUT = THRESHOLD CUTOFF LEVEL FOR REJECTING HIGH LINE (DB) I4 01060000 C FREND = END FREQ FOR SEARCHING FOR HIGH LINE NOISE SPIKES I4 01070000 C 01080000 C HPDB = AMP RATIO BETWEEN LOW PASS AND HIGH CUT FREQ POINTS 01090000 C FOR TRAPEZOIDAL AMP SPECTRUM OF FILTER (DB) 01100000 C 01110000 C EJECT 01120000 C ===================================================================== 01130000 C FORMAT OF PARAMETER RECORDS 01140000 C 01150000 C ****** FIRST RECORDS ****** PROCESSING RANGES ****** 01160000 C 01170000 C WORD 1 WORD 2 WORD 3 WORD 4 WORD 5 WORD 6 WORD 7 WORD 8 01180000 C |_______|________|_______|_______|_______|_______|__|_|____|_______| 01190000 C | ALTO | INVOC. | PTS |3D LINE| NOT | # OF |L/|P|NOT | MUTE | 01200000 C |_______|_NUMBER_|_______|_RANGE_|__USED_|_PARMS_|N_|M|USED|__FLAG_| 01210000 C 01220000 C WORD 9 WORD 10 01230000 C |_______|________| 01240000 C | START | END | 01250000 C |SP / DP|SP / DP_| 01260000 C . . . 01270000 C . . . 01280000 C . . . 01290000 C WORD 103WORD 104 01300000 C |_______|________| 01310000 C | START | END | 01320000 C |SP / DP|SP / DP_| 01330000 C 01340000 C 01350000 C 01360000 C *** TM* /TZF/HLR RECORD ** FILTER PARAMETERS ****** 01370000 C 01380000 C WORD 1 WORD 2 WORD 3 WORD 4 WORD 5 WORD 6 WORD 7 WORD 8 01390000 C |_______|________|_______|_______|_______|_______|__|_|____|_______| 01400000 C | ALTO | INVOC. | TM* | START | WLA | # OF |L/|P|NOT | SHOT | 01410000 C |_______|_NUMBER_|TZF/HLR|SP / DP|__FLAG_|_PARMS_|N_|M|USED|_LOCN._| 01420000 C 01430000 C WORD 9 WORD 10 WORD 11 WORD 12 WORD 13 WORD 14 WORD 15 01440000 C |_______|________|_______|_______|_______|_______|_______| 01450000 C |START |OPERATOR| LC | LP | HP | HC |OVERLAP| 01460000 C |TIME 1_|_LENGTH_|_______|_______|_______|_______|_______| 01470000 C . . . . . . . . 01480000 C . . . . . . . . 01490000 C . . . . . . . . 01500000 C WORD 30 WORD 31 WORD 32 WORD 33 WORD 34 WORD 35 WORD 36 01510000 C |_______|________|_______|_______|_______|_______|_______| 01520000 C |START |OPERATOR| LC | LP | HP | HC | NOT | 01530000 C |TIME 4_|_LENGTH_|_______|_______|_______|_______|USED 4_| 01540000 C 01550000 C WORD 37 WORD 38 WORD 39 WORD 40 WORD 41 WORD 42 WORD 43 RD 104 01560000 C |_______|________|_______|_______|_________________|______ |_______| 01570000 C | WATER | WATER | HPDB | FRHLR | HIREJ |DBCUT | FREND | NOT | 01580000 C |_DEPTH_|_VEL.___|_______| ..... |__USED__|________|_______| USED | 01590000 C 01600000 C EJECT 01610000 C 01620000 C ****** PAN RECORD ****** FILTER PANEL PARAMETERS ****** 01630000 C 01640000 C WORD 1 WORD 2 WORD 3 WORD 4 WORD 5 WORD 6 WORD 7 WORD 8 01650000 C |_______|________|_______|_______|_______|_______|__|_|____|_______| 01660000 C | ALTO | INVOC. | PAN | START | END | # OF |N |P|NOT | SHOT | 01670000 C |_______|_NUMBER_|_______|SP / DP|SP / DP|_PARMS_|__|M|USED|_LOCN._| 01680000 C 01690000 C WORD 9 01700000 C |_______| 01710000 C | TM* | 01720000 C |TZF/COR| 01730000 C 01740000 C WORD 10 WORD 11 WORD 12 WORD 13 WORD 14 01750000 C |_______|________|_______|_______|________| 01760000 C | LOW | LOW | HIGH | HIGH |OPERATOR| 01770000 C |__CUT__|__PASS__|_PASS__|_CUT___|_LENGTH_| 01780000 C . . . . . 01790000 C . . . . . 01800000 C . . . . . 01810000 C WORD 100 WORD 104 01820000 C |_______|________|_______|_______|________| 01830000 C | LOW | LOW | HIGH | HIGH |OPERATOR| 01840000 C |__CUT__|__PASS__|_PASS__|_CUT___|_LENGTH_| 01850000 C 01860000 C 01870000 C 01880000 C ****** OPR RECORD ****** FILTER PARAMETERS FOR INPUT OPERATOR ***** 01890000 C 01900000 C WORD 1 WORD 2 WORD 3 WORD 4 WORD 5 WORD 6 WORD 7 WORD 8 01910000 C |_______|________|_______|_______|_______|_______|__|_|____|_______| 01920000 C | ALTO | INVOC. | OPR | START | END | # OF |N |P|NOT | SHOT | 01930000 C |_______|_NUMBER_|_______|SP / DP|SP / DP|_PARMS_|__|M|USED|_LOCN._| 01940000 C 01950000 C WORD 9 WORD 10 WORD 11 WORD12 01960000 C |_______|________|_______|_______| 01970000 C |START | DA OF | # OF |OVERLAP| 01980000 C |TIME 1_|OPERATOR|POINTS_|_______| 01990000 C . . . . 02000000 C . . . . 02010000 C . . . . 02020000 C WORD 21 WORD 22 WORD 23 WORD 24 02030000 C |_______|________|_______|_______| 02040000 C |START | DA OF | # OF | NOT | 02050000 C |TIME 4_|OPERATOR|POINTS_|_USED 4| 02060000 C 02070000 C WORD 25 WORD 26 WORD 27 ..... WORD 104 02080000 C |_______|________|_______| ..... |_______| 02090000 C | WATER | WATER | NOT | ..... | NOT | 02100000 C |_DEPTH_|_VEL.___|__USED_| ..... |__USED_| 02110000 C 02120000 C EJECT 02130000 C 02140000 C ****** OPH/OPF RECORD ****** INPUT OPERATOR COEFFIEICNTS ****** 02150000 C 02160000 C WORD 1 WORD 2 WORD 3 WORD 4 WORD 5 WORD 6 WORD 7 WORD 8 02170000 C |_______|________|_______|_______|_______|_______|__|_|____|_______| 02180000 C | ALTO | INVOC. |OPH/OPF| NOT | TM* | # OF |N |P|NOT | ID | 02190000 C |_______|_NUMBER_|_______|__USED_|TZF/COR|_PARMS_|__|M|USED|_______| 02200000 C 02210000 C WORD 9 ...... WORD 104 02220000 C |_______| ...... |_______| 02230000 C | COEFF | ...... | COEFF | 02240000 C |_______| ...... |_______| 02250000 C 02260000 C ===================================================================== 02270000 C EJECT 02280000 C ===================================================================== 02290000 C LAYOUT OF BLANK COMMON 02300000 C 02310000 C ________________________________ 02320000 C | 100 WORDS FOR | 02330000 C | LOCAL VARIABLES | 02340000 C | ("DLOCAL") | 02350000 C | | 02360000 C |______________________________| 02370000 C RANG --> | STARTING AND ENDING SHOT | 02380000 C | POINTS TO BE PROCESSED | 02390000 C | . | 02400000 C | . | 02410000 C RANGE --> |______________________________| 02420000 C DAT --> | DISK ADDRESS POINTER | 02430000 C | SPLOCN | 02440000 C | . | 02450000 C | . | 02460000 C | . | 02470000 C DATEND --> |______________________________| 02480000 C TAB1 --> | TABLE OF FILTER VALUES ON | 02490000 C | LEFT | 02500000 C | | 02510000 C | | 02520000 C |______________________________| 02530000 C TAB2 --> | TABLE OF FILTER INCREMENT | 02540000 C | VALUES (NOT ALLOCATED FOR | 02550000 C | FILTER PANELS OR INPUT OP) | 02560000 C |______________________________| 02570000 C TAB3 --> | TABLE OF INTERPOLATED | 02580000 C | FILTER VALUES (NOT ALLOCATED | 02590000 C |FOR FILTER PANELS OR INPUT OP)| 02600000 C |______________________________| 02610000 C TTEMP --> | TRACE SAVE AREA | 02620000 C | | 02630000 C | | 02640000 C |______________________________| 02650000 C 02660000 C====================================================================== 02670000 C EJECT 02680000 C 02690000 SUBROUTINE SDALTO (INH, INTR, OH, OTR) 02700000 C 02710000 IMPLICIT INTEGER (A-Z) 02720000 C 02730000 C COMMON /P/ STATEMENTS GENERATED BY UTCGI4 11/23/83 02740000 COMMON /P/ STARTP ( 2) , M00000( 10) 02750000 C REAL *8 STARTP 02760000 COMMON /P/ LCTPSP , M00048( 4) 02770000 COMMON /P/ LCMXFD 02780000 COMMON /P/ LCANSP 02790000 COMMON /P/ LCMXLN , M00076( 11) 02800000 COMMON /P/ ACLNAM ( 5) , M00124( 68) 02810000 COMMON /P/ KPNA 02820000 COMMON /P/ KPRNO , M00420( 5) 02830000 COMMON /P/ KPWRKS 02840000 COMMON /P/ KPWRKD , M00448( 4) 02850000 COMMON /P/ KPFCF 02860000 COMMON /P/ KPIRSM , M00472 02870000 COMMON /P/ KPIUSM 02880000 COMMON /P/ KPNUSM , M00484 02890000 COMMON /P/ KPRTF , M00492 02900000 COMMON /P/ KPMOTF , M00500( 4) 02910000 COMMON /P/ KPLOTF 02920000 COMMON /P/ KPMITF 02930000 COMMON /P/ KPPRNT , M00528( 2) 02940000 COMMON /P/ KPBUGF , M00540( 226) 02950000 COMMON /P/ ENDP 02960000 C 02970000 COMMON /SYSTEM/ SYSTEM,SYBYPW,SYLOCF 02980000 C 02990000 COMMON COM (1) 03000000 REAL XCOM(1) 03010000 EQUIVALENCE (COM(1), XCOM(1)) 03020000 C 03030000 C=================================================================== 03040000 C 03050000 C REAL ARRAYS IN PARAMETER LIST. 03060000 C 03070000 REAL INTR(1) 03080000 REAL OTR (1) 03090000 C 03100000 C INTEGER ARRAYS IN PARAMETER LIST. 03110000 C 03120000 INTEGER INH(1) 03130000 INTEGER OH (1) 03140000 C 03150000 C INTEGER ARRAYS--LOCAL 03160000 C 03170000 INTEGER DATTR ( 96) 03180000 INTEGER DENTRY (104) 03190000 INTEGER DEPTHP ( 2) 03200000 INTEGER FILNO ( 2) 03210000 INTEGER DCTYP 03220000 INTEGER OPF 03230000 INTEGER OPH 03240000 INTEGER OPR 03250000 INTEGER PAN 03260000 INTEGER PTS 03270000 INTEGER TYPE 03280000 INTEGER TZF 03290000 INTEGER DLOCAL (100) 03300000 INTEGER IND ( 8) 03310000 INTEGER PAR ( 12) 03320000 INTEGER PSHOT ( 24) 03330000 INTEGER SHOTPT ( 2) 03340000 INTEGER TYPPNT ( 2) 03350000 C 03360000 C REAL ARRAYS LOCAL 03370000 REAL XLOCAL (100) 03380000 EQUIVALENCE (DLOCAL(1), XLOCAL(1)) 03390000 C 03400000 C DENTRY IS AN ARRAY TO HOLD A PARAMETER RECORD. THE DEFINITIONS 03410000 C OF THE FIRST EIGHT WORDS ARE FIXED. THE REMAINING WORDS ARE 03420000 C FOR VARIABLE PARAMETERS AND ARE USUALLY ADDRESSED USING "DATTR". 03430000 C THE MAXIMUM LENGTH OF DENTRY IS 104 BECAUSE OF THE I/O ROUTINES. 03440000 C 03450000 EQUIVALENCE (DCTYP , DENTRY (03)) 03460000 EQUIVALENCE (SPT , DENTRY (04)) 03470000 EQUIVALENCE (LRANG , DENTRY (04)) 03480000 EQUIVALENCE (EPT , DENTRY (05)) 03490000 EQUIVALENCE (NOPAR , DENTRY (06)) 03500000 EQUIVALENCE (PMODE , DENTRY (07)) 03510000 EQUIVALENCE (SPLOCN , DENTRY (08)) 03520000 EQUIVALENCE (DATTR(1) , DENTRY (09)) 03530000 C 03540000 C DLOCAL IS AN ARRAY USED TO HOLD PARAMETER VALUES THAT ARE UNIQUE 03550000 C TO EACH OCCURRENCE OF THE PROCESS. 03560000 C 03570000 EQUIVALENCE (TYPE , DLOCAL (01)) 03580000 EQUIVALENCE (RANG , DLOCAL (02)) 03590000 EQUIVALENCE (RANGE , DLOCAL (03)) 03600000 EQUIVALENCE (RANGM1 , DLOCAL (04)) 03610000 EQUIVALENCE (DAT , DLOCAL (05)) 03620000 EQUIVALENCE (DATEND , DLOCAL (06)) 03630000 EQUIVALENCE (GATH , DLOCAL (07)) 03640000 EQUIVALENCE (PANELF , DLOCAL (08)) 03650000 EQUIVALENCE (POS1 , DLOCAL (09)) 03660000 EQUIVALENCE (POS2 , DLOCAL (10)) 03670000 EQUIVALENCE (NUMOP , DLOCAL (11)) 03680000 EQUIVALENCE (TGATE , DLOCAL (12)) 03690000 EQUIVALENCE (NWORDS , DLOCAL (13)) 03700000 EQUIVALENCE (NWDM15 , DLOCAL (14)) 03710000 CBOK 03720000 EQUIVALENCE (MODFLT , DLOCAL (15)) 03730000 EQUIVALENCE (MODOPR , DLOCAL (16)) 03740000 CBOKEND 03750000 EQUIVALENCE (MXNPAN , DLOCAL (17)) 03760000 EQUIVALENCE (OPER , DLOCAL (18)) 03770000 EQUIVALENCE (NALTO , DLOCAL (19)) 03780000 EQUIVALENCE (INTF , DLOCAL (20)) 03790000 EQUIVALENCE (TTEMP , DLOCAL (21)) 03800000 EQUIVALENCE (TAB1 , DLOCAL (22)) 03810000 EQUIVALENCE (TAB2 , DLOCAL (23)) 03820000 EQUIVALENCE (TAB3 , DLOCAL (24)) 03830000 EQUIVALENCE (THL , DLOCAL (25)) 03840000 EQUIVALENCE (NOSAMP , DLOCAL (26)) 03850000 EQUIVALENCE (SAMPR , DLOCAL (27)) 03860000 EQUIVALENCE (RLENG , DLOCAL (28)) 03870000 EQUIVALENCE (SEQDA , DLOCAL (29)) 03880000 EQUIVALENCE (DAWRK , DLOCAL (30)) 03890000 EQUIVALENCE (NTRO , DLOCAL (31)) 03900000 EQUIVALENCE (SHOTL , DLOCAL (32)) 03910000 EQUIVALENCE (POSL , DLOCAL (33)) 03920000 EQUIVALENCE (INTFLG , DLOCAL (34)) 03930000 CBOK 03940000 EQUIVALENCE (FRHLR , DLOCAL (35)) 03950000 EQUIVALENCE (HIREJ , DLOCAL (36)) 03960000 EQUIVALENCE (DBCUT , DLOCAL (37)) 03970000 CBOKEND 03980000 EQUIVALENCE (TYPPNT(1) , DLOCAL (38)) 03990000 EQUIVALENCE (PAR(1) , DLOCAL (40)) 04000000 EQUIVALENCE (NS , DLOCAL (52)) 04010000 EQUIVALENCE (TNS , DLOCAL (53)) 04020000 EQUIVALENCE (LFOUR , DLOCAL (54)) 04030000 EQUIVALENCE (WTRDP , DLOCAL (55)) 04040000 EQUIVALENCE (WTRVEL , DLOCAL (56)) 04050000 EQUIVALENCE (PSHOT(1) , DLOCAL (57)) 04060000 EQUIVALENCE (LNST , DLOCAL (81)) 04070000 EQUIVALENCE (LNEN , DLOCAL (82)) 04080000 EQUIVALENCE (MTFLG , DLOCAL (83)) 04090000 EQUIVALENCE (LNFLG , DLOCAL (84)) 04100000 EQUIVALENCE (LNNO , DLOCAL (85)) 04110000 EQUIVALENCE (LNKNT , DLOCAL (86)) 04120000 EQUIVALENCE (NLINES , DLOCAL (87)) 04130000 EQUIVALENCE (LNOLD , DLOCAL (88)) 04140000 C 04150000 EQUIVALENCE (APLEN , DLOCAL (89)) 04160000 EQUIVALENCE (APMUT , DLOCAL (90)) 04170000 EQUIVALENCE (FREND , DLOCAL (91)) 04180000 CBOK FOR TRAPEZOIDAL FILTER 04190000 EQUIVALENCE (HPDB , DLOCAL (94)) 04200000 CBOK FOR WATER COLUMN DEREVERBERATION 04210000 CC EQUIVALENCE ( , DLOCAL (91)) 04220000 EQUIVALENCE (WATV , DLOCAL (96)) 04230000 EQUIVALENCE (WATDPTH , DLOCAL (97)) 04240000 EQUIVALENCE (PHNDPTH , DLOCAL (98)) 04250000 EQUIVALENCE (TOPREFL , DLOCAL (99)) 04260000 EQUIVALENCE (BOTREFL , DLOCAL(100)) 04270000 C 04280000 C REAL VARIABLES -- LOCAL 04290000 C 04300000 C MAXIMUM NEGATIVE NUMBER Z80100000 04310000 REAL RMAXNG 04320000 EQUIVALENCE (MAXNG , RMAXNG) 04330000 C MINIMUM POSITIVE NUMBER Z00100000 04340000 REAL RMINPS 04350000 EQUIVALENCE (MINPS , RMINPS) 04360000 REAL T0 04370000 REAL XINT 04380000 REAL FDPWD 04390000 REAL FRGEL 04400000 REAL FSDPT 04410000 CBOK 04420000 REAL FNYQ 04430000 C 04440000 C MISCELLANEOUS 04450000 C 04460000 CHARACTER*8 DDNAME 04470000 C 04480000 C INTEGER VARIABLES AND CONSTANTS--LOCAL 04490000 C 04500000 C MAXIMUM NEGATIVE NUMBER Z80100000 04510000 DATA MAXNG /-2146435072/ 04520000 C MINIMUM POSITIVE NUMBER Z00100000 04530000 DATA MINPS /1048576/ 04540000 DATA OPF /' OPF'/ 04550000 DATA OPH /' OPH'/ 04560000 DATA OPR /' OPR'/ 04570000 DATA PAN /' PAN'/ 04580000 DATA PTS /'PTS '/ 04590000 DATA TZF /' TZF'/ 04600000 CBOK 04610000 DATA TMF /' TMF'/ 04620000 DATA TML /' TML'/ 04630000 DATA TMP /' TMP'/ 04640000 DATA HLR /' HLR'/ 04650000 DATA NON /' NON'/ 04660000 DATA REV /' REV'/ 04670000 DATA COR /' COR'/ 04680000 DATA UNC /' UNC'/ 04690000 CBOKEND 04700000 C 04710000 C INITIALIZATION 04720000 C 04730000 DATA LLOCAL /100/ 04740000 DATA DEPTHP /'DEPT','H PT'/ 04750000 DATA FILNO /'FILE',' NO '/ 04760000 DATA SHOTPT /'SHOT',' PT '/ 04770000 C 04780000 C================================================================== 04790000 C 04800000 C CHECK IF FIRST TIME THROUGH 04810000 C 04820000 IF (KPFCF .EQ. 0) GO TO 260 04830000 C 04840000 DAP = 1 04850000 PANELF = 0 04860000 4 CALL FORP (KPNA, KPRNO, DAP, 104, DENTRY, * 8 )04870000 IF (DCTYP .NE. PAN) GO TO 4 04880000 PANELF = 1 04890000 8 CONTINUE 04900000 C 04910000 C MAKE SURE THE INPUT IS A TRACE 04920000 C 04930000 CALL USRTHV (INH, 'THTICD ', TICD) 04940000 CALL USRTHV (INH, 'THLNNO ', LNNO) 04950000 IF (TICD .NE. 1 .AND. TICD .NE. 2) GO TO 830 04960000 C ==================================================================== 04970000 C INITIALIZATION 04980000 C ============== 04990000 C ==================================================================== 05000000 C 05010000 C FIRST TIME THROUGH 05020000 C 05030000 KPFCF = 0 05040000 DAP = 1 05050000 LNFLG = 0 05060000 MTFLG = 1 05070000 LNOLD = 99999 05080000 LNKNT = 0 05090000 LNST = 0 05100000 LNEN = 0 05110000 NLINES = 0 05120000 C 05130000 CBOK 05140000 MODFLT = -9999 05150000 MODOPR = -9999 05160000 CBOKEND 05170000 C PRINT HEADING 05180000 C 05190000 CALL USPHD (2, ACLNAM,KPNA, KPRNO, 0, 0, KPPRNT) 05200000 C 05210000 C APPROXIMATE THE AMOUNT OF MEMORY REQUIRED FOR 05220000 C THIS PROCESS. 05230000 C 05240000 NOWDS = LLOCAL 05250000 C 05260000 C GET LOCAL MEMORY REQUIREMENTS 05270000 C 05280000 CALL UPRESM (NOWDS) 05290000 IF (NOWDS .EQ. 0) GO TO 820 05300000 IC = KPIUSM 05310000 C ******************************************************************** 05320000 C READ THE PROCESSING RANGES 05330000 C ******************************************************************** 05340000 RANG = IC 05350000 DAP = 1 05360000 C 05370000 10 CALL FORP (KPNA, KPRNO, DAP, 104, DENTRY, * 20 )05380000 IF (DCTYP .NE. PTS) GO TO 10 05390000 IF (IC+NOPAR .GT. KPIUSM+KPNUSM) GO TO 820 05400000 CALL ARMVE(DATTR, COM(IC), NOPAR) 05410000 IC = IC + NOPAR 05420000 RANGE = IC - 1 05430000 C 05440000 C SET 3-D LINE RANGES 05450000 C 05460000 IF (DAP .NE. 2) GO TO 10 05470000 CALL S1MVCH(LRANG,1,LNST,SYBYPW-1,2) 05480000 CALL S1MVCH(LRANG,3,LNEN,SYBYPW-1,2) 05490000 COLD LNST = LRANG(1) 05500000 COLD LNEN = LRANG(2) 05510000 IF (LNST .NE. 0 .AND. LNNO .EQ. 0) WRITE (KPPRNT,9090) 05520000 IF (LNNO .NE. 0) LNFLG = -1 05530000 C 05540000 C SET FLAG TO REAPPLY MUTES 05550000 C 05560000 MTFLG = DENTRY(08) 05570000 C 05580000 GO TO 10 05590000 C 05600000 20 RANGM1 = RANGE - 1 05610000 PANELF = 0 05620000 IF (DCTYP .EQ. PAN) PANELF = 1 05630000 C BUILD DISK ADDRESS TABLES 05640000 C 05650000 DAT = IC 05660000 IC = IC + 2 05670000 SHOTL = -999999999 05680000 DAP = 1 05690000 C ******************************************************************** 05700000 C READ TM*/TZF/HLR OR PAN OR OPR RECORD 05710000 C ******************************************************************** 05720000 C 05730000 C 05740000 30 CALL FORP (KPNA, KPRNO, DAP, 104, DENTRY, * 40 )05750000 IF (DCTYP .EQ. PTS .OR. DCTYP .EQ. OPF .OR. DCTYP .EQ. OPH) 05760000 * GO TO 30 05770000 TYPE = DCTYP 05780000 IF (SPLOCN .EQ. SHOTL) GO TO 30 05790000 IF (IC+1 .GT. KPIUSM+KPNUSM) GO TO 820 05800000 COM(IC) = DAP - 1 05810000 COM(IC+1) = SPLOCN 05820000 IC = IC + 2 05830000 SHOTL = SPLOCN 05840000 GO TO 30 05850000 C 05860000 C SORT THE DISK ADDRESS TABLES 05870000 C 05880000 40 IPS = DAT + 4 05890000 IP = IC - 1 05900000 IF (IPS .GE. IP) GO TO 60 05910000 C 05920000 DO 50 05930000 * J=IPS,IP,2 05940000 C 05950000 DO 50 05960000 * K=IPS,IP,2 05970000 IF (COM(K-1) .LT. COM(K+1)) GO TO 50 05980000 H1 = COM(K-2) 05990000 H2 = COM(K-1) 06000000 COM(K-2) = COM(K) 06010000 COM(K-1) = COM(K+1) 06020000 COM(K) = H1 06030000 COM(K+1) = H2 06040000 C 06050000 50 CONTINUE 06060000 C 06070000 C SET END ENTRIES 06080000 C 06090000 60 COM(DAT) = COM(DAT+2) 06100000 COM(DAT+1) = -999999999 06110000 COM(IC) = COM(IC-2) 06120000 COM(IC+1) = 999999999 06130000 IC = IC + 2 06140000 DATEND = IC - 1 06150000 C 06160000 CALL USRTHV (INH, 'THNS ', NOSAMP) 06170000 CALL USRTHV (INH, 'THL ', THL ) 06180000 CALL USRTHV (INH, 'THSI ', SAMPR) 06190000 SAMPR = SAMPR/1000 06200000 RLENG = NOSAMP * SAMPR 06210000 CALL USRTHV (INH, 'THNHST ', NHST) 06220000 C 06230000 IF (S1CPCH(PMODE, 2, 'D', 1, 1) .EQ. 0) GO TO 70 06240000 IF (S1CPCH(PMODE, 2, 'F', 1, 1) .EQ. 0) GO TO 75 06250000 GATH = 0 06260000 TYPPNT(1) = SHOTPT(1) 06270000 TYPPNT(2) = SHOTPT(2) 06280000 GO TO 80 06290000 C 06300000 70 GATH = 1 06310000 TYPPNT(1) = DEPTHP(1) 06320000 TYPPNT(2) = DEPTHP(2) 06330000 GO TO 80 06340000 75 CONTINUE 06350000 C 06360000 C FILE MODE 06370000 C 06380000 GATH=-1 06390000 TYPPNT(1) = FILNO(1) 06400000 TYPPNT(2) = FILNO(2) 06410000 C 06420000 80 INTFLG = 1 06430000 IF (S1CPCH(PMODE, 1, 'N', 1, 1) .EQ. 0) INTFLG = 2 06440000 IF (LNST .EQ. 0 .AND. LNNO .NE. 0 .AND. GATH .EQ.1) 06450000 * WRITE (KPPRNT,9100) 06460000 C 06470000 C CALCULATE CORE REQUIREMENTS 06480000 C 06490000 TAB1 = IC 06500000 TAB2 = 0 06510000 TAB3 = 0 06520000 IF (PANELF .NE. 0) GO TO 120 06530000 IF (TYPE .EQ. OPR) GO TO 190 06540000 C ##### 06550000 C ##### ALLOCATE SPACE FOR TIME VARYING FILTER APPLICATION 06560000 C ##### 06570000 TAB2 = TAB1 + 30 06580000 TAB3 = TAB2 + 30 06590000 NUMOP = TAB3 + 31 06600000 OPER = NUMOP + 15 06610000 LEN = 0 06620000 DAP = 1 06630000 C 06640000 C READ TZF/TM*/HLR CARD 06650000 C 06660000 C FIND MAXIMUM LENGTH OF TIME GATE + OPERATOR 06670000 C 06680000 90 CALL FORP (KPNA, KPRNO, DAP, 104, DENTRY, * 110 )06690000 CCC IF (DCTYP .NE. TZF) GO TO 90 06700000 CBOK 06710000 C SET FILTER MODE AND HIGH LINE REJECTION 06720000 C 06730000 IF (DCTYP .NE. TZF .AND. DCTYP .NE. TMF .AND. DCTYP .NE. TML .AND.06740000 * DCTYP .NE. TMP .AND. DCTYP .NE. HLR) GO TO 90 06750000 IF (MODFLT .LT. 0) THEN 06760000 MODFLT = 0 06770000 IF (DCTYP .EQ. TMF) MODFLT = 1 06780000 IF (DCTYP .EQ. TML) MODFLT = 2 06790000 IF (DCTYP .EQ. TMP) MODFLT = 3 06800000 IF (DCTYP .EQ. HLR) MODFLT = 9 06810000 C 06820000 HPDB = DATTR(31) 06830000 C 06840000 IF (DCTYP .EQ. HLR) THEN 06850000 FRHLR = DATTR(32) 06860000 HIREJ = DATTR(33) * 2 06870000 DBCUT = DATTR(34) 06880000 FREND = DATTR(35) 06890000 IF (FREND .LE. FRHLR) FREND = 500 / SAMPR 06900000 ENDIF 06910000 ENDIF 06920000 CBOKEND 06930000 WTRDP = DATTR(NOPAR+1) 06940000 DATTR(NOPAR+1) = RLENG 06950000 PREOVP = 0 06960000 C 06970000 DO 100 06980000 * I = 1, NOPAR, 7 06990000 LEN1 = DATTR(I+6) / 2 + PREOVP + SAMPR 07000000 IF (WTRDP .EQ. 0) LEN1 = LEN1 + DATTR(I+7) - DATTR(I) 07010000 IF (WTRDP .NE. 0) LEN1 = LEN1 + RLENG 07020000 LEN1 = LEN1 + DATTR(I+1) 07030000 IF (LEN1 .GT. LEN) LEN = LEN1 07040000 PREOVP = DATTR(I+6) / 2 07050000 C 07060000 100 CONTINUE 07070000 C 07080000 GO TO 90 07090000 C 07100000 110 LEN = LEN / SAMPR 07110000 IF (LEN .LT. 128) LEN = 128 07120000 NALTO = NOPAR / 7 07130000 CALL S1FMAG (LEN, MAG, LFOUR) 07140000 C 07150000 C RESERVE SPACE FOR OPERATORS IN FFT FORMAT 07160000 C 07170000 IC = OPER + NALTO * (LFOUR + 2) 07180000 NWORDS = IC - NUMOP 07190000 GO TO 230 07200000 C ##### ##### 07210000 C ##### ALLOCATE SPACE FOR FILTER PANEL APPLICATION ##### 07220000 C ##### ##### 07230000 120 DAP = 1 07240000 MAXTR = LCTPSP 07250000 IF (GATH .EQ. 1) THEN 07260000 MAXTR = LCMXFD 07270000 IF (NHST .NE. 0) MAXTR = 1 07280000 ENDIF 07290000 MAXNTR = 0 07300000 MXNPAN = 0 07310000 LEN = 0 07320000 N = 96 07330000 C 07340000 C READ PAN RECORD 07350000 C 07360000 C CALCULATE MAXIMUM NUMBER OF PANELS (MXNPAN) FOR 07370000 C ANY ONE PART OF THE DATA SET AND THE MAXIMUM 07380000 C NUMBER OF TRACES (MAXNTR) FOR ANY ONE PART OF THE 07390000 C DATA SET THAT WILL NEED TO BE WRITTEN TO THE WORK 07400000 C FILE. 07410000 C 07420000 130 CALL FORP (KPNA, KPRNO, DAP, 104, DENTRY, * 180 )07430000 C 07440000 140 IF (DCTYP .NE. PAN) GO TO 130 07450000 PANTR = (IABS(EPT - SPT) + 1) * MAXTR 07460000 C 07470000 IF (LNFLG .EQ. 0) GO TO 145 07480000 NLINES = LNEN - LNST + 1 07490000 IF (LNST .EQ. 0) NLINES = LCMXLN 07500000 IF (NLINES .EQ. 0) GO TO 890 07510000 PANTR = PANTR * NLINES 07520000 C 07530000 145 NPAN = (NOPAR - 1) / 5 07540000 IF (NPAN * PANTR .GT. MAXNTR) MAXNTR = NPAN * PANTR 07550000 IF (NPAN .GT. MXNPAN) MXNPAN = NPAN 07560000 N1 = 0 07570000 POSL = SPLOCN 07580000 C 07590000 150 N1 = N1 + NOPAR 07600000 IF (N1 .GT. N) N = N1 07610000 C 07620000 DO 160 07630000 * I = 6, NOPAR, 5 07640000 IF (DATTR(I) .GT. LEN) LEN = DATTR(I) 07650000 C 07660000 160 CONTINUE 07670000 C 07680000 CALL FORP (KPNA, KPRNO, DAP, 104, DENTRY, * 180 )07690000 IF (SPLOCN .NE. POSL .OR. DCTYP .NE. PAN) GO TO 140 07700000 NPAN = NPAN + (NOPAR - 1) / 5 07710000 IF (NPAN * PANTR .GT. MAXNTR) MAXNTR = NPAN * PANTR 07720000 IF (NPAN .GT. MXNPAN) MXNPAN = NPAN 07730000 GO TO 150 07740000 C 07750000 180 NUMOP = TAB1 + N 07760000 OPER = NUMOP + 15 07770000 LFOUR = NOSAMP + LEN / SAMPR 07780000 IF (LFOUR .LT. 128) LFOUR = 128 07790000 CALL S1FMAG (LFOUR, MAG, LFOUR) 07800000 C 07810000 C RESERVE SPACE FOR ONE OPERATOR IN FFT FORMAT 07820000 C 07830000 IF (LFOUR+2 .GE. THL+NOSAMP) IC = OPER + LFOUR + 2 07840000 IF (LFOUR+2 .LT. THL+NOSAMP) IC = OPER + THL + NOSAMP 07850000 NWORDS = IC - NUMOP 07860000 GO TO 230 07870000 C ##### ##### 07880000 C ##### ALLOCATE SPACE FOR INPUT OPERATORS ##### 07890000 C ##### ##### 07900000 190 NUMOP = TAB1 + 17 07910000 OPER = NUMOP + 15 07920000 LEN = 0 07930000 LEN2 = 0 07940000 DAP = 1 07950000 C ******************************************************************** 07960000 C READ OPR RECORD 07970000 C ********************************************************************* 07980000 C FIND MAXIMUM LENGTH OF TIME GATE + OPERATOR 07990000 C 08000000 200 CALL FORP (KPNA, KPRNO, DAP, 104, DENTRY, * 220 )08010000 IF (DCTYP .NE. OPR) GO TO 200 08020000 WTRDP = DATTR(NOPAR+1) 08030000 DATTR(NOPAR+1) = RLENG 08040000 PREOVP = 0 08050000 C 08060000 DO 210 08070000 * I = 1, NOPAR, 4 08080000 LEN1 = DATTR(I+3) / 2 + PREOVP + SAMPR 08090000 IF (WTRDP .EQ. 0) LEN1 = LEN1 + DATTR(I+4) - DATTR(I) 08100000 IF (WTRDP .NE. 0) LEN1 = LEN1 + RLENG 08110000 IF (LEN1 .GT. LEN) LEN = LEN1 08120000 IF (DATTR(I+2) .GT. LEN2) LEN2 = DATTR(I+2) 08130000 PREOVP = DATTR(I+3) / 2 08140000 C 08150000 210 CONTINUE 08160000 C 08170000 GO TO 200 08180000 C 08190000 220 LEN = LEN / SAMPR 08200000 LEN = LEN + LEN2 08210000 IF (LEN .LT. 128) LEN = 128 08220000 CALL S1FMAG (LEN, MAG, LFOUR) 08230000 NALTO = NOPAR / 4 08240000 C 08250000 C RESERVE SPACE FOR OPERATORS IN FFT FORMAT 08260000 C 08270000 IC = OPER + NALTO * (LFOUR + 2) 08280000 NWORDS = IC - NUMOP 08290000 C 08300000 C ALLOCATE SPACE FOR TEMPORARY TRACE/HEADER 08310000 C AND SPACE FOR TIME GATES. 08320000 C 08330000 230 TTEMP = IC 08340000 IC = TTEMP + NOSAMP + THL 08350000 NWDM15 = NWORDS - 15 08360000 TGATE = KPIUSM + KPNUSM - NWDM15 08370000 C 08380000 NOWDS = IC - KPIUSM 08390000 CALL UPRESM(NOWDS) 08400000 IF (NOWDS .EQ. 0) GO TO 820 08410000 C 08420000 SHOTL = -999999 08430000 POSL = -999999 08440000 POS1 = -999999 08450000 POS2 = -999999 08460000 NS = 0 08470000 TNS = 0 08480000 C 08490000 APLEN = 2 * NWORDS + LFOUR - 14 08500000 C 08510000 C TEMP SPACE FOR MUTE OPERATOR 08520000 C 08530000 APMUT = APLEN + 1 08540000 APLEN = APLEN + NWDM15 08550000 C 08560000 XCOM(NUMOP+5) = 1.0 08570000 XCOM(NUMOP+6) = 0.5 08580000 C 08590000 C SET UP FLAGS FOR AMP NORMALIZATION FOR UP TO 4 FILTERS 08600000 C 08610000 COM(NUMOP+7) = 0 08620000 COM(NUMOP+8) = 0 08630000 COM(NUMOP+9) = 0 08640000 COM(NUMOP+10) = 0 08650000 CC 08660000 CC SET UP U ARRAY FOR DETERMINING MUTE MASK 08670000 CC 08680000 CC XCOM(NUMOP+11) = RMINPS 08690000 CC XCOM(NUMOP+12) = 1.0 08700000 CC XCOM(NUMOP+13) = RMAXNG 08710000 CC XCOM(NUMOP+14) = 1.0 08720000 C 08730000 CBOK 08740000 C SET UP U ARRAY FOR PHASE MODES OF UP TO 4 FILTERS 08750000 C 08760000 COM(NUMOP+11) = MODFLT 08770000 COM(NUMOP+12) = MODFLT 08780000 COM(NUMOP+13) = MODFLT 08790000 COM(NUMOP+14) = MODFLT 08800000 IF (KPBUGF .NE. 0) THEN 08810000 WRITE (KPPRNT, 9550) DLOCAL 08820000 CCC WRITE (KPPRNT, 9560) XLOCAL 08830000 CCC WRITE (KPPRNT, 9010) (COM(I), I = KPIRSM, TAB2) 08840000 ENDIF 08850000 CBOKEND 08860000 C 08870000 IF (PANELF .NE. 0) GO TO 240 08880000 C 08890000 C FIX NUMBER OF TIME GATES IN AREA PASSED TO 3838 08900000 C 08910000 COM(NUMOP) = NALTO 08920000 WRITE (KPPRNT, 9000) TYPPNT 08930000 GO TO 270 08940000 C 08950000 C INITIALIZE WORK FILE FOR FILTER(ED DATA) PANELS. 08960000 C THE FIRST MXNPAN RECORDS ARE RESERVED TO HOLD 08970000 C THE OPERATORS. 08980000 C 08990000 240 TTLEN = (THL + NOSAMP) * 4 09000000 IF (4 * (LFOUR + 2) .GT. TTLEN) TTLEN = 4 * (LFOUR + 2) 09010000 C 09020000 MAXNTR = MAXNTR + MXNPAN 09030000 C 09040000 NREC = MAXNTR 09050000 BLKSIZ= TTLEN 09060000 C 09070000 CALL UPAWRK ( NREC, BLKSIZ, 'A', KPWRKS, KPWRKD, DDNAME, 09080000 * ERR , ERIN ) 09090000 IF ( ERR.NE.1 ) GO TO 900 09100000 C 09110000 CALL FOISSD (KPWRKS, TTLEN, 2) 09120000 DAWRK = 1 09130000 C 09140000 DO 250 09150000 * I = 1, MAXNTR 09160000 CALL FOWSSD (KPWRKS, DAWRK, COM(OPER)) 09170000 C 09180000 250 CONTINUE 09190000 C 09200000 CALL FOCSD (KPWRKS) 09210000 CALL FOIDSD (KPWRKD, TTLEN) 09220000 DAWRK = 0 09230000 C 09240000 C FIX NUMBER OF TIME GATES AT 1 AND FFT LENGTH IN 09250000 C AREA PASSED TO 3838. 09260000 C 09270000 COM(NUMOP) = 1 09280000 COM(NUMOP+1) = LFOUR 09290000 C 09300000 GO TO 270 09310000 C 09320000 C ==================================================================== 09330000 C PROCESSES THE DATA 09340000 C ================== 09350000 C ==================================================================== 09360000 C 09370000 C RETRIEVE LOCAL VARIABLES 09380000 C 09390000 260 CALL ARMVE (COM(KPIRSM), DLOCAL, LLOCAL) 09400000 C 09410000 C CHECK FOR NO MORE INPUT 09420000 IF (KPMITF .EQ. 0) GO TO 290 09430000 C 09440000 IF (KPMOTF .EQ. 1) GO TO 440 09450000 C 09460000 270 IF(KPBUGF .EQ. 0) GO TO 280 09470000 C 09480000 C RETRIEVAL OF INFORMATION FROM THE TRACE 09490000 C HEADER. THE VALUE OF 'SHOTT' IS EITHER THE 09500000 C SHOTPOINT NO. OR THE CDP NO. 09510000 C 09520000 280 CALL USRTHV (INH, 'THTICD ', TICD) 09530000 C 09540000 IF (TICD .NE. 1 .AND. TICD .NE. 2) GO TO 840 09550000 C 09560000 CALL USRTHV (INH, 'THSSP ', SHOT) 09570000 CALL USRTHV (INH, 'THCDPN ', CDP) 09580000 CALL USRTHV (INH, 'THFN ', FILE) 09590000 CALL USRTHV (INH, 'THSLN ', POS) 09600000 CALL USRTHV (INH, 'THFLV ', MUTE) 09610000 MUTE = MUTE - 1 09620000 CALL USRTHV (INH, 'THRGEL ', RGEL) 09630000 CALL USRTHV (INH, 'THSDPT ', SDPT) 09640000 CALL USRTHV (INH, 'THDPWD ', DPWD) 09650000 CALL USRTHV (INH, 'THWATV ', WATV) 09660000 CALL USRTHV (INH, 'THLNNO ', LNNO) 09670000 C 09680000 CBOK FOR REMOVING GEOPHONE RESPONSE REVERBERATIONS IN WATER COLUMN 09690000 C ASSUMING WATER SURF REFL. 0.95 AND BOTTOM REFLECTION 0.02 09700000 C 09710000 CALL USRTHV (INH, 'THWDPR ', WATDPTH) 09720000 CALL USRTHV (INH, 'THRGEL ', PHNDPTH) 09730000 PHNDPTH = - PHNDPTH 09740000 CALL USRTHV (INH, 'THSCLE ', ELEVSCL) 09750000 CBOK ??????????????????????????????????????????????? 09760000 C TEMPORARY FOR MILLER'S DATA 09770000 C 09780000 IF (ELEVSCL .GT. 0) THEN 09790000 PHNDPTH = PHNDPTH * ELEVSCL 09800000 WATDPTH = WATDPTH * ELEVSCL 09810000 ENDIF 09820000 IF (ELEVSCL .LT. 0) THEN 09830000 PHNDPTH =-PHNDPTH / ELEVSCL 09840000 WATDPTH =-WATDPTH / ELEVSCL 09850000 ENDIF 09860000 C ????????????????????????????????????????????????? 09870000 C 09880000 IF (WATDPTH .EQ. 0) WATDPTH = PHNDPTH 09890000 IF (WATV .LE. 0) WATV = 4920 09900000 TOPREFL = 90 09910000 BOTREFL = 20 09920000 C 09930000 IF (LNFLG .NE. 0 .AND. LNNO .NE. LNOLD) LNFLG = -1 09940000 IF (GATH .NE. 1 ) LNFLG = 0 09950000 CBOK ??????????????????????????????????????????????????/ 09960000 C TEST HIGH LINE NOISE REJECTION 09970000 C 09980000 CC CALL ARSET (INTR, NOSAMP, 0.1E-19) 09990000 CC DO 17 I=1,1 10000000 CC 17 INTR(I*500/SAMPR) = 0.1E+10 10010000 CC DO 17 I=1,NOSAMP 10020000 CC 17 INTR(I) = INTR(I) + 1.E4 *(SIN (I*3.14159/2.0) 10030000 CC * + SIN (I*3.14159/8.0) ) 10040000 C 10050000 C 10060000 CBOK ??????????????????????????????????????????????????/ 10070000 CBOKEND 10080000 CBOKEND 10090000 C 10100000 SHOTT = SHOT 10110000 IF (GATH.NE.-1) GO TO 285 10120000 SHOTT=FILE 10130000 POS=FILE 10140000 GO TO 290 10150000 285 CONTINUE 10160000 IF (GATH .NE. 1) GO TO 290 10170000 SHOTT = CDP 10180000 POS = CDP 10190000 C 10200000 290 IF (PANELF .EQ. 0) GO TO 490 10210000 C 10220000 C ************************************************************** 10230000 C ***** ***** 10240000 C ***** OPTION A: FILTER(ED DATA SET) PANELS ***** 10250000 C ***** ***** 10260000 C ************************************************************** 10270000 C 10280000 IF (KPMITF .EQ. 0) GO TO 420 10290000 C 10300000 C CHECK 3-D LINE RANGE - EITHER ON THE FIRST FILTER CARD 10310000 C OR THE MAXIMUM NO. OF 3-D LINES ON THE LINE CARD 10320000 C 10330000 IF (LNNO .EQ. 0 .OR. GATH .NE. 1 ) GO TO 295 10340000 IF (LNNO .NE. LNOLD) LNKNT = LNKNT + 1 10350000 IF (LNST .NE. 0) GO TO 294 10360000 IF (LNKNT .GT. NLINES) GO TO 305 10370000 GO TO 295 10380000 C 10390000 294 IF (LNNO .LT. LNST .OR. LNNO .GT. LNEN) GO TO 305 10400000 C 10410000 295 IF (SHOTT .EQ. SHOTL) GO TO 370 10420000 IF (KPBUGF .NE. 0) WRITE (KPPRNT, 9036) SHOTT 10430000 C 10440000 C 10450000 C IS SHOT OR DEPTH POINT TO BE PROCESSED 10460000 C 10470000 DO 300 10480000 * I = RANG, RANGE, 2 10490000 IF (COM(I) .LE. SHOTT .AND. SHOTT .LE. COM(I+1)) GO TO 310 10500000 IF (COM(I) .GE. SHOTT .AND. SHOTT .GE. COM(I+1)) GO TO 310 10510000 C 10520000 300 CONTINUE 10530000 C 10540000 IF (LNNO .NE. 0) GO TO 307 10550000 C 10560000 305 IF (DAWRK .NE. 0) GO TO 430 10570000 C 10580000 307 KPRTF = 0 10590000 GO TO 800 10600000 C 10610000 310 SHOTL = SHOTT 10620000 C 10630000 IF (POS1 .LE. SHOTT .AND. SHOTT .LE. POS2) GO TO 370 10640000 IF (POS1 .GE. SHOTT .AND. SHOTT .GE. POS2) GO TO 370 10650000 IF (DAWRK .NE. 0) GO TO 430 10660000 C 10670000 C NEED A NEW SET OF OPERATORS 10680000 C 10690000 DO 320 10700000 * I = DAT, DATEND, 2 10710000 IF (COM(I+1) .LE. POS .AND. POS .LT. COM(I+3)) GO TO 330 10720000 C 10730000 320 CONTINUE 10740000 C 10750000 330 POSL = COM(I+1) 10760000 DA1 = COM(I) 10770000 N = 0 10780000 CALL FORP (KPNA, KPRNO, DA1, 104, DENTRY, * 340 )10790000 POS1 = SPT 10800000 POS2 = EPT 10810000 IC = TAB1 10820000 C 10830000 340 N = N + NOPAR - 1 10840000 CALL ARMVE (DATTR(2), COM(IC), NOPAR-1) 10850000 IC = IC + NOPAR - 1 10860000 CALL FORP (KPNA, KPRNO, DA1, 104, DENTRY, * 350 )10870000 IF (SPT .EQ. POS1) GO TO 340 10880000 C 10890000 350 IPS = TAB1 10900000 IP = IPS + N - 1 10910000 DAWRK1 = 1 10920000 C 10930000 BULK = KPIUSM + 1 10940000 W = BULK + APLEN 10950000 LW = KPNUSM + KPIUSM - W 10960000 C 10970000 C GENERATE OPERATORS AND CONVERT (ONE AT A TIME) TO 10980000 C FREQUENCY DOMAIN. TRANSFORMED OPERATOR IS THEN 10990000 C STORED ON THE WORK FILE. 11000000 C 11010000 DO 360 11020000 * I = IPS, IP, 5 11030000 COM(I+4) = COM(I+4) / SAMPR 11040000 IF (MOD(COM(I+4),2) .EQ. 0) COM(I+4) = COM(I+4) + 1 11050000 KPRTF = 0 11060000 CALL ARSET (COM(OPER), LFOUR, 0) 11070000 CC CALL S2CSRJ (COM(OPER), COM(I+4), SAMPR, COM(I), COM(I+1), 11080000 CC * COM(I+2), COM(I+3), KPPRNT) 11090000 FNYQ = 500.0/SAMPR 11100000 NFFT = LFOUR 11110000 IF (LW .LT. 2*NFFT) GO TO 820 11120000 CALL ARSET (XCOM(W), 2*NFFT, 0.0) 11130000 CALL SABBAND (FLOAT(COM(I)), FLOAT(COM(I+1)), FLOAT(COM(I+2)),11140000 * FLOAT(COM(I+3)),FLOAT(HPDB), FNYQ, NFFT, XCOM(W), 1) 11150000 CALL MFORSP (MAG, XCOM(W), XCOM(W+NFFT), +1) 11160000 C 11170000 C 11180000 C 11190000 CALL ARMVE (XCOM(W), XCOM(OPER+NFFT/2), NFFT/2) 11200000 CALL ARMVE (XCOM(W+NFFT/2), XCOM(OPER), NFFT/2) 11210000 C 11220000 C 11230000 C 11240000 IF (KPBUGF .NE. 0) THEN 11250000 M1 = NUMOP 11260000 M2 = NUMOP + 483 11270000 WRITE (KPPRNT, 9510) MODFLT 11280000 WRITE (KPPRNT, 9550) DLOCAL 11290000 IF (KPBUGF .GE. 2) THEN 11300000 WRITE (KPPRNT, 9550) (COM(M),M=M1,M2) 11310000 WRITE (KPPRNT, 9560) (XCOM(M),M=M1,M2) 11320000 ENDIF 11330000 ENDIF 11340000 CALL UPFFTF (DLOCAL,XCOM(BULK),XCOM(BULK), 11350000 * XCOM(BULK),XCOM(W),LW) 11360000 C 11370000 IF (KPBUGF .GE. 2) THEN 11380000 M1 = NUMOP + 15 11390000 M2 = M1 + LFOUR - 1 11400000 WRITE (KPPRNT, 9510) MODFLT 11410000 WRITE (KPPRNT, 9560) (XCOM(M),M=M1,M2) 11420000 ENDIF 11430000 IF (LW .LE. 0) GO TO 815 11440000 C 11450000 CALL FOWDSD (KPWRKD, DAWRK1, COM(OPER)) 11460000 C 11470000 360 CONTINUE 11480000 C 11490000 IP = TAB1 + 3 11500000 WRITE (KPPRNT, 9020) TYPPNT, (COM(I), I = TAB1, IP) 11510000 NALTO = N / 5 11520000 DAWRK = MXNPAN + 1 11530000 370 IF (TGATE .LE. KPIUSM) GO TO 820 11540000 DAWRK1 = 1 11550000 C 11560000 C APPLY THE FIRST OPERATOR 11570000 C 11580000 CALL ARMVE (INH, OH, THL) 11590000 CALL FORDSD (KPWRKD, DAWRK1, COM(OPER)) 11600000 C 11610000 KPRTF = 0 11620000 CALL ARMVE (INTR, COM(TGATE), NOSAMP) 11630000 CALL ARSET (COM(TGATE+NOSAMP), NWDM15-NOSAMP, 0) 11640000 C 11650000 C MEASURE THE AMPLITUDE OF THE TRACE 11660000 C 11670000 C? CALL ARSMFA (INTR, NOSAMP, SUM) 11680000 C 11690000 C? IF (APFLAG .EQ. 0) 11700000 C? * CALL ARCON (COM(OPER),NPTS,COM(KPIUSM),COM(IC1),LEN,0) 11710000 C 11720000 BULK = KPIUSM + 1 11730000 W = BULK + APLEN 11740000 LW = TGATE- W 11750000 C 11760000 C 11770000 CBOK DEBUG 11780000 IF (KPBUGF .GE. 2) THEN 11790000 M1 = TGATE 11800000 M2 = M1 + LFOUR - 1 11810000 WRITE (KPPRNT, 9560) (XCOM(M),M=M1,M2) 11820000 ENDIF 11830000 CBOKEND 11840000 CALL UPFFTI (DLOCAL,XCOM(BULK),XCOM(BULK), 11850000 * XCOM(BULK),XCOM(W),LW) 11860000 C 11870000 CBOK DEBUG 11880000 IF (KPBUGF .GE. 2) THEN 11890000 M1 = TGATE 11900000 M2 = M1 + LFOUR - 1 11910000 WRITE (KPPRNT, 9560) (XCOM(M),M=M1,M2) 11920000 ENDIF 11930000 CBOKEND 11940000 IF (LW .LE. 0) GO TO 815 11950000 C 11960000 C 11970000 CALL ARMVE (COM(TGATE), OTR, NOSAMP) 11980000 FN = ((COM(TAB1) + COM(TAB1+1)) / 2) * 1000 + 11990000 * (COM(TAB1+2) + COM(TAB1+3)) / 2 12000000 CALL USSTHV (OH, 'THFN ', FN) 12010000 C 12020000 C RESTORE AMPLITUDE TO ORIGINAL LEVEL 12030000 C 12040000 C? CALL ARSMFA (OTR, NOSAMP, WFAC) 12050000 C? IF (WFAC .EQ. 0) GO TO 375 12060000 C? WFAC = SUM / WFAC 12070000 C? CALL ARMPFC (OTR, OTR, WFAC, NOSAMP) 12080000 C 12090000 C 12100000 IF (LNFLG .GE. 0) GO TO 378 12110000 C 12120000 IF (NS .NE. 0) WRITE (KPPRNT, 9030) TNS, (PSHOT(I),I=1,NS) 12130000 WRITE (KPPRNT, 9035) LNNO 12140000 LNOLD = LNNO 12150000 LNFLG = 1 12160000 NS = 0 12170000 GO TO 380 12180000 C 12190000 378 IF (NS .EQ. 0) GO TO 380 12200000 IF (PSHOT(NS) .EQ. SHOTT) GO TO 390 12210000 IF (NS .NE. 24) GO TO 380 12220000 WRITE (KPPRNT, 9030) TNS, PSHOT 12230000 NS = 0 12240000 C 12250000 380 NS = NS + 1 12260000 TNS = TNS + 1 12270000 PSHOT(NS) = SHOTT 12280000 C 12290000 C NOW DO THE OTHER FILTER(ED DATASET) PANELS 12300000 C 12310000 390 CALL ARMVE (INH, COM(TTEMP), THL) 12320000 IP = NALTO - 1 12330000 IC = TAB1 + 5 12340000 C 12350000 BULK = KPIUSM + 1 12360000 W = BULK + APLEN 12370000 LW = TGATE- W 12380000 C 12390000 DO 410 12400000 * I = 1, IP 12410000 CALL FORDSD (KPWRKD, DAWRK1, COM(OPER)) 12420000 KPRTF = 0 12430000 CALL ARMVE (INTR, COM(TGATE), NOSAMP) 12440000 CALL ARSET (COM(TGATE+NOSAMP), NWDM15-NOSAMP, 0) 12450000 C 12460000 CBOK DEBUG 12470000 IF (KPBUGF .GE. 2) THEN 12480000 M1 = TGATE 12490000 M2 = M1 + LFOUR - 1 12500000 WRITE (KPPRNT, 9560) (XCOM(M),M=M1,M2) 12510000 ENDIF 12520000 CBOKEND 12530000 CALL UPFFTI (DLOCAL,XCOM(BULK),XCOM(BULK), 12540000 * XCOM(BULK),XCOM(W),LW) 12550000 C 12560000 CBOK DEBUG 12570000 IF (KPBUGF .GE. 2) THEN 12580000 M1 = TGATE 12590000 M2 = M1 + LFOUR - 1 12600000 WRITE (KPPRNT, 9560) (XCOM(M),M=M1,M2) 12610000 ENDIF 12620000 CBOKEND 12630000 IF (LW .LE. 0) GO TO 815 12640000 C 12650000 CALL ARMVE (COM(TGATE), COM(TTEMP+THL), NOSAMP) 12660000 C 12670000 C RESTORE AMPLITUDE TO ORIGINAL LEVEL 12680000 C 12690000 C? CALL ARSMFA (OTR, NOSAMP, WFAC) 12700000 C? IF (WFAC .EQ. 0) GO TO 405 12710000 C? WFAC = SUM / WFAC 12720000 C? CALL ARMPFC (OTR, OTR, WFAC, NOSAMP) 12730000 C 12740000 C STORE TRACE ON WORK FILE 12750000 C 12760000 CALL FOWDSD (KPWRKD, DAWRK, COM(TTEMP)) 12770000 IC = IC + 5 12780000 C 12790000 410 CONTINUE 12800000 C 12810000 KPRTF = 1 12820000 C 12830000 GO TO 800 12840000 C 12850000 C THIS CODE IS EXECUTED AFTER THE LAST TRACE HAS BEEN 12860000 C INPUT. IT DUMPS, BY FILTER PANEL, THE TRACES 12870000 C WHICH ARE ON THE WORK FILE. 12880000 C 12890000 420 IF (KPMOTF .NE. 0) GO TO 440 12900000 IF (DAWRK .NE. 0) GO TO 430 12910000 C 12920000 GO TO 790 12930000 C 12940000 C PASS FILTERED DATA SET PANELS TO WORK FILE 12950000 C 12960000 C SAVE INPUT TRACE 12970000 C 12980000 430 CALL ARMVE(INH, COM(TTEMP), NOSAMP+THL) 12990000 SEQDA = DAWRK - 1 13000000 DAWRK = MXNPAN + 1 13010000 KPMOTF = 1 13020000 NTRO = 1 13030000 IF (LNFLG .EQ. 0 .OR. GATH .NE. 1) GO TO 450 13040000 LNFLG = -1 13050000 LNOLD = 99999 13060000 GO TO 450 13070000 C 13080000 C GET NEXT DISK ADDRESS AND PASS THE TRACE 13090000 C 13100000 440 DAWRK = DAWRK + NALTO - 1 13110000 IF (DAWRK .LE. SEQDA) GO TO 460 13120000 NTRO = NTRO + 1 13130000 IF (NTRO .GE. NALTO) GO TO 480 13140000 DAWRK = MXNPAN + NTRO 13150000 C 13160000 450 IF (NS .NE. 0) WRITE (KPPRNT, 9030) TNS, (PSHOT(I),I=1,NS) 13170000 IPS = TAB1 + 5 * NTRO 13180000 IP = IPS + 3 13190000 WRITE (KPPRNT, 9020) TYPPNT, (COM(I), I = IPS, IP) 13200000 NS = 0 13210000 C 13220000 460 DAWRK1 = DAWRK 13230000 CALL FORDSD (KPWRKD, DAWRK1, COM(OPER)) 13240000 CALL ARMVE (COM(OPER), OH, NOSAMP+THL) 13250000 KPRTF = 1 13260000 IF (GATH .EQ. 0) CALL USRTHV (OH, 'THSSP ', SHOTT) 13270000 IF (GATH .EQ. 1) CALL USRTHV (OH, 'THCDPN ', SHOTT) 13280000 IF (GATH .EQ. -1) CALL USRTHV (OH, 'THFN ', SHOTT) 13290000 C 13300000 IK = TAB1 + 5 * NTRO 13310000 FN = ((COM(IK) + COM(IK+1)) / 2) * 1000 + 13320000 * (COM(IK+2) + COM(IK+3)) / 2 13330000 CALL USSTHV (OH, 'THFN ', FN) 13340000 C 13350000 IF (LNFLG .EQ. 0) GO TO 465 13360000 C 13370000 CALL USRTHV (OH, 'THLNNO ', LNNO) 13380000 IF (LNNO .NE. LNOLD) LNFLG = -1 13390000 C 13400000 IF (LNFLG .GE. 0) GO TO 465 13410000 C 13420000 IF (NS .NE. 0) WRITE (KPPRNT, 9030) TNS, (PSHOT(I),I=1,NS) 13430000 WRITE (KPPRNT, 9035) LNNO 13440000 LNOLD = LNNO 13450000 LNFLG = 1 13460000 NS = 0 13470000 GO TO 470 13480000 C 13490000 465 IF (NS .EQ. 0) GO TO 470 13500000 IF (PSHOT(NS) .EQ. SHOTT) GO TO 800 13510000 IF (NS .NE. 24) GO TO 470 13520000 WRITE (KPPRNT, 9030) TNS, PSHOT 13530000 NS = 0 13540000 C 13550000 470 NS = NS + 1 13560000 TNS = TNS + 1 13570000 PSHOT(NS) = SHOTT 13580000 GO TO 800 13590000 C 13600000 480 WRITE (KPPRNT, 9030) TNS,(PSHOT(I), I = 1, NS) 13610000 NS = 0 13620000 KPMOTF = 0 13630000 DAWRK = 0 13640000 SHOTL = -999999 13650000 IF (KPMITF .EQ. 0) GO TO 790 13660000 C RESTORE TRACE 13670000 CALL ARMVE (COM(TTEMP), INH, NOSAMP+THL) 13680000 GO TO 280 13690000 C 13700000 490 IF (TYPE .EQ. OPR) GO TO 650 13710000 IF (KPMITF .EQ. 0) GO TO 780 13720000 C 13730000 C ************************************************************** 13740000 C ***** ***** 13750000 C ***** OPTION B: TIME VARYING FILTER ***** 13760000 C ***** ***** 13770000 C ************************************************************** 13780000 C 13790000 C CHECK 3-D LINE RANGE 13800000 C 13810000 IF (LNNO .EQ. 0 .OR. GATH .NE. 1) GO TO 495 13820000 IF (LNST .EQ. 0) GO TO 495 13830000 IF (LNNO .LT. LNST .OR. LNNO .GT. LNEN) GO TO 505 13840000 C 13850000 495 IF (SHOTT .EQ. SHOTL) GO TO 530 13860000 C 13870000 DO 500 13880000 * I = RANG, RANGM1, INTFLG 13890000 IF (COM(I) .LE. SHOTT .AND. SHOTT .LE. COM(I+1)) GO TO 510 13900000 IF (COM(I) .GE. SHOTT .AND. SHOTT .GE. COM(I+1)) GO TO 510 13910000 C 13920000 500 CONTINUE 13930000 C 13940000 505 KPRTF = 2 13950000 GO TO 800 13960000 C 13970000 510 SHOTL = SHOTT 13980000 C 13990000 530 IF (POS .EQ. POSL) GO TO 618 14000000 POSL = POS 14010000 C CHECK FOR CORRECT TABLES 14020000 IF (POS1 .LE. POS .AND. POS .LT. POS2) GO TO 570 14030000 C 14040000 C SEARCH FOR A NEW SET OF TABLES 14050000 C 14060000 DO 540 14070000 * I = DAT, DATEND, 2 14080000 IF (COM(I+1) .LE. POS .AND. POS .LT. COM(I+3)) GO TO 550 14090000 C 14100000 540 CONTINUE 14110000 C 14120000 550 POS1 = COM(I+1) 14130000 POS2 = COM(I+3) 14140000 DA1 = COM(I) 14150000 DA2 = COM(I+2) 14160000 CALL FORP (KPNA, KPRNO, DA1, 104, DENTRY, * 570 )14170000 WTRDP = DATTR(NOPAR+1) 14180000 IF (WTRDP .NE. 0) NOPAR = NOPAR + 2 14190000 CALL ARMVE (DATTR(1), COM(TAB1), NOPAR) 14200000 CALL FORP (KPNA, KPRNO, DA2, 104, DENTRY, * 570 )14210000 WTRDP = DATTR(NOPAR+1) 14220000 IF (WTRDP .NE. 0) NOPAR = NOPAR + 2 14230000 CALL ARMVE (DATTR(1), COM(TAB2), NOPAR) 14240000 C 14250000 C CONVERT TAB2 TO INCREMENT TABLE 14260000 C 14270000 XINT = 1. / (POS2 - POS1) 14280000 INTF = 0 14290000 C 14300000 DO 560 14310000 * I = 1, NOPAR 14320000 XCOM(TAB2+I-1) = XINT * (COM(TAB2+I-1) - COM(TAB1+I-1)) 14330000 IF (XCOM(TAB2+I-1) .NE. 0.) INTF = 1 14340000 C 14350000 560 CONTINUE 14360000 C 14370000 GO TO 580 14380000 C 14390000 570 IF (INTF .EQ. 0) GO TO 610 14400000 C 14410000 C INTERPOLATE FOR CURRENT PARAMETERS 14420000 C 14430000 580 XINT = POS - POS1 14440000 IP = 7 * NALTO 14450000 IF (WTRDP .NE. 0) IP = IP + 2 14460000 KPRTF = 0 14470000 C 14480000 DO 590 14490000 * I = 1, IP 14500000 COM(TAB3+I-1) = COM(TAB1+I-1) + XINT * XCOM(TAB2+I-1) 14510000 C 14520000 590 CONTINUE 14530000 14540000 IF (WTRDP .NE. 0) WTRVEL = COM(TAB3+IP-1) 14550000 IF (WTRDP .NE. 0) WTRDP = COM(TAB3+IP-2) 14560000 C 14570000 C NOW GENERATE OPERATORS 14580000 C 14590000 IPS = TAB3 14600000 IP = IPS + 7 * NALTO - 1 14610000 COM(IP+1) = RLENG 14620000 PREOVP = 0 14630000 IC = OPER 14640000 J = 1 14650000 K = NUMOP + 1 14660000 C SET POINTERS FIRST 14670000 C 14680000 BULK = KPIUSM + 1 14690000 W = BULK + APLEN 14700000 LW = KPNUSM + KPIUSM - W 14710000 DO 600 14720000 * I = IPS, IP, 7 14730000 COM(I+1) = COM(I+1) / SAMPR 14740000 IF (MOD(COM(I+1),2) .EQ. 0) COM(I+1) = COM(I+1) + 1 14750000 LEN = (COM(I+7)-COM(I)+COM(I+6)/2+PREOVP+SAMPR) / SAMPR 14760000 IF (I .EQ. IPS .AND. WTRDP .NE. 0) 14770000 * LEN = (RLENG + COM(I+6) / 2 + PREOVP + SAMPR) / SAMPR 14780000 C 14790000 C GET FFT LENGTH = WINDOW + OPERATOR 14800000 C 14810000 LEN = LEN + COM(I+1) 14820000 IF (LEN .LT. 128) LEN = 128 14830000 CALL S1FMAG (LEN, MAG, LFOUR) 14840000 C 14850000 C SAVE FFT LENGTH FOR 3838 14860000 C 14870000 COM(K) = LFOUR 14880000 K = K + 1 14890000 CALL ARSET (COM(IC), LFOUR, 0) 14900000 C 14910000 C CREATE TIME-DOMAIN OPERATOR WITH ZERO TIME AT FIRST SAMPLE 14920000 C FOR ZERO-PHASE BAND 14930000 C 14940000 CC CALL S2CSRJ (COM(IC), COM(I+1), SAMPR, COM(I+2), COM(I+3), 14950000 CC * COM(I+4), COM(I+5), KPPRNT) 14960000 FNYQ = 500.0/SAMPR 14970000 NFFT = LFOUR 14980000 IF (LW .LT. 2*NFFT) GO TO 820 14990000 CALL ARSET (XCOM(W), 2*NFFT, 0.0) 15000000 CALL SABBAND(FLOAT(COM(I+2)),FLOAT(COM(I+3)), FLOAT(COM(I+4)),15010000 * FLOAT(COM(I+5)),FLOAT(HPDB), FNYQ, NFFT, XCOM(W), 1) 15020000 CALL MFORSP (MAG, XCOM(W), XCOM(W+NFFT), +1) 15030000 C 15040000 C 15050000 C 15060000 CALL ARMVE (XCOM(W), XCOM(IC+NFFT/2), NFFT/2) 15070000 CALL ARMVE (XCOM(W+NFFT/2), XCOM(IC), NFFT/2) 15080000 C 15090000 C 15100000 IC = IC + LFOUR + 2 15110000 PAR(J) = COM(I) 15120000 PAR(J+1) = COM(I+1) * SAMPR 15130000 PAR(J+2) = COM(I+6) 15140000 J = J + 3 15150000 PREOVP = COM(I+6) / 2 15160000 C 15170000 600 CONTINUE 15180000 C 15190000 CC SET POINTERS FIRST 15200000 CC 15210000 CC BULK = KPIUSM + 1 15220000 CC W = BULK + APLEN 15230000 CC LW = KPNUSM + KPIUSM - W 15240000 C TRANSFORM ALL OPERATORS TO FREQUENCY DOMAIN 15250000 C 15260000 IF (KPBUGF .NE. 0) THEN 15270000 M1 = NUMOP 15280000 M2 = NUMOP + 483 15290000 WRITE (KPPRNT, 9520) MODFLT 15300000 WRITE (KPPRNT, 9550) DLOCAL 15310000 IF (KPBUGF .GE. 2) THEN 15320000 WRITE (KPPRNT, 9550) (COM(M),M=M1,M2) 15330000 WRITE (KPPRNT, 9560) (XCOM(M),M=M1,M2) 15340000 ENDIF 15350000 ENDIF 15360000 CALL UPFFTF (DLOCAL,XCOM(BULK),XCOM(BULK), 15370000 * XCOM(BULK),XCOM(W),LW) 15380000 C 15390000 IF (KPBUGF .GE. 2) THEN 15400000 M1 = NUMOP + 15 15410000 M2 = M1 + LFOUR - 1 15420000 WRITE (KPPRNT, 9520) MODFLT 15430000 WRITE (KPPRNT, 9560) (XCOM(M),M=M1,M2) 15440000 ENDIF 15450000 IF (LW .LE. 0) GO TO 815 15460000 C 15470000 C% 15480000 C% IC=NUMOP 15490000 C% IC1=NUMOP+NWORDS 15500000 C% WRITE (KPPRNT,9990) (XCOM(I),I=IC,IC1) 15510000 C% IC=KPIUSM 15520000 C% IC1=IC+LFOUR+1 15530000 C% WRITE (KPPRNT,9990) (XCOM(I),I=IC,IC1) 15540000 C% IC=IC1+1 15550000 C% IC1=IC+LFOUR+1 15560000 C% WRITE (KPPRNT,9990) (XCOM(I),I=IC,IC1) 15570000 C% IC=IC1+1 15580000 C% IC1=IC+LFOUR+1 15590000 C% WRITE (KPPRNT,9990) (XCOM(I),I=IC,IC1) 15600000 C% IF (SHOTT .GE. 3) STOP 666 15610000 C9990 FORMAT ('0',8(2X,E14.8)) 15620000 C% 15630000 C 15640000 C MEASURE THE AMPLITUDE OF THE TRACE 15650000 C 15660000 C?610 CALL ARSMFA (INTR, NOSAMP, SUM) 15670000 C 15680000 C CALCULATE THE TIME ADJUSTMENT FOR THE WATER LAYER 15690000 C 15700000 610 IF (WTRDP .EQ. 0 .OR. NALTO .EQ. 1) GO TO 618 15710000 IF (WTRVEL .EQ. 0) WTRVEL = WATV 15720000 IF (WTRVEL .EQ. 0) GO TO 860 15730000 IF (RGEL .EQ. -9999) RGEL = 0 15740000 FRGEL = RGEL 15750000 FSDPT = SDPT 15760000 FDPWD = DPWD - WTRDP 15770000 C 15780000 C CALCULATE THE WATER LAYER TRAVEL TIME ADJUSTMENT 15790000 C 15800000 T0 = (2.0 * FDPWD - FSDPT + FRGEL) / WTRVEL * 1000. 15810000 IF (T0 .GE. 0.0) T0 = T0 + 0.5 15820000 IF (T0 .LT. 0.0) T0 = T0 - 0.5 15830000 C 15840000 C ADJUST THE APPLICATION START TIMES 15850000 C 15860000 DO 615 15870000 * I = 1, NALTO 15880000 IF (I .EQ. 1) GO TO 615 15890000 J = 3 * I - 2 15900000 K = TAB3 + (I - 1) * 7 15910000 PAR(J) = COM(K) + T0 15920000 IF (PAR(J) .GT. RLENG) GO TO 870 15930000 IF (PAR(J) .LT. 0) GO TO 880 15940000 C 15950000 615 CONTINUE 15960000 C 15970000 C NOW SPLIT THE TRACE INTO INDIVIDUAL WINDOWS 15980000 C 15990000 618 HIND = TGATE - 1 16000000 KPRTF = 0 16010000 IND(1) = KPIUSM 16020000 CALL USTSPL (INTR,RLENG,SAMPR,COM(1),NALTO,PAR,3,HIND,IND, * 820 )16030000 C 16040000 C NOW PUT WINDOWS IN FORMAT FOR FFT 16050000 C 16060000 IC = TGATE 16070000 CALL ARSET (COM(IC), NWDM15, 0) 16080000 K = NUMOP + 1 16090000 C 16100000 DO 620 16110000 * I=1, NALTO 16120000 IC1 = IND(2*I-1) 16130000 LEN = IND(2*I) - IC1 + 1 16140000 LFOUR = COM(K) 16150000 CALL ARMVE (COM(IC1), COM(IC), LEN) 16160000 CALL ARSET (COM(IC+LEN), LFOUR-LEN+2, 0) 16170000 C 16180000 C RESET INDEXES FOR USE IN RECOMBINING THE TRACE 16190000 C 16200000 IND(2*I-1) = IC 16210000 IC = IC + LFOUR + 2 16220000 IND(2*I) = IC - 1 16230000 K = K + 1 16240000 C 16250000 620 CONTINUE 16260000 C 16270000 C NOW APPLY OPERATORS 16280000 C 16290000 C? IF (APFLAG .EQ. 0) 16300000 C? * CALL ARCON (COM(IC2),COM(J+1),COM(IC),COM(IC1),LEN,0) 16310000 C 16320000 BULK = KPIUSM + 1 16330000 W = BULK + APLEN 16340000 LW = TGATE- W 16350000 C 16360000 C 16370000 CBOK DEBUG 16380000 IF (KPBUGF .GE. 2) THEN 16390000 M1 = TGATE 16400000 M2 = M1 + LFOUR - 1 16410000 WRITE (KPPRNT, 9560) (XCOM(M),M=M1,M2) 16420000 ENDIF 16430000 CBOKEND 16440000 CALL UPFFTI (DLOCAL,XCOM(BULK),XCOM(BULK), 16450000 * XCOM(BULK),XCOM(W),LW) 16460000 C 16470000 CBOK DEBUG 16480000 IF (KPBUGF .GE. 2) THEN 16490000 M1 = TGATE 16500000 M2 = M1 + LFOUR - 1 16510000 WRITE (KPPRNT, 9560) (XCOM(M),M=M1,M2) 16520000 ENDIF 16530000 CBOKEND 16540000 IF (LW .LE. 0) GO TO 815 16550000 C 16560000 C NOW RECOMBINE THE TRACE 16570000 C 16580000 CALL USCOMB (OTR, RLENG, SAMPR, COM(1), NALTO, PAR, 3, 16590000 * HIND, IND) 16600000 CALL ARMVE (INH, OH, THL) 16610000 C 16620000 C RESTORE AMPLITUDE TO ORIGINAL LEVEL 16630000 C 16640000 C? CALL ARSMFA (OTR, NOSAMP, WFAC) 16650000 C? IF (WFAC .EQ. 0) GO TO 625 16660000 C? WFAC = SUM / WFAC 16670000 C? CALL ARMPFC (OTR, OTR, WFAC, NOSAMP) 16680000 C 16690000 C KEEP TRACK OF SHOT/DEPTH POINTS PROCESSED 16700000 C 16710000 C 16720000 IF (LNFLG .GE. 0) GO TO 625 16730000 C 16740000 IF (NS .NE. 0) WRITE (KPPRNT, 9030) TNS, (PSHOT(I),I=1,NS) 16750000 WRITE (KPPRNT, 9035) LNNO 16760000 LNOLD = LNNO 16770000 LNFLG = 1 16780000 NS = 0 16790000 GO TO 630 16800000 C 16810000 625 IF (NS .EQ. 0) GO TO 630 16820000 IF (PSHOT(NS) .EQ. SHOTT) GO TO 640 16830000 IF (NS .NE. 24) GO TO 630 16840000 WRITE (KPPRNT, 9030) TNS, PSHOT 16850000 NS = 0 16860000 C 16870000 630 NS = NS + 1 16880000 TNS = TNS + 1 16890000 PSHOT(NS) = SHOTT 16900000 C 16910000 640 KPRTF = 1 16920000 GO TO 800 16930000 C 16940000 C ************************************************************** 16950000 C ***** ***** 16960000 C ***** OPTION C: INPUT OPERATORS ***** 16970000 C ***** ***** 16980000 C ************************************************************** 16990000 C 17000000 650 IF (KPMITF .EQ. 0) GO TO 780 17010000 C 17020000 C CHECK 3-D LINE RANGE 17030000 C 17040000 IF (LNNO .EQ. 0 .OR. GATH .NE. 1) GO TO 655 17050000 IF (LNST .EQ. 0) GO TO 655 17060000 IF (LNNO .LT. LNST .OR. LNNO .GT. LNEN) GO TO 665 17070000 C 17080000 655 IF (SHOTT .EQ. SHOTL) GO TO 740 17090000 C 17100000 C IS SHOT OR DEPTH POINT TO BE PROCESSED 17110000 C 17120000 DO 660 17130000 * I = RANG, RANGE, 2 17140000 IF (COM(I) .LE. SHOTT .AND. SHOTT .LE. COM(I+1)) GO TO 670 17150000 IF (COM(I) .GE. SHOTT .AND. SHOTT .GE. COM(I+1)) GO TO 670 17160000 C 17170000 660 CONTINUE 17180000 C 17190000 665 KPRTF = 2 17200000 GO TO 800 17210000 C 17220000 670 SHOTL = SHOTT 17230000 C 17240000 IF (POS1 .LE. SHOTT .AND. SHOTT .LE. POS2) GO TO 731 17250000 IF (POS1 .GE. SHOTT .AND. SHOTT .GE. POS2) GO TO 731 17260000 C 17270000 C NEED A NEW SET OF OPERATORS 17280000 C 17290000 DO 680 17300000 * I = DAT, DATEND, 2 17310000 IF (COM(I+1) .LE. POS .AND. POS .LT. COM(I+3)) GO TO 690 17320000 C 17330000 680 CONTINUE 17340000 C 17350000 690 DA1 = COM(I) 17360000 CALL FORP (KPNA, KPRNO, DA1, 104, DENTRY, * 700 )17370000 C 17380000 700 POS1 = SPT 17390000 POS2 = EPT 17400000 C 17410000 CALL ARMVE (DATTR(1), COM(TAB1), NOPAR) 17420000 COM(TAB1+NOPAR) = RLENG 17430000 WTRDP = DATTR(NOPAR + 1) 17440000 WTRVEL = DATTR(NOPAR + 2) 17450000 C 17460000 KPRTF = 0 17470000 PREOVP = 0 17480000 C 17490000 C GET OPERATORS 17500000 C 17510000 IPS = TAB1 17520000 IP = IPS + NOPAR - 1 17530000 IC = OPER 17540000 J = 1 17550000 K = NUMOP + 1 17560000 C 17570000 C =================================================================== 17580000 C DO LOOP 17590000 C 17600000 DO 730 17610000 * I = IPS, IP, 4 17620000 LEN = (COM(I+4)-COM(I)+COM(I+3)/2+PREOVP+SAMPR) / SAMPR 17630000 IF (I .EQ. IPS .AND. WTRDP .NE. 0) 17640000 * LEN = (RLENG + COM(I+3) / 2 + PREOVP + SAMPR) / SAMPR 17650000 LEN = LEN + COM(I+2) 17660000 IF (LEN .LT. 128) LEN = 128 17670000 CALL S1FMAG (LEN, MAG, LFOUR) 17680000 COM(K) = LFOUR 17690000 K = K + 1 17700000 CALL ARSET (COM(IC), LFOUR, 0) 17710000 DA1 = COM(I+1) 17720000 CALL FORP (KPNA, KPRNO, DA1, 104, DENTRY, * 730 )17730000 FLID = SPLOCN 17740000 IC1 = IC 17750000 C SET FLAG FOR SYMMETRIC OR NON-SYMMETRIC OPERATOR 17760000 COM(K+5) = 2 17770000 IF (DCTYP .EQ. OPH) COM(K+5) = 1 17780000 CBOK 17790000 C SET MODOPR = 0 (TZF), 1 (TMF), 2 (TML), 3 (TMP), 17800000 C MODOPR = 5 (COR), -1(NON), -2 (REV), 17810000 C MODOPR = 6 (UNC) 17820000 C 17830000 IF (MODOPR .LT.-9) THEN 17840000 MODOPR = -1 17850000 IF (DENTRY(05) .EQ. REV) MODOPR = -2 17860000 IF (DENTRY(05) .EQ. TZF) MODOPR = 0 17870000 IF (DENTRY(05) .EQ. TMF) MODOPR = 1 17880000 IF (DENTRY(05) .EQ. TML) MODOPR = 2 17890000 IF (DENTRY(05) .EQ. TMP) MODOPR = 3 17900000 IF (DENTRY(05) .EQ. COR) MODOPR = 5 17910000 IF (DENTRY(05) .EQ. UNC) MODOPR = 6 17920000 ENDIF 17930000 IF (KPBUGF .NE. 0) THEN 17940000 WRITE (KPPRNT, 9550) DLOCAL 17950000 CCC WRITE (KPPRNT, 9560) XLOCAL 17960000 CCC WRITE (KPPRNT, 9010) (COM(I), I = KPIRSM, TAB2) 17970000 ENDIF 17980000 CBOKEND 17990000 C 18000000 710 CALL ARMVE (DATTR(1), COM(IC1), NOPAR) 18010000 IC1 = IC1 + NOPAR 18020000 CALL FORP (KPNA, KPRNO, DA1, 104, DENTRY, * 720 )18030000 IF (SPLOCN .EQ. FLID) GO TO 710 18040000 C 18050000 720 IC = IC + LFOUR + 2 18060000 PAR(J) = COM(I) 18070000 PAR(J+1) = COM(I+2) * SAMPR 18080000 PAR(J+2) = COM(I+3) 18090000 J = J + 3 18100000 PREOVP = COM(I+3) / 2 18110000 C 18120000 730 CONTINUE 18130000 CBOK 18140000 C SET FILTER PHASE MODE FOR UP TO FOUR OPERATORS 18150000 C 18160000 COM(NUMOP+11) = MODOPR 18170000 COM(NUMOP+12) = MODOPR 18180000 COM(NUMOP+13) = MODOPR 18190000 COM(NUMOP+14) = MODOPR 18200000 CBOKEND 18210000 C 18220000 C ==================================================================== 18230000 C 18240000 C TRANSFORM INPUT OPERATORS AFTER SETTING INDEXES/FLAGS 18250000 C 18260000 BULK = KPIUSM + 1 18270000 W = BULK + APLEN 18280000 LW = KPNUSM + KPIUSM - W 18290000 C 18300000 C 18310000 C TRANSFORM INPUT OPERATORS 18320000 C 18330000 C 18340000 CBOK DEBUG 18350000 IF (KPBUGF .NE. 0) THEN 18360000 M1 = NUMOP 18370000 M2 = NUMOP + 473 18380000 WRITE (KPPRNT, 9530) MODOPR 18390000 WRITE (KPPRNT, 9550) DLOCAL 18400000 IF (KPBUGF .GE. 2) THEN 18410000 WRITE (KPPRNT, 9550) (COM(M),M=M1,M2) 18420000 WRITE (KPPRNT, 9560) (XCOM(M),M=M1,M2) 18430000 ENDIF 18440000 ENDIF 18450000 CALL UPFFTF (DLOCAL,XCOM(BULK),XCOM(BULK), 18460000 * XCOM(BULK),XCOM(W),LW) 18470000 C 18480000 CBOK DEBUG 18490000 IF (KPBUGF .GE. 2) THEN 18500000 M1 = NUMOP + 15 18510000 M2 = M1 + LFOUR - 1 18520000 WRITE (KPPRNT, 9530) MODOPR 18530000 WRITE (KPPRNT, 9560) (XCOM(M),M=M1,M2) 18540000 ENDIF 18550000 IF (LW .LE. 0) GO TO 815 18560000 C 18570000 C CALCULATE THE TIME ADJUSTMENT FOR THE WATER LAYER 18580000 C 18590000 731 IF (WTRDP .EQ. 0 .OR. NALTO .EQ. 1) GO TO 740 18600000 IF (WTRVEL .EQ. 0) WTRVEL = WATV 18610000 IF (WTRVEL .EQ. 0) GO TO 860 18620000 IF (RGEL .EQ. -9999) RGEL = 0 18630000 FRGEL = RGEL 18640000 FSDPT = SDPT 18650000 FDPWD = DPWD - WTRDP 18660000 C 18670000 C CALCULATE THE WATER LAYER TRAVEL TIME ADJUSTMENT 18680000 C 18690000 T0 = (2.0 * FDPWD - FSDPT + FRGEL) / WTRVEL * 1000. 18700000 IF (T0 .GE. 0.0) T0 = T0 + 0.5 18710000 IF (T0 .LT. 0.0) T0 = T0 - 0.5 18720000 C 18730000 C ADJUST THE APPLICATION START TIMES 18740000 C 18750000 DO 735 18760000 * I = 2, NALTO 18770000 J = 3 * I 18780000 K = TAB1 + (I - 1) * 4 18790000 PAR(J) = COM(K) + T0 18800000 IF (PAR(J) .GT. RLENG) GO TO 870 18810000 IF (PAR(J) .LT. 0) GO TO 880 18820000 C 18830000 735 CONTINUE 18840000 C 18850000 C NOW SPLIT THE TRACE INTO INDIVIDUAL WINDOWS 18860000 C 18870000 740 HIND = TGATE - 1 18880000 KPRTF = 0 18890000 IND(1) = KPIUSM 18900000 CALL USTSPL (INTR,RLENG,SAMPR,COM(1),NALTO,PAR,3,HIND,IND, * 820 )18910000 C 18920000 C NOW PUT WINDOWS IN FORMAT FOR FFT 18930000 C 18940000 IC = TGATE 18950000 CALL ARSET (COM(IC), NWDM15, 0) 18960000 K = NUMOP + 1 18970000 C 18980000 DO 750 18990000 * I=1, NALTO 19000000 IC1 = IND(2*I-1) 19010000 LEN = IND(2*I) - IC1 + 1 19020000 LFOUR = COM(K) 19030000 CALL ARMVE (COM(IC1), COM(IC), LEN) 19040000 CALL ARSET (COM(IC+LEN), LFOUR-LEN+2, 0) 19050000 IND(2*I-1) = IC 19060000 IC = IC + LFOUR + 2 19070000 IND(2*I) = IC - 1 19080000 K = K + 1 19090000 C 19100000 750 CONTINUE 19110000 C 19120000 C NOW APPLY OPERATORS 19130000 C 19140000 C 19150000 BULK = KPIUSM + 1 19160000 W = BULK + APLEN 19170000 LW = TGATE- W 19180000 C 19190000 CBOK DEBUG 19200000 IF (KPBUGF .GE. 2) THEN 19210000 M1 = TGATE 19220000 M2 = M1 + LFOUR - 1 19230000 WRITE (KPPRNT, 9560) (XCOM(M),M=M1,M2) 19240000 ENDIF 19250000 CBOKEND 19260000 CALL UPFFTI (DLOCAL,XCOM(BULK),XCOM(BULK), 19270000 * XCOM(BULK),XCOM(W),LW) 19280000 C 19290000 CBOK DEBUG 19300000 IF (KPBUGF .GE. 2) THEN 19310000 M1 = TGATE 19320000 M2 = M1 + LFOUR - 1 19330000 WRITE (KPPRNT, 9560) (XCOM(M),M=M1,M2) 19340000 ENDIF 19350000 CBOKEND 19360000 IF (LW .LE. 0) GO TO 815 19370000 C 19380000 C NOW RECOMBINE THE TRACE 19390000 C 19400000 CALL USCOMB (OTR, RLENG, SAMPR, COM(1), NALTO, PAR, 3, 19410000 * HIND, IND) 19420000 CALL ARMVE (INH, OH, THL) 19430000 C 19440000 C KEEP TRACK OF SHOT/DEPTH POINTS PROCESSED 19450000 C 19460000 IF (LNFLG .GE. 0) GO TO 755 19470000 C 19480000 IF (NS .NE. 0) WRITE (KPPRNT, 9030) TNS, (PSHOT(I),I=1,NS) 19490000 WRITE (KPPRNT, 9035) LNNO 19500000 LNOLD = LNNO 19510000 LNFLG = 1 19520000 NS = 0 19530000 GO TO 760 19540000 C 19550000 755 IF (NS .EQ. 0) GO TO 760 19560000 IF (PSHOT(NS) .EQ. SHOTT) GO TO 770 19570000 IF (NS .NE. 24) GO TO 760 19580000 WRITE (KPPRNT, 9030) TNS, PSHOT 19590000 NS = 0 19600000 C 19610000 760 NS = NS + 1 19620000 TNS = TNS + 1 19630000 PSHOT(NS) = SHOTT 19640000 C 19650000 770 KPRTF = 1 19660000 GO TO 800 19670000 C 19680000 780 WRITE (KPPRNT, 9030) TNS, (PSHOT(I), I = 1, NS) 19690000 C 19700000 790 KPLOTF = 0 19710000 KPMOTF = 0 19720000 KPRTF = 0 19730000 C 19740000 IF (PANELF .NE. 0) THEN 19750000 CALL FOCDD (KPWRKD) 19760000 CALL UGUWRK (KPWRKS, KPWRKD, ERR, ERIN) 19770000 IF (ERR .NE. 1) GO TO 900 19780000 ENDIF 19790000 C 19800000 C 19810000 C SAVE LOCAL VARIABLES 19820000 C 19830000 800 CALL ARMVE (DLOCAL, COM(KPIRSM), LLOCAL) 19840000 C 19850000 C RECOMPUTE FLV FOR THE 'NOMUT' OPTION 19860000 C 19870000 810 IHOLD = 1 19880000 IF( MTFLG .EQ. 0 ) THEN 19890000 DO 812 19900000 * I=1,NOSAMP 19910000 IHOLD = I 19920000 IF ( OTR(IHOLD) .NE. 0.0 ) GO TO 814 19930000 812 CONTINUE 19940000 814 CONTINUE 19950000 CALL USSTHV ( OH, 'THFLV ', IHOLD) 19960000 END IF 19970000 C 19980000 C 19990000 RETURN 20000000 C 20010000 C 20020000 815 WRITE (KPPRNT, 9038) KPNUSM, KPIUSM, APLEN, LW, TGATE 20030000 KPRTF = -1 20040000 GO TO 810 20050000 C 20060000 820 WRITE (KPPRNT, 9040) 20070000 KPRTF = -1 20080000 GO TO 810 20090000 C 20100000 830 KPRTF = 0 20110000 IF (PANELF .EQ. 0) KPRTF = 2 20120000 GO TO 810 20130000 C 20140000 840 KPRTF = 0 20150000 IF (PANELF .EQ. 0) KPRTF = 2 20160000 GO TO 800 20170000 C 20180000 860 WRITE (KPPRNT, 9060) 20190000 KPRTF = -1 20200000 GO TO 810 20210000 C 20220000 870 WRITE (KPPRNT, 9070) SHOTT 20230000 KPRTF = -1 20240000 GO TO 810 20250000 C 20260000 880 WRITE (KPPRNT, 9080) SHOTT 20270000 KPRTF = -1 20280000 GO TO 810 20290000 C 20300000 890 WRITE (KPPRNT, 9110) 20310000 KPRTF = -1 20320000 GO TO 810 20330000 C 20340000 900 WRITE (KPPRNT, 9120) ERR, ERIN 20350000 KPRTF = -1 20360000 GO TO 810 20370000 C 20380000 C FORMAT STATEMENTS 20390000 C 20400000 9000 FORMAT ('-COUNT',4X,2A4,' PROCESSED') 20410000 C 20420000 9010 FORMAT (1X, 20I5) 20430000 C 20440000 9020 FORMAT ('-COUNT',4X,2A4,' PROCESSED',4X,'LC = ',I5, ' LP = ',I5, 20450000 * ' HP = ',I5,' HC = ',I5) 20460000 C 20470000 9030 FORMAT (1X,I4,4(2X,6I5)) 20480000 C 20490000 9035 FORMAT (/5X,'3-D LINE NO. ',I5) 20500000 C 20510000 9036 FORMAT (/5X,'GATHER NO. ',I5) 20520000 C 20530000 9038 FORMAT (5X,'*** NOT ENOUGH MEMORY AVAILABLE: ',5I8,' ***' ) 20540000 C 20550000 9040 FORMAT (5X,'*** NOT ENOUGH MEMORY AVAILABLE ***' ) 20560000 C 20570000 9060 FORMAT (/5X,'*** WATER VELOCITY IS ZERO ***') 20580000 C 20590000 9070 FORMAT (/5X,'*** APPLY START TIME IS BEYOND TRACE LENGTH FOR ', 20600000 * 'SHOT/CDP ',I5) 20610000 C 20620000 9080 FORMAT (/5X,'*** APPLY START TIME IS BEFORE TIME ZERO FOR ', 20630000 * 'SHOT/CDP ',I5) 20640000 C 20650000 9090 FORMAT (/5X,'*** 3-D LINE NOS. DEFINED ON RANGE CARD, BUT TRACE ',20660000 * 'HEADERS HAVE NO 3-D LINE NOS.',/, 9X,'3-D LINE NOS. ON ',20670000 * 'CARD ARE IGNORED.') 20680000 C 20690000 9100 FORMAT (/5X,'*** NO 3-D LINE NOS. DESIGNATED ON THE RANGE CARD, ',20700000 * 'BUT TRACE HEADERS HAVE 3-D LINE NOS.',/, 20710000 * 9X,'FOR NORMAL TZF FILTERS ALL LINES WILL BE PROCESSED.',/,20720000 * 9X,'FOR FILTER PANELS ONLY THE NO. OF LINES CODED ON THE ',20730000 * 'LINE CARD WILL BE PROCESSED.',/) 20740000 C 20750000 9110 FORMAT (//5X,'*** CODE A MAXIMUM NUMBER OF 3-D LINES ON THE ', 20760000 * 'LINE CARD.') 20770000 C 20780000 9120 FORMAT (//5X,'*** UNABLE TO AALOCATE WORKFILE FOR FILTER PANELS', 20790000 * /5X,' SVC99 ERROR CODE =',I5,' REASON CODE =',Z10 )20800000 C 20810000 CBOK 20820000 C 20830000 9510 FORMAT (//5X,' ** FILTERED DATA PANEL OPTION ***' 20840000 * /5X,' FILTER MODE = ', I5) 20850000 9520 FORMAT (//5X,' ** TIME VARYING FILTER OPTION ***' 20860000 * /5X,' FILTER MODE = ', I5) 20870000 9530 FORMAT (//5X,' ** INPUT OPERATOR OPTION ***' 20880000 * /5X,' OPERATOR MODE = ', I5) 20890000 9550 FORMAT (//' INTG',50(2X,10I10/)) 20900000 9560 FORMAT (//' REAL',50(1X,10G12.4/)) 20910000 C 20920000 CBOK 20930000 C 20940000 END 20950000