zeta.c 3.5 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180
  1. /* zeta.c
  2. *
  3. * Riemann zeta function of two arguments
  4. *
  5. *
  6. *
  7. * SYNOPSIS:
  8. *
  9. * double x, q, y, zeta();
  10. *
  11. * y = zeta( x, q );
  12. *
  13. *
  14. *
  15. * DESCRIPTION:
  16. *
  17. *
  18. *
  19. * inf.
  20. * - -x
  21. * zeta(x,q) = > (k+q)
  22. * -
  23. * k=0
  24. *
  25. * where x > 1 and q is not a negative integer or zero.
  26. * The Euler-Maclaurin summation formula is used to obtain
  27. * the expansion
  28. *
  29. * n
  30. * - -x
  31. * zeta(x,q) = > (k+q)
  32. * -
  33. * k=1
  34. *
  35. * 1-x inf. B x(x+1)...(x+2j)
  36. * (n+q) 1 - 2j
  37. * + --------- - ------- + > --------------------
  38. * x-1 x - x+2j+1
  39. * 2(n+q) j=1 (2j)! (n+q)
  40. *
  41. * where the B2j are Bernoulli numbers. Note that (see zetac.c)
  42. * zeta(x,1) = zetac(x) + 1.
  43. *
  44. *
  45. *
  46. * ACCURACY:
  47. *
  48. *
  49. *
  50. * REFERENCE:
  51. *
  52. * Gradshteyn, I. S., and I. M. Ryzhik, Tables of Integrals,
  53. * Series, and Products, p. 1073; Academic Press, 1980.
  54. *
  55. */
  56. /*
  57. Cephes Math Library Release 2.8: June, 2000
  58. Copyright 1984, 1987, 2000 by Stephen L. Moshier
  59. */
  60. #include "mconf.h"
  61. #ifdef ANSIPROT
  62. extern double fabs(double);
  63. extern double pow(double, double);
  64. extern double floor(double);
  65. #else
  66. double fabs(), pow(), floor();
  67. #endif
  68. extern double MAXNUM, MACHEP;
  69. /* Expansion coefficients
  70. * for Euler-Maclaurin summation formula
  71. * (2k)! / B2k
  72. * where B2k are Bernoulli numbers
  73. */
  74. static double A[] = {
  75. 12.0,
  76. -720.0,
  77. 30240.0,
  78. -1209600.0,
  79. 47900160.0,
  80. -1.8924375803183791606e9, /*1.307674368e12/691*/
  81. 7.47242496e10,
  82. -2.950130727918164224e12, /*1.067062284288e16/3617*/
  83. 1.1646782814350067249e14, /*5.109094217170944e18/43867*/
  84. -4.5979787224074726105e15, /*8.028576626982912e20/174611*/
  85. 1.8152105401943546773e17, /*1.5511210043330985984e23/854513*/
  86. -7.1661652561756670113e18 /*1.6938241367317436694528e27/236364091*/
  87. };
  88. /* 30 Nov 86 -- error in third coefficient fixed */
  89. double zeta(x, q) double x, q;
  90. {
  91. int i;
  92. double a, b, k, s, t, w;
  93. if (x == 1.0)
  94. goto retinf;
  95. if (x < 1.0) {
  96. domerr:
  97. mtherr("zeta", DOMAIN);
  98. return (0.0);
  99. }
  100. if (q <= 0.0) {
  101. if (q == floor(q)) {
  102. mtherr("zeta", SING);
  103. retinf:
  104. return (MAXNUM);
  105. }
  106. if (x != floor(x))
  107. goto domerr; /* because q^-x not defined */
  108. }
  109. /* Euler-Maclaurin summation formula */
  110. /*
  111. if( x < 25.0 )
  112. */
  113. {
  114. /* Permit negative q but continue sum until n+q > +9 .
  115. * This case should be handled by a reflection formula.
  116. * If q<0 and x is an integer, there is a relation to
  117. * the polygamma function.
  118. */
  119. s = pow(q, -x);
  120. a = q;
  121. i = 0;
  122. b = 0.0;
  123. while ((i < 9) || (a <= 9.0)) {
  124. i += 1;
  125. a += 1.0;
  126. b = pow(a, -x);
  127. s += b;
  128. if (fabs(b / s) < MACHEP)
  129. goto done;
  130. }
  131. w = a;
  132. s += b * w / (x - 1.0);
  133. s -= 0.5 * b;
  134. a = 1.0;
  135. k = 0.0;
  136. for (i = 0; i < 12; i++) {
  137. a *= x + k;
  138. b /= w;
  139. t = a * b / A[i];
  140. s = s + t;
  141. t = fabs(t / s);
  142. if (t < MACHEP)
  143. goto done;
  144. k += 1.0;
  145. a *= x + k;
  146. b /= w;
  147. k += 1.0;
  148. }
  149. done:
  150. return (s);
  151. }
  152. /* Basic sum of inverse powers */
  153. /*
  154. pseres:
  155. s = pow( q, -x );
  156. a = q;
  157. do
  158. {
  159. a += 2.0;
  160. b = pow( a, -x );
  161. s += b;
  162. }
  163. while( b/s > MACHEP );
  164. b = pow( 2.0, -x );
  165. s = (s + b)/(1.0-b);
  166. return(s);
  167. */
  168. }