SUBROUTINE BARPLT(FNME, FMT, YARR, XSTART, XINC, NUMBAR, ISTAT) C C C BARPLT plots data as a bar graph. Subroutine BARBOX must have been C called before this routine. Data is either read from a file (FNME) C or alternatively from an array (YARR). If FNME contains a zero in the C first byte, the assumption is made that the data is in YARR. C C Parameters: C C FNME Name of file containing data. 0 in byte 1 means no file. C FMT Character array containing the run time format C YARR If byte 1 of FNME is zero,or ' ', data is assumed to be in this C array. The last array element must be -999.. C XSTART Starting value of the horizontal axis. C XINC The width of a bar in X units. C NUMBAR The number of bars in the horizontal (integer <50). C ISTAT On Input: C 0 Last plot of the program C >0 More plots to follow C C Returned status C 0 Success C -1 BARBOX was not called FATAL. C -2 NUMBAR exceeds maximum (50) C -3 Error in Format parameter C C LOGICAL BARFLG, FILE, FINIT REAL YARR(1), LIMITS(50), HOLE(50) INTEGER*4I4 BYTE FMT(20), ABUF(20) BYTE FNME(20) COMMON/BAR/BARFLG, KOLOR C C IF (.NOT.(ISTAT.EQ.0)) GOTO 2000 FINIT = .TRUE. GOTO 2010 2000 CONTINUE FINIT = .FALSE. 2010 CONTINUE ISTAT = 0 CALL ERRSET(62, .TRUE., , , .FALSE.) IF (.NOT.(.NOT.BARFLG)) GOTO 2020 ISTAT = - 1 RETURN 2020 CONTINUE IF (.NOT.(NUMBAR.GT.50)) GOTO 2040 ISTAT = - 2 RETURN 2040 CONTINUE BARFLG = .FALSE. C IF (.NOT.((FNME(1).NE.0).AND.(FNME(1).NE.' '))) GOTO 2060 FILE = .TRUE. OPEN(UNIT = 7, NAME = FNME, TYPE = 'OLD', READONLY) 2060 CONTINUE LIMITS(1) = XSTART HOLE(1) = 0 DO 2080 I = 2, NUMBAR LIMITS(I) = LIMITS(I - 1) + XINC HOLE(I) = 0 C C Calculate distribution of data C 2080 CONTINUE I = 1 2100 CONTINUE IF (.NOT.(FILE)) GOTO 2130 READ(7, FMT, END=10, ERR=20) Y GOTO 2140 2130 CONTINUE Y = YARR(I) 2140 CONTINUE IF (.NOT.(Y.EQ.-999.)) GOTO 2150 GOTO 2120 2150 CONTINUE DO 2170 J = 1, NUMBAR Y = Y + .0001*Y IF (.NOT.(Y.GT.LIMITS(J))) GOTO 2190 IF (.NOT.(Y.LE.(LIMITS(J)+XINC))) GOTO 2210 HOLE(J) = HOLE(J) + 1 GOTO 2180 2210 CONTINUE 2190 CONTINUE 2170 CONTINUE 2180 CONTINUE I = I + 1 2110 GOTO 2100 2120 CONTINUE 10 CONTINUE C C Draw x scale C BWIDTH = 8./NUMBAR XS = 0. - BWIDTH*.7 Y = - 0.5 IF (.NOT.(KOLOR)) GOTO 2230 CALL COLOR(2) 2230 CONTINUE DO 2250 I = 1, NUMBAR XS = XS + BWIDTH I4 = I CALL BINASC(I4, 2, 10, ABUF) CALL SYMBOL(XS, Y, .2, ABUF, 0., 2) C 2250 CONTINUE YMAX = 0 DO 2270 I = 1, NUMBAR IF (.NOT.(HOLE(I).GT.YMAX)) GOTO 2290 YMAX = HOLE(I) 2290 CONTINUE C C Draw y scale C 2270 CONTINUE IF (.NOT.(KOLOR)) GOTO 2310 CALL COLOR(1) 2310 CONTINUE X = 0. YYNC = YMAX/10. YY = 0. DO 2330 I = 1, 10 YY = YY + YYNC IY = YY Y = IY*9./YMAX CALL PLOT(X, Y, 3) CALL PLOT(X - .1, Y, 2) CALL PLOT(X - .1, Y, 3) I4 = YY CALL BINASC(I4, 4, 10, ABUF) CALL SYMBOL(X - 1., Y - .12, .2, ABUF, 0., 4) C C Draw legend C 2330 CONTINUE IF (.NOT.(KOLOR)) GOTO 2350 CALL COLOR(2) 2350 CONTINUE X = 8.1 Y = 9.5 ABUF(3) = ' ' ABUF(8) = '-' DO 2370 I = 1, NUMBAR I4 = I CALL BINASC(I4, 2, 10, ABUF) I4 = LIMITS(I) CALL BINASC(I4, 4, 10, ABUF(4)) I4 = LIMITS(I) + XINC CALL BINASC(I4, 4, 10, ABUF(9)) CALL SYMBOL(X, Y, .2, ABUF, 0., 12) Y = Y - 0.3 C C Draw bars C 2370 CONTINUE X = 0. XN = 0. Y = 0. CALL PLOT(0., 0., 3) IF (.NOT.(KOLOR)) GOTO 2390 CALL COLOR(3) 2390 CONTINUE DO 2410 I = 1, NUMBAR Y = HOLE(I)*9./YMAX CALL PLOT(XN, Y, 2) X = X + BWIDTH CALL PLOT(X, Y, 2) CALL PLOT(X, 0., 2) IF (.NOT.(Y.NE.0)) GOTO 2430 CALL HATCH(XN, Y, BWIDTH) 2430 CONTINUE XN = X 2410 CONTINUE IF (.NOT.(KOLOR)) GOTO 2450 CALL COLOR(1) 2450 CONTINUE IF (.NOT.(FINIT)) GOTO 2470 CALL PLOT(0., 0., 999) 2470 CONTINUE CLOSE(UNIT = 7) RETURN 20 CONTINUE ISTAT = - 3 RETURN END C C C ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ C SUBROUTINE HATCH(X, Y, WIDTH) C C ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ C C x,y = upper left coordinate of bar C width= width in x direction C LOGICAL TOGGLE C XI = X XH = X YH = 0. YI = 0. 2490 CONTINUE XI = XI + .2 YH = YH + .2 IF (.NOT.(XI.GT.X+WIDTH)) GOTO 2520 IF (.NOT.(YI.EQ.0)) GOTO 2540 YI = XI - (X + WIDTH) GOTO 2550 2540 CONTINUE YI = YI + .2 2550 CONTINUE XI = X + WIDTH 2520 CONTINUE IF (.NOT.(YH.GT.Y)) GOTO 2560 IF (.NOT.(XH.EQ.X)) GOTO 2580 XH = X + YH - Y GOTO 2590 2580 CONTINUE XH = XH + .2 2590 CONTINUE YH = Y 2560 CONTINUE IF (.NOT.((XH.GE.(X+WIDTH)).AND.(YH.GE.Y))) GOTO 2600 GOTO 2510 2600 CONTINUE IF (.NOT.(TOGGLE)) GOTO 2620 CALL PLOT(XI, YI, 3) CALL PLOT(XH, YH, 2) TOGGLE = .NOT.TOGGLE GOTO 2630 2620 CONTINUE CALL PLOT(XH, YH, 3) CALL PLOT(XI, YI, 2) TOGGLE = .NOT.TOGGLE 2630 CONTINUE 2500 GOTO 2490 2510 CONTINUE CALL PLOT(X + WIDTH, 0., 3) RETURN END