gamlim.f 2.0 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061
  1. *DECK GAMLIM
  2. SUBROUTINE GAMLIM (XMIN, XMAX)
  3. C***BEGIN PROLOGUE GAMLIM
  4. C***PURPOSE Compute the minimum and maximum bounds for the argument in
  5. C the Gamma function.
  6. C***LIBRARY SLATEC (FNLIB)
  7. C***CATEGORY C7A, R2
  8. C***TYPE SINGLE PRECISION (GAMLIM-S, DGAMLM-D)
  9. C***KEYWORDS COMPLETE GAMMA FUNCTION, FNLIB, LIMITS, SPECIAL FUNCTIONS
  10. C***AUTHOR Fullerton, W., (LANL)
  11. C***DESCRIPTION
  12. C
  13. C Calculate the minimum and maximum legal bounds for X in GAMMA(X).
  14. C XMIN and XMAX are not the only bounds, but they are the only non-
  15. C trivial ones to calculate.
  16. C
  17. C Output Arguments --
  18. C XMIN minimum legal value of X in GAMMA(X). Any smaller value of
  19. C X might result in underflow.
  20. C XMAX maximum legal value of X in GAMMA(X). Any larger value will
  21. C cause overflow.
  22. C
  23. C***REFERENCES (NONE)
  24. C***ROUTINES CALLED R1MACH, XERMSG
  25. C***REVISION HISTORY (YYMMDD)
  26. C 770401 DATE WRITTEN
  27. C 890531 Changed all specific intrinsics to generic. (WRB)
  28. C 890531 REVISION DATE from Version 3.2
  29. C 891214 Prologue converted to Version 4.0 format. (BAB)
  30. C 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ)
  31. C***END PROLOGUE GAMLIM
  32. C***FIRST EXECUTABLE STATEMENT GAMLIM
  33. ALNSML = LOG(R1MACH(1))
  34. XMIN = -ALNSML
  35. DO 10 I=1,10
  36. XOLD = XMIN
  37. XLN = LOG(XMIN)
  38. XMIN = XMIN - XMIN*((XMIN+0.5)*XLN - XMIN - 0.2258 + ALNSML)
  39. 1 / (XMIN*XLN + 0.5)
  40. IF (ABS(XMIN-XOLD).LT.0.005) GO TO 20
  41. 10 CONTINUE
  42. CALL XERMSG ('SLATEC', 'GAMLIM', 'UNABLE TO FIND XMIN', 1, 2)
  43. C
  44. 20 XMIN = -XMIN + 0.01
  45. C
  46. ALNBIG = LOG(R1MACH(2))
  47. XMAX = ALNBIG
  48. DO 30 I=1,10
  49. XOLD = XMAX
  50. XLN = LOG(XMAX)
  51. XMAX = XMAX - XMAX*((XMAX-0.5)*XLN - XMAX + 0.9189 - ALNBIG)
  52. 1 / (XMAX*XLN - 0.5)
  53. IF (ABS(XMAX-XOLD).LT.0.005) GO TO 40
  54. 30 CONTINUE
  55. CALL XERMSG ('SLATEC', 'GAMLIM', 'UNABLE TO FIND XMAX', 2, 2)
  56. C
  57. 40 XMAX = XMAX - 0.01
  58. XMIN = MAX (XMIN, -XMAX+1.)
  59. C
  60. RETURN
  61. END