      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
