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
ad08f475
Commit
ad08f475
authored
Jan 29, 2020
by
Daniel Wortmann
1
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
ATTENTION, HUGE COMMIT! Spitted noco type into noco&nococonv type. Made many types more INTENT(IN).
parent
078fc1c4
Changes
101
Expand all
Hide whitespace changes
Inline
Side-by-side
Showing
101 changed files
with
1369 additions
and
1219 deletions
+1369
-1219
cdn/cdnval.F90
cdn/cdnval.F90
+6
-5
cdn/genNewNocoInp.f90
cdn/genNewNocoInp.f90
+12
-11
cdn/m_perp.f90
cdn/m_perp.f90
+21
-20
cdn/qal_21.f90
cdn/qal_21.f90
+19
-19
cdn/vacden.F90
cdn/vacden.F90
+8
-7
cdn_mt/abcof.F90
cdn_mt/abcof.F90
+11
-10
cdn_mt/alignSpinAxisMagn.f90
cdn_mt/alignSpinAxisMagn.f90
+27
-25
cdn_mt/cdncore.F90
cdn_mt/cdncore.F90
+7
-6
cdn_mt/magDiMom.f90
cdn_mt/magDiMom.f90
+5
-4
cdn_mt/magMoms.f90
cdn_mt/magMoms.f90
+11
-10
cdn_mt/orbMagMoms.f90
cdn_mt/orbMagMoms.f90
+8
-6
cdn_mt/resMoms.f90
cdn_mt/resMoms.f90
+4
-3
eigen/eigen.F90
eigen/eigen.F90
+6
-6
eigen/eigen_hssetup.F90
eigen/eigen_hssetup.F90
+13
-13
eigen/hlomat.F90
eigen/hlomat.F90
+6
-5
eigen/hsmt.F90
eigen/hsmt.F90
+16
-15
eigen/hsmt_ab.F90
eigen/hsmt_ab.F90
+27
-26
eigen/hsmt_lo.F90
eigen/hsmt_lo.F90
+4
-3
eigen/hsmt_mtNocoPot_offdiag.F90
eigen/hsmt_mtNocoPot_offdiag.F90
+10
-9
eigen/hsmt_nonsph.F90
eigen/hsmt_nonsph.F90
+31
-28
eigen/hsmt_offdiag.F90
eigen/hsmt_offdiag.F90
+11
-11
eigen/hsmt_soc_offdiag.f90
eigen/hsmt_soc_offdiag.f90
+10
-10
eigen/hsmt_sph.F90
eigen/hsmt_sph.F90
+14
-14
eigen/hsmt_spinor.F90
eigen/hsmt_spinor.F90
+20
-20
eigen/hsvac.F90
eigen/hsvac.F90
+9
-8
eigen/mt_setup.F90
eigen/mt_setup.F90
+4
-3
eigen/od_hsvac.F90
eigen/od_hsvac.F90
+19
-18
eigen/od_vacfun.f90
eigen/od_vacfun.f90
+4
-3
eigen/slomat.F90
eigen/slomat.F90
+6
-6
eigen/tlmplm.F90
eigen/tlmplm.F90
+3
-2
eigen/tlmplm_cholesky.F90
eigen/tlmplm_cholesky.F90
+9
-8
eigen/vacfun.f90
eigen/vacfun.f90
+5
-6
eigen_secvar/aline.F90
eigen_secvar/aline.F90
+10
-9
eigen_soc/eigenso.F90
eigen_soc/eigenso.F90
+4
-3
eigen_soc/spnorb.f90
eigen_soc/spnorb.f90
+13
-12
eigen_soc/ssomat.F90
eigen_soc/ssomat.F90
+8
-7
fleurinput/types_input.f90
fleurinput/types_input.f90
+0
-2
fleurinput/types_noco.f90
fleurinput/types_noco.f90
+22
-59
forcetheorem/dmi.F90
forcetheorem/dmi.F90
+28
-25
forcetheorem/jij.F90
forcetheorem/jij.F90
+72
-69
forcetheorem/mae.F90
forcetheorem/mae.F90
+20
-17
forcetheorem/ssdisp.F90
forcetheorem/ssdisp.F90
+21
-19
greensf/crystalfield.f90
greensf/crystalfield.f90
+4
-4
greensf/gfcalc.f90
greensf/gfcalc.f90
+4
-3
hybrid/calc_hybrid.F90
hybrid/calc_hybrid.F90
+5
-4
hybrid/checkolap.F90
hybrid/checkolap.F90
+5
-4
hybrid/exchange_val_hf.F90
hybrid/exchange_val_hf.F90
+4
-3
hybrid/gen_wavf.F90
hybrid/gen_wavf.F90
+4
-3
hybrid/hf_setup.F90
hybrid/hf_setup.F90
+8
-7
hybrid/hsfock.F90
hybrid/hsfock.F90
+3
-2
hybrid/wavefproducts_inv.f90
hybrid/wavefproducts_inv.f90
+7
-5
hybrid/wavefproducts_noinv.f90
hybrid/wavefproducts_noinv.f90
+6
-4
init/fleurinput_postprocess.f90
init/fleurinput_postprocess.f90
+2
-2
init/lapw_dim.F90
init/lapw_dim.F90
+4
-3
init/make_sym.f90
init/make_sym.f90
+2
-2
init/mapatom.F90
init/mapatom.F90
+2
-2
inpgen2/CMakeLists.txt
inpgen2/CMakeLists.txt
+1
-0
inpgen2/make_defaults.f90
inpgen2/make_defaults.f90
+6
-8
inpgen2/make_spacegroup.f90
inpgen2/make_spacegroup.f90
+7
-7
inpgen2/old_inp/apws_dim.f90
inpgen2/old_inp/apws_dim.f90
+10
-10
inpgen2/old_inp/dimen7.F90
inpgen2/old_inp/dimen7.F90
+4
-6
inpgen2/old_inp/fleur_init_old.F90
inpgen2/old_inp/fleur_init_old.F90
+2
-2
inpgen2/old_inp/inped.F90
inpgen2/old_inp/inped.F90
+3
-4
inpgen2/old_inp/inpnoco.F90
inpgen2/old_inp/inpnoco.F90
+5
-5
inpgen2/old_inp/rw_inp.f90
inpgen2/old_inp/rw_inp.f90
+6
-6
inpgen2/old_inp/rw_noco.f90
inpgen2/old_inp/rw_noco.f90
+24
-25
inpgen2/read_inpgen_input.f90
inpgen2/read_inpgen_input.f90
+2
-2
io/w_inpXML.f90
io/w_inpXML.f90
+5
-5
io/writeBasis.F90
io/writeBasis.F90
+1
-1
kpoints/unfoldBandKPTS.f90
kpoints/unfoldBandKPTS.f90
+22
-22
main/cdngen.F90
main/cdngen.F90
+19
-25
main/fleur.F90
main/fleur.F90
+61
-62
main/fleur_init.F90
main/fleur_init.F90
+6
-3
main/fleur_job.F90
main/fleur_job.F90
+40
-1
main/optional.F90
main/optional.F90
+4
-4
main/vgen.F90
main/vgen.F90
+4
-3
optional/bmt.f90
optional/bmt.f90
+8
-8
optional/cdnsp.f90
optional/cdnsp.f90
+5
-6
optional/plot.f90
optional/plot.f90
+38
-32
rdmft/rdmft.F90
rdmft/rdmft.F90
+11
-10
types/CMakeLists.txt
types/CMakeLists.txt
+1
-0
types/types.F90
types/types.F90
+1
-0
types/types_forcetheo.F90
types/types_forcetheo.F90
+7
-3
types/types_lapw.F90
types/types_lapw.F90
+26
-19
types/types_nococonv.F90
types/types_nococonv.F90
+73
-0
vgen/sfTests.f90
vgen/sfTests.f90
+16
-13
vgen/vgen_coulomb.F90
vgen/vgen_coulomb.F90
+0
-2
vgen/vgen_finalize.F90
vgen/vgen_finalize.F90
+4
-3
vgen/vis_xc.F90
vgen/vis_xc.F90
+2
-2
vgen/xcBfield.f90
vgen/xcBfield.f90
+4
-3
wannier/uhu/wann_uHu.F
wannier/uhu/wann_uHu.F
+56
-56
wannier/uhu/wann_uHu_dmi.F
wannier/uhu/wann_uHu_dmi.F
+51
-51
wannier/wann_optional.f90
wannier/wann_optional.f90
+13
-13
wannier/wann_plot_um_dat.F
wannier/wann_plot_um_dat.F
+59
-58
wannier/wann_postproc.F90
wannier/wann_postproc.F90
+21
-20
wannier/wann_socmat.F
wannier/wann_socmat.F
+12
-11
wannier/wann_socmat_vec.F
wannier/wann_socmat_vec.F
+16
-15
wannier/wann_updown.F
wannier/wann_updown.F
+7
-5
wannier/wannier.F90
wannier/wannier.F90
+31
-30
wannier/wannier_to_lapw.F
wannier/wannier_to_lapw.F
+47
-45
xc-pot/metagga.F90
xc-pot/metagga.F90
+4
-3
No files found.
cdn/cdnval.F90
View file @
ad08f475
...
...
@@ -10,7 +10,7 @@ USE m_juDFT
CONTAINS
SUBROUTINE
cdnval
(
eig_id
,
mpi
,
kpts
,
jspin
,
noco
,
input
,
banddos
,
cell
,
atoms
,
enpara
,
stars
,&
SUBROUTINE
cdnval
(
eig_id
,
mpi
,
kpts
,
jspin
,
noco
,
nococonv
,
input
,
banddos
,
cell
,
atoms
,
enpara
,
stars
,&
vacuum
,
sphhar
,
sym
,
vTot
,
oneD
,
cdnvalJob
,
den
,
regCharges
,
dos
,
results
,&
moments
,
gfinp
,
hub1inp
,
hub1data
,
coreSpecInput
,
mcd
,
slab
,
orbcomp
,
greensfCoeffs
)
...
...
@@ -67,6 +67,7 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,st
TYPE
(
t_input
),
INTENT
(
IN
)
::
input
TYPE
(
t_vacuum
),
INTENT
(
IN
)
::
vacuum
TYPE
(
t_noco
),
INTENT
(
IN
)
::
noco
TYPE
(
t_nococonv
),
INTENT
(
IN
)
::
nococonv
TYPE
(
t_sym
),
INTENT
(
IN
)
::
sym
TYPE
(
t_stars
),
INTENT
(
IN
)
::
stars
TYPE
(
t_cell
),
INTENT
(
IN
)
::
cell
...
...
@@ -191,7 +192,7 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,st
DO
ikpt_i
=
1
,
size
(
cdnvalJob
%
k_list
)
ikpt
=
cdnvalJob
%
k_list
(
ikpt_i
)
CALL
lapw
%
init
(
input
,
noco
,
kpts
,
atoms
,
sym
,
ikpt
,
cell
,
.false.
,
mpi
)
CALL
lapw
%
init
(
input
,
noco
,
nococonv
,
kpts
,
atoms
,
sym
,
ikpt
,
cell
,
.false.
,
mpi
)
skip_t
=
skip_tt
ev_list
=
cdnvaljob
%
compact_ev_list
(
ikpt_i
,
banddos
%
dos
.OR.
gfinp
%
n
>
0
)
noccbd
=
SIZE
(
ev_list
)
...
...
@@ -224,7 +225,7 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,st
IF
(
l_dosNdir
.AND.
PRESENT
(
slab
))
CALL
q_int_sl
(
jspin
,
ikpt
,
stars
,
atoms
,
sym
,
cell
,
noccbd
,
ev_list
,
lapw
,
slab
,
oneD
,
zMat
)
! valence density in the vacuum region
IF
(
input
%
film
)
THEN
CALL
vacden
(
vacuum
,
stars
,
oneD
,
kpts
,
input
,
sym
,
cell
,
atoms
,
noco
,
banddos
,&
CALL
vacden
(
vacuum
,
stars
,
oneD
,
kpts
,
input
,
sym
,
cell
,
atoms
,
noco
,
nococonv
,
banddos
,&
gVacMap
,
we
,
ikpt
,
jspin
,
vTot
%
vacz
(:,:,
jspin
),
noccbd
,
ev_list
,
lapw
,
enpara
%
evac
,
eig
,
den
,
zMat
,
dos
)
END
IF
END
IF
...
...
@@ -244,7 +245,7 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,st
ENDIF
DO
ispin
=
jsp_start
,
jsp_end
IF
(
input
%
l_f
)
CALL
force
%
init2
(
noccbd
,
input
,
atoms
)
CALL
abcof
(
input
,
atoms
,
sym
,
cell
,
lapw
,
noccbd
,
usdus
,
noco
,
ispin
,
oneD
,&
CALL
abcof
(
input
,
atoms
,
sym
,
cell
,
lapw
,
noccbd
,
usdus
,
noco
,
nococonv
,
ispin
,
oneD
,&
eigVecCoeffs
%
acof
(:,
0
:,:,
ispin
),
eigVecCoeffs
%
bcof
(:,
0
:,:,
ispin
),&
eigVecCoeffs
%
ccof
(
-
atoms
%
llod
:,:,:,:,
ispin
),
zMat
,
eig
,
force
)
...
...
@@ -260,7 +261,7 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,st
CALL
eparas
(
ispin
,
atoms
,
noccbd
,
ev_list
,
mpi
,
ikpt
,
noccbd
,
we
,
eig
,&
skip_t
,
cdnvalJob
%
l_evp
,
eigVecCoeffs
,
usdus
,
regCharges
,
dos
,
banddos
%
l_mcd
,
mcd
)
IF
(
noco
%
l_mperp
.AND.
(
ispin
==
jsp_end
))
CALL
qal_21
(
atoms
,
input
,
noccbd
,
ev_list
,
noco
,
eigVecCoeffs
,
denCoeffsOffdiag
,
ikpt
,
dos
)
IF
(
noco
%
l_mperp
.AND.
(
ispin
==
jsp_end
))
CALL
qal_21
(
atoms
,
input
,
noccbd
,
ev_list
,
noco
conv
,
eigVecCoeffs
,
denCoeffsOffdiag
,
ikpt
,
dos
)
! layer charge of each valence state in this k-point of the SBZ from the mt-sphere region of the film
...
...
cdn/genNewNocoInp.f90
View file @
ad08f475
...
...
@@ -8,7 +8,7 @@ MODULE m_genNewNocoInp
CONTAINS
SUBROUTINE
genNewNocoInp
(
input
,
atoms
,
noco
,
noco_new
)
SUBROUTINE
genNewNocoInp
(
input
,
atoms
,
noco
,
noco
conv
,
nococonv
_new
)
USE
m_juDFT
USE
m_types
...
...
@@ -20,7 +20,8 @@ SUBROUTINE genNewNocoInp(input,atoms,noco,noco_new)
TYPE
(
t_input
),
INTENT
(
IN
)
::
input
TYPE
(
t_atoms
),
INTENT
(
IN
)
::
atoms
TYPE
(
t_noco
),
INTENT
(
IN
)
::
noco
TYPE
(
t_noco
),
INTENT
(
INOUT
)
::
noco_new
TYPE
(
t_nococonv
),
INTENT
(
IN
)
::
nococonv
TYPE
(
t_nococonv
),
INTENT
(
INOUT
)
::
nococonv_new
INTEGER
::
iAtom
,
iType
REAL
::
alphdiff
...
...
@@ -31,18 +32,18 @@ SUBROUTINE genNewNocoInp(input,atoms,noco,noco_new)
iAtom
=
1
DO
iType
=
1
,
atoms
%
ntype
IF
(
noco
%
l_ss
)
THEN
alphdiff
=
2.0
*
pi_const
*
(
noco
%
qss
(
1
)
*
atoms
%
taual
(
1
,
iAtom
)
+
&
noco
%
qss
(
2
)
*
atoms
%
taual
(
2
,
iAtom
)
+
&
noco
%
qss
(
3
)
*
atoms
%
taual
(
3
,
iAtom
)
)
noco
_new
%
alph
(
iType
)
=
noco
_new
%
alph
(
iType
)
-
alphdiff
DO
WHILE
(
noco_new
%
alph
(
iType
)
>
+
pi_const
)
noco
_new
%
alph
(
iType
)
=
noco
_new
%
alph
(
iType
)
-
2.0
*
pi_const
alphdiff
=
2.0
*
pi_const
*
(
noco
conv
%
qss
(
1
)
*
atoms
%
taual
(
1
,
iAtom
)
+
&
noco
conv
%
qss
(
2
)
*
atoms
%
taual
(
2
,
iAtom
)
+
&
noco
conv
%
qss
(
3
)
*
atoms
%
taual
(
3
,
iAtom
)
)
noco
conv_new
%
alph
(
iType
)
=
nococonv
_new
%
alph
(
iType
)
-
alphdiff
DO
WHILE
(
noco
conv
_new
%
alph
(
iType
)
>
+
pi_const
)
noco
conv_new
%
alph
(
iType
)
=
nococonv
_new
%
alph
(
iType
)
-
2.0
*
pi_const
END
DO
DO
WHILE
(
noco_new
%
alph
(
iType
)
<
-
pi_const
)
noco
_new
%
alph
(
iType
)
=
noco
_new
%
alph
(
iType
)
+
2.0
*
pi_const
DO
WHILE
(
noco
conv
_new
%
alph
(
iType
)
<
-
pi_const
)
noco
conv_new
%
alph
(
iType
)
=
nococonv
_new
%
alph
(
iType
)
+
2.0
*
pi_const
END
DO
ELSE
noco
_new
%
alph
(
iType
)
=
noco
_new
%
alph
(
iType
)
noco
conv_new
%
alph
(
iType
)
=
nococonv
_new
%
alph
(
iType
)
END
IF
iatom
=
iatom
+
atoms
%
neq
(
iType
)
END
DO
...
...
cdn/m_perp.f90
View file @
ad08f475
...
...
@@ -5,8 +5,8 @@
!--------------------------------------------------------------------------------
MODULE
m_m_perp
CONTAINS
SUBROUTINE
m_perp
(
atoms
,
itype
,
iRepAtom
,
noco
,
vr0
,
chmom
,
qa21
)
CONTAINS
SUBROUTINE
m_perp
(
atoms
,
itype
,
iRepAtom
,
noco
,
nococonv
,
vr0
,
chmom
,
qa21
)
!***********************************************************************
! calculates the perpendicular part of the local moment.
! if l_relax is true the angle of the output local moment is calculated
...
...
@@ -22,8 +22,9 @@ CONTAINS
USE
m_rotdenmat
USE
m_types
IMPLICIT
NONE
TYPE
(
t_noco
),
INTENT
(
INOUT
)
::
noco
TYPE
(
t_atoms
),
INTENT
(
IN
)
::
atoms
TYPE
(
t_noco
),
INTENT
(
IN
)
::
noco
TYPE
(
t_nococonv
),
INTENT
(
INOUT
)
::
nococonv
TYPE
(
t_atoms
),
INTENT
(
IN
)
::
atoms
! .. Scalar Arguments ..
INTEGER
,
INTENT
(
IN
)
::
itype
,
iRepAtom
...
...
@@ -45,9 +46,9 @@ CONTAINS
! angles in nocoinp file are (alph-alphdiff)
IF
(
noco
%
l_ss
)
THEN
alphdiff
=
2.0
*
pi_const
*
(
noco
%
qss
(
1
)
*
atoms
%
taual
(
1
,
iRepAtom
)
+
&
noco
%
qss
(
2
)
*
atoms
%
taual
(
2
,
iRepAtom
)
+
&
noco
%
qss
(
3
)
*
atoms
%
taual
(
3
,
iRepAtom
)
)
alphdiff
=
2.0
*
pi_const
*
(
noco
conv
%
qss
(
1
)
*
atoms
%
taual
(
1
,
iRepAtom
)
+
&
noco
conv
%
qss
(
2
)
*
atoms
%
taual
(
2
,
iRepAtom
)
+
&
noco
conv
%
qss
(
3
)
*
atoms
%
taual
(
3
,
iRepAtom
)
)
ELSE
alphdiff
=
0.0
END
IF
...
...
@@ -71,23 +72,23 @@ CONTAINS
rho11
=
chmom
(
itype
,
1
)
rho22
=
chmom
(
itype
,
2
)
rho21
=
qa21
(
itype
)
CALL
rot_den_mat
(
noco
%
alph
(
itype
),
noco
%
beta
(
itype
),
rho11
,
rho22
,
rho21
)
CALL
rot_den_mat
(
noco
conv
%
alph
(
itype
),
nococonv
%
beta
(
itype
),
rho11
,
rho22
,
rho21
)
!---> determine the polar angles of the mom. vec. in the global frame
mx
=
2
*
REAL
(
rho21
)
my
=
2
*
AIMAG
(
rho21
)
mz
=
rho11
-
rho22
CALL
pol_angle
(
mx
,
my
,
mz
,
betah
,
alphh
)
WRITE
(
6
,
8027
)
noco
%
beta
(
itype
),
noco
%
alph
(
itype
)
-
alphdiff
WRITE
(
6
,
8027
)
noco
conv
%
beta
(
itype
),
nococonv
%
alph
(
itype
)
-
alphdiff
WRITE
(
6
,
8028
)
betah
,
alphh
-
alphdiff
8027
FORMAT
(
2x
,
'-->'
,
10x
,
' input noco
%beta='
,
f9.5
,
' input noco
%alpha='
,
f9.5
)
8028
FORMAT
(
2x
,
'-->'
,
10x
,
'output noco
%beta='
,
f9.5
,
' output noco
%alpha='
,
f9.5
)
8027
FORMAT
(
2x
,
'-->'
,
10x
,
' input noco
conv%beta='
,
f9.5
,
' input nococonv
%alpha='
,
f9.5
)
8028
FORMAT
(
2x
,
'-->'
,
10x
,
'output noco
conv%beta='
,
f9.5
,
' output nococonv
%alpha='
,
f9.5
)
! ff do the same for mixed density: rho21 = mix_b * rho21
rho11
=
chmom
(
itype
,
1
)
rho22
=
chmom
(
itype
,
2
)
rho21
=
qa21
(
itype
)
rho21
=
noco
%
mix_b
*
rho21
CALL
rot_den_mat
(
noco
%
alph
(
itype
),
noco
%
beta
(
itype
),
rho11
,
rho22
,
rho21
)
CALL
rot_den_mat
(
noco
conv
%
alph
(
itype
),
nococonv
%
beta
(
itype
),
rho11
,
rho22
,
rho21
)
!---> determine the polar angles of the mom. vec. in the global frame
mx_mix
=
2
*
REAL
(
rho21
)
my_mix
=
2
*
AIMAG
(
rho21
)
...
...
@@ -95,8 +96,8 @@ CONTAINS
WRITE
(
6
,
8031
)
mx_mix
,
my_mix
8031
FORMAT
(
2x
,
'--> global frame: '
,
'mixed mx='
,
f9.5
,
' mixed my='
,
f9.5
)
! if magnetic moment (in local frame!) is negative, direction of quantization
! has to be antiparallel!
mz_tmp
=
chmom
(
itype
,
1
)
-
chmom
(
itype
,
2
)
! has to be antiparallel!
mz_tmp
=
chmom
(
itype
,
1
)
-
chmom
(
itype
,
2
)
IF
(
mz_tmp
.LT.
0.0
)
THEN
mx_mix
=
(
-1.0
)
*
mx_mix
my_mix
=
(
-1.0
)
*
my_mix
...
...
@@ -105,9 +106,9 @@ CONTAINS
! calculate angles alpha and beta in global frame
CALL
pol_angle
(
mx_mix
,
my_mix
,
mz_mix
,
betah
,
alphh
)
WRITE
(
6
,
8029
)
betah
,
alphh
-
alphdiff
8029
FORMAT
(
2x
,
'-->'
,
10x
,
' new noco
%beta ='
,
f9.5
,
' new noco
%alpha ='
,
f9.5
)
noco
%
alph
(
itype
)
=
alphh
noco
%
beta
(
itype
)
=
betah
8029
FORMAT
(
2x
,
'-->'
,
10x
,
' new noco
conv%beta ='
,
f9.5
,
' new nococonv
%alpha ='
,
f9.5
)
noco
conv
%
alph
(
itype
)
=
alphh
noco
conv
%
beta
(
itype
)
=
betah
ENDIF
IF
(
noco
%
l_constr
)
THEN
...
...
@@ -123,10 +124,10 @@ CONTAINS
b_con_outx
=
scale
*
mx
b_con_outy
=
scale
*
my
!---> mix input and output constraint fields
WRITE
(
6
,
8100
)
noco
%
b_con
(
1
,
itype
),
noco
%
b_con
(
2
,
itype
)
WRITE
(
6
,
8100
)
noco
conv
%
b_con
(
1
,
itype
),
nococonv
%
b_con
(
2
,
itype
)
WRITE
(
6
,
8200
)
b_con_outx
,
b_con_outy
noco
%
b_con
(
1
,
itype
)
=
noco
%
b_con
(
1
,
itype
)
+
noco
%
mix_b
*
b_con_outx
noco
%
b_con
(
2
,
itype
)
=
noco
%
b_con
(
2
,
itype
)
+
noco
%
mix_b
*
b_con_outy
noco
conv
%
b_con
(
1
,
itype
)
=
nococonv
%
b_con
(
1
,
itype
)
+
noco
%
mix_b
*
b_con_outx
noco
conv
%
b_con
(
2
,
itype
)
=
nococonv
%
b_con
(
2
,
itype
)
+
noco
%
mix_b
*
b_con_outy
ENDIF
8100
FORMAT
(
2x
,
'-->'
,
10x
,
' input B_con_x='
,
f12.6
,
&
...
...
cdn/qal_21.f90
View file @
ad08f475
MODULE
m_qal21
MODULE
m_qal21
!***********************************************************************
! Calculates qal21 needed to determine the off-diagonal parts of the
! Calculates qal21 needed to determine the off-diagonal parts of the
! DOS
!***********************************************************************
!
CONTAINS
SUBROUTINE
qal_21
(
atoms
,
input
,
noccbd
,
ev_list
,
noco
,
eigVecCoeffs
,
denCoeffsOffdiag
,
ikpt
,
dos
)
SUBROUTINE
qal_21
(
atoms
,
input
,
noccbd
,
ev_list
,
noco
conv
,
eigVecCoeffs
,
denCoeffsOffdiag
,
ikpt
,
dos
)
use
m_types_nococonv
USE
m_types_setup
USE
m_types_dos
USE
m_types_cdnval
,
ONLY
:
t_eigVecCoeffs
USE
m_types_cdnval
,
ONLY
:
t_eigVecCoeffs
USE
m_types_denCoeffsOffdiag
USE
m_rotdenmat
use
m_constants
IMPLICIT
NONE
TYPE
(
t_input
),
INTENT
(
IN
)
::
input
TYPE
(
t_noco
),
INTENT
(
IN
)
::
noco
TYPE
(
t_noco
conv
),
INTENT
(
IN
)
::
nococonv
TYPE
(
t_atoms
),
INTENT
(
IN
)
::
atoms
TYPE
(
t_eigVecCoeffs
),
INTENT
(
IN
)
::
eigVecCoeffs
TYPE
(
t_denCoeffsOffdiag
),
INTENT
(
IN
)
::
denCoeffsOffdiag
...
...
@@ -52,7 +52,7 @@ CONTAINS
ls
:
DO
l
=
0
,
3
IF
(
i
==
1
)
THEN
ENDIF
sumaa
=
CMPLX
(
0.
,
0.
)
;
sumab
=
CMPLX
(
0.
,
0.
)
sumaa
=
CMPLX
(
0.
,
0.
)
;
sumab
=
CMPLX
(
0.
,
0.
)
sumbb
=
CMPLX
(
0.
,
0.
)
;
sumba
=
CMPLX
(
0.
,
0.
)
ll1
=
l
*
(
l
+1
)
ms
:
DO
m
=
-
l
,
l
...
...
@@ -65,7 +65,7 @@ CONTAINS
ENDDO
atoms_loop
ENDDO
ms
qal21
(
l
,
n
,
i
)
=
sumaa
*
denCoeffsOffdiag
%
uu21n
(
l
,
n
)
+
sumbb
*
denCoeffsOffdiag
%
dd21n
(
l
,
n
)
+
&
sumba
*
denCoeffsOffdiag
%
du21n
(
l
,
n
)
+
sumab
*
denCoeffsOffdiag
%
ud21n
(
l
,
n
)
sumba
*
denCoeffsOffdiag
%
du21n
(
l
,
n
)
+
sumab
*
denCoeffsOffdiag
%
ud21n
(
l
,
n
)
ENDDO
ls
nt1
=
nt1
+
atoms
%
neq
(
n
)
ENDDO
types_loop
...
...
@@ -92,13 +92,13 @@ CONTAINS
lm
=
ll1
+
m
DO
i
=
1
,
noccbd
qbclo
(
i
,
lo
,
ntyp
)
=
qbclo
(
i
,
lo
,
ntyp
)
+
&
eigVecCoeffs
%
bcof
(
i
,
lm
,
natom
,
1
)
*
CONJG
(
eigVecCoeffs
%
ccof
(
m
,
i
,
lo
,
natom
,
input
%
jspins
))
eigVecCoeffs
%
bcof
(
i
,
lm
,
natom
,
1
)
*
CONJG
(
eigVecCoeffs
%
ccof
(
m
,
i
,
lo
,
natom
,
input
%
jspins
))
qbclo
(
i
,
lo
,
ntyp
)
=
qbclo
(
i
,
lo
,
ntyp
)
+
&
eigVecCoeffs
%
ccof
(
m
,
i
,
lo
,
natom
,
1
)
*
CONJG
(
eigVecCoeffs
%
bcof
(
i
,
lm
,
natom
,
input
%
jspins
))
eigVecCoeffs
%
ccof
(
m
,
i
,
lo
,
natom
,
1
)
*
CONJG
(
eigVecCoeffs
%
bcof
(
i
,
lm
,
natom
,
input
%
jspins
))
qaclo
(
i
,
lo
,
ntyp
)
=
qaclo
(
i
,
lo
,
ntyp
)
+
&
eigVecCoeffs
%
acof
(
i
,
lm
,
natom
,
1
)
*
CONJG
(
eigVecCoeffs
%
ccof
(
m
,
i
,
lo
,
natom
,
input
%
jspins
))
eigVecCoeffs
%
acof
(
i
,
lm
,
natom
,
1
)
*
CONJG
(
eigVecCoeffs
%
ccof
(
m
,
i
,
lo
,
natom
,
input
%
jspins
))
qaclo
(
i
,
lo
,
ntyp
)
=
qaclo
(
i
,
lo
,
ntyp
)
+
&
eigVecCoeffs
%
ccof
(
m
,
i
,
lo
,
natom
,
1
)
*
CONJG
(
eigVecCoeffs
%
acof
(
i
,
lm
,
natom
,
input
%
jspins
))
eigVecCoeffs
%
ccof
(
m
,
i
,
lo
,
natom
,
1
)
*
CONJG
(
eigVecCoeffs
%
acof
(
i
,
lm
,
natom
,
input
%
jspins
))
ENDDO
ENDDO
DO
lop
=
1
,
atoms
%
nlo
(
ntyp
)
...
...
@@ -146,14 +146,14 @@ CONTAINS
!
! rotate into global frame
!
TYPE_loop
:
DO
n
=
1
,
atoms
%
ntype
chi
(
1
,
1
)
=
EXP
(
-
ImagUnit
*
noco
%
alph
(
n
)/
2
)
*
COS
(
noco
%
beta
(
n
)/
2
)
chi
(
1
,
2
)
=
-
EXP
(
-
ImagUnit
*
noco
%
alph
(
n
)/
2
)
*
SIN
(
noco
%
beta
(
n
)/
2
)
chi
(
2
,
1
)
=
EXP
(
ImagUnit
*
noco
%
alph
(
n
)/
2
)
*
SIN
(
noco
%
beta
(
n
)/
2
)
chi
(
2
,
2
)
=
EXP
(
ImagUnit
*
noco
%
alph
(
n
)/
2
)
*
COS
(
noco
%
beta
(
n
)/
2
)
TYPE_loop
:
DO
n
=
1
,
atoms
%
ntype
chi
(
1
,
1
)
=
EXP
(
-
ImagUnit
*
noco
conv
%
alph
(
n
)/
2
)
*
COS
(
nococonv
%
beta
(
n
)/
2
)
chi
(
1
,
2
)
=
-
EXP
(
-
ImagUnit
*
noco
conv
%
alph
(
n
)/
2
)
*
SIN
(
nococonv
%
beta
(
n
)/
2
)
chi
(
2
,
1
)
=
EXP
(
ImagUnit
*
noco
conv
%
alph
(
n
)/
2
)
*
SIN
(
nococonv
%
beta
(
n
)/
2
)
chi
(
2
,
2
)
=
EXP
(
ImagUnit
*
noco
conv
%
alph
(
n
)/
2
)
*
COS
(
nococonv
%
beta
(
n
)/
2
)
state
:
DO
i
=
1
,
noccbd
lls
:
DO
l
=
0
,
3
CALL
rot_den_mat
(
noco
%
alph
(
n
),
noco
%
beta
(
n
),&
CALL
rot_den_mat
(
noco
conv
%
alph
(
n
),
nococonv
%
beta
(
n
),&
dos
%
qal
(
l
,
n
,
ev_list
(
i
),
ikpt
,
1
),
dos
%
qal
(
l
,
n
,
ev_list
(
i
),
ikpt
,
2
),
qal21
(
l
,
n
,
i
))
IF
(
.FALSE.
)
THEN
IF
(
n
==
1
)
WRITE
(
*
,
'(3i3,4f10.5)'
)
l
,
n
,
i
,
qal21
(
l
,
n
,
i
),
dos
%
qal
(
l
,
n
,
ev_list
(
i
),
ikpt
,:)
...
...
cdn/vacden.F90
View file @
ad08f475
...
...
@@ -5,7 +5,7 @@ MODULE m_vacden
! vacuum charge density. speed up by r. wu 1992
! *************************************************************
CONTAINS
SUBROUTINE
vacden
(
vacuum
,
stars
,
oneD
,
kpts
,
input
,
sym
,
cell
,
atoms
,
noco
,
banddos
,&
SUBROUTINE
vacden
(
vacuum
,
stars
,
oneD
,
kpts
,
input
,
sym
,
cell
,
atoms
,
noco
,
nococonv
,
banddos
,&
gVacMap
,
we
,
ikpt
,
jspin
,
vz
,
ne
,
ev_list
,
lapw
,
evac
,
eig
,
den
,
zMat
,
dos
)
!***********************************************************************
...
...
@@ -54,6 +54,7 @@ CONTAINS
TYPE
(
t_input
),
INTENT
(
IN
)
::
input
TYPE
(
t_vacuum
),
INTENT
(
IN
)
::
vacuum
TYPE
(
t_noco
),
INTENT
(
IN
)
::
noco
TYPE
(
t_nococonv
),
INTENT
(
IN
)
::
nococonv
TYPE
(
t_stars
),
INTENT
(
IN
)
::
stars
TYPE
(
t_sym
),
INTENT
(
IN
)
::
sym
TYPE
(
t_cell
),
INTENT
(
IN
)
::
cell
...
...
@@ -262,12 +263,12 @@ CONTAINS
!---> Thus, the vaccum wavefunctions and the A- and B-coeff. (ac bc)
!---> have to be calculated for both spins on that call.
!---> setup the spin-spiral q-vector
qssbti
(
1
,
1
)
=
-
noco
%
qss
(
1
)/
2
qssbti
(
2
,
1
)
=
-
noco
%
qss
(
2
)/
2
qssbti
(
1
,
2
)
=
+
noco
%
qss
(
1
)/
2
qssbti
(
2
,
2
)
=
+
noco
%
qss
(
2
)/
2
qssbti
(
3
,
1
)
=
-
noco
%
qss
(
3
)/
2
qssbti
(
3
,
2
)
=
+
noco
%
qss
(
3
)/
2
qssbti
(
1
,
1
)
=
-
noco
conv
%
qss
(
1
)/
2
qssbti
(
2
,
1
)
=
-
noco
conv
%
qss
(
2
)/
2
qssbti
(
1
,
2
)
=
+
noco
conv
%
qss
(
1
)/
2
qssbti
(
2
,
2
)
=
+
noco
conv
%
qss
(
2
)/
2
qssbti
(
3
,
1
)
=
-
noco
conv
%
qss
(
3
)/
2
qssbti
(
3
,
2
)
=
+
noco
conv
%
qss
(
3
)/
2
DO
ispin
=
1
,
input
%
jspins
! -----> set up vacuum wave functions
IF
(
oneD
%
odi
%
d1
)
THEN
...
...
cdn_mt/abcof.F90
View file @
ad08f475
MODULE
m_abcof
CONTAINS
SUBROUTINE
abcof
(
input
,
atoms
,
sym
,
cell
,
lapw
,
ne
,
usdus
,&
noco
,
jspin
,
oneD
,
acof
,
bcof
,
ccof
,
zMat
,
eig
,
force
)
noco
,
nococonv
,
jspin
,
oneD
,
acof
,
bcof
,
ccof
,
zMat
,
eig
,
force
)
! ************************************************************
! subroutine constructs the a,b coefficients of the linearized
! m.t. wavefunctions for each band and atom. c.l. fu
...
...
@@ -22,6 +22,7 @@ CONTAINS
TYPE
(
t_lapw
),
INTENT
(
IN
)
::
lapw
TYPE
(
t_oneD
),
INTENT
(
IN
)
::
oneD
TYPE
(
t_noco
),
INTENT
(
IN
)
::
noco
TYPE
(
t_nococonv
),
INTENT
(
IN
)::
nococonv
TYPE
(
t_sym
),
INTENT
(
IN
)
::
sym
TYPE
(
t_cell
),
INTENT
(
IN
)
::
cell
TYPE
(
t_atoms
),
INTENT
(
IN
)
::
atoms
...
...
@@ -105,9 +106,9 @@ CONTAINS
nvmax
=
lapw
%
nv
(
jspin
)
IF
(
noco
%
l_ss
)
nvmax
=
lapw
%
nv
(
iintsp
)
IF
(
iintsp
.EQ.
1
)
THEN
qss
=
-
noco
%
qss
/
2
qss
=
-
noco
conv
%
qss
/
2
ELSE
qss
=
+
noco
%
qss
/
2
qss
=
+
noco
conv
%
qss
/
2
ENDIF
!---> loop over atom types
...
...
@@ -115,11 +116,11 @@ CONTAINS
!$OMP& DEFAULT(none)&
!$OMP& PRIVATE(n,nn,natom,k,i,work_r,work_c,ccchi,kspin,fg,fk,s,r1,fj,dfj,l,df,wronk,tmk,phase,lo,nkvec,&
!$OMP& alo1,blo1,clo1,inap,nap,j,fgr,fgp,s2h,s2h_e,fkr,fkp,ylm,ll1,m,c_0,c_1,c_2,jatom,lmp,inv_f,lm)&
!$OMP& SHARED(noco,atoms,sym,cell,oneD,lapw,nvmax,ne,zMat,usdus,iintsp,eig,l_force,&
!$OMP& SHARED(noco,
nococonv,
atoms,sym,cell,oneD,lapw,nvmax,ne,zMat,usdus,iintsp,eig,l_force,&
!$OMP& jspin,qss,apw,const,nbasf0,enough,acof,bcof,ccof,force)
DO
n
=
1
,
atoms
%
ntype
CALL
setabc1lo
(
atoms
,
n
,
usdus
,
jspin
,
alo1
,
blo1
,
clo1
)
! ----> loop over equivalent atoms
DO
nn
=
1
,
atoms
%
neq
(
n
)
natom
=
0
...
...
@@ -145,10 +146,10 @@ CONTAINS
IF
(
noco
%
l_noco
)
THEN
!---> generate the spinors (chi)
ccchi
(
1
,
1
)
=
EXP
(
ImagUnit
*
noco
%
alph
(
n
)/
2
)
*
COS
(
noco
%
beta
(
n
)/
2
)
ccchi
(
1
,
2
)
=
-
EXP
(
ImagUnit
*
noco
%
alph
(
n
)/
2
)
*
SIN
(
noco
%
beta
(
n
)/
2
)
ccchi
(
2
,
1
)
=
EXP
(
-
ImagUnit
*
noco
%
alph
(
n
)/
2
)
*
SIN
(
noco
%
beta
(
n
)/
2
)
ccchi
(
2
,
2
)
=
EXP
(
-
ImagUnit
*
noco
%
alph
(
n
)/
2
)
*
COS
(
noco
%
beta
(
n
)/
2
)
ccchi
(
1
,
1
)
=
EXP
(
ImagUnit
*
noco
conv
%
alph
(
n
)/
2
)
*
COS
(
nococonv
%
beta
(
n
)/
2
)
ccchi
(
1
,
2
)
=
-
EXP
(
ImagUnit
*
noco
conv
%
alph
(
n
)/
2
)
*
SIN
(
nococonv
%
beta
(
n
)/
2
)
ccchi
(
2
,
1
)
=
EXP
(
-
ImagUnit
*
noco
conv
%
alph
(
n
)/
2
)
*
SIN
(
nococonv
%
beta
(
n
)/
2
)
ccchi
(
2
,
2
)
=
EXP
(
-
ImagUnit
*
noco
conv
%
alph
(
n
)/
2
)
*
COS
(
nococonv
%
beta
(
n
)/
2
)
IF
(
noco
%
l_ss
)
THEN
!---> the coefficients of the spin-down basis functions are
!---> stored in the second half of the eigenvector
...
...
@@ -289,7 +290,7 @@ CONTAINS
ENDDO
! loop over LAPWs
IF
(
zmat
%
l_real
)
THEN
DEALLOCATE
(
work_r
)
ELSE
ELSE
DEALLOCATE
(
work_c
)
ENDIF
ENDIF
! invsatom == ( 0 v 1 )
...
...
cdn_mt/alignSpinAxisMagn.f90
View file @
ad08f475
...
...
@@ -21,10 +21,11 @@ IMPLICIT NONE
CONTAINS
SUBROUTINE
rotateMagnetToSpinAxis
(
vacuum
,
sphhar
,
stars
&
,
sym
,
oneD
,
cell
,
noco
,
input
,
atoms
,
den
)
,
sym
,
oneD
,
cell
,
noco
,
nococonv
,
input
,
atoms
,
den
)
TYPE
(
t_input
),
INTENT
(
IN
)
::
input
TYPE
(
t_atoms
),
INTENT
(
IN
)
::
atoms
TYPE
(
t_noco
),
INTENT
(
INOUT
)
::
noco
TYPE
(
t_atoms
),
INTENT
(
IN
)
::
atoms
TYPE
(
t_noco
),
INTENT
(
IN
)
::
noco
TYPE
(
t_nococonv
),
INTENT
(
INOUT
)::
nococonv
TYPE
(
t_stars
),
INTENT
(
IN
)
::
stars
TYPE
(
t_vacuum
),
INTENT
(
IN
)
::
vacuum
TYPE
(
t_sphhar
),
INTENT
(
IN
)
::
sphhar
...
...
@@ -36,12 +37,12 @@ SUBROUTINE rotateMagnetToSpinAxis(vacuum,sphhar,stars&
REAL
::
moments
(
3
,
atoms
%
ntype
)
REAL
::
phiTemp
(
atoms
%
ntype
),
thetaTemp
(
atoms
%
ntype
)
INTEGER
::
i
!!TEMP
! REAL :: x,y,z
phiTemp
=
noco
%
alph
thetaTemp
=
noco
%
beta
phiTemp
=
noco
conv
%
alph
thetaTemp
=
noco
conv
%
beta
CALL
magnMomFromDen
(
input
,
atoms
,
noco
,
den
,
moments
,
thetaTemp
,
phiTemp
)
!DO i=1, atoms%ntype
! IF (abs(atoms%theta_mt_avg(i)).LE. 0.0001) THEN
...
...
@@ -67,33 +68,34 @@ SUBROUTINE rotateMagnetToSpinAxis(vacuum,sphhar,stars&
!write(*,*) atoms%phi_mt_avg
!write(*,*) "atoms%theta_mt_avg"
!write(*,*) atoms%theta_mt_avg
noco
%
alph
=
mod
(
noco
%
alph
+
phiTemp
,
2
*
pimach
())
noco
%
beta
=
mod
(
noco
%
beta
+
thetaTemp
,
pimach
())
noco
conv
%
alph
=
mod
(
nococonv
%
alph
+
phiTemp
,
2
*
pimach
())
noco
conv
%
beta
=
mod
(
nococonv
%
beta
+
thetaTemp
,
pimach
())
!DO i=1, atoms%ntype
! IF(noco
%alph(i)<0) noco%alph(i)=noco
%alph(i)+2*pi
! IF(noco%beta(i)<0) THEN
! noco
%beta(i)=-noco
%beta(i)
! noco
%alph=noco
%alph+pi
! IF(noco
conv%alph(i)<0) nococonv%alph(i)=nococonv
%alph(i)+2*pi
! IF(noco
conv
%beta(i)<0) THEN
! noco
conv%beta(i)=-nococonv
%beta(i)
! noco
conv%alph=nococonv
%alph+pi
!END IF
! IF(noco%beta(i)>pi) THEN
! noco
%beta(i)=pi-mod(noco
%beta(i),pi)
! noco
%alph(i)=noco
%alph(i)+pi
! IF(noco
conv
%beta(i)>pi) THEN
! noco
conv%beta(i)=pi-mod(nococonv
%beta(i),pi)
! noco
conv%alph(i)=nococonv
%alph(i)+pi
! END IF
! noco
%alph=mod(noco
%alph,2*pi)
! noco
conv%alph=mod(nococonv
%alph,2*pi)
!End Do
write
(
*
,
*
)
"Noco Phi"
write
(
*
,
*
)
noco
%
alph
write
(
*
,
*
)
noco
conv
%
alph
write
(
*
,
*
)
"Noco Theta"
write
(
*
,
*
)
noco
%
beta
write
(
*
,
*
)
noco
conv
%
beta
END
SUBROUTINE
rotateMagnetToSpinAxis
SUBROUTINE
rotateMagnetFromSpinAxis
(
noco
,
vacuum
,
sphhar
,
stars
&
SUBROUTINE
rotateMagnetFromSpinAxis
(
noco
,
nococonv
,
vacuum
,
sphhar
,
stars
&
,
sym
,
oneD
,
cell
,
input
,
atoms
,
den
,
inDen
)
TYPE
(
t_input
),
INTENT
(
IN
)
::
input
TYPE
(
t_atoms
),
INTENT
(
IN
)
::
atoms
TYPE
(
t_noco
),
INTENT
(
INOUT
)
::
noco
TYPE
(
t_stars
),
INTENT
(
IN
)
::
stars
TYPE
(
t_noco
),
INTENT
(
IN
)
::
noco
TYPE
(
t_nococonv
),
INTENT
(
INOUT
)
::
nococonv
TYPE
(
t_stars
),
INTENT
(
IN
)
::
stars
TYPE
(
t_vacuum
),
INTENT
(
IN
)
::
vacuum
TYPE
(
t_sphhar
),
INTENT
(
IN
)
::
sphhar
TYPE
(
t_sym
),
INTENT
(
IN
)
::
sym
...
...
@@ -102,11 +104,11 @@ SUBROUTINE rotateMagnetFromSpinAxis(noco,vacuum,sphhar,stars&
TYPE
(
t_potden
),
INTENT
(
INOUT
)
::
den
,
inDen
CALL
flipcdn
(
atoms
,
input
,
vacuum
,
sphhar
,
stars
,
sym
,
noco
,
oneD
,
cell
,
noco
%
alph
,
noco
%
beta
,
den
)
CALL
flipcdn
(
atoms
,
input
,
vacuum
,
sphhar
,
stars
,
sym
,
noco
,
oneD
,
cell
,
noco
%
alph
,
noco
%
beta
,
inDen
)
CALL
flipcdn
(
atoms
,
input
,
vacuum
,
sphhar
,
stars
,
sym
,
noco
,
oneD
,
cell
,
noco
conv
%
alph
,
nococonv
%
beta
,
den
)
CALL
flipcdn
(
atoms
,
input
,
vacuum
,
sphhar
,
stars
,
sym
,
noco
,
oneD
,
cell
,
noco
conv
%
alph
,
nococonv
%
beta
,
inDen
)
noco
%
alph
=
0
noco
%
beta
=
0
noco
conv
%
alph
=
0
noco
conv
%
beta
=
0
END
SUBROUTINE
rotateMagnetFromSpinAxis
...
...
cdn_mt/cdncore.F90
View file @
ad08f475
...
...
@@ -8,7 +8,7 @@ MODULE m_cdncore
CONTAINS
SUBROUTINE
cdncore
(
mpi
,
oneD
,
input
,
vacuum
,
noco
,
sym
,&
SUBROUTINE
cdncore
(
mpi
,
oneD
,
input
,
vacuum
,
noco
,
nococonv
,
sym
,&
stars
,
cell
,
sphhar
,
atoms
,
vTot
,
outDen
,
moments
,
results
,
EnergyDen
)
USE
m_constants
...
...
@@ -29,11 +29,12 @@ SUBROUTINE cdncore(mpi,oneD,input,vacuum,noco,sym,&
TYPE
(
t_mpi
),
INTENT
(
IN
)
::
mpi
TYPE
(
t_oneD
),
INTENT
(
IN
)
::
oneD
TYPE
(
t_input
),
INTENT
(
IN
)
::
input
TYPE
(
t_vacuum
),
INTENT
(
IN
)
::
vacuum
TYPE
(
t_noco
),
INTENT
(
IN
)
::
noco
TYPE
(
t_nococonv
),
INTENT
(
IN
)
::
nococonv
TYPE
(
t_sym
),
INTENT
(
IN
)
::
sym
TYPE
(
t_stars
),
INTENT
(
IN
)
::
stars
TYPE
(
t_cell
),
INTENT
(
IN
)
::
cell
...
...
@@ -121,13 +122,13 @@ SUBROUTINE cdncore(mpi,oneD,input,vacuum,noco,sym,&
rhoint
=
(
qint
(
iType
,
1
)
+
qint
(
iType
,
2
))
/(
cell
%
volint
*
input
%
jspins
*
2.0
)
momint
=
(
qint
(
iType
,
1
)
-
qint
(
iType
,
2
))
/(
cell
%
volint
*
input
%
jspins
*
2.0
)
!rho_11
outDen
%
pw
(
1
,
1
)
=
outDen
%
pw
(
1
,
1
)
+
rhoint
+
momint
*
cos
(
noco
%
beta
(
iType
))
outDen
%
pw
(
1
,
1
)
=
outDen
%
pw
(
1
,
1
)
+
rhoint
+
momint
*
cos
(
noco
conv
%
beta
(
iType
))
!rho_22
outDen
%
pw
(
1
,
2
)
=
outDen
%
pw
(
1
,
2
)
+
rhoint
-
momint
*
cos
(
noco
%
beta
(
iType
))
outDen
%
pw
(
1
,
2
)
=
outDen
%
pw
(
1
,
2
)
+
rhoint
-
momint
*
cos
(
noco
conv
%
beta
(
iType
))
!real part rho_21
outDen
%
pw
(
1
,
3
)
=
outDen
%
pw
(
1
,
3
)
+
cmplx
(
0.5
*
momint
*
cos
(
noco
%
alph
(
iType
))
*
sin
(
noco
%
beta
(
iType
)),&
outDen
%
pw
(
1
,
3
)
=
outDen
%
pw
(
1
,
3
)
+
cmplx
(
0.5
*
momint
*
cos
(
noco
conv
%
alph
(
iType
))
*
sin
(
nococonv
%
beta
(
iType
)),&
!imaginary part rho_21
-0.5
*
momint
*
sin
(
noco
%
alph
(
iType
))
*
sin
(
noco
%
beta
(
iType
)))
-0.5
*
momint
*
sin
(
noco
conv
%
alph
(
iType
))
*
sin
(
nococonv
%
beta
(
iType
)))
END
DO
!pk non-collinear (end)
END
IF
...
...
cdn_mt/magDiMom.f90
View file @
ad08f475
...
...
@@ -15,7 +15,7 @@ CONTAINS
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
SUBROUTINE
magDiMom
(
sym
,
input
,
atoms
,
sphhar
,
noco
,
l_fmpl2
,
rho
,
magDipoles
,
elecDipoles
)
SUBROUTINE
magDiMom
(
sym
,
input
,
atoms
,
sphhar
,
noco
,
nococonv
,
l_fmpl2
,
rho
,
magDipoles
,
elecDipoles
)
USE
m_constants
USE
m_types
...
...
@@ -31,6 +31,7 @@ SUBROUTINE magDiMom(sym,input,atoms,sphhar,noco,l_fmpl2,rho,magDipoles,elecDipol
TYPE
(
t_atoms
),
INTENT
(
IN
)
::
atoms
TYPE
(
t_sphhar
),
INTENT
(
IN
)
::
sphhar
TYPE
(
t_noco
),
INTENT
(
IN
)
::
noco
TYPE
(
t_nococonv
),
INTENT
(
IN
)
::
nococonv
REAL
,
INTENT
(
IN
)
::
rho
(:,
0
:,:,:)
! if l_fmpl last dimension is 4, otherwise 2.
LOGICAL
,
INTENT
(
IN
)
::
l_fmpl2
...
...
@@ -56,8 +57,8 @@ SUBROUTINE magDiMom(sym,input,atoms,sphhar,noco,l_fmpl2,rho,magDipoles,elecDipol
ALLOCATE
(
inRho
(
atoms
%
jmtd
,
0
:
sphhar
%
nlhd
,
atoms
%
ntype
,
4
))
DO
iType
=
1
,
atoms
%
ntype
IF
(
.NOT.
l_fmpl2
)
THEN
theta
=
noco
%
beta
(
iType
)
phi
=
noco
%
alph
(
iType
)
theta
=