00001 *DECK DGAMR 00002 DOUBLE PRECISION FUNCTION DGAMR (X) 00003 C***BEGIN PROLOGUE DGAMR 00004 C***PURPOSE Compute the reciprocal of the Gamma function. 00005 C***LIBRARY SLATEC (FNLIB) 00006 C***CATEGORY C7A 00007 C***TYPE DOUBLE PRECISION (GAMR-S, DGAMR-D, CGAMR-C) 00008 C***KEYWORDS FNLIB, RECIPROCAL GAMMA FUNCTION, SPECIAL FUNCTIONS 00009 C***AUTHOR Fullerton, W., (LANL) 00010 C***DESCRIPTION 00011 C 00012 C DGAMR(X) calculates the double precision reciprocal of the 00013 C complete Gamma function for double precision argument X. 00014 C 00015 C***REFERENCES (NONE) 00016 C***ROUTINES CALLED DGAMMA, DLGAMS, XERCLR, XGETF, XSETF 00017 C***REVISION HISTORY (YYMMDD) 00018 C 770701 DATE WRITTEN 00019 C 890531 Changed all specific intrinsics to generic. (WRB) 00020 C 890531 REVISION DATE from Version 3.2 00021 C 891214 Prologue converted to Version 4.0 format. (BAB) 00022 C 900727 Added EXTERNAL statement. (WRB) 00023 C***END PROLOGUE DGAMR 00024 DOUBLE PRECISION X, ALNGX, SGNGX, DGAMMA 00025 EXTERNAL DGAMMA 00026 C***FIRST EXECUTABLE STATEMENT DGAMR 00027 DGAMR = 0.0D0 00028 IF (X.LE.0.0D0 .AND. AINT(X).EQ.X) RETURN 00029 C 00030 CALL XGETF (IROLD) 00031 CALL XSETF (1) 00032 IF (ABS(X).GT.10.0D0) GO TO 10 00033 DGAMR = 1.0D0/DGAMMA(X) 00034 CALL XERCLR 00035 CALL XSETF (IROLD) 00036 RETURN 00037 C 00038 10 CALL DLGAMS (X, ALNGX, SGNGX) 00039 CALL XERCLR 00040 CALL XSETF (IROLD) 00041 DGAMR = SGNGX * EXP(-ALNGX) 00042 RETURN 00043 C 00044 END
1.7.1
