gamr.f 1.2 KB

123456789101112131415161718192021222324252627282930313233343536373839404142
  1. *DECK GAMR
  2. FUNCTION GAMR (X)
  3. C***BEGIN PROLOGUE GAMR
  4. C***PURPOSE Compute the reciprocal of the Gamma function.
  5. C***LIBRARY SLATEC (FNLIB)
  6. C***CATEGORY C7A
  7. C***TYPE SINGLE PRECISION (GAMR-S, DGAMR-D, CGAMR-C)
  8. C***KEYWORDS FNLIB, RECIPROCAL GAMMA FUNCTION, SPECIAL FUNCTIONS
  9. C***AUTHOR Fullerton, W., (LANL)
  10. C***DESCRIPTION
  11. C
  12. C GAMR is a single precision function that evaluates the reciprocal
  13. C of the gamma function for single precision argument X.
  14. C
  15. C***REFERENCES (NONE)
  16. C***ROUTINES CALLED ALGAMS, GAMMA, XERCLR, XGETF, XSETF
  17. C***REVISION HISTORY (YYMMDD)
  18. C 770701 DATE WRITTEN
  19. C 861211 REVISION DATE from Version 3.2
  20. C 891214 Prologue converted to Version 4.0 format. (BAB)
  21. C 900727 Added EXTERNAL statement. (WRB)
  22. C***END PROLOGUE GAMR
  23. EXTERNAL GAMMA
  24. C***FIRST EXECUTABLE STATEMENT GAMR
  25. GAMR = 0.0
  26. IF (X.LE.0.0 .AND. AINT(X).EQ.X) RETURN
  27. C
  28. CALL XGETF (IROLD)
  29. CALL XSETF (1)
  30. IF (ABS(X).GT.10.0) GO TO 10
  31. GAMR = 1.0/GAMMA(X)
  32. CALL XERCLR
  33. CALL XSETF (IROLD)
  34. RETURN
  35. C
  36. 10 CALL ALGAMS (X, ALNGX, SGNGX)
  37. CALL XERCLR
  38. CALL XSETF (IROLD)
  39. GAMR = SGNGX * EXP(-ALNGX)
  40. RETURN
  41. C
  42. END