mirror of
https://git.planet-casio.com/Lephenixnoir/OpenLibm.git
synced 2025-01-01 06:23:39 +01:00
77 lines
3.6 KiB
Fortran
77 lines
3.6 KiB
Fortran
*DECK DFAC
|
|
DOUBLE PRECISION FUNCTION DFAC (N)
|
|
C***BEGIN PROLOGUE DFAC
|
|
C***PURPOSE Compute the factorial function.
|
|
C***LIBRARY SLATEC (FNLIB)
|
|
C***CATEGORY C1
|
|
C***TYPE DOUBLE PRECISION (FAC-S, DFAC-D)
|
|
C***KEYWORDS FACTORIAL, FNLIB, SPECIAL FUNCTIONS
|
|
C***AUTHOR Fullerton, W., (LANL)
|
|
C***DESCRIPTION
|
|
C
|
|
C DFAC(N) calculates the double precision factorial for integer
|
|
C argument N.
|
|
C
|
|
C***REFERENCES (NONE)
|
|
C***ROUTINES CALLED D9LGMC, DGAMLM, 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 DFAC
|
|
DOUBLE PRECISION FACN(31), SQ2PIL, X, XMAX, XMIN, D9LGMC
|
|
SAVE FACN, SQ2PIL, NMAX
|
|
DATA FACN ( 1) / +.1000000000 0000000000 0000000000 000 D+1 /
|
|
DATA FACN ( 2) / +.1000000000 0000000000 0000000000 000 D+1 /
|
|
DATA FACN ( 3) / +.2000000000 0000000000 0000000000 000 D+1 /
|
|
DATA FACN ( 4) / +.6000000000 0000000000 0000000000 000 D+1 /
|
|
DATA FACN ( 5) / +.2400000000 0000000000 0000000000 000 D+2 /
|
|
DATA FACN ( 6) / +.1200000000 0000000000 0000000000 000 D+3 /
|
|
DATA FACN ( 7) / +.7200000000 0000000000 0000000000 000 D+3 /
|
|
DATA FACN ( 8) / +.5040000000 0000000000 0000000000 000 D+4 /
|
|
DATA FACN ( 9) / +.4032000000 0000000000 0000000000 000 D+5 /
|
|
DATA FACN ( 10) / +.3628800000 0000000000 0000000000 000 D+6 /
|
|
DATA FACN ( 11) / +.3628800000 0000000000 0000000000 000 D+7 /
|
|
DATA FACN ( 12) / +.3991680000 0000000000 0000000000 000 D+8 /
|
|
DATA FACN ( 13) / +.4790016000 0000000000 0000000000 000 D+9 /
|
|
DATA FACN ( 14) / +.6227020800 0000000000 0000000000 000 D+10 /
|
|
DATA FACN ( 15) / +.8717829120 0000000000 0000000000 000 D+11 /
|
|
DATA FACN ( 16) / +.1307674368 0000000000 0000000000 000 D+13 /
|
|
DATA FACN ( 17) / +.2092278988 8000000000 0000000000 000 D+14 /
|
|
DATA FACN ( 18) / +.3556874280 9600000000 0000000000 000 D+15 /
|
|
DATA FACN ( 19) / +.6402373705 7280000000 0000000000 000 D+16 /
|
|
DATA FACN ( 20) / +.1216451004 0883200000 0000000000 000 D+18 /
|
|
DATA FACN ( 21) / +.2432902008 1766400000 0000000000 000 D+19 /
|
|
DATA FACN ( 22) / +.5109094217 1709440000 0000000000 000 D+20 /
|
|
DATA FACN ( 23) / +.1124000727 7776076800 0000000000 000 D+22 /
|
|
DATA FACN ( 24) / +.2585201673 8884976640 0000000000 000 D+23 /
|
|
DATA FACN ( 25) / +.6204484017 3323943936 0000000000 000 D+24 /
|
|
DATA FACN ( 26) / +.1551121004 3330985984 0000000000 000 D+26 /
|
|
DATA FACN ( 27) / +.4032914611 2660563558 4000000000 000 D+27 /
|
|
DATA FACN ( 28) / +.1088886945 0418352160 7680000000 000 D+29 /
|
|
DATA FACN ( 29) / +.3048883446 1171386050 1504000000 000 D+30 /
|
|
DATA FACN ( 30) / +.8841761993 7397019545 4361600000 000 D+31 /
|
|
DATA FACN ( 31) / +.2652528598 1219105863 6308480000 000 D+33 /
|
|
DATA SQ2PIL / 0.9189385332 0467274178 0329736405 62 D0 /
|
|
DATA NMAX / 0 /
|
|
C***FIRST EXECUTABLE STATEMENT DFAC
|
|
IF (NMAX.NE.0) GO TO 10
|
|
CALL DGAMLM (XMIN, XMAX)
|
|
NMAX = XMAX - 1.D0
|
|
C
|
|
10 IF (N .LT. 0) CALL XERMSG ('SLATEC', 'DFAC',
|
|
+ 'FACTORIAL OF NEGATIVE INTEGER UNDEFINED', 1, 2)
|
|
C
|
|
IF (N.LE.30) DFAC = FACN(N+1)
|
|
IF (N.LE.30) RETURN
|
|
C
|
|
IF (N .GT. NMAX) CALL XERMSG ('SLATEC', 'DFAC',
|
|
+ 'N SO BIG FACTORIAL(N) OVERFLOWS', 2, 2)
|
|
C
|
|
X = N + 1
|
|
DFAC = EXP ((X-0.5D0)*LOG(X) - X + SQ2PIL + D9LGMC(X) )
|
|
C
|
|
RETURN
|
|
END
|