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:
parent
a38bf1bcb2
commit
3589688254
@ -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
|
||||
|
@ -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
|
||||
|
||||
! ---
|
||||
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user