Skip to content
Merged
Changes from 2 commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
31 changes: 5 additions & 26 deletions src/stdlib_specialfunctions_gamma.fypp
Original file line number Diff line number Diff line change
Expand Up @@ -575,9 +575,9 @@ contains
! Fortran 90 program by Jim-215-Fisher
!
${t1}$, intent(in) :: p, x
integer :: n, m
integer :: n

${t2}$ :: res, p_lim, a, b, g, c, d, y, ss
${t2}$ :: res, p_lim, a, b, g, c, d, y
${t2}$, parameter :: zero = 0.0_${k2}$, one = 1.0_${k2}$
${t2}$, parameter :: dm = tiny(1.0_${k2}$) * 10 ** 6
${t1}$, parameter :: zero_k1 = 0.0_${k1}$
Expand All @@ -603,6 +603,9 @@ contains
call error_stop("Error(gpx): Incomplete gamma function with " &
//"negative x must come with a whole number p not too small")

if(x < zero_k1) call error_stop("Error(gpx): Incomplete gamma" &
// " function with negative x must have an integer parameter p")

if(p >= p_lim) then !use modified Lentz method of continued fraction
!for eq. (15) in the above reference.
a = one
Expand Down Expand Up @@ -668,30 +671,6 @@ contains

end do

else !Algorithm 2 in the reference

m = nint(ss)
a = - x
c = one / a
d = p - one
b = c * (a - d)
n = 1

do

c = d * (d - one) / (a * a)
d = d - 2
y = c * (a - d)
b = b + y
n = n + 1

if(n > int((p - 2) / 2) .or. y < b * tol_${k2}$) exit

end do

if(y >= b * tol_${k2}$ .and. mod(m , 2) /= 0) b = b + d * c / a

g = ((-1) ** m * exp(-a + log_gamma(p) - (p - 1) * log(a)) + b) / a
end if

res = g
Expand Down
Loading