scnc
/
quantum-espresso
mirror of https://gitlab.com/QEF/q-e.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Added the possibility to generate PAW dataset with rel=2 (still experimental). 

Sligthly different r->0 behaviour in PSQ pseudization.


git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@5777 c92efa57-630b-4861-b058-cf58834340f0
This commit is contained in:
dalcorso 2009-07-30 12:45:53 +00:00
parent 8f64d3cacb
commit 51e4cdeafd
6 changed files with 50 additions and 51 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

42
atomic/atomic_paw.f90
View File

@ -70,7 +70,7 @@ CONTAINS
! Compute also the total energy
!
SUBROUTINE new_paw_hamiltonian (veffps_, ddd_, etot_, &
pawset_, nwfc_, l_, nspin_, spin_, oc_, pswfc_, eig_, paw_energy,dddion_)
pawset_, nwfc_, l_, j_, nspin_, spin_, oc_, pswfc_, eig_, paw_energy,dddion_)
IMPLICIT NONE
REAL(dp), INTENT(OUT) :: veffps_(ndmx,2)
REAL(dp), INTENT(OUT) :: ddd_(nwfsx,nwfsx,2)
@ -80,6 +80,7 @@ CONTAINS
INTEGER, INTENT(IN) :: l_(nwfsx)
INTEGER, INTENT(IN) :: nspin_
INTEGER, INTENT(IN) :: spin_(nwfsx)
REAL(dp), INTENT(IN) :: j_(nwfsx)
REAL(dp), INTENT(IN) :: oc_(nwfsx)
REAL(dp), INTENT(IN) :: pswfc_(ndmx,nwfsx)
REAL(dp), INTENT(IN) :: eig_(nwfsx)
@ -92,12 +93,12 @@ CONTAINS
chargeps(ndmx,2), charge1(ndmx,2), charge1ps(ndmx,2), & ! charges.
projsum(nwfsx,nwfsx,2), eigsum ! sum of projections, sum of eigenval.
!
INTEGER :: ns, ns1, is, n
REAL(dp) :: aux(ndmx), energy(5,3)
INTEGER :: ns, is, n
REAL(dp) :: energy(5,3)
!
! Compute the valence charges
CALL compute_charges(projsum, chargeps, charge1, charge1ps, &
pawset_, nwfc_, l_, nspin_, spin_, oc_, pswfc_, 1 )
pawset_, nwfc_, l_, j_, nspin_, spin_, oc_, pswfc_, 1 )
!
! Check for negative charge
!
@ -200,7 +201,7 @@ CONTAINS
REAL(DP), EXTERNAL :: int_0_inf_dr
CHARACTER, EXTERNAL :: atom_name*2
REAL(dp) :: vps(ndmx,2), projsum(nwfsx,nwfsx,2), ddd(nwfsx,nwfsx,2), dddion(nwfsx,nwfsx)
INTEGER :: irc, ns, ns1, n, l, leading_power, mesh, ios
INTEGER :: irc, ns, ns1, n, leading_power, mesh, ios
REAL(dp) :: aux(ndmx), aux2(ndmx,2), raux
REAL(dp) :: aecharge(ndmx,2), pscharge(ndmx,2)
REAL(dp) :: etot
@ -486,7 +487,7 @@ CONTAINS
pawset_%aeloc(1:mesh)=aevtot(1:mesh)
! and descreen them:
CALL compute_charges(projsum, pscharge, aecharge, aux2, &
pawset_, nbeta, lls, nspin, spin, ocs, phis )
pawset_, nbeta, lls, jjs, nspin, spin, ocs, phis )
pawset_%pscharge(1:mesh)=pscharge(1:mesh,1)
!
CALL compute_onecenter_energy ( raux, aux2, &
@ -520,7 +521,7 @@ CONTAINS
!
! Generate the paw hamiltonian for test (should be equal to the US one)
CALL new_paw_hamiltonian (vps, ddd, etot, &
pawset_, pawset_%nwfc, pawset_%l, nspin, spin, pawset_%oc, pawset_%pswfc, pawset_%enl, energy, dddion)
pawset_, pawset_%nwfc, pawset_%l, pawset_%jj, nspin, spin, pawset_%oc, pawset_%pswfc, pawset_%enl, energy, dddion)
pawset_%dion(1:nbeta,1:nbeta)=dddion(1:nbeta,1:nbeta)
WRITE(stdout,'(/5x,A,f12.6,A)') 'Estimated PAW energy =',etot,' Ryd'
WRITE(stdout,'(/5x,A)') 'The PAW screened D coefficients'
@ -617,7 +618,6 @@ CONTAINS
USE io_global, ONLY : stdout
IMPLICIT NONE
TYPE(paw_t), INTENT(IN) :: pawset_
REAL(dp):: zval
INTEGER:: mesh
REAL(dp) :: r(ndmx), r2(ndmx), sqr(ndmx), dx
INTEGER :: nbeta
@ -666,7 +666,7 @@ CONTAINS
!============================================================================
!
SUBROUTINE compute_charges (projsum_, chargeps_, charge1_, charge1ps_, &
pawset_, nwfc_, l_, nspin_, spin_, oc_, pswfc_ , iflag, unit_)
pawset_, nwfc_, l_, j_, nspin_, spin_, oc_, pswfc_ , iflag, unit_)
USE io_global, ONLY : ionode
IMPLICIT NONE
REAL(dp), INTENT(OUT) :: projsum_(nwfsx,nwfsx,2)
@ -678,16 +678,17 @@ CONTAINS
INTEGER, INTENT(IN) :: l_(nwfsx)
INTEGER, INTENT(IN) :: nspin_
INTEGER, INTENT(IN) :: spin_(nwfsx)
REAL(dp), INTENT(IN) :: j_(nwfsx)
REAL(dp), INTENT(IN) :: oc_(nwfsx)
REAL(dp), INTENT(IN) :: pswfc_(ndmx,nwfsx)
INTEGER, OPTIONAL :: unit_, iflag
REAL(dp) :: augcharge(ndmx,2), chargetot
INTEGER :: i, n, ns, ns1, iflag0
INTEGER :: i, n, iflag0
iflag0=0
if (present(iflag)) iflag0=iflag
CALL compute_sumwfc2(chargeps_,pawset_,nwfc_,pswfc_,oc_,spin_)
CALL compute_projsum(projsum_,pawset_,nwfc_,l_,spin_,pswfc_,oc_)
CALL compute_projsum(projsum_,pawset_,nwfc_,l_,j_,spin_,pswfc_,oc_)
! WRITE (6200,'(20e20.10)') ((projsum_(ns,ns1,1),ns=1,ns1),ns1=1,pawset_%nwfc)
CALL compute_onecenter_charge(charge1ps_,pawset_,projsum_,nspin_,"PS")
CALL compute_onecenter_charge(charge1_ ,pawset_,projsum_,nspin_,"AE")
@ -767,7 +768,7 @@ CONTAINS
rhc, & ! core charge at a given point without 4 pi r^2
vxcr(2) ! exchange-correlation potential at a given point
!
INTEGER :: ns, i, is
INTEGER :: i, is
INTEGER :: lsd
REAL(DP), EXTERNAL :: int_0_inf_dr
#if defined __DEBUG_V_H_vs_SPHEROPOLE
@ -877,7 +878,7 @@ CONTAINS
REAL(dp), INTENT(IN) :: veffps_(ndmx,2)
REAL(dp), INTENT(IN) :: veff1_(ndmx,2)
REAL(dp), INTENT(IN) :: veff1ps_(ndmx,2)
INTEGER :: is, ns, ns1, l
INTEGER :: is, ns, ns1
REAL(dp) :: aux(ndmx), dd
REAL(DP), EXTERNAL :: int_0_inf_dr
! REAL(dp):: dddd(nwfsx,nwfsx,3) = 0.d0
@ -889,7 +890,8 @@ CONTAINS
DO is=1,nspin_
DO ns=1,pawset_%nwfc
DO ns1=1,ns
IF (pawset_%l(ns)==pawset_%l(ns1)) THEN
IF (pawset_%l(ns)==pawset_%l(ns1).and.&
ABS(pawset_%jj(ns)-pawset_%jj(ns1))<1.d-8) THEN
! Int[Q*v~]
aux(1:pawset_%grid%mesh) = &
pawset_%augfun(1:pawset_%grid%mesh,ns,ns1,0) * &
@ -937,7 +939,7 @@ CONTAINS
IMPLICIT NONE
REAL(dp), INTENT(OUT) :: ddd_(nwfsx,nwfsx)
TYPE(paw_t), INTENT(IN) :: pawset_
INTEGER :: ns, ns1, l
INTEGER :: ns, ns1
REAL(dp) :: aux(ndmx), dd
REAL(DP), EXTERNAL :: int_0_inf_dr
!
@ -948,7 +950,8 @@ CONTAINS
ddd_(:,:)=ZERO
DO ns=1,pawset_%nwfc
DO ns1=1,ns
IF (pawset_%l(ns)==pawset_%l(ns1)) THEN
IF (pawset_%l(ns)==pawset_%l(ns1).and. &
ABS(pawset_%jj(ns)-pawset_%jj(ns1))<1.d-8 ) THEN
! Int[ae*v1*ae]
aux(1:pawset_%grid%mesh) = &
pawset_%aewfc(1:pawset_%grid%mesh,ns ) * &
@ -1021,12 +1024,13 @@ CONTAINS
!
! Compute Sum_n oc_n <pswfc_n|proj_i> <proj_j|pswfc_n>
!
SUBROUTINE compute_projsum (projsum_, pawset_, nwfc_, l_, spin_, pswfc_, oc_)
SUBROUTINE compute_projsum (projsum_, pawset_, nwfc_, l_, j_, spin_, pswfc_, oc_)
REAL(dp), INTENT(OUT) :: projsum_(nwfsx,nwfsx,2)
TYPE(paw_t), INTENT(IN) :: pawset_
INTEGER, INTENT(IN) :: nwfc_
INTEGER, INTENT(IN) :: l_(nwfsx)
INTEGER, INTENT(IN) :: spin_(nwfsx)
REAL(dp), INTENT(IN) :: j_(nwfsx)
REAL(dp), INTENT(IN) :: pswfc_(ndmx,nwfsx)
REAL(dp), INTENT(IN) :: oc_(nwfsx)
REAL(dp) :: proj_dot_wfc(nwfsx,nwfsx), aux(ndmx)
@ -1035,7 +1039,7 @@ CONTAINS
! Compute <projector|wavefunction>
DO ns=1,pawset_%nwfc
DO nf=1,nwfc_
IF (pawset_%l(ns)==l_(nf)) THEN
IF (pawset_%l(ns)==l_(nf).AND.pawset_%jj(ns)==j_(nf)) THEN
DO nr=1,pawset_%grid%mesh
aux(nr)=pawset_%proj(nr,ns)*pswfc_(nr,nf)
END DO
@ -1073,7 +1077,7 @@ CONTAINS
TYPE(paw_t), INTENT(IN) :: pawset_
REAL(dp), INTENT(IN) :: projsum_(nwfsx,nwfsx,2)
INTEGER, INTENT(IN) :: nspin_
INTEGER :: ns, ns1, is, l
INTEGER :: ns, ns1, is
REAL(dp) :: factor
augcharge_=ZERO
DO is=1,nspin_

5
atomic/compute_q_3bess.f90
View File

@ -74,14 +74,15 @@ subroutine compute_q_3bess(ldip,lam,ik,chir,phi_out,ecutrho)
! spherical Bessel functions for r < r(ik)
! find q_i with the correct log derivatives
!
call find_qi(f1ae/fae,xc(nbes+1),ik,lam,nbes,2,iok)
call find_qi(f1ae/fae,xc(nbes+1),ik,ldip,nbes,2,iok)
if (iok.ne.0) &
call errore('compute_q_3bess', 'problem with the q_i coefficients', 1)
!
! compute the Bessel functions and multiply by r**2
!
do nc=1,nbes
call sph_bes(ik+5,grid%r,xc(nbes+nc),lam,j1(1,nc))
call sph_bes(ik+5,grid%r,xc(nbes+nc),ldip,j1(1,nc))
jnor=j1(ik,nc)*grid%r2(ik)
do n=1,ik+5
j1(n,nc)=j1(n,nc)*grid%r2(n)*chir(ik)/jnor

28
atomic/gener_pseudo.f90
View File

@ -51,7 +51,6 @@ subroutine gener_pseudo
ikloc, & ! the point corresponding to rc local
ns, & ! counter on pseudo functions
ns1, & ! counter on pseudo functions
ib,jb, & ! counter on beta functions
nnode, & ! the number of nodes of phi
lam ! the angular momentum
@ -59,8 +58,8 @@ subroutine gener_pseudo
xc(8), & ! parameters of bessel functions
psi_in(ndmx), & ! the all_electron wavefunction
gi(ndmx,2), & ! auxiliary to compute the integrals
occ, &
sum, db, work(nwfsx) ! work space
occ, norm1, &
db, work(nwfsx) ! work space
real(DP), allocatable :: &
b(:,:), binv(:,:) ! the B matrix and its inverse
@ -74,8 +73,8 @@ subroutine gener_pseudo
int_0_inf_dr ! the function calculating the integral
integer :: &
m, n, l, n1, n2, nwf0, nst, ikl, imax, iwork(nwfsx), &
is, nbf, nc, ios, ind, nmax
n, nwf0, nst, ikl, &
is, ios, ind, nmax
character(len=5) :: indqvan
character(len=256) :: filename
@ -88,8 +87,7 @@ subroutine gener_pseudo
! generation (normally the AE potential)
integer :: iknc2paw ! point in rgrid closer to rcutnc2paw
real(DP) :: q, fac, vq, pi, wrk(ndmx), jlq(ndmx), norm(nwfsx), normr(nwfsx)
integer :: ll
real(DP) :: q, fac, pi, wrk(ndmx), jlq(ndmx), norm(nwfsx), normr(nwfsx)
if (lpaw) then
write(stdout, &
@ -150,7 +148,14 @@ subroutine gener_pseudo
if (new(ns)) then
call set_psi_in(ik,lls(ns),jjs(ns),enls(ns),psipaw(1,ns))
else
lam=lls(ns)
nst=(lam+1)*2
psipaw(:,ns)=psi(:,1,nwf0)
do n=1,grid%mesh
gi(n,1)=psipaw(n,ns)*psipaw(n,ns)
enddo
norm1=sqrt(int_0_inf_dr(gi,grid,grid%mesh,nst))
psipaw(:,ns)=psipaw(:,ns)/norm1
endif
enddo
@ -251,14 +256,6 @@ subroutine gener_pseudo
call compute_chi(lam,ikk(ns),phis(1,ns),chis(1,ns),xc,enls(ns),lbes4)
endif
enddo
! do n=1,mesh
! write(stdout,'(5e15.7)') r(n),psipsus(n,1),chis(n,1),
! + psipsus(n,2),chis(n,2)
! enddo
! stop
!
! for each angular momentum take the same integration point
!
@ -405,7 +402,6 @@ subroutine gener_pseudo
!
IF (which_augfun=='PSQ'.and..not.lpaw) CALL pseudo_q(qvan,qvanl)
!
!
! generate a PAW dataset if required
!
if (lpaw) then

6
atomic/import_upf.f90
View File

@ -202,8 +202,12 @@ INTEGER :: mesh, nbeta,ih,jh,ijh
mesh=upf_%mesh
pawset_%augfun=0.0_DP
pawset_%augmom=0.0_DP
pawset_%jj(:) = 0.0_DP
pawset_%enl(:) = 0.0_DP
if (upf_%has_so) then
pawset_%jj(1:nbeta) = upf_%jjj(1:nbeta)
else
pawset_%jj(:) = 0.0_DP
endif
pawset_%l(1:nbeta) = upf_%lll(1:nbeta)
pawset_%ikk(1:nbeta) = upf_%kbeta(1:nbeta)
pawset_%oc(1:nbeta) = upf_%paw%oc(1:nbeta)

3
atomic/ld1_readin.f90
View File

@ -269,6 +269,7 @@ subroutine ld1_readin
! No lsda with pseudopotential generation
!
if (iswitch > 2) lsd = 0
if (iswitch==2) tm=.true.
if (lsd == 0) then
nspin = 1
else if(lsd == 1) then
@ -615,8 +616,6 @@ subroutine ld1_readin
lsave_wfc = .true.
if (pseudotype /= 3) call errore('ld1_readin', &
'please start from a US for generating a PAW dataset' ,pseudotype)
if (rel > 1) call errore('ld1_readin', &
'relativistic PAW not implemented' ,rel)
if (latt /= 0) call errore('ld1_readin', &
'Latter correction not implemented in PAW' ,latt)
call errore('ld1_readin', &

17
atomic/run_pseudo.f90
View File

@ -29,27 +29,23 @@ subroutine run_pseudo
integer :: &
ns, & ! counter on pseudowavefunctions
n, & ! counter on mesh
is, & ! counter on spin
nbf ! number of beta functions
is ! counter on spin
real(DP) :: &
vaux(ndmx), & ! auxiliary variable
vnew(ndmx,2) ! the potential
integer :: &
n1,n2,nst,ikl,ind,ios
ios
logical :: &
conv ! if true convergence reached
real(DP) :: &
nvalts, & ! number of valence electrons for this conf.
dddnew(nwfsx,nwfsx,2), & ! the new D coefficients
vd(2*(ndmx+nwfsx+nwfsx)), & ! Vloc and D in one array for mixing
vdnew(2*(ndmx+nwfsx+nwfsx)) ! the new vd array
integer :: &
nerr, & ! error message
iswstart(nwfsx) ! guess for the starting spins
nerr ! error message
real(DP), parameter :: thresh=1.e-10_dp
integer, parameter :: itmax=200
@ -69,7 +65,7 @@ subroutine run_pseudo
call start_potps ( )
else
CALL new_paw_hamiltonian (vpstot, ddd, etots,pawsetup, nwfts, &
llts, nspin, iswts, octs, phits, enlts)
llts, jjts, nspin, iswts, octs, phits, enlts)
do is=1,nspin
vpstot(1:grid%mesh,is)=vpstot(1:grid%mesh,is)-pawsetup%psloc(1:grid%mesh)
enddo
@ -135,7 +131,7 @@ subroutine run_pseudo
else
!
call new_paw_hamiltonian (vnew, dddnew, etots, &
pawsetup, nwfts, llts, nspin, iswts, octs, phits, enlts)
pawsetup, nwfts, llts, jjts, nspin, iswts, octs, phits, enlts)
do is=1,nspin
vnew(1:grid%mesh,is)=vnew(1:grid%mesh,is)-pawsetup%psloc(1:grid%mesh)
enddo
@ -161,7 +157,6 @@ subroutine run_pseudo
endif
enddo
call infomsg('run_pseudo','convergence not achieved')
!
! final calculation with all states
!
@ -173,7 +168,7 @@ subroutine run_pseudo
call elsdps ( )
else
call new_paw_hamiltonian (vnew, dddnew, etots, pawsetup, nwfts, &
llts, nspin, iswts, octs, phits, enlts, paw_energy)
llts, jjts, nspin, iswts, octs, phits, enlts, paw_energy)
call elsdps_paw()
endif