SUBROUTINE BARPLT (FNME,FMT,YARR,XSTART,XINC,NUMBAR,ISTAT) # # # BARPLT plots data as a bar graph. Subroutine BARBOX must have been # called before this routine. Data is either read from a file (FNME) # or alternatively from an array (YARR). If FNME contains a zero in the # first byte, the assumption is made that the data is in YARR. # # Parameters: # # FNME Name of file containing data. 0 in byte 1 means no file. # FMT Character array containing the run time format # YARR If byte 1 of FNME is zero,or ' ', data is assumed to be in this # array. The last array element must be -999.. # XSTART Starting value of the horizontal axis. # XINC The width of a bar in X units. # NUMBAR The number of bars in the horizontal (integer <50). # ISTAT On Input: # 0 Last plot of the program # >0 More plots to follow # # Returned status # 0 Success # -1 BARBOX was not called FATAL. # -2 NUMBAR exceeds maximum (50) # -3 Error in Format parameter # # logical barflg,file,finit real yarr(1),limits(50),hole(50) integer*4 i4 byte fmt(20),abuf(20) byte fnme(20) common /bar/ barflg,kolor # # if (istat.eq.0) finit=.true. else finit=.false. istat=0 call errset(62,.true.,,,.false.) if (.not.barflg) { istat=-1 return } if (numbar.gt.50) { istat=-2 return } barflg=.false. # if ((fnme(1).ne.0).and.(fnme(1).ne.' ')) { file=.true. open (unit=7,name=fnme,type='OLD',readonly) } limits(1)=xstart hole(1)=0 do i=2,numbar { limits(i)=limits(i-1)+xinc hole(i)=0 } # # Calculate distribution of data # i=1 repeat { if (file) read(7,fmt,end=10,err=20)y else y=yarr(i) if (y.eq.-999.)break do j=1,numbar { y=y+.0001*y if (y.gt.limits(j)) { if (y.le.(limits(j)+xinc)) { hole(j)=hole(j)+1 break } } } i=i+1 } 10 continue # # Draw x scale # bwidth=8./numbar xs=0.-bwidth*.7 y=-0.5 if(kolor) call color(2) do i=1,numbar { xs=xs+bwidth i4=i call binasc(i4,2,10,abuf) call symbol(xs,y,.2,abuf,0.,2) } # ymax=0 do i=1,numbar { if(hole(i).gt.ymax) ymax=hole(i) } # # Draw y scale # if(kolor) call color(1) x=0. yync=ymax/10. yy=0. do 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) } # # Draw legend # if (kolor) call color(2) x=8.1 y=9.5 abuf(3)=' ' abuf(8)='-' do 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 } # # Draw bars # x=0. xn=0. y=0. call plot(0.,0.,3) if (kolor) call color(3) do 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 (y.ne.0) call hatch(xn,y,bwidth) xn=x } if (kolor) call color(1) if (finit) call plot(0.,0.,999) close(unit=7) return 20 continue istat=-3 return end # # # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ # subroutine hatch (x,y,width) # # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ # # x,y = upper left coordinate of bar # width= width in x direction # logical toggle # xi=x xh=x yh=0. yi=0. repeat { xi=xi+.2 yh=yh+.2 if (xi.gt.x+width) { if (yi.eq.0) { yi=xi-(x+width) } else yi=yi+.2 xi=x+width } if (yh.gt.y) { if (xh.eq.x) { xh=x+yh-y } else xh=xh+.2 yh=y } if ((xh.ge.(x+width)).and.(yh.ge.y))break if (toggle) { call plot(xi,yi,3) call plot(xh,yh,2) toggle=.not.toggle } else { call plot(xh,yh,3) call plot(xi,yi,2) toggle=.not.toggle } } call plot (x+width,0.,3) return end