From 6cfe4a5dece390784ddcc1b6c2f70afe7bac7671 Mon Sep 17 00:00:00 2001 From: AbdAmmar Date: Sun, 1 Dec 2024 11:22:29 +0100 Subject: [PATCH] OMP for phLR --- src/LR/phLR_A.f90 | 116 ++++++++++++++++++++++++++++++++++------------ src/LR/phLR_B.f90 | 107 ++++++++++++++++++++++++++++++------------ 2 files changed, 163 insertions(+), 60 deletions(-) diff --git a/src/LR/phLR_A.f90 b/src/LR/phLR_A.f90 index 2826fdd..4b44aa7 100644 --- a/src/LR/phLR_A.f90 +++ b/src/LR/phLR_A.f90 @@ -25,6 +25,9 @@ subroutine phLR_A(ispin,dRPA,nBas,nC,nO,nV,nR,nS,lambda,e,ERI,Aph) double precision,external :: Kronecker_delta integer :: i,j,a,b,ia,jb + integer :: nn,jb0 + logical :: i_eq_j + double precision :: ct1,ct2 ! Output variables @@ -39,22 +42,49 @@ subroutine phLR_A(ispin,dRPA,nBas,nC,nO,nV,nR,nS,lambda,e,ERI,Aph) if(ispin == 1) then - ia = 0 - do i=nC+1,nO - do a=nO+1,nBas-nR - ia = ia + 1 - jb = 0 - do j=nC+1,nO - do b=nO+1,nBas-nR - jb = jb + 1 - - Aph(ia,jb) = (e(a) - e(i))*Kronecker_delta(i,j)*Kronecker_delta(a,b) & - + 2d0*lambda*ERI(i,b,a,j) - (1d0 - delta_dRPA)*lambda*ERI(i,b,j,a) + nn = nBas - nR - nO + ct1 = 2d0 * 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, nBas, nn, ct1, ct2, e, ERI, Aph) + !$OMP DO COLLAPSE(2) + do i = nC+1, nO + do a = nO+1, nBas-nR + ia = a - nO + (i - nC - 1) * nn - end do - end do - end do - end do + do j = nC+1, nO + i_eq_j = i == j + jb0 = (j - nC - 1) * nn - nO + + do b = nO+1, nBas-nR + jb = b + jb0 + + Aph(ia,jb) = ct1 * ERI(i,b,a,j) + ct2 * ERI(i,b,j,a) + if(i_eq_j) then + if(a == b) Aph(ia,jb) = Aph(ia,jb) + e(a) - e(i) + endif + enddo + enddo + enddo + enddo + !$OMP END DO + !$OMP END PARALLEL + + !ia = 0 + !do i=nC+1,nO + ! do a=nO+1,nBas-nR + ! ia = ia + 1 + ! jb = 0 + ! do j=nC+1,nO + ! do b=nO+1,nBas-nR + ! jb = jb + 1 + ! Aph(ia,jb) = (e(a) - e(i))*Kronecker_delta(i,j)*Kronecker_delta(a,b) & + ! + 2d0*lambda*ERI(i,b,a,j) - (1d0 - delta_dRPA)*lambda*ERI(i,b,j,a) + ! end do + ! end do + ! end do + !end do end if @@ -62,22 +92,48 @@ subroutine phLR_A(ispin,dRPA,nBas,nC,nO,nV,nR,nS,lambda,e,ERI,Aph) if(ispin == 2) then - ia = 0 - do i=nC+1,nO - do a=nO+1,nBas-nR - ia = ia + 1 - jb = 0 - do j=nC+1,nO - do b=nO+1,nBas-nR - jb = jb + 1 - - Aph(ia,jb) = (e(a) - e(i))*Kronecker_delta(i,j)*Kronecker_delta(a,b) & - - (1d0 - delta_dRPA)*lambda*ERI(i,b,j,a) + nn = nBas - nR - nO + 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, nBas, nn, ct2, e, ERI, Aph) + !$OMP DO COLLAPSE(2) + do i = nC+1, nO + do a = nO+1, nBas-nR + ia = a - nO + (i - nC - 1) * nn - end do - end do - end do - end do + do j = nC+1, nO + i_eq_j = i == j + jb0 = (j - nC - 1) * nn - nO + + do b = nO+1, nBas-nR + jb = b + jb0 + + Aph(ia,jb) = ct2 * ERI(i,b,j,a) + if(i_eq_j) then + if(a == b) Aph(ia,jb) = Aph(ia,jb) + e(a) - e(i) + endif + enddo + enddo + enddo + enddo + !$OMP END DO + !$OMP END PARALLEL + +! ia = 0 +! do i=nC+1,nO +! do a=nO+1,nBas-nR +! ia = ia + 1 +! jb = 0 +! do j=nC+1,nO +! do b=nO+1,nBas-nR +! jb = jb + 1 +! Aph(ia,jb) = (e(a) - e(i))*Kronecker_delta(i,j)*Kronecker_delta(a,b) & +! - (1d0 - delta_dRPA)*lambda*ERI(i,b,j,a) +! end do +! end do +! end do +! end do end if diff --git a/src/LR/phLR_B.f90 b/src/LR/phLR_B.f90 index 51a4a01..954065a 100644 --- a/src/LR/phLR_B.f90 +++ b/src/LR/phLR_B.f90 @@ -17,6 +17,8 @@ subroutine phLR_B(ispin,dRPA,nBas,nC,nO,nV,nR,nS,lambda,ERI,Bph) double precision :: delta_dRPA integer :: i,j,a,b,ia,jb + integer :: nn,jb0 + double precision :: ct1,ct2 ! Output variables @@ -31,21 +33,44 @@ subroutine phLR_B(ispin,dRPA,nBas,nC,nO,nV,nR,nS,lambda,ERI,Bph) if(ispin == 1) then - ia = 0 - do i=nC+1,nO - do a=nO+1,nBas-nR - ia = ia + 1 - jb = 0 - do j=nC+1,nO - do b=nO+1,nBas-nR - jb = jb + 1 - - Bph(ia,jb) = 2d0*lambda*ERI(i,j,a,b) - (1d0 - delta_dRPA)*lambda*ERI(i,j,b,a) - - end do - end do - end do - end do + nn = nBas - nR - nO + ct1 = 2d0 * lambda + ct2 = - (1d0 - delta_dRPA) * lambda + !$OMP PARALLEL DEFAULT(NONE) & + !$OMP PRIVATE (i, a, j, b, ia, jb0, jb) & + !$OMP SHARED (nC, nO, nR, nBas, nn, ct1, ct2, ERI, Bph) + !$OMP DO COLLAPSE(2) + do i = nC+1, nO + do a = nO+1, nBas-nR + ia = a - nO + (i - nC - 1) * nn + + do j = nC+1, nO + jb0 = (j - nC - 1) * nn - nO + + do b = nO+1, nBas-nR + jb = b + jb0 + + Bph(ia,jb) = ct1 * ERI(i,j,a,b) + ct2 * ERI(i,j,b,a) + enddo + enddo + enddo + enddo + !$OMP END DO + !$OMP END PARALLEL + + !ia = 0 + !do i=nC+1,nO + ! do a=nO+1,nBas-nR + ! ia = ia + 1 + ! jb = 0 + ! do j=nC+1,nO + ! do b=nO+1,nBas-nR + ! jb = jb + 1 + ! Bph(ia,jb) = 2d0*lambda*ERI(i,j,a,b) - (1d0 - delta_dRPA)*lambda*ERI(i,j,b,a) + ! end do + ! end do + ! end do + !end do end if @@ -53,21 +78,43 @@ subroutine phLR_B(ispin,dRPA,nBas,nC,nO,nV,nR,nS,lambda,ERI,Bph) if(ispin == 2) then - ia = 0 - do i=nC+1,nO - do a=nO+1,nBas-nR - ia = ia + 1 - jb = 0 - do j=nC+1,nO - do b=nO+1,nBas-nR - jb = jb + 1 - - Bph(ia,jb) = - (1d0 - delta_dRPA)*lambda*ERI(i,j,b,a) - - end do - end do - end do - end do + nn = nBas - nR - nO + ct2 = - (1d0 - delta_dRPA) * lambda + !$OMP PARALLEL DEFAULT(NONE) & + !$OMP PRIVATE (i, a, j, b, ia, jb0, jb) & + !$OMP SHARED (nC, nO, nR, nBas, nn, ct2, ERI, Bph) + !$OMP DO COLLAPSE(2) + do i = nC+1, nO + do a = nO+1, nBas-nR + ia = a - nO + (i - nC - 1) * nn + + do j = nC+1, nO + jb0 = (j - nC - 1) * nn - nO + + do b = nO+1, nBas-nR + jb = b + jb0 + + Bph(ia,jb) = ct2 * ERI(i,j,b,a) + enddo + enddo + enddo + enddo + !$OMP END DO + !$OMP END PARALLEL + +! ia = 0 +! do i=nC+1,nO +! do a=nO+1,nBas-nR +! ia = ia + 1 +! jb = 0 +! do j=nC+1,nO +! do b=nO+1,nBas-nR +! jb = jb + 1 +! Bph(ia,jb) = - (1d0 - delta_dRPA)*lambda*ERI(i,j,b,a) +! end do +! end do +! end do +! end do end if