Skip to content

GitLab

fleur
fleur
Commit 3032c4e5 authored by Gregor Michalicek's avatar Gregor Michalicek
Browse files
Options

And more and more fixes to integrate the Wannier code

parent 5be524db
Expand all Hide whitespace changes
Inline Side-by-side
Showing with 430 additions and 328 deletions
wannier/uhu/wann_uHu.F
View file @ 3032c4e5
......@@ -20,6 +20,7 @@ c*******************************************c
CONTAINS
SUBROUTINE wann_uHu(
> DIMENSION,stars,vacuum,atoms,sphhar,input,sym,mpi,banddos,
> lapw,oneD,noco,cell,
> l_real,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,
......@@ -79,6 +80,10 @@ c*******************************************c
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_mpi),INTENT(IN) :: mpi
TYPE(t_banddos),INTENT(IN) :: banddos
TYPE(t_lapw),INTENT(IN) :: lapw
TYPE(t_oneD),INTENT(IN) :: oneD
TYPE(t_noco),INTENT(IN) :: noco
TYPE(t_cell),INTENT(IN) :: cell
c ..scalar arguments..
character(len=20),intent(in) :: param_file
......@@ -166,15 +171,6 @@ c complex, allocatable :: uHuold(:,:)
complex, allocatable :: tulod_soc(:,:,:,:,:)
complex, allocatable :: tulou_soc(:,:,:,:,:)
complex, allocatable :: tuloulo_soc(:,:,:,:,:,:)
#if ( !defined(CPP_INVERSION) || defined(CPP_SOC) )
complex, allocatable :: z(:,:),zz(:,:)
complex, allocatable :: z_b(:,:)
complex, allocatable :: z_b2(:,:)
#else
real, allocatable :: z(:,:),zz(:,:)
real, allocatable :: z_b(:,:)
real, allocatable :: z_b2(:,:)
#endif
c ..local arrays..
character(len=2) :: spin012(0:2)
......@@ -237,6 +233,8 @@ c ..local scalars..
complex :: ci
TYPE(t_usdus) :: usdus
TYPE(t_zmat) :: zMat, zzMat, zMat_b, zMat_b2
TYPE(t_lapw) :: lapw_b, lapw_b2
c ..initializations..
......@@ -934,7 +932,7 @@ c write(*,*)irank,ikpt
i_rec = i_rec + 1
c if (mod(i_rec-1,isize).eq.irank) then
allocate ( zz(nbasfcn,neigd),eigg(neigd) )
allocate ( eigg(neigd) )
n_start=1
n_end=neigd
......@@ -952,8 +950,21 @@ c if (mod(i_rec-1,isize).eq.irank) then
call cpu_time(t1)
t_eig = t_eig + t1 - t0
allocate ( z_b(nbasfcn,neigd), we_b(neigd) )
allocate ( z_b2(nbasfcn,neigd), we_b2(neigd) )
zMat_b%l_real = zzMat%l_real
zMat_b2%l_real = zzMat%l_real
zMat_b%nbasfcn = zzMat%nbasfcn
zMat_b2%nbasfcn = zzMat%nbasfcn
zMat_b%nbands = zzMat%nbands
zMat_b2%nbands = zzMat%nbands
IF(zzMat%l_real) THEN
ALLOCATE (zMat_b%z_r(zMat%nbasfcn,zMat%nbands))
ALLOCATE (zMat_b2%z_r(zMat%nbasfcn,zMat%nbands))
ELSE
ALLOCATE (zMat_b%z_c(zMat%nbasfcn,zMat%nbands))
ALLOCATE (zMat_b2%z_c(zMat%nbasfcn,zMat%nbands))
END IF
allocate (we_b(neigd), we_b2(neigd))
!!! the cycle by the nearest neighbors (nntot) for each kpoint
......@@ -978,11 +989,12 @@ c if (mod(i_rec-1,isize).eq.irank) then
nslibd_b = 0
#if ( !defined(CPP_INVERSION) || defined(CPP_SOC) )
z_b(:,:) = cmplx(0.,0.)
#else
z_b(:,:) = 0.
#endif
IF(zzMat%l_real) THEN
zMat_b%z_r = 0.0
ELSE
zMat_b%z_c = CMPLX(0.0,0.0)
END IF
eig_b(:) = 0.
do i = 1,nbands_b
......@@ -1003,9 +1015,15 @@ c if (mod(i_rec-1,isize).eq.irank) then
else
funbas = nv_b(jspin) + nlotot
endif
do j = 1,funbas
z_b(j,nslibd_b) = zz(j,i)
enddo
IF (zzMat%l_real) THEN
do j = 1,funbas
zMat_b%z_r(j,nslibd_b) = zzMat%z_r(j,i)
enddo
ELSE
do j = 1,funbas
zMat_b%z_c(j,nslibd_b) = zzMat%z_c(j,i)
enddo
END IF
endif
enddo
......@@ -1025,7 +1043,7 @@ c***********************************************************
> tau,
x bkpt_b,k1_b(:,:),
x k2_b(:,:),k3_b(:,:),
x z_b,nsfactor_b)
x zMat_b,nsfactor_b)
else
nsfactor_b=cmplx(1.0,0.0)
endif
......@@ -1042,20 +1060,17 @@ c***********************************************************
> ccof_b(-llod:llod,noccbd_b,nlod,natd) )
call cpu_time(t0)
call abcof(
> lmaxd,ntypd,neigd,noccbd_b,natd,nop,nvd,wannierspin,
> lmd,nbasfcn,llod,nlod,nlotot,invtab,
> ntype,mrot,ngopr1,taual,neq,lmax,rmt,omtil,
> bmat,bbmat,bkpt_b,
> k1_b,k2_b,k3_b,nv_b,nmat_b,noccbd_b,z_b,
> us(0,1,jspin),dus(0,1,jspin),uds(0,1,jspin),
> duds(0,1,jspin),ddn(0,1,jspin),invsat,invsatnr,
> ulos(1,1,jspin),uulon(1,1,jspin),dulon(1,1,jspin),
> dulos(1,1,jspin),llo,nlo,l_dulo,lapw_l,
> l_noco,l_ss,jspin,alph_i,beta_i,qpt_i,
> kveclo_b,odi,ods,
< acof_b(1,0,1),bcof_b(1,0,1),
< ccof_b(-llod,1,1,1))
lapw_b = lapw
lapw_b%k1 = k1_b
lapw_b%k2 = k2_b
lapw_b%k3 = k3_b
lapw_b%nmat = nmat_b
lapw_b%nv = nv_b
CALL abcof(input,atoms,noccbd_b,sym,cell,bkpt_b,lapw_b,
+ noccbd_b,usdus,noco,jspin,kveclo_b,oneD,
+ acof_b,bcof_b,ccof_b,zMat_b)
call wann_abinv(
> ntypd,natd,noccbd_b,lmaxd,lmd,llod,nlod,ntype,neq,
......@@ -1076,6 +1091,9 @@ c***********************************************************
eigg = 0.
call cpu_time(t0)
WRITE(*,*) 'Here probably the wrong record is read in'
WRITE(*,*) 'Should eig_id not be dependent on iqpt_b?'
WRITE(*,*) '(in wann_uHu)'
CALL cdn_read(
> eig_id,
> nvd,jspd,irank,isize,kptibz_b2,jspin,nbasfcn, !wannierspin instead of jspd?
......@@ -1086,11 +1104,12 @@ c***********************************************************
nslibd_b2 = 0
#if ( !defined(CPP_INVERSION) || defined(CPP_SOC) )
z_b2(:,:) = cmplx(0.,0.)
#else
z_b2(:,:) = 0.
#endif
IF(zzMat%l_real) THEN
zMat_b2%z_r = 0.0
ELSE
zMat_b2%z_c = CMPLX(0.0,0.0)
END IF
eig_b2(:) = 0.
do i = 1,nbands_b2
......@@ -1111,9 +1130,15 @@ c***********************************************************
else
funbas = nv_b2(jspin_b) + nlotot
endif
do j = 1,funbas
z_b2(j,nslibd_b2) = zz(j,i)
enddo
IF (zzMat%l_real) THEN
do j = 1,funbas
zMat_b2%z_r(j,nslibd_b2) = zzMat%z_r(j,i)
enddo
ELSE
do j = 1,funbas
zMat_b2%z_c(j,nslibd_b2) = zzMat%z_c(j,i)
enddo
END IF
endif
enddo
......@@ -1133,7 +1158,7 @@ c***********************************************************
> tau,
x bkpt_b2,k1_b2(:,:),
x k2_b2(:,:),k3_b2(:,:),
x z_b2,nsfactor_b2)
x zMat_b2,nsfactor_b2)
else
nsfactor_b2=cmplx(1.0,0.0)
endif
......@@ -1150,20 +1175,17 @@ c***********************************************************
> ccof_b2(-llod:llod,noccbd_b2,nlod,natd) )
call cpu_time(t0)
call abcof(
> lmaxd,ntypd,neigd,noccbd_b2,natd,nop,nvd,wannierspin,
> lmd,nbasfcn,llod,nlod,nlotot,invtab,
> ntype,mrot,ngopr1,taual,neq,lmax,rmt,omtil,
> bmat,bbmat,bkpt_b2,
> k1_b2,k2_b2,k3_b2,nv_b2,nmat_b2,noccbd_b2,z_b2,
> us(0,1,jspin_b),dus(0,1,jspin_b),uds(0,1,jspin_b),
> duds(0,1,jspin_b),ddn(0,1,jspin_b),invsat,invsatnr,
> ulos(1,1,jspin_b),uulon(1,1,jspin_b),dulon(1,1,jspin_b),
> dulos(1,1,jspin_b),llo,nlo,l_dulo,lapw_l,
> l_noco,l_ss,jspin_b,alph_i,beta_i,qpt_i,
> kveclo_b2,odi,ods,
< acof_b2(1,0,1),bcof_b2(1,0,1),
< ccof_b2(-llod,1,1,1))
lapw_b2 = lapw
lapw_b2%k1 = k1_b2
lapw_b2%k2 = k2_b2
lapw_b2%k3 = k3_b2
lapw_b2%nmat = nmat_b2
lapw_b2%nv = nv_b2
CALL abcof(input,atoms,noccbd_b2,sym,cell,bkpt_b2,lapw_b2,
+ noccbd_b2,usdus,noco,jspin_b,kveclo_b2,oneD,
+ acof_b2,bcof_b2,ccof_b2,zMat_b2)
call wann_abinv(
> ntypd,natd,noccbd_b2,lmaxd,lmd,llod,nlod,ntype,neq,
......@@ -1268,7 +1290,7 @@ c endif
> gb(:,ikpt_b,ikpt),
> k1_b2(:,jspin_b),k2_b2(:,jspin_b),k3_b2(:,jspin_b),
> gb(:,ikpt_b2,ikpt),
> bkpt,bbmat,vpw(:,jspin3),z_b,z_b2,rgphs,
> bkpt,bbmat,vpw(:,jspin3),zMat_b,zMat_b2,rgphs,
> ustep,ig,jspin.eq.jspin_b,sign2,
> uHu(:,:,ikpt_b2,ikpt_b,i_rec))
call cpu_time(t1)
......@@ -1294,7 +1316,7 @@ c endif
> vzxy(:,:,:,jspin3),vz,nslibd_b,nslibd_b2,
> jspin,jspin_b,doublespin,k1_b,k2_b,k3_b,
> k1_b2,k2_b2,k3_b2,wannierspin,nvd,nbasfcn,neigd,
> z_b,z_b2,nv_b,nv_b2,omtil,gb(:,ikpt_b,ikpt),
> zMat_b,zMat_b2,nv_b,nv_b2,omtil,gb(:,ikpt_b,ikpt),
> gb(:,ikpt_b2,ikpt),sign2,
> uHu(:,:,ikpt_b2,ikpt_b,i_rec))
call cpu_time(t1)
......@@ -1304,12 +1326,13 @@ c endif
call cpu_time(t0)
call wann_uHu_od_vac(
> DIMENSION,oneD,vacuum,stars,cell,
> cmplx(1.,0.),l_noco,l_soc,jspins,nlotot,nbnd,z1,
> nmzxyd,nmzd,nv2d,k1d,k2d,k3d,n2d,n3d,ig,nmzxy,nmz,
> delz,ig2,bbmat,evac(1,jspin4),evac(1,jspin4_b),bkpt_b,
> bkpt_b2,odi,vzxy(:,:,:,jspin3),vz,nslibd_b,nslibd_b2,
> jspin,jspin_b,doublespin,k1_b,k2_b,k3_b,k1_b2,k2_b2,
> k3_b2,wannierspin,nvd,area,nbasfcn,neigd,z_b,z_b2,
> k3_b2,wannierspin,nvd,area,nbasfcn,neigd,zMat_b,zMat_b2,
> nv_b,nv_b2,sk2,phi2,omtil,gb(:,ikpt_b,ikpt),
> gb(:,ikpt_b2,ikpt),qpt_i,sign2,
> uHu(:,:,ikpt_b2,ikpt_b,i_rec))
......@@ -1337,9 +1360,8 @@ c endif
deallocate (acof_b,bcof_b,ccof_b)
15 continue ! end of loop by the nearest k-neighbors
deallocate ( z_b,we_b )
deallocate ( z_b2,we_b2 )
deallocate ( zz,eigg )
deallocate ( we_b,we_b2 )
deallocate ( eigg )
endif ! loop by processors
......
wannier/uhu/wann_uHu_dmi.F
View file @ 3032c4e5
This diff is collapsed.
wannier/uhu/wann_uHu_int.F
View file @ 3032c4e5
......@@ -22,14 +22,18 @@ c*****************************************c
> n3d,nv_b,nv_b2,nbnd,neigd,
> nslibd_b,nslibd_b2,nbasfcn,
> addnoco,addnoco2,
> k1_b ,k2_b ,k3_b, gb,
> k1_b ,k2_b ,k3_b, gb,
> k1_b2,k2_b2,k3_b2,gb2,
> bkpt,bbmat,vpw,z_b,z_b2,
> bkpt,bbmat,vpw,zMat_b,zMat_b2,
> rgphs,ustep,ig,l_kin,sign,uHu)
#include "cpp_double.h"
USE m_types
implicit none
TYPE(t_zmat), INTENT(IN) :: zMat_b, zMat_b2
c ..arguments..
logical, intent(in) :: l_kin
integer, intent(in) :: gb(3),gb2(3)
......@@ -44,36 +48,35 @@ c ..arguments..
real, intent(in) :: bkpt(3),bbmat(3,3)
complex, intent(in) :: ustep(n3d),vpw(n3d)
complex, intent(in) :: chi
#if ( !defined(CPP_INVERSION) || defined(CPP_SOC) )
complex, intent(in) :: z_b(nbasfcn,neigd),z_b2(nbasfcn,neigd)
#else
real, intent(in) :: z_b(nbasfcn,neigd),z_b2(nbasfcn,neigd)
#endif
complex, intent(inout) :: uHu(nbnd,nbnd)
c ..local variables..
#if (!defined(CPP_INVERSION)||defined(CPP_SOC))
complex,allocatable :: vstep(:,:)
complex,allocatable :: mat(:,:)
complex :: th
#else
real,allocatable :: vstep(:,:)
real,allocatable :: mat(:,:)
complex,allocatable :: vstep_c(:,:)
complex,allocatable :: mat_c(:,:)
complex :: th_c
real,allocatable :: vstep_r(:,:)
real,allocatable :: mat_r(:,:)
real,allocatable :: uHu_tmp(:,:)
real :: th
#endif
real :: th_r
real,allocatable :: rk_b(:),rk_b2(:)
real :: phase,phase2,ekk,s(3)
integer :: i,j,j1,j2,j3,i1,i2,i3,in,ind
allocate( vstep(nv_b2,nv_b) )
allocate( mat(nv_b,nslibd_b2) )
allocate( rk_b (nv_b) )
allocate( rk_b2(nv_b2) )
#if (!defined(CPP_INVERSION)||defined(CPP_SOC))
#else
allocate( uHu_tmp(nslibd_b,nslibd_b2) )
#endif
IF(zMat_b%l_real) THEN
allocate( uHu_tmp(nslibd_b,nslibd_b2) )
allocate( vstep_r(nv_b2,nv_b) )
allocate( mat_r(nv_b,nslibd_b2) )
vstep_r(:,:) = 0.0
ELSE
allocate( vstep_c(nv_b2,nv_b) )
allocate( mat_c(nv_b,nslibd_b2) )
vstep_c(:,:) = CMPLX(0.0,0.0)
END IF
! set up |k+G-G(k+b1)|^2
do i=1,nv_b
......@@ -95,7 +98,6 @@ c ..local variables..
! construct vstep(g,g') ~ V(g-g')
! + Theta(g-g')*[rk_b+rk_b2]
vstep(:,:) = 0.0
do i=1,nv_b
j1 = -k1_b(i) + gb(1) - gb2(1)
j2 = -k2_b(i) + gb(2) - gb2(2)
......@@ -113,42 +115,47 @@ c ..local variables..
endif
ekk = rk_b(i) + rk_b2(j)
#if ( !defined(CPP_INVERSION) || defined(CPP_SOC) )
th = phase*conjg(vpw(in))
if(l_kin) th = th + phase*0.25*ekk*conjg(ustep(in))
#else
th = phase*real(vpw(in))
if(l_kin) th = th + phase*0.25*ekk*real(ustep(in))
#endif
vstep(j,i) = th
IF(zMat_b%l_real) THEN
th_r = phase*real(vpw(in))
if(l_kin) th_r = th_r + phase*0.25*ekk*real(ustep(in))
vstep_r(j,i) = th_r
ELSE
th_c = phase*conjg(vpw(in))
if(l_kin) th_c = th_c + phase*0.25*ekk*conjg(ustep(in))
vstep_c(j,i) = th_c
END IF
enddo
enddo
! complex conjugate of (z(k+b1,g))^* vstep(g,g') z(k+b2,g')
#if (!defined(CPP_INVERSION) || defined(CPP_SOC))
call CPP_BLAS_cgemm('T','N',nv_b,nslibd_b2,nv_b2,cmplx(1.0),
> vstep,nv_b2,z_b2(1+addnoco2,1),nbasfcn,
> cmplx(0.0),mat,nv_b)
mat = conjg(mat)
call CPP_BLAS_cgemm('T','N',nslibd_b,nslibd_b2,nv_b,
> chi,z_b(1+addnoco,1),nbasfcn,
> mat,nv_b,cmplx(1.0),uHu,nbnd)
#else
call CPP_BLAS_sgemm('T','N',nv_b,nslibd_b2,nv_b2,real(1.0),
> vstep,nv_b2,z_b2(1+addnoco2,1),nbasfcn,
> real(0.0),mat,nv_b)
call CPP_BLAS_sgemm('T','N',nslibd_b,nslibd_b2,nv_b,
> real(1.0),z_b(1+addnoco,1),nbasfcn,
> mat,nv_b,real(0.0),uHu_tmp,nslibd_b)
uHu(1:nslibd_b,1:nslibd_b2) = uHu(1:nslibd_b,1:nslibd_b2)
IF(zMat_b%l_real) THEN
call CPP_BLAS_sgemm('T','N',nv_b,nslibd_b2,nv_b2,real(1.0),
> vstep_r,nv_b2,zMat_b2%z_r(1+addnoco2,1),nbasfcn,
> real(0.0),mat_r,nv_b)
call CPP_BLAS_sgemm('T','N',nslibd_b,nslibd_b2,nv_b,
> real(1.0),zMat_b%z_r(1+addnoco,1),nbasfcn,
> mat_r,nv_b,real(0.0),uHu_tmp,nslibd_b)
uHu(1:nslibd_b,1:nslibd_b2) = uHu(1:nslibd_b,1:nslibd_b2)
> + uHu_tmp(1:nslibd_b,1:nslibd_b2)*chi
#endif
ELSE
call CPP_BLAS_cgemm('T','N',nv_b,nslibd_b2,nv_b2,cmplx(1.0),
> vstep_c,nv_b2,zMat_b2%z_c(1+addnoco2,1),nbasfcn,
> cmplx(0.0),mat_c,nv_b)
mat_c = conjg(mat_c)
call CPP_BLAS_cgemm('T','N',nslibd_b,nslibd_b2,nv_b,
> chi,zMat_b%z_c(1+addnoco,1),nbasfcn,
> mat_c,nv_b,cmplx(1.0),uHu,nbnd)
END IF
deallocate( vstep, mat )
deallocate( rk_b, rk_b2 )
#if (!defined(CPP_INVERSION) || defined(CPP_SOC))
#else
deallocate( uHu_tmp )
#endif
IF(zMat_b%l_real) THEN
deallocate( uHu_tmp )
deallocate( vstep_r, mat_r )
ELSE
deallocate( vstep_c, mat_c )
END IF
end subroutine
end module m_wann_uHu_int
wannier/uhu/wann_uHu_od_vac.F
View file @ 3032c4e5
......@@ -17,7 +17,7 @@ c***************************************c
> nslibd,nslibd_b,jspin,jspin_b,ico,
> 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,
> zMat,zMat_b,nv,nv_b,sk2,phi2,omtil,gb,gb2,qss,sign2,
< uHu)
use m_constants
......@@ -35,6 +35,8 @@ c***************************************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, zMat_b
c .. scalar Arguments..
logical, intent (in) :: l_noco,l_soc
......@@ -60,11 +62,6 @@ c ..array arguments..
integer, intent (in) :: k1_b(:,:),k2_b(:,:),k3_b(:,:) !k1_b(nvd,jspd),k2_b(nvd,jspd),k3_b(nvd,jspd)
complex, intent (inout) :: uHu(:,:) !uHu(nbnd,nbnd)
#if ( !defined(CPP_INVERSION) || defined(CPP_SOC) )
complex, intent (in):: z(:,:),z_b(:,:) !z(nbasfcn,neigd),z_b(nbasfcn,neigd)
#else
real, intent (in):: z(:,:),z_b(:,:) !z(nbasfcn,neigd),z_b(nbasfcn,neigd)
#endif
complex, intent (in):: vxy(nmzxyd,odi%n2d-1,2)
......@@ -228,15 +225,26 @@ c...for the k-point
bvac = exp(-cmplx(0.0,m*arg))*(ic**m)*
* cmplx(-duz(l,m)*bess(m) +
- uz(l,m)*sk2(irec2)*dbss(m),0.0)/
/ ((wronk1)*sqrt(omtil))
do n = 1,nslibd
acof(l,m,n) = acof(l,m,n) +
+ z(k+addnoco,n)*avac
c + conjg(z(k,n))*avac
bcof(l,m,n) = bcof(l,m,n) +
+ z(k+addnoco,n)*bvac
c + conjg(z(k,n))*bvac
enddo
/ ((wronk1)*sqrt(omtil))
IF(zMat%l_real) THEN
do n = 1,nslibd
acof(l,m,n) = acof(l,m,n) +
+ zMat%z_r(k+addnoco,n)*avac
c + conjg(zMat%z_r(k,n))*avac
bcof(l,m,n) = bcof(l,m,n) +
+ zMat%z_r(k+addnoco,n)*bvac
c + conjg(zMat%z_r(k,n))*bvac
enddo
ELSE
do n = 1,nslibd
acof(l,m,n) = acof(l,m,n) +
+ zMat%z_c(k+addnoco,n)*avac
c + conjg(zMat%z_c(k,n))*avac
bcof(l,m,n) = bcof(l,m,n) +
+ zMat%z_c(k+addnoco,n)*bvac
c + conjg(zMat%z_c(k,n))*bvac
enddo
END IF
enddo ! -mb:mb
endif
enddo
......@@ -273,15 +281,27 @@ c...for the b-point
bvac = exp(-cmplx(0.0,m*arg))*(ic**m)*
& cmplx(-duz_b(l,m)*bess(m) +
- uz_b(l,m)*sk2(irec2)*dbss(m),0.0)/
/ ((wronk1)*sqrt(omtil))
do n = 1,nslibd_b
acof_b(l,m,n) = acof_b(l,m,n) +
+ z_b(k+addnoco2,n)*avac
c + conjg(z(k,n))*avac
bcof_b(l,m,n) = bcof_b(l,m,n) +
+ z_b(k+addnoco2,n)*bvac
c + conjg(z(k,n))*bvac
enddo
/ ((wronk1)*sqrt(omtil))
IF(zMat_b%l_real) THEN
do n = 1,nslibd_b
acof_b(l,m,n) = acof_b(l,m,n) +
+ zMat_b%z_r(k+addnoco2,n)*avac
c + conjg(zMat_b%z_r(k,n))*avac
bcof_b(l,m,n) = bcof_b(l,m,n) +
+ zMat_b%z_r(k+addnoco2,n)*bvac
c + conjg(zMat_b%z_r(k,n))*bvac
enddo
ELSE
do n = 1,nslibd_b
acof_b(l,m,n) = acof_b(l,m,n) +
+ zMat_b%z_c(k+addnoco2,n)*avac
c + conjg(zMat_b%z_c(k,n))*avac
bcof_b(l,m,n) = bcof_b(l,m,n) +
+ zMat_b%z_c(k+addnoco2,n)*bvac
c + conjg(zMat_b%z_c(k,n))*bvac
enddo
END IF
enddo ! -mb:mb
endif
enddo ! k = 1,nv
......
wannier/uhu/wann_uHu_vac.F
View file @ 3032c4e5
......@@ -16,13 +16,17 @@ c***************************************c
> nmz,delz,ig2,nq2,kv2,area,bmat,bbmat,evac,evac_b,
> bkpt,bkpt_b,vzxy,vz,nslibd,nslibd_b,jspin,jspin_b,
> ico,k1,k2,k3,k1_b,k2_b,k3_b,jspd,nvd,nbasfcn,neigd,
> z,z_b,nv,nv_b,omtil,gb,gb2,sign2,uHu)
> zMat,zMat_b,nv,nv_b,omtil,gb,gb2,sign2,uHu)
#include "cpp_double.h"
USE m_types
use m_constants, only : pimach
use m_intgr, only : intgz0
use m_d2fdz2cmplx
implicit none
TYPE(t_zmat), INTENT(IN) :: zMat, zMat_b
c .. scalar Arguments..
logical, intent (in) :: l_noco,l_soc,zrfs
integer, intent (in) :: nlotot,jspin_b,n2d,jspins,ico
......@@ -49,12 +53,6 @@ c ..array arguments..
complex, intent (in) :: vzxy(nmzxyd,n2d-1,2)
complex, intent (inout) :: uHu(nbnd,nbnd)
#if ( !defined(CPP_INVERSION) || defined(CPP_SOC) )
complex, intent (in):: z(nbasfcn,neigd),z_b(nbasfcn,neigd)
#else
real, intent (in):: z(nbasfcn,neigd),z_b(nbasfcn,neigd)
#endif
c ..local arrays..
complex, allocatable :: ac(:,:),bc(:,:),ac_b(:,:),bc_b(:,:)
complex, allocatable :: vv(:),fac(:),fac_b(:),fac1(:)
......@@ -275,10 +273,18 @@ c if (nvac==1) symvacvac=2
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) = ac(l,n) + z(k+addnoco,n)*av
bc(l,n) = bc(l,n) + z(k+addnoco,n)*bv
enddo
IF(zMat%l_real) THEN
do n = 1,nslibd
ac(l,n) = ac(l,n) + zMat%z_r(k+addnoco,n)*av
bc(l,n) = bc(l,n) + zMat%z_r(k+addnoco,n)*bv
enddo
ELSE
do n = 1,nslibd
ac(l,n) = ac(l,n) + zMat%z_c(k+addnoco,n)*av
bc(l,n) = bc(l,n) + zMat%z_c(k+addnoco,n)*bv
enddo
END IF
enddo