00001 *DECK GAMR 00002 FUNCTION GAMR (X) 00003 C***BEGIN PROLOGUE GAMR 00004 C***PURPOSE Compute the reciprocal of the Gamma function. 00005 C***LIBRARY SLATEC (FNLIB) 00006 C***CATEGORY C7A 00007 C***TYPE SINGLE 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 GAMR is a single precision function that evaluates the reciprocal 00013 C of the gamma function for single precision argument X. 00014 C 00015 C***REFERENCES (NONE) 00016 C***ROUTINES CALLED ALGAMS, GAMMA, XERCLR, XGETF, XSETF 00017 C***REVISION HISTORY (YYMMDD) 00018 C 770701 DATE WRITTEN 00019 C 861211 REVISION DATE from Version 3.2 00020 C 891214 Prologue converted to Version 4.0 format. (BAB) 00021 C 900727 Added EXTERNAL statement. (WRB) 00022 C***END PROLOGUE GAMR 00023 EXTERNAL GAMMA 00024 C***FIRST EXECUTABLE STATEMENT GAMR 00025 GAMR = 0.0 00026 IF (X.LE.0.0 .AND. AINT(X).EQ.X) RETURN 00027 C 00028 CALL XGETF (IROLD) 00029 CALL XSETF (1) 00030 IF (ABS(X).GT.10.0) GO TO 10 00031 GAMR = 1.0/GAMMA(X) 00032 CALL XERCLR 00033 CALL XSETF (IROLD) 00034 RETURN 00035 C 00036 10 CALL ALGAMS (X, ALNGX, SGNGX) 00037 CALL XERCLR 00038 CALL XSETF (IROLD) 00039 GAMR = SGNGX * EXP(-ALNGX) 00040 RETURN 00041 C 00042 END
1.7.1
