quantum_package/src/Utils/one_e_integration.irp.f

double precision function overlap_gaussian_x(A_center,B_center,alpha,beta,power_A,power_B,dim)
  implicit none
  BEGIN_DOC
  !.. math:: 
  !
  ! \sum_{-infty}^{+infty} (x-A_x)^ax (x-B_x)^bx exp(-alpha(x-A_x)^2) exp(-beta(x-B_X)^2) dx
  !
  END_DOC
  include 'constants.include.F'
  integer,intent(in)             :: dim ! dimension maximum for the arrays representing the polynomials
  double precision,intent(in)    :: A_center,B_center  ! center of the x1 functions
  integer,intent(in)             :: power_A, power_B ! power of the x1 functions
  double precision               :: P_new(0:max_dim),P_center,fact_p,p,alpha,beta
  integer                        :: iorder_p
  call give_explicit_poly_and_gaussian_x(P_new,P_center,p,fact_p,iorder_p,alpha,&
      beta,power_A,power_B,A_center,B_center,dim)
  
! if(fact_p.lt.0.000001d0)then
!   overlap_gaussian_x = 0.d0
!   return
! endif
  
  overlap_gaussian_x = 0.d0
  integer                        :: i
  double precision               :: F_integral
  
  do i = 0,iorder_p
    overlap_gaussian_x += P_new(i) * F_integral(i,p)
  enddo
  
  overlap_gaussian_x*= fact_p
end


subroutine overlap_A_B_C(dim,alpha,beta,gama,a,b,A_center,B_center,Nucl_center,overlap)
 implicit none
  include 'constants.include.F'
 integer, intent(in)            :: dim                                                             
 integer, intent(in)            :: a(3),b(3)         ! powers : (x-xa)**a_x = (x-A(1))**a(1)
 double precision, intent(in)   :: alpha, beta, gama ! exponents
 double precision, intent(in)   :: A_center(3)       ! A center
 double precision, intent(in)   :: B_center (3)      ! B center
 double precision, intent(in)   :: Nucl_center(3)    ! B center
 double precision, intent(out)  :: overlap

 double precision               :: P_new(0:max_dim,3),P_center(3),fact_p,p
 double precision               :: F_integral_tab(0:max_dim)
 integer                        :: iorder_p(3)
 double precision :: overlap_x,overlap_z,overlap_y

 call give_explicit_poly_and_gaussian_double(P_new,P_center,p,fact_p,iorder_p,alpha,beta,gama,a,b,A_center,B_center,Nucl_center,dim)
  if(fact_p.lt.1d-10)then
!   overlap_x = 0.d0
!   overlap_y = 0.d0
!   overlap_z = 0.d0
    overlap = 0.d0
    return
  endif

  integer                        :: nmax
  double precision               :: F_integral
  nmax = maxval(iorder_p)
  do i = 0,nmax
    F_integral_tab(i) = F_integral(i,p)
  enddo
  overlap_x = P_new(0,1) * F_integral_tab(0)
  overlap_y = P_new(0,2) * F_integral_tab(0)
  overlap_z = P_new(0,3) * F_integral_tab(0)
  
  integer                        :: i
  do i = 1,iorder_p(1)
    overlap_x += P_new(i,1) * F_integral_tab(i)
  enddo
  do i = 1,iorder_p(2)
    overlap_y += P_new(i,2) * F_integral_tab(i)
  enddo
  do i = 1,iorder_p(3)
    overlap_z += P_new(i,3) * F_integral_tab(i)
  enddo
  overlap = overlap_x * overlap_y * overlap_z * fact_p 
  
!double precision :: overlap_x_1,overlap_y_1,overlap_z_1,overlap_1
!call test(alpha,beta,gama,a,b,A_center,B_center,Nucl_center,overlap_x_1,overlap_y_1,overlap_z_1,overlap_1)
!print*,'overlap_1 = ',overlap_1
!print*,'overlap   = ',overlap
!if(dabs(overlap - overlap_1).ge.1.d-3)then
!  print*,'power_A(1) = ',a(1)
!  print*,'power_A(2) = ',a(2)
!  print*,'power_A(3) = ',a(3)
!  print*,'power_B(1) = ',b(1)
!  print*,'power_B(2) = ',b(2)
!  print*,'power_B(3) = ',b(3)
!  print*,'alpha = ',alpha
!  print*,'beta = ',beta
!  print*,'gama = ',gama
!  print*,'A_center(1) = ',A_center(1)
!  print*,'A_center(2) = ',A_center(2)
!  print*,'A_center(3) = ',A_center(3)
!  print*,'B_center(1) = ',B_center(1)
!  print*,'B_center(2) = ',B_center(2)
!  print*,'B_center(3) = ',B_center(3)
!  print*,'Nucl_center(1) = ',Nucl_center(1)
!  print*,'Nucl_center(2) = ',Nucl_center(2)
!  print*,'Nucl_center(3) = ',Nucl_center(3)
!  print*,'overlap = ',overlap
!  print*,'overlap_1=',overlap_1

!  stop
!endif

end

subroutine overlap_gaussian_xyz(A_center,B_center,alpha,beta,power_A,&
      power_B,overlap_x,overlap_y,overlap_z,overlap,dim)
  implicit none
  BEGIN_DOC
  !.. math:: 
  !
  !   S_x = \int (x-A_x)^{a_x} exp(-\alpha(x-A_x)^2)  (x-B_x)^{b_x} exp(-beta(x-B_x)^2) dx \\
  !   S = S_x S_y S_z
  !
  END_DOC
  include 'constants.include.F'
  integer,intent(in)             :: dim ! dimension maximum for the arrays representing the polynomials
  double precision,intent(in)    :: A_center(3),B_center(3)  ! center of the x1 functions
  double precision, intent(in)   :: alpha,beta
  integer,intent(in)             :: power_A(3), power_B(3) ! power of the x1 functions
  double precision, intent(out)  :: overlap_x,overlap_y,overlap_z,overlap
  double precision               :: P_new(0:max_dim,3),P_center(3),fact_p,p
  double precision               :: F_integral_tab(0:max_dim)
  integer                        :: iorder_p(3)
  
  call give_explicit_poly_and_gaussian(P_new,P_center,p,fact_p,iorder_p,alpha,beta,power_A,power_B,A_center,B_center,dim)
!  if(fact_p.lt.1d-20)then
!    overlap_x = 0.d0
!    overlap_y = 0.d0
!    overlap_z = 0.d0
!    overlap = 0.d0
!    return
!  endif
  integer                        :: nmax
  double precision               :: F_integral
  nmax = maxval(iorder_p)
  do i = 0,nmax
    F_integral_tab(i) = F_integral(i,p)
  enddo
  overlap_x = P_new(0,1) * F_integral_tab(0)
  overlap_y = P_new(0,2) * F_integral_tab(0)
  overlap_z = P_new(0,3) * F_integral_tab(0)
  
  integer                        :: i
  do i = 1,iorder_p(1)
    overlap_x += P_new(i,1) * F_integral_tab(i)
  enddo
  call gaussian_product_x(alpha,A_center(1),beta,B_center(1),fact_p,p,P_center(1))
  overlap_x *= fact_p
  
  do i = 1,iorder_p(2)
    overlap_y += P_new(i,2) * F_integral_tab(i)
  enddo
  call gaussian_product_x(alpha,A_center(2),beta,B_center(2),fact_p,p,P_center(2))
  overlap_y *= fact_p
  
  do i = 1,iorder_p(3)
    overlap_z += P_new(i,3) * F_integral_tab(i)
  enddo
  call gaussian_product_x(alpha,A_center(3),beta,B_center(3),fact_p,p,P_center(3))
  overlap_z *= fact_p
  
  overlap = overlap_x * overlap_y * overlap_z
  
end
   

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
  ! .. 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
  !
  END_DOC
  integer                        :: i,j,k,l
  integer,intent(in)             :: power_A,power_B
  double precision, intent(in)   :: lower_exp_val
  double precision,intent(in)    :: A_center, B_center,alpha,beta
  double precision, intent(out)  :: overlap_x,dx
  integer, intent(in)            :: nx
  double precision               :: x_min,x_max,domain,x,factor,dist,p,p_inv,rho
  double precision               :: P_center
  if(power_A.lt.0.or.power_B.lt.0)then
    overlap_x = 0.d0
    dx = 0.d0
    return
  endif
  p = alpha + beta
  p_inv= 1.d0/p
  rho = alpha * beta * p_inv
  dist = (A_center - B_center)*(A_center - B_center)
  P_center = (alpha * A_center + beta * B_center) * p_inv
  if(rho*dist.gt.80.d0)then
   overlap_x= 0.d0
   return
  endif
  factor = dexp(-rho * dist)
  
  double precision               :: tmp
  
  tmp = dsqrt(lower_exp_val/p)
  x_min = P_center - tmp
  x_max = P_center + tmp
  domain = x_max-x_min
  dx = domain/dble(nx)
  overlap_x = 0.d0
  x = x_min
  do i = 1, nx
    x += dx
    overlap_x += abs((x-A_center)**power_A * (x-B_center)**power_B) * dexp(-p * (x-P_center)*(x-P_center))
  enddo
  
  overlap_x = factor * dx * overlap_x
end