Skip to content
GitLab
Commit 4d93df0b authored by Gregor Michalicek's avatar Gregor Michalicek
Browse files

Even more adjustments to integrate the Wannier code

parent db1020c4
Hide whitespace changes
Inline Side-by-side
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 2nd 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 2nd 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