LCPQ/qp2
9
1
Fork 0
mirror of https://github.com/QuantumPackage/qp2.git synced 2024-12-03 10:28:25 +01:00
Code Releases Activity

added ao_many_one_e_ints/ bi_ortho_mos/

Browse Source
This commit is contained in:
eginer 2023-02-06 18:17:56 +01:00
parent ddf2035d2b
commit 17d8197a67
28 changed files with 6602 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
external/qp2-dependencies vendored

@ -1 +1 @@
Subproject commit 242151e03d1d6bf042387226431d82d35845686a
Subproject commit f40bde0925808bbec0424b57bfcef1b26473a1c8

5
src/ao_many_one_e_ints/NEED Normal file
View File

@ -0,0 +1,5 @@
ao_one_e_ints
ao_two_e_ints
becke_numerical_grid
mo_one_e_ints
dft_utils_in_r

25
src/ao_many_one_e_ints/README.rst Normal file
View File

@ -0,0 +1,25 @@
==================
ao_many_one_e_ints
==================
This module contains A LOT of one-electron integrals of the type
A_ij( r ) = \int dr' phi_i(r') w(r,r') phi_j(r')
where r is a point in real space.
+) ao_gaus_gauss.irp.f: w(r,r') is a exp(-(r-r')^2) , and can be multiplied by x/y/z
+) ao_erf_gauss.irp.f : w(r,r') is a exp(-(r-r')^2) erf(mu * |r-r'|)/|r-r'| , and can be multiplied by x/y/z
+) ao_erf_gauss_grad.irp.f: w(r,r') is a exp(-(r-r')^2) erf(mu * |r-r'|)/|r-r'| , and can be multiplied by x/y/z, but evaluated with also one gradient of an AO function.
Fit of a Slater function and corresponding integrals
----------------------------------------------------
The file fit_slat_gauss.irp.f contains many useful providers/routines to fit a Slater function with 20 gaussian.
+) coef_fit_slat_gauss : coefficients of the gaussians to fit e^(-x)
+) expo_fit_slat_gauss : exponents of the gaussians to fit e^(-x)
Integrals involving Slater functions : stg_gauss_int.irp.f
Taylor expansion of full correlation factor
-------------------------------------------
In taylor_exp.irp.f you might find interesting integrals of the type
\int dr' exp( e^{-alpha |r-r|' - beta |r-r'|^2}) phi_i(r') phi_j(r')
evaluated as a Taylor expansion of the exponential.

1113
src/ao_many_one_e_ints/ao_erf_gauss.irp.f Normal file
View File

File diff suppressed because it is too large Load Diff

150
src/ao_many_one_e_ints/ao_erf_gauss_grad.irp.f Normal file
View File

@ -0,0 +1,150 @@
subroutine phi_j_erf_mu_r_dxyz_phi(i,j,mu_in, C_center, dxyz_ints)
implicit none
BEGIN_DOC
! dxyz_ints(1/2/3) = int dr phi_i(r) [erf(mu |r - C|)/|r-C|] d/d(x/y/z) phi_i(r)
END_DOC
integer, intent(in) :: i,j
double precision, intent(in) :: mu_in, C_center(3)
double precision, intent(out):: dxyz_ints(3)
integer :: num_A,power_A(3), num_b, power_B(3),power_B_tmp(3)
double precision :: alpha, beta, A_center(3), B_center(3),contrib,NAI_pol_mult_erf,coef,thr
integer :: n_pt_in,l,m,mm
thr = 1.d-12
dxyz_ints = 0.d0
if(ao_overlap_abs(j,i).lt.thr)then
return
endif
n_pt_in = n_pt_max_integrals
! j
num_A = ao_nucl(j)
power_A(1:3)= ao_power(j,1:3)
A_center(1:3) = nucl_coord(num_A,1:3)
! i
num_B = ao_nucl(i)
power_B(1:3)= ao_power(i,1:3)
B_center(1:3) = nucl_coord(num_B,1:3)
do l=1,ao_prim_num(j)
alpha = ao_expo_ordered_transp(l,j)
do m=1,ao_prim_num(i)
beta = ao_expo_ordered_transp(m,i)
coef = ao_coef_normalized_ordered_transp(l,j) * ao_coef_normalized_ordered_transp(m,i)
if(dabs(coef).lt.thr)cycle
do mm = 1, 3
! (d/dx phi_i ) * phi_j
! d/dx * (x - B_x)^b_x exp(-beta * (x -B_x)^2)= [b_x * (x - B_x)^(b_x - 1) - 2 beta * (x - B_x)^(b_x + 1)] exp(-beta * (x -B_x)^2)
!
! first contribution :: b_x (x - B_x)^(b_x-1) :: integral with b_x=>b_x-1 multiplied by b_x
power_B_tmp = power_B
power_B_tmp(mm) += -1
contrib = NAI_pol_mult_erf(A_center,B_center,power_A,power_B_tmp,alpha,beta,C_center,n_pt_in,mu_in)
dxyz_ints(mm) += contrib * dble(power_B(mm)) * coef
! second contribution :: - 2 beta * (x - B_x)^(b_x + 1) :: integral with b_x=> b_x+1 multiplied by -2 * beta
power_B_tmp = power_B
power_B_tmp(mm) += 1
contrib = NAI_pol_mult_erf(A_center,B_center,power_A,power_B_tmp,alpha,beta,C_center,n_pt_in,mu_in)
dxyz_ints(mm) += contrib * (-2.d0 * beta ) * coef
enddo
enddo
enddo
end
subroutine phi_j_erf_mu_r_dxyz_phi_bis(i,j,mu_in, C_center, dxyz_ints)
implicit none
BEGIN_DOC
! dxyz_ints(1/2/3) = int dr phi_j(r) [erf(mu |r - C|)/|r-C|] d/d(x/y/z) phi_i(r)
END_DOC
integer, intent(in) :: i,j
double precision, intent(in) :: mu_in, C_center(3)
double precision, intent(out):: dxyz_ints(3)
integer :: num_A,power_A(3), num_b, power_B(3),power_B_tmp(3)
double precision :: alpha, beta, A_center(3), B_center(3),contrib,NAI_pol_mult_erf
double precision :: thr, coef
integer :: n_pt_in,l,m,mm,kk
thr = 1.d-12
dxyz_ints = 0.d0
if(ao_overlap_abs(j,i).lt.thr)then
return
endif
n_pt_in = n_pt_max_integrals
! j == A
num_A = ao_nucl(j)
power_A(1:3)= ao_power(j,1:3)
A_center(1:3) = nucl_coord(num_A,1:3)
! i == B
num_B = ao_nucl(i)
power_B(1:3)= ao_power(i,1:3)
B_center(1:3) = nucl_coord(num_B,1:3)
dxyz_ints = 0.d0
do l=1,ao_prim_num(j)
alpha = ao_expo_ordered_transp(l,j)
do m=1,ao_prim_num(i)
beta = ao_expo_ordered_transp(m,i)
do kk = 1, 2 ! loop over the extra terms induced by the d/dx/y/z * AO(i)
do mm = 1, 3
power_B_tmp = power_B
power_B_tmp(mm) = power_ord_grad_transp(kk,mm,i)
coef = ao_coef_normalized_ordered_transp(l,j) * ao_coef_ord_grad_transp(kk,mm,m,i)
if(dabs(coef).lt.thr)cycle
contrib = NAI_pol_mult_erf(A_center,B_center,power_A,power_B_tmp,alpha,beta,C_center,n_pt_in,mu_in)
dxyz_ints(mm) += contrib * coef
enddo
enddo
enddo
enddo
end
subroutine phi_j_erf_mu_r_xyz_dxyz_phi(i,j,mu_in, C_center, dxyz_ints)
implicit none
BEGIN_DOC
! dxyz_ints(1/2/3) = int dr phi_j(r) x/y/z [erf(mu |r - C|)/|r-C|] d/d(x/y/z) phi_i(r)
END_DOC
integer, intent(in) :: i,j
double precision, intent(in) :: mu_in, C_center(3)
double precision, intent(out):: dxyz_ints(3)
integer :: num_A,power_A(3), num_b, power_B(3),power_B_tmp(3)
double precision :: alpha, beta, A_center(3), B_center(3),contrib,NAI_pol_mult_erf
double precision :: thr, coef
integer :: n_pt_in,l,m,mm,kk
thr = 1.d-12
dxyz_ints = 0.d0
if(ao_overlap_abs(j,i).lt.thr)then
return
endif
n_pt_in = n_pt_max_integrals
! j == A
num_A = ao_nucl(j)
power_A(1:3)= ao_power(j,1:3)
A_center(1:3) = nucl_coord(num_A,1:3)
! i == B
num_B = ao_nucl(i)
power_B(1:3)= ao_power(i,1:3)
B_center(1:3) = nucl_coord(num_B,1:3)
dxyz_ints = 0.d0
do l=1,ao_prim_num(j)
alpha = ao_expo_ordered_transp(l,j)
do m=1,ao_prim_num(i)
beta = ao_expo_ordered_transp(m,i)
do kk = 1, 4 ! loop over the extra terms induced by the x/y/z * d dx/y/z AO(i)
do mm = 1, 3
power_B_tmp = power_B
power_B_tmp(mm) = power_ord_xyz_grad_transp(kk,mm,i)
coef = ao_coef_normalized_ordered_transp(l,j) * ao_coef_ord_xyz_grad_transp(kk,mm,m,i)
if(dabs(coef).lt.thr)cycle
contrib = NAI_pol_mult_erf(A_center,B_center,power_A,power_B_tmp,alpha,beta,C_center,n_pt_in,mu_in)
dxyz_ints(mm) += contrib * coef
enddo
enddo
enddo
enddo
end

426
src/ao_many_one_e_ints/ao_gaus_gauss.irp.f Normal file
View File

@ -0,0 +1,426 @@
! ---
subroutine overlap_gauss_xyz_r12_ao(D_center,delta,i,j,gauss_ints)
implicit none
BEGIN_DOC
! gauss_ints(m) = \int dr AO_i(r) AO_j(r) x/y/z e^{-delta |r-D_center|^2}
!
! with m == 1 ==> x, m == 2 ==> y, m == 3 ==> z
END_DOC
integer, intent(in) :: i,j
double precision, intent(in) :: D_center(3), delta
double precision, intent(out) :: gauss_ints(3)
integer :: num_a,num_b,power_A(3), power_B(3),l,k,m
double precision :: A_center(3), B_center(3),overlap_gauss_r12,alpha,beta,gauss_ints_tmp(3)
gauss_ints = 0.d0
if(ao_overlap_abs(j,i).lt.1.d-12)then
return
endif
num_A = ao_nucl(i)
power_A(1:3)= ao_power(i,1:3)
A_center(1:3) = nucl_coord(num_A,1:3)
num_B = ao_nucl(j)
power_B(1:3)= ao_power(j,1:3)
B_center(1:3) = nucl_coord(num_B,1:3)
do l=1,ao_prim_num(i)
alpha = ao_expo_ordered_transp(l,i)
do k=1,ao_prim_num(j)
beta = ao_expo_ordered_transp(k,j)
call overlap_gauss_xyz_r12(D_center,delta,A_center,B_center,power_A,power_B,alpha,beta,gauss_ints_tmp)
do m = 1, 3
gauss_ints(m) += gauss_ints_tmp(m) * ao_coef_normalized_ordered_transp(l,i) &
* ao_coef_normalized_ordered_transp(k,j)
enddo
enddo
enddo
end
double precision function overlap_gauss_xyz_r12_ao_specific(D_center,delta,i,j,mx)
implicit none
BEGIN_DOC
! \int dr AO_i(r) AO_j(r) x/y/z e^{-delta |r-D_center|^2}
!
! with mx == 1 ==> x, mx == 2 ==> y, mx == 3 ==> z
END_DOC
integer, intent(in) :: i,j,mx
double precision, intent(in) :: D_center(3), delta
integer :: num_a,num_b,power_A(3), power_B(3),l,k
double precision :: gauss_int
double precision :: A_center(3), B_center(3),overlap_gauss_r12,alpha,beta
double precision :: overlap_gauss_xyz_r12_specific
overlap_gauss_xyz_r12_ao_specific = 0.d0
if(ao_overlap_abs(j,i).lt.1.d-12)then
return
endif
num_A = ao_nucl(i)
power_A(1:3)= ao_power(i,1:3)
A_center(1:3) = nucl_coord(num_A,1:3)
num_B = ao_nucl(j)
power_B(1:3)= ao_power(j,1:3)
B_center(1:3) = nucl_coord(num_B,1:3)
do l=1,ao_prim_num(i)
alpha = ao_expo_ordered_transp(l,i)
do k=1,ao_prim_num(j)
beta = ao_expo_ordered_transp(k,j)
gauss_int = overlap_gauss_xyz_r12_specific(D_center,delta,A_center,B_center,power_A,power_B,alpha,beta,mx)
overlap_gauss_xyz_r12_ao_specific = gauss_int * ao_coef_normalized_ordered_transp(l,i) &
* ao_coef_normalized_ordered_transp(k,j)
enddo
enddo
end
subroutine overlap_gauss_r12_all_ao(D_center,delta,aos_ints)
implicit none
double precision, intent(in) :: D_center(3), delta
double precision, intent(out):: aos_ints(ao_num,ao_num)
integer :: num_a,num_b,power_A(3), power_B(3),l,k,i,j
double precision :: A_center(3), B_center(3),overlap_gauss_r12,alpha,beta,analytical_j
aos_ints = 0.d0
do i = 1, ao_num
do j = 1, ao_num
if(ao_overlap_abs(j,i).lt.1.d-12)cycle
num_A = ao_nucl(i)
power_A(1:3)= ao_power(i,1:3)
A_center(1:3) = nucl_coord(num_A,1:3)
num_B = ao_nucl(j)
power_B(1:3)= ao_power(j,1:3)
B_center(1:3) = nucl_coord(num_B,1:3)
do l=1,ao_prim_num(i)
alpha = ao_expo_ordered_transp(l,i)
do k=1,ao_prim_num(j)
beta = ao_expo_ordered_transp(k,j)
analytical_j = overlap_gauss_r12(D_center,delta,A_center,B_center,power_A,power_B,alpha,beta)
aos_ints(j,i) += analytical_j * ao_coef_normalized_ordered_transp(l,i) &
* ao_coef_normalized_ordered_transp(k,j)
enddo
enddo
enddo
enddo
end
! ---
! TODO :: PUT CYCLES IN LOOPS
double precision function overlap_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_gauss_r12
overlap_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_gauss_r12(D_center, delta, A_center, B_center, power_A, power_B, alpha, beta)
overlap_gauss_r12_ao += coef * analytical_j
enddo
enddo
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
!
! \int dr AO_i(r) AO_j(r) e^{-delta |r-D_center|^2}
!
! n_points: nb of integrals <= min(LD_D, LD_resv)
!
END_DOC
implicit none
integer, intent(in) :: i, j, LD_D, LD_resv, n_points
double precision, intent(in) :: D_center(LD_D,3), delta
double precision, intent(out) :: resv(LD_resv)
integer :: ipoint
integer :: power_A(3), power_B(3), l, k
double precision :: A_center(3), B_center(3), alpha, beta, coef, coef1
double precision, allocatable :: analytical_j(:)
resv(:) = 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)
allocate(analytical_j(n_points))
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
call overlap_gauss_r12_v(D_center, LD_D, delta, A_center, B_center, power_A, power_B, alpha, beta, analytical_j, n_points, n_points)
do ipoint = 1, n_points
resv(ipoint) = resv(ipoint) + coef * analytical_j(ipoint)
enddo
enddo
enddo
deallocate(analytical_j)
end subroutine overlap_gauss_r12_ao_v
! ---
double precision function overlap_gauss_r12_ao_with1s(B_center, beta, D_center, delta, i, j)
BEGIN_DOC
!
! \int dr AO_i(r) AO_j(r) e^{-beta |r-B_center^2|} e^{-delta |r-D_center|^2}
!
END_DOC
implicit none
integer, intent(in) :: i, j
double precision, intent(in) :: B_center(3), beta, D_center(3), delta
integer :: power_A1(3), power_A2(3), l, k
double precision :: A1_center(3), A2_center(3), alpha1, alpha2, coef1, coef12, analytical_j
double precision :: G_center(3), gama, fact_g, gama_inv
double precision, external :: overlap_gauss_r12, overlap_gauss_r12_ao
if(beta .lt. 1d-10) then
overlap_gauss_r12_ao_with1s = overlap_gauss_r12_ao(D_center, delta, i, j)
return
endif
overlap_gauss_r12_ao_with1s = 0.d0
if(ao_overlap_abs(j,i) .lt. 1.d-12) then
return
endif
! e^{-beta |r-B_center^2|} e^{-delta |r-D_center|^2} = fact_g e^{-gama |r - G|^2}
gama = beta + delta
gama_inv = 1.d0 / gama
G_center(1) = (beta * B_center(1) + delta * D_center(1)) * gama_inv
G_center(2) = (beta * B_center(2) + delta * D_center(2)) * gama_inv
G_center(3) = (beta * B_center(3) + delta * D_center(3)) * gama_inv
fact_g = beta * delta * gama_inv * ( (B_center(1) - D_center(1)) * (B_center(1) - D_center(1)) &
+ (B_center(2) - D_center(2)) * (B_center(2) - D_center(2)) &
+ (B_center(3) - D_center(3)) * (B_center(3) - D_center(3)) )
if(fact_g .gt. 10d0) return
fact_g = dexp(-fact_g)
! ---
power_A1(1:3) = ao_power(i,1:3)
power_A2(1:3) = ao_power(j,1:3)
A1_center(1:3) = nucl_coord(ao_nucl(i),1:3)
A2_center(1:3) = nucl_coord(ao_nucl(j),1:3)
do l = 1, ao_prim_num(i)
alpha1 = ao_expo_ordered_transp (l,i)
coef1 = fact_g * ao_coef_normalized_ordered_transp(l,i)
if(dabs(coef1) .lt. 1d-12) cycle
do k = 1, ao_prim_num(j)
alpha2 = ao_expo_ordered_transp (k,j)
coef12 = coef1 * ao_coef_normalized_ordered_transp(k,j)
if(dabs(coef12) .lt. 1d-12) cycle
analytical_j = overlap_gauss_r12(G_center, gama, A1_center, A2_center, power_A1, power_A2, alpha1, alpha2)
overlap_gauss_r12_ao_with1s += coef12 * analytical_j
enddo
enddo
end function overlap_gauss_r12_ao_with1s
! ---
subroutine overlap_gauss_r12_ao_with1s_v(B_center, beta, D_center, LD_D, delta, i, j, resv, LD_resv, n_points)
BEGIN_DOC
!
! \int dr AO_i(r) AO_j(r) e^{-beta |r-B_center^2|} e^{-delta |r-D_center|^2}
! using an array of D_centers.
!
END_DOC
implicit none
integer, intent(in) :: i, j, n_points, LD_D, LD_resv
double precision, intent(in) :: B_center(3), beta, D_center(LD_D,3), delta
double precision, intent(out) :: resv(LD_resv)
integer :: ipoint
integer :: power_A1(3), power_A2(3), l, k
double precision :: A1_center(3), A2_center(3), alpha1, alpha2, coef1
double precision :: coef12, coef12f
double precision :: gama, gama_inv
double precision :: bg, dg, bdg
double precision, allocatable :: fact_g(:), G_center(:,:), analytical_j(:)
if(ao_overlap_abs(j,i) .lt. 1.d-12) then
return
endif
ASSERT(beta .gt. 0.d0)
if(beta .lt. 1d-10) then
call overlap_gauss_r12_ao_v(D_center, LD_D, delta, i, j, resv, LD_resv, n_points)
return
endif
resv(:) = 0.d0
! e^{-beta |r-B_center^2|} e^{-delta |r-D_center|^2} = fact_g e^{-gama |r - G|^2}
gama = beta + delta
gama_inv = 1.d0 / gama
power_A1(1:3) = ao_power(i,1:3)
power_A2(1:3) = ao_power(j,1:3)
A1_center(1:3) = nucl_coord(ao_nucl(i),1:3)
A2_center(1:3) = nucl_coord(ao_nucl(j),1:3)
allocate(fact_g(n_points), G_center(n_points,3), analytical_j(n_points))
bg = beta * gama_inv
dg = delta * gama_inv
bdg = bg * delta
do ipoint = 1, n_points
G_center(ipoint,1) = bg * B_center(1) + dg * D_center(ipoint,1)
G_center(ipoint,2) = bg * B_center(2) + dg * D_center(ipoint,2)
G_center(ipoint,3) = bg * B_center(3) + dg * D_center(ipoint,3)
fact_g(ipoint) = bdg * ( (B_center(1) - D_center(ipoint,1)) * (B_center(1) - D_center(ipoint,1)) &
+ (B_center(2) - D_center(ipoint,2)) * (B_center(2) - D_center(ipoint,2)) &
+ (B_center(3) - D_center(ipoint,3)) * (B_center(3) - D_center(ipoint,3)) )
if(fact_g(ipoint) < 10d0) then
fact_g(ipoint) = dexp(-fact_g(ipoint))
else
fact_g(ipoint) = 0.d0
endif
enddo
do l = 1, ao_prim_num(i)
alpha1 = ao_expo_ordered_transp (l,i)
coef1 = ao_coef_normalized_ordered_transp(l,i)
do k = 1, ao_prim_num(j)
alpha2 = ao_expo_ordered_transp (k,j)
coef12 = coef1 * ao_coef_normalized_ordered_transp(k,j)
if(dabs(coef12) .lt. 1d-12) cycle
call overlap_gauss_r12_v(G_center, n_points, gama, A1_center, A2_center, power_A1, power_A2, alpha1, alpha2, analytical_j, n_points, n_points)
do ipoint = 1, n_points
coef12f = coef12 * fact_g(ipoint)
resv(ipoint) += coef12f * analytical_j(ipoint)
enddo
enddo
enddo
deallocate(fact_g, G_center, analytical_j)
end subroutine overlap_gauss_r12_ao_with1s_v
! ---

94
src/ao_many_one_e_ints/fit_slat_gauss.irp.f Normal file
View File

@ -0,0 +1,94 @@
BEGIN_PROVIDER [integer, n_max_fit_slat]
implicit none
BEGIN_DOC
! number of gaussian to fit exp(-x)
!
! I took 20 gaussians from the program bassto.f
END_DOC
n_max_fit_slat = 20
END_PROVIDER
BEGIN_PROVIDER [double precision, coef_fit_slat_gauss, (n_max_fit_slat)]
&BEGIN_PROVIDER [double precision, expo_fit_slat_gauss, (n_max_fit_slat)]
implicit none
include 'constants.include.F'
BEGIN_DOC
! fit the exp(-x) as
!
! \sum_{i = 1, n_max_fit_slat} coef_fit_slat_gauss(i) * exp(-expo_fit_slat_gauss(i) * x**2)
!
! The coefficient are taken from the program bassto.f
END_DOC
expo_fit_slat_gauss(01)=30573.77073000000
coef_fit_slat_gauss(01)=0.00338925525
expo_fit_slat_gauss(02)=5608.45238100000
coef_fit_slat_gauss(02)=0.00536433869
expo_fit_slat_gauss(03)=1570.95673400000
coef_fit_slat_gauss(03)=0.00818702846
expo_fit_slat_gauss(04)=541.39785110000
coef_fit_slat_gauss(04)=0.01202047655
expo_fit_slat_gauss(05)=212.43469630000
coef_fit_slat_gauss(05)=0.01711289568
expo_fit_slat_gauss(06)=91.31444574000
coef_fit_slat_gauss(06)=0.02376001022
expo_fit_slat_gauss(07)=42.04087246000
coef_fit_slat_gauss(07)=0.03229121736
expo_fit_slat_gauss(08)=20.43200443000
coef_fit_slat_gauss(08)=0.04303646818
expo_fit_slat_gauss(09)=10.37775161000
coef_fit_slat_gauss(09)=0.05624657578
expo_fit_slat_gauss(10)=5.46880754500
coef_fit_slat_gauss(10)=0.07192311571
expo_fit_slat_gauss(11)=2.97373529200
coef_fit_slat_gauss(11)=0.08949389001
expo_fit_slat_gauss(12)=1.66144190200
coef_fit_slat_gauss(12)=0.10727599240
expo_fit_slat_gauss(13)=0.95052560820
coef_fit_slat_gauss(13)=0.12178961750
expo_fit_slat_gauss(14)=0.55528683970
coef_fit_slat_gauss(14)=0.12740141870
expo_fit_slat_gauss(15)=0.33043360020
coef_fit_slat_gauss(15)=0.11759168160
expo_fit_slat_gauss(16)=0.19982303230
coef_fit_slat_gauss(16)=0.08953504394
expo_fit_slat_gauss(17)=0.12246840760
coef_fit_slat_gauss(17)=0.05066721317
expo_fit_slat_gauss(18)=0.07575825322
coef_fit_slat_gauss(18)=0.01806363869
expo_fit_slat_gauss(19)=0.04690146243
coef_fit_slat_gauss(19)=0.00305632563
expo_fit_slat_gauss(20)=0.02834749861
coef_fit_slat_gauss(20)=0.00013317513
END_PROVIDER
double precision function slater_fit_gam(x,gam)
implicit none
double precision, intent(in) :: x,gam
BEGIN_DOC
! fit of the function exp(-gam * x) with gaussian functions
END_DOC
integer :: i
slater_fit_gam = 0.d0
do i = 1, n_max_fit_slat
slater_fit_gam += coef_fit_slat_gauss(i) * dexp(-expo_fit_slat_gauss(i) * gam * gam * x * x)
enddo
end
subroutine expo_fit_slater_gam(gam,expos)
implicit none
BEGIN_DOC
! returns the array of the exponents of the gaussians to fit exp(-gam*x)
END_DOC
double precision, intent(in) :: gam
double precision, intent(out) :: expos(n_max_fit_slat)
integer :: i
do i = 1, n_max_fit_slat
expos(i) = expo_fit_slat_gauss(i) * gam * gam
enddo
end

517
src/ao_many_one_e_ints/grad2_jmu_manu.irp.f Normal file
View File

@ -0,0 +1,517 @@
! ---
BEGIN_PROVIDER [ double precision, int2_grad1u2_grad2u2_j1b2_test, (ao_num, ao_num, n_points_final_grid)]
BEGIN_DOC
!
! -\frac{1}{4} x int dr2 phi_i(r2) phi_j(r2) 1s_j1b(r2)^2 [1 - erf(mu r12)]^2
!
END_DOC
implicit none
integer :: i, j, ipoint, i_1s, i_fit
double precision :: r(3), expo_fit, coef_fit
double precision :: coef, beta, B_center(3)
double precision :: tmp
double precision :: wall0, wall1
double precision :: int_gauss, dsqpi_3_2, int_j1b
double precision :: factor_ij_1s, beta_ij, center_ij_1s(3), sq_pi_3_2
double precision, allocatable :: int_fit_v(:)
double precision, external :: overlap_gauss_r12_ao_with1s
print*, ' providing int2_grad1u2_grad2u2_j1b2_test ...'
sq_pi_3_2 = (dacos(-1.d0))**(1.5d0)
provide mu_erf final_grid_points_transp j1b_pen List_comb_thr_b3_coef
call wall_time(wall0)
int2_grad1u2_grad2u2_j1b2_test(:,:,:) = 0.d0
!$OMP PARALLEL DEFAULT (NONE) &
!$OMP PRIVATE (ipoint, i, j, i_1s, i_fit, r, coef, beta, B_center, &
!$OMP coef_fit, expo_fit, int_fit_v, tmp,int_gauss,int_j1b,factor_ij_1s,beta_ij,center_ij_1s) &
!$OMP SHARED (n_points_final_grid, ao_num, final_grid_points,List_comb_thr_b3_size, &
!$OMP final_grid_points_transp, ng_fit_jast, &
!$OMP expo_gauss_1_erf_x_2, coef_gauss_1_erf_x_2, &
!$OMP List_comb_thr_b3_coef, List_comb_thr_b3_expo, &
!$OMP List_comb_thr_b3_cent, int2_grad1u2_grad2u2_j1b2_test, ao_abs_comb_b3_j1b, &
!$OMP ao_overlap_abs,sq_pi_3_2)
!$OMP DO SCHEDULE(dynamic)
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(ao_overlap_abs(j,i) .lt. 1.d-12) then
cycle
endif
do i_1s = 1, List_comb_thr_b3_size(j,i)
coef = List_comb_thr_b3_coef (i_1s,j,i)
beta = List_comb_thr_b3_expo (i_1s,j,i)
int_j1b = ao_abs_comb_b3_j1b(i_1s,j,i)
B_center(1) = List_comb_thr_b3_cent(1,i_1s,j,i)
B_center(2) = List_comb_thr_b3_cent(2,i_1s,j,i)
B_center(3) = List_comb_thr_b3_cent(3,i_1s,j,i)
do i_fit = 1, ng_fit_jast
expo_fit = expo_gauss_1_erf_x_2(i_fit)
!DIR$ FORCEINLINE
call gaussian_product(expo_fit,r,beta,B_center,factor_ij_1s,beta_ij,center_ij_1s)
coef_fit = -0.25d0 * coef_gauss_1_erf_x_2(i_fit) * coef
! if(dabs(coef_fit*factor_ij_1s*int_j1b).lt.1.d-10)cycle ! old version
if(dabs(coef_fit*factor_ij_1s*int_j1b*sq_pi_3_2*(beta_ij)**(-1.5d0)).lt.1.d-10)cycle
! call overlap_gauss_r12_ao_with1s_v(B_center, beta, final_grid_points_transp, &
! expo_fit, i, j, int_fit_v, n_points_final_grid)
int_gauss = overlap_gauss_r12_ao_with1s(B_center, beta, r, expo_fit, i, j)
int2_grad1u2_grad2u2_j1b2_test(j,i,ipoint) += coef_fit * int_gauss
enddo
enddo
enddo
enddo
enddo
!$OMP END DO
!$OMP END PARALLEL
do ipoint = 1, n_points_final_grid
do i = 1, ao_num
do j = 1, i-1
int2_grad1u2_grad2u2_j1b2_test(j,i,ipoint) = int2_grad1u2_grad2u2_j1b2_test(i,j,ipoint)
enddo
enddo
enddo
call wall_time(wall1)
print*, ' wall time for int2_grad1u2_grad2u2_j1b2_test', wall1 - wall0
END_PROVIDER
! ---
BEGIN_PROVIDER [ double precision, int2_grad1u2_grad2u2_j1b2_test_v, (ao_num, ao_num, n_points_final_grid)]
!
! BEGIN_DOC
! !
! ! -\frac{1}{4} x int dr2 phi_i(r2) phi_j(r2) 1s_j1b(r2)^2 [1 - erf(mu r12)]^2
! !
! END_DOC
!
implicit none
integer :: i, j, ipoint, i_1s, i_fit
double precision :: r(3), expo_fit, coef_fit
double precision :: coef, beta, B_center(3)
double precision :: tmp
double precision :: wall0, wall1
double precision, allocatable :: int_fit_v(:),big_array(:,:,:)
double precision, external :: overlap_gauss_r12_ao_with1s
print*, ' providing int2_grad1u2_grad2u2_j1b2_test_v ...'
provide mu_erf final_grid_points_transp j1b_pen
call wall_time(wall0)
double precision :: int_j1b
big_array(:,:,:) = 0.d0
allocate(big_array(n_points_final_grid,ao_num, ao_num))
!$OMP PARALLEL DEFAULT (NONE) &
!$OMP PRIVATE (ipoint, i, j, i_1s, i_fit, r, coef, beta, B_center,&
!$OMP coef_fit, expo_fit, int_fit_v, tmp,int_j1b) &
!$OMP SHARED (n_points_final_grid, ao_num, List_comb_thr_b3_size,&
!$OMP final_grid_points_transp, ng_fit_jast, &
!$OMP expo_gauss_1_erf_x_2, coef_gauss_1_erf_x_2, &
!$OMP List_comb_thr_b3_coef, List_comb_thr_b3_expo, &
!$OMP List_comb_thr_b3_cent, big_array,&
!$OMP ao_abs_comb_b3_j1b,ao_overlap_abs)
!
allocate(int_fit_v(n_points_final_grid))
!$OMP DO SCHEDULE(dynamic)
do i = 1, ao_num
do j = i, ao_num
if(ao_overlap_abs(j,i) .lt. 1.d-12) then
cycle
endif
do i_1s = 1, List_comb_thr_b3_size(j,i)
coef = List_comb_thr_b3_coef (i_1s,j,i)
beta = List_comb_thr_b3_expo (i_1s,j,i)
int_j1b = ao_abs_comb_b3_j1b(i_1s,j,i)
! if(dabs(coef)*dabs(int_j1b).lt.1.d-15)cycle
B_center(1) = List_comb_thr_b3_cent(1,i_1s,j,i)
B_center(2) = List_comb_thr_b3_cent(2,i_1s,j,i)
B_center(3) = List_comb_thr_b3_cent(3,i_1s,j,i)
do i_fit = 1, ng_fit_jast
expo_fit = expo_gauss_1_erf_x_2(i_fit)
coef_fit = -0.25d0 * coef_gauss_1_erf_x_2(i_fit) * coef
call overlap_gauss_r12_ao_with1s_v(B_center, beta, final_grid_points_transp, size(final_grid_points_transp,1),&
expo_fit, i, j, int_fit_v, size(int_fit_v,1),n_points_final_grid)
do ipoint = 1, n_points_final_grid
big_array(ipoint,j,i) += coef_fit * int_fit_v(ipoint)
enddo
enddo
enddo
enddo
enddo
!$OMP END DO
deallocate(int_fit_v)
!$OMP END PARALLEL
do i = 1, ao_num
do j = i, ao_num
do ipoint = 1, n_points_final_grid
int2_grad1u2_grad2u2_j1b2_test_v(j,i,ipoint) = big_array(ipoint,j,i)
enddo
enddo
enddo
do ipoint = 1, n_points_final_grid
do i = 2, ao_num
do j = 1, i-1
int2_grad1u2_grad2u2_j1b2_test_v(j,i,ipoint) = big_array(ipoint,i,j)
enddo
enddo
enddo
call wall_time(wall1)
print*, ' wall time for int2_grad1u2_grad2u2_j1b2_test_v', wall1 - wall0
END_PROVIDER
! ---
BEGIN_PROVIDER [ double precision, int2_u2_j1b2_test, (ao_num, ao_num, n_points_final_grid)]
BEGIN_DOC
!
! int dr2 phi_i(r2) phi_j(r2) 1s_j1b(r2)^2 [u_12^mu]^2
!
END_DOC
implicit none
integer :: i, j, ipoint, i_1s, i_fit
double precision :: r(3), int_fit, expo_fit, coef_fit
double precision :: coef, beta, B_center(3), tmp
double precision :: wall0, wall1,int_j1b
double precision, external :: overlap_gauss_r12_ao
double precision, external :: overlap_gauss_r12_ao_with1s
double precision :: factor_ij_1s,beta_ij,center_ij_1s(3),sq_pi_3_2
print*, ' providing int2_u2_j1b2_test ...'
sq_pi_3_2 = (dacos(-1.d0))**(1.5d0)
provide mu_erf final_grid_points j1b_pen
call wall_time(wall0)
int2_u2_j1b2_test = 0.d0
!$OMP PARALLEL DEFAULT (NONE) &
!$OMP PRIVATE (ipoint, i, j, i_1s, i_fit, r, coef, beta, B_center, &
!$OMP coef_fit, expo_fit, int_fit, tmp, int_j1b,factor_ij_1s,beta_ij,center_ij_1s) &
!$OMP SHARED (n_points_final_grid, ao_num, List_comb_thr_b3_size, &
!$OMP final_grid_points, ng_fit_jast, &
!$OMP expo_gauss_j_mu_x_2, coef_gauss_j_mu_x_2, &
!$OMP List_comb_thr_b3_coef, List_comb_thr_b3_expo,sq_pi_3_2, &
!$OMP List_comb_thr_b3_cent, int2_u2_j1b2_test,ao_abs_comb_b3_j1b)
!$OMP DO
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
tmp = 0.d0
do i_1s = 1, List_comb_thr_b3_size(j,i)
coef = List_comb_thr_b3_coef (i_1s,j,i)
beta = List_comb_thr_b3_expo (i_1s,j,i)
int_j1b = ao_abs_comb_b3_j1b(i_1s,j,i)
if(dabs(coef)*dabs(int_j1b).lt.1.d-10)cycle
B_center(1) = List_comb_thr_b3_cent(1,i_1s,j,i)
B_center(2) = List_comb_thr_b3_cent(2,i_1s,j,i)
B_center(3) = List_comb_thr_b3_cent(3,i_1s,j,i)
do i_fit = 1, ng_fit_jast
expo_fit = expo_gauss_j_mu_x_2(i_fit)
coef_fit = coef_gauss_j_mu_x_2(i_fit)
!DIR$ FORCEINLINE
call gaussian_product(expo_fit,r,beta,B_center,factor_ij_1s,beta_ij,center_ij_1s)
! if(dabs(coef_fit*coef*factor_ij_1s*int_j1b).lt.1.d-10)cycle ! old version
if(dabs(coef_fit*coef*factor_ij_1s*int_j1b*sq_pi_3_2*(beta_ij)**(-1.5d0)).lt.1.d-10)cycle
! ---
int_fit = overlap_gauss_r12_ao_with1s(B_center, beta, r, expo_fit, i, j)
tmp += coef * coef_fit * int_fit
enddo
! ---
enddo
int2_u2_j1b2_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
int2_u2_j1b2_test(j,i,ipoint) = int2_u2_j1b2_test(i,j,ipoint)
enddo
enddo
enddo
call wall_time(wall1)
print*, ' wall time for int2_u2_j1b2_test', wall1 - wall0
END_PROVIDER
! ---
BEGIN_PROVIDER [ double precision, int2_u_grad1u_x_j1b2_test, (ao_num, ao_num, n_points_final_grid, 3)]
BEGIN_DOC
!
! int dr2 phi_i(r2) phi_j(r2) 1s_j1b(r2)^2 u_12^mu [\grad_1 u_12^mu] r2
!
END_DOC
implicit none
integer :: i, j, ipoint, i_1s, i_fit
double precision :: r(3), int_fit(3), expo_fit, coef_fit
double precision :: coef, beta, B_center(3), dist
double precision :: alpha_1s, alpha_1s_inv, centr_1s(3), expo_coef_1s, coef_tmp
double precision :: tmp_x, tmp_y, tmp_z, int_j1b
double precision :: wall0, wall1, sq_pi_3_2,sq_alpha
print*, ' providing int2_u_grad1u_x_j1b2_test ...'
sq_pi_3_2 = dacos(-1.D0)**(1.d0)
provide mu_erf final_grid_points j1b_pen
call wall_time(wall0)
int2_u_grad1u_x_j1b2_test = 0.d0
!$OMP PARALLEL DEFAULT (NONE) &
!$OMP PRIVATE (ipoint, i, j, i_1s, i_fit, r, coef, beta, B_center, &
!$OMP coef_fit, expo_fit, int_fit, alpha_1s, dist, &
!$OMP alpha_1s_inv, centr_1s, expo_coef_1s, coef_tmp, &
!$OMP tmp_x, tmp_y, tmp_z,int_j1b,sq_alpha) &
!$OMP SHARED (n_points_final_grid, ao_num, List_comb_thr_b3_size, &
!$OMP final_grid_points, ng_fit_jast, &
!$OMP expo_gauss_j_mu_1_erf, coef_gauss_j_mu_1_erf, &
!$OMP List_comb_thr_b3_coef, List_comb_thr_b3_expo, &
!$OMP List_comb_thr_b3_cent, int2_u_grad1u_x_j1b2_test,ao_abs_comb_b3_j1b,sq_pi_3_2)
!$OMP DO
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
tmp_x = 0.d0
tmp_y = 0.d0
tmp_z = 0.d0
do i_1s = 1, List_comb_thr_b3_size(j,i)
coef = List_comb_thr_b3_coef (i_1s,j,i)
beta = List_comb_thr_b3_expo (i_1s,j,i)
int_j1b = ao_abs_comb_b3_j1b(i_1s,j,i)
if(dabs(coef)*dabs(int_j1b).lt.1.d-10)cycle
B_center(1) = List_comb_thr_b3_cent(1,i_1s,j,i)
B_center(2) = List_comb_thr_b3_cent(2,i_1s,j,i)
B_center(3) = List_comb_thr_b3_cent(3,i_1s,j,i)
do i_fit = 1, ng_fit_jast
expo_fit = expo_gauss_j_mu_1_erf(i_fit)
coef_fit = coef_gauss_j_mu_1_erf(i_fit)
dist = (B_center(1) - r(1)) * (B_center(1) - r(1)) &
+ (B_center(2) - r(2)) * (B_center(2) - r(2)) &
+ (B_center(3) - r(3)) * (B_center(3) - r(3))
alpha_1s = beta + expo_fit
alpha_1s_inv = 1.d0 / alpha_1s
centr_1s(1) = alpha_1s_inv * (beta * B_center(1) + expo_fit * r(1))
centr_1s(2) = alpha_1s_inv * (beta * B_center(2) + expo_fit * r(2))
centr_1s(3) = alpha_1s_inv * (beta * B_center(3) + expo_fit * r(3))
expo_coef_1s = beta * expo_fit * alpha_1s_inv * dist
coef_tmp = coef * coef_fit * dexp(-expo_coef_1s)
sq_alpha = alpha_1s_inv * dsqrt(alpha_1s_inv)
! if(dabs(coef_tmp*int_j1b) .lt. 1d-10) cycle ! old version
if(dabs(coef_tmp*int_j1b*sq_pi_3_2*sq_alpha) .lt. 1d-10) cycle
call NAI_pol_x_mult_erf_ao_with1s(i, j, alpha_1s, centr_1s, 1.d+9, r, int_fit)
tmp_x += coef_tmp * int_fit(1)
tmp_y += coef_tmp * int_fit(2)
tmp_z += coef_tmp * int_fit(3)
enddo
! ---
enddo
int2_u_grad1u_x_j1b2_test(j,i,ipoint,1) = tmp_x
int2_u_grad1u_x_j1b2_test(j,i,ipoint,2) = tmp_y
int2_u_grad1u_x_j1b2_test(j,i,ipoint,3) = tmp_z
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
int2_u_grad1u_x_j1b2_test(j,i,ipoint,1) = int2_u_grad1u_x_j1b2_test(i,j,ipoint,1)
int2_u_grad1u_x_j1b2_test(j,i,ipoint,2) = int2_u_grad1u_x_j1b2_test(i,j,ipoint,2)
int2_u_grad1u_x_j1b2_test(j,i,ipoint,3) = int2_u_grad1u_x_j1b2_test(i,j,ipoint,3)
enddo
enddo
enddo
call wall_time(wall1)
print*, ' wall time for int2_u_grad1u_x_j1b2_test', wall1 - wall0
END_PROVIDER
BEGIN_PROVIDER [ double precision, int2_u_grad1u_j1b2_test, (ao_num, ao_num, n_points_final_grid)]
BEGIN_DOC
!
! int dr2 phi_i(r2) phi_j(r2) 1s_j1b(r2)^2 u_12^mu [\grad_1 u_12^mu]
!
END_DOC
implicit none
integer :: i, j, ipoint, i_1s, i_fit
double precision :: r(3), int_fit, expo_fit, coef_fit, coef_tmp
double precision :: coef, beta, B_center(3), dist
double precision :: alpha_1s, alpha_1s_inv, centr_1s(3), expo_coef_1s, tmp
double precision :: wall0, wall1
double precision, external :: NAI_pol_mult_erf_ao_with1s
double precision :: j12_mu_r12,int_j1b
double precision :: sigma_ij,dist_ij_ipoint,dsqpi_3_2
double precision :: beta_ij,center_ij_1s(3),factor_ij_1s
print*, ' providing int2_u_grad1u_j1b2_test ...'
dsqpi_3_2 = (dacos(-1.d0))**(1.5d0)
provide mu_erf final_grid_points j1b_pen ao_overlap_abs List_comb_thr_b3_cent
call wall_time(wall0)
int2_u_grad1u_j1b2_test = 0.d0
!$OMP PARALLEL DEFAULT (NONE) &
!$OMP PRIVATE (ipoint, i, j, i_1s, i_fit, r, coef, beta, B_center, &
!$OMP coef_fit, expo_fit, int_fit, tmp, alpha_1s, dist, &
!$OMP beta_ij,center_ij_1s,factor_ij_1s, &
!$OMP int_j1b,alpha_1s_inv, centr_1s, expo_coef_1s, coef_tmp) &
!$OMP SHARED (n_points_final_grid, ao_num, List_comb_thr_b3_size, &
!$OMP final_grid_points, ng_fit_jast, &
!$OMP expo_gauss_j_mu_1_erf, coef_gauss_j_mu_1_erf, &
!$OMP ao_prod_dist_grid, ao_prod_sigma, ao_overlap_abs_grid,ao_prod_center,dsqpi_3_2, &
!$OMP List_comb_thr_b3_coef, List_comb_thr_b3_expo, ao_abs_comb_b3_j1b, &
!$OMP List_comb_thr_b3_cent, int2_u_grad1u_j1b2_test)
!$OMP DO
do ipoint = 1, n_points_final_grid
do i = 1, ao_num
do j = i, ao_num
if(dabs(ao_overlap_abs_grid(j,i)).lt.1.d-10)cycle
r(1) = final_grid_points(1,ipoint)
r(2) = final_grid_points(2,ipoint)
r(3) = final_grid_points(3,ipoint)
tmp = 0.d0
do i_1s = 1, List_comb_thr_b3_size(j,i)
coef = List_comb_thr_b3_coef (i_1s,j,i)
beta = List_comb_thr_b3_expo (i_1s,j,i)
int_j1b = ao_abs_comb_b3_j1b(i_1s,j,i)
if(dabs(coef)*dabs(int_j1b).lt.1.d-10)cycle
B_center(1) = List_comb_thr_b3_cent(1,i_1s,j,i)
B_center(2) = List_comb_thr_b3_cent(2,i_1s,j,i)
B_center(3) = List_comb_thr_b3_cent(3,i_1s,j,i)
dist = (B_center(1) - r(1)) * (B_center(1) - r(1)) &
+ (B_center(2) - r(2)) * (B_center(2) - r(2)) &
+ (B_center(3) - r(3)) * (B_center(3) - r(3))
do i_fit = 1, ng_fit_jast
expo_fit = expo_gauss_j_mu_1_erf(i_fit)
call gaussian_product(expo_fit,r,beta,B_center,factor_ij_1s,beta_ij,center_ij_1s)
if(factor_ij_1s*dabs(coef*int_j1b)*dsqpi_3_2*beta_ij**(-1.5d0).lt.1.d-15)cycle
coef_fit = coef_gauss_j_mu_1_erf(i_fit)
alpha_1s = beta + expo_fit
alpha_1s_inv = 1.d0 / alpha_1s
centr_1s(1) = alpha_1s_inv * (beta * B_center(1) + expo_fit * r(1))
centr_1s(2) = alpha_1s_inv * (beta * B_center(2) + expo_fit * r(2))
centr_1s(3) = alpha_1s_inv * (beta * B_center(3) + expo_fit * r(3))
expo_coef_1s = beta * expo_fit * alpha_1s_inv * dist
if(expo_coef_1s .gt. 20.d0) cycle
coef_tmp = coef * coef_fit * dexp(-expo_coef_1s)
if(dabs(coef_tmp) .lt. 1d-08) cycle
int_fit = NAI_pol_mult_erf_ao_with1s(i, j, alpha_1s, centr_1s, 1.d+9, r)
tmp += coef_tmp * int_fit
enddo
enddo
int2_u_grad1u_j1b2_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
int2_u_grad1u_j1b2_test(j,i,ipoint) = int2_u_grad1u_j1b2_test(i,j,ipoint)
enddo
enddo
enddo
call wall_time(wall1)
print*, ' wall time for int2_u_grad1u_j1b2_test', wall1 - wall0
END_PROVIDER
! ---

420
src/ao_many_one_e_ints/grad2_jmu_modif.irp.f Normal file
View File

@ -0,0 +1,420 @@
! ---
BEGIN_PROVIDER [ double precision, int2_grad1u2_grad2u2_j1b2, (ao_num, ao_num, n_points_final_grid)]
BEGIN_DOC
!
! -\frac{1}{4} x int dr2 phi_i(r2) phi_j(r2) 1s_j1b(r2)^2 [1 - erf(mu r12)]^2
!
END_DOC
implicit none
integer :: i, j, ipoint, i_1s, i_fit
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
double precision, external :: overlap_gauss_r12_ao_with1s
print*, ' providing int2_grad1u2_grad2u2_j1b2 ...'
call wall_time(wall0)
provide mu_erf final_grid_points j1b_pen
int2_grad1u2_grad2u2_j1b2 = 0.d0
!$OMP PARALLEL DEFAULT (NONE) &
!$OMP PRIVATE (ipoint, i, j, i_1s, i_fit, r, coef, beta, B_center, &
!$OMP coef_fit, expo_fit, int_fit, tmp) &
!$OMP SHARED (n_points_final_grid, ao_num, List_all_comb_b3_size, &
!$OMP final_grid_points, ng_fit_jast, &
!$OMP expo_gauss_1_erf_x_2, coef_gauss_1_erf_x_2, &
!$OMP List_all_comb_b3_coef, List_all_comb_b3_expo, &
!$OMP List_all_comb_b3_cent, int2_grad1u2_grad2u2_j1b2)
!$OMP DO
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
tmp = 0.d0
do i_fit = 1, ng_fit_jast
expo_fit = expo_gauss_1_erf_x_2(i_fit)
coef_fit = coef_gauss_1_erf_x_2(i_fit)
! ---
int_fit = overlap_gauss_r12_ao(r, expo_fit, i, j)
tmp += -0.25d0 * coef_fit * int_fit
! if(dabs(coef_fit*int_fit) .lt. 1d-12) cycle
! ---