Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Support
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
fleur
Project
Project
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
57
Issues
57
List
Boards
Labels
Milestones
Packages
Packages
Container Registry
Wiki
Wiki
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Commits
Issue Boards
Open sidebar
fleur
fleur
Commits
ab6dd87f
Commit
ab6dd87f
authored
Jul 12, 2017
by
Gregor Michalicek
1
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Initial commit for the implementation of multiple U parameters on each atom type
This is not yet tested.
parent
774881a1
Changes
19
Expand all
Hide whitespace changes
Inline
Side-by-side
Showing
19 changed files
with
730 additions
and
741 deletions
+730
-741
cdn/n_mat.f90
cdn/n_mat.f90
+23
-21
eigen/hsmt.F90
eigen/hsmt.F90
+1
-1
eigen/hsmt_extra.F90
eigen/hsmt_extra.F90
+44
-28
eigen/tlmplm_store.F90
eigen/tlmplm_store.F90
+15
-9
force/force_a21.F90
force/force_a21.F90
+17
-9
force/force_a21_U.f90
force/force_a21_U.f90
+41
-60
global/types.F90
global/types.F90
+4
-3
init/inped.F90
init/inped.F90
+9
-12
io/r_inpXML.F90
io/r_inpXML.F90
+28
-30
io/rw_inp.f90
io/rw_inp.f90
+26
-16
ldau/u_ham.F90
ldau/u_ham.F90
+99
-103
ldau/u_setup.f90
ldau/u_setup.f90
+40
-46
ldau/uj2f.f90
ldau/uj2f.f90
+79
-82
ldau/umtx.f90
ldau/umtx.f90
+51
-55
ldau/v_mmp.F90
ldau/v_mmp.F90
+129
-131
main/cdngen.F90
main/cdngen.F90
+4
-4
mix/u_mix.f90
mix/u_mix.f90
+60
-67
mpi/mpi_bc_all.F90
mpi/mpi_bc_all.F90
+5
-4
optional/flipcdn.f90
optional/flipcdn.f90
+55
-60
No files found.
cdn/n_mat.f90
View file @
ab6dd87f
...
...
@@ -11,6 +11,7 @@ MODULE m_nmat
! all atoms are stored in lda_u(), if lda_u()<0, no +U is used.
! For details see Eq.(12) of Shick et al. PRB 60, 10765 (1999)
! Part of the LDA+U package G.B., Oct. 2000
! Extension to multiple U per atom type by G.M. 2017
! ************************************************************
CONTAINS
SUBROUTINE
n_mat
(
atoms
,
sym
,
ne
,
usdus
,
jspin
,
we
,
acof
,
bcof
,
ccof
,
n_mmp
)
...
...
@@ -34,7 +35,7 @@ CONTAINS
! ..
! .. Local Scalars ..
COMPLEX
c_0
INTEGER
i
,
j
,
k
,
l
,
mp
,
n
,
it
,
is
,
isi
,
natom
,
n
_ldau
,
lp
,
m
INTEGER
i
,
j
,
k
,
l
,
mp
,
n
,
it
,
is
,
isi
,
natom
,
n
atomTemp
,
n_ldau
,
lp
,
m
,
i_u
INTEGER
ilo
,
ilop
,
ll1
,
nn
,
lmp
,
lm
REAL
fac
! ..
...
...
@@ -45,16 +46,17 @@ CONTAINS
!
! calculate n_mat:
!
n_ldau
=
0
natom
=
0
i_u
=
1
DO
n
=
1
,
atoms
%
ntype
IF
(
atoms
%
lda_u
(
n
)
%
l
.GE.
0
)
THEN
n_ldau
=
n_ldau
+
1
n_tmp
(:,:)
=
cmplx
(
0.0
,
0.0
)
l
=
atoms
%
lda_u
(
n
)
%
l
DO
WHILE
(
i_u
.LE.
atoms
%
n_u
)
IF
(
atoms
%
lda_u
(
i_u
)
%
atomType
.GT.
n
)
EXIT
natomTemp
=
natom
n_tmp
(:,:)
=
cmplx
(
0.0
,
0.0
)
l
=
atoms
%
lda_u
(
i_u
)
%
l
ll1
=
(
l
+1
)
*
l
DO
nn
=
1
,
atoms
%
neq
(
n
)
natom
=
natom
+
1
natom
Temp
=
natomTemp
+
1
!
! prepare n_mat in local frame (in noco-calculations this depends
! also on alpha(n) and beta(n) )
...
...
@@ -66,8 +68,8 @@ CONTAINS
c_0
=
cmplx
(
0.0
,
0.0
)
DO
i
=
1
,
ne
c_0
=
c_0
+
we
(
i
)
*
(
usdus
%
ddn
(
l
,
n
,
jspin
)
*
&
conjg
(
bcof
(
i
,
lmp
,
natom
))
*
bcof
(
i
,
lm
,
natom
)
+
&
conjg
(
acof
(
i
,
lmp
,
natom
))
*
acof
(
i
,
lm
,
natom
)
)
conjg
(
bcof
(
i
,
lmp
,
natom
Temp
))
*
bcof
(
i
,
lm
,
natomTemp
)
+
&
conjg
(
acof
(
i
,
lmp
,
natom
Temp
))
*
acof
(
i
,
lm
,
natomTemp
)
)
ENDDO
n_tmp
(
m
,
mp
)
=
c_0
ENDDO
...
...
@@ -85,17 +87,17 @@ CONTAINS
c_0
=
cmplx
(
0.0
,
0.0
)
DO
i
=
1
,
ne
c_0
=
c_0
+
we
(
i
)
*
(
usdus
%
uulon
(
ilo
,
n
,
jspin
)
*
(&
conjg
(
acof
(
i
,
lmp
,
natom
))
*
ccof
(
m
,
i
,
ilo
,
natom
)
+
&
conjg
(
ccof
(
mp
,
i
,
ilo
,
natom
))
*
acof
(
i
,
lm
,
natom
)
)&
conjg
(
acof
(
i
,
lmp
,
natom
Temp
))
*
ccof
(
m
,
i
,
ilo
,
natomTemp
)
+
&
conjg
(
ccof
(
mp
,
i
,
ilo
,
natom
Temp
))
*
acof
(
i
,
lm
,
natomTemp
)
)&
+
usdus
%
dulon
(
ilo
,
n
,
jspin
)
*
(&
conjg
(
bcof
(
i
,
lmp
,
natom
))
*
ccof
(
m
,
i
,
ilo
,
natom
)
+
&
conjg
(
ccof
(
mp
,
i
,
ilo
,
natom
))
*
bcof
(
i
,
lm
,
natom
)))
conjg
(
bcof
(
i
,
lmp
,
natom
Temp
))
*
ccof
(
m
,
i
,
ilo
,
natomTemp
)
+
&
conjg
(
ccof
(
mp
,
i
,
ilo
,
natom
Temp
))
*
bcof
(
i
,
lm
,
natomTemp
)))
ENDDO
DO
ilop
=
1
,
atoms
%
nlo
(
n
)
IF
(
atoms
%
llo
(
ilop
,
n
)
.EQ.
l
)
THEN
DO
i
=
1
,
ne
c_0
=
c_0
+
we
(
i
)
*
usdus
%
uloulopn
(
ilo
,
ilop
,
n
,
jspin
)
*
&
conjg
(
ccof
(
mp
,
i
,
ilop
,
natom
))
*
ccof
(
m
,
i
,
ilo
,
natom
)
conjg
(
ccof
(
mp
,
i
,
ilop
,
natom
Temp
))
*
ccof
(
m
,
i
,
ilo
,
natomTemp
)
ENDDO
ENDIF
ENDDO
...
...
@@ -108,10 +110,10 @@ CONTAINS
!
! n_mmp should be rotated by D_mm' ; compare force_a21
!
DO
it
=
1
,
sym
%
invarind
(
natom
)
DO
it
=
1
,
sym
%
invarind
(
natom
Temp
)
fac
=
1.0
/
(
sym
%
invarind
(
natom
)
*
atoms
%
neq
(
n
)
)
is
=
sym
%
invarop
(
natom
,
it
)
fac
=
1.0
/
(
sym
%
invarind
(
natom
Temp
)
*
atoms
%
neq
(
n
)
)
is
=
sym
%
invarop
(
natom
Temp
,
it
)
isi
=
sym
%
invtab
(
is
)
d_tmp
(:,:)
=
cmplx
(
0.0
,
0.0
)
DO
m
=
-
l
,
l
...
...
@@ -123,16 +125,16 @@ CONTAINS
n1_tmp
=
matmul
(
nr_tmp
,
d_tmp
)
DO
m
=
-
l
,
l
DO
mp
=
-
l
,
l
n_mmp
(
m
,
mp
,
n_ldau
)
=
n_mmp
(
m
,
mp
,
n_ldau
)
+
conjg
(
n1_tmp
(
m
,
mp
))
*
fac
n_mmp
(
m
,
mp
,
i_u
)
=
n_mmp
(
m
,
mp
,
i_u
)
+
conjg
(
n1_tmp
(
m
,
mp
))
*
fac
ENDDO
ENDDO
ENDDO
ENDDO
! sum over equivalent atoms
ELSE
natom
=
natom
+
atoms
%
neq
(
n
)
ENDIF
i_u
=
i_u
+
1
END
DO
natom
=
natom
+
atoms
%
neq
(
n
)
ENDDO
! loop over atom types
! do m=-l,l
...
...
eigen/hsmt.F90
View file @
ab6dd87f
...
...
@@ -229,7 +229,7 @@ CONTAINS
#endif
IF
(
.NOT.
input
%
secvar
)
THEN
CALL
timestart
(
"hsmt extra"
)
IF
(
ANY
(
atoms
%
nlo
>
0
)
.OR.
ANY
(
atoms
%
lda_u
%
l
.GE
.
0
))
&
IF
(
ANY
(
atoms
%
nlo
>
0
)
.OR.
(
atoms
%
n_u
.GT
.
0
))
&
CALL
hsmt_extra
(
DIMENSION
,
atoms
,
sym
,
isp
,
n_size
,
n_rank
,
input
,
nintsp
,
sub_comm
,&
hlpmsize
,
lmaxb
,
gwc
,
noco
,
l_socfirst
,
lapw
,
cell
,
enpara
%
el0
,&
fj
,
gj
,
gk
,
vk
,
tlmplm
,
usdus
,
vs_mmp
,
oneD
,&
!in
...
...
eigen/hsmt_extra.F90
View file @
ab6dd87f
...
...
@@ -64,12 +64,11 @@ CONTAINS
COMPLEX
chi11
,
chi21
,
chi22
INTEGER
k
,
i
,
spin2
,&
l
,
ll1
,
lo
,
jd
,&
m
,
n
,
na
,
nn
,
np
,&
iiloh
,
iilos
,
nkvecprevath
,
nkvecprevats
,&
iintsp
,
jintsp
INTEGER
k
,
i
,
spin2
,
l
,
ll1
,
lo
,
jd
INTEGER
m
,
n
,
na
,
nn
,
np
,
i_u
INTEGER
iiloh
,
iilos
,
nkvecprevath
,
nkvecprevats
,
iintsp
,
jintsp
INTEGER
nc
,
locolh
,
locols
,
nkvecprevatu
,
iilou
,
locolu
INTEGER
nkvecprevatuTemp
,
iilouTemp
,
locoluTemp
INTEGER
ab_dim
,
nkvec_sv
,
fjstart
LOGICAL
enough
,
l_lo1
! ..
...
...
@@ -105,6 +104,7 @@ CONTAINS
na
=
0
nkvecprevats
=
0
nkvecprevath
=
0
nkvecprevatu
=
0
nkvec_sv
=
0
!Determine index of first LO
locols
=
lapw
%
nv
(
1
)
...
...
@@ -123,7 +123,10 @@ CONTAINS
iiloh
=
lapw
%
nv
(
1
)
*
(
lapw
%
nv
(
1
)
+1
)/
2
#endif
iilou
=
iilos
locolu
=
locols
i_u
=
1
ntype_loop
:
DO
n
=
1
,
atoms
%
ntype
IF
(
noco
%
l_noco
)
THEN
...
...
@@ -268,29 +271,42 @@ CONTAINS
ENDIF
END
IF
IF
(
atoms
%
n_u
>
0.
and
.
atoms
%
lda_u
(
n
)
%
l
.GE.
0.
AND
.gwc.
EQ
.1
)
THEN
IF
(
noco
%
l_noco
.AND.
(
.NOT.
noco
%
l_ss
)
)
THEN
CALL
u_ham
(&
atoms
,
input
,
lapw
,
isp
,
n
,
invsfct
,&
ar
,
ai
,
br
,
bi
,
vs_mmp
,
lmaxb
,&
alo
,
blo
,
clo
,&
n_size
,
n_rank
,
isp
,
usdus
,
noco
,&
1
,
1
,
chi11
,
chi22
,
chi21
,&
nkvecprevatu
,
iilou
,
locolu
,
.false.
,
aa_c
=
aahlp
)
ELSE
DO
iintsp
=
1
,
nintsp
DO
jintsp
=
1
,
iintsp
CALL
u_ham
(&
atoms
,
input
,
lapw
,
isp
,
n
,
invsfct
,&
ar
,
ai
,
br
,
bi
,
vs_mmp
,
lmaxb
,&
alo
,
blo
,
clo
,&
n_size
,
n_rank
,
isp
,
usdus
,
noco
,&
iintsp
,
jintsp
,
chi11
,
chi22
,
chi21
,&
nkvecprevatu
,
iilou
,
locolu
,
l_real
,
aa_r
,
aa_c
)
ENDDO
ENDDO
ENDIF
ENDIF
IF
((
gwc
.EQ.
1
)
.AND.
(
atoms
%
n_u
.GT.
0
))
THEN
nkvecprevatuTemp
=
nkvecprevatu
iilouTemp
=
iilou
locoluTemp
=
locolu
DO
WHILE
(
i_u
.LE.
atoms
%
n_u
)
IF
(
atoms
%
lda_u
(
i_u
)
%
atomType
.GT.
n
)
EXIT
nkvecprevatuTemp
=
nkvecprevatu
iilouTemp
=
iilou
locoluTemp
=
locolu
IF
(
atoms
%
lda_u
(
i_u
)
%
atomType
.EQ.
n
)
THEN
IF
((
noco
%
l_noco
)
.AND.
(
.NOT.
noco
%
l_ss
))
THEN
CALL
u_ham
(
atoms
,
input
,
lapw
,
isp
,
n
,
i_u
,
invsfct
,&
ar
,
ai
,
br
,
bi
,
vs_mmp
,
lmaxb
,&
alo
,
blo
,
clo
,&
n_size
,
n_rank
,
isp
,
usdus
,
noco
,&
1
,
1
,
chi11
,
chi22
,
chi21
,&
nkvecprevatuTemp
,
iilouTemp
,
locoluTemp
,
.false.
,
aa_c
=
aahlp
)
ELSE
DO
iintsp
=
1
,
nintsp
DO
jintsp
=
1
,
iintsp
CALL
u_ham
(
atoms
,
input
,
lapw
,
isp
,
n
,
i_u
,
invsfct
,&
ar
,
ai
,
br
,
bi
,
vs_mmp
,
lmaxb
,&
alo
,
blo
,
clo
,&
n_size
,
n_rank
,
isp
,
usdus
,
noco
,&
iintsp
,
jintsp
,
chi11
,
chi22
,
chi21
,&
nkvecprevatuTemp
,
iilouTemp
,
locoluTemp
,
l_real
,
aa_r
,
aa_c
)
END
DO
END
DO
END
IF
END
IF
i_u
=
i_u
+
1
END
DO
nkvecprevatu
=
nkvecprevatuTemp
iilou
=
iilouTemp
locolu
=
locoluTemp
END
IF
ENDIF
! atoms%invsat(na) = 0 or 1
!---> end loop over equivalent atoms
...
...
eigen/tlmplm_store.F90
View file @
ab6dd87f
...
...
@@ -14,7 +14,7 @@ MODULE m_tlmplm_store
PRIVATE
TYPE
(
t_tlmplm
)
::
td_stored
COMPLEX
,
ALLOCATABLE
::
vs_mmp_stored
(:,:,:,:)
PUBLIC
write_tlmplm
,
read_tlmplm
PUBLIC
write_tlmplm
,
read_tlmplm
,
read_tlmplm_vs_mmp
CONTAINS
SUBROUTINE
write_tlmplm
(
td
,
vs_mmp
,
ldau
,
ispin
,
jspin
,
jspins
)
TYPE
(
t_tlmplm
),
INTENT
(
IN
)
::
td
...
...
@@ -58,15 +58,13 @@ CONTAINS
END
SUBROUTINE
write_tlmplm
SUBROUTINE
read_tlmplm
(
n
,
jspin
,
nlo
,
ldau
,
tuu
,
tud
,
tdu
,
tdd
,
ind
,
tuulo
,
tuloulo
,
tdulo
,
vs_mmp
)
SUBROUTINE
read_tlmplm
(
n
,
jspin
,
nlo
,
tuu
,
tud
,
tdu
,
tdd
,
ind
,
tuulo
,
tuloulo
,
tdulo
)
COMPLEX
,
INTENT
(
OUT
)::
tuu
(:),
tdd
(:),
tud
(:),
tdu
(:)
INTEGER
,
INTENT
(
OUT
)::
ind
(:,:)
COMPLEX
,
INTENT
(
OUT
)::
tuulo
(:,:,:),
tdulo
(:,:,:),
tuloulo
(:,:,:)
COMPLEX
,
INTENT
(
OUT
)::
vs_mmp
(:,:)
INTEGER
,
INTENT
(
IN
)
::
n
,
jspin
,
nlo
(:)
LOGICAL
,
INTENT
(
IN
)
::
ldau
(:)
INTEGER
::
mlo
,
mlolo
,
nn
INTEGER
::
mlo
,
mlolo
tuu
=
td_stored
%
tuu
(:
size
(
tuu
,
1
),
n
,
jspin
)
tud
=
td_stored
%
tud
(:
size
(
tuu
,
1
),
n
,
jspin
)
tdu
=
td_stored
%
tdu
(:
size
(
tuu
,
1
),
n
,
jspin
)
...
...
@@ -83,10 +81,18 @@ CONTAINS
tuloulo
(:,:,
mlolo
:
mlolo
+
nlo
(
n
)
*
(
nlo
(
n
)
+1
)/
2-1
)
=
&
td_stored
%
tuloulo
(:
size
(
tuloulo
,
1
),:
size
(
tuloulo
,
2
),
mlolo
:
mlolo
+
nlo
(
n
)
*
(
nlo
(
n
)
+1
)/
2-1
,
jspin
)
ENDIF
IF
(
ldau
(
n
))
THEN
nn
=
count
(
ldau
(:
n
-1
))
+1
vs_mmp
=
vs_mmp_stored
(
size
(
vs_mmp
,
1
),
size
(
vs_mmp
,
2
),
nn
,
jspin
)
ENDIF
END
SUBROUTINE
read_tlmplm
SUBROUTINE
read_tlmplm_vs_mmp
(
jspin
,
n_u
,
vs_mmp
)
INTEGER
,
INTENT
(
IN
)
::
jspin
,
n_u
COMPLEX
,
INTENT
(
OUT
)
::
vs_mmp
(:,:,:)
IF
(
n_u
.GT.
0
)
THEN
vs_mmp
(:,:,:)
=
vs_mmp_stored
(:,:,:,
jspin
)
END
IF
END
SUBROUTINE
read_tlmplm_vs_mmp
END
MODULE
m_tlmplm_store
force/force_a21.F90
View file @
ab6dd87f
...
...
@@ -57,13 +57,13 @@ CONTAINS
INTEGER
,
PARAMETER
::
lmaxb
=
3
COMPLEX
dtd
,
dtu
,
utd
,
utu
INTEGER
lo
,
mlotot
,
mlolotot
,
mlot_d
,
mlolot_d
INTEGER
i
,
ie
,
im
,
in
,
l1
,
l2
,
ll1
,
ll2
,
lm1
,
lm2
,
m1
,
m2
,
n
,
natom
,
m
INTEGER
i
,
ie
,
im
,
in
,
l1
,
l2
,
ll1
,
ll2
,
lm1
,
lm2
,
m1
,
m2
,
n
,
natom
,
m
,
i_u
INTEGER
natrun
,
is
,
isinv
,
j
,
irinv
,
it
REAL
,
PARAMETER
::
zero
=
0.0
COMPLEX
,
PARAMETER
::
czero
=
CMPLX
(
0.
,
0.
)
! ..
! .. Local Arrays ..
COMPLEX
,
ALLOCATABLE
::
v_mmp
(:,:)
COMPLEX
,
ALLOCATABLE
::
v_mmp
(:,:
,:
)
REAL
,
ALLOCATABLE
::
a21
(:,:),
b4
(:,:)
COMPLEX
forc_a21
(
3
),
forc_b4
(
3
)
REAL
starsum
(
3
),
starsum2
(
3
),
gvint
(
3
),
gvint2
(
3
)
...
...
@@ -85,9 +85,15 @@ CONTAINS
tlmplm
%
tuulo
(
0
:
DIMENSION
%
lmd
,
-
atoms
%
llod
:
atoms
%
llod
,
mlot_d
,
1
),&
tlmplm
%
tdulo
(
0
:
DIMENSION
%
lmd
,
-
atoms
%
llod
:
atoms
%
llod
,
mlot_d
,
1
),&
tlmplm
%
tuloulo
(
-
atoms
%
llod
:
atoms
%
llod
,
-
atoms
%
llod
:
atoms
%
llod
,
mlolot_d
,
1
),&
v_mmp
(
-
lmaxb
:
lmaxb
,
-
lmaxb
:
lmaxb
),&
a21
(
3
,
atoms
%
nat
),
b4
(
3
,
atoms
%
nat
),
tlmplm
%
ind
(
0
:
DIMENSION
%
lmd
,
0
:
DIMENSION
%
lmd
,
atoms
%
ntype
,
1
)
)
!
IF
(
atoms
%
n_u
.GT.
0
)
THEN
ALLOCATE
(
v_mmp
(
-
lmaxb
:
lmaxb
,
-
lmaxb
:
lmaxb
,
atoms
%
n_u
))
v_mmp
=
CMPLX
(
0.0
,
0.0
)
CALL
read_tlmplm_vs_mmp
(
jsp
,
atoms
%
n_u
,
v_mmp
)
END
IF
i_u
=
1
natom
=
1
DO
n
=
1
,
atoms
%
ntype
IF
(
atoms
%
l_geo
(
n
))
THEN
...
...
@@ -95,9 +101,9 @@ CONTAINS
forc_b4
(:)
=
czero
CALL
read_tlmplm
(
n
,
jsp
,
atoms
%
nlo
,
atoms
%
lda_u
%
l
.GE.
0
,
&
CALL
read_tlmplm
(
n
,
jsp
,
atoms
%
nlo
,&
tlmplm
%
tuu
(:,
n
,
1
),
tlmplm
%
tud
(:,
n
,
1
),
tlmplm
%
tdu
(:,
n
,
1
),
tlmplm
%
tdd
(:,
n
,
1
),&
tlmplm
%
ind
(:,:,
n
,
1
),
tlmplm
%
tuulo
(:,:,:,
1
),
tlmplm
%
tuloulo
(:,:,:,
1
),
tlmplm
%
tdulo
(:,:,:,
1
)
,
v_mmp
)
tlmplm
%
ind
(:,:,
n
,
1
),
tlmplm
%
tuulo
(:,:,:,
1
),
tlmplm
%
tuloulo
(:,:,:,
1
),
tlmplm
%
tdulo
(:,:,:,
1
))
DO
natrun
=
natom
,
natom
+
atoms
%
neq
(
n
)
-
1
a21
(:,
natrun
)
=
zero
...
...
@@ -190,9 +196,11 @@ CONTAINS
acof
,
bcof
,
ccof
,
aveccof
,
bveccof
,&
cveccof
,
tlmplm
,
usdus
,
a21
)
CALL
force_a21_U
(
nobd
,
atoms
,
lmaxb
,
n
,
jsp
,
we
,
ne
,&
usdus
,
v_mmp
,
acof
,
bcof
,
ccof
,&
aveccof
,
bveccof
,
cveccof
,
a21
)
IF
((
atoms
%
n_u
.GT.
0
)
.AND.
(
i_u
.LE.
atoms
%
n_u
))
THEN
CALL
force_a21_U
(
nobd
,
atoms
,
lmaxb
,
i_u
,
n
,
jsp
,
we
,
ne
,&
usdus
,
v_mmp
,
acof
,
bcof
,
ccof
,&
aveccof
,
bveccof
,
cveccof
,
a21
)
END
IF
IF
(
input
%
l_useapw
)
THEN
! -> B4 force
DO
ie
=
1
,
ne
...
...
@@ -352,7 +360,7 @@ CONTAINS
natom
=
natom
+
atoms
%
neq
(
n
)
ENDDO
!
DEALLOCATE
(
tlmplm
%
tdd
,
tlmplm
%
tuu
,
tlmplm
%
tdu
,
tlmplm
%
tud
,
tlmplm
%
tuulo
,
tlmplm
%
tdulo
,
tlmplm
%
tuloulo
,
v_mmp
,
tlmplm
%
ind
,
a21
,
b4
)
DEALLOCATE
(
tlmplm
%
tdd
,
tlmplm
%
tuu
,
tlmplm
%
tdu
,
tlmplm
%
tud
,
tlmplm
%
tuulo
,
tlmplm
%
tdulo
,
tlmplm
%
tuloulo
,
tlmplm
%
ind
,
a21
,
b4
)
END
SUBROUTINE
force_a21
END
MODULE
m_forcea21
force/force_a21_U.f90
View file @
ab6dd87f
MODULE
m_forcea21U
CONTAINS
SUBROUTINE
force_a21_U
(
nobd
,
atoms
,
lmaxb
,
itype
,
isp
,
we
,
ne
,&
SUBROUTINE
force_a21_U
(
nobd
,
atoms
,
lmaxb
,
i_u
,
itype
,
isp
,
we
,
ne
,&
usdus
,
v_mmp
,
acof
,
bcof
,
ccof
,
aveccof
,
bveccof
,
cveccof
,
a21
)
!
!***********************************************************************
...
...
@@ -16,12 +16,14 @@ CONTAINS
TYPE
(
t_atoms
),
INTENT
(
IN
)
::
atoms
! ..
! .. Scalar Arguments ..
INTEGER
,
INTENT
(
IN
)
::
nobd
INTEGER
,
INTENT
(
IN
)
::
itype
,
isp
,
ne
,
lmaxb
INTEGER
,
INTENT
(
IN
)
::
nobd
INTEGER
,
INTENT
(
IN
)
::
itype
,
isp
,
ne
,
lmaxb
INTEGER
,
INTENT
(
INOUT
)
::
i_u
! on input: index for the first U for atom type "itype or higher"
! on exit: index for the first U for atom type "itype+1 or higher"
! ..
! .. Array Arguments ..
REAL
,
INTENT
(
IN
)
::
we
(
nobd
)
COMPLEX
,
INTENT
(
IN
)
::
v_mmp
(
-
lmaxb
:
lmaxb
,
-
lmaxb
:
lmaxb
)
COMPLEX
,
INTENT
(
IN
)
::
v_mmp
(
-
lmaxb
:
lmaxb
,
-
lmaxb
:
lmaxb
,
atoms
%
n_u
)
COMPLEX
,
INTENT
(
IN
)
::
acof
(:,
0
:,:)
!(nobd,0:dimension%lmd,atoms%nat)
COMPLEX
,
INTENT
(
IN
)
::
bcof
(:,
0
:,:)
!(nobd,0:dimension%lmd,atoms%nat)
COMPLEX
,
INTENT
(
IN
)
::
ccof
(
-
atoms
%
llod
:
atoms
%
llod
,
nobd
,
atoms
%
nlod
,
atoms
%
nat
)
...
...
@@ -42,8 +44,12 @@ CONTAINS
! comments in setlomap.
!***********************************************************************
IF
(
atoms
%
lda_u
(
itype
)
%
l
.GE.
0
)
THEN
l
=
atoms
%
lda_u
(
itype
)
%
l
IF
(
atoms
%
lda_u
(
i_u
)
%
atomType
.GT.
itype
)
RETURN
DO
WHILE
(
atoms
%
lda_u
(
i_u
)
%
atomType
.EQ.
itype
)
l
=
atoms
%
lda_u
(
i_u
)
%
l
!
! Add contribution for the regular LAPWs (like force_a21, but with
! the potential matrix, v_mmp, instead of the tuu, tdd ...)
...
...
@@ -52,77 +58,52 @@ CONTAINS
lm
=
l
*
(
l
+1
)
+
m
DO
mp
=
-
l
,
l
lmp
=
l
*
(
l
+1
)
+
mp
v_a
=
v_mmp
(
m
,
mp
)
v_b
=
v_mmp
(
m
,
mp
)
*
usdus
%
ddn
(
l
,
itype
,
isp
)
v_a
=
v_mmp
(
m
,
mp
,
i_u
)
v_b
=
v_mmp
(
m
,
mp
,
i_u
)
*
usdus
%
ddn
(
l
,
itype
,
isp
)
DO
iatom
=
sum
(
atoms
%
neq
(:
itype
-1
))
+1
,
sum
(
atoms
%
neq
(:
itype
))
DO
ie
=
1
,
ne
DO
i
=
1
,
3
p1
=
(
CONJG
(
acof
(
ie
,
lm
,
iatom
))
*
v_a
)
*
aveccof
(
i
,
ie
,
lmp
,
iatom
)
p2
=
(
CONJG
(
bcof
(
ie
,
lm
,
iatom
))
*
v_b
)
*
bveccof
(
i
,
ie
,
lmp
,
iatom
)
a21
(
i
,
iatom
)
=
a21
(
i
,
iatom
)
+
2.0
*
AIMAG
(
p1
+
p2
)
*
we
(
ie
)/
atoms
%
neq
(
itype
)
END
DO
END
DO
END
DO
END
DO
! mp
END
DO
! m
p1
=
(
CONJG
(
acof
(
ie
,
lm
,
iatom
))
*
v_a
)&
*
aveccof
(
i
,
ie
,
lmp
,
iatom
)
p2
=
(
CONJG
(
bcof
(
ie
,
lm
,
iatom
))
*
v_b
)&
*
bveccof
(
i
,
ie
,
lmp
,
iatom
)
a21
(
i
,
iatom
)
=
a21
(
i
,
iatom
)
+
2.0
*
AIMAG
(&
p1
+
p2
)
*
we
(
ie
)/
atoms
%
neq
(
itype
)
! no idea, why this did not work with ifort:
! a21(i,iatom) = a21(i,iatom) + 2.0*aimag(
! + conjg(acof(ie,lm,iatom)) * v_a *
! + *aveccof(i,ie,lmp,iatom) +
! + conjg(bcof(ie,lm,iatom)) * v_b *
! + *bveccof(i,ie,lmp,iatom) )
! + *we(ie)/neq
ENDDO
ENDDO
ENDDO
ENDDO
! mp
ENDDO
! m
!
! If there are also LOs on this atom, with the same l as
! the one of LDA+U, add another few terms
!
DO
lo
=
1
,
atoms
%
nlo
(
itype
)
l
=
atoms
%
llo
(
lo
,
itype
)
IF
(
l
==
atoms
%
lda_u
(
itype
)
%
l
)
THEN
IF
(
l
==
atoms
%
llo
(
lo
,
itype
))
THEN
DO
m
=
-
l
,
l
lm
=
l
*
(
l
+1
)
+
m
DO
mp
=
-
l
,
l
lmp
=
l
*
(
l
+1
)
+
mp
v_a
=
v_mmp
(
m
,
mp
)
v_b
=
v_mmp
(
m
,
mp
)
*
usdus
%
uulon
(
lo
,
itype
,
isp
)
v_c
=
v_mmp
(
m
,
mp
)
*
usdus
%
dulon
(
lo
,
itype
,
isp
)
v_a
=
v_mmp
(
m
,
mp
,
i_u
)
v_b
=
v_mmp
(
m
,
mp
,
i_u
)
*
usdus
%
uulon
(
lo
,
itype
,
isp
)
v_c
=
v_mmp
(
m
,
mp
,
i_u
)
*
usdus
%
dulon
(
lo
,
itype
,
isp
)
DO
iatom
=
sum
(
atoms
%
neq
(:
itype
-1
))
+1
,
sum
(
atoms
%
neq
(:
itype
))
DO
ie
=
1
,
ne
DO
i
=
1
,
3
p1
=
v_a
*
(
CONJG
(
ccof
(
m
,
ie
,
lo
,
iatom
))
*
cveccof
(
i
,
mp
,
ie
,
lo
,
iatom
))
p2
=
v_b
*
(
CONJG
(
acof
(
ie
,
lm
,
iatom
))
*
cveccof
(
i
,
mp
,
ie
,
lo
,
iatom
)
+
&
CONJG
(
ccof
(
m
,
ie
,
lo
,
iatom
))
*
aveccof
(
i
,
ie
,
lmp
,
iatom
))
p3
=
v_c
*
(
CONJG
(
bcof
(
ie
,
lm
,
iatom
))
*
cveccof
(
i
,
mp
,
ie
,
lo
,
iatom
)
+
&
CONJG
(
ccof
(
m
,
ie
,
lo
,
iatom
))
*
bveccof
(
i
,
ie
,
lmp
,
iatom
))
a21
(
i
,
iatom
)
=
a21
(
i
,
iatom
)
+
2.0
*
AIMAG
(
p1
+
p2
+
p3
)
*
we
(
ie
)/
atoms
%
neq
(
itype
)
END
DO
END
DO
END
DO
END
DO
END
DO
END
IF
! l == atoms%llo(lo,itype)
END
DO
! lo = 1,atoms%nlo
p1
=
v_a
*
(
CONJG
(
ccof
(
m
,
ie
,
lo
,
iatom
))
&
*
cveccof
(
i
,
mp
,
ie
,
lo
,
iatom
)
)
p2
=
v_b
*
(
CONJG
(
acof
(
ie
,
lm
,
iatom
))&
*
cveccof
(
i
,
mp
,
ie
,
lo
,
iatom
)
+
&
CONJG
(
ccof
(
m
,
ie
,
lo
,
iatom
))&
*
aveccof
(
i
,
ie
,
lmp
,
iatom
)
)
p3
=
v_c
*
(
CONJG
(
bcof
(
ie
,
lm
,
iatom
))&
*
cveccof
(
i
,
mp
,
ie
,
lo
,
iatom
)
+
&
CONJG
(
ccof
(
m
,
ie
,
lo
,
iatom
))&
*
bveccof
(
i
,
ie
,
lmp
,
iatom
)
)
a21
(
i
,
iatom
)
=
a21
(
i
,
iatom
)
+
2.0
*
AIMAG
(&
p1
+
p2
+
p3
)
*
we
(
ie
)/
atoms
%
neq
(
itype
)
ENDDO
ENDDO
ENDDO
ENDDO
ENDDO
ENDIF
! l == atoms%lda_u
ENDDO
! lo = 1,atoms%nlo
ENDIF
i_u
=
i_u
+
1
END
DO
END
SUBROUTINE
force_a21_U
END
MODULE
m_forcea21U
global/types.F90
View file @
ab6dd87f
...
...
@@ -139,9 +139,10 @@
!
TYPE
t_utype
SEQUENCE
REAL
u
,
j
INTEGER
l
LOGICAL
::
l_amf
REAL
u
,
j
! the actual U and J parameters
INTEGER
l
! the l quantum number to which this U parameter belongs
INTEGER
atomType
! The atom type to which this U parameter belongs
LOGICAL
::
l_amf
! logical switch to choose the "around mean field" LDA+U limit
END
TYPE
t_utype
!
...
...
init/inped.F90
View file @
ab6dd87f
...
...
@@ -520,18 +520,15 @@
!
! Check for LDA+U:
!
atoms
%
n_u
=
0
DO
n
=
1
,
atoms
%
ntype
IF
(
atoms
%
lda_u
(
n
)
%
l
.GE.
0
)
THEN
atoms
%
n_u
=
atoms
%
n_u
+
1
IF
(
atoms
%
nlo
(
n
)
.GE.
1
)
THEN
DO
j
=
1
,
atoms
%
nlo
(
n
)
IF
((
ABS
(
atoms
%
llo
(
j
,
n
))
.EQ.
atoms
%
lda_u
(
n
)
%
l
)
.AND.
(
.NOT.
atoms
%
l_dulo
(
j
,
n
))
)
&
WRITE
(
*
,
*
)
'LO and LDA+U for same l not implemented'
ENDDO
ENDIF
ENDIF
ENDDO
DO
i
=
1
,
atoms
%
n_u
n
=
atoms
%
lda_u
(
i
)
%
atomType
IF
(
atoms
%
nlo
(
n
)
.GE.
1
)
THEN
DO
j
=
1
,
atoms
%
nlo
(
n
)
IF
((
ABS
(
atoms
%
llo
(
j
,
n
))
.EQ.
atoms
%
lda_u
(
i
)
%
l
)
.AND.
(
.NOT.
atoms
%
l_dulo
(
j
,
n
))
)
&
WRITE
(
*
,
*
)
'LO and LDA+U for same l not implemented'
END
DO
END
IF
END
DO
IF
(
atoms
%
n_u
.GT.
0
)
THEN
IF
(
input
%
secvar
)
CALL
juDFT_error
(
"LDA+U and sevcar not implemented"
,
calledby
=
"inped"
)
IF
(
input
%
isec1
<
input
%
itmax
)
CALL
juDFT_error
(
"LDA+U and Wu not implemented"
,
calledby
=
"inped"
)
...
...
io/r_inpXML.F90
View file @
ab6dd87f
...
...
@@ -148,7 +148,7 @@ SUBROUTINE r_inpXML(&
INTEGER
::
latticeDef
,
symmetryDef
,
nop48
,
firstAtomOfType
,
errorStatus
INTEGER
::
loEDeriv
,
ntp1
,
ios
,
ntst
,
jrc
,
minNeigd
,
providedCoreStates
,
providedStates
INTEGER
::
nv
,
nv2
,
kq1
,
kq2
,
kq3
,
nprncTemp
,
kappaTemp
INTEGER
::
ldau_l
,
numVac
INTEGER
::
ldau_l
(
4
),
numVac
,
numU
INTEGER
::
speciesEParams
(
0
:
3
)
INTEGER
::
mrotTemp
(
3
,
3
,
48
)
REAL
::
tauTemp
(
3
,
48
)
...
...
@@ -156,9 +156,9 @@ SUBROUTINE r_inpXML(&
LOGICAL
::
flipSpin
,
l_eV
,
invSym
,
l_qfix
,
relaxX
,
relaxY
,
relaxZ
,
l_gga
,
l_kpts
LOGICAL
::
l_vca
,
coreConfigPresent
,
l_enpara
,
l_orbcomp
REAL
::
magMom
,
radius
,
logIncrement
,
qsc
(
3
),
latticeScale
,
dr
REAL
::
aTemp
,
zp
,
rmtmax
,
sumWeight
,
ldau_u
,
ldau_j
,
tempReal
REAL
::
aTemp
,
zp
,
rmtmax
,
sumWeight
,
ldau_u
(
4
),
ldau_j
(
4
)
,
tempReal
REAL
::
weightScale
,
eParamUp
,
eParamDown
LOGICAL
::
l_amf
LOGICAL
::
l_amf
(
4
)
REAL
,
PARAMETER
::
boltzmannConst
=
3.1668114e-6
! value is given in Hartree/Kelvin
...
...
@@ -260,7 +260,7 @@ SUBROUTINE r_inpXML(&
ALLOCATE
(
atoms
%
lnonsph
(
atoms
%
ntype
))
ALLOCATE
(
atoms
%
nflip
(
atoms
%
ntype
))
ALLOCATE
(
atoms
%
l_geo
(
atoms
%
ntype
))
ALLOCATE
(
atoms
%
lda_u
(
atoms
%
ntype
))
ALLOCATE
(
atoms
%
lda_u
(
4
*
atoms
%
ntype
))
ALLOCATE
(
atoms
%
bmu
(
atoms
%
ntype
))
ALLOCATE
(
atoms
%
relax
(
3
,
atoms
%
ntype
))
ALLOCATE
(
atoms
%
neq
(
atoms
%
ntype
))
...
...
@@ -1264,6 +1264,7 @@ SUBROUTINE r_inpXML(&
atoms
%
numStatesProvided
=
0
atoms
%
lapw_l
(:)
=
-1
atoms
%
n_u
=
0
DO
iSpecies
=
1
,
numSpecies
! Attributes of species
...
...
@@ -1288,20 +1289,17 @@ SUBROUTINE r_inpXML(&
lmaxAPW
=
evaluateFirstIntOnly
(
xmlGetAttributeValue
(
TRIM
(
ADJUSTL
(
xPathA
))//
'/atomicCutoffs/@lmaxAPW'
))
END
IF
numberNodes
=
xmlGetNumberOfNodes
(
TRIM
(
ADJUSTL
(
xPathA
))//
'/ldaU'
)
numU
=
xmlGetNumberOfNodes
(
TRIM
(
ADJUSTL
(
xPathA
))//
'/ldaU'
)
IF
(
numU
.GT.
4
)
CALL
juDFT_error
(
"Too many U parameters provided for a certain species (maximum is 4)."
,
calledby
=
"r_inpXML"
)
ldau_l
=
-1
ldau_u
=
0.0
ldau_j
=
0.0
l_amf
=
.FALSE.
DO
i
=
1
,
numberNodes
IF
(
i
.GT.
1
)
THEN
WRITE
(
*
,
*
)
'Not yet implemented:'
STOP
'ERROR: More than 1 U parameter provided for a certain species.'
END
IF
ldau_l
=
evaluateFirstIntOnly
(
xmlGetAttributeValue
(
TRIM
(
ADJUSTL
(
xPathA
))//
'/ldaU/@l'
))
ldau_u
=
evaluateFirstOnly
(
xmlGetAttributeValue
(
TRIM
(
ADJUSTL
(
xPathA
))//
'/ldaU/@U'
))
ldau_j
=
evaluateFirstOnly
(
xmlGetAttributeValue
(
TRIM
(
ADJUSTL
(
xPathA
))//
'/ldaU/@J'
))
l_amf
=
evaluateFirstBoolOnly
(
xmlGetAttributeValue
(
TRIM
(
ADJUSTL
(
xPathA
))//
'/ldaU/@l_amf'
))
DO
i
=
1
,
numU
ldau_l
(
i
)
=
evaluateFirstIntOnly
(
xmlGetAttributeValue
(
TRIM
(
ADJUSTL
(
xPathA
))//
'/ldaU/@l'
))
ldau_u
(
i
)
=
evaluateFirstOnly
(
xmlGetAttributeValue
(
TRIM
(
ADJUSTL
(
xPathA
))//
'/ldaU/@U'
))
ldau_j
(
i
)
=
evaluateFirstOnly
(
xmlGetAttributeValue
(
TRIM
(
ADJUSTL
(
xPathA
))//
'/ldaU/@J'
))
l_amf
(
i
)
=
evaluateFirstBoolOnly
(
xmlGetAttributeValue
(
TRIM
(
ADJUSTL
(
xPathA
))//
'/ldaU/@l_amf'
))
END
DO
speciesNLO
(
iSpecies
)
=
0
...
...
@@ -1345,10 +1343,14 @@ SUBROUTINE r_inpXML(&
atoms
%
nflip
(
iType
)
=
0
ENDIF
atoms
%
bmu
(
iType
)
=
magMom
atoms
%
lda_u
(
iType
)
%
l
=
ldau_l
atoms
%
lda_u
(
iType
)
%
u
=
ldau_u
atoms
%
lda_u
(
iType
)
%
j
=
ldau_j
atoms
%
lda_u
(
iType
)
%
l_amf
=
l_amf
DO
i
=
1
,
numU
atoms
%
n_u
=
atoms
%
n_u
+
1
atoms
%
lda_u
(
atoms
%
n_u
)
%
l
=
ldau_l
(
i
)
atoms
%
lda_u
(
atoms
%
n_u
)
%
u
=
ldau_u
(
i
)
atoms
%
lda_u
(
atoms
%
n_u
)
%
j
=
ldau_j
(
i
)
atoms
%
lda_u
(
atoms
%
n_u
)
%
l_amf
=
l_amf
(
i
)
atoms
%
lda_u
(
atoms
%
n_u
)
%
atomType
=
iType
END
DO
atomTypeSpecies
(
iType
)
=
iSpecies
IF
(
speciesRepAtomType
(
iSpecies
)
.EQ.
-1
)
speciesRepAtomType
(
iSpecies
)
=
iType
END
IF
...
...
@@ -1897,20 +1899,16 @@ SUBROUTINE r_inpXML(&
! Check lda+u stuff (from inped)
atoms
%
n_u
=
0
DO
iType
=
1
,
atoms
%
ntype
IF
(
atoms
%
lda_u
(
iType
)
%
l
.GE.
0
)
THEN
atoms
%
n_u
=
atoms
%
n_u
+
1
IF
(
atoms
%
nlo
(
iType
)
.GE.
1
)
THEN
DO
iLLO
=
1
,
atoms
%
nlo
(
iType
)
IF
((
abs
(
atoms
%
llo
(
iLLO
,
iType
))
.EQ.
atoms
%
lda_u
(
iType
)
%
l
)
.AND.
&
.NOT.
atoms
%
l_dulo
(
iLLO
,
iType
))
THEN
WRITE
(
*
,
*
)
'LO and LDA+U for same l not implemented'
END
IF
END
DO
END
IF
DO
i
=
1
,
atoms
%
n_u
n
=
atoms
%
lda_u
(
i
)
%
atomType
IF
(
atoms
%
nlo
(
n
)
.GE.
1
)
THEN
DO
j
=
1
,
atoms
%
nlo
(
n
)
IF
((
ABS
(
atoms
%
llo
(
j
,
n
))
.EQ.
atoms
%
lda_u
(
i
)
%
l
)
.AND.
(
.NOT.
atoms
%
l_dulo
(
j
,
n
))
)
&
WRITE
(
*
,
*
)
'LO and LDA+U for same l not implemented'
END
DO
END
IF
END
DO
IF
(
atoms
%
n_u
.GT.
0
)
THEN
IF
(
input
%
secvar
)
CALL
juDFT_error
(
"LDA+U and sevcar not implemented"
,
calledby
=
"r_inpXML"
)
IF
(
input
%
isec1
<
input
%
itmax
)
CALL
juDFT_error
(
"LDA+U and Wu not implemented"
,
calledby
=
"r_inpXML"
)
...
...
io/rw_inp.f90
View file @
ab6dd87f
...
...
@@ -55,7 +55,7 @@
!+lda+u
REAL
u
,
j
INTEGER
l
INTEGER
l
,
i_u
LOGICAL
l_amf
CHARACTER
(
len
=
3
)
ch_test
NAMELIST
/
ldaU
/
l
,
u
,
j
,
l_amf
...
...
@@ -375,6 +375,7 @@
na
=
0
READ
(
UNIT
=
5
,
FMT
=
7110
,
END
=
99
,
ERR
=
99
)
WRITE
(
6
,
9060
)
atoms
%
n_u
=
0
DO
n
=
1
,
atoms
%
ntype
!
READ
(
UNIT
=
5
,
FMT
=
7140
,
END
=
99
,
ERR
=
99
)
noel
(
n
),
atoms
%
nz
(
n
),&
...
...
@@ -387,16 +388,17 @@
READ
(
UNIT
=
5
,
FMT
=
7180
,
END
=
199
,
ERR
=
199
)
ch_test
7180
FORMAT
(
a3
)
IF
(
ch_test
.EQ.
'&ld'
)
THEN
l
=
0
;
u
=
0.0
;
j
=
0.0
;
l_amf
=
.false.
BACKSPACE
(
5
)
READ
(
5
,
ldaU
)
atoms
%
lda_u
(
n
)
%
l
=
l
;
atoms
%
lda_u
(
n
)
%
u
=
u
;
atoms
%
lda_u
(
n
)
%
j
=
j