PROGRAM DEV2 C C To read the device summary created by Datatrieve C C B. Z. Lederman 09-Apr-84 One device per graph C 12-Oct-84 Update for plotter, file, etc. C 15-Jan-85 Update: flattop, slow plot, etc. C 31-Jan-85 Maximums for each variable C 20-Feb-85 Virtual arrays, move pen at end, more hours, C IMPLICIT INTEGER (A-F, H-W) PARAMETER POINTS = 330 PARAMETER NBRDEV = 6 PARAMETER NBRDAT = NBRDEV * 3 C INCLUDE '[001005]CGL.FTN/NOLIST' C VIRTUAL YV(POINTS, NBRDEV, 3) REAL X(2, POINTS), Y(2, POINTS), INC REAL A, B, C, D, A2, D2, AL, AR, DX, DY, HOURS(32) 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, PLOT, FILE, SLOW 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 EQUIVALENCE (OUTFIL(1), OUTF) C DATA DEVCE, OLDDEV / NBRDEV * ' ', ' ' / DATA I, HOURS, MAX / NBRDAT * 0, 32 * 0., NBRDAT * 0 / DATA INPFIL, OUTFIL, OUTLEN / 32 * 0, 32 * 0, 0 / DATA TI, GH, BLANKS / 'TI:', 'GH:', 10 * ' ' / 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) 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 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 OPEN (UNIT = 1, FILE = 'TT2:FORMF.EED', TYPE = 'NEW') ENDIF C CALL CGL (GIC) ! Initialize CGL 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 DO 1000 DV = 1, NBRDEV ! once for each device B = AJMAX0( MAX(DV, 1), MAX(DV, 2), MAX(DV, 3)) ! most used frame IF (B .LE. 0) GOTO 1000 ! device not used today L = IMAX0( I(DV, 1), I(DV, 2), I(DV, 3)) ! most number of points DO 210 F = 1, 3 ! for each frame IF (MAX(DV, F) .LE. 0.) GOTO 210 ! skip zero activity A = B / MAX(DV, F) ! use A as scaling factor DO 210 M = 1, L ! scale all points in frame IF (F .EQ. 1) THEN ! if first frame X(1, M) = M ! also set Y axis points X(2, M) = M + 1 ENDIF YV(M, DV, F) = A * YV(M, DV, F) ! scale data 210 CONTINUE 220 A = L ! A is now max. Y axis M = L ! store for later L = L - 1 ! correct plot points L = 2 * L ! number to plot "flat top" 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.12 * A D = -0.10 * B IF (PLOT) THEN 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 DX = 0.025 * A ! length of tic DY = A - DX ! position of right tic DX = DX + 1. ! correct for left edge 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 a small line ELSE CALL CGL (GMA2, A, AR) ! move to position at right CALL CGL (GLA2, DY, AR) ! draw another small line ENDIF 600 CONTINUE C D2 = 0.5 * D ! need for positioning A2 = B + D2 ! ditto AL = -0.02 * A ! left end of sample line AR = -2. * AL ! right end of sample line C DO 300 F = 1, 3 ! once for each activity IF (MAX(DV, F) .LE. 0) GOTO 300 ! skip zero activity ENCODE (8, 250, VALUE) MAX(DV, F) ! get maximum this variable 250 FORMAT( I8) DO 280 J = 1, M ! move data from virtual Y(1, J) = YV(J, DV, F) ! to local storage Y(2, J) = Y(1, J) ! "flat top" 280 CONTINUE CALL CGL (GSWI, F) ! Set color IF (.NOT.PLOT) CALL CGL (GSLS, F, 0, 0) ! set line type IF (B .EQ. FLOATJ( MAX(DV, F))) THEN ! find most used activity CCC CALL CGL(GSLS, 1, 0, 0) ! and set solid line ENCODE (8, 250, MAXVAL) MAX(DV,F) ! absolute maximum 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, TITLE(1,F), 6) ! name activity 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 maximum CALL CGL (GMA2, C, A2) ! move to position CALL CGL (GT, VALUE, 8) ! write out maximum 300 CONTINUE C CALL CGL (GSLS, 1, 0, 0) ! set line type to solid CALL CGL (GSWI, 7) ! set color to white 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, DEVCE(DV), 4) ! identify device 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 ! do edges seperately 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 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 IF (DV .EQ. 1 .OR. DV .EQ. 4) WRITE (1, 810) ! formfeed 810 FORMAT ( '1' ) 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) DV 820 FORMAT(' Finished device ', I2) ELSE CALL CGL (GMA2, C, D) ! move cursor to corner 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 999 CALL EXIT END