10
0
mirror of https://github.com/QuantumPackage/qp2.git synced 2024-06-26 15:12:19 +02:00

Fix locks in openmp

This commit is contained in:
Anthony Scemama 2023-09-20 15:16:10 +02:00
parent c44d624ceb
commit 4f78610432
2 changed files with 17 additions and 16 deletions

View File

@ -4,10 +4,11 @@
subroutine provide_all_three_ints_bi_ortho() subroutine provide_all_three_ints_bi_ortho()
BEGIN_DOC BEGIN_DOC
! routine that provides all necessary three-electron integrals ! routine that provides all necessary three-electron integrals
END_DOC END_DOC
implicit none implicit none
PROVIDE ao_two_e_integrals_in_map
if(three_body_h_tc) then if(three_body_h_tc) then
@ -17,14 +18,14 @@ subroutine provide_all_three_ints_bi_ortho()
endif endif
if(three_e_4_idx_term) then if(three_e_4_idx_term) then
PROVIDE three_e_4_idx_direct_bi_ort three_e_4_idx_cycle_1_bi_ort three_e_4_idx_exch23_bi_ort three_e_4_idx_exch13_bi_ort PROVIDE three_e_4_idx_direct_bi_ort three_e_4_idx_cycle_1_bi_ort three_e_4_idx_exch23_bi_ort three_e_4_idx_exch13_bi_ort
endif endif
if(pure_three_body_h_tc)then if(pure_three_body_h_tc)then
provide three_body_ints_bi_ort provide three_body_ints_bi_ort
endif endif
if(.not. double_normal_ord .and. three_e_5_idx_term) then if(.not. double_normal_ord .and. three_e_5_idx_term) then
PROVIDE three_e_5_idx_direct_bi_ort PROVIDE three_e_5_idx_direct_bi_ort
elseif(double_normal_ord .and. (.not. three_e_5_idx_term)) then elseif(double_normal_ord .and. (.not. three_e_5_idx_term)) then
PROVIDE normal_two_body_bi_orth PROVIDE normal_two_body_bi_orth
endif endif
@ -44,9 +45,9 @@ subroutine htilde_mu_mat_opt_bi_ortho_tot(key_j, key_i, Nint, htot)
! !
! <key_j |H_tilde | key_i> where |key_j> is developed on the LEFT basis and |key_i> is developed on the RIGHT basis ! <key_j |H_tilde | key_i> where |key_j> is developed on the LEFT basis and |key_i> is developed on the RIGHT basis
!! !!
! Returns the total matrix element ! Returns the total matrix element
!! WARNING !! !! WARNING !!
! !
! Non hermitian !! ! Non hermitian !!
! !
END_DOC END_DOC
@ -69,9 +70,9 @@ subroutine htilde_mu_mat_opt_bi_ortho(key_j, key_i, Nint, hmono, htwoe, hthree,
! !
! <key_j |H_tilde | key_i> where |key_j> is developed on the LEFT basis and |key_i> is developed on the RIGHT basis ! <key_j |H_tilde | key_i> where |key_j> is developed on the LEFT basis and |key_i> is developed on the RIGHT basis
!! !!
! Returns the detail of the matrix element in terms of single, two and three electron contribution. ! Returns the detail of the matrix element in terms of single, two and three electron contribution.
!! WARNING !! !! WARNING !!
! !
! Non hermitian !! ! Non hermitian !!
! !
END_DOC END_DOC
@ -82,7 +83,7 @@ subroutine htilde_mu_mat_opt_bi_ortho(key_j, key_i, Nint, hmono, htwoe, hthree,
integer, intent(in) :: Nint integer, intent(in) :: Nint
integer(bit_kind), intent(in) :: key_i(Nint,2), key_j(Nint,2) integer(bit_kind), intent(in) :: key_i(Nint,2), key_j(Nint,2)
double precision, intent(out) :: hmono, htwoe, hthree, htot double precision, intent(out) :: hmono, htwoe, hthree, htot
integer :: degree integer :: degree
hmono = 0.d0 hmono = 0.d0
htwoe = 0.d0 htwoe = 0.d0
@ -94,7 +95,7 @@ subroutine htilde_mu_mat_opt_bi_ortho(key_j, key_i, Nint, hmono, htwoe, hthree,
if(.not.pure_three_body_h_tc) then if(.not.pure_three_body_h_tc) then
if(degree .gt. 2) return if(degree .gt. 2) return
if(degree == 0) then if(degree == 0) then
call diag_htilde_mu_mat_fock_bi_ortho (Nint, key_i, hmono, htwoe, hthree, htot) call diag_htilde_mu_mat_fock_bi_ortho (Nint, key_i, hmono, htwoe, hthree, htot)
else if (degree == 1) then else if (degree == 1) then
@ -103,7 +104,7 @@ subroutine htilde_mu_mat_opt_bi_ortho(key_j, key_i, Nint, hmono, htwoe, hthree,
call double_htilde_mu_mat_fock_bi_ortho(Nint, key_j, key_i, hmono, htwoe, hthree, htot) call double_htilde_mu_mat_fock_bi_ortho(Nint, key_j, key_i, hmono, htwoe, hthree, htot)
endif endif
else else
if(degree .gt. 3) return if(degree .gt. 3) return
@ -122,7 +123,7 @@ subroutine htilde_mu_mat_opt_bi_ortho(key_j, key_i, Nint, hmono, htwoe, hthree,
if(degree==0) then if(degree==0) then
htot += nuclear_repulsion htot += nuclear_repulsion
endif endif
end end
! --- ! ---
@ -133,9 +134,9 @@ subroutine htilde_mu_mat_opt_bi_ortho_no_3e(key_j, key_i, Nint, htot)
! !
! <key_j |H_tilde | key_i> where |key_j> is developed on the LEFT basis and |key_i> is developed on the RIGHT basis ! <key_j |H_tilde | key_i> where |key_j> is developed on the LEFT basis and |key_i> is developed on the RIGHT basis
!! !!
! Returns the detail of the matrix element WITHOUT ANY CONTRIBUTION FROM THE THREE ELECTRON TERMS ! Returns the detail of the matrix element WITHOUT ANY CONTRIBUTION FROM THE THREE ELECTRON TERMS
!! WARNING !! !! WARNING !!
! !
! Non hermitian !! ! Non hermitian !!
! !
END_DOC END_DOC
@ -146,7 +147,7 @@ subroutine htilde_mu_mat_opt_bi_ortho_no_3e(key_j, key_i, Nint, htot)
integer, intent(in) :: Nint integer, intent(in) :: Nint
integer(bit_kind), intent(in) :: key_i(Nint,2), key_j(Nint,2) integer(bit_kind), intent(in) :: key_i(Nint,2), key_j(Nint,2)
double precision, intent(out) :: htot double precision, intent(out) :: htot
integer :: degree integer :: degree
htot = 0.d0 htot = 0.d0
@ -164,7 +165,7 @@ subroutine htilde_mu_mat_opt_bi_ortho_no_3e(key_j, key_i, Nint, htot)
if(degree==0) then if(degree==0) then
htot += nuclear_repulsion htot += nuclear_repulsion
endif endif
end end
! --- ! ---

View File

@ -15,7 +15,7 @@ BEGIN_PROVIDER [double precision, htilde_matrix_elmt_bi_ortho, (N_det,N_det)]
integer :: i, j integer :: i, j
double precision :: htot double precision :: htot
PROVIDE N_int call provide_all_three_ints_bi_ortho
i = 1 i = 1
j = 1 j = 1