1*DECK R9LGIC 2 FUNCTION R9LGIC (A, X, ALX) 3C***BEGIN PROLOGUE R9LGIC 4C***SUBSIDIARY 5C***PURPOSE Compute the log complementary incomplete Gamma function 6C for large X and for A .LE. X. 7C***LIBRARY SLATEC (FNLIB) 8C***CATEGORY C7E 9C***TYPE SINGLE PRECISION (R9LGIC-S, D9LGIC-D) 10C***KEYWORDS COMPLEMENTARY INCOMPLETE GAMMA FUNCTION, FNLIB, LARGE X, 11C LOGARITHM, SPECIAL FUNCTIONS 12C***AUTHOR Fullerton, W., (LANL) 13C***DESCRIPTION 14C 15C Compute the log complementary incomplete gamma function for large X 16C and for A .LE. X. 17C 18C***REFERENCES (NONE) 19C***ROUTINES CALLED R1MACH, XERMSG 20C***REVISION HISTORY (YYMMDD) 21C 770701 DATE WRITTEN 22C 890531 Changed all specific intrinsics to generic. (WRB) 23C 890531 REVISION DATE from Version 3.2 24C 891214 Prologue converted to Version 4.0 format. (BAB) 25C 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ) 26C 900720 Routine changed from user-callable to subsidiary. (WRB) 27C***END PROLOGUE R9LGIC 28 SAVE EPS 29 DATA EPS / 0.0 / 30C***FIRST EXECUTABLE STATEMENT R9LGIC 31 IF (EPS.EQ.0.0) EPS = 0.5*R1MACH(3) 32C 33 XPA = X + 1.0 - A 34 XMA = X - 1.0 - A 35C 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) 49C 50 20 R9LGIC = A*ALX - X + LOG(S/XPA) 51C 52 RETURN 53 END 54