C PROGRAM TO PLOT 1:500,000 AND SMALLER MAPS OF CALIFORNIA, NEVADA C October 1986. PROGRAMMER DONALD PLOUFF. Larry Baker plot package. c Hewlett-Packard or Versatec plotter. CHARACTER*8 DENT CHARACTER*132 IFAKE character*60 infile C LIMIT OF RANDOM POINTS AND THEIR FORMAT. DIMENSION IFMT(20),XLIN(10) COMMON /IDEN/ DENT(4001) C LIMIT OF POINTS ALONG LINES (PLUS NUMBER OF DISCONNECTED LINES). COMMON /XYLINE/ XLON(1010),YLAT(1010) COMMON /XPT/ XLND(4000),YLTD(4000),ISYM(4001) COMMON /YPAP/ IW,ZPAPR,ZPAPG,ZBOTG,ZPAPS,ZBOTS,ZPAPH,XFACT,YFACT DATA IBLNK,NSYM,MPTS/2*' ',0/ DATA IFNEV,IFGRID,ISIZE,IFBNDY,IFPOST,IFOUR,IFSEC,ISCALE/8*0/ C IREAD-UNIT CARDS IMAGES ARE READ ON. C ZPINC-BASIC SYMBOL HEIGHT OF PLOTTER BEING USED. DEFAULT IS C TO 0.07 INCH. CALCOMP USUALLY IS 0.07 INCH. C XFACT,YFACT-FACTORS THAT X(RIGHT-LEFT)AND Y(TOP-BOTTOM) C PLOT DISTANCES ARE TO BE MULTIPLIED BY, TO CONVERT TO TRUE INCHES. C DEFAULTS ARE 1.0 FOR PLOTTERS WITH NO SCALE ERROR. IFPLOT=0 C MAXIMUM PTS/LINE-SEGS THAT CAN BE PLOTTED (DIMENSION LIMITS) MAXN=4001 MAXL=1009 C READ THIS PARAMETER CARD ON READ UNIT 15. C 'IFVERS'(30-31) IS NON-ZERO IF VERSATEC PLOTTER IS TO BE USED C XGAP (3-5) IS SPACE IN INCHES BETWEEN PLOT SECTIONS (BEYOND ONE- C INCH BORDER ON EACH SIDE FOR LETTERING). OPTION XGAP IS USED TO C MINIMIZE STORAGE CHARGES IN ELECTROSTATIC PLOTTERS OR TO PROVIDE C LARGER BLANK BORDERS FOR PEN PLOTTERS. DEFAULT IS 2 INCHES. C MAXIMUM IS 20 INCHES. NOTEN (32-33) IS NON-ZERO IF NO C CALIBRATION 10-INCH L-SHAPED LINE IS TO BE 'DRAWN' BY C AN ELECTROSTATIC PLOTTER. C ZPAPR(6-10) IS PAPER WIDTH IN INCHES WITH DEFAULT OF 29.4. C IW(34-35) IS THE NUMBER OF THE PRINT FILE FOR A DETAILED PRINTOUT OF C POSITIONS NOT PLOTTED BECAUSE THEY ARE OUTSIDE THE PLOT PAPER (ONLY C ON ROTATED MAPS). DEFAULT IS 16. print 600 600 format (' California or Nevada map-drawing program.',/,' See ', 1 'Don Plouff for complete documentation.',/,' A printed record', 2 ' of this session is in a file called CALNEV.PNT',/,' TYPE ', 3 'the name of the data input file:') read (5,601) infile 601 format (a60) open (unit=15,file=infile,form='formatted',status='old', 1 blank='zero',readonly,shared) open (unit=16,file='CALNEV.PNT',form='formatted',status='new') READ (15,100) IREAD,XGAP,ZPAPR,ZPINC,XFACT,YFACT,IFVERS,NOTEN,IW 100 FORMAT(I2,F3.0,2F5.0,2F7.0,3I2) IF (ZPINC .EQ. 0.0) ZPINC=0.07 IF (XFACT .EQ. 0.0) XFACT=1.0 IF (YFACT .EQ. 0.0) YFACT=1.0 IF (XGAP .EQ. 0.0) XGAP=2.0 IF (XGAP .GT. 19.0) XGAP=20.0 C PROGRAM DESIGNED TO FILL MAXIMUM 30-INCH PAPER IF (ZPAPR .EQ. 0.0) ZPAPR=29.4 c IF (IW .EQ. 0) IW=16 c IF (IREAD .EQ. 0) IREAD=15 c IREAD (read unit), IW (write unit), and IFVERS (kind of plotter) are c ignored. iread=15 iw=16 PRINT 200, ZPINC,ZPAPR,XFACT,YFACT,XGAP write (16,200) ZPINC,ZPAPR,XFACT,YFACT,XGAP 200 FORMAT('0BASIC PLOTTER INCREMENT ', 1'IS',F6.3,' INCH ON',F7.1,' INCH PAPER.',/,' MULTIPLYING FACTORS' 2 ,' FOR X- AND Y-PLOTTER DIRECTIONS ARE ',F8.4,' AND',F8.4,/, 3 10X,'GAP=',F4.1,' INCHES.') C READ AND LIST THE PARAMETERS 1 CALL PARAM(IREAD,IFMT,IFNEV,MPTS,NSYM,IFGRID,ISIZE,IFBNDY, 1 IFPOST,IFOUR,IFSEC,ZPINC,ISCALE) N=0 IF (ISCALE .LT. 500000) GO TO 97 C ESTABLISH PAPERSIZE LIMITS. G FOR GRID. S FOR SYMBOLS. ZBOTG=ZPINC*IFGRID*1.5 ZBOTS=ZPINC*ISIZE*0.5+0.01 ZBOTT=ZBOTS IF (IFPOST .NE. 0) ZBOTT=ZPINC*ISIZE*7.0 ZPAPH=0.5*ZPAPR ZPAPS=ZPAPR-ZBOTT ZPAPG=ZPAPR-ZBOTG IF (MPTS .EQ. 0) GO TO 4 C CONNECTED POINTS FORM LINE. BLANK COORDINATES SEPARATE LINES. MPTS=0 2 READ (IREAD,101,ERR=99) (XLIN(I),I=1,10) 101 FORMAT (10F8.3) DO 3 I=1,9,2 YI=XLIN(I) C LAST POINT OF LAST LINE IS FOLLOWED BY A POINT WITH LATITUDE OF ALL C NINES. IF (YI .GT. 90) GO TO 4 MPTS=MPTS+1 IF (MPTS .GT. MAXL) GO TO 99 YLAT(MPTS)=YI 3 XLON(MPTS)=XLIN(I+1) GO TO 2 4 PRINT 201,MPTS 201 FORMAT(' LINE SEGMENTS=',I5) C RANDOM POINTS 5 N=N+1 IF (N .GT. MAXN) GO TO 99 C ARTIFICIAL READ, TO PAD END OF LINE WITH BLANKS, IN CASE USER HAS C CARRIAGE RETURN EMBEDDED IN A NUMBER OR NAME BEFORE END OF LINE READ (IREAD,500) IFAKE 500 FORMAT (A132) GO TO (6,7,8), IFSEC C DEGREES FORMAT 6 READ (IFAKE,IFMT,ERR=99) DENT(N),YDEG,XDEG,ISYM(N) GO TO 9 C DEGREES, DECIMAL MINUTES 7 READ (IFAKE,IFMT,ERR=99) DENT(N),YDEG,YMIN,XDEG,XMIN,ISYM(N) YDEG=YDEG+YMIN/60.0 XDEG=XDEG+XMIN/60.0 GO TO 9 C DEGREES, MINUTES, SECONDS 8 READ (IFAKE,IFMT,ERR=99) DENT(N),YDEG,YMIN,YSEC,XDEG,XMIN,XSEC, 1 ISYM(N) YDEG=YDEG+(YMIN+YSEC/60.0)/60.0 XDEG=XDEG+(XMIN+XSEC/60.0)/60.0 9 IF (YDEG .GT. 90.0) GO TO 10 YLTD(N)=YDEG XLND(N)=XDEG-100.0 IF (NSYM .NE. IBLNK) ISYM(N)=NSYM GO TO 5 10 N=N-1 PRINT 202, N 202 FORMAT(1X,I5,' RANDOM POINTS TO BE PLOTTED.') IF (IFPLOT .NE. 0) GO TO 12 C INITIALIZE Hewlett-Packard, HOUSTON OR VERSATEC PLOTTER CALL PLOTS (0,0,0) c IF (IFVERS .EQ. 0) GO TO 11 C VERSATEC PLOTTER c IF (IFVERS .GT. ISIZE .AND. ISIZE .GT. 0) IFVERS=ISIZE c WID=0.005*IFVERS c PRINT 203, WID c 203 FORMAT (' VERSATEC PLOTTER WITH LINE WIDTH OF',F6.3,' INCH') c CALL NEWPEN(IFVERS) c XP=1.0 c IF (NOTEN .NE. 0) GO TO 13 C DRAW 10-INCH LINES FOR SCALE ERROR CHECK BEFORE EACH PLOT C BASHES PEN AGAINST EDGE TO CORRECT HOUSTON PROBLEM 11 if (noten .ne. 0) go to 13 XP=10.0*XFACT YP=10.0*YFACT CALL PLOT(XP,0.2,3) CALL PLOT(XP,0.0,2) CALL PLOT(0.0,0.0,2) CALL PLOT(0.0,YP,2) CALL PLOT(0.2,YP,2) C NEW PLOT FRAME XP=10.0+XGAP 13 CALL PLOT(XP,0.0,-3) PRINT 204, XP 204 FORMAT (1X,F6.1,' INCHES OF CALIBRATION PLOTTING DONE') IFPLOT=1 12 CALL CALIF(N,ISIZE,ISCALE,IFBNDY,IFGRID, 1 IFPOST,ZPINC,IFOUR,MPTS,IFNEV,XGAP) GO TO 1 97 IF (IFPLOT .EQ. 0) then close (15) close (16) end if STOP 98 CALL PLOT(0.0,0.0,999) PRINT 209 209 FORMAT (' Your plot file is called BATCH.PLT') c (default FOR038.DAT) should be written ', c 1 'by:',/,' alloc MTA0:',/,' ',/, c 2 ' mount/dens=800/block=1020/record=1020/foreign ', c 3 'MTA0: ',/,' copy/log FOR038.DAT MTA0:',/,' ',/,' dismount MTA0:',/,' dealloc MTA0:') c IF (IFVERS .NE. 0) CALL PLOT(0.0,0.0,-999) close (15) close (16) STOP 99 PRINT 900, MPTS,N 900 FORMAT('0STOP. TOO MANY LINE SEGMENTS (',I4,') OR POINTS (',I4, 1 ') OR OTHER ERROR') IF (IFPLOT .NE. 0) GO TO 98 close (15) close (16) STOP END SUBROUTINE PTS(N,LTS,LTN,LNE,LNW,I,ZHT,XRIGHT,ZSIZE,IFPOST) C DRAWS RANDOM POINTS AND OPTIONAL ONE-DEGREE GRIDMARKS. C PEN MOVEMENT OPTIMIZED TO BUT NOT WITHIN ONE-DEGREE RECTANGLES IMPLICIT REAL*8 (A-H,O-W) CHARACTER*8 DENT DIMENSION LTS(12),LTN(12),LNE(12),LNW(12) COMMON/IRAY/ IPT(4000) COMMON /XPT/ XLND(4000),YLTD(4000),ISYM(4001) COMMON /IDEN/ DENT(4001) COMMON /CONST/DEGR,QFK,BA2,BA4,FLD,STDLN,ROT,STX,STY COMMON /YPAP/ IW,ZPAPR,ZPAPG,ZBOTG,ZPAPS,ZBOTS,ZPAPH,XFACT,YFACT DATA JDOT,JBLNK,JPLUS/'.',' ','+'/ MISSP=0 C PERIOD AND CONSTANT SHIFTS FOR SPOTC ROUTINE AND 8-DIGIT NAME ZS=DSIN(ROT) ZC=DCOS(ROT) C BENSON-LEHNER PLOTTER 0.06-INCH HT. 0.04 WIDTH/0.02 GAP C XSPOT=ZSIZE*(0.5*ZS-ZC/3.0) C YSPOT=-ZSIZE*(0.5*ZC+ZS/3.0) C HOUSTON PLOTTER 0.07-INCH HT. 0.01/0.04/0.01 WIDTH F7=1.0/7.0 ZSIZW=6.0*ZSIZE*F7 XSPOT=ZSIZE*(0.5*ZS-3.0*ZC*F7) YSPOT=-ZSIZE*(0.5*ZC+3.0*ZS*F7) X8=ZSIZE*F7*(3.0*ZC+ZS) C OFFSET FOR NAME AFTER ONE-DIGIT SYMBOL Y8=ZSIZE*F7*(3.0*ZS-ZC) C HOUSTON SYMBOL WIDTH=6/7 HT. BENSON IS 6/6. ZWT=6.0*ZHT*F7 XPLUSG=ZWT*ZS/3.0 YPLUSG=ZWT*ZC/3.0 XDOT=ZSIZW*(ZS-ZC)/6.0 YDOT=ZSIZW*(ZS+ZC)/6.0 XPLUS=ZSIZW*ZS/3.0 YPLUS=ZSIZW*ZC/3.0 NPTS=0 C NUMBER OF GRIDMARKS IN EACH DIRECTION LONG=LNW(I)-LNE(I)+1 LAT=LTN(I)-LTS(I)+1 C LABELS YS=LTS(I) YN=LTN(I) LNEP=LNE(I)+100 LNWN=LNW(I)+100 XE=LNEP XW=LNWN LTSM=LTS(I)-1 LNWP=LNW(I)+1 LNEM=LNE(I)-1 IROT=0.5D0+ROT/DEGR ZROT=IROT C WESTWARD MOVEMENT IS=1. EASTWARD, -1. IS=1 DO 13 L=1,N 13 IPT(L)=0 DO 11 K=1,LAT IS=-IS C SOUTH EDGE, AND NO GRID OPTION IF (ZHT .EQ. 0.0 .AND. K .EQ. 1) GO TO 11 WLAT=K+LTSM WLATM=WLAT-1.0 THETA=DEGR*WLAT C DONOT MOVE THE FOLLOWING STATEMENT POSITION, BECAUSE GRIDMARKS WOULD C BE WRONG. IT IS FOR POINTS SLIGHTLY NORTH OF THE STATE BORDER. IF (WLAT .EQ. 42.0) WLAT=42.02 C=DCOS(THETA) S=DSIN(THETA) QR=QFK*(C/(BA2*S+DSQRT(C*C+BA4*S*S)))**0.6305D0 DO 10 J=1,LONG IF (IS .EQ. -1) GO TO 2 C WESTWARD MOVEMENT LN=LNEM+J XMAX=LN+1 GO TO 3 C EASTWARD MOVEMENT 2 LN=LNWP-J XMAX=LN 3 XMIN=XMAX-1.0 C NO GRID OPTION IF (ZHT .EQ. 0.0) GO TO 5 DLAML=FLD*(STDLN-LN)+ROT X=(QR*DSIN(DLAML)-STX)*XFACT C NEXT TEST GENERALLY NOT NEEDED C IF (X .LT. 0.0 .OR. X .GT. XRIGHT) GO TO 5 Y=(-QR*DCOS(DLAML)-STY)*YFACT C PROTECT AGAINST GRIDMARKS OUTSIDE PAPERWIDTH IF (Y .LT. ZBOTG .OR. Y .GT. ZPAPG) GO TO 5 C PROVIDE ONE DEGREE MARKS FOR CALIFORNIA BASE MAP. CALL SPOTC(X,Y,ZHT,JPLUS,ZROT,XPLUSG,YPLUSG) IF (K .NE. 1) GO TO 4 IF (LNE(I) .NE. LN) GO TO 5 C LABEL AT SOUTHEAST CORNER. LATITUDE, LONGITUDE XP=X+ZHT*(ZC+0.5*ZS) YP=Y+ZHT*(ZS-0.5*ZC) CALL NUMBER(XP,YP,ZHT,YS,ZROT,-1) XP=X+ZHT*(2.17*ZS-1.33*ZC) YP=Y-ZHT*(2.17*ZC+1.33*ZS) CALL NUMBER(XP,YP,ZHT,XE,ZROT,-1) GO TO 10 4 IF (K .NE. LAT) GO TO 5 IF (LNW(I) .NE. LN) GO TO 5 C LABEL AT NORTHWEST CORNER. XP=X+ZHT*(0.5*ZS-2.33*ZC) YP=Y-ZHT*(2.33*ZS+0.5*ZC) CALL NUMBER(XP,YP,ZHT,YN,ZROT,-1) XP=X-ZHT*(1.33*ZC+1.17*ZS) YP=Y+ZHT*(1.17*ZC-1.33*ZS) CALL NUMBER(XP,YP,ZHT,XW,ZROT,-1) C SYMBOL PLOT IN ONE DEGREE RECTANGLE. NO RECTANGLES BELOW SOUTH EDGE. C LAST GRIDPOINT HAS NO INTERIOR RECTANGLE 5 IF (K .EQ. 1 .OR. J .EQ. LONG) GO TO 10 C BYPASS LOOP IF NO DATA POINTS IF (N .EQ. 0) GO TO 10 C FIND DATA POINTS WITHIN THIS ONE-DEGREE RECTANGLE DO 9 L=1,N C TEST IF LATITUDE OF POINT OUTSIDE ONE-DEGREE RECTANGLE ZLT=YLTD(L) IF (ZLT .LE. WLATM) GO TO 9 IF (ZLT .GT. WLAT) GO TO 9 ZLN=XLND(L) IF (ZLN .EQ. XMAX .AND. ZLN .EQ. XW) GO TO 55 IF (ZLN .GE. XMAX) GO TO 9 IF (ZLN .LT. XMIN) GO TO 9 55 CALL CALC(ZLT,ZLN,X,Y,XFACT,YFACT) C POINT OFF THE PAPER IF (Y .GT. ZBOTS .AND. Y .LT. ZPAPS) GO TO 56 C LOCATION IS OFF THE PLOT PAPER MISSP=MISSP+1 ZLN=ZLN+100.0 WRITE (IW,600) DENT(L),L,ZLT,ZLN 600 FORMAT (5X,'LOCATION ',A8,' (SEQUENCE',I5,') IS OUTSIDE PLOT AT', 1 2F7.2,' DEGREES') GO TO 9 56 NPTS=NPTS+1 IPT(L)=IPT(L)+1 IF (ISYM(L) .EQ. JDOT) GO TO 6 IF (ISYM(L) .EQ. JPLUS) GO TO 7 C SYMBOLS EXCEPT PERIOD OR PLUS SIGN CALL SPOTC(X,Y,ZSIZE,ISYM(L),ZROT,XSPOT,YSPOT) GO TO 8 C DECIMAL POINT IS REPLACED BY A CENTERED SQUARE. PLUS IS 2/3 HEIGHT. 6 CALL SPOTC(X,Y,ZSIZE,JDOT,ZROT,XDOT,YDOT) GO TO 8 7 CALL SPOTC(X,Y,ZSIZE,JPLUS,ZROT,XPLUS,YPLUS) 8 IF (IFPOST .EQ. 0) GO TO 9 C PLOT 8-DIGIT NAME TO RIGHT OF AND ABOVE CENTERED SYMBOL. XP=X+X8 YP=Y+Y8 C IF NO CENTERED SYMBOL, LEFTMOST DENT IS CENTERED IF (ISYM(L) .NE. JBLNK) GO TO 12 XP=X+XSPOT YP=Y+YSPOT C 12 CALL LETTER(8,ISIZE,IROT,XP,YP,DENT(L)) C 12 CALL HSYMBL(XP,YP,ZSIZE,%REF(DENT(L)),ZROT,8) 12 CALL SYMBOL(XP,YP,ZSIZE,%REF(DENT(L)),ZROT,8) 9 CONTINUE 10 CONTINUE 11 CONTINUE PRINT 200, NPTS,LTS(I),LTN(I),LNEP,LNWN 200 FORMAT(I5,' POINTS PLOTTED FROM', I3,' TO', I3,' LATITUDE AND', 1 I4,' TO', I4,' LONGITUDE') NZ=0 N2=0 DO 16 L=1,N IF (IPT(L)-1) 14,16,15 14 NZ=NZ+1 IPT(NZ)=L GO TO 16 15 N2=N2+1 16 CONTINUE IF (NZ .EQ. 0) GO TO 17 PRINT 202, NZ,(IPT(L),L=1,NZ) 202 FORMAT (1X,60('*'),/,1X,I4,' input points were NOT plotted.', 1 ' Sequences numbers of unplotted points:',/,(15I5)) IF (MISSP .NE. 0) WRITE (IW,202) NZ,(IPT(L),L=1,NZ) 17 IF (N2 .NE. 0) PRINT 203, N2 203 FORMAT (1X,I4,' points plotted on more than one section.') IF (MISSP .NE. 0) PRINT 201, MISSP 201 FORMAT (I6,' POINTS ARE OUTSIDE BORDER OF PAPER. ', 1 'SEE DETAILED PRINTOUT.') RETURN END SUBROUTINE CLINE(I,MPTS,ZSTH,ZNTH,ZEAST,ZWEST,XRIGHT) C DRAW ONE OR MORE LINES WITH SPECIFIED GEOGRAPHIC COORDINATES. C ZERO VALUE COORDINATES FILL GAPS BETWEEN SEPARATED LINE SEGMENTS COMMON /XYLINE/ XLON(1010),YLAT(1010) COMMON /YPAP/ IW,ZPAPR,ZPAPG,ZBOTG,ZPAPS,ZBOTS,ZPAPH,XFACT,YFACT DATA X,Y/2*0.0/ C IN=0 SIGNIFIES THAT THE PREVIOUS POINT FALLS OUTSIDE THE PLOT BORDER. IN=0 L=0 MISSL=0 C ALLOW LINES TO BE PLOTTED SLIGHTLY NORTH OF STATE BORDER IF (ZNTH .EQ. 42.0) ZNTH=42.02 DO 4 J=1,MPTS ZLT=YLAT(J) C GEOGRAPHIC LIMITS IF (ZLT .EQ. 0.0 .OR. ZLT .GT. ZNTH .OR. ZLT .LT. ZSTH) GO TO 3 ZLN=XLON(J)-100.0 IF (ZLN .GT. ZWEST .OR. ZLN .LT. ZEAST) GO TO 3 CALL CALC(ZLT,ZLN,X,Y,XFACT,YFACT) C NEXT LINE GENERALLY NOT BE NEEDED C IF (X .LT. 0.0 .OR. X .GT. XRIGHT) GO TO 3 C PAPERSIZE LIMIT IF (Y .LT. ZPAPR .AND. Y .GT. 0.0) GO TO 2 MISSL=MISSL+1 GO TO 3 2 IF (IN.NE. 0) GO TO 5 CALL PLOT(X,Y,3) IN=1 5 CALL PLOT(X,Y,2) L=L+1 GO TO 4 3 IN=0 4 CONTINUE IF (MISSL .NE. 0) PRINT 200, MISSL 200 FORMAT (I10,' LINE SEGMENTS ARE OUTSIDE PAPER BORDER.') PRINT 201, L 201 FORMAT (1X,I6,' LINE SEGMENTS PLOTTED.') RETURN END SUBROUTINE CALC(ZLT,ZLN,X,Y,XFACT,YFACT) C INPUT LATITUDE AND LONGITUDE IN DEGREES C OUTPUT X-Y COORDINATES IN INCHES IMPLICIT REAL*8 (A-H,O-W) COMMON /CONST/DEGR,QFK,BA2,BA4,FLD,STDLN,ROT,STX,STY THETA=DEGR*ZLT C=DCOS(THETA) S=DSIN(THETA) QR=QFK*(C/(BA2*S+DSQRT(C*C+BA4*S*S)))**0.6305D0 DLAML=FLD*(STDLN-ZLN)+ROT X=( QR*DSIN(DLAML)-STX)*XFACT Y=(-QR*DCOS(DLAML)-STY)*YFACT RETURN END SUBROUTINE CONSTN(ISCALE) C SET UP LAMBERTS CONSTANTS FOR STANDARD LATITUDES OF 33 AND 45 DEGREES IMPLICIT REAL*8(A-H,O-W) COMMON /CONST/ DEGR,QFK,BA2,BA4,FLD,STDLN,ROT,STX,STY DEGR=3.141592654D0/1.8D2 BA2=0.9932313D0 BA4=BA2*BA2 FL=0.6305D0 FK=12452660.0D0 SCALE=ISCALE Q=39.37D0/SCALE FLD=FL*DEGR QFK=Q*FK RETURN END SUBROUTINE OUTLIN(I) INTEGER XP,XN,X1,X2,X3,X4,X5,X6,X7,X8 DIMENSION K1S(12),K1F(12),K2S(8),K2F(8),XOFF1S(8),XOFF1F(8), 1 XOFF2S(8),XOFF2F(8),XP(742),X1(120),X2(122),X3(120),X4(120), 2 X5(122),X6(138),XN(246),X7(120),X8(126) EQUIVALENCE (XP(1),X1(1)),(XP(121),X2(1)),(XP(243),X3(1)), 1 (XP(363),X4(1)),(XP(483),X5(1)),(XP(605),X6(1)) EQUIVALENCE (XN(1),X7(1)),(XN(121),X8(1)) C DATA POINTS ARE PAIRED LATITUDE/LONGITUDE (MINUS 100) IN THOUSANDTHS C DEGREES C BOUNDARY OF CALIFORNIA IS DRAWN WITH 370 LINE SEGMENTS DATA X1/39000, * 23698,39022,23690,39129,23717,39202,23767,39355,23819, 5 * 39493,23797,39577,23759,39610,23786,39616,23772,39685,23786, 10 * 39726,23822,39833,23841,39862,23897,39903,23916,40021,24039, 15 * 40025,24073,40071,24078,40109,24113,40137,24189,40157,24208, 20 * 40205,24291,40261,24357,40322,24344,40339,24359,40380,24362, 25 * 40404,24388,40441,24405,40492,24379,40505,24386,40665,24298, 30 * 40754,24234,40751,24228,40701,24259,40690,24222,40708,24212, 35 * 40726,24223,40742,24216,40748,24203,40791,24189,40814,24160, 40 * 40812,24128,40827,24089,40850,24088,40863,24098,40853,24120, 45 * 40869,24144,40761,24219,40766,24228,40906,24146,41026,24111, 50 * 41059,24137,41055,24153,41143,24165,41142,24144,41286,24093, 55 * 41421,24063,41473,24063,41543,24083,41579,24102,41596,24097/ 60 DATA X2/41679, * 24140,41726,24146,41746,24165,41750,24207,41784,24253, 65 * 41791,24239,41879,24207,41998,24202,41992,23679,41998,23630, 70 * 41995,23356,42007,23119,42000,23041,42007,22212,42000,21583, 75 * 41991,20799,41990,20317,41998,20000,39000,20000,37210,17486, 80 * 37000,17203, 81 * 36438,16466,35000,14632,34941,14628,34877,14633,34856,14621, 86 * 34829,14580,34797,14572,34738,14515,34711,14469,34601,14418, 91 * 34591,14438,34583,14421,34523,14381,34452,14380,34447,14343, 96 * 34340,14173,34304,14138,34261,14132,34257,14165,34171,14258, 101 * 34170,14283,34122,14363,34098,14432,33997,14450,33940,14535, 106 * 33873,14507,33812,14523,33704,14496,33670,14536,33662,14515, 111 * 33646,14533,33555,14533,33418,14648,33415,14688,33407,14721, 116 * 33349,14693,33297,14730,33275,14678,33206,14675,33092,14707/ 121 DATA X3/33033, * 14667,33029,14528,32968,14470,32852,14465,32792,14528, 126 * 32762,14527,32750,14560,32740,14567,32740,14581,32734,14582, 131 * 32738,14707,32715,14724,32672,15363,32530,17119,32616,17134, 136 * 32687,17186,32689,17222,32718,17202,32692,17166,32625,17125, 141 * 32597,17110,32615,17091,32672,17113,32712,17172,32733,17181, 146 * 32740,17201,32716,17228,32664,17235,32699,17252,32748,17248, 151 * 32779,17206,32800,17211,32778,17230,32822,17275,32849,17274, 156 * 32850,17251,32874,17244,33012,17278,33130,17333,33318,17488, 161 * 33380,17584,33441,17648,33462,17687,33456,17710,33537,17780, 166 * 33589,17872,33601,17919,33663,18013,33734,18095,33763,18161, 171 * 33747,18243,33705,18286,33739,18412,33775,18423,33813,18387, 176 * 33947,18443,34013,18500,34036,18541,34029,18746,34000,18809/ 181 DATA X4/34030, * 18847,34042,18944,34150,19218,34266,19280,34370,19472, 186 * 34408,19568,34414,19675,34391,19709,34413,19800,34402,19870, 191 * 34460,20020,34458,20087,34470,20129,34445,20469,34513,20508, 196 * 34558,20585,34552,20622,34575,20649,34703,20599,34755,20640, 201 * 34847,20608,34900,20649,34901,20672,35000,20640,35029,20629, 206 * 35104,20628,35142,20647,35172,20707,35178,20749,35155,20753, 211 * 35210,20856,35249,20893,35348,20852,35313,20861,35333,20825, 216 * 35371,20860,35438,20886,35460,20998,35548,21096,35631,21158, 221 * 35662,21282,35708,21311,35772,21326,35882,21453,35991,21492, 226 * 36018,21570,36120,21639,36195,21717,36243,21830,36273,21846, 231 * 36305,21895,36339,21890,36520,21947,36523,21920,36562,21928, 236 * 36575,21973,36637,21924,36601,21878,36614,21850,36669,21816/ 241 DATA X5/36812, * 21784,36941,21865,36980,21927,36959,21970,36968,22012, 246 * 36952,22023,36950,22067,36969,22129,37000,22175, 250 * 37028,22221,37103,22288, 252 * 37120,22312,37112,22329,37172,22364,37184,22395,37216,22405, 257 * 37246,22419,37358,22398,37440,22442,37472,22447,37503,22473, 262 * 37500,22495,37522,22511,37595,22518,37598,22501,37638,22491, 267 * 37783,22512,37791,22488,37809,22474,37807,22400,37791,22384, 272 * 37737,22372,37728,22354,37713,22360,37722,22378,37698,22395, 277 * 37650,22376,37650,22400,37623,22368,37615,22381,37589,22346, 282 * 37589,22315,37570,22291,37573,22261,37530,22190,37500,22152, 287 * 37508,22133,37451,22090,37453,22032,37470,21997,37470,22049, 292 * 37500,22050,37502,22102,37538,22108,37581,22140,37666,22154, 297 * 37720,22199,37730,22247,37747,22250,37748,22206,37782,22326/ 302 DATA X6/37829, * 22322,37831,22292,37910,22318,37910,22378,37966,22427, 307 * 37953,22397,37987,22361,38012,22368,38002,22337,38018,22291, 312 * 38060,22243,38116,22302,38161,22406,38136,22405,38117,22439, 317 * 38114,22488,38020,22498,37986,22448,37965,22499,37939,22482, 322 * 37946,22507,37934,22506,37883,22437,37868,22461,37898,22490, 327 * 37875,22500,37858,22478,37825,22472,37821,22524,37935,22691, 332 * 37908,22676,37896,22698,37909,22724,37926,22732,37950,22777, 337 * 37972,22788,38026,22869,38033,22953,38004,22986,37991,22955, 342 * 37998,23022,38120,22952,38163,22946,38237,22989,38188,22927, 347 * 38134,22891,38071,22818,38085,22823,38156,22891,38216,22928, 352 * 38235,22969,38260,22971,38307,23016,38314,23039,38298,23076, 357 * 38322,23072,38360,23067,38455,23133,38509,23244,38571,23333, 362 * 38710,23449,38751,23520,38772,23537,38853,23649,38871,23658, 367 * 38922,23728,38958,23738,38960,23723,39000,23698/ 371 C NEVADA WITH 122 SEGMENTS (123 POINTS) DATA X7/39000, 1 20000,41998,20000,41996,20031,41998,19895,41992,19516, 5 1 41995,18961,41992,18728,41998,17752,41998,17563,41996,17316, 10 1 41999,17026,42020,17026,41999,17026,41998,16668,41996,16364, 15 1 41999,16133,41997,16002,41995,15314,41996,14988,42000,14882, 20 1 41996,14690,41994,14347,41992,14000,41992,14040,41000,14039, 25 1 40830,14040,40366,14046,39888,14047,39392,14043,39000,14050, 30 1 38731,14047,38000,14050,37000,14049,37000,14000,37000,14049, 35 1 36193,14045,36188,14061,36123,14100,36116,14118,36105,14117, 40 1 36100,14113,36057,14134,36042,14136,36025,14150,36026,14179, 45 1 36017,14209,36013,14239,36031,14265,36047,14269,36056,14295, 50 1 36063,14316,36076,14303,36102,14320,36110,14336,36142,14367, 55 1 36147,14403,36127,14442,36142,14458,36125,14500,36135,14509/ 60 DATA X8/36146, 1 14500,36151,14508,36149,14529,36152,14538,36150,14577, 65 1 36131,14603,36142,14624,36112,14678,36106,14730,36087,14754, 70 1 36056,14731,36044,14742,36033,14722,36024,14722,36009,14742, 75 1 35983,14743,35964,14727,35946,14732,35930,14708,35912,14704, 80 1 35869,14662,35852,14704,35830,14694,35805,14710,35789,14699, 85 1 35772,14700,35756,14695,35733,14696,35705,14706,35684,14681, 90 1 35652,14688,35610,14653,35588,14657,35579,14678,35568,14666, 95 1 35530,14658,35513,14680,35466,14668,35451,14649,35424,14643, 100 1 35390,14621,35326,14596,35293,14598,35270,14588,35206,14581, 105 1 35202,14572,35169,14570,35130,14577,35122,14596,35120,14630, 110 1 35105,14649,35096,14644,35081,14613,35068,14625,35057,14622, 115 1 35040,14637,35008,14629,34993,14635,35000,14632,36002,15898, 120 1 36438,16466,37210,17486,39000,20000/ 123 C K'S ARE SUBSCRIPTS OF ENDPOINTS ALONG BOUNDARY C 6 FOR 1:2,000,000 OR SMALLER. 7-8 FOR 2 PARTS AT 1:750,000. DATA K1S/1,79,80,83,1,1,250,81,1,1,1,30/ DATA K1F/79,80,83,205,371,371,371,250,123,123,30,123/ DATA K2S/79,257,205,205,1,1,1,250/ DATA K2F/79,371,257,205,1,1,81,250/ DATA XOFF1S/0.1,-0.1,-0.1,-0.1,0.0,0.0,0.0,0.0/ DATA XOFF1F/-0.1,-0.1,-0.1,0.1,0.0,0.0,0.0,0.0/ DATA XOFF2S/0.0,0.1,0.1,0.0,0.0,0.0,0.0,0.0/ DATA XOFF2F/0.0,0.1,0.1,0.0,0.0,0.0,0.0,0.0/ C XOFF-DIRECTIONS OF TICKMARKS AT ENDS OF BOUNDARY OF 1:500,000 C TO 1:999,999 MAPS. + IS RIGHT (AT WEST EDGE). KS=K1S(I) KF=K1F(I) M=0 IF (I .LT. 9) GO TO 7 C NEVADA BORDER. SUBSCRIPTS 11-12 FOR 1:500,000 IN 2 PARTS, WHICH C BARELY FITS 29.4-INCH PAPER. 9 FOR 1:1,000,000 ROTATED. 10 FOR C SMALLER SCALES. CALL PBND(KS,KF,XN,0.0,0.0,M,246) GO TO 9 C CALIFORNIA BORDER C SUBSCRIPTS 1-4 FOR 4 PARTS AT 1:500,000. 5 FOR ROTATED 1:1,000,000. 7 L=0 XS=XOFF1S(I) XF=XOFF1F(I) 2 CALL PBND(KS,KF,XP,XS,XF,M,742) L=L+1 IF (L .EQ. 2) GO TO 9 KS=K2S(I) KF=K2F(I) IF (KS .EQ. KF) GO TO 9 XS=XOFF2S(I) XF=XOFF2F(I) GO TO 2 9 IF (M .NE. 0) PRINT 200, M 200 FORMAT (I6,' BORDER SEGMENTS OFF THE PLOT PAPER.') RETURN END SUBROUTINE PBND(KS,KF,XP,XS,XF,M,N) C DRAWS PART OF STATE BOUNDARY THAT IS WITHIN THE PLOT PAPER INTEGER XP DIMENSION XP(N) COMMON /YPAP/ IW,ZPAPR,ZPAPG,ZBOTG,ZPAPS,ZBOTS,ZPAPH,XFACT,YFACT DATA X,Y/2*0.0/ IN=0 DO 4 K=KS,KF J=2*K ZT=XP(J-1)*0.001 ZN=XP(J)*0.001 CALL CALC(ZT,ZN,X,Y,XFACT,YFACT) IF (Y .LT. ZPAPR .AND. Y .GT. 0.0) GO TO 6 M=M+1 IN=0 GO TO 4 6 IF (IN .NE. 0) GO TO 5 IN=1 CALL PLOT (X,Y,3) C FIRST POINT ONLY ENCOUNTERED WHEN IN=0 IF (K .EQ. KS) CALL PLOT (X+XS,Y,2) C LAST POINT ENCOUNTERED WITH PEN UP OR DOWN IF (K .EQ. KF) CALL PLOT (X+XF,Y,2) 5 CALL PLOT (X,Y,2) IF (K .EQ. KF) CALL PLOT (X+XF,Y,2) 4 CONTINUE RETURN END SUBROUTINE PARAM(IREAD,IFMT,IFNEV,MPTS,NSYM,IFGRID,ISIZE,IFBNDY, 1 IFPOST,IFOUR,IFSEC,ZPINC,ISCALE) DIMENSION IFMT(20),IFMTM(20),IFMTS(20),IFMTD(20) COMMON /NOPLOT/ NOPTS(12) C FORMAT OF TC OUTPUT CARD WITH FIRST DIGIT OF ACCURACY CODE DATA IFMTM/'(A8,','1X,F','2.0,','F4.2',',1X,','F3.0',',F4.','2,13' 1 ,'X,A1',') ',10*' '/ DATA IBLNK/' '/ DATA IFMTS/'(A8,','1X,3','F2.0',',1X,','F3.0',',2F2','.0,4', 1 'X,A1',') ',11*' '/ DATA IFMTD/'(A8,','F7.3',',F8.','3,1X',',A1)',15*' '/ READ (IREAD,102,ERR=99,END=9) ISCALE,IFBNDY,IFGRID,IFLINE,ISIZE, 1 IFPOST, IFORM,IFSEC,NSYM,N1,N2,N3,N4,I4,IFNEV 102 FORMAT(I8,7I2,1X,A1,4I1,2I2) C ISCALE(1-8)-RECIPROCAL OF MAP SCALE, GREATER THAN 499,999. DEFAULT IS C 1:1,000,000. IFBNDY(9-10)IS NON-ZERO IF STATE BOUNDARY IS TO BE DRAWN. C IFGRID(11-12) IS NON-ZERO IF GRIDMARKS AT A ONE-DEGREE INTERVAL C ARE TO BE PLOTTED. GRIDMARK HEIGHT IS IN INCREMENTS OF 'IFGRID' TIMES C 'ZPINC' IN THE MAIN PROGRAM. IF ZPINC=0.07-INCH FOR THE BASIC PLOT C SIZE INCREMENT, IFGRID=2 YIELDS A 0.12 INCH LETTER HEIGHT FOR E.G.. C IFLINE(13-14) IS NON-ZERO IF ONE OR MORE (LESS THAN 1010) LINE C SEGMENTS WITH DECIMAL-DEGREE COORDINATES ARE TO BE PLOTTED. C ISIZE(15-16)TIMES'ZPINC'EQUALS THE ONE-DIGIT SYMBOL HEIGHT. C DEFAULT IS ONE. C IFPOST(17-18)IS NON-ZERO IF AN 8(OR LESS)-DIGIT I.D. IS TO BE PLOTTED. C IFORM(19-20)IS NON-ZERO IF AN OPTIONAL FORMAT-CARD IS TO BE READ NEXT C (BEFORE FIRST LINE OR POINT CARD). A FORMAT-CARD INCLUDES LEFT AND C RIGHT PARENTHESES. FOUR INTEGER NUMBERS IN COLUMNS 25-28 C INDICATE WITH ONE OR MORE NON-ZERO NUMBERS WHICH FULL MAP (25), C 2-PART MAP WITH BREAKS AT 37-42 (25) AND AT 32-37 (26), OR 4-PART C MAP WITH BREAKS AT 39-42 (25), 37-39 (26), 35-38 (27), AND 32-35 C (28) SHOULD NOT BE PLOTTED. IFOUR (29-30) IS 4 IF A 4-PART MAP C WILL BE PLOTTED EVEN IF THE SCALE IS LESS THAN 1:749,999, 2 IF A C ROTATED 2-PART MAP WILL BE PLOTTED EVEN IF THE SCALE IS LESS C THAN 1:999,999, AND 3 IF A ROTATED SINGLE MAP WILL BE PLOTTED C EVEN IF THE SCALE IS LESS THAN 1:1,999,999. C IFSEC (21-22) PROVIDES THE GEOGRAPHIC C UNITS OF MEASUREMENT. THE NUMBER ONE IS FOR DECIMAL DEGREES; TWO IS C FOR DEGREES AND DECIMAL MINUTES, THREE (OR DEFAULT) SIGNIFIES DEGREES, C MINUTES AND DECIMAL SECONDS. NSYM (24)-UNLESS BLANK THIS ONE-DIGIT C SYMBOL REPLACES THE SYMBOL READ ON DATA CARDS. C IFN(31-32) IS 1 TO 3 TO REQUEST A MAP OF NEVADA. DEFAULT CALIFORNIA. C 2 FOR A 2-PART MAP EVEN IF SCALE IS LESS THAN 1:999,999, 1 FOR A C NORMAL MAP, OR 3 FOR A ROTATED MAP EVEN IF LT 1:1,499,999. MPTS=IFLINE IF(ISCALE .EQ. 0) ISCALE=1000000 IF (ISIZE .EQ. 0) ISIZE=1 ZHT=ZPINC*IFGRID ZSIZE=ZPINC*ISIZE IF (IFSEC .EQ. 0) IFSEC=3 PRINT 600, ISCALE,ZSIZE 600 FORMAT(/,'0MAP SCALE IS 1:',I8,'. SYMBOL HEIGHT IS',F5.2,' INCH') IF (IFBNDY .NE. 0) PRINT 601 601 FORMAT (' STATE BOUNDARY WILL BE DRAWN.') IF (IFGRID .NE. 0) PRINT 602, ZHT 602 FORMAT (' ONE-DEGREE GRIDMARKS WILL BE PLOTTED AT HEIGHT',F5.2, 1' INCH') IF (IFGRID .EQ. 0) PRINT 202 202 FORMAT ('0WARNING. YOU ARE REJECTING THE ONE-DEGREE GRID PLOT.') IF (NSYM .NE. IBLNK) PRINT 603, NSYM 603 FORMAT (' ALL ONE DIGIT SYMBOLS ON THE MAP WILL BE: ',A1) IF (IFPOST .NE. 0) PRINT 604 604 FORMAT (' AN 8-DIGIT SYMBOL WILL BE PRINTED TO THE RIGHT OF ', 1 'EACH CENTERED SYMBOL') IF (MPTS .NE. 0) PRINT 605 605 FORMAT(' LINE SEGMENT DATA WILL BE PLOTTED.') IS=ISCALE IF (IS .LT. 500000) GO TO 99 DO 1 I=1,12 1 NOPTS(I)=0 IF (IFNEV .EQ. 0) GO TO 20 PRINT 200, IFNEV 200 FORMAT (' MAP OF NEVADA WILL BE PLOTTED.',I9) I4=0 NOPTS(11)=N1 NOPTS(12)=N2 IF (IFNEV .LT. 0 .OR. IFNEV .GT. 3) GO TO 99 IF (IFNEV .EQ. 2) GO TO 22 IF (IS .LT. 1000000) GO TO 21 IF (IFNEV .EQ. 3) GO TO 23 IF (IS .LT. 1500000) GO TO 25 IFNEV=1 GO TO 16 21 IFNEV=2 GO TO 22 25 IFNEV=3 GO TO 23 20 PRINT 201, I4 201 FORMAT (' MAP OF CALIFORNIA WILL BE PLOTTED.',I9) IF (I4 .LT. 1) I4=1 IF (I4 .GT. 4) GO TO 99 IF (I4 .EQ. 4) GO TO 24 IF (IS .LT. 750000) GO TO 18 IF (I4 .EQ. 2) GO TO 22 IF (IS .LT. 1000000) GO TO 7 IF (I4 .EQ. 3) GO TO 23 IF (IS .LT. 2000000) GO TO 8 I4=1 16 IF (N1) 98,19,98 7 I4=2 22 PRINT 222, N1,N2 222 FORMAT (' MAP WILL BE PLOTTED IN 2 ROTATED SECTIONS.',5X,2I2) IT=N1*N2 17 NOPTS(1)=N1 NOPTS(2)=N2 IF (IT) 98,19,98 8 I4=3 23 PRINT 223 223 FORMAT (' MAP WILL BE ROTATED ON PLOT PAPER.') GO TO 16 18 I4=4 24 PRINT 224, N1,N2,N3,N4 224 FORMAT (' MAP WILL BE PLOTTED IN 4 SECTIONS.',5X,4I2) IT=N1*N2*N3*N4 NOPTS(3)=N3 NOPTS(4)=N4 GO TO 17 19 IFOUR=I4 IF (IFSEC .LT. 1 .OR. IFSEC .GT. 3) GO TO 99 IF (IFGRID .LT. 0 .OR. IFGRID .GT. 8) GO TO 99 IF (ISIZE .LT. 1 .OR. ISIZE .GT. 8) GO TO 99 IF (IFORM .NE. 0) GO TO 6 GO TO (27,2,4), IFSEC 2 DO 3 J=1,20 3 IFMT(J)=IFMTM(J) GO TO 10 4 DO 5 J=1,20 5 IFMT(J)=IFMTS(J) GO TO 10 6 READ (IREAD,103) IFMT 103 FORMAT(20A4) GO TO 10 27 DO 28 J=1,20 28 IFMT(J)=IFMTD(J) GO TO 10 98 PRINT 208 208 FORMAT ('0STOP. OPTION IN COLUMNS 25-28 BYPASSES ALL PLOTS.') GO TO 9 99 PRINT 203 203 FORMAT ('0STOP. WRONG SCALE, SYMBOL HEIGHT, GEOGRAPHIC ', 1'FORMAT OR OTHER INPUT ERROR') 9 ISCALE=9 RETURN 10 GO TO (11,12,13),IFSEC 11 PRINT 211 211 FORMAT (' DATA POINT INPUT IS IN DECIMAL DEGREES.') GO TO 14 12 PRINT 212 212 FORMAT (' DATA POINT INPUT IS IN DEGREES AND DECIMAL MINUTES.') GO TO 14 13 PRINT 213 213 FORMAT (' DATA POINT INPUT IS IN DEGREES, MINUTES, AND DECIMAL ', 1'SECONDS.') 14 PRINT 214, IFMT 214 FORMAT (' FORMAT OF DATA POINT INPUT IS:',/,2X,20A4) RETURN END SUBROUTINE CALIF(N,ISIZE,ISCALE,IFBNDY, 1 IFGRID,IFPOST,ZPINC,IFOUR,MPTS,IFNEV,XGAP) C CALIFORNIA BASEMAP. PLOTTED 1, 2 OR 4 PIECES DEPENDING ON SCALE. C N RANDOM POINTS AND UP TO MPTS-1 LINE SEGMENTS WILL BE PLOTTED. DIMENSION LTS(12),LTN(12),LNE(12),LNW(12) COMMON /NOPLOT/ NOPTS(12) C GEOGRAPHIC LIMITS OF 4 PIECES, ROTATED, AND FULL NORMAL. LONGITUDES C MINUS 100. DATA LTS/39,37,35,32,32,32,37,32,35,35,39,35/ DATA LTN/42,39,38,35,42,42,42,37,42,42,42,39/ DATA LNE/20,17,14,14,14,14,17,14,14,14,14,14/ DATA LNW/25,24,23,21,25,25,25,23,20,20,20,20/ DATA JDOT,JPLUS,XRIGHT/'.','+',0.0/ IF (IFNEV .EQ. 0) GO TO 1 C NORMAL, ROTATED AND 2-PART NEVADA GO TO (3,8,9), IFNEV 3 NS=10 GO TO 7 8 NS=11 NF=12 GO TO 10 9 NS=9 GO TO 7 C CALIFORNIA MAPS FOLLOW 1 GO TO (6,2,5,4), IFOUR C MAP PLOTTED IN 2 ROTATED SECTIONS 2 NS=7 NF=8 GO TO 10 4 NS=1 NF=4 C 204 FORMAT (' MAP WILL BE PLOTTED IN FOUR SECTIONS.') GO TO 10 5 NS=5 C 205 FORMAT (' MAP WILL BE ROTATED 60 DEGREES ON PLOT PAPER.') GO TO 7 6 NS=6 7 NF=NS 10 IHT=IFGRID ZSIZE=ZPINC*ISIZE ZHT=ZPINC*IHT CALL CONSTN(ISCALE) DO 12 MAPTYP=NS,NF I=MAPTYP IF (NOPTS(I) .NE. 0) GO TO 12 C REPEAT POINT STARTS WITH A + CALL SPOTC(0.0,0.1,0.0,JPLUS,0.0,0.0,0.05) ZSTH=LTS(I) ZNTH=LTN(I) ZEAST=LNE(I) ZWEST=LNW(I) C FIND PLOT BORDERS AND ROTATION. CALL EXTREM(I,ZSTH,ZNTH,ZEAST,ZWEST,XRIGHT) C PLOT CALIFORNIA BOUNDARY IF (IFBNDY .NE. 0) CALL OUTLIN(I) C PLOT SERIES OF LINES IF (MPTS .NE. 0)CALL CLINE(I,MPTS,ZSTH,ZNTH,ZEAST,ZWEST,XRIGHT) C PLOT RANDOM POINTS AND OPTIONAL ONE-DEGREE GRID. CALL PTS(N,LTS,LTN,LNE,LNW,I,ZHT,XRIGHT,ZSIZE,IFPOST) C SUPERPOSITION OF PLUS-SIGN AND SQUARE TO TEST FOR SHIFT DURING C PLOTTING. CALL SPOTC(0.0,0.1,0.0,JDOT,0.0,-0.02,0.02) XP=XRIGHT+XGAP PRINT 210, XP 210 FORMAT (1X,F8.1,' MORE INCHES OF PLOTTING DONE') CALL PLOT(XP,0.0,-3) 12 CONTINUE RETURN END SUBROUTINE EXTREM(I,ZSTH,ZNTH,ZEAST,ZWEST,XRIGHT) C TO FIND MAXIMUM MAP WIDTH, LEFT BORDER AND ROTATION. IMPLICIT REAL*8(A-H,O-W) COMMON /CONST/ DEGR,QFK,BA2,BA4,FLD,STDLN,ROT,STX,STY COMMON /YPAP/ IW,ZPAPR,ZPAPG,ZBOTG,ZPAPS,ZBOTS,ZPAPH,XFACT,YFACT DATA X,Y,XMAX,XMIN/4*0.0/ C CENTRAL MERIDIANS AND LATITUDES IN DEGREES STDLT=0.5*(ZNTH+ZSTH) STDLN=0.5*(ZEAST+ZWEST) IROT=0 IF (I .NE. 5) GO TO 3 C ROTATED 1,000,000 TO 1,999,999 MAPS STDLT=37.38D0 STDLN=19.36D0 2 IROT=60 GO TO 5 3 IF (I .NE. 7) GO TO 4 C NORTH HALF OF 1:750,000 MAP, ROTATED STDLT=39.35D0 STDLN=21.2D0 GO TO 2 4 IF (I .NE. 8) GO TO 6 C SOUTH HALF OF 1:750,000 MAP, ROTATED STDLT=34.9D0 STDLN=18.0D0 IROT=41 GO TO 5 6 IF (I .NE. 9) GO TO 11 C ROTATED NEVADA 1:1,000,000 STDLT=39.5D0 STDLN=15.75D0 GO TO 12 11 IF (I .NE. 12) GO TO 5 C SOUTH HALF OF ROTATED NEVADA. BARELY 29 INCH SIZE 1:500,000 STDLT=38.05D0 STDLN=15.69D0 12 IROT=44 C REFERENCE TO LEFT EDGE AND CENTER OF PAPER 5 STX=0.0D0 STY=ZPAPH ROT=IROT*DEGR CLON=100.0D0+STDLN PRINT 200, STDLT,CLON,IROT 200 FORMAT (' CENTRAL LATITUDE IS',F6.2,' AND CENTRAL MERIDIAN IS', 1 F7.2,' DEGREES',/,5X,'WITH ROTATION OF',I3,' DEGREES') ZLT=STDLT ZLN=STDLN CALL CALC(ZLT,ZLN,X,Y,1.0,1.0) STY=Y ZLT=ZSTH CALL CALC(ZSTH,ZEAST,XMAX,Y,1.0,1.0) C NW AND SE CORNERS OF ROTATED STATE ESTABLISH X-LIMITS. C SW AND SE CORNERS FOR NORMAL ORIENTATION IF (I .EQ. 5 .OR. I .EQ. 7 .OR. I .EQ. 8 1 .OR. I .EQ. 9 .OR. I .EQ. 12) ZLT=ZNTH CALL CALC(ZLT,ZWEST,XMIN,Y,1.0,1.0) STX=XMIN-1.0 XRIGHT=(XMAX-XMIN+2.0)*XFACT IF (ZLT .EQ. ZNTH) RETURN CALL CALC(ZSTH,ZLN,X,Y,1.0,1.0) CALL CALC(ZNTH,ZEAST,X,XMAX,1.0,1.0) XMIN=XMAX-Y IF (XMIN .LE. ZPAPG) RETURN PRINT 201, XMIN 201 FORMAT ('0WARNING. FULL MAP HEIGHT OF',F6.1,' INCHES EXCEEDS', 1 ' PAPER SIZE.',/,' FULL STATE MAY NOT BE PLOTTED.') RETURN END SUBROUTINE SPOTC(X,Y,HT,IS,ANGLE,XS,YS) C SUBROUTINE SPOTC (X,Y,IHT,FIS,IANGLE,XS,YS) C PLOT A SINGLE DIGIT SYMBOL CENTERED AT X,Y INCHES. 'HT' IS HEIGHT OF C SYMBOL IN INCHES. ANGLE OF ROTATION IN DEGREES. ASSUMED PLOT C REFERENCE IS AT LOWER LEFT CORNER OF SYMBOL SPACE. C SEE SUBROUTINE PTS FOR PLOTTER TYPES. C S IS SINE OF ANGLE. C IS COSINE OF ANGLE. BENSON EXAMPLE: C XS= H*(0.5*S-C/3.) C YS=-H*(0.5*C+S/3.) ---HOUSTON HAS 3/7 INSTEAD OF 1/3 DATA JDOT,JPLUS/'.','+'/ IF (IS .NE. JDOT) GO TO 3 C PERIOD IS A CENTERED SQUARE 2/3 WIDTH OF SYMBOL. 0.06-MULTIPLE C XS=HT*(S-C)/3 YS=HT*(S+C)/3 CALL PLOT (X+XS,Y-YS,3) DO 2 J=1,2 CALL PLOT (X-YS,Y-XS,2) CALL PLOT (X-XS,Y+YS,2) CALL PLOT (X+YS,Y+XS,2) 2 CALL PLOT (X+XS,Y-YS,2) C IF (HT .EQ. 0.0) CALL LETTER(6,1,0,X+0.15,Y,'REPEAT') C IF (HT .EQ. 0.0) CALL HSYMBL(X+0.15,Y,0.07,'REPEAT',0.0,6) IF (HT .EQ. 0.0) CALL SYMBOL(X+0.15,Y,0.07,'REPEAT',0.0,6) RETURN 3 IF (IS .NE. JPLUS) GO TO 4 C PLUS SIGN 2/3 WIDTH OF SYMBOL XS=HT*S/3 YS=HT*C/3 CALL PLOT (X+XS,Y-YS,3) CALL PLOT (X-XS,Y+YS,2) CALL PLOT (X+XS,Y-YS,2) CALL PLOT (X-YS,Y-XS,3) CALL PLOT (X+YS,Y+XS,2) CALL PLOT (X-YS,Y-XS,2) RETURN C 4 CALL LETTER (1,IHT,IANGLE,X+XS,Y+YS,FIS) 4 CALL SYMBOL(X+XS,Y+YS,HT,IS,ANGLE,1) RETURN END