From 23ec3ba18af62b13e97c0fecc4e7b06a30a208e1 Mon Sep 17 00:00:00 2001 From: eginer Date: Mon, 12 Dec 2022 16:49:31 +0100 Subject: [PATCH] trying to prune grid points per AO couples --- src/ao_many_one_e_ints/ao_gaus_gauss.irp.f | 47 +++++++++ .../grad_lapl_jmu_manu.irp.f | 99 ++++++++++++++++++- src/ao_many_one_e_ints/list_grid.irp.f | 59 +++++++++++ src/ao_many_one_e_ints/listj1b_sorted.irp.f | 2 +- .../prim_int_gauss_gauss.irp.f | 68 ++++++++++++- src/ao_tc_eff_map/fit_j.irp.f | 25 +++++ src/bi_ort_ints/semi_num_ints_mo.irp.f | 30 ++++-- src/dft_utils_in_r/ao_in_r.irp.f | 41 ++++++++ src/dft_utils_in_r/ao_prod_mlti_pl.irp.f | 32 +++--- src/non_h_ints_mu/grad_squared_manu.irp.f | 2 +- src/tc_scf/test_int.irp.f | 53 +++++++++- 11 files changed, 424 insertions(+), 34 deletions(-) create mode 100644 src/ao_many_one_e_ints/list_grid.irp.f diff --git a/src/ao_many_one_e_ints/ao_gaus_gauss.irp.f b/src/ao_many_one_e_ints/ao_gaus_gauss.irp.f index 213a63e4..ad215b41 100644 --- a/src/ao_many_one_e_ints/ao_gaus_gauss.irp.f +++ b/src/ao_many_one_e_ints/ao_gaus_gauss.irp.f @@ -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 diff --git a/src/ao_many_one_e_ints/grad_lapl_jmu_manu.irp.f b/src/ao_many_one_e_ints/grad_lapl_jmu_manu.irp.f index 382f6351..c7a171f8 100644 --- a/src/ao_many_one_e_ints/grad_lapl_jmu_manu.irp.f +++ b/src/ao_many_one_e_ints/grad_lapl_jmu_manu.irp.f @@ -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 + +! --- + diff --git a/src/ao_many_one_e_ints/list_grid.irp.f b/src/ao_many_one_e_ints/list_grid.irp.f new file mode 100644 index 00000000..ccdc33ad --- /dev/null +++ b/src/ao_many_one_e_ints/list_grid.irp.f @@ -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 diff --git a/src/ao_many_one_e_ints/listj1b_sorted.irp.f b/src/ao_many_one_e_ints/listj1b_sorted.irp.f index 934ccab1..9481d363 100644 --- a/src/ao_many_one_e_ints/listj1b_sorted.irp.f +++ b/src/ao_many_one_e_ints/listj1b_sorted.irp.f @@ -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 diff --git a/src/ao_many_one_e_ints/prim_int_gauss_gauss.irp.f b/src/ao_many_one_e_ints/prim_int_gauss_gauss.irp.f index cfdaf95f..dcd1db66 100644 --- a/src/ao_many_one_e_ints/prim_int_gauss_gauss.irp.f +++ b/src/ao_many_one_e_ints/prim_int_gauss_gauss.irp.f @@ -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 !--- diff --git a/src/ao_tc_eff_map/fit_j.irp.f b/src/ao_tc_eff_map/fit_j.irp.f index 8fad9079..d861054e 100644 --- a/src/ao_tc_eff_map/fit_j.irp.f +++ b/src/ao_tc_eff_map/fit_j.irp.f @@ -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 diff --git a/src/bi_ort_ints/semi_num_ints_mo.irp.f b/src/bi_ort_ints/semi_num_ints_mo.irp.f index 4762c25e..746593dc 100644 --- a/src/bi_ort_ints/semi_num_ints_mo.irp.f +++ b/src/bi_ort_ints/semi_num_ints_mo.irp.f @@ -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 diff --git a/src/dft_utils_in_r/ao_in_r.irp.f b/src/dft_utils_in_r/ao_in_r.irp.f index 6fa6a4c7..72f820ec 100644 --- a/src/dft_utils_in_r/ao_in_r.irp.f +++ b/src/dft_utils_in_r/ao_in_r.irp.f @@ -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 diff --git a/src/dft_utils_in_r/ao_prod_mlti_pl.irp.f b/src/dft_utils_in_r/ao_prod_mlti_pl.irp.f index 1af34d74..9393668f 100644 --- a/src/dft_utils_in_r/ao_prod_mlti_pl.irp.f +++ b/src/dft_utils_in_r/ao_prod_mlti_pl.irp.f @@ -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 diff --git a/src/non_h_ints_mu/grad_squared_manu.irp.f b/src/non_h_ints_mu/grad_squared_manu.irp.f index ada174e5..9b4cbfbd 100644 --- a/src/non_h_ints_mu/grad_squared_manu.irp.f +++ b/src/non_h_ints_mu/grad_squared_manu.irp.f @@ -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) & diff --git a/src/tc_scf/test_int.irp.f b/src/tc_scf/test_int.irp.f index 1947bb92..f3a396be 100644 --- a/src/tc_scf/test_int.irp.f +++ b/src/tc_scf/test_int.irp.f @@ -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