From 6ed7fd09be4d5948a0aa3084a0dcb4185942cf66 Mon Sep 17 00:00:00 2001 From: Antoine Marie Date: Thu, 31 Oct 2024 17:17:50 +0100 Subject: [PATCH] saving work in T matrix kernel --- src/GT/GGTpp_ppBSE_static_kernel_B.f90 | 10 ++-- src/GT/GGTpp_ppBSE_static_kernel_C.f90 | 11 ++-- src/GT/RGTpp_ppBSE_static_kernel_B.f90 | 69 ++++++++++++++++---------- src/GT/RGTpp_ppBSE_static_kernel_C.f90 | 50 +++++++++++++------ src/GT/RGTpp_ppBSE_static_kernel_D.f90 | 2 - 5 files changed, 86 insertions(+), 56 deletions(-) diff --git a/src/GT/GGTpp_ppBSE_static_kernel_B.f90 b/src/GT/GGTpp_ppBSE_static_kernel_B.f90 index e70bcee..848cbfd 100644 --- a/src/GT/GGTpp_ppBSE_static_kernel_B.f90 +++ b/src/GT/GGTpp_ppBSE_static_kernel_B.f90 @@ -53,12 +53,10 @@ subroutine GGTpp_ppBSE_static_kernel_B(eta,nOrb,nC,nO,nV,nR,nOO,nVV,lambda,ERI,e do m=nC+1,nO do e=nO+1,nOrb-nR - 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 = 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(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) + dem = eGF(m) - eGF(e) + num = T(a,m,i,e) * T(e,b,m,j) + T(a,e,i,m) * T(m,b,e,j) + num = num - T(b,m,i,e) * T(e,a,m,j) - T(b,e,i,m) * T(m,a,e,j) + KB_sta(ab,ij) = KB_sta(ab,ij) + num*dem/(dem**2 + eta**2) end do end do diff --git a/src/GT/GGTpp_ppBSE_static_kernel_C.f90 b/src/GT/GGTpp_ppBSE_static_kernel_C.f90 index 3808d90..c0c3866 100644 --- a/src/GT/GGTpp_ppBSE_static_kernel_C.f90 +++ b/src/GT/GGTpp_ppBSE_static_kernel_C.f90 @@ -54,13 +54,10 @@ subroutine GGTpp_ppBSE_static_kernel_C(eta,nOrb,nC,nO,nV,nR,nOO,nVV,lambda,ERI,e do m=nC+1,nO do e=nO+1,nOrb-nR - 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 = 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(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) + dem = eGF(m) - eGF(e) + num = T(a,m,c,e) * T(e,b,m,d) + T(a,e,c,m) * T(m,b,e,d) + num = num - T(b,m,c,e) * T(e,a,m,d) - T(b,e,c,m) * T(m,a,e,d) + KC_sta(ab,cd) = KC_sta(ab,cd) + num*dem/(dem**2 + eta**2) end do end do diff --git a/src/GT/RGTpp_ppBSE_static_kernel_B.f90 b/src/GT/RGTpp_ppBSE_static_kernel_B.f90 index de14f2c..d96a236 100644 --- a/src/GT/RGTpp_ppBSE_static_kernel_B.f90 +++ b/src/GT/RGTpp_ppBSE_static_kernel_B.f90 @@ -24,9 +24,9 @@ subroutine RGTpp_ppBSE_static_kernel_B(ispin,eta,nBas,nC,nO,nV,nR,nOO,nVV,lambda ! Local variables - double precision :: chi - double precision :: eps - integer :: i,j,a,b,ij,ab,cd,kl + double precision,external :: Kronecker_delta + double precision :: dem,num + integer :: i,j,a,b,ij,ab,cd,kl,m,e ! 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 ij = ij + 1 - chi = 0d0 - - do cd=1,nVV - eps = 0d0 - chi = 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) + + num = Taaaa(a,e,i,m)*Tabab(m,b,e,j) + Tabab(a,e,i,m)*Taaaa(m,b,e,j) + KB_sta(ab,ij) = KB_sta(ab,ij) + num*dem/(dem**2 + eta**2) + + 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 - do kl=1,nOO - eps = 0d0 - chi = chi + 0d0 - end do - - KB_sta(ab,ij) = lambda*chi + KB_sta(ab,ij) = KB_sta(ab,ij) / sqrt((1d0 + Kronecker_delta(a,b))*(1d0 + Kronecker_delta(i,j))) 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 ij = ij + 1 - chi = 0d0 - - do cd=1,nVV - eps = 0d0 - chi = 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) + + end do end do - do kl=1,nOO - eps = 0d0 - chi = chi + 0d0 - end do - - KB_sta(ab,ij) = lambda*chi - end do end do diff --git a/src/GT/RGTpp_ppBSE_static_kernel_C.f90 b/src/GT/RGTpp_ppBSE_static_kernel_C.f90 index c8b36e4..a9ae81b 100644 --- a/src/GT/RGTpp_ppBSE_static_kernel_C.f90 +++ b/src/GT/RGTpp_ppBSE_static_kernel_C.f90 @@ -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 :: dem,num - double precision :: chi - double precision :: eps integer :: a,b,c,d,ab,cd,ef,mn,m,e ! 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 cd = cd + 1 - chi = 0d0 - - do ef=1,nVV - eps = 0d0 - chi = 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) + + num = Taaaa(a,e,c,m)*Tabab(m,b,e,d) + Tabab(a,e,c,m)*Taaaa(m,b,e,d) + KC_sta(ab,cd) = KC_sta(ab,cd) + num*dem/(dem**2 + eta**2) + + 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 - do mn=1,nOO - 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))) + KC_sta(ab,cd) = KC_sta(ab,cd) / sqrt((1d0 + Kronecker_delta(a,b))*(1d0 + Kronecker_delta(c,d))) 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 e=nO+1,nBas-nR 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) + + 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 diff --git a/src/GT/RGTpp_ppBSE_static_kernel_D.f90 b/src/GT/RGTpp_ppBSE_static_kernel_D.f90 index 5aae119..a3ea11a 100644 --- a/src/GT/RGTpp_ppBSE_static_kernel_D.f90 +++ b/src/GT/RGTpp_ppBSE_static_kernel_D.f90 @@ -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 :: dem,num - double precision :: chi - double precision :: eps integer :: i,j,k,l,ij,kl,ef,mn,m,e ! Output variables