PTEROSOR/QuantumPackage
10
0
Fork 0
mirror of https://github.com/QuantumPackage/qp2.git synced 2024-06-26 23:22:24 +02:00
Code Releases Activity

prep tu git pull from olympe 2

Browse Source
This commit is contained in:
Abdallah Ammar 2022-09-29 11:34:40 +02:00
parent d919d6ce7d
commit 7597fe9f5b
2 changed files with 33 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -444,14 +444,17 @@ BEGIN_PROVIDER [ logical, ao_two_e_integrals_in_map ]
END_PROVIDER END_PROVIDER
BEGIN_PROVIDER [ double precision, ao_two_e_integral_schwartz,(ao_num,ao_num) ] ! ---
implicit none
BEGIN_PROVIDER [ double precision, ao_two_e_integral_schwartz, (ao_num, ao_num) ]
BEGIN_DOC BEGIN_DOC
! Needed to compute Schwartz inequalities ! Needed to compute Schwartz inequalities
END_DOC END_DOC
integer :: i,k implicit none
double precision :: ao_two_e_integral,cpu_1,cpu_2, wall_1, wall_2 integer :: i, k
double precision :: ao_two_e_integral,cpu_1,cpu_2, wall_1, wall_2
ao_two_e_integral_schwartz(1,1) = ao_two_e_integral(1,1,1,1) ao_two_e_integral_schwartz(1,1) = ao_two_e_integral(1,1,1,1)
!$OMP PARALLEL DO PRIVATE(i,k) & !$OMP PARALLEL DO PRIVATE(i,k) &
@ -468,6 +471,7 @@ BEGIN_PROVIDER [ double precision, ao_two_e_integral_schwartz,(ao_num,ao_num) ]
END_PROVIDER END_PROVIDER
! ---
double precision function general_primitive_integral(dim, & double precision function general_primitive_integral(dim, &
P_new,P_center,fact_p,p,p_inv,iorder_p, & P_new,P_center,fact_p,p,p_inv,iorder_p, &

43
src/utils/one_e_integration.irp.f
View File

@ -92,41 +92,48 @@ subroutine overlap_gaussian_xyz(A_center,B_center,alpha,beta,power_A,&
overlap = overlap_x * overlap_y * overlap_z overlap = overlap_x * overlap_y * overlap_z
end end
! ---
subroutine overlap_x_abs(A_center, B_center, alpha, beta, power_A, power_B, overlap_x, lower_exp_val, dx, nx)
subroutine overlap_x_abs(A_center,B_center,alpha,beta,power_A,power_B,overlap_x,lower_exp_val,dx,nx)
implicit none
BEGIN_DOC BEGIN_DOC
! .. math :: ! .. math ::
! !
! \int_{-infty}^{+infty} (x-A_center)^(power_A) * (x-B_center)^power_B * exp(-alpha(x-A_center)^2) * exp(-beta(x-B_center)^2) dx ! \int_{-infty}^{+infty} (x-A_center)^(power_A) * (x-B_center)^power_B * exp(-alpha(x-A_center)^2) * exp(-beta(x-B_center)^2) dx
! !
END_DOC END_DOC
integer :: i,j,k,l
integer,intent(in) :: power_A,power_B implicit none
double precision, intent(in) :: lower_exp_val
double precision,intent(in) :: A_center, B_center,alpha,beta integer, intent(in) :: power_A, power_B, nx
double precision, intent(out) :: overlap_x,dx double precision, intent(in) :: lower_exp_val, A_center, B_center, alpha, beta
integer, intent(in) :: nx double precision, intent(out) :: overlap_x, dx
double precision :: x_min,x_max,domain,x,factor,dist,p,p_inv,rho
double precision :: P_center integer :: i, j, k, l
if(power_A.lt.0.or.power_B.lt.0)then double precision :: x_min, x_max, domain, x, factor, dist, p, p_inv, rho
double precision :: P_center
double precision :: tmp
if(power_A.lt.0 .or. power_B.lt.0) then
overlap_x = 0.d0 overlap_x = 0.d0
dx = 0.d0 dx = 0.d0
return return
endif endif
p = alpha + beta
p_inv= 1.d0/p p = alpha + beta
rho = alpha * beta * p_inv p_inv = 1.d0/p
dist = (A_center - B_center)*(A_center - B_center) rho = alpha * beta * p_inv
dist = (A_center - B_center)*(A_center - B_center)
P_center = (alpha * A_center + beta * B_center) * p_inv P_center = (alpha * A_center + beta * B_center) * p_inv
if(rho*dist.gt.80.d0)then
if(rho*dist.gt.80.d0) then
overlap_x= 0.d0 overlap_x= 0.d0
return return
endif endif
factor = dexp(-rho * dist) factor = dexp(-rho * dist)
double precision :: tmp
tmp = dsqrt(lower_exp_val/p) tmp = dsqrt(lower_exp_val/p)
x_min = P_center - tmp x_min = P_center - tmp