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
4d93df0b
Commit
4d93df0b
authored
Aug 02, 2017
by
Gregor Michalicek
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Even more adjustments to integrate the Wannier code
parent
db1020c4
Changes
13
Hide whitespace changes
Inline
Side-by-side
Showing
13 changed files
with
277 additions
and
106 deletions
+277
-106
wannier/CMakeLists.txt
wannier/CMakeLists.txt
+2
-1
wannier/abcof_small.F
wannier/abcof_small.F
+15
-11
wannier/uhu/wann_uHu_od_vac.F
wannier/uhu/wann_uHu_od_vac.F
+28
-20
wannier/uhu/wann_uHu_soc.F
wannier/uhu/wann_uHu_soc.F
+19
-12
wannier/uhu/wann_uHu_tlmplm.F
wannier/uhu/wann_uHu_tlmplm.F
+9
-7
wannier/uhu/wann_uHu_tlmplm2.F
wannier/uhu/wann_uHu_tlmplm2.F
+9
-7
wannier/uhu/wann_uHu_tlo.F
wannier/uhu/wann_uHu_tlo.F
+1
-3
wannier/wann_1dvacabcof.F
wannier/wann_1dvacabcof.F
+11
-6
wannier/wann_mmkb_od_vac.F
wannier/wann_mmkb_od_vac.F
+16
-10
wannier/wann_plot.F
wannier/wann_plot.F
+17
-14
wannier/wann_plot_od_vac.F
wannier/wann_plot_od_vac.F
+115
-0
wannier/wann_rw_eig.F
wannier/wann_rw_eig.F
+8
-6
wannier/wann_socmat.F
wannier/wann_socmat.F
+27
-9
No files found.
wannier/CMakeLists.txt
View file @
4d93df0b
...
...
@@ -23,7 +23,7 @@ wannier/wann_gwf_auxbrav.F
wannier/wann_gwf_auxovlp.F
wannier/wann_gwf_commat2.f
wannier/wann_gwf_commat.f
wannier/wann_gwf_commat_old.f
#
wannier/wann_gwf_commat_old.f
wannier/wann_gwf_tools.f
wannier/wann_gwf_write_mmnk.F
wannier/wann_hopping.F
...
...
@@ -93,6 +93,7 @@ wannier/wann_write_matrix5.F
wannier/wann_write_mmnk2.F
wannier/wann_write_mmnk.F
wannier/wann_write_nabla.F
wannier/wann_plot_od_vac.F
)
set
(
fleur_F90
${
fleur_F90
}
)
wannier/abcof_small.F
View file @
4d93df0b
MODULE
m_abcof_small
CONTAINS
SUBROUTINE
abcof_small
(
>
sym
,
atoms
,
usdus
,
lapw
,
noco
,
zMat
,
>
lmaxd
,
ntypd
,
neigd
,
nobd
,
natd
,
nop
,
nvd
,
jspd
,
>
lmd
,
nbasfcn
,
llod
,
nlod
,
nlotot
,
invtab
,
>
ntype
,
mrot
,
ngopr
,
taual
,
neq
,
lmax
,
rmt
,
omtil
,
...
...
@@ -24,6 +25,14 @@ c ************************************************************
USE
m_types
IMPLICIT
NONE
TYPE
(
t_sym
),
INTENT
(
IN
)
::
sym
TYPE
(
t_atoms
),
INTENT
(
IN
)
::
atoms
TYPE
(
t_usdus
),
INTENT
(
IN
)
::
usdus
TYPE
(
t_lapw
),
INTENT
(
IN
)
::
lapw
TYPE
(
t_noco
),
INTENT
(
IN
)
::
noco
TYPE
(
t_zMat
),
INTENT
(
IN
)
::
zMat
C
..
C
..
Scalar
Arguments
..
INTEGER
,
INTENT
(
IN
)
::
lmaxd
,
ntypd
,
neigd
,
nobd
,
natd
,
nop
,
nvd
,
jspd
...
...
@@ -116,11 +125,8 @@ c---> loop over the interstitial spin
IF
(
l_ss
)
nvmax
=
nv
(
iintsp
)
c
CALL
setabc1locdn
(
>
ntypd
,
natd
,
nlod
,
llod
,
nobd
,
lmaxd
,
nvmax
,
>
nmat
,
ne
,
ntype
,
neq
,
l_noco
,
iintsp
,
>
nlo
,
llo
,
l_dulo
,
invsat
,
invsatnr
,
ddn
,
>
us
,
dus
,
uds
,
duds
,
dulos
,
ulos
,
dulon
,
uulon
,
>
nlotot
,
kveclo
,
>
jspin
,
atoms
,
lapw
,
ne
,
noco
,
iintsp
,
sym
,
usdus
,
>
kveclo
,
<
enough
,
nkvec
,
kvec
,
nbasf0
,
ccof
,
<
alo1
,
blo1
,
clo1
)
c
...
...
@@ -268,12 +274,10 @@ c ----> loop over bands
IF
(
.NOT.
enough
(
natom
))
THEN
write
(
*
,
*
)
'.not.enough(natom)'
CALL
abclocdn
(
>
nobd
,
natd
,
nlod
,
llod
,
lmaxd
,
neigd
,
ntypd
,
>
lmd
,
nbasfcn
,
nlo
,
llo
,
invsat
,
invsatnr
,
>
l_noco
,
ccchi
(
1
,
jspin
),
kspin
,
l_ss
,
iintsp
,
>
const
,
rmt
(
n
),
phase
,
ylm
,
n
,
natom
,
k
,
s
,
nvmax
,
>
ne
,
z
,
nbasf0
,
alo1
,
blo1
,
clo1
,
kvec
(
1
,
1
,
natom
),
<
nkvec
,
enough
,
acof
,
bcof
,
ccof
)
>
atoms
,
sym
,
noco
,
ccchi
(
1
,
jspin
),
kspin
,
iintsp
,
>
const
,
phase
,
ylm
,
n
,
natom
,
k
,
s
,
nvmax
,
>
ne
,
nbasf0
,
alo1
,
blo1
,
clo1
,
kvec
(
1
,
1
,
natom
),
<
nkvec
,
enough
(
natom
),
acof
,
bcof
,
ccof
,
zMat
)
ENDIF
!ENDDO ! loop over LAPWs
ENDIF
! invsatom == ( 0 v 1 )
...
...
wannier/uhu/wann_uHu_od_vac.F
View file @
4d93df0b
...
...
@@ -8,7 +8,8 @@ c J.-P. Hanke, Dec. 2015 c
c
***************************************
c
MODULE
m_wann_uHu_od_vac
CONTAINS
SUBROUTINE
wann_uHu_od_vac
(
SUBROUTINE
wann_uHu_od_vac
(
>
DIMENSION
,
oneD
,
vacuum
,
stars
,
cell
,
>
chi
,
l_noco
,
l_soc
,
jspins
,
nlotot
,
>
nbnd
,
z1
,
nmzxyd
,
nmzd
,
nv2d
,
k1d
,
k2d
,
k3d
,
n2d
,
n3d
,
>
ig
,
nmzxy
,
nmz
,
delz
,
ig2
,
...
...
@@ -17,17 +18,24 @@ c***************************************c
>
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
,
<
uHu
)
use
m_constants
,
only
:
pimach
use
m_od_types
,
only
:
od_inp
<
uHu
)
use
m_constants
use
m_types
use
m_od_abvac
use
m_cylbes
use
m_dcylbs
use
m_intgr
,
only
:
intgz0
use
m_d2fdz2
use
m_dotir
implicit
none
implicit
none
TYPE
(
t_dimension
),
INTENT
(
IN
)
::
DIMENSION
TYPE
(
t_oneD
),
INTENT
(
IN
)
::
oneD
TYPE
(
t_vacuum
),
INTENT
(
IN
)
::
vacuum
TYPE
(
t_stars
),
INTENT
(
IN
)
::
stars
TYPE
(
t_cell
),
INTENT
(
IN
)
::
cell
c
..
scalar
Arguments
..
logical
,
intent
(
in
)
::
l_noco
,
l_soc
integer
,
intent
(
in
)
::
jspins
,
nlotot
,
ico
...
...
@@ -192,11 +200,10 @@ c...for the k-point
qssbti
(
3
,
1
)
=
-
qss
(
3
)/
2.
qssbti
(
3
,
2
)
=
+
qss
(
3
)/
2.
DO
ispin
=
1
,
1
! jspins
CALL
od_abvac
(
>
z1
,
nmzxyd
,
nmzd
,
nv2d
,
k1d
,
k2d
,
k3d
,
n2d
,
n3d
,
>
ig
,
odi
%
ig
,
tpi
,
qssbti
(
3
,
jspin
),
>
nmzxy
,
nmz
,
delz
,
ig2
,
odi
%
n2d
,
>
bbmat
,
wronk
,
evac
,
bkpt
,
odi
%
M
,
odi
%
mb
,
CALL
od_abvac
(
>
cell
,
vacuum
,
DIMENSION
,
stars
,
oneD
,
>
qssbti
(
3
,
jspin
),
odi
%
n2d
,
>
wronk
,
evac
,
bkpt
,
odi
%
M
,
odi
%
mb
,
>
vz
(
1
,
ivac
,
jspin2
),
kvac3
,
nv2
,
<
uz
(
1
,
-
odi
%
mb
),
duz
(
1
,
-
odi
%
mb
),
u
(
1
,
1
,
-
odi
%
mb
),
udz
(
1
,
-
odi
%
mb
),
<
dudz
(
1
,
-
odi
%
mb
),
ddnv
(
1
,
-
odi
%
mb
),
ud
(
1
,
1
,
-
odi
%
mb
))
...
...
@@ -237,11 +244,10 @@ c + conjg(z(k,n))*bvac
c
...
for
the
b
-
point
DO
ispin
=
1
,
1
! jspins
call
od_abvac
(
>
z1
,
nmzxyd
,
nmzd
,
nv2d
,
k1d
,
k2d
,
k3d
,
n2d
,
n3d
,
>
ig
,
odi
%
ig
,
tpi
,
qssbti
(
3
,
jspin_b
),
>
nmzxy
,
nmz
,
delz
,
ig2
,
odi
%
n2d
,
>
bbmat
,
wronk
,
evac_b
,
bkpt_b
,
odi
%
M
,
odi
%
mb
,
call
od_abvac
(
>
cell
,
vacuum
,
DIMENSION
,
stars
,
oneD
,
>
qssbti
(
3
,
jspin_b
),
odi
%
n2d
,
>
wronk
,
evac_b
,
bkpt_b
,
odi
%
M
,
odi
%
mb
,
>
vz
(
1
,
ivac
,
jspin2_b
),
kvac3_b
,
nv2_b
,
<
uz_b
(
1
,
-
odi
%
mb
),
duz_b
(
1
,
-
odi
%
mb
),
u_b
(
1
,
1
,
-
odi
%
mb
),
<
udz_b
(
1
,
-
odi
%
mb
),
...
...
@@ -417,13 +423,15 @@ c now actually computing the uHu matrix
! determine |G+k+b1|^2 and |G'+k+b2|^2
s
(
1
)
=
0.0
s
(
2
)
=
0.0
s
(
3
)
=
bkpt
(
3
)
+
kvac3
(
l
)
+
qssbti
(
3
,
jspin
)
!-gb(3)
rk
=
dotirp
(
s
,
s
,
bbmat
)
s
(
3
)
=
bkpt
(
3
)
+
kvac3
(
l
)
+
qssbti
(
3
,
jspin
)
!-gb(3)
rk
=
dot_product
(
s
,
matmul
(
bbmat
,
s
))
! rk = dotirp(s,s,bbmat)
s
(
1
)
=
0.0
s
(
2
)
=
0.0
s
(
3
)
=
bkpt_b
(
3
)
+
kvac3_b
(
lp
)
+
qssbti
(
3
,
jspin_b
)
!-gb2(3)
rk_b
=
dotirp
(
s
,
s
,
bbmat
)
s
(
3
)
=
bkpt_b
(
3
)
+
kvac3_b
(
lp
)
+
qssbti
(
3
,
jspin_b
)
!-gb2(3)
rk_b
=
dot_product
(
s
,
matmul
(
bbmat
,
s
))
! rk_b = dotirp(s,s,bbmat)
! construct symmetrized 'pseudopotential'
! TODO: valid to simply symmetrize?
...
...
wannier/uhu/wann_uHu_soc.F
View file @
4d93df0b
...
...
@@ -10,6 +10,7 @@ c*****************************************c
MODULE
m_wann_uHu_soc
CONTAINS
SUBROUTINE
wann_uHu_soc
(
>
input
,
atoms
,
>
ntypd
,
jmtd
,
lmaxd
,
jspd
,
ntype
,
dx
,
rmsh
,
jri
,
lmax
,
>
natd
,
lmd
,
lmplmd
,
neq
,
irank
,
nlod
,
llod
,
loplod
,
>
ello
,
llo
,
nlo
,
lo1l
,
l_dulo
,
ulo_der
,
f
,
g
,
flo
,
f_b
,
...
...
@@ -21,21 +22,24 @@ c*****************************************c
USE
m_intgr
,
ONLY
:
intgr0
USE
m_sphbes
USE
m_dotir
USE
m_ylm
USE
m_cotra
USE
m_gaunt
,
ONLY
:
gaunt1
USE
m_sointg
USE
m_constants
,
ONLY
:
c_light
USE
m_wann_uHu_soc_tlo
USE
m_constants
USE
m_wann_uHu_soc_tlo
USE
m_types
IMPLICIT
NONE
REAL
::
sgml
COMPLEX
::
anglso
EXTERNAL
sgml
,
anglso
C
..
Intrinsic
Functions
..
INTRINSIC
abs
,
cmplx
,
max
,
mod
C
..
TYPE
(
t_input
),
INTENT
(
IN
)
::
input
TYPE
(
t_atoms
),
INTENT
(
IN
)
::
atoms
C
..
Scalar
Arguments
..
LOGICAL
,
INTENT
(
IN
)
::
l_noco
,
l_skip_loc
INTEGER
,
INTENT
(
IN
)
::
ntypd
,
jmtd
,
lmaxd
,
jspd
,
jspins
...
...
@@ -167,7 +171,8 @@ c begin 1st neighbor loop: <k+b1| c
c
***************************************
c
do
ikpt_b
=
1
,
nntot
bpt
=
kdiff
(:,
ikpt_b
)
rk1
=
sqrt
(
dotirp
(
bpt
,
bpt
,
bbmat
))
rk1
=
sqrt
(
dot_product
(
bpt
,
matmul
(
bbmat
,
bpt
)))
! rk1= sqrt(dotirp(bpt,bpt,bbmat))
c
***************************************
c
c
begin
2
nd
neighbor
loop
:
|
k
+
b2
>
c
...
...
@@ -176,7 +181,8 @@ c***************************************c
indexx
=
ikpt_b2
+
(
ikpt_b
-1
)
*
nntot2
bpt2
=
kdiff2
(:,
ikpt_b2
)
rk2
=
sqrt
(
dotirp
(
bpt2
,
bpt2
,
bbmat
))
rk2
=
sqrt
(
dot_product
(
bpt2
,
matmul
(
bbmat
,
bpt2
)))
! rk2= sqrt(dotirp(bpt2,bpt2,bbmat))
! loop over atoms
DO
210
n
=
1
,
ntype
...
...
@@ -201,11 +207,13 @@ c***************************************c
! set up spherical harmonics
! yl1(lm) for b1 and yl2(lm) for b2
yl1
=
cmplx
(
0.
,
0.
)
call
cotra3
(
bpt
,
bkrot
,
bmat
)
bkrot
=
MATMUL
(
bpt
,
bmat
)
! call cotra3(bpt,bkrot,bmat)
call
ylm4
(
lwn
,
bkrot
,
yl1
)
yl2
=
cmplx
(
0.
,
0.
)
call
cotra3
(
bpt2
,
bkrot
,
bmat
)
bkrot
=
MATMUL
(
bpt2
,
bmat
)
! call cotra3(bpt2,bkrot,bmat)
call
ylm4
(
lwn
,
bkrot
,
yl2
)
call
cpu_time
(
t0
)
t33
=
t33
+
t0
-
t1
...
...
@@ -243,9 +251,7 @@ c****************************************************c
> +epar(lp,n,1)+epar(lp,n,jspins) )/4.
END IF
CALL sointg(
> e,vr(:,n,:),v0,r0,dx(n),jri(n),jmtd,c,jspins,
< vso)
CALL sointg(n,e,vr(:,n,:),v0,atoms,input,vso)
! spin-averaging
if(l_spav)then
...
...
@@ -410,6 +416,7 @@ c*********************************************************c
IF((nlo(n).GE.1).AND.(.NOT.l_skip_loc)) THEN
call wann_uHu_soc_tlo(
> input,atoms,
> ntypd,jmtd,lmaxd,jspd,ntype,dx,rmsh,jri,lmax,
> natd,lmd,irank,nlod,llod,loplod,ello,llo,nlo,
> lo1l,l_dulo,ulo_der,flo,flo_b,kdiff,kdiff2,
...
...
wannier/uhu/wann_uHu_tlmplm.F
View file @
4d93df0b
...
...
@@ -33,15 +33,13 @@ c****************************************c
USE
m_radfun
USE
m_tlo
USE
m_sphbes
USE
m_dotir
USE
m_ylm
USE
m_cotra
USE
m_gaunt
,
ONLY
:
gaunt1
USE
m_dujdr
USE
m_wann_uHu_radintsra5
USE
m_wann_uHu_radintsra3
USE
m_wann_uHu_tlo
USE
m_constants
,
ONLY
:
pimach
USE
m_constants
IMPLICIT
NONE
C
..
...
...
@@ -176,7 +174,8 @@ c begin 1st neighbor loop: <k+b1| c
c
***************************************
c
do
ikpt_b
=
1
,
nntot
bpt
=
kdiff
(:,
ikpt_b
)
rk1
=
sqrt
(
dotirp
(
bpt
,
bpt
,
bbmat
))
rk1
=
sqrt
(
dot_product
(
bpt
,
matmul
(
bbmat
,
bpt
)))
! rk1= sqrt(dotirp(bpt,bpt,bbmat))
c
***************************************
c
c
begin
2
nd
neighbor
loop
:
|
k
+
b2
>
c
...
...
@@ -184,7 +183,8 @@ c***************************************c
do
ikpt_b2
=
1
,
nntot2
indexx
=
ikpt_b2
+
(
ikpt_b
-1
)
*
nntot2
bpt2
=
kdiff2
(:,
ikpt_b2
)
rk2
=
sqrt
(
dotirp
(
bpt2
,
bpt2
,
bbmat
))
rk2
=
sqrt
(
dot_product
(
bpt2
,
matmul
(
bbmat
,
bpt2
)))
! rk2= sqrt(dotirp(bpt2,bpt2,bbmat))
na
=
1
mlo
=
1
;
mlolo
=
1
...
...
@@ -219,11 +219,13 @@ c***************************************c
! set up spherical harmonics
! yl1(lm) for b1 and yl2(lm) for b2
yl1
=
cmplx
(
0.
,
0.
)
call
cotra3
(
bpt
,
bkrot
,
bmat
)
bkrot
=
MATMUL
(
bpt
,
bmat
)
! call cotra3(bpt,bkrot,bmat)
call
ylm4
(
lwn
,
bkrot
,
yl1
)
yl2
=
cmplx
(
0.
,
0.
)
call
cotra3
(
bpt2
,
bkrot
,
bmat
)
bkrot
=
MATMUL
(
bpt2
,
bmat
)
! call cotra3(bpt2,bkrot,bmat)
call
ylm4
(
lwn
,
bkrot
,
yl2
)
call
cpu_time
(
t0
)
...
...
wannier/uhu/wann_uHu_tlmplm2.F
View file @
4d93df0b
...
...
@@ -36,14 +36,12 @@ c*******************************************c
USE
m_radfun
USE
m_tlo
USE
m_sphbes
USE
m_dotir
USE
m_ylm
USE
m_cotra
USE
m_gaunt
,
ONLY
:
gaunt1
USE
m_dujdr
USE
m_wann_uHu_radintsra5
USE
m_wann_uHu_tlo
USE
m_constants
,
ONLY
:
pimach
USE
m_constants
IMPLICIT
NONE
C
..
...
...
@@ -173,7 +171,8 @@ c begin 1st neighbor loop: <k+b1| c
c
***************************************
c
do
ikpt_b
=
1
,
nntot
bpt
=
kdiff
(:,
ikpt_b
)
rk1
=
sqrt
(
dotirp
(
bpt
,
bpt
,
bbmat
))
rk1
=
sqrt
(
dot_product
(
bpt
,
matmul
(
bbmat
,
bpt
)))
! rk1= sqrt(dotirp(bpt,bpt,bbmat))
!if(irank.eq.0) write(*,*)'rk1',rk1
c
***************************************
c
...
...
@@ -182,7 +181,8 @@ c***************************************c
do
ikpt_b2
=
1
,
nntot2
indexx
=
ikpt_b2
+
(
ikpt_b
-1
)
*
nntot2
bpt2
=
kdiff2
(:,
ikpt_b2
)
rk2
=
sqrt
(
dotirp
(
bpt2
,
bpt2
,
bbmat
))
rk2
=
sqrt
(
dot_product
(
bpt2
,
matmul
(
bbmat
,
bpt2
)))
! rk2= sqrt(dotirp(bpt2,bpt2,bbmat))
if
(
rk2
.ne.
0.0
)
stop
'dmi but rk2.ne.0'
na
=
1
...
...
@@ -234,11 +234,13 @@ c endif
! set up spherical harmonics
! yl1(lm) for b1 and yl2(lm) for b2
yl1
=
cmplx
(
0.
,
0.
)
call
cotra3
(
bpt
,
bkrot
,
bmat
)
bkrot
=
MATMUL
(
bpt
,
bmat
)
! call cotra3(bpt,bkrot,bmat)
call
ylm4
(
lwn
,
bkrot
,
yl1
)
yl2
=
cmplx
(
0.
,
0.
)
call
cotra3
(
bpt2
,
bkrot
,
bmat
)
bkrot
=
MATMUL
(
bpt2
,
bmat
)
! call cotra3(bpt2,bkrot,bmat)
if
(
ANY
(
bkrot
.ne.
0.0
))
stop
'dmi but bkrot.ne.0'
call
ylm4
(
lwn
,
bkrot
,
yl2
)
!if(indexx.eq.1 .and. irank.eq.0) write(*,*)'yl2',yl2(1)
...
...
wannier/uhu/wann_uHu_tlo.F
View file @
4d93df0b
...
...
@@ -27,13 +27,11 @@ c****************************************c
USE
m_radfun
USE
m_tlo
USE
m_sphbes
USE
m_dotir
USE
m_ylm
USE
m_cotra
USE
m_gaunt
,
ONLY
:
gaunt1
USE
m_wann_uHu_radintsra3
USE
m_wann_uHu_radintsra5
USE
m_constants
,
ONLY
:
pimach
USE
m_constants
USE
m_dujdr
IMPLICIT
NONE
...
...
wannier/wann_1dvacabcof.F
View file @
4d93df0b
...
...
@@ -5,6 +5,7 @@ c********************************************************
module m_wann_1dvacabcof
contains
subroutine wann_1dvacabcof(
> DIMENSION,oneD,vacuum,stars,cell,
> nv2d,nslibd,nmzd,nmz,omtil,vz,
> nv,bkpt,z1,odi,ods,
> nvd,k1,k2,k3,evac,
...
...
@@ -13,14 +14,19 @@ c********************************************************
> phi2,k1d,k2d,k3d,
< ac,bc,u,ue,addnoco,l_ss,qss,jspin)
use m_dotir
use m_od_types
use m_types
use m_od_abvac
use m_constants
, only : pimach
use m_constants
use m_cylbes
use m_dcylbs
implicit none
TYPE(t_dimension),INTENT(IN) :: DIMENSION
TYPE(t_oneD),INTENT(IN) :: oneD
TYPE(t_vacuum),INTENT(IN) :: vacuum
TYPE(t_stars),INTENT(IN) :: stars
TYPE(t_cell),INTENT(IN) :: cell
integer,intent(in)::nv2d,n2d,n3d
integer,intent(in)::nslibd
integer,intent(in)::k1d,k2d,k3d
...
...
@@ -107,9 +113,8 @@ c********************************************************
endif
ispin=1
call od_abvac(
> z1,nmzxyd,nmzd,nv2d,k1d,k2d,k3d,n2d,n3d,
> ig,odi%ig,tpi,qssbti(3,jspin),
> nmzxy,nmz,delz,ig2,odi%n2d,bbmat,wronk,evacp,bkpt,
> cell,vacuum,DIMENSION,stars,oneD,
> qssbti(3,jspin),odi%n2d,wronk,evacp,bkpt,
> odi%M,odi%mb,vz(1,nvac),kvac3(1),nv2,
> t(1,-odi%mb),dt(1,-odi%mb),u(1,1,-odi%mb),
< te(1,-odi%mb),dte(1,-odi%mb),tei(1,-odi%mb),
...
...
wannier/wann_mmkb_od_vac.F
View file @
4d93df0b
...
...
@@ -14,6 +14,7 @@ c Y. Mokrousov, F. Freimuth
c
***************************************************************
CONTAINS
SUBROUTINE
wann_mmkb_od_vac
(
>
DIMENSION
,
oneD
,
vacuum
,
stars
,
cell
,
>
vacchi
,
l_noco
,
nlotot
,
>
nbnd
,
z1
,
nmzxyd
,
nmzd
,
nv2d
,
k1d
,
k2d
,
k3d
,
n2d
,
n3d
,
>
ig
,
nmzxy
,
nmz
,
delz
,
ig2
,
n2d_1
,
...
...
@@ -23,14 +24,21 @@ c***************************************************************
>
z
,
z_b
,
nv
,
nv_b
,
sk2
,
phi2
,
omtil
,
gb
,
qss
,
>
l_q
,
sign_q
,
<
mmn
)
use
m_constants
,
only
:
pimach
use
m_
od_types
,
only
:
od_inp
use
m_constants
use
m_
types
use
m_od_abvac
use
m_cylbes
use
m_dcylbs
use
m_intgr
,
only
:
intgz0
implicit
none
TYPE
(
t_dimension
),
INTENT
(
IN
)
::
DIMENSION
TYPE
(
t_oneD
),
INTENT
(
IN
)
::
oneD
TYPE
(
t_vacuum
),
INTENT
(
IN
)
::
vacuum
TYPE
(
t_stars
),
INTENT
(
IN
)
::
stars
TYPE
(
t_cell
),
INTENT
(
IN
)
::
cell
c
..
scalar
Arguments
..
logical
,
intent
(
in
)
::
l_noco
integer
,
intent
(
in
)
::
nlotot
...
...
@@ -173,10 +181,9 @@ c...for the k-point
qssbti
(
3
,
2
)
=
+
qss
(
3
)/
2.
DO
ispin
=
1
,
1
! jspins
CALL
od_abvac
(
>
z1
,
nmzxyd
,
nmzd
,
nv2d
,
k1d
,
k2d
,
k3d
,
n2d
,
n3d
,
>
ig
,
odi
%
ig
,
tpi
,
qssbti
(
3
,
jspin
),
>
nmzxy
,
nmz
,
delz
,
ig2
,
odi
%
n2d
,
>
bbmat
,
wronk
,
evac
,
bkpt
,
odi
%
M
,
odi
%
mb
,
>
cell
,
vacuum
,
DIMENSION
,
stars
,
oneD
,
>
qssbti
(
3
,
jspin
),
odi
%
n2d
,
>
wronk
,
evac
,
bkpt
,
odi
%
M
,
odi
%
mb
,
>
vz
,
kvac3
,
nv2
,
<
uz
(
1
,
-
vM
),
duz
(
1
,
-
vM
),
u
(
1
,
1
,
-
vM
),
udz
(
1
,
-
vM
),
<
dudz
(
1
,
-
vM
),
ddnv
(
1
,
-
vM
),
ud
(
1
,
1
,
-
vM
))
...
...
@@ -218,10 +225,9 @@ c...for the b-point
DO
ispin
=
1
,
1
! jspins
call
od_abvac
(
>
z1
,
nmzxyd
,
nmzd
,
nv2d
,
k1d
,
k2d
,
k3d
,
n2d
,
n3d
,
>
ig
,
odi
%
ig
,
tpi
,
qssbti
(
3
,
jspin_b
),
>
nmzxy
,
nmz
,
delz
,
ig2
,
odi
%
n2d
,
>
bbmat
,
wronk
,
evac_b
,
bkpt_b
,
odi
%
M
,
odi
%
mb
,
>
cell
,
vacuum
,
DIMENSION
,
stars
,
oneD
,
>
qssbti
(
3
,
jspin_b
),
odi
%
n2d
,
>
wronk
,
evac_b
,
bkpt_b
,
odi
%
M
,
odi
%
mb
,
>
vz_b
,
kvac3_b
,
nv2_b
,
<
uz_b
(
1
,
-
vM
),
duz_b
(
1
,
-
vM
),
u_b
(
1
,
1
,
-
vM
),
udz_b
(
1
,
-
vM
),
<
dudz_b
(
1
,
-
vM
),
ddnv_b
(
1
,
-
vM
),
ud_b
(
1
,
1
,
-
vM
))
...
...
wannier/wann_plot.F
View file @
4d93df0b
...
...
@@ -37,7 +37,9 @@
! written to the file kk.nnne.real.jsp.xsf and kk.nnne.imag.jsp.xsf
! +++++++++++++++++++++++++++++++++++++++++++++++++
CONTAINS
SUBROUTINE
wann_plot
(
nv2d
,
jspin
,
odi
,
ods
,
n3d
,
nmzxyd
,
n2d
,
ntypsd
,
SUBROUTINE
wann_plot
(
>
DIMENSION
,
oneD
,
vacuum
,
stars
,
cell
,
atoms
,
>
nv2d
,
jspin
,
odi
,
ods
,
n3d
,
nmzxyd
,
n2d
,
ntypsd
,
>
ntype
,
lmaxd
,
jmtd
,
ntypd
,
natd
,
nmzd
,
neq
,
nq3
,
nvac
,
>
nmz
,
nmzxy
,
nq2
,
nop
,
nop2
,
volint
,
film
,
slice
,
symor
,
>
invs
,
invs2
,
z1
,
delz
,
ngopr
,
ntypsy
,
jri
,
pos
,
zatom
,
...
...
@@ -47,18 +49,24 @@
>
k1d
,
k2d
,
k3d
,
ig
,
ig2
,
sk2
,
phi2
,
l_noco
,
l_ss
,
qss
,
addnoco
,
>
index_kq
,
l_sgwf
)
! *****************************************************
USE
m_constants
,
ONLY
:
pimach
USE
m_
od_types
,
ONLY
:
od_inp
,
od_sym
USE
m_constants
USE
m_
types
USE
m_wann_real
USE
m_xsf_io
USE
m_dotir
USE
m_wann_plot_vac
USE
m_wann_2dvacabcof
USE
m_wann_plot_od_vac
USE
m_wann_1dvacabcof
IMPLICIT
NONE
! ..
TYPE
(
t_dimension
),
INTENT
(
IN
)
::
DIMENSION
TYPE
(
t_oneD
),
INTENT
(
IN
)
::
oneD
TYPE
(
t_vacuum
),
INTENT
(
IN
)
::
vacuum
TYPE
(
t_stars
),
INTENT
(
IN
)
::
stars
TYPE
(
t_cell
),
INTENT
(
IN
)
::
cell
TYPE
(
t_atoms
),
INTENT
(
IN
)
::
atoms
! .. Scalar Arguments ..
INTEGER
,
INTENT
(
IN
)
::
n3d
,
nmzxyd
,
n2d
,
ntypsd
,
ikpt
,
jspin
,
nv2d
INTEGER
,
INTENT
(
IN
)
::
lmaxd
,
jmtd
,
ntypd
,
natd
,
nmzd
...
...
@@ -184,6 +192,7 @@ c make preparations for plotting in vacuum
&
u_1
(
nmzd
,
nv2d
,
-
odi
%
mb
:
odi
%
mb
),
&
ue_1
(
nmzd
,
nv2d
,
-
odi
%
mb
:
odi
%
mb
)
)
call
wann_1dvacabcof
(
>
DIMENSION
,
oneD
,
vacuum
,
stars
,
cell
,
>
nv2d
,
nslibd
,
nmzd
,
nmz
,
omtil
,
vz
(:,:),
>
nv
,
bkpt
,
z1
,
odi
,
ods
,
>
nvd
,
k1
,
k2
,
k3
,
evac
,
...
...
@@ -236,17 +245,11 @@ c..loop by the bands
write
(
name3
,
24
)
ikpt
,
nbn
,
jspin
24
format
(
i5.5
,
'.'
,
i3.3
,
'.absv.'
,
i1
,
'.xsf'
)
OPEN
(
55
,
file
=
name1
)
CALL
xsf_WRITE_atoms
(
>
55
,
film
,
odi
%
d1
,
amat
,
neq
(:
ntype
),
>
zatom
(:
ntype
),
pos
)
CALL
xsf_WRITE_atoms
(
55
,
atoms
,
film
,
odi
%
d1
,
amat
)
OPEN
(
56
,
file
=
name2
)
CALL
xsf_WRITE_atoms
(
>
56
,
film
,
odi
%
d1
,
amat
,
neq
(:
ntype
),
>
zatom
(:
ntype
),
pos
)
CALL
xsf_WRITE_atoms
(
56
,
atoms
,
film
,
odi
%
d1
,
amat
)
OPEN
(
57
,
file
=
name3
)
CALL
xsf_WRITE_atoms
(
>
57
,
film
,
odi
%
d1
,
amat
,
neq
(:
ntype
),
>
zatom
(:
ntype
),
pos
)
CALL
xsf_WRITE_atoms
(
57
,
atoms
,
film
,
odi
%
d1
,
amat
)
CALL
xsf_WRITE_header
(
55
,
twodim
,
filename
,(
vec1
),
&
(
vec2
),(
vec3
),
zero
$
,
grid
)
...
...
wannier/wann_plot_od_vac.F
0 → 100755
View file @
4d93df0b
module
m_wann_plot_od_vac
contains
subroutine
wann_plot_od_vac
(
point
,
>
z1
,
nmzd
,
nv2d
,
odi
,
nmz
,
delz
,
bmat
,
>
bkpt
,
nvd
,
nv
,
omtil
,
k3
,
ac
,
bc
,
u
,
ue
,
<
value
)
c
**************************************************************
c
Calculates
the
lattice
periodic
part
of
the
Bloch
function
c
in
the
vacuum
.
Used
for
plotting
.
c
FF
,
Sep
.
'06 ----> 1D version YM January 07
c***************************************************************
use m_constants, only : pimach
use m_angle
use m_types
implicit none
c .. scalar Arguments..
integer, intent (in) :: nmzd,nv2d,nmz,nvd,nv
real, intent (in) :: delz,z1,omtil,point(3)
c ..array arguments..
integer, intent (in) :: k3(nvd)
real, intent (in) :: bkpt(3),bmat(3,3)
complex, intent (out) :: value
type (od_inp), intent (in) :: odi
c ..basis wavefunctions in the vacuum
complex, intent(in) :: ac(nv2d,-odi%mb:odi%mb)
complex, intent(in) :: bc(nv2d,-odi%mb:odi%mb)
real, intent(in) :: u(nmzd,nv2d,-odi%mb:odi%mb)
real, intent(in) :: ue(nmzd,nv2d,-odi%mb:odi%mb)
c ..local scalars..
real arg,zks,tpi,r,phi
integer i,m,l,j,k,n,nv2,n2
integer np1
complex c_1
integer, allocatable :: kvac3(:),map1(:)
complex value1
c ..intrinsic functions..
intrinsic aimag,cmplx,conjg,real,sqrt
allocate (kvac3(nv2d),map1(nvd))
tpi = 2 * pimach()
np1 = nmz + 1
c.. determining the indexing array (in-plane stars)
c.. for the k-point
n2 = 0
do 35 k = 1,nv
do 45 j = 1,n2
if (k3(k).eq.kvac3(j)) then
map1(k) = j
goto 35
end if
45 continue
n2 = n2 + 1
if (n2.gt.nv2d) stop '
wann_plot
:
vac
'
kvac3(n2) = k3(k)
map1(k) = n2
35 continue
nv2 = n2
c.. the body of the routine
value = cmplx(0.0,0.0)
value1 = cmplx(0.0,0.0)
r = sqrt(point(1)**2+point(2)**2)
phi = angle(point(1),point(2))
c print*,"difference=",(abs(point(3))-z1)/delz
i=(r-z1)/delz + 1
if (i.gt.nmz) then