/winsup/mingw/mingwex/math/tgammaf.c

https://github.com/scottt/cygwin-vmci-sockets · C · 265 lines · 172 code · 26 blank · 67 comment · 27 complexity · e4542bea22092fb2d1a28ea080146217 MD5 · raw file

  1. /* gammaf.c
  2. *
  3. * Gamma function
  4. *
  5. *
  6. *
  7. * SYNOPSIS:
  8. *
  9. * float x, y, __tgammaf_r();
  10. * int* sgngamf;
  11. * y = __tgammaf_r( x, sgngamf );
  12. *
  13. * float x, y, tgammaf();
  14. * y = tgammaf( x);
  15. *
  16. *
  17. * DESCRIPTION:
  18. *
  19. * Returns gamma function of the argument. The result is
  20. * correctly signed. In the reentrant version the sign (+1 or -1)
  21. * is returned in the variable referenced by sgngamf.
  22. *
  23. * Arguments between 0 and 10 are reduced by recurrence and the
  24. * function is approximated by a polynomial function covering
  25. * the interval (2,3). Large arguments are handled by Stirling's
  26. * formula. Negative arguments are made positive using
  27. * a reflection formula.
  28. *
  29. *
  30. * ACCURACY:
  31. *
  32. * Relative error:
  33. * arithmetic domain # trials peak rms
  34. * IEEE 0,-33 100,000 5.7e-7 1.0e-7
  35. * IEEE -33,0 100,000 6.1e-7 1.2e-7
  36. *
  37. *
  38. */
  39. /*
  40. Cephes Math Library Release 2.7: July, 1998
  41. Copyright 1984, 1987, 1989, 1992, 1998 by Stephen L. Moshier
  42. */
  43. /*
  44. * 26-11-2002 Modified for mingw.
  45. * Danny Smith <dannysmith@users.sourceforge.net>
  46. */
  47. #ifndef __MINGW32__
  48. #include "mconf.h"
  49. #else
  50. #include "cephes_mconf.h"
  51. #endif
  52. /* define MAXGAM 34.84425627277176174 */
  53. /* Stirling's formula for the gamma function
  54. * gamma(x) = sqrt(2 pi) x^(x-.5) exp(-x) ( 1 + 1/x P(1/x) )
  55. * .028 < 1/x < .1
  56. * relative error < 1.9e-11
  57. */
  58. static const float STIR[] = {
  59. -2.705194986674176E-003,
  60. 3.473255786154910E-003,
  61. 8.333331788340907E-002,
  62. };
  63. static const float MAXSTIR = 26.77;
  64. static const float SQTPIF = 2.50662827463100050242; /* sqrt( 2 pi ) */
  65. #ifndef __MINGW32__
  66. extern float MAXLOGF, MAXNUMF, PIF;
  67. #ifdef ANSIC
  68. float expf(float);
  69. float logf(float);
  70. float powf( float, float );
  71. float sinf(float);
  72. float gammaf(float);
  73. float floorf(float);
  74. static float stirf(float);
  75. float polevlf( float, float *, int );
  76. float p1evlf( float, float *, int );
  77. #else
  78. float expf(), logf(), powf(), sinf(), floorf();
  79. float polevlf(), p1evlf();
  80. static float stirf();
  81. #endif
  82. #else /* __MINGW32__ */
  83. static float stirf(float);
  84. #endif
  85. /* Gamma function computed by Stirling's formula,
  86. * sqrt(2 pi) x^(x-.5) exp(-x) (1 + 1/x P(1/x))
  87. * The polynomial STIR is valid for 33 <= x <= 172.
  88. */
  89. static float stirf( float x )
  90. {
  91. float y, w, v;
  92. w = 1.0/x;
  93. w = 1.0 + w * polevlf( w, STIR, 2 );
  94. y = expf( -x );
  95. if( x > MAXSTIR )
  96. { /* Avoid overflow in pow() */
  97. v = powf( x, 0.5 * x - 0.25 );
  98. y *= v;
  99. y *= v;
  100. }
  101. else
  102. {
  103. y = powf( x, x - 0.5 ) * y;
  104. }
  105. y = SQTPIF * y * w;
  106. return( y );
  107. }
  108. /* gamma(x+2), 0 < x < 1 */
  109. static const float P[] = {
  110. 1.536830450601906E-003,
  111. 5.397581592950993E-003,
  112. 4.130370201859976E-003,
  113. 7.232307985516519E-002,
  114. 8.203960091619193E-002,
  115. 4.117857447645796E-001,
  116. 4.227867745131584E-001,
  117. 9.999999822945073E-001,
  118. };
  119. float __tgammaf_r( float x, int* sgngamf)
  120. {
  121. float p, q, z, nz;
  122. int i, direction, negative;
  123. #ifdef NANS
  124. if( isnan(x) )
  125. return(x);
  126. #endif
  127. #ifdef INFINITIES
  128. #ifdef NANS
  129. if( x == INFINITYF )
  130. return(x);
  131. if( x == -INFINITYF )
  132. return(NANF);
  133. #else
  134. if( !isfinite(x) )
  135. return(x);
  136. #endif
  137. #endif
  138. *sgngamf = 1;
  139. negative = 0;
  140. nz = 0.0;
  141. if( x < 0.0 )
  142. {
  143. negative = 1;
  144. q = -x;
  145. p = floorf(q);
  146. if( p == q )
  147. {
  148. gsing:
  149. _SET_ERRNO(EDOM);
  150. mtherr( "tgammaf", SING );
  151. #ifdef INFINITIES
  152. return (INFINITYF);
  153. #else
  154. return (MAXNUMF);
  155. #endif
  156. }
  157. i = p;
  158. if( (i & 1) == 0 )
  159. *sgngamf = -1;
  160. nz = q - p;
  161. if( nz > 0.5 )
  162. {
  163. p += 1.0;
  164. nz = q - p;
  165. }
  166. nz = q * sinf( PIF * nz );
  167. if( nz == 0.0 )
  168. {
  169. _SET_ERRNO(ERANGE);
  170. mtherr( "tgamma", OVERFLOW );
  171. #ifdef INFINITIES
  172. return( *sgngamf * INFINITYF);
  173. #else
  174. return( *sgngamf * MAXNUMF);
  175. #endif
  176. }
  177. if( nz < 0 )
  178. nz = -nz;
  179. x = q;
  180. }
  181. if( x >= 10.0 )
  182. {
  183. z = stirf(x);
  184. }
  185. if( x < 2.0 )
  186. direction = 1;
  187. else
  188. direction = 0;
  189. z = 1.0;
  190. while( x >= 3.0 )
  191. {
  192. x -= 1.0;
  193. z *= x;
  194. }
  195. /*
  196. while( x < 0.0 )
  197. {
  198. if( x > -1.E-4 )
  199. goto Small;
  200. z *=x;
  201. x += 1.0;
  202. }
  203. */
  204. while( x < 2.0 )
  205. {
  206. if( x < 1.e-4 )
  207. goto Small;
  208. z *=x;
  209. x += 1.0;
  210. }
  211. if( direction )
  212. z = 1.0/z;
  213. if( x == 2.0 )
  214. return(z);
  215. x -= 2.0;
  216. p = z * polevlf( x, P, 7 );
  217. gdone:
  218. if( negative )
  219. {
  220. p = *sgngamf * PIF/(nz * p );
  221. }
  222. return(p);
  223. Small:
  224. if( x == 0.0 )
  225. {
  226. goto gsing;
  227. }
  228. else
  229. {
  230. p = z / ((1.0 + 0.5772156649015329 * x) * x);
  231. goto gdone;
  232. }
  233. }
  234. /* This is the C99 version */
  235. float tgammaf(float x)
  236. {
  237. int local_sgngamf=0;
  238. return (__tgammaf_r(x, &local_sgngamf));
  239. }