C***********************************************************************00010000 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CTITLESAFX3D0 -- 3D-SPATIAL DECONVOLUTION PROCESS FX3D 00020000 CABS SAFX3D0 - 3D-SPATIAL DECONVOLUTION PROCESS FX3D 00030000 C 00040000 C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1989. 00050000 C 00060000 C ALL RIGHTS RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, 00070000 C REPRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE00080000 C PRIOR CONSENT OF ATLANTIC RICHFIELD COMPANY. 00090000 C 00100000 C 00110000 CA DESIGNER D CORRIGAN 00120000 CA AUTHOR D CORRIGAN 00130000 CA LANGUAGE VS FORTRAN 00140000 CA SYSTEM IBM/CRAY 00150000 CA WRITTEN 12-13-88 00160000 CA 00170000 CA REVISED 01-10-89 GENERALIZE INITIAL PROGRAM 00180000 CA BY PERMITTING THE OPERATOR 00190000 CA TO BE DESIGNED AND APPLIED 00200000 CA IN A SPATIALLY VARYING WAY 00210000 CA 00220000 CA REVISED 02-09-89 IMPLEMENT LOGIC TO CHECK 00230000 CA EACH PATCH FOR THE DEGREE TO 00240000 CA WHICH IT IS FILLED. FOR THOSE00250000 CA PATCHES WITH TOO FEW TRACES, 00260000 CA APPLY OPERATOR FROM NEAREST 00270000 CA ACCEPTABLE PATCH 00280000 CA 00290000 CA REVISED 03-02-89 IMPROVE DOCUMENTATION AND 00300000 CA ELIMINATE EXTRANEOUS PRINT 00310000 CA STATEMENTS 00320000 CA 00330000 CA REVISED 03-08-90 FIX BUG IS ISW VARIABLE SET 00340000 CA 00350000 CA REVISED 10-05-90 BY D. CORRIGAN 00360000 CA TO AVOID ASSUMPTIONS ABOUT 00370000 CA THE OVERALL MAGNITUDE OF THE 00380000 CA CROSS CORRELATIONS BY SETTING 00390000 CA ZTOL = ETOL * MAX(ABS(R)) 00400000 CA IN MTOEPL (VIA MTOEPI) 00410000 CA 00420000 CA REVISED 10-19-90 CLJ RENAME FX3*** ROUTINES TO SAFX3D* 00430000 CA RENAME BC**** ROUTINES TO SAFX3D* 00440000 CA RENAME SETDSK ROUTINE TO USIDSK* 00450000 CA 00460000 CA REVISED 09-10-92 DC MODIFICATIONS: 00470000 CA 1. REVISE BOOKKEEPING TO AVOID DYNAMIC 00480000 CA BUFFERING. THIS ELIMINATES THE NEED 00490000 CA FOR SAFF3DD AND SAFF3DI 00500000 CA 2. CLEAN UP CODE. 00510000 CA 00520000 CA THIS IS A SPARC DEVELOPMENT PROGRAM 00530000 CA 00540000 CA PURPOSE OF PROGRAM: 00550000 CA 00560000 CA ATTENUATE RANDOM NOISE ON 3-D SEISMIC DATA 00570000 CA BY F-X DOMAIN PREDICTIVE FILTERING 00580000 CA (DESCENDANT OF RANT PROGRAM) 00590000 CA 00600000 CA CALLING PROCEDURE: 00610000 CA SUBROUTINE SAFX3D0(OH,ICC,AUTO3,IABORT,RA) 00620000 CA 00630000 CA CALLING ARGUMENTS: 00640000 CA 00650000 CA OH IN INTEGER INPUT TRACE HEADER 00660000 CA ICC IN INTEGER AMOUNT OF RESERVED COMMON 00670000 CA AUTO3 OUT INTEGER AUTO BOUNDARY DETECTION 00680000 CA IABORT OUT INTEGER FLAG TO ABORT PROCESS 00690000 CA RA OUT REAL RESERVED COMMON ARRAY 00700000 C 00710000 C ENTRY POINTS: 00720000 C CALL SAFX3D1(OH,OTR,VEL,PASS,IABORT,RA,SA) 00730000 C CALL SAFX3D2(OH,OTR,VEL,PASS,IABORT,RA,SA) 00740000 C CALL SAFX3D3(OH,OTR,VEL,PASS,IABORT,RA,SA) 00750000 C 00760000 C SUBROUTINES CALLED: 00770000 C ARMVE 00780000 C ARSET 00790000 C MTOEPI 00800000 C CCOPY (ESSL/CRAY LIBRARY) 00810000 C FOCDD 00820000 C FORDSD 00830000 C FORP 00840000 C FOWDSD 00850000 C SAFX3DA 00860000 C SAFX3DB 00870000 C SAFX3DC 00880000 C SAFX3DE 00890000 C SAFX3DG 00900000 C SCOPY (ESSL/CRAY LIBRARY) 00910000 C USIDSK 00920000 C S2DFI2 00930000 C S2DFT2 00940000 C UGUWRK 00950000 C USRTHV 00960000 C 00970000 CEND 00980000 C***********************************************************************00990000 C 01000000 C EJECT 01010000 C 01020000 C=======================================================================01030000 C 01040000 C LOCAL ARRAYS (INTERNAL TO SUBROUTINE). 01050000 C 01060000 C DATTR ( 96) = ARRAY FOR ATTRIBUTES OF DATA I*4 01070000 C DENTRY ( 104) = ARRAY FOR STORAGE OF PARAMETER RECORDS I*4 01080000 C 01090000 C LOCAL VARIABLES AND CONSTANTS 01100000 C 01110000 C AUTO3 = FLAG INDICATING WHETHER BOUNDARY DETECTION IS ON I*4 01120000 C CDF = FIRST CDP OF PROCESSING RANGE I*4 01130000 C CDL = LAST CDP OF PROCESSING RANGE I*4 01140000 C CDPN = CDP NUMBER INPUT TO SUBROUTINE VIA /HEAD/ I*4 01150000 C CDPT = CDP TRACE NO. INPUT TO SUBROUTINE VIA /HEAD/ I*4 01160000 C DAP = COUNTER FOR PARAMETER READ & WRITE SUBROUTINES I*4 01170000 C DCTYP = PARAMETER RECORD TYPE 'PTS ' CHAR*4 01180000 C DELF = FREQUENCY SEPARATION IN HZ BETWEEN RADIAL FREQUENCY 01190000 C COMPONENTS R*4 01200000 C DEPTH = CHARACTER STRING 'DEPTH PT' CHAR*8 01210000 C FAB = FRACTIONAL ADD-BACK AS A FLOATING POINT NUMBER R*4 01220000 C FN = FILE NUMBER INPUT TO SUBROUTINE VIA /HEAD/ I*4 01230000 C FNYQ = NYQUIST FREQUENCY R*4 01240000 C FPMN = FLOATING POINT FORM OF MINIMUM FRACTION OF PATCH 01250000 C ALLOWED FOR PATCH OPERATOR TO BE USED R*4 01260000 C F1 = LOW-CUT FREQUENCY IN HZ I*4 01270000 C F2 = LOW-PASS FREQUENCY IN HZ I*4 01280000 C F3 = HIGH-PASS FREQUENCY IN HZ I*4 01290000 C F4 = HIGH-CUT FREQUENCY IN HZ I*4 01300000 C IABORT = FLAG SET TO YES IF PROCESS IS TO ABORT I*4 01310000 C ICC = AMOUNT OF RESERVED COMMON REQUIRED BY DEVELOPER I*4 01320000 C ICMN = FIRST LIVE CDP I*4 01330000 C ICMX = LAST LIVE CDP I*4 01340000 C IDTR = RELATIVE POSITION OF CURRENT CDP TO FIRST CDP OF 01350000 C PROCESSING RANGE CARD I*4 01360000 C IFLG = INDEX WHICH INDICATES IF A PATCH HAS ENOUGH TRACES TO 01370000 C BE USED IN OPERATOR DESIGN I*4 01380000 C IFLV = INDEX TO FIRST LIVE SAMPLE VALUE I*4 01390000 C IF1 = LOW-CUT RADIAL FREQUENCY INDEX I*4 01400000 C IF2 = LOW-PASS RADIAL FREQUENCY INDEX I*4 01410000 C IF3 = HIGH-PASS RADIAL FREQUENCY INDEX I*4 01420000 C IF4 = HIGH-CUT RADIAL FREQUENCY INDEX I*4 01430000 C ILIN = COUNTER OF INPUT 3D-LINES I*4 01440000 C IPR = SPARC PRINT UNIT FOR THE PROCESS I*4 01450000 C IREC = DISK FILE RECORD INDEX I*4 01460000 C ISB = SCRATCH COMMON INDEX FOR INFO ABOUT OVERLAPPING 01470000 C PATCHES I*4 01480000 C ISF = SCRATCH COMMON INDEX FOR STORING FILTERS FOR EACH 01490000 C PATCH I*4 01500000 C ISL = SCRATCH COMMON INDEX FOR STORING OUTPUT FROM CURRENT 01510000 C PATCH I*4 01520000 C ISM = SCRATCH COMMON INDEX FOR STORING INPUT TO CURRENT 01530000 C PATCH I*4 01540000 C ISO = SCRATCH COMMON INDEX FOR STORING OUTPUT DATA I*4 01550000 C ISR = SCRATCH COMMON INDEX FOR STORING COMPLEX CROSS- 01560000 C CORRELATIONS I*4 01570000 C ISW = SCRATCH COMMON INDEX FOR WORK AREA I*4 01580000 C ITRC = INPUT TRACE COUNTER FOR A SINGLE 3D-LINE I*4 01590000 C IXD = RESERVED COMMON INDEX FOR STORING DATA FOR A SINGLE 01600000 C FREQUENCY I*4 01610000 C IXG = RESERVED COMMON INDEX FOR RIGHT HAND SIDE OF NORMAL 01620000 C = EQUATIONS I*4 01630000 C IXH = RESERVED COMMON INDEX FOR STORING HEADERS FOR ONE 01640000 C LINE I*4 01650000 C IXP = RESERVED COMMON INDEX FOR FLAGING LIVE TRACES IN ALL 01660000 C 3D-LINES I*4 01670000 C IXT = RESERVED COMMON INDEX FOR STORING FREQUENCY DOMAIN 01680000 C TRACES FOR ONE LINE I*4 01690000 C JLIN = LINE COUNTER FOR OUTPUTTING 3D-LINES OF DATA I*4 01700000 C JSB = RELATED TO SCRATCH COMMON INDEX ISB AS WE LOOP OVER THE 01710000 C VARIOUS PATCHES I*4 01720000 C JSF = RELATED TO SCRATCH COMMON INDEX ISF AS WE LOOP OVER THE 01730000 C VARIOUS PATCHES I*4 01740000 C JTRC = TRACE COUNTER ON OUTPUT FOR A GIVEN 3D LINE I*4 01750000 C JXH = INDEX INTO RESERVED COMMON IXH FOR AN INDIVIDUAL TRACE 01760000 C HEADER I*4 01770000 C JXP = INDEX INTO RESERVED COMMON IXP FOR AN INDIVIDUAL TRACE 01780000 C FLAG I*4 01790000 C JXT = INDEX INTO RESERVED COMMON IXT FOR AN INDIVIDUAL 01800000 C FREQUENCY TRACE I*4 01810000 C KCDP = LOCAL INDEX TO A CDP WITHIN A GIVEN PATCH I*4 01820000 C KLIN = LOCAL INDEX TO A 3D-LINE WITHIN A GIVEN PATCH I*4 01830000 C KTRC = LOCAL INDEX TO A TRACE WITHIN A GIVEN PATHC I*4 01840000 C KXP = INDEX TO FLAG INDIVIDUAL TRACE RELATIVE TO JXP I*4 01850000 C LBUF = LENGTH OF LINKED-LIST INFORMATION BUFFER I*4 01860000 C LFI = IN-LINE SPATIAL FILTER LENGTH I*4 01870000 C LFX = CROSS-LINE SPATIAL FILTER LENGTH I*4 01880000 C LGI = IN-LINE DESIGN GATE LENGTH I*4 01890000 C LGX = CROSS-LINE DESIGN GATE LENGTH I*4 01900000 C LHDR = TRACE HEADER LENGTH IN WORDS I*4 01910000 C LNC = LINE NUMBER OF PREVIOUS INPUT TRACE I*4 01920000 C LNF = BEGINING 3D LINE NUMBER I*4 01930000 C LNL = ENDING 3D LINE NUMBER I*4 01940000 C LNT = LINE NUMBER OF CURRENT INPUT TRACE I*4 01950000 C LREC = DISK FILE RECORD LENGTH IN WORDS I*4 01960000 C M = THE POWER OF 2 THAT IS THE LENGTH OF THE FFT I*4 01970000 C MGI = LGI + LFI - 1 I*4 01980000 C MGX = LGX + LFX - 1 I*4 01990000 C MLIN = COUNTER OF COMPLETED INPUT 3D LINES I*4 02000000 C N = LENGTH OF THE FFT 2**M I*4 02010000 C NBL = NUMBER OF SAMPLES IN TRACE I*4 02020000 C NCDP = MAXIMUM NUMBER OF CDP PER LINE FROM RANGE CARD I*4 02030000 C NF = NUMBER OF RADIAL FREQUENCIES TO BE FILTERED I*4 02040000 C NLIN = MAXIMUM NUMBER OF 3D-LINES FROM RANGE CARD I*4 02050000 C NOPAR = NUMBER OF PARAMETERS ON SEISPARM FILE I*4 02060000 C NPAT = NUMBER OF PATCHES TO BE CONSIDERED I*4 02070000 C NREC = NUMBER OF DISK FILE RECORDS I*4 02080000 C NS = NUMBER OF SAMPLES INPUT TO SUBROUTINE VIA /HEAD/ I*4 02090000 C ORTN = ORIGINAL RECORD TRACE NUMBER INPUT VIA /HEAD/ I*4 02100000 C OSW = OUTPUT SELECTION SWITCH R*4 02110000 C PAB = PERCENTAGE OF INPUT TO ADD BACK R*4 02120000 C PASS = FLAG USED TO DETERMINE WHETHER TO PASS TRACE OUT OF 02130000 C PROCESS OR NOT. NO IMPLIES THAT TRACE IS NOT TO BE 02140000 C RETURNED FROM PROCESS; YES IMPLIES THAT IT IS TO BE 02150000 C RETURNED FROM PROCESS; YES3 AND NO3 IMPLY YES OR NO 02160000 C FOLLOWED BY A CALL TO ENTRY THREE OF THE SHELL I*4 02170000 C PMN = MINIMUM PERCENTAGE OF PATCH ALLOWED FOR PATCH OPERATOR 02180000 C TO BE USED R*4 02190000 C PTS = CHARACTER STRING 'PTS ' CHAR*4 02200000 C PWN = PERCENTAGE WHITE NOISE TO BE ADDED TO DIAGONAL R*4 02210000 C SC = TAPER WEIGHT FOR A GIVEN FREQUENCY R*4 02220000 C SI = SAMPLE INTERVAL IN MICROSEC. FROM /HEAD/ I*4 02230000 C SR = SAMPLE RATE IN MS. R*4 02240000 C TICD = TRACE IDENTIFICATION CODE FROM HEADER I*4 02250000 C TYPPNT = CHARACTER STRING WHICH IS SET TO SHOTPT,DEPTH,OR 02260000 C FILEN CHAR*8 02270000 C WNF = FLOATING POINT FORM OF PERCENTAGE OF WHITE NOISE R*4 02280000 C XATTR ( 96) = ARRAY FOR ATTRIBUTES OF DATA R*4 02290000 C XMAX = MAX. CROSS CORRELATION (RETURNED BY SAFX3DB) R*4 02300000 C ZERO = DATA STATEMENT VARIABLE DEFINED TO BE ZERO R*4 02310000 C 02320000 C 02330000 C====================================================================== 02340000 C 02350000 C PROCESS FX3D -- SPATIAL DECONVOLUTION OF 3-D STACKED DATA 02360000 C 02370000 C DATA CARD (1) -- DEFINES PROCESSING RANGE AND FILTER PARAMETERS 02380000 C 02390000 C NO. OF CARDS: REQUIRED = 1 ALLOWED = 1 02400000 C 02410000 C REQ OR OPT 02420000 C DF COLS DEFINITION OR DEFAULT 02430000 C -- ----- ---------- -----------02440000 C 1 1- 4 'FX3D' | REQ |02450000 C 2 - 5 PROCESS NUMBER | 0 |02460000 C 3 - 6 NOT USED | |02470000 C 4 - 7 PROCESSING MODE |LINE CARD|02480000 C 'D' = DEPTH POINT | |02490000 C 5 8-10 BLANK | |02500000 C 6 11-15 STARTING CDP NUMBER TO PROCESS | REQ |02510000 C 7 16-20 ENDING CDP NUMBER TO PROCESS | DF6 |02520000 C 8 21-25 IN-LINE SPATIAL FILTER LENGTH | 7 |02530000 C 9 26-30 CROSS-LINE SPATIAL FILTER LENGTH | 7 |02540000 C 10 31-35 PERCENTAGE WHITE NOISE | 1 |02550000 C 11 36-40 OUTPUT SWITCH: | 0 |02560000 C = 0 OUTPUT THE INPUT - NOISE ESTIMATED | |02570000 C = 1 OUTPUT THE NOISE ESTIMATED | |02580000 C 12 41-45 PERCENTAGE OF INPUT TO ADD-BACK | 0 |02590000 C 13 46-50 PERCENT MINIMUM FOR DESIGN PATCH | 60 |02600000 C 14 51-65 NOT USED | |02610000 C 17 66-70 FIRST 3D LINE NUMBER TO PROCESS | 1 |02620000 C 18 71-75 LAST 3D LINE NUMBER TO PROCESS | DF17 |02630000 C 19 76-80 NOT USED | |02640000 C | |02650000 C -----------02660000 C DF NOTES 02670000 C -- ----- 02680000 C 02690000 C 10 THIS FIELD MAY BE CODED IN FLOATING POINT FORMAT. 02700000 C A MINIMUM VALUE OF .5% WILL BE ACCEPTED. 02710000 C 02720000 C 12 THIS FIELD MAY BE CODED IN FLOATING POINT FORMAT. 02730000 C 02740000 C 13 THIS FIELD MAY BE CODED IN FLOATING POINT FORMAT. 02750000 C PATCHES WITH FEWER TRACES THAN THIS PERCENTAGE OF (DF8 MULTIPLIED02760000 C BY DF9 OF DATA CARD (2)) TRACES WILL BE FILTERED USING THE 02770000 C OPERATOR FROM THE NEAREST ACCEPTABLE PATCH. 02780000 C 02790000 C=======================================================================02800000 C 02810000 C PROCESS FX3D -- SPATIAL DECONVOLUTION OF 3-D STACKED DATA 02820000 C 02830000 C DATA CARD (2) -- DEFINES DESIGN GATE AND FREQUENCY RANGE 02840000 C 02850000 C NO. OF CARDS: REQUIRED = 1 ALLOWED = 1 02860000 C 02870000 C REQ OR OPT 02880000 C DF COLS DEFINITION OR DEFAULT 02890000 C -- ----- ---------- -----------02900000 C 1 1- 4 'FX3D' | REQ |02910000 C 2 - 5 PROCESS NUMBER | 0 |02920000 C 3 6- 9 NOT USED | |02930000 C 5 8-10 'DGS' | REQ |02940000 C 6 11-15 NOT USED | |02950000 C 7 16-20 NOT USED | |02960000 C 8 21-25 DESIGN GATE LENGTH IN-LINE (NUMBER OF CDP) | 100 |02970000 C 9 26-30 DESIGN GATE LENGTH CROSS-LINE (NUMBER OF CDP) | 100 |02980000 C 10 31-35 LOW-CUT FREQUENCY (HZ) | REQ |02990000 C 11 36-40 LOW-PASS FREQUENCY (HZ) | DF10 |03000000 C 12 41-45 HIGH-PASS FREQUENCY (HZ) | DF13 |03010000 C 13 46-50 HIGH-CUT FREQUENCY (HZ) |NOTE DF13|03020000 C 14 51-80 NOT USED | |03030000 C -----------03040000 C 03050000 C DF NOTES 03060000 C -- ----- 03070000 C 03080000 C 10 THIS IS THE LOW-CUT FREQUENCY IN HZ FOR THE START OF THE 03090000 C TRAPEZOIDAL FILTER. 03100000 C 03110000 C DEFAULT: 0 HZ. 03120000 C 03130000 C 11 THIS IS THE LOW-PASS FREQUENCY IN HZ FOR THE LOW FREQUENCY SIDE 03140000 C OF THE TRAPEZOIDAL FILTER. 03150000 C 03160000 C DEFAULT: LOW-CUT FREQUENCY. 03170000 C 03180000 C 12 THIS IS THE HIGH-PASS FREQUENCY IN HZ FOR THE START OF THE HIGH 03190000 C FREQUENCY SIDE OF TRAPEZOIDAL FILTER. 03200000 C 03210000 C DEFAULT: HIGH-CUT FREQUENCY. 03220000 C 03230000 C 13 THIS IS THE HIGH-CUT FREQUENCY IN HZ FOR THE END OF THE 03240000 C TRAPEZOIDAL FILTER. 03250000 C 03260000 C DEFAULT: NYQUIST FREQUENCY. 03270000 C 03280000 C EJECT 03290000 C=======================================================================03300000 C 03310000 C LAYOUT OF RESERVED BLANK COMMON 03320000 C 03330000 C ________________________________ 03340000 C KPIRSM --> : LLOCAL WORDS FOR : 03350000 C : LOCAL VARIABLES : 03360000 C : ("DLOCAL") : 03370000 C : : 03380000 C :______________________________: 03390000 C IXP --> : NLIN * NCDP WORDS : 03400000 C :______________________________: 03410000 C IXH --> : NCDP * LHDR WORDS : 03420000 C :______________________________: 03430000 C IXT --> : 2 * NF * NCDP WORDS : 03440000 C IC1 --> :______________________________: 03450000 C : : 03460000 C :______________________________: 03470000 C IXD=IXH --> : 2 * NLIN * NCDP WORDS : 03480000 C :______________________________: 03490000 C IXG --> : 2 * LFI * LFX WORDS : 03500000 C IC2 --> :______________________________: 03510000 C ICC --> : MAX0 (IC1, IC2) : 03520000 C :______________________________: 03530000 C 03540000 C 03550000 C LAYOUT OF SCRATCH BLANK COMMON 03560000 C 03570000 C KPIUSM --> :______________________________: 03580000 C ISB --> : LBUF WORDS : 03590000 C :______________________________: 03600000 C ISO --> : 2 * NCDP * NLIN WORDS : 03610000 C :______________________________: 03620000 C ISM --> : 2 * MGI * MGX WORDS : 03630000 C :______________________________: 03640000 C ISL --> : 2 * LGI * LGX WORDS : 03650000 C :______________________________: 03660000 C ISR --> : 2 * LFX * LFX * LFI WORDS : 03670000 C :______________________________: 03680000 C ISF --> : 2 * LFI * LFX * NPAT WORDS: 03690000 C :______________________________: 03700000 C ISW --> : 2 * (4 * LFI * LFX * LFX : 03710000 C : + 7 * LFX *LFX + 3 *LFX) : 03720000 C : WORDS : 03730000 C :______________________________: 03740000 C 03750000 C 03760000 SUBROUTINE SAFX3D0(OH,ICC,AUTO3,IABORT,RA) 03770000 C 03780000 IMPLICIT INTEGER(A-Z) 03790000 REAL RA 03800000 REAL OTR 03810000 REAL SA 03820000 REAL VEL 03830000 REAL SR 03840000 REAL OSW 03850000 REAL WNF 03860000 REAL FAB 03870000 REAL FPMN 03880000 REAL ZERO 03890000 REAL ASI 03900000 REAL PWN 03910000 REAL PAB 03920000 REAL PMN 03930000 REAL FNYQ 03940000 REAL DELF 03950000 REAL D12 03960000 REAL D34 03970000 REAL SC 03980000 REAL XMAX 03990000 C 04000000 DIMENSION OH(1), OTR(1), RA(1), SA(1),VEL(1) 04010000 C 04020000 INTEGER PASS 04030000 INTEGER YES 04040000 INTEGER NO 04050000 INTEGER YES3 04060000 INTEGER NO3 04070000 INTEGER AUTO3 04080000 INTEGER ORTN,CDPN,CDPT,TICD,XDST,SI,SSP,FN,THL 04090000 INTEGER ULOCAL 04100000 INTEGER SLOCAL 04110000 C 04120000 CHARACTER*8 DEPTH 04130000 CHARACTER*8 TYPPNT 04140000 CHARACTER*4 DCTYP 04150000 CHARACTER*4 PTS 04160000 C 04170000 REAL XATTR (96) 04180000 C 04190000 DIMENSION DATTR(96),DENTRY(104) 04200000 C 04210000 C 04220000 C COMMON /P/ STATEMENTS GENERATED BY UTCGI4 12/12/83 04230000 COMMON /P/ STARTP(2) , M00000( 10) 04240000 COMMON /P/ LCTPSP , M00048( 2) 04250000 COMMON /P/ LCPI , M00060 04260000 COMMON /P/ LCMXFD , M00068( 86) 04270000 COMMON /P/ KPNA 04280000 COMMON /P/ KPRNO , M00420( 5) 04290000 COMMON /P/ KPWRKS 04300000 COMMON /P/ KPWRKD 04310000 COMMON /P/ KPWKS2 04320000 COMMON /P/ KPWKD2 04330000 COMMON /P/ KPWKS3 04340000 COMMON /P/ KPWKD3 , M00464 04350000 COMMON /P/ KPIRSM 04360000 COMMON /P/ KPNRSM 04370000 COMMON /P/ KPIUSM 04380000 COMMON /P/ KPNUSM , M00484( 10) 04390000 COMMON /P/ KPPRNT , M00528( 2) 04400000 COMMON /P/ KPBUGF , M00540( 226) 04410000 COMMON /P/ ENDP 04420000 C 04430000 C 04440000 COMMON /HEAD/ ORTN,CDPN,CDPT,TICD,XDST,NS,SI,SSP,FN,THL 04450000 COMMON /USER/ SLOCAL(50), ULOCAL(100) 04460000 C 04470000 C DENTRY IS AN ARRAY TO HOLD A PARAMETER RECORD. THE DEFINITIONS 04480000 C OF THE FIRST EIGHT WORDS ARE FIXED. THE REMAINING WORDS ARE 04490000 C FOR VARIABLE PARAMETERS AND ARE USUALLY ADDRESSED USING "DATTR". 04500000 C THE MAXIMUM LENGTH OF DENTRY IS 104 BECAUSE OF THE I/O ROUTINES. 04510000 C 04520000 EQUIVALENCE (DCTYP , DENTRY (03)) 04530000 EQUIVALENCE (SPT , DENTRY (04)) 04540000 EQUIVALENCE (SPE , DENTRY (05)) 04550000 EQUIVALENCE (NOPAR , DENTRY (06)) 04560000 EQUIVALENCE (SPLOCN , DENTRY (07)) 04570000 EQUIVALENCE (DATTR(1) , DENTRY (09)) 04580000 C 04590000 EQUIVALENCE (DATTR(1) , XATTR(1)) 04600000 C 04610000 EQUIVALENCE (NBL ,ULOCAL( 1)) 04620000 EQUIVALENCE (SR ,ULOCAL( 2)) 04630000 EQUIVALENCE (IPR ,ULOCAL( 3)) 04640000 C EQUIVALENCE (MODE ,ULOCAL( 4)) 04650000 C EQUIVALENCE (NTRC ,ULOCAL( 5)) 04660000 EQUIVALENCE (ITRC ,ULOCAL( 6)) 04670000 EQUIVALENCE (JTRC ,ULOCAL( 7)) 04680000 EQUIVALENCE (ILIN ,ULOCAL( 8)) 04690000 EQUIVALENCE (JLIN ,ULOCAL( 9)) 04700000 EQUIVALENCE (CDF ,ULOCAL(10)) 04710000 EQUIVALENCE (CDL ,ULOCAL(11)) 04720000 EQUIVALENCE (LNF ,ULOCAL(12)) 04730000 EQUIVALENCE (LNL ,ULOCAL(13)) 04740000 EQUIVALENCE (M ,ULOCAL(14)) 04750000 EQUIVALENCE (N ,ULOCAL(15)) 04760000 EQUIVALENCE (NCDP ,ULOCAL(16)) 04770000 EQUIVALENCE (NLIN ,ULOCAL(17)) 04780000 EQUIVALENCE (LGI ,ULOCAL(18)) 04790000 EQUIVALENCE (LGX ,ULOCAL(19)) 04800000 EQUIVALENCE (LFI ,ULOCAL(20)) 04810000 EQUIVALENCE (LFX ,ULOCAL(21)) 04820000 EQUIVALENCE (IF1 ,ULOCAL(22)) 04830000 EQUIVALENCE (IF2 ,ULOCAL(23)) 04840000 EQUIVALENCE (IF3 ,ULOCAL(24)) 04850000 EQUIVALENCE (IF4 ,ULOCAL(25)) 04860000 EQUIVALENCE (NF ,ULOCAL(26)) 04870000 EQUIVALENCE (IXH ,ULOCAL(27)) 04880000 EQUIVALENCE (IXT ,ULOCAL(28)) 04890000 EQUIVALENCE (IXP ,ULOCAL(29)) 04900000 CDC EQUIVALENCE (IXL ,ULOCAL(30)) 04910000 EQUIVALENCE (IXD ,ULOCAL(31)) 04920000 EQUIVALENCE (IXG ,ULOCAL(32)) 04930000 EQUIVALENCE (OSW ,ULOCAL(33)) 04940000 EQUIVALENCE (WNF ,ULOCAL(34)) 04950000 EQUIVALENCE (FAB ,ULOCAL(35)) 04960000 EQUIVALENCE (LNC ,ULOCAL(36)) 04970000 CDC EQUIVALENCE (KXL ,ULOCAL(37)) 04980000 EQUIVALENCE (ICMN ,ULOCAL(38)) 04990000 EQUIVALENCE (ICMX ,ULOCAL(39)) 05000000 EQUIVALENCE (FPMN ,ULOCAL(40)) 05010000 EQUIVALENCE (JXP ,ULOCAL(41)) 05020000 C 05030000 DATA ZERO / 0. / 05040000 C 05050000 DATA DEPTH / 'DEPTH PT' / 05060000 DATA PTS / 'PTS ' / 05070000 DATA YES /0/ 05080000 DATA NO /1/ 05090000 DATA YES3 /2/ 05100000 DATA NO3 /3/ 05110000 C 05120000 C=======================================================================05130000 C 05140000 C INITIALIZE VARIABLES 05150000 C 05160000 IPR = KPPRNT 05170000 IABORT = NO 05180000 ASI = SI 05190000 SR = ASI/1000. 05200000 NBL = NS 05210000 AUTO3 = NO 05220000 C 05230000 C=======================================================================05240000 C=======================================================================05250000 C 05260000 C READ SEISPARM FILE 05270000 C 05280000 DAP = 1 05290000 C 05300000 100 CALL FORP (KPNA, KPRNO, DAP, 104, DENTRY, *2600) 05310000 IF (DCTYP .NE. PTS) GO TO 100 05320000 C 05330000 C OBTAIN VARIABLES FROM ATTRIBUTE ARRAY DATTR 05340000 C 05350000 C#######################################################################05360000 C 05370000 C READ THE STARTING CDP NUMBER FOR THIS PROCESSING RANGE 05380000 C 05390000 CDF = DATTR (1) 05400000 C 05410000 C READ THE ENDING CDP NUMBER FOR THIS PROCESSING RANGE 05420000 C 05430000 CDL = DATTR (2) 05440000 C 05450000 C-----------------------------------------------------------------------05460000 C 05470000 C READ THE IN-LINE SPATIAL FILTER LENGTH. IF THE VALUE IS POSITIVE 05480000 C THEN IT IS TO BE APPLIED POST-STACK WITH THE INDICATED NUMBER 05490000 C OF TRACES IN THE FILTER. 05500000 C 05510000 C-----------------------------------------------------------------------05520000 C 05530000 LFI = DATTR(3) 05540000 C 05550000 C-----------------------------------------------------------------------05560000 C 05570000 C READ THE CROSS-LINE SPATIAL FILTER LENGTH. IF THE VALUE IS 05580000 C POSITIVE THEN IT IS TO BE APPLIED POST-STACK WITH THE INDICATED 05590000 C NUMBER OF TRACES IN THE FILTER. 05600000 C 05610000 C-----------------------------------------------------------------------05620000 C 05630000 LFX = DATTR(4) 05640000 C 05650000 C-----------------------------------------------------------------------05660000 C 05670000 C OBTAIN THE PERCENTAGE OF WHITE NOISE. IT MAY BE A FLOATING 05680000 C POINT VALUE. 05690000 C 05700000 C-----------------------------------------------------------------------05710000 C 05720000 PWN = XATTR(5) 05730000 C 05740000 C-----------------------------------------------------------------------05750000 C 05760000 C DETERMINE THE OUTPUT SELECTION VALUE. A ZERO INDICATES THAT 05770000 C WE WISH TO OUTPUT THE INPUT - NOISE ESTIMATED; A VALUE OF ONE 05780000 C INDICATES THAT WE WISH THE NOISE ESTIMATED TO BE OUTPUT. THE 05790000 C DEFAULT VALUE IS ZERO 05800000 C 05810000 C-----------------------------------------------------------------------05820000 C 05830000 OSW = FLOAT(DATTR(6)) 05840000 C 05850000 C-----------------------------------------------------------------------05860000 C 05870000 C DETERMINE THE PERCENTAGE OF THE INPUT TO BE ADDED BACK TO 05880000 C THE RESULT BEFORE OUTPUT. THE DEFAULT VALUE IS ZERO. A 05890000 C FLOATING POINT VALUE IS PERMITTED. 05900000 C 05910000 C-----------------------------------------------------------------------05920000 C 05930000 PAB = XATTR(7) 05940000 C 05950000 C-----------------------------------------------------------------------05960000 C 05970000 C DETERMINE THE MINIMUM PERCENTAGE FOR THE DESIGN PATCH. 05980000 C THE DEFAULT VALUE IS 60. A FLOATING POINT VALUE IS PERMITTED. 05990000 C 06000000 C-----------------------------------------------------------------------06010000 C 06020000 PMN = XATTR(8) 06030000 C 06040000 C-----------------------------------------------------------------------06050000 C 06060000 C READ THE BEGINING LINE (LNF) AND ENDING LINE NUMBER (LNL). 06070000 C 06080000 C-----------------------------------------------------------------------06090000 C 06100000 LNF = DATTR(9) 06110000 LNL = DATTR(10) 06120000 C 06130000 C-----------------------------------------------------------------------06140000 C 06150000 C READ THE IN-LINE DESIGN GATE LENGTH (NUMBER OF CDP'S) 06160000 C 06170000 C-----------------------------------------------------------------------06180000 C 06190000 LGI = DATTR(11) 06200000 C 06210000 C-----------------------------------------------------------------------06220000 C 06230000 C READ THE CROSS-LINE DESIGN GATE LENGTH (NUMBER OF CDP'S) 06240000 C 06250000 C-----------------------------------------------------------------------06260000 C 06270000 LGX = DATTR(12) 06280000 C 06290000 C-----------------------------------------------------------------------06300000 C 06310000 C READ LOW-CUT FREQUENCY IN HZ 06320000 C 06330000 C-----------------------------------------------------------------------06340000 C 06350000 F1 = DATTR(13) 06360000 C 06370000 C-----------------------------------------------------------------------06380000 C 06390000 C READ THE LOW-PASS FREQUENCY IN HZ 06400000 C 06410000 C-----------------------------------------------------------------------06420000 C 06430000 F2 = DATTR(14) 06440000 C 06450000 C-----------------------------------------------------------------------06460000 C 06470000 C READ THE HIGH-CUT FREQUENCY IN HZ 06480000 C 06490000 C-----------------------------------------------------------------------06500000 C 06510000 F3 = DATTR(15) 06520000 C 06530000 C-----------------------------------------------------------------------06540000 C 06550000 C READ THE HIGH-PASS FREQUENCY 06560000 C 06570000 C-----------------------------------------------------------------------06580000 C 06590000 F4 = DATTR(16) 06600000 C 06610000 C-----------------------------------------------------------------------06620000 C 06630000 C SET THE PROCESSING MODE 06640000 C 06650000 TYPPNT = DEPTH 06660000 C 06670000 C#######################################################################06680000 C=======================================================================06690000 C 06700000 C WRITE OUT PARAMETERS 06710000 C 06720000 C***********************************************************************06730000 C 06740000 C PRINT INPUT PARAMETERS READ FROM DISK PARAMETER FILE 06750000 C 06760000 C***********************************************************************06770000 C 06780000 WRITE (KPPRNT, 9080) TYPPNT, CDF, TYPPNT, CDL 06790000 06800000 WRITE (KPPRNT, 9100) LFI, LFX, PWN, OSW, PAB, PMN, LGI, LGX, 06810000 + F1, F2, F3, F4, LNF, LNL 06820000 C 06830000 9080 FORMAT ('03D SPATIAL DECONVOLUTION FROM ', A8,1X,I5,' TO ', 06840000 +A8,1X,I5,' PARAMETER VALUES SELECTED ARE'/1X,102('=')) 06850000 C 06860000 9100 FORMAT('0IN-LINE SPATIAL FILTER LENGTH:',3X,I7,T60, 06870000 * 'CROSS-LINE SPATIAL FILTER LENGTH:',1X,I7/1X, 06880000 * 'PERCENTAGE WHITE NOISE:',10X,F7.2,T60, 06890000 * 'OUTPUT SELECTION SWITCH:',10X,F7.0/1X, 06900000 * 'PERCENTAGE OF INPUT FOR ADD-BACK:',F7.2,T60, 06910000 * 'PERCENTAGE MIN. FOR DESIGN PATCH:',1X,F7.2/1X, 06920000 * 'IN-LINE SPATIAL DESIGN GATE:',5X,I7,T60, 06930000 * 'CROSS-LINE SPATIAL DESIGN GATE:',4X,I6/1X, 06940000 * 'LOW-CUT FREQUENCY:',15X,I7,' HZ',T60, 06950000 * 'LOW-PASS FREQUENCY:',15X,I7,' HZ'/1X, 06960000 * 'HIGH-PASS FREQUENCY:',13X,I7,' HZ',T60, 06970000 * 'HIGH-CUT FREQUENCY:',15X,I7,' HZ'/1X, 06980000 * 'STARTING 3D LINE NUMBER:',10X,I6,T60, 06990000 * 'ENDING 3D LINE NUMBER:',12X,I7//) 07000000 C 07010000 C***********************************************************************07020000 C=======================================================================07030000 C 07040000 C FREQUENCY DOMAIN SPECIFICATIONS 07050000 C 07060000 M = 5 07070000 N = 32 07080000 250 M = M + 1 07090000 N = 2*N 07100000 IF( N.LT.NBL ) GO TO 250 07110000 C 07120000 FNYQ = 500./SR 07130000 DELF = FNYQ/FLOAT(N/2) 07140000 C 07150000 C 07160000 IF1 = FLOAT(F1)/DELF + 1.0 07170000 IF2 = FLOAT(F2)/DELF + 1.0 07180000 IF3 = FLOAT(F3)/DELF + 1.0 07190000 IF4 = FLOAT(F4)/DELF + 1.0 07200000 NF = IF4 - IF1 + 1 07210000 C 07220000 C=======================================================================07230000 C 07240000 C COMPUTATIONAL PARAMETERS 07250000 C 07260000 NCDP = CDL - CDF + 1 07270000 NLIN = LNL - LNF + 1 07280000 LFI = 2*(LFI/2) + 1 07290000 LFX = 2*(LFX/2) + 1 07300000 C 07310000 WNF = PWN/100. + 1. 07320000 FAB = PAB/100. 07330000 FPMN = PMN/100. 07340000 C 07350000 C=======================================================================07360000 C 07370000 C ALLOCATE RA AREA FOR STORING DATA 07380000 C 07390000 C FIRST - AREA TO KEEP TRACK OF LIVE CDP'S FOR EACH LINE 07400000 C PLUS AREA TO STORE A FULL LINE OF INPUT DATA 07410000 C 07420000 C IXP: ARRAY TO FLAG LIVE TRACES IN ALL LINES 07430000 C IXH: STORAGE FOR HEADERS FOR ONE LINE 07440000 C IXT: STORAGE FOR FREQUENCY DOMAIN TRACES FOR ONE LINE 07450000 C 07460000 C 07470000 CALL USRTHV( OH,'THL ',LHDR ) 07480000 IXP = 1 07490000 IXH = IXP + NLIN*NCDP 07500000 IXT = IXH + NCDP*LHDR 07510000 IC1 = IXT + 2*NF*NCDP 07520000 C 07530000 C THEN - ALLOCATE STORAGE FOR A SINGLE FREQUENCY 07540000 C 07550000 C IXD: DATA FOR A SINGLE FREQUENCY 07560000 C IXG: RIGHT HAND SIDE OF NORMAL EQUATIONS 07570000 C 07580000 IXD = IXH 07590000 IXG = IXD + 2*NLIN*NCDP 07600000 IC2 = IXG + 2*LFI*LFX 07610000 C 07620000 ICC = MAX0( IC1,IC2) 07630000 C 07640000 C=======================================================================07650000 C 07660000 C ALLOCATE DISK SPACE: 07670000 C 07680000 C HEADERS - RECORD LENGTH = LHDR 07690000 C NUMBER OF RECORDS = NCDP*NLIN 07700000 C 07710000 LREC = LHDR 07720000 NREC = NCDP*NLIN 07730000 CALL USIDSK( KPWKS2,KPWKD2,NREC,LREC,RA ) 07740000 C 07750000 C 07760000 C DATA - RECORD LENGTH = 2*NCDP 07770000 C NUMBER OF RECORDS = NF*NLIN 07780000 C 07790000 LREC = 2*NCDP 07800000 NREC = NF*NLIN 07810000 CALL USIDSK( KPWRKS,KPWRKD,NREC,LREC,RA ) 07820000 C 07830000 C=======================================================================07840000 C 07850000 C INITIALIZE COUNTERS 07860000 C 07870000 ITRC = 0 07880000 JTRC = 0 07890000 ILIN = 0 07900000 JLIN = 0 07910000 LNC = 0 07920000 C 07930000 C=======================================================================07940000 C 07950000 RETURN 07960000 C 07970000 C 07980000 C SAFX3D1 ENTRY STARTS HERE 07990000 C******************************************************************* 08000000 C******************************************************************* 08010000 C 08020000 ENTRY SAFX3D1(OH,OTR,VEL,PASS,IABORT,RA,SA) 08030000 C 08040000 C******************************************************************* 08050000 C******************************************************************* 08060000 C 08070000 IABORT = NO 08080000 PASS = NO 08090000 JXP = IXP 08100000 ICMN = CDPN 08110000 ICMX = CDPN 08120000 C 08130000 C ZERO RA(IXP) 08140000 C 08150000 CALL SCOPY( NCDP*NLIN,ZERO,0,RA(IXP),1 ) 08160000 C 08170000 C******************************************************************* 08180000 C******************************************************************* 08190000 C 08200000 ENTRY SAFX3D2(OH,OTR,VEL,PASS,IABORT,RA,SA) 08210000 C 08220000 C******************************************************************* 08230000 C******************************************************************* 08240000 C 08250000 C 08260000 C CHECK THAT THIS TRACE IS TO BE PROCESSED 08270000 C 08280000 PASS = NO 08290000 FNT = CDPN 08300000 IF( FNT.LT.CDF ) RETURN 08310000 IF( FNT.GT.CDL ) RETURN 08320000 C 08330000 CALL USRTHV( OH,'THLNNO ',LNT ) 08340000 IF( LNT.LT.LNF ) RETURN 08350000 IF( LNT.GT.LNL ) RETURN 08360000 C 08370000 ICMN = MIN0(ICMN,CDPN) 08380000 ICMX = MAX0(ICMX,CDPN) 08390000 C 08400000 C=======================================================================08410000 C 08420000 IF( LNT.EQ.LNC ) GO TO 500 08430000 C 08440000 C THIS IS A NEW LINE 08450000 C 08460000 MLIN = ILIN 08470000 ILIN = ILIN + 1 08480000 IF( ILIN.EQ.1 ) THEN 08490000 LNC = LNT 08500000 GO TO 500 08510000 ENDIF 08520000 C 08530000 C FOR THE PRECEDING LINE: 08540000 C 08550000 C 1. STORE HEADERS 08560000 C 08570000 IREC = 1 + (MLIN-1)*NCDP 08580000 JXH = IXH 08590000 DO 300 ICDP = 1,NCDP 08600000 CALL FOWDSD( KPWKD2,IREC,RA(JXH) ) 08610000 300 JXH = JXH + LHDR 08620000 C 08630000 C 2. STORE DATA IN VECTORS OF FIXED FREQUENCY 08640000 C 08650000 IREC = 1 + (MLIN-1)*NF 08660000 DO 400 IF = 1,NF 08670000 JXT = IXT + 2*(IF-1) 08680000 CALL CCOPY( NCDP,RA(JXT),NF,SA,1 ) 08690000 CALL FOWDSD( KPWRKD,IREC,SA ) 08700000 400 CONTINUE 08710000 C 08720000 C 3. ZERO RA(IXT) 08730000 C 08740000 CALL SCOPY( 2*NF*NCDP,ZERO,0,RA(IXT),1 ) 08750000 C 08760000 LNC = LNT 08770000 ITRC = 0 08780000 JXP = JXP + NCDP 08790000 C 08800000 C=======================================================================08810000 C 08820000 C STORE HEADER IN RA 08830000 C 08840000 500 ITRC = ITRC + 1 08850000 IDTR = CDPN - CDF 08860000 JXH = IXH + LHDR*IDTR 08870000 CALL SCOPY( LHDR,OH,1,RA(JXH),1 ) 08880000 C 08890000 C STORE FFT OF TRACE IN RA AND 08900000 C RECORD THIS LIVE TRACE IN RA(IXP) BUFFER 08910000 C 08920000 KXP = JXP + IDTR 08930000 JXT = IXT + 2*NF*IDTR 08940000 C 08950000 IF( TICD.EQ.1 ) THEN 08960000 CALL ARSET( SA,N,0. ) 08970000 CALL ARMVE(OTR(1),SA(1),NBL ) 08980000 CALL S2DFT2( M,SA,*2700) 08990000 IS = 2*IF1 - 1 09000000 CALL ARMVE( SA(IS),RA(JXT),2*NF ) 09010000 RA(KXP) = 1. 09020000 ELSE 09030000 RA(KXP) = -1. 09040000 ENDIF 09050000 C 09060000 IF( ILIN.EQ.NLIN .AND. ITRC.EQ.NCDP ) PASS = NO3 09070000 C 09080000 C=======================================================================09090000 C 09100000 RETURN 09110000 C 09120000 C******************************************************************* 09130000 C******************************************************************* 09140000 C 09150000 ENTRY SAFX3D3(OH,OTR,VEL,PASS,IABORT,RA,SA) 09160000 C 09170000 C******************************************************************* 09180000 C******************************************************************* 09190000 C 09200000 C 09210000 PASS = NO 09220000 IF( JLIN.GT.0 ) GO TO 1900 09230000 C 09240000 C FOR THE LAST LINE: 09250000 C 09260000 C 1. STORE HEADERS 09270000 C 09280000 IREC = 1 + (ILIN-1)*NCDP 09290000 JXH = IXH 09300000 DO 600 ICDP = 1,NCDP 09310000 CALL FOWDSD( KPWKD2,IREC,RA(JXH) ) 09320000 600 JXH = JXH + LHDR 09330000 C 09340000 C 2. STORE DATA IN VECTORS OF FIXED FREQUENCY 09350000 C 09360000 IREC = 1 + (ILIN-1)*NF 09370000 DO 700 IF = 1,NF 09380000 JXT = IXT + 2*(IF-1) 09390000 CALL CCOPY( NCDP,RA(JXT),NF,SA,1 ) 09400000 CALL FOWDSD( KPWRKD,IREC,SA ) 09410000 700 CONTINUE 09420000 C 09430000 C 3. USE INFORMATION IN RA(IXP) TO FIGURE OUT THE 09440000 C OVERLAP LOGIC - OVERLAP ZONES, WEIGHTS ETC. 09450000 C 09460000 ICMN = ICMN - CDF + 1 09470000 ICMX = ICMX - CDF + 1 09480000 C 09490000 CALL SAFX3DG( RA(IXP),NCDP,NLIN,ICMN,ICMX,ILIN,FPMN, 09500000 * LGI,LGX,LFI,LFX, 09510000 * NPAT,SA(1),LBUF,RA(IXT) ) 09520000 C 09530000 C 09540000 C=======================================================================09550000 C 09560000 C ALLOCATE SA AREAS FOR COMPUTATION 09570000 C 09580000 C ISB: BUFFER CONTAINING INFORMATION ABOUT OVERLAPPING 09590000 C ISO: OUTPUT DATA STORAGE 09600000 C ISM: AREA FOR INPUT DATA OF CURRENT PATCH TO BE HELD 09610000 C ISL: AREA FOR OUTPUT DATA OF CURRENT PATCH TO BE HELD 09620000 C ISR: AREA FOR STORING COMPLEX CROSS-CORRELATIONS 09630000 C ISF: FILTERS FOR EACH PATCH 09640000 C ISW: WORK AREA 09650000 C 09660000 C 09670000 MGI = LGI + LFI - 1 09680000 MGX = LGX + LFX - 1 09690000 C 09700000 ISB = 1 09710000 ISO = ISB + LBUF 09720000 ISM = ISO + 2*NCDP*NLIN 09730000 ISL = ISM + 2*MGI*MGX 09740000 ISR = ISL + 2*LGI*LGX 09750000 ISF = ISR + 2*LFX*LFX*LFI 09760000 ISW = ISF + 2*LFI*LFX*NPAT 09770000 C 09780000 C=======================================================================09790000 C 09800000 C SPATIAL PREDICTION: 09810000 C 09820000 C INITIALIZE RHS VECTOR 09830000 C 09840000 CALL SCOPY( 2*LFI*LFX,ZERO,0,RA(IXG),1 ) 09850000 JXG = IXG + 2*(LFI/2)*LFX + 2*(LFX/2) 09860000 RA(JXG) = 1. 09870000 C 09880000 C OUTER LOOP ON FREQUENCY 09890000 C 09900000 D12 = IF2 - IF1 09910000 D34 = IF4 - IF3 09920000 DO 1800 IF = 1,NF 09930000 C 09940000 C ---------------------------------------------------------------------09950000 C 09960000 C FETCH THE NLIN*NCDP DATA POINTS FOR THIS FREQUENCY 09970000 C 09980000 DO 1100 IRC = 1,NLIN 09990000 IREC = IF + (IRC-1)*NF 10000000 JXD = IXD + 2*NCDP*(IRC-1) 10010000 1100 CALL FORDSD( KPWRKD,IREC,RA(JXD) ) 10020000 C 10030000 C ---------------------------------------------------------------------10040000 C 10050000 C TAPER WEIGHT FOR THIS FREQUENCY 10060000 C 10070000 SC = 1. 10080000 JF = IF + IF1 - 1 10090000 IF( JF.GE.IF1 .AND. JF.LT.IF2 ) SC = FLOAT(JF-IF1)/D12 10100000 IF( JF.GT.IF3 .AND. JF.LE.IF4 ) SC = FLOAT(IF4-JF)/D34 10110000 C 10120000 C ---------------------------------------------------------------------10130000 C ---------------------------------------------------------------------10140000 C 10150000 C FIRST LOOP ON PATCHES - OPERATOR DESIGN 10160000 C 10170000 JSB = ISB 10180000 DO 1400 IPAT = 1,NPAT 10190000 C 10200000 LBUF = SA(JSB) 10210000 IFLG = SA(JSB+1) 10220000 KCDP = SA(JSB+2) 10230000 KLIN = SA(JSB+3) 10240000 IF( IFLG.NE.IPAT ) GO TO 1400 10250000 C 10260000 C COMPUTE REQUIRED CORRELATIONS 10270000 C 10280000 CALL SAFX3DB( RA(IXD),NCDP,NLIN,KCDP,LGI,KLIN,LGX, 10290000 * SA(ISR),XMAX,LFI,LFX,WNF,SA(ISW) ) 10300000 C 10310000 C 10320000 C ---------------------------------------------------------------------10330000 C 10340000 C NOW THE FILTERS CAN BE CALCULATED 10350000 C 10360000 JSF = ISF + 2*LFI*LFX*(IPAT-1) 10370000 CALL MTOEPI( LFX,LFI,SA(ISR),XMAX,RA(IXG), 10380000 * SA(JSF),SA(ISW),*2800) 10390000 C 10400000 C 10410000 C ---------------------------------------------------------------------10420000 C 10430000 C ADJUST THE FILTERS ACCORDING TO THE VALUES 10440000 C OF SC,FAB AND OSW 10450000 C 10460000 CALL SAFX3DA( LFX,LFI,SA(JSF),SC,FAB,OSW ) 10470000 C 10480000 1400 JSB = JSB + LBUF 10490000 C 10500000 C ---------------------------------------------------------------------10510000 C ---------------------------------------------------------------------10520000 C 10530000 C SECOND LOOP ON PATCHES - OPERATOR APPLICATION 10540000 C 10550000 JSB = ISB 10560000 DO 1600 IPAT = 1,NPAT 10570000 C 10580000 LBUF = SA(JSB) 10590000 JPAT = SA(JSB+1) 10600000 KCDP = SA(JSB+2) 10610000 KLIN = SA(JSB+3) 10620000 IF( JPAT.LE.0 ) GO TO 1600 10630000 C 10640000 C APPLY THE FILTERS 10650000 C 10660000 JSF = ISF + 2*LFI*LFX*(JPAT-1) 10670000 CALL SAFX3DC( RA(IXD),NCDP,NLIN,KCDP,KLIN,SA(JSF),LFI,LFX, 10680000 * SA(ISM),MGI,MGX,SA(ISL),LGI,LGX ) 10690000 C 10700000 C MERGE FILTERED RESULT INTO OUTPUT BUFFER 10710000 C 10720000 CALL SAFX3DE( SA(ISO),NCDP,NLIN,KCDP,KLIN, 10730000 * SA(ISL),LGI,LGX,SA(JSB),LBUF ) 10740000 C 10750000 1600 JSB = JSB + LBUF 10760000 C 10770000 C ---------------------------------------------------------------------10780000 C ---------------------------------------------------------------------10790000 C 10800000 C RESTORE THE NLIN*NCDP DATA POINTS FOR THIS FREQUENCY 10810000 C 10820000 DO 1700 IRC = 1,NLIN 10830000 IREC = IF + (IRC-1)*NF 10840000 JSO = ISO + 2*NCDP*(IRC-1) 10850000 1700 CALL FOWDSD( KPWRKD,IREC,SA(JSO) ) 10860000 C 10870000 C ---------------------------------------------------------------------10880000 C 10890000 1800 CONTINUE 10900000 C 10910000 JLIN = 1 10920000 JXP = IXP 10930000 C 10940000 C=======================================================================10950000 C 10960000 C OUTPUT TRACES 10970000 C 10980000 C ---------------------------------------------------------------------10990000 C 11000000 C CHECK COUNTERS FOR CDP(JTRC) AND LINE(JLIN) 11010000 C 11020000 1900 JTRC = JTRC + 1 11030000 C 11040000 C FOR A NEW LINE RESET JTRC AND INCREMENT JLIN 11050000 C 11060000 IF( JTRC.GT.NCDP ) THEN 11070000 JTRC = 1 11080000 JLIN = JLIN + 1 11090000 JXP = JXP + NCDP 11100000 ENDIF 11110000 C 11120000 IF( JLIN.GT.ILIN ) RETURN 11130000 C 11140000 C ---------------------------------------------------------------------11150000 C 11160000 IF( JTRC.GT.1 ) GO TO 2500 11170000 C 11180000 C ---------------------------------------------------------------------11190000 C 11200000 C THIS IS A NEW LINE - NEED TO FETCH HEADERS 11210000 C AND FILTERED DATA 11220000 C 11230000 C 11240000 IREC = 1 + (JLIN-1)*NCDP 11250000 JXH = IXH 11260000 DO 2100 ICDP = 1,NCDP 11270000 CALL FORDSD( KPWKD2,IREC,RA(JXH) ) 11280000 2100 JXH = JXH + LHDR 11290000 C 11300000 IREC = 1 + (JLIN-1)*NF 11310000 DO 2200 IF = 1,NF 11320000 CALL FORDSD( KPWRKD,IREC,SA ) 11330000 JXT = IXT + 2*(IF-1) 11340000 2200 CALL CCOPY( NCDP,SA,1,RA(JXT),NF ) 11350000 C 11360000 C ---------------------------------------------------------------------11370000 C 11380000 IF( JLIN.EQ.ILIN ) THEN 11390000 C 11400000 C CLOSE UP WORK FILES 11410000 C 11420000 CALL FOCDD( KPWRKD ) 11430000 CALL UGUWRK( KPWRKS,KPWRKD,ERR1,ERR2 ) 11440000 CALL FOCDD( KPWKD2 ) 11450000 CALL UGUWRK( KPWKS2,KPWKD2,ERR3,ERR4 ) 11460000 ENDIF 11470000 C 11480000 C ---------------------------------------------------------------------11490000 C 11500000 C PREPARE DATA FOR OUTPUT 11510000 C 11520000 2500 CONTINUE 11530000 KXP = JXP + JTRC - 1 11540000 IF( RA(KXP).EQ.0. ) THEN 11550000 PASS = NO3 11560000 IF( JTRC.EQ.NCDP .AND. JLIN.EQ.ILIN ) PASS = NO 11570000 RETURN 11580000 ENDIF 11590000 C 11600000 C THIS TRACE IS TO BE OUTPUT 11610000 C 11620000 PASS = YES3 11630000 IF( JTRC.EQ.NCDP .AND. JLIN.EQ.ILIN ) PASS = YES 11640000 C 11650000 JXH = IXH + LHDR*(JTRC-1) 11660000 CALL SCOPY( LHDR,RA(JXH),1,OH,1 ) 11670000 CALL USRTHV( OH,'THTICD ',ITID ) 11680000 C 11690000 C IF TRACE IS DEAD, ZERO IT 11700000 C 11710000 IF( RA(KXP).LT.0. ) THEN 11720000 CALL SCOPY( NBL,ZERO,0,OTR,1 ) 11730000 RETURN 11740000 ENDIF 11750000 C 11760000 C OTHERWISE, INVERSE TRANSFORM 11770000 C 11780000 CALL SCOPY( N+2,ZERO,0,SA,1 ) 11790000 JXT = IXT + 2*NF*(JTRC-1) 11800000 ISX = 1 + 2*(IF1-1) 11810000 CALL CCOPY( NF,RA(JXT),1,SA(ISX),1 ) 11820000 CALL S2DFI2( M,SA,*2700) 11830000 CALL SCOPY( NBL,SA,1,OTR,1 ) 11840000 C 11850000 C ZERO TO FIRST LIVE VALUE 11860000 C 11870000 CALL USRTHV( OH,'THFLV ',IFLV ) 11880000 IF( IFLV.GT.1 ) CALL SCOPY( IFLV-1,ZERO,0,OTR,1 ) 11890000 C 11900000 C 11910000 RETURN 11920000 C 11930000 C=======================================================================11940000 C 11950000 C ******************** 11960000 C ******************** 11970000 C ERROR MESSAGES 11980000 C ******************** 11990000 C ******************** 12000000 C 12010000 2600 IABORT = YES 12020000 WRITE(IPR,9010) 12030000 GO TO 9000 12040000 C 12050000 2700 IABORT = YES 12060000 WRITE(IPR,9020) 12070000 GO TO 9000 12080000 C 12090000 2800 IABORT = YES 12100000 WRITE(IPR,9030) 12110000 C 12120000 C***********************************************************************12130000 C 12140000 C RETURN FROM CALL TO SAFX3D3 12150000 C 12160000 9000 RETURN 12170000 C 12180000 C***********************************************************************12190000 C 12200000 C ******************** 12210000 C ******************** 12220000 C FORMAT STATEMENTS 12230000 C ******************** 12240000 C ******************** 12250000 C 12260000 C 12270000 C 12280000 9010 FORMAT('0*** NO SEISPARM FILE RECORD FOUND FOR ',A4,I1,' ***') 12290000 C 12300000 9020 FORMAT(' *** ERROR RETURN FROM S2DFT2/S2DFI2 ***') 12310000 C 12320000 9030 FORMAT(' *** MATRIX INVERSION PROBLEM IN FX3D ***' ) 12330000 C 12340000 C9090 FORMAT(//,5X,'ERROR RETURN FROM WORK FILE DE-ALLOCATION '/ 12350000 C + 5X,'ERROR CODE = ',I5,' SVC99 ERROR = ',Z9 / 12360000 C + 5X,'PROCESSING CONTINUES') 12370000 C 12380000 END 12390000