parallelized the two electron terms for opt doubles tc

src/tc_bi_ortho/slater_tc_opt_double.irp.f

@@ -209,7 +209,13 @@ BEGIN_PROVIDER [ double precision, eff_2_e_from_3_e_ab, (mo_num, mo_num, mo_num,
  double precision :: contrib
  allocate( occ(N_int*bit_kind_size,2) )
  call bitstring_to_list_ab(ref_bitmask,occ,Ne,N_int)
+ call give_contrib_for_abab(1,1,1,1,occ,Ne,contrib)
  eff_2_e_from_3_e_ab = 0.d0
+ !$OMP PARALLEL                                                                         &
+ !$OMP DEFAULT (NONE)                                                                   &
+ !$OMP PRIVATE (hh1, h1, hh2, h2, pp1, p1, pp2, p2, contrib) & 
+ !$OMP SHARED (n_act_orb, list_act, Ne,occ, eff_2_e_from_3_e_ab)
+ !$OMP DO SCHEDULE (static) 
   do hh1 = 1, n_act_orb !! alpha 
     h1 = list_act(hh1) 
     do hh2 = 1, n_act_orb !! beta 
@@ -224,6 +230,8 @@ BEGIN_PROVIDER [ double precision, eff_2_e_from_3_e_ab, (mo_num, mo_num, mo_num,
       enddo
     enddo
   enddo
+ !$OMP END DO
+ !$OMP END PARALLEL
 
 END_PROVIDER 
 
@@ -276,7 +284,13 @@ BEGIN_PROVIDER [ double precision, eff_2_e_from_3_e_aa, (mo_num, mo_num, mo_num,
  double precision :: contrib
  allocate( occ(N_int*bit_kind_size,2) )
  call bitstring_to_list_ab(ref_bitmask,occ,Ne,N_int)
+ call give_contrib_for_aaaa(1 ,1 ,1 ,1 ,occ,Ne,contrib)
  eff_2_e_from_3_e_aa = 100000000.d0
+ !$OMP PARALLEL                                                                         &
+ !$OMP DEFAULT (NONE)                                                                   &
+ !$OMP PRIVATE (hh1, h1, hh2, h2, pp1, p1, pp2, p2, contrib) & 
+ !$OMP SHARED (n_act_orb, list_act, Ne,occ, eff_2_e_from_3_e_aa)
+ !$OMP DO SCHEDULE (static) 
   do hh1 = 1, n_act_orb !! alpha 
     h1 = list_act(hh1) 
     do hh2 = hh1+1, n_act_orb !! alpha
@@ -291,6 +305,8 @@ BEGIN_PROVIDER [ double precision, eff_2_e_from_3_e_aa, (mo_num, mo_num, mo_num,
       enddo
     enddo
   enddo
+ !$OMP END DO
+ !$OMP END PARALLEL
 
 END_PROVIDER 
 
@@ -341,7 +357,13 @@ BEGIN_PROVIDER [ double precision, eff_2_e_from_3_e_bb, (mo_num, mo_num, mo_num,
  double precision :: contrib
  allocate( occ(N_int*bit_kind_size,2) )
  call bitstring_to_list_ab(ref_bitmask,occ,Ne,N_int)
+ call give_contrib_for_bbbb(1,1 ,1 ,1 ,occ,Ne,contrib)
  eff_2_e_from_3_e_bb = 100000000.d0
+ !$OMP PARALLEL                                                                         &
+ !$OMP DEFAULT (NONE)                                                                   &
+ !$OMP PRIVATE (hh1, h1, hh2, h2, pp1, p1, pp2, p2, contrib) & 
+ !$OMP SHARED (n_act_orb, list_act, Ne,occ, eff_2_e_from_3_e_bb)
+ !$OMP DO SCHEDULE (static) 
   do hh1 = 1, n_act_orb !! beta 
     h1 = list_act(hh1) 
     do hh2 = hh1+1, n_act_orb !! beta
@@ -356,6 +378,8 @@ BEGIN_PROVIDER [ double precision, eff_2_e_from_3_e_bb, (mo_num, mo_num, mo_num,
       enddo
     enddo
   enddo
+ !$OMP END DO
+ !$OMP END PARALLEL
 
 END_PROVIDER 
 

src/tc_bi_ortho/test_tc_bi_ortho.irp.f

@@ -11,7 +11,8 @@ program tc_bi_ortho
   touch read_wf
   touch  my_grid_becke my_n_pt_r_grid my_n_pt_a_grid
 
-  call test_slater_tc_opt
+!  call test_slater_tc_opt
+ call timing_hij
 end
 
 subroutine test_slater_tc_opt
@@ -65,3 +66,43 @@ subroutine test_slater_tc_opt
  print*,'accu   = ',accu/i_count
 
 end
+
+
+subroutine timing_hij
+ implicit none
+ integer :: i,j
+ double precision :: wall0, wall1
+ double precision, allocatable :: mat_old(:,:),mat_new(:,:)
+ double precision :: hmono, htwoe, hthree, htot
+! allocate(mat_old(N_det,N_det))
+ call htilde_mu_mat_opt_bi_ortho(psi_det(1,1,1), psi_det(1,1,1), N_int, hmono, htwoe, hthree, htot)
+ call wall_time(wall0)
+ do i = 1, N_det
+  do j = 1, N_det
+   call htilde_mu_mat_bi_ortho(psi_det(1,1,j), psi_det(1,1,i), N_int, hmono, htwoe, hthree, htot)
+!   mat_old(j,i) = htot
+  enddo
+ enddo
+ call wall_time(wall1)
+ print*,'time for old hij = ',wall1 - wall0
+
+! allocate(mat_new(N_det,N_det))
+ call wall_time(wall0)
+ do i = 1, N_det
+  do j = 1, N_det
+   call htilde_mu_mat_opt_bi_ortho(psi_det(1,1,j), psi_det(1,1,i), N_int, hmono, htwoe, hthree, htot)
+!   mat_new(j,i) = htot
+  enddo
+ enddo
+ call wall_time(wall1)
+ print*,'time for new hij = ',wall1 - wall0
+ double precision :: accu
+ accu = 0.d0
+ do i = 1, N_det
+  do j = 1, N_det
+!   accu += dabs(mat_new(j,i) - mat_old(j,i))
+  enddo
+ enddo
+ print*,'accu = ',accu
+
+end