quantum_package/src/Utils/util.irp.f

double precision function binom_func(i,j)
 implicit none
 integer,intent(in) :: i,j
 double precision :: fact, f
 integer, save :: ifirst
 double precision, save :: memo(0:15,0:15)
 !DEC$ ATTRIBUTES ALIGN : $IRP_ALIGN :: memo
 integer :: k,l
 if (ifirst == 0) then
   ifirst = 1
   do k=0,15
    f = fact(k)
    do l=0,15
     memo(k,l) = f/(fact(l)*fact(k-l))
    enddo
   enddo
 endif
 if ( (i<=15).and.(j<=15) ) then
   binom_func = memo(i,j)
 else
   binom_func = fact(i)/(fact(j)*fact(i-j))
 endif
end




 BEGIN_PROVIDER [ double precision, binom, (0:20,0:20) ]
&BEGIN_PROVIDER [ double precision, binom_transp, (0:20,0:20) ]
 implicit none
 BEGIN_DOC
! Binomial coefficients
 END_DOC
 integer :: k,l
 double precision :: fact, f
 do k=0,20
  f = fact(k)
  do l=0,20
   binom(k,l) = f/(fact(l)*fact(k-l))
   binom_transp(l,k) = binom(k,l)
  enddo
 enddo
END_PROVIDER


integer function align_double(n)
 implicit none
 integer :: n
 include 'include/constants.F'
 if (mod(n,SIMD_vector/4) /= 0) then
   align_double= n + SIMD_vector/4 - mod(n,SIMD_vector/4)
 else
   align_double= n
 endif
end


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

  if (n<=memomax) then
    if (n<2) then
      fact = 1.d0
    else
      fact = memo(n)
    endif
    return
  endif

  integer :: i
  memo(1) = 1.d0
  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 = fact*float(i)
  enddo
end function



BEGIN_PROVIDER [ double precision, fact_inv, (128) ]
 implicit none
 BEGIN_DOC
! 1.d0/fact(k)
 END_DOC
 integer :: i
 double precision :: fact
  do i=1,size(fact_inv)
    fact_inv(i) = 1.d0/fact(i)
  enddo
END_PROVIDER

double precision function dble_fact(n) result(fact2)
  implicit none
  integer :: n
  double precision, save :: memo(1:100)
  integer, save :: memomax = 1

  ASSERT (iand(n,1) /= 0)
  if (n<=memomax) then
    if (n<3) then
      fact2 = 1.d0
    else
      fact2 = memo(n)
    endif
    return
  endif

  integer :: i
  memo(1) = 1.d0
  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 = fact2*float(i)
  enddo

end function

subroutine write_git_log(iunit)
 implicit none
 integer, intent(in) :: iunit
 write(iunit,*) '----------------'
 write(iunit,*) 'Last git commit:'
 BEGIN_SHELL [ /bin/bash ]
   git log -1 | sed "s/'//g"| sed "s/^/    write(iunit,*) '/g" | sed "s/$/'/g"
 END_SHELL
 write(iunit,*) '----------------'
end

BEGIN_PROVIDER [ double precision, inv_int, (128) ]
 implicit none
 BEGIN_DOC
! 1/i
 END_DOC
 integer :: i
 do i=1,size(inv_int)
   inv_int(i) = 1.d0/dble(i)
 enddo

END_PROVIDER

subroutine wall_time(t)
  implicit none
  double precision, intent(out) :: t
  integer :: c
  integer, save :: rate = 0
  if (rate == 0) then
    CALL SYSTEM_CLOCK(count_rate=rate)
  endif
  CALL SYSTEM_CLOCK(count=c)
  t = dble(c)/dble(rate)
end

BEGIN_PROVIDER [ integer, nproc ]
 implicit none
 BEGIN_DOC
! Number of current openmp threads
 END_DOC

 integer :: omp_get_num_threads
 nproc = 1
 !$OMP PARALLEL
 !$OMP MASTER
 !$ nproc = omp_get_num_threads()
 !$OMP END MASTER
 !$OMP END PARALLEL
END_PROVIDER