! @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ !
! @@                                                                @@ !
! @@       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 Screening__setup
  use ac_misc_module

  implicit none
  integer        :: ia, ib, ic
  real(8) :: R(3)
  real(8)  :: dR
  integer        :: ika, ikb, ikc
  real(8) :: K(3)
  real(8)  :: kk
  real(8) :: pkl_t

  Screening%alpha = 5.d0/sqrt(dot_product(Param%Cell%La,Param%Cell%La))
  allocate( Screening%PhiK(2*(Param%Cell%Na/2+1),Param%Cell%Nb,Param%Cell%Nc) )

  do ic=1, Param%Cell%Nc
     do ib=1, Param%Cell%Nb
        do ia=1, Param%Cell%Na
           if( 2*ia-2 < Param%Cell%Na ) then
              R = Param%Cell%dLa*dble(ia-1)
           else
              R = Param%Cell%dLa*dble(ia-1-Param%Cell%Na)
           endif

           if( 2*ib-2 < Param%Cell%Nb ) then
              R = R + Param%Cell%dLb*dble(ib-1)
           else
              R = R + Param%Cell%dLb*dble(ib-1-Param%Cell%Nb)
           endif

           if( 2*ic-2 < Param%Cell%Nc ) then
              R = R + Param%Cell%dLc*dble(ic-1)
           else
              R = R + Param%Cell%dLc*dble(ic-1-Param%Cell%Nc)
           endif

           dR = sqrt(dot_product(R,R))

           call Screening__PhiRlong(Screening%PhiK(ia,ib,ic),dR)
        end do
     end do
  end do

  call FFT__forward( &
       Param%Cell%Na, Param%Cell%Nb, Param%Cell%Nc, &
       Screening%PhiK, Screening%PhiK )

  do ikc=1, Param%Cell%Nc
     do ikb=1, Param%Cell%Nb
        do ika=1, Param%Cell%Na/2+1
           call Param__Cell__K(K,ika,ikb,ikc)
           kk = dot_product(K,K)

           call Screening__PhiKlong(pkl_t,kk)
           Screening%PhiK(2*ika-1,ikb,ikc) = &
                Screening%PhiK(2*ika-1,ikb,ikc)*Param%Cell%dV - pkl_t

           Screening%PhiK(2*ika-0,ikb,ikc) = 0.d0
        end do
     end do
  end do

  return
end subroutine Screening__setup

subroutine Screening__deallocate
  use ac_misc_module

  implicit none

  if( associated(Screening%PhiK) ) deallocate( Screening%PhiK )

  return
end subroutine Screening__deallocate

subroutine Screening__PhiRlong(Phi,dR)
  use ac_misc_module

  implicit none
  real(8), intent(in) ::dR
  real(8), intent(out) :: Phi
  real(8) :: derf

  if( dabs(dR) < 1.d-14 ) then
     Phi = Screening%alpha*M_2_SQRTPI
  else
     Phi = derf(Screening%alpha*dR)/dR
  endif

  return
end subroutine Screening__PhiRlong

subroutine Screening__PhiKlong(Phi,kk)
  use ac_misc_module

  implicit none
  real(8), intent(in) :: kk
  real(8), intent(out) :: Phi

  if( dabs(kk) < 1.d-14 ) then
     Phi = - M_PI/(Screening%alpha*Screening%alpha)
  else
     Phi = 4*M_PI/kk * exp(-kk/(4*Screening%alpha*Screening%alpha))
  endif

  return
end subroutine Screening__PhiKlong
