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
0c6b3548
Commit
0c6b3548
authored
Sep 25, 2018
by
Gustav Bihlmayer
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Fixed OMP parallelization in abcof_soc.F90 and included LO part.
parent
08c083af
Changes
4
Hide whitespace changes
Inline
Side-by-side
Showing
4 changed files
with
96 additions
and
161 deletions
+96
-161
eigen_soc/CMakeLists.txt
eigen_soc/CMakeLists.txt
+0
-1
eigen_soc/abclocdn_soc.F90
eigen_soc/abclocdn_soc.F90
+0
-97
eigen_soc/abcof_soc.F90
eigen_soc/abcof_soc.F90
+92
-51
eigen_soc/hsohelp.F90
eigen_soc/hsohelp.F90
+4
-12
No files found.
eigen_soc/CMakeLists.txt
View file @
0c6b3548
set
(
fleur_F77
${
fleur_F77
}
)
set
(
fleur_F90
${
fleur_F90
}
eigen_soc/abclocdn_soc.F90
eigen_soc/abcof_soc.F90
eigen_soc/alineso.F90
eigen_soc/anglso.f90
...
...
eigen_soc/abclocdn_soc.F90
deleted
100644 → 0
View file @
08c083af
!--------------------------------------------------------------------------------
! 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_abclocdn_soc
USE
m_juDFT
!*********************************************************************
! Calculates the (upper case) A, B and C coefficients for the local
! orbitals. The difference to abccoflo is, that a summation over the
! Gs ist performed. The A, B and C coeff. are set up for each eigen-
! state.
! Philipp Kurz 99/04
!*********************************************************************
!*************** ABBREVIATIONS ***************************************
! nkvec : stores the number of G-vectors that have been found and
! accepted during the construction of the local orbitals.
! kvec : k-vector used in hssphn to attach the local orbital 'lo'
! of atom 'na' to it.
!*********************************************************************
CONTAINS
SUBROUTINE
abclocdn_soc
(
atoms
,
sym
,
noco
,
lapw
,
cell
,
ccchi
,
iintsp
,
phase
,
ylm
,&
ntyp
,
na
,
na_l
,
k
,
nkvec
,
lo
,
ne
,
alo1
,
blo1
,
clo1
,
acof
,
bcof
,
ccof
,
zMat
,
l_force
,
fgp
,
force
)
USE
m_types
USE
m_constants
IMPLICIT
NONE
TYPE
(
t_noco
),
INTENT
(
IN
)
::
noco
TYPE
(
t_sym
),
INTENT
(
IN
)
::
sym
TYPE
(
t_atoms
),
INTENT
(
IN
)
::
atoms
TYPE
(
t_lapw
),
INTENT
(
IN
)
::
lapw
TYPE
(
t_cell
),
INTENT
(
IN
)
::
cell
TYPE
(
t_mat
),
INTENT
(
IN
)
::
zMat
TYPE
(
t_force
),
OPTIONAL
,
INTENT
(
INOUT
)
::
force
! .. Scalar Arguments ..
INTEGER
,
INTENT
(
IN
)
::
iintsp
INTEGER
,
INTENT
(
IN
)
::
k
,
na
,
na_l
,
ne
,
ntyp
,
nkvec
,
lo
COMPLEX
,
INTENT
(
IN
)
::
phase
LOGICAL
,
INTENT
(
IN
)
::
l_force
! .. Array Arguments ..
REAL
,
INTENT
(
IN
)
::
alo1
(:),
blo1
(:),
clo1
(:)
COMPLEX
,
INTENT
(
IN
)
::
ylm
(
(
atoms
%
lmaxd
+1
)
**
2
)
COMPLEX
,
INTENT
(
IN
)
::
ccchi
(
2
)
COMPLEX
,
INTENT
(
INOUT
)
::
acof
(:,
0
:,:)
!(nobd,0:dimension%lmd,atoms%nat_l)
COMPLEX
,
INTENT
(
INOUT
)
::
bcof
(:,
0
:,:)
!(nobd,0:dimension%lmd,atoms%nat_l)
COMPLEX
,
INTENT
(
INOUT
)
::
ccof
(
-
atoms
%
llod
:,:,:,:)
!(-atoms%llod:atoms%llod,nobd,atoms%nlod,atoms%nat_l)
REAL
,
OPTIONAL
,
INTENT
(
IN
)
::
fgp
(
3
)
! .. Local Scalars ..
COMPLEX
ctmp
,
term1
INTEGER
i
,
j
,
l
,
ll1
,
lm
,
nbasf
,
m
,
na2
,
lmp
! ..
! ..
term1
=
2
*
tpi_const
/
SQRT
(
cell
%
omtil
)
*
((
atoms
%
rmt
(
ntyp
)
**
2
)/
2
)
*
phase
!
!---> the whole program is in hartree units, therefore 1/wronskian is
!---> (rmt**2)/2. the factor i**l, which usually appears in the a, b
!---> and c coefficients, is included in the t-matrices. thus, it does
!---> not show up in the formula above.
IF
((
atoms
%
invsat
(
na
)
==
0
)
.OR.
(
atoms
%
invsat
(
na
)
==
1
))
THEN
na2
=
na
ELSE
na2
=
sym
%
invsatnr
(
na
)
ENDIF
nbasf
=
lapw
%
nv
(
iintsp
)
+
lapw
%
index_lo
(
lo
,
na2
)
+
nkvec
l
=
atoms
%
llo
(
lo
,
ntyp
)
ll1
=
l
*
(
l
+1
)
DO
i
=
1
,
ne
DO
m
=
-
l
,
l
lm
=
ll1
+
m
!+gu_con
IF
((
atoms
%
invsat
(
na
)
==
0
)
.OR.
(
atoms
%
invsat
(
na
)
==
1
))
THEN
IF
(
zMat
%
l_real
)
THEN
ctmp
=
zMat
%
data_r
(
nbasf
,
i
)
*
term1
*
CONJG
(
ylm
(
ll1
+
m
+1
))
ELSE
ctmp
=
zMat
%
data_c
(
nbasf
,
i
)
*
term1
*
CONJG
(
ylm
(
ll1
+
m
+1
))
ENDIF
acof
(
i
,
lm
,
na_l
)
=
acof
(
i
,
lm
,
na_l
)
+
ctmp
*
alo1
(
lo
)
bcof
(
i
,
lm
,
na_l
)
=
bcof
(
i
,
lm
,
na_l
)
+
ctmp
*
blo1
(
lo
)
ccof
(
m
,
i
,
lo
,
na_l
)
=
ccof
(
m
,
i
,
lo
,
na_l
)
+
ctmp
*
clo1
(
lo
)
ELSE
ctmp
=
zMat
%
data_c
(
nbasf
,
i
)
*
CONJG
(
term1
)
*
ylm
(
ll1
+
m
+1
)
*
(
-1
)
**
(
l
-
m
)
lmp
=
ll1
-
m
acof
(
i
,
lmp
,
na_l
)
=
acof
(
i
,
lmp
,
na_l
)
+
ctmp
*
alo1
(
lo
)
bcof
(
i
,
lmp
,
na_l
)
=
bcof
(
i
,
lmp
,
na_l
)
+
ctmp
*
blo1
(
lo
)
ccof
(
-
m
,
i
,
lo
,
na_l
)
=
ccof
(
-
m
,
i
,
lo
,
na_l
)
+
ctmp
*
clo1
(
lo
)
ENDIF
END
DO
END
DO
END
SUBROUTINE
abclocdn_soc
END
MODULE
m_abclocdn_soc
eigen_soc/abcof_soc.F90
View file @
0c6b3548
...
...
@@ -2,7 +2,7 @@ MODULE m_abcof_soc
CONTAINS
SUBROUTINE
abcof_soc
(
input
,
atoms
,
sym
,
cell
,
lapw
,
ne
,
usdus
,&
noco
,
jspin
,
oneD
,
nat_start
,
nat_stop
,
nat_l
,&
acof
,
bcof
,
ccof
,
zMat
,
eig
,
force
)
acof
,
bcof
,
ccof
,
zMat
)
! ************************************************************
! subroutine constructs the a,b coefficients of the linearized
! m.t. wavefunctions for each band and atom. c.l. fu
...
...
@@ -27,7 +27,6 @@ CONTAINS
TYPE
(
t_cell
),
INTENT
(
IN
)
::
cell
TYPE
(
t_atoms
),
INTENT
(
IN
)
::
atoms
TYPE
(
t_mat
),
INTENT
(
IN
)
::
zMat
TYPE
(
t_force
),
OPTIONAL
,
INTENT
(
INOUT
)
::
force
! ..
! .. Scalar Arguments ..
INTEGER
,
INTENT
(
IN
)
::
ne
,
nat_start
,
nat_stop
,
nat_l
...
...
@@ -37,25 +36,22 @@ CONTAINS
COMPLEX
,
INTENT
(
OUT
)
::
acof
(:,
0
:,:)
!(nobd,0:dimension%lmd,nat_l)
COMPLEX
,
INTENT
(
OUT
)
::
bcof
(:,
0
:,:)
!(nobd,0:dimension%lmd,nat_l)
COMPLEX
,
INTENT
(
OUT
)
::
ccof
(
-
atoms
%
llod
:,:,:,:)
!(-llod:llod,nobd,atoms%nlod,nat_l)
REAL
,
OPTIONAL
,
INTENT
(
IN
)
::
eig
(:)
!(dimension%neigd)
! ..
! .. Local Scalars ..
COMPLEX
cexp
,
phase
,
c_0
,
c_1
,
c_2
,
ci
COMPLEX
cexp
,
phase
,
c_0
,
c_1
,
c_2
,
ci
,
ctmp
,
term1
REAL
const
,
df
,
r1
,
s
,
tmk
,
wronk
REAL
s2h
,
s2h_e
(
ne
)
INTEGER
i
,
j
,
k
,
l
,
ll1
,
lm
,
n
,
nap
,
natom
,
nn
,
iatom
,
jatom
,
lmp
,
m
,
nkvec
INTEGER
inv_f
,
ie
,
ilo
,
kspin
,
iintsp
,
nintsp
,
nvmax
,
lo
,
inap
,
natom_l
LOGICAL
l_force
INTEGER
i
,
j
,
k
,
l
,
ll1
,
lm
,
n
,
natom
,
nn
,
iatom
,
jatom
,
lmp
,
m
,
nkvec
,
nbasf
INTEGER
inv_f
,
ie
,
ilo
,
iintsp
,
nintsp
,
nvmax
,
lo
,
natom_l
,
na2
! ..
! .. Local Arrays ..
INTEGER
nbasf0
(
atoms
%
nlod
,
atoms
%
nat
)
REAL
dfj
(
0
:
atoms
%
lmaxd
),
fj
(
0
:
atoms
%
lmaxd
),
fg
(
3
),
fgp
(
3
),
f
gr
(
3
),
fk
(
3
),
fkp
(
3
),
fkr
(
3
)
REAL
dfj
(
0
:
atoms
%
lmaxd
),
fj
(
0
:
atoms
%
lmaxd
),
fg
(
3
),
fgp
(
3
),
f
k
(
3
),
fkp
(
3
)
REAL
alo1
(
atoms
%
nlod
),
blo1
(
atoms
%
nlod
),
clo1
(
atoms
%
nlod
)
COMPLEX
ylm
(
(
atoms
%
lmaxd
+1
)
**
2
)
COMPLEX
ccchi
(
2
,
2
)
LOGICAL
apw
(
0
:
atoms
%
lmaxd
,
atoms
%
ntype
)
REAL
,
ALLOCATABLE
::
work_r
(:)
COMPLEX
,
ALLOCATABLE
::
work_c
(:)
!$ COMPLEX, ALLOCATABLE :: acof_l(:,:),bcof_l(:,:),ccof_l(:,:,:)
CALL
timestart
(
"abcof"
)
...
...
@@ -114,12 +110,16 @@ CONTAINS
ENDIF
!---> loop over lapws
#ifndef CPP_OLDINTEL
!!$OMP PARALLEL DO &
!!$OMP& DEFAULT(none)&
!!$OMP& PRIVATE(k,i,work_r,work_c,ccchi,kspin,fg,fk,s,r1,fj,dfj,l,df,wronk,tmk,phase,lo,nkvec,&
!!$OMP& inap,nap,j,fgr,fgp,s2h,s2h_e,fkr,fkp,ylm,ll1,m,c_0,c_1,c_2,lmp,inv_f,lm)&
!!$OMP& SHARED(n,nn,natom,natom_l,noco,atoms,sym,cell,oneD,lapw,nvmax,ne,zMat,usdus,ci,iintsp,eig,l_force,&
!!$OMP& alo1,blo1,clo1,jatom,jspin,apw,const,nbasf0,acof,bcof,ccof,force,nat_start,nat_stop)
!$OMP PARALLEL &
!$OMP& DEFAULT(none)&
!$OMP& PRIVATE(k,i,work_r,work_c,fg,fk,s,r1,fj,dfj,l,df,wronk,tmk,phase,lo,nkvec,na2,nbasf,&
!$OMP& j,fkp,fgp,ylm,ll1,m,c_0,c_1,c_2,lmp,inv_f,lm,term1,ctmp,acof_l,bcof_l,ccof_l)&
!$OMP& SHARED(n,nn,natom,natom_l,noco,atoms,sym,cell,oneD,lapw,nvmax,ne,zMat,usdus,ci,iintsp,&
!$OMP& alo1,blo1,clo1,jatom,jspin,apw,const,nbasf0,acof,bcof,ccof,nat_start,nat_stop)
!$ ALLOCATE(acof_l(size(acof,1),0:size(acof,2)-1),bcof_l(size(bcof,1),0:size(bcof,2)-1))
!$ ALLOCATE(ccof_l(-atoms%llod:atoms%llod,size(ccof,2),size(ccof,3)))
!$ acof_l=0 ; bcof_l=0 ; ccof_l=0
!$OMP DO
#endif
DO
k
=
1
,
nvmax
IF
(
zmat
%
l_real
)
THEN
...
...
@@ -147,31 +147,10 @@ CONTAINS
fj
(
l
)
=
const
*
(
df
*
usdus
%
uds
(
l
,
n
,
jspin
)
-
fj
(
l
)
*
usdus
%
duds
(
l
,
n
,
jspin
))/
wronk
ENDIF
ENDDO
! loop over l
tmk
=
tpi_const
*
(
fk
(
1
)
*
atoms
%
taual
(
1
,
jatom
)
+
&
fk
(
2
)
*
atoms
%
taual
(
2
,
jatom
)
+
&
fk
(
3
)
*
atoms
%
taual
(
3
,
jatom
))
tmk
=
tpi_const
*
DOT_PRODUCT
(
fk
(:),
atoms
%
taual
(:,
jatom
))
phase
=
CMPLX
(
COS
(
tmk
),
SIN
(
tmk
))
IF
(
oneD
%
odi
%
d1
)
THEN
inap
=
oneD
%
ods
%
ngopr
(
jatom
)
ELSE
nap
=
atoms
%
ngopr
(
jatom
)
inap
=
sym
%
invtab
(
nap
)
END
IF
DO
j
=
1
,
3
fkr
(
j
)
=
0.0
fgr
(
j
)
=
0.0
DO
i
=
1
,
3
IF
(
oneD
%
odi
%
d1
)
THEN
fkr
(
j
)
=
fkr
(
j
)
+
fk
(
i
)
*
oneD
%
ods
%
mrot
(
i
,
j
,
inap
)
fgr
(
j
)
=
fgr
(
j
)
+
fg
(
i
)
*
oneD
%
ods
%
mrot
(
i
,
j
,
inap
)
ELSE
fkr
(
j
)
=
fkr
(
j
)
+
fk
(
i
)
*
sym
%
mrot
(
i
,
j
,
inap
)
fgr
(
j
)
=
fgr
(
j
)
+
fg
(
i
)
*
sym
%
mrot
(
i
,
j
,
inap
)
END
IF
END
DO
END
DO
fkp
=
MATMUL
(
fkr
,
cell
%
bmat
)
fgp
=
MATMUL
(
fgr
,
cell
%
bmat
)
fkp
=
MATMUL
(
fk
(:),
cell
%
bmat
)
! fkr
fgp
=
MATMUL
(
fg
(:),
cell
%
bmat
)
! fgr
! ----> generate spherical harmonics
CALL
ylm4
(
atoms
%
lmax
(
n
),
fkp
,
ylm
)
! ----> loop over l
...
...
@@ -189,35 +168,97 @@ CONTAINS
c_1
=
conjg
(
c_1
)
*
inv_f
c_2
=
conjg
(
c_2
)
*
inv_f
IF
(
zmat
%
l_real
)
THEN
!$ IF (.false.) THEN
acof
(:
ne
,
lmp
,
natom_l
)
=
acof
(:
ne
,
lmp
,
natom_l
)
+
c_1
*
work_r
(:
ne
)
bcof
(:
ne
,
lmp
,
natom_l
)
=
bcof
(:
ne
,
lmp
,
natom_l
)
+
c_2
*
work_r
(:
ne
)
!$ ENDIF
!$ acof_l(:ne,lmp) = acof_l(:ne,lmp) + c_1 * work_r(:ne)
!$ bcof_l(:ne,lmp) = bcof_l(:ne,lmp) + c_2 * work_r(:ne)
ELSE
!$ IF (.false.) THEN
acof
(:
ne
,
lmp
,
natom_l
)
=
acof
(:
ne
,
lmp
,
natom_l
)
+
c_1
*
work_c
(:
ne
)
bcof
(:
ne
,
lmp
,
natom_l
)
=
bcof
(:
ne
,
lmp
,
natom_l
)
+
c_2
*
work_c
(:
ne
)
!$ ENDIF
!$ acof_l(:ne,lmp) = acof_l(:ne,lmp) + c_1 * work_c(:ne)
!$ bcof_l(:ne,lmp) = bcof_l(:ne,lmp) + c_2 * work_c(:ne)
END
IF
ELSE
! ----> loop over bands
IF
(
zmat
%
l_real
)
THEN
acof
(:
ne
,
lm
,
natom_l
)
=
acof
(:
ne
,
lm
,
natom_l
)
+
c_1
*
work_r
(:
ne
)
bcof
(:
ne
,
lm
,
natom_l
)
=
bcof
(:
ne
,
lm
,
natom_l
)
+
c_2
*
work_r
(:
ne
)
ELSE
acof
(:
ne
,
lm
,
natom_l
)
=
acof
(:
ne
,
lm
,
natom_l
)
+
c_1
*
work_c
(:
ne
)
bcof
(:
ne
,
lm
,
natom_l
)
=
bcof
(:
ne
,
lm
,
natom_l
)
+
c_2
*
work_c
(:
ne
)
END
IF
! ----> loop over bands
IF
(
zmat
%
l_real
)
THEN
!$ IF (.false.) THEN
acof
(:
ne
,
lm
,
natom_l
)
=
acof
(:
ne
,
lm
,
natom_l
)
+
c_1
*
work_r
(:
ne
)
bcof
(:
ne
,
lm
,
natom_l
)
=
bcof
(:
ne
,
lm
,
natom_l
)
+
c_2
*
work_r
(:
ne
)
!$ ENDIF
!$ acof_l(:ne,lm) = acof_l(:ne,lm) + c_1 * work_r(:ne)
!$ bcof_l(:ne,lm) = bcof_l(:ne,lm) + c_2 * work_r(:ne)
ELSE
!$ IF (.false.) THEN
acof
(:
ne
,
lm
,
natom_l
)
=
acof
(:
ne
,
lm
,
natom_l
)
+
c_1
*
work_c
(:
ne
)
bcof
(:
ne
,
lm
,
natom_l
)
=
bcof
(:
ne
,
lm
,
natom_l
)
+
c_2
*
work_c
(:
ne
)
!$ ENDIF
!$ acof_l(:ne,lm) = acof_l(:ne,lm) + c_1 * work_c(:ne)
!$ bcof_l(:ne,lm) = bcof_l(:ne,lm) + c_2 * work_c(:ne)
END
IF
ENDIF
ENDDO
! loop over m
ENDDO
! loop over l
DO
lo
=
1
,
atoms
%
nlo
(
n
)
DO
nkvec
=
1
,
lapw
%
nkvec
(
lo
,
jatom
)
IF
(
k
==
lapw
%
kvec
(
nkvec
,
lo
,
jatom
))
THEN
!check if this k-vector has LO attached
CALL
abclocdn_soc
(
atoms
,
sym
,
noco
,
lapw
,
cell
,
ccchi
(:,
jspin
),
iintsp
,
phase
,
ylm
,&
n
,
natom
,
natom_l
,
k
,
nkvec
,
lo
,
ne
,
alo1
,
blo1
,
clo1
,
acof
,
bcof
,
ccof
,
zMat
,
l_force
,
fgp
,
force
)
term1
=
2
*
tpi_const
/
SQRT
(
cell
%
omtil
)
*
((
atoms
%
rmt
(
n
)
**
2
)/
2
)
*
phase
IF
((
atoms
%
invsat
(
natom
)
==
0
)
.OR.
(
atoms
%
invsat
(
natom
)
==
1
))
THEN
na2
=
natom
ELSE
na2
=
sym
%
invsatnr
(
natom
)
ENDIF
nbasf
=
lapw
%
nv
(
iintsp
)
+
lapw
%
index_lo
(
lo
,
na2
)
+
nkvec
l
=
atoms
%
llo
(
lo
,
n
)
ll1
=
l
*
(
l
+1
)
DO
i
=
1
,
ne
DO
m
=
-
l
,
l
lm
=
ll1
+
m
!+gu_con
IF
((
atoms
%
invsat
(
natom
)
==
0
)
.OR.
(
atoms
%
invsat
(
natom
)
==
1
))
THEN
IF
(
zMat
%
l_real
)
THEN
ctmp
=
zMat
%
data_r
(
nbasf
,
i
)
*
term1
*
CONJG
(
ylm
(
ll1
+
m
+1
))
ELSE
ctmp
=
zMat
%
data_c
(
nbasf
,
i
)
*
term1
*
CONJG
(
ylm
(
ll1
+
m
+1
))
ENDIF
!$ IF (.false.) THEN
acof
(
i
,
lm
,
natom_l
)
=
acof
(
i
,
lm
,
natom_l
)
+
ctmp
*
alo1
(
lo
)
bcof
(
i
,
lm
,
natom_l
)
=
bcof
(
i
,
lm
,
natom_l
)
+
ctmp
*
blo1
(
lo
)
ccof
(
m
,
i
,
lo
,
natom_l
)
=
ccof
(
m
,
i
,
lo
,
natom_l
)
+
ctmp
*
clo1
(
lo
)
!$ ENDIF
!$ acof_l(i,lm) = acof_l(i,lm) + ctmp*alo1(lo)
!$ bcof_l(i,lm) = bcof_l(i,lm) + ctmp*blo1(lo)
!$ ccof_l(m,i,lo) = ccof_l(m,i,lo) + ctmp*clo1(lo)
ELSE
ctmp
=
zMat
%
data_c
(
nbasf
,
i
)
*
CONJG
(
term1
)
*
ylm
(
ll1
+
m
+1
)
*
(
-1
)
**
(
l
-
m
)
lmp
=
ll1
-
m
!$ IF (.false.) THEN
acof
(
i
,
lmp
,
natom_l
)
=
acof
(
i
,
lmp
,
natom_l
)
+
ctmp
*
alo1
(
lo
)
bcof
(
i
,
lmp
,
natom_l
)
=
bcof
(
i
,
lmp
,
natom_l
)
+
ctmp
*
blo1
(
lo
)
ccof
(
-
m
,
i
,
lo
,
natom_l
)
=
ccof
(
-
m
,
i
,
lo
,
natom_l
)
+
ctmp
*
clo1
(
lo
)
!$ ENDIF
!$ acof_l(i,lmp) = acof_l(i,lmp) + ctmp*alo1(lo)
!$ bcof_l(i,lmp) = bcof_l(i,lmp) + ctmp*blo1(lo)
!$ ccof_l(-m,i,lo) = ccof_l(-m,i,lo) + ctmp*clo1(lo)
ENDIF
END
DO
END
DO
ENDIF
ENDDO
END
DO
ENDDO
! loop over LAPWs (k)
#ifndef CPP_OLDINTEL
!!$OMP END PARALLEL DO
!$OMP END DO
!$OMP CRITICAL
!$ acof(:,:,natom_l) = acof(:,:,natom_l) + acof_l(:,:)
!$ bcof(:,:,natom_l) = bcof(:,:,natom_l) + bcof_l(:,:)
!$ ccof(:,:,:,natom_l) = ccof(:,:,:,natom_l) + ccof_l(:,:,:)
!$OMP END CRITICAL
!$ DEALLOCATE (acof_l,bcof_l,ccof_l)
!$OMP END PARALLEL
#endif
IF
(
zmat
%
l_real
)
THEN
DEALLOCATE
(
work_r
)
...
...
eigen_soc/hsohelp.F90
View file @
0c6b3548
...
...
@@ -51,8 +51,6 @@ CONTAINS
!+odim
! ..
! .. Locals ..
TYPE
(
t_atoms
)
::
atoms_local
TYPE
(
t_noco
)
::
noco_local
TYPE
(
t_mat
)
::
zMat_local
INTEGER
ispin
,
l
,
n
,
na
,
ie
,
lm
,
ll1
,
nv1
(
DIMENSION
%
jspd
),
m
,
lmd
INTEGER
,
ALLOCATABLE
::
g1
(:,:),
g2
(:,:),
g3
(:,:)
...
...
@@ -60,12 +58,7 @@ CONTAINS
!
! turn off the non-collinear part of abcof
!
noco_local
=
noco
noco_local
%
l_ss
=
.FALSE.
lmd
=
atoms
%
lmaxd
*
(
atoms
%
lmaxd
+2
)
noco_local
%
qss
(:)
=
0.0
atoms_local
=
atoms
atoms_local
%
ngopr
(:)
=
1
! use unrotated coeffs...
!
! some praparations to match array sizes
!
...
...
@@ -89,8 +82,8 @@ CONTAINS
zMat_local
%
matsize2
=
DIMENSION
%
neigd
ALLOCATE
(
zMat_local
%
data_c
(
zmat
(
1
)
%
matsize1
,
DIMENSION
%
neigd
))
zMat_local
%
data_c
(:,:)
=
zso
(:,
1
:
DIMENSION
%
neigd
,
ispin
)
CALL
abcof_soc
(
input
,
atoms
_local
,
sym
,
cell
,
lapw
,
nsz
(
ispin
),&
usdus
,
noco
_local
,
ispin
,
oneD
,
nat_start
,
nat_stop
,
nat_l
,&
CALL
abcof_soc
(
input
,
atoms
,
sym
,
cell
,
lapw
,
nsz
(
ispin
),&
usdus
,
noco
,
ispin
,
oneD
,
nat_start
,
nat_stop
,
nat_l
,&
acof
,
bcof
,
chelp
(
-
atoms
%
llod
:,:,:,:,
ispin
),
zMat_local
)
DEALLOCATE
(
zMat_local
%
data_c
)
!
...
...
@@ -109,15 +102,14 @@ CONTAINS
ENDDO
ENDDO
ENDDO
chelp
(:,:,:,:,
ispin
)
=
(
chelp
(:,:,:,:,
ispin
))
ELSE
zMat_local
%
l_real
=
zmat
(
1
)
%
l_real
zMat_local
%
matsize1
=
zmat
(
1
)
%
matsize1
zMat_local
%
matsize2
=
DIMENSION
%
neigd
ALLOCATE
(
zMat_local
%
data_c
(
zmat
(
1
)
%
matsize1
,
DIMENSION
%
neigd
))
zMat_local
%
data_c
(:,:)
=
zmat
(
ispin
)
%
data_c
(:,:)
CALL
abcof_soc
(
input
,
atoms
_local
,
sym
,
cell
,
lapw
,
nsz
(
ispin
),&
usdus
,
noco_local
,
ispin
,
oneD
,
nat_start
,
nat_stop
,
nat_l
,&
CALL
abcof_soc
(
input
,
atoms
,
sym
,
cell
,
lapw
,
nsz
(
ispin
),&
usdus
,
noco
,
ispin
,
oneD
,
nat_start
,
nat_stop
,
nat_l
,&
acof
,
bcof
,
chelp
(
-
atoms
%
llod
:,:,:,:,
ispin
),
zMat_local
)
DEALLOCATE
(
zMat_local
%
data_c
)
!
...
...
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