	subroutine oohist
c	make histograms
c
	include '/u1/rgk/icicle/cb/ztpltc'
	include '/u1/gcf/e350/crystal/cb/norm'
	include '/u1/gcf/e350/crystal/cb/wenbin'
	include '/u1/gcf/e350/crystal/cb/datbin'
	include '/u1/gcf/e350/crystal/cb/where'
	include '/u1/gcf/e350/crystal/cb/beam'
	include '/u1/gcf/e350/crystal/cb/it'
	include '/u1/gcf/e350/crystal/cb/igr'
	include '/u1/gcf/e350/crystal/cb/ooflak'
	include '/u1/gcf/e350/crystal/cb/parms'
	include '/u1/gcf/e350/crystal/cb/abssiz'
	include '/u1/gcf/e350/crystal/cb/clouds'
	include '/u1/gcf/e350/crystal/cb/they'
	include '/u1/gcf/e350/crystal/cb/const'
	dimension num(10),nath(6),thsbav(7),totth(7),binoo(180),
&	ebinoo(180),thoo(180),allth(7)
c
	character*10 num,idot,istar,ix,ibl,ith,nath
	character*1 kout(81)
	data num/1h0,1h1,1h2,1h3,1h4,1h5,1h6,1h7,1h8,1h9/
	data idot/1h./,istar/1h*/,ix/1hx/,ibl/1h /,ith/1ht/
	data nath/1ha,1hb,1hc,1hd,1he,1hf/,nocol,nocol1/81,80/
c
13	format(36h ******** histogram deleted as empty)
14	format(47h energy x accum     x value     midpt thy resid)
20	format(' normn='1pg9.3' expl cs='1pg10.3'+-'1pg9.3
&	' mub  total thy cs='g9.3'  exp/thy='1pg9.3' indivl thy cs '5g10.3)
21	format(' indivl thy cs over entire range'5g10.3)
100	format(1h ,f5.1,2f9.2,2h+-,f6.2,f9.2,f5.1,1x,81a1)
101	format(' index to theory')
102	format(' symbol = 'a2'    theory = '4a10)
103	format(1h ,f5.1,2f9.4,2h+-,f7.4,f8.4,f5.1,1x,81a1)
105	format(1h ,f5.1,2f9.2,2h+-,f7.4,1x,81a1)
106	format(1h ,f5.1,2f9.4,2h+-,f7.4,1x,81a1)
107	format(' energy x accum   v value      ')
c
	if (usei2.and.dofit.and.(.not.dolist)) call resi2
	nempty=0
	fudm=fdmicr/abs(tlo-thi)
c
c	loop over triggers
	do 16 it=1,ntrdis
	empty(it)=.false.
	a=0.
	noet=noe(it)
	ia=ie1(it)
	ib=ie2(it)
	accum=0.
	counte=0.
	ebb=0.
	do 87 j=1,noth
	allth(j)=0.
87	totth(j)=0.
	fudq=fudm/de(it)
	if (noth.eq.0) goto 44
	call wgtint(0.,de(it),moint,val1(1,it),wgt1(1,it))
	igr=igrp(it)
	pll=0.
	jp=jpart(igr)
	if (jp.le.4) pll=plim2(1)
	if (jp.ge.5) pll=plim2(jp-4)
	call prepth(noet,de(it),elow(it),pll,fixed(igr),jp)
c
44	idbeg=1
	idend=1
	do 11 i=1,noet
	binoo(i)=binb(i,it)*fudq
	ebinoo(i)=ebinb(i,it)/fudq
	thoo(i)=th(i)*fudq
	a=amax1(a,binoo(i),thoo(i))
	if (idbeg.eq.i-1.and.binoo(i).eq.0.) idbeg=i
	if (binoo(i).ne.0.) idend=i
11	continue
	if(a.gt.1.e-20) go to 12
	empty(it)=.true.
	nempty=nempty+1
	print 13
	goto 16
c
12	a=float(nocol1)/a
	ioo=1
	if (a.gt.8.) ioo=2
	if (cross) then
	print 107
	else
	print 14
	endif
	e=elow(it)+float(idbeg-1)*de(it)
	nloop=iocon(it)
c
c	loop over energy bins truncating zeroes from both ends of plot
	if (idend.lt.idbeg) call abort
	do 1 i=idbeg,idend
	if (ebinoo(i).gt.0) eb=amax1(1.,sqrt(amax1(ftest(i,it)*fudq,
&	thoo(i))/amax1(ftest(i,it)*fudq,binoo(i))))/ebinoo(i)
	if (ebinoo(i).le.0.) eb=0.
	bb=binoo(i)
c
	if(i.eq.1) go to 61
	if(iloop.ne.nloop) go to 62
61	iloop=0
	thav=0.
	bbav=0.
	ebav=0.
	if (noth.eq.0) goto 62
	do 63 j=1,noth
63	thsbav(j)=0.
c
62	iloop=iloop+1
	if(noth.lt.1) go to 67
	do 65 j=1,noth
	thsbav(j)=thsbav(j)+thy(i,j)*fudq
	allth(j)=allth(j)+thy(i,j)*fudm
65	if (i.ge.ia.and.i.le.ib) totth(j)=totth(j)+thy(i,j)*fudm
67	bbav=bbav+bb
	ebav=ebav+eb*eb
	if(iloop.eq.1) eav=e
	thav=thav+thoo(i)
c
	if(i.lt.ia) go to 41
	if (i.gt.ib) goto 41
	counte=counte+bb*de(it)
	ebb=ebb+eb**2
41	continue
	if(iloop.ne.nloop.and.i.  ne.noet) go to 1
	kout(1)=idot
	if (10*(i/10).eq.i) kout(1)=istar
c
	thav=thav/iloop
	bbav=bbav/iloop
	ebav=sqrt(ebav)/iloop
	j=bbav*10.*a+.5000001
	jj=j/10
	j=j-jj*10
c
	if (jj.gt.0) goto 7
	jj=jj+1
	if (jj.ge.0.and.j.gt.0) kout(jj+1)=num(1+j)
	jj=max0(jj,1)
	goto 4
7	iy=(bbav-ebav)*a+.0001
	do 2 k=1,jj
	if (k.le.iy) then
		kout(k+1)=ix
	else
		kout(k+1)=istar
	endif
2	continue
	jj=jj+1
	if(j.eq.0) go to 4
	kout(jj+1)=num(1+j)
	jj=jj+1
c
4	if (jj.eq.nocol) goto 40
	do 6 k=jj,nocol1
6	kout(k+1)=ibl
c
40	if(noth.le.1) go to 50
	do 30 j=1,noth
	jath=thsbav(j)*a/iloop+.500001
	if (jath.le.0.or.jath.gt.nocol1) goto 30
	kout(jath+1)=nath(j)
30	continue
c
50	jth=thav*a+.500001
	if (ebav.gt.0.) resid=(thav-bbav)/ebav
	if (ebav.le.0.) resid=-9.99
	accum=accum+bbav
	if (jth.le.0.or.jth.gt.nocol1) goto 5
	kout(jth+1)=ith
	if(i.lt.ia.or.i.gt.ib) kout(jth+1)=1hn
c
c	calculate last non-blank column
5	do 77 ik=1,nocol
	jcl=nocol-ik+1
	if (kout(jcl).ne.ibl) goto 78
77	continue
78	if (ioo.eq.1) then
		if (cross) then
		print 105,eav,accum,bbav,ebav,(kout(ik),ik=1,jcl)
		else
		print 100,eav,accum,bbav,ebav,thav,resid,(kout(ik),ik=1,jcl)
		endif
	else
		if (cross) then
		print 106,eav,accum,bbav,ebav,(kout(ik),ik=1,jcl)
		else
		print 103,eav,accum,bbav,ebav,thav,resid,(kout(ik),ik=1,jcl)
		endif
	endif
1	e=e+de(it)
c
c	output overall normalizations
	if (.not.dofit) goto 16
	errore=sqrt(ebb)*de(it)
	if (noth.gt.0) goto 32
	print 20,fudm,counte,errore
	goto 16
32	oth=0.
	do 19 j=1,noth
19	oth=oth+totth(j)
	arat=0.
	if (oth.gt.0.) arat=counte/oth
	print 20,fudm,counte,errore,oth,arat,(totth(j),j=1,noth)
	print 21,(allth(j),j=1,noth)
16	continue
	if (nempty.eq.ntrdis) return
c
c	index to theory
	if (noth.le.1) return
	print 101
	do 60 j=1,noth
	print 102,nath(j),(namth(k,j),k=1,4)
60	continue
	return
	end
