/* returns ceil(log(d)/log(2)) if d > 0,
-1023 if d = +0,
and floor(log(-d)/log(2))+1 if d < 0*/
long
__gmpfr_ceil_log2 (double d)
{
long exp;
#if _GMP_IEEE_FLOATS
union ieee_double_extract x;
x.d = d;
exp = x.s.exp - 1023;
x.s.exp = 1023; /* value for 1 <= d < 2 */
if (x.d != 1.0) /* d: not a power of two? */
exp++;
return exp;
#else
double m;
if (d < 0.0)
return __gmpfr_floor_log2(-d)+1;
else if (d == 0.0)
return -1023;
else if (d >= 1.0)
{
exp = 0;
for( m= 1.0 ; m < d ; m *=2.0 )
exp++;
}
else
{
exp = 1;
for( m= 1.0 ; m >= d ; m *= (1.0/2.0) )
exp--;
}
#endif
return exp;
}
static void
tcmp2 (double x, double y, int i)
{
mpfr_t xx, yy;
mp_prec_t j;
if (i == -1)
{
if (x == y)
i = 53;
else
i = (int) (__gmpfr_floor_log2 (x) - __gmpfr_floor_log2 (x - y));
}
mpfr_init2(xx, 53); mpfr_init2(yy, 53);
mpfr_set_d (xx, x, GMP_RNDN);
mpfr_set_d (yy, y, GMP_RNDN);
j = 0;
if (mpfr_cmp2 (xx, yy, &j) == 0)
{
if (x != y)
{
printf ("Error in mpfr_cmp2 for\nx=");
mpfr_out_str (stdout, 2, 0, xx, GMP_RNDN);
printf ("\ny=");
mpfr_out_str (stdout, 2, 0, yy, GMP_RNDN);
printf ("\ngot sign 0 for x != y\n");
exit (1);
}
}
else if (j != (unsigned) i)
{
printf ("Error in mpfr_cmp2 for\nx=");
mpfr_out_str (stdout, 2, 0, xx, GMP_RNDN);
printf ("\ny=");
mpfr_out_str (stdout, 2, 0, yy, GMP_RNDN);
printf ("\ngot %lu instead of %d\n", j, i);
exit (1);
}
mpfr_clear(xx); mpfr_clear(yy);
}
/* returns ceil(log(d)/log(2)) if d > 0,
-1023 if d = +0,
and floor(log(-d)/log(2))+1 if d < 0
*/
long
__gmpfr_ceil_log2 (double d)
{
long exp;
#if _MPFR_IEEE_FLOATS
union mpfr_ieee_double_extract x;
x.d = d;
/* The cast below is useless in theory, but let us not depend on the
integer promotion rules (for instance, tcc is currently wrong). */
exp = (long) x.s.exp - 1023;
MPFR_ASSERTN (exp < 1023); /* fail on infinities */
x.s.exp = 1023; /* value for 1 <= d < 2 */
if (x.d != 1.0) /* d: not a power of two? */
exp++;
return exp;
#else /* _MPFR_IEEE_FLOATS */
double m;
if (d < 0.0)
return __gmpfr_floor_log2 (-d) + 1;
else if (d == 0.0)
return -1023;
else if (d >= 1.0)
{
exp = 0;
for (m = 1.0; m < d; m *= 2.0)
exp++;
}
else
{
exp = 1;
for (m = 1.0; m >= d; m *= 0.5)
exp--;
}
#endif /* _MPFR_IEEE_FLOATS */
return exp;
}
/* Input: s - a floating-point number >= 1/2.
rnd_mode - a rounding mode.
Assumes s is neither NaN nor Infinite.
Output: z - Zeta(s) rounded to the precision of z with direction rnd_mode
*/
static int
mpfr_zeta_pos (mpfr_t z, mpfr_srcptr s, mp_rnd_t rnd_mode)
{
mpfr_t b, c, z_pre, f, s1;
double beta, sd, dnep;
mpfr_t *tc1;
mp_prec_t precz, precs, d, dint;
int p, n, l, add;
int inex;
MPFR_GROUP_DECL (group);
MPFR_ZIV_DECL (loop);
MPFR_ASSERTD (MPFR_IS_POS (s) && MPFR_GET_EXP (s) >= 0);
precz = MPFR_PREC (z);
precs = MPFR_PREC (s);
/* Zeta(x) = 1+1/2^x+1/3^x+1/4^x+1/5^x+O(1/6^x)
so with 2^(EXP(x)-1) <= x < 2^EXP(x)
So for x > 2^3, k^x > k^8, so 2/k^x < 2/k^8
Zeta(x) = 1 + 1/2^x*(1+(2/3)^x+(2/4)^x+...)
= 1 + 1/2^x*(1+sum((2/k)^x,k=3..infinity))
<= 1 + 1/2^x*(1+sum((2/k)^8,k=3..infinity))
And sum((2/k)^8,k=3..infinity) = -257+128*Pi^8/4725 ~= 0.0438035
So Zeta(x) <= 1 + 1/2^x*2 for x >= 8
The error is < 2^(-x+1) <= 2^(-2^(EXP(x)-1)+1) */
if (MPFR_GET_EXP (s) > 3)
{
mp_exp_t err;
err = MPFR_GET_EXP (s) - 1;
if (err > (mp_exp_t) (sizeof (mp_exp_t)*CHAR_BIT-2))
err = MPFR_EMAX_MAX;
else
err = ((mp_exp_t)1) << err;
err = 1 - (-err+1); /* GET_EXP(one) - (-err+1) = err :) */
MPFR_FAST_COMPUTE_IF_SMALL_INPUT (z, __gmpfr_one, err, 0, 1,
rnd_mode, {});
}
d = precz + MPFR_INT_CEIL_LOG2(precz) + 10;
/* we want that s1 = s-1 is exact, i.e. we should have PREC(s1) >= EXP(s) */
dint = (mpfr_uexp_t) MPFR_GET_EXP (s);
mpfr_init2 (s1, MAX (precs, dint));
inex = mpfr_sub (s1, s, __gmpfr_one, GMP_RNDN);
MPFR_ASSERTD (inex == 0);
/* case s=1 */
if (MPFR_IS_ZERO (s1))
{
MPFR_SET_INF (z);
MPFR_SET_POS (z);
MPFR_ASSERTD (inex == 0);
goto clear_and_return;
}
MPFR_GROUP_INIT_4 (group, MPFR_PREC_MIN, b, c, z_pre, f);
MPFR_ZIV_INIT (loop, d);
for (;;)
{
/* Principal loop: we compute, in z_pre,
an approximation of Zeta(s), that we send to can_round */
if (MPFR_GET_EXP (s1) <= -(mp_exp_t) ((mpfr_prec_t) (d-3)/2))
/* Branch 1: when s-1 is very small, one
uses the approximation Zeta(s)=1/(s-1)+gamma,
where gamma is Euler's constant */
{
dint = MAX (d + 3, precs);
MPFR_TRACE (printf ("branch 1\ninternal precision=%d\n", dint));
MPFR_GROUP_REPREC_4 (group, dint, b, c, z_pre, f);
mpfr_div (z_pre, __gmpfr_one, s1, GMP_RNDN);
mpfr_const_euler (f, GMP_RNDN);
mpfr_add (z_pre, z_pre, f, GMP_RNDN);
}
else /* Branch 2 */
{
size_t size;
MPFR_TRACE (printf ("branch 2\n"));
/* Computation of parameters n, p and working precision */
dnep = (double) d * LOG2;
sd = mpfr_get_d (s, GMP_RNDN);
/* beta = dnep + 0.61 + sd * log (6.2832 / sd);
but a larger value is ok */
#define LOG6dot2832 1.83787940484160805532
beta = dnep + 0.61 + sd * (LOG6dot2832 - LOG2 *
__gmpfr_floor_log2 (sd));
if (beta <= 0.0)
{
p = 0;
/* n = 1 + (int) (exp ((dnep - LOG2) / sd)); */
n = 1 + (int) __gmpfr_ceil_exp2 ((d - 1.0) / sd);
}
else
{
p = 1 + (int) beta / 2;
n = 1 + (int) ((sd + 2.0 * (double) p - 1.0) / 6.2832);
}
MPFR_TRACE (printf ("\nn=%d\np=%d\n",n,p));
/* add = 4 + floor(1.5 * log(d) / log (2)).
We should have add >= 10, which is always fulfilled since
d = precz + 11 >= 12, thus ceil(log2(d)) >= 4 */
add = 4 + (3 * MPFR_INT_CEIL_LOG2 (d)) / 2;
MPFR_ASSERTD(add >= 10);
dint = d + add;
if (dint < precs)
dint = precs;
MPFR_TRACE (printf("internal precision=%d\n",dint));
size = (p + 1) * sizeof(mpfr_t);
tc1 = (mpfr_t*) (*__gmp_allocate_func) (size);
for (l=1; l<=p; l++)
mpfr_init2 (tc1[l], dint);
MPFR_GROUP_REPREC_4 (group, dint, b, c, z_pre, f);
MPFR_TRACE (printf ("precision of z =%d\n", precz));
/* Computation of the coefficients c_k */
mpfr_zeta_c (p, tc1);
/* Computation of the 3 parts of the fonction Zeta. */
mpfr_zeta_part_a (z_pre, s, n);
mpfr_zeta_part_b (b, s, n, p, tc1);
/* s1 = s-1 is already computed above */
mpfr_div (c, __gmpfr_one, s1, GMP_RNDN);
mpfr_ui_pow (f, n, s1, GMP_RNDN);
mpfr_div (c, c, f, GMP_RNDN);
MPFR_TRACE (MPFR_DUMP (c));
mpfr_add (z_pre, z_pre, c, GMP_RNDN);
mpfr_add (z_pre, z_pre, b, GMP_RNDN);
for (l=1; l<=p; l++)
mpfr_clear (tc1[l]);
(*__gmp_free_func) (tc1, size);
/* End branch 2 */
}
MPFR_TRACE (MPFR_DUMP (z_pre));
if (MPFR_LIKELY (MPFR_CAN_ROUND (z_pre, d-3, precz, rnd_mode)))
break;
MPFR_ZIV_NEXT (loop, d);
}
MPFR_ZIV_FREE (loop);
inex = mpfr_set (z, z_pre, rnd_mode);
MPFR_GROUP_CLEAR (group);
clear_and_return:
mpfr_clear (s1);
return inex;
}