CTITLE SACCNAC -- (UNIRAS) COLOR DISPLAY FOR CNAC C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA CA AUTHOR J.V.S. HARVEY CA LANGUAGE VS FORTRAN (77) FOR VECTORIZATION CA SYSTEM IBM ONLY CA REWRITTEN 14 DEC 1988 C REVISED 02-16-89 JJC FOR SPARC PRODUCTION. CA CA CA THIS SUBROUTINE DISPLAYS CNAC INFORMATION IN COLOR CA CA **************************************************************** CA *** NOTE: THIS ROUTINE REPLACES SACNX4 (SEE SACNAX) *** CA **************************************************************** CA CA CA USER UNITS: INCHES CA CA CHARACTER FONT: SIMPLEX CA CHARACTER COLOR: BLACK CA CHARACTER SPACING: 1.25*HEIGHT (CONSTANT) CA STRING TERMINATOR: $ CA CHARACTER ANGLE: 90 DEGREES CA CA THE COLOR SCALE IS DEFINED AS: CA 0-10 = DEFAULT UNIRAS PURE COLORS ( 1 FOR BLACK ) CA 11-31 = APPLICATION COLOR CODE SCALE CA CA--------------------------------------------------------------------- CA CA CALL SACCNAC( PLCODE, DSPFMT, MIDPCT, REMARK, CA PMODE, MIXPT1, MIXPT2, CA PLCLIP, PKCLIP, PKBALP, SPACIN, CA XMAX, YMAX, FRQSCL, VELSCL, CA NUMVEL, VELMIN, VELINC, VELMAX, CA NUMFRQ, FRQMIN, FRQINC, CA SPECTR, HICOHR, MXCOHR, CA PEAKVF, PKBFCN, PIKVEL, CA PLTWRK, DSNAME, ERR1, ERR2 ) CA CA CA IN/OUT ARGUMENT TYPE DESCRIPTION CA CA IN PLCODE CH4 PLOTTER DESTINATION CA 'META' = UNIRAS METAFILE CA 'VERC' = COLOR VERSATEC CA CA IN DSPFMT CH4 DISPLAY FORMAT CA 'ISOC' = ISOLINEAR CONTOUR (COLORED) CA 'COLR' = COLOR-CODED SQUARES CA 'INTC' = INTERPOLATED COLOR-CODED SQUARES CA CA IN MIDPCT I4 PERCENTILE AT MIDPOINT OF COLOR SCALE CA IN REMARK CH32 REMARKS TO BE PLOTTED CA CA CA IN PMODE CH4 PROCESSING MODE CA 'SHOT' = SHOTPOINT MODE CA 'CDPN' = DEPTHPOINT MODE CA 'XDST' = OFFSET MODE CA 'STAK' = STACKED (CDP) CA CA IN MIXPT1 I4 STARTING DEPTHPOINT OR SHOTPOINT CA IN MIXPT2 I4 ENDING DEPTHPOINT OR SHOTPOINT CA CA CA IN PLCLIP I4 PLOT CLIPPING LEVEL CA IN PKCLIP I4 PICK CLIPPING LEVEL CA CA IN PKBALP I4 PEAK-BALANCING CUTOFF CA CA IN SPACIN R4 TRACE SPACING (REF. FOR ALIAS LINES) CA CA CA IN XMAX, YMAX R4 MAXIMUM PLOT DIMENSIONS ( INCHES ) CA IN FRQSCL R4 FREQUENCY SCALE FACTOR ( IN. PER 100 HZ ) CA IN VELSCL R4 VELOCITY SCALE FACTOR ( IN. PER KFT/S ) CA CA CA IN NUMVEL I4 NUMBER OF VELOCITY LABELS CA IN VELMIN R4 MINIMUM VELOCITY LABEL CA IN VELINC R4 VELOCITY LABEL INCREMENT CA IN VELMAX R4 MAXIMUM VELOCITY LABEL CA CA CA IN NUMFRQ I4 NUMBER OF DISPLAY FREQUENCY SAMPLES CA IN FRQMIN R4 MINIMUM FREQUENCY LABEL CA IN FRQINC R4 FREQ-AXIS LABEL INCREMENT CA CA CA IN SPECTR R4 INPUT F-V SPECTRA CA ( 2-D ARRAY DIMENSIONED: NUMFRQ BY NUMVEL ) CA CA IN HICOHR R4 MAXIMUM COHERENCY FUNCTION CA ( 1-D ARRAY DIMENSIONED: NUMFRQ ) CA CA IN MXCOHR R4 MAXIMUM COHERENCY CA CA CA IN PEAKVF R4 VELOCITY FUNCTION FOR PEAKS CA ( 1-D ARRAY DIMENSIONED: NUMFRQ ) CA CA IN PKBFCN R4 PEAK-BALANCING GAIN FUNCTION CA ( 1-D ARRAY DIMENSIONED: NUMFRQ ) CA CA IN PIKVEL R4 PICKED VELOCITIES CA ( 1-D ARRAY DIMENSIONED: NUMFRQ ) CA CA CA WORK PLTWRK I2 WORK AREA (16384 HALFWORDS) CA CA CA OUT DSNAME CH44 NAME OF META-FILE ALLOCATED CA CA OUT ERR1 I4 ERROR CODE ('META' OPTION ONLY) CA 1 = NO ERROR CA 2 = INVALID DATA SET TYPE (FIRST CARD COL 40) CA 3 = SEISTRAN FILE ACCESS FAILURE CA 4 = LINE NAME BLANK ON LINE CARD. CA 5 = LINE NAME CONTAINS EMBEDDED BLANKS. CA 6 = LINE NAME INVALID CA 7 = INVALID PLOTTER CODE (FIRST CARD COL 76) CA 8 = SVC 99 ENVIRONMENTAL ERROR (SEE ERR2) CA 9 = SVC 99 INSTALLATION ERROR (SEE ERR2) CA 10 = SVC 99 PARAMETER ERROR (SEE ERR2) CA 11 = NOT USED CA 12 = DCB MEMORY ALLOCATION FAILURE CA 13 = NOT USED CA 14 = NOT USED CA 15 = DATA SET NAME ALL BLANKS. CA 16 = ZERO OR NEGATIVE NUMBER OF RECORDS CA 18 = INVALID BLOCKSIZE CA 19 = BLOCKSIZE/RECORD LENGTH MISMATCH CA 20 = BLOCKSIZE/RECORD LENGTH (SEISMIC). CA 21 = INVALID TYPE OF PLOT CA 22 = TSO USERID RETRIEVEL ERROR CA 23 = NO DATA CARDS FOR PROCESS. CA 24 = PLOTNO > KPDBGN & FAT'S EXIST. CA 25 = NOT USED CA 26 = OUTPUT TOO LARGE FOR INTERACTIVE CA 27 = INVALID RECORD COUNT CA 28 = INVALID BLOCKSIZE CA 29 = EXCESSIVE VOLUME COUNT CA CA OUT ERR2 I4 CODES FROM DYNAMIC ALLOCATION (SVC 99). CA ('META' OPTION ONLY) CA CA BYTES 1 AND 2 = ERROR CODE, CA BYTES 3 AND 4 = INFORMATION CODE. CA CA SEE IBM MANUAL GC28-0627-2, OS/VS2 MVS CA SYSTEM PROGRAMMING LIBRARY: CA JOB MANAGEMENT, PAGES 28 TO 31.0. CA CA********************************************************************** CA CA COMMON BLOCKS USED: / P / -- SPARC REFERENCE PARAMETERS CA CA KPDSNS MUST BE INITIALIZED CA -- PREFERRABLY TO KPIUSM -- CA BEFORE FIRST CALL TO SACCNAC CAEND C*********************************************************************** C C SUBROUTINES CALLED: SACNEWP -- PLOT INITIATION FOR UNIRAS C SACENDP -- END PLOT AND ADD TO PLOT QUEUE C C SACISOC -- ISOLINEAR CONTOURING OF A QUADRILATERAL C C GWICOL -- UNIRAS LINE COLOR AND WIDTH C GVECT -- UNIRAS POINT/LINE DRAWING C C GCHAR -- UNIRAS CHARACTER STRING PLOTTING C GCHARA -- UNIRAS CHARACTER PLOTTING ANGLE C GCHARC -- UNIRAS CHARACTER PLOTTING COLOR C GCHARJ -- UNIRAS CHARACTER JUSTIFICATION C GNUMB -- UNIRAS NUMERIC VALUE PLOTTING C C RSURF -- UNIRAS POLYGONAL FILL WITH COLOR C RRECT -- UNIRAS RECTANGULAR FILL WITH COLOR C C*********************************************************************** C SUBROUTINE SACCNAC( PLCODE, DSPFMT, MIDPCT, REMARK, * PMODE, MIXPT1, MIXPT2, * PLCLIP, PKCLIP, PKBALP, SPACIN, * XMAX, YMAX, FRQSCL, VELSCL, * NUMVEL, VELMIN, VELINC, VELMAX, * NUMFRQ, FRQMIN, FRQINC, * SPECTR, HICOHR, MXCOHR, * PEAKVF, PKBFCN, PIKVEL, * PLTWRK, DSNAME, ERR1, ERR2 ) IMPLICIT INTEGER (A-Z) C CHARACTER*4 PMODE CHARACTER*4 PLCODE CHARACTER*4 DSPFMT CHARACTER*32 REMARK C REAL SPACIN C REAL XMAX REAL YMAX REAL FRQSCL REAL VELSCL C REAL VELMIN REAL VELINC REAL VELMAX C REAL FRQMIN REAL FRQINC C REAL SPECTR(NUMFRQ,NUMVEL) REAL HICOHR(NUMFRQ) REAL MXCOHR C REAL PEAKVF(NUMFRQ) REAL PKBFCN(NUMFRQ) REAL PIKVEL(NUMFRQ) C INTEGER*2 PLTWRK(16384) C CHARACTER*44 DSNAME C---------------------------------------------------------------------- C C CHARACTER STRINGS -- LOCAL C CHARACTER*40 PROCNM(2) CHARACTER*40 CNALAB/'COHERENT NOISE DISPERSION ANALYSIS '/ CHARACTER*40 CNXLAB/' (CNAC) '/ C CHARACTER*16 CDPLAB /'00000 TO 00000$ '/ CHARACTER*20 PCTCLL /' . % TO . %$'/ C CHARACTER*40 PCLIPL /'VALUES BELOW **% OF MAXIMUM ARE CLIPPED$'/ CHARACTER*40 PPICKL /'PEAKS ABOVE **% OF MAXIMUM ARE PICKED $'/ CHARACTER*20 PKBLAB /'PEAK-BALANCED (00%)$'/ C CHARACTER*8 FREQHZ /'000.000$'/ CHARACTER*10 MAXLAB /'0.000E+00$'/ CHARACTER*28 TRCLAB /' (AT 000.000 FT/TRACE) $'/ C-------------------------------------------------------------------- C C MINIMUM RECOGNIZED AMPLITUDE FOR COHERENCE C REAL MINAMP PARAMETER ( MINAMP = 1.0E-20 ) C-------------------------------------------------------------------- C C FIXED CHARACTER PLOTTING HEIGHTS C REAL HT008, HT010, HT014 PARAMETER ( HT008 = 2.032, HT010 = 2.540, HT014 = 3.556 ) C-------------------------------------------------------------------- C C INTEGER ARRAYS -- LOCAL C INTEGER CYAN(21), MAGENT(21), YELLOW(21) C ------------------------------------------- C C REAL VARIABLES -- LOCAL C REAL WORKXC(999) REAL WORKYC(999) C REAL A, B, C REAL CLIP REAL CONSTA, COLOR0 REAL CVALUE REAL DELTAX REAL DELTAY REAL DDX, DDXH, DX REAL DDY, DDYH, DY REAL DXY REAL FREQ REAL P1, P2 REAL S REAL SSCALE REAL SJ REAL SK REAL SGJ REAL SGK REAL SPLINC REAL SPLMAX CCC REAL SPLMIN REAL SPJ REAL SPK REAL S1 REAL S2 REAL S3 REAL V, V1, V2, V3 REAL VSQ REAL WPJ REAL WPK REAL X, X1, X2, X3 REAL Y, Y1, Y2, Y3, Y4, Y5, Y6, Y7 REAL XSCALE REAL YSCALE REAL YSTART, YL REAL XSTART, XGRID1, XLASTG REAL X0 REAL XL1, XL2, XL3, XL4, XL5, YL1, YL2, DXL REAL XD1, XD2, XD3, XD4, XD5, YD1, YD2 C REAL S11, S12, S21, S22 REAL Y11, Y12, Y21, Y22 C REAL SQRT C C*********************************************************************** C*** **** C*** PLOTTER INITIALIZATION **** C*** **** C*********************************************************************** C C IN/OUT ARGUMENT TYPE DESCRIPTION C C IN KOLOR I4 ARCO-SPARC COLOR C 2 = RED C 3 = GREEN C 4 = DARK BLUE C 5 = CYAN C 6 = MAGENTA C 7 = YELLOW C 8 = ORANGE C 9 = YELLOW-GREEN C C 10 = AOGC BROWN C C IN PROCNM CH40 PROCESS DESCRIPTION (TWO LINES) C ( 1-D ARRAY DIMENSIONED: 2 ) C IN REMARK CH32 REMARKS C C IN PLCODE CH4 PLOTTER INITIALIZATION CODE C 'META' = PC G/GX METAFILE (BATCH) C 'VERC' = COLOR VERSATEC (BATCH ONLINE) C IN XMAX, YMAX R4 MAXIMUM PLOTTING LIMITS C C IN UNITS CH4 COORDINATE UNITS C 'INCH' = INCHES C 'MM. ' = MILLIMETERS C C IN CSFLAG CH4 COLOR SCALE OPTION C 'SEMB' = SEMBLANCE COLOR SCALE C 'REFR' = REFRACTION COLOR SCALES C IN NCOLOR I4 NUMBER OF COLORS TOTAL C 21 FOR SEMBLANCE COLOR SCALE C 30 FOR REFRACTION COLOR SCALES C C OUT CYAN I4 CYAN COLOR COMPONENTS PER COLOR C ( 1-D ARRAY DIMENSIONED: NCOLOR ) C OUT MAGENT I4 MAGENTA COLOR COMPONENTS PER COLOR C ( 1-D ARRAY DIMENSIONED: NCOLOR ) C OUT YELLOW I4 YELLOW COLOR COMPONENTS PER COLOR C ( 1-D ARRAY DIMENSIONED: NCOLOR ) C C OUT XL1 R4 X COORD. OF USER DOCUMENTATION LINE 1 OF 5 C OUT DXL R4 X SPACING OF USER DOCUMENTATION LINES C OUT YL1 R4 Y COORD. OF USER DOCUMENTATION COLUMN 1 C OUT YL2 R4 Y COORD. OF USER DOCUMENTATION COLUMN 2 C OUT HT R4 MAX. USER CHARACTER PLOTTING HEIGHT C C OUT X0 R4 STARTING X COORD. FOR APPLICATION DISPLAY 5 C C C OUT DSNAME CH44 NAME OF META-FILE ALLOCATED C ('META' OPTION ONLY) C C OUT ERR1 I4 ERROR CODE ('META' OPTION ONLY) C 1 = NO ERROR C 2 = INVALID DATA SET TYPE (FIRST CARD COL 40) C 3 = SEISTRAN FILE ACCESS FAILURE C 4 = LINE NAME BLANK ON LINE CARD. C 5 = LINE NAME CONTAINS EMBEDDED BLANKS. C 6 = LINE NAME INVALID C 7 = INVALID PLOTTER CODE (FIRST CARD COL 76) C 8 = SVC 99 ENVIRONMENTAL ERROR (SEE ERR2) C 9 = SVC 99 INSTALLATION ERROR (SEE ERR2) C 10 = SVC 99 PARAMETER ERROR (SEE ERR2) C 11 = NOT USED C 12 = DCB MEMORY ALLOCATION FAILURE C 13 = NOT USED C 14 = NOT USED C 15 = DATA SET NAME ALL BLANKS. C 16 = ZERO OR NEGATIVE NUMBER OF RECORDS C 18 = INVALID BLOCKSIZE C 19 = BLOCKSIZE/RECORD LENGTH MISMATCH C 20 = BLOCKSIZE/RECORD LENGTH (SEISMIC). C 21 = INVALID TYPE OF PLOT C 22 = TSO USERID RETRIEVEL ERROR C 23 = NO DATA CARDS FOR PROCESS. C 24 = PLOTNO > KPDBGN & FAT'S EXIST. C 25 = NOT USED C 26 = OUTPUT TOO LARGE FOR INTERACTIVE C 27 = INVALID RECORD COUNT C 28 = INVALID BLOCKSIZE C 29 = EXCESSIVE VOLUME COUNT C C OUT ERR2 I4 CODES FROM DYNAMIC ALLOCATION (SVC 99). C ('META' OPTION ONLY) C C BYTES 1 AND 2 = ERROR CODE, C BYTES 3 AND 4 = INFORMATION CODE. C C SEE IBM MANUAL GC28-0627-2, OS/VS2 MVS C SYSTEM PROGRAMMING LIBRARY: C JOB MANAGEMENT, PAGES 28 TO 31.0. C C ************************************* C C COMMON BLOCKS USED: / P / -- SPARC REFERENCE PARAMETERS C C KPDSNS MUST BE INITIALIZED C -- PREFERRABLY TO KPIUSM -- C BEFORE FIRST CALL TO SACNEWP C C ************************************* C PROCNM(1) = CNALAB PROCNM(2) = CNXLAB C CALL SACNEWP( 10, PROCNM, REMARK, * PLCODE, XMAX, 40.0, 'INCH', * 'SEMB', 21, CYAN, MAGENT, YELLOW, * XL1, DXL, YL1, YL2, HT, X0, * DSNAME, ERR1, ERR2 ) C====================================================================== C C OVERLAY PARAMETER DOCUMENTATION C XL2 = XL1 + DXL XL3 = XL2 + DXL XL4 = XL3 + DXL XL5 = XL4 + DXL CCC XL6 = XL5 + DXL C XD1 = XL1 - 0.03 XD2 = XD1 + DXL XD3 = XD2 + DXL XD4 = XD3 + DXL XD5 = XD4 + DXL CCC XD6 = XD5 + DXL C YD1 = YL1 + 2.75 YD2 = YL2 + 2.75 C ------------------------------------------- C C LEFT COLUMN LISTINGS C CCC CALL GCHARA( 90 ) CCC CALL GCHAR( 'NOMINAL FREQ STEP: $', XL1, YL1, HT010 ) CCC CALL GCHARA( 90 ) CCC CALL GNUMB( TIMRES, XD1, YD1, HT008, 1 ) CCC CALL GCHARA( 90 ) CCC CALL GCHAR( 'MS.$', XD1, YD1+0.7, HT008 ) C CCC CALL GCHARA( 90 ) CCC CALL GCHAR( 'NOMINAL VEL. STEP:$', XL2, YL1, HT010 ) CCC CALL GCHARA( 90 ) CCC CALL GNUMB( VELRES(1), XD2, YD1, HT008, 1 ) CCC CALL GCHARA( 90 ) CCC CALL GCHAR( 'TO$', XD2, YD1+0.7, HT008 ) CCC CALL GCHARA( 90 ) CCC CALL GNUMB( VELRES(2), XD2, YD1+1.2, HT008, 1 ) C ------------------------------------------- C C RIGHT COLUMN LISTINGS C CCC V1 = NUMVEL CCC CALL GCHARA( 90 ) CCC CALL GCHAR( 'NO. VELOC FUNC:$', XL1, YL2, HT010 ) CCC CALL GCHARA( 90 ) CCC CALL GNUMB( V1, XD1, YD2, HT008, 0 ) C CCC X = NUMFRQ CCC CALL GCHARA( 90 ) CCC CALL GCHAR( 'NUMBER SAMPLES: $', XL2, YL2, HT010 ) CCC CALL GCHARA( 90 ) CCC CALL GNUMB( X, XD2, YD2, HT008, 0 ) C C*********************************************************************** C*** **** C*** COLOR SCALE **** C*** **** C*********************************************************************** C IF( MIDPCT .NE. 50 ) THEN A = 0.50 - 0.01*MIDPCT B = 6.00 - 0.22*MIDPCT C = 5.50 - 0.21*MIDPCT ENDIF C Y1 = 11.0 Y2 = 11.4 Y3 = 11.5 C P1 = 0.0 - 5.0 X1 = 7.1 M = 11 C DO 315 I = 1, 21 X2 = X1 + 0.2 X3 = X1 + 0.1 C CALL RRECT( X1, Y1, X2, Y2, M, 0.1 ) C IF( I .EQ. 21 ) THEN P2 = 100.0 ELSE IF( MIDPCT .EQ. 50 ) THEN P2 = P1 + 5.0 ELSE P2 = ( A*I - B )*I + C ENDIF C CALL GCHARA( 90 ) C IF( I .EQ. 1 ) THEN CALL GCHAR( '(CLIPPED) 0.00%$', X3, Y3, HT008 ) ELSE WRITE( PCTCLL, 8010 ) P1, P2 C CALL GCHAR( PCTCLL, X3, Y3, HT008 ) C IF( I .EQ. 21 ) THEN CALL GCHARA( 90 ) CALL GCHAR( 'MAXIMUM$', X3, 16.1, HT008 ) C ELSE IF( I .EQ. 11 ) THEN CALL GCHARA( 90 ) CALL GCHAR( 'MIDPOINT$', X3, 16.1, HT008 ) ENDIF ENDIF C M = M + 1 X1 = X1 - 0.25 P1 = P2 315 CONTINUE C CALL GCHARA( 90 ) CALL GCHAR( '0$', 7.4, 13.9685, HT008 ) CALL GCHARA( 90 ) CALL GCHAR( '100%$', 7.4, 15.8435, HT008 ) C ------------------------------------------- C C DRAW (QUADRATIC) SCALING FUNCTION C CALL GWICOL( -5.0, 3 ) C X1 = 7.2 CALL GVECT( X1, 14.0, 0 ) C X2 = X1 P2 = 0.0 DO 325 I = 2, 21 X2 = X2 - 0.25 C IF( I .EQ. 21 ) THEN P2 = 100.0 ELSE IF( MIDPCT .EQ. 50 ) THEN P2 = P2 + 5.0 ELSE P2 = ( A*I - B )*I + C ENDIF Y = 14.0 + 0.02*P2 CALL GVECT( X2, Y, 1 ) 325 CONTINUE C CALL GWICOL( -5.0, 1 ) CALL GVECT( X2, 16.0, 0 ) CALL GVECT( X2, 14.0, 1 ) CALL GVECT( X1, 14.0, 1 ) CALL GVECT( X1, 16.0, 1 ) CALL GVECT( X2, 16.0, 1 ) C CALL GWICOL( -1.0, 1 ) CALL GVECT( X2, 15.5, 0 ) CALL GVECT( X1, 15.5, 1 ) CALL GVECT( X1, 15.0, 0 ) CALL GVECT( X2, 15.0, 1 ) CALL GVECT( X2, 14.5, 0 ) CALL GVECT( X1, 14.5, 1 ) C X = X1 - 0.25 DO 350 I = 2, 20, 2 CALL GVECT( X, 14.0, 0 ) CALL GVECT( X, 16.0, 1 ) X = X - 0.25 C CALL GVECT( X, 16.0, 0 ) CALL GVECT( X, 14.0, 1 ) X = X - 0.25 350 CONTINUE C C*********************************************************************** C*** **** C*** SCALING CONSTANTS **** C*** **** C*********************************************************************** C NSGRID = NUMFRQ CCC NSGRID = ( NUMFRQ - 1 )/FRQINC + 1 C XSCALE = 0.010*FRQSCL YSCALE = 0.001*VELSCL C VSQ = VELMIN*VELMAX C CCC SPLMIN = 1.0/VELMAX SPLMAX = 1.0/VELMIN SPLINC = VELINC/VSQ SSCALE = YSCALE*VSQ C DELTAX = XSCALE*FRQINC DELTAY = YSCALE*VELINC C XSTART = X0 + 2.5 XGRID1 = XSTART + DELTAX XLASTG = XGRID1 + DELTAX*( NSGRID + 1 ) C---------------------------------------------------------------------- C C CONSTANTS FOR NON-LINEAR COLOR SCALE C IF( MIDPCT .NE. 50 ) THEN CONSTA = 0.50 - 0.01*MIDPCT COLOR0 = 11.0 + ( 3.00 - 0.11*MIDPCT )/CONSTA ENDIF C CALL GCHARJ( 0 ) CALL GCHARC( 1 ) C---------------------------------------------------------------------- C C CLIPPING CONSTANTS C CLIP = 0.01*PLCLIP C IF( PLCLIP .GE. 5 ) THEN BACKGC = 11 ELSE BACKGC = 12 ENDIF C C*********************************************************************** C*** **** C*** MATRIX DESCRIPTIONS **** C*** **** C*********************************************************************** C C PLOT ANALYSIS POINT NUMBER (GREEN) C X = XSTART - 2.3 Y = 0.50 CALL GCHARA( 90 ) C IF( PMODE .EQ. 'SHOT' ) THEN CALL GCHAR( 'ANALYSIS SHOT$', X, Y, HT014 ) C ELSE IF( PMODE .EQ. 'CDPN' ) THEN CALL GCHAR( 'ANALYSIS CDPN$', X, Y, HT014 ) C ELSE IF( PMODE .EQ. 'STAK' ) THEN CALL GCHAR( 'ANALYSIS CDPN$', X, Y, HT014 ) C ELSE CALL GCHAR( 'ANALYSIS OFFSET$', X, Y, HT014 ) ENDIF C Y1 = Y + 2.50 C CALL GCHARA( 90 ) C IF( MIXPT1 .EQ. MIXPT2 ) THEN WRITE( CDPLAB, 8020 ) MIXPT1 ELSE WRITE( CDPLAB, 8025 ) MIXPT1, MIXPT2 ENDIF C CALL GCHAR( CDPLAB, X, Y1, HT014 ) C---------------------------------------------------------------------- C C TYPE OF AMPLITUDE (LIGHT BLUE) C DO 600 CTYPE = 1, 3 YSTART = Y C X = XSTART - 2.0 CALL GCHARC( 4 ) CALL GCHARA( 90 ) C IF( PKBALP .GE. 100 .OR. CTYPE .EQ. 1 ) THEN CALL GCHAR( 'TRUE AMPLITUDE$', X, Y, HT010 ) ELSE WRITE( PKBLAB, 8050 ) PKBALP C CALL GCHAR( ' AMPLITUDE$', X, Y, HT010 ) CALL GCHARC( 2 ) CALL GCHARA( 90 ) CALL GCHAR( PKBLAB, X, Y, HT010 ) CALL GCHARC( 4 ) ENDIF C ------------------------------------------- C C MAPPING MODE C X = X + 0.2 CALL GCHARA( 90 ) CALL GCHAR( 'PLOTTED LINEARLY VS. $', X, Y, HT010 ) CALL GCHARA( 90 ) C IF( CTYPE .EQ. 3 ) THEN CALL GCHARC( 8 ) CALL GCHAR( ' TIME DIP $', X, Y, HT010 ) ELSE CALL GCHARC( 1 ) CALL GCHAR( ' VELOCITY $', X, Y, HT010 ) ENDIF C CALL GCHARC( 4 ) C ------------------------------------------- C C CLIPPING PERCENT C WRITE( PCLIPL, 8075 ) PLCLIP C X = X + 0.2 CALL GCHARA( 90 ) CALL GCHAR( PCLIPL, X, Y, HT010 ) C ------------------------------------------- C C PICKING PERCENT C WRITE( PPICKL, 8080 ) PKCLIP C X = X + 0.2 CALL GCHARA( 90 ) CALL GCHAR( PPICKL, X, Y, HT010 ) C CALL GCHARC( 1 ) C C*********************************************************************** C*** **** C*** COLOR-CODED AMPLITUDE MAPPING **** C*** **** C*********************************************************************** C IF( DSPFMT .EQ. 'COLR' ) THEN X = XGRID1 X1 = X - 0.5*DELTAX X2 = X + 0.5*DELTAX C---------------------------------------------------------------------- C C COLOR IN BACKGROUND C DO 425 KF = 1, NUMFRQ V3 = VELMIN V2 = VELMAX C IF( CTYPE .LE. 2 ) THEN YD1 = YSCALE*( V3 - VELMIN ) + YSTART YD2 = YSCALE*( V2 - VELMIN ) + YSTART C ELSE S2 = 1.0/V2 S3 = 1.0/V3 C YD1 = SSCALE*( SPLMAX - S3 ) + YSTART YD2 = SSCALE*( SPLMAX - S2 ) + YSTART ENDIF C CALL RRECT( X1, YD1, X2, YD2, BACKGC, 0.0 ) C---------------------------------------------------------------------- C C COLOR IN NON-ZERO AMPLITUDE C KOLOR = BACKGC C V2 = VELMIN DO 420 JV = 1, NUMVEL V1 = V3 IF( V1 .LT. VELMIN ) V1 = VELMIN C ------------------------------------------- C C POSITION AND LENGTH OF BOX ALONG VELOCITY AXIS C IF( JV .LT. NUMVEL ) THEN V3 = V2 + 0.5*VELINC ELSE V3 = V2 ENDIF IF( V3 .GT. VELMAX ) V3 = VELMAX C IF( V3 .GT. V1 ) THEN IF( CTYPE .LE. 2 ) THEN Y1 = YSCALE*( V1 - VELMIN ) + YSTART Y2 = YSCALE*( V3 - VELMIN ) + YSTART C ELSE S1 = 1.0/V1 S3 = 1.0/V3 C Y1 = SSCALE*( SPLMAX - S1 ) + YSTART Y2 = SSCALE*( SPLMAX - S3 ) + YSTART ENDIF C ------------------------------------------- C C APPLY PEAK-BALANCING C IF( CTYPE .EQ. 1 .OR. PKBALP .GE. 100 ) THEN S = SPECTR(KF,JV)/MXCOHR C ELSE SK = SPECTR(KF,JV) SPK = PKBFCN(KF) C IF( SK .GE. SPK ) THEN S = 1.0 C ELSE WPK = MXCOHR/SPK SGK = SK + WPK*( SPK - SK ) C IF( SGK .LT. MINAMP ) S = 1.0 IF( SGK .GE. MINAMP ) S = SK/SGK ENDIF ENDIF C ------------------------------------------- C C COLOR CODE SPECIFICATION C IF( S .LT. CLIP ) THEN COLOR = 11 ELSE IF( S .GE. 1.0 ) THEN COLOR = 31 C ELSE IF( MIDPCT .EQ. 50 ) THEN COLOR = 12.0 + 20.0*S C ELSE B = 100.0*S - MIDPCT A = CONSTA*B + 6.25 C IF( A .LE. 0.0 ) THEN COLOR = COLOR0 ELSE COLOR = COLOR0 - SQRT( A )/CONSTA C IF( COLOR .LE. 11 .OR. COLOR .GE. 31 ) * COLOR = COLOR0 + SQRT( A )/CONSTA ENDIF ENDIF C IF( COLOR .GT. 31 ) COLOR = 31 IF( COLOR .LT. 11 ) COLOR = 11 C ------------------------------------------- C C COLOR IN RECTANGLE C IF( COLOR .NE. KOLOR .AND. * KOLOR .NE. BACKGC ) THEN CALL RRECT( X1, YD1, X2, YD2, KOLOR, 0.0 ) C KOLOR = COLOR YD1 = Y1 YD2 = Y2 C ELSE IF( COLOR .NE. KOLOR ) THEN KOLOR = COLOR YD1 = Y1 YD2 = Y2 C ELSE YD2 = Y2 ENDIF ENDIF C V2 = V2 + VELINC 420 CONTINUE C IF( COLOR .NE. BACKGC ) * CALL RRECT( X1, YD1, X2, YD2, COLOR, 0.0 ) C X1 = X2 X2 = X1 + DELTAX 425 CONTINUE C LCOLOR = 0 PCOLOR = 0 C C*********************************************************************** C*** **** C*** INTERPOLATED COLOR CODING **** C*** **** C*********************************************************************** C C Y11 = Y21 Y12 = Y22 C -------+---------------+--------- C | C | S11 S12 C X1 + X---------------X C | | | C | | | C | | | C X2 + X---------------X C | S21 S22 C | C C ELSE IF( DSPFMT .EQ. 'INTC' ) THEN X1 = XGRID1 X2 = XGRID1 + DELTAX C JF = 1 DO 450 KF = 2, NUMFRQ V2 = VELMIN C DO 445 JV = 1, NUMVEL IF( CTYPE .LE. 2 ) THEN Y22 = YSCALE*( V2 - VELMIN ) + YSTART C ELSE S2 = 1.0/V2 C Y22 = SSCALE*( SPLMAX - S2 ) + YSTART ENDIF C Y12 = Y22 C ------------------------------------------- C C APPLY PEAK-BALANCING (TO LOWER-RIGHT CORNER) C IF( CTYPE .EQ. 1 .OR. PKBALP .GE. 100 ) THEN S12 = SPECTR(JF,JV)/MXCOHR S22 = SPECTR(KF,JV)/MXCOHR C ELSE SJ = SPECTR(JF,JV) SPJ = PKBFCN(JF) C IF( SJ .GE. SPJ ) THEN S12 = 1.0 C ELSE WPJ = MXCOHR/SPJ SGJ = SJ + WPJ*( SPJ - SJ ) C IF( SGJ .LT. MINAMP ) S12 = 1.0 IF( SGJ .GE. MINAMP ) S12 = SJ/SGJ ENDIF C SK = SPECTR(KF,JV) SPK = PKBFCN(KF) C IF( SK .GE. SPK ) THEN S22 = 1.0 C ELSE WPK = MXCOHR/SPK SGK = SK + WPK*( SPK - SK ) C IF( SGK .LT. MINAMP ) S22 = 1.0 IF( SGK .GE. MINAMP ) S22 = SK/SGK ENDIF ENDIF C ------------------------------------------- C C BACKGROUND COLOR C IF( JV .GT. 1 ) THEN KOLOR = BACKGC C CALL RRECT( X1, Y11, X2, Y22, BACKGC, 0.0 ) C ------------------------------------------- C C INTERPOLATE CORNERS OF SMALL SQUARES C DX = ( X2 - X1 ) DY = ( Y22 - Y21 ) C DXY = DX*DY C DDX = 0.1*DX DDY = 0.1*DY C DDXH = 0.5*DDX DDYH = 0.5*DDY C DO 440 IXSTEP = 0, 10 X = X1 + IXSTEP*DDX C XD1 = X - DDXH XD2 = X + DDXH C IF( XD1 .LT. X1 ) XD1 = X1 IF( XD2 .GT. X2 ) XD2 = X2 C DO 430 IYSTEP = 0, 10 Y7 = Y11 + IYSTEP*DDY C Y1 = Y7 - DDYH Y2 = Y7 + DDYH C IF( Y1 .LT. Y11 ) Y1 = Y11 IF( Y2 .GT. Y22 ) Y2 = Y22 C ------------------------------------------- C C INTERPOLATE AMPLITUDE C S = S11*( X2 - X )*( Y22 - Y7 ) * + S12*( X2 - X )*( Y7 - Y11 ) * + S21*( X - X1 )*( Y22 - Y7 ) * + S22*( X - X1 )*( Y7 - Y11 ) S = S/DXY C ------------------------------------------- C C COLOR CODE SPECIFICATION C IF( S .LT. CLIP ) THEN COLOR = 11 ELSE IF( S .GE. 1.0 ) THEN COLOR = 31 C ELSE IF( MIDPCT .EQ. 50 ) THEN COLOR = 12.0 + 20.0*S C ELSE B = 100.0*S - MIDPCT A = CONSTA*B + 6.25 C IF( A .LE. 0.0 ) THEN COLOR = COLOR0 ELSE COLOR = COLOR0 - SQRT( A )/CONSTA C IF( COLOR .LE. 11 .OR. COLOR .GE. 31 ) * COLOR = COLOR0 + SQRT( A )/CONSTA ENDIF ENDIF C IF( COLOR .GT. 31 ) COLOR = 31 IF( COLOR .LT. 11 ) COLOR = 11 C ------------------------------------------- C C COLOR IN RECTANGLE C IF( COLOR .NE. KOLOR .AND. * KOLOR .NE. BACKGC ) THEN CALL RRECT( XD1, YD1, XD2, YD2, * KOLOR, 0.0 ) C KOLOR = COLOR YD1 = Y1 YD2 = Y2 C ELSE IF( COLOR .NE. KOLOR ) THEN KOLOR = COLOR YD1 = Y1 YD2 = Y2 C ELSE YD2 = Y2 ENDIF 430 CONTINUE C IF( COLOR .NE. BACKGC ) * CALL RRECT( XD1, YD1, XD2, YD2, COLOR, 0.0 ) C KOLOR = BACKGC 440 CONTINUE ENDIF C S11 = S12 S21 = S22 C Y11 = Y12 Y21 = Y22 C V2 = V2 + VELINC 445 CONTINUE C JF = KF C X1 = X2 X2 = X1 + DELTAX 450 CONTINUE C LCOLOR = 0 PCOLOR = 0 C C*********************************************************************** C*** **** C*** ISOLINEAR CONTOUR MAPPING **** C*** **** C*********************************************************************** C C IN/OUT ARGUMENT TYPE DESCRIPTION C C IN X1 R4 X COORDS OF SIDE A C IN Y11,Y12 R4 Y COORDS OF CORNERS ON SIDE A C IN S11,S12 R4 VALUES AT CORNERS ON SIDE A C C IN X2 R4 X COORDS OF SIDE C C IN Y21,Y22 R4 Y COORDS OF CORNERS ON SIDE C C IN S21,S22 R4 VALUES AT CORNERS ON SIDE C C C IN CVALUE R4 CONTOUR VALUE C IN COLOR I4 LINE COLOR CODE C C C Y11 Y21 Y12 Y22 C -------+-----+---------+-----+--- C | C | S11 SIDE A S12 C X1 + X---------------X C | \ \ C | SIDE D \ \ SIDE B C | \ \ C X2 + X---------------X C | S21 SIDE C S22 C | C C SIDES A AND C MUST BE PARALLEL AND NON-ZERO LENGTH C C ELSE IF( DSPFMT .EQ. 'ISOC' ) THEN X1 = XGRID1 X2 = XGRID1 + DELTAX C IF( MIDPCT .NE. 50 ) THEN A = 0.01*( 0.50 - 0.01*MIDPCT ) B = 0.01*( 6.00 - 0.22*MIDPCT ) C = 0.01*( 5.50 - 0.21*MIDPCT ) ENDIF C JF = 1 DO 475 KF = 2, NUMFRQ V2 = VELMIN C DO 470 JV = 1, NUMVEL IF( CTYPE .LE. 2 ) THEN Y22 = YSCALE*( V2 - VELMIN ) + YSTART C ELSE S2 = 1.0/V2 C Y22 = SSCALE*( SPLMAX - S2 ) + YSTART ENDIF C Y12 = Y22 C ------------------------------------------- C C APPLY PEAK-BALANCING (TO LOWER-RIGHT CORNER) C IF( CTYPE .EQ. 1 .OR. PKBALP .GE. 100 ) THEN S12 = SPECTR(JF,JV)/MXCOHR S22 = SPECTR(KF,JV)/MXCOHR C ELSE SJ = SPECTR(JF,JV) SPJ = PKBFCN(JF) C IF( SJ .GE. SPJ ) THEN S12 = 1.0 C ELSE WPJ = MXCOHR/SPJ SGJ = SJ + WPJ*( SPJ - SJ ) C IF( SGJ .LT. MINAMP ) S12 = 1.0 IF( SGJ .GE. MINAMP ) S12 = SJ/SGJ ENDIF C SK = SPECTR(KF,JV) SPK = PKBFCN(KF) C IF( SK .GE. SPK ) THEN S22 = 1.0 C ELSE WPK = MXCOHR/SPK SGK = SK + WPK*( SPK - SK ) C IF( SGK .LT. MINAMP ) S22 = 1.0 IF( SGK .GE. MINAMP ) S22 = SK/SGK ENDIF ENDIF C ------------------------------------------- C C DRAW VARIOUS CONTOUR CURVES WITHIN CURRENT QUADRILATERAL C IF( JV .GT. 1 ) THEN CVALUE = 0.0 C DO 460 COLOR = 13, 31 IF( MIDPCT .EQ. 50 ) THEN CVALUE = CVALUE + 0.05 ELSE IC = COLOR - 11 CVALUE = ( A*IC - B )*IC + C ENDIF C IF( CVALUE .GE. CLIP ) THEN CALL SACISOC( X1, Y11, S11, Y12, S12, * X2, Y21, S21, Y22, S22, * CVALUE, COLOR ) ENDIF 460 CONTINUE ENDIF C S11 = S12 S21 = S22 C Y11 = Y12 Y21 = Y22 C V2 = V2 + VELINC 470 CONTINUE C JF = KF C X1 = X2 X2 = X1 + DELTAX 475 CONTINUE C LCOLOR = 8 PCOLOR = 5 ENDIF C C*********************************************************************** C*** **** C*** OVERLAY REFERENCE FREQ-VELOCITY GRID **** C*** **** C*********************************************************************** C IF( CTYPE .LE. 2 ) V = VELMIN IF( CTYPE .GT. 2 ) S = SPLMAX*1000.0 C J = 10 DO 525 IV = 1, NUMVEL IF( IV .EQ. NUMVEL ) J = 10 C ------------------------------------------- C C SLOWNESS (OR VELOCITY) ESTIMATES C IF( CTYPE .LE. 2 ) S = 1000.0/V IF( CTYPE .GT. 2 ) V = 1000.0/S C SGK = S*SPACIN C ------------------------------------------- C C ANNOTATE UPPER AXIS (VELOCITY OR SLOWNESS) C IF( J .GE. 10 .OR. IV .EQ. NUMVEL ) THEN X1 = XSTART - 0.2 X2 = XSTART + 0.50*DELTAX C CALL GNUMB( V, XSTART-0.9, Y-0.07, HT010, 0 ) C ELSE IF( J .EQ. 5 ) THEN X1 = XSTART - 0.2 X2 = XSTART + 0.25*DELTAX C ELSE X1 = XSTART - 0.1 X2 = XSTART + 0.15*DELTAX ENDIF C CALL GVECT( X1, Y, 0 ) CALL GVECT( X2, Y, 1 ) C ------------------------------------------- C C PLOT MAIN GRID C Y1 = Y - 0.15*DELTAY Y2 = Y + 0.15*DELTAY C IF( IV .EQ. 1 ) Y1 = Y IF( IV .EQ. NUMVEL ) Y2 = Y C X = XGRID1 DO 520 KF = 1, NSGRID IF( J .EQ. 10 ) THEN X1 = X - 0.50*DELTAX X2 = X + 0.50*DELTAX ELSE IF( J .EQ. 5 ) THEN X1 = X - 0.25*DELTAX X2 = X + 0.25*DELTAX ELSE X1 = X - 0.15*DELTAX X2 = X + 0.15*DELTAX ENDIF C IF( PLCODE .NE. 'META' ) THEN CALL GVECT( X1, Y, 0 ) CALL GVECT( X2, Y, 1 ) C CALL GVECT( X, Y1, 0 ) CALL GVECT( X, Y2, 1 ) ENDIF C X = X + DELTAX 520 CONTINUE C ------------------------------------------- C C ANNOTATE LOWER AXIS (VELOCITY OR SLOWNESS) C IF( J .EQ. 10 ) THEN J = 0 X = XLASTG + 0.3 C WRITE( FREQHZ, 8100 ) S C CALL GCHARC( 8 ) CALL GCHAR( FREQHZ, X, Y-0.07, HT010 ) CCC CALL GNUMB( V, X, Y-0.07, HT010, 0 ) C X = X + 1.75 C WRITE( FREQHZ, 8100 ) SGK C CALL GCHARC( 3 ) CALL GCHAR( FREQHZ, X, Y-0.07, HT010 ) CALL GCHARC( 1 ) C X1 = XLASTG - 0.50*DELTAX X2 = XLASTG + 0.2 C ELSE IF( J .EQ. 5 ) THEN X1 = XLASTG - 0.25*DELTAX X2 = XLASTG + 0.2 C ELSE X1 = XLASTG - 0.15*DELTAX X2 = XLASTG + 0.1 ENDIF C CALL GVECT( X1, Y, 0 ) CALL GVECT( X2, Y, 1 ) C IF( IV .LT. NUMVEL ) Y = Y + DELTAY C IF( CTYPE .LE. 2 ) V = V + VELINC IF( CTYPE .GT. 2 ) S = S - SPLINC*1000.0 J = J + 1 525 CONTINUE C====================================================================== C C LABEL LOWER VELOCITY AXIS C X = XLASTG + 1.75 YL = 0.5*( Y + YSTART ) - 1.6875 C CALL GCHARC( 8 ) CALL GCHARA( 90 ) CALL GCHAR( ' TIME DIP IN MS/FT $', X, YL, HT010 ) X = X + 0.15 CALL GCHARA( 90 ) CALL GCHAR( ' (1/PHASE VELOCITY) $', X, YL, HT010 ) C X = X + 1.60 CALL GCHARC( 3 ) CALL GCHARA( 90 ) CALL GCHAR( ' TIME DIP IN MS/TRACE $', X, YL, HT010 ) C WRITE( TRCLAB, 8300 ) SPACIN C X = X + 0.15 CALL GCHARA( 90 ) CALL GCHAR( TRCLAB, X, YL, HT010 ) C ------------------------------------------- C C DRAW LABELLING AXIS TIC MARKS C L1 = FRQMIN FREQ = L1 IF( FREQ .LT. FRQMIN ) L1 = L1 + 1 C L2 = FRQMIN + ( NUMFRQ - 1 )*FRQINC C CALL GWICOL( -5.0, 5 ) C Y1 = Y + 0.15 DO 540 KF = L1, L2 X = XGRID1 + ( KF - FRQMIN )*XSCALE C CALL GVECT( X, Y, 0 ) CALL GVECT( X, Y1, 1 ) 540 CONTINUE C CALL GWICOL( -1.0, 1 ) C ------------------------------------------- C C LABEL FREQUENCY AXIS C L1 = 0.2*FRQMIN FREQ = 5.0*L1 IF( FREQ .LT. FRQMIN ) L1 = L1 + 1 C L2 = 0.2*( FRQMIN + ( NUMFRQ - 1 )*FRQINC ) C CALL GCHARC( 5 ) CALL GCHARJ( 3 ) C Y2 = Y + 0.10 DO 550 KF = L1, L2 FREQ = KF*5.0 X = XGRID1 + ( FREQ - FRQMIN )*XSCALE C WRITE( FREQHZ, 8100 ) FREQ C CALL GCHARA( 90 ) CALL GCHAR( FREQHZ, X, Y2, HT010 ) 550 CONTINUE C CALL GCHARJ( 0 ) CALL GCHAR( 'FREQ. (HZ):$', XSTART-1.50, Y+0.45, HT010 ) CALL GCHARC( 1 ) C ------------------------------------------- C C LABEL UPPER VELOCITY AXIS C X = XSTART - 1.1 CALL GCHARA( 90 ) CALL GCHAR( 'PHASE VELOCITY IN FEET/SEC.$', X, YL, HT010 ) C---------------------------------------------------------------------- C C DRAW BOX AROUND AMPLITUDE MAP C CALL GWICOL( -2.0, 1 ) C CALL GVECT( XSTART, Y, 0 ) CALL GVECT( XSTART, YSTART, 1 ) CALL GVECT( XLASTG, YSTART, 1 ) CALL GVECT( XLASTG, Y, 1 ) CALL GVECT( XSTART, Y, 1 ) C CCC CALL GWICOL( -1.0, 1 ) C C*********************************************************************** C*** **** C*** PEAK INDICATORS **** C*** **** C*********************************************************************** C CALL GCHARC( PCOLOR ) CALL GCHARJ( 4 ) C X2 = XGRID1 FREQ = FRQMIN C DO 570 KF = 1, NUMFRQ V = PEAKVF(KF) C IF( CTYPE .LE. 2 ) THEN Y2 = YSTART + YSCALE*( V - VELMIN ) C ELSE S = 1.0/V C Y2 = YSTART + SSCALE*( SPLMAX - S ) ENDIF C CALL GCHAR( '*$', X2, Y2, HT008 ) C FREQ = FREQ + FRQINC X2 = X2 + DELTAX 570 CONTINUE C CALL GCHARJ( 0 ) CALL GCHARC( 1 ) C C*********************************************************************** C*** **** C*** ALIAS REFERENCE LINES **** C*** **** C*********************************************************************** C CALL GWICOL( -5.0, LCOLOR ) C DO 575 KK = 1, 2 X2 = XGRID1 PEN = 0 FREQ = FRQMIN C DO 575 KF = 1, NUMFRQ V = KK*FREQ*SPACIN C IF( VELMIN .LE. V .AND. V .LE. VELMAX ) THEN IF( CTYPE .LE. 2 ) THEN Y2 = YSTART + YSCALE*( V - VELMIN ) C ELSE S = 1.0/V C Y2 = YSTART + SSCALE*( SPLMAX - S ) ENDIF C CALL GVECT( X2, Y2, PEN ) PEN = 1 ENDIF C FREQ = FREQ + FRQINC X2 = X2 + DELTAX 575 CONTINUE C CALL GWICOL( -1.0, 1 ) C Y = Y + 1.25 600 CONTINUE C C*********************************************************************** C*** **** C*** MAXIMUM AMPLITUDE TRACES **** C*** **** C*********************************************************************** C X1 = XSTART - 0.7 X2 = XSTART - 0.3 C Y1 = Y + 0.16 C CALL GCHARC( 4 ) CALL GCHARA( 90 ) CALL GCHAR( ' MAXIMUM $', X1, Y1, HT010 ) CALL GCHARA( 90 ) CALL GCHAR( 'AMPLITUDE$', X2, Y1, HT010 ) C X = XSTART - 1.25 Y1 = Y - 0.07 Y2 = Y + 1.43 C WRITE( MAXLAB, 8200 ) MXCOHR C CALL GCHAR( '0.000E+00$', X, Y1, HT010 ) CALL GCHAR( MAXLAB, X, Y2, HT010 ) CALL GCHARC( 1 ) C IF( MXCOHR .GT. 0.001 ) THEN C = 1.50/MXCOHR C Y1 = Y + 0.375 Y2 = Y + 0.750 Y3 = Y + 1.125 Y4 = Y + 1.500 C ------------------------------------------- C C DRAW REFERENCE LINES C CALL GVECT( XSTART, Y1, 0 ) CALL GVECT( XLASTG, Y1, 1 ) C CALL GVECT( XLASTG, Y2, 0 ) CALL GVECT( XSTART, Y2, 1 ) C CALL GVECT( XSTART, Y3, 0 ) CALL GVECT( XLASTG, Y3, 1 ) C ------------------------------------------- C C COLOR IN PEAK-BALANCING CORRECTION (RED) C IF( PKBALP .LT. 100 ) THEN X = XGRID1 N = 0 DO 625 KF = 1, NUMFRQ N = N + 1 WORKXC(N) = X WORKYC(N) = Y + C*PKBFCN(KF) C IF( N .EQ. 1 ) THEN X1 = X C ELSE IF( N .EQ. 997 ) THEN WORKXC(998) = X WORKYC(998) = Y4 C WORKXC(999) = X1 WORKYC(999) = Y4 C CALL RSURF( WORKXC, WORKYC, 999, 2, 0.0 ) N = 0 C ELSE X2 = X ENDIF C X = X + DELTAX 625 CONTINUE C IF( N .GT. 1 ) THEN N = N + 1 WORKXC(N) = X2 WORKYC(N) = Y4 C N = N + 1 WORKXC(N) = X1 WORKYC(N) = Y4 C CALL RSURF( WORKXC, WORKYC, N, 2, 0.0 ) ENDIF ENDIF C ------------------------------------------- C C COLOR IN MAXIMUM DEFLECTION (BLUE) C X = XGRID1 C N = 0 DO 650 KF = 1, NUMFRQ N = N + 1 WORKXC(N) = X WORKYC(N) = Y + C*HICOHR(KF) C IF( N .EQ. 1 ) THEN X1 = X C ELSE IF( N .EQ. 997 ) THEN WORKXC(998) = X WORKYC(998) = Y C WORKXC(999) = X1 WORKYC(999) = Y C CALL RSURF( WORKXC, WORKYC, 999, 4, 0.0 ) N = 0 C ELSE X2 = X ENDIF C X = X + DELTAX 650 CONTINUE C IF( N .GT. 1 ) THEN N = N + 1 WORKXC(N) = X2 WORKYC(N) = Y C N = N + 1 WORKXC(N) = X1 WORKYC(N) = Y C CALL RSURF( WORKXC, WORKYC, N, 4, 0.0 ) ENDIF C ------------------------------------------- C C PLOT BOX C CALL GWICOL( -5.0, 1 ) C CALL GVECT( XLASTG, Y, 0 ) CALL GVECT( XLASTG, Y4, 1 ) CALL GVECT( XSTART, Y4, 1 ) CALL GVECT( XSTART, Y, 1 ) CALL GVECT( XLASTG, Y, 1 ) C CALL GWICOL( -1.0, 1 ) C---------------------------------------------------------------------- C C REFERENCE NUMBERS C X = XSTART - 2.50 C Y1 = Y + 4.75 Y2 = Y + 4.60 Y3 = Y + 3.75 Y4 = Y + 3.60 Y5 = Y + 2.75 Y6 = Y + 2.60 Y7 = Y + 1.85 C CALL GCHARC( 3 ) CALL GCHAR( 'TIME DIPS FOR PEAKS:$', X, Y1, HT010 ) CALL GCHAR( ' (MS/TRACE) $', X, Y2, HT008 ) CALL GCHARC( 8 ) CALL GCHAR( 'TIME DIPS FOR PEAKS:$', X, Y3, HT010 ) CALL GCHAR( ' (MS/FT) $', X, Y4, HT008 ) CALL GCHARC( 1 ) CALL GCHAR( 'VELOCITIES OF PEAKS:$', X, Y5, HT010 ) CALL GCHAR( ' (FT/SEC) $', X, Y6, HT008 ) CALL GCHARC( 5 ) CALL GCHAR( 'FREQ. (HZ) OF PEAK: $', X, Y7, HT010 ) C CALL GCHARJ( 3 ) C Y1 = Y + 1.60 Y2 = Y + 2.60 Y3 = Y + 3.60 Y4 = Y + 4.60 C X = XGRID1 C ------------------------------------------- C C FREQUENCY (BLUE) C FREQ = FRQMIN DO 690 KF = 1, NUMFRQ V = PIKVEL(KF) C IF( V .GT. 0.0 ) THEN CALL GCHARC( 5 ) CALL GCHARA( 90 ) CALL GNUMB( FREQ, X, Y1, HT010, 3 ) C ------------------------------------------- C C VELOCITIES (BLACK) C CALL GCHARC( 1 ) CALL GCHARA( 90 ) CALL GNUMB( V, X, Y2, HT010, 0 ) C ------------------------------------------- C C SLOWNESS ESTIMATES (ORANGE AND GREEN) C S = 1000.0/V SGK = S*SPACIN C CALL GCHARC( 8 ) CALL GCHARA( 90 ) CALL GNUMB( S, X, Y3, HT010, 3 ) C CALL GCHARC( 3 ) CALL GCHARA( 90 ) CALL GNUMB( SGK, X, Y4, HT010, 3 ) ENDIF C FREQ = FREQ + FRQINC X = X + DELTAX 690 CONTINUE C CALL GCHARJ( 0 ) CALL GCHARC( 1 ) ENDIF C C*********************************************************************** C*** **** C*** END OF PLOT **** C*** **** C*********************************************************************** C C CLOSE UINRAS PLOT FILE C AND ADD PLOT TO OUTPUT QUEUE C C IN/OUT ARGUMENT TYPE DESCRIPTION C C IN PLCODE CH4 PLOTTER INITIALIZATION CODE C 'META' = UNIRAS METAFILE C 'VERC' = COLOR VERSATEC C IN YMAX R4 MAXIMUM PLOTTING LIMIT (Y-AXIS) C C IN PLTNUM I4 PLOT SEQUENCE NUMBER (1 FOR FIRST PLOT) C IN NUMPLT I4 TOTAL NUMBER OF PLOTS C C C IN/OUT DSNAME CH44 NAME OF META-FILE ALLOCATED C (IN: 'META' OPTION ONLY) C (OUT: 'VERC' OPTION ONLY) C C WORK PLTWRK I2 WORK AREA (16384 HALFWORDS) C C C OUT ERR1 I4 ERROR CODE. C 1 = NO ERROR C 2 = INVALID DATA SET TYPE (FIRST CARD COL 40) C 3 = SEISTRAN FILE ACCESS FAILURE C 4 = LINE NAME BLANK ON LINE CARD. C 5 = LINE NAME CONTAINS EMBEDDED BLANKS. C 6 = LINE NAME INVALID C 7 = INVALID PLOTTER CODE (FIRST CARD COL 76) C 8 = SVC 99 ENVIRONMENTAL ERROR (SEE ERR2) C 9 = SVC 99 INSTALLATION ERROR (SEE ERR2) C 10 = SVC 99 PARAMETER ERROR (SEE ERR2) C 11 = NOT USED C 12 = DCB MEMORY ALLOCATION FAILURE C 13 = NOT USED C 14 = NOT USED C 15 = DATA SET NAME ALL BLANKS. C 16 = ZERO OR NEGATIVE NUMBER OF RECORDS C 18 = INVALID BLOCKSIZE C 19 = BLOCKSIZE/RECORD LENGTH MISMATCH C 20 = BLOCKSIZE/RECORD LENGTH (SEISMIC). C 21 = INVALID TYPE OF PLOT C 22 = TSO USERID RETRIEVEL ERROR C 23 = NO DATA CARDS FOR PROCESS. C 24 = PLOTNO > KPDBGN & FAT'S EXIST. C 25 = NOT USED C 26 = OUTPUT TOO LARGE FOR INTERACTIVE C 27 = INVALID RECORD COUNT C 28 = INVALID BLOCKSIZE C 29 = EXCESSIVE VOLUME COUNT C C 102 = SVC 99 ENVIRONMENTAL ERROR (SEE ERR2) C 103 = SVC 99 INSTALLATION ERROR (SEE ERR2) C 104 = SVC 99 PARAMETER ERROR (SEE ERR2) C 105 = ATTEMPT TO CLOSE DATA SET FAILED. C 107 = DCB AREA NOT RELEASED BY FREEMAIN. C 108 = DDNAME IN DCB IS ALL BLANKS. C C C OUT ERR2 I4 CODES FROM DYNAMIC ALLOCATION (SVC 99). C BYTES 1 AND 2 = ERROR CODE, C BYTES 3 AND 4 = INFORMATION CODE. C C SEE IBM MANUAL GC28-0627-2, OS/VS2 MVS C SYSTEM PROGRAMMING LIBRARY: C JOB MANAGEMENT, PAGES 28 TO 31.0. C PLTNUM = 1 QUANT = 1 C CALL SACENDP( PLCODE, YMAX, PLTNUM, QUANT, DSNAME, * PLTWRK, ERR1, ERR2 ) RETURN C C*********************************************************************** C*** **** C*** FORMAT STATEMENTS **** C*** **** C*********************************************************************** C 8010 FORMAT(F5.2,'% TO ',F6.2,'%$') 8020 FORMAT(I5,'$ ') 8025 FORMAT(I5,' TO ',I5,'$ ') C 8050 FORMAT('PEAK-BALANCED (',I2,'%)$') 8075 FORMAT('VALUES BELOW ',I2,'% OF MAXIMUM ARE CLIPPED$') 8080 FORMAT('PEAKS ABOVE ',I2,'% OF MAXIMUM ARE PICKED $') C 8100 FORMAT(F7.3,'$') 8200 FORMAT(E9.3,'$') 8300 FORMAT(' (AT ',F7.3,' FT/TRACE) $') END