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

More meta-GGA cleanup: CP now uses same interfaces tau_xc and tau_xc_spin 

as PW, thus allowing more metaGGA to be used in CP as well


git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@11088 c92efa57-630b-4861-b058-cf58834340f0
This commit is contained in:
giannozz 2014-07-15 20:41:50 +00:00
parent 500f71907f
commit 517877d553
4 changed files with 44 additions and 33 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
CPV/src/make.depend
View File

@ -607,6 +607,7 @@ makov_payne.o : ../../Modules/parallel_include.o
makov_payne.o : gvecw.o
makov_payne.o : ions_positions.o
makov_payne.o : mainvar.o
metaxc.o : ../../Modules/funct.o
metaxc.o : ../../Modules/kind.o
modules.o : ../../Modules/kind.o
modules.o : ../../Modules/uspp.o

43
CPV/src/metaxc.f90
View File

@ -1,5 +1,6 @@
!
! Copyright (C) 2005 FPMD-CPV groups
! Copyright (C) 2005-2014 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,
@ -10,6 +11,7 @@ SUBROUTINE tpssmeta(nnr, nspin,grho,rho,kedtau,etxc)
! ===================
!--------------------------------------------------------------------
use kinds, only: dp
use funct, only: tau_xc, tau_xc_spin
IMPLICIT NONE
!
! input
@ -22,8 +24,7 @@ SUBROUTINE tpssmeta(nnr, nspin,grho,rho,kedtau,etxc)
INTEGER :: k, ipol, is
REAL(dp) :: grho2 (2), sx, sc, v1x, v2x, v3x,v1c, v2c, v3c, &
v1xup, v1xdw, v2xup, v2xdw, v1cup, v1cdw ,v2cup(3),v2cdw(3), &
v3xup, v3xdw,grhoup(3),grhodw(3),&
segno, arho, atau
v3xup, v3xdw,grhoup(3),grhodw(3),v3cup, v3cdw, segno, arho, atau
REAL(dp), PARAMETER :: epsr = 1.0d-6, epsg = 1.0d-10
etxc = 0.d0
! calculate the gradient of rho+rho_core in real space
@ -39,8 +40,8 @@ SUBROUTINE tpssmeta(nnr, nspin,grho,rho,kedtau,etxc)
segno = SIGN (1.d0, rho (k, 1) )
atau = kedtau(k,1)
IF (arho.GT.epsr.AND.grho2 (1) .GT.epsg.AND.ABS(atau).GT.epsr) THEN
CALL tpsscxc (arho, grho2(1),atau,sx, sc, &
v1x, v2x,v3x,v1c, v2c,v3c)
CALL tau_xc (arho, grho2(1), atau, sx, sc, &
v1x, v2x, v3x, v1c, v2c, v3c)
rho (k, 1) = (v1x + v1c )
kedtau(k,1)= (v3x + v3c) *0.5d0
! h contains D(rho*Exc)/D(|grad rho|) * (grad rho) / |grad rho|
@ -58,26 +59,38 @@ SUBROUTINE tpssmeta(nnr, nspin,grho,rho,kedtau,etxc)
!
! spin-polarised case
!
CALL tpsscx_spin(rho (k, 1), rho (k, 2), grho2 (1), grho2 (2), &
kedtau(k,1),kedtau(k,2),sx, &
v1xup,v1xdw,v2xup,v2xdw,v3xup,v3xdw)
!CALL tpsscx_spin(rho (k, 1), rho (k, 2), grho2 (1), grho2 (2), &
! kedtau(k,1),kedtau(k,2),sx, &
! v1xup,v1xdw,v2xup,v2xdw,v3xup,v3xdw)
rh = rho (k, 1) + rho (k, 2)
IF (rh.GT.epsr) THEN
zeta = (rho (k, 1) - rho (k, 2) ) / rh
!zeta = (rho (k, 1) - rho (k, 2) ) / rh
DO ipol=1,3
grhoup(ipol)=grho(k,ipol,1)
grhodw(ipol)=grho(k,ipol,2)
END DO
atau=kedtau(k,1)+kedtau(k,2)
CALL tpsscc_spin(rh,zeta,grhoup,grhodw, &
atau,sc,v1cup,v1cdw,v2cup,v2cdw,v3c)
! atau=kedtau(k,1)+kedtau(k,2)
call tau_xc_spin (rho(k,1), rho(k,2), grhoup, grhodw, &
kedtau(k,1), kedtau(k,2), sx, sc, v1xup, v1xdw, v2xup, v2xdw, &
v3xup, v3xdw, v1cup, v1cdw, v2cup, v2cdw,&
v3cup, v3cdw)
!CALL tpsscc_spin(rh,zeta,grhoup,grhodw, &
! atau,sc,v1cup,v1cdw,v2cup,v2cdw,v3c)
ELSE
sx = 0.d0
sc = 0.d0
v1xup = 0.d0
v1xdw = 0.d0
v2xup=0.d0
v2xdw=0.d0
v3xup=0.d0
v3xdw=0.d0
v1cup = 0.d0
v1cdw = 0.d0
v2cup=0.d0
v2cdw=0.d0
v3c=0.d0
v3cup=0.d0
v3cdw=0.d0
!
ENDIF
!
@ -92,8 +105,8 @@ SUBROUTINE tpssmeta(nnr, nspin,grho,rho,kedtau,etxc)
grho(k,ipol,1) = (v2xup*grho(k,ipol,1) + v2cup(ipol))
grho(k,ipol,2) = (v2xdw*grho(k,ipol,2) + v2cdw(ipol))
ENDDO
kedtau(k,1)= (v3xup + v3c) *0.5d0
kedtau(k,2)= (v3xdw + v3c) *0.5d0
kedtau(k,1)= (v3xup + v3cup) *0.5d0
kedtau(k,2)= (v3xdw + v3cdw) *0.5d0
etxc = etxc + (sx + sc)
ENDIF
ENDDO

19
Modules/funct.f90
View File

@ -2054,9 +2054,9 @@ end subroutine tau_xc
!
!
!-----------------------------------------------------------------------
subroutine tau_xc_spin (rhoup, rhodw, grhoup, grhodw, tauup, taudw, ex, ec, &
& v1xup, v1xdw, v2xup, v2xdw, v3xup, v3xdw, v1cup, v1cdw, &
& v2cup, v2cdw, v2cup_vec, v2cdw_vec, v3cup, v3cdw)
subroutine tau_xc_spin (rhoup, rhodw, grhoup, grhodw, tauup, taudw, ex, ec, &
& v1xup, v1xdw, v2xup, v2xdw, v3xup, v3xdw, v1cup, v1cdw,&
& v2cup, v2cdw, v3cup, v3cdw)
!-----------------------------------------------------------------------
!
@ -2068,8 +2068,8 @@ subroutine tau_xc_spin (rhoup, rhodw, grhoup, grhodw, tauup, taudw, ex, ec,
real(dp), dimension (3), intent(in) :: grhoup, grhodw
real(dp), intent(out) :: ex, ec, v1xup, v1xdw, v2xup, v2xdw, v3xup, v3xdw, &
& v1cup, v1cdw, v2cup, v2cdw, v3cup, v3cdw
real(dp), dimension(3), intent(out) :: v2cup_vec, v2cdw_vec
& v1cup, v1cdw, v3cup, v3cdw
real(dp), dimension(3), intent(out) :: v2cup, v2cdw
!
! Local variables
@ -2085,10 +2085,7 @@ subroutine tau_xc_spin (rhoup, rhodw, grhoup, grhodw, tauup, taudw, ex, ec,
v2cup = zero
v2cdw = zero
v2cup_vec (:) = zero
v2cdw_vec (:) = zero
do ipol=1,3
grhoup2 = grhoup2 + grhoup(ipol)**2
grhodw2 = grhodw2 + grhodw(ipol)**2
@ -2106,14 +2103,14 @@ subroutine tau_xc_spin (rhoup, rhodw, grhoup, grhodw, tauup, taudw, ex, ec,
atau = tauup + taudw ! KE-density in Hartree
call tpsscc_spin(rh,zeta,grhoup,grhodw, atau,ec, &
& v1cup,v1cdw,v2cup_vec,v2cdw_vec,v3cup, v3cdw)
& v1cup,v1cdw,v2cup,v2cdw,v3cup, v3cdw)
elseif (imeta == 2) then
call m06lxc_spin (rhoup, rhodw, grhoup2, grhodw2, tauup, taudw, &
& ex, ec, v1xup, v1xdw, v2xup, v2xdw, v3xup, v3xdw, &
& v1cup, v1cdw, v2cup, v2cdw, v3cup, v3cdw)
& v1cup, v1cdw, v2cup(1), v2cdw(1), v3cup, v3cdw)
else

14
PW/src/v_of_rho.f90
View File

@ -137,12 +137,12 @@ SUBROUTINE v_xc_meta( rho, rho_core, rhog_core, etxc, vtxc, v, kedtaur )
REAL(DP) :: zeta, rh
INTEGER :: k, ipol, is
REAL(DP) :: ex, ec, v1x, v2x, v3x,v1c, v2c, v3c, &
& v1xup, v1xdw, v2xup, v2xdw, v1cup, v1cdw, v2cup, v2cdw , &
& v1xup, v1xdw, v2xup, v2xdw, v1cup, v1cdw, &
& v3xup, v3xdw,v3cup, v3cdw, &
& arho, atau, fac, rhoup, rhodw, ggrho2, tauup,taudw
REAL(DP), DIMENSION(2) :: grho2, rhoneg
REAL(DP), DIMENSION(3) :: grhoup, grhodw, v2cup_vec, v2cdw_vec
REAL(DP), DIMENSION(3) :: grhoup, grhodw, v2cup, v2cdw
!
REAL(DP), ALLOCATABLE :: grho(:,:,:), h(:,:,:), dh(:)
@ -242,7 +242,7 @@ SUBROUTINE v_xc_meta( rho, rho_core, rhog_core, etxc, vtxc, v, kedtaur )
call tau_xc_spin (rhoup, rhodw, grhoup, grhodw, tauup, taudw, ex, ec, &
v1xup, v1xdw, v2xup, v2xdw, v3xup, v3xdw, v1cup, v1cdw, &
v2cup, v2cdw, v2cup_vec, v2cdw_vec, v3cup, v3cdw )
v2cup, v2cdw, v3cup, v3cdw )
!
! first term of the gradient correction : D(rho*Exc)/D(rho)
!
@ -253,13 +253,13 @@ SUBROUTINE v_xc_meta( rho, rho_core, rhog_core, etxc, vtxc, v, kedtaur )
!
if (get_meta()==1) then ! tpss functional
!
h(:,k,1) = (v2xup * grhoup(:) + v2cup_vec(:)) * e2
h(:,k,2) = (v2xdw * grhodw(:) + v2cdw_vec(:)) * e2
h(:,k,1) = (v2xup * grhoup(:) + v2cup(:)) * e2
h(:,k,2) = (v2xdw * grhodw(:) + v2cdw(:)) * e2
!
else
!
h(:,k,1) = (v2xup + v2cup) * grhoup(:) * e2
h(:,k,2) = (v2xdw + v2cdw) * grhodw(:) * e2
h(:,k,1) = (v2xup + v2cup(1)) * grhoup(:) * e2
h(:,k,2) = (v2xdw + v2cdw(1)) * grhodw(:) * e2
!
end if
!