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
55
Issues
55
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
Show 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
...
...
@@ -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
)
...
...
fleurinput/constants.f90
View file @
7f10ed8c
...
...
@@ -26,7 +26,8 @@ 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
...
...
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
(:)
...
...
global/checkdop.F90
View file @
7f10ed8c
...
...
@@ -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
...
...
global/find_enpara.f90
View file @
7f10ed8c
...
...
@@ -15,27 +15,25 @@ 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
(:)
...
...
@@ -129,30 +126,11 @@ CONTAINS
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
...
...
@@ -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
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)
!determine number of rotkpt
nrkpt
=
0
...
...
@@ -221,7 +223,8 @@ CONTAINS
rotkpt
=
matmul
(
rrot
(:,
:,
isym
),
kpts
%
bkf
(:,
ikpt
))
!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(:,ikpt)
IF
(
maxval
(
abs
(
rotkpt
-
kpts
%
bkf
(:,
ikpt
)))
<=
1E-06
)
THEN
...
...
@@ -573,7 +576,8 @@ CONTAINS
rotkpt
=
matmul
(
rrot
(:,
:,
iop
),
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
...
...
@@ -608,7 +612,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)
!determine number of rotkpt
nrkpt
=
0
...
...
hybrid/symmetrizeh.F90
View file @
7f10ed8c
...
...
@@ -233,9 +233,9 @@ CONTAINS
DO
itype
=
1
,
atoms
%
ntype
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
)
invsfct
=
2
IF
((
sym
%
invsat
(
iatom
)
==
0
)
.OR.
(
sym
%
invsat
(
iatom
)
==
1
))
THEN
IF
(
sym
%
invsat
(
iatom
)
==
0
)
invsfct
=
1
IF
(
sym
%
invsat
(
iatom
)
==
1
)
invsfct
=
2
DO
ilo
=
1
,
atoms
%
nlo
(
itype
)
l
=
atoms
%
llo
(
ilo
,
itype
)
DO
m
=
1
,
invsfct
*
(
2
*
l
+
1
)
...
...
@@ -264,9 +264,9 @@ CONTAINS
DO
itype
=
1
,
atoms
%
ntype
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
)
invsfct
=
2
IF
((
sym
%
invsat
(
iatom
)
==
0
)
.OR.
(
sym
%
invsat
(
iatom
)
==
1
))
THEN
IF
(
sym
%
invsat
(
iatom
)
==
0
)
invsfct
=
1
IF
(
sym
%
invsat
(
iatom
)
==
1
)
invsfct
=
2
DO
ilo
=
1
,
atoms
%
nlo
(
itype
)
l
=
atoms
%
llo
(
ilo
,
itype
)
...
...
@@ -325,10 +325,10 @@ CONTAINS
iatom
=
iatom
+
1
ratom
=
map
(
isym
,
iatom
)
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
(
atoms
%
invsat
(
ratom
)
==
2
)
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
IF
(
sym
%
invsat
(
ratom
)
==
2
)
THEN
ratom
=
sym
%
invsatnr
(
ratom
)
END
IF
invsfct
=
2
...
...
@@ -387,9 +387,9 @@ CONTAINS
DO
itype
=
1
,
atoms
%
ntype
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
)
invsfct
=
2
IF
((
sym
%
invsat
(
iatom
)
==
0
)
.OR.
(
sym
%
invsat
(
iatom
)
==
1
))
THEN
IF
(
sym
%
invsat
(
iatom
)
==
0
)
invsfct
=
1
IF
(
sym
%
invsat
(
iatom
)
==
1
)
invsfct
=
2
DO
ilo
=
1
,
atoms
%
nlo
(
itype
)
l
=
atoms
%
llo
(
ilo
,
itype
)
...
...
@@ -403,7 +403,7 @@ CONTAINS
iop
=
psym
(
isym
)
ratom
=
map
(
isym
,
iatom
)
IF
(
invsfct
==
2
)
THEN
IF
(
atoms
%
invsat
(
ratom
)
==
2
)
THEN
IF
(
sym
%
invsat
(
ratom
)
==
2
)
THEN
ratom
=
sym
%
invsatnr
(
ratom
)
END
IF
END
IF
...
...
@@ -448,9 +448,9 @@ CONTAINS
DO
itype
=
1
,
atoms
%
ntype
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
)
invsfct
=
2
IF
((
sym
%
invsat
(
iatom
)
==
0
)
.OR.
(
sym
%
invsat
(
iatom
)
==
1
))
THEN
IF
(
sym
%
invsat
(
iatom
)
==
0
)
invsfct
=
1
IF
(
sym
%
invsat
(
iatom
)
==
1
)
invsfct
=
2
DO
ilo
=
1
,
atoms
%
nlo
(
itype
)
l
=
atoms
%
llo
(
ilo
,
itype
)
...
...
@@ -461,9 +461,9 @@ CONTAINS
DO
itype1
=
1
,
atoms
%
ntype
DO
ieq1
=
1
,
atoms
%
neq
(
itype1
)
iatom1
=
iatom1
+
1
IF
((
atoms
%
invsat
(
iatom1
)
==
0
)
.OR.
(
atoms
%
invsat
(
iatom1
)
==
1
))
THEN
IF
(
atoms
%
invsat
(
iatom1
)
==
0
)
invsfct1
=
1
IF
(
atoms
%
invsat
(
iatom1
)
==
1
)
invsfct1
=
2
IF
((
sym
%
invsat
(
iatom1
)
==
0
)
.OR.
(
sym
%
invsat
(
iatom1
)
==
1
))
THEN
IF
(
sym
%
invsat
(
iatom1
)
==
0
)
invsfct1
=
1
IF
(
sym
%
invsat
(
iatom1
)
==
1
)
invsfct1
=
2
DO
ilo1
=
1
,
atoms
%
nlo
(
itype1
)
l1
=
atoms
%
llo
(
ilo1
,
itype1
)
...
...
@@ -478,12 +478,12 @@ CONTAINS
ratom1
=
map
(
isym
,
iatom1
)
IF
(
invsfct
==
2
)
THEN
IF
(
atoms
%
invsat
(
ratom
)
==
2
)
THEN
IF
(
sym
%
invsat
(
ratom
)
==
2
)
THEN
ratom
=
sym
%
invsatnr
(
ratom
)
END
IF
END
IF
IF
(
invsfct1
==
2
)
THEN
IF
(
atoms
%
invsat
(
ratom1
)
==
2
)
THEN
IF
(
sym
%
invsat
(
ratom1
)
==
2
)
THEN
ratom1
=
sym
%
invsatnr
(
ratom1
)
END
IF
END
IF
...
...
hybrid/trafo.F90
View file @
7f10ed8c
...
...
@@ -5,7 +5,7 @@
!--------------------------------------------------------------------------------
MODULE
m_trafo
use
m_judft
CONTAINS
SUBROUTINE
waveftrafo_symm
(
cmt_out
,
z_out
,
cmt
,
l_real
,
z_r
,
z_c
,
bandi
,
ndb
,
&
...
...
@@ -76,7 +76,8 @@ CONTAINS
rkpt
=
matmul
(
rrot
,
kpts
%
bk
(:,
nk
))
rkpthlp
=
rkpt
rkpt
=
modulo1
(
rkpt
,
kpts
%
nkpt3
)
call
judft_error
(
"Missing functionality here"
)
!rkpt = modulo1(rkpt, kpts%nkpt3)
g1
=
nint
(
rkpt
-
rkpthlp
)
! MT coefficients
...
...
@@ -223,7 +224,8 @@ CONTAINS
rkpt
=
matmul
(
rrot
,
kpts
%
bk
(:,
nk
))
rkpthlp
=
rkpt
rkpt
=
modulo1
(
rkpt
,
kpts
%
nkpt3
)
call
judft_error
(
"Missing functionality here"
)
!rkpt = modulo1(rkpt, kpts%nkpt3)
g1
=
nint
(
rkpt
-
rkpthlp
)
! MT coefficients
...
...
@@ -369,7 +371,7 @@ CONTAINS
nn
=
sum
((/((
2
*
l
+
1
)
*
nindxm
(
l
,
itype
),
l
=
0
,
lcutm
(
itype
))/))
DO
ieq
=
1
,
atoms
%
neq
(
itype
)
ic
=
ic
+
1
IF
(
atoms
%
invsat
(
ic
)
==
0
)
THEN
IF
(
sym
%
invsat
(
ic
)
==
0
)
THEN
! if the structure is inversion-symmetric, but the equivalent atom belongs to a different unit cell
! invsat(atom) = 0, invsatnr(atom) = 0
! but we need invsatnr(atom) = natom
...
...
@@ -481,7 +483,7 @@ CONTAINS
nn
=
sum
((/((
2
*
l
+
1
)
*
nindxm
(
l
,
itype
),
l
=
0
,
lcutm
(
itype
))/))
DO
ieq
=
1
,
atoms
%
neq
(
itype
)
ic
=
ic
+
1
IF
(
atoms
%
invsat
(
ic
)
==
0
)
THEN
IF
(
sym
%
invsat
(
ic
)
==
0
)
THEN
! if the structure is inversion-symmetric, but the equivalent atom belongs to a different unit cell
! invsat(atom) = 0, invsatnr(atom) =0
! but we need invsatnr(atom) = natom
...
...
@@ -633,7 +635,8 @@ CONTAINS
rkpt
=
matmul
(
rrot
,
kpts
%
bkf
(:,
ikpt0
))
rkpthlp
=
rkpt
rkpt
=
modulo1
(
rkpt
,
kpts
%
nkpt3
)
call
judft_error
(
"Missing functionality here"
)
!rkpt = modulo1(rkpt, kpts%nkpt3)
g
=
nint
(
rkpthlp
-
rkpt
)
#ifdef CPP_DEBUG
...
...
@@ -838,7 +841,8 @@ CONTAINS
rrot
=
transpose
(
sym
%
mrot
(:,
:,
sym
%
invtab
(
iisym
)))
invrrot
=
transpose
(
sym
%
mrot
(:,
:,
iisym
))
rkpt
=
matmul
(
rrot
,
kpts
%
bk
(:,
ikpt0
))
rkpthlp
=
modulo1
(
rkpt
,
kpts
%
nkpt3
)
call
judft_error
(
"Missing functionality here"
)
! rkpthlp = modulo1(rkpt, kpts%nkpt3)
g
=
nint
(
rkpt
-
rkpthlp
)
CALL
d_wigner
(
invrot
,
cell
%
bmat
,
maxlcutm
,
dwgn
(:,
:,
1
:
maxlcutm
))
...
...
@@ -854,7 +858,8 @@ CONTAINS
rrot
=
-
transpose
(
sym
%
mrot
(:,
:,
sym
%
invtab
(
iisym
)))
invrrot
=
-
transpose
(
sym
%
mrot
(:,
:,
iisym
))
rkpt
=
matmul
(
rrot
,
kpts
%
bk
(:,
ikpt0
))
rkpthlp
=
modulo1
(
rkpt
,
kpts
%
nkpt3
)
call
judft_error
(
"Missing functionality here"
)
!rkpthlp = modulo1(rkpt, kpts%nkpt3)
g
=
nint
(
rkpt
-
rkpthlp
)
matin1
=
conjg
(
matin1
)
...
...
@@ -1111,7 +1116,8 @@ CONTAINS
END
DO
rkpt
=
matmul
(
rrot
,
kpts
%
bk
(:,
ikpt0
))
rkpthlp
=
modulo1
(
rkpt
,
kpts
%
nkpt3
)
call
judft_error
(
"Missing functionality here"
)
!rkpthlp = modulo1(rkpt, kpts%nkpt3)
g
=
nint
(
rkpt
-
rkpthlp
)
! determine number of rotated k-point bk(:,ikpt) -> ikpt1
...
...
@@ -1332,7 +1338,8 @@ CONTAINS
rrot
=
transpose
(
sym
%
mrot
(:,
:,
sym
%
invtab
(
iisym
)))
invrrot
=
transpose
(
sym
%
mrot
(:,
:,
iisym
))
rkpt
=
matmul
(
rrot
,
kpts
%
bk
(:,
ikpt0
))
rkpthlp
=
modulo1
(
rkpt
,
kpts
%
nkpt3
)
call
judft_error
(
"Missing functionality here"
)
!rkpthlp = modulo1(rkpt, kpts%nkpt3)
g
=
nint
(
rkpt
-
rkpthlp
)
CALL
d_wigner
(
invrot
,
cell
%
bmat
,
maxlcutm
,
dwgn
(:,
:,
1
:
maxlcutm
))
...
...
@@ -1348,7 +1355,8 @@ CONTAINS
invrot
=
sym
%
mrot
(:,
:,
sym
%
invtab
(
iisym
))