#include "fpreproc/library_names.h"
#include "fpreproc/f77_dcomplx.h"
#include "fpreproc/fp_const.h"
*DECK D9LGMC
      REAL*8 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      REAL*8 (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
C============
C idecl:  explicitize implicit INTEGER declarations:
      IMPLICIT NONE
      INTEGER nalgm,initds
C============
      REAL*8 X, ALGMCS(15), XBIG, XMAX, DCSEVL, D1MACH
      LOGICAL FIRST
      SAVE ALGMCS, NALGM, XBIG, XMAX, FIRST
      DATA ALGMCS(  1) / +CONST(.1666389480451863247205729650822,+0)/
      DATA ALGMCS(  2) / -CONST(.1384948176067563840732986059135,-4)/
      DATA ALGMCS(  3) / +CONST(.9810825646924729426157171547487,-8)/
      DATA ALGMCS(  4) / -CONST(.1809129475572494194263306266719,-10)/
      DATA ALGMCS(  5) / +CONST(.6221098041892605227126015543416,-13)/
      DATA ALGMCS(  6) / -CONST(.3399615005417721944303330599666,-15)/
      DATA ALGMCS(  7) / +CONST(.2683181998482698748957538846666,-17)/
      DATA ALGMCS(  8) / -CONST(.2868042435334643284144622399999,-19)/
      DATA ALGMCS(  9) / +CONST(.3962837061046434803679306666666,-21)/
      DATA ALGMCS( 10) / -CONST(.6831888753985766870111999999999,-23)/
      DATA ALGMCS( 11) / +CONST(.1429227355942498147573333333333,-24)/
      DATA ALGMCS( 12) / -CONST(.3547598158101070547199999999999,-26)/
      DATA ALGMCS( 13) / +CONST(.1025680058010470912000000000000,-27)/
      DATA ALGMCS( 14) / -CONST(.3401102254316748799999999999999,-29)/
      DATA ALGMCS( 15) / +CONST(.1276642195630062933333333333333,-30)/
      DATA FIRST /.TRUE./
C***FIRST EXECUTABLE STATEMENT  D9LGMC
      IF (FIRST) THEN
         NALGM = INITDS (ALGMCS, 15, AREAL(D1MACH(3)) )
         XBIG = CONST(1.0,0)/SQRT(D1MACH(3))
         XMAX = EXP (MIN(LOG(D1MACH(2)/CONST(12.,0)),
     >      -LOG(CONST(12.,0)*D1MACH(1))))
      ENDIF
      FIRST = .FALSE.
C
      IF (X .LT. CONST(10.,0)) CALL XERMSG ('SLATEC', 'D9LGMC',
     +   'X MUST BE GE 10', 1, 2)
      IF (X.GE.XMAX) GO TO 20
C
      D9LGMC = CONST(1.,0)/(CONST(12.,0)*X)
      IF (X.LT.XBIG) D9LGMC =
     1   DCSEVL (CONST(2.0,0)*(CONST(10.,0)/X)**2-CONST(1.,0), ALGMCS,
     1   NALGM) / X
      RETURN
C
 20   D9LGMC = CONST(0.,0)
      CALL XERMSG ('SLATEC', 'D9LGMC', 'X SO BIG D9LGMC UNDERFLOWS', 2,
     +   1)
      RETURN
C
      END
! 22Jun2000 fgtok -s r8_precision.sub "r8con.csh conversion"
! 22Jun2000 fgtok
! 22Jun2000 fgtok
! 22Jun2000 fgtok
