mirror of https://gitlab.com/QEF/q-e.git
Step 1 of many: paw augmentation functions moved to upf structure
(I apologise for the many check-ins I'll do, but I have to keep track of changes.) LP git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@4424 c92efa57-630b-4861-b058-cf58834340f0
This commit is contained in:
parent
3ee15febfe
commit
513379419b
|
@ -15,8 +15,6 @@ MODULE paw_variables
|
|||
!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
!!!! Control flags: !!!!
|
||||
|
||||
! debug: if .false. don't apply PAW correction
|
||||
LOGICAL, PARAMETER :: really_do_paw = .true.
|
||||
! Set to true after initialization, to prevent double allocs:
|
||||
LOGICAL :: is_init = .false.
|
||||
! Analogous to okvan in "uspp_param" (Modules/uspp.f90)
|
||||
|
@ -24,8 +22,8 @@ MODULE paw_variables
|
|||
okpaw ! if .TRUE. at least one pseudo is PAW
|
||||
|
||||
! Analogous to tvanp in "uspp_param" (Modules/uspp.f90)
|
||||
LOGICAL :: &
|
||||
tpawp(npsx) = .false. ! if .TRUE. the atom is of PAW type
|
||||
! LOGICAL :: &
|
||||
! tpawp(npsx) = .false. ! if .TRUE. the atom is of PAW type
|
||||
|
||||
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
!!!! Initialization data: !!!!
|
||||
|
@ -57,13 +55,13 @@ MODULE paw_variables
|
|||
ptfunc(ndmx,nbrx,nbrx,npsx) ! PS: \tilde{\phi}_{mu}(|r|)-\tilde{\phi}_{nu}(|r|)
|
||||
|
||||
! Augmentation on radial grid:
|
||||
TYPE augfun_t
|
||||
REAL(DP), ALLOCATABLE :: fun(:,:,:,:)
|
||||
END TYPE
|
||||
TYPE(augfun_t) :: aug(npsx)
|
||||
! TYPE augfun_t
|
||||
! REAL(DP), ALLOCATABLE :: fun(:,:,:,:)
|
||||
! END TYPE
|
||||
! TYPE(augfun_t) :: aug(npsx)
|
||||
! Moments of the augmentation functions
|
||||
REAL (DP) :: &
|
||||
augmom(nbrx,nbrx,0:6,npsx) ! moments of PAW augm. functions
|
||||
augmom(nbrx,nbrx,0:6,npsx) ! moments of PAW augm. functions
|
||||
INTEGER :: &
|
||||
nraug(npsx) ! augm. functions cutoff parameter
|
||||
|
||||
|
@ -71,7 +69,7 @@ MODULE paw_variables
|
|||
REAL(DP), TARGET :: &
|
||||
aerho_atc(ndmx,npsx), &! radial AE core charge density
|
||||
psrho_atc(ndmx,npsx) ! radial PS core charge density
|
||||
|
||||
|
||||
! Analogous to vloc_at in "uspp_param" (Modules/uspp.f90)
|
||||
! actually pseudopotential (AE and PS) on radial grid.
|
||||
REAL(DP), TARGET :: &
|
||||
|
@ -100,13 +98,13 @@ MODULE paw_variables
|
|||
saved(:) ! allocated in PAW_rad_init
|
||||
|
||||
! This type contains some useful data that has to be passed to all
|
||||
! the functions, but cannot stay in global variables for parallel:
|
||||
! functions, but cannot stay in global variables for parallel:
|
||||
TYPE paw_info
|
||||
INTEGER :: a ! atom index
|
||||
INTEGER :: t ! atom type index
|
||||
INTEGER :: m ! atom mesh = g(nt)%mesh
|
||||
INTEGER :: w ! w=1 --> all electron, w=2 --> pseudo
|
||||
! (used only for gradient correction)
|
||||
INTEGER :: w ! number of atomic wavefunctions
|
||||
INTEGER :: l ! max angular index l
|
||||
END TYPE
|
||||
|
||||
! Analogous to deeq in "uspp_param" (Modules/uspp.f90)
|
||||
|
|
|
@ -60,9 +60,21 @@ TYPE :: paw_t
|
|||
END TYPE paw_t
|
||||
|
||||
!
|
||||
! Additional data to make a PAW setup out of an US pseudo,
|
||||
! they are all stored on a radial grid:
|
||||
TYPE paw_in_upf
|
||||
REAL(DP),ALLOCATABLE :: aug(:,:,:,:) ! Augmentation charge
|
||||
REAL(DP),ALLOCATABLE :: ae_core(:), &! AE core charge
|
||||
ps_core(:) ! PS core charge
|
||||
REAL(DP),ALLOCATABLE :: ae_vloc(:), &! AE local potential
|
||||
ps_vloc(:) ! PS local potential
|
||||
REAL(DP),ALLOCATABLE :: pfunc(:,:,:),&! Psi_i(r)*Psi_j(r)
|
||||
ptfunc(:,:,:) ! as above, but for pseudo
|
||||
END TYPE paw_in_upf
|
||||
|
||||
|
||||
TYPE pseudo_upf
|
||||
CHARACTER(LEN=80):: generated !
|
||||
CHARACTER(LEN=80):: generated !
|
||||
CHARACTER(LEN=80):: date_author ! Misc info
|
||||
CHARACTER(LEN=80):: comment !
|
||||
CHARACTER(LEN=2) :: psd ! Element label
|
||||
|
@ -119,13 +131,18 @@ END TYPE paw_t
|
|||
REAL(DP), POINTER :: qfcoef(:,:,:,:) ! qfcoef(nqf,0:2*lmax,nbeta,nbeta)
|
||||
! coefficients for Q for |r|<r_L
|
||||
REAL(DP), POINTER :: chi(:,:) ! chi(mesh,nwfc) atomic wavefcts
|
||||
REAL(DP), POINTER :: rho_at(:) ! rho_at(mesh) atomic charge
|
||||
|
||||
LOGICAL :: has_paw ! Whether PAW data is included
|
||||
REAL(DP), POINTER :: rho_at(:) ! rho_at(mesh) atomic charge
|
||||
|
||||
! PAW:
|
||||
LOGICAL :: has_paw ! Whether PAW data is included
|
||||
REAL(DP) :: paw_data_format ! The version of the format
|
||||
LOGICAL :: has_gipaw ! Whether GIPAW data is included
|
||||
LOGICAL :: tpawp ! true if atom is PAW
|
||||
TYPE(paw_in_upf) :: paw ! additional data for PAW (see above)
|
||||
|
||||
! GIPAW:
|
||||
LOGICAL :: has_gipaw ! Whether GIPAW data is included
|
||||
REAL(DP) :: gipaw_data_format ! The version of the format
|
||||
INTEGER :: gipaw_ncore_orbitals
|
||||
INTEGER :: gipaw_ncore_orbitals
|
||||
REAL(DP), POINTER :: gipaw_core_orbital_n(:)
|
||||
REAL(DP), POINTER :: gipaw_core_orbital_l(:)
|
||||
CHARACTER(LEN=2), POINTER :: gipaw_core_orbital_el(:)
|
||||
|
|
|
@ -292,9 +292,9 @@ subroutine set_pseudo_paw (is, pawset)
|
|||
USE pseudo_types
|
||||
USE constants, ONLY: FPI
|
||||
!
|
||||
USE paw_variables, ONLY : tpawp, pfunc, ptfunc, aevloc_at, psvloc_at, &
|
||||
USE paw_variables, ONLY : pfunc, ptfunc, aevloc_at, psvloc_at, &
|
||||
aerho_atc, psrho_atc, kdiff, &
|
||||
augmom, nraug, step_f, aug
|
||||
augmom, nraug, step_f
|
||||
!
|
||||
implicit none
|
||||
!
|
||||
|
@ -306,6 +306,7 @@ subroutine set_pseudo_paw (is, pawset)
|
|||
integer :: nb, mb, ijv
|
||||
TYPE (paw_t) :: pawset
|
||||
integer :: i,j, l, nrc, nrs
|
||||
integer :: nwfc, mesh
|
||||
real (DP) :: pow
|
||||
real (DP), ALLOCATABLE :: aux (:)
|
||||
!
|
||||
|
@ -330,8 +331,7 @@ subroutine set_pseudo_paw (is, pawset)
|
|||
upf(is)%psd = pawset%symbol
|
||||
upf(is)%tvanp=.true.
|
||||
upf(is)%nlcc = pawset%nlcc
|
||||
!tvanp(is)=.true.
|
||||
tpawp(is)=.true.
|
||||
upf(is)%tpawp = .true.
|
||||
call set_dft_from_name( pawset%dft )
|
||||
!
|
||||
IF ( dft_is_meta() ) &
|
||||
|
@ -343,50 +343,52 @@ subroutine set_pseudo_paw (is, pawset)
|
|||
#endif
|
||||
!
|
||||
rgrid(is)%mesh = pawset%grid%mesh
|
||||
mesh = pawset%grid%mesh ! to make this file barely readable
|
||||
nwfc = pawset%nwfc ! " " " " " "
|
||||
!
|
||||
! ... Copy wavefunctions used for PAW construction.
|
||||
! ... Copy also the unoccupied ones, e.g.
|
||||
! ... corresponding to second energy for the same channel
|
||||
! ... (necessary to set starting occupations correctly)
|
||||
!
|
||||
upf(is)%nwfc = pawset%nwfc
|
||||
ALLOCATE ( upf(is)%lchi(pawset%nwfc), upf(is)%oc(pawset%nwfc) )
|
||||
ALLOCATE ( upf(is)%chi( pawset%grid%mesh, pawset%nwfc) )
|
||||
do i=1, pawset%nwfc
|
||||
upf(is)%nwfc = nwfc
|
||||
ALLOCATE ( upf(is)%lchi(nwfc), upf(is)%oc(nwfc) )
|
||||
ALLOCATE ( upf(is)%chi( mesh, nwfc) )
|
||||
do i=1, nwfc
|
||||
upf(is)%lchi(i)=pawset%l(i)
|
||||
upf(is)%oc(i)=MAX(pawset%oc(i),0._DP)
|
||||
upf(is)%chi(1:pawset%grid%mesh, i) = pawset%pswfc(1:pawset%grid%mesh, i)
|
||||
upf(is)%chi(1:mesh, i) = pawset%pswfc(1:mesh, i)
|
||||
end do
|
||||
!
|
||||
upf(is)%nbeta= pawset%nwfc
|
||||
allocate ( upf(is)%kbeta(pawset%nwfc) )
|
||||
do nb=1,pawset%nwfc
|
||||
upf(is)%nbeta= nwfc
|
||||
allocate ( upf(is)%kbeta(nwfc) )
|
||||
do nb=1,nwfc
|
||||
upf(is)%kbeta(nb)=pawset%ikk(nb)
|
||||
end do
|
||||
! kkbeta is the maximum distance from nucleus where AE
|
||||
! and PS wavefunction may not match:
|
||||
upf(is)%kkbeta=MAXVAL (upf(is)%kbeta(:))
|
||||
|
||||
allocate (upf(is)%beta(1:pawset%grid%mesh, 1:pawset%nwfc))
|
||||
upf(is)%beta(1:pawset%grid%mesh, 1:pawset%nwfc) = &
|
||||
pawset%proj(1:pawset%grid%mesh, 1:pawset%nwfc)
|
||||
allocate (upf(is)%beta(1:mesh, 1:nwfc))
|
||||
upf(is)%beta(1:mesh, 1:nwfc) = &
|
||||
pawset%proj(1:mesh, 1:nwfc)
|
||||
|
||||
allocate(upf(is)%dion(1:pawset%nwfc, 1:pawset%nwfc))
|
||||
upf(is)%dion(1:pawset%nwfc, 1:pawset%nwfc) = pawset%dion(1:pawset%nwfc, 1:pawset%nwfc)
|
||||
kdiff(1:pawset%nwfc, 1:pawset%nwfc, is) = pawset%kdiff(1:pawset%nwfc, 1:pawset%nwfc)
|
||||
allocate(upf(is)%dion(1:nwfc, 1:nwfc))
|
||||
upf(is)%dion(1:nwfc, 1:nwfc) = pawset%dion(1:nwfc, 1:nwfc)
|
||||
kdiff(1:nwfc, 1:nwfc, is) = pawset%kdiff(1:nwfc, 1:nwfc)
|
||||
|
||||
upf(is)%nqlc = 2*pawset%lmax+1
|
||||
upf(is)%nqf = 0 !! no rinner, all numeric
|
||||
|
||||
allocate (upf(is)%lll(pawset%nwfc) )
|
||||
upf(is)%lll(1:pawset%nwfc) = pawset%l(1:pawset%nwfc)
|
||||
allocate (upf(is)%lll(nwfc) )
|
||||
upf(is)%lll(1:nwfc) = pawset%l(1:nwfc)
|
||||
allocate (upf(is)%rinner(upf(is)%nqlc))
|
||||
upf(is)%rinner(1:upf(is)%nqlc) = 0._dp !! no rinner, all numeric
|
||||
|
||||
! integral of augmentation charges vanishes for different values of l
|
||||
allocate ( upf(is)%qqq(pawset%nwfc,pawset%nwfc))
|
||||
do i = 1, pawset%nwfc
|
||||
do j = 1, pawset%nwfc
|
||||
allocate ( upf(is)%qqq(nwfc,nwfc))
|
||||
do i = 1, nwfc
|
||||
do j = 1, nwfc
|
||||
if (pawset%l(i)==pawset%l(j)) then
|
||||
upf(is)%qqq(i,j) = pawset%augmom(i,j,0) !!gf spherical approximation
|
||||
else
|
||||
|
@ -398,45 +400,53 @@ subroutine set_pseudo_paw (is, pawset)
|
|||
! import augmentation charge:
|
||||
nraug(is) = pawset%irc
|
||||
rgrid(is)%dx = pawset%grid%dx
|
||||
rgrid(is)%r2 (1:pawset%grid%mesh) = pawset%grid%r2 (1:pawset%grid%mesh)
|
||||
rgrid(is)%r2 (1:mesh) = pawset%grid%r2 (1:mesh)
|
||||
do l = 0, 2*pawset%lmax
|
||||
do i = 1, pawset%nwfc
|
||||
do j = 1, pawset%nwfc
|
||||
do i = 1, nwfc
|
||||
do j = 1, nwfc
|
||||
augmom(i,j,l,is) = pawset%augmom(i,j,l)
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
|
||||
! FIXME!!! Probably this loop is unnecessary as the qfunc are reconstraucted from
|
||||
! the full augfuncs !!
|
||||
! triangularize matrix of qfunc's
|
||||
allocate ( upf(is)%qfunc(1:pawset%grid%mesh,pawset%nwfc*(pawset%nwfc+1)/2) )
|
||||
do nb = 1, pawset%nwfc
|
||||
do mb = nb, pawset%nwfc
|
||||
allocate ( upf(is)%qfunc(1:mesh,nwfc*(nwfc+1)/2) )
|
||||
do nb = 1, nwfc
|
||||
do mb = nb, nwfc
|
||||
ijv = mb * (mb-1) / 2 + nb
|
||||
upf(is)%qfunc (1:pawset%grid%mesh,ijv) = &
|
||||
pawset%augfun(1:pawset%grid%mesh,nb,mb,0)
|
||||
upf(is)%qfunc (1:mesh,ijv) = &
|
||||
pawset%augfun(1:mesh,nb,mb,0)
|
||||
enddo
|
||||
enddo
|
||||
|
||||
! new sparse allocation for augmentation functions
|
||||
if (allocated(aug(is)%fun)) deallocate(aug(is)%fun)
|
||||
allocate(aug(is)%fun(1:pawset%grid%mesh,1:pawset%nwfc,1:pawset%nwfc,0:2*pawset%lmax))
|
||||
!
|
||||
aug(is)%fun(1:pawset%grid%mesh,1:pawset%nwfc,1:pawset%nwfc,0:2*pawset%lmax) &
|
||||
= &
|
||||
pawset%augfun(1:pawset%grid%mesh,1:pawset%nwfc,1:pawset%nwfc,0:2*pawset%lmax)
|
||||
!if (allocated(aug(is)%fun)) deallocate(aug(is)%fun)
|
||||
! allocate(aug(is)%fun(1:mesh,1:nwfc,1:nwfc,0:2*pawset%lmax))
|
||||
! !
|
||||
! aug(is)%fun(1:mesh,1:nwfc,1:nwfc,0:2*pawset%lmax) &
|
||||
! = &
|
||||
! pawset%augfun(1:mesh,1:nwfc,1:nwfc,0:2*pawset%lmax)
|
||||
|
||||
! Augmentation functions for PAW depend on angular momentum!
|
||||
allocate(upf(is)%paw%aug(1:mesh,1:nwfc,1:nwfc,0:2*pawset%lmax))
|
||||
upf(is)%paw%aug(1:mesh,1:nwfc,1:nwfc,0:2*pawset%lmax) &
|
||||
= pawset%augfun(1:mesh,1:nwfc,1:nwfc,0:2*pawset%lmax)
|
||||
|
||||
|
||||
|
||||
!
|
||||
#if ! defined __DO_NOT_CUTOFF_PAW_FUNC
|
||||
ALLOCATE (aux(1:pawset%grid%mesh))
|
||||
ALLOCATE (aux(1:mesh))
|
||||
#endif
|
||||
do i=1,pawset%nwfc
|
||||
do j=1,pawset%nwfc
|
||||
do i=1,nwfc
|
||||
do j=1,nwfc
|
||||
#if defined __DO_NOT_CUTOFF_PAW_FUNC
|
||||
pfunc (1:pawset%grid%mesh, i, j, is) = &
|
||||
pawset%aewfc(1:pawset%grid%mesh, i) * pawset%aewfc(1:pawset%grid%mesh, j)
|
||||
ptfunc (1:pawset%grid%mesh, i, j, is) = &
|
||||
pawset%pswfc(1:pawset%grid%mesh, i) * pawset%pswfc(1:pawset%grid%mesh, j)
|
||||
pfunc (1:mesh, i, j, is) = &
|
||||
pawset%aewfc(1:mesh, i) * pawset%aewfc(1:mesh, j)
|
||||
ptfunc (1:mesh, i, j, is) = &
|
||||
pawset%pswfc(1:mesh, i) * pawset%pswfc(1:mesh, j)
|
||||
#else
|
||||
#if defined __SHARP_CUTOFF_PAW_FUNC
|
||||
pfunc(:,i,j,is) = 0._dp
|
||||
|
@ -446,14 +456,14 @@ subroutine set_pseudo_paw (is, pawset)
|
|||
ptfunc (1:pawset%irc, i, j, is) = &
|
||||
pawset%pswfc(1:pawset%irc, i) * pawset%pswfc(1:pawset%irc, j)
|
||||
#else
|
||||
aux(1:pawset%grid%mesh) = pawset%aewfc(1:pawset%grid%mesh, i) * &
|
||||
pawset%aewfc(1:pawset%grid%mesh, j)
|
||||
CALL step_f( pfunc(1:pawset%grid%mesh,i,j,is), aux(1:pawset%grid%mesh), &
|
||||
pawset%grid%r(1:pawset%grid%mesh), nrs, nrc, pow, pawset%grid%mesh)
|
||||
aux(1:pawset%grid%mesh) = pawset%pswfc(1:pawset%grid%mesh, i) * &
|
||||
pawset%pswfc(1:pawset%grid%mesh, j)
|
||||
CALL step_f( ptfunc(1:pawset%grid%mesh,i,j,is), aux(1:pawset%grid%mesh), &
|
||||
pawset%grid%r(1:pawset%grid%mesh), nrs, nrc, pow, pawset%grid%mesh)
|
||||
aux(1:mesh) = pawset%aewfc(1:mesh, i) * &
|
||||
pawset%aewfc(1:mesh, j)
|
||||
CALL step_f( pfunc(1:mesh,i,j,is), aux(1:mesh), &
|
||||
pawset%grid%r(1:mesh), nrs, nrc, pow, mesh)
|
||||
aux(1:mesh) = pawset%pswfc(1:mesh, i) * &
|
||||
pawset%pswfc(1:mesh, j)
|
||||
CALL step_f( ptfunc(1:mesh,i,j,is), aux(1:mesh), &
|
||||
pawset%grid%r(1:mesh), nrs, nrc, pow, mesh)
|
||||
#endif
|
||||
#endif
|
||||
end do
|
||||
|
@ -463,80 +473,79 @@ subroutine set_pseudo_paw (is, pawset)
|
|||
! ... One should not need \tilde{n}^1 alone in any case.
|
||||
!
|
||||
! nqf is always 0 for this PAW format
|
||||
! qfcoef(1:pawset%nqf, 1:pawset%nqlc, 1:pawset%nwfc, 1:pawset%nwfc, is ) = 0._dp
|
||||
! qfcoef(1:pawset%nqf, 1:pawset%nqlc, 1:nwfc, 1:nwfc, is ) = 0._dp
|
||||
!
|
||||
rgrid(is)%r (1:pawset%grid%mesh) = pawset%grid%r (1:pawset%grid%mesh)
|
||||
rgrid(is)%rab(1:pawset%grid%mesh) = pawset%grid%r (1:pawset%grid%mesh)*pawset%grid%dx
|
||||
rgrid(is)%r (1:mesh) = pawset%grid%r (1:mesh)
|
||||
rgrid(is)%rab(1:mesh) = pawset%grid%r (1:mesh)*pawset%grid%dx
|
||||
|
||||
!
|
||||
! set radial grid data
|
||||
!
|
||||
rgrid(is)%mesh = pawset%grid%mesh
|
||||
rgrid(is)%mesh = mesh
|
||||
rgrid(is)%xmin = pawset%grid%xmin
|
||||
rgrid(is)%rmax = pawset%grid%rmax
|
||||
rgrid(is)%zmesh= pawset%grid%zmesh
|
||||
rgrid(is)%dx = pawset%grid%dx
|
||||
rgrid(is)%r(1:pawset%grid%mesh) = pawset%grid%r(1:pawset%grid%mesh)
|
||||
rgrid(is)%r2(1:pawset%grid%mesh) = pawset%grid%r2(1:pawset%grid%mesh)
|
||||
rgrid(is)%rab(1:pawset%grid%mesh) = pawset%grid%rab(1:pawset%grid%mesh)
|
||||
rgrid(is)%sqr(1:pawset%grid%mesh) = sqrt(pawset%grid%r(1:pawset%grid%mesh))
|
||||
! these speed up a lot a few calculations:
|
||||
rgrid(is)%rm1(1:pawset%grid%mesh) = pawset%grid%rm1(1:pawset%grid%mesh)
|
||||
rgrid(is)%rm2(1:pawset%grid%mesh) = pawset%grid%rm2(1:pawset%grid%mesh)
|
||||
rgrid(is)%rm3(1:pawset%grid%mesh) = pawset%grid%rm3(1:pawset%grid%mesh)
|
||||
rgrid(is)%r(1:mesh) = pawset%grid%r(1:mesh)
|
||||
rgrid(is)%r2(1:mesh) = pawset%grid%r2(1:mesh)
|
||||
rgrid(is)%rab(1:mesh) = pawset%grid%rab(1:mesh)
|
||||
rgrid(is)%sqr(1:mesh) = sqrt(pawset%grid%r(1:mesh))
|
||||
! these speed up a lot a few calculations (paw XC and GCXC):
|
||||
rgrid(is)%rm1(1:mesh) = pawset%grid%rm1(1:mesh)
|
||||
rgrid(is)%rm2(1:mesh) = pawset%grid%rm2(1:mesh)
|
||||
rgrid(is)%rm3(1:mesh) = pawset%grid%rm3(1:mesh)
|
||||
|
||||
! NO spin orbit PAW implemented right now (oct 2007)
|
||||
!!$ if (lspinorb.and..not.pawset%has_so) &
|
||||
!!$ call infomsg ('pawset_to_internal','At least one non s.o. pseudo')
|
||||
allocate (upf(is)%jchi(1:pawset%nwfc))
|
||||
allocate (upf(is)%jjj(1:pawset%nwfc))
|
||||
allocate (upf(is)%jchi(1:nwfc))
|
||||
allocate (upf(is)%jjj(1:nwfc))
|
||||
|
||||
!!$ lspinorb=lspinorb.and.pawset%has_so
|
||||
!!$ if (pawset%has_so) then
|
||||
!!$ jchi(1:pawset%nwfc, is) = pawset%jchi(1:pawset%nwfc)
|
||||
!!$ jchi(1:nwfc, is) = pawset%jchi(1:nwfc)
|
||||
!!$ jjj(1:pawset%nbeta, is) = pawset%jjj(1:pawset%nbeta)
|
||||
!!$ else
|
||||
|
||||
upf(is)%jchi(1:pawset%nwfc) = 0._dp
|
||||
upf(is)%jjj(1:pawset%nwfc) = 0._dp
|
||||
upf(is)%jchi(1:nwfc) = 0._dp
|
||||
upf(is)%jjj(1:nwfc) = 0._dp
|
||||
|
||||
!!$ endif
|
||||
!
|
||||
if ( pawset%nlcc) then
|
||||
allocate ( upf(is)%rho_atc(pawset%grid%mesh) )
|
||||
upf(is)%rho_atc(1:pawset%grid%mesh) = &
|
||||
pawset%psccharge(1:pawset%grid%mesh) &
|
||||
/ FPI / pawset%grid%r2(1:pawset%grid%mesh)
|
||||
allocate ( upf(is)%rho_atc(mesh) )
|
||||
upf(is)%rho_atc(1:mesh) = &
|
||||
pawset%psccharge(1:mesh) / FPI / pawset%grid%r2(1:mesh)
|
||||
end if
|
||||
|
||||
aerho_atc(1:pawset%grid%mesh, is) = pawset%aeccharge(1:pawset%grid%mesh) &
|
||||
& / FPI / pawset%grid%r2(1:pawset%grid%mesh)
|
||||
aerho_atc(1:mesh, is) = pawset%aeccharge(1:mesh) &
|
||||
& / FPI / pawset%grid%r2(1:mesh)
|
||||
if ( pawset%nlcc) then
|
||||
psrho_atc(1:pawset%grid%mesh, is) = pawset%psccharge(1:pawset%grid%mesh) &
|
||||
& / FPI / pawset%grid%r2(1:pawset%grid%mesh)
|
||||
psrho_atc(1:mesh, is) = pawset%psccharge(1:mesh) &
|
||||
& / FPI / pawset%grid%r2(1:mesh)
|
||||
else
|
||||
psrho_atc(:,is) = 0._dp
|
||||
end if
|
||||
!
|
||||
allocate ( upf(is)%rho_at(pawset%grid%mesh) )
|
||||
upf(is)%rho_at (1:pawset%grid%mesh) = pawset%pscharge(1:pawset%grid%mesh)
|
||||
allocate ( upf(is)%rho_at(mesh) )
|
||||
upf(is)%rho_at (1:mesh) = pawset%pscharge(1:mesh)
|
||||
|
||||
allocate (upf(is)%vloc(1:pawset%grid%mesh))
|
||||
upf(is)%vloc(1:pawset%grid%mesh) = pawset%psloc(1:pawset%grid%mesh)
|
||||
allocate (upf(is)%vloc(1:mesh))
|
||||
upf(is)%vloc(1:mesh) = pawset%psloc(1:mesh)
|
||||
#if defined __DO_NOT_CUTOFF_PAW_FUNC
|
||||
aevloc_at(1:pawset%grid%mesh,is) = pawset%aeloc(1:pawset%grid%mesh)
|
||||
psvloc_at(1:pawset%grid%mesh,is) = pawset%psloc(1:pawset%grid%mesh)
|
||||
aevloc_at(1:mesh,is) = pawset%aeloc(1:mesh)
|
||||
psvloc_at(1:mesh,is) = pawset%psloc(1:mesh)
|
||||
#else
|
||||
#if defined __SHARP_CUTOFF_PAW_FUNC
|
||||
aevloc_at(1:pawset%grid%mesh,is) = pawset%aeloc(1:pawset%grid%mesh)
|
||||
psvloc_at(1:pawset%grid%mesh,is) = pawset%psloc(1:pawset%grid%mesh)
|
||||
aux(1:pawset%grid%mesh) = pawset%aeloc(1:pawset%grid%mesh)
|
||||
aevloc_at(1:mesh,is) = pawset%aeloc(1:mesh)
|
||||
psvloc_at(1:mesh,is) = pawset%psloc(1:mesh)
|
||||
aux(1:mesh) = pawset%aeloc(1:mesh)
|
||||
#else
|
||||
CALL step_f( aevloc_at(1:pawset%grid%mesh,is), aux(1:pawset%grid%mesh), &
|
||||
pawset%grid%r(1:pawset%grid%mesh), nrs, nrc, pow, pawset%grid%mesh)
|
||||
aux(1:pawset%grid%mesh) = pawset%psloc(1:pawset%grid%mesh)
|
||||
CALL step_f( psvloc_at(1:pawset%grid%mesh,is), aux(1:pawset%grid%mesh), &
|
||||
pawset%grid%r(1:pawset%grid%mesh), nrs, nrc, pow, pawset%grid%mesh)
|
||||
CALL step_f( aevloc_at(1:mesh,is), aux(1:mesh), &
|
||||
pawset%grid%r(1:mesh), nrs, nrc, pow, mesh)
|
||||
aux(1:mesh) = pawset%psloc(1:mesh)
|
||||
CALL step_f( psvloc_at(1:mesh,is), aux(1:mesh), &
|
||||
pawset%grid%r(1:mesh), nrs, nrc, pow, mesh)
|
||||
DEALLOCATE (aux)
|
||||
#endif
|
||||
#endif
|
||||
|
|
|
@ -63,7 +63,7 @@ SUBROUTINE electrons()
|
|||
USE mp_global, ONLY : intra_pool_comm, npool
|
||||
USE mp, ONLY : mp_sum
|
||||
!
|
||||
USE paw_variables, ONLY : really_do_paw, okpaw, tpawp, becnew
|
||||
USE paw_variables, ONLY : okpaw, becnew
|
||||
USE paw_onecenter, ONLY : PAW_potential,PAW_integrate
|
||||
USE uspp, ONLY : becsum ! used for PAW
|
||||
USE uspp_param, ONLY : nhm ! used for PAW
|
||||
|
@ -175,11 +175,8 @@ SUBROUTINE electrons()
|
|||
!
|
||||
IF (okpaw) THEN
|
||||
IF ( .not. ALLOCATED(becstep) ) ALLOCATE (becstep(nhm*(nhm+1)/2,nat,nspin))
|
||||
becstep (:,:,:) = 0._dp
|
||||
! DO na = 1, nat
|
||||
! IF (tpawp(ityp(na))) becstep(:,na,:) = becsum(:,na,:)
|
||||
! END DO
|
||||
becstep(:,:,:) = becsum(:,:,:)
|
||||
!becstep (:,:,:) = 0._dp
|
||||
becstep(:,:,:) = becsum(:,:,:)
|
||||
END IF
|
||||
call create_scf_type ( rhoin )
|
||||
!
|
||||
|
@ -459,14 +456,12 @@ SUBROUTINE electrons()
|
|||
etot = eband + ( etxc - etxcc ) + ewld + ehart + deband + demet + descf
|
||||
!
|
||||
IF (okpaw) THEN
|
||||
correction1c = (deband_PAW + descf_PAW + e_PAW)
|
||||
PRINT '(5x,A,f12.6,A)', 'PAW correction: ',correction1c, ', composed of: '
|
||||
PRINT '(5x,A,f10.6,A,f10.6,A,f12.6)',&
|
||||
'de_band: ',deband_PAW,', de_scf: ',descf_PAW,', 1-center E: ', e_PAW
|
||||
IF (really_do_paw) THEN
|
||||
etot = etot + correction1c
|
||||
hwf_energy = hwf_energy + correction1c
|
||||
ENDIF
|
||||
correction1c = (deband_PAW + descf_PAW + e_PAW)
|
||||
PRINT '(5x,A,f12.6,A)', 'PAW correction: ',correction1c, ', composed of: '
|
||||
PRINT '(5x,A,f10.6,A,f10.6,A,f12.6)',&
|
||||
'de_band: ',deband_PAW,', de_scf: ',descf_PAW,', 1-center E: ', e_PAW
|
||||
etot = etot + correction1c
|
||||
hwf_energy = hwf_energy + correction1c
|
||||
END IF
|
||||
!
|
||||
#if defined (EXX)
|
||||
|
|
|
@ -27,27 +27,27 @@ subroutine init_us_1
|
|||
! g) It computes the q terms which define the S matrix.
|
||||
! h) It fills the interpolation table for the beta functions
|
||||
!
|
||||
USE kinds, ONLY : DP
|
||||
USE parameters, ONLY : lmaxx
|
||||
USE constants, ONLY : fpi
|
||||
USE atom, ONLY : rgrid
|
||||
USE ions_base, ONLY : ntyp => nsp
|
||||
USE cell_base, ONLY : omega, tpiba
|
||||
USE gvect, ONLY : g, gg
|
||||
USE lsda_mod, ONLY : nspin
|
||||
USE us, ONLY : nqxq, dq, nqx, tab, tab_d2y, qrad, spline_ps
|
||||
USE kinds, ONLY : DP
|
||||
USE parameters, ONLY : lmaxx
|
||||
USE constants, ONLY : fpi
|
||||
USE atom, ONLY : rgrid
|
||||
USE ions_base, ONLY : ntyp => nsp
|
||||
USE cell_base, ONLY : omega, tpiba
|
||||
USE gvect, ONLY : g, gg
|
||||
USE lsda_mod, ONLY : nspin
|
||||
USE us, ONLY : nqxq, dq, nqx, tab, tab_d2y, qrad, spline_ps
|
||||
USE splinelib
|
||||
USE uspp, ONLY : nhtol, nhtoj, nhtolm, dvan, qq, indv, ap, aainit, &
|
||||
qq_so, dvan_so, okvan
|
||||
USE uspp_param, ONLY : upf, lmaxq, nbetam, nh, nhm, lmaxkb
|
||||
USE spin_orb, ONLY : lspinorb, so, rot_ylm, fcoef
|
||||
USE paw_variables, ONLY : really_do_paw, okpaw, tpawp, aug
|
||||
USE uspp, ONLY : nhtol, nhtoj, nhtolm, dvan, qq, indv,&
|
||||
ap, aainit, qq_so, dvan_so, okvan
|
||||
USE uspp_param, ONLY : upf, lmaxq, nbetam, nh, nhm, lmaxkb
|
||||
USE spin_orb, ONLY : lspinorb, so, rot_ylm, fcoef
|
||||
USE paw_variables,ONLY : okpaw
|
||||
USE paw_init, ONLY : PAW_post_init
|
||||
!
|
||||
implicit none
|
||||
!
|
||||
! here a few local variables
|
||||
!
|
||||
|
||||
integer :: nt, ih, jh, nb, mb, ijv, l, m, ir, iq, is, startq, &
|
||||
lastq, ilast, ndm
|
||||
! various counters
|
||||
|
@ -242,8 +242,8 @@ subroutine init_us_1
|
|||
do mb = nb, upf(nt)%nbeta
|
||||
ijv = mb * (mb-1) / 2 + nb
|
||||
paw : & ! in PAW formalism aug. charge is computed elsewhere
|
||||
if (tpawp(nt)) then
|
||||
qtot(1:upf(nt)%kkbeta,ijv) = aug(nt)%fun(1:upf(nt)%kkbeta,nb,mb,l)
|
||||
if (upf(nt)%tpawp) then
|
||||
qtot(1:upf(nt)%kkbeta,ijv) = upf(nt)%paw%aug(1:upf(nt)%kkbeta,nb,mb,l)
|
||||
else
|
||||
if ( ( l >= abs(upf(nt)%lll(nb) - upf(nt)%lll(mb)) ) .and. &
|
||||
( l <= upf(nt)%lll(nb) + upf(nt)%lll(mb) ) .and. &
|
||||
|
@ -281,7 +281,7 @@ subroutine init_us_1
|
|||
if ( ( l >= abs(upf(nt)%lll(nb) - upf(nt)%lll(mb)) ) .and. &
|
||||
( l <= upf(nt)%lll(nb) + upf(nt)%lll(mb) ) .and. &
|
||||
(mod (l+upf(nt)%lll(nb)+upf(nt)%lll(mb), 2) == 0) .or.&
|
||||
tpawp(nt) ) then
|
||||
upf(nt)%tpawp ) then
|
||||
do ir = 1, upf(nt)%kkbeta
|
||||
aux1 (ir) = aux (ir) * qtot (ir, ijv)
|
||||
enddo
|
||||
|
@ -405,6 +405,11 @@ subroutine init_us_1
|
|||
deallocate (besr)
|
||||
deallocate (aux1)
|
||||
deallocate (aux)
|
||||
|
||||
! Some paw variables are used on all nodes only for initialization,
|
||||
! then they can be deallocated on all nodes but one.
|
||||
call PAW_post_init()
|
||||
|
||||
call stop_clock ('init_us_1')
|
||||
return
|
||||
end subroutine init_us_1
|
||||
|
|
|
@ -39,8 +39,7 @@ SUBROUTINE newd_g()
|
|||
USE spin_orb, ONLY : lspinorb, so, domag
|
||||
USE noncollin_module, ONLY : noncolin
|
||||
!
|
||||
USE paw_variables, ONLY : really_do_paw, okpaw, tpawp, &
|
||||
kdiff, dpaw_ae, dpaw_ps
|
||||
USE paw_variables, ONLY : okpaw, kdiff, dpaw_ae, dpaw_ps
|
||||
USE paw_onecenter, ONLY : PAW_newd
|
||||
USE uspp, ONLY : nhtol, nhtolm
|
||||
!
|
||||
|
|
|
@ -16,6 +16,8 @@ MODULE paw_init
|
|||
|
||||
PUBLIC :: PAW_init_becsum
|
||||
PUBLIC :: PAW_init_onecenter
|
||||
PUBLIC :: PAW_post_init
|
||||
|
||||
PUBLIC :: allocate_paw_internals, deallocate_paw_internals
|
||||
|
||||
!!!=========================================================================
|
||||
|
@ -42,7 +44,8 @@ MODULE paw_init
|
|||
! Called from clean_pw
|
||||
SUBROUTINE deallocate_paw_internals
|
||||
USE paw_variables
|
||||
USE ions_base, ONLY : ntyp => nsp
|
||||
USE uspp_param, ONLY : upf
|
||||
USE ions_base, ONLY : ntyp => nsp
|
||||
!
|
||||
IMPLICIT NONE
|
||||
INTEGER :: nt
|
||||
|
@ -54,22 +57,29 @@ MODULE paw_init
|
|||
!
|
||||
! Allocated in read_paw:
|
||||
DO nt = 1,ntyp
|
||||
IF(allocated(aug(nt)%fun)) DEALLOCATE (aug(nt)%fun)
|
||||
IF(allocated(upf(nt)%paw%aug)) DEALLOCATE (upf(nt)%paw%aug)
|
||||
ENDDO
|
||||
!
|
||||
END SUBROUTINE deallocate_paw_internals
|
||||
|
||||
! Deallocate variables that are used only at init and then no more necessary.
|
||||
SUBROUTINE PAW_post_init()
|
||||
! this routine does nothing at this moment...
|
||||
RETURN
|
||||
|
||||
END SUBROUTINE PAW_post_init
|
||||
|
||||
|
||||
! Initialize becsum with atomic occupations (for PAW atoms only)
|
||||
! Notice: requires exact correspondence chi <--> beta in the atom,
|
||||
! that is that all wavefunctions considered for PAW generation are
|
||||
! counted in chi (otherwise the array "oc" does not correspond to beta)
|
||||
SUBROUTINE PAW_init_becsum()
|
||||
USE kinds, ONLY : DP
|
||||
USE uspp, ONLY : becsum, nhtol, indv
|
||||
USE uspp_param, ONLY : upf, nh
|
||||
USE uspp_param, ONLY : upf, nh, upf
|
||||
USE ions_base, ONLY : nat, ityp
|
||||
USE lsda_mod, ONLY : nspin, starting_magnetization
|
||||
USE paw_variables, ONLY : tpawp, okpaw
|
||||
USE paw_variables, ONLY : okpaw
|
||||
USE paw_onecenter, ONLY : PAW_symmetrize
|
||||
IMPLICIT NONE
|
||||
INTEGER :: ispin, na, nt, ijh, ih, jh, nb, mb
|
||||
|
@ -80,7 +90,7 @@ SUBROUTINE PAW_init_becsum()
|
|||
!
|
||||
na_loop: DO na = 1, nat
|
||||
nt = ityp(na)
|
||||
is_paw: IF (tpawp(nt)) THEN
|
||||
is_paw: IF (upf(nt)%tpawp) THEN
|
||||
!
|
||||
ijh = 1
|
||||
ih_loop: DO ih = 1, nh(nt)
|
||||
|
@ -121,9 +131,9 @@ END SUBROUTINE PAW_init_becsum
|
|||
! calls PAW_rad_init to initialize onecenter integration.
|
||||
SUBROUTINE PAW_init_onecenter()
|
||||
USE ions_base, ONLY : nat, ityp
|
||||
USE paw_variables, ONLY : tpawp, xlm, saved
|
||||
USE paw_variables, ONLY : xlm, saved
|
||||
USE atom, ONLY : g => rgrid
|
||||
USE uspp_param, ONLY : lmaxq
|
||||
USE uspp_param, ONLY : lmaxq, upf
|
||||
USE lsda_mod, ONLY : nspin
|
||||
USE funct, ONLY : dft_is_gradient
|
||||
|
||||
|
@ -138,7 +148,7 @@ SUBROUTINE PAW_init_onecenter()
|
|||
DO na = first_nat, last_nat
|
||||
nt = ityp(na)
|
||||
! note that if the atom is not paw it is left unallocated
|
||||
IF ( tpawp(nt) ) THEN
|
||||
IF ( upf(nt)%tpawp ) THEN
|
||||
IF (allocated(saved(na)%v)) DEALLOCATE(saved(na)%v)
|
||||
ALLOCATE( saved(na)%v(g(nt)%mesh, lmaxq**2, nspin, 2 ) )
|
||||
! {AE|PS}
|
||||
|
|
|
@ -52,6 +52,7 @@ MODULE paw_onecenter
|
|||
USE parameters, ONLY : ntypx
|
||||
USE paw_variables, ONLY : paw_info, saved, ww, nx, lm_max, ylm, &
|
||||
xlm, dylmp, dylmt, sin_th, cos_th
|
||||
USE uspp_param, ONLY : upf
|
||||
!
|
||||
IMPLICIT NONE
|
||||
|
||||
|
@ -80,9 +81,8 @@ SUBROUTINE PAW_potential(becsum, energy, e_cmp)
|
|||
USE atom, ONLY : g => rgrid
|
||||
USE ions_base, ONLY : nat, ityp
|
||||
USE lsda_mod, ONLY : nspin
|
||||
USE uspp_param, ONLY : nhm, lmaxq
|
||||
USE paw_variables, ONLY : pfunc, ptfunc, tpawp, &
|
||||
aerho_atc, psrho_atc, aug
|
||||
USE uspp_param, ONLY : nhm, lmaxq, upf
|
||||
USE paw_variables, ONLY : pfunc, ptfunc, aerho_atc, psrho_atc
|
||||
|
||||
REAL(DP), INTENT(IN) :: becsum(nhm*(nhm+1)/2,nat,nspin)! cross band occupations
|
||||
REAL(DP),INTENT(OUT),OPTIONAL :: energy ! if present compute E[rho]
|
||||
|
@ -112,8 +112,10 @@ SUBROUTINE PAW_potential(becsum, energy, e_cmp)
|
|||
i%a = na ! the index of the atom
|
||||
i%t = ityp(na) ! the type of atom na
|
||||
i%m = g(i%t)%mesh! radial mesh size for atom na
|
||||
i%w = upf(i%t)%nwfc
|
||||
i%l = upf(i%t)%nqlc-1
|
||||
!
|
||||
ifpaw: IF (tpawp(i%t)) THEN
|
||||
ifpaw: IF (upf(i%t)%tpawp) THEN
|
||||
!
|
||||
! Arrays are allocated inside the cycle to allow reduced
|
||||
! memory usage as differnt atoms have different meshes (they
|
||||
|
@ -122,7 +124,6 @@ SUBROUTINE PAW_potential(becsum, energy, e_cmp)
|
|||
ALLOCATE(v_lm(i%m,lmaxq**2,nspin))
|
||||
!
|
||||
whattodo: DO i_what = AE, PS
|
||||
i%w = i_what ! spherical_gradient likes to know
|
||||
! STEP: 1 [ build rho_lm (PAW_rho_lm) ]
|
||||
NULLIFY(rho_core)
|
||||
IF (i_what == AE) THEN
|
||||
|
@ -134,31 +135,31 @@ SUBROUTINE PAW_potential(becsum, energy, e_cmp)
|
|||
! sign to sum up the enrgy
|
||||
sgn = +1._dp
|
||||
ELSE
|
||||
CALL PAW_rho_lm(i, becsum, ptfunc, rho_lm, aug)
|
||||
CALL PAW_rho_lm(i, becsum, ptfunc, rho_lm, upf(i%t)%paw%aug)
|
||||
! optional argument for pseudo part --> ^^^
|
||||
rho_core => psrho_atc ! as before
|
||||
sgn = -1._dp ! as before
|
||||
ENDIF
|
||||
|
||||
! cleanup previously stored potentials
|
||||
saved(i%a)%v(:,:,:,i%w) = 0._dp
|
||||
saved(i%a)%v(:,:,:,i_what) = 0._dp
|
||||
! First compute the Hartree potential (it does not depend on spin...):
|
||||
CALL PAW_h_potential(i, rho_lm, v_lm(:,:,1), energy)
|
||||
! using "energy" as the in/out parameter I save a double call, but I have to do this:
|
||||
IF (present(energy)) energy_h = energy
|
||||
DO is = 1,nspin ! ... so it has to be copied to all spin components
|
||||
saved(i%a)%v(:,:,is,i%w) = v_lm(:,:,1)
|
||||
saved(i%a)%v(:,:,is,i_what) = v_lm(:,:,1)
|
||||
ENDDO
|
||||
|
||||
! Than the XC one:
|
||||
CALL PAW_xc_potential(i, rho_lm, rho_core, v_lm, energy)
|
||||
IF (present(energy)) energy_xc = energy
|
||||
saved(i%a)%v(:,:,:,i%w) = saved(i%a)%v(:,:,:,i_what) &
|
||||
saved(i%a)%v(:,:,:,i_what) = saved(i%a)%v(:,:,:,i_what) &
|
||||
+ v_lm(:,:,:)
|
||||
IF (present(energy)) energy_tot = energy_tot + sgn*(energy_xc + energy_h)
|
||||
IF (present(e_cmp)) THEN
|
||||
e_cmp(na, 1, i%w) = energy_xc
|
||||
e_cmp(na, 2, i%w) = energy_h
|
||||
e_cmp(na, 1, i_what) = energy_xc
|
||||
e_cmp(na, 2, i_what) = energy_h
|
||||
ENDIF
|
||||
ENDDO whattodo
|
||||
DEALLOCATE(rho_lm, v_lm)
|
||||
|
@ -186,8 +187,7 @@ SUBROUTINE PAW_symmetrize(becsum)
|
|||
USE ions_base, ONLY : nat, ityp
|
||||
USE symme, ONLY : nsym, irt, d1, d2, d3
|
||||
USE uspp, ONLY : nhtolm,nhtol
|
||||
USE uspp_param, ONLY : nh
|
||||
USE paw_variables, ONLY : tpawp
|
||||
USE uspp_param, ONLY : nh, upf
|
||||
USE wvfct, ONLY : gamma_only
|
||||
USE control_flags, ONLY : nosym
|
||||
|
||||
|
@ -260,7 +260,7 @@ SUBROUTINE PAW_symmetrize(becsum)
|
|||
DO na = 1, nat
|
||||
nt = ityp(na)
|
||||
! No need to symmetrize non-PAW atoms
|
||||
IF ( .not. tpawp(nt) ) CYCLE
|
||||
IF ( .not. upf(nt)%tpawp ) CYCLE
|
||||
!
|
||||
DO ih = 1, nh(nt)
|
||||
DO jh = ih, nh(nt) ! note: jh >= ih
|
||||
|
@ -352,9 +352,9 @@ SUBROUTINE PAW_newd(d_ae, d_ps)
|
|||
USE lsda_mod, ONLY : nspin
|
||||
USE ions_base, ONLY : nat, ityp
|
||||
USE atom, ONLY : g => rgrid
|
||||
USE paw_variables, ONLY : pfunc, ptfunc, tpawp, aug, &
|
||||
USE paw_variables, ONLY : pfunc, ptfunc, &
|
||||
aevloc_at, psvloc_at, ra=>nraug
|
||||
USE uspp_param, ONLY : nh, nhm, lmaxq
|
||||
USE uspp_param, ONLY : nh, nhm, lmaxq, upf
|
||||
|
||||
REAL(DP), TARGET, INTENT(INOUT) :: d_ae( nhm, nhm, nat, nspin)
|
||||
REAL(DP), TARGET, INTENT(INOUT) :: d_ps( nhm, nhm, nat, nspin)
|
||||
|
@ -393,14 +393,15 @@ SUBROUTINE PAW_newd(d_ae, d_ps)
|
|||
i%a = na ! the index of the atom
|
||||
i%t = ityp(na) ! the type of atom na
|
||||
! skip non-paw atoms
|
||||
IF ( .not. tpawp(i%t) ) CYCLE
|
||||
IF ( .not. upf(i%t)%tpawp ) CYCLE
|
||||
i%m = g(i%t)%mesh! radial mesh size for atom na
|
||||
i%w = upf(i%t)%nwfc
|
||||
i%l = upf(i%t)%nqlc-1
|
||||
!
|
||||
! Different atoms may have different mesh sizes:
|
||||
ALLOCATE(pfunc_lm(i%m, lmaxq**2, nspin))
|
||||
!
|
||||
whattodo: DO i_what = AE, PS
|
||||
i%w = i_what
|
||||
!
|
||||
spins: DO is = 1, nspin
|
||||
nmb = 0
|
||||
|
@ -411,12 +412,12 @@ SUBROUTINE PAW_newd(d_ae, d_ps)
|
|||
!
|
||||
! compute the density from a single pfunc
|
||||
becfake(nmb,na,is) = 1._dp
|
||||
IF (i%w == AE) THEN
|
||||
IF (i_what == AE) THEN
|
||||
CALL PAW_rho_lm(i, becfake, pfunc, pfunc_lm)
|
||||
v_at => aevloc_at
|
||||
d => d_ae
|
||||
ELSE
|
||||
CALL PAW_rho_lm(i, becfake, ptfunc, pfunc_lm, aug)
|
||||
CALL PAW_rho_lm(i, becfake, ptfunc, pfunc_lm, upf(i%t)%paw%aug)
|
||||
v_at => psvloc_at
|
||||
d => d_ps
|
||||
ENDIF
|
||||
|
@ -426,10 +427,10 @@ SUBROUTINE PAW_newd(d_ae, d_ps)
|
|||
DO lm = 1,lmaxq**2
|
||||
IF ( lm == 1 ) THEN
|
||||
pfunc_lm(1:i%m,lm,is) = pfunc_lm(1:i%m,lm,is) * &
|
||||
( saved(i%a)%v(1:i%m,lm,is,i%w) + e2*sqrtpi*v_at(1:i%m,i%t) )
|
||||
( saved(i%a)%v(1:i%m,lm,is,i_what) + e2*sqrtpi*v_at(1:i%m,i%t) )
|
||||
ELSE
|
||||
pfunc_lm(1:i%m,lm,is) = pfunc_lm(1:i%m,lm,is) * &
|
||||
saved(i%a)%v(1:i%m,lm,is,i%w)
|
||||
saved(i%a)%v(1:i%m,lm,is,i_what)
|
||||
ENDIF
|
||||
!
|
||||
! Integrate!
|
||||
|
@ -470,8 +471,8 @@ FUNCTION PAW_integrate(becsum)
|
|||
USE lsda_mod, ONLY : nspin
|
||||
USE ions_base, ONLY : nat, ityp
|
||||
USE atom, ONLY : g => rgrid
|
||||
USE paw_variables, ONLY : pfunc, ptfunc, tpawp, aug
|
||||
USE uspp_param, ONLY : nhm, lmaxq
|
||||
USE paw_variables, ONLY : pfunc, ptfunc
|
||||
USE uspp_param, ONLY : nhm, lmaxq, upf
|
||||
|
||||
REAL(DP) :: PAW_integrate
|
||||
|
||||
|
@ -499,19 +500,20 @@ FUNCTION PAW_integrate(becsum)
|
|||
i%a = na ! the index of the atom
|
||||
i%t = ityp(na) ! the type of atom na
|
||||
i%m = g(i%t)%mesh! radial mesh size for atom na
|
||||
i%w = upf(i%t)%nwfc
|
||||
i%l = upf(i%t)%nqlc-1
|
||||
!
|
||||
ifpaw: IF (tpawp(i%t)) THEN
|
||||
ifpaw: IF (upf(i%t)%tpawp) THEN
|
||||
!
|
||||
ALLOCATE(rho_lm(i%m,lmaxq**2,nspin))
|
||||
!
|
||||
whattodo: DO i_what = AE, PS
|
||||
i%w = i_what
|
||||
!
|
||||
IF (i%w == AE) THEN
|
||||
IF (i_what == AE) THEN
|
||||
CALL PAW_rho_lm(i, becsum, pfunc, rho_lm)
|
||||
i_sign = +1._dp
|
||||
ELSE
|
||||
CALL PAW_rho_lm(i, becsum, ptfunc, rho_lm, aug)
|
||||
CALL PAW_rho_lm(i, becsum, ptfunc, rho_lm, upf(i%t)%paw%aug)
|
||||
i_sign = -1._dp
|
||||
ENDIF
|
||||
!
|
||||
|
@ -520,7 +522,7 @@ FUNCTION PAW_integrate(becsum)
|
|||
DO lm = 1, lmaxq**2
|
||||
! I can use rho_lm itself as workspace
|
||||
rho_lm(1:i%m,lm,is) = rho_lm(1:i%m,lm,is) &
|
||||
* saved(i%a)%v(1:i%m,lm,is,i%w)
|
||||
* saved(i%a)%v(1:i%m,lm,is,i_what)
|
||||
CALL simpson (i%m,rho_lm(:,lm,is),g(i%t)%rab,integral)
|
||||
!WRITE(6,"(3i3,10f20.10)") i_what, is, lm, integral
|
||||
PAW_integrate = PAW_integrate + i_sign*integral
|
||||
|
@ -552,8 +554,8 @@ FUNCTION PAW_ddot(bec1,bec2)
|
|||
USE lsda_mod, ONLY : nspin
|
||||
USE ions_base, ONLY : nat, ityp
|
||||
USE atom, ONLY : g => rgrid
|
||||
USE paw_variables, ONLY : pfunc, ptfunc, tpawp, aug
|
||||
USE uspp_param, ONLY : nhm, lmaxq
|
||||
USE paw_variables, ONLY : pfunc, ptfunc
|
||||
USE uspp_param, ONLY : nhm, lmaxq, upf
|
||||
|
||||
REAL(DP) :: PAW_ddot
|
||||
|
||||
|
@ -586,8 +588,10 @@ FUNCTION PAW_ddot(bec1,bec2)
|
|||
i%a = na ! the index of the atom
|
||||
i%t = ityp(na) ! the type of atom na
|
||||
i%m = g(i%t)%mesh ! radial mesh size for atom na
|
||||
i%w = upf(i%t)%nwfc
|
||||
i%l = upf(i%t)%nqlc-1
|
||||
!
|
||||
ifpaw: IF (tpawp(i%t)) THEN
|
||||
ifpaw: IF (upf(i%t)%tpawp) THEN
|
||||
!
|
||||
ALLOCATE(rho_lm(i%m,lmaxq**2,nspin))
|
||||
ALLOCATE(v_lm(i%m,lmaxq**2))
|
||||
|
@ -598,7 +602,7 @@ FUNCTION PAW_ddot(bec1,bec2)
|
|||
CALL PAW_rho_lm(i, bec1, pfunc, rho_lm)
|
||||
i_sign = +1._dp
|
||||
ELSE
|
||||
CALL PAW_rho_lm(i, bec1, ptfunc, rho_lm, aug) !fun)
|
||||
CALL PAW_rho_lm(i, bec1, ptfunc, rho_lm, upf(i%t)%paw%aug)
|
||||
i_sign = -1._dp
|
||||
ENDIF
|
||||
!
|
||||
|
@ -609,7 +613,7 @@ FUNCTION PAW_ddot(bec1,bec2)
|
|||
IF (i_what == AE) THEN
|
||||
CALL PAW_rho_lm(i, bec2, pfunc, rho_lm)
|
||||
ELSE
|
||||
CALL PAW_rho_lm(i, bec2, ptfunc, rho_lm, aug) !fun)
|
||||
CALL PAW_rho_lm(i, bec2, ptfunc, rho_lm, upf(i%t)%paw%aug)
|
||||
ENDIF
|
||||
!
|
||||
! Finally compute the integral
|
||||
|
@ -1132,15 +1136,15 @@ SUBROUTINE PAW_rho_lm(i, becsum, pfunc, rho_lm, aug)
|
|||
USE parameters, ONLY : lqmax
|
||||
USE constants, ONLY : eps12
|
||||
USE radial_grids, ONLY : ndmx
|
||||
USE paw_variables, ONLY : augfun_t, nbrx
|
||||
USE paw_variables, ONLY : nbrx
|
||||
USE atom, ONLY : g => rgrid
|
||||
|
||||
TYPE(paw_info) :: i ! atom's minimal info
|
||||
REAL(DP), INTENT(IN) :: becsum(nhm*(nhm+1)/2,nat,nspin)! cross band occupation
|
||||
REAL(DP), INTENT(IN) :: pfunc(ndmx,nbrx,nbrx,ntyp) ! psi_i * psi_j
|
||||
REAL(DP), INTENT(OUT) :: rho_lm(i%m,lmaxq**2,nspin) ! AE charge density on rad. grid
|
||||
TYPE(augfun_t), OPTIONAL,INTENT(IN) :: &
|
||||
aug(ntyp) ! augmentation functions (only for PS part)
|
||||
REAL(DP), OPTIONAL,INTENT(IN) :: &
|
||||
aug(i%m,i%w,i%w,0:2*i%l) ! augmentation functions (only for PS part)
|
||||
|
||||
REAL(DP) :: pref ! workspace (ap*becsum)
|
||||
|
||||
|
@ -1188,7 +1192,7 @@ SUBROUTINE PAW_rho_lm(i, becsum, pfunc, rho_lm, aug)
|
|||
! if I'm doing the pseudo part I have to add the augmentation charge
|
||||
l = INT(SQRT(DBLE(lm-1))) ! l has to start from zero
|
||||
rho_lm(1:i%m,lm,ispin) = rho_lm(1:i%m,lm,ispin) +&
|
||||
pref * aug(i%t)%fun(1:i%m, indv(nb,i%t), indv(mb,i%t), l)
|
||||
pref * aug(1:i%m, indv(nb,i%t), indv(mb,i%t), l)
|
||||
ENDIF ! augfun
|
||||
ENDDO angular_momentum
|
||||
ENDDO !mb
|
||||
|
|
|
@ -42,7 +42,7 @@ SUBROUTINE read_file()
|
|||
USE pw_restart, ONLY : pw_readfile
|
||||
USE xml_io_base, ONLY : pp_check_file
|
||||
USE uspp, ONLY : okvan
|
||||
USE paw_variables, ONLY : okpaw, tpawp
|
||||
USE paw_variables, ONLY : okpaw
|
||||
USE paw_init, ONLY : paw_init_onecenter, allocate_paw_internals
|
||||
USE ldaU, ONLY : v_hub, eth
|
||||
!
|
||||
|
@ -153,7 +153,7 @@ SUBROUTINE read_file()
|
|||
CALL readpp()
|
||||
!
|
||||
okvan = ANY ( upf(:)%tvanp )
|
||||
okpaw = ANY ( tpawp(1:nsp) )
|
||||
okpaw = ANY ( upf(1:nsp)%tpawp )
|
||||
!
|
||||
! ... check for spin-orbit pseudopotentials
|
||||
!
|
||||
|
|
|
@ -27,7 +27,6 @@ subroutine readpp
|
|||
USE io_global, ONLY : stdout
|
||||
USE ions_base, ONLY : zv
|
||||
USE uspp_param, ONLY : upf
|
||||
USE paw_variables, ONLY : tpawp
|
||||
USE read_paw_module, ONLY : paw_io, allocate_pseudo_paw, deallocate_pseudo_paw
|
||||
USE paw_to_internal, ONLY : set_pseudo_paw
|
||||
implicit none
|
||||
|
@ -55,7 +54,6 @@ subroutine readpp
|
|||
END IF
|
||||
ALLOCATE ( upf(ntyp) )
|
||||
do nt = 1, ntyp
|
||||
!tpawp(nt) = .false.
|
||||
!
|
||||
! obsolescent variables, not read from UPF format, no longer used
|
||||
!
|
||||
|
|
|
@ -86,7 +86,7 @@ SUBROUTINE setup()
|
|||
USE exx, ONLY : exx_grid_init
|
||||
#endif
|
||||
USE funct, ONLY : dft_is_meta, dft_is_hybrid, dft_is_gradient
|
||||
USE paw_variables, ONLY : okpaw, tpawp
|
||||
USE paw_variables, ONLY : okpaw
|
||||
!
|
||||
IMPLICIT NONE
|
||||
!
|
||||
|
@ -698,7 +698,7 @@ SUBROUTINE setup()
|
|||
! ... okvan = .TRUE. : at least one pseudopotential is US
|
||||
!
|
||||
okvan = ANY( upf(:)%tvanp )
|
||||
okpaw = ANY( tpawp(1:ntyp) )
|
||||
okpaw = ANY( upf(1:ntyp)%tpawp )
|
||||
!
|
||||
! ... Needed for LDA+U and PAW
|
||||
!
|
||||
|
|
|
@ -406,7 +406,6 @@ SUBROUTINE print_ps_info
|
|||
USE ions_base, ONLY : ntyp => nsp
|
||||
USE atom, ONLY : rgrid
|
||||
USE uspp_param, ONLY : upf
|
||||
USE paw_variables, ONLY: tpawp
|
||||
!
|
||||
INTEGER :: nt
|
||||
CHARACTER :: ps*35
|
||||
|
@ -415,7 +414,7 @@ SUBROUTINE print_ps_info
|
|||
!
|
||||
IF ( upf(nt)%tvanp ) THEN
|
||||
ps='Ultrasoft'
|
||||
ELSE IF ( tpawp (nt) ) THEN
|
||||
ELSE IF ( upf(nt)%tpawp ) THEN
|
||||
ps="Projector augmented-wave"
|
||||
ELSE
|
||||
ps='Norm-conserving'
|
||||
|
|
Loading…
Reference in New Issue