module Appelbaum_and_Hamann
! 
!  Joel A. Appelbaum and D.R. Hamann 
! Self-Consistent Pseudopotential for Si
!   Phys. Rev. B 8, 1777 (1973) 
!

  implicit none

contains

  subroutine set_AH_tables
    use constants,          only : dp, e2, fpi, three, four, half, zero, pi
    use utilities,          only  :  error
    use constants,          only  :  tpiba2
    use reciprocal_lattice, only  :  gg, gcutm
    use structure,          only  :  omega, element, species
    real(dp)                      :: v1, v2, alpha, q, dq, q2, qmax
    integer                       :: table_size, k, n
    
    for_each_species: do n=1, size(species)
       select case(species(n)%name)
       case('Si')
          v1          =  3.042_dp * E2 ! The factor E2 accounts for the convers
          v2          = -1.372_dp * E2 ! Hartree -> Ry
          alpha       =  0.6102_dp
          species(n)%zv = 4.0_dp
       case default
          call error('setup_potential','element '//' currently not allowed',1)
       end select

       qmax = sqrt(gcutm*tpiba2)
       dq = 0.01_dp
       table_size = qmax / dq + 2
       allocate (species(n)%ps%vps(0:table_size))
    
       q = ZERO
       species(n)%ps%vps(0) = (PI *E2 *species(n)%zv / alpha) &
            + (PI/alpha)**(THREE*HALF) * (v1 + THREE*HALF*v2/alpha) 

       do k = 1, table_size
          q  = q + dq
          q2 = q*q
          species(n)%ps%vps(k) = exp(-q2/FOUR/alpha) * &
               ( -FPI* species(n)%zv* E2 /q2 + (PI/alpha)**(THREE*HALF)* &
               ( v1 + v2/alpha * (THREE*HALF - q2/FOUR/alpha) ) ) 
       end do

       species(n)%ps%dq   = dq

    end do for_each_species
    
  end subroutine set_AH_tables

  subroutine fill_AH_vatom
    use constants, only : dp, zero, tpiba2
    use reciprocal_lattice, only : ngm, gg
    use structure, only : atom, atoms, element, species, ntyp
    
    complex(DP), pointer     :: vg(:,:)
    real(DP), pointer        :: vps(:)
    complex(DP)              :: v_value
    real(DP)                 :: vatom, q, dq
    integer                  :: i,j,k, ig,  indx, n

    allocate(vg(ngm,ntyp))

    do n=1,ntyp
       vps => species(n)%ps%vps
       dq  =  species(n)%ps%dq
       do ig=1, ngm
          q = sqrt(gg(ig)*tpiba2)
          v_value = cmplx(ZERO,ZERO)
          indx = q / dq
          vg(ig,n) = vps(indx) + (q-indx*dq)*(vps(indx+1)-vps(indx))/dq
       end do
       species(n)%ps%vg => vg(:,n)
    end do
          
    return
  end subroutine fill_AH_vatom

  subroutine fill_ahq_vatom
    use constants, only : dp, e2, tpiba2, three, half, four, pi, fpi
    use reciprocal_lattice, only : ngm, g, tpiba2
    use structure, only : atom, atoms, element, species, ntyp
    use phonon_mod, only : q
    
    complex(DP), pointer     :: vgq(:,:)
    real(DP)                 :: vatom, xq, dq, v1,v2,alpha, q2
    integer                  :: i,j,k, ig,  indx, n

    v1          =  3.042_dp * E2 ! The factor E2 accounts for 
    v2          = -1.372_dp * E2 ! Hartree -> Ry
    alpha       =  0.6102_dp


    allocate(vgq(ngm,ntyp))

    do n=1,ntyp
       do ig=1, ngm
          xq =  ( (g(1,ig)+q(1))**2 + (g(2,ig)+q(2))**2 + &
                      (g(3,ig)+q(3))**2 )*tpiba2
          if (sqrt(xq).lt.1d-9) then
             vgq(ig,n)= (PI *E2 *4.d0 / alpha) &
            + (PI/alpha)**(THREE*HALF) * (v1 + THREE*HALF*v2/alpha)
          else
             vgq(ig,n) =  exp(-xq/FOUR/alpha) * &
               ( -FPI* 4.d0* E2 /xq + (PI/alpha)**(THREE*HALF)* &
               ( v1 + v2/alpha * (THREE*HALF - xq/FOUR/alpha) ) )
          endif
       end do
       species(n)%ps%vgq => vgq(:,n)
    end do
          
    return
  end subroutine fill_ahq_vatom




end module Appelbaum_and_Hamann
