CTITLE SARPHAN -- OFFSET EXTRAPOLATION BY CONCENTRIC PHANTOMING C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA CA AUTHOR J.V.S. HARVEY CA LANGUAGE VS FORTRAN CA REWRITTEN 29 MAR 1988 CA CA CA THIS SUBROUTINE CALCULATES PHANTOM TIME PICKS FOR ALL CDP GATHERS CA USING TIME PICKS FROM CONCENTRIC SHOT-RECEIVER PROFILES CA CA CA CALL SARPHAN( IPR, KPBUGF, NUMHRZ, NCDPN, NCDPT, CA NSHOT, NRECV, LCTPSP, CA SHOTNO, ORTNSR, CDPREF, CA IOCREF, RTIMES, PHSCAT ) CA CA CA IN/OUT ARGUMENT TYPE DESCRIPTION CA CA IN IPR I4 OUTPUT UNIT NUMBER CA IN KPBUGF I4 DEBUG PRINT FLAG CA CA IN NUMHRZ I4 NUMBER OF HORIZONS IN ANALYSIS CA IN NCDPN I4 NUMBER OF CDPN LOCATIONS CA IN NCDPT I4 MAX. NUMBER OF TRACES PER CDPN SIDE CA IN NSHOT I4 NUMBER OF SHOTPOINTS PICKED CA IN NRECV I4 NUMBER OF RECEIVER STATIONS CA IN LCTPSP I4 NUMBER OF TRACES PER SHOT CA CA IN SHOTNO I2 PICKED SHOTPOINT NUMBER LIST (UNSORTED) CA ( 1-D ARRAY DIMENSIONED: NSHOT ) CA CA IN ORTNSR I2 TRACE CROSS-REFERENCE FOR SHOT AND RECEIVER 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 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 UPDATE 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 UPDATE 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 CA UPDATE PHSCAT R4 PHANTOMING MAX SCATTERING IN SECONDS CA ( 3-D ARRAY DIMENSIONED: LCTPSP BY NSHOT BY NUMHRZ ) CA C*********************************************************************** C C SUBROUTINES CALLED: (NONE) C C*********************************************************************** C SUBROUTINE SARPHAN( IPR, KPBUGF, NUMHRZ, NCDPN, NCDPT, * NSHOT, NRECV, LCTPSP, * SHOTNO, ORTNSR, CDPREF, * IOCREF, RTIMES, PHSCAT ) IMPLICIT INTEGER (A-Z) C INTEGER*2 SHOTNO(NSHOT) INTEGER*2 ORTNSR(NSHOT,NRECV) INTEGER*2 CDPREF(3,2,NCDPT,NCDPN) INTEGER*2 IOCREF(3,2,NUMHRZ,NCDPN) REAL RTIMES(LCTPSP,NSHOT,NUMHRZ) REAL PHSCAT(LCTPSP,NSHOT,NUMHRZ) C---------------------------------------------------------------------- C C INTEGER ARRAYS -- LOCAL C INTEGER*2 TRACES(24) C C REAL VARIABLES -- LOCAL C REAL TIME C REAL*8 TAY REAL*8 TAZ REAL*8 TAZMIN REAL*8 TAZMAX REAL*8 TBY REAL*8 TBZ REAL*8 TSCAT C REAL*8 SUMW REAL*8 SUMWT C REAL*8 DABS C C*********************************************************************** C*** **** C*** FAR-OFFSET PHANTOMING **** C*** **** C*********************************************************************** C DO 900 CURHRZ = 1, NUMHRZ DO 400 SIDE = 1, 2 DO 300 CDPTAZ = 2, NCDPT DO 200 CDPN = 1, NCDPN CDPT1 = IOCREF(2,SIDE,CURHRZ,CDPN) CDPT2 = IOCREF(1,SIDE,CURHRZ,CDPN) C IF( 0 .LT. CDPT1 .AND. * CDPT1 .LE. CDPT2 .AND. * CDPT2 .LT. CDPTAZ ) THEN SHOTA = CDPREF(1,SIDE,CDPTAZ,CDPN) RECVZ = CDPREF(2,SIDE,CDPTAZ,CDPN) ORTNAZ = CDPREF(3,SIDE,CDPTAZ,CDPN) C IF( SHOTA .GT. 0 .AND. ORTNAZ .GT. 0 ) THEN TIME = RTIMES(ORTNAZ,SHOTA,CURHRZ) C IF( TIME .EQ. 0.0 ) THEN SUMW = 0.0 SUMWT = 0.0 C TAZMIN = 1.0E+10 TAZMAX = 0.0 C DO 100 CDPTBY = CDPT1, NCDPT SHOTB = CDPREF(1,SIDE,CDPTBY,CDPN) RECVY = CDPREF(2,SIDE,CDPTBY,CDPN) ORTNBY = CDPREF(3,SIDE,CDPTBY,CDPN) C IF( 0 .LT. SHOTB .AND. SHOTB .NE. SHOTA .AND. * 0 .LT. RECVY .AND. RECVY .NE. RECVZ ) THEN ORTNAY = ORTNSR(SHOTA,RECVY) ORTNBZ = ORTNSR(SHOTB,RECVZ) C IF( ORTNAY .GT. 0 .AND. ORTNBZ .GT. 0 ) THEN TAY = RTIMES(ORTNAY,SHOTA,CURHRZ) TBY = RTIMES(ORTNBY,SHOTB,CURHRZ) TBZ = RTIMES(ORTNBZ,SHOTB,CURHRZ) C IF( TAY .NE. 0.0D0 .AND. * TBY .NE. 0.0D0 .AND. * TBZ .NE. 0.0D0 ) THEN TAZ = DABS( TAY ) + DABS( TBZ ) * - DABS( TBY ) C SUMW = SUMW + 1.0 SUMWT = SUMWT - TAZ C IF( TAZ .LT. TAZMIN ) TAZMIN = TAZ IF( TAZ .GT. TAZMAX ) TAZMAX = TAZ ENDIF ENDIF ENDIF 100 CONTINUE C IF( SUMW .GT. 0.0D0 ) THEN TAZ = SUMWT/SUMW C TSCAT = ( TAZMAX + TAZ ) TBY = 0.0 - ( TAZMIN + TAZ ) IF( TSCAT .LT. TBY ) TSCAT = TBY C RTIMES(ORTNAZ,SHOTA,CURHRZ) = TAZ PHSCAT(ORTNAZ,SHOTA,CURHRZ) = TSCAT ENDIF ENDIF ENDIF ENDIF 200 CONTINUE 300 CONTINUE 400 CONTINUE C C*********************************************************************** C*** **** C*** NEAR-OFFSET PHANTOMING **** C*** **** C*********************************************************************** C DO 800 CSIDE = 1, 2 CDPTAZ = NCDPT C DO 700 CDPTX = 1, NCDPT DO 600 CDPN = 1, NCDPN CDPT1 = IOCREF(2,CSIDE,CURHRZ,CDPN) CDPT2 = IOCREF(1,CSIDE,CURHRZ,CDPN) C IF( 0 .LT. CDPT1 .AND. * CDPT1 .LE. CDPT2 .AND. * CDPT2 .GT. CDPTAZ ) THEN SHOTA = CDPREF(1,CSIDE,CDPTAZ,CDPN) RECVZ = CDPREF(2,CSIDE,CDPTAZ,CDPN) ORTNAZ = CDPREF(3,CSIDE,CDPTAZ,CDPN) C IF( SHOTA .GT. 0 .AND. ORTNAZ .GT. 0 ) THEN TIME = RTIMES(ORTNAZ,SHOTA,CURHRZ) C IF( TIME .EQ. 0.0 ) THEN SUMW = 0.0 SUMWT = 0.0 C TAZMIN = 1.0E+10 TAZMAX = 0.0 C DO 500 CDPTBY = CDPT1, NCDPT SHOTB = CDPREF(1,CSIDE,CDPTBY,CDPN) RECVY = CDPREF(2,CSIDE,CDPTBY,CDPN) ORTNBY = CDPREF(3,CSIDE,CDPTBY,CDPN) C IF( 0 .LT. SHOTB .AND. SHOTB .NE. SHOTA .AND. * 0 .LT. RECVY .AND. RECVY .NE. RECVZ ) THEN ORTNAY = ORTNSR(SHOTA,RECVY) ORTNBZ = ORTNSR(SHOTB,RECVZ) C IF( ORTNAY .GT. 0 .AND. ORTNBZ .GT. 0 ) THEN TAY = RTIMES(ORTNAY,SHOTA,CURHRZ) TBY = RTIMES(ORTNBY,SHOTB,CURHRZ) TBZ = RTIMES(ORTNBZ,SHOTB,CURHRZ) C IF( TAY .NE. 0.0D0 .AND. * TBY .NE. 0.0D0 .AND. * TBZ .NE. 0.0D0 ) THEN TAZ = DABS( TAY ) + DABS( TBZ ) * - DABS( TBY ) C SUMW = SUMW + 1.0 SUMWT = SUMWT - TAZ C IF( TAZ .LT. TAZMIN ) TAZMIN = TAZ IF( TAZ .GT. TAZMAX ) TAZMAX = TAZ ENDIF ENDIF ENDIF 500 CONTINUE C IF( SUMW .GT. 0.0D0 ) THEN TAZ = SUMWT/SUMW C TSCAT = ( TAZMAX + TAZ ) TBY = 0.0 - ( TAZMIN + TAZ ) IF( TSCAT .LT. TBY ) TSCAT = TBY C RTIMES(ORTNAZ,SHOTA,CURHRZ) = TAZ PHSCAT(ORTNAZ,SHOTA,CURHRZ) = TSCAT IOCREF(3,CSIDE,CURHRZ,CDPN) = CDPTAZ ENDIF ENDIF ENDIF ENDIF 600 CONTINUE C CDPTAZ = CDPTAZ - 1 700 CONTINUE 800 CONTINUE 900 CONTINUE C C*********************************************************************** C*** **** C*** DEBUG PRINT **** C*** **** C*********************************************************************** C IF( KPBUGF .GE. 1 ) THEN NPAGE = ( ( LCTPSP - 1 )/15 ) + 1 C DO 995 CURHRZ = 1, NUMHRZ WRITE( IPR, 8975 ) CURHRZ C K0 = 0 DO 990 PAGE = 1, NPAGE K1 = K0 + 1 K2 = K0 + 15 IF( K2 .GT. LCTPSP ) THEN K2 = LCTPSP ENDIF C J2 = K2 - K1 + 1 K = K0 DO 980 J = 1, J2 K = K + 1 TRACES(J) = K 980 CONTINUE WRITE( IPR, 8980 ) ( TRACES(J), J=1,J2 ) WRITE( IPR, 8985 ) C DO 985 SHOT = 1, NSHOT WRITE( IPR, 8990 ) SHOTNO(SHOT), * ( RTIMES(K,SHOT,CURHRZ), K=K1,K2 ) 985 CONTINUE K0 = K2 990 CONTINUE 995 CONTINUE ENDIF RETURN C C*********************************************************************** C*** **** C*** FORMAT STATEMENTS **** C*** **** C*********************************************************************** C 8975 FORMAT(1X,130('-')// * '0REFRACTION TIMES FOR HORIZON ',I1,' AFTER PHANTOMING:') 8980 FORMAT(/63X,'ORTN'/5X,'SHOT ',15I8) 8985 FORMAT(5X,'---- ',15(' -----')) 8990 FORMAT(4X,I5,1X,15F8.4) END