LCPQ/quantum_package
10
0
Fork 0
mirror of https://github.com/LCPQ/quantum_package synced 2025-01-09 20:48:47 +01:00
Code Issues Releases Wiki Activity

Optimized provides in if statements

Browse Source
This commit is contained in:
Anthony Scemama 2014-10-15 15:19:34 +02:00
parent 8343697d6f
commit f79d6dd622
9 changed files with 27 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
src/BiInts/map_integrals.irp.f
View File

@ -132,7 +132,7 @@ subroutine get_ao_bielec_integrals(j,k,l,sze,out_val)
integer :: i integer :: i
integer*8 :: hash integer*8 :: hash
double precision :: thresh double precision :: thresh
PROVIDE ao_bielec_integrals_in_map PROVIDE ao_bielec_integrals_in_map ao_integrals_map
thresh = ao_integrals_threshold thresh = ao_integrals_threshold
if (ao_overlap_abs(j,l) < thresh) then if (ao_overlap_abs(j,l) < thresh) then

1
src/Dets/SC2.irp.f
View File

@ -166,6 +166,7 @@ subroutine CISD_SC2(dets_in,u_in,energies,dim_in,sze,N_st,Nint,convergence)
!$OMP END DO !$OMP END DO
!$OMP END PARALLEL !$OMP END PARALLEL
PROVIDE n_states_diag h_matrix_all_dets
if(sze>sze_max)then 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) call davidson_diag_hjj(dets_in,u_in,H_jj_dressed,energies,dim_in,sze,N_st,Nint,output_Dets)
else else

2
src/Dets/slater_rules.irp.f
View File

@ -372,7 +372,7 @@ subroutine i_H_j(key_i,key_j,Nint,hij)
integer :: n_occ_alpha, n_occ_beta integer :: n_occ_alpha, n_occ_beta
logical :: has_mipi(Nint*bit_kind_size) logical :: has_mipi(Nint*bit_kind_size)
double precision :: mipi(Nint*bit_kind_size), miip(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 > 0)
ASSERT (Nint == N_int) ASSERT (Nint == N_int)

5
src/Full_CI/full_ci.irp.f
View File

@ -30,6 +30,11 @@ program full_ci
do while (N_det < n_det_max_fci.and.maxval(abs(pt2(1:N_st))) > pt2_max) 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) 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 if (N_det > n_det_max_fci) then
psi_det = psi_det_sorted psi_det = psi_det_sorted
psi_coef = psi_coef_sorted psi_coef = psi_coef_sorted

5
src/Nuclei/nuclei.irp.f
View File

@ -178,14 +178,15 @@ BEGIN_PROVIDER [ double precision, nuclear_repulsion ]
nuclear_repulsion = 0.d0 nuclear_repulsion = 0.d0
do l = 1, nucl_num do l = 1, nucl_num
do k = 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) Z12 = nucl_charge(k)*nucl_charge(l)
x(1) = nucl_coord(k,1) - nucl_coord(l,1) x(1) = nucl_coord(k,1) - nucl_coord(l,1)
x(2) = nucl_coord(k,2) - nucl_coord(l,2) x(2) = nucl_coord(k,2) - nucl_coord(l,2)
x(3) = nucl_coord(k,3) - nucl_coord(l,3) x(3) = nucl_coord(k,3) - nucl_coord(l,3)
r2 = x(1)*x(1) + x(2)*x(2) + x(3)*x(3) r2 = x(1)*x(1) + x(2)*x(2) + x(3)*x(3)
nuclear_repulsion += Z12/dsqrt(r2) nuclear_repulsion += Z12/dsqrt(r2)
endif
enddo enddo
enddo enddo
nuclear_repulsion *= 0.5d0 nuclear_repulsion *= 0.5d0

4
src/Perturbation/epstein_nesbet.irp.f
View File

@ -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 integer :: i,j
double precision :: diag_H_mat_elem, h double precision :: diag_H_mat_elem, h
PROVIDE selection_criterion
ASSERT (Nint == N_int) ASSERT (Nint == N_int)
ASSERT (Nint > 0) 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) 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 double precision :: diag_H_mat_elem,delta_e, h
ASSERT (Nint == N_int) ASSERT (Nint == N_int)
ASSERT (Nint > 0) 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) 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) h = diag_H_mat_elem(det_pert,Nint)
do i =1,N_st do i =1,N_st

2
src/Perturbation/pert_sc2.irp.f
View File

@ -204,6 +204,8 @@ subroutine pt2_epstein_nesbet_sc2(det_pert,c_pert,e_2_pert,H_pert_diag,Nint,ndet
integer :: i,j integer :: i,j
double precision :: diag_H_mat_elem, h double precision :: diag_H_mat_elem, h
PROVIDE selection_criterion
ASSERT (Nint == N_int) ASSERT (Nint == N_int)
ASSERT (Nint > 0) 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) call i_H_psi(det_pert,psi_selectors,psi_selectors_coef,Nint,N_det_selectors,psi_selectors_size,N_st,i_H_psi_array)

5
src/Perturbation/selection.irp.f
View File

@ -15,7 +15,7 @@ subroutine fill_H_apply_buffer_selection(n_selected,det_buffer,e_2_pert_buffer,c
integer :: new_size integer :: new_size
double precision :: s, smin, smax double precision :: s, smin, smax
logical :: is_selected logical :: is_selected
PROVIDE H_apply_buffer_allocated PROVIDE H_apply_buffer_allocated N_int
ASSERT (Nint > 0) ASSERT (Nint > 0)
ASSERT (N_int == N_int) ASSERT (N_int == N_int)
ASSERT (N_selected >= 0) ASSERT (N_selected >= 0)
@ -41,6 +41,7 @@ subroutine fill_H_apply_buffer_selection(n_selected,det_buffer,e_2_pert_buffer,c
enddo enddo
if (is_selected) then if (is_selected) then
l = l+1 l = l+1
do j=1,N_int do j=1,N_int
@ -90,6 +91,7 @@ subroutine remove_small_contributions
integer :: i,j,k, N_removed integer :: i,j,k, N_removed
logical, allocatable :: keep(:) logical, allocatable :: keep(:)
double precision :: i_H_psi_array(N_states) double precision :: i_H_psi_array(N_states)
allocate (keep(N_det)) allocate (keep(N_det))
call diagonalize_CI call diagonalize_CI
do i=1,N_det do i=1,N_det
@ -113,6 +115,7 @@ subroutine remove_small_contributions
N_removed = 0 N_removed = 0
k = 0 k = 0
do i=1, N_det do i=1, N_det
PROVIDE psi_coef psi_det psi_det_sorted psi_coef_sorted
if (keep(i)) then if (keep(i)) then
k += 1 k += 1
do j=1,N_int do j=1,N_int

1
src/Selectors_full/e_corr_selectors.irp.f
View File

@ -45,6 +45,7 @@ END_PROVIDER
! !
! coef_hf_selector = coefficient of the Hartree Fock determinant in the selectors determinants ! coef_hf_selector = coefficient of the Hartree Fock determinant in the selectors determinants
END_DOC END_DOC
PROVIDE ref_bitmask_energy psi_selectors ref_bitmask N_int psi_selectors
integer :: i,degree integer :: i,degree
double precision :: hij,diag_H_mat_elem double precision :: hij,diag_H_mat_elem
E_corr_double_only = 0.d0 E_corr_double_only = 0.d0