CTITLESACLRP -- COLOR PLOTTING PROGRAM 00010000 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** C 00020000 CA AUTHOR P. COOPER 00030000 CA DESIGNER P. COOPER 00040000 CA LANGUAGE VS-FORTRAN/UNIRAS 00050000 CA WRITTEN 03-31-80 - 06-30-80 00060000 C REVISED 07-28-80 PC - CORRECTED PLACEMENT OF NORTH ARROW. 00070000 C REVISED 05-15-84 RDK- MADE CDPS, LNSP, LINBER FLOATING PT. 00080000 C REVISED 06-04-84 CMP- REVISE TO USE UNIRAS SOFTWARE. 00090000 C REVISED 09-14-84 CMP- ADD VERSATEC PLOTTER OPTION. 00100000 C REVISED 10-23-85 REP- ADD CALL TO GVERCD TO GET NEW DITHER 00101000 C PATTERN AND REMOVE HALFING OF COLORS FOR 00102000 C VERSATEC PLOTS. 00103000 C REVISED 07-29-86 PKC - CHANGE FOR NEW UNIRAS (RCMODE). 00110000 C REVISED 06-18-87 DPH - DELETE OPEN & CLOSE FOR APPLICON, AND 00110101 C ADD OPEN & CLOSE FOR META PLOT FILE. 00110201 C REVISED 06-25-87 DPH - REPLACE CALL TO GCONR2 WITH CALLS TO 00110308 C GCNR2V AND GCNR2S FOR META FILE COMPATIBILITY. 00110408 CA 00120000 CA 00130000 CA CALL SACLRP (ZIN,NPX,NPY,CDPS,LNSP,ZCLASS,NCLZ,ICOLOR,TEXT, 00140000 CA SLNNO,ELNNO,FRSTLN,LNINCR,SDP,EDP,FRSTDP, 00150000 CA DPINCR,LINBER,PLOTYP,SCALFI,KPBUGF,WORK,OTYPE) 00160000 CA 00170000 CA IN/OUT ARGUMENT TYPE DESCRIPTION 00180000 CA IN ZIN R4 MATRIX TO PLOT 00190000 CA IN NPX I4 NUMBER TO PLOT IN X DIRECTION (NODP) 00200000 CA IN NPY I4 NUMBER TO PLOT IN Y DIRECTION (NOLN) 00210000 CA IN CDPS R4 DEPTH POINT SPACING 00220000 CA IN LNSP R4 LINE SPACING 00230000 CA IN ZCLASS R4 BREAK POINTS OF COLORS 00240000 CA IN NCLZ I4 NUMBER OF BREAK POINTS 00250000 CA IN ICOLOR I4 COLOR CODES TO PLOT 00260000 CA IN TEXT I4 TEXT STRING FOR LABEL 00270000 CA IN SLNNO I4 STARTING LINE NUMBER PLOTTED 00280000 CA IN ELNNO I4 ENDING LINE NUMBER PLOTTED 00290000 CA IN FRSTLN I4 FIRST LINE TO LABEL 00300000 CA IN LNINCR I4 LINE LABEL INCREMENT 00310000 CA IN SDP I4 STARTING DEPTH POINT PLOTTED 00320000 CA IN EDP I4 ENDING DEPTH POINT PLOTTED 00330000 CA IN FRSTDP I4 FIRST DEPTH POINT TO LABEL 00340000 CA IN DPINCR I4 DEPTH POINT LABEL INCREMENT 00350000 CA IN LINBER R4 LINE BEARING IN DEGREES FROM NORTH 00360000 CA (IF NEGATIVE NO ARROW PLOTTED) 00370000 CA IN PLOTYP I4 PLOT TYPE 00380000 CA 1 = GRID PLOT 00390000 CA 2 = CONTOUR PLOT WITHOUT CONTOUR LINES 00400000 CA 3 = CONTOUR PLOT WITH CONTOUR LINES 00410000 CA IN SCALFI I4 SCALE - FOOT PER INCH 00420000 CA IN KPBUGF I4 KP DEBUG VARIABLE 00430000 CA IN WORK R4 WORK ARRAY USED FOR GIMAGE 00440000 CA IN OTYPE I4 OUTPUT PLOTTER TYPE 00450000 CA 1, 2 = APPLICON PLOTTER 00460000 CA 3 = VERSATEC PLOTTER 00470000 CA 4 = META FILE 00471001 CA 00480000 CA 00490000 CA THIS SUBROUTINE PRODUCES EITHER A GRID PLOT OR A CONTOUR PLOT 00500000 CA OF 3-D DATA USING UNIRAS COLOR SUBROUTINES. LINES AND DEPTH 00510000 CA POINTS ARE LABELED, A SCALE IS DRAWN AND A PLOT LABEL IS 00520000 CA GENERATED. ALSO AN ARROW INDICATING NORTH CAN BE DRAWN. 00530000 CA IF STARTING DEPTH POINT IS ZERO THEN ONLY COMPANY LABELS, 00540000 CA COMMENTS AND THE COLOR SCALE WILL BE PLOTTED. IF ENDING 00550000 CA DEPTH POINT IS ZERO THEN NO LABELS WILL BE PLOTTED -- ALL 00560000 CA THAT WILL BE PLOTTED IS THE COLOR PORTION OF THE PLOT. 00570000 CA 00580000 CA EJECT 00590000 CA 00600000 CA 00610000 CA THIS PROGRAM CONTAINS CALLS TO THE UNIRAS SOFTWARE TO 00620000 CA CREATE THE COLOR PLOT FOR CD3D. IT COULD ALSO BE USED FOR 00630000 CA OTHER PURPOSES. IF THE STARTING LINE NUMBER IS ZERO THEN NO 00640000 CA LABELS SPECIFIC TO CD3D ARE PLOTTED. IF THE ENDING LINE NUMBER 00650000 CA IS ZERO THEN THE COMPANY LABEL AND COMMENTS ARE NOT PLOTTED. 00660000 CA 00670000 CA METHOD 00680000 CA ______ 00690000 CA 00700000 CA THE SCALES ARE INITIALIZED AND CHECKED TO MAKE SURE THEY WILL 00710000 CA FIT ON A PLOT (32.0 X 19.5 INCHES FOR APPLICON, 100.0 X 37.5 INCHES 00720000 CA FOR VERSATEC) RESCALING WILL BE DONE IF THE SCALES WILL CREATE A 00730000 CA PLOT LARGER THAN THIS. 00740000 CA 00750000 CA THERE ARE TWO TYPES OF PLOTS AVAILABLE THROUGH THIS PROGRAM, 00760000 CA A GRID PLOT AND A CONTOUR PLOT. A GRID PLOT SIMPLY CONVERTS EACH 00770000 CA VALUE OF THE INPUT MATRIX TO A COLOR SQUARE AND PLOTS IT. A CONTOUR00780000 CA PLOT WILL TAKE THE INPUT MATRIX AND INTERPOLATE A VALUE FOR EVERY 00790000 CA .2 MILLIMETERS OF THE PLOT. THIS MEANS THAT THE NUMBER OF POINTS 00800000 CA INTERPOLATED WILL VARY WITH THE SCALE AND THE NUMBER OF INPUT 00810000 CA POINTS. 00820000 CA 00830000 CA THE INPUT IS CONVERTED TO COLORS BY ASSIGNING THE FIRST COLOR 00840000 CA (THE FIRST ICOLOR VALUE) TO ALL VALUES BETWEEN THE FIRST ZCLASS 00850000 CA VALUE AND THE SECOND ZCLASS VALUE MINUS ONE. (ZCLASS VALUES ARE 00860000 CA COMPUTED IN THE CALLING PROGRAM. THEY ARE THE VALUES AT WHICH YOU 00870000 CA WANT THE COLORS TO CHANGE. ICOLOR VALUES ARE ALSO ASSIGNED IN THE 00880000 CA CALLING PROGRAM. THEY MUST FOLLOW THE UNIRAS COLOR CONVENTIONS.) 00890000 CA THEN ASSIGNING THE SECOND COLOR TO ALL VALUES BETWEEN THE SECOND 00900000 CA ZCLASS VALUE AND THE THIRD ZCLASS VALUE MINUS ONE. THIS CONTINUES 00910000 CA FOR A SPECIFIED NUMBER OF TIMES (NCLZ) WHICH IS USUALLY THE 00920000 CA DIMENSION OF ZCLASS. 00930000 CA 00940000 CA THE LINES AND DEPTH POINTS ARE LABELLED. THEN A SCALE IS DRAWN00950000 CA TO SHOW WHAT RANGE OF VALUES EACH COLOR REPRESENTS. THE LEGEND, 00960000 CA COMPANY LABELS, COMMENTS, AN ARROW INDICATING NORTH AND THE SCALE 00970000 CA FACTOR ARE THEN ADDED TO FINISH THE PLOT. 00980000 CA 00990000 CA PRINTER OUTPUT 01000000 CA _______ ______ 01010000 CA 01020000 CA IF KPBUGF EQUALS ZERO MOST OF THE PRINT FROM THE UNIRAS 01030000 CA SUBROUTINES WILL BE SUPPRESSED. IF KPBUGF IS NOT EQUAL TO ZERO 01040000 CA THIS PRINT WILL BE OUTPUT. A MESSAGE IS PRINTED IF ANY RESCALING 01050000 CA IS DONE. 01060000 CA 01070000 CA PLOT OUTPUT 01080000 CA ____ ______ 01090000 CA 01100000 CA AN APPLICON OR VERSATEC PLOT IS OUTPUT TO A DATA SET. 01110000 CAEND 01120000 C EJECT 01130000 C 01140000 C LOCAL OR INTERNAL ARRAYS 01150000 C 01160000 C ARGUMENT TYPE LENGTH DESCRIPTION 01170000 C ZIN R4 VAR. INPUT VALUES TO BE CHANGED TO COLOR 01180000 C TEXT I4 24 USER COMMENTS TO BE PUT IN LABEL 01190000 C FTPRIN I4 4 FEET PER INCH SCALE LABEL 01200000 C ICOLOR I4 VAR. COLORS TO BE USED FOR PLOT 01210000 C SIZHOR R4 6 HORIZONTAL SIZE OF TEXT POSSIBLE 01220000 C SIZVER R4 6 VERTICAL SIZE OF TEXT POSSIBLE 01230000 C TEXTLN I4 2 TEXT FOR LINE LABEL 01240000 C TEXTDP I4 2 TEXT FOR DEPTH POINT LABEL 01250000 C ZCLASS R4 VAR. VALUES AT WHICH COLORS CHANGE 01260000 C 01270000 C LOCAL OR INTERNAL VARIABLES AND CONSTANTS 01280000 C 01290000 C ARGUMENT TYPE DESCRIPTION 01300000 C NX I4 NUMBER OF 0.8 MILLIMETER POINTS IN X DIRECTION 01310000 C NY I4 NUMBER OF 0.8 MILLIMETER POINTS IN Y DIRECTION 01320000 C XK R4 USED TO COMPUTE X COORDINATE 01330000 C X0 R4 USED TO COMPUTE X COORDINATE 01340000 C YK R4 USED TO COMPUTE Y COORDINATE 01350000 C Y0 R4 USED TO COMPUTE Y COORDINATE 01360000 C EDP I4 ENDING DEPTH POINT TO LABEL -- INPUT 01370000 C INK I4 COLOR CODE (BLACK) FOR LINE AND DEPTH POINT LABELS 01380000 C LEN I4 USED TO COMPUTE LENGTH OF LABEL 01390000 C NPX I4 NUMBER OF POINTS IN X DIRECTION (NODP)-- INPUT 01400000 C NPY I4 NUMBER OF POINTS IN Y DIRECTION (NOLN) -- INPUT 01410000 C PHI R4 LINE BEARING IN RADIANS 01420000 C SDP I4 STARTING DEPTH POINT TO LABEL -- INPUT 01430000 C XK1 R4 USED TO COMPUTE X COORDINATE FOR NORTH ARROW 01440000 C XK2 R4 USED TO COMPUTE X COORDINATE FOR NORTH ARROW 01450000 C YK1 R4 USED TO COMPUTE Y COORDINATE FOR NORTH ARROW 01460000 C YK2 R4 USED TO COMPUTE Y COORDINATE FOR NORTH ARROW 01470000 C CDPS R4 CDP SPACING - USED FOR SIZE CALCULATION -- INPUT 01480000 C INDX I4 INDEX TO TEXTDP, TEXTLN FOR INSERTION OF ^ SIGN 01490000 C LEN1 I4 USED TO COMPUTE LENGTH FOR LABEL 01500000 C LNSP R4 LINE SPACING - USED FOR SIZE CALCULATION -- INPUT 01510000 C NCLZ I4 NUMBER OF COLORS TO USE FOR PLOT 01520000 C XADD R4 ADDED X NEEDED TO PUT NORTH ARROW AT CORRECT ANGLE 01530000 C YADD R4 ADDED Y NEEDED TO PUT NORTH ARROW AT CORRECT ANGLE 01540000 C BLANK I4 CHARACTER STRING ' ' 01550000 C ELNNO I4 ENDING LINE NUMBER USED FOR LABELING -- INPUT 01560000 C LENSV I4 USED TO COMPUTE LENGTH FOR LABELS 01570000 C LENTX R4 HORIZONTAL SIZE OF TEXT 01580000 C NSQRS I4 NUMBER OF SQUARES IN SCALE 01590000 C OTYPE I4 OUTPUT PLOTTER TYPE 01600000 C SIZEI I4 INDEX TO SIZE TO TEXT ARRAYS 01610000 C SLNNO I4 STARTING LINE NUMBER TO LABEL -- INPUT 01620000 C XORIG R4 X ORIGIN OF PLOT 01630000 C XSIZE R4 X SIZE IN MILLIMETERS 01640000 C YORIG R4 Y ORIGIN OF PLOT 01650000 C YSIZE R4 Y SIZE IN MILLIMETERS 01660000 C DGTORD R4 DEGREE TO RADIANS CONVERSION FACTOR 01670000 C FRSTDP I4 FIRST DEPTH POINT TO LABEL -- INPUT 01680000 C FRSTLN I4 FIRST LINE TO LABEL -- INPUT 01690000 C INTOMM R4 INCHES TO MILLIMETERS CONVERSION FACTOR 01700000 C LENHOR R4 HORIZONTAL LENGTH OF PLOT BOX IN MILLIMETERS 01710000 C LENVER R4 VERTICAL LENGTH OF PLOT BOX IN MILLIMETERS 01720000 C LINBER R4 LINE BEARING IN DEGREES FROM NORTH -- INPUT 01730000 C LNINCR I4 LINE INCREMENT FOR LABELING -- INPUT 01740000 C NTHETA I4 ANGLE OF LABELING - USUALLY ZERO 01750000 C PLOTYP I4 PLOT TYPE 01760000 C SCALFI I4 SCALE FACTOR IN FEET PER INCH 01770000 C SCLORG R4 TEMPORARY REAL VALUE USED FOR SCALE CALCULATIONS 01780000 C SIZETX R4 VERTICAL SIZE OF TEXT FOR LABELING 01790000 C SPACEH R4 ALLOWED HORIZONTAL SPACE - 32.0 INCHES 01800000 C SPACEV R4 ALLOWED VERTICAL SPACE - 19.5 INCHES 01810000 C SPBETW R4 SPACE BETWEEN CHARACTERS OF TEXT 01820000 C XORIGC R4 X ORIGIN AT CENTER OF LABEL 01830000 C XORIGD R4 X ORIGIN FOR DEPTH POINT LABEL 01840000 C XORIGL R4 X ORIGIN FOR LINE LABEL 01850000 C YORIGD R4 Y ORIGIN FOR DEPTH POINT LABEL 01860000 C YORIGL R4 Y ORIGIN FOR LINE LABEL 01870000 C 01880000 C EJECT 01890000 C 01900000 SUBROUTINE SACLRP(ZIN,NPX,NPY,CDPS,LNSP,ZCLASS,NCLZ,ICOLOR, 01910000 * TEXT,SLNNO,ELNNO,FRSTLN,LNINCR,SDP,EDP,FRSTDP, 01920000 * DPINCR,LINBER,PLOTYP,SCALFI,KPBUGF,WORK,OTYPE) 01930000 C 01940000 IMPLICIT INTEGER (A-Z) 01950000 C 01960000 C REAL ARRAYS 01970000 C 01980000 REAL X (04) 01990000 REAL Y (04) 02000000 REAL WORK (NPY) 02010000 REAL ZIN(NPX,NPY) 02020000 REAL ZCLASS(1) 02030000 C 02040000 C INTEGER ARRAYS 02050000 C 02060000 INTEGER ICOLOR(1) 02070000 INTEGER KODE1 (40) 02080000 INTEGER KODE2 (40) 02090000 INTEGER KODE3 (40) 02100000 INTEGER TEXT (24) 02110000 INTEGER TEXTLN(2) 02120000 INTEGER TEXTDP(2) 02130000 C 02150000 C CHARACTER VARIABLES 02160000 C 02170000 CHARACTER*4 BLANK /' '/ 02180000 CHARACTER*4 FTPRIN(4) /'FT/I','N ',' ',' $ '/ 02181000 C 02190000 C REAL VARIABLES 02200000 C 02210000 REAL CDPS 02220000 REAL LNSP 02230000 REAL LINBER 02240000 C 02250000 REAL X0 02260000 REAL Y0 02270000 REAL XK 02280000 REAL YK 02290000 REAL PHI 02300000 REAL XK1 02310000 REAL XK2 02320000 REAL YK1 02330000 REAL YK2 02340000 REAL XADD 02350000 REAL YADD 02360000 REAL XMIN 02370000 REAL XMAX 02380000 REAL YMIN 02390000 REAL YMAX 02400000 REAL LENTX 02410000 REAL XORIG 02420000 REAL XSIZE 02430000 REAL YORIG 02440000 REAL YSIZE 02450000 REAL DGTORD /0.01745329/ 02460000 REAL INTOMM /25.4/ 02470000 REAL LENHOR 02480000 REAL LENVER 02490000 REAL SCLORG 02500000 REAL SIZETX 02510000 REAL SIZHOR(6) /1.0,1.4,2.0,2.8,3.0,4.2/ 02520000 REAL SIZVER(6) /1.4,2.0,2.8,4.0,4.2,6.0/ 02530000 REAL SPACEH 02540000 REAL SPACEV 02550000 REAL SPBETW 02560000 REAL XORIGC 02570000 REAL XORIGD 02580000 REAL XORIGL 02590000 REAL YORIGD 02600000 REAL YORIGL 02610000 C 02620000 C INITIALIZE VARIABLES 02630000 C 02640000 SPACEV = 19.5 * INTOMM 02650000 SPACEH = 32.0 * INTOMM 02660000 C 02670000 SPACEV = 37.5 * INTOMM 02690000 SPACEH = 100.0 * INTOMM 02700000 C 02710000 5 XK = CDPS 02720000 XK = XK / SCALFI 02730000 NX = (XK * INTOMM / 0.8 + 0.5) 02740000 YK = LNSP 02750000 YK = YK / SCALFI 02760000 NY = (YK * INTOMM / 0.8 + 0.5) 02770000 LENHOR = NX * 0.8 02780000 LENVER = NY * 0.8 02790000 SCLORG = CDPS 02800000 SCLORG = SCLORG / LNSP 02810000 C 02820000 C SET UP PLOT SIZE 02830000 C 02840000 IF (KPBUGF .EQ. 0) CALL GPRINT(0) 02850000 CALL GUNIT (1, 6) 02851001 CALL GUNIT (11, 6) 02852001 IF (OTYPE .LE. 3) CALL GVERC2 02870001 IF (OTYPE .EQ. 4) CALL GROUTE ('SEL MDUMDR;EXIT') 02871001 CALL GOPEN 02880000 IF (OTYPE .EQ. 4) THEN 02880104 CALL GSEGCR (1) 02880204 CALL GCHARF ('SOFT') 02880304 CALL GCHARF ('COMP') 02880404 ENDIF 02880504 C 02880600 C RESET DITHER PATTERN FOR VERSATEC PLOTS 02880700 C 02880800 CALL GVERCD 02881001 C 02890000 C MODIFY SIZE IF TOO BIG FOR PAGE IN Y DIRECTION 02900000 C 02910000 10 YORIG = SPACEV - LENVER * NPY 02920000 IF (YORIG .GE. 0.0 ) GO TO 20 02930000 LENVER = SPACEV / NPY 02940000 NY = LENVER / 0.8 02950000 LENVER = NY * 0.8 02960000 NX = NY * SCLORG 02970000 LENHOR = NX * 0.8 02980000 YORIG = SPACEV - LENVER * NPY 02990000 SCALFI = LNSP * INTOMM / LENVER 03000000 C 03010000 C PRINT OUT THERE WAS A CHANGE OF SCALE 03020000 C 03030000 WRITE (6, 9000 ) SCALFI 03040000 GO TO 10 03050000 C 03060000 20 XORIG = 60.8 03070000 C 03080000 C MODIFY SIZE IF TOO BIG FOR PAGE IN X DIRECTION 03090000 C 03100000 IF (LENHOR * NPX .LE. SPACEH) GO TO 30 03110000 LENHOR = SPACEH / NPX 03120000 NX = LENHOR / 0.8 03130000 LENHOR = NX * 0.8 03140000 NY = NX / SCLORG 03150000 LENVER = NY * 0.8 03160000 SCALFI = CDPS * INTOMM / LENHOR 03170000 C 03180000 C PRINT OUT THERE WAS A CHANGE OF SCALE 03190000 C 03200000 WRITE (6, 9000 ) SCALFI 03210000 C 03220000 C CALCULATE SIZE OF PLOT 03230000 C 03240000 30 XSIZE = LENHOR * NPX 03250000 YSIZE = LENVER * NPY 03260000 C 03270000 C 03280000 C CALL PROGRAMS TO GENERATE THE COLOR PLOT 03290000 C PLOTYP = 1 PLOT GRIDS 03300000 C PLOTYP = 2 PLOT CONTOURS WITHOUT CONTOUR LINES 03310000 C PLOTYP = 3 PLOT CONTOURS WITH CONTOUR LINES 03320000 C 03330000 C 03340000 C SET THE COLOR CODES IN THE COLOR TABLE 03350000 C 03360000 CNEW CALL GCMODE (-2, IAMODE) 03370000 CALL RCMODE ('CMY', 16 ) 03371000 NCOLOR = NCLZ + 1 03380000 C 03390000 DO 35 03400000 * I = 1, NCOLOR 03410000 KOLR = ICOLOR(I) 03420000 KODE3(I) = KOLR/10000 03430000 KODE2(I) = KOLR/100 - KODE3(I)*100 03440000 KODE1(I) = MOD(KOLR,100) 03450000 35 CONTINUE 03460000 C 03470000 C TONE DOWN THE COLORS FOR VERSATEC PLOT 03480000 C REMOVED WHEN NEW DITHER PATTERNS USED (GVERCD) 03490000 CREP IF (OTYPE .LT. 3) GO TO 38 03500000 C 03510000 CREP DO 37 03520000 CREP * I= 1, NCOLOR 03530000 CREP KODE1(I) = KODE1(I) / 2 03540000 CREP KODE2(I) = KODE2(I) / 2 03550000 CREP KODE3(I) = KODE3(I) / 2 03560000 CREP37 CONTINUE 03570000 C 03580000 38 CALL GCOLOR (3, KODE1, KODE2, KODE3, NCOLOR) 03590000 CALL GSHADE (3, -NCOLOR) 03600000 CALL GZCL (ZCLASS, NCLZ, 0) 03610000 C 03620000 C SET THE PLOT SCALE AND ORIGIN 03630000 C 03640000 CPC CALL GORIG (XORIG, YORIG) 03650001 C 03660000 XMIN = SDP 03670000 XMAX = EDP 03680000 C 03690000 YMIN = SLNNO 03700000 YMAX = ELNNO 03710000 C 03720000 CALL GLIMIT (XMIN, XMAX, YMIN, YMAX, 0.0, 0.0) 03730000 CALL GVPORT (XORIG, YORIG, XSIZE, YSIZE) 03731001 CPC CALL GSIZE (XSIZE, YSIZE) 03740001 C 03750000 C CONTRUCT THE PLOTS 03760000 C 03770000 C*** NEXT LINE MAY BE COMMENTED OUT WHEN THE 03780000 C NEW UNIRAS LIBRARIES ARE RELEASED 03790000 C IF (PLOTYP .EQ. 1) CALL GORIG (XORIG-LENHOR, YORIG) 03800000 C 03810000 IF (PLOTYP .EQ. 1) CALL USMAPG (ZIN, NPX, NPY, WORK) 03820000 C 03830000 IF (PLOTYP .EQ. 2) THEN 03840008 CALL GCNR2V (ZIN, NPX, NPY) 03841008 CALL GCNR2S (ZIN, NPX, NPY) 03842008 ENDIF 03843008 C 03850000 IF (PLOTYP .EQ. 3) THEN 03871008 CALL GEOCOL (1) 03871108 CALL GCNR2V (ZIN, NPX, NPY) 03872008 CALL GCNR2S (ZIN, NPX, NPY) 03873008 ENDIF 03874008 C 03880000 C 03890000 C 03900000 C OPTION TO NOT PLOT LINE AND DEPTH POINT LABELS 03910000 C 03920000 IF (SLNNO .EQ. 0) GO TO 135 03930000 C 03940000 C SET UP SIZE FOR LABELING 03950000 C 03960000 SIZETX = (LENVER/2.0) - 1.0 03970000 C 03980000 IF (SIZETX .GT. SIZVER(1)) GO TO 40 03990000 SIZEI = 1 04000000 GO TO 60 04010000 C 04020000 C FIND CLOSEST SIZE ALLOWABLE 04030000 C 04040000 40 DO 50 04050000 * I = 1, 5 04060000 IF (SIZVER(I) .GT. SIZETX .OR. 04070000 * SIZETX .GE. SIZVER(I+1)) GO TO 50 04080000 SIZEI = I 04090000 GO TO 60 04100000 C 04110000 50 CONTINUE 04120000 C 04130000 SIZEI = 6 04140000 C 04150000 C COUNT MAXIMUM NUMBER OF CHARACTERS TO PLOT 04160000 C 04170000 60 IF(ELNNO .LT. 10000) LEN = 5 04180000 IF(ELNNO .LT. 1000 ) LEN = 4 04190000 IF(ELNNO .LT. 100 ) LEN = 3 04200000 IF(ELNNO .LT. 10 ) LEN = 2 04210000 LENSV = LEN 04220000 C 04230000 IF (EDP .LT. 10000) LEN = 4 04240000 IF (EDP .LT. 1000 ) LEN = 3 04250000 IF (EDP .LT. 100 ) LEN = 2 04260000 IF (EDP .LT. 10 ) LEN = 1 04270000 C 04280000 IF (LEN .GT. LENSV) LENSV = LEN 04290000 C 04300000 C CALCULATE WIDTH POSSIBLE FOR GIVEN GRID SIZE 04310000 C 04320000 70 SCLORG = (LENSV - 1) * (SIZHOR(SIZEI) / 2.0) 04330000 LENTX = (LENHOR - SCLORG) / LENSV 04340000 C 04350000 C CHECK IF WIDTH TO PLOT IS LESS THAN WIDTH POSSIBLE 04360000 C 04370000 IF (SIZHOR(SIZEI) .LE. LENTX) GO TO 80 04380000 IF (SIZEI .EQ. 1) GO TO 80 04390000 SIZEI = SIZEI - 1 04400000 GO TO 70 04410000 C 04420000 C ADJUST SIZE IF NECESSARY 04430000 C 04440000 80 SIZETX = SIZVER (SIZEI) 04450000 C 04460000 C CALCULATE INTERCHARACTER SPACE 04470000 C 04480000 SPBETW = SIZHOR(SIZEI) / 2.0 04490000 C 04500000 C SET UP VARIABLES AND ORIGINS FOR LABELS 04510000 C 04520000 INDX = 1 04530000 C 04540000 XORIGC = XORIG + LENHOR / 2 + (FRSTDP - SDP) * LENHOR 04550000 YORIGL = YORIG + LENVER / 2 + 0.5 + 04560000 * (NPY - (FRSTLN - SLNNO + 1)) * LENVER 04570000 YORIGD = YORIGL - SIZETX - 1.0 04580000 C 04590000 CALL ARSET (TEXTLN(1), 2, BLANK) 04600000 CALL ARSET (TEXTDP(1), 2, BLANK) 04610000 CALL S1MVCH ('L',1,TEXTLN(1),1,1) 04620000 C 04630000 C SET UP TO LABEL LINE 04640000 C 04650000 DO 130 04660000 * I = FRSTLN, ELNNO, LNINCR 04670000 C 04680000 IF (I .LT. 10000) LEN1 = 4 04690000 IF (I .LT. 1000 ) LEN1 = 3 04700000 IF (I .LT. 100 ) LEN1 = 2 04710000 IF (I .LT. 10 ) LEN1 = 1 04720000 C 04730000 C CONVERT LINE NUMBER TO CHARACTERS 04740000 C 04750000 CALL S1BNCV (I, TEXTLN(1), 2, LEN1) 04760000 C 04770000 IF (LEN1 .LT. 3) GO TO 90 04780000 INDX = 2 04790000 LEN = LEN1 - 4 04800000 C 04810000 C INSERT TERMINATING CHARACTER 04820000 C 04830000 90 CALL S1MVCH ('$', 1, TEXTLN(INDX), LEN+2, 1) 04840000 INDX = 1 04850000 C 04860000 C SET UP TO LABEL DEPTH POINT 04870000 C 04880000 DO 120 04890000 * J = FRSTDP, EDP, DPINCR 04900000 C 04910000 C CHECK IF NO VALUE AT LABEL LOCATION 04920000 C 04930000 JTH = J - SDP + 1 04940000 ITH = ELNNO - I + 1 04950000 IF (ZIN(JTH,ITH) .EQ. 0.0) GO TO 110 04960000 C 04970000 IF (J .LT. 10000) LEN = 4 04980000 IF (J .LT. 1000 ) LEN = 3 04990000 IF (J .LT. 100 ) LEN = 2 05000000 IF (J .LT. 10 ) LEN = 1 05010000 C 05020000 C CONVERT DEPTH POINT NUMBER TO CHARACTERS 05030000 C 05040000 CALL S1BNCV (J, TEXTDP(1), 1, LEN) 05050000 C 05060000 C MODIFY X-ORIGIN FOR LINE AND DEPTH POINT 05070000 C 05080000 XORIGL = XORIGC - (SIZHOR(SIZEI) * (LEN1+1) / 2.0) - 05090000 * LEN1 * SPBETW / 2.0 05100000 XORIGD = XORIGL + SIZHOR(SIZEI) * (LEN1 - LEN + 1) + 05110000 * (LEN1 + 1 - LEN) * SPBETW 05120000 C 05130000 C INSERT TERMINATING CHARACTER 05140000 C 05150000 IF (LEN .NE. 4) GO TO 100 05160000 INDX = 2 05170000 LEN = 0 05180000 C 05190000 100 CALL S1MVCH ('$', 1, TEXTDP(INDX), LEN+1, 1) 05200000 INDX = 1 05210000 C 05220000 C LABEL LINE AND DEPTH POINT 05230000 C 05240000 CALL GCHAR (TEXTLN, XORIGL, YORIGL, SIZETX) 05250000 CALL GCHAR (TEXTDP, XORIGD, YORIGD, SIZETX) 05260000 C 05270000 C RESET TEXTDP AND UPDATE ORIGIN 05280000 C 05290000 CALL ARSET (TEXTDP(1), 2, BLANK) 05300000 C 05310000 110 XORIGC = XORIGC + LENHOR * DPINCR 05320000 C 05330000 120 CONTINUE 05340000 C 05350000 C RESET ORIGINS AND LABEL NEXT LINE 05360000 C 05370000 XORIGC = XORIG + LENHOR/2 + (FRSTDP - SDP) * LENHOR 05380000 YORIGL = YORIGL - LENVER * LNINCR 05390000 YORIGD = YORIGL - SIZETX - 1.0 05400000 CALL ARSET (TEXTLN(1), 2, BLANK) 05410000 CALL S1MVCH ('L',1,TEXTLN(1),1,1) 05420000 C 05430000 130 CONTINUE 05440000 C 05450000 C OPTION TO NOT PLOT COLOR SCALE, COMPANY LABELS 05460000 C OR COMMENTS 05470000 C 05480000 135 IF (ELNNO .EQ. 0) GO TO 170 05490000 C 05500000 C DRAW SCALE 05510000 C 05520000 SCLORG = (NCLZ+1) * 10.0 05530000 SCLORG = SPACEV - SCLORG - 20.0 05540000 C 05550000 NSQRS = NCLZ + 1 05560000 C 05570000 CALL GCOSCL( 5., SCLORG) 05580000 C 05590000 C DRAW SPARC AND COMPANY LABELS AND USER COMMENTS 05600000 C 05610000 X0 = 1.5 * INTOMM 05620000 Y0 = 0.5 * INTOMM 05630000 CALL S1MVCH ('$',1,TEXT(24),3,1) 05640000 C 05650000 CNEW CALL GCMODE (-2, IAMODE) 05660001 CALL RCMODE ('CMY', 16 ) 05661001 KODE1(1) = 12 05670001 KODE2(1) = 14 05680001 KODE3(1) = 16 05690001 C 05700000 CALL GCOLOR (2, KODE1, KODE2, KODE3, 1) 05710000 C 05720000 CALL SALOGA (X0, Y0, SPACEV, 20.0, 6.0, 4.0, 2, 1, TEXT) 05730000 C 05740000 C 05750000 C CHECK IF NO OTHER LABELS 05760000 C 05770000 IF (SLNNO .EQ. 0) GO TO 170 05780000 C 05790000 C DRAW LEGEND 05800000 C 05810000 X0 = 0.3 * INTOMM 05820000 Y0 = SPACEV - 14.0 05830000 C 05840000 CALL GCHAR('DP NO. --- 1$ ', X0, Y0, 2.8) 05850000 C 05860000 YK = Y0 + 4.0 05870000 C 05880000 CALL GCHAR('LINE NO.-- L1$ ', X0, YK, 2.8) 05890000 C 05900000 YK = YK + 5.0 05910000 C 05920000 CALL GCHAR(' LEGEND $ ', X0, YK, 4.0) 05930000 C 05940000 C PLOT ARROW TO INDICATE NORTH 05950000 C 05960000 IF (LINBER .LT. 0.)GO TO 140 05970000 C 05980000 PHI = LINBER * DGTORD 05990000 XADD = COS(PHI) * INTOMM 06000000 YADD = SIN(PHI) * INTOMM 06010000 C 06020000 XK1 = 18.5 * INTOMM 06030000 YK1 = SPACEV + 0.63 * INTOMM 06040000 XK2 = XK1 + XADD 06050000 YK2 = YK1 + YADD 06060000 C 06070000 CALL GWICOL (.6, 1) 06080000 CALL GVECT (XK1, YK1, 0) 06090000 CALL GVECT (XK2, YK2, 1) 06100000 C 06110000 X(1) = XK1 + 1.25 * XADD 06120000 Y(1) = YK1 + 1.25 * YADD 06130000 C 06140000 X(2) = XK2 + .1 * YADD 06150000 Y(2) = YK2 - .1 * XADD 06160000 C 06170000 X(3) = XK2 - .1 * YADD 06180000 Y(3) = YK2 + .1 * XADD 06190000 C 06200000 CALL GSURF (X, Y, 3, 1,0) 06210000 XK = XK2 + 4.0 06220000 YK = YK2 + 4.0 06230000 CALL GCHAR ('N$ ', XK, YK, 6.0) 06240000 C 06250000 C PLOT SCALE FACTOR 06260000 C 06270000 140 X0 = 0.2 * INTOMM 06280000 Y0 = SCLORG - 20.0 06290000 XK = 2. * X0 06300000 C 06310000 CALL GCHAR (' SCALE$ ', XK, Y0, 4.0) 06320000 C 06330000 Y0 = Y0 - 5.0 06340000 C 06350000 LEN = 5 06360000 IF (SCALFI .LT. 10000) LEN = 4 06370000 IF (SCALFI .LT. 1000 ) LEN = 3 06380000 IF (SCALFI .LT. 100 ) LEN = 2 06390000 IF (SCALFI .LT. 10 ) LEN = 1 06400000 C 06410000 CALL S1BNCV (SCALFI, FTPRIN(2), 4, LEN) 06420000 CALL GCHAR (FTPRIN, XK, Y0, 2.8) 06430000 C 06442001 C 06443001 C CLOSE PLOT FILES 06450000 C 06460000 C 06470000 C IF (OTYPE .EQ. 3) CALL GCLOSE 06490000 170 IF (OTYPE .LE. 3) CALL QHVERC 06500001 IF (OTYPE .EQ. 4) THEN 06501001 CALL GSEGCL (1) 06502001 CALL GCLOSE 06503001 ENDIF 06504001 C 06510000 RETURN 06530000 C 06540000 9000 FORMAT (/1X,' *** RESCALING WAS DONE TO ',I5,' FT/IN') 06550000 C 06551001 END 06570000