Commit 69208f45 authored by Matthias Redies's avatar Matthias Redies

bug fixes

parent efa283d7
......@@ -173,7 +173,7 @@ CONTAINS
#ifdef CPP_LIBXC
TYPE(xc_f03_func_info_t) :: xc_info
xc_info = xc_f03_func_get_info(xcpot%vxc_func_x)
xc_info = xc_f03_func_get_info(xcpot%exc_func_x)
xcpot_exc_is_gga = ANY([XC_FAMILY_GGA, XC_FAMILY_HYB_GGA]==xc_f03_func_info_get_family(xc_info))
#else
xcpot_exc_is_gga=.false.
......@@ -260,6 +260,8 @@ CONTAINS
SUBROUTINE xcpot_get_exc(xcpot,jspins,rh,exc,grad, kinEnergyDen)
USE IFCORE
IMPLICIT NONE
CLASS(t_xcpot_libxc),INTENT(IN) :: xcpot
INTEGER, INTENT (IN) :: jspins
......@@ -269,10 +271,12 @@ CONTAINS
TYPE(t_gradients),OPTIONAL,INTENT(IN)::grad
REAL, INTENT(IN), OPTIONAL :: kinEnergyDen(:,:)
TYPE(xc_f03_func_info_t) :: xc_info
REAL :: excc(SIZE(exc))
#ifdef CPP_LIBXC
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_exc for a GGA potential without providing derivatives")
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
CALL xc_f03_gga_exc(xcpot%exc_func_c, SIZE(rh,1), TRANSPOSE(rh),grad%sigma,excc)
......@@ -285,8 +289,7 @@ CONTAINS
exc=exc+excc
END IF
ELSEIF(xcpot%exc_is_MetaGGA()) THEN
write (*,*) "Doing MetaGGA"
IF(PRESENT(kinEnergyDen)) THEN ! patch till vacuum can do LibXC
IF(PRESENT(kinEnergyDen)) THEN
call xc_f03_mgga_exc(xcpot%exc_func_x, SIZE(rh,1), TRANSPOSE(rh), grad%sigma, &
transpose(grad%laplace), transpose(kinEnergyDen), exc)
IF (xcpot%func_exc_id_c>0) THEN
......@@ -294,10 +297,16 @@ CONTAINS
transpose(grad%laplace), transpose(kinEnergyDen), excc)
exc=exc+excc
END IF
ELSE
call juDFT_error("MetaGGAs needs the kinetic energy density",&
hint="maybe you used vacuum with LibXC")
ELSE ! first iteration is GGA
IF (.NOT.PRESENT(grad)) CALL judft_error("Bug: You called get_exc for a MetaGGA potential without providing derivatives")
CALL xc_f03_gga_exc(xcpot%vxc_func_x, SIZE(rh,1), TRANSPOSE(rh),grad%sigma,exc)
IF (xcpot%func_exc_id_c>0) THEN
CALL xc_f03_gga_exc(xcpot%vxc_func_c, SIZE(rh,1), TRANSPOSE(rh),grad%sigma,excc)
exc=exc+excc
END IF
ENDIF
ELSE
call juDFT_error("exc is part of a known Family", calledby="xcpot_get_exc@libxc")
ENDIF
......
......@@ -63,8 +63,9 @@ CONTAINS
REAL:: v_xc((atoms%lmaxd+1+MOD(atoms%lmaxd+1,2))*(2*atoms%lmaxd+1)*atoms%jmtd,input%jspins)
REAL:: e_xc((atoms%lmaxd+1+MOD(atoms%lmaxd+1,2))*(2*atoms%lmaxd+1)*atoms%jmtd,1)
REAL,ALLOCATABLE:: xcl(:,:)
LOGICAL :: lda_atom(atoms%ntype),l_libxc
LOGICAL :: lda_atom(atoms%ntype),l_libxc, perform_MetaGGA
!.....------------------------------------------------------------------
perform_MetaGGA = ALLOCATED(EnergyDen%mt) .AND. xcpot%exc_is_MetaGGA()
lda_atom=.FALSE.; l_libxc=.FALSE.
SELECT TYPE(xcpot)
TYPE IS(t_xcpot_inbuild)
......@@ -81,9 +82,13 @@ CONTAINS
nsp=(atoms%lmaxd+1+MOD(atoms%lmaxd+1,2))*(2*atoms%lmaxd+1)
ALLOCATE(ch(nsp*atoms%jmtd,input%jspins))
IF (xcpot%needs_grad()) THEN
CALL xcpot%alloc_gradients(SIZE(ch,1),input%jspins,grad)
CALL xcpot%alloc_gradients(SIZE(ch,1),input%jspins,tmp_grad)
IF (xcpot%needs_grad()) CALL xcpot%alloc_gradients(SIZE(ch,1),input%jspins,grad)
IF (perform_MetaGGA) THEN
IF (xcpot%needs_grad()) CALL xcpot%alloc_gradients(SIZE(ch,1),input%jspins,tmp_grad)
ALLOCATE(ED_rs, mold=ch)
ALLOCATE(vTot_rs, mold=ch)
ALLOCATE(kinED_RS, mold=ch)
ENDIF
CALL init_mt_grid(nsp,input%jspins,atoms,sphhar,xcpot,sym)
......@@ -126,9 +131,10 @@ CONTAINS
CALL mt_from_grid(atoms,sphhar,nsp,n,input%jspins,v_x,vx%mt(:,0:,n,:))
! use updated vTot for exc calculation
IF(ALLOCATED(EnergyDen%mt) .AND. xcpot%exc_is_MetaGGA()) THEN
IF(perform_MetaGGA) THEN
CALL mt_to_grid(xcpot, input%jspins, atoms,sphhar,EnergyDen%mt(:,0:,n,:),nsp,n,tmp_grad,ED_rs)
CALL mt_to_grid(xcpot, input%jspins, atoms,sphhar,vTot%mt(:,0:,n,:),nsp,n,tmp_grad,vTot_rs)
CALL calc_kinEnergyDen(ED_rs, vTot_rs, ch, kinED_rs)
ENDIF
......@@ -136,7 +142,8 @@ CONTAINS
!
! calculate the ex.-cor energy density
!
IF(ALLOCATED(EnergyDen%mt) .AND. xcpot%exc_is_MetaGGA()) THEN
IF(perform_MetaGGA) THEN
CALL xcpot%get_exc(input%jspins,ch(:nsp*atoms%jri(n),:),e_xc(:nsp*atoms%jri(n),1),grad, kinED_rs)
ELSE
CALL xcpot%get_exc(input%jspins,ch(:nsp*atoms%jri(n),:),e_xc(:nsp*atoms%jri(n),1),grad)
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment