alngam.f

Go to the documentation of this file.

*DECK ALNGAM
      FUNCTION alngam (X)
C***BEGIN PROLOGUE  ALNGAM
C***PURPOSE  Compute the logarithm of the absolute value of the Gamma
C            function.
C***LIBRARY   SLATEC (FNLIB)
C***CATEGORY  C7A
C***TYPE      SINGLE PRECISION (ALNGAM-S, DLNGAM-D, CLNGAM-C)
C***KEYWORDS  ABSOLUTE VALUE, COMPLETE GAMMA FUNCTION, FNLIB, LOGARITHM,
C             SPECIAL FUNCTIONS
C***AUTHOR  Fullerton, W., (LANL)
C***DESCRIPTION
C
C ALNGAM(X) computes the logarithm of the absolute value of the
C gamma function at X.
C
C***REFERENCES  (NONE)
C***ROUTINES CALLED  GAMMA, R1MACH, R9LGMC, XERMSG
C***REVISION HISTORY  (YYMMDD)
C   770601  DATE WRITTEN
C   890531  Changed all specific intrinsics to generic.  (WRB)
C   890531  REVISION DATE from Version 3.2
C   891214  Prologue converted to Version 4.0 format.  (BAB)
C   900315  CALLs to XERROR changed to CALLs to XERMSG.  (THJ)
C   900326  Removed duplicate information from DESCRIPTION section.
C           (WRB)
C   900727  Added EXTERNAL statement.  (WRB)
C***END PROLOGUE  ALNGAM
      LOGICAL first
      EXTERNAL gamma
      SAVE sq2pil, sqpi2l, pi, xmax, dxrel, first
      DATA sq2pil / 0.9189385332 0467274e0/
      DATA sqpi2l / 0.2257913526 4472743e0/
      DATA pi     / 3.1415926535 8979324e0/
      DATA first  /.true./
C***FIRST EXECUTABLE STATEMENT  ALNGAM
      IF (first) THEN
         xmax = r1mach(2)/log(r1mach(2))
         dxrel = sqrt(r1mach(4))
      ENDIF
      first = .false.
C
      y = abs(x)
      IF (y.GT.10.0) go to 20
C
C LOG (ABS (GAMMA(X))) FOR  ABS(X) .LE. 10.0
C
      alngam = log(abs(gamma(x)))
      RETURN
C
C LOG (ABS (GAMMA(X))) FOR ABS(X) .GT. 10.0
C
 20   IF (y .GT. xmax) CALL xermsg('SLATEC', 'ALNGAM',
     +   'ABS(X) SO BIG ALNGAM OVERFLOWS', 2, 2)
C
      IF (x.GT.0.) alngam = sq2pil + (x-0.5)*log(x) - x + r9lgmc(y)
      IF (x.GT.0.) RETURN
C
      sinpiy = abs(sin(pi*y))
      IF (sinpiy .EQ. 0.) CALL xermsg('SLATEC', 'ALNGAM',
     +   'X IS A NEGATIVE INTEGER', 3, 2)
C
      IF (abs((x-aint(x-0.5))/x) .LT. dxrel) CALL xermsg('SLATEC',
     +   'ALNGAM', 'ANSWER LT HALF PRECISION BECAUSE X TOO NEAR ' //
     +   'NEGATIVE INTEGER', 1, 1)
C
      alngam = sqpi2l + (x-0.5)*log(y) - x - log(sinpiy) - r9lgmc(y)
      RETURN
C
      END