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
f6a5ac87
Commit
f6a5ac87
authored
Apr 11, 2018
by
Daniel Wortmann
Browse files
Options
Browse Files
Download
Plain Diff
Merge branch 'develop' of iffgit.fz-juelich.de:fleur/fleur into develop
parents
913ced1e
e99aaa5f
Changes
20
Expand all
Hide whitespace changes
Inline
Side-by-side
Showing
20 changed files
with
705 additions
and
600 deletions
+705
-600
cdn/cdnval.F90
cdn/cdnval.F90
+95
-223
cdn/int_21.f90
cdn/int_21.f90
+27
-13
cdn/int_21lo.f90
cdn/int_21lo.f90
+10
-12
cdn/pwden.F90
cdn/pwden.F90
+3
-3
cdn/qal_21.f90
cdn/qal_21.f90
+9
-11
cdn_mt/abcof.F90
cdn_mt/abcof.F90
+30
-36
cdn_mt/cdnmt.f90
cdn_mt/cdnmt.f90
+37
-57
cdn_mt/rhomt.f90
cdn_mt/rhomt.f90
+12
-19
cdn_mt/rhomt21.f90
cdn_mt/rhomt21.f90
+11
-13
cdn_mt/rhomtlo.f90
cdn_mt/rhomtlo.f90
+10
-14
cdn_mt/rhonmt.f90
cdn_mt/rhonmt.f90
+14
-19
cdn_mt/rhonmt21.f90
cdn_mt/rhonmt21.f90
+9
-12
cdn_mt/rhonmtlo.f90
cdn_mt/rhonmtlo.f90
+15
-17
eigen/rad_ovlp.f90
eigen/rad_ovlp.f90
+1
-1
force/force_a12.f90
force/force_a12.f90
+7
-12
force/force_a21.F90
force/force_a21.F90
+26
-29
force/force_a8.F90
force/force_a8.F90
+12
-15
mpi/mpi_col_den.F90
mpi/mpi_col_den.F90
+58
-75
types/types_cdnval.f90
types/types_cdnval.f90
+319
-1
types/types_misc.F90
types/types_misc.F90
+0
-18
No files found.
cdn/cdnval.F90
View file @
f6a5ac87
This diff is collapsed.
Click to expand it.
cdn/int_21.f90
View file @
f6a5ac87
...
...
@@ -8,38 +8,52 @@ MODULE m_int21
!
!-----------------------------------------------------------
CONTAINS
SUBROUTINE
int_21
(
f
,
g
,
atoms
,
ityp
,
l
,
uun21
,
udn21
,
dun21
,
ddn21
)
SUBROUTINE
int_21
(
f
,
g
,
atoms
,
ityp
,
l
,
denCoeffsOffdiag
)
USE
m_types
IMPLICIT
NONE
TYPE
(
t_atoms
),
INTENT
(
IN
)
::
atoms
TYPE
(
t_denCoeffsOffdiag
),
INTENT
(
INOUT
)
::
denCoeffsOffdiag
INTEGER
,
INTENT
(
IN
)
::
l
,
ityp
REAL
,
INTENT
(
IN
)
::
f
(:,:,
0
:,:)
!(atoms%jmtd,2,0:atoms%lmaxd,dimension%jspd)
REAL
,
INTENT
(
IN
)
::
g
(:,:,
0
:,:)
!(atoms%jmtd,2,0:atoms%lmaxd,dimension%jspd)
CALL
int_21_arrays
(
f
,
g
,
atoms
,
ityp
,
l
,
denCoeffsOffdiag
%
uu21n
,
denCoeffsOffdiag
%
ud21n
,&
denCoeffsOffdiag
%
du21n
,
denCoeffsOffdiag
%
dd21n
)
END
SUBROUTINE
int_21
SUBROUTINE
int_21_arrays
(
f
,
g
,
atoms
,
ityp
,
l
,
uu21n
,
ud21n
,
du21n
,
dd21n
)
USE
m_intgr
,
ONLY
:
intgr3
USE
m_types
IMPLICIT
NONE
TYPE
(
t_atoms
),
INTENT
(
IN
)
::
atoms
! ..
! .. Scalar Arguments ..
TYPE
(
t_atoms
),
INTENT
(
IN
)
::
atoms
INTEGER
,
INTENT
(
IN
)
::
l
,
ityp
REAL
,
INTENT
(
OUT
)::
uun21
,
udn21
,
dun21
,
ddn21
! ... Array Arguments
REAL
,
INTENT
(
IN
)
::
f
(:,:,
0
:,:)
!(atoms%jmtd,2,0:atoms%lmaxd,dimension%jspd)
REAL
,
INTENT
(
IN
)
::
g
(:,:,
0
:,:)
!(atoms%jmtd,2,0:atoms%lmaxd,dimension%jspd)
! ...local arrays
REAL
uu_tmp
(
atoms
%
jri
(
ityp
)
)
REAL
,
INTENT
(
INOUT
)
::
uu21n
(
0
:
atoms
%
lmaxd
,
atoms
%
ntype
),
ud21n
(
0
:
atoms
%
lmaxd
,
atoms
%
ntype
)
REAL
,
INTENT
(
INOUT
)
::
du21n
(
0
:
atoms
%
lmaxd
,
atoms
%
ntype
),
dd21n
(
0
:
atoms
%
lmaxd
,
atoms
%
ntype
)
REAL
uu_tmp
(
atoms
%
jri
(
ityp
))
uu_tmp
(:
atoms
%
jri
(
ityp
))
=
f
(:
atoms
%
jri
(
ityp
),
1
,
l
,
2
)
*
f
(:
atoms
%
jri
(
ityp
),
1
,
l
,
1
)&
+
f
(:
atoms
%
jri
(
ityp
),
2
,
l
,
2
)
*
f
(:
atoms
%
jri
(
ityp
),
2
,
l
,
1
)
CALL
intgr3
(
uu_tmp
,
atoms
%
rmsh
(:,
ityp
),
atoms
%
dx
(
ityp
),
atoms
%
jri
(
ityp
),
uu
n21
)
CALL
intgr3
(
uu_tmp
,
atoms
%
rmsh
(:,
ityp
),
atoms
%
dx
(
ityp
),
atoms
%
jri
(
ityp
),
uu
21n
(
l
,
ityp
)
)
uu_tmp
(:
atoms
%
jri
(
ityp
))
=
f
(:
atoms
%
jri
(
ityp
),
1
,
l
,
2
)
*
g
(:
atoms
%
jri
(
ityp
),
1
,
l
,
1
)&
+
f
(:
atoms
%
jri
(
ityp
),
2
,
l
,
2
)
*
g
(:
atoms
%
jri
(
ityp
),
2
,
l
,
1
)
CALL
intgr3
(
uu_tmp
,
atoms
%
rmsh
(:,
ityp
),
atoms
%
dx
(
ityp
),
atoms
%
jri
(
ityp
),
ud
n21
)
CALL
intgr3
(
uu_tmp
,
atoms
%
rmsh
(:,
ityp
),
atoms
%
dx
(
ityp
),
atoms
%
jri
(
ityp
),
ud
21n
(
l
,
ityp
)
)
uu_tmp
(:
atoms
%
jri
(
ityp
))
=
g
(:
atoms
%
jri
(
ityp
),
1
,
l
,
2
)
*
f
(:
atoms
%
jri
(
ityp
),
1
,
l
,
1
)&
+
g
(:
atoms
%
jri
(
ityp
),
2
,
l
,
2
)
*
f
(:
atoms
%
jri
(
ityp
),
2
,
l
,
1
)
CALL
intgr3
(
uu_tmp
,
atoms
%
rmsh
(:,
ityp
),
atoms
%
dx
(
ityp
),
atoms
%
jri
(
ityp
),
du
n21
)
CALL
intgr3
(
uu_tmp
,
atoms
%
rmsh
(:,
ityp
),
atoms
%
dx
(
ityp
),
atoms
%
jri
(
ityp
),
du
21n
(
l
,
ityp
)
)
uu_tmp
(:
atoms
%
jri
(
ityp
))
=
g
(:
atoms
%
jri
(
ityp
),
1
,
l
,
2
)
*
g
(:
atoms
%
jri
(
ityp
),
1
,
l
,
1
)&
+
g
(:
atoms
%
jri
(
ityp
),
2
,
l
,
2
)
*
g
(:
atoms
%
jri
(
ityp
),
2
,
l
,
1
)
CALL
intgr3
(
uu_tmp
,
atoms
%
rmsh
(:,
ityp
),
atoms
%
dx
(
ityp
),
atoms
%
jri
(
ityp
),
dd
n21
)
CALL
intgr3
(
uu_tmp
,
atoms
%
rmsh
(:,
ityp
),
atoms
%
dx
(
ityp
),
atoms
%
jri
(
ityp
),
dd
21n
(
l
,
ityp
)
)
END
SUBROUTINE
int_21
END
SUBROUTINE
int_21
_arrays
END
MODULE
m_int21
cdn/int_21lo.f90
View file @
f6a5ac87
...
...
@@ -6,17 +6,18 @@ MODULE m_int21lo
! spins (s).
! Output is ..n21(l,itype), where .. is a combination of (u,d) and
! ulo dependent on the (f,g) combination used. Also ..n12 and
! uloulop
n21
are calculated.
! uloulop
21n
are calculated.
!
!-----------------------------------------------------------
CONTAINS
SUBROUTINE
int_21lo
(
f
,
g
,
atoms
,
n
,
flo
,
ilo
,
uulon21
,
dulon21
,
uulon12
,
dulon12
,
uloulopn21
)
SUBROUTINE
int_21lo
(
f
,
g
,
atoms
,
n
,
flo
,
ilo
,
denCoeffsOffdiag
)
USE
m_intgr
,
ONLY
:
intgr3
USE
m_types
USE
m_types
IMPLICIT
NONE
TYPE
(
t_atoms
),
INTENT
(
IN
)
::
atoms
TYPE
(
t_atoms
),
INTENT
(
IN
)
::
atoms
TYPE
(
t_denCoeffsOffdiag
),
INTENT
(
INOUT
)
::
denCoeffsOffdiag
! ..
! .. Scalar Arguments ..
INTEGER
,
INTENT
(
IN
)
::
ilo
,
n
...
...
@@ -24,9 +25,6 @@ CONTAINS
REAL
,
INTENT
(
IN
)
::
f
(:,:,
0
:,:)
!(atoms%jmtd,2,0:atoms%lmaxd,dimension%jspd)
REAL
,
INTENT
(
IN
)
::
g
(:,:,
0
:,:)
!(atoms%jmtd,2,0:atoms%lmaxd,dimension%jspd)
REAL
,
INTENT
(
IN
)
::
flo
(:,:,:,:)
!(atoms%jmtd,2,atoms%nlod,dimension%jspd)
REAL
,
INTENT
(
OUT
)::
uulon21
,
uulon12
REAL
,
INTENT
(
OUT
)::
dulon21
,
dulon12
REAL
,
INTENT
(
OUT
)::
uloulopn21
(
atoms
%
nlod
,
atoms
%
nlod
)
! ...local scalars
INTEGER
iri
,
l
,
lp
,
ilop
...
...
@@ -40,22 +38,22 @@ CONTAINS
DO
iri
=
1
,
atoms
%
jri
(
n
)
uu_tmp
(
iri
)
=
f
(
iri
,
1
,
l
,
2
)
*
flo
(
iri
,
1
,
ilo
,
1
)
+
f
(
iri
,
2
,
l
,
2
)
*
flo
(
iri
,
2
,
ilo
,
1
)
ENDDO
CALL
intgr3
(
uu_tmp
,
atoms
%
rmsh
(:,
n
),
atoms
%
dx
(
n
),
atoms
%
jri
(
n
),
uulon21
)
CALL
intgr3
(
uu_tmp
,
atoms
%
rmsh
(:,
n
),
atoms
%
dx
(
n
),
atoms
%
jri
(
n
),
denCoeffsOffdiag
%
uulo21n
(
ilo
,
n
)
)
DO
iri
=
1
,
atoms
%
jri
(
n
)
uu_tmp
(
iri
)
=
f
(
iri
,
1
,
l
,
1
)
*
flo
(
iri
,
1
,
ilo
,
2
)
+
f
(
iri
,
2
,
l
,
1
)
*
flo
(
iri
,
2
,
ilo
,
2
)
ENDDO
CALL
intgr3
(
uu_tmp
,
atoms
%
rmsh
(:,
n
),
atoms
%
dx
(
n
),
atoms
%
jri
(
n
),
uulon12
)
CALL
intgr3
(
uu_tmp
,
atoms
%
rmsh
(:,
n
),
atoms
%
dx
(
n
),
atoms
%
jri
(
n
),
denCoeffsOffdiag
%
ulou21n
(
ilo
,
n
)
)
!
! --> norm of product of du and ulo:
!
DO
iri
=
1
,
atoms
%
jri
(
n
)
uu_tmp
(
iri
)
=
g
(
iri
,
1
,
l
,
2
)
*
flo
(
iri
,
1
,
ilo
,
1
)
+
g
(
iri
,
2
,
l
,
2
)
*
flo
(
iri
,
2
,
ilo
,
1
)
ENDDO
CALL
intgr3
(
uu_tmp
,
atoms
%
rmsh
(:,
n
),
atoms
%
dx
(
n
),
atoms
%
jri
(
n
),
d
ulon21
)
CALL
intgr3
(
uu_tmp
,
atoms
%
rmsh
(:,
n
),
atoms
%
dx
(
n
),
atoms
%
jri
(
n
),
d
enCoeffsOffdiag
%
dulo21n
(
ilo
,
n
)
)
DO
iri
=
1
,
atoms
%
jri
(
n
)
uu_tmp
(
iri
)
=
g
(
iri
,
1
,
l
,
1
)
*
flo
(
iri
,
1
,
ilo
,
2
)
+
g
(
iri
,
2
,
l
,
1
)
*
flo
(
iri
,
2
,
ilo
,
2
)
ENDDO
CALL
intgr3
(
uu_tmp
,
atoms
%
rmsh
(:,
n
),
atoms
%
dx
(
n
),
atoms
%
jri
(
n
),
d
ulon12
)
CALL
intgr3
(
uu_tmp
,
atoms
%
rmsh
(:,
n
),
atoms
%
dx
(
n
),
atoms
%
jri
(
n
),
d
enCoeffsOffdiag
%
ulod21n
(
ilo
,
n
)
)
!
! --> norm of product of ulo and ulo':
!
...
...
@@ -65,10 +63,10 @@ CONTAINS
DO
iri
=
1
,
atoms
%
jri
(
n
)
uu_tmp
(
iri
)
=
flo
(
iri
,
1
,
ilo
,
2
)
*
flo
(
iri
,
1
,
ilop
,
1
)
+
flo
(
iri
,
2
,
ilo
,
2
)
*
flo
(
iri
,
2
,
ilop
,
1
)
ENDDO
CALL
intgr3
(
uu_tmp
,
atoms
%
rmsh
(:,
n
),
atoms
%
dx
(
n
),
atoms
%
jri
(
n
),
uloulopn21
(
ilo
,
ilop
))
CALL
intgr3
(
uu_tmp
,
atoms
%
rmsh
(:,
n
),
atoms
%
dx
(
n
),
atoms
%
jri
(
n
),
denCoeffsOffdiag
%
uloulop21n
(
ilo
,
ilop
,
n
))
ELSE
uloulopn21
(
ilo
,
ilop
)
=
0.0
denCoeffsOffdiag
%
uloulop21n
(
ilo
,
ilop
,
n
)
=
0.0
ENDIF
ENDDO
...
...
cdn/pwden.F90
View file @
f6a5ac87
...
...
@@ -7,7 +7,7 @@
MODULE
m_pwden
CONTAINS
SUBROUTINE
pwden
(
stars
,
kpts
,
banddos
,
oneD
,
input
,
mpi
,
noco
,
cell
,
atoms
,
sym
,
&
ikpt
,
jspin
,
lapw
,
ne
,
we
,
eig
,
den
,
qis
,
force
s
,
f_b8
,
zMat
)
ikpt
,
jspin
,
lapw
,
ne
,
we
,
eig
,
den
,
qis
,
result
s
,
f_b8
,
zMat
)
!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
! In this subroutine the star function expansion coefficients of
! the plane wave charge density is determined.
...
...
@@ -93,6 +93,7 @@ CONTAINS
TYPE
(
t_atoms
),
INTENT
(
IN
)
::
atoms
TYPE
(
t_zMat
),
INTENT
(
IN
)
::
zMat
TYPE
(
t_potden
),
INTENT
(
INOUT
)
::
den
TYPE
(
t_results
),
INTENT
(
INOUT
)
::
results
REAL
,
INTENT
(
IN
)
::
we
(:)
!(nobd)
REAL
,
INTENT
(
IN
)
::
eig
(:)
!(dimension%neigd)
...
...
@@ -102,7 +103,6 @@ CONTAINS
INTEGER
,
INTENT
(
IN
)
::
ikpt
,
jspin
REAL
,
INTENT
(
OUT
)
::
qis
(:,:,:)
!(dimension%neigd,kpts%nkpt,dimension%jspd)
COMPLEX
,
INTENT
(
INOUT
)
::
f_b8
(
3
,
atoms
%
ntype
)
REAL
,
INTENT
(
INOUT
)
::
forces
(:,:,:)
!(3,atoms%ntype,dimension%jspd)
!
!-----> LOCAL VARIABLES
!
...
...
@@ -650,7 +650,7 @@ CONTAINS
DO
istr
=
1
,
stars
%
ng3_fft
ecwk
(
istr
)
=
scale
*
ecwk
(
istr
)
/
REAL
(
stars
%
nstr
(
istr
)
)
ENDDO
CALL
force_b8
(
atoms
,
ecwk
,
stars
,
sym
,
cell
,
jspin
,
forces
,
f_b8
)
CALL
force_b8
(
atoms
,
ecwk
,
stars
,
sym
,
cell
,
jspin
,
results
%
force
,
f_b8
)
ENDIF
ENDIF
!
...
...
cdn/qal_21.f90
View file @
f6a5ac87
...
...
@@ -5,7 +5,7 @@ MODULE m_qal21
!***********************************************************************
!
CONTAINS
SUBROUTINE
qal_21
(
atoms
,
input
,
noccbd
,
we
,
ccof
,
noco
,
acof
,
bcof
,
mt21
,
lo21
,
uloulopn21
,
qal
,
qmat
)
SUBROUTINE
qal_21
(
atoms
,
input
,
noccbd
,
we
,
ccof
,
noco
,
acof
,
bcof
,
denCoeffsOffdiag
,
qal
,
qmat
)
USE
m_rotdenmat
USE
m_types
...
...
@@ -19,13 +19,11 @@ CONTAINS
! ..
! .. Array Arguments ..
REAL
,
INTENT
(
INout
)
::
we
(
noccbd
),
qal
(
0
:,:,:,:)
!(0:3,atoms%ntype,DIMENSION%neigd,input%jspins)
REAL
,
INTENT
(
IN
)
::
uloulopn21
(
atoms
%
nlod
,
atoms
%
nlod
,
atoms
%
ntype
)
COMPLEX
,
INTENT
(
IN
)
::
ccof
(
-
atoms
%
llod
:
atoms
%
llod
,
noccbd
,
atoms
%
nlod
,
atoms
%
nat
,
input
%
jspins
)
COMPLEX
,
INTENT
(
IN
)
::
acof
(:,
0
:,:,:)
!(noccbd,0:DIMENSION%lmd,atoms%nat,input%jspins)
COMPLEX
,
INTENT
(
IN
)
::
bcof
(:,
0
:,:,:)
!(noccbd,0:DIMENSION%lmd,atoms%nat,input%jspins)
REAL
,
INTENT
(
OUT
)
::
qmat
(
0
:,:,:,:)
!(0:3,atoms%ntype,DIMENSION%neigd,4)
TYPE
(
t_mt21
),
INTENT
(
IN
)
::
mt21
(
0
:
atoms
%
lmaxd
,
atoms
%
ntype
)
TYPE
(
t_lo21
),
INTENT
(
IN
)
::
lo21
(
0
:
atoms
%
lmaxd
,
atoms
%
ntype
)
TYPE
(
t_denCoeffsOffdiag
),
INTENT
(
IN
)
::
denCoeffsOffdiag
! ..
! .. Local Scalars ..
...
...
@@ -67,8 +65,8 @@ CONTAINS
sumab
=
sumab
+
bcof
(
i
,
lm
,
natom
,
1
)
*
CONJG
(
acof
(
i
,
lm
,
natom
,
input
%
jspins
))
ENDDO
atoms_loop
ENDDO
ms
qal21
(
l
,
n
,
i
)
=
sumaa
*
mt21
(
l
,
n
)
%
uun
+
sumbb
*
mt21
(
l
,
n
)
%
ddn
+
&
sumba
*
mt21
(
l
,
n
)
%
dun
+
sumab
*
mt21
(
l
,
n
)
%
udn
qal21
(
l
,
n
,
i
)
=
sumaa
*
denCoeffsOffdiag
%
uu21n
(
l
,
n
)
+
sumbb
*
denCoeffsOffdiag
%
dd21n
(
l
,
n
)
+
&
sumba
*
denCoeffsOffdiag
%
du21n
(
l
,
n
)
+
sumab
*
denCoeffsOffdiag
%
ud21n
(
l
,
n
)
ENDDO
ls
nt1
=
nt1
+
atoms
%
neq
(
n
)
ENDDO
types_loop
...
...
@@ -126,16 +124,16 @@ CONTAINS
l
=
atoms
%
llo
(
lo
,
ntyp
)
DO
i
=
1
,
noccbd
qal21
(
l
,
ntyp
,
i
)
=
qal21
(
l
,
ntyp
,
i
)
+
&
qaclo
(
i
,
lo
,
ntyp
)
*
lo21
(
lo
,
ntyp
)
%
uulon
+
&
qcloa
(
i
,
lo
,
ntyp
)
*
lo21
(
lo
,
ntyp
)
%
uloun
+
&
qclob
(
i
,
lo
,
ntyp
)
*
lo21
(
lo
,
ntyp
)
%
ulodn
+
&
qbclo
(
i
,
lo
,
ntyp
)
*
lo21
(
lo
,
ntyp
)
%
dulon
qaclo
(
i
,
lo
,
ntyp
)
*
denCoeffsOffdiag
%
uulo21n
(
lo
,
ntyp
)
+
&
qcloa
(
i
,
lo
,
ntyp
)
*
denCoeffsOffdiag
%
ulou21n
(
lo
,
ntyp
)
+
&
qclob
(
i
,
lo
,
ntyp
)
*
denCoeffsOffdiag
%
ulod21n
(
lo
,
ntyp
)
+
&
qbclo
(
i
,
lo
,
ntyp
)
*
denCoeffsOffdiag
%
dulo21n
(
lo
,
ntyp
)
END
DO
DO
lop
=
1
,
atoms
%
nlo
(
ntyp
)
IF
(
atoms
%
llo
(
lop
,
ntyp
)
.EQ.
l
)
THEN
DO
i
=
1
,
noccbd
qal21
(
l
,
ntyp
,
i
)
=
qal21
(
l
,
ntyp
,
i
)
+
&
qlo
(
i
,
lop
,
lo
,
ntyp
)
*
uloulopn21
(
lop
,
lo
,
ntyp
)
qlo
(
i
,
lop
,
lo
,
ntyp
)
*
denCoeffsOffdiag
%
uloulop21n
(
lop
,
lo
,
ntyp
)
ENDDO
ENDIF
ENDDO
...
...
cdn_mt/abcof.F90
View file @
f6a5ac87
...
...
@@ -2,7 +2,7 @@ MODULE m_abcof
CONTAINS
SUBROUTINE
abcof
(
input
,
atoms
,
sym
,
cell
,
lapw
,
ne
,
usdus
,&
noco
,
jspin
,
oneD
,
acof
,
bcof
,
ccof
,
zMat
,&
eig
,
acoflo
,
bcoflo
,
e1cof
,
e2cof
,
aveccof
,
bveccof
,
cveccof
)
eig
,
force
)
! ************************************************************
! subroutine constructs the a,b coefficients of the linearized
! m.t. wavefunctions for each band and atom. c.l. fu
...
...
@@ -26,6 +26,7 @@ CONTAINS
TYPE
(
t_cell
),
INTENT
(
IN
)
::
cell
TYPE
(
t_atoms
),
INTENT
(
IN
)
::
atoms
TYPE
(
t_zMat
),
INTENT
(
IN
)
::
zMat
TYPE
(
t_force
),
OPTIONAL
,
INTENT
(
INOUT
)
::
force
! ..
! .. Scalar Arguments ..
INTEGER
,
INTENT
(
IN
)
::
ne
...
...
@@ -36,13 +37,6 @@ CONTAINS
COMPLEX
,
INTENT
(
OUT
)
::
bcof
(:,
0
:,:)
!(nobd,0:dimension%lmd,atoms%nat)
COMPLEX
,
INTENT
(
OUT
)
::
ccof
(
-
atoms
%
llod
:,:,:,:)
!(-llod:llod,nobd,atoms%nlod,atoms%nat)
REAL
,
OPTIONAL
,
INTENT
(
IN
)
::
eig
(:)
!(dimension%neigd)
COMPLEX
,
OPTIONAL
,
INTENT
(
OUT
)
::
acoflo
(
-
atoms
%
llod
:,:,:,:)
COMPLEX
,
OPTIONAL
,
INTENT
(
OUT
)
::
bcoflo
(
-
atoms
%
llod
:,:,:,:)
COMPLEX
,
OPTIONAL
,
INTENT
(
OUT
)
::
e1cof
(:,
0
:,:)
!(nobd,0:dimension%lmd,atoms%nat)
COMPLEX
,
OPTIONAL
,
INTENT
(
OUT
)
::
e2cof
(:,
0
:,:)
!(nobd,0:dimension%lmd,atoms%nat)
COMPLEX
,
OPTIONAL
,
INTENT
(
OUT
)
::
aveccof
(:,:,
0
:,:)
!(3,nobd,0:dimension%lmd,atoms%nat)
COMPLEX
,
OPTIONAL
,
INTENT
(
OUT
)
::
bveccof
(:,:,
0
:,:)
!(3,nobd,0:dimension%lmd,atoms%nat)
COMPLEX
,
OPTIONAL
,
INTENT
(
OUT
)
::
cveccof
(:,
-
atoms
%
llod
:,:,:,:)
! ..
! .. Local Scalars ..
COMPLEX
cexp
,
phase
,
c_0
,
c_1
,
c_2
,
ci
...
...
@@ -75,13 +69,13 @@ CONTAINS
bcof
(:,:,:)
=
CMPLX
(
0.0
,
0.0
)
ccof
(:,:,:,:)
=
CMPLX
(
0.0
,
0.0
)
IF
(
PRESENT
(
eig
))
THEN
acoflo
(:,:,:,:)
=
CMPLX
(
0.0
,
0.0
)
bcoflo
(:,:,:,:)
=
CMPLX
(
0.0
,
0.0
)
e1cof
(:,:,:)
=
CMPLX
(
0.0
,
0.0
)
e2cof
(:,:,:)
=
CMPLX
(
0.0
,
0.0
)
aveccof
(:,:,:,:)
=
CMPLX
(
0.0
,
0.0
)
bveccof
(:,:,:,:)
=
CMPLX
(
0.0
,
0.0
)
cveccof
(:,:,:,:,:)
=
CMPLX
(
0.0
,
0.0
)
force
%
acoflo
=
CMPLX
(
0.0
,
0.0
)
force
%
bcoflo
=
CMPLX
(
0.0
,
0.0
)
force
%
e1cof
=
CMPLX
(
0.0
,
0.0
)
force
%
e2cof
=
CMPLX
(
0.0
,
0.0
)
force
%
aveccof
=
CMPLX
(
0.0
,
0.0
)
force
%
bveccof
=
CMPLX
(
0.0
,
0.0
)
force
%
cveccof
=
CMPLX
(
0.0
,
0.0
)
END
IF
! ..
!+APW_LO
...
...
@@ -121,7 +115,7 @@ CONTAINS
!$OMP& jspin,qss,&
!$OMP& apw,const,&
!$OMP& nbasf0,enough,&
!$OMP& acof,bcof,ccof,
e1cof,e2cof,acoflo,bcoflo,aveccof,bveccof,cveccof
)
!$OMP& acof,bcof,ccof,
force
)
DO
n
=
1
,
atoms
%
ntype
CALL
setabc1lo
(
atoms
,
n
,
usdus
,
jspin
,
alo1
,
blo1
,
clo1
)
...
...
@@ -246,18 +240,18 @@ CONTAINS
IF
((
atoms
%
l_geo
(
n
))
.AND.
(
PRESENT
(
eig
)))
THEN
IF
(
zmat
%
l_real
)
THEN
e1cof
(:
ne
,
lm
,
natom
)
=
e1cof
(:
ne
,
lm
,
natom
)
+
c_1
*
work_r
(:
ne
)
*
s2h_e
(:
ne
)
e2cof
(:
ne
,
lm
,
natom
)
=
e2cof
(:
ne
,
lm
,
natom
)
+
c_2
*
work_r
(:
ne
)
*
s2h_e
(:
ne
)
force
%
e1cof
(:
ne
,
lm
,
natom
)
=
force
%
e1cof
(:
ne
,
lm
,
natom
)
+
c_1
*
work_r
(:
ne
)
*
s2h_e
(:
ne
)
force
%
e2cof
(:
ne
,
lm
,
natom
)
=
force
%
e2cof
(:
ne
,
lm
,
natom
)
+
c_2
*
work_r
(:
ne
)
*
s2h_e
(:
ne
)
DO
i
=
1
,
3
aveccof
(
i
,:
ne
,
lm
,
natom
)
=
aveccof
(
i
,:
ne
,
lm
,
natom
)
+
c_1
*
work_r
(:
ne
)
*
fgp
(
i
)
bveccof
(
i
,:
ne
,
lm
,
natom
)
=
bveccof
(
i
,:
ne
,
lm
,
natom
)
+
c_2
*
work_r
(:
ne
)
*
fgp
(
i
)
force
%
aveccof
(
i
,:
ne
,
lm
,
natom
)
=
force
%
aveccof
(
i
,:
ne
,
lm
,
natom
)
+
c_1
*
work_r
(:
ne
)
*
fgp
(
i
)
force
%
bveccof
(
i
,:
ne
,
lm
,
natom
)
=
force
%
bveccof
(
i
,:
ne
,
lm
,
natom
)
+
c_2
*
work_r
(:
ne
)
*
fgp
(
i
)
END
DO
ELSE
e1cof
(:
ne
,
lm
,
natom
)
=
e1cof
(:
ne
,
lm
,
natom
)
+
c_1
*
work_c
(:
ne
)
*
s2h_e
(:
ne
)
e2cof
(:
ne
,
lm
,
natom
)
=
e2cof
(:
ne
,
lm
,
natom
)
+
c_2
*
work_c
(:
ne
)
*
s2h_e
(:
ne
)
force
%
e1cof
(:
ne
,
lm
,
natom
)
=
force
%
e1cof
(:
ne
,
lm
,
natom
)
+
c_1
*
work_c
(:
ne
)
*
s2h_e
(:
ne
)
force
%
e2cof
(:
ne
,
lm
,
natom
)
=
force
%
e2cof
(:
ne
,
lm
,
natom
)
+
c_2
*
work_c
(:
ne
)
*
s2h_e
(:
ne
)
DO
i
=
1
,
3
aveccof
(
i
,:
ne
,
lm
,
natom
)
=
aveccof
(
i
,:
ne
,
lm
,
natom
)
+
c_1
*
work_c
(:
ne
)
*
fgp
(
i
)
bveccof
(
i
,:
ne
,
lm
,
natom
)
=
bveccof
(
i
,:
ne
,
lm
,
natom
)
+
c_2
*
work_c
(:
ne
)
*
fgp
(
i
)
force
%
aveccof
(
i
,:
ne
,
lm
,
natom
)
=
force
%
aveccof
(
i
,:
ne
,
lm
,
natom
)
+
c_1
*
work_c
(:
ne
)
*
fgp
(
i
)
force
%
bveccof
(
i
,:
ne
,
lm
,
natom
)
=
force
%
bveccof
(
i
,:
ne
,
lm
,
natom
)
+
c_2
*
work_c
(:
ne
)
*
fgp
(
i
)
END
DO
END
IF
ENDIF
...
...
@@ -272,11 +266,11 @@ CONTAINS
CALL
CPP_BLAS_caxpy
(
ne
,
c_1
,
work_c
,
1
,
acof
(
1
,
lmp
,
jatom
),
1
)
CALL
CPP_BLAS_caxpy
(
ne
,
c_2
,
work_c
,
1
,
bcof
(
1
,
lmp
,
jatom
),
1
)
IF
((
atoms
%
l_geo
(
n
))
.AND.
(
PRESENT
(
eig
)))
THEN
CALL
CPP_BLAS_caxpy
(
ne
,
c_1
,
work_c
*
s2h_e
,
1
,
e1cof
(
1
,
lmp
,
jatom
),
1
)
CALL
CPP_BLAS_caxpy
(
ne
,
c_2
,
work_c
*
s2h_e
,
1
,
e2cof
(
1
,
lmp
,
jatom
),
1
)
CALL
CPP_BLAS_caxpy
(
ne
,
c_1
,
work_c
*
s2h_e
,
1
,
force
%
e1cof
(
1
,
lmp
,
jatom
),
1
)
CALL
CPP_BLAS_caxpy
(
ne
,
c_2
,
work_c
*
s2h_e
,
1
,
force
%
e2cof
(
1
,
lmp
,
jatom
),
1
)
DO
i
=
1
,
3
CALL
CPP_BLAS_caxpy
(
ne
,
c_1
,
work_c
*
fgp
(
i
),
1
,
aveccof
(
i
,
1
,
lmp
,
jatom
),
3
)
CALL
CPP_BLAS_caxpy
(
ne
,
c_2
,
work_c
*
fgp
(
i
),
1
,
bveccof
(
i
,
1
,
lmp
,
jatom
),
3
)
CALL
CPP_BLAS_caxpy
(
ne
,
c_1
,
work_c
*
fgp
(
i
),
1
,
force
%
aveccof
(
i
,
1
,
lmp
,
jatom
),
3
)
CALL
CPP_BLAS_caxpy
(
ne
,
c_2
,
work_c
*
fgp
(
i
),
1
,
force
%
bveccof
(
i
,
1
,
lmp
,
jatom
),
3
)
END
DO
END
IF
ENDIF
...
...
@@ -288,7 +282,7 @@ CONTAINS
IF
(
k
==
lapw
%
kvec
(
nkvec
,
lo
,
natom
))
THEN
!check if this k-vector has LO attached
CALL
abclocdn
(
atoms
,
sym
,
noco
,
lapw
,
cell
,
ccchi
(:,
jspin
),
iintsp
,
phase
,
ylm
,&
n
,
natom
,
k
,
nkvec
,
lo
,
ne
,
alo1
,
blo1
,
clo1
,
acof
,
bcof
,
ccof
,
zMat
,&
fgp
,
acoflo
,
bcoflo
,
aveccof
,
bveccof
,
cveccof
)
fgp
,
force
%
acoflo
,
force
%
bcoflo
,
force
%
aveccof
,
force
%
bveccof
,
force
%
cveccof
)
ENDIF
ENDDO
END
DO
...
...
@@ -334,10 +328,10 @@ CONTAINS
DO
ie
=
1
,
ne
ccof
(
m
,
ie
,
ilo
,
jatom
)
=
inv_f
*
cexp
*
CONJG
(
ccof
(
-
m
,
ie
,
ilo
,
iatom
))
IF
(
PRESENT
(
eig
))
THEN
acoflo
(
m
,
ie
,
ilo
,
jatom
)
=
inv_f
*
cexp
*
CONJG
(
acoflo
(
-
m
,
ie
,
ilo
,
iatom
))
bcoflo
(
m
,
ie
,
ilo
,
jatom
)
=
inv_f
*
cexp
*
CONJG
(
bcoflo
(
-
m
,
ie
,
ilo
,
iatom
))
force
%
acoflo
(
m
,
ie
,
ilo
,
jatom
)
=
inv_f
*
cexp
*
CONJG
(
force
%
acoflo
(
-
m
,
ie
,
ilo
,
iatom
))
force
%
bcoflo
(
m
,
ie
,
ilo
,
jatom
)
=
inv_f
*
cexp
*
CONJG
(
force
%
bcoflo
(
-
m
,
ie
,
ilo
,
iatom
))
DO
i
=
1
,
3
cveccof
(
i
,
m
,
ie
,
ilo
,
jatom
)
=
-
inv_f
*
cexp
*
CONJG
(
cveccof
(
i
,
-
m
,
ie
,
ilo
,
iatom
))
force
%
cveccof
(
i
,
m
,
ie
,
ilo
,
jatom
)
=
-
inv_f
*
cexp
*
CONJG
(
force
%
cveccof
(
i
,
-
m
,
ie
,
ilo
,
iatom
))
END
DO
END
IF
ENDDO
...
...
@@ -355,11 +349,11 @@ CONTAINS
END
DO
IF
((
atoms
%
l_geo
(
n
))
.AND.
(
PRESENT
(
eig
)))
THEN
DO
ie
=
1
,
ne
e1cof
(
ie
,
lm
,
jatom
)
=
inv_f
*
cexp
*
CONJG
(
e1cof
(
ie
,
lmp
,
iatom
))
e2cof
(
ie
,
lm
,
jatom
)
=
inv_f
*
cexp
*
CONJG
(
e2cof
(
ie
,
lmp
,
iatom
))
force
%
e1cof
(
ie
,
lm
,
jatom
)
=
inv_f
*
cexp
*
CONJG
(
force
%
e1cof
(
ie
,
lmp
,
iatom
))
force
%
e2cof
(
ie
,
lm
,
jatom
)
=
inv_f
*
cexp
*
CONJG
(
force
%
e2cof
(
ie
,
lmp
,
iatom
))
DO
i
=
1
,
3
aveccof
(
i
,
ie
,
lm
,
jatom
)
=
-
inv_f
*
cexp
*
CONJG
(
aveccof
(
i
,
ie
,
lmp
,
iatom
))
bveccof
(
i
,
ie
,
lm
,
jatom
)
=
-
inv_f
*
cexp
*
CONJG
(
bveccof
(
i
,
ie
,
lmp
,
iatom
))
force
%
aveccof
(
i
,
ie
,
lm
,
jatom
)
=
-
inv_f
*
cexp
*
CONJG
(
force
%
aveccof
(
i
,
ie
,
lmp
,
iatom
))
force
%
bveccof
(
i
,
ie
,
lm
,
jatom
)
=
-
inv_f
*
cexp
*
CONJG
(
force
%
bveccof
(
i
,
ie
,
lmp
,
iatom
))
END
DO
END
DO
END
IF
...
...
cdn_mt/cdnmt.f90
View file @
f6a5ac87
...
...
@@ -11,9 +11,9 @@ MODULE m_cdnmt
!***********************************************************************
CONTAINS
SUBROUTINE
cdnmt
(
jspd
,
atoms
,
sphhar
,
llpd
,
noco
,
l_fmpl
,
jsp_start
,
jsp_end
,
epar
,&
ello
,
vr
,
uu
,
du
,
dd
,
uunmt
,
udnmt
,
dunmt
,
ddnmt
,
usdus
,
aclo
,
bclo
,
cclo
,&
acnmt
,
bcnmt
,
ccnmt
,
orb
,
mt21
,
lo21
,
uloulopn21
,
uloulop21
,
uunmt21
,&
ddnmt21
,
udnmt21
,
dunmt21
,
chmom
,
clmom
,
qa21
,
rho
)
ello
,
vr
,
denCoeffs
,
usdus
,&
orb
,
denCoeffsOffdiag
,&
chmom
,
clmom
,
qa21
,
rho
)
use
m_constants
,
only
:
sfp_const
USE
m_rhosphnlo
USE
m_radfun
...
...
@@ -35,31 +35,12 @@ CONTAINS
REAL
,
INTENT
(
IN
)
::
epar
(
0
:
atoms
%
lmaxd
,
atoms
%
ntype
,
jspd
)
REAL
,
INTENT
(
IN
)
::
vr
(
atoms
%
jmtd
,
atoms
%
ntype
,
jspd
)
REAL
,
INTENT
(
IN
)
::
ello
(
atoms
%
nlod
,
atoms
%
ntype
,
jspd
)
REAL
,
INTENT
(
IN
)
::
aclo
(
atoms
%
nlod
,
atoms
%
ntype
,
jsp_start
:
jsp_end
)
REAL
,
INTENT
(
IN
)
::
bclo
(
atoms
%
nlod
,
atoms
%
ntype
,
jsp_start
:
jsp_end
)
REAL
,
INTENT
(
IN
)
::
cclo
(
atoms
%
nlod
,
atoms
%
nlod
,
atoms
%
ntype
,
jsp_start
:
jsp_end
)
REAL
,
INTENT
(
IN
)
::
acnmt
(
0
:
atoms
%
lmaxd
,
atoms
%
nlod
,
sphhar
%
nlhd
,
atoms
%
ntype
,
jsp_start
:
jsp_end
)
REAL
,
INTENT
(
IN
)
::
bcnmt
(
0
:
atoms
%
lmaxd
,
atoms
%
nlod
,
sphhar
%
nlhd
,
atoms
%
ntype
,
jsp_start
:
jsp_end
)
REAL
,
INTENT
(
IN
)
::
ccnmt
(
atoms
%
nlod
,
atoms
%
nlod
,
sphhar
%
nlhd
,
atoms
%
ntype
,
jsp_start
:
jsp_end
)
REAL
,
INTENT
(
IN
)
::
uu
(
0
:
atoms
%
lmaxd
,
atoms
%
ntype
,
jsp_start
:
jsp_end
)
REAL
,
INTENT
(
IN
)
::
du
(
0
:
atoms
%
lmaxd
,
atoms
%
ntype
,
jsp_start
:
jsp_end
)
REAL
,
INTENT
(
IN
)
::
dd
(
0
:
atoms
%
lmaxd
,
atoms
%
ntype
,
jsp_start
:
jsp_end
)
REAL
,
INTENT
(
IN
)
::
uunmt
(
0
:
llpd
,
sphhar
%
nlhd
,
atoms
%
ntype
,
jsp_start
:
jsp_end
)
REAL
,
INTENT
(
IN
)
::
udnmt
(
0
:
llpd
,
sphhar
%
nlhd
,
atoms
%
ntype
,
jsp_start
:
jsp_end
)
REAL
,
INTENT
(
IN
)
::
dunmt
(
0
:
llpd
,
sphhar
%
nlhd
,
atoms
%
ntype
,
jsp_start
:
jsp_end
)
REAL
,
INTENT
(
IN
)
::
ddnmt
(
0
:
llpd
,
sphhar
%
nlhd
,
atoms
%
ntype
,
jsp_start
:
jsp_end
)
REAL
,
INTENT
(
IN
)
::
uloulopn21
(
atoms
%
nlod
,
atoms
%
nlod
,
atoms
%
ntype
)
COMPLEX
,
INTENT
(
IN
)
::
uloulop21
(
atoms
%
nlod
,
atoms
%
nlod
,
atoms
%
ntype
)
COMPLEX
,
INTENT
(
IN
)
::
ddnmt21
((
atoms
%
lmaxd
+1
)
**
2
,
sphhar
%
nlhd
,
atoms
%
ntype
)
COMPLEX
,
INTENT
(
IN
)
::
dunmt21
((
atoms
%
lmaxd
+1
)
**
2
,
sphhar
%
nlhd
,
atoms
%
ntype
)
COMPLEX
,
INTENT
(
IN
)
::
udnmt21
((
atoms
%
lmaxd
+1
)
**
2
,
sphhar
%
nlhd
,
atoms
%
ntype
)
COMPLEX
,
INTENT
(
IN
)
::
uunmt21
((
atoms
%
lmaxd
+1
)
**
2
,
sphhar
%
nlhd
,
atoms
%
ntype
)
REAL
,
INTENT
(
OUT
)
::
chmom
(
atoms
%
ntype
,
jspd
),
clmom
(
3
,
atoms
%
ntype
,
jspd
)
REAL
,
INTENT
(
INOUT
)
::
rho
(:,
0
:,:,:)
!(toms%jmtd,0:sphhar%nlhd,atoms%ntype,jspd)
COMPLEX
,
INTENT
(
INOUT
)
::
qa21
(
atoms
%
ntype
)
TYPE
(
t_orb
),
INTENT
(
IN
)
::
orb
TYPE
(
t_
mt21
),
INTENT
(
IN
)
::
mt21
(
0
:
atoms
%
lmaxd
,
atoms
%
ntype
)
TYPE
(
t_
lo21
),
INTENT
(
IN
)
::
lo21
(
atoms
%
nlod
,
atoms
%
ntype
)
TYPE
(
t_orb
),
INTENT
(
IN
)
::
orb
TYPE
(
t_
denCoeffs
),
INTENT
(
IN
)
::
denCoeffs
TYPE
(
t_
denCoeffsOffdiag
),
INTENT
(
IN
)
::
denCoeffsOffdiag
! ..
! .. Local Scalars ..
INTEGER
itype
,
na
,
nd
,
l
,
lp
,
llp
,
lh
,
j
,
ispin
,
noded
,
nodeu
...
...
@@ -89,9 +70,8 @@ CONTAINS
!$OMP PARALLEL DEFAULT(none) &
!$OMP SHARED(usdus,rho,chmom,clmom,qa21,rho21,qmtl) &
!$OMP SHARED(atoms,jsp_start,jsp_end,epar,vr,uu,dd,du,sphhar,ello,aclo,bclo,cclo) &
!$OMP SHARED(acnmt,bcnmt,ccnmt,orb,ddnmt,udnmt,dunmt,uunmt,mt21,lo21,uloulop21)&
!$OMP SHARED(uloulopn21,noco,l_fmpl,uunmt21,ddnmt21,dunmt21,udnmt21,jspd)&
!$OMP SHARED(atoms,jsp_start,jsp_end,epar,vr,denCoeffs,sphhar,ello)&
!$OMP SHARED(orb,noco,l_fmpl,denCoeffsOffdiag,jspd)&
!$OMP PRIVATE(itype,na,ispin,l,f,g,nodeu,noded,wronk,i,j,s,qmtllo,qmtt,nd,lh,lp,llp,cs)
IF
(
noco
%
l_mperp
)
THEN
ALLOCATE
(
f
(
atoms
%
jmtd
,
2
,
0
:
atoms
%
lmaxd
,
jspd
),
g
(
atoms
%
jmtd
,
2
,
0
:
atoms
%
lmaxd
,
jspd
)
)
...
...
@@ -114,9 +94,9 @@ CONTAINS
CALL
radfun
(
l
,
itype
,
ispin
,
epar
(
l
,
itype
,
ispin
),
vr
(
1
,
itype
,
ispin
),
atoms
,&
f
(
1
,
1
,
l
,
ispin
),
g
(
1
,
1
,
l
,
ispin
),
usdus
,
nodeu
,
noded
,
wronk
)
DO
j
=
1
,
atoms
%
jri
(
itype
)
s
=
uu
(
l
,
itype
,
ispin
)
*
(
f
(
j
,
1
,
l
,
ispin
)
*
f
(
j
,
1
,
l
,
ispin
)
+
f
(
j
,
2
,
l
,
ispin
)
*
f
(
j
,
2
,
l
,
ispin
)
)&
+
dd
(
l
,
itype
,
ispin
)
*
(
g
(
j
,
1
,
l
,
ispin
)
*
g
(
j
,
1
,
l
,
ispin
)
+
g
(
j
,
2
,
l
,
ispin
)
*
g
(
j
,
2
,
l
,
ispin
)
)&
+
2
*
du
(
l
,
itype
,
ispin
)
*
(
f
(
j
,
1
,
l
,
ispin
)
*
g
(
j
,
1
,
l
,
ispin
)
+
f
(
j
,
2
,
l
,
ispin
)
*
g
(
j
,
2
,
l
,
ispin
)
)
s
=
denCoeffs
%
uu
(
l
,
itype
,
ispin
)
*
(
f
(
j
,
1
,
l
,
ispin
)
*
f
(
j
,
1
,
l
,
ispin
)
+
f
(
j
,
2
,
l
,
ispin
)
*
f
(
j
,
2
,
l
,
ispin
)
)&
+
d
enCoeffs
%
d
d
(
l
,
itype
,
ispin
)
*
(
g
(
j
,
1
,
l
,
ispin
)
*
g
(
j
,
1
,
l
,
ispin
)
+
g
(
j
,
2
,
l
,
ispin
)
*
g
(
j
,
2
,
l
,
ispin
)
)&
+
2
*
d
enCoeffs
%
d
u
(
l
,
itype
,
ispin
)
*
(
f
(
j
,
1
,
l
,
ispin
)
*
g
(
j
,
1
,
l
,
ispin
)
+
f
(
j
,
2
,
l
,
ispin
)
*
g
(
j
,
2
,
l
,
ispin
)
)
rho
(
j
,
0
,
itype
,
ispin
)
=
rho
(
j
,
0
,
itype
,
ispin
)
+
s
/(
atoms
%
neq
(
itype
)
*
sfp_const
)
ENDDO
ENDDO
...
...
@@ -131,9 +111,9 @@ CONTAINS
CALL
rhosphnlo
(
itype
,
atoms
,
sphhar
,&
usdus
%
uloulopn
(
1
,
1
,
itype
,
ispin
),
usdus
%
dulon
(
1
,
itype
,
ispin
),&
usdus
%
uulon
(
1
,
itype
,
ispin
),
ello
(
1
,
itype
,
ispin
),&
vr
(
1
,
itype
,
ispin
),
aclo
(
1
,
itype
,
ispin
),
bclo
(
1
,
itype
,
ispin
),&
cclo
(
1
,
1
,
itype
,
ispin
),
acnmt
(
0
,
1
,
1
,
itype
,
ispin
),&
bcnmt
(
0
,
1
,
1
,
itype
,
ispin
),
ccnmt
(
1
,
1
,
1
,
itype
,
ispin
),&
vr
(
1
,
itype
,
ispin
),
denCoeffs
%
aclo
(
1
,
itype
,
ispin
),
denCoeffs
%
bclo
(
1
,
itype
,
ispin
),&
denCoeffs
%
cclo
(
1
,
1
,
itype
,
ispin
),
denCoeffs
%
acnmt
(
0
,
1
,
1
,
itype
,
ispin
),&
denCoeffs
%
bcnmt
(
0
,
1
,
1
,
itype
,
ispin
),
denCoeffs
%
ccnmt
(
1
,
1
,
1
,
itype
,
ispin
),&
f
(
1
,
1
,
0
,
ispin
),
g
(
1
,
1
,
0
,
ispin
),&
rho
(:,
0
:,
itype
,
ispin
),
qmtllo
)
...
...
@@ -141,7 +121,7 @@ CONTAINS
!---> l-decomposed density for each atom type
qmtt
=
0.0
DO
l
=
0
,
atoms
%
lmax
(
itype
)
qmtl
(
l
,
ispin
,
itype
)
=
(
uu
(
l
,
itype
,
ispin
)
+
dd
(
l
,
itype
,
ispin
)&
qmtl
(
l
,
ispin
,
itype
)
=
(
denCoeffs
%
uu
(
l
,
itype
,
ispin
)
+
denCoeffs
%
dd
(
l
,
itype
,
ispin
)&
&
*
usdus
%
ddn
(
l
,
itype
,
ispin
)
)/
atoms
%
neq
(
itype
)
+
qmtllo
(
l
)
qmtt
=
qmtt
+
qmtl
(
l
,
ispin
,
itype
)
END
DO
...
...
@@ -162,13 +142,13 @@ CONTAINS
DO
lp
=
0
,
l
llp
=
(
l
*
(
l
+1
))/
2
+
lp
DO
j
=
1
,
atoms
%
jri
(
itype
)
s
=
uunmt
(
llp
,
lh
,
itype
,
ispin
)
*
(
&
s
=
denCoeffs
%
uunmt
(
llp
,
lh
,
itype
,
ispin
)
*
(
&
f
(
j
,
1
,
l
,
ispin
)
*
f
(
j
,
1
,
lp
,
ispin
)
+
f
(
j
,
2
,
l
,
ispin
)
*
f
(
j
,
2
,
lp
,
ispin
)
)&
+
ddnmt
(
llp
,
lh
,
itype
,
ispin
)
*
(
g
(
j
,
1
,
l
,
ispin
)
*
g
(
j
,
1
,
lp
,
ispin
)&
+
d
enCoeffs
%
d
dnmt
(
llp
,
lh
,
itype
,
ispin
)
*
(
g
(
j
,
1
,
l
,
ispin
)
*
g
(
j
,
1
,
lp
,
ispin
)&
+
g
(
j
,
2
,
l
,
ispin
)
*
g
(
j
,
2
,
lp
,
ispin
)
)&
+
udnmt
(
llp
,
lh
,
itype
,
ispin
)
*
(
f
(
j
,
1
,
l
,
ispin
)
*
g
(
j
,
1
,
lp
,
ispin
)&
+
denCoeffs
%
udnmt
(
llp
,
lh
,
itype
,
ispin
)
*
(
f
(
j
,
1
,
l
,
ispin
)
*
g
(
j
,
1
,
lp
,
ispin
)&
+
f
(
j
,
2
,
l
,
ispin
)
*
g
(
j
,
2
,
lp
,
ispin
)
)&
+
dunmt
(
llp
,
lh
,
itype
,
ispin
)
*
(
g
(
j
,
1
,
l
,
ispin
)
*
f
(
j
,
1
,
lp
,
ispin
)&
+
d
enCoeffs
%
d
unmt
(
llp
,
lh
,
itype
,
ispin
)
*
(
g
(
j
,
1
,
l
,
ispin
)
*
f
(
j
,
1
,
lp
,
ispin
)&
+
g
(
j
,
2
,
l
,
ispin
)
*
f
(
j
,
2
,
lp
,
ispin
)
)
rho
(
j
,
lh
,
itype
,
ispin
)
=
rho
(
j
,
lh
,
itype
,
ispin
)
+
s
/
atoms
%
neq
(
itype
)
ENDDO
...
...
@@ -182,22 +162,22 @@ CONTAINS
!---> calculate off-diagonal integrated density
DO
l
=
0
,
atoms
%
lmax
(
itype
)
qa21
(
itype
)
=
qa21
(
itype
)
+
conjg
(&
mt21
(
l
,
itype
)
%
uu
*
mt21
(
l
,
itype
)
%
uun
+
&
mt21
(
l
,
itype
)
%
ud
*
mt21
(
l
,
itype
)
%
udn
+
&
mt21
(
l
,
itype
)
%
du
*
mt21
(
l
,
itype
)
%
dun
+
&
mt21
(
l
,
itype
)
%
dd
*
mt21
(
l
,
itype
)
%
ddn
)/
atoms
%
neq
(
itype
)
denCoeffsOffdiag
%
uu21
(
l
,
itype
)
*
denCoeffsOffdiag
%
uu21n
(
l
,
itype
)
+
&
denCoeffsOffdiag
%
ud21
(
l
,
itype
)
*
denCoeffsOffdiag
%
ud21n
(
l
,
itype
)
+
&
denCoeffsOffdiag
%
du21
(
l
,
itype
)
*
denCoeffsOffdiag
%
du21n
(
l
,
itype
)
+
&
denCoeffsOffdiag
%
dd21
(
l
,
itype
)
*
denCoeffsOffdiag
%
dd21n
(
l
,
itype
)
)/
atoms
%
neq
(
itype
)
ENDDO
DO
ilo
=
1
,
atoms
%
nlo
(
itype
)
qa21
(
itype
)
=
qa21
(
itype
)
+
conjg
(&
lo21
(
ilo
,
itype
)
%
ulou
*
lo21
(
ilo
,
itype
)
%
uloun
+
&
lo21
(
ilo
,
itype
)
%
ulod
*
lo21
(
ilo
,
itype
)
%
ulodn
+
&
lo21
(
ilo
,
itype
)
%
uulo
*
lo21
(
ilo
,
itype
)
%
uulon
+
&
lo21
(
ilo
,
itype
)
%
dulo
*
lo21
(
ilo
,
itype
)
%
dulon
)/&
denCoeffsOffdiag
%
ulou21
(
ilo
,
itype
)
*
denCoeffsOffdiag
%
ulou21n
(
ilo
,
itype
)
+
&
denCoeffsOffdiag
%
ulod21
(
ilo
,
itype
)
*
denCoeffsOffdiag
%
ulod21n
(
ilo
,
itype
)
+
&
denCoeffsOffdiag
%
uulo21
(
ilo
,
itype
)
*
denCoeffsOffdiag
%
uulo21n
(
ilo
,
itype
)
+
&
denCoeffsOffdiag
%
dulo21
(
ilo
,
itype
)
*
denCoeffsOffdiag
%
dulo21n
(
ilo
,
itype
)
)/&
atoms
%
neq
(
itype
)
DO
ilop
=
1
,
atoms
%
nlo
(
itype
)
qa21
(
itype
)
=
qa21
(
itype
)
+
conjg
(&
uloulop21
(
ilo
,
ilop
,
itype
)
*
&
uloulopn21
(
ilo
,
ilop
,
itype
)
)/
atoms
%
neq
(
itype
)
denCoeffsOffdiag
%
uloulop21
(
ilo
,
ilop
,
itype
)
*
&
denCoeffsOffdiag
%
uloulop21n
(
ilo
,
ilop
,
itype
)
)/
atoms
%
neq
(
itype
)
ENDDO
ENDDO
...
...
@@ -209,10 +189,10 @@ CONTAINS
!---> spherical component
DO
l
=
0
,
atoms
%
lmax
(
itype
)
DO
j
=
1
,
atoms
%
jri
(
itype
)
cs
=
mt21
(
l
,
itype
)
%
uu
*
(
f
(
j
,
1
,
l
,
2
)
*
f
(
j
,
1
,
l
,
1
)
+
f
(
j
,
2
,
l
,
2
)
*
f
(
j
,
2
,
l
,
1
)
)&
+
mt21
(
l
,
itype
)
%
ud
*
(
f
(
j
,
1
,
l
,
2
)
*
g
(
j
,
1
,
l
,
1
)
+
f
(
j
,
2
,
l
,
2
)
*
g
(
j
,
2
,
l
,
1
)
)&
+
mt21
(
l
,
itype
)
%
du
*
(
g
(
j
,
1
,
l
,
2
)
*
f
(
j
,
1
,
l
,
1
)
+
g
(
j
,
2
,
l
,
2
)
*
f
(
j
,
2
,
l
,
1
)
)&
+
mt21
(
l
,
itype
)
%
dd
*
(
g
(
j
,
1
,
l
,
2
)
*
g
(
j
,
1
,
l
,
1
)
+
g
(
j
,
2
,
l
,
2
)
*
g
(
j
,
2
,
l
,
1
)
)
cs
=
denCoeffsOffdiag
%
uu21
(
l
,
itype
)
*
(
f
(
j
,
1
,
l
,
2
)
*
f
(
j
,
1
,
l
,
1
)
+
f
(
j
,
2
,
l
,
2
)
*
f
(
j
,
2
,
l
,
1
)
)&
+
denCoeffsOffdiag
%
ud21