more openMP

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_C(ispin,nOrb,nC,nO,nV,nR,nVVs,1d0,eOld,ERI,Cpp)
-                     call ppRLR_D(ispin,nOrb,nC,nO,nV,nR,nOOs,1d0,eHF,ERI,Dpp)
+                     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_C(ispin,nOrb,nC,nO,nV,nR,nVVt,1d0,eOld,ERI,Cpp)
-                     call ppRLR_D(ispin,nOrb,nC,nO,nV,nR,nOOt,1d0,eHF,ERI,Dpp)
+                     call ppRLR_D(ispin,nOrb,nC,nO,nV,nR,nOOt,1d0,eOld,ERI,Dpp)
 
       if(n_it_2b == 1) then
 

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 !

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 

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 

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)         &
+  a0 = nOrb - nR - nO
-!  !$OMP PRIVATE(a, b, ab, c, d, cd, n) &
+  !$OMP PARALLEL DEFAULT(NONE)          &
-!  !$OMP SHARED(nC, nOrb, nO, nS, pp_sing_Gam_C, eh_sing_rho, eh_sing_Om, eh_trip_rho, eh_trip_Om)
+  !$OMP PRIVATE(a, b, aa, ab, c, d, cd) &
-!  !$OMP DO COLLAPSE(2)
+  !$OMP SHARED(nO, nOrb, nR, a0, pp_sing_Gam_C, eh_sing_Phi, eh_trip_Phi)
-
+  !$OMP DO
-  ab = 0
+  do a = nO+1, nOrb-nR
-  do a=nO+1,nOrb - nR
+     aa = a0 * (a - nO - 1) - (a - nO - 1) * (a - nO) / 2 - nO
-     do b=a,nOrb - nR
+     do b = a, nOrb-nR
-        ab = ab + 1
+        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 DO
-!  !$OMP END PARALLEL
+  !$OMP END PARALLEL
 
 end subroutine
 

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 

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 

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 PARALLEL DEFAULT(NONE)                                &
-!  !$OMP          PRIVATE(p, q, a, b, ab, c, d, cd, i, j, ij, k, l, kl) &
+  !$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 SHARED(nC, nOrb, nR, nO, rho1, rho2, ERI, eh_sing_Phi, eh_trip_Phi, X1, Y1, X2, Y2)
-!  !$OMP DO COLLAPSE(2)
+  !$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 DO
-!  !$OMP END PARALLEL
+  !$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 PARALLEL DEFAULT(NONE)                                &
-!  !$OMP          PRIVATE(p, q, a, b, ab, c, d, cd, i, j, ij, k, l, kl) &
+  !$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 SHARED(nC, nOrb, nR, nO, rho1, rho2, ERI, eh_sing_Phi, eh_trip_Phi, X1, Y1, X2, Y2)
-!  !$OMP DO COLLAPSE(2)
+  !$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 DO
-!  !$OMP END PARALLEL
+  !$OMP END PARALLEL
 
 end subroutine