mirror of
https://github.com/pfloos/quack
synced 2024-09-27 12:00:50 +02:00
ebugging GF2 ppBSE spin adaptation
This commit is contained in:
Pierre-Francois Loos
parent
c9a269cbb6
commit
cd25d07f6f
@ -68,6 +68,7 @@ subroutine RGF2_ppBSE_static_kernel_B(ispin,eta,nBas,nC,nO,nV,nR,nOO,nVV,lambda,
|
|||||||
end do
|
end do
|
||||||
|
|
||||||
KB_sta(ab,ij) = 2d0*lambda*KB_sta(ab,ij)/sqrt((1d0 + Kronecker_delta(a,b))*(1d0 + Kronecker_delta(i,j)))
|
KB_sta(ab,ij) = 2d0*lambda*KB_sta(ab,ij)/sqrt((1d0 + Kronecker_delta(a,b))*(1d0 + Kronecker_delta(i,j)))
|
||||||
|
|
||||||
end do
|
end do
|
||||||
end do
|
end do
|
||||||
|
|
||||||
|
|||||||
@ -37,22 +37,22 @@ subroutine RGF2_ppBSE_static_kernel_C(ispin,eta,nBas,nC,nO,nV,nR,nVV,lambda,ERI,
|
|||||||
! Initialization
|
! Initialization
|
||||||
|
|
||||||
KC_sta(:,:) = 0d0
|
KC_sta(:,:) = 0d0
|
||||||
eta2 = eta * eta
|
! eta2 = eta * eta
|
||||||
|
|
||||||
allocate(Om_tmp(nBas,nBas))
|
! allocate(Om_tmp(nBas,nBas))
|
||||||
Om_tmp(:,:) = 0d0
|
! Om_tmp(:,:) = 0d0
|
||||||
|
|
||||||
! Compute the energy differences and denominator once and store them in a temporary array
|
! ! Compute the energy differences and denominator once and store them in a temporary array
|
||||||
!$OMP PARALLEL DEFAULT(NONE) PRIVATE(m,e,dem) SHARED(nC,nO,nBas,nR, eta2, eGF, Om_tmp)
|
! !$OMP PARALLEL DEFAULT(NONE) PRIVATE(m,e,dem) SHARED(nC,nO,nBas,nR, eta2, eGF, Om_tmp)
|
||||||
!$OMP DO
|
! !$OMP DO
|
||||||
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)
|
||||||
Om_tmp(m,e) = dem / (dem*dem + eta2)
|
! Om_tmp(m,e) = dem / (dem*dem + eta2)
|
||||||
enddo
|
! enddo
|
||||||
enddo
|
! enddo
|
||||||
!$OMP END DO
|
! !$OMP END DO
|
||||||
!$OMP END PARALLEL
|
! !$OMP END PARALLEL
|
||||||
|
|
||||||
! Second-order correlation kernel for the block C of the singlet manifold
|
! Second-order correlation kernel for the block C of the singlet manifold
|
||||||
|
|
||||||
@ -60,93 +60,94 @@ subroutine RGF2_ppBSE_static_kernel_C(ispin,eta,nBas,nC,nO,nV,nR,nVV,lambda,ERI,
|
|||||||
! OpenMP implementation
|
! OpenMP implementation
|
||||||
! --- --- ---
|
! --- --- ---
|
||||||
|
|
||||||
if(ispin == 1) then
|
! if(ispin == 1) then
|
||||||
|
|
||||||
a0 = nBas - nR - nO
|
! a0 = nBas - nR - nO
|
||||||
!$OMP PARALLEL DEFAULT(NONE) &
|
! !$OMP PARALLEL DEFAULT(NONE) &
|
||||||
!$OMP PRIVATE(a, b, aa, ab, c, d, cd, m, e, num) &
|
! !$OMP PRIVATE(a, b, aa, ab, c, d, cd, m, e, num) &
|
||||||
!$OMP SHARED(nO, nBas, nR, nC, a0, ERI, Om_tmp, KC_sta, lambda)
|
! !$OMP SHARED(nO, nBas, nR, nC, a0, ERI, Om_tmp, KC_sta, lambda)
|
||||||
!$OMP DO
|
! !$OMP DO
|
||||||
do a=nO+1,nBas-nR
|
! do a=nO+1,nBas-nR
|
||||||
aa = a0 * (a - nO - 1) - (a - nO - 1) * (a - nO) / 2 - nO
|
! aa = a0 * (a - nO - 1) - (a - nO - 1) * (a - nO) / 2 - nO
|
||||||
do b=a,nBas-nR
|
! do b=a,nBas-nR
|
||||||
ab = aa + b
|
! ab = aa + b
|
||||||
|
|
||||||
cd = 0
|
! cd = 0
|
||||||
do c=nO+1,nBas-nR
|
! do c=nO+1,nBas-nR
|
||||||
do d=c,nBas-nR
|
! do d=c,nBas-nR
|
||||||
cd = cd + 1
|
! cd = cd + 1
|
||||||
|
!
|
||||||
do m=nC+1,nO
|
! do m=nC+1,nO
|
||||||
do e=nO+1,nBas-nR
|
! do e=nO+1,nBas-nR
|
||||||
|
!
|
||||||
num = 2d0*ERI(a,m,c,e)*ERI(b,e,d,m) - ERI(a,m,c,e)*ERI(b,e,m,d) &
|
! 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)
|
! - 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) + num * Om_tmp(m,e)
|
! KC_sta(ab,cd) = KC_sta(ab,cd) + num * Om_tmp(m,e)
|
||||||
|
!
|
||||||
num = 2d0*ERI(b,m,c,e)*ERI(a,e,d,m) - ERI(b,m,c,e)*ERI(a,e,m,d) &
|
! 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)
|
! - 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) + num * Om_tmp(m,e)
|
! KC_sta(ab,cd) = KC_sta(ab,cd) + num * Om_tmp(m,e)
|
||||||
|
!
|
||||||
end do
|
! end do
|
||||||
end do
|
! end do
|
||||||
|
|
||||||
KC_sta(ab,cd) = 2d0*lambda*KC_sta(ab,cd)/sqrt((1d0 + Kronecker_delta(a,b))*(1d0 + Kronecker_delta(c,d)))
|
! KC_sta(ab,cd) = 2d0*lambda*KC_sta(ab,cd)/sqrt((1d0 + Kronecker_delta(a,b))*(1d0 + Kronecker_delta(c,d)))
|
||||||
|
!
|
||||||
end do
|
! end do
|
||||||
end do
|
! end do
|
||||||
|
|
||||||
end do
|
! end do
|
||||||
end do
|
! end do
|
||||||
!$OMP END DO
|
! !$OMP END DO
|
||||||
!$OMP END PARALLEL
|
! !$OMP END PARALLEL
|
||||||
|
|
||||||
end if
|
! end if
|
||||||
|
|
||||||
! --- --- ---
|
! --- --- ---
|
||||||
! Naive implementation
|
! Naive implementation
|
||||||
! --- --- ---
|
! --- --- ---
|
||||||
! if(ispin == 1) then
|
|
||||||
|
if(ispin == 1) then
|
||||||
|
|
||||||
|
ab = 0
|
||||||
|
do a=nO+1,nBas-nR
|
||||||
|
do b=a,nBas-nR
|
||||||
|
ab = ab + 1
|
||||||
|
|
||||||
|
cd = 0
|
||||||
|
do c=nO+1,nBas-nR
|
||||||
|
do d=c,nBas-nR
|
||||||
|
cd = cd + 1
|
||||||
|
|
||||||
|
do m=nC+1,nO
|
||||||
|
do e=nO+1,nBas-nR
|
||||||
|
|
||||||
! ab = 0
|
dem = eGF(m) - eGF(e)
|
||||||
! do a=nO+1,nBas-nR
|
num = 2d0*ERI(a,m,c,e)*ERI(b,e,d,m) - ERI(a,m,c,e)*ERI(b,e,m,d) &
|
||||||
! do b=a,nBas-nR
|
- ERI(a,m,e,c)*ERI(b,e,d,m) - ERI(a,m,e,c)*ERI(b,e,m,d)
|
||||||
! ab = ab + 1
|
|
||||||
|
KC_sta(ab,cd) = KC_sta(ab,cd) + num*dem/(dem**2 + eta**2)
|
||||||
! cd = 0
|
|
||||||
! do c=nO+1,nBas-nR
|
dem = eGF(m) - eGF(e)
|
||||||
! do d=c,nBas-nR
|
num = 2d0*ERI(b,m,c,e)*ERI(a,e,d,m) - ERI(b,m,c,e)*ERI(a,e,m,d) &
|
||||||
! cd = cd + 1
|
- ERI(b,m,e,c)*ERI(a,e,d,m) - ERI(b,m,e,c)*ERI(a,e,m,d)
|
||||||
|
|
||||||
! do m=nC+1,nO
|
KC_sta(ab,cd) = KC_sta(ab,cd) + num*dem/(dem**2 + eta**2)
|
||||||
! do e=nO+1,nBas-nR
|
|
||||||
|
end do
|
||||||
! dem = eGF(m) - eGF(e)
|
end do
|
||||||
! 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) = 2d0*lambda*KC_sta(ab,cd)/sqrt((1d0 + Kronecker_delta(a,b))*(1d0 + Kronecker_delta(c,d)))
|
||||||
|
|
||||||
! KC_sta(ab,cd) = KC_sta(ab,cd) + num*dem/(dem**2 + eta**2)
|
end do
|
||||||
|
end do
|
||||||
! 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) &
|
end do
|
||||||
! - ERI(b,m,e,c)*ERI(a,e,d,m) - ERI(b,m,e,c)*ERI(a,e,m,d)
|
end do
|
||||||
|
|
||||||
! KC_sta(ab,cd) = KC_sta(ab,cd) + num*dem/(dem**2 + eta**2)
|
end if
|
||||||
|
|
||||||
! end do
|
|
||||||
! end do
|
|
||||||
|
|
||||||
! KC_sta(ab,cd) = 2d0*lambda*KC_sta(ab,cd)/sqrt((1d0 + Kronecker_delta(a,b))*(1d0 + Kronecker_delta(c,d)))
|
|
||||||
|
|
||||||
! end do
|
|
||||||
! end do
|
|
||||||
|
|
||||||
! end do
|
|
||||||
! end do
|
|
||||||
|
|
||||||
! end if
|
|
||||||
|
|
||||||
! Second-order correlation kernel for the block C of the triplet manifold
|
! Second-order correlation kernel for the block C of the triplet manifold
|
||||||
|
|
||||||
@ -154,47 +155,89 @@ subroutine RGF2_ppBSE_static_kernel_C(ispin,eta,nBas,nC,nO,nV,nR,nVV,lambda,ERI,
|
|||||||
! OpenMP implementation
|
! OpenMP implementation
|
||||||
! --- --- ---
|
! --- --- ---
|
||||||
|
|
||||||
if(ispin == 2) then
|
! if(ispin == 2) then
|
||||||
|
|
||||||
a0 = nBas - nR - nO - 1
|
! a0 = nBas - nR - nO - 1
|
||||||
!$OMP PARALLEL DEFAULT(NONE) &
|
! !$OMP PARALLEL DEFAULT(NONE) &
|
||||||
!$OMP PRIVATE(a, b, aa, ab, c, d, cd, m, e, num) &
|
! !$OMP PRIVATE(a, b, aa, ab, c, d, cd, m, e, num) &
|
||||||
!$OMP SHARED(nO, nBas, nR, nC, a0, ERI, Om_tmp, KC_sta)
|
! !$OMP SHARED(nO, nBas, nR, nC, a0, ERI, Om_tmp, KC_sta)
|
||||||
!$OMP DO
|
! !$OMP DO
|
||||||
do a = nO+1, nBas-nR
|
! do a = nO+1, nBas-nR
|
||||||
aa = a0 * (a - nO - 1) - (a - nO - 1) * (a - nO) / 2 - nO - 1
|
! aa = a0 * (a - nO - 1) - (a - nO - 1) * (a - nO) / 2 - nO - 1
|
||||||
do b = a+1, nBas-nR
|
! do b = a+1, nBas-nR
|
||||||
ab = aa + b
|
! ab = aa + b
|
||||||
|
|
||||||
cd = 0
|
! cd = 0
|
||||||
do c=nO+1,nBas-nR
|
! do c=nO+1,nBas-nR
|
||||||
do d=c+1,nBas-nR
|
! do d=c+1,nBas-nR
|
||||||
cd = cd + 1
|
! cd = cd + 1
|
||||||
|
!
|
||||||
|
! do m=nC+1,nO
|
||||||
|
! do e=nO+1,nBas-nR
|
||||||
|
!
|
||||||
|
! 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) + 2d0 * num * Om_tmp(m,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) + ERI(b,m,e,c)*ERI(a,e,m,d)
|
||||||
|
|
||||||
|
! KC_sta(ab,cd) = KC_sta(ab,cd) - 2d0 * num * Om_tmp(m,e)
|
||||||
|
!
|
||||||
|
! end do
|
||||||
|
! end do
|
||||||
|
|
||||||
|
! end do
|
||||||
|
! end do
|
||||||
|
|
||||||
|
! end do
|
||||||
|
! end do
|
||||||
|
! !$OMP END DO
|
||||||
|
! !$OMP END PARALLEL
|
||||||
|
|
||||||
|
! end if
|
||||||
|
|
||||||
|
! --- --- ---
|
||||||
|
! Naive implementation
|
||||||
|
! --- --- ---
|
||||||
|
|
||||||
|
if(ispin == 2) then
|
||||||
|
|
||||||
|
ab = 0
|
||||||
|
do a=nO+1,nBas-nR
|
||||||
|
do b=a+1,nBas-nR
|
||||||
|
ab = ab + 1
|
||||||
|
|
||||||
|
cd = 0
|
||||||
|
do c=nO+1,nBas-nR
|
||||||
|
do d=c+1,nBas-nR
|
||||||
|
cd = cd + 1
|
||||||
|
|
||||||
|
do m=nC+1,nO
|
||||||
|
do e=nO+1,nBas-nR
|
||||||
|
|
||||||
do m=nC+1,nO
|
dem = eGF(m) - eGF(e)
|
||||||
do e=nO+1,nBas-nR
|
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)
|
||||||
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) + 2d0 * num * Om_tmp(m,e)
|
KC_sta(ab,cd) = KC_sta(ab,cd) + 2d0*num*dem/(dem**2 + eta**2)
|
||||||
|
|
||||||
num = 2d0*ERI(b,m,c,e)*ERI(a,e,d,m) - ERI(b,m,c,e)*ERI(a,e,m,d) &
|
dem = eGF(m) - eGF(e)
|
||||||
- ERI(b,m,e,c)*ERI(a,e,d,m) + ERI(b,m,e,c)*ERI(a,e,m,d)
|
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) - 2d0 * num * Om_tmp(m,e)
|
KC_sta(ab,cd) = KC_sta(ab,cd) - 2d0*num*dem/(dem**2 + eta**2)
|
||||||
|
|
||||||
end do
|
end do
|
||||||
end do
|
end do
|
||||||
|
|
||||||
end do
|
end do
|
||||||
end do
|
end do
|
||||||
|
|
||||||
end do
|
|
||||||
end do
|
|
||||||
!$OMP END DO
|
|
||||||
!$OMP END PARALLEL
|
|
||||||
|
|
||||||
|
end do
|
||||||
|
end do
|
||||||
|
|
||||||
end if
|
end if
|
||||||
|
|
||||||
if(ispin == 4) then
|
if(ispin == 4) then
|
||||||
@ -237,48 +280,8 @@ subroutine RGF2_ppBSE_static_kernel_C(ispin,eta,nBas,nC,nO,nV,nR,nVV,lambda,ERI,
|
|||||||
|
|
||||||
! Second-order correlation kernel for the block C of the spinorbital manifold
|
! Second-order correlation kernel for the block C of the spinorbital manifold
|
||||||
|
|
||||||
! --- --- ---
|
|
||||||
! Naive implementation
|
|
||||||
! --- --- ---
|
|
||||||
! if(ispin == 2) then
|
|
||||||
|
|
||||||
! ab = 0
|
|
||||||
! do a=nO+1,nBas-nR
|
|
||||||
! do b=a+1,nBas-nR
|
|
||||||
! ab = ab + 1
|
|
||||||
|
|
||||||
! cd = 0
|
|
||||||
! do c=nO+1,nBas-nR
|
|
||||||
! do d=c+1,nBas-nR
|
|
||||||
! cd = cd + 1
|
|
||||||
|
|
||||||
! do m=nC+1,nO
|
|
||||||
! 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) + ERI(a,m,e,c)*ERI(b,e,m,d)
|
|
||||||
|
|
||||||
! 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) + ERI(b,m,e,c)*ERI(a,e,m,d)
|
|
||||||
|
|
||||||
! KC_sta(ab,cd) = KC_sta(ab,cd) - 2d0*num*dem/(dem**2 + eta**2)
|
|
||||||
|
|
||||||
! end do
|
|
||||||
! end do
|
|
||||||
|
|
||||||
! end do
|
|
||||||
! end do
|
|
||||||
|
|
||||||
! end do
|
|
||||||
! end do
|
|
||||||
|
|
||||||
! end if
|
|
||||||
|
|
||||||
|
|
||||||
deallocate(Om_tmp)
|
! deallocate(Om_tmp)
|
||||||
|
|
||||||
end subroutine
|
end subroutine
|
||||||
|
|||||||
@ -52,13 +52,13 @@ subroutine RGF2_ppBSE_static_kernel_D(ispin,eta,nBas,nC,nO,nV,nR,nOO,lambda,ERI,
|
|||||||
do m=nC+1,nO
|
do m=nC+1,nO
|
||||||
do e=nO+1,nBas-nR
|
do e=nO+1,nBas-nR
|
||||||
|
|
||||||
dem = - eGF(e) + eGF(m)
|
dem = eGF(m) - eGF(e)
|
||||||
num = 2d0*ERI(i,e,k,m)*ERI(j,m,l,e) - ERI(i,e,k,m)*ERI(j,m,e,l) &
|
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)
|
- 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) + 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)
|
dem = eGF(m) - eGF(e)
|
||||||
num = 2d0*ERI(j,e,k,m)*ERI(i,m,l,e) - ERI(j,e,k,m)*ERI(i,m,e,l) &
|
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)
|
- ERI(j,e,m,k)*ERI(i,m,l,e) - ERI(j,e,m,k)*ERI(i,m,e,l)
|
||||||
|
|
||||||
@ -68,6 +68,7 @@ subroutine RGF2_ppBSE_static_kernel_D(ispin,eta,nBas,nC,nO,nV,nR,nOO,lambda,ERI,
|
|||||||
end do
|
end do
|
||||||
|
|
||||||
KD_sta(ij,kl) = 2d0*lambda*KD_sta(ij,kl)/sqrt((1d0 + Kronecker_delta(i,j))*(1d0 + Kronecker_delta(k,l)))
|
KD_sta(ij,kl) = 2d0*lambda*KD_sta(ij,kl)/sqrt((1d0 + Kronecker_delta(i,j))*(1d0 + Kronecker_delta(k,l)))
|
||||||
|
|
||||||
end do
|
end do
|
||||||
end do
|
end do
|
||||||
|
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user