C RELATIVE AMPLITUDE SCALING ON RECORD BASIS HEADER SPRARS 00010013 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CTITLESPRARS -- RELATIVE AMPLITUDE SCALING 00020013 CA AUTHOR C. W. CACKLER 00030013 CA DESIGNER C. W. CACKLER 00040013 CA LANGUAGE FORTRAN 00050013 CA SYSTEM IBM AND CRAY 00060013 C WRITTEN 12-19-79 00070013 C REVISED 03-06-86 BY ESN. FOR CRAY COMPATIBILITY. 00080013 C REVISED 06-30-87 BY MJM. ADD OPTION TO CALCULATE 00090013 C SCALE ONLY WITHIN DESIGN WINDOW 00100013 C AND/OR BY SIDE OF SPREAD. 00110013 C REVISED 09-04-90 ESN. ALLOW FILE MODE. 00120013 C REVISED 11-08-90 ESN. IMPLEMENTED MULTIPLE 00130013 C WINDOWS. 00140013 C REVISED 02-08-91 ESN. REMOVE USER OPTION TO USE 00150013 C TRACES OUTSIDE THE WINDOW FOR 00160013 C SCALING (CARD(1),DF16). 00170013 CA 00180013 CA PROGRAM SPRARS 00190013 CA 00200013 CA THIS PREPARATION ROUTINE SCRUTINIZES USER INPUT DATA 00210013 CA CARDS FOR POSSIBLE ERRORS. IF NO ERRORS ARE FOUND THE 00220013 CA PARAMETERS LISTED ON THE INPUT CARDS ARE USED TO 00230013 CA DEVELOP PROCESSING PARAMETERS FOR USE BY THIS PREPARATION 00240013 CA ROUTINE'S CORRESPONDING PROCESSOR. THESE PARAMETERS 00250013 CA ARE STORED ON SEISPARM FILE FOR ACCESS AT PROCESSING TIME. 00260013 CA 00270013 CA 00280013 C EJECT 00290013 C 00300013 C LOCAL OR INTERNAL ARRAYS. 00310013 C 00320013 C CARD ( 20) = ARRAY TO HOLD 80-CHAR. CARD INPUT DATA I4 00330013 C DATTR ( 96) = ARRAY FOR ATTRIBUTES OF DATA I4 00340013 C DENTRY ( 104) = ARRAY FOR STORAGE OF LOCAL PARAMETERS I4 00350013 C 00360013 C LOCAL OR INTERNAL VARIABLES AND CONSTANTS. 00370013 C 00380013 C DAC = COUNTER FOR CARD READ SUBROUTINE I4 00390013 C DAP = COUNTER FOR PARAMETER READ & WRITE SUBROUTINES I4 00400013 C DA4 = COUNTER FOR PARAMETER DUMP IN THE DEBUG MODE I4 00410013 C DCTYP = VARIABLE FOR TYPE OF SCALING I4 00420013 C NOC = NUMBER OF CARDS READ I4 00430013 C NOPAR = NUMBER OF PARAMETERS I4 00440013 C NOREC = NUMBER OF RECORDS I4 00450013 C PMODE = PROCESSING MODE I4 00460013 C R1 = STARTING SHOTPOINT OR DEPTHPOINT I4 00470013 C R2 = ENDING SHOTPOINT OR DEPTHPOINT I4 00480013 C SPT = STARTING POINT I4 00490013 C EJECT 00500013 C====================================================================== 00510013 C 00520013 CU PROCESS RARS -- RELATIVE AMPLITUDE RECORD SCALING 00530013 CU 00540013 CU DATA CARD (1) -- DEFINES S OR D RANGE 00550013 CU 00560013 CU NO. OF CARDS: REQUIRED = 1 ALLOWED = 1 00570013 CU 00580013 CU REQ OR OPT 00590013 CU DF COLS DESCRIPTION OR DEFAULT 00600013 CU -- ----- ----------- -----------00610013 CU 1 1- 4 'RARS' |REQ |00620013 CU 2 - 5 PROCESS NUMBER |0 |00630013 CU 3 - 6 NOT USED | |00640013 CU 4 - 7 PROCESSING MODE |LINE CARD|00650013 CU 'S' = SHOTPOINT MODE | |00660013 CU 'D' = DEPTH POINT MODE | |00670013 CU 'F' = FILE NUMBER | |00680013 CU 5 8-10 FOR PROGRAMMING USE | |00690013 CU 6 11-15 STARTING SHOTPOINT, DEPTH POINT |REQ |00700013 CU 7 16-20 ENDING SHOTPOINT, DEPTH POINT |DF6 |00710013 CU 8 21-25 TYPE |ABS |00720013 CU 'ABS'=SCALE DETERMINED BY MEAN ABSOLUTE VALUE | |00730013 CU 'MAX'=SCALE DETERMINED BY MAX. ABSOLUTE VALUE | |00740013 CU 'RMS'=SCALE DETERMINED BY ROOT MEAN SQUARE VALUE| |00750013 CU 9 26-30 REFERENCE MEAN |3000 |00760013 CU 10 31-35 DISTANCE X1 |REQ |00770013 CU 11 36-40 WINDOW START TIME AT X1 (MS) |REQ |00780013 CU 12 41-45 WINDOW END TIME AT X1 (MS) |REQ |00790013 CU 13 46-50 DISTANCE X2 |OPT |00800013 CU 14 51-55 WINDOW START TIME AT X2 (MS) |OPT |00810013 CU 15 56-60 WINDOW END TIME AT X2 (MS) |OPT |00820013 CU 16 61-65 NOT USED | |00830013 CU 17 66-70 SIDE OF SPREAD TO USE |OPT |00840013 CU 18 71-75 NUMBER OF WINDOWS TO SMOOTH OVER |1 |00850013 CU 19 76-80 PRINT INCREMENT FOR SCALE FACTORS |NOTE DF19|00860013 CU -----------00870013 CU 00880013 CU 00890013 CU DF NOTES 00900013 CU -- ----- 00910013 CU 6 TRACES OUTSIDE THE CODED RANGE (DF6-DF7) ARE NOT PASSED 00920013 CU TO SUBSEQUENT PROCESSES. 00930013 CU THE SCALE FACTOR IS COMPUTED FOR EACH RECORD IN THE PROCESSING 00940013 CU RANGE SPECIFIED BY DF6 AND DF7. 00950013 CU 00960013 CU 9 NORMAL RANGE 2500-4000 00970013 CU 00980013 CU 10 FOR STACKED DATA X1 = 0 00990013 CU EJECT 01000013 CU 01010013 CU 17 IF 'R', USE SIDE OF SPREAD SUCH THAT SHOT POINT LOCATION IS 01020013 CU LESS THAN OR EQUAL TO RECEIVER LOCATION TO DETERMINE SCALE. 01030013 CU 01040013 CU IF 'L', USE SIDE OF SPREAD SUCH THAT SHOT POINT LOCATION IS 01050013 CU GREATER THAN OR EQUAL TO RECEIVER LOCATION TO DETERMINE SCALE 01060013 CU 01070013 CU IF ' ' OR 'B', BOTH SIDES OF SPREAD WILL BE USED. 01080013 CU 01090013 CU EXAMPLE 01100013 CU ------- 01110013 CU LINEAR INTERPOLATION FOR WINDOW START AND END. 01120013 CU 01130013 CU (0) ========= TIME =========> 01140013 CU == TRACE AT X1 ! --WST1 **************************** WET1 01150013 CU ! **************************** 01160013 CU D ! **************************** 01170013 CU I ! **************************** 01180013 CU S ! **************************** 01190013 CU T ! **************************** 01200013 CU ! **************************** 01210013 CU == TRACE AT X2 ! ------WST2 **************************** WET2 01220013 CU 01230013 CU LINEAR INTERPOLATION WILL BE DONE FOR TRACE IN A SHOTPOINT 01240013 CU OR GATHER GROUP BY DISTANCE. 01250013 CU X1 = DISTANCE 1 (DF10) 01260013 CU WST1 = WINDOW START TIME AT X1 (DF11) 01270013 CU WET1 = WINDOW END TIME AT X1 (DF12) 01280013 CU X2 = DISTANCE 2 (DF13) 01290013 CU WST2 = WINDOW START TIME AT X2 (DF14) 01300013 CU WET2 = WINDOW END TIME AT X2 (DF15) 01310013 CU 01320013 CU 01330013 CU NUMBER OF WINDOWS BEFORE APPLICATION. IF NOT SUPPLIED AS 01340013 CU AN ODD NUMBER, THE NEXT LOWER ODD NUMBER WILL BE USED. 01350013 CU 01360013 CU 18 THE SCALE FACTORS DETERMINED WILL BE AVERAGED OVER THIS 01370013 CU NUMBER OF WINDOWS BEFORE APPLICATION. IF NOT SUPPLIED AS 01380013 CU AN ODD NUMBER, THE NEXT LOWER ODD NUMBER WILL BE USED. 01390013 CU 01400013 CU 19 SCALE FACTORS FOR SHOTPOINTS OR DEPTH POINTS WHICH ARE A 01410013 CU MULTIPLE OF THIS VALUE WILL BE PRINTED. '0' IS THE DEFAULT, 01420013 CU AND WILL RESULT IN NO PRINT. 01430013 CU EJECT 01440013 CU 01450013 CU DATA CARD (2 ) -- DEFINES EXTRA WINDOWS 01460013 CU 01470013 CU NO. OF CARDS: REQUIRED = 0 ALLOWED = 25 01480013 CU 01490013 CU 01500013 CU REQ OR OPT 01510013 CU DF COLS DEFINITION OR DEFAULT 01520013 CU -- ---- ---------- ---------- 01530013 CU 1 1 -4 'RARS' |REQ |01540013 CU 2 -5 PROCESS NUMBER |0 |01550013 CU 3 -6 NOT USED | |01560013 CU 4 -7 NOT USED | |01570013 CU 5 8 -10 'WIN' |REQ |01580013 CU 6 11-15 REFERENCE MEAN |3000 |01590013 CU 7 16-20 DISTANCE X1 FOR WINDOW 2 |REQ |01600013 CU 8 21-25 WINDOW 2 START TIME AT X1 (MS) |REQ |01610013 CU 9 26-30 WINDOW 2 END TIME AT X1 (MS) |REQ |01620013 CU 10 31-35 DISTANCE X2 FOR WINDOW 2 |OPT |01630013 CU 11 36-40 WINDOW 2 START TIME AT X2 (MS) |OPT |01640013 CU 12 41-45 WINDOW 2 END TIME AT X2 (MS) |OPT |01650013 CU 13 46-50 REFERENCE MEAN |3000 |01660013 CU 14 51-55 DISTANCE X1 |OPT |01670013 CU 15 56-60 WINDOW START TIME AT X1 (MS) |OPT |01680013 CU 16 61-65 WINDOW END TIME AT X1 (MS) |OPT |01690013 CU 17 66-70 DISTANCE X2 |OPT |01700013 CU 18 71-75 WINDOW START TIME AT X2 (MS) |OPT |01710013 CU 19 76-80 WINDOW END TIME AT X2 (MS) |OPT |01720013 CU ---------- 01730013 CU 01740013 CU DF NOTES 01750013 CU -- ----- 01760013 CU 01770013 CU 5 THE SCALING APPLIED WILL BE LINEARLY INTERPOLATED BETWEEN 01780013 CU THE CENTER OF ALL WINDOWS SUPPLIED AND COPIED BEFORE THE 01790013 CU EJECT 01800013 CU 01810013 CU DATA CARD (3 ) -- DEFINES ADDITIONAL PARAMETERS 01820013 CU 01830013 CU NO. OF CARDS: REQUIRED = 0 ALLOWED = 1 01840013 CU 01850013 CU 01860013 CU REQ OR OPT 01870013 CU DF COLS DEFINITION OR DEFAULT 01880013 CU -- ---- ---------- ---------- 01890013 CU 1 1 -4 'RARS' |REQ |01900013 CU 2 -5 PROCESS NUMBER |0 |01910013 CU 3 -6 NOT USED | |01920013 CU 4 -7 NOT USED | |01930013 CU 5 8 -10 'TRC' |REQ |01940013 CU 6 11-15 NUMBER OF TRACES PER MODE |NOTE DF6 |01950013 CU 16-80 NOT USED | |01960013 CU ---------- 01970013 CU 01980013 CU DF NOTES 01990013 CU -- ----- 02000013 CU 02010013 CU 6 FOR DEPTH POINT MODE, THIS DEFAULTS TO THE LINE CARD MAXIMUM 02020013 CU NUMBER OF TRACES PER DEPTH POINT. FOR SHOT POINT OR FILE 02030013 CU MODE, THIS DEFAULTS TO THE NUMBER OF TRACES PER SHOTPOINT. 02040013 C EJECT 02050013 C ===================================================================== 02060013 C FORMAT OF OUTPUT PARAMETER RECORDS 02070013 C 02080013 C ****** FIRST RECORDS ****** PROCESSING RANGES ****** 02090013 C 02100013 C WORD 1 WORD 2 WORD 3 WORD 4 WORD 5 WORD 6 WORD 7 WORD 8 02110013 C |_______|________|_______|_______|_______|_______|_|_|_____|_______| 02120013 C | RARS | INVOC. | PTS | NOT | NOT | # OF |N|P| NOT | NOT | 02130013 C |_______|_NUMBER_|_______|__USED_|__USED_|_PARMS_|_|M|_USED|__USED_| 02140013 C 02150013 C WORD 9 WORD 10 02160013 C |_______|________| 02170013 C | START | END | 02180013 C |S D_PT|_S D_PT| 02190013 C . . . 02200013 C . . . 02210013 C . . . 02220013 C WORD 103WORD 104 02230013 C |_______|________| 02240013 C | START | END | 02250013 C |S D_PT|_S D_PT| 02260013 C 02270013 C EJECT 02280013 C 02290013 C ****** APPLICATION RECORD ****** 02300013 C 02310013 C WORD 1 WORD 2 WORD 3 WORD 4 WORD 5 WORD 6 WORD 7 WORD 8 02320013 C |_______|________|_______|_______|_______|_______|_|_|_____|_______| 02330013 C | RARS | INVOC. |ABS,MAX| S OR D| NOT | # OF |N|P| NOT | SHOT | 02340013 C |_______|_NUMBER_|OR RMS_|__PT.__|__USED_|_PARMS_|_|M|_USED|_LOCN._| 02350013 C 02360013 C WORD 9 WORD 10 WORD 11 02370013 C |_______|_______|_______| 02380013 C |END | SCALE |SPREAD | 02390013 C |S/D_PT_| _TYPE_|_TYPE__| 02400013 C 02410013 C WORD 12 WORD 13 WORD 14 WORD 15 WORD 16 WORD 17 WORD 18 02420013 C |_______|_______|_______|_______|_______|_______|_______| 02430013 C |REF. |DIST. |WIN. X1|WIN. X1|DIST. |WIN. X2|WIN. X2| WINDOW 02440013 C |MEAN___|X1_____|START__|END____|X2_____|START__|END____| 1 02450013 C 02460013 C WORD 19 WORD 20 WORD 21 WORD 22 WORD 23 WORD 24 WORD 25 02470013 C |_______|_______|_______|_______|_______|_______|_______| 02480013 C |REF. |DIST. |WIN. X1|WIN. X1|DIST. |WIN. X2|WIN. X2| WINDOW 02490013 C |MEAN___|X1_____|START__|END____|X2_____|START__|END____| 2 02500013 C 02510013 C . . . . . . . 02520013 C 02530013 C WORD 96 WORD 97 WORD 98 WORD 99 WORD100 WORD101 WORD102 02540013 C |_______|_______|_______|_______|_______|_______|_______| 02550013 C |REF. |DIST. |WIN. X1|WIN. X1|DIST. |WIN. X2|WIN. X2| WINDOW 02560013 C |MEAN___|X1_____|START__|END____|X2_____|START__|END____| 13 02570013 C 02580013 C ==================================================================== 02590013 C EJECT 02600013 C 02610013 SUBROUTINE SPRARS 02620013 C 02630013 IMPLICIT INTEGER (A-Z) 02640013 C 02650013 C COMMON /P/ STATEMENTS GENERATED BY UTCGI4 11/30/83 02660013 COMMON /P/ STARTP ( 2) 02670013 COMMON /P/ LCNAME 02680013 COMMON /P/ LC5 02690013 COMMON /P/ LCINT 02700013 COMMON /P/ LCTYP , M00020 02710013 COMMON /P/ LCBGSP 02720013 COMMON /P/ LCENSP , M00032( 2) 02730013 COMMON /P/ LCNSP 02740013 COMMON /P/ LCTPSP 02750013 COMMON /P/ LCRL 02760013 COMMON /P/ LCSI 02770013 COMMON /P/ LCPI 02780013 COMMON /P/ LCGRPI 02790013 COMMON /P/ LCMXFD , M00068( 2) 02800013 COMMON /P/ LCDRYF , M00080( 3) 02810013 COMMON /P/ ACNAME 02820013 COMMON /P/ AC0506 02830013 COMMON /P/ AC64BC 02840013 COMMON /P/ ACOPCD 02850013 COMMON /P/ ACQCF 02860013 COMMON /P/ ACDIST 02870013 COMMON /P/ ACPROJ 02880013 COMMON /P/ ACLNAM ( 5) 02890013 COMMON /P/ ACCOM ( 8) , M00144 02900013 COMMON /P/ ACTYPE 02910013 COMMON /P/ ACNSP 02920013 COMMON /P/ ACUSER ( 5) , M00188( 12) 02930013 COMMON /P/ LHJBNO 02940013 COMMON /P/ LHLNO 02950013 COMMON /P/ LHRLNO 02960013 COMMON /P/ LHTPSP 02970013 COMMON /P/ LHATSP 02980013 COMMON /P/ LHSI 02990013 COMMON /P/ LHORSI 03000013 COMMON /P/ LHST 03010013 COMMON /P/ LHORST 03020013 COMMON /P/ LHDFCD 03030013 COMMON /P/ LHEXFD 03040013 COMMON /P/ LHTSCD 03050013 COMMON /P/ LHVSCD 03060013 COMMON /P/ LHSWFS 03070013 COMMON /P/ LHSWFE 03080013 COMMON /P/ LHSWL 03090013 COMMON /P/ LHSWCD 03100013 COMMON /P/ LHTSNO 03110013 COMMON /P/ LHSWTS 03120013 COMMON /P/ LHSWTE 03130013 COMMON /P/ LHSWTT 03140013 COMMON /P/ LHTCF 03150013 COMMON /P/ LHBGRF 03160013 COMMON /P/ LHARCD 03170013 COMMON /P/ LHMS 03180013 COMMON /P/ LHSGPL 03190013 COMMON /P/ LHVPCD 03200013 COMMON /P/ LHNSP 03210013 COMMON /P/ LHNDP 03220013 COMMON /P/ LHNSL 03230013 COMMON /P/ LHMTPR , M00376( 9) 03240013 COMMON /P/ KPNA 03250013 COMMON /P/ KPRNO , M00420 03260013 COMMON /P/ KPA 03270013 COMMON /P/ KPDBGS 03280013 COMMON /P/ KPDBGA 03290013 COMMON /P/ KPDBGN 03300013 COMMON /P/ KPWRKS 03310013 COMMON /P/ KPWRKD , M00448( 4) 03320013 COMMON /P/ KPFCF 03330013 COMMON /P/ KPIRSM 03340013 COMMON /P/ KPNRSM 03350013 COMMON /P/ KPIUSM 03360013 COMMON /P/ KPNUSM 03370013 COMMON /P/ KPTIME 03380013 COMMON /P/ KPRTF 03390013 COMMON /P/ KPDRTF 03400013 COMMON /P/ KPMOTF 03410013 COMMON /P/ KPNBR 03420013 COMMON /P/ KPIBN 03430013 COMMON /P/ KPITSV 03440013 COMMON /P/ KPTAMF 03450013 COMMON /P/ KPLOTF 03460013 COMMON /P/ KPMITF 03470013 COMMON /P/ KPPRNT 03480013 COMMON /P/ KPPLOT 03490013 COMMON /P/ KPPLTA 03500013 COMMON /P/ KPBUGF , M00540( 226) 03510013 COMMON /P/ ENDP 03520013 C 03530013 C=================================================================== 03540013 C 03550013 C INTEGER ARRAYS--LOCAL 03560013 INTEGER DATTR (96) 03570013 INTEGER DENTRY (104) 03580013 C 03590013 C=================================================================== 03600013 C 03610013 C CHARACTER VARIABLES--LOCAL 03620013 CHARACTER*80 CARD 03630013 C 03640013 EQUIVALENCE (DCTYP ,DENTRY (03)) 03650013 EQUIVALENCE (SPT ,DENTRY (04)) 03660013 EQUIVALENCE (NWIN ,DENTRY (05)) 03670013 EQUIVALENCE (NOPAR ,DENTRY (06)) 03680013 EQUIVALENCE (PMODE ,DENTRY (07)) 03690013 EQUIVALENCE (SPLOCN ,DENTRY (08)) 03700013 EQUIVALENCE (DATTR(1) ,DENTRY (09)) 03710013 C 03720013 C=================================================================== 03730013 C 03740013 C DATA STATEMENTS 03750013 DATA ABS /' ABS'/ 03760013 DATA BLANK /' '/ 03770013 DATA DATTR /96 * 0/ 03780013 DATA BEE /'B '/ 03790013 DATA IYES /'YES '/ 03800013 DATA MAX /' MAX'/ 03810013 DATA RMS /' RMS'/ 03820013 C 03830013 C INTIALIZATION AREA 03840013 C 03850013 DAC = 1 03860013 DAP = 1 03870013 IPR = KPPRNT 03880013 C PRINT HEADING 03890013 CALL USPHD (1,ACLNAM,KPNA,KPRNO,0,0,IPR) 03900013 C 03910013 DENTRY(1) = KPNA 03920013 DENTRY(2) = KPRNO 03930013 NOREC = 0 03940013 NOC = 0 03950013 NOPAR = 0 03960013 C 03970013 DCTYP = BLANK 03980013 CALL S1MVCH ('PTS ',1,DCTYP,1,4) 03990013 C 04000013 C SET THE PROCESSING MODE TO 'S' OR 'D' 04010013 C 04020013 CALL FORC(KPNA,KPRNO,DAC,CARD, *180) 04030013 DAC = 1 04040013 IF(S1CPCH(CARD,7,' ',1,1).NE.0) GO TO 10 04050013 CALL S1MVCH(LCTYP,1,CARD,7,1) 04060013 C 04070013 C SET INTERPOLATION TYPE 04080013 C 04090013 10 CALL S1MVCH('N',1,CARD,6,1) 04100013 C 04110013 PMODE = BLANK 04120013 CALL S1MVCH(CARD,6,PMODE,1,4) 04130013 C 04140013 DO 20 L = 1 , 96 04150013 C 04160013 20 DATTR (L) = 0 04170013 C 04180013 K = 0 04190013 C EJECT 04200013 C 04210013 CZ ********************************************************* 04220013 CZ ********************************************************* 04230013 CZ ********** RETRIEVE PROCESSING RANGES. *********** 04240013 CZ ********************************************************* 04250013 CZ ********************************************************* 04260013 C 04270013 30 CALL FORC (KPNA,KPRNO,DAC,CARD, *40) 04280013 IF (S1CPCH(CARD,8,' ',1,3).NE.0) GO TO 30 04290013 NOC = NOC + 1 04300013 IF (NOC.NE.1) GO TO 200 04310013 C 04320013 R1 = S1CVBN (CARD,11,5) 04330013 IF (R1.EQ.0) GO TO 150 04340013 R2 = S1CVBN (CARD,16,5) 04350013 IF (R2.EQ.0) R2 = R1 04360013 C 04370013 DATTR(K+1) = R1 04380013 DATTR(K+2) = R2 04390013 K = K + 2 04400013 GO TO 30 04410013 C 04420013 40 IF (NOC.EQ.0) GO TO 180 04430013 NOPAR = K 04440013 CALL FOWP (KPNA,KPRNO,DAP,104,DENTRY, *40) 04450013 NOREC = NOREC + 1 04460013 C 04470013 DO 50 L=1,96 04480013 C 04490013 50 DATTR(L)=0 04500013 C EJECT 04510013 C 04520013 CZ ******************************************************* 04530013 CZ ****** NOW REREAD THE CARDS AND WRITE ****** 04540013 CZ ****** THE PARAMETER RECORDS ****** 04550013 CZ ******************************************************* 04560013 C 04570013 NOC = 0 04580013 NOPAR = 0 04590013 DAC = 1 04600013 C 04610013 60 CALL FORC (KPNA,KPRNO,DAC,CARD, *170) 04620013 IF (S1CPCH(CARD,8,' ',1,3).NE.0) GO TO 60 04630013 NOC = NOC + 1 04640013 C 04650013 SPT = S1CVBN(CARD,11,5) 04660013 DATTR(1) = S1CVBN(CARD,16,5) 04670013 IF (DATTR(1).EQ.0) DATTR(1) = SPT 04680013 SPLOCN = SPT 04690013 C IF SHOT POINT MODE, GET SHOT POINT LOCATION 04700013 IF (S1CPCH(PMODE,2,'S',1,1).EQ.0)CALL USSLN (SPT, LCTPSP 04710013 *, SPLOCN, *210) 04720013 C 04730013 C MOVE TYPE TO DCTYPE 04740013 C DEFAULT TO 'ABS' 04750013 C 04760013 IF (S1CPCH(CARD,22,' ',1,4).NE.0) GO TO 80 04770013 CALL S1MVCH ('ABS',1,CARD,23,3) 04780013 C 04790013 80 DCTYP = BLANK 04800013 CALL S1MVCH ( CARD, 22, DCTYP, 1, 4 ) 04810013 C 04820013 C INTERPRET REFERENCE MEAN 04830013 C DEFAULT TO 3000 04840013 DATTR(4) = S1CVBN( CARD, 26, 5) 04850013 IF ( DATTR(4) .EQ. 0 ) DATTR(4) = 3000 04860013 C 04870013 C INTERPRET WINDOW START AND END 04880013 C 04890013 DATTR(5) = S1CVBN( CARD, 31, 5) 04900013 DATTR(6) = S1CVBN( CARD, 36, 5) 04910013 DATTR(7) = S1CVBN( CARD, 41, 5) 04920013 DATTR(8) = S1CVBN( CARD, 46, 5) 04930013 DATTR(9) = S1CVBN( CARD, 51, 5) 04940013 DATTR(10) = S1CVBN( CARD, 56, 5) 04950013 C 04960013 C GET SPREAD TYPES 04970013 C 04980013 CALL S1MVCH(CARD, 70, DATTR(3),1,1) 04990013 IF (S1CPCH(CARD,66,' R',1,5) .NE. 0 ) THEN 05000013 IF (S1CPCH(CARD,66,' L',1,5) .NE. 0 ) THEN 05010013 CALL S1MVCH(BEE, 1, DATTR(3), 1, 1) 05020013 END IF 05030013 END IF 05040013 C 05050013 C CHECK FOR WINDOW START AND END 05060013 C BEING BLANK 05070013 C 05080013 IF (S1CPCH(CARD,31,' ',1,5).EQ.0) GO TO 190 05090013 IF (S1CPCH(CARD,36,' ',1,5).EQ.0) GO TO 190 05100013 C 05110013 C CHECK FOR X2 BEING BLANK IF START OR END IS 05120013 C CODED 05130013 C 05140013 IF (S1CPCH(CARD,51,' ',1,5).EQ.0) GO TO 90 05150013 IF (S1CPCH(CARD,46,' ',1,5).EQ.0) GO TO 190 05160013 GO TO 100 05170013 C 05180013 90 IF (S1CPCH(CARD,56,' ',1,5).EQ.0) GO TO 100 05190013 IF (S1CPCH(CARD,46,' ',1,5).EQ.0) GO TO 190 05200013 C 05210013 100 NOPAR = 10 05220013 IF ( DATTR(7) .LE. DATTR(6) ) GO TO 190 05230013 IF ( DATTR( 8) .EQ. 0 ) GO TO 60 05240013 IF ( DATTR(5) .EQ. DATTR( 8) ) GO TO 190 05250013 IF ( DATTR(10) .LE. DATTR(9) ) GO TO 190 05260013 C 05270013 C CHECK FOR WINDOW START AND END AT X2 05280013 C BEING BLANK 05290013 C 05300013 IF (S1CPCH(CARD,51,' ',1,5).EQ.0) GO TO 190 05310013 IF (S1CPCH(CARD,56,' ',1,5).EQ.0) GO TO 190 05320013 C 05330013 C CHECK FOR X2 GREATER THAN X1 GO AROUND 05340013 C SPECIAL CODE IF TRUE 05350013 IF ( DATTR(7) .EQ. 0 ) GO TO 110 05360013 IF ( DATTR(8) .GT. DATTR(5) ) GO TO 110 05370013 C 05380013 C CODE TO FLIP WINDOW FOR X1 AND WINDOW FOR X2 05390013 C FORCE THE NUMERATOR TO BE POSITIVE,IN THE 05400013 C VELOCITY CALCULATION 05410013 C 05420013 DATTR(5) = S1CVBN( CARD, 46, 5) 05430013 DATTR(6) = S1CVBN( CARD, 51, 5) 05440013 DATTR(7) = S1CVBN( CARD, 56, 5) 05450013 DATTR(8) = S1CVBN( CARD, 31, 5) 05460013 DATTR(9) = S1CVBN( CARD, 36, 5) 05470013 DATTR(10) = S1CVBN( CARD, 41, 5) 05480013 C 05490013 110 CONTINUE 05500013 GO TO 60 05510013 C 05520013 140 WRITE (IPR, 9000 ) 05530013 GO TO 220 05540013 C 05550013 150 WRITE (IPR, 9010 ) CARD 05560013 C 05570013 KPRTF=-1 05580013 GO TO 30 05590013 C 05600013 170 IF(NOC.EQ.0) GO TO 180 05610013 C MAKE SURE NO ERRORS HAVE OCCURRED 05620013 C 05630013 CZ ******************************************************* 05640013 CZ ****** NOW READ THE WIN CARDS AND WRITE ****** 05650013 CZ ****** THE PARAMETER RECORDS ****** 05660013 CZ ******************************************************* 05670013 C 05680013 NOC = 0 05690013 DAC = 1 05700013 K = 11 05710013 NWIN = 1 05720013 NWINPR = 0 05730013 C 05740013 1060 CALL FORC (KPNA,KPRNO,DAC,CARD, *1170 )05750013 IF (S1CPCH(CARD,8,'WIN',1,3) .NE. 0) GO TO 1060 05760013 NOC = NOC + 1 05770013 C 05780013 COL = 11 05790013 DO 1150 IWIN = 1, 2 05800013 C 05810013 C INTERPRET REFERENCE MEAN 05820013 C DEFAULT TO 3000 05830013 C 05840013 DATTR(K) = S1CVBN( CARD, COL, 5) 05850013 IF ( DATTR(K) .EQ. 0 ) DATTR(K) = 3000 05860013 C 05870013 C INTERPRET WINDOW START AND END 05880013 C 05890013 DATTR(K+1) = S1CVBN( CARD, COL+5, 5) 05900013 DATTR(K+2) = S1CVBN( CARD, COL+10, 5) 05910013 DATTR(K+3) = S1CVBN( CARD, COL+15, 5) 05920013 DATTR(K+4) = S1CVBN( CARD, COL+20, 5) 05930013 DATTR(K+5) = S1CVBN( CARD, COL+25, 5) 05940013 DATTR(K+6) = S1CVBN( CARD, COL+30, 5) 05950013 C 05960013 C CHECK FOR ANY OF WINDOW START AND END 05970013 C BEING BLANK, OR DISTANCE 05980013 C 05990013 IF (S1CPCH(CARD,COL ,' ',1,5).NE.0 .AND. 06000013 * S1CPCH(CARD,COL+5 ,' ',1,5).NE.0 .AND. 06010013 * S1CPCH(CARD,COL+10,' ',1,5).NE.0 .AND. 06020013 * S1CPCH(CARD,COL+15,' ',1,5).NE.0) GO TO 1080 06030013 C 06040013 C IF ANY ARE BLANK, THEY MUST ALL BE BLANK 06050013 C 06060013 IF (S1CPCH(CARD,COL+ 5,' ',1,5).NE.0) GO TO 1190 06070013 IF (S1CPCH(CARD,COL+10,' ',1,5).NE.0) GO TO 1190 06080013 IF (S1CPCH(CARD,COL+15,' ',1,5).NE.0) GO TO 1190 06090013 IF (S1CPCH(CARD,COL+20,' ',1,5).NE.0) GO TO 1190 06100013 IF (S1CPCH(CARD,COL+25,' ',1,5).NE.0) GO TO 1190 06110013 IF (S1CPCH(CARD,COL+30,' ',1,5).NE.0) GO TO 1190 06120013 GO TO 1150 06130013 1080 CONTINUE 06140013 C 06150013 C CHECK FOR X2 BEING BLANK IF START OR END IS 06160013 C CODED 06170013 C 06180013 IF (S1CPCH(CARD,COL+25,' ',1,5).EQ.0) GO TO 1090 06190013 IF (S1CPCH(CARD,COL+20,' ',1,5).EQ.0) GO TO 1190 06200013 GO TO 1100 06210013 C 06220013 1090 IF (S1CPCH(CARD,COL+30,' ',1,5).EQ.0) GO TO 1100 06230013 IF (S1CPCH(CARD,COL+20,' ',1,5).EQ.0) GO TO 1190 06240013 C 06250013 1100 CONTINUE 06260013 IF ( DATTR(K+3) .LE. DATTR(K+2) ) GO TO 1190 06270013 IF ( DATTR(K+4) .EQ. 0 ) GO TO 1110 06280013 IF ( DATTR(K+1) .EQ. DATTR(K+4) ) GO TO 1190 06290013 IF ( DATTR(K+6) .LE. DATTR(K+5) ) GO TO 1190 06300013 C 06310013 C CHECK FOR WINDOW START AND END AT X2 06320013 C BEING BLANK 06330013 C 06340013 IF (S1CPCH(CARD,COL+25,' ',1,5).EQ.0) GO TO 1190 06350013 IF (S1CPCH(CARD,COL+30,' ',1,5).EQ.0) GO TO 1190 06360013 C 06370013 C CHECK FOR X2 GREATER THAN X1 GO AROUND 06380013 C SPECIAL CODE IF TRUE 06390013 C 06400013 IF ( DATTR(K+4) .EQ. 0 ) GO TO 1110 06410013 IF ( DATTR(K+6) .GT. DATTR(K+5) ) GO TO 1110 06420013 C 06430013 C CODE TO FLIP WINDOW FOR X1 AND WINDOW FOR X2 06440013 C FORCE THE NUMERATOR TO BE POSITIVE, IN THE 06450013 C VELOCITY CALCULATION 06460013 C 06470013 DATTR(K+1) = S1CVBN( CARD, COL+20, 5) 06480013 DATTR(K+2) = S1CVBN( CARD, COL+25, 5) 06490013 DATTR(K+3) = S1CVBN( CARD, COL+35, 5) 06500013 DATTR(K+4) = S1CVBN( CARD, COL+5, 5) 06510013 DATTR(K+5) = S1CVBN( CARD, COL+10, 5) 06520013 DATTR(K+6) = S1CVBN( CARD, COL+15, 5) 06530013 1110 CONTINUE 06540013 NWIN = NWIN + 1 06550013 IF ((NWIN+NWINPR) .GT. 51) GO TO 205 06560013 K = K + 7 06570013 IF (K .GE. 90) THEN 06580013 NOPAR = NOPAR + 7 06590013 NOPAR = K 06600013 CALL FOWP (KPNA,KPRNO,DAP,104,DENTRY, *140 ) 06610013 NOREC = NOREC + 1 06620013 CALL ARSET (DATTR(4), 93, 0) 06630013 K = 4 06640013 NWINPR = NWINPR + NWIN 06650013 NWIN = 0 06660013 ENDIF 06670013 1150 COL = COL + 35 06680013 GO TO 1060 06690013 1170 CONTINUE 06700013 C 06710013 C WRITE OUT THE WINDOWS 06720013 C 06730013 IF (NWIN .GT. 0) THEN 06740013 CALL FOWP (KPNA,KPRNO,DAP,104,DENTRY, *140) 06750013 NOREC = NOREC + 1 06760013 ENDIF 06770013 GO TO 230 06780013 C 06790013 180 WRITE (IPR , 9020 ) 06800013 GO TO 220 06810013 C 06820013 190 WRITE (IPR , 9030 ) 06830013 GO TO 220 06840013 C 06850013 1190 WRITE (IPR , 9030 ) 06860013 GO TO 220 06870013 C 06880013 200 WRITE (IPR , 9040 ) 06890013 GO TO 220 06900013 C 06910013 205 WRITE (IPR , 9230 ) 06920013 GO TO 220 06930013 C 06940013 210 WRITE (IPR, 9050 ) SPT 06950013 GO TO 340 06960013 C 06970013 220 KPRTF = -1 06980013 C 06990013 230 IF(KPBUGF.EQ.0) GO TO 250 07000013 C 07010013 C DUMP THE PARAMETER ENTRIES 07020013 C 07030013 DAP = 1 07040013 C 07050013 240 CALL FORP(KPNA,KPRNO,DAP,104,DENTRY, *250) 07060013 WRITE (IPR, 9060 ) DENTRY 07070013 GO TO 240 07080013 C 07090013 250 DA4 = 1 07100013 IF (KPRTF.LT.0) GO TO 320 07110013 C 07120013 260 CALL FORP(KPNA,KPRNO,DA4,104,DENTRY, *310) 07130013 IF (S1CPCH(DCTYP,1,'PTS',1,3).EQ.0) GO TO 260 07140013 C 07150013 C CHECK FOR RANGE HEADING 07160013 C 07170013 IF (S1CPCH(PMODE,2,'S',1,1).NE.0) GO TO 270 07180013 WRITE ( IPR, 9070 ) SPT,DATTR(1) 07190013 GO TO 280 07200013 C 07210013 270 CONTINUE 07220013 IF (S1CPCH(PMODE,2,'D',1,1).NE.0) GO TO 275 07230013 WRITE ( IPR, 9090 ) SPT,DATTR(1) 07240013 GO TO 280 07250013 C 07260013 275 CONTINUE 07270013 WRITE ( IPR, 9095 ) SPT,DATTR(1) 07280013 C 07290013 280 CONTINUE 07300013 IF ( DCTYP .EQ. ABS .OR. DCTYP .EQ. MAX .OR. DCTYP .E 07310013 *Q. RMS )GO TO 290 07320013 GO TO 330 07330013 C 07340013 290 CONTINUE 07350013 C 07360013 IF ( DCTYP .EQ. ABS ) WRITE ( IPR, 9120 ) 07370013 IF ( DCTYP .EQ. MAX ) WRITE ( IPR, 9130 ) 07380013 IF ( DCTYP .EQ. RMS ) WRITE ( IPR, 9140 ) 07390013 C 07400013 DAP = 1 07410013 NWINPR = 0 07420013 WRITE (KPPRNT, 9210) 07430013 295 CALL FORP (KPNA,KPRNO,DAP,104,DENTRY, *310) 07440013 IF (S1CPCH(DCTYP,1,'PTS',1,3).EQ.0) GO TO 295 07450013 K = 4 07460013 DO 300 IWIN = 1, NWIN 07470013 JWIN = NWINPR + IWIN 07480013 IF (DATTR(K+4) .EQ. 0) THEN 07490013 WRITE ( IPR, 9220) JWIN,(DATTR(K+I-1),I=1,4) 07500013 ELSE 07510013 WRITE ( IPR, 9220) JWIN,(DATTR(K+I-1),I=1,7) 07520013 ENDIF 07530013 300 K = K + 7 07540013 NWINPR = NWINPR + NWIN 07550013 GO TO 295 07560013 C 07570013 C PRINT THE TOTAL NUMBER OF RECORDS 07580013 C WRITTEN 07590013 C 07600013 310 WRITE (IPR, 9180 ) KPNA,KPRNO,NOREC 07610013 C 07620013 320 RETURN 07630013 C 07640013 330 WRITE (IPR , 9190 ) 07650013 C 07660013 340 KPRTF = -1 07670013 GO TO 60 07680013 C 07690013 C 07700013 9000 FORMAT('0*** FOWP HAD A WRITE ERROR ***') 07710013 C 07720013 9010 FORMAT('0*** NO RANGES PRESENT ***'/10X,A80) 07730013 C 07740013 9020 FORMAT('0*** NO DATA CARD FOR RARS ***'/) 07750013 C 07760013 9030 FORMAT('0*** ERROR IN WINDOW SPECIFICATION ***'/) 07770013 C 07780013 9040 FORMAT ('0*** ONLY ONE RARS CARD ALLOWED ***') 07790013 C 07800013 9050 FORMAT ('0*** LINE LOCATION NOT FOUND FOR SHOTPOINT = ',I5) 07810013 C 07820013 9060 FORMAT(1X,A4,I1,5X,A4,3I5,1X,A4,I5/4(1X,24I5/)) 07830013 C 07840013 9070 FORMAT ('0',5X,' RELATIVE AMPLITUDE RECORD SCALING WILL BE', 07850013 * /,6X,' APPLIED FROM SHOTPOINT ',I5, ' TO SHOTPOINT ' , 07860013 * I5,//) 07870013 C 07880013 C 07890013 9090 FORMAT ('0',5X,' RELATIVE AMPLITUDE RECORD SCALING WILL BE', 07900013 * /,6X,' APPLIED FROM DEPTHPOINT ',I5, ' TO DEPTHPOINT ', 07910013 * I5//) 07920013 C 07930013 9095 FORMAT ('0',5X,' RELATIVE AMPLITUDE RECORD SCALING WILL BE', 07940013 * /,6X,' APPLIED FROM FILE NUMBER ',I5, ' TO FILE NUMBER ', 07950013 * I5//) 07960013 C 07970013 9110 FORMAT ('0',5X,' THE REFERENCE MEAN = ' , I5 ) 07980013 C 07990013 9120 FORMAT ('0',5X,' SCALE DETERMINED BY MEAN ABSOLUTE VALUE ') 08000013 C 08010013 9130 FORMAT ('0',5X,' SCALE DETERMINED BY MAXIMUN ABSOLUTE VALUE ') 08020013 C 08030013 9140 FORMAT ('0',5X,' SCALE DETERMINED BY ROOT MEAN SQUARE VALUE') 08040013 C 08050013 9150 FORMAT ('0',5X,' THE WINDOW WILL START AT',I5,' MS',/, 08060013 * 6X,' AND END AT',I5,' MS') 08070013 C 08080013 9160 FORMAT ('0',5X,' THIS WINDOW WILL BE APPLIED TO THE', 08090013 *' ENTIRE SECTION') 08100013 C 08110013 9170 FORMAT (' ',5X,' AT A DISTANCE = ',I5,' FEET ' ,//, 08120013 * 6X,' AND BE LINEARLY INTERPOLATED ',//, 08130013 * 6X,' TO A START TIME =',I5,' MS ',/, 08140013 * 6X,' AND END TIME =',I5,' MS ',/, 08150013 * 6X,' AT A DISTANCE = ',I5,' FEET ',/) 08160013 C 08170013 9180 FORMAT( '0*** ',A4,I1,' COMPLETED -- NO ERRORS,', 08180013 * /' *** TOTAL NUMBER OF PARAMETER RECORDS = ',I5) 08190013 C 08200013 9190 FORMAT('0*** INCORRECT TYPE SPECIFICATION ***'/) 08210013 C 08220013 9210 FORMAT(' WINDOW REF DIST WINDOW WINDOW', 08230013 * ' DIST WINDOW WINDOW',/, 08240013 * ' NUMBER MEAN X1 START END', 08250013 * ' X2 START END') 08260013 C 08270013 9220 FORMAT(' ',8I10) 08280013 C 08290013 9230 FORMAT('0*** MAXIMUM OF 51 WINDOWS IS ALLOWED ***',/) 08300013 C 08310013 END 08320013