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
3032c4e5
Commit
3032c4e5
authored
Aug 07, 2017
by
Gregor Michalicek
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
And more and more fixes to integrate the Wannier code
parent
5be524db
Changes
6
Expand all
Hide whitespace changes
Inline
Side-by-side
Showing
6 changed files
with
430 additions
and
328 deletions
+430
-328
wannier/uhu/wann_uHu.F
wannier/uhu/wann_uHu.F
+86
-64
wannier/uhu/wann_uHu_dmi.F
wannier/uhu/wann_uHu_dmi.F
+207
-168
wannier/uhu/wann_uHu_int.F
wannier/uhu/wann_uHu_int.F
+60
-53
wannier/uhu/wann_uHu_od_vac.F
wannier/uhu/wann_uHu_od_vac.F
+44
-24
wannier/uhu/wann_uHu_vac.F
wannier/uhu/wann_uHu_vac.F
+29
-15
wannier/wann_gwf_commat2.f
wannier/wann_gwf_commat2.f
+4
-4
No files found.
wannier/uhu/wann_uHu.F
View file @
3032c4e5
...
...
@@ -20,6 +20,7 @@ c*******************************************c
CONTAINS
SUBROUTINE
wann_uHu
(
>
DIMENSION
,
stars
,
vacuum
,
atoms
,
sphhar
,
input
,
sym
,
mpi
,
banddos
,
>
lapw
,
oneD
,
noco
,
cell
,
>
l_real
,
l_dulo
,
l_noco
,
l_ss
,
lmaxd
,
ntypd
,
>
neigd
,
natd
,
nop
,
nvd
,
jspd
,
nbasfcn
,
llod
,
nlod
,
ntype
,
>
nwdd
,
omtil
,
nlo
,
llo
,
lapw_l
,
invtab
,
mrot
,
ngopr
,
neq
,
lmax
,
...
...
@@ -79,6 +80,10 @@ c*******************************************c
TYPE
(
t_sym
),
INTENT
(
IN
)
::
sym
TYPE
(
t_mpi
),
INTENT
(
IN
)
::
mpi
TYPE
(
t_banddos
),
INTENT
(
IN
)
::
banddos
TYPE
(
t_lapw
),
INTENT
(
IN
)
::
lapw
TYPE
(
t_oneD
),
INTENT
(
IN
)
::
oneD
TYPE
(
t_noco
),
INTENT
(
IN
)
::
noco
TYPE
(
t_cell
),
INTENT
(
IN
)
::
cell
c
..
scalar
arguments
..
character
(
len
=
20
),
intent
(
in
)
::
param_file
...
...
@@ -166,15 +171,6 @@ c complex, allocatable :: uHuold(:,:)
complex
,
allocatable
::
tulod_soc
(:,:,:,:,:)
complex
,
allocatable
::
tulou_soc
(:,:,:,:,:)
complex
,
allocatable
::
tuloulo_soc
(:,:,:,:,:,:)
#if ( !defined(CPP_INVERSION) || defined(CPP_SOC) )
complex
,
allocatable
::
z
(:,:),
zz
(:,:)
complex
,
allocatable
::
z_b
(:,:)
complex
,
allocatable
::
z_b2
(:,:)
#else
real
,
allocatable
::
z
(:,:),
zz
(:,:)
real
,
allocatable
::
z_b
(:,:)
real
,
allocatable
::
z_b2
(:,:)
#endif
c
..
local
arrays
..
character
(
len
=
2
)
::
spin012
(
0
:
2
)
...
...
@@ -237,6 +233,8 @@ c ..local scalars..
complex
::
ci
TYPE
(
t_usdus
)
::
usdus
TYPE
(
t_zmat
)
::
zMat
,
zzMat
,
zMat_b
,
zMat_b2
TYPE
(
t_lapw
)
::
lapw_b
,
lapw_b2
c
.
.initializations.
.
...
...
@@ -934,7 +932,7 @@ c write(*,*)irank,ikpt
i_rec
=
i_rec
+
1
c
if
(
mod
(
i_rec
-1
,
isize
)
.eq.
irank
)
then
allocate
(
zz
(
nbasfcn
,
neigd
),
eigg
(
neigd
)
)
allocate
(
eigg
(
neigd
)
)
n_start
=
1
n_end
=
neigd
...
...
@@ -952,8 +950,21 @@ c if (mod(i_rec-1,isize).eq.irank) then
call
cpu_time
(
t1
)
t_eig
=
t_eig
+
t1
-
t0
allocate
(
z_b
(
nbasfcn
,
neigd
),
we_b
(
neigd
)
)
allocate
(
z_b2
(
nbasfcn
,
neigd
),
we_b2
(
neigd
)
)
zMat_b
%
l_real
=
zzMat
%
l_real
zMat_b2
%
l_real
=
zzMat
%
l_real
zMat_b
%
nbasfcn
=
zzMat
%
nbasfcn
zMat_b2
%
nbasfcn
=
zzMat
%
nbasfcn
zMat_b
%
nbands
=
zzMat
%
nbands
zMat_b2
%
nbands
=
zzMat
%
nbands
IF
(
zzMat
%
l_real
)
THEN
ALLOCATE
(
zMat_b
%
z_r
(
zMat
%
nbasfcn
,
zMat
%
nbands
))
ALLOCATE
(
zMat_b2
%
z_r
(
zMat
%
nbasfcn
,
zMat
%
nbands
))
ELSE
ALLOCATE
(
zMat_b
%
z_c
(
zMat
%
nbasfcn
,
zMat
%
nbands
))
ALLOCATE
(
zMat_b2
%
z_c
(
zMat
%
nbasfcn
,
zMat
%
nbands
))
END
IF
allocate
(
we_b
(
neigd
),
we_b2
(
neigd
))
!!! the cycle by the nearest neighbors (nntot) for each kpoint
...
...
@@ -978,11 +989,12 @@ c if (mod(i_rec-1,isize).eq.irank) then
nslibd_b
=
0
#if ( !defined(CPP_INVERSION) || defined(CPP_SOC) )
z_b
(:,:)
=
cmplx
(
0.
,
0.
)
#else
z_b
(:,:)
=
0.
#endif
IF
(
zzMat
%
l_real
)
THEN
zMat_b
%
z_r
=
0.0
ELSE
zMat_b
%
z_c
=
CMPLX
(
0.0
,
0.0
)
END
IF
eig_b
(:)
=
0.
do
i
=
1
,
nbands_b
...
...
@@ -1003,9 +1015,15 @@ c if (mod(i_rec-1,isize).eq.irank) then
else
funbas
=
nv_b
(
jspin
)
+
nlotot
endif
do
j
=
1
,
funbas
z_b
(
j
,
nslibd_b
)
=
zz
(
j
,
i
)
enddo
IF
(
zzMat
%
l_real
)
THEN
do
j
=
1
,
funbas
zMat_b
%
z_r
(
j
,
nslibd_b
)
=
zzMat
%
z_r
(
j
,
i
)
enddo
ELSE
do
j
=
1
,
funbas
zMat_b
%
z_c
(
j
,
nslibd_b
)
=
zzMat
%
z_c
(
j
,
i
)
enddo
END
IF
endif
enddo
...
...
@@ -1025,7 +1043,7 @@ c***********************************************************
>
tau
,
x
bkpt_b
,
k1_b
(:,:),
x
k2_b
(:,:),
k3_b
(:,:),
x
z_b
,
nsfactor_b
)
x
z
Mat
_b
,
nsfactor_b
)
else
nsfactor_b
=
cmplx
(
1.0
,
0.0
)
endif
...
...
@@ -1042,20 +1060,17 @@ c***********************************************************
>
ccof_b
(
-
llod
:
llod
,
noccbd_b
,
nlod
,
natd
)
)
call
cpu_time
(
t0
)
call
abcof
(
>
lmaxd
,
ntypd
,
neigd
,
noccbd_b
,
natd
,
nop
,
nvd
,
wannierspin
,
>
lmd
,
nbasfcn
,
llod
,
nlod
,
nlotot
,
invtab
,
>
ntype
,
mrot
,
ngopr1
,
taual
,
neq
,
lmax
,
rmt
,
omtil
,
>
bmat
,
bbmat
,
bkpt_b
,
>
k1_b
,
k2_b
,
k3_b
,
nv_b
,
nmat_b
,
noccbd_b
,
z_b
,
>
us
(
0
,
1
,
jspin
),
dus
(
0
,
1
,
jspin
),
uds
(
0
,
1
,
jspin
),
>
duds
(
0
,
1
,
jspin
),
ddn
(
0
,
1
,
jspin
),
invsat
,
invsatnr
,
>
ulos
(
1
,
1
,
jspin
),
uulon
(
1
,
1
,
jspin
),
dulon
(
1
,
1
,
jspin
),
>
dulos
(
1
,
1
,
jspin
),
llo
,
nlo
,
l_dulo
,
lapw_l
,
>
l_noco
,
l_ss
,
jspin
,
alph_i
,
beta_i
,
qpt_i
,
>
kveclo_b
,
odi
,
ods
,
<
acof_b
(
1
,
0
,
1
),
bcof_b
(
1
,
0
,
1
),
<
ccof_b
(
-
llod
,
1
,
1
,
1
))
lapw_b
=
lapw
lapw_b
%
k1
=
k1_b
lapw_b
%
k2
=
k2_b
lapw_b
%
k3
=
k3_b
lapw_b
%
nmat
=
nmat_b
lapw_b
%
nv
=
nv_b
CALL
abcof
(
input
,
atoms
,
noccbd_b
,
sym
,
cell
,
bkpt_b
,
lapw_b
,
+
noccbd_b
,
usdus
,
noco
,
jspin
,
kveclo_b
,
oneD
,
+
acof_b
,
bcof_b
,
ccof_b
,
zMat_b
)
call
wann_abinv
(
>
ntypd
,
natd
,
noccbd_b
,
lmaxd
,
lmd
,
llod
,
nlod
,
ntype
,
neq
,
...
...
@@ -1076,6 +1091,9 @@ c***********************************************************
eigg
=
0.
call
cpu_time
(
t0
)
WRITE
(
*
,
*
)
'Here probably the wrong record is read in'
WRITE
(
*
,
*
)
'Should eig_id not be dependent on iqpt_b?'
WRITE
(
*
,
*
)
'(in wann_uHu)'
CALL
cdn_read
(
>
eig_id
,
>
nvd
,
jspd
,
irank
,
isize
,
kptibz_b2
,
jspin
,
nbasfcn
,
!wannierspin instead of jspd?
...
...
@@ -1086,11 +1104,12 @@ c***********************************************************
nslibd_b2
=
0
#if ( !defined(CPP_INVERSION) || defined(CPP_SOC) )
z_b2
(:,:)
=
cmplx
(
0.
,
0.
)
#else
z_b2
(:,:)
=
0.
#endif
IF
(
zzMat
%
l_real
)
THEN
zMat_b2
%
z_r
=
0.0
ELSE
zMat_b2
%
z_c
=
CMPLX
(
0.0
,
0.0
)
END
IF
eig_b2
(:)
=
0.
do
i
=
1
,
nbands_b2
...
...
@@ -1111,9 +1130,15 @@ c***********************************************************
else
funbas
=
nv_b2
(
jspin_b
)
+
nlotot
endif
do
j
=
1
,
funbas
z_b2
(
j
,
nslibd_b2
)
=
zz
(
j
,
i
)
enddo
IF
(
zzMat
%
l_real
)
THEN
do
j
=
1
,
funbas
zMat_b2
%
z_r
(
j
,
nslibd_b2
)
=
zzMat
%
z_r
(
j
,
i
)
enddo
ELSE
do
j
=
1
,
funbas
zMat_b2
%
z_c
(
j
,
nslibd_b2
)
=
zzMat
%
z_c
(
j
,
i
)
enddo
END
IF
endif
enddo
...
...
@@ -1133,7 +1158,7 @@ c***********************************************************
>
tau
,
x
bkpt_b2
,
k1_b2
(:,:),
x
k2_b2
(:,:),
k3_b2
(:,:),
x
z_b2
,
nsfactor_b2
)
x
z
Mat
_b2
,
nsfactor_b2
)
else
nsfactor_b2
=
cmplx
(
1.0
,
0.0
)
endif
...
...
@@ -1150,20 +1175,17 @@ c***********************************************************
>
ccof_b2
(
-
llod
:
llod
,
noccbd_b2
,
nlod
,
natd
)
)
call
cpu_time
(
t0
)
call
abcof
(
>
lmaxd
,
ntypd
,
neigd
,
noccbd_b2
,
natd
,
nop
,
nvd
,
wannierspin
,
>
lmd
,
nbasfcn
,
llod
,
nlod
,
nlotot
,
invtab
,
>
ntype
,
mrot
,
ngopr1
,
taual
,
neq
,
lmax
,
rmt
,
omtil
,
>
bmat
,
bbmat
,
bkpt_b2
,
>
k1_b2
,
k2_b2
,
k3_b2
,
nv_b2
,
nmat_b2
,
noccbd_b2
,
z_b2
,
>
us
(
0
,
1
,
jspin_b
),
dus
(
0
,
1
,
jspin_b
),
uds
(
0
,
1
,
jspin_b
),
>
duds
(
0
,
1
,
jspin_b
),
ddn
(
0
,
1
,
jspin_b
),
invsat
,
invsatnr
,
>
ulos
(
1
,
1
,
jspin_b
),
uulon
(
1
,
1
,
jspin_b
),
dulon
(
1
,
1
,
jspin_b
),
>
dulos
(
1
,
1
,
jspin_b
),
llo
,
nlo
,
l_dulo
,
lapw_l
,
>
l_noco
,
l_ss
,
jspin_b
,
alph_i
,
beta_i
,
qpt_i
,
>
kveclo_b2
,
odi
,
ods
,
<
acof_b2
(
1
,
0
,
1
),
bcof_b2
(
1
,
0
,
1
),
<
ccof_b2
(
-
llod
,
1
,
1
,
1
))
lapw_b2
=
lapw
lapw_b2
%
k1
=
k1_b2
lapw_b2
%
k2
=
k2_b2
lapw_b2
%
k3
=
k3_b2
lapw_b2
%
nmat
=
nmat_b2
lapw_b2
%
nv
=
nv_b2
CALL
abcof
(
input
,
atoms
,
noccbd_b2
,
sym
,
cell
,
bkpt_b2
,
lapw_b2
,
+
noccbd_b2
,
usdus
,
noco
,
jspin_b
,
kveclo_b2
,
oneD
,
+
acof_b2
,
bcof_b2
,
ccof_b2
,
zMat_b2
)
call
wann_abinv
(
>
ntypd
,
natd
,
noccbd_b2
,
lmaxd
,
lmd
,
llod
,
nlod
,
ntype
,
neq
,
...
...
@@ -1268,7 +1290,7 @@ c endif
>
gb
(:,
ikpt_b
,
ikpt
),
>
k1_b2
(:,
jspin_b
),
k2_b2
(:,
jspin_b
),
k3_b2
(:,
jspin_b
),
>
gb
(:,
ikpt_b2
,
ikpt
),
>
bkpt
,
bbmat
,
vpw
(:,
jspin3
),
z
_b
,
z
_b2
,
rgphs
,
>
bkpt
,
bbmat
,
vpw
(:,
jspin3
),
z
Mat_b
,
zMat
_b2
,
rgphs
,
>
ustep
,
ig
,
jspin
.eq.
jspin_b
,
sign2
,
>
uHu
(:,:,
ikpt_b2
,
ikpt_b
,
i_rec
))
call
cpu_time
(
t1
)
...
...
@@ -1294,7 +1316,7 @@ c endif
>
vzxy
(:,:,:,
jspin3
),
vz
,
nslibd_b
,
nslibd_b2
,
>
jspin
,
jspin_b
,
doublespin
,
k1_b
,
k2_b
,
k3_b
,
>
k1_b2
,
k2_b2
,
k3_b2
,
wannierspin
,
nvd
,
nbasfcn
,
neigd
,
>
z
_b
,
z
_b2
,
nv_b
,
nv_b2
,
omtil
,
gb
(:,
ikpt_b
,
ikpt
),
>
z
Mat_b
,
zMat
_b2
,
nv_b
,
nv_b2
,
omtil
,
gb
(:,
ikpt_b
,
ikpt
),
>
gb
(:,
ikpt_b2
,
ikpt
),
sign2
,
>
uHu
(:,:,
ikpt_b2
,
ikpt_b
,
i_rec
))
call
cpu_time
(
t1
)
...
...
@@ -1304,12 +1326,13 @@ c endif
call
cpu_time
(
t0
)
call
wann_uHu_od_vac
(
>
DIMENSION
,
oneD
,
vacuum
,
stars
,
cell
,
>
cmplx
(
1.
,
0.
),
l_noco
,
l_soc
,
jspins
,
nlotot
,
nbnd
,
z1
,
>
nmzxyd
,
nmzd
,
nv2d
,
k1d
,
k2d
,
k3d
,
n2d
,
n3d
,
ig
,
nmzxy
,
nmz
,
>
delz
,
ig2
,
bbmat
,
evac
(
1
,
jspin4
),
evac
(
1
,
jspin4_b
),
bkpt_b
,
>
bkpt_b2
,
odi
,
vzxy
(:,:,:,
jspin3
),
vz
,
nslibd_b
,
nslibd_b2
,
>
jspin
,
jspin_b
,
doublespin
,
k1_b
,
k2_b
,
k3_b
,
k1_b2
,
k2_b2
,
>
k3_b2
,
wannierspin
,
nvd
,
area
,
nbasfcn
,
neigd
,
z_b
,
z
_b2
,
>
k3_b2
,
wannierspin
,
nvd
,
area
,
nbasfcn
,
neigd
,
zMat_b
,
zMat
_b2
,
>
nv_b
,
nv_b2
,
sk2
,
phi2
,
omtil
,
gb
(:,
ikpt_b
,
ikpt
),
>
gb
(:,
ikpt_b2
,
ikpt
),
qpt_i
,
sign2
,
>
uHu
(:,:,
ikpt_b2
,
ikpt_b
,
i_rec
))
...
...
@@ -1337,9 +1360,8 @@ c endif
deallocate
(
acof_b
,
bcof_b
,
ccof_b
)
15
continue
! end of loop by the nearest k-neighbors
deallocate
(
z_b
,
we_b
)
deallocate
(
z_b2
,
we_b2
)
deallocate
(
zz
,
eigg
)
deallocate
(
we_b
,
we_b2
)
deallocate
(
eigg
)
endif
! loop by processors
...
...
wannier/uhu/wann_uHu_dmi.F
View file @
3032c4e5
This diff is collapsed.
Click to expand it.
wannier/uhu/wann_uHu_int.F
View file @
3032c4e5
...
...
@@ -22,14 +22,18 @@ c*****************************************c
>
n3d
,
nv_b
,
nv_b2
,
nbnd
,
neigd
,
>
nslibd_b
,
nslibd_b2
,
nbasfcn
,
>
addnoco
,
addnoco2
,
>
k1_b
,
k2_b
,
k3_b
,
gb
,
>
k1_b
,
k2_b
,
k3_b
,
gb
,
>
k1_b2
,
k2_b2
,
k3_b2
,
gb2
,
>
bkpt
,
bbmat
,
vpw
,
z
_b
,
z
_b2
,
>
bkpt
,
bbmat
,
vpw
,
z
Mat_b
,
zMat
_b2
,
>
rgphs
,
ustep
,
ig
,
l_kin
,
sign
,
uHu
)
#include "cpp_double.h"
USE
m_types
implicit
none
TYPE
(
t_zmat
),
INTENT
(
IN
)
::
zMat_b
,
zMat_b2
c
.
.arguments.
.
logical
,
intent
(
in
)
::
l_kin
integer
,
intent
(
in
)
::
gb
(
3
),
gb2
(
3
)
...
...
@@ -44,36 +48,35 @@ c ..arguments..
real
,
intent
(
in
)
::
bkpt
(
3
),
bbmat
(
3
,
3
)
complex
,
intent
(
in
)
::
ustep
(
n3d
),
vpw
(
n3d
)
complex
,
intent
(
in
)
::
chi
#if ( !defined(CPP_INVERSION) || defined(CPP_SOC) )
complex
,
intent
(
in
)
::
z_b
(
nbasfcn
,
neigd
),
z_b2
(
nbasfcn
,
neigd
)
#else
real
,
intent
(
in
)
::
z_b
(
nbasfcn
,
neigd
),
z_b2
(
nbasfcn
,
neigd
)
#endif
complex
,
intent
(
inout
)
::
uHu
(
nbnd
,
nbnd
)
c
..
local
variables
..
#if (!defined(CPP_INVERSION)||defined(CPP_SOC))
complex
,
allocatable
::
vstep
(:,:)
complex
,
allocatable
::
mat
(:,:)
complex
::
th
#else
real
,
allocatable
::
vstep
(:,:)
real
,
allocatable
::
mat
(:,:)
complex
,
allocatable
::
vstep_c
(:,:)
complex
,
allocatable
::
mat_c
(:,:)
complex
::
th_c
real
,
allocatable
::
vstep_r
(:,:)
real
,
allocatable
::
mat_r
(:,:)
real
,
allocatable
::
uHu_tmp
(:,:)
real
::
th
#endif
real
::
th
_r
real
,
allocatable
::
rk_b
(:),
rk_b2
(:)
real
::
phase
,
phase2
,
ekk
,
s
(
3
)
integer
::
i
,
j
,
j1
,
j2
,
j3
,
i1
,
i2
,
i3
,
in
,
ind
allocate
(
vstep
(
nv_b2
,
nv_b
)
)
allocate
(
mat
(
nv_b
,
nslibd_b2
)
)
allocate
(
rk_b
(
nv_b
)
)
allocate
(
rk_b2
(
nv_b2
)
)
#if (!defined(CPP_INVERSION)||defined(CPP_SOC))
#else
allocate
(
uHu_tmp
(
nslibd_b
,
nslibd_b2
)
)
#endif
IF
(
zMat_b
%
l_real
)
THEN
allocate
(
uHu_tmp
(
nslibd_b
,
nslibd_b2
)
)
allocate
(
vstep_r
(
nv_b2
,
nv_b
)
)
allocate
(
mat_r
(
nv_b
,
nslibd_b2
)
)
vstep_r
(:,:)
=
0.0
ELSE
allocate
(
vstep_c
(
nv_b2
,
nv_b
)
)
allocate
(
mat_c
(
nv_b
,
nslibd_b2
)
)
vstep_c
(:,:)
=
CMPLX
(
0.0
,
0.0
)
END
IF
! set up |k+G-G(k+b1)|^2
do
i
=
1
,
nv_b
...
...
@@ -95,7 +98,6 @@ c ..local variables..
! construct vstep(g,g') ~ V(g-g')
! + Theta(g-g')*[rk_b+rk_b2]
vstep
(:,:)
=
0.0
do
i
=
1
,
nv_b
j1
=
-
k1_b
(
i
)
+
gb
(
1
)
-
gb2
(
1
)
j2
=
-
k2_b
(
i
)
+
gb
(
2
)
-
gb2
(
2
)
...
...
@@ -113,42 +115,47 @@ c ..local variables..
endif
ekk
=
rk_b
(
i
)
+
rk_b2
(
j
)
#if ( !defined(CPP_INVERSION) || defined(CPP_SOC) )
th
=
phase
*
conjg
(
vpw
(
in
))
if
(
l_kin
)
th
=
th
+
phase
*
0.25
*
ekk
*
conjg
(
ustep
(
in
))
#else
th
=
phase
*
real
(
vpw
(
in
))
if
(
l_kin
)
th
=
th
+
phase
*
0.25
*
ekk
*
real
(
ustep
(
in
))
#endif
vstep
(
j
,
i
)
=
th
IF
(
zMat_b
%
l_real
)
THEN
th_r
=
phase
*
real
(
vpw
(
in
))
if
(
l_kin
)
th_r
=
th_r
+
phase
*
0.25
*
ekk
*
real
(
ustep
(
in
))
vstep_r
(
j
,
i
)
=
th_r
ELSE
th_c
=
phase
*
conjg
(
vpw
(
in
))
if
(
l_kin
)
th_c
=
th_c
+
phase
*
0.25
*
ekk
*
conjg
(
ustep
(
in
))
vstep_c
(
j
,
i
)
=
th_c
END
IF
enddo
enddo
! complex conjugate of (z(k+b1,g))^* vstep(g,g') z(k+b2,g')
#if (!defined(CPP_INVERSION) || defined(CPP_SOC))
call
CPP_BLAS_cgemm
(
'T'
,
'N'
,
nv_b
,
nslibd_b2
,
nv_b2
,
cmplx
(
1.0
),
>
vstep
,
nv_b2
,
z_b2
(
1
+
addnoco2
,
1
),
nbasfcn
,
>
cmplx
(
0.0
),
mat
,
nv_b
)
mat
=
conjg
(
mat
)
call
CPP_BLAS_cgemm
(
'T'
,
'N'
,
nslibd_b
,
nslibd_b2
,
nv_b
,
>
chi
,
z_b
(
1
+
addnoco
,
1
),
nbasfcn
,
>
mat
,
nv_b
,
cmplx
(
1.0
),
uHu
,
nbnd
)
#else
call
CPP_BLAS_sgemm
(
'T'
,
'N'
,
nv_b
,
nslibd_b2
,
nv_b2
,
real
(
1.0
),
>
vstep
,
nv_b2
,
z_b2
(
1
+
addnoco2
,
1
),
nbasfcn
,
>
real
(
0.0
),
mat
,
nv_b
)
call
CPP_BLAS_sgemm
(
'T'
,
'N'
,
nslibd_b
,
nslibd_b2
,
nv_b
,
>
real
(
1.0
),
z_b
(
1
+
addnoco
,
1
),
nbasfcn
,
>
mat
,
nv_b
,
real
(
0.0
),
uHu_tmp
,
nslibd_b
)
uHu
(
1
:
nslibd_b
,
1
:
nslibd_b2
)
=
uHu
(
1
:
nslibd_b
,
1
:
nslibd_b2
)
IF
(
zMat_b
%
l_real
)
THEN
call
CPP_BLAS_sgemm
(
'T'
,
'N'
,
nv_b
,
nslibd_b2
,
nv_b2
,
real
(
1.0
),
>
vstep_r
,
nv_b2
,
zMat_b2
%
z_r
(
1
+
addnoco2
,
1
),
nbasfcn
,
>
real
(
0.0
),
mat_r
,
nv_b
)
call
CPP_BLAS_sgemm
(
'T'
,
'N'
,
nslibd_b
,
nslibd_b2
,
nv_b
,
>
real
(
1.0
),
zMat_b
%
z_r
(
1
+
addnoco
,
1
),
nbasfcn
,
>
mat_r
,
nv_b
,
real
(
0.0
),
uHu_tmp
,
nslibd_b
)
uHu
(
1
:
nslibd_b
,
1
:
nslibd_b2
)
=
uHu
(
1
:
nslibd_b
,
1
:
nslibd_b2
)
>
+
uHu_tmp
(
1
:
nslibd_b
,
1
:
nslibd_b2
)
*
chi
#endif
ELSE
call
CPP_BLAS_cgemm
(
'T'
,
'N'
,
nv_b
,
nslibd_b2
,
nv_b2
,
cmplx
(
1.0
),
>
vstep_c
,
nv_b2
,
zMat_b2
%
z_c
(
1
+
addnoco2
,
1
),
nbasfcn
,
>
cmplx
(
0.0
),
mat_c
,
nv_b
)
mat_c
=
conjg
(
mat_c
)
call
CPP_BLAS_cgemm
(
'T'
,
'N'
,
nslibd_b
,
nslibd_b2
,
nv_b
,
>
chi
,
zMat_b
%
z_c
(
1
+
addnoco
,
1
),
nbasfcn
,
>
mat_c
,
nv_b
,
cmplx
(
1.0
),
uHu
,
nbnd
)
END
IF
deallocate
(
vstep
,
mat
)
deallocate
(
rk_b
,
rk_b2
)
#if (!defined(CPP_INVERSION) || defined(CPP_SOC))
#else
deallocate
(
uHu_tmp
)
#endif
IF
(
zMat_b
%
l_real
)
THEN
deallocate
(
uHu_tmp
)
deallocate
(
vstep_r
,
mat_r
)
ELSE
deallocate
(
vstep_c
,
mat_c
)
END
IF
end
subroutine
end
module
m_wann_uHu_int
wannier/uhu/wann_uHu_od_vac.F
View file @
3032c4e5
...
...
@@ -17,7 +17,7 @@ c***************************************c
>
nslibd
,
nslibd_b
,
jspin
,
jspin_b
,
ico
,
>
k1
,
k2
,
k3
,
k1_b
,
k2_b
,
k3_b
,
>
jspd
,
nvd
,
area
,
nbasfcn
,
neigd
,
>
z
,
z
_b
,
nv
,
nv_b
,
sk2
,
phi2
,
omtil
,
gb
,
gb2
,
qss
,
sign2
,
>
z
Mat
,
zMat
_b
,
nv
,
nv_b
,
sk2
,
phi2
,
omtil
,
gb
,
gb2
,
qss
,
sign2
,
<
uHu
)
use
m_constants
...
...
@@ -35,6 +35,8 @@ c***************************************c
TYPE
(
t_vacuum
),
INTENT
(
IN
)
::
vacuum
TYPE
(
t_stars
),
INTENT
(
IN
)
::
stars
TYPE
(
t_cell
),
INTENT
(
IN
)
::
cell
TYPE
(
t_zmat
),
INTENT
(
IN
)
::
zMat
,
zMat_b
c
..
scalar
Arguments
..
logical
,
intent
(
in
)
::
l_noco
,
l_soc
...
...
@@ -60,11 +62,6 @@ c ..array arguments..
integer
,
intent
(
in
)
::
k1_b
(:,:),
k2_b
(:,:),
k3_b
(:,:)
!k1_b(nvd,jspd),k2_b(nvd,jspd),k3_b(nvd,jspd)
complex
,
intent
(
inout
)
::
uHu
(:,:)
!uHu(nbnd,nbnd)
#if ( !defined(CPP_INVERSION) || defined(CPP_SOC) )
complex
,
intent
(
in
)::
z
(:,:),
z_b
(:,:)
!z(nbasfcn,neigd),z_b(nbasfcn,neigd)
#else
real
,
intent
(
in
)::
z
(:,:),
z_b
(:,:)
!z(nbasfcn,neigd),z_b(nbasfcn,neigd)
#endif
complex
,
intent
(
in
)::
vxy
(
nmzxyd
,
odi
%
n2d
-1
,
2
)
...
...
@@ -228,15 +225,26 @@ c...for the k-point
bvac
=
exp
(
-
cmplx
(
0.0
,
m
*
arg
))
*
(
ic
**
m
)
*
*
cmplx
(
-
duz
(
l
,
m
)
*
bess
(
m
)
+
-
uz
(
l
,
m
)
*
sk2
(
irec2
)
*
dbss
(
m
),
0.0
)/
/
((
wronk1
)
*
sqrt
(
omtil
))
do
n
=
1
,
nslibd
acof
(
l
,
m
,
n
)
=
acof
(
l
,
m
,
n
)
+
+
z
(
k
+
addnoco
,
n
)
*
avac
c
+
conjg
(
z
(
k
,
n
))
*
avac
bcof
(
l
,
m
,
n
)
=
bcof
(
l
,
m
,
n
)
+
+
z
(
k
+
addnoco
,
n
)
*
bvac
c
+
conjg
(
z
(
k
,
n
))
*
bvac
enddo
/
((
wronk1
)
*
sqrt
(
omtil
))
IF
(
zMat
%
l_real
)
THEN
do
n
=
1
,
nslibd
acof
(
l
,
m
,
n
)
=
acof
(
l
,
m
,
n
)
+
+
zMat
%
z_r
(
k
+
addnoco
,
n
)
*
avac
c
+
conjg
(
zMat
%
z_r
(
k
,
n
))
*
avac
bcof
(
l
,
m
,
n
)
=
bcof
(
l
,
m
,
n
)
+
+
zMat
%
z_r
(
k
+
addnoco
,
n
)
*
bvac
c
+
conjg
(
zMat
%
z_r
(
k
,
n
))
*
bvac
enddo
ELSE
do
n
=
1
,
nslibd
acof
(
l
,
m
,
n
)
=
acof
(
l
,
m
,
n
)
+
+
zMat
%
z_c
(
k
+
addnoco
,
n
)
*
avac
c
+
conjg
(
zMat
%
z_c
(
k
,
n
))
*
avac
bcof
(
l
,
m
,
n
)
=
bcof
(
l
,
m
,
n
)
+
+
zMat
%
z_c
(
k
+
addnoco
,
n
)
*
bvac
c
+
conjg
(
zMat
%
z_c
(
k
,
n
))
*
bvac
enddo
END
IF
enddo
! -mb:mb
endif
enddo
...
...
@@ -273,15 +281,27 @@ c...for the b-point
bvac
=
exp
(
-
cmplx
(
0.0
,
m
*
arg
))
*
(
ic
**
m
)
*
&
cmplx
(
-
duz_b
(
l
,
m
)
*
bess
(
m
)
+
-
uz_b
(
l
,
m
)
*
sk2
(
irec2
)
*
dbss
(
m
),
0.0
)/
/
((
wronk1
)
*
sqrt
(
omtil
))
do
n
=
1
,
nslibd_b
acof_b
(
l
,
m
,
n
)
=
acof_b
(
l
,
m
,
n
)
+
+
z_b
(
k
+
addnoco2
,
n
)
*
avac
c
+
conjg
(
z
(
k
,
n
))
*
avac
bcof_b
(
l
,
m
,
n
)
=
bcof_b
(
l
,
m
,
n
)
+
+
z_b
(
k
+
addnoco2
,
n
)
*
bvac
c
+
conjg
(
z
(
k
,
n
))
*
bvac
enddo
/
((
wronk1
)
*
sqrt
(
omtil
))
IF
(
zMat_b
%
l_real
)
THEN
do
n
=
1
,
nslibd_b
acof_b
(
l
,
m
,
n
)
=
acof_b
(
l
,
m
,
n
)
+
+
zMat_b
%
z_r
(
k
+
addnoco2
,
n
)
*
avac
c
+
conjg
(
zMat_b
%
z_r
(
k
,
n
))
*
avac
bcof_b
(
l
,
m
,
n
)
=
bcof_b
(
l
,
m
,
n
)
+
+
zMat_b
%
z_r
(
k
+
addnoco2
,
n
)
*
bvac
c
+
conjg
(
zMat_b
%
z_r
(
k
,
n
))
*
bvac
enddo
ELSE
do
n
=
1
,
nslibd_b
acof_b
(
l
,
m
,
n
)
=
acof_b
(
l
,
m
,
n
)
+
+
zMat_b
%
z_c
(
k
+
addnoco2
,
n
)
*
avac
c
+
conjg
(
zMat_b
%
z_c
(
k
,
n
))
*
avac
bcof_b
(
l
,
m
,
n
)
=
bcof_b
(
l
,
m
,
n
)
+
+
zMat_b
%
z_c
(
k
+
addnoco2
,
n
)
*
bvac
c
+
conjg
(
zMat_b
%
z_c
(
k
,
n
))
*
bvac
enddo
END
IF
enddo
! -mb:mb
endif
enddo
! k = 1,nv
...
...
wannier/uhu/wann_uHu_vac.F
View file @
3032c4e5
...
...
@@ -16,13 +16,17 @@ c***************************************c
>
nmz
,
delz
,
ig2
,
nq2
,
kv2
,
area
,
bmat
,
bbmat
,
evac
,
evac_b
,
>
bkpt
,
bkpt_b
,
vzxy
,
vz
,
nslibd
,
nslibd_b
,
jspin
,
jspin_b
,
>
ico
,
k1
,
k2
,
k3
,
k1_b
,
k2_b
,
k3_b
,
jspd
,
nvd
,
nbasfcn
,
neigd
,
>
z
,
z
_b
,
nv
,
nv_b
,
omtil
,
gb
,
gb2
,
sign2
,
uHu
)
>
z
Mat
,
zMat
_b
,
nv
,
nv_b
,
omtil
,
gb
,
gb2
,
sign2
,
uHu
)
#include "cpp_double.h"
USE
m_types
use
m_constants
,
only
:
pimach
use
m_intgr
,
only
:
intgz0
use
m_d2fdz2cmplx
implicit
none
TYPE
(
t_zmat
),
INTENT
(
IN
)
::
zMat
,
zMat_b
c
..
scalar
Arguments
..
logical
,
intent
(
in
)
::
l_noco
,
l_soc
,
zrfs
integer
,
intent
(
in
)
::
nlotot
,
jspin_b
,
n2d
,
jspins
,
ico
...
...
@@ -49,12 +53,6 @@ c ..array arguments..
complex
,
intent
(
in
)
::
vzxy
(
nmzxyd
,
n2d
-1
,
2
)
complex
,
intent
(
inout
)
::
uHu
(
nbnd
,
nbnd
)
#if ( !defined(CPP_INVERSION) || defined(CPP_SOC) )
complex
,
intent
(
in
)::
z
(
nbasfcn
,
neigd
),
z_b
(
nbasfcn
,
neigd
)
#else
real
,
intent
(
in
)::
z
(
nbasfcn
,
neigd
),
z_b
(
nbasfcn
,
neigd
)
#endif
c
..
local
arrays
..
complex
,
allocatable
::
ac
(:,:),
bc
(:,:),
ac_b
(:,:),
bc_b
(:,:)
complex
,
allocatable
::
vv
(:),
fac
(:),
fac_b
(:),
fac1
(:)
...
...
@@ -275,10 +273,18 @@ c if (nvac==1) symvacvac=2
av
=
-
c_1
*
cmplx
(
dte
(
l
),
zks
*
te
(
l
)
)
bv
=
c_1
*
cmplx
(
dt
(
l
),
zks
*
t
(
l
)
)
c
----->
loop
over
basis
functions
do
n
=
1
,
nslibd
ac
(
l
,
n
)
=
ac
(
l
,
n
)
+
z
(
k
+
addnoco
,
n
)
*
av
bc
(
l
,
n
)
=
bc
(
l
,
n
)
+
z
(
k
+
addnoco
,
n
)
*
bv
enddo
IF
(
zMat
%
l_real
)
THEN
do
n
=
1
,
nslibd
ac
(
l
,
n
)
=
ac
(
l
,
n
)
+
zMat
%
z_r
(
k
+
addnoco
,
n
)
*
av
bc
(
l
,
n
)
=
bc
(
l
,
n
)
+
zMat
%
z_r
(
k
+
addnoco
,
n
)
*
bv
enddo
ELSE
do
n
=
1
,
nslibd
ac
(
l
,
n
)
=
ac
(
l
,
n
)
+
zMat
%
z_c
(
k
+
addnoco
,
n
)
*
av
bc
(
l
,
n
)
=
bc
(
l
,
n
)
+
zMat
%
z_c
(
k
+
addnoco
,
n
)
*
bv
enddo
END
IF
enddo