mirror of
https://git.planet-casio.com/Lephenixnoir/OpenLibm.git
synced 2025-01-01 06:23:39 +01:00
70 lines
2.2 KiB
Fortran
70 lines
2.2 KiB
Fortran
*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
|