mirror of
https://github.com/QuantumPackage/qp2.git
synced 2024-12-22 11:33:29 +01:00
fixed bug in cpx polyn multip
This commit is contained in:
AbdAmmar
parent
3589688254
commit
398ca5ceb7
@ -12,16 +12,19 @@ BEGIN_PROVIDER [double precision, ao_integrals_n_e_cgtos, (ao_num, ao_num)]
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
integer :: power_A(3), power_B(3)
|
||||
integer :: i, j, k, l, m, n, ii, jj
|
||||
double precision :: c, Z, C_center(3)
|
||||
double precision :: phiA, KA2
|
||||
double precision :: phiB, KB2
|
||||
complex*16 :: alpha, alpha_inv, Ae_center(3), Ap_center(3)
|
||||
complex*16 :: beta, beta_inv, Be_center(3), Bp_center(3)
|
||||
complex*16 :: C1, C2, I1, I2
|
||||
|
||||
complex*16 :: NAI_pol_mult_cgtos
|
||||
integer :: power_A(3), power_B(3)
|
||||
integer :: i, j, k, l, m, n, ii, jj
|
||||
double precision :: c, Z, C_center(3)
|
||||
double precision :: phiA, KA2
|
||||
double precision :: phiB, KB2
|
||||
complex*16 :: alpha, alpha_inv, Ae_center(3), Ap_center(3)
|
||||
complex*16 :: beta, beta_inv, Be_center(3), Bp_center(3)
|
||||
complex*16 :: C1, C2, I1, I2
|
||||
|
||||
complex*16, external :: NAI_pol_mult_cgtos
|
||||
|
||||
|
||||
|
||||
ao_integrals_n_e_cgtos = 0.d0
|
||||
|
||||
@ -140,7 +143,6 @@ complex*16 function NAI_pol_mult_cgtos(Ae_center, Be_center, power_A, power_B, a
|
||||
dist_AC += abs(Ae_center(i) - C_center(i) * (1.d0, 0.d0))
|
||||
enddo
|
||||
|
||||
|
||||
if((dist_AB .gt. 1d-13) .or. (dist_AC .gt. 1d-13) .or. use_pw) then
|
||||
|
||||
continue
|
||||
@ -217,7 +219,7 @@ subroutine give_cpolynomial_mult_center_one_e(A_center, B_center, alpha, beta, &
|
||||
double precision, intent(in) :: C_center(3)
|
||||
complex*16, intent(in) :: alpha, beta, A_center(3), B_center(3)
|
||||
integer, intent(out) :: n_pt_out
|
||||
complex*16, intent(out) :: d(0:n_pt_in)
|
||||
complex*16, intent(inout) :: d(0:n_pt_in)
|
||||
|
||||
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
|
||||
@ -231,9 +233,9 @@ subroutine give_cpolynomial_mult_center_one_e(A_center, B_center, alpha, beta, &
|
||||
p_inv = (1.d0, 0.d0) / p
|
||||
p_inv_2 = 0.5d0 * p_inv
|
||||
|
||||
do i = 1, 3
|
||||
P_center(i) = (alpha * A_center(i) + beta * B_center(i)) * p_inv
|
||||
enddo
|
||||
P_center(1) = (alpha * A_center(1) + beta * B_center(1)) * p_inv
|
||||
P_center(2) = (alpha * A_center(2) + beta * B_center(2)) * p_inv
|
||||
P_center(3) = (alpha * A_center(3) + beta * B_center(3)) * p_inv
|
||||
|
||||
do i = 0, n_pt_in
|
||||
d(i) = (0.d0, 0.d0)
|
||||
@ -260,6 +262,7 @@ subroutine give_cpolynomial_mult_center_one_e(A_center, B_center, alpha, beta, &
|
||||
|
||||
a_x = power_A(1)
|
||||
b_x = power_B(1)
|
||||
|
||||
call I_x1_pol_mult_one_e_cgtos(a_x, b_x, R1x, R1xp, R2x, d1, n_pt1, n_pt_in)
|
||||
|
||||
if(n_pt1 < 0) then
|
||||
@ -284,6 +287,7 @@ subroutine give_cpolynomial_mult_center_one_e(A_center, B_center, alpha, beta, &
|
||||
|
||||
a_y = power_A(2)
|
||||
b_y = power_B(2)
|
||||
|
||||
call I_x1_pol_mult_one_e_cgtos(a_y, b_y, R1x, R1xp, R2x, d2, n_pt2, n_pt_in)
|
||||
|
||||
if(n_pt2 < 0) then
|
||||
@ -308,6 +312,7 @@ subroutine give_cpolynomial_mult_center_one_e(A_center, B_center, alpha, beta, &
|
||||
|
||||
a_z = power_A(3)
|
||||
b_z = power_B(3)
|
||||
|
||||
call I_x1_pol_mult_one_e_cgtos(a_z, b_z, R1x, R1xp, R2x, d3, n_pt3, n_pt_in)
|
||||
|
||||
if(n_pt3 < 0) then
|
||||
@ -322,11 +327,9 @@ subroutine give_cpolynomial_mult_center_one_e(A_center, B_center, alpha, beta, &
|
||||
|
||||
n_pt_tmp = 0
|
||||
call multiply_cpoly(d1, n_pt1, d2, n_pt2, d, n_pt_tmp)
|
||||
do i = 0, n_pt_tmp
|
||||
d1(i) = (0.d0, 0.d0)
|
||||
enddo
|
||||
|
||||
n_pt_out = 0
|
||||
d1(0:n_pt_tmp) = (0.d0, 0.d0)
|
||||
call multiply_cpoly(d, n_pt_tmp, d3, n_pt3, d1, n_pt_out)
|
||||
do i = 0, n_pt_out
|
||||
d(i) = d1(i)
|
||||
|
||||
@ -3,7 +3,7 @@ logical function ao_one_e_integral_zero(i,k)
|
||||
integer, intent(in) :: i,k
|
||||
|
||||
ao_one_e_integral_zero = .False.
|
||||
if (.not.((io_ao_integrals_overlap/='None').or.is_periodic)) then
|
||||
if (.not.((io_ao_integrals_overlap/='None').or.is_periodic.or.use_cgtos)) then
|
||||
if (ao_overlap_abs(i,k) < ao_one_e_integrals_threshold) then
|
||||
ao_one_e_integral_zero = .True.
|
||||
return
|
||||
|
||||
@ -1,153 +0,0 @@
|
||||
|
||||
! ---
|
||||
|
||||
subroutine deb_ao_2eint_cgtos(i, j, k, l)
|
||||
|
||||
BEGIN_DOC
|
||||
! integral of the AO basis <ik|jl> or (ij|kl)
|
||||
! i(r1) j(r1) 1/r12 k(r2) l(r2)
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
include 'utils/constants.include.F'
|
||||
|
||||
integer, intent(in) :: i, j, k, l
|
||||
|
||||
integer :: p, q, r, s
|
||||
integer :: num_i, num_j, num_k, num_l, dim1, I_power(3), J_power(3), K_power(3), L_power(3)
|
||||
integer :: iorder_p1(3), iorder_p2(3), iorder_q1(3), iorder_q2(3)
|
||||
complex*16 :: I_center(3), J_center(3), K_center(3), L_center(3)
|
||||
complex*16 :: expo1, expo2, expo3, expo4
|
||||
complex*16 :: P1_center(3), pp1
|
||||
complex*16 :: P2_center(3), pp2
|
||||
complex*16 :: Q1_center(3), qq1
|
||||
complex*16 :: Q2_center(3), qq2
|
||||
|
||||
|
||||
|
||||
dim1 = n_pt_max_integrals
|
||||
|
||||
num_i = ao_nucl(i)
|
||||
num_j = ao_nucl(j)
|
||||
num_k = ao_nucl(k)
|
||||
num_l = ao_nucl(l)
|
||||
|
||||
if(num_i /= num_j .or. num_k /= num_l .or. num_j /= num_k) then
|
||||
|
||||
!print*, ao_prim_num(i), ao_prim_num(j), ao_prim_num(k), ao_prim_num(l)
|
||||
|
||||
do p = 1, 3
|
||||
I_power(p) = ao_power(i,p)
|
||||
J_power(p) = ao_power(j,p)
|
||||
K_power(p) = ao_power(k,p)
|
||||
L_power(p) = ao_power(l,p)
|
||||
I_center(p) = nucl_coord(num_i,p) * (1.d0, 0.d0)
|
||||
J_center(p) = nucl_coord(num_j,p) * (1.d0, 0.d0)
|
||||
K_center(p) = nucl_coord(num_k,p) * (1.d0, 0.d0)
|
||||
L_center(p) = nucl_coord(num_l,p) * (1.d0, 0.d0)
|
||||
enddo
|
||||
|
||||
do p = 1, ao_prim_num(i)
|
||||
expo1 = ao_expo_cgtos_ord_transp(p,i)
|
||||
!print*, "expo1 = ", expo1
|
||||
!print*, "center1 = ", I_center
|
||||
|
||||
do q = 1, ao_prim_num(j)
|
||||
expo2 = ao_expo_cgtos_ord_transp(q,j)
|
||||
!print*, "expo2 = ", expo2
|
||||
!print*, "center2 = ", J_center
|
||||
|
||||
pp1 = expo1 + expo2
|
||||
P1_center(1:3) = (expo1 * I_center(1:3) + expo2 * J_center(1:3)) / pp1
|
||||
iorder_p1(1:3) = I_power(1:3) + J_power(1:3)
|
||||
|
||||
pp2 = conjg(expo1) + expo2
|
||||
P2_center(1:3) = (conjg(expo1) * I_center(1:3) + expo2 * J_center(1:3)) / pp2
|
||||
iorder_p2(1:3) = I_power(1:3) + J_power(1:3)
|
||||
|
||||
do r = 1, ao_prim_num(k)
|
||||
expo3 = ao_expo_cgtos_ord_transp(r,k)
|
||||
!print*, "expo3 = ", expo3
|
||||
!print*, "center3 = ", K_center
|
||||
|
||||
do s = 1, ao_prim_num(l)
|
||||
expo4 = ao_expo_cgtos_ord_transp(s,l)
|
||||
!print*, "expo4 = ", expo4
|
||||
!print*, "center4 = ", L_center
|
||||
|
||||
qq1 = expo3 + expo4
|
||||
Q1_center(1:3) = (expo3 * K_center(1:3) + expo4 * L_center(1:3)) / qq1
|
||||
iorder_q1(1:3) = K_power(1:3) + L_power(1:3)
|
||||
|
||||
qq2 = conjg(expo3) + expo4
|
||||
Q2_center(1:3) = (conjg(expo3) * K_center(1:3) + expo4 * L_center(1:3)) / qq2
|
||||
iorder_q2(1:3) = K_power(1:3) + L_power(1:3)
|
||||
|
||||
call deb_cboys(P1_center, pp1, iorder_p1, Q1_center, qq1, iorder_q1)
|
||||
call deb_cboys(P1_center, pp1, iorder_p1, Q2_center, qq2, iorder_q2)
|
||||
call deb_cboys(P2_center, pp2, iorder_p2, Q1_center, qq1, iorder_q1)
|
||||
call deb_cboys(P2_center, pp2, iorder_p2, Q2_center, qq2, iorder_q2)
|
||||
call deb_cboys(conjg(P2_center), conjg(pp2), iorder_p2, Q1_center, qq1, iorder_q1)
|
||||
call deb_cboys(conjg(P2_center), conjg(pp2), iorder_p2, Q2_center, qq2, iorder_q2)
|
||||
call deb_cboys(conjg(P1_center), conjg(pp1), iorder_p1, Q1_center, qq1, iorder_q1)
|
||||
call deb_cboys(conjg(P1_center), conjg(pp1), iorder_p1, Q2_center, qq2, iorder_q2)
|
||||
enddo ! s
|
||||
enddo ! r
|
||||
enddo ! q
|
||||
enddo ! p
|
||||
|
||||
endif ! same centers
|
||||
|
||||
return
|
||||
end
|
||||
|
||||
! ---
|
||||
|
||||
subroutine deb_cboys(P_center, p, iorder_p, Q_center, q, iorder_q)
|
||||
|
||||
|
||||
implicit none
|
||||
include 'utils/constants.include.F'
|
||||
|
||||
integer, intent(in) :: iorder_p(3), iorder_q(3)
|
||||
complex*16, intent(in) :: P_center(3), p
|
||||
complex*16, intent(in) :: Q_center(3), q
|
||||
|
||||
integer :: iorder, n
|
||||
complex*16 :: dist, rho
|
||||
complex*16 :: int1, int2
|
||||
|
||||
complex*16, external :: crint_2
|
||||
|
||||
|
||||
dist = (P_center(1) - Q_center(1)) * (P_center(1) - Q_center(1)) &
|
||||
+ (P_center(2) - Q_center(2)) * (P_center(2) - Q_center(2)) &
|
||||
+ (P_center(3) - Q_center(3)) * (P_center(3) - Q_center(3))
|
||||
rho = dist * p * q / (p + q)
|
||||
|
||||
if(abs(rho) .lt. 1d-15) return
|
||||
|
||||
iorder = 2*iorder_p(1)+2*iorder_q(1) + 2*iorder_p(2)+2*iorder_q(2) + 2*iorder_p(3)+2*iorder_q(3)
|
||||
n = shiftr(iorder, 1)
|
||||
|
||||
!write(33,*) n, real(rho), aimag(rho)
|
||||
!print*, n, real(rho), aimag(rho)
|
||||
|
||||
int1 = crint_2(n, rho)
|
||||
call crint_quad_12(n, rho, 1000000, int2)
|
||||
|
||||
if(abs(int1 - int2) .gt. 1d-5) then
|
||||
print*, ' important error found: '
|
||||
print*, p!, P_center
|
||||
print*, q!, Q_center
|
||||
print*, dist
|
||||
print*, " n, tho = ", n, real(rho), aimag(rho)
|
||||
print*, real(int1), real(int2), dabs(real(int1-int2))
|
||||
print*, aimag(int1), aimag(int2), dabs(aimag(int1-int2))
|
||||
stop
|
||||
endif
|
||||
|
||||
end
|
||||
|
||||
! ---
|
||||
|
||||
@ -882,15 +882,13 @@ complex*16 function general_primitive_integral_cgtos(dim, P_new, P_center, fact_
|
||||
complex*16, intent(in) :: Q_new(0:max_dim,3), Q_center(3), fact_q, q, q_inv
|
||||
|
||||
integer :: i, j, nx, ny, nz, n_Ix, n_Iy, n_Iz, iorder, n_pt_tmp, n_pt_out
|
||||
double precision :: tmp_mod
|
||||
double precision :: ppq_re, ppq_im, ppq_mod, sq_ppq_re, sq_ppq_im
|
||||
complex*16 :: pq, pq_inv, pq_inv_2, p01_1, p01_2, p10_1, p10_2, ppq, sq_ppq
|
||||
complex*16 :: rho, dist, const
|
||||
complex*16 :: accu, tmp_p, tmp_q
|
||||
complex*16 :: dx(0:max_dim), Ix_pol(0:max_dim), dy(0:max_dim), Iy_pol(0:max_dim), dz(0:max_dim), Iz_pol(0:max_dim)
|
||||
complex*16 :: d1(0:max_dim), d_poly(0:max_dim)
|
||||
|
||||
complex*16 :: crint_sum
|
||||
complex*16, external :: crint_sum
|
||||
|
||||
|
||||
!DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: dx, Ix_pol, dy, Iy_pol, dz, Iz_pol
|
||||
@ -919,15 +917,13 @@ complex*16 function general_primitive_integral_cgtos(dim, P_new, P_center, fact_
|
||||
n_Ix = 0
|
||||
do i = 0, iorder_p(1)
|
||||
|
||||
tmp_p = P_new(i,1)
|
||||
tmp_mod = dsqrt(real(tmp_p)*real(tmp_p) + aimag(tmp_p)*aimag(tmp_p))
|
||||
if(tmp_mod < thresh) cycle
|
||||
tmp_p = P_new(i,1)
|
||||
if(zabs(tmp_p) < thresh) cycle
|
||||
|
||||
do j = 0, iorder_q(1)
|
||||
|
||||
tmp_q = tmp_p * Q_new(j,1)
|
||||
tmp_mod = dsqrt(real(tmp_q)*real(tmp_q) + aimag(tmp_q)*aimag(tmp_q))
|
||||
if(tmp_mod < thresh) cycle
|
||||
tmp_q = tmp_p * Q_new(j,1)
|
||||
if(zabs(tmp_q) < thresh) cycle
|
||||
|
||||
!DIR$ FORCEINLINE
|
||||
call give_cpolynom_mult_center_x(P_center(1), Q_center(1), i, j, p, q, iorder, pq_inv, pq_inv_2, p10_1, p01_1, p10_2, p01_2, dx, nx)
|
||||
@ -950,15 +946,13 @@ complex*16 function general_primitive_integral_cgtos(dim, P_new, P_center, fact_
|
||||
n_Iy = 0
|
||||
do i = 0, iorder_p(2)
|
||||
|
||||
tmp_p = P_new(i,2)
|
||||
tmp_mod = dsqrt(REAL(tmp_p)*REAL(tmp_p) + AIMAG(tmp_p)*AIMAG(tmp_p))
|
||||
if(tmp_mod < thresh) cycle
|
||||
tmp_p = P_new(i,2)
|
||||
if(zabs(tmp_p) < thresh) cycle
|
||||
|
||||
do j = 0, iorder_q(2)
|
||||
|
||||
tmp_q = tmp_p * Q_new(j,2)
|
||||
tmp_mod = dsqrt(REAL(tmp_q)*REAL(tmp_q) + AIMAG(tmp_q)*AIMAG(tmp_q))
|
||||
if(tmp_mod < thresh) cycle
|
||||
tmp_q = tmp_p * Q_new(j,2)
|
||||
if(zabs(tmp_q) < thresh) cycle
|
||||
|
||||
!DIR$ FORCEINLINE
|
||||
call give_cpolynom_mult_center_x(P_center(2), Q_center(2), i, j, p, q, iorder, pq_inv, pq_inv_2, p10_1, p01_1, p10_2, p01_2, dy, ny)
|
||||
@ -982,15 +976,13 @@ complex*16 function general_primitive_integral_cgtos(dim, P_new, P_center, fact_
|
||||
n_Iz = 0
|
||||
do i = 0, iorder_p(3)
|
||||
|
||||
tmp_p = P_new(i,3)
|
||||
tmp_mod = dsqrt(REAL(tmp_p)*REAL(tmp_p) + AIMAG(tmp_p)*AIMAG(tmp_p))
|
||||
if(tmp_mod < thresh) cycle
|
||||
tmp_p = P_new(i,3)
|
||||
if(zabs(tmp_p) < thresh) cycle
|
||||
|
||||
do j = 0, iorder_q(3)
|
||||
|
||||
tmp_q = tmp_p * Q_new(j,3)
|
||||
tmp_mod = dsqrt(REAL(tmp_q)*REAL(tmp_q) + AIMAG(tmp_q)*AIMAG(tmp_q))
|
||||
if(tmp_mod < thresh) cycle
|
||||
tmp_q = tmp_p * Q_new(j,3)
|
||||
if(zabs(tmp_q) < thresh) cycle
|
||||
|
||||
!DIR$ FORCEINLINE
|
||||
call give_cpolynom_mult_center_x(P_center(3), Q_center(3), i, j, p, q, iorder, pq_inv, pq_inv_2, p10_1, p01_1, p10_2, p01_2, dz, nz)
|
||||
@ -1028,6 +1020,9 @@ complex*16 function general_primitive_integral_cgtos(dim, P_new, P_center, fact_
|
||||
|
||||
!DIR$ FORCEINLINE
|
||||
call multiply_cpoly(d_poly, n_pt_tmp, Iz_pol, n_Iz, d1, n_pt_out)
|
||||
if(n_pt_out == -1) then
|
||||
return
|
||||
endif
|
||||
|
||||
accu = crint_sum(n_pt_out, const, d1)
|
||||
|
||||
@ -1056,7 +1051,6 @@ complex*16 function ERI_cgtos(alpha, beta, delta, gama, a_x, b_x, c_x, d_x, a_y,
|
||||
integer :: a_x_2, b_x_2, c_x_2, d_x_2, a_y_2, b_y_2, c_y_2, d_y_2, a_z_2, b_z_2, c_z_2, d_z_2
|
||||
integer :: i, j, k, l, n_pt
|
||||
integer :: nx, ny, nz
|
||||
double precision :: ppq_re, ppq_im, ppq_mod, sq_ppq_re, sq_ppq_im
|
||||
complex*16 :: p, q, ppq, sq_ppq, coeff, I_f
|
||||
|
||||
ERI_cgtos = (0.d0, 0.d0)
|
||||
@ -1494,7 +1488,7 @@ recursive subroutine I_x1_pol_mult_a1_cgtos(c,B_10,B_01,B_00,C_00,D_00,d,nd,n_pt
|
||||
complex*16 :: Y(0:max_dim)
|
||||
!DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: X,Y
|
||||
|
||||
if( (c < 0) .or. (nd < 0) ) then
|
||||
if((c < 0) .or. (nd < 0)) then
|
||||
nd = -1
|
||||
return
|
||||
endif
|
||||
|
||||
@ -46,6 +46,7 @@ double precision function ao_two_e_integral(i, j, k, l)
|
||||
if(use_cgtos) then
|
||||
|
||||
ao_two_e_integral = ao_two_e_integral_cgtos(i, j, k, l)
|
||||
return
|
||||
|
||||
else if (use_only_lr) then
|
||||
|
||||
|
||||
@ -3,18 +3,134 @@ program deb_ao_2e_int
|
||||
|
||||
implicit none
|
||||
|
||||
!call main()
|
||||
call check_ao_one_e_integral_cgtos()
|
||||
!call check_ao_two_e_integral_cgtos()
|
||||
!call check_crint1()
|
||||
!call check_crint2()
|
||||
!call check_crint3()
|
||||
!call check_crint4()
|
||||
call check_crint5()
|
||||
!call check_crint5()
|
||||
!call check_crint6()
|
||||
|
||||
end
|
||||
|
||||
! ---
|
||||
|
||||
subroutine main()
|
||||
|
||||
implicit none
|
||||
|
||||
integer :: i, j
|
||||
|
||||
|
||||
PROVIDE ao_overlap
|
||||
PROVIDE ao_kinetic_integrals
|
||||
PROVIDE ao_integrals_n_e
|
||||
|
||||
print*, "ao_overlap:"
|
||||
do i = 1, ao_num
|
||||
print*, (ao_overlap(i,j), j=1, ao_num)
|
||||
enddo
|
||||
|
||||
print*, "ao_kinetic_integrals:"
|
||||
do i = 1, ao_num
|
||||
print*, (ao_kinetic_integrals(i,j), j=1, ao_num)
|
||||
enddo
|
||||
|
||||
print*, "ao_integrals_n_e:"
|
||||
do i = 1, ao_num
|
||||
print*, (ao_integrals_n_e(i,j), j=1, ao_num)
|
||||
enddo
|
||||
|
||||
return
|
||||
end
|
||||
|
||||
! ---
|
||||
|
||||
subroutine check_ao_one_e_integral_cgtos()
|
||||
|
||||
implicit none
|
||||
|
||||
integer :: i, j
|
||||
double precision :: acc, nrm, dif
|
||||
double precision :: tmp1, tmp2
|
||||
double precision :: t1, t2, tt
|
||||
|
||||
PROVIDE ao_overlap ao_overlap_cgtos
|
||||
PROVIDE ao_integrals_n_e ao_integrals_n_e_cgtos
|
||||
PROVIDE ao_kinetic_integrals ao_kinetic_integrals_cgtos
|
||||
|
||||
! ---
|
||||
|
||||
! print *, "overlap:"
|
||||
! acc = 0.d0
|
||||
! nrm = 0.d0
|
||||
! do i = 1, ao_num
|
||||
! do j = 1, ao_num
|
||||
! tmp1 = ao_overlap (i,j)
|
||||
! tmp2 = ao_overlap_cgtos(i,j)
|
||||
! dif = abs(tmp1 - tmp2)
|
||||
! if(dif .gt. 1d-10) then
|
||||
! print*, ' error on:', i, j
|
||||
! print*, tmp1, tmp2, dif
|
||||
! !stop
|
||||
! endif
|
||||
! acc += dif
|
||||
! nrm += abs(tmp1)
|
||||
! enddo
|
||||
! enddo
|
||||
! print *, ' acc (%) = ', 100.d0 * acc / nrm
|
||||
!
|
||||
! ! ---
|
||||
!
|
||||
! print *, "kinetic:"
|
||||
! acc = 0.d0
|
||||
! nrm = 0.d0
|
||||
! do i = 1, ao_num
|
||||
! do j = 1, ao_num
|
||||
! tmp1 = ao_kinetic_integrals (i,j)
|
||||
! tmp2 = ao_kinetic_integrals_cgtos(i,j)
|
||||
! dif = abs(tmp1 - tmp2)
|
||||
! if(dif .gt. 1d-10) then
|
||||
! print*, ' error on:', i, j
|
||||
! print*, tmp1, tmp2, dif
|
||||
! !stop
|
||||
! endif
|
||||
! acc += dif
|
||||
! nrm += abs(tmp1)
|
||||
! enddo
|
||||
! enddo
|
||||
! print *, ' acc (%) = ', 100.d0 * acc / nrm
|
||||
|
||||
! ---
|
||||
|
||||
print *, "NAI:"
|
||||
acc = 0.d0
|
||||
nrm = 0.d0
|
||||
do i = 1, ao_num
|
||||
!do i = 9, 9
|
||||
do j = 1, ao_num
|
||||
!do j = 16, 16
|
||||
tmp1 = ao_integrals_n_e (i,j)
|
||||
tmp2 = ao_integrals_n_e_cgtos(i,j)
|
||||
dif = dabs(tmp1 - tmp2)
|
||||
if(dif .gt. 1d-10) then
|
||||
print*, ' error on:', i, j
|
||||
print*, tmp1, tmp2, dif
|
||||
stop
|
||||
endif
|
||||
acc += dif
|
||||
nrm += dabs(tmp1)
|
||||
enddo
|
||||
enddo
|
||||
print *, ' acc (%) = ', 100.d0 * acc / nrm
|
||||
|
||||
end
|
||||
|
||||
! ---
|
||||
|
||||
|
||||
subroutine check_ao_two_e_integral_cgtos()
|
||||
|
||||
implicit none
|
||||
@ -22,7 +138,6 @@ subroutine check_ao_two_e_integral_cgtos()
|
||||
integer :: i, j, k, l
|
||||
double precision :: acc, nrm, dif
|
||||
double precision :: tmp1, tmp2
|
||||
double precision :: pw, pw0
|
||||
double precision :: t1, t2, tt
|
||||
|
||||
double precision, external :: ao_two_e_integral
|
||||
@ -31,40 +146,40 @@ subroutine check_ao_two_e_integral_cgtos()
|
||||
acc = 0.d0
|
||||
nrm = 0.d0
|
||||
|
||||
pw0 = dble(ao_num**3)
|
||||
pw = 0.d0
|
||||
tt = 0.d0
|
||||
do i = 1, ao_num
|
||||
!do i = 1, 1
|
||||
call wall_time(t1)
|
||||
do j = 1, ao_num
|
||||
!do j = 1, 1
|
||||
do k = 1, ao_num
|
||||
!do k = 1, 1
|
||||
do l = 1, ao_num
|
||||
!do l = 21, 21
|
||||
|
||||
call deb_ao_2eint_cgtos(i, j, k, l)
|
||||
!call deb_ao_2eint_cgtos(i, j, k, l)
|
||||
|
||||
!tmp1 = ao_two_e_integral (i, j, k, l)
|
||||
!tmp2 = ao_two_e_integral_cgtos(i, j, k, l)
|
||||
tmp1 = ao_two_e_integral (i, j, k, l)
|
||||
tmp2 = ao_two_e_integral_cgtos(i, j, k, l)
|
||||
|
||||
!print*, i, j, k, l
|
||||
|
||||
!dif = abs(tmp1 - tmp2)
|
||||
!!if(dif .gt. 1d-10) then
|
||||
! print*, ' error on:', i, j, k, l
|
||||
! print*, tmp1, tmp2, dif
|
||||
! !stop
|
||||
!!endif
|
||||
!acc += dif
|
||||
!nrm += abs(tmp1)
|
||||
dif = abs(tmp1 - tmp2)
|
||||
if(dif .gt. 1d-10) then
|
||||
print*, ' error on:', i, j, k, l
|
||||
print*, tmp1, tmp2, dif
|
||||
!stop
|
||||
endif
|
||||
acc += dif
|
||||
nrm += abs(tmp1)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
call wall_time(t2)
|
||||
tt += t2 - t1
|
||||
print*, " % done = ", 100.d0 * dble(i) / ao_num
|
||||
print*, ' ellepsed time (sec) =', tt
|
||||
print*, ' ellapsed time (sec) =', tt
|
||||
enddo
|
||||
|
||||
!print *, ' acc (%) = ', dif * 100.d0 / nrm
|
||||
!print *, ' acc (%) = ', 100.d0 * acc / nrm
|
||||
|
||||
end
|
||||
|
||||
@ -635,3 +750,160 @@ end
|
||||
|
||||
! ---
|
||||
|
||||
|
||||
! ---
|
||||
|
||||
subroutine deb_ao_2eint_cgtos(i, j, k, l)
|
||||
|
||||
BEGIN_DOC
|
||||
! integral of the AO basis <ik|jl> or (ij|kl)
|
||||
! i(r1) j(r1) 1/r12 k(r2) l(r2)
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
include 'utils/constants.include.F'
|
||||
|
||||
integer, intent(in) :: i, j, k, l
|
||||
|
||||
integer :: p, q, r, s
|
||||
integer :: num_i, num_j, num_k, num_l, dim1, I_power(3), J_power(3), K_power(3), L_power(3)
|
||||
integer :: iorder_p1(3), iorder_p2(3), iorder_q1(3), iorder_q2(3)
|
||||
complex*16 :: I_center(3), J_center(3), K_center(3), L_center(3)
|
||||
complex*16 :: expo1, expo2, expo3, expo4
|
||||
complex*16 :: P1_center(3), pp1
|
||||
complex*16 :: P2_center(3), pp2
|
||||
complex*16 :: Q1_center(3), qq1
|
||||
complex*16 :: Q2_center(3), qq2
|
||||
|
||||
|
||||
|
||||
dim1 = n_pt_max_integrals
|
||||
|
||||
num_i = ao_nucl(i)
|
||||
num_j = ao_nucl(j)
|
||||
num_k = ao_nucl(k)
|
||||
num_l = ao_nucl(l)
|
||||
|
||||
if(num_i /= num_j .or. num_k /= num_l .or. num_j /= num_k) then
|
||||
|
||||
!print*, ao_prim_num(i), ao_prim_num(j), ao_prim_num(k), ao_prim_num(l)
|
||||
|
||||
do p = 1, 3
|
||||
I_power(p) = ao_power(i,p)
|
||||
J_power(p) = ao_power(j,p)
|
||||
K_power(p) = ao_power(k,p)
|
||||
L_power(p) = ao_power(l,p)
|
||||
I_center(p) = nucl_coord(num_i,p) * (1.d0, 0.d0)
|
||||
J_center(p) = nucl_coord(num_j,p) * (1.d0, 0.d0)
|
||||
K_center(p) = nucl_coord(num_k,p) * (1.d0, 0.d0)
|
||||
L_center(p) = nucl_coord(num_l,p) * (1.d0, 0.d0)
|
||||
enddo
|
||||
|
||||
do p = 1, ao_prim_num(i)
|
||||
expo1 = ao_expo_cgtos_ord_transp(p,i)
|
||||
!print*, "expo1 = ", expo1
|
||||
!print*, "center1 = ", I_center
|
||||
|
||||
do q = 1, ao_prim_num(j)
|
||||
expo2 = ao_expo_cgtos_ord_transp(q,j)
|
||||
!print*, "expo2 = ", expo2
|
||||
!print*, "center2 = ", J_center
|
||||
|
||||
pp1 = expo1 + expo2
|
||||
P1_center(1:3) = (expo1 * I_center(1:3) + expo2 * J_center(1:3)) / pp1
|
||||
iorder_p1(1:3) = I_power(1:3) + J_power(1:3)
|
||||
|
||||
pp2 = conjg(expo1) + expo2
|
||||
P2_center(1:3) = (conjg(expo1) * I_center(1:3) + expo2 * J_center(1:3)) / pp2
|
||||
iorder_p2(1:3) = I_power(1:3) + J_power(1:3)
|
||||
|
||||
do r = 1, ao_prim_num(k)
|
||||
expo3 = ao_expo_cgtos_ord_transp(r,k)
|
||||
!print*, "expo3 = ", expo3
|
||||
!print*, "center3 = ", K_center
|
||||
|
||||
do s = 1, ao_prim_num(l)
|
||||
expo4 = ao_expo_cgtos_ord_transp(s,l)
|
||||
!print*, "expo4 = ", expo4
|
||||
!print*, "center4 = ", L_center
|
||||
|
||||
qq1 = expo3 + expo4
|
||||
Q1_center(1:3) = (expo3 * K_center(1:3) + expo4 * L_center(1:3)) / qq1
|
||||
iorder_q1(1:3) = K_power(1:3) + L_power(1:3)
|
||||
|
||||
qq2 = conjg(expo3) + expo4
|
||||
Q2_center(1:3) = (conjg(expo3) * K_center(1:3) + expo4 * L_center(1:3)) / qq2
|
||||
iorder_q2(1:3) = K_power(1:3) + L_power(1:3)
|
||||
|
||||
call deb_cboys(P1_center, pp1, iorder_p1, Q1_center, qq1, iorder_q1)
|
||||
call deb_cboys(P1_center, pp1, iorder_p1, Q2_center, qq2, iorder_q2)
|
||||
call deb_cboys(P2_center, pp2, iorder_p2, Q1_center, qq1, iorder_q1)
|
||||
call deb_cboys(P2_center, pp2, iorder_p2, Q2_center, qq2, iorder_q2)
|
||||
call deb_cboys(conjg(P2_center), conjg(pp2), iorder_p2, Q1_center, qq1, iorder_q1)
|
||||
call deb_cboys(conjg(P2_center), conjg(pp2), iorder_p2, Q2_center, qq2, iorder_q2)
|
||||
call deb_cboys(conjg(P1_center), conjg(pp1), iorder_p1, Q1_center, qq1, iorder_q1)
|
||||
call deb_cboys(conjg(P1_center), conjg(pp1), iorder_p1, Q2_center, qq2, iorder_q2)
|
||||
enddo ! s
|
||||
enddo ! r
|
||||
enddo ! q
|
||||
enddo ! p
|
||||
|
||||
endif ! same centers
|
||||
|
||||
return
|
||||
end
|
||||
|
||||
! ---
|
||||
|
||||
subroutine deb_cboys(P_center, p, iorder_p, Q_center, q, iorder_q)
|
||||
|
||||
|
||||
implicit none
|
||||
include 'utils/constants.include.F'
|
||||
|
||||
integer, intent(in) :: iorder_p(3), iorder_q(3)
|
||||
complex*16, intent(in) :: P_center(3), p
|
||||
complex*16, intent(in) :: Q_center(3), q
|
||||
|
||||
integer :: iorder, n
|
||||
complex*16 :: dist, rho
|
||||
complex*16 :: int1, int2
|
||||
|
||||
complex*16, external :: crint_2
|
||||
|
||||
|
||||
dist = (P_center(1) - Q_center(1)) * (P_center(1) - Q_center(1)) &
|
||||
+ (P_center(2) - Q_center(2)) * (P_center(2) - Q_center(2)) &
|
||||
+ (P_center(3) - Q_center(3)) * (P_center(3) - Q_center(3))
|
||||
rho = dist * p * q / (p + q)
|
||||
|
||||
if(real(rho) .lt. -5.d0) then
|
||||
print*, 'warning ! impotant negative rho: ', rho
|
||||
endif
|
||||
|
||||
!if(abs(rho) .lt. 1d-15) return
|
||||
|
||||
iorder = 2*iorder_p(1)+2*iorder_q(1) + 2*iorder_p(2)+2*iorder_q(2) + 2*iorder_p(3)+2*iorder_q(3)
|
||||
n = shiftr(iorder, 1)
|
||||
|
||||
!write(33,*) n, real(rho), aimag(rho)
|
||||
!print*, n, real(rho), aimag(rho)
|
||||
|
||||
int1 = crint_2(n, rho)
|
||||
call crint_quad_12(n, rho, 1000000, int2)
|
||||
|
||||
if(abs(int1 - int2) .gt. 1d-5) then
|
||||
print*, ' important error found: '
|
||||
print*, p!, P_center
|
||||
print*, q!, Q_center
|
||||
print*, dist
|
||||
print*, " n, tho = ", n, real(rho), aimag(rho)
|
||||
print*, real(int1), real(int2), dabs(real(int1-int2))
|
||||
print*, aimag(int1), aimag(int2), dabs(aimag(int1-int2))
|
||||
stop
|
||||
endif
|
||||
|
||||
end
|
||||
|
||||
! ---
|
||||
|
||||
|
||||
@ -256,15 +256,10 @@ subroutine multiply_cpoly(b, nb, c, nc, d, nd)
|
||||
complex*16, intent(inout) :: d(0:nb+nc)
|
||||
integer, intent(out) :: nd
|
||||
|
||||
integer :: ndtmp, ib, ic
|
||||
integer :: ib, ic
|
||||
|
||||
if(ior(nc, nb) >= 0) then ! True if nc>=0 and nb>=0
|
||||
continue
|
||||
else
|
||||
return
|
||||
endif
|
||||
if(ior(nc, nb) < 0) return ! False if nc>=0 and nb>=0
|
||||
|
||||
ndtmp = nb + nc
|
||||
|
||||
do ic = 0, nc
|
||||
d(ic) = d(ic) + c(ic) * b(0)
|
||||
@ -277,9 +272,8 @@ subroutine multiply_cpoly(b, nb, c, nc, d, nd)
|
||||
enddo
|
||||
enddo
|
||||
|
||||
do nd = ndtmp, 0, -1
|
||||
if(abs(d(nd)) .lt. 1.d-15) cycle
|
||||
exit
|
||||
do nd = nb + nc, 0, -1
|
||||
if(d(nd) /= (0.d0, 0.d0)) exit
|
||||
enddo
|
||||
|
||||
end
|
||||
|
||||
Loading…
Reference in New Issue
Block a user