Commit 4addcb1c authored by Daniel Wortmann's avatar Daniel Wortmann

Fixes to make pbe faster (again after refactoring of xcpot) Changes for...

Fixes to make pbe faster (again after refactoring of xcpot) Changes for reanabling old CPP_66 functionality
parent 3b8deae3
......@@ -525,6 +525,7 @@ MODULE m_types
LOGICAL, ALLOCATABLE :: soc_opt(:)
REAL :: theta
REAL :: phi
REAL,ALLOCATABLE :: socscale(:)
END TYPE t_noco
TYPE t_input
......
......@@ -20,54 +20,87 @@ MODULE m_types_xcpot
REAL, PARAMETER :: amix_hse = 0.25
REAL, PARAMETER :: amix_hf = 1.00
INTEGER,PARAMETER:: ILLEGAL_XCPOT=0
TYPE t_xcpot
#ifdef CPP_MPI
INTEGER :: icorr !not private to allow bcasting it around
INTEGER :: icorr=0 !not private to allow bcasting it around
#else
INTEGER,PRIVATE :: icorr
INTEGER,PRIVATE :: icorr=0
#endif
INTEGER,ALLOCATABLE :: icorr_mt(:)
!in the pbe case (exchpbe.F) lots of test are made
!in addition some constants are set
!to speed up this code precalculate things in init
LOGICAL :: is_rpbe !Rpbe
LOGICAL :: is_wc
LOGICAL :: is_hse !hse,lhse,vhse
REAL :: uk,um
LOGICAL,ALLOCATABLE :: lda_atom(:)
REAL :: gmaxxc
INTEGER :: krla !relativistic corrections
CONTAINS
PROCEDURE :: is_gga=>xcpot_is_gga
PROCEDURE,NOPASS :: from_name=>xcpot_from_name
PROCEDURE :: get_name=>xcpot_get_name
PROCEDURE :: init=>xcpot_init
PROCEDURE :: is_hybrid=>xcpot_is_hybrid
PROCEDURE :: is_name=>xcpot_is_name
PROCEDURE :: get_exchange_weight=>xcpot_get_exchange_weight
END TYPE t_xcpot
PUBLIC t_xcpot,ILLEGAL_XCPOT
PUBLIC t_xcpot
CONTAINS
PURE INTEGER FUNCTION xcpot_from_name(name)
CHARACTER(len=4) FUNCTION xcpot_get_name(xcpot)
USE m_judft
IMPLICIT NONE
CHARACTER(len=*),INTENT(IN) :: name
INTEGER :: n
xcpot_from_name=ILLEGAL_XCPOT
DO n=1,SIZE(xc_names)
IF (TRIM(ADJUSTL(name))==TRIM(xc_names(n))) xcpot_from_name=n
ENDDO
END FUNCTION xcpot_from_name
CLASS(t_xcpot),INTENT(IN) :: xcpot
IF (xcpot%icorr==0) CALL judft_error("xc-potential not initialized",calledby="types_xcpot.F90")
xcpot_get_name=xc_names(xcpot%icorr)
END FUNCTION xcpot_get_name
SUBROUTINE xcpot_init(xcpot,namex,relcor)
USE m_judft
IMPLICIT NONE
CLASS(t_xcpot),INTENT(INOUT) :: xcpot
CHARACTER(len=*),INTENT(IN) :: namex
LOGICAL,INTENT(IN) :: relcor
xcpot%icorr=xcpot%from_name(namex)
INTEGER:: n
!Determine icorr from name
xcpot%icorr=0
DO n=1,SIZE(xc_names)
IF (TRIM(ADJUSTL(namex))==TRIM(xc_names(n))) THEN
xcpot%icorr=n
ENDIF
ENDDO
if (xcpot%icorr==0) CALL judft_error("Unkown xc-potential:"//namex,calledby="types_xcpot.F90")
xcpot%krla=MERGE(1,0,relcor)
!Code from exchpbe to speed up determination of constants
IF (xcpot%is_name("rpbe")) THEN
xcpot%uk=1.2450
ELSE
xcpot%uk=0.8040
ENDIF
IF (xcpot%is_name("PBEs")) THEN ! pbe_sol
xcpot%um=0.123456790123456d0
ELSE
xcpot%um=0.2195149727645171e0
ENDIF
xcpot%is_hse=xcpot%is_name("hse").OR.xcpot%is_name("lhse").OR.xcpot%is_name("vhse")
xcpot%is_rpbe=xcpot%is_name("Rpbe") !Rpbe
xcpot%is_wc=xcpot%is_name("wc")
END SUBROUTINE xcpot_init
PURE LOGICAL FUNCTION xcpot_is_name(xcpot,name)
LOGICAL FUNCTION xcpot_is_name(xcpot,name)
CLASS(t_xcpot),INTENT(IN):: xcpot
CHARACTER(len=*),INTENT(IN) :: name
xcpot_is_name=(xcpot%icorr/=ILLEGAL_XCPOT.AND.xcpot%icorr==xcpot_from_name(name))
xcpot_is_name=(trim(xc_names(xcpot%icorr))==trim((name)))
END FUNCTION xcpot_is_name
ELEMENTAL LOGICAL FUNCTION xcpot_is_gga(xcpot,icorr)
LOGICAL FUNCTION xcpot_is_gga(xcpot,icorr)
IMPLICIT NONE
CLASS(t_xcpot),INTENT(IN):: xcpot
INTEGER,OPTIONAL,INTENT(IN):: icorr
......@@ -78,7 +111,7 @@ CONTAINS
ENDIF
END FUNCTION xcpot_is_gga
ELEMENTAL LOGICAL FUNCTION xcpot_is_hybrid(xcpot,icorr)
LOGICAL FUNCTION xcpot_is_hybrid(xcpot,icorr)
IMPLICIT NONE
CLASS(t_xcpot),INTENT(IN):: xcpot
INTEGER,OPTIONAL,INTENT(IN):: icorr
......
......@@ -133,10 +133,9 @@ SUBROUTINE r_inpXML(&
CHARACTER(LEN=11) :: latticeType
CHARACTER(LEN=50) :: versionString
CHARACTER(LEN=4) :: namexSpecies
LOGICAL :: relcorSpecies
INTEGER :: icorrSpecies, igrdSpecies, krlaSpecies
LOGICAL :: ldaSpecies
REAL :: socscaleSpecies
INTEGER, ALLOCATABLE :: lNumbers(:), nNumbers(:), speciesLLO(:)
INTEGER, ALLOCATABLE :: loOrderList(:)
INTEGER, ALLOCATABLE :: speciesNLO(:)
......@@ -225,7 +224,8 @@ SUBROUTINE r_inpXML(&
ALLOCATE(atoms%igrd(atoms%ntype))
ALLOCATE(atoms%krla(atoms%ntype))
ALLOCATE(atoms%relcor(atoms%ntype))
ALLOCATE(xcpot%lda_atom(atoms%ntype))
atoms%namex = ''
atoms%icorr = -99
......@@ -236,7 +236,8 @@ SUBROUTINE r_inpXML(&
ALLOCATE(noco%soc_opt(atoms%ntype+2),noco%l_relax(atoms%ntype),noco%b_con(2,atoms%ntype))
ALLOCATE(noco%alphInit(atoms%ntype),noco%alph(atoms%ntype),noco%beta(atoms%ntype))
ALLOCATE(noco%socscale(atoms%ntype))
ALLOCATE (Jij%alph1(atoms%ntype),Jij%l_magn(atoms%ntype),Jij%M(atoms%ntype))
ALLOCATE (Jij%magtype(atoms%ntype),Jij%nmagtype(atoms%ntype))
......@@ -1310,21 +1311,13 @@ SUBROUTINE r_inpXML(&
SELECT(4)=evaluateFirstIntOnly(xPathA)
ENDIF
! Explicitely provided xc functional
WRITE(xPathA,*) '/fleurInput/atomSpecies/species[',iSpecies,']/xcFunctional'
numberNodes = xmlGetNumberOfNodes(TRIM(ADJUSTL(xPathA)))
namexSpecies = ''
relcorSpecies = .FALSE.
icorrSpecies = -99
igrdSpecies = 0
krlaSpecies = 0
IF (numberNodes.EQ.1) THEN
namexSpecies = TRIM(ADJUSTL(xmlGetAttributeValue(TRIM(ADJUSTL(xPathA))//'/@name')))
relcorSpecies = evaluateFirstBoolOnly(xmlGetAttributeValue(TRIM(ADJUSTL(xPathA))//'/@relativisticCorrections'))
!CALL getXCParameters(namexSpecies,relcorSpecies,icorrSpecies,krlaSpecies,ldummy)
END IF
! Special switches for species
ldaspecies=.FALSE.
socscalespecies=1.0
!WRITE(xPathA,*) '/fleurInput/atomSpecies/species[',iSpecies,']/special'
!ldaSpecies = evaluateFirstBoolOnly(TRIM(ADJUSTL(xmlGetAttributeValue(TRIM(ADJUSTL(xPathA))//'/@lda'))))
!socscaleSpecies = evaluateFirstOnly(TRIM(ADJUSTL(xmlGetAttributeValue(TRIM(ADJUSTL(xPathA))//'/@socscale'))))
! Explicitely provided core configurations
coreConfigPresent = .FALSE.
......@@ -1513,10 +1506,8 @@ SUBROUTINE r_inpXML(&
hybrid%select1(:,iType)=SELECT
ENDIF
! Explicit xc functional
atoms%namex(iType) = namexSpecies
atoms%relcor(iType) = relcorSpecies
atoms%icorr(iType) = icorrSpecies
atoms%krla(iType) = krlaSpecies
xcpot%lda_atom(iType)=ldaSpecies
noco%socscale(iType)=socscaleSpecies
END IF
END DO
DEALLOCATE(loOrderList)
......
......@@ -1177,46 +1177,83 @@ unsigned char FleurInputSchema_xsd[] = {
0x65, 0x66, 0x61, 0x75, 0x6c, 0x74, 0x3d, 0x22, 0x34, 0x20, 0x30, 0x20,
0x34, 0x20, 0x32, 0x22, 0x2f, 0x3e, 0x0a, 0x20, 0x20, 0x20, 0x3c, 0x2f,
0x78, 0x73, 0x64, 0x3a, 0x63, 0x6f, 0x6d, 0x70, 0x6c, 0x65, 0x78, 0x54,
0x79, 0x70, 0x65, 0x3e, 0x0a, 0x20, 0x20, 0x20, 0x0a, 0x20, 0x20, 0x20,
0x3c, 0x78, 0x73, 0x64, 0x3a, 0x63, 0x6f, 0x6d, 0x70, 0x6c, 0x65, 0x78,
0x54, 0x79, 0x70, 0x65, 0x20, 0x6e, 0x61, 0x6d, 0x65, 0x3d, 0x22, 0x53,
0x70, 0x65, 0x63, 0x69, 0x65, 0x73, 0x54, 0x79, 0x70, 0x65, 0x22, 0x3e,
0x0a, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x3c, 0x78, 0x73, 0x64, 0x3a,
0x73, 0x65, 0x71, 0x75, 0x65, 0x6e, 0x63, 0x65, 0x3e, 0x0a, 0x20, 0x20,
0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x3c, 0x78, 0x73, 0x64, 0x3a,
0x65, 0x6c, 0x65, 0x6d, 0x65, 0x6e, 0x74, 0x20, 0x6e, 0x61, 0x6d, 0x65,
0x3d, 0x22, 0x6d, 0x74, 0x53, 0x70, 0x68, 0x65, 0x72, 0x65, 0x22, 0x20,
0x74, 0x79, 0x70, 0x65, 0x3d, 0x22, 0x4d, 0x54, 0x53, 0x70, 0x68, 0x65,
0x72, 0x65, 0x54, 0x79, 0x70, 0x65, 0x22, 0x2f, 0x3e, 0x0a, 0x20, 0x20,
0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x3c, 0x78, 0x73, 0x64, 0x3a,
0x65, 0x6c, 0x65, 0x6d, 0x65, 0x6e, 0x74, 0x20, 0x6e, 0x61, 0x6d, 0x65,
0x3d, 0x22, 0x61, 0x74, 0x6f, 0x6d, 0x69, 0x63, 0x43, 0x75, 0x74, 0x6f,
0x66, 0x66, 0x73, 0x22, 0x20, 0x74, 0x79, 0x70, 0x65, 0x3d, 0x22, 0x41,
0x74, 0x6f, 0x6d, 0x69, 0x63, 0x43, 0x75, 0x74, 0x6f, 0x66, 0x66, 0x73,
0x79, 0x70, 0x65, 0x3e, 0x0a, 0x0a, 0x20, 0x20, 0x20, 0x3c, 0x78, 0x73,
0x64, 0x3a, 0x73, 0x69, 0x6d, 0x70, 0x6c, 0x65, 0x54, 0x79, 0x70, 0x65,
0x20, 0x6e, 0x61, 0x6d, 0x65, 0x3d, 0x22, 0x5a, 0x65, 0x72, 0x6f, 0x54,
0x6f, 0x4f, 0x6e, 0x65, 0x4e, 0x75, 0x6d, 0x62, 0x65, 0x72, 0x54, 0x79,
0x70, 0x65, 0x22, 0x3e, 0x0a, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x3c,
0x78, 0x73, 0x64, 0x3a, 0x72, 0x65, 0x73, 0x74, 0x72, 0x69, 0x63, 0x74,
0x69, 0x6f, 0x6e, 0x20, 0x62, 0x61, 0x73, 0x65, 0x3d, 0x22, 0x78, 0x73,
0x64, 0x3a, 0x64, 0x6f, 0x75, 0x62, 0x6c, 0x65, 0x22, 0x3e, 0x0a, 0x20,
0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x3c, 0x78, 0x73, 0x64,
0x3a, 0x6d, 0x69, 0x6e, 0x49, 0x6e, 0x63, 0x6c, 0x75, 0x73, 0x69, 0x76,
0x65, 0x20, 0x76, 0x61, 0x6c, 0x75, 0x65, 0x3d, 0x22, 0x30, 0x2e, 0x30,
0x22, 0x2f, 0x3e, 0x0a, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20,
0x20, 0x3c, 0x78, 0x73, 0x64, 0x3a, 0x6d, 0x61, 0x78, 0x49, 0x6e, 0x63,
0x6c, 0x75, 0x73, 0x69, 0x76, 0x65, 0x20, 0x76, 0x61, 0x6c, 0x75, 0x65,
0x3d, 0x22, 0x31, 0x2e, 0x30, 0x22, 0x2f, 0x3e, 0x0a, 0x20, 0x20, 0x20,
0x20, 0x20, 0x20, 0x3c, 0x2f, 0x78, 0x73, 0x64, 0x3a, 0x72, 0x65, 0x73,
0x74, 0x72, 0x69, 0x63, 0x74, 0x69, 0x6f, 0x6e, 0x3e, 0x0a, 0x20, 0x20,
0x20, 0x3c, 0x2f, 0x78, 0x73, 0x64, 0x3a, 0x73, 0x69, 0x6d, 0x70, 0x6c,
0x65, 0x54, 0x79, 0x70, 0x65, 0x3e, 0x0a, 0x0a, 0x20, 0x20, 0x20, 0x3c,
0x78, 0x73, 0x64, 0x3a, 0x63, 0x6f, 0x6d, 0x70, 0x6c, 0x65, 0x78, 0x54,
0x79, 0x70, 0x65, 0x20, 0x6e, 0x61, 0x6d, 0x65, 0x3d, 0x22, 0x53, 0x70,
0x65, 0x63, 0x69, 0x61, 0x6c, 0x54, 0x79, 0x70, 0x65, 0x22, 0x3e, 0x0a,
0x20, 0x20, 0x20, 0x20, 0x20, 0x3c, 0x78, 0x73, 0x64, 0x3a, 0x61, 0x74,
0x74, 0x72, 0x69, 0x62, 0x75, 0x74, 0x65, 0x20, 0x6e, 0x61, 0x6d, 0x65,
0x3d, 0x22, 0x6c, 0x64, 0x61, 0x22, 0x20, 0x74, 0x79, 0x70, 0x65, 0x3d,
0x22, 0x46, 0x6c, 0x65, 0x75, 0x72, 0x42, 0x6f, 0x6f, 0x6c, 0x22, 0x20,
0x75, 0x73, 0x65, 0x3d, 0x22, 0x6f, 0x70, 0x74, 0x69, 0x6f, 0x6e, 0x61,
0x6c, 0x22, 0x20, 0x64, 0x65, 0x66, 0x61, 0x75, 0x6c, 0x74, 0x3d, 0x22,
0x46, 0x22, 0x2f, 0x3e, 0x0a, 0x20, 0x20, 0x20, 0x20, 0x20, 0x3c, 0x78,
0x73, 0x64, 0x3a, 0x61, 0x74, 0x74, 0x72, 0x69, 0x62, 0x75, 0x74, 0x65,
0x20, 0x6e, 0x61, 0x6d, 0x65, 0x3d, 0x22, 0x73, 0x6f, 0x63, 0x73, 0x63,
0x61, 0x6c, 0x65, 0x22, 0x20, 0x74, 0x79, 0x70, 0x65, 0x3d, 0x22, 0x5a,
0x65, 0x72, 0x6f, 0x54, 0x6f, 0x4f, 0x6e, 0x65, 0x4e, 0x75, 0x6d, 0x62,
0x65, 0x72, 0x54, 0x79, 0x70, 0x65, 0x22, 0x20, 0x75, 0x73, 0x65, 0x3d,
0x22, 0x6f, 0x70, 0x74, 0x69, 0x6f, 0x6e, 0x61, 0x6c, 0x22, 0x20, 0x64,
0x65, 0x66, 0x61, 0x75, 0x6c, 0x74, 0x3d, 0x22, 0x31, 0x2e, 0x30, 0x22,
0x2f, 0x3e, 0x0a, 0x20, 0x20, 0x20, 0x3c, 0x2f, 0x78, 0x73, 0x64, 0x3a,
0x63, 0x6f, 0x6d, 0x70, 0x6c, 0x65, 0x78, 0x54, 0x79, 0x70, 0x65, 0x3e,
0x0a, 0x0a, 0x0a, 0x20, 0x20, 0x20, 0x0a, 0x20, 0x20, 0x20, 0x3c, 0x78,
0x73, 0x64, 0x3a, 0x63, 0x6f, 0x6d, 0x70, 0x6c, 0x65, 0x78, 0x54, 0x79,
0x70, 0x65, 0x20, 0x6e, 0x61, 0x6d, 0x65, 0x3d, 0x22, 0x53, 0x70, 0x65,
0x63, 0x69, 0x65, 0x73, 0x54, 0x79, 0x70, 0x65, 0x22, 0x3e, 0x0a, 0x20,
0x20, 0x20, 0x20, 0x20, 0x20, 0x3c, 0x78, 0x73, 0x64, 0x3a, 0x73, 0x65,
0x71, 0x75, 0x65, 0x6e, 0x63, 0x65, 0x3e, 0x0a, 0x20, 0x20, 0x20, 0x20,
0x20, 0x20, 0x20, 0x20, 0x20, 0x3c, 0x78, 0x73, 0x64, 0x3a, 0x65, 0x6c,
0x65, 0x6d, 0x65, 0x6e, 0x74, 0x20, 0x6e, 0x61, 0x6d, 0x65, 0x3d, 0x22,
0x6d, 0x74, 0x53, 0x70, 0x68, 0x65, 0x72, 0x65, 0x22, 0x20, 0x74, 0x79,
0x70, 0x65, 0x3d, 0x22, 0x4d, 0x54, 0x53, 0x70, 0x68, 0x65, 0x72, 0x65,
0x54, 0x79, 0x70, 0x65, 0x22, 0x2f, 0x3e, 0x0a, 0x20, 0x20, 0x20, 0x20,
0x20, 0x20, 0x20, 0x20, 0x20, 0x3c, 0x78, 0x73, 0x64, 0x3a, 0x65, 0x6c,
0x65, 0x6d, 0x65, 0x6e, 0x74, 0x20, 0x6d, 0x61, 0x78, 0x4f, 0x63, 0x63,
0x75, 0x72, 0x73, 0x3d, 0x22, 0x31, 0x22, 0x20, 0x6d, 0x69, 0x6e, 0x4f,
0x63, 0x63, 0x75, 0x72, 0x73, 0x3d, 0x22, 0x30, 0x22, 0x20, 0x6e, 0x61,
0x6d, 0x65, 0x3d, 0x22, 0x65, 0x6e, 0x65, 0x72, 0x67, 0x79, 0x50, 0x61,
0x72, 0x61, 0x6d, 0x65, 0x74, 0x65, 0x72, 0x73, 0x22, 0x20, 0x74, 0x79,
0x70, 0x65, 0x3d, 0x22, 0x45, 0x6e, 0x65, 0x72, 0x67, 0x79, 0x50, 0x61,
0x72, 0x61, 0x6d, 0x65, 0x74, 0x65, 0x72, 0x73, 0x54, 0x79, 0x70, 0x65,
0x22, 0x2f, 0x3e, 0x0a, 0x09, 0x20, 0x3c, 0x78, 0x73, 0x64, 0x3a, 0x65,
0x6c, 0x65, 0x6d, 0x65, 0x6e, 0x74, 0x20, 0x6d, 0x61, 0x78, 0x4f, 0x63,
0x63, 0x75, 0x72, 0x73, 0x3d, 0x22, 0x31, 0x22, 0x20, 0x6d, 0x69, 0x6e,
0x4f, 0x63, 0x63, 0x75, 0x72, 0x73, 0x3d, 0x22, 0x30, 0x22, 0x20, 0x6e,
0x61, 0x6d, 0x65, 0x3d, 0x22, 0x70, 0x72, 0x6f, 0x64, 0x42, 0x61, 0x73,
0x69, 0x73, 0x22, 0x20, 0x74, 0x79, 0x70, 0x65, 0x3d, 0x22, 0x50, 0x72,
0x6f, 0x64, 0x42, 0x61, 0x73, 0x69, 0x73, 0x54, 0x79, 0x70, 0x65, 0x22,
0x2f, 0x3e, 0x0a, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20,
0x3c, 0x78, 0x73, 0x64, 0x3a, 0x65, 0x6c, 0x65, 0x6d, 0x65, 0x6e, 0x74,
0x20, 0x6d, 0x61, 0x78, 0x4f, 0x63, 0x63, 0x75, 0x72, 0x73, 0x3d, 0x22,
0x31, 0x22, 0x20, 0x6d, 0x69, 0x6e, 0x4f, 0x63, 0x63, 0x75, 0x72, 0x73,
0x3d, 0x22, 0x30, 0x22, 0x20, 0x6e, 0x61, 0x6d, 0x65, 0x3d, 0x22, 0x78,
0x63, 0x46, 0x75, 0x6e, 0x63, 0x74, 0x69, 0x6f, 0x6e, 0x61, 0x6c, 0x22,
0x20, 0x74, 0x79, 0x70, 0x65, 0x3d, 0x22, 0x58, 0x43, 0x46, 0x75, 0x6e,
0x63, 0x74, 0x69, 0x6f, 0x6e, 0x61, 0x6c, 0x54, 0x79, 0x70, 0x65, 0x22,
0x65, 0x6d, 0x65, 0x6e, 0x74, 0x20, 0x6e, 0x61, 0x6d, 0x65, 0x3d, 0x22,
0x61, 0x74, 0x6f, 0x6d, 0x69, 0x63, 0x43, 0x75, 0x74, 0x6f, 0x66, 0x66,
0x73, 0x22, 0x20, 0x74, 0x79, 0x70, 0x65, 0x3d, 0x22, 0x41, 0x74, 0x6f,
0x6d, 0x69, 0x63, 0x43, 0x75, 0x74, 0x6f, 0x66, 0x66, 0x73, 0x54, 0x79,
0x70, 0x65, 0x22, 0x2f, 0x3e, 0x0a, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20,
0x20, 0x20, 0x20, 0x3c, 0x78, 0x73, 0x64, 0x3a, 0x65, 0x6c, 0x65, 0x6d,
0x65, 0x6e, 0x74, 0x20, 0x6d, 0x61, 0x78, 0x4f, 0x63, 0x63, 0x75, 0x72,
0x73, 0x3d, 0x22, 0x31, 0x22, 0x20, 0x6d, 0x69, 0x6e, 0x4f, 0x63, 0x63,
0x75, 0x72, 0x73, 0x3d, 0x22, 0x30, 0x22, 0x20, 0x6e, 0x61, 0x6d, 0x65,
0x3d, 0x22, 0x65, 0x6e, 0x65, 0x72, 0x67, 0x79, 0x50, 0x61, 0x72, 0x61,
0x6d, 0x65, 0x74, 0x65, 0x72, 0x73, 0x22, 0x20, 0x74, 0x79, 0x70, 0x65,
0x3d, 0x22, 0x45, 0x6e, 0x65, 0x72, 0x67, 0x79, 0x50, 0x61, 0x72, 0x61,
0x6d, 0x65, 0x74, 0x65, 0x72, 0x73, 0x54, 0x79, 0x70, 0x65, 0x22, 0x2f,
0x3e, 0x0a, 0x09, 0x20, 0x3c, 0x78, 0x73, 0x64, 0x3a, 0x65, 0x6c, 0x65,
0x6d, 0x65, 0x6e, 0x74, 0x20, 0x6d, 0x61, 0x78, 0x4f, 0x63, 0x63, 0x75,
0x72, 0x73, 0x3d, 0x22, 0x31, 0x22, 0x20, 0x6d, 0x69, 0x6e, 0x4f, 0x63,
0x63, 0x75, 0x72, 0x73, 0x3d, 0x22, 0x30, 0x22, 0x20, 0x6e, 0x61, 0x6d,
0x65, 0x3d, 0x22, 0x70, 0x72, 0x6f, 0x64, 0x42, 0x61, 0x73, 0x69, 0x73,
0x22, 0x20, 0x74, 0x79, 0x70, 0x65, 0x3d, 0x22, 0x50, 0x72, 0x6f, 0x64,
0x42, 0x61, 0x73, 0x69, 0x73, 0x54, 0x79, 0x70, 0x65, 0x22, 0x2f, 0x3e,
0x0a, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x3c, 0x78,
0x73, 0x64, 0x3a, 0x65, 0x6c, 0x65, 0x6d, 0x65, 0x6e, 0x74, 0x20, 0x6d,
0x61, 0x78, 0x4f, 0x63, 0x63, 0x75, 0x72, 0x73, 0x3d, 0x22, 0x31, 0x22,
0x20, 0x6d, 0x69, 0x6e, 0x4f, 0x63, 0x63, 0x75, 0x72, 0x73, 0x3d, 0x22,
0x30, 0x22, 0x20, 0x6e, 0x61, 0x6d, 0x65, 0x3d, 0x22, 0x73, 0x70, 0x65,
0x63, 0x69, 0x61, 0x6c, 0x22, 0x20, 0x74, 0x79, 0x70, 0x65, 0x3d, 0x22,
0x53, 0x70, 0x65, 0x63, 0x69, 0x61, 0x6c, 0x54, 0x79, 0x70, 0x65, 0x22,
0x2f, 0x3e, 0x0a, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20,
0x3c, 0x78, 0x73, 0x64, 0x3a, 0x65, 0x6c, 0x65, 0x6d, 0x65, 0x6e, 0x74,
0x20, 0x6d, 0x61, 0x78, 0x4f, 0x63, 0x63, 0x75, 0x72, 0x73, 0x3d, 0x22,
......@@ -3049,4 +3086,4 @@ unsigned char FleurInputSchema_xsd[] = {
0x70, 0x6c, 0x65, 0x54, 0x79, 0x70, 0x65, 0x3e, 0x0a, 0x0a, 0x3c, 0x2f,
0x78, 0x73, 0x64, 0x3a, 0x73, 0x63, 0x68, 0x65, 0x6d, 0x61, 0x3e, 0x0a
};
unsigned int FleurInputSchema_xsd_len = 36588;
unsigned int FleurInputSchema_xsd_len = 37032;
......@@ -42,6 +42,7 @@ CONTAINS
INTEGER i(39),ierr(3)
REAL r(30)
LOGICAL l(43)
CHARACTER(len=4)::namex
! ..
! .. External Subroutines..
#ifdef CPP_MPI
......@@ -52,7 +53,7 @@ CONTAINS
i(7)=stars%ng2 ; i(8)=stars%ng3 ; i(9)=vacuum%nmz ; i(10)=vacuum%nmzxy ; i(11)=obsolete%lepr
i(12)=input%jspins ; i(13)=vacuum%nvac ; i(14)=input%itmax ; i(15)=sliceplot%kk ; i(16)=vacuum%layers
i(17)=sliceplot%nnne ; i(18)=banddos%ndir ; i(19)=stars%mx1 ; i(20)=stars%mx2 ; i(21)=stars%mx3
i(22)=atoms%n_u ; i(23) = sym%nop2 ; i(24) = sym%nsymt ; i(25) = xcpot%icorr ; i(26) = 0!xcpot%igrd
i(22)=atoms%n_u ; i(23) = sym%nop2 ; i(24) = sym%nsymt ; i(25) = 0 ; i(26) = 0!xcpot%igrd
i(27)=vacuum%nstars ; i(28)=vacuum%nstm ; i(29)=oneD%odd%nq2 ; i(30)=oneD%odd%nop
i(31)=input%gw ; i(32)=input%gw_neigd ; i(33)=hybrid%ewaldlambda ; i(34)=hybrid%lexp
i(35)=hybrid%bands1 ; i(36)=1 ; i(37)=input%imix ; i(38)=banddos%orbCompAtom
......@@ -84,12 +85,12 @@ CONTAINS
hybrid%bands1=i(35) ; input%imix=i(37)
input%gw=i(31) ; input%gw_neigd=i(32) ; hybrid%ewaldlambda=i(33) ; hybrid%lexp=i(34)
vacuum%nstars=i(27) ; vacuum%nstm=i(28) ; oneD%odd%nq2=i(29) ; oneD%odd%nop=i(30)
atoms%n_u=i(22) ; sym%nop2=i(23) ; sym%nsymt = i(24) ; xcpot%icorr=i(25) !; xcpot%igrd=i(26)
atoms%n_u=i(22) ; sym%nop2=i(23) ; sym%nsymt = i(24)
sliceplot%nnne=i(17) ; banddos%ndir=i(18) ; stars%mx1=i(19) ; stars%mx2=i(20) ; stars%mx3=i(21)
input%jspins=i(12) ; vacuum%nvac=i(13) ; input%itmax=i(14) ; sliceplot%kk=i(15) ; vacuum%layers=i(16)
stars%ng2=i(7) ; stars%ng3=i(8) ; vacuum%nmz=i(9) ; vacuum%nmzxy=i(10) ; obsolete%lepr=i(11)
atoms%ntype=i(3) ; input%isec1=i(6) ; banddos%orbCompAtom=i(38)
input%coretail_lmax=i(2) ; xcpot%krla=i(4) ; input%kcrel=i(39)
input%coretail_lmax=i(2) ; input%kcrel=i(39)
!
CALL MPI_BCAST(r,SIZE(r),MPI_DOUBLE_PRECISION,0,mpi%mpi_comm,ierr)
input%minDistance=r(29) ; obsolete%chng=r(30)
......@@ -267,9 +268,16 @@ CONTAINS
END IF
!--- HF>
CALL MPI_BCAST(atoms%relcor,atoms%ntype,MPI_LOGICAL,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(atoms%icorr,atoms%ntype,MPI_INTEGER,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(atoms%krla,atoms%ntype,MPI_INTEGER,0,mpi%mpi_comm,ierr)
IF (mpi%irank==0) THEN
namex=xcpot%get_name()
ENDIF
CALL MPI_BCAST(namex,4,MPI_CHARACTER,0,mpi%mpi_comm,ierr)
IF (mpi%irank>0) THEN
call xcpot%init(namex,i(4)==1)
allocate(xcpot%lda_atom(atoms%ntype))
ENDIF
CALL MPI_BCAST(xcpot%lda_atom,atoms%ntype,MPI_LOGICAL,0,mpi%mpi_comm,ierr)
IF(input%l_inpXML) THEN
n = dimension%nstd*atoms%ntype
......
......@@ -67,7 +67,8 @@ CONTAINS
! ..
! .. Local Arrays ..
REAL vx(dimension%nspd,dimension%jspd),vxc(dimension%nspd,dimension%jspd),exc(dimension%nspd),rx(3,dimension%nspd)
! REAL vxl(dimension%nspd,dimension%jspd),vxcl(dimension%nspd,dimension%jspd),excl(dimension%nspd),divi
REAL vxcl(DIMENSION%nspd,DIMENSION%jspd),excl(DIMENSION%nspd),divi
TYPE(t_xcpot)::xcpot_tmp
REAL wt(dimension%nspd),rr2(atoms%jmtd),thet(dimension%nspd)
REAL agr(dimension%nspd),agru(dimension%nspd),agrd(dimension%nspd),g2r(dimension%nspd),g2ru(dimension%nspd)
REAL g2rd(dimension%nspd),gggr(dimension%nspd),gggru(dimension%nspd),gggrd(dimension%nspd)
......@@ -150,7 +151,10 @@ CONTAINS
& chlhdr(atoms%jmtd,0:sphhar%nlhd,dimension%jspd),chlhdrr(atoms%jmtd,0:sphhar%nlhd,dimension%jspd))
DO 200 n = n_start,atoms%ntype,n_stride
IF (xcpot%lda_atom(n))THEN
IF((.NOT.xcpot%is_name("pw91"))) CALL judft_error("Using locally LDA only possible with pw91 functional")
CALL xcpot_tmp%init("l91",.FALSE.)
ENDIF
nat=sum(atoms%neq(:n-1))+1
nd = atoms%ntypsy(nat)
......@@ -191,12 +195,12 @@ CONTAINS
!$OMP& SHARED(vr,vxr,excr,rhmn,ichsmrg,l_gga) &
!$OMP& SHARED(dimension,mpi,sphhar,atoms,rho,xcpot,input,sym,obsolete)&
!$OMP& SHARED(n,nd,ist,ixpm,nsp,nat,d_15,lwbc) &
!$OMP& SHARED(rx,wt,rr2,thet) &
!$OMP& SHARED(rx,wt,rr2,thet,xcpot_tmp) &
!$OMP& SHARED(ylh,ylht,ylhtt,ylhf,ylhff,ylhtf) &
!$OMP& SHARED(chlh,chlhdr,chlhdrr) &
!$OMP& SHARED(ierr,n_start,n_stride) &
!$OMP& PRIVATE(js,k,lh,i,rhmnm,elh,vlh) &
!$OMP& PRIVATE(vx,vxc,exc) &
!$OMP& PRIVATE(vx,vxc,exc,excl,vxcl,divi) &
!$OMP& PRIVATE(agr,agru,agrd,g2r,g2ru,g2rd,gggr,gggru,gggrd,grgru,grgrd,gzgr) &
!$OMP& PRIVATE(ch,chdr,chdt,chdf,chdrr,chdtt,chdff,chdtf,chdrt,chdrf)
ALLOCATE ( ch(dimension%nspd,dimension%jspd),chdr(dimension%nspd,dimension%jspd),chdt(dimension%nspd,dimension%jspd),&
......@@ -303,8 +307,20 @@ CONTAINS
CALL vxcallg(&
& xcpot,lwbc,input%jspins,nsp,nsp,ch,agr,agru,agrd,&
& g2r,g2ru,g2rd,gggr,gggru,gggrd,gzgr,&
& vx,vxc)!keep
& vx,vxc)
IF (xcpot%lda_atom(n)) THEN
! Use local part of pw91 for this atom
CALL vxcallg(&
xcpot_tmp,lwbc,input%jspins,nsp,nsp,ch,agr,agru,agrd,&
g2r,g2ru,g2rd,gggr,gggru,gggrd,gzgr,&
vx,vxcl)
!Mix the potentials
divi = 1.0 / (atoms%rmsh(atoms%jri(n),n) - atoms%rmsh(1,n))
vxc(:,:) = ( vxcl(:,:) * ( atoms%rmsh(atoms%jri(n),n) - atoms%rmsh(jr,n) ) +&
vxc(:,:) * ( atoms%rmsh(jr,n) - atoms%rmsh(1,n) ) ) * divi
ENDIF
IF (mpi%irank == 0) THEN
IF (mod(jr,1000).eq.0)&
......@@ -366,13 +382,19 @@ CONTAINS
!
! calculate the ex.-cor energy density
!
CALL excallg(xcpot,lwbc,input%jspins,nsp,&
& ch,agr,agru,agrd,g2r,g2ru,g2rd,&
& gggr,gggru,gggrd,gzgr,&
& exc)!keep
ch,agr,agru,agrd,g2r,g2ru,g2rd,&
gggr,gggru,gggrd,gzgr, exc)
IF (xcpot%lda_atom(n)) THEN
! Use local part of pw91 for this atom
CALL excallg(xcpot_tmp,lwbc,input%jspins,nsp,&
ch,agr,agru,agrd,g2r,g2ru,g2rd,&
gggr,gggru,gggrd,gzgr, excl)
!Mix the potentials
exc(:) = ( excl(:) * ( atoms%rmsh(atoms%jri(n),n) - atoms%rmsh(jr,n) ) +&
exc(:) * ( atoms%rmsh(jr,n) - atoms%rmsh(1,n) ) ) * divi
ENDIF
IF (mpi%irank == 0) THEN
IF (mod(jr,10000).EQ.0)&
& WRITE (6,'(/'' 999exc''/(10d15.7))') (exc(k),k=1,nsp)
......
......@@ -38,7 +38,7 @@ c----------------------------------------------------------------------
REAL :: dFx_ds,d2Fx_ds2,dFx_dkF,d2Fx_dsdkF
! .. local variables ..
REAL :: um,uk,ul,exunif,fs,fss,fxpbe,p0,s2
REAL :: ul,exunif,fs,fss,fxpbe,p0,s2
REAL :: xwu,css,dxwu,ddx ! for wu-cohen
REAL, PARAMETER :: teo = 10.e0/81.e0 ! for wu-cohen
REAL, PARAMETER :: cwu = 0.0079325 ! for wu-cohen
......@@ -49,26 +49,27 @@ c----------------------------------------------------------------------
c----------------------------------------------------------------------
c uk, ul defined after [a](13) (for icorr==7)
c----------------------------------------------------------------------
IF (xcpot%is_name("pbe").OR.xcpot%is_name("wc").OR.
+ xcpot%is_name("PBEs")) THEN
uk=0.8040
ELSEIF (xcpot%is_name("rpbe")) THEN
uk=1.2450
ELSEIF (xcpot%is_name("Rpbe")) THEN ! changed to [c]
uk=0.8040
ELSEIF (xcpot%is_name("pbe0").OR.xcpot%is_name("hse")
+ .OR. xcpot%is_name("lhse").OR.xcpot%is_name("vhse")) THEN
uk=0.8040
ELSE
CALL judft_error("BUG:Wrong xcpot",calledby="exchpbe.F")
ENDIF
IF (xcpot%is_name("PBEs")) THEN ! pbe_sol
um=0.123456790123456d0
ELSE
um=0.2195149727645171e0
ENDIF
! IF (xcpot%is_name("pbe").OR.xcpot%is_name("wc").OR.
! + xcpot%is_name("PBEs")) THEN
! uk=0.8040
! ELSEIF (xcpot%is_name("rpbe")) THEN
! uk=1.2450
! ELSEIF (xcpot%is_name("Rpbe")) THEN ! changed to [c]
! uk=0.8040
! ELSEIF (xcpot%is_name("pbe0").OR.xcpot%is_name("hse")
! + .OR. xcpot%is_name("lhse").OR.xcpot%is_name("vhse")) THEN
! uk=0.8040
! ELSE
! CALL judft_error("BUG:Wrong xcpot",calledby="exchpbe.F")
! ENDIF
! IF (xcpot%is_name("PBEs")) THEN ! pbe_sol
! um=0.123456790123456d0
! ELSE
! um=0.2195149727645171e0
! ENDIF
ul=um/uk
ul=xcpot%um/xcpot%uk
c----------------------------------------------------------------------
c construct lda exchange energy density:
! e_x[unif] = -0.75 * (3/pi)^(1/3) * rho^(4/3)
......@@ -82,30 +83,25 @@ c----------------------------------------------------------------------
c----------------------------------------------------------------------
c construct pbe enhancement factor
c e_x[pbe]=e_x[unif]*fxpbe(s)
c fxpbe(s)=1+uk-uk/(1+ul*s*s) [a](13)
c fxpbe(s)=1+xcpot%uk-xcpot%uk/(1+ul*s*s) [a](13)
c----------------------------------------------------------------------
s2 = s*s
c +gu
if (xcpot%is_name("pbe").or.xcpot%is_name("rpbe")
& .or.xcpot%is_name("pbe0").or.xcpot%is_name("hse")
& .or.xcpot%is_name("lhse").or.xcpot%is_name("vhse")) then
! calculate fxpbe
p0 = 1.e0 + ul*s2
fxpbe = 1e0 + uk - uk/p0
ELSEIF (xcpot%is_name("Rpbe")) THEN
p0 = 1.e0 + ul*s2
fxpbe = 1e0 + xcpot%uk - xcpot%uk/p0
IF (xcpot%is_Rpbe) THEN
p0 = exp( - ul*s2 )
fxpbe = 1e0 + uk * ( 1e0 - p0 )
ELSEIF (xcpot%is_name("wc")) THEN
fxpbe = 1e0 + xcpot%uk * ( 1e0 - p0 )
ELSEIF (xcpot%is_wc) THEN
css = 1+cwu*s2*s2
xwu = teo*s2 + (um-teo)*s2*exp(-s2) + log(css)
p0 = 1.e0 + xwu/uk
fxpbe = 1e0 + uk - uk/p0
xwu = teo*s2 + (xcpot%um-teo)*s2*exp(-s2) + log(css)
p0 = 1.e0 + xwu/xcpot%uk
fxpbe = 1e0 + xcpot%uk - xcpot%uk/p0
ENDIF
c -gu
! Mixing of short and long range components
IF (xcpot%is_name("hse")
& .or.xcpot%is_name("lhse").or.xcpot%is_name("vhse")) THEN
IF (xcpot%is_hse) THEN
! ex = (1-a)ex,SR + ex,LR
! = (1-a)ex,SR + (ex,PBE - ex,SR)
! = (fxpbe - a*fxhse)*exunif
......@@ -125,21 +121,18 @@ c find first and second derivatives of fx w.r.t s.
c fs=(1/s)*d fxpbe/ ds
c fss=d fs/ds
c----------------------------------------------------------------------
c +gu
if (xcpot%is_name("pbe").or.xcpot%is_name("rpbe")
& .or.xcpot%is_name("pbe0").or.xcpot%is_name("hse")
& .or.xcpot%is_name("lhse").or.xcpot%is_name("vhse")) then
! derivatives for the pbe part
fs = 2.e0*uk*ul/ (p0*p0)
fss = -4.e0*ul*s*fs/p0
ELSEIF (xcpot%is_name("Rpbe")) THEN
fs = 2.e0*xcpot%uk*ul/ (p0*p0)
fss = -4.e0*ul*s*fs/p0
IF (xcpot%is_Rpbe) THEN
fs = 2.e0*ul*p0
fss = -2.e0*ul*s*fs
ELSEIF (xcpot%is_name("wc")) THEN
dxwu = 2*teo + 2*(um-teo)*exp(-s2)*(1-s2) + 4*cwu*s2/css
ELSEIF (xcpot%is_wc) THEN
dxwu = 2*teo + 2*(xcpot%um-teo)*exp(-s2)*(1-s2) + 4*cwu*s2/css
fs = dxwu / (p0*p0)
ddx = 4*s*((um-teo)*exp(-s2)*(s2-2)+2*cwu*(1-cwu*s2*s2)/css**2)
fss = ( ddx - 2*s*dxwu*dxwu/(p0*uk) ) / (p0*p0)
ddx = 4*s*((xcpot%um-teo)*exp(-s2)*(s2-2)+2*cwu*
& (1-cwu*s2*s2)/css**2)
fss = ( ddx - 2*s*dxwu*dxwu/(p0*xcpot%uk) ) / (p0*p0)
ENDIF
c -gu
c----------------------------------------------------------------------
......@@ -147,8 +140,7 @@ c calculate potential from [b](24)
c----------------------------------------------------------------------
vx = exunif* (thrd4*fxpbe- (u-thrd4*s2*s)*fss-v*fs)
IF (.not.(xcpot%is_name("hse").or.xcpot%is_name("lhse")
& .or.xcpot%is_name("vhse"))) RETURN
IF (.not.(xcpot%is_hse)) RETURN
c----------------------------------------------------------------------
c short ranged potential (HSE functional)
......
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