besks.f 555 Bytes
subroutine besks (xnu, x, nin, bk)
c july 1980 edition.   w. fullerton, c3, los alamos scientific lab.
      dimension bk(1)
      external  r1mach
      data xmax / 0.0 /
c
      if (xmax.ne.0.0) go to 10
      xmax = -alog (r1mach(1))
      xmax = xmax + 0.5*alog(3.14*0.5/xmax)
c
 10   if (x.gt.xmax) call seteru (
     1  36hbesks   x so big bessel k underflows, 36, 1, 2)
c
      call beskes (xnu, x, nin, bk)
c
      expxi = exp (-x)
      n = iabs (nin)
      do 20 i=1,n
        bk(i) = expxi * bk(i)
 20   continue
c
      return
      end