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:
parent
d6b6e7ce63
commit
99f26d72bf
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
||||
|
@ -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
|
||||
|
Loading…
x
Reference in New Issue
Block a user