!
subroutine bessel(rr, b, db)
use Advertisement
implicit none
complex*16, intent(in) :: rr
complex*16, intent(out) :: b, db
complex*16 al, ar, br, fr, fr_, cB(m_min)
real*8 ra, rb
integer*4 pp, mm
mm=m; if (m.eq.0) mm=1
pp=1
al=(2*mm+1)/rr; ar=al; br=(1.d00,0.d00)
fr_=al
do
 al=-al*(1.d00+1.d00/(mm+pp-.5d00))
 ar=al+1.d00/ar
 br=al+1.d00/br; if (pp.eq.1) br=al
 ra=cdabs(ar); rb=cdabs(br)
 if (ra.le.1.d-19) then
  pp=pp+1; al=-al*(1.d00+1.d00/(mm+pp-.5d00))
  br=br*(al+1.d00/br)
  fr_=fr/br
  pp=pp+1; al=-al*(1.d00+1.d00/(mm+pp-.5d00))
  br=al+1.d00/br
  fr=fr_*al/br
 end if
  if (rb.le.1.d-19) then
   pp=pp+1; al=-al*(1.d00+1.d00/(mm+pp-.5d00))
   ar=ar*(al+1.d00/ar)
   fr_=fr*ar
   pp=pp+1; al=-al*(1.d00+1.d00/(mm+pp-.5d00))
   ar=al+1.d00/ar
   fr=fr_*ar/al
 end if
 if (ra.gt.1.d-19.and.rb.gt.1.d-19) fr=fr_*ar/br
 if (cdabs(fr/fr_-1.d00).le.1.d-19) exit
 pp=pp+1; fr_=fr
end do
cB(mm)=fr
do pp=mm, 2, -1
 cB(pp-1)=(2*pp-1)/rr-1.d00/cB(pp)
end do
cB(1)=cdsin(rr)/cB(1)
do pp=2,mm
 cB(pp)=cB(pp-1)/cB(pp)
end do
b=cB(mm)
db=(fr-mm/rr)*b
end subroutine bessel
!
subroutine hankel(rr, hn, dhn)
use Advertisement
implicit none
complex*16, intent(in) :: rr
complex*16, intent(out) :: hn, dhn
complex*16 hn_1, hn_2
integer*4 pp
hn_1=cdexp((0.d00,1.d00)*rr)
hn_2=-(0.d00,1.d00)*hn_1
hn_1=-((0.d00,1.d00)/rr+1.d00)*hn_1
hn=hn_1; dhn=hn_2-hn/rr
do pp=1, m-1
 hn=(2*pp+1)*hn_1/rr-hn_2
 dhn=hn_1-(pp+1)*hn/rr
 hn_2=hn_1; hn_1=hn
end do
end subroutine hankel
!
subroutine nbessel(max, rr, B, dB)
use Advertisement
implicit none
integer*4, intent(in) :: max
complex*16, intent(in) :: rr
complex*16, intent(out) :: B(max), dB(max) !
complex*16 al, ar, br, fr, fr_
real*8 ra, rb
integer*4 pp, mm 
mm=max
pp=1
al=(2*mm+1)/rr; ar=al; br=(1.d00,0.d00)
fr_=al
do
 al=-al*(1.d00+1.d00/(mm+pp-.5d00))
 ar=al+1.d00/ar
 br=al+1.d00/br; if (pp.eq.1) br=al
 ra=cdabs(ar); rb=cdabs(br)
 if (ra.le.1.d-19) then
  pp=pp+1; al=-al*(1.d00+1.d00/(mm+pp-.5d00))
  br=br*(al+1.d00/br)
  fr_=fr/br
  pp=pp+1; al=-al*(1.d00+1.d00/(mm+pp-.5d00))
  br=al+1.d00/br
  fr=fr_*al/br
 end if
  if (rb.le.1.d-19) then
   pp=pp+1; al=-al*(1.d00+1.d00/(mm+pp-.5d00))
   ar=ar*(al+1.d00/ar)
   fr_=fr*ar
   pp=pp+1; al=-al*(1.d00+1.d00/(mm+pp-.5d00))
   ar=al+1.d00/ar
   fr=fr_*ar/al
 end if
 if (ra.gt.1.d-19.and.rb.gt.1.d-19) fr=fr_*ar/br
 if (cdabs(fr/fr_-1.d00).le.1.d-19) exit
 pp=pp+1; fr_=fr
end do
B(mm)=fr
do pp=mm, 2, -1
 B(pp-1)=(2*pp-1)/rr-1.d00/B(pp)
end do
B(1)=cdsin(rr)/B(1)
dB(1)=cdsin(rr)-B(1)/rr
do pp=2,mm
 fr=B(pp-1)/B(pp)
 dB(pp)=(B(pp)-pp/rr)*fr
 B(pp)=fr
end do
end subroutine nbessel
!
subroutine nhankel(max, rr, B, dB)
use Advertisement
implicit none
integer*4, intent(in) :: max
complex*16, intent(in) :: rr
complex*16, intent(out) :: B(max), dB(max)
integer*4 pp
B(3)=cdexp((0.d00,1.d00)*rr)
B(4)=-(0.d00,1.d00)*B(3)
B(1)=-((0.d00,1.d00)/rr+1.d00)*B(3)
B(2)=3.d00*B(1)/rr-B(4)
dB(1)=B(4)-B(1)/rr
dB(2)=B(1)-2.d00*B(2)/rr
do pp=2, max-1
 B(pp+1)=(2*pp+1)*B(pp)/rr-B(pp-1)
 dB(pp+1)=B(pp)-(pp+1)*B(pp+1)/rr
end do
end subroutine nhankel