CTITLE SARHCHK -- LOCALIZED HORIZON CHANGE OR KILL (POLYGONAL) C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA CA DESIGNER J. V. S. HARVEY CA LANGUAGE VS FORTRAN (77) CA REWRITTEN 29 MAR 1988 CA CA CA THIS SUBROUTINE CHANGES THE HORIZON MAPPING OF A ZONE OF TIME PICKS CA ON THE SHOT-ORTN GRID. CA CA CA CALL SARHCHK( CURHCH, HCHMAP, HCHREF, CA NUMHRZ, NSHOT, LCTPSP, CA NCDPN, NCDPT, CDPREF, CA FBREAK, RTIMES, IOCREF ) CA CA CA IN/OUT ARGUMENT TYPE DESCRIPTION CA CA IN CURHCH I4 CURRENT HCH POLYGON (1-12) CA IN HCHMAP I2 HCH REMAPPING REFERENCE HORIZONS CA (1,POLYGON) = OLD HORIZON INDEX CA (2,POLYGON) = NEW HORIZON INDEX CA (99 FOR 'KILL') CA (3,POLYGON) = VERTICES PER POLYGON CA ( 2-D ARRAY DIMENSIONED: 3 BY 12 ) CA IN HCHREF I2 HCH POLYGONAL VERTICES CA (1,VERTEX,POLYGON) = SHOT INDEX CA (2,VERTEX,POLYGON) = TRACE NUMBER CA ( 3-D ARRAY DIMENSIONED: 2 BY 6 BY 12 ) CA CA IN NUMHRZ I4 NUMBER OF HORIZONS CA IN NSHOT I4 NUMBER OF SHOTPOINTS PICKED CA IN LCTPSP I4 NUMBER OF TRACES PER SHOT 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 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 ( 3-D ARRAY DIMENSIONED: LCTPSP BY NSHOT BY 2 ) CA CA IN/OUT RTIMES R4 REMAPPED REFRACTION TIMES IN SECONDS CA DEFAULTED TO ZERO FOR NO PICKED TIME CA ( 3-D ARRAY DIMENSIONED: LCTPSP BY NSHOT BY NUMHRZ ) CA 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 C*********************************************************************** C C SUBROUTINES CALLED: SARMVPK -- TIME PICK MOVEMENT (HORIZ. TO HORIZ.) C C*********************************************************************** C SUBROUTINE SARHCHK( CURHCH, HCHMAP, HCHREF, * NUMHRZ, NSHOT, LCTPSP, * NCDPN, NCDPT, CDPREF, * FBREAK, RTIMES, IOCREF ) IMPLICIT INTEGER (A-Z) C INTEGER*2 HCHMAP(3,12) INTEGER*2 HCHREF(2,6,12) INTEGER*2 CDPREF(3,2,NCDPT,NCDPN) INTEGER*2 FBREAK(LCTPSP,NSHOT,2) REAL RTIMES(LCTPSP,NSHOT,NUMHRZ) INTEGER*2 IOCREF(3,2,NUMHRZ,NCDPN) C REAL A REAL DX REAL SLOPE REAL YM, Y1, Y2 C C*********************************************************************** C*** **** C*** LOCALIZED CHANGE OR KILL **** C*** **** C*********************************************************************** C C REFERENCE CONSTANTS C OLDHRZ = HCHMAP(1,CURHCH) NEWHRZ = HCHMAP(2,CURHCH) NPAIRS = HCHMAP(3,CURHCH) C====================================================================== C C SINGLE PICK ALTERATION C IF( NPAIRS .EQ. 1 ) THEN SHOT = HCHREF(1,1,CURHCH) ORTN = HCHREF(2,1,CURHCH) C CALL SARMVPK( ORTN, SHOT, OLDHRZ, NEWHRZ, * LCTPSP, NSHOT, NUMHRZ, * FBREAK, RTIMES ) C====================================================================== C C LINEAR ALTERATION C ELSE IF( NPAIRS .EQ. 2 ) THEN SHOT1 = HCHREF(1,1,CURHCH) ORTN1 = HCHREF(2,1,CURHCH) SHOT2 = HCHREF(1,2,CURHCH) ORTN2 = HCHREF(2,2,CURHCH) C ------------------------------------------- C C CASE A: CONSTANT TRACE C IF( ORTN1 .EQ. ORTN2 ) THEN DO 225 SHOT = SHOT1, SHOT2 CALL SARMVPK( ORTN1, SHOT, OLDHRZ, NEWHRZ, * LCTPSP, NSHOT, NUMHRZ, * FBREAK, RTIMES ) 225 CONTINUE C ------------------------------------------- C C CASE B: CONSTANT SHOT C ELSE IF( SHOT1 .EQ. SHOT2 ) THEN DO 250 ORTN = ORTN1, ORTN2 CALL SARMVPK( ORTN, SHOT1, OLDHRZ, NEWHRZ, * LCTPSP, NSHOT, NUMHRZ, * FBREAK, RTIMES ) 250 CONTINUE C ------------------------------------------- C C CASE C: DIAGONAL C ELSE DX = ( SHOT2 - SHOT1 ) SLOPE = ( ORTN2 - ORTN1 )/DX C DO 275 SHOT = SHOT1, SHOT2 YM = ORTN1 + SLOPE*( SHOT - SHOT1 ) ORTN = YM Y1 = ORTN - 0.01 Y2 = ORTN + 0.01 C IF( Y1 .LE. YM .AND. YM .LE. Y2 ) THEN CALL SARMVPK( ORTN, SHOT, OLDHRZ, NEWHRZ, * LCTPSP, NSHOT, NUMHRZ, * FBREAK, RTIMES ) ENDIF 275 CONTINUE ENDIF C====================================================================== C C POLYGONAL ALTERATION C ELSE IF( NPAIRS .GE. 3 ) THEN SM = 0 TM = 0 C C CALCULATE MIDPOINT OF POLYGON C DO 310 PAIR = 1, NPAIRS SM = SM + HCHREF(1,PAIR,CURHCH) TM = TM + HCHREF(2,PAIR,CURHCH) 310 CONTINUE C A = NPAIRS SM = SM/A TM = TM/A C C SORT CORNERS INTO CLOCKWISE SERIES C DO 350 PAIR = 2, NPAIRS DO 325 PAIR2 = 2, PAIR PAIR1 = PAIR2 - 1 C S1 = HCHREF(1,PAIR1,CURHCH) T1 = HCHREF(2,PAIR1,CURHCH) S2 = HCHREF(1,PAIR2,CURHCH) T2 = HCHREF(2,PAIR2,CURHCH) C A = S1*T2 - S2*T1 + S2*TM - SM*T2 + SM*T1 - S1*TM C IF( A .LT. 0.0 ) THEN HCHREF(1,PAIR1,CURHCH) = S2 HCHREF(2,PAIR1,CURHCH) = T2 HCHREF(1,PAIR2,CURHCH) = S1 HCHREF(2,PAIR2,CURHCH) = T1 ENDIF 325 CONTINUE 350 CONTINUE C---------------------------------------------------------------------- C C DETERMINE WHICH PICKS MUST BE ALTERED C DO 375 SHOT = 1, NSHOT DO 365 ORTN = 1, LCTPSP IF( FBREAK(ORTN,SHOT,2) .NE. 99 ) THEN IFLAG = 1 C SM = SHOT TM = ORTN C S1 = HCHREF(1,NPAIRS,CURHCH) T1 = HCHREF(2,NPAIRS,CURHCH) C DO 360 PAIR = 1, NPAIRS S2 = HCHREF(1,PAIR,CURHCH) T2 = HCHREF(2,PAIR,CURHCH) C A = S1*T2 - S2*T1 + S2*TM - SM*T2 + SM*T1 - S1*TM IF( A .LT. 0.0 ) IFLAG = 0 C S1 = S2 T1 = T2 360 CONTINUE C C REARRANGE TIME PICKS AND REDETERMINE LIMITS C IF( IFLAG .EQ. 1 ) THEN CALL SARMVPK( ORTN, SHOT, OLDHRZ, NEWHRZ, * LCTPSP, NSHOT, NUMHRZ, * FBREAK, RTIMES ) ENDIF ENDIF 365 CONTINUE 375 CONTINUE ENDIF C C*********************************************************************** C*** **** C*** UPDATE REFERENCE ARRAYS **** C*** **** C*********************************************************************** C C 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 END