From d0fecfa84577d3f9eee07615bb4399ad33eebe69 Mon Sep 17 00:00:00 2001 From: eginer Date: Fri, 20 Jan 2023 18:14:29 +0100 Subject: [PATCH] parallelized the two electron terms for opt doubles tc --- src/tc_bi_ortho/slater_tc_opt_double.irp.f | 24 ++++++++++++ src/tc_bi_ortho/test_tc_bi_ortho.irp.f | 43 +++++++++++++++++++++- 2 files changed, 66 insertions(+), 1 deletion(-) diff --git a/src/tc_bi_ortho/slater_tc_opt_double.irp.f b/src/tc_bi_ortho/slater_tc_opt_double.irp.f index c16c673d..bd2d37a3 100644 --- a/src/tc_bi_ortho/slater_tc_opt_double.irp.f +++ b/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 diff --git a/src/tc_bi_ortho/test_tc_bi_ortho.irp.f b/src/tc_bi_ortho/test_tc_bi_ortho.irp.f index 7d063c61..66ca2e6a 100644 --- a/src/tc_bi_ortho/test_tc_bi_ortho.irp.f +++ b/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