CTITLE SACRMOD -- (UNIRAS) COLOR REFRACTION INVERSION MODEL DISPLAY C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA (W/ RESIDUALS) CA CA AUTHOR J.V.S. HARVEY CA LANGUAGE VS FORTRAN (77) CA SYSTEM IBM ONLY CA REWRITTEN 04 OCT 1988 (EXPANSION OF SACINVM) CA CA CA THIS SUBROUTINE DISPLAYS MULTI-LAYER REFRACTION MODEL ATTRIBUTES CA AND RESIDUAL ESTIMATES IN (UNIRAS) COLOR. CA CA THE COLOR SCALE MUST BE DEFINED AS: CA 0-10 = DEFAULT UNIRAS PURE COLORS ( 1 FOR BLACK ) CA 21-30 = LAYER COLORS CA 31-40 = STD. DEVIATION COLORS (PER HORIZON) CA CA CA CALL SACRMOD( QCPLOT, NRESID, CA VELFLG, VRTMIN, VRTMAX, CA NCDPN, CDPNID, CDPNUM, CA NUMHRZ, CMODEL, PSEUDO, CA NGRID, ZMODEL, PMODEL, CA NSHOT, SHOTID, SRESID, CA NRECV, RECVID, RRESID, CA X0, Y0, XSTEP, YSIZE, HT, CA WORKXC, WORKYC ) CA CA CA IN/OUT ARGUMENT TYPE DESCRIPTION CA CA IN QCPLOT CH1 QC OPTION CA 'E' FOR ELEVATION CA 'V' LAYER VELOCITY CA 'T' VERTICAL RAY TIME CA 'D' RESIDUAL ESTIMATES CA CA IN NRESID I4 NUMBER OF RESIDUAL ITERATIONS CA ( 0 DISABLES RESIDUALS ) CA CA CA IN VELFLG I2 VELOCITY PLOTTING DIRECTION FLAG CA ' UP ' FOR UPWARD CA 'DOWN' FOR DOWNWARD CA IN VRTMIN I4 MINIMUM VERTICAL RAY TIME TO PLOT CA IN VRTMAX I4 MAXIMUM VERTICAL RAY TIME TO PLOT CA CA IN NCDPN I4 NUMBER OF CDPN LOCATIONS CA IN CDPNID R4 CDP IDENTIFICATION ARRAY CA (1,I) = X COORDINATE (IN-LINE) CA IN UNITS OF GRID-POINT POSITION CA (2,I) = SURFACE ELEVATION CA IN ORIGINAL UNITS CA ( 2-D ARRAY DIMENSIONED: 2 BY NCDPN ) CA IN CDPNUM I2 CDP NUMBERS (LABELS) CA ( 1-D ARRAY DIMENSIONED: NCDPN ) CA CA IN NUMHRZ I4 NUMBER OF HORIZONS IN ANALYSIS CA IN CMODEL R8 MODEL VALUES ASSOCIATED WITH CDP LOCATIONS CA (CDPN,1) = VERTICAL RAY TIME (SEC) CA (CDPN,2) = DATUM ELEVATION CA (CDPN,3) = STATIC REFERENCE TIME CA (CDPN,4) = "FLAT" VERTICAL RAY TIME (SEC) CA ( 2-D ARRAY DIMENSIONED: NCDPN BY 4 ) CA IN PSEUDO R4 PSEUDO-DATUM ELEVATION CA CA IN NGRID I4 NUMBER OF GRID X LOCATIONS CA IN ZMODEL R4 THE ELEVATION MODEL FOR ALL HORIZONS CA -- INITIALLY DEFAULTED TO SURFACE VALUES CA ( 2-D ARRAY DIMENSIONED: NGRID BY 0:NUMHRZ ) CA CA IN PMODEL R4 THE SLOWNESS MODEL FOR THE LAYER BELOW CA EACH HORIZON DEFINED FOR ZMODEL CA (GRID,CURHRZ,1) = SLOWNESS ESTIMATE CA (GRID,CURHRZ,1) = VELOCITY RMS ERROR CA -- INITIALLY DEFAULTED TO SURFACE VALUES CA ( 3-D ARRAY DIMENSIONED: NGRID BY 0:NUMHRZ BY 2 ) CA 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 CA IN SRESID R4 SHOT-CONSISTENT LEAST-SQUARES RESIDUALS CA (SHOT,1) = POSITIVE RAY (L-R) RESIDUAL CA (SHOT,2) = NEGATIVE RAY (R-L) RESIDUAL CA ( 2-D ARRAY DIMENSIONED: NSHOT BY 2 ) CA CA CA IN NRECV I4 NUMBER OF UNIQUE RECEIVER POSITIONS 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 RRESID R4 RECV-CONSISTENT OVERBURDEN VALUES CA (RECV,1) = POSITIVE RAY (L-R) RESIDUAL CA (RECV,2) = NEGATIVE RAY (R-L) RESIDUAL CA ( 2-D ARRAY DIMENSIONED: NRECV BY 2 ) CA CA CA IN X0, Y0 R4 ORIGIN OF CURRENT PLOTTING CA IN XSTEP R4 STEP SIZE IN X DIRECTION CA IN YSIZE R4 MAX. SIZE IN Y DIRECTION CA IN HT R4 CHARACTER PLOTTING HEIGHTS CA 1) PRIMARY LABEL CHARACTER HEIGHT (MM) CA 2) Y-AXIS CHARACTER HEIGHT (MM) CA 3) X-AXIS CHARACTER HEIGHT (MM) CA 4) Y-AXIS CHARACTER WIDTH IN CA PLOTTING UNITS CA 5) X-AXIS CHARACTER WIDTH IN CA PLOTTING UNITS CA ( 1-D ARRAY DIMENSIONED: 5 ) CA CA WORK WORKXC R4 WORK ARRAY FOR PLOTTING (X COORDS) CA ( 1-D ARRAY DIMENSIONED: 999 ) CA WORK WORKYC R4 WORK ARRAY FOR PLOTTING (Y COORDS) CA ( 1-D ARRAY DIMENSIONED: 999 ) 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 GWICOL -- UNIRAS LINE WIDTH AND COLOR C RSURF -- UNIRAS POLYGONAL FILL WITH COLOR C C SACGRID -- REFERENCE GRID PLOTTING C C*********************************************************************** C SUBROUTINE SACRMOD( QCPLOT, NRESID, * VELFLG, VRTMIN, VRTMAX, * NCDPN, CDPNID, CDPNUM, * NUMHRZ, CMODEL, PSEUDO, * NGRID, ZMODEL, PMODEL, * NSHOT, SHOTID, SRESID, * NRECV, RECVID, RRESID, * X0, Y0, XSTEP, YSIZE, HT, * WORKXC, WORKYC ) IMPLICIT INTEGER (A-Z) C CHARACTER*1 QCPLOT CHARACTER*4 VELFLG REAL CDPNID(2,NCDPN) INTEGER*2 CDPNUM(NCDPN) REAL*8 CMODEL(NCDPN,4) REAL ZMODEL(NGRID,0:NUMHRZ) REAL PMODEL(NGRID,0:NUMHRZ,2) REAL PSEUDO C REAL SHOTID(5,NSHOT) REAL SRESID(NSHOT,2) C REAL RECVID(5,NRECV) REAL RRESID(NRECV,2) C REAL X0, Y0 REAL XSTEP REAL YSIZE REAL HT(5) REAL WORKXC(999) REAL WORKYC(999) C ------------------------------------------- C C REAL VARIABLES -- LOCAL C REAL PA, VA C REAL T, TMIN, TMAX REAL V, VMIN, VMAX, DV, V1, V2 REAL Z, ZMIN, ZMAX C EQUIVALENCE( T, V, Z ) EQUIVALENCE( TMIN, VMIN, ZMIN ) EQUIVALENCE( TMAX, VMAX, ZMAX ) C REAL X, XMIN, XMAX, X1, X2, X3 REAL Y, YMIN, YMAX, Y1, Y2, Y3, Y4, YSCALE, YSTEP REAL FACTOR C ------------------------------------------- C C CHARACTER CONSTANTS -- LOCAL C CHARACTER*36 RESLAB /'MODEL RESIDUALS AFTER ## ITERATIONS$'/ C C*********************************************************************** C*** **** C*** PLOTTING LIMITS **** C*** **** C*********************************************************************** C XMIN = X0 + 1.5 YMIN = Y0 + 2.0 C====================================================================== C C DIP-CORRECTED VELOCITY C IF( QCPLOT .EQ. 'V' ) THEN VMIN = 1.0E+10 VMAX = 0.0 C DO 25 GRID = 1, NGRID DO 25 CURHRZ = 0, NUMHRZ VA = 1.0/PMODEL(GRID,CURHRZ,1) C V1 = VA - PMODEL(GRID,CURHRZ,2) IF( V1 .LT. VMIN ) VMIN = V1 C V2 = VA + PMODEL(GRID,CURHRZ,2) IF( V2 .GT. VMAX ) VMAX = V2 25 CONTINUE C IF( VMIN .GT. VMAX ) THEN VMIN = 0.0 VMAX = 1000.0 ENDIF C L1 = 0.001*VMIN L2 = 0.001*VMAX IF( VMIN .LT. 0.0 ) L1 = L1 - 1 IF( VMAX .GE. 0.0 ) L2 = L2 + 1 VMIN = L1*1000.0 VMAX = L2*1000.0 C FACTOR = 1.0 BEGLAB = VMIN ENDLAB = VMAX C IF( VELFLG .EQ. 'DOWN' ) THEN INCLAB = -100 ELSE INCLAB = 100 ENDIF C====================================================================== C C ELEVATION C ELSE IF( QCPLOT .EQ. 'E' ) THEN ZMIN = PSEUDO ZMAX = ZMIN C DO 40 CDPN = 1, NCDPN Z = CMODEL(CDPN,2) IF( Z .LT. ZMIN ) ZMIN = Z IF( Z .GT. ZMAX ) ZMAX = Z 40 CONTINUE C DO 50 GRID = 1, NGRID DO 50 CURHRZ = 0, NUMHRZ Z = ZMODEL(GRID,CURHRZ) IF( Z .LT. ZMIN ) ZMIN = Z IF( Z .GT. ZMAX ) ZMAX = Z 50 CONTINUE C L1 = 0.001*ZMIN L2 = 0.001*ZMAX IF( ZMIN .LT. 0.0 ) L1 = L1 - 1 IF( ZMAX .GE. 0.0 ) L2 = L2 + 1 C BEGLAB = L1*1000 ENDLAB = L2*1000 INCLAB = 100 C ZMIN = BEGLAB ZMAX = ENDLAB FACTOR = 1.0 C====================================================================== C C VERTICAL RAY TIMES C ELSE IF( QCPLOT .EQ. 'T' ) THEN IF( VRTMAX .LE. 0 ) THEN TMIN = 1.0E+10 TMAX = 0.0 C DO 75 CDPN = 1, NCDPN T = CMODEL(CDPN,1) IF( T .LT. TMIN ) TMIN = T IF( T .GT. TMAX ) TMAX = T C T = CMODEL(CDPN,4) IF( T .LT. TMIN ) TMIN = T IF( T .GT. TMAX ) TMAX = T 75 CONTINUE C IF( TMIN .GT. TMAX ) THEN TMIN = 0.0 TMAX = 1.0 ENDIF C ELSE TMIN = 0.001*VRTMIN TMAX = 0.001*VRTMAX ENDIF C L1 = 10*TMIN L2 = 10*TMAX IF( TMIN .LT. 0.0 ) L1 = L1 - 1 IF( TMAX .GE. 0.0 ) L2 = L2 + 1 TMIN = 0.1*L1 TMAX = 0.1*L2 C FACTOR = 1000.0 BEGLAB = L1*100.0 ENDLAB = L2*100.0 INCLAB = 10 C====================================================================== C C RESIDUAL ESTIMATES C ELSE IF( QCPLOT .EQ. 'D' ) THEN TMIN = 1.0E+10 TMAX = 0.0 C DO 80 SHOT = 1, NSHOT T = SRESID(SHOT,1) IF( T .LT. TMIN ) TMIN = T IF( T .GT. TMAX ) TMAX = T C T = SRESID(SHOT,2) IF( T .LT. TMIN ) TMIN = T IF( T .GT. TMAX ) TMAX = T 80 CONTINUE C DO 90 RECV = 1, NRECV T = RRESID(RECV,1) IF( T .LT. TMIN ) TMIN = T IF( T .GT. TMAX ) TMAX = T C T = RRESID(RECV,2) IF( T .LT. TMIN ) TMIN = T IF( T .GT. TMAX ) TMAX = T 90 CONTINUE C IF( TMIN .GT. TMAX ) THEN TMIN = 0.0 - 1.0 TMAX = 1.0 ENDIF C L1 = 100.0*TMIN L2 = 100.0*TMAX IF( TMIN .LT. 0.0 ) L1 = L1 - 1 IF( TMAX .GE. 0.0 ) L2 = L2 + 1 TMIN = 0.01*L1 TMAX = 0.01*L2 C FACTOR = 1000.0 BEGLAB = L1*10.0 ENDLAB = L2*10.0 INCLAB = 1 ENDIF C C*********************************************************************** C*** **** C*** REFERENCE GRID **** C*** **** C*********************************************************************** C DV = VMAX - VMIN YSCALE = YSIZE/DV C YSTEP = INCLAB*( YSCALE/FACTOR ) IF( YSTEP .LT. 0.0 ) YSTEP = 0.0 - YSTEP C ------------------------------------------- C C DRAW REFERENCE GRID C C IN/OUT ARGUMENT TYPE DESCRIPTION C C IN XMIN, YMIN 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 CALL SACGRID( XMIN, YMIN, XSTEP, YSTEP, NGRID, 10, * BEGLAB, ENDLAB, INCLAB, HT(2), XMAX, YMAX ) C---------------------------------------------------------------------- C C LABEL CDP LOCATIONS C CALL GCHARJ( 3 ) CALL GCHARC( 3 ) C Y = YMIN - 0.5 DO 250 CDPN = 1, NCDPN, 4 X = XMIN + XSTEP*CDPNID(1,CDPN) X1 = CDPNUM(CDPN) CALL GCHARA( 90 ) CALL GNUMB( X1, X, Y, HT(3), 0 ) 250 CONTINUE C Y = YMIN - 1.0 DO 260 CDPN = 2, NCDPN, 4 X = XMIN + XSTEP*CDPNID(1,CDPN) X1 = CDPNUM(CDPN) CALL GCHARA( 90 ) CALL GNUMB( X1, X, Y, HT(3), 0 ) 260 CONTINUE C X = XMIN - 6*HT(4) Y = YMIN - 1.0 - 0.5*HT(4) CALL GCHAR( 'CDPN:$', X, Y, HT(2) ) C Y = YMIN - 1.5 DO 270 CDPN = 3, NCDPN, 4 X = XMIN + XSTEP*CDPNID(1,CDPN) X1 = CDPNUM(CDPN) CALL GCHARA( 90 ) CALL GNUMB( X1, X, Y, HT(3), 0 ) 270 CONTINUE C Y = YMIN - 2.0 DO 280 CDPN = 4, NCDPN, 4 X = XMIN + XSTEP*CDPNID(1,CDPN) X1 = CDPNUM(CDPN) CALL GCHARA( 90 ) CALL GNUMB( X1, X, Y, HT(3), 0 ) 280 CONTINUE C CALL GCHARJ( 0 ) CALL GCHARC( 1 ) C---------------------------------------------------------------------- C C DEFINE REFERENCE LOCATIONS FOR VERTICAL AXIS LABELS C X = XMIN Y = YMAX + 0.25 C X1 = XMIN - 8*HT(4) X2 = XMAX + 8*HT(4) C C*********************************************************************** C*** **** C*** LAYER VELOCITY MODEL **** C*** **** C*********************************************************************** C IF( QCPLOT .EQ. 'V' ) THEN CALL GCHAR( 'NEAR-SURFACE LAYER VELOCITY MODEL$', X, Y, HT(1) ) C Y1 = 0.5*( YMIN + YMAX ) - 3.5*HT(4) Y2 = 0.5*( YMIN + YMAX ) + 3.5*HT(4) C CALL GCHARA( 90 ) CALL GCHAR( 'VELOCITY$', X1, Y1, HT(2) ) CALL GCHARA( 270 ) CALL GCHAR( 'VELOCITY$', X2, Y2, HT(2) ) C====================================================================== C C STD. DEVIATION COLORING C DO 450 CURHRZ = 1, NUMHRZ COLOR = CURHRZ + 31 C PA = PMODEL(1,CURHRZ,1) DV = PMODEL(1,CURHRZ,2) V2 = ( 1.0/PA ) + DV C IF( VELFLG .EQ. 'DOWN' ) THEN Y1 = YMIN + YSCALE*( VMAX - V2 ) ELSE Y1 = YMIN + YSCALE*( V2 - VMIN ) ENDIF X1 = XMIN + XSTEP C NXY = 1 WORKXC(1) = X1 WORKYC(1) = Y1 BGRID = 1 IF( DV .GT. 0.0 ) NXY = 2 C C SCAN ALONG TOP EDGE OF ERROR BAND C X2 = X1 DO 450 GRID = 2, NGRID X2 = X2 + XSTEP C PA = PMODEL(GRID,CURHRZ,1) DV = PMODEL(GRID,CURHRZ,2) V2 = ( 1.0/PA ) + DV C IF( VELFLG .EQ. 'DOWN' ) THEN Y2 = YMIN + YSCALE*( VMAX - V2 ) ELSE Y2 = YMIN + YSCALE*( V2 - VMIN ) ENDIF C IF( NXY .EQ. 1 ) THEN IF( DV .GT. 0.0 ) THEN NXY = 2 WORKXC(NXY) = X2 WORKYC(NXY) = Y2 NXY = 3 ELSE BGRID = GRID X1 = X2 Y1 = Y2 WORKXC(NXY) = X1 WORKYC(NXY) = Y1 ENDIF ELSE WORKXC(NXY) = X2 WORKYC(NXY) = Y2 IF( DV .GT. 0.0 ) NXY = NXY + 1 C C SCAN ALONG BOTTOM EDGE C IF( GRID .EQ. NGRID .OR. DV .LE. 0.0 * .OR. NXY .GE. 499 ) THEN IGRID = GRID X = X2 DO 440 JGRID = BGRID, GRID PA = PMODEL(IGRID,CURHRZ,1) V1 = ( 1.0/PA ) - PMODEL(IGRID,CURHRZ,2) C IF( VELFLG .EQ. 'DOWN' ) THEN Y = YMIN + YSCALE*( VMAX - V1 ) ELSE Y = YMIN + YSCALE*( V1 - VMIN ) ENDIF C IF( IGRID .NE. BGRID .OR. DV .LE. 0.0 ) THEN WORKXC(NXY) = X WORKYC(NXY) = Y NXY = NXY + 1 ENDIF C X = X - XSTEP IGRID = IGRID - 1 440 CONTINUE C C REPEAT FIRST VERTEX AND COLOR IN BAND C WORKXC(NXY) = WORKXC(1) WORKYC(NXY) = WORKYC(1) CALL RSURF( WORKXC, WORKYC, NXY, COLOR, 0.0 ) C C DEFINE NEW STARTING POINT C NXY = 1 WORKXC(1) = X2 WORKYC(1) = Y2 BGRID = GRID IF( DV .GT. 0.0 ) NXY = 2 ENDIF ENDIF 450 CONTINUE C====================================================================== C C DRAW FUNCTION CURVE C DO 475 CURHRZ = 0, NUMHRZ COLOR = CURHRZ + 21 CALL GWICOL( -10.0, COLOR ) C X = XMIN PEN = 0 DO 470 GRID = 1, NGRID X = X + XSTEP C VA = 1.0/PMODEL(GRID,CURHRZ,1) C IF( VELFLG .EQ. 'DOWN' ) THEN Y = YMIN + YSCALE*( VMAX - VA ) ELSE Y = YMIN + YSCALE*( VA - VMIN ) ENDIF C CALL GVECT( X, Y, PEN ) PEN = 1 470 CONTINUE 475 CONTINUE CALL GVECT( X, Y, 0 ) C CALL GWICOL( -1.0, 1 ) C C*********************************************************************** C*** **** C*** STRUCTURAL MODEL **** C*** **** C*********************************************************************** C ELSE IF( QCPLOT .EQ. 'E' ) THEN CALL GCHAR( 'NEAR-SURFACE STRUCTURAL MODEL$', X, Y, HT(1) ) C Y1 = 0.5*( YMIN + YMAX ) - 4.0*HT(4) Y2 = 0.5*( YMIN + YMAX ) + 4.0*HT(4) C CALL GCHARA( 90 ) CALL GCHAR( 'ELEVATION$', X1, Y1, HT(2) ) CALL GCHARA( 270 ) CALL GCHAR( 'ELEVATION$', X2, Y2, HT(2) ) C---------------------------------------------------------------------- C C STRUCTURAL MODEL LAYER COLORING C DO 525 CURHRZ = 0, NUMHRZ COLOR = CURHRZ + 21 C X1 = XMIN + XSTEP Y1 = YMIN + YSCALE*( ZMODEL(1,CURHRZ) - ZMIN ) C WORKXC(1) = X1 WORKYC(1) = YMIN C WORKXC(2) = X1 WORKYC(2) = Y1 NXY = 2 C X2 = X1 DO 525 GRID = 2, NGRID X2 = X2 + XSTEP C Y2 = YMIN + YSCALE*( ZMODEL(GRID,CURHRZ) - ZMIN ) C NXY = NXY + 1 WORKXC(NXY) = X2 WORKYC(NXY) = Y2 C IF( GRID .EQ. NGRID .OR. NXY .GE. 996 ) THEN NXY = NXY + 1 WORKXC(NXY) = X2 WORKYC(NXY) = YMIN C NXY = NXY + 1 WORKXC(NXY) = WORKXC(1) WORKYC(NXY) = WORKYC(1) C IF( NXY .GT. 4 ) THEN CALL RSURF( WORKXC, WORKYC, NXY, COLOR, 0.0 ) ENDIF C IF( NXY .GE. 998 ) THEN WORKXC(1) = X2 WORKYC(1) = YMIN C WORKXC(2) = X2 WORKYC(2) = Y2 NXY = 2 ENDIF ENDIF 525 CONTINUE C---------------------------------------------------------------------- C C DRAW HORIZONS C X = XMIN PEN = 0 DO 540 GRID = 1, NGRID X = X + XSTEP C Y = YMIN + YSCALE*( ZMODEL(GRID,0) - ZMIN ) CALL GVECT( X, Y, PEN ) PEN = 1 540 CONTINUE C CALL GWICOL( -3.0, 31 ) C DO 550 CURHRZ = 1, NUMHRZ X = XMIN PEN = 0 DO 550 GRID = 1, NGRID X = X + XSTEP C Y = YMIN + YSCALE*( ZMODEL(GRID,CURHRZ) - ZMIN ) CALL GVECT( X, Y, PEN ) PEN = 1 550 CONTINUE C---------------------------------------------------------------------- C C PROCESS DATUM C COLOR = 1 PEN = 0 DO 575 CDPN = 1, NCDPN X = XMIN + XSTEP*( CDPNID(1,CDPN) ) Y = YMIN + YSCALE*( CMODEL(CDPN,2) - ZMIN ) C CALL GWICOL( -10.0, COLOR ) CALL GVECT( X, Y, PEN ) C IF( COLOR .EQ. 1 ) THEN COLOR = 31 ELSE COLOR = 1 ENDIF C PEN = 1 575 CONTINUE C---------------------------------------------------------------------- C C PSEUDO-DATUM C Y = YMIN + YSCALE*( PSEUDO - ZMIN ) C COLOR = 1 PEN = 0 DO 585 CDPN = 1, NCDPN X = XMIN + XSTEP*CDPNID(1,CDPN) C CALL GWICOL( -10.0, COLOR ) CALL GVECT( X, Y, PEN ) C IF( COLOR .EQ. 1 ) THEN COLOR = 31 ELSE COLOR = 1 ENDIF C PEN = 1 585 CONTINUE C CALL GVECT( X, Y, 0 ) CALL GWICOL( -1.0, 1 ) C C*********************************************************************** C*** **** C*** VERTICAL RAY TIME CURVES **** C*** **** C*********************************************************************** C ELSE IF( QCPLOT .EQ. 'T' ) THEN CALL GCHAR( 'ONE-WAY VERTICAL RAY TIMES$', X, Y, HT(1) ) C Y1 = 0.5*( YMIN + YMAX ) - 4.0*HT(4) Y2 = 0.5*( YMIN + YMAX ) + 4.0*HT(4) C CALL GCHARA( 90 ) CALL GCHAR( 'TIME (MS)$', X1, Y1, HT(2) ) CALL GCHARA( 270 ) CALL GCHAR( 'TIME (MS)$', X2, Y2, HT(2) ) C ------------------------------------------- C C VERTICAL RAY TIME FROM AVERAGE SURFACE TO PSEUDO-DATUM C PEN = 0 CALL GWICOL( -10.0, 40 ) C DO 650 CDPN = 1, NCDPN T = CMODEL(CDPN,4) C IF( TMIN .LT. T .AND. T .LT. TMAX ) THEN X = XMIN + XSTEP*CDPNID(1,CDPN) Y = YMIN + YSCALE*( T - TMIN ) C CALL GVECT( X, Y, PEN ) PEN = 1 ELSE PEN = 0 ENDIF 650 CONTINUE C ------------------------------------------- C C VERTICAL RAY TIME FROM TRUE SURFACE TO PSEUDO-DATUM C PEN = 0 CALL GWICOL( -10.0, 21 ) C DO 675 CDPN = 1, NCDPN T = CMODEL(CDPN,1) C IF( TMIN .LT. T .AND. T .LT. TMAX ) THEN X = XMIN + XSTEP*CDPNID(1,CDPN) Y = YMIN + YSCALE*( T - TMIN ) C CALL GVECT( X, Y, PEN ) PEN = 1 ELSE PEN = 0 ENDIF 675 CONTINUE C CALL GVECT( X, Y, 0 ) CALL GWICOL( -1.0, 1 ) C C*********************************************************************** C*** **** C*** RESIDUAL ESTIMATES **** C*** **** C*********************************************************************** C ELSE IF( QCPLOT .EQ. 'D' ) THEN WRITE( RESLAB, 8000 ) NRESID CALL GCHAR( RESLAB, X, Y, HT(1) ) C X3 = X + 2.0*HT(5) C Y1 = YMAX - 1.5*HT(4) Y2 = YMAX - 3.0*HT(4) Y3 = YMAX - 4.5*HT(4) Y4 = YMAX - 6.0*HT(4) C CALL GCHARC( 4 ) CALL GCHAR( 'SHOT L$', X3, Y1, HT(2) ) CALL GCHARC( 5 ) CALL GCHAR( 'SHOT R$', X3, Y2, HT(2) ) CALL GCHARC( 2 ) CALL GCHAR( 'RECV L$', X3, Y3, HT(2) ) CALL GCHARC( 6 ) CALL GCHAR( 'RECV R$', X3, Y4, HT(2) ) CALL GCHARC( 1 ) C Y1 = 0.5*( YMIN + YMAX ) - 4.0*HT(4) Y2 = 0.5*( YMIN + YMAX ) + 4.0*HT(4) C CALL GCHARA( 90 ) CALL GCHAR( 'TIME (MS)$', X1, Y1, HT(2) ) CALL GCHARA( 270 ) CALL GCHAR( 'TIME (MS)$', X2, Y2, HT(2) ) C ------------------------------------------- C C SHOT LEFT C PEN = 0 CALL GWICOL( -10.0, 4 ) C DO 725 SHOT = 1, NSHOT T = SRESID(SHOT,1) C IF( TMIN .LT. T .AND. T .LT. TMAX ) THEN X = XMIN + XSTEP*SHOTID(1,SHOT) Y = YMIN + YSCALE*( T - TMIN ) C CALL GVECT( X, Y, PEN ) PEN = 1 ELSE PEN = 0 ENDIF 725 CONTINUE C ------------------------------------------- C C SHOT RIGHT C PEN = 0 CALL GWICOL( -10.0, 5 ) C DO 750 SHOT = 1, NSHOT T = SRESID(SHOT,2) C IF( TMIN .LT. T .AND. T .LT. TMAX ) THEN X = XMIN + XSTEP*SHOTID(1,SHOT) Y = YMIN + YSCALE*( T - TMIN ) C CALL GVECT( X, Y, PEN ) PEN = 1 ELSE PEN = 0 ENDIF 750 CONTINUE C ------------------------------------------- C C RECV LEFT C PEN = 0 CALL GWICOL( -10.0, 2 ) C DO 775 RECV = 1, NRECV T = RRESID(RECV,1) C IF( TMIN .LT. T .AND. T .LT. TMAX ) THEN X = XMIN + XSTEP*RECVID(1,RECV) Y = YMIN + YSCALE*( T - TMIN ) C CALL GVECT( X, Y, PEN ) PEN = 1 ELSE PEN = 0 ENDIF 775 CONTINUE C ------------------------------------------- C C RECV RIGHT C PEN = 0 CALL GWICOL( -10.0, 6 ) C DO 790 RECV = 1, NRECV T = RRESID(RECV,2) C IF( TMIN .LT. T .AND. T .LT. TMAX ) THEN X = XMIN + XSTEP*RECVID(1,RECV) Y = YMIN + YSCALE*( T - TMIN ) C CALL GVECT( X, Y, PEN ) PEN = 1 ELSE PEN = 0 ENDIF 790 CONTINUE C CALL GVECT( X, Y, 0 ) CALL GWICOL( -1.0, 1 ) ENDIF RETURN C C*********************************************************************** C*** **** C*** FORMAT STATEMENTS **** C*** **** C*********************************************************************** C 8000 FORMAT( 'MODEL RESIDUALS AFTER ',I2,' ITERATIONS$') END