CTITLE SACRTQC -- COLOR REFRACTION TIME-PICK QUALITY CONTROL DISPLAYS C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA CA AUTHOR J.V.S. HARVEY CA LANGUAGE VS FORTRAN (77) CA SYSTEM IBM ONLY CA REWRITTEN 06 MAY 1988 CA CA CA THIS SUBROUTINE PLOTS A SELECTED REFRACTION TIME-PICK QC DISPLAY CA FOR EITHER THE FIRST BREAKS OR FOR ALL PICKS FROM ONE HORIZON. CA CA THE COLOR SCALE MUST BE DEFINED AS: CA 0-10 = DEFAULT UNIRAS PURE COLORS ( 1 FOR BLACK ) CA 11-18 = TIME ERROR COLOR CODE SCALE CA 21-28 = HORIZON COLORS CA 40 = NO EVALUATION OR AUTOMATIC KILL CA CA CA CA CALL SACRTQC( QCPLOT, REFHRZ, HAXIS, TSCALE, FBNLAB, CA NSHOT, SHOTID, SHOTNO, SPNODE, CA NRECV, RECVID, ORTNSR, CA NCDPN, CDPNUM, NCDPT, CDPREF, CA NUMHRZ, IOCREF, CA LCTPSP, FBREAK, RTIMES, PHSCAT, MTIMES, CA X0, Y0, XYSTEP, HT ) CA CA CA IN/OUT ARGUMENT TYPE DESCRIPTION CA CA IN QCPLOT CH1 QC OPTION CA 'H' FOR FIRST-BREAK HORIZON MAP CA CA 'R' RECIPROCAL TIME ERRORS CA 'I' INWARD RAYPATH CANC. ERRORS CA 'O' OUTWARD RAYPATH CANC. ERRORS CA CA '2' 2-WIDE BULL'S-EYE CANC. ERRORS CA '3' 3-WIDE BULL'S-EYE CANC. ERRORS CA '4' 4-WIDE BULL'S-EYE CANC. ERRORS CA '5' 5-WIDE BULL'S-EYE CANC. ERRORS CA '6' 6-WIDE BULL'S-EYE CANC. ERRORS CA '7' 7-WIDE BULL'S-EYE CANC. ERRORS CA '8' 8-WIDE BULL'S-EYE CANC. ERRORS CA CA 'F' PHANTOMING MAX SCATTERING CA CA 'M' MODEL-PREDICTION TIME ERRORS CA 'Q' RECIPROCAL ERRORS IN PREDICTIONS CA CA '#' REFERENCE GRID FOR FBN MAPPING CA CA IN REFHRZ I4 REFERENCE HORIZON CA 99 FOR FIRST BREAK CA CA IN HAXIS CH4 HORIZONTAL AXIS INDICATOR CA 'SHOT' FOR SHOTPOINT CA 'CDPN' FOR CDP LOCATION CA CA IN TSCALE R4 TIME-TO-COLOR SCALING FACTOR CA IN FBNLAB CH8 FIRST-BREAK NODE LABELS CA CA CA IN NSHOT I4 NUMBER OF SHOTPOINTS PICKED CA 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 CA IN SHOTNO I2 PICKED SHOTPOINT NUMBER LIST CA ( 1-D ARRAY DIMENSIONED: NSHOT ) CA CA IN SPNODE I2 LARGEST OFFSET ORTN PICKED FOR EACH HORIZON CA (HORIZ,1,SHOT) = LOW-SIDE MAPPING CA (DEFAULTS TO -999) CA (HORIZ,2,SHOT) = HIGH-SIDE MAPPING CA (DEFAULTS TO -999) CA ( 3-D ARRAY DIMENSIONED: 8 BY 2 BY NSHOT ) CA CA CA IN NRECV I4 NUMBER OF RECEIVERS CA 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 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 CA IN NCDPN I4 NUMBER OF CDPN LOCATIONS CA CA IN CDPNUM I2 CDP NUMBERS (LABELS) CA ( 1-D ARRAY DIMENSIONED: NCDPN ) CA CA CA IN NCDPT I4 MAX. NUMBER OF TRACES PER CDPN SIDE 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 CA IN NUMHRZ I4 NUMBER OF HORIZONS IN ANALYSIS CA CA IN 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 CA IN LCTPSP I4 NUMBER OF TRACES PER SHOT CA CA IN 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 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 IN PHSCAT R4 PHANTOMING MAX SCATTERING IN SECONDS CA ( 3-D ARRAY DIMENSIONED: LCTPSP BY NSHOT BY NUMHRZ ) CA CA IN MTIMES R4 MODEL-PREDICTED TIMES IN SECONDS CA SIGN INDICATES SOURCE: CA POSITIVE FOR MODELLED 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 CA IN X0, Y0 R4 ORIGIN OF CURRENT PLOTTING CA ALLOW 1.0 FOR BOTTOM LABELS CA 1.5 FOR SIDE LABELS CA 1.5 FOR TOP LABELS CA IN XYSTEP R4 STEP SIZES CA 1) IN X DIRECTION CA 2) IN Y DIRECTION CA ( 1-D ARRAY DIMENSIONED: 2 ) CA CA IN HT R4 CHARACTER PLOTTING HEIGHTS CA 1) PRIMARY LABEL CHARACTER HEIGHT (MM) CA 2) ORTN AXIS CHARACTER HEIGHT (MM) CA 3) SHOT AXIS CHARACTER HEIGHT (MM) CA 4) ORTN AXIS CHARACTER WIDTH IN CA PLOTTING UNITS CA 5) SHOT AXIS CHARACTER WIDTH IN CA PLOTTING UNITS CA ( 1-D ARRAY DIMENSIONED: 5 ) CAEND C*********************************************************************** C C SUBROUTINES CALLED: GCHAR -- UNIRAS CHARACTER STRING PLOTTING C GCHARA -- UNIRAS CHARACTER PLOTTING ANGLE C GCHARC -- UNIRAS CHARACTER COLOR C GCHARJ -- UNIRAS CHARACTER JUSTIFICATION C GNUMB -- UNIRAS NUMERIC VALUE PLOTTING C GVECT -- UNIRAS POINT/LINE DRAWING C RRECT -- UNIRAS RECTANGLE FILL WITH COLOR C C SACGRID -- REFERENCE GRID PLOTTING C C SARRERR -- RECIPROCAL TIME ERROR C SARBULL -- BULL'S-EYE CANCELLATION ERROR C SARCANC -- RAYPATH CANCELLATION ERROR C C*********************************************************************** C SUBROUTINE SACRTQC( QCPLOT, REFHRZ, HAXIS, TSCALE, FBNLAB, * NSHOT, SHOTID, SHOTNO, SPNODE, * NRECV, RECVID, ORTNSR, * NCDPN, CDPNUM, NCDPT, CDPREF, * NUMHRZ, IOCREF, * LCTPSP, FBREAK, RTIMES, PHSCAT, MTIMES, * X0, Y0, XYSTEP, HT ) IMPLICIT INTEGER (A-Z) C CHARACTER*1 QCPLOT CHARACTER*4 HAXIS REAL TSCALE CHARACTER*8 FBNLAB C REAL SHOTID(5,NSHOT) INTEGER*2 SHOTNO(NSHOT) INTEGER*2 SPNODE(8,2,NSHOT) C REAL RECVID(5,NRECV) INTEGER*2 ORTNSR(NSHOT,NRECV) C INTEGER*2 CDPNUM(NCDPN) 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) REAL PHSCAT(LCTPSP,NSHOT,NUMHRZ) REAL MTIMES(LCTPSP,NSHOT,NUMHRZ) C REAL X0, Y0 REAL XYSTEP(2) REAL HT(5) C C LOCAL CHARACTER STRINGS C CHARACTER*16 HRZLAB /'REFRACTOR 1(AB)$'/ CHARACTER*8 HRZNUM /'12345678'/ C---------------------------------------------------------------------- C C REAL VARIABLES -- LOCAL C REAL BOXDIM REAL DT REAL DIFF REAL TIME REAL TIMEAZ REAL X, Y REAL X1, Y1 REAL X2, Y2 REAL XMIN, XMAX REAL YMIN, YMAX, YORG C ------------------------------------------- C C REAL FUNCTIONS C REAL ABS REAL SARRERR, SARBULL, SARCANC C C*********************************************************************** C*** **** C*** REFERENCE GRID **** C*** **** C*********************************************************************** C XMIN = X0 + 1.5 YMIN = Y0 + 0.75 C IF( QCPLOT .NE. '#' ) GRDINC = 0 IF( QCPLOT .EQ. '#' ) GRDINC = 10 C ------------------------------------------- C C DRAW REFERENCE GRID C C IN/OUT ARGUMENT TYPE DESCRIPTION C C IN XMIN, YORG R4 CURRENT PLOT ORIGIN (LOWER LEFT) C IN DELTAX R4 X GRID SPACING IN INCHES C IN DELTAY R4 Y GRID SPACING IN INCHES C IN NXGRID I4 NUMBER OF X GRID LINES C IN GRDINC I4 X GRID LINE INCREMENT C C IN BEGLAB I4 BEGINNING Y-AXIS LABEL C IN ENDLAB I4 ENDING Y-AXIS LABEL C IN INCLAB I4 Y-AXIS LABEL INCREMENT C POSITIVE FOR UPWARD PLOT C NEGATIVE FOR DOWNWARD PLOT C IN HTCHAR R4 Y-AXIS LABEL CHARACTER HEIGHT C C OUT XMAX R4 MAXIMUM X GRID LINE PLOTTED C OUT YMAX R4 MAXIMUM Y GRID LINE PLOTTED C IF( HAXIS .EQ. 'CDPN' ) THEN NGRID = NCDPN LSTTRN = NCDPT + 1 C CALL SACGRID( XMIN, YMIN, XYSTEP(1), XYSTEP(2), NGRID, GRDINC, * 0, LSTTRN, -1, HT(2), XMAX, YORG ) ELSE NGRID = NSHOT LSTTRN = LCTPSP + 1 YORG = YMIN ENDIF C CALL SACGRID( XMIN, YORG, XYSTEP(1), XYSTEP(2), NGRID, GRDINC, * 0, LSTTRN, +1, HT(2), XMAX, YMAX ) C ------------------------------------------- C C INDICATE TYPE OF DISPLAY C X = XMIN Y = YMAX + 1.0 C IF( QCPLOT .EQ. 'H' ) THEN CALL GCHAR( 'REMAPPED HORIZON LABELS$', X, Y, HT(1) ) C ELSE IF( QCPLOT .EQ. 'R' ) THEN CALL GCHAR( 'INTERP. RECIPROCAL TIME ERROR$', X, Y, HT(1) ) C ELSE IF( QCPLOT .EQ. '2' ) THEN CALL GCHAR( '2-WIDE BULL''S-EYE CANC. ERROR$', X, Y, HT(1) ) C ELSE IF( QCPLOT .EQ. '3' ) THEN CALL GCHAR( '3-WIDE BULL''S-EYE CANC. ERROR$', X, Y, HT(1) ) C ELSE IF( QCPLOT .EQ. '4' ) THEN CALL GCHAR( '4-WIDE BULL''S-EYE CANC. ERROR$', X, Y, HT(1) ) C ELSE IF( QCPLOT .EQ. '5' ) THEN CALL GCHAR( '5-WIDE BULL''S-EYE CANC. ERROR$', X, Y, HT(1) ) C ELSE IF( QCPLOT .EQ. '6' ) THEN CALL GCHAR( '6-WIDE BULL''S-EYE CANC. ERROR$', X, Y, HT(1) ) C ELSE IF( QCPLOT .EQ. '7' ) THEN CALL GCHAR( '7-WIDE BULL''S-EYE CANC. ERROR$', X, Y, HT(1) ) C ELSE IF( QCPLOT .EQ. '8' ) THEN CALL GCHAR( '8-WIDE BULL''S-EYE CANC. ERROR$', X, Y, HT(1) ) C ELSE IF( QCPLOT .EQ. 'I' ) THEN CALL GCHAR( 'INWARD RAYPATH CANCEL. ERROR$', X, Y, HT(1) ) C ELSE IF( QCPLOT .EQ. 'O' ) THEN CALL GCHAR( 'OUTWARD RAYPATH CANCEL. ERROR$', X, Y, HT(1) ) C ELSE IF( QCPLOT .EQ. 'F' ) THEN CALL GCHAR( 'PHANTOMING MAX SCATTER (TIME)$', X, Y, HT(1) ) C ELSE IF( QCPLOT .EQ. 'M' ) THEN CALL GCHAR( 'MODEL-PREDICTION TIME ERROR$', X, Y, HT(1) ) C ELSE IF( QCPLOT .EQ. 'Q' ) THEN CALL GCHAR( 'RECIP. ERROR FOR MODELLED TIMES$', X, Y, HT(1) ) C ELSE IF( QCPLOT .EQ. '#' ) THEN CALL GCHAR( 'REFERENCE GRID FOR FBN MAPPING$', X, Y, HT(1) ) C ELSE CALL GCHAR( 'UNKNOWN PLOT TYPE$', X, Y, HT(1) ) ENDIF C ------------------------------------------- C C INDICATE HORIZON REFERENCE C Y = Y - 0.25 C IF( QCPLOT .NE. '#' ) THEN IF( REFHRZ .EQ. 99 .OR. QCPLOT .EQ. 'M' ) THEN CALL GCHAR( 'FIRST BREAKS ONLY$', X, Y, HT(1) ) C ELSE IF( 1 .LE. REFHRZ .AND. REFHRZ .LE. 7 ) THEN NXTHRZ = REFHRZ + 1 HRZLAB(11:11) = HRZNUM(REFHRZ:REFHRZ) HRZLAB(13:14) = FBNLAB(REFHRZ:NXTHRZ) C CALL GCHAR( HRZLAB, X, Y, HT(1) ) ENDIF ENDIF C ------------------------------------------- C C LABEL AXES C X1 = XMIN - 5*HT(4) X2 = XMAX + 5*HT(4) C Y1 = 0.5*( YMIN + YMAX ) - 6.0*HT(4) Y2 = 0.5*( YMIN + YMAX ) + 6.0*HT(4) C CALL GCHARA( 90 ) CALL GCHAR( 'TRACE NUMBER$', X1, Y1, HT(2) ) CALL GCHARA( 270 ) CALL GCHAR( 'TRACE NUMBER$', X2, Y2, HT(2) ) C Y1 = YMIN - 3.0*HT(5) Y2 = YMAX + 3.0*HT(5) C CALL GCHARJ( 4 ) C IF( HAXIS .EQ. 'SHOT' ) THEN CALL GCHARC( 5 ) CALL GCHAR( 'SHOT:$', X1, Y1, HT(2) ) CALL GCHAR( 'SHOT:$', X1, Y2, HT(2) ) ELSE CALL GCHARC( 3 ) CALL GCHAR( 'CDP:$', X1, Y1, HT(2) ) CALL GCHAR( 'CDP:$', X1, Y2, HT(2) ) ENDIF C CALL GCHARJ( 3 ) JFLAG = 0 J = 1 X = XMIN DO 150 GRID = 1, NGRID X = X + XYSTEP(1) C IF( JFLAG .EQ. 1 ) THEN Y = YMIN - 0.5*HT(5) CALL GVECT( X, Y, 0 ) CALL GVECT( X, YMIN, 1 ) C Y = YMAX + HT(5) CALL GVECT( X, YMAX, 0 ) CALL GVECT( X, Y, 1 ) Y = Y + HT(5) C IF( HAXIS .EQ. 'SHOT' ) THEN IF( J .EQ. 10 ) THEN CALL GCHARC( 8 ) J = 1 ELSE CALL GCHARC( 5 ) J = J + 1 ENDIF ENDIF JFLAG = 0 ELSE Y = YMAX + 0.5*HT(5) CALL GVECT( X, Y, 0 ) CALL GVECT( X, YMAX, 1 ) C Y = YMIN - HT(5) CALL GVECT( X, YMIN, 0 ) CALL GVECT( X, Y, 1 ) Y = Y - 5.0*HT(5) C IF( HAXIS .EQ. 'SHOT' ) CALL GCHARC( 5 ) J = J + 1 JFLAG = 1 ENDIF C C LABEL NUMBER C IF( HAXIS .EQ. 'SHOT' ) THEN X1 = SHOTNO(GRID) ELSE X1 = CDPNUM(GRID) ENDIF C CALL GCHARA( 90 ) CALL GNUMB( X1, X, Y, HT(3), 0 ) 150 CONTINUE CALL GCHARJ( 0 ) CALL GCHARC( 1 ) C C*********************************************************************** C*** **** C*** ERROR VALUE COLORING **** C*** **** C*********************************************************************** C IF( QCPLOT .NE. '#' ) THEN DO 500 SIDE = 1, 2 DO 450 CDPN = 1, NCDPN DO 400 CDPT = 1, NCDPT SHOTA = CDPREF(1,SIDE,CDPT,CDPN) RECVZ = CDPREF(2,SIDE,CDPT,CDPN) ORTNAZ = CDPREF(3,SIDE,CDPT,CDPN) C IF( SHOTA .GT. 0 .AND. ORTNAZ .GT. 0 ) THEN BOXDIM = 0.0 C====================================================================== C C FIRST-BREAK MAPS C IF( QCPLOT .EQ. 'H' ) THEN CURHRZ = FBREAK(ORTNAZ,SHOTA,2) C C CASE A: REMAPPED PICKS C IF( 1 .LE. CURHRZ .AND. CURHRZ .LE. NUMHRZ ) THEN COLOR = CURHRZ + 21 BOXDIM = 0.500 C C CASE B: PICKS ELIMINATED DUE TO RECIPROCITY MISMATCH C ELSE IF( CURHRZ .NE. 99 ) THEN COLOR = 40 BOXDIM = 0.500 ENDIF C====================================================================== C C TIME PICK ERRORS C ELSE IF( REFHRZ .EQ. 99 ) THEN CURHRZ = FBREAK(ORTNAZ,SHOTA,2) C IF( 1 .LE. CURHRZ .AND. * CURHRZ .LE. NUMHRZ ) THEN TIME = RTIMES(ORTNAZ,SHOTA,CURHRZ) C IF( TIME .LT. 0.0 ) TIME = 0.0 ELSE TIME = 0.0 ENDIF OCFLAG = 2 C ELSE CURHRZ = REFHRZ TIME = RTIMES(ORTNAZ,SHOTA,REFHRZ) OCFLAG = 3 ENDIF C IF( TIME .NE. 0.0 ) THEN IF( TIME .GT. 0.0 ) BOXDIM = 0.500 IF( TIME .LT. 0.0 ) BOXDIM = 0.250 C DT = -1.0 C ------------------------------------------- C C RECIPROCAL TIME ERROR C IF( QCPLOT .EQ. 'R' ) THEN DT = SARRERR( 'CONS', CURHRZ, * SHOTA, RECVZ, ORTNAZ, * NUMHRZ, NSHOT, NRECV, LCTPSP, * SHOTID, RECVID, ORTNSR, * FBREAK, RTIMES ) C ELSE IF( QCPLOT .EQ. 'Q' ) THEN DT = SARRERR( 'CONS', CURHRZ, * SHOTA, RECVZ, ORTNAZ, * NUMHRZ, NSHOT, NRECV, LCTPSP, * SHOTID, RECVID, ORTNSR, * FBREAK, MTIMES ) C ------------------------------------------- C C BULL'S-EYE CANCELLATION ERROR C ELSE IF( QCPLOT .EQ. '2' ) THEN DT = SARBULL( 2, CURHRZ, * SHOTA, RECVZ, ORTNAZ, * NSHOT, SHOTID, * NRECV, RECVID, ORTNSR, * LCTPSP, FBREAK, NUMHRZ, RTIMES ) C ELSE IF( QCPLOT .EQ. '3' ) THEN DT = SARBULL( 3, CURHRZ, * SHOTA, RECVZ, ORTNAZ, * NSHOT, SHOTID, * NRECV, RECVID, ORTNSR, * LCTPSP, FBREAK, NUMHRZ, RTIMES ) C ELSE IF( QCPLOT .EQ. '4' ) THEN DT = SARBULL( 4, CURHRZ, * SHOTA, RECVZ, ORTNAZ, * NSHOT, SHOTID, * NRECV, RECVID, ORTNSR, * LCTPSP, FBREAK, NUMHRZ, RTIMES ) C ELSE IF( QCPLOT .EQ. '5' ) THEN DT = SARBULL( 5, CURHRZ, * SHOTA, RECVZ, ORTNAZ, * NSHOT, SHOTID, * NRECV, RECVID, ORTNSR, * LCTPSP, FBREAK, NUMHRZ, RTIMES ) C ELSE IF( QCPLOT .EQ. '6' ) THEN DT = SARBULL( 6, CURHRZ, * SHOTA, RECVZ, ORTNAZ, * NSHOT, SHOTID, * NRECV, RECVID, ORTNSR, * LCTPSP, FBREAK, NUMHRZ, RTIMES ) C ELSE IF( QCPLOT .EQ. '7' ) THEN DT = SARBULL( 7, CURHRZ, * SHOTA, RECVZ, ORTNAZ, * NSHOT, SHOTID, * NRECV, RECVID, ORTNSR, * LCTPSP, FBREAK, NUMHRZ, RTIMES ) C ELSE IF( QCPLOT .EQ. '8' ) THEN DT = SARBULL( 8, CURHRZ, * SHOTA, RECVZ, ORTNAZ, * NSHOT, SHOTID, * NRECV, RECVID, ORTNSR, * LCTPSP, FBREAK, NUMHRZ, RTIMES ) C ------------------------------------------- C C INWARD OR OUTWARD RAYPATH CANCELLATION ERROR C ELSE IF( QCPLOT .EQ. 'I' .OR. * QCPLOT .EQ. 'O' ) THEN C IF( QCPLOT .EQ. 'I' ) THEN CDPTR = IOCREF( 1,SIDE,CURHRZ,CDPN) ELSE CDPTR = IOCREF(OCFLAG,SIDE,CURHRZ,CDPN) ENDIF C DT = SARCANC( CURHRZ, SIDE, CDPN, * CDPT, CDPTR, * NSHOT, NRECV, LCTPSP, * NUMHRZ, NCDPN, NCDPT, * CDPREF, ORTNSR, RTIMES ) C ------------------------------------------- C C PHANTOMING MAX SCATTER C ELSE IF( QCPLOT .EQ. 'F' ) THEN TIMEAZ = PHSCAT(ORTNAZ,SHOTA,CURHRZ) DT = ABS( TIMEAZ ) C ------------------------------------------- C C MODEL PREDICTION ERROR C ELSE IF( QCPLOT .EQ. 'M' ) THEN TIMEAZ = MTIMES(ORTNAZ,SHOTA,CURHRZ) C IF( TIMEAZ .NE. 0.0 ) THEN DIFF = ABS( TIME ) - ABS( TIMEAZ ) DT = ABS( DIFF ) ENDIF ENDIF C ------------------------------------------- C C COLOR CODING C IF( DT .GE. 0.0 ) THEN COLOR = 11.0 + DT*TSCALE IF( COLOR .GT. 19 ) COLOR = 19 C ELSE COLOR = 40 ENDIF ENDIF ENDIF C---------------------------------------------------------------------- C C RECTANGULAR CELL COLORING C IF( BOXDIM .GT. 0.0 ) THEN IF( HAXIS .EQ. 'SHOT' ) THEN X1 = XMIN + XYSTEP(1)*( SHOTA - BOXDIM ) Y1 = YORG + XYSTEP(2)*( ORTNAZ - BOXDIM ) C X2 = XMIN + XYSTEP(1)*( SHOTA + BOXDIM ) Y2 = YORG + XYSTEP(2)*( ORTNAZ + BOXDIM ) C ELSE IF( SIDE .EQ. 1 ) THEN X1 = XMIN + XYSTEP(1)*( CDPN - BOXDIM ) Y1 = YORG - XYSTEP(2)*( CDPT + BOXDIM ) C X2 = XMIN + XYSTEP(1)*( CDPN + BOXDIM ) Y2 = YORG - XYSTEP(2)*( CDPT - BOXDIM ) C ELSE X1 = XMIN + XYSTEP(1)*( CDPN - BOXDIM ) Y1 = YORG + XYSTEP(2)*( CDPT - BOXDIM ) C X2 = XMIN + XYSTEP(1)*( CDPN + BOXDIM ) Y2 = YORG + XYSTEP(2)*( CDPT + BOXDIM ) ENDIF C CALL RRECT( X1, Y1, X2, Y2, COLOR, 0.0 ) ENDIF ENDIF 400 CONTINUE 450 CONTINUE 500 CONTINUE ENDIF C C*********************************************************************** C*** **** C*** COLOR-IN SPLIT INDICATORS **** C*** **** C*********************************************************************** C IF( HAXIS .EQ. 'SHOT' .AND. QCPLOT .NE. '#' ) THEN DO 750 SHOT = 1, NSHOT ORTN1 = SPNODE(1,1,SHOT) - 1 ORTN2 = SPNODE(1,2,SHOT) C X1 = XMIN + XYSTEP(1)*( SHOT - 0.50 ) Y1 = YORG + XYSTEP(2)*( ORTN1 + 0.45 ) C X2 = XMIN + XYSTEP(1)*( SHOT + 0.50 ) Y2 = YORG + XYSTEP(2)*( ORTN1 + 0.55 ) C CALL RRECT( X1, Y1, X2, Y2, 1, 0.0 ) C IF( ORTN1 .NE. ORTN2 ) THEN X1 = XMIN + XYSTEP(1)*( SHOT - 0.50 ) Y1 = YORG + XYSTEP(2)*( ORTN2 + 0.45 ) C X2 = XMIN + XYSTEP(1)*( SHOT + 0.50 ) Y2 = YORG + XYSTEP(2)*( ORTN2 + 0.55 ) C CALL RRECT( X1, Y1, X2, Y2, 1, 0.0 ) ENDIF 750 CONTINUE ENDIF RETURN END