From b2393ba88db73506b0589a8003a20fb7720a8936 Mon Sep 17 00:00:00 2001 From: ydamour Date: Mon, 26 Jun 2023 15:59:30 +0200 Subject: [PATCH 1/4] fix typo --- src/utils_cc/occupancy.irp.f | 4 ++-- src/utils_cc/org/occupancy.org | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/src/utils_cc/occupancy.irp.f b/src/utils_cc/occupancy.irp.f index c6139bb3..27b0ee5e 100644 --- a/src/utils_cc/occupancy.irp.f +++ b/src/utils_cc/occupancy.irp.f @@ -204,8 +204,8 @@ function is_del(i) is_del = .False. ! Search - do j = 1, dim_list_core_orb - if (list_core(j) == i) then + do j = 1, dim_list_del_orb + if (list_del(j) == i) then is_del = .True. exit endif diff --git a/src/utils_cc/org/occupancy.org b/src/utils_cc/org/occupancy.org index 246bbd5b..4267fc88 100644 --- a/src/utils_cc/org/occupancy.org +++ b/src/utils_cc/org/occupancy.org @@ -209,8 +209,8 @@ function is_del(i) is_del = .False. ! Search - do j = 1, dim_list_core_orb - if (list_core(j) == i) then + do j = 1, dim_list_del_orb + if (list_del(j) == i) then is_del = .True. exit endif From ce82fc82524a342c570483d79dab9dea760045fd Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Wed, 28 Jun 2023 13:50:21 +0200 Subject: [PATCH 2/4] Update EZFIO --- external/ezfio | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/external/ezfio b/external/ezfio index d5805497..0520b5e2 160000 --- a/external/ezfio +++ b/external/ezfio @@ -1 +1 @@ -Subproject commit d5805497fa0ef30e70e055cde1ecec2963303e93 +Subproject commit 0520b5e2cf70e2451c37ce5b7f2f64f6d2e5e956 From d4b0312414ecf2fc38a672ef62c09e6b44bd6047 Mon Sep 17 00:00:00 2001 From: Emmanuel Giner LCT Date: Thu, 29 Jun 2023 18:31:48 +0200 Subject: [PATCH 3/4] removed UGLY NON ASCII CHARACTERS --- src/mo_optimization/debug_gradient_list_opt.irp.f | 4 ++-- src/mo_optimization/debug_gradient_opt.irp.f | 4 ++-- src/mo_optimization/debug_hessian_list_opt.irp.f | 2 +- src/mo_optimization/debug_hessian_opt.irp.f | 2 +- src/mol_properties/multi_s_dipole_moment.irp.f | 2 +- src/mol_properties/print_properties.irp.f | 12 ++++++------ src/tc_bi_ortho/dressing_vectors_lr.irp.f | 8 ++++---- src/tc_bi_ortho/h_biortho.irp.f | 6 +++--- src/tc_bi_ortho/slater_tc_3e_slow.irp.f | 4 ++-- src/tc_bi_ortho/slater_tc_opt.irp.f | 6 +++--- src/tc_bi_ortho/slater_tc_opt_double.irp.f | 4 ++-- src/tc_bi_ortho/slater_tc_opt_single.irp.f | 4 ++-- src/tc_bi_ortho/slater_tc_slow.irp.f | 8 ++++---- src/tc_bi_ortho/tc_hmat.irp.f | 2 +- src/utils_trust_region/algo_trust.irp.f | 2 +- 15 files changed, 35 insertions(+), 35 deletions(-) diff --git a/src/mo_optimization/debug_gradient_list_opt.irp.f b/src/mo_optimization/debug_gradient_list_opt.irp.f index 867e0105..32cea90c 100644 --- a/src/mo_optimization/debug_gradient_list_opt.irp.f +++ b/src/mo_optimization/debug_gradient_list_opt.irp.f @@ -35,14 +35,14 @@ program debug_gradient_list ! Definition of n n = m*(m-1)/2 - PROVIDE mo_two_e_integrals_in_map ! Vérifier pour suppression + PROVIDE mo_two_e_integrals_in_map ! Verifier pour suppression ! Allocation allocate(v_grad(n), v_grad2(n)) ! Calculation - call diagonalize_ci ! Vérifier pour suppression + call diagonalize_ci ! Verifier pour suppression ! Gradient call gradient_list_opt(n,m,list_act,v_grad,max_elem,norm) diff --git a/src/mo_optimization/debug_gradient_opt.irp.f b/src/mo_optimization/debug_gradient_opt.irp.f index 8aeec18f..529a02b6 100644 --- a/src/mo_optimization/debug_gradient_opt.irp.f +++ b/src/mo_optimization/debug_gradient_opt.irp.f @@ -34,14 +34,14 @@ program debug_gradient ! Definition of n n = mo_num*(mo_num-1)/2 - PROVIDE mo_two_e_integrals_in_map ! Vérifier pour suppression + PROVIDE mo_two_e_integrals_in_map ! Check for suppression ! Allocation allocate(v_grad(n), v_grad2(n)) ! Calculation - call diagonalize_ci ! Vérifier pour suppression + call diagonalize_ci ! Gradient call first_gradient_opt(n,v_grad) diff --git a/src/mo_optimization/debug_hessian_list_opt.irp.f b/src/mo_optimization/debug_hessian_list_opt.irp.f index d1aa79c4..65a7bcf3 100644 --- a/src/mo_optimization/debug_hessian_list_opt.irp.f +++ b/src/mo_optimization/debug_hessian_list_opt.irp.f @@ -49,7 +49,7 @@ program debug_hessian_list_opt ! Definition of n n = m*(m-1)/2 - PROVIDE mo_two_e_integrals_in_map ! Vérifier pour suppression + PROVIDE mo_two_e_integrals_in_map ! Hessian if (optimization_method == 'full') then diff --git a/src/mo_optimization/debug_hessian_opt.irp.f b/src/mo_optimization/debug_hessian_opt.irp.f index 6d22cc01..684a0da5 100644 --- a/src/mo_optimization/debug_hessian_opt.irp.f +++ b/src/mo_optimization/debug_hessian_opt.irp.f @@ -40,7 +40,7 @@ program debug_hessian ! Definition of n n = mo_num*(mo_num-1)/2 - PROVIDE mo_two_e_integrals_in_map ! Vérifier pour suppression + PROVIDE mo_two_e_integrals_in_map ! Allocation allocate(H(n,n),H2(n,n)) diff --git a/src/mol_properties/multi_s_dipole_moment.irp.f b/src/mol_properties/multi_s_dipole_moment.irp.f index d5e62799..913ae2f3 100644 --- a/src/mol_properties/multi_s_dipole_moment.irp.f +++ b/src/mol_properties/multi_s_dipole_moment.irp.f @@ -13,7 +13,7 @@ ! matrix as a expectation value ! \begin{align*} ! <\Psi_n|x| \Psi_m > = \sum_p \gamma_{pp}^{nm} < \phi_p | x | \phi_p > -! + \sum_{pq, p \neq q} \gamma_{pq}^{nm} < \phi_p | x | \phi_q > + < \Psi_m | \sum_A Z_A R_A | \Psi_n > +! + \sum_{pq, p \neq q} \gamma_{pq}^{nm} < \phi_p |x | \phi_q > + < \Psi_m | \sum_A Z_A R_A | \Psi_n > ! \end{align*} diff --git a/src/mol_properties/print_properties.irp.f b/src/mol_properties/print_properties.irp.f index 4c0a9f38..af413a88 100644 --- a/src/mol_properties/print_properties.irp.f +++ b/src/mol_properties/print_properties.irp.f @@ -13,7 +13,7 @@ subroutine print_dipole_moment implicit none BEGIN_DOC - ! To print the dipole moment ||<\Psi_i|µ|\Psi_i>|| and its x,y,z components + ! To print the dipole moment ||<\Psi_i|\mu|\Psi_i>|| and its x,y,z components END_DOC integer :: istate @@ -33,7 +33,7 @@ subroutine print_dipole_moment print*,'# Dipoles:' print*,'==============================================' print*,' Dipole moments (au)' - print*,' State X Y Z ||µ||' + print*,' State X Y Z ||MU||' do istate = 1, N_states write(*,'(I5,4(F12.6))') (istate-1), d_x(istate), d_y(istate), d_z(istate), d(istate) @@ -42,7 +42,7 @@ subroutine print_dipole_moment ! Debye print*,'' print*,' Dipole moments (D)' - print*,' State X Y Z ||µ||' + print*,' State X Y Z ||MU||' do istate = 1, N_states write(*,'(I5,4(F12.6))') (istate-1), d_x(istate)*au_to_D, d_y(istate)*au_to_D, d_z(istate)*au_to_D, d(istate)*au_to_D @@ -70,7 +70,7 @@ subroutine print_transition_dipole_moment implicit none BEGIN_DOC - ! To print the transition dipole moment ||<\Psi_i|µ|\Psi_j>|| and its components along x, y and z + ! To print the transition dipole moment ||<\Psi_i|\mu|\Psi_j>|| and its components along x, y and z END_DOC integer :: istate,jstate, n_states_print @@ -84,7 +84,7 @@ subroutine print_transition_dipole_moment print*,'# Transition dipoles:' print*,'==============================================' print*,' Transition dipole moments (au)' - write(*,'(A89)') ' # Transition X Y Z ||µ|| Dip. str. Osc. str.' + write(*,'(A89)') ' # Transition X Y Z ||MU|| Dip. str. Osc. str.' if (print_all_transitions) then n_states_print = N_states @@ -106,7 +106,7 @@ subroutine print_transition_dipole_moment print*,'' print*,' Transition dipole moments (D)' - write(*,'(A89)') ' # Transition X Y Z ||µ|| Dip. str. Osc. str.' + write(*,'(A89)') ' # Transition X Y Z ||MU|| Dip. str. Osc. str.' do jstate = 1, n_states_print !N_states do istate = jstate + 1, N_states diff --git a/src/tc_bi_ortho/dressing_vectors_lr.irp.f b/src/tc_bi_ortho/dressing_vectors_lr.irp.f index ed663f02..0aff9980 100644 --- a/src/tc_bi_ortho/dressing_vectors_lr.irp.f +++ b/src/tc_bi_ortho/dressing_vectors_lr.irp.f @@ -38,9 +38,9 @@ subroutine get_delta_bitc_right(psidet, psicoef, ndet, Nint, delta) do i = 1, ndet do j = 1, ndet - ! < I | Htilde | J > + ! < I |Htilde | J > call htilde_mu_mat_bi_ortho_slow(psidet(1,1,i), psidet(1,1,j), Nint, htc_mono, htc_twoe, htc_three, htc_tot) - ! < I | H | J > + ! < I |H | J > call hmat_bi_ortho(psidet(1,1,i), psidet(1,1,j), Nint, h_mono, h_twoe, h_tot) delta_mat = htc_tot - h_tot @@ -87,7 +87,7 @@ subroutine get_htc_bitc_right(psidet, psicoef, ndet, Nint, delta) do i = 1, ndet do j = 1, ndet - ! < I | Htilde | J > + ! < I |Htilde | J > call htilde_mu_mat_bi_ortho_slow(psidet(1,1,i), psidet(1,1,j), Nint, htc_mono, htc_twoe, htc_three, htc_tot) delta(i) = delta(i) + psicoef(j) * htc_tot @@ -141,7 +141,7 @@ subroutine get_h_bitc_right(psidet, psicoef, ndet, Nint, delta) do i = 1, ndet do j = 1, ndet - ! < I | H | J > + ! < I |H | J > call hmat_bi_ortho(psidet(1,1,i), psidet(1,1,j), Nint, h_mono, h_twoe, h_tot) delta(i) = delta(i) + psicoef(j) * h_tot diff --git a/src/tc_bi_ortho/h_biortho.irp.f b/src/tc_bi_ortho/h_biortho.irp.f index 492e1282..bc06b88d 100644 --- a/src/tc_bi_ortho/h_biortho.irp.f +++ b/src/tc_bi_ortho/h_biortho.irp.f @@ -5,7 +5,7 @@ subroutine hmat_bi_ortho(key_j, key_i, Nint, hmono, htwoe, htot) BEGIN_DOC ! - ! < key_j | H | key_i > where | key_j > is developed on the LEFT basis and | key_i > is developed on the RIGHT basis + ! < key_j |H | key_i > where | key_j > is developed on the LEFT basis and | key_i > is developed on the RIGHT basis ! END_DOC @@ -111,7 +111,7 @@ subroutine single_hmat_bi_ortho(Nint, key_j, key_i, hmono, htwoe) BEGIN_DOC ! - ! < key_j | H | key_i > for single excitation + ! < key_j |H | key_i > for single excitation ! END_DOC @@ -185,7 +185,7 @@ subroutine double_hmat_bi_ortho(Nint, key_j, key_i, hmono, htwoe) BEGIN_DOC ! - ! < key_j | H | key_i> for double excitation + ! < key_j |H | key_i> for double excitation ! END_DOC diff --git a/src/tc_bi_ortho/slater_tc_3e_slow.irp.f b/src/tc_bi_ortho/slater_tc_3e_slow.irp.f index 49977f37..76539cb3 100644 --- a/src/tc_bi_ortho/slater_tc_3e_slow.irp.f +++ b/src/tc_bi_ortho/slater_tc_3e_slow.irp.f @@ -93,7 +93,7 @@ end subroutine single_htilde_three_body_ints_bi_ort_slow(Nint, key_j, key_i, hthree) BEGIN_DOC - ! for single excitation ONLY FOR THREE-BODY TERMS WITH BI ORTHONORMAL ORBITALS + ! for single excitation ONLY FOR THREE-BODY TERMS WITH BI ORTHONORMAL ORBITALS !! !! WARNING !! ! @@ -188,7 +188,7 @@ end subroutine double_htilde_three_body_ints_bi_ort_slow(Nint, key_j, key_i, hthree) BEGIN_DOC - ! for double excitation ONLY FOR THREE-BODY TERMS WITH BI ORTHONORMAL ORBITALS + ! for double excitation ONLY FOR THREE-BODY TERMS WITH BI ORTHONORMAL ORBITALS !! !! WARNING !! ! diff --git a/src/tc_bi_ortho/slater_tc_opt.irp.f b/src/tc_bi_ortho/slater_tc_opt.irp.f index ceefbfb8..933479e9 100644 --- a/src/tc_bi_ortho/slater_tc_opt.irp.f +++ b/src/tc_bi_ortho/slater_tc_opt.irp.f @@ -36,7 +36,7 @@ subroutine htilde_mu_mat_opt_bi_ortho_tot(key_j, key_i, Nint, htot) implicit none BEGIN_DOC ! - ! where |key_j> is developed on the LEFT basis and |key_i> is developed on the RIGHT basis + ! where |key_j> is developed on the LEFT basis and |key_i> is developed on the RIGHT basis !! ! Returns the total matrix element !! WARNING !! @@ -55,7 +55,7 @@ end subroutine htilde_mu_mat_opt_bi_ortho(key_j, key_i, Nint, hmono, htwoe, hthree, htot) BEGIN_DOC ! - ! where |key_j> is developed on the LEFT basis and |key_i> is developed on the RIGHT basis + ! 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. !! WARNING !! @@ -100,7 +100,7 @@ subroutine htilde_mu_mat_opt_bi_ortho_no_3e(key_j, key_i, Nint, htot) BEGIN_DOC ! - ! where |key_j> is developed on the LEFT basis and |key_i> is developed on the RIGHT basis + ! 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 !! WARNING !! 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 12bbbec0..bd59583f 100644 --- a/src/tc_bi_ortho/slater_tc_opt_double.irp.f +++ b/src/tc_bi_ortho/slater_tc_opt_double.irp.f @@ -2,7 +2,7 @@ subroutine double_htilde_mu_mat_fock_bi_ortho(Nint, key_j, key_i, hmono, htwoe, hthree, htot) BEGIN_DOC - ! for double excitation ONLY FOR ONE- AND TWO-BODY TERMS + ! for double excitation ONLY FOR ONE- AND TWO-BODY TERMS !! !! WARNING !! ! @@ -430,7 +430,7 @@ end subroutine double_htilde_mu_mat_fock_bi_ortho_no_3e(Nint, key_j, key_i, htot) BEGIN_DOC - ! for double excitation ONLY FOR ONE- AND TWO-BODY TERMS + ! for double excitation ONLY FOR ONE- AND TWO-BODY TERMS !! !! WARNING !! ! diff --git a/src/tc_bi_ortho/slater_tc_opt_single.irp.f b/src/tc_bi_ortho/slater_tc_opt_single.irp.f index 9719a6e7..ddcd1e66 100644 --- a/src/tc_bi_ortho/slater_tc_opt_single.irp.f +++ b/src/tc_bi_ortho/slater_tc_opt_single.irp.f @@ -2,7 +2,7 @@ subroutine single_htilde_mu_mat_fock_bi_ortho (Nint, key_j, key_i, hmono, htwoe, hthree, htot) BEGIN_DOC - ! for single excitation ONLY FOR ONE- AND TWO-BODY TERMS + ! for single excitation ONLY FOR ONE- AND TWO-BODY TERMS !! !! WARNING !! ! @@ -464,7 +464,7 @@ END_PROVIDER subroutine single_htilde_mu_mat_fock_bi_ortho_no_3e(Nint, key_j, key_i, htot) BEGIN_DOC - ! for single excitation ONLY FOR ONE- AND TWO-BODY TERMS + ! for single excitation ONLY FOR ONE- AND TWO-BODY TERMS !! !! WARNING !! ! diff --git a/src/tc_bi_ortho/slater_tc_slow.irp.f b/src/tc_bi_ortho/slater_tc_slow.irp.f index 1833d20f..0e0b5812 100644 --- a/src/tc_bi_ortho/slater_tc_slow.irp.f +++ b/src/tc_bi_ortho/slater_tc_slow.irp.f @@ -4,7 +4,7 @@ subroutine htilde_mu_mat_bi_ortho_tot_slow(key_j, key_i, Nint, htot) BEGIN_DOC - ! where |key_j> is developed on the LEFT basis and |key_i> is developed on the RIGHT basis + ! where |key_j> is developed on the LEFT basis and |key_i> is developed on the RIGHT basis !! !! WARNING !! ! @@ -35,7 +35,7 @@ subroutine htilde_mu_mat_bi_ortho_slow(key_j, key_i, Nint, hmono, htwoe, hthree, BEGIN_DOC ! - ! where |key_j> is developed on the LEFT basis and |key_i> is developed on the RIGHT basis + ! 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. !! WARNING !! @@ -191,7 +191,7 @@ end subroutine double_htilde_mu_mat_bi_ortho_slow(Nint, key_j, key_i, hmono, htwoe, htot) BEGIN_DOC - ! for double excitation ONLY FOR ONE- AND TWO-BODY TERMS + ! for double excitation ONLY FOR ONE- AND TWO-BODY TERMS !! !! WARNING !! ! @@ -258,7 +258,7 @@ end subroutine single_htilde_mu_mat_bi_ortho_slow(Nint, key_j, key_i, hmono, htwoe, htot) BEGIN_DOC - ! for single excitation ONLY FOR ONE- AND TWO-BODY TERMS + ! for single excitation ONLY FOR ONE- AND TWO-BODY TERMS !! !! WARNING !! ! diff --git a/src/tc_bi_ortho/tc_hmat.irp.f b/src/tc_bi_ortho/tc_hmat.irp.f index ec072531..e2c6f010 100644 --- a/src/tc_bi_ortho/tc_hmat.irp.f +++ b/src/tc_bi_ortho/tc_hmat.irp.f @@ -21,7 +21,7 @@ !$OMP SHARED (N_det, psi_det, N_int,htilde_matrix_elmt_bi_ortho) do i = 1, N_det do j = 1, N_det - ! < J | Htilde | I > + ! < J |Htilde | I > call htilde_mu_mat_opt_bi_ortho_tot(psi_det(1,1,j), psi_det(1,1,i), N_int, htot) htilde_matrix_elmt_bi_ortho(j,i) = htot diff --git a/src/utils_trust_region/algo_trust.irp.f b/src/utils_trust_region/algo_trust.irp.f index 933d8eff..09d76a40 100644 --- a/src/utils_trust_region/algo_trust.irp.f +++ b/src/utils_trust_region/algo_trust.irp.f @@ -77,7 +77,7 @@ ! ! Criterion -> step accepted or rejected ! call trust_region_is_step_cancelled(nb_iter,prev_criterion, criterion, criterion_model,rho,cancel_step) ! -! ! ### TODO ### +! !### TODO ### ! !if (cancel_step) then ! ! Cancel the previous step (mo_coef = prev_mos if you keep them...) ! !endif From e83a1f962ebd60d8be004e3c555ae195f70404f9 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Thu, 29 Jun 2023 18:52:31 +0200 Subject: [PATCH 4/4] Cholesky flag in CCSD --- src/utils_cc/mo_integrals_cc.irp.f | 139 ++++++++++++++++++++--------- 1 file changed, 96 insertions(+), 43 deletions(-) diff --git a/src/utils_cc/mo_integrals_cc.irp.f b/src/utils_cc/mo_integrals_cc.irp.f index 485d7002..dafcf7af 100644 --- a/src/utils_cc/mo_integrals_cc.irp.f +++ b/src/utils_cc/mo_integrals_cc.irp.f @@ -47,33 +47,61 @@ subroutine gen_v_space(n1,n2,n3,n4,list1,list2,list3,list4,v) integer :: i1,i2,i3,i4,idx1,idx2,idx3,idx4,k - double precision, allocatable :: buffer(:,:,:) - !$OMP PARALLEL & - !$OMP SHARED(n1,n2,n3,n4,list1,list2,list3,list4,v,mo_num,cholesky_mo_transp,cholesky_ao_num) & - !$OMP PRIVATE(i1,i2,i3,i4,idx1,idx2,idx3,idx4,k,buffer)& - !$OMP DEFAULT(NONE) - allocate(buffer(mo_num,mo_num,mo_num)) - !$OMP DO - do i4 = 1, n4 - idx4 = list4(i4) - call dgemm('T','N', mo_num*mo_num, mo_num, cholesky_ao_num, 1.d0, & - cholesky_mo_transp, cholesky_ao_num, & - cholesky_mo_transp(1,1,idx4), cholesky_ao_num, 0.d0, buffer, mo_num*mo_num) - do i2 = 1, n2 - idx2 = list2(i2) - do i3 = 1, n3 - idx3 = list3(i3) - do i1 = 1, n1 - idx1 = list1(i1) - v(i1,i2,i3,i4) = buffer(idx1,idx3,idx2) + if (do_ao_cholesky) then + double precision, allocatable :: buffer(:,:,:) + !$OMP PARALLEL & + !$OMP SHARED(n1,n2,n3,n4,list1,list2,list3,list4,v,mo_num,cholesky_mo_transp,cholesky_ao_num) & + !$OMP PRIVATE(i1,i2,i3,i4,idx1,idx2,idx3,idx4,k,buffer)& + !$OMP DEFAULT(NONE) + allocate(buffer(mo_num,mo_num,mo_num)) + !$OMP DO + do i4 = 1, n4 + idx4 = list4(i4) + call dgemm('T','N', mo_num*mo_num, mo_num, cholesky_ao_num, 1.d0, & + cholesky_mo_transp, cholesky_ao_num, & + cholesky_mo_transp(1,1,idx4), cholesky_ao_num, 0.d0, buffer, mo_num*mo_num) + do i2 = 1, n2 + idx2 = list2(i2) + do i3 = 1, n3 + idx3 = list3(i3) + do i1 = 1, n1 + idx1 = list1(i1) + v(i1,i2,i3,i4) = buffer(idx1,idx3,idx2) + enddo enddo enddo enddo - enddo - !$OMP END DO - deallocate(buffer) - !$OMP END PARALLEL + !$OMP END DO + deallocate(buffer) + !$OMP END PARALLEL + else + double precision :: get_two_e_integral + + PROVIDE mo_two_e_integrals_in_map + + !$OMP PARALLEL & + !$OMP SHARED(n1,n2,n3,n4,list1,list2,list3,list4,v,mo_integrals_map) & + !$OMP PRIVATE(i1,i2,i3,i4,idx1,idx2,idx3,idx4)& + !$OMP DEFAULT(NONE) + !$OMP DO collapse(3) + do i4 = 1, n4 + do i3 = 1, n3 + do i2 = 1, n2 + do i1 = 1, n1 + idx4 = list4(i4) + idx3 = list3(i3) + idx2 = list2(i2) + idx1 = list1(i1) + v(i1,i2,i3,i4) = get_two_e_integral(idx1,idx2,idx3,idx4,mo_integrals_map) + enddo + enddo + enddo + enddo + !$OMP END DO + !$OMP END PARALLEL + + endif end @@ -81,29 +109,54 @@ end BEGIN_PROVIDER [double precision, cc_space_v, (mo_num,mo_num,mo_num,mo_num)] implicit none - integer :: i1,i2,i3,i4,k - double precision, allocatable :: buffer(:,:,:) - !$OMP PARALLEL & - !$OMP SHARED(cc_space_v,mo_num,cholesky_mo_transp,cholesky_ao_num) & - !$OMP PRIVATE(i1,i2,i3,i4,k,buffer)& - !$OMP DEFAULT(NONE) - allocate(buffer(mo_num,mo_num,mo_num)) - !$OMP DO - do i4 = 1, mo_num - call dgemm('T','N', mo_num*mo_num, mo_num, cholesky_ao_num, 1.d0, & - cholesky_mo_transp, cholesky_ao_num, & - cholesky_mo_transp(1,1,i4), cholesky_ao_num, 0.d0, buffer, mo_num*mo_num) - do i2 = 1, mo_num - do i3 = 1, mo_num - do i1 = 1, mo_num - cc_space_v(i1,i2,i3,i4) = buffer(i1,i3,i2) + if (do_ao_cholesky) then + integer :: i1,i2,i3,i4 + double precision, allocatable :: buffer(:,:,:) + !$OMP PARALLEL & + !$OMP SHARED(cc_space_v,mo_num,cholesky_mo_transp,cholesky_ao_num) & + !$OMP PRIVATE(i1,i2,i3,i4,k,buffer)& + !$OMP DEFAULT(NONE) + allocate(buffer(mo_num,mo_num,mo_num)) + !$OMP DO + do i4 = 1, mo_num + call dgemm('T','N', mo_num*mo_num, mo_num, cholesky_ao_num, 1.d0, & + cholesky_mo_transp, cholesky_ao_num, & + cholesky_mo_transp(1,1,i4), cholesky_ao_num, 0.d0, buffer, mo_num*mo_num) + do i2 = 1, mo_num + do i3 = 1, mo_num + do i1 = 1, mo_num + cc_space_v(i1,i2,i3,i4) = buffer(i1,i3,i2) + enddo enddo enddo enddo - enddo - !$OMP END DO - deallocate(buffer) - !$OMP END PARALLEL + !$OMP END DO + deallocate(buffer) + !$OMP END PARALLEL + else + integer :: i,j,k,l + double precision :: get_two_e_integral + + PROVIDE mo_two_e_integrals_in_map + + !$OMP PARALLEL & + !$OMP SHARED(cc_space_v,mo_num,mo_integrals_map) & + !$OMP PRIVATE(i,j,k,l) & + !$OMP DEFAULT(NONE) + + !$OMP DO collapse(3) + do l = 1, mo_num + do k = 1, mo_num + do j = 1, mo_num + do i = 1, mo_num + cc_space_v(i,j,k,l) = get_two_e_integral(i,j,k,l,mo_integrals_map) + enddo + enddo + enddo + enddo + !$OMP END DO + !$OMP END PARALLEL + endif END_PROVIDER