c 8-97, Plouff. Draws templates to map transfer of GPS locations, c e.g.. 1:24,000 page size plots of 2.5X2.5 minute or 7.5-minute c maps on plot sheets, e.g.. Drawing in PostScript format. c Coordinates: X--increase to right; Y--increase to top of paper; c longitudes/J increase to left; latitudes/I increase to top. C 5-97 Draw 0.01-minute tickmarks along edges of 1:24,000 template character*1 ans common /tmerc/ xscale,yscale,shiftx,shifty data iscale,ifine,icors,iend,jfine,jcors,jend,latd,latm,lats, 1 ifpage,latsouth,n,ifmin,map,kdeg,kmin,ksec,ifold, xne,yne, 2 paperx,papery,x1,x2,y1,y2,xse,yse,xcs,ycs,fmin/19*0,13*0.0/ xscale=0.0 yscale=0.0 c Derived from template program (announced as service by Plouff and c Barnes 5-29-74) with CALCOMP language calls for a pen plotter. The c last version first had templates aligned end-to-end on 11-inch c rolls, then adapted for groupings on larger sheets. HP interactive c mechanical origin shifts briefly was implemented. Thick lines c were done with pen changes or two strokes of a fine pen. Now, for c PostScript plotters, thick line strokes can be interspersed c with thin. Now, only a single category (projection, scale, c intervals) of templates are produced in an interactive session for c a span of latitudes. One file for each page size plot for c individual templates and one file per strip of larger templates. print 100 100 format (' DRAWGEOG, Plouff 5-98. Program to draw templates ', 1 'with labeled lines of',/,' equal latitude and longitude, ', 2 'which coincide with geographic gridmarks',/,' on maps. ', 3 'Graphical output is in PostScript format (laser, etc.).') c paperx--max width of paper; papery--paper length (inches) C XSCALE/YSCALE--SCALE FACTORS TO COMPENSATE FOR PLOTTER MIS- C CALIBRATION IN E-W (TOP-BOTTOM)/N-S (LEFT-RIGHT) DIRECTIONS. c Prompting for paper parameters. xscale and yscale passed via COMMON call prompap (paperx,papery,ifpage) if (ifpage .gt. 1) stop C MAP--0 FOR UTM; 1 FOR POLYCONIC. ISCALE--RECIPROCAL OF MAP SCALE. C LATD/LATM/LATS--LATITUDE OF SOUTH EDGE OF TEMPLATE EXPRESSED IN C DEG/MIN/SEC. I-PREFIX FOR LATITUDES; J-FOR LONGITUDES. FINE-- c DISTANCE BETWEEN CLOSEST SPACED LINES IN SECONDS. CORS--DISTANCE c BETWEEN THICK LABELED LINES. END--TOTAL HEIGHT OR WIDTH IN SECONDS. C IFMIN--ZERO OR BLANK IF COARSE LATITUDE LINES ARE LABELLED IN C DECIMAL MINUTES; OTHERWISE, MINUTES AND SECONDS. c ifpage not zero for 8.5- by 11-inch paper medium. call prmpgen (map,iscale,ifine,icors,iend,jfine,jcors,jend, 1 ifmin,ifpage,ifold) if (map .gt. 20) stop nifine=iend/ifine njfine=jend/jfine c One more than total number of fine intervals, to draw edges nifinep=nifine+1 njfinep=njfine+1 C Tickmark edges if finest interval is small. Dec min, seconds nsub=0 if (ifine .eq. 5) print 119 119 format (' Do you want tickmarks at an interval of one second ', 1 'marked along the edges?') if (ifine .eq. 6) print 120 120 format (' Do you want tickmarks at an interval of 0.01 minute ', 1 'marked along the edges?') read 501, ans 501 format (a1) if (ans .eq. 'y' .or. ans .eq. 'Y' .or. ans .eq. ' ') then if (ifine .eq. 5) nsub=5 if (ifine .eq. 5) write (16,607) 607 format (' Tickmarks at an interval of one second will be ', 1 'drawn along the edges.') if (ifine .eq. 6) nsub=10 if (ifine .eq. 6) write (16,608) 608 format (' Tickmarks at an interval of 0.01 minute will be ', 1 'drawn along the edges.') nsubi=nsub*nifine nsubj=nsub*njfine fnsubi=nsubi fnsubj=nsubj end if c Write interval lengths in deg/min/sec from seconds call prinparm (0,ifmin,ifine,icors,iend) call prinparm (1,ifmin,jfine,jcors,jend) c XSTART/YSTART--initial origin shift into printable part of paper. c A HP DesignJet 650C plotter needs 0.7 margin to avoid truncation. xstart=0.7 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? ystart=xstart c TOPLAB--Y room for longitude labels. BOT2--Y room for 2 lines. toplab=0.14+0.03 c 2 lines of print: (0.05+0.14+0.06) scale and (0.09+0.06) lengths. bot2=0.4 SCAL=ISCALE c Roughly, <1.86 km/minute (1220 inches/second) N-S ymargin=bot2+toplab yroom=ymargin+((float(iend)*1220.0)/scal) if ((yroom+2.0*ystart) .gt. papery) then print 101, yroom,ymargin write (16,101) yroom,ymargin 101 format (' PROGRAM STOP---',/,1x,f5.1,'-inch estimated N-S ', 1 'component of template size, including captions of',/,f6.1, 2 ' inch exceeds specified paper size.') go to 99 end if c LATD/LATM/LATS--latitude of south edge of southmost template. c IEND to test divisor. N--total number of templates to cover span c to northmost template. LATSOUTH--south edge in seconds. call prmcoord (latd,latm,lats,n,iend,latsouth) if (latd .gt. 89) go to 99 c Increment "map" for GO TO branch. 2=number of projections in PMER. MAP=MAP+1 MAPK=MAP+2 c HIEND--northernmost latitude rel center; HJEND--westmost longitude hiend=float(iend)/7200.0 hjend=float(jend)/7200.0 c CLAT--nominal mid-latitude clat=hiend+float(latsouth)/3600.0 c Initialize parameters for projection of widest (southmost) map. call pmer (mapk,clat,scal,x1,y1) shifty=0.0 shiftx=0.0 call pmer (map,-hiend,0.0,xcs,ycs) c Input to PMER IS CENTRAL MERIDIAN MINUS LONGITUDE; e.g. east edge c is positive HJEND (opposite positive west longitude sense). call pmer (map,-hiend,hjend,xse,yse) c SPANS--length of south edge c FLEFT--X room for half width of largest longitude minutes label. c RIGHT--X room for width of latitude minutes label (0.1X0.13). spans=2.0*(xse-xcs) fleft=0.07 if ((jcors/60) .gt. 9) fleft=0.15 right=0.87 if (ifmin .ne. 0) right=1.0 xmargin=fleft+right c XROOM is E-W room for one template, excluding inter-template gap. xroom=xmargin+spans c 5.2 inches needed for print at bottom--can underlie right label if (xroom .lt. 5.2) xroom=5.2 if ((xroom+2.0*xstart) .gt. paperx) then print 102, xroom,xmargin write (16,102) xroom,xmargin 102 format (' PROGRAM STOP---',/,1x,f5.1,'-inch east-west ', 1 'component of template size, including captions of',/,f6.1, 2 ' inch exceeds specified paper size.') go to 99 end if c For >one template per sheet, 1.5-inch gaps. Southmost multiple. mplate=(paperx-2.0*xstart+1.5)/(xroom+1.5) if (mplate .lt. 1) then c Hopefully, not encountered condition. print 103, mplate write (16,103) mplate 103 format (' ***STOP---program cannot handle',i3, 1 ' templates per file.') close (16) stop end if call pmer (map,hiend,hjend,xne,yne) yroom=ymargin+(yne-yse) print 104, xroom,yroom,mplate write (16,104) xroom,yroom,mplate 104 format (' Excluding a 1.5-inch east-west gap, each template ', 1 'occupies',f5.1,' inches or',/,' less in the east-west di', 2 'rection and',f5.1,' inches in the north-south',/,' direc', 3 'tion with',i3,' templates per paper width (and per file).') c Decimal minutes for finest intervals to be printed on template. finei=float(ifine)/60.0 finej=float(jfine)/60.0 c NFILE--increment number of files; NMAP--increment number of maps. nfile=0 nmap=0 c Longitude and relative latitude (to 0.5 second) at template center. midjend=jend/2 midiend=iend/2 latss=latsouth-iend c DO LOOP TO "N" TOTAL TEMPLATES, INCREMENTED BY MPLATE PER FILE do 9 kf=1,n,mplate nfile=nfile+1 latsouth=latss+iend call fileopen (nfile,latsouth) 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',/,'/DEG14 {MED CUR /ypo {yp 0.11', 7 ' add} def /xpo {xp 0.03 add} def',/,'newpath xpo ypo ', 8 '0.022 0 360 arc stroke} def') write (7,705) 705 format ('/MIN14 {MED CUR /ypo {yp 0.09 add} def /xpo {xp 0.02', 1 ' add} def',/,' xpo ypo M xpo 0.02 add ypo 0.05 add ST} def', 2 /,'/SEC14 {MED CUR /ypo {yp 0.09 add} def /xpo {xp 0.02 ', 3 'add} def',/,'xpo ypo M xpo 0.02 add ypo 0.05 add ST',/, 4 'xpo 0.03 add ypo M xpo 0.05 add ypo 0.05 add ST} 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') if (ifpage .eq. 1 .or. (paperx .eq. 11. .and. papery .eq. 1 17.)) then c Assume can plot to 0.4 inch from corner of page write (7,709) 709 format ('72 72 scale 0.4 0.4 translate') else c Found that a large plotter needed 0.7-inch gap to print write (7,710) 710 format ('72 72 scale 0.7 0.7 translate') end if do 8 kp=1,mplate nmap=nmap+1 latss=latss+iend c South edge of map in seconds yields mid-latitude. Later,increment midlats=latss+midiend clat=float(midlats)/3600.0 c Initialize map parameters for projection call pmer (mapk,clat,scal,xcs,ycs) c Shifts output inches relative to mid-latitude and east edge. shifty=0.0 shiftx=0.0 call pmer (map,-hiend,0.0,xcs,ycs) call pmer (map,-hiend,hjend,xse,yse) call pmer (map,hiend,hjend,xne,yne) c Length of south and east edges in inches. XCS should =0.00 sedge=(2.0*(xse-xcs))/xscale eedge=sqrt(((yne-yse)/yscale)**2+((xne-xse)/xscale)**2) c 0.14-inch print for scale. 0.08-inch print for rest. write (7,711) 711 format ('HF14 0.05 0.16 M (SCALE 1:) S') if (iscale .gt. 999999) then write (7,727) iscale 727 format ('(',i7,') S (.) S HF8') else if (iscale .gt. 99999) then write (7,726) iscale 726 format ('(',i6,') S (.) S HF8') else if (iscale .gt. 9999) then write (7,725) iscale 725 format ('(',i5,') S (.) S HF8') else write (7,724) iscale 724 format ('(',i4,') S (.) S HF8') end if end if end if if (ifmin .ne. 0) write (7,712) ifine,jfine 712 format ('1.85 0.16 M (SUBDIVISIONS ARE ) S (',i3,') S ( AND) ', 1 'S (',i3,') S ( SECONDS.) S') if (ifmin .eq. 0) write (7,713) finei,finej 713 format ('1.85 0.16 M (SUBDIVISIONS ARE ) S (',f5.2,') S ( AND) ', 1 'S (',f5.2,') S ( MINUTE.) S') c Map name in A-H 7.5-minute south to north quads per degree call temname (0,latss) write (7,714) sedge,eedge 714 format ('0.05 0.01 M (SOUTH EDGE=) S (',f5.2,') S ( INCHES;', 1 ' EAST EDGE=) S (',f5.2,') S',/,' ( INCHES (PLOUFF68).) S') c Old map name in A-D 15-minute south to north quads per degree if (ifold .ne. 0) call temname (1,latss) c 0.14-inch print font for lat/lon labels write (7,715) 715 format ('HF14') c Set up coordinate shifts relative to mid-lat/lon (base latitude c and central meridian) of template for greatest accuracy. c Leave room for 2 lines of print at bottom of template--0.4 inch. c YCS--y-coord of center of south edge, initially negative rel midpt shifty=0.4-ycs c Leave room for a half label for largest longitude to west. shiftx=fleft+xse c Draw and label latitude lines south to north c Set constants for longitude edges in secs/degs here or outside do 2 i=1,nifinep c ISEC/MSEC seconds relative to south edge and mid-latitude isec=(i-1)*ifine msec=isec-midiend dlat=float(msec)/3600.0 c West and east end points of a latitude parallel call pmer (map,dlat,-hjend,x1,y1) call pmer (map,dlat,hjend,x2,y2) if (nsub .eq. 0) go to 12 if (i .eq. 1 .or. i .eq. nifinep) then c Draw tickmarks, 0.01 minute or 1 second, along S and N edges dx=(x2-x1)/fnsubj dy=(y2-y1)/fnsubj c Don't draw if less than 0.015 inch apart if (dx .lt. 0.015) go to 12 dt=0.04 if (i .eq. nifinep) dt=-0.04 write (7,733) 733 format ('THIN') do 7 j=1,nsubj x=x1+j*dx y=y1+j*dy yt=y+dt 7 write (7,734) x,y,x,yt 734 format (2f9.3,' M ',2f9.3,' ST') end if 12 if ((isec-icors*(isec/icors)) .eq. 0) then c A labeled thick line is an integer multiple of the fine interval c Draw medium or thick line between 0.001-inch locations. ilats=isec+latss call secmin (ilats,kdeg,kmin,ksec,fmin) if (ksec .ne. 0) then write (7,728) x1,y1,x2,y2 728 format ('MED ',2f9.3,' M ',2f9.3,' ST') else c Medium line thickness if not integer minutes, else thick write (7,716) x1,y1,x2,y2 716 format ('THICK ',2f9.3,' M ',2f9.3,' ST') end if yp=y2-0.07 if (i .eq. 1 .or. i .eq. nifinep) write (7,717) x2,yp,kdeg c Degree label only for top and bottom lines 717 format (1x,f9.3,' 0.05 add ',f9.3,' M (',i2,') S DEG14') if (ifmin .eq. 0) then c Decimal minute notation if (ksec .ne. 0) then write (7,718) x2,yp,fmin 718 format(1x,f9.3,' 0.34 add ',f9.3,' M (',f5.2,') S MIN14') else c If zero seconds, integer minute notation instead of decimal write (7,729) x2,yp,kmin 729 format (1x,f9.3,' 0.34 add ',f9.3,' M (',i2,') S MIN14') end if else c Seconds notation with no seconds if zero trailing seconds write (7,719) x2,yp,kmin 719 format (1x,f9.3,' 0.34 add ',f9.3,' M (',i2,') S MIN14') if (ksec .ne. 0) write (7,731) x2,yp,ksec 731 format (1x,f9.3,' 0.62 add ',f9.3,' M (',i2,') S SEC14') end if else c Thin line segments write (7,720) x1,y1,x2,y2 720 format ('THIN ',2f9.3,' M ',2f9.3,' ST') end if 2 continue c Draw and label (starts at 0) longitude lines east to west do 3 j=1,njfinep c JSEC/MSEC seconds starting at east edge relative to mid-longitude jsec=(j-1)*jfine msec=midjend-jsec dlon=float(msec)/3600.0 c South and north end points of a longitude meridian call pmer (map,-hiend,dlon,x1,y1) call pmer (map,hiend,dlon,x2,y2) if (nsub .eq. 0) go to 11 if (j .eq. 1 .or. j .eq. njfinep) then c Draw tickmarks, 0.01 minute or 1 second, along S and N edges dx=(x2-x1)/fnsubi dy=(y2-y1)/fnsubi c Don't draw if less than 0.015 inch apart if (dy .lt. 0.015) go to 11 dt=0.04 if (j .eq. 1) dt=-0.04 write (7,733) do 10 i=1,nsubi x=x1+i*dx y=y1+i*dy xt=x+dt 10 write (7,734) x,y,xt,y end if 11 if ((jsec-jcors*(jsec/jcors)) .eq. 0) then c A thick line is an integer multiple of the fine interval c Draw medium or thick line between 0.001-inch locations. call secmin (jsec,kdeg,kmin,ksec,fmin) if (ksec .ne. 0) then write (7,728) x1,y1,x2,y2 else write (7,716) x1,y1,x2,y2 end if kmin=kmin+60*kdeg if (ksec .eq. 0) then c Label only integer minutes with zero trailing seconds if (kmin .lt. 10) then write (7,721) x2,y2,kmin 721 format (1x,f9.3,' -0.06 add ',f9.3,' 0.05 add M (',i1, 1 ') S MIN14') else if (kmin .lt. 100) then write (7,722) x2,y2,kmin 722 format (1x,f9.3,' -0.13 add ',f9.3,' 0.05 add M (', 1 i2,') S MIN14') else if (kmin .lt. 1000) write (7,723) x2,y2,kmin 723 format (1x,f9.3,' -0.19 add ',f9.3,' 0.05 add M (', 1 i3,') S MIN14') end if end if end if else c Thin lines write (7,720) x1,y1,x2,y2 end if 3 continue call secmin (latss,kdeg,kmin,ksec,fmin) print 605, nmap,kdeg,kmin,ksec write (16,605) nmap,kdeg,kmin,ksec 605 format (' South edge of template',i3,' is',i3,'D',i3,'M',i3, 1 'S') if (nmap .eq. n) then write (7,730) 730 format ('showpage') close (7) go to 98 end if if (kp .ne. mplate) then c DRAW 0.75 INCH VERTICAL LINE AND TRANSLATE ORIGIN 1.5 inch gap call pmer (map,hiend,hjend,x1,y1) call pmer (map,-hiend,hjend,x2,y2) xline=x2+right+0.75 write (7,732) xline,xline,y1,xline 732 format (f7.2,' 0.0 M ',2f7.2,' 0.2 add ST',/, 1 f7.2,' 0.75 add 0.0 translate') end if 8 continue write (7,730) close (7) 9 continue 98 print 699, nfile write (16,699) nfile 699 format (' A total of',i3,' sheets were plotted.') 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 27 ', 2 '(translate command) in file DRAWGEOG.PST 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 20 and 24.') 99 close(16) stop end C------------------------------------------------------------------ SUBROUTINE PMER (JENTRY,DPI,DLI,X,Y) C UTM and Polyconic approximations from Plouff, 1968, USGS PP 600-C, c p. C174-C176. Input degrees LAT/LON, output X/Y inches--3/4. c ****NOTE THAT LONGITUDES (ABSOLUTE VALUE) INCREASE TO WEST C INPUT DLI IS CENTRAL MERIDIAN OF MAP MINUS LONGITUDE IN DEGREES. C INPUT DPI IS LATITUDE MINUS CENTRAL LATITUDE OF MAP, IN DEGREES. COMMON /TMERC/ XSCALE,YSCALE,SHIFTX,SHIFTY C Preserve initial arguments. **Not in previous programs. common /args/SCALEX,SCALEY,CP,SP,SC5,FM1,SC228,AGE,AGEF,ASCALE DATA A,EQ,DEGR/6378206.0,6.768658E-3,1.745329E-2/ DPR=DEGR*DPI DLB=DEGR*DLI GO TO (1,2,3,4), JENTRY c Output X/Y are in inches from lower left origin shifted from midpt 1 G=AGE+DPR*AGEF X=SCALEX*G*(CP-DPR*SP)*DLB+SHIFTX C Rotated version had minus SCALEY Y=SHIFTY+SCALEY*(DPI*(FM1+DPR*SC228)+DLB*DLB*G*SC5) RETURN c Initially (JENTRY=1/2), DPI is mid-latitude CLAT and DLI=SCAL(e) C SET UP CONSTANTS OF AREA-DEPEND ON mid-LATITUDE ONLY. SCAL=DLI 3 SCALE=99.96/(DLI*2.54) SCALEX=SCALE*XSCALE SCALEY=SCALE*YSCALE c DPR is mid-latitude in degrees converted to radians CP=COS(DPR) SP=SIN(DPR) CP2=CP*CP SP2=1.0-CP2 SCP=SP*CP SC5=0.5*SCP F1141=1141.7-9.6*CP2 FM1=111699.3-CP2*F1141 SC228=F1141*SCP GE=1.0+0.5*EQ*SP2*(1.0+0.75*EQ*SP2) AGE=A*GE AGEF=A*EQ*SCP c 200 FORMAT (10X,'TRANSVERSE MERCATOR PROJECTION') RETURN 2 X=ASCALE*DLB*(AGEF-DPR*SP)+SHIFTX C Rotated version had minus SCALEY Y=SHIFTY+SCALEY*(DPI*FM1+DLB*DLB*AGE) RETURN 4 SCALE=100.0/(DLI *2.54) ASCALE=A*SCALE*XSCALE SCALEY=SCALE*YSCALE c DPR is central latitude CP=COS(DPR) SP=SIN(DPR) CP2=CP*CP SCP=SP*CP*0.5 FM1=111699.3+CP2*(9.6*CP2-1141.7) AGE=A*SCP AGEF= EQ*SCP*SP+CP c 201 FORMAT (10X,'POLYCONIC PROJECTION') RETURN END c------------------------------------------------------------------- subroutine prompap (paperx,papery,ifpage) character*1 ans logical exists COMMON /TMERC/ XSCALE,YSCALE,SHIFTX,SHIFTY 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 (' All lines on the templates are drawn as straight ', 1 'lines. The minimum span of',/, ' lines of equal longitude ', 2 'is the smallest geographic gridmark interval printed',/, 3 ' on the map to be overlain, and, to the extent plot paper ', 4 'is available, the',/,' maximum length can be the full ', 5 'height of the map. Inasmuch as projected',/,' parallels ', 6 'of latitude curve, the span of longitudes should equal or ', 7 'exceed',/,' the smallest geographic gridmark interval ', 8 'marked on the map to be overlain.') print 102 102 format (' The span of the smallest geographic gridmark inter', 1 'val commonly fits on an',/,' 8.5- by 11-inch sheet. Lar', 2 'ger plot sheets, for which templates are',/,' plotted side', 3 ' by side until the paper width is exceeded and a new file ', 4 'is',/,' started, are needed to span the north-south ', 5 'extent of maps. Only the',/,' Polyconic and the common ', 6 'Transverse Mercator projections are available,',/,' but ', 7 'scale factors might be adjusted to fit other projections.',/, 8 ' 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 name of the file that will record your session ', 1 'is DRAWGEOG.PNT.') inquire (file='DRAWGEOG.PNT',exist=exists) if (exists) then print 112 112 format (' DRAWGEOG.PNT already exists.',/,' DO YOU WANT TO', 1 ' STOP TO RENAME IT RATHER THAN BEING OVERWRITTEN?') 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='DRAWGEOG.PNT',form='formatted',status='unknown') write (16,600) 600 format (' DRAWGEOG, Plouff 5-98. Draws lines of equal lati', 1 'tude and longitude with a ',/,' PostScript plotter. The ', 2 'templates overlay maps with geographic registration.') print 113 113 format (' Do your templates fit on 8.5- by 11-inch sheets (a ', 1 'marked grid interval)?') 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 print 105 105 format (' Typical north-south lengths for the span of a map:', 1 ' about 26 inches at',/,' 1:24,000 and 1:100,000 and 21 ', 2 'inches at 1:62,500 and 1:250,000.',/,' Overestimates of ', 3 'available paper lengths in the direction of drum motion',/, 4 ' beyond these values may waste paper (advanced PageSize ', 5 'definition). ') 2 print 106 106 format(' TYPE the available length (in inches) of your paper:') read (5,*,err=2) papery 3 print 107 107 format (' TYPE the width of your plotter paper:') read (5,*,err=3) paperx write (16,602) papery,paperx 602 format (' Selected plotter paper length:',f6.1,' inches, ', 1 'width:',f6.1,' inches.') end if xscale=1.0 yscale=1.0 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 are expressed as true length divided ', 1 'by plot length.') 4 print 110 110 format (' TYPE the scale factor in the direction of paper ', 1 'length (N-S):') read (5,*,err=4) yscale 5 print 111 111 format (' TYPE the scale factor in the direction of paper ', 1 'width (E-W):') read (5,*,err=5) xscale 6 write (16,606) yscale,xscale 606 format(' Scale factors:',f7.4,' N-S',f7.4,' E-W.') return end c----------------------------------------------------------------- subroutine prmpgen (map,iscale,ifine,icors,iend,jfine, 1 jcors,jend,ifmin,ifpage,ifold) character*1 ans print 100 100 format (' Do the maps to be overlain have the typical Trans', 1 'verse Mercator projection?') read 501, ans 501 format (a1) if (ans .eq. 'y' .or. ans .eq. 'Y' .or. ans .eq. ' ') then write (16,600) 600 format (' Maps have the Transverse Mercator projection.') else map=1 write (16,601) print 601 601 format (' Maps have the Polyconic projection.') end if print 118 118 format (' Do want to print superseded A-D 15-minute names as', 1 ' well as A-H 7.5 minutes?') read 501, ans if (ans .eq. 'y' .or. ans .eq. 'Y' .or. ans .eq. ' ') ifold=1 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,602) iscale 602 format (' Scale selected is 1:',i7) print 102 102 format (' The finest intervals are designed for interpolating', 1 ' either decimal minutes',/,' or seconds.',/,' Do you want ', 2 'decimal minutes?') read 501, ans if (ans .eq. 'y' .or. ans .eq. 'Y' .or. ans .eq. ' ') then write (16,603) 603 format (' The finest template interval is to interpolate ', 1 'decimal minutes.') print 103 103 format (' The subdivisions are multiples of 6 seconds.') else ifmin=1 write (16,604) 604 format (' The finest template interval is to interpolate ', 1 'seconds.') print 104 104 format (' The subdivisions are multiples of 5 seconds.') end if c Fine/thick (coarse) lines and template extents in seconds only if (ifpage .ne. 1) go to 9 CXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX c Page-size templates if (iscale .lt. 23000 .or. iscale .gt. 28000) go to 3 print 105 105 format (' Your scale permits no more than the standard 2.5-', 1 'minute gridmark span.') if (ifmin .eq. 0) then print 106 106 format (' The standard template setup is: 0.1 minute between', 1 ' fine lines',/,' and 0.5 minute between thick lines, to ', 2 'cover the 2.5-minute span.') call q (ifine,icors,iend,jend,6,30,150,150) if (ifine .eq. 0) go to 44 write (16,106) else print 108 108 format (' The standard template setup is: 5 seconds between', 1 ' fine lines',/,' and 30 seconds between thick lines, to ', 2 'cover the 2.5-minute span.') call q (ifine,icors,iend,jend,5,30,150,150) if (ifine .eq. 0) go to 44 write (16,108) end if go to 8 3 if (iscale .lt. 49000 .or. iscale .gt. 65000) go to 4 print 109 109 format (' Your scale permits no more than the standard 5-', 1 'minute gridmark span.') if (ifmin .eq. 0) then print 110 110 format (' The standard template setup is: 0.1 minute between', 1 ' fine lines',/,' and 0.5 minute between thick lines, to ', 2 'cover the 5-minute span.') call q (ifine,icors,iend,jend,6,30,300,300) if (ifine .eq. 0) go to 44 write (16,110) else print 111 111 format (' The standard template setup is: 5 seconds between', 1 ' fine lines',/,' and 30 seconds between thick lines, to ', 2 'cover the 5-minute span.') call q (ifine,icors,iend,jend,5,30,300,300) if (ifine .eq. 0) go to 44 write (16,111) end if go to 8 4 if (iscale .lt. 99000 .or. iscale .gt. 120000) go to 5 c Could, with elaborate programming (a KTEST=1, e.g.) permit ICORS=60, c which does not divide by an integer into template span IEND. print 112 112 format (' Your scale permits no more than the standard 7.5-', 1 'minute gridmark span.') if (ifmin .eq. 0) then print 113 113 format (' A standard template setup is: 0.1 minute between', 1 ' fine lines',/,' and 0.5 minute between thick lines, to ', 2 'cover the 7.5-minute span.') call q (ifine,icors,iend,jend,6,30,450,450) if (ifine .eq. 0) go to 44 write (16,113) else print 114 114 format (' A standard template setup is: 5 seconds between', 1 ' fine lines',/,' and 30 seconds between thick lines, to ', 2 'cover the 7.5-minute span.') call q (ifine,icors,iend,jend,5,30,450,450) if (ifine .eq. 0) go to 44 write (16,114) end if go to 8 5 if (iscale .lt. 240000 .or. iscale .gt. 310000) go to 44 print 115 115 format (' Your scale permits 30 minutes latitude by 15 minutes ', 1 'longitude.') if (ifmin .eq. 0) then print 116 116 format (' A template setup is: 0.5-minute fine and 5-minute ', 1 ' thick lines') else print 117 117 format (' A template setup is: 30-second fine and 5-minute ', 1 'thick lines.') end if call q (ifine,icors,iend,jend,30,300,1800,900) if (ifine .eq. 0) go to 44 write (16,115) if (ifmin .eq. 0) then write (16,116) else write (16,117) end if 8 jfine=ifine jcors=icors return CXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX C Templates greater than 8.5- by 11-inch page size 9 if (iscale .lt. 23000 .or. iscale .gt. 28000) go to 13 if (ifmin .eq. 0) then print 206 206 format (' The standard template setup is: 0.1 minute between', 1 ' fine lines',/,' and 0.5 minute between thick lines, to ', 2 'cover a 2.5- by 7.5-minute span.') print 207 207 format (' A template will be about 25 inches in the north-', 1 'south dimension.') call q (ifine,icors,iend,jend,6,30,450,150) if (ifine .eq. 0) go to 44 write (16,206) else print 208 208 format (' The standard template setup is: 5 seconds between', 1 ' fine lines',/,' and 30 seconds between thick lines, to ', 2 'cover a 2.5- by 7.5-minute span.') print 207 call q (ifine,icors,iend,jend,5,30,450,150) if (ifine .eq. 0) go to 44 write (16,208) end if go to 8 13 if (iscale .lt. 49000 .or. iscale .gt. 65000) go to 14 if (ifmin .eq. 0) then print 209 209 format (' The standard template setup is: 0.1 minute between', 1 ' fine lines',/,' and 0.5 minute between thick lines, to ', 2 'cover a 5- by 15-minute span.') print 210 210 format (' A template will be about 19 inches in the north-', 1 'south dimension.') call q (ifine,icors,iend,jend,6,30,900,300) if (ifine .eq. 0) go to 44 write (16,209) else print 211 211 format (' The standard template setup is: 5 seconds between', 1 ' fine lines',/,' and 30 seconds between thick lines, to ', 2 'cover a 5- by 15-minute span.') print 210 call q (ifine,icors,iend,jend,5,30,900,300) if (ifine .eq. 0) go to 44 write (16,211) end if go to 8 14 if (iscale .lt. 99000 .or. iscale .gt. 120000) go to 15 if (ifmin .eq. 0) then print 212 212 format (' A standard template setup is: 0.1 minute between', 1 ' fine lines',/,' and 1 minute between thick lines, to ', 2 'cover a 15- by 30-minute span.') print 213 213 format (' A template will be about 23 inches in the north-', 1 'south dimension.') call q (ifine,icors,iend,jend,6,60,1800,900) if (ifine .eq. 0) go to 44 write (16,212) else print 214 214 format (' A standard template setup is: 5 seconds between', 1 ' fine lines',/,' and 1 minute between thick lines, to ', 2 'cover a 15- by 30-minute span.') print 213 call q (ifine,icors,iend,jend,5,60,1800,900) if (ifine .eq. 0) go to 44 write (16,214) end if go to 8 15 if (iscale .lt. 240000 .or. iscale .gt. 310000) go to 44 if (ifmin .eq. 0) then print 215 215 format (' A standard template setup is: 0.5 minute between', 1 ' fine lines',/,' and 5 minutes between thick lines, to ', 2 'cover a 15-minute by 1-degree span.') else print 217 217 format (' A standard template setup is: 30 seconds between', 1 ' fine lines',/,' and 5 minutes between thick lines, to ', 2 'cover a 15-minute by 1-degree span.') end if print 216 216 format (' A template will be about 19 inches in the north-', 1 'south dimension.') call q (ifine,icors,iend,jend,30,300,3600,900) if (ifine .eq. 0) go to 44 if (ifmin .eq. 0) then write (16,215) else write (16,217) end if go to 8 CYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYY c Prompting for all the parameters because standard set not selected 44 print 300 300 format (' You will type (in integer seconds) the geographic ', 1 'size of the smallest',/,' subdivision, the thick line sepa', 2 'ration, and total length of the template.',/,' Rarely would', 3 ' geographic subdivisions differ in the directions of longi', 4 'tude',/,' and latitude. Templates greater than page size ', 5 'generally have a longer',/,' total length in latitude than', 6 ' longitude; page size generally are equal.') if (ifmin .eq. 0) print 301 301 format (' The finest interval should be a multiple of 6 ', 1 'seconds.') if (ifmin .eq. 1) print 302 302 format (' The finest interval should be a multiple of 5 ', 1 'seconds.') 45 print 399 399 format (' DO YOU WANT TO EXIT THE PROGRAM?') read 501, ans if (ans .eq. 'y' .or. ans .eq. 'Y' .or. ans .eq. ' ') go to 99 print 303 303 format (' TYPE the distance (seconds) between the finest ', 1 'latitude lines of the template:') read (5,*,err=45) ifine print 304 304 format (' The same interval between longitude lines?') read 501, ans if (ans .eq. 'y' .or. ans .eq. 'Y' .or. ans .eq. ' ') then jfine=ifine else 46 print 305 305 format (' TYPE interval of fine longitude lines ', 1 '(integer seconds):') read (5,*,err=46) jfine end if print 306 306 format (' The distance between thick lines usually is a ', 1 'multiple of 30 seconds.') 47 print 307 307 format (' TYPE the distance between thick latitude lines ', 1 '(integer seconds):') read (5,*,err=47) icors if (icors .ne. (ifine*(icors/ifine))) then print 308 308 format (' Your thick-line interval is not an integer multi', 1 'ple of the fine interval.',/,' THE QUESTIONS WILL BE ', 2 'REPEATED.') go to 45 end if print 304 read 501, ans if (ans .eq. 'y' .or. ans .eq. 'Y' .or. ans .eq. ' ') then jcors=icors else 48 print 309 309 format(' TYPE the interval between thick longitude lines ', 1 '(integer seconds):') read (5,*,err=48) jcors end if if (jcors .ne. (jfine*(jcors/jfine))) then print 308 go to 45 end if 49 print 310 310 format (' TYPE the latitude height of your templates (minutes,', 1 ' seconds):') read (5,*,err=49) kmin,ksec iend=60*kmin+ksec if (iend .ne. (icors*(iend/icors))) then print 311 311 format (' Your latitude height is not an integer multi', 1 'ple of the thick line interval.',/,' THE QUESTIONS WILL', 2 ' BE REPEATED.') go to 45 end if print 312 312 format (' The longitude width of the templates usually equals', 1 ' the smallest gridmark',/,' interval of the map.',/,' For ', 2 'example 300 seconds for 1:62,500 maps, and 150 seconds for ', 3 '1:24,000.') 50 print 313 313 format (' TYPE the longitude width of your templates ', 4 '(minutes, seconds):') read (5,*,err=50) kmin,ksec jend=60*kmin+ksec if (jend .ne. (jcors*(jend/jcors))) then print 314 314 format (' Your longitude width is not an integer multi', 1 'ple of the thick line interval.',/,' THE QUESTIONS WILL', 2 ' BE REPEATED UNLESS YOU WANT TO EXIT THE PROGRAM.') print 399 read 501, ans if (ans .eq. 'y' .or. ans .eq. 'Y' .or. ans .eq. ' ') go to 99 go to 45 end if return 99 map=99 write (16,699) 699 format (' *****No templates. User stopped program execution ', 1 'before completion.') close (16) return end c------------------------------------------------------------------- subroutine prmcoord (latd,latm,lats,n,iend,latsouth) character*1 ans print 100 100 format (' One or more templates can be printed to cover a ', 1 'range of latitudes.',/,' Type 3 integer numbers (without ', 2 'decimal points) separated by spaces.') 1 print 101 101 format (' TYPE the latitude of the south edge of southmost ', 1 'template (deg,min,sec):') read (5,*,err=1) latd,latm,lats latd=iabs(latd) latm=iabs(latm) lats=iabs(lats) if (latd .gt. 89 .or. latm .gt. 59 .or. lats .gt. 59) then print 107 107 format (' ***TRY AGAIN. A COORDINATE IS WRONG.') go to 1 end if latsouth=lats+60*(latm+60*latd) if (latsouth .ne. iend*(latsouth/iend)) then print 102 102 format (' THE SOUTHMOST LATITUDE MUST BE AN INTEGER MULTIPLE', 1 ' OF THE TEMPLATE EXTENT.',/,' Try again unless you want ', 2 'to exit the program.',/,' DO YOU WANT TO EXIT THE PROGRAM?') read 501, ans if(ans .eq. 'y' .or. ans .eq. 'Y' .or. ans .eq. ' ') go to 99 go to 1 end if 2 print 103 103 format (' TYPE the latitude of the north edge of northmost ', 1 'template (deg,min,sec):') read (5,*,err=2) latdn,latmn,latsn latdn=iabs(latdn) latmn=iabs(latmn) latsn=iabs(latsn) latnorth=latsn+60*(latmn+60*latdn) if (latdn .gt. 89 .or. latmn .gt. 59 .or. latsn .gt. 59 1 .or. latnorth .le. latsouth) then print 107 go to 2 end if n=(latnorth-latsouth)/iend if ((latnorth-latsouth) .ne. (n*iend)) then n=n+1 latnorth=latsouth+iend*n latdn=latnorth/3600 latsn=latnorth-3600*latdn latmn=latsn/60 latsn=latsn-60*latmn print 104, latdn,latmn,latsn 104 format (' An increment was added so that the north edge is ', 1 ' a multiple of',/,' the template extent:',i3,'D',i3,'M', 2 i3,'S.') end if print 105, n 105 format (' A total of',i4,' templates will be prepared. If ', 1 'this is not acceptable,',/,' the request for the south ', 2 'edge will be repeated.',/,' IS THIS ACCEPTABLE?') read 501, ans 501 format (a1) if (ans .eq. 'y' .or. ans .eq. 'Y' .or. ans .eq. ' ') then write (16,600) n,latd,latm,lats,latdn,latmn,latsn 600 format (i5,' templates will be prepared.',/,' The latitude', 1 ' range is',i3,'D',i3,'M',i3,'S to',i3,'D',i3,'M',i3,'S.') else go to 1 end if return 99 latd=99 write (16,699) 699 format (' *****No templates. User stopped program execution ', 1 'before completion.') close (16) return end c------------------------------------------------------------------ subroutine prinparm (k,ifmin,ifine,icors,iend) c Print dimensions ifm=ifine/60 ifs=ifine-60*ifm icm=icors/60 ics=icors-60*icm ied=iend/3600 ies=iend-3600*ied iem=ies/60 ies=ies-60*iem if (k .eq. 0 .and. ifmin .ne. 0) 1 write (16,600) ifm,ifs,icm,ics,ied,iem,ies 600 format (' Latitude units. Finest:',i3,'M',i3,'S; coarse:', 1 i3,'M',i3,'S; template:',i2,'D',i3,'M',i3,'S.') kem=60*ied+iem if (k .eq. 1 .and. ifmin .ne. 0) 1 write (16,601) ifm,ifs,icm,ics,kem,ies 601 format (' Longitude units. Finest:',i3,'M',i3,'S; coarse:', 1 i3,'M',i3,'S; template:',i3,'M',i3,'S.') ffm=float(ifm)+float(ifs)/60.0 fcm=float(icm)+float(ics)/60.0 fem=float(iem)+float(ies)/60.0 if (k .eq. 0 .and. ifmin .eq. 0) 1 write (16,602) ffm,fcm,ied,fem 602 format (' Latitude units. Finest:',f6.2,'M; coarse:',f6.2, 1 'M; template:',i2,'D',f6.2,'M') if (k .eq. 1 .and. ifmin .eq. 0) 1 write (16,603) ffm,fcm,ied,fem 603 format (' Longitude units. Finest:',f6.2,'M; coarse:',f6.2, 1 'M; template:',i2,'D',f6.2,'M') return end c-------------------------------------------------------------- subroutine fileopen (nfile,latsouth) c Opens files named with south latitude of first template in strip character*8 pstfile logical exists latd=latsouth/3600 lats=latsouth-3600*latd flat=100.0*float(latd)+float(lats)/60.0 if (latd .le. 9) then write (pstfile,600) flat 600 format ('T',f6.2) else write (pstfile,700) flat 700 format ('T',f7.2) end if print 100, nfile,pstfile write (16,100) nfile,pstfile 100 format (' Template(s) file',i3,' is named ',a8) inquire (file=pstfile,exist=exists) if (exists) then print 800 write (16,800) 800 format (' Existing file will be overwritten.') end if open (7,file=pstfile,form='formatted',status='unknown') return end c--------------------------------------------------------------- subroutine secmin (isec,kdeg,kmin,ksec,fmin) c Converts seconds to integer degees/minutes/seconds and dec minutes kdeg=isec/3600 ksec=isec-3600*kdeg kmin=ksec/60 ksec=ksec-60*kmin fmin=float(kmin)+float(ksec)/60.0 return end c----------------------------------------------------------------- subroutine temname (i,latss) c Prints bold relative template name at right end of top line character name0(24)*2,name1(24)*3 data name0/'AS','AM','AN','BS','BM','BN','CS','CM','CN','DS', 1 'DM','DN','ES','EM','EN','FS','FM','FN','GS','GM','GN', 2 'HS','HM','HN'/ data name1/'ASS','ASM','ASN','ANS','ANM','ANN','BSS','BSM', 1 'BSN','BNS','BNM','BNN','CSS','CSM','CSN','CNS','CNM','CNN', 2 'DSS','DSM','DSN','DNS','DNM','DNN'/ latd=latss/3600 c Seconds north of integer degrees. USGS 7.5' nomenclature +2.5' S/M/N lats=latss-3600*latd c 150 seconds per 2.5' interval index=lats/150+1 if (i .eq. 0) write (7,770) name0(index) 770 format ('HF14 ( MAP ',a2,') S HF8') c Superseded 15-minute-based Alaskan-style names: A-D latit/1-8 longit if (i .eq. 1) write (7,771) name1(index) 771 format ('4.45 0.01 M (OLD MAP ',a3,') S') return end c----------------------------------------------------------------- subroutine q (ifine,icors,iend,jend,i1,i2,i3,i4) 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 ifine=i1 icors=i2 iend=i3 jend=i4 else ifine=0 end if return end