! @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ !
! @@                                                                @@ !
! @@       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 Ewald__calc( V, Q, Ro, R1 )
  use ac_parameter

  implicit none
  real(8), intent(in)  :: Q
  real(8), intent(in) :: Ro(3)
  real(8), intent(in) :: R1(3)

  real(8), intent(out) :: V

  integer :: ika, ikb, ikc
  integer :: na, nb, nc
  integer :: Nr, Nk
  real(8) :: K(3)
  real(8) :: kk
  real(8) :: R(3)
  real(8)  :: dR
  real(8)  :: epk_t, eprl_t, eprs_t

  Ewald%alpha = sqrt(0.84d0*M_PI/(sum(Param%Cell%La*Param%Cell%La)))
  Nk = 4
  Nr = 4

  V=0.d0
  do ika=-Nk, Nk
     do ikb=-Nk, +Nk
        do ikc=-Nk, +Nk
           K = Param%Cell%dKa*dble(ika) + Param%Cell%dKb*dble(ikb) + Param%Cell%dKc*dble(ikc)
           kk = dot_product(K,K)

           call Ewald__PhiKlong(epk_t,kk)
           V = V + cos( sum(k*(Ro-R1)) )*epk_t
        end do
     end do
  end do
  V = V * 1.d0/Param%Cell%V

  do  na=-Nr, +Nr
     do nb=-Nr,+Nr
        do nc=-Nr, +Nr
           call Param__Cell__L(R,na,nb,nc)
           R = Ro + R - R1
           dR = sqrt(dot_product(R,R))

           if( na==0 .and.  nb==0 .and. nc==0 ) then
              call Ewald__PhiRlong(eprl_t,dR)
              V = V - eprl_t
           else
              call Ewald__PhiRshort(eprs_t,dR)
              V = V + eprs_t
           end if
        end do
     end do
  end do

  V = V*Q

  return
end subroutine Ewald__calc

subroutine Ewald__calcForce( F, Q, Ro, R1 )
  use ac_parameter

  implicit none
  real(8), intent(in)  :: Q
  real(8), intent(in) :: Ro(3)
  real(8), intent(in) :: R1(3)

  real(8), intent(out) :: F(3)

  integer :: ika, ikb, ikc
  integer :: na, nb, nc
  integer :: Nr, Nk
  real(8) :: K(3)
  real(8) :: kk
  real(8) :: R(3)
  real(8) :: dR
  real(8) :: epk_t, eprl_t, eprs_t

  Ewald%alpha = sqrt(0.84d0*M_PI/(sum(Param%Cell%La*Param%Cell%La)))
  Nk = 4
  Nr = 4

  F = 0.d0
  do ika=-Nk, Nk
     do ikb=-Nk, +Nk
        do ikc=-Nk, +Nk
           K = Param%Cell%dKa*dble(ika) + Param%Cell%dKb*dble(ikb) + Param%Cell%dKc*dble(ikc)
           kk = dot_product(K,K)

           call Ewald__PhiKlong(epk_t,kk)
           F = F - k*sin(k*(Ro-R1))*epk_t
        end do
     end do
  end do
  F = F * 1.d0/Param%Cell%V

  do  na=-Nr, +Nr
     do nb=-Nr,+Nr
        do nc=-Nr, +Nr
           call Param__Cell__L(R,na,nb,nc)
           R = Ro + R - R1
           dR = sqrt(dot_product(R,R))

           if( na==0 .and.  nb==0 .and. nc==0 ) then
              if( dR < 1.d-14 ) then
              else
                 call Ewald__dPhiRlong(eprl_t,dR)
                 F = F - eprl_t/dR*R
              end if
           else
              call Ewald__dPhiRshort(eprs_t,dR)
              F = F + eprs_t/dR*R
           end if
        end do
     end do
  end do

  F = F*Q

  return
end subroutine Ewald__calcForce

subroutine Ewald__PhiKlong(Phi,kk)
  use ac_parameter

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

  real(8), intent(out) :: Phi

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

  return
end subroutine Ewald__PhiKlong

subroutine Ewald__PhiRlong(Phi,dR)
  use ac_parameter

  implicit none
  real(8), intent(in) :: dR

  real(8) :: Phi
  real(8) :: derf 

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

  return
end subroutine Ewald__PhiRlong

subroutine Ewald__dPhiRlong(dPhi,dR)
  use ac_parameter

  implicit none
  real(8), intent(in) :: dR

  real(8) :: dPhi
  real(8) :: derf 

  if( dR < 1.d-14 ) then
     dPhi = 0.d0
  else
     dPhi = M_2_SQRTPI*Ewald%alpha*exp(-(Ewald%alpha*dR)**2 )/dR &
          - derf(Ewald%alpha*dR)/(dR**2)
  end if

  return
end subroutine Ewald__dPhiRlong

subroutine Ewald__PhiRshort(Phi,dR) 
  use ac_parameter

  implicit none
  real(8), intent(in) :: dR

  real(8) :: Phi
  real(8) :: derfc 

  Phi = derfc(Ewald%alpha*dR)/dR

  return
end subroutine Ewald__PhiRshort

subroutine Ewald__dPhiRshort(dPhi,dR) 
  use ac_parameter

  implicit none
  real(8), intent(in) :: dR

  real(8) :: dPhi
  real(8) :: derfc 

  dPhi = - M_2_SQRTPI*Ewald%alpha*exp(-(Ewald%alpha*dR)**2 )/dR &
       - derfc(Ewald%alpha*dR)/(dR**2)
  return
end subroutine Ewald__dPhiRshort
