Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Support
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
fleur
Project overview
Project overview
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
0
Issues
0
List
Boards
Labels
Milestones
Merge Requests
0
Merge Requests
0
Packages
Packages
Container Registry
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Commits
Issue Boards
Open sidebar
Anoop Chandran
fleur
Commits
3e24dd1b
Commit
3e24dd1b
authored
Mar 28, 2018
by
Daniel Wortmann
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Modified the SOC part. Some routines can still be deleted. theta/phi are arrays now for
DMI calculations.
parent
ebc860cc
Changes
32
Hide whitespace changes
Inline
Side-by-side
Showing
32 changed files
with
257 additions
and
478 deletions
+257
-478
cdn_mt/orbMagMoms.f90
cdn_mt/orbMagMoms.f90
+3
-2
core/coredr.F90
core/coredr.F90
+0
-1
diagonalization/scalapack.F90
diagonalization/scalapack.F90
+6
-3
eigen/CMakeLists.txt
eigen/CMakeLists.txt
+0
-1
eigen/mt_setup.F90
eigen/mt_setup.F90
+2
-2
eigen_soc/CMakeLists.txt
eigen_soc/CMakeLists.txt
+1
-1
eigen_soc/alineso.F90
eigen_soc/alineso.F90
+4
-21
eigen_soc/eigenso.F90
eigen_soc/eigenso.F90
+8
-91
eigen_soc/hsoham.f90
eigen_soc/hsoham.f90
+17
-35
eigen_soc/soinit.f90
eigen_soc/soinit.f90
+10
-16
eigen_soc/sorad.f90
eigen_soc/sorad.f90
+20
-26
eigen_soc/spnorb.f90
eigen_soc/spnorb.f90
+73
-52
force/geo.f90
force/geo.f90
+1
-56
init/dimen7.F90
init/dimen7.F90
+3
-3
init/mapatom.F90
init/mapatom.F90
+1
-1
init/postprocessInput.F90
init/postprocessInput.F90
+1
-1
inpgen/inpgen.f90
inpgen/inpgen.f90
+4
-4
inpgen/set_inp.f90
inpgen/set_inp.f90
+2
-4
io/calculator.f
io/calculator.f
+22
-2
io/inpnoco.F90
io/inpnoco.F90
+1
-1
io/r_inpXML.F90
io/r_inpXML.F90
+12
-12
io/rw_inp.f90
io/rw_inp.f90
+4
-46
io/rw_noco.f90
io/rw_noco.f90
+9
-9
io/w_inpXML.f90
io/w_inpXML.f90
+17
-9
main/fleur_init.F90
main/fleur_init.F90
+0
-1
types/types_misc.F90
types/types_misc.F90
+6
-6
types/types_tlmplm.F90
types/types_tlmplm.F90
+1
-0
wannier/uhu/wann_uHu.F
wannier/uhu/wann_uHu.F
+5
-5
wannier/uhu/wann_uHu_dmi.F
wannier/uhu/wann_uHu_dmi.F
+7
-7
wannier/wann_socmat.F
wannier/wann_socmat.F
+7
-49
wannier/wann_updown.F
wannier/wann_updown.F
+3
-4
wannier/wannier.F
wannier/wannier.F
+7
-7
No files found.
cdn_mt/orbMagMoms.f90
View file @
3e24dd1b
...
...
@@ -25,8 +25,9 @@ SUBROUTINE orbMagMoms(dimension,atoms,noco,clmom)
REAL
::
thetai
,
phii
,
slmom
,
slxmom
,
slymom
CHARACTER
(
LEN
=
20
)
::
attributes
(
4
)
thetai
=
noco
%
theta
phii
=
noco
%
phi
thetai
=
noco
%
theta
(
1
)
!only single spin-qant-axis supported here
phii
=
noco
%
phi
(
1
)
WRITE
(
6
,
FMT
=
9020
)
WRITE
(
16
,
FMT
=
9020
)
CALL
openXMLElement
(
'orbitalMagneticMomentsInMTSpheres'
,(/
'units'
/),(/
'muBohr'
/))
...
...
core/coredr.F90
View file @
3e24dd1b
...
...
@@ -10,7 +10,6 @@ CONTAINS
USE
m_spratm
USE
m_ccdnup
USE
m_cdn_io
USE
m_types
IMPLICIT
NONE
TYPE
(
t_dimension
),
INTENT
(
IN
)
::
DIMENSION
...
...
diagonalization/scalapack.F90
View file @
3e24dd1b
...
...
@@ -93,9 +93,12 @@ CONTAINS
CALL
ev_dist
%
init
(
hmat
%
l_real
,
hmat
%
global_size1
,
hmat
%
global_size2
,
hmat
%
mpi_com
,
.TRUE.
)
smat
%
blacs_desc
(
2
)
=
hmat
%
blacs_desc
(
2
)
ev_dist
%
blacs_desc
(
2
)
=
hmat
%
blacs_desc
(
2
)
!smat%blacs_desc(2) = hmat%blacs_desc(2)
!ev_dist%blacs_desc(2) = hmat%blacs_desc(2)
smat
%
blacs_desc
=
hmat
%
blacs_desc
ev_dist
%
blacs_desc
=
hmat
%
blacs_desc
nb
=
hmat
%
blacs_desc
(
5
)
! Blocking factor
IF
(
nb
.NE.
hmat
%
blacs_desc
(
6
))
CALL
judft_error
(
"Different block sizes for rows/columns not supported"
)
...
...
eigen/CMakeLists.txt
View file @
3e24dd1b
...
...
@@ -7,7 +7,6 @@ eigen/hlomat.F90
eigen/hs_int.F90
eigen/hsmt_fjgj.F90
eigen/hsmt_ab.f90
eigen/soc_init.f90
eigen/hsmt_sph.F90
eigen/hsmt_nonsph.F90
eigen/hsmt_spinor.F90
...
...
eigen/mt_setup.F90
View file @
3e24dd1b
...
...
@@ -12,7 +12,7 @@ CONTAINS
USE
m_tlmplm_cholesky
USE
m_tlmplm_store
USE
m_types
USE
m_s
ocinit
USE
m_s
pnorb
IMPLICIT
NONE
TYPE
(
t_results
),
INTENT
(
INOUT
)::
results
TYPE
(
t_mpi
),
INTENT
(
IN
)
::
mpi
...
...
@@ -48,7 +48,7 @@ CONTAINS
!Setup of soc parameters for first-variation SOC
IF
(
noco
%
l_soc
.AND.
noco
%
l_noco
.AND..NOT.
noco
%
l_ss
)
THEN
CALL
s
ocinit
(
mpi
,
atoms
,
sphhar
,
enpara
,
input
,
vTot
%
mt
,
noco
,
ud
,
td
%
rsoc
)
CALL
s
pnorb
(
atoms
,
noco
,
input
,
mpi
,
enpara
,
vTot
%
mt
,
ud
,
td
%
rsoc
,
.FALSE.
)
END
IF
END
SUBROUTINE
mt_setup
...
...
eigen_soc/CMakeLists.txt
View file @
3e24dd1b
...
...
@@ -7,9 +7,9 @@ eigen_soc/eigenso.F90
eigen_soc/hsoham.f90
eigen_soc/hsohelp.F90
eigen_soc/sgml.f90
eigen_soc/soinit.f90
eigen_soc/sointg.f90
eigen_soc/sorad.f90
eigen_soc/spnorb.f90
eigen_soc/vso.f90
eigen_soc/ssomat.F90
)
eigen_soc/alineso.F90
View file @
3e24dd1b
...
...
@@ -8,12 +8,8 @@ MODULE m_alineso
CONTAINS
SUBROUTINE
alineso
(
eig_id
,
lapw
,&
mpi
,
DIMENSION
,
atoms
,
sym
,
kpts
,&
input
,
noco
,
cell
,
oneD
,&
rsopp
,
rsoppd
,
rsopdp
,
rsopdpd
,
nk
,&
rsoplop
,
rsoplopd
,
rsopdplo
,
rsopplo
,
rsoploplop
,&
usdus
,
soangl
,&
nsize
,
nmat
,&
eig_so
,
zso
)
input
,
noco
,
cell
,
oneD
,
nk
,
usdus
,
rsoc
,&
nsize
,
nmat
,
eig_so
,
zso
)
#include"cpp_double.h"
USE
m_hsohelp
...
...
@@ -32,6 +28,7 @@ CONTAINS
TYPE
(
t_atoms
),
INTENT
(
IN
)
::
atoms
TYPE
(
t_kpts
),
INTENT
(
IN
)
::
kpts
TYPE
(
t_usdus
),
INTENT
(
IN
)
::
usdus
TYPE
(
t_rsoc
),
INTENT
(
IN
)
::
rsoc
! ..
! .. Scalar Arguments ..
INTEGER
,
INTENT
(
IN
)
::
eig_id
...
...
@@ -39,16 +36,6 @@ CONTAINS
INTEGER
,
INTENT
(
OUT
)::
nsize
,
nmat
! ..
! .. Array Arguments ..
REAL
,
INTENT
(
IN
)
::
rsopp
(
atoms
%
ntype
,
atoms
%
lmaxd
,
2
,
2
)
REAL
,
INTENT
(
IN
)
::
rsoppd
(
atoms
%
ntype
,
atoms
%
lmaxd
,
2
,
2
)
REAL
,
INTENT
(
IN
)
::
rsopdp
(
atoms
%
ntype
,
atoms
%
lmaxd
,
2
,
2
)
REAL
,
INTENT
(
IN
)
::
rsopdpd
(
atoms
%
ntype
,
atoms
%
lmaxd
,
2
,
2
)
REAL
,
INTENT
(
IN
)
::
rsoplop
(
atoms
%
ntype
,
atoms
%
nlod
,
2
,
2
)
REAL
,
INTENT
(
IN
)
::
rsoplopd
(
atoms
%
ntype
,
atoms
%
nlod
,
2
,
2
)
REAL
,
INTENT
(
IN
)
::
rsopdplo
(
atoms
%
ntype
,
atoms
%
nlod
,
2
,
2
)
REAL
,
INTENT
(
IN
)
::
rsopplo
(
atoms
%
ntype
,
atoms
%
nlod
,
2
,
2
)
REAL
,
INTENT
(
IN
)
::
rsoploplop
(
atoms
%
ntype
,
atoms
%
nlod
,
atoms
%
nlod
,
2
,
2
)
COMPLEX
,
INTENT
(
IN
)
::
soangl
(
atoms
%
lmaxd
,
-
atoms
%
lmaxd
:
atoms
%
lmaxd
,
2
,
atoms
%
lmaxd
,
-
atoms
%
lmaxd
:
atoms
%
lmaxd
,
2
)
COMPLEX
,
INTENT
(
OUT
)
::
zso
(:,:,:)
!(dimension%nbasfcn,2*dimension%neigd,wannierspin)
REAL
,
INTENT
(
OUT
)
::
eig_so
(
2
*
DIMENSION
%
neigd
)
!-odim
...
...
@@ -167,11 +154,7 @@ CONTAINS
CALL
timestart
(
"alineso SOC: -ham"
)
ALLOCATE
(
hsomtx
(
2
,
2
,
DIMENSION
%
neigd
,
DIMENSION
%
neigd
)
)
CALL
hsoham
(&
&
atoms
,
noco
,
input
,
nsz
,
chelp
,&
&
rsoplop
,
rsoplopd
,
rsopdplo
,
rsopplo
,
rsoploplop
,&
&
ahelp
,
bhelp
,
rsopp
,
rsoppd
,
rsopdp
,
rsopdpd
,
soangl
,&
&
hsomtx
)
CALL
hsoham
(
atoms
,
noco
,
input
,
nsz
,
chelp
,
rsoc
,
ahelp
,
bhelp
,
hsomtx
)
DEALLOCATE
(
ahelp
,
bhelp
,
chelp
)
CALL
timestop
(
"alineso SOC: -ham"
)
!
...
...
eigen_soc/eigenso.F90
View file @
3e24dd1b
...
...
@@ -27,6 +27,7 @@ CONTAINS
USE
m_spnorb
USE
m_alineso
USE
m_types
USE
m_judft
#ifdef CPP_MPI
USE
m_mpi_bc_pot
#endif
...
...
@@ -62,13 +63,9 @@ CONTAINS
! .. Local Arrays..
CHARACTER
*
3
chntype
REAL
,
ALLOCATABLE
::
rsopdp
(:,:,:,:),
rsopdpd
(:,:,:,:)
REAL
,
ALLOCATABLE
::
rsopp
(:,:,:,:),
rsoppd
(:,:,:,:)
TYPE
(
t_rsoc
)
::
rsoc
REAL
,
ALLOCATABLE
::
eig_so
(:)
REAL
,
ALLOCATABLE
::
rsoplop
(:,:,:,:)
REAL
,
ALLOCATABLE
::
rsoplopd
(:,:,:,:),
rsopdplo
(:,:,:,:)
REAL
,
ALLOCATABLE
::
rsopplo
(:,:,:,:),
rsoploplop
(:,:,:,:,:)
COMPLEX
,
ALLOCATABLE
::
zso
(:,:,:),
soangl
(:,:,:,:,:,:)
COMPLEX
,
ALLOCATABLE
::
zso
(:,:,:)
TYPE
(
t_mat
)::
zmat
TYPE
(
t_lapw
)::
lapw
...
...
@@ -107,88 +104,15 @@ CONTAINS
#endif
CALL
timestart
(
"eigenso: spnorb"
)
! ..
ALLOCATE
(
rsopdp
(
atoms
%
ntype
,
atoms
%
lmaxd
,
2
,
2
),
rsopdpd
(
atoms
%
ntype
,
atoms
%
lmaxd
,
2
,
2
),&
rsopp
(
atoms
%
ntype
,
atoms
%
lmaxd
,
2
,
2
),
rsoppd
(
atoms
%
ntype
,
atoms
%
lmaxd
,
2
,
2
),&
rsoplop
(
atoms
%
ntype
,
atoms
%
nlod
,
2
,
2
),
rsoplopd
(
atoms
%
ntype
,
atoms
%
nlod
,
2
,
2
),&
rsopdplo
(
atoms
%
ntype
,
atoms
%
nlod
,
2
,
2
),
rsopplo
(
atoms
%
ntype
,
atoms
%
nlod
,
2
,
2
),&
rsoploplop
(
atoms
%
ntype
,
atoms
%
nlod
,
atoms
%
nlod
,
2
,
2
),&
soangl
(
atoms
%
lmaxd
,
-
atoms
%
lmaxd
:
atoms
%
lmaxd
,
2
,
atoms
%
lmaxd
,
-
atoms
%
lmaxd
:
atoms
%
lmaxd
,
2
)
)
soangl
(:,:,:,:,:,:)
=
CMPLX
(
0.0
,
0.0
)
CALL
spnorb
(
atoms
,
noco
,
input
,
mpi
,
enpara
,
vTot
%
mt
,
rsopp
,
rsoppd
,
rsopdp
,
rsopdpd
,
usdus
,&
rsoplop
,
rsoplopd
,
rsopdplo
,
rsopplo
,
rsoploplop
,
soangl
)
IF
(
SIZE
(
noco
%
theta
)
>
1
)
CALL
judft_warn
(
"only first SOC-angle used in second variation"
)
!Get spin-orbit coupling matrix elements
CALL
spnorb
(
atoms
,
noco
,
input
,
mpi
,
enpara
,
vTot
%
mt
,
usdus
,
rsoc
,
.TRUE.
)
!
!Check if SOC is to be scaled for some atom
DO
n
=
1
,
atoms
%
ntype
IF
(
ABS
(
noco
%
socscale
(
n
)
-1.0
)
>
1.E-7
)
THEN
IF
(
mpi
%
irank
==
0
)
WRITE
(
6
,
*
)
"SOC scaled by "
,
noco
%
socscale
(
n
),
" for atom "
,
n
rsopp
(
n
,:,:,:)
=
rsopp
(
n
,:,:,:)
*
noco
%
socscale
(
n
)
rsopdp
(
n
,:,:,:)
=
rsopdp
(
n
,:,:,:)
*
noco
%
socscale
(
n
)
rsoppd
(
n
,:,:,:)
=
rsoppd
(
n
,:,:,:)
*
noco
%
socscale
(
n
)
rsopdpd
(
n
,:,:,:)
=
rsopdpd
(
n
,:,:,:)
*
noco
%
socscale
(
n
)
rsoplop
(
n
,:,:,:)
=
rsoplop
(
n
,:,:,:)
*
noco
%
socscale
(
n
)
rsoplopd
(
n
,:,:,:)
=
rsoplopd
(
n
,:,:,:)
*
noco
%
socscale
(
n
)
rsopdplo
(
n
,:,:,:)
=
rsopdplo
(
n
,:,:,:)
*
noco
%
socscale
(
n
)
rsopplo
(
n
,:,:,:)
=
rsopplo
(
n
,:,:,:)
*
noco
%
socscale
(
n
)
rsoploplop
(
n
,:,:,:,:)
=
rsoploplop
(
n
,:,:,:,:)
*
noco
%
socscale
(
n
)
ENDIF
ENDDO
IF
(
mpi
%
irank
==
0
)
THEN
DO
n
=
1
,
atoms
%
ntype
WRITE
(
6
,
FMT
=
8000
)
WRITE
(
6
,
FMT
=
9000
)
WRITE
(
6
,
FMT
=
8001
)
(
2
*
rsopp
(
n
,
l
,
1
,
1
),
l
=
1
,
3
)
WRITE
(
6
,
FMT
=
8001
)
(
2
*
rsopp
(
n
,
l
,
2
,
2
),
l
=
1
,
3
)
WRITE
(
6
,
FMT
=
8001
)
(
2
*
rsopp
(
n
,
l
,
2
,
1
),
l
=
1
,
3
)
WRITE
(
6
,
FMT
=
8000
)
WRITE
(
6
,
FMT
=
9000
)
WRITE
(
6
,
FMT
=
8001
)
(
2
*
rsoppd
(
n
,
l
,
1
,
1
),
l
=
1
,
3
)
WRITE
(
6
,
FMT
=
8001
)
(
2
*
rsoppd
(
n
,
l
,
2
,
2
),
l
=
1
,
3
)
WRITE
(
6
,
FMT
=
8001
)
(
2
*
rsoppd
(
n
,
l
,
2
,
1
),
l
=
1
,
3
)
WRITE
(
6
,
FMT
=
8000
)
WRITE
(
6
,
FMT
=
9000
)
WRITE
(
6
,
FMT
=
8001
)
(
2
*
rsopdp
(
n
,
l
,
1
,
1
),
l
=
1
,
3
)
WRITE
(
6
,
FMT
=
8001
)
(
2
*
rsopdp
(
n
,
l
,
2
,
2
),
l
=
1
,
3
)
WRITE
(
6
,
FMT
=
8001
)
(
2
*
rsopdp
(
n
,
l
,
2
,
1
),
l
=
1
,
3
)
WRITE
(
6
,
FMT
=
8000
)
WRITE
(
6
,
FMT
=
9000
)
WRITE
(
6
,
FMT
=
8001
)
(
2
*
rsopdpd
(
n
,
l
,
1
,
1
),
l
=
1
,
3
)
WRITE
(
6
,
FMT
=
8001
)
(
2
*
rsopdpd
(
n
,
l
,
2
,
2
),
l
=
1
,
3
)
WRITE
(
6
,
FMT
=
8001
)
(
2
*
rsopdpd
(
n
,
l
,
2
,
1
),
l
=
1
,
3
)
ENDDO
ENDIF
8000
FORMAT
(
' spin - orbit parameter HR '
)
8001
FORMAT
(
8f8.4
)
9000
FORMAT
(
5x
,
' p '
,
5x
,
' d '
,
5x
,
' f '
)
IF
(
mpi
%
irank
==
0
)
THEN
IF
(
noco
%
soc_opt
(
atoms
%
ntype
+1
))
THEN
! .OR. l_all) THEN
! IF (l_all) THEN
! WRITE (6,fmt='(A)') 'Only SOC contribution of certain'&
! //' atom types included in Hamiltonian.'
! ELSE
WRITE
(
chntype
,
'(i3)'
)
atoms
%
ntype
WRITE
(
6
,
fmt
=
'(A,2x,'
//
chntype
//
'l1)'
)
'SOC contributi'
&
//
'on of certain atom types included in Hamiltonian:'
,&
(
noco
%
soc_opt
(
n
),
n
=
1
,
atoms
%
ntype
)
! ENDIF
ELSE
WRITE
(
6
,
fmt
=
'(A,1x,A)'
)
'SOC contribution of all atom'
//&
' types inculded in Hamiltonian.'
ENDIF
IF
(
noco
%
soc_opt
(
atoms
%
ntype
+2
))
THEN
WRITE
(
6
,
fmt
=
'(A)'
)&
'SOC Hamiltonian is constructed by neglecting B_xc.'
ENDIF
ENDIF
ALLOCATE
(
eig_so
(
2
*
DIMENSION
%
neigd
)
)
soangl
(:,:,:,:,:,:)
=
CONJG
(
soangl
(:,:,:,:,:,:
))
rsoc
%
soangl
(:,:,:,:,:,:,
1
)
=
CONJG
(
rsoc
%
soangl
(:,:,:,:,:,:,
1
))
CALL
timestop
(
"eigenso: spnorb"
)
!
!---> loop over k-points: each can be a separate task
...
...
@@ -207,9 +131,7 @@ CONTAINS
zso
(:,:,:)
=
CMPLX
(
0.0
,
0.0
)
CALL
timestart
(
"eigenso: alineso"
)
CALL
alineso
(
eig_id
,
lapw
,
mpi
,
DIMENSION
,
atoms
,
sym
,
kpts
,&
input
,
noco
,
cell
,
oneD
,
rsopp
,
rsoppd
,
rsopdp
,
rsopdpd
,
nk
,&
rsoplop
,
rsoplopd
,
rsopdplo
,
rsopplo
,
rsoploplop
,&
usdus
,
soangl
,
nsz
,
nmat
,
eig_so
,
zso
)
input
,
noco
,
cell
,
oneD
,
nk
,
usdus
,
rsoc
,
nsz
,
nmat
,
eig_so
,
zso
)
CALL
timestop
(
"eigenso: alineso"
)
IF
(
mpi
%
irank
.EQ.
0
)
THEN
WRITE
(
16
,
FMT
=
8010
)
nk
,
nsz
...
...
@@ -234,11 +156,6 @@ CONTAINS
ENDIF
! (input%eonly) ELSE
deallocate
(
zso
)
ENDDO
! DO nk
DEALLOCATE
(
eig_so
,
rsoploplop
,
rsopplo
,
rsopdplo
,
rsoplopd
)
DEALLOCATE
(
rsoplop
,
rsopdp
,
rsopdpd
,
rsopp
,
rsoppd
,
soangl
)
DEALLOCATE
(
usdus
%
us
,
usdus
%
dus
,
usdus
%
uds
,
usdus
%
duds
,
usdus
%
ulos
,
usdus
%
dulos
,
usdus
%
uulon
,
usdus
%
dulon
,
usdus
%
ddn
)
RETURN
END
SUBROUTINE
eigenso
END
MODULE
m_eigenso
eigen_soc/hsoham.f90
View file @
3e24dd1b
...
...
@@ -7,32 +7,22 @@ MODULE m_hsoham
CONTAINS
SUBROUTINE
hsoham
(&
atoms
,
noco
,
input
,
nsz
,
chelp
,&
rsoplop
,
rsoplopd
,
rsopdplo
,
rsopplo
,
rsoploplop
,&
ahelp
,
bhelp
,
rsopp
,
rsoppd
,
rsopdp
,
rsopdpd
,
soangl
,&
rsoc
,
ahelp
,
bhelp
,&
hsomtx
)
USE
m_types
IMPLICIT
NONE
TYPE
(
t_input
),
INTENT
(
IN
)
::
input
TYPE
(
t_noco
),
INTENT
(
IN
)
::
noco
TYPE
(
t_atoms
),
INTENT
(
IN
)
::
atoms
TYPE
(
t_rsoc
),
INTENT
(
IN
)
::
rsoc
! ..
! .. Scalar Arguments ..
! ..
! .. Array Arguments ..
INTEGER
,
INTENT
(
IN
)
::
nsz
(:)
!(dimension%jspd)
REAL
,
INTENT
(
IN
)
::
rsopp
(
atoms
%
ntype
,
atoms
%
lmaxd
,
2
,
2
)
REAL
,
INTENT
(
IN
)
::
rsoppd
(
atoms
%
ntype
,
atoms
%
lmaxd
,
2
,
2
)
REAL
,
INTENT
(
IN
)
::
rsopdp
(
atoms
%
ntype
,
atoms
%
lmaxd
,
2
,
2
)
REAL
,
INTENT
(
IN
)
::
rsopdpd
(
atoms
%
ntype
,
atoms
%
lmaxd
,
2
,
2
)
REAL
,
INTENT
(
IN
)
::
rsoplop
(
atoms
%
ntype
,
atoms
%
nlod
,
2
,
2
)
REAL
,
INTENT
(
IN
)
::
rsoplopd
(
atoms
%
ntype
,
atoms
%
nlod
,
2
,
2
)
REAL
,
INTENT
(
IN
)
::
rsopdplo
(
atoms
%
ntype
,
atoms
%
nlod
,
2
,
2
)
REAL
,
INTENT
(
IN
)
::
rsopplo
(
atoms
%
ntype
,
atoms
%
nlod
,
2
,
2
)
REAL
,
INTENT
(
IN
)
::
rsoploplop
(
atoms
%
ntype
,
atoms
%
nlod
,
atoms
%
nlod
,
2
,
2
)
COMPLEX
,
INTENT
(
IN
)
::
ahelp
(
-
atoms
%
lmaxd
:,:,:,:,:)
!(-lmaxd:lmaxd,lmaxd,atoms%nat,dimension%neigd,dimension%jspd)
COMPLEX
,
INTENT
(
IN
)
::
bhelp
(
-
atoms
%
lmaxd
:,:,:,:,:)
!(-lmaxd:lmaxd,lmaxd,atoms%nat,dimension%neigd,dimension%jspd)
COMPLEX
,
INTENT
(
IN
)
::
chelp
(
-
atoms
%
llod
:,:,:,:,:)
!(-llod:llod ,dimension%neigd,atoms%nlod,atoms%nat ,dimension%jspd)
COMPLEX
,
INTENT
(
IN
)
::
soangl
(:,
-
atoms
%
lmaxd
:,:,:,
-
atoms
%
lmaxd
:,:)
!(lmaxd,-lmaxd:lmaxd,2,lmaxd,-lmaxd:lmaxd,2)
COMPLEX
,
INTENT
(
OUT
)::
hsomtx
(:,:,:,:)
!(2,2,dimension%neigd,neigd)
! ..
! .. Local Scalars ..
...
...
@@ -64,10 +54,9 @@ CONTAINS
!$OMP PARALLEL DEFAULT(none)&
!$OMP PRIVATE(j,na,n,nn,l,m,m1,ilo,i,lwn,ilop)&
!$OMP PRIVATE(c_a,c_b,c_c,c_1,c_2,c_3,c_4,c_5) &
!$OMP SHARED(hsomtx,i1,jsp,j1,jsp1,nsz,atoms
,soangl
)&
!$OMP SHARED(hsomtx,i1,jsp,j1,jsp1,nsz,atoms)&
!$OMP SHARED(ahelp,bhelp,chelp,noco)&
!$OMP SHARED(rsoplop,rsoplopd,rsopdplo,rsopplo,rsoploplop)&
!$OMP SHARED(rsopp,rsoppd,rsopdp,rsopdpd)
!$OMP SHARED(rsoc)
ALLOCATE
(
c_b
(
-
atoms
%
lmaxd
:
atoms
%
lmaxd
,
atoms
%
lmaxd
,
atoms
%
nat
),&
c_a
(
-
atoms
%
lmaxd
:
atoms
%
lmaxd
,
atoms
%
lmaxd
,
atoms
%
nat
),&
...
...
@@ -89,9 +78,9 @@ CONTAINS
c_a
(
m
,
l
,
na
)
=
CMPLX
(
0.
,
0.
)
c_b
(
m
,
l
,
na
)
=
CMPLX
(
0.
,
0.
)
DO
m1
=
-
l
,
l
c_a
(
m
,
l
,
na
)
=
c_a
(
m
,
l
,
na
)
+
soangl
(
l
,
m
,
i1
,
l
,
m1
,
j
1
)&
c_a
(
m
,
l
,
na
)
=
c_a
(
m
,
l
,
na
)
+
rsoc
%
soangl
(
l
,
m
,
i1
,
l
,
m1
,
j1
,
1
)&
*
CONJG
(
ahelp
(
m1
,
l
,
na
,
j
,
jsp1
))
c_b
(
m
,
l
,
na
)
=
c_b
(
m
,
l
,
na
)
+
soangl
(
l
,
m
,
i1
,
l
,
m1
,
j
1
)&
c_b
(
m
,
l
,
na
)
=
c_b
(
m
,
l
,
na
)
+
rsoc
%
soangl
(
l
,
m
,
i1
,
l
,
m1
,
j1
,
1
)&
*
CONJG
(
bhelp
(
m1
,
l
,
na
,
j
,
jsp1
))
ENDDO
ENDDO
...
...
@@ -104,7 +93,7 @@ CONTAINS
c_c
(
m
,
ilo
,
na
)
=
CMPLX
(
0.
,
0.
)
DO
m1
=
-
l
,
l
c_c
(
m
,
ilo
,
na
)
=
c_c
(
m
,
ilo
,
na
)
+
CONJG
(&
chelp
(
m1
,
j
,
ilo
,
na
,
jsp1
))
*
soangl
(
l
,
m
,
i1
,
l
,
m1
,
j
1
)
chelp
(
m1
,
j
,
ilo
,
na
,
jsp1
))
*
rsoc
%
soangl
(
l
,
m
,
i1
,
l
,
m1
,
j1
,
1
)
ENDDO
ENDDO
ENDIF
...
...
@@ -122,8 +111,6 @@ CONTAINS
!---> loop over each atom type
!
DO
n
=
1
,
atoms
%
ntype
IF
(
(
.NOT.
noco
%
soc_opt
(
atoms
%
ntype
+1
))
.OR.
noco
%
soc_opt
(
n
)
)
THEN
lwn
=
atoms
%
lmax
(
n
)
!
!---> loop over equivalent atoms
...
...
@@ -133,10 +120,10 @@ CONTAINS
DO
l
=
1
,
lwn
!
DO
m
=
-
l
,
l
c_1
=
rsopp
(
n
,
l
,
i1
,
j1
)
*
ahelp
(
m
,
l
,
na
,
i
,
jsp
)
+
&
rsopdp
(
n
,
l
,
i1
,
j1
)
*
bhelp
(
m
,
l
,
na
,
i
,
jsp
)
c_2
=
rsoppd
(
n
,
l
,
i1
,
j1
)
*
ahelp
(
m
,
l
,
na
,
i
,
jsp
)
+
&
rsopdpd
(
n
,
l
,
i1
,
j1
)
*
bhelp
(
m
,
l
,
na
,
i
,
jsp
)
c_1
=
rso
c
%
rso
pp
(
n
,
l
,
i1
,
j1
)
*
ahelp
(
m
,
l
,
na
,
i
,
jsp
)
+
&
rso
c
%
rso
pdp
(
n
,
l
,
i1
,
j1
)
*
bhelp
(
m
,
l
,
na
,
i
,
jsp
)
c_2
=
rso
c
%
rso
ppd
(
n
,
l
,
i1
,
j1
)
*
ahelp
(
m
,
l
,
na
,
i
,
jsp
)
+
&
rso
c
%
rso
pdpd
(
n
,
l
,
i1
,
j1
)
*
bhelp
(
m
,
l
,
na
,
i
,
jsp
)
hsomtx
(
i1
,
j1
,
i
,
j
)
=
hsomtx
(
i1
,
j1
,
i
,
j
)
+
&
c_1
*
c_a
(
m
,
l
,
na
)
+
c_2
*
c_b
(
m
,
l
,
na
)
ENDDO
...
...
@@ -147,10 +134,10 @@ CONTAINS
l
=
atoms
%
llo
(
ilo
,
n
)
IF
(
l
.GT.
0
)
THEN
DO
m
=
-
l
,
l
c_3
=
rsopplo
(
n
,
ilo
,
i1
,
j1
)
*
ahelp
(
m
,
l
,
na
,
i
,
jsp
)
+
&
rsopdplo
(
n
,
ilo
,
i1
,
j1
)
*
bhelp
(
m
,
l
,
na
,
i
,
jsp
)
c_4
=
rsoplop
(
n
,
ilo
,
i1
,
j1
)
*
chelp
(
m
,
i
,
ilo
,
na
,
jsp
)
c_5
=
rsoplopd
(
n
,
ilo
,
i1
,
j1
)
*
chelp
(
m
,
i
,
ilo
,
na
,
jsp
)
c_3
=
rso
c
%
rso
pplo
(
n
,
ilo
,
i1
,
j1
)
*
ahelp
(
m
,
l
,
na
,
i
,
jsp
)
+
&
rso
c
%
rso
pdplo
(
n
,
ilo
,
i1
,
j1
)
*
bhelp
(
m
,
l
,
na
,
i
,
jsp
)
c_4
=
rso
c
%
rso
plop
(
n
,
ilo
,
i1
,
j1
)
*
chelp
(
m
,
i
,
ilo
,
na
,
jsp
)
c_5
=
rso
c
%
rso
plopd
(
n
,
ilo
,
i1
,
j1
)
*
chelp
(
m
,
i
,
ilo
,
na
,
jsp
)
hsomtx
(
i1
,
j1
,
i
,
j
)
=
hsomtx
(
i1
,
j1
,
i
,
j
)
+
&
c_4
*
c_a
(
m
,
l
,
na
)
+
c_5
*
c_b
(
m
,
l
,
na
)
+
&
c_3
*
c_c
(
m
,
ilo
,
na
)
...
...
@@ -159,7 +146,7 @@ CONTAINS
IF
(
atoms
%
llo
(
ilop
,
n
)
.EQ.
l
)
THEN
DO
m
=
-
l
,
l
hsomtx
(
i1
,
j1
,
i
,
j
)
=
hsomtx
(
i1
,
j1
,
i
,
j
)
+
&
rsoploplop
(
n
,
ilop
,
ilo
,
i1
,
j1
)
*
&
rso
c
%
rso
ploplop
(
n
,
ilop
,
ilo
,
i1
,
j1
)
*
&
chelp
(
m
,
i
,
ilop
,
na
,
jsp
)
*
c_c
(
m
,
ilo
,
na
)
ENDDO
ENDIF
...
...
@@ -169,12 +156,7 @@ CONTAINS
! end lo's
ENDDO
ELSE
na
=
na
+
atoms
%
neq
(
n
)
ENDIF
ENDDO
ENDDO
!
ENDDO
!!i
...
...
eigen_soc/soinit.f90
View file @
3e24dd1b
!--------------------------------------------------------------------------------
! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
! This file is part of FLEUR and available as free software under the conditions
! of the MIT license as expressed in the LICENSE file in more detail.
!--------------------------------------------------------------------------------
MODULE
m_soinit
!
!**********************************************************************
! 1. generates radial spin-orbit matrix elements:sorad
! 2. generates spin-angular spin-orbit matrix :soorb (not implemented)
! generates radial spin-orbit matrix elements:sorad
!**********************************************************************
!
CONTAINS
SUBROUTINE
soinit
(
atoms
,
input
,
enpara
,
vr
,
spav
,&
rsopp
,
rsoppd
,
rsopdp
,
rsopdpd
,
usdus
,&
rsoplop
,
rsoplopd
,
rsopdplo
,
rsopplo
,
rsoploplop
)
SUBROUTINE
soinit
(
atoms
,
input
,
enpara
,
vr
,
spav
,
rsoc
,
usdus
)
USE
m_sorad
USE
m_types
...
...
@@ -16,7 +18,8 @@ CONTAINS
TYPE
(
t_enpara
),
INTENT
(
IN
)
::
enpara
TYPE
(
t_input
),
INTENT
(
IN
)
::
input
TYPE
(
t_atoms
),
INTENT
(
IN
)
::
atoms
TYPE
(
t_usdus
),
INTENT
(
INOUT
)
::
usdus
TYPE
(
t_usdus
),
INTENT
(
INOUT
)::
usdus
TYPE
(
t_rsoc
),
INTENT
(
INOUT
)
::
rsoc
!
! .. Scalar Arguments ..
! ..
...
...
@@ -25,15 +28,6 @@ CONTAINS
! ..
! .. Array Arguments ..
REAL
,
INTENT
(
IN
)
::
vr
(:,
0
:,:,:)
!(atoms%jmtd,0:sphhar%nlhd,atoms%ntype,dimension%jspd)
REAL
,
INTENT
(
OUT
)
::
rsopp
(
atoms
%
ntype
,
atoms
%
lmaxd
,
2
,
2
)
REAL
,
INTENT
(
OUT
)
::
rsoppd
(
atoms
%
ntype
,
atoms
%
lmaxd
,
2
,
2
)
REAL
,
INTENT
(
OUT
)
::
rsopdp
(
atoms
%
ntype
,
atoms
%
lmaxd
,
2
,
2
)
REAL
,
INTENT
(
OUT
)
::
rsopdpd
(
atoms
%
ntype
,
atoms
%
lmaxd
,
2
,
2
)
REAL
,
INTENT
(
OUT
)
::
rsoplop
(
atoms
%
ntype
,
atoms
%
nlod
,
2
,
2
)
REAL
,
INTENT
(
OUT
)
::
rsoplopd
(
atoms
%
ntype
,
atoms
%
nlod
,
2
,
2
)
REAL
,
INTENT
(
OUT
)
::
rsopdplo
(
atoms
%
ntype
,
atoms
%
nlod
,
2
,
2
)
REAL
,
INTENT
(
OUT
)
::
rsopplo
(
atoms
%
ntype
,
atoms
%
nlod
,
2
,
2
)
REAL
,
INTENT
(
OUT
)
::
rsoploplop
(
atoms
%
ntype
,
atoms
%
nlod
,
atoms
%
nlod
,
2
,
2
)
! ..
! .. Local Scalars ..
INTEGER
i
,
jspin
,
n
...
...
@@ -41,7 +35,7 @@ CONTAINS
! .. Local Arrays ..
REAL
vr0
(
atoms
%
jmtd
,
size
(
vr
,
4
))
! ..
rsopp
=
0.0
rso
c
%
rso
pp
=
0.0
rsoppd
=
0.0
rsopdp
=
0.0
rsopdpd
=
0.0
...
...
eigen_soc/sorad.f90
View file @
3e24dd1b
!--------------------------------------------------------------------------------
! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
! This file is part of FLEUR and available as free software under the conditions
! of the MIT license as expressed in the LICENSE file in more detail.
!--------------------------------------------------------------------------------
MODULE
m_sorad
USE
m_juDFT
!*********************************************************************
! 1. generates radial spin-orbit matrix elements
! based on m.weinert's radsra and radsrd subroutines
! generates radial spin-orbit matrix elements
!*********************************************************************
CONTAINS
SUBROUTINE
sorad
(
atoms
,
input
,
ntyp
,
vr
,
enpara
,
spav
,&
rsopp
,
rsopdpd
,
rsoppd
,
rsopdp
,
usdus
,&
rsoplop
,
rsoplopd
,
rsopdplo
,
rsopplo
,
rsoploplop
)
SUBROUTINE
sorad
(
atoms
,
input
,
ntyp
,
vr
,
enpara
,
spav
,
rsoc
,
usdus
)
USE
m_constants
,
ONLY
:
c_light
USE
m_intgr
,
ONLY
:
intgr0
...
...
@@ -18,9 +20,10 @@ CONTAINS
USE
m_types
IMPLICIT
NONE
TYPE
(
t_enpara
),
INTENT
(
IN
)
::
enpara
TYPE
(
t_input
),
INTENT
(
IN
)
::
input
TYPE
(
t_atoms
),
INTENT
(
IN
)
::
atoms
TYPE
(
t_usdus
),
INTENT
(
INOUT
)
::
usdus
TYPE
(
t_input
),
INTENT
(
IN
)
::
input
TYPE
(
t_atoms
),
INTENT
(
IN
)
::
atoms
TYPE
(
t_usdus
),
INTENT
(
INOUT
)
::
usdus
TYPE
(
t_rsoc
),
INTENT
(
INOUT
)
::
rsoc
! ..
! .. Scalar Arguments ..
INTEGER
,
INTENT
(
IN
)
::
ntyp
...
...
@@ -28,15 +31,6 @@ CONTAINS
! ..
! .. Array Arguments ..
REAL
,
INTENT
(
IN
)
::
vr
(:,:)
!(atoms%jmtd,dimension%jspd),
REAL
,
INTENT
(
INOUT
)
::
rsopp
(
atoms
%
ntype
,
atoms
%
lmaxd
,
2
,
2
)
REAL
,
INTENT
(
INOUT
)
::
rsoppd
(
atoms
%
ntype
,
atoms
%
lmaxd
,
2
,
2
)
REAL
,
INTENT
(
INOUT
)
::
rsopdp
(
atoms
%
ntype
,
atoms
%
lmaxd
,
2
,
2
)
REAL
,
INTENT
(
INOUT
)
::
rsopdpd
(
atoms
%
ntype
,
atoms
%
lmaxd
,
2
,
2
)
REAL
,
INTENT
(
INOUT
)
::
rsoplop
(
atoms
%
ntype
,
atoms
%
nlod
,
2
,
2
)
REAL
,
INTENT
(
INOUT
)
::
rsoplopd
(
atoms
%
ntype
,
atoms
%
nlod
,
2
,
2
)
REAL
,
INTENT
(
INOUT
)
::
rsopdplo
(
atoms
%
ntype
,
atoms
%
nlod
,
2
,
2
)
REAL
,
INTENT
(
INOUT
)
::
rsopplo
(
atoms
%
ntype
,
atoms
%
nlod
,
2
,
2
)
REAL
,
INTENT
(
INOUT
)
::
rsoploplop
(
atoms
%
ntype
,
atoms
%
nlod
,
atoms
%
nlod
,
2
,
2
)
! ..
! .. Local Scalars ..
REAL
ddn1
,
e
,
ulops
,
dulops
,
duds1
...
...
@@ -113,10 +107,10 @@ CONTAINS
IF
(
l
.GT.
0
)
THEN
! there is no spin-orbit for s-states
DO
i
=
1
,
2
DO
j
=
1
,
2
rsopp
(
ntyp
,
l
,
i
,
j
)
=
radso
(
p
(:
atoms
%
jri
(
ntyp
),
i
),
p
(:
atoms
%
jri
(
ntyp
),
j
),
vso
(:
atoms
%
jri
(
ntyp
),
i
),
atoms
%
dx
(
ntyp
),
atoms
%
rmsh
(
1
,
ntyp
))
rsopdp
(
ntyp
,
l
,
i
,
j
)
=
radso
(
pd
(:
atoms
%
jri
(
ntyp
),
i
),
p
(:
atoms
%
jri
(
ntyp
),
j
),
vso
(:
atoms
%
jri
(
ntyp
),
i
),
atoms
%
dx
(
ntyp
),
atoms
%
rmsh
(
1
,
ntyp
))
rsoppd
(
ntyp
,
l
,
i
,
j
)
=
radso
(
p
(:
atoms
%
jri
(
ntyp
),
i
),
pd
(:
atoms
%
jri
(
ntyp
),
j
),
vso
(:
atoms
%
jri
(
ntyp
),
i
),
atoms
%
dx
(
ntyp
),
atoms
%
rmsh
(
1
,
ntyp
))
rsopdpd
(
ntyp
,
l
,
i
,
j
)
=
radso
(
pd
(:
atoms
%
jri
(
ntyp
),
i
),
pd
(:
atoms
%
jri
(
ntyp
),
j
),
vso
(:
atoms
%
jri
(
ntyp
),
i
),
atoms
%
dx
(
ntyp
),
atoms
%
rmsh
(
1
,
ntyp
))
rso
c
%
rso
pp
(
ntyp
,
l
,
i
,
j
)
=
radso
(
p
(:
atoms
%
jri
(
ntyp
),
i
),
p
(:
atoms
%
jri
(
ntyp
),
j
),
vso
(:
atoms
%
jri
(
ntyp
),
i
),
atoms
%
dx
(
ntyp
),
atoms
%
rmsh
(
1
,
ntyp
))
rso
c
%
rso
pdp
(
ntyp
,
l
,
i
,
j
)
=
radso
(
pd
(:
atoms
%
jri
(
ntyp
),
i
),
p
(:
atoms
%
jri
(
ntyp
),
j
),
vso
(:
atoms
%
jri
(
ntyp
),
i
),
atoms
%
dx
(
ntyp
),
atoms
%
rmsh
(
1
,
ntyp
))
rso
c
%
rso
ppd
(
ntyp
,
l
,
i
,
j
)
=
radso
(
p
(:
atoms
%
jri
(
ntyp
),
i
),
pd
(:
atoms
%
jri
(
ntyp
),
j
),
vso
(:
atoms
%
jri
(
ntyp
),
i
),
atoms
%
dx
(
ntyp
),
atoms
%
rmsh
(
1
,
ntyp
))
rso
c
%
rso
pdpd
(
ntyp
,
l
,
i
,
j
)
=
radso
(
pd
(:
atoms
%
jri
(
ntyp
),
i
),
pd
(:
atoms
%
jri
(
ntyp
),
j
),
vso
(:
atoms
%
jri
(
ntyp
),
i
),
atoms
%
dx
(
ntyp
),
atoms
%
rmsh
(
1
,
ntyp
))
ENDDO
ENDDO
ENDIF
! l>0
...
...
@@ -171,10 +165,10 @@ CONTAINS
DO
i
=
1
,
2
DO
j
=
1
,
2
rsoplop
(
ntyp
,
ilo
,
i
,
j
)
=
radso
(
plo
(:
atoms
%
jri
(
ntyp
),
i
),
p
(:
atoms
%
jri
(
ntyp
),
j
),
vso
(:
atoms
%
jri
(
ntyp
),
i
),
atoms
%
dx
(
ntyp
),
atoms
%
rmsh
(
1
,
ntyp
))
rsoplopd
(
ntyp
,
ilo
,
i
,
j
)
=
radso
(
plo
(:
atoms
%
jri
(
ntyp
),
i
),
pd
(:
atoms
%
jri
(
ntyp
),
j
),
vso
(:
atoms
%
jri
(
ntyp
),
i
),
atoms
%
dx
(
ntyp
),
atoms
%
rmsh
(
1
,
ntyp
))
rsopplo
(
ntyp
,
ilo
,
i
,
j
)
=
radso
(
p
(:
atoms
%
jri
(
ntyp
),
i
),
plo
(:
atoms
%
jri
(
ntyp
),
j
),
vso
(:
atoms
%
jri
(
ntyp
),
i
),
atoms
%
dx
(
ntyp
),
atoms
%
rmsh
(
1
,
ntyp
))
rsopdplo
(
ntyp
,
ilo
,
i
,
j
)
=
radso
(
pd
(:
atoms
%
jri
(
ntyp
),
i
),
plo
(:
atoms
%
jri
(
ntyp
),
j
),
vso
(:
atoms
%
jri
(
ntyp
),
i
),
atoms
%
dx
(
ntyp
),
atoms
%
rmsh
(
1
,
ntyp
))
rso
c
%
rso
plop
(
ntyp
,
ilo
,
i
,
j
)
=
radso
(
plo
(:
atoms
%
jri
(
ntyp
),
i
),
p
(:
atoms
%
jri
(
ntyp
),
j
),
vso
(:
atoms
%
jri
(
ntyp
),
i
),
atoms
%
dx
(
ntyp
),
atoms
%
rmsh
(
1
,
ntyp
))
rso
c
%
rso
plopd
(
ntyp
,
ilo
,
i
,
j
)
=
radso
(
plo
(:
atoms
%
jri
(
ntyp
),
i
),
pd
(:
atoms
%
jri
(
ntyp
),
j
),
vso
(:
atoms
%
jri
(
ntyp
),
i
),
atoms
%
dx
(
ntyp
),
atoms
%
rmsh
(
1
,
ntyp
))
rso
c
%
rso
pplo
(
ntyp
,
ilo
,
i
,
j
)
=
radso
(
p
(:
atoms
%
jri
(
ntyp
),
i
),
plo
(:
atoms
%
jri
(
ntyp
),
j
),
vso
(:
atoms
%
jri
(
ntyp
),
i
),
atoms
%
dx
(
ntyp
),
atoms
%
rmsh
(
1
,
ntyp
))
rso
c
%
rso
pdplo
(
ntyp
,
ilo
,
i
,
j
)
=
radso
(
pd
(:
atoms
%
jri
(
ntyp
),
i
),
plo
(:
atoms
%
jri
(
ntyp
),
j
),
vso
(:
atoms
%
jri
(
ntyp
),
i
),
atoms
%
dx
(
ntyp
),
atoms
%
rmsh
(
1
,
ntyp
))
ENDDO
ENDDO
...
...
@@ -227,7 +221,7 @@ CONTAINS
DO
i
=
1
,
2
DO
j
=
1
,
2
rsoploplop
(
ntyp
,
ilo
,
ilop
,
i
,
j
)
=
&
rso
c
%
rso
ploplop
(
ntyp
,
ilo
,
ilop
,
i
,
j
)
=
&
radso
(
plo
(:
atoms
%
jri
(
ntyp
),
i
),
plop
(:
atoms
%
jri
(
ntyp
),
j
),
vso
(:
atoms
%
jri
(
ntyp
),
i
),
atoms
%
dx
(
ntyp
),
atoms
%
rmsh
(
1
,
ntyp
))
ENDDO
ENDDO
...
...
eigen_soc/spnorb.f90
View file @
3e24dd1b
!--------------------------------------------------------------------------------
! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
! This file is part of FLEUR and available as free software under the conditions
! of the MIT license as expressed in the LICENSE file in more detail.
!--------------------------------------------------------------------------------
MODULE
m_spnorb
!*********************************************************************
! calls soinit to calculate the radial spin-orbit matrix elements:
...
...
@@ -6,40 +12,30 @@ MODULE m_spnorb
! using the functions anglso and sgml.
!*********************************************************************
CONTAINS
SUBROUTINE
spnorb
(
atoms
,
noco
,
input
,
mpi
,
enpara
,
vr
,
rsopp
,
rsoppd
,
rsopdp
,
rsopdpd
,&
usdus
,
rsoplop
,
rsoplopd
,
rsopdplo
,
rsopplo
,
rsoploplop
,
soangl
)
SUBROUTINE
spnorb
(
atoms
,
noco
,
input
,
mpi
,
enpara
,
vr
,
usdus
,
rsoc
,
l_angles
)
USE
m_anglso
USE
m_sgml
USE
m_so
init
USE
m_so
rad
USE
m_types
IMPLICIT
NONE
TYPE
(
t_mpi
),
INTENT
(
IN
)
::
mpi
TYPE
(
t_mpi
),
INTENT
(
IN
)
::
mpi
TYPE
(
t_enpara
),
INTENT
(
IN
)
::
enpara
TYPE
(
t_input
),
INTENT
(
IN
)
::
input
TYPE
(
t_noco
),
INTENT
(
IN
)
::
noco
TYPE
(
t_atoms
),
INTENT
(
IN
)
::
atoms
TYPE
(
t_usdus
),
INTENT
(
INOUT
)
::
usdus
TYPE
(
t_usdus
),
INTENT
(
INOUT
)
::
usdus
TYPE
(
t_rsoc
),
INTENT
(
OUT
)
::
rsoc
LOGICAL
,
INTENT
(
IN
)
::
l_angles
! ..
! ..
! .. Array Arguments ..
REAL
,
INTENT
(
IN
)
::
vr
(:,
0
:,:,:)
!(atoms%jmtd,0:sphhar%nlhd,atoms%ntype,dimension%jspd)
REAL
,
INTENT
(
OUT
)
::
rsopp
(
atoms
%
ntype
,
atoms
%
lmaxd
,
2
,
2
)
REAL
,
INTENT
(
OUT
)
::
rsoppd
(
atoms
%
ntype
,
atoms
%
lmaxd
,
2
,
2
)
REAL
,
INTENT
(
OUT
)
::
rsopdp
(
atoms
%
ntype
,
atoms
%
lmaxd
,
2
,
2
)
REAL
,
INTENT
(
OUT
)
::
rsopdpd
(
atoms
%
ntype
,
atoms
%
lmaxd
,
2
,
2
)
REAL
,
INTENT
(
OUT
)
::
rsoplop
(
atoms
%
ntype
,
atoms
%
nlod
,
2
,
2
)
REAL
,
INTENT
(
OUT
)
::
rsoplopd
(
atoms
%
ntype
,
atoms
%
nlod
,
2
,
2
)
REAL
,
INTENT
(
OUT
)
::
rsopdplo
(
atoms
%
ntype
,
atoms
%
nlod
,
2
,
2
)
REAL
,
INTENT
(
OUT
)
::
rsopplo
(
atoms
%
ntype
,
atoms
%
nlod
,
2
,
2
)
REAL
,
INTENT
(
OUT
)
::
rsoploplop
(
atoms
%
ntype
,
atoms
%
nlod
,
atoms
%
nlod
,
2
,
2
)
COMPLEX
,
INTENT
(
OUT
)
::
soangl
(
atoms
%
lmaxd
,
-
atoms
%
lmaxd
:
atoms
%
lmaxd
,
2
,&
atoms
%
lmaxd
,
-
atoms
%
lmaxd
:
atoms
%
lmaxd
,
2
)
! ..
! .. Local Scalars ..
INTEGER
is1
,
is2
,
jspin1
,
jspin2
,
l
,
l1
,
l2
,
m1
,
m2
,
n
INTEGER
is1
,
is2
,
jspin1
,
jspin2
,
l
,
l1
,
l2
,
m1
,
m2
,
n
,
nr
LOGICAL
,
SAVE
::
first_k
=
.TRUE.
! ..
! .. Local Arrays ..
INTEGER
ispjsp
(
2
)
...
...
@@ -47,44 +43,69 @@ CONTAINS
! ..
DATA
ispjsp
/
1
,
-1
/
CALL
soinit
(
atoms
,
input
,
enpara
,
vr
,
noco
%
soc_opt
(
atoms
%
ntype
+2
),
&
rsopp
,
rsoppd
,
rsopdp
,
rsopdpd
,
usdus
,
rsoplop
,
rsoplopd
,
rsopdplo
,&
rsopplo
,
rsoploplop
)
!Allocate space for SOC matrix elements; set to zero at the same time
ALLOCATE
(
rsoc
%
rsopp
(
atoms
%
ntype
,
atoms
%
lmaxd
,
2
,
2
));
rsoc
%
rsopp
=
0.0
ALLOCATE
(
rsoc
%
rsoppd
(
atoms
%
ntype
,
atoms
%
lmaxd
,
2
,
2
));
rsoc
%
rsoppd
=
0.0
ALLOCATE
(
rsoc
%
rsopdp
(
atoms
%
ntype
,
atoms
%
lmaxd
,
2
,
2
));
rsoc
%
rsopdp
=
0.0
ALLOCATE
(
rsoc
%
rsopdpd
(
atoms
%
ntype
,
atoms
%
lmaxd
,
2
,
2
));
rsoc
%
rsopdpd
=
0.0
ALLOCATE
(
rsoc
%
rsoplop
(
atoms
%
ntype
,
atoms
%
nlod
,
2
,
2
));
rsoc
%
rsoplop
=
0.0
ALLOCATE
(
rsoc
%
rsoplopd
(
atoms
%
ntype
,
atoms
%
nlod
,
2
,
2
));
rsoc
%
rsoplopd
=
0.0
ALLOCATE
(
rsoc
%
rsopdplo
(
atoms
%
ntype
,
atoms
%
nlod
,
2
,
2
));
rsoc
%
rsopdplo
=
0.0
ALLOCATE
(
rsoc
%
rsopplo
(
atoms
%
ntype
,
atoms
%
nlod
,
2
,
2
));
rsoc
%
rsopplo
=
0.0
ALLOCATE
(
rsoc
%
rsoploplop
(
atoms
%
ntype
,
atoms
%
nlod
,
atoms
%
nlod
,
2
,
2
));
rsoc
%
rsoploplop
=
0.0
IF
(
l_angles
)
ALLOCATE
(
rsoc
%
soangl
(
atoms
%
lmaxd
,
-
atoms
%
lmaxd
:
atoms
%
lmaxd
,
2
,&
atoms
%
lmaxd
,
-
atoms
%
lmaxd
:
atoms
%
lmaxd
,
2
,
SIZE
(
noco
%
theta
)))
!Calculate radial soc-matrix elements
DO
n
=
1
,
atoms
%
ntype
CALL
sorad
(
atoms
,
input
,
n
,
vr
(:
atoms
%
jri
(
n
),
0
,
n
,:),
enpara
,
noco
%
l_spav
,
rsoc
,
usdus
)
END
DO
!
IF
(
mpi
%
irank
.EQ.
0
)
THEN
!Scale SOC
DO
n
=
1
,
atoms
%
ntype
IF
(
ABS
(
noco
%
socscale
(
n
)
-1
)
>
1E-5
)
THEN
IF
(
mpi
%
irank
==
0
)
WRITE
(
6
,
"(a,i0,a,f10.8)"
)
"Scaled SOC for atom "
,
n
,
" by "
,
noco
%
socscale
(
n
)
rsoc
%
rsopp
(
n
,:,:,:)
=
rsoc
%
rsopp
(
n
,:,:,:)
*
noco
%
socscale
(
n
)
rsoc
%
rsopdp
(
n
,:,:,:)
=
rsoc
%
rsopdp
(
n
,:,:,:)
*
noco
%
socscale
(
n
)
rsoc
%
rsoppd
(
n
,:,:,:)
=
rsoc
%
rsoppd
(
n
,:,:,:)
*
noco
%
socscale
(
n
)
rsoc
%
rsopdpd
(
n
,:,:,:)
=
rsoc
%
rsopdpd
(
n
,:,:,:)
*
noco
%
socscale
(
n
)
rsoc
%
rsoplop
(
n
,:,:,:)
=
rsoc
%
rsoplop
(
n
,:,:,:)
*
noco
%
socscale
(
n
)
rsoc
%
rsoplopd
(
n
,:,:,:)
=
rsoc
%
rsoplopd
(
n
,:,:,:)
*
noco
%
socscale
(
n
)
rsoc
%
rsopdplo
(
n
,:,:,:)
=
rsoc
%
rsopdplo
(
n
,:,:,:)
*
noco
%
socscale
(
n
)
rsoc
%
rsopplo
(
n
,:,:,:)
=
rsoc
%
rsopplo
(
n
,:,:,:)
*
noco
%
socscale
(
n
)
rsoc
%
rsoploplop
(
n
,:,:,:,:)
=
rsoc
%
rsoploplop
(
n
,:,:,:,:)
*
noco
%
socscale
(
n
)
ENDIF