C PROGRAM FOR PLOTTING X,Y DATA SETS.
C NSETS IS THE NUMBER OF DATA SETS
C X AND Y ARE ARRAYS OF DATA SETS
C N(I) ARE THE NUMBER OF PTS IN EACH DATA SET
C XMAX, YMAX, XMIN, YMIN ARE THE MAX AND MIN VALUES FOR ALL THE
SETS
C ISYM DESIGNATES THE NO. OF THE SYMBOL FOR THE I TH SET
C IMARK SETS THE TYPE OF CURVE PLOTTED:
C NSCL = 1 SETS THE AXIS LIMITS AUTOMATICALLY; IF NSCL = 0,
C ONE MUST INSERT THE AXIS LIMITS.
C NAMEX AND NAMEY ARE THE AXIS LABELS.
C IMARK>0 PTS CONNECTED + SYMBOLS DRAWN
C IMARK=0 PTS CONNECTED, NO SYMBOLS
C IMARK<0 PTS NOT CONNECTED, SYMBOLS DRAWN
C
C
PROGRAM XY
REAL EOF
REAL X(500,25),Y(500,25),XMAX,YMAX,XMIN,YMIN,XTREME
INTEGER N(25),NSETS,ISYM(25),IMARK(25),NSCL
INTEGER IBUFF2(3)
CHARACTER NAMEX*80,NAMEY*80,FNAME*7
C
EOF=-1.0
XTREME=1.E38
C
WRITE (*,*) 'WHICH FILE CONTAINS
THE DATA?'
READ (*,130) FNAME
NREAD=7
OPEN (NREAD,FILE=FNAME)
REWIND(NREAD)
READ (NREAD,*) NSETS
READ (NREAD,*) NAMEX
READ (NREAD,*) NAMEY
READ (NREAD,*) NSCL
IF(NSCL.EQ.1) GO TO 10
READ (NREAD,*) XMIN,XMAX,YMIN,YMAX
10 CONTINUE
C
DO 20 I=1,NSETS
READ (NREAD,*) ISYM(I),IMARK(I)
20 CONTINUE
C
DO 50 J=1,NSETS
C OPEN (NREAD,FILE=FNAME)
DO 30 I=1,500
READ (NREAD,*,END=40) X(I,J),Y(I,J)
IF(X(I,J).EQ.EOF.AND.Y(I,J).EQ.EOF)GOTO40
N(J)=I
30 CONTINUE
40 CONTINUE
C CLOSE (NREAD,STATUS='KEEP')
50 CONTINUE
C
IF(NSCL.NE.1) GO TO 80
C
XMAX=-XTREME
XMIN=XTREME
YMIN=XTREME
YMAX=-XTREME
C
DO 70 J=1,NSETS
DO 60 I=1,N(J)
XMAX=AMAX1(XMAX,X(I,J))
XMIN=AMIN1(XMIN,X(I,J))
YMIN=AMIN1(YMIN,Y(I,J))
YMAX=AMAX1(YMAX,Y(I,J))
60 CONTINUE
70 CONTINUE
WRITE (6,*) XMIN,XMAX,YMIN,YMAX
C
80 CONTINUE
C
WRITE (*,*) '
DEVICE MENU'
WRITE (*,*)
WRITE (*,*) '1
TEKTRONIX 4014'
WRITE (*,*) '2
LASER PRINTER'
WRITE (*,*)
WRITE (*,*) 'WHICH DEVICE DO YOU
WANT (0 TO STOP)?'
90 READ (*,*) NDV
IF (NDV.EQ.0) GO TO 140
IF (NDV.EQ.1) THEN
CALL TK4014
(960,1)
GO TO 100
ENDIF
IF (NDV.EQ.6) THEN
C CALL TK4054 (960,1)
GO TO 100
ENDIF
IF (NDV.EQ.3) THEN
C CALL ZETA
GO TO 100
ENDIF
IF (NDV.EQ.4) THEN
C CALL HP2623
GO TO 100
ENDIF
IF (NDV.EQ.5) THEN
C CALL TK41(4105)
GO TO 100
ENDIF
IF (NDV.EQ.2) THEN
C SET WRITE MODE ON FILE std00001.dat
C
C 0 - APPEND MODE
C 1 - NEW (USER'S FILE NAME)
C 2 - OVERWRITE OLD FILE (NOTE: FOR MULTI-PAGE PLOTS,
WILL ONLY
C GET LAST PAGE)
C 3 - NO OVERWRITE
C 4 - INCREMENT (CREATE UNIQUE FILE NAME)
C
IBUFF2(1)=2
ILEN=-104
CALL IOMGR(IBUFF2,ILEN)
C SET FORTRAN CARRIAGE CONTROL OFF
C TURN-OFF CARRIAGE CONTROL SO "%!" STARTS IN COLUMN 1.
IF NOT,
C ON UNIX SYSTEMS WILL PRINT AS TEXT NOT AS A GRAPH.
IBUFF2(1)=0
IBUFF2(2)=0
IBUFF2(3)=0
ILEN=-111
CALL IOMGR(IBUFF2,ILEN)
C WRITE TO FILE (std00001.dat) RATHER THAN SCREEN
IBUFF2(1)=5
ILEN=-102
CALL IOMGR(IBUFF2,ILEN)
C CALL POSTSCRIPT DRIVER
C The third paramater could be changed - it is the size of
the default line
C in inches.
CALL
PSCRPT(7.99,10.78,0.0139)
GO TO 100
ENDIF
WRITE (*,*) 'RE-ENTER NO. OF THE
DEVICE (0 TO STOP):'
GO TO 90
C
100 CONTINUE
CALL SETDEV(20,20)
CALL NOBRDR
CALL AREA2D(7.0,7.5)
CALL HEIGHT(0.2)
CALL COMPLX
C
CALL MX1ALF('STAND','!')
CALL MX2ALF('L/CSTD','*')
CALL MX3ALF('INSTR','#')
CALL MX4ALF('L/CGRE','&')
CALL MX5ALF('MATHE','%')
CALL MX6ALF('GREEK','?')
C
CALL XNAME(NAMEX,100)
CALL YNAME(NAMEY,100)
CALL XREVTK
CALL YREVTK
CALL GRAF(XMIN,'SCALE',XMAX,YMIN,'SCALE',YMAX)
CALL FRAME
CALL PSPLIN
CALL SCLPIC(1.5)
C THE FOLLOWING CAUSES POINTS TO BE CONNECTED
WITH STRAIGHT LINES
CALL LINEAR
C
DO 110 K=1,25
IF (K.EQ.2) CALL DOT
IF (K.EQ.3) CALL DASH
IF (K.EQ.4) CALL CHNDOT
IF (K.EQ.5) CALL CHNDSH
IF (K.EQ.6) CALL RESET ('CHNDOT')
IF (K.EQ.7) CALL DOT
IF (K.EQ.8) CALL DASH
IF (K.EQ.9) CALL CHNDOT
IF (K.EQ.10) CALL CHNDSH
C IF (K.GT.11) CALL RESET ('CHNDOT')
C THE NEXT 11 LINES HAVE BEEN ADDED TEMPORARILY
IF (K.EQ.11) CALL RESET ('CHNDOT')
IF (K.EQ.12) CALL DOT
IF (K.EQ.13) CALL DASH
IF (K.EQ.14) CALL CHNDOT
IF (K.EQ.15) CALL CHNDSH
IF (K.EQ.16) CALL RESET ('CHNDOT')
IF (K.EQ.17) CALL DOT
IF (K.EQ.18) CALL DASH
IF (K.EQ.19) CALL CHNDOT
IF (K.EQ.20) CALL CHNDSH
IF (K.EQ.21) CALL RESET ('CHNDOT')
IF (K.EQ.1) THEN
ISYM(K)=16
ENDIF
IF (K.EQ.7) THEN
ISYM(K)=0
ENDIF
CALL MARKER(ISYM(K))
CALL CURVE(X(1,K),Y(1,K),N(K),IMARK(K))
IF(NSETS.EQ.K) GO TO 120
110 CONTINUE
C
120 CALL ENDPL(0)
CALL DONEPL
C
130 FORMAT (A7)
C
REWIND(NREAD)
REWIND(20)
C
140 STOP
END
="TOP">