Commit 9161a5b0 authored by Matthias Redies's avatar Matthias Redies

fix LDA so tests run through

parent d4eb1d7b
......@@ -21,11 +21,13 @@ MODULE m_types_xcpot_libxc
#endif
INTEGER :: func_id_c,func_id_x,jspins
CONTAINS
PROCEDURE :: is_LDA=>xcpot_is_LDA
PROCEDURE :: is_gga=>xcpot_is_gga
PROCEDURE :: is_MetaGGA=>xcpot_is_MetaGGA
PROCEDURE :: is_hybrid=>xcpot_is_hybrid
PROCEDURE :: get_exchange_weight=>xcpot_get_exchange_weight
PROCEDURE :: get_vxc=>xcpot_get_vxc
PROCEDURE :: get_vxc_start=>xcpot_get_vxc_start
PROCEDURE :: get_exc=>xcpot_get_exc
PROCEDURE,NOPASS :: alloc_gradients=>xcpot_alloc_gradients
!Not overloeaded...
......@@ -76,7 +78,6 @@ CONTAINS
#endif
END SUBROUTINE xcpot_init
LOGICAL FUNCTION xcpot_is_gga(xcpot)
IMPLICIT NONE
CLASS(t_xcpot_libxc),INTENT(IN):: xcpot
......@@ -87,6 +88,16 @@ CONTAINS
#endif
END FUNCTION xcpot_is_gga
LOGICAL FUNCTION xcpot_is_LDA(xcpot)
IMPLICIT NONE
CLASS(t_xcpot_libxc),INTENT(IN):: xcpot
#ifdef CPP_LIBXC
xcpot_is_LDA= (XC_FAMILY_LDA==xc_f03_func_info_get_family(xcpot%xc_info_x))
#else
xcpot_is_LDA=.false.
#endif
END FUNCTION xcpot_is_LDA
LOGICAL FUNCTION xcpot_is_MetaGGA(xcpot)
IMPLICIT NONE
CLASS(t_xcpot_libxc),INTENT(IN):: xcpot
......@@ -118,6 +129,23 @@ CONTAINS
#endif
END FUNCTION xcpot_get_exchange_weight
SUBROUTINE xcpot_get_vxc_start(xcpot,jspins,rh, vxc,vx, grad)
IMPLICIT NONE
CLASS(t_xcpot_libxc),INTENT(IN) :: xcpot
INTEGER, INTENT (IN) :: jspins
REAL,INTENT (IN) :: rh(:,:) !Dimensions here
REAL, INTENT (OUT) :: vx (:,:) !points,spin
REAL, INTENT (OUT ) :: vxc(:,:) !
! optional arguments for GGA
TYPE(t_gradients),OPTIONAL,INTENT(INOUT)::grad
IF (xcpot%is_lda()) THEN
call xcpot%get_vxc(jspins,rh, vxc,vx, grad)
ELSE
ENDIF
END SUBROUTINE xcpot_get_vxc_start
!***********************************************************************
SUBROUTINE xcpot_get_vxc(xcpot,jspins,rh, vxc,vx, grad)
!***********************************************************************
......@@ -132,8 +160,8 @@ CONTAINS
#ifdef CPP_LIBXC
REAL,ALLOCATABLE::vxc_tmp(:,:),vx_tmp(:,:),vsigma(:,:)
!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(vx_tmp(SIZE(vx,2),SIZE(vx,1)));vx_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
IF (xcpot%is_gga()) THEN
IF (.NOT.PRESENT(grad)) CALL judft_error("Bug: You called get_vxc for a GGA potential without providing derivatives")
ALLOCATE(vsigma,mold=grad%vsigma)
......@@ -159,7 +187,6 @@ CONTAINS
#endif
END SUBROUTINE xcpot_get_vxc
!***********************************************************************
SUBROUTINE xcpot_get_exc(xcpot,jspins,rh,exc,grad)
!***********************************************************************
......@@ -203,7 +230,6 @@ CONTAINS
END SUBROUTINE xcpot_alloc_gradients
#ifdef CPP_LIBXC
SUBROUTINE priv_write_info(xc_info)
IMPLICIT NONE
......
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