9
1
mirror of https://github.com/QuantumPackage/qp2.git synced 2024-12-22 03:23:29 +01:00

added OPENMP for all 3e PROVIDERS

This commit is contained in:
AbdAmmar 2023-04-27 18:03:30 +02:00
parent b2e65d010b
commit ff66fe8d26
2 changed files with 145 additions and 78 deletions

View File

@ -7,14 +7,24 @@ BEGIN_PROVIDER [double precision, fock_3e_uhf_mo_cs, (mo_num, mo_num)]
integer :: a, b, i, j integer :: a, b, i, j
double precision :: I_bij_aij, I_bij_ija, I_bij_jai, I_bij_aji, I_bij_iaj, I_bij_jia double precision :: I_bij_aij, I_bij_ija, I_bij_jai, I_bij_aji, I_bij_iaj, I_bij_jia
double precision :: ti, tf double precision :: ti, tf
double precision, allocatable :: tmp(:,:)
PROVIDE mo_l_coef mo_r_coef PROVIDE mo_l_coef mo_r_coef
call give_integrals_3_body_bi_ort(1, 1, 1, 1, 1, 1, I_bij_aij)
!print *, ' PROVIDING fock_3e_uhf_mo_cs ...' !print *, ' PROVIDING fock_3e_uhf_mo_cs ...'
call wall_time(ti) !call wall_time(ti)
fock_3e_uhf_mo_cs = 0.d0 fock_3e_uhf_mo_cs = 0.d0
!$OMP PARALLEL DEFAULT (NONE) &
!$OMP PRIVATE (a, b, i, j, I_bij_aij, I_bij_ija, I_bij_jai, I_bij_aji, I_bij_iaj, I_bij_jia, tmp) &
!$OMP SHARED (mo_num, elec_beta_num, fock_3e_uhf_mo_cs)
allocate(tmp(mo_num,mo_num))
tmp = 0.d0
!$OMP DO
do a = 1, mo_num do a = 1, mo_num
do b = 1, mo_num do b = 1, mo_num
@ -28,7 +38,7 @@ BEGIN_PROVIDER [double precision, fock_3e_uhf_mo_cs, (mo_num, mo_num)]
call give_integrals_3_body_bi_ort(b, i, j, i, a, j, I_bij_iaj) call give_integrals_3_body_bi_ort(b, i, j, i, a, j, I_bij_iaj)
call give_integrals_3_body_bi_ort(b, i, j, j, i, a, I_bij_jia) call give_integrals_3_body_bi_ort(b, i, j, j, i, a, I_bij_jia)
fock_3e_uhf_mo_cs(b,a) -= 0.5d0 * ( 4.d0 * I_bij_aij & tmp(b,a) -= 0.5d0 * ( 4.d0 * I_bij_aij &
+ I_bij_ija & + I_bij_ija &
+ I_bij_jai & + I_bij_jai &
- 2.d0 * I_bij_aji & - 2.d0 * I_bij_aji &
@ -39,8 +49,20 @@ BEGIN_PROVIDER [double precision, fock_3e_uhf_mo_cs, (mo_num, mo_num)]
enddo enddo
enddo enddo
enddo enddo
!$OMP END DO NOWAIT
call wall_time(tf) !$OMP CRITICAL
do a = 1, mo_num
do b = 1, mo_num
fock_3e_uhf_mo_cs(b,a) += tmp(b,a)
enddo
enddo
!$OMP END CRITICAL
deallocate(tmp)
!$OMP END PARALLEL
!call wall_time(tf)
!print *, ' total Wall time for fock_3e_uhf_mo_cs =', tf - ti !print *, ' total Wall time for fock_3e_uhf_mo_cs =', tf - ti
END_PROVIDER END_PROVIDER
@ -61,17 +83,27 @@ BEGIN_PROVIDER [double precision, fock_3e_uhf_mo_a, (mo_num, mo_num)]
integer :: a, b, i, j, o integer :: a, b, i, j, o
double precision :: I_bij_aij, I_bij_ija, I_bij_jai, I_bij_aji, I_bij_iaj, I_bij_jia double precision :: I_bij_aij, I_bij_ija, I_bij_jai, I_bij_aji, I_bij_iaj, I_bij_jia
double precision :: ti, tf double precision :: ti, tf
double precision, allocatable :: tmp(:,:)
PROVIDE mo_l_coef mo_r_coef PROVIDE mo_l_coef mo_r_coef
PROVIDE fock_3e_uhf_mo_cs PROVIDE fock_3e_uhf_mo_cs
print *, ' Providing fock_3e_uhf_mo_a ...' !print *, ' Providing fock_3e_uhf_mo_a ...'
call wall_time(ti) !call wall_time(ti)
o = elec_beta_num + 1 o = elec_beta_num + 1
call give_integrals_3_body_bi_ort(1, 1, 1, 1, 1, 1, I_bij_aij)
fock_3e_uhf_mo_a = fock_3e_uhf_mo_cs fock_3e_uhf_mo_a = fock_3e_uhf_mo_cs
!$OMP PARALLEL DEFAULT (NONE) &
!$OMP PRIVATE (a, b, i, j, I_bij_aij, I_bij_ija, I_bij_jai, I_bij_aji, I_bij_iaj, I_bij_jia, tmp) &
!$OMP SHARED (mo_num, o, elec_alpha_num, elec_beta_num, fock_3e_uhf_mo_a)
allocate(tmp(mo_num,mo_num))
tmp = 0.d0
!$OMP DO
do a = 1, mo_num do a = 1, mo_num
do b = 1, mo_num do b = 1, mo_num
@ -87,7 +119,7 @@ BEGIN_PROVIDER [double precision, fock_3e_uhf_mo_a, (mo_num, mo_num)]
call give_integrals_3_body_bi_ort(b, i, j, i, a, j, I_bij_iaj) call give_integrals_3_body_bi_ort(b, i, j, i, a, j, I_bij_iaj)
call give_integrals_3_body_bi_ort(b, i, j, j, i, a, I_bij_jia) call give_integrals_3_body_bi_ort(b, i, j, j, i, a, I_bij_jia)
fock_3e_uhf_mo_a(b,a) -= 0.5d0 * ( 2.d0 * I_bij_aij & tmp(b,a) -= 0.5d0 * ( 2.d0 * I_bij_aij &
+ I_bij_ija & + I_bij_ija &
+ I_bij_jai & + I_bij_jai &
- I_bij_aji & - I_bij_aji &
@ -109,7 +141,7 @@ BEGIN_PROVIDER [double precision, fock_3e_uhf_mo_a, (mo_num, mo_num)]
call give_integrals_3_body_bi_ort(b, i, j, i, a, j, I_bij_iaj) call give_integrals_3_body_bi_ort(b, i, j, i, a, j, I_bij_iaj)
call give_integrals_3_body_bi_ort(b, i, j, j, i, a, I_bij_jia) call give_integrals_3_body_bi_ort(b, i, j, j, i, a, I_bij_jia)
fock_3e_uhf_mo_a(b,a) -= 0.5d0 * ( 2.d0 * I_bij_aij & tmp(b,a) -= 0.5d0 * ( 2.d0 * I_bij_aij &
+ I_bij_ija & + I_bij_ija &
+ I_bij_jai & + I_bij_jai &
- I_bij_aji & - I_bij_aji &
@ -131,7 +163,7 @@ BEGIN_PROVIDER [double precision, fock_3e_uhf_mo_a, (mo_num, mo_num)]
call give_integrals_3_body_bi_ort(b, i, j, i, a, j, I_bij_iaj) call give_integrals_3_body_bi_ort(b, i, j, i, a, j, I_bij_iaj)
call give_integrals_3_body_bi_ort(b, i, j, j, i, a, I_bij_jia) call give_integrals_3_body_bi_ort(b, i, j, j, i, a, I_bij_jia)
fock_3e_uhf_mo_a(b,a) -= 0.5d0 * ( I_bij_aij & tmp(b,a) -= 0.5d0 * ( I_bij_aij &
+ I_bij_ija & + I_bij_ija &
+ I_bij_jai & + I_bij_jai &
- I_bij_aji & - I_bij_aji &
@ -145,35 +177,58 @@ BEGIN_PROVIDER [double precision, fock_3e_uhf_mo_a, (mo_num, mo_num)]
enddo enddo
enddo enddo
!$OMP END DO NOWAIT
call wall_time(tf) !$OMP CRITICAL
print *, ' Wall time for fock_3e_uhf_mo_a =', tf - ti do a = 1, mo_num
do b = 1, mo_num
fock_3e_uhf_mo_a(b,a) += tmp(b,a)
enddo
enddo
!$OMP END CRITICAL
deallocate(tmp)
!$OMP END PARALLEL
!call wall_time(tf)
!print *, ' Wall time for fock_3e_uhf_mo_a =', tf - ti
END_PROVIDER END_PROVIDER
! --- ! ---
BEGIN_PROVIDER [double precision, fock_3e_uhf_mo_b, (mo_num, mo_num)] BEGIN_PROVIDER [double precision, fock_3e_uhf_mo_b, (mo_num, mo_num)]
BEGIN_DOC BEGIN_DOC
! BETA part of the Fock matrix from three-electron terms ! BETA part of the Fock matrix from three-electron terms
! !
! WARNING :: non hermitian if bi-ortho MOS used ! WARNING :: non hermitian if bi-ortho MOS used
END_DOC END_DOC
implicit none implicit none
integer :: a, b, i, j, o integer :: a, b, i, j, o
double precision :: I_bij_aij, I_bij_ija, I_bij_jai, I_bij_aji, I_bij_iaj, I_bij_jia double precision :: I_bij_aij, I_bij_ija, I_bij_jai, I_bij_aji, I_bij_iaj, I_bij_jia
double precision :: ti, tf double precision :: ti, tf
double precision, allocatable :: tmp(:,:)
PROVIDE mo_l_coef mo_r_coef PROVIDE mo_l_coef mo_r_coef
!print *, ' PROVIDING fock_3e_uhf_mo_b ...' !print *, ' PROVIDING fock_3e_uhf_mo_b ...'
call wall_time(ti) !call wall_time(ti)
o = elec_beta_num + 1 o = elec_beta_num + 1
call give_integrals_3_body_bi_ort(1, 1, 1, 1, 1, 1, I_bij_aij)
fock_3e_uhf_mo_b = fock_3e_uhf_mo_cs fock_3e_uhf_mo_b = fock_3e_uhf_mo_cs
!$OMP PARALLEL DEFAULT (NONE) &
!$OMP PRIVATE (a, b, i, j, I_bij_aij, I_bij_ija, I_bij_jai, I_bij_aji, I_bij_iaj, I_bij_jia, tmp) &
!$OMP SHARED (mo_num, o, elec_alpha_num, elec_beta_num, fock_3e_uhf_mo_b)
allocate(tmp(mo_num,mo_num))
tmp = 0.d0
!$OMP DO
do a = 1, mo_num do a = 1, mo_num
do b = 1, mo_num do b = 1, mo_num
@ -189,7 +244,7 @@ BEGIN_PROVIDER [double precision, fock_3e_uhf_mo_b, (mo_num, mo_num)]
call give_integrals_3_body_bi_ort(b, i, j, i, a, j, I_bij_iaj) call give_integrals_3_body_bi_ort(b, i, j, i, a, j, I_bij_iaj)
call give_integrals_3_body_bi_ort(b, i, j, j, i, a, I_bij_jia) call give_integrals_3_body_bi_ort(b, i, j, j, i, a, I_bij_jia)
fock_3e_uhf_mo_b(b,a) -= 0.5d0 * ( 2.d0 * I_bij_aij & tmp(b,a) -= 0.5d0 * ( 2.d0 * I_bij_aij &
- I_bij_aji & - I_bij_aji &
- I_bij_iaj ) - I_bij_iaj )
@ -208,7 +263,7 @@ BEGIN_PROVIDER [double precision, fock_3e_uhf_mo_b, (mo_num, mo_num)]
call give_integrals_3_body_bi_ort(b, i, j, i, a, j, I_bij_iaj) call give_integrals_3_body_bi_ort(b, i, j, i, a, j, I_bij_iaj)
call give_integrals_3_body_bi_ort(b, i, j, j, i, a, I_bij_jia) call give_integrals_3_body_bi_ort(b, i, j, j, i, a, I_bij_jia)
fock_3e_uhf_mo_b(b,a) -= 0.5d0 * ( 2.d0 * I_bij_aij & tmp(b,a) -= 0.5d0 * ( 2.d0 * I_bij_aij &
- I_bij_aji & - I_bij_aji &
- I_bij_jia ) - I_bij_jia )
@ -227,7 +282,7 @@ BEGIN_PROVIDER [double precision, fock_3e_uhf_mo_b, (mo_num, mo_num)]
call give_integrals_3_body_bi_ort(b, i, j, i, a, j, I_bij_iaj) call give_integrals_3_body_bi_ort(b, i, j, i, a, j, I_bij_iaj)
call give_integrals_3_body_bi_ort(b, i, j, j, i, a, I_bij_jia) call give_integrals_3_body_bi_ort(b, i, j, j, i, a, I_bij_jia)
fock_3e_uhf_mo_b(b,a) -= 0.5d0 * ( I_bij_aij & tmp(b,a) -= 0.5d0 * ( I_bij_aij &
- I_bij_aji ) - I_bij_aji )
enddo enddo
@ -237,8 +292,20 @@ BEGIN_PROVIDER [double precision, fock_3e_uhf_mo_b, (mo_num, mo_num)]
enddo enddo
enddo enddo
!$OMP END DO NOWAIT
call wall_time(tf) !$OMP CRITICAL
do a = 1, mo_num
do b = 1, mo_num
fock_3e_uhf_mo_b(b,a) += tmp(b,a)
enddo
enddo
!$OMP END CRITICAL
deallocate(tmp)
!$OMP END PARALLEL
!call wall_time(tf)
!print *, ' total Wall time for fock_3e_uhf_mo_b =', tf - ti !print *, ' total Wall time for fock_3e_uhf_mo_b =', tf - ti
END_PROVIDER END_PROVIDER

View File

@ -208,10 +208,10 @@ BEGIN_PROVIDER [ double precision, Fock_matrix_tc_mo_alpha, (mo_num, mo_num) ]
if(three_body_h_tc) then if(three_body_h_tc) then
!call wall_time(tt0) !call wall_time(tt0)
PROVIDE fock_a_tot_3e_bi_orth !PROVIDE fock_a_tot_3e_bi_orth
Fock_matrix_tc_mo_alpha += fock_a_tot_3e_bi_orth !Fock_matrix_tc_mo_alpha += fock_a_tot_3e_bi_orth
!PROVIDE fock_3e_uhf_mo_a PROVIDE fock_3e_uhf_mo_a
!Fock_matrix_tc_mo_alpha += fock_3e_uhf_mo_a Fock_matrix_tc_mo_alpha += fock_3e_uhf_mo_a
!call wall_time(tt1) !call wall_time(tt1)
!print*, ' 3-e term:', tt1-tt0 !print*, ' 3-e term:', tt1-tt0
endif endif
@ -252,10 +252,10 @@ BEGIN_PROVIDER [ double precision, Fock_matrix_tc_mo_beta, (mo_num,mo_num) ]
call ao_to_mo_bi_ortho( Fock_matrix_tc_ao_beta, size(Fock_matrix_tc_ao_beta, 1) & call ao_to_mo_bi_ortho( Fock_matrix_tc_ao_beta, size(Fock_matrix_tc_ao_beta, 1) &
, Fock_matrix_tc_mo_beta, size(Fock_matrix_tc_mo_beta, 1) ) , Fock_matrix_tc_mo_beta, size(Fock_matrix_tc_mo_beta, 1) )
if(three_body_h_tc) then if(three_body_h_tc) then
PROVIDE fock_b_tot_3e_bi_orth !PROVIDE fock_b_tot_3e_bi_orth
Fock_matrix_tc_mo_beta += fock_b_tot_3e_bi_orth !Fock_matrix_tc_mo_beta += fock_b_tot_3e_bi_orth
!PROVIDE fock_3e_uhf_mo_b PROVIDE fock_3e_uhf_mo_b
!Fock_matrix_tc_mo_beta += fock_3e_uhf_mo_b Fock_matrix_tc_mo_beta += fock_3e_uhf_mo_b
endif endif
else else