zetacf.c 5.2 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266
  1. /* zetacf.c
  2. *
  3. * Riemann zeta function
  4. *
  5. *
  6. *
  7. * SYNOPSIS:
  8. *
  9. * float x, y, zetacf();
  10. *
  11. * y = zetacf( x );
  12. *
  13. *
  14. *
  15. * DESCRIPTION:
  16. *
  17. *
  18. *
  19. * inf.
  20. * - -x
  21. * zetac(x) = > k , x > 1,
  22. * -
  23. * k=2
  24. *
  25. * is related to the Riemann zeta function by
  26. *
  27. * Riemann zeta(x) = zetac(x) + 1.
  28. *
  29. * Extension of the function definition for x < 1 is implemented.
  30. * Zero is returned for x > log2(MAXNUM).
  31. *
  32. * An overflow error may occur for large negative x, due to the
  33. * gamma function in the reflection formula.
  34. *
  35. * ACCURACY:
  36. *
  37. * Tabulated values have full machine accuracy.
  38. *
  39. * Relative error:
  40. * arithmetic domain # trials peak rms
  41. * IEEE 1,50 30000 5.5e-7 7.5e-8
  42. *
  43. *
  44. */
  45. /*
  46. Cephes Math Library Release 2.2: July, 1992
  47. Copyright 1984, 1987, 1989, 1992 by Stephen L. Moshier
  48. Direct inquiries to 30 Frost Street, Cambridge, MA 02140
  49. */
  50. #include <math.h>
  51. /* Riemann zeta(x) - 1
  52. * for integer arguments between 0 and 30.
  53. */
  54. static float azetacf[] = {
  55. -1.50000000000000000000E0,
  56. 1.70141183460469231730E38, /* infinity. */
  57. 6.44934066848226436472E-1,
  58. 2.02056903159594285400E-1,
  59. 8.23232337111381915160E-2,
  60. 3.69277551433699263314E-2,
  61. 1.73430619844491397145E-2,
  62. 8.34927738192282683980E-3,
  63. 4.07735619794433937869E-3,
  64. 2.00839282608221441785E-3,
  65. 9.94575127818085337146E-4,
  66. 4.94188604119464558702E-4,
  67. 2.46086553308048298638E-4,
  68. 1.22713347578489146752E-4,
  69. 6.12481350587048292585E-5,
  70. 3.05882363070204935517E-5,
  71. 1.52822594086518717326E-5,
  72. 7.63719763789976227360E-6,
  73. 3.81729326499983985646E-6,
  74. 1.90821271655393892566E-6,
  75. 9.53962033872796113152E-7,
  76. 4.76932986787806463117E-7,
  77. 2.38450502727732990004E-7,
  78. 1.19219925965311073068E-7,
  79. 5.96081890512594796124E-8,
  80. 2.98035035146522801861E-8,
  81. 1.49015548283650412347E-8,
  82. 7.45071178983542949198E-9,
  83. 3.72533402478845705482E-9,
  84. 1.86265972351304900640E-9,
  85. 9.31327432419668182872E-10
  86. };
  87. /* 2**x (1 - 1/x) (zeta(x) - 1) = P(1/x)/Q(1/x), 1 <= x <= 10 */
  88. static float P[9] = {
  89. 5.85746514569725319540E11,
  90. 2.57534127756102572888E11,
  91. 4.87781159567948256438E10,
  92. 5.15399538023885770696E9,
  93. 3.41646073514754094281E8,
  94. 1.60837006880656492731E7,
  95. 5.92785467342109522998E5,
  96. 1.51129169964938823117E4,
  97. 2.01822444485997955865E2,
  98. };
  99. static float Q[8] = {
  100. /* 1.00000000000000000000E0,*/
  101. 3.90497676373371157516E11,
  102. 5.22858235368272161797E10,
  103. 5.64451517271280543351E9,
  104. 3.39006746015350418834E8,
  105. 1.79410371500126453702E7,
  106. 5.66666825131384797029E5,
  107. 1.60382976810944131506E4,
  108. 1.96436237223387314144E2,
  109. };
  110. /* log(zeta(x) - 1 - 2**-x), 10 <= x <= 50 */
  111. static float A[11] = {
  112. 8.70728567484590192539E6,
  113. 1.76506865670346462757E8,
  114. 2.60889506707483264896E10,
  115. 5.29806374009894791647E11,
  116. 2.26888156119238241487E13,
  117. 3.31884402932705083599E14,
  118. 5.13778997975868230192E15,
  119. -1.98123688133907171455E15,
  120. -9.92763810039983572356E16,
  121. 7.82905376180870586444E16,
  122. 9.26786275768927717187E16,
  123. };
  124. static float B[10] = {
  125. /* 1.00000000000000000000E0,*/
  126. -7.92625410563741062861E6,
  127. -1.60529969932920229676E8,
  128. -2.37669260975543221788E10,
  129. -4.80319584350455169857E11,
  130. -2.07820961754173320170E13,
  131. -2.96075404507272223680E14,
  132. -4.86299103694609136686E15,
  133. 5.34589509675789930199E15,
  134. 5.71464111092297631292E16,
  135. -1.79915597658676556828E16,
  136. };
  137. /* (1-x) (zeta(x) - 1), 0 <= x <= 1 */
  138. static float R[6] = {
  139. -3.28717474506562731748E-1,
  140. 1.55162528742623950834E1,
  141. -2.48762831680821954401E2,
  142. 1.01050368053237678329E3,
  143. 1.26726061410235149405E4,
  144. -1.11578094770515181334E5,
  145. };
  146. static float S[5] = {
  147. /* 1.00000000000000000000E0,*/
  148. 1.95107674914060531512E1,
  149. 3.17710311750646984099E2,
  150. 3.03835500874445748734E3,
  151. 2.03665876435770579345E4,
  152. 7.43853965136767874343E4,
  153. };
  154. #define MAXL2 127
  155. /*
  156. * Riemann zeta function, minus one
  157. */
  158. extern float MACHEPF, PIO2F, MAXNUMF, PIF;
  159. #ifdef ANSIC
  160. extern float sinf ( float xx );
  161. extern float floorf ( float x );
  162. extern float gammaf ( float xx );
  163. extern float powf ( float x, float y );
  164. extern float expf ( float xx );
  165. extern float polevlf ( float xx, float *coef, int N );
  166. extern float p1evlf ( float xx, float *coef, int N );
  167. #else
  168. float sinf(), floorf(), gammaf(), powf(), expf();
  169. float polevlf(), p1evlf();
  170. #endif
  171. float zetacf(float xx)
  172. {
  173. int i;
  174. float x, a, b, s, w;
  175. x = xx;
  176. if( x < 0.0 )
  177. {
  178. if( x < -30.8148 )
  179. {
  180. mtherr( "zetacf", OVERFLOW );
  181. return(0.0);
  182. }
  183. s = 1.0 - x;
  184. w = zetacf( s );
  185. b = sinf(PIO2F*x) * powf(2.0*PIF, x) * gammaf(s) * (1.0 + w) / PIF;
  186. return(b - 1.0);
  187. }
  188. if( x >= MAXL2 )
  189. return(0.0); /* because first term is 2**-x */
  190. /* Tabulated values for integer argument */
  191. w = floorf(x);
  192. if( w == x )
  193. {
  194. i = x;
  195. if( i < 31 )
  196. {
  197. return( azetacf[i] );
  198. }
  199. }
  200. if( x < 1.0 )
  201. {
  202. w = 1.0 - x;
  203. a = polevlf( x, R, 5 ) / ( w * p1evlf( x, S, 5 ));
  204. return( a );
  205. }
  206. if( x == 1.0 )
  207. {
  208. mtherr( "zetacf", SING );
  209. return( MAXNUMF );
  210. }
  211. if( x <= 10.0 )
  212. {
  213. b = powf( 2.0, x ) * (x - 1.0);
  214. w = 1.0/x;
  215. s = (x * polevlf( w, P, 8 )) / (b * p1evlf( w, Q, 8 ));
  216. return( s );
  217. }
  218. if( x <= 50.0 )
  219. {
  220. b = powf( 2.0, -x );
  221. w = polevlf( x, A, 10 ) / p1evlf( x, B, 10 );
  222. w = expf(w) + b;
  223. return(w);
  224. }
  225. /* Basic sum of inverse powers */
  226. s = 0.0;
  227. a = 1.0;
  228. do
  229. {
  230. a += 2.0;
  231. b = powf( a, -x );
  232. s += b;
  233. }
  234. while( b/s > MACHEPF );
  235. b = powf( 2.0, -x );
  236. s = (s + b)/(1.0-b);
  237. return(s);
  238. }