Commit 3032c4e5 authored by Gregor Michalicek's avatar Gregor Michalicek

And more and more fixes to integrate the Wannier code

parent 5be524db
......@@ -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
......
This diff is collapsed.
......@@ -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
......@@ -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
......
......@@ -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