print 100 100 format (' FLDFORM, Plouff. Program to draw a gravity field ', 1 'sheet.',/,' Output is a PostScript file FLDFORM.PS') c Essentially program can plot the form by using the original CALCOMP c -type plotter calls. PostScript conversions are made in the c trailing subroutines which supersede PLOTS, PLOT, and SYMBOL. CALL PLOTS (0,0,0) C DRAW BORDER TO GET PEN RUNNING AND TO CUT EDGE--not needed by PS CALL PLOT (0.01,0.01,3) CALL PLOT (0.01,10.99,2) CALL PLOT (8.49,10.99,2) CALL PLOT (8.49,0.01,2) CALL PLOT (0.01,0.01,2) C RECORD WORKING TIME CALL SYMBOL (0.2,10.6,0.07,'START:',0.0,6) CALL SYMBOL (0.2,10.46,0.07,'LUNCH:',0.0,6) CALL SYMBOL (0.2,10.18,0.07,' STOP:',0.0,6) CALL SYMBOL (0.2,10.04,0.07,'TOTAL:',0.0,6) C HEADINGS CALL SYMBOL (1.3,10.6,0.10,'PROJECT',0.0,7) CALL H(2.0,4.32,10.6) CALL SYMBOL (4.42,10.6,0.10,'DATE',0.0,4) CALL SYMBOL (4.85,10.6,0.07,'(1-8)',0.0,5) CALL H (5.3,6.36,10.6) CALL SYMBOL (6.46,10.6,0.10,'DATA SHEET',0.0,10) CALL H(7.5,8.1,10.6) CALL SYMBOL (1.3,10.32,0.10,'GRAVITY METER/CALIB',0.0,19) CALL H(3.2,5.54,10.32) CALL SYMBOL (5.64,10.32,0.10,'LAST',0.0,4) CALL SYMBOL (6.11,10.32,0.10,'NEW',0.0,3) CALL SYMBOL (6.48,10.32,0.10,'STATION',0.0,7) CALL H(7.2,8.1,10.32) CALL SYMBOL (1.3,10.04,0.10,'TIME ZONE',0.0,9) CALL H(2.2,3.1,10.04) CALL SYMBOL (3.2,10.04,0.10,'OPERATOR',0.0,8) CALL H(4.0,5.6,10.04) CALL SYMBOL (5.7,10.04,0.10,'RECORDER',0.0,8) CALL H(6.5,8.1,10.04) Y1=9.70 Y2=9.68 Y3=9.63 Y4=9.57 CALL SYMBOL (0.34,Y1,0.07,'ODO-',0.0,4) CALL SYMBOL (0.34,Y4,0.07,'METER',0.0,5) CALL SYMBOL (0.74,Y3,0.1,'STATION',0.0,7) CALL SYMBOL (1.48,Y1,0.08,'R',0.0,1) CALL SYMBOL (1.48,Y4,0.08,'?',0.0,1) CALL SYMBOL (1.67,Y3,0.1,'TIME',0.0,4) CALL SYMBOL (2.34,Y3,0.1,'READING',0.0,7) CALL SYMBOL (3.17,Y1,0.07,'TIDE-TEMP',0.0,9) CALL SYMBOL (3.17,Y4,0.07,'CORR-READ',0.0,9) CALL SYMBOL (3.85,Y2,0.1,'ELEVATION',0.0,9) CALL SYMBOL (4.03,Y4,0.07,'/INCREMENT',0.0,10) CALL SYMBOL (4.84,Y1,0.08,'M',0.0,1) CALL SYMBOL (4.84,Y4,0.08,'?',0.0,1) CALL SYMBOL (4.98,Y4,0.07,'T.C.',0.0,4) CALL SYMBOL (5.28,Y4,0.07,'29-31',0.0,5) CALL SYMBOL (4.98,Y1,0.07,'ACC.',0.0,4) CALL SYMBOL (5.28,Y1,0.07,'26-28',0.0,5) CALL SYMBOL (5.73,Y3,0.1,'STATION DESCRIPTION',0.0,19) CALL SYMBOL (7.79,Y3,0.1,'MAP',0.0,3) C COLUMN NUMBERS Y=9.85 CALL SYMBOL (0.87,Y,0.07,'1-5',0.0,3) CALL SYMBOL (1.48,Y,0.07,'6',0.0,1) CALL SYMBOL (1.72,Y,0.07,'7-10',0.0,4) CALL SYMBOL (2.50,Y,0.07,'11-18',0.0,5) CALL SYMBOL (4.14,Y,0.07,'19-24',0.0,5) CALL SYMBOL (4.82,Y,0.07,'25',0.0,2) CALL SYMBOL (5.22,Y+0.01,0.1,'T.C. RING',0.0,9) CALL H (6.15,7.5,Y+0.01) CALL SYMBOL (7.78,Y,0.07,'32-36',0.0,5) C ALLOW 0.3-INCH BORDER IN CASE 8-INCH CARBON IS USED CALL PLOT (8.2,9.54,3) CALL PLOT (0.3,9.54,2) CALL PLOT (0.3,9.82,2) CALL PLOT (8.2,9.82,2) CALL PLOT (8.2,9.54,2) CALL PLOT (8.2,9.53,2) CALL PLOT (0.3,9.53,2) C 28 HORIZONTAL LINES SPACED AT 0.33 INCH. X=0.3 TO START. Y=9.53 DY=0.33 DO 2 J=1,28 Y=Y-DY C TIME DIVIDER FOR UNCLAMP AND FINAL TIMES T=Y+0.165 CALL PLOT (1.61,T,3) CALL PLOT (1.75,T,2) CALL PLOT (1.81,T,3) CALL PLOT (1.95,T,2) CALL PLOT (2.01,T,3) CALL PLOT (2.15,T,2) C DECIMAL POINT IN READING CALL DOT (2.78,Y+0.06) C DECIMAL POINT IN ELEVATION AND ELEVATION DIFFERENCE CALL DOT (4.42,Y+0.18) CALL DOT (4.58,Y+0.04) C DASH SEPARATES ACCURACY CODE AND TERRAIN CORRECTION CALL PLOT (5.05,T,3) CALL PLOT (5.13,T,2) CALL PLOT (5.22,T,3) CALL PLOT (5.30,T,2) C VERTICAL DIVIDERS FOR TERRAIN AND MAP CALL DASH (5.38,Y) CALL DASH (7.68,Y) C DOUBLE HORIZONTAL LINE CALL PLOT (8.2,Y,3) CALL PLOT (0.3,Y,2) 2 CALL PLOT (8.2,Y,2) C VERTICAL LINES Y1=9.82 Y2=9.53 CALL V(0.3,Y1) CALL V(0.71,Y1) CALL V(1.43,Y2) CALL V(1.59,Y1) CALL V(2.17,Y1) CALL V(3.17,Y2) CALL V(3.82,Y1) CALL V(4.8,Y2) CALL V(4.97,Y1) CALL V(8.2,Y1) CALL SYMBOL (0.3,0.15,0.07,'LINE WITH ALL NINES',0.0,19) CALL SYMBOL (1.7,0.15,0.07,'AFTER LAST READING',0.0,18) CALL SYMBOL (6.6,0.15,0.07,'D. PLOUFF 7-86 FORM',0.0,19) call plot (0.0,0.0,999) STOP END SUBROUTINE V(X,YMAX) C VERTICAL LINES CALL PLOT (X,0.3,3) CALL PLOT (X,YMAX,2) CALL PLOT (X,0.3,2) RETURN END SUBROUTINE H(XS,XF,Y) C HORIZONTAL LINES CALL PLOT (XS,Y+0.005,3) CALL PLOT (XF,Y+0.005,2) CALL PLOT (XF,Y-0.005,2) CALL PLOT (XS,Y-0.005,2) RETURN END SUBROUTINE DOT (X,Y) CALL PLOT (X-0.01,Y-0.01,3) CALL PLOT (X-0.01,Y+0.01,2) CALL PLOT (X+0.01,Y+0.01,2) CALL PLOT (X+0.01,Y-0.01,2) CALL PLOT (X-0.01,Y-0.01,2) CALL PLOT (X+0.01,Y+0.01,2) RETURN END SUBROUTINE DASH (X,Y) CALL PLOT (X,Y+0.07,3) CALL PLOT (X,Y+0.13,2) CALL PLOT (X,Y+0.20,3) CALL PLOT (X,Y+0.26,2) RETURN END subroutine plots (idum,jdum,ldev) c D. Plouff 9-94. Subroutines adapted to convert CALCOMP plot calls c to PostScript for FORM3 program. Open plot file with specified c name/unit. Other applications will need longer file name. c Plotter initialization routine - by MAIN before other plot calls. c idum, jdum, ldev = dummy variables for compatibility with caller. c Open plot file with name and unit 23. Overwrite tested outside. open (7,file='FLDFORM.PS',status='unknown') c Set up the header required to identify following as PS commands. write (7,101) 101 format ('%!PS-Adobe') c Set up definitions for other routines: M, change to a new location. c S, print previous character string in parentheses. write (7,102) 102 format ('/M {moveto} def',/,'/S {show} def') c Units inches, origin near lower left corner, page rotated mode. write (7,103) 103 format('72 72 scale 0.0 0.0 translate') c Set line width 300 dpi laser write (7,104) 104 format ('0.004 setlinewidth') return end subroutine plot (x,y,ipen) c CalComp calls. x,y coordinates in inches from the origin. c ipen=2, move/draw with pen down; =3, move with pen up; =999, c move with pen up, terminate plot, close plot file c DRFTPLT program has no ipen=-3 for origin change c Pen down - draw if (ipen .eq. 2) then write (7,2) x,y 2 format (2f8.4,' lineto currentpoint stroke M') c Pen up - move if ipen=3 (start a line) or 999 by default else write (7,3) x,y 3 format (2f8.4,' M') end if if (ipen .eq. 999) then c Print this only page and close plot file write (7,999) 999 format ('showpage % end of plot') close (7) end if return end subroutine symbol (x,y,ht,name,ang,nch) c D. Plouff. Set string to max length of 19 (four calls). character name*19,temp*19,char(19)*1 equivalence (temp,char(1)) c Heights are 0.07, 0.08, and 0.10 inch for this application. See c MAPSCALE for slight difference in Helvetica between number and c uppercase heights. Also see DRIFTPLT used as basis for this. if (ht .lt. 0.075) then write (7,100) 100 format ('/Helvetica findfont 0.10 scalefont setfont') else if (ht .lt. 0.09) then write (7,101) 101 format ('/Helvetica findfont 0.12 scalefont setfont') else write (7,102) c 0.15 yielded overlapping print 102 format ('/Helvetica findfont 0.14 scalefont setfont') end if end if c If left-adjusted and padded with blanks, all may print as a19, but c need to replace unprotected trailing characters with blank spaces. c Also could use array CHAR simply to print as consecutive single c characters in a DO-loop. temp=name if (nch .lt. 19) then nchp=nch+1 do 1 i= nchp,19 1 char(i)=' ' end if write (7,103) x,y,temp 103 format (2f8.3,' M (',a19,') S') return end