CTITLESAFXIN0 - TIME VARYING VERSION OF F-X PREDICTIVE FILTERING (RANT) 00010000 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA 00020000 CA AUTHOR D CORRIGAN 00030000 CA DESIGNER D CORRIGAN 00040000 CA LANGUAGE FORTRAN 77 00050000 CA SYSTEM IBM / CRAY 00060000 CA WRITTEN FEBRUARY 1988 00070000 C DATE 02-05-88 TIME VARYING VERSION OF THE 00080000 C RANDOM NOISE ATTENUATION 00090000 C PROGRAM (RANT) 00100000 C FILTER APPLICATION 00110000 C REVISED 02-19-88 TO ADD LOGIC TO ACCOMDATE 00120000 C SINGLE SPATIAL AND TEMPORAL GATES00130000 C REVISED 02-29-88 TO RESTORE ADD-BACK OPTION AS IN 00140000 C RANT 00150000 C REVISED 03-11-88 TO READ THE OUTPUT TRACE INTO 00160000 C SA INSTEAD OF DIRECTLY INTO OTR 00170000 C REVISED 04-07-88 WRF TO READ DATA FROM SEISPARM FILE 00180000 C WRITTEN IN THE PREP STEP 00190000 C REVISED 08-08-88 SSC ADDED MINOR MODIFICATIONS FOR 00200000 C PRODUCTION SPARC RELEASE. 00210000 C REVISED 09-14-88 SSC ADDED 3D LINE PROCESSING. 00220000 C DEFINED 2 NEW DATA FIELDS BLINE &00230000 C ELINE TO READ 3D LINE RANGE. 00240000 C REVISED 11-14-88 CAD MODIFIED TO MEET EDP STANDARDS. 00250000 C CLOSED WORK FILE. REPLACED ESSL 00260000 C CALLS TO SNDOT & SNAXPY BY MATH 00270000 C ADVANTAGE CALLS. 00280000 C REVISED 02-28-89 JJC IMPLEMENTED THE OPTION FOR 00290000 C FREQUENCY RANGE. 00300000 C REVISED 08-29-89 JJC FILTERED THE TRACES OUTSIDE THE 00310000 C FREQUENCY RANGE. 00320000 C REVISED 08-23-90 ESN PASS AUTO3 IN ALL ENTRY POINTS. 00330000 C REVISED 07-10-91 JJC RENAMED RAVE TO FXIN. 00340000 C RENAMED SAFXIN1 TO SAFXINA. 00350000 C RENAMED SAFXIN3 TO SAFXINC. 00360000 C REVISED 02-12-92 JJC REPLACED SYAX BY SSCAL. 00370000 C CHANGED COFGEN TO MCOFGN. 00380000 C ADDED CRAY CAPABILITIES. 00390000 C REVISED 08-27-92 ESN ALLOCATE (NTRC+3)/2 RECORDS IN 00400001 C UPAWRK. 00410000 CA 00420000 CA 00430000 CA CALL SAFXIN0(OH,ICC,AUTO3,IABORT,RA) 00440000 CA CALL SAFXIN1(OH,OTR,VEL,PASS,AUTO3,IABORT,RA,SA) 00450000 CA CALL SAFXIN2(OH,OTR,VEL,PASS,AUTO3,IABORT,RA,SA) 00460000 CA CALL SAFXIN3(OH,OTR,VEL,PASS,AUTO3,IABORT,RA,SA) 00470000 CA 00480000 CA 00490000 C SUBROUTINES CALLED: 00500000 C ARSET 00510000 C CCOPY (IBM-ESSL ROUTINE) 00520000 C FOCDD 00530000 C FOCSD 00540000 C FOIDSD 00550000 C FOISSD 00560000 C FORP 00570000 C FOWDSD 00580000 C FOWSSD 00590000 C SAFXINA 00600000 C SAFXINC 00610000 C SAXPY (IBM-ESSL ROUTINE) 00620000 C SCOPY (IBM-ESSL ROUTINE) 00630000 C SYAX (IBM-ESSL ROUTINE) 00640000 C S2DFI2 00650000 C S2DFT2 00660000 C UPAWRK 00670000 C USRTHV 00680000 C 00690000 C 00700000 C====================================================================== 00710000 C 00720000 C FORMAT OF PARAMETER RECORDS 'PTS ' 00730000 C 00740000 C 00750000 C WORD 1 WORD 2 WORD 3 WORD 4 WORD 5 WORD 6 WORD 7 WORD 8 00760000 C :_______:________:_______:_______:_______:_______:_______:_______: 00770000 C : FXIN : INVOC. : 'PTS ': NOT : NOT : # OF : NOT : NOT : 00780000 C :_______:_NUMBER_:_______:__USED_:__USED_:_PARMS_:__USED_:__USED_: 00790000 C 00800000 C WORD 9 WORD 10 WORD 11 WORD 12 WORD 13 WORD 14 WORD 15 WORD 16 00810000 C :________:_______:________:________:________:_______:_______:_______:00820000 C : START : END :SPATIAL :SPATIAL :TEMPORAL:% WHITE:OUTPUT :% ADD :00830000 C :SP/DP/F :SP/DP/F:GATE LEN:FLTR LEN:GATE LEN:NOISE :SWITCH :BACK :00840000 C 00850000 C WORD 17 WORD 18 WORD 19 WORD 20 WORD 21 WORD 22 WORD 23 WORD 24 00860000 C :________:_______:________:________:________:_______:_______:_______:00870000 C : IMODE : LOW : LOW : HIGH : HIGH : BLINE : ELINE :: 00880000 C :________:__CUT__:__PASS__:__PASS__:_CUT____:_______:_______:_______:00890000 C 00900000 C=======================================================================00910000 C 00920000 C EJECT 00930000 C 00940000 C LAYOUT OF RESERVED BLANK COMMON 00950000 C 00960000 C ________________________________ 00970000 C KPIRSM --> : LLOCAL WORDS FOR : 00980000 C : LOCAL VARIABLES : 00990000 C : ("DLOCAL") : 01000000 C : : 01010000 C :______________________________: 01020000 C IXH --> : NTRC* THL WORDS : 01030000 C : : 01040000 C : : 01050000 C :______________________________: 01060000 C IXW1 --> : LXO WORDS : 01070000 C :______________________________: 01080000 C IXW2 --> : LXO WORDS : 01090000 C :______________________________: 01100000 C ITW1 --> : ITW WORDS : 01110000 C :______________________________: 01120000 C ITW2 --> : ITW WORDS : 01130000 C :______________________________: 01140000 C IXD --> : NTT WORDS : 01150000 C :______________________________: 01160000 C ICC --> : : 01170000 C :______________________________: 01180000 C 01190000 C 01200000 C LAYOUT OF SCRATCH BLANK COMMON 01210000 C 01220000 C :______________________________: 01230000 C KPIUSM --> : : 01240000 C :______________________________: 01250000 C ISR --> : 2 * LX WORDS : 01260000 C :______________________________: 01270000 C ISC --> : 2 * LX WORDS : 01280000 C :______________________________: 01290000 C ISH --> : 2 * LX WORDS : 01300000 C :______________________________: 01310000 C ISA --> : 2 * LX + 2 * MXL WORDS : 01320000 C :______________________________: 01330000 C ISB --> : 2 * LX + 2 * MXL WORDS : 01340000 C :______________________________: 01350000 CDC ISY --> : 2 * LX + 2 * MXL WORDS : 01360000 CDC :______________________________: 01370000 C ISF --> : 2 * LX WORDS : 01380000 C :______________________________: 01390000 CDC ISG --> : 2 * LX WORDS : 01400000 CDC :______________________________: 01410000 C IXI --> : NTT * MXL WORDS : 01420000 C :______________________________: 01430000 C IXF --> : NTT * MXT WORDS : 01440000 C :______________________________: 01450000 CDC IXY --> : NTT * MXT WORDS : 01460000 CDC :______________________________: 01470000 C IXL --> : NTT * LXO WORDS : 01480000 C :______________________________: 01490000 CDC IXU --> : NTT * LXO WORDS : 01500000 CDC :______________________________: 01510000 C IXM --> : NP2 * MXL WORDS : 01520000 C :______________________________: 01530000 CDC IXZ --> : NP2 * MXL WORDS : 01540000 CCC :______________________________: 01550000 C IHS --> : 2 * MXL WORDS : 01560000 C :______________________________: 01570000 C IHN --> : : 01580000 C :______________________________: 01590000 C 01600000 C 01610000 C 01620000 C=======================================================================01630000 C 01640000 SUBROUTINE SAFXIN0(OH,ICC,AUTO3,IABORT,RA) 01650000 IMPLICIT INTEGER (A-Z) 01660000 REAL RA(1),SA(1),VEL(1),OTR(1) 01670000 REAL ABF,ASI,CDF,CDL 01680000 REAL FNT,HMT,OSW,PAB 01690000 REAL PI,PWN,RAT,SFL,SGL 01700000 REAL SPE,SPLOCN,SPT,SR 01710000 REAL TGL,WNF,ZERO 01720000 REAL STARTP,ENDP 01730000 REAL FAB,OH(1) 01740000 REAL SC, FNYQ, DELF 01750000 CDC 01760000 REAL FRNYQ 01770000 REAL DXGRP,XLAST,XTEST,DXT 01780000 REAL LCGRPI 01790000 CDC 01800000 C 01810000 C COMMON /P/ STATEMENTS GENERATED BY UTCGI4 12/12/83 01820000 COMMON /P/ STARTP(2) , M00000( 10) 01830000 COMMON /P/ LCTPSP , M00048( 2) 01840000 COMMON /P/ LCPI 01850000 COMMON /P/ LCGRPI 01860000 COMMON /P/ LCMXFD , M00068( 86) 01870000 COMMON /P/ KPNA 01880000 COMMON /P/ KPRNO , M00420( 5) 01890000 COMMON /P/ KPWRKS 01900000 COMMON /P/ KPWRKD 01910000 COMMON /P/ KPWKS2 01920000 COMMON /P/ KPWKD2 01930000 COMMON /P/ KPWKS3 01940000 COMMON /P/ KPWKD3 , M00464 01950000 COMMON /P/ KPIRSM 01960000 COMMON /P/ KPNRSM 01970000 COMMON /P/ KPIUSM 01980000 COMMON /P/ KPNUSM , M00484( 9) 01990000 COMMON /P/ KPMITF 02000000 COMMON /P/ KPPRNT , M00528( 2) 02010000 COMMON /P/ KPBUGF , M00540( 226) 02020000 COMMON /P/ ENDP 02030000 C 02040000 REAL XATTR (96) 02050000 C 02060000 CHARACTER*8 DDNAME 02070000 CDC 02080000 CHARACTER*8 DDNME2 02090000 CHARACTER*8 SHOTPT 02100000 CHARACTER*8 DEPTH 02110000 CHARACTER*8 FILEN 02120000 CHARACTER*8 LINE3D 02130000 CHARACTER*8 TYPPNT 02140000 CJJ CHARACTER*4 DCTYP 02150000 CJJ CHARACTER*4 PTS 02160000 C 02170000 DIMENSION DATTR(96),DENTRY(104) 02180000 C 02190000 COMMON /HEAD/ ORTN,CDPN,CDPT,TICD,XDST,NS,SI,SSP,FN,THL 02200000 COMMON /USER/ SLOCAL(50), ULOCAL(100) 02210000 C 02220000 C VARIABLE DIRECTORY 02230000 C 02240000 CDC IHN INTERPLOATED DATA I4 02250000 C IHS DATA FOR SINGLE FREQUENCY I4 02260000 C ISA ARRAY FOR INTERMEDIATE RESULT I4 02270000 C ISB ARRAY FOR INTERMEDIATE RESULT I4 02280000 C ISC CROSSCORRELATION I4 02290000 C ISF FILTER I4 02300000 CDC ISG FILTER I4 02310000 C ISH SPATIAL FILTER I4 02320000 C ISR AUTOCORRELATION I4 02330000 CDC ISX ARRAY FOR INTERMEDIATE RESULT I4 02340000 CDC ISY ARRAY FOR INTERMEDIATE RESULT I4 02350000 C LX NO. OF TRACES IN SPATIAL FILTER I4 02360000 C NXI NO. OF TRACES IN DESIGN GATE I4 02370000 C WNF WHITEN NOISE FACTOR R4 02380000 C 02390000 C DENTRY IS AN ARRAY TO HOLD A PARAMETER RECORD. THE DEFINITIONS 02400000 C OF THE FIRST EIGHT WORDS ARE FIXED. THE REMAINING WORDS ARE 02410000 C FOR VARIABLE PARAMETERS AND ARE USUALLY ADDRESSED USING "DATTR". 02420000 C THE MAXIMUM LENGTH OF DENTRY IS 104 BECAUSE OF THE I/O ROUTINES. 02430000 C 02440000 EQUIVALENCE (DCTYP , DENTRY (03)) 02450000 EQUIVALENCE (SPT , DENTRY (04)) 02460000 EQUIVALENCE (SPE , DENTRY (05)) 02470000 EQUIVALENCE (NOPAR , DENTRY (06)) 02480000 EQUIVALENCE (SPLOCN , DENTRY (07)) 02490000 EQUIVALENCE (DATTR(1) , DENTRY (09)) 02500000 C 02510000 EQUIVALENCE (DATTR(1) , XATTR(1)) 02520000 C 02530000 EQUIVALENCE (NBL ,ULOCAL( 1)) 02540000 EQUIVALENCE (SR ,ULOCAL( 2)) 02550000 EQUIVALENCE (IPR ,ULOCAL( 3)) 02560000 EQUIVALENCE (IMODE ,ULOCAL( 4)) 02570000 EQUIVALENCE (NTRC ,ULOCAL( 5)) 02580000 EQUIVALENCE (ITRC ,ULOCAL( 6)) 02590000 EQUIVALENCE (JTRC ,ULOCAL( 7)) 02600000 EQUIVALENCE (KTRC ,ULOCAL( 8)) 02610000 EQUIVALENCE (LTRC ,ULOCAL( 9)) 02620000 EQUIVALENCE (CDF ,ULOCAL(10)) 02630000 EQUIVALENCE (CDL ,ULOCAL(11)) 02640000 EQUIVALENCE (M ,ULOCAL(12)) 02650000 EQUIVALENCE (N ,ULOCAL(13)) 02660000 EQUIVALENCE (NX ,ULOCAL(14)) 02670000 EQUIVALENCE (LX ,ULOCAL(15)) 02680000 EQUIVALENCE (LXH ,ULOCAL(16)) 02690000 EQUIVALENCE (LX2 ,ULOCAL(17)) 02700000 EQUIVALENCE (NT ,ULOCAL(18)) 02710000 EQUIVALENCE (NTW ,ULOCAL(19)) 02720000 EQUIVALENCE (ITW ,ULOCAL(20)) 02730000 EQUIVALENCE (NTT ,ULOCAL(21)) 02740000 EQUIVALENCE (OSW ,ULOCAL(22)) 02750000 EQUIVALENCE (WNF ,ULOCAL(23)) 02760000 EQUIVALENCE (IXH ,ULOCAL(24)) 02770000 EQUIVALENCE (IXW1 ,ULOCAL(25)) 02780000 EQUIVALENCE (IXW2 ,ULOCAL(26)) 02790000 EQUIVALENCE (ITW1 ,ULOCAL(27)) 02800000 EQUIVALENCE (ITW2 ,ULOCAL(28)) 02810000 EQUIVALENCE (IXD ,ULOCAL(29)) 02820000 EQUIVALENCE (NF ,ULOCAL(30)) 02830000 EQUIVALENCE (LXO ,ULOCAL(31)) 02840000 EQUIVALENCE (LO2 ,ULOCAL(32)) 02850000 EQUIVALENCE (ABF ,ULOCAL(33)) 02860000 EQUIVALENCE (BLINE ,ULOCAL(34)) 02870000 EQUIVALENCE (ELINE ,ULOCAL(35)) 02880000 EQUIVALENCE (ILINE ,ULOCAL(36)) 02890000 EQUIVALENCE (FNT ,ULOCAL(37)) 02900000 EQUIVALENCE (IF1 ,ULOCAL(38)) 02910000 EQUIVALENCE (IF2 ,ULOCAL(39)) 02920000 EQUIVALENCE (IF3 ,ULOCAL(40)) 02930000 EQUIVALENCE (IF4 ,ULOCAL(41)) 02940000 EQUIVALENCE (NFR ,ULOCAL(42)) 02950000 EQUIVALENCE (IFB ,ULOCAL(43)) 02960000 EQUIVALENCE (IFE ,ULOCAL(44)) 02970000 CDC 02980000 EQUIVALENCE (LOP ,ULOCAL(45)) 02990000 EQUIVALENCE (IXOP ,ULOCAL(46)) 03000000 EQUIVALENCE (IFNT1 ,ULOCAL(47)) 03010000 EQUIVALENCE (ISGL ,ULOCAL(48)) 03020000 EQUIVALENCE (ISW ,ULOCAL(49)) 03030000 EQUIVALENCE (IXSGN ,ULOCAL(50)) 03040000 EQUIVALENCE (KTR1 ,ULOCAL(51)) 03050000 EQUIVALENCE (KSKIP ,ULOCAL(52)) 03060000 EQUIVALENCE (IFTRC ,ULOCAL(53)) 03070000 EQUIVALENCE (DXGRP ,ULOCAL(54)) 03080000 EQUIVALENCE (KGAP ,ULOCAL(55)) 03090000 EQUIVALENCE (XLAST ,ULOCAL(56)) 03100000 CDC 03110000 C 03120000 DATA PI/3.14159265/ 03130000 C 03140000 DATA SHOTPT / 'SHOT PT' / 03150000 DATA DEPTH / 'DEPTH PT' / 03160000 DATA FILEN / 'FILE NO' / 03170000 DATA LINE3D / '3D LINE' / 03180000 DATA PTS / 'PTS ' / 03190000 DATA YES /0/ 03200000 DATA NO /1/ 03210000 DATA YES3 /2/ 03220000 DATA NO3 /3/ 03230000 C 03240000 C=======================================================================03250000 C 03260000 C INITIALIZE VARIABLES 03270000 C 03280000 IPR = KPPRNT 03290000 IABORT = NO 03300000 ASI = SI 03310000 SR = ASI/1000. 03320000 NBL = NS 03330000 AUTO3 = NO 03340000 C 03350000 CDC 03360000 LOP = 10 03370000 C 03380000 C=======================================================================03390000 C 03400000 C READ SEISPARM FILE 03410000 C 03420000 DAP = 1 03430000 C 03440000 100 CALL FORP (KPNA, KPRNO, DAP, 104, DENTRY, *998) 03450000 IF (DCTYP .NE. PTS) GO TO 100 03460000 C 03470000 C OBTAIN VARIABLES FROM ATTRIBUTE ARRAY DATTR 03480000 C 03490000 C#######################################################################03500000 C 03510000 C READ THE STARTING SP/DP/FILE NUMBER FOR THIS PROCESSING RANGE 03520000 C 03530000 CDF = FLOAT(DATTR (1)) 03540000 C 03550000 C READ THE ENDING SP/DP/FILE NUMBER FOR THIS PROCESSING RANGE 03560000 C 03570000 CDL = FLOAT(DATTR (2)) 03580000 C 03590000 C-----------------------------------------------------------------------03600000 C 03610000 C READ THE SPATIAL GATE LENGTH. IF THE VALUE IS GREATER THAN ZERO 03620000 C THEN IT IS TO BE APPLIED POST-STACK WITH THE INDICATED NUMBER OF 03630000 C TRACES IN THE GATE. A VALUE OF ZERO WILL INDICATE THAT THE PROCESS03640000 C IS TO BE APPLIED TO PRESTACK GATHERS. IN THAT CASE THE NUMBER OF 03650000 C TRACES IN THE GATE WILL BE TAKEN FROM THE LINE CARD. THAT IS, 03660000 C FOR SHOT RECORDS LCTPSP WILL BE USED AS THE GATE LENGTH AND FOR 03670000 C DEPTH POINT GATHERS LCMXFD WILL BE USED AS THE GATE LENGTH. A NEG-03680000 C ATIVE VALUE WILL ALSO INDICATE THAT THE GATE IS TO BE APPLIED TO 03690000 C PRESTACK DATA BUT THAT THE NUMBER OF TRACES IN THE GATE IS TO BE 03700000 C THE ABSOLUTE VALUE OF THE NEGATIVE NUMBER INPUT. 03710000 C 03720000 SGL = FLOAT (DATTR(3)) 03730000 C 03740000 C-----------------------------------------------------------------------03750000 C 03760000 C OBTAIN THE NUMBER OF TRACES TO BE USED IN THE SPATIAL FILTER 03770000 C 03780000 SFL = FLOAT (DATTR(4)) 03790000 C 03800000 C-----------------------------------------------------------------------03810000 C 03820000 C READ THE TIME GATE LENGTH IN MS 03830000 C 03840000 TGL = FLOAT (DATTR(5)) 03850000 C 03860000 C-----------------------------------------------------------------------03870000 C 03880000 C OBTAIN THE PERCENTAGE OF WHITE NOISE 03890000 C 03900000 PWN = XATTR(6) 03910000 C 03920000 C-----------------------------------------------------------------------03930000 C 03940000 C DETERMINE THE OUTPUT SELECTION VALUE. A ZERO INDICATES THAT 03950000 C WE WISH TO OUTPUT THE INPUT - NOISE ESTIMATED; A VALUE OF ONE 03960000 C INDICATES THAT WE WISH THE NOISE ESTIMATED TO BE OUTPUT. THE 03970000 C DEFAULT VALUE IS ZERO 03980000 C 03990000 OSW = FLOAT(DATTR (7)) 04000000 C 04010000 C-----------------------------------------------------------------------04020000 C-----------------------------------------------------------------------04030000 C 04040000 C DETERMINE THE PERCENTAGE OF THE INPUT TO BE ADDED BACK TO 04050000 C THE RESULT BEFORE OUTPUT 04060000 C 04070000 PAB = XATTR(8) 04080000 C 04090000 C-----------------------------------------------------------------------04100000 C 04110000 C OBTAIN THE VALUE OF PROCESSING MODE. A VALUE OF 1 INDICATES THAT 04120000 C THE PROCESSING MODE IS BY CDP FILE NUMBER. A VALUE OF 2 INDICATES 04130000 C PROCESSING BY SHOT POINTS. A VALUE OF 3 INDICATES THAT THE 04140000 C PROCESSING MODE IS BY DEPTH POINTS.A VALUE OF 4 DETERMINES 3D LINE04150000 C PROCESSING . 04160000 C 04170000 IMODE = (DATTR (9)) 04180000 C 04190000 C 04200000 IF( IMODE.EQ. 1 ) THEN 04210000 C 04220000 TYPPNT = FILEN 04230000 C 04240000 ELSE IF (IMODE .EQ. 2 ) THEN 04250000 C 04260000 TYPPNT = SHOTPT 04270000 C 04280000 ELSE IF (IMODE.EQ. 3 ) THEN 04290000 C 04300000 TYPPNT = DEPTH 04310000 C 04320000 ELSE IF (IMODE.EQ.4) THEN 04330000 C 04340000 TYPPNT = DEPTH 04350000 C 04360000 END IF 04370000 C---------------------------------------------------------------------- 04380000 C OBTAIN THE FREQUENCY PARAMETERS 04390000 C 04400000 F1 = (DATTR(10)) 04410000 F2 = (DATTR(11)) 04420000 F3 = (DATTR(12)) 04430000 F4 = (DATTR(13)) 04440000 C-----------------------------------------------------------------------04450000 C 04460000 C DETERMINE THE BEGINING AND ENDING 3D LINE NUMBER VALUES. 04470000 C FOR 2D PROCESSING BOTH FIELDS SHOULD BE BLANK. 04480000 C 04490000 BLINE = (DATTR (14)) 04500000 ELINE = (DATTR (15)) 04510000 ILINE = -9999 04520000 C 04530000 C 04540000 C=======================================================================04550000 C 04560000 C WRITE OUT PARAMETERS 04570000 C 04580000 WRITE (KPPRNT, 9080) TYPPNT,INT(CDF),TYPPNT,INT(CDL) 04590000 04600000 IF (IMODE.NE.4) THEN 04610000 WRITE (KPPRNT,9100) INT(SGL),INT(SFL),INT(TGL),PWN,INT(OSW),PAB 04620000 ELSE 04630000 WRITE (KPPRNT,9110) INT(SGL),INT(SFL),INT(TGL),PWN,INT(OSW),PAB, 04640000 + BLINE,ELINE 04650000 END IF 04660000 C 04670000 C=======================================================================04680000 C 04690000 IF (IMODE.EQ.4) AUTO3 = YES 04700000 C 04710000 NT = TGL/SR 04720000 ITW = NT/2 04730000 NT = 2*ITW 04740000 NTW = 2 + (NBL-NT)/ITW 04750000 NTT = NT + (NTW-1)*ITW 04760000 C 04770000 IF( NT.GT.3*NBL/4 ) THEN 04780000 NTW = 1 04790000 NT = NBL 04800000 ITW = 0 04810000 NTT = NT 04820000 ENDIF 04830000 C 04840000 WRITE(IPR,9000) NT,ITW,NTW,NTT 04850000 C 04860000 C=======================================================================04870000 C 04880000 C FREQUENCY DOMAIN SPECIFICATIONS 04890000 C 04900000 NTS = (5*NT)/4 04910000 M = 3 04920000 N = 8 04930000 250 M = M + 1 04940000 N = 2*N 04950000 IF( N.LT.NTS ) GO TO 250 04960000 C 04970000 FNYQ = 500. / SR 04980000 DELF = FNYQ / (N/2) 04990000 C 05000000 IF1 = F1/DELF + 1 05010000 IF2 = F2/DELF + 1 05020000 IF3 = F3/DELF + 1 05030000 IF4 = F4/DELF + 1 05040000 NFR = IF4 - IF1 + 1 05050000 NF = N/2 + 1 05060000 IFB = 2 * (IF1-1) 05070000 IFE = IFB + 2 * NFR 05080000 C 05090000 C=======================================================================05100000 C 05110000 C POST-STACK MODE 05120000 C 05130000 ISGL = SGL 05140000 CDC 05150000 ISW = 0 05160000 IF( SGL.GT.0. ) THEN 05170000 NTRC = CDL - CDF + 1 05180000 GO TO 300 05190000 ENDIF 05200000 C 05210000 C PRE-STACK MODE 05220000 C 05230000 AUTO3 = YES 05240000 C USE LINE CARD TO OBTAIN NUMBER OF TRACES/SPN(CDP) 05250000 C 05260000 IF (IMODE .EQ. 1 .OR. IMODE .EQ.2) THEN 05270000 HMT = FLOAT (LCTPSP) 05280000 CDC 05290000 ISW = 1 05300000 DXGRP = LCGRPI 05310000 WRITE( KPPRNT,7851 ) DXGRP 05320000 7851 FORMAT(' DXGRP = ',F12.4 ) 05330000 ELSE 05340000 HMT = FLOAT (LCMXFD) 05350000 END IF 05360000 C 05370000 IF (HMT .EQ. 0.0) HMT = FLOAT(LCTPSP) 05380000 C 05390000 NTRC = HMT 05400000 SGL = ABS(SGL) 05410000 IF( SGL.EQ.0. ) SGL = HMT 05420000 C 05430000 C=======================================================================05440000 C 05450000 300 LX = SFL 05460000 LX = 2*(LX/2) + 1 05470000 LXH = LX/2 05480000 LX2 = 2*LXH 05490000 C 05500000 NX = SGL 05510000 LXO = NX/2 05520000 LO2 = LXO + LX2 05530000 NX = 2*LXO 05540000 C 05550000 WNF = 1. + PWN/100. 05560000 C 05570000 FAB = PAB/100. 05580000 ABF = FAB/(1.+FAB) 05590000 C 05600000 IF( OSW.EQ.1. ) ABF = 0. 05610000 C 05620000 C=======================================================================05630000 C 05640000 C ALLOCATE RA AREA FOR STORING HEADERS AND WEIGHTS 05650000 CDC PLUS INTERPLOATION OPERATOR 05660000 C 05670000 C 05680000 IXOP = 1 05690000 IXH = IXOP + LOP 05700000 IXW1 = IXH + NTRC*THL 05710000 IXW2 = IXW1 + LXO 05720000 ITW1 = IXW2 + LXO 05730000 ITW2 = ITW1 + ITW 05740000 IXD = ITW2 + ITW 05750000 ICC = IXD + NTT 05760000 C 05770000 WRITE(IPR,9015) F1, F2, F3, F4 05780000 WRITE(IPR,9018) NFR, DELF 05790000 WRITE(IPR,9020) M,N,NF 05800000 WRITE(IPR,9030) NX,LX,NTRC 05810000 WRITE(IPR,9040) LXO,LO2 05820000 C 05830000 C=======================================================================05840000 C 05850000 C SET UP DISK SPACE FOR TRACES 05860000 C 05870000 CDC INPUT: (NTRC+1)/2 RECORDS OF LENGTH NTT WORDS 05880000 CDC OUTPUT: (NTRC+1) RECORDS -(FILTERED) INPUT+INTERPOLATED DATA 05890000 C 05900000 C SET RECORD LENGTHS IN BYTES 05910000 C 05920000 CDC 05930000 C 05940000 C INPUT DATA 05950000 C 05960000 LEN = 4*NTT 05970000 MTRC = NTRC+3 05980000 CALL UPAWRK( MTRC/2,LEN,'A',KPWRKS,KPWRKD,DDNAME,IER1,IER2 ) 05990000 CDC 06000000 C 06010000 C OUTPUT DATA 06020000 C 06030000 LN2 = 4*NBL 06040000 CALL UPAWRK( MTRC,LEN,'B',KPWKS2,KPWKD2,DDNME2,IER1,IER2 ) 06050000 C 06060000 C OPEN FILES FOR SEQUENTIAL ACCESS 06070000 C 06080000 CALL FOISSD( KPWRKS,LEN,2) 06090000 CALL FOISSD( KPWKS2,LN2,2) 06100000 C 06110000 C WRITE MTRC/NTRC DUMMY RECORDS SEQUENTIALLY 06120000 C 06130000 CALL ARSET (RA, NTT, 0.0) 06140000 CDC 06150000 DO 320 I = 1,MTRC/2 06160000 ISEQ = I 06170000 CALL FOWSSD( KPWRKS,ISEQ ,RA ) 06180000 320 CONTINUE 06190000 DO 330 I = 1,MTRC 06200000 ISEQ = I 06210000 CALL FOWSSD( KPWKS2,ISEQ ,RA ) 06220000 330 CONTINUE 06230000 C 06240000 C CLOSE SEQUENTIAL FILE AND OPEN FOR DIRECT ACCESS 06250000 C 06260000 CALL FOCSD (KPWRKS) 06270000 CALL FOCSD (KPWKS2) 06280000 CALL FOIDSD( KPWRKD,LEN ) 06290000 CALL FOIDSD( KPWKD2,LN2 ) 06300000 C 06310000 C=======================================================================06320000 C 06330000 CDC 06340000 CDC GET REQUIRED INTERPLOATION OPERATOR 06350000 CDC 06360000 IRW = IXOP + 99*LOP 06370000 IG = IRW + LOP + 2 06380000 IF = IG + LOP + 2 06390000 IA = IF + LOP + 2 06400000 FRNYQ = .7 06410000 KXOP = IXOP + 49*LOP 06420000 CJJ CALL COFGEN( LOP,FRNYQ,RA(IRW),RA(IG),RA(IF),RA(IA),RA(IXOP) ) 06430000 CALL MCOFGN( LOP,FRNYQ,RA(IRW),RA(IG),RA(IF),RA(IA),RA(IXOP) ) 06440000 CALL SCOPY( LOP,RA(KXOP),1,RA(IXOP),1 ) 06450000 C 06460000 C=======================================================================06470000 C 06480000 C WEIGHTS FOR MERGING TIME AND SPACE GATES 06490000 C 06500000 DO 350 IT = 1,ITW 06510000 RAT = FLOAT(IT)/FLOAT(ITW+1) 06520000 RA(ITW1+IT-1) = RAT 06530000 350 RA(ITW2+IT-1) = 1. - RAT 06540000 C 06550000 DO 400 IX = 1,LXO 06560000 RAT = FLOAT(IX)/FLOAT(LXO+1) 06570000 RA(IXW1+IX-1) = RAT 06580000 400 RA(IXW2+IX-1) = 1. - RAT 06590000 C 06600000 405 ZERO = 0. 06610000 CALL ARSET(RA(IXD),NTT,ZERO) 06620000 C 06630000 C=======================================================================06640000 C 06650000 C INITIALIZE COUNTERS 06660000 C 06670000 ITRC = 0 06680000 JTRC = 0 06690000 KTRC = 0 06700000 LTRC = 0 06710000 CDC 06720000 IFNT1 = 0 06730000 C 06740000 C=======================================================================06750000 C 06760000 RETURN 06770000 C 06780000 C******************************************************************* 06790000 C******************************************************************* 06800000 C 06810000 ENTRY SAFXIN1(OH,OTR,VEL,PASS,AUTO3,IABORT,RA,SA) 06820000 C 06830000 C******************************************************************* 06840000 C******************************************************************* 06850000 C 06860000 IABORT = NO 06870000 PASS = NO 06880000 IF( AUTO3.EQ.YES ) THEN 06890000 ITRC = 0 06900000 JTRC = 0 06910000 KTRC = 0 06920000 LTRC = 0 06930000 IF( IMODE.EQ.3 ) THEN 06940000 IFTRC = CDPT 06950000 ELSE 06960000 IFTRC = ORTN 06970000 ENDIF 06980000 ENDIF 06990000 CDC 07000000 IF( ISW.EQ.1 ) THEN 07010000 KTR1 = 0 07020000 KGAP = 0 07030000 CALL USRTHV( OH,'THSLN ',ISLN ) 07040000 CALL USRTHV( OH,'THRCLN ',IRLN ) 07050000 IF( ISLN.GT.IRLN ) THEN 07060000 IXSGN = -1 07070000 ELSE 07080000 IXSGN = +1 07090000 ENDIF 07100000 XLAST = IXSGN*XDST 07110000 ENDIF 07120000 CDC 07130000 C 07140000 C 07150000 C******************************************************************* 07160000 C******************************************************************* 07170000 C 07180000 ENTRY SAFXIN2(OH,OTR,VEL,PASS,AUTO3,IABORT,RA,SA) 07190000 C 07200000 C******************************************************************* 07210000 C******************************************************************* 07220000 C 07230000 C CHECK THAT THIS TRACE IS TO BE PROCESSED 07240000 C 07250000 PASS = NO 07260000 IF( IMODE.EQ.1 ) FNT = FN 07270000 IF( IMODE.EQ.2 ) FNT = SSP 07280000 IF( IMODE.EQ.3 ) FNT = CDPN 07290000 IF( IMODE.EQ.4 ) FNT = CDPN 07300000 CDC 07310000 IF( IFNT1.EQ.0 ) IFNT1 = FNT 07320000 C 07330000 C NOTE THAT THE FOLLOWING WILL BE CORRECT ONLY IF THE INPUT 07340000 C FILE/SHOT/DEPTH POINT NUMBER INCREASE 07350000 C 07360000 CALL USRTHV ( OH, 'THLNNO ', LINENO ) 07370000 IF (IMODE .EQ. 4 .AND. LINENO .LT. BLINE) RETURN 07380000 IF (IMODE .EQ. 4 .AND. LINENO .GT. ELINE) RETURN 07390000 IF( FNT.LT.CDF ) RETURN 07400000 IF( FNT.GT.CDL ) THEN 07410000 IF (AUTO3 .EQ. YES) THEN 07420000 RETURN 07430000 ELSE 07440000 PASS = NO3 07450000 RETURN 07460000 ENDIF 07470000 ENDIF 07480000 CDC 07490000 IF( ISW.EQ.1 .AND. KGAP.EQ.0 ) THEN 07500000 CALL USRTHV( OH,'THSLN ',ISLN ) 07510000 CALL USRTHV( OH,'THRCLN ',IRLN ) 07520000 IF( ISLN.GT.IRLN ) THEN 07530000 IXSGN = -1 07540000 ELSE 07550000 IXSGN = +1 07560000 ENDIF 07570000 XTEST = IXSGN*XDST 07580000 DXT = ABS(XTEST-XLAST) 07590000 IF( DXT.GT.1.5*DXGRP ) THEN 07600000 KGAP = 1 07610000 ELSE 07620000 KTR1 = KTR1 + 1 07630000 XLAST = XTEST 07640000 ENDIF 07650000 ENDIF 07660000 CDC 07670000 C 07680000 C=======================================================================07690000 C 07700000 C STORE HEADER IN RA 07710000 C 07720000 ITRC = ITRC + 1 07730000 JXH = IXH + THL*(ITRC-1) 07740000 CALL ARMVE(OH,RA(JXH),THL) 07750000 CDC IF( TICD.NE.1 ) RETURN 07760000 IF ( LINENO .NE. ILINE ) ILINE = LINENO 07770000 C 07780000 C STORE TRACE ON DISK 07790000 C 07800000 KTRC = KTRC + 1 07810000 KSEQ = KTRC 07820000 CALL ARMVE( OTR,RA(IXD),NBL) 07830000 CALL FOWDSD( KPWRKD,KSEQ,RA(IXD) ) 07840000 C 07850000 C 07860000 C=======================================================================07870000 C 07880000 C 07890000 RETURN 07900000 C******************************************************************* 07910000 C******************************************************************* 07920000 C 07930000 ENTRY SAFXIN3(OH,OTR,VEL,PASS,AUTO3,IABORT,RA,SA) 07940000 C 07950000 C******************************************************************* 07960000 C******************************************************************* 07970000 C 07980000 C 07990000 PASS = NO 08000000 IF( JTRC.GT.0 ) GO TO 2900 08010000 C 08020000 C ARE THERE ENOUGH LIVE TRACES? 08030000 C 08040000 IF( KTRC.LT.2*LX ) GO TO 2900 08050000 CDC 08060000 IF( ISW.EQ.1 ) THEN 08070000 IF( KTR1.EQ.KTRC ) THEN 08080000 KSKIP = 0 08090000 ELSE 08100000 KSKIP = 2*KTR1 08110000 ENDIF 08120000 ENDIF 08130000 CDC 08140000 C 08150000 C ALLOCATE SA AREAS FOR COMPUTATION 08160000 C 08170000 NXW = KTRC/LXO - 1 08180000 NEX = KTRC - (NXW+1)*LXO 08190000 NXS = NX + NEX/2 08200000 NXE = NX + NEX - NEX/2 08210000 MXT = MAX0(NXS,NXE) 08220000 IF( NXW.LE.1 ) THEN 08230000 MXT = KTRC 08240000 NXW = 1 08250000 ENDIF 08260000 C 08270000 MXL = MXT + LX2 08280000 NP2 = N + 2 08290000 C 08300000 IF (KPBUGF.NE.0) WRITE(IPR,9050) KTRC,NXS,NXE 08310000 C 08320000 ISR = 1 08330000 ISC = ISR + 2*LX 08340000 ISH = ISC + 2*LX 08350000 ISA = ISH + 2*LX 08360000 ISB = ISA + 2*LX + 2*MXL 08370000 ISY = ISB + 2*LX + 2*MXL 08380000 ISF = ISY + 2*LX + 2*MXL 08390000 ISG = ISF + 2*LX 08400000 IXI = ISG + 2*LX 08410000 CDC 08420000 IXF = IXI + NTT*MXL 08430000 IXU = IXF + NTT*MXT 08440000 IXL = IXU + NTT*MXT 08450000 IXV = IXL + NTT*LXO 08460000 IXM = IXV + NTT*LXO 08470000 IXY = IXM + NP2*MXL 08480000 IHS = IXY + NP2*MXL 08490000 IHN = IHS + 2*MXL 08500000 CDC ISN = IHS 08510000 CDC IF( OSW.EQ.1. ) ISN = IHN 08520000 C 08530000 IF ( KPBUGF.NE.0) WRITE(IPR,9060) IXI,IXF,IXL,IXM,IHS,IHN 08540000 C 08550000 C=======================================================================08560000 C 08570000 C OUTER LOOP - SPATIAL WINDOWS 08580000 C 08590000 NXI = NXS 08600000 MXI = NXI + LX2 08610000 NXO = NXI - LXO 08620000 NXF = NXI + LXH 08630000 IXS = IXI + NTT*LXH 08640000 ISEQ = 1 08650000 JSEQ = 1 08660000 C 08670000 CALL ARSET(SA(IXI),LXH*NTT,ZERO) 08680000 C 08690000 D12 = IF2 - IF1 08700000 D34 = IF4 - IF3 08710000 C 08720000 DO 2000 JXW = 1,NXW 08730000 C 08740000 C SET POINTERS FOR SCRATCH COMMON VARIABLES FOR PRE-STACK PROCESSING 08750000 IF( JXW.EQ.NXW ) THEN 08760000 NXI = NXE 08770000 MXI = NXI + LX2 08780000 NXO = NXI 08790000 NXF = NXI - LXO - LXH 08800000 I2Z = IXI + NTT*(NXI+LXH) 08810000 CALL ARSET(SA(I2Z),LXH*NTT,ZERO) 08820000 ENDIF 08830000 C 08840000 C SET POINTERS FOR SCRATCH COMMON VARIABLES FOR POST-STACK PROCESSING 08850000 IF( NXW.EQ.1 ) THEN 08860000 NXI = KTRC 08870000 MXI = NXI + LX2 08880000 NXO = NXI 08890000 NXF = NXI 08900000 I2Z = IXI + NTT*(NXI+LXH) 08910000 CALL ARSET(SA(I2Z),LXH*NTT,ZERO) 08920000 ENDIF 08930000 C 08940000 IF (KPBUGF.NE.0) WRITE(IPR,9070) JXW,NXI,NXO,NXF,IXS,MXI 08950000 C 08960000 C BRING IN NXF TRACES 08970000 C 08980000 JXI = IXS 08990000 DO 800 IX = 1,NXF 09000000 CALL FORDSD( KPWRKD,ISEQ,SA(JXI) ) 09010000 800 JXI = JXI + NTT 09020000 C 09030000 C LOOP ON TEMPORAL WINDOWS 09040000 C 09050000 JXI = IXI 09060000 JXF = IXF 09070000 JXU = IXU 09080000 DO 1600 JTW = 1,NTW 09090000 C 09100000 C TRANSFORM FOR EACH WINDOW 09110000 C 09120000 KXI = JXI 09130000 KXM = IXM 09140000 KXY = IXY 09150000 DO 900 IX = 1,MXI 09160000 CALL ARMVE(SA(KXI),SA(KXM),NT) 09170000 CALL ARSET(SA(KXM+NT),N-NT,ZERO) 09180000 CALL S2DFT2( M,SA(KXM),*9990 ) 09190000 CALL ARSET(SA(KXM), IFB, 0.) 09200000 CALL ARSET(SA(KXM+IFE), NP2-IFE, 0.) 09210000 CDC 09220000 CALL ARSET(SA(KXY),NP2,0.) 09230000 KXM = KXM + NP2 09240000 KXY = KXY + NP2 09250000 900 KXI = KXI + NTT 09260000 C 09270000 C PREDICTION OPERATION 09280000 C 09290000 KXM = IXM 09300000 KXY = IXY 09310000 KXM1 = KXM + IFB 09320000 KXY1 = KXY + IFB 09330000 DO 1000 IF = 1,NFR 09340000 CALL CCOPY( MXI,SA(KXM1),NF,SA(IHS),1 ) 09350000 CALL SAFXINA(SA(IHS),SA(IHN),NXI,LX,WNF,OSW, 09360000 * SA(ISR),SA(ISC),SA(ISH), 09370000 * SA(ISA),SA(ISB),SA(ISY),SA(ISF),SA(ISG), 09380000 * RA(IXOP),LOP ) 09390000 C 09400000 C APPLY TRAPEZOIDAL WEIGHTS 09410000 C 09420000 SC = 1. 09430000 JF = IF + IF1 - 1 09440000 IF (JF.GE.IF1 .AND. JF.LT.IF2) SC = FLOAT(JF-IF1)/D12 09450000 IF (JF.GT.IF3 .AND. JF.LE.IF4) SC = FLOAT(IF4-JF)/D34 09460000 CDC 09470000 IF (SC.NE.1) THEN 09480000 CALL ARMPFC(SA(IHS), SA(IHS), SC, 2*NXI) 09490000 CALL ARMPFC(SA(IHN), SA(IHN), SC, 2*NXI) 09500000 ENDIF 09510000 CALL CCOPY( NXI,SA(IHS),1,SA(KXM1),NF ) 09520000 CALL CCOPY( NXI,SA(IHN),1,SA(KXY1),NF ) 09530000 KXM1 = KXM1 + 2 09540000 1000 KXY1 = KXY1 + 2 09550000 C 09560000 C INVERSE TRANSFORMS 09570000 C 09580000 CDC 09590000 KXM = IXM 09600000 KXY = IXY 09610000 DO 1200 IX = 1,NXI 09620000 CALL S2DFI2( M,SA(KXM),*9990 ) 09630000 CALL S2DFI2( M,SA(KXY),*9990 ) 09640000 KXM = KXM + NP2 09650000 1200 KXY = KXY + NP2 09660000 C 09670000 C MERGE TEMPORAL WINDOWS 09680000 C 09690000 IF( JTW.EQ.1 ) THEN 09700000 CDC 09710000 KXF = IXF 09720000 KXU = IXU 09730000 KXM = IXM 09740000 KXY = IXY 09750000 DO 1400 IX = 1,NXI 09760000 CDC 09770000 CALL SCOPY( NT,SA(KXM),1,SA(KXF),1 ) 09780000 CALL SCOPY( NT,SA(KXY),1,SA(KXU),1 ) 09790000 KXM = KXM + NP2 09800000 KXY = KXY + NP2 09810000 KXF = KXF + NTT 09820000 1400 KXU = KXU + NTT 09830000 GO TO 1550 09840000 ENDIF 09850000 C 09860000 CDC 09870000 KXM = IXM 09880000 KXY = IXY 09890000 KXF = IXF + ITW*(JTW-1) 09900000 KXU = IXU + ITW*(JTW-1) 09910000 DO 1500 IX = 1,NXI 09920000 DO 1450 IT = 1,ITW 09930000 SA(KXF+IT-1) = RA(ITW2+IT-1)*SA(KXF+IT-1) 09940000 * + RA(ITW1+IT-1)*SA(KXM+IT-1) 09950000 SA(KXU+IT-1) = RA(ITW2+IT-1)*SA(KXU+IT-1) 09960000 * + RA(ITW1+IT-1)*SA(KXY+IT-1) 09970000 1450 CONTINUE 09980000 C 09990000 CALL SCOPY( NT-ITW,SA(KXM+ITW),1,SA(KXF+ITW),1 ) 10000000 CALL SCOPY( NT-ITW,SA(KXY+ITW),1,SA(KXU+ITW),1 ) 10010000 C 10020000 KXM = KXM + NP2 10030000 KXY = KXY + NP2 10040000 KXF = KXF + NTT 10050000 1500 KXU = KXU + NTT 10060000 C 10070000 1550 JXI = JXI + ITW 10080000 1600 JXF = JXF + ITW 10090000 C 10100000 C MERGE SPATIAL WINDOWS 10110000 C 10120000 CDC 10130000 JXO = IXF 10140000 KXO = IXU 10150000 IF( JXW.EQ.1 ) GO TO 1800 10160000 C 10170000 JXF = IXF 10180000 JXU = IXU 10190000 JXL = IXL 10200000 JXV = IXV 10210000 DO 1700 IX = 1,LXO 10220000 CJJ CALL SYAX ( NTT,RA(IXW2+IX-1),SA(JXL),1,SA(JXL),1 ) 10230000 CJJ CALL SYAX ( NTT,RA(IXW2+IX-1),SA(JXV),1,SA(JXV),1 ) 10240000 CALL SSCAL ( NTT,RA(IXW2+IX-1),SA(JXL),1 ) 10250000 CALL SSCAL ( NTT,RA(IXW2+IX-1),SA(JXV),1 ) 10260000 CALL SAXPY( NTT,RA(IXW1+IX-1),SA(JXF),1,SA(JXL),1 ) 10270000 CALL SAXPY( NTT,RA(IXW1+IX-1),SA(JXU),1,SA(JXV),1 ) 10280000 JXF = JXF + NTT 10290000 JXU = JXU + NTT 10300000 JXL = JXL + NTT 10310000 1700 JXV = JXV + NTT 10320000 JXO = IXL 10330000 KXO = IXV 10340000 C 10350000 C PUT OUTPUT TRACES BACK ON DISK 10360000 C 10370000 1800 DO 1900 IX = 1,NXO 10380000 IF( IX.EQ.LXO+1 ) THEN 10390000 JXO = IXF + LXO*NTT 10400000 KXO = IXU + LXO*NTT 10410000 ENDIF 10420000 CALL FOWDSD( KPWKD2,JSEQ,SA(JXO) ) 10430000 CALL FOWDSD( KPWKD2,JSEQ,SA(KXO) ) 10440000 KXO = KXO + NTT 10450000 1900 JXO = JXO + NTT 10460000 C 10470000 IF( JXW.EQ.NXW ) GO TO 2000 10480000 C 10490000 C MOVE REST OF FILTERED TRACES TO OVERLAP BUFFER 10500000 C 10510000 JXF = IXF + NXO*NTT 10520000 JXU = IXU + NXO*NTT 10530000 CALL SCOPY( NTT*LXO,SA(JXF),1,SA(IXL),1 ) 10540000 CALL SCOPY( NTT*LXO,SA(JXU),1,SA(IXV),1 ) 10550000 C 10560000 C MOVE INPUT TRACES TO START OF INPUT BUFFER 10570000 C 10580000 JXI = IXI 10590000 KXI = IXI + NTT*NXO 10600000 DO 1920 IX = 1,LO2 10610000 CALL SCOPY( NTT,SA(KXI),1,SA(JXI),1 ) 10620000 JXI = JXI + NTT 10630000 1920 KXI = KXI + NTT 10640000 C 10650000 NXI = NX 10660000 MXI = NXI + LX2 10670000 NXO = LXO 10680000 NXF = LXO 10690000 IXS = IXI + LO2*NTT 10700000 C 10710000 2000 CONTINUE 10720000 C 10730000 C=======================================================================10740000 C 10750000 C 10760000 C OUTPUT TRACES 10770000 C 10780000 C 10790000 C 10800000 2900 JTRC = JTRC + 1 10810000 C 10820000 CDC 10830000 IF( JTRC.GT.2*ITRC-1 ) THEN 10840000 PASS = NO 10850000 IF ( KPMITF .EQ. 0) THEN 10860000 CALL FOCDD (KPWRKD) 10870000 CALL UGUWRK( KPWRKS, KPWRKD, IER1, IER2 ) 10880000 IF ( IER1 .NE. 1 ) WRITE( IPR, 9090 ) IER1, IER2 10890000 END IF 10900000 RETURN 10910000 ENDIF 10920000 C 10930000 PASS = YES3 10940000 CDC 10950000 IF( ISW.EQ.1 ) THEN 10960000 IF( JTRC.EQ.KSKIP ) THEN 10970000 PASS = NO3 10980000 RETURN 10990000 ENDIF 11000000 ENDIF 11010000 CDC 11020000 LTRC = LTRC + 1 11030000 C 11040000 C FETCH TRACE HEADER 11050000 C 11060000 MTRC = (1+JTRC)/2 11070000 IF( JTRC.EQ.2*MTRC ) THEN 11080000 JXH = IXH + THL*(MTRC-1) 11090000 KXH = IXH + THL*MTRC 11100000 CALL SAFXINC( THL,RA(JXH),RA(KXH),OH,IMODE,ISGL,IFN1,JTRC ) 11110000 ELSE 11120000 JXH = IXH + THL*(MTRC-1) 11130000 CALL SCOPY( THL,RA(JXH),1,OH,1 ) 11140000 ENDIF 11150000 CDC 11160000 C MODIFY TRACE NUMBER, IF APPROPRIATE 11170000 C 11180000 CDC 11190000 IF( IMODE.EQ.1 .OR. IMODE.EQ.2 ) THEN 11200000 CALL USSTHV( OH,'THORTN ',IFTRC+LTRC-1 ) 11210000 ELSEIF( AUTO3.EQ.YES ) THEN 11220000 CALL USSTHV( OH,'THCDPT ',IFTRC+LTRC-1 ) 11230000 ENDIF 11240000 CDC 11250000 C 11260000 CALL USRTHV( OH,'THTICD ',TICD ) 11270000 IF( TICD.NE.1 ) THEN 11280000 CALL ARSET( OTR,NBL,0. ) 11290000 GO TO 3000 11300000 ENDIF 11310000 C 11320000 C FETCH TRACE 11330000 C 11340000 KSEQ = JTRC 11350000 CALL FORDSD( KPWKD2,KSEQ,SA ) 11360000 CALL ARMVE(SA,OTR,NBL) 11370000 C 11380000 C ZERO TO FIRST LIVE VALUE 11390000 C 11400000 CALL USRTHV( OH,'THFLV ',IFLV ) 11410000 IF( IFLV.GT.1 ) CALL ARSET( OTR,IFLV-1,0. ) 11420000 C 11430000 C 11440000 C 11450000 3000 IF ( KPMITF .EQ. 0) THEN 11460000 IF( JTRC.EQ.2*ITRC-1 ) THEN 11470000 PASS = YES 11480000 CALL FOCDD (KPWRKD) 11490000 CALL FOCDD (KPWKD2) 11500000 CALL UGUWRK( KPWRKS, KPWRKD, IER1, IER2 ) 11510000 IF ( IER1 .NE. 1 ) WRITE( IPR, 9090 ) IER1, IER2 11520000 CALL UGUWRK( KPWKS2, KPWKD2, IER1, IER2 ) 11530000 IF ( IER1 .NE. 1 ) WRITE( IPR, 9090 ) IER1, IER2 11540000 END IF 11550000 END IF 11560000 C 11570000 RETURN 11580000 C 11590000 C=======================================================================11600000 C 11610000 C 11620000 C ******************** 11630000 C ******************** 11640000 C ERROR MESSAGES 11650000 C ******************** 11660000 C ******************** 11670000 C 11680000 C 11690000 9990 IABORT = YES 11700000 WRITE(IPR,9120) 11710000 RETURN 11720000 C 11730000 998 IABORT = YES 11740000 WRITE(KPPRNT,9010) KPNA,KPRNO 11750000 C 11760000 C 11770000 C ******************** 11780000 C ******************** 11790000 C FORMAT STATEMENTS 11800000 C ******************** 11810000 C ******************** 11820000 C 11830000 C 11840000 C 11850000 9000 FORMAT('0 NT = ',I5,' ITW = ',I5,' NTW = ',I5,' NTT = ',I5 ) 11860000 C 11870000 9010 FORMAT('0*** NO SEISPARM FILE RECORD FOUND FOR ',A4,I1,' ***') 11880000 C 11890000 9015 FORMAT ('0LOW-CUT:', 2X,I5,T20,'LOW-PASS:',I5/1X, 11900000 * 'HIGH-PASS:',I5,T20,'HIGH-CUT:',I5/) 11910000 C 11920000 9018 FORMAT ('0NO. OF FREQUENCY: ',I5, 5X, 'FREQUENCY INTERVAL: ', 11930000 * F8.5,/) 11940000 C 11950000 9020 FORMAT('0 M = ',I5,' N = ',I6,' NF = ',I6 ) 11960000 C 11970000 9030 FORMAT('0 NX = ',I5,' LX = ',I5,' NTRC = ',I5 ) 11980000 C 11990000 9040 FORMAT('0 LXO = ',I5,' LO2 = ',I5 ) 12000000 C 12010000 9050 FORMAT('0 KTRC = ',I6,' NXS = ',I6,' NXE = ',I6 ) 12020000 C 12030000 9060 FORMAT('0 IXI = ',I8,' IXF = ',I8,' IXL = ',I8,/, 12040000 + ' IXM = ',I8,' IHS = ',I8,' IHN = ',I8 ) 12050000 C 12060000 9070 FORMAT('0 JXW = ',I4,' NXI = ',I6,' NXO = ',I6,' NXF = ',I6, 12070000 + ' IXS = ',I8,' MXI = ',I6 ) 12080000 C 12090000 9080 FORMAT ('0F-X DECONVOLUTION FROM ', A8,1X,I5,' TO ', A8,1X,I5, 12100000 + ' PARAMETER VALUES SELECTED ARE'/1X,102('=')) 12110000 C 12120000 9090 FORMAT(//,5X,'ERROR RETURN FROM WORK FILE DE-ALLOCATION '/ 12130000 + 5X,'ERROR CODE = ',I5,' SVC99 ERROR = ',Z9 / 12140000 + 5X,'PROCESSING CONTINUES') 12150000 C 12160000 9100 FORMAT('0SPATIAL GATE LENGTH:',14X,I6,T60, 12170000 + 'SPATIAL FILTER LENGTH:',12X,I6/1X, 12180000 + 'TIME-GATE LENGTH:',17X,I6,' MS',T60, 12190000 + 'PERCENTAGE WHITE NOISE:',10X,F7.2/1X, 12200000 + 'OUTPUT SELECTION SWITCH:',10X,I6,T60, 12210000 + 'PERCENTAGE OF INPUT FOR ADD-BACK:',F7.2//) 12220000 C 12230000 9110 FORMAT('0SPATIAL GATE LENGTH:',14X,I6,T60, 12240000 + 'SPATIAL FILTER LENGTH:',12X,I6/1X, 12250000 + 'TIME-GATE LENGTH:',17X,I6,' MS',T60, 12260000 + 'PERCENTAGE WHITE NOISE:',10X,F7.2/1X, 12270000 + 'OUTPUT SELECTION SWITCH:',10X,I6,T60, 12280000 + 'PERCENTAGE OF INPUT FOR ADD-BACK:',F7.2/1X, 12290000 + 'BEGINING 3D LINE NUMBER:',10X,I6,T60, 12300000 + 'ENDING 3D LINE NUMBER:',11X,I6//) 12310000 C 12320000 9120 FORMAT('0 MISSING DATA CARD FOR FXIN ' ) 12330000 C 12340000 RETURN 12350000 END 12360000