/*
This file is part of liberferfc.
Copyright 2009-2010 by
Laboratoire de l'Informatique du Parallélisme, UMR CNRS - ENS Lyon -
UCB Lyon 1 - INRIA 5668,
and by LORIA (CNRS, INPL, INRIA, UHP, U-Nancy 2).
It has been written by S. Chevillard.
Liberferfc 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.
Liberferfc 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 liberferfc. If not, see .
*/
#include
#include "erferfc_utils.h"
/* Gives a rough overestimation of the necessary truncation rank. */
/* See Recipe 3 of the article. */
void rough_truncation_rank2(mpfr_t rank, mpfr_t x, mpfr_prec_t tprime) {
mpfr_t temp1, temp2, au;
long int E;
mpfr_init2(au, SMALL_PRECISION);
mpfr_init2(temp1, SMALL_PRECISION);
mpfr_init2(temp2, SMALL_PRECISION);
mpfr_set(temp1, x, MPFR_RNDD);
mpfr_sqr(temp1, temp1, MPFR_RNDD);
mpfr_my_mul_d(temp2, temp1, LOG2EINF, MPFR_RNDD); /* temp2 <~ x^2 log2(e) */
mpfr_my_mul_d(temp1, temp1, EINF, MPFR_RNDD); /* temp1 <~ ex^2 */
E = (long int)mpfr_get_exp(x);
E = (E<0) ? 0 : E;
mpfr_neg(temp2, temp2, MPFR_RNDU);
mpfr_add_si(temp2, temp2, E, MPFR_RNDU);
mpfr_add_ui(temp2, temp2, ADD_UI_SAFE(3, (unsigned long)tprime), MPFR_RNDU);
mpfr_div(au, temp2, temp1, MPFR_RNDU);
if (mpfr_get_exp(au) >= 2) { /* au >= 2 */
mpfr_log2(temp1, au, MPFR_RNDD);
mpfr_div(temp1, au, temp1, MPFR_RNDU);
mpfr_mul_2ui(temp1, temp1, 1, MPFR_RNDU); /* temp1 >~ 2au/log2(au) */
}
else {
if (mpfr_sgn(au)>=0) { /* au in [0,2] */
mpfr_div_2ui(temp1, au, 1, MPFR_RNDU);
mpfr_set_ui(temp2, 1, MPFR_RNDU);
mpfr_div_2ui(temp2, temp2, 2, MPFR_RNDU);
mpfr_add(temp1, temp1, temp2, MPFR_RNDU);
mpfr_exp2(temp1, temp1, MPFR_RNDU); /* temp1 >~ 2^(1/4) * 2^(au/2) */
}
else mpfr_exp2(temp1, au, MPFR_RNDU); /* au < 0 : temp1 >~ 2^(au) */
}
mpfr_set(temp2, x, MPFR_RNDU);
mpfr_sqr(temp2, temp2, MPFR_RNDU); /* temp2 >~ x^2 */
mpfr_mul(temp1, temp1, temp2, MPFR_RNDU);
mpfr_my_mul_d(temp1, temp1, ESUP, MPFR_RNDU); /* temp1 is a candidate for N */
mpfr_mul_2ui(temp2, temp2, 1, MPFR_RNDU); /* temp2 >~ 2x^2 */
if(mpfr_greater_p(temp2, temp1)) mpfr_set(rank, temp2, MPFR_RNDU);
else mpfr_set(rank, temp1, MPFR_RNDU);
ASSERT(mpfr_fits_ulong_p(rank, MPFR_RNDU));
mpfr_clear(temp1);
mpfr_clear(temp2);
mpfr_clear(au);
return;
}
/* Computes an approximate value of erf(x) with an overall relative error */
/* less than 2^{-tprime}. */
/* The method used is a Taylor development of exp(x^2)erf(x) at zero. */
/* The value x is assumed to satisfy 0 < x < infinity. */
mpfr_t *mp_erf2(mpfr_t x, mpfr_prec_t tprime) {
unsigned long k, N;
long int i, L;
mpfr_prec_t t, t2;
mpfr_exp_t E, F, G;
mpfr_t y, z, acc;
mpfr_t *R;
mpfr_t *S;
mpfr_t rank, temp, temp2;
/* Rough overestimation N of the truncation rank */
mpfr_init2(rank, SMALL_PRECISION);
rough_truncation_rank2(rank, x, tprime);
N = mpfr_get_ui(rank, MPFR_RNDU);
/* Choosing the working precision t */
t = ADD_UI_SAFE(tprime, 7);
t = ADD_UI_SAFE(t, (unsigned long)mpfr_get_exp(rank));
/* Choosing the size L of the groups */
mpfr_sqrt(rank, rank, MPFR_RNDN);
L = mpfr_get_ui(rank, MPFR_RNDU);
mpfr_clear(rank);
/* Initializations */
mpfr_init2(y, t);
mpfr_init2(z, t);
mpfr_init2(acc, t);
R = malloc(sizeof(mpfr_t)); ASSERT( R != NULL);
mpfr_init2(*R, t);
S = calloc(L, sizeof(mpfr_t)); ASSERT(S != NULL);
for(i=0; i 0) || (mpfr_get_exp(acc) >= G-(long int)tprime-3-F*i) ) );
/* Final accumulation */
mpfr_set(*R, S[L-1], MPFR_RNDN);
for( i=L-2; i>=0; i-- ) {
mpfr_mul(*R, *R, y, MPFR_RNDN);
mpfr_add(*R, *R, S[i], MPFR_RNDN);
}
/* Garbage collecting */
mpfr_clear(y);
mpfr_clear(z);
mpfr_clear(acc);
for(i=0; i