c DRAWUTM. Draws UTM templates with distance sub-division c See DRAWGEOG.F for templates with geographic coordinates. c Coordinates: X--easting increases to right; Y--northing c increases to top of paper. character unit(2)*5,unitk(2)*11 data iscale,ifn,ith,imx,jmx,ifpage,ifmet,lab/8*0/, 1 xscale,yscale/2*1.0/,factor,paperx,papery/3*0.0/,xstart/0.7/ data unit/'METER','FOOT '/, 1 unitk/'KILOMETERS.','KILOFEET. '/ c For PostScript plotters, thick line strokes are interspersed c with thin. Interactive session for scale. One file for each c scale. Page size and larger plots. print 100 100 format (' DRAWUTM, Plouff 8-97. Program to draw templates ', 1 'with equally-spaced lines',/,' to interpolate distances be', 2 'tween gridmarks for Universal Transverse Mercator',/, 3 ' (metric) or State Plane (english) coordinates.',/, 4 ' Graphical output is in PostScript format (laser, etc.).') c Prompting for paper parameters: XSCALE/YSCALE=scale factors to c compensate for plotter mis-calibration in e-w (top-bottom)/n-s c (left-right) directions. PAPERX=max width of paper; PAPERY=paper c length (inches). IFPAGE=1 for 8.5x11 page size, else zero. call prompap (xscale,yscale,paperx,papery,ifpage) if (ifpage .gt. 1) stop if (ifpage .eq. 1 .or. (paperx .eq. 11. .and. papery .eq. 17.)) 1 xstart=0.4 c 0.3 works for some laser printers, but 0.4 safer. 0.5 inch? c A HP DesignJet 650C plotter needs 0.7 margin to avoid truncation. ystart=xstart c Top 0.16, bottom 0.34 inch for labels/caption. Half width of c zero=0.03+. Deal with largest KILO numbers inside PRMPGEN. c Allow extra 0.02 inch for mechanical registration of paper. width=(paperx-(xstart+xstart+0.06))/xscale height=(papery-(ystart+ystart+0.52))/yscale C ISCALE--reciprocal of map scale. IFN=distance between closest lines, c in meters/feet. ITH=distance between medium lines. LAB=distance c between thick labeled lines. IFMET=1 or 2 for meters or feet. call prmpgen (iscale,ifn,ith,imx,jmx,ifpage,width,height, 1 ifmet,factor,lab,paperx,papery) if (ifmet .gt. 2) go to 99 c Create PostScript file name from units and scale. Open it. call fileopen (iscale,ifmet) c First line for all PostScript files write (7,700) 700 format ('%!PS-Adobe') c Establish paper boundaries for drawing if (ifpage .eq. 1) then write (7,701) 701 format ('%%BoundingBox 50 50 600 780') else if (paperx .eq. 11. .and. papery .eq. 17.) then write (7,702) 702 format ('%%BoundingBox 50 50 780 1200') else c 72 points per inch kx=paperx*72.0-24.0 ky=papery*72.0-24.0 write (7,703) kx,ky 703 format ('%%BoundingBox 50 50',2i5) end if end if c Abbreviations/definitions in PostScript language write (7,704) 704 format ('/M {moveto} def /L {lineto} def /S {show} def',/, 1 ' /CP {currentpoint} def',/,' /ST {L CP stroke M} def',/, 2 '/CUR {CP /yp exch def /xp exch def} def /SW {setline', 3 'width} def',/,'/THIN {0.006 SW} def /MED {0.012 SW} def ', 4 '/THICK {0.018 SW} def',/,'/HF14 {/Helvetica findfont 0.20 ', 5 'scalefont setfont} def',/,'/HF8 {/Helvetica findfont 0.12', 6 ' scalefont setfont} def',/,'/HF11 {/Helvetica findfont 0.16', 7 ' scalefont setfont} def' ) write (7,706) 706 format ('% SPECIAL LINES FOR ADVANCED PLOTTERS',/, 1 '%%BeginSetup',/,'<<',/,' /InputAttributes <<') kx=paperx*72.0 ky=papery*72.0 write (7,707) kx,ky,kx,ky 707 format (' 0 << /PageSize [',2i5,'] >>',/,'>>',/, 1 ' >> setpagedevice',//,'<< /PageSize [',2i5,'] >> ', 2 'setpagedevice',/,'%%EndSetup') write (7,708) 708 format ('% Scale to inches; move origin from lower left ', 1 'corner') c Plot to XSTART inch from corner of page + half zero write (7,709) xstart,ystart 709 format ('72 72 scale ',f4.2,' 0.04 add ',f4.2,' translate') c 0.14-inch print for scale. 0.08-inch print for rest. write (7,711) 711 format ('HF14 0.05 0.14 M (SCALE 1:) S') nscfig=ndig(iscale) go to (344,344,344,344,345,346,347), nscfig 347 write (7,727) iscale 727 format ('(',i7,') S (.) S') go to 348 346 write (7,726) iscale 726 format ('(',i6,') S (.) S') go to 348 345 write (7,725) iscale 725 format ('(',i5,') S (.) S') go to 348 344 write (7,724) iscale 724 format ('(',i4,') S (.) S') 348 write (7,712) ifn,unit(ifmet),unitk(ifmet) 712 format ('HF8 1.85 0.14 M (',i5,'-',a5,' SUBDIVISIONS. LABELS', 1 ' ARE IN ) S (',a11,') S') bot=float(jmx)*factor side=float(imx)*factor write (7,714) bot,side 714 format ('0.05 0.01 M (BOTTOM=) S (',f5.2,') S ( INCHES; ', 1 'SIDES=) S (',f5.2,' INCHES.) S') c Translate origin to plot. 0.11-inch print font for distance labels write (7,715) 715 format ('0.0 0.34 translate',/,'HF11') c Set plot scale factors and constants for far borders factory=factor*yscale xmax=bot*xscale imaxdig=ndig(imx/1000) xp=xmax+0.04 c One more than total number of fine intervals, to draw edges nifnp=(imx/ifn)+1 c Draw and label left-to-right rows from BOTTOM TO TOP. do 2 i=1,nifnp c Increasing y distance in map units north=(i-1)*ifn y=factory*float(north) if ((north-ith*(north/ith)) .eq. 0) then c A thick line if ((north-lab*(north/lab)) .ne. 0) then write (7,728) y,xmax,y 728 format ('MED 0.0 ',f9.3,' M ',2f9.3,' ST') else c Labeled line is thicker write (7,716) y,xmax,y 716 format ('THICK 0.0 ',f9.3,' M ',2f9.3,' ST') yp=y-0.055 ivalue=north/1000 idig=ndig(ivalue) c Multiples of number width, assuming 0.09 inch x=xp+0.09*float((imaxdig-idig)) go to (301,302,303,304), idig 301 write (7,401) x,yp,ivalue 401 format(2f9.3,' M (',i1,') S') go to 2 302 write (7,402) x,yp,ivalue 402 format(2f9.3,' M (',i2,') S') go to 2 303 write (7,403) x,yp,ivalue 403 format(2f9.3,' M (',i3,') S') go to 2 304 write (7,404) x,yp,ivalue 404 format(2f9.3,' M (',i4,') S') end if else c Thin line segments write (7,720) y,xmax,y 720 format ('THIN 0.0 ',f9.3,' M ',2f9.3,' ST') end if 2 continue ymax=side*yscale yp=ymax+0.07 factorx=factor*xscale njfnp=(jmx/ifn)+1 c Draw and label bottom-to-top columns from LEFT-TO-RIGHT do 3 j=1,njfnp c Increasing x distance in map units jeast=(j-1)*ifn x=factorx*float(jeast) if ((jeast-ith*(jeast/ith)) .eq. 0) then c A thick line if ((jeast-lab*(jeast/lab)) .ne. 0) then write (7,828) x,x,ymax 828 format ('MED ',f9.3,' 0.0 M ',2f9.3,' ST') else c Labeled line is thicker write (7,816) x,x,ymax 816 format ('THICK ',f9.3,' 0.0 M ',2f9.3,' ST') jvalue=jeast/1000 jdig=ndig(jvalue) c Half multiples of number width, assuming 0.10 inch xp=x-0.5*0.09*float(jdig)+0.01 go to (801,802,803,804), jdig 801 write (7,901) xp,yp,jvalue 901 format(2f9.3,' M (',i1,') S') go to 3 802 write (7,902) xp,yp,jvalue 902 format(2f9.3,' M (',i2,') S') go to 3 803 write (7,903) xp,yp,jvalue 903 format(2f9.3,' M (',i3,') S') go to 3 804 write (7,904) xp,yp,jvalue 904 format(2f9.3,' M (',i4,') S') end if else c Thin line segments write (7,920) x,x,ymax 920 format ('THIN ',f9.3,' 0.0 M ',2f9.3,' ST') end if 3 continue write (7,730) 730 format ('showpage') print 609, xstart,ystart write (16,609) xstart,ystart 609 format (' If the edges of your template are not plotted, you ', 1 'must: increase numbers',/,f6.2,' and',f5.2,' for line 22 ', 2 '(translate command) in PostScript file for the',/,' left ', 3 'or bottom edges, respectively; request shorter distances for ', 4 'the right',/,' or top edges; or change complicated lines 2 ', 5 '(BoundingBox) or bracketed',/,' numbers in lines 15 and 19.') close (7) 99 close(16) stop end c------------------------------------------------------------ subroutine prompap (xscale,yscale,paperx,papery,ifpage) character*1 ans logical exists print 100 100 format (' Do you want to skip the explanation of how tem', 1 'plates are designed?') read 501, ans 501 format (a1) if (ans .eq. 'y' .or. ans .eq. 'Y' .or. ans .eq. ' ') go to 1 print 101 101 format (' Templates can cover the smallest gridmark interval ', 1 'shown on maps.',/,' For example, 1,000 meters UTM squares ', 2 '(1.64-inch separation) may be shown or',/,' can be drawn be', 3 'tween map edges on 7.5-minute maps. If UTM or State Plane',/, 4 ' registration marks along edges are insufficient to obtain ', 5 '1,000-meter',/,' squares, templates need to be large enough ', 6 'to span a short distance beyond',/,' the map.') print 102 102 format (' DO YOU WANT TO CONTINUE?') read 501, ans if (ans .eq. 'y' .or. ans .eq. 'Y' .or. ans .eq. ' ') go to 1 9 ifpage=9 return 1 print 103 103 format (' A carriage return is a yes and the letter n is a no', 1 ' throughout the program.', /,' Questions will be repeated ', 2 'if your response is not understood.',/,' Print PostScript ', 3 'files PLOT5.PST or PLOT5DAV.PST (advanced language) with a', 4 /,' 5-inch square to test if you need to apply scale ', 5 'factors.',/,' DO YOU WANT TO STOP TO CHECK?') read 501, ans if (ans .eq. 'y' .or. ans .eq. 'Y' .or. ans .eq. ' ') go to 9 print 104 104 format (' The file that will record your session is ', 1 'DRAWUTM.PNT.') inquire (file='DRAWUTM.PNT',exist=exists) if (exists) then print 112 112 format (' Print file DRAWUTM.PNT already exists.') print 114 114 format (' DO YOU WANT TO STOP TO RENAME IT RATHER THAN ', 2 'OVERWRITING IT?') read 501, ans if (ans .eq. 'y' .or. ans .eq. 'Y' .or. ans .eq. ' ') go to 9 end if c open file to write open (16,file='DRAWUTM.PNT',form='formatted',status='unknown') write (16,600) 600 format (' DRAWUTM, Plouff 8-97. Draws templates with equally-', 1 'spaced lines to',/,' interpolate distances between grid', 2 'marks for Universal Transverse Mercator',/,' or State Plane', 3 ' coordinates.') print 115 115 format (' Do your templates fit on 8.5- by 11-inch pages?') read 501, ans if (ans .eq. 'y' .or. ans .eq. 'Y' .or. ans .eq. ' ') then ifpage=1 paperx=8.5 papery=11.0 write (16,601) 601 format (' Page-size templates are selected.') else 3 print 107 107 format (' TYPE the left-right width of your plot paper ', 1 '(inches):') read (5,*,err=3) paperx 2 print 106 106 format(' TYPE the available bottom-to-top length of your ', 1 'paper (inches):') read (5,*,err=2) papery write (16,602) papery,paperx 602 format (' Selected plotter paper length:',f6.1,' inches, ', 1 'width:',f6.1,' inches.') end if print 108 108 format (' Are plotter/printer scale factors okay and maps ', 1 'undistorted?') read 501, ans if (ans .eq. 'y' .or. ans .eq. 'Y' .or. ans .eq. ' ') go to 6 print 109 109 format (' Scale factors equal true length divided ', 1 'by measured plot length.') 4 print 110 110 format (' TYPE the scale factor in the direction of paper ', 1 'length (bottom-top):') read (5,*,err=4) yscale 5 print 111 111 format (' TYPE the scale factor in the direction of paper ', 1 'width (left-right):') read (5,*,err=5) xscale 6 write (16, 606) yscale,xscale 606 format(' Scale factors:',f7.4,' bottom-top',f7.4,' left-', 1 'right.') return end c------------------------------------------------------------------- subroutine prmpgen (iscale,ifn,ith,imx,jmx,ifpage, 1 width,height,ifmet,factor,lab,paperx,papery) character ans*1,unit(2)*6 data unit/'meters','feet '/ print 200 200 format (' DO NOT TYPE DECIMAL POINTS OR COMMAS FOR THE RE', 1 'MAINING REQUESTED NUMBERS.') 2 print 101 101 format(' TYPE the reciprocal of the map scale (integer num', 1 'ber):') read (5,*,err=2) iscale write (16,600) iscale 600 format (' Scale selected is 1:',i7) if (iscale .le. 0) go to 2 scal=float(iscale) print 400 400 format (' Distance intervals can be shown in either the met', 1 'ric (meters/kilometers)',/,' or the english (feet/', 2 'kilofeet) system.') print 401 401 format (' Do you want the metric system?') read 501, ans 501 format (a1) if (ans .eq. 'y' .or. ans .eq. 'Y' .or. ans .eq. ' ') then ifmet=1 c Multiplication factor to convert meters to inches. Agrees with c projection formulas--compared to present 0.3048 for surveying. factor=12.0/0.3048006 write (16,601) print 601 601 format ('The metric system is selected.') else ifmet=2 c Convert feet to inches factor=12.0 write (16,603) print 603 603 format ('The english system is selected.') end if c Multiplication factor to convert map meters/feet to inches factor=factor/scal c Available width in distance units, including paper scale factor xwide=width/factor ylong=height/factor if (ylong .lt. 1000.0 .or. xwide .lt. 1000.0) then print 502, unit(ifmet) write (16,502) unit(ifmet) 502 format (' ***STOP. Plot labeling cannot be done. Scale or ', 1 'paper size yields a',/,' maximum distance of less than ', 2 '1,000 ',a6,' along one axis.') go to 99 end if if (ifpage .ne. 1) go to 7 c Page-size templates if (iscale .lt. 23000 .or. iscale .gt. 28000) go to 3 if (ifmet .eq. 1) then print 106 106 format (' The standard template setup is 100 m between', 1 ' fine lines and 500 m',/,' between thick lines, to ', 2 'cover a 4- by 5-km area.') call p (ifn,ith,lab,imx,jmx,100,500,1000,5000,4000) if (ifn .eq. 0) go to 44 write (16,106) else print 108 108 format (' The standard template setup is 200 ft between ', 1 'fine lines and',/,' 1,000 ft between thick lines, to ', 2 'cover a 10- by 10-kft area.') call p (ifn,ith,lab,imx,jmx,200,1000,2000,10000,10000) if (ifn .eq. 0) go to 44 write (16,108) end if go to 9 3 if (iscale .lt. 49000 .or. iscale .gt. 65000) go to 4 if (ifmet .eq. 1) then print 110 110 format (' The standard template setup is 200 m between', 1 ' fine lines and 1,000 m',/,' between thick lines, to ', 2 'cover a 10- by 15-km area.') call p (ifn,ith,lab,imx,jmx,200,1000,1000,15000,10000) if (ifn .eq. 0) go to 44 write (16,110) else print 111 111 format (' The standard template setup is 500 ft between ', 1 'fine lines and',/,' 1,000 ft between thick lines, to ', 2 'cover a 25- by 50-kft area.') call p (ifn,ith,lab,imx,jmx,500,1000,5000,50000,25000) if (ifn .eq. 0) go to 44 write (16,111) end if go to 9 4 if (iscale .lt. 99000 .or. iscale .gt. 120000) go to 5 if (ifmet .eq. 1) then print 113 113 format (' A standard template setup is 500 m between', 1 ' fine lines and 1,000 m',/,' between thick lines, to ', 2 'cover a 15- by 20-km area.') call p (ifn,ith,lab,imx,jmx,500,1000,2000,20000,15000) if (ifn .eq. 0) go to 44 write (16,113) else print 114 114 format (' A standard template setup is 1,000 ft between ', 1 'fine lines and',/,' 5,000 ft between thick lines, to ', 2 'cover a 50- by 75-kft area.') call p (ifn,ith,lab,imx,jmx,1000,5000,10000,75000,50000) if (ifn .eq. 0) go to 44 write (16,114) end if go to 9 5 if (iscale .lt. 240000 .or. iscale .gt. 310000) go to 44 if (ifmet .ne. 1) go to 44 print 116 116 format (' A standard template setup is 1 km between', 1 ' fine lines and 5 km',/,' between thick lines, to ', 2 'cover a 40- by 50-km area.') call p (ifn,ith,lab,imx,jmx,1000,5000,10000,50000,40000) if (ifn .eq. 0) go to 44 write (16,116) go to 9 CXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX C Templates greater than 8.5- by 11-inch page size 7 if (iscale .lt. 23000 .or. iscale .gt. 28000) go to 13 if (paperx .gt. 11.01 .or. papery .gt. 17.01) go to 8 c Templates on 11- by 17-inch paper if (ifmet .eq. 1) then print 406 406 format (' A standard template setup is 100 m between', 1 ' fine lines and 500 m',/,' between thick lines, to ', 2 'cover a 5- by 5-km area.') call p (ifn,ith,lab,imx,jmx,100,500,1000,5000,5000) if (ifn .eq. 0) go to 44 write (16,406) end if go to 9 8 if (paperx .lt. 26.0 .or. papery .lt. 26.0) go to 44 if (ifmet .eq. 1) then print 206 206 format (' A standard template setup is 100 m between ', 1 'fine lines and 500 m',/,' between thick lines, to ', 2 'cover a 15- by 15-km area.') call p (ifn,ith,lab,imx,jmx,100,500,1000,15000,15000) if (ifn .eq. 0) go to 44 write (16,206) else print 208 208 format (' A standard template setup is 200 ft between ', 1 'fine lines and 1,000 ft',/,' between thick lines, to ', 2 'cover a 50- by 50-kft area.') call p (ifn,ith,lab,imx,jmx,200,1000,2000,50000,50000) if (ifn .eq. 0) go to 44 write (16,208) end if go to 9 13 if (iscale .lt. 49000 .or. iscale .gt. 65000) go to 14 if (paperx .lt. 19.0 .or. papery .lt. 19.0) go to 44 if (ifmet .eq. 1) then print 209 209 format (' A standard template setup is 200 m between ', 1 'fine lines and 1,000 m',/,' between thick lines, to ', 2 'cover a 30- by 30-km area.') call p (ifn,ith,lab,imx,jmx,200,1000,1000,30000,30000) if (ifn .eq. 0) go to 44 write (16,209) else print 211 211 format (' A standard template setup is 500 ft between ', 1 'fine lines and 1,000 ft',/,' between thick lines, to ', 2 'cover a 100- by 100-kft area.') call p (ifn,ith,lab,imx,jmx,500,1000,5000,100000,100000) if (ifn .eq. 0) go to 44 write (16,211) end if go to 9 14 if (iscale .lt. 99000 .or. iscale .gt. 120000) go to 15 if (paperx .lt. 26.0 .or. papery .lt. 26.0) go to 44 if (ifmet .eq. 1) then print 212 212 format (' A standard template setup is 500 m between ', 1 'fine lines and 1,000 m',/,' between thick lines, to ', 2 'cover a 60- by 60-km area.') call p (ifn,ith,lab,imx,jmx,500,1000,2000,60000,60000) if (ifn .eq. 0) go to 44 write (16,212) else ifn=5 print 214 214 format (' A standard template setup is 1,000 ft between ', 1 'fine lines and 5,000 ft',/,' between thick lines, to ', 2 'cover a 200- by 200-kft area.') call p (ifn,ith,lab,imx,jmx,1000,5000,10000,200000,200000) if (ifn .eq. 0) go to 44 write (16,214) end if go to 9 15 if (iscale .lt. 240000 .or. iscale .gt. 310000) go to 44 if (paperx .lt. 21.0 .or. papery .lt. 21.0) go to 44 if (ifmet .ne. 1) go to 44 print 215 215 format (' A standard template setup is 1 km between ', 1 'fine lines and 5 km',/,' between thick lines, to ', 2 'cover a 130- by 130-km area.') call p (ifn,ith,lab,imx,jmx,1000,5000,10000,130000,130000) if (ifn .eq. 0) go to 44 write (16,215) go to 9 CYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYY c Prompting for all the parameters because standard set not selected c Distance equivalent to 0.12 to 0.25 inch gap 44 if (ifmet .eq. 1) then print 500 500 format (' You will type (integer meters) the size of the ', 1 'smallest subdivision, ') else print 201 201 format (' You will type (integer feet) the size of the ', 1 'smallest subdivision, ') end if print 300 300 format (' the thick line separation, the total width/', 1 'length of the template,',/,' and label spacing.') print 399 399 format (' DO YOU WANT TO EXIT THE PROGRAM TO PREPARE THE ', 1 'DESIGN?') read 501, ans if (ans .eq. 'y' .or. ans .eq. 'Y' .or. ans .eq. ' ') go to 99 k12=(0.12/factor)+0.5 k12=100*((k12+50)/100) k25=(0.25/factor)+0.5 k25=100*((k25+50)/100) print 503, k12,k25,unit(ifmet) write (16,503) k12,k25,unit(ifmet) 503 format (' The smallest subdivision should be a number rounded ', 1 ' to hundreds in the',/,' range of about',i6,' to',i6,1x,a6) 45 print 303 303 format (' TYPE the distance (integer) between the finest ', 1 'lines of the template:') read (5,*,err=45) ifn 47 print 306 306 format (' The distance between thick lines must be an ', 1 'integer multiple of the',/,' smallest interval.') print 307 307 format (' TYPE the distance (integer) between thick lines:') read (5,*,err=47) ith if (ith .ne. (ifn*(ith/ifn))) go to 47 print 308 308 format (' The maximum distance spans covered by the template ', 1 'must be multiples of the',/,' thick line interval.') c Find available map-unit span (except room for longest label) ndig1000=0.001*ylong ndig1000=ndig(ndig1000) c Number of digits in max y-value in km or kft (from m or ft) xwide=xwide-((0.04+float(ndig1000)*0.09)/factor) iwide=xwide/ith iwide=ith*iwide long=ylong/ith long=ith*long print 505, long,unit(ifmet),iwide,unit(ifmet) write (16,505) long,unit(ifmet),iwide,unit(ifmet) 505 format (i12,1x,a6,'=longest bottom-to-top distance available',/, 1 i12,1x,a6,'=longest left-to-right distance available') 49 print 310 310 format (' TYPE the maximum bottom-to-top distance covered by ', 1 'the template (integer):') read (5,*,err=49) imx if (imx .ne. (ith*(imx/ith))) then print 311 311 format (' Your distance is not an integer multiple of the ', 1 'thick line interval. Try again.') go to 49 end if if (imx .gt. long) then print 504 504 format (' Your distance exceeds the paper size. Try again.') go to 49 end if 50 print 313 313 format (' TYPE the maximum left-right distance covered by ', 1 'the template (integer):') read (5,*,err=50) jmx if (jmx .ne. (ith*(jmx/ith))) then print 311 go to 50 end if if (jmx .gt. iwide) then print 504 go to 50 end if 51 print 314 314 format (' Spacing of labeled thick lines must be an ', 1 'integral multiple of a thousand.') print 315 315 format (' TYPE the spacing of labels:') read (5,*,err=51) lab if (lab .ne. (ith*(lab/ith))) go to 51 if (lab .ne. (1000*(lab/1000))) go to 51 write (16,316) ifn,ith,imx,jmx 316 format (i10,'=finest subdivision',/,i10,'=spacing between ', 1 'thick lines',/,i10,'=bottom-to-top span',/,i10,'=left-right', 2 ' span') write (16,317) lab 317 format (i10,'=label spacing') return 9 print 317, lab return 99 ifmet=99 write (16,699) 699 format (' ****No template. User stopped program execution ', 1 'before completion.') close (16) return end c--------------------------------------------------------------- subroutine p (ifn,ith,lab,imx,jmx,i1,i2,i3,i4,i5) character ans*1 print 107 107 format (' Is this acceptable?') read 501, ans 501 format (a1) if (ans .eq. 'y' .or. ans .eq. 'Y' .or. ans .eq. ' ') then ifn=i1 ith=i2 lab=i3 imx=i4 jmx=i5 else ifn=0 end if return end c-------------------------------------------------------------- function ndig(ivalue) c Determine the number of digits in positive integer number ndig=1 nval=10 1 if (ivalue .lt. nval) return ndig=ndig+1 nval=nval*10 go to 1 end c-------------------------------------------------------------- subroutine fileopen (iscale,ifmet) character pstfile*8,un*1 c PostScript file name includes units (M/E) and scale/1000 if (iscale .gt. 999 .and. iscale .lt. 10000000) go to 1 print 100 write (16,100) 100 format (' The PostScript file to print is DRAWUTM.PST.') open (7,file='DRAWUTM.PST',form='formatted',status='unknown') return 1 scal=0.001*float(iscale) kdig=ndig(iscale)-3 if (ifmet .eq. 1) then un='M' else un='E' end if go to (4,5,6,7), kdig 4 write (pstfile,704) un,scal 704 format (a1,f3.1) go to 9 5 write (pstfile,705) un,scal 705 format (a1,f4.1) go to 9 6 write (pstfile,706) un,scal 706 format (a1,f5.1) go to 9 7 write (pstfile,707) un,scal 707 format (a1,f6.1) 9 print 101, pstfile write (16,101) pstfile 101 format (' The PostScript file to print is named ',a8) open (7,file=pstfile,form='formatted',status='unknown') return end