SUBROUTINE BAR(X,Y,NPTS,IHSET,IVSET,AXLENX,AXLENY +,KC,IV,IP,ILEGND) C C X,Y(REAL)=X,Y data arrays C NPTS(INTEGER)=Number of points in each set C IHSET(INTEGER)=Number of horizontal bars/x value C The bars will be centered about every tick mark. C If IHSET=-IHSET then draw the bars around C the actual X value,whether it lies on the tick mark C or not,and set the bar width to .5 C IVSET(INTEGER)=Number of vertical bars/x value C AXLENX(REAL)=Length of the x-axis in inches C AXLENY(REAL)=Length of the y-axis in inches C KC(INTEGER)=Current data set number C IV(INTEGER)=Flag for bar filling/hatching C 0 = no fill C 1 = solid fill C 2 = horizontal fill C 3 = vertical fill C 4 = left diagonal C 5 = right diagonal C 6 = up/down cross hatch C 7 = diagonal cross hatch C IP(INTEGER)=array containing the pen number (1-8) for current set C ILEGND(BYTE)=array containing the data strings of legend information C C Subroutine SCALE must first be called C which returns in array(npts+1) the minimum C and in array(npts+2) the increment C DIMENSION X(1),Y(1),IV(1),IP(1) BYTE SET(24),ILEGND(20,24) INTEGER I 5 YMIN=Y(NPTS+1) DY=Y(NPTS+2) XMIN=X(NPTS+1) DX=X(NPTS+2) DO 10 I=1,NPTS Y(I)=(Y(I)-YMIN)/DY X(I)=(X(I)-XMIN)/DX 10 CONTINUE ISS=ISIGN(1,IHSET) IF(IVSET.GT.1)NPTS=NPTS/IVSET IF(ISS.GT.0)BARWID=(AXLENX+1.)/FLOAT(NPTS*IHSET+NPTS) IF(ISS.LT.0)BARWID=.25 XINT=BARWID/2.-.5 IF(KC.EQ.1.AND.ISS.GT.0)CALL PLOT(XINT,0.,-3) XNEXT=BARWID*(FLOAT(KC)-1.) DO 40 I=1,NPTS YHT=0.0 IF(ISS.LT.0)XNEXT=X(I)-BARWID/2. DO 20 J=1,IVSET !for vertically stacked bars IFLTYP=IV(J) !get the shading pattern IPEN=IP(J) YMAX=Y(NPTS*J-NPTS+I) !get the Y value CALL NEWPEN(IPEN) !if not pen #1,change it CALL FILL(XNEXT,YHT,BARWID,YMAX+YHT,AXLENY,IFLTYP) !shade it CALL NEWPEN(1) CALL RECTS (XNEXT,YHT,BARWID,YMAX) !draw the bar YHT=YMAX !save old Y value 20 CONTINUE 30 CALL LINTYP(0) XNEXT=XNEXT+BARWID*FLOAT(IHSET+1) 40 CONTINUE YLPOS=FLOAT((KC-1)*IVSET)+.2 !Y position for legend plotting XLPOS=AXLENX+1. !X position for legend plotting DO 50 J=1,IVSET DO 45 K=1,24 45 SET(K)=ILEGND(J,K) NLEN=LEN(SET) IF(NLEN.EQ.0)GOTO 50 IFLTYP=IV(J) IPEN=IP(J) CALL NEWPEN(1) CALL SYMBOL(XLPOS,YLPOS,.18,SET,0.,NLEN) !what it is CALL NEWPEN(IPEN) CALL FILL(XLPOS,YLPOS+.3,.4,YLPOS+.7,AXLENY,IFLTYP) !shade it CALL NEWPEN(1) CALL RECTS(XLPOS,YLPOS+.3,0.4,0.4) YLPOS=YLPOS+1. 50 CONTINUE IF(KC.EQ.IHSET)CALL PLOT(-XINT,0.,-3) RETURN END C SUBROUTINE FILL(XNEXT,YHT,BARWID,YMAX,AXLENY,IFLTYP) IF(YMAX-YHT.LT..01)RETURN CALL PLOT(XNEXT,YHT,3) GOTO(1,10,30,10,50,90,110,150),IFLTYP+1 C C NO FILL C 1 RETURN C C VERTICAL FILL OR SOLID FILL C 10 IF(IFLTYP.EQ.1)XINC=0.01 IF(IFLTYP.EQ.3)XINC=BARWIDTH/6. IF(XINC.GT.BARWID)XINC=BARWID XN=XNEXT+XINC 20 IF(XN.GE.XNEXT+BARWID)RETURN CALL PLOT(XN,YHT,2) CALL PLOT(XN,YMAX,1) XN=XN+XINC IF(XN.GE.XNEXT+BARWID)RETURN CALL PLOT(XN,YMAX,1) CALL PLOT(XN,YHT,1) XN=XN+XINC GOTO 20 C C HORIZONTAL FILL C 30 YINC=AXLENY/(AXLENY*10.) YN=YHT XI=XNEXT+BARWID 40 YN=YN+YINC IF(YN.GT.YMAX)RETURN CALL PLOT(XNEXT,YN,2) CALL PLOT(XI,YN,1) YN=YN+YINC IF(YN.GT.YMAX)RETURN CALL PLOT(XI,YN,1) CALL PLOT(XNEXT,YN,1) GOTO 40 C C LEFT DIAGONAL FILL C 50 YINC=AXLENY/(AXLENY*10.) XLEFT=XNEXT YNL=YHT YNR=YHT-YINC XI=XLEFT+BARWID SLOPE=(YNR-YNL)/BARWID 60 YNL=YNL+YINC YNR=YNR+YINC IF(YNR.GE.YMAX)RETURN IF(YNL.LE.YMAX)GOTO 65 XYMAX=(YMAX-YNL )/SLOPE !at the top of the bar,calculate X XLEFT=XNEXT+XYMAX !offset it YNL=YMAX !don't go over the top of the bar CALL PLOT(XNEXT,YMAX,1) !move to the top left corner 65 CALL PLOT(XLEFT,YNL,2) CALL PLOT(XI,YNR,1) YNL=YNL+YINC YNR=YNR+YINC IF(YNR.GE.YMAX)RETURN IF(YNL.LE.YMAX)GOTO 68 XYMAX=(YMAX-YNL)/SLOPE XLEFT=XNEXT+XYMAX YNL=YMAX 68 CALL PLOT(XI,YNR,1) CALL PLOT(XLEFT,YNL,1) GOTO 60 C C RIGHT DIAGONAL FILL C 90 YINC=AXLENY/(AXLENY*20.) XLEFT=XNEXT YNR=YHT YNL=YHT-YINC XI=XLEFT+BARWID SLOPE=(YNR-YNL)/BARWID 100 YNL=YNL+YINC YNR=YNR+YINC IF(YNL.GE.YMAX)RETURN IF(YNR.LE.YMAX)GOTO 105 XYMAX=(YMAX-YNL)/SLOPE XI=XNEXT+XYMAX YNR=YMAX CALL PLOT(XNEXT+BARWID,YMAX,1) 105 CALL PLOT(XLEFT,YNL,2) CALL PLOT(XI,YNR,1) YNL=YNL+YINC YNR=YNR+YINC IF(YNL.GE.YMAX)RETURN IF(YNR.LE.YMAX)GOTO 108 XYMAX=(YMAX-YNL)/SLOPE XI=XNEXT+XYMAX YNR=YMAX 108 CALL PLOT(XI,YNR,1) CALL PLOT(XLEFT,YNL,1) GOTO 100 C C UP/DOWN CROSS HATCH C 110 XINC=BARWIDTH/4. IF(XINC.GT.BARWID)XINC=BARWID XN=XNEXT+XINC 120 IF(XN.GE.XNEXT+BARWID)GOTO 130 CALL PLOT(XN,YHT,2) CALL PLOT(XN,YMAX,1) XN=XN+XINC IF(XN.GE.XNEXT+BARWID)GOTO 130 CALL PLOT(XN,YMAX,1) CALL PLOT(XN,YHT,1) XN=XN+XINC GOTO 120 CALL PLOT(XLEFT,YHT,3) 130 YINC=AXLENY/(AXLENY*10.) YN=YHT XI=XNEXT+BARWID CALL PLOT(XNEXT,YN,3) 140 YN=YN+YINC IF(YN.GE.YMAX)RETURN CALL PLOT(XNEXT,YN,2) CALL PLOT(XI,YN,1) YN=YN+YINC IF(YN.GE.YMAX)RETURN CALL PLOT(XI,YN,1) CALL PLOT(XNEXT,YN,1) GOTO 140 C C DIAGONAL CROSS HATCH C 150 YINC=AXLENY/(AXLENY*15.) XLEFT=XNEXT YNL=YHT YNR=YHT-YINC XI=XLEFT+BARWID SLOPE=(YNR-YNL)/BARWID 160 YNL=YNL+YINC YNR=YNR+YINC IF(YNR.GE.YMAX)GOTO 170 IF(YNL.LE.YMAX)GOTO 165 XYMAX=(YMAX-YNL)/SLOPE XLEFT=XNEXT+XYMAX YNL=YMAX CALL PLOT(XNEXT,YMAX,1) 165 CALL PLOT(XLEFT,YNL,2) CALL PLOT(XI,YNR,1) YNL=YNL+YINC YNR=YNR+YINC IF(YNR.GE.YMAX)GOTO 170 IF(YNL.LE.YMAX)GOTO 168 XYMAX=(YMAX-YNL)/SLOPE XLEFT=XNEXT+XYMAX YNL=YMAX 168 CALL PLOT(XI,YNR,1) CALL PLOT(XLEFT,YNL,1) GOTO 160 170 CALL PENUP XLEFT=XNEXT YNR=YHT YNL=YHT-YINC XI=XLEFT+BARWID SLOPE=(YNR-YNL)/BARWID CALL PLOT(XNEXT,YHT,3) 180 YNL=YNL+YINC YNR=YNR+YINC IF(YNL.GE.YMAX)RETURN IF(YNR.LE.YMAX)GOTO 185 XYMAX=(YMAX-YNL)/SLOPE XI=XNEXT+XYMAX YNR=YMAX CALL PLOT(XI,YMAX,1) 185 CALL PLOT(XLEFT,YNL,2) CALL PLOT(XI,YNR,1) YNL=YNL+YINC YNR=YNR+YINC IF(YNL.GE.YMAX)RETURN IF(YNR.LE.YMAX)GOTO 190 XYMAX=(YMAX-YNL)/SLOPE XI=XNEXT+XYMAX YNR=YMAX 190 CALL PLOT(XI,YNR,1) CALL PLOT(XLEFT,YNL,1) GOTO 180 END