Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
fleur
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
52
Issues
52
List
Boards
Labels
Service Desk
Milestones
Operations
Operations
Incidents
Packages & Registries
Packages & Registries
Container Registry
Analytics
Analytics
Repository
Value Stream
Wiki
Wiki
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Commits
Issue Boards
Open sidebar
fleur
fleur
Commits
e82adc28
Commit
e82adc28
authored
Apr 18, 2018
by
Gregor Michalicek
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Introduce t_moments type to main/cdngen.F90
parent
c8f4d88f
Changes
6
Hide whitespace changes
Inline
Side-by-side
Showing
6 changed files
with
107 additions
and
94 deletions
+107
-94
cdn/cdnval.F90
cdn/cdnval.F90
+25
-30
cdn_mt/cdncore.F90
cdn_mt/cdncore.F90
+4
-5
cdn_mt/cdnmt.f90
cdn_mt/cdnmt.f90
+15
-18
cdn_mt/magMoms.f90
cdn_mt/magMoms.f90
+12
-16
main/cdngen.F90
main/cdngen.F90
+12
-24
types/types_cdnval.f90
types/types_cdnval.f90
+39
-1
No files found.
cdn/cdnval.F90
View file @
e82adc28
...
...
@@ -3,7 +3,7 @@ MODULE m_cdnval
CONTAINS
SUBROUTINE
cdnval
(
eig_id
,
mpi
,
kpts
,
jspin
,
sliceplot
,
noco
,
input
,
banddos
,
cell
,
atoms
,
enpara
,
stars
,&
vacuum
,
dimension
,
sphhar
,
sym
,
obsolete
,
vTot
,
oneD
,
coreSpecInput
,
den
,
regCharges
,
results
,&
qa21
,
chmom
,
clmom
)
moments
)
!
! ***********************************************************
! this subroutin is a modified version of cdnval.F.
...
...
@@ -86,36 +86,32 @@ CONTAINS
USE
m_types
USE
m_xmlOutput
IMPLICIT
NONE
TYPE
(
t_results
),
INTENT
(
INOUT
)
::
results
TYPE
(
t_mpi
),
INTENT
(
IN
)
::
mpi
TYPE
(
t_dimension
),
INTENT
(
IN
)
::
dimension
TYPE
(
t_oneD
),
INTENT
(
IN
)
::
oneD
TYPE
(
t_enpara
),
INTENT
(
INOUT
)
::
enpara
TYPE
(
t_obsolete
),
INTENT
(
IN
)
::
obsolete
TYPE
(
t_banddos
),
INTENT
(
IN
)
::
banddos
TYPE
(
t_sliceplot
),
INTENT
(
IN
)
::
sliceplot
TYPE
(
t_input
),
INTENT
(
IN
)
::
input
TYPE
(
t_vacuum
),
INTENT
(
IN
)
::
vacuum
TYPE
(
t_noco
),
INTENT
(
IN
)
::
noco
TYPE
(
t_sym
),
INTENT
(
IN
)
::
sym
TYPE
(
t_stars
),
INTENT
(
IN
)
::
stars
TYPE
(
t_cell
),
INTENT
(
IN
)
::
cell
TYPE
(
t_kpts
),
INTENT
(
IN
)
::
kpts
TYPE
(
t_sphhar
),
INTENT
(
IN
)
::
sphhar
TYPE
(
t_atoms
),
INTENT
(
IN
)
::
atoms
TYPE
(
t_coreSpecInput
),
INTENT
(
IN
)
::
coreSpecInput
TYPE
(
t_potden
),
INTENT
(
IN
)
::
vTot
TYPE
(
t_potden
),
INTENT
(
INOUT
)
::
den
TYPE
(
t_regionCharges
),
INTENT
(
INOUT
)
::
regCharges
TYPE
(
t_results
),
INTENT
(
INOUT
)
::
results
TYPE
(
t_mpi
),
INTENT
(
IN
)
::
mpi
TYPE
(
t_dimension
),
INTENT
(
IN
)
::
dimension
TYPE
(
t_oneD
),
INTENT
(
IN
)
::
oneD
TYPE
(
t_enpara
),
INTENT
(
INOUT
)
::
enpara
TYPE
(
t_obsolete
),
INTENT
(
IN
)
::
obsolete
TYPE
(
t_banddos
),
INTENT
(
IN
)
::
banddos
TYPE
(
t_sliceplot
),
INTENT
(
IN
)
::
sliceplot
TYPE
(
t_input
),
INTENT
(
IN
)
::
input
TYPE
(
t_vacuum
),
INTENT
(
IN
)
::
vacuum
TYPE
(
t_noco
),
INTENT
(
IN
)
::
noco
TYPE
(
t_sym
),
INTENT
(
IN
)
::
sym
TYPE
(
t_stars
),
INTENT
(
IN
)
::
stars
TYPE
(
t_cell
),
INTENT
(
IN
)
::
cell
TYPE
(
t_kpts
),
INTENT
(
IN
)
::
kpts
TYPE
(
t_sphhar
),
INTENT
(
IN
)
::
sphhar
TYPE
(
t_atoms
),
INTENT
(
IN
)
::
atoms
TYPE
(
t_coreSpecInput
),
INTENT
(
IN
)
::
coreSpecInput
TYPE
(
t_potden
),
INTENT
(
IN
)
::
vTot
TYPE
(
t_potden
),
INTENT
(
INOUT
)
::
den
TYPE
(
t_regionCharges
),
INTENT
(
INOUT
)
::
regCharges
TYPE
(
t_moments
),
INTENT
(
INOUT
)
::
moments
! .. Scalar Arguments ..
INTEGER
,
INTENT
(
IN
)
::
eig_id
,
jspin
! .. Array Arguments ..
COMPLEX
,
INTENT
(
INOUT
)
::
qa21
(
atoms
%
ntype
)
REAL
,
INTENT
(
OUT
)
::
chmom
(
atoms
%
ntype
,
dimension
%
jspd
)
REAL
,
INTENT
(
OUT
)
::
clmom
(
3
,
atoms
%
ntype
,
dimension
%
jspd
)
#ifdef CPP_MPI
INCLUDE
'mpif.h'
LOGICAL
::
mpi_flag
,
mpi_status
...
...
@@ -616,10 +612,9 @@ CONTAINS
END
IF
IF
(
mpi
%
irank
==
0
)
THEN
CALL
cdnmt
(
dimension
%
jspd
,
atoms
,
sphhar
,
llpd
,&
noco
,
l_fmpl
,
jsp_start
,
jsp_end
,&
CALL
cdnmt
(
dimension
%
jspd
,
atoms
,
sphhar
,
llpd
,
noco
,
l_fmpl
,
jsp_start
,
jsp_end
,&
enpara
%
el0
,
enpara
%
ello0
,
vTot
%
mt
(:,
0
,:,:),
denCoeffs
,&
usdus
,
orb
,
denCoeffsOffdiag
,
chmom
,
clmom
,
qa21
,
den
%
mt
)
usdus
,
orb
,
denCoeffsOffdiag
,
moments
,
den
%
mt
)
DO
ispin
=
jsp_start
,
jsp_end
IF
(
.NOT.
sliceplot
%
slice
)
THEN
...
...
cdn_mt/cdncore.F90
View file @
e82adc28
...
...
@@ -9,7 +9,7 @@ MODULE m_cdncore
CONTAINS
SUBROUTINE
cdncore
(
results
,
mpi
,
dimension
,
oneD
,
sliceplot
,
input
,
vacuum
,
noco
,
sym
,&
stars
,
cell
,
sphhar
,
atoms
,
vTot
,
outDen
,
stdn
,
svdn
)
stars
,
cell
,
sphhar
,
atoms
,
vTot
,
outDen
,
moments
)
USE
m_constants
USE
m_cdn_io
...
...
@@ -41,8 +41,7 @@ SUBROUTINE cdncore(results,mpi,dimension,oneD,sliceplot,input,vacuum,noco,sym,&
TYPE
(
t_atoms
),
INTENT
(
IN
)
::
atoms
TYPE
(
t_potden
),
INTENT
(
IN
)
::
vTot
TYPE
(
t_potden
),
INTENT
(
INOUT
)
::
outDen
REAL
,
INTENT
(
INOUT
)
::
stdn
(
atoms
%
ntype
,
dimension
%
jspd
)
REAL
,
INTENT
(
INOUT
)
::
svdn
(
atoms
%
ntype
,
dimension
%
jspd
)
TYPE
(
t_moments
),
INTENT
(
INOUT
)
::
moments
INTEGER
::
jspin
,
n
,
iType
REAL
::
seig
,
rhoint
,
momint
...
...
@@ -57,7 +56,7 @@ SUBROUTINE cdncore(results,mpi,dimension,oneD,sliceplot,input,vacuum,noco,sym,&
IF
(
mpi
%
irank
.EQ.
0
)
THEN
DO
jspin
=
1
,
input
%
jspins
DO
n
=
1
,
atoms
%
ntype
svdn
(
n
,
jspin
)
=
outDen
%
mt
(
1
,
0
,
n
,
jspin
)
/
(
sfp_const
*
atoms
%
rmsh
(
1
,
n
)
*
atoms
%
rmsh
(
1
,
n
))
moments
%
svdn
(
n
,
jspin
)
=
outDen
%
mt
(
1
,
0
,
n
,
jspin
)
/
(
sfp_const
*
atoms
%
rmsh
(
1
,
n
)
*
atoms
%
rmsh
(
1
,
n
))
END
DO
END
DO
END
IF
...
...
@@ -99,7 +98,7 @@ SUBROUTINE cdncore(results,mpi,dimension,oneD,sliceplot,input,vacuum,noco,sym,&
DO
jspin
=
1
,
input
%
jspins
IF
(
mpi
%
irank
.EQ.
0
)
THEN
DO
n
=
1
,
atoms
%
ntype
stdn
(
n
,
jspin
)
=
outDen
%
mt
(
1
,
0
,
n
,
jspin
)
/
(
sfp_const
*
atoms
%
rmsh
(
1
,
n
)
*
atoms
%
rmsh
(
1
,
n
))
moments
%
stdn
(
n
,
jspin
)
=
outDen
%
mt
(
1
,
0
,
n
,
jspin
)
/
(
sfp_const
*
atoms
%
rmsh
(
1
,
n
)
*
atoms
%
rmsh
(
1
,
n
))
END
DO
END
IF
IF
((
noco
%
l_noco
)
.AND.
(
mpi
%
irank
.EQ.
0
))
THEN
...
...
cdn_mt/cdnmt.f90
View file @
e82adc28
...
...
@@ -11,9 +11,7 @@ MODULE m_cdnmt
!***********************************************************************
CONTAINS
SUBROUTINE
cdnmt
(
jspd
,
atoms
,
sphhar
,
llpd
,
noco
,
l_fmpl
,
jsp_start
,
jsp_end
,
epar
,&
ello
,
vr
,
denCoeffs
,
usdus
,&
orb
,
denCoeffsOffdiag
,&
chmom
,
clmom
,
qa21
,
rho
)
ello
,
vr
,
denCoeffs
,
usdus
,
orb
,
denCoeffsOffdiag
,
moments
,
rho
)
use
m_constants
,
only
:
sfp_const
USE
m_rhosphnlo
USE
m_radfun
...
...
@@ -21,10 +19,11 @@ CONTAINS
USE
m_types
USE
m_xmlOutput
IMPLICIT
NONE
TYPE
(
t_usdus
),
INTENT
(
INOUT
)::
usdus
!in fact only the lo part is intent(in)
TYPE
(
t_noco
),
INTENT
(
IN
)
::
noco
TYPE
(
t_sphhar
),
INTENT
(
IN
)
::
sphhar
TYPE
(
t_atoms
),
INTENT
(
IN
)
::
atoms
TYPE
(
t_usdus
),
INTENT
(
INOUT
)
::
usdus
!in fact only the lo part is intent(in)
TYPE
(
t_noco
),
INTENT
(
IN
)
::
noco
TYPE
(
t_sphhar
),
INTENT
(
IN
)
::
sphhar
TYPE
(
t_atoms
),
INTENT
(
IN
)
::
atoms
TYPE
(
t_moments
),
INTENT
(
INOUT
)
::
moments
! .. Scalar Arguments ..
INTEGER
,
INTENT
(
IN
)
::
llpd
...
...
@@ -35,9 +34,7 @@ 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
(
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_denCoeffs
),
INTENT
(
IN
)
::
denCoeffs
TYPE
(
t_denCoeffsOffdiag
),
INTENT
(
IN
)
::
denCoeffsOffdiag
...
...
@@ -69,7 +66,7 @@ CONTAINS
!$OMP PARALLEL DEFAULT(none) &
!$OMP SHARED(usdus,rho,
chmom,clmom,qa21
,rho21,qmtl) &
!$OMP SHARED(usdus,rho,
moments
,rho21,qmtl) &
!$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)
...
...
@@ -125,14 +122,14 @@ CONTAINS
&
*
usdus
%
ddn
(
l
,
itype
,
ispin
)
)/
atoms
%
neq
(
itype
)
+
qmtllo
(
l
)
qmtt
=
qmtt
+
qmtl
(
l
,
ispin
,
itype
)
END
DO
chmom
(
itype
,
ispin
)
=
qmtt
moments
%
chmom
(
itype
,
ispin
)
=
qmtt
!+soc
!---> spherical angular component
IF
(
noco
%
l_soc
)
THEN
CALL
orbmom2
(
atoms
,
itype
,
ispin
,
usdus
%
ddn
(
0
,
itype
,
ispin
),&
orb
,
usdus
%
uulon
(
1
,
itype
,
ispin
),
usdus
%
dulon
(
1
,
itype
,
ispin
),&
usdus
%
uloulopn
(
1
,
1
,
itype
,
ispin
),
clmom
(
1
,
itype
,
ispin
))
!keep
usdus
%
uloulopn
(
1
,
1
,
itype
,
ispin
),
moments
%
clmom
(
1
,
itype
,
ispin
))
!keep
ENDIF
!-soc
!---> non-spherical components
...
...
@@ -161,21 +158,21 @@ CONTAINS
!---> calculate off-diagonal integrated density
DO
l
=
0
,
atoms
%
lmax
(
itype
)
qa21
(
itype
)
=
qa21
(
itype
)
+
conjg
(&
moments
%
qa21
(
itype
)
=
moments
%
qa21
(
itype
)
+
conjg
(&
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
(&
moments
%
qa21
(
itype
)
=
moments
%
qa21
(
itype
)
+
conjg
(&
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
(&
moments
%
qa21
(
itype
)
=
moments
%
qa21
(
itype
)
+
conjg
(&
denCoeffsOffdiag
%
uloulop21
(
ilo
,
ilop
,
itype
)
*
&
denCoeffsOffdiag
%
uloulop21n
(
ilo
,
ilop
,
itype
)
)/
atoms
%
neq
(
itype
)
ENDDO
...
...
@@ -230,12 +227,12 @@ CONTAINS
DO
itype
=
1
,
atoms
%
ntype
DO
ispin
=
jsp_start
,
jsp_end
WRITE
(
6
,
FMT
=
8100
)
itype
,
(
qmtl
(
l
,
ispin
,
itype
),
l
=
0
,
3
),
chmom
(
itype
,
ispin
)
WRITE
(
16
,
FMT
=
8100
)
itype
,
(
qmtl
(
l
,
ispin
,
itype
),
l
=
0
,
3
),
chmom
(
itype
,
ispin
)
WRITE
(
6
,
FMT
=
8100
)
itype
,
(
qmtl
(
l
,
ispin
,
itype
),
l
=
0
,
3
),
moments
%
chmom
(
itype
,
ispin
)
WRITE
(
16
,
FMT
=
8100
)
itype
,
(
qmtl
(
l
,
ispin
,
itype
),
l
=
0
,
3
),
moments
%
chmom
(
itype
,
ispin
)
8100
FORMAT
(
' -->'
,
i3
,
2x
,
4f9.5
,
2x
,
f9.5
)
attributes
=
''
WRITE
(
attributes
(
1
),
'(i0)'
)
itype
WRITE
(
attributes
(
2
),
'(f12.7)'
)
chmom
(
itype
,
ispin
)
WRITE
(
attributes
(
2
),
'(f12.7)'
)
moments
%
chmom
(
itype
,
ispin
)
WRITE
(
attributes
(
3
),
'(f12.7)'
)
qmtl
(
0
,
ispin
,
itype
)
WRITE
(
attributes
(
4
),
'(f12.7)'
)
qmtl
(
1
,
ispin
,
itype
)
WRITE
(
attributes
(
5
),
'(f12.7)'
)
qmtl
(
2
,
ispin
,
itype
)
...
...
cdn_mt/magMoms.f90
View file @
e82adc28
...
...
@@ -8,7 +8,7 @@ MODULE m_magMoms
CONTAINS
SUBROUTINE
magMoms
(
dimension
,
input
,
atoms
,
noco
,
vTot
,
stdn
,
svdn
,
chmom
,
qa21
)
SUBROUTINE
magMoms
(
dimension
,
input
,
atoms
,
noco
,
vTot
,
moments
)
USE
m_types
USE
m_xmlOutput
...
...
@@ -21,11 +21,7 @@ SUBROUTINE magMoms(dimension,input,atoms,noco,vTot,stdn,svdn,chmom,qa21)
TYPE
(
t_atoms
),
INTENT
(
IN
)
::
atoms
TYPE
(
t_noco
),
INTENT
(
INOUT
)
::
noco
TYPE
(
t_potden
),
INTENT
(
IN
)
::
vTot
REAL
,
INTENT
(
INOUT
)
::
chmom
(
atoms
%
ntype
,
dimension
%
jspd
)
COMPLEX
,
INTENT
(
IN
)
::
qa21
(
atoms
%
ntype
)
REAL
,
INTENT
(
IN
)
::
stdn
(
atoms
%
ntype
,
dimension
%
jspd
)
REAL
,
INTENT
(
IN
)
::
svdn
(
atoms
%
ntype
,
dimension
%
jspd
)
TYPE
(
t_moments
),
INTENT
(
IN
)
::
moments
INTEGER
::
iType
,
j
,
iRepAtom
REAL
::
sval
,
stot
,
scor
,
smom
...
...
@@ -34,11 +30,11 @@ SUBROUTINE magMoms(dimension,input,atoms,noco,vTot,stdn,svdn,chmom,qa21)
WRITE
(
6
,
FMT
=
8000
)
WRITE
(
16
,
FMT
=
8000
)
DO
iType
=
1
,
atoms
%
ntype
sval
=
svdn
(
iType
,
1
)
-
svdn
(
iType
,
input
%
jspins
)
stot
=
stdn
(
iType
,
1
)
-
stdn
(
iType
,
input
%
jspins
)
sval
=
moments
%
svdn
(
iType
,
1
)
-
moments
%
svdn
(
iType
,
input
%
jspins
)
stot
=
moments
%
stdn
(
iType
,
1
)
-
moments
%
stdn
(
iType
,
input
%
jspins
)
scor
=
stot
-
sval
WRITE
(
6
,
FMT
=
8010
)
iType
,
stot
,
sval
,
scor
,
svdn
(
iType
,
1
),
stdn
(
iType
,
1
)
WRITE
(
16
,
FMT
=
8010
)
iType
,
stot
,
sval
,
scor
,
svdn
(
iType
,
1
),
stdn
(
iType
,
1
)
WRITE
(
6
,
FMT
=
8010
)
iType
,
stot
,
sval
,
scor
,
moments
%
svdn
(
iType
,
1
),
moments
%
stdn
(
iType
,
1
)
WRITE
(
16
,
FMT
=
8010
)
iType
,
stot
,
sval
,
scor
,
moments
%
svdn
(
iType
,
1
),
moments
%
stdn
(
iType
,
1
)
END
DO
8000
FORMAT
(
/
,
/
,
10x
,
'spin density at the nucleus:'
,
/
,
10x
,
'type'
,
t25
,
&
...
...
@@ -52,14 +48,14 @@ SUBROUTINE magMoms(dimension,input,atoms,noco,vTot,stdn,svdn,chmom,qa21)
CALL
openXMLElement
(
'magneticMomentsInMTSpheres'
,(/
'units'
/),(/
'muBohr'
/))
iRepAtom
=
1
DO
iType
=
1
,
atoms
%
ntype
smom
=
chmom
(
iType
,
1
)
-
chmom
(
iType
,
input
%
jspins
)
WRITE
(
6
,
FMT
=
8030
)
iType
,
smom
,
(
chmom
(
iType
,
j
),
j
=
1
,
input
%
jspins
)
WRITE
(
16
,
FMT
=
8030
)
iType
,
smom
,
(
chmom
(
iType
,
j
),
j
=
1
,
input
%
jspins
)
smom
=
moments
%
chmom
(
iType
,
1
)
-
moments
%
chmom
(
iType
,
input
%
jspins
)
WRITE
(
6
,
FMT
=
8030
)
iType
,
smom
,
(
moments
%
chmom
(
iType
,
j
),
j
=
1
,
input
%
jspins
)
WRITE
(
16
,
FMT
=
8030
)
iType
,
smom
,
(
moments
%
chmom
(
iType
,
j
),
j
=
1
,
input
%
jspins
)
attributes
=
''
WRITE
(
attributes
(
1
),
'(i0)'
)
iType
WRITE
(
attributes
(
2
),
'(f15.10)'
)
smom
WRITE
(
attributes
(
3
),
'(f15.10)'
)
chmom
(
iType
,
1
)
WRITE
(
attributes
(
4
),
'(f15.10)'
)
chmom
(
iType
,
2
)
WRITE
(
attributes
(
3
),
'(f15.10)'
)
moments
%
chmom
(
iType
,
1
)
WRITE
(
attributes
(
4
),
'(f15.10)'
)
moments
%
chmom
(
iType
,
2
)
CALL
writeXMLElementFormPoly
(
'magneticMoment'
,(/
'atomType '
,
'moment '
,
'spinUpCharge '
,&
'spinDownCharge'
/),&
attributes
,
reshape
((/
8
,
6
,
12
,
14
,
6
,
15
,
15
,
15
/),(/
4
,
2
/)))
...
...
@@ -68,7 +64,7 @@ SUBROUTINE magMoms(dimension,input,atoms,noco,vTot,stdn,svdn,chmom,qa21)
!calculate the perpendicular part of the local moment
!and relax the angle of the local moment or calculate
!the constraint B-field.
CALL
m_perp
(
atoms
,
iType
,
iRepAtom
,
noco
,
vTot
%
mt
(:,
0
,:,:),
chmom
,
qa21
)
CALL
m_perp
(
atoms
,
iType
,
iRepAtom
,
noco
,
vTot
%
mt
(:,
0
,:,:),
moments
%
chmom
,
moments
%
qa21
)
END
IF
iRepAtom
=
iRepAtom
+
atoms
%
neq
(
iType
)
END
DO
...
...
main/cdngen.F90
View file @
e82adc28
...
...
@@ -66,27 +66,19 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,&
INTEGER
,
INTENT
(
IN
)
::
eig_id
,
archiveType
! Local type instances
TYPE
(
t_noco
)
::
noco_new
TYPE
(
t_regionCharges
)
::
regCharges
TYPE
(
t_noco
)
::
noco_new
TYPE
(
t_regionCharges
)
::
regCharges
TYPE
(
t_moments
)
::
moments
!Local Scalars
REAL
fix
,
qtot
,
dummy
INTEGER
jspin
,
jspmax
REAL
::
fix
,
qtot
,
dummy
INTEGER
::
jspin
,
jspmax
!Local Arrays
REAL
stdn
(
atoms
%
ntype
,
dimension
%
jspd
),
svdn
(
atoms
%
ntype
,
dimension
%
jspd
)
REAL
chmom
(
atoms
%
ntype
,
dimension
%
jspd
),
clmom
(
3
,
atoms
%
ntype
,
dimension
%
jspd
)
COMPLEX
,
ALLOCATABLE
::
qa21
(:)
ALLOCATE
(
qa21
(
atoms
%
ntype
))
!initialize density arrays with zero
qa21
(:)
=
cmplx
(
0.0
,
0.0
)
CALL
regCharges
%
init
(
input
,
atoms
,
dimension
,
kpts
,
vacuum
)
CALL
moments
%
init
(
input
,
atoms
)
IF
(
mpi
%
irank
.EQ.
0
)
CALL
openXMLElementNoAttributes
(
'valenceDensity'
)
CALL
regCharges
%
init
(
input
,
atoms
,
dimension
,
kpts
,
vacuum
)
!In a non-collinear calcuation where the off-diagonal part of the
!density matrix in the muffin-tins is calculated, the a- and
!b-coef. for both spins are needed at once. Thus, cdnval is only
...
...
@@ -95,10 +87,8 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,&
IF
(
noco
%
l_mperp
)
jspmax
=
1
DO
jspin
=
1
,
jspmax
CALL
timestart
(
"cdngen: cdnval"
)
CALL
cdnval
(
eig_id
,&
mpi
,
kpts
,
jspin
,
sliceplot
,
noco
,
input
,
banddos
,
cell
,
atoms
,
enpara
,
stars
,
vacuum
,
dimension
,&
sphhar
,
sym
,
obsolete
,
vTot
,
oneD
,
coreSpecInput
,&
outDen
,
regCharges
,
results
,
qa21
,
chmom
,
clmom
)
CALL
cdnval
(
eig_id
,
mpi
,
kpts
,
jspin
,
sliceplot
,
noco
,
input
,
banddos
,
cell
,
atoms
,
enpara
,
stars
,
vacuum
,
dimension
,&
sphhar
,
sym
,
obsolete
,
vTot
,
oneD
,
coreSpecInput
,
outDen
,
regCharges
,
results
,
moments
)
CALL
timestop
(
"cdngen: cdnval"
)
END
DO
...
...
@@ -108,7 +98,7 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,&
END
IF
! mpi%irank = 0
CALL
cdncore
(
results
,
mpi
,
dimension
,
oneD
,
sliceplot
,
input
,
vacuum
,
noco
,
sym
,&
stars
,
cell
,
sphhar
,
atoms
,
vTot
,
outDen
,
stdn
,
svdn
)
stars
,
cell
,
sphhar
,
atoms
,
vTot
,
outDen
,
moments
)
IF
(
sliceplot
%
slice
)
THEN
IF
(
mpi
%
irank
.EQ.
0
)
THEN
...
...
@@ -127,7 +117,7 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,&
noco_new
=
noco
!Calculate and write out spin densities at the nucleus and magnetic moments in the spheres
CALL
magMoms
(
dimension
,
input
,
atoms
,
noco_new
,
vTot
,
stdn
,
svdn
,
chmom
,
qa21
)
CALL
magMoms
(
dimension
,
input
,
atoms
,
noco_new
,
vTot
,
moments
)
!Generate and save the new nocoinp file if the directions of the local
!moments are relaxed or a constraint B-field is calculated.
...
...
@@ -135,7 +125,7 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,&
CALL
genNewNocoInp
(
input
,
atoms
,
noco
,
noco_new
)
END
IF
IF
(
noco
%
l_soc
)
CALL
orbMagMoms
(
dimension
,
atoms
,
noco
,
clmom
)
IF
(
noco
%
l_soc
)
CALL
orbMagMoms
(
dimension
,
atoms
,
noco
,
moments
%
clmom
)
END
IF
END
IF
! mpi%irank.EQ.0
...
...
@@ -143,8 +133,6 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,&
CALL
mpi_bc_potden
(
mpi
,
stars
,
sphhar
,
atoms
,
input
,
vacuum
,
oneD
,
noco
,
outDen
)
#endif
DEALLOCATE
(
qa21
)
END
SUBROUTINE
cdngen
END
MODULE
m_cdngen
types/types_cdnval.f90
View file @
e82adc28
...
...
@@ -174,8 +174,20 @@ PRIVATE
PROCEDURE
,
PASS
::
init
=>
regionCharges_init
END
TYPE
t_regionCharges
TYPE
t_moments
PUBLIC
t_orb
,
t_denCoeffs
,
t_denCoeffsOffdiag
,
t_force
,
t_slab
,
t_eigVecCoeffs
,
t_mcd
,
t_regionCharges
REAL
,
ALLOCATABLE
::
chmom
(:,:)
REAL
,
ALLOCATABLE
::
clmom
(:,:,:)
COMPLEX
,
ALLOCATABLE
::
qa21
(:)
REAL
,
ALLOCATABLE
::
stdn
(:,:)
REAL
,
ALLOCATABLE
::
svdn
(:,:)
CONTAINS
PROCEDURE
,
PASS
::
init
=>
moments_init
END
TYPE
t_moments
PUBLIC
t_orb
,
t_denCoeffs
,
t_denCoeffsOffdiag
,
t_force
,
t_slab
,
t_eigVecCoeffs
,
t_mcd
,
t_regionCharges
,
t_moments
CONTAINS
...
...
@@ -643,4 +655,30 @@ SUBROUTINE regionCharges_init(thisRegCharges,input,atoms,dimension,kpts,vacuum)
END
SUBROUTINE
regionCharges_init
SUBROUTINE
moments_init
(
thisMoments
,
input
,
atoms
)
USE
m_types_setup
IMPLICIT
NONE
CLASS
(
t_moments
),
INTENT
(
INOUT
)
::
thisMoments
TYPE
(
t_input
),
INTENT
(
IN
)
::
input
TYPE
(
t_atoms
),
INTENT
(
IN
)
::
atoms
ALLOCATE
(
thisMoments
%
chmom
(
atoms
%
ntype
,
input
%
jspins
))
ALLOCATE
(
thisMoments
%
clmom
(
3
,
atoms
%
ntype
,
input
%
jspins
))
ALLOCATE
(
thisMoments
%
qa21
(
atoms
%
ntype
))
ALLOCATE
(
thisMoments
%
stdn
(
atoms
%
ntype
,
input
%
jspins
))
ALLOCATE
(
thisMoments
%
svdn
(
atoms
%
ntype
,
input
%
jspins
))
thisMoments
%
chmom
=
0.0
thisMoments
%
clmom
=
0.0
thisMoments
%
qa21
=
CMPLX
(
0.0
,
0.0
)
thisMoments
%
stdn
=
0.0
thisMoments
%
svdn
=
0.0
END
SUBROUTINE
moments_init
END
MODULE
m_types_cdnval
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment