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
54
Issues
54
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
59e03acc
Commit
59e03acc
authored
May 29, 2019
by
Daniel Wortmann
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Further refactoring of Wannier code. Should compile and run simple example~
parent
13992254
Changes
15
Expand all
Show whitespace changes
Inline
Side-by-side
Showing
15 changed files
with
3770 additions
and
4263 deletions
+3770
-4263
wannier/CMakeLists.txt
wannier/CMakeLists.txt
+5
-5
wannier/uhu/wann_uHu.F
wannier/uhu/wann_uHu.F
+2
-6
wannier/uhu/wann_uHu_dmi.F
wannier/uhu/wann_uHu_dmi.F
+2
-6
wannier/wann_abinv.f
wannier/wann_abinv.f
+0
-114
wannier/wann_abinv.f90
wannier/wann_abinv.f90
+55
-0
wannier/wann_anglmom.f
wannier/wann_anglmom.f
+0
-260
wannier/wann_anglmom.f90
wannier/wann_anglmom.f90
+251
-0
wannier/wann_orbcomp.f
wannier/wann_orbcomp.f
+0
-431
wannier/wann_orbcomp.f90
wannier/wann_orbcomp.f90
+424
-0
wannier/wann_plot_um_dat.F
wannier/wann_plot_um_dat.F
+1
-3
wannier/wann_postproc.F
wannier/wann_postproc.F
+0
-563
wannier/wann_postproc.F90
wannier/wann_postproc.F90
+506
-0
wannier/wann_updown.F
wannier/wann_updown.F
+3
-5
wannier/wannier.F
wannier/wannier.F
+0
-2870
wannier/wannier.F90
wannier/wannier.F90
+2521
-0
No files found.
wannier/CMakeLists.txt
View file @
59e03acc
...
...
@@ -4,9 +4,7 @@ wannier/eulerrot.f
#wannier/w90kpunktgen.f
wannier/wann_1dvacabcof.F
wannier/wann_2dvacabcof.F
wannier/wann_abinv.f
wannier/wann_amn.f
wannier/wann_anglmom.f
wannier/wann_dipole2.f
wannier/wann_dipole3.f
wannier/wann_dipole_electronic.f
...
...
@@ -27,7 +25,6 @@ wannier/wann_gwf_commat.f
wannier/wann_gwf_tools.f
wannier/wann_gwf_write_mmnk.F
wannier/wann_hopping.F
wannier/wannier.F
wannier/wannier_to_lapw.F
wannier/wann_ioncharge_gen.f
wannier/wann_kpointgen.f
...
...
@@ -52,7 +49,6 @@ wannier/wann_mmnk_symm.f
wannier/wann_nabla_pauli_rs.f
wannier/wann_nabla_rs.f
wannier/wann_nocoplot.F
wannier/wann_orbcomp.f
#wannier/wann_orbmag.F
wannier/wann_pauli_rs.F
wannier/wann_perpmag_rs.f
...
...
@@ -62,7 +58,6 @@ wannier/wann_plot_symm.f
wannier/wann_plot_um_dat.F
wannier/wann_plot_vac.F
#wannier/wann_plotw90.F
wannier/wann_postproc.F
wannier/wann_postproc_setup4.F
wannier/wann_postproc_setup5.F
wannier/wann_postproc_setup.F
...
...
@@ -99,6 +94,11 @@ set(fleur_F90 ${fleur_F90}
wannier/init_wannier_defaults.f90
wannier/wann_read_inp.f90
wannier/wann_optional.f90
wannier/wann_abinv.f90
wannier/wann_anglmom.f90
wannier/wannier.F90
wannier/wann_orbcomp.f90
wannier/wann_postproc.F90
)
if
(
FLEUR_USE_WANN
)
set
(
fleur_F90
${
fleur_F90
}
...
...
wannier/uhu/wann_uHu.F
View file @
59e03acc
...
...
@@ -1100,9 +1100,7 @@ c***********************************************************
DEALLOCATE
(
lapw_b
%
k1
,
lapw_b
%
k2
,
lapw_b
%
k3
)
call
wann_abinv
(
>
ntypd
,
natd
,
noccbd_b
,
lmaxd
,
lmd
,
llod
,
nlod
,
ntype
,
neq
,
>
noccbd_b
,
lmax
,
nlo
,
llo
,
invsat
,
invsatnr
,
bkpt_b
,
taual
,
call
wann_abinv
(
atoms
,
X
acof_b
,
bcof_b
,
ccof_b
)
call
cpu_time
(
t1
)
t_abcof
=
t_abcof
+
t1
-
t0
...
...
@@ -1222,9 +1220,7 @@ c***********************************************************
DEALLOCATE
(
lapw_b2
%
k1
,
lapw_b2
%
k2
,
lapw_b2
%
k3
)
call
wann_abinv
(
>
ntypd
,
natd
,
noccbd_b2
,
lmaxd
,
lmd
,
llod
,
nlod
,
ntype
,
neq
,
>
noccbd_b2
,
lmax
,
nlo
,
llo
,
invsat
,
invsatnr
,
bkpt_b2
,
taual
,
call
wann_abinv
(
atoms
,
X
acof_b2
,
bcof_b2
,
ccof_b2
)
call
cpu_time
(
t1
)
t_abcof
=
t_abcof
+
t1
-
t0
...
...
wannier/uhu/wann_uHu_dmi.F
View file @
59e03acc
...
...
@@ -1073,9 +1073,7 @@ c***********************************************************
DEALLOCATE
(
lapw_b
%
k1
,
lapw_b
%
k2
,
lapw_b
%
k3
)
call
wann_abinv
(
>
ntypd
,
natd
,
noccbd_b
,
lmaxd
,
lmd
,
llod
,
nlod
,
ntype
,
neq
,
>
noccbd_b
,
lmax
,
nlo
,
llo
,
invsat
,
invsatnr
,
bkpt_b
,
taual
,
call
wann_abinv
(
atoms
,
X
acof_b
,
bcof_b
,
ccof_b
)
call
cpu_time
(
t1
)
t_abcof
=
t_abcof
+
t1
-
t0
...
...
@@ -1205,9 +1203,7 @@ c***********************************************************
DEALLOCATE
(
lapw_b2
%
k1
,
lapw_b2
%
k2
,
lapw_b2
%
k3
)
call
wann_abinv
(
>
ntypd
,
natd
,
noccbd_b2
,
lmaxd
,
lmd
,
llod
,
nlod
,
ntype
,
neq
,
>
noccbd_b2
,
lmax
,
nlo
,
llo
,
invsat
,
invsatnr
,
bkpt_b2
,
taual
,
call
wann_abinv
(
atoms
,
X
acof_b2
,
bcof_b2
,
ccof_b2
)
call
cpu_time
(
t1
)
t_abcof
=
t_abcof
+
t1
-
t0
...
...
wannier/wann_abinv.f
deleted
100644 → 0
View file @
13992254
!--------------------------------------------------------------------------------
! 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_wann_abinv
contains
SUBROUTINE
wann_abinv
(
>
ntypd
,
natd
,
neigd
,
lmaxd
,
lmd
,
llod
,
nlod
,
ntype
,
neq
,
>
neig
,
lmax
,
nlo
,
llo
,
invsat
,
invsatnr
,
bkpt
,
taual
,
X
acof
,
bcof
,
ccof
)
C
***************************************************************
C
Transform
acof
,
bcof
,
ccof
in
case
of
atoms
related
by
inversion
c
symmetry
to
obtain
the
coefficients
in
the
global
frame
.
c
Based
on
abcrot
.
c
Frank
Freimuth
C
***************************************************************
use
m_constants
,
only
:
pimach
IMPLICIT
NONE
C
..
C
..
Scalar
Arguments
..
INTEGER
,
INTENT
(
IN
)
::
ntypd
,
natd
,
neigd
,
lmd
,
llod
,
nlod
,
ntype
INTEGER
,
INTENT
(
IN
)
::
lmaxd
,
neig
C
..
C
..
Array
Arguments
..
INTEGER
,
INTENT
(
IN
)
::
neq
(
ntypd
),
lmax
(
ntypd
),
nlo
(
ntypd
)
INTEGER
,
INTENT
(
IN
)
::
llo
(
nlod
,
ntypd
)
INTEGER
,
INTENT
(
IN
)
::
invsat
(
natd
),
invsatnr
(
natd
)
real
,
intent
(
in
)
::
bkpt
(
3
)
REAL
,
INTENT
(
IN
)
::
taual
(
3
,
natd
)
COMPLEX
,
INTENT
(
INOUT
)
::
acof
(
neigd
,
0
:
lmd
,
natd
)
COMPLEX
,
INTENT
(
INOUT
)
::
bcof
(
neigd
,
0
:
lmd
,
natd
)
COMPLEX
,
INTENT
(
INOUT
)
::
ccof
(
-
llod
:
llod
,
neigd
,
nlod
,
natd
)
C
..
Local
Scalars
..
INTEGER
::
itype
,
ineq
,
iatom
,
iop
,
ilo
,
i
,
l
,
m
,
lm
,
lmp
,
ifac
integer
::
n
,
nn
,
jatom
,
ie
,
ll1
real
::
tpi
,
arg
complex
::
fac
C
..
tpi
=
2.0
*
pimach
()
iatom
=
0
DO
itype
=
1
,
ntype
DO
ineq
=
1
,
neq
(
itype
)
iatom
=
iatom
+1
IF
(
invsat
(
iatom
)
.ne.
2
)
cycle
DO
l
=
1
,
lmax
(
itype
),
2
DO
i
=
1
,
neig
acof
(
i
,
l
**
2
:
l
*
(
l
+2
),
iatom
)
=
(
-1
)
**
l
*
&
acof
(
i
,
l
**
2
:
l
*
(
l
+2
),
iatom
)
bcof
(
i
,
l
**
2
:
l
*
(
l
+2
),
iatom
)
=
(
-1
)
**
l
*
&
bcof
(
i
,
l
**
2
:
l
*
(
l
+2
),
iatom
)
ENDDO
ENDDO
DO
ilo
=
1
,
nlo
(
itype
)
l
=
llo
(
ilo
,
itype
)
IF
(
l
.gt.
0
)
THEN
if
(
mod
(
l
,
2
)
.eq.
0
)
cycle
DO
i
=
1
,
neig
ccof
(
-
l
:
l
,
i
,
ilo
,
iatom
)
=
(
-1
)
**
l
*
&
ccof
(
-
l
:
l
,
i
,
ilo
,
iatom
)
ENDDO
ENDIF
ENDDO
ENDDO
ENDDO
c
$$$
iatom
=
0
c
$$$
DO
n
=
1
,
ntype
c
$$$
DO
nn
=
1
,
neq
(
n
)
c
$$$
iatom
=
iatom
+
1
c
$$$
IF
(
invsat
(
iatom
)
.EQ.
1
)
THEN
c
$$$
jatom
=
invsatnr
(
iatom
)
c
$$$
arg
=
(
taual
(
1
,
jatom
)
+
taual
(
1
,
iatom
))
*
bkpt
(
1
)
c
$$$
arg
=
arg
+
(
taual
(
2
,
jatom
)
+
taual
(
2
,
iatom
))
*
bkpt
(
2
)
c
$$$
arg
=
arg
+
(
taual
(
3
,
jatom
)
+
taual
(
3
,
iatom
))
*
bkpt
(
3
)
c
$$$
arg
=
arg
*
tpi
c
$$$
fac
=
cmplx
(
cos
(
arg
),
sin
(
arg
))
c
$$$
DO
ilo
=
1
,
nlo
(
n
)
c
$$$
l
=
llo
(
ilo
,
n
)
c
$$$
DO
m
=
-
l
,
l
c
$$$
DO
ie
=
1
,
neig
c
$$$
ccof
(
m
,
ie
,
ilo
,
jatom
)
=
fac
*
c
$$$
+
ccof
(
m
,
ie
,
ilo
,
jatom
)
c
$$$
ENDDO
c
$$$
ENDDO
c
$$$
ENDDO
c
$$$
DO
l
=
0
,
lmax
(
n
)
c
$$$
ll1
=
l
*
(
l
+1
)
c
$$$
DO
m
=-
l
,
l
c
$$$
lm
=
ll1
+
m
c
$$$
DO
ie
=
1
,
neig
c
$$$
acof
(
ie
,
lm
,
jatom
)
=
fac
*
c
$$$
*
acof
(
ie
,
lm
,
jatom
)
c
$$$
ENDDO
c
$$$
DO
ie
=
1
,
neig
c
$$$
bcof
(
ie
,
lm
,
jatom
)
=
fac
*
c
$$$
*
bcof
(
ie
,
lm
,
jatom
)
c
$$$
ENDDO
c
$$$
ENDDO
c
$$$
ENDDO
c
$$$
ENDIF
c
$$$
ENDDO
c
$$$
ENDDO
END
subroutine
end
module
wannier/wann_abinv.f90
0 → 100644
View file @
59e03acc
!--------------------------------------------------------------------------------
! 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_wann_abinv
CONTAINS
SUBROUTINE
wann_abinv
(
atoms
,
acof
,
bcof
,
ccof
)
! ***************************************************************
! Transform acof,bcof,ccof in case of atoms related by inversion
! symmetry to obtain the coefficients in the global frame.
! Based on abcrot.
! Frank Freimuth
! ***************************************************************
USE
m_types
IMPLICIT
NONE
! ..
! .. Scalar Arguments ..
TYPE
(
t_atoms
),
INTENT
(
IN
)
::
atoms
COMPLEX
,
INTENT
(
INOUT
)
::
acof
(:,
0
:,:)
COMPLEX
,
INTENT
(
INOUT
)
::
bcof
(:,
0
:,:)
COMPLEX
,
INTENT
(
INOUT
)
::
ccof
(
-
atoms
%
llod
:,:,:,:)
!(-llod:llod,neigd,nlod,natd)
! .. Local Scalars ..
INTEGER
::
itype
,
ineq
,
iatom
,
ilo
,
l
iatom
=
0
DO
itype
=
1
,
atoms
%
ntype
DO
ineq
=
1
,
atoms
%
neq
(
itype
)
iatom
=
iatom
+1
IF
(
atoms
%
invsat
(
iatom
)
.NE.
2
)
CYCLE
DO
l
=
1
,
atoms
%
lmax
(
itype
),
2
acof
(:,
l
**
2
:
l
*
(
l
+2
),
iatom
)
=
(
-1
)
**
l
*
&
acof
(:,
l
**
2
:
l
*
(
l
+2
),
iatom
)
bcof
(:,
l
**
2
:
l
*
(
l
+2
),
iatom
)
=
(
-1
)
**
l
*
&
bcof
(:,
l
**
2
:
l
*
(
l
+2
),
iatom
)
ENDDO
DO
ilo
=
1
,
atoms
%
nlo
(
itype
)
l
=
atoms
%
llo
(
ilo
,
itype
)
IF
(
l
.GT.
0
)
THEN
IF
(
MOD
(
l
,
2
)
.EQ.
0
)
CYCLE
ccof
(
-
l
:
l
,:,
ilo
,
iatom
)
=
(
-1
)
**
l
*
&
ccof
(
-
l
:
l
,:,
ilo
,
iatom
)
ENDIF
ENDDO
ENDDO
ENDDO
END
SUBROUTINE
wann_abinv
END
MODULE
m_wann_abinv
wannier/wann_anglmom.f
deleted
100755 → 0
View file @
13992254
!--------------------------------------------------------------------------------
! 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_wann_anglmom
c
***********************************************************************
c
Compute
matrix
elements
of
angular
momentum
operator
c
in
the
muffin
-
tin
spheres
.
c
c
Frank
Freimuth
c
***********************************************************************
CONTAINS
SUBROUTINE
wann_anglmom
(
>
llod
,
noccbd
,
nlod
,
natd
,
ntypd
,
lmax
,
lmd
,
>
ntype
,
neq
,
nlo
,
llo
,
acof
,
bcof
,
ccof
,
>
ddn
,
uulon
,
dulon
,
uloulopn
,
=
mmn
)
implicit
none
c
..
scalar
arguments
..
integer
,
intent
(
in
)
::
llod
,
nlod
,
natd
,
ntypd
,
lmd
integer
,
intent
(
in
)
::
ntype
,
noccbd
c
..
array
arguments
..
integer
,
intent
(
in
)
::
neq
(:)
!neq(ntypd)
integer
,
intent
(
in
)
::
nlo
(:)
!nlo(ntypd)
integer
,
intent
(
in
)
::
lmax
(:)
!lmax(ntypd)
integer
,
intent
(
in
)
::
llo
(:,:)
!llo(nlod,ntypd)
real
,
intent
(
in
)
::
ddn
(
0
:,:)
!ddn(0:lmaxd,ntypd)
real
,
intent
(
in
)
::
uloulopn
(:,:,:)
!uloulopn(nlod,nlod,ntypd)
real
,
intent
(
in
)
::
uulon
(:,:)
!uulon(nlod,ntypd)
real
,
intent
(
in
)
::
dulon
(:,:)
!dulon(nlod,ntypd)
complex
,
intent
(
in
)
::
ccof
(
-
llod
:,:,:,:)
!ccof(-llod:llod,noccbd,nlod,natd)
complex
,
intent
(
in
)
::
acof
(:,
0
:,:)
!acof(noccbd,0:lmd,natd)
complex
,
intent
(
in
)
::
bcof
(:,
0
:,:)
!bcof(noccbd,0:lmd,natd)
complex
,
intent
(
inout
)
::
mmn
(:,:,:)
!mmn(3,noccbd,noccbd)
c
..
local
scalars
..
logical
::
l_select
integer
::
i
,
j
,
l
,
lo
,
lop
,
m
,
natom
,
nn
,
ntyp
integer
::
nt1
,
nt2
,
lm
,
n
,
ll1
,
indat
complex
::
suma_z
,
sumb_z
complex
::
suma_p
,
sumb_p
complex
::
suma_m
,
sumb_m
complex
::
suma_x
,
sumb_x
complex
::
suma_y
,
sumb_y
real
::
lplus
,
lminus
C
..
C
..
local
arrays
..
complex
,
allocatable
::
qlo_z
(:,:,:,:,:)
complex
,
allocatable
::
qlo_p
(:,:,:,:,:)
complex
,
allocatable
::
qlo_m
(:,:,:,:,:)
complex
,
allocatable
::
qaclo_z
(:,:,:,:),
qbclo_z
(:,:,:,:)
complex
,
allocatable
::
qaclo_p
(:,:,:,:),
qbclo_p
(:,:,:,:)
complex
,
allocatable
::
qaclo_m
(:,:,:,:),
qbclo_m
(:,:,:,:)
C
..
C
..
intrinsic
functions
..
intrinsic
conjg
allocate
(
qlo_z
(
noccbd
,
noccbd
,
nlod
,
nlod
,
ntypd
),
+
qaclo_z
(
noccbd
,
noccbd
,
nlod
,
ntypd
),
+
qbclo_z
(
noccbd
,
noccbd
,
nlod
,
ntypd
)
)
allocate
(
qlo_p
(
noccbd
,
noccbd
,
nlod
,
nlod
,
ntypd
),
+
qaclo_p
(
noccbd
,
noccbd
,
nlod
,
ntypd
),
+
qbclo_p
(
noccbd
,
noccbd
,
nlod
,
ntypd
)
)
allocate
(
qlo_m
(
noccbd
,
noccbd
,
nlod
,
nlod
,
ntypd
),
+
qaclo_m
(
noccbd
,
noccbd
,
nlod
,
ntypd
),
+
qbclo_m
(
noccbd
,
noccbd
,
nlod
,
ntypd
)
)
inquire
(
file
=
'select_anglmom'
,
exist
=
l_select
)
write
(
*
,
*
)
'select_anglmom: '
,
l_select
if
(
l_select
)
then
open
(
866
,
file
=
'select_anglmom'
)
read
(
866
,
*
)
indat
close
(
866
)
write
(
*
,
*
)
'anglmom for atom='
,
indat
write
(
*
,
*
)
ntype
write
(
*
,
*
)
neq
(
indat
)
endif
c
----->
lapw
-
lapw
-
Terms
do
i
=
1
,
noccbd
do
j
=
1
,
noccbd
nt1
=
1
do
n
=
1
,
ntype
nt2
=
nt1
+
neq
(
n
)
-
1
do
l
=
0
,
lmax
(
n
)
suma_z
=
cmplx
(
0.
,
0.
);
sumb_z
=
cmplx
(
0.
,
0.
)
suma_m
=
cmplx
(
0.
,
0.
);
sumb_m
=
cmplx
(
0.
,
0.
)
suma_p
=
cmplx
(
0.
,
0.
);
sumb_p
=
cmplx
(
0.
,
0.
)
if
(
l_select
.and.
(
n
.ne.
indat
))
cycle
ll1
=
l
*
(
l
+1
)
do
m
=
-
l
,
l
lm
=
ll1
+
m
lplus
=
sqrt
(
real
(
(
l
-
m
)
*
(
l
+
m
+1
)
)
)
lminus
=
sqrt
(
real
(
(
l
+
m
)
*
(
l
-
m
+1
)
)
)
do
natom
=
nt1
,
nt2
suma_z
=
suma_z
+
acof
(
i
,
lm
,
natom
)
*
+
conjg
(
acof
(
j
,
lm
,
natom
))
*
real
(
m
)
sumb_z
=
sumb_z
+
bcof
(
i
,
lm
,
natom
)
*
+
conjg
(
bcof
(
j
,
lm
,
natom
))
*
real
(
m
)
if
(
m
+1.
le
.
l
)
then
suma_p
=
suma_p
+
acof
(
i
,
lm
,
natom
)
*
+
conjg
(
acof
(
j
,
lm
+1
,
natom
))
*
lplus
sumb_p
=
sumb_p
+
bcof
(
i
,
lm
,
natom
)
*
+
conjg
(
bcof
(
j
,
lm
+1
,
natom
))
*
lplus
endif
if
(
m
-1.
ge
.
-
l
)
then
suma_m
=
suma_m
+
acof
(
i
,
lm
,
natom
)
*
+
conjg
(
acof
(
j
,
lm
-1
,
natom
))
*
lminus
sumb_m
=
sumb_m
+
bcof
(
i
,
lm
,
natom
)
*
+
conjg
(
bcof
(
j
,
lm
-1
,
natom
))
*
lminus
endif
enddo
enddo
mmn
(
3
,
j
,
i
)
=
mmn
(
3
,
j
,
i
)
+
(
suma_z
+
sumb_z
*
ddn
(
l
,
n
))
suma_x
=
0.5
*
(
suma_p
+
suma_m
)
sumb_x
=
0.5
*
(
sumb_p
+
sumb_m
)
mmn
(
1
,
j
,
i
)
=
mmn
(
1
,
j
,
i
)
+
(
suma_x
+
sumb_x
*
ddn
(
l
,
n
))
suma_y
=
cmplx
(
0.0
,
-0.5
)
*
(
suma_p
-
suma_m
)
sumb_y
=
cmplx
(
0.0
,
-0.5
)
*
(
sumb_p
-
sumb_m
)
mmn
(
2
,
j
,
i
)
=
mmn
(
2
,
j
,
i
)
+
(
suma_y
+
sumb_y
*
ddn
(
l
,
n
))
enddo
! l
nt1
=
nt1
+
neq
(
n
)
enddo
! n
enddo
! j
enddo
! i
c
--->
Terms
involving
local
orbitals
.
qlo_z
=
0.0
;
qlo_p
=
0.0
;
qlo_m
=
0.0
qaclo_z
=
0.0
;
qaclo_p
=
0.0
;
qaclo_m
=
0.0
qbclo_z
=
0.0
;
qbclo_p
=
0.0
;
qbclo_m
=
0.0
natom
=
0
do
ntyp
=
1
,
ntype
do
nn
=
1
,
neq
(
ntyp
)
natom
=
natom
+
1
if
(
l_select
.and.
(
ntyp
.ne.
indat
))
cycle
do
lo
=
1
,
nlo
(
ntyp
)
l
=
llo
(
lo
,
ntyp
)
ll1
=
l
*
(
l
+1
)
do
m
=
-
l
,
l
lm
=
ll1
+
m
lplus
=
sqrt
(
real
(
(
l
-
m
)
*
(
l
+
m
+1
)
)
)
lminus
=
sqrt
(
real
(
(
l
+
m
)
*
(
l
-
m
+1
)
)
)
do
i
=
1
,
noccbd
do
j
=
1
,
noccbd
qbclo_z
(
j
,
i
,
lo
,
ntyp
)
=
qbclo_z
(
j
,
i
,
lo
,
ntyp
)
+
(
+
bcof
(
i
,
lm
,
natom
)
*
conjg
(
ccof
(
m
,
j
,
lo
,
natom
))
+
+
ccof
(
m
,
i
,
lo
,
natom
)
*
conjg
(
bcof
(
j
,
lm
,
natom
))
)
*
real
(
m
)
qaclo_z
(
j
,
i
,
lo
,
ntyp
)
=
qaclo_z
(
j
,
i
,
lo
,
ntyp
)
+
(
+
acof
(
i
,
lm
,
natom
)
*
conjg
(
ccof
(
m
,
j
,
lo
,
natom
))
+
+
ccof
(
m
,
i
,
lo
,
natom
)
*
conjg
(
acof
(
j
,
lm
,
natom
))
)
*
real
(
m
)
if
(
m
+1.
le
.
l
)
then
qbclo_p
(
j
,
i
,
lo
,
ntyp
)
=
qbclo_p
(
j
,
i
,
lo
,
ntyp
)
+
(
+
bcof
(
i
,
lm
,
natom
)
*
conjg
(
ccof
(
m
+1
,
j
,
lo
,
natom
))
+
+
ccof
(
m
,
i
,
lo
,
natom
)
*
conjg
(
bcof
(
j
,
lm
+1
,
natom
))
)
*
lplus
qaclo_p
(
j
,
i
,
lo
,
ntyp
)
=
qaclo_p
(
j
,
i
,
lo
,
ntyp
)
+
(
+
acof
(
i
,
lm
,
natom
)
*
conjg
(
ccof
(
m
+1
,
j
,
lo
,
natom
))
+
+
ccof
(
m
,
i
,
lo
,
natom
)
*
conjg
(
acof
(
j
,
lm
+1
,
natom
))
)
*
lplus
endif
if
(
m
-1.
ge
.
-
l
)
then
qbclo_m
(
j
,
i
,
lo
,
ntyp
)
=
qbclo_m
(
j
,
i
,
lo
,
ntyp
)
+
(
+
bcof
(
i
,
lm
,
natom
)
*
conjg
(
ccof
(
m
-1
,
j
,
lo
,
natom
))
+
+
ccof
(
m
,
i
,
lo
,
natom
)
*
conjg
(
bcof
(
j
,
lm
-1
,
natom
))
)
*
lminus
qaclo_m
(
j
,
i
,
lo
,
ntyp
)
=
qaclo_m
(
j
,
i
,
lo
,
ntyp
)
+
(
+
acof
(
i
,
lm
,
natom
)
*
conjg
(
ccof
(
m
-1
,
j
,
lo
,
natom
))
+
+
ccof
(
m
,
i
,
lo
,
natom
)
*
conjg
(
acof
(
j
,
lm
-1
,
natom
))
)
*
lminus
endif
enddo
!j
enddo
!i
enddo
!m
do
lop
=
1
,
nlo
(
ntyp
)
if
(
llo
(
lop
,
ntyp
)
.eq.
l
)
then
do
m
=
-
l
,
l
lplus
=
sqrt
(
real
(
(
l
-
m
)
*
(
l
+
m
+1
)
)
)
lminus
=
sqrt
(
real
(
(
l
+
m
)
*
(
l
-
m
+1
)
)
)
do
i
=
1
,
noccbd
do
j
=
1
,
noccbd
qlo_z
(
j
,
i
,
lop
,
lo
,
ntyp
)
=
qlo_z
(
j
,
i
,
lop
,
lo
,
ntyp
)
+
+
conjg
(
ccof
(
m
,
j
,
lop
,
natom
))
*
*
ccof
(
m
,
i
,
lo
,
natom
)
*
real
(
m
)
if
(
m
+1.
le
.
l
)
then
qlo_p
(
j
,
i
,
lop
,
lo
,
ntyp
)
=
+
qlo_p
(
j
,
i
,
lop
,
lo
,
ntyp
)
+
+
conjg
(
ccof
(
m
+1
,
j
,
lop
,
natom
))
*
*
ccof
(
m
,
i
,
lo
,
natom
)
*
lplus
endif
if
(
m
-1.
ge
.
-
l
)
then
qlo_m
(
j
,
i
,
lop
,
lo
,
ntyp
)
=
+
qlo_m
(
j
,
i
,
lop
,
lo
,
ntyp
)
+
+
conjg
(
ccof
(
m
-1
,
j
,
lop
,
natom
))
*
*
ccof
(
m
,
i
,
lo
,
natom
)
*
lminus
endif
enddo
! j
enddo
! i
enddo
! m
endif
enddo
! lop
enddo
! lo
enddo
! nn
enddo
! ntyp
c
--->
perform
summation
of
the
coefficients
with
the
integrals
c
--->
of
the
radial
basis
functions
do
ntyp
=
1
,
ntype
if
(
l_select
.and.
(
ntyp
.ne.
indat
)
)
cycle
do
lo
=
1
,
nlo
(
ntyp
)
l
=
llo
(
lo
,
ntyp
)
do
j
=
1
,
noccbd
do
i
=
1
,
noccbd
mmn
(
3
,
i
,
j
)
=
mmn
(
3
,
i
,
j
)
+
+
qaclo_z
(
i
,
j
,
lo
,
ntyp
)
*
uulon
(
lo
,
ntyp
)
+
+
qbclo_z
(
i
,
j
,
lo
,
ntyp
)
*
dulon
(
lo
,
ntyp
)
suma_p
=
qaclo_p
(
i
,
j
,
lo
,
ntyp
)
*
uulon
(
lo
,
ntyp
)
+
+
qbclo_p
(
i
,
j
,
lo
,
ntyp
)
*
dulon
(
lo
,
ntyp
)
suma_m
=
qaclo_m
(
i
,
j
,
lo
,
ntyp
)
*
uulon
(
lo
,
ntyp
)
+
+
qbclo_m
(
i
,
j
,
lo
,
ntyp
)
*
dulon
(
lo
,
ntyp
)
suma_x
=
0.5
*
(
suma_p
+
suma_m
)
suma_y
=
cmplx
(
0.0
,
-0.5
)
*
(
suma_p
-
suma_m
)
mmn
(
1
,
i
,
j
)
=
mmn
(
1
,
i
,
j
)
+
suma_x
mmn
(
2
,
i
,
j
)
=
mmn
(
2
,
i
,
j
)
+
suma_y
enddo
!i
enddo
!j
do
lop
=
1
,
nlo
(
ntyp
)
if
(
llo
(
lop
,
ntyp
)
.eq.
l
)
then
do
j
=
1
,
noccbd
do
i
=
1
,
noccbd
mmn
(
3
,
i
,
j
)
=
mmn
(
3
,
i
,
j
)
+
+
qlo_z
(
i
,
j
,
lop
,
lo
,
ntyp
)
*
uloulopn
(
lop
,
lo
,
ntyp
)
suma_p
=
qlo_p
(
i
,
j
,
lop
,
lo
,
ntyp
)
*
uloulopn
(
lop
,
lo
,
ntyp
)
suma_m
=
qlo_m
(
i
,
j
,
lop
,
lo
,
ntyp
)
*
uloulopn
(
lop
,
lo
,
ntyp
)
mmn
(
1
,
i
,
j
)
=
mmn
(
1
,
i
,
j
)
+
0.5
*
(
suma_p
+
suma_m
)
mmn
(
2
,
i
,
j
)
=
mmn
(
2
,
i
,
j
)
+
+
cmplx
(
0.0
,
-0.5
)
*
(
suma_p
-
suma_m
)
enddo
! i
enddo
! j
endif
enddo
!lop
enddo
!lo
enddo
!ntyp
deallocate
(
qlo_z
,
qaclo_z
,
qbclo_z
)
deallocate
(
qlo_m
,
qaclo_m
,
qbclo_m
)
deallocate
(
qlo_p
,
qaclo_p
,
qbclo_p
)
END
SUBROUTINE
wann_anglmom
END
MODULE
m_wann_anglmom
wannier/wann_anglmom.f90
0 → 100644
View file @
59e03acc
!--------------------------------------------------------------------------------
! 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_wann_anglmom
!***********************************************************************
! Compute matrix elements of angular momentum operator
! in the muffin-tin spheres.
!
! Frank Freimuth
!***********************************************************************
CONTAINS
SUBROUTINE
wann_anglmom
(
atoms
,
usdus
,
jspin
,
acof
,
bcof
,
ccof
,
mmn
)
USE
m_types
IMPLICIT
NONE
! .. scalar arguments ..
TYPE
(
t_atoms
),
INTENT
(
in
)::
atoms
TYPE
(
t_usdus
),
INTENT
(
in
)::
usdus
INTEGER
,
INTENT
(
IN
)
::
jspin
! .. array arguments ..
COMPLEX
,
INTENT
(
in
)
::
ccof
(
-
atoms
%
llod
:,:,:,:)
!ccof(-llod:llod,noccbd,atoms%nlod,natd)
COMPLEX
,
INTENT
(
in
)
::
acof
(:,
0
:,:)
!acof(noccbd,0:lmd,natd)
COMPLEX
,
INTENT
(
in
)
::
bcof
(:,
0
:,:)
!bcof(noccbd,0:lmd,natd)
COMPLEX
,
INTENT
(
inout
)
::
mmn
(:,:,:)
!mmn(3,noccbd,noccbd)
! .. local scalars ..
LOGICAL
::
l_select
INTEGER
::
i
,
j
,
l
,
lo
,
lop
,
m
,
natom
,
nn
,
ntyp
INTEGER
::
nt1
,
nt2
,
lm
,
n
,
ll1
,
indat
COMPLEX
::
suma_z
,
sumb_z
COMPLEX
::
suma_p
,
sumb_p
COMPLEX
::
suma_m
,
sumb_m
COMPLEX
::
suma_x
,
sumb_x
COMPLEX
::
suma_y
,
sumb_y
REAL
::
lplus
,
lminus
! ..
! .. local arrays ..
COMPLEX
,
ALLOCATABLE
::
qlo_z
(:,:,:,:,:)
COMPLEX
,
ALLOCATABLE
::
qlo_p
(:,:,:,:,:)
COMPLEX
,
ALLOCATABLE
::
qlo_m
(:,:,:,:,:)
COMPLEX
,
ALLOCATABLE
::
qaclo_z
(:,:,:,:),
qbclo_z
(:,:,:,:)
COMPLEX
,
ALLOCATABLE
::
qaclo_p
(:,:,:,:),
qbclo_p
(:,:,:,:)
COMPLEX
,
ALLOCATABLE
::
qaclo_m
(:,:,:,:),
qbclo_m
(:,:,:,:)
! ..
! .. intrinsic functions ..
INTRINSIC
conjg
ALLOCATE
(
qlo_z
(
SIZE
(
acof
,
1
),
SIZE
(
acof
,
1
),
atoms
%
nlod
,
atoms
%
nlod
,
atoms
%
ntype
)
&
,
qaclo_z
(
SIZE
(
acof
,
1
),
SIZE
(
acof
,
1
),
atoms
%
nlod
,
atoms
%
ntype
),&
qbclo_z
(
SIZE
(
acof
,
1
),
SIZE
(
acof
,
1
),
atoms
%
nlod
,
atoms
%
ntype
)
)
ALLOCATE
(
qlo_p
(
SIZE
(
acof
,
1
),
SIZE
(
acof
,
1
),
atoms
%
nlod
,
atoms
%
nlod
,
atoms
%
ntype
)
&
,
qaclo_p
(
SIZE
(
acof
,
1
),
SIZE
(
acof
,
1
),
atoms
%
nlod
,
atoms
%
ntype
),&
qbclo_p
(
SIZE
(
acof
,
1
),
SIZE
(
acof
,
1
),
atoms
%
nlod
,
atoms
%
ntype
)
)
ALLOCATE
(
qlo_m
(
SIZE
(
acof
,
1
),
SIZE
(
acof
,
1
),
atoms
%
nlod
,
atoms
%
nlod
,
atoms
%
ntype
)&
,
qaclo_m
(
SIZE
(
acof
,
1
),
SIZE
(
acof
,
1
),
atoms
%
nlod
,
atoms
%
ntype
),&
qbclo_m
(
SIZE
(
acof
,
1
),
SIZE
(
acof
,
1
),
atoms
%
nlod
,
atoms
%
ntype
)
)
INQUIRE
(
file
=
'select_anglmom'
,
exist
=
l_select
)
WRITE
(
*
,
*
)
'select_anglmom: '
,
l_select
IF
(
l_select
)
THEN
OPEN
(
866
,
file
=
'select_anglmom'
)
READ
(
866
,
*
)
indat
CLOSE
(
866
)
WRITE
(
*
,
*
)
'anglmom for atom='
,
indat
WRITE
(
*
,
*
)
atoms
%
ntype