relibc_openlibm/slatec/fac.f

*DECK FAC
      FUNCTION FAC (N)
C***BEGIN PROLOGUE  FAC
C***PURPOSE  Compute the factorial function.
C***LIBRARY   SLATEC (FNLIB)
C***CATEGORY  C1
C***TYPE      SINGLE PRECISION (FAC-S, DFAC-D)
C***KEYWORDS  FACTORIAL, FNLIB, SPECIAL FUNCTIONS
C***AUTHOR  Fullerton, W., (LANL)
C***DESCRIPTION
C
C FAC(N) evaluates the factorial function of N.  FAC is single
C precision.  N must be an integer between 0 and 25 inclusive.
C
C***REFERENCES  (NONE)
C***ROUTINES CALLED  GAMLIM, 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***END PROLOGUE  FAC
      DIMENSION FACN(26)
      SAVE FACN, SQ2PIL, NMAX
      DATA FACN( 1) / 1.0E0 /
      DATA FACN( 2) / 1.0E0 /
      DATA FACN( 3) / 2.0E0 /
      DATA FACN( 4) / 6.0E0 /
      DATA FACN( 5) / 24.0E0 /
      DATA FACN( 6) / 120.0E0 /
      DATA FACN( 7) / 720.0E0 /
      DATA FACN( 8) / 5040.0E0 /
      DATA FACN( 9) / 40320.0E0 /
      DATA FACN(10) / 362880.0E0 /
      DATA FACN(11) / 3628800.0E0 /
      DATA FACN(12) / 39916800.0E0 /
      DATA FACN(13) / 479001600.0E0 /
      DATA FACN(14) / 6227020800.0E0 /
      DATA FACN(15) / 87178291200.0E0 /
      DATA FACN(16) / 1307674368000.0E0 /
      DATA FACN(17) / 20922789888000.0E0 /
      DATA FACN(18) / 355687428096000.0E0 /
      DATA FACN(19) / 6402373705728000.0E0 /
      DATA FACN(20) /  .12164510040883200E18 /
      DATA FACN(21) /  .24329020081766400E19 /
      DATA FACN(22) /  .51090942171709440E20 /
      DATA FACN(23) /  .11240007277776077E22 /
      DATA FACN(24) /  .25852016738884977E23 /
      DATA FACN(25) /  .62044840173323944E24 /
      DATA FACN(26) /  .15511210043330986E26 /
      DATA SQ2PIL / 0.9189385332 0467274E0/
      DATA NMAX / 0 /
C***FIRST EXECUTABLE STATEMENT  FAC
      IF (NMAX.NE.0) GO TO 10
      CALL GAMLIM (XMIN, XMAX)
      NMAX = XMAX - 1.
C
 10   IF (N .LT. 0) CALL XERMSG ('SLATEC', 'FAC',
     +   'FACTORIAL OF NEGATIVE INTEGER UNDEFINED', 1, 2)
C
      IF (N.LE.25) FAC = FACN(N+1)
      IF (N.LE.25) RETURN
C
      IF (N .GT. NMAX) CALL XERMSG ('SLATEC', 'FAC',
     +   'N SO BIG FACTORIAL(N) OVERFLOWS', 2, 2)
C
      X = N + 1
      FAC = EXP ( (X-0.5)*LOG(X) - X + SQ2PIL + R9LGMC(X) )
C
      RETURN
      END