fac.c 6.5 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183
  1. /* fac.c
  2. *
  3. * Factorial function
  4. *
  5. *
  6. *
  7. * SYNOPSIS:
  8. *
  9. * double y, fac();
  10. * int i;
  11. *
  12. * y = fac( i );
  13. *
  14. *
  15. *
  16. * DESCRIPTION:
  17. *
  18. * Returns factorial of i = 1 * 2 * 3 * ... * i.
  19. * fac(0) = 1.0.
  20. *
  21. * Due to machine arithmetic bounds the largest value of
  22. * i accepted is 33 in DEC arithmetic or 170 in IEEE
  23. * arithmetic. Greater values, or negative ones,
  24. * produce an error message and return MAXNUM.
  25. *
  26. *
  27. *
  28. * ACCURACY:
  29. *
  30. * For i < 34 the values are simply tabulated, and have
  31. * full machine accuracy. If i > 55, fac(i) = gamma(i+1);
  32. * see gamma.c.
  33. *
  34. * Relative error:
  35. * arithmetic domain peak
  36. * IEEE 0, 170 1.4e-15
  37. * DEC 0, 33 1.4e-17
  38. *
  39. */
  40. /*
  41. Cephes Math Library Release 2.8: June, 2000
  42. Copyright 1984, 1987, 2000 by Stephen L. Moshier
  43. */
  44. #include "mconf.h"
  45. /* Factorials of integers from 0 through 33 */
  46. #ifdef UNK
  47. static double factbl[] = {
  48. 1.00000000000000000000E0, 1.00000000000000000000E0,
  49. 2.00000000000000000000E0, 6.00000000000000000000E0,
  50. 2.40000000000000000000E1, 1.20000000000000000000E2,
  51. 7.20000000000000000000E2, 5.04000000000000000000E3,
  52. 4.03200000000000000000E4, 3.62880000000000000000E5,
  53. 3.62880000000000000000E6, 3.99168000000000000000E7,
  54. 4.79001600000000000000E8, 6.22702080000000000000E9,
  55. 8.71782912000000000000E10, 1.30767436800000000000E12,
  56. 2.09227898880000000000E13, 3.55687428096000000000E14,
  57. 6.40237370572800000000E15, 1.21645100408832000000E17,
  58. 2.43290200817664000000E18, 5.10909421717094400000E19,
  59. 1.12400072777760768000E21, 2.58520167388849766400E22,
  60. 6.20448401733239439360E23, 1.55112100433309859840E25,
  61. 4.03291461126605635584E26, 1.0888869450418352160768E28,
  62. 3.04888344611713860501504E29, 8.841761993739701954543616E30,
  63. 2.6525285981219105863630848E32, 8.22283865417792281772556288E33,
  64. 2.6313083693369353016721801216E35, 8.68331761881188649551819440128E36};
  65. #define MAXFAC 33
  66. #endif
  67. #ifdef DEC
  68. static unsigned short factbl[] = {
  69. 0040200, 0000000, 0000000, 0000000, 0040200, 0000000, 0000000, 0000000,
  70. 0040400, 0000000, 0000000, 0000000, 0040700, 0000000, 0000000, 0000000,
  71. 0041300, 0000000, 0000000, 0000000, 0041760, 0000000, 0000000, 0000000,
  72. 0042464, 0000000, 0000000, 0000000, 0043235, 0100000, 0000000, 0000000,
  73. 0044035, 0100000, 0000000, 0000000, 0044661, 0030000, 0000000, 0000000,
  74. 0045535, 0076000, 0000000, 0000000, 0046430, 0042500, 0000000, 0000000,
  75. 0047344, 0063740, 0000000, 0000000, 0050271, 0112146, 0000000, 0000000,
  76. 0051242, 0060731, 0040000, 0000000, 0052230, 0035673, 0126000, 0000000,
  77. 0053230, 0035673, 0126000, 0000000, 0054241, 0137567, 0063300, 0000000,
  78. 0055265, 0173546, 0051630, 0000000, 0056330, 0012711, 0101504, 0100000,
  79. 0057407, 0006635, 0171012, 0150000, 0060461, 0040737, 0046656, 0030400,
  80. 0061563, 0135223, 0005317, 0101540, 0062657, 0027031, 0127705, 0023155,
  81. 0064003, 0061223, 0041723, 0156322, 0065115, 0045006, 0014773, 0004410,
  82. 0066246, 0146044, 0172433, 0173526, 0067414, 0136077, 0027317, 0114261,
  83. 0070566, 0044556, 0110753, 0045465, 0071737, 0031214, 0032075, 0036050,
  84. 0073121, 0037543, 0070371, 0064146, 0074312, 0132550, 0052561, 0116443,
  85. 0075512, 0132550, 0052561, 0116443, 0076721, 0005423, 0114035, 0025014};
  86. #define MAXFAC 33
  87. #endif
  88. #ifdef IBMPC
  89. static unsigned short factbl[] = {
  90. 0x0000, 0x0000, 0x0000, 0x3ff0, 0x0000, 0x0000, 0x0000, 0x3ff0, 0x0000,
  91. 0x0000, 0x0000, 0x4000, 0x0000, 0x0000, 0x0000, 0x4018, 0x0000, 0x0000,
  92. 0x0000, 0x4038, 0x0000, 0x0000, 0x0000, 0x405e, 0x0000, 0x0000, 0x8000,
  93. 0x4086, 0x0000, 0x0000, 0xb000, 0x40b3, 0x0000, 0x0000, 0xb000, 0x40e3,
  94. 0x0000, 0x0000, 0x2600, 0x4116, 0x0000, 0x0000, 0xaf80, 0x414b, 0x0000,
  95. 0x0000, 0x08a8, 0x4183, 0x0000, 0x0000, 0x8cfc, 0x41bc, 0x0000, 0xc000,
  96. 0x328c, 0x41f7, 0x0000, 0x2800, 0x4c3b, 0x4234, 0x0000, 0x7580, 0x0777,
  97. 0x4273, 0x0000, 0x7580, 0x0777, 0x42b3, 0x0000, 0xecd8, 0x37ee, 0x42f4,
  98. 0x0000, 0xca73, 0xbeec, 0x4336, 0x9000, 0x3068, 0x02b9, 0x437b, 0x5a00,
  99. 0xbe41, 0xe1b3, 0x43c0, 0xc620, 0xe9b5, 0x283b, 0x4406, 0xf06c, 0x6159,
  100. 0x7752, 0x444e, 0xa4ce, 0x35f8, 0xe5c3, 0x4495, 0x7b9a, 0x687a, 0x6c52,
  101. 0x44e0, 0x6121, 0xc33f, 0xa940, 0x4529, 0x7eeb, 0x9ea3, 0xd984, 0x4574,
  102. 0xf316, 0xe5d9, 0x9787, 0x45c1, 0x6967, 0xd23d, 0xc92d, 0x460e, 0xa785,
  103. 0x8687, 0xe651, 0x465b, 0x2d0d, 0x6e1f, 0x27ec, 0x46aa, 0x33a4, 0x0aae,
  104. 0x56ad, 0x46f9, 0x33a4, 0x0aae, 0x56ad, 0x4749, 0xa541, 0x7303, 0x2162,
  105. 0x479a};
  106. #define MAXFAC 170
  107. #endif
  108. #ifdef MIEEE
  109. static unsigned short factbl[] = {
  110. 0x3ff0, 0x0000, 0x0000, 0x0000, 0x3ff0, 0x0000, 0x0000, 0x0000, 0x4000,
  111. 0x0000, 0x0000, 0x0000, 0x4018, 0x0000, 0x0000, 0x0000, 0x4038, 0x0000,
  112. 0x0000, 0x0000, 0x405e, 0x0000, 0x0000, 0x0000, 0x4086, 0x8000, 0x0000,
  113. 0x0000, 0x40b3, 0xb000, 0x0000, 0x0000, 0x40e3, 0xb000, 0x0000, 0x0000,
  114. 0x4116, 0x2600, 0x0000, 0x0000, 0x414b, 0xaf80, 0x0000, 0x0000, 0x4183,
  115. 0x08a8, 0x0000, 0x0000, 0x41bc, 0x8cfc, 0x0000, 0x0000, 0x41f7, 0x328c,
  116. 0xc000, 0x0000, 0x4234, 0x4c3b, 0x2800, 0x0000, 0x4273, 0x0777, 0x7580,
  117. 0x0000, 0x42b3, 0x0777, 0x7580, 0x0000, 0x42f4, 0x37ee, 0xecd8, 0x0000,
  118. 0x4336, 0xbeec, 0xca73, 0x0000, 0x437b, 0x02b9, 0x3068, 0x9000, 0x43c0,
  119. 0xe1b3, 0xbe41, 0x5a00, 0x4406, 0x283b, 0xe9b5, 0xc620, 0x444e, 0x7752,
  120. 0x6159, 0xf06c, 0x4495, 0xe5c3, 0x35f8, 0xa4ce, 0x44e0, 0x6c52, 0x687a,
  121. 0x7b9a, 0x4529, 0xa940, 0xc33f, 0x6121, 0x4574, 0xd984, 0x9ea3, 0x7eeb,
  122. 0x45c1, 0x9787, 0xe5d9, 0xf316, 0x460e, 0xc92d, 0xd23d, 0x6967, 0x465b,
  123. 0xe651, 0x8687, 0xa785, 0x46aa, 0x27ec, 0x6e1f, 0x2d0d, 0x46f9, 0x56ad,
  124. 0x0aae, 0x33a4, 0x4749, 0x56ad, 0x0aae, 0x33a4, 0x479a, 0x2162, 0x7303,
  125. 0xa541};
  126. #define MAXFAC 170
  127. #endif
  128. #ifdef ANSIPROT
  129. double gamma(double);
  130. #else
  131. double gamma();
  132. #endif
  133. extern double MAXNUM;
  134. double fac(i) int i;
  135. {
  136. double x, f, n;
  137. int j;
  138. if (i < 0) {
  139. mtherr("fac", SING);
  140. return (MAXNUM);
  141. }
  142. if (i > MAXFAC) {
  143. mtherr("fac", OVERFLOW);
  144. return (MAXNUM);
  145. }
  146. /* Get answer from table for small i. */
  147. if (i < 34) {
  148. #ifdef UNK
  149. return (factbl[i]);
  150. #else
  151. return (*(double *)(&factbl[4 * i]));
  152. #endif
  153. }
  154. /* Use gamma function for large i. */
  155. if (i > 55) {
  156. x = i + 1;
  157. return (gamma(x));
  158. }
  159. /* Compute directly for intermediate i. */
  160. n = 34.0;
  161. f = 34.0;
  162. for (j = 35; j <= i; j++) {
  163. n += 1.0;
  164. f *= n;
  165. }
  166. #ifdef UNK
  167. f *= factbl[33];
  168. #else
  169. f *= *(double *)(&factbl[4 * 33]);
  170. #endif
  171. return (f);
  172. }