PTEROSOR/QuantumPackage
10
0
Fork 0
mirror of https://github.com/QuantumPackage/qp2.git synced 2024-11-19 12:32:30 +01:00
Code Releases Activity

few optim in cplx Boys fct

Browse Source
This commit is contained in:
Abdallah Ammar 2024-10-09 10:49:31 +02:00
parent 7f57051739
commit 68ed788645
4 changed files with 316 additions and 470 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
src/ao_one_e_ints/one_e_Coul_integrals_cosgtos.irp.f
View File

@ -111,8 +111,9 @@ complex*16 function NAI_pol_mult_cosgtos(A_center, B_center, power_A, power_B, a
complex*16 :: accu, P_center(3) complex*16 :: accu, P_center(3)
complex*16 :: d(0:n_pt_in) complex*16 :: d(0:n_pt_in)
complex*16 :: V_n_e_cosgtos complex*16, external :: V_n_e_cosgtos
complex*16 :: crint_2 complex*16, external :: crint_2
complex*16, external :: crint_sum_2
if ( (A_center(1)/=B_center(1)) .or. (A_center(2)/=B_center(2)) .or. (A_center(3)/=B_center(3)) .or. & if ( (A_center(1)/=B_center(1)) .or. (A_center(2)/=B_center(2)) .or. (A_center(3)/=B_center(3)) .or. &
(A_center(1)/=C_center(1)) .or. (A_center(2)/=C_center(2)) .or. (A_center(3)/=C_center(3)) ) then (A_center(1)/=C_center(1)) .or. (A_center(2)/=C_center(2)) .or. (A_center(3)/=C_center(3)) ) then
@ -162,22 +163,22 @@ complex*16 function NAI_pol_mult_cosgtos(A_center, B_center, power_A, power_B, a
return return
endif endif
call give_cpolynomial_mult_center_one_e( A_center, B_center, alpha, beta & call give_cpolynomial_mult_center_one_e(A_center, B_center, alpha, beta, &
, power_A, power_B, C_center, n_pt_in, d, n_pt_out) power_A, power_B, C_center, n_pt_in, d, n_pt_out)
if(n_pt_out < 0) then if(n_pt_out < 0) then
NAI_pol_mult_cosgtos = (0.d0, 0.d0) NAI_pol_mult_cosgtos = (0.d0, 0.d0)
return return
endif endif
accu = (0.d0, 0.d0) !accu = (0.d0, 0.d0)
do i = 0, n_pt_out, 2 !do i = 0, n_pt_out, 2
accu += crint_2(shiftr(i, 1), const) * d(i) ! accu += crint_2(shiftr(i, 1), const) * d(i)
!enddo
! print *, shiftr(i, 1), real(const), real(d(i)), real(crint_2(shiftr(i, 1), const)) accu = crint_sum_2(n_pt_out, const, d)
enddo
NAI_pol_mult_cosgtos = accu * coeff NAI_pol_mult_cosgtos = accu * coeff
return
end end
! --- ! ---

290
src/ao_two_e_ints/two_e_Coul_integrals_cosgtos.irp.f
View File

@ -35,11 +35,9 @@ double precision function ao_two_e_integral_cosgtos(i, j, k, l)
if(ao_prim_num(i) * ao_prim_num(j) * ao_prim_num(k) * ao_prim_num(l) > 1024) then if(ao_prim_num(i) * ao_prim_num(j) * ao_prim_num(k) * ao_prim_num(l) > 1024) then
!print *, ' with shwartz acc '
ao_two_e_integral_cosgtos = ao_2e_cosgtos_schwartz_accel(i, j, k, l) ao_two_e_integral_cosgtos = ao_2e_cosgtos_schwartz_accel(i, j, k, l)
else else
!print *, ' without shwartz acc '
dim1 = n_pt_max_integrals dim1 = n_pt_max_integrals
@ -51,7 +49,6 @@ double precision function ao_two_e_integral_cosgtos(i, j, k, l)
ao_two_e_integral_cosgtos = 0.d0 ao_two_e_integral_cosgtos = 0.d0
if(num_i /= num_j .or. num_k /= num_l .or. num_j /= num_k) then if(num_i /= num_j .or. num_k /= num_l .or. num_j /= num_k) then
!print *, ' not the same center'
do p = 1, 3 do p = 1, 3
I_power(p) = ao_power(i,p) I_power(p) = ao_power(i,p)
@ -130,14 +127,6 @@ double precision function ao_two_e_integral_cosgtos(i, j, k, l)
integral_tot = integral1 + integral2 + integral3 + integral4 + integral5 + integral6 + integral7 + integral8 integral_tot = integral1 + integral2 + integral3 + integral4 + integral5 + integral6 + integral7 + integral8
!write(*,"(8(F15.7,2X))") real(integral1), real(integral2), real(integral3), real(integral4), &
! real(integral5), real(integral6), real(integral7), real(integral8)
!write(33,"(5(F22.15,2X))") real(expo1), real(expo2), real(expo3), real(expo4), coef4*16.d0
!write(43,"(1(F22.15,2X))") coef4 * 2.d0 * real(integral_tot)
!integral_tot = integral1
!print*, integral_tot
ao_two_e_integral_cosgtos = ao_two_e_integral_cosgtos + coef4 * 2.d0 * real(integral_tot) ao_two_e_integral_cosgtos = ao_two_e_integral_cosgtos + coef4 * 2.d0 * real(integral_tot)
enddo ! s enddo ! s
enddo ! r enddo ! r
@ -145,7 +134,6 @@ double precision function ao_two_e_integral_cosgtos(i, j, k, l)
enddo ! p enddo ! p
else else
!print *, ' the same center'
do p = 1, 3 do p = 1, 3
I_power(p) = ao_power(i,p) I_power(p) = ao_power(i,p)
@ -222,7 +210,7 @@ double precision function ao_two_e_integral_cosgtos(i, j, k, l)
endif endif
endif endif
end function ao_two_e_integral_cosgtos end
! --- ! ---
@ -258,8 +246,8 @@ double precision function ao_2e_cosgtos_schwartz_accel(i, j, k, l)
double precision :: thr double precision :: thr
double precision :: schwartz_ij double precision :: schwartz_ij
complex*16 :: ERI_cosgtos complex*16, external :: ERI_cosgtos
complex*16 :: general_primitive_integral_cosgtos complex*16, external :: general_primitive_integral_cosgtos
ao_2e_cosgtos_schwartz_accel = 0.d0 ao_2e_cosgtos_schwartz_accel = 0.d0
@ -273,7 +261,7 @@ double precision function ao_2e_cosgtos_schwartz_accel(i, j, k, l)
thr = ao_integrals_threshold*ao_integrals_threshold thr = ao_integrals_threshold*ao_integrals_threshold
allocate( schwartz_kl(0:ao_prim_num(l),0:ao_prim_num(k)) ) allocate(schwartz_kl(0:ao_prim_num(l),0:ao_prim_num(k)))
if(num_i /= num_j .or. num_k /= num_l .or. num_j /= num_k) then if(num_i /= num_j .or. num_k /= num_l .or. num_j /= num_k) then
@ -298,45 +286,45 @@ double precision function ao_2e_cosgtos_schwartz_accel(i, j, k, l)
coef2 = coef1 * ao_coef_norm_ord_transp_cosgtos(s,l) * ao_coef_norm_ord_transp_cosgtos(s,l) coef2 = coef1 * ao_coef_norm_ord_transp_cosgtos(s,l) * ao_coef_norm_ord_transp_cosgtos(s,l)
expo2 = ao_expo_ord_transp_cosgtos(s,l) expo2 = ao_expo_ord_transp_cosgtos(s,l)
call give_explicit_cpoly_and_cgaussian( P1_new, P1_center, pp1, fact_p1, iorder_p1 & call give_explicit_cpoly_and_cgaussian(P1_new, P1_center, pp1, fact_p1, iorder_p1, &
, expo1, expo2, K_power, L_power, K_center, L_center, dim1 ) expo1, expo2, K_power, L_power, K_center, L_center, dim1)
p1_inv = (1.d0,0.d0) / pp1 p1_inv = (1.d0,0.d0) / pp1
call give_explicit_cpoly_and_cgaussian( P2_new, P2_center, pp2, fact_p2, iorder_p2 & call give_explicit_cpoly_and_cgaussian(P2_new, P2_center, pp2, fact_p2, iorder_p2, &
, conjg(expo1), expo2, K_power, L_power, K_center, L_center, dim1 ) conjg(expo1), expo2, K_power, L_power, K_center, L_center, dim1)
p2_inv = (1.d0,0.d0) / pp2 p2_inv = (1.d0,0.d0) / pp2
call give_explicit_cpoly_and_cgaussian( P3_new, P3_center, pp3, fact_p3, iorder_p3 & call give_explicit_cpoly_and_cgaussian(P3_new, P3_center, pp3, fact_p3, iorder_p3, &
, expo1, conjg(expo2), K_power, L_power, K_center, L_center, dim1 ) expo1, conjg(expo2), K_power, L_power, K_center, L_center, dim1)
p3_inv = (1.d0,0.d0) / pp3 p3_inv = (1.d0,0.d0) / pp3
call give_explicit_cpoly_and_cgaussian( P4_new, P4_center, pp4, fact_p4, iorder_p4 & call give_explicit_cpoly_and_cgaussian(P4_new, P4_center, pp4, fact_p4, iorder_p4, &
, conjg(expo1), conjg(expo2), K_power, L_power, K_center, L_center, dim1 ) conjg(expo1), conjg(expo2), K_power, L_power, K_center, L_center, dim1)
p4_inv = (1.d0,0.d0) / pp4 p4_inv = (1.d0,0.d0) / pp4
integral1 = general_primitive_integral_cosgtos( dim1, P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p1 & integral1 = general_primitive_integral_cosgtos(dim1, P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p1, &
, P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p1 ) P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p1)
integral2 = general_primitive_integral_cosgtos( dim1, P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p1 & integral2 = general_primitive_integral_cosgtos(dim1, P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p1, &
, P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p2 ) P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p2)
integral3 = general_primitive_integral_cosgtos( dim1, P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p2 & integral3 = general_primitive_integral_cosgtos(dim1, P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p2, &
, P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p1 ) P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p1)
integral4 = general_primitive_integral_cosgtos( dim1, P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p2 & integral4 = general_primitive_integral_cosgtos(dim1, P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p2, &
, P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p2 ) P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p2)
integral5 = general_primitive_integral_cosgtos( dim1, P3_new, P3_center, fact_p3, pp3, p3_inv, iorder_p3 & integral5 = general_primitive_integral_cosgtos(dim1, P3_new, P3_center, fact_p3, pp3, p3_inv, iorder_p3, &
, P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p1 ) P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p1)
integral6 = general_primitive_integral_cosgtos( dim1, P3_new, P3_center, fact_p3, pp3, p3_inv, iorder_p3 & integral6 = general_primitive_integral_cosgtos(dim1, P3_new, P3_center, fact_p3, pp3, p3_inv, iorder_p3, &
, P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p2 ) P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p2)
integral7 = general_primitive_integral_cosgtos( dim1, P4_new, P4_center, fact_p4, pp4, p4_inv, iorder_p4 & integral7 = general_primitive_integral_cosgtos(dim1, P4_new, P4_center, fact_p4, pp4, p4_inv, iorder_p4, &
, P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p1 ) P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p1)
integral8 = general_primitive_integral_cosgtos( dim1, P4_new, P4_center, fact_p4, pp4, p4_inv, iorder_p4 & integral8 = general_primitive_integral_cosgtos(dim1, P4_new, P4_center, fact_p4, pp4, p4_inv, iorder_p4, &
, P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p2 ) P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p2)
integral_tot = integral1 + integral2 + integral3 + integral4 + integral5 + integral6 + integral7 + integral8 integral_tot = integral1 + integral2 + integral3 + integral4 + integral5 + integral6 + integral7 + integral8
@ -476,41 +464,45 @@ double precision function ao_2e_cosgtos_schwartz_accel(i, j, k, l)
coef2 = coef1 * ao_coef_norm_ord_transp_cosgtos(s,l) * ao_coef_norm_ord_transp_cosgtos(s,l) coef2 = coef1 * ao_coef_norm_ord_transp_cosgtos(s,l) * ao_coef_norm_ord_transp_cosgtos(s,l)
expo2 = ao_expo_ord_transp_cosgtos(s,l) expo2 = ao_expo_ord_transp_cosgtos(s,l)
integral1 = ERI_cosgtos( expo1, expo2, expo1, expo2 & integral1 = ERI_cosgtos(expo1, expo2, expo1, expo2, &
, K_power(1), L_power(1), K_power(1), L_power(1) & K_power(1), L_power(1), K_power(1), L_power(1), &
, K_power(2), L_power(2), K_power(2), L_power(2) & K_power(2), L_power(2), K_power(2), L_power(2), &
, K_power(3), L_power(3), K_power(3), L_power(3) ) K_power(3), L_power(3), K_power(3), L_power(3))
integral2 = ERI_cosgtos( expo1, expo2, conjg(expo1), expo2 &
, K_power(1), L_power(1), K_power(1), L_power(1) &
, K_power(2), L_power(2), K_power(2), L_power(2) &
, K_power(3), L_power(3), K_power(3), L_power(3) )
integral3 = ERI_cosgtos( conjg(expo1), expo2, expo1, expo2 & integral2 = ERI_cosgtos(expo1, expo2, conjg(expo1), expo2, &
, K_power(1), L_power(1), K_power(1), L_power(1) & K_power(1), L_power(1), K_power(1), L_power(1), &
, K_power(2), L_power(2), K_power(2), L_power(2) & K_power(2), L_power(2), K_power(2), L_power(2), &
, K_power(3), L_power(3), K_power(3), L_power(3) ) K_power(3), L_power(3), K_power(3), L_power(3))
integral4 = ERI_cosgtos( conjg(expo1), expo2, conjg(expo1), expo2 &
, K_power(1), L_power(1), K_power(1), L_power(1) &
, K_power(2), L_power(2), K_power(2), L_power(2) &
, K_power(3), L_power(3), K_power(3), L_power(3) )
integral5 = ERI_cosgtos( expo1, conjg(expo2), expo1, expo2 & integral3 = ERI_cosgtos(conjg(expo1), expo2, expo1, expo2, &
, K_power(1), L_power(1), K_power(1), L_power(1) & K_power(1), L_power(1), K_power(1), L_power(1), &
, K_power(2), L_power(2), K_power(2), L_power(2) & K_power(2), L_power(2), K_power(2), L_power(2), &
, K_power(3), L_power(3), K_power(3), L_power(3) ) K_power(3), L_power(3), K_power(3), L_power(3))
integral6 = ERI_cosgtos( expo1, conjg(expo2), conjg(expo1), expo2 &
, K_power(1), L_power(1), K_power(1), L_power(1) &
, K_power(2), L_power(2), K_power(2), L_power(2) &
, K_power(3), L_power(3), K_power(3), L_power(3) )
integral7 = ERI_cosgtos( conjg(expo1), conjg(expo2), expo1, expo2 & integral4 = ERI_cosgtos(conjg(expo1), expo2, conjg(expo1), expo2, &
, K_power(1), L_power(1), K_power(1), L_power(1) & K_power(1), L_power(1), K_power(1), L_power(1), &
, K_power(2), L_power(2), K_power(2), L_power(2) & K_power(2), L_power(2), K_power(2), L_power(2), &
, K_power(3), L_power(3), K_power(3), L_power(3) ) K_power(3), L_power(3), K_power(3), L_power(3))
integral8 = ERI_cosgtos( conjg(expo1), conjg(expo2), conjg(expo1), expo2 &
, K_power(1), L_power(1), K_power(1), L_power(1) & integral5 = ERI_cosgtos(expo1, conjg(expo2), expo1, expo2, &
, K_power(2), L_power(2), K_power(2), L_power(2) & K_power(1), L_power(1), K_power(1), L_power(1), &
, K_power(3), L_power(3), K_power(3), L_power(3) ) K_power(2), L_power(2), K_power(2), L_power(2), &
K_power(3), L_power(3), K_power(3), L_power(3))
integral6 = ERI_cosgtos(expo1, conjg(expo2), conjg(expo1), expo2, &
K_power(1), L_power(1), K_power(1), L_power(1), &
K_power(2), L_power(2), K_power(2), L_power(2), &
K_power(3), L_power(3), K_power(3), L_power(3))
integral7 = ERI_cosgtos(conjg(expo1), conjg(expo2), expo1, expo2, &
K_power(1), L_power(1), K_power(1), L_power(1), &
K_power(2), L_power(2), K_power(2), L_power(2), &
K_power(3), L_power(3), K_power(3), L_power(3))
integral8 = ERI_cosgtos(conjg(expo1), conjg(expo2), conjg(expo1), expo2, &
K_power(1), L_power(1), K_power(1), L_power(1), &
K_power(2), L_power(2), K_power(2), L_power(2), &
K_power(3), L_power(3), K_power(3), L_power(3))
integral_tot = integral1 + integral2 + integral3 + integral4 + integral5 + integral6 + integral7 + integral8 integral_tot = integral1 + integral2 + integral3 + integral4 + integral5 + integral6 + integral7 + integral8
@ -530,45 +522,45 @@ double precision function ao_2e_cosgtos_schwartz_accel(i, j, k, l)
coef2 = coef1 * ao_coef_norm_ord_transp_cosgtos(q,j) coef2 = coef1 * ao_coef_norm_ord_transp_cosgtos(q,j)
expo2 = ao_expo_ord_transp_cosgtos(q,j) expo2 = ao_expo_ord_transp_cosgtos(q,j)
integral1 = ERI_cosgtos( expo1, expo2, expo1, expo2 & integral1 = ERI_cosgtos(expo1, expo2, expo1, expo2, &
, I_power(1), J_power(1), I_power(1), J_power(1) & I_power(1), J_power(1), I_power(1), J_power(1), &
, I_power(2), J_power(2), I_power(2), J_power(2) & I_power(2), J_power(2), I_power(2), J_power(2), &
, I_power(3), J_power(3), I_power(3), J_power(3) ) I_power(3), J_power(3), I_power(3), J_power(3))
integral2 = ERI_cosgtos( expo1, expo2, conjg(expo1), expo2 & integral2 = ERI_cosgtos(expo1, expo2, conjg(expo1), expo2, &
, I_power(1), J_power(1), I_power(1), J_power(1) & I_power(1), J_power(1), I_power(1), J_power(1), &
, I_power(2), J_power(2), I_power(2), J_power(2) & I_power(2), J_power(2), I_power(2), J_power(2), &
, I_power(3), J_power(3), I_power(3), J_power(3) ) I_power(3), J_power(3), I_power(3), J_power(3))
integral3 = ERI_cosgtos( conjg(expo1), expo2, expo1, expo2 & integral3 = ERI_cosgtos(conjg(expo1), expo2, expo1, expo2, &
, I_power(1), J_power(1), I_power(1), J_power(1) & I_power(1), J_power(1), I_power(1), J_power(1), &
, I_power(2), J_power(2), I_power(2), J_power(2) & I_power(2), J_power(2), I_power(2), J_power(2), &
, I_power(3), J_power(3), I_power(3), J_power(3) ) I_power(3), J_power(3), I_power(3), J_power(3))
integral4 = ERI_cosgtos( conjg(expo1), expo2, conjg(expo1), expo2 & integral4 = ERI_cosgtos(conjg(expo1), expo2, conjg(expo1), expo2, &
, I_power(1), J_power(1), I_power(1), J_power(1) & I_power(1), J_power(1), I_power(1), J_power(1), &
, I_power(2), J_power(2), I_power(2), J_power(2) & I_power(2), J_power(2), I_power(2), J_power(2), &
, I_power(3), J_power(3), I_power(3), J_power(3) ) I_power(3), J_power(3), I_power(3), J_power(3))
integral5 = ERI_cosgtos( expo1, conjg(expo2), expo1, expo2 & integral5 = ERI_cosgtos(expo1, conjg(expo2), expo1, expo2, &
, I_power(1), J_power(1), I_power(1), J_power(1) & I_power(1), J_power(1), I_power(1), J_power(1), &
, I_power(2), J_power(2), I_power(2), J_power(2) & I_power(2), J_power(2), I_power(2), J_power(2), &
, I_power(3), J_power(3), I_power(3), J_power(3) ) I_power(3), J_power(3), I_power(3), J_power(3))
integral6 = ERI_cosgtos( expo1, conjg(expo2), conjg(expo1), expo2 & integral6 = ERI_cosgtos(expo1, conjg(expo2), conjg(expo1), expo2, &
, I_power(1), J_power(1), I_power(1), J_power(1) & I_power(1), J_power(1), I_power(1), J_power(1), &
, I_power(2), J_power(2), I_power(2), J_power(2) & I_power(2), J_power(2), I_power(2), J_power(2), &
, I_power(3), J_power(3), I_power(3), J_power(3) ) I_power(3), J_power(3), I_power(3), J_power(3))
integral7 = ERI_cosgtos( conjg(expo1), conjg(expo2), expo1, expo2 & integral7 = ERI_cosgtos(conjg(expo1), conjg(expo2), expo1, expo2, &
, I_power(1), J_power(1), I_power(1), J_power(1) & I_power(1), J_power(1), I_power(1), J_power(1), &
, I_power(2), J_power(2), I_power(2), J_power(2) & I_power(2), J_power(2), I_power(2), J_power(2), &
, I_power(3), J_power(3), I_power(3), J_power(3) ) I_power(3), J_power(3), I_power(3), J_power(3))
integral8 = ERI_cosgtos( conjg(expo1), conjg(expo2), conjg(expo1), expo2 & integral8 = ERI_cosgtos(conjg(expo1), conjg(expo2), conjg(expo1), expo2, &
, I_power(1), J_power(1), I_power(1), J_power(1) & I_power(1), J_power(1), I_power(1), J_power(1), &
, I_power(2), J_power(2), I_power(2), J_power(2) & I_power(2), J_power(2), I_power(2), J_power(2), &
, I_power(3), J_power(3), I_power(3), J_power(3) ) I_power(3), J_power(3), I_power(3), J_power(3))
integral_tot = integral1 + integral2 + integral3 + integral4 + integral5 + integral6 + integral7 + integral8 integral_tot = integral1 + integral2 + integral3 + integral4 + integral5 + integral6 + integral7 + integral8
@ -587,45 +579,45 @@ double precision function ao_2e_cosgtos_schwartz_accel(i, j, k, l)
coef4 = coef3 * ao_coef_norm_ord_transp_cosgtos(s,l) coef4 = coef3 * ao_coef_norm_ord_transp_cosgtos(s,l)
expo4 = ao_expo_ord_transp_cosgtos(s,l) expo4 = ao_expo_ord_transp_cosgtos(s,l)
integral1 = ERI_cosgtos( expo1, expo2, expo3, expo4 & integral1 = ERI_cosgtos(expo1, expo2, expo3, expo4, &
, I_power(1), J_power(1), K_power(1), L_power(1) & I_power(1), J_power(1), K_power(1), L_power(1), &
, I_power(2), J_power(2), K_power(2), L_power(2) & I_power(2), J_power(2), K_power(2), L_power(2), &
, I_power(3), J_power(3), K_power(3), L_power(3) ) I_power(3), J_power(3), K_power(3), L_power(3))
integral2 = ERI_cosgtos( expo1, expo2, conjg(expo3), expo4 & integral2 = ERI_cosgtos(expo1, expo2, conjg(expo3), expo4, &
, I_power(1), J_power(1), K_power(1), L_power(1) & I_power(1), J_power(1), K_power(1), L_power(1), &
, I_power(2), J_power(2), K_power(2), L_power(2) & I_power(2), J_power(2), K_power(2), L_power(2), &
, I_power(3), J_power(3), K_power(3), L_power(3) ) I_power(3), J_power(3), K_power(3), L_power(3))
integral3 = ERI_cosgtos( conjg(expo1), expo2, expo3, expo4 & integral3 = ERI_cosgtos(conjg(expo1), expo2, expo3, expo4, &
, I_power(1), J_power(1), K_power(1), L_power(1) & I_power(1), J_power(1), K_power(1), L_power(1), &
, I_power(2), J_power(2), K_power(2), L_power(2) & I_power(2), J_power(2), K_power(2), L_power(2), &
, I_power(3), J_power(3), K_power(3), L_power(3) ) I_power(3), J_power(3), K_power(3), L_power(3))
integral4 = ERI_cosgtos( conjg(expo1), expo2, conjg(expo3), expo4 & integral4 = ERI_cosgtos(conjg(expo1), expo2, conjg(expo3), expo4, &
, I_power(1), J_power(1), K_power(1), L_power(1) & I_power(1), J_power(1), K_power(1), L_power(1), &
, I_power(2), J_power(2), K_power(2), L_power(2) & I_power(2), J_power(2), K_power(2), L_power(2), &
, I_power(3), J_power(3), K_power(3), L_power(3) ) I_power(3), J_power(3), K_power(3), L_power(3))
integral5 = ERI_cosgtos( expo1, conjg(expo2), expo3, expo4 & integral5 = ERI_cosgtos(expo1, conjg(expo2), expo3, expo4, &
, I_power(1), J_power(1), K_power(1), L_power(1) & I_power(1), J_power(1), K_power(1), L_power(1), &
, I_power(2), J_power(2), K_power(2), L_power(2) & I_power(2), J_power(2), K_power(2), L_power(2), &
, I_power(3), J_power(3), K_power(3), L_power(3) ) I_power(3), J_power(3), K_power(3), L_power(3))
integral6 = ERI_cosgtos( expo1, conjg(expo2), conjg(expo3), expo4 & integral6 = ERI_cosgtos(expo1, conjg(expo2), conjg(expo3), expo4, &
, I_power(1), J_power(1), K_power(1), L_power(1) & I_power(1), J_power(1), K_power(1), L_power(1), &
, I_power(2), J_power(2), K_power(2), L_power(2) & I_power(2), J_power(2), K_power(2), L_power(2), &
, I_power(3), J_power(3), K_power(3), L_power(3) ) I_power(3), J_power(3), K_power(3), L_power(3))
integral7 = ERI_cosgtos( conjg(expo1), conjg(expo2), expo3, expo4 & integral7 = ERI_cosgtos(conjg(expo1), conjg(expo2), expo3, expo4, &
, I_power(1), J_power(1), K_power(1), L_power(1) & I_power(1), J_power(1), K_power(1), L_power(1), &
, I_power(2), J_power(2), K_power(2), L_power(2) & I_power(2), J_power(2), K_power(2), L_power(2), &
, I_power(3), J_power(3), K_power(3), L_power(3) ) I_power(3), J_power(3), K_power(3), L_power(3))
integral8 = ERI_cosgtos( conjg(expo1), conjg(expo2), conjg(expo3), expo4 & integral8 = ERI_cosgtos(conjg(expo1), conjg(expo2), conjg(expo3), expo4, &
, I_power(1), J_power(1), K_power(1), L_power(1) & I_power(1), J_power(1), K_power(1), L_power(1), &
, I_power(2), J_power(2), K_power(2), L_power(2) & I_power(2), J_power(2), K_power(2), L_power(2), &
, I_power(3), J_power(3), K_power(3), L_power(3) ) I_power(3), J_power(3), K_power(3), L_power(3))
integral_tot = integral1 + integral2 + integral3 + integral4 + integral5 + integral6 + integral7 + integral8 integral_tot = integral1 + integral2 + integral3 + integral4 + integral5 + integral6 + integral7 + integral8
@ -639,11 +631,11 @@ double precision function ao_2e_cosgtos_schwartz_accel(i, j, k, l)
deallocate(schwartz_kl) deallocate(schwartz_kl)
end function ao_2e_cosgtos_schwartz_accel end
! --- ! ---
BEGIN_PROVIDER [ double precision, ao_2e_cosgtos_schwartz, (ao_num,ao_num)] BEGIN_PROVIDER [double precision, ao_2e_cosgtos_schwartz, (ao_num, ao_num)]
BEGIN_DOC BEGIN_DOC
! Needed to compute Schwartz inequalities ! Needed to compute Schwartz inequalities
@ -845,8 +837,6 @@ complex*16 function general_primitive_integral_cosgtos(dim, P_new, P_center, fac
call multiply_cpoly(d_poly, n_pt_tmp, Iz_pol, n_Iz, d1, n_pt_out) call multiply_cpoly(d_poly, n_pt_tmp, Iz_pol, n_Iz, d1, n_pt_out)
accu = crint_sum_2(n_pt_out, const, d1) accu = crint_sum_2(n_pt_out, const, d1)
! print *, n_pt_out, real(d1(0:n_pt_out))
! print *, real(accu)
general_primitive_integral_cosgtos = fact_p * fact_q * accu * pi_5_2 * p_inv * q_inv / sq_ppq general_primitive_integral_cosgtos = fact_p * fact_q * accu * pi_5_2 * p_inv * q_inv / sq_ppq
@ -926,7 +916,7 @@ complex*16 function ERI_cosgtos(alpha, beta, delta, gama, a_x, b_x, c_x, d_x, a_
ERI_cosgtos = I_f * coeff ERI_cosgtos = I_f * coeff
end function ERI_cosgtos end
! --- ! ---
@ -1008,7 +998,7 @@ subroutine integrale_new_cosgtos(I_f, a_x, b_x, c_x, d_x, a_y, b_y, c_y, d_y, a_
I_f += gauleg_w(i, j) * t1(i) I_f += gauleg_w(i, j) * t1(i)
enddo enddo
end subroutine integrale_new_cosgtos end
! --- ! ---
@ -1055,7 +1045,7 @@ recursive subroutine I_x1_new_cosgtos(a, c, B_10, B_01, B_00, res, n_pt)
endif endif
end subroutine I_x1_new_cosgtos end
! --- ! ---
@ -1095,7 +1085,7 @@ recursive subroutine I_x2_new_cosgtos(c, B_10, B_01, B_00, res, n_pt)
endif endif
end subroutine I_x2_new_cosgtos end
! --- ! ---
@ -1166,7 +1156,7 @@ subroutine give_cpolynom_mult_center_x( P_center, Q_center, a_x, d_x, p, q, n_pt
return return
endif endif
end subroutine give_cpolynom_mult_center_x end
! --- ! ---
@ -1209,7 +1199,7 @@ subroutine I_x1_pol_mult_cosgtos(a, c, B_10, B_01, B_00, C_00, D_00, d, nd, n_pt
endif endif
end subroutine I_x1_pol_mult_cosgtos end
! --- ! ---
@ -1302,7 +1292,7 @@ recursive subroutine I_x1_pol_mult_recurs_cosgtos(a, c, B_10, B_01, B_00, C_00,
!DIR$ FORCEINLINE !DIR$ FORCEINLINE
call multiply_cpoly(Y, ny, C_00, 2, d, nd) call multiply_cpoly(Y, ny, C_00, 2, d, nd)
end subroutine I_x1_pol_mult_recurs_cosgtos end
! --- ! ---
@ -1358,7 +1348,7 @@ recursive subroutine I_x1_pol_mult_a1_cosgtos(c,B_10,B_01,B_00,C_00,D_00,d,nd,n_
!DIR$ FORCEINLINE !DIR$ FORCEINLINE
call multiply_cpoly(Y, ny, C_00, 2, d, nd) call multiply_cpoly(Y, ny, C_00, 2, d, nd)
end subroutine I_x1_pol_mult_a1_cosgtos end
! --- ! ---
@ -1422,7 +1412,7 @@ recursive subroutine I_x1_pol_mult_a2_cosgtos(c, B_10, B_01, B_00, C_00, D_00, d
!DIR$ FORCEINLINE !DIR$ FORCEINLINE
call multiply_cpoly(Y, ny, C_00, 2, d, nd) call multiply_cpoly(Y, ny, C_00, 2, d, nd)
end subroutine I_x1_pol_mult_a2_cosgtos end
! --- ! ---
@ -1507,7 +1497,7 @@ recursive subroutine I_x2_pol_mult_cosgtos(c, B_10, B_01, B_00, C_00, D_00, d, n
end select end select
end subroutine I_x2_pol_mult_cosgtos end
! --- ! ---

2
src/ao_two_e_ints/two_e_integrals.irp.f
View File

@ -101,8 +101,6 @@ double precision function ao_two_e_integral(i, j, k, l)
integral = general_primitive_integral(dim1, & integral = general_primitive_integral(dim1, &
P_new,P_center,fact_p,pp,p_inv,iorder_p, & P_new,P_center,fact_p,pp,p_inv,iorder_p, &
Q_new,Q_center,fact_q,qq,q_inv,iorder_q) Q_new,Q_center,fact_q,qq,q_inv,iorder_q)
!write(32,"(5(F22.15,2X))") ao_expo_ordered_transp(p,i),ao_expo_ordered_transp(q,j),ao_expo_ordered_transp(r,k),ao_expo_ordered_transp(s,l), coef4
!write(42,"(1(F22.15,2X))") coef4*integral
ao_two_e_integral = ao_two_e_integral + coef4 * integral ao_two_e_integral = ao_two_e_integral + coef4 * integral
enddo ! s enddo ! s
enddo ! r enddo ! r

473
src/utils/cpx_boys.irp.f
View File

@ -252,9 +252,9 @@ complex*16 function crint_smallz(n, rho)
complex*16 :: rho_k, ct, delta_k complex*16 :: rho_k, ct, delta_k
ct = 0.5d0 * zexp(-rho) * gamma(dble(n) + 0.5d0) ct = 0.5d0 * zexp(-rho) * gamma(dble(n) + 0.5d0)
rho_k = (1.d0, 0.d0) crint_smallz = ct / gamma(dble(n) + 1.5d0)
crint_smallz = ct * rho_k / gamma(dble(n) + 1.5d0)
rho_k = (1.d0, 0.d0)
do k = 1, kmax do k = 1, kmax
rho_k = rho_k * rho rho_k = rho_k * rho
@ -269,7 +269,7 @@ complex*16 function crint_smallz(n, rho)
write(*,*) ' pb in crint_smallz !' write(*,*) ' pb in crint_smallz !'
write(*,*) ' n, rho = ', n, rho write(*,*) ' n, rho = ', n, rho
write(*,*) ' delta_mod = ', delta_mod write(*,*) ' delta_mod = ', delta_mod
stop 1 !stop 1
endif endif
end end
@ -279,7 +279,6 @@ end
complex*16 function crint_2(n, rho) complex*16 function crint_2(n, rho)
implicit none implicit none
include 'constants.include.F'
integer, intent(in) :: n integer, intent(in) :: n
complex*16, intent(in) :: rho complex*16, intent(in) :: rho
@ -332,166 +331,23 @@ subroutine zboysfun(n_max, x, vals)
END_DOC END_DOC
implicit none implicit none
double precision, parameter :: tol = 1.0d-03
double precision, parameter :: x0(1:50) = (/ 0.5d0, & integer, intent(in) :: n_max
0.8660254037844386d0, & complex*16, intent(in) :: x
1.2331060371652351d0, &
1.6005429364718398d0, &
1.968141713517676d0, &
2.3358274254733784d0, &
2.703565149324218d0, &
3.0713364398393708d0, &
3.4391306442915526d0, &
3.8069411832467615d0, &
4.174763774674144d0, &
4.5425955121971775d0, &
4.9104343539723185d0, &
5.278278823606476d0, &
5.646127827158555d0, &
6.0139805368686865d0, &
6.381836314862427d0, &
6.749694661668329d0, &
7.117555180620059d0, &
7.48541755270593d0, &
7.853281518456119d0, &
8.221146864672829d0, &
8.589013414557305d0, &
8.956881020260978d0, &
9.324749557193652d0, &
9.692618919623587d0, &
10.060489017239897d0, &
10.428359772440366d0, &
10.796231118172152d0, &
11.164102996198254d0, &
11.531975355694907d0, &
11.899848152108484d0, &
12.26772134621756d0, &
12.63559490335844d0, &
13.003468792781872d0, &
13.371342987115684d0, &
13.739217461913594d0, &
14.107092195274445d0, &
14.474967167519445d0, &
14.842842360917235d0, &
15.210717759448817d0, &
15.578593348605757d0, &
15.94646911521622d0, &
16.31434504729452d0, &
16.68222113391055d0, &
17.05009736507609d0, &
17.4179737316455d0, &
17.78585022522868d0, &
18.153726838114668d0, &
18.521603563204277d0 /)
double precision, parameter :: t(0:11) = (/ 0.20000000000000000d+01, &
0.66666666666666663d+00, &
0.40000000000000002d+00, &
0.28571428571428570d+00, &
0.22222222222222221d+00, &
0.18181818181818182d+00, &
0.15384615384615385d+00, &
0.13333333333333333d+00, &
0.11764705882352941d+00, &
0.10526315789473684d+00, &
0.95238095238095233d-01, &
0.86956521739130432d-01 /)
complex*16, parameter :: zz(1:10) = (/ ( 0.64304020652330500d+01, 0.18243694739308491d+02), &
( 0.64304020652330500d+01,-0.18243694739308491d+02), &
(-0.12572081889410178d+01, 0.14121366415342502d+02), &
(-0.12572081889410178d+01,-0.14121366415342502d+02), &
(-0.54103079551670268d+01, 0.10457909575828442d+02), &
(-0.54103079551670268d+01,-0.10457909575828442d+02), &
(-0.78720025594983341d+01, 0.69309284623985663d+01), &
(-0.78720025594983341d+01,-0.69309284623985663d+01), &
(-0.92069621609035313d+01, 0.34559308619699376d+01), &
(-0.92069621609035313d+01,-0.34559308619699376d+01) /)
complex*16, parameter :: fact(1:10) = (/ ( 0.13249210991966042d-02, 0.91787356295447745d-03), &
( 0.13249210991966042d-02,-0.91787356295447745d-03), &
( 0.55545905103006735d-01,-0.35151540664451613d+01), &
( 0.55545905103006735d-01, 0.35151540664451613d+01), &
(-0.11456407675096416d+03, 0.19213789620924834d+03), &
(-0.11456407675096416d+03,-0.19213789620924834d+03), &
( 0.20915556220686653d+04,-0.15825742912360638d+04), &
( 0.20915556220686653d+04, 0.15825742912360638d+04), &
(-0.94779394228935325d+04, 0.30814443710192086d+04), &
(-0.94779394228935325d+04,-0.30814443710192086d+04) /)
complex*16, parameter :: ww(1:10) = (/ (-0.83418049867878959d-08,-0.70958810331788253d-08), &
(-0.83418050437598581d-08, 0.70958810084577824d-08), &
( 0.82436739552884774d-07,-0.27704117936134414d-06), &
( 0.82436739547688584d-07, 0.27704117938414886d-06), &
( 0.19838416382728666d-05, 0.78321058613942770d-06), &
( 0.19838416382681279d-05,-0.78321058613180811d-06), &
(-0.47372729839268780d-05, 0.58076919074212929d-05), &
(-0.47372729839287016d-05,-0.58076919074154416d-05), &
(-0.68186014282131608d-05,-0.13515261354290787d-04), &
(-0.68186014282138385d-05, 0.13515261354295612d-04) /)
double precision, parameter :: rzz(1:1) = (/ -0.96321934290343840d+01 /)
double precision, parameter :: rfact(1:1) = (/ 0.15247844519077540d+05 /)
double precision, parameter :: rww(1:1) = (/ 0.18995875677635889d-04 /)
integer, intent(in) :: n_max
complex*16, intent(in) :: x
complex*16, intent(out) :: vals(0:n_max) complex*16, intent(out) :: vals(0:n_max)
integer :: n, k integer :: n
double precision :: x0_nmax complex*16 :: yy, x_inv
complex*16 :: y, yy, rtmp
complex*16 :: p, q, tmp
y = zexp(-x) call zboysfun00(x, vals(0))
! x0_nmax = x0(n_max)
! if(abs(x) .ge. x0_nmax) then yy = 0.5d0 * zexp(-x)
x_inv = (1.d0, 0.d0) / x
!print*,'check' do n = 1, n_max
call zboysfun00(x, vals(0)) vals(n) = ((dble(n) - 0.5d0) * vals(n-1) - yy) * x_inv
!print*, vals(0) enddo
yy = 0.5d0 * y
do n = 1, n_max
vals(n) = ((dble(n) - 0.5d0) * vals(n-1) - yy) / x
!print*, n, x
!print*, vals(n)
enddo
! else
!
! rtmp = (0.d0, 0.d0)
! do k = 1, 10
! if(abs(x + zz(k)) .ge. tol) then
! rtmp = rtmp + ww(k) * (1.0d0 - fact(k)*y) / (x + zz(k))
! else
! q = x + zz(k)
! p = 1.0d0 - 0.5d0 * q + q*q/6.0d0 - q*q*q/24.0d0 + q*q*q*q/120.0d0
! rtmp = rtmp + ww(k) * p
! endif
! enddo
!
! tmp = (0.d0, 0.d0)
! do k = 1, 1
! if(abs(x + rzz(k)) .ge. tol) then
! tmp = tmp + rww(k) * (1.0d0 - rfact(k)*y) / (x + rzz(k))
! else
! q = x + rzz(k)
! p = 1.0d0 - 0.5d0 * q + q*q/6.0d0 - q*q*q/24.0d0 + q*q*q*q/120.0d0
! tmp = tmp + rww(k) * p
! endif
! enddo
!
! vals(n_max) = rtmp + tmp
! print*, vals(n_max)
! yy = 0.5d0 * y
! do n = n_max-1, 0, -1
! vals(n) = (x * vals(n+1) + yy) * t(n)
! enddo
!
! endif
return
end end
! --- ! ---
@ -510,155 +366,22 @@ subroutine zboysfunnrp(n_max, x, vals)
END_DOC END_DOC
implicit none implicit none
double precision, parameter :: tol = 1.0d-03
double precision, parameter :: x0(1:50) = (/ 0.5d0, & integer, intent(in) :: n_max
0.8660254037844386d0, & complex*16, intent(in) :: x
1.2331060371652351d0, &
1.6005429364718398d0, &
1.968141713517676d0, &
2.3358274254733784d0, &
2.703565149324218d0, &
3.0713364398393708d0, &
3.4391306442915526d0, &
3.8069411832467615d0, &
4.174763774674144d0, &
4.5425955121971775d0, &
4.9104343539723185d0, &
5.278278823606476d0, &
5.646127827158555d0, &
6.0139805368686865d0, &
6.381836314862427d0, &
6.749694661668329d0, &
7.117555180620059d0, &
7.48541755270593d0, &
7.853281518456119d0, &
8.221146864672829d0, &
8.589013414557305d0, &
8.956881020260978d0, &
9.324749557193652d0, &
9.692618919623587d0, &
10.060489017239897d0, &
10.428359772440366d0, &
10.796231118172152d0, &
11.164102996198254d0, &
11.531975355694907d0, &
11.899848152108484d0, &
12.26772134621756d0, &
12.63559490335844d0, &
13.003468792781872d0, &
13.371342987115684d0, &
13.739217461913594d0, &
14.107092195274445d0, &
14.474967167519445d0, &
14.842842360917235d0, &
15.210717759448817d0, &
15.578593348605757d0, &
15.94646911521622d0, &
16.31434504729452d0, &
16.68222113391055d0, &
17.05009736507609d0, &
17.4179737316455d0, &
17.78585022522868d0, &
18.153726838114668d0, &
18.521603563204277d0 /)
double precision, parameter :: t(0:11) = (/ 0.20000000000000000D+01, &
0.66666666666666663D+00, &
0.40000000000000002D+00, &
0.28571428571428570D+00, &
0.22222222222222221D+00, &
0.18181818181818182D+00, &
0.15384615384615385D+00, &
0.13333333333333333D+00, &
0.11764705882352941D+00, &
0.10526315789473684D+00, &
0.95238095238095233D-01, &
0.86956521739130432D-01 /)
complex*16, parameter :: zz(1:10) = (/ ( 0.64304020652330500D+01, 0.18243694739308491D+02), &
( 0.64304020652330500D+01,-0.18243694739308491D+02), &
(-0.12572081889410178D+01, 0.14121366415342502D+02), &
(-0.12572081889410178D+01,-0.14121366415342502D+02), &
(-0.54103079551670268D+01, 0.10457909575828442D+02), &
(-0.54103079551670268D+01,-0.10457909575828442D+02), &
(-0.78720025594983341D+01, 0.69309284623985663D+01), &
(-0.78720025594983341D+01,-0.69309284623985663D+01), &
(-0.92069621609035313D+01, 0.34559308619699376D+01), &
(-0.92069621609035313D+01,-0.34559308619699376D+01) /)
complex*16, parameter :: fact(1:10) = (/ ( 0.13249210991966042D-02, 0.91787356295447745D-03), &
( 0.13249210991966042D-02,-0.91787356295447745D-03), &
( 0.55545905103006735D-01,-0.35151540664451613D+01), &
( 0.55545905103006735D-01, 0.35151540664451613D+01), &
(-0.11456407675096416D+03, 0.19213789620924834D+03), &
(-0.11456407675096416D+03,-0.19213789620924834D+03), &
( 0.20915556220686653D+04,-0.15825742912360638D+04), &
( 0.20915556220686653D+04, 0.15825742912360638D+04), &
(-0.94779394228935325D+04, 0.30814443710192086D+04), &
(-0.94779394228935325D+04,-0.30814443710192086D+04) /)
complex*16, parameter :: ww(1:10) = (/ (-0.83418049867878959D-08,-0.70958810331788253D-08), &
(-0.83418050437598581D-08, 0.70958810084577824D-08), &
( 0.82436739552884774D-07,-0.27704117936134414D-06), &
( 0.82436739547688584D-07, 0.27704117938414886D-06), &
( 0.19838416382728666D-05, 0.78321058613942770D-06), &
( 0.19838416382681279D-05,-0.78321058613180811D-06), &
(-0.47372729839268780D-05, 0.58076919074212929D-05), &
(-0.47372729839287016D-05,-0.58076919074154416D-05), &
(-0.68186014282131608D-05,-0.13515261354290787D-04), &
(-0.68186014282138385D-05, 0.13515261354295612D-04) /)
double precision, parameter :: rzz(1:1) = (/ -0.96321934290343840D+01 /)
double precision, parameter :: rfact(1:1) = (/ 0.15247844519077540D+05 /)
double precision, parameter :: rww(1:1) = (/ 0.18995875677635889D-04 /)
integer, intent(in) :: n_max
complex*16, intent(in) :: x
complex*16, intent(out) :: vals(0:n_max) complex*16, intent(out) :: vals(0:n_max)
integer :: n, k integer :: n
double precision :: x0_nmax complex*16 :: x_inv
complex*16 :: y, rtmp
complex*16 :: p, q, tmp
y = exp(x) call zboysfun00nrp(x, vals(0))
! x0_nmax = x0(n_max)
! if(abs(x) .ge. x0_nmax) then x_inv = (1.d0, 0.d0) / x
call zboysfun00nrp(x, vals(0)) do n = 1, n_max
do n = 1, n_max vals(n) = ((dble(n) - 0.5d0) * vals(n-1) - 0.5d0) * x_inv
vals(n) = ((n - 0.5d0) * vals(n-1) - 0.5d0) / x enddo
enddo
return
! endif
!
! rtmp = (0.d0, 0.d0)
! do k = 1, 10
! if(abs(x + zz(k)) .ge. tol) then
! rtmp = rtmp + ww(k) * (y - fact(k)) / (x + zz(k))
! else
! q = x+zz(k)
! p = 1.0d0 - 0.5d0*q + q*q/6.0d0 - q*q*q/24.0d0 + q*q*q*q/120.0d0
! rtmp = rtmp + ww(k)*p
! endif
! enddo
! tmp = (0.d0, 0.d0)
! do k = 1, 1
! if (abs(x + rzz(k)) .ge. tol) then
! tmp = tmp + rww(k)*(y-rfact(k))/(x + rzz(k))
! else
! q = x+rzz(k)
! p = 1.0d0 - 0.5d0*q + q*q/6.0d0 - q*q*q/24.0d0 + q*q*q*q/120.0d0
! tmp = tmp + rww(k) * p
! endif
! enddo
! vals(n_max) = rtmp+tmp
! do n = n_max-1, 0, -1
! vals(n) = (x * vals(n+1) + 0.5d0) * t(n)
! enddo
! return
return
end end
! --- ! ---
@ -667,19 +390,153 @@ complex*16 function crint_sum_2(n_pt_out, rho, d1)
implicit none implicit none
integer, intent(in) :: n_pt_out integer, intent(in) :: n_pt_out
complex*16, intent(in) :: rho, d1(0:n_pt_out) complex*16, intent(in) :: rho, d1(0:n_pt_out)
integer :: n, i
integer :: n_max
integer :: n, i complex*16, allocatable :: vals(:)
complex*16, external :: crint_2 !complex*16, external :: crint_2
!crint_sum_2 = (0.d0, 0.d0)
!do i = 0, n_pt_out, 2
! n = shiftr(i, 1)
! crint_sum_2 = crint_sum_2 + d1(i) * crint_2(n, rho)
!enddo
crint_sum_2 = (0.d0, 0.d0) n_max = shiftr(n_pt_out, 1)
do i = 0, n_pt_out, 2
allocate(vals(0:n_max))
call crint_2_vec(n_max, rho, vals)
crint_sum_2 = d1(0) * vals(0)
do i = 2, n_pt_out, 2
n = shiftr(i, 1) n = shiftr(i, 1)
crint_sum_2 = crint_sum_2 + d1(i) * crint_2(n, rho) crint_sum_2 += d1(i) * vals(n)
enddo enddo
deallocate(vals)
return
end
! ---
subroutine crint_2_vec(n_max, rho, vals)
implicit none
integer, intent(in) :: n_max
complex*16, intent(in) :: rho
complex*16, intent(out) :: vals(0:n_max)
integer :: n
double precision :: tmp, abs_rho
complex*16 :: rho2, rho3, erho
abs_rho = abs(rho)
if(abs_rho < 10.d0) then
if(abs_rho .lt. 1d-6) then
! use finite expansion for very small rho
! rho^2 / 2
rho2 = 0.5d0 * rho * rho
! rho^3 / 6
rho3 = 0.3333333333333333d0 * rho * rho2
vals(0) = 1.d0 - 0.3333333333333333d0 * rho + 0.2d0 * rho2 - 0.14285714285714285d0 * rho3
do n = 1, n_max
tmp = 2.d0 * dble(n)
vals(n) = 1.d0 / (tmp + 1.d0) - rho / (tmp + 3.d0) &
+ rho2 / (tmp + 5.d0) - rho3 / (tmp + 7.d0)
enddo
else
call crint_smallz_vec(n_max, rho, vals)
endif
else
if(real(rho) .ge. 0.d0) then
call zboysfun(n_max, rho, vals)
else
call zboysfunnrp(n_max, rho, vals)
erho = zexp(-rho)
do n = 0, n_max
vals(n) = vals(n) * erho
enddo
endif
endif
return
end
! ---
subroutine crint_smallz_vec(n_max, rho, vals)
BEGIN_DOC
! Standard version of rint
END_DOC
implicit none
integer, intent(in) :: n_max
complex*16, intent(in) :: rho
complex*16, intent(out) :: vals(0:n_max)
integer, parameter :: kmax = 40
double precision, parameter :: eps = 1.d-13
integer :: k, n
complex*16 :: ct, delta_k
complex*16 :: rhoe
complex*16, allocatable :: rho_k(:)
allocate(rho_k(0:kmax))
rho_k(0) = (1.d0, 0.d0)
do k = 1, kmax
rho_k(k) = rho_k(k-1) * rho
enddo
rhoe = 0.5d0 * zexp(-rho)
do n = 0, n_max
ct = rhoe * gamma(dble(n) + 0.5d0)
vals(n) = ct / gamma(dble(n) + 1.5d0)
do k = 1, kmax
delta_k = ct * rho_k(k) / gamma(dble(n+k) + 1.5d0)
vals(n) += delta_k
if(abs(delta_k) .lt. eps) then
exit
endif
enddo
!if(abs(delta_k) > eps) then
! write(*,*) ' pb in crint_smallz_vec !'
! write(*,*) ' n, rho = ', n, rho
! write(*,*) ' |delta_k| = ', abs(delta_k)
!endif
enddo
deallocate(rho_k)
return
end end
! --- ! ---