diff --git a/src/GT/GGT_Tmatrix.f90 b/src/GT/GGT_Tmatrix.f90 index 3ef9984..d38f584 100644 --- a/src/GT/GGT_Tmatrix.f90 +++ b/src/GT/GGT_Tmatrix.f90 @@ -25,7 +25,6 @@ subroutine GGT_Tmatrix(nOrb,nC,nO,nV,nR,nOO,nVV,lambda,ERI,eGF,Om1,rho1,Om2,rho2 ! Local variables integer :: p,q,r,s - integer :: c,d,k,l integer :: kl,cd ! Output variables @@ -38,8 +37,8 @@ subroutine GGT_Tmatrix(nOrb,nC,nO,nV,nR,nOO,nVV,lambda,ERI,eGF,Om1,rho1,Om2,rho2 ! Start by building the tensor elements of T ! This is probabbly not a good idea because this tensor is really large !$OMP PARALLEL & - !$OMP SHARED(nC,nO,nOrb,nR,T,ERI,rho1,rho2,Om1,Om2) & - !$OMP PRIVATE(p,q,r,s,c,d,cd,k,l,kl) & + !$OMP SHARED(nC,nO,nOrb,nR,nOO,nVV,T,ERI,rho1,rho2,Om1,Om2) & + !$OMP PRIVATE(p,q,r,s,cd,kl) & !$OMP DEFAULT(NONE) !$OMP DO do s=nC+1,nOrb-nR @@ -49,25 +48,13 @@ subroutine GGT_Tmatrix(nOrb,nC,nO,nV,nR,nOO,nVV,lambda,ERI,eGF,Om1,rho1,Om2,rho2 T(p,q,r,s) = ERI(p,q,r,s) - ERI(p,q,s,r) - cd = 0 - do c=nO+1,nOrb-nR - do d=c+1,nOrb-nR - cd = cd + 1 + do cd=1,nVV + T(p,q,r,s) = T(p,q,r,s) - rho1(p,q,cd)*rho1(r,s,cd)/Om1(cd) + end do - T(p,q,r,s) = T(p,q,r,s) - rho1(p,q,cd)*rho1(r,s,cd)/Om1(cd) - - end do ! d - end do ! c - - kl = 0 - do k=nC+1,nO - do l=k+1,nO - kl = kl + 1 - - T(p,q,r,s) = T(p,q,r,s) + rho2(p,q,kl)*rho2(r,s,kl)/Om2(kl) - - enddo - enddo + do kl=1,nOO + T(p,q,r,s) = T(p,q,r,s) + rho2(p,q,kl)*rho2(r,s,kl)/Om2(kl) + end do enddo enddo diff --git a/src/GT/GGTpp_ppBSE.f90 b/src/GT/GGTpp_ppBSE.f90 index 3f0be29..30f1d2b 100644 --- a/src/GT/GGTpp_ppBSE.f90 +++ b/src/GT/GGTpp_ppBSE.f90 @@ -91,9 +91,9 @@ subroutine GGTpp_ppBSE(TDA_T,TDA,dBSE,dTDA,eta,nOrb,nC,nO,nV,nR,nOO,nVV,ERI,dipo allocate(KB_sta(nVV,nOO),KC_sta(nVV,nVV),KD_sta(nOO,nOO)) + if(.not.TDA) call GGTpp_ppBSE_static_kernel_B(eta,nOrb,nC,nO,nV,nR,nOO,nVV,1d0,ERI,eGT,Om1,rho1,Om2,rho2,T,KB_sta) call GGTpp_ppBSE_static_kernel_C(eta,nOrb,nC,nO,nV,nR,nOO,nVV,1d0,ERI,eGT,Om1,rho1,Om2,rho2,T,KC_sta) call GGTpp_ppBSE_static_kernel_D(eta,nOrb,nC,nO,nV,nR,nOO,nVV,1d0,ERI,eGT,Om1,rho1,Om2,rho2,T,KD_sta) - if(.not.TDA) call GGTpp_ppBSE_static_kernel_B(eta,nOrb,nC,nO,nV,nR,nOO,nVV,1d0,ERI,eGT,Om1,rho1,Om2,rho2,T,KB_sta) deallocate(Om1,Om2,rho1,rho2) ! Deallocate the 4-tensor T diff --git a/src/GT/RGT_Tmatrix.f90 b/src/GT/RGT_Tmatrix.f90 index 6a8b3d5..6c34ce9 100644 --- a/src/GT/RGT_Tmatrix.f90 +++ b/src/GT/RGT_Tmatrix.f90 @@ -46,8 +46,8 @@ subroutine RGT_Tmatrix(isp_T,nBas,nC,nO,nV,nR,nOOs,nVVs,nOOt,nVVt,lambda,ERI,Om1 if(isp_T == 1) then !$OMP PARALLEL & - !$OMP SHARED(nC,nO,nBas,nR,T,ERI,rho1t,rho2t,Om1t,Om2t) & - !$OMP PRIVATE(p,q,r,s,c,d,cd,k,l,kl) & + !$OMP SHARED(nC,nO,nBas,nR,T,ERI,nOOt,nVVt,rho1t,rho2t,Om1t,Om2t) & + !$OMP PRIVATE(p,q,r,s,cd,kl) & !$OMP DEFAULT(NONE) !$OMP DO do s=nC+1,nBas-nR @@ -57,21 +57,13 @@ subroutine RGT_Tmatrix(isp_T,nBas,nC,nO,nV,nR,nOOs,nVVs,nOOt,nVVt,lambda,ERI,Om1 T(p,q,r,s) = ERI(p,q,r,s) - ERI(p,q,s,r) - cd = 0 - do c=nO+1,nBas-nR - do d=c+1,nBas-nR - cd = cd + 1 - T(p,q,r,s) = T(p,q,r,s) - rho1t(p,q,cd) * rho1t(r,s,cd) / Om1t(cd) - end do ! d - end do ! c + do cd=1,nVVt + T(p,q,r,s) = T(p,q,r,s) - rho1t(p,q,cd) * rho1t(r,s,cd) / Om1t(cd) + end do ! cd - kl = 0 - do k=nC+1,nO - do l=k+1,nO - kl = kl + 1 - T(p,q,r,s) = T(p,q,r,s) + rho2t(p,q,kl) * rho2t(r,s,kl) / Om2t(kl) - enddo ! l - enddo ! k + do kl=1,nOOt + T(p,q,r,s) = T(p,q,r,s) + rho2t(p,q,kl) * rho2t(r,s,kl) / Om2t(kl) + enddo ! kl enddo ! p enddo ! q @@ -86,8 +78,8 @@ subroutine RGT_Tmatrix(isp_T,nBas,nC,nO,nV,nR,nOOs,nVVs,nOOt,nVVt,lambda,ERI,Om1 if(isp_T == 2) then !$OMP PARALLEL & - !$OMP SHARED(nC,nO,nBas,nR,T,ERI,rho1s,rho2s,Om1s,Om2s,rho1t,rho2t,Om1t,Om2t) & - !$OMP PRIVATE(p,q,r,s,c,d,cd,k,l,kl) & + !$OMP SHARED(nC,nO,nBas,nR,T,ERI,nOOs,nOOt,nVVs,nVVt,rho1s,rho2s,Om1s,Om2s,rho1t,rho2t,Om1t,Om2t) & + !$OMP PRIVATE(p,q,r,s,cd,kl) & !$OMP DEFAULT(NONE) !$OMP DO do s=nC+1,nBas-nR @@ -97,37 +89,21 @@ subroutine RGT_Tmatrix(isp_T,nBas,nC,nO,nV,nR,nOOs,nVVs,nOOt,nVVt,lambda,ERI,Om1 T(p,q,r,s) = ERI(p,q,r,s) - cd = 0 - do c=nO+1,nBas-nR - do d=c,nBas-nR - cd = cd + 1 - T(p,q,r,s) = T(p,q,r,s) - 0.5d0 * rho1s(p,q,cd) * rho1s(r,s,cd) / Om1s(cd) - end do ! d - end do ! c + do cd=1,nVVs + T(p,q,r,s) = T(p,q,r,s) - 0.5d0 * rho1s(p,q,cd) * rho1s(r,s,cd) / Om1s(cd) + end do ! cd - cd = 0 - do c=nO+1,nBas-nR - do d=c+1,nBas-nR - cd = cd + 1 - T(p,q,r,s) = T(p,q,r,s) - 0.5d0 * rho1t(p,q,cd) * rho1t(r,s,cd) / Om1t(cd) - end do ! d - end do ! c + do cd=1,nVVt + T(p,q,r,s) = T(p,q,r,s) - 0.5d0 * rho1t(p,q,cd) * rho1t(r,s,cd) / Om1t(cd) + end do ! cd - kl = 0 - do k=nC+1,nO - do l=k,nO - kl = kl + 1 - T(p,q,r,s) = T(p,q,r,s) + 0.5d0 * rho2s(p,q,kl) * rho2s(r,s,kl) / Om2s(kl) - enddo ! l - enddo ! k + do kl=1,nOOs + T(p,q,r,s) = T(p,q,r,s) + 0.5d0 * rho2s(p,q,kl) * rho2s(r,s,kl) / Om2s(kl) + enddo ! kl - kl = 0 - do k=nC+1,nO - do l=k+1,nO - kl = kl + 1 - T(p,q,r,s) = T(p,q,r,s) + 0.5d0 * rho2t(p,q,kl) * rho2t(r,s,kl) / Om2t(kl) - enddo ! l - enddo ! k + do kl=1,nOOt + T(p,q,r,s) = T(p,q,r,s) + 0.5d0 * rho2t(p,q,kl) * rho2t(r,s,kl) / Om2t(kl) + enddo ! kl enddo ! p enddo ! q @@ -141,10 +117,9 @@ subroutine RGT_Tmatrix(isp_T,nBas,nC,nO,nV,nR,nOOs,nVVs,nOOt,nVVt,lambda,ERI,Om1 ! Elements baab if(isp_T == 3) then - !$OMP PARALLEL & - !$OMP SHARED(nC,nO,nBas,nR,T,ERI,rho1s,rho2s,Om1s,Om2s,rho1t,rho2t,Om1t,Om2t) & - !$OMP PRIVATE(p,q,r,s,c,d,cd,k,l,kl) & + !$OMP SHARED(nC,nO,nBas,nR,T,ERI,nOOs,nOOt,nVVs,nVVt,rho1s,rho2s,Om1s,Om2s,rho1t,rho2t,Om1t,Om2t) & + !$OMP PRIVATE(p,q,r,s,cd,kl) & !$OMP DEFAULT(NONE) !$OMP DO do s=nC+1,nBas-nR @@ -154,37 +129,21 @@ subroutine RGT_Tmatrix(isp_T,nBas,nC,nO,nV,nR,nOOs,nVVs,nOOt,nVVt,lambda,ERI,Om1 T(p,q,r,s) = - ERI(p,q,s,r) - cd = 0 - do c=nO+1,nBas-nR - do d=c+1,nBas-nR - cd = cd + 1 - T(p,q,r,s) = T(p,q,r,s) + 0.5d0 * rho1t(p,q,cd) * rho1s(r,s,cd) / Om1t(cd) - end do ! d - end do ! c + do cd=1,nVVs + T(p,q,r,s) = T(p,q,r,s) + 0.5d0 * rho1s(p,q,cd) * rho1s(r,s,cd) / Om1s(cd) + end do ! cd - cd = 0 - do c=nO+1,nBas-nR - do d=c,nBas-nR - cd = cd + 1 - T(p,q,r,s) = T(p,q,r,s) - (1d0 - Kronecker_delta(c,d)) * 0.5d0 * rho1s(p,q,cd) * rho1t(r,s,cd) / Om1s(cd) - end do ! d - end do ! c + do cd=1,nVVt + T(p,q,r,s) = T(p,q,r,s) - 0.5d0 * rho1t(p,q,cd) * rho1t(r,s,cd) / Om1t(cd) + end do ! cd - kl = 0 - do k=nC+1,nO - do l=k+1,nO - kl = kl + 1 - T(p,q,r,s) = T(p,q,r,s) - 0.5d0 * rho2t(p,q,kl) * rho2s(r,s,kl) / Om2t(kl) - enddo ! l - enddo ! k + do kl=1,nOOs + T(p,q,r,s) = T(p,q,r,s) - 0.5d0 * rho2s(p,q,kl) * rho2s(r,s,kl) / Om2s(kl) + enddo ! kl - kl = 0 - do k=nC+1,nO - do l=k,nO - kl = kl + 1 - T(p,q,r,s) = T(p,q,r,s) + (1d0 - Kronecker_delta(k,l)) * 0.5d0 * rho2s(p,q,kl) * rho2t(r,s,kl) / Om2s(kl) - enddo ! l - enddo ! k + do kl=1,nOOt + T(p,q,r,s) = T(p,q,r,s) + 0.5d0 * rho2t(p,q,kl) * rho2t(r,s,kl) / Om2t(kl) + enddo ! kl enddo ! p enddo ! q diff --git a/src/GT/RGTpp_ppBSE.f90 b/src/GT/RGTpp_ppBSE.f90 index 2da003d..787b650 100644 --- a/src/GT/RGTpp_ppBSE.f90 +++ b/src/GT/RGTpp_ppBSE.f90 @@ -66,8 +66,8 @@ subroutine RGTpp_ppBSE(TDA_T,TDA,dBSE,dTDA,singlet,triplet,eta,nBas,nC,nO,nV,nR, allocate(Bpp(nVVs,nOOs),Cpp(nVVs,nVVs),Dpp(nOOs,nOOs)) if(.not.TDA_T) call ppLR_B(isp_T,nBas,nC,nO,nV,nR,nOOs,nVVs,1d0,ERI,Bpp) - call ppLR_C(isp_T,nBas,nC,nO,nV,nR,nVVs,1d0,eGT,ERI,Cpp) - call ppLR_D(isp_T,nBas,nC,nO,nV,nR,nOOs,1d0,eGT,ERI,Dpp) + call ppLR_C(isp_T,nBas,nC,nO,nV,nR,nVVs,1d0,eT,ERI,Cpp) + call ppLR_D(isp_T,nBas,nC,nO,nV,nR,nOOs,1d0,eT,ERI,Dpp) allocate(Om1s(nVVs),X1s(nVVs,nVVs),Y1s(nOOs,nVVs)) allocate(Om2s(nOOs),X2s(nVVs,nOOs),Y2s(nOOs,nOOs)) @@ -88,8 +88,8 @@ subroutine RGTpp_ppBSE(TDA_T,TDA,dBSE,dTDA,singlet,triplet,eta,nBas,nC,nO,nV,nR, allocate(Bpp(nVVt,nOOt),Cpp(nVVt,nVVt),Dpp(nOOt,nOOt)) if(.not.TDA_T) call ppLR_B(isp_T,nBas,nC,nO,nV,nR,nOOt,nVVt,1d0,ERI,Bpp) - call ppLR_C(isp_T,nBas,nC,nO,nV,nR,nVVt,1d0,eGT,ERI,Cpp) - call ppLR_D(isp_T,nBas,nC,nO,nV,nR,nOOt,1d0,eGT,ERI,Dpp) + call ppLR_C(isp_T,nBas,nC,nO,nV,nR,nVVt,1d0,eT,ERI,Cpp) + call ppLR_D(isp_T,nBas,nC,nO,nV,nR,nOOt,1d0,eT,ERI,Dpp) allocate(Om1t(nVVt),X1t(nVVt,nVVt),Y1t(nOOt,nVVt)) allocate(Om2t(nOOt),X2t(nVVt,nOOt),Y2t(nOOt,nOOt)) diff --git a/src/GT/RGTpp_ppBSE_static_kernel_D.f90 b/src/GT/RGTpp_ppBSE_static_kernel_D.f90 index 5e5c41f..5aae119 100644 --- a/src/GT/RGTpp_ppBSE_static_kernel_D.f90 +++ b/src/GT/RGTpp_ppBSE_static_kernel_D.f90 @@ -68,10 +68,10 @@ subroutine RGTpp_ppBSE_static_kernel_D(ispin,eta,nBas,nC,nO,nV,nR,nOO,nVV,lambda num = Taaaa(j,e,k,m)*Tabab(m,i,e,l) + Tabab(j,e,k,m)*Taaaa(m,i,e,l) KD_sta(ij,kl) = KD_sta(ij,kl) + num*dem/(dem**2 + eta**2) - num = Tabab(i,m,k,e)*Tbaab(e,j,m,l) + Tbaab(i,e,k,m)*Tabab(m,j,e,l) + num = Tbaab(i,m,k,e)*Tbaab(e,j,m,l) + Tbaab(i,e,k,m)*Tbaab(m,j,e,l) KD_sta(ij,kl) = KD_sta(ij,kl) - num*dem/(dem**2 + eta**2) - num = Tabab(j,m,k,e)*Tbaab(e,i,m,l) + Tbaab(j,e,k,m)*Tabab(m,i,e,l) + num = Tbaab(j,m,k,e)*Tbaab(e,i,m,l) + Tbaab(j,e,k,m)*Tbaab(m,i,e,l) KD_sta(ij,kl) = KD_sta(ij,kl) - num*dem/(dem**2 + eta**2) end do end do