Viewing file:  zeta.c (24.49 KB) -rw-r--r--
Select action/file-type:
 (+) |  (+) |  (+) | Code (+) | Session (+) |  (+) | SDB (+) |  (+) |  (+) |  (+) |  (+) |  (+) |
/* mpfr_zeta -- compute the Riemann Zeta function
Copyright 2003-2020 Free Software Foundation, Inc.
Contributed by the AriC and Caramba projects, INRIA.
This file is part of the GNU MPFR Library.
The GNU MPFR Library is free software; you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
the Free Software Foundation; either version 3 of the License, or (at your
option) any later version.
The GNU MPFR Library is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public
License for more details.
You should have received a copy of the GNU Lesser General Public License
along with the GNU MPFR Library; see the file COPYING.LESSER. If not, see
https://www.gnu.org/licenses/ or write to the Free Software Foundation, Inc.,
51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. */
#include <float.h> /* for DBL_MAX */
#define MPFR_NEED_LONGLONG_H
#include "mpfr-impl.h"
/*
Parameters:
s - the input floating-point number
n, p - parameters from the algorithm
tc - an array of p floating-point numbers tc[1]..tc[p]
Output:
b is the result, i.e.
sum(tc[i]*product((s+2j)*(s+2j-1)/n^2,j=1..i-1), i=1..p)*s*n^(-s-1)
*/
static void
mpfr_zeta_part_b (mpfr_t b, mpfr_srcptr s, int n, int p, mpfr_t *tc)
{
mpfr_t s1, d, u;
unsigned long n2;
int l, t;
MPFR_GROUP_DECL (group);
if (p == 0)
{
MPFR_SET_ZERO (b);
MPFR_SET_POS (b);
return;
}
n2 = n * n;
MPFR_GROUP_INIT_3 (group, MPFR_PREC (b), s1, d, u);
/* t equals 2p-2, 2p-3, ... ; s1 equals s+t */
t = 2 * p - 2;
mpfr_set (d, tc[p], MPFR_RNDN);
for (l = 1; l < p; l++)
{
mpfr_add_ui (s1, s, t, MPFR_RNDN); /* s + (2p-2l) */
mpfr_mul (d, d, s1, MPFR_RNDN);
t = t - 1;
mpfr_add_ui (s1, s, t, MPFR_RNDN); /* s + (2p-2l-1) */
mpfr_mul (d, d, s1, MPFR_RNDN);
t = t - 1;
mpfr_div_ui (d, d, n2, MPFR_RNDN);
mpfr_add (d, d, tc[p-l], MPFR_RNDN);
/* since s is positive and the tc[i] have alternate signs,
the following is unlikely */
if (MPFR_UNLIKELY (mpfr_cmpabs (d, tc[p-l]) > 0))
mpfr_set (d, tc[p-l], MPFR_RNDN);
}
mpfr_mul (d, d, s, MPFR_RNDN);
mpfr_add (s1, s, __gmpfr_one, MPFR_RNDN);
mpfr_neg (s1, s1, MPFR_RNDN);
mpfr_ui_pow (u, n, s1, MPFR_RNDN);
mpfr_mul (b, d, u, MPFR_RNDN);
MPFR_GROUP_CLEAR (group);
}
/* Input: p - an integer
Output: fills tc[1..p], tc[i] = bernoulli(2i)/(2i)!
tc[1]=1/12, tc[2]=-1/720, tc[3]=1/30240, ...
Assumes all the tc[i] have the same precision.
Uses the recurrence (4.60) from the book "Modern Computer Arithmetic"
by Brent and Zimmermann for C_k = bernoulli(2k)/(2k)!:
sum(C_k/(2k+1-2j)!/4^(k-j), j=0..k) = 1/(2k)!/4^k
If we put together the terms involving C_0 and C_1 we get:
sum(D_k/(2k+1-2j)!/4^(k-j), j=1..k) = 0
with D_1 = C_0/4/(2k+1)/(2k)+C_1-1/(2k)/4=(k-1)/(12k+6),
and D_k = C_k for k >= 2.
FIXME: we have C_k = (-1)^(k-1) 2/(2pi)^(2k) * zeta(2k),
see for example formula (4.65) from the above book,
thus since |zeta(2k)-1| < 2^(1-2k) for k >= 2, we have:
|C_k - E_k| < E_k * 2^(1-2k) for k >= 2 and E_k := (-1)^(k-1) 2/(2pi)^(2k).
Then if 2k-1 >= prec we can evaluate E_k instead, which only requires one
multiplication per term, instead of O(k) small divisions.
*/
static void
mpfr_zeta_c (int p, mpfr_t *tc)
{
if (p > 0)
{
mpfr_t d;
int k, l;
mpfr_prec_t prec = MPFR_PREC (tc[1]);
mpfr_init2 (d, prec);
mpfr_div_ui (tc[1], __gmpfr_one, 12, MPFR_RNDN);
for (k = 2; k <= p; k++)
{
mpfr_set_ui (d, k-1, MPFR_RNDN);
mpfr_div_ui (d, d, 12*k+6, MPFR_RNDN);
for (l=2; l < k; l++)
{
mpfr_div_ui (d, d, 4*(2*k-2*l+3)*(2*k-2*l+2), MPFR_RNDN);
mpfr_add (d, d, tc[l], MPFR_RNDN);
}
mpfr_div_ui (tc[k], d, 24, MPFR_RNDN);
MPFR_CHANGE_SIGN (tc[k]);
}
mpfr_clear (d);
}
}
/* Input: s - a floating-point number
n - an integer
Output: sum - a floating-point number approximating sum(1/i^s, i=1..n-1) */
static void
mpfr_zeta_part_a (mpfr_t sum, mpfr_srcptr s, int n)
{
mpfr_t u, s1;
int i;
MPFR_GROUP_DECL (group);
MPFR_GROUP_INIT_2 (group, MPFR_PREC (sum), u, s1);
mpfr_neg (s1, s, MPFR_RNDN);
mpfr_ui_pow (u, n, s1, MPFR_RNDN);
mpfr_div_2ui (u, u, 1, MPFR_RNDN);
mpfr_set (sum, u, MPFR_RNDN);
for (i=n-1; i>1; i--)
{
mpfr_ui_pow (u, i, s1, MPFR_RNDN);
mpfr_add (sum, sum, u, MPFR_RNDN);
}
mpfr_add (sum, sum, __gmpfr_one, MPFR_RNDN);
MPFR_GROUP_CLEAR (group);
}
/* 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, mpfr_rnd_t rnd_mode)
{
mpfr_t b, c, z_pre, f, s1;
double beta, sd, dnep;
mpfr_t *tc1;
mpfr_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)
{
mpfr_exp_t err;
err = MPFR_GET_EXP (s) - 1;
if (err > (mpfr_exp_t) (sizeof (mpfr_exp_t)*CHAR_BIT-2))
err = MPFR_EMAX_MAX;
else
err = ((mpfr_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, MPFR_RNDN);
MPFR_ASSERTD (inex == 0);
/* case s=1 should have already been handled */
MPFR_ASSERTD (!MPFR_IS_ZERO (s1));
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) <= -(mpfr_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);
/* branch 1, with internal precision dint */
MPFR_GROUP_REPREC_4 (group, dint, b, c, z_pre, f);
mpfr_div (z_pre, __gmpfr_one, s1, MPFR_RNDN);
mpfr_const_euler (f, MPFR_RNDN);
mpfr_add (z_pre, z_pre, f, MPFR_RNDN);
}
else /* Branch 2 */
{
size_t size;
/* branch 2 */
/* Computation of parameters n, p and working precision */
dnep = (double) d * LOG2;
sd = mpfr_get_d (s, MPFR_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);
}
/* 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;
/* internal precision is dint */
size = (p + 1) * sizeof(mpfr_t);
tc1 = (mpfr_t*) mpfr_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);
/* precision of z is precz */
/* Computation of the coefficients c_k */
mpfr_zeta_c (p, tc1);
/* Computation of the 3 parts of the function 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, MPFR_RNDN);
mpfr_ui_pow (f, n, s1, MPFR_RNDN);
mpfr_div (c, c, f, MPFR_RNDN);
mpfr_add (z_pre, z_pre, c, MPFR_RNDN);
mpfr_add (z_pre, z_pre, b, MPFR_RNDN);
for (l=1; l<=p; l++)
mpfr_clear (tc1[l]);
mpfr_free_func (tc1, size);
/* End branch 2 */
}
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);
mpfr_clear (s1);
return inex;
}
/* return add = 1 + floor(log(c^3*(13+m1))/log(2))
where c = (1+eps)*(1+eps*max(8,m1)),
m1 = 1 + max(1/eps,2*sd)*(1+eps),
eps = 2^(-precz-14)
sd = abs(s-1)
*/
static long
compute_add (mpfr_srcptr s, mpfr_prec_t precz)
{
mpfr_t t, u, m1;
long add;
mpfr_inits2 (64, t, u, m1, (mpfr_ptr) 0);
if (mpfr_cmp_ui (s, 1) >= 0)
mpfr_sub_ui (t, s, 1, MPFR_RNDU);
else
mpfr_ui_sub (t, 1, s, MPFR_RNDU);
/* now t = sd = abs(s-1), rounded up */
mpfr_set_ui_2exp (u, 1, - precz - 14, MPFR_RNDU);
/* u = eps */
/* since 1/eps = 2^(precz+14), if EXP(sd) >= precz+14, then
sd >= 1/2*2^(precz+14) thus 2*sd >= 2^(precz+14) >= 1/eps */
if (mpfr_get_exp (t) >= precz + 14)
mpfr_mul_2ui (t, t, 1, MPFR_RNDU);
else
mpfr_set_ui_2exp (t, 1, precz + 14, MPFR_RNDU);
/* now t = max(1/eps,2*sd) */
mpfr_add_ui (u, u, 1, MPFR_RNDU); /* u = 1+eps, rounded up */
mpfr_mul (t, t, u, MPFR_RNDU); /* t = max(1/eps,2*sd)*(1+eps) */
mpfr_add_ui (m1, t, 1, MPFR_RNDU);
if (mpfr_get_exp (m1) <= 3)
mpfr_set_ui (t, 8, MPFR_RNDU);
else
mpfr_set (t, m1, MPFR_RNDU);
/* now t = max(8,m1) */
mpfr_div_2ui (t, t, precz + 14, MPFR_RNDU); /* eps*max(8,m1) */
mpfr_add_ui (t, t, 1, MPFR_RNDU); /* 1+eps*max(8,m1) */
mpfr_mul (t, t, u, MPFR_RNDU); /* t = c */
mpfr_add_ui (u, m1, 13, MPFR_RNDU); /* 13+m1 */
mpfr_mul (u, u, t, MPFR_RNDU); /* c*(13+m1) */
mpfr_sqr (t, t, MPFR_RNDU); /* c^2 */
mpfr_mul (u, u, t, MPFR_RNDU); /* c^3*(13+m1) */
add = mpfr_get_exp (u);
mpfr_clears (t, u, m1, (mpfr_ptr) 0);
return add;
}
/* return in z a lower bound (for rnd = RNDD) or upper bound (for rnd = RNDU)
of |zeta(s)|/2, using:
log(|zeta(s)|/2) = (s-1)*log(2*Pi) + lngamma(1-s)
+ log(|sin(Pi*s/2)| * zeta(1-s)).
Assumes s < 1/2 and s1 = 1-s exactly, thus s1 > 1/2.
y and p are temporary variables.
At input, p is Pi rounded down.
The comments in the code are for rnd = RNDD. */
static void
mpfr_reflection_overflow (mpfr_t z, mpfr_t s1, const mpfr_t s, mpfr_t y,
mpfr_t p, mpfr_rnd_t rnd)
{
mpz_t sint;
MPFR_ASSERTD (rnd == MPFR_RNDD || rnd == MPFR_RNDU);
/* Since log is increasing, we want lower bounds on |sin(Pi*s/2)| and
zeta(1-s). */
mpz_init (sint);
mpfr_get_z (sint, s, MPFR_RNDD); /* sint = floor(s) */
/* We first compute a lower bound of |sin(Pi*s/2)|, which is a periodic
function of period 2. Thus:
if 2k < s < 2k+1, then |sin(Pi*s/2)| is increasing;
if 2k-1 < s < 2k, then |sin(Pi*s/2)| is decreasing.
These cases are distinguished by testing bit 0 of floor(s) as if
represented in two's complement (or equivalently, as an unsigned
integer mod 2):
0: sint = 0 mod 2, thus 2k < s < 2k+1 and |sin(Pi*s/2)| is increasing;
1: sint = 1 mod 2, thus 2k-1 < s < 2k and |sin(Pi*s/2)| is decreasing.
Let's recall that the comments are for rnd = RNDD. */
if (mpz_tstbit (sint, 0) == 0) /* |sin(Pi*s/2)| is increasing: round down
Pi*s to get a lower bound. */
{
mpfr_mul (y, p, s, rnd);
if (rnd == MPFR_RNDD)
mpfr_nextabove (p); /* we will need p rounded above afterwards */
}
else /* |sin(Pi*s/2)| is decreasing: round up Pi*s to get a lower bound. */
{
if (rnd == MPFR_RNDD)
mpfr_nextabove (p);
mpfr_mul (y, p, s, MPFR_INVERT_RND(rnd));
}
mpfr_div_2ui (y, y, 1, MPFR_RNDN); /* exact, rounding mode doesn't matter */
/* The rounding direction of sin depends on its sign. We have:
if -4k-2 < s < -4k, then -2k-1 < s/2 < -2k, thus sin(Pi*s/2) < 0;
if -4k < s < -4k+2, then -2k < s/2 < -2k+1, thus sin(Pi*s/2) > 0.
These cases are distinguished by testing bit 1 of floor(s) as if
represented in two's complement (or equivalently, as an unsigned
integer mod 4):
0: sint = {0,1} mod 4, thus -2k < s/2 < -2k+1 and sin(Pi*s/2) > 0;
1: sint = {2,3} mod 4, thus -2k-1 < s/2 < -2k and sin(Pi*s/2) < 0.
Let's recall that the comments are for rnd = RNDD. */
if (mpz_tstbit (sint, 1) == 0) /* -2k < s/2 < -2k+1; sin(Pi*s/2) > 0 */
{
/* Round sin down to get a lower bound of |sin(Pi*s/2)|. */
mpfr_sin (y, y, rnd);
}
else /* -2k-1 < s/2 < -2k; sin(Pi*s/2) < 0 */
{
/* Round sin up to get a lower bound of |sin(Pi*s/2)|. */
mpfr_sin (y, y, MPFR_INVERT_RND(rnd));
mpfr_abs (y, y, MPFR_RNDN); /* exact, rounding mode doesn't matter */
}
mpz_clear (sint);
/* now y <= |sin(Pi*s/2)| when rnd=RNDD, y >= |sin(Pi*s/2)| when rnd=RNDU */
mpfr_zeta_pos (z, s1, rnd); /* zeta(1-s) */
mpfr_mul (z, z, y, rnd);
/* now z <= |sin(Pi*s/2)|*zeta(1-s) */
mpfr_log (z, z, rnd);
/* now z <= log(|sin(Pi*s/2)|*zeta(1-s)) */
mpfr_lngamma (y, s1, rnd);
mpfr_add (z, z, y, rnd);
/* z <= lngamma(1-s) + log(|sin(Pi*s/2)|*zeta(1-s)) */
/* since s-1 < 0, we want to round log(2*pi) upwards */
mpfr_mul_2ui (y, p, 1, MPFR_INVERT_RND(rnd));
mpfr_log (y, y, MPFR_INVERT_RND(rnd));
mpfr_mul (y, y, s1, MPFR_INVERT_RND(rnd));
mpfr_sub (z, z, y, rnd);
mpfr_exp (z, z, rnd);
if (rnd == MPFR_RNDD)
mpfr_nextbelow (p); /* restore original p */
}
int
mpfr_zeta (mpfr_t z, mpfr_srcptr s, mpfr_rnd_t rnd_mode)
{
mpfr_t z_pre, s1, y, p;
long add;
mpfr_prec_t precz, prec1, precs, precs1;
int inex;
MPFR_GROUP_DECL (group);
MPFR_ZIV_DECL (loop);
MPFR_SAVE_EXPO_DECL (expo);
MPFR_LOG_FUNC (
("s[%Pu]=%.*Rg rnd=%d", mpfr_get_prec (s), mpfr_log_prec, s, rnd_mode),
("z[%Pu]=%.*Rg inexact=%d", mpfr_get_prec (z), mpfr_log_prec, z, inex));
/* Zero, Nan or Inf ? */
if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (s)))
{
if (MPFR_IS_NAN (s))
{
MPFR_SET_NAN (z);
MPFR_RET_NAN;
}
else if (MPFR_IS_INF (s))
{
if (MPFR_IS_POS (s))
return mpfr_set_ui (z, 1, MPFR_RNDN); /* Zeta(+Inf) = 1 */
MPFR_SET_NAN (z); /* Zeta(-Inf) = NaN */
MPFR_RET_NAN;
}
else /* s iz zero */
{
MPFR_ASSERTD (MPFR_IS_ZERO (s));
return mpfr_set_si_2exp (z, -1, -1, rnd_mode);
}
}
/* s is neither Nan, nor Inf, nor Zero */
/* check tiny s: we have zeta(s) = -1/2 - 1/2 log(2 Pi) s + ... around s=0,
and for |s| <= 2^(-4), we have |zeta(s) + 1/2| <= |s|.
EXP(s) + 1 < -PREC(z) is a sufficient condition to be able to round
correctly, for any PREC(z) >= 1 (see algorithms.tex for details). */
if (MPFR_GET_EXP (s) + 1 < - (mpfr_exp_t) MPFR_PREC(z))
{
int signs = MPFR_SIGN(s);
MPFR_SAVE_EXPO_MARK (expo);
mpfr_set_si_2exp (z, -1, -1, rnd_mode); /* -1/2 */
if (rnd_mode == MPFR_RNDA)
rnd_mode = MPFR_RNDD; /* the result is around -1/2, thus negative */
if ((rnd_mode == MPFR_RNDU || rnd_mode == MPFR_RNDZ) && signs < 0)
{
mpfr_nextabove (z); /* z = -1/2 + epsilon */
inex = 1;
}
else if (rnd_mode == MPFR_RNDD && signs > 0)
{
mpfr_nextbelow (z); /* z = -1/2 - epsilon */
inex = -1;
}
else
{
if (rnd_mode == MPFR_RNDU) /* s > 0: z = -1/2 */
inex = 1;
else if (rnd_mode == MPFR_RNDD)
inex = -1; /* s < 0: z = -1/2 */
else /* (MPFR_RNDZ and s > 0) or MPFR_RNDN: z = -1/2 */
inex = (signs > 0) ? 1 : -1;
}
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_check_range (z, inex, rnd_mode);
}
/* Check for case s= -2n */
if (MPFR_IS_NEG (s))
{
mpfr_t tmp;
tmp[0] = *s;
MPFR_EXP (tmp) = MPFR_GET_EXP (s) - 1;
if (mpfr_integer_p (tmp))
{
MPFR_SET_ZERO (z);
MPFR_SET_POS (z);
MPFR_RET (0);
}
}
/* Check for case s=1 before changing the exponent range */
if (mpfr_cmp (s, __gmpfr_one) == 0)
{
MPFR_SET_INF (z);
MPFR_SET_POS (z);
MPFR_SET_DIVBY0 ();
MPFR_RET (0);
}
MPFR_SAVE_EXPO_MARK (expo);
/* Compute Zeta */
if (MPFR_IS_POS (s) && MPFR_GET_EXP (s) >= 0) /* Case s >= 1/2 */
inex = mpfr_zeta_pos (z, s, rnd_mode);
else /* use reflection formula
zeta(s) = 2^s*Pi^(s-1)*sin(Pi*s/2)*gamma(1-s)*zeta(1-s) */
{
int overflow = 0;
precz = MPFR_PREC (z);
precs = MPFR_PREC (s);
/* Precision precs1 needed to represent 1 - s, and s + 2,
without any truncation */
precs1 = precs + 2 + MAX (0, - MPFR_GET_EXP (s));
/* Precision prec1 is the precision on elementary computations;
it ensures a final precision prec1 - add for zeta(s) */
add = compute_add (s, precz);
prec1 = precz + add;
/* FIXME: To avoid that the working precision (prec1) depends on the
input precision, one would need to take into account the error made
when s1 is not exactly 1-s when computing zeta(s1) and gamma(s1)
below, and also in the case y=Inf (i.e. when gamma(s1) overflows).
Make sure that underflows do not occur in intermediate computations.
Due to the limited precision, they are probably not possible
in practice; add some MPFR_ASSERTN's to be sure that problems
do not remain undetected? */
prec1 = MAX (prec1, precs1) + 10;
MPFR_GROUP_INIT_4 (group, prec1, z_pre, s1, y, p);
MPFR_ZIV_INIT (loop, prec1);
for (;;)
{
mpfr_exp_t ey;
mpfr_t z_up;
mpfr_const_pi (p, MPFR_RNDD); /* p is Pi */
mpfr_sub (s1, __gmpfr_one, s, MPFR_RNDN); /* s1 = 1-s */
mpfr_gamma (y, s1, MPFR_RNDN); /* gamma(1-s) */
if (MPFR_IS_INF (y)) /* zeta(s) < 0 for -4k-2 < s < -4k,
zeta(s) > 0 for -4k < s < -4k+2 */
{
/* FIXME: An overflow in gamma(s1) does not imply that
zeta(s) will overflow. A solution:
1. Compute
log(|zeta(s)|/2) = (s-1)*log(2*pi) + lngamma(1-s)
+ log(abs(sin(Pi*s/2)) * zeta(1-s))
(possibly sharing computations with the normal case)
with a rather good accuracy (see (2)).
Memorize the sign of sin(...) for the final sign.
2. Take the exponential, ~= |zeta(s)|/2. If there is an
overflow, then this means an overflow on the final result
(due to the multiplication by 2, which has not been done
yet).
3. Ziv test.
4. Correct the sign from the sign of sin(...).
5. Round then multiply by 2. Here, an overflow in either
operation means a real overflow. */
mpfr_reflection_overflow (z_pre, s1, s, y, p, MPFR_RNDD);
/* z_pre is a lower bound of |zeta(s)|/2, thus if it overflows,
or has exponent emax, then |zeta(s)| overflows too. */
if (MPFR_IS_INF (z_pre) || MPFR_GET_EXP(z_pre) == __gmpfr_emax)
{ /* determine the sign of overflow */
mpfr_div_2ui (s1, s, 2, MPFR_RNDN); /* s/4, exact */
mpfr_frac (s1, s1, MPFR_RNDN); /* exact, -1 < s1 < 0 */
overflow = (mpfr_cmp_si_2exp (s1, -1, -1) > 0) ? -1 : 1;
break;
}
else /* EXP(z_pre) < __gmpfr_emax */
{
int ok = 0;
mpfr_t z_down;
mpfr_init2 (z_up, mpfr_get_prec (z_pre));
mpfr_reflection_overflow (z_up, s1, s, y, p, MPFR_RNDU);
/* if the lower approximation z_pre does not overflow, but
z_up does, we need more precision */
if (MPFR_IS_INF (z_up) || MPFR_GET_EXP(z_up) == __gmpfr_emax)
goto next_loop;
/* check if z_pre and z_up round to the same number */
mpfr_init2 (z_down, precz);
mpfr_set (z_down, z_pre, rnd_mode);
/* Note: it might be that EXP(z_down) = emax here, in that
case we will have overflow below when we multiply by 2 */
mpfr_prec_round (z_up, precz, rnd_mode);
ok = mpfr_cmp (z_down, z_up) == 0;
mpfr_clear (z_up);
mpfr_clear (z_down);
if (ok)
{
/* get correct sign and multiply by 2 */
mpfr_div_2ui (s1, s, 2, MPFR_RNDN); /* s/4, exact */
mpfr_frac (s1, s1, MPFR_RNDN); /* exact, -1 < s1 < 0 */
if (mpfr_cmp_si_2exp (s1, -1, -1) > 0)
mpfr_neg (z_pre, z_pre, rnd_mode);
mpfr_mul_2ui (z_pre, z_pre, 1, rnd_mode);
break;
}
else
goto next_loop;
}
}
mpfr_zeta_pos (z_pre, s1, MPFR_RNDN); /* zeta(1-s) */
mpfr_mul (z_pre, z_pre, y, MPFR_RNDN); /* gamma(1-s)*zeta(1-s) */
/* multiply z_pre by 2^s*Pi^(s-1) where p=Pi, s1=1-s */
mpfr_mul_2ui (y, p, 1, MPFR_RNDN); /* 2*Pi */
mpfr_neg (s1, s1, MPFR_RNDN); /* s-1 */
mpfr_pow (y, y, s1, MPFR_RNDN); /* (2*Pi)^(s-1) */
mpfr_mul (z_pre, z_pre, y, MPFR_RNDN);
mpfr_mul_2ui (z_pre, z_pre, 1, MPFR_RNDN);
/* multiply z_pre by sin(Pi*s/2) */
mpfr_mul (y, s, p, MPFR_RNDN);
mpfr_div_2ui (p, y, 1, MPFR_RNDN); /* p = s*Pi/2 */
/* FIXME: sinpi will be available, we should replace the mpfr_sin
call below by mpfr_sinpi(s/2), where s/2 will be exact.
Can mpfr_sin underflow? Moreover, the code below should be
improved so that the "if" condition becomes unlikely, e.g.
by taking a slightly larger working precision. */
mpfr_sin (y, p, MPFR_RNDN); /* y = sin(Pi*s/2) */
ey = MPFR_GET_EXP (y);
if (ey < 0) /* take account of cancellation in sin(p) */
{
mpfr_t t;
MPFR_ASSERTN (- ey < MPFR_PREC_MAX - prec1);
mpfr_init2 (t, prec1 - ey);
mpfr_const_pi (t, MPFR_RNDD);
mpfr_mul (t, s, t, MPFR_RNDN);
mpfr_div_2ui (t, t, 1, MPFR_RNDN);
mpfr_sin (y, t, MPFR_RNDN);
mpfr_clear (t);
}
mpfr_mul (z_pre, z_pre, y, MPFR_RNDN);
if (MPFR_LIKELY (MPFR_CAN_ROUND (z_pre, prec1 - add, precz,
rnd_mode)))
break;
next_loop:
MPFR_ZIV_NEXT (loop, prec1);
MPFR_GROUP_REPREC_4 (group, prec1, z_pre, s1, y, p);
}
MPFR_ZIV_FREE (loop);
if (overflow != 0)
{
inex = mpfr_overflow (z, rnd_mode, overflow);
MPFR_SAVE_EXPO_UPDATE_FLAGS (expo, MPFR_FLAGS_OVERFLOW);
}
else
inex = mpfr_set (z, z_pre, rnd_mode);
MPFR_GROUP_CLEAR (group);
}
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_check_range (z, inex, rnd_mode);
}
|
