mirror of
https://git.planet-casio.com/Lephenixnoir/OpenLibm.git
synced 2025-01-01 06:23:39 +01:00
76 lines
3.3 KiB
Fortran
76 lines
3.3 KiB
Fortran
*DECK D9LGMC
|
|
DOUBLE PRECISION FUNCTION D9LGMC (X)
|
|
C***BEGIN PROLOGUE D9LGMC
|
|
C***SUBSIDIARY
|
|
C***PURPOSE Compute the log Gamma correction factor so that
|
|
C LOG(DGAMMA(X)) = LOG(SQRT(2*PI)) + (X-5.)*LOG(X) - X
|
|
C + D9LGMC(X).
|
|
C***LIBRARY SLATEC (FNLIB)
|
|
C***CATEGORY C7E
|
|
C***TYPE DOUBLE PRECISION (R9LGMC-S, D9LGMC-D, C9LGMC-C)
|
|
C***KEYWORDS COMPLETE GAMMA FUNCTION, CORRECTION TERM, FNLIB,
|
|
C LOG GAMMA, LOGARITHM, SPECIAL FUNCTIONS
|
|
C***AUTHOR Fullerton, W., (LANL)
|
|
C***DESCRIPTION
|
|
C
|
|
C Compute the log gamma correction factor for X .GE. 10. so that
|
|
C LOG (DGAMMA(X)) = LOG(SQRT(2*PI)) + (X-.5)*LOG(X) - X + D9lGMC(X)
|
|
C
|
|
C Series for ALGM on the interval 0. to 1.00000E-02
|
|
C with weighted error 1.28E-31
|
|
C log weighted error 30.89
|
|
C significant figures required 29.81
|
|
C decimal places required 31.48
|
|
C
|
|
C***REFERENCES (NONE)
|
|
C***ROUTINES CALLED D1MACH, DCSEVL, INITDS, 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 900720 Routine changed from user-callable to subsidiary. (WRB)
|
|
C***END PROLOGUE D9LGMC
|
|
DOUBLE PRECISION X, ALGMCS(15), XBIG, XMAX, DCSEVL, D1MACH
|
|
LOGICAL FIRST
|
|
SAVE ALGMCS, NALGM, XBIG, XMAX, FIRST
|
|
DATA ALGMCS( 1) / +.1666389480 4518632472 0572965082 2 D+0 /
|
|
DATA ALGMCS( 2) / -.1384948176 0675638407 3298605913 5 D-4 /
|
|
DATA ALGMCS( 3) / +.9810825646 9247294261 5717154748 7 D-8 /
|
|
DATA ALGMCS( 4) / -.1809129475 5724941942 6330626671 9 D-10 /
|
|
DATA ALGMCS( 5) / +.6221098041 8926052271 2601554341 6 D-13 /
|
|
DATA ALGMCS( 6) / -.3399615005 4177219443 0333059966 6 D-15 /
|
|
DATA ALGMCS( 7) / +.2683181998 4826987489 5753884666 6 D-17 /
|
|
DATA ALGMCS( 8) / -.2868042435 3346432841 4462239999 9 D-19 /
|
|
DATA ALGMCS( 9) / +.3962837061 0464348036 7930666666 6 D-21 /
|
|
DATA ALGMCS( 10) / -.6831888753 9857668701 1199999999 9 D-23 /
|
|
DATA ALGMCS( 11) / +.1429227355 9424981475 7333333333 3 D-24 /
|
|
DATA ALGMCS( 12) / -.3547598158 1010705471 9999999999 9 D-26 /
|
|
DATA ALGMCS( 13) / +.1025680058 0104709120 0000000000 0 D-27 /
|
|
DATA ALGMCS( 14) / -.3401102254 3167487999 9999999999 9 D-29 /
|
|
DATA ALGMCS( 15) / +.1276642195 6300629333 3333333333 3 D-30 /
|
|
DATA FIRST /.TRUE./
|
|
C***FIRST EXECUTABLE STATEMENT D9LGMC
|
|
IF (FIRST) THEN
|
|
NALGM = INITDS (ALGMCS, 15, REAL(D1MACH(3)) )
|
|
XBIG = 1.0D0/SQRT(D1MACH(3))
|
|
XMAX = EXP (MIN(LOG(D1MACH(2)/12.D0), -LOG(12.D0*D1MACH(1))))
|
|
ENDIF
|
|
FIRST = .FALSE.
|
|
C
|
|
IF (X .LT. 10.D0) CALL XERMSG ('SLATEC', 'D9LGMC',
|
|
+ 'X MUST BE GE 10', 1, 2)
|
|
IF (X.GE.XMAX) GO TO 20
|
|
C
|
|
D9LGMC = 1.D0/(12.D0*X)
|
|
IF (X.LT.XBIG) D9LGMC = DCSEVL (2.0D0*(10.D0/X)**2-1.D0, ALGMCS,
|
|
1 NALGM) / X
|
|
RETURN
|
|
C
|
|
20 D9LGMC = 0.D0
|
|
CALL XERMSG ('SLATEC', 'D9LGMC', 'X SO BIG D9LGMC UNDERFLOWS', 2,
|
|
+ 1)
|
|
RETURN
|
|
C
|
|
END
|