eplf/src/Util.irp.f

!recursive double precision function Boys(x,n) result(res)
! implicit none
! include 'constants.F'
!
! real, intent(in)     :: x
! integer, intent(in)  :: n
!
! ASSERT (x > 0.)
! if (n == 0) then
!   res = sqrt(pi/(4.*x))*erf(sqrt(x))
! else
!   res = (dble(2*n-1) * Boys(x,(n-1)) - exp(-x) )/(2.*x)
! endif
!
!end function


double precision function binom(k,n)
 implicit none
 integer, intent(in) :: k,n
 double precision, save :: memo(0:20,0:20)
 !DEC$ ATTRIBUTES ALIGN : 32 :: memo
 integer, save :: ifirst
 double precision :: fact
 if (ifirst /= 0) then

  if (n<20) then
    binom = memo(k,n)
    return
  else
    binom=fact(n)/(fact(k)*fact(n-k))
    return
  endif

 else

  ifirst = 1
  integer :: i,j
  do j=0,20
   do i=0,j
    memo(i,j) = fact(j)/(fact(i)*fact(j-i))
   enddo
  enddo

  if (n<20) then
    binom = memo(k,n)
    return
  else
    binom=fact(n)/(fact(k)*fact(n-k))
  endif
 endif
end

double precision function fact2(n)
  implicit none
  integer :: n
  double precision, save :: memo(100)
  integer, save :: memomax = 1 
  
  ASSERT (mod(n,2) /= 0)
  memo(1) = 1.d0
  if (n<2) then
      fact2 = 1.d0
  else if (n<=memomax) then
      fact2 = memo(n)
  else

    integer :: i
    do i=memomax+2,min(n,99),2
      memo(i) = memo(i-2)* float(i)
    enddo
    memomax = min(n,99)
    fact2 = memo(memomax)

    do i=101,n,2
      fact2 *= float(i)
    enddo

  endif

end function


double precision function fact(n)
  implicit none
  integer :: n
  double precision, save :: memo(0:100)
  integer, save :: memomax = 1 
  
  memo(0) = 1.d0
  memo(1) = 1.d0

  if (n<=memomax) then
    fact = memo(n)
  else
    integer :: i
    do i=memomax+1,min(n,100)
      memo(i) = memo(i-1)*float(i)
    enddo
    memomax = min(n,100)
    fact = memo(memomax)
    do i=101,n
      fact *= float(i)
    enddo
  endif
end function


double precision function rintgauss(n)
  implicit none
  include 'constants.F'

  integer :: n

  rintgauss = dsqrt_pi
  if ( n == 0 ) then
    return
  else if ( n == 1 ) then
    rintgauss = 0.
  else if ( mod(n,2) == 1) then
    rintgauss = 0.
  else
    double precision :: fact2
    rintgauss = rintgauss/(2.**(n/2))
    rintgauss = rintgauss * fact2(n-1)
  endif
end function

double precision function goverlap(gamA,gamB,nA)
  implicit none

  real    :: gamA, gamB
  integer :: nA(3)

  double precision :: gamtot
  gamtot = gamA+gamB

  goverlap=1.0

  integer :: l
  double precision :: rintgauss
  do l=1,3
    goverlap = goverlap * rintgauss(nA(l)+nA(l))/ (gamtot**(0.5+float(nA(l))))
  enddo

end function