mirror of
https://github.com/LCPQ/quantum_package
synced 2024-08-25 05:51:46 +02:00
Optimized provides in if statements
This commit is contained in:
parent
8343697d6f
commit
f79d6dd622
@ -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
|
||||
|
@ -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
|
||||
|
@ -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)
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
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)
|
||||
endif
|
||||
enddo
|
||||
enddo
|
||||
nuclear_repulsion *= 0.5d0
|
||||
|
@ -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
|
||||
|
@ -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)
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user