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
7f10ed8c
Commit
7f10ed8c
authored
Sep 20, 2019
by
Daniel Wortmann
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Fixed merge. Several features are disabled: libxc because of metaGGA for example
parent
932ae148
Changes
29
Expand all
Hide whitespace changes
Inline
Side-by-side
Showing
29 changed files
with
1104 additions
and
1542 deletions
+1104
-1542
cdn/cdntot.f90
cdn/cdntot.f90
+5
-5
fleurinput/constants.f90
fleurinput/constants.f90
+19
-18
fleurinput/types_wannier.f90
fleurinput/types_wannier.f90
+24
-1
global/checkdop.F90
global/checkdop.F90
+4
-4
global/find_enpara.f90
global/find_enpara.f90
+24
-66
hybrid/exchange_val_hf.F90
hybrid/exchange_val_hf.F90
+6
-5
hybrid/hf_setup.F90
hybrid/hf_setup.F90
+4
-4
hybrid/hyb_abcrot.F90
hybrid/hyb_abcrot.F90
+3
-3
hybrid/hybrid.F90
hybrid/hybrid.F90
+1
-1
hybrid/kp_perturbation.F90
hybrid/kp_perturbation.F90
+3
-3
hybrid/read_core.F90
hybrid/read_core.F90
+390
-353
hybrid/subvxc.F90
hybrid/subvxc.F90
+6
-7
hybrid/symm_hf.F90
hybrid/symm_hf.F90
+11
-6
hybrid/symmetrizeh.F90
hybrid/symmetrizeh.F90
+22
-22
hybrid/trafo.F90
hybrid/trafo.F90
+23
-13
hybrid/wavefproducts.F90
hybrid/wavefproducts.F90
+8
-4
inpgen2/old_inp/dimen7.F90
inpgen2/old_inp/dimen7.F90
+27
-29
inpgen2/old_inp/dimens.F90
inpgen2/old_inp/dimens.F90
+3
-3
inpgen2/old_inp/rw_inp.f90
inpgen2/old_inp/rw_inp.f90
+27
-27
kpoints/kptmop.f
kpoints/kptmop.f
+310
-562
main/cdngen.F90
main/cdngen.F90
+3
-3
main/fleur.F90
main/fleur.F90
+20
-20
main/fleur_init.F90
main/fleur_init.F90
+5
-5
types/types_enpara.F90
types/types_enpara.F90
+40
-37
types/types_xcpot_inbuild.F90
types/types_xcpot_inbuild.F90
+9
-167
types/types_xcpot_libxc.F90
types/types_xcpot_libxc.F90
+74
-156
vgen/vis_xc.F90
vgen/vis_xc.F90
+8
-3
vgen/vmt_xc.F90
vgen/vmt_xc.F90
+11
-3
xc-pot/metagga.F90
xc-pot/metagga.F90
+14
-12
No files found.
cdn/cdntot.f90
View file @
7f10ed8c
...
...
@@ -27,7 +27,7 @@ CONTAINS
INTEGER
::
jsp
,
j
,
ivac
,
nz
,
n
REAL
::
q2
(
vacuum
%
nmz
),
w
,
rht1
(
vacuum
%
nmzd
,
2
,
input
%
jspins
)
COMPLEX
::
x
(
stars
%
ng3
)
qtot
=
0.0
qistot
=
0.0
DO
jsp
=
1
,
input
%
jspins
...
...
@@ -103,7 +103,7 @@ CONTAINS
call
tmp_potden
%
init
(
stars
,
atoms
,
sphhar
,
vacuum
,
noco
,
input
%
jspins
,
POTDEN_TYPE_DEN
)
call
init_mt_grid
(
input
%
jspins
,
atoms
,
sphhar
,
xcpot
,
sym
)
do
n_atm
=
1
,
atoms
%
ntype
call
mt_from_grid
(
atoms
,
sphhar
,
n_atm
,
input
%
jspins
,
mt
(:,:,
n_atm
),
&
call
mt_from_grid
(
atoms
,
s
ym
,
s
phhar
,
n_atm
,
input
%
jspins
,
mt
(:,:,
n_atm
),
&
tmp_potden
%
mt
(:,
0
:,
n_atm
,:))
do
i
=
1
,
atoms
%
jri
(
n_atm
)
...
...
@@ -156,11 +156,11 @@ CONTAINS
REAL
qmt
(
atoms
%
ntype
,
input
%
jspins
),
qvac
(
2
,
input
%
jspins
)
INTEGER
,
ALLOCATABLE
::
lengths
(:,:)
CHARACTER
(
LEN
=
20
)
::
attributes
(
6
),
names
(
6
)
CALL
timestart
(
"cdntot"
)
call
integrate_cdn
(
stars
,
atoms
,
sym
,
vacuum
,
input
,
cell
,
oneD
,
den
,
&
q
,
qis
,
qmt
,
qvac
,
qtot
,
qistot
)
IF
(
input
%
film
)
THEN
ALLOCATE
(
lengths
(
4
+
vacuum
%
nvac
,
2
))
ELSE
...
...
@@ -209,7 +209,7 @@ CONTAINS
REAL
,
INTENT
(
in
)
::
q
(:),
qis
(:),
qmt
(:,:),
qvac
(:,:),
qtot
,
qistot
character
(
len
=*
),
intent
(
in
),
optional
::
hint
integer
::
n_mt
if
(
present
(
hint
))
write
(
*
,
*
)
"DEN of "
,
hint
write
(
*
,
*
)
"q = "
,
q
...
...
fleurinput/constants.f90
View file @
7f10ed8c
...
...
@@ -13,7 +13,7 @@ MODULE m_constants
PROCEDURE
::
read_xml
=>
read_xml_constants
PROCEDURE
::
mpi_bc
=>
mpi_bc_constants
END
TYPE
t_constants
REAL
::
warp_factor
=
1.0
!should be set from input later
INTEGER
,
PARAMETER
::
noState_const
=
0
INTEGER
,
PARAMETER
::
coreState_const
=
1
...
...
@@ -26,9 +26,10 @@ MODULE m_constants
COMPLEX
,
PARAMETER
::
ImagUnit
=
(
0.0
,
1.0
)
REAL
,
PARAMETER
::
hartree_to_ev_const
=
27.21138602
! value from 2014 CODATA recommended values. Uncertainty is 0.00000017
REAL
,
PARAMETER
::
eVac0Default_const
=
-0.25
CHARACTER
(
len
=
9
),
PARAMETER
::
version_const
=
'fleur 27'
CHARACTER
(
len
=
9
),
PARAMETER
::
version_const
=
'fleur 30'
CHARACTER
(
len
=
49
),
PARAMETER
::
version_const_MaX
=
' MaX-Release 3.1 (www.max-centre.eu)'
REAL
,
PARAMETER
::
boltzmann_const
=
3.1668114e-6
! value is given in Hartree/Kelvin
INTEGER
,
PARAMETER
::
POTDEN_TYPE_OTHER
=
0
! POTDEN_TYPE <= 0 ==> undefined
INTEGER
,
PARAMETER
::
POTDEN_TYPE_POTTOT
=
1
! 0 < POTDEN_TYPE <= 1000 ==> potential
INTEGER
,
PARAMETER
::
POTDEN_TYPE_POTCOUL
=
2
...
...
@@ -36,7 +37,7 @@ MODULE m_constants
INTEGER
,
PARAMETER
::
POTDEN_TYPE_POTYUK
=
4
INTEGER
,
PARAMETER
::
POTDEN_TYPE_EnergyDen
=
5
INTEGER
,
PARAMETER
::
POTDEN_TYPE_DEN
=
1001
! 1000 < POTDEN_TYPE ==> density
CHARACTER
(
2
),
DIMENSION
(
0
:
103
),
PARAMETER
::
namat_const
=
(/&
'va'
,
' H'
,
'He'
,
'Li'
,
'Be'
,
' B'
,
' C'
,
' N'
,
' O'
,
' F'
,
'Ne'
,&
'Na'
,
'Mg'
,
'Al'
,
'Si'
,
' P'
,
' S'
,
'Cl'
,
'Ar'
,
' K'
,
'Ca'
,
'Sc'
,
'Ti'
,&
...
...
@@ -47,7 +48,7 @@ MODULE m_constants
'Lu'
,
'Hf'
,
'Ta'
,
' W'
,
'Re'
,
'Os'
,
'Ir'
,
'Pt'
,
'Au'
,
'Hg'
,
'Tl'
,
'Pb'
,&
'Bi'
,
'Po'
,
'At'
,
'Rn'
,
'Fr'
,
'Ra'
,
'Ac'
,
'Th'
,
'Pa'
,
' U'
,
'Np'
,
'Pu'
,&
'Am'
,
'Cm'
,
'Bk'
,
'Cf'
,
'Es'
,
'Fm'
,
'Md'
,
'No'
,
'Lw'
/)
CHARACTER
(
7
),
DIMENSION
(
29
),
PARAMETER
::
coreStateList_const
=
(/&
'(1s1/2)'
,
'(2s1/2)'
,
'(2p1/2)'
,
'(2p3/2)'
,
'(3s1/2)'
,&
'(3p1/2)'
,
'(3p3/2)'
,
'(4s1/2)'
,
'(3d3/2)'
,
'(3d5/2)'
,&
...
...
@@ -55,50 +56,50 @@ MODULE m_constants
'(5p1/2)'
,
'(5p3/2)'
,
'(6s1/2)'
,
'(4f5/2)'
,
'(4f7/2)'
,&
'(5d3/2)'
,
'(5d5/2)'
,
'(6p1/2)'
,
'(6p3/2)'
,
'(7s1/2)'
,&
'(5f5/2)'
,
'(5f7/2)'
,
'(6d3/2)'
,
'(6d5/2)'
/)
INTEGER
,
DIMENSION
(
29
),
PARAMETER
::
coreStateNumElecsList_const
=
(/&
! This is the number of electrons per spin
1
,
1
,
1
,
2
,
1
,
1
,
2
,
1
,
2
,
3
,
1
,
2
,
1
,
2
,&
3
,
1
,
2
,
1
,
3
,
4
,
2
,
3
,
1
,
2
,
1
,
3
,
4
,
2
,
3
/)
INTEGER
,
DIMENSION
(
29
),
PARAMETER
::
coreStateNprncList_const
=
(/&
1
,
2
,
2
,
2
,
3
,
3
,
3
,
4
,
3
,
3
,
4
,
4
,
5
,
4
,
4
,&
5
,
5
,
6
,
4
,
4
,
5
,
5
,
6
,
6
,
7
,
5
,
5
,
6
,
6
/)
INTEGER
,
DIMENSION
(
29
),
PARAMETER
::
coreStateKappaList_const
=
(/&
-1
,
-1
,
1
,
-2
,
-1
,
1
,
-2
,
-1
,
2
,
-3
,
1
,
-2
,
-1
,
2
,
-3
,&
1
,
-2
,
-1
,
3
,
-4
,
2
,
-3
,
1
,
-2
,
-1
,
3
,
-4
,
2
,
-3
/)
CHARACTER
(
4
),
DIMENSION
(
6
),
PARAMETER
::
nobleGasConfigList_const
=
(/
'[He]'
,
'[Ne]'
,
'[Ar]'
,
'[Kr]'
,
'[Xe]'
,
'[Rn]'
/)
INTEGER
,
DIMENSION
(
6
),
PARAMETER
::
nobleGasNumStatesList_const
=
(/
1
,
4
,
7
,
12
,
17
,
24
/)
CONTAINS
REAL
PURE
FUNCTION
pimach
()
IMPLICIT
NONE
! This subprogram supplies the value of the constant PI correct to
! machine precision where
! PI=3.1415926535897932384626433832795028841971693993751058209749446
pimach
=
3.1415926535897932
END
FUNCTION
pimach
REAL
ELEMENTAL
FUNCTION
c_light
(
fac
)
IMPLICIT
NONE
! This subprogram supplies the value of c according to
! NIST standard 13.1.99
! NIST standard 13.1.99
! Hartree and Rydbergs changed by fac = 1.0 or 2.0
REAL
,
INTENT
(
IN
)
::
fac
c_light
=
137.0359895e0
*
fac
*
warp_factor
!c_light = 1e6*fac
END
FUNCTION
c_light
SUBROUTINE
read_xml_constants
(
this
,
xml
)
USE
m_types_xml
CLASS
(
t_constants
),
INTENT
(
INout
)::
this
TYPE
(
t_xml
),
INTENT
(
in
)
::
xml
IF
(
xml
%
GetNumberOfNodes
(
'/fleurInput/calculationSetup/expertModes/@warp_factor'
)
==
1
)&
warp_factor
=
evaluateFirstOnly
(
xml
%
GetAttributeValue
(
'/fleurInput/calculationSetup/expertModes/@warp_factor'
))
END
SUBROUTINE
read_xml_constants
...
...
fleurinput/types_wannier.f90
View file @
7f10ed8c
...
...
@@ -13,6 +13,29 @@ MODULE m_types_wannier
! type for wannier-functions
!
TYPE
,
EXTENDS
(
t_fleurinput_base
)::
t_wann
!New parameters not handled correctly yet...
LOGICAL
::
l_socmatvec
LOGICAL
::
l_socmatvecrs
LOGICAL
::
l_mmn0_unf_to_spn_unf
LOGICAL
::
l_mmn0_to_spn_unf
LOGICAL
::
l_mmn0_to_spn
LOGICAL
::
l_mmn0_to_spn2
LOGICAL
::
l_mmn0_unf_to_spn
LOGICAL
::
l_perpmag_unf_to_tor_unf
LOGICAL
::
l_perpmag_to_tor_unf
LOGICAL
::
l_perpmag_to_tor
LOGICAL
::
l_perpmag_unf_to_tor
LOGICAL
::
l_hsomtxvec_unf_to_lmpzsoc_unf
LOGICAL
::
l_hsomtxvec_to_lmpzsoc_unf
LOGICAL
::
l_hsomtxvec_to_lmpzsoc
LOGICAL
::
l_hsomtxvec_unf_to_lmpzsoc
LOGICAL
::
l_hsomtx_unf_to_hsoc_unf
LOGICAL
::
l_hsomtx_to_hsoc_unf
LOGICAL
::
l_hsomtx_to_hsoc
LOGICAL
::
l_hsomtx_unf_to_hsoc
INTEGER
::
perpmagl
LOGICAL
::
l_perpmagatlres
INTEGER
::
wan90version
=
3
INTEGER
::
oc_num_orbs
=
0
INTEGER
,
ALLOCATABLE
::
oc_orbs
(:)
...
...
@@ -133,7 +156,7 @@ MODULE m_types_wannier
PROCEDURE
::
read_xml
=>
read_xml_wannier
PROCEDURE
::
mpi_bc
=>
mpi_bc_wannier
END
TYPE
t_wann
PUBLIC
t_wann
CONTAINS
...
...
global/checkdop.F90
View file @
7f10ed8c
...
...
@@ -24,7 +24,7 @@
! ..
! .. Scalar Arguments ..
TYPE
(
t_dimension
),
INTENT
(
IN
)
::
dimension
type
(
t_sphhar
),
intent
(
in
)
::
sphhar
type
(
t_sphhar
),
intent
(
in
)
::
sphhar
TYPE
(
t_stars
),
INTENT
(
IN
)
::
stars
TYPE
(
t_atoms
),
INTENT
(
IN
)
::
atoms
TYPE
(
t_sym
),
INTENT
(
IN
)
::
sym
...
...
@@ -52,7 +52,7 @@
l_cdn
=
.FALSE.
! By default we assume that the input is a potential.
IF
(
potden
%
potdenType
.LE.
0
)
CALL
juDFT_error
(
'unknown potden type'
,
calledby
=
'checkdop'
)
IF
(
potden
%
potdenType
.GT.
1000
)
l_cdn
=
.TRUE.
! potdenTypes > 1000 are reserved for densities
! ..
! ..
...
...
@@ -92,7 +92,7 @@
DO
j
=
1
,
np
IF
(
.NOT.
oneD
%
odi
%
d1
)
THEN
CALL
starf2
(&
&
sym
%
nop2
,
stars
%
ng2
,
stars
%
kv2
,
sym
%
mrot
,
sym
%
symor
,
sym
%
tau
,
p
(
1
,
j
),
sym
%
invtab
,&
&
sym
%
nop2
,
stars
%
ng2
,
stars
%
kv2
,
sym
%
mrot
,
sym
%
symor
,
sym
%
tau
,
p
(
1
:
3
,
j
),
sym
%
invtab
,&
&
sf2
)
!keep
v2
(
j
)
=
potden
%
vacz
(
1
,
ivac
,
jsp
)
DO
k
=
2
,
stars
%
ng2
...
...
@@ -190,7 +190,7 @@
ENDDO
help
=
help
+
potden
%
mt
(
atoms
%
jri
(
n
),
lh
,
n
,
jsp
)
*
s
ENDDO
v2
(
j
)
=
help
*
ir2
v2
(
j
)
=
help
*
ir2
IF
(
j
.LE.
8
)
THEN
!CALL cotra1(p(1,j),rcc,cell%bmat)
rcc
=
MATMUL
(
cell
%
bmat
,
p
(:,
j
))/
tpi_const
...
...
global/find_enpara.f90
View file @
7f10ed8c
...
...
@@ -11,31 +11,29 @@ MODULE m_find_enpara
PUBLIC
::
find_enpara
CONTAINS
!> Function to determine the energy parameter given the quantum number and the potential
!! Different schemes are implemented. Nqn (main quantum number) is used as a switch.
!! This code was previously in lodpot.f
REAL
FUNCTION
find_enpara
(
lo
,
l
,
n
,
jsp
,
nqn
,
atoms
,
irank
,
vr
)
RESULT
(
e
)
USE
m_types_
atoms
REAL
FUNCTION
find_enpara
(
lo
,
l
,
n
,
jsp
,
nqn
,
atoms
,
vr
,
e_lo
,
e_up
)
RESULT
(
e
)
USE
m_types_
setup
USE
m_radsra
USE
m_differ
Use
m_xmlOutput
USE
m_constants
IMPLICIT
NONE
LOGICAL
,
INTENT
(
IN
)::
lo
INTEGER
,
INTENT
(
IN
)::
l
,
n
,
nqn
,
jsp
REAL
,
INTENT
(
OUT
)
::
e_lo
,
e_up
TYPE
(
t_atoms
),
INTENT
(
IN
)::
atoms
INTEGER
,
INTENT
(
IN
)
::
irank
REAL
,
INTENT
(
IN
)::
vr
(:)
IF
(
nqn
>
0
)
e
=
priv_method1
(
lo
,
l
,
n
,
jsp
,
nqn
,
atoms
,
irank
,
vr
)
IF
(
nqn
<
0
)
e
=
priv_method2
(
lo
,
l
,
n
,
jsp
,
nqn
,
atoms
,
irank
,
vr
)
IF
(
nqn
>
0
)
e
=
priv_method1
(
lo
,
l
,
n
,
jsp
,
nqn
,
atoms
,
vr
,
e_lo
,
e_up
)
IF
(
nqn
<
0
)
e
=
priv_method2
(
lo
,
l
,
n
,
jsp
,
nqn
,
atoms
,
vr
,
e_lo
,
e_up
)
END
FUNCTION
find_enpara
REAL
FUNCTION
priv_method1
(
lo
,
l
,
n
,
jsp
,
nqn
,
atoms
,
irank
,
vr
)
RESULT
(
e
)
USE
m_types_
atoms
REAL
FUNCTION
priv_method1
(
lo
,
l
,
n
,
jsp
,
nqn
,
atoms
,
vr
,
e_lo
,
e_up
)
RESULT
(
e
)
USE
m_types_
setup
USE
m_radsra
USE
m_differ
USE
m_constants
...
...
@@ -44,7 +42,6 @@ CONTAINS
INTEGER
,
INTENT
(
IN
)::
l
,
n
,
nqn
,
jsp
REAL
,
INTENT
(
OUT
)
::
e_lo
,
e_up
TYPE
(
t_atoms
),
INTENT
(
IN
)::
atoms
INTEGER
,
INTENT
(
IN
)
::
irank
REAL
,
INTENT
(
IN
)::
vr
(:)
...
...
@@ -54,12 +51,12 @@ CONTAINS
REAL
d
,
rn
,
fl
,
fn
,
fj
,
t2
,
rr
,
t1
,
ldmt
,
us
,
dus
,
c
LOGICAL
start
! ..
! .. Local Arrays ..
! .. Local Arrays ..
REAL
,
ALLOCATABLE
::
f
(:,:),
vrd
(:)
CHARACTER
(
LEN
=
20
)
::
attributes
(
6
)
c
=
c_light
(
1.0
)
!Core potential setup done for each n,l now
!Core potential setup done for each n,l now
d
=
EXP
(
atoms
%
dx
(
n
))
! set up core-mesh
rn
=
atoms
%
rmt
(
n
)
...
...
@@ -84,10 +81,10 @@ CONTAINS
node
=
nqn
-
(
l
+1
)
IF
(
node
<
0
)
CALL
judft_error
(
"Error in setup of energy-parameters"
,
hint
=
"This could e.g. happen if you try to use 1p-states"
)
e
=
0.0
e
=
0.0
! determine upper edge
nodeu
=
-1
;
start
=
.TRUE.
DO
WHILE
(
nodeu
<=
node
)
DO
WHILE
(
nodeu
<=
node
)
CALL
radsra
(
e
,
l
,
vr
(:),
atoms
%
rmsh
(
1
,
n
),&
atoms
%
dx
(
n
),
atoms
%
jri
(
n
),
c
,
us
,
dus
,
nodeu
,
f
(:,
1
),
f
(:,
2
))
IF
(
(
nodeu
>
node
)
.AND.
start
)
THEN
...
...
@@ -105,7 +102,7 @@ CONTAINS
IF
(
node
/
=
0
)
THEN
! determine lower edge
nodeu
=
node
+
1
DO
WHILE
(
nodeu
>=
node
)
DO
WHILE
(
nodeu
>=
node
)
CALL
radsra
(
e
,
l
,
vr
(:),
atoms
%
rmsh
(
1
,
n
),&
atoms
%
dx
(
n
),
atoms
%
jri
(
n
),
c
,
us
,
dus
,
nodeu
,
f
(:,
1
),
f
(:,
2
))
e
=
e
-
0.01
...
...
@@ -113,7 +110,7 @@ CONTAINS
ENDDO
e_lo
=
e
ELSE
e_lo
=
-9.99
e_lo
=
-9.99
ENDIF
! calculate core
e
=
(
e_up
+
e_lo
)/
2
...
...
@@ -125,34 +122,15 @@ CONTAINS
fn
=
REAL
(
nqn
)
;
fl
=
REAL
(
l
)
;
fj
=
fl
-0.5
CALL
differ
(
fn
,
fl
,
fj
,
c
,
atoms
%
zatom
(
n
),
atoms
%
dx
(
n
),
atoms
%
rmsh
(
1
,
n
),&
rn
,
d
,
msh
,
vrd
,
e1
,
f
(:,
1
),
f
(:,
2
),
ierr
)
e
=
(
2.0
*
e
+
e1
)
/
3.0
e
=
(
2.0
*
e
+
e1
)
/
3.0
ENDIF
IF
(
irank
==
0
)
THEN
attributes
=
''
WRITE
(
attributes
(
1
),
'(i0)'
)
n
WRITE
(
attributes
(
2
),
'(i0)'
)
jsp
WRITE
(
attributes
(
3
),
'(i0,a1)'
)
nqn
,
ch
(
l
)
WRITE
(
attributes
(
4
),
'(f8.2)'
)
e_lo
WRITE
(
attributes
(
5
),
'(f8.2)'
)
e_up
WRITE
(
attributes
(
6
),
'(f16.10)'
)
e
IF
(
lo
)
THEN
CALL
writeXMLElementForm
(
'loAtomicEP'
,(/
'atomType '
,
'spin '
,
'branch '
,&
'branchLowest '
,
'branchHighest'
,
'value '
/),&
attributes
,
RESHAPE
((/
10
,
4
,
6
,
12
,
13
,
5
,
6
,
1
,
3
,
8
,
8
,
16
/),(/
6
,
2
/)))
ELSE
CALL
writeXMLElementForm
(
'atomicEP'
,(/
'atomType '
,
'spin '
,
'branch '
,&
'branchLowest '
,
'branchHighest'
,
'value '
/),&
attributes
,
RESHAPE
((/
12
,
4
,
6
,
12
,
13
,
5
,
6
,
1
,
3
,
8
,
8
,
16
/),(/
6
,
2
/)))
ENDIF
WRITE
(
6
,
'(a6,i5,i2,a1,a12,f6.2,a3,f6.2,a13,f8.4)'
)
' Atom'
,
n
,
nqn
,
ch
(
l
),
' branch from'
,&
e_lo
,
' to'
,
e_up
,
' htr. ; e_l ='
,
e
ENDIF
END
FUNCTION
priv_method1
REAL
FUNCTION
priv_method2
(
lo
,
l
,
n
,
jsp
,
nqn
,
atoms
,
irank
,
vr
)
RESULT
(
e
)
USE
m_types_
atoms
REAL
FUNCTION
priv_method2
(
lo
,
l
,
n
,
jsp
,
nqn
,
atoms
,
vr
,
e_lo
,
e_up
)
RESULT
(
e
)
USE
m_types_
setup
USE
m_radsra
USE
m_differ
USE
m_constants
...
...
@@ -161,7 +139,6 @@ CONTAINS
INTEGER
,
INTENT
(
IN
)::
l
,
n
,
nqn
,
jsp
REAL
,
INTENT
(
OUT
)
::
e_lo
,
e_up
TYPE
(
t_atoms
),
INTENT
(
IN
)::
atoms
INTEGER
,
INTENT
(
IN
)
::
irank
REAL
,
INTENT
(
IN
)::
vr
(:)
INTEGER
j
,
ilo
,
i
...
...
@@ -170,14 +147,14 @@ CONTAINS
REAL
d
,
rn
,
fl
,
fn
,
fj
,
t2
,
rr
,
t1
,
ldmt
,
us
,
dus
,
c
LOGICAL
start
! ..
! .. Local Arrays ..
! .. Local Arrays ..
REAL
,
ALLOCATABLE
::
f
(:,:),
vrd
(:)
CHARACTER
(
LEN
=
20
)
::
attributes
(
6
)
c
=
c_light
(
1.0
)
!Core potential setup done for each n,l now
!Core potential setup done for each n,l now
d
=
EXP
(
atoms
%
dx
(
n
))
! set up core-mesh
rn
=
atoms
%
rmt
(
n
)
...
...
@@ -266,7 +243,7 @@ CONTAINS
! determince notches by intersection
ldmt
=
-99.0
!ldmt = logarithmic derivative @ MT boundary
lnd
=
-
l
-1
DO
WHILE
(
ABS
(
ldmt
-
lnd
)
.GE.
1E-07
)
DO
WHILE
(
ABS
(
ldmt
-
lnd
)
.GE.
1E-07
)
e
=
(
e_up
+
e_lo
)/
2
CALL
radsra
(
e
,
l
,
vr
(:),
atoms
%
rmsh
(
1
,
n
),&
atoms
%
dx
(
n
),
atoms
%
jri
(
n
),
c
,
us
,
dus
,
nodeu
,
f
(:,
1
),
f
(:,
2
))
...
...
@@ -279,25 +256,6 @@ CONTAINS
END
IF
END
DO
IF
(
irank
==
0
)
THEN
attributes
=
''
WRITE
(
attributes
(
1
),
'(i0)'
)
n
WRITE
(
attributes
(
2
),
'(i0)'
)
jsp
WRITE
(
attributes
(
3
),
'(i0,a1)'
)
ABS
(
nqn
),
ch
(
l
)
WRITE
(
attributes
(
4
),
'(f16.10)'
)
ldmt
WRITE
(
attributes
(
5
),
'(f16.10)'
)
e
IF
(
lo
)
THEN
CALL
writeXMLElementForm
(
'heloAtomicEP'
,(/
'atomType '
,
'spin '
,
'branch '
,&
'logDerivMT '
,
'value '
/),&
attributes
(
1
:
5
),
reshape
((/
8
,
4
,
6
,
12
,
5+17
,
6
,
1
,
3
,
16
,
16
/),(/
5
,
2
/)))
ELSE
CALL
writeXMLElementForm
(
'heAtomicEP'
,(/
'atomType '
,
'spin '
,
'branch '
,&
'logDerivMT '
,
'value '
/),&
attributes
(
1
:
5
),
reshape
((/
10
,
4
,
6
,
12
,
5+17
,
6
,
1
,
3
,
16
,
16
/),(/
5
,
2
/)))
ENDIF
WRITE
(
6
,
'(a7,i3,i2,a1,a12,f7.2,a4,f7.2,a5)'
)
" Atom "
,
n
,
nqn
,
ch
(
l
),
" branch, D = "
,&
ldmt
,
" at "
,
e
,
" htr."
ENDIF
END
FUNCTION
priv_method2
END
FUNCTION
priv_method2
END
MODULE
m_find_enpara
hybrid/exchange_val_hf.F90
View file @
7f10ed8c
...
...
@@ -50,7 +50,7 @@
! converges well with q0. (Should be the default.)
MODULE
m_exchange_valence_hf
use
m_judft
LOGICAL
,
PARAMETER
::
zero_order
=
.false.
,
ibs_corr
=
.false.
INTEGER
,
PARAMETER
::
maxmem
=
600
...
...
@@ -287,7 +287,7 @@ CONTAINS
hybrid
%
lcutm1
,
hybrid
%
maxlcutm1
,
hybrid
%
nindxm1
,
hybrid
%
maxindxm1
,
hybrid
%
gptm
,
&
hybrid
%
ngptm
(
ikpt0
),
hybrid
%
pgptm
(:,
ikpt0
),
hybrid
%
gptmd
,
hybrid
%
basm1
,
&
hybrid
%
nbasm
(
ikpt0
),
iband1
,
hybrid
%
nbands
(
nk
),
nsest
,
ibando
,
psize
,
indx_sest
,
&
atoms
%
invsat
,
sym
%
invsatnr
,
mpi
%
irank
,
cprod_vv_r
(:
hybrid
%
nbasm
(
ikpt0
),
:,
:),
&
sym
%
invsat
,
sym
%
invsatnr
,
mpi
%
irank
,
cprod_vv_r
(:
hybrid
%
nbasm
(
ikpt0
),
:,
:),
&
cprod_vv_c
(:
hybrid
%
nbasm
(
ikpt0
),
:,
:),
mat_ex
%
l_real
,
wl_iks
(:
iband1
,
nkqpt
),
n_q
(
ikpt
))
END
IF
#endif
...
...
@@ -506,9 +506,10 @@ CONTAINS
cdum
=
sqrt
(
expo
)
*
rrad
divergence
=
cell
%
omtil
/(
tpi_const
**
2
)
*
sqrt
(
pi_const
/
expo
)
*
cerf
(
cdum
)
rrad
=
rrad
**
2
kv1
=
cell
%
bmat
(
1
,
:)/
kpts
%
nkpt3
(
1
)
kv2
=
cell
%
bmat
(
2
,
:)/
kpts
%
nkpt3
(
2
)
kv3
=
cell
%
bmat
(
3
,
:)/
kpts
%
nkpt3
(
3
)
call
judft_error
(
"Missing functionality"
)
!kv1 = cell%bmat(1, :)/kpts%nkpt3(1)
!kv2 = cell%bmat(2, :)/kpts%nkpt3(2)
!kv3 = cell%bmat(3, :)/kpts%nkpt3(3)
n
=
1
found
=
.true.
...
...
hybrid/hf_setup.F90
View file @
7f10ed8c
...
...
@@ -51,7 +51,7 @@ CONTAINS
! local arrays
REAL
,
ALLOCATABLE
::
basprod
(:)
INTEGER
::
degenerat
(
DIMENSION
%
neigd2
+
1
,
kpts
%
nkpt
)
INTEGER
::
degenerat
(
merge
(
dimension
%
neigd
*
2
,
dimension
%
neigd
,
noco
%
l_soc
)
+
1
,
kpts
%
nkpt
)
LOGICAL
::
skip_kpt
(
kpts
%
nkpt
)
INTEGER
::
g
(
3
)
...
...
@@ -63,7 +63,7 @@ CONTAINS
ALLOCATE
(
zmat
(
kpts
%
nkptf
),
stat
=
ok
)
IF
(
ok
/
=
0
)
STOP
'eigen_hf: failure allocation z_c'
ALLOCATE
(
eig_irr
(
DIMENSION
%
neigd2
,
kpts
%
nkpt
),
stat
=
ok
)
ALLOCATE
(
eig_irr
(
merge
(
dimension
%
neigd
*
2
,
dimension
%
neigd
,
noco
%
l_soc
)
,
kpts
%
nkpt
),
stat
=
ok
)
IF
(
ok
/
=
0
)
STOP
'eigen_hf: failure allocation eig_irr'
ALLOCATE
(
hybdat
%
kveclo_eig
(
atoms
%
nlotot
,
kpts
%
nkpt
),
stat
=
ok
)
IF
(
ok
/
=
0
)
STOP
'eigen_hf: failure allocation hybdat%kveclo_eig'
...
...
@@ -75,7 +75,7 @@ CONTAINS
nrec1
=
kpts
%
nkpt
*
(
jsp
-
1
)
+
nk
CALL
lapw
%
init
(
input
,
noco
,
kpts
,
atoms
,
sym
,
nk
,
cell
,
sym
%
zrfs
)
nbasfcn
=
MERGE
(
lapw
%
nv
(
1
)
+
lapw
%
nv
(
2
)
+
2
*
atoms
%
nlotot
,
lapw
%
nv
(
1
)
+
atoms
%
nlotot
,
noco
%
l_noco
)
CALL
zMat
(
nk
)
%
init
(
l_real
,
nbasfcn
,
dimension
%
neigd2
)
CALL
zMat
(
nk
)
%
init
(
l_real
,
nbasfcn
,
merge
(
dimension
%
neigd
*
2
,
dimension
%
neigd
,
noco
%
l_soc
)
)
CALL
read_eig
(
eig_id_hf
,
nk
,
jsp
,
zmat
=
zMat
(
nk
))
eig_irr
(:,
nk
)
=
results
%
eig
(:,
nk
,
jsp
)
hybrid
%
ne_eig
(
nk
)
=
results
%
neig
(
nk
,
jsp
)
...
...
@@ -83,7 +83,7 @@ CONTAINS
!Allocate further space
DO
nk
=
kpts
%
nkpt
+
1
,
kpts
%
nkptf
nbasfcn
=
zMat
(
kpts
%
bkp
(
nk
))
%
matsize1
CALL
zMat
(
nk
)
%
init
(
l_real
,
nbasfcn
,
dimension
%
neigd2
)
CALL
zMat
(
nk
)
%
init
(
l_real
,
nbasfcn
,
merge
(
dimension
%
neigd
*
2
,
dimension
%
neigd
,
noco
%
l_soc
)
)
END
DO
!determine degenerate states at each k-point
...
...
hybrid/hyb_abcrot.F90
View file @
7f10ed8c
...
...
@@ -52,7 +52,7 @@ CONTAINS
DO
ineq
=
1
,
atoms
%
neq
(
itype
)
iatom
=
iatom
+
1
IF
(
.NOT.
oneD
%
odi
%
d1
)
THEN
iop
=
atoms
%
ngopr
(
iatom
)
iop
=
sym
%
ngopr
(
iatom
)
ELSE
iop
=
oneD
%
ods
%
ngopr
(
iatom
)
ENDIF
...
...
@@ -60,9 +60,9 @@ CONTAINS
! inversion of spherical harmonics: Y (pi-theta,pi+phi) = (-1) * Y (theta,phi)
! m m
ifac
=
1
IF
(
atoms
%
invsat
(
iatom
)
==
2
)
THEN
IF
(
sym
%
invsat
(
iatom
)
==
2
)
THEN
IF
(
.NOT.
oneD
%
odi
%
d1
)
THEN
iop
=
atoms
%
ngopr
(
sym
%
invsatnr
(
iatom
))
iop
=
sym
%
ngopr
(
sym
%
invsatnr
(
iatom
))
ELSE
iop
=
oneD
%
ods
%
ngopr
(
sym
%
invsatnr
(
iatom
))
ENDIF
...
...
hybrid/hybrid.F90
View file @
7f10ed8c
...
...
@@ -88,7 +88,7 @@ CONTAINS
END
IF
hybrid
%
l_subvxc
=
(
hybrid
%
l_subvxc
.AND.
hybrid
%
l_addhf
)
IF
(
.NOT.
ALLOCATED
(
results
%
w_iks
))
ALLOCATE
(
results
%
w_iks
(
DIMENSION
%
neigd2
,
kpts
%
nkpt
,
input
%
jspins
))
IF
(
.NOT.
ALLOCATED
(
results
%
w_iks
))
ALLOCATE
(
results
%
w_iks
(
merge
(
dimension
%
neigd
*
2
,
dimension
%
neigd
,
noco
%
l_soc
)
,
kpts
%
nkpt
,
input
%
jspins
))
IF
(
hybrid
%
l_calhf
)
THEN
iterHF
=
iterHF
+
1
...
...
hybrid/kp_perturbation.F90
View file @
7f10ed8c
...
...
@@ -157,9 +157,9 @@ MODULE m_kp_perturbation
const
=
fpi_const
*
(
atoms
%
rmt
(
itype
)
**
2
)/
2
/
sqrt
(
cell
%
omtil
)
DO
ieq
=
1
,
atoms
%
neq
(
itype
)
iatom
=
iatom
+
1
IF
((
atoms
%
invsat
(
iatom
)
==
0
)
.or.
(
atoms
%
invsat
(
iatom
)
==
1
))
THEN
IF
(
atoms
%
invsat
(
iatom
)
==
0
)
invsfct
=
1
IF
(
atoms
%
invsat
(
iatom
)
==
1
)
THEN
IF
((
sym
%
invsat
(
iatom
)
==
0
)
.or.
(
sym
%
invsat
(
iatom
)
==
1
))
THEN
IF
(
sym
%
invsat
(
iatom
)
==
0
)
invsfct
=
1
IF
(
sym
%
invsat
(
iatom
)
==
1
)
THEN
invsfct
=
2
iatom1
=
sym
%
invsatnr
(
iatom
)
END
IF
...
...
hybrid/read_core.F90
View file @
7f10ed8c
This diff is collapsed.
Click to expand it.
hybrid/subvxc.F90
View file @
7f10ed8c
...
...
@@ -168,7 +168,7 @@ CONTAINS
iatom
=
0
DO
itype
=
1
,
atoms
%
ntype
typsym
=
atoms
%
ntypsy
(
SUM
(
atoms
%
neq
(:
itype
-
1
))
+
1
)
typsym
=
sym
%
ntypsy
(
SUM
(
atoms
%
neq
(:
itype
-
1
))
+
1
)
nlharm
=
sphhar
%
nlh
(
typsym
)
! Calculate vxc = vtot - vcoul
...
...
@@ -298,7 +298,7 @@ CONTAINS
DO
itype
=
1
,
atoms
%
ntype
typsym
=
atoms
%
ntypsy
(
SUM
(
atoms
%
neq
(:
itype
-
1
))
+
1
)
typsym
=
sym
%
ntypsy
(
SUM
(
atoms
%
neq
(:
itype
-
1
))
+
1
)
nlharm
=
sphhar
%
nlh
(
typsym
)
! Calculate vxc = vtot - vcoul
...
...
@@ -340,10 +340,10 @@ CONTAINS
DO
ieq
=
1
,
atoms
%
neq
(
itype
)
iatom
=
iatom
+
1
IF
((
atoms
%
invsat
(
iatom
)
==
0
)
.OR.
(
atoms
%
invsat
(
iatom
)
==
1
))
THEN
IF
((
sym
%
invsat
(
iatom
)
==
0
)
.OR.
(
sym
%
invsat
(
iatom
)
==
1
))
THEN
IF
(
atoms
%
invsat
(
iatom
)
==
0
)
invsfct
=
1
IF
(
atoms
%
invsat
(
iatom
)
==
1
)
invsfct
=
2
IF
(
sym
%
invsat
(
iatom
)
==
0
)
invsfct
=
1
IF
(
sym
%
invsat
(
iatom
)
==
1
)
invsfct
=
2
DO
ilo
=
1
,
atoms
%
nlo
(
itype
)
#ifdef CPP_OLDINTEL
...
...
@@ -484,7 +484,7 @@ CONTAINS
END
DO
! ilo
ikvecprevat
=
ikvecprevat
+
ikvecat
ikvecat
=
0
END
IF
!
atoms
%invsat(iatom)
END
IF
!
sym
%invsat(iatom)
END
DO
! ieq
END
DO
!itype
END
IF
! if any atoms%llo
...
...
@@ -513,4 +513,3 @@ CONTAINS
END
SUBROUTINE
subvxc
END
MODULE
m_subvxc
hybrid/symm_hf.F90
View file @
7f10ed8c
...
...
@@ -10,7 +10,7 @@
! M.Betzinger (09/07) !
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
MODULE
m_symm_hf
use
m_judft
#define irreps .false.
CONTAINS
...
...
@@ -52,7 +52,8 @@ CONTAINS
rotkpt
=
matmul
(
rrot
(:,
:,
i
),
kpts
%
bkf
(:,
nk
))
!transfer rotkpt into BZ
rotkpt
=
modulo1
(
rotkpt
,
kpts
%
nkpt3
)
call
judft_error
(
"Missing functionality"
)
!rotkpt = modulo1(rotkpt, kpts%nkpt3)
!check if rotkpt is identical to bk(:,nk)
IF
(
maxval
(
abs
(
rotkpt
-
kpts
%
bkf
(:,
nk
)))
<=
1E-07
)
THEN
...
...
@@ -162,7 +163,8 @@ CONTAINS
rotkpt
=
matmul
(
rrot
(:,
:,
psym
(
iop
)),
kpts
%
bkf
(:,
ikpt
))
!transfer rotkpt into BZ
rotkpt
=
modulo1
(
rotkpt
,
kpts
%
nkpt3
)
call
judft_error
(
"Missing functionality"
)
!rotkpt = modulo1(rotkpt, kpts%nkpt3)