00001 *DECK R9LGIC 00002 FUNCTION R9LGIC (A, X, ALX) 00003 C***BEGIN PROLOGUE R9LGIC 00004 C***SUBSIDIARY 00005 C***PURPOSE Compute the log complementary incomplete Gamma function 00006 C for large X and for A .LE. X. 00007 C***LIBRARY SLATEC (FNLIB) 00008 C***CATEGORY C7E 00009 C***TYPE SINGLE PRECISION (R9LGIC-S, D9LGIC-D) 00010 C***KEYWORDS COMPLEMENTARY INCOMPLETE GAMMA FUNCTION, FNLIB, LARGE X, 00011 C LOGARITHM, SPECIAL FUNCTIONS 00012 C***AUTHOR Fullerton, W., (LANL) 00013 C***DESCRIPTION 00014 C 00015 C Compute the log complementary incomplete gamma function for large X 00016 C and for A .LE. X. 00017 C 00018 C***REFERENCES (NONE) 00019 C***ROUTINES CALLED R1MACH, XERMSG 00020 C***REVISION HISTORY (YYMMDD) 00021 C 770701 DATE WRITTEN 00022 C 890531 Changed all specific intrinsics to generic. (WRB) 00023 C 890531 REVISION DATE from Version 3.2 00024 C 891214 Prologue converted to Version 4.0 format. (BAB) 00025 C 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ) 00026 C 900720 Routine changed from user-callable to subsidiary. (WRB) 00027 C***END PROLOGUE R9LGIC 00028 SAVE EPS 00029 DATA EPS / 0.0 / 00030 C***FIRST EXECUTABLE STATEMENT R9LGIC 00031 IF (EPS.EQ.0.0) EPS = 0.5*R1MACH(3) 00032 C 00033 XPA = X + 1.0 - A 00034 XMA = X - 1.0 - A 00035 C 00036 R = 0.0 00037 P = 1.0 00038 S = P 00039 DO 10 K=1,200 00040 FK = K 00041 T = FK*(A-FK)*(1.0+R) 00042 R = -T/((XMA+2.0*FK)*(XPA+2.0*FK)+T) 00043 P = R*P 00044 S = S + P 00045 IF (ABS(P).LT.EPS*S) GO TO 20 00046 10 CONTINUE 00047 CALL XERMSG ('SLATEC', 'R9LGIC', 00048 + 'NO CONVERGENCE IN 200 TERMS OF CONTINUED FRACTION', 1, 2) 00049 C 00050 20 R9LGIC = A*ALX - X + LOG(S/XPA) 00051 C 00052 RETURN 00053 END
1.7.1
