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

More work on the integration of the Wannier code into the new fleur

parent 0f500c29
Hide whitespace changes
Inline Side-by-side
wannier/wann_1dvacabcof.F
View file @ cdf4da44
......@@ -9,7 +9,7 @@ c********************************************************
> nv2d,nslibd,nmzd,nmz,omtil,vz,
> nv,bkpt,z1,odi,ods,
> nvd,k1,k2,k3,evac,
> bbmat,delz,bmat,nbasfcn,neigd,z,
> bbmat,delz,bmat,nbasfcn,neigd,zMat,
> n2d,n3d,ig,nmzxy,nmzxyd,ig2,sk2,
> phi2,k1d,k2d,k3d,
< ac,bc,u,ue,addnoco,l_ss,qss,jspin)
......@@ -26,6 +26,7 @@ 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
integer,intent(in)::nv2d,n2d,n3d
integer,intent(in)::nslibd
......@@ -58,11 +59,7 @@ c********************************************************
complex,intent(out)::bc(nv2d,-odi%mb:odi%mb,nslibd)
real,intent(out)::u(nmzd,nv2d,-odi%mb:odi%mb)
real,intent(out)::ue(nmzd,nv2d,-odi%mb:odi%mb)
#if ( !defined(CPP_INVERSION) || defined(CPP_SOC) )
COMPLEX, INTENT (IN) :: z(nbasfcn,neigd)
#else
REAL, INTENT (IN) :: z(nbasfcn,neigd)
#endif
real wronk,const,wronk_1
complex av,bv,ic
real, allocatable :: dt(:,:),dte(:,:)
......@@ -139,10 +136,17 @@ c********************************************************
* cmplx(-dt(l,m)*bess(m) +
- t(l,m)*sk2(irec2)*dbss(m),0.0)/
/ ((wronk_1)*sqrt(omtil))
do n = 1,nslibd
ac(l,m,n) = ac(l,m,n) + z(k+addnoco,n)*av
bc(l,m,n) = bc(l,m,n) + z(k+addnoco,n)*bv
end do
IF (zMat%l_real) THEN
do n = 1,nslibd
ac(l,m,n) = ac(l,m,n) + zMat%z_r(k+addnoco,n)*av
bc(l,m,n) = bc(l,m,n) + zMat%z_r(k+addnoco,n)*bv
end do
ELSE
do n = 1,nslibd
ac(l,m,n) = ac(l,m,n) + zMat%z_c(k+addnoco,n)*av
bc(l,m,n) = bc(l,m,n) + zMat%z_c(k+addnoco,n)*bv
end do
END IF
end do ! -mb:mb
end if
end do ! k = 1,nv
......
wannier/wann_2dvacabcof.F
View file @ cdf4da44
......@@ -13,10 +13,15 @@ c********************************************************
CONTAINS
SUBROUTINE wann_2dvacabcof(
>nv2d,nslibd,nvac,nmzd,nmz,omtil,vz,nv,bkpt,z1,
>nvd,k1,k2,k3,evac,bbmat,delz,bmat,nbasfcn,neigd,z,
>nvd,k1,k2,k3,evac,bbmat,delz,bmat,nbasfcn,neigd,zMat,
<ac,bc,u,ue,addnoco,l_ss,qss,jspin)
USE m_types
implicit none
TYPE(t_zMat),INTENT(IN) :: zMat
logical,intent(in)::l_ss
integer,intent(in)::nv2d,jspin,addnoco
integer,intent(in)::nslibd
......@@ -41,11 +46,7 @@ c********************************************************
complex,intent(out)::bc(nv2d,nslibd,2)
real,intent(out)::u(nmzd,nv2d,nvac)
real,intent(out)::ue(nmzd,nv2d,nvac)
#if ( !defined(CPP_INVERSION) || defined(CPP_SOC) )
COMPLEX, INTENT (IN) :: z(nbasfcn,neigd)
#else
REAL, INTENT (IN) :: z(nbasfcn,neigd)
#endif
real wronk,const
complex c_1,av,bv
real, allocatable :: dt(:),dte(:)
......@@ -151,11 +152,21 @@ c enddo
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,jvac) = ac(l,n,jvac) + z(k+addnoco,n)*av
bc(l,n,jvac) = bc(l,n,jvac) + z(k+addnoco,n)*bv
enddo
IF (zMat%l_real) THEN
do n = 1,nslibd
ac(l,n,jvac) = ac(l,n,jvac) +
+ zMat%z_r(k+addnoco,n)*av
bc(l,n,jvac) = bc(l,n,jvac) +
+ zMat%z_r(k+addnoco,n)*bv
enddo
ELSE
do n = 1,nslibd
ac(l,n,jvac) = ac(l,n,jvac) +
+ zMat%z_c(k+addnoco,n)*av
bc(l,n,jvac) = bc(l,n,jvac) +
+ zMat%z_c(k+addnoco,n)*bv
enddo
END IF
enddo
enddo !symvac
enddo !loop over ivac
......
wannier/wann_plot.F
View file @ cdf4da44
......@@ -45,7 +45,7 @@
> invs,invs2,z1,delz,ngopr,ntypsy,jri,pos,zatom,
> lmax,mrot,tau,rmsh,invtab,amat,bmat,bbmat,ikpt,nnne,kk,
> nvd,nlod,llod,nv,lmd,bkpt,omtil,nlo,llo,k1,k2,k3,evac,vz,
> nslibd,nbasfcn,neigd,ff,gg,flo,acof,bcof,ccof,z,
> nslibd,nbasfcn,neigd,ff,gg,flo,acof,bcof,ccof,zMat,
> k1d,k2d,k3d,ig,ig2,sk2,phi2,l_noco,l_ss,qss,addnoco,
> index_kq,l_sgwf)
! *****************************************************
......@@ -66,6 +66,7 @@
TYPE(t_stars),INTENT(IN) :: stars
TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_zMat),INTENT(IN) :: zMat
! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: n3d,nmzxyd,n2d,ntypsd,ikpt,jspin,nv2d
......@@ -98,11 +99,7 @@
real, intent (in) :: sk2(n2d),phi2(n2d)
TYPE (od_inp), INTENT (IN) :: odi
TYPE (od_sym), INTENT (IN) :: ods
#if ( !defined(CPP_INVERSION) || defined(CPP_SOC) )
COMPLEX, INTENT (IN) :: z(nbasfcn,neigd)
#else
REAL, INTENT (IN) :: z(nbasfcn,neigd)
#endif
! ..
! .. Local Scalars ..
integer n2,k,j,l
......@@ -182,7 +179,7 @@ c make preparations for plotting in vacuum
+ u(nmzd,nv2d,nvac),ue(nmzd,nv2d,nvac))
call wann_2dvacabcof(
> nv2d,nslibd,nvac,nmzd,nmz,omtil,vz,nv,bkpt,z1,
> nvd,k1,k2,k3,evac,bbmat,delz,bmat,nbasfcn,neigd,z,
> nvd,k1,k2,k3,evac,bbmat,delz,bmat,nbasfcn,neigd,zMat,
< ac,bc,u,ue,addnoco,l_ss,qss,jspin)
endif
......@@ -196,7 +193,7 @@ c make preparations for plotting in vacuum
> nv2d,nslibd,nmzd,nmz,omtil,vz(:,:),
> nv,bkpt,z1,odi,ods,
> nvd,k1,k2,k3,evac,
> bbmat,delz,bmat,nbasfcn,neigd,z,
> bbmat,delz,bmat,nbasfcn,neigd,zMat,
> n2d,n3d,ig,nmzxy,nmzxyd,ig2,sk2,phi2,k1d,k2d,k3d,
< ac_1,bc_1,u_1,ue_1,addnoco,l_ss,qss,jspin)
endif !preparations for vacuum
......@@ -309,14 +306,14 @@ c..loop by the bands
s = SQRT(dot_PRODUCT(pos(:,na)-pt,pos(:,na)-pt))
IF (s<rmsh(jri(nt),nt)) THEN
CALL wann_real(
> pt,nt,na,0,1,bkpt,
> pt,nt,na,0,1,bkpt,nbn,
> n3d,nmzxyd,n2d,ntypsd,lmaxd,jmtd,
> natd,ntypd,nmzd,nop,nop2,mrot,tau,invtab,
> nq3,nvac,invs,z1,delz,nmz,nmzxy,nq2,
> lmax,rmsh,jri,pos,ngopr,ntypsy,nvd,
> omtil,amat,bmat,odi,ods,nlod,llod,nlo,llo,
> ff,gg,flo,acof(nbn,:,:),bcof(nbn,:,:),
> ccof(:,nbn,:,:),z(:,nbn),
> ccof(:,nbn,:,:),zMat,
> nv,k1,k2,k3,lmd,nbasfcn,l_ss,qss,jspin,addnoco,
< xdnout)
xdnout=xdnout*factor
......@@ -342,7 +339,7 @@ c..loop by the bands
if(nvac==1)jvac=1
call wann_plot_vac(point,z1,nmzd,nv2d,n3d,nvac,
> nmz,delz,bmat,bbmat,evac,bkpt,vz,jspin,k1,k2,k3,nvd,
> nbasfcn,neigd,z(:,nbn),nv,omtil,nslibd,ac(:,nbn,ivac),
> nbasfcn,neigd,nv,omtil,nslibd,ac(:,nbn,ivac),
& bc(:,nbn,ivac),
& u(:,:,jvac),ue(:,:,jvac),xdnout)
xdnout=xdnout*factor
......@@ -390,14 +387,14 @@ c < xdnout)
END IF
END IF
CALL wann_real(
> point,0,0,0,2,bkpt,
> point,0,0,0,2,bkpt,nbn,
> n3d,nmzxyd,n2d,ntypsd,lmaxd,jmtd,
> natd,ntypd,nmzd,nop,nop2,mrot,tau,invtab,
> nq3,nvac,invs,z1,delz,nmz,nmzxy,nq2,
> lmax,rmsh,jri,pos,ngopr,ntypsy,nvd,
> omtil,amat,bmat,odi,ods,nlod,llod,nlo,llo,
> ff,gg,flo,acof(nbn,:,:),bcof(nbn,:,:),
> ccof(:,nbn,:,:),z(:,nbn),
> ccof(:,nbn,:,:),zMat,
> nv,k1,k2,k3,lmd,nbasfcn,l_ss,qss,jspin,addnoco,
< xdnout)
xdnout=xdnout*factor
......
wannier/wann_plot_um_dat.F
View file @ cdf4da44
......@@ -13,7 +13,8 @@ c FF, September 2006
c******************************************************************
CONTAINS
SUBROUTINE wann_plot_um_dat(
> stars,vacuum,atoms,sphhar,input,sym,mpi,eig_id,
> DIMENSION,stars,vacuum,atoms,sphhar,input,sym,mpi,
> lapw,oneD,noco,cell,eig_id,
> mpi_comm,sortrule,band_min,band_max,l_soc,
> l_dulo,l_noco,l_ss,lmaxd,
> ntypd,
......@@ -26,7 +27,7 @@ c******************************************************************
> ustep,ig,k1d,k2d,k3d,rgphs,slice,kk,nnne,
> z1,nv2d,nmzxy,nmz,delz,ig2,area,tau,zatom,nq2,nop2,
> volint,symor,pos,ef,l_bzsym,
> l_proj_plot,irecl,wan90version)
> l_proj_plot,wan90version)
use m_wann_rw_eig
use m_abcof
......@@ -49,13 +50,18 @@ c******************************************************************
implicit none
TYPE(t_stars),INTENT(IN) :: stars
TYPE(t_vacuum),INTENT(IN) :: vacuum
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_sphhar),INTENT(IN) :: sphhar
TYPE(t_input),INTENT(IN) :: input
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_mpi),INTENT(IN) :: mpi
TYPE(t_dimension),INTENT(IN) :: DIMENSION
TYPE(t_stars),INTENT(IN) :: stars
TYPE(t_vacuum),INTENT(IN) :: vacuum
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_sphhar),INTENT(IN) :: sphhar
TYPE(t_input),INTENT(IN) :: input
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_mpi),INTENT(IN) :: mpi
TYPE(t_lapw),INTENT(IN) :: lapw
TYPE(t_oneD),INTENT(IN) :: oneD
TYPE(t_noco),INTENT(IN) :: noco
TYPE(t_cell),INTENT(IN) :: cell
#include "cpp_double.h"
#ifdef CPP_MPI
......@@ -93,11 +99,6 @@ c******************************************************************
logical, intent (in) :: l_dulo(nlod,ntypd),l_noco,l_ss,l_bzsym
logical,intent(in)::l_proj_plot
integer,intent(in)::sortrule
#ifndef CPP_MPI
integer(8), intent (in) :: irecl
#else
INTEGER(KIND=MPI_OFFSET_KIND),intent(in) :: irecl
#endif
c-odim
real, intent (in) :: sk2(n2d),phi2(n2d)
type (od_inp), intent (in) :: odi
......@@ -621,18 +622,9 @@ c******************************************************************
c...generation of the A,B,C coefficients in the spheres
c...for the lapws and local orbitals, summed by the basis functions
ngopr1(:)=1
call abcof(
> lmaxd,ntypd,neigd,noccbd,natd,nop,nvd,wannierspin,
> lmd,nbasfcn,llod,nlod,nlotot,invtab,
> ntype,mrot,ngopr1,taual,neq,lmax,rmt,omtil,
> bmat,bbmat,bkpt,k1,k2,k3,nv,nmat,noccbd,zMat,
> us(0,1),dus(0,1),uds(0,1),
> duds(0,1),ddn(0,1),invsat,invsatnr,
> ulos(1,1),uulon(1,1),dulon(1,1),
> dulos(1,1),llo,nlo,l_dulo,lapw_l,
> l_noco,l_ss,jspin,alph,beta,qss,kveclo,odi,ods,
< acof(1,0,1),bcof(1,0,1),
< ccof(-llod,1,1,1))
CALL abcof(input,atoms,noccbd,sym,cell,bkpt,lapw,noccbd,usdus,
> noco,jspin,kveclo,oneD,acof,bcof,ccof,zMat)
call wann_abinv(
> ntypd,natd,noccbd,lmaxd,lmd,llod,nlod,ntype,neq,
......@@ -660,6 +652,7 @@ c***********************************************************************
& 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(:,:,jspin2),
> nv(jspin),bkpt,z1,odi,ods,
> nvd,k1(:,jspin),k2(:,jspin),k3(:,jspin),evac(:,jspin),
......@@ -711,14 +704,14 @@ c**************************************************************************
s = SQRT(dot_PRODUCT(pos(:,na)-pt,pos(:,na)-pt))
IF (s<rmsh(jri(nt),nt)) THEN
CALL wann_real(
> pt,nt,na,0,1,bkpt,
> pt,nt,na,0,1,bkpt,nbn,
> n3d,nmzxyd,n2d,ntypsd,lmaxd,jmtd,
> natd,ntypd,nmzd,nop,nop2,mrot,tau,invtab,
> nq3,nvac,invs,z1,delz,nmz,nmzxy,nq2,
> lmax,rmsh,jri,pos,ngopr,ntypsy,nvd,
> omtil,amat,bmat,odi,ods,nlod,llod,nlo,llo,
> ff,gg,flo,acof(nbn,:,:),bcof(nbn,:,:),
> ccof(:,nbn,:,:),z(:,nbn),
> ccof(:,nbn,:,:),zMat,
> nv(jspin),k1(:,jspin),k2(:,jspin),k3(:,jspin),
> lmd,nbasfcn,l_ss,qss,jspin,0,
< xdnout)
......@@ -741,7 +734,7 @@ c**************************************************************************
call wann_plot_vac(point,z1,nmzd,nv2d,n3d,nvac,
> nmz,delz,bmat,bbmat,evac(:,jspin),bkpt,vz,jspin,
> k1(:,jspin),k2(:,jspin),k3(:,jspin),nvd,
> nbasfcn,neigd,z(:,nbn),nv(jspin),omtil,nslibd,
> nbasfcn,neigd,nv(jspin),omtil,nslibd,
> ac(:,nbn,ivac),
& bc(:,nbn,ivac),
& u(:,:,jvac),ue(:,:,jvac),xdnout)
......@@ -764,14 +757,14 @@ c**************************************************************************
END IF
END IF
CALL wann_real(
> point,0,0,0,2,bkpt,
> point,0,0,0,2,bkpt,nbn,
> n3d,nmzxyd,n2d,ntypsd,lmaxd,jmtd,
> natd,ntypd,nmzd,nop,nop2,mrot,tau,invtab,
> nq3,nvac,invs,z1,delz,nmz,nmzxy,nq2,
> lmax,rmsh,jri,pos,ngopr,ntypsy,nvd,
> omtil,amat,bmat,odi,ods,nlod,llod,nlo,llo,
> ff,gg,flo,acof(nbn,:,:),bcof(nbn,:,:),
> ccof(:,nbn,:,:),z(:,nbn),
> ccof(:,nbn,:,:),zMat,
> nv(jspin),k1(:,jspin),k2(:,jspin),k3(:,jspin),
> lmd,nbasfcn,l_ss,qss,jspin,0,
< xdnout)
......@@ -887,17 +880,11 @@ c***************************************************************
write (name3,24) nplo,jspin
24 format (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)
CALL xsf_WRITE_header(56,twodim,filename,vec1,vec2,vec3,zero
......@@ -1046,8 +1033,7 @@ c*****************************************************************
deallocate ( vr,vz,kveclo,nv,k1,k2,k3 )
deallocate ( ff,gg,us,dus,duds,uds,ddn)
deallocate ( ulos,dulos,uulon,dulon,uloulopn )
deallocate ( ff,gg)
#ifdef CPP_MPI
call MPI_BARRIER(mpi_comm,mpiierr)
......
wannier/wann_plot_vac.F
View file @ cdf4da44
......@@ -19,11 +19,12 @@ c***************************************************************
> evac,bkpt,vz,
> jspin,
> k1,k2,k3,nvd,
> nbasfcn,neigd,z,nv,omtil,nslibd,ac,bc,u,ue,
> nbasfcn,neigd,nv,omtil,nslibd,ac,bc,u,ue,
< value)
use m_constants, only : pimach
implicit none
c .. scalar Arguments..
integer, intent (in) :: nmzd,nv2d,n3d,nslibd
integer, intent (in) :: nmz,nvac
......@@ -38,12 +39,6 @@ c ..array arguments..
integer, intent (in) :: k1(nvd),k2(nvd),k3(nvd)
complex, intent (out) :: value
#if ( !defined(CPP_INVERSION) || defined(CPP_SOC) )
complex, intent (in):: z(nbasfcn)
#else
real, intent (in):: z(nbasfcn)
#endif
c ..basis wavefunctions in the vacuum
complex, intent(in) :: ac(nv2d),bc(nv2d)
real, intent(in) :: u(nmzd,nv2d),ue(nmzd,nv2d)
......
wannier/wann_postproc.F
View file @ cdf4da44
......@@ -7,6 +7,8 @@
module m_wann_postproc
contains
subroutine wann_postproc(
> DIMENSION,stars,vacuum,atoms,sphhar,input,sym,mpi,
> lapw,oneD,noco,cell,eig_id,
> mpi_comm,wann,l_p0,film,jspins,n2d,
> natd,pos,amat,bmat,ntype,neq,zatom,
> omtil,l_soc,l_noco,neigd,fullnkpts,
......@@ -42,7 +44,7 @@ c***********************************************
use m_wann_nabla_pauli_rs
use m_wann_socmat_rs
use m_wann_perpmag_rs
use m_od_types, only : od_inp, od_sym
use m_types
use m_wann_wigner_seitz
use m_wann_get_mp
use m_wann_get_kpts
......@@ -63,10 +65,24 @@ c***********************************************
use m_wannier_lapw_gfleur
#endif
implicit none
TYPE(t_dimension),INTENT(IN) :: DIMENSION
TYPE(t_stars),INTENT(IN) :: stars
TYPE(t_vacuum),INTENT(IN) :: vacuum
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_sphhar),INTENT(IN) :: sphhar
TYPE(t_input),INTENT(IN) :: input
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_mpi),INTENT(IN) :: mpi
TYPE(t_lapw),INTENT(IN) :: lapw
TYPE(t_oneD),INTENT(IN) :: oneD
TYPE(t_noco),INTENT(IN) :: noco
TYPE(t_cell),INTENT(IN) :: cell
type(t_wann), intent(in) :: wann
logical, intent(in) :: l_p0
logical, intent(in) :: film
integer, intent(in) :: jspins,n2d,mpi_comm
integer, intent(in) :: jspins,n2d,mpi_comm, eig_id, irecl
integer, intent(in) :: natd
real, intent(in) :: pos(3,natd)
real, intent(in) :: amat(3,3),bmat(3,3)
......@@ -107,7 +123,7 @@ c***********************************************
integer, intent (in) :: ig(-k1d:k1d,-k2d:k2d,-k3d:k3d)
real, intent (in) :: rgphs(-k1d:k1d,-k2d:k2d,-k3d:k3d)
logical, intent (in) :: slice
integer, intent (in) :: kk,nnne,irecl
integer, intent (in) :: kk,nnne
integer, intent (in) :: nv2d,nmzxy,nmz,nq2
real, intent (in) :: delz,area,z1,volint
integer, intent (in) :: ig2(n3d)
......@@ -187,7 +203,8 @@ c*********************************************************
if(wann%l_byindex) i=1
if(wann%l_plotw90)then
CALL juDFT_error("not in this version",calledby ="wann_postproc")
CALL juDFT_error("not in this version",
+ calledby ="wann_postproc")
c call wann_plotw90(i,wann%band_min,wann%band_max,numbands,nwfs,
c > l_dulo,l_noco,l_ss,lmaxd,ntypd,
......@@ -420,6 +437,8 @@ c > volint,symor,pos,ef,wann%l_bzsym,irecl)
if(wann%l_plot_umdat)then
call wann_plot_um_dat(
> DIMENSION,stars,vacuum,atoms,sphhar,input,sym,mpi,
> lapw,oneD,noco,cell,eig_id,
> mpi_comm,i,wann%band_min,wann%band_max,l_soc,
> l_dulo,l_noco,l_ss,lmaxd,ntypd,
> neigd,natd,nop,nvd,jspd,nbasfcn,llod,nlod,ntype,
......@@ -430,7 +449,7 @@ c > volint,symor,pos,ef,wann%l_bzsym,irecl)
> ntypsy,jspins,nkptd,dx,n2d,rmsh,e1s,e2s,ulo_der,
> ustep,ig,k1d,k2d,k3d,rgphs,slice,kk,nnne,
> z1,nv2d,nmzxy,nmz,delz,ig2,area,tau,zatom,nq2,nop2,
> volint,symor,pos,ef,wann%l_bzsym,wann%l_proj_plot,irecl,
> volint,symor,pos,ef,wann%l_bzsym,wann%l_proj_plot,
> wann%wan90version)
endif
......@@ -438,8 +457,9 @@ c > volint,symor,pos,ef,wann%l_bzsym,irecl)
call cpu_time(delta2)
if(wann%l_lapw.and.l_p0)then
call wannier_to_lapw(
> mpi_comm,l_soc,
> wann%unigrid,i,wann%band_min,wann%band_max,
> mpi_comm,eig_id,
> input,lapw,oneD,noco,sym,cell,atoms,
> l_soc,wann%unigrid,i,wann%band_min,wann%band_max,
> 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,
......@@ -449,7 +469,7 @@ c > volint,symor,pos,ef,wann%l_bzsym,irecl)
> ntypsy,jspins,nkptd,dx,n2d,rmsh,e1s,e2s,ulo_der,
> ustep,ig,k1d,k2d,k3d,rgphs,slice,kk,nnne,
> z1,nv2d,nmzxy,nmz,delz,ig2,area,tau,zatom,nq2,nop2,
> volint,symor,pos,ef,wann%l_bzsym,wann%l_proj_plot,irecl,
> volint,symor,pos,ef,wann%l_bzsym,wann%l_proj_plot,
> wann%wan90version)
endif
......
wannier/wann_real.F
View file @ cdf4da44
......@@ -12,23 +12,25 @@ c Y.Mokrousov 16.8.6
c ********************************************************
CONTAINS
SUBROUTINE wann_real(
> p,n,na,iv,iflag,bkpt,
> p,n,na,iv,iflag,bkpt,iband,
> n3d,nmzxyd,n2d,ntypsd,lmaxd,jmtd,
> natd,ntypd,nmzd,nop,nop2,mrot,tau,invtab,
> nq3,nvac,invs,z1,delz,nmz,nmzxy,nq2,
> lmax,rmsh,jri,pos,ngopr,ntypsy,nvd,
> omtil,amat,bmat,odi,ods,nlod,llod,nlo,llo,
> ff,gg,flo,acof,bcof,ccof,z,
> ff,gg,flo,acof,bcof,ccof,zMat,
> nv,k1,k2,k3,lmd,nbasfcn,l_ss,qss,jspin,addnoco,
< xdnout)
c
USE m_types, ONLY : od_inp, od_sym
USE m_types
USE m_ylm
USE m_constants
IMPLICIT NONE
c
TYPE(t_zMat),INTENT(IN) :: zMat
C .. Scalar Arguments ..
INTEGER, INTENT (IN) :: n3d,nmzxyd,n2d,ntypsd,llod,nlod
INTEGER, INTENT (IN) :: n3d,nmzxyd,n2d,ntypsd,llod,nlod,iband
INTEGER, INTENT (IN) :: lmaxd,jmtd,ntypd,natd,nmzd
INTEGER, INTENT (IN) :: iflag,n,na,iv,lmd,nv,nvd,nbasfcn
INTEGER, INTENT (IN) :: nq3,nvac,nmz,nmzxy,nq2,nop,nop2
......@@ -55,11 +57,7 @@ C .. Array Arguments ..
REAL, INTENT (IN) :: gg(ntypd,jmtd,2,0:lmaxd)
REAL, INTENT (IN) :: flo(ntypd,jmtd,2,nlod)
REAL, INTENT (INOUT) :: p(3)
#if ( !defined(CPP_INVERSION) || defined(CPP_SOC) )
COMPLEX, INTENT (IN) :: z(nbasfcn)
#else
REAL, INTENT (IN) :: z(nbasfcn)
#endif
C ..
C .. Local Scalars ..
REAL delta,sx,xx1,xx2,rrr,phi,const,arg,tpi,arg1
......@@ -107,21 +105,37 @@ c ---> interstitial part
rcc=matmul(bmat,p)/tpi_const
xdnout = cmplx(0.,0.)
c write (6,*) 'nv,nvd=',nv,nvd
DO 10 k = 1,nv
c write (6,*) 'k1,k2,k3=',k1(k),k2(k),k3(k)
c write (6,*) 'z(k)=', z(k)
arg = tpi*((k1(k))*rcc(1)+
+ (k2(k))*rcc(2)+
+ (k3(k))*rcc(3) )
xdnout = xdnout + z(k+addnoco)*cmplx(cos(arg),sin(arg))*const
IF (((abs(p(1)-2.2).le.0.0001).and.(abs(p(2)).le.0.0001))
& .or.((abs(p(2)-2.2).le.0.0001).and.(abs(p(1)).le.0.0001)))then
c write (6,*) 'p(i)=',p(1:2)
c write (6,*) 'G=',k1(k),k2(k),k3(k)
c write (6,*) 'z(k)=',z(k)
c write (6,*) 'val=',z(k)*cmplx(cos(arg),sin(arg))
ENDIF
10 CONTINUE
IF (zMat%l_real) THEN
DO k = 1,nv
c write (6,*) 'k1,k2,k3=',k1(k),k2(k),k3(k)
c write (6,*) 'z(k,iband)=', z(k,iband)
arg = tpi * ((k1(k))*rcc(1)+(k2(k))*rcc(2)+(k3(k))*rcc(3))
xdnout = xdnout + zMat%z_r(k+addnoco,iband)*
+ cmplx(cos(arg),sin(arg))*const
IF (((abs(p(1)-2.2).le.0.0001).and.(abs(p(2)).le.0.0001))
& .or.((abs(p(2)-2.2).le.0.0001).and.(abs(p(1)).le.0.0001)))then
c write (6,*) 'p(i)=',p(1:2)
c write (6,*) 'G=',k1(k),k2(k),k3(k)
c write (6,*) 'z(k,iband)=',z(k,iband)
c write (6,*) 'val=',z(k,iband)*cmplx(cos(arg),sin(arg))
ENDIF
END DO
ELSE
DO k = 1,nv
c write (6,*) 'k1,k2,k3=',k1(k),k2(k),k3(k)
c write (6,*) 'z(k,iband)=', z(k,iband)
arg = tpi * ((k1(k))*rcc(1)+(k2(k))*rcc(2)+(k3(k))*rcc(3))
xdnout = xdnout + zMat%z_c(k+addnoco,iband)*
+ cmplx(cos(arg),sin(arg))*const
IF (((abs(p(1)-2.2).le.0.0001).and.(abs(p(2)).le.0.0001))
& .or.((abs(p(2)-2.2).le.0.0001).and.(abs(p(1)).le.0.0001)))then
c write (6,*) 'p(i)=',p(1:2)
c write (6,*) 'G=',k1(k),k2(k),k3(k)
</