10
1
mirror of https://github.com/pfloos/quack synced 2024-12-22 12:23:42 +01:00

fix stupid bug in UGW static kernel

This commit is contained in:
Pierre-Francois Loos 2024-10-30 09:28:39 +01:00
parent 61288e474d
commit 9b32dbd749
4 changed files with 8 additions and 18 deletions

View File

@ -121,7 +121,7 @@ subroutine UGW_phBSE(exchange_kernel,TDA_W,TDA,dBSE,dTDA,spin_conserved,spin_fli
if(.not.TDA) call UGW_phBSE_static_kernel_B(ispin,eta,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sc,nS_sc,1d0,OmRPA,rho_RPA,KB)
Aph(:,:) = Aph(:,:) + KA(:,:)
! if(.not.TDA) Bph(:,:) = Bph(:,:) + KB(:,:)
if(.not.TDA) Bph(:,:) = Bph(:,:) + KB(:,:)
call phULR(TDA,nS_aa,nS_bb,nS_sc,Aph,Bph,EcBSE(ispin),OmBSE,XpY_BSE,XmY_BSE)
@ -155,6 +155,7 @@ subroutine UGW_phBSE(exchange_kernel,TDA_W,TDA,dBSE,dTDA,spin_conserved,spin_fli
allocate(OmBSE(nS_sf),XpY_BSE(nS_sf,nS_sf),XmY_BSE(nS_sf,nS_sf))
! Compute spin-conserved BSE excitation energies
call phULR_A(ispin,dRPA,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sf,1d0,eGW,ERI_aaaa,ERI_aabb,ERI_bbbb,Aph)
if(.not.TDA) call phULR_B(ispin,dRPA,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sf,1d0,ERI_aaaa,ERI_aabb,ERI_bbbb,Bph)

View File

@ -36,6 +36,8 @@ subroutine UGW_phBSE_static_kernel_A(ispin,eta,nBas,nC,nO,nV,nR,nSa,nSb,nSt,nS_s
! Build BSE matrix for spin-conserving transitions !
!--------------------------------------------------!
KA(:,:) = 0d0
if(ispin == 1) then
! aaaa block

View File

@ -36,6 +36,8 @@ subroutine UGW_phBSE_static_kernel_B(ispin,eta,nBas,nC,nO,nV,nR,nSa,nSb,nSt,nS_s
! Build BSE matrix for spin-conserving transitions !
!--------------------------------------------------!
KB(:,:) = 0d0
if(ispin == 1) then
! aaaa block

View File

@ -31,7 +31,6 @@ subroutine print_UHF(nBas,nO,S,eHF,c,P,ENuc,ET,EV,EJ,Ex,EUHF,dipole)
double precision :: Sz
double precision :: Sx2,Sy2,Sz2
integer :: mu,nu
double precision,allocatable :: qa(:),qb(:)
logical :: dump_orb = .false.
@ -119,18 +118,4 @@ subroutine print_UHF(nBas,nO,S,eHF,c,P,ENuc,ET,EV,EJ,Ex,EUHF,dipole)
call vecout(nBas,eHF(:,2))
write(*,*)
allocate(qa(nBas),qb(nBas))
qa(:) = 0d0
qb(:) = 0d0
do mu=1,nBas
do nu=1,nBas
qa(mu) = qa(mu) + P(mu,nu,1)*S(nu,mu)
qb(mu) = qb(mu) + P(mu,nu,2)*S(nu,mu)
end do
end do
call vecout(nBas,qa)
call vecout(nBas,qb)
end subroutine