quantum-espresso/atomic/chargeps.f90

101 lines
3.0 KiB
Fortran

!
! Copyright (C) 2007 QUANTUM-ESPRESSO group
! This file is distributed under the terms of the
! GNU General Public License. See the file `License'
! in the root directory of the present distribution,
! or http://www.gnu.org/copyleft/gpl.txt .
!
!
!---------------------------------------------------------------
subroutine chargeps(rho_i,phi_i,nwf_i,ll_i,jj_i,oc_i,iswf_i)
!---------------------------------------------------------------
!
! calculate the (spherical) pseudo charge density
!
! use ld1inc
use kinds, only: dp
use ld1_parameters, only: nwfsx
use radial_grids, only: ndmx
use ld1inc, only: grid, pseudotype, qvan, nbeta, betas, lls, jjs, ikk, &
which_augfun, lpaw, qvanl
implicit none
integer :: &
nwf_i, & ! input: the number of wavefunctions
iswf_i(nwfsx),& ! input: their spin
ll_i(nwfsx) ! input: their angular momentum
real(DP) :: &
jj_i(nwfsx), & ! input: their total angular momentum
oc_i(nwfsx), & ! input: the occupation
phi_i(ndmx,nwfsx), & ! input: the functions to add
rho_i(ndmx,2) ! output: the (nspin) components of the charge
integer :: &
is, & ! counter on spin
n,n1,n2,& ! counters on beta and mesh function
ns,nst,ikl ! counter on wavefunctions
real(DP) :: &
work(nwfsx), & ! auxiliary variable for becp
int_0_inf_dr,& ! integration function
gi(ndmx) ! used to compute the integrals
rho_i=0.0_dp
!
! compute the square modulus of the eigenfunctions
!
do ns=1,nwf_i
if (oc_i(ns).gt.0.0_dp) then
is=iswf_i(ns)
do n=1,grid%mesh
rho_i(n,is)=rho_i(n,is)+oc_i(ns)*phi_i(n,ns)**2
end do
endif
enddo
!
! if US pseudopotential compute the augmentation part
!
if (pseudotype.eq.3) then
do ns=1,nwf_i
if (oc_i(ns).gt.0.0_dp) then
is=iswf_i(ns)
do n1=1,nbeta
if (ll_i(ns).eq.lls(n1).and. &
abs(jj_i(ns)-jjs(n1)).lt.1.e-7_dp) then
nst=(ll_i(ns)+1)*2
ikl=ikk(n1)
do n=1,ikl
gi(n)=betas(n,n1)*phi_i(n,ns)
enddo
work(n1)=int_0_inf_dr(gi,grid,ikl,nst)
else
work(n1)=0.0_dp
endif
enddo
!
! and adding to the charge density
!
do n1=1,nbeta
do n2=1,nbeta
IF (which_augfun=='PSQ') then
do n=1,grid%mesh
rho_i(n,is)=rho_i(n,is)+qvanl(n,n1,n2,0)*oc_i(ns)* &
work(n1)*work(n2)
enddo
ELSE
do n=1,grid%mesh
rho_i(n,is)=rho_i(n,is)+qvan(n,n1,n2)*oc_i(ns)* &
work(n1)*work(n2)
enddo
ENDIF
enddo
enddo
endif
enddo
endif
return
end subroutine chargeps