dbesks.f
612 Bytes
subroutine dbesks (xnu, x, nin, bk)
c july 1980 edition. w. fullerton, c3, los alamos scientific lab.
double precision xnu, x, bk(1), expxi, xmax, d1mach, dexp, dlog
external d1mach
data xmax / 0.d0 /
c
if (xmax.ne.0.0d0) go to 10
xmax = -dlog(d1mach(1))
xmax = xmax + 0.5d0*dlog(3.14d0*0.5d0/xmax)
c
10 if (x.gt.xmax) call seteru (
1 36hdbesks x so big bessel k underflows, 36, 1, 2)
c
call dbskes (xnu, x, nin, bk)
c
expxi = dexp (-x)
n = iabs (nin)
do 20 i=1,n
bk(i) = expxi * bk(i)
20 continue
c
return
end