c c subroutine histo (nvals,bin) c c c PROG NAME: HISTO2.rat c c DATE OF FIRST VERSION: 20-Sep-78 c DATE OF CURRENT VERSION: 21-Jun-83 c c PURPOSE: PLTFIL routine to plot histogram data c c USAGE: call HISTO (NVALS,BIN) c c Where NVALS = No. of bins c BIN = Bin values c c NOTES FOR PROGRAMMERS: The histogram fills the entire X-axis length c with the number of bins provided. Thus, all c bins along the X-axis must be accounted for. c c PROGRAMMER: Mike Collins / Eric Javel / Matt Prucka c c********************************************************************* c c c Common block for PLT parameters c real*8prmnam,txtnam,keywrd bytexlabel,ylabel,rlabel,xfmt,yfmt,rfmt,msg,filonm(14) bytefilinm(40) logical*1dataon,pltfnd,msgflg,finflg,modflg,conton,axflg,newpag, & ecflg,typerr,dbflg c common /params/xmin,xmax,xint,xcycle,xpct,xlen,xllc,ymin,ymax, & yint,ycycle,ypct,ylen,yllc,rmin,rmax,rint,rcycle,rpct,pltype, & typlin,pltlin,symnum,sizsym,solid,sizann,wtlnan,xanlab,yanlab, & ranlab,yhor,grid,sizlab,wtlnlb,ticmrk,shade,echo,wtlnax,openax, & sizmsg,wtlnms,xmsg,ymsg,angmsg,datmsg,sizfac,smooth,header,sort, & unused(1) common /flags/dataon,pltfnd,msgflg,finflg,modflg,conton,axflg, & newpag,ecflg,typerr,dbflg common /names/prmnam(50),txtnam(6),keywrd(25),filinm,filonm common /text/xlabel(52),ylabel(52),rlabel(52),xfmt(6),yfmt(6), & rfmt(6),msg(256) common /misc/ifrom,ito,inow,ipage,model,lunin,lunout c common /axes/rxmin,rxmax,rymin,rymax,rxlen,rylen,rxllc,ryllc, & pxmin,pxmax,pymin,pymax,pxlen,pylen,pxllc,pyllc common /size/tiklen,hitann,hitlab,hitsym,hitmsg,iaxlnw,igrlnw, & ianlnw,ilblnw,ipllnw,imslnw,avgaxl common /msks/ msk1,msk2,msk3,msk4,msk5 dimension bin(256),xclr(4),yclr(4) c c------------------------------------------------------------------------ c c Initialize call newpen (ipllnw) if(.not.(ycycle .eq. 0.))goto 23000 cony = rymax - rymin goto 23001 c else 23000 continue cony = alog10 (rymax/rymin) 23001 continue cony = rylen * ypct/100. / cony xbase = rxllc + rxlen*(1.-xpct/100.)/2. ybase = ryllc + rylen*(1.-ypct/100.)/2. barwid = rxlen * xpct/100. / nvals c Do the histogram c for i=1 23002 if(.not.(i.le.nvals))goto 23004 if(.not.(bin(i) .gt. 0.))goto 23005 xbegin = xbase + (i-1)*barwid xend = xbegin + barwid ybegin = ybase if(.not.(ycycle .eq. 0.))goto 23007 yend=ybase + (bin(i)-rymin)*cony goto 23008 c else 23007 continue yend=ybase + alog10(bin(i)/rymin)*cony 23008 continue call plot2 (xbegin,ybegin,3) call plot2 (xbegin,yend,2) call plot2 (xend,yend,2) call plot2 (xend,ybegin,2) c Check for shaded bars if(.not.(shade .ne. 0.))goto 23009 dx=.01 c for xx=xend-dx 23011 if(.not.(xx.gt.xbegin))goto 23013 call plot2(xx,ybegin,2) call plot2(xx,yend,2) xx=xx-dx if(.not.(xx.gt.xbegin))goto 23014 call plot2(xx,yend,2) call plot2(xx,ybegin,2) 23014 continue xx=xx-dx goto 23011 c endfor 23013 continue 23009 continue 23005 continue i=i+1 goto 23002 c endfor 23004 continue c Draw the bottom of the histogram if Y-axis offset is specified if(.not.(shade.eq.0. .and. ybase.ne.ryllc))goto 23016 call plot2 (xbase,ybase,3) call plot2 (xend,ybase,2) 23016 continue return end