	subroutine dblevl(ppde,epart,acc)
c     calculate double scattering correction, acc, at pperp/e of ppde and
c     energy of epart
c
	include '/u1/rgk/icicle/cb/dblsct'
c
100	format(' acca in dbleval negative at energy =',f10.3,
& 	' pperp/energy =',f10.3,' value = ',f10.3,' energy no ',i2,
& 	' p/e no ',i2)
101	format(' accb in dbleval negative at energy =',f10.3,
& 	' pperp/energy =',f10.3,' value = ',f10.3,' energy no ',i2,
& 	' p/e no ',i2)
c
c	if no double scattering correction available then neds is
c	set to 0.  return acc=1. in this case
	if (neds.eq.0) goto 22
c     find nearest values of pperp/e
	npuse=npds(1)
	do 1 ip=2,npuse
	if (ppde.lt.peds(ip,1)) goto 2
1	continue
	ip=npuse
c     find energy to use at pperp/e ip-1 and ip
2	jp=ip-1
	do 3 je=2,neds
	if (jp.gt.npds(je)) goto 5
	if (epart.lt.egds(je)) goto 4
3	continue
	je=neds
4	acca=(accds(jp,je-1)*(egds(je)-epart)+accds(jp,je)*(epart-
& 	egds(je-1)))/(egds(je)-egds(je-1))
	if (acca.lt.0.) print 100,epart,ppde,acca,jp,je
	goto 8
5	acca=accds(jp,je-1)
8	do 7 ie=2,neds
	if (ip.gt.npds(ie)) goto 11
	if (epart.lt.egds(ie)) goto 9
7	continue
	ie=neds
9	accb=(accds(ip,ie-1)*(egds(ie)-epart)+accds(ip,ie)*(epart-
& 	egds(ie-1)))/(egds(ie)-egds(ie-1))
	if (accb.lt.0.) print 101,epart,ppde,accb,jp,je
	goto 10
11	accb=accds(ip,ie-1)
10	acc=(acca*(peds(ip,1)-ppde)+accb*(ppde-peds(jp,1)))/(peds(ip,1)-
& 	peds(jp,1))
	return
c
22	acc=1.
	return
c
	end
