Commit cdf4da44 authored by Gregor Michalicek's avatar Gregor Michalicek

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

parent 0f500c29
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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)
......
......@@ -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)
......
......@@ -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
......
......@@ -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)
c write (6,*) 'z(k,iband)=',z(k,iband)
c write (6,*) 'val=',z(k,iband)*cmplx(cos(arg),sin(arg))
ENDIF
END DO
END IF
c write (6,*) 'ir:p(i)',p(:)
RETURN
c ---> vacuum part
......
......@@ -16,7 +16,9 @@ c******************************************************************
use m_juDFT
contains
subroutine wannier_to_lapw(
> mpi_comm,l_soc,unigrid,sortrule,band_min,band_max,
> mpi_comm,eig_id,
> input,lapw,oneD,noco,sym,cell,atoms,
> l_soc,unigrid,sortrule,band_min,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,
......@@ -26,14 +28,14 @@ c******************************************************************
> 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,l_bzsym,l_proj_plot,irecl,wan90version)
> volint,symor,pos,ef,l_bzsym,l_proj_plot,wan90version)
use m_wann_rw_eig
use m_wann_read_umatrix
use m_abcof
use m_radfun
use m_radflo
use m_cdnread, only : cdn_read0
use m_types, only : od_inp, od_sym
use m_types
use m_loddop
use m_constants
use m_wann_real
......@@ -43,6 +45,15 @@ c******************************************************************
implicit none
#include "cpp_double.h"
TYPE(t_input),INTENT(IN) :: input
TYPE(t_lapw),INTENT(IN) :: lapw
TYPE(t_oneD),INTENT(IN) :: oneD
TYPE(t_noco),INTENT(IN) :: noco
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_atoms),INTENT(IN) :: atoms
#ifdef CPP_MPI
include 'mpif.h'
integer mpiierr(3)
......@@ -50,7 +61,7 @@ c******************************************************************
integer stt(MPI_STATUS_SIZE)
#endif
logical,intent(in):: l_soc
integer,intent(in)::unigrid(4),mpi_comm
integer,intent(in)::unigrid(4),mpi_comm,eig_id
integer,intent(in)::band_min(2),band_max(2)
logical, intent (in) :: invs,invs2,film,slice,symor
integer, intent (in) :: lmaxd,ntypd,neigd,nkptd,kk,nnne
......@@ -77,7 +88,7 @@ c******************************************************************
logical, intent (in) :: l_dulo(nlod,ntypd),l_noco,l_ss,l_bzsym
logical,intent(in)::l_proj_plot
integer,intent(in)::sortrule
integer, intent(in)::irecl,wan90version
integer, intent(in):: wan90version
c-odim
real, intent (in) :: sk2(n2d),phi2(n2d)
type (od_inp), intent (in) :: odi
......@@ -102,11 +113,7 @@ cccccccccccccccccc local variables cccccccccccccccccccc
integer, allocatable :: kveclo(:),nv(:)
integer, allocatable :: k1(:,:),k2(:,:),k3(:,:)
real, allocatable :: we(:)
#if ( !defined(CPP_INVERSION) || defined(CPP_SOC) )
complex, allocatable :: z(:,:),zz(:,:)
#else
real, allocatable :: z(:,:),zz(:,:)
#endif
real, allocatable :: eigg(:)
real kpoints(nkptd)
!!! a and b coeff. constructed for each k-point
......@@ -128,10 +135,7 @@ cccccccccccccccccc local variables cccccccccccccccccccc
!!! radial wavefunctions in the muffin-tins and more ...
real, allocatable :: flo(:,:,:,:)
real, allocatable :: ff(:,:,:,:),gg(:,:,:,:)
real, allocatable :: us(:,:),uds(:,:),ulos(:,:)
real, allocatable :: dus(:,:),duds(:,:),dulos(:,:)
real, allocatable :: ddn(:,:),uulon(:,:),dulon(:,:)
real, allocatable :: uloulopn(:,:,:)
real uuilon(nlod,ntypd),duilon(nlod,ntypd)
real ulouilopn(nlod,nlod,ntypd)
!!! energy parameters
......@@ -195,6 +199,9 @@ cccccccccccccccccc local variables cccccccccccccccccccc
complex,allocatable::wannz(:,:),wannz2(:,:)
real denom
TYPE(t_zmat) :: zzMat, zMat
TYPE(t_usdus) :: usdus
ci=cmplx(0.,1.)
c specify number of unit-cells that are calculated
cell1=3
......@@ -259,16 +266,16 @@ cccccccccccccccc end of the potential part ccccccccccc
allocate ( k1(nvd,jspd),k2(nvd,jspd),k3(nvd,jspd) )