LCPQ/qp2
9
1
Fork 0
mirror of https://github.com/QuantumPackage/qp2.git synced 2024-11-09 06:53:38 +01:00
Code Releases Activity

trying to prune grid points per AO couples

Browse Source
This commit is contained in:
eginer 2022-12-12 16:49:31 +01:00
parent ce79917152
commit 23ec3ba18a
11 changed files with 424 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

47
src/ao_many_one_e_ints/ao_gaus_gauss.irp.f
View File

@ -156,6 +156,53 @@ end function overlap_gauss_r12_ao
! --
double precision function overlap_abs_gauss_r12_ao(D_center, delta, i, j)
BEGIN_DOC
! \int dr AO_i(r) AO_j(r) e^{-delta |r-D_center|^2}
END_DOC
implicit none
integer, intent(in) :: i, j
double precision, intent(in) :: D_center(3), delta
integer :: power_A(3), power_B(3), l, k
double precision :: A_center(3), B_center(3), alpha, beta, coef, coef1, analytical_j
double precision, external :: overlap_abs_gauss_r12
overlap_abs_gauss_r12_ao = 0.d0
if(ao_overlap_abs(j,i).lt.1.d-12) then
return
endif
power_A(1:3) = ao_power(i,1:3)
power_B(1:3) = ao_power(j,1:3)
A_center(1:3) = nucl_coord(ao_nucl(i),1:3)
B_center(1:3) = nucl_coord(ao_nucl(j),1:3)
do l = 1, ao_prim_num(i)
alpha = ao_expo_ordered_transp (l,i)
coef1 = ao_coef_normalized_ordered_transp(l,i)
do k = 1, ao_prim_num(j)
beta = ao_expo_ordered_transp(k,j)
coef = coef1 * ao_coef_normalized_ordered_transp(k,j)
if(dabs(coef) .lt. 1d-12) cycle
analytical_j = overlap_abs_gauss_r12(D_center, delta, A_center, B_center, power_A, power_B, alpha, beta)
overlap_abs_gauss_r12_ao += dabs(coef * analytical_j)
enddo
enddo
end function overlap_gauss_r12_ao
! --
subroutine overlap_gauss_r12_ao_v(D_center, LD_D, delta, i, j, resv, LD_resv, n_points)
BEGIN_DOC

99
src/ao_many_one_e_ints/grad_lapl_jmu_manu.irp.f
View File

@ -94,9 +94,9 @@ BEGIN_PROVIDER [ double precision, x_v_ij_erf_rk_cst_mu_j1b_test, (ao_num, ao_nu
do ipoint = 1, n_points_final_grid
do i = 1, ao_num
do j = 1, ao_num
x_v_ij_erf_rk_cst_mu_j1b_test(j,i,ipoint,1) = x_v_ij_erf_rk_cst_mu_tmp_j1b(1,j,i,ipoint)
x_v_ij_erf_rk_cst_mu_j1b_test(j,i,ipoint,2) = x_v_ij_erf_rk_cst_mu_tmp_j1b(2,j,i,ipoint)
x_v_ij_erf_rk_cst_mu_j1b_test(j,i,ipoint,3) = x_v_ij_erf_rk_cst_mu_tmp_j1b(3,j,i,ipoint)
x_v_ij_erf_rk_cst_mu_j1b_test(j,i,ipoint,1) = x_v_ij_erf_rk_cst_mu_tmp_j1b_test(1,j,i,ipoint)
x_v_ij_erf_rk_cst_mu_j1b_test(j,i,ipoint,2) = x_v_ij_erf_rk_cst_mu_tmp_j1b_test(2,j,i,ipoint)
x_v_ij_erf_rk_cst_mu_j1b_test(j,i,ipoint,3) = x_v_ij_erf_rk_cst_mu_tmp_j1b_test(3,j,i,ipoint)
enddo
enddo
enddo
@ -285,3 +285,96 @@ END_PROVIDER
! ---
BEGIN_PROVIDER [ double precision, v_ij_u_cst_mu_j1b_ng_1_test, (ao_num, ao_num, n_points_final_grid)]
BEGIN_DOC
!
! int dr2 phi_i(r2) phi_j(r2) 1s_j1b(r2) u(mu, r12) with u(mu,r12) \approx 1/2 mu e^{-2.5 * mu (r12)^2}
!
END_DOC
implicit none
integer :: i, j, ipoint, i_1s
double precision :: r(3), int_fit, expo_fit, coef_fit
double precision :: coef, beta, B_center(3)
double precision :: tmp
double precision :: wall0, wall1
double precision, external :: overlap_gauss_r12_ao_with1s
double precision :: sigma_ij,dist_ij_ipoint,dsqpi_3_2,int_j1b
dsqpi_3_2 = (dacos(-1.d0))**(3/2)
provide mu_erf final_grid_points j1b_pen
call wall_time(wall0)
v_ij_u_cst_mu_j1b_ng_1_test = 0.d0
!$OMP PARALLEL DEFAULT (NONE) &
!$OMP PRIVATE (ipoint, i, j, i_1s, r, coef, beta, B_center, &
!$OMP beta_ij_u, factor_ij_1s_u, center_ij_1s_u, &
!$OMP coef_fit, expo_fit, int_fit, tmp,coeftot,int_j1b) &
!$OMP SHARED (n_points_final_grid, ao_num, &
!$OMP final_grid_points, expo_good_j_mu_1gauss,coef_good_j_mu_1gauss, &
!$OMP expo_gauss_j_mu_x, coef_gauss_j_mu_x, &
!$OMP List_comb_thr_b2_coef, List_comb_thr_b2_expo,List_comb_thr_b2_size, &
!$OMP List_comb_thr_b2_cent, v_ij_u_cst_mu_j1b_ng_1_test,ao_abs_comb_b2_j1b, &
!$OMP ao_overlap_abs_grid,ao_prod_center,ao_prod_sigma,dsqpi_3_2)
!$OMP DO
!do ipoint = 1, 10
do ipoint = 1, n_points_final_grid
r(1) = final_grid_points(1,ipoint)
r(2) = final_grid_points(2,ipoint)
r(3) = final_grid_points(3,ipoint)
do i = 1, ao_num
do j = i, ao_num
if(dabs(ao_overlap_abs_grid(j,i)).lt.1.d-20)cycle
tmp = 0.d0
do i_1s = 1, List_comb_thr_b2_size(j,i)
coef = List_comb_thr_b2_coef (i_1s,j,i)
beta = List_comb_thr_b2_expo (i_1s,j,i)
int_j1b = ao_abs_comb_b2_j1b(i_1s,j,i)
if(dabs(coef)*dabs(int_j1b).lt.1.d-10)cycle
B_center(1) = List_comb_thr_b2_cent(1,i_1s,j,i)
B_center(2) = List_comb_thr_b2_cent(2,i_1s,j,i)
B_center(3) = List_comb_thr_b2_cent(3,i_1s,j,i)
! do i_fit = 1, ng_fit_jast
expo_fit = expo_good_j_mu_1gauss
coef_fit = 1.d0
coeftot = coef * coef_fit
if(dabs(coeftot).lt.1.d-15)cycle
double precision :: beta_ij_u, factor_ij_1s_u, center_ij_1s_u(3),coeftot
call gaussian_product(beta,B_center,expo_fit,r,factor_ij_1s_u,beta_ij_u,center_ij_1s_u)
if(factor_ij_1s_u*ao_overlap_abs_grid(j,i).lt.1.d-15)cycle
int_fit = overlap_gauss_r12_ao_with1s(B_center, beta, r, expo_fit, i, j)
tmp += coef * coef_fit * int_fit
! enddo
enddo
v_ij_u_cst_mu_j1b_ng_1_test(j,i,ipoint) = tmp
enddo
enddo
enddo
!$OMP END DO
!$OMP END PARALLEL
do ipoint = 1, n_points_final_grid
do i = 2, ao_num
do j = 1, i-1
v_ij_u_cst_mu_j1b_ng_1_test(j,i,ipoint) = v_ij_u_cst_mu_j1b_ng_1_test(i,j,ipoint)
enddo
enddo
enddo
call wall_time(wall1)
print*, ' wall time for v_ij_u_cst_mu_j1b_ng_1_test', wall1 - wall0
END_PROVIDER
! ---

59
src/ao_many_one_e_ints/list_grid.irp.f Normal file
View File

@ -0,0 +1,59 @@
BEGIN_PROVIDER [ integer, n_pts_grid_ao_prod, (ao_num, ao_num)]
&BEGIN_PROVIDER [ integer, max_n_pts_grid_ao_prod]
implicit none
integer :: i,j,ipoint
double precision :: overlap, r(3),thr, overlap_abs_gauss_r12_ao,overlap_gauss_r12_ao
double precision :: sigma,dist,center_ij(3),fact_gauss, alpha, center(3)
n_pts_grid_ao_prod = 0
thr = 1.d-11
print*,' expo_good_j_mu_1gauss = ',expo_good_j_mu_1gauss
!$OMP PARALLEL DEFAULT (NONE) &
!$OMP PRIVATE (ipoint, i, j, r, overlap, thr,fact_gauss, alpha, center,dist,sigma,center_ij) &
!$OMP SHARED (n_points_final_grid, ao_num, ao_overlap_abs_grid,n_pts_grid_ao_prod,expo_good_j_mu_1gauss,&
!$OMP final_grid_points,ao_prod_center,ao_prod_sigma,ao_nucl)
!$OMP DO
do i = 1, ao_num
! do i = 3,3
do j = 1, ao_num
! do i = 22,22
! do j = 9,9
center_ij(1:3) = ao_prod_center(1:3,j,i)
sigma = ao_prod_sigma(j,i)
sigma *= sigma
sigma = 0.5d0 /sigma
! if(dabs(ao_overlap_abs_grid(j,i)).lt.1.d-10)cycle
do ipoint = 1, n_points_final_grid
r(1) = final_grid_points(1,ipoint)
r(2) = final_grid_points(2,ipoint)
r(3) = final_grid_points(3,ipoint)
dist = (center_ij(1) - r(1))*(center_ij(1) - r(1))
dist += (center_ij(2) - r(2))*(center_ij(2) - r(2))
dist += (center_ij(3) - r(3))*(center_ij(3) - r(3))
dist = dsqrt(dist)
call gaussian_product(sigma, center_ij, expo_good_j_mu_1gauss, r, fact_gauss, alpha, center)
! print*,''
! print*,j,i,ao_overlap_abs_grid(j,i),ao_overlap_abs(j,i)
! print*,r
! print*,dist,sigma
! print*,fact_gauss
if( fact_gauss*ao_overlap_abs_grid(j,i).lt.1.d-11)cycle
if(ao_nucl(i) == ao_nucl(j))then
overlap = overlap_abs_gauss_r12_ao(r, expo_good_j_mu_1gauss, i, j)
else
overlap = overlap_gauss_r12_ao(r, expo_good_j_mu_1gauss, i, j)
endif
! print*,overlap
if(dabs(overlap).lt.thr)cycle
n_pts_grid_ao_prod(j,i) += 1
enddo
enddo
enddo
!$OMP END DO
!$OMP END PARALLEL
integer :: list(ao_num)
do i = 1, ao_num
list(i) = maxval(n_pts_grid_ao_prod(:,i))
enddo
max_n_pts_grid_ao_prod = maxval(list)
END_PROVIDER

2
src/ao_many_one_e_ints/listj1b_sorted.irp.f
View File

@ -116,7 +116,7 @@ END_PROVIDER
dist = ( center(1) - r(1) )*( center(1) - r(1) )
dist += ( center(2) - r(2) )*( center(2) - r(2) )
dist += ( center(3) - r(3) )*( center(3) - r(3) )
int_j1b += dabs(aos_in_r_array_transp(ipoint,i) * aos_in_r_array_transp(ipoint,j))*dexp(-beta*dist) * weight
int_j1b += dabs(aos_in_r_array_extra_transp(ipoint,i) * aos_in_r_array_extra_transp(ipoint,j))*dexp(-beta*dist) * weight
enddo
if(dabs(coef)*dabs(int_j1b).gt.thr)then
List_comb_thr_b3_size(j,i) += 1

68
src/ao_many_one_e_ints/prim_int_gauss_gauss.irp.f
View File

@ -26,14 +26,16 @@ double precision function overlap_gauss_r12(D_center,delta,A_center,B_center,pow
dim1=100
thr = 1.d-10
d(:) = 0 ! order of the polynom for the gaussian exp(-delta (r - D)^2 ) == 0
overlap_gauss_r12 = 0.d0
! New gaussian/polynom defined by :: new pol new center new expo cst fact new order
call give_explicit_poly_and_gaussian(A_new , A_center_new , alpha_new, fact_a_new , iorder_a_new ,&
delta,alpha,d,power_A,D_center,A_center,n_pt_max_integrals)
if(fact_a_new.lt.thr)return
! The new gaussian exp(-delta (r - D)^2 ) (x-A_x)^a \exp(-\alpha (x-A_x)^2
accu = 0.d0
do lx = 0, iorder_a_new(1)
coefx = A_new(lx,1)
coefx = A_new(lx,1)*fact_a_new
if(dabs(coefx).lt.thr)cycle
iorder_tmp(1) = lx
do ly = 0, iorder_a_new(2)
@ -51,7 +53,69 @@ double precision function overlap_gauss_r12(D_center,delta,A_center,B_center,pow
enddo
enddo
enddo
overlap_gauss_r12 = fact_a_new * accu
overlap_gauss_r12 = accu
end
!---
double precision function overlap_abs_gauss_r12(D_center,delta,A_center,B_center,power_A,power_B,alpha,beta)
BEGIN_DOC
! Computes the following integral :
!
! .. math ::
!
! \int dr exp(-delta (r - D)^2 ) |(x-A_x)^a (x-B_x)^b \exp(-\alpha (x-A_x)^2 - \beta (x-B_x)^2 )|
!
END_DOC
implicit none
include 'constants.include.F'
double precision, intent(in) :: D_center(3), delta ! pure gaussian "D"
double precision, intent(in) :: A_center(3),B_center(3),alpha,beta ! gaussian/polynoms "A" and "B"
integer, intent(in) :: power_A(3),power_B(3)
double precision :: overlap_x,overlap_y,overlap_z,overlap
! First you multiply the usual gaussian "A" with the gaussian exp(-delta (r - D)^2 )
double precision :: A_new(0:max_dim,3)! new polynom
double precision :: A_center_new(3) ! new center
integer :: iorder_a_new(3) ! i_order(i) = order of the new polynom ==> should be equal to power_A
double precision :: alpha_new ! new exponent
double precision :: fact_a_new ! constant factor
double precision :: accu,coefx,coefy,coefz,coefxy,coefxyz,thr,dx,lower_exp_val
integer :: d(3),i,lx,ly,lz,iorder_tmp(3),dim1
dim1=50
lower_exp_val = 40.d0
thr = 1.d-12
d(:) = 0 ! order of the polynom for the gaussian exp(-delta (r - D)^2 ) == 0
overlap_abs_gauss_r12 = 0.d0
! New gaussian/polynom defined by :: new pol new center new expo cst fact new order
call give_explicit_poly_and_gaussian(A_new , A_center_new , alpha_new, fact_a_new , iorder_a_new ,&
delta,alpha,d,power_A,D_center,A_center,n_pt_max_integrals)
if(fact_a_new.lt.thr)return
! The new gaussian exp(-delta (r - D)^2 ) (x-A_x)^a \exp(-\alpha (x-A_x)^2
accu = 0.d0
do lx = 0, iorder_a_new(1)
coefx = A_new(lx,1)*fact_a_new
! if(dabs(coefx).lt.thr)cycle
iorder_tmp(1) = lx
do ly = 0, iorder_a_new(2)
coefy = A_new(ly,2)
coefxy = coefx * coefy
if(dabs(coefxy).lt.thr)cycle
iorder_tmp(2) = ly
do lz = 0, iorder_a_new(3)
coefz = A_new(lz,3)
coefxyz = coefxy * coefz
if(dabs(coefxyz).lt.thr)cycle
iorder_tmp(3) = lz
call overlap_x_abs(A_center_new(1),B_center(1),alpha_new,beta,iorder_tmp(1),power_B(1),overlap_x,lower_exp_val,dx,dim1)
call overlap_x_abs(A_center_new(2),B_center(2),alpha_new,beta,iorder_tmp(2),power_B(2),overlap_y,lower_exp_val,dx,dim1)
call overlap_x_abs(A_center_new(3),B_center(3),alpha_new,beta,iorder_tmp(3),power_B(3),overlap_z,lower_exp_val,dx,dim1)
accu += dabs(coefxyz * overlap_x * overlap_y * overlap_z)
enddo
enddo
enddo
overlap_abs_gauss_r12= accu
end
!---

25
src/ao_tc_eff_map/fit_j.irp.f
View File

@ -1,5 +1,30 @@
BEGIN_PROVIDER [ double precision, expo_j_xmu_1gauss ]
&BEGIN_PROVIDER [ double precision, coef_j_xmu_1gauss ]
implicit none
BEGIN_DOC
! Upper bound long range fit of F(x) = x * (1 - erf(x)) - 1/sqrt(pi) * exp(-x**2)
!
! with a single gaussian.
!
! Such a function can be used to screen integrals with F(x).
END_DOC
expo_j_xmu_1gauss = 0.5d0
coef_j_xmu_1gauss = 1.d0
END_PROVIDER
! ---
BEGIN_PROVIDER [ double precision, expo_good_j_mu_1gauss ]
&BEGIN_PROVIDER [ double precision, coef_good_j_mu_1gauss ]
implicit none
BEGIN_DOC
! exponent of Gaussian in order to obtain an upper bound of J(r12,mu)
!
! Can be used to scree integrals with J(r12,mu)
END_DOC
expo_good_j_mu_1gauss = 2.D0 * mu_erf * expo_j_xmu_1gauss
coef_good_j_mu_1gauss = 0.5d0/mu_erf * coef_j_xmu_1gauss
END_PROVIDER
BEGIN_PROVIDER [ double precision, expo_j_xmu, (n_fit_1_erf_x) ]
implicit none
BEGIN_DOC

30
src/bi_ort_ints/semi_num_ints_mo.irp.f
View File

@ -108,15 +108,27 @@ BEGIN_PROVIDER [ double precision, int2_grad1_u12_ao_transp, (ao_num, ao_num, 3,
double precision :: wall0, wall1
call wall_time(wall0)
do ipoint = 1, n_points_final_grid
do i = 1, ao_num
do j = 1, ao_num
int2_grad1_u12_ao_transp(j,i,1,ipoint) = int2_grad1_u12_ao(1,j,i,ipoint)
int2_grad1_u12_ao_transp(j,i,2,ipoint) = int2_grad1_u12_ao(2,j,i,ipoint)
int2_grad1_u12_ao_transp(j,i,3,ipoint) = int2_grad1_u12_ao(3,j,i,ipoint)
enddo
enddo
enddo
if(test_cycle_tc)then
do ipoint = 1, n_points_final_grid
do i = 1, ao_num
do j = 1, ao_num
int2_grad1_u12_ao_transp(j,i,1,ipoint) = int2_grad1_u12_ao_test(1,j,i,ipoint)
int2_grad1_u12_ao_transp(j,i,2,ipoint) = int2_grad1_u12_ao_test(2,j,i,ipoint)
int2_grad1_u12_ao_transp(j,i,3,ipoint) = int2_grad1_u12_ao_test(3,j,i,ipoint)
enddo
enddo
enddo
else
do ipoint = 1, n_points_final_grid
do i = 1, ao_num
do j = 1, ao_num
int2_grad1_u12_ao_transp(j,i,1,ipoint) = int2_grad1_u12_ao(1,j,i,ipoint)
int2_grad1_u12_ao_transp(j,i,2,ipoint) = int2_grad1_u12_ao(2,j,i,ipoint)
int2_grad1_u12_ao_transp(j,i,3,ipoint) = int2_grad1_u12_ao(3,j,i,ipoint)
enddo
enddo
enddo
endif
call wall_time(wall1)
print *, ' wall time for int2_grad1_u12_ao_transp ', wall1 - wall0

41
src/dft_utils_in_r/ao_in_r.irp.f
View File

@ -40,6 +40,47 @@
END_PROVIDER
BEGIN_PROVIDER[double precision, aos_in_r_array_extra, (ao_num,n_points_extra_final_grid)]
implicit none
BEGIN_DOC
! aos_in_r_array_extra(i,j) = value of the ith ao on the jth grid point
END_DOC
integer :: i,j
double precision :: aos_array(ao_num), r(3)
!$OMP PARALLEL DO &
!$OMP DEFAULT (NONE) &
!$OMP PRIVATE (i,r,aos_array,j) &
!$OMP SHARED(aos_in_r_array_extra,n_points_extra_final_grid,ao_num,final_grid_points_extra)
do i = 1, n_points_extra_final_grid
r(1) = final_grid_points_extra(1,i)
r(2) = final_grid_points_extra(2,i)
r(3) = final_grid_points_extra(3,i)
call give_all_aos_at_r(r,aos_array)
do j = 1, ao_num
aos_in_r_array_extra(j,i) = aos_array(j)
enddo
enddo
!$OMP END PARALLEL DO
END_PROVIDER
BEGIN_PROVIDER[double precision, aos_in_r_array_extra_transp, (n_points_extra_final_grid,ao_num)]
implicit none
BEGIN_DOC
! aos_in_r_array_extra_transp(i,j) = value of the jth ao on the ith grid point
END_DOC
integer :: i,j
double precision :: aos_array(ao_num), r(3)
do i = 1, n_points_extra_final_grid
do j = 1, ao_num
aos_in_r_array_extra_transp(i,j) = aos_in_r_array_extra(j,i)
enddo
enddo
END_PROVIDER
BEGIN_PROVIDER[double precision, aos_grad_in_r_array, (ao_num,n_points_final_grid,3)]
implicit none

32
src/dft_utils_in_r/ao_prod_mlti_pl.irp.f
View File

@ -38,15 +38,15 @@ BEGIN_PROVIDER [ double precision, ao_prod_center, (3, ao_num, ao_num)]
enddo
enddo
enddo
do i = 1, ao_num
do j = 1, ao_num
if(dabs(ao_overlap_abs_grid(j,i)).gt.1.d-10)then
do m = 1, 3
ao_prod_center(m,j,i) *= 1.d0/ao_overlap_abs_grid(j,i)
enddo
endif
enddo
enddo
! do i = 1, ao_num
! do j = 1, ao_num
! if(dabs(ao_overlap_abs_grid(j,i)).gt.1.d-10)then
! do m = 1, 3
! ao_prod_center(m,j,i) *= 1.d0/ao_overlap_abs_grid(j,i)
! enddo
! endif
! enddo
! enddo
END_PROVIDER
@ -76,13 +76,13 @@ BEGIN_PROVIDER [ double precision, ao_prod_sigma, (ao_num, ao_num)]
enddo
enddo
do i = 1, ao_num
do j = 1, ao_num
if(dabs(ao_overlap_abs_grid(j,i)).gt.1.d-10)then
ao_prod_sigma(j,i) *= 1.d0/ao_overlap_abs_grid(j,i)
endif
enddo
enddo
! do i = 1, ao_num
! do j = 1, ao_num
! if(dabs(ao_overlap_abs_grid(j,i)).gt.1.d-10)then
! ao_prod_sigma(j,i) *= 1.d0/ao_overlap_abs_grid(j,i)
! endif
! enddo
! enddo
END_PROVIDER

2
src/non_h_ints_mu/grad_squared_manu.irp.f
View File

@ -116,7 +116,7 @@ BEGIN_PROVIDER [ double precision, u12_grad1_u12_j1b_grad1_j1b_test, (ao_num, ao
do j = 1, ao_num
do i = 1, ao_num
tmp9 = int2_u_grad1u_j1b2(i,j,ipoint)
tmp9 = int2_u_grad1u_j1b2_test(i,j,ipoint)
u12_grad1_u12_j1b_grad1_j1b_test(i,j,ipoint) = tmp6 * tmp9 + tmp3 * int2_u_grad1u_x_j1b2_test(1,i,j,ipoint) &
+ tmp7 * tmp9 + tmp4 * int2_u_grad1u_x_j1b2_test(2,i,j,ipoint) &

53
src/tc_scf/test_int.irp.f
View File

@ -14,7 +14,7 @@ program test_ints
! my_n_pt_r_grid = 10 ! small grid for quick debug
! my_n_pt_a_grid = 14 ! small grid for quick debug
touch my_grid_becke my_n_pt_r_grid my_n_pt_a_grid
my_extra_grid_becke = .True.
my_n_pt_r_extra_grid = 30
my_n_pt_a_extra_grid = 50 ! small extra_grid for quick debug
touch my_extra_grid_becke my_n_pt_r_extra_grid my_n_pt_a_extra_grid
@ -39,7 +39,8 @@ program test_ints
! call routine_int2_u_grad1u_j1b2
! call test_total_grad_lapl
! call test_total_grad_square
call test_ao_tc_int_chemist
! call test_ao_tc_int_chemist
call test_grid_points_ao
end
@ -584,3 +585,51 @@ subroutine test_total_grad_square
end
subroutine test_grid_points_ao
implicit none
integer :: i,j,ipoint,icount,icount_good, icount_bad,icount_full
double precision :: thr
thr = 1.d-10
! print*,'max_n_pts_grid_ao_prod = ',max_n_pts_grid_ao_prod
! print*,'n_pts_grid_ao_prod'
do i = 1, ao_num
do j = i, ao_num
icount = 0
icount_good = 0
icount_bad = 0
icount_full = 0
do ipoint = 1, n_points_final_grid
! if(dabs(int2_u_grad1u_x_j1b2_test(1,j,i,ipoint)) &
! + dabs(int2_u_grad1u_x_j1b2_test(2,j,i,ipoint)) &
! + dabs(int2_u_grad1u_x_j1b2_test(2,j,i,ipoint)) )
! if(dabs(int2_u2_j1b2_test(j,i,ipoint)).gt.thr)then
! icount += 1
! endif
if(dabs(v_ij_u_cst_mu_j1b_ng_1_test(j,i,ipoint)).gt.thr*0.1d0)then
icount_full += 1
endif
if(dabs(v_ij_u_cst_mu_j1b_test(j,i,ipoint)).gt.thr)then
icount += 1
if(dabs(v_ij_u_cst_mu_j1b_ng_1_test(j,i,ipoint)).gt.thr*0.1d0)then
icount_good += 1
else
print*,j,i,ipoint
print*,dabs(v_ij_u_cst_mu_j1b_test(j,i,ipoint)),dabs(v_ij_u_cst_mu_j1b_ng_1_test(j,i,ipoint)),dabs(v_ij_u_cst_mu_j1b_ng_1_test(j,i,ipoint))/dabs(v_ij_u_cst_mu_j1b_test(j,i,ipoint))
icount_bad += 1
endif
endif
! if(dabs(v_ij_u_cst_mu_j1b_ng_1_test(j,i,ipoint)).gt.thr)then
! endif
enddo
print*,''
print*,j,i
print*,icount,icount_full, icount_bad!,n_pts_grid_ao_prod(j,i)
print*,dble(icount)/dble(n_points_final_grid),dble(icount_full)/dble(n_points_final_grid)
! dble(n_pts_grid_ao_prod(j,i))/dble(n_points_final_grid)
! if(icount.gt.n_pts_grid_ao_prod(j,i))then
! print*,'pb !!'
! endif
enddo
enddo
end