LCPQ/qp2
9
1
Fork 0
mirror of https://github.com/QuantumPackage/qp2.git synced 2024-07-27 21:07:23 +02:00
Code Releases Activity

parallelized the two electron terms for opt doubles tc

Browse Source
This commit is contained in:
eginer 2023-01-20 18:14:29 +01:00
parent a5ded6cd59
commit d0fecfa845
2 changed files with 66 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
src/tc_bi_ortho/slater_tc_opt_double.irp.f
View File

@ -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

43
src/tc_bi_ortho/test_tc_bi_ortho.irp.f
View File

@ -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