From f79d6dd6225a5316ec4be4eb5595c188b27c45bb Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Wed, 15 Oct 2014 15:19:34 +0200 Subject: [PATCH] Optimized provides in if statements --- src/BiInts/map_integrals.irp.f | 2 +- src/Dets/SC2.irp.f | 1 + src/Dets/slater_rules.irp.f | 2 +- src/Full_CI/full_ci.irp.f | 5 +++++ src/Nuclei/nuclei.irp.f | 15 ++++++++------- src/Perturbation/epstein_nesbet.irp.f | 4 ++++ src/Perturbation/pert_sc2.irp.f | 2 ++ src/Perturbation/selection.irp.f | 5 ++++- src/Selectors_full/e_corr_selectors.irp.f | 1 + 9 files changed, 27 insertions(+), 10 deletions(-) diff --git a/src/BiInts/map_integrals.irp.f b/src/BiInts/map_integrals.irp.f index 098f585d..b6e0295d 100644 --- a/src/BiInts/map_integrals.irp.f +++ b/src/BiInts/map_integrals.irp.f @@ -132,7 +132,7 @@ subroutine get_ao_bielec_integrals(j,k,l,sze,out_val) integer :: i integer*8 :: hash double precision :: thresh - PROVIDE ao_bielec_integrals_in_map + PROVIDE ao_bielec_integrals_in_map ao_integrals_map thresh = ao_integrals_threshold if (ao_overlap_abs(j,l) < thresh) then diff --git a/src/Dets/SC2.irp.f b/src/Dets/SC2.irp.f index 79717f2c..e6e15991 100644 --- a/src/Dets/SC2.irp.f +++ b/src/Dets/SC2.irp.f @@ -166,6 +166,7 @@ subroutine CISD_SC2(dets_in,u_in,energies,dim_in,sze,N_st,Nint,convergence) !$OMP END DO !$OMP END PARALLEL + PROVIDE n_states_diag h_matrix_all_dets if(sze>sze_max)then call davidson_diag_hjj(dets_in,u_in,H_jj_dressed,energies,dim_in,sze,N_st,Nint,output_Dets) else diff --git a/src/Dets/slater_rules.irp.f b/src/Dets/slater_rules.irp.f index 56fff5bd..f909bb24 100644 --- a/src/Dets/slater_rules.irp.f +++ b/src/Dets/slater_rules.irp.f @@ -372,7 +372,7 @@ subroutine i_H_j(key_i,key_j,Nint,hij) integer :: n_occ_alpha, n_occ_beta logical :: has_mipi(Nint*bit_kind_size) double precision :: mipi(Nint*bit_kind_size), miip(Nint*bit_kind_size) - PROVIDE mo_bielec_integrals_in_map + PROVIDE mo_bielec_integrals_in_map mo_integrals_map ASSERT (Nint > 0) ASSERT (Nint == N_int) diff --git a/src/Full_CI/full_ci.irp.f b/src/Full_CI/full_ci.irp.f index a389e616..08acb9cb 100644 --- a/src/Full_CI/full_ci.irp.f +++ b/src/Full_CI/full_ci.irp.f @@ -30,6 +30,11 @@ program full_ci do while (N_det < n_det_max_fci.and.maxval(abs(pt2(1:N_st))) > pt2_max) call H_apply_FCI(pt2, norm_pert, H_pert_diag, N_st) + + PROVIDE psi_coef + PROVIDE psi_det + PROVIDE psi_det_sorted + if (N_det > n_det_max_fci) then psi_det = psi_det_sorted psi_coef = psi_coef_sorted diff --git a/src/Nuclei/nuclei.irp.f b/src/Nuclei/nuclei.irp.f index 7e7d6149..98303e61 100644 --- a/src/Nuclei/nuclei.irp.f +++ b/src/Nuclei/nuclei.irp.f @@ -178,14 +178,15 @@ BEGIN_PROVIDER [ double precision, nuclear_repulsion ] nuclear_repulsion = 0.d0 do l = 1, nucl_num do k = 1, nucl_num - if(k /= l) then - Z12 = nucl_charge(k)*nucl_charge(l) - x(1) = nucl_coord(k,1) - nucl_coord(l,1) - x(2) = nucl_coord(k,2) - nucl_coord(l,2) - x(3) = nucl_coord(k,3) - nucl_coord(l,3) - r2 = x(1)*x(1) + x(2)*x(2) + x(3)*x(3) - nuclear_repulsion += Z12/dsqrt(r2) + if(k == l) then + cycle endif + Z12 = nucl_charge(k)*nucl_charge(l) + x(1) = nucl_coord(k,1) - nucl_coord(l,1) + x(2) = nucl_coord(k,2) - nucl_coord(l,2) + x(3) = nucl_coord(k,3) - nucl_coord(l,3) + r2 = x(1)*x(1) + x(2)*x(2) + x(3)*x(3) + nuclear_repulsion += Z12/dsqrt(r2) enddo enddo nuclear_repulsion *= 0.5d0 diff --git a/src/Perturbation/epstein_nesbet.irp.f b/src/Perturbation/epstein_nesbet.irp.f index 60d050f5..62cb0cd6 100644 --- a/src/Perturbation/epstein_nesbet.irp.f +++ b/src/Perturbation/epstein_nesbet.irp.f @@ -19,6 +19,8 @@ subroutine pt2_epstein_nesbet(det_pert,c_pert,e_2_pert,H_pert_diag,Nint,ndet,N_s integer :: i,j double precision :: diag_H_mat_elem, h + PROVIDE selection_criterion + ASSERT (Nint == N_int) ASSERT (Nint > 0) call i_H_psi(det_pert,psi_selectors,psi_selectors_coef,Nint,N_det_selectors,psi_selectors_size,N_st,i_H_psi_array) @@ -63,6 +65,8 @@ subroutine pt2_epstein_nesbet_2x2(det_pert,c_pert,e_2_pert,H_pert_diag,Nint,ndet double precision :: diag_H_mat_elem,delta_e, h ASSERT (Nint == N_int) ASSERT (Nint > 0) + PROVIDE CI_electronic_energy + call i_H_psi(det_pert,psi_selectors,psi_selectors_coef,Nint,N_det_selectors,psi_selectors_size,N_st,i_H_psi_array) h = diag_H_mat_elem(det_pert,Nint) do i =1,N_st diff --git a/src/Perturbation/pert_sc2.irp.f b/src/Perturbation/pert_sc2.irp.f index f0fc8a0f..bdd8f97c 100644 --- a/src/Perturbation/pert_sc2.irp.f +++ b/src/Perturbation/pert_sc2.irp.f @@ -204,6 +204,8 @@ subroutine pt2_epstein_nesbet_sc2(det_pert,c_pert,e_2_pert,H_pert_diag,Nint,ndet integer :: i,j double precision :: diag_H_mat_elem, h + PROVIDE selection_criterion + ASSERT (Nint == N_int) ASSERT (Nint > 0) call i_H_psi(det_pert,psi_selectors,psi_selectors_coef,Nint,N_det_selectors,psi_selectors_size,N_st,i_H_psi_array) diff --git a/src/Perturbation/selection.irp.f b/src/Perturbation/selection.irp.f index 274e44af..80c3d770 100644 --- a/src/Perturbation/selection.irp.f +++ b/src/Perturbation/selection.irp.f @@ -15,7 +15,7 @@ subroutine fill_H_apply_buffer_selection(n_selected,det_buffer,e_2_pert_buffer,c integer :: new_size double precision :: s, smin, smax logical :: is_selected - PROVIDE H_apply_buffer_allocated + PROVIDE H_apply_buffer_allocated N_int ASSERT (Nint > 0) ASSERT (N_int == N_int) ASSERT (N_selected >= 0) @@ -41,6 +41,7 @@ subroutine fill_H_apply_buffer_selection(n_selected,det_buffer,e_2_pert_buffer,c enddo + if (is_selected) then l = l+1 do j=1,N_int @@ -90,6 +91,7 @@ subroutine remove_small_contributions integer :: i,j,k, N_removed logical, allocatable :: keep(:) double precision :: i_H_psi_array(N_states) + allocate (keep(N_det)) call diagonalize_CI do i=1,N_det @@ -113,6 +115,7 @@ subroutine remove_small_contributions N_removed = 0 k = 0 do i=1, N_det + PROVIDE psi_coef psi_det psi_det_sorted psi_coef_sorted if (keep(i)) then k += 1 do j=1,N_int diff --git a/src/Selectors_full/e_corr_selectors.irp.f b/src/Selectors_full/e_corr_selectors.irp.f index 076a3213..952e1c23 100644 --- a/src/Selectors_full/e_corr_selectors.irp.f +++ b/src/Selectors_full/e_corr_selectors.irp.f @@ -45,6 +45,7 @@ END_PROVIDER ! ! coef_hf_selector = coefficient of the Hartree Fock determinant in the selectors determinants END_DOC + PROVIDE ref_bitmask_energy psi_selectors ref_bitmask N_int psi_selectors integer :: i,degree double precision :: hij,diag_H_mat_elem E_corr_double_only = 0.d0