CTITLESPALGN -- TRACE ALIGNMENT USING CROSS CORRELATION 00000100 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** C 00000200 CA AUTHOR R. D. KNIGHT 00000300 CA DESIGNER R. D. KNIGHT 00000400 CA LANGUAGE FORTRAN H 00000500 CA SYSTEM S/370 00000600 CA WRITTEN 10-05-83 00000700 C REVISED 00-00-00 ZZZ 00000800 CA 00000900 CA 00001000 CA CALL SPALGN (NO PARAMETERS) 00001100 CA 00001200 CA 00001300 CA THIS PREPARATION ROUTINE SCRUTINIZES USER INPUT DATA CARDS 00001400 CA FOR POSSIBLE ERRORS. IF NO ERRORS ARE FOUND, THE PARAMETERS 00001500 CA LISTED ON THE INPUT CARDS ARE USED TO DEVELOP PROCESSING 00001600 CA PARAMETERS FOR USE BY THIS PREPARATION ROUTINE'S 00001700 CA CORRESPONDING PROCESSOR. THESE PARAMETERS ARE STORED ON 00001800 CA DISK FOR ACCESS AT PROCESSING TIME. 00001900 CA 00002000 C EJECT 00002100 C 00002200 C LOCAL OR INTERNAL ARRAYS. 00002300 C 00002400 C CARD ( 20) = ARRAY TO HOLD 80-CHAR. CARD INPUT DATA I4 00002500 C CARD2 ( 20) = ARRAY TO HOLD 80-CHAR. CARD INPUT DATA I4 00002600 C DATTR ( 96) = ARRAY FOR ATTRIBUTES OF DATA I4 00002700 C DENTRY ( 104) = ARRAY FOR STORAGE OF LOCAL PARAMETERS I4 00002800 C 00002900 C LOCAL OR INTERNAL VARIABLES AND CONSTANTS. 00003000 C 00003100 C DAC = COUNTER FOR CARD READ SUBROUTINE I4 00003200 C DAP = COUNTER FOR PARAMETER READ & WRITE SUBROUTINES I4 00003300 C DA1 = COUNTER FOR CARD READ SUBROUTINE I4 00003400 C DCTYP = VARIABLE FOR TYPE OF PARAMETER CARD I4 00003500 C NOC = NUMBER OF CARDS READ I4 00003600 C NOPAR = NUMBER OF PARAMETERS I4 00003700 C NOREC = NUMBER OF RECORDS I4 00003800 C PMODE = PROCESSING MODE I4 00003900 C SPT = STARTING POINT I4 00004000 C EJECT 00004100 C-----------------------------------------------------------------------00004200 CA 00004300 CU PROCESS ALGN -- TRACE ALIGNMENT BY CROSS CORRELATION 00004400 CU DATA CARD (1) -- DEFINES PROCESSING MODE AND PARAMETERS 00004500 CU 00004600 CU NO. OF CARDS: REQUIRED = 1 ALLOWED = NO LIMIT 00004700 CU 00004800 CU REQ OR OPT00004900 CU DF COLS DEFINITION OR DEFAULT00005000 CU -- ----- ----------- -----------00005100 CU 1 1-4 'ALGN' | REQ |00005200 CU 2 -5 PROCESS NUMBER | 0 |00005300 CU 3 -6 NOT USED | |00005400 CU 4 -7 PROCESSING MODE |LINE CARD|00005500 CU 'S' = SHOT POINT MODE | |00005600 CU 'D' = DEPTH POINT MODE | |00005700 CU 'F' = FILE MODE | |00005710 CU 5 8-10 FOR PROGRAMMING USE | |00005800 CU 6 11-15 STARTING SHOT, DEPTH POINT, FILE | REQ |00005900 CU 7 16-20 ENDING SHOT, DEPTH POINT, FILE | DF6 |00006000 CU 8 21-25 EVENT TIME PARAMETER CARD ID (DF6,CARD(2)) | REQ |00006100 CU 9 26-30 LENGTH OF EVENT WINDOW TO BE ANALYZED (MS) | REQ |00006200 CU 10 31-35 MINIMUM RESIDUAL TIME (MS) | REQ |00006300 CU 11 36-40 MAXIMUM RESIDUAL TIME (MS) | REQ |00006400 CU 12 41-45 NOT USED | |00006500 CU 13 46-50 PRINT SWITCH: 1 FOR CORRELATION INFORMATION | 0 |00006600 CU 51-80 NOT USED | |00006700 CU -----------00006800 CU 00006900 CU DF NOTES 00007000 CU -- ----- 00007100 CU 00007200 CU 10- THESE TIMES ARE THE MAXIMUM ADVANCE/DELAY AFTER ALLOWING FOR 00007300 CU 11 THE TIME PICKS ON DATA CARD 2. MINIMUM TIME IS NORMALLY < 0; 00007400 CU MAXIMUM TIME IS NORMALLY > 0. 00007500 CU 00007600 CU EJECT 00007700 CU 00007800 CU DATA CARD (2) -- DEFINES EVENT TIME CONTROL POINTS 00007900 CU 00008000 CU NO. OF CARDS: REQUIRED = NONE ALLOWED = 100 PER ID 00008100 CU 00008200 CU REQ OR OPT00008300 CU DF COLS DEFINITION OR DEFAULT00008400 CU -- ----- ----------- -----------00008500 CU 1 1- 4 'ALGN' | REQ |00008600 CU 2 - 5 PROCESS NUMBER | 0 |00008700 CU 3 - 6 NOT USED | |00008800 CU 4 - 7 NOT USED | |00008900 CU 5 8-10 'CPT' | REQ |00009000 CU 6 11-15 ANALYSIS ID (DF8, CARD(1)) | REQ |00009100 CU 7 16-20 NOT USED | |00009200 CU 8 21-25 SHOT POINT, DEPTH POINT, FILE (1) | REQ |00009300 CU 9 26-30 TRACE NUMBER (1) | REQ |00009400 CU 10 31-35 WINDOW START TIME (MS) (1) | REQ |00009500 CU 11 36-40 BULK STATIC TO APPLY AT THIS TRACE (MS) (1) | 0 |00009600 CU 12 41-45 SHOT POINT, DEPTH POINT, FILE (2) | REQ |00009700 CU 13 46-50 TRACE NUMBER (2) | REQ |00009800 CU 14 51-55 WINDOW START TIME (MS) (2) | REQ |00009900 CU 15 56-60 BULK STATIC TO APPLY AT THIS TRACE (MS) (2) | 0 |00010000 CU 16 61-65 SHOT POINT, DEPTH POINT, FILE (3) | OPT |00010100 CU 17 66-70 TRACE NUMBER (3) | OPT |00010200 CU 18 71-75 WINDOW START TIME (MS) (3) | OPT |00010300 CU 19 76-80 BULK STATIC TO APPLY AT THIS TRACE (MS) (3) | 0 |00010400 CU -----------00010500 CU DF NOTES 00010600 CU -- ----- 00010700 CU 00010800 CU 5 NO DEFAULTS EXIST FOR THE PARAMETERS ON THIS CARD. 00010900 CU AT LEAST TWO CONTROL POINTS SHOULD BE GIVEN. 00011000 CU 00011100 CU 11 IF NONZERO, THE CONTROL TRACE IS SHIFTED BY THE SPECIFIED 00011200 CU AMOUNT RATHER THAN BY A STATIC CALCULATED BY THE PROGRAM. 00011300 CU DECIMAL VALUE IS OKAY. 00011400 C 00011500 C EJECT 00011600 C ===================================================================== 00011700 C FORMAT OF PARAMETER RECORDS 00011800 C 00011900 C ****** FIRST RECORD ****** PROCESSING RANGES, ETC. ****** 00012000 C ===================================================================== 00012100 C 00012200 C WORD 1 WORD 2 WORD 3 WORD 4 WORD 5 WORD 6 WORD 7 WORD 8 00012300 C |_______|________|_______|_______|_______|_______|_________|_______| 00012400 C | ALGN | PROCESS| PTS | BEGIN | END |# OF |N|D|NOT | SHOT | 00012500 C |_______|_NUMBER_|_______|_SHOT__|_SHOT__|__PARMS|_|_|USED_|_RANGE_| 00012600 C 00012700 C WORD 9 WORD 10 00012800 C |_______|________| 00012900 C | BEGIN | END | 00013000 C |_SHOT__|__SHOT__| 00013100 C . 00013200 C . 00013300 C . 00013400 C WORD 103 WORD 104 00013500 C |_______|________| 00013600 C | BEGIN | END | 00013700 C |_SHOT__|__SHOT__| 00013800 C 00013900 C ===================================================================== 00014000 C FORMAT OF PARAMETER RECORDS 00014100 C 00014200 C ****** SECOND RECORD ****** PROCESSING PARAMETERS ****** 00014300 C ===================================================================== 00014400 C 00014500 C WORD 1 WORD 2 WORD 3 WORD 4 WORD 5 WORD 6 WORD 7 WORD 8 00014600 C |_______|________|_______|_______|_______|_______|_________|_______| 00014700 C | ALGN | PROCESS| ANA | BEGIN | NOT |# OF |N|D|NOT | NOT | 00014800 C |_______|_NUMBER_|_______|_SHOT__|_USED__|__PARMS|_|_|USED_|_USED__| 00014900 C 00015000 C WORD 9 WORD 10 WORD 11 WORD 12 WORD 13 WORD 14 ....... WORD 31 00015100 C |_______|________|_______|_______|_______|_______| ....... |_______| 00015200 C | END | WINDOW | MIN | MAX | CORR |RESERVD| ....... |RESERVD| 00015300 C |_SHOT__|_LENGTH_|_TIME__|_TIME__|_COEFF_|_______| ....... |_______| 00015400 C 00015500 C WORD 32 ...... WORD 104 00015600 C |_______| ...... |_______| 00015700 C | NOT | ...... | NOT | 00015800 C |__USED_| ...... |__USED_| 00015900 C 00016000 C ===================================================================== 00016100 C FORMAT OF PARAMETER RECORDS 00016200 C 00016300 C ****** THIRD RECORD ****** CONTROL POINTS ********** 00016400 C ===================================================================== 00016500 C 00016600 C WORD 1 WORD 2 WORD 3 WORD 4 WORD 5 WORD 6 WORD 7 WORD 8 00016700 C |_______|________|_______|_______|_______|_______|_________|_______| 00016800 C | ALGN | PROCESS| CPT | START | NOT |# OF |N|D|NOT | NOT | 00016900 C |_______|_NUMBER_|_______|_SHOT__|_USED__|__PARMS|_|_|USED_|_USED__| 00017000 C 00017100 C WORD 9 WORD 10 WORD 11 WORD 12 00017200 C |_______|________|________|_______| 00017300 C | RECORD| TRACE |ANALYSIS| TRAVEL| 00017400 C |_NUMBER|_NUMBER_|__START_|__TIME_| 00017500 C . . . . . 00017600 C . . . . . 00017700 C . . . . . 00017800 C WORD 101 WORD 102 WORD 103 WORD 104 00017900 C |_______|________|________|_______| 00018000 C | RECORD| TRACE |ANALYSIS| TRAVEL| 00018100 C |_NUMBER|_NUMBER_|__START_|__TIME_| 00018200 C 00018300 C ==================================================================== 00018400 C 00018500 SUBROUTINE SPALGN 00018600 C 00018700 IMPLICIT INTEGER (A-Z) 00018800 C 00018900 C COMMON /P/ STATEMENTS GENERATED BY UTCGI4 12/08/83 00019200 COMMON /P/ STARTP 00019210 REAL *8 STARTP 00019220 COMMON /P/ LCNAME 00019230 COMMON /P/ LC5 00019240 COMMON /P/ LCINT 00019250 COMMON /P/ LCTYP , M00020 00019260 COMMON /P/ LCBGSP 00019270 COMMON /P/ LCENSP , M00032( 2) 00019280 COMMON /P/ LCNSP 00019290 COMMON /P/ LCTPSP 00019300 COMMON /P/ LCRL 00019310 COMMON /P/ LCSI 00019320 COMMON /P/ LCPI 00019330 COMMON /P/ LCGRPI 00019340 COMMON /P/ LCMXFD , M00068( 2) 00019350 COMMON /P/ LCDRYF , M00080( 3) 00019360 COMMON /P/ ACNAME 00019370 COMMON /P/ AC0506 , M00100 00019380 COMMON /P/ ACOPCD 00019390 COMMON /P/ ACQCF 00019400 COMMON /P/ ACDIST 00019410 COMMON /P/ ACPROJ 00019420 COMMON /P/ ACLNAM ( 5) 00019430 COMMON /P/ ACCOM ( 8) , M00144 00019440 COMMON /P/ ACTYPE 00019450 COMMON /P/ ACNSP 00019460 COMMON /P/ ACUSER ( 5) , M00188( 12) 00019470 COMMON /P/ LHJBNO 00019480 COMMON /P/ LHLNO 00019490 COMMON /P/ LHRLNO 00019500 COMMON /P/ LHTPSP 00019510 COMMON /P/ LHATSP 00019520 COMMON /P/ LHSI 00019530 COMMON /P/ LHORSI 00019540 COMMON /P/ LHST 00019550 COMMON /P/ LHORST 00019560 COMMON /P/ LHDFCD 00019570 COMMON /P/ LHEXFD 00019580 COMMON /P/ LHTSCD 00019590 COMMON /P/ LHVSCD 00019600 COMMON /P/ LHSWFS 00019610 COMMON /P/ LHSWFE 00019620 COMMON /P/ LHSWL 00019630 COMMON /P/ LHSWCD 00019640 COMMON /P/ LHTSNO 00019650 COMMON /P/ LHSWTS 00019660 COMMON /P/ LHSWTE 00019670 COMMON /P/ LHSWTT 00019680 COMMON /P/ LHTCF 00019690 COMMON /P/ LHBGRF 00019700 COMMON /P/ LHARCD 00019710 COMMON /P/ LHMS 00019720 COMMON /P/ LHSGPL 00019730 COMMON /P/ LHVPCD 00019740 COMMON /P/ LHNSP 00019750 COMMON /P/ LHNDP 00019760 COMMON /P/ LHNSL 00019770 COMMON /P/ LHMTPR , M00376( 9) 00019780 COMMON /P/ KPNA 00019790 COMMON /P/ KPRNO , M00420 00019800 COMMON /P/ KPA 00019810 COMMON /P/ KPDBGS 00019820 COMMON /P/ KPDBGA 00019830 COMMON /P/ KPDBGN 00019840 COMMON /P/ KPWRKS 00019850 COMMON /P/ KPWRKD , M00448( 4) 00019860 COMMON /P/ KPFCF 00019870 COMMON /P/ KPIRSM 00019880 COMMON /P/ KPNRSM 00019890 COMMON /P/ KPIUSM 00019900 COMMON /P/ KPNUSM 00019910 COMMON /P/ KPTIME 00019920 COMMON /P/ KPRTF 00019930 COMMON /P/ KPDRTF 00019940 COMMON /P/ KPMOTF 00019950 COMMON /P/ KPNBR 00019960 COMMON /P/ KPIBN 00019970 COMMON /P/ KPITSV 00019980 COMMON /P/ KPTAMF 00019990 COMMON /P/ KPLOTF 00020000 COMMON /P/ KPMITF 00020010 COMMON /P/ KPPRNT 00020020 COMMON /P/ KPPLOT 00020030 COMMON /P/ KPPLTA 00020040 COMMON /P/ KPBUGF , M00540( 226) 00020050 COMMON /P/ ENDP 00020060 C 00020070 C=================================================================== 00020080 C 00020090 C REAL ARRAYS--LOCAL 00020100 REAL ATTR (96) 00020110 REAL FLOAT 00020120 C 00020130 C=================================================================== 00020140 C 00020150 C INTEGER ARRAYS--LOCAL 00020160 INTEGER CARD (20) 00020170 INTEGER CARD2 (20) 00020180 INTEGER DATTR (96) /96 * 0/ 00020190 INTEGER DENTRY (104) 00020200 C 00020210 EQUIVALENCE (DCTYP ,DENTRY (03)) 00020220 EQUIVALENCE (SPT ,DENTRY (04)) 00020230 EQUIVALENCE (EXTRA ,DENTRY (05)) 00020240 EQUIVALENCE (NOPAR ,DENTRY (06)) 00020250 EQUIVALENCE (PMODE ,DENTRY (07)) 00020260 EQUIVALENCE (SPLOCN ,DENTRY (08)) 00020270 EQUIVALENCE (DATTR(1) ,DENTRY (09)) 00020280 C 00020290 EQUIVALENCE (DATTR(1) ,ATTR (01)) 00020300 C 00020310 C================================================================= 00020320 C 00020330 C INTEGER VARIABLES--LOCAL 00020340 INTEGER ANA /'ANA '/ 00020350 INTEGER BLANK /' '/ 00020360 INTEGER CPT /'CPT '/ 00020370 INTEGER PTS /'PTS '/ 00020380 C 00020390 C =========================================================== 00020400 C INTIALIZATION AREA 00020410 C =========================================================== 00020420 C 00020430 DAC = 1 00020440 DAP = 1 00020450 IPR = KPPRNT 00020460 C PRINT HEADING 00020470 CALL USPHD (1,ACLNAM,KPNA,KPRNO,0,0,IPR) 00020480 C 00020490 DENTRY(1) = KPNA 00020500 DENTRY(2) = KPRNO 00020510 NOREC = 0 00020520 NOC = 0 00020530 NOPAR = 0 00020540 C 00020550 C SET THE PROCESSING MODE TO 'S' OR 'D' 00020560 C 00020570 CALL FORC(KPNA,KPRNO,DAC,CARD, * 380 )00020580 DAC = 1 00020590 IF(S1CPCH(CARD,7,' ',1,1).NE.0) GO TO 10 00020600 CALL S1MVCH(LCTYP,1,CARD,7,1) 00020610 C 00020620 C SET INTERPOLATION TYPE 00020630 C 00020640 10 CALL S1MVCH('N',1,CARD,6,1) 00020650 C 00020660 CALL S1MVCH(CARD,6,PMODE,1,4) 00020670 C 00020680 DO 20 L = 1 , 96 00020690 20 DATTR (L) = 0 00020700 C 00020710 DCTYP = PTS 00020720 K = 0 00020730 SPLOCN = 0 00020740 C 00020750 C =============================================================== 00020760 C RETRIEVE PROCESSING RANGES. 00020770 C =============================================================== 00020780 C 00020790 30 CALL FORC (KPNA, KPRNO, DAC, CARD, * 60 )00020800 NOC = NOC + 1 00020810 C 00020820 IF (S1CPCH(CARD,8,' ',1,3).NE.0) GO TO 30 00020830 C 00020840 R1 = S1CVBN (CARD,11,5) 00020850 IF (R1.EQ.0) GO TO 350 00020860 R2 = S1CVBN (CARD,16,5) 00020870 IF (R2.EQ.0) R2 = R1 00020880 C 00020890 IF (K.EQ.0) GO TO 50 00020900 C 00020910 C CHECK FOR OVERLAP OF RANGES 00020920 C 00020930 CALL USOVLP (DATTR(K-1), DATTR(K), R1, R2, IPR, CARD, * 360 )00020940 C 00020950 IF (K.NE.96) GO TO 50 00020960 NOPAR = K 00020970 CALL FOWP (KPNA, KPRNO, DAP, 104, DENTRY, * 340 )00020980 NOREC = NOREC + 1 00020990 C 00021000 DO 40 L=3,96 00021010 40 DATTR(L)=0 00021020 C 00021030 K = 0 00021040 SPLOCN = 0 00021050 C 00021060 50 DATTR(K+1) = R1 00021070 DATTR(K+2) = R2 00021080 K = K + 2 00021090 C 00021100 N = IABS(R2-R1)+1 00021110 SPLOCN = MAX0(SPLOCN, N) 00021120 C 00021130 GO TO 30 00021140 C 00021150 60 IF (NOC.EQ.0) GO TO 380 00021160 C 00021170 C WRITE LAST PROCESSING RANGE RECORD 00021180 C 00021190 NOPAR = K 00021200 CALL FOWP (KPNA, KPRNO, DAP, 104, DENTRY, * 340 )00021210 NOREC = NOREC + 1 00021220 C 00021230 DO 70 L=1,96 00021240 70 DATTR(L)=0 00021250 C 00021260 C ================================================================ 00021270 C NOW REREAD THE CARDS AND WRITE THE PARAMETER RECORDS 00021280 C ================================================================ 00021290 C 00021300 NOC = 0 00021310 DAC = 1 00021320 C 00021330 90 CALL FORC (KPNA, KPRNO, DAC, CARD, * 290 )00021340 IF (S1CPCH(CARD,8,' ',1,3).NE.0) GO TO 90 00021350 C 00021360 NOC = NOC + 1 00021370 DCTYP = ANA 00021380 C 00021390 C PROCESSING RANGES 00021400 C 00021410 SPT = S1CVBN(CARD,11,5) 00021420 EPT = S1CVBN(CARD,16,5) 00021430 IF (EPT .EQ. 0) EPT = SPT 00021440 DATTR(1) = EPT 00021450 C 00021460 C EVENT TIME ID 00021470 C 00021480 DF = 8 00021490 IF (S1CPCH(CARD,21,BLANK,1,5) .EQ. 0) GO TO 450 00021500 C 00021510 C WINDOW LENGTH 00021520 C 00021530 DF = 9 00021540 DATTR(02) = S1CVBN(CARD,26,5) 00021550 IF (DATTR(2) .EQ. 0) GO TO 450 00021560 C 00021570 C MIN, MAX RESIDUAL TIMES 00021580 C 00021590 DF = 10 00021600 DATTR(03) = S1CVBN(CARD,31,5) 00021610 IF (DATTR(3) .EQ. 0) GO TO 450 00021620 C 00021630 DF = 11 00021640 DATTR(04) = S1CVBN(CARD,36,5) 00021650 IF (DATTR(4) .EQ. 0) DATTR(4) = DATTR(3) 00021660 C 00021670 C MINIMUM CORRELATION COEFFICIENT 00021680 C 00021690 CALL USCHFT (CARD,41,5,ATTR(5)) 00021700 IF (S1CPCH(CARD,42,BLANK,1,4).EQ.0) ATTR(5)=0.5 00021710 C 00021720 C PRINT SWITCH 00021730 C 00021740 DATTR(21) = S1CVBN( CARD, 46, 5 ) 00021750 C 00021760 C WRITE PARAMETER RECORD 00021770 C 00021780 NOPAR = 23 00021790 CALL FOWP (KPNA, KPRNO, DAP, 104, DENTRY, * 340 )00021800 C 00021810 C ================================================================= 00021820 C GET EVENT TIME CONTROL POINTS 00021830 C ================================================================= 00021840 C 00021850 FOUND = 0 00021860 NOPAR = 0 00021870 INDX = 0 00021880 ICPT = 0 00021890 DCTYP = CPT 00021900 DA1 = 1 00021910 C 00021920 170 CALL FORC (KPNA, KPRNO, DA1, CARD2, * 200 )00021930 IF(S1CPCH(CARD2, 8, CPT ,1,3).NE.0) GO TO 170 00021940 C 00021950 C CHECK FOR ID 00021960 C 00021970 DF = 6 00021980 IF ( S1CPCH(CARD2,12,BLANK,1,4).EQ.0 ) GO TO 410 00021990 IF ( S1CPCH(CARD,21,CARD2,11,5).NE.0 ) GO TO 170 00022000 C 00022010 FOUND = 1 00022020 IX = 21 00022030 C 00022040 DO 180 I = 1, 3 00022050 C 00022060 IF(S1CPCH(CARD2,IX+1,BLANK,1,4).EQ.0) GO TO 200 00022070 C 00022080 C RECORD NUMBER 00022090 C 00022100 INDX = INDX + 1 00022110 DATTR(INDX) = S1CVBN (CARD2,IX , 5 ) 00022120 IX = IX + 5 00022130 C 00022140 C TRACE NUMBER 00022150 C 00022160 INDX = INDX + 1 00022170 DATTR(INDX) = S1CVBN (CARD2,IX , 5 ) 00022180 IX = IX + 5 00022190 C 00022200 C WINDOW START TIME 00022210 00022220 INDX = INDX + 1 00022230 DATTR(INDX) = S1CVBN (CARD2,IX , 5 ) 00022240 IX = IX + 5 00022250 C 00022260 C EVENT TIME 00022270 C 00022280 INDX = INDX + 1 00022290 CALL USCHFT ( CARD2, IX, 5, ATTR(INDX) ) 00022300 IX = IX + 5 00022310 C 00022320 ICPT = ICPT + 1 00022330 C 00022340 180 CONTINUE 00022350 C 00022360 IF (ICPT .GT. 300) GO TO 420 00022370 IF (INDX .LT. 96) GO TO 170 00022380 C 00022390 NOPAR = INDX 00022400 CALL FOWP (KPNA, KPRNO, DAP, 104, DENTRY, * 340 )00022410 NOREC = NOREC + 1 00022420 INDX = 0 00022430 C 00022440 DO 190 L = 1,96 00022450 190 DATTR(L) = 0 00022460 C 00022470 GO TO 170 00022480 C 00022490 200 IF (FOUND .EQ. 0) GO TO 440 00022500 C 00022510 C WRITE PARAMETER RECORD 00022520 C 00022530 IF (INDX.LE.0) GO TO 90 00022540 C 00022550 NOPAR = INDX 00022560 CALL FOWP (KPNA, KPRNO, DAP, 104, DENTRY, * 340 )00022570 NOREC = NOREC + 1 00022580 C 00022590 DO 220 L = 1,96 00022600 220 DATTR(L) = 0 00022610 C 00022620 GO TO 90 00022630 C 00022640 C =============================================================== 00022650 C END OF PARAMETER INTERPRETATION - CHECK FOR ERRORS 00022660 C =============================================================== 00022670 C 00022680 290 IF (KPRTF .LT. 0) GO TO 1000 00022690 C 00022700 IF (KPBUGF .EQ. 0) GO TO 310 00022710 C 00022720 DAP = 1 00022730 C 00022740 300 CALL FORP (KPNA, KPRNO, DAP, 104, DENTRY, * 310 )00022750 WRITE (IPR, 9010 ) DENTRY 00022760 GO TO 300 00022770 C 00022780 C =============================================================== 00022790 C LIST PARAMETERS THAT WILL BE USED 00022800 C =============================================================== 00022810 C 00022820 310 DAP = 1 00022830 C 00022840 315 CALL FORP (KPNA, KPRNO, DAP, 104, DENTRY, * 325 )00022850 IF (DCTYP .NE. ANA) GO TO 315 00022860 SPTC = SPT 00022870 C 00022880 C CHECK FOR RANGE HEADING 00022890 C 00022900 IF (S1CPCH(PMODE,2,'S',1,1) .EQ. 0)WRITE (IPR, 9120 )SPT,DATTR(1) 00022910 IF (S1CPCH(PMODE,2,'D',1,1) .EQ. 0)WRITE (IPR, 9130 )SPT,DATTR(1) 00022920 IF (S1CPCH(PMODE,2,'F',1,1) .EQ. 0)WRITE (IPR, 9140 )SPT,DATTR(1) 00022930 WRITE(KPPRNT,9220) DATTR(2) 00022940 WRITE(KPPRNT,9230) DATTR(3) 00022950 WRITE(KPPRNT,9240) DATTR(4) 00022960 C WRITE(KPPRNT,9250) DATTR(5) 00022970 IF (DATTR(21) .NE. 0) WRITE (KPPRNT, 9260 ) 00022980 C 00022990 C DUMP CONTROL POINTS THIS RANGE 00023000 C 00023010 DAP2 = DAP 00023020 PRNT = 0 00023030 C 00023040 316 CALL FORP (KPNA, KPRNO,DAP2, 104, DENTRY, * 315 )00023050 IF (DCTYP .NE. CPT) GO TO 316 00023060 IF (SPTC.NE.SPT) GO TO 316 00023070 C 00023080 IF (PRNT.EQ.0) WRITE (IPR, 9440) 00023090 PRNT = 1 00023100 C 00023110 N = NOPAR/4 00023120 J = 0 00023130 C 00023140 DO 317 I = 1,N 00023150 C WRITE (IPR, 9450) DATTR(J+1),DATTR(J+2),DATTR(J+3),ATTR(J+4) 00023160 WRITE (IPR, 9450) DATTR(J+1),DATTR(J+2),DATTR(J+3) 00023170 317 J = J+ 4 00023180 C 00023190 GO TO 316 00023200 C 00023210 C PRINT THE TOTAL NUMBER OF RECORDS WRITTEN 00023220 C 00023230 325 WRITE (IPR, 9020 ) KPNA, KPRNO, NOREC 00023240 C 00023250 GO TO 1000 00023260 C 00023270 C =============================================================== 00023280 C MESSAGES, ERROR CONDITIONS, ETC. 00023290 C =============================================================== 00023300 C 00023310 340 WRITE (IPR, 9030 ) 00023320 GO TO 400 00023330 C 00023340 350 WRITE (IPR, 9040 ) CARD 00023350 C 00023360 360 KPRTF=-1 00023370 GO TO 30 00023380 C 00023390 380 WRITE (IPR, 9050 ) 00023400 GO TO 400 00023410 C 00023420 400 KPRTF = -1 00023430 GO TO 290 00023440 C 00023450 410 WRITE (IPR, 9070 ) CARD2 00023460 GO TO 460 00023470 C 00023480 420 WRITE (IPR, 9080 ) 00023490 GO TO 460 00023500 C 00023510 440 ID = S1CVBN( CARD, 21, 5 ) 00023520 WRITE (IPR, 9100 ) ID 00023530 GO TO 460 00023540 C 00023550 450 WRITE (IPR, 9110 ) DF 00023560 GO TO 460 00023570 C 00023580 460 KPRTF=-1 00023590 GO TO 90 00023600 C 00023610 C PROGRAM RETURN 00023620 C 00023630 1000 RETURN 00023640 C 00023650 C FORMAT STATEMENTS USED IN ALGN 00023660 C 00023670 9010 FORMAT (1X,A4,I1,5X,A4,3I5,1X,A4,I5/4(1X,24I5/)) 00023680 C 00023690 9020 FORMAT ('0*** ',A4,I1,' COMPLETED -- NO ERRORS,', 00023700 * /' *** TOTAL NUMBER OF PARAMETER RECORDS = ',I5) 00023710 C 00023720 9030 FORMAT ('0*** FOWP HAD A WRITE ERROR ***') 00023730 C 00023740 9040 FORMAT ('0*** NO PROCESSING MODE RANGE PRESENT ***'/10X,20A4) 00023750 C 00023760 9050 FORMAT ('0*** NO DATA CARD FOR ALGN ***'/) 00023770 C 00023780 9070 FORMAT ('0*** NO ANALYSIS ID SPECIFIED ***'/5X,20A4) 00023790 C 00023800 9080 FORMAT ('0*** MAXIMUM OF 100 CPT CARDS PER ID EXCEEDED ***') 00023810 C 00023820 9100 FORMAT ('0*** NO CPT CARD FOUND FOR ID ',I5,'***') 00023830 C 00023840 9110 FORMAT ('0*** DF ',I2,' REQUIRED BUT MISSING ON "ANA" CARD') 00023850 C 00023860 9120 FORMAT ('0 FROM SHOTPOINT ', I5, ' TO SHOTPOINT ', I5 ) 00023870 C 00023880 9130 FORMAT ('0 FROM DEPTHPOINT ', I5, ' TO DEPTHPOINT ', I5 ) 00023890 C 00023900 9140 FORMAT ('0 FROM FILE NUMBER', I5, ' TO FILE NUMBER', I5 ) 00023910 C 00023920 9220 FORMAT ('0 ANALYSIS WINDOW LENGTH = ',I7, ' MS')00023930 C 00023940 9230 FORMAT (' MINIMUM RESIDUAL TRAVELTIME = ',I7, ' MS')00023950 C 00023960 9240 FORMAT (' MAXIMUM RESIDUAL TRAVELTIME = ',I7, ' MS')00023970 C 00023980 9250 FORMAT (' MINIMUM CORRELATION COEFFICIENT = ',F7.3 )00023990 C 00024000 9260 FORMAT (' PRINT CORRELATION INFORMATION' )00024010 C 00024020 9440 FORMAT ('0 CONTROL POINTS : ')00024030 C 00024040 9450 FORMAT (' ', 3I8, F12.2 )00024050 C 00024060 END 00024070