CTITLESAAVOP0 - HIGH ORDER SINE CURVE FITTING AND AMPLITUDE CALCULATION 00010000 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA DESIGNER C. Y. YOUNG 00020000 CA AUTHOR C. Y. YOUNG 00030000 CA LANGUAGE FORTRAN 77 00040000 CA SYSTEM IBM 00050000 CA WRITTEN APRIL 25,1987 00060000 C REVISED NOV 28, 1988 CAD MODIFIED TO MEET EDP STANDARDS00070000 C REVISED 07-02-89 JJC - MAKE THE LAST CDP THE SAME AS 00080000 C IXEND FOR EACH WINDOW. 00090000 C REVISED 07-21-89 JJC - FIXED THE BRANCH PROBLEM 00100000 C 07-24-89 JJC - FIXED THE DISPLAY PROBLEM WHEN 00110000 C NSIN EQUAL TO 0. 00120000 C REVISED 08-25-89 JJC - INCREASE THE SPACE FOR IDIVNT. 00130000 C REVISED 09-10-89 JJC - CHANGED PROCESS NAME TO AVOP. 00140000 C REVISED 11-06-90 ESN - COMMENT OUT NTS=MAX0(KCDP,NTS), 00150004 C CHECK FOR DIVIDE-BY-ZERO OF TY. 00160004 CA 00170000 CA CALL SAAVOP0(OH,ICC,AUTO3,IABORT,RA,IRA) 00180000 CA CALL SAAVOP1(OH,OTR,VEL,PASS,IABORT,RA,SA,IRA) 00190000 CA CALL SAAVOP2(OH,OTR,VEL,PASS,IABORT,RA,SA,IRA) 00200000 CA CALL SAAVOP3(OH,OTR,VEL,PASS,IABORT,RA,SA,IRA) 00210000 C 00220000 C 00230000 C 00240000 CA PURPOSE: TO DETERMINE THE PARAMETER OF A + B*SIN**2 + C*SIN**4 00250000 CA FITTED TO A THE RMS AMPLITUDE OF A SELECTED WINDOW. 00260000 CA INPUT: DEPTH POINT GATHER. 00270000 CA OUTPUT: RMS AMPLITUDE AND THE PARAMETERS A,B AND C 00280000 CA BENSON VARIAN PLOTS 00290000 C 00300000 C 00310000 C ===================================================================== 00320000 CU 00330000 CU 00340000 CU PROCESS AVOP -- RMS AMPLITUDE AND AVO PARAMETER CALCULATION 00350000 CU DATA CARD (1) -- DEFINES RANGE TO BE ANALYZED 00360000 CU 00370000 CU NO. OF CARDS: REQUIRED = 1 ALLOWED = 1 00380000 CU 00390000 CU REQ OR OPT 00400000 CU DF COLS DEFINITION OR DEFAULT 00410000 CU -- ----- ---------- -----------00420000 CU 1 1- 4 'AVOP' | REQ |00430000 CU 2 - 5 PROCESS NUMBER | 0 |00440000 CU 3 - 6 NOT USED | |00450000 CU 4 - 7 PROCESSING MODE | REQ |00460000 CU 'D' = DEPTH POINT | |00470000 CU 5 8-10 FOR PROGRAMMING USE | |00480000 CU 6 11-15 STARTING DEPTH POINT | REQ |00490000 CU 7 16-20 ENDING DEPTH POINT | DF6 |00500000 CU 8 21-25 NOT USED | |00510000 CU 9 26-35 TEN COLUMNS, FIELDS 9 AND 10 | NEXT NO.|00520000 CU 10 DATA SET IDENTIFICATION | |00530000 CU NORMALLY BLANK--SYSTEM ASSIGNS NEXT NUMBER | |00540000 CU 11 36-40 DATA SET TYPE | M |00550000 CU 'T' = TAPE WITH IBM STANDARD LABEL | |00560000 CU 'M' = MASS STORAGE DEVICE | |00570000 CU 12 41-45 TAPE RECORDING DENSITY | H |00580000 CU 'L' = 800 BPI | |00590000 CU 'M' = 1600 BPI | |00600000 CU 'H' = 6250 BPI | |00610000 CU 13 46-50 NOT USED | |00620000 CU 14 51-55 ONLINE PLOTTER CODE. SEE OPERATIONS FOR CODE. | |00630000 CU 15 56-75 NOT USED | |00640000 CU 16 76-80 PLOTTER SELECTION | NOPLT |00650000 CU 'NOPLT' NO PLOT IS GENERATED | |00660000 CU 'ONCOL' FOR ON LINE COLOR VERSATEC PLOTTER | |00670000 CU ' META' FOR METAFILE | |00680000 CU |_________|00690000 CU 00700000 CU EJECT 00710000 CU======================================================================00720000 CU 00730000 CU PROCESS AVOP -- RMS AMPLITUDE AND AVO PARAMETER CALCULATION 00740000 CU DATA CARD (2) -- DEFINES ANALYSIS PARAMETERS 00750000 CU 00760000 CU NO. OF CARDS: REQUIRED = 1 ALLOWED = 1 00770000 CU 00780000 CU REQ OR OPT 00790000 CU DF COLS DEFINITION OR DEFAULT 00800000 CU -- ----- ---------- -----------00810000 CU 1 1- 4 'AVOP' | REQ |00820000 CU 2 - 5 PROCESS NUMBER | 0 |00830000 CU 3 - 6 NOT USED | |00840000 CU 4 - 7 NOT USED | |00850000 CU 5 8-10 'ANA' | REQ |00860000 CU 6 11-15 NOT USED | |00870000 CU 7 16-20 NOT USED | |00880000 CU 8 21-25 MAXIMUN NO OF TRACES PER DEPTH POINT | REQ |00890000 CU 9 26-30 NOT USED | |00900000 CU 10 31-35 NUMBER OF TIME PICK PAIRS (CDP NO., TIME(MSEC)) | 1 |00910000 CU FOR EACH TIME WINDOW | |00920000 CU 11 36-40 TIME WINDOW IN MSEC | 40 |00930000 CU 12 41-45 ORDER OF SIN(X) TERM (0, 2 OR 3) | 2 |00940000 CU 0 = DISPLAY AMPLITUDE WITHOUT FIT | |00950000 CU 2 = SIN 2ND ORDER FIT | |00960000 CU 3 = SIN 4TH ORDER FIT AND SIN 2ND ORDER FIT | |00970000 CU 13 46-50 OPTION FOR POLYNOMIAL FIT | 0 |00980000 CU 2 = LINEAR FIT | |00990000 CU 3 = 2ND ORDER POLYNOMIAL | |01000000 CU 14 51-55 OPTION FOR INPUT DATA TYPE | NMOC |01010000 CU ' NMOC' - NORMAL MOVEOUT CORRECTED DATA | |01020000 CU 'UNMOC' - UNCORRECTED NORMAL MOVEOUT DATA | |01030000 CU 15 56-60 OPTION FOR INPUT DATA AMPLITUDE TYPE | DF15 |01040000 CU ' ' - REGULAR AMPLITUDE TRACE DATA | |01050000 CU ' RMSA' - INPUT DATA IS RMS AMPLITUDE IN DB | |01060000 CU 16 61-65 MULTIPLE TIME WINDOW CHOICE | 1 |01070000 CU 17 66-75 REFERENCE AMPLITUDE FOR AMPLITUDE NORMALIZATION | DF17 |01080000 CU OR SCALE FACTOR FOR DB CALCULATION | |01090000 CU |_________|01100000 CU 01110000 CU DF NOTES 01120000 CU -- ----- 01130000 CU 01140000 CU 10 THE DEFAULT IS 1, MAXIMUM IS 30. 01150000 CU THE ACTUAL NO. OF PLOTS SHOULD BE LESS THAN 40. 01160000 CU 01170000 CU 13 MUST BE 0 IF DF 14 IS USED. 01180000 CU 01190000 CU 14 DEFAULT IS MOVEOUT CORRECTION HAS BEEN APPLIED. 01200000 CU 01210000 CU 15 DEFAULT IS REGULAR AMPLITUDE TRACE DATA. 01220000 CU 01230000 CU 16 DEFAULT IS ONE WINDOW, MAXIMUM IS 10 WINDOWS 01240000 CU THE TOTAL NUMBER OF PAIRS SHOULD EQUAL TO DF16*DF10. 01250000 CU 01260000 CU 17 DEFAULT IS THE MAX VALUE OF THE FIRST TRACE. 01270000 CU 01280000 CU EJECT 01290000 CU======================================================================01300000 CU 01310000 CU 01320000 CU PROCESS AVOP -- RMS AMPLITUDE AND AVO PARAMETER CALCULATION 01330000 CU DATA CARD (3) -- DEFINES TIME PAIRS TO BE ANALYZED 01340000 CU 01350000 CU NO. OF CARDS: REQUIRED = 1 ALLOWED = NO LIMIT 01360000 CU 01370000 CU REQ OR OPT 01380000 CU DF COLS DEFINITION OR DEFAULT 01390000 CU -- ----- ---------- -----------01400000 CU 1 1- 4 'AVOP' | REQ |01410000 CU 2 - 5 PROCESS NUMBER | 0 |01420000 CU 3 - 6 NOT USED | |01430000 CU 4 - 7 NOT USED | |01440000 CU 5 8-10 'TPK' | REQ |01450000 CU 6 11-15 INTEGER CDP NUMBER. | REQ |01460000 CU 7 16-20 EVENT TIME PICK AT ZERO OFFSET (INTEGER, MSEC) | REQ |01470000 CU 8 21-25 INTEGER CDP NUMBER. | OPT |01480000 CU 9 26-30 EVENT TIME PICK AT ZERO OFFSET (INTEGER, MSEC) | OPT |01490000 CU . . | OPT |01500000 CU . . | . |01510000 CU . . | . |01520000 CU . . | OPT |01530000 CU |_________|01540000 CU DF NOTES 01550000 CU -- ----- 01560000 CU 01570000 CU 5 SEVEN PAIRS PER CARD. MAXIMUM OF 30 PAIRS FOR EACH WINDOW. 01580000 CU 01590000 CU EJECT 01600000 CU 01610000 CU======================================================================01620000 CU 01630000 CU PROCESS AVOP -- RMS AMPLITUDE AND AVO PARAMETER CALCULATION 01640000 CU DATA CARD (4) -- DISPLAY CONTROL PARAMETER 01650000 CU 01660000 CU NO. OF CARDS: REQUIRED = 1 ALLOWED = 1 01670000 CU 01680000 CU REQ OR OPT 01690000 CU DF COLS DEFINITION OR DEFAULT 01700000 CU -- ----- ---------- -----------01710000 CU 1 1- 4 'AVOP' | REQ |01720000 CU 2 - 5 PROCESS NUMBER | 0 |01730000 CU 3 - 6 NOT USED | |01740000 CU 4 - 7 NOT USED | |01750000 CU 5 8-10 'DSP' | REQ |01760000 CU 6 11-15 'ANGLE' AMPLITUDE WILL BE PLOTTED AS FUNCTION | ANGLE |01770000 CU OF LOCAL ANGLE OF INCIDENCE. | |01780000 CU 'TRSNO' AMPLITUDE WILL BE PLOTTED AS FUNCTION | |01790000 CU OF TRACES NUMBER. | |01800000 CU 'OFSET' AMPLITUDE WILL BE PLOTTED AS FUNCTION | |01810000 CU OF OFFSET. | |01820000 CU 7 16-20 TPI DEGREES/INCH IF DF6 IS 'ANGLE' | 4 |01830000 CU OR TRACES/INCH IF DF6 IS 'TRSNO' | 6 |01840000 CU OR FT/INCH IF DF6 IS 'OFSET' | 1000 |01850000 CU 8 21-25 'LINEA' AMPLITUDE WILL BE PLOTTED IN NORMALIZED | LINEA |01860000 CU LINEAR SCALE | |01870000 CU 'DBSCL' AMPLITUDE WILL BE PLOTTED IN DB SCALE | |01880000 CU 9 26-30 DBI MAXIMUM HIGHT IN INCH IF DF8 IS LINEA | 5 |01890000 CU DBI DB/INCH FOR AMPLITUDE | 3 |01900000 CU | |01910000 CU |_________|01920000 CU 01930000 CU EJECT 01940000 CU 01950000 CU======================================================================01960000 CU 01970000 CU 01980000 CU PROCESS AVOP -- RMS AMPLITUDE AND AVO PARAMETER CALCULATION 01990000 CU DATA CARD (5) -- VELOCITY FUNCTION CARDS 02000000 CU 02010000 CU NO. OF CARDS: REQUIRED = 1 ALLOWED = NO LIMIT 02020000 CU 02030000 CU REQ OR OPT 02040000 CU DF COLS DEFINITION OR DEFAULT 02050000 CU -- ----- ---------- -----------02060000 CU 1 1- 4 'AVOP' | REQ |02070000 CU 2 - 5 PROCESS NUMBER | 0 |02080000 CU 3 - 6 NOT USED | |02090000 CU 4 - 7 NOT USED | |02100000 CU 5 8-10 'VEL' | REQ |02110000 CU 6 11-15 STARTING DEPTH POINT | REQ |02120000 CU 7 16-20 ENDING DEPTH POINT | DF6 |02130000 CU 8 21-25 NUMERICAL VELOCITY FUNCTION ID(SEE VELF CARD(1))| REQ |02140000 CU 9 26-80 NOT USED | OPT |02150000 CU ___________02160000 CU 02170000 CU DF NOTES 02180000 CU -- ----- 02190000 CU 6 WHEN MORE THAN ONE CARD IS INCLUDED, THE RANGES ON DIFFERENT 02200000 CU CARDS CANNOT OVERLAP. 02210000 CU 02220000 CU EJECT 02230000 CU 02240000 CU======================================================================02250000 CU 02260000 CU 02270000 CU PROCESS AVOP -- RMS AMPLITUDE AND AVO PARAMETER CALCULATION 02280000 CU DATA CARD (6) -- PLOT TITLE CARD 02290000 CU 02300000 CU NO. OF CARDS: REQUIRED = 0 ALLOWED = 1 02310000 CU 02320000 CU REQ OR OPT 02330000 CU DF COLS DEFINITION OR DEFAULT 02340000 CU -- ----- ---------- -----------02350000 CU 1 1- 4 'AVOP' | REQ |02360000 CU 2 - 5 PROCESS NUMBER | 0 |02370000 CU 3 - 6 NOT USED | |02380000 CU 4 - 7 NOT USED | |02390000 CU 5 8-10 'LBL' | REQ |02400000 CU 6 11-60 PLOT TITLE | REQ |02410000 CU |_________|02420000 CU DF NOTES 02430000 CU -- ----- 02440000 CU 6 THIS TITLE WILL SHOW ON THE TOP OF EACH PLOT. 02450000 CU THE TILTLE MUST END WITH A CHARACTER '$'. 02460000 CU 02470000 CU EJECT 02480000 CU======================================================================02490000 C 02500000 C 02510000 C FORMAT OF OUTPUT PARAMETER RECORDS 02520000 C 02530000 C ****** FIRST RECORD, PROCESSING PARAMETERS ************ 02540000 C 02550000 C WORD 1 WORD 2 WORD 3 WORD 4 WORD 5 WORD 6 WORD 7 WORD 8 02560000 C |_______|________|_______|_______|_______|_______|_______|_______| 02570000 C | AVOP | PROCESS| DCTYP | NOT | JPARM | JNPRM | NOT | NOT | 02580000 C |_______|_NUMBER_|_______|__USED_|_______|_______|__USED_|__USED_| 02590000 C 02600000 C WORD 9 WORD 10 WORD 11 WORD 12 WORD 13 WORD 14 WORD 15 WORD 16 02610000 C |_______|________|_______|_______|_______|_______|_______|_______| 02620000 C | IXBEG | IXEND | NX | NTS | IWIN | NSIN | IPOLY | NWNT | 02630000 C |_______|________|_______|_______|_______|_______|_______|_______| 02640000 C 02650000 C WORD 17 WORD 18 WORD 19 WORD 20 WORD 21 WORD 22 WORD23 WORD 24 02660000 C |_______|________|_______|_______|_______|_______|_______|_______| 02670000 C | TPI | DBI | -------- PLOT ID ---------------- 02680000 C |_______|________|________________________________________________ 02690000 C 02700000 C WORD 25 WORD 26 WORD 27 WORD 28 WORD 29 WORD 30 WORD 31 WORD 32 02710000 C |_______|________|_______|_______|_______|_______|_______|_______| 02720000 C |----------- PLOT ID CONTINUED ------------- 02730000 C __________________________________________________________________ 02740000 C 02750000 C WORD 33 WORD 34 WORD 35 WORD 36 WORD 37 WORD 38 WORD 39 WORD 40 02760000 C |_______|________|_______|_______|_______|_______|_______|_______| 02770000 C ----- PLOT ID CONTINUED.----- | NMOCI------- | NRMS------ | 02780000 C _________________________________|_______________|_______________| 02790000 C 02800000 C WORD 41 WORD 42 WORD 43 WORD 44 WORD 45 WORD 46 WORD 47 WORD 48 02810000 C |_______|________|_______|_______|_______|_______|_______|_______| 02820000 C | IPT | TRCSN | DBS | IPOLY | NWNT | 02830000 C |________________|_______________|_______________|_______|_______| 02840000 C 02850000 C WORD 49 .................................................WORD 104 02860000 C |_______|................................................|.......| 02870000 C | NOT |................................................|.......| 02880000 C |__USED_|................................................|.......| 02890000 C 02900000 C ****** 2ND THROUGH 11TH RECORD (ONE PER WINDOW)****** 02910000 C 02920000 C WORD 1 WORD 2 WORD 3 WORD 4 WORD 5 WORD 6 WORD 7 WORD 8 02930000 C |_______|________|_______|_______|_______|_______|_______|_______| 02940000 C | AVOP | PROCESS| DCTYP | NOT | JPARM | JNPRM | NOT | NOT | 02950000 C |_______|_NUMBER_|_______|__USED_|_______|_______|__USED_|__USED_| 02960000 C 02970000 C WORD 9 WORD 10 WORD 11 WORD 12 WORD 13 WORD 14 WORD 15 WORD 16 02980000 C |_______|________|_______|_______|_______|_______|_______|_______| 02990000 C | CDP#1 | CDP#2 | CDP#3 | .................................... | 03000000 C |_______|________|_______|_______|_______|_______|_______|_______| 03010000 C 03020000 C 03030000 C WORD 33 WORD 34 WORD 35 WORD 36 WORD 37 WORD 38 WORD 39 WORD 40 03040000 C |_______|________|_______|_______|_______|_______|_______|_______| 03050000 C |........................................|CDP#30 |TIME#1 |TIME#2 | 03060000 C |________________________________|_______|_______|_______|_______| 03070000 C 03080000 C 03090000 C WORD 61 WORD 62 WORD 63 WORD 64 WORD 65 WORD 66 WORD 67 WORD 68 03100000 C |_______|________|_______|_______|_______|_______|_______|_______| 03110000 C |....................................................... |TIME#30| 03120000 C |________________|_______________|_______________|_______|_______| 03130000 C 03140000 C WORD 69 .................................................WORD 104 03150000 C |_______|................................................|.......| 03160000 C | NOT |................................................|.......| 03170000 C |__USED_|................................................|.......| 03180000 C=======================================================================03190000 C 03200000 C MAP OF BLANK COMMON 03210000 C 03220000 C IC = 1 ------------------------ 03230000 C | | 03240000 C | NS * 4 | 03250000 C | | 03260000 C NDX ------------------------ 03270000 C | | 03280000 C | NX | 03290000 C | | 03300000 C JP ------------------------ 03310000 C | | 03320000 C | NX * NWN | 03330000 C | | 03340000 C JTN0 ------------------------ 03350000 C | | 03360000 C | NX * NWN * 2 | 03370000 C | | 03380000 C NV ------------------------ 03390000 C | | 03400000 C | NS | 03410000 C | | 03420000 C NZ ------------------------ 03430000 C | | 03440000 C | NS | 03450000 C | | 03460000 C NMX ------------------------ 03470000 C | | 03480000 C | NX * 10 | 03490000 C | | 03500000 C IDT ------------------------ 03510000 C | | 03520000 C | KCDP * NWN | 03530000 C | | 03540000 C IDTSQ ------------------------ 03550000 C | | 03560000 C | NX * NWN | 03570000 C | | 03580000 C IDIVNT ------------------------ 03590000 C | | 03600000 C | NTS * NWN | 03610000 C | | 03620000 C IDZ ------------------------ 03630000 C | | 03640000 C | NS | 03650000 C | | 03660000 C IDICPD ------------------------ 03670000 C | | 03680000 C | NTS | 03690000 C | | 03700000 C IDXCDP ------------------------ 03710000 C | | 03720000 C | NTS * NWN | 03730000 C | | 03740000 C IDIHIN ------------------------ 03750000 C | | 03760000 C | NWN | 03770000 C | | 03780000 C ICC ------------------------ 03790000 C 03800000 C********************************************************************* 03810000 C VARIABLE DEFINITIONS 03820000 C 03830000 C VARIABLE TYPE DESCRIPTION 03840000 C 03850000 C IXBEG I4 STARTING DEPTH POINT 03860000 C IXEND I4 ENDING DEPTH POINT 03870000 C NX I4 MAX NO. OF TRACES PER DEPTH PT. 03880000 C NTS I4 NO. OF TIME PICK PAIRS 03890000 C IWIN I4 TIME WINDOW IN MILISECONDS 03900000 C NSIN I4 ORDER OF SINX TERM 03910000 C IPOLY I4 POLYNIMIAL FIT ORDER,OPTION NO. 03920000 C NMOCI CH INPUT DATA MOVEOUT PARAMETER 03930000 C NRMS CH INPUT DATA AMPLITUDE PARAMATER 03940000 C NWNT I4 MULTIPLE TIME WINDOW CHOICE 03950000 C AMX R4 SCALE FACTOR USED FOR DB CALC. 03960000 C TRCSN CH AMPLITUDE PLOTTED AS A FUNCTION 03970000 C TPI I4 TRACE UNIT (DPI TPI OR FPI) 03980000 C DBS CH AMPLITUDE PLOTTING SCALE 03990000 C DBI R4 MAX AMPLITUDE PER INCH OR DB/IN 04000000 C FSR R4 SAMPLE FREQUENCY RATE 04010000 C PLCODE CH PLOTTER CODE (META OR VERC) 04020000 C 04030000 SUBROUTINE SAAVOP0(OH,ICC,AUTO3,IABORT,RA,IRA) 04040000 IMPLICIT INTEGER (A-Z) 04050000 C 04060000 DIMENSION OH(1), OTR(1), RA(1), SA(1),VEL(1),IRA(1) 04070000 C 04080000 REAL ALOG10 04090000 REAL AMAX1 04100000 REAL AMX 04110000 REAL AMX10 04120000 REAL ANGMAX 04130000 REAL DBI 04140000 REAL DN 04150000 REAL SAAVOPF 04160000 REAL FLOAT 04170000 REAL FSR 04180000 REAL SAAVOPG 04190000 REAL OTR 04200000 REAL PAA 04210000 REAL PAAA 04220000 REAL PI 04230000 REAL P1 04240000 REAL RA 04250000 REAL SA 04260000 REAL SD 04270000 REAL SUM1 04280000 REAL SUM2 04290000 REAL TBEG 04300000 REAL TEND 04310000 REAL TNWN 04320000 REAL TX 04330000 REAL TXX 04340000 REAL TY 04350000 REAL TZ 04360000 REAL VEL 04370000 REAL WK 04380000 REAL WTS 04390000 REAL XCDP1 04400000 REAL XS 04410000 REAL YS 04420000 C 04430000 C EXTERNAL FOSCDK 04440000 C 04450000 C 04460000 C COMMON /P/ STATEMENTS GENERATED BY UTCGI4 1/06/89 04470000 COMMON /P/ STARTP ( 2) , M00000( 10) 04480000 COMMON /P/ LCTPSP , M00048( 2) 04490000 COMMON /P/ LCPI , M00060 04500000 COMMON /P/ LCMXFD , M00068( 86) 04510000 COMMON /P/ KPNA 04520000 COMMON /P/ KPRNO , M00420 04530000 COMMON /P/ KPA 04540000 COMMON /P/ KPDBGS 04550000 COMMON /P/ KPDBGA 04560000 COMMON /P/ KPDBGN 04570000 COMMON /P/ KPWRKS 04580000 COMMON /P/ KPWRKD 04590000 COMMON /P/ KPWKS2 04600000 COMMON /P/ KPWKD2 04610000 COMMON /P/ KPWKS3 04620000 COMMON /P/ KPWKD3 , M00464 04630000 COMMON /P/ KPIRSM 04640000 COMMON /P/ KPNRSM 04650000 COMMON /P/ KPIUSM 04660000 COMMON /P/ KPNUSM , M00484( 10) 04670000 COMMON /P/ KPPRNT , M00528( 2) 04680000 COMMON /P/ KPBUGF , M00540( 6) 04690000 COMMON /P/ KPDSNS , M00568( 217) 04700000 COMMON /P/ PROTAB ( 2) 04710000 COMMON /P/ ENDP 04720000 C 04730000 C 04740000 CHARACTER*4 PLCODE 04750000 CHARACTER*5 NMOCI,NRMS,IPT,TRCSN,DBS 04760000 CHARACTER*44 PLTFIL 04770000 CHARACTER*70 PLOTID 04780000 C 04790000 DIMENSION PAA(5),WK(18),PAAA(5) 04800000 DIMENSION DN(10),SD(10),TBEG(10),TEND(10) 04810000 DIMENSION DENTRY(104) 04820000 C 04830000 INTEGER YES /0/ 04840000 INTEGER NO /1/ 04850000 INTEGER YES3 /2/ 04860000 INTEGER NO3 /3/ 04870000 C 04880000 COMMON /HEAD/ ORTN,CDPN,CDPT,TICD,XDST,NS,SI,SSP,FN,THL 04890000 COMMON /USER/ SLOCAL(50), ULOCAL(200) 04900000 C 04910000 C 04920000 EQUIVALENCE (INDXS ,SLOCAL(17)) 04930000 EQUIVALENCE (INDFAT ,SLOCAL(27)) 04940000 C 04950000 EQUIVALENCE (IXBEG ,ULOCAL( 1)) 04960000 EQUIVALENCE (IXEND ,ULOCAL( 2)) 04970000 EQUIVALENCE (NX ,ULOCAL( 3)) 04980000 EQUIVALENCE (NTS ,ULOCAL( 4)) 04990000 EQUIVALENCE (IWIN ,ULOCAL( 5)) 05000000 EQUIVALENCE (NSIN ,ULOCAL( 6)) 05010000 EQUIVALENCE (IPOLY ,ULOCAL( 7)) 05020000 EQUIVALENCE (NWNT ,ULOCAL( 8)) 05030000 EQUIVALENCE (AMX ,ULOCAL( 9)) 05040000 EQUIVALENCE (TPI ,ULOCAL(10)) 05050000 EQUIVALENCE (DBI ,ULOCAL(11)) 05060000 EQUIVALENCE (PLOTID ,ULOCAL(12)) 05070000 EQUIVALENCE (NMOCI ,ULOCAL(30)) 05080000 EQUIVALENCE (NRMS ,ULOCAL(32)) 05090000 EQUIVALENCE (IPT ,ULOCAL(34)) 05100000 EQUIVALENCE (TRCSN ,ULOCAL(36)) 05110000 EQUIVALENCE (DBS ,ULOCAL(38)) 05120000 C 05130000 EQUIVALENCE (AMX10 ,ULOCAL(40)) 05140000 EQUIVALENCE (ANGI ,ULOCAL(41)) 05150000 EQUIVALENCE (FSR ,ULOCAL(42)) 05160000 EQUIVALENCE (IDFLAG ,ULOCAL(43)) 05170000 EQUIVALENCE (IDICDP ,ULOCAL(44)) 05180000 EQUIVALENCE (IDIHIN ,ULOCAL(45)) 05190000 EQUIVALENCE (IDIVNT ,ULOCAL(46)) 05200000 EQUIVALENCE (IDT ,ULOCAL(47)) 05210000 EQUIVALENCE (IDTSQ ,ULOCAL(48)) 05220000 EQUIVALENCE (IDTVNT ,ULOCAL(49)) 05230000 EQUIVALENCE (IDXCDP ,ULOCAL(50)) 05240000 EQUIVALENCE (IDZ ,ULOCAL(51)) 05250000 EQUIVALENCE (IHFLAG ,ULOCAL(52)) 05260000 EQUIVALENCE (IHN ,ULOCAL(53)) 05270000 EQUIVALENCE (IHOUT ,ULOCAL(54)) 05280000 EQUIVALENCE (IH3 ,ULOCAL(55)) 05290000 EQUIVALENCE (IPR ,ULOCAL(56)) 05300000 EQUIVALENCE (ITI ,ULOCAL(57)) 05310000 EQUIVALENCE (ITI2 ,ULOCAL(58)) 05320000 EQUIVALENCE (JP ,ULOCAL(59)) 05330000 EQUIVALENCE (JPI ,ULOCAL(60)) 05340000 EQUIVALENCE (JTN0 ,ULOCAL(61)) 05350000 EQUIVALENCE (NDX ,ULOCAL(62)) 05360000 EQUIVALENCE (NMX ,ULOCAL(63)) 05370000 EQUIVALENCE (NPLOT ,ULOCAL(64)) 05380000 EQUIVALENCE (NS3 ,ULOCAL(65)) 05390000 EQUIVALENCE (NV ,ULOCAL(66)) 05400000 EQUIVALENCE (NWN ,ULOCAL(67)) 05410000 EQUIVALENCE (NWN1 ,ULOCAL(68)) 05420000 EQUIVALENCE (NX2 ,ULOCAL(69)) 05430000 EQUIVALENCE (NX4 ,ULOCAL(70)) 05440000 EQUIVALENCE (NX5 ,ULOCAL(71)) 05450000 EQUIVALENCE (NZ ,ULOCAL(72)) 05460000 EQUIVALENCE (OFST ,ULOCAL(73)) 05470000 EQUIVALENCE (PLCODE ,ULOCAL(74)) 05480000 EQUIVALENCE (SUM1 ,ULOCAL(75)) 05490000 EQUIVALENCE (SUM2 ,ULOCAL(76)) 05500000 EQUIVALENCE (TNWN ,ULOCAL(77)) 05510000 EQUIVALENCE (TX ,ULOCAL(78)) 05520000 EQUIVALENCE (TXX ,ULOCAL(79)) 05530000 EQUIVALENCE (TY ,ULOCAL(80)) 05540000 EQUIVALENCE (TZ ,ULOCAL(81)) 05550000 EQUIVALENCE (XS ,ULOCAL(82)) 05560000 EQUIVALENCE (YS ,ULOCAL(83)) 05570000 EQUIVALENCE (PLTLST ,ULOCAL(84)) 05580000 C 05590000 EQUIVALENCE (PAA ,ULOCAL(90)) 05600000 EQUIVALENCE (PAAA ,ULOCAL(95)) 05610000 EQUIVALENCE (DN ,ULOCAL(100)) 05620000 EQUIVALENCE (SD ,ULOCAL(110)) 05630000 EQUIVALENCE (TBEG ,ULOCAL(120)) 05640000 EQUIVALENCE (TEND ,ULOCAL(130)) 05650000 EQUIVALENCE (WK ,ULOCAL(140)) 05660000 EQUIVALENCE (KCDP ,ULOCAL(158)) 05670000 EQUIVALENCE (IHIN ,ULOCAL(159)) 05680000 C 05690000 EXTERNAL SAAVOPF,SAAVOPG 05700000 C 05710000 DATA PI/3.14159265/ 05720000 DATA P1/0.0174533/ 05730000 C 05740000 C SET PROGRAM FLAGS AND VARIABLES. 05750000 C 05760000 IPR = KPPRNT 05770000 IHFLAG = 0 05780000 NPLOT = 0 05790000 FSR = FLOAT(SI)*1.E-6 05800000 C 05810000 C SET SHELL FLAGS. 05820000 C 05830000 IABORT = NO 05840000 AUTO3 = YES 05850000 C 05860000 C READ SEISPARM RECORD1 05870000 C 05880000 LA = 1 05890000 LEN = 104 05900000 CALL FORP(KPNA,KPRNO,LA,LEN,DENTRY,*9999) 05910000 CALL ARMVE(DENTRY(9),ULOCAL,DENTRY(6)) 05920000 C 05930000 IF ( IPT .EQ. 'ONCOL' ) PLCODE = 'VERC' 05940000 IF ( IPT .EQ. ' META' ) PLCODE = 'META' 05950000 NWN = NWNT 05960000 NX2 = NX/2 05970000 NS3 = FLOAT(IWIN)/1000./FSR+1 05980000 WTS = 0.0 05990000 KCDP = IXEND - IXBEG +1 06000000 C 06010000 C NTS = MAX0(KCDP, NTS) 06020000 C 06030000 C SET UP INDICES FOR STORAGE IN RA 06040000 C 06050000 IC = 1 06060000 C 06070000 NDX = IC + NS*4 06080000 C RESERVE SPACE FOR INCIDENCE ANGLES 06090000 JP = NDX + NX 06100000 C RESERVE SPACE FOR CDP TRACE NO. 06110000 JTN0 = JP + NX * NWN 06120000 NV = JTN0 + NX * NWN * 2 06130000 NZ = NV + NS 06140000 NMX = NZ + NS 06150000 IDT = NMX + NX * 10 06160000 IDTSQ = IDT + KCDP * NWN 06170000 IDIVNT = IDTSQ + NX * NWN 06180000 IDZ = IDIVNT + NTS * NWN 06190000 IDICDP = IDZ + NS 06200000 IDXCDP = IDICDP + NTS 06210000 IDTVNT = IDXCDP + NTS * NWN 06220000 IDIHIN = IDTVNT + NTS * NWN 06230000 PLTLST = IDIHIN + NWN 06240000 ICC = PLTLST + 4 06250000 C SETUP INDICES FOR SCRATCH COMMON 06260000 NX4 = 3 * NX 06270000 NX5 = NX4 + NX 06280000 NXPLT = NX5 + NX 06290000 C ALLOW 16384 HALF WORDS OF WORK AREA FOR SACENDP 06300000 MAXSA = NXPLT + 16384/2 06310000 C 06320000 DO 70 J = 1,NWN 06330000 IRA(IDIHIN + J - 1) = 0.0 06340000 IX = (J-1) * NTS 06350000 LEN = 104 06360000 CALL FORP(KPNA,KPRNO,LA,LEN,DENTRY,*9999) 06370000 CALL ARMVE(DENTRY(9),IRA(IDICDP),NTS) 06380000 CALL ARMVE(DENTRY(39),IRA(IDIVNT+IX),NTS) 06390000 C 06400000 C MAKE THE LAST CDP THE SAME AS IXEND FOR EACH WINDOW 06410000 C 06420000 DO 20 I = 2, NTS 06430000 IF (IRA(IDICDP+I-1) .EQ. 0) 06440000 * IRA(IDICDP+I-1) = IRA(IDICDP+I-2) + 1 06450000 IF (IRA(IDIVNT+IX+I-1) .EQ. 0) 06460000 * IRA(IDIVNT+IX+I-1) = IRA(IDIVNT+IX+I-2) 06470000 20 CONTINUE 06480000 C 06490000 DO 30 I = 1,NTS 06500000 TXX = FLOAT(IRA(IDIVNT+IX+I-1)) 06510000 RA(IDTVNT-1+IX+I)= TXX/1000. 06520000 30 RA(IDXCDP-1+IX+I)= FLOAT(IRA(IDICDP-1+I)) 06530000 C 06540000 XCDP1 = RA(IDXCDP+IX) 06550000 K = RA(IDXCDP-1+IX+NTS) - XCDP1 + 1 06560000 IF (K .GT. 2 ) THEN 06570000 CALL SAAVOPA(RA(IDXCDP+IX), RA(IDTVNT+IX), 06580000 + NTS,1,XCDP1,1.0,RA(IDT-1+(J-1)*KCDP+1),K) 06590000 ELSE 06600000 DO 40 I = 1,K 06610000 RA(IDT-1+(J-1)*KCDP+I) = RA(IDTVNT-1+(J-1)*NTS+I) 06620000 40 CONTINUE 06630000 ENDIF 06640000 70 CONTINUE 06650000 C 06660000 C PROCESSINPUT PLOT OPTIONS 06670000 C 06680000 ANGI = TPI 06690000 OFST = TPI 06700000 IF ( TPI .EQ. 0 ) THEN 06710000 OFST = 1000 06720000 ANGI = 4 06730000 TPI = 6 06740000 ENDIF 06750000 IF ( DBI .EQ. 0. .AND. DBS .EQ. 'DBSCL' ) THEN 06760000 DBI = 3. 06770000 ELSE 06780000 IF ( DBI .EQ. 0. .AND. DBS .NE. 'DBSCL' ) THEN 06790000 DBI = 0.2 06800000 ELSE 06810000 IF ( DBS .EQ. 'LINEA' )DBI = 1./DBI 06820000 ENDIF 06830000 ENDIF 06840000 C 06850000 C PRINT OUT PARAMETER READ 06860000 C 06870000 WRITE (IPR,9010) KPNA,KPRNO 06880000 WRITE (IPR,9020) IPT 06890000 WRITE (IPR,9030)IXBEG,IXEND,NX,NTS, 06900000 1 IWIN,NSIN,IPOLY,NMOCI,NRMS,NWNT,AMX 06910000 WRITE (IPR,9040)TRCSN,TPI,DBS,DBI 06920000 WRITE (IPR,9050)PLOTID 06930000 DO 100 J = 1,NWN 06940000 IX = (J-1) * NTS 06950000 WRITE(IPR,9060) J 06960000 WRITE (IPR,9070)(IP,(IRA(IDICDP-1+IP), 06970000 1 IRA(IDIVNT-1+IX+IP)), IP=1,NTS) 06980000 100 CONTINUE 06990000 C 07000000 RETURN 07010000 C 07020000 C******************************************************************* 07030000 C 07040000 C 07050000 C AVOP1 ENTRY STARTS HERE 07060000 C******************************************************************* 07070000 C******************************************************************* 07080000 C 07090000 ENTRY SAAVOP1(OH,OTR,VEL,PASS,IABORT,RA,SA,IRA) 07100000 C 07110000 C******************************************************************* 07120000 C******************************************************************* 07130000 C 07140000 C 07150000 IABORT = NO 07160000 IHIN = 0 07170000 NWN1 = 1 07180000 IHOUT = 0 07190000 IDFLAG = 0 07200000 C 07210000 C DEFINE CDP RANGE 07220000 C 07230000 IF(CDPN.LT.IXBEG .OR. CDPN.GT.IXEND ) IDFLAG=1 07240000 C 07250000 C ****DETERMINE INTERVAL VELOCITY **** 07260000 C 07270000 CALL SAAVOPN(VEL,RA(NV),RA(NZ),NS,FSR,IPR) 07280000 C 07290000 C******************************************************************* 07300000 C******************************************************************* 07310000 C 07320000 ENTRY SAAVOP2(OH,OTR,VEL,PASS,IABORT,RA,SA,IRA) 07330000 C 07340000 C******************************************************************* 07350000 C******************************************************************* 07360000 C 07370000 C 07380000 PASS = NO 07390000 C 07400000 IF ( CDPN .LT. IRA(IDICDP-1+1)) RETURN 07410000 IF ( CDPN .GT. IRA(IDICDP-1+NTS)) RETURN 07420000 IF (IHIN .EQ. 0 ) THEN 07430000 IF (VEL(1) .EQ. 0.0 ) THEN 07440000 IDFLAG = 1 07450000 IPT='NOPLT' 07460000 IABORT = YES 07470000 WRITE(IPR,9170) 07480000 ENDIF 07490000 ENDIF 07500000 IF(IDFLAG.NE.0) RETURN 07510000 C 07520000 C PASS=YES IF INPUT TRACES IS DISPLAYED AFTER MUTE 07530000 C 07540000 PASS = YES 07550000 C 07560000 C 07570000 CALL ARMVE(OTR,RA(1),NS) 07580000 CALL ARSET(OTR,NS,0.0) 07590000 IF ( IHIN .EQ. NX ) PASS = NO 07600000 IF ( IHIN .EQ. NX ) RETURN 07610000 IF ( TICD .EQ. 2 ) RETURN 07620000 RA(NDX+IHIN) = XDST 07630000 IHIN = IHIN + 1 07640000 IF ( NWN1 .GT. NWN ) RETURN 07650000 KK = CDPN - IRA(IDICDP-1+1) + 1 07660000 C 07670000 C MULTIPLE ANALYSIS WINDOW FOR ONE CDP 07680000 C 07690000 DO 2050 L = NWN1,NWN 07700000 2050 RA(NMX+L-1) = -1. 07710000 DO 2700 L = NWN1,NWN 07720000 CALL ARSET(RA(NS+1),NS,0.0) 07730000 C 07740000 J = RA(IDT-1+(L-1)*KCDP+KK)/FSR + 1 07750000 IT1 = J 07760000 IT2 = J+NS3 - 1 07770000 IF( IT2. GT. NS ) IT2 = NS 07780000 C ITI2 = ITI/2 07790000 IF ( IHIN .EQ. 1 ) THEN 07800000 TBEG(L) = IT1*FSR 07810000 TEND(L) = IT2*FSR 07820000 C 07830000 C RAY TRACING TO TOP OF THE WINDOW SELECTED 07840000 C 07850000 ANGMAX = 35. 07860000 ENDIF 07870000 C********************ORIGINAL CALL TO XTHETA ROLLED IN HERE********** 07880000 C CALL XTHETA(IHIN,RA(JP),XDST,L,RA(NV),VEL,J,FSR,NX) 07890000 C SUBROUTINE XTHETA(IHIN,P,XDST,L,V,VEL,J,FSR,NX) 07900000 TX = SQRT((FLOAT(J-1)*FSR)**2+(FLOAT(XDST)/VEL(J))**2) 07910000 1 *VEL(J)**2 07920000 TX = XDST*RA(NV-1+J)/TX 07930000 IF ( TX .GT. 1.0 ) THEN 07940000 RA(JP-1+(L-1)*NX+IHIN) = 0.0 07950000 ELSE 07960000 RA(JP-1+(L-1)*NX+IHIN) = ASIN(TX)/P1 07970000 ENDIF 07980000 C******************************************************************** 07990000 JTN = (L-1)*NX+IHIN+JTN0 -1 08000000 RA(JTN) = CDPT 08010000 IF ( NMOCI .EQ. ' NMOC' ) GO TO 2060 08020000 TY = XDST/VEL(J) 08030000 TZ = RA(IDT-1+(L-1)*KCDP+KK) 08040000 TY = TZ*TZ + TY*TY 08050000 TY = SQRT(TY) 08060000 C 08070000 TXX = TY 08080000 IT1 = TXX/FSR + 1 08090000 IT2 = IT1 + NS3 - 1 08100000 IF ( IT2 .GT. NS ) IT2 = NS 08110000 ITI = IT2-IT1+1 08120000 ITI2 = ITI/2 08130000 C 08140000 2060 TXX = 0. 08150000 ITI = IT2-IT1+1 08160000 ITI2 = ITI/2 08170000 TY = FLOAT(ITI) 08180000 C IF ( RA(IT1) .NE. 0.0 ) THEN 08190000 IF ( NRMS .EQ. ' RMSA' ) THEN 08200000 JT = 0 08210000 DO 2100 J = IT1,IT2 08220000 JNS = J+NS 08230000 IF ( RA(J) .NE. 0.0 ) THEN 08240000 RA(JNS) = RA(J) 08250000 TXX = TXX + RA(JNS) 08260000 ELSE 08270000 JT = JT + 1 08280000 ENDIF 08290000 2100 CONTINUE 08300000 IF( JT .GT. ITI2 .AND. JT .LT. ITI .AND. IHIN .GT. NX2) THEN 08310000 WRITE(IPR,9180) CDPN,IHIN 08320000 NWN1 = NWN1+1 08330000 GO TO 2700 08340000 ENDIF 08350000 TY = TY - JT 08360000 RA(IDTSQ-1+(L-1)*NX+IHIN) = 10.**(TXX/TY/20.) 08370000 ELSE 08380000 JS = 0 08390000 JT = 0 08400000 DO 2300 J = IT1,IT2 08410000 JNS = J + NS 08420000 JS = JS + 1 08430000 IF ( RA(J) .NE. 0.0 ) THEN 08440000 RA(JNS) = RA(J) 08450000 TXX = TXX + (RA(JNS))**2 08460000 ELSE 08470000 JT = JT + 1 08480000 ENDIF 08490000 2300 CONTINUE 08500000 IF( JT .GT. ITI2 .AND. JT .LT. ITI .AND. IHIN .GT. NX2) THEN 08510000 WRITE(IPR,9180) CDPN,IHIN 08520000 NWN1 = NWN1+1 08530000 GO TO 2700 08540000 ENDIF 08550000 TY = TY - JT 08560000 ITEMP = IDTSQ-1+(L-1)*NX+IHIN 08570000 RA(ITEMP) = 0.0 08580003 IF (TY .NE. 0.0) RA(ITEMP) = SQRT(TXX/TY) 08590003 IF (RA(ITEMP) .GT. RA(NMX+L-1)) 08600000 1 RA(NMX+L-1)=RA(ITEMP) 08610000 ENDIF 08620000 C 08630000 JNT = IT1+NS 08640000 C 08650000 CALL ARMVE(RA(JNT),OTR(IT1),ITI) 08660000 C 08670000 IRA(IDIHIN-1+L) = IHIN 08680000 C 08690000 C 08700000 2700 CONTINUE 08710000 C 08720000 RETURN 08730000 C******************************************************************* 08740000 C******************************************************************* 08750000 C 08760000 ENTRY SAAVOP3(OH,OTR,VEL,PASS,IABORT,RA,SA,IRA) 08770000 C 08780000 C******************************************************************* 08790000 C******************************************************************* 08800000 C 08810000 PASS = NO 08820000 C 08830000 IF ( CDPN .LT. IRA(IDICDP-1+1)) RETURN 08840000 IF ( CDPN .GT. IRA(IDICDP-1+NTS)) RETURN 08850000 IF(IDFLAG.NE.0) RETURN 08860000 IHOUT = IHOUT+1 08870000 IF(IHOUT .GT. 1 ) RETURN 08880000 C 08890000 WRITE(IPR,9140) CDPN,XDST 08900000 IHFLAG = IHFLAG + 1 08910000 IH3 = NX*3 08920000 CALL ARSET(RA,IH3,0.0) 08930000 DO 3700 L = 1,NWN 08940000 IHIN = IRA(IDIHIN-1+L) 08950000 K = IHIN+ 1 08960000 DO 3050 I = 1,IHIN 08970000 K = K-1 08980000 IF ( RA(IDTSQ-1+(L-1)*NX+K) .NE. 0.0 ) GO TO 3060 08990000 3050 CONTINUE 09000000 3060 IHIN = K 09010000 IH3 = IHIN *3 09020000 CALL ARSET(SA,IH3,0.0) 09030000 C 09040000 C LEAST SQUARE FIT OF THE WINDOW SELECTED 09050000 C 09060000 K = 0 09070000 DO 3100 I = 1,IHIN 09080000 JPN = JP+I+(L-1)*NX - 1 09090000 IF ( RA(JPN) .GT. 0.0 .AND. RA(JPN) .LT. 40.0 ) THEN 09100000 IF ( RA(IDTSQ-1+(L-1)*NX+I) .GT. RA(NMX+L-1)/100. ) THEN 09110000 K = K+1 09120000 SA(K+NX5) = RA(IDTSQ-1+(L-1)*NX+I) 09130000 SA(K+NX4) = RA(JPN) 09140000 ENDIF 09150000 ENDIF 09160000 3100 CONTINUE 09170000 WRITE(IPR,9190)K 09180000 WRITE(IPR,9200)(SA(I+NX4),I=1,K) 09190000 WRITE(IPR,9210)(SA(I+NX5),I=1,K) 09200000 IF ( NSIN .NE. 0 ) THEN 09210000 IER = 0 09220000 IF ( IPOLY .GT. 1 ) THEN 09230000 NSIN = 2 09240000 K = 0 09250000 DO 3150 I = 1,IHIN 09260000 IF ( RA(IDTSQ-1+(L-1)*NX+I) .GT. RA(NMX+L-1)/100. ) THEN 09270000 K = K+1 09280000 SA(K+NX5) = RA(IDTSQ-1+(L-1)*NX+I) 09290000 SA(K+NX4) = RA(NDX+K-1) 09300000 ENDIF 09310000 3150 CONTINUE 09320000 CALL SAAVOPB(SAAVOPG,SA(NX4+1),SA(NX5+1),K,PAA,IPOLY,WK,IER)09330000 ELSE 09340000 CALL SAAVOPB(SAAVOPF,SA(NX4+1),SA(NX5+1),K,PAA,2,WK,IER) 09350000 IF( NSIN .EQ. 3 ) CALL SAAVOPB(SAAVOPF,SA(NX4+1),SA(NX5+1), 09360000 1 K,PAAA,NSIN,WK,IER) 09370000 ENDIF 09380000 IF (IER .NE. 0) THEN 09390000 IF (IERR .EQ. 129) WRITE (IPR,9100) IER 09400000 IF (IERR .EQ. 130) WRITE (IPR,9110) IER 09410000 IF (IERR .NE. 129 .AND. IERR .NE. 130) WRITE (IPR,9120) IER 09420000 IABORT = YES 09430000 RETURN 09440000 ENDIF 09450000 IHIN1 = K 09460000 C 09470000 C 09480000 DO 3200 I = 1,IHIN 09490000 JPI = JP+I-1+(L-1)*NX 09500000 RA(IDZ-1+I) = RA(JPI) 09510000 IF ( I .LE. IHIN1 ) THEN 09520000 RA(IDZ-1+I+IHIN) = RA(JPI) 09530000 RA(IDZ-1+I+IHIN+IHIN1) = RA(JPI) 09540000 ENDIF 09550000 IF ( TRCSN .EQ. 'OFSET' ) THEN 09560000 RA(IDZ-1+I ) = RA(NDX+I-1) 09570000 IF ( I .LE. IHIN1 ) THEN 09580000 RA(IDZ-1+I+IHIN) = RA(NDX+I-1) 09590000 RA(IDZ-1+I+IHIN+IHIN1) = RA(NDX+I-1) 09600000 ENDIF 09610000 ENDIF 09620000 IF ( TRCSN .EQ. 'TRSNO' ) THEN 09630000 ITN = JTN0 + I + (L-1)*NX -1 09640000 RA(IDZ-1+I ) = RA(ITN) 09650000 IF ( I .LE. IHIN1 ) THEN 09660000 RA(IDZ-1+I+IHIN) = RA(ITN) 09670000 RA(IDZ-1+I+IHIN+IHIN1) = RA(ITN) 09680000 ENDIF 09690000 ENDIF 09700000 SA(I) = RA(IDTSQ-1+(L-1)*NX+I) 09710000 IF ( I .LE. IHIN1 ) THEN 09720000 SA(I+IHIN) = PAA(1) + PAA(2)*SAAVOPF(2,RA(JPI)) 09730000 IF ( IPOLY .GT. 1 ) THEN 09740000 SA(I+IHIN) = PAA(1)+PAA(2)*SAAVOPG(2,RA(IDZ-1+I))+ 09750000 1 PAA(3)*SAAVOPG(3,RA(IDZ-1+I)) 09760000 ENDIF 09770000 SA(I+IHIN+IHIN1) = PAAA(1) + 09780000 1 PAAA(2)*SAAVOPF(2,RA(JPI))+PAAA(3)*SAAVOPF(3,RA(JPI)) 09790000 ENDIF 09800000 3200 CONTINUE 09810000 IHN = IHIN*NSIN 09820000 IF ( AMX .GT. 0.0 ) GO TO 3270 09830000 IF ( IHFLAG .EQ. 1 .AND. L .EQ. 1 ) THEN 09840000 AMX= -0.000001 09850000 DO 3250 I = 1,IHN 09860000 3250 AMX = AMAX1(AMX,SA(I)) 09870000 ENDIF 09880000 3270 WRITE(IPR,9220) AMX 09890000 AMX10 = AMX/100. 09900000 DO 3300 I = 1,IHN 09910000 IF ( SA(I) .LT. AMX10 ) SA(I) = AMX10 09920000 3300 SA(I) = SA(I)/AMX 09930000 PAA(1)=PAA(1)/AMX 09940000 PAA(2)=PAA(2)/AMX 09950000 PAA(5)=CDPN 09960000 PAAA(1)=PAAA(1)/AMX 09970000 PAAA(2)=PAAA(2)/AMX 09980000 PAAA(3)=PAAA(3)/AMX 09990000 SUM1= 0. 10000000 SUM2= 0. 10010000 DO 3320 I = 1,IHIN1 10020000 SUM1= SUM1+ (SA(I+IHIN )-SA(I))**2 10030000 3320 SUM2= SUM2+ (SA(I+IHIN+IHIN1)-SA(I))**2 10040000 SUM1= SQRT(SUM1/(IHIN1-1)) 10050000 SUM2= SQRT(SUM2/(IHIN1-1)) 10060000 PAA(4) = SUM1 10070000 PAAA(4) = SUM2 10080000 WRITE(IPR,9230) PAA(1),PAA(2) 10090000 WRITE(IPR,9240) PAAA(1),PAAA(2),PAAA(3) 10100000 WRITE(IPR,9250) SUM1,SUM2 10110000 IF ( DBS .EQ. 'DBSCL' ) THEN 10120000 DO 3350 I = 1,IHN 10130000 3350 SA(I) = 20.*ALOG10(SA(I)) 10140000 ENDIF 10150000 WRITE(IPR,9260) 10160000 WRITE(IPR,9090) (I ,RA(IDZ-1+I),I=1,IHIN) 10170000 WRITE(IPR,9270) 10180000 WRITE(IPR,9090) (I ,SA(I),I=1,IHIN) 10190000 WRITE(IPR,9280) 10200000 WRITE(IPR,9090) (I ,SA(I+IHIN),I=1,IHIN1) 10210000 IF ( NSIN .EQ. 3 ) THEN 10220000 WRITE(IPR,9290) 10230000 WRITE(IPR,9090) ( I ,SA(I+IHIN+IHIN1),I=1,IHIN1) 10240000 ENDIF 10250000 DO 3370 I = 1,IHIN1 10260000 RA(I+IHIN) = SA(I) - SA(I+IHIN+IHIN1) + RA(I+IHIN) 10270000 3370 RA(I) = SA(I) - SA(I+IHIN) + RA(I) 10280000 ELSE 10290000 IF ( AMX .GT. 0.0 ) GO TO 3410 10300000 IF ( IHFLAG .EQ. 1 .AND. L .EQ. 1 ) THEN 10310000 AMX= -0.000001 10320000 DO 3400 I = 1,IHIN 10330000 3400 AMX = AMAX1(AMX,RA(IDTSQ-1+(L-1)*NX+I)) 10340000 ENDIF 10350000 3410 WRITE(IPR,9220) AMX 10360000 AMX10 = AMX/100. 10370000 DO 3440 I = 1,IHIN 10380000 CJJ 10390000 RA(IDZ+I-1) = SA(NX4+I) 10400000 IF ( TRCSN .EQ. 'OFSET' ) RA(IDZ-1+I) = RA(NDX+I-1) 10410000 IF ( TRCSN .EQ. 'TRSNO' ) RA(IDZ-1+I) = I 10420000 CJJ IF ( TRCSN .EQ. 'TRSNO' ) THEN 10430000 CJJ RA(IDZ-1+I ) = I 10440000 CJJ ELSE 10450000 CJJ RA(IDZ-1+I ) = 0.0 10460000 CJJ ENDIF 10470000 SA(I) = RA(IDTSQ-1+(L-1)*NX+I) 10480000 IF ( SA(I) .LT. AMX10 ) SA(I) = AMX10 10490000 SA(I) = SA(I)/AMX 10500000 IF ( DBS .EQ. 'DBSCL' ) 10510000 1 SA(I) = 20.0*ALOG10(SA(I)) 10520000 3440 CONTINUE 10530000 PAA(1)=0.0 10540000 PAA(2)=0.0 10550000 PAA(5)=CDPN 10560000 PAAA(1)=0.0 10570000 PAAA(2)=0.0 10580000 PAAA(3)=0.0 10590000 WRITE(IPR,9270) 10600000 WRITE(IPR,9090) ( I ,SA(I),I=1,IHIN) 10610000 C ENDIF OF (NSIN ?) 10620000 ENDIF 10630000 IF ( IPT .NE. 'NOPLT' ) THEN 10640000 NPLOT = NPLOT + 1 10650000 IF ( NSIN .EQ. 0 ) THEN 10660000 DN(1) = IHIN 10670000 DN(2) = 0 10680000 SD(1) = 40. 10690000 ELSE 10700000 DN(1) = IHIN 10710000 DN(2) = K 10720000 DN(3) = K 10730000 IF( NSIN .EQ. 2 ) DN(3) = 0. 10740000 DN(4) = 0.0 10750000 SD(1) = 40. 10760000 SD(3) = 44. 10770000 SD(2) = -60. 10780000 ENDIF 10790000 IF ( NPLOT .LT. 41 ) GO TO 3500 10800000 WRITE (IPR,9300) 10810000 IF (PLCODE .EQ. 'META') THEN 10820000 CALL GSEGCL(1) 10830000 CALL GCLOSE 10840000 ELSE IF(PLCODE .EQ. 'VERC') THEN 10850000 CALL QHVERC 10860000 ENDIF 10870000 RETURN 10880000 3500 CONTINUE 10890000 XS = -ANGI 10900000 IF ( TRCSN .EQ. 'OFSET' ) XS = -OFST 10910000 IF ( TRCSN .EQ. 'TRSNO' ) XS = -TPI 10920000 YS = -DBI 10930000 IF ( NPLOT .EQ. 1 ) THEN 10940000 CJJ KPDSNS = INDXS -1 + PLTLST 10950000 CALL S1MVCH(PROTAB(INDFAT+3),1,PLTFIL,1,44) 10960000 CALL SAAVOPI(2,RA(IDZ),SA,DN,SD,XS,YS,PAA,PAAA,TBEG(L), 10970000 1 TEND(L),PLOTID,IPR,TRCSN,PLCODE,DBS,PLTFIL) 10980000 ELSE 10990000 CALL SAAVOPJ(2,RA(IDZ),SA,DN,SD,XS,YS,PAA,PAAA,TBEG(L), 11000000 1 TEND(L),PLOTID,IPR,TRCSN,PLCODE,DBS) 11010000 ENDIF 11020000 ENDIF 11030000 3700 CONTINUE 11040000 IF ( NSIN .NE. 0 ) THEN 11050000 I1 = 1 11060000 TNWN = NWN 11070000 DO 3750 J = 1,NWN 11080000 I2 = IRA(IDIHIN-1+J) 11090000 IF ( I1 .GT. I2 ) GO TO 3730 11100000 DO 3720 I = I1,I2 11110000 RA(I+IHIN) = RA(I+IHIN)/TNWN 11120000 3720 RA(I) = RA(I)/TNWN 11130000 3730 I1=I2+1 11140000 IF ( I1 .GT. IRA(IDIHIN-1+NWN) ) GO TO 3760 11150000 TNWN = TNWN-1 11160000 3750 CONTINUE 11170000 3760 CONTINUE 11180000 WRITE(IPR,9310) 11190000 WRITE(IPR,9160) (RA(I),I=1,IHIN) 11200000 WRITE(IPR,9320) 11210000 WRITE(IPR,9160) (RA(I+IHIN),I=1,IHIN) 11220000 ENDIF 11230000 IF ( IPT .NE. 'NOPLT' ) THEN 11240000 IF ( CDPN .EQ. IXEND .OR. NPLOT .EQ. 40 ) THEN 11250000 IF (PLCODE .EQ. 'META') THEN 11260000 CALL GSEGCL(1) 11270000 CALL GCLOSE 11280000 ELSE IF(PLCODE .EQ. 'VERC') THEN 11290000 CALL QHVERC 11300000 ENDIF 11310000 ENDIF 11320000 ENDIF 11330000 WRITE(IPR,9330)IHFLAG,KCDP 11340000 IF(IHOUT .GE. IHIN ) PASS = NO 11350000 IF(PASS.EQ.NO) RETURN 11360000 C 11370000 RETURN 11380000 C 11390000 C 11400000 C ******************** 11410000 C ******************** 11420000 C ERROR MESSAGES 11430000 C ******************** 11440000 C ******************** 11450000 C 11460000 C 11470000 9999 IABORT = YES 11480000 WRITE(IPR,9070) 11490000 RETURN 11500000 C 11510000 9010 FORMAT (' **** ',A4,I2,' ENTRY 0****') 11520000 9020 FORMAT (' ',10X,'PLOTTER SELECTION IS:',A5,//) 11530000 9030 FORMAT (' ', 11540000 1 10X,'STARTING DEPTH POINT (IXBEG )=',I5,/ 11550000 1 ,10X,'ENDING DEPTH POINT (IXEND )=',I5,/ 11560000 1 ,10X,'MAX NO. OF TRACES PER DEPTH PT. (NX )=',I5,/ 11570000 1 ,10X,'NO. OF TIME PICK PAIRS (NTS )=',I5,/ 11580000 1 ,10X,'TIME WINDOW IN MILISECONDS (IWIN )=',I5,/ 11590000 1 ,10X,'ORDER OF SINX TERM (NSIN )=',I5,/ 11600000 1 ,10X,'POLYNIMIAL FIT ORDER,OPTION NO. (IPOLY )=',I5,/ 11610000 1 ,10X,'INPUT DATA MOVEOUT PARAMETER (NMOCI )=',A5,/ 11620000 1 ,10X,'INPUT DATA AMPLITUDE PARAMATER (NRMS )=',A5,/ 11630000 1 ,10X,'MULTIPLE TIME WINDOW CHOICE (NWNT )=',I5,/ 11640000 1 ,10X,'SCALE FACTOR USED FOR DB CALC. (AMX )=',G15.9,//) 11650005 9040 FORMAT (' ', 11660000 1 10X,'AMPLITUDE PLOTTED AS A FUNCTION (TRCSN )=',A5,/ 11670000 1 ,10X,'TRACE UNIT (DPI TPI OR FPI) (TPI )=',I5,/ 11680000 1 ,10X,'AMPLITUDE PLOTTING SCALE (DBS )=',A5,/ 11690000 1 ,10X,'MAX AMPLITUDE PER INCH OR DB/IN (DBI )=',F8.3,//) 11700000 9050 FORMAT (' ', 11710000 1 10X,'PLOT ID IS :',2X,A70,//) 11720000 9060 FORMAT (' *** WINDOW:',I5,'***', 11730000 1 /,' * ', 11740000 1 ' ',2X,'PAIR NO.',2X,'CDP NO.',3X,'EVENT TIME',/) 11750000 9070 FORMAT (' ',24X,I5,5X,I5,5X,I5,/) 11760000 9090 FORMAT(1X,5(I5,F8.3)) 11770000 9100 FORMAT (' SAAVOPB ERROR: ',I5,' MATRIX A IS ALGORITHMICALLY ', 11780000 + ' NOT POSITIVE DEFINITE.') 11790000 9110 FORMAT (' SAAVOPB ERROR: ',I5,' ITERATIVE IMPROVEMENT FAILED', 11800000 + ' TO CONVERGE.') 11810000 9120 FORMAT (' SAAVOPB ERROR: ',I5,' UNDEFINED ERROR CONDITION.') 11820000 9140 FORMAT(////,' *** DEPTH POINT *** ',I5, 11830000 1 /,' OFFSET DISTANCES',I10,' PROCESSED') 11840000 9160 FORMAT('PSPR',6X,6F10.4) 11850000 9170 FORMAT(' ***** PROGRAM ABORTED : CHECK VELOCITY FUNCTION') 11860000 9180 FORMAT(' CDP NO. ',I5, 'TRACE NO. ',I5,/, 11870000 + ' MORE THAN HALF OF THE POINTS IN THE WINDOW = 0') 11880000 9190 FORMAT(' NUMBER OF TRACES USED IN THE FIT = ',I4) 11890000 9200 FORMAT(' ANGLE RANGE ',8(' , ',E12.6)) 11900000 9210 FORMAT(' AMPLITUDE ',8(' , ',E12.6)) 11910000 9220 FORMAT(' SCALE FACTOR = ',E12.6) 11920000 9230 FORMAT(' PARAMETER A,B',F14.7,' , ',F14.7) 11930000 9240 FORMAT(' PARAMETER A,B,C',F14.7,' , ',F14.7,' , ',F14.7 ) 11940000 9250 FORMAT(' STANDARD DEVIATIONS= ',F14.7,' , ',F14.7) 11950000 9260 FORMAT (' LOCAL INCIDENCE ANGLE ') 11960000 9270 FORMAT (' PICKED RMS AMPLITUDE ') 11970000 9280 FORMAT (' *** FITTED AMPLITUDE 2ND ORDER OF SIN ***') 11980000 9290 FORMAT (' *** FITTED AMPLITUDE 4TH ORDER OF SIN ***') 11990000 9300 FORMAT(' MAXIMUN NUMBER OF PLOTS (40 ) FINISHED') 12000000 9310 FORMAT(' CORRECTION FACTOR FOR A+B*SIN**2 ') 12010000 9320 FORMAT(' CORRECTION FACTOR FOR A+B*SIN**2 + C*SIN**4 ') 12020000 9330 FORMAT(' NUMBER OF CDP PROCESSED ',I4,' , ',I4) 12030000 END 12040000