LCPQ/quantum_package
10
0
Fork 0
mirror of https://github.com/LCPQ/quantum_package synced 2024-11-03 20:54:00 +01:00
Code Issues Releases Wiki Activity

Added Schrwartz screening

Browse Source
This commit is contained in:
Anthony Scemama 2014-09-19 11:35:53 +02:00
parent 1316735589
commit 3918134a4f
2 changed files with 16 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
src/BiInts/ao_bi_integrals.irp.f
View File

@ -215,6 +215,7 @@ BEGIN_PROVIDER [ logical, ao_bielec_integrals_in_map ]
integer :: jl_pairs(2,ao_num*(ao_num+1)/2), kk, m, j1, i1, lmax
PROVIDE gauleg_t2 ao_integrals_map all_utils
PROVIDE ao_bielec_integral_schwartz
integral = ao_bielec_integral(1,1,1,1)
real :: map_mb

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

@ -62,8 +62,14 @@ double precision function get_ao_bielec_integral(i,j,k,l,map)
real(integral_kind) :: tmp
PROVIDE ao_bielec_integrals_in_map
!DIR$ FORCEINLINE
if (ao_overlap_abs(i,k)*ao_overlap_abs(j,l) < ao_integrals_threshold ) then
tmp = 0.d0
else if (ao_bielec_integral_schwartz(i,k)*ao_bielec_integral_schwartz(j,l) < ao_integrals_threshold) then
tmp = 0.d0
else
call bielec_integrals_index(i,j,k,l,idx)
call map_get(map,idx,tmp)
endif
get_ao_bielec_integral = tmp
end
@ -92,6 +98,8 @@ subroutine get_ao_bielec_integrals(j,k,l,sze,out_val)
do i=1,sze
if (ao_overlap_abs(i,k)*ao_overlap_abs(j,l) < thresh ) then
out_val(i) = 0.d0
else if (ao_bielec_integral_schwartz(i,k)*ao_bielec_integral_schwartz(j,l) < thresh) then
out_val(i)=0.d0
else
!DIR$ FORCEINLINE
call bielec_integrals_index(i,j,k,l,hash)
@ -126,7 +134,12 @@ subroutine get_ao_bielec_integrals_non_zero(j,k,l,sze,out_val,out_val_index,non_
non_zero_int = 0
do i=1,sze
integer, external :: ao_l4
double precision, external :: ao_bielec_integral
!DIR$ FORCEINLINE
if (ao_bielec_integral_schwartz(i,k)*ao_bielec_integral_schwartz(j,l) < thresh) then
cycle
endif
call bielec_integrals_index(i,j,k,l,hash)
call map_get(ao_integrals_map, hash,tmp)
if (dabs(tmp) < thresh ) cycle