LCPQ
/
qp2
mirror of https://github.com/QuantumPackage/qp2.git
9
1
Fork 0
Code Releases Activity

Introduced screening.irp.f

This commit is contained in:
Anthony Scemama 2020-05-12 18:48:51 +02:00
parent 4699ad5822
commit 08089a4dad
9 changed files with 81 additions and 50 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
src/ao_one_e_ints/screening.irp.f Normal file
View File

@ -0,0 +1,16 @@
logical function ao_one_e_integral_zero(i,k)
implicit none
integer, intent(in) :: i,k
ao_one_e_integral_zero = .False.
if (.not.(read_ao_one_e_integrals.or.is_periodic)) then
if (ao_overlap_abs(i,k) < ao_integrals_threshold) then
ao_one_e_integral_zero = .True.
return
endif
endif
if (ao_two_e_integral_schwartz(i,k) < ao_integrals_threshold) then
ao_one_e_integral_zero = .True.
endif
end

9
src/ao_two_e_erf_ints/map_integrals_erf.irp.f
View File

@ -85,9 +85,10 @@ double precision function get_ao_two_e_integral_erf(i,j,k,l,map) result(result)
type(map_type), intent(inout) :: map
integer :: ii
real(integral_kind) :: tmp
logical, external :: ao_two_e_integral_zero
PROVIDE ao_two_e_integrals_erf_in_map ao_integrals_erf_cache ao_integrals_erf_cache_min
!DIR$ FORCEINLINE
if (ao_overlap_abs(i,k)*ao_overlap_abs(j,l) < ao_integrals_threshold ) then
if (ao_two_e_integral_zero(i,j,k,l) < ao_integrals_threshold ) then
tmp = 0.d0
else if (ao_two_e_integral_erf_schwartz(i,k)*ao_two_e_integral_erf_schwartz(j,l) < ao_integrals_threshold) then
tmp = 0.d0
@ -127,10 +128,11 @@ subroutine get_ao_two_e_integrals_erf(j,k,l,sze,out_val)
integer :: i
integer(key_kind) :: hash
double precision :: thresh
logical, external :: ao_one_e_integral_zero
PROVIDE ao_two_e_integrals_erf_in_map ao_integrals_erf_map
thresh = ao_integrals_threshold
if (ao_overlap_abs(j,l) < thresh) then
if (ao_one_e_integral_zero(j,l)) then
out_val = 0.d0
return
endif
@ -156,11 +158,12 @@ subroutine get_ao_two_e_integrals_erf_non_zero(j,k,l,sze,out_val,out_val_index,n
integer :: i
integer(key_kind) :: hash
double precision :: thresh,tmp
logical, external :: ao_one_e_integral_zero
PROVIDE ao_two_e_integrals_erf_in_map
thresh = ao_integrals_threshold
non_zero_int = 0
if (ao_overlap_abs(j,l) < thresh) then
if (ao_one_e_integral_zero(j,l)) then
out_val = 0.d0
return
endif

9
src/ao_two_e_erf_ints/two_e_integrals_erf.irp.f
View File

@ -291,8 +291,10 @@ subroutine compute_ao_two_e_integrals_erf(j,k,l,sze,buffer_value)
double precision :: ao_two_e_integral_erf
integer :: i
logical, external :: ao_one_e_integral_zero
logical, external :: ao_two_e_integral_zero
if (ao_overlap_abs(j,l) < thresh) then
if (ao_one_e_integral_zero(j,l)) then
buffer_value = 0._integral_kind
return
endif
@ -302,7 +304,7 @@ subroutine compute_ao_two_e_integrals_erf(j,k,l,sze,buffer_value)
endif
do i = 1, ao_num
if (ao_overlap_abs(i,k)*ao_overlap_abs(j,l) < thresh) then
if (ao_two_e_integral_zero(i,j,k,l)) then
buffer_value(i) = 0._integral_kind
cycle
endif
@ -618,6 +620,7 @@ subroutine compute_ao_integrals_erf_jl(j,l,n_integrals,buffer_i,buffer_value)
double precision :: integral, wall_0
double precision :: thr
integer :: kk, m, j1, i1
logical, external :: ao_two_e_integral_zero
thr = ao_integrals_threshold
@ -634,7 +637,7 @@ subroutine compute_ao_integrals_erf_jl(j,l,n_integrals,buffer_i,buffer_value)
if (i1 > j1) then
exit
endif
if (ao_overlap_abs(i,k)*ao_overlap_abs(j,l) < thr) then
if (ao_two_e_integral_zero(i,j,k,l)) then
cycle
endif
if (ao_two_e_integral_erf_schwartz(i,k)*ao_two_e_integral_erf_schwartz(j,l) < thr ) then

43
src/ao_two_e_ints/map_integrals.irp.f
View File

@ -333,11 +333,10 @@ double precision function get_ao_two_e_integral(i,j,k,l,map) result(result)
type(map_type), intent(inout) :: map
integer :: ii
real(integral_kind) :: tmp
logical, external :: ao_two_e_integral_zero
PROVIDE ao_two_e_integrals_in_map ao_integrals_cache ao_integrals_cache_min
!DIR$ FORCEINLINE
if (ao_overlap_abs(i,k)*ao_overlap_abs(j,l) < ao_integrals_threshold ) then
tmp = 0.d0
else if (ao_two_e_integral_schwartz(i,k)*ao_two_e_integral_schwartz(j,l) < ao_integrals_threshold) then
if (ao_two_e_integral_zero(i,j,k,l)) then
tmp = 0.d0
else
ii = l-ao_integrals_cache_min
@ -427,9 +426,8 @@ complex*16 function get_ao_two_e_integral_periodic(i,j,k,l,map) result(result)
complex(integral_kind) :: tmp
PROVIDE ao_two_e_integrals_in_map ao_integrals_cache_periodic ao_integrals_cache_min
!DIR$ FORCEINLINE
if (ao_overlap_abs(i,k)*ao_overlap_abs(j,l) < ao_integrals_threshold ) then
tmp = (0.d0,0.d0)
else if (ao_two_e_integral_schwartz(i,k)*ao_two_e_integral_schwartz(j,l) < ao_integrals_threshold) then
logical, external :: ao_two_e_integral_zero
if (ao_two_e_integral_zero(i,j,k,l)) then
tmp = (0.d0,0.d0)
else
ii = l-ao_integrals_cache_min
@ -481,11 +479,10 @@ subroutine get_ao_two_e_integrals(j,k,l,sze,out_val)
integer :: i
integer(key_kind) :: hash
double precision :: thresh
logical, external :: ao_one_e_integral_zero
PROVIDE ao_two_e_integrals_in_map ao_integrals_map
thresh = ao_integrals_threshold
if (ao_overlap_abs(j,l) < thresh) then
if (ao_one_e_integral_zero(j,l)) then
out_val = 0.d0
return
endif
@ -511,11 +508,10 @@ subroutine get_ao_two_e_integrals_periodic(j,k,l,sze,out_val)
integer :: i
integer(key_kind) :: hash
double precision :: thresh
logical, external :: ao_one_e_integral_zero
PROVIDE ao_two_e_integrals_in_map ao_integrals_map
thresh = ao_integrals_threshold
if (ao_overlap_abs(j,l) < thresh) then
if (ao_one_e_integral_zero(j,l)) then
out_val = 0.d0
return
endif
@ -540,12 +536,13 @@ subroutine get_ao_two_e_integrals_non_zero(j,k,l,sze,out_val,out_val_index,non_z
integer :: i
integer(key_kind) :: hash
double precision :: thresh,tmp
double precision :: tmp
logical, external :: ao_one_e_integral_zero
logical, external :: ao_two_e_integral_zero
PROVIDE ao_two_e_integrals_in_map
thresh = ao_integrals_threshold
non_zero_int = 0
if (ao_overlap_abs(j,l) < thresh) then
if (ao_one_e_integral_zero(j,l)) then
out_val = 0.d0
return
endif
@ -555,12 +552,12 @@ subroutine get_ao_two_e_integrals_non_zero(j,k,l,sze,out_val,out_val_index,non_z
integer, external :: ao_l4
double precision, external :: ao_two_e_integral
!DIR$ FORCEINLINE
if (ao_two_e_integral_schwartz(i,k)*ao_two_e_integral_schwartz(j,l) < thresh) then
if (ao_two_e_integral_zero(i,j,k,l)) then
cycle
endif
call two_e_integrals_index(i,j,k,l,hash)
call map_get(ao_integrals_map, hash,tmp)
if (dabs(tmp) < thresh ) cycle
if (dabs(tmp) < ao_integrals_threshold) cycle
non_zero_int = non_zero_int+1
out_val_index(non_zero_int) = i
out_val(non_zero_int) = tmp
@ -584,10 +581,12 @@ subroutine get_ao_two_e_integrals_non_zero_jl(j,l,thresh,sze_max,sze,out_val,out
integer :: i,k
integer(key_kind) :: hash
double precision :: tmp
logical, external :: ao_one_e_integral_zero
logical, external :: ao_two_e_integral_zero
PROVIDE ao_two_e_integrals_in_map
non_zero_int = 0
if (ao_overlap_abs(j,l) < thresh) then
if (ao_one_e_integral_zero(j,l)) then
out_val = 0.d0
return
endif
@ -598,7 +597,7 @@ subroutine get_ao_two_e_integrals_non_zero_jl(j,l,thresh,sze_max,sze,out_val,out
integer, external :: ao_l4
double precision, external :: ao_two_e_integral
!DIR$ FORCEINLINE
if (ao_two_e_integral_schwartz(i,k)*ao_two_e_integral_schwartz(j,l) < thresh) then
if (ao_two_e_integral_zero(i,j,k,l)) then
cycle
endif
call two_e_integrals_index(i,j,k,l,hash)
@ -630,10 +629,12 @@ subroutine get_ao_two_e_integrals_non_zero_jl_from_list(j,l,thresh,list,n_list,s
integer :: i,k
integer(key_kind) :: hash
double precision :: tmp
logical, external :: ao_one_e_integral_zero
logical, external :: ao_two_e_integral_zero
PROVIDE ao_two_e_integrals_in_map
non_zero_int = 0
if (ao_overlap_abs(j,l) < thresh) then
if (ao_one_e_integral_zero(j,l)) then
out_val = 0.d0
return
endif
@ -646,7 +647,7 @@ subroutine get_ao_two_e_integrals_non_zero_jl_from_list(j,l,thresh,list,n_list,s
integer, external :: ao_l4
double precision, external :: ao_two_e_integral
!DIR$ FORCEINLINE
if (ao_two_e_integral_schwartz(i,k)*ao_two_e_integral_schwartz(j,l) < thresh) then
if (ao_two_e_integral_zero(i,j,k,l)) then
cycle
endif
call two_e_integrals_index(i,j,k,l,hash)

15
src/ao_two_e_ints/screening.irp.f Normal file
View File

@ -0,0 +1,15 @@
logical function ao_two_e_integral_zero(i,j,k,l)
implicit none
integer, intent(in) :: i,j,k,l
ao_two_e_integral_zero = .False.
if (.not.(read_ao_two_e_integrals.or.is_periodic)) then
if (ao_overlap_abs(j,l)*ao_overlap_abs(i,k) < ao_integrals_threshold) then
ao_two_e_integral_zero = .True.
return
endif
endif
if (ao_two_e_integral_schwartz(j,l)*ao_two_e_integral_schwartz(i,k) < ao_integrals_threshold) then
ao_two_e_integral_zero = .True.
endif
end

21
src/ao_two_e_ints/two_e_integrals.irp.f
View File

@ -300,22 +300,17 @@ subroutine compute_ao_two_e_integrals(j,k,l,sze,buffer_value)
double precision :: ao_two_e_integral
integer :: i
logical, external :: ao_one_e_integral_zero
logical, external :: ao_two_e_integral_zero
if (ao_overlap_abs(j,l) < thresh) then
buffer_value = 0._integral_kind
return
endif
if (ao_two_e_integral_schwartz(j,l) < thresh ) then
if (ao_one_e_integral_zero(j,l)) then
buffer_value = 0._integral_kind
return
endif
do i = 1, ao_num
if (ao_overlap_abs(i,k)*ao_overlap_abs(j,l) < thresh) then
buffer_value(i) = 0._integral_kind
cycle
endif
if (ao_two_e_integral_schwartz(i,k)*ao_two_e_integral_schwartz(j,l) < thresh ) then
if (ao_two_e_integral_zero(i,j,k,l)) then
buffer_value(i) = 0._integral_kind
cycle
endif
@ -1173,6 +1168,7 @@ subroutine compute_ao_integrals_jl(j,l,n_integrals,buffer_i,buffer_value)
double precision :: integral, wall_0
double precision :: thr
integer :: kk, m, j1, i1
logical, external :: ao_two_e_integral_zero
thr = ao_integrals_threshold
@ -1189,10 +1185,7 @@ subroutine compute_ao_integrals_jl(j,l,n_integrals,buffer_i,buffer_value)
if (i1 > j1) then
exit
endif
if (ao_overlap_abs(i,k)*ao_overlap_abs(j,l) < thr) then
cycle
endif
if (ao_two_e_integral_schwartz(i,k)*ao_two_e_integral_schwartz(j,l) < thr ) then
if (ao_two_e_integral_zero(i,j,k,l)) then
cycle
endif
!DIR$ FORCEINLINE

6
src/hartree_fock/fock_matrix_hf.irp.f
View File

@ -25,7 +25,7 @@
!$OMP local_threshold)&
!$OMP SHARED(ao_num,SCF_density_matrix_ao_alpha,SCF_density_matrix_ao_beta,&
!$OMP ao_integrals_map,ao_integrals_threshold, ao_two_e_integral_schwartz, &
!$OMP ao_overlap_abs, ao_two_e_integral_alpha, ao_two_e_integral_beta)
!$OMP ao_two_e_integral_alpha, ao_two_e_integral_beta)
allocate(keys(1), values(1))
allocate(ao_two_e_integral_alpha_tmp(ao_num,ao_num), &
@ -48,8 +48,8 @@
l = ll(1)
j = jj(1)
if (ao_overlap_abs(k,l)*ao_overlap_abs(i,j) &
< ao_integrals_threshold) then
logical, external :: ao_two_e_integral_zero
if (ao_two_e_integral_zero(i,k,j,l)) then
cycle
endif
local_threshold = ao_two_e_integral_schwartz(k,l)*ao_two_e_integral_schwartz(i,j)

6
src/kohn_sham/fock_matrix_ks.irp.f
View File

@ -28,7 +28,7 @@
!$OMP local_threshold)&
!$OMP SHARED(ao_num,SCF_density_matrix_ao_alpha,SCF_density_matrix_ao_beta,&
!$OMP ao_integrals_map,ao_integrals_threshold, ao_two_e_integral_schwartz, &
!$OMP ao_overlap_abs, ao_two_e_integral_alpha, ao_two_e_integral_beta)
!$OMP ao_two_e_integral_alpha, ao_two_e_integral_beta)
allocate(keys(1), values(1))
allocate(ao_two_e_integral_alpha_tmp(ao_num,ao_num), &
@ -51,8 +51,8 @@
l = ll(1)
j = jj(1)
if (ao_overlap_abs(k,l)*ao_overlap_abs(i,j) &
< ao_integrals_threshold) then
logical, external :: ao_two_e_integral_zero
if (ao_two_e_integral_zero(i,k,j,l)) then
cycle
endif
local_threshold = ao_two_e_integral_schwartz(k,l)*ao_two_e_integral_schwartz(i,j)

6
src/kohn_sham_rs/fock_matrix_rs_ks.irp.f
View File

@ -26,7 +26,7 @@
!$OMP local_threshold)&
!$OMP SHARED(ao_num,SCF_density_matrix_ao_alpha,SCF_density_matrix_ao_beta,&
!$OMP ao_integrals_map,ao_integrals_threshold, ao_two_e_integral_schwartz, &
!$OMP ao_overlap_abs, ao_two_e_integral_alpha, ao_two_e_integral_beta)
!$OMP ao_two_e_integral_alpha, ao_two_e_integral_beta)
allocate(keys(1), values(1))
allocate(ao_two_e_integral_alpha_tmp(ao_num,ao_num), &
@ -49,8 +49,8 @@
l = ll(1)
j = jj(1)
if (ao_overlap_abs(k,l)*ao_overlap_abs(i,j) &
< ao_integrals_threshold) then
logical, external :: ao_two_e_integral_zero
if (ao_two_e_integral_zero(i,k,j,l)) then
cycle
endif
local_threshold = ao_two_e_integral_schwartz(k,l)*ao_two_e_integral_schwartz(i,j)