! @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ !
! @@                                                                @@ !
! @@       PROGRAM  ASCOT 2014.440 (ver.4.40)                       @@ !
! @@     "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_misc_module

  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_misc_module

  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, sum

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

     sum=0.d0
     do i=1, SphericalBessel%Nr
        r = Spline__xback(fR) * SphericalBessel%vrx(i)
        w = Spline__xback(fR) * SphericalBessel%vrw(i)

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

  return
end subroutine SphericalBessel__transpose

subroutine SphericalBessel__transposetail( vK, fR, Q )
  use ac_misc_module

  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 = Spline__xback(fR)
     re = Spline__xback(fR)*3

     if( dabs(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

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

  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

  sumS=0.d0
  sumK=0.d0

  if( dabs(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_misc_module

  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

  sumdS = 0.d0
  sumdK = 0.d0

  if( dabs(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_misc_module

  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
