void _STUB_erf(){}
#else
/*-
* Copyright (c) 1992, 1993
* The Regents of the University of California. All rights reserved.
*
* Redistribution and use in source and binary forms, with or without
* modification, are permitted provided that the following conditions
* are met:
* 1. Redistributions of source code must retain the above copyright
* notice, this list of conditions and the following disclaimer.
* 2. Redistributions in binary form must reproduce the above copyright
* notice, this list of conditions and the following disclaimer in the
* 3. Neither the name of the University nor the names of its contributors
* may be used to endorse or promote products derived from this software
* without specific prior written permission.
*
* THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
* ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
* IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
* ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
* FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
* DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
* OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
* HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
* LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
* OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
* SUCH DAMAGE.
*/
#ifndef lint
#endif /* not lint */
/* Modified Nov 30, 1992 P. McILROY:
* Replaced expansions for x >= 1.25 (error 1.7ulp vs ~6ulp)
* Replaced even+odd with direct calculation for x < .84375,
* to avoid destructive cancellation.
*
* Performance of erfc(x):
* In 300000 trials in the range [.83, .84375] the
* maximum observed error was 3.6ulp.
*
* In [.84735,1.25] the maximum observed error was <2.5ulp in
* 100000 runs in the range [1.2, 1.25].
*
* In [1.25,26] (Not including subnormal results)
* the error is < 1.7ulp.
*/
/* double erf(double x)
* double erfc(double x)
* x
* 2 |\
* erf(x) = --------- | exp(-t*t)dt
* sqrt(pi) \|
* 0
*
* erfc(x) = 1-erf(x)
*
* Method:
* 1. Reduce x to |x| by erf(-x) = -erf(x)
* 2. For x in [0, 0.84375]
* erf(x) = x + x*P(x^2)
* erfc(x) = 1 - erf(x) if x<=0.25
* = 0.5 + ((0.5-x)-x*P) if x in [0.25,0.84375]
* where
* 2 2 4 20
* P = P(x ) = (p0 + p1 * x + p2 * x + ... + p10 * x )
* is an approximation to (erf(x)-x)/x with precision
*
* -56.45
* | P - (erf(x)-x)/x | <= 2
*
*
* Remark. The formula is derived by noting
* erf(x) = (2/sqrt(pi))*(x - x^3/3 + x^5/10 - x^7/42 + ....)
* and that
* 2/sqrt(pi) = 1.128379167095512573896158903121545171688
* is close to one. The interval is chosen because the fixed
* point of erf(x) is near 0.6174 (i.e., erf(x)=x when x is
* near 0.6174), and by some experiment, 0.84375 is chosen to
* guarantee the error is less than one ulp for erf.
*
* 3. For x in [0.84375,1.25], let s = x - 1, and
* c = 0.84506291151 rounded to single (24 bits)
* erf(x) = c + P1(s)/Q1(s)
* erfc(x) = (1-c) - P1(s)/Q1(s)
* Remark: here we use the taylor series expansion at x=1.
* erf(1+s) = erf(1) + s*Poly(s)
* = 0.845.. + P1(s)/Q1(s)
* That is, we use rational approximation to approximate
* erf(1+s) - (c = (single)0.84506291151)
* where
* P1(s) = degree 6 poly in s
* Q1(s) = degree 6 poly in s
*
* 4. For x in [1.25, 2]; [2, 4]
* erf(x) = 1.0 - tiny
* erfc(x) = (1/x)exp(-x*x-(.5*log(pi) -.5z + R(z)/S(z))
*
* Where z = 1/(x*x), R is degree 9, and S is degree 3;
*
* 5. For x in [4,28]
* erf(x) = 1.0 - tiny
* erfc(x) = (1/x)exp(-x*x-(.5*log(pi)+eps + zP(z))
*
* Where P is degree 14 polynomial in 1/(x*x).
*
* Notes:
* Here 4 and 5 make use of the asymptotic series
* exp(-x*x)
* erfc(x) ~ ---------- * ( 1 + Poly(1/x^2) );
* x*sqrt(pi)
*
* where for z = 1/(x*x)
* P(z) ~ z/2*(-1 + z*3/2*(1 + z*5/2*(-1 + z*7/2*(1 +...))))
*
* Thus we use rational approximation to approximate
* erfc*x*exp(x*x) ~ 1/sqrt(pi);
*
* The error bound for the target function, G(z) for
* the interval
* [4, 28]:
* |eps + 1/(z)P(z) - G(z)| < 2**(-56.61)
* for [2, 4]:
* |R(z)/S(z) - G(z)| < 2**(-58.24)
* for [1.25, 2]:
* |R(z)/S(z) - G(z)| < 2**(-58.12)
*
* 6. For inf > x >= 28
* erf(x) = 1 - tiny (raise inexact)
* erfc(x) = tiny*tiny (raise underflow)
*
* 7. Special cases:
* erf(0) = 0, erf(inf) = 1, erf(-inf) = -1,
* erfc(0) = 1, erfc(inf) = 0, erfc(-inf) = 2,
*/
#define _IEEE 0
#define TRUNC(x) (double) (float) (x)
#else
#endif
#ifdef _IEEE_LIBM
/*
* redefining "___function" to "function" in _IEEE_LIBM mode
*/
#include "ieee_libm.h"
#endif
#include "mathimpl.h"
static double
c = 8.45062911510467529297e-01, /* (float)0.84506291151 */
/*
* Coefficients for approximation to erf in [0,0.84375]
*/
/*
* Coefficients for approximation to erf in [0.84375,1.25]
*/
static double
/*
* log(sqrt(pi)) for large x expansions.
* The tail (lsqrtPI_lo) is included in the rational
* approximations.
*/
static double
/*
* lsqrtPI_lo = .000000000000000005132975581353913;
*
* Coefficients for approximation to erfc in [2, 4]
*/
static double
/*
* Coefficients for approximation to erfc in [1.25, 2]
*/
static double
/*
* Coefficients for approximation to erfc in [4,28]
*/
static double
extern double erf(x)
double x;
{
if(!finite(x)) { /* erf(nan)=nan */
if (isnan(x))
return(x);
}
if ((ax = x) < 0)
if (ax < .84375) {
if (ax < 3.7e-09) {
if (ax < 1.0e-308)
return x + p0*x;
}
y = x*x;
return x + x*(p0+r);
}
if (x>=0)
return (c + P/Q);
else
return (-c - P/Q);
}
if (x >= 0.0)
else
}
/* 1.25 <= |x| < 6 */
s = -one/z;
if (ax < 2.0) {
} else {
}
y = (R/S -.5*s) - lsqrtPI_hi;
z += y;
if (x >= 0)
return (one-z);
else
return (z-one);
}
extern double erfc(x)
double x;
{
if (!finite(x)) {
if (isnan(x)) /* erfc(NaN) = NaN */
return(x);
else if (x > 0) /* erfc(+-inf)=0,2 */
return 0.0;
else
return 2.0;
}
if ((ax = x) < 0)
return one-x;
y = x*x;
} else {
r = x*(p0+r);
r += (x-half);
return (half - r);
}
}
if (x>=0) {
z = one-c; return z - P/Q;
} else {
z = c+P/Q; return one+z;
}
}
if (x>0)
else
z = ax;
TRUNC(z);
z *= -z; /* Here z + y = -x^2 */
s = one/(-z-y); /* 1/(x*x) */
y += rd0;
} else if (ax >= 2) {
y += R/S;
R = -.5*s;
} else {
y += R/S;
R = -.5*s;
}
/* return exp(-x^2 - lsqrtPI_hi + R + y)/x; */
s = ((R + y) - lsqrtPI_hi) + z;
y = (((z-s) - lsqrtPI_hi) + R) + y;
r = __exp__D(s, y)/x;
if (x>0)
return r;
else
return two-r;
}
#endif