00001 *DECK D9LGIC 00002 DOUBLE PRECISION FUNCTION D9LGIC (A, X, ALX) 00003 C***BEGIN PROLOGUE D9LGIC 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 DOUBLE 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 D1MACH, 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 D9LGIC 00028 DOUBLE PRECISION A, X, ALX, EPS, FK, P, R, S, T, XMA, XPA, D1MACH 00029 SAVE EPS 00030 DATA EPS / 0.D0 / 00031 C***FIRST EXECUTABLE STATEMENT D9LGIC 00032 IF (EPS.EQ.0.D0) EPS = 0.5D0*D1MACH(3) 00033 C 00034 XPA = X + 1.0D0 - A 00035 XMA = X - 1.D0 - A 00036 C 00037 R = 0.D0 00038 P = 1.D0 00039 S = P 00040 DO 10 K=1,300 00041 FK = K 00042 T = FK*(A-FK)*(1.D0+R) 00043 R = -T/((XMA+2.D0*FK)*(XPA+2.D0*FK)+T) 00044 P = R*P 00045 S = S + P 00046 IF (ABS(P).LT.EPS*S) GO TO 20 00047 10 CONTINUE 00048 CALL XERMSG ('SLATEC', 'D9LGIC', 00049 + 'NO CONVERGENCE IN 300 TERMS OF CONTINUED FRACTION', 1, 2) 00050 C 00051 20 D9LGIC = A*ALX - X + LOG(S/XPA) 00052 C 00053 RETURN 00054 END
1.7.1
