mirror of
https://github.com/pfloos/quack
synced 2024-12-22 20:34:46 +01:00
T matrix kernel of the ppBSE working in TDA in RHF and GHF
This commit is contained in:
Antoine Marie
parent
127aeabf72
commit
5b5d3376c9
@ -25,7 +25,6 @@ subroutine GGT_Tmatrix(nOrb,nC,nO,nV,nR,nOO,nVV,lambda,ERI,eGF,Om1,rho1,Om2,rho2
|
|||||||
! Local variables
|
! Local variables
|
||||||
|
|
||||||
integer :: p,q,r,s
|
integer :: p,q,r,s
|
||||||
integer :: c,d,k,l
|
|
||||||
integer :: kl,cd
|
integer :: kl,cd
|
||||||
|
|
||||||
! Output variables
|
! 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
|
! Start by building the tensor elements of T
|
||||||
! This is probabbly not a good idea because this tensor is really large
|
! This is probabbly not a good idea because this tensor is really large
|
||||||
!$OMP PARALLEL &
|
!$OMP PARALLEL &
|
||||||
!$OMP SHARED(nC,nO,nOrb,nR,T,ERI,rho1,rho2,Om1,Om2) &
|
!$OMP SHARED(nC,nO,nOrb,nR,nOO,nVV,T,ERI,rho1,rho2,Om1,Om2) &
|
||||||
!$OMP PRIVATE(p,q,r,s,c,d,cd,k,l,kl) &
|
!$OMP PRIVATE(p,q,r,s,cd,kl) &
|
||||||
!$OMP DEFAULT(NONE)
|
!$OMP DEFAULT(NONE)
|
||||||
!$OMP DO
|
!$OMP DO
|
||||||
do s=nC+1,nOrb-nR
|
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)
|
T(p,q,r,s) = ERI(p,q,r,s) - ERI(p,q,s,r)
|
||||||
|
|
||||||
cd = 0
|
do cd=1,nVV
|
||||||
do c=nO+1,nOrb-nR
|
T(p,q,r,s) = T(p,q,r,s) - rho1(p,q,cd)*rho1(r,s,cd)/Om1(cd)
|
||||||
do d=c+1,nOrb-nR
|
end do
|
||||||
cd = cd + 1
|
|
||||||
|
|
||||||
T(p,q,r,s) = T(p,q,r,s) - rho1(p,q,cd)*rho1(r,s,cd)/Om1(cd)
|
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 ! d
|
end do
|
||||||
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
|
|
||||||
|
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
|
|||||||
@ -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))
|
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_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)
|
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(Om1,Om2,rho1,rho2)
|
||||||
! Deallocate the 4-tensor T
|
! Deallocate the 4-tensor T
|
||||||
|
|||||||
@ -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
|
if(isp_T == 1) then
|
||||||
|
|
||||||
!$OMP PARALLEL &
|
!$OMP PARALLEL &
|
||||||
!$OMP SHARED(nC,nO,nBas,nR,T,ERI,rho1t,rho2t,Om1t,Om2t) &
|
!$OMP SHARED(nC,nO,nBas,nR,T,ERI,nOOt,nVVt,rho1t,rho2t,Om1t,Om2t) &
|
||||||
!$OMP PRIVATE(p,q,r,s,c,d,cd,k,l,kl) &
|
!$OMP PRIVATE(p,q,r,s,cd,kl) &
|
||||||
!$OMP DEFAULT(NONE)
|
!$OMP DEFAULT(NONE)
|
||||||
!$OMP DO
|
!$OMP DO
|
||||||
do s=nC+1,nBas-nR
|
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)
|
T(p,q,r,s) = ERI(p,q,r,s) - ERI(p,q,s,r)
|
||||||
|
|
||||||
cd = 0
|
do cd=1,nVVt
|
||||||
do c=nO+1,nBas-nR
|
T(p,q,r,s) = T(p,q,r,s) - rho1t(p,q,cd) * rho1t(r,s,cd) / Om1t(cd)
|
||||||
do d=c+1,nBas-nR
|
end do ! cd
|
||||||
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
|
|
||||||
|
|
||||||
kl = 0
|
do kl=1,nOOt
|
||||||
do k=nC+1,nO
|
T(p,q,r,s) = T(p,q,r,s) + rho2t(p,q,kl) * rho2t(r,s,kl) / Om2t(kl)
|
||||||
do l=k+1,nO
|
enddo ! kl
|
||||||
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
|
|
||||||
|
|
||||||
enddo ! p
|
enddo ! p
|
||||||
enddo ! q
|
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
|
if(isp_T == 2) then
|
||||||
!$OMP PARALLEL &
|
!$OMP PARALLEL &
|
||||||
!$OMP SHARED(nC,nO,nBas,nR,T,ERI,rho1s,rho2s,Om1s,Om2s,rho1t,rho2t,Om1t,Om2t) &
|
!$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,c,d,cd,k,l,kl) &
|
!$OMP PRIVATE(p,q,r,s,cd,kl) &
|
||||||
!$OMP DEFAULT(NONE)
|
!$OMP DEFAULT(NONE)
|
||||||
!$OMP DO
|
!$OMP DO
|
||||||
do s=nC+1,nBas-nR
|
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)
|
T(p,q,r,s) = ERI(p,q,r,s)
|
||||||
|
|
||||||
cd = 0
|
do cd=1,nVVs
|
||||||
do c=nO+1,nBas-nR
|
T(p,q,r,s) = T(p,q,r,s) - 0.5d0 * rho1s(p,q,cd) * rho1s(r,s,cd) / Om1s(cd)
|
||||||
do d=c,nBas-nR
|
end do ! cd
|
||||||
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
|
|
||||||
|
|
||||||
cd = 0
|
do cd=1,nVVt
|
||||||
do c=nO+1,nBas-nR
|
T(p,q,r,s) = T(p,q,r,s) - 0.5d0 * rho1t(p,q,cd) * rho1t(r,s,cd) / Om1t(cd)
|
||||||
do d=c+1,nBas-nR
|
end do ! cd
|
||||||
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
|
|
||||||
|
|
||||||
kl = 0
|
do kl=1,nOOs
|
||||||
do k=nC+1,nO
|
T(p,q,r,s) = T(p,q,r,s) + 0.5d0 * rho2s(p,q,kl) * rho2s(r,s,kl) / Om2s(kl)
|
||||||
do l=k,nO
|
enddo ! kl
|
||||||
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
|
|
||||||
|
|
||||||
kl = 0
|
do kl=1,nOOt
|
||||||
do k=nC+1,nO
|
T(p,q,r,s) = T(p,q,r,s) + 0.5d0 * rho2t(p,q,kl) * rho2t(r,s,kl) / Om2t(kl)
|
||||||
do l=k+1,nO
|
enddo ! kl
|
||||||
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
|
|
||||||
|
|
||||||
enddo ! p
|
enddo ! p
|
||||||
enddo ! q
|
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
|
! Elements baab
|
||||||
|
|
||||||
if(isp_T == 3) then
|
if(isp_T == 3) then
|
||||||
|
|
||||||
!$OMP PARALLEL &
|
!$OMP PARALLEL &
|
||||||
!$OMP SHARED(nC,nO,nBas,nR,T,ERI,rho1s,rho2s,Om1s,Om2s,rho1t,rho2t,Om1t,Om2t) &
|
!$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,c,d,cd,k,l,kl) &
|
!$OMP PRIVATE(p,q,r,s,cd,kl) &
|
||||||
!$OMP DEFAULT(NONE)
|
!$OMP DEFAULT(NONE)
|
||||||
!$OMP DO
|
!$OMP DO
|
||||||
do s=nC+1,nBas-nR
|
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)
|
T(p,q,r,s) = - ERI(p,q,s,r)
|
||||||
|
|
||||||
cd = 0
|
do cd=1,nVVs
|
||||||
do c=nO+1,nBas-nR
|
T(p,q,r,s) = T(p,q,r,s) + 0.5d0 * rho1s(p,q,cd) * rho1s(r,s,cd) / Om1s(cd)
|
||||||
do d=c+1,nBas-nR
|
end do ! cd
|
||||||
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
|
|
||||||
|
|
||||||
cd = 0
|
do cd=1,nVVt
|
||||||
do c=nO+1,nBas-nR
|
T(p,q,r,s) = T(p,q,r,s) - 0.5d0 * rho1t(p,q,cd) * rho1t(r,s,cd) / Om1t(cd)
|
||||||
do d=c,nBas-nR
|
end do ! cd
|
||||||
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
|
|
||||||
|
|
||||||
kl = 0
|
do kl=1,nOOs
|
||||||
do k=nC+1,nO
|
T(p,q,r,s) = T(p,q,r,s) - 0.5d0 * rho2s(p,q,kl) * rho2s(r,s,kl) / Om2s(kl)
|
||||||
do l=k+1,nO
|
enddo ! kl
|
||||||
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
|
|
||||||
|
|
||||||
kl = 0
|
do kl=1,nOOt
|
||||||
do k=nC+1,nO
|
T(p,q,r,s) = T(p,q,r,s) + 0.5d0 * rho2t(p,q,kl) * rho2t(r,s,kl) / Om2t(kl)
|
||||||
do l=k,nO
|
enddo ! kl
|
||||||
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
|
|
||||||
|
|
||||||
enddo ! p
|
enddo ! p
|
||||||
enddo ! q
|
enddo ! q
|
||||||
|
|||||||
@ -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))
|
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)
|
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_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,eGT,ERI,Dpp)
|
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(Om1s(nVVs),X1s(nVVs,nVVs),Y1s(nOOs,nVVs))
|
||||||
allocate(Om2s(nOOs),X2s(nVVs,nOOs),Y2s(nOOs,nOOs))
|
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))
|
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)
|
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_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,eGT,ERI,Dpp)
|
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(Om1t(nVVt),X1t(nVVt,nVVt),Y1t(nOOt,nVVt))
|
||||||
allocate(Om2t(nOOt),X2t(nVVt,nOOt),Y2t(nOOt,nOOt))
|
allocate(Om2t(nOOt),X2t(nVVt,nOOt),Y2t(nOOt,nOOt))
|
||||||
|
|||||||
@ -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)
|
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)
|
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)
|
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)
|
KD_sta(ij,kl) = KD_sta(ij,kl) - num*dem/(dem**2 + eta**2)
|
||||||
end do
|
end do
|
||||||
end do
|
end do
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user