	subroutine bemset
c
	include '/u1/gcf/e350/crystal/cb/beam'
	include '/u1/gcf/e350/crystal/cb/efm'
	include '/u1/gcf/e350/crystal/cb/clouds'
	include '/u1/gcf/e350/crystal/cb/parms'
	include '/u1/gcf/e350/crystal/cb/foxin'
	include '/u1/gcf/e350/crystal/cb/datbin'
	include '/u1/gcf/e350/crystal/cb/type'
c
	call wgtint(pinc-dbeam,pinc+dbeam,nobeam,pbm,wgp)
	nbeam=nobeam
	if (fitbem) nbeam=nbeam+2
	do 10 ibm=1,nbeam
	if (ibm.le.nobeam) p=pbm(ibm)
	if (ibm.eq.nobeam+1) p=pinc-dbeam
	if (ibm.eq.nobeam+2) p=pinc+dbeam
	pbm(ibm)=p
	pp=p*p
	pbm2(ibm)=pp
	e=sqrt(am2j+pp)
	ebm(ibm)=e
	ss=2.*amp*e+am2j+amp2
	s(ibm)=ss
	do 1 i=1,ntrdis
1	sreal(ibm,i)=2.*amp*e*core(i)+am2j+amp2
	ca=amp+e
	cc=pp*am2i
	cd=ss+am2i
	ce=ca*(mxmin2-cd)
	cf=.25*(cd-mxmin2)**2+cc
	cona(ibm)=ca
	conc(ibm)=cc
	cond(ibm)=cd
c	calculate proton momentum squared in c m
	pprosq=(ss**2-2.*ss*(am2j+amp2)+am2j**2+amp2**2-4.*am2j*amp2)*.25/ss
	aeta(ibm)=sqrt(pprosq)/amp
	agam(ibm)=sqrt(pprosq/amp2+1.0)
	enhigh(ibm)=emaxm(-avt,ce,cf,ss,pp)
	enhghi(ibm)=1./enhigh(ibm)
10	def(ibm)=dfromm(mxmin2,-avt,s,ca,cc,cd,pp,e)*p/e
	sreg=sreal((nobeam+1)/2,1)
	return
	end
