CTITLE SARZAPP -- REFRACTION TIME PICK ELIMINATION BASED ON CANCELLATION C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA CA AUTHOR J.V.S. HARVEY CA LANGUAGE VS FORTRAN (77) CA REWRITTEN 29 MAR 1988 CA CA CA THIS SUBROUTINE KILLS THOSE PICKS WHERE ONE OR MORE CANCELLATION CA ERRORS EXCEED A USER-DEFINED THRESHHOLD. CA CA CA CALL SARZAPP( IPR, MXRECP, MXBULL, BWIDTH, MXRAYC, CA NSHOT, SHOTID, SHOTNO, CA NRECV, RECVID, ORTNSR, CA NCDPN, NCDPT, CDPREF, CA NUMHRZ, IOCREF, CA LCTPSP, FBREAK, RTIMES ) CA CA CA IN/OUT ARGUMENT TYPE DESCRIPTION CA CA IN IPR I4 PRINTER UNIT NUMBER CA CA IN MXRECP I4 MAXIMUM ALLOWABLE RECIPROCAL CANCELLATION ERROR CA IN MXBULL I4 MAXIMUM ALLOWABLE "BULL'S-EYE" CANCELLATION ERROR CA IN BWIDTH I4 "BULL'S-EYE" CANCELLATION WIDTH (SHOT INTERVALS) CA IN MXRAYC I4 MAXIMUM ALLOWABLE RAYPATH CANCELLATION ERROR CA CA IN NSHOT I4 NUMBER OF SHOTPOINTS PICKED CA IN SHOTID R4 SHOTPOINT IDENTIFICATION ARRAY CA (1,I) = X COORDINATE (IN-LINE) CA IN UNITS OF GRID-POINT POSITION CA (2,I) = Y COORDINATE (CROSS-LINE) CA IN UNITS OF GRID-POINT POSITION CA (3,I) = SURFACE ELEVATION CA IN ORIGINAL UNITS CA (4,I) = RECIPROCAL RECEIVER NUMBER CA AS INDEX PLUS FRAC. DISTANCE CA (5,I) = EQUIVALENT CDPN LOCATION CA AS INDEX PLUS FRAC. DISTANCE CA ( 2-D ARRAY DIMENSIONED: 5 BY NSHOT ) CA IN SHOTNO I2 PICKED SHOTPOINT NUMBER LIST CA ( 1-D ARRAY DIMENSIONED: NSHOTP ) CA CA IN NRECV I4 NUMBER OF RECEIVERS CA IN RECVID R4 RECEIVER IDENTIFICATION ARRAY CA (1,I) = X COORDINATE (IN-LINE) CA IN UNITS OF GRID-POINT POSITION CA (2,I) = Y COORDINATE (CROSS-LINE) CA IN UNITS OF GRID-POINT POSITION CA (3,I) = SURFACE ELEVATION CA IN ORIGINAL UNITS CA (4,I) = RECIPROCAL SHOT LOCATION NUMBER CA AS INDEX PLUS FRAC. DISTANCE CA (5,I) = EQUIVALENT CDPN LOCATION CA AS INDEX PLUS FRAC. DISTANCE CA ( 2-D ARRAY DIMENSIONED: 5 BY NRECV ) CA IN ORTNSR I2 TRACE-RECEIVER CROSS-REFERENCE CA ORTNSR(I,J) = TRACE NUMBER (ORTN) CA OF SHOT I AT REC J CA = 0 IF OUT OF RANGE CA ( 2-D ARRAY DIMENSIONED: NSHOT BY NRECV ) CA CA IN NCDPN I4 NUMBER OF CDPN LOCATIONS CA IN NCDPT I4 MAX. NUMBER OF TRACES PER CDPN SIDE CA IN CDPREF I2 CDP-TO-SHOT CROSS-REFERENCE INDICES CA (1,SIDE,CDPT,CDPN) = SHOT INDEX CA (2,SIDE,CDPT,CDPN) = RECEIVER INDEX CA (3,SIDE,CDPT,CDPN) = ORTN (TRACE) CA ( 4-D ARRAY DIMENSIONED: 3 BY 2 BY NCDPT BY NCDPN ) CA CA IN NUMHRZ I4 NUMBER OF HORIZONS IN ANALYSIS CA IN/OUT IOCREF I2 REFERENCE CDPT LOCATIONS FOR INWARD AND CA OUTWARD CANCELLATION CA (1,SIDE,HORIZ,CDPN) = INWARD REFERENCE CA FIRST BREAKS ONLY CA (DEFAULTS TO -999) CA (2,SIDE,HORIZ,CDPN) = OUTWARD REFERENCE CA FIRST BREAKS ONLY CA (DEFAULTS TO -999) CA (3,SIDE,HORIZ,CDPN) = OUTWARD REFERENCE CA INCLUDING PHANTOMS CA (DEFAULTS TO -999) CA ( 4-D ARRAY DIMENSIONED: 3 BY 2 BY NUMHRZ BY NCDPN ) CA CA IN LCTPSP I4 NUMBER OF TRACES PER SHOT CA CA IN/OUT FBREAK I2 FIRST-BREAK HORIZONS (OLD AND NEW) CA (ORTN,SHOT,1) = OLD (PICK FILE) CA (ORTN,SHOT,2) = NEW (REMAPPED) CA CA THE FOLLOWING CONVENTIONS ARE USED: CA 1-8 = HORIZON CODE FOR VALID PICK CA 99 MISSING PICK OR KILLED BY "HCH" CA CA 101-108 HORIZON CODE PLUS 100 FOR CA "FBN" KILLED PICK CA 201-208 HORIZON CODE PLUS 200 FOR CA "MXRECP/MXBULL" KILLED PICK CA 301-308 HORIZON CODE PLUS 300 FOR CA "MXRAYC" KILLED PICK CA ( 3-D ARRAY DIMENSIONED: LCTPSP BY NSHOT BY 2 ) CA CA IN/OUT RTIMES R4 REFRACTION TIMES IN SECONDS CA SIGN INDICATES SOURCE: CA POSITIVE FOR ORIGINAL PICK CA ZERO FOR MISSING PICK CA NEGATIVE FOR PHANTOMED PICK CA ABSOLUTE VALUE GIVES PROPER TIME CA ( 3-D ARRAY DIMENSIONED: LCTPSP BY NSHOT BY NUMHRZ ) CA CAEND C*********************************************************************** C C SUBROUTINES CALLED: SARBULL -- BULL'S-EYE CANCELLATION ERROR C SARCANC -- RAYPATH CANCELLATION ERROR C SARRERR -- RECIPROCAL TIME ERROR C C*********************************************************************** C SUBROUTINE SARZAPP( IPR, MXRECP, MXBULL, BWIDTH, MXRAYC, * NSHOT, SHOTID, SHOTNO, * NRECV, RECVID, ORTNSR, * NCDPN, NCDPT, CDPREF, * NUMHRZ, IOCREF, * LCTPSP, FBREAK, RTIMES ) IMPLICIT INTEGER (A-Z) C REAL SHOTID(5,NSHOT) INTEGER*2 SHOTNO(NSHOT) REAL RECVID(5,NRECV) INTEGER*2 ORTNSR(NSHOT,NRECV) INTEGER*2 CDPREF(3,2,NCDPT,NCDPN) C INTEGER*2 IOCREF(3,2,NUMHRZ,NCDPN) INTEGER*2 FBREAK(LCTPSP,NSHOT,2) REAL RTIMES(LCTPSP,NSHOT,NUMHRZ) C---------------------------------------------------------------------- C C REAL VARIABLES -- LOCAL C REAL EBMAX, EB REAL ERMAX, ER REAL ECMAX, EI, EO REAL TIME C C REAL FUNCTIONS C REAL SARRERR, SARBULL, SARCANC C C*********************************************************************** C*** **** C*** LOCATION OF EXCESSIVE INDIVIDUAL TIME ERRORS **** C*** **** C*********************************************************************** C ERMAX = MXRECP*0.001 EBMAX = MXBULL*0.001 KFLAG = 0 C DO 275 SIDE = 1, 2 DO 275 CDPN = 1, NCDPN DO 275 CURHRZ = 1, NUMHRZ CDPTI = IOCREF(1,SIDE,CURHRZ,CDPN) CDPTO = IOCREF(2,SIDE,CURHRZ,CDPN) C IF( 0 .LT. CDPTO .AND. CDPTO .LE. CDPTI ) THEN DO 250 CDPT = CDPTO, CDPTI SHOTA = CDPREF(1,SIDE,CDPT,CDPN) RECVZ = CDPREF(2,SIDE,CDPT,CDPN) ORTNAZ = CDPREF(3,SIDE,CDPT,CDPN) C IF( SHOTA .GT. 0 .AND. RECVZ .GT. 0 * .AND. ORTNAZ .GT. 0 ) THEN TIME = RTIMES(ORTNAZ,SHOTA,CURHRZ) C IF( TIME .GT. 0.0 ) THEN ER = 0.0 EB = 0.0 C ------------------------------------------- C C RECIPROCAL TIME ERROR C IF( MXRECP .GT. 0 ) THEN ER = SARRERR( 'FBRK', CURHRZ, * SHOTA, RECVZ, ORTNAZ, * NUMHRZ, NSHOT, NRECV, LCTPSP, * SHOTID, RECVID, ORTNSR, * FBREAK, RTIMES ) EB = ER ENDIF C ------------------------------------------- C C BULL'S-EYE CANCELLATION ERROR C IF( MXBULL .GT. 0 ) THEN EB = SARBULL( BWIDTH, CURHRZ, * SHOTA, RECVZ, ORTNAZ, * NSHOT, SHOTID, * NRECV, RECVID, ORTNSR, * LCTPSP, FBREAK, NUMHRZ, * RTIMES ) C IF( MXRECP .LE. 0 ) ER = EB ENDIF C ------------------------------------------- C C TARGETED PICKS C IF( ER .GT. ERMAX .AND. EB .GT. EBMAX ) THEN KFLAG = 1 OLDHRZ = FBREAK(ORTNAZ,SHOTA,1) C FBREAK(ORTNAZ,SHOTA,1) = OLDHRZ + 200 ENDIF ENDIF ENDIF 250 CONTINUE ENDIF 275 CONTINUE C C*********************************************************************** C*** **** C*** LOCATION OF EXCESSIVE RAYPATH CANCELLATION ERRORS **** C*** **** C*********************************************************************** C CKFLAG = 0 C IF( MXRAYC .GT. 0 ) THEN ECMAX = MXRAYC*0.001 C DO 375 SIDE = 1, 2 DO 375 CDPN = 1, NCDPN DO 375 CURHRZ = 1, NUMHRZ CDPTI = IOCREF(1,SIDE,CURHRZ,CDPN) CDPTO = IOCREF(2,SIDE,CURHRZ,CDPN) C CDPT1 = CDPTO + 1 CDPT2 = CDPTI - 1 C IF( 0 .LT. CDPT1 .AND. CDPT1 .LE. CDPT2 ) THEN SHOTI = CDPREF(1,SIDE,CDPTI,CDPN) RECVI = CDPREF(2,SIDE,CDPTI,CDPN) ORTNI = CDPREF(3,SIDE,CDPTI,CDPN) C SHOTO = CDPREF(1,SIDE,CDPTO,CDPN) RECVO = CDPREF(2,SIDE,CDPTO,CDPN) ORTNO = CDPREF(3,SIDE,CDPTO,CDPN) C INWHRZ = FBREAK(ORTNI,SHOTI,2) OUTHRZ = FBREAK(ORTNO,SHOTO,2) C DO 350 CDPT = CDPT1, CDPT2 SHOTA = CDPREF(1,SIDE,CDPT,CDPN) RECVZ = CDPREF(2,SIDE,CDPT,CDPN) ORTNAZ = CDPREF(3,SIDE,CDPT,CDPN) C NEWHRZ = FBREAK(ORTNAZ,SHOTA,2) C EI = SARCANC( CURHRZ, SIDE, CDPN, * CDPT, CDPTI, * NSHOT, NRECV, LCTPSP, * NUMHRZ, NCDPN, NCDPT, * CDPREF, ORTNSR, RTIMES ) C IF( EI .GT. ECMAX ) THEN CKFLAG = 1 C IF( NEWHRZ .LT. 99 ) THEN NEWHRZ = NEWHRZ + 300 FBREAK(ORTNAZ,SHOTA,2) = NEWHRZ ENDIF C IF( INWHRZ .LT. 99 ) THEN INWHRZ = INWHRZ + 300 FBREAK(ORTNI,SHOTI,2) = INWHRZ ENDIF C ORTNAI = ORTNSR(SHOTA,RECVI) HRZAI = FBREAK(ORTNAI,SHOTA,2) C IF( HRZAI .LT. 99 ) THEN FBREAK(ORTNAI,SHOTA,2) = HRZAI + 300 ENDIF C ORTNIZ = ORTNSR(SHOTI,RECVZ) HRZIZ = FBREAK(ORTNIZ,SHOTI,2) C IF( HRZIZ .LT. 99 ) THEN FBREAK(ORTNIZ,SHOTI,2) = HRZIZ + 300 ENDIF ENDIF C EO = SARCANC( CURHRZ, SIDE, CDPN, * CDPT, CDPTO, * NSHOT, NRECV, LCTPSP, * NUMHRZ, NCDPN, NCDPT, * CDPREF, ORTNSR, RTIMES ) C IF( EO .GT. ECMAX ) THEN CKFLAG = 1 C IF( NEWHRZ .LT. 99 ) THEN NEWHRZ = NEWHRZ + 300 FBREAK(ORTNAZ,SHOTA,2) = NEWHRZ ENDIF C IF( OUTHRZ .LT. 99 ) THEN OUTHRZ = OUTHRZ + 300 FBREAK(ORTNO,SHOTO,2) = OUTHRZ ENDIF C ORTNAO = ORTNSR(SHOTA,RECVO) HRZAO = FBREAK(ORTNAO,SHOTA,2) C IF( HRZAO .LT. 99 ) THEN FBREAK(ORTNAO,SHOTA,2) = HRZAO + 300 ENDIF C ORTNOZ = ORTNSR(SHOTO,RECVZ) HRZOZ = FBREAK(ORTNOZ,SHOTO,2) C IF( HRZOZ .LT. 99 ) THEN FBREAK(ORTNOZ,SHOTO,2) = HRZOZ + 300 ENDIF ENDIF 350 CONTINUE ENDIF 375 CONTINUE ENDIF C C*********************************************************************** C*** **** C*** DIAGNOSTIC PRINTOUT **** C*** **** C*********************************************************************** C WRITE( IPR, 8000 ) C ------------------------------------------- C C CASE A: SIMPLE TIME-ERROR KILL C IF( KFLAG .EQ. 1 ) THEN WRITE( IPR, 8100 ) C DO 425 SHOTA = 1, NSHOT DO 425 ORTNAZ = 1, LCTPSP OLDHRZ = FBREAK(ORTNAZ,SHOTA,1) C IF( OLDHRZ .GT. 200 ) THEN NEWHRZ = FBREAK(ORTNAZ,SHOTA,2) IF( NEWHRZ .GT. 300 ) NEWHRZ = NEWHRZ - 300 C WRITE( IPR, 8105 ) SHOTNO(SHOTA), ORTNAZ, NEWHRZ ENDIF 425 CONTINUE ENDIF C ------------------------------------------- C C CASE B: RAYPATH CANCELLATION KILL C IF( CKFLAG .EQ. 1 ) THEN WRITE( IPR, 8200 ) C DO 450 SHOTA = 1, NSHOT DO 450 ORTNAZ = 1, LCTPSP NEWHRZ = FBREAK(ORTNAZ,SHOTA,2) C IF( NEWHRZ .GT. 300 ) THEN CURHRZ = NEWHRZ - 300 WRITE( IPR, 8105 ) SHOTNO(SHOTA), ORTNAZ, CURHRZ ENDIF 450 CONTINUE ENDIF C C*********************************************************************** C*** **** C*** AUTOMATIC KILL **** C*** **** C*********************************************************************** C DO 525 SHOTA = 1, NSHOT DO 525 ORTNAZ = 1, LCTPSP OLDHRZ = FBREAK(ORTNAZ,SHOTA,1) NEWHRZ = FBREAK(ORTNAZ,SHOTA,2) C IF( OLDHRZ .GT. 200 .OR. NEWHRZ .GT. 300 ) THEN DO 520 CURHRZ = 1, NUMHRZ RTIMES(ORTNAZ,SHOTA,CURHRZ) = 0.0 520 CONTINUE C IF( OLDHRZ .GT. 200 ) THEN FBREAK(ORTNAZ,SHOTA,1) = OLDHRZ - 200 C IF( NEWHRZ .LT. 300 ) THEN FBREAK(ORTNAZ,SHOTA,2) = NEWHRZ + 200 ENDIF ENDIF ENDIF 525 CONTINUE C---------------------------------------------------------------------- C C NEW INWARD AND OUTWARD REFERNCES C DO 775 SIDE = 1, 2 DO 775 CDPN = 1, NCDPN DO 775 CURHRZ = 1, NUMHRZ CDPT1 = IOCREF(2,SIDE,CURHRZ,CDPN) CDPT2 = IOCREF(1,SIDE,CURHRZ,CDPN) C IF( 0 .LT. CDPT1 .AND. CDPT1 .LE. CDPT2 ) THEN IOCREF(1,SIDE,CURHRZ,CDPN) = -999 IOCREF(2,SIDE,CURHRZ,CDPN) = -999 IOCREF(3,SIDE,CURHRZ,CDPN) = -999 C DO 725 CDPT = CDPT1, CDPT2 SHOTA = CDPREF(1,SIDE,CDPT,CDPN) ORTNAZ = CDPREF(3,SIDE,CDPT,CDPN) C IF( SHOTA .GT. 0 .AND. ORTNAZ .GT. 0 ) THEN IF( FBREAK(ORTNAZ,SHOTA,2) .EQ. CURHRZ ) THEN IOCREF(1,SIDE,CURHRZ,CDPN) = CDPT C IF( IOCREF(2,SIDE,CURHRZ,CDPN) .LT. 0 ) THEN IOCREF(2,SIDE,CURHRZ,CDPN) = CDPT IOCREF(3,SIDE,CURHRZ,CDPN) = CDPT ENDIF ENDIF ENDIF 725 CONTINUE ENDIF 775 CONTINUE RETURN C C*********************************************************************** C*** **** C*** FORMAT STATEMENTS **** C*** **** C*********************************************************************** C 8000 FORMAT(1X,130('-')//51X,'AUTOMATIC KILL BY VALUE (ZAP)'/) C 8100 FORMAT('0THE FOLLOWING TIME PICKS HAVE BEEN ELIMINATED DUE TO '/ * ' EXCESSIVE RECIPROCAL OR BULL''S-EYE ERRORS:'/) C 8105 FORMAT(10X,'SHOT',I5,', TRACE (ORTN)',I5,5X,'(HORIZON ',I1,')') C 8200 FORMAT('0---------------------------------------------------- '/ * ' THE FOLLOWING TIME PICKS HAVE BEEN ELIMINATED DUE TO '/ * ' EXCESSIVE RAYPATH CANCELLATION ERRORS:'/) END