/*
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 5 of the article. */
/* If the asymptotic equation can succesfully be used, a correct */
/* rank is stored and the returned value is 1. */
/* Otherwise, the value of rank is undefined and the returne */
/* is 0. */
int rough_truncation_rank3(mpfr_t rank, mpfr_t x, mpfr_prec_t tprime) {
mpfr_t temp1, temp2, ad, x2inf;
int res = 1;
mpfr_init2(ad, SMALL_PRECISION);
mpfr_init2(temp1, SMALL_PRECISION);
mpfr_init2(temp2, SMALL_PRECISION);
mpfr_init2(x2inf, SMALL_PRECISION);
mpfr_set(x2inf, x, MPFR_RNDD);
mpfr_sqr(x2inf, x2inf, MPFR_RNDD);
mpfr_my_mul_d(temp1, x2inf, EINF, MPFR_RNDD); /* temp1 <~ ex^2 */
mpfr_set_ui(temp2, ADD_UI_SAFE(3, (unsigned long)tprime), MPFR_RNDU);
mpfr_div(ad, temp2, temp1, MPFR_RNDU);
mpfr_neg(ad, ad, MPFR_RNDD);
if (mpfr_cmp_d(ad, ALPHA) <= 0) { /* ad is presumably lower than -log2(e)/e */
res = 0;
}
else {
mpfr_neg(temp1, ad, MPFR_RNDU);
mpfr_log2(temp1, temp1, MPFR_RNDU);
mpfr_div(temp1, ad, temp1, MPFR_RNDU); /* temp1 >~ ad/log2(-ad) */
mpfr_set(temp2, x, MPFR_RNDU);
mpfr_sqr(temp2, temp2, MPFR_RNDU);
mpfr_my_mul_d(temp2, temp2, ESUP, MPFR_RNDU); /* temp2 >~ ex^2 */
mpfr_mul(temp1, temp1, temp2, MPFR_RNDU); /* temp1 >~ ex^2 * ad/log2(-ad) */
mpfr_ceil(rank, temp1);
if (!mpfr_lessequal_p(rank, x2inf)) {
mpfr_ceil(rank, x2inf);
mpfr_my_mul_d(temp1, x2inf, EINF, MPFR_RNDD);
mpfr_div(temp1, rank, temp1, MPFR_RNDU);
mpfr_log2(temp2, temp1, MPFR_RNDU);
mpfr_mul(temp1, temp1, temp2, MPFR_RNDU); /* temp1 >~ (N/ex^2)log2(N/ex^2) */
if(!mpfr_greaterequal_p(ad, temp1)) res = 0;
}
}
if(res) {
ASSERT(mpfr_fits_ulong_p(rank, MPFR_RNDU));
ASSERT(mpfr_cmp_ui(rank, mpfr_get_ui(rank, MPFR_RNDU))==0);
}
mpfr_clear(temp1);
mpfr_clear(temp2);
mpfr_clear(ad);
mpfr_clear(x2inf);
return res;
}
/* Computes an approximate value of erfc(x) with an overall relative error */
/* less than 2^{-tprime}. */
/* The method used is the asymptotic development of erf at zero. */
/* The value x is assumed to satisfy 0 < x < infinity. */
/* If the development does not provide enough accuracy, NULL is returned. */
mpfr_t *mp_erfc3(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, temp1, temp2, temp3;
/* Rough overestimation N of the truncation rank */
mpfr_init2(rank, SMALL_PRECISION);
if (!rough_truncation_rank3(rank, x, tprime)) {
mpfr_clear(rank);
return NULL;
}
N = mpfr_get_ui(rank, MPFR_RNDU);
/* Choosing the working precision t */
t = ADD_UI_SAFE(tprime, 9);
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=1);
t2 = (unsigned long)E;
t2 = ADD_UI_SAFE(t2, t2);
t2 = ADD_UI_SAFE(t, t2);
mpfr_init2(temp2, t2);
mpfr_sqr(temp2, x, MPFR_RNDD);
mpfr_mul_2ui(y, temp2, 1, MPFR_RNDD);
mpfr_ui_div(y, 1, y, MPFR_RNDU);
mpfr_neg(temp2, temp2, MPFR_RNDU);
mpfr_exp(acc, temp2, MPFR_RNDU);
mpfr_clear(temp2);
mpfr_init2(temp3, t);
mpfr_const_pi(temp3, MPFR_RNDD);
mpfr_sqrt(temp3, temp3, MPFR_RNDD);
mpfr_mul(temp3, temp3, x, MPFR_RNDD);
mpfr_div(acc, acc, temp3, MPFR_RNDU);
mpfr_clear(temp3);
F = mpfr_get_exp(y);
binaryPow(z, y, L, MPFR_RNDU);
for(i=0; i= -(long int)tprime-3-F*i-G-E) );
/* 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