! @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ !
! @@                                                                @@ !
! @@       PROGRAM  ASCOT 2014.440 (ver.4.53)                       @@ !
! @@     "Abinitio Simulation Code for Quantum Transport"           @@ !
! @@                                                                @@ !
! @@                                                                @@ !
! @@  AUTHOR(S): Naoki WATANABE, Nobutaka NISHIKAWA (Mizuho I.R.)   @@ !
! @@             Hisashi KONDO (Univ. Tokyo)                        @@ !
! @@                                                09/May/2014     @@ !
! @@                                                                @@ !
! @@  Contact address: Phase System Consortium                      @@ !
! @@                                                                @@ !
! @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ !

subroutine SphericalBessel__setup( Nr, Nk, Ecutoff )
  use ac_parameter

  implicit none
  integer, intent(in)       :: Nr, Nk
  real(8), intent(in) :: Ecutoff
  real(8) :: Kcutoff

  SphericalBessel%Nr = Nr
  SphericalBessel%Nk = Nk
  allocate( SphericalBessel%vrx(SphericalBessel%Nr) )
  allocate( SphericalBessel%vrw(SphericalBessel%Nr) )
  allocate( SphericalBessel%vkx(SphericalBessel%Nk) )
  allocate( SphericalBessel%vkw(SphericalBessel%Nk) )

  Kcutoff = sqrt(2*Ecutoff)

  if( Param%Option%mx ) then
     call GaussLegendre__getPointsMX( SphericalBessel%Nk, 0.d0, Kcutoff, SphericalBessel%vkx, SphericalBessel%vkw ) 

     call GaussLegendre__getPointsMX( SphericalBessel%Nr, 0.d0, 1.d0, SphericalBessel%vrx, SphericalBessel%vrw )
  else
     call GaussLegendre__getPoints( SphericalBessel%Nk, 0.d0, Kcutoff, SphericalBessel%vkx, SphericalBessel%vkw ) 

     call GaussLegendre__getPoints( SphericalBessel%Nr, 0.d0, 1.d0, SphericalBessel%vrx, SphericalBessel%vrw )
  end if

  return
end subroutine SphericalBessel__setup

subroutine SphericalBessel__transpose( vK, fR, l )
  use ac_parameter

  implicit none
  real(8), intent(out) :: vK(SphericalBessel%Nk)
  type(Spline_type), intent(in)   :: fR
  integer, intent(in)        :: l

  integer :: ik, i
  real(8) :: k, r, w, sumk
  real(8) :: f

  real(8) SphericalBessel__J

  do ik=1, SphericalBessel%Nk
     k = SphericalBessel%vkx(ik)

     sumk=0.d0
     do i=1, SphericalBessel%Nr
        r = fR%vx(fR%N) * SphericalBessel%vrx(i)
        w = fR%vx(fR%N) * SphericalBessel%vrw(i)

        call Spline__evaluate(fR, r, f)
        sumk = sumk + w*r*r* f * SphericalBessel__J(l,k*r)
     end do
     vK(ik) = sumk*M_2_SQRTPI*M_SQRT1_2     
  end do

  return
end subroutine SphericalBessel__transpose

subroutine SphericalBessel__transposetail( vK, fR, Q )
  use ac_parameter

  implicit none
  real(8), intent(out) :: vK(SphericalBessel%Nk)
  type(Spline_type), intent(in)   :: fR
  real(8), intent(in)  :: Q

  integer       :: ik
  real(8) :: k, rs, re, sum

  do ik=1, SphericalBessel%Nk
     k  = SphericalBessel%vkx(ik)
     rs = fR%vx(fR%N)
     re = fR%vx(fR%N)*3

     if( k<1.d-14 ) then
        sum = 0.5*(re*re-rs*rs)
     else
        sum = (cos(k*rs)-cos(k*re))/(k*k)
     endif
     vK(ik) = vK(ik) + sum*Q*M_2_SQRTPI*M_SQRT1_2
  end do

  return
end subroutine SphericalBessel__transposetail

function SphericalBessel__J( l, x ) result(J)
  implicit none
  integer, intent(in) :: l
  real(8), intent(in) :: x
  real(8) :: J

  real(8) :: ix1, ix2

  select case(l)
  case(0)
     if( x<1.0e-2 ) then
        J = 1.0 - 1.0/6.0*x*x
     else
        J = sin(x)/x
     endif

  case(1)
     if( x<1.0e-6 ) then
        J = 1.0/3.0*x - 1.0/30.0*(x**3)
     else
        ix1 = 1.0/x
        J = (sin(x)*ix1-cos(x))*ix1
     endif

  case(2)
     if( x<4.0e-3 ) then
        J = 1.0/15.0*(x**2) - 1.0/210.0*(x**4)
     else
        ix1 = 1.0/x
        ix2 = ix1*ix1
        J = + (sin(x)*ix1)*(3.0*ix2-1.0) - (cos(x)*ix2)*3.0
     endif

  case(3)
     if( x<2.0e-2 ) then
        J = 1.0/105.0*(x**3) - 1.0/1890.0*(x**5)
     else
        ix1 = 1.0/x
        ix2 = ix1*ix1
        J = + (sin(x)*ix2)*(15.0*ix2-6.0) &
             - (cos(x)*ix1)*(15.0*ix2-1.0)
     endif

  case(4)
     if( x<6.0e-2 ) then
        J = 1.0/945.0*(x**4) - 1.0/20790.0*(x**6)
     else
        ix1 = 1.0/x
        ix2 = ix1*ix1
        J = + (sin(x)*ix1)*((105.0*ix2-45.0)*ix2+1.0) &
             - (cos(x)*ix2)*(105.0*ix2-10.0)
     endif

  case(5)
     if( x<1.0e-1 ) then
        J = 1.0/(10395.0)*(x**5) - 1.0/270270.0*(x**7)
     else
        ix1 = 1.0/x
        ix2 = ix1*ix1
        J = + (sin(x)*ix2)*((945.0*ix2-420.0)*ix2+15.0) &
             - (cos(x)*ix1)*((945.0*ix2-105.0)*ix2+1.0)
     endif

  case(6)
     if( x<5.0e-1 ) then
        J = 1.0/(135135.0)*(x**6) - 1.0/4054050.0*(x**8)
     else
        ix1 = 1.0/x
        ix2 = ix1*ix1
        J = + (sin(x)*ix1)*(((945.0*11.0*ix2-4725.0)*ix2+210.0)*ix2-1.0) &
             - (cos(x)*ix2)*((945.0*11.0*ix2-1260.0)*ix2+21.0)
     endif

  case default
     J = 0.d0
     write(*,'(a70)') '# Sorry : spherical Bessel function for l>6 is not implemented'
     stop
  end select

  return
end function SphericalBessel__J

function SphericalBessel__Jxl( l, x ) result(Jxl)
  implicit none
  integer, intent(in) :: l
  real(8), intent(in) :: x
  real(8) :: Jxl

  real(8) :: ix1, ix2

  select case(l)
  case(0)
     if( x<1.0e-2 ) then
        Jxl = 1.0 - 1.0/6.0*(x**2)
     else
        Jxl = sin(x)/x
     endif

  case(1)
     if( x<1.0e-6 ) then
        Jxl = 1.0/3.0 - 1.0/30.0*(x**2)
     else
        ix1 = 1.0/x
        ix2 = ix1*ix1
        Jxl = (sin(x)*ix1-cos(x))*ix2
     endif

  case(2)
     if( x<4.0e-3 ) then
        Jxl = 1.0/15.0 - 1.0/210.0*(x**2)
     else
        ix1 = 1.0/x
        ix2 = ix1*ix1
        Jxl = ((sin(x)*ix1)*(3.0*ix2-1.0) &
             - (cos(x)*ix2)*3.0)*ix2
     endif

  case(3)
     if( x<2.0e-2 ) then
        Jxl = 1.0/105.0 - 1.0/1890.0*(x**2)
     else
        ix1 = 1.0/x
        ix2 = ix1*ix1
        Jxl = ((sin(x)*ix1)*(15.0*ix2-6.0) &
             - (cos(x))*(15.0*ix2-1.0))*ix2*ix2
     endif

  case(4)
     if( x<6.0e-2 ) then
        Jxl = 1.0/945.0 - 1.0/20790.0*(x**2)
     else
        ix1 = 1.0/x
        ix2 = ix1*ix1
        Jxl = ((sin(x)*ix1)*((105.0*ix2-45.0)*ix2+1.0) &
             - (cos(x)*ix2)*(105.0*ix2-10.0))*ix2*ix2
     endif

  case(5)
     if( x<1.0e-1 ) then
        Jxl = 1.0/(10395.0) - 1.0/270270.0*(x**2)
     else
        ix1 = 1.0/x
        ix2 = ix1*ix1
        Jxl = ((sin(x)*ix1)*((945.0*ix2-420.0)*ix2+15.0) &
             - (cos(x))*((945.0*ix2-105.0)*ix2+1.0))*ix2*ix2*ix2
     endif

  case(6)
     if( x<5.0e-1 ) then
        Jxl = 1.0/(135135.0) - 1.0/4054050.0*(x**2)
     else
        ix1 = 1.0/x
        ix2 = ix1*ix1
        Jxl = ((sin(x)*ix1)*(((945.0*11.0*ix2-4725.0)*ix2+210.0)*ix2-1.0) &
             - (cos(x)*ix2)*((945.0*11.0*ix2-1260.0)*ix2+21.0))*ix2*ix2*ix2
     endif

  case default
     Jxl = 0.d0
     write(*,'(a70)') '# Sorry : spherical Bessel function for l>6 is not implemented'
     stop
  end select

  return
end function SphericalBessel__Jxl

function SphericalBessel__Jx2( l, x ) result(Jx2)
  implicit none
  integer, intent(in)       :: l
  real(8), intent(in) :: x
  real(8) :: Jx2

  real(8) :: ix1, ix2


  select case(l)
  case(0)
     Jx2 = sin(x)*x

  case(1)
     Jx2 = sin(x) - cos(x)*x

  case(2)
     if( x<4.0e-3 ) then
        Jx2 = 1.0/15.0*(x**4) - 1.0/210.0*(x**6)
     else
        ix1 = 1.0/x
        ix2 = ix1*ix1
        Jx2 = (sin(x)*x)*(3.0*ix2-1.0) - (cos(x))*3.0
     endif

  case(3)
     if( x<2.0e-2 ) then
        Jx2 = 1.0/105.0*(x**5) - 1.0/1890.0*(x**7)
     else
        ix1 = 1.0/x
        ix2 = ix1*ix1
        Jx2 = (sin(x))*(15.0*ix2-6.0) - (cos(x)*x)*(15.0*ix2-1.0)
     endif

  case(4)
     if( x<6.0e-2 ) then
        Jx2 = 1.0/945.0*(x**6) - 1.0/20790.0*(x**8)
     else
        ix1 = 1.0/x
        ix2 = ix1*ix1
        Jx2 = (sin(x)*x)*((105.0*ix2-45.0)*ix2+1.0) &
             - (cos(x))*(105.0*ix2-10.0)
     endif

  case(5)
     if( x<1.0e-1 ) then
        Jx2 = 1.0/(10395.0)*(x**7) - 1.0/270270.0*(x**9)
     else
        ix1 = 1.0/x
        ix2 = ix1*ix1
        Jx2 = (sin(x))*((945.0*ix2-420.0)*ix2+15.0) &
             - (cos(x)*x)*((945.0*ix2-105.0)*ix2+1.0)
     endif

  case(6)
     if( x<5.0e-1 ) then
        Jx2 = 1.0/(135135.0)*(x**8) - 1.0/4054050.0*(x**10)
     else
        ix1 = 1.0/x
        ix2 = ix1*ix1
        Jx2 = + (sin(x)*x)*(((945.0*11.0*ix2-4725.0)*ix2+210.0)*ix2-1.0) &
             - (cos(x))*((945.0*11.0*ix2-1260.0)*ix2+21.0)
     endif

  case default
     Jx2 = 0.d0
     write(*,'(a70)') '# Sorry : spherical Bessel function for l>6 is not implemented'
     stop
  end select

  return
end function SphericalBessel__Jx2

function SphericalBessel__dJx2( l, x ) result(dJx2)
  implicit none
  integer, intent(in)       :: l
  real(8), intent(in) :: x
  real(8) :: dJx2

  real(8) :: ix1, ix2

  select case(l)
  case(0)
     dJx2 = sin(x) + cos(x)*x

  case(1)
     dJx2 = sin(x)*x

  case(2)
     if( x<4.0e-3 ) then
        dJx2 = 4.0/15.0*(x**3) - 6.0/210.0*(x**5)
     else
        ix1 = 1.0/x
        ix2 = ix1*ix1
        dJx2 = sin(x)*(-3.0*ix2+2.0) + cos(x)*(3.0*ix1-x)
     endif

  case(3)
     if( x<2.0e-2 ) then
        dJx2 = 1.0/21.0*(x**4) - 7.0/1890.0*(x**6)
     else
        ix1 = 1.0/x
        ix2 = ix1*ix1
        dJx2 = sin(x)*((-30.0*ix2+15.0)*ix1-x) + cos(x)*(30.0*ix2-5.0)
     endif

  case(4)
     if( x<6.0e-2 ) then
        dJx2 = 6.0/945.0*(x**5) - 8.0/20790.0*(x**7)
     else
        ix1 = 1.0/x
        ix2 = ix1*ix1
        dJx2 = sin(x)*((-315.0*ix2+150.0)*ix2-9.0)  &
             + cos(x)*((315.0*ix2-45.0)*ix1+x)
     endif

  case(5)
     if( x<1.0e-1 ) then
        dJx2 = 7.0/10395.0*(x**6) - 9.0/270270.0*(x**8)
     else
        ix1 = 1.0/x
        ix2 = ix1*ix1
        dJx2 = sin(x)*(((-3780.0*ix2+1785.0)*ix2-105.0)*ix1+x) &
             + cos(x)*((945.0*4.0*ix2-525.0)*ix2+14.0)
     endif

  case(6)
     if( x<5.0e-1 ) then
        dJx2 = 8.0/135135.0*(x**7) - 10.0/4054050.0*(x**9)
     else
        ix1 = 1.0/x
        ix2 = ix1*ix1
        dJx2 = sin(x)*(((-51975.0*ix2+24570.0)*ix2-1470.0)*ix2+20.0) &
             + cos(x)*((( 51975.0*ix2-7245.0)*ix2+210.0)*ix1-x)
     endif


  case default
     dJx2 = 0.d0
     write(*,'(a70)') '# Sorry : spherical Bessel function for l>6 is not implemented'
     stop
  end select

  return
end function SphericalBessel__dJx2

function SphericalBessel__dJxlx( l, x ) result(dJxlx)
  implicit none
  integer, intent(in)       :: l
  real(8), intent(in) :: x
  real(8) :: dJxlx
  real(8) :: ix1, ix2

  select case(l)
  case(0)
     if( x<1.0e-2 ) then
        dJxlx = - 2.0/6.0
     else
        ix1 = 1.0/x
        ix2 = ix1*ix1
        dJxlx = (cos(x)-(sin(x)*ix1))*ix2
     endif

  case(1)
     if( x<1.0e-6 ) then
        dJxlx = - 2.0/30.0
     else
        ix1 = 1.0/x
        ix2 = ix1*ix1
        dJxlx = ((1-3*ix2)*(sin(x)*ix1) + 3*(cos(x)*ix2) )*ix2
     endif

  case(2)
     if( x<4.0e-3 ) then
        dJxlx = - 2.0/210.0
     else
        ix1 = 1.0/x
        ix2 = ix1*ix1
        dJxlx = ((6-15*ix2)*(sin(x)*ix1) &
             + (15*ix2-1)*cos(x))*ix2*ix2
     endif

  case(3)
     if( x<2.0e-2 ) then
        dJxlx = - 2.0/1890.0
     else
        ix1 = 1.0/x
        ix2 = ix1*ix1
        dJxlx = ( - (1-45*ix2+105*ix2*ix2)*(sin(x)*ix1) &
             - (10*ix2-105)*(cos(x)*ix2) )*ix2*ix2
     endif

  case(4)
     if( x<6.0e-2 ) then
        dJxlx = - 2.0/20790.0
     else
        ix1 = 1.0/x
        ix2 = ix1*ix1
        dJxlx = -((15-420*ix2+945*ix2*ix2)*(sin(x)*ix1) &
             + (-1+105*ix2-945*ix2*ix2)*cos(x))*ix2*ix2*ix2
     endif

  case(5)
     if( x<1.0e-1 ) then
        dJxlx = - 2.0/270270.0
     else
        ix1 = 1.0/x
        ix2 = ix1*ix1
        dJxlx = ((1-210*ix2+4725*ix2*ix2-10395*ix2*ix2*ix2)*(sin(x)*ix1) &
             + (21-1260*ix2+10395*ix2*ix2)*(cos(x)*ix2))*ix2*ix2*ix2
     endif

  case(6)
     if( x<5.0e-1 ) then
        dJxlx = - 2.0/4054050.0
     else
        ix1 = 1.0/x
        ix2 = ix1*ix1
        dJxlx = ((28-3150*ix2+62370*ix2*ix2-135135*ix2*ix2*ix2)*(sin(x)*ix1) &
             + (-1+378*ix2-17325*ix2*ix2+135135*ix2*ix2*ix2)*cos(x))*ix2*ix2*ix2*ix2
     endif

  case default
     dJxlx = 0.d0
     write(*,'(a70)') '# Sorry : spherical Bessel function for l>6 is not implemented'
     stop
  end select

  return

end function SphericalBessel__dJxlx

subroutine SphericalBessel__integrateS( sumS, Ra, Rb, l, r ) 
  use ac_parameter

  implicit none
  real(8), intent(in) :: Ra(SphericalBessel%Nk)
  real(8), intent(in) :: Rb(SphericalBessel%Nk)
  integer, intent(in) :: l
  real(8), intent(in) :: r

  real(8) :: sumS
  integer :: ik
  real(8) :: k, w

  real(8) SphericalBessel__Jxl
  real(8) SphericalBessel__Jx2

  sumS=0.d0

  if( r < 1.d-14 ) then
     do ik=1, SphericalBessel%Nk
        k = SphericalBessel%vkx(ik)
        w = SphericalBessel%vkw(ik)

        sumS = sumS + w*(k**(l+2)) * Ra(ik)*Rb(ik)
     end do

     sumS = sumS*4*M_PI*SphericalBessel__Jxl(l,0.d0)
     return
  end if

  do ik=1, SphericalBessel%Nk
     k = SphericalBessel%vkx(ik)
     w = SphericalBessel%vkw(ik)

     sumS = sumS + w*SphericalBessel__Jx2(l,k*r) * Ra(ik)*Rb(ik)
  end do

  sumS = sumS*4*M_PI/r**(l+2)

  return
end subroutine SphericalBessel__integrateS

subroutine SphericalBessel__integrateK( sumK, Ra, Rb, l, r )
  use ac_parameter

  implicit none
  real(8), intent(in) :: Ra(SphericalBessel%Nk)
  real(8), intent(in) :: Rb(SphericalBessel%Nk)
  integer, intent(in) :: l
  real(8), intent(in) :: r

  real(8) :: sumK
  integer :: ik
  real(8) :: k, w

  real(8) SphericalBessel__Jxl
  real(8) SphericalBessel__Jx2

  sumK=0.d0

  if( r < 1.d-14 ) then
     do ik=1, SphericalBessel%Nk
        k = SphericalBessel%vkx(ik)
        w = SphericalBessel%vkw(ik)

        sumK = sumK + w*(k**(l+4)) * Ra(ik)*Rb(ik)
     end do

     sumK = sumK*2*M_PI*SphericalBessel__Jxl(l,0.d0)
     return
  end if

  do ik=1, SphericalBessel%Nk
     k = SphericalBessel%vkx(ik)
     w = SphericalBessel%vkw(ik)

     sumK = sumK + w*k*k*SphericalBessel__Jx2(l,k*r) * Ra(ik)*Rb(ik)
  end do

  sumK = sumK*2*M_PI/r**(l+2)

  return
end subroutine SphericalBessel__integrateK

subroutine SphericalBessel__integratedS( sumdS, Ra, Rb, l, r )
  use ac_parameter

  implicit none
  real(8), intent(in) :: Ra(SphericalBessel%Nk)
  real(8), intent(in) :: Rb(SphericalBessel%Nk)
  integer, intent(in) :: l
  real(8), intent(in) :: r

  real(8) :: sumdS
  integer       :: ik
  real(8) :: k, w

  real(8) SphericalBessel__dJxlx
  real(8) SphericalBessel__Jx2
  real(8) SphericalBessel__dJx2

  sumdS=0.d0

  if( r < 1.d-14 ) then
     do ik=1, SphericalBessel%Nk
        k = SphericalBessel%vkx(ik)
        w = SphericalBessel%vkw(ik)

        sumdS = sumdS + w*(k**(l+2)) * k**2 * Ra(ik)*Rb(ik)
     end do

     sumdS = sumdS*4*M_PI*SphericalBessel__dJxlx(l,0.d0)
     return
  end if

  do ik=1, SphericalBessel%Nk
     k = SphericalBessel%vkx(ik)
     w = SphericalBessel%vkw(ik)

     sumdS = sumdS - w*Ra(ik)*Rb(ik)*(l+2)*SphericalBessel__Jx2 (l,k*r)
     sumdS = sumdS + w*Ra(ik)*Rb(ik)*(k*r)*SphericalBessel__dJx2(l,k*r)
  end do

  sumdS = sumdS*4*M_PI/r**(l+4)

  return 
end subroutine SphericalBessel__integratedS

subroutine SphericalBessel__integratedK( sumdK, Ra, Rb, l, r )
  use ac_parameter

  implicit none
  real(8), intent(in) :: Ra(SphericalBessel%Nk)
  real(8), intent(in) :: Rb(SphericalBessel%Nk)
  integer, intent(in) :: l
  real(8), intent(in) :: r

  real(8) :: sumdK
  integer :: ik
  real(8) :: k, w

  real(8) SphericalBessel__dJxlx
  real(8) SphericalBessel__Jx2
  real(8) SphericalBessel__dJx2

  sumdK=0.d0

  if( r < 1.d-14 ) then
     do ik=1, SphericalBessel%Nk
        k = SphericalBessel%vkx(ik)
        w = SphericalBessel%vkw(ik)

        sumdK = sumdK + w*(k**(l+4)) * k**2 * Ra(ik)*Rb(ik)
     end do

     sumdK = sumdK*2*M_PI*SphericalBessel__dJxlx(l,0.d0)
     return
  end if

  do ik=1, SphericalBessel%Nk
     k = SphericalBessel%vkx(ik)
     w = SphericalBessel%vkw(ik)

     sumdK = sumdK - w*k*k*Ra(ik)*Rb(ik)* (l+2)*SphericalBessel__Jx2 (l,k*r)
     sumdK = sumdK + w*k*k*Ra(ik)*Rb(ik)*(k*r)*SphericalBessel__dJx2(l,k*r)
  end do

  sumdK = sumdK*2*M_PI/r**(l+4)

  return
end subroutine SphericalBessel__integratedK

subroutine SphericalBessel__integrateSK( sumS, sumK, Ra, Rb, l, r )
  use ac_parameter

  implicit none
  real(8) :: sumS, sumK
  real(8), intent(in) :: Ra(SphericalBessel%Nk)
  real(8), intent(in) :: Rb(SphericalBessel%Nk)
  integer, intent(in) :: l
  real(8), intent(in) :: r

  integer :: ik
  real(8) :: k, w, f

  real(8) SphericalBessel__Jxl
  real(8) SphericalBessel__Jx2

  sumS=0.d0
  sumK=0.d0

  if( r < 1.d-14 ) then
     do ik=1, SphericalBessel%Nk
        k = SphericalBessel%vkx(ik)
        w = SphericalBessel%vkw(ik)
        f = w*(k**(l+2)) * Ra(ik)*Rb(ik)

        sumS = sumS + f
        sumK = sumK + f*k*k
     end do

     sumS = sumS*4*M_PI*SphericalBessel__Jxl(l,0.d0)
     sumK = sumK*2*M_PI*SphericalBessel__Jxl(l,0.d0)

     return
  end if

  do ik=1, SphericalBessel%Nk
     k = SphericalBessel%vkx(ik)
     w = SphericalBessel%vkw(ik)
     f = w*SphericalBessel__Jx2(l,k*r) * Ra(ik)*Rb(ik)
     sumS = sumS + f
     sumK = sumK + f*k*k
  end do

  sumS = sumS*4*M_PI/r**(l+2)
  sumK = sumK*2*M_PI/r**(l+2)

  return
end subroutine SphericalBessel__integrateSK

subroutine SphericalBessel__integratedSK( sumdS, sumdK, Ra, Rb, l, r )
  use ac_parameter

  implicit none
  real(8) :: sumdS, sumdK
  real(8), intent(in) :: Ra(SphericalBessel%Nk)
  real(8), intent(in) :: Rb(SphericalBessel%Nk)
  integer, intent(in) :: l
  real(8), intent(in) :: r

  integer :: ik
  real(8) :: k, w, f, df

  real(8) SphericalBessel__dJxlx
  real(8) SphericalBessel__Jx2
  real(8) SphericalBessel__dJx2

  sumdS = 0.d0
  sumdK = 0.d0

  if( r < 1.d-14 ) then
     do ik=1, SphericalBessel%Nk
        k = SphericalBessel%vkx(ik)
        w = SphericalBessel%vkw(ik)

        sumdS = sumdS + w*(k**(l+2)) * k**2 * Ra(ik)*Rb(ik)
        sumdK = sumdK + w*(k**(l+4)) * k**2 * Ra(ik)*Rb(ik)
     end do

     sumdS = sumdS*4*M_PI*SphericalBessel__dJxlx(l,0.d0)
     sumdK = sumdK*2*M_PI*SphericalBessel__dJxlx(l,0.d0)
     return
  end if

  do ik=1, SphericalBessel%Nk
     k = SphericalBessel%vkx(ik)
     w = SphericalBessel%vkw(ik)

     f  = w*SphericalBessel__Jx2 (l,k*r) * Ra(ik)*Rb(ik)
     df = w*SphericalBessel__dJx2(l,k*r) * Ra(ik)*Rb(ik)
     sumdS = sumdS + (df*(k*r) - f*(l+2))
     sumdK = sumdK + (df*(k*r) - f*(l+2))* k*k
  end do

  sumdS = sumdS*4*M_PI/r**(l+4)
  sumdK = sumdK*2*M_PI/r**(l+4)

end subroutine SphericalBessel__integratedSK

subroutine SphericalBessel__deallocate
  use ac_parameter

  implicit none
  if(associated(SphericalBessel%vrx)) deallocate( SphericalBessel%vrx )
  if(associated(SphericalBessel%vrw)) deallocate( SphericalBessel%vrw )
  if(associated(SphericalBessel%vkx)) deallocate( SphericalBessel%vkx )
  if(associated(SphericalBessel%vkw)) deallocate( SphericalBessel%vkw )

  return
end subroutine SphericalBessel__deallocate
