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
52
Issues
52
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
cbac3b75
Commit
cbac3b75
authored
Sep 12, 2018
by
Matthias Redies
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
put changes on branch
parent
55719b61
Changes
6
Hide whitespace changes
Inline
Side-by-side
Showing
6 changed files
with
453 additions
and
119 deletions
+453
-119
cdn_mt/cdncore.F90
cdn_mt/cdncore.F90
+39
-34
core/cored.F90
core/cored.F90
+39
-23
types/types_xcpot_libxc.F90
types/types_xcpot_libxc.F90
+105
-54
vgen/vgen_xcpot.F90
vgen/vgen_xcpot.F90
+8
-8
xc-pot/CMakeLists.txt
xc-pot/CMakeLists.txt
+1
-0
xc-pot/metagga.F90
xc-pot/metagga.F90
+261
-0
No files found.
cdn_mt/cdncore.F90
View file @
cbac3b75
...
...
@@ -9,7 +9,7 @@ MODULE m_cdncore
CONTAINS
SUBROUTINE
cdncore
(
mpi
,
dimension
,
oneD
,
input
,
vacuum
,
noco
,
sym
,&
stars
,
cell
,
sphhar
,
atoms
,
vTot
,
outDen
,
moments
,
results
)
stars
,
cell
,
sphhar
,
atoms
,
vTot
,
outDen
,
moments
,
results
,
EnergyDen
)
USE
m_constants
USE
m_cdn_io
...
...
@@ -27,21 +27,22 @@ SUBROUTINE cdncore(mpi,dimension,oneD,input,vacuum,noco,sym,&
IMPLICIT
NONE
TYPE
(
t_mpi
),
INTENT
(
IN
)
::
mpi
TYPE
(
t_dimension
),
INTENT
(
IN
)
::
dimension
TYPE
(
t_oneD
),
INTENT
(
IN
)
::
oneD
TYPE
(
t_input
),
INTENT
(
IN
)
::
input
TYPE
(
t_vacuum
),
INTENT
(
IN
)
::
vacuum
TYPE
(
t_noco
),
INTENT
(
IN
)
::
noco
TYPE
(
t_sym
),
INTENT
(
IN
)
::
sym
TYPE
(
t_stars
),
INTENT
(
IN
)
::
stars
TYPE
(
t_cell
),
INTENT
(
IN
)
::
cell
TYPE
(
t_sphhar
),
INTENT
(
IN
)
::
sphhar
TYPE
(
t_atoms
),
INTENT
(
IN
)
::
atoms
TYPE
(
t_potden
),
INTENT
(
IN
)
::
vTot
TYPE
(
t_potden
),
INTENT
(
INOUT
)
::
outDen
TYPE
(
t_moments
),
INTENT
(
INOUT
)
::
moments
TYPE
(
t_results
),
INTENT
(
INOUT
)
::
results
TYPE
(
t_mpi
),
INTENT
(
IN
)
::
mpi
TYPE
(
t_dimension
),
INTENT
(
IN
)
::
dimension
TYPE
(
t_oneD
),
INTENT
(
IN
)
::
oneD
TYPE
(
t_input
),
INTENT
(
IN
)
::
input
TYPE
(
t_vacuum
),
INTENT
(
IN
)
::
vacuum
TYPE
(
t_noco
),
INTENT
(
IN
)
::
noco
TYPE
(
t_sym
),
INTENT
(
IN
)
::
sym
TYPE
(
t_stars
),
INTENT
(
IN
)
::
stars
TYPE
(
t_cell
),
INTENT
(
IN
)
::
cell
TYPE
(
t_sphhar
),
INTENT
(
IN
)
::
sphhar
TYPE
(
t_atoms
),
INTENT
(
IN
)
::
atoms
TYPE
(
t_potden
),
INTENT
(
IN
)
::
vTot
TYPE
(
t_potden
),
INTENT
(
INOUT
)
::
outDen
TYPE
(
t_moments
),
INTENT
(
INOUT
)
::
moments
TYPE
(
t_results
),
INTENT
(
INOUT
)
::
results
TYPE
(
t_potden
),
INTENT
(
INOUT
),
OPTIONAL
::
EnergyDen
INTEGER
::
jspin
,
n
,
iType
REAL
::
seig
,
rhoint
,
momint
...
...
@@ -53,7 +54,7 @@ SUBROUTINE cdncore(mpi,dimension,oneD,input,vacuum,noco,sym,&
REAL
::
rhTemp
(
dimension
%
msh
,
atoms
%
ntype
,
dimension
%
jspd
)
results
%
seigc
=
0.0
IF
(
mpi
%
irank
.EQ.
0
)
THEN
IF
(
mpi
%
irank
==
0
)
THEN
DO
jspin
=
1
,
input
%
jspins
DO
n
=
1
,
atoms
%
ntype
moments
%
svdn
(
n
,
jspin
)
=
outDen
%
mt
(
1
,
0
,
n
,
jspin
)
/
(
sfp_const
*
atoms
%
rmsh
(
1
,
n
)
*
atoms
%
rmsh
(
1
,
n
))
...
...
@@ -61,10 +62,10 @@ SUBROUTINE cdncore(mpi,dimension,oneD,input,vacuum,noco,sym,&
END
DO
END
IF
IF
(
input
%
kcrel
.EQ.
0
)
THEN
IF
(
input
%
kcrel
==
0
)
THEN
! Generate input file ecore for subsequent GW calculation
! 11.2.2004 Arno Schindlmayr
IF
((
input
%
gw
.eq.
1
.or.
input
%
gw
.eq.
3
)
.AND.
(
mpi
%
irank
.EQ.
0
))
THEN
IF
((
input
%
gw
==
1
.or.
input
%
gw
==
3
)
.AND.
(
mpi
%
irank
==
0
))
THEN
OPEN
(
15
,
file
=
'ecore'
,
status
=
'unknown'
,
action
=
'write'
,
form
=
'unformatted'
)
END
IF
...
...
@@ -72,7 +73,7 @@ SUBROUTINE cdncore(mpi,dimension,oneD,input,vacuum,noco,sym,&
tec
=
0.0
qint
=
0.0
IF
(
input
%
frcor
)
THEN
IF
(
mpi
%
irank
.EQ.
0
)
THEN
IF
(
mpi
%
irank
==
0
)
THEN
CALL
readCoreDensity
(
input
,
atoms
,
dimension
,
rh
,
tec
,
qint
)
END
IF
#ifdef CPP_MPI
...
...
@@ -82,51 +83,55 @@ SUBROUTINE cdncore(mpi,dimension,oneD,input,vacuum,noco,sym,&
END
IF
!add in core density
IF
(
mpi
%
irank
.EQ.
0
)
THEN
IF
(
input
%
kcrel
.EQ.
0
)
THEN
IF
(
mpi
%
irank
==
0
)
THEN
IF
(
input
%
kcrel
==
0
)
THEN
DO
jspin
=
1
,
input
%
jspins
CALL
cored
(
input
,
jspin
,
atoms
,
outDen
%
mt
,
dimension
,
sphhar
,
vTot
%
mt
(:,
0
,:,
jspin
),
qint
,
rh
,
tec
,
seig
)
CALL
cored
(
input
,
jspin
,
atoms
,
outDen
%
mt
,
dimension
,
sphhar
,
vTot
%
mt
(:,
0
,:,
jspin
),
qint
,
rh
,
tec
,
seig
,
EnergyDen
%
mt
)
rhTemp
(:,:,
jspin
)
=
rh
(:,:,
jspin
)
results
%
seigc
=
results
%
seigc
+
seig
END
DO
ELSE
IF
(
PRESENT
(
EnergyDen
))
call
juDFT_error
(
"Energyden not implemented for relativistic"
)
CALL
coredr
(
input
,
atoms
,
seig
,
outDen
%
mt
,
dimension
,
sphhar
,
vTot
%
mt
(:,
0
,:,:),
qint
,
rh
)
results
%
seigc
=
results
%
seigc
+
seig
END
IF
END
IF
DO
jspin
=
1
,
input
%
jspins
IF
(
mpi
%
irank
.EQ.
0
)
THEN
IF
(
mpi
%
irank
==
0
)
THEN
DO
n
=
1
,
atoms
%
ntype
moments
%
stdn
(
n
,
jspin
)
=
outDen
%
mt
(
1
,
0
,
n
,
jspin
)
/
(
sfp_const
*
atoms
%
rmsh
(
1
,
n
)
*
atoms
%
rmsh
(
1
,
n
))
END
DO
END
IF
IF
((
noco
%
l_noco
)
.AND.
(
mpi
%
irank
.EQ.
0
))
THEN
IF
(
jspin
.EQ.
2
)
THEN
IF
((
noco
%
l_noco
)
.AND.
(
mpi
%
irank
==
0
))
THEN
IF
(
jspin
==
2
)
THEN
IF
(
PRESENT
(
EnergyDen
))
call
juDFT_error
(
"Energyden not implemented for noco"
)
!pk non-collinear (start)
!add the coretail-charge to the constant interstitial
!charge (star 0), taking into account the direction of
!magnetisation of this atom
DO
iType
=
1
,
atoms
%
ntype
rhoint
=
(
qint
(
iType
,
1
)
+
qint
(
iType
,
2
))
/
cell
%
volint
/
input
%
jspins
/
2.0
momint
=
(
qint
(
iType
,
1
)
-
qint
(
iType
,
2
))
/
cell
%
volint
/
input
%
jspins
/
2.0
rhoint
=
(
qint
(
iType
,
1
)
+
qint
(
iType
,
2
))
/
(
cell
%
volint
*
input
%
jspins
*
2.0
)
momint
=
(
qint
(
iType
,
1
)
-
qint
(
iType
,
2
))
/
(
cell
%
volint
*
input
%
jspins
*
2.0
)
!rho_11
outDen
%
pw
(
1
,
1
)
=
outDen
%
pw
(
1
,
1
)
+
rhoint
+
momint
*
cos
(
noco
%
beta
(
iType
))
!rho_22
outDen
%
pw
(
1
,
2
)
=
outDen
%
pw
(
1
,
2
)
+
rhoint
-
momint
*
cos
(
noco
%
beta
(
iType
))
!real part rho_21
outDen
%
pw
(
1
,
3
)
=
outDen
%
pw
(
1
,
3
)
+
cmplx
(
0.5
*
momint
*
cos
(
noco
%
alph
(
iType
))
*
sin
(
noco
%
beta
(
iType
)),
0.0
)
outDen
%
pw
(
1
,
3
)
=
outDen
%
pw
(
1
,
3
)
+
cmplx
(
0.5
*
momint
*
cos
(
noco
%
alph
(
iType
))
*
sin
(
noco
%
beta
(
iType
)),&
!imaginary part rho_21
outDen
%
pw
(
1
,
3
)
=
outDen
%
pw
(
1
,
3
)
+
cmplx
(
0.0
,
-0.5
*
momint
*
sin
(
noco
%
alph
(
iType
))
*
sin
(
noco
%
beta
(
iType
)))
-0.5
*
momint
*
sin
(
noco
%
alph
(
iType
))
*
sin
(
noco
%
beta
(
iType
)))
END
DO
!pk non-collinear (end)
END
IF
ELSE
IF
(
input
%
ctail
)
THEN
IF
(
PRESENT
(
EnergyDen
))
call
juDFT_error
(
"Energyden not implemented for ctail"
)
!+gu hope this works as well
CALL
cdnovlp
(
mpi
,
sphhar
,
stars
,
atoms
,
sym
,
dimension
,
vacuum
,&
cell
,
input
,
oneD
,
l_st
,
jspin
,
rh
(:,:,
jspin
),&
outDen
%
pw
,
outDen
%
vacxy
,
outDen
%
mt
,
outDen
%
vacz
)
ELSE
IF
(
mpi
%
irank
.EQ.
0
)
THEN
ELSE
IF
(
mpi
%
irank
==
0
)
THEN
DO
iType
=
1
,
atoms
%
ntype
outDen
%
pw
(
1
,
jspin
)
=
outDen
%
pw
(
1
,
jspin
)
+
qint
(
iType
,
jspin
)
/
(
input
%
jspins
*
cell
%
volint
)
END
DO
...
...
@@ -134,11 +139,11 @@ SUBROUTINE cdncore(mpi,dimension,oneD,input,vacuum,noco,sym,&
END
IF
END
DO
IF
(
input
%
kcrel
.EQ.
0
)
THEN
IF
(
mpi
%
irank
.EQ.
0
)
THEN
IF
(
input
%
kcrel
==
0
)
THEN
IF
(
mpi
%
irank
==
0
)
THEN
CALL
writeCoreDensity
(
input
,
atoms
,
dimension
,
rhTemp
,
tec
,
qint
)
END
IF
IF
((
input
%
gw
.eq.
1
.or.
input
%
gw
.eq.
3
)
.AND.
(
mpi
%
irank
.EQ.
0
))
CLOSE
(
15
)
IF
((
input
%
gw
==
1
.or.
input
%
gw
==
3
)
.AND.
(
mpi
%
irank
==
0
))
CLOSE
(
15
)
END
IF
END
SUBROUTINE
cdncore
...
...
core/cored.F90
View file @
cbac3b75
MODULE
m_cored
CONTAINS
SUBROUTINE
cored
(&
&
input
,
jspin
,
atoms
,&
&
rho
,
DIMENSION
,&
&
sphhar
,&
&
vr
,&
&
qint
,
rhc
,
tec
,
seig
)
SUBROUTINE
cored
(
input
,
jspin
,
atoms
,
rho
,
DIMENSION
,
sphhar
,
vr
,
qint
,
rhc
,
tec
,
seig
,
EnergyDen
)
! *******************************************************
! ***** set up the core densities for compounds. *****
! ***** d.d.koelling *****
...
...
@@ -29,20 +23,22 @@ CONTAINS
REAL
,
INTENT
(
OUT
)
::
seig
! ..
! .. Array Arguments ..
REAL
,
INTENT
(
IN
)
::
vr
(
atoms
%
jmtd
,
atoms
%
ntype
)
REAL
,
INTENT
(
INOUT
)
::
rho
(
atoms
%
jmtd
,
0
:
sphhar
%
nlhd
,
atoms
%
ntype
,
DIMENSION
%
jspd
)
REAL
,
INTENT
(
INOUT
)
::
rhc
(
DIMENSION
%
msh
,
atoms
%
ntype
,
DIMENSION
%
jspd
)
REAL
,
INTENT
(
INOUT
)
::
qint
(
atoms
%
ntype
,
DIMENSION
%
jspd
)
REAL
,
INTENT
(
INOUT
)
::
tec
(
atoms
%
ntype
,
DIMENSION
%
jspd
)
REAL
,
INTENT
(
IN
)
::
vr
(
atoms
%
jmtd
,
atoms
%
ntype
)
REAL
,
INTENT
(
INOUT
)
::
rho
(
atoms
%
jmtd
,
0
:
sphhar
%
nlhd
,
atoms
%
ntype
,
DIMENSION
%
jspd
)
REAL
,
INTENT
(
INOUT
)
::
rhc
(
DIMENSION
%
msh
,
atoms
%
ntype
,
DIMENSION
%
jspd
)
REAL
,
INTENT
(
INOUT
)
::
qint
(
atoms
%
ntype
,
DIMENSION
%
jspd
)
REAL
,
INTENT
(
INOUT
)
::
tec
(
atoms
%
ntype
,
DIMENSION
%
jspd
)
REAL
,
INTENT
(
INOUT
),
OPTIONAL
::
EnergyDen
(
atoms
%
jmtd
,
0
:
sphhar
%
nlhd
,
atoms
%
ntype
,
DIMENSION
%
jspd
)
! ..
! .. Local Scalars ..
REAL
e
,
fj
,
fl
,
fn
,
q
,
rad
,
rhos
,
rhs
,
sea
,
sume
,
t2
REAL
d
,
dxx
,
rn
,
rnot
,
z
,
t1
,
rr
,
r
,
lambd
,
c
,
bmu
,
weight
REAL
e
ig
,
fj
,
fl
,
fn
,
q
,
rad
,
rhos
,
rhs
,
sea
,
sume
,
t2
REAL
d
,
dxx
,
rn
,
rnot
,
z
,
t1
,
rr
,
r
,
lambd
,
c
,
bmu
,
weight
,
aux_weight
INTEGER
i
,
j
,
jatom
,
korb
,
n
,
ncmsh
,
nm
,
nm1
,
nst
,
l
,
ierr
! ..
! .. Local Arrays ..
REAL
rhcs
(
DIMENSION
%
msh
),
rhoc
(
DIMENSION
%
msh
),
rhoss
(
DIMENSION
%
msh
),
vrd
(
DIMENSION
%
msh
),
f
(
0
:
3
)
REAL
rhcs_aux
(
DIMENSION
%
msh
),
rhoss_aux
(
DIMENSION
%
msh
)
!> quantities for energy density calculations
REAL
occ
(
DIMENSION
%
nstd
),
a
(
DIMENSION
%
msh
),
b
(
DIMENSION
%
msh
),
ain
(
DIMENSION
%
msh
),
ahelp
(
DIMENSION
%
msh
)
REAL
occ_h
(
DIMENSION
%
nstd
,
2
)
INTEGER
kappa
(
DIMENSION
%
nstd
),
nprnc
(
DIMENSION
%
nstd
)
...
...
@@ -99,7 +95,7 @@ CONTAINS
WRITE
(
6
,
FMT
=
8000
)
z
,
rnot
,
dxx
,
atoms
%
jri
(
jatom
)
WRITE
(
16
,
FMT
=
8000
)
z
,
rnot
,
dxx
,
atoms
%
jri
(
jatom
)
DO
j
=
1
,
atoms
%
jri
(
jatom
)
rhoss
(
j
)
=
0.
rhoss
(
j
)
=
0.0
vrd
(
j
)
=
vr
(
j
,
jatom
)
ENDDO
!
...
...
@@ -137,23 +133,35 @@ CONTAINS
IF
(
occ
(
korb
)
/
=
0.0
)
THEN
fn
=
nprnc
(
korb
)
fj
=
iabs
(
kappa
(
korb
))
-
.5e0
weight
=
2
*
fj
+
1.e0
IF
(
bmu
>
99.
)
weight
=
occ
(
korb
)
fl
=
fj
+
(
.5e0
)
*
isign
(
1
,
kappa
(
korb
))
e
=
-2
*
(
z
/
(
fn
+
fl
))
**
2
CALL
differ
(
fn
,
fl
,
fj
,
c
,
z
,
dxx
,
rnot
,
rn
,
d
,
ncmsh
,
vrd
,
e
,
a
,
b
,
ierr
)
stateEnergies
(
korb
)
=
e
WRITE
(
6
,
FMT
=
8010
)
fn
,
fl
,
fj
,
e
,
weight
WRITE
(
16
,
FMT
=
8010
)
fn
,
fl
,
fj
,
e
,
weight
eig
=
-2
*
(
z
/
(
fn
+
fl
))
**
2
CALL
differ
(
fn
,
fl
,
fj
,
c
,
z
,
dxx
,
rnot
,
rn
,
d
,
ncmsh
,
vrd
,
eig
,
a
,
b
,
ierr
)
stateEnergies
(
korb
)
=
eig
WRITE
(
6
,
FMT
=
8010
)
fn
,
fl
,
fj
,
eig
,
weight
WRITE
(
16
,
FMT
=
8010
)
fn
,
fl
,
fj
,
eig
,
weight
IF
(
ierr
/
=
0
)
CALL
juDFT_error
(
"error in core-level routine"
,
calledby
=
"cored"
)
IF
(
input
%
gw
==
1
.OR.
input
%
gw
==
3
)
WRITE
(
15
)
NINT
(
fl
),
weight
,
e
,&
IF
(
input
%
gw
==
1
.OR.
input
%
gw
==
3
)
WRITE
(
15
)
NINT
(
fl
),
weight
,
e
ig
,&
a
(
1
:
atoms
%
jri
(
jatom
)),
b
(
1
:
atoms
%
jri
(
jatom
))
sume
=
sume
+
weight
*
e
/
input
%
jspins
sume
=
sume
+
weight
*
e
ig
/
input
%
jspins
DO
j
=
1
,
ncmsh
rhcs
(
j
)
=
weight
*
(
a
(
j
)
**
2
+
b
(
j
)
**
2
)
rhcs
(
j
)
=
weight
*
(
a
(
j
)
**
2
+
b
(
j
)
**
2
)
rhoss
(
j
)
=
rhoss
(
j
)
+
rhcs
(
j
)
ENDDO
IF
(
present
(
EnergyDen
))
THEN
rhoss_aux
=
rhoss
DO
j
=
1
,
ncmsh
! for energy density we want to multiply the weights
! with the eigenenergies
rhoss_aux
(
j
)
=
rhoss_aux
(
j
)
+
(
rhcs
(
j
)
*
eig
)
ENDDO
ENDIF
ENDIF
ENDDO
...
...
@@ -165,6 +173,14 @@ CONTAINS
rho
(
j
,
0
,
jatom
,
jspin
)
=
rho
(
j
,
0
,
jatom
,
jspin
)
+
rhoc
(
j
)/
sfp_const
ENDDO
IF
(
present
(
EnergyDen
))
then
DO
j
=
1
,
nm
rhoc
(
j
)
=
rhoss
(
j
)/
input
%
jspins
EnergyDen
(
j
,
0
,
jatom
,
jspin
)
=
EnergyDen
(
j
,
0
,
jatom
,
jspin
)
&
+
rhoss_aux
(
j
)
/(
input
%
jspins
*
sfp_const
)
ENDDO
ENDIF
rhc
(
1
:
ncmsh
,
jatom
,
jspin
)
=
rhoss
(
1
:
ncmsh
)
/
input
%
jspins
rhc
(
ncmsh
+1
:
DIMENSION
%
msh
,
jatom
,
jspin
)
=
0.0
...
...
types/types_xcpot_libxc.F90
View file @
cbac3b75
...
...
@@ -12,41 +12,54 @@ MODULE m_types_xcpot_libxc
USE
m_types_xcpot
USE
m_judft
IMPLICIT
NONE
PRIVATE
PRIVATE
::
write_xc_info
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
TYPE
(
xc_f03_func_t
)
::
vxc_func_x
,
v
xc_func_c
TYPE
(
xc_f03_func_
t
)
::
exc_func_x
,
exc_func
_c
#endif
INTEGER
::
func_id_c
,
func_id_x
,
jspins
INTEGER
::
func_vxc_id_c
,
func_vxc_id_x
!> functionals to be used for potential & density convergence
INTEGER
::
func_exc_id_c
,
func_exc_id_x
!> functionals to be used in exc- & totale-calculations
INTEGER
::
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
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
CONTAINS
SUBROUTINE
xcpot_init
(
xcpot
,
jspins
,
id_x
,
id_c
)
SUBROUTINE
xcpot_init
(
xcpot
,
jspins
,
vxc_id_x
,
vxc_id_c
,
exc_id_x
,
exc_
id_c
)
USE
m_judft
IMPLICIT
NONE
CLASS
(
t_xcpot_libxc
),
INTENT
(
OUT
)
::
xcpot
INTEGER
,
INTENT
(
IN
)
::
jspins
,
id_x
,
id_c
INTEGER
,
INTENT
(
IN
)
::
jspins
INTEGER
,
INTENT
(
IN
)
::
vxc_id_x
,
vxc_id_c
! potential functional
INTEGER
,
INTENT
(
IN
),
OPTIONAL
::
exc_id_x
,
exc_id_c
! energy functionals
LOGICAL
::
same_functionals
! are vxc and exc equal
#ifdef CPP_LIBXC
INTEGER
::
err
xcpot
%
jspins
=
jspins
xcpot
%
func_id_x
=
id_x
xcpot
%
func_id_c
=
id_c
xcpot
%
jspins
=
jspins
xcpot
%
func_vxc_id_x
=
vxc_id_x
xcpot
%
func_vxc_id_c
=
vxc_id_c
xcpot
%
func_exc_id_x
=
merge
(
exc_id_x
,
vxc_id_x
,
PRESENT
(
exc_id_x
))
xcpot
%
func_exc_id_x
=
merge
(
exc_id_c
,
vxc_id_c
,
PRESENT
(
exc_id_c
))
same_functionals
=
(
xcpot
%
func_vxc_id_x
==
xcpot
%
func_exc_id_x
)
&
.and.
(
xcpot
%
func_vxc_id_c
==
xcpot
%
func_exc_id_c
)
if
(
xcpot
%
func_vxc_id_x
==
0
.or.
xcpot
%
func_exc_id_x
==
0
)
then
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
)
//&
...
...
@@ -55,21 +68,39 @@ CONTAINS
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
)
! potential functionals
CALL
xc_f03_func_init
(
xcpot
%
vxc_func_x
,
xcpot
%
func_vxc_id_x
,
XC_UNPOLARIZED
)
IF
(
xcpot
%
func_vxc_id_c
>
0
)
CALL
xc_f03_func_init
(
xcpot
%
vxc_func_c
,
xcpot
%
func_vxc_id_c
,
XC_UNPOLARIZED
)
! energy functionals
CALL
xc_f03_func_init
(
xcpot
%
exc_func_x
,
xcpot
%
func_exc_id_x
,
XC_UNPOLARIZED
)
IF
(
xcpot
%
func_exc_id_c
>
0
)
CALL
xc_f03_func_init
(
xcpot
%
exc_func_c
,
xcpot
%
func_exc_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
)
! potential functionals
CALL
xc_f03_func_init
(
xcpot
%
vxc_func_x
,
xcpot
%
func_vxc_id_x
,
XC_POLARIZED
)
IF
(
xcpot
%
func_vxc_id_c
>
0
)
CALL
xc_f03_func_init
(
xcpot
%
vxc_func_c
,
xcpot
%
func_vxc_id_c
,
XC_POLARIZED
)
!energy functionals
CALL
xc_f03_func_init
(
xcpot
%
exc_func_x
,
xcpot
%
func_exc_id_x
,
XC_POLARIZED
)
IF
(
xcpot
%
func_exc_id_c
>
0
)
CALL
xc_f03_func_init
(
xcpot
%
exc_func_c
,
xcpot
%
func_exc_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
)
CALL
write_xc_info
(
xcpot
%
vxc_func
_x
)
IF
(
xcpot
%
func_vxc_id_c
>
0
)
THEN
CALL
write_xc_info
(
xcpot
%
vxc_func
_c
)
ELSE
WRITE
(
*
,
*
)
"No Correlation functional"
END
IF
IF
(
.not.
same_functionals
)
THEN
CALL
write_xc_info
(
xcpot
%
exc_func_x
)
IF
(
xcpot
%
func_exc_id_c
>
0
)
THEN
CALL
write_xc_info
(
xcpot
%
exc_func_c
)
ELSE
WRITE
(
*
,
*
)
"No Correlation functional for TotalE"
ENDIF
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"
)
...
...
@@ -79,9 +110,12 @@ CONTAINS
LOGICAL
FUNCTION
xcpot_is_gga
(
xcpot
)
IMPLICIT
NONE
CLASS
(
t_xcpot_libxc
),
INTENT
(
IN
)::
xcpot
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
))
TYPE
(
xc_f03_func_info_t
)
::
xc_info
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
))
#endif
END
FUNCTION
xcpot_is_gga
...
...
@@ -89,7 +123,10 @@ CONTAINS
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
))
TYPE
(
xc_f03_func_info_t
)
::
xc_info
xc_info
=
xc_f03_func_get_info
(
xcpot
%
exc_func_x
)
xcpot_is_MetaGGA
=
ANY
([
XC_FAMILY_MGGA
,
XC_FAMILY_HYB_MGGA
]
==
xc_f03_func_info_get_family
(
xc_info
))
#endif
END
FUNCTION
xcpot_is_MetaGGA
...
...
@@ -97,7 +134,10 @@ CONTAINS
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
))
TYPE
(
xc_f03_func_info_t
)
::
xc_info
xc_info
=
xc_f03_func_get_info
(
xcpot
%
vxc_func_x
)
xcpot_is_hybrid
=
ANY
([
XC_FAMILY_HYB_MGGA
,
XC_FAMILY_HYB_GGA
]
==
xc_f03_func_info_get_family
(
xc_info
))
#endif
END
FUNCTION
xcpot_is_hybrid
...
...
@@ -108,7 +148,7 @@ CONTAINS
REAL
::
a_ex
#ifdef CPP_LIBXC
a_ex
=
xc_f03_hyb_exx_coef
(
xcpot
%
xc_func_x
)
a_ex
=
xc_f03_hyb_exx_coef
(
xcpot
%
v
xc_func_x
)
#endif
END
FUNCTION
xcpot_get_exchange_weight
...
...
@@ -132,18 +172,18 @@ CONTAINS
IF
(
.NOT.
PRESENT
(
grad
))
CALL
judft_error
(
"Bug: You called get_vxc for a GGA potential without providing derivatives"
)
ALLOCATE
(
vsigma
,
mold
=
grad
%
vsigma
)
!where(abs(grad%sigma)<1E-9) grad%sigma=1E-9
CALL
xc_f03_gga_vxc
(
xcpot
%
xc_func_x
,
SIZE
(
rh
,
1
),
TRANSPOSE
(
rh
),
grad
%
sigma
,
vx_tmp
,
vsigma
)
IF
(
xcpot
%
func_id_c
>
0
)
THEN
CALL
xc_f03_gga_vxc
(
xcpot
%
xc_func_c
,
SIZE
(
rh
,
1
),
TRANSPOSE
(
rh
),
grad
%
sigma
,
vxc_tmp
,
grad
%
vsigma
)
CALL
xc_f03_gga_vxc
(
xcpot
%
v
xc_func_x
,
SIZE
(
rh
,
1
),
TRANSPOSE
(
rh
),
grad
%
sigma
,
vx_tmp
,
vsigma
)
IF
(
xcpot
%
func_
vxc_
id_c
>
0
)
THEN
CALL
xc_f03_gga_vxc
(
xcpot
%
v
xc_func_c
,
SIZE
(
rh
,
1
),
TRANSPOSE
(
rh
),
grad
%
sigma
,
vxc_tmp
,
grad
%
vsigma
)
grad
%
vsigma
=
grad
%
vsigma
+
vsigma
vxc_tmp
=
vxc_tmp
+
vx_tmp
ELSE
vxc_tmp
=
vx_tmp
ENDIF
ELSE
!LDA potentials
CALL
xc_f03_lda_vxc
(
xcpot
%
xc_func_x
,
SIZE
(
rh
,
1
),
TRANSPOSE
(
rh
),
vx_tmp
)
IF
(
xcpot
%
func_id_c
>
0
)
THEN
CALL
xc_f03_lda_vxc
(
xcpot
%
xc_func_c
,
SIZE
(
rh
,
1
),
TRANSPOSE
(
rh
),
vxc_tmp
)
CALL
xc_f03_lda_vxc
(
xcpot
%
v
xc_func_x
,
SIZE
(
rh
,
1
),
TRANSPOSE
(
rh
),
vx_tmp
)
IF
(
xcpot
%
func_
vxc_
id_c
>
0
)
THEN
CALL
xc_f03_lda_vxc
(
xcpot
%
v
xc_func_c
,
SIZE
(
rh
,
1
),
TRANSPOSE
(
rh
),
vxc_tmp
)
vxc_tmp
=
vxc_tmp
+
vx_tmp
ENDIF
ENDIF
...
...
@@ -169,15 +209,15 @@ CONTAINS
#ifdef CPP_LIBXC
IF
(
xcpot
%
is_gga
())
THEN
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
%
xc_func_x
,
SIZE
(
rh
,
1
),
TRANSPOSE
(
rh
),
grad
%
sigma
,
exc
)
IF
(
xcpot
%
func_id_c
>
0
)
THEN
CALL
xc_f03_gga_exc
(
xcpot
%
xc_func_c
,
SIZE
(
rh
,
1
),
TRANSPOSE
(
rh
),
grad
%
sigma
,
excc
)
CALL
xc_f03_gga_exc
(
xcpot
%
e
xc_func_x
,
SIZE
(
rh
,
1
),
TRANSPOSE
(
rh
),
grad
%
sigma
,
exc
)
IF
(
xcpot
%
func_
vxc_
id_c
>
0
)
THEN
CALL
xc_f03_gga_exc
(
xcpot
%
e
xc_func_c
,
SIZE
(
rh
,
1
),
TRANSPOSE
(
rh
),
grad
%
sigma
,
excc
)
exc
=
exc
+
excc
END
IF
ELSE
!LDA potentials
CALL
xc_f03_lda_exc
(
xcpot
%
xc_func_x
,
SIZE
(
rh
,
1
),
TRANSPOSE
(
rh
),
exc
)
IF
(
xcpot
%
func_id_c
>
0
)
THEN
CALL
xc_f03_lda_exc
(
xcpot
%
xc_func_c
,
SIZE
(
rh
,
1
),
TRANSPOSE
(
rh
),
excc
)
CALL
xc_f03_lda_exc
(
xcpot
%
e
xc_func_x
,
SIZE
(
rh
,
1
),
TRANSPOSE
(
rh
),
exc
)
IF
(
xcpot
%
func_
vxc_
id_c
>
0
)
THEN
CALL
xc_f03_lda_exc
(
xcpot
%
e
xc_func_c
,
SIZE
(
rh
,
1
),
TRANSPOSE
(
rh
),
excc
)
exc
=
exc
+
excc
END
IF
ENDIF
...
...
@@ -198,13 +238,19 @@ CONTAINS
END
SUBROUTINE
xcpot_alloc_gradients
#ifdef CPP_LIBXC
SUBROUTINE
priv_write_info
(
xc_info
)
#ifdef CPP_LIBXC
SUBROUTINE
write_xc_info
(
xc_func
,
is_E_func
)
IMPLICIT
NONE
TYPE
(
xc_f03_func_info_t
),
INTENT
(
IN
)
::
xc_info
INTEGER
::
i
CHARACTER
(
len
=
120
)
::
kind
,
family
TYPE
(
xc_f03_func_t
),
INTENT
(
IN
)
::
xc_func
LOGICAL
,
INTENT
(
IN
),
OPTIONAL
::
is_E_func
TYPE
(
xc_f03_func_info_t
)
::
xc_info
INTEGER
::
i
CHARACTER
(
len
=
120
)
::
kind
,
family
LOGICAL
::
is_energy_func
xc_info
=
xc_f03_func_get_info
(
xc_func
)
is_energy_func
=
merge
(
is_E_func
,
.False.
,
PRESENT
(
is_E_func
))
SELECT
CASE
(
xc_f03_func_info_get_kind
(
xc_info
))
CASE
(
XC_EXCHANGE
)
WRITE
(
kind
,
'(a)'
)
'an exchange functional'
...
...
@@ -232,14 +278,19 @@ CONTAINS
WRITE
(
family
,
'(a)'
)
"unknown"
END
SELECT
WRITE
(
*
,
'("The functional
''
", a, "
''
is ", a, ", it belongs to the
''
", a, "
''
family and is defined in the reference(s):")'
)
&
TRIM
(
xc_f03_func_info_get_name
(
xc_info
)),
TRIM
(
kind
),
TRIM
(
family
)
IF
(
.not.
is_energy_func
)
THEN
WRITE
(
*
,
'("The functional
''
", a, "
''
is ", a, ", it belongs to the
''
", a, "
''
family and is defined in the reference(s):")'
)
&
TRIM
(
xc_f03_func_info_get_name
(
xc_info
)),
TRIM
(
kind
),
TRIM
(
family
)
ELSE
WRITE
(
*
,
'("The functional used for TotalE
''
", a, "
''
is ", a, ", it belongs to the
''
", a, "
''
family and is defined in the reference(s):")'
)
&
TRIM
(
xc_f03_func_info_get_name
(
xc_info
)),
TRIM
(
kind
),
TRIM
(
family
)
ENDIF
i
=
0
DO
WHILE
(
i
>=
0
)
WRITE
(
*
,
'(a,i1,2a)'
)
'['
,
i
+1
,
'] '
,
TRIM
(
xc_f03_func_reference_get_ref
(
xc_f03_func_info_get_references
(
xc_info
,
i
)))
END
DO
END
SUBROUTINE
priv_write
_info
END
SUBROUTINE
write_xc
_info
#endif
END
MODULE
m_types_xcpot_libxc
vgen/vgen_xcpot.F90
View file @
cbac3b75
...
...
@@ -158,15 +158,15 @@ CONTAINS
veff
=
vTot
IF
(
xcpot
%
is_hybrid
()
.AND.
hybrid
%
l_subvxc
)
THEN
DO
ispin
=
1
,
input
%
jspins
DO
ispin
=
1
,
input
%
jspins
CALL
convol
(
stars
,
vx
%
pw_w
(:,
ispin
),
vx
%
pw
(:,
ispin
),
stars
%
ufft
)
END
DO
veff
%
pw
=
vTot
%
pw
-
xcpot
%
get_exchange_weight
()
*
vx
%
pw
veff
%
pw_w
=
vTot
%
pw_w
-
xcpot
%
get_exchange_weight
()
*
vx
%
pw_w
veff
%
mt
=
vTot
%
mt
-
xcpot
%
get_exchange_weight
()
*
vx
%
mt
exc
%
pw
=
exc
%
pw
-
xcpot
%
get_exchange_weight
()
*
exc
%
pw
exc
%
pw_w
=
exc
%
pw_w
-
xcpot
%
get_exchange_weight
()
*
exc
%
pw_w
exc
%
mt
=
exc
%
mt
-
xcpot
%
get_exchange_weight
()
*
exc
%
mt
END
DO
veff
%
pw
=
vTot
%
pw
-
xcpot
%
get_exchange_weight
()
*
vx
%
pw
veff
%
pw_w
=
vTot
%
pw_w
-
xcpot
%
get_exchange_weight
()
*
vx
%
pw_w
veff
%
mt
=
vTot
%
mt
-
xcpot
%
get_exchange_weight
()
*
vx
%
mt
exc
%
pw
=
exc
%
pw
-
xcpot
%
get_exchange_weight
()
*
exc
%
pw
exc
%
pw_w
=
exc
%
pw_w
-
xcpot
%
get_exchange_weight
()
*
exc
%
pw_w
exc
%
mt
=
exc
%
mt
-
xcpot
%
get_exchange_weight
()
*
exc
%
mt
END
IF
results
%
te_veff
=
0.0
...
...
xc-pot/CMakeLists.txt
View file @
cbac3b75
set
(
fleur_F90
${
fleur_F90
}
xc-pot/libxc_postprocess_gga.f90
xc-pot/metagga.F90
)
set
(
fleur_F77
${
fleur_F77
}
...
...
xc-pot/metagga.F90
0 → 100644
View file @
cbac3b75
!--------------------------------------------------------------------------------
! Copyright (c) 2018 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
! This file is part of FLEUR and available as free software under the conditions
! of the MIT license as expressed in the LICENSE file in more detail.
!--------------------------------------------------------------------------------
module
m_metagga
type
t_realspace_potden
real
,
allocatable
::
is
(:,:),
mt
(:,:)
end
type
t_realspace_potden
public
::
calc_EnergyDen
private
::
calc_EnergyDen_auxillary_weights
,
t_realspace_potden
,
subtract_RS
,
multiply_RS
interface
operator
(
-
)
procedure
subtract_RS
end
interface
operator
(
-
)