PTEROSOR/QuAcK
10
1
Fork 0
mirror of https://github.com/pfloos/quack synced 2024-12-22 20:34:46 +01:00
Code Releases Activity

Merge branch 'master' of github.com:pfloos/QuAcK

Browse Source
This commit is contained in:
Pierre-Francois Loos 2024-10-31 19:36:15 +01:00
commit 33a2debb3a
5 changed files with 86 additions and 56 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
src/GT/GGTpp_ppBSE_static_kernel_B.f90
View File

@ -54,10 +54,8 @@ subroutine GGTpp_ppBSE_static_kernel_B(eta,nOrb,nC,nO,nV,nR,nOO,nVV,lambda,ERI,e
do e=nO+1,nOrb-nR do e=nO+1,nOrb-nR
dem = eGF(m) - eGF(e) dem = eGF(m) - eGF(e)
num = (T(a,m,i,e) - T(a,m,e,i)) * (T(e,b,m,j) - T(e,b,j,m)) num = T(a,m,i,e) * T(e,b,m,j) + T(a,e,i,m) * T(m,b,e,j)
num = num + (T(a,e,i,m) - T(a,e,m,i)) * (T(m,b,e,j) - T(m,b,j,e)) num = num - T(b,m,i,e) * T(e,a,m,j) - T(b,e,i,m) * T(m,a,e,j)
num = num - (T(b,m,i,e) - T(b,m,e,i)) * (T(e,a,m,j) - T(e,a,j,m))
num = num - (T(b,e,i,m) - T(b,e,m,i)) * (T(m,a,e,j) - T(m,a,j,e))
KB_sta(ab,ij) = KB_sta(ab,ij) + num*dem/(dem**2 + eta**2) KB_sta(ab,ij) = KB_sta(ab,ij) + num*dem/(dem**2 + eta**2)
end do end do

7
src/GT/GGTpp_ppBSE_static_kernel_C.f90
View File

@ -55,11 +55,8 @@ subroutine GGTpp_ppBSE_static_kernel_C(eta,nOrb,nC,nO,nV,nR,nOO,nVV,lambda,ERI,e
do e=nO+1,nOrb-nR do e=nO+1,nOrb-nR
dem = eGF(m) - eGF(e) dem = eGF(m) - eGF(e)
num = (T(a,m,c,e) - T(a,m,e,c)) * (T(e,b,m,d) - T(e,b,d,m)) num = T(a,m,c,e) * T(e,b,m,d) + T(a,e,c,m) * T(m,b,e,d)
num = num + (T(a,e,c,m) - T(a,e,m,c)) * (T(m,b,e,d) - T(m,b,d,e)) num = num - T(b,m,c,e) * T(e,a,m,d) - T(b,e,c,m) * T(m,a,e,d)
num = num - (T(b,m,c,e) - T(b,m,e,c)) * (T(e,a,m,d) - T(e,a,d,m))
num = num - (T(b,e,c,m) - T(b,e,m,c)) * (T(m,a,e,d) - T(m,a,d,e))
KC_sta(ab,cd) = KC_sta(ab,cd) + num*dem/(dem**2 + eta**2) KC_sta(ab,cd) = KC_sta(ab,cd) + num*dem/(dem**2 + eta**2)
end do end do

63
src/GT/RGTpp_ppBSE_static_kernel_B.f90
View File

@ -24,9 +24,9 @@ subroutine RGTpp_ppBSE_static_kernel_B(ispin,eta,nBas,nC,nO,nV,nR,nOO,nVV,lambda
! Local variables ! Local variables
double precision :: chi double precision,external :: Kronecker_delta
double precision :: eps double precision :: dem,num
integer :: i,j,a,b,ij,ab,cd,kl integer :: i,j,a,b,ij,ab,cd,kl,m,e
! Output variables ! Output variables
@ -52,19 +52,31 @@ subroutine RGTpp_ppBSE_static_kernel_B(ispin,eta,nBas,nC,nO,nV,nR,nOO,nVV,lambda
do j=i,nO do j=i,nO
ij = ij + 1 ij = ij + 1
chi = 0d0 do m=nC+1,nO
do e=nO+1,nBas-nR
dem = eGF(m) - eGF(e)
! Wabab_{ijkl}
num = Taaaa(a,m,i,e)*Tabab(e,b,m,j) + Tabab(a,m,i,e)*Taaaa(e,b,m,j)
KB_sta(ab,ij) = KB_sta(ab,ij) + num*dem/(dem**2 + eta**2)
do cd=1,nVV num = Taaaa(a,e,i,m)*Tabab(m,b,e,j) + Tabab(a,e,i,m)*Taaaa(m,b,e,j)
eps = 0d0 KB_sta(ab,ij) = KB_sta(ab,ij) + num*dem/(dem**2 + eta**2)
chi = chi + 0d0
num = Taaaa(b,m,i,e)*Tabab(e,a,m,j) + Tabab(b,m,i,e)*Taaaa(e,a,m,j)
KB_sta(ab,ij) = KB_sta(ab,ij) + num*dem/(dem**2 + eta**2)
num = Taaaa(b,e,i,m)*Tabab(m,a,e,j) + Tabab(b,e,i,m)*Taaaa(m,a,e,j)
KB_sta(ab,ij) = KB_sta(ab,ij) + num*dem/(dem**2 + eta**2)
num = Tbaab(a,m,i,e)*Tbaab(e,b,m,j) + Tbaab(a,e,i,m)*Tbaab(m,b,e,j)
KB_sta(ab,ij) = KB_sta(ab,ij) - num*dem/(dem**2 + eta**2)
num = Tbaab(b,m,i,e)*Tbaab(e,a,m,j) + Tbaab(b,e,i,m)*Tbaab(m,a,e,j)
KB_sta(ab,ij) = KB_sta(ab,ij) - num*dem/(dem**2 + eta**2)
end do
end do end do
do kl=1,nOO KB_sta(ab,ij) = KB_sta(ab,ij) / sqrt((1d0 + Kronecker_delta(a,b))*(1d0 + Kronecker_delta(i,j)))
eps = 0d0
chi = chi + 0d0
end do
KB_sta(ab,ij) = lambda*chi
end do end do
end do end do
@ -90,20 +102,25 @@ subroutine RGTpp_ppBSE_static_kernel_B(ispin,eta,nBas,nC,nO,nV,nR,nOO,nVV,lambda
do j=i+1,nO do j=i+1,nO
ij = ij + 1 ij = ij + 1
chi = 0d0 do m=nC+1,nO
do e=nO+1,nBas-nR
dem = eGF(m) - eGF(e)
num = Taaaa(a,m,i,e)*Taaaa(e,b,m,j) + Tabab(a,m,i,e)*Tabab(e,b,m,j)
KB_sta(ab,ij) = KB_sta(ab,ij) + num*dem/(dem**2 + eta**2)
num = Taaaa(a,e,i,m)*Taaaa(m,b,e,j) + Tabab(a,e,i,m)*Tabab(m,b,e,j)
KB_sta(ab,ij) = KB_sta(ab,ij) + num*dem/(dem**2 + eta**2)
num = Taaaa(b,m,i,e)*Taaaa(e,a,m,j) + Tabab(b,m,i,e)*Tabab(e,a,m,j)
KB_sta(ab,ij) = KB_sta(ab,ij) - num*dem/(dem**2 + eta**2)
num = Taaaa(b,e,i,m)*Taaaa(m,a,e,j) + Tabab(b,e,i,m)*Tabab(m,a,e,j)
KB_sta(ab,ij) = KB_sta(ab,ij) - num*dem/(dem**2 + eta**2)
do cd=1,nVV
eps = 0d0
chi = chi + 0d0
end do end do
do kl=1,nOO
eps = 0d0
chi = chi + 0d0
end do end do
KB_sta(ab,ij) = lambda*chi
end do end do
end do end do

46
src/GT/RGTpp_ppBSE_static_kernel_C.f90
View File

@ -26,8 +26,6 @@ subroutine RGTpp_ppBSE_static_kernel_C(ispin,eta,nBas,nC,nO,nV,nR,nOO,nVV,lambda
double precision,external :: Kronecker_delta double precision,external :: Kronecker_delta
double precision :: dem,num double precision :: dem,num
double precision :: chi
double precision :: eps
integer :: a,b,c,d,ab,cd,ef,mn,m,e integer :: a,b,c,d,ab,cd,ef,mn,m,e
! Output variables ! Output variables
@ -54,19 +52,31 @@ subroutine RGTpp_ppBSE_static_kernel_C(ispin,eta,nBas,nC,nO,nV,nR,nOO,nVV,lambda
do d=c,nBas-nR do d=c,nBas-nR
cd = cd + 1 cd = cd + 1
chi = 0d0 do m=nC+1,nO
do e=nO+1,nBas-nR
dem = eGF(m) - eGF(e)
! Wabab_{ijkl}
num = Taaaa(a,m,c,e)*Tabab(e,b,m,d) + Tabab(a,m,c,e)*Taaaa(e,b,m,d)
KC_sta(ab,cd) = KC_sta(ab,cd) + num*dem/(dem**2 + eta**2)
do ef=1,nVV num = Taaaa(a,e,c,m)*Tabab(m,b,e,d) + Tabab(a,e,c,m)*Taaaa(m,b,e,d)
eps = 0d0 KC_sta(ab,cd) = KC_sta(ab,cd) + num*dem/(dem**2 + eta**2)
chi = chi + 0d0
num = Taaaa(b,m,c,e)*Tabab(e,a,m,d) + Tabab(b,m,c,e)*Taaaa(e,a,m,d)
KC_sta(ab,cd) = KC_sta(ab,cd) + num*dem/(dem**2 + eta**2)
num = Taaaa(b,e,c,m)*Tabab(m,a,e,d) + Tabab(b,e,c,m)*Taaaa(m,a,e,d)
KC_sta(ab,cd) = KC_sta(ab,cd) + num*dem/(dem**2 + eta**2)
num = Tbaab(a,m,c,e)*Tbaab(e,b,m,d) + Tbaab(a,e,c,m)*Tbaab(m,b,e,d)
KC_sta(ab,cd) = KC_sta(ab,cd) - num*dem/(dem**2 + eta**2)
num = Tbaab(b,m,c,e)*Tbaab(e,a,m,d) + Tbaab(b,e,c,m)*Tbaab(m,a,e,d)
KC_sta(ab,cd) = KC_sta(ab,cd) - num*dem/(dem**2 + eta**2)
end do
end do end do
do mn=1,nOO KC_sta(ab,cd) = KC_sta(ab,cd) / sqrt((1d0 + Kronecker_delta(a,b))*(1d0 + Kronecker_delta(c,d)))
eps = 0d0
chi = chi + 0d0
end do
KC_sta(ab,cd) = 0.5d0*lambda*chi/sqrt((1d0 + Kronecker_delta(a,b))*(1d0 + Kronecker_delta(c,d)))
end do end do
end do end do
@ -95,9 +105,19 @@ subroutine RGTpp_ppBSE_static_kernel_C(ispin,eta,nBas,nC,nO,nV,nR,nOO,nVV,lambda
do m=nC+1,nO do m=nC+1,nO
do e=nO+1,nBas-nR do e=nO+1,nBas-nR
dem = eGF(m) - eGF(e) dem = eGF(m) - eGF(e)
num = 2d0*(Taaaa(a,m,c,e)*Taaaa(e,b,m,d) + Tabab(a,m,c,e)*Tabab(e,b,m,d))
num = Taaaa(a,m,c,e)*Taaaa(e,b,m,d) + Tabab(a,m,c,e)*Tabab(e,b,m,d)
KC_sta(ab,cd) = KC_sta(ab,cd) + num*dem/(dem**2 + eta**2) KC_sta(ab,cd) = KC_sta(ab,cd) + num*dem/(dem**2 + eta**2)
num = Taaaa(a,e,c,m)*Taaaa(m,b,e,d) + Tabab(a,e,c,m)*Tabab(m,b,e,d)
KC_sta(ab,cd) = KC_sta(ab,cd) + num*dem/(dem**2 + eta**2)
num = Taaaa(b,m,c,e)*Taaaa(e,a,m,d) + Tabab(b,m,c,e)*Tabab(e,a,m,d)
KC_sta(ab,cd) = KC_sta(ab,cd) - num*dem/(dem**2 + eta**2)
num = Taaaa(b,e,c,m)*Taaaa(m,a,e,d) + Tabab(b,e,c,m)*Tabab(m,a,e,d)
KC_sta(ab,cd) = KC_sta(ab,cd) - num*dem/(dem**2 + eta**2)
end do end do
end do end do

2
src/GT/RGTpp_ppBSE_static_kernel_D.f90
View File

@ -24,8 +24,6 @@ subroutine RGTpp_ppBSE_static_kernel_D(ispin,eta,nBas,nC,nO,nV,nR,nOO,nVV,lambda
double precision,external :: Kronecker_delta double precision,external :: Kronecker_delta
double precision :: dem,num double precision :: dem,num
double precision :: chi
double precision :: eps
integer :: i,j,k,l,ij,kl,ef,mn,m,e integer :: i,j,k,l,ij,kl,ef,mn,m,e
! Output variables ! Output variables