9
1
mirror of https://github.com/QuantumPackage/qp2.git synced 2024-12-26 21:33:30 +01:00
qp2/src/non_h_ints_mu/numerical_integ.irp.f

624 lines
16 KiB
Fortran
Raw Normal View History

2023-02-06 19:00:35 +01:00
! ---
double precision function num_v_ij_u_cst_mu_j1b(i, j, ipoint)
BEGIN_DOC
!
! \int dr2 u12 \phi_i(r2) \phi_j(r2) x v_1b(r2)
!
END_DOC
implicit none
integer, intent(in) :: i, j, ipoint
integer :: jpoint
double precision :: r1(3), r2(3)
double precision, external :: ao_value
double precision, external :: j12_mu, j1b_nucl, j12_mu_gauss
r1(1) = final_grid_points(1,ipoint)
r1(2) = final_grid_points(2,ipoint)
r1(3) = final_grid_points(3,ipoint)
num_v_ij_u_cst_mu_j1b = 0.d0
do jpoint = 1, n_points_final_grid
r2(1) = final_grid_points(1,jpoint)
r2(2) = final_grid_points(2,jpoint)
r2(3) = final_grid_points(3,jpoint)
num_v_ij_u_cst_mu_j1b += ao_value(i, r2) * ao_value(j, r2) * j12_mu_gauss(r1, r2) * j1b_nucl(r2) * final_weight_at_r_vector(jpoint)
enddo
return
end function num_v_ij_u_cst_mu_j1b
! ---
double precision function num_int2_u2_j1b2(i, j, ipoint)
BEGIN_DOC
!
! \int dr2 u12^2 \phi_i(r2) \phi_j(r2) x v_1b(r2)^2
!
END_DOC
implicit none
integer, intent(in) :: i, j, ipoint
integer :: jpoint, i_fit
double precision :: r1(3), r2(3)
double precision :: dx, dy, dz, r12, x2, tmp1, tmp2, tmp3, coef, expo
double precision, external :: ao_value
double precision, external :: j1b_nucl
double precision, external :: j12_mu
r1(1) = final_grid_points(1,ipoint)
r1(2) = final_grid_points(2,ipoint)
r1(3) = final_grid_points(3,ipoint)
num_int2_u2_j1b2 = 0.d0
do jpoint = 1, n_points_final_grid
r2(1) = final_grid_points(1,jpoint)
r2(2) = final_grid_points(2,jpoint)
r2(3) = final_grid_points(3,jpoint)
dx = r1(1) - r2(1)
dy = r1(2) - r2(2)
dz = r1(3) - r2(3)
x2 = dx * dx + dy * dy + dz * dz
r12 = dsqrt(x2)
tmp1 = j1b_nucl(r2)
tmp2 = tmp1 * tmp1 * ao_value(i, r2) * ao_value(j, r2) * final_weight_at_r_vector(jpoint)
!tmp3 = 0.d0
!do i_fit = 1, n_max_fit_slat
! expo = expo_gauss_j_mu_x_2(i_fit)
! coef = coef_gauss_j_mu_x_2(i_fit)
! tmp3 += coef * dexp(-expo*x2)
!enddo
tmp3 = j12_mu(r1, r2)
tmp3 = tmp3 * tmp3
num_int2_u2_j1b2 += tmp2 * tmp3
enddo
return
end function num_int2_u2_j1b2
! ---
double precision function num_int2_grad1u2_grad2u2_j1b2(i, j, ipoint)
BEGIN_DOC
!
! \int dr2 \frac{-[erf(mu r12) -1]^2}{4} \phi_i(r2) \phi_j(r2) x v_1b(r2)^2
!
END_DOC
implicit none
integer, intent(in) :: i, j, ipoint
integer :: jpoint, i_fit
double precision :: r1(3), r2(3)
double precision :: dx, dy, dz, r12, x2, tmp1, tmp2, tmp3, coef, expo
double precision, external :: ao_value
double precision, external :: j1b_nucl
r1(1) = final_grid_points(1,ipoint)
r1(2) = final_grid_points(2,ipoint)
r1(3) = final_grid_points(3,ipoint)
num_int2_grad1u2_grad2u2_j1b2 = 0.d0
do jpoint = 1, n_points_final_grid
r2(1) = final_grid_points(1,jpoint)
r2(2) = final_grid_points(2,jpoint)
r2(3) = final_grid_points(3,jpoint)
dx = r1(1) - r2(1)
dy = r1(2) - r2(2)
dz = r1(3) - r2(3)
x2 = dx * dx + dy * dy + dz * dz
r12 = dsqrt(x2)
tmp1 = j1b_nucl(r2)
tmp2 = tmp1 * tmp1 * ao_value(i, r2) * ao_value(j, r2) * final_weight_at_r_vector(jpoint)
!tmp3 = 0.d0
!do i_fit = 1, n_max_fit_slat
! expo = expo_gauss_1_erf_x_2(i_fit)
! coef = coef_gauss_1_erf_x_2(i_fit)
! tmp3 += coef * dexp(-expo*x2)
!enddo
tmp3 = derf(mu_erf*r12) - 1.d0
tmp3 = tmp3 * tmp3
tmp3 = -0.25d0 * tmp3
num_int2_grad1u2_grad2u2_j1b2 += tmp2 * tmp3
enddo
return
end function num_int2_grad1u2_grad2u2_j1b2
! ---
double precision function num_v_ij_erf_rk_cst_mu_j1b(i, j, ipoint)
BEGIN_DOC
!
! \int dr2 [erf(mu r12) -1]/r12 \phi_i(r2) \phi_j(r2) x v_1b(r2)
!
END_DOC
implicit none
integer, intent(in) :: i, j, ipoint
integer :: jpoint
double precision :: r1(3), r2(3)
double precision :: dx, dy, dz, r12, tmp1, tmp2
double precision, external :: ao_value
double precision, external :: j1b_nucl
r1(1) = final_grid_points(1,ipoint)
r1(2) = final_grid_points(2,ipoint)
r1(3) = final_grid_points(3,ipoint)
num_v_ij_erf_rk_cst_mu_j1b = 0.d0
do jpoint = 1, n_points_final_grid
r2(1) = final_grid_points(1,jpoint)
r2(2) = final_grid_points(2,jpoint)
r2(3) = final_grid_points(3,jpoint)
dx = r1(1) - r2(1)
dy = r1(2) - r2(2)
dz = r1(3) - r2(3)
r12 = dsqrt( dx * dx + dy * dy + dz * dz )
if(r12 .lt. 1d-10) cycle
tmp1 = (derf(mu_erf * r12) - 1.d0) / r12
tmp2 = tmp1 * ao_value(i, r2) * ao_value(j, r2) * j1b_nucl(r2) * final_weight_at_r_vector(jpoint)
num_v_ij_erf_rk_cst_mu_j1b += tmp2
enddo
return
end function num_v_ij_erf_rk_cst_mu_j1b
! ---
subroutine num_x_v_ij_erf_rk_cst_mu_j1b(i, j, ipoint, integ)
BEGIN_DOC
!
! \int dr2 [erf(mu r12) -1]/r12 \phi_i(r2) \phi_j(r2) x v_1b(r2) x r2
!
END_DOC
implicit none
integer, intent(in) :: i, j, ipoint
double precision, intent(out) :: integ(3)
integer :: jpoint
double precision :: r1(3), r2(3), grad(3)
double precision :: dx, dy, dz, r12, tmp1, tmp2
double precision :: tmp_x, tmp_y, tmp_z
double precision, external :: ao_value
double precision, external :: j1b_nucl
r1(1) = final_grid_points(1,ipoint)
r1(2) = final_grid_points(2,ipoint)
r1(3) = final_grid_points(3,ipoint)
tmp_x = 0.d0
tmp_y = 0.d0
tmp_z = 0.d0
do jpoint = 1, n_points_final_grid
r2(1) = final_grid_points(1,jpoint)
r2(2) = final_grid_points(2,jpoint)
r2(3) = final_grid_points(3,jpoint)
dx = r1(1) - r2(1)
dy = r1(2) - r2(2)
dz = r1(3) - r2(3)
r12 = dsqrt( dx * dx + dy * dy + dz * dz )
if(r12 .lt. 1d-10) cycle
tmp1 = (derf(mu_erf * r12) - 1.d0) / r12
tmp2 = tmp1 * ao_value(i, r2) * ao_value(j, r2) * j1b_nucl(r2) * final_weight_at_r_vector(jpoint)
tmp_x += tmp2 * r2(1)
tmp_y += tmp2 * r2(2)
tmp_z += tmp2 * r2(3)
enddo
integ(1) = tmp_x
integ(2) = tmp_y
integ(3) = tmp_z
return
end subroutine num_x_v_ij_erf_rk_cst_mu_j1b
! ---
subroutine num_int2_grad1_u12_ao(i, j, ipoint, integ)
BEGIN_DOC
!
! \int dr2 [-grad_1 u12] \phi_i(r2) \phi_j(r2) x v12_1b(r1, r2)
!
END_DOC
implicit none
integer, intent(in) :: i, j, ipoint
double precision, intent(out) :: integ(3)
integer :: jpoint
double precision :: tmp, r1(3), r2(3), grad(3)
double precision :: tmp_x, tmp_y, tmp_z
double precision, external :: ao_value
r1(1) = final_grid_points(1,ipoint)
r1(2) = final_grid_points(2,ipoint)
r1(3) = final_grid_points(3,ipoint)
tmp_x = 0.d0
tmp_y = 0.d0
tmp_z = 0.d0
do jpoint = 1, n_points_final_grid
r2(1) = final_grid_points(1,jpoint)
r2(2) = final_grid_points(2,jpoint)
r2(3) = final_grid_points(3,jpoint)
tmp = ao_value(i, r2) * ao_value(j, r2) * final_weight_at_r_vector(jpoint)
call grad1_jmu_modif_num(r1, r2, grad)
tmp_x += tmp * (-1.d0 * grad(1))
tmp_y += tmp * (-1.d0 * grad(2))
tmp_z += tmp * (-1.d0 * grad(3))
enddo
integ(1) = tmp_x
integ(2) = tmp_y
integ(3) = tmp_z
return
end subroutine num_int2_grad1_u12_ao
! ---
double precision function num_gradu_squared_u_ij_mu(i, j, ipoint)
BEGIN_DOC
!
! -0.50 x \int r2 \phi_i(2) \phi_j(2) x v2^2
! [ v1^2 ((grad_1 u12)^2 + (grad_2 u12^2)])
! + u12^2 (grad_1 v1)^2
! + 2 u12 v1 (grad_1 u12) . (grad_1 v1)
!
END_DOC
implicit none
integer, intent(in) :: i, j, ipoint
integer :: jpoint
double precision :: r1(3), r2(3)
double precision :: tmp_x, tmp_y, tmp_z, r12
double precision :: dx1_v1, dy1_v1, dz1_v1, grad_u12(3)
double precision :: tmp1, v1_tmp, v2_tmp, u12_tmp
double precision :: fst_term, scd_term, thd_term, tmp
double precision, external :: ao_value
double precision, external :: j1b_nucl
double precision, external :: j12_mu
2023-04-21 20:50:00 +02:00
double precision, external :: grad_x_j1b_nucl_num
double precision, external :: grad_y_j1b_nucl_num
double precision, external :: grad_z_j1b_nucl_num
2023-02-06 19:00:35 +01:00
r1(1) = final_grid_points(1,ipoint)
r1(2) = final_grid_points(2,ipoint)
r1(3) = final_grid_points(3,ipoint)
num_gradu_squared_u_ij_mu = 0.d0
do jpoint = 1, n_points_final_grid
r2(1) = final_grid_points(1,jpoint)
r2(2) = final_grid_points(2,jpoint)
r2(3) = final_grid_points(3,jpoint)
tmp_x = r1(1) - r2(1)
tmp_y = r1(2) - r2(2)
tmp_z = r1(3) - r2(3)
r12 = dsqrt(tmp_x*tmp_x + tmp_y*tmp_y + tmp_z*tmp_z)
2023-04-21 20:50:00 +02:00
dx1_v1 = grad_x_j1b_nucl_num(r1)
dy1_v1 = grad_y_j1b_nucl_num(r1)
dz1_v1 = grad_z_j1b_nucl_num(r1)
2023-02-06 19:00:35 +01:00
2023-04-21 20:50:00 +02:00
call grad1_j12_mu(r1, r2, grad_u12)
2023-02-06 19:00:35 +01:00
tmp1 = 1.d0 - derf(mu_erf * r12)
v1_tmp = j1b_nucl(r1)
v2_tmp = j1b_nucl(r2)
u12_tmp = j12_mu(r1, r2)
fst_term = 0.5d0 * tmp1 * tmp1 * v1_tmp * v1_tmp
scd_term = u12_tmp * u12_tmp * (dx1_v1*dx1_v1 + dy1_v1*dy1_v1 + dz1_v1*dz1_v1)
thd_term = 2.d0 * v1_tmp * u12_tmp * (dx1_v1*grad_u12(1) + dy1_v1*grad_u12(2) + dz1_v1*grad_u12(3))
tmp = -0.5d0 * ao_value(i, r2) * ao_value(j, r2) * final_weight_at_r_vector(jpoint) * (fst_term + scd_term + thd_term) * v2_tmp * v2_tmp
num_gradu_squared_u_ij_mu += tmp
enddo
return
end function num_gradu_squared_u_ij_mu
! ---
double precision function num_grad12_j12(i, j, ipoint)
BEGIN_DOC
!
! -0.50 x \int r2 \phi_i(2) \phi_j(2) x v2^2 [v1^2 ((grad_1 u12)^2 + (grad_2 u12^2)]) ]
!
END_DOC
implicit none
integer, intent(in) :: i, j, ipoint
integer :: jpoint
double precision :: r1(3), r2(3)
double precision :: tmp_x, tmp_y, tmp_z, r12
double precision :: dx1_v1, dy1_v1, dz1_v1, grad_u12(3)
double precision :: tmp1, v1_tmp, v2_tmp, u12_tmp
double precision :: fst_term, scd_term, thd_term, tmp
double precision, external :: ao_value
double precision, external :: j1b_nucl
double precision, external :: j12_mu
2023-04-21 20:50:00 +02:00
double precision, external :: grad_x_j1b_nucl_num
double precision, external :: grad_y_j1b_nucl_num
double precision, external :: grad_z_j1b_nucl_num
2023-02-06 19:00:35 +01:00
r1(1) = final_grid_points(1,ipoint)
r1(2) = final_grid_points(2,ipoint)
r1(3) = final_grid_points(3,ipoint)
num_grad12_j12 = 0.d0
do jpoint = 1, n_points_final_grid
r2(1) = final_grid_points(1,jpoint)
r2(2) = final_grid_points(2,jpoint)
r2(3) = final_grid_points(3,jpoint)
tmp_x = r1(1) - r2(1)
tmp_y = r1(2) - r2(2)
tmp_z = r1(3) - r2(3)
r12 = dsqrt(tmp_x*tmp_x + tmp_y*tmp_y + tmp_z*tmp_z)
2023-04-21 20:50:00 +02:00
dx1_v1 = grad_x_j1b_nucl_num(r1)
dy1_v1 = grad_y_j1b_nucl_num(r1)
dz1_v1 = grad_z_j1b_nucl_num(r1)
2023-02-06 19:00:35 +01:00
2023-04-21 20:50:00 +02:00
call grad1_j12_mu(r1, r2, grad_u12)
2023-02-06 19:00:35 +01:00
tmp1 = 1.d0 - derf(mu_erf * r12)
v1_tmp = j1b_nucl(r1)
v2_tmp = j1b_nucl(r2)
u12_tmp = j12_mu(r1, r2)
fst_term = 0.5d0 * tmp1 * tmp1 * v1_tmp * v1_tmp
tmp = -0.5d0 * ao_value(i, r2) * ao_value(j, r2) * final_weight_at_r_vector(jpoint) * fst_term * v2_tmp * v2_tmp
num_grad12_j12 += tmp
enddo
return
end function num_grad12_j12
! ---
double precision function num_u12sq_j1bsq(i, j, ipoint)
BEGIN_DOC
!
! -0.50 x \int r2 \phi_i(2) \phi_j(2) x v2^2 [ u12^2 (grad_1 v1)^2 ]
!
END_DOC
implicit none
integer, intent(in) :: i, j, ipoint
integer :: jpoint
double precision :: r1(3), r2(3)
double precision :: tmp_x, tmp_y, tmp_z, r12
double precision :: dx1_v1, dy1_v1, dz1_v1, grad_u12(3)
double precision :: tmp1, v1_tmp, v2_tmp, u12_tmp
double precision :: fst_term, scd_term, thd_term, tmp
double precision, external :: ao_value
double precision, external :: j1b_nucl
double precision, external :: j12_mu
2023-04-21 20:50:00 +02:00
double precision, external :: grad_x_j1b_nucl_num
double precision, external :: grad_y_j1b_nucl_num
double precision, external :: grad_z_j1b_nucl_num
2023-02-06 19:00:35 +01:00
r1(1) = final_grid_points(1,ipoint)
r1(2) = final_grid_points(2,ipoint)
r1(3) = final_grid_points(3,ipoint)
num_u12sq_j1bsq = 0.d0
do jpoint = 1, n_points_final_grid
r2(1) = final_grid_points(1,jpoint)
r2(2) = final_grid_points(2,jpoint)
r2(3) = final_grid_points(3,jpoint)
tmp_x = r1(1) - r2(1)
tmp_y = r1(2) - r2(2)
tmp_z = r1(3) - r2(3)
r12 = dsqrt(tmp_x*tmp_x + tmp_y*tmp_y + tmp_z*tmp_z)
2023-04-21 20:50:00 +02:00
dx1_v1 = grad_x_j1b_nucl_num(r1)
dy1_v1 = grad_y_j1b_nucl_num(r1)
dz1_v1 = grad_z_j1b_nucl_num(r1)
2023-02-06 19:00:35 +01:00
2023-04-21 20:50:00 +02:00
call grad1_j12_mu(r1, r2, grad_u12)
2023-02-06 19:00:35 +01:00
tmp1 = 1.d0 - derf(mu_erf * r12)
v1_tmp = j1b_nucl(r1)
v2_tmp = j1b_nucl(r2)
u12_tmp = j12_mu(r1, r2)
scd_term = u12_tmp * u12_tmp * (dx1_v1*dx1_v1 + dy1_v1*dy1_v1 + dz1_v1*dz1_v1)
tmp = -0.5d0 * ao_value(i, r2) * ao_value(j, r2) * final_weight_at_r_vector(jpoint) * scd_term * v2_tmp * v2_tmp
num_u12sq_j1bsq += tmp
enddo
return
end function num_u12sq_j1bsq
! ---
double precision function num_u12_grad1_u12_j1b_grad1_j1b(i, j, ipoint)
BEGIN_DOC
!
! -0.50 x \int r2 \phi_i(2) \phi_j(2) x v2^2 [ 2 u12 v1 (grad_1 u12) . (grad_1 v1) ]
!
END_DOC
implicit none
integer, intent(in) :: i, j, ipoint
integer :: jpoint
double precision :: r1(3), r2(3)
double precision :: tmp_x, tmp_y, tmp_z, r12
double precision :: dx1_v1, dy1_v1, dz1_v1, grad_u12(3)
double precision :: tmp1, v1_tmp, v2_tmp, u12_tmp
double precision :: fst_term, scd_term, thd_term, tmp
double precision, external :: ao_value
double precision, external :: j1b_nucl
double precision, external :: j12_mu
2023-04-21 20:50:00 +02:00
double precision, external :: grad_x_j1b_nucl_num
double precision, external :: grad_y_j1b_nucl_num
double precision, external :: grad_z_j1b_nucl_num
2023-02-06 19:00:35 +01:00
r1(1) = final_grid_points(1,ipoint)
r1(2) = final_grid_points(2,ipoint)
r1(3) = final_grid_points(3,ipoint)
num_u12_grad1_u12_j1b_grad1_j1b = 0.d0
do jpoint = 1, n_points_final_grid
r2(1) = final_grid_points(1,jpoint)
r2(2) = final_grid_points(2,jpoint)
r2(3) = final_grid_points(3,jpoint)
tmp_x = r1(1) - r2(1)
tmp_y = r1(2) - r2(2)
tmp_z = r1(3) - r2(3)
r12 = dsqrt(tmp_x*tmp_x + tmp_y*tmp_y + tmp_z*tmp_z)
2023-04-21 20:50:00 +02:00
dx1_v1 = grad_x_j1b_nucl_num(r1)
dy1_v1 = grad_y_j1b_nucl_num(r1)
dz1_v1 = grad_z_j1b_nucl_num(r1)
2023-02-06 19:00:35 +01:00
2023-04-21 20:50:00 +02:00
call grad1_j12_mu(r1, r2, grad_u12)
2023-02-06 19:00:35 +01:00
tmp1 = 1.d0 - derf(mu_erf * r12)
v1_tmp = j1b_nucl(r1)
v2_tmp = j1b_nucl(r2)
u12_tmp = j12_mu(r1, r2)
thd_term = 2.d0 * v1_tmp * u12_tmp * (dx1_v1*grad_u12(1) + dy1_v1*grad_u12(2) + dz1_v1*grad_u12(3))
tmp = -0.5d0 * ao_value(i, r2) * ao_value(j, r2) * final_weight_at_r_vector(jpoint) * thd_term * v2_tmp * v2_tmp
num_u12_grad1_u12_j1b_grad1_j1b += tmp
enddo
return
end function num_u12_grad1_u12_j1b_grad1_j1b
! ---
subroutine num_int2_u_grad1u_total_j1b2(i, j, ipoint, integ)
BEGIN_DOC
!
! \int dr2 u12 (grad_1 u12) \phi_i(r2) \phi_j(r2) x v_1b(r2)^2
!
END_DOC
implicit none
integer, intent(in) :: i, j, ipoint
double precision, intent(out) :: integ(3)
integer :: jpoint
double precision :: r1(3), r2(3), grad(3)
double precision :: dx, dy, dz, r12, tmp0, tmp1, tmp2
double precision :: tmp_x, tmp_y, tmp_z
double precision, external :: ao_value
double precision, external :: j1b_nucl
double precision, external :: j12_mu
r1(1) = final_grid_points(1,ipoint)
r1(2) = final_grid_points(2,ipoint)
r1(3) = final_grid_points(3,ipoint)
tmp_x = 0.d0
tmp_y = 0.d0
tmp_z = 0.d0
do jpoint = 1, n_points_final_grid
r2(1) = final_grid_points(1,jpoint)
r2(2) = final_grid_points(2,jpoint)
r2(3) = final_grid_points(3,jpoint)
dx = r1(1) - r2(1)
dy = r1(2) - r2(2)
dz = r1(3) - r2(3)
r12 = dsqrt( dx * dx + dy * dy + dz * dz )
if(r12 .lt. 1d-10) cycle
tmp0 = j1b_nucl(r2)
tmp1 = 0.5d0 * j12_mu(r1, r2) * (1.d0 - derf(mu_erf * r12)) / r12
tmp2 = tmp0 * tmp0 * tmp1 * ao_value(i, r2) * ao_value(j, r2) * final_weight_at_r_vector(jpoint)
tmp_x += tmp2 * dx
tmp_y += tmp2 * dy
tmp_z += tmp2 * dz
enddo
integ(1) = tmp_x
integ(2) = tmp_y
integ(3) = tmp_z
return
end subroutine num_int2_u_grad1u_total_j1b2
! ---