From 100357747b51be36f7e787100a4f3c0ee81c1dc9 Mon Sep 17 00:00:00 2001 From: Antoine MARIE Date: Thu, 3 Apr 2025 17:26:35 +0200 Subject: [PATCH] more openMP --- src/Parquet/RParquet.f90 | 20 +++++++++++++------- src/Parquet/R_Parquet_self_energy.f90 | 4 ++-- src/Parquet/R_eh_singlet_Phi.f90 | 6 ++++++ src/Parquet/R_eh_triplet_Phi.f90 | 6 ++++++ src/Parquet/R_pp_singlet_Gam.f90 | 27 +++++++++++++-------------- src/Parquet/R_pp_singlet_Phi.f90 | 6 ++++++ src/Parquet/R_pp_triplet_Phi.f90 | 6 ++++++ src/Parquet/R_screened_integrals.f90 | 24 ++++++++++++------------ 8 files changed, 64 insertions(+), 35 deletions(-) diff --git a/src/Parquet/RParquet.f90 b/src/Parquet/RParquet.f90 index 8738db9..f644ce3 100644 --- a/src/Parquet/RParquet.f90 +++ b/src/Parquet/RParquet.f90 @@ -206,7 +206,7 @@ subroutine RParquet(TDAeh,TDApp,max_diis_1b,max_diis_2b,linearize,eta,ENuc,max_i call wall_time(start_t) - call phRLR_A(ispin,.false.,nOrb,nC,nO,nV,nR,nS,1d0,eHF,ERI,Aph) + call phRLR_A(ispin,.false.,nOrb,nC,nO,nV,nR,nS,1d0,eOld,ERI,Aph) if(.not.TDAeh) call phRLR_B(ispin,.false.,nOrb,nC,nO,nV,nR,nS,1d0,ERI,Bph) if(n_it_2b == 1) then @@ -261,7 +261,7 @@ subroutine RParquet(TDAeh,TDApp,max_diis_1b,max_diis_2b,linearize,eta,ENuc,max_i call wall_time(start_t) - call phRLR_A(ispin,.false.,nOrb,nC,nO,nV,nR,nS,1d0,eHF,ERI,Aph) + call phRLR_A(ispin,.false.,nOrb,nC,nO,nV,nR,nS,1d0,eOld,ERI,Aph) if(.not.TDAeh) call phRLR_B(ispin,.false.,nOrb,nC,nO,nV,nR,nS,1d0,ERI,Bph) if(n_it_2b == 1) then @@ -319,8 +319,8 @@ subroutine RParquet(TDAeh,TDApp,max_diis_1b,max_diis_2b,linearize,eta,ENuc,max_i call wall_time(start_t) if(.not.TDApp) call ppRLR_B(ispin,nOrb,nC,nO,nV,nR,nOOs,nVVs,1d0,ERI,Bpp) - call ppRLR_C(ispin,nOrb,nC,nO,nV,nR,nVVs,1d0,eHF,ERI,Cpp) - call ppRLR_D(ispin,nOrb,nC,nO,nV,nR,nOOs,1d0,eHF,ERI,Dpp) + call ppRLR_C(ispin,nOrb,nC,nO,nV,nR,nVVs,1d0,eOld,ERI,Cpp) + call ppRLR_D(ispin,nOrb,nC,nO,nV,nR,nOOs,1d0,eOld,ERI,Dpp) if(n_it_2b == 1) then @@ -340,11 +340,17 @@ subroutine RParquet(TDAeh,TDApp,max_diis_1b,max_diis_2b,linearize,eta,ENuc,max_i Cpp(:,:) = Cpp(:,:) + pp_sing_Gam_C(:,:) Dpp(:,:) = Dpp(:,:) + pp_sing_Gam_D(:,:) + call wall_time(end_t) + t = end_t - start_t + + write(*,'(A50,1X,F9.3,A8)') 'Wall time for building singlet ppBSE =',t,' seconds' + call wall_time(start_t) + call ppRLR(TDApp,nOOs,nVVs,Bpp,Cpp,Dpp,ee_sing_Om,X1s,Y1s,hh_sing_Om,X2s,Y2s,Ec_pp(ispin)) call wall_time(end_t) t = end_t - start_t - write(*,'(A50,1X,F9.3,A8)') 'Wall time for singlet ppBSE =',t,' seconds' + write(*,'(A50,1X,F9.3,A8)') 'Wall time for diagonalizing singlet ppBSE =',t,' seconds' write(*,*) if(print_ppLR) call print_excitation_energies('ppBSE@Parquet','2p (singlets)',nVVs,ee_sing_Om) @@ -376,8 +382,8 @@ subroutine RParquet(TDAeh,TDApp,max_diis_1b,max_diis_2b,linearize,eta,ENuc,max_i call wall_time(start_t) if(.not.TDApp) call ppRLR_B(ispin,nOrb,nC,nO,nV,nR,nOOt,nVVt,1d0,ERI,Bpp) - call ppRLR_C(ispin,nOrb,nC,nO,nV,nR,nVVt,1d0,eHF,ERI,Cpp) - call ppRLR_D(ispin,nOrb,nC,nO,nV,nR,nOOt,1d0,eHF,ERI,Dpp) + call ppRLR_C(ispin,nOrb,nC,nO,nV,nR,nVVt,1d0,eOld,ERI,Cpp) + call ppRLR_D(ispin,nOrb,nC,nO,nV,nR,nOOt,1d0,eOld,ERI,Dpp) if(n_it_2b == 1) then diff --git a/src/Parquet/R_Parquet_self_energy.f90 b/src/Parquet/R_Parquet_self_energy.f90 index a51a81c..efcdb73 100644 --- a/src/Parquet/R_Parquet_self_energy.f90 +++ b/src/Parquet/R_Parquet_self_energy.f90 @@ -207,7 +207,7 @@ subroutine R_Parquet_self_energy(eta,nOrb,nC,nO,nV,nR,nS,nOOs,nVVs,nOOt,nVVt,eQP call wall_time(end_t) t = end_t - start_t - write(*,'(1X,A50,1X,F9.3,A8)') 'Wall time for building eh self-energy =',t,' seconds' + write(*,'(1X,A50,1X,F9.3,A8)') 'Wall time for building singlet eh self-energy =',t,' seconds' write(*,*) !-------------------------------------! ! triplet eh part of the self-energy ! @@ -330,7 +330,7 @@ subroutine R_Parquet_self_energy(eta,nOrb,nC,nO,nV,nR,nS,nOOs,nVVs,nOOt,nVVt,eQP call wall_time(end_t) t = end_t - start_t - write(*,'(1X,A50,1X,F9.3,A8)') 'Wall time for building eh self-energy =',t,' seconds' + write(*,'(1X,A50,1X,F9.3,A8)') 'Wall time for building triplet eh self-energy =',t,' seconds' write(*,*) !-------------------------------------! ! singlet pp part of the self-energy ! diff --git a/src/Parquet/R_eh_singlet_Phi.f90 b/src/Parquet/R_eh_singlet_Phi.f90 index d7f8783..f02d518 100644 --- a/src/Parquet/R_eh_singlet_Phi.f90 +++ b/src/Parquet/R_eh_singlet_Phi.f90 @@ -19,6 +19,10 @@ subroutine R_eh_singlet_Phi(nOrb,nC,nR,nS,eh_sing_Om,eh_sing_rho,eh_sing_Phi) ! Initialization eh_sing_Phi(:,:,:,:) = 0d0 + !$OMP PARALLEL DEFAULT(NONE) & + !$OMP PRIVATE(p, q, r, s, n) & + !$OMP SHARED(nC, nOrb, nR, nS, eh_sing_Phi, eh_sing_rho, eh_sing_Om) + !$OMP DO COLLAPSE(2) do s = nC+1, nOrb-nR do r = nC+1, nOrb-nR do q = nC+1, nOrb-nR @@ -34,5 +38,7 @@ subroutine R_eh_singlet_Phi(nOrb,nC,nR,nS,eh_sing_Om,eh_sing_rho,eh_sing_Phi) enddo enddo enddo + !$OMP END DO + !$OMP END PARALLEL end subroutine diff --git a/src/Parquet/R_eh_triplet_Phi.f90 b/src/Parquet/R_eh_triplet_Phi.f90 index 38fd216..9e7b2e9 100644 --- a/src/Parquet/R_eh_triplet_Phi.f90 +++ b/src/Parquet/R_eh_triplet_Phi.f90 @@ -19,6 +19,10 @@ subroutine R_eh_triplet_Phi(nOrb,nC,nR,nS,eh_trip_Om,eh_trip_rho,eh_trip_Phi) ! Initialization eh_trip_Phi(:,:,:,:) = 0d0 + !$OMP PARALLEL DEFAULT(NONE) & + !$OMP PRIVATE(p, q, r, s, n) & + !$OMP SHARED(nC, nOrb, nR, nS, eh_trip_Phi, eh_trip_rho, eh_trip_Om) + !$OMP DO COLLAPSE(2) do s = nC+1, nOrb-nR do r = nC+1, nOrb-nR do q = nC+1, nOrb-nR @@ -34,5 +38,7 @@ subroutine R_eh_triplet_Phi(nOrb,nC,nR,nS,eh_trip_Om,eh_trip_rho,eh_trip_Phi) enddo enddo enddo + !$OMP END DO + !$OMP END PARALLEL end subroutine diff --git a/src/Parquet/R_pp_singlet_Gam.f90 b/src/Parquet/R_pp_singlet_Gam.f90 index 4bf6f88..206a577 100644 --- a/src/Parquet/R_pp_singlet_Gam.f90 +++ b/src/Parquet/R_pp_singlet_Gam.f90 @@ -60,7 +60,7 @@ subroutine R_pp_singlet_Gamma_C(nOrb,nO,nR,nVVs,eh_sing_Phi,eh_trip_Phi,pp_sing_ ! Local variables integer :: a,b,c,d - integer :: ab,cd + integer :: ab,cd,aa,a0 double precision,external :: Kronecker_delta ! Output variables @@ -69,21 +69,20 @@ subroutine R_pp_singlet_Gamma_C(nOrb,nO,nR,nVVs,eh_sing_Phi,eh_trip_Phi,pp_sing_ ! Initialization pp_sing_Gam_C(:,:) = 0d0 -! !$OMP PARALLEL DEFAULT(NONE) & -! !$OMP PRIVATE(a, b, ab, c, d, cd, n) & -! !$OMP SHARED(nC, nOrb, nO, nS, pp_sing_Gam_C, eh_sing_rho, eh_sing_Om, eh_trip_rho, eh_trip_Om) -! !$OMP DO COLLAPSE(2) - - ab = 0 - do a=nO+1,nOrb - nR - do b=a,nOrb - nR - ab = ab + 1 - + a0 = nOrb - nR - nO + !$OMP PARALLEL DEFAULT(NONE) & + !$OMP PRIVATE(a, b, aa, ab, c, d, cd) & + !$OMP SHARED(nO, nOrb, nR, a0, pp_sing_Gam_C, eh_sing_Phi, eh_trip_Phi) + !$OMP DO + do a = nO+1, nOrb-nR + aa = a0 * (a - nO - 1) - (a - nO - 1) * (a - nO) / 2 - nO + do b = a, nOrb-nR + ab = aa + b + cd = 0 do c=nO+1,nOrb - nR do d=c,nOrb - nR cd = cd +1 - pp_sing_Gam_C(ab,cd) = 0.5d0*eh_sing_Phi(a,b,c,d) - 1.5d0*eh_trip_Phi(a,b,c,d) & + 0.5d0*eh_sing_Phi(a,b,d,c) - 1.5d0*eh_trip_Phi(a,b,d,c) @@ -94,8 +93,8 @@ subroutine R_pp_singlet_Gamma_C(nOrb,nO,nR,nVVs,eh_sing_Phi,eh_trip_Phi,pp_sing_ end do end do end do -! !$OMP END DO -! !$OMP END PARALLEL + !$OMP END DO + !$OMP END PARALLEL end subroutine diff --git a/src/Parquet/R_pp_singlet_Phi.f90 b/src/Parquet/R_pp_singlet_Phi.f90 index e1ae594..73552a7 100644 --- a/src/Parquet/R_pp_singlet_Phi.f90 +++ b/src/Parquet/R_pp_singlet_Phi.f90 @@ -21,6 +21,10 @@ subroutine R_pp_singlet_Phi(nOrb,nC,nR,nOO,nVV,ee_sing_Om,ee_sing_rho,hh_sing_Om ! Initialization pp_sing_Phi(:,:,:,:) = 0d0 + !$OMP PARALLEL DEFAULT(NONE) & + !$OMP PRIVATE(p, q, r, s, n) & + !$OMP SHARED(nC, nOrb, nR, nVV, nOO, pp_sing_Phi, ee_sing_rho, ee_sing_Om, hh_sing_rho, hh_sing_Om) + !$OMP DO COLLAPSE(2) do s = nC+1, nOrb-nR do r = nC+1, nOrb-nR do q = nC+1, nOrb-nR @@ -40,5 +44,7 @@ subroutine R_pp_singlet_Phi(nOrb,nC,nR,nOO,nVV,ee_sing_Om,ee_sing_rho,hh_sing_Om enddo enddo enddo + !$OMP END DO + !$OMP END PARALLEL end subroutine diff --git a/src/Parquet/R_pp_triplet_Phi.f90 b/src/Parquet/R_pp_triplet_Phi.f90 index eaea4e2..b7c204b 100644 --- a/src/Parquet/R_pp_triplet_Phi.f90 +++ b/src/Parquet/R_pp_triplet_Phi.f90 @@ -21,6 +21,10 @@ subroutine R_pp_triplet_Phi(nOrb,nC,nR,nOO,nVV,ee_trip_Om,ee_trip_rho,hh_trip_Om ! Initialization pp_trip_Phi(:,:,:,:) = 0d0 + !$OMP PARALLEL DEFAULT(NONE) & + !$OMP PRIVATE(p, q, r, s, n) & + !$OMP SHARED(nC, nOrb, nR, nVV, nOO, pp_trip_Phi, ee_trip_rho, ee_trip_Om, hh_trip_rho, hh_trip_Om) + !$OMP DO COLLAPSE(2) do s = nC+1, nOrb-nR do r = nC+1, nOrb-nR do q = nC+1, nOrb-nR @@ -40,5 +44,7 @@ subroutine R_pp_triplet_Phi(nOrb,nC,nR,nOO,nVV,ee_trip_Om,ee_trip_rho,hh_trip_Om enddo enddo enddo + !$OMP END DO + !$OMP END PARALLEL end subroutine diff --git a/src/Parquet/R_screened_integrals.f90 b/src/Parquet/R_screened_integrals.f90 index 032e37d..9999e75 100644 --- a/src/Parquet/R_screened_integrals.f90 +++ b/src/Parquet/R_screened_integrals.f90 @@ -157,10 +157,10 @@ subroutine R_pp_singlet_screened_integral(nOrb,nC,nO,nR,nOO,nVV,ERI,eh_sing_Phi, 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_sing_Phi, eh_trip_Phi, X1, Y1, X2, Y2) + !$OMP DO COLLAPSE(2) do q=nC+1,nOrb-nR do p=nC+1,nOrb-nR @@ -231,8 +231,8 @@ subroutine R_pp_singlet_screened_integral(nOrb,nC,nO,nR,nOO,nVV,ERI,eh_sing_Phi, end do end do -! !$OMP END DO -! !$OMP END PARALLEL + !$OMP END DO + !$OMP END PARALLEL end subroutine @@ -274,10 +274,10 @@ subroutine R_pp_triplet_screened_integral(nOrb,nC,nO,nR,nOO,nVV,ERI,eh_sing_Phi, dim_1 = (nOrb - nO) * (nOrb - nO - 1) / 2 dim_2 = nO * (nO - 1) / 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, pp_trip_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_sing_Phi, eh_trip_Phi, X1, Y1, X2, Y2) + !$OMP DO COLLAPSE(2) do q = nC+1, nOrb-nR do p = nC+1, nOrb-nR @@ -344,7 +344,7 @@ subroutine R_pp_triplet_screened_integral(nOrb,nC,nO,nR,nOO,nVV,ERI,eh_sing_Phi, end do ! p end do ! q -! !$OMP END DO -! !$OMP END PARALLEL + !$OMP END DO + !$OMP END PARALLEL end subroutine