From 6caba52805b3c76aba78261421460638d854a02f Mon Sep 17 00:00:00 2001 From: Pierre-Francois Loos Date: Thu, 4 Jul 2024 13:21:45 +0200 Subject: [PATCH] working on dBSE beyond TDA --- src/GF/GF2_ppBSE2_static_kernel_B.f90 | 38 +++++++-------------------- src/GF/GF2_ppBSE2_static_kernel_C.f90 | 36 ++++++------------------- src/GF/GF2_ppBSE2_static_kernel_D.f90 | 38 +++++++-------------------- 3 files changed, 26 insertions(+), 86 deletions(-) diff --git a/src/GF/GF2_ppBSE2_static_kernel_B.f90 b/src/GF/GF2_ppBSE2_static_kernel_B.f90 index bc41b5f..03ff94f 100644 --- a/src/GF/GF2_ppBSE2_static_kernel_B.f90 +++ b/src/GF/GF2_ppBSE2_static_kernel_B.f90 @@ -51,29 +51,17 @@ subroutine GF2_ppBSE2_static_kernel_B(ispin,eta,nBas,nC,nO,nV,nR,nOO,nVV,lambda, do k=nC+1,nO do c=nO+1,nBas-nR - dem = eGF(k) - eGF(c) + dem = eGF(k) - eGF(c) num = 2d0*ERI(a,k,i,c)*ERI(b,c,j,k) - ERI(a,k,i,c)*ERI(b,c,k,j) & - ERI(a,k,c,i)*ERI(b,c,j,k) + 2d0*ERI(a,k,c,i)*ERI(b,c,k,j) - KB_sta(ab,ij) = KB_sta(ab,ij) + 0.5d0*num*dem/(dem**2 + eta**2) + KB_sta(ab,ij) = KB_sta(ab,ij) + num*dem/(dem**2 + eta**2) dem = eGF(k) - eGF(c) num = 2d0*ERI(b,k,i,c)*ERI(a,c,j,k) - ERI(b,k,i,c)*ERI(a,c,k,j) & - ERI(b,k,c,i)*ERI(a,c,j,k) + 2d0*ERI(b,k,c,i)*ERI(a,c,k,j) - KB_sta(ab,ij) = KB_sta(ab,ij) - 0.5d0*num*dem/(dem**2 + eta**2) - - dem = eGF(k) - eGF(c) - num = 2d0*ERI(a,c,i,k)*ERI(b,k,j,c) - ERI(a,c,i,k)*ERI(b,k,c,j) & - - ERI(a,c,k,i)*ERI(b,k,j,c) + 2d0*ERI(a,c,k,i)*ERI(b,k,c,j) - - KB_sta(ab,ij) = KB_sta(ab,ij) + 0.5d0*num*dem/(dem**2 + eta**2) - - dem = eGF(k) - eGF(c) - num = 2d0*ERI(b,c,i,k)*ERI(a,k,j,c) - ERI(b,c,i,k)*ERI(a,k,c,j) & - - ERI(b,c,k,i)*ERI(a,k,j,c) + 2d0*ERI(b,c,k,i)*ERI(a,k,c,j) - - KB_sta(ab,ij) = KB_sta(ab,ij) - 0.5d0*num*dem/(dem**2 + eta**2) + KB_sta(ab,ij) = KB_sta(ab,ij) - num*dem/(dem**2 + eta**2) end do end do @@ -104,24 +92,16 @@ subroutine GF2_ppBSE2_static_kernel_B(ispin,eta,nBas,nC,nO,nV,nR,nOO,nVV,lambda, do c=nO+1,nBas-nR dem = eGF(k) - eGF(c) - num = 2d0*ERI(a,k,i,c)*ERI(b,c,j,k) - ERI(a,k,i,c)*ERI(b,c,k,j) - ERI(a,k,c,i)*ERI(b,c,j,k) + num = 2d0*ERI(a,k,i,c)*ERI(b,c,j,k) - ERI(a,k,i,c)*ERI(b,c,k,j) & + - ERI(a,k,c,i)*ERI(b,c,j,k) + ERI(a,k,c,i)*ERI(b,c,k,j) - KB_sta(ab,ij) = KB_sta(ab,ij) + 0.5d0*num*dem/(dem**2 + eta**2) + KB_sta(ab,ij) = KB_sta(ab,ij) + 2d0*num*dem/(dem**2 + eta**2) dem = eGF(k) - eGF(c) - num = 2d0*ERI(b,k,i,c)*ERI(a,c,j,k) - ERI(b,k,i,c)*ERI(a,c,k,j) - ERI(b,k,c,i)*ERI(a,c,j,k) + num = 2d0*ERI(b,k,i,c)*ERI(a,c,j,k) - ERI(b,k,i,c)*ERI(a,c,k,j) & + - ERI(b,k,c,i)*ERI(a,c,j,k) + ERI(b,k,c,i)*ERI(a,c,k,j) - KB_sta(ab,ij) = KB_sta(ab,ij) - 0.5d0*num*dem/(dem**2 + eta**2) - - dem = eGF(k) - eGF(c) - num = 2d0*ERI(a,c,i,k)*ERI(b,k,j,c) - ERI(a,c,i,k)*ERI(b,k,c,j) - ERI(a,c,k,i)*ERI(b,k,j,c) - - KB_sta(ab,ij) = KB_sta(ab,ij) + 0.5d0*num*dem/(dem**2 + eta**2) - - dem = eGF(k) - eGF(c) - num = 2d0*ERI(b,c,i,k)*ERI(a,k,j,c) - ERI(b,c,i,k)*ERI(a,k,c,j) - ERI(b,c,k,i)*ERI(a,k,j,c) - - KB_sta(ab,ij) = KB_sta(ab,ij) - 0.5d0*num*dem/(dem**2 + eta**2) + KB_sta(ab,ij) = KB_sta(ab,ij) - 2d0*num*dem/(dem**2 + eta**2) end do end do diff --git a/src/GF/GF2_ppBSE2_static_kernel_C.f90 b/src/GF/GF2_ppBSE2_static_kernel_C.f90 index a89da30..b34f700 100644 --- a/src/GF/GF2_ppBSE2_static_kernel_C.f90 +++ b/src/GF/GF2_ppBSE2_static_kernel_C.f90 @@ -55,25 +55,13 @@ subroutine GF2_ppBSE2_static_kernel_C(ispin,eta,nBas,nC,nO,nV,nR,nVV,lambda,ERI, num = 2d0*ERI(a,m,c,e)*ERI(b,e,d,m) - ERI(a,m,c,e)*ERI(b,e,m,d) & - ERI(a,m,e,c)*ERI(b,e,d,m) + 2d0*ERI(a,m,e,c)*ERI(b,e,m,d) - KC_sta(ab,cd) = KC_sta(ab,cd) + 0.5d0*num*dem/(dem**2 + eta**2) + KC_sta(ab,cd) = KC_sta(ab,cd) + num*dem/(dem**2 + eta**2) dem = eGF(m) - eGF(e) num = 2d0*ERI(b,m,c,e)*ERI(a,e,d,m) - ERI(b,m,c,e)*ERI(a,e,m,d) & - ERI(b,m,e,c)*ERI(a,e,d,m) + 2d0*ERI(b,m,e,c)*ERI(a,e,m,d) - KC_sta(ab,cd) = KC_sta(ab,cd) - 0.5d0*num*dem/(dem**2 + eta**2) - - dem = eGF(m) - eGF(e) - num = 2d0*ERI(a,e,c,m)*ERI(b,m,d,e) - ERI(a,e,c,m)*ERI(b,m,e,d) & - - ERI(a,e,m,c)*ERI(b,m,d,e) + 2d0*ERI(a,e,m,c)*ERI(b,m,e,d) - - KC_sta(ab,cd) = KC_sta(ab,cd) + 0.5d0*num*dem/(dem**2 + eta**2) - - dem = eGF(m) - eGF(e) - num = 2d0*ERI(b,e,c,m)*ERI(a,m,d,e) - ERI(b,e,c,m)*ERI(a,m,e,d) & - - ERI(b,e,m,c)*ERI(a,m,d,e) + 2d0*ERI(b,e,c,m)*ERI(a,m,e,d) - - KC_sta(ab,cd) = KC_sta(ab,cd) - 0.5d0*num*dem/(dem**2 + eta**2) + KC_sta(ab,cd) = KC_sta(ab,cd) - num*dem/(dem**2 + eta**2) end do end do @@ -104,24 +92,16 @@ subroutine GF2_ppBSE2_static_kernel_C(ispin,eta,nBas,nC,nO,nV,nR,nVV,lambda,ERI, do e=nO+1,nBas-nR dem = eGF(m) - eGF(e) - num = 2d0*ERI(a,m,c,e)*ERI(b,e,d,m) - ERI(a,m,c,e)*ERI(b,e,m,d) - ERI(a,m,e,c)*ERI(b,e,d,m) + num = 2d0*ERI(a,m,c,e)*ERI(b,e,d,m) - ERI(a,m,c,e)*ERI(b,e,m,d) & + - ERI(a,m,e,c)*ERI(b,e,d,m) + ERI(a,m,e,c)*ERI(b,e,m,d) - KC_sta(ab,cd) = KC_sta(ab,cd) + 0.5d0*num*dem/(dem**2 + eta**2) + KC_sta(ab,cd) = KC_sta(ab,cd) + 2d0*num*dem/(dem**2 + eta**2) dem = eGF(m) - eGF(e) - num = 2d0*ERI(b,m,c,e)*ERI(a,e,d,m) - ERI(b,m,c,e)*ERI(a,e,m,d) - ERI(b,m,e,c)*ERI(a,e,d,m) + num = 2d0*ERI(b,m,c,e)*ERI(a,e,d,m) - ERI(b,m,c,e)*ERI(a,e,m,d) & + - ERI(b,m,e,c)*ERI(a,e,d,m) + ERI(b,m,e,c)*ERI(a,e,m,d) - KC_sta(ab,cd) = KC_sta(ab,cd) - 0.5d0*num*dem/(dem**2 + eta**2) - - dem = eGF(m) - eGF(e) - num = 2d0*ERI(a,e,c,m)*ERI(b,m,d,e) - ERI(a,e,c,m)*ERI(b,m,e,d) - ERI(a,e,m,c)*ERI(b,m,d,e) - - KC_sta(ab,cd) = KC_sta(ab,cd) + 0.5d0*num*dem/(dem**2 + eta**2) - - dem = eGF(m) - eGF(e) - num = 2d0*ERI(b,e,c,m)*ERI(a,m,d,e) - ERI(b,e,c,m)*ERI(a,m,e,d) - ERI(b,e,m,c)*ERI(a,m,d,e) - - KC_sta(ab,cd) = KC_sta(ab,cd) - 0.5d0*num*dem/(dem**2 + eta**2) + KC_sta(ab,cd) = KC_sta(ab,cd) - 2d0*num*dem/(dem**2 + eta**2) end do end do diff --git a/src/GF/GF2_ppBSE2_static_kernel_D.f90 b/src/GF/GF2_ppBSE2_static_kernel_D.f90 index bf013dd..7e18345 100644 --- a/src/GF/GF2_ppBSE2_static_kernel_D.f90 +++ b/src/GF/GF2_ppBSE2_static_kernel_D.f90 @@ -55,25 +55,13 @@ subroutine GF2_ppBSE2_static_kernel_D(ispin,eta,nBas,nC,nO,nV,nR,nOO,lambda,ERI, num = 2d0*ERI(i,e,k,m)*ERI(j,m,l,e) - ERI(i,e,k,m)*ERI(j,m,e,l) & - ERI(i,e,m,k)*ERI(j,m,l,e) + 2d0*ERI(i,e,m,k)*ERI(j,m,e,l) - KD_sta(ij,kl) = KD_sta(ij,kl) + 0.5d0*num*dem/(dem**2 + eta**2) + KD_sta(ij,kl) = KD_sta(ij,kl) + num*dem/(dem**2 + eta**2) dem = - eGF(e) + eGF(m) num = 2d0*ERI(j,e,k,m)*ERI(i,m,l,e) - ERI(j,e,k,m)*ERI(i,m,e,l) & - ERI(j,e,m,k)*ERI(i,m,l,e) + 2d0*ERI(j,e,m,k)*ERI(i,m,e,l) - KD_sta(ij,kl) = KD_sta(ij,kl) - 0.5d0*num*dem/(dem**2 + eta**2) - - dem = - eGF(e) + eGF(m) - num = 2d0*ERI(i,m,k,e)*ERI(j,e,l,m) - ERI(i,m,k,e)*ERI(j,e,m,l) & - - ERI(i,m,e,k)*ERI(j,e,l,m) + 2d0*ERI(i,m,e,k)*ERI(j,e,m,l) - - KD_sta(ij,kl) = KD_sta(ij,kl) + 0.5d0*num*dem/(dem**2 + eta**2) - - dem = - eGF(e) + eGF(m) - num = 2d0*ERI(j,m,k,e)*ERI(i,e,l,m) - ERI(j,m,k,e)*ERI(i,e,m,l) & - - ERI(j,m,e,k)*ERI(i,e,l,m) + 2d0*ERI(j,m,e,k)*ERI(i,e,m,l) - - KD_sta(ij,kl) = KD_sta(ij,kl) - 0.5d0*num*dem/(dem**2 + eta**2) + KD_sta(ij,kl) = KD_sta(ij,kl) - num*dem/(dem**2 + eta**2) end do end do @@ -104,25 +92,17 @@ subroutine GF2_ppBSE2_static_kernel_D(ispin,eta,nBas,nC,nO,nV,nR,nOO,lambda,ERI, do e=nO+1,nBas-nR dem = - eGF(e) + eGF(m) - num = 2d0*ERI(i,e,k,m)*ERI(j,m,l,e) - ERI(i,e,k,m)*ERI(j,m,e,l) - ERI(i,e,m,k)*ERI(j,m,l,e) + num = 2d0*ERI(i,e,k,m)*ERI(j,m,l,e) - ERI(i,e,k,m)*ERI(j,m,e,l) & + - ERI(i,e,m,k)*ERI(j,m,l,e) + ERI(i,e,m,k)*ERI(j,m,e,l) + + KD_sta(ij,kl) = KD_sta(ij,kl) + 2d0*num*dem/(dem**2 + eta**2) - KD_sta(ij,kl) = KD_sta(ij,kl) + 0.5d0*num*dem/(dem**2 + eta**2) - dem = - eGF(e) + eGF(m) - num = 2d0*ERI(j,e,k,m)*ERI(i,m,l,e) - ERI(j,e,k,m)*ERI(i,m,e,l) - ERI(j,e,m,k)*ERI(i,m,l,e) + num = 2d0*ERI(j,e,k,m)*ERI(i,m,l,e) - ERI(j,e,k,m)*ERI(i,m,e,l) & + - ERI(j,e,m,k)*ERI(i,m,l,e) + ERI(j,e,m,k)*ERI(i,m,e,l) - KD_sta(ij,kl) = KD_sta(ij,kl) - 0.5d0*num*dem/(dem**2 + eta**2) - - dem = - eGF(e) + eGF(m) - num = 2d0*ERI(i,m,k,e)*ERI(j,e,l,m) - ERI(i,m,k,e)*ERI(j,e,m,l) - ERI(i,m,e,k)*ERI(j,e,l,m) + KD_sta(ij,kl) = KD_sta(ij,kl) - 2d0*num*dem/(dem**2 + eta**2) - KD_sta(ij,kl) = KD_sta(ij,kl) + 0.5d0*num*dem/(dem**2 + eta**2) - - dem = - eGF(e) + eGF(m) - num = 2d0*ERI(j,m,k,e)*ERI(i,e,l,m) - ERI(j,m,k,e)*ERI(i,e,m,l) - ERI(j,m,e,k)*ERI(i,e,l,m) - - KD_sta(ij,kl) = KD_sta(ij,kl) - 0.5d0*num*dem/(dem**2 + eta**2) - end do end do