GNU Octave: libcruft/slatec-fn/dlngam.f Source File

Go to the documentation of this file.
00001 *DECK DLNGAM
00002       DOUBLE PRECISION FUNCTION DLNGAM (X)
00003 C***BEGIN PROLOGUE  DLNGAM
00004 C***PURPOSE  Compute the logarithm of the absolute value of the Gamma
00005 C            function.
00006 C***LIBRARY   SLATEC (FNLIB)
00007 C***CATEGORY  C7A
00008 C***TYPE      DOUBLE PRECISION (ALNGAM-S, DLNGAM-D, CLNGAM-C)
00009 C***KEYWORDS  ABSOLUTE VALUE, COMPLETE GAMMA FUNCTION, FNLIB, LOGARITHM,
00010 C             SPECIAL FUNCTIONS
00011 C***AUTHOR  Fullerton, W., (LANL)
00012 C***DESCRIPTION
00013 C
00014 C DLNGAM(X) calculates the double precision logarithm of the
00015 C absolute value of the Gamma function for double precision
00016 C argument X.
00017 C
00018 C***REFERENCES  (NONE)
00019 C***ROUTINES CALLED  D1MACH, D9LGMC, DGAMMA, XERMSG
00020 C***REVISION HISTORY  (YYMMDD)
00021 C   770601  DATE WRITTEN
00022 C   890531  Changed all specific intrinsics to generic.  (WRB)
00023 C   890531  REVISION DATE from Version 3.2
00024 C   891214  Prologue converted to Version 4.0 format.  (BAB)
00025 C   900315  CALLs to XERROR changed to CALLs to XERMSG.  (THJ)
00026 C   900727  Added EXTERNAL statement.  (WRB)
00027 C***END PROLOGUE  DLNGAM
00028       DOUBLE PRECISION X, DXREL, PI, SINPIY, SQPI2L, SQ2PIL, XMAX,
00029      1  Y, DGAMMA, D9LGMC, D1MACH, TEMP
00030       LOGICAL FIRST
00031       EXTERNAL DGAMMA
00032       SAVE SQ2PIL, SQPI2L, PI, XMAX, DXREL, FIRST
00033       DATA SQ2PIL / 0.9189385332 0467274178 0329736405 62 D0 /
00034       DATA SQPI2L / +.2257913526 4472743236 3097614947 441 D+0    /
00035       DATA PI / 3.1415926535 8979323846 2643383279 50 D0 /
00036       DATA FIRST /.TRUE./
00037 C***FIRST EXECUTABLE STATEMENT  DLNGAM
00038       IF (FIRST) THEN
00039          TEMP = 1.D0/LOG(D1MACH(2))
00040          XMAX = TEMP*D1MACH(2)
00041          DXREL = SQRT(D1MACH(4))
00042       ENDIF
00043       FIRST = .FALSE.
00044 C
00045       Y = ABS (X)
00046       IF (Y.GT.10.D0) GO TO 20
00047 C
00048 C LOG (ABS (DGAMMA(X)) ) FOR ABS(X) .LE. 10.0
00049 C
00050       DLNGAM = LOG (ABS (DGAMMA(X)) )
00051       RETURN
00052 C
00053 C LOG ( ABS (DGAMMA(X)) ) FOR ABS(X) .GT. 10.0
00054 C
00055  20   IF (Y .GT. XMAX) CALL XERMSG ('SLATEC', 'DLNGAM',
00056      +   'ABS(X) SO BIG DLNGAM OVERFLOWS', 2, 2)
00057 C
00058       IF (X.GT.0.D0) DLNGAM = SQ2PIL + (X-0.5D0)*LOG(X) - X + D9LGMC(Y)
00059       IF (X.GT.0.D0) RETURN
00060 C
00061       SINPIY = ABS (SIN(PI*Y))
00062       IF (SINPIY .EQ. 0.D0) CALL XERMSG ('SLATEC', 'DLNGAM',
00063      +   'X IS A NEGATIVE INTEGER', 3, 2)
00064 C
00065       IF (ABS((X-AINT(X-0.5D0))/X) .LT. DXREL) CALL XERMSG ('SLATEC',
00066      +   'DLNGAM',
00067      +   'ANSWER LT HALF PRECISION BECAUSE X TOO NEAR NEGATIVE INTEGER',
00068      +   1, 1)
00069 C
00070       DLNGAM = SQPI2L + (X-0.5D0)*LOG(Y) - X - LOG(SINPIY) - D9LGMC(Y)
00071       RETURN
00072 C
00073       END