Blame view
fvn_fnlib/gamit.f
2.43 KB
38581db0c git-svn-id: https... |
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 |
function gamit (a, x) c july 1977 edition. w. fullerton, c3, los alamos scientific lab. c c evaluate tricomi-s incomplete gamma function defined by c c gamit = x**(-a)/gamma(a) * integral t = 0 to x of exp(-t) * t**(a-1.) c c and analytic continuation for a .le. 0.0. gamma(x) is the complete c gamma function of x. gamit is evaluated for arbitrary real values of c a and for non-negative values of x (even though gamit is defined for c x .lt. 0.0). c c a slight deterioration of 2 or 3 digits accuracy will occur when c gamit is very large or very small in absolute value, because log- c arithmic variables are used. also, if the parameter a is very close c to a negative integer (but not a negative integer), there is a loss c of accuracy, which is reported if the result is less than half c machine precision. c c ref. -- w. gautschi, an evaluation procedure for incomplete gamma c functions, acm trans. math. software. c external alngam, gamr, r1mach, r9gmit, r9lgic, 1 r9lgit data alneps, sqeps, bot / 3*0.0 / c if (alneps.ne.0.0) go to 10 alneps = -alog(r1mach(3)) sqeps = sqrt(r1mach(4)) bot = alog(r1mach(1)) c 10 if (x.lt.0.0) call seteru (21hgamit x is negative, 21, 2, 2) c if (x.ne.0.0) alx = alog(x) sga = 1.0 if (a.ne.0.0) sga = sign (1.0, a) ainta = aint (a+0.5*sga) aeps = a - ainta c if (x.gt.0.0) go to 20 gamit = 0.0 if (ainta.gt.0.0 .or. aeps.ne.0.0) gamit = gamr(a+1.0) return c 20 if (x.gt.1.0) go to 40 if (a.ge.(-0.5) .or. aeps.ne.0.0) call algams (a+1.0, algap1, 1 sgngam) gamit = r9gmit (a, x, algap1, sgngam, alx) return c 40 if (a.lt.x) go to 50 t = r9lgit (a, x, alngam(a+1.0)) if (t.lt.bot) call erroff gamit = exp(t) return c 50 alng = r9lgic (a, x, alx) c c evaluate gamit in terms of alog(gamic(a,x)) c h = 1.0 if (aeps.eq.0.0 .and. ainta.le.0.0) go to 60 call algams (a+1.0, algap1, sgngam) t = alog(abs(a)) + alng - algap1 if (t.gt.alneps) go to 70 if (t.gt.(-alneps)) h = 1.0 - sga*sgngam*exp(t) if (abs(h).gt.sqeps) go to 60 call erroff call seteru (32hgamit result lt half precision, 32, 1, 1) c 60 t = -a*alx + alog(abs(h)) if (t.lt.bot) call erroff gamit = sign (exp(t), h) return c 70 t = t - a*alx if (t.lt.bot) call erroff gamit = -sga*sgngam*exp(t) return c end |