Commit d192b448 authored by Matthias Redies's avatar Matthias Redies

split is_gga into vxc and exc

parent 3268a531
...@@ -174,7 +174,7 @@ SUBROUTINE initParallelProcesses(atoms,vacuum,input,stars,sliceplot,banddos,& ...@@ -174,7 +174,7 @@ SUBROUTINE initParallelProcesses(atoms,vacuum,input,stars,sliceplot,banddos,&
ALLOCATE(hybrid%select1(4,atoms%ntype),hybrid%lcutm1(atoms%ntype)) ALLOCATE(hybrid%select1(4,atoms%ntype),hybrid%lcutm1(atoms%ntype))
ALLOCATE(hybrid%lcutwf(atoms%ntype)) ALLOCATE(hybrid%lcutwf(atoms%ntype))
IF (xcpot%is_gga()) THEN IF (xcpot%vxc_is_gga()) THEN
ALLOCATE (stars%ft2_gfx(0:stars%kimax2),stars%ft2_gfy(0:stars%kimax2)) ALLOCATE (stars%ft2_gfx(0:stars%kimax2),stars%ft2_gfy(0:stars%kimax2))
ALLOCATE (oneD%pgft1x(0:oneD%odd%nn2d-1),oneD%pgft1xx(0:oneD%odd%nn2d-1),& ALLOCATE (oneD%pgft1x(0:oneD%odd%nn2d-1),oneD%pgft1xx(0:oneD%odd%nn2d-1),&
oneD%pgft1xy(0:oneD%odd%nn2d-1),& oneD%pgft1xy(0:oneD%odd%nn2d-1),&
......
...@@ -38,7 +38,7 @@ ...@@ -38,7 +38,7 @@
oneD%igfft1(0:oneD%odd%nn2d-1,1:2) = 0 oneD%igfft1(0:oneD%odd%nn2d-1,1:2) = 0
oneD%pgfft1(0:oneD%odd%nn2d-1) = 0. oneD%pgfft1(0:oneD%odd%nn2d-1) = 0.
IF (xcpot%is_gga()) THEN IF (xcpot%vxc_is_gga()) THEN
! ALLOCATE ( odg%pgfx(0:odg%nn2d-1), ! ALLOCATE ( odg%pgfx(0:odg%nn2d-1),
! & odg%pgfy(0:odg%nn2d-1), ! & odg%pgfy(0:odg%nn2d-1),
! & odg%pgfxx(0:odg%nn2d-1), ! & odg%pgfxx(0:odg%nn2d-1),
...@@ -125,7 +125,7 @@ ...@@ -125,7 +125,7 @@
oneD%pgfft1(i-1) = 1. oneD%pgfft1(i-1) = 1.
ENDDO ENDDO
IF (xcpot%is_gga()) THEN IF (xcpot%vxc_is_gga()) THEN
DO i = 1,oneD%odd%nq2 DO i = 1,oneD%odd%nq2
kfx_1 = oneD%kv1(1,i) kfx_1 = oneD%kv1(1,i)
kfy_1 = oneD%kv1(2,i) kfy_1 = oneD%kv1(2,i)
......
...@@ -164,7 +164,7 @@ CONTAINS ...@@ -164,7 +164,7 @@ CONTAINS
cell,sliceplot,noco,& cell,sliceplot,noco,&
stars,oneD,hybrid,kpts,a1,a2,a3,namex,relcor) stars,oneD,hybrid,kpts,a1,a2,a3,namex,relcor)
! !
IF (xcpot%is_gga()) THEN IF (xcpot%vxc_is_gga()) THEN
ALLOCATE (stars%ft2_gfx(0:stars%kimax2),stars%ft2_gfy(0:stars%kimax2)) ALLOCATE (stars%ft2_gfx(0:stars%kimax2),stars%ft2_gfy(0:stars%kimax2))
ALLOCATE (oneD%pgft1x(0:oneD%odd%nn2d-1),oneD%pgft1xx(0:oneD%odd%nn2d-1),& ALLOCATE (oneD%pgft1x(0:oneD%odd%nn2d-1),oneD%pgft1xx(0:oneD%odd%nn2d-1),&
oneD%pgft1xy(0:oneD%odd%nn2d-1),& oneD%pgft1xy(0:oneD%odd%nn2d-1),&
......
...@@ -261,7 +261,7 @@ ...@@ -261,7 +261,7 @@
!!$ !+guta !!$ !+guta
!!$ IF ((xcpot%icorr.EQ.-1).OR.(xcpot%icorr.GE.6)) THEN !!$ IF ((xcpot%icorr.EQ.-1).OR.(xcpot%icorr.GE.6)) THEN
IF (xcpot%is_gga()) THEN IF (xcpot%vxc_is_gga()) THEN
obsolete%ndvgrd = MAX(obsolete%ndvgrd,3) obsolete%ndvgrd = MAX(obsolete%ndvgrd,3)
...@@ -360,7 +360,7 @@ ...@@ -360,7 +360,7 @@
! !
! check muffin tin radii ! check muffin tin radii
! !
l_gga= xcpot%is_gga() l_gga= xcpot%vxc_is_gga()
l_test = .TRUE. ! only checking, dont use new parameters l_test = .TRUE. ! only checking, dont use new parameters
CALL chkmt(atoms,input,vacuum,cell,oneD,l_gga,noel,l_test, kmax1,dtild,dvac1,lmax1,jri1,rmt1,dx1) CALL chkmt(atoms,input,vacuum,cell,oneD,l_gga,noel,l_test, kmax1,dtild,dvac1,lmax1,jri1,rmt1,dx1)
......
...@@ -317,7 +317,7 @@ SUBROUTINE postprocessInput(mpi,input,field,sym,stars,atoms,vacuum,obsolete,kpts ...@@ -317,7 +317,7 @@ SUBROUTINE postprocessInput(mpi,input,field,sym,stars,atoms,vacuum,obsolete,kpts
ALLOCATE (jri1(atoms%ntype), lmax1(atoms%ntype)) ALLOCATE (jri1(atoms%ntype), lmax1(atoms%ntype))
ALLOCATE (rmt1(atoms%ntype), dx1(atoms%ntype)) ALLOCATE (rmt1(atoms%ntype), dx1(atoms%ntype))
l_test = .TRUE. ! only checking, dont use new parameters l_test = .TRUE. ! only checking, dont use new parameters
l_gga=xcpot%is_gga() l_gga=xcpot%vxc_is_gga()
CALL chkmt(atoms,input,vacuum,cell,oneD,l_gga,noel,l_test,& CALL chkmt(atoms,input,vacuum,cell,oneD,l_gga,noel,l_test,&
kmax1,dtild1,dvac1,lmax1,jri1,rmt1,dx1) kmax1,dtild1,dvac1,lmax1,jri1,rmt1,dx1)
DEALLOCATE (jri1,lmax1,rmt1,dx1) DEALLOCATE (jri1,lmax1,rmt1,dx1)
...@@ -479,7 +479,7 @@ SUBROUTINE postprocessInput(mpi,input,field,sym,stars,atoms,vacuum,obsolete,kpts ...@@ -479,7 +479,7 @@ SUBROUTINE postprocessInput(mpi,input,field,sym,stars,atoms,vacuum,obsolete,kpts
ENDIF ENDIF
! Missing xc functionals initializations ! Missing xc functionals initializations
IF (xcpot%is_gga()) THEN IF (xcpot%vxc_is_gga()) THEN
ALLOCATE (stars%ft2_gfx(0:stars%kimax2),stars%ft2_gfy(0:stars%kimax2)) ALLOCATE (stars%ft2_gfx(0:stars%kimax2),stars%ft2_gfy(0:stars%kimax2))
ALLOCATE (oneD%pgft1x(0:oneD%odd%nn2d-1),oneD%pgft1xx(0:oneD%odd%nn2d-1),& ALLOCATE (oneD%pgft1x(0:oneD%odd%nn2d-1),oneD%pgft1xx(0:oneD%odd%nn2d-1),&
oneD%pgft1xy(0:oneD%odd%nn2d-1),& oneD%pgft1xy(0:oneD%odd%nn2d-1),&
......
...@@ -82,7 +82,7 @@ ...@@ -82,7 +82,7 @@
! arltv(i) : length of reciprical lattice vector along ! arltv(i) : length of reciprical lattice vector along
! direction (i) ! direction (i)
! !
IF (.NOT.xcpot%is_gga()) xcpot%gmaxxc=stars%gmax IF (.NOT.xcpot%vxc_is_gga()) xcpot%gmaxxc=stars%gmax
WRITE (6,'('' gmaxxc should be: 2*kmax <= gmaxxc <= gmax '')') WRITE (6,'('' gmaxxc should be: 2*kmax <= gmaxxc <= gmax '')')
IF ( abs( xcpot%gmaxxc - stars%gmax ) .le. 10.0**(-6) ) THEN IF ( abs( xcpot%gmaxxc - stars%gmax ) .le. 10.0**(-6) ) THEN
WRITE (6,'('' concerning memory, you may want to choose'',& WRITE (6,'('' concerning memory, you may want to choose'',&
......
...@@ -63,7 +63,7 @@ CONTAINS ...@@ -63,7 +63,7 @@ CONTAINS
! !
!WRITE (*,*) ' stars are always ordered ' !WRITE (*,*) ' stars are always ordered '
l_xcExtended = xcpot%is_gga() l_xcExtended = xcpot%vxc_is_gga()
!---> read in information if exists !---> read in information if exists
CALL readStars(stars,l_xcExtended,.TRUE.,l_error) CALL readStars(stars,l_xcExtended,.TRUE.,l_error)
IF(.NOT.l_error) THEN IF(.NOT.l_error) THEN
...@@ -383,7 +383,7 @@ CONTAINS ...@@ -383,7 +383,7 @@ CONTAINS
stars%igfft2(kidx2,2) = kfft stars%igfft2(kidx2,2) = kfft
stars%pgfft2(kidx2) = phas(n) stars%pgfft2(kidx2) = phas(n)
!+guta !+guta
IF (xcpot%is_gga()) THEN IF (xcpot%vxc_is_gga()) THEN
!! pgft2x: exp(i*(gfx,gfy,gfz)*tau)*gfx. !! pgft2x: exp(i*(gfx,gfy,gfz)*tau)*gfx.
!! y y. !! y y.
!! pgft2xx: exp(i*(gfx,gfy,gfz)*tau)*gfx*gfx. !! pgft2xx: exp(i*(gfx,gfy,gfz)*tau)*gfx*gfx.
...@@ -610,7 +610,7 @@ CONTAINS ...@@ -610,7 +610,7 @@ CONTAINS
! !
WRITE (*,*) ' stars are always ordered ' WRITE (*,*) ' stars are always ordered '
l_xcExtended = xcpot%is_gga() l_xcExtended = xcpot%vxc_is_gga()
!---> read in information if exists !---> read in information if exists
CALL readStars(stars,l_xcExtended,.FALSE.,l_error) CALL readStars(stars,l_xcExtended,.FALSE.,l_error)
IF(.NOT.l_error) THEN IF(.NOT.l_error) THEN
...@@ -856,7 +856,7 @@ CONTAINS ...@@ -856,7 +856,7 @@ CONTAINS
judft_error("BUG 1 in strgen") judft_error("BUG 1 in strgen")
stars%ng2 = 2 ; stars%kv2 = 0 ; stars%ig2 = 0 ; stars%kimax2= 0 ; stars%igfft2 = 0 stars%ng2 = 2 ; stars%kv2 = 0 ; stars%ig2 = 0 ; stars%kimax2= 0 ; stars%igfft2 = 0
stars%sk2 = 0.0 ; stars%pgfft2 = 0.0 ; stars%nstr2 = 0 stars%sk2 = 0.0 ; stars%pgfft2 = 0.0 ; stars%nstr2 = 0
IF (xcpot%is_gga()) THEN IF (xcpot%vxc_is_gga()) THEN
stars%ft2_gfx = 0.0 ; stars%ft2_gfy = 0.0 stars%ft2_gfx = 0.0 ; stars%ft2_gfy = 0.0
ENDIF ENDIF
......
...@@ -1195,12 +1195,12 @@ input%preconditioning_param = evaluateFirstOnly(xmlGetAttributeValue('/fleurInpu ...@@ -1195,12 +1195,12 @@ input%preconditioning_param = evaluateFirstOnly(xmlGetAttributeValue('/fleurInpu
ALLOCATE(hybrid%lcutm1(atoms%ntype),hybrid%lcutwf(atoms%ntype),hybrid%select1(4,atoms%ntype)) ALLOCATE(hybrid%lcutm1(atoms%ntype),hybrid%lcutwf(atoms%ntype),hybrid%select1(4,atoms%ntype))
obsolete%lwb=.FALSE. obsolete%lwb=.FALSE.
IF (xcpot%is_gga()) THEN IF (xcpot%vxc_is_gga()) THEN
obsolete%ndvgrd=6 obsolete%ndvgrd=6
obsolete%chng=-0.1e-11 obsolete%chng=-0.1e-11
END IF END IF
IF (xcpot%is_gga()) THEN IF (xcpot%vxc_is_gga()) THEN
obsolete%ndvgrd = MAX(obsolete%ndvgrd,3) obsolete%ndvgrd = MAX(obsolete%ndvgrd,3)
END IF END IF
......
This source diff could not be displayed because it is too large. You can view the blob instead.
...@@ -218,7 +218,7 @@ ...@@ -218,7 +218,7 @@
rhoss(i,ispin) = rhoss(i,ispin) / (fpi_const*rad(i)**2) rhoss(i,ispin) = rhoss(i,ispin) / (fpi_const*rad(i)**2)
ENDDO ENDDO
ENDDO ENDDO
IF (xcpot%is_gga()) THEN IF (xcpot%vxc_is_gga()) THEN
CALL potl0(xcpot,DIMENSION%msh,DIMENSION%jspd,input%jspins,n,& CALL potl0(xcpot,DIMENSION%msh,DIMENSION%jspd,input%jspins,n,&
atoms%dx(ntyp), rad, rhoss, vxc) atoms%dx(ntyp), rad, rhoss, vxc)
ELSE ELSE
......
...@@ -19,8 +19,9 @@ MODULE m_types_xcpot ...@@ -19,8 +19,9 @@ MODULE m_types_xcpot
TYPE,ABSTRACT :: t_xcpot TYPE,ABSTRACT :: t_xcpot
REAL :: gmaxxc REAL :: gmaxxc
CONTAINS CONTAINS
PROCEDURE :: is_gga=>xcpot_is_gga PROCEDURE :: vxc_is_gga=>xcpot_vxc_is_gga
PROCEDURE :: is_MetaGGA=>xcpot_is_MetaGGA PROCEDURE :: exc_is_gga=>xcpot_exc_is_gga
PROCEDURE :: exc_is_MetaGGA=>xcpot_exc_is_MetaGGA
PROCEDURE :: needs_grad=>xcpot_needs_grad PROCEDURE :: needs_grad=>xcpot_needs_grad
PROCEDURE :: is_hybrid=>xcpot_is_hybrid PROCEDURE :: is_hybrid=>xcpot_is_hybrid
PROCEDURE :: get_exchange_weight=>xcpot_get_exchange_weight PROCEDURE :: get_exchange_weight=>xcpot_get_exchange_weight
...@@ -47,23 +48,29 @@ MODULE m_types_xcpot ...@@ -47,23 +48,29 @@ MODULE m_types_xcpot
END TYPE t_gradients END TYPE t_gradients
CONTAINS CONTAINS
LOGICAL FUNCTION xcpot_is_gga(xcpot) LOGICAL FUNCTION xcpot_vxc_is_gga(xcpot)
IMPLICIT NONE IMPLICIT NONE
CLASS(t_xcpot),INTENT(IN):: xcpot CLASS(t_xcpot),INTENT(IN):: xcpot
xcpot_is_gga=.false. xcpot_vxc_is_gga=.false.
END FUNCTION xcpot_is_gga END FUNCTION xcpot_vxc_is_gga
LOGICAL FUNCTION xcpot_is_MetaGGA(xcpot) LOGICAL FUNCTION xcpot_exc_is_gga(xcpot)
IMPLICIT NONE IMPLICIT NONE
CLASS(t_xcpot),INTENT(IN):: xcpot CLASS(t_xcpot),INTENT(IN):: xcpot
xcpot_is_MetaGGA=.false. xcpot_exc_is_gga=.false.
END FUNCTION xcpot_is_MetaGGA END FUNCTION xcpot_exc_is_gga
LOGICAL FUNCTION xcpot_exc_is_MetaGGA(xcpot)
IMPLICIT NONE
CLASS(t_xcpot),INTENT(IN):: xcpot
xcpot_exc_is_MetaGGA=.false.
END FUNCTION xcpot_exc_is_MetaGGA
LOGICAL FUNCTION xcpot_needs_grad(xcpot) LOGICAL FUNCTION xcpot_needs_grad(xcpot)
IMPLICIT NONE IMPLICIT NONE
CLASS(t_xcpot),INTENT(IN):: xcpot CLASS(t_xcpot),INTENT(IN):: xcpot
xcpot_needs_grad= xcpot%is_gga() .or. xcpot%is_MetaGGA() xcpot_needs_grad= xcpot%vxc_is_gga()
END FUNCTION xcpot_needs_grad END FUNCTION xcpot_needs_grad
LOGICAL FUNCTION xcpot_is_hybrid(xcpot) LOGICAL FUNCTION xcpot_is_hybrid(xcpot)
......
...@@ -43,7 +43,8 @@ MODULE m_types_xcpot_inbuild ...@@ -43,7 +43,8 @@ MODULE m_types_xcpot_inbuild
CONTAINS CONTAINS
!overloading t_xcpot: !overloading t_xcpot:
PROCEDURE :: is_gga=>xcpot_is_gga PROCEDURE :: vxc_is_gga=>xcpot_vxc_is_gga
PROCEDURE :: exc_is_gga=>xcpot_exc_is_gga
PROCEDURE :: is_hybrid=>xcpot_is_hybrid PROCEDURE :: is_hybrid=>xcpot_is_hybrid
PROCEDURE :: get_exchange_weight=>xcpot_get_exchange_weight PROCEDURE :: get_exchange_weight=>xcpot_get_exchange_weight
PROCEDURE :: get_vxc=>xcpot_get_vxc PROCEDURE :: get_vxc=>xcpot_get_vxc
...@@ -105,11 +106,18 @@ CONTAINS ...@@ -105,11 +106,18 @@ CONTAINS
xcpot%DATA%exchange_weight=xcpot%get_exchange_weight() xcpot%DATA%exchange_weight=xcpot%get_exchange_weight()
END SUBROUTINE xcpot_init END SUBROUTINE xcpot_init
LOGICAL FUNCTION xcpot_is_gga(xcpot)
LOGICAL FUNCTION xcpot_vxc_is_gga(xcpot)
IMPLICIT NONE
CLASS(t_xcpot_inbuild),INTENT(IN):: xcpot
xcpot_vxc_is_gga=priv_gga(xcpot%icorr)
END FUNCTION xcpot_vxc_is_gga
LOGICAL FUNCTION xcpot_exc_is_gga(xcpot)
IMPLICIT NONE IMPLICIT NONE
CLASS(t_xcpot_inbuild),INTENT(IN):: xcpot CLASS(t_xcpot_inbuild),INTENT(IN):: xcpot
xcpot_is_gga=priv_gga(xcpot%icorr) xcpot_exc_is_gga = xcpot%vxc_is_gga()
END FUNCTION xcpot_is_gga END FUNCTION xcpot_exc_is_gga
LOGICAL FUNCTION xcpot_is_hybrid(xcpot) LOGICAL FUNCTION xcpot_is_hybrid(xcpot)
IMPLICIT NONE IMPLICIT NONE
...@@ -178,7 +186,7 @@ CONTAINS ...@@ -178,7 +186,7 @@ CONTAINS
vxc(:,:) = 0.0 vxc(:,:) = 0.0
ngrid=SIZE(rh,1) ngrid=SIZE(rh,1)
IF (xcpot%is_gga()) THEN IF (xcpot%vxc_is_gga()) THEN
IF (.NOT.PRESENT(grad)) CALL judft_error("Bug: You called get_vxc for a GGA potential without providing derivatives") IF (.NOT.PRESENT(grad)) CALL judft_error("Bug: You called get_vxc for a GGA potential without providing derivatives")
IF (xcpot%is_name("l91")) THEN ! local pw91 IF (xcpot%is_name("l91")) THEN ! local pw91
CALL vxcl91(jspins,ngrid,ngrid,rh,grad%agrt(:ngrid),grad%agru(:ngrid),grad%agrd(:ngrid), grad%g2rt(:ngrid),& CALL vxcl91(jspins,ngrid,ngrid,rh,grad%agrt(:ngrid),grad%agru(:ngrid),grad%agrd(:ngrid), grad%g2rt(:ngrid),&
...@@ -275,7 +283,7 @@ CONTAINS ...@@ -275,7 +283,7 @@ CONTAINS
!c !c
exc(:) = 0.0 exc(:) = 0.0
ngrid=SIZE(rh,1) ngrid=SIZE(rh,1)
IF (xcpot%is_gga()) THEN IF (xcpot%exc_is_gga()) THEN
IF (.NOT.PRESENT(grad)) CALL judft_error("Bug: You called get_exc for a GGA potential without providing derivatives") IF (.NOT.PRESENT(grad)) CALL judft_error("Bug: You called get_exc for a GGA potential without providing derivatives")
IF (xcpot%is_name("l91")) THEN ! local pw91 IF (xcpot%is_name("l91")) THEN ! local pw91
CALL excl91(jspins,ngrid,ngrid,rh(:ngrid,:),grad%agrt,grad%agru,grad%agrd,grad%g2rt,grad%g2ru,grad%g2rd,grad%gggrt,grad%gggru,grad%gggrd,grad%gzgr, exc, isprsv,sprsv) CALL excl91(jspins,ngrid,ngrid,rh(:ngrid,:),grad%agrt,grad%agru,grad%agrd,grad%g2rt,grad%g2ru,grad%g2rd,grad%gggrt,grad%gggru,grad%gggrd,grad%gzgr, exc, isprsv,sprsv)
......
...@@ -27,7 +27,8 @@ MODULE m_types_xcpot_libxc ...@@ -27,7 +27,8 @@ MODULE m_types_xcpot_libxc
INTEGER :: func_exc_id_c, func_exc_id_x !> functionals to be used in exc- & totale-calculations INTEGER :: func_exc_id_c, func_exc_id_x !> functionals to be used in exc- & totale-calculations
INTEGER :: jspins INTEGER :: jspins
CONTAINS CONTAINS
PROCEDURE :: is_gga => xcpot_is_gga PROCEDURE :: vxc_is_gga => xcpot_vxc_is_gga
PROCEDURE :: exc_is_gga => xcpot_exc_is_gga
PROCEDURE :: is_MetaGGA => xcpot_is_MetaGGA PROCEDURE :: is_MetaGGA => xcpot_is_MetaGGA
PROCEDURE :: is_hybrid => xcpot_is_hybrid PROCEDURE :: is_hybrid => xcpot_is_hybrid
PROCEDURE :: get_exchange_weight => xcpot_get_exchange_weight PROCEDURE :: get_exchange_weight => xcpot_get_exchange_weight
...@@ -111,19 +112,33 @@ CONTAINS ...@@ -111,19 +112,33 @@ CONTAINS
#endif #endif
END SUBROUTINE xcpot_init END SUBROUTINE xcpot_init
LOGICAL FUNCTION xcpot_is_gga(xcpot) LOGICAL FUNCTION xcpot_vxc_is_gga(xcpot)
IMPLICIT NONE IMPLICIT NONE
CLASS(t_xcpot_libxc),INTENT(IN):: xcpot CLASS(t_xcpot_libxc),INTENT(IN):: xcpot
#ifdef CPP_LIBXC #ifdef CPP_LIBXC
TYPE(xc_f03_func_info_t) :: xc_info TYPE(xc_f03_func_info_t) :: xc_info
xc_info = xc_f03_func_get_info(xcpot%exc_func_x) xc_info = xc_f03_func_get_info(xcpot%vxc_func_x)
xcpot_is_gga = ANY([XC_FAMILY_GGA, XC_FAMILY_HYB_GGA]==xc_f03_func_info_get_family(xc_info)) & xcpot_vxc_is_gga = ANY([XC_FAMILY_GGA, XC_FAMILY_HYB_GGA]==xc_f03_func_info_get_family(xc_info)) &
.or. xcpot%is_MetaGGA()
#else
xcpot_vxc_is_gga=.false.
#endif
END FUNCTION xcpot_vxc_is_gga
LOGICAL FUNCTION xcpot_exc_is_gga(xcpot)
IMPLICIT NONE
CLASS(t_xcpot_libxc),INTENT(IN):: xcpot
#ifdef CPP_LIBXC
TYPE(xc_f03_func_info_t) :: xc_info
xc_info = xc_f03_func_get_info(xcpot%vxc_func_x)
xcpot_exc_is_gga = ANY([XC_FAMILY_GGA, XC_FAMILY_HYB_GGA]==xc_f03_func_info_get_family(xc_info)) &
.or. xcpot%is_MetaGGA() .or. xcpot%is_MetaGGA()
#else #else
xcpot_is_gga=.false. xcpot_exc_is_gga=.false.
#endif #endif
END FUNCTION xcpot_is_gga END FUNCTION xcpot_exc_is_gga
LOGICAL FUNCTION xcpot_is_MetaGGA(xcpot) LOGICAL FUNCTION xcpot_is_MetaGGA(xcpot)
IMPLICIT NONE IMPLICIT NONE
...@@ -178,7 +193,7 @@ CONTAINS ...@@ -178,7 +193,7 @@ CONTAINS
!libxc uses the spin as a first index, hence we have to transpose.... !libxc uses the spin as a first index, hence we have to transpose....
ALLOCATE(vxc_tmp(SIZE(vxc,2),SIZE(vxc,1)));vxc_tmp=0.0 ALLOCATE(vxc_tmp(SIZE(vxc,2),SIZE(vxc,1)));vxc_tmp=0.0
ALLOCATE(vx_tmp(SIZE(vx,2),SIZE(vx,1)));vx_tmp=0.0 ALLOCATE(vx_tmp(SIZE(vx,2),SIZE(vx,1)));vx_tmp=0.0
IF (xcpot%is_gga()) THEN IF (xcpot%vxc_is_gga()) THEN
IF (.NOT.PRESENT(grad)) CALL judft_error("Bug: You called get_vxc for a GGA potential without providing derivatives") IF (.NOT.PRESENT(grad)) CALL judft_error("Bug: You called get_vxc for a GGA potential without providing derivatives")
ALLOCATE(vsigma,mold=grad%vsigma) ALLOCATE(vsigma,mold=grad%vsigma)
!where(abs(grad%sigma)<1E-9) grad%sigma=1E-9 !where(abs(grad%sigma)<1E-9) grad%sigma=1E-9
...@@ -215,7 +230,7 @@ CONTAINS ...@@ -215,7 +230,7 @@ CONTAINS
REAL :: excc(SIZE(exc)) REAL :: excc(SIZE(exc))
#ifdef CPP_LIBXC #ifdef CPP_LIBXC
IF (xcpot%is_gga()) THEN IF (xcpot%exc_is_gga()) THEN
IF (.NOT.PRESENT(grad)) CALL judft_error("Bug: You called get_vxc for a GGA potential without providing derivatives") IF (.NOT.PRESENT(grad)) CALL judft_error("Bug: You called get_vxc for a GGA potential without providing derivatives")
CALL xc_f03_gga_exc(xcpot%exc_func_x, SIZE(rh,1), TRANSPOSE(rh),grad%sigma,exc) CALL xc_f03_gga_exc(xcpot%exc_func_x, SIZE(rh,1), TRANSPOSE(rh),grad%sigma,exc)
IF (xcpot%func_exc_id_c>0) THEN IF (xcpot%func_exc_id_c>0) THEN
......
...@@ -58,7 +58,7 @@ CONTAINS ...@@ -58,7 +58,7 @@ CONTAINS
& rx(1,k),rx(2,k),rx(3,k),& & rx(1,k),rx(2,k),rx(3,k),&
& thet(k),phi) & thet(k),phi)
IF (xcpot%is_gga()) THEN IF (xcpot%vxc_is_gga()) THEN
CALL dylm3(& CALL dylm3(&
& atoms%lmaxd,atoms%lmaxd,rx(:,k),ylm,& & atoms%lmaxd,atoms%lmaxd,rx(:,k),ylm,&
& dylmt1,dylmt2,dylmf1,dylmf2,dylmtf) & dylmt1,dylmt2,dylmf1,dylmf2,dylmtf)
...@@ -80,7 +80,7 @@ CONTAINS ...@@ -80,7 +80,7 @@ CONTAINS
ylh(k,lh,nd) = s ylh(k,lh,nd) = s
IF (xcpot%is_gga()) THEN IF (xcpot%vxc_is_gga()) THEN
DO mem = 1,sphhar%nmem(lh,nd) DO mem = 1,sphhar%nmem(lh,nd)
lm = ll1 + sphhar%mlh(mem,lh,nd) lm = ll1 + sphhar%mlh(mem,lh,nd)
......
...@@ -35,7 +35,7 @@ CONTAINS ...@@ -35,7 +35,7 @@ CONTAINS
ifftd=27*stars%mx1*stars%mx2*stars%mx3 ifftd=27*stars%mx1*stars%mx2*stars%mx3
ifftxc3d = stars%kxc1_fft*stars%kxc2_fft*stars%kxc3_fft ifftxc3d = stars%kxc1_fft*stars%kxc2_fft*stars%kxc3_fft
IF (xcpot%is_gga()) THEN IF (xcpot%vxc_is_gga()) THEN
ALLOCATE ( igxc_fft(0:ifftxc3d-1),gxc_fft(0:ifftxc3d-1,3) ) ALLOCATE ( igxc_fft(0:ifftxc3d-1),gxc_fft(0:ifftxc3d-1,3) )
CALL prp_xcfft_map(stars,sym, cell, igxc_fft,gxc_fft) CALL prp_xcfft_map(stars,sym, cell, igxc_fft,gxc_fft)
ENDIF ENDIF
...@@ -99,7 +99,7 @@ CONTAINS ...@@ -99,7 +99,7 @@ CONTAINS
! Allocate arrays ! Allocate arrays
ALLOCATE( bf3(0:ifftd-1)) ALLOCATE( bf3(0:ifftd-1))
IF (xcpot%is_gga()) THEN IF (xcpot%vxc_is_gga()) THEN
IF (PRESENT(rho)) ALLOCATE(rho(0:ifftxc3d-1,jspins)) IF (PRESENT(rho)) ALLOCATE(rho(0:ifftxc3d-1,jspins))
ALLOCATE( ph_wrk(0:ifftxc3d-1),rhd1(0:ifftxc3d-1,jspins,3)) ALLOCATE( ph_wrk(0:ifftxc3d-1),rhd1(0:ifftxc3d-1,jspins,3))
ALLOCATE( rhd2(0:ifftxc3d-1,jspins,6) ) ALLOCATE( rhd2(0:ifftxc3d-1,jspins,6) )
...@@ -107,7 +107,7 @@ CONTAINS ...@@ -107,7 +107,7 @@ CONTAINS
IF (PRESENT(rho)) ALLOCATE(rho(0:ifftd-1,jspins)) IF (PRESENT(rho)) ALLOCATE(rho(0:ifftd-1,jspins))
ENDIF ENDIF
IF (l_noco) THEN IF (l_noco) THEN
IF (xcpot%is_gga()) THEN IF (xcpot%vxc_is_gga()) THEN
ALLOCATE( mx(0:ifftxc3-1),my(0:ifftxc3-1),magmom(0:ifftxc3-1)) ALLOCATE( mx(0:ifftxc3-1),my(0:ifftxc3-1),magmom(0:ifftxc3-1))
ALLOCATE(dmagmom(0:ifftxc3-1,3),ddmagmom(0:ifftxc3-1,3,3) ) ALLOCATE(dmagmom(0:ifftxc3-1,3),ddmagmom(0:ifftxc3-1,3,3) )
ELSE ELSE
...@@ -117,7 +117,7 @@ CONTAINS ...@@ -117,7 +117,7 @@ CONTAINS
IF (PRESENT(rho)) THEN IF (PRESENT(rho)) THEN
!Put den_pw on grid and store into rho(:,1:2) !Put den_pw on grid and store into rho(:,1:2)
DO js=1,jspins DO js=1,jspins
IF (xcpot%is_gga()) THEN IF (xcpot%vxc_is_gga()) THEN
CALL fft3dxc(rho(0:,js),bf3, den_pw(:,js), stars%kxc1_fft,stars%kxc2_fft,stars%kxc3_fft,& CALL fft3dxc(rho(0:,js),bf3, den_pw(:,js), stars%kxc1_fft,stars%kxc2_fft,stars%kxc3_fft,&
stars%nxc3_fft,stars%kmxxc_fft,+1, stars%igfft(0:,1),igxc_fft,stars%pgfft,stars%nstr) stars%nxc3_fft,stars%kmxxc_fft,+1, stars%igfft(0:,1),igxc_fft,stars%pgfft,stars%nstr)
ELSE ELSE
...@@ -127,7 +127,7 @@ CONTAINS ...@@ -127,7 +127,7 @@ CONTAINS
IF (l_noco) THEN IF (l_noco) THEN
! Get mx,my on real space grid and recalculate rho and magmom ! Get mx,my on real space grid and recalculate rho and magmom
IF (xcpot%is_gga()) THEN IF (xcpot%vxc_is_gga()) THEN
CALL fft3dxc(mx,my, den_pw(:,3), stars%kxc1_fft,stars%kxc2_fft,stars%kxc3_fft,& CALL fft3dxc(mx,my, den_pw(:,3), stars%kxc1_fft,stars%kxc2_fft,stars%kxc3_fft,&
stars%nxc3_fft,stars%kmxxc_fft,+1, stars%igfft(0:,1),igxc_fft,stars%pgfft,stars%nstr) stars%nxc3_fft,stars%kmxxc_fft,+1, stars%igfft(0:,1),igxc_fft,stars%pgfft,stars%nstr)
ELSE ELSE
...@@ -141,7 +141,7 @@ CONTAINS ...@@ -141,7 +141,7 @@ CONTAINS
END DO END DO
ENDIF ENDIF
ENDIF ENDIF
IF (xcpot%is_gga()) THEN IF (xcpot%vxc_is_gga()) THEN
! In collinear calculations all derivatives are calculated in g-spce, ! In collinear calculations all derivatives are calculated in g-spce,
! in non-collinear calculations the derivatives of |m| are calculated in real space. ! in non-collinear calculations the derivatives of |m| are calculated in real space.
...@@ -258,19 +258,19 @@ CONTAINS ...@@ -258,19 +258,19 @@ CONTAINS
ALLOCATE ( vcon(0:ifftd-1) ) ALLOCATE ( vcon(0:ifftd-1) )
DO js = 1,SIZE(v_in,2) DO js = 1,SIZE(v_in,2)
bf3=0.0 bf3=0.0
IF (xcpot%is_gga()) THEN IF (xcpot%vxc_is_gga()) THEN
CALL fft3dxc(v_in(0:,js),bf3, fg3, stars%kxc1_fft,stars%kxc2_fft,stars%kxc3_fft,& CALL fft3dxc(v_in(0:,js),bf3, fg3, stars%kxc1_fft,stars%kxc2_fft,stars%kxc3_fft,&
stars%nxc3_fft,stars%kmxxc_fft,-1, stars%igfft(0:,1),igxc_fft,stars%pgfft,stars%nstr) stars%nxc3_fft,stars%kmxxc_fft,-1, stars%igfft(0:,1),igxc_fft,stars%pgfft,stars%nstr)
ELSE ELSE
vcon(0:)=v_in(0:,js) vcon(0:)=v_in(0:,js)
CALL fft3d(v_in(0:,js),bf3, fg3, stars,-1) CALL fft3d(v_in(0:,js),bf3, fg3, stars,-1)
ENDIF ENDIF
DO k = 1,MERGE(stars%nxc3_fft,stars%ng3,xcpot%is_gga()) DO k = 1,MERGE(stars%nxc3_fft,stars%ng3,xcpot%vxc_is_gga())
v_out_pw(k,js) = v_out_pw(k,js) + fg3(k) v_out_pw(k,js) = v_out_pw(k,js) + fg3(k)
ENDDO ENDDO
IF (l_pw_w) THEN IF (l_pw_w) THEN
IF (xcpot%is_gga()) THEN IF (xcpot%vxc_is_gga()) THEN
!----> Perform fft transform: v_xc(star) --> vxc(r) !----> Perform fft transform: v_xc(star) --> vxc(r)
! !Use large fft mesh for convolution ! !Use large fft mesh for convolution
fg3(stars%nxc3_fft+1:)=0.0 fg3(stars%nxc3_fft+1:)=0.0
......
...@@ -86,7 +86,7 @@ CONTAINS ...@@ -86,7 +86,7 @@ CONTAINS
ifftd2 = 9*stars%mx1*stars%mx2 ifftd2 = 9*stars%mx1*stars%mx2
IF (oneD%odi%d1) ifftd2 = 9*stars%mx3*oneD%odi%M IF (oneD%odi%d1) ifftd2 = 9*stars%mx3*oneD%odi%M
IF (.NOT.xcpot%is_gga()) THEN ! LDA IF (.NOT.xcpot%vxc_is_gga()) THEN ! LDA
IF (.NOT.oneD%odi%d1) THEN IF (.NOT.oneD%odi%d1) THEN
CALL vvacxc(ifftd2,stars,vacuum,xcpot,input,noco,Den,vTot,exc) CALL vvacxc(ifftd2,stars,vacuum,xcpot,input,noco,Den,vTot,exc)
...@@ -114,7 +114,7 @@ CONTAINS ...@@ -114,7 +114,7 @@ CONTAINS
CALL timestart("Vxc in interstitial") CALL timestart("Vxc in interstitial")
IF ( (.NOT. obsolete%lwb) .OR. ( .not.xcpot%is_gga() ) ) THEN IF ( (.NOT. obsolete%lwb) .OR. ( .not.xcpot%vxc_is_gga() ) ) THEN
! no White-Bird-trick ! no White-Bird-trick
CALL vis_xc(stars,sym,cell,den,xcpot,input,noco,vTot,vx,exc) CALL vis_xc(stars,sym,cell,den,xcpot,input,noco,vTot,vx,exc)
......
...@@ -57,7 +57,7 @@ CONTAINS ...@@ -57,7 +57,7 @@ CONTAINS
CALL xcpot%get_vxc(input%jspins,rho,v_xc,v_x,grad) CALL xcpot%get_vxc(input%jspins,rho,v_xc,v_x,grad)
IF (xcpot%is_gga()) THEN IF (xcpot%vxc_is_gga()) THEN
SELECT TYPE(xcpot) SELECT TYPE(xcpot)
TYPE IS (t_xcpot_libxc) TYPE IS (t_xcpot_libxc)
CALL libxc_postprocess_gga_pw(xcpot,stars,cell,v_xc,grad) CALL libxc_postprocess_gga_pw(xcpot,stars,cell,v_xc,grad)
......
...@@ -80,7 +80,7 @@ CONTAINS ...@@ -80,7 +80,7 @@ CONTAINS
nsp=(atoms%lmaxd+1+MOD(atoms%lmaxd+1,2))*(2*atoms%lmaxd+1) nsp=(atoms%lmaxd+1+MOD(atoms%lmaxd+1,2))*(2*atoms%lmaxd+1)
ALLOCATE(ch(nsp*atoms%jmtd,input%jspins)) ALLOCATE(ch(nsp*atoms%jmtd,input%jspins))
IF (xcpot%is_gga()) CALL xcpot%alloc_gradients(SIZE(ch,1),input%jspins,grad) IF (xcpot%vxc_is_gga()) CALL xcpot%alloc_gradients(SIZE(ch,1),input%jspins,grad)
CALL init_mt_grid(nsp,input%jspins,atoms,sphhar,xcpot,sym) CALL init_mt_grid(nsp,input%jspins,atoms,sphhar,xcpot,sym)
...@@ -117,7 +117,7 @@ CONTAINS ...@@ -117,7 +117,7 @@ CONTAINS
ENDIF ENDIF
!Add postprocessing for libxc !Add postprocessing for libxc
IF (l_libxc.AND.xcpot%is_gga()) CALL libxc_postprocess_gga_mt(xcpot,atoms,sphhar,n,v_xc,grad) IF (l_libxc.AND.xcpot%vxc_is_gga()) CALL libxc_postprocess_gga_mt(xcpot,atoms,sphhar,n,v_xc,grad)
CALL mt_from_grid(atoms,sphhar,nsp,n,input%jspins,v_xc,vxc%mt(:,0:,n,:)) CALL mt_from_grid(atoms,sphhar,nsp,n,input%jspins,v_xc,vxc%mt(:,0:,n,:))
......
...@@ -141,7 +141,7 @@ CONTAINS ...@@ -141,7 +141,7 @@ CONTAINS
! ENDDO ! ivac ! ENDDO ! ivac
! DO ivac = 1,nvac ! DO ivac = 1,nvac
IF (xcpot%is_gga()) THEN IF (xcpot%vxc_is_gga()) THEN
DO js=1,input%jspins DO js=1,input%jspins
! !
! calculate first (rhtdz) & second (rhtdzz) derivative of den%vacz(1:nmz) ! calculate first (rhtdz) & second (rhtdzz) derivative of den%vacz(1:nmz)
...@@ -237,7 +237,7 @@ CONTAINS ...@@ -237,7 +237,7 @@ CONTAINS
END IF END IF
IF (xcpot%is_gga()) THEN IF (xcpot%vxc_is_gga()) THEN