d9lgmc.f

Go to the documentation of this file.
00001 *DECK D9LGMC
00002       DOUBLE PRECISION FUNCTION D9LGMC (X)
00003 C***BEGIN PROLOGUE  D9LGMC
00004 C***SUBSIDIARY
00005 C***PURPOSE  Compute the log Gamma correction factor so that
00006 C            LOG(DGAMMA(X)) = LOG(SQRT(2*PI)) + (X-5.)*LOG(X) - X
00007 C            + D9LGMC(X).
00008 C***LIBRARY   SLATEC (FNLIB)
00009 C***CATEGORY  C7E
00010 C***TYPE      DOUBLE PRECISION (R9LGMC-S, D9LGMC-D, C9LGMC-C)
00011 C***KEYWORDS  COMPLETE GAMMA FUNCTION, CORRECTION TERM, FNLIB,
00012 C             LOG GAMMA, LOGARITHM, SPECIAL FUNCTIONS
00013 C***AUTHOR  Fullerton, W., (LANL)
00014 C***DESCRIPTION
00015 C
00016 C Compute the log gamma correction factor for X .GE. 10. so that
00017 C LOG (DGAMMA(X)) = LOG(SQRT(2*PI)) + (X-.5)*LOG(X) - X + D9lGMC(X)
00018 C
00019 C Series for ALGM       on the interval  0.          to  1.00000E-02
00020 C                                        with weighted error   1.28E-31
00021 C                                         log weighted error  30.89
00022 C                               significant figures required  29.81
00023 C                                    decimal places required  31.48
00024 C
00025 C***REFERENCES  (NONE)
00026 C***ROUTINES CALLED  D1MACH, DCSEVL, INITDS, XERMSG
00027 C***REVISION HISTORY  (YYMMDD)
00028 C   770601  DATE WRITTEN
00029 C   890531  Changed all specific intrinsics to generic.  (WRB)
00030 C   890531  REVISION DATE from Version 3.2
00031 C   891214  Prologue converted to Version 4.0 format.  (BAB)
00032 C   900315  CALLs to XERROR changed to CALLs to XERMSG.  (THJ)
00033 C   900720  Routine changed from user-callable to subsidiary.  (WRB)
00034 C***END PROLOGUE  D9LGMC
00035       DOUBLE PRECISION X, ALGMCS(15), XBIG, XMAX, DCSEVL, D1MACH
00036       LOGICAL FIRST
00037       SAVE ALGMCS, NALGM, XBIG, XMAX, FIRST
00038       DATA ALGMCS(  1) / +.1666389480 4518632472 0572965082 2 D+0      /
00039       DATA ALGMCS(  2) / -.1384948176 0675638407 3298605913 5 D-4      /
00040       DATA ALGMCS(  3) / +.9810825646 9247294261 5717154748 7 D-8      /
00041       DATA ALGMCS(  4) / -.1809129475 5724941942 6330626671 9 D-10     /
00042       DATA ALGMCS(  5) / +.6221098041 8926052271 2601554341 6 D-13     /
00043       DATA ALGMCS(  6) / -.3399615005 4177219443 0333059966 6 D-15     /
00044       DATA ALGMCS(  7) / +.2683181998 4826987489 5753884666 6 D-17     /
00045       DATA ALGMCS(  8) / -.2868042435 3346432841 4462239999 9 D-19     /
00046       DATA ALGMCS(  9) / +.3962837061 0464348036 7930666666 6 D-21     /
00047       DATA ALGMCS( 10) / -.6831888753 9857668701 1199999999 9 D-23     /
00048       DATA ALGMCS( 11) / +.1429227355 9424981475 7333333333 3 D-24     /
00049       DATA ALGMCS( 12) / -.3547598158 1010705471 9999999999 9 D-26     /
00050       DATA ALGMCS( 13) / +.1025680058 0104709120 0000000000 0 D-27     /
00051       DATA ALGMCS( 14) / -.3401102254 3167487999 9999999999 9 D-29     /
00052       DATA ALGMCS( 15) / +.1276642195 6300629333 3333333333 3 D-30     /
00053       DATA FIRST /.TRUE./
00054 C***FIRST EXECUTABLE STATEMENT  D9LGMC
00055       IF (FIRST) THEN
00056          NALGM = INITDS (ALGMCS, 15, REAL(D1MACH(3)) )
00057          XBIG = 1.0D0/SQRT(D1MACH(3))
00058          XMAX = EXP (MIN(LOG(D1MACH(2)/12.D0), -LOG(12.D0*D1MACH(1))))
00059       ENDIF
00060       FIRST = .FALSE.
00061 C
00062       IF (X .LT. 10.D0) CALL XERMSG ('SLATEC', 'D9LGMC',
00063      +   'X MUST BE GE 10', 1, 2)
00064       IF (X.GE.XMAX) GO TO 20
00065 C
00066       D9LGMC = 1.D0/(12.D0*X)
00067       IF (X.LT.XBIG) D9LGMC = DCSEVL (2.0D0*(10.D0/X)**2-1.D0, ALGMCS,
00068      1  NALGM) / X
00069       RETURN
00070 C
00071  20   D9LGMC = 0.D0
00072       CALL XERMSG ('SLATEC', 'D9LGMC', 'X SO BIG D9LGMC UNDERFLOWS', 2,
00073      +   1)
00074       RETURN
00075 C
00076       END
 All Classes Files Functions Variables Typedefs Enumerations Enumerator Friends Defines