LCPQ/qp2
9
1
Fork 0
mirror of https://github.com/QuantumPackage/qp2.git synced 2024-11-07 14:03:37 +01:00
Code Releases Activity

u^2 j1b^2 added

Browse Source
This commit is contained in:
AbdAmmar 2022-10-13 20:48:26 +02:00
parent b913277daa
commit fce9db0fce
2 changed files with 128 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

92
src/ao_many_one_e_ints/grad2_jmu_modif.irp.f
View File

@ -211,3 +211,95 @@ END_PROVIDER
! ---
BEGIN_PROVIDER [ double precision, int2_u2_j1b, (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)
double precision :: wall0, wall1
double precision, allocatable :: tmp(:,:,:)
double precision, external :: overlap_gauss_r12_ao_with1s
provide mu_erf final_grid_points j1b_pen
call wall_time(wall0)
int2_u2_j1b = 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, n_max_fit_slat, &
!$OMP expo_gauss_j_mu_x_2, coef_gauss_j_mu_x_2, &
!$OMP List_all_comb_b3_coef, List_all_comb_b3_expo, &
!$OMP List_all_comb_b3_cent, int2_u2_j1b)
allocate( tmp(ao_num,ao_num,n_points_final_grid) )
tmp = 0.d0
!$OMP DO
do ipoint = 1, n_points_final_grid
do i = 1, ao_num
do j = i, ao_num
r(1) = final_grid_points(1,ipoint)
r(2) = final_grid_points(2,ipoint)
r(3) = final_grid_points(3,ipoint)
do i_1s = 1, List_all_comb_b3_size
coef = List_all_comb_b3_coef (i_1s)
beta = List_all_comb_b3_expo (i_1s)
B_center(1) = List_all_comb_b3_cent(1,i_1s)
B_center(2) = List_all_comb_b3_cent(2,i_1s)
B_center(3) = List_all_comb_b3_cent(3,i_1s)
do i_fit = 1, n_max_fit_slat
expo_fit = expo_gauss_j_mu_x_2(i_fit)
coef_fit = coef_gauss_j_mu_x_2(i_fit)
int_fit = overlap_gauss_r12_ao_with1s(B_center, beta, r, expo_fit, i, j)
tmp(j,i,ipoint) += coef * coef_fit * int_fit
enddo
enddo
enddo
enddo
enddo
!$OMP END DO
!$OMP CRITICAL
do ipoint = 1, n_points_final_grid
do i = 1, ao_num
do j = i, ao_num
int2_u2_j1b(j,i,ipoint) += tmp(j,i,ipoint)
enddo
enddo
enddo
!$OMP END CRITICAL
deallocate( tmp )
!$OMP END PARALLEL
do ipoint = 1, n_points_final_grid
do i = 1, ao_num
do j = 1, i-1
int2_u2_j1b(j,i,ipoint) = int2_u2_j1b(i,j,ipoint)
enddo
enddo
enddo
call wall_time(wall1)
print*, ' wall time for int2_u2_j1b', wall1 - wall0
END_PROVIDER
! ---

37
src/non_h_ints_mu/fit_j.irp.f
View File

@ -23,7 +23,7 @@ END_PROVIDER
!
! J(mu,r12) = 0.5/mu * F(r12*mu) where F(x) = x * (1 - erf(x)) - 1/sqrt(pi) * exp(-x**2)
!
! F(x) is fitted by - 1/sqrt(pi) * exp(-alpha * x) exp(-beta*mu^2x^2) (see expo_j_xmu)
! F(x) is fitted by - 1/sqrt(pi) * exp(-alpha * x) exp(-beta * x^2) (see expo_j_xmu)
!
! The slater function exp(-alpha * x) is fitted with n_max_fit_slat gaussians
!
@ -49,6 +49,41 @@ END_PROVIDER
END_PROVIDER
! ---
BEGIN_PROVIDER [double precision, expo_gauss_j_mu_x_2, (n_max_fit_slat)]
&BEGIN_PROVIDER [double precision, coef_gauss_j_mu_x_2, (n_max_fit_slat)]
BEGIN_DOC
!
! J(mu,r12)^2 = 0.25/mu^2 F(r12*mu)^2
!
! F(x) = 1 /pi * exp(-2 * alpha * x) exp(-2 * beta * x^2)
!
! The slater function exp(-2 * alpha * x) is fitted with n_max_fit_slat gaussians
!
! See Appendix 2 of JCP 154, 084119 (2021)
!
END_DOC
implicit none
integer :: i
double precision :: tmp
double precision :: expos(n_max_fit_slat), alpha, beta
tmp = 0.25d0 / (mu_erf * mu_erf * dacos(-1.d0))
alpha = 2.d0 * expo_j_xmu(1) * mu_erf
call expo_fit_slater_gam(alpha, expos)
beta = 2.d0 * expo_j_xmu(2) * mu_erf * mu_erf
do i = 1, n_max_fit_slat
expo_gauss_j_mu_x_2(i) = expos(i) + beta
coef_gauss_j_mu_x_2(i) = tmp * coef_fit_slat_gauss(i)
enddo
END_PROVIDER
! ---
double precision function F_x_j(x)