4
1
mirror of https://github.com/pfloos/quack synced 2025-05-06 23:34:42 +02:00

speedup phGLR and G_screened_int

This commit is contained in:
Antoine Marie 2025-04-02 11:35:33 +02:00
parent d6b6e7ce63
commit 99f26d72bf
4 changed files with 98 additions and 100 deletions

View File

@ -38,51 +38,51 @@ subroutine phGLR_A(dRPA,nOrb,nC,nO,nV,nR,nS,lambda,e,ERI,Aph)
if(dRPA) delta_dRPA = 1d0
! Build A matrix for spin orbitals
! nn = nOrb - nR - nO
! ct1 = lambda
! ct2 = - (1d0 - delta_dRPA) * lambda
nn = nOrb - nR - nO
ct1 = lambda
ct2 = - (1d0 - delta_dRPA) * lambda
! !$OMP PARALLEL DEFAULT(NONE) &
! !$OMP PRIVATE (i, a, j, b, i_eq_j, ia, jb0, jb) &
! !$OMP SHARED (nC, nO, nR, nOrb, nn, ct1, ct2, e, ERI, Aph)
! !$OMP DO COLLAPSE(2)
! do i = nC+1, nO
! do a = nO+1, nOrb-nR
! ia = a - nO + (i - nC - 1) * nn
!$OMP PARALLEL DEFAULT(NONE) &
!$OMP PRIVATE (i, a, j, b, i_eq_j, ia, jb0, jb) &
!$OMP SHARED (nC, nO, nR, nOrb, nn, ct1, ct2, e, ERI, Aph)
!$OMP DO COLLAPSE(2)
do i = nC+1, nO
do a = nO+1, nOrb-nR
ia = a - nO + (i - nC - 1) * nn
! do j = nC+1, nO
! i_eq_j = i == j
! jb0 = (j - nC - 1) * nn - nO
! do b = nO+1, nOrb-nR
! jb = b + jb0
do j = nC+1, nO
i_eq_j = i == j
jb0 = (j - nC - 1) * nn - nO
do b = nO+1, nOrb-nR
jb = b + jb0
! Aph(ia,jb) = ct1 * ERI(b,i,j,a) + ct2 * ERI(b,j,a,i)
! if(i_eq_j) then
! if(a == b) Aph(ia,jb) = Aph(ia,jb) + e(a) - e(i)
! endif
Aph(ia,jb) = ct1 * ERI(b,i,j,a) + ct2 * ERI(b,j,a,i)
if(i_eq_j) then
if(a == b) Aph(ia,jb) = Aph(ia,jb) + e(a) - e(i)
endif
! enddo
! enddo
enddo
enddo
! enddo
! enddo
! !$OMP END DO
! !$OMP END PARALLEL
ia = 0
do i=nC+1,nO
do a=nO+1,nOrb-nR
ia = ia + 1
jb = 0
do j=nC+1,nO
do b=nO+1,nOrb-nR
jb = jb + 1
enddo
enddo
!$OMP END DO
!$OMP END PARALLEL
! ia = 0
! do i=nC+1,nO
! do a=nO+1,nOrb-nR
! ia = ia + 1
! jb = 0
! do j=nC+1,nO
! do b=nO+1,nOrb-nR
! jb = jb + 1
Aph(ia,jb) = (e(a) - e(i))*Kronecker_delta(i,j)*Kronecker_delta(a,b) &
+ lambda*ERI(i,b,a,j) - (1d0 - delta_dRPA)*lambda*ERI(i,b,j,a)
! Aph(ia,jb) = (e(a) - e(i))*Kronecker_delta(i,j)*Kronecker_delta(a,b) &
! + lambda*ERI(i,b,a,j) - (1d0 - delta_dRPA)*lambda*ERI(i,b,j,a)
end do
end do
end do
end do
! end do
! end do
! end do
! end do
end subroutine

View File

@ -35,46 +35,46 @@ subroutine phGLR_B(dRPA,nOrb,nC,nO,nV,nR,nS,lambda,ERI,Bph)
if(dRPA) delta_dRPA = 1d0
! Build B matrix for spin orbitals
! nn = nOrb - nR - nO
! ct1 = lambda
! ct2 = - (1d0 - delta_dRPA) * lambda
nn = nOrb - nR - nO
ct1 = lambda
ct2 = - (1d0 - delta_dRPA) * lambda
! !$OMP PARALLEL DEFAULT(NONE) &
! !$OMP PRIVATE (i, a, j, b, ia, jb0, jb) &
! !$OMP SHARED (nC, nO, nR, nOrb, nn, ct1, ct2, ERI, Bph)
! !$OMP DO COLLAPSE(2)
! do i = nC+1, nO
! do a = nO+1, nOrb-nR
! ia = a - nO + (i - nC - 1) * nn
!$OMP PARALLEL DEFAULT(NONE) &
!$OMP PRIVATE (i, a, j, b, ia, jb0, jb) &
!$OMP SHARED (nC, nO, nR, nOrb, nn, ct1, ct2, ERI, Bph)
!$OMP DO COLLAPSE(2)
do i = nC+1, nO
do a = nO+1, nOrb-nR
ia = a - nO + (i - nC - 1) * nn
! do j = nC+1, nO
! jb0 = (j - nC - 1) * nn - nO
! do b = nO+1, nOrb-nR
! jb = b + jb0
do j = nC+1, nO
jb0 = (j - nC - 1) * nn - nO
do b = nO+1, nOrb-nR
jb = b + jb0
! Bph(ia,jb) = ct1 * ERI(i,j,a,b) + ct2 * ERI(i,j,b,a)
Bph(ia,jb) = ct1 * ERI(i,j,a,b) + ct2 * ERI(i,j,b,a)
! enddo
! enddo
enddo
enddo
! enddo
! enddo
! !$OMP END DO
! !$OMP END PARALLEL
ia = 0
do i=nC+1,nO
do a=nO+1,nOrb-nR
ia = ia + 1
jb = 0
do j=nC+1,nO
do b=nO+1,nOrb-nR
jb = jb + 1
enddo
enddo
!$OMP END DO
!$OMP END PARALLEL
! ia = 0
! do i=nC+1,nO
! do a=nO+1,nOrb-nR
! ia = ia + 1
! jb = 0
! do j=nC+1,nO
! do b=nO+1,nOrb-nR
! jb = jb + 1
Bph(ia,jb) = lambda*ERI(i,j,a,b) - (1d0 - delta_dRPA)*lambda*ERI(i,j,b,a)
! Bph(ia,jb) = lambda*ERI(i,j,a,b) - (1d0 - delta_dRPA)*lambda*ERI(i,j,b,a)
end do
end do
end do
end do
! end do
! end do
! end do
! end do
end subroutine

View File

@ -82,7 +82,7 @@ subroutine GParquet(TDAeh,TDApp,linearize,eta,ENuc,max_it_1b,conv_1b,max_it_2b,c
! DIIS parameters
max_diis = 2
max_diis = 1
n_diis = 0
rcond = 1d0

View File

@ -18,11 +18,10 @@ subroutine G_eh_screened_integral(nOrb,nC,nO,nR,nS,ERI,eh_Phi,pp_Phi,XpY,XmY,rho
double precision,intent(out) :: rho(nOrb,nOrb,nS)
rho(:,:,:) = 0d0
! !$OMP PARALLEL &
! !$OMP SHARED(nC,nOrb,nR,nO,nS,rho,ERI,XpY,eh_sing_Gam) &
! !$OMP PRIVATE(q,p,jb,ia) &
! !$OMP DEFAULT(NONE)
! !$OMP DO
!$OMP PARALLEL DEFAULT(NONE) &
!$OMP PRIVATE(q,p,j,b,jb,ia,X,Y) &
!$OMP SHARED(nC,nOrb,nR,nO,nS,rho,ERI,XpY,XmY,eh_Phi,pp_Phi)
!$OMP DO
do q=nC+1,nOrb-nR
do p=nC+1,nOrb-nR
@ -37,11 +36,10 @@ subroutine G_eh_screened_integral(nOrb,nC,nO,nR,nS,ERI,eh_Phi,pp_Phi,XpY,XmY,rho
Y = 0.5d0*(XpY(ia,jb) - XmY(ia,jb))
rho(p,q,ia) = rho(p,q,ia) &
+ (ERI(q,j,p,b) - ERI(q,j,b,p) &
- 0d0*eh_Phi(q,j,b,p) + 0d0*pp_Phi(q,j,p,b)) * X &
+ (ERI(q,b,p,j) - ERI(q,b,j,p) &
- 0d0*eh_Phi(q,b,j,p) + 0d0*pp_Phi(q,b,p,j)) * Y
+ (ERI(q,j,p,b) - ERI(q,j,b,p)) * X !&
!- (eh_Phi(q,j,b,p) + pp_Phi(q,j,p,b)) * X &
!+ (ERI(q,b,p,j) - ERI(q,b,j,p)) * Y &
!- (eh_Phi(q,b,j,p) + pp_Phi(q,b,p,j)) * Y
end do
@ -51,8 +49,8 @@ subroutine G_eh_screened_integral(nOrb,nC,nO,nR,nS,ERI,eh_Phi,pp_Phi,XpY,XmY,rho
end do
end do
! !$OMP END DO
! !$OMP END PARALLEL
!$OMP END DO
!$OMP END PARALLEL
end subroutine
@ -93,10 +91,10 @@ subroutine G_pp_screened_integral(nOrb,nC,nO,nR,nOO,nVV,ERI,eh_Phi,X1,Y1,rho1,X2
rho1(:,:,:) = 0d0
rho2(:,:,:) = 0d0
! !$OMP PARALLEL DEFAULT(NONE) &
! !$OMP PRIVATE(p, q, a, b, ab, c, d, cd, i, j, ij, k, l, kl) &
! !$OMP SHARED(nC, nOrb, nR, nO, rho1, rho2, ERI, pp_sing_Gam, X1, Y1, X2, Y2)
! !$OMP DO COLLAPSE(2)
!$OMP PARALLEL DEFAULT(NONE) &
!$OMP PRIVATE(p, q, a, b, ab, c, d, cd, i, j, ij, k, l, kl) &
!$OMP SHARED(nC, nOrb, nR, nO, rho1, rho2, ERI, eh_Phi, X1, Y1, X2, Y2)
!$OMP DO COLLAPSE(2)
do q=nC+1,nOrb-nR
do p=nC+1,nOrb-nR
@ -110,8 +108,8 @@ subroutine G_pp_screened_integral(nOrb,nC,nO,nR,nOO,nVV,ERI,eh_Phi,X1,Y1,rho1,X2
do d=c+1,nOrb-nR
cd = cd + 1
rho1(p,q,ab) = rho1(p,q,ab) + ( ERI(p,q,c,d) - ERI(p,q,d,c) &
+ 0d0*eh_Phi(p,q,c,d) - 0d0*eh_Phi(p,q,d,c) ) * X1(cd,ab)
rho1(p,q,ab) = rho1(p,q,ab) + ( ERI(p,q,c,d) - ERI(p,q,d,c)) * X1(cd,ab)! &
!+ (eh_Phi(p,q,c,d) - eh_Phi(p,q,d,c) ) * X1(cd,ab)
end do
end do
@ -121,8 +119,8 @@ subroutine G_pp_screened_integral(nOrb,nC,nO,nR,nOO,nVV,ERI,eh_Phi,X1,Y1,rho1,X2
do l=k+1,nO
kl = kl + 1
rho1(p,q,ab) = rho1(p,q,ab) + ( ERI(p,q,k,l) - ERI(p,q,l,k) &
+ 0d0*eh_Phi(p,q,k,l) - 0d0*eh_Phi(p,q,l,k) ) * Y1(kl,ab)
rho1(p,q,ab) = rho1(p,q,ab) + ( ERI(p,q,k,l) - ERI(p,q,l,k))* Y1(kl,ab) !&
!+ (eh_Phi(p,q,k,l) - eh_Phi(p,q,l,k) ) * Y1(kl,ab)
end do
end do
@ -140,8 +138,8 @@ subroutine G_pp_screened_integral(nOrb,nC,nO,nR,nOO,nVV,ERI,eh_Phi,X1,Y1,rho1,X2
do d=c+1,nOrb-nR
cd = cd + 1
rho2(p,q,ij) = rho2(p,q,ij) + ( ERI(p,q,c,d) - ERI(p,q,d,c) &
+ 0d0*eh_Phi(p,q,c,d) - 0d0*eh_Phi(p,q,d,c) ) * X2(cd,ij)
rho2(p,q,ij) = rho2(p,q,ij) + ( ERI(p,q,c,d) - ERI(p,q,d,c)) * X2(cd,ij) !&
!+ ( eh_Phi(p,q,c,d) - eh_Phi(p,q,d,c) ) * X2(cd,ij)
end do
end do
@ -151,8 +149,8 @@ subroutine G_pp_screened_integral(nOrb,nC,nO,nR,nOO,nVV,ERI,eh_Phi,X1,Y1,rho1,X2
do l=k+1,nO
kl = kl + 1
rho2(p,q,ij) = rho2(p,q,ij) + ( ERI(p,q,k,l) - ERI(p,q,l,k) &
+ 0d0*eh_Phi(p,q,k,l) - 0d0*eh_Phi(p,q,l,k) ) * Y2(kl,ij)
rho2(p,q,ij) = rho2(p,q,ij) + ( ERI(p,q,k,l) - ERI(p,q,l,k)) * Y2(kl,ij) !&
!+ ( eh_Phi(p,q,k,l) - eh_Phi(p,q,l,k) ) * Y2(kl,ij)
end do
end do
@ -161,7 +159,7 @@ subroutine G_pp_screened_integral(nOrb,nC,nO,nR,nOO,nVV,ERI,eh_Phi,X1,Y1,rho1,X2
end do
end do
! !$OMP END DO
! !$OMP END PARALLEL
!$OMP END DO
!$OMP END PARALLEL
end subroutine