data iscale,ifn,ith,imx,jmx,ifpage/6*0/, 1 xscale,yscale/2*1.0/,factor,paperx,papery/3*0.0/,xstart/0.7/ c Page size and larger plots. print 100 100 format (' DRAW30, Plouff 2-98. Program to draw templates ', 1 'with lines spaced at',/,' multiples of 30 meters to iterpo', 2 'late UTM locations for 30-m Digital',/,' Elevation Models. ', 3 ' 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 HP DesignJet 650C plotter needs 0.7 margin to avoid truncation. ystart=xstart c Top 0.21, bottom 0.41 inch for labels/caption. Half width of c zero=0.03+. Extra 0.02 inch for mechanical registration of paper. width=(paperx-(xstart+xstart+0.06))/xscale height=(papery-(ystart+ystart+0.62))/yscale C ISCALE--reciprocal of map scale. IFN=distance between closest lines, c in meters. ITH=distance between medium lines. call prmpgen (iscale,ifn,ith,imx,jmx,ifpage,width,height, 1 factor,paperx,papery) if (iscale .eq. 0) go to 99 c Create PostScript file name from units and scale. Open it. call fileopen (iscale) 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 /,'/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 + 0.06-inch tickmark write (7,709) xstart,ystart 709 format ('72 72 scale ',f4.2,' 0.06 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 712 format ('HF8 1.85 0.14 M (',i5,'-METER GRID. LABELS IN ', 1 'KILOMETERS.) 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. Corners should overlay UTM E/N', 2 ' multiples of 30 m.) S') c Translate origin to plot. 0.11-inch print font for distance labels write (7,715) 715 format ('0.0 0.41 translate',/,'HF11') c Set plot scale factors and constants for far borders factory=factor*yscale xmax=bot*xscale c One more than total number of fine intervals, to draw edges nifnp=(imx/ifn)+1 c Draw 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 write (7,728) y,xmax,y 728 format ('MED 0.0 ',f9.3,' M ',2f9.3,' ST') 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 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 .eq. ith*(jeast/ith)) then c A thick line write (7,828) x,x,ymax 828 format ('MED ',f9.3,' 0.0 M ',2f9.3,' ST') 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 c Tick 500 m and label 1 km left-to-right rows from BOTTOM TO TOP. imaxdig=ndig(imx/1000) xp6=xmax+0.06 xp8=xmax+0.08 nifnp=(imx/500) if (500*nifnp .eq. imx) nifnp=nifnp+1 do 4 i=1,nifnp north=(i-1)*500 y=factory*float(north) c Draw tick marks outside left and right edges write (7,716) y,y,xmax,y,xp6,y 716 format ('MED -0.06 ',f9.3,' M 0.0',f9.3,' ST',/, 1 2f9.3,' M ',2f9.3,' ST') ivalue=north/1000 if (north .ne. (1000*ivalue)) go to 4 yp=y-0.055 idig=ndig(ivalue) c Multiples of number width, assuming 0.09 inch x=xp8+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 4 302 write (7,402) x,yp,ivalue 402 format(2f9.3,' M (',i2,') S') go to 4 303 write (7,403) x,yp,ivalue 403 format(2f9.3,' M (',i3,') S') go to 4 304 write (7,404) x,yp,ivalue 404 format(2f9.3,' M (',i4,') S') 4 continue yp6=ymax+0.06 yp9=ymax+0.09 factorx=factor*xscale njfnp=(jmx/500) if (500*njfnp .eq. jmx) njfnp=njfnp+1 c Draw and label bottom-to-top columns from LEFT-TO-RIGHT do 5 j=1,njfnp c Increasing x distance in map units jeast=(j-1)*500 x=factorx*float(jeast) c Draw tick marks outside bottom and top edges write (7,816) x,x,x,ymax,x,yp6 816 format ('MED ',f9.3,' -0.06 M ',f9.3,' 0.0 ST',/, 1 2f9.3,' M ',2f9.3,' ST') jvalue=jeast/1000 if (jeast .ne. (1000*jvalue)) go to 5 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,yp9,jvalue 901 format(2f9.3,' M (',i1,') S') go to 5 802 write (7,902) xp,yp9,jvalue 902 format(2f9.3,' M (',i2,') S') go to 5 803 write (7,903) xp,yp9,jvalue 903 format(2f9.3,' M (',i3,') S') go to 5 804 write (7,904) xp,yp9,jvalue 904 format(2f9.3,' M (',i4,') S') 5 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 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 'DRAW30.PNT.') inquire (file='DRAW30.PNT',exist=exists) if (exists) then print 112 112 format (' Print file DRAW30.PNT already exists.') print 114 114 format (' DO YOU WANT TO STOP TO RENAME IT RATHER THAN ', 2 'OVERWRITING IT?') read 501, ans 501 format (a1) if (ans .eq. 'y' .or. ans .eq. 'Y' .or. ans .eq. ' ') go to 9 end if c open file to write open (16,file='DRAW30.PNT',form='formatted',status='unknown') write (16,600) 600 format (' DRAW30, Plouff 2-98. Draws templates with multiple', 1 ' of 30-m grid to',/,' interpolate DEM/UTM coordinates. ', 2 'Must register with UTM multiples of 30m.') 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 9 ifpage=9 return end c------------------------------------------------------------------- subroutine prmpgen (iscale,ifn,ith,imx,jmx,ifpage, 1 width,height,factor,paperx,papery) character ans*1 print 200 200 format (' DO NOT TYPE DECIMAL POINTS OR COMMAS FOR THE FO', 1 'LOWING 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 (' Distances are expressed in meters.') 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 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 write (16,502) 502 format (' ***STOP. Plot labeling cannot be done. Scale or ', 1 'paper size yields a',/,' maximum distance of less than ', 2 '1,000 meters 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 print 106 106 format (' The standard template setup is 60 m between', 1 ' fine lines and 600 m',/,' between thick lines, to ', 2 'cover a 3- by 3-km area.') call p (ifn,ith,imx,jmx,60,600,3000,3000) if (ifn .eq. 0) go to 44 write (16,106) return 3 if (iscale .lt. 49000 .or. iscale .gt. 65000) go to 4 print 110 110 format (' The standard template setup is 150 m between', 1 ' fine lines and 1,500 m',/,' between thick lines, to ', 2 'cover a 9- by 15-km area.') call p (ifn,ith,imx,jmx,150,1500,15000,9000) if (ifn .eq. 0) go to 44 write (16,110) return 4 if (iscale .lt. 99000 .or. iscale .gt. 120000) go to 5 print 113 113 format (' A standard template setup is 300 m between', 1 ' fine lines and 1,500 m',/,' between thick lines, to ', 2 'cover a 15- by 15-km area.') call p (ifn,ith,imx,jmx,300,1500,15000,15000) if (ifn .eq. 0) go to 44 write (16,113) return 5 if (iscale .lt. 240000 .or. iscale .gt. 310000) go to 44 print 116 116 format (' A standard template setup is 300 m between', 1 ' fine lines and 6 km',/,' between thick lines, to ', 2 'cover a 30- by 30-km area.') call p (ifn,ith,imx,jmx,300,6000,30000,30000) if (ifn .eq. 0) go to 44 write (16,116) return 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 print 406 406 format (' A standard template setup is 60 m between', 1 ' fine lines and 600 m',/,' between thick lines, to ', 2 'cover a 6- by 6-km area.') call p (ifn,ith,imx,jmx,60,600,6000,6000) if (ifn .eq. 0) go to 44 write (16,406) return 8 if (paperx .lt. 26.0 .or. papery .lt. 26.0) go to 44 print 206 206 format (' A standard template setup is 60 m between ', 1 'fine lines and 600 m',/,' between thick lines, to ', 2 'cover a 15- by 15-km area.') call p (ifn,ith,imx,jmx,60,600,15000,15000) if (ifn .eq. 0) go to 44 write (16,206) return 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 print 209 209 format (' A standard template setup is 150 m between ', 1 'fine lines and 1,500 m',/,' between thick lines, to ', 2 'cover a 30- by 30-km area.') call p (ifn,ith,imx,jmx,150,1500,30000,30000) if (ifn .eq. 0) go to 44 write (16,209) return 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 print 212 212 format (' A standard template setup is 300 m between ', 1 'fine lines and 1,500 m',/,' between thick lines, to ', 2 'cover a 60- by 60-km area.') call p (ifn,ith,imx,jmx,300,1500,60000,60000) if (ifn .eq. 0) go to 44 write (16,212) return 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 print 215 215 format (' A standard template setup is 300 m between ', 1 'fine lines and 6 km',/,' between thick lines, to ', 2 'cover a 120- by 120-km area.') call p (ifn,ith,imx,jmx,300,6000,120000,120000) if (ifn .eq. 0) go to 44 write (16,215) return CYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYY c Prompting for all the parameters because standard set not selected c Distance equivalent to 0.12 to 0.25 inch gap 44 print 500 500 format (' You will type (integer meters) the size of the ', 1 'smallest subdivision, ') print 300 300 format (' the thick line separation, the total width/', 1 'length of the template.') print 399 399 format (' DO YOU WANT TO EXIT THE PROGRAM TO PREPARE THE ', 1 'DESIGN?') read 501, ans 501 format (a1) if (ans .eq. 'y' .or. ans .eq. 'Y' .or. ans .eq. ' ') go to 99 k05=(0.05/factor)+0.5 k05=100*((k05+50)/100) k25=(0.25/factor)+0.5 k25=100*((k25+50)/100) print 503, k05,k25 write (16,503) k05,k25 503 format (' The smallest subdivision should be an integer multi', 1 'ple of the 30 meters in the',/,' range of about',i6,' to', 2 i6,' meters') 45 print 303 303 format (' TYPE the distance (integer) between the finest ', 1 'lines of the template:') read (5,*,err=45) ifn if (ifn .lt. 30 .or. ifn .ne. (30*(ifn/30))) then print 304 304 format (' **Less than 30 m or not a multiple. TRY AGAIN.') go to 45 end if 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,iwide write (16,505) long,iwide 505 format (i12,'meters=longest bottom-to-top distance available',/, 1 i12,' meters=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 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') return 99 iscale=0 write (16,699) 699 format (' ****No template. User stopped program execution ', 1 'before completion.') close (16) return end c--------------------------------------------------------------- subroutine p (ifn,ith,imx,jmx,i1,i2,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 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) character pstfile*8,un*1 c PostScript file name includes units (M) 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 DRAW30.PST.') open (7,file='DRAW30.PST',form='formatted',status='unknown') return 1 scal=0.001*float(iscale) kdig=ndig(iscale)-3 un='D' 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