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

  implicit none
  type(Element_type), pointer :: elem
  type(PPloc_type) :: Vpsloc
  type(PPloc_type) :: Vpsval
  integer     :: a

  if( Param%Option%cluster ) then
     call Screening__setup
  endif

  if( Param%Option%projection ) then
     return
  end if

  do a=1, Param%Data%natom
     elem => Param__Data__getElement( Param%Data%vatom(a)%name )

     if( Param%Option%na .and. (.not. Param%Option%nohar) ) then
        call PPloc__set( Vpsloc, Param%Data%vatom(a)%Ro, elem%Vloc )
        call PPloc__set( Vpsval, Param%Data%vatom(a)%Ro, elem%Vval )
        call Potential__addExt2( Potential%Vext, Vpsloc, Vpsval )
     else
        call PPloc__set( Vpsloc, Param%Data%vatom(a)%Ro, elem%Vloc )
        call Potential__addExt1( Potential%Vext, Vpsloc )
     end if
  end do

  return
end subroutine Potential__setExtLocal

subroutine Potential__addExt1( Vext, Vpsloc )
  use ac_misc_module
  implicit none
  real(8), intent(inout)  :: Vext(Param%Cell%Na,Param%Cell%Nb,Param%Cell%Nc)
  type(PPloc_type), intent(in) :: Vpsloc

  integer        :: ia, ib, ic
  integer        :: ia0, ib0, ic0
  real(8) :: R(3)
  integer        :: range(6)
  real(8)        :: ppw_t, ec_t

  if( Param%Option%projection ) then
     return
  end if

  call Param__Cell__getRange( range, Vpsloc%Ro, Vpsloc%Rc )

  do ic = range(5), range(6)
     ic0 = modp(ic,Param%Cell%Nc)
     do ib = range(3), range(4)
        ib0 = modp(ib,Param%Cell%Nb)
        do ia = range(1), range(2)
           ia0 = modp(ia,Param%Cell%Na)

           call Param__Cell__R(R,ia,ib,ic)

           if( 0<ic .and. ic<=Param%Cell%Nc .and. &
                0<ib .and. ib<=Param%Cell%Nb .and.&
                0<ia .and. ia<=Param%Cell%Na ) then
              call PPloc__W( ppw_t, Vpsloc, R )
              Vext(ia0,ib0,ic0) = Vext(ia0,ib0,ic0) + ppw_t
           else 
              call PPloc__Wdiff( ppw_t, Vpsloc, R )
              Vext(ia0,ib0,ic0) = Vext(ia0,ib0,ic0) + ppw_t
           end if
        end do
     end do
  end do

  do ic=1, Param%Cell%Nc
     do ib=1, Param%Cell%Nb
        do ia=1, Param%Cell%Na
           if(  range(5)<=ic .and. ic<=range(6) .and. &
                range(3)<=ib .and. ib<=range(4) .and. &
                range(1)<=ia .and. ia<=range(2) ) then
           else
              call Param__Cell__R(R,ia,ib,ic)
              call PPloc__W( ppw_t, Vpsloc, R )
              Vext(ia,ib,ic) = Vext(ia,ib,ic) + ppw_t
           end if
        end do
     end do
  end do

  if( .not. Param%Option%cluster ) then
     do ic=1, Param%Cell%Nc
        do ib=1, Param%Cell%Nb
           do ia=1, Param%Cell%Na
              call Param__Cell__R(R,ia,ib,ic)
              call Ewald__calc( ec_t, Vpsloc%Q, Vpsloc%Ro, R )
              Vext(ia,ib,ic) = Vext(ia,ib,ic) + ec_t
           end do
        end do
     end do
  end if

  return
end subroutine Potential__addExt1

subroutine Potential__addExt2( Vext, Vpsloc, Vpsval )
  use ac_misc_module
  implicit none
  real(8), intent(inout)  :: Vext(Param%Cell%Na,Param%Cell%Nb,Param%Cell%Nc)
  type(PPloc_type), intent(in) :: Vpsloc
  type(PPloc_type), intent(in) :: Vpsval

  integer        :: ia, ib, ic
  integer        :: ia0, ib0, ic0
  real(8) :: R(3)
  integer        :: range(6)
  real(8)        :: ppw_t1,ppw_t2


  if( Param%Option%projection ) then
     return
  end if

  call Param__Cell__getRange( range, Vpsval%Ro, Vpsval%Rc )

  do ic = range(5), range(6)
     ic0 = modp(ic,Param%Cell%Nc)
     do ib = range(3), range(4)
        ib0 = modp(ib,Param%Cell%Nb)
        do ia = range(1), range(2)
           ia0 = modp(ia,Param%Cell%Na)

           call Param__Cell__R(R,ia,ib,ic)
           call PPloc__W( ppw_t1, Vpsloc, R )
           call PPloc__W( ppw_t2, Vpsval, R )

           Vext(ia0,ib0,ic0) = Vext(ia0,ib0,ic0) + ppw_t1 + ppw_t2
        end do
     end do
  end do

  return
end subroutine Potential__addExt2

subroutine Potential__setGradient1( gVext, Vpsloc )
  use ac_misc_module

  implicit none
  real(8), intent(inout)  :: gVext(3,Param%Cell%Na,Param%Cell%Nb,Param%Cell%Nc)
  type(PPloc_type), intent(in) :: Vpsloc

  integer        :: ia, ib, ic
  integer        :: ia0, ib0, ic0
  real(8) :: R(3)
  integer        :: range(6)
  real(8) :: ppw_t(3), ec_t(3)

  if( Param%Option%projection ) then
     return
  end if

  call Param__Cell__getRange( range, Vpsloc%Ro, Vpsloc%Rc )

  do ic = range(5), range(6)
     ic0 = modp(ic,Param%Cell%Nc)
     do ib = range(3), range(4)
        ib0 = modp(ib,Param%Cell%Nb)
        do ia = range(1), range(2)
           ia0 = modp(ia,Param%Cell%Na)

           call Param__Cell__R(R,ia,ib,ic)

           if( 0<ic .and. ic<=Param%Cell%Nc .and. &
                0<ib .and. ib<=Param%Cell%Nb .and.&
                0<ia .and. ia<=Param%Cell%Na ) then
              call PPloc__gW( ppw_t, Vpsloc, R )
              gVext(:,ia0,ib0,ic0) = gVext(:,ia0,ib0,ic0) + ppw_t
           else 
              call PPloc__gWdiff( ppw_t, Vpsloc, R )
              gVext(:,ia0,ib0,ic0) = gVext(:,ia0,ib0,ic0) + ppw_t
           end if
        end do
     end do
  end do

  do ic=1, Param%Cell%Nc
     do ib=1, Param%Cell%Nb
        do ia=1, Param%Cell%Na
           if(  range(5)<=ic .and. ic<=range(6) .and. &
                range(3)<=ib .and. ib<=range(4) .and. &
                range(1)<=ia .and. ia<=range(2) ) then
           else
              call Param__Cell__R(R,ia,ib,ic)
              call PPloc__gW( ppw_t, Vpsloc, R )
              gVext(:,ia,ib,ic) = gVext(:,ia,ib,ic) + ppw_t
           end if
        end do
     end do
  end do


  if( .not. Param%Option%cluster ) then
     do ic=1, Param%Cell%Nc
        do ib=1, Param%Cell%Nb
           do ia=1, Param%Cell%Na
              call Param__Cell__R(R,ia,ib,ic)
              call Ewald__calcForce( ec_t, Vpsloc%Q, Vpsloc%Ro, R )
              gVext(:,ia,ib,ic) = gVext(:,ia,ib,ic) - ec_t
           end do
        end do
     end do
  end if

  return
end subroutine Potential__setGradient1

subroutine Potential__setGradient2( gVext, Vpsloc, Vpsval )
  use ac_misc_module

  implicit none
  real(8), intent(inout)  :: gVext(3,Param%Cell%Na,Param%Cell%Nb,Param%Cell%Nc)
  type(PPloc_type), intent(in) :: Vpsloc
  type(PPloc_type), intent(in) :: Vpsval

  integer        :: ia, ib, ic
  integer        :: ia0, ib0, ic0
  real(8) :: R(3)
  integer        :: range(6)
  real(8) :: ppw_t1(3),ppw_t2(3)

  if( Param%Option%projection ) then
     return
  end if

  call Param__Cell__getRange( range, Vpsval%Ro, Vpsval%Rc )

  do ic = range(5), range(6)
     ic0 = modp(ic,Param%Cell%Nc)
     do ib = range(3), range(4)
        ib0 = modp(ib,Param%Cell%Nb)
        do ia = range(1), range(2)
           ia0 = modp(ia,Param%Cell%Na)

           call Param__Cell__R(R,ia,ib,ic)
           call PPloc__gW( ppw_t1, Vpsloc, R )
           call PPloc__gW( ppw_t2, Vpsval, R )

           gVext(:,ia0,ib0,ic0) = gVext(:,ia0,ib0,ic0) + ppw_t1 + ppw_t2
        end do
     end do
  end do

  return
end subroutine Potential__setGradient2

subroutine Potential__setExtNonLocal
  use ac_misc_module

  implicit none
  type(Element_type), pointer :: elem
  integer :: a, n, i, l, m, naVpsnon

  allocate( Potential%vnVpsnon(Param%Data%natom) )
  allocate( Potential%viVpsnon(Param%Data%natom) )

  Potential%nVpsnon=0
  do a=1, Param%Data%natom
     elem => Param__Data__getElement( Param%Data%vatom(a)%name )

     Potential%viVpsnon(a) = Potential%nVpsnon+1
     Potential%vnVpsnon(a) = Element__getNumberOfVPS( elem )
     Potential%nVpsnon = Potential%nVpsnon + Potential%vnVpsnon(a)
  end do



  if( Param%Option%spin_orbit ) then
     do a=1, Param%Data%natom
        elem => Param__Data__getElement( Param%Data%vatom(a)%name )
        if( .not. elem%dirac ) then
           open(unit=16,file=Param%Option%file_ac_tempout,position='append')
           write(16,*) '      ++++++ Warning!: it is not spin-dependent potential ', &
                trim(Param%Data%vatom(a)%name),'(',a,')' 
           close(16)
        end if

     end do
  else
     do a=1, Param%Data%natom
        elem => Param__Data__getElement( Param%Data%vatom(a)%name )
        if( elem%dirac ) then
           open(unit=16,file=Param%Option%file_ac_tempout,position='append')
           write(16,*) '      ++++++ Warning!: spin-dependent potentials are averaged ', &
                trim(Param%Data%vatom(a)%name),'(',a,')'
           close(16)
           call Element__averageVPS(elem)
        end if
     end do
  end if

  if( Param%Option%spin_orbit ) then
     allocate( Potential%vVpsnon(Potential%nVpsnon,2) )
  else
     allocate( Potential%vVpsnon(Potential%nVpsnon,1) )
  end if

  i=0
  do a=1, Param%Data%natom
     elem => Param__Data__getElement( Param%Data%vatom(a)%name )

     do n=1, elem%nVnon
        l = elem%vVnon(n,1)%l
        if((Param%Data%element_type=='ciao_ls') &
             .and.(.not. Param%Option%spin_orbit) &
             .and.(elem%dirac) &
             .and.(elem%vVnon(n,1)%l==elem%Vloc%l)) then
           cycle
        end if
        do m=-l, +l
           i=i+1
           if( Param%Option%spin_orbit ) then
              if( elem%dirac ) then
                 call PPnon__set( Potential%vVpsnon(i,1), Param%Data%vatom(a)%Ro, m, elem%vVnon(n,1) )
                 call PPnon__set( Potential%vVpsnon(i,2), Param%Data%vatom(a)%Ro, m, elem%vVnon(n,2) )
              else
                 call PPnon__set( Potential%vVpsnon(i,1), Param%Data%vatom(a)%Ro, m, elem%vVnon(n,1) )
                 call PPnon__set( Potential%vVpsnon(i,2), Param%Data%vatom(a)%Ro, m, elem%vVnon(n,1) )
              end if
           else
              call PPnon__set( Potential%vVpsnon(i,1), Param%Data%vatom(a)%Ro, m, elem%vVnon(n,1) )
           end if
        end do
     end do
  end do


  if( .not. Param%Option%projection ) then
     return
  end if

  allocate( Potential%vnVpsloc(Param%Data%natom) )
  allocate( Potential%viVpsloc(Param%Data%natom) )

  Potential%nVpsloc=0
  do a=1, Param%Data%natom
     elem => Param__Data__getElement( Param%Data%vatom(a)%name )

     Potential%viVpsloc(a) = Potential%nVpsloc
     Potential%vnVpsloc(a) = Element__getNumberOfPAO2( elem )
     Potential%nVpsloc = Potential%nVpsloc + Potential%vnVpsloc(a)
  end do

  allocate( Potential%vVpsloc(Potential%nVpsloc) )

  i=0
  do a=1, Param%Data%natom
     elem => Param__Data__getElement( Param%Data%vatom(a)%name )

     do n=1, elem%nVloc
        l = elem%vVloc(n)%l
        do m=-l, +l
           call PPnon__set( Potential%vVpsloc(i), Param%Data%vatom(a)%Ro, m, elem%vVloc(n) )
           i=i+1
        end do
     end do
  end do

  return
end subroutine Potential__setExtNonLocal

subroutine PPloc__set( pploc, Ro, RF )
  use ac_misc_module

  implicit none
  type(PPloc_type), intent(out)   :: pploc
  real(8), intent(in) :: Ro(3)
  type(RadialFunc_type), intent(in), target :: RF

  pploc%Ro = Ro
  pploc%Q  = RF%Q
  pploc%Rc = RF%Rc
  pploc%RF => RF

  return
end subroutine PPloc__set

subroutine PPloc__W( V, pploc, Rg )
  use ac_misc_module

  implicit none
  type(PPloc_type), intent(in)    :: pploc
  real(8), intent(in) :: Rg(3)
  real(8), intent(out)  :: V

  real(8) :: R(3)
  real(8)  :: dR
  R  = Rg-pploc%Ro
  dR = sqrt(dot_product(R,R))

  if( dR < pploc%Rc ) then
     V = Spline__evaluate( pploc%RF%fR, dR )
  else
     V = pploc%Q/dR
  end if

  return
end subroutine PPloc__W

subroutine PPloc__gW( gV, pploc, Rg )
  use ac_misc_module
  implicit none
  type(PPloc_type), intent(in)    :: pploc
  real(8), intent(in) :: Rg(3)
  real(8), intent(out) :: gV(3)

  real(8) :: R(3)
  real(8)  :: dR

  R  = Rg-pploc%Ro
  dR = sqrt(dot_product(R,R))

  if( dR < pploc%Rc ) then
     if( dR < 1.d-14 ) then
        gV = 0.d0
     else
        gV = Spline__derivative( pploc%RF%fR, dR ) / dR * R
     end if
  else
     gV = (-pploc%Q)/(dR*dR) / dR * R
  end if

  return
end subroutine PPloc__gW

subroutine PPloc__Wdiff( Vdiff, pploc, Rg )
  use ac_misc_module

  implicit none
  type(PPloc_type), intent(in)    :: pploc
  real(8), intent(in) :: Rg(3)
  real(8), intent(out) :: Vdiff

  real(8) :: R(3)
  real(8)  :: dR
  R  = Rg-pploc%Ro
  dR = sqrt(dot_product(R,R))
  if( dR < pploc%Rc ) then
     call PPloc__W( Vdiff, pploc, Rg )
     Vdiff = Vdiff - pploc%Q/dR
  else
     Vdiff = 0.d0
  end if

  return
end subroutine PPloc__Wdiff

subroutine PPloc__gWdiff( gVdiff, pploc, Rg )
  use ac_misc_module

  implicit none
  type(PPloc_type), intent(in)    :: pploc
  real(8), intent(in) :: Rg(3)
  real(8), intent(out) :: gVdiff(3)

  real(8) :: R(3)
  real(8)  :: dR

  R  = Rg-pploc%Ro
  dR = sqrt(dot_product(R,R))
  if( dR < pploc%Rc ) then
     call PPloc__gW( gVdiff, pploc, Rg )
     gVdiff = gVdiff + pploc%Q/(dR*dR) /dR*R
  else
     gVdiff = 0.d0
  end if

  return
end subroutine PPloc__gWdiff

subroutine PPnon__set( ppnon, Ro, m, RF )
  use ac_misc_module

  implicit none
  type(PPnon_type), intent(out)   :: ppnon
  real(8), intent(in) :: Ro(3)
  integer, intent(in)        :: m
  type(RadialFunc_type), intent(in), target :: RF

  ppnon%Ro = Ro
  ppnon%m  = m
  ppnon%E  = RF%Q
  ppnon%l  = RF%l
  ppnon%Rc = RF%Rc
  ppnon%RF => RF

  return
end subroutine PPnon__set

subroutine Potential__bracketS( sum, pao1, pao2, L )
  use ac_misc_module

  implicit none
  type(PAO_type), intent(in)   :: pao1
  type(PPnon_type), intent(in) :: pao2
  real(8), intent(in) :: L(3)

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

  real(8) :: R(3)
  real(8)  :: dR
  integer        :: l0, m0
  real(8)  :: g, gy, y

  sum = 0.d0

  R  = pao2%Ro + L - pao1%Ro
  dR = sqrt(dot_product(R,R))

  if( dR > pao1%Rc + pao2%Rc ) then
     return
  end if

  do l0=0, min( 2*max( pao1%l, pao2%l ), 6 )
     gy=0.0
     do m0=-l0, +l0
        g = SphericalHarmonic__Gaunt( pao1%l, pao1%m, pao2%l, pao2%m, l0, m0 )
        if( g == 0.0 ) cycle

        y = SphericalHarmonic__rlY( l0, m0, R )
        gy = gy + g*y
     end do
     if( gy == 0.d0 ) cycle

     sum = sum + gy * SphericalBessel__integrateS( pao1%RF%vK, pao2%RF%vK, l0, dR )
  end do

  return
end subroutine Potential__bracketS

subroutine Potential__bracketdS( dS, pao1, pao2, L )
  use ac_misc_module

  implicit none
  type(PAO_type), intent(in)   :: pao1
  type(PPnon_type), intent(in) :: pao2
  real(8), intent(in) :: L(3)

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

  real(8) :: R(3)
  real(8)  :: dR
  integer        :: l0, m0
  real(8)  :: g, gy, y
  real(8) :: dgy(3), dy(3)

  dS = 0.d0

  R  = pao2%Ro + L - pao1%Ro
  dR = sqrt(dot_product(R,R))

  if( dR > pao1%Rc + pao2%Rc ) then
     return
  end if

  do l0=0, min( 2*max( pao1%l, pao2%l ), 6 )
     gy=0.0
     dgy=0.d0
     do m0=-l0, +l0
        g = SphericalHarmonic__Gaunt( pao1%l, pao1%m, pao2%l, pao2%m, l0, m0 )
        if( g == 0.0 ) cycle
        y = SphericalHarmonic__rlY( l0, m0, R )
        dy = SphericalHarmonic__drlY( l0, m0, R )

        gy = gy + g*y
        dgy = dgy + g*dy
     end do

     if( .not. gy == 0.d0 ) then
        dS = dS + gy * &
             SphericalBessel__integratedS( pao1%RF%vK, pao2%RF%vK, l0, dR ) * R
     end if
     if( .not. dot_product(dgy,dgy) == 0.0d0 ) then
        dS = dS + dgy * &
             SphericalBessel__integrateS( pao1%RF%vK, pao2%RF%vK, l0, dR )
     end if

  end do

  return
end subroutine Potential__bracketdS

subroutine Density__bracketS( sum, pao1, pao2, L )
  use ac_misc_module

  implicit none
  real(8), intent(out)       :: sum
  type(PPcharge_type), intent(in) :: pao1
  type(PPloc_type), intent(in)    :: pao2
  real(8), intent(in) :: L(3)

  real(8) :: R(3)
  real(8)  :: dR
  real(8)  :: g, y, j

  R  = pao2%Ro + L - pao1%Ro
  dR = sqrt(dot_product(R,R))
  g = SphericalHarmonic__Gaunt( 0, 0, 0, 0, 0, 0 )
  y = SphericalHarmonic__rlY( 0, 0, R )
  j = SphericalBessel__integrateS( pao1%RF%vK, pao2%RF%vK, 0, dR )

  sum = 4.d0*M_PI*g*y*j

  return
end subroutine Density__bracketS

subroutine Density__bracketdS( dS, pao1, pao2, L )
  use ac_misc_module

  implicit none
  type(PPcharge_type), intent(in) :: pao1
  type(PPloc_type), intent(in)    :: pao2
  real(8), intent(in) :: L(3)

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

  real(8) :: R(3)
  real(8)  :: dR
  real(8)  :: g, y, j
  real(8) :: dy(3), dj(3)

  R  = pao2%Ro + L - pao1%Ro
  dR = sqrt(dot_product(R,R))
  g = SphericalHarmonic__Gaunt( 0, 0, 0, 0, 0, 0 )
  y = SphericalHarmonic__rlY( 0, 0, R )
  dy = SphericalHarmonic__drlY( 0, 0, R )
  j = SphericalBessel__integrateS( pao1%RF%vK, pao2%RF%vK, 0, dR )
  dj = SphericalBessel__integratedS( pao1%RF%vK, pao2%RF%vK, 0, dR )*R

  dS = 4.d0*M_PI*g*dy*j + 4.d0*M_PI*g*y*dj

  return
end subroutine Density__bracketdS

subroutine Potential__setup
  use ac_misc_module

  implicit none

  call Potential__deallocate

  if( .not. Param%Option%projection ) then
     allocate( Potential%Vext(Param%Cell%Na,Param%Cell%Nb,Param%Cell%Nc) )
     Potential%Vext = 0.d0
  end if

  if( .not. Param%Option%nohar ) then
     allocate( Potential%dVhar(Param%Cell%Na,Param%Cell%Nb,Param%Cell%Nc) )
     Potential%dVhar = 0.d0
  end if

  if( .not. Param%Option%noexc ) then
     allocate( Potential%Vexc(Param%Option%nspin,Param%Cell%Na,Param%Cell%Nb,Param%Cell%Nc) )
     Potential%Vexc = 0.d0
  end if

  allocate( Potential%Vtot(Param%Option%nspin,Param%Cell%Na,Param%Cell%Nb,Param%Cell%Nc) )
  Potential%Vtot = 0.d0

  call Potential__setExtLocal
  call Potential__setExtNonLocal

  return
end subroutine Potential__setup

subroutine Potential__update
  use ac_misc_module

  implicit none
  integer :: spin
  real(8) :: Ehar, Eexc

  if( .not. Param%Option%projection ) then
     if( Param%Option%spin_orbit ) then
        Potential%Vtot(1,:,:,:) = Potential%Vext(:,:,:)
        Potential%Vtot(2,:,:,:) = 0.d0
        Potential%Vtot(3,:,:,:) = 0.d0
        Potential%Vtot(4,:,:,:) = Potential%Vext(:,:,:)
     else
        do spin=1, Param%Option%nspin
           Potential%Vtot(spin,:,:,:) = Potential%Vext(:,:,:)
        end do
     end if
  else
     Potential%Vtot = 0.d0
  end if

  if( .not. Param%Option%nohar ) then
     if( Param%Option%spin_orbit ) then
        call HartreeLS__calcPotential( Ehar, Potential%dVhar, Density%rhoLS, Density%rhoval )

        Potential%Vtot(1,:,:,:) = Potential%Vtot(1,:,:,:) + Potential%dVhar(:,:,:)
        Potential%Vtot(4,:,:,:) = Potential%Vtot(4,:,:,:) + Potential%dVhar(:,:,:)
     else
        call Hartree__calcPotential( Ehar, Potential%dVhar, Density%rho, Density%rhoval )

        do spin=1, Param%Option%nspin
           Potential%Vtot(spin,:,:,:) = Potential%Vtot(spin,:,:,:) + Potential%dVhar(:,:,:)
        end do
     end if
  end if

  if( .not. Param%Option%noexc ) then
     if( Param%Option%spin_orbit ) then
        call ExchangeLS__calcPotential( Eexc, Potential%Vexc, Density%rhoLS, Density%rhopcc )
     else
        call Exchange__calcPotential( Eexc, Potential%Vexc, Density%rho, Density%rhopcc )
     end if
     Potential%Vtot = Potential%Vtot + Potential%Vexc
  end if

  return
end subroutine Potential__update

subroutine Potential__deallocate
  use ac_misc_module

  implicit none

  if( associated(Potential%Vext) ) deallocate( Potential%Vext )
  if( associated(Potential%dVhar) ) deallocate( Potential%dVhar )
  if( associated(Potential%Vexc) ) deallocate( Potential%Vexc )
  if( associated(Potential%Vtot) ) deallocate( Potential%Vtot )
  if( associated(Potential%vnVpsnon) ) deallocate( Potential%vnVpsnon )
  if( associated(Potential%viVpsnon) ) deallocate( Potential%viVpsnon )
  if( associated(Potential%vVpsnon) ) deallocate( Potential%vVpsnon )
  if( associated(Potential%vVpsloc) ) deallocate( Potential%vVpsloc )
  if( associated(Potential%vnVpsloc) ) deallocate( Potential%vnVpsloc )
  if( associated(Potential%viVpsloc) ) deallocate( Potential%viVpsloc )

  if( Param%Option%cluster ) then
     call Screening__deallocate
  endif

  return
end subroutine Potential__deallocate
