GNU Octave  3.8.0
A high-level interpreted language, primarily intended for numerical computations, mostly compatible with Matlab
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Properties Friends Macros Pages
r9lgic.f
Go to the documentation of this file.
1 *DECK R9LGIC
2  FUNCTION r9lgic (A, X, ALX)
3 C***BEGIN PROLOGUE R9LGIC
4 C***SUBSIDIARY
5 C***PURPOSE Compute the log complementary incomplete Gamma function
6 C for large X and for A .LE. X.
7 C***LIBRARY SLATEC (FNLIB)
8 C***CATEGORY C7E
9 C***TYPE SINGLE PRECISION (R9LGIC-S, D9LGIC-D)
10 C***KEYWORDS COMPLEMENTARY INCOMPLETE GAMMA FUNCTION, FNLIB, LARGE X,
11 C LOGARITHM, SPECIAL FUNCTIONS
12 C***AUTHOR Fullerton, W., (LANL)
13 C***DESCRIPTION
14 C
15 C Compute the log complementary incomplete gamma function for large X
16 C and for A .LE. X.
17 C
18 C***REFERENCES (NONE)
19 C***ROUTINES CALLED R1MACH, XERMSG
20 C***REVISION HISTORY (YYMMDD)
21 C 770701 DATE WRITTEN
22 C 890531 Changed all specific intrinsics to generic. (WRB)
23 C 890531 REVISION DATE from Version 3.2
24 C 891214 Prologue converted to Version 4.0 format. (BAB)
25 C 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ)
26 C 900720 Routine changed from user-callable to subsidiary. (WRB)
27 C***END PROLOGUE R9LGIC
28  SAVE eps
29  DATA eps / 0.0 /
30 C***FIRST EXECUTABLE STATEMENT R9LGIC
31  IF (eps.EQ.0.0) eps = 0.5*r1mach(3)
32 C
33  xpa = x + 1.0 - a
34  xma = x - 1.0 - a
35 C
36  r = 0.0
37  p = 1.0
38  s = p
39  DO 10 k=1,200
40  fk = k
41  t = fk*(a-fk)*(1.0+r)
42  r = -t/((xma+2.0*fk)*(xpa+2.0*fk)+t)
43  p = r*p
44  s = s + p
45  IF (abs(p).LT.eps*s) go to 20
46  10 CONTINUE
47  CALL xermsg('SLATEC', 'R9LGIC',
48  + 'NO CONVERGENCE IN 200 TERMS OF CONTINUED FRACTION', 1, 2)
49 C
50  20 r9lgic = a*alx - x + log(s/xpa)
51 C
52  RETURN
53  END