LCPQ/quack
4
1
Fork 0
mirror of https://github.com/pfloos/quack synced 2024-12-22 04:14:26 +01:00
Code Releases Activity

fix stupid bug in UGW static kernel

Browse Source
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
src/GW/UGW_phBSE.f90
View File

@ -117,11 +117,11 @@ subroutine UGW_phBSE(exchange_kernel,TDA_W,TDA,dBSE,dTDA,spin_conserved,spin_fli
call phULR_A(ispin,dRPA,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sc,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_sc,1d0,ERI_aaaa,ERI_aabb,ERI_bbbb,Bph)
call UGW_phBSE_static_kernel_A(ispin,eta,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sc,nS_sc,1d0,OmRPA,rho_RPA,KA)
call UGW_phBSE_static_kernel_A(ispin,eta,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sc,nS_sc,1d0,OmRPA,rho_RPA,KA)
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,10 +155,11 @@ 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)
call UGW_phBSE_static_kernel_A(ispin,eta,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sc,nS_sf,1d0,OmRPA,rho_RPA,KA)
call UGW_phBSE_static_kernel_A(ispin,eta,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sc,nS_sf,1d0,OmRPA,rho_RPA,KA)
if(.not.TDA) call UGW_phBSE_static_kernel_B(ispin,eta,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sc,nS_sf,1d0,OmRPA,rho_RPA,KB)
Aph(:,:) = Aph(:,:) + KA(:,:)

2
src/GW/UGW_phBSE_static_kernel_A.f90
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

2
src/GW/UGW_phBSE_static_kernel_B.f90
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

15
src/HF/print_UHF.f90
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