PROGRAM DEVICE
C
C	To read the device summary created by Datatrieve
C
C	B. Z. Lederman	27-Mar-84
C			 4-Apr-84 add prompt for filename, automatic device
C					selection
C			 3-Jul-84 add Y-axis grid
C			 4-Sep-84 add output to plotter, file
C			11-Oct-84 re-order plot for faster pen plotting
C			10-Jan-85 Flat-Top plot and correct maximums
C			19-Feb-85 Use Virtual arrays for more space.
C
	IMPLICIT INTEGER (A-F, H-W)
	IMPLICIT INTEGER*4 Y
	PARAMETER POINTS = 1200
	PARAMETER NBRDEV = 6
	PARAMETER NBRDAT = NBRDEV * 3
	INCLUDE '[001005]CGL.FTN/NOLIST'
	REAL A, B, C, D, A2, D2, AL, AR, DX, DY, HOURS(32), MXA
	REAL X(2, POINTS), Y(2, POINTS)
	VIRTUAL YV(POINTS, NBRDEV, 3)
	INTEGER*4 DEVCE(NBRDEV), DEVCIN, OLDDEV
	INTEGER*4 DATAIN(3), MAX(NBRDEV, 3), GH, TI, OUTF
	INTEGER*2 I(NBRDEV, 3), SAVCOL(24), MOVCOL(24)
	BYTE DATE(9), STARTM(8), ENDTIM(8), MAXVAL(8), TITLE(17, 3)
	BYTE BLANKS(10), INPFIL(32), ANS, SYSACC(6), OUTFIL(32), VALUE(8)
	LOGICAL FIRST, PRINT, SLOW
C
	EQUIVALENCE (OUTFIL(1), OUTF)
C
	DATA MOVCOL / 0, 0, 0,   7, 0, 0,   0, 7, 0,   0, 3, 7,
     1		7, 7, 0,   0, 7, 6,   7, 0, 6,   7, 7, 6 /
C
	DATA DEVCE, OLDDEV / NBRDEV * '    ', '    ' /
	DATA I, HOURS, OUTLEN / NBRDAT * 0, 32 * 0., 0 /
	DATA BLANKS, INPFIL, OUTFIL / 10 * ' ', 32 * 0, 32 * 0 /
	DATA TI, GH / 'TI:', 'GH:' /
	DATA SYSACC / 'S', 'Y', 'S', 'L', 'O', 'G' /
	DATA TITLE / 'I', '/', 'O', ' ', 'R', 'e', 'q', 'u', 'e',
     1		's', 't', 's', 5*' ', 'W', 'o', 'r', 'd', 's', ' ',
     2		'T', 'r', 'a', 'n', 's', 'f', 'e', 'r', 'r', 'e', 'd',
     3		'C', 'y', 'l', 'i', 'n', 'd', 'e', 'r', 's', ' ',
     4		'C', 'r', 'o', 's', 's', 'e', 'd' /
C
	FIRST = .TRUE.
	PRINT = .FALSE.
	PLOT = .FALSE.
	FILE = .FALSE.
	SLOW = .FALSE.
	ANS = 'N'
	DV = 0
	OLDHR = 0
	H = 0
C
	WRITE (5, 10)
   10	FORMAT('$ Enter data file name: ')
	READ (5, 20, END = 999) J, INPFIL
   20	FORMAT( Q, 32A1)
	IF (J .LT. 32) J = J + 1
	INPFIL(J) = 0
	OPEN (UNIT = 1, NAME = INPFIL, TYPE = 'OLD', ERR = 999,
     1		READONLY)
C
	WRITE (5, 22)
   22	FORMAT('$ Store graphic output in a file [Y/N] ? ')
	READ (5, 40, END = 999) ANS
	IF ((ANS .EQ. 'Y') .OR. (ANS .EQ. 'y')) THEN
		WRITE (5, 25)
   25		FORMAT('$ Enter output file name: ')
		READ (5, 28, END = 999) OUTLEN, OUTFIL
   28		FORMAT( Q, 32A1)
		FILE = .TRUE.
		GOTO 100
	ENDIF
C
	OUTLEN = 3
	WRITE (5, 32)
   32	FORMAT('$ Output directly to plotter [Y/N] ? ')
	READ (5, 40, END = 999) ANS
	IF ((ANS .EQ. 'S') .OR. (ANS .EQ. 's')) THEN
		SLOW = .TRUE.				! slow plot for film
		ANS = 'Y'				! also means plot
	ENDIF
	IF ((ANS .EQ. 'Y') .OR. (ANS .EQ. 'y')) THEN
		OUTF = GH
		PLOT = .TRUE.
		GOTO 100
	ENDIF
C
	OUTF = TI
	WRITE (5, 30)
   30	FORMAT('  Output will be to video screen.' /
     1		'$ Copy output to printer [Y/N] ? ')
	READ (5, 40, END = 999) ANS
   40	FORMAT(A1)
	IF ((ANS .EQ. 'Y') .OR. (ANS .EQ. 'y')) PRINT = .TRUE.
C
  100	READ (1, 110, END = 200) DATE, HOUR, MIN, SEC, DEVCIN, DATAIN
  110	FORMAT( 9A1, 3I2, A4, 2X, 3I9)
C
	IF (FIRST) THEN
		ENCODE (8, 120, STARTM) HOUR, MIN, SEC
  120		FORMAT( I2, ':', I2.2, ':', I2.2)
		FIRST = .FALSE.
	ENDIF
C
	IF (DEVCIN .NE. OLDDEV) THEN
		DV = DV + 1
		IF (DV .GT. NBRDEV) GOTO 100		! too many devices
		DEVCE(DV) = DEVCIN
		OLDDEV = DEVCIN
		MAX(DV, 1) = 0				! start maximums
		MAX(DV, 2) = 0				! at zero
		MAX(DV, 3) = 0
	ENDIF
C
  140	DO 150 F = 1, 3
	I(DV, F) = I(DV, F) + 1
	L = I(DV, F)
	IF (L .GT. POINTS) GOTO 160		! no more room this device
	YV(L, DV, F) = DATAIN(F)		! store activity
	IF (DATAIN(F) .GT. MAX(DV, F)) MAX(DV, F) = DATAIN(F)
  150	CONTINUE
C
  160	IF (OLDHR .LT. HOUR) THEN		! capture hour markers
		IF (H .LT. 32) THEN		! but no more than 32 of them
			H = H + 1
			HOURS(H) = L + 0.5
			OLDHR = HOUR
		ENDIF
	ENDIF
C
	GOTO 100				! get next record
C
  200	ENCODE (8, 120, ENDTIM) HOUR, MIN, SEC	! catch last time
	CLOSE (UNIT = 1)
	IF (PRINT) THEN				! formfeed paper
		OPEN (UNIT = 1, FILE = 'TT2:FORMF.EED', TYPE = 'NEW')
		WRITE (1, 205)
  205		FORMAT ( '1' )
	ENDIF
C
	CALL CGL (GIC)				! Initialize Core
	CALL CGL (GIVS, OUTFIL, OUTLEN)		! Initialize Surface
	CALL CGL (GSVS, OUTFIL, OUTLEN)		! Select Surface
	IF (FILE .OR. PLOT) CALL CGL (GDVS, 'TI:', 3)	! De-Select Video Screen
	CALL CGL (GNF)				! New Frame
	CALL CGL (GICM, SAVCOL)			! Save preset colors
	CALL CGL (GSCM, MOVCOL)			! First set of colors
	CALL CGL (GSWM, 6)			! set write mode replace
	CALL CGL (GSWI, 7)			! write index white
	CALL CGL (GSCJ, 1, 2)			! justify text left, center
	IF (SLOW) CALL CGL (GSBI, 8)		! slow plot by setting bkgrnd
C
	DVM = DV				! store number of devices
	DO 1000 F = 1, 3			! Once for each type of data
	L = 0
	B = 0.
C
	DO 207 M = 1, DVM			! for each device with data
	A = FLOATJ( MAX(M, F))			! convert data type
	IF (A .GT. B) B = A			! catch maximums
  207	IF (I(M, F) .GT. L) L = I(M, F)		! insure we have all values
C
	DO 210 M = 1, L
	X(1, M) = M
  210	X(2, M) = M + 1				! set up x array
	A = L					! catch maximum
	LM = L					! store this max for later
	L = L - 1				! convert to "flat-top"
	L = 2 * L				! number of points
C
	D2 = 1.					! start grid increment
  630	D2 = 10. * D2				! go up by factors of 10
	DY = 2.4 * D2				! limits of 24, 240, 2400...
	IF (DY .LT. B) GOTO 630			! if not past limit, try again
	D2 = 0.1 * D2				! went past, go back one
C
	C = -0.11 * A				! left edge of page
	D = -0.1  * B				! bottom of page
	IF (PLOT) THEN				! wait for paper
		WRITE (5, 830)
  830		FORMAT('$ Insert paper, then press Return or Enter.')
		READ (5, 40, END = 900) ANS
	ENDIF
	IF (FILE .OR. PLOT) CALL CGL (GBB)	! begin batch
	CALL CGL (GSW, C, A, D, B)		! Set window
	CALL CGL (GSO, 0)			! Set origin to bottom left
	CALL CGL (GMA2, 1., 0.)			! Move to origin
	CALL CGL (GRA2, A, B)			! Draw box around window
C						! Y-axis grid:
	DX = (0.025 * A)			! length of tic
	DY = A - DX				! position of right tic
	DX = DX + 1.				! correct for left edge position
	A2 = 0.98 * B				! upper limit to grid
	DO 600 J = 1, 2				! for left and right sides
	DO 600 AR = D2, A2, D2			! for each Y axis interval
	IF (J .EQ. 1) THEN			! do each side seperately
		CALL CGL (GMA2, 1., AR)		! move to position at left
		CALL CGL (GLA2, DX, AR)		! draw small line
	ELSE
		CALL CGL (GMA2,  A, AR)		! move to right edge
		CALL CGL (GLA2, DY, AR)		! draw another small line
	ENDIF
  600	CONTINUE
C
	D2 = 0.5 * D				! need for positioning
	A2 = B + D2				! ditto
	AR = 0.02 * A				! right end of sample line
	AL = -(AR)				! left end of sample line
	AR = 2. * AR				! need a little more
	K = 0					! reset color
C
	DO 300 DV = 1, DVM			! once for each device
	IF (MAX(DV, F) .LE. 0) GOTO 300		! skip zero activity
	M = I(DV, F)				! max for this activity
	DO 240 J = 1, LM			! move virtual to local storage
	IF (J .LE. M) THEN			! have real data
		Y(1, J) = FLOATJ( YV(J, DV, F))
	ELSE					! went past this device
		Y(1, J) = 0.
	ENDIF
	Y(2, J) = Y(1, J)			! "Flat-Top" display
  240	CONTINUE
	ENCODE (8, 250, VALUE) MAX(DV, F)	! store maximum this variable
	MXA = FLOATJ(MAX(DV, F))		! copy for later
	J = DV + 1				! index to line type
	K = K + 1				! next color
	IF (K .GT. 7) K = 1			! repeat colors if neccessary
	IF (PLOT) THEN
		IF (K .EQ. 5) K = 6		! correct for plotter map
	ELSE
		CALL CGL (GSLS, J, 0, 0)	! set line type
	ENDIF
	CALL CGL (GSWI, K)			! set color
	IF (B .EQ. MXA) THEN			! if this is most used device
		CALL CGL(GSLS, 1, 0, 0)		! set solid line
		ENCODE (8, 250, MAXVAL) MAX(DV, F)
  250		FORMAT( I8)			! capture absolute max value
	ENDIF
	CALL CGL (GMA2, X(1, 1), Y(1, 1))	! Move to start
	CALL CGL (GPLA2, X(1, 1), Y(1, 1), L)	! Draw lines, connected
	A2 = D2 + A2				! drop down for each device
	CALL CGL (GMA2, C, A2)			! move to position at left
	IF (.NOT.PLOT) CALL CGL (GT, BLANKS, 10) ! make room for name and sample
	CALL CGL (GT, DEVCE(DV), 4)		! name device
	IF (.NOT.PLOT) THEN
		CALL CGL (GMA2, AL, A2)		! start of sample line
		CALL CGL (GLA2, AR, A2)		! draw sample
	ENDIF
	A2 = D2 + A2				! drop down for max value
	CALL CGL (GMA2, C, A2)			! move to position
	CALL CGL (GT, VALUE, 8)			! write max value
  300	CONTINUE
C
	CALL CGL (GSLS, 1, 0, 0)		! set line type to solid
	CALL CGL (GSWI, 7)			! set color to white
	A2 = D2 + A2				! drop down once more
	CALL CGL (GMA2, C, A2)			! move to position
	CALL CGL (GT, SYSACC, 6)		! identify source
	A2 = B + D2				! remember D is negative
	CALL CGL (GMA2, C, A2)			! top left
	CALL CGL (GT, MAXVAL, 8)		! write in maximum Y
	CALL CGL (GMA2, C, D2)			! lower left
	CALL CGL (GT, STARTM, 8)		! starting time
	CALL CGL (GITE2, 20, DX, DY)		! obtain amount of space used
	A2 = C + DX
	CALL CGL (GMA2, A2, D2)			! over that amount
	CALL CGL (GT, DATE, 9)			! note the date
	CALL CGL (GITE2, 22, DX, DY)		! repeat process
	A2 = DX + A2
	CALL CGL (GMA2, A2, D2)
	CALL CGL (GT, TITLE(1,F), 17)		! identify variable plotted
	CALL CGL (GITE2, 30, DX, DY)
	A2 = DX + A2
	CALL CGL (GMA2, A2, D2)
	CALL CGL (GT, ENDTIM, 8)		! ending time
	DY = 0.25 * D2				! length of tic
	DX = -(DY)				! actually move above line
	A2 = 0.96 * B				! length of top tic
	DO 800 J = 1, 2				! for top and bottom of graph
	DO 800 M = 1, H				! put in hour tics
	AR = HOURS(M)				! re-use AR as temp. var.
	IF (AR .LE. (0.02 * A)) GOTO 800	! don't overprint first time
	IF (AR .GE. (0.98 * A)) GOTO 800	! or last time
	IF (J .EQ. 1) THEN			! do edges seperately
		CALL CGL (GMA2, AR, DX)		! move over above bottom line
		CALL CGL (GLA2, AR, DY)		! draw small line
	ELSE
		CALL CGL (GMA2, AR,  B)		! move over on top line
		CALL CGL (GLA2, AR, A2)		! draw another small line
	ENDIF
  800	CONTINUE
	IF (PRINT) THEN
		CALL CGL (GPS, C, A, D, B, 0., 0.)	! print screen
	ELSE IF (FILE .OR. PLOT) THEN
		IF (PLOT) CALL CGL (GMA2, C, B)		! move to top left
		CALL CGL (GEB)				! end batch
		WRITE (5, 820) F
  820		FORMAT('  Finished frame ', I2)
	ELSE
		CALL CGL (GMA2, C, D)		! move cursor to lower left
		CALL CGL (GCW, 8.)		! Wait
	ENDIF
	CALL CGL (GNF)				! New Frame
 1000	CONTINUE
C
  900	CALL CGL (GSCM, SAVCOL)			! Put original colors back
	CALL CGL (GDVS, OUTFIL, OUTLEN)		! De-Select view surface
	CALL CGL (GTVS, OUTFIL, OUTLEN)		! Terminate view surface
	CALL CGL (GTC)				! Terminate Core
  999	CALL EXIT
	END