10
0
mirror of https://github.com/QuantumPackage/qp2.git synced 2025-01-08 20:33:20 +01:00

few opt in cgtos integrals

This commit is contained in:
AbdAmmar 2024-10-20 11:18:28 +02:00
parent a38bf1bcb2
commit 3589688254
3 changed files with 21 additions and 15 deletions

View File

@ -158,24 +158,27 @@ complex*16 function NAI_pol_mult_cgtos(Ae_center, Be_center, power_A, power_B, a
p_inv = (1.d0, 0.d0) / p
rho = alpha * beta * p_inv
dist = (0.d0, 0.d0)
dist_integral = (0.d0, 0.d0)
do i = 1, 3
P_center(i) = (alpha * Ae_center(i) + beta * Be_center(i)) * p_inv
dist += (Ae_center(i) - Be_center(i)) * (Ae_center(i) - Be_center(i))
dist_integral += (P_center(i) - C_center(i)) * (P_center(i) - C_center(i))
enddo
dist = (Ae_center(1) - Be_center(1)) * (Ae_center(1) - Be_center(1)) &
+ (Ae_center(2) - Be_center(2)) * (Ae_center(2) - Be_center(2)) &
+ (Ae_center(3) - Be_center(3)) * (Ae_center(3) - Be_center(3))
const_factor = dist * rho
const = p * dist_integral
if(abs(const_factor) > 80.d0) then
if(real(const_factor) > 80.d0) then
NAI_pol_mult_cgtos = (0.d0, 0.d0)
return
endif
P_center(1) = (alpha * Ae_center(1) + beta * Be_center(1)) * p_inv
P_center(2) = (alpha * Ae_center(2) + beta * Be_center(2)) * p_inv
P_center(3) = (alpha * Ae_center(3) + beta * Be_center(3)) * p_inv
dist_integral = (P_center(1) - C_center(1)) * (P_center(1) - C_center(1)) &
+ (P_center(2) - C_center(2)) * (P_center(2) - C_center(2)) &
+ (P_center(3) - C_center(3)) * (P_center(3) - C_center(3))
const = p * dist_integral
factor = zexp(-const_factor)
coeff = dtwo_pi * factor * p_inv
coeff = dtwo_pi * factor * p_inv
n_pt = 2 * ((power_A(1) + power_B(1)) + (power_A(2) + power_B(2)) + (power_A(3) + power_B(3)))
if(n_pt == 0) then
@ -219,7 +222,7 @@ subroutine give_cpolynomial_mult_center_one_e(A_center, B_center, alpha, beta, &
integer :: a_x, b_x, a_y, b_y, a_z, b_z
integer :: n_pt1, n_pt2, n_pt3, dim, i, n_pt_tmp
complex*16 :: p, P_center(3), rho, p_inv, p_inv_2
complex*16 :: R1x(0:2), B01(0:2), R1xp(0:2),R2x(0:2)
complex*16 :: R1x(0:2), B01(0:2), R1xp(0:2), R2x(0:2)
complex*16 :: d1(0:n_pt_in), d2(0:n_pt_in), d3(0:n_pt_in)
ASSERT (n_pt_in > 1)
@ -354,13 +357,13 @@ recursive subroutine I_x1_pol_mult_one_e_cgtos(a, c, R1x, R1xp, R2x, d, nd, n_pt
dim = n_pt_in
if( (a==0) .and. (c==0)) then
if((a == 0) .and. (c == 0)) then
nd = 0
d(0) = (1.d0, 0.d0)
return
elseif( (c < 0) .or. (nd < 0) ) then
elseif((c < 0) .or. (nd < 0)) then
nd = -1
return

View File

@ -42,6 +42,7 @@ complex*16 function overlap_cgaussian_x(Ae_center, Be_center, alpha, beta, power
overlap_cgaussian_x = overlap_cgaussian_x * fact_p
return
end
! ---

View File

@ -164,6 +164,7 @@ subroutine cgaussian_product(a, xa, b, xb, k, p, xp)
END_DOC
implicit none
complex*16, intent(in) :: a, b, xa(3), xb(3)
complex*16, intent(out) :: p, k, xp(3)
@ -196,6 +197,7 @@ subroutine cgaussian_product(a, xa, b, xb, k, p, xp)
xp(2) = (a * xa(2) + b * xb(2)) * p_inv
xp(3) = (a * xa(3) + b * xb(3)) * p_inv
return
end
! ---
@ -458,7 +460,7 @@ complex*16 function Fc_integral(n, inv_sq_p)
inv_sq_p4 = inv_sq_p2 * inv_sq_p2
Fc_integral = 29.53125d0 * sqpi * inv_sq_p * inv_sq_p2 * inv_sq_p4 * inv_sq_p4
case default
Fc_integral = sqpi * 0.5d0**n * inv_sq_p**(n+1) * fact(n) / fact(shiftr(n, 1))
Fc_integral = 2.d0 * sqpi * (0.5d0 * inv_sq_p)**(n+1) * fact(n) / fact(shiftr(n, 1))
end select
return