Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
fleur
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
51
Issues
51
List
Boards
Labels
Service Desk
Milestones
Operations
Operations
Incidents
Packages & Registries
Packages & Registries
Container Registry
Analytics
Analytics
Repository
Value Stream
Wiki
Wiki
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Commits
Issue Boards
Open sidebar
fleur
fleur
Commits
d60d35ac
Commit
d60d35ac
authored
Sep 10, 2018
by
Daniel Wortmann
Browse files
Options
Browse Files
Download
Plain Diff
Merge branch 'develop' of iffgit.fz-juelich.de:fleur/fleur into develop
parents
e98b33f2
9161a5b0
Changes
4
Hide whitespace changes
Inline
Side-by-side
Showing
4 changed files
with
406 additions
and
361 deletions
+406
-361
optional/stden.f90
optional/stden.f90
+1
-1
types/types_xcpot.F90
types/types_xcpot.F90
+11
-0
types/types_xcpot_inbuild.F90
types/types_xcpot_inbuild.F90
+158
-150
types/types_xcpot_libxc.F90
types/types_xcpot_libxc.F90
+236
-210
No files found.
optional/stden.f90
View file @
d60d35ac
...
...
@@ -311,7 +311,7 @@ SUBROUTINE stden(mpi,sphhar,stars,atoms,sym,DIMENSION,vacuum,&
END
DO
CALL
qsf
(
vacuum
%
delz
,
sigm
,
vacpar
(
ivac
),
vacuum
%
nmz
,
0
)
denz1
=
den
%
vacz
(
1
,
ivac
,
ispin
)
! get estimate for potential at vacuum boundary
CALL
xcpot
%
get_vxc
(
1
,
denz1
,
vacpot
,
vacxpot
)
CALL
xcpot
%
get_vxc
_start
(
1
,
denz1
,
vacpot
,
vacxpot
)
! seems to be the best choice for 1D not to substract vacpar
IF
(
.NOT.
oneD
%
odi
%
d1
)
THEN
vacpot
=
vacpot
-
fpi_const
*
vacpar
(
ivac
)
...
...
types/types_xcpot.F90
View file @
d60d35ac
...
...
@@ -25,6 +25,7 @@ MODULE m_types_xcpot
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
END
TYPE
t_xcpot
...
...
@@ -92,6 +93,16 @@ CONTAINS
TYPE
(
t_gradients
),
OPTIONAL
,
INTENT
(
INOUT
)::
grad
END
SUBROUTINE
xcpot_get_vxc
SUBROUTINE
xcpot_get_vxc_start
(
xcpot
,
jspins
,
rh
,
vxc
,
vx
,
grad
)
CLASS
(
t_xcpot
),
INTENT
(
IN
)
::
xcpot
INTEGER
,
INTENT
(
IN
)
::
jspins
!--> charge density
REAL
,
INTENT
(
IN
)
::
rh
(:,:)
!---> xc potential
REAL
,
INTENT
(
OUT
)
::
vxc
(:,:),
vx
(:,:)
TYPE
(
t_gradients
),
OPTIONAL
,
INTENT
(
INOUT
)::
grad
END
SUBROUTINE
xcpot_get_vxc_start
SUBROUTINE
xcpot_get_exc
(
xcpot
,
jspins
,
rh
,
exc
,
grad
)
CLASS
(
t_xcpot
),
INTENT
(
IN
)
::
xcpot
...
...
types/types_xcpot_inbuild.F90
View file @
d60d35ac
...
...
@@ -4,149 +4,160 @@
! of the MIT license as expressed in the LICENSE file in more detail.
!--------------------------------------------------------------------------------
MODULE
m_types_xcpot_inbuild
!This module contains the xcpot-type used for the in-build xc-implementations
USE
m_types_xcpot_data
USE
m_types_xcpot
USE
m_judft
IMPLICIT
NONE
PRIVATE
REAL
,
PARAMETER
,
PRIVATE
::
hrtr_half
=
0.5
CHARACTER
(
len
=
4
),
PARAMETER
::
xc_names
(
20
)
=
[&
'l91 '
,
'x-a '
,
'wign'
,
'mjw '
,
'hl '
,
'bh '
,
'vwn '
,
'pz '
,
&
'pw91'
,
'pbe '
,
'rpbe'
,
'Rpbe'
,
'wc '
,
'PBEs'
,
&
'pbe0'
,
'hse '
,
'vhse'
,
'lhse'
,
'exx '
,
'hf '
]
LOGICAL
,
PARAMETER
::
priv_gga
(
20
)
=
[&
.TRUE.
,
.FALSE.
,
.FALSE.
,
.FALSE.
,
.FALSE.
,
.FALSE.
,
.FALSE.
,
.FALSE.
,&
.TRUE.
,
.TRUE.
,
.TRUE.
,
.TRUE.
,
.TRUE.
,
.TRUE.
,&
.TRUE.
,
.TRUE.
,
.TRUE.
,
.TRUE.
,
.FALSE.
,
.FALSE.
]
LOGICAL
,
PARAMETER
::
priv_hybrid
(
20
)
=
[&
.FALSE.
,
.FALSE.
,
.FALSE.
,
.FALSE.
,
.FALSE.
,
.FALSE.
,
.FALSE.
,
.FALSE.
,&
.FALSE.
,
.FALSE.
,
.FALSE.
,
.FALSE.
,
.FALSE.
,
.FALSE.
,&
.TRUE.
,
.TRUE.
,
.TRUE.
,
.TRUE.
,
.TRUE.
,
.TRUE.
]
REAL
,
PARAMETER
::
amix_pbe0
=
0.25
REAL
,
PARAMETER
::
amix_hse
=
0.25
REAL
,
PARAMETER
::
amix_hf
=
1.00
TYPE
,
EXTENDS
(
t_xcpot
)::
t_xcpot_inbuild
#ifdef CPP_MPI
INTEGER
::
icorr
=
0
!not private to allow bcasting it around
!This module contains the xcpot-type used for the in-build xc-implementations
USE
m_types_xcpot_data
USE
m_types_xcpot
USE
m_judft
IMPLICIT
NONE
PRIVATE
REAL
,
PARAMETER
,
PRIVATE
::
hrtr_half
=
0.5
CHARACTER
(
len
=
4
),
PARAMETER
::
xc_names
(
20
)
=
[&
'l91 '
,
'x-a '
,
'wign'
,
'mjw '
,
'hl '
,
'bh '
,
'vwn '
,
'pz '
,
&
'pw91'
,
'pbe '
,
'rpbe'
,
'Rpbe'
,
'wc '
,
'PBEs'
,
&
'pbe0'
,
'hse '
,
'vhse'
,
'lhse'
,
'exx '
,
'hf '
]
LOGICAL
,
PARAMETER
::
priv_gga
(
20
)
=
[&
.TRUE.
,
.FALSE.
,
.FALSE.
,
.FALSE.
,
.FALSE.
,
.FALSE.
,
.FALSE.
,
.FALSE.
,&
.TRUE.
,
.TRUE.
,
.TRUE.
,
.TRUE.
,
.TRUE.
,
.TRUE.
,&
.TRUE.
,
.TRUE.
,
.TRUE.
,
.TRUE.
,
.FALSE.
,
.FALSE.
]
LOGICAL
,
PARAMETER
::
priv_hybrid
(
20
)
=
[&
.FALSE.
,
.FALSE.
,
.FALSE.
,
.FALSE.
,
.FALSE.
,
.FALSE.
,
.FALSE.
,
.FALSE.
,&
.FALSE.
,
.FALSE.
,
.FALSE.
,
.FALSE.
,
.FALSE.
,
.FALSE.
,&
.TRUE.
,
.TRUE.
,
.TRUE.
,
.TRUE.
,
.TRUE.
,
.TRUE.
]
REAL
,
PARAMETER
::
amix_pbe0
=
0.25
REAL
,
PARAMETER
::
amix_hse
=
0.25
REAL
,
PARAMETER
::
amix_hf
=
1.00
TYPE
,
EXTENDS
(
t_xcpot
)::
t_xcpot_inbuild
#ifdef CPP_MPI
INTEGER
::
icorr
=
0
!not private to allow bcasting it around
#else
INTEGER
,
PRIVATE
::
icorr
=
0
INTEGER
,
PRIVATE
::
icorr
=
0
#endif
TYPE
(
t_xcpot_data
)
::
DATA
LOGICAL
,
ALLOCATABLE
::
lda_atom
(:)
TYPE
(
t_xcpot_data
)
::
DATA
LOGICAL
,
ALLOCATABLE
::
lda_atom
(:)
CONTAINS
!overloading t_xcpot:
PROCEDURE
::
is_gga
=>
xcpot_is_gga
PROCEDURE
::
is_hybrid
=>
xcpot_is_hybrid
PROCEDURE
::
get_exchange_weight
=>
xcpot_get_exchange_weight
PROCEDURE
::
get_vxc
=>
xcpot_get_vxc
PROCEDURE
::
get_exc
=>
xcpot_get_exc
!not overloaded
PROCEDURE
::
get_name
=>
xcpot_get_name
PROCEDURE
::
is_name
=>
xcpot_is_name
PROCEDURE
::
init
=>
xcpot_init
END
TYPE
t_xcpot_inbuild
PUBLIC
t_xcpot_inbuild
!overloading t_xcpot:
PROCEDURE
::
is_gga
=>
xcpot_is_gga
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
!not overloaded
PROCEDURE
::
get_name
=>
xcpot_get_name
PROCEDURE
::
is_name
=>
xcpot_is_name
PROCEDURE
::
init
=>
xcpot_init
END
TYPE
t_xcpot_inbuild
PUBLIC
t_xcpot_inbuild
CONTAINS
CHARACTER
(
len
=
4
)
FUNCTION
xcpot_get_name
(
xcpot
)
USE
m_judft
IMPLICIT
NONE
CLASS
(
t_xcpot_inbuild
),
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
,
ntype
)
USE
m_judft
IMPLICIT
NONE
CLASS
(
t_xcpot_inbuild
),
INTENT
(
INOUT
)
::
xcpot
CHARACTER
(
len
=*
),
INTENT
(
IN
)
::
namex
LOGICAL
,
INTENT
(
IN
)
::
relcor
INTEGER
,
INTENT
(
IN
)
::
ntype
INTEGER
::
n
!Determine icorr from name
ALLOCATE
(
xcpot
%
lda_atom
(
ntype
))
xcpot
%
lda_atom
=
.FALSE.
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
%
data
%
krla
=
MERGE
(
1
,
0
,
relcor
)
!Code from exchpbe to speed up determination of constants
IF
(
xcpot
%
is_name
(
"rpbe"
))
THEN
xcpot
%
data
%
uk
=
1.2450
ELSE
xcpot
%
data
%
uk
=
0.8040
ENDIF
IF
(
xcpot
%
is_name
(
"PBEs"
))
THEN
! pbe_sol
xcpot
%
data
%
um
=
0.123456790123456d0
ELSE
xcpot
%
data
%
um
=
0.2195149727645171e0
ENDIF
xcpot
%
data
%
is_hse
=
xcpot
%
is_name
(
"hse"
)
.OR.
xcpot
%
is_name
(
"lhse"
)
.OR.
xcpot
%
is_name
(
"vhse"
)
xcpot
%
data
%
is_rpbe
=
xcpot
%
is_name
(
"Rpbe"
)
!Rpbe
xcpot
%
data
%
is_wc
=
xcpot
%
is_name
(
"wc"
)
xcpot
%
data
%
is_pbes
=
xcpot
%
is_name
(
"PBEs"
)
xcpot
%
data
%
is_pbe0
=
xcpot
%
is_name
(
"pbe0"
)
xcpot
%
data
%
is_mjw
=
xcpot
%
is_name
(
"mjw"
)
xcpot
%
data
%
is_bh
=
xcpot
%
is_name
(
"bh"
)
xcpot
%
DATA
%
exchange_weight
=
xcpot
%
get_exchange_weight
()
END
SUBROUTINE
xcpot_init
LOGICAL
FUNCTION
xcpot_is_gga
(
xcpot
)
IMPLICIT
NONE
CLASS
(
t_xcpot_inbuild
),
INTENT
(
IN
)::
xcpot
xcpot_is_gga
=
priv_gga
(
xcpot
%
icorr
)
END
FUNCTION
xcpot_is_gga
LOGICAL
FUNCTION
xcpot_is_hybrid
(
xcpot
)
IMPLICIT
NONE
CLASS
(
t_xcpot_inbuild
),
INTENT
(
IN
)::
xcpot
xcpot_is_hybrid
=
priv_hybrid
(
xcpot
%
icorr
)
END
FUNCTION
xcpot_is_hybrid
FUNCTION
xcpot_get_exchange_weight
(
xcpot
)
RESULT
(
a_ex
)
USE
m_judft
IMPLICIT
NONE
CLASS
(
t_xcpot_inbuild
),
INTENT
(
IN
)::
xcpot
REAL
::
a_ex
a_ex
=
-1
IF
(
xcpot
%
is_name
(
"pbe0"
))
a_ex
=
amix_pbe0
IF
(
xcpot
%
is_name
(
"hf"
))
a_ex
=
amix_hf
IF
(
xcpot
%
is_name
(
"hse"
))
a_ex
=
amix_hse
IF
(
xcpot
%
is_name
(
"vhse"
))
a_ex
=
amix_hse
END
FUNCTION
xcpot_get_exchange_weight
CHARACTER
(
len
=
4
)
FUNCTION
xcpot_get_name
(
xcpot
)
USE
m_judft
IMPLICIT
NONE
CLASS
(
t_xcpot_inbuild
),
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_get_vxc
(
xcpot
,
jspins
,
rh
,
vxc
,
vx
,
grad
)
!***********************************************************************
SUBROUTINE
xcpot_init
(
xcpot
,
namex
,
relcor
,
ntype
)
USE
m_judft
IMPLICIT
NONE
CLASS
(
t_xcpot_inbuild
),
INTENT
(
INOUT
)
::
xcpot
CHARACTER
(
len
=*
),
INTENT
(
IN
)
::
namex
LOGICAL
,
INTENT
(
IN
)
::
relcor
INTEGER
,
INTENT
(
IN
)
::
ntype
INTEGER
::
n
!Determine icorr from name
ALLOCATE
(
xcpot
%
lda_atom
(
ntype
))
xcpot
%
lda_atom
=
.FALSE.
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
%
data
%
krla
=
MERGE
(
1
,
0
,
relcor
)
!Code from exchpbe to speed up determination of constants
IF
(
xcpot
%
is_name
(
"rpbe"
))
THEN
xcpot
%
data
%
uk
=
1.2450
ELSE
xcpot
%
data
%
uk
=
0.8040
ENDIF
IF
(
xcpot
%
is_name
(
"PBEs"
))
THEN
! pbe_sol
xcpot
%
data
%
um
=
0.123456790123456d0
ELSE
xcpot
%
data
%
um
=
0.2195149727645171e0
ENDIF
xcpot
%
data
%
is_hse
=
xcpot
%
is_name
(
"hse"
)
.OR.
xcpot
%
is_name
(
"lhse"
)
.OR.
xcpot
%
is_name
(
"vhse"
)
xcpot
%
data
%
is_rpbe
=
xcpot
%
is_name
(
"Rpbe"
)
!Rpbe
xcpot
%
data
%
is_wc
=
xcpot
%
is_name
(
"wc"
)
xcpot
%
data
%
is_pbes
=
xcpot
%
is_name
(
"PBEs"
)
xcpot
%
data
%
is_pbe0
=
xcpot
%
is_name
(
"pbe0"
)
xcpot
%
data
%
is_mjw
=
xcpot
%
is_name
(
"mjw"
)
xcpot
%
data
%
is_bh
=
xcpot
%
is_name
(
"bh"
)
xcpot
%
DATA
%
exchange_weight
=
xcpot
%
get_exchange_weight
()
END
SUBROUTINE
xcpot_init
LOGICAL
FUNCTION
xcpot_is_gga
(
xcpot
)
IMPLICIT
NONE
CLASS
(
t_xcpot_inbuild
),
INTENT
(
IN
)::
xcpot
xcpot_is_gga
=
priv_gga
(
xcpot
%
icorr
)
END
FUNCTION
xcpot_is_gga
LOGICAL
FUNCTION
xcpot_is_hybrid
(
xcpot
)
IMPLICIT
NONE
CLASS
(
t_xcpot_inbuild
),
INTENT
(
IN
)::
xcpot
xcpot_is_hybrid
=
priv_hybrid
(
xcpot
%
icorr
)
END
FUNCTION
xcpot_is_hybrid
FUNCTION
xcpot_get_exchange_weight
(
xcpot
)
RESULT
(
a_ex
)
USE
m_judft
IMPLICIT
NONE
CLASS
(
t_xcpot_inbuild
),
INTENT
(
IN
)::
xcpot
REAL
::
a_ex
a_ex
=
-1
IF
(
xcpot
%
is_name
(
"pbe0"
))
a_ex
=
amix_pbe0
IF
(
xcpot
%
is_name
(
"hf"
))
a_ex
=
amix_hf
IF
(
xcpot
%
is_name
(
"hse"
))
a_ex
=
amix_hse
IF
(
xcpot
%
is_name
(
"vhse"
))
a_ex
=
amix_hse
END
FUNCTION
xcpot_get_exchange_weight
SUBROUTINE
xcpot_get_vxc_start
(
xcpot
,
jspins
,
rh
,
vxc
,
vx
,
grad
)
CLASS
(
t_xcpot_inbuild
),
INTENT
(
IN
)
::
xcpot
INTEGER
,
INTENT
(
IN
)
::
jspins
REAL
,
INTENT
(
IN
)
::
rh
(:,:)
REAL
,
INTENT
(
OUT
)
::
vx
(:,:)
REAL
,
INTENT
(
OUT
)
::
vxc
(:,:)
TYPE
(
t_gradients
),
INTENT
(
INOUT
),
OPTIONAL
::
grad
! there is no difference for inbuild case
call
xcpot
%
get_vxc
(
jspins
,
rh
,
vxc
,
vx
,
grad
)
END
SUBROUTINE
xcpot_get_vxc_start
SUBROUTINE
xcpot_get_vxc
(
xcpot
,
jspins
,
rh
,
vxc
,
vx
,
grad
)
!
USE
m_xcxal
,
ONLY
:
vxcxal
USE
m_xcwgn
,
ONLY
:
vxcwgn
USE
m_xcbh
,
ONLY
:
vxcbh
USE
m_xcvwn
,
ONLY
:
vxcvwn
USE
m_xcpz
,
ONLY
:
vxcpz
USE
m_vxcl91
USE
m_vxcwb91
USE
m_vxcpw91
USE
m_vxcepbe
USE
m_xcxal
,
ONLY
:
vxcxal
USE
m_xcwgn
,
ONLY
:
vxcwgn
USE
m_xcbh
,
ONLY
:
vxcbh
USE
m_xcvwn
,
ONLY
:
vxcvwn
USE
m_xcpz
,
ONLY
:
vxcpz
USE
m_vxcl91
USE
m_vxcwb91
USE
m_vxcpw91
USE
m_vxcepbe
IMPLICIT
NONE
!c
!c---> running mode parameters
...
...
@@ -182,7 +193,7 @@ CONTAINS
vx
(:,:)
=
0.0
vxc
(:,:)
=
0.0
ngrid
=
SIZE
(
rh
,
1
)
IF
(
xcpot
%
is_gga
())
THEN
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
...
...
@@ -205,7 +216,7 @@ CONTAINS
CALL
vxcwgn
(
xcpot
%
data
%
krla
,
jspins
,
ngrid
,
ngrid
,
rh
(:
ngrid
,:),
vx
(:
ngrid
,:),
vxc
(:
ngrid
,:))
ELSEIF
(
xcpot
%
is_name
(
"mjw"
)
.OR.
xcpot
%
is_name
(
"bh"
))
THEN
! von Barth,Hedin correlation
CALL
vxcbh
(
iofile
,
xcpot
%
data
,
jspins
,
ngrid
,
ngrid
,
rh
(:
ngrid
,:),
vx
(:
ngrid
,:),
vxc
(:
ngrid
,:))
ELSEIF
(
xcpot
%
is_name
(
"vwn"
))
THEN
! Vosko,Wilk,Nusair correlation
CALL
vxcvwn
(
iofile
,
xcpot
%
data
%
krla
,
jspins
,
ngrid
,
ngrid
,
rh
(:
ngrid
,:),
vx
(:
ngrid
,:),
vxc
(:
ngrid
,:))
ELSEIF
(
xcpot
%
is_name
(
"pz"
))
THEN
! Perdew,Zunger correlation
...
...
@@ -226,12 +237,12 @@ CONTAINS
!-----> hartree units
!
vx
=
hrtr_half
*
vx
vxc
=
hrtr_half
*
vxc
END
SUBROUTINE
xcpot_get_vxc
vxc
=
hrtr_half
*
vxc
END
SUBROUTINE
xcpot_get_vxc
!***********************************************************************
SUBROUTINE
xcpot_get_exc
(
xcpot
,
jspins
,
rh
,
exc
,
grad
)
SUBROUTINE
xcpot_get_exc
(
xcpot
,
jspins
,
rh
,
exc
,
grad
)
!***********************************************************************
USE
m_xcxal
,
ONLY
:
excxal
USE
m_xcwgn
,
ONLY
:
excwgn
...
...
@@ -305,16 +316,13 @@ CONTAINS
ENDIF
!c-----> hartree units
exc
=
hrtr_half
*
exc
END
SUBROUTINE
xcpot_get_exc
LOGICAL
FUNCTION
xcpot_is_name
(
xcpot
,
name
)
END
SUBROUTINE
xcpot_get_exc
LOGICAL
FUNCTION
xcpot_is_name
(
xcpot
,
name
)
CLASS
(
t_xcpot_inbuild
),
INTENT
(
IN
)::
xcpot
CHARACTER
(
len
=*
),
INTENT
(
IN
)
::
name
xcpot_is_name
=
(
TRIM
(
xc_names
(
xcpot
%
icorr
))
==
TRIM
((
name
)))
END
FUNCTION
xcpot_is_name
END
FUNCTION
xcpot_is_name
END
MODULE
m_types_xcpot_inbuild
END
MODULE
m_types_xcpot_inbuild
types/types_xcpot_libxc.F90
View file @
d60d35ac
...
...
@@ -6,246 +6,272 @@
!>This module contains the xcpot-type providing an interface to libxc
MODULE
m_types_xcpot_libxc
#ifdef CPP_LIBXC
USE
xc_f03_lib_m
#ifdef CPP_LIBXC
USE
xc_f03_lib_m
#endif
USE
m_types_xcpot
USE
m_judft
IMPLICIT
NONE
PRIVATE
TYPE
,
EXTENDS
(
t_xcpot
)::
t_xcpot_libxc
#ifdef CPP_LIBXC
TYPE
(
xc_f03_func_t
)
::
xc_func_x
,
xc_func_c
TYPE
(
xc_f03_func_info_t
)
::
xc_info_x
,
xc_info_c
USE
m_types_xcpot
USE
m_judft
IMPLICIT
NONE
PRIVATE
TYPE
,
EXTENDS
(
t_xcpot
)::
t_xcpot_libxc
#ifdef CPP_LIBXC
TYPE
(
xc_f03_func_t
)
::
xc_func_x
,
xc_func_c
TYPE
(
xc_f03_func_info_t
)
::
xc_info_x
,
xc_info_c
#endif
INTEGER
::
func_id_c
,
func_id_x
,
jspins
INTEGER
::
func_id_c
,
func_id_x
,
jspins
CONTAINS
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_exc
=>
xcpot_get_exc
PROCEDURE
,
NOPASS
::
alloc_gradients
=>
xcpot_alloc_gradients
!Not overloeaded...
PROCEDURE
::
init
=>
xcpot_init
END
TYPE
t_xcpot_libxc
PUBLIC
t_xcpot_libxc
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...
PROCEDURE
::
init
=>
xcpot_init
END
TYPE
t_xcpot_libxc
PUBLIC
t_xcpot_libxc
CONTAINS
SUBROUTINE
xcpot_init
(
xcpot
,
jspins
,
id_x
,
id_c
)
USE
m_judft
IMPLICIT
NONE
CLASS
(
t_xcpot_libxc
),
INTENT
(
OUT
)
::
xcpot
INTEGER
,
INTENT
(
IN
)
::
jspins
,
id_x
,
id_c
SUBROUTINE
xcpot_init
(
xcpot
,
jspins
,
id_x
,
id_c
)
USE
m_judft
IMPLICIT
NONE
CLASS
(
t_xcpot_libxc
),
INTENT
(
OUT
)
::
xcpot
INTEGER
,
INTENT
(
IN
)
::
jspins
,
id_x
,
id_c
#ifdef CPP_LIBXC
INTEGER
::
err
xcpot
%
jspins
=
jspins
xcpot
%
func_id_x
=
id_x
xcpot
%
func_id_c
=
id_c
if
(
xcpot
%
func_id_x
==
0
.or.
xcpot
%
func_id_c
==
0
)
then
CALL
judft_error
(
"LibXC exchange- and correlation-function indicies need to be set"
&
,
hint
=
'Try this: '
//
ACHAR
(
10
)
//&
'<xcFunctional name="libxc" relativisticCorrections="F">'
//
ACHAR
(
10
)
//&
' <libXC exchange="1" correlation="1" /> '
//
ACHAR
(
10
)
//&
'</xcFunctional> '
)
endif
IF
(
jspins
==
1
)
THEN
CALL
xc_f03_func_init
(
xcpot
%
xc_func_x
,
xcpot
%
func_id_x
,
XC_UNPOLARIZED
)
IF
(
xcpot
%
func_id_c
>
0
)
CALL
xc_f03_func_init
(
xcpot
%
xc_func_c
,
xcpot
%
func_id_c
,
XC_UNPOLARIZED
)
ELSE
CALL
xc_f03_func_init
(
xcpot
%
xc_func_x
,
xcpot
%
func_id_x
,
XC_POLARIZED
)
IF
(
xcpot
%
func_id_c
>
0
)
CALL
xc_f03_func_init
(
xcpot
%
xc_func_c
,
xcpot
%
func_id_c
,
XC_POLARIZED
)
END
IF
xcpot
%
xc_info_x
=
xc_f03_func_get_info
(
xcpot
%
xc_func_x
)
CALL
priv_write_info
(
xcpot
%
xc_info_x
)
IF
(
xcpot
%
func_id_c
>
0
)
THEN
xcpot
%
xc_info_c
=
xc_f03_func_get_info
(
xcpot
%
xc_func_c
)
CALL
priv_write_info
(
xcpot
%
xc_info_c
)
ELSE
WRITE
(
*
,
*
)
"No Correlation functional"
END
IF
INTEGER
::
err
xcpot
%
jspins
=
jspins
xcpot
%
func_id_x
=
id_x
xcpot
%
func_id_c
=
id_c
if
(
xcpot
%
func_id_x
==
0
.or.
xcpot
%
func_id_c
==
0
)
then
CALL
judft_error
(
"LibXC exchange- and correlation-function indicies need to be set"
&
,
hint
=
'Try this: '
//
ACHAR
(
10
)
//&
'<xcFunctional name="libxc" relativisticCorrections="F">'
//
ACHAR
(
10
)
//&
' <libXC exchange="1" correlation="1" /> '
//
ACHAR
(
10
)
//&
'</xcFunctional> '
)
endif
IF
(
jspins
==
1
)
THEN
CALL
xc_f03_func_init
(
xcpot
%
xc_func_x
,
xcpot
%
func_id_x
,
XC_UNPOLARIZED
)
IF
(
xcpot
%
func_id_c
>
0
)
CALL
xc_f03_func_init
(
xcpot
%
xc_func_c
,
xcpot
%
func_id_c
,
XC_UNPOLARIZED
)
ELSE
CALL
xc_f03_func_init
(
xcpot
%
xc_func_x
,
xcpot
%
func_id_x
,
XC_POLARIZED
)
IF
(
xcpot
%
func_id_c
>
0
)
CALL
xc_f03_func_init
(
xcpot
%
xc_func_c
,
xcpot
%
func_id_c
,
XC_POLARIZED
)
END
IF
xcpot
%
xc_info_x
=
xc_f03_func_get_info
(
xcpot
%
xc_func_x
)
CALL
priv_write_info
(
xcpot
%
xc_info_x
)
IF
(
xcpot
%
func_id_c
>
0
)
THEN
xcpot
%
xc_info_c
=
xc_f03_func_get_info
(
xcpot
%
xc_func_c
)
CALL
priv_write_info
(
xcpot
%
xc_info_c
)
ELSE
WRITE
(
*
,
*
)
"No Correlation functional"
END
IF
#else
CALL
judft_error
(
"You specified a libxc-exchange correlation potential but FLEUR is not linked against libxc"
,
&
hint
=
"Please recompile FLEUR with libxc support"
)
CALL
judft_error
(
"You specified a libxc-exchange correlation potential but FLEUR is not linked against libxc"
,
&
hint
=
"Please recompile FLEUR with libxc support"
)
#endif
END
SUBROUTINE
xcpot_init
END
SUBROUTINE
xcpot_init
LOGICAL
FUNCTION
xcpot_is_gga
(
xcpot
)
IMPLICIT
NONE
CLASS
(
t_xcpot_libxc
),
INTENT
(
IN
)::
xcpot
#ifdef CPP_LIBXC
xcpot_is_gga
=
ANY
((/
XC_FAMILY_GGA
,
XC_FAMILY_HYB_GGA
/)
==
xc_f03_func_info_get_family
(
xcpot
%
xc_info_x
))
#else
xcpot_is_gga
=
.false.
#endif
END
FUNCTION
xcpot_is_gga
LOGICAL
FUNCTION
xcpot_is_gga
(
xcpot
)
IMPLICIT
NONE
CLASS
(
t_xcpot_libxc
),
INTENT
(
IN
)::
xcpot
#ifdef CPP_LIBXC
xcpot_is_gga
=
ANY
((/
XC_FAMILY_GGA
,
XC_FAMILY_HYB_GGA
/)
==
xc_f03_func_info_get_family
(
xcpot
%
xc_info_x
))
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_gga
=
.false.
xcpot_is_LDA
=
.false.
#endif
END
FUNCTION
xcpot_is_gga
END
FUNCTION
xcpot_is_LDA
LOGICAL
FUNCTION
xcpot_is_MetaGGA
(
xcpot
)
IMPLICIT
NONE
CLASS
(
t_xcpot_libxc
),
INTENT
(
IN
)::
xcpot
#ifdef CPP_LIBXC
xcpot_is_MetaGGA
=
ANY
((/
XC_FAMILY_MGGA
,
XC_FAMILY_HYB_MGGA
/)
==
xc_f03_func_info_get_family
(
xcpot
%
xc_info_x
))
LOGICAL
FUNCTION
xcpot_is_MetaGGA
(
xcpot
)
IMPLICIT
NONE
CLASS
(
t_xcpot_libxc
),
INTENT
(
IN
)::
xcpot
#ifdef CPP_LIBXC
xcpot_is_MetaGGA
=
ANY
((/
XC_FAMILY_MGGA
,
XC_FAMILY_HYB_MGGA
/)
==
xc_f03_func_info_get_family
(
xcpot
%
xc_info_x
))
#else
xcpot_is_MetaGGA
=
.false.
xcpot_is_MetaGGA
=
.false.
#endif
END
FUNCTION
xcpot_is_MetaGGA
END
FUNCTION
xcpot_is_MetaGGA
LOGICAL
FUNCTION
xcpot_is_hybrid
(
xcpot
)
IMPLICIT
NONE
CLASS
(
t_xcpot_libxc
),
INTENT
(
IN
)::
xcpot
LOGICAL
FUNCTION
xcpot_is_hybrid
(
xcpot
)
IMPLICIT
NONE
CLASS
(
t_xcpot_libxc
),
INTENT
(
IN
)::
xcpot
#ifdef CPP_LIBXC
xcpot_is_hybrid
=
ANY
((/
XC_FAMILY_HYB_MGGA
,
XC_FAMILY_HYB_GGA
/)
==
xc_f03_func_info_get_family
(
xcpot
%
xc_info_x
))
xcpot_is_hybrid
=
ANY
((/
XC_FAMILY_HYB_MGGA
,
XC_FAMILY_HYB_GGA
/)
==
xc_f03_func_info_get_family
(
xcpot
%
xc_info_x
))
#else
xcpot_is_hybrid
=
.false.
xcpot_is_hybrid
=
.false.
#endif
END
FUNCTION
xcpot_is_hybrid
END
FUNCTION
xcpot_is_hybrid
FUNCTION
xcpot_get_exchange_weight
(
xcpot
)
RESULT
(
a_ex
)
USE
m_judft
IMPLICIT
NONE
CLASS
(
t_xcpot_libxc
),
INTENT
(
IN
)::
xcpot
FUNCTION
xcpot_get_exchange_weight
(
xcpot
)
RESULT
(
a_ex
)
USE
m_judft
IMPLICIT
NONE
CLASS
(
t_xcpot_libxc
),
INTENT
(
IN
)::
xcpot
REAL
::
a_ex
#ifdef CPP_LIBXC
a_ex
=
xc_f03_hyb_exx_coef
(
xcpot
%
xc_func_x
)
#endif
END
FUNCTION
xcpot_get_exchange_weight
!***********************************************************************
SUBROUTINE
xcpot_get_vxc
(
xcpot
,
jspins
,
rh
,
vxc
,
vx
,
grad
)
!***********************************************************************
IMPLICIT
NONE
CLASS
(
t_xcpot_libxc
),
INTENT
(
IN
)
::
xcpot
INTEGER
,
INTENT
(
IN
)
::
jspins