C 00000000 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** C NOTE - THERE ARE ONLY 34 CONTOUR LEVELS USED, THEY ARE HARDWIRDED 00000100 C STATIC VALUES. 00000200 C 00000300 C 00000400 C 00000500 C 00000600 CTITLESASP3D -- COLOR PLOTTING PROGRAM 00000700 C 00000800 CA AUTHOR DANIEL POLAK 00000900 CA DESIGNER DANIEL POLAK 00001000 CA LANGUAGE FORTRAN H / APPLICON 00001100 CA SYSTEM S / 370 00001200 CA WRITTEN 03-11-81 00001300 C REVISED 06-18-84 GRAY - MODIFIED TO USE UNIRAS PLOTTING 00001400 C SUBROUTINES INSTEAD OF APPLICON. 00001500 C 00001600 C REVISED MO-DA-YR BY PROGRAMMER FOR REASON. 00001700 CA 00001800 CA 00001900 CA CALL SASP3D (ZIN, NPX, NPY, ZCLASS, NCLZ, ICOLOR, TEXT, SXCOR, 00002000 CA SYCOR, SHTNUM, NSHOT, MINX, MINY, XDIF, YDIF, 00002100 CA MNXINC, MNYINC, NTHETA, LBLFLG, KPBUGF) 00002200 CA 00002300 CA IN/OUT ARGUMENT TYPE DESCRIPTION 00002400 CA IN ZIN R4 MATRIX OF STATIC VALUES TO PLOT 00002500 CA IN NPX I4 NUMBER TO PLOT IN X DIRECTION 00002600 CA IN NPY I4 NUMBER TO PLOT IN Y DIRECTION 00002700 CA IN ZCLASS R4 BREAK POINTS OF COLORS 00002800 CA IN NCLZ I4 NUMBER OF BREAK POINTS 00002900 CA IN ICOLOR I4 COLOR CODES TO PLOT 00003000 CA IN TEXT I4 TEXT STRING FOR LABEL 00003100 CA IN SXCOR I4 SHOTPOINT X-COORDINATES 00003200 CA IN SYCOR I4 SHOTPOINT Y-COORDINATES 00003300 CA IN SHTNUM I4 SHOTPOINT NUMBERS 00003400 CA IN NSHOT I4 NUMBER OF SHOTPOINTS 00003500 CA IN MINX I4 MINIMUM X-COORDINATE 00003600 CA IN MINY I4 MINIMUM Y-COORDINATE 00003700 CA IN XDIF I4 DIFFERENCE BETWEEN LARGEST AND SMALLEST 00003800 CA X-COORDINATES 00003900 CA IN YDIF I4 DIFFERENCE BETWEEN LARGEST AND SMALLEST 00004000 CA Y-COORDINATES 00004100 CA IN MNXINC I4 MINIMUM INCREMENT BETWEEN X-COORDINATES 00004200 CA IN MNYINC I4 MINIMUM INCREMENT BETWEEN Y-COORDINATES 00004300 CA IN NTHETA I4 ANNOTATION ANGLE FOR SHOTPOINT NUMBERS 00004400 CA IN LBLFLG I4 LABEL RECEIVER STATICS PLOT FLAG 00004500 CA IN KPBUGF I4 KP DEBUG VARIABLE 00004600 CA 00004700 CA 00004800 CA THIS SUBROUTINE PRODUCES A GRID PLOT OF 3-D SURFACE CONSISTENT 00004900 CA RECEIVER OR SHOT STATICS USING APPLICON COLOR PROGRAMS. THE 00005000 CA SHOTPOINTS ARE LABELED WITH THE SHOTPOINT NUMBERS. ALSO, PLOTTED 00005100 CA ARE COORDINATE AXES, SCALE FACTORS FOR EACH AXIS, A COLOR SCALE, 00005200 CA AND A TITLE. 00005300 CA 00005400 CAEND 00005500 C EJECT 00005600 C 00005700 C LOCAL OR INTERNAL ARRAYS 00005800 C 00005900 C NAME TYPE DESCRIPTION 00006000 C FTPRIN (4) I4 FEET PER INCH SCALE LABEL 00006100 C SIZVER (6) R4 VERTICAL SIZE OF TEXT POSSIBLE 00006200 C TEXTSP (2) I4 TEXT FOR SHOTPOINT NUMBER LABEL 00006300 C XTEXT (4) I4 X-AXIS LABEL 00006400 C YTEXT (4) I4 Y-AXIS LABEL 00006500 C KOLC (40) I4 CYAN COLOR TABLE 00006600 C KOLM (40) I4 MAGENTA COLOR TABLE 00006700 C KOLY (40) I4 YELLOW COLOR TABLE 00006800 C KOLNDX (40) I4 COLOR INDEX ARRAY 00006900 C 00007000 C 00007100 C 00007200 C 00007300 C 00007400 C 00007500 C LOCAL OR INTERNAL VARIABLES AND CONSTANTS 00007600 C 00007700 C NAME TYPE DESCRIPTION 00007800 C NX I4 NUMBER OF 0.8 MILLIMETER POINTS IN X DIRECTION 00007900 C NY I4 NUMBER OF 0.8 MILLIMETER POINTS IN Y DIRECTION 00008000 C XK R4 X COORDINATE FOR SHOTPOINT NUMBER LABEL 00008100 C X0 R4 INITIAL X COORDINATE FOR PLOT TITLE 00008200 C YK R4 Y COORDINATE FOR SHOTPOINT NUMBER LABEL 00008300 C Y0 R4 INITIAL Y COORDINATE FOR PLOT TITLE 00008400 C INK I4 COLOR CODE (BLACK) FOR SHOTPOINT NUMBER LABEL 00008500 C LEN I4 USED TO COMPUTE LENGTH OF LABEL 00008600 C NUM I4 SHOTPOINT NUMBER 00008700 C INDX I4 INDEX TO TEXTSP FOR INSERTION OF $ SIGN 00008800 C BLANK I4 CHARACTER STRING ' ' 00008900 C NSQRS I4 NUMBER OF SQUARES IN SCALE 00009000 C SCALE I4 PLOT SCALE 00009100 C XFRAC R4 FRACTION TO REDUCE X-COORDINATES TO WITHIN PLOT GRID00009200 C XORIG R4 X ORIGIN OF PLOT 00009300 C XSTEP R4 STEP INTERVAL FOR LABELING HORIZONTAL AXIS 00009400 C YORIG R4 Y ORIGIN OF PLOT 00009500 C YSTEP R4 STEP INTERVAL FOR LABELING VERTICAL AXIS 00009600 C INTOMM R4 INCHES TO MILLIMETERS CONVERSION FACTOR 00009700 C SIZETX R4 VERTICAL SIZE OF TEXT FOR LABELING 00009800 C SPACEH R4 ALLOWED HORIZONTAL SPACE - 800.0 MM. 00009900 C SPACEV R4 ALLOWED VERTICAL SPACE - 500.0 MM. 00010000 C XSTART R4 FIRST VALUE TO LABEL HORIZONTAL AXIS 00010100 C YSTART R4 FIRST VALUE TO LABEL VERTICAL AXIS 00010200 C 00010300 C EJECT 00010400 C 00010500 SUBROUTINE SASP3D (ZIN, NPX, NPY, ZCLASS, NCLZ, ICOLOR, TEXT, 00010600 * SXCOR, SYCOR, SHTNUM, NSHOT, MINX, MINY, XDIF, 00010700 * YDIF, MNXINC, MNYINC, NTHETA, LBLFLG, KPBUGF) 00010800 C 00010900 IMPLICIT INTEGER (A-Z) 00011000 C 00011100 C REAL ARRAYS IN PARAMETER LIST 00011200 C 00011300 REAL ZIN (NPX, NPY) 00011400 REAL ZCLASS (1) 00011500 C 00011600 C INTEGER ARRAYS IN PARAMETER LIST 00011700 C 00011800 INTEGER ICOLOR ( 1) 00011900 INTEGER SHTNUM (NSHOT) 00012000 INTEGER SXCOR (NSHOT) 00012100 INTEGER SYCOR (NSHOT) 00012200 INTEGER TEXT ( 24) 00012300 C 00012400 C INTEGER ARRAYS -- LOCAL 00012500 C 00012600 INTEGER TEXTSP ( 2) 00012700 INTEGER XTEXT ( 4) /'X-CO', 'ORDI', 'NATE', 'S $ '/ 00012800 INTEGER YTEXT ( 4) /'Y-CO', 'ORDI', 'NATE', 'S $ '/ 00012900 INTEGER FTPRIN ( 4) /'FT/I', 'N ', ' ', ' $ '/ 00013000 INTEGER KOLY ( 40) 00013100 INTEGER KOLM ( 40) 00013200 INTEGER KOLC ( 40) 00013300 INTEGER KOLNDX ( 40) 00013400 INTEGER TEMP ( 1000) 00013500 C 00013600 C 00013700 C 00013800 C INTEGER VARIABLES 00013900 C 00014000 INTEGER BLANK /' '/ 00014100 INTEGER LABEL1 /'FT/I'/ 00014200 INTEGER LABEL2 /'N '/ 00014300 INTEGER LABEL4 /' $ '/ 00014400 C 00014500 C REAL VARIABLES 00014600 C 00014700 REAL XK 00014800 REAL X0 00014900 REAL YK 00015000 REAL Y0 00015100 REAL XFRAC 00015200 REAL XORIG 00015300 REAL XOR83 00015405 REAL XSTEP 00015500 REAL YFRAC 00015600 REAL YORIG 00015700 REAL YSTEP 00015800 REAL INTOMM /25.4/ 00015900 REAL SIZETX 00016000 REAL SIZVER(6) /1.4, 2.0, 2.8, 4.0, 4.2, 6.0/ 00016100 REAL SPACEH 00016200 REAL SPACEV 00016300 REAL XSTART 00016400 REAL YSTART 00016500 REAL XSIZE 00016600 REAL YSIZE 00016700 REAL DXLL 00016800 REAL DYLL 00016900 C 00017000 C 00017100 C REAL FUNCTION 00017200 C 00017300 REAL FLOAT 00017400 C 00017500 C 00017600 C COLOR CODES FOR YELLOW, MAGENTA, AND CYAN ON APPLICON PLOTTER. 00017700 C 00017800 CKG DATA KOLY/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 00017900 CKG * 4, 8,12,16,16,16,16,16,16,16, 00018000 CKG * 16,16,16,16,16,16,16,16,16,16, 00018100 CKG * 16,16,16,16,16,16,16,16,16,16/ 00018200 CKG DATA KOLM/16,12,10, 8, 6, 4, 3, 2, 1, 0, 00018300 CKG * 1, 1, 1, 1, 1, 2, 3, 4, 6, 8, 00018400 CKG * 10,12,14,16,15,14,13,12,11,10, 00018500 CKG * 9, 8, 7, 6, 5, 4, 3, 2, 1, 0/ 00018600 CKG DATA KOLC/16,16,16,16,16,16,16,16,16,16, 00018700 CKG * 16,16,16,16,14,12,10, 8, 6, 4, 00018800 CKG * 3, 2, 1, 0, 0, 0, 0, 0, 0, 0, 00018900 CKG * 0, 0, 0, 0, 0, 0, 0, 0, 0, 0/ 00019000 C 00019100 C 00019200 C 00019300 DATA KOLY/ 4, 8,12,16,16,16, 00019400 * 0, 0, 0, 0, 0, 0, 00019500 * 0, 8,12,12,16, 0, 00019603 * 16, 0, 0, 0, 0, 0, 00019700 * 0, 0, 0, 0, 0,16, 00019800 * 12,16,12, 8, 4, 0, 00019900 * 0, 0, 0, 0 / 00020000 DATA KOLM/ 0, 0, 0, 0, 4, 8, 00020103 * 4, 8,12,16,12,16, 00020200 * 4, 8,12,12,16, 0, 00020300 * 16,16,12, 8, 4, 4, 00020400 * 4, 0, 0, 0, 0, 4, 00020500 * 4, 0, 0, 0, 0, 0, 00020600 * 0, 0, 0, 0 / 00020700 DATA KOLC/ 0, 0, 0, 0, 0, 0, 00020800 * 0, 0, 0, 0, 4, 4, 00020900 * 0, 0, 0, 4, 0, 0, 00021000 * 16,16,12, 8, 4,16, 00021100 * 12,16,12, 8, 4,16, 00021200 * 12,16,12, 8, 4, 0, 00021300 * 0, 0, 0, 0 / 00021400 C 00021500 C 00021600 C 00021700 C***********************************************************************00021800 C 00021900 C 00022000 C 00022100 C INITIALIZE VARIABLES 00022200 C 00022300 INK = 7 00022400 SPACEV = 0.8 * 625. 00022500 SPACEH = 0.8 * 1000. 00022600 CKG 00022700 CKG CHANGED THESE BECAUSE X AXIS WAS MOVED EXTRA 50.0 MM FROM LEFT EDGE 00022802 CKG 00022900 NX = 1 00023000 IF (NPX .GT. 270 .AND. NPX .LE. 437) NX = 2 00023102 IF (NPX .GT. 187 .AND. NPX .LE. 270) NX = 3 00023202 IF (NPX .GT. 137 .AND. NPX .LE. 187) NX = 4 00023302 IF (NPX .LE. 137) NX = 5 00023402 NY = 1 00023500 IF (NPY .GT. 201 .AND. NPY .LE. 305) NY = 2 00023602 IF (NPY .GT. 149 .AND. NPY .LE. 201) NY = 3 00023702 IF (NPY .GT. 118 .AND. NPY .LE. 149) NY = 4 00023802 IF (NPY .LE. 118) NY = 5 00023902 YORIG = 25.0 00024002 XORIG = 90.0 00024100 C 00024200 C SET PRINTOUT LEVEL 00024300 C 00024400 CALL GPRINT(1) 00024500 C 00024600 IF (KPBUGF .EQ. 0) CALL GPRINT(0) 00024706 C 00024800 C INITIALIZE APPLICON AND OPEN RASTER DATA FILE 00024900 C 00025000 CALL GAPPL 00025100 CALL GOPEN 00025200 C 00025300 C 00025400 C SET UP PLOT SIZE (SIZE OF THE MAP IN MM.) 00025500 C 00025600 XSIZE = .8 * NPX * NX 00025700 YSIZE = .8 * NPY * NY 00025800 CALL GIMSIZ (XSIZE, YSIZE) 00025900 C 00026000 C 00026100 C SET UP GRID SIZE (IN MM.) 00026200 C 00026300 DXLL = .8 * NX 00026400 DYLL = .8 * NY 00026500 CALL GIMGRD (DXLL, DYLL) 00026600 C 00026700 C 00026800 C SELECT WHICH SCHEME WILL BE USED IN UPDATING THE COLOR TABLE 00026900 C WHEN GCOLOR IS CALLED ( -2 MEANS CMY, CYAN-MAGENTA-YELLOW, NEGATIVE 00027000 C MEANS COLOR CODES ARE GIVEN AS ABSOLUTE VALUES, INSTEAD OF PERCENTAGES00027100 C 00027200 CALL GCMODE (-2, IAMODE) 00027300 C 00027400 C GCOLOR IS USED TO UPDATE THE COLOR TABLE 00027500 C 00027600 C 00027700 CALL GCOLOR ( 2, KOLC, KOLM, KOLY, 35) 00027800 C 00027900 C 00028000 DO 1045 I = 1,35 00028100 KOLNDX(I) = I + 1 00028200 1045 CONTINUE 00028300 C 00028400 C DEFINE COLOR SCALE ( -35 MEANS COLOR SCALE PRESENT IN COLOR TABLE 00028500 C STARTING AT INDEX EQUAL TO KOLNDX(1) 00028600 C 00028700 CALL GIMCOL (KOLNDX, -35) 00028800 C 00028900 C SET CLASS LIMITS FOR THE COLOR SCALE 00029000 C 00029100 C WRITE(6,99111) (ZCLASS(I),I=1,NCLZ) 00029207 99111 FORMAT(1X,10Z9) 00029300 C 00029400 C 00029500 CALL GIMZCL ( ZCLASS, NCLZ ) 00029600 C 00029700 C 00029800 C 00029900 C CALL PROGRAM TO GENERATE THE COLOR PLOT 00030000 C 00030100 C 00030200 CKG **** NOTE **** ERROR IN GIMAGE (83 VERSION) CAUSED SCAN LINE TO BE 00030303 CKG PLOTTED WHEN INITIALIZATION CALL WAS MADE. THIS 00030403 CKG PROBLEM WAS CORRECTED FOR THE 84 VERSION. UNTIL THEN00030503 CKG WILL RESET THE ORIGIN 1 SCAN LINE TO THE LEFT TO GET00030603 CKG THE DATA TO BE ALIGNED WITH THE AXIS. 00030703 CKG 00030803 CKG WHEN THE 84 VERSION IS USED, REMOVE XOR83 **** 00030903 CKG 00031003 C 00031103 XOR83 = XORIG - (.8 * NX) 00031203 C 00031303 CALL GIMORI (XOR83, YORIG) 00031403 C 00031500 CALL USMAPG (ZIN, NPX, NPY, TEMP) 00031600 C 00031700 CALL GIMORI (XORIG, YORIG) 00031804 C 00031904 C 00032000 C 00032100 C 00032200 CKG CALL IMAPG (ZIN, NPX, NPY, NX, NY, ZCLASS, NCLZ, ICOLOR, XORIG, 00032300 CKG * YORIG) 00032400 C 00032500 C 00032600 CKG*** 00032700 C 00032800 C 00032900 C ANNOTATE THE PLOT WITH THE SHOTPOINT NUMBERS 00033000 C 00033100 IF (LBLFLG .EQ. 0) GO TO 40 00033200 SIZETX = SIZVER(NY) 00033300 DO 30 I = 1, NSHOT 00033400 INDX = 1 00033500 CALL ARSET (TEXTSP(1), 2, BLANK) 00033600 CALL S1MVCH ('S', 1, TEXTSP(1), 1, 1) 00033700 NUM = SHTNUM(I) 00033800 IF (NUM .GT. 99999) GO TO 30 00033900 LEN = 5 00034000 IF (NUM .LT. 10000) LEN = 4 00034100 IF (NUM .LT. 1000) LEN = 3 00034200 IF (NUM .LT. 100) LEN = 2 00034300 IF (NUM .LT. 10) LEN = 1 00034400 C 00034500 C CONVERT THE SHOTPOINT NUMBER TO CHARACTERS 00034600 C 00034700 CALL S1BNCV (NUM, TEXTSP(1), 2, LEN) 00034800 IF (LEN .LT. 3) GO TO 10 00034900 INDX = 2 00035000 LEN = LEN - 4 00035100 C 00035200 C INSERT TERMINATING CHARACTER OF TEXT STRING 00035300 C 00035400 10 CALL S1MVCH ('$', 1, TEXTSP(INDX), LEN+2, 1) 00035500 C 00035600 C DETERMINE THE PLOTTING COORDINATES FROM THE X-Y COORDINATES 00035700 C 00035800 IF (XDIF .LT. YDIF) GO TO 20 00035900 XFRAC = 1.0 00036000 YFRAC = 1.0 00036100 IF (NPX .EQ. 1000) XFRAC = 1000. / (XDIF / MNXINC + 1) 00036200 IF (NPY .EQ. 625) YFRAC = 625. / (YDIF / MNYINC + 1) 00036300 M = ((SXCOR(I) - MINX + MNXINC) / MNXINC) * XFRAC 00036400 N = ((SYCOR(I) - MINY + MNYINC) / MNYINC) * YFRAC 00036500 IF (M .EQ. 0) M = 1 00036600 IF (N .EQ. 0) N = 1 00036700 XK = XORIG + (M - 1) * NX * 0.8 00036800 YK = YORIG + (N + 1) * NY * 0.8 00036900 IF (NTHETA .EQ. 270) YK = YORIG + (N - 3) * NY * 0.8 00037000 C 00037100 C LABEL THE SHOTPOINT 00037200 C 00037300 CKG 00037400 CALL GCHARA (NTHETA) 00037500 CALL GCHAR (TEXTSP, XK, YK, SIZETX) 00037600 CKG 00037700 CKG CALL ISYMB (TEXTSP, XK, YK, SIZETX, NTHETA, INK) 00037800 GO TO 30 00037900 C 00038000 C DETERMINE THE PLOTTING COORDINATES FROM THE X-Y COORDINATES 00038100 C 00038200 20 XFRAC = 1.0 00038300 YFRAC = 1.0 00038400 IF (NPX .EQ. 1000) XFRAC = 1000. / (YDIF / MNYINC + 1) 00038500 IF (NPY .EQ. 625) YFRAC = 625. / (XDIF / MNXINC + 1) 00038600 M = ((SYCOR(I) - MINY + MNYINC) / MNYINC) * XFRAC 00038700 N = ((SXCOR(I) - MINX + MNXINC) / MNXINC) * YFRAC 00038800 IF (M .EQ. 0) M = 1 00038900 IF (N .EQ. 0) N = 1 00039000 XK = XORIG + (M - 1) * NX * 0.8 00039100 YK = YORIG + (N + 1) * NY * 0.8 00039200 IF (NTHETA .EQ. 270) YK = YORIG + (N - 3) * NY * 0.8 00039300 C 00039400 C LABEL THE SHOTPOINT 00039500 C 00039600 CKG 00039700 CALL GCHARA (NTHETA) 00039800 CALL GCHAR (TEXTSP, XK, YK, SIZETX) 00039900 CKG 00040000 CKG CALL ISYMB (TEXTSP, XK, YK, SIZETX, NTHETA, INK) 00040100 C 00040200 30 CONTINUE 00040300 C 00040400 C DRAW THE COORDINATE AXES 00040500 C 00040600 40 IF (XDIF .LT. YDIF) GO TO 50 00040700 XSTART = MINX 00040800 XSTEP = XDIF / NPX 00040900 YSTART = MINY 00041000 YSTEP = YDIF / NPY 00041100 C 00041200 C 00041300 C 00041400 C 00041500 C 00041600 CALL USMPGA (XORIG, YORIG, NPX, NPY, NX, NY, XSTART, XSTEP, 00041700 * YSTART, YSTEP, XTEXT, YTEXT, 20.0) 00041800 C 00041900 GO TO 60 00042000 C 00042100 50 XSTART = MINY 00042200 XSTEP = YDIF / NPX 00042300 YSTART = MINX 00042400 YSTEP = XDIF / NPY 00042500 C 00042600 C 00042700 C 00042800 C 00042900 CALL USMPGA (XORIG, YORIG, NPX, NPY, NX, NY, XSTART, XSTEP, 00043000 * YSTART, YSTEP, YTEXT, XTEXT, 20.0) 00043100 C 00043200 C PLOT HORIZONTAL SCALE FACTOR 00043300 C 00043400 60 CONTINUE 00043500 CKG 00043600 CALL GCHARA (0) 00043700 CALL GCHAR ('HORIZONTAL SCALE$ ', 2.0, 1.0, 2.8) 00043800 CKG 00043900 CKG60 CALL ISYMB ('HORIZONTAL SCALE$ ', 2.0, 1.0, 2.8, 0, INK) 00044000 SCALE = (FLOAT(XDIF) / FLOAT(NPX)) / (NX * 0.8) * INTOMM + 0.5 00044100 IF (XDIF .LT. YDIF) SCALE = (FLOAT(YDIF) / FLOAT(NPX)) / 00044200 * (NX * 0.8) * INTOMM + 0.5 00044300 LEN = 5 00044400 IF (SCALE .LT. 10000) LEN = 4 00044500 IF (SCALE .LT. 1000) LEN = 3 00044600 IF (SCALE .LT. 100) LEN = 2 00044700 IF (SCALE .LT. 10) LEN = 1 00044800 CALL S1BNCV (SCALE, FTPRIN(2), 4, LEN) 00044900 CKG 00045000 CALL GCHARA (0) 00045100 CALL GCHAR (FTPRIN, 50.0, 1.0, 2.8) 00045200 CKG 00045300 CKG CALL ISYMB (FTPRIN, 50.0, 1.0, 2.8, 0, INK) 00045400 C 00045500 C PLOT VERTICAL SCALE FACTOR 00045600 C 00045700 CKG 00045800 CALL GCHARA (0) 00045900 CALL GCHAR ('VERTICAL SCALE $ ', 2.0, 4.8, 2.8) 00046000 CKG 00046100 CKG CALL ISYMB ('VERTICAL SCALE $ ', 2.0, 4.8, 2.8, 0, INK) 00046200 FTPRIN(1) = LABEL1 00046300 FTPRIN(2) = LABEL2 00046400 FTPRIN(3) = BLANK 00046500 FTPRIN(4) = LABEL4 00046600 SCALE = (FLOAT(YDIF) / FLOAT(NPY)) / (NY * 0.8) * INTOMM + 0.5 00046700 IF (XDIF .LT. YDIF) SCALE = (FLOAT(XDIF) / FLOAT(NPY)) / 00046800 * (NY * 0.8) * INTOMM + 0.5 00046900 LEN = 5 00047000 IF (SCALE .LT. 10000) LEN = 4 00047100 IF (SCALE .LT. 1000) LEN = 3 00047200 IF (SCALE .LT. 100) LEN = 2 00047300 IF (SCALE .LT. 10) LEN = 1 00047400 CALL S1BNCV (SCALE, FTPRIN(2), 4, LEN) 00047500 CKG 00047600 CALL GCHARA (0) 00047700 CALL GCHAR (FTPRIN, 50.0, 4.8, 2.8) 00047800 CKG 00047900 CKG CALL ISYMB (FTPRIN, 50.0, 4.8, 2.8, 0, INK) 00048000 C 00048100 C DRAW COLOR SCALE 00048200 C 00048300 CKG NSQRS = NCLZ + 1 00048400 CKG CALL ICHCOL(1) 00048500 CKG CALL INKSCL (10.0, 20.0, ICOLOR, ZCLASS, PROC, NSQRS, -1, 0, 10.0,00048600 CKG * 0) 00048700 C 00048800 C 00048900 C 00049000 CALL GCOSCL (10.0, 20.0) 00049100 C 00049200 C DRAW SPARC AND COMPANY LABELS AND USER COMMENTS 00049300 C 00049400 CALL S1MVCH ('$', 1, TEXT(24), 3, 1) 00049500 X0 = 35.0 00049600 Y0 = 12.7 00049700 C 00049800 C 00049900 C DRAW THE ARCO LOGO ON THE PLOT 00050000 C 00050100 KOLOR1 = 42 00050200 CALL GCOLOR (KOLOR1, 14, 6, 10, 1) 00050300 CALL SALOGA (X0, Y0, SPACEV, 20.0, 6.0, 4.0, KOLOR1, 1, TEXT) 00050400 CKG CALL SALOGA (X0, Y0, SPACEV, 20.0, 6.0, 4.0, 161616, 7, TEXT) 00050500 C 00050600 C CLOSE PLOT FILES 00050700 C IPLOT = 0 - CREATE PLOT 00050800 C IPLOT = 999 - NO PLOT OUTPUT 00050900 C 00051000 IPLOT = 0 00051100 IF (KPBUGF .EQ. 2) IPLOT = 999 00051200 C 00051300 C 00051400 CALL QAPPL 00051500 C 00051600 CKG CALL ICLB(IPLOT) 00051700 C 00051800 RETURN 00051900 C 00052006 CKG DEBUG UNIT(6),INIT 00053006 C 00054006 END 00060000