Skip to content

GitLab

fleur
fleur
Commit 4d93df0b authored by Gregor Michalicek's avatar Gregor Michalicek
Browse files
Options

Even more adjustments to integrate the Wannier code

parent db1020c4
Hide whitespace changes
Inline Side-by-side
Showing with 277 additions and 106 deletions
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
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