diff options
| author | Eric Andersen <andersen@codepoet.org> | 2001-05-10 00:40:28 +0000 |
|---|---|---|
| committer | Eric Andersen <andersen@codepoet.org> | 2001-05-10 00:40:28 +0000 |
| commit | 1077fa4d772832f77a677ce7fb7c2d513b959e3f (patch) | |
| tree | 579bee13fb0b58d2800206366ec2caecbb15f3fc /libm/float | |
| parent | 22358dd7ce7bb49792204b698f01a6f69b9c8e08 (diff) | |
uClibc now has a math library. muahahahaha!
-Erik
Diffstat (limited to 'libm/float')
82 files changed, 20650 insertions, 0 deletions
diff --git a/libm/float/Makefile b/libm/float/Makefile new file mode 100644 index 000000000..389ac1a5d --- /dev/null +++ b/libm/float/Makefile @@ -0,0 +1,62 @@ +# Makefile for uClibc's math library +# +# Copyright (C) 2001 by Lineo, inc. +# +# This program is free software; you can redistribute it and/or modify it under +# the terms of the GNU Library General Public License as published by the Free +# Software Foundation; either version 2 of the License, or (at your option) any +# later version. +# +# This program 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 Library General Public License for more +# details. +# +# You should have received a copy of the GNU Library General Public License +# along with this program; if not, write to the Free Software Foundation, Inc., +# 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +# +# Derived in part from the Linux-8086 C library, the GNU C Library, and several +# other sundry sources. Files within this library are copyright by their +# respective copyright holders. + +TOPDIR=../../ +include $(TOPDIR)Rules.mak + +LIBM=../libm.a +TARGET_CC= $(TOPDIR)/extra/gcc-uClibc/$(TARGET_ARCH)-uclibc-gcc + +CSRC= acoshf.c airyf.c asinf.c asinhf.c atanf.c \ + atanhf.c bdtrf.c betaf.c cbrtf.c chbevlf.c chdtrf.c \ + clogf.c cmplxf.c constf.c coshf.c dawsnf.c ellief.c \ + ellikf.c ellpef.c ellpkf.c ellpjf.c expf.c exp2f.c \ + exp10f.c expnf.c facf.c fdtrf.c floorf.c fresnlf.c \ + gammaf.c gdtrf.c hypergf.c hyp2f1f.c igamf.c igamif.c \ + incbetf.c incbif.c i0f.c i1f.c ivf.c j0f.c j1f.c \ + jnf.c jvf.c k0f.c k1f.c knf.c logf.c log2f.c \ + log10f.c nbdtrf.c ndtrf.c ndtrif.c pdtrf.c polynf.c \ + powif.c powf.c psif.c rgammaf.c shichif.c sicif.c \ + sindgf.c sinf.c sinhf.c spencef.c sqrtf.c stdtrf.c \ + struvef.c tandgf.c tanf.c tanhf.c ynf.c zetaf.c \ + zetacf.c polevlf.c setprec.c mtherr.c +COBJS=$(patsubst %.c,%.o, $(CSRC)) + + +OBJS=$(COBJS) + +all: $(OBJS) $(LIBM) + +$(LIBM): ar-target + +ar-target: $(OBJS) + $(AR) $(ARFLAGS) $(LIBM) $(OBJS) + +$(COBJS): %.o : %.c + $(TARGET_CC) $(CFLAGS) -c $< -o $@ + $(STRIPTOOL) -x -R .note -R .comment $*.o + +$(OBJ): Makefile + +clean: + rm -f *.[oa] *~ core + diff --git a/libm/float/README.txt b/libm/float/README.txt new file mode 100644 index 000000000..30a10b083 --- /dev/null +++ b/libm/float/README.txt @@ -0,0 +1,4721 @@ +/* acoshf.c + * + * Inverse hyperbolic cosine + * + * + * + * SYNOPSIS: + * + * float x, y, acoshf(); + * + * y = acoshf( x ); + * + * + * + * DESCRIPTION: + * + * Returns inverse hyperbolic cosine of argument. + * + * If 1 <= x < 1.5, a polynomial approximation + * + * sqrt(z) * P(z) + * + * where z = x-1, is used. Otherwise, + * + * acosh(x) = log( x + sqrt( (x-1)(x+1) ). + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE 1,3 100000 1.8e-7 3.9e-8 + * IEEE 1,2000 100000 3.0e-8 + * + * + * ERROR MESSAGES: + * + * message condition value returned + * acoshf domain |x| < 1 0.0 + * + */ + +/* airy.c + * + * Airy function + * + * + * + * SYNOPSIS: + * + * float x, ai, aip, bi, bip; + * int airyf(); + * + * airyf( x, _&ai, _&aip, _&bi, _&bip ); + * + * + * + * DESCRIPTION: + * + * Solution of the differential equation + * + * y"(x) = xy. + * + * The function returns the two independent solutions Ai, Bi + * and their first derivatives Ai'(x), Bi'(x). + * + * Evaluation is by power series summation for small x, + * by rational minimax approximations for large x. + * + * + * + * ACCURACY: + * Error criterion is absolute when function <= 1, relative + * when function > 1, except * denotes relative error criterion. + * For large negative x, the absolute error increases as x^1.5. + * For large positive x, the relative error increases as x^1.5. + * + * Arithmetic domain function # trials peak rms + * IEEE -10, 0 Ai 50000 7.0e-7 1.2e-7 + * IEEE 0, 10 Ai 50000 9.9e-6* 6.8e-7* + * IEEE -10, 0 Ai' 50000 2.4e-6 3.5e-7 + * IEEE 0, 10 Ai' 50000 8.7e-6* 6.2e-7* + * IEEE -10, 10 Bi 100000 2.2e-6 2.6e-7 + * IEEE -10, 10 Bi' 50000 2.2e-6 3.5e-7 + * + */ + +/* asinf.c + * + * Inverse circular sine + * + * + * + * SYNOPSIS: + * + * float x, y, asinf(); + * + * y = asinf( x ); + * + * + * + * DESCRIPTION: + * + * Returns radian angle between -pi/2 and +pi/2 whose sine is x. + * + * A polynomial of the form x + x**3 P(x**2) + * is used for |x| in the interval [0, 0.5]. If |x| > 0.5 it is + * transformed by the identity + * + * asin(x) = pi/2 - 2 asin( sqrt( (1-x)/2 ) ). + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE -1, 1 100000 2.5e-7 5.0e-8 + * + * + * ERROR MESSAGES: + * + * message condition value returned + * asinf domain |x| > 1 0.0 + * + */ + /* acosf() + * + * Inverse circular cosine + * + * + * + * SYNOPSIS: + * + * float x, y, acosf(); + * + * y = acosf( x ); + * + * + * + * DESCRIPTION: + * + * Returns radian angle between -pi/2 and +pi/2 whose cosine + * is x. + * + * Analytically, acos(x) = pi/2 - asin(x). However if |x| is + * near 1, there is cancellation error in subtracting asin(x) + * from pi/2. Hence if x < -0.5, + * + * acos(x) = pi - 2.0 * asin( sqrt((1+x)/2) ); + * + * or if x > +0.5, + * + * acos(x) = 2.0 * asin( sqrt((1-x)/2) ). + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE -1, 1 100000 1.4e-7 4.2e-8 + * + * + * ERROR MESSAGES: + * + * message condition value returned + * acosf domain |x| > 1 0.0 + */ + +/* asinhf.c + * + * Inverse hyperbolic sine + * + * + * + * SYNOPSIS: + * + * float x, y, asinhf(); + * + * y = asinhf( x ); + * + * + * + * DESCRIPTION: + * + * Returns inverse hyperbolic sine of argument. + * + * If |x| < 0.5, the function is approximated by a rational + * form x + x**3 P(x)/Q(x). Otherwise, + * + * asinh(x) = log( x + sqrt(1 + x*x) ). + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE -3,3 100000 2.4e-7 4.1e-8 + * + */ + +/* atanf.c + * + * Inverse circular tangent + * (arctangent) + * + * + * + * SYNOPSIS: + * + * float x, y, atanf(); + * + * y = atanf( x ); + * + * + * + * DESCRIPTION: + * + * Returns radian angle between -pi/2 and +pi/2 whose tangent + * is x. + * + * Range reduction is from four intervals into the interval + * from zero to tan( pi/8 ). A polynomial approximates + * the function in this basic interval. + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE -10, 10 100000 1.9e-7 4.1e-8 + * + */ + /* atan2f() + * + * Quadrant correct inverse circular tangent + * + * + * + * SYNOPSIS: + * + * float x, y, z, atan2f(); + * + * z = atan2f( y, x ); + * + * + * + * DESCRIPTION: + * + * Returns radian angle whose tangent is y/x. + * Define compile time symbol ANSIC = 1 for ANSI standard, + * range -PI < z <= +PI, args (y,x); else ANSIC = 0 for range + * 0 to 2PI, args (x,y). + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE -10, 10 100000 1.9e-7 4.1e-8 + * See atan.c. + * + */ + +/* atanhf.c + * + * Inverse hyperbolic tangent + * + * + * + * SYNOPSIS: + * + * float x, y, atanhf(); + * + * y = atanhf( x ); + * + * + * + * DESCRIPTION: + * + * Returns inverse hyperbolic tangent of argument in the range + * MINLOGF to MAXLOGF. + * + * If |x| < 0.5, a polynomial approximation is used. + * Otherwise, + * atanh(x) = 0.5 * log( (1+x)/(1-x) ). + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE -1,1 100000 1.4e-7 3.1e-8 + * + */ + +/* bdtrf.c + * + * Binomial distribution + * + * + * + * SYNOPSIS: + * + * int k, n; + * float p, y, bdtrf(); + * + * y = bdtrf( k, n, p ); + * + * + * + * DESCRIPTION: + * + * Returns the sum of the terms 0 through k of the Binomial + * probability density: + * + * k + * -- ( n ) j n-j + * > ( ) p (1-p) + * -- ( j ) + * j=0 + * + * The terms are not summed directly; instead the incomplete + * beta integral is employed, according to the formula + * + * y = bdtr( k, n, p ) = incbet( n-k, k+1, 1-p ). + * + * The arguments must be positive, with p ranging from 0 to 1. + * + * + * + * ACCURACY: + * + * Relative error (p varies from 0 to 1): + * arithmetic domain # trials peak rms + * IEEE 0,100 2000 6.9e-5 1.1e-5 + * + * ERROR MESSAGES: + * + * message condition value returned + * bdtrf domain k < 0 0.0 + * n < k + * x < 0, x > 1 + * + */ + /* bdtrcf() + * + * Complemented binomial distribution + * + * + * + * SYNOPSIS: + * + * int k, n; + * float p, y, bdtrcf(); + * + * y = bdtrcf( k, n, p ); + * + * + * + * DESCRIPTION: + * + * Returns the sum of the terms k+1 through n of the Binomial + * probability density: + * + * n + * -- ( n ) j n-j + * > ( ) p (1-p) + * -- ( j ) + * j=k+1 + * + * The terms are not summed directly; instead the incomplete + * beta integral is employed, according to the formula + * + * y = bdtrc( k, n, p ) = incbet( k+1, n-k, p ). + * + * The arguments must be positive, with p ranging from 0 to 1. + * + * + * + * ACCURACY: + * + * Relative error (p varies from 0 to 1): + * arithmetic domain # trials peak rms + * IEEE 0,100 2000 6.0e-5 1.2e-5 + * + * ERROR MESSAGES: + * + * message condition value returned + * bdtrcf domain x<0, x>1, n<k 0.0 + */ + /* bdtrif() + * + * Inverse binomial distribution + * + * + * + * SYNOPSIS: + * + * int k, n; + * float p, y, bdtrif(); + * + * p = bdtrf( k, n, y ); + * + * + * + * DESCRIPTION: + * + * Finds the event probability p such that the sum of the + * terms 0 through k of the Binomial probability density + * is equal to the given cumulative probability y. + * + * This is accomplished using the inverse beta integral + * function and the relation + * + * 1 - p = incbi( n-k, k+1, y ). + * + * + * + * + * ACCURACY: + * + * Relative error (p varies from 0 to 1): + * arithmetic domain # trials peak rms + * IEEE 0,100 2000 3.5e-5 3.3e-6 + * + * ERROR MESSAGES: + * + * message condition value returned + * bdtrif domain k < 0, n <= k 0.0 + * x < 0, x > 1 + * + */ + +/* betaf.c + * + * Beta function + * + * + * + * SYNOPSIS: + * + * float a, b, y, betaf(); + * + * y = betaf( a, b ); + * + * + * + * DESCRIPTION: + * + * - - + * | (a) | (b) + * beta( a, b ) = -----------. + * - + * | (a+b) + * + * For large arguments the logarithm of the function is + * evaluated using lgam(), then exponentiated. + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE 0,30 10000 4.0e-5 6.0e-6 + * IEEE -20,0 10000 4.9e-3 5.4e-5 + * + * ERROR MESSAGES: + * + * message condition value returned + * betaf overflow log(beta) > MAXLOG 0.0 + * a or b <0 integer 0.0 + * + */ + +/* cbrtf.c + * + * Cube root + * + * + * + * SYNOPSIS: + * + * float x, y, cbrtf(); + * + * y = cbrtf( x ); + * + * + * + * DESCRIPTION: + * + * Returns the cube root of the argument, which may be negative. + * + * Range reduction involves determining the power of 2 of + * the argument. A polynomial of degree 2 applied to the + * mantissa, and multiplication by the cube root of 1, 2, or 4 + * approximates the root to within about 0.1%. Then Newton's + * iteration is used to converge to an accurate result. + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE 0,1e38 100000 7.6e-8 2.7e-8 + * + */ + +/* chbevlf.c + * + * Evaluate Chebyshev series + * + * + * + * SYNOPSIS: + * + * int N; + * float x, y, coef[N], chebevlf(); + * + * y = chbevlf( x, coef, N ); + * + * + * + * DESCRIPTION: + * + * Evaluates the series + * + * N-1 + * - ' + * y = > coef[i] T (x/2) + * - i + * i=0 + * + * of Chebyshev polynomials Ti at argument x/2. + * + * Coefficients are stored in reverse order, i.e. the zero + * order term is last in the array. Note N is the number of + * coefficients, not the order. + * + * If coefficients are for the interval a to b, x must + * have been transformed to x -> 2(2x - b - a)/(b-a) before + * entering the routine. This maps x from (a, b) to (-1, 1), + * over which the Chebyshev polynomials are defined. + * + * If the coefficients are for the inverted interval, in + * which (a, b) is mapped to (1/b, 1/a), the transformation + * required is x -> 2(2ab/x - b - a)/(b-a). If b is infinity, + * this becomes x -> 4a/x - 1. + * + * + * + * SPEED: + * + * Taking advantage of the recurrence properties of the + * Chebyshev polynomials, the routine requires one more + * addition per loop than evaluating a nested polynomial of + * the same degree. + * + */ + +/* chdtrf.c + * + * Chi-square distribution + * + * + * + * SYNOPSIS: + * + * float df, x, y, chdtrf(); + * + * y = chdtrf( df, x ); + * + * + * + * DESCRIPTION: + * + * Returns the area under the left hand tail (from 0 to x) + * of the Chi square probability density function with + * v degrees of freedom. + * + * + * inf. + * - + * 1 | | v/2-1 -t/2 + * P( x | v ) = ----------- | t e dt + * v/2 - | | + * 2 | (v/2) - + * x + * + * where x is the Chi-square variable. + * + * The incomplete gamma integral is used, according to the + * formula + * + * y = chdtr( v, x ) = igam( v/2.0, x/2.0 ). + * + * + * The arguments must both be positive. + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE 0,100 5000 3.2e-5 5.0e-6 + * + * ERROR MESSAGES: + * + * message condition value returned + * chdtrf domain x < 0 or v < 1 0.0 + */ + /* chdtrcf() + * + * Complemented Chi-square distribution + * + * + * + * SYNOPSIS: + * + * float v, x, y, chdtrcf(); + * + * y = chdtrcf( v, x ); + * + * + * + * DESCRIPTION: + * + * Returns the area under the right hand tail (from x to + * infinity) of the Chi square probability density function + * with v degrees of freedom: + * + * + * inf. + * - + * 1 | | v/2-1 -t/2 + * P( x | v ) = ----------- | t e dt + * v/2 - | | + * 2 | (v/2) - + * x + * + * where x is the Chi-square variable. + * + * The incomplete gamma integral is used, according to the + * formula + * + * y = chdtr( v, x ) = igamc( v/2.0, x/2.0 ). + * + * + * The arguments must both be positive. + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE 0,100 5000 2.7e-5 3.2e-6 + * + * ERROR MESSAGES: + * + * message condition value returned + * chdtrc domain x < 0 or v < 1 0.0 + */ + /* chdtrif() + * + * Inverse of complemented Chi-square distribution + * + * + * + * SYNOPSIS: + * + * float df, x, y, chdtrif(); + * + * x = chdtrif( df, y ); + * + * + * + * + * DESCRIPTION: + * + * Finds the Chi-square argument x such that the integral + * from x to infinity of the Chi-square density is equal + * to the given cumulative probability y. + * + * This is accomplished using the inverse gamma integral + * function and the relation + * + * x/2 = igami( df/2, y ); + * + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE 0,100 10000 2.2e-5 8.5e-7 + * + * ERROR MESSAGES: + * + * message condition value returned + * chdtri domain y < 0 or y > 1 0.0 + * v < 1 + * + */ + +/* clogf.c + * + * Complex natural logarithm + * + * + * + * SYNOPSIS: + * + * void clogf(); + * cmplxf z, w; + * + * clogf( &z, &w ); + * + * + * + * DESCRIPTION: + * + * Returns complex logarithm to the base e (2.718...) of + * the complex argument x. + * + * If z = x + iy, r = sqrt( x**2 + y**2 ), + * then + * w = log(r) + i arctan(y/x). + * + * The arctangent ranges from -PI to +PI. + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE -10,+10 30000 1.9e-6 6.2e-8 + * + * Larger relative error can be observed for z near 1 +i0. + * In IEEE arithmetic the peak absolute error is 3.1e-7. + * + */ + /* cexpf() + * + * Complex exponential function + * + * + * + * SYNOPSIS: + * + * void cexpf(); + * cmplxf z, w; + * + * cexpf( &z, &w ); + * + * + * + * DESCRIPTION: + * + * Returns the exponential of the complex argument z + * into the complex result w. + * + * If + * z = x + iy, + * r = exp(x), + * + * then + * + * w = r cos y + i r sin y. + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE -10,+10 30000 1.4e-7 4.5e-8 + * + */ + /* csinf() + * + * Complex circular sine + * + * + * + * SYNOPSIS: + * + * void csinf(); + * cmplxf z, w; + * + * csinf( &z, &w ); + * + * + * + * DESCRIPTION: + * + * If + * z = x + iy, + * + * then + * + * w = sin x cosh y + i cos x sinh y. + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE -10,+10 30000 1.9e-7 5.5e-8 + * + */ + /* ccosf() + * + * Complex circular cosine + * + * + * + * SYNOPSIS: + * + * void ccosf(); + * cmplxf z, w; + * + * ccosf( &z, &w ); + * + * + * + * DESCRIPTION: + * + * If + * z = x + iy, + * + * then + * + * w = cos x cosh y - i sin x sinh y. + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE -10,+10 30000 1.8e-7 5.5e-8 + */ + /* ctanf() + * + * Complex circular tangent + * + * + * + * SYNOPSIS: + * + * void ctanf(); + * cmplxf z, w; + * + * ctanf( &z, &w ); + * + * + * + * DESCRIPTION: + * + * If + * z = x + iy, + * + * then + * + * sin 2x + i sinh 2y + * w = --------------------. + * cos 2x + cosh 2y + * + * On the real axis the denominator is zero at odd multiples + * of PI/2. The denominator is evaluated by its Taylor + * series near these points. + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE -10,+10 30000 3.3e-7 5.1e-8 + */ + /* ccotf() + * + * Complex circular cotangent + * + * + * + * SYNOPSIS: + * + * void ccotf(); + * cmplxf z, w; + * + * ccotf( &z, &w ); + * + * + * + * DESCRIPTION: + * + * If + * z = x + iy, + * + * then + * + * sin 2x - i sinh 2y + * w = --------------------. + * cosh 2y - cos 2x + * + * On the real axis, the denominator has zeros at even + * multiples of PI/2. Near these points it is evaluated + * by a Taylor series. + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE -10,+10 30000 3.6e-7 5.7e-8 + * Also tested by ctan * ccot = 1 + i0. + */ + /* casinf() + * + * Complex circular arc sine + * + * + * + * SYNOPSIS: + * + * void casinf(); + * cmplxf z, w; + * + * casinf( &z, &w ); + * + * + * + * DESCRIPTION: + * + * Inverse complex sine: + * + * 2 + * w = -i clog( iz + csqrt( 1 - z ) ). + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE -10,+10 30000 1.1e-5 1.5e-6 + * Larger relative error can be observed for z near zero. + * + */ + /* cacosf() + * + * Complex circular arc cosine + * + * + * + * SYNOPSIS: + * + * void cacosf(); + * cmplxf z, w; + * + * cacosf( &z, &w ); + * + * + * + * DESCRIPTION: + * + * + * w = arccos z = PI/2 - arcsin z. + * + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE -10,+10 30000 9.2e-6 1.2e-6 + * + */ + /* catan() + * + * Complex circular arc tangent + * + * + * + * SYNOPSIS: + * + * void catan(); + * cmplxf z, w; + * + * catan( &z, &w ); + * + * + * + * DESCRIPTION: + * + * If + * z = x + iy, + * + * then + * 1 ( 2x ) + * Re w = - arctan(-----------) + k PI + * 2 ( 2 2) + * (1 - x - y ) + * + * ( 2 2) + * 1 (x + (y+1) ) + * Im w = - log(------------) + * 4 ( 2 2) + * (x + (y-1) ) + * + * Where k is an arbitrary integer. + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE -10,+10 30000 2.3e-6 5.2e-8 + * + */ + +/* cmplxf.c + * + * Complex number arithmetic + * + * + * + * SYNOPSIS: + * + * typedef struct { + * float r; real part + * float i; imaginary part + * }cmplxf; + * + * cmplxf *a, *b, *c; + * + * caddf( a, b, c ); c = b + a + * csubf( a, b, c ); c = b - a + * cmulf( a, b, c ); c = b * a + * cdivf( a, b, c ); c = b / a + * cnegf( c ); c = -c + * cmovf( b, c ); c = b + * + * + * + * DESCRIPTION: + * + * Addition: + * c.r = b.r + a.r + * c.i = b.i + a.i + * + * Subtraction: + * c.r = b.r - a.r + * c.i = b.i - a.i + * + * Multiplication: + * c.r = b.r * a.r - b.i * a.i + * c.i = b.r * a.i + b.i * a.r + * + * Division: + * d = a.r * a.r + a.i * a.i + * c.r = (b.r * a.r + b.i * a.i)/d + * c.i = (b.i * a.r - b.r * a.i)/d + * ACCURACY: + * + * In DEC arithmetic, the test (1/z) * z = 1 had peak relative + * error 3.1e-17, rms 1.2e-17. The test (y/z) * (z/y) = 1 had + * peak relative error 8.3e-17, rms 2.1e-17. + * + * Tests in the rectangle {-10,+10}: + * Relative error: + * arithmetic function # trials peak rms + * IEEE cadd 30000 5.9e-8 2.6e-8 + * IEEE csub 30000 6.0e-8 2.6e-8 + * IEEE cmul 30000 1.1e-7 3.7e-8 + * IEEE cdiv 30000 2.1e-7 5.7e-8 + */ + +/* cabsf() + * + * Complex absolute value + * + * + * + * SYNOPSIS: + * + * float cabsf(); + * cmplxf z; + * float a; + * + * a = cabsf( &z ); + * + * + * + * DESCRIPTION: + * + * + * If z = x + iy + * + * then + * + * a = sqrt( x**2 + y**2 ). + * + * Overflow and underflow are avoided by testing the magnitudes + * of x and y before squaring. If either is outside half of + * the floating point full scale range, both are rescaled. + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE -10,+10 30000 1.2e-7 3.4e-8 + */ + /* csqrtf() + * + * Complex square root + * + * + * + * SYNOPSIS: + * + * void csqrtf(); + * cmplxf z, w; + * + * csqrtf( &z, &w ); + * + * + * + * DESCRIPTION: + * + * + * If z = x + iy, r = |z|, then + * + * 1/2 + * Im w = [ (r - x)/2 ] , + * + * Re w = y / 2 Im w. + * + * + * Note that -w is also a square root of z. The solution + * reported is always in the upper half plane. + * + * Because of the potential for cancellation error in r - x, + * the result is sharpened by doing a Heron iteration + * (see sqrt.c) in complex arithmetic. + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE -10,+10 100000 1.8e-7 4.2e-8 + * + */ + +/* coshf.c + * + * Hyperbolic cosine + * + * + * + * SYNOPSIS: + * + * float x, y, coshf(); + * + * y = coshf( x ); + * + * + * + * DESCRIPTION: + * + * Returns hyperbolic cosine of argument in the range MINLOGF to + * MAXLOGF. + * + * cosh(x) = ( exp(x) + exp(-x) )/2. + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE +-MAXLOGF 100000 1.2e-7 2.8e-8 + * + * + * ERROR MESSAGES: + * + * message condition value returned + * coshf overflow |x| > MAXLOGF MAXNUMF + * + * + */ + +/* dawsnf.c + * + * Dawson's Integral + * + * + * + * SYNOPSIS: + * + * float x, y, dawsnf(); + * + * y = dawsnf( x ); + * + * + * + * DESCRIPTION: + * + * Approximates the integral + * + * x + * - + * 2 | | 2 + * dawsn(x) = exp( -x ) | exp( t ) dt + * | | + * - + * 0 + * + * Three different rational approximations are employed, for + * the intervals 0 to 3.25; 3.25 to 6.25; and 6.25 up. + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE 0,10 50000 4.4e-7 6.3e-8 + * + * + */ + +/* ellief.c + * + * Incomplete elliptic integral of the second kind + * + * + * + * SYNOPSIS: + * + * float phi, m, y, ellief(); + * + * y = ellief( phi, m ); + * + * + * + * DESCRIPTION: + * + * Approximates the integral + * + * + * phi + * - + * | | + * | 2 + * E(phi\m) = | sqrt( 1 - m sin t ) dt + * | + * | | + * - + * 0 + * + * of amplitude phi and modulus m, using the arithmetic - + * geometric mean algorithm. + * + * + * + * ACCURACY: + * + * Tested at random arguments with phi in [0, 2] and m in + * [0, 1]. + * Relative error: + * arithmetic domain # trials peak rms + * IEEE 0,2 10000 4.5e-7 7.4e-8 + * + * + */ + +/* ellikf.c + * + * Incomplete elliptic integral of the first kind + * + * + * + * SYNOPSIS: + * + * float phi, m, y, ellikf(); + * + * y = ellikf( phi, m ); + * + * + * + * DESCRIPTION: + * + * Approximates the integral + * + * + * + * phi + * - + * | | + * | dt + * F(phi\m) = | ------------------ + * | 2 + * | | sqrt( 1 - m sin t ) + * - + * 0 + * + * of amplitude phi and modulus m, using the arithmetic - + * geometric mean algorithm. + * + * + * + * + * ACCURACY: + * + * Tested at random points with phi in [0, 2] and m in + * [0, 1]. + * Relative error: + * arithmetic domain # trials peak rms + * IEEE 0,2 10000 2.9e-7 5.8e-8 + * + * + */ + +/* ellpef.c + * + * Complete elliptic integral of the second kind + * + * + * + * SYNOPSIS: + * + * float m1, y, ellpef(); + * + * y = ellpef( m1 ); + * + * + * + * DESCRIPTION: + * + * Approximates the integral + * + * + * pi/2 + * - + * | | 2 + * E(m) = | sqrt( 1 - m sin t ) dt + * | | + * - + * 0 + * + * Where m = 1 - m1, using the approximation + * + * P(x) - x log x Q(x). + * + * Though there are no singularities, the argument m1 is used + * rather than m for compatibility with ellpk(). + * + * E(1) = 1; E(0) = pi/2. + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE 0, 1 30000 1.1e-7 3.9e-8 + * + * + * ERROR MESSAGES: + * + * message condition value returned + * ellpef domain x<0, x>1 0.0 + * + */ + +/* ellpjf.c + * + * Jacobian Elliptic Functions + * + * + * + * SYNOPSIS: + * + * float u, m, sn, cn, dn, phi; + * int ellpj(); + * + * ellpj( u, m, _&sn, _&cn, _&dn, _&phi ); + * + * + * + * DESCRIPTION: + * + * + * Evaluates the Jacobian elliptic functions sn(u|m), cn(u|m), + * and dn(u|m) of parameter m between 0 and 1, and real + * argument u. + * + * These functions are periodic, with quarter-period on the + * real axis equal to the complete elliptic integral + * ellpk(1.0-m). + * + * Relation to incomplete elliptic integral: + * If u = ellik(phi,m), then sn(u|m) = sin(phi), + * and cn(u|m) = cos(phi). Phi is called the amplitude of u. + * + * Computation is by means of the arithmetic-geometric mean + * algorithm, except when m is within 1e-9 of 0 or 1. In the + * latter case with m close to 1, the approximation applies + * only for phi < pi/2. + * + * ACCURACY: + * + * Tested at random points with u between 0 and 10, m between + * 0 and 1. + * + * Absolute error (* = relative error): + * arithmetic function # trials peak rms + * IEEE sn 10000 1.7e-6 2.2e-7 + * IEEE cn 10000 1.6e-6 2.2e-7 + * IEEE dn 10000 1.4e-3 1.9e-5 + * IEEE phi 10000 3.9e-7* 6.7e-8* + * + * Peak error observed in consistency check using addition + * theorem for sn(u+v) was 4e-16 (absolute). Also tested by + * the above relation to the incomplete elliptic integral. + * Accuracy deteriorates when u is large. + * + */ + +/* ellpkf.c + * + * Complete elliptic integral of the first kind + * + * + * + * SYNOPSIS: + * + * float m1, y, ellpkf(); + * + * y = ellpkf( m1 ); + * + * + * + * DESCRIPTION: + * + * Approximates the integral + * + * + * + * pi/2 + * - + * | | + * | dt + * K(m) = | ------------------ + * | 2 + * | | sqrt( 1 - m sin t ) + * - + * 0 + * + * where m = 1 - m1, using the approximation + * + * P(x) - log x Q(x). + * + * The argument m1 is used rather than m so that the logarithmic + * singularity at m = 1 will be shifted to the origin; this + * preserves maximum accuracy. + * + * K(0) = pi/2. + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE 0,1 30000 1.3e-7 3.4e-8 + * + * ERROR MESSAGES: + * + * message condition value returned + * ellpkf domain x<0, x>1 0.0 + * + */ + +/* exp10f.c + * + * Base 10 exponential function + * (Common antilogarithm) + * + * + * + * SYNOPSIS: + * + * float x, y, exp10f(); + * + * y = exp10f( x ); + * + * + * + * DESCRIPTION: + * + * Returns 10 raised to the x power. + * + * Range reduction is accomplished by expressing the argument + * as 10**x = 2**n 10**f, with |f| < 0.5 log10(2). + * A polynomial approximates 10**f. + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE -38,+38 100000 9.8e-8 2.8e-8 + * + * ERROR MESSAGES: + * + * message condition value returned + * exp10 underflow x < -MAXL10 0.0 + * exp10 overflow x > MAXL10 MAXNUM + * + * IEEE single arithmetic: MAXL10 = 38.230809449325611792. + * + */ + +/* exp2f.c + * + * Base 2 exponential function + * + * + * + * SYNOPSIS: + * + * float x, y, exp2f(); + * + * y = exp2f( x ); + * + * + * + * DESCRIPTION: + * + * Returns 2 raised to the x power. + * + * Range reduction is accomplished by separating the argument + * into an integer k and fraction f such that + * x k f + * 2 = 2 2. + * + * A polynomial approximates 2**x in the basic range [-0.5, 0.5]. + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE -127,+127 100000 1.7e-7 2.8e-8 + * + * + * See exp.c for comments on error amplification. + * + * + * ERROR MESSAGES: + * + * message condition value returned + * exp underflow x < -MAXL2 0.0 + * exp overflow x > MAXL2 MAXNUMF + * + * For IEEE arithmetic, MAXL2 = 127. + */ + +/* expf.c + * + * Exponential function + * + * + * + * SYNOPSIS: + * + * float x, y, expf(); + * + * y = expf( x ); + * + * + * + * DESCRIPTION: + * + * Returns e (2.71828...) raised to the x power. + * + * Range reduction is accomplished by separating the argument + * into an integer k and fraction f such that + * + * x k f + * e = 2 e. + * + * A polynomial is used to approximate exp(f) + * in the basic range [-0.5, 0.5]. + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE +- MAXLOG 100000 1.7e-7 2.8e-8 + * + * + * Error amplification in the exponential function can be + * a serious matter. The error propagation involves + * exp( X(1+delta) ) = exp(X) ( 1 + X*delta + ... ), + * which shows that a 1 lsb error in representing X produces + * a relative error of X times 1 lsb in the function. + * While the routine gives an accurate result for arguments + * that are exactly represented by a double precision + * computer number, the result contains amplified roundoff + * error for large arguments not exactly represented. + * + * + * ERROR MESSAGES: + * + * message condition value returned + * expf underflow x < MINLOGF 0.0 + * expf overflow x > MAXLOGF MAXNUMF + * + */ + +/* expnf.c + * + * Exponential integral En + * + * + * + * SYNOPSIS: + * + * int n; + * float x, y, expnf(); + * + * y = expnf( n, x ); + * + * + * + * DESCRIPTION: + * + * Evaluates the exponential integral + * + * inf. + * - + * | | -xt + * | e + * E (x) = | ---- dt. + * n | n + * | | t + * - + * 1 + * + * + * Both n and x must be nonnegative. + * + * The routine employs either a power series, a continued + * fraction, or an asymptotic formula depending on the + * relative values of n and x. + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE 0, 30 10000 5.6e-7 1.2e-7 + * + */ + +/* facf.c + * + * Factorial function + * + * + * + * SYNOPSIS: + * + * float y, facf(); + * int i; + * + * y = facf( i ); + * + * + * + * DESCRIPTION: + * + * Returns factorial of i = 1 * 2 * 3 * ... * i. + * fac(0) = 1.0. + * + * Due to machine arithmetic bounds the largest value of + * i accepted is 33 in single precision arithmetic. + * Greater values, or negative ones, + * produce an error message and return MAXNUM. + * + * + * + * ACCURACY: + * + * For i < 34 the values are simply tabulated, and have + * full machine accuracy. + * + */ + +/* fdtrf.c + * + * F distribution + * + * + * + * SYNOPSIS: + * + * int df1, df2; + * float x, y, fdtrf(); + * + * y = fdtrf( df1, df2, x ); + * + * + * + * DESCRIPTION: + * + * Returns the area from zero to x under the F density + * function (also known as Snedcor's density or the + * variance ratio density). This is the density + * of x = (u1/df1)/(u2/df2), where u1 and u2 are random + * variables having Chi square distributions with df1 + * and df2 degrees of freedom, respectively. + * + * The incomplete beta integral is used, according to the + * formula + * + * P(x) = incbet( df1/2, df2/2, (df1*x/(df2 + df1*x) ). + * + * + * The arguments a and b are greater than zero, and x + * x is nonnegative. + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE 0,100 5000 2.2e-5 1.1e-6 + * + * ERROR MESSAGES: + * + * message condition value returned + * fdtrf domain a<0, b<0, x<0 0.0 + * + */ + /* fdtrcf() + * + * Complemented F distribution + * + * + * + * SYNOPSIS: + * + * int df1, df2; + * float x, y, fdtrcf(); + * + * y = fdtrcf( df1, df2, x ); + * + * + * + * DESCRIPTION: + * + * Returns the area from x to infinity under the F density + * function (also known as Snedcor's density or the + * variance ratio density). + * + * + * inf. + * - + * 1 | | a-1 b-1 + * 1-P(x) = ------ | t (1-t) dt + * B(a,b) | | + * - + * x + * + * (See fdtr.c.) + * + * The incomplete beta integral is used, according to the + * formula + * + * P(x) = incbet( df2/2, df1/2, (df2/(df2 + df1*x) ). + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE 0,100 5000 7.3e-5 1.2e-5 + * + * ERROR MESSAGES: + * + * message condition value returned + * fdtrcf domain a<0, b<0, x<0 0.0 + * + */ + /* fdtrif() + * + * Inverse of complemented F distribution + * + * + * + * SYNOPSIS: + * + * float df1, df2, x, y, fdtrif(); + * + * x = fdtrif( df1, df2, y ); + * + * + * + * + * DESCRIPTION: + * + * Finds the F density argument x such that the integral + * from x to infinity of the F density is equal to the + * given probability y. + * + * This is accomplished using the inverse beta integral + * function and the relations + * + * z = incbi( df2/2, df1/2, y ) + * x = df2 (1-z) / (df1 z). + * + * Note: the following relations hold for the inverse of + * the uncomplemented F distribution: + * + * z = incbi( df1/2, df2/2, y ) + * x = df2 z / (df1 (1-z)). + * + * + * + * ACCURACY: + * + * arithmetic domain # trials peak rms + * Absolute error: + * IEEE 0,100 5000 4.0e-5 3.2e-6 + * Relative error: + * IEEE 0,100 5000 1.2e-3 1.8e-5 + * + * ERROR MESSAGES: + * + * message condition value returned + * fdtrif domain y <= 0 or y > 1 0.0 + * v < 1 + * + */ + +/* ceilf() + * floorf() + * frexpf() + * ldexpf() + * + * Single precision floating point numeric utilities + * + * + * + * SYNOPSIS: + * + * float x, y; + * float ceilf(), floorf(), frexpf(), ldexpf(); + * int expnt, n; + * + * y = floorf(x); + * y = ceilf(x); + * y = frexpf( x, &expnt ); + * y = ldexpf( x, n ); + * + * + * + * DESCRIPTION: + * + * All four routines return a single precision floating point + * result. + * + * sfloor() returns the largest integer less than or equal to x. + * It truncates toward minus infinity. + * + * sceil() returns the smallest integer greater than or equal + * to x. It truncates toward plus infinity. + * + * sfrexp() extracts the exponent from x. It returns an integer + * power of two to expnt and the significand between 0.5 and 1 + * to y. Thus x = y * 2**expn. + * + * sldexp() multiplies x by 2**n. + * + * These functions are part of the standard C run time library + * for many but not all C compilers. The ones supplied are + * written in C for either DEC or IEEE arithmetic. They should + * be used only if your compiler library does not already have + * them. + * + * The IEEE versions assume that denormal numbers are implemented + * in the arithmetic. Some modifications will be required if + * the arithmetic has abrupt rather than gradual underflow. + */ + +/* fresnlf.c + * + * Fresnel integral + * + * + * + * SYNOPSIS: + * + * float x, S, C; + * void fresnlf(); + * + * fresnlf( x, _&S, _&C ); + * + * + * DESCRIPTION: + * + * Evaluates the Fresnel integrals + * + * x + * - + * | | + * C(x) = | cos(pi/2 t**2) dt, + * | | + * - + * 0 + * + * x + * - + * | | + * S(x) = | sin(pi/2 t**2) dt. + * | | + * - + * 0 + * + * + * The integrals are evaluated by power series for small x. + * For x >= 1 auxiliary functions f(x) and g(x) are employed + * such that + * + * C(x) = 0.5 + f(x) sin( pi/2 x**2 ) - g(x) cos( pi/2 x**2 ) + * S(x) = 0.5 - f(x) cos( pi/2 x**2 ) - g(x) sin( pi/2 x**2 ) + * + * + * + * ACCURACY: + * + * Relative error. + * + * Arithmetic function domain # trials peak rms + * IEEE S(x) 0, 10 30000 1.1e-6 1.9e-7 + * IEEE C(x) 0, 10 30000 1.1e-6 2.0e-7 + */ + +/* gammaf.c + * + * Gamma function + * + * + * + * SYNOPSIS: + * + * float x, y, gammaf(); + * extern int sgngamf; + * + * y = gammaf( x ); + * + * + * + * DESCRIPTION: + * + * Returns gamma function of the argument. The result is + * correctly signed, and the sign (+1 or -1) is also + * returned in a global (extern) variable named sgngamf. + * This same variable is also filled in by the logarithmic + * gamma function lgam(). + * + * Arguments between 0 and 10 are reduced by recurrence and the + * function is approximated by a polynomial function covering + * the interval (2,3). Large arguments are handled by Stirling's + * formula. Negative arguments are made positive using + * a reflection formula. + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE 0,-33 100,000 5.7e-7 1.0e-7 + * IEEE -33,0 100,000 6.1e-7 1.2e-7 + * + * + */ +/* lgamf() + * + * Natural logarithm of gamma function + * + * + * + * SYNOPSIS: + * + * float x, y, lgamf(); + * extern int sgngamf; + * + * y = lgamf( x ); + * + * + * + * DESCRIPTION: + * + * Returns the base e (2.718...) logarithm of the absolute + * value of the gamma function of the argument. + * The sign (+1 or -1) of the gamma function is returned in a + * global (extern) variable named sgngamf. + * + * For arguments greater than 6.5, the logarithm of the gamma + * function is approximated by the logarithmic version of + * Stirling's formula. Arguments between 0 and +6.5 are reduced by + * by recurrence to the interval [.75,1.25] or [1.5,2.5] of a rational + * approximation. The cosecant reflection formula is employed for + * arguments less than zero. + * + * Arguments greater than MAXLGM = 2.035093e36 return MAXNUM and an + * error message. + * + * + * + * ACCURACY: + * + * + * + * arithmetic domain # trials peak rms + * IEEE -100,+100 500,000 7.4e-7 6.8e-8 + * The error criterion was relative when the function magnitude + * was greater than one but absolute when it was less than one. + * The routine has low relative error for positive arguments. + * + * The following test used the relative error criterion. + * IEEE -2, +3 100000 4.0e-7 5.6e-8 + * + */ + +/* gdtrf.c + * + * Gamma distribution function + * + * + * + * SYNOPSIS: + * + * float a, b, x, y, gdtrf(); + * + * y = gdtrf( a, b, x ); + * + * + * + * DESCRIPTION: + * + * Returns the integral from zero to x of the gamma probability + * density function: + * + * + * x + * b - + * a | | b-1 -at + * y = ----- | t e dt + * - | | + * | (b) - + * 0 + * + * The incomplete gamma integral is used, according to the + * relation + * + * y = igam( b, ax ). + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE 0,100 5000 5.8e-5 3.0e-6 + * + * ERROR MESSAGES: + * + * message condition value returned + * gdtrf domain x < 0 0.0 + * + */ + /* gdtrcf.c + * + * Complemented gamma distribution function + * + * + * + * SYNOPSIS: + * + * float a, b, x, y, gdtrcf(); + * + * y = gdtrcf( a, b, x ); + * + * + * + * DESCRIPTION: + * + * Returns the integral from x to infinity of the gamma + * probability density function: + * + * + * inf. + * b - + * a | | b-1 -at + * y = ----- | t e dt + * - | | + * | (b) - + * x + * + * The incomplete gamma integral is used, according to the + * relation + * + * y = igamc( b, ax ). + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE 0,100 5000 9.1e-5 1.5e-5 + * + * ERROR MESSAGES: + * + * message condition value returned + * gdtrcf domain x < 0 0.0 + * + */ + +/* hyp2f1f.c + * + * Gauss hypergeometric function F + * 2 1 + * + * + * SYNOPSIS: + * + * float a, b, c, x, y, hyp2f1f(); + * + * y = hyp2f1f( a, b, c, x ); + * + * + * DESCRIPTION: + * + * + * hyp2f1( a, b, c, x ) = F ( a, b; c; x ) + * 2 1 + * + * inf. + * - a(a+1)...(a+k) b(b+1)...(b+k) k+1 + * = 1 + > ----------------------------- x . + * - c(c+1)...(c+k) (k+1)! + * k = 0 + * + * Cases addressed are + * Tests and escapes for negative integer a, b, or c + * Linear transformation if c - a or c - b negative integer + * Special case c = a or c = b + * Linear transformation for x near +1 + * Transformation for x < -0.5 + * Psi function expansion if x > 0.5 and c - a - b integer + * Conditionally, a recurrence on c to make c-a-b > 0 + * + * |x| > 1 is rejected. + * + * The parameters a, b, c are considered to be integer + * valued if they are within 1.0e-6 of the nearest integer. + * + * ACCURACY: + * + * Relative error (-1 < x < 1): + * arithmetic domain # trials peak rms + * IEEE 0,3 30000 5.8e-4 4.3e-6 + */ + +/* hypergf.c + * + * Confluent hypergeometric function + * + * + * + * SYNOPSIS: + * + * float a, b, x, y, hypergf(); + * + * y = hypergf( a, b, x ); + * + * + * + * DESCRIPTION: + * + * Computes the confluent hypergeometric function + * + * 1 2 + * a x a(a+1) x + * F ( a,b;x ) = 1 + ---- + --------- + ... + * 1 1 b 1! b(b+1) 2! + * + * Many higher transcendental functions are special cases of + * this power series. + * + * As is evident from the formula, b must not be a negative + * integer or zero unless a is an integer with 0 >= a > b. + * + * The routine attempts both a direct summation of the series + * and an asymptotic expansion. In each case error due to + * roundoff, cancellation, and nonconvergence is estimated. + * The result with smaller estimated error is returned. + * + * + * + * ACCURACY: + * + * Tested at random points (a, b, x), all three variables + * ranging from 0 to 30. + * Relative error: + * arithmetic domain # trials peak rms + * IEEE 0,5 10000 6.6e-7 1.3e-7 + * IEEE 0,30 30000 1.1e-5 6.5e-7 + * + * Larger errors can be observed when b is near a negative + * integer or zero. Certain combinations of arguments yield + * serious cancellation error in the power series summation + * and also are not in the region of near convergence of the + * asymptotic series. An error message is printed if the + * self-estimated relative error is greater than 1.0e-3. + * + */ + +/* i0f.c + * + * Modified Bessel function of order zero + * + * + * + * SYNOPSIS: + * + * float x, y, i0(); + * + * y = i0f( x ); + * + * + * + * DESCRIPTION: + * + * Returns modified Bessel function of order zero of the + * argument. + * + * The function is defined as i0(x) = j0( ix ). + * + * The range is partitioned into the two intervals [0,8] and + * (8, infinity). Chebyshev polynomial expansions are employed + * in each interval. + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE 0,30 100000 4.0e-7 7.9e-8 + * + */ + /* i0ef.c + * + * Modified Bessel function of order zero, + * exponentially scaled + * + * + * + * SYNOPSIS: + * + * float x, y, i0ef(); + * + * y = i0ef( x ); + * + * + * + * DESCRIPTION: + * + * Returns exponentially scaled modified Bessel function + * of order zero of the argument. + * + * The function is defined as i0e(x) = exp(-|x|) j0( ix ). + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE 0,30 100000 3.7e-7 7.0e-8 + * See i0f(). + * + */ + +/* i1f.c + * + * Modified Bessel function of order one + * + * + * + * SYNOPSIS: + * + * float x, y, i1f(); + * + * y = i1f( x ); + * + * + * + * DESCRIPTION: + * + * Returns modified Bessel function of order one of the + * argument. + * + * The function is defined as i1(x) = -i j1( ix ). + * + * The range is partitioned into the two intervals [0,8] and + * (8, infinity). Chebyshev polynomial expansions are employed + * in each interval. + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE 0, 30 100000 1.5e-6 1.6e-7 + * + * + */ + /* i1ef.c + * + * Modified Bessel function of order one, + * exponentially scaled + * + * + * + * SYNOPSIS: + * + * float x, y, i1ef(); + * + * y = i1ef( x ); + * + * + * + * DESCRIPTION: + * + * Returns exponentially scaled modified Bessel function + * of order one of the argument. + * + * The function is defined as i1(x) = -i exp(-|x|) j1( ix ). + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE 0, 30 30000 1.5e-6 1.5e-7 + * See i1(). + * + */ + +/* igamf.c + * + * Incomplete gamma integral + * + * + * + * SYNOPSIS: + * + * float a, x, y, igamf(); + * + * y = igamf( a, x ); + * + * + * + * DESCRIPTION: + * + * The function is defined by + * + * x + * - + * 1 | | -t a-1 + * igam(a,x) = ----- | e t dt. + * - | | + * | (a) - + * 0 + * + * + * In this implementation both arguments must be positive. + * The integral is evaluated by either a power series or + * continued fraction expansion, depending on the relative + * values of a and x. + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE 0,30 20000 7.8e-6 5.9e-7 + * + */ + /* igamcf() + * + * Complemented incomplete gamma integral + * + * + * + * SYNOPSIS: + * + * float a, x, y, igamcf(); + * + * y = igamcf( a, x ); + * + * + * + * DESCRIPTION: + * + * The function is defined by + * + * + * igamc(a,x) = 1 - igam(a,x) + * + * inf. + * - + * 1 | | -t a-1 + * = ----- | e t dt. + * - | | + * | (a) - + * x + * + * + * In this implementation both arguments must be positive. + * The integral is evaluated by either a power series or + * continued fraction expansion, depending on the relative + * values of a and x. + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE 0,30 30000 7.8e-6 5.9e-7 + * + */ + +/* igamif() + * + * Inverse of complemented imcomplete gamma integral + * + * + * + * SYNOPSIS: + * + * float a, x, y, igamif(); + * + * x = igamif( a, y ); + * + * + * + * DESCRIPTION: + * + * Given y, the function finds x such that + * + * igamc( a, x ) = y. + * + * Starting with the approximate value + * + * 3 + * x = a t + * + * where + * + * t = 1 - d - ndtri(y) sqrt(d) + * + * and + * + * d = 1/9a, + * + * the routine performs up to 10 Newton iterations to find the + * root of igamc(a,x) - y = 0. + * + * + * ACCURACY: + * + * Tested for a ranging from 0 to 100 and x from 0 to 1. + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE 0,100 5000 1.0e-5 1.5e-6 + * + */ + +/* incbetf.c + * + * Incomplete beta integral + * + * + * SYNOPSIS: + * + * float a, b, x, y, incbetf(); + * + * y = incbetf( a, b, x ); + * + * + * DESCRIPTION: + * + * Returns incomplete beta integral of the arguments, evaluated + * from zero to x. The function is defined as + * + * x + * - - + * | (a+b) | | a-1 b-1 + * ----------- | t (1-t) dt. + * - - | | + * | (a) | (b) - + * 0 + * + * The domain of definition is 0 <= x <= 1. In this + * implementation a and b are restricted to positive values. + * The integral from x to 1 may be obtained by the symmetry + * relation + * + * 1 - incbet( a, b, x ) = incbet( b, a, 1-x ). + * + * The integral is evaluated by a continued fraction expansion. + * If a < 1, the function calls itself recursively after a + * transformation to increase a to a+1. + * + * ACCURACY: + * + * Tested at random points (a,b,x) with a and b in the indicated + * interval and x between 0 and 1. + * + * arithmetic domain # trials peak rms + * Relative error: + * IEEE 0,30 10000 3.7e-5 5.1e-6 + * IEEE 0,100 10000 1.7e-4 2.5e-5 + * The useful domain for relative error is limited by underflow + * of the single precision exponential function. + * Absolute error: + * IEEE 0,30 100000 2.2e-5 9.6e-7 + * IEEE 0,100 10000 6.5e-5 3.7e-6 + * + * Larger errors may occur for extreme ratios of a and b. + * + * ERROR MESSAGES: + * message condition value returned + * incbetf domain x<0, x>1 0.0 + */ + +/* incbif() + * + * Inverse of imcomplete beta integral + * + * + * + * SYNOPSIS: + * + * float a, b, x, y, incbif(); + * + * x = incbif( a, b, y ); + * + * + * + * DESCRIPTION: + * + * Given y, the function finds x such that + * + * incbet( a, b, x ) = y. + * + * the routine performs up to 10 Newton iterations to find the + * root of incbet(a,b,x) - y = 0. + * + * + * ACCURACY: + * + * Relative error: + * x a,b + * arithmetic domain domain # trials peak rms + * IEEE 0,1 0,100 5000 2.8e-4 8.3e-6 + * + * Overflow and larger errors may occur for one of a or b near zero + * and the other large. + */ + +/* ivf.c + * + * Modified Bessel function of noninteger order + * + * + * + * SYNOPSIS: + * + * float v, x, y, ivf(); + * + * y = ivf( v, x ); + * + * + * + * DESCRIPTION: + * + * Returns modified Bessel function of order v of the + * argument. If x is negative, v must be integer valued. + * + * The function is defined as Iv(x) = Jv( ix ). It is + * here computed in terms of the confluent hypergeometric + * function, according to the formula + * + * v -x + * Iv(x) = (x/2) e hyperg( v+0.5, 2v+1, 2x ) / gamma(v+1) + * + * If v is a negative integer, then v is replaced by -v. + * + * + * ACCURACY: + * + * Tested at random points (v, x), with v between 0 and + * 30, x between 0 and 28. + * arithmetic domain # trials peak rms + * Relative error: + * IEEE 0,15 3000 4.7e-6 5.4e-7 + * Absolute error (relative when function > 1) + * IEEE 0,30 5000 8.5e-6 1.3e-6 + * + * Accuracy is diminished if v is near a negative integer. + * The useful domain for relative error is limited by overflow + * of the single precision exponential function. + * + * See also hyperg.c. + * + */ + +/* j0f.c + * + * Bessel function of order zero + * + * + * + * SYNOPSIS: + * + * float x, y, j0f(); + * + * y = j0f( x ); + * + * + * + * DESCRIPTION: + * + * Returns Bessel function of order zero of the argument. + * + * The domain is divided into the intervals [0, 2] and + * (2, infinity). In the first interval the following polynomial + * approximation is used: + * + * + * 2 2 2 + * (w - r ) (w - r ) (w - r ) P(w) + * 1 2 3 + * + * 2 + * where w = x and the three r's are zeros of the function. + * + * In the second interval, the modulus and phase are approximated + * by polynomials of the form Modulus(x) = sqrt(1/x) Q(1/x) + * and Phase(x) = x + 1/x R(1/x^2) - pi/4. The function is + * + * j0(x) = Modulus(x) cos( Phase(x) ). + * + * + * + * ACCURACY: + * + * Absolute error: + * arithmetic domain # trials peak rms + * IEEE 0, 2 100000 1.3e-7 3.6e-8 + * IEEE 2, 32 100000 1.9e-7 5.4e-8 + * + */ + /* y0f.c + * + * Bessel function of the second kind, order zero + * + * + * + * SYNOPSIS: + * + * float x, y, y0f(); + * + * y = y0f( x ); + * + * + * + * DESCRIPTION: + * + * Returns Bessel function of the second kind, of order + * zero, of the argument. + * + * The domain is divided into the intervals [0, 2] and + * (2, infinity). In the first interval a rational approximation + * R(x) is employed to compute + * + * 2 2 2 + * y0(x) = (w - r ) (w - r ) (w - r ) R(x) + 2/pi ln(x) j0(x). + * 1 2 3 + * + * Thus a call to j0() is required. The three zeros are removed + * from R(x) to improve its numerical stability. + * + * In the second interval, the modulus and phase are approximated + * by polynomials of the form Modulus(x) = sqrt(1/x) Q(1/x) + * and Phase(x) = x + 1/x S(1/x^2) - pi/4. Then the function is + * + * y0(x) = Modulus(x) sin( Phase(x) ). + * + * + * + * + * ACCURACY: + * + * Absolute error, when y0(x) < 1; else relative error: + * + * arithmetic domain # trials peak rms + * IEEE 0, 2 100000 2.4e-7 3.4e-8 + * IEEE 2, 32 100000 1.8e-7 5.3e-8 + * + */ + +/* j1f.c + * + * Bessel function of order one + * + * + * + * SYNOPSIS: + * + * float x, y, j1f(); + * + * y = j1f( x ); + * + * + * + * DESCRIPTION: + * + * Returns Bessel function of order one of the argument. + * + * The domain is divided into the intervals [0, 2] and + * (2, infinity). In the first interval a polynomial approximation + * 2 + * (w - r ) x P(w) + * 1 + * 2 + * is used, where w = x and r is the first zero of the function. + * + * In the second interval, the modulus and phase are approximated + * by polynomials of the form Modulus(x) = sqrt(1/x) Q(1/x) + * and Phase(x) = x + 1/x R(1/x^2) - 3pi/4. The function is + * + * j0(x) = Modulus(x) cos( Phase(x) ). + * + * + * + * ACCURACY: + * + * Absolute error: + * arithmetic domain # trials peak rms + * IEEE 0, 2 100000 1.2e-7 2.5e-8 + * IEEE 2, 32 100000 2.0e-7 5.3e-8 + * + * + */ + /* y1.c + * + * Bessel function of second kind of order one + * + * + * + * SYNOPSIS: + * + * double x, y, y1(); + * + * y = y1( x ); + * + * + * + * DESCRIPTION: + * + * Returns Bessel function of the second kind of order one + * of the argument. + * + * The domain is divided into the intervals [0, 2] and + * (2, infinity). In the first interval a rational approximation + * R(x) is employed to compute + * + * 2 + * y0(x) = (w - r ) x R(x^2) + 2/pi (ln(x) j1(x) - 1/x) . + * 1 + * + * Thus a call to j1() is required. + * + * In the second interval, the modulus and phase are approximated + * by polynomials of the form Modulus(x) = sqrt(1/x) Q(1/x) + * and Phase(x) = x + 1/x S(1/x^2) - 3pi/4. Then the function is + * + * y0(x) = Modulus(x) sin( Phase(x) ). + * + * + * + * + * ACCURACY: + * + * Absolute error: + * arithmetic domain # trials peak rms + * IEEE 0, 2 100000 2.2e-7 4.6e-8 + * IEEE 2, 32 100000 1.9e-7 5.3e-8 + * + * (error criterion relative when |y1| > 1). + * + */ + +/* jnf.c + * + * Bessel function of integer order + * + * + * + * SYNOPSIS: + * + * int n; + * float x, y, jnf(); + * + * y = jnf( n, x ); + * + * + * + * DESCRIPTION: + * + * Returns Bessel function of order n, where n is a + * (possibly negative) integer. + * + * The ratio of jn(x) to j0(x) is computed by backward + * recurrence. First the ratio jn/jn-1 is found by a + * continued fraction expansion. Then the recurrence + * relating successive orders is applied until j0 or j1 is + * reached. + * + * If n = 0 or 1 the routine for j0 or j1 is called + * directly. + * + * + * + * ACCURACY: + * + * Absolute error: + * arithmetic range # trials peak rms + * IEEE 0, 15 30000 3.6e-7 3.6e-8 + * + * + * Not suitable for large n or x. Use jvf() instead. + * + */ + +/* jvf.c + * + * Bessel function of noninteger order + * + * + * + * SYNOPSIS: + * + * float v, x, y, jvf(); + * + * y = jvf( v, x ); + * + * + * + * DESCRIPTION: + * + * Returns Bessel function of order v of the argument, + * where v is real. Negative x is allowed if v is an integer. + * + * Several expansions are included: the ascending power + * series, the Hankel expansion, and two transitional + * expansions for large v. If v is not too large, it + * is reduced by recurrence to a region of best accuracy. + * + * The single precision routine accepts negative v, but with + * reduced accuracy. + * + * + * + * ACCURACY: + * Results for integer v are indicated by *. + * Error criterion is absolute, except relative when |jv()| > 1. + * + * arithmetic domain # trials peak rms + * v x + * IEEE 0,125 0,125 30000 2.0e-6 2.0e-7 + * IEEE -17,0 0,125 30000 1.1e-5 4.0e-7 + * IEEE -100,0 0,125 3000 1.5e-4 7.8e-6 + */ + +/* k0f.c + * + * Modified Bessel function, third kind, order zero + * + * + * + * SYNOPSIS: + * + * float x, y, k0f(); + * + * y = k0f( x ); + * + * + * + * DESCRIPTION: + * + * Returns modified Bessel function of the third kind + * of order zero of the argument. + * + * The range is partitioned into the two intervals [0,8] and + * (8, infinity). Chebyshev polynomial expansions are employed + * in each interval. + * + * + * + * ACCURACY: + * + * Tested at 2000 random points between 0 and 8. Peak absolute + * error (relative when K0 > 1) was 1.46e-14; rms, 4.26e-15. + * Relative error: + * arithmetic domain # trials peak rms + * IEEE 0, 30 30000 7.8e-7 8.5e-8 + * + * ERROR MESSAGES: + * + * message condition value returned + * K0 domain x <= 0 MAXNUM + * + */ + /* k0ef() + * + * Modified Bessel function, third kind, order zero, + * exponentially scaled + * + * + * + * SYNOPSIS: + * + * float x, y, k0ef(); + * + * y = k0ef( x ); + * + * + * + * DESCRIPTION: + * + * Returns exponentially scaled modified Bessel function + * of the third kind of order zero of the argument. + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE 0, 30 30000 8.1e-7 7.8e-8 + * See k0(). + * + */ + +/* k1f.c + * + * Modified Bessel function, third kind, order one + * + * + * + * SYNOPSIS: + * + * float x, y, k1f(); + * + * y = k1f( x ); + * + * + * + * DESCRIPTION: + * + * Computes the modified Bessel function of the third kind + * of order one of the argument. + * + * The range is partitioned into the two intervals [0,2] and + * (2, infinity). Chebyshev polynomial expansions are employed + * in each interval. + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE 0, 30 30000 4.6e-7 7.6e-8 + * + * ERROR MESSAGES: + * + * message condition value returned + * k1 domain x <= 0 MAXNUM + * + */ + /* k1ef.c + * + * Modified Bessel function, third kind, order one, + * exponentially scaled + * + * + * + * SYNOPSIS: + * + * float x, y, k1ef(); + * + * y = k1ef( x ); + * + * + * + * DESCRIPTION: + * + * Returns exponentially scaled modified Bessel function + * of the third kind of order one of the argument: + * + * k1e(x) = exp(x) * k1(x). + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE 0, 30 30000 4.9e-7 6.7e-8 + * See k1(). + * + */ + +/* knf.c + * + * Modified Bessel function, third kind, integer order + * + * + * + * SYNOPSIS: + * + * float x, y, knf(); + * int n; + * + * y = knf( n, x ); + * + * + * + * DESCRIPTION: + * + * Returns modified Bessel function of the third kind + * of order n of the argument. + * + * The range is partitioned into the two intervals [0,9.55] and + * (9.55, infinity). An ascending power series is used in the + * low range, and an asymptotic expansion in the high range. + * + * + * + * ACCURACY: + * + * Absolute error, relative when function > 1: + * arithmetic domain # trials peak rms + * IEEE 0,30 10000 2.0e-4 3.8e-6 + * + * Error is high only near the crossover point x = 9.55 + * between the two expansions used. + */ + +/* log10f.c + * + * Common logarithm + * + * + * + * SYNOPSIS: + * + * float x, y, log10f(); + * + * y = log10f( x ); + * + * + * + * DESCRIPTION: + * + * Returns logarithm to the base 10 of x. + * + * The argument is separated into its exponent and fractional + * parts. The logarithm of the fraction is approximated by + * + * log(1+x) = x - 0.5 x**2 + x**3 P(x). + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE 0.5, 2.0 100000 1.3e-7 3.4e-8 + * IEEE 0, MAXNUMF 100000 1.3e-7 2.6e-8 + * + * In the tests over the interval [0, MAXNUM], the logarithms + * of the random arguments were uniformly distributed over + * [-MAXL10, MAXL10]. + * + * ERROR MESSAGES: + * + * log10f singularity: x = 0; returns -MAXL10 + * log10f domain: x < 0; returns -MAXL10 + * MAXL10 = 38.230809449325611792 + */ + +/* log2f.c + * + * Base 2 logarithm + * + * + * + * SYNOPSIS: + * + * float x, y, log2f(); + * + * y = log2f( x ); + * + * + * + * DESCRIPTION: + * + * Returns the base 2 logarithm of x. + * + * The argument is separated into its exponent and fractional + * parts. If the exponent is between -1 and +1, the base e + * logarithm of the fraction is approximated by + * + * log(1+x) = x - 0.5 x**2 + x**3 P(x)/Q(x). + * + * Otherwise, setting z = 2(x-1)/x+1), + * + * log(x) = z + z**3 P(z)/Q(z). + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE exp(+-88) 100000 1.1e-7 2.4e-8 + * IEEE 0.5, 2.0 100000 1.1e-7 3.0e-8 + * + * In the tests over the interval [exp(+-88)], the logarithms + * of the random arguments were uniformly distributed. + * + * ERROR MESSAGES: + * + * log singularity: x = 0; returns MINLOGF/log(2) + * log domain: x < 0; returns MINLOGF/log(2) + */ + +/* logf.c + * + * Natural logarithm + * + * + * + * SYNOPSIS: + * + * float x, y, logf(); + * + * y = logf( x ); + * + * + * + * DESCRIPTION: + * + * Returns the base e (2.718...) logarithm of x. + * + * The argument is separated into its exponent and fractional + * parts. If the exponent is between -1 and +1, the logarithm + * of the fraction is approximated by + * + * log(1+x) = x - 0.5 x**2 + x**3 P(x) + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE 0.5, 2.0 100000 7.6e-8 2.7e-8 + * IEEE 1, MAXNUMF 100000 2.6e-8 + * + * In the tests over the interval [1, MAXNUM], the logarithms + * of the random arguments were uniformly distributed over + * [0, MAXLOGF]. + * + * ERROR MESSAGES: + * + * logf singularity: x = 0; returns MINLOG + * logf domain: x < 0; returns MINLOG + */ + +/* mtherr.c + * + * Library common error handling routine + * + * + * + * SYNOPSIS: + * + * char *fctnam; + * int code; + * void mtherr(); + * + * mtherr( fctnam, code ); + * + * + * + * DESCRIPTION: + * + * This routine may be called to report one of the following + * error conditions (in the include file math.h). + * + * Mnemonic Value Significance + * + * DOMAIN 1 argument domain error + * SING 2 function singularity + * OVERFLOW 3 overflow range error + * UNDERFLOW 4 underflow range error + * TLOSS 5 total loss of precision + * PLOSS 6 partial loss of precision + * EDOM 33 Unix domain error code + * ERANGE 34 Unix range error code + * + * The default version of the file prints the function name, + * passed to it by the pointer fctnam, followed by the + * error condition. The display is directed to the standard + * output device. The routine then returns to the calling + * program. Users may wish to modify the program to abort by + * calling exit() under severe error conditions such as domain + * errors. + * + * Since all error conditions pass control to this function, + * the display may be easily changed, eliminated, or directed + * to an error logging device. + * + * SEE ALSO: + * + * math.h + * + */ + +/* nbdtrf.c + * + * Negative binomial distribution + * + * + * + * SYNOPSIS: + * + * int k, n; + * float p, y, nbdtrf(); + * + * y = nbdtrf( k, n, p ); + * + * + * + * DESCRIPTION: + * + * Returns the sum of the terms 0 through k of the negative + * binomial distribution: + * + * k + * -- ( n+j-1 ) n j + * > ( ) p (1-p) + * -- ( j ) + * j=0 + * + * In a sequence of Bernoulli trials, this is the probability + * that k or fewer failures precede the nth success. + * + * The terms are not computed individually; instead the incomplete + * beta integral is employed, according to the formula + * + * y = nbdtr( k, n, p ) = incbet( n, k+1, p ). + * + * The arguments must be positive, with p ranging from 0 to 1. + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE 0,100 5000 1.5e-4 1.9e-5 + * + */ + /* nbdtrcf.c + * + * Complemented negative binomial distribution + * + * + * + * SYNOPSIS: + * + * int k, n; + * float p, y, nbdtrcf(); + * + * y = nbdtrcf( k, n, p ); + * + * + * + * DESCRIPTION: + * + * Returns the sum of the terms k+1 to infinity of the negative + * binomial distribution: + * + * inf + * -- ( n+j-1 ) n j + * > ( ) p (1-p) + * -- ( j ) + * j=k+1 + * + * The terms are not computed individually; instead the incomplete + * beta integral is employed, according to the formula + * + * y = nbdtrc( k, n, p ) = incbet( k+1, n, 1-p ). + * + * The arguments must be positive, with p ranging from 0 to 1. + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE 0,100 5000 1.4e-4 2.0e-5 + * + */ + +/* ndtrf.c + * + * Normal distribution function + * + * + * + * SYNOPSIS: + * + * float x, y, ndtrf(); + * + * y = ndtrf( x ); + * + * + * + * DESCRIPTION: + * + * Returns the area under the Gaussian probability density + * function, integrated from minus infinity to x: + * + * x + * - + * 1 | | 2 + * ndtr(x) = --------- | exp( - t /2 ) dt + * sqrt(2pi) | | + * - + * -inf. + * + * = ( 1 + erf(z) ) / 2 + * = erfc(z) / 2 + * + * where z = x/sqrt(2). Computation is via the functions + * erf and erfc. + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE -13,0 50000 1.5e-5 2.6e-6 + * + * + * ERROR MESSAGES: + * + * See erfcf(). + * + */ + /* erff.c + * + * Error function + * + * + * + * SYNOPSIS: + * + * float x, y, erff(); + * + * y = erff( x ); + * + * + * + * DESCRIPTION: + * + * The integral is + * + * x + * - + * 2 | | 2 + * erf(x) = -------- | exp( - t ) dt. + * sqrt(pi) | | + * - + * 0 + * + * The magnitude of x is limited to 9.231948545 for DEC + * arithmetic; 1 or -1 is returned outside this range. + * + * For 0 <= |x| < 1, erf(x) = x * P(x**2); otherwise + * erf(x) = 1 - erfc(x). + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE -9.3,9.3 50000 1.7e-7 2.8e-8 + * + */ + /* erfcf.c + * + * Complementary error function + * + * + * + * SYNOPSIS: + * + * float x, y, erfcf(); + * + * y = erfcf( x ); + * + * + * + * DESCRIPTION: + * + * + * 1 - erf(x) = + * + * inf. + * - + * 2 | | 2 + * erfc(x) = -------- | exp( - t ) dt + * sqrt(pi) | | + * - + * x + * + * + * For small x, erfc(x) = 1 - erf(x); otherwise polynomial + * approximations 1/x P(1/x**2) are computed. + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE -9.3,9.3 50000 3.9e-6 7.2e-7 + * + * + * ERROR MESSAGES: + * + * message condition value returned + * erfcf underflow x**2 > MAXLOGF 0.0 + * + * + */ + +/* ndtrif.c + * + * Inverse of Normal distribution function + * + * + * + * SYNOPSIS: + * + * float x, y, ndtrif(); + * + * x = ndtrif( y ); + * + * + * + * DESCRIPTION: + * + * Returns the argument, x, for which the area under the + * Gaussian probability density function (integrated from + * minus infinity to x) is equal to y. + * + * + * For small arguments 0 < y < exp(-2), the program computes + * z = sqrt( -2.0 * log(y) ); then the approximation is + * x = z - log(z)/z - (1/z) P(1/z) / Q(1/z). + * There are two rational functions P/Q, one for 0 < y < exp(-32) + * and the other for y up to exp(-2). For larger arguments, + * w = y - 0.5, and x/sqrt(2pi) = w + w**3 R(w**2)/S(w**2)). + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE 1e-38, 1 30000 3.6e-7 5.0e-8 + * + * + * ERROR MESSAGES: + * + * message condition value returned + * ndtrif domain x <= 0 -MAXNUM + * ndtrif domain x >= 1 MAXNUM + * + */ + +/* pdtrf.c + * + * Poisson distribution + * + * + * + * SYNOPSIS: + * + * int k; + * float m, y, pdtrf(); + * + * y = pdtrf( k, m ); + * + * + * + * DESCRIPTION: + * + * Returns the sum of the first k terms of the Poisson + * distribution: + * + * k j + * -- -m m + * > e -- + * -- j! + * j=0 + * + * The terms are not summed directly; instead the incomplete + * gamma integral is employed, according to the relation + * + * y = pdtr( k, m ) = igamc( k+1, m ). + * + * The arguments must both be positive. + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE 0,100 5000 6.9e-5 8.0e-6 + * + */ + /* pdtrcf() + * + * Complemented poisson distribution + * + * + * + * SYNOPSIS: + * + * int k; + * float m, y, pdtrcf(); + * + * y = pdtrcf( k, m ); + * + * + * + * DESCRIPTION: + * + * Returns the sum of the terms k+1 to infinity of the Poisson + * distribution: + * + * inf. j + * -- -m m + * > e -- + * -- j! + * j=k+1 + * + * The terms are not summed directly; instead the incomplete + * gamma integral is employed, according to the formula + * + * y = pdtrc( k, m ) = igam( k+1, m ). + * + * The arguments must both be positive. + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE 0,100 5000 8.4e-5 1.2e-5 + * + */ + /* pdtrif() + * + * Inverse Poisson distribution + * + * + * + * SYNOPSIS: + * + * int k; + * float m, y, pdtrf(); + * + * m = pdtrif( k, y ); + * + * + * + * + * DESCRIPTION: + * + * Finds the Poisson variable x such that the integral + * from 0 to x of the Poisson density is equal to the + * given probability y. + * + * This is accomplished using the inverse gamma integral + * function and the relation + * + * m = igami( k+1, y ). + * + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE 0,100 5000 8.7e-6 1.4e-6 + * + * ERROR MESSAGES: + * + * message condition value returned + * pdtri domain y < 0 or y >= 1 0.0 + * k < 0 + * + */ + +/* polevlf.c + * p1evlf.c + * + * Evaluate polynomial + * + * + * + * SYNOPSIS: + * + * int N; + * float x, y, coef[N+1], polevlf[]; + * + * y = polevlf( x, coef, N ); + * + * + * + * DESCRIPTION: + * + * Evaluates polynomial of degree N: + * + * 2 N + * y = C + C x + C x +...+ C x + * 0 1 2 N + * + * Coefficients are stored in reverse order: + * + * coef[0] = C , ..., coef[N] = C . + * N 0 + * + * The function p1evl() assumes that coef[N] = 1.0 and is + * omitted from the array. Its calling arguments are + * otherwise the same as polevl(). + * + * + * SPEED: + * + * In the interest of speed, there are no checks for out + * of bounds arithmetic. This routine is used by most of + * the functions in the library. Depending on available + * equipment features, the user may wish to rewrite the + * program in microcode or assembly language. + * + */ + +/* polynf.c + * polyrf.c + * Arithmetic operations on polynomials + * + * In the following descriptions a, b, c are polynomials of degree + * na, nb, nc respectively. The degree of a polynomial cannot + * exceed a run-time value MAXPOLF. An operation that attempts + * to use or generate a polynomial of higher degree may produce a + * result that suffers truncation at degree MAXPOL. The value of + * MAXPOL is set by calling the function + * + * polinif( maxpol ); + * + * where maxpol is the desired maximum degree. This must be + * done prior to calling any of the other functions in this module. + * Memory for internal temporary polynomial storage is allocated + * by polinif(). + * + * Each polynomial is represented by an array containing its + * coefficients, together with a separately declared integer equal + * to the degree of the polynomial. The coefficients appear in + * ascending order; that is, + * + * 2 na + * a(x) = a[0] + a[1] * x + a[2] * x + ... + a[na] * x . + * + * + * + * sum = poleva( a, na, x ); Evaluate polynomial a(t) at t = x. + * polprtf( a, na, D ); Print the coefficients of a to D digits. + * polclrf( a, na ); Set a identically equal to zero, up to a[na]. + * polmovf( a, na, b ); Set b = a. + * poladdf( a, na, b, nb, c ); c = b + a, nc = max(na,nb) + * polsubf( a, na, b, nb, c ); c = b - a, nc = max(na,nb) + * polmulf( a, na, b, nb, c ); c = b * a, nc = na+nb + * + * + * Division: + * + * i = poldivf( a, na, b, nb, c ); c = b / a, nc = MAXPOL + * + * returns i = the degree of the first nonzero coefficient of a. + * The computed quotient c must be divided by x^i. An error message + * is printed if a is identically zero. + * + * + * Change of variables: + * If a and b are polynomials, and t = a(x), then + * c(t) = b(a(x)) + * is a polynomial found by substituting a(x) for t. The + * subroutine call for this is + * + * polsbtf( a, na, b, nb, c ); + * + * + * Notes: + * poldivf() is an integer routine; polevaf() is float. + * Any of the arguments a, b, c may refer to the same array. + * + */ + +/* powf.c + * + * Power function + * + * + * + * SYNOPSIS: + * + * float x, y, z, powf(); + * + * z = powf( x, y ); + * + * + * + * DESCRIPTION: + * + * Computes x raised to the yth power. Analytically, + * + * x**y = exp( y log(x) ). + * + * Following Cody and Waite, this program uses a lookup table + * of 2**-i/16 and pseudo extended precision arithmetic to + * obtain an extra three bits of accuracy in both the logarithm + * and the exponential. + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE -10,10 100,000 1.4e-7 3.6e-8 + * 1/10 < x < 10, x uniformly distributed. + * -10 < y < 10, y uniformly distributed. + * + * + * ERROR MESSAGES: + * + * message condition value returned + * powf overflow x**y > MAXNUMF MAXNUMF + * powf underflow x**y < 1/MAXNUMF 0.0 + * powf domain x<0 and y noninteger 0.0 + * + */ + +/* powif.c + * + * Real raised to integer power + * + * + * + * SYNOPSIS: + * + * float x, y, powif(); + * int n; + * + * y = powif( x, n ); + * + * + * + * DESCRIPTION: + * + * Returns argument x raised to the nth power. + * The routine efficiently decomposes n as a sum of powers of + * two. The desired power is a product of two-to-the-kth + * powers of x. Thus to compute the 32767 power of x requires + * 28 multiplications instead of 32767 multiplications. + * + * + * + * ACCURACY: + * + * + * Relative error: + * arithmetic x domain n domain # trials peak rms + * IEEE .04,26 -26,26 100000 1.1e-6 2.0e-7 + * IEEE 1,2 -128,128 100000 1.1e-5 1.0e-6 + * + * Returns MAXNUMF on overflow, zero on underflow. + * + */ + +/* psif.c + * + * Psi (digamma) function + * + * + * SYNOPSIS: + * + * float x, y, psif(); + * + * y = psif( x ); + * + * + * DESCRIPTION: + * + * d - + * psi(x) = -- ln | (x) + * dx + * + * is the logarithmic derivative of the gamma function. + * For integer x, + * n-1 + * - + * psi(n) = -EUL + > 1/k. + * - + * k=1 + * + * This formula is used for 0 < n <= 10. If x is negative, it + * is transformed to a positive argument by the reflection + * formula psi(1-x) = psi(x) + pi cot(pi x). + * For general positive x, the argument is made greater than 10 + * using the recurrence psi(x+1) = psi(x) + 1/x. + * Then the following asymptotic expansion is applied: + * + * inf. B + * - 2k + * psi(x) = log(x) - 1/2x - > ------- + * - 2k + * k=1 2k x + * + * where the B2k are Bernoulli numbers. + * + * ACCURACY: + * Absolute error, relative when |psi| > 1 : + * arithmetic domain # trials peak rms + * IEEE -33,0 30000 8.2e-7 1.2e-7 + * IEEE 0,33 100000 7.3e-7 7.7e-8 + * + * ERROR MESSAGES: + * message condition value returned + * psi singularity x integer <=0 MAXNUMF + */ + +/* rgammaf.c + * + * Reciprocal gamma function + * + * + * + * SYNOPSIS: + * + * float x, y, rgammaf(); + * + * y = rgammaf( x ); + * + * + * + * DESCRIPTION: + * + * Returns one divided by the gamma function of the argument. + * + * The function is approximated by a Chebyshev expansion in + * the interval [0,1]. Range reduction is by recurrence + * for arguments between -34.034 and +34.84425627277176174. + * 1/MAXNUMF is returned for positive arguments outside this + * range. + * + * The reciprocal gamma function has no singularities, + * but overflow and underflow may occur for large arguments. + * These conditions return either MAXNUMF or 1/MAXNUMF with + * appropriate sign. + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE -34,+34 100000 8.9e-7 1.1e-7 + */ + +/* shichif.c + * + * Hyperbolic sine and cosine integrals + * + * + * + * SYNOPSIS: + * + * float x, Chi, Shi; + * + * shichi( x, &Chi, &Shi ); + * + * + * DESCRIPTION: + * + * Approximates the integrals + * + * x + * - + * | | cosh t - 1 + * Chi(x) = eul + ln x + | ----------- dt, + * | | t + * - + * 0 + * + * x + * - + * | | sinh t + * Shi(x) = | ------ dt + * | | t + * - + * 0 + * + * where eul = 0.57721566490153286061 is Euler's constant. + * The integrals are evaluated by power series for x < 8 + * and by Chebyshev expansions for x between 8 and 88. + * For large x, both functions approach exp(x)/2x. + * Arguments greater than 88 in magnitude return MAXNUM. + * + * + * ACCURACY: + * + * Test interval 0 to 88. + * Relative error: + * arithmetic function # trials peak rms + * IEEE Shi 20000 3.5e-7 7.0e-8 + * Absolute error, except relative when |Chi| > 1: + * IEEE Chi 20000 3.8e-7 7.6e-8 + */ + +/* sicif.c + * + * Sine and cosine integrals + * + * + * + * SYNOPSIS: + * + * float x, Ci, Si; + * + * sicif( x, &Si, &Ci ); + * + * + * DESCRIPTION: + * + * Evaluates the integrals + * + * x + * - + * | cos t - 1 + * Ci(x) = eul + ln x + | --------- dt, + * | t + * - + * 0 + * x + * - + * | sin t + * Si(x) = | ----- dt + * | t + * - + * 0 + * + * where eul = 0.57721566490153286061 is Euler's constant. + * The integrals are approximated by rational functions. + * For x > 8 auxiliary functions f(x) and g(x) are employed + * such that + * + * Ci(x) = f(x) sin(x) - g(x) cos(x) + * Si(x) = pi/2 - f(x) cos(x) - g(x) sin(x) + * + * + * ACCURACY: + * Test interval = [0,50]. + * Absolute error, except relative when > 1: + * arithmetic function # trials peak rms + * IEEE Si 30000 2.1e-7 4.3e-8 + * IEEE Ci 30000 3.9e-7 2.2e-8 + */ + +/* sindgf.c + * + * Circular sine of angle in degrees + * + * + * + * SYNOPSIS: + * + * float x, y, sindgf(); + * + * y = sindgf( x ); + * + * + * + * DESCRIPTION: + * + * Range reduction is into intervals of 45 degrees. + * + * Two polynomial approximating functions are employed. + * Between 0 and pi/4 the sine is approximated by + * x + x**3 P(x**2). + * Between pi/4 and pi/2 the cosine is represented as + * 1 - x**2 Q(x**2). + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE +-3600 100,000 1.2e-7 3.0e-8 + * + * ERROR MESSAGES: + * + * message condition value returned + * sin total loss x > 2^24 0.0 + * + */ + +/* cosdgf.c + * + * Circular cosine of angle in degrees + * + * + * + * SYNOPSIS: + * + * float x, y, cosdgf(); + * + * y = cosdgf( x ); + * + * + * + * DESCRIPTION: + * + * Range reduction is into intervals of 45 degrees. + * + * Two polynomial approximating functions are employed. + * Between 0 and pi/4 the cosine is approximated by + * 1 - x**2 Q(x**2). + * Between pi/4 and pi/2 the sine is represented as + * x + x**3 P(x**2). + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE -8192,+8192 100,000 3.0e-7 3.0e-8 + */ + +/* sinf.c + * + * Circular sine + * + * + * + * SYNOPSIS: + * + * float x, y, sinf(); + * + * y = sinf( x ); + * + * + * + * DESCRIPTION: + * + * Range reduction is into intervals of pi/4. The reduction + * error is nearly eliminated by contriving an extended precision + * modular arithmetic. + * + * Two polynomial approximating functions are employed. + * Between 0 and pi/4 the sine is approximated by + * x + x**3 P(x**2). + * Between pi/4 and pi/2 the cosine is represented as + * 1 - x**2 Q(x**2). + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE -4096,+4096 100,000 1.2e-7 3.0e-8 + * IEEE -8192,+8192 100,000 3.0e-7 3.0e-8 + * + * ERROR MESSAGES: + * + * message condition value returned + * sin total loss x > 2^24 0.0 + * + * Partial loss of accuracy begins to occur at x = 2^13 + * = 8192. Results may be meaningless for x >= 2^24 + * The routine as implemented flags a TLOSS error + * for x >= 2^24 and returns 0.0. + */ + +/* cosf.c + * + * Circular cosine + * + * + * + * SYNOPSIS: + * + * float x, y, cosf(); + * + * y = cosf( x ); + * + * + * + * DESCRIPTION: + * + * Range reduction is into intervals of pi/4. The reduction + * error is nearly eliminated by contriving an extended precision + * modular arithmetic. + * + * Two polynomial approximating functions are employed. + * Between 0 and pi/4 the cosine is approximated by + * 1 - x**2 Q(x**2). + * Between pi/4 and pi/2 the sine is represented as + * x + x**3 P(x**2). + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE -8192,+8192 100,000 3.0e-7 3.0e-8 + */ + +/* sinhf.c + * + * Hyperbolic sine + * + * + * + * SYNOPSIS: + * + * float x, y, sinhf(); + * + * y = sinhf( x ); + * + * + * + * DESCRIPTION: + * + * Returns hyperbolic sine of argument in the range MINLOGF to + * MAXLOGF. + * + * The range is partitioned into two segments. If |x| <= 1, a + * polynomial approximation is used. + * Otherwise the calculation is sinh(x) = ( exp(x) - exp(-x) )/2. + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE +-MAXLOG 100000 1.1e-7 2.9e-8 + * + */ + +/* spencef.c + * + * Dilogarithm + * + * + * + * SYNOPSIS: + * + * float x, y, spencef(); + * + * y = spencef( x ); + * + * + * + * DESCRIPTION: + * + * Computes the integral + * + * x + * - + * | | log t + * spence(x) = - | ----- dt + * | | t - 1 + * - + * 1 + * + * for x >= 0. A rational approximation gives the integral in + * the interval (0.5, 1.5). Transformation formulas for 1/x + * and 1-x are employed outside the basic expansion range. + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE 0,4 30000 4.4e-7 6.3e-8 + * + * + */ + +/* sqrtf.c + * + * Square root + * + * + * + * SYNOPSIS: + * + * float x, y, sqrtf(); + * + * y = sqrtf( x ); + * + * + * + * DESCRIPTION: + * + * Returns the square root of x. + * + * Range reduction involves isolating the power of two of the + * argument and using a polynomial approximation to obtain + * a rough value for the square root. Then Heron's iteration + * is used three times to converge to an accurate value. + * + * + * + * ACCURACY: + * + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE 0,1.e38 100000 8.7e-8 2.9e-8 + * + * + * ERROR MESSAGES: + * + * message condition value returned + * sqrtf domain x < 0 0.0 + * + */ + +/* stdtrf.c + * + * Student's t distribution + * + * + * + * SYNOPSIS: + * + * float t, stdtrf(); + * short k; + * + * y = stdtrf( k, t ); + * + * + * DESCRIPTION: + * + * Computes the integral from minus infinity to t of the Student + * t distribution with integer k > 0 degrees of freedom: + * + * t + * - + * | | + * - | 2 -(k+1)/2 + * | ( (k+1)/2 ) | ( x ) + * ---------------------- | ( 1 + --- ) dx + * - | ( k ) + * sqrt( k pi ) | ( k/2 ) | + * | | + * - + * -inf. + * + * Relation to incomplete beta integral: + * + * 1 - stdtr(k,t) = 0.5 * incbet( k/2, 1/2, z ) + * where + * z = k/(k + t**2). + * + * For t < -1, this is the method of computation. For higher t, + * a direct method is derived from integration by parts. + * Since the function is symmetric about t=0, the area under the + * right tail of the density is found by calling the function + * with -t instead of t. + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE +/- 100 5000 2.3e-5 2.9e-6 + */ + +/* struvef.c + * + * Struve function + * + * + * + * SYNOPSIS: + * + * float v, x, y, struvef(); + * + * y = struvef( v, x ); + * + * + * + * DESCRIPTION: + * + * Computes the Struve function Hv(x) of order v, argument x. + * Negative x is rejected unless v is an integer. + * + * This module also contains the hypergeometric functions 1F2 + * and 3F0 and a routine for the Bessel function Yv(x) with + * noninteger v. + * + * + * + * ACCURACY: + * + * v varies from 0 to 10. + * Absolute error (relative error when |Hv(x)| > 1): + * arithmetic domain # trials peak rms + * IEEE -10,10 100000 9.0e-5 4.0e-6 + * + */ + +/* tandgf.c + * + * Circular tangent of angle in degrees + * + * + * + * SYNOPSIS: + * + * float x, y, tandgf(); + * + * y = tandgf( x ); + * + * + * + * DESCRIPTION: + * + * Returns the circular tangent of the radian argument x. + * + * Range reduction is into intervals of 45 degrees. + * + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE +-2^24 50000 2.4e-7 4.8e-8 + * + * ERROR MESSAGES: + * + * message condition value returned + * tanf total loss x > 2^24 0.0 + * + */ + /* cotdgf.c + * + * Circular cotangent of angle in degrees + * + * + * + * SYNOPSIS: + * + * float x, y, cotdgf(); + * + * y = cotdgf( x ); + * + * + * + * DESCRIPTION: + * + * Range reduction is into intervals of 45 degrees. + * A common routine computes either the tangent or cotangent. + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE +-2^24 50000 2.4e-7 4.8e-8 + * + * + * ERROR MESSAGES: + * + * message condition value returned + * cot total loss x > 2^24 0.0 + * cot singularity x = 0 MAXNUMF + * + */ + +/* tanf.c + * + * Circular tangent + * + * + * + * SYNOPSIS: + * + * float x, y, tanf(); + * + * y = tanf( x ); + * + * + * + * DESCRIPTION: + * + * Returns the circular tangent of the radian argument x. + * + * Range reduction is modulo pi/4. A polynomial approximation + * is employed in the basic interval [0, pi/4]. + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE +-4096 100000 3.3e-7 4.5e-8 + * + * ERROR MESSAGES: + * + * message condition value returned + * tanf total loss x > 2^24 0.0 + * + */ + /* cotf.c + * + * Circular cotangent + * + * + * + * SYNOPSIS: + * + * float x, y, cotf(); + * + * y = cotf( x ); + * + * + * + * DESCRIPTION: + * + * Returns the circular cotangent of the radian argument x. + * A common routine computes either the tangent or cotangent. + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE +-4096 100000 3.0e-7 4.5e-8 + * + * + * ERROR MESSAGES: + * + * message condition value returned + * cot total loss x > 2^24 0.0 + * cot singularity x = 0 MAXNUMF + * + */ + +/* tanhf.c + * + * Hyperbolic tangent + * + * + * + * SYNOPSIS: + * + * float x, y, tanhf(); + * + * y = tanhf( x ); + * + * + * + * DESCRIPTION: + * + * Returns hyperbolic tangent of argument in the range MINLOG to + * MAXLOG. + * + * A polynomial approximation is used for |x| < 0.625. + * Otherwise, + * + * tanh(x) = sinh(x)/cosh(x) = 1 - 2/(exp(2x) + 1). + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE -2,2 100000 1.3e-7 2.6e-8 + * + */ + +/* ynf.c + * + * Bessel function of second kind of integer order + * + * + * + * SYNOPSIS: + * + * float x, y, ynf(); + * int n; + * + * y = ynf( n, x ); + * + * + * + * DESCRIPTION: + * + * Returns Bessel function of order n, where n is a + * (possibly negative) integer. + * + * The function is evaluated by forward recurrence on + * n, starting with values computed by the routines + * y0() and y1(). + * + * If n = 0 or 1 the routine for y0 or y1 is called + * directly. + * + * + * + * ACCURACY: + * + * + * Absolute error, except relative when y > 1: + * + * arithmetic domain # trials peak rms + * IEEE 0, 30 10000 2.3e-6 3.4e-7 + * + * + * ERROR MESSAGES: + * + * message condition value returned + * yn singularity x = 0 MAXNUMF + * yn overflow MAXNUMF + * + * Spot checked against tables for x, n between 0 and 100. + * + */ + + /* zetacf.c + * + * Riemann zeta function + * + * + * + * SYNOPSIS: + * + * float x, y, zetacf(); + * + * y = zetacf( x ); + * + * + * + * DESCRIPTION: + * + * + * + * inf. + * - -x + * zetac(x) = > k , x > 1, + * - + * k=2 + * + * is related to the Riemann zeta function by + * + * Riemann zeta(x) = zetac(x) + 1. + * + * Extension of the function definition for x < 1 is implemented. + * Zero is returned for x > log2(MAXNUM). + * + * An overflow error may occur for large negative x, due to the + * gamma function in the reflection formula. + * + * ACCURACY: + * + * Tabulated values have full machine accuracy. + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE 1,50 30000 5.5e-7 7.5e-8 + * + * + */ + +/* zetaf.c + * + * Riemann zeta function of two arguments + * + * + * + * SYNOPSIS: + * + * float x, q, y, zetaf(); + * + * y = zetaf( x, q ); + * + * + * + * DESCRIPTION: + * + * + * + * inf. + * - -x + * zeta(x,q) = > (k+q) + * - + * k=0 + * + * where x > 1 and q is not a negative integer or zero. + * The Euler-Maclaurin summation formula is used to obtain + * the expansion + * + * n + * - -x + * zeta(x,q) = > (k+q) + * - + * k=1 + * + * 1-x inf. B x(x+1)...(x+2j) + * (n+q) 1 - 2j + * + --------- - ------- + > -------------------- + * x-1 x - x+2j+1 + * 2(n+q) j=1 (2j)! (n+q) + * + * where the B2j are Bernoulli numbers. Note that (see zetac.c) + * zeta(x,1) = zetac(x) + 1. + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE 0,25 10000 6.9e-7 1.0e-7 + * + * Large arguments may produce underflow in powf(), in which + * case the results are inaccurate. + * + * REFERENCE: + * + * Gradshteyn, I. S., and I. M. Ryzhik, Tables of Integrals, + * Series, and Products, p. 1073; Academic Press, 1980. + * + */ diff --git a/libm/float/acoshf.c b/libm/float/acoshf.c new file mode 100644 index 000000000..c45206125 --- /dev/null +++ b/libm/float/acoshf.c @@ -0,0 +1,97 @@ +/* acoshf.c + * + * Inverse hyperbolic cosine + * + * + * + * SYNOPSIS: + * + * float x, y, acoshf(); + * + * y = acoshf( x ); + * + * + * + * DESCRIPTION: + * + * Returns inverse hyperbolic cosine of argument. + * + * If 1 <= x < 1.5, a polynomial approximation + * + * sqrt(z) * P(z) + * + * where z = x-1, is used. Otherwise, + * + * acosh(x) = log( x + sqrt( (x-1)(x+1) ). + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE 1,3 100000 1.8e-7 3.9e-8 + * IEEE 1,2000 100000 3.0e-8 + * + * + * ERROR MESSAGES: + * + * message condition value returned + * acoshf domain |x| < 1 0.0 + * + */ + +/* acosh.c */ + +/* +Cephes Math Library Release 2.2: June, 1992 +Copyright 1984, 1987, 1988, 1992 by Stephen L. Moshier +Direct inquiries to 30 Frost Street, Cambridge, MA 02140 +*/ + +/* Single precision inverse hyperbolic cosine + * test interval: [1.0, 1.5] + * trials: 10000 + * peak relative error: 1.7e-7 + * rms relative error: 5.0e-8 + * + * Copyright (C) 1989 by Stephen L. Moshier. All rights reserved. + */ +#include <math.h> +extern float LOGE2F; + +float sqrtf( float ); +float logf( float ); + +float acoshf( float xx ) +{ +float x, z; + +x = xx; +if( x < 1.0 ) + { + mtherr( "acoshf", DOMAIN ); + return(0.0); + } + +if( x > 1500.0 ) + return( logf(x) + LOGE2F ); + +z = x - 1.0; + +if( z < 0.5 ) + { + z = + (((( 1.7596881071E-3 * z + - 7.5272886713E-3) * z + + 2.6454905019E-2) * z + - 1.1784741703E-1) * z + + 1.4142135263E0) * sqrtf( z ); + } +else + { + z = sqrtf( z*(x+1.0) ); + z = logf(x + z); + } +return( z ); +} diff --git a/libm/float/airyf.c b/libm/float/airyf.c new file mode 100644 index 000000000..a84a5c861 --- /dev/null +++ b/libm/float/airyf.c @@ -0,0 +1,377 @@ +/* airy.c + * + * Airy function + * + * + * + * SYNOPSIS: + * + * float x, ai, aip, bi, bip; + * int airyf(); + * + * airyf( x, _&ai, _&aip, _&bi, _&bip ); + * + * + * + * DESCRIPTION: + * + * Solution of the differential equation + * + * y"(x) = xy. + * + * The function returns the two independent solutions Ai, Bi + * and their first derivatives Ai'(x), Bi'(x). + * + * Evaluation is by power series summation for small x, + * by rational minimax approximations for large x. + * + * + * + * ACCURACY: + * Error criterion is absolute when function <= 1, relative + * when function > 1, except * denotes relative error criterion. + * For large negative x, the absolute error increases as x^1.5. + * For large positive x, the relative error increases as x^1.5. + * + * Arithmetic domain function # trials peak rms + * IEEE -10, 0 Ai 50000 7.0e-7 1.2e-7 + * IEEE 0, 10 Ai 50000 9.9e-6* 6.8e-7* + * IEEE -10, 0 Ai' 50000 2.4e-6 3.5e-7 + * IEEE 0, 10 Ai' 50000 8.7e-6* 6.2e-7* + * IEEE -10, 10 Bi 100000 2.2e-6 2.6e-7 + * IEEE -10, 10 Bi' 50000 2.2e-6 3.5e-7 + * + */ + /* airy.c */ + +/* +Cephes Math Library Release 2.2: June, 1992 +Copyright 1984, 1987, 1989, 1992 by Stephen L. Moshier +Direct inquiries to 30 Frost Street, Cambridge, MA 02140 +*/ + +#include <math.h> + +static float c1 = 0.35502805388781723926; +static float c2 = 0.258819403792806798405; +static float sqrt3 = 1.732050807568877293527; +static float sqpii = 5.64189583547756286948E-1; +extern float PIF; + +extern float MAXNUMF, MACHEPF; +#define MAXAIRY 25.77 + +/* Note, these expansions are for double precision accuracy; + * they have not yet been redesigned for single precision. + */ +static float AN[8] = { + 3.46538101525629032477e-1, + 1.20075952739645805542e1, + 7.62796053615234516538e1, + 1.68089224934630576269e2, + 1.59756391350164413639e2, + 7.05360906840444183113e1, + 1.40264691163389668864e1, + 9.99999999999999995305e-1, +}; +static float AD[8] = { + 5.67594532638770212846e-1, + 1.47562562584847203173e1, + 8.45138970141474626562e1, + 1.77318088145400459522e2, + 1.64234692871529701831e2, + 7.14778400825575695274e1, + 1.40959135607834029598e1, + 1.00000000000000000470e0, +}; + + +static float APN[8] = { + 6.13759184814035759225e-1, + 1.47454670787755323881e1, + 8.20584123476060982430e1, + 1.71184781360976385540e2, + 1.59317847137141783523e2, + 6.99778599330103016170e1, + 1.39470856980481566958e1, + 1.00000000000000000550e0, +}; +static float APD[8] = { + 3.34203677749736953049e-1, + 1.11810297306158156705e1, + 7.11727352147859965283e1, + 1.58778084372838313640e2, + 1.53206427475809220834e2, + 6.86752304592780337944e1, + 1.38498634758259442477e1, + 9.99999999999999994502e-1, +}; + +static float BN16[5] = { +-2.53240795869364152689e-1, + 5.75285167332467384228e-1, +-3.29907036873225371650e-1, + 6.44404068948199951727e-2, +-3.82519546641336734394e-3, +}; +static float BD16[5] = { +/* 1.00000000000000000000e0,*/ +-7.15685095054035237902e0, + 1.06039580715664694291e1, +-5.23246636471251500874e0, + 9.57395864378383833152e-1, +-5.50828147163549611107e-2, +}; + +static float BPPN[5] = { + 4.65461162774651610328e-1, +-1.08992173800493920734e0, + 6.38800117371827987759e-1, +-1.26844349553102907034e-1, + 7.62487844342109852105e-3, +}; +static float BPPD[5] = { +/* 1.00000000000000000000e0,*/ +-8.70622787633159124240e0, + 1.38993162704553213172e1, +-7.14116144616431159572e0, + 1.34008595960680518666e0, +-7.84273211323341930448e-2, +}; + +static float AFN[9] = { +-1.31696323418331795333e-1, +-6.26456544431912369773e-1, +-6.93158036036933542233e-1, +-2.79779981545119124951e-1, +-4.91900132609500318020e-2, +-4.06265923594885404393e-3, +-1.59276496239262096340e-4, +-2.77649108155232920844e-6, +-1.67787698489114633780e-8, +}; +static float AFD[9] = { +/* 1.00000000000000000000e0,*/ + 1.33560420706553243746e1, + 3.26825032795224613948e1, + 2.67367040941499554804e1, + 9.18707402907259625840e0, + 1.47529146771666414581e0, + 1.15687173795188044134e-1, + 4.40291641615211203805e-3, + 7.54720348287414296618e-5, + 4.51850092970580378464e-7, +}; + +static float AGN[11] = { + 1.97339932091685679179e-2, + 3.91103029615688277255e-1, + 1.06579897599595591108e0, + 9.39169229816650230044e-1, + 3.51465656105547619242e-1, + 6.33888919628925490927e-2, + 5.85804113048388458567e-3, + 2.82851600836737019778e-4, + 6.98793669997260967291e-6, + 8.11789239554389293311e-8, + 3.41551784765923618484e-10, +}; +static float AGD[10] = { +/* 1.00000000000000000000e0,*/ + 9.30892908077441974853e0, + 1.98352928718312140417e1, + 1.55646628932864612953e1, + 5.47686069422975497931e0, + 9.54293611618961883998e-1, + 8.64580826352392193095e-2, + 4.12656523824222607191e-3, + 1.01259085116509135510e-4, + 1.17166733214413521882e-6, + 4.91834570062930015649e-9, +}; + +static float APFN[9] = { + 1.85365624022535566142e-1, + 8.86712188052584095637e-1, + 9.87391981747398547272e-1, + 4.01241082318003734092e-1, + 7.10304926289631174579e-2, + 5.90618657995661810071e-3, + 2.33051409401776799569e-4, + 4.08718778289035454598e-6, + 2.48379932900442457853e-8, +}; +static float APFD[9] = { +/* 1.00000000000000000000e0,*/ + 1.47345854687502542552e1, + 3.75423933435489594466e1, + 3.14657751203046424330e1, + 1.09969125207298778536e1, + 1.78885054766999417817e0, + 1.41733275753662636873e-1, + 5.44066067017226003627e-3, + 9.39421290654511171663e-5, + 5.65978713036027009243e-7, +}; + +static float APGN[11] = { +-3.55615429033082288335e-2, +-6.37311518129435504426e-1, +-1.70856738884312371053e0, +-1.50221872117316635393e0, +-5.63606665822102676611e-1, +-1.02101031120216891789e-1, +-9.48396695961445269093e-3, +-4.60325307486780994357e-4, +-1.14300836484517375919e-5, +-1.33415518685547420648e-7, +-5.63803833958893494476e-10, +}; +static float APGD[11] = { +/* 1.00000000000000000000e0,*/ + 9.85865801696130355144e0, + 2.16401867356585941885e1, + 1.73130776389749389525e1, + 6.17872175280828766327e0, + 1.08848694396321495475e0, + 9.95005543440888479402e-2, + 4.78468199683886610842e-3, + 1.18159633322838625562e-4, + 1.37480673554219441465e-6, + 5.79912514929147598821e-9, +}; + +#define fabsf(x) ( (x) < 0 ? -(x) : (x) ) + +float polevlf(float, float *, int); +float p1evlf(float, float *, int); +float sinf(float), cosf(float), expf(float), sqrtf(float); + +int airyf( float xx, float *ai, float *aip, float *bi, float *bip ) +{ +float x, z, zz, t, f, g, uf, ug, k, zeta, theta; +int domflg; + +x = xx; +domflg = 0; +if( x > MAXAIRY ) + { + *ai = 0; + *aip = 0; + *bi = MAXNUMF; + *bip = MAXNUMF; + return(-1); + } + +if( x < -2.09 ) + { + domflg = 15; + t = sqrtf(-x); + zeta = -2.0 * x * t / 3.0; + t = sqrtf(t); + k = sqpii / t; + z = 1.0/zeta; + zz = z * z; + uf = 1.0 + zz * polevlf( zz, AFN, 8 ) / p1evlf( zz, AFD, 9 ); + ug = z * polevlf( zz, AGN, 10 ) / p1evlf( zz, AGD, 10 ); + theta = zeta + 0.25 * PIF; + f = sinf( theta ); + g = cosf( theta ); + *ai = k * (f * uf - g * ug); + *bi = k * (g * uf + f * ug); + uf = 1.0 + zz * polevlf( zz, APFN, 8 ) / p1evlf( zz, APFD, 9 ); + ug = z * polevlf( zz, APGN, 10 ) / p1evlf( zz, APGD, 10 ); + k = sqpii * t; + *aip = -k * (g * uf + f * ug); + *bip = k * (f * uf - g * ug); + return(0); + } + +if( x >= 2.09 ) /* cbrt(9) */ + { + domflg = 5; + t = sqrtf(x); + zeta = 2.0 * x * t / 3.0; + g = expf( zeta ); + t = sqrtf(t); + k = 2.0 * t * g; + z = 1.0/zeta; + f = polevlf( z, AN, 7 ) / polevlf( z, AD, 7 ); + *ai = sqpii * f / k; + k = -0.5 * sqpii * t / g; + f = polevlf( z, APN, 7 ) / polevlf( z, APD, 7 ); + *aip = f * k; + + if( x > 8.3203353 ) /* zeta > 16 */ + { + f = z * polevlf( z, BN16, 4 ) / p1evlf( z, BD16, 5 ); + k = sqpii * g; + *bi = k * (1.0 + f) / t; + f = z * polevlf( z, BPPN, 4 ) / p1evlf( z, BPPD, 5 ); + *bip = k * t * (1.0 + f); + return(0); + } + } + +f = 1.0; +g = x; +t = 1.0; +uf = 1.0; +ug = x; +k = 1.0; +z = x * x * x; +while( t > MACHEPF ) + { + uf *= z; + k += 1.0; + uf /=k; + ug *= z; + k += 1.0; + ug /=k; + uf /=k; + f += uf; + k += 1.0; + ug /=k; + g += ug; + t = fabsf(uf/f); + } +uf = c1 * f; +ug = c2 * g; +if( (domflg & 1) == 0 ) + *ai = uf - ug; +if( (domflg & 2) == 0 ) + *bi = sqrt3 * (uf + ug); + +/* the deriviative of ai */ +k = 4.0; +uf = x * x/2.0; +ug = z/3.0; +f = uf; +g = 1.0 + ug; +uf /= 3.0; +t = 1.0; + +while( t > MACHEPF ) + { + uf *= z; + ug /=k; + k += 1.0; + ug *= z; + uf /=k; + f += uf; + k += 1.0; + ug /=k; + uf /=k; + g += ug; + k += 1.0; + t = fabsf(ug/g); + } + +uf = c1 * f; +ug = c2 * g; +if( (domflg & 4) == 0 ) + *aip = uf - ug; +if( (domflg & 8) == 0 ) + *bip = sqrt3 * (uf + ug); +return(0); +} diff --git a/libm/float/asinf.c b/libm/float/asinf.c new file mode 100644 index 000000000..c96d75acb --- /dev/null +++ b/libm/float/asinf.c @@ -0,0 +1,186 @@ +/* asinf.c + * + * Inverse circular sine + * + * + * + * SYNOPSIS: + * + * float x, y, asinf(); + * + * y = asinf( x ); + * + * + * + * DESCRIPTION: + * + * Returns radian angle between -pi/2 and +pi/2 whose sine is x. + * + * A polynomial of the form x + x**3 P(x**2) + * is used for |x| in the interval [0, 0.5]. If |x| > 0.5 it is + * transformed by the identity + * + * asin(x) = pi/2 - 2 asin( sqrt( (1-x)/2 ) ). + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE -1, 1 100000 2.5e-7 5.0e-8 + * + * + * ERROR MESSAGES: + * + * message condition value returned + * asinf domain |x| > 1 0.0 + * + */ + /* acosf() + * + * Inverse circular cosine + * + * + * + * SYNOPSIS: + * + * float x, y, acosf(); + * + * y = acosf( x ); + * + * + * + * DESCRIPTION: + * + * Returns radian angle between -pi/2 and +pi/2 whose cosine + * is x. + * + * Analytically, acos(x) = pi/2 - asin(x). However if |x| is + * near 1, there is cancellation error in subtracting asin(x) + * from pi/2. Hence if x < -0.5, + * + * acos(x) = pi - 2.0 * asin( sqrt((1+x)/2) ); + * + * or if x > +0.5, + * + * acos(x) = 2.0 * asin( sqrt((1-x)/2) ). + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE -1, 1 100000 1.4e-7 4.2e-8 + * + * + * ERROR MESSAGES: + * + * message condition value returned + * acosf domain |x| > 1 0.0 + */ + +/* asin.c */ + +/* +Cephes Math Library Release 2.2: June, 1992 +Copyright 1984, 1987, 1992 by Stephen L. Moshier +Direct inquiries to 30 Frost Street, Cambridge, MA 02140 +*/ + +/* Single precision circular arcsine + * test interval: [-0.5, +0.5] + * trials: 10000 + * peak relative error: 6.7e-8 + * rms relative error: 2.5e-8 + */ +#include <math.h> +extern float PIF, PIO2F; + +float sqrtf( float ); + +float asinf( float xx ) +{ +float a, x, z; +int sign, flag; + +x = xx; + +if( x > 0 ) + { + sign = 1; + a = x; + } +else + { + sign = -1; + a = -x; + } + +if( a > 1.0 ) + { + mtherr( "asinf", DOMAIN ); + return( 0.0 ); + } + +if( a < 1.0e-4 ) + { + z = a; + goto done; + } + +if( a > 0.5 ) + { + z = 0.5 * (1.0 - a); + x = sqrtf( z ); + flag = 1; + } +else + { + x = a; + z = x * x; + flag = 0; + } + +z = +(((( 4.2163199048E-2 * z + + 2.4181311049E-2) * z + + 4.5470025998E-2) * z + + 7.4953002686E-2) * z + + 1.6666752422E-1) * z * x + + x; + +if( flag != 0 ) + { + z = z + z; + z = PIO2F - z; + } +done: +if( sign < 0 ) + z = -z; +return( z ); +} + + + + +float acosf( float x ) +{ + +if( x < -1.0 ) + goto domerr; + +if( x < -0.5) + return( PIF - 2.0 * asinf( sqrtf(0.5*(1.0+x)) ) ); + +if( x > 1.0 ) + { +domerr: mtherr( "acosf", DOMAIN ); + return( 0.0 ); + } + +if( x > 0.5 ) + return( 2.0 * asinf( sqrtf(0.5*(1.0-x) ) ) ); + +return( PIO2F - asinf(x) ); +} + diff --git a/libm/float/asinhf.c b/libm/float/asinhf.c new file mode 100644 index 000000000..d3fbe10a7 --- /dev/null +++ b/libm/float/asinhf.c @@ -0,0 +1,88 @@ +/* asinhf.c + * + * Inverse hyperbolic sine + * + * + * + * SYNOPSIS: + * + * float x, y, asinhf(); + * + * y = asinhf( x ); + * + * + * + * DESCRIPTION: + * + * Returns inverse hyperbolic sine of argument. + * + * If |x| < 0.5, the function is approximated by a rational + * form x + x**3 P(x)/Q(x). Otherwise, + * + * asinh(x) = log( x + sqrt(1 + x*x) ). + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE -3,3 100000 2.4e-7 4.1e-8 + * + */ + +/* asinh.c */ + +/* +Cephes Math Library Release 2.2: June, 1992 +Copyright 1984, 1987, 1988, 1992 by Stephen L. Moshier +Direct inquiries to 30 Frost Street, Cambridge, MA 02140 +*/ + +/* Single precision inverse hyperbolic sine + * test interval: [-0.5, +0.5] + * trials: 10000 + * peak relative error: 8.8e-8 + * rms relative error: 3.2e-8 + */ +#include <math.h> +extern float LOGE2F; + +float logf( float ); +float sqrtf( float ); + +float asinhf( float xx ) +{ +float x, z; + +if( xx < 0 ) + x = -xx; +else + x = xx; + +if( x > 1500.0 ) + { + z = logf(x) + LOGE2F; + goto done; + } +z = x * x; +if( x < 0.5 ) + { + z = + ((( 2.0122003309E-2 * z + - 4.2699340972E-2) * z + + 7.4847586088E-2) * z + - 1.6666288134E-1) * z * x + + x; + } +else + { + z = sqrtf( z + 1.0 ); + z = logf( x + z ); + } +done: +if( xx < 0 ) + z = -z; +return( z ); +} + diff --git a/libm/float/atanf.c b/libm/float/atanf.c new file mode 100644 index 000000000..321e3be39 --- /dev/null +++ b/libm/float/atanf.c @@ -0,0 +1,190 @@ +/* atanf.c + * + * Inverse circular tangent + * (arctangent) + * + * + * + * SYNOPSIS: + * + * float x, y, atanf(); + * + * y = atanf( x ); + * + * + * + * DESCRIPTION: + * + * Returns radian angle between -pi/2 and +pi/2 whose tangent + * is x. + * + * Range reduction is from four intervals into the interval + * from zero to tan( pi/8 ). A polynomial approximates + * the function in this basic interval. + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE -10, 10 100000 1.9e-7 4.1e-8 + * + */ + /* atan2f() + * + * Quadrant correct inverse circular tangent + * + * + * + * SYNOPSIS: + * + * float x, y, z, atan2f(); + * + * z = atan2f( y, x ); + * + * + * + * DESCRIPTION: + * + * Returns radian angle whose tangent is y/x. + * Define compile time symbol ANSIC = 1 for ANSI standard, + * range -PI < z <= +PI, args (y,x); else ANSIC = 0 for range + * 0 to 2PI, args (x,y). + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE -10, 10 100000 1.9e-7 4.1e-8 + * See atan.c. + * + */ + +/* atan.c */ + + +/* +Cephes Math Library Release 2.2: June, 1992 +Copyright 1984, 1987, 1989, 1992 by Stephen L. Moshier +Direct inquiries to 30 Frost Street, Cambridge, MA 02140 +*/ + +/* Single precision circular arcsine + * test interval: [-tan(pi/8), +tan(pi/8)] + * trials: 10000 + * peak relative error: 7.7e-8 + * rms relative error: 2.9e-8 + */ +#include <math.h> +extern float PIF, PIO2F, PIO4F; + +float atanf( float xx ) +{ +float x, y, z; +int sign; + +x = xx; + +/* make argument positive and save the sign */ +if( xx < 0.0 ) + { + sign = -1; + x = -xx; + } +else + { + sign = 1; + x = xx; + } +/* range reduction */ +if( x > 2.414213562373095 ) /* tan 3pi/8 */ + { + y = PIO2F; + x = -( 1.0/x ); + } + +else if( x > 0.4142135623730950 ) /* tan pi/8 */ + { + y = PIO4F; + x = (x-1.0)/(x+1.0); + } +else + y = 0.0; + +z = x * x; +y += +((( 8.05374449538e-2 * z + - 1.38776856032E-1) * z + + 1.99777106478E-1) * z + - 3.33329491539E-1) * z * x + + x; + +if( sign < 0 ) + y = -y; + +return( y ); +} + + + + +float atan2f( float y, float x ) +{ +float z, w; +int code; + + +code = 0; + +if( x < 0.0 ) + code = 2; +if( y < 0.0 ) + code |= 1; + +if( x == 0.0 ) + { + if( code & 1 ) + { +#if ANSIC + return( -PIO2F ); +#else + return( 3.0*PIO2F ); +#endif + } + if( y == 0.0 ) + return( 0.0 ); + return( PIO2F ); + } + +if( y == 0.0 ) + { + if( code & 2 ) + return( PIF ); + return( 0.0 ); + } + + +switch( code ) + { + default: +#if ANSIC + case 0: + case 1: w = 0.0; break; + case 2: w = PIF; break; + case 3: w = -PIF; break; +#else + case 0: w = 0.0; break; + case 1: w = 2.0 * PIF; break; + case 2: + case 3: w = PIF; break; +#endif + } + +z = atanf( y/x ); + +return( w + z ); +} + diff --git a/libm/float/atanhf.c b/libm/float/atanhf.c new file mode 100644 index 000000000..dfadad09e --- /dev/null +++ b/libm/float/atanhf.c @@ -0,0 +1,92 @@ +/* atanhf.c + * + * Inverse hyperbolic tangent + * + * + * + * SYNOPSIS: + * + * float x, y, atanhf(); + * + * y = atanhf( x ); + * + * + * + * DESCRIPTION: + * + * Returns inverse hyperbolic tangent of argument in the range + * MINLOGF to MAXLOGF. + * + * If |x| < 0.5, a polynomial approximation is used. + * Otherwise, + * atanh(x) = 0.5 * log( (1+x)/(1-x) ). + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE -1,1 100000 1.4e-7 3.1e-8 + * + */ + +/* atanh.c */ + + +/* +Cephes Math Library Release 2.2: June, 1992 +Copyright (C) 1987, 1992 by Stephen L. Moshier +Direct inquiries to 30 Frost Street, Cambridge, MA 02140 +*/ + +/* Single precision inverse hyperbolic tangent + * test interval: [-0.5, +0.5] + * trials: 10000 + * peak relative error: 8.2e-8 + * rms relative error: 3.0e-8 + */ +#include <math.h> +extern float MAXNUMF; + +float logf( float ); + +float atanhf( float xx ) +{ +float x, z; + +x = xx; +if( x < 0 ) + z = -x; +else + z = x; +if( z >= 1.0 ) + { + if( x == 1.0 ) + return( MAXNUMF ); + if( x == -1.0 ) + return( -MAXNUMF ); + mtherr( "atanhl", DOMAIN ); + return( MAXNUMF ); + } + +if( z < 1.0e-4 ) + return(x); + +if( z < 0.5 ) + { + z = x * x; + z = + (((( 1.81740078349E-1 * z + + 8.24370301058E-2) * z + + 1.46691431730E-1) * z + + 1.99782164500E-1) * z + + 3.33337300303E-1) * z * x + + x; + } +else + { + z = 0.5 * logf( (1.0+x)/(1.0-x) ); + } +return( z ); +} diff --git a/libm/float/bdtrf.c b/libm/float/bdtrf.c new file mode 100644 index 000000000..e063f1c77 --- /dev/null +++ b/libm/float/bdtrf.c @@ -0,0 +1,247 @@ +/* bdtrf.c + * + * Binomial distribution + * + * + * + * SYNOPSIS: + * + * int k, n; + * float p, y, bdtrf(); + * + * y = bdtrf( k, n, p ); + * + * + * + * DESCRIPTION: + * + * Returns the sum of the terms 0 through k of the Binomial + * probability density: + * + * k + * -- ( n ) j n-j + * > ( ) p (1-p) + * -- ( j ) + * j=0 + * + * The terms are not summed directly; instead the incomplete + * beta integral is employed, according to the formula + * + * y = bdtr( k, n, p ) = incbet( n-k, k+1, 1-p ). + * + * The arguments must be positive, with p ranging from 0 to 1. + * + * + * + * ACCURACY: + * + * Relative error (p varies from 0 to 1): + * arithmetic domain # trials peak rms + * IEEE 0,100 2000 6.9e-5 1.1e-5 + * + * ERROR MESSAGES: + * + * message condition value returned + * bdtrf domain k < 0 0.0 + * n < k + * x < 0, x > 1 + * + */ + /* bdtrcf() + * + * Complemented binomial distribution + * + * + * + * SYNOPSIS: + * + * int k, n; + * float p, y, bdtrcf(); + * + * y = bdtrcf( k, n, p ); + * + * + * + * DESCRIPTION: + * + * Returns the sum of the terms k+1 through n of the Binomial + * probability density: + * + * n + * -- ( n ) j n-j + * > ( ) p (1-p) + * -- ( j ) + * j=k+1 + * + * The terms are not summed directly; instead the incomplete + * beta integral is employed, according to the formula + * + * y = bdtrc( k, n, p ) = incbet( k+1, n-k, p ). + * + * The arguments must be positive, with p ranging from 0 to 1. + * + * + * + * ACCURACY: + * + * Relative error (p varies from 0 to 1): + * arithmetic domain # trials peak rms + * IEEE 0,100 2000 6.0e-5 1.2e-5 + * + * ERROR MESSAGES: + * + * message condition value returned + * bdtrcf domain x<0, x>1, n<k 0.0 + */ + /* bdtrif() + * + * Inverse binomial distribution + * + * + * + * SYNOPSIS: + * + * int k, n; + * float p, y, bdtrif(); + * + * p = bdtrf( k, n, y ); + * + * + * + * DESCRIPTION: + * + * Finds the event probability p such that the sum of the + * terms 0 through k of the Binomial probability density + * is equal to the given cumulative probability y. + * + * This is accomplished using the inverse beta integral + * function and the relation + * + * 1 - p = incbi( n-k, k+1, y ). + * + * + * + * + * ACCURACY: + * + * Relative error (p varies from 0 to 1): + * arithmetic domain # trials peak rms + * IEEE 0,100 2000 3.5e-5 3.3e-6 + * + * ERROR MESSAGES: + * + * message condition value returned + * bdtrif domain k < 0, n <= k 0.0 + * x < 0, x > 1 + * + */ + +/* bdtr() */ + + +/* +Cephes Math Library Release 2.2: July, 1992 +Copyright 1984, 1987, 1992 by Stephen L. Moshier +Direct inquiries to 30 Frost Street, Cambridge, MA 02140 +*/ + +#include <math.h> + +#ifdef ANSIC +float incbetf(float, float, float), powf(float, float); +float incbif( float, float, float ); +#else +float incbetf(), powf(), incbif(); +#endif + +float bdtrcf( int k, int n, float pp ) +{ +float p, dk, dn; + +p = pp; +if( (p < 0.0) || (p > 1.0) ) + goto domerr; +if( k < 0 ) + return( 1.0 ); + +if( n < k ) + { +domerr: + mtherr( "bdtrcf", DOMAIN ); + return( 0.0 ); + } + +if( k == n ) + return( 0.0 ); +dn = n - k; +if( k == 0 ) + { + dk = 1.0 - powf( 1.0-p, dn ); + } +else + { + dk = k + 1; + dk = incbetf( dk, dn, p ); + } +return( dk ); +} + + + +float bdtrf( int k, int n, float pp ) +{ +float p, dk, dn; + +p = pp; +if( (p < 0.0) || (p > 1.0) ) + goto domerr; +if( (k < 0) || (n < k) ) + { +domerr: + mtherr( "bdtrf", DOMAIN ); + return( 0.0 ); + } + +if( k == n ) + return( 1.0 ); + +dn = n - k; +if( k == 0 ) + { + dk = powf( 1.0-p, dn ); + } +else + { + dk = k + 1; + dk = incbetf( dn, dk, 1.0 - p ); + } +return( dk ); +} + + +float bdtrif( int k, int n, float yy ) +{ +float y, dk, dn, p; + +y = yy; +if( (y < 0.0) || (y > 1.0) ) + goto domerr; +if( (k < 0) || (n <= k) ) + { +domerr: + mtherr( "bdtrif", DOMAIN ); + return( 0.0 ); + } + +dn = n - k; +if( k == 0 ) + { + p = 1.0 - powf( y, 1.0/dn ); + } +else + { + dk = k + 1; + p = 1.0 - incbif( dn, dk, y ); + } +return( p ); +} diff --git a/libm/float/betaf.c b/libm/float/betaf.c new file mode 100644 index 000000000..7a1963191 --- /dev/null +++ b/libm/float/betaf.c @@ -0,0 +1,122 @@ +/* betaf.c + * + * Beta function + * + * + * + * SYNOPSIS: + * + * float a, b, y, betaf(); + * + * y = betaf( a, b ); + * + * + * + * DESCRIPTION: + * + * - - + * | (a) | (b) + * beta( a, b ) = -----------. + * - + * | (a+b) + * + * For large arguments the logarithm of the function is + * evaluated using lgam(), then exponentiated. + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE 0,30 10000 4.0e-5 6.0e-6 + * IEEE -20,0 10000 4.9e-3 5.4e-5 + * + * ERROR MESSAGES: + * + * message condition value returned + * betaf overflow log(beta) > MAXLOG 0.0 + * a or b <0 integer 0.0 + * + */ + +/* beta.c */ + + +/* +Cephes Math Library Release 2.2: July, 1992 +Copyright 1984, 1987 by Stephen L. Moshier +Direct inquiries to 30 Frost Street, Cambridge, MA 02140 +*/ + +#include <math.h> + +#define fabsf(x) ( (x) < 0 ? -(x) : (x) ) + +#define MAXGAM 34.84425627277176174 + + +extern float MAXLOGF, MAXNUMF; +extern int sgngamf; + +#ifdef ANSIC +float gammaf(float), lgamf(float), expf(float), floorf(float); +#else +float gammaf(), lgamf(), expf(), floorf(); +#endif + +float betaf( float aa, float bb ) +{ +float a, b, y; +int sign; + +sign = 1; +a = aa; +b = bb; +if( a <= 0.0 ) + { + if( a == floorf(a) ) + goto over; + } +if( b <= 0.0 ) + { + if( b == floorf(b) ) + goto over; + } + + +y = a + b; +if( fabsf(y) > MAXGAM ) + { + y = lgamf(y); + sign *= sgngamf; /* keep track of the sign */ + y = lgamf(b) - y; + sign *= sgngamf; + y = lgamf(a) + y; + sign *= sgngamf; + if( y > MAXLOGF ) + { +over: + mtherr( "betaf", OVERFLOW ); + return( sign * MAXNUMF ); + } + return( sign * expf(y) ); + } + +y = gammaf(y); +if( y == 0.0 ) + goto over; + +if( a > b ) + { + y = gammaf(a)/y; + y *= gammaf(b); + } +else + { + y = gammaf(b)/y; + y *= gammaf(a); + } + +return(y); +} diff --git a/libm/float/cbrtf.c b/libm/float/cbrtf.c new file mode 100644 index 000000000..ca9b433d9 --- /dev/null +++ b/libm/float/cbrtf.c @@ -0,0 +1,119 @@ +/* cbrtf.c + * + * Cube root + * + * + * + * SYNOPSIS: + * + * float x, y, cbrtf(); + * + * y = cbrtf( x ); + * + * + * + * DESCRIPTION: + * + * Returns the cube root of the argument, which may be negative. + * + * Range reduction involves determining the power of 2 of + * the argument. A polynomial of degree 2 applied to the + * mantissa, and multiplication by the cube root of 1, 2, or 4 + * approximates the root to within about 0.1%. Then Newton's + * iteration is used to converge to an accurate result. + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE 0,1e38 100000 7.6e-8 2.7e-8 + * + */ + /* cbrt.c */ + +/* +Cephes Math Library Release 2.2: June, 1992 +Copyright 1984, 1987, 1988, 1992 by Stephen L. Moshier +Direct inquiries to 30 Frost Street, Cambridge, MA 02140 +*/ + + +#include <math.h> + +static float CBRT2 = 1.25992104989487316477; +static float CBRT4 = 1.58740105196819947475; + + +float frexpf(float, int *), ldexpf(float, int); + +float cbrtf( float xx ) +{ +int e, rem, sign; +float x, z; + +x = xx; +if( x == 0 ) + return( 0.0 ); +if( x > 0 ) + sign = 1; +else + { + sign = -1; + x = -x; + } + +z = x; +/* extract power of 2, leaving + * mantissa between 0.5 and 1 + */ +x = frexpf( x, &e ); + +/* Approximate cube root of number between .5 and 1, + * peak relative error = 9.2e-6 + */ +x = (((-0.13466110473359520655053 * x + + 0.54664601366395524503440 ) * x + - 0.95438224771509446525043 ) * x + + 1.1399983354717293273738 ) * x + + 0.40238979564544752126924; + +/* exponent divided by 3 */ +if( e >= 0 ) + { + rem = e; + e /= 3; + rem -= 3*e; + if( rem == 1 ) + x *= CBRT2; + else if( rem == 2 ) + x *= CBRT4; + } + + +/* argument less than 1 */ + +else + { + e = -e; + rem = e; + e /= 3; + rem -= 3*e; + if( rem == 1 ) + x /= CBRT2; + else if( rem == 2 ) + x /= CBRT4; + e = -e; + } + +/* multiply by power of 2 */ +x = ldexpf( x, e ); + +/* Newton iteration */ +x -= ( x - (z/(x*x)) ) * 0.333333333333; + +if( sign < 0 ) + x = -x; +return(x); +} diff --git a/libm/float/chbevlf.c b/libm/float/chbevlf.c new file mode 100644 index 000000000..343d00a22 --- /dev/null +++ b/libm/float/chbevlf.c @@ -0,0 +1,86 @@ +/* chbevlf.c + * + * Evaluate Chebyshev series + * + * + * + * SYNOPSIS: + * + * int N; + * float x, y, coef[N], chebevlf(); + * + * y = chbevlf( x, coef, N ); + * + * + * + * DESCRIPTION: + * + * Evaluates the series + * + * N-1 + * - ' + * y = > coef[i] T (x/2) + * - i + * i=0 + * + * of Chebyshev polynomials Ti at argument x/2. + * + * Coefficients are stored in reverse order, i.e. the zero + * order term is last in the array. Note N is the number of + * coefficients, not the order. + * + * If coefficients are for the interval a to b, x must + * have been transformed to x -> 2(2x - b - a)/(b-a) before + * entering the routine. This maps x from (a, b) to (-1, 1), + * over which the Chebyshev polynomials are defined. + * + * If the coefficients are for the inverted interval, in + * which (a, b) is mapped to (1/b, 1/a), the transformation + * required is x -> 2(2ab/x - b - a)/(b-a). If b is infinity, + * this becomes x -> 4a/x - 1. + * + * + * + * SPEED: + * + * Taking advantage of the recurrence properties of the + * Chebyshev polynomials, the routine requires one more + * addition per loop than evaluating a nested polynomial of + * the same degree. + * + */ + /* chbevl.c */ + +/* +Cephes Math Library Release 2.0: April, 1987 +Copyright 1985, 1987 by Stephen L. Moshier +Direct inquiries to 30 Frost Street, Cambridge, MA 02140 +*/ + +#ifdef ANSIC +float chbevlf( float x, float *array, int n ) +#else +float chbevlf( x, array, n ) +float x; +float *array; +int n; +#endif +{ +float b0, b1, b2, *p; +int i; + +p = array; +b0 = *p++; +b1 = 0.0; +i = n - 1; + +do + { + b2 = b1; + b1 = b0; + b0 = x * b1 - b2 + *p++; + } +while( --i ); + +return( 0.5*(b0-b2) ); +} diff --git a/libm/float/chdtrf.c b/libm/float/chdtrf.c new file mode 100644 index 000000000..53bd3d961 --- /dev/null +++ b/libm/float/chdtrf.c @@ -0,0 +1,210 @@ +/* chdtrf.c + * + * Chi-square distribution + * + * + * + * SYNOPSIS: + * + * float df, x, y, chdtrf(); + * + * y = chdtrf( df, x ); + * + * + * + * DESCRIPTION: + * + * Returns the area under the left hand tail (from 0 to x) + * of the Chi square probability density function with + * v degrees of freedom. + * + * + * inf. + * - + * 1 | | v/2-1 -t/2 + * P( x | v ) = ----------- | t e dt + * v/2 - | | + * 2 | (v/2) - + * x + * + * where x is the Chi-square variable. + * + * The incomplete gamma integral is used, according to the + * formula + * + * y = chdtr( v, x ) = igam( v/2.0, x/2.0 ). + * + * + * The arguments must both be positive. + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE 0,100 5000 3.2e-5 5.0e-6 + * + * ERROR MESSAGES: + * + * message condition value returned + * chdtrf domain x < 0 or v < 1 0.0 + */ + /* chdtrcf() + * + * Complemented Chi-square distribution + * + * + * + * SYNOPSIS: + * + * float v, x, y, chdtrcf(); + * + * y = chdtrcf( v, x ); + * + * + * + * DESCRIPTION: + * + * Returns the area under the right hand tail (from x to + * infinity) of the Chi square probability density function + * with v degrees of freedom: + * + * + * inf. + * - + * 1 | | v/2-1 -t/2 + * P( x | v ) = ----------- | t e dt + * v/2 - | | + * 2 | (v/2) - + * x + * + * where x is the Chi-square variable. + * + * The incomplete gamma integral is used, according to the + * formula + * + * y = chdtr( v, x ) = igamc( v/2.0, x/2.0 ). + * + * + * The arguments must both be positive. + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE 0,100 5000 2.7e-5 3.2e-6 + * + * ERROR MESSAGES: + * + * message condition value returned + * chdtrc domain x < 0 or v < 1 0.0 + */ + /* chdtrif() + * + * Inverse of complemented Chi-square distribution + * + * + * + * SYNOPSIS: + * + * float df, x, y, chdtrif(); + * + * x = chdtrif( df, y ); + * + * + * + * + * DESCRIPTION: + * + * Finds the Chi-square argument x such that the integral + * from x to infinity of the Chi-square density is equal + * to the given cumulative probability y. + * + * This is accomplished using the inverse gamma integral + * function and the relation + * + * x/2 = igami( df/2, y ); + * + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE 0,100 10000 2.2e-5 8.5e-7 + * + * ERROR MESSAGES: + * + * message condition value returned + * chdtri domain y < 0 or y > 1 0.0 + * v < 1 + * + */ + +/* chdtr() */ + + +/* +Cephes Math Library Release 2.2: July, 1992 +Copyright 1984, 1987, 1992 by Stephen L. Moshier +Direct inquiries to 30 Frost Street, Cambridge, MA 02140 +*/ + +#include <math.h> + +#ifdef ANSIC +float igamcf(float, float), igamf(float, float), igamif(float, float); +#else +float igamcf(), igamf(), igamif(); +#endif + +float chdtrcf(float dff, float xx) +{ +float df, x; + +df = dff; +x = xx; + +if( (x < 0.0) || (df < 1.0) ) + { + mtherr( "chdtrcf", DOMAIN ); + return(0.0); + } +return( igamcf( 0.5*df, 0.5*x ) ); +} + + +float chdtrf(float dff, float xx) +{ +float df, x; + +df = dff; +x = xx; +if( (x < 0.0) || (df < 1.0) ) + { + mtherr( "chdtrf", DOMAIN ); + return(0.0); + } +return( igamf( 0.5*df, 0.5*x ) ); +} + + +float chdtrif( float dff, float yy ) +{ +float y, df, x; + +y = yy; +df = dff; +if( (y < 0.0) || (y > 1.0) || (df < 1.0) ) + { + mtherr( "chdtrif", DOMAIN ); + return(0.0); + } + +x = igamif( 0.5 * df, y ); +return( 2.0 * x ); +} diff --git a/libm/float/clogf.c b/libm/float/clogf.c new file mode 100644 index 000000000..5f4944eba --- /dev/null +++ b/libm/float/clogf.c @@ -0,0 +1,669 @@ +/* clogf.c + * + * Complex natural logarithm + * + * + * + * SYNOPSIS: + * + * void clogf(); + * cmplxf z, w; + * + * clogf( &z, &w ); + * + * + * + * DESCRIPTION: + * + * Returns complex logarithm to the base e (2.718...) of + * the complex argument x. + * + * If z = x + iy, r = sqrt( x**2 + y**2 ), + * then + * w = log(r) + i arctan(y/x). + * + * The arctangent ranges from -PI to +PI. + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE -10,+10 30000 1.9e-6 6.2e-8 + * + * Larger relative error can be observed for z near 1 +i0. + * In IEEE arithmetic the peak absolute error is 3.1e-7. + * + */ + +#include <math.h> +extern float MAXNUMF, MACHEPF, PIF, PIO2F; +#ifdef ANSIC +float cabsf(cmplxf *), sqrtf(float), logf(float), atan2f(float, float); +float expf(float), sinf(float), cosf(float); +float coshf(float), sinhf(float), asinf(float); +float ctansf(cmplxf *), redupif(float); +void cchshf( float, float *, float * ); +void caddf( cmplxf *, cmplxf *, cmplxf * ); +void csqrtf( cmplxf *, cmplxf * ); +#else +float cabsf(), sqrtf(), logf(), atan2f(); +float expf(), sinf(), cosf(); +float coshf(), sinhf(), asinf(); +float ctansf(), redupif(); +void cchshf(), csqrtf(), caddf(); +#endif + +#define fabsf(x) ( (x) < 0 ? -(x) : (x) ) + +void clogf( z, w ) +register cmplxf *z, *w; +{ +float p, rr; + +/*rr = sqrtf( z->r * z->r + z->i * z->i );*/ +rr = cabsf(z); +p = logf(rr); +#if ANSIC +rr = atan2f( z->i, z->r ); +#else +rr = atan2f( z->r, z->i ); +if( rr > PIF ) + rr -= PIF + PIF; +#endif +w->i = rr; +w->r = p; +} + /* cexpf() + * + * Complex exponential function + * + * + * + * SYNOPSIS: + * + * void cexpf(); + * cmplxf z, w; + * + * cexpf( &z, &w ); + * + * + * + * DESCRIPTION: + * + * Returns the exponential of the complex argument z + * into the complex result w. + * + * If + * z = x + iy, + * r = exp(x), + * + * then + * + * w = r cos y + i r sin y. + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE -10,+10 30000 1.4e-7 4.5e-8 + * + */ + +void cexpf( z, w ) +register cmplxf *z, *w; +{ +float r; + +r = expf( z->r ); +w->r = r * cosf( z->i ); +w->i = r * sinf( z->i ); +} + /* csinf() + * + * Complex circular sine + * + * + * + * SYNOPSIS: + * + * void csinf(); + * cmplxf z, w; + * + * csinf( &z, &w ); + * + * + * + * DESCRIPTION: + * + * If + * z = x + iy, + * + * then + * + * w = sin x cosh y + i cos x sinh y. + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE -10,+10 30000 1.9e-7 5.5e-8 + * + */ + +void csinf( z, w ) +register cmplxf *z, *w; +{ +float ch, sh; + +cchshf( z->i, &ch, &sh ); +w->r = sinf( z->r ) * ch; +w->i = cosf( z->r ) * sh; +} + + + +/* calculate cosh and sinh */ + +void cchshf( float xx, float *c, float *s ) +{ +float x, e, ei; + +x = xx; +if( fabsf(x) <= 0.5f ) + { + *c = coshf(x); + *s = sinhf(x); + } +else + { + e = expf(x); + ei = 0.5f/e; + e = 0.5f * e; + *s = e - ei; + *c = e + ei; + } +} + + /* ccosf() + * + * Complex circular cosine + * + * + * + * SYNOPSIS: + * + * void ccosf(); + * cmplxf z, w; + * + * ccosf( &z, &w ); + * + * + * + * DESCRIPTION: + * + * If + * z = x + iy, + * + * then + * + * w = cos x cosh y - i sin x sinh y. + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE -10,+10 30000 1.8e-7 5.5e-8 + */ + +void ccosf( z, w ) +register cmplxf *z, *w; +{ +float ch, sh; + +cchshf( z->i, &ch, &sh ); +w->r = cosf( z->r ) * ch; +w->i = -sinf( z->r ) * sh; +} + /* ctanf() + * + * Complex circular tangent + * + * + * + * SYNOPSIS: + * + * void ctanf(); + * cmplxf z, w; + * + * ctanf( &z, &w ); + * + * + * + * DESCRIPTION: + * + * If + * z = x + iy, + * + * then + * + * sin 2x + i sinh 2y + * w = --------------------. + * cos 2x + cosh 2y + * + * On the real axis the denominator is zero at odd multiples + * of PI/2. The denominator is evaluated by its Taylor + * series near these points. + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE -10,+10 30000 3.3e-7 5.1e-8 + */ + +void ctanf( z, w ) +register cmplxf *z, *w; +{ +float d; + +d = cosf( 2.0f * z->r ) + coshf( 2.0f * z->i ); + +if( fabsf(d) < 0.25f ) + d = ctansf(z); + +if( d == 0.0f ) + { + mtherr( "ctanf", OVERFLOW ); + w->r = MAXNUMF; + w->i = MAXNUMF; + return; + } + +w->r = sinf( 2.0f * z->r ) / d; +w->i = sinhf( 2.0f * z->i ) / d; +} + /* ccotf() + * + * Complex circular cotangent + * + * + * + * SYNOPSIS: + * + * void ccotf(); + * cmplxf z, w; + * + * ccotf( &z, &w ); + * + * + * + * DESCRIPTION: + * + * If + * z = x + iy, + * + * then + * + * sin 2x - i sinh 2y + * w = --------------------. + * cosh 2y - cos 2x + * + * On the real axis, the denominator has zeros at even + * multiples of PI/2. Near these points it is evaluated + * by a Taylor series. + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE -10,+10 30000 3.6e-7 5.7e-8 + * Also tested by ctan * ccot = 1 + i0. + */ + +void ccotf( z, w ) +register cmplxf *z, *w; +{ +float d; + + +d = coshf(2.0f * z->i) - cosf(2.0f * z->r); + +if( fabsf(d) < 0.25f ) + d = ctansf(z); + +if( d == 0.0f ) + { + mtherr( "ccotf", OVERFLOW ); + w->r = MAXNUMF; + w->i = MAXNUMF; + return; + } + +d = 1.0f/d; +w->r = sinf( 2.0f * z->r ) * d; +w->i = -sinhf( 2.0f * z->i ) * d; +} + +/* Program to subtract nearest integer multiple of PI */ +/* extended precision value of PI: */ + +static float DP1 = 3.140625; +static float DP2 = 9.67502593994140625E-4; +static float DP3 = 1.509957990978376432E-7; + + +float redupif(float xx) +{ +float x, t; +long i; + +x = xx; +t = x/PIF; +if( t >= 0.0f ) + t += 0.5f; +else + t -= 0.5f; + +i = t; /* the multiple */ +t = i; +t = ((x - t * DP1) - t * DP2) - t * DP3; +return(t); +} + +/* Taylor series expansion for cosh(2y) - cos(2x) */ + +float ctansf(z) +cmplxf *z; +{ +float f, x, x2, y, y2, rn, t, d; + +x = fabsf( 2.0f * z->r ); +y = fabsf( 2.0f * z->i ); + +x = redupif(x); + +x = x * x; +y = y * y; +x2 = 1.0f; +y2 = 1.0f; +f = 1.0f; +rn = 0.0f; +d = 0.0f; +do + { + rn += 1.0f; + f *= rn; + rn += 1.0f; + f *= rn; + x2 *= x; + y2 *= y; + t = y2 + x2; + t /= f; + d += t; + + rn += 1.0f; + f *= rn; + rn += 1.0f; + f *= rn; + x2 *= x; + y2 *= y; + t = y2 - x2; + t /= f; + d += t; + } +while( fabsf(t/d) > MACHEPF ); +return(d); +} + /* casinf() + * + * Complex circular arc sine + * + * + * + * SYNOPSIS: + * + * void casinf(); + * cmplxf z, w; + * + * casinf( &z, &w ); + * + * + * + * DESCRIPTION: + * + * Inverse complex sine: + * + * 2 + * w = -i clog( iz + csqrt( 1 - z ) ). + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE -10,+10 30000 1.1e-5 1.5e-6 + * Larger relative error can be observed for z near zero. + * + */ + +void casinf( z, w ) +cmplxf *z, *w; +{ +float x, y; +static cmplxf ca, ct, zz, z2; +/* +float cn, n; +static float a, b, s, t, u, v, y2; +static cmplxf sum; +*/ + +x = z->r; +y = z->i; + +if( y == 0.0f ) + { + if( fabsf(x) > 1.0f ) + { + w->r = PIO2F; + w->i = 0.0f; + mtherr( "casinf", DOMAIN ); + } + else + { + w->r = asinf(x); + w->i = 0.0f; + } + return; + } + +/* Power series expansion */ +/* +b = cabsf(z); +if( b < 0.125 ) +{ +z2.r = (x - y) * (x + y); +z2.i = 2.0 * x * y; + +cn = 1.0; +n = 1.0; +ca.r = x; +ca.i = y; +sum.r = x; +sum.i = y; +do + { + ct.r = z2.r * ca.r - z2.i * ca.i; + ct.i = z2.r * ca.i + z2.i * ca.r; + ca.r = ct.r; + ca.i = ct.i; + + cn *= n; + n += 1.0; + cn /= n; + n += 1.0; + b = cn/n; + + ct.r *= b; + ct.i *= b; + sum.r += ct.r; + sum.i += ct.i; + b = fabsf(ct.r) + fabsf(ct.i); + } +while( b > MACHEPF ); +w->r = sum.r; +w->i = sum.i; +return; +} +*/ + + +ca.r = x; +ca.i = y; + +ct.r = -ca.i; /* iz */ +ct.i = ca.r; + + /* sqrt( 1 - z*z) */ +/* cmul( &ca, &ca, &zz ) */ +zz.r = (ca.r - ca.i) * (ca.r + ca.i); /*x * x - y * y */ +zz.i = 2.0f * ca.r * ca.i; + +zz.r = 1.0f - zz.r; +zz.i = -zz.i; +csqrtf( &zz, &z2 ); + +caddf( &z2, &ct, &zz ); +clogf( &zz, &zz ); +w->r = zz.i; /* mult by 1/i = -i */ +w->i = -zz.r; +return; +} + /* cacosf() + * + * Complex circular arc cosine + * + * + * + * SYNOPSIS: + * + * void cacosf(); + * cmplxf z, w; + * + * cacosf( &z, &w ); + * + * + * + * DESCRIPTION: + * + * + * w = arccos z = PI/2 - arcsin z. + * + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE -10,+10 30000 9.2e-6 1.2e-6 + * + */ + +void cacosf( z, w ) +cmplxf *z, *w; +{ + +casinf( z, w ); +w->r = PIO2F - w->r; +w->i = -w->i; +} + /* catan() + * + * Complex circular arc tangent + * + * + * + * SYNOPSIS: + * + * void catan(); + * cmplxf z, w; + * + * catan( &z, &w ); + * + * + * + * DESCRIPTION: + * + * If + * z = x + iy, + * + * then + * 1 ( 2x ) + * Re w = - arctan(-----------) + k PI + * 2 ( 2 2) + * (1 - x - y ) + * + * ( 2 2) + * 1 (x + (y+1) ) + * Im w = - log(------------) + * 4 ( 2 2) + * (x + (y-1) ) + * + * Where k is an arbitrary integer. + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE -10,+10 30000 2.3e-6 5.2e-8 + * + */ + +void catanf( z, w ) +cmplxf *z, *w; +{ +float a, t, x, x2, y; + +x = z->r; +y = z->i; + +if( (x == 0.0f) && (y > 1.0f) ) + goto ovrf; + +x2 = x * x; +a = 1.0f - x2 - (y * y); +if( a == 0.0f ) + goto ovrf; + +#if ANSIC +t = 0.5f * atan2f( 2.0f * x, a ); +#else +t = 0.5f * atan2f( a, 2.0f * x ); +#endif +w->r = redupif( t ); + +t = y - 1.0f; +a = x2 + (t * t); +if( a == 0.0f ) + goto ovrf; + +t = y + 1.0f; +a = (x2 + (t * t))/a; +w->i = 0.25f*logf(a); +return; + +ovrf: +mtherr( "catanf", OVERFLOW ); +w->r = MAXNUMF; +w->i = MAXNUMF; +} diff --git a/libm/float/cmplxf.c b/libm/float/cmplxf.c new file mode 100644 index 000000000..949b94e3d --- /dev/null +++ b/libm/float/cmplxf.c @@ -0,0 +1,407 @@ +/* cmplxf.c + * + * Complex number arithmetic + * + * + * + * SYNOPSIS: + * + * typedef struct { + * float r; real part + * float i; imaginary part + * }cmplxf; + * + * cmplxf *a, *b, *c; + * + * caddf( a, b, c ); c = b + a + * csubf( a, b, c ); c = b - a + * cmulf( a, b, c ); c = b * a + * cdivf( a, b, c ); c = b / a + * cnegf( c ); c = -c + * cmovf( b, c ); c = b + * + * + * + * DESCRIPTION: + * + * Addition: + * c.r = b.r + a.r + * c.i = b.i + a.i + * + * Subtraction: + * c.r = b.r - a.r + * c.i = b.i - a.i + * + * Multiplication: + * c.r = b.r * a.r - b.i * a.i + * c.i = b.r * a.i + b.i * a.r + * + * Division: + * d = a.r * a.r + a.i * a.i + * c.r = (b.r * a.r + b.i * a.i)/d + * c.i = (b.i * a.r - b.r * a.i)/d + * ACCURACY: + * + * In DEC arithmetic, the test (1/z) * z = 1 had peak relative + * error 3.1e-17, rms 1.2e-17. The test (y/z) * (z/y) = 1 had + * peak relative error 8.3e-17, rms 2.1e-17. + * + * Tests in the rectangle {-10,+10}: + * Relative error: + * arithmetic function # trials peak rms + * IEEE cadd 30000 5.9e-8 2.6e-8 + * IEEE csub 30000 6.0e-8 2.6e-8 + * IEEE cmul 30000 1.1e-7 3.7e-8 + * IEEE cdiv 30000 2.1e-7 5.7e-8 + */ + /* cmplx.c + * complex number arithmetic + */ + + +/* +Cephes Math Library Release 2.1: December, 1988 +Copyright 1984, 1987, 1988 by Stephen L. Moshier +Direct inquiries to 30 Frost Street, Cambridge, MA 02140 +*/ + + +#include <math.h> +extern float MAXNUMF, MACHEPF, PIF, PIO2F; +#define fabsf(x) ( (x) < 0 ? -(x) : (x) ) +#ifdef ANSIC +float sqrtf(float), frexpf(float, int *); +float ldexpf(float, int); +float cabsf(cmplxf *), atan2f(float, float), cosf(float), sinf(float); +#else +float sqrtf(), frexpf(), ldexpf(); +float cabsf(), atan2f(), cosf(), sinf(); +#endif +/* +typedef struct + { + float r; + float i; + }cmplxf; +*/ +cmplxf czerof = {0.0, 0.0}; +extern cmplxf czerof; +cmplxf conef = {1.0, 0.0}; +extern cmplxf conef; + +/* c = b + a */ + +void caddf( a, b, c ) +register cmplxf *a, *b; +cmplxf *c; +{ + +c->r = b->r + a->r; +c->i = b->i + a->i; +} + + +/* c = b - a */ + +void csubf( a, b, c ) +register cmplxf *a, *b; +cmplxf *c; +{ + +c->r = b->r - a->r; +c->i = b->i - a->i; +} + +/* c = b * a */ + +void cmulf( a, b, c ) +register cmplxf *a, *b; +cmplxf *c; +{ +register float y; + +y = b->r * a->r - b->i * a->i; +c->i = b->r * a->i + b->i * a->r; +c->r = y; +} + + + +/* c = b / a */ + +void cdivf( a, b, c ) +register cmplxf *a, *b; +cmplxf *c; +{ +float y, p, q, w; + + +y = a->r * a->r + a->i * a->i; +p = b->r * a->r + b->i * a->i; +q = b->i * a->r - b->r * a->i; + +if( y < 1.0f ) + { + w = MAXNUMF * y; + if( (fabsf(p) > w) || (fabsf(q) > w) || (y == 0.0f) ) + { + c->r = MAXNUMF; + c->i = MAXNUMF; + mtherr( "cdivf", OVERFLOW ); + return; + } + } +c->r = p/y; +c->i = q/y; +} + + +/* b = a */ + +void cmovf( a, b ) +register short *a, *b; +{ +int i; + + +i = 8; +do + *b++ = *a++; +while( --i ); +} + + +void cnegf( a ) +register cmplxf *a; +{ + +a->r = -a->r; +a->i = -a->i; +} + +/* cabsf() + * + * Complex absolute value + * + * + * + * SYNOPSIS: + * + * float cabsf(); + * cmplxf z; + * float a; + * + * a = cabsf( &z ); + * + * + * + * DESCRIPTION: + * + * + * If z = x + iy + * + * then + * + * a = sqrt( x**2 + y**2 ). + * + * Overflow and underflow are avoided by testing the magnitudes + * of x and y before squaring. If either is outside half of + * the floating point full scale range, both are rescaled. + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE -10,+10 30000 1.2e-7 3.4e-8 + */ + + +/* +Cephes Math Library Release 2.1: January, 1989 +Copyright 1984, 1987, 1989 by Stephen L. Moshier +Direct inquiries to 30 Frost Street, Cambridge, MA 02140 +*/ + + +/* +typedef struct + { + float r; + float i; + }cmplxf; +*/ +/* square root of max and min numbers */ +#define SMAX 1.3043817825332782216E+19 +#define SMIN 7.6664670834168704053E-20 +#define PREC 12 +#define MAXEXPF 128 + + +#define SMAXT (2.0f * SMAX) +#define SMINT (0.5f * SMIN) + +float cabsf( z ) +register cmplxf *z; +{ +float x, y, b, re, im; +int ex, ey, e; + +re = fabsf( z->r ); +im = fabsf( z->i ); + +if( re == 0.0f ) + { + return( im ); + } +if( im == 0.0f ) + { + return( re ); + } + +/* Get the exponents of the numbers */ +x = frexpf( re, &ex ); +y = frexpf( im, &ey ); + +/* Check if one number is tiny compared to the other */ +e = ex - ey; +if( e > PREC ) + return( re ); +if( e < -PREC ) + return( im ); + +/* Find approximate exponent e of the geometric mean. */ +e = (ex + ey) >> 1; + +/* Rescale so mean is about 1 */ +x = ldexpf( re, -e ); +y = ldexpf( im, -e ); + +/* Hypotenuse of the right triangle */ +b = sqrtf( x * x + y * y ); + +/* Compute the exponent of the answer. */ +y = frexpf( b, &ey ); +ey = e + ey; + +/* Check it for overflow and underflow. */ +if( ey > MAXEXPF ) + { + mtherr( "cabsf", OVERFLOW ); + return( MAXNUMF ); + } +if( ey < -MAXEXPF ) + return(0.0f); + +/* Undo the scaling */ +b = ldexpf( b, e ); +return( b ); +} + /* csqrtf() + * + * Complex square root + * + * + * + * SYNOPSIS: + * + * void csqrtf(); + * cmplxf z, w; + * + * csqrtf( &z, &w ); + * + * + * + * DESCRIPTION: + * + * + * If z = x + iy, r = |z|, then + * + * 1/2 + * Im w = [ (r - x)/2 ] , + * + * Re w = y / 2 Im w. + * + * + * Note that -w is also a square root of z. The solution + * reported is always in the upper half plane. + * + * Because of the potential for cancellation error in r - x, + * the result is sharpened by doing a Heron iteration + * (see sqrt.c) in complex arithmetic. + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE -10,+10 100000 1.8e-7 4.2e-8 + * + */ + + +void csqrtf( z, w ) +cmplxf *z, *w; +{ +cmplxf q, s; +float x, y, r, t; + +x = z->r; +y = z->i; + +if( y == 0.0f ) + { + if( x < 0.0f ) + { + w->r = 0.0f; + w->i = sqrtf(-x); + return; + } + else + { + w->r = sqrtf(x); + w->i = 0.0f; + return; + } + } + +if( x == 0.0f ) + { + r = fabsf(y); + r = sqrtf(0.5f*r); + if( y > 0 ) + w->r = r; + else + w->r = -r; + w->i = r; + return; + } + +/* Approximate sqrt(x^2+y^2) - x = y^2/2x - y^4/24x^3 + ... . + * The relative error in the first term is approximately y^2/12x^2 . + */ +if( (fabsf(y) < fabsf(0.015f*x)) + && (x > 0) ) + { + t = 0.25f*y*(y/x); + } +else + { + r = cabsf(z); + t = 0.5f*(r - x); + } + +r = sqrtf(t); +q.i = r; +q.r = 0.5f*y/r; + +/* Heron iteration in complex arithmetic: + * q = (q + z/q)/2 + */ +cdivf( &q, z, &s ); +caddf( &q, &s, w ); +w->r *= 0.5f; +w->i *= 0.5f; +} + diff --git a/libm/float/constf.c b/libm/float/constf.c new file mode 100644 index 000000000..bf6b6f657 --- /dev/null +++ b/libm/float/constf.c @@ -0,0 +1,20 @@ + +#ifdef DEC +/* MAXNUMF = 2^127 * (1 - 2^-24) */ +float MAXNUMF = 1.7014117331926442990585209174225846272e38; +float MAXLOGF = 88.02969187150841; +float MINLOGF = -88.7228391116729996; /* log(2^-128) */ +#else +/* MAXNUMF = 2^128 * (1 - 2^-24) */ +float MAXNUMF = 3.4028234663852885981170418348451692544e38; +float MAXLOGF = 88.72283905206835; +float MINLOGF = -103.278929903431851103; /* log(2^-149) */ +#endif + +float LOG2EF = 1.44269504088896341; +float LOGE2F = 0.693147180559945309; +float SQRTHF = 0.707106781186547524; +float PIF = 3.141592653589793238; +float PIO2F = 1.5707963267948966192; +float PIO4F = 0.7853981633974483096; +float MACHEPF = 5.9604644775390625E-8; diff --git a/libm/float/coshf.c b/libm/float/coshf.c new file mode 100644 index 000000000..2b44fdeb3 --- /dev/null +++ b/libm/float/coshf.c @@ -0,0 +1,67 @@ +/* coshf.c + * + * Hyperbolic cosine + * + * + * + * SYNOPSIS: + * + * float x, y, coshf(); + * + * y = coshf( x ); + * + * + * + * DESCRIPTION: + * + * Returns hyperbolic cosine of argument in the range MINLOGF to + * MAXLOGF. + * + * cosh(x) = ( exp(x) + exp(-x) )/2. + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE +-MAXLOGF 100000 1.2e-7 2.8e-8 + * + * + * ERROR MESSAGES: + * + * message condition value returned + * coshf overflow |x| > MAXLOGF MAXNUMF + * + * + */ + +/* cosh.c */ + +/* +Cephes Math Library Release 2.2: June, 1992 +Copyright 1985, 1987, 1992 by Stephen L. Moshier +Direct inquiries to 30 Frost Street, Cambridge, MA 02140 +*/ + +#include <math.h> +extern float MAXLOGF, MAXNUMF; + +float expf(float); + +float coshf(float xx) +{ +float x, y; + +x = xx; +if( x < 0 ) + x = -x; +if( x > MAXLOGF ) + { + mtherr( "coshf", OVERFLOW ); + return( MAXNUMF ); + } +y = expf(x); +y = y + 1.0/y; +return( 0.5*y ); +} diff --git a/libm/float/dawsnf.c b/libm/float/dawsnf.c new file mode 100644 index 000000000..d00607719 --- /dev/null +++ b/libm/float/dawsnf.c @@ -0,0 +1,168 @@ +/* dawsnf.c + * + * Dawson's Integral + * + * + * + * SYNOPSIS: + * + * float x, y, dawsnf(); + * + * y = dawsnf( x ); + * + * + * + * DESCRIPTION: + * + * Approximates the integral + * + * x + * - + * 2 | | 2 + * dawsn(x) = exp( -x ) | exp( t ) dt + * | | + * - + * 0 + * + * Three different rational approximations are employed, for + * the intervals 0 to 3.25; 3.25 to 6.25; and 6.25 up. + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE 0,10 50000 4.4e-7 6.3e-8 + * + * + */ + +/* dawsn.c */ + + +/* +Cephes Math Library Release 2.1: January, 1989 +Copyright 1984, 1987, 1989 by Stephen L. Moshier +Direct inquiries to 30 Frost Street, Cambridge, MA 02140 +*/ + +#include <math.h> +/* Dawson's integral, interval 0 to 3.25 */ +static float AN[10] = { + 1.13681498971755972054E-11, + 8.49262267667473811108E-10, + 1.94434204175553054283E-8, + 9.53151741254484363489E-7, + 3.07828309874913200438E-6, + 3.52513368520288738649E-4, +-8.50149846724410912031E-4, + 4.22618223005546594270E-2, +-9.17480371773452345351E-2, + 9.99999999999999994612E-1, +}; +static float AD[11] = { + 2.40372073066762605484E-11, + 1.48864681368493396752E-9, + 5.21265281010541664570E-8, + 1.27258478273186970203E-6, + 2.32490249820789513991E-5, + 3.25524741826057911661E-4, + 3.48805814657162590916E-3, + 2.79448531198828973716E-2, + 1.58874241960120565368E-1, + 5.74918629489320327824E-1, + 1.00000000000000000539E0, +}; + +/* interval 3.25 to 6.25 */ +static float BN[11] = { + 5.08955156417900903354E-1, +-2.44754418142697847934E-1, + 9.41512335303534411857E-2, +-2.18711255142039025206E-2, + 3.66207612329569181322E-3, +-4.23209114460388756528E-4, + 3.59641304793896631888E-5, +-2.14640351719968974225E-6, + 9.10010780076391431042E-8, +-2.40274520828250956942E-9, + 3.59233385440928410398E-11, +}; +static float BD[10] = { +/* 1.00000000000000000000E0,*/ +-6.31839869873368190192E-1, + 2.36706788228248691528E-1, +-5.31806367003223277662E-2, + 8.48041718586295374409E-3, +-9.47996768486665330168E-4, + 7.81025592944552338085E-5, +-4.55875153252442634831E-6, + 1.89100358111421846170E-7, +-4.91324691331920606875E-9, + 7.18466403235734541950E-11, +}; + +/* 6.25 to infinity */ +static float CN[5] = { +-5.90592860534773254987E-1, + 6.29235242724368800674E-1, +-1.72858975380388136411E-1, + 1.64837047825189632310E-2, +-4.86827613020462700845E-4, +}; +static float CD[5] = { +/* 1.00000000000000000000E0,*/ +-2.69820057197544900361E0, + 1.73270799045947845857E0, +-3.93708582281939493482E-1, + 3.44278924041233391079E-2, +-9.73655226040941223894E-4, +}; + + +extern float PIF, MACHEPF; +#define fabsf(x) ( (x) < 0 ? -(x) : (x) ) +#ifdef ANSIC +float polevlf(float, float *, int); +float p1evlf(float, float *, int); +#else +float polevlf(), p1evlf(); +#endif + +float dawsnf( float xxx ) +{ +float xx, x, y; +int sign; + +xx = xxx; +sign = 1; +if( xx < 0.0 ) + { + sign = -1; + xx = -xx; + } + +if( xx < 3.25 ) + { + x = xx*xx; + y = xx * polevlf( x, AN, 9 )/polevlf( x, AD, 10 ); + return( sign * y ); + } + + +x = 1.0/(xx*xx); + +if( xx < 6.25 ) + { + y = 1.0/xx + x * polevlf( x, BN, 10) / (p1evlf( x, BD, 10) * xx); + return( sign * 0.5 * y ); + } + + +if( xx > 1.0e9 ) + return( (sign * 0.5)/xx ); + +/* 6.25 to infinity */ +y = 1.0/xx + x * polevlf( x, CN, 4) / (p1evlf( x, CD, 5) * xx); +return( sign * 0.5 * y ); +} diff --git a/libm/float/ellief.c b/libm/float/ellief.c new file mode 100644 index 000000000..5c3f822df --- /dev/null +++ b/libm/float/ellief.c @@ -0,0 +1,115 @@ +/* ellief.c + * + * Incomplete elliptic integral of the second kind + * + * + * + * SYNOPSIS: + * + * float phi, m, y, ellief(); + * + * y = ellief( phi, m ); + * + * + * + * DESCRIPTION: + * + * Approximates the integral + * + * + * phi + * - + * | | + * | 2 + * E(phi\m) = | sqrt( 1 - m sin t ) dt + * | + * | | + * - + * 0 + * + * of amplitude phi and modulus m, using the arithmetic - + * geometric mean algorithm. + * + * + * + * ACCURACY: + * + * Tested at random arguments with phi in [0, 2] and m in + * [0, 1]. + * Relative error: + * arithmetic domain # trials peak rms + * IEEE 0,2 10000 4.5e-7 7.4e-8 + * + * + */ + + +/* +Cephes Math Library Release 2.2: July, 1992 +Copyright 1984, 1987, 1992 by Stephen L. Moshier +Direct inquiries to 30 Frost Street, Cambridge, MA 02140 +*/ + +/* Incomplete elliptic integral of second kind */ + +#include <math.h> + +extern float PIF, PIO2F, MACHEPF; + +#define fabsf(x) ( (x) < 0 ? -(x) : (x) ) + +#ifdef ANSIC +float sqrtf(float), logf(float), sinf(float), tanf(float), atanf(float); +float ellpef(float), ellpkf(float); +#else +float sqrtf(), logf(), sinf(), tanf(), atanf(); +float ellpef(), ellpkf(); +#endif + + +float ellief( float phia, float ma ) +{ +float phi, m, a, b, c, e, temp; +float lphi, t; +int d, mod; + +phi = phia; +m = ma; +if( m == 0.0 ) + return( phi ); +if( m == 1.0 ) + return( sinf(phi) ); +lphi = phi; +if( lphi < 0.0 ) + lphi = -lphi; +a = 1.0; +b = 1.0 - m; +b = sqrtf(b); +c = sqrtf(m); +d = 1; +e = 0.0; +t = tanf( lphi ); +mod = (lphi + PIO2F)/PIF; + +while( fabsf(c/a) > MACHEPF ) + { + temp = b/a; + lphi = lphi + atanf(t*temp) + mod * PIF; + mod = (lphi + PIO2F)/PIF; + t = t * ( 1.0 + temp )/( 1.0 - temp * t * t ); + c = 0.5 * ( a - b ); + temp = sqrtf( a * b ); + a = 0.5 * ( a + b ); + b = temp; + d += d; + e += c * sinf(lphi); + } + +b = 1.0 - m; +temp = ellpef(b)/ellpkf(b); +temp *= (atanf(t) + mod * PIF)/(d * a); +temp += e; +if( phi < 0.0 ) + temp = -temp; +return( temp ); +} diff --git a/libm/float/ellikf.c b/libm/float/ellikf.c new file mode 100644 index 000000000..8ec890926 --- /dev/null +++ b/libm/float/ellikf.c @@ -0,0 +1,113 @@ +/* ellikf.c + * + * Incomplete elliptic integral of the first kind + * + * + * + * SYNOPSIS: + * + * float phi, m, y, ellikf(); + * + * y = ellikf( phi, m ); + * + * + * + * DESCRIPTION: + * + * Approximates the integral + * + * + * + * phi + * - + * | | + * | dt + * F(phi\m) = | ------------------ + * | 2 + * | | sqrt( 1 - m sin t ) + * - + * 0 + * + * of amplitude phi and modulus m, using the arithmetic - + * geometric mean algorithm. + * + * + * + * + * ACCURACY: + * + * Tested at random points with phi in [0, 2] and m in + * [0, 1]. + * Relative error: + * arithmetic domain # trials peak rms + * IEEE 0,2 10000 2.9e-7 5.8e-8 + * + * + */ + + +/* +Cephes Math Library Release 2.2: July, 1992 +Copyright 1984, 1987, 1992 by Stephen L. Moshier +Direct inquiries to 30 Frost Street, Cambridge, MA 02140 +*/ + +/* Incomplete elliptic integral of first kind */ + +#include <math.h> +extern float PIF, PIO2F, MACHEPF; + +#define fabsf(x) ( (x) < 0 ? -(x) : (x) ) + +#ifdef ANSIC +float sqrtf(float), logf(float), sinf(float), tanf(float), atanf(float); +#else +float sqrtf(), logf(), sinf(), tanf(), atanf(); +#endif + + +float ellikf( float phia, float ma ) +{ +float phi, m, a, b, c, temp; +float t; +int d, mod, sign; + +phi = phia; +m = ma; +if( m == 0.0 ) + return( phi ); +if( phi < 0.0 ) + { + phi = -phi; + sign = -1; + } +else + sign = 0; +a = 1.0; +b = 1.0 - m; +if( b == 0.0 ) + return( logf( tanf( 0.5*(PIO2F + phi) ) ) ); +b = sqrtf(b); +c = sqrtf(m); +d = 1; +t = tanf( phi ); +mod = (phi + PIO2F)/PIF; + +while( fabsf(c/a) > MACHEPF ) + { + temp = b/a; + phi = phi + atanf(t*temp) + mod * PIF; + mod = (phi + PIO2F)/PIF; + t = t * ( 1.0 + temp )/( 1.0 - temp * t * t ); + c = ( a - b )/2.0; + temp = sqrtf( a * b ); + a = ( a + b )/2.0; + b = temp; + d += d; + } + +temp = (atanf(t) + mod * PIF)/(d * a); +if( sign < 0 ) + temp = -temp; +return( temp ); +} diff --git a/libm/float/ellpef.c b/libm/float/ellpef.c new file mode 100644 index 000000000..645bc55ba --- /dev/null +++ b/libm/float/ellpef.c @@ -0,0 +1,105 @@ +/* ellpef.c + * + * Complete elliptic integral of the second kind + * + * + * + * SYNOPSIS: + * + * float m1, y, ellpef(); + * + * y = ellpef( m1 ); + * + * + * + * DESCRIPTION: + * + * Approximates the integral + * + * + * pi/2 + * - + * | | 2 + * E(m) = | sqrt( 1 - m sin t ) dt + * | | + * - + * 0 + * + * Where m = 1 - m1, using the approximation + * + * P(x) - x log x Q(x). + * + * Though there are no singularities, the argument m1 is used + * rather than m for compatibility with ellpk(). + * + * E(1) = 1; E(0) = pi/2. + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE 0, 1 30000 1.1e-7 3.9e-8 + * + * + * ERROR MESSAGES: + * + * message condition value returned + * ellpef domain x<0, x>1 0.0 + * + */ + +/* ellpe.c */ + +/* Elliptic integral of second kind */ + +/* +Cephes Math Library, Release 2.1: February, 1989 +Copyright 1984, 1987, 1989 by Stephen L. Moshier +Direct inquiries to 30 Frost Street, Cambridge, MA 02140 +*/ + +#include <math.h> + + +static float P[] = { + 1.53552577301013293365E-4, + 2.50888492163602060990E-3, + 8.68786816565889628429E-3, + 1.07350949056076193403E-2, + 7.77395492516787092951E-3, + 7.58395289413514708519E-3, + 1.15688436810574127319E-2, + 2.18317996015557253103E-2, + 5.68051945617860553470E-2, + 4.43147180560990850618E-1, + 1.00000000000000000299E0 +}; +static float Q[] = { + 3.27954898576485872656E-5, + 1.00962792679356715133E-3, + 6.50609489976927491433E-3, + 1.68862163993311317300E-2, + 2.61769742454493659583E-2, + 3.34833904888224918614E-2, + 4.27180926518931511717E-2, + 5.85936634471101055642E-2, + 9.37499997197644278445E-2, + 2.49999999999888314361E-1 +}; + +float polevlf(float, float *, int), logf(float); +float ellpef( float xx) +{ +float x; + +x = xx; +if( (x <= 0.0) || (x > 1.0) ) + { + if( x == 0.0 ) + return( 1.0 ); + mtherr( "ellpef", DOMAIN ); + return( 0.0 ); + } +return( polevlf(x,P,10) - logf(x) * (x * polevlf(x,Q,9)) ); +} diff --git a/libm/float/ellpjf.c b/libm/float/ellpjf.c new file mode 100644 index 000000000..552f5ffe4 --- /dev/null +++ b/libm/float/ellpjf.c @@ -0,0 +1,161 @@ +/* ellpjf.c + * + * Jacobian Elliptic Functions + * + * + * + * SYNOPSIS: + * + * float u, m, sn, cn, dn, phi; + * int ellpj(); + * + * ellpj( u, m, _&sn, _&cn, _&dn, _&phi ); + * + * + * + * DESCRIPTION: + * + * + * Evaluates the Jacobian elliptic functions sn(u|m), cn(u|m), + * and dn(u|m) of parameter m between 0 and 1, and real + * argument u. + * + * These functions are periodic, with quarter-period on the + * real axis equal to the complete elliptic integral + * ellpk(1.0-m). + * + * Relation to incomplete elliptic integral: + * If u = ellik(phi,m), then sn(u|m) = sin(phi), + * and cn(u|m) = cos(phi). Phi is called the amplitude of u. + * + * Computation is by means of the arithmetic-geometric mean + * algorithm, except when m is within 1e-9 of 0 or 1. In the + * latter case with m close to 1, the approximation applies + * only for phi < pi/2. + * + * ACCURACY: + * + * Tested at random points with u between 0 and 10, m between + * 0 and 1. + * + * Absolute error (* = relative error): + * arithmetic function # trials peak rms + * IEEE sn 10000 1.7e-6 2.2e-7 + * IEEE cn 10000 1.6e-6 2.2e-7 + * IEEE dn 10000 1.4e-3 1.9e-5 + * IEEE phi 10000 3.9e-7* 6.7e-8* + * + * Peak error observed in consistency check using addition + * theorem for sn(u+v) was 4e-16 (absolute). Also tested by + * the above relation to the incomplete elliptic integral. + * Accuracy deteriorates when u is large. + * + */ + +/* ellpj.c */ + + +/* +Cephes Math Library Release 2.2: July, 1992 +Copyright 1984, 1987, 1992 by Stephen L. Moshier +Direct inquiries to 30 Frost Street, Cambridge, MA 02140 +*/ + +#include <math.h> +extern float PIO2F, MACHEPF; + +#define fabsf(x) ( (x) < 0 ? -(x) : (x) ) + +#ifdef ANSIC +float sqrtf(float), sinf(float), cosf(float), asinf(float), tanhf(float); +float sinhf(float), coshf(float), atanf(float), expf(float); +#else +float sqrtf(), sinf(), cosf(), asinf(), tanhf(); +float sinhf(), coshf(), atanf(), expf(); +#endif + +int ellpjf( float uu, float mm, + float *sn, float *cn, float *dn, float *ph ) +{ +float u, m, ai, b, phi, t, twon; +float a[10], c[10]; +int i; + +u = uu; +m = mm; +/* Check for special cases */ + +if( m < 0.0 || m > 1.0 ) + { + mtherr( "ellpjf", DOMAIN ); + return(-1); + } +if( m < 1.0e-5 ) + { + t = sinf(u); + b = cosf(u); + ai = 0.25 * m * (u - t*b); + *sn = t - ai*b; + *cn = b + ai*t; + *ph = u - ai; + *dn = 1.0 - 0.5*m*t*t; + return(0); + } + +if( m >= 0.99999 ) + { + ai = 0.25 * (1.0-m); + b = coshf(u); + t = tanhf(u); + phi = 1.0/b; + twon = b * sinhf(u); + *sn = t + ai * (twon - u)/(b*b); + *ph = 2.0*atanf(expf(u)) - PIO2F + ai*(twon - u)/b; + ai *= t * phi; + *cn = phi - ai * (twon - u); + *dn = phi + ai * (twon + u); + return(0); + } + + +/* A. G. M. scale */ +a[0] = 1.0; +b = sqrtf(1.0 - m); +c[0] = sqrtf(m); +twon = 1.0; +i = 0; + +while( fabsf( (c[i]/a[i]) ) > MACHEPF ) + { + if( i > 8 ) + { +/* mtherr( "ellpjf", OVERFLOW );*/ + break; + } + ai = a[i]; + ++i; + c[i] = 0.5 * ( ai - b ); + t = sqrtf( ai * b ); + a[i] = 0.5 * ( ai + b ); + b = t; + twon += twon; + } + + +/* backward recurrence */ +phi = twon * a[i] * u; +do + { + t = c[i] * sinf(phi) / a[i]; + b = phi; + phi = 0.5 * (asinf(t) + phi); + } +while( --i ); + +*sn = sinf(phi); +t = cosf(phi); +*cn = t; +*dn = t/cosf(phi-b); +*ph = phi; +return(0); +} diff --git a/libm/float/ellpkf.c b/libm/float/ellpkf.c new file mode 100644 index 000000000..2cc13d90a --- /dev/null +++ b/libm/float/ellpkf.c @@ -0,0 +1,128 @@ +/* ellpkf.c + * + * Complete elliptic integral of the first kind + * + * + * + * SYNOPSIS: + * + * float m1, y, ellpkf(); + * + * y = ellpkf( m1 ); + * + * + * + * DESCRIPTION: + * + * Approximates the integral + * + * + * + * pi/2 + * - + * | | + * | dt + * K(m) = | ------------------ + * | 2 + * | | sqrt( 1 - m sin t ) + * - + * 0 + * + * where m = 1 - m1, using the approximation + * + * P(x) - log x Q(x). + * + * The argument m1 is used rather than m so that the logarithmic + * singularity at m = 1 will be shifted to the origin; this + * preserves maximum accuracy. + * + * K(0) = pi/2. + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE 0,1 30000 1.3e-7 3.4e-8 + * + * ERROR MESSAGES: + * + * message condition value returned + * ellpkf domain x<0, x>1 0.0 + * + */ + +/* ellpk.c */ + + +/* +Cephes Math Library, Release 2.0: April, 1987 +Copyright 1984, 1987 by Stephen L. Moshier +Direct inquiries to 30 Frost Street, Cambridge, MA 02140 +*/ + +#include <math.h> + +static float P[] = +{ + 1.37982864606273237150E-4, + 2.28025724005875567385E-3, + 7.97404013220415179367E-3, + 9.85821379021226008714E-3, + 6.87489687449949877925E-3, + 6.18901033637687613229E-3, + 8.79078273952743772254E-3, + 1.49380448916805252718E-2, + 3.08851465246711995998E-2, + 9.65735902811690126535E-2, + 1.38629436111989062502E0 +}; + +static float Q[] = +{ + 2.94078955048598507511E-5, + 9.14184723865917226571E-4, + 5.94058303753167793257E-3, + 1.54850516649762399335E-2, + 2.39089602715924892727E-2, + 3.01204715227604046988E-2, + 3.73774314173823228969E-2, + 4.88280347570998239232E-2, + 7.03124996963957469739E-2, + 1.24999999999870820058E-1, + 4.99999999999999999821E-1 +}; +static float C1 = 1.3862943611198906188E0; /* log(4) */ + +extern float MACHEPF, MAXNUMF; + +float polevlf(float, float *, int); +float p1evlf(float, float *, int); +float logf(float); +float ellpkf(float xx) +{ +float x; + +x = xx; +if( (x < 0.0) || (x > 1.0) ) + { + mtherr( "ellpkf", DOMAIN ); + return( 0.0 ); + } + +if( x > MACHEPF ) + { + return( polevlf(x,P,10) - logf(x) * polevlf(x,Q,10) ); + } +else + { + if( x == 0.0 ) + { + mtherr( "ellpkf", SING ); + return( MAXNUMF ); + } + else + { + return( C1 - 0.5 * logf(x) ); + } + } +} diff --git a/libm/float/exp10f.c b/libm/float/exp10f.c new file mode 100644 index 000000000..c7c62c567 --- /dev/null +++ b/libm/float/exp10f.c @@ -0,0 +1,115 @@ +/* exp10f.c + * + * Base 10 exponential function + * (Common antilogarithm) + * + * + * + * SYNOPSIS: + * + * float x, y, exp10f(); + * + * y = exp10f( x ); + * + * + * + * DESCRIPTION: + * + * Returns 10 raised to the x power. + * + * Range reduction is accomplished by expressing the argument + * as 10**x = 2**n 10**f, with |f| < 0.5 log10(2). + * A polynomial approximates 10**f. + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE -38,+38 100000 9.8e-8 2.8e-8 + * + * ERROR MESSAGES: + * + * message condition value returned + * exp10 underflow x < -MAXL10 0.0 + * exp10 overflow x > MAXL10 MAXNUM + * + * IEEE single arithmetic: MAXL10 = 38.230809449325611792. + * + */ + +/* +Cephes Math Library Release 2.2: June, 1992 +Copyright 1984, 1987, 1988, 1992 by Stephen L. Moshier +Direct inquiries to 30 Frost Street, Cambridge, MA 02140 +*/ + + +#include <math.h> + +static float P[] = { + 2.063216740311022E-001, + 5.420251702225484E-001, + 1.171292686296281E+000, + 2.034649854009453E+000, + 2.650948748208892E+000, + 2.302585167056758E+000 +}; + +/*static float LOG102 = 3.01029995663981195214e-1;*/ +static float LOG210 = 3.32192809488736234787e0; +static float LG102A = 3.00781250000000000000E-1; +static float LG102B = 2.48745663981195213739E-4; +static float MAXL10 = 38.230809449325611792; + + + + +extern float MAXNUMF; + +float floorf(float), ldexpf(float, int), polevlf(float, float *, int); + +float exp10f(float xx) +{ +float x, px, qx; +short n; + +x = xx; +if( x > MAXL10 ) + { + mtherr( "exp10f", OVERFLOW ); + return( MAXNUMF ); + } + +if( x < -MAXL10 ) /* Would like to use MINLOG but can't */ + { + mtherr( "exp10f", UNDERFLOW ); + return(0.0); + } + +/* The following is necessary because range reduction blows up: */ +if( x == 0 ) + return(1.0); + +/* Express 10**x = 10**g 2**n + * = 10**g 10**( n log10(2) ) + * = 10**( g + n log10(2) ) + */ +px = x * LOG210; +qx = floorf( px + 0.5 ); +n = qx; +x -= qx * LG102A; +x -= qx * LG102B; + +/* rational approximation for exponential + * of the fractional part: + * 10**x - 1 = 2x P(x**2)/( Q(x**2) - P(x**2) ) + */ +px = 1.0 + x * polevlf( x, P, 5 ); + +/* multiply by power of 2 */ +x = ldexpf( px, n ); + +return(x); +} diff --git a/libm/float/exp2f.c b/libm/float/exp2f.c new file mode 100644 index 000000000..0de21decd --- /dev/null +++ b/libm/float/exp2f.c @@ -0,0 +1,116 @@ +/* exp2f.c + * + * Base 2 exponential function + * + * + * + * SYNOPSIS: + * + * float x, y, exp2f(); + * + * y = exp2f( x ); + * + * + * + * DESCRIPTION: + * + * Returns 2 raised to the x power. + * + * Range reduction is accomplished by separating the argument + * into an integer k and fraction f such that + * x k f + * 2 = 2 2. + * + * A polynomial approximates 2**x in the basic range [-0.5, 0.5]. + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE -127,+127 100000 1.7e-7 2.8e-8 + * + * + * See exp.c for comments on error amplification. + * + * + * ERROR MESSAGES: + * + * message condition value returned + * exp underflow x < -MAXL2 0.0 + * exp overflow x > MAXL2 MAXNUMF + * + * For IEEE arithmetic, MAXL2 = 127. + */ + + +/* +Cephes Math Library Release 2.2: June, 1992 +Copyright 1984, 1987, 1988, 1992 by Stephen L. Moshier +Direct inquiries to 30 Frost Street, Cambridge, MA 02140 +*/ + + + +#include <math.h> +static char fname[] = {"exp2f"}; + +static float P[] = { + 1.535336188319500E-004, + 1.339887440266574E-003, + 9.618437357674640E-003, + 5.550332471162809E-002, + 2.402264791363012E-001, + 6.931472028550421E-001 +}; +#define MAXL2 127.0 +#define MINL2 -127.0 + + + +extern float MAXNUMF; + +float polevlf(float, float *, int), floorf(float), ldexpf(float, int); + +float exp2f( float xx ) +{ +float x, px; +int i0; + +x = xx; +if( x > MAXL2) + { + mtherr( fname, OVERFLOW ); + return( MAXNUMF ); + } + +if( x < MINL2 ) + { + mtherr( fname, UNDERFLOW ); + return(0.0); + } + +/* The following is necessary because range reduction blows up: */ +if( x == 0 ) + return(1.0); + +/* separate into integer and fractional parts */ +px = floorf(x); +i0 = px; +x = x - px; + +if( x > 0.5 ) + { + i0 += 1; + x -= 1.0; + } + +/* rational approximation + * exp2(x) = 1.0 + xP(x) + */ +px = 1.0 + x * polevlf( x, P, 5 ); + +/* scale by power of 2 */ +px = ldexpf( px, i0 ); +return(px); +} diff --git a/libm/float/expf.c b/libm/float/expf.c new file mode 100644 index 000000000..073678b99 --- /dev/null +++ b/libm/float/expf.c @@ -0,0 +1,122 @@ +/* expf.c + * + * Exponential function + * + * + * + * SYNOPSIS: + * + * float x, y, expf(); + * + * y = expf( x ); + * + * + * + * DESCRIPTION: + * + * Returns e (2.71828...) raised to the x power. + * + * Range reduction is accomplished by separating the argument + * into an integer k and fraction f such that + * + * x k f + * e = 2 e. + * + * A polynomial is used to approximate exp(f) + * in the basic range [-0.5, 0.5]. + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE +- MAXLOG 100000 1.7e-7 2.8e-8 + * + * + * Error amplification in the exponential function can be + * a serious matter. The error propagation involves + * exp( X(1+delta) ) = exp(X) ( 1 + X*delta + ... ), + * which shows that a 1 lsb error in representing X produces + * a relative error of X times 1 lsb in the function. + * While the routine gives an accurate result for arguments + * that are exactly represented by a double precision + * computer number, the result contains amplified roundoff + * error for large arguments not exactly represented. + * + * + * ERROR MESSAGES: + * + * message condition value returned + * expf underflow x < MINLOGF 0.0 + * expf overflow x > MAXLOGF MAXNUMF + * + */ + +/* +Cephes Math Library Release 2.2: June, 1992 +Copyright 1984, 1987, 1989 by Stephen L. Moshier +Direct inquiries to 30 Frost Street, Cambridge, MA 02140 +*/ + +/* Single precision exponential function. + * test interval: [-0.5, +0.5] + * trials: 80000 + * peak relative error: 7.6e-8 + * rms relative error: 2.8e-8 + */ +#include <math.h> +extern float LOG2EF, MAXLOGF, MINLOGF, MAXNUMF; + +static float C1 = 0.693359375; +static float C2 = -2.12194440e-4; + + + +float floorf( float ), ldexpf( float, int ); + +float expf( float xx ) +{ +float x, z; +int n; + +x = xx; + + +if( x > MAXLOGF) + { + mtherr( "expf", OVERFLOW ); + return( MAXNUMF ); + } + +if( x < MINLOGF ) + { + mtherr( "expf", UNDERFLOW ); + return(0.0); + } + +/* Express e**x = e**g 2**n + * = e**g e**( n loge(2) ) + * = e**( g + n loge(2) ) + */ +z = floorf( LOG2EF * x + 0.5 ); /* floor() truncates toward -infinity. */ +x -= z * C1; +x -= z * C2; +n = z; + +z = x * x; +/* Theoretical peak relative error in [-0.5, +0.5] is 4.2e-9. */ +z = +((((( 1.9875691500E-4 * x + + 1.3981999507E-3) * x + + 8.3334519073E-3) * x + + 4.1665795894E-2) * x + + 1.6666665459E-1) * x + + 5.0000001201E-1) * z + + x + + 1.0; + +/* multiply by power of 2 */ +x = ldexpf( z, n ); + +return( x ); +} diff --git a/libm/float/expnf.c b/libm/float/expnf.c new file mode 100644 index 000000000..ebf0ccb3e --- /dev/null +++ b/libm/float/expnf.c @@ -0,0 +1,207 @@ +/* expnf.c + * + * Exponential integral En + * + * + * + * SYNOPSIS: + * + * int n; + * float x, y, expnf(); + * + * y = expnf( n, x ); + * + * + * + * DESCRIPTION: + * + * Evaluates the exponential integral + * + * inf. + * - + * | | -xt + * | e + * E (x) = | ---- dt. + * n | n + * | | t + * - + * 1 + * + * + * Both n and x must be nonnegative. + * + * The routine employs either a power series, a continued + * fraction, or an asymptotic formula depending on the + * relative values of n and x. + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE 0, 30 10000 5.6e-7 1.2e-7 + * + */ + +/* expn.c */ + +/* Cephes Math Library Release 2.2: July, 1992 + * Copyright 1985, 1992 by Stephen L. Moshier + * Direct inquiries to 30 Frost Street, Cambridge, MA 02140 */ + +#include <math.h> + +#define EUL 0.57721566490153286060 +#define BIG 16777216. +extern float MAXNUMF, MACHEPF, MAXLOGF; +#ifdef ANSIC +float powf(float, float), gammaf(float), logf(float), expf(float); +#else +float powf(), gammaf(), logf(), expf(); +#endif +#define fabsf(x) ( (x) < 0 ? -(x) : (x) ) + + +float expnf( int n, float xx ) +{ +float x, ans, r, t, yk, xk; +float pk, pkm1, pkm2, qk, qkm1, qkm2; +float psi, z; +int i, k; +static float big = BIG; + + +x = xx; +if( n < 0 ) + goto domerr; + +if( x < 0 ) + { +domerr: mtherr( "expnf", DOMAIN ); + return( MAXNUMF ); + } + +if( x > MAXLOGF ) + return( 0.0 ); + +if( x == 0.0 ) + { + if( n < 2 ) + { + mtherr( "expnf", SING ); + return( MAXNUMF ); + } + else + return( 1.0/(n-1.0) ); + } + +if( n == 0 ) + return( expf(-x)/x ); + +/* expn.c */ +/* Expansion for large n */ + +if( n > 5000 ) + { + xk = x + n; + yk = 1.0 / (xk * xk); + t = n; + ans = yk * t * (6.0 * x * x - 8.0 * t * x + t * t); + ans = yk * (ans + t * (t - 2.0 * x)); + ans = yk * (ans + t); + ans = (ans + 1.0) * expf( -x ) / xk; + goto done; + } + +if( x > 1.0 ) + goto cfrac; + +/* expn.c */ + +/* Power series expansion */ + +psi = -EUL - logf(x); +for( i=1; i<n; i++ ) + psi = psi + 1.0/i; + +z = -x; +xk = 0.0; +yk = 1.0; +pk = 1.0 - n; +if( n == 1 ) + ans = 0.0; +else + ans = 1.0/pk; +do + { + xk += 1.0; + yk *= z/xk; + pk += 1.0; + if( pk != 0.0 ) + { + ans += yk/pk; + } + if( ans != 0.0 ) + t = fabsf(yk/ans); + else + t = 1.0; + } +while( t > MACHEPF ); +k = xk; +t = n; +r = n - 1; +ans = (powf(z, r) * psi / gammaf(t)) - ans; +goto done; + +/* expn.c */ +/* continued fraction */ +cfrac: +k = 1; +pkm2 = 1.0; +qkm2 = x; +pkm1 = 1.0; +qkm1 = x + n; +ans = pkm1/qkm1; + +do + { + k += 1; + if( k & 1 ) + { + yk = 1.0; + xk = n + (k-1)/2; + } + else + { + yk = x; + xk = k/2; + } + pk = pkm1 * yk + pkm2 * xk; + qk = qkm1 * yk + qkm2 * xk; + if( qk != 0 ) + { + r = pk/qk; + t = fabsf( (ans - r)/r ); + ans = r; + } + else + t = 1.0; + pkm2 = pkm1; + pkm1 = pk; + qkm2 = qkm1; + qkm1 = qk; +if( fabsf(pk) > big ) + { + pkm2 *= MACHEPF; + pkm1 *= MACHEPF; + qkm2 *= MACHEPF; + qkm1 *= MACHEPF; + } + } +while( t > MACHEPF ); + +ans *= expf( -x ); + +done: +return( ans ); +} + diff --git a/libm/float/facf.c b/libm/float/facf.c new file mode 100644 index 000000000..c69738897 --- /dev/null +++ b/libm/float/facf.c @@ -0,0 +1,106 @@ +/* facf.c + * + * Factorial function + * + * + * + * SYNOPSIS: + * + * float y, facf(); + * int i; + * + * y = facf( i ); + * + * + * + * DESCRIPTION: + * + * Returns factorial of i = 1 * 2 * 3 * ... * i. + * fac(0) = 1.0. + * + * Due to machine arithmetic bounds the largest value of + * i accepted is 33 in single precision arithmetic. + * Greater values, or negative ones, + * produce an error message and return MAXNUM. + * + * + * + * ACCURACY: + * + * For i < 34 the values are simply tabulated, and have + * full machine accuracy. + * + */ + +/* +Cephes Math Library Release 2.0: April, 1987 +Copyright 1984, 1987 by Stephen L. Moshier +Direct inquiries to 30 Frost Street, Cambridge, MA 02140 +*/ + +#include <math.h> + +/* Factorials of integers from 0 through 33 */ +static float factbl[] = { + 1.00000000000000000000E0, + 1.00000000000000000000E0, + 2.00000000000000000000E0, + 6.00000000000000000000E0, + 2.40000000000000000000E1, + 1.20000000000000000000E2, + 7.20000000000000000000E2, + 5.04000000000000000000E3, + 4.03200000000000000000E4, + 3.62880000000000000000E5, + 3.62880000000000000000E6, + 3.99168000000000000000E7, + 4.79001600000000000000E8, + 6.22702080000000000000E9, + 8.71782912000000000000E10, + 1.30767436800000000000E12, + 2.09227898880000000000E13, + 3.55687428096000000000E14, + 6.40237370572800000000E15, + 1.21645100408832000000E17, + 2.43290200817664000000E18, + 5.10909421717094400000E19, + 1.12400072777760768000E21, + 2.58520167388849766400E22, + 6.20448401733239439360E23, + 1.55112100433309859840E25, + 4.03291461126605635584E26, + 1.0888869450418352160768E28, + 3.04888344611713860501504E29, + 8.841761993739701954543616E30, + 2.6525285981219105863630848E32, + 8.22283865417792281772556288E33, + 2.6313083693369353016721801216E35, + 8.68331761881188649551819440128E36 +}; +#define MAXFACF 33 + +extern float MAXNUMF; + +#ifdef ANSIC +float facf( int i ) +#else +float facf(i) +int i; +#endif +{ + +if( i < 0 ) + { + mtherr( "facf", SING ); + return( MAXNUMF ); + } + +if( i > MAXFACF ) + { + mtherr( "facf", OVERFLOW ); + return( MAXNUMF ); + } + +/* Get answer from table for small i. */ +return( factbl[i] ); +} diff --git a/libm/float/fdtrf.c b/libm/float/fdtrf.c new file mode 100644 index 000000000..5fdc6d81d --- /dev/null +++ b/libm/float/fdtrf.c @@ -0,0 +1,214 @@ +/* fdtrf.c + * + * F distribution + * + * + * + * SYNOPSIS: + * + * int df1, df2; + * float x, y, fdtrf(); + * + * y = fdtrf( df1, df2, x ); + * + * + * + * DESCRIPTION: + * + * Returns the area from zero to x under the F density + * function (also known as Snedcor's density or the + * variance ratio density). This is the density + * of x = (u1/df1)/(u2/df2), where u1 and u2 are random + * variables having Chi square distributions with df1 + * and df2 degrees of freedom, respectively. + * + * The incomplete beta integral is used, according to the + * formula + * + * P(x) = incbet( df1/2, df2/2, (df1*x/(df2 + df1*x) ). + * + * + * The arguments a and b are greater than zero, and x + * x is nonnegative. + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE 0,100 5000 2.2e-5 1.1e-6 + * + * ERROR MESSAGES: + * + * message condition value returned + * fdtrf domain a<0, b<0, x<0 0.0 + * + */ + /* fdtrcf() + * + * Complemented F distribution + * + * + * + * SYNOPSIS: + * + * int df1, df2; + * float x, y, fdtrcf(); + * + * y = fdtrcf( df1, df2, x ); + * + * + * + * DESCRIPTION: + * + * Returns the area from x to infinity under the F density + * function (also known as Snedcor's density or the + * variance ratio density). + * + * + * inf. + * - + * 1 | | a-1 b-1 + * 1-P(x) = ------ | t (1-t) dt + * B(a,b) | | + * - + * x + * + * (See fdtr.c.) + * + * The incomplete beta integral is used, according to the + * formula + * + * P(x) = incbet( df2/2, df1/2, (df2/(df2 + df1*x) ). + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE 0,100 5000 7.3e-5 1.2e-5 + * + * ERROR MESSAGES: + * + * message condition value returned + * fdtrcf domain a<0, b<0, x<0 0.0 + * + */ + /* fdtrif() + * + * Inverse of complemented F distribution + * + * + * + * SYNOPSIS: + * + * float df1, df2, x, y, fdtrif(); + * + * x = fdtrif( df1, df2, y ); + * + * + * + * + * DESCRIPTION: + * + * Finds the F density argument x such that the integral + * from x to infinity of the F density is equal to the + * given probability y. + * + * This is accomplished using the inverse beta integral + * function and the relations + * + * z = incbi( df2/2, df1/2, y ) + * x = df2 (1-z) / (df1 z). + * + * Note: the following relations hold for the inverse of + * the uncomplemented F distribution: + * + * z = incbi( df1/2, df2/2, y ) + * x = df2 z / (df1 (1-z)). + * + * + * + * ACCURACY: + * + * arithmetic domain # trials peak rms + * Absolute error: + * IEEE 0,100 5000 4.0e-5 3.2e-6 + * Relative error: + * IEEE 0,100 5000 1.2e-3 1.8e-5 + * + * ERROR MESSAGES: + * + * message condition value returned + * fdtrif domain y <= 0 or y > 1 0.0 + * v < 1 + * + */ + + +/* +Cephes Math Library Release 2.2: July, 1992 +Copyright 1984, 1987, 1992 by Stephen L. Moshier +Direct inquiries to 30 Frost Street, Cambridge, MA 02140 +*/ + + +#include <math.h> + +#ifdef ANSIC +float incbetf(float, float, float); +float incbif(float, float, float); +#else +float incbetf(), incbif(); +#endif + +float fdtrcf( int ia, int ib, float xx ) +{ +float x, a, b, w; + +x = xx; +if( (ia < 1) || (ib < 1) || (x < 0.0) ) + { + mtherr( "fdtrcf", DOMAIN ); + return( 0.0 ); + } +a = ia; +b = ib; +w = b / (b + a * x); +return( incbetf( 0.5*b, 0.5*a, w ) ); +} + + + +float fdtrf( int ia, int ib, int xx ) +{ +float x, a, b, w; + +x = xx; +if( (ia < 1) || (ib < 1) || (x < 0.0) ) + { + mtherr( "fdtrf", DOMAIN ); + return( 0.0 ); + } +a = ia; +b = ib; +w = a * x; +w = w / (b + w); +return( incbetf( 0.5*a, 0.5*b, w) ); +} + + +float fdtrif( int ia, int ib, float yy ) +{ +float y, a, b, w, x; + +y = yy; +if( (ia < 1) || (ib < 1) || (y <= 0.0) || (y > 1.0) ) + { + mtherr( "fdtrif", DOMAIN ); + return( 0.0 ); + } +a = ia; +b = ib; +w = incbif( 0.5*b, 0.5*a, y ); +x = (b - b*w)/(a*w); +return(x); +} diff --git a/libm/float/floorf.c b/libm/float/floorf.c new file mode 100644 index 000000000..7a2f3530d --- /dev/null +++ b/libm/float/floorf.c @@ -0,0 +1,526 @@ +/* ceilf() + * floorf() + * frexpf() + * ldexpf() + * signbitf() + * isnanf() + * isfinitef() + * + * Single precision floating point numeric utilities + * + * + * + * SYNOPSIS: + * + * float x, y; + * float ceilf(), floorf(), frexpf(), ldexpf(); + * int signbit(), isnan(), isfinite(); + * int expnt, n; + * + * y = floorf(x); + * y = ceilf(x); + * y = frexpf( x, &expnt ); + * y = ldexpf( x, n ); + * n = signbit(x); + * n = isnan(x); + * n = isfinite(x); + * + * + * + * DESCRIPTION: + * + * All four routines return a single precision floating point + * result. + * + * sfloor() returns the largest integer less than or equal to x. + * It truncates toward minus infinity. + * + * sceil() returns the smallest integer greater than or equal + * to x. It truncates toward plus infinity. + * + * sfrexp() extracts the exponent from x. It returns an integer + * power of two to expnt and the significand between 0.5 and 1 + * to y. Thus x = y * 2**expn. + * + * ldexpf() multiplies x by 2**n. + * + * signbit(x) returns 1 if the sign bit of x is 1, else 0. + * + * These functions are part of the standard C run time library + * for many but not all C compilers. The ones supplied are + * written in C for either DEC or IEEE arithmetic. They should + * be used only if your compiler library does not already have + * them. + * + * The IEEE versions assume that denormal numbers are implemented + * in the arithmetic. Some modifications will be required if + * the arithmetic has abrupt rather than gradual underflow. + */ + + +/* +Cephes Math Library Release 2.1: December, 1988 +Copyright 1984, 1987, 1988 by Stephen L. Moshier +Direct inquiries to 30 Frost Street, Cambridge, MA 02140 +*/ + + +#include <math.h> +#ifdef DEC +#undef DENORMAL +#define DENORMAL 0 +#endif + +#ifdef UNK +#undef UNK +#if BIGENDIAN +#define MIEEE 1 +#else +#define IBMPC 1 +#endif +/* +char *unkmsg = "ceil(), floor(), frexp(), ldexp() must be rewritten!\n"; +*/ +#endif + +#define EXPMSK 0x807f +#define MEXP 255 +#define NBITS 24 + + +extern float MAXNUMF; /* (2^24 - 1) * 2^103 */ +#ifdef ANSIC +float floorf(float); +#else +float floorf(); +#endif + +float ceilf( float x ) +{ +float y; + +#ifdef UNK +printf( "%s\n", unkmsg ); +return(0.0); +#endif + +y = floorf( (float )x ); +if( y < x ) + y += 1.0; +return(y); +} + + + + +/* Bit clearing masks: */ + +static unsigned short bmask[] = { +0xffff, +0xfffe, +0xfffc, +0xfff8, +0xfff0, +0xffe0, +0xffc0, +0xff80, +0xff00, +0xfe00, +0xfc00, +0xf800, +0xf000, +0xe000, +0xc000, +0x8000, +0x0000, +}; + + + +float floorf( float x ) +{ +unsigned short *p; +union + { + float y; + unsigned short i[2]; + } u; +int e; + +#ifdef UNK +printf( "%s\n", unkmsg ); +return(0.0); +#endif + +u.y = x; +/* find the exponent (power of 2) */ +#ifdef DEC +p = &u.i[0]; +e = (( *p >> 7) & 0377) - 0201; +p += 3; +#endif + +#ifdef IBMPC +p = &u.i[1]; +e = (( *p >> 7) & 0xff) - 0x7f; +p -= 1; +#endif + +#ifdef MIEEE +p = &u.i[0]; +e = (( *p >> 7) & 0xff) - 0x7f; +p += 1; +#endif + +if( e < 0 ) + { + if( u.y < 0 ) + return( -1.0 ); + else + return( 0.0 ); + } + +e = (NBITS -1) - e; +/* clean out 16 bits at a time */ +while( e >= 16 ) + { +#ifdef IBMPC + *p++ = 0; +#endif + +#ifdef DEC + *p-- = 0; +#endif + +#ifdef MIEEE + *p-- = 0; +#endif + e -= 16; + } + +/* clear the remaining bits */ +if( e > 0 ) + *p &= bmask[e]; + +if( (x < 0) && (u.y != x) ) + u.y -= 1.0; + +return(u.y); +} + + + +float frexpf( float x, int *pw2 ) +{ +union + { + float y; + unsigned short i[2]; + } u; +int i, k; +short *q; + +u.y = x; + +#ifdef UNK +printf( "%s\n", unkmsg ); +return(0.0); +#endif + +#ifdef IBMPC +q = &u.i[1]; +#endif + +#ifdef DEC +q = &u.i[0]; +#endif + +#ifdef MIEEE +q = &u.i[0]; +#endif + +/* find the exponent (power of 2) */ + +i = ( *q >> 7) & 0xff; +if( i == 0 ) + { + if( u.y == 0.0 ) + { + *pw2 = 0; + return(0.0); + } +/* Number is denormal or zero */ +#if DENORMAL +/* Handle denormal number. */ + do + { + u.y *= 2.0; + i -= 1; + k = ( *q >> 7) & 0xff; + } + while( k == 0 ); + i = i + k; +#else + *pw2 = 0; + return( 0.0 ); +#endif /* DENORMAL */ + } +i -= 0x7e; +*pw2 = i; +*q &= 0x807f; /* strip all exponent bits */ +*q |= 0x3f00; /* mantissa between 0.5 and 1 */ +return( u.y ); +} + + + + + +float ldexpf( float x, int pw2 ) +{ +union + { + float y; + unsigned short i[2]; + } u; +short *q; +int e; + +#ifdef UNK +printf( "%s\n", unkmsg ); +return(0.0); +#endif + +u.y = x; +#ifdef DEC +q = &u.i[0]; +#endif + +#ifdef IBMPC +q = &u.i[1]; +#endif +#ifdef MIEEE +q = &u.i[0]; +#endif +while( (e = ( *q >> 7) & 0xff) == 0 ) + { + if( u.y == (float )0.0 ) + { + return( 0.0 ); + } +/* Input is denormal. */ + if( pw2 > 0 ) + { + u.y *= 2.0; + pw2 -= 1; + } + if( pw2 < 0 ) + { + if( pw2 < -24 ) + return( 0.0 ); + u.y *= 0.5; + pw2 += 1; + } + if( pw2 == 0 ) + return(u.y); + } + +e += pw2; + +/* Handle overflow */ +if( e > MEXP ) + { + return( MAXNUMF ); + } + +*q &= 0x807f; + +/* Handle denormalized results */ +if( e < 1 ) + { +#if DENORMAL + if( e < -24 ) + return( 0.0 ); + *q |= 0x80; /* Set LSB of exponent. */ + /* For denormals, significant bits may be lost even + when dividing by 2. Construct 2^-(1-e) so the result + is obtained with only one multiplication. */ + u.y *= ldexpf(1.0f, e - 1); + return(u.y); +#else + return( 0.0 ); +#endif + } +*q |= (e & 0xff) << 7; +return(u.y); +} + + +/* Return 1 if the sign bit of x is 1, else 0. */ + +int signbitf(x) +float x; +{ +union + { + float f; + short s[4]; + int i; + } u; + +u.f = x; + +if( sizeof(int) == 4 ) + { +#ifdef IBMPC + return( u.i < 0 ); +#endif +#ifdef DEC + return( u.s[1] < 0 ); +#endif +#ifdef MIEEE + return( u.i < 0 ); +#endif + } +else + { +#ifdef IBMPC + return( u.s[1] < 0 ); +#endif +#ifdef DEC + return( u.s[1] < 0 ); +#endif +#ifdef MIEEE + return( u.s[0] < 0 ); +#endif + } +} + + +/* Return 1 if x is a number that is Not a Number, else return 0. */ + +int isnanf(x) +float x; +{ +#ifdef NANS +union + { + float f; + unsigned short s[2]; + unsigned int i; + } u; + +u.f = x; + +if( sizeof(int) == 4 ) + { +#ifdef IBMPC + if( ((u.i & 0x7f800000) == 0x7f800000) + && ((u.i & 0x007fffff) != 0) ) + return 1; +#endif +#ifdef DEC + if( (u.s[1] & 0x7f80) == 0) + { + if( (u.s[1] | u.s[0]) != 0 ) + return(1); + } +#endif +#ifdef MIEEE + if( ((u.i & 0x7f800000) == 0x7f800000) + && ((u.i & 0x007fffff) != 0) ) + return 1; +#endif + return(0); + } +else + { /* size int not 4 */ +#ifdef IBMPC + if( (u.s[1] & 0x7f80) == 0x7f80) + { + if( ((u.s[1] & 0x007f) | u.s[0]) != 0 ) + return(1); + } +#endif +#ifdef DEC + if( (u.s[1] & 0x7f80) == 0) + { + if( (u.s[1] | u.s[0]) != 0 ) + return(1); + } +#endif +#ifdef MIEEE + if( (u.s[0] & 0x7f80) == 0x7f80) + { + if( ((u.s[0] & 0x000f) | u.s[1]) != 0 ) + return(1); + } +#endif + return(0); + } /* size int not 4 */ + +#else +/* No NANS. */ +return(0); +#endif +} + + +/* Return 1 if x is not infinite and is not a NaN. */ + +int isfinitef(x) +float x; +{ +#ifdef INFINITIES +union + { + float f; + unsigned short s[2]; + unsigned int i; + } u; + +u.f = x; + +if( sizeof(int) == 4 ) + { +#ifdef IBMPC + if( (u.i & 0x7f800000) != 0x7f800000) + return 1; +#endif +#ifdef DEC + if( (u.s[1] & 0x7f80) == 0) + { + if( (u.s[1] | u.s[0]) != 0 ) + return(1); + } +#endif +#ifdef MIEEE + if( (u.i & 0x7f800000) != 0x7f800000) + return 1; +#endif + return(0); + } +else + { +#ifdef IBMPC + if( (u.s[1] & 0x7f80) != 0x7f80) + return 1; +#endif +#ifdef DEC + if( (u.s[1] & 0x7f80) == 0) + { + if( (u.s[1] | u.s[0]) != 0 ) + return(1); + } +#endif +#ifdef MIEEE + if( (u.s[0] & 0x7f80) != 0x7f80) + return 1; +#endif + return(0); + } +#else +/* No INFINITY. */ +return(1); +#endif +} diff --git a/libm/float/fresnlf.c b/libm/float/fresnlf.c new file mode 100644 index 000000000..d6ae773b1 --- /dev/null +++ b/libm/float/fresnlf.c @@ -0,0 +1,173 @@ +/* fresnlf.c + * + * Fresnel integral + * + * + * + * SYNOPSIS: + * + * float x, S, C; + * void fresnlf(); + * + * fresnlf( x, _&S, _&C ); + * + * + * DESCRIPTION: + * + * Evaluates the Fresnel integrals + * + * x + * - + * | | + * C(x) = | cos(pi/2 t**2) dt, + * | | + * - + * 0 + * + * x + * - + * | | + * S(x) = | sin(pi/2 t**2) dt. + * | | + * - + * 0 + * + * + * The integrals are evaluated by power series for small x. + * For x >= 1 auxiliary functions f(x) and g(x) are employed + * such that + * + * C(x) = 0.5 + f(x) sin( pi/2 x**2 ) - g(x) cos( pi/2 x**2 ) + * S(x) = 0.5 - f(x) cos( pi/2 x**2 ) - g(x) sin( pi/2 x**2 ) + * + * + * + * ACCURACY: + * + * Relative error. + * + * Arithmetic function domain # trials peak rms + * IEEE S(x) 0, 10 30000 1.1e-6 1.9e-7 + * IEEE C(x) 0, 10 30000 1.1e-6 2.0e-7 + */ + +/* +Cephes Math Library Release 2.1: January, 1989 +Copyright 1984, 1987, 1989 by Stephen L. Moshier +Direct inquiries to 30 Frost Street, Cambridge, MA 02140 +*/ + +#include <math.h> + +/* S(x) for small x */ +static float sn[7] = { + 1.647629463788700E-009, +-1.522754752581096E-007, + 8.424748808502400E-006, +-3.120693124703272E-004, + 7.244727626597022E-003, +-9.228055941124598E-002, + 5.235987735681432E-001 +}; + +/* C(x) for small x */ +static float cn[7] = { + 1.416802502367354E-008, +-1.157231412229871E-006, + 5.387223446683264E-005, +-1.604381798862293E-003, + 2.818489036795073E-002, +-2.467398198317899E-001, + 9.999999760004487E-001 +}; + + +/* Auxiliary function f(x) */ +static float fn[8] = { +-1.903009855649792E+012, + 1.355942388050252E+011, +-4.158143148511033E+009, + 7.343848463587323E+007, +-8.732356681548485E+005, + 8.560515466275470E+003, +-1.032877601091159E+002, + 2.999401847870011E+000 +}; + +/* Auxiliary function g(x) */ +static float gn[8] = { +-1.860843997624650E+011, + 1.278350673393208E+010, +-3.779387713202229E+008, + 6.492611570598858E+006, +-7.787789623358162E+004, + 8.602931494734327E+002, +-1.493439396592284E+001, + 9.999841934744914E-001 +}; + + +extern float PIF, PIO2F; + +#define fabsf(x) ( (x) < 0 ? -(x) : (x) ) + +#ifdef ANSIC +float polevlf( float, float *, int ); +float cosf(float), sinf(float); +#else +float polevlf(), cosf(), sinf(); +#endif + +void fresnlf( float xxa, float *ssa, float *cca ) +{ +float f, g, cc, ss, c, s, t, u, x, x2; + +x = xxa; +x = fabsf(x); +x2 = x * x; +if( x2 < 2.5625 ) + { + t = x2 * x2; + ss = x * x2 * polevlf( t, sn, 6); + cc = x * polevlf( t, cn, 6); + goto done; + } + +if( x > 36974.0 ) + { + cc = 0.5; + ss = 0.5; + goto done; + } + + +/* Asymptotic power series auxiliary functions + * for large argument + */ + x2 = x * x; + t = PIF * x2; + u = 1.0/(t * t); + t = 1.0/t; + f = 1.0 - u * polevlf( u, fn, 7); + g = t * polevlf( u, gn, 7); + + t = PIO2F * x2; + c = cosf(t); + s = sinf(t); + t = PIF * x; + cc = 0.5 + (f * s - g * c)/t; + ss = 0.5 - (f * c + g * s)/t; + +done: +if( xxa < 0.0 ) + { + cc = -cc; + ss = -ss; + } + +*cca = cc; +*ssa = ss; +#if !ANSIC +return 0; +#endif +} diff --git a/libm/float/gammaf.c b/libm/float/gammaf.c new file mode 100644 index 000000000..e8c4694c4 --- /dev/null +++ b/libm/float/gammaf.c @@ -0,0 +1,423 @@ +/* gammaf.c + * + * Gamma function + * + * + * + * SYNOPSIS: + * + * float x, y, gammaf(); + * extern int sgngamf; + * + * y = gammaf( x ); + * + * + * + * DESCRIPTION: + * + * Returns gamma function of the argument. The result is + * correctly signed, and the sign (+1 or -1) is also + * returned in a global (extern) variable named sgngamf. + * This same variable is also filled in by the logarithmic + * gamma function lgam(). + * + * Arguments between 0 and 10 are reduced by recurrence and the + * function is approximated by a polynomial function covering + * the interval (2,3). Large arguments are handled by Stirling's + * formula. Negative arguments are made positive using + * a reflection formula. + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE 0,-33 100,000 5.7e-7 1.0e-7 + * IEEE -33,0 100,000 6.1e-7 1.2e-7 + * + * + */ +/* lgamf() + * + * Natural logarithm of gamma function + * + * + * + * SYNOPSIS: + * + * float x, y, lgamf(); + * extern int sgngamf; + * + * y = lgamf( x ); + * + * + * + * DESCRIPTION: + * + * Returns the base e (2.718...) logarithm of the absolute + * value of the gamma function of the argument. + * The sign (+1 or -1) of the gamma function is returned in a + * global (extern) variable named sgngamf. + * + * For arguments greater than 6.5, the logarithm of the gamma + * function is approximated by the logarithmic version of + * Stirling's formula. Arguments between 0 and +6.5 are reduced by + * by recurrence to the interval [.75,1.25] or [1.5,2.5] of a rational + * approximation. The cosecant reflection formula is employed for + * arguments less than zero. + * + * Arguments greater than MAXLGM = 2.035093e36 return MAXNUM and an + * error message. + * + * + * + * ACCURACY: + * + * + * + * arithmetic domain # trials peak rms + * IEEE -100,+100 500,000 7.4e-7 6.8e-8 + * The error criterion was relative when the function magnitude + * was greater than one but absolute when it was less than one. + * The routine has low relative error for positive arguments. + * + * The following test used the relative error criterion. + * IEEE -2, +3 100000 4.0e-7 5.6e-8 + * + */ + +/* gamma.c */ +/* gamma function */ + +/* +Cephes Math Library Release 2.7: July, 1998 +Copyright 1984, 1987, 1989, 1992, 1998 by Stephen L. Moshier +*/ + + +#include <math.h> + +/* define MAXGAM 34.84425627277176174 */ + +/* Stirling's formula for the gamma function + * gamma(x) = sqrt(2 pi) x^(x-.5) exp(-x) ( 1 + 1/x P(1/x) ) + * .028 < 1/x < .1 + * relative error < 1.9e-11 + */ +static float STIR[] = { +-2.705194986674176E-003, + 3.473255786154910E-003, + 8.333331788340907E-002, +}; +static float MAXSTIR = 26.77; +static float SQTPIF = 2.50662827463100050242; /* sqrt( 2 pi ) */ + +int sgngamf = 0; +extern int sgngamf; +extern float MAXLOGF, MAXNUMF, PIF; + +#ifdef ANSIC +float expf(float); +float logf(float); +float powf( float, float ); +float sinf(float); +float gammaf(float); +float floorf(float); +static float stirf(float); +float polevlf( float, float *, int ); +float p1evlf( float, float *, int ); +#else +float expf(), logf(), powf(), sinf(), floorf(); +float polevlf(), p1evlf(); +static float stirf(); +#endif + +/* Gamma function computed by Stirling's formula, + * sqrt(2 pi) x^(x-.5) exp(-x) (1 + 1/x P(1/x)) + * The polynomial STIR is valid for 33 <= x <= 172. + */ +static float stirf( float xx ) +{ +float x, y, w, v; + +x = xx; +w = 1.0/x; +w = 1.0 + w * polevlf( w, STIR, 2 ); +y = expf( -x ); +if( x > MAXSTIR ) + { /* Avoid overflow in pow() */ + v = powf( x, 0.5 * x - 0.25 ); + y *= v; + y *= v; + } +else + { + y = powf( x, x - 0.5 ) * y; + } +y = SQTPIF * y * w; +return( y ); +} + + +/* gamma(x+2), 0 < x < 1 */ +static float P[] = { + 1.536830450601906E-003, + 5.397581592950993E-003, + 4.130370201859976E-003, + 7.232307985516519E-002, + 8.203960091619193E-002, + 4.117857447645796E-001, + 4.227867745131584E-001, + 9.999999822945073E-001, +}; + +float gammaf( float xx ) +{ +float p, q, x, z, nz; +int i, direction, negative; + +x = xx; +sgngamf = 1; +negative = 0; +nz = 0.0; +if( x < 0.0 ) + { + negative = 1; + q = -x; + p = floorf(q); + if( p == q ) + goto goverf; + i = p; + if( (i & 1) == 0 ) + sgngamf = -1; + nz = q - p; + if( nz > 0.5 ) + { + p += 1.0; + nz = q - p; + } + nz = q * sinf( PIF * nz ); + if( nz == 0.0 ) + { +goverf: + mtherr( "gamma", OVERFLOW ); + return( sgngamf * MAXNUMF); + } + if( nz < 0 ) + nz = -nz; + x = q; + } +if( x >= 10.0 ) + { + z = stirf(x); + } +if( x < 2.0 ) + direction = 1; +else + direction = 0; +z = 1.0; +while( x >= 3.0 ) + { + x -= 1.0; + z *= x; + } +/* +while( x < 0.0 ) + { + if( x > -1.E-4 ) + goto small; + z *=x; + x += 1.0; + } +*/ +while( x < 2.0 ) + { + if( x < 1.e-4 ) + goto small; + z *=x; + x += 1.0; + } + +if( direction ) + z = 1.0/z; + +if( x == 2.0 ) + return(z); + +x -= 2.0; +p = z * polevlf( x, P, 7 ); + +gdone: + +if( negative ) + { + p = sgngamf * PIF/(nz * p ); + } +return(p); + +small: +if( x == 0.0 ) + { + mtherr( "gamma", SING ); + return( MAXNUMF ); + } +else + { + p = z / ((1.0 + 0.5772156649015329 * x) * x); + goto gdone; + } +} + + + + +/* log gamma(x+2), -.5 < x < .5 */ +static float B[] = { + 6.055172732649237E-004, +-1.311620815545743E-003, + 2.863437556468661E-003, +-7.366775108654962E-003, + 2.058355474821512E-002, +-6.735323259371034E-002, + 3.224669577325661E-001, + 4.227843421859038E-001 +}; + +/* log gamma(x+1), -.25 < x < .25 */ +static float C[] = { + 1.369488127325832E-001, +-1.590086327657347E-001, + 1.692415923504637E-001, +-2.067882815621965E-001, + 2.705806208275915E-001, +-4.006931650563372E-001, + 8.224670749082976E-001, +-5.772156501719101E-001 +}; + +/* log( sqrt( 2*pi ) ) */ +static float LS2PI = 0.91893853320467274178; +#define MAXLGM 2.035093e36 +static float PIINV = 0.318309886183790671538; + +/* Logarithm of gamma function */ + + +float lgamf( float xx ) +{ +float p, q, w, z, x; +float nx, tx; +int i, direction; + +sgngamf = 1; + +x = xx; +if( x < 0.0 ) + { + q = -x; + w = lgamf(q); /* note this modifies sgngam! */ + p = floorf(q); + if( p == q ) + goto loverf; + i = p; + if( (i & 1) == 0 ) + sgngamf = -1; + else + sgngamf = 1; + z = q - p; + if( z > 0.5 ) + { + p += 1.0; + z = p - q; + } + z = q * sinf( PIF * z ); + if( z == 0.0 ) + goto loverf; + z = -logf( PIINV*z ) - w; + return( z ); + } + +if( x < 6.5 ) + { + direction = 0; + z = 1.0; + tx = x; + nx = 0.0; + if( x >= 1.5 ) + { + while( tx > 2.5 ) + { + nx -= 1.0; + tx = x + nx; + z *=tx; + } + x += nx - 2.0; +iv1r5: + p = x * polevlf( x, B, 7 ); + goto cont; + } + if( x >= 1.25 ) + { + z *= x; + x -= 1.0; /* x + 1 - 2 */ + direction = 1; + goto iv1r5; + } + if( x >= 0.75 ) + { + x -= 1.0; + p = x * polevlf( x, C, 7 ); + q = 0.0; + goto contz; + } + while( tx < 1.5 ) + { + if( tx == 0.0 ) + goto loverf; + z *=tx; + nx += 1.0; + tx = x + nx; + } + direction = 1; + x += nx - 2.0; + p = x * polevlf( x, B, 7 ); + +cont: + if( z < 0.0 ) + { + sgngamf = -1; + z = -z; + } + else + { + sgngamf = 1; + } + q = logf(z); + if( direction ) + q = -q; +contz: + return( p + q ); + } + +if( x > MAXLGM ) + { +loverf: + mtherr( "lgamf", OVERFLOW ); + return( sgngamf * MAXNUMF ); + } + +/* Note, though an asymptotic formula could be used for x >= 3, + * there is cancellation error in the following if x < 6.5. */ +q = LS2PI - x; +q += ( x - 0.5 ) * logf(x); + +if( x <= 1.0e4 ) + { + z = 1.0/x; + p = z * z; + q += (( 6.789774945028216E-004 * p + - 2.769887652139868E-003 ) * p + + 8.333316229807355E-002 ) * z; + } +return( q ); +} diff --git a/libm/float/gdtrf.c b/libm/float/gdtrf.c new file mode 100644 index 000000000..e7e02026b --- /dev/null +++ b/libm/float/gdtrf.c @@ -0,0 +1,144 @@ +/* gdtrf.c + * + * Gamma distribution function + * + * + * + * SYNOPSIS: + * + * float a, b, x, y, gdtrf(); + * + * y = gdtrf( a, b, x ); + * + * + * + * DESCRIPTION: + * + * Returns the integral from zero to x of the gamma probability + * density function: + * + * + * x + * b - + * a | | b-1 -at + * y = ----- | t e dt + * - | | + * | (b) - + * 0 + * + * The incomplete gamma integral is used, according to the + * relation + * + * y = igam( b, ax ). + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE 0,100 5000 5.8e-5 3.0e-6 + * + * ERROR MESSAGES: + * + * message condition value returned + * gdtrf domain x < 0 0.0 + * + */ + /* gdtrcf.c + * + * Complemented gamma distribution function + * + * + * + * SYNOPSIS: + * + * float a, b, x, y, gdtrcf(); + * + * y = gdtrcf( a, b, x ); + * + * + * + * DESCRIPTION: + * + * Returns the integral from x to infinity of the gamma + * probability density function: + * + * + * inf. + * b - + * a | | b-1 -at + * y = ----- | t e dt + * - | | + * | (b) - + * x + * + * The incomplete gamma integral is used, according to the + * relation + * + * y = igamc( b, ax ). + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE 0,100 5000 9.1e-5 1.5e-5 + * + * ERROR MESSAGES: + * + * message condition value returned + * gdtrcf domain x < 0 0.0 + * + */ + +/* gdtr() */ + + +/* +Cephes Math Library Release 2.2: July, 1992 +Copyright 1984, 1987, 1992 by Stephen L. Moshier +Direct inquiries to 30 Frost Street, Cambridge, MA 02140 +*/ + +#include <math.h> +#ifdef ANSIC +float igamf(float, float), igamcf(float, float); +#else +float igamf(), igamcf(); +#endif + + + +float gdtrf( float aa, float bb, float xx ) +{ +float a, b, x; + +a = aa; +b = bb; +x = xx; + + +if( x < 0.0 ) + { + mtherr( "gdtrf", DOMAIN ); + return( 0.0 ); + } +return( igamf( b, a * x ) ); +} + + + +float gdtrcf( float aa, float bb, float xx ) +{ +float a, b, x; + +a = aa; +b = bb; +x = xx; +if( x < 0.0 ) + { + mtherr( "gdtrcf", DOMAIN ); + return( 0.0 ); + } +return( igamcf( b, a * x ) ); +} diff --git a/libm/float/hyp2f1f.c b/libm/float/hyp2f1f.c new file mode 100644 index 000000000..01fe54928 --- /dev/null +++ b/libm/float/hyp2f1f.c @@ -0,0 +1,442 @@ +/* hyp2f1f.c + * + * Gauss hypergeometric function F + * 2 1 + * + * + * SYNOPSIS: + * + * float a, b, c, x, y, hyp2f1f(); + * + * y = hyp2f1f( a, b, c, x ); + * + * + * DESCRIPTION: + * + * + * hyp2f1( a, b, c, x ) = F ( a, b; c; x ) + * 2 1 + * + * inf. + * - a(a+1)...(a+k) b(b+1)...(b+k) k+1 + * = 1 + > ----------------------------- x . + * - c(c+1)...(c+k) (k+1)! + * k = 0 + * + * Cases addressed are + * Tests and escapes for negative integer a, b, or c + * Linear transformation if c - a or c - b negative integer + * Special case c = a or c = b + * Linear transformation for x near +1 + * Transformation for x < -0.5 + * Psi function expansion if x > 0.5 and c - a - b integer + * Conditionally, a recurrence on c to make c-a-b > 0 + * + * |x| > 1 is rejected. + * + * The parameters a, b, c are considered to be integer + * valued if they are within 1.0e-6 of the nearest integer. + * + * ACCURACY: + * + * Relative error (-1 < x < 1): + * arithmetic domain # trials peak rms + * IEEE 0,3 30000 5.8e-4 4.3e-6 + */ + +/* hyp2f1 */ + + +/* +Cephes Math Library Release 2.2: November, 1992 +Copyright 1984, 1987, 1992 by Stephen L. Moshier +Direct inquiries to 30 Frost Street, Cambridge, MA 02140 +*/ + + +#include <math.h> + +#define EPS 1.0e-5 +#define EPS2 1.0e-5 +#define ETHRESH 1.0e-5 + +extern float MAXNUMF, MACHEPF; + +#define fabsf(x) ( (x) < 0 ? -(x) : (x) ) + +#ifdef ANSIC +float powf(float, float); +static float hys2f1f(float, float, float, float, float *); +static float hyt2f1f(float, float, float, float, float *); +float gammaf(float), logf(float), expf(float), psif(float); +float floorf(float); +#else +float powf(), gammaf(), logf(), expf(), psif(); +float floorf(); +static float hyt2f1f(), hys2f1f(); +#endif + +#define roundf(x) (floorf((x)+(float )0.5)) + + + + +float hyp2f1f( float aa, float bb, float cc, float xx ) +{ +float a, b, c, x; +float d, d1, d2, e; +float p, q, r, s, y, ax; +float ia, ib, ic, id, err; +int flag, i, aid; + +a = aa; +b = bb; +c = cc; +x = xx; +err = 0.0; +ax = fabsf(x); +s = 1.0 - x; +flag = 0; +ia = roundf(a); /* nearest integer to a */ +ib = roundf(b); + +if( a <= 0 ) + { + if( fabsf(a-ia) < EPS ) /* a is a negative integer */ + flag |= 1; + } + +if( b <= 0 ) + { + if( fabsf(b-ib) < EPS ) /* b is a negative integer */ + flag |= 2; + } + +if( ax < 1.0 ) + { + if( fabsf(b-c) < EPS ) /* b = c */ + { + y = powf( s, -a ); /* s to the -a power */ + goto hypdon; + } + if( fabsf(a-c) < EPS ) /* a = c */ + { + y = powf( s, -b ); /* s to the -b power */ + goto hypdon; + } + } + + + +if( c <= 0.0 ) + { + ic = roundf(c); /* nearest integer to c */ + if( fabsf(c-ic) < EPS ) /* c is a negative integer */ + { + /* check if termination before explosion */ + if( (flag & 1) && (ia > ic) ) + goto hypok; + if( (flag & 2) && (ib > ic) ) + goto hypok; + goto hypdiv; + } + } + +if( flag ) /* function is a polynomial */ + goto hypok; + +if( ax > 1.0 ) /* series diverges */ + goto hypdiv; + +p = c - a; +ia = roundf(p); +if( (ia <= 0.0) && (fabsf(p-ia) < EPS) ) /* negative int c - a */ + flag |= 4; + +r = c - b; +ib = roundf(r); /* nearest integer to r */ +if( (ib <= 0.0) && (fabsf(r-ib) < EPS) ) /* negative int c - b */ + flag |= 8; + +d = c - a - b; +id = roundf(d); /* nearest integer to d */ +q = fabsf(d-id); + +if( fabsf(ax-1.0) < EPS ) /* |x| == 1.0 */ + { + if( x > 0.0 ) + { + if( flag & 12 ) /* negative int c-a or c-b */ + { + if( d >= 0.0 ) + goto hypf; + else + goto hypdiv; + } + if( d <= 0.0 ) + goto hypdiv; + y = gammaf(c)*gammaf(d)/(gammaf(p)*gammaf(r)); + goto hypdon; + } + + if( d <= -1.0 ) + goto hypdiv; + } + +/* Conditionally make d > 0 by recurrence on c + * AMS55 #15.2.27 + */ +if( d < 0.0 ) + { +/* Try the power series first */ + y = hyt2f1f( a, b, c, x, &err ); + if( err < ETHRESH ) + goto hypdon; +/* Apply the recurrence if power series fails */ + err = 0.0; + aid = 2 - id; + e = c + aid; + d2 = hyp2f1f(a,b,e,x); + d1 = hyp2f1f(a,b,e+1.0,x); + q = a + b + 1.0; + for( i=0; i<aid; i++ ) + { + r = e - 1.0; + y = (e*(r-(2.0*e-q)*x)*d2 + (e-a)*(e-b)*x*d1)/(e*r*s); + e = r; + d1 = d2; + d2 = y; + } + goto hypdon; + } + + +if( flag & 12 ) + goto hypf; /* negative integer c-a or c-b */ + +hypok: +y = hyt2f1f( a, b, c, x, &err ); + +hypdon: +if( err > ETHRESH ) + { + mtherr( "hyp2f1", PLOSS ); +/* printf( "Estimated err = %.2e\n", err );*/ + } +return(y); + +/* The transformation for c-a or c-b negative integer + * AMS55 #15.3.3 + */ +hypf: +y = powf( s, d ) * hys2f1f( c-a, c-b, c, x, &err ); +goto hypdon; + +/* The alarm exit */ +hypdiv: +mtherr( "hyp2f1f", OVERFLOW ); +return( MAXNUMF ); +} + + + + +/* Apply transformations for |x| near 1 + * then call the power series + */ +static float hyt2f1f( float aa, float bb, float cc, float xx, float *loss ) +{ +float a, b, c, x; +float p, q, r, s, t, y, d, err, err1; +float ax, id, d1, d2, e, y1; +int i, aid; + +a = aa; +b = bb; +c = cc; +x = xx; +err = 0.0; +s = 1.0 - x; +if( x < -0.5 ) + { + if( b > a ) + y = powf( s, -a ) * hys2f1f( a, c-b, c, -x/s, &err ); + + else + y = powf( s, -b ) * hys2f1f( c-a, b, c, -x/s, &err ); + + goto done; + } + + + +d = c - a - b; +id = roundf(d); /* nearest integer to d */ + +if( x > 0.8 ) +{ + +if( fabsf(d-id) > EPS2 ) /* test for integer c-a-b */ + { +/* Try the power series first */ + y = hys2f1f( a, b, c, x, &err ); + if( err < ETHRESH ) + goto done; +/* If power series fails, then apply AMS55 #15.3.6 */ + q = hys2f1f( a, b, 1.0-d, s, &err ); + q *= gammaf(d) /(gammaf(c-a) * gammaf(c-b)); + r = powf(s,d) * hys2f1f( c-a, c-b, d+1.0, s, &err1 ); + r *= gammaf(-d)/(gammaf(a) * gammaf(b)); + y = q + r; + + q = fabsf(q); /* estimate cancellation error */ + r = fabsf(r); + if( q > r ) + r = q; + err += err1 + (MACHEPF*r)/y; + + y *= gammaf(c); + goto done; + } +else + { +/* Psi function expansion, AMS55 #15.3.10, #15.3.11, #15.3.12 */ + if( id >= 0.0 ) + { + e = d; + d1 = d; + d2 = 0.0; + aid = id; + } + else + { + e = -d; + d1 = 0.0; + d2 = d; + aid = -id; + } + + ax = logf(s); + + /* sum for t = 0 */ + y = psif(1.0) + psif(1.0+e) - psif(a+d1) - psif(b+d1) - ax; + y /= gammaf(e+1.0); + + p = (a+d1) * (b+d1) * s / gammaf(e+2.0); /* Poch for t=1 */ + t = 1.0; + do + { + r = psif(1.0+t) + psif(1.0+t+e) - psif(a+t+d1) + - psif(b+t+d1) - ax; + q = p * r; + y += q; + p *= s * (a+t+d1) / (t+1.0); + p *= (b+t+d1) / (t+1.0+e); + t += 1.0; + } + while( fabsf(q/y) > EPS ); + + + if( id == 0.0 ) + { + y *= gammaf(c)/(gammaf(a)*gammaf(b)); + goto psidon; + } + + y1 = 1.0; + + if( aid == 1 ) + goto nosum; + + t = 0.0; + p = 1.0; + for( i=1; i<aid; i++ ) + { + r = 1.0-e+t; + p *= s * (a+t+d2) * (b+t+d2) / r; + t += 1.0; + p /= t; + y1 += p; + } + + +nosum: + p = gammaf(c); + y1 *= gammaf(e) * p / (gammaf(a+d1) * gammaf(b+d1)); + y *= p / (gammaf(a+d2) * gammaf(b+d2)); + if( (aid & 1) != 0 ) + y = -y; + + q = powf( s, id ); /* s to the id power */ + if( id > 0.0 ) + y *= q; + else + y1 *= q; + + y += y1; +psidon: + goto done; + } +} + + +/* Use defining power series if no special cases */ +y = hys2f1f( a, b, c, x, &err ); + +done: +*loss = err; +return(y); +} + + + + + +/* Defining power series expansion of Gauss hypergeometric function */ + +static float hys2f1f( float aa, float bb, float cc, float xx, float *loss ) +{ +int i; +float a, b, c, x; +float f, g, h, k, m, s, u, umax; + + +a = aa; +b = bb; +c = cc; +x = xx; +i = 0; +umax = 0.0; +f = a; +g = b; +h = c; +k = 0.0; +s = 1.0; +u = 1.0; + +do + { + if( fabsf(h) < EPS ) + return( MAXNUMF ); + m = k + 1.0; + u = u * ((f+k) * (g+k) * x / ((h+k) * m)); + s += u; + k = fabsf(u); /* remember largest term summed */ + if( k > umax ) + umax = k; + k = m; + if( ++i > 10000 ) /* should never happen */ + { + *loss = 1.0; + return(s); + } + } +while( fabsf(u/s) > MACHEPF ); + +/* return estimated relative error */ +*loss = (MACHEPF*umax)/fabsf(s) + (MACHEPF*i); + +return(s); +} + + diff --git a/libm/float/hypergf.c b/libm/float/hypergf.c new file mode 100644 index 000000000..60d0eb4c5 --- /dev/null +++ b/libm/float/hypergf.c @@ -0,0 +1,384 @@ +/* hypergf.c + * + * Confluent hypergeometric function + * + * + * + * SYNOPSIS: + * + * float a, b, x, y, hypergf(); + * + * y = hypergf( a, b, x ); + * + * + * + * DESCRIPTION: + * + * Computes the confluent hypergeometric function + * + * 1 2 + * a x a(a+1) x + * F ( a,b;x ) = 1 + ---- + --------- + ... + * 1 1 b 1! b(b+1) 2! + * + * Many higher transcendental functions are special cases of + * this power series. + * + * As is evident from the formula, b must not be a negative + * integer or zero unless a is an integer with 0 >= a > b. + * + * The routine attempts both a direct summation of the series + * and an asymptotic expansion. In each case error due to + * roundoff, cancellation, and nonconvergence is estimated. + * The result with smaller estimated error is returned. + * + * + * + * ACCURACY: + * + * Tested at random points (a, b, x), all three variables + * ranging from 0 to 30. + * Relative error: + * arithmetic domain # trials peak rms + * IEEE 0,5 10000 6.6e-7 1.3e-7 + * IEEE 0,30 30000 1.1e-5 6.5e-7 + * + * Larger errors can be observed when b is near a negative + * integer or zero. Certain combinations of arguments yield + * serious cancellation error in the power series summation + * and also are not in the region of near convergence of the + * asymptotic series. An error message is printed if the + * self-estimated relative error is greater than 1.0e-3. + * + */ + +/* hyperg.c */ + + +/* +Cephes Math Library Release 2.1: November, 1988 +Copyright 1984, 1987, 1988 by Stephen L. Moshier +Direct inquiries to 30 Frost Street, Cambridge, MA 02140 +*/ + +#include <math.h> + +extern float MAXNUMF, MACHEPF; + +#define fabsf(x) ( (x) < 0 ? -(x) : (x) ) + +#ifdef ANSIC +float expf(float); +float hyp2f0f(float, float, float, int, float *); +static float hy1f1af(float, float, float, float *); +static float hy1f1pf(float, float, float, float *); +float logf(float), gammaf(float), lgamf(float); +#else +float expf(), hyp2f0f(); +float logf(), gammaf(), lgamf(); +static float hy1f1pf(), hy1f1af(); +#endif + +float hypergf( float aa, float bb, float xx ) +{ +float a, b, x, asum, psum, acanc, pcanc, temp; + + +a = aa; +b = bb; +x = xx; +/* See if a Kummer transformation will help */ +temp = b - a; +if( fabsf(temp) < 0.001 * fabsf(a) ) + return( expf(x) * hypergf( temp, b, -x ) ); + +psum = hy1f1pf( a, b, x, &pcanc ); +if( pcanc < 1.0e-6 ) + goto done; + + +/* try asymptotic series */ + +asum = hy1f1af( a, b, x, &acanc ); + + +/* Pick the result with less estimated error */ + +if( acanc < pcanc ) + { + pcanc = acanc; + psum = asum; + } + +done: +if( pcanc > 1.0e-3 ) + mtherr( "hyperg", PLOSS ); + +return( psum ); +} + + + + +/* Power series summation for confluent hypergeometric function */ + + +static float hy1f1pf( float aa, float bb, float xx, float *err ) +{ +float a, b, x, n, a0, sum, t, u, temp; +float an, bn, maxt, pcanc; + +a = aa; +b = bb; +x = xx; +/* set up for power series summation */ +an = a; +bn = b; +a0 = 1.0; +sum = 1.0; +n = 1.0; +t = 1.0; +maxt = 0.0; + + +while( t > MACHEPF ) + { + if( bn == 0 ) /* check bn first since if both */ + { + mtherr( "hypergf", SING ); + return( MAXNUMF ); /* an and bn are zero it is */ + } + if( an == 0 ) /* a singularity */ + return( sum ); + if( n > 200 ) + goto pdone; + u = x * ( an / (bn * n) ); + + /* check for blowup */ + temp = fabsf(u); + if( (temp > 1.0 ) && (maxt > (MAXNUMF/temp)) ) + { + pcanc = 1.0; /* estimate 100% error */ + goto blowup; + } + + a0 *= u; + sum += a0; + t = fabsf(a0); + if( t > maxt ) + maxt = t; +/* + if( (maxt/fabsf(sum)) > 1.0e17 ) + { + pcanc = 1.0; + goto blowup; + } +*/ + an += 1.0; + bn += 1.0; + n += 1.0; + } + +pdone: + +/* estimate error due to roundoff and cancellation */ +if( sum != 0.0 ) + maxt /= fabsf(sum); +maxt *= MACHEPF; /* this way avoids multiply overflow */ +pcanc = fabsf( MACHEPF * n + maxt ); + +blowup: + +*err = pcanc; + +return( sum ); +} + + +/* hy1f1a() */ +/* asymptotic formula for hypergeometric function: + * + * ( -a + * -- ( |z| + * | (b) ( -------- 2f0( a, 1+a-b, -1/x ) + * ( -- + * ( | (b-a) + * + * + * x a-b ) + * e |x| ) + * + -------- 2f0( b-a, 1-a, 1/x ) ) + * -- ) + * | (a) ) + */ + +static float hy1f1af( float aa, float bb, float xx, float *err ) +{ +float a, b, x, h1, h2, t, u, temp, acanc, asum, err1, err2; + +a = aa; +b = bb; +x = xx; +if( x == 0 ) + { + acanc = 1.0; + asum = MAXNUMF; + goto adone; + } +temp = logf( fabsf(x) ); +t = x + temp * (a-b); +u = -temp * a; + +if( b > 0 ) + { + temp = lgamf(b); + t += temp; + u += temp; + } + +h1 = hyp2f0f( a, a-b+1, -1.0/x, 1, &err1 ); + +temp = expf(u) / gammaf(b-a); +h1 *= temp; +err1 *= temp; + +h2 = hyp2f0f( b-a, 1.0-a, 1.0/x, 2, &err2 ); + +if( a < 0 ) + temp = expf(t) / gammaf(a); +else + temp = expf( t - lgamf(a) ); + +h2 *= temp; +err2 *= temp; + +if( x < 0.0 ) + asum = h1; +else + asum = h2; + +acanc = fabsf(err1) + fabsf(err2); + + +if( b < 0 ) + { + temp = gammaf(b); + asum *= temp; + acanc *= fabsf(temp); + } + + +if( asum != 0.0 ) + acanc /= fabsf(asum); + +acanc *= 30.0; /* fudge factor, since error of asymptotic formula + * often seems this much larger than advertised */ + +adone: + + +*err = acanc; +return( asum ); +} + +/* hyp2f0() */ + +float hyp2f0f(float aa, float bb, float xx, int type, float *err) +{ +float a, b, x, a0, alast, t, tlast, maxt; +float n, an, bn, u, sum, temp; + +a = aa; +b = bb; +x = xx; +an = a; +bn = b; +a0 = 1.0; +alast = 1.0; +sum = 0.0; +n = 1.0; +t = 1.0; +tlast = 1.0e9; +maxt = 0.0; + +do + { + if( an == 0 ) + goto pdone; + if( bn == 0 ) + goto pdone; + + u = an * (bn * x / n); + + /* check for blowup */ + temp = fabsf(u); + if( (temp > 1.0 ) && (maxt > (MAXNUMF/temp)) ) + goto error; + + a0 *= u; + t = fabsf(a0); + + /* terminating condition for asymptotic series */ + if( t > tlast ) + goto ndone; + + tlast = t; + sum += alast; /* the sum is one term behind */ + alast = a0; + + if( n > 200 ) + goto ndone; + + an += 1.0; + bn += 1.0; + n += 1.0; + if( t > maxt ) + maxt = t; + } +while( t > MACHEPF ); + + +pdone: /* series converged! */ + +/* estimate error due to roundoff and cancellation */ +*err = fabsf( MACHEPF * (n + maxt) ); + +alast = a0; +goto done; + +ndone: /* series did not converge */ + +/* The following "Converging factors" are supposed to improve accuracy, + * but do not actually seem to accomplish very much. */ + +n -= 1.0; +x = 1.0/x; + +switch( type ) /* "type" given as subroutine argument */ +{ +case 1: + alast *= ( 0.5 + (0.125 + 0.25*b - 0.5*a + 0.25*x - 0.25*n)/x ); + break; + +case 2: + alast *= 2.0/3.0 - b + 2.0*a + x - n; + break; + +default: + ; +} + +/* estimate error due to roundoff, cancellation, and nonconvergence */ +*err = MACHEPF * (n + maxt) + fabsf( a0 ); + + +done: +sum += alast; +return( sum ); + +/* series blew up: */ +error: +*err = MAXNUMF; +mtherr( "hypergf", TLOSS ); +return( sum ); +} diff --git a/libm/float/i0f.c b/libm/float/i0f.c new file mode 100644 index 000000000..bb62cf60a --- /dev/null +++ b/libm/float/i0f.c @@ -0,0 +1,160 @@ +/* i0f.c + * + * Modified Bessel function of order zero + * + * + * + * SYNOPSIS: + * + * float x, y, i0(); + * + * y = i0f( x ); + * + * + * + * DESCRIPTION: + * + * Returns modified Bessel function of order zero of the + * argument. + * + * The function is defined as i0(x) = j0( ix ). + * + * The range is partitioned into the two intervals [0,8] and + * (8, infinity). Chebyshev polynomial expansions are employed + * in each interval. + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE 0,30 100000 4.0e-7 7.9e-8 + * + */ + /* i0ef.c + * + * Modified Bessel function of order zero, + * exponentially scaled + * + * + * + * SYNOPSIS: + * + * float x, y, i0ef(); + * + * y = i0ef( x ); + * + * + * + * DESCRIPTION: + * + * Returns exponentially scaled modified Bessel function + * of order zero of the argument. + * + * The function is defined as i0e(x) = exp(-|x|) j0( ix ). + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE 0,30 100000 3.7e-7 7.0e-8 + * See i0f(). + * + */ + +/* i0.c */ + + +/* +Cephes Math Library Release 2.2: June, 1992 +Copyright 1984, 1987, 1992 by Stephen L. Moshier +Direct inquiries to 30 Frost Street, Cambridge, MA 02140 +*/ + +#include <math.h> + +/* Chebyshev coefficients for exp(-x) I0(x) + * in the interval [0,8]. + * + * lim(x->0){ exp(-x) I0(x) } = 1. + */ + +static float A[] = +{ +-1.30002500998624804212E-8f, + 6.04699502254191894932E-8f, +-2.67079385394061173391E-7f, + 1.11738753912010371815E-6f, +-4.41673835845875056359E-6f, + 1.64484480707288970893E-5f, +-5.75419501008210370398E-5f, + 1.88502885095841655729E-4f, +-5.76375574538582365885E-4f, + 1.63947561694133579842E-3f, +-4.32430999505057594430E-3f, + 1.05464603945949983183E-2f, +-2.37374148058994688156E-2f, + 4.93052842396707084878E-2f, +-9.49010970480476444210E-2f, + 1.71620901522208775349E-1f, +-3.04682672343198398683E-1f, + 6.76795274409476084995E-1f +}; + + +/* Chebyshev coefficients for exp(-x) sqrt(x) I0(x) + * in the inverted interval [8,infinity]. + * + * lim(x->inf){ exp(-x) sqrt(x) I0(x) } = 1/sqrt(2pi). + */ + +static float B[] = +{ + 3.39623202570838634515E-9f, + 2.26666899049817806459E-8f, + 2.04891858946906374183E-7f, + 2.89137052083475648297E-6f, + 6.88975834691682398426E-5f, + 3.36911647825569408990E-3f, + 8.04490411014108831608E-1f +}; + + +float chbevlf(float, float *, int), expf(float), sqrtf(float); + +float i0f( float x ) +{ +float y; + +if( x < 0 ) + x = -x; +if( x <= 8.0f ) + { + y = 0.5f*x - 2.0f; + return( expf(x) * chbevlf( y, A, 18 ) ); + } + +return( expf(x) * chbevlf( 32.0f/x - 2.0f, B, 7 ) / sqrtf(x) ); +} + + + +float chbevlf(float, float *, int), expf(float), sqrtf(float); + +float i0ef( float x ) +{ +float y; + +if( x < 0 ) + x = -x; +if( x <= 8.0f ) + { + y = 0.5f*x - 2.0f; + return( chbevlf( y, A, 18 ) ); + } + +return( chbevlf( 32.0f/x - 2.0f, B, 7 ) / sqrtf(x) ); +} diff --git a/libm/float/i1f.c b/libm/float/i1f.c new file mode 100644 index 000000000..e9741e1da --- /dev/null +++ b/libm/float/i1f.c @@ -0,0 +1,177 @@ +/* i1f.c + * + * Modified Bessel function of order one + * + * + * + * SYNOPSIS: + * + * float x, y, i1f(); + * + * y = i1f( x ); + * + * + * + * DESCRIPTION: + * + * Returns modified Bessel function of order one of the + * argument. + * + * The function is defined as i1(x) = -i j1( ix ). + * + * The range is partitioned into the two intervals [0,8] and + * (8, infinity). Chebyshev polynomial expansions are employed + * in each interval. + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE 0, 30 100000 1.5e-6 1.6e-7 + * + * + */ + /* i1ef.c + * + * Modified Bessel function of order one, + * exponentially scaled + * + * + * + * SYNOPSIS: + * + * float x, y, i1ef(); + * + * y = i1ef( x ); + * + * + * + * DESCRIPTION: + * + * Returns exponentially scaled modified Bessel function + * of order one of the argument. + * + * The function is defined as i1(x) = -i exp(-|x|) j1( ix ). + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE 0, 30 30000 1.5e-6 1.5e-7 + * See i1(). + * + */ + +/* i1.c 2 */ + + +/* +Cephes Math Library Release 2.0: March, 1987 +Copyright 1985, 1987 by Stephen L. Moshier +Direct inquiries to 30 Frost Street, Cambridge, MA 02140 +*/ + +#include <math.h> + +/* Chebyshev coefficients for exp(-x) I1(x) / x + * in the interval [0,8]. + * + * lim(x->0){ exp(-x) I1(x) / x } = 1/2. + */ + +static float A[] = +{ + 9.38153738649577178388E-9f, +-4.44505912879632808065E-8f, + 2.00329475355213526229E-7f, +-8.56872026469545474066E-7f, + 3.47025130813767847674E-6f, +-1.32731636560394358279E-5f, + 4.78156510755005422638E-5f, +-1.61760815825896745588E-4f, + 5.12285956168575772895E-4f, +-1.51357245063125314899E-3f, + 4.15642294431288815669E-3f, +-1.05640848946261981558E-2f, + 2.47264490306265168283E-2f, +-5.29459812080949914269E-2f, + 1.02643658689847095384E-1f, +-1.76416518357834055153E-1f, + 2.52587186443633654823E-1f +}; + + +/* Chebyshev coefficients for exp(-x) sqrt(x) I1(x) + * in the inverted interval [8,infinity]. + * + * lim(x->inf){ exp(-x) sqrt(x) I1(x) } = 1/sqrt(2pi). + */ + +static float B[] = +{ +-3.83538038596423702205E-9f, +-2.63146884688951950684E-8f, +-2.51223623787020892529E-7f, +-3.88256480887769039346E-6f, +-1.10588938762623716291E-4f, +-9.76109749136146840777E-3f, + 7.78576235018280120474E-1f +}; + +/* i1.c */ + +#define fabsf(x) ( (x) < 0 ? -(x) : (x) ) + +#ifdef ANSIC +float chbevlf(float, float *, int); +float expf(float), sqrtf(float); +#else +float chbevlf(), expf(), sqrtf(); +#endif + + +float i1f(float xx) +{ +float x, y, z; + +x = xx; +z = fabsf(x); +if( z <= 8.0f ) + { + y = 0.5f*z - 2.0f; + z = chbevlf( y, A, 17 ) * z * expf(z); + } +else + { + z = expf(z) * chbevlf( 32.0f/z - 2.0f, B, 7 ) / sqrtf(z); + } +if( x < 0.0f ) + z = -z; +return( z ); +} + +/* i1e() */ + +float i1ef( float xx ) +{ +float x, y, z; + +x = xx; +z = fabsf(x); +if( z <= 8.0f ) + { + y = 0.5f*z - 2.0f; + z = chbevlf( y, A, 17 ) * z; + } +else + { + z = chbevlf( 32.0f/z - 2.0f, B, 7 ) / sqrtf(z); + } +if( x < 0.0f ) + z = -z; +return( z ); +} diff --git a/libm/float/igamf.c b/libm/float/igamf.c new file mode 100644 index 000000000..c54225df4 --- /dev/null +++ b/libm/float/igamf.c @@ -0,0 +1,223 @@ +/* igamf.c + * + * Incomplete gamma integral + * + * + * + * SYNOPSIS: + * + * float a, x, y, igamf(); + * + * y = igamf( a, x ); + * + * + * + * DESCRIPTION: + * + * The function is defined by + * + * x + * - + * 1 | | -t a-1 + * igam(a,x) = ----- | e t dt. + * - | | + * | (a) - + * 0 + * + * + * In this implementation both arguments must be positive. + * The integral is evaluated by either a power series or + * continued fraction expansion, depending on the relative + * values of a and x. + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE 0,30 20000 7.8e-6 5.9e-7 + * + */ + /* igamcf() + * + * Complemented incomplete gamma integral + * + * + * + * SYNOPSIS: + * + * float a, x, y, igamcf(); + * + * y = igamcf( a, x ); + * + * + * + * DESCRIPTION: + * + * The function is defined by + * + * + * igamc(a,x) = 1 - igam(a,x) + * + * inf. + * - + * 1 | | -t a-1 + * = ----- | e t dt. + * - | | + * | (a) - + * x + * + * + * In this implementation both arguments must be positive. + * The integral is evaluated by either a power series or + * continued fraction expansion, depending on the relative + * values of a and x. + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE 0,30 30000 7.8e-6 5.9e-7 + * + */ + +/* +Cephes Math Library Release 2.2: June, 1992 +Copyright 1985, 1987, 1992 by Stephen L. Moshier +Direct inquiries to 30 Frost Street, Cambridge, MA 02140 +*/ + +#include <math.h> + +/* BIG = 1/MACHEPF */ +#define BIG 16777216. + +extern float MACHEPF, MAXLOGF; + +#ifdef ANSIC +float lgamf(float), expf(float), logf(float), igamf(float, float); +#else +float lgamf(), expf(), logf(), igamf(); +#endif + +#define fabsf(x) ( (x) < 0 ? -(x) : (x) ) + + + +float igamcf( float aa, float xx ) +{ +float a, x, ans, c, yc, ax, y, z; +float pk, pkm1, pkm2, qk, qkm1, qkm2; +float r, t; +static float big = BIG; + +a = aa; +x = xx; +if( (x <= 0) || ( a <= 0) ) + return( 1.0 ); + +if( (x < 1.0) || (x < a) ) + return( 1.0 - igamf(a,x) ); + +ax = a * logf(x) - x - lgamf(a); +if( ax < -MAXLOGF ) + { + mtherr( "igamcf", UNDERFLOW ); + return( 0.0 ); + } +ax = expf(ax); + +/* continued fraction */ +y = 1.0 - a; +z = x + y + 1.0; +c = 0.0; +pkm2 = 1.0; +qkm2 = x; +pkm1 = x + 1.0; +qkm1 = z * x; +ans = pkm1/qkm1; + +do + { + c += 1.0; + y += 1.0; + z += 2.0; + yc = y * c; + pk = pkm1 * z - pkm2 * yc; + qk = qkm1 * z - qkm2 * yc; + if( qk != 0 ) + { + r = pk/qk; + t = fabsf( (ans - r)/r ); + ans = r; + } + else + t = 1.0; + pkm2 = pkm1; + pkm1 = pk; + qkm2 = qkm1; + qkm1 = qk; + if( fabsf(pk) > big ) + { + pkm2 *= MACHEPF; + pkm1 *= MACHEPF; + qkm2 *= MACHEPF; + qkm1 *= MACHEPF; + } + } +while( t > MACHEPF ); + +return( ans * ax ); +} + + + +/* left tail of incomplete gamma function: + * + * inf. k + * a -x - x + * x e > ---------- + * - - + * k=0 | (a+k+1) + * + */ + +float igamf( float aa, float xx ) +{ +float a, x, ans, ax, c, r; + +a = aa; +x = xx; +if( (x <= 0) || ( a <= 0) ) + return( 0.0 ); + +if( (x > 1.0) && (x > a ) ) + return( 1.0 - igamcf(a,x) ); + +/* Compute x**a * exp(-x) / gamma(a) */ +ax = a * logf(x) - x - lgamf(a); +if( ax < -MAXLOGF ) + { + mtherr( "igamf", UNDERFLOW ); + return( 0.0 ); + } +ax = expf(ax); + +/* power series */ +r = a; +c = 1.0; +ans = 1.0; + +do + { + r += 1.0; + c *= x/r; + ans += c; + } +while( c/ans > MACHEPF ); + +return( ans * ax/a ); +} diff --git a/libm/float/igamif.c b/libm/float/igamif.c new file mode 100644 index 000000000..5a33b4982 --- /dev/null +++ b/libm/float/igamif.c @@ -0,0 +1,112 @@ +/* igamif() + * + * Inverse of complemented imcomplete gamma integral + * + * + * + * SYNOPSIS: + * + * float a, x, y, igamif(); + * + * x = igamif( a, y ); + * + * + * + * DESCRIPTION: + * + * Given y, the function finds x such that + * + * igamc( a, x ) = y. + * + * Starting with the approximate value + * + * 3 + * x = a t + * + * where + * + * t = 1 - d - ndtri(y) sqrt(d) + * + * and + * + * d = 1/9a, + * + * the routine performs up to 10 Newton iterations to find the + * root of igamc(a,x) - y = 0. + * + * + * ACCURACY: + * + * Tested for a ranging from 0 to 100 and x from 0 to 1. + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE 0,100 5000 1.0e-5 1.5e-6 + * + */ + +/* +Cephes Math Library Release 2.2: July, 1992 +Copyright 1984, 1987, 1992 by Stephen L. Moshier +Direct inquiries to 30 Frost Street, Cambridge, MA 02140 +*/ + +#include <math.h> + +extern float MACHEPF, MAXLOGF; + +#define fabsf(x) ( (x) < 0 ? -(x) : (x) ) + +#ifdef ANSIC +float igamcf(float, float); +float ndtrif(float), expf(float), logf(float), sqrtf(float), lgamf(float); +#else +float igamcf(); +float ndtrif(), expf(), logf(), sqrtf(), lgamf(); +#endif + + +float igamif( float aa, float yy0 ) +{ +float a, y0, d, y, x0, lgm; +int i; + +a = aa; +y0 = yy0; +/* approximation to inverse function */ +d = 1.0/(9.0*a); +y = ( 1.0 - d - ndtrif(y0) * sqrtf(d) ); +x0 = a * y * y * y; + +lgm = lgamf(a); + +for( i=0; i<10; i++ ) + { + if( x0 <= 0.0 ) + { + mtherr( "igamif", UNDERFLOW ); + return(0.0); + } + y = igamcf(a,x0); +/* compute the derivative of the function at this point */ + d = (a - 1.0) * logf(x0) - x0 - lgm; + if( d < -MAXLOGF ) + { + mtherr( "igamif", UNDERFLOW ); + goto done; + } + d = -expf(d); +/* compute the step to the next approximation of x */ + if( d == 0.0 ) + goto done; + d = (y - y0)/d; + x0 = x0 - d; + if( i < 3 ) + continue; + if( fabsf(d/x0) < (2.0 * MACHEPF) ) + goto done; + } + +done: +return( x0 ); +} diff --git a/libm/float/incbetf.c b/libm/float/incbetf.c new file mode 100644 index 000000000..fed9aae4b --- /dev/null +++ b/libm/float/incbetf.c @@ -0,0 +1,424 @@ +/* incbetf.c + * + * Incomplete beta integral + * + * + * SYNOPSIS: + * + * float a, b, x, y, incbetf(); + * + * y = incbetf( a, b, x ); + * + * + * DESCRIPTION: + * + * Returns incomplete beta integral of the arguments, evaluated + * from zero to x. The function is defined as + * + * x + * - - + * | (a+b) | | a-1 b-1 + * ----------- | t (1-t) dt. + * - - | | + * | (a) | (b) - + * 0 + * + * The domain of definition is 0 <= x <= 1. In this + * implementation a and b are restricted to positive values. + * The integral from x to 1 may be obtained by the symmetry + * relation + * + * 1 - incbet( a, b, x ) = incbet( b, a, 1-x ). + * + * The integral is evaluated by a continued fraction expansion. + * If a < 1, the function calls itself recursively after a + * transformation to increase a to a+1. + * + * ACCURACY: + * + * Tested at random points (a,b,x) with a and b in the indicated + * interval and x between 0 and 1. + * + * arithmetic domain # trials peak rms + * Relative error: + * IEEE 0,30 10000 3.7e-5 5.1e-6 + * IEEE 0,100 10000 1.7e-4 2.5e-5 + * The useful domain for relative error is limited by underflow + * of the single precision exponential function. + * Absolute error: + * IEEE 0,30 100000 2.2e-5 9.6e-7 + * IEEE 0,100 10000 6.5e-5 3.7e-6 + * + * Larger errors may occur for extreme ratios of a and b. + * + * ERROR MESSAGES: + * message condition value returned + * incbetf domain x<0, x>1 0.0 + */ + + +/* +Cephes Math Library, Release 2.2: July, 1992 +Copyright 1984, 1987, 1992 by Stephen L. Moshier +Direct inquiries to 30 Frost Street, Cambridge, MA 02140 +*/ + +#include <math.h> + +#ifdef ANSIC +float lgamf(float), expf(float), logf(float); +static float incbdf(float, float, float); +static float incbcff(float, float, float); +float incbpsf(float, float, float); +#else +float lgamf(), expf(), logf(); +float incbpsf(); +static float incbcff(), incbdf(); +#endif + +#define fabsf(x) ( (x) < 0 ? -(x) : (x) ) + +/* BIG = 1/MACHEPF */ +#define BIG 16777216. +extern float MACHEPF, MAXLOGF; +#define MINLOGF (-MAXLOGF) + +float incbetf( float aaa, float bbb, float xxx ) +{ +float aa, bb, xx, ans, a, b, t, x, onemx; +int flag; + +aa = aaa; +bb = bbb; +xx = xxx; +if( (xx <= 0.0) || ( xx >= 1.0) ) + { + if( xx == 0.0 ) + return(0.0); + if( xx == 1.0 ) + return( 1.0 ); + mtherr( "incbetf", DOMAIN ); + return( 0.0 ); + } + +onemx = 1.0 - xx; + + +/* transformation for small aa */ + +if( aa <= 1.0 ) + { + ans = incbetf( aa+1.0, bb, xx ); + t = aa*logf(xx) + bb*logf( 1.0-xx ) + + lgamf(aa+bb) - lgamf(aa+1.0) - lgamf(bb); + if( t > MINLOGF ) + ans += expf(t); + return( ans ); + } + + +/* see if x is greater than the mean */ + +if( xx > (aa/(aa+bb)) ) + { + flag = 1; + a = bb; + b = aa; + t = xx; + x = onemx; + } +else + { + flag = 0; + a = aa; + b = bb; + t = onemx; + x = xx; + } + +/* transformation for small aa */ +/* +if( a <= 1.0 ) + { + ans = a*logf(x) + b*logf( onemx ) + + lgamf(a+b) - lgamf(a+1.0) - lgamf(b); + t = incbetf( a+1.0, b, x ); + if( ans > MINLOGF ) + t += expf(ans); + goto bdone; + } +*/ +/* Choose expansion for optimal convergence */ + + +if( b > 10.0 ) + { +if( fabsf(b*x/a) < 0.3 ) + { + t = incbpsf( a, b, x ); + goto bdone; + } + } + +ans = x * (a+b-2.0)/(a-1.0); +if( ans < 1.0 ) + { + ans = incbcff( a, b, x ); + t = b * logf( t ); + } +else + { + ans = incbdf( a, b, x ); + t = (b-1.0) * logf(t); + } + +t += a*logf(x) + lgamf(a+b) - lgamf(a) - lgamf(b); +t += logf( ans/a ); + +if( t < MINLOGF ) + { + t = 0.0; + if( flag == 0 ) + { + mtherr( "incbetf", UNDERFLOW ); + } + } +else + { + t = expf(t); + } +bdone: + +if( flag ) + t = 1.0 - t; + +return( t ); +} + +/* Continued fraction expansion #1 + * for incomplete beta integral + */ + +static float incbcff( float aa, float bb, float xx ) +{ +float a, b, x, xk, pk, pkm1, pkm2, qk, qkm1, qkm2; +float k1, k2, k3, k4, k5, k6, k7, k8; +float r, t, ans; +static float big = BIG; +int n; + +a = aa; +b = bb; +x = xx; +k1 = a; +k2 = a + b; +k3 = a; +k4 = a + 1.0; +k5 = 1.0; +k6 = b - 1.0; +k7 = k4; +k8 = a + 2.0; + +pkm2 = 0.0; +qkm2 = 1.0; +pkm1 = 1.0; +qkm1 = 1.0; +ans = 1.0; +r = 0.0; +n = 0; +do + { + + xk = -( x * k1 * k2 )/( k3 * k4 ); + pk = pkm1 + pkm2 * xk; + qk = qkm1 + qkm2 * xk; + pkm2 = pkm1; + pkm1 = pk; + qkm2 = qkm1; + qkm1 = qk; + + xk = ( x * k5 * k6 )/( k7 * k8 ); + pk = pkm1 + pkm2 * xk; + qk = qkm1 + qkm2 * xk; + pkm2 = pkm1; + pkm1 = pk; + qkm2 = qkm1; + qkm1 = qk; + + if( qk != 0 ) + r = pk/qk; + if( r != 0 ) + { + t = fabsf( (ans - r)/r ); + ans = r; + } + else + t = 1.0; + + if( t < MACHEPF ) + goto cdone; + + k1 += 1.0; + k2 += 1.0; + k3 += 2.0; + k4 += 2.0; + k5 += 1.0; + k6 -= 1.0; + k7 += 2.0; + k8 += 2.0; + + if( (fabsf(qk) + fabsf(pk)) > big ) + { + pkm2 *= MACHEPF; + pkm1 *= MACHEPF; + qkm2 *= MACHEPF; + qkm1 *= MACHEPF; + } + if( (fabsf(qk) < MACHEPF) || (fabsf(pk) < MACHEPF) ) + { + pkm2 *= big; + pkm1 *= big; + qkm2 *= big; + qkm1 *= big; + } + } +while( ++n < 100 ); + +cdone: +return(ans); +} + + +/* Continued fraction expansion #2 + * for incomplete beta integral + */ + +static float incbdf( float aa, float bb, float xx ) +{ +float a, b, x, xk, pk, pkm1, pkm2, qk, qkm1, qkm2; +float k1, k2, k3, k4, k5, k6, k7, k8; +float r, t, ans, z; +static float big = BIG; +int n; + +a = aa; +b = bb; +x = xx; +k1 = a; +k2 = b - 1.0; +k3 = a; +k4 = a + 1.0; +k5 = 1.0; +k6 = a + b; +k7 = a + 1.0;; +k8 = a + 2.0; + +pkm2 = 0.0; +qkm2 = 1.0; +pkm1 = 1.0; +qkm1 = 1.0; +z = x / (1.0-x); +ans = 1.0; +r = 0.0; +n = 0; +do + { + + xk = -( z * k1 * k2 )/( k3 * k4 ); + pk = pkm1 + pkm2 * xk; + qk = qkm1 + qkm2 * xk; + pkm2 = pkm1; + pkm1 = pk; + qkm2 = qkm1; + qkm1 = qk; + + xk = ( z * k5 * k6 )/( k7 * k8 ); + pk = pkm1 + pkm2 * xk; + qk = qkm1 + qkm2 * xk; + pkm2 = pkm1; + pkm1 = pk; + qkm2 = qkm1; + qkm1 = qk; + + if( qk != 0 ) + r = pk/qk; + if( r != 0 ) + { + t = fabsf( (ans - r)/r ); + ans = r; + } + else + t = 1.0; + + if( t < MACHEPF ) + goto cdone; + + k1 += 1.0; + k2 -= 1.0; + k3 += 2.0; + k4 += 2.0; + k5 += 1.0; + k6 += 1.0; + k7 += 2.0; + k8 += 2.0; + + if( (fabsf(qk) + fabsf(pk)) > big ) + { + pkm2 *= MACHEPF; + pkm1 *= MACHEPF; + qkm2 *= MACHEPF; + qkm1 *= MACHEPF; + } + if( (fabsf(qk) < MACHEPF) || (fabsf(pk) < MACHEPF) ) + { + pkm2 *= big; + pkm1 *= big; + qkm2 *= big; + qkm1 *= big; + } + } +while( ++n < 100 ); + +cdone: +return(ans); +} + + +/* power series */ +float incbpsf( float aa, float bb, float xx ) +{ +float a, b, x, t, u, y, s; + +a = aa; +b = bb; +x = xx; + +y = a * logf(x) + (b-1.0)*logf(1.0-x) - logf(a); +y -= lgamf(a) + lgamf(b); +y += lgamf(a+b); + + +t = x / (1.0 - x); +s = 0.0; +u = 1.0; +do + { + b -= 1.0; + if( b == 0.0 ) + break; + a += 1.0; + u *= t*b/a; + s += u; + } +while( fabsf(u) > MACHEPF ); + +if( y < MINLOGF ) + { + mtherr( "incbetf", UNDERFLOW ); + s = 0.0; + } +else + s = expf(y) * (1.0 + s); +/*printf( "incbpsf: %.4e\n", s );*/ +return(s); +} diff --git a/libm/float/incbif.c b/libm/float/incbif.c new file mode 100644 index 000000000..4d8c0652e --- /dev/null +++ b/libm/float/incbif.c @@ -0,0 +1,197 @@ +/* incbif() + * + * Inverse of imcomplete beta integral + * + * + * + * SYNOPSIS: + * + * float a, b, x, y, incbif(); + * + * x = incbif( a, b, y ); + * + * + * + * DESCRIPTION: + * + * Given y, the function finds x such that + * + * incbet( a, b, x ) = y. + * + * the routine performs up to 10 Newton iterations to find the + * root of incbet(a,b,x) - y = 0. + * + * + * ACCURACY: + * + * Relative error: + * x a,b + * arithmetic domain domain # trials peak rms + * IEEE 0,1 0,100 5000 2.8e-4 8.3e-6 + * + * Overflow and larger errors may occur for one of a or b near zero + * and the other large. + */ + + +/* +Cephes Math Library Release 2.2: July, 1992 +Copyright 1984, 1987, 1992 by Stephen L. Moshier +Direct inquiries to 30 Frost Street, Cambridge, MA 02140 +*/ + +#include <math.h> + +extern float MACHEPF, MINLOGF; + +#define fabsf(x) ( (x) < 0 ? -(x) : (x) ) + +#ifdef ANSIC +float incbetf(float, float, float); +float ndtrif(float), expf(float), logf(float), sqrtf(float), lgamf(float); +#else +float incbetf(); +float ndtrif(), expf(), logf(), sqrtf(), lgamf(); +#endif + +float incbif( float aaa, float bbb, float yyy0 ) +{ +float aa, bb, yy0, a, b, y0; +float d, y, x, x0, x1, lgm, yp, di; +int i, rflg; + + +aa = aaa; +bb = bbb; +yy0 = yyy0; +if( yy0 <= 0 ) + return(0.0); +if( yy0 >= 1.0 ) + return(1.0); + +/* approximation to inverse function */ + +yp = -ndtrif(yy0); + +if( yy0 > 0.5 ) + { + rflg = 1; + a = bb; + b = aa; + y0 = 1.0 - yy0; + yp = -yp; + } +else + { + rflg = 0; + a = aa; + b = bb; + y0 = yy0; + } + + +if( (aa <= 1.0) || (bb <= 1.0) ) + { + y = 0.5 * yp * yp; + } +else + { + lgm = (yp * yp - 3.0)* 0.16666666666666667; + x0 = 2.0/( 1.0/(2.0*a-1.0) + 1.0/(2.0*b-1.0) ); + y = yp * sqrtf( x0 + lgm ) / x0 + - ( 1.0/(2.0*b-1.0) - 1.0/(2.0*a-1.0) ) + * (lgm + 0.833333333333333333 - 2.0/(3.0*x0)); + y = 2.0 * y; + if( y < MINLOGF ) + { + x0 = 1.0; + goto under; + } + } + +x = a/( a + b * expf(y) ); +y = incbetf( a, b, x ); +yp = (y - y0)/y0; +if( fabsf(yp) < 0.1 ) + goto newt; + +/* Resort to interval halving if not close enough */ +x0 = 0.0; +x1 = 1.0; +di = 0.5; + +for( i=0; i<20; i++ ) + { + if( i != 0 ) + { + x = di * x1 + (1.0-di) * x0; + y = incbetf( a, b, x ); + yp = (y - y0)/y0; + if( fabsf(yp) < 1.0e-3 ) + goto newt; + } + + if( y < y0 ) + { + x0 = x; + di = 0.5; + } + else + { + x1 = x; + di *= di; + if( di == 0.0 ) + di = 0.5; + } + } + +if( x0 == 0.0 ) + { +under: + mtherr( "incbif", UNDERFLOW ); + goto done; + } + +newt: + +x0 = x; +lgm = lgamf(a+b) - lgamf(a) - lgamf(b); + +for( i=0; i<10; i++ ) + { +/* compute the function at this point */ + if( i != 0 ) + y = incbetf(a,b,x0); +/* compute the derivative of the function at this point */ + d = (a - 1.0) * logf(x0) + (b - 1.0) * logf(1.0-x0) + lgm; + if( d < MINLOGF ) + { + x0 = 0.0; + goto under; + } + d = expf(d); +/* compute the step to the next approximation of x */ + d = (y - y0)/d; + x = x0; + x0 = x0 - d; + if( x0 <= 0.0 ) + { + x0 = 0.0; + goto under; + } + if( x0 >= 1.0 ) + { + x0 = 1.0; + goto under; + } + if( i < 2 ) + continue; + if( fabsf(d/x0) < 256.0 * MACHEPF ) + goto done; + } + +done: +if( rflg ) + x0 = 1.0 - x0; +return( x0 ); +} diff --git a/libm/float/ivf.c b/libm/float/ivf.c new file mode 100644 index 000000000..b7ab2b619 --- /dev/null +++ b/libm/float/ivf.c @@ -0,0 +1,114 @@ +/* ivf.c + * + * Modified Bessel function of noninteger order + * + * + * + * SYNOPSIS: + * + * float v, x, y, ivf(); + * + * y = ivf( v, x ); + * + * + * + * DESCRIPTION: + * + * Returns modified Bessel function of order v of the + * argument. If x is negative, v must be integer valued. + * + * The function is defined as Iv(x) = Jv( ix ). It is + * here computed in terms of the confluent hypergeometric + * function, according to the formula + * + * v -x + * Iv(x) = (x/2) e hyperg( v+0.5, 2v+1, 2x ) / gamma(v+1) + * + * If v is a negative integer, then v is replaced by -v. + * + * + * ACCURACY: + * + * Tested at random points (v, x), with v between 0 and + * 30, x between 0 and 28. + * arithmetic domain # trials peak rms + * Relative error: + * IEEE 0,15 3000 4.7e-6 5.4e-7 + * Absolute error (relative when function > 1) + * IEEE 0,30 5000 8.5e-6 1.3e-6 + * + * Accuracy is diminished if v is near a negative integer. + * The useful domain for relative error is limited by overflow + * of the single precision exponential function. + * + * See also hyperg.c. + * + */ + /* iv.c */ +/* Modified Bessel function of noninteger order */ +/* If x < 0, then v must be an integer. */ + + +/* +Cephes Math Library Release 2.2: June, 1992 +Copyright 1984, 1987, 1988, 1992 by Stephen L. Moshier +Direct inquiries to 30 Frost Street, Cambridge, MA 02140 +*/ + + +#include <math.h> + +extern float MAXNUMF; +#define fabsf(x) ( (x) < 0 ? -(x) : (x) ) + +float hypergf(float, float, float); +float expf(float), gammaf(float), logf(float), floorf(float); + +float ivf( float v, float x ) +{ +int sign; +float t, ax; + +/* If v is a negative integer, invoke symmetry */ +t = floorf(v); +if( v < 0.0 ) + { + if( t == v ) + { + v = -v; /* symmetry */ + t = -t; + } + } +/* If x is negative, require v to be an integer */ +sign = 1; +if( x < 0.0 ) + { + if( t != v ) + { + mtherr( "ivf", DOMAIN ); + return( 0.0 ); + } + if( v != 2.0 * floorf(v/2.0) ) + sign = -1; + } + +/* Avoid logarithm singularity */ +if( x == 0.0 ) + { + if( v == 0.0 ) + return( 1.0 ); + if( v < 0.0 ) + { + mtherr( "ivf", OVERFLOW ); + return( MAXNUMF ); + } + else + return( 0.0 ); + } + +ax = fabsf(x); +t = v * logf( 0.5 * ax ) - x; +t = sign * expf(t) / gammaf( v + 1.0 ); +ax = v + 0.5; +return( t * hypergf( ax, 2.0 * ax, 2.0 * x ) ); +} diff --git a/libm/float/j0f.c b/libm/float/j0f.c new file mode 100644 index 000000000..2b0d4a5a4 --- /dev/null +++ b/libm/float/j0f.c @@ -0,0 +1,228 @@ +/* j0f.c + * + * Bessel function of order zero + * + * + * + * SYNOPSIS: + * + * float x, y, j0f(); + * + * y = j0f( x ); + * + * + * + * DESCRIPTION: + * + * Returns Bessel function of order zero of the argument. + * + * The domain is divided into the intervals [0, 2] and + * (2, infinity). In the first interval the following polynomial + * approximation is used: + * + * + * 2 2 2 + * (w - r ) (w - r ) (w - r ) P(w) + * 1 2 3 + * + * 2 + * where w = x and the three r's are zeros of the function. + * + * In the second interval, the modulus and phase are approximated + * by polynomials of the form Modulus(x) = sqrt(1/x) Q(1/x) + * and Phase(x) = x + 1/x R(1/x^2) - pi/4. The function is + * + * j0(x) = Modulus(x) cos( Phase(x) ). + * + * + * + * ACCURACY: + * + * Absolute error: + * arithmetic domain # trials peak rms + * IEEE 0, 2 100000 1.3e-7 3.6e-8 + * IEEE 2, 32 100000 1.9e-7 5.4e-8 + * + */ + /* y0f.c + * + * Bessel function of the second kind, order zero + * + * + * + * SYNOPSIS: + * + * float x, y, y0f(); + * + * y = y0f( x ); + * + * + * + * DESCRIPTION: + * + * Returns Bessel function of the second kind, of order + * zero, of the argument. + * + * The domain is divided into the intervals [0, 2] and + * (2, infinity). In the first interval a rational approximation + * R(x) is employed to compute + * + * 2 2 2 + * y0(x) = (w - r ) (w - r ) (w - r ) R(x) + 2/pi ln(x) j0(x). + * 1 2 3 + * + * Thus a call to j0() is required. The three zeros are removed + * from R(x) to improve its numerical stability. + * + * In the second interval, the modulus and phase are approximated + * by polynomials of the form Modulus(x) = sqrt(1/x) Q(1/x) + * and Phase(x) = x + 1/x S(1/x^2) - pi/4. Then the function is + * + * y0(x) = Modulus(x) sin( Phase(x) ). + * + * + * + * + * ACCURACY: + * + * Absolute error, when y0(x) < 1; else relative error: + * + * arithmetic domain # trials peak rms + * IEEE 0, 2 100000 2.4e-7 3.4e-8 + * IEEE 2, 32 100000 1.8e-7 5.3e-8 + * + */ + +/* +Cephes Math Library Release 2.2: June, 1992 +Copyright 1984, 1987, 1989, 1992 by Stephen L. Moshier +Direct inquiries to 30 Frost Street, Cambridge, MA 02140 +*/ + + +#include <math.h> + +static float MO[8] = { +-6.838999669318810E-002f, + 1.864949361379502E-001f, +-2.145007480346739E-001f, + 1.197549369473540E-001f, +-3.560281861530129E-003f, +-4.969382655296620E-002f, +-3.355424622293709E-006f, + 7.978845717621440E-001f +}; + +static float PH[8] = { + 3.242077816988247E+001f, +-3.630592630518434E+001f, + 1.756221482109099E+001f, +-4.974978466280903E+000f, + 1.001973420681837E+000f, +-1.939906941791308E-001f, + 6.490598792654666E-002f, +-1.249992184872738E-001f +}; + +static float YP[5] = { + 9.454583683980369E-008f, +-9.413212653797057E-006f, + 5.344486707214273E-004f, +-1.584289289821316E-002f, + 1.707584643733568E-001f +}; + +float YZ1 = 0.43221455686510834878f; +float YZ2 = 22.401876406482861405f; +float YZ3 = 64.130620282338755553f; + +static float DR1 = 5.78318596294678452118f; +/* +static float DR2 = 30.4712623436620863991; +static float DR3 = 74.887006790695183444889; +*/ + +static float JP[5] = { +-6.068350350393235E-008f, + 6.388945720783375E-006f, +-3.969646342510940E-004f, + 1.332913422519003E-002f, +-1.729150680240724E-001f +}; +extern float PIO4F; + + +float polevlf(float, float *, int); +float logf(float), sinf(float), cosf(float), sqrtf(float); + +float j0f( float xx ) +{ +float x, w, z, p, q, xn; + + +if( xx < 0 ) + x = -xx; +else + x = xx; + +if( x <= 2.0f ) + { + z = x * x; + if( x < 1.0e-3f ) + return( 1.0f - 0.25f*z ); + + p = (z-DR1) * polevlf( z, JP, 4); + return( p ); + } + +q = 1.0f/x; +w = sqrtf(q); + +p = w * polevlf( q, MO, 7); +w = q*q; +xn = q * polevlf( w, PH, 7) - PIO4F; +p = p * cosf(xn + x); +return(p); +} + +/* y0() 2 */ +/* Bessel function of second kind, order zero */ + +/* Rational approximation coefficients YP[] are used for x < 6.5. + * The function computed is y0(x) - 2 ln(x) j0(x) / pi, + * whose value at x = 0 is 2 * ( log(0.5) + EUL ) / pi + * = 0.073804295108687225 , EUL is Euler's constant. + */ + +static float TWOOPI = 0.636619772367581343075535f; /* 2/pi */ +extern float MAXNUMF; + +float y0f( float xx ) +{ +float x, w, z, p, q, xn; + + +x = xx; +if( x <= 2.0f ) + { + if( x <= 0.0f ) + { + mtherr( "y0f", DOMAIN ); + return( -MAXNUMF ); + } + z = x * x; +/* w = (z-YZ1)*(z-YZ2)*(z-YZ3) * polevlf( z, YP, 4);*/ + w = (z-YZ1) * polevlf( z, YP, 4); + w += TWOOPI * logf(x) * j0f(x); + return( w ); + } + +q = 1.0f/x; +w = sqrtf(q); + +p = w * polevlf( q, MO, 7); +w = q*q; +xn = q * polevlf( w, PH, 7) - PIO4F; +p = p * sinf(xn + x); +return( p ); +} diff --git a/libm/float/j0tst.c b/libm/float/j0tst.c new file mode 100644 index 000000000..e5a5607d7 --- /dev/null +++ b/libm/float/j0tst.c @@ -0,0 +1,43 @@ +float z[20] = { +2.4048254489898681641, +5.5200781822204589844, +8.6537275314331054687, +11.791533470153808594, +14.930917739868164062, +18.071063995361328125, +21.211637496948242188, +24.352472305297851563, +27.493478775024414062, +30.634607315063476562, +33.775821685791015625, +36.9170989990234375, +40.0584259033203125, +43.19979095458984375, +46.3411865234375, +49.482608795166015625, +52.624050140380859375, +55.76551055908203125, +58.906982421875, +62.04846954345703125, +}; + +/* #if ANSIC */ +#if __STDC__ +float j0f(float); +#else +float j0f(); +#endif + +int main() +{ +float y; +int i; + +for (i = 0; i< 20; i++) + { + y = j0f(z[i]); + printf("%.9e\n", y); + } +exit(0); +} + diff --git a/libm/float/j1f.c b/libm/float/j1f.c new file mode 100644 index 000000000..4306e9747 --- /dev/null +++ b/libm/float/j1f.c @@ -0,0 +1,211 @@ +/* j1f.c + * + * Bessel function of order one + * + * + * + * SYNOPSIS: + * + * float x, y, j1f(); + * + * y = j1f( x ); + * + * + * + * DESCRIPTION: + * + * Returns Bessel function of order one of the argument. + * + * The domain is divided into the intervals [0, 2] and + * (2, infinity). In the first interval a polynomial approximation + * 2 + * (w - r ) x P(w) + * 1 + * 2 + * is used, where w = x and r is the first zero of the function. + * + * In the second interval, the modulus and phase are approximated + * by polynomials of the form Modulus(x) = sqrt(1/x) Q(1/x) + * and Phase(x) = x + 1/x R(1/x^2) - 3pi/4. The function is + * + * j0(x) = Modulus(x) cos( Phase(x) ). + * + * + * + * ACCURACY: + * + * Absolute error: + * arithmetic domain # trials peak rms + * IEEE 0, 2 100000 1.2e-7 2.5e-8 + * IEEE 2, 32 100000 2.0e-7 5.3e-8 + * + * + */ + /* y1.c + * + * Bessel function of second kind of order one + * + * + * + * SYNOPSIS: + * + * double x, y, y1(); + * + * y = y1( x ); + * + * + * + * DESCRIPTION: + * + * Returns Bessel function of the second kind of order one + * of the argument. + * + * The domain is divided into the intervals [0, 2] and + * (2, infinity). In the first interval a rational approximation + * R(x) is employed to compute + * + * 2 + * y0(x) = (w - r ) x R(x^2) + 2/pi (ln(x) j1(x) - 1/x) . + * 1 + * + * Thus a call to j1() is required. + * + * In the second interval, the modulus and phase are approximated + * by polynomials of the form Modulus(x) = sqrt(1/x) Q(1/x) + * and Phase(x) = x + 1/x S(1/x^2) - 3pi/4. Then the function is + * + * y0(x) = Modulus(x) sin( Phase(x) ). + * + * + * + * + * ACCURACY: + * + * Absolute error: + * arithmetic domain # trials peak rms + * IEEE 0, 2 100000 2.2e-7 4.6e-8 + * IEEE 2, 32 100000 1.9e-7 5.3e-8 + * + * (error criterion relative when |y1| > 1). + * + */ + + +/* +Cephes Math Library Release 2.2: June, 1992 +Copyright 1984, 1987, 1989, 1992 by Stephen L. Moshier +Direct inquiries to 30 Frost Street, Cambridge, MA 02140 +*/ + + +#include <math.h> + + +static float JP[5] = { +-4.878788132172128E-009f, + 6.009061827883699E-007f, +-4.541343896997497E-005f, + 1.937383947804541E-003f, +-3.405537384615824E-002f +}; + +static float YP[5] = { + 8.061978323326852E-009f, +-9.496460629917016E-007f, + 6.719543806674249E-005f, +-2.641785726447862E-003f, + 4.202369946500099E-002f +}; + +static float MO1[8] = { + 6.913942741265801E-002f, +-2.284801500053359E-001f, + 3.138238455499697E-001f, +-2.102302420403875E-001f, + 5.435364690523026E-003f, + 1.493389585089498E-001f, + 4.976029650847191E-006f, + 7.978845453073848E-001f +}; + +static float PH1[8] = { +-4.497014141919556E+001f, + 5.073465654089319E+001f, +-2.485774108720340E+001f, + 7.222973196770240E+000f, +-1.544842782180211E+000f, + 3.503787691653334E-001f, +-1.637986776941202E-001f, + 3.749989509080821E-001f +}; + +static float YO1 = 4.66539330185668857532f; +static float Z1 = 1.46819706421238932572E1f; + +static float THPIO4F = 2.35619449019234492885f; /* 3*pi/4 */ +static float TWOOPI = 0.636619772367581343075535f; /* 2/pi */ +extern float PIO4; + + +float polevlf(float, float *, int); +float logf(float), sinf(float), cosf(float), sqrtf(float); + +float j1f( float xx ) +{ +float x, w, z, p, q, xn; + + +x = xx; +if( x < 0 ) + x = -xx; + +if( x <= 2.0f ) + { + z = x * x; + p = (z-Z1) * x * polevlf( z, JP, 4 ); + return( p ); + } + +q = 1.0f/x; +w = sqrtf(q); + +p = w * polevlf( q, MO1, 7); +w = q*q; +xn = q * polevlf( w, PH1, 7) - THPIO4F; +p = p * cosf(xn + x); +return(p); +} + + + + +extern float MAXNUMF; + +float y1f( float xx ) +{ +float x, w, z, p, q, xn; + + +x = xx; +if( x <= 2.0f ) + { + if( x <= 0.0f ) + { + mtherr( "y1f", DOMAIN ); + return( -MAXNUMF ); + } + z = x * x; + w = (z - YO1) * x * polevlf( z, YP, 4 ); + w += TWOOPI * ( j1f(x) * logf(x) - 1.0f/x ); + return( w ); + } + +q = 1.0f/x; +w = sqrtf(q); + +p = w * polevlf( q, MO1, 7); +w = q*q; +xn = q * polevlf( w, PH1, 7) - THPIO4F; +p = p * sinf(xn + x); +return(p); +} diff --git a/libm/float/jnf.c b/libm/float/jnf.c new file mode 100644 index 000000000..de358e0ef --- /dev/null +++ b/libm/float/jnf.c @@ -0,0 +1,124 @@ +/* jnf.c + * + * Bessel function of integer order + * + * + * + * SYNOPSIS: + * + * int n; + * float x, y, jnf(); + * + * y = jnf( n, x ); + * + * + * + * DESCRIPTION: + * + * Returns Bessel function of order n, where n is a + * (possibly negative) integer. + * + * The ratio of jn(x) to j0(x) is computed by backward + * recurrence. First the ratio jn/jn-1 is found by a + * continued fraction expansion. Then the recurrence + * relating successive orders is applied until j0 or j1 is + * reached. + * + * If n = 0 or 1 the routine for j0 or j1 is called + * directly. + * + * + * + * ACCURACY: + * + * Absolute error: + * arithmetic range # trials peak rms + * IEEE 0, 15 30000 3.6e-7 3.6e-8 + * + * + * Not suitable for large n or x. Use jvf() instead. + * + */ + +/* jn.c +Cephes Math Library Release 2.2: June, 1992 +Copyright 1984, 1987, 1992 by Stephen L. Moshier +Direct inquiries to 30 Frost Street, Cambridge, MA 02140 +*/ +#include <math.h> + +extern float MACHEPF; + +float j0f(float), j1f(float); + +float jnf( int n, float xx ) +{ +float x, pkm2, pkm1, pk, xk, r, ans, xinv, sign; +int k; + +x = xx; +sign = 1.0; +if( n < 0 ) + { + n = -n; + if( (n & 1) != 0 ) /* -1**n */ + sign = -1.0; + } + +if( n == 0 ) + return( sign * j0f(x) ); +if( n == 1 ) + return( sign * j1f(x) ); +if( n == 2 ) + return( sign * (2.0 * j1f(x) / x - j0f(x)) ); + +/* +if( x < MACHEPF ) + return( 0.0 ); +*/ + +/* continued fraction */ +k = 24; +pk = 2 * (n + k); +ans = pk; +xk = x * x; + +do + { + pk -= 2.0; + ans = pk - (xk/ans); + } +while( --k > 0 ); +/*ans = x/ans;*/ + +/* backward recurrence */ + +pk = 1.0; +/*pkm1 = 1.0/ans;*/ +xinv = 1.0/x; +pkm1 = ans * xinv; +k = n-1; +r = (float )(2 * k); + +do + { + pkm2 = (pkm1 * r - pk * x) * xinv; + pk = pkm1; + pkm1 = pkm2; + r -= 2.0; + } +while( --k > 0 ); + +r = pk; +if( r < 0 ) + r = -r; +ans = pkm1; +if( ans < 0 ) + ans = -ans; + +if( r > ans ) /* if( fabs(pk) > fabs(pkm1) ) */ + ans = sign * j1f(x)/pk; +else + ans = sign * j0f(x)/pkm1; +return( ans ); +} diff --git a/libm/float/jvf.c b/libm/float/jvf.c new file mode 100644 index 000000000..268a8e4eb --- /dev/null +++ b/libm/float/jvf.c @@ -0,0 +1,848 @@ +/* jvf.c + * + * Bessel function of noninteger order + * + * + * + * SYNOPSIS: + * + * float v, x, y, jvf(); + * + * y = jvf( v, x ); + * + * + * + * DESCRIPTION: + * + * Returns Bessel function of order v of the argument, + * where v is real. Negative x is allowed if v is an integer. + * + * Several expansions are included: the ascending power + * series, the Hankel expansion, and two transitional + * expansions for large v. If v is not too large, it + * is reduced by recurrence to a region of best accuracy. + * + * The single precision routine accepts negative v, but with + * reduced accuracy. + * + * + * + * ACCURACY: + * Results for integer v are indicated by *. + * Error criterion is absolute, except relative when |jv()| > 1. + * + * arithmetic domain # trials peak rms + * v x + * IEEE 0,125 0,125 30000 2.0e-6 2.0e-7 + * IEEE -17,0 0,125 30000 1.1e-5 4.0e-7 + * IEEE -100,0 0,125 3000 1.5e-4 7.8e-6 + */ + + +/* +Cephes Math Library Release 2.2: June, 1992 +Copyright 1984, 1987, 1989, 1992 by Stephen L. Moshier +Direct inquiries to 30 Frost Street, Cambridge, MA 02140 +*/ + + +#include <math.h> +#define DEBUG 0 + +extern float MAXNUMF, MACHEPF, MINLOGF, MAXLOGF, PIF; +extern int sgngamf; + +/* BIG = 1/MACHEPF */ +#define BIG 16777216. + +#ifdef ANSIC +float floorf(float), j0f(float), j1f(float); +static float jnxf(float, float); +static float jvsf(float, float); +static float hankelf(float, float); +static float jntf(float, float); +static float recurf( float *, float, float * ); +float sqrtf(float), sinf(float), cosf(float); +float lgamf(float), expf(float), logf(float), powf(float, float); +float gammaf(float), cbrtf(float), acosf(float); +int airyf(float, float *, float *, float *, float *); +float polevlf(float, float *, int); +#else +float floorf(), j0f(), j1f(); +float sqrtf(), sinf(), cosf(); +float lgamf(), expf(), logf(), powf(), gammaf(); +float cbrtf(), polevlf(), acosf(); +void airyf(); +static float recurf(), jvsf(), hankelf(), jnxf(), jntf(), jvsf(); +#endif + + +#define fabsf(x) ( (x) < 0 ? -(x) : (x) ) + +float jvf( float nn, float xx ) +{ +float n, x, k, q, t, y, an, sign; +int i, nint; + +n = nn; +x = xx; +nint = 0; /* Flag for integer n */ +sign = 1.0; /* Flag for sign inversion */ +an = fabsf( n ); +y = floorf( an ); +if( y == an ) + { + nint = 1; + i = an - 16384.0 * floorf( an/16384.0 ); + if( n < 0.0 ) + { + if( i & 1 ) + sign = -sign; + n = an; + } + if( x < 0.0 ) + { + if( i & 1 ) + sign = -sign; + x = -x; + } + if( n == 0.0 ) + return( j0f(x) ); + if( n == 1.0 ) + return( sign * j1f(x) ); + } + +if( (x < 0.0) && (y != an) ) + { + mtherr( "jvf", DOMAIN ); + y = 0.0; + goto done; + } + +y = fabsf(x); + +if( y < MACHEPF ) + goto underf; + +/* Easy cases - x small compared to n */ +t = 3.6 * sqrtf(an); +if( y < t ) + return( sign * jvsf(n,x) ); + +/* x large compared to n */ +k = 3.6 * sqrtf(y); +if( (an < k) && (y > 6.0) ) + return( sign * hankelf(n,x) ); + +if( (n > -100) && (n < 14.0) ) + { +/* Note: if x is too large, the continued + * fraction will fail; but then the + * Hankel expansion can be used. + */ + if( nint != 0 ) + { + k = 0.0; + q = recurf( &n, x, &k ); + if( k == 0.0 ) + { + y = j0f(x)/q; + goto done; + } + if( k == 1.0 ) + { + y = j1f(x)/q; + goto done; + } + } + + if( n >= 0.0 ) + { +/* Recur backwards from a larger value of n + */ + if( y > 1.3 * an ) + goto recurdwn; + if( an > 1.3 * y ) + goto recurdwn; + k = n; + y = 2.0*(y+an+1.0); + if( (y - n) > 33.0 ) + y = n + 33.0; + y = n + floorf(y-n); + q = recurf( &y, x, &k ); + y = jvsf(y,x) * q; + goto done; + } +recurdwn: + if( an > (k + 3.0) ) + { +/* Recur backwards from n to k + */ + if( n < 0.0 ) + k = -k; + q = n - floorf(n); + k = floorf(k) + q; + if( n > 0.0 ) + q = recurf( &n, x, &k ); + else + { + t = k; + k = n; + q = recurf( &t, x, &k ); + k = t; + } + if( q == 0.0 ) + { +underf: + y = 0.0; + goto done; + } + } + else + { + k = n; + q = 1.0; + } + +/* boundary between convergence of + * power series and Hankel expansion + */ + t = fabsf(k); + if( t < 26.0 ) + t = (0.0083*t + 0.09)*t + 12.9; + else + t = 0.9 * t; + + if( y > t ) /* y = |x| */ + y = hankelf(k,x); + else + y = jvsf(k,x); +#if DEBUG +printf( "y = %.16e, q = %.16e\n", y, q ); +#endif + if( n > 0.0 ) + y /= q; + else + y *= q; + } + +else + { +/* For large positive n, use the uniform expansion + * or the transitional expansion. + * But if x is of the order of n**2, + * these may blow up, whereas the + * Hankel expansion will then work. + */ + if( n < 0.0 ) + { + mtherr( "jvf", TLOSS ); + y = 0.0; + goto done; + } + t = y/an; + t /= an; + if( t > 0.3 ) + y = hankelf(n,x); + else + y = jnxf(n,x); + } + +done: return( sign * y); +} + +/* Reduce the order by backward recurrence. + * AMS55 #9.1.27 and 9.1.73. + */ + +static float recurf( float *n, float xx, float *newn ) +{ +float x, pkm2, pkm1, pk, pkp1, qkm2, qkm1; +float k, ans, qk, xk, yk, r, t, kf, xinv; +static float big = BIG; +int nflag, ctr; + +x = xx; +/* continued fraction for Jn(x)/Jn-1(x) */ +if( *n < 0.0 ) + nflag = 1; +else + nflag = 0; + +fstart: + +#if DEBUG +printf( "n = %.6e, newn = %.6e, cfrac = ", *n, *newn ); +#endif + +pkm2 = 0.0; +qkm2 = 1.0; +pkm1 = x; +qkm1 = *n + *n; +xk = -x * x; +yk = qkm1; +ans = 1.0; +ctr = 0; +do + { + yk += 2.0; + pk = pkm1 * yk + pkm2 * xk; + qk = qkm1 * yk + qkm2 * xk; + pkm2 = pkm1; + pkm1 = pk; + qkm2 = qkm1; + qkm1 = qk; + if( qk != 0 ) + r = pk/qk; + else + r = 0.0; + if( r != 0 ) + { + t = fabsf( (ans - r)/r ); + ans = r; + } + else + t = 1.0; + + if( t < MACHEPF ) + goto done; + + if( fabsf(pk) > big ) + { + pkm2 *= MACHEPF; + pkm1 *= MACHEPF; + qkm2 *= MACHEPF; + qkm1 *= MACHEPF; + } + } +while( t > MACHEPF ); + +done: + +#if DEBUG +printf( "%.6e\n", ans ); +#endif + +/* Change n to n-1 if n < 0 and the continued fraction is small + */ +if( nflag > 0 ) + { + if( fabsf(ans) < 0.125 ) + { + nflag = -1; + *n = *n - 1.0; + goto fstart; + } + } + + +kf = *newn; + +/* backward recurrence + * 2k + * J (x) = --- J (x) - J (x) + * k-1 x k k+1 + */ + +pk = 1.0; +pkm1 = 1.0/ans; +k = *n - 1.0; +r = 2 * k; +xinv = 1.0/x; +do + { + pkm2 = (pkm1 * r - pk * x) * xinv; + pkp1 = pk; + pk = pkm1; + pkm1 = pkm2; + r -= 2.0; +#if 0 + t = fabsf(pkp1) + fabsf(pk); + if( (k > (kf + 2.5)) && (fabsf(pkm1) < 0.25*t) ) + { + k -= 1.0; + t = x*x; + pkm2 = ( (r*(r+2.0)-t)*pk - r*x*pkp1 )/t; + pkp1 = pk; + pk = pkm1; + pkm1 = pkm2; + r -= 2.0; + } +#endif + k -= 1.0; + } +while( k > (kf + 0.5) ); + +#if 0 +/* Take the larger of the last two iterates + * on the theory that it may have less cancellation error. + */ +if( (kf >= 0.0) && (fabsf(pk) > fabsf(pkm1)) ) + { + k += 1.0; + pkm2 = pk; + } +#endif + +*newn = k; +#if DEBUG +printf( "newn %.6e\n", k ); +#endif +return( pkm2 ); +} + + + +/* Ascending power series for Jv(x). + * AMS55 #9.1.10. + */ + +static float jvsf( float nn, float xx ) +{ +float n, x, t, u, y, z, k, ay; + +#if DEBUG +printf( "jvsf: " ); +#endif +n = nn; +x = xx; +z = -0.25 * x * x; +u = 1.0; +y = u; +k = 1.0; +t = 1.0; + +while( t > MACHEPF ) + { + u *= z / (k * (n+k)); + y += u; + k += 1.0; + t = fabsf(u); + if( (ay = fabsf(y)) > 1.0 ) + t /= ay; + } + +if( x < 0.0 ) + { + y = y * powf( 0.5 * x, n ) / gammaf( n + 1.0 ); + } +else + { + t = n * logf(0.5*x) - lgamf(n + 1.0); + if( t < -MAXLOGF ) + { + return( 0.0 ); + } + if( t > MAXLOGF ) + { + t = logf(y) + t; + if( t > MAXLOGF ) + { + mtherr( "jvf", OVERFLOW ); + return( MAXNUMF ); + } + else + { + y = sgngamf * expf(t); + return(y); + } + } + y = sgngamf * y * expf( t ); + } +#if DEBUG +printf( "y = %.8e\n", y ); +#endif +return(y); +} + +/* Hankel's asymptotic expansion + * for large x. + * AMS55 #9.2.5. + */ +static float hankelf( float nn, float xx ) +{ +float n, x, t, u, z, k, sign, conv; +float p, q, j, m, pp, qq; +int flag; + +#if DEBUG +printf( "hankelf: " ); +#endif +n = nn; +x = xx; +m = 4.0*n*n; +j = 1.0; +z = 8.0 * x; +k = 1.0; +p = 1.0; +u = (m - 1.0)/z; +q = u; +sign = 1.0; +conv = 1.0; +flag = 0; +t = 1.0; +pp = 1.0e38; +qq = 1.0e38; + +while( t > MACHEPF ) + { + k += 2.0; + j += 1.0; + sign = -sign; + u *= (m - k * k)/(j * z); + p += sign * u; + k += 2.0; + j += 1.0; + u *= (m - k * k)/(j * z); + q += sign * u; + t = fabsf(u/p); + if( t < conv ) + { + conv = t; + qq = q; + pp = p; + flag = 1; + } +/* stop if the terms start getting larger */ + if( (flag != 0) && (t > conv) ) + { +#if DEBUG + printf( "Hankel: convergence to %.4E\n", conv ); +#endif + goto hank1; + } + } + +hank1: +u = x - (0.5*n + 0.25) * PIF; +t = sqrtf( 2.0/(PIF*x) ) * ( pp * cosf(u) - qq * sinf(u) ); +return( t ); +} + + +/* Asymptotic expansion for large n. + * AMS55 #9.3.35. + */ + +static float lambda[] = { + 1.0, + 1.041666666666666666666667E-1, + 8.355034722222222222222222E-2, + 1.282265745563271604938272E-1, + 2.918490264641404642489712E-1, + 8.816272674437576524187671E-1, + 3.321408281862767544702647E+0, + 1.499576298686255465867237E+1, + 7.892301301158651813848139E+1, + 4.744515388682643231611949E+2, + 3.207490090890661934704328E+3 +}; +static float mu[] = { + 1.0, + -1.458333333333333333333333E-1, + -9.874131944444444444444444E-2, + -1.433120539158950617283951E-1, + -3.172272026784135480967078E-1, + -9.424291479571202491373028E-1, + -3.511203040826354261542798E+0, + -1.572726362036804512982712E+1, + -8.228143909718594444224656E+1, + -4.923553705236705240352022E+2, + -3.316218568547972508762102E+3 +}; +static float P1[] = { + -2.083333333333333333333333E-1, + 1.250000000000000000000000E-1 +}; +static float P2[] = { + 3.342013888888888888888889E-1, + -4.010416666666666666666667E-1, + 7.031250000000000000000000E-2 +}; +static float P3[] = { + -1.025812596450617283950617E+0, + 1.846462673611111111111111E+0, + -8.912109375000000000000000E-1, + 7.324218750000000000000000E-2 +}; +static float P4[] = { + 4.669584423426247427983539E+0, + -1.120700261622299382716049E+1, + 8.789123535156250000000000E+0, + -2.364086914062500000000000E+0, + 1.121520996093750000000000E-1 +}; +static float P5[] = { + -2.8212072558200244877E1, + 8.4636217674600734632E1, + -9.1818241543240017361E1, + 4.2534998745388454861E1, + -7.3687943594796316964E0, + 2.27108001708984375E-1 +}; +static float P6[] = { + 2.1257013003921712286E2, + -7.6525246814118164230E2, + 1.0599904525279998779E3, + -6.9957962737613254123E2, + 2.1819051174421159048E2, + -2.6491430486951555525E1, + 5.7250142097473144531E-1 +}; +static float P7[] = { + -1.9194576623184069963E3, + 8.0617221817373093845E3, + -1.3586550006434137439E4, + 1.1655393336864533248E4, + -5.3056469786134031084E3, + 1.2009029132163524628E3, + -1.0809091978839465550E2, + 1.7277275025844573975E0 +}; + + +static float jnxf( float nn, float xx ) +{ +float n, x, zeta, sqz, zz, zp, np; +float cbn, n23, t, z, sz; +float pp, qq, z32i, zzi; +float ak, bk, akl, bkl; +int sign, doa, dob, nflg, k, s, tk, tkp1, m; +static float u[8]; +static float ai, aip, bi, bip; + +n = nn; +x = xx; +/* Test for x very close to n. + * Use expansion for transition region if so. + */ +cbn = cbrtf(n); +z = (x - n)/cbn; +if( (fabsf(z) <= 0.7) || (n < 0.0) ) + return( jntf(n,x) ); +z = x/n; +zz = 1.0 - z*z; +if( zz == 0.0 ) + return(0.0); + +if( zz > 0.0 ) + { + sz = sqrtf( zz ); + t = 1.5 * (logf( (1.0+sz)/z ) - sz ); /* zeta ** 3/2 */ + zeta = cbrtf( t * t ); + nflg = 1; + } +else + { + sz = sqrtf(-zz); + t = 1.5 * (sz - acosf(1.0/z)); + zeta = -cbrtf( t * t ); + nflg = -1; + } +z32i = fabsf(1.0/t); +sqz = cbrtf(t); + +/* Airy function */ +n23 = cbrtf( n * n ); +t = n23 * zeta; + +#if DEBUG +printf("zeta %.5E, Airyf(%.5E)\n", zeta, t ); +#endif +airyf( t, &ai, &aip, &bi, &bip ); + +/* polynomials in expansion */ +u[0] = 1.0; +zzi = 1.0/zz; +u[1] = polevlf( zzi, P1, 1 )/sz; +u[2] = polevlf( zzi, P2, 2 )/zz; +u[3] = polevlf( zzi, P3, 3 )/(sz*zz); +pp = zz*zz; +u[4] = polevlf( zzi, P4, 4 )/pp; +u[5] = polevlf( zzi, P5, 5 )/(pp*sz); +pp *= zz; +u[6] = polevlf( zzi, P6, 6 )/pp; +u[7] = polevlf( zzi, P7, 7 )/(pp*sz); + +#if DEBUG +for( k=0; k<=7; k++ ) + printf( "u[%d] = %.5E\n", k, u[k] ); +#endif + +pp = 0.0; +qq = 0.0; +np = 1.0; +/* flags to stop when terms get larger */ +doa = 1; +dob = 1; +akl = MAXNUMF; +bkl = MAXNUMF; + +for( k=0; k<=3; k++ ) + { + tk = 2 * k; + tkp1 = tk + 1; + zp = 1.0; + ak = 0.0; + bk = 0.0; + for( s=0; s<=tk; s++ ) + { + if( doa ) + { + if( (s & 3) > 1 ) + sign = nflg; + else + sign = 1; + ak += sign * mu[s] * zp * u[tk-s]; + } + + if( dob ) + { + m = tkp1 - s; + if( ((m+1) & 3) > 1 ) + sign = nflg; + else + sign = 1; + bk += sign * lambda[s] * zp * u[m]; + } + zp *= z32i; + } + + if( doa ) + { + ak *= np; + t = fabsf(ak); + if( t < akl ) + { + akl = t; + pp += ak; + } + else + doa = 0; + } + + if( dob ) + { + bk += lambda[tkp1] * zp * u[0]; + bk *= -np/sqz; + t = fabsf(bk); + if( t < bkl ) + { + bkl = t; + qq += bk; + } + else + dob = 0; + } +#if DEBUG + printf("a[%d] %.5E, b[%d] %.5E\n", k, ak, k, bk ); +#endif + if( np < MACHEPF ) + break; + np /= n*n; + } + +/* normalizing factor ( 4*zeta/(1 - z**2) )**1/4 */ +t = 4.0 * zeta/zz; +t = sqrtf( sqrtf(t) ); + +t *= ai*pp/cbrtf(n) + aip*qq/(n23*n); +return(t); +} + +/* Asymptotic expansion for transition region, + * n large and x close to n. + * AMS55 #9.3.23. + */ + +static float PF2[] = { + -9.0000000000000000000e-2, + 8.5714285714285714286e-2 +}; +static float PF3[] = { + 1.3671428571428571429e-1, + -5.4920634920634920635e-2, + -4.4444444444444444444e-3 +}; +static float PF4[] = { + 1.3500000000000000000e-3, + -1.6036054421768707483e-1, + 4.2590187590187590188e-2, + 2.7330447330447330447e-3 +}; +static float PG1[] = { + -2.4285714285714285714e-1, + 1.4285714285714285714e-2 +}; +static float PG2[] = { + -9.0000000000000000000e-3, + 1.9396825396825396825e-1, + -1.1746031746031746032e-2 +}; +static float PG3[] = { + 1.9607142857142857143e-2, + -1.5983694083694083694e-1, + 6.3838383838383838384e-3 +}; + + +static float jntf( float nn, float xx ) +{ +float n, x, z, zz, z3; +float cbn, n23, cbtwo; +float ai, aip, bi, bip; /* Airy functions */ +float nk, fk, gk, pp, qq; +float F[5], G[4]; +int k; + +n = nn; +x = xx; +cbn = cbrtf(n); +z = (x - n)/cbn; +cbtwo = cbrtf( 2.0 ); + +/* Airy function */ +zz = -cbtwo * z; +airyf( zz, &ai, &aip, &bi, &bip ); + +/* polynomials in expansion */ +zz = z * z; +z3 = zz * z; +F[0] = 1.0; +F[1] = -z/5.0; +F[2] = polevlf( z3, PF2, 1 ) * zz; +F[3] = polevlf( z3, PF3, 2 ); +F[4] = polevlf( z3, PF4, 3 ) * z; +G[0] = 0.3 * zz; +G[1] = polevlf( z3, PG1, 1 ); +G[2] = polevlf( z3, PG2, 2 ) * z; +G[3] = polevlf( z3, PG3, 2 ) * zz; +#if DEBUG +for( k=0; k<=4; k++ ) + printf( "F[%d] = %.5E\n", k, F[k] ); +for( k=0; k<=3; k++ ) + printf( "G[%d] = %.5E\n", k, G[k] ); +#endif +pp = 0.0; +qq = 0.0; +nk = 1.0; +n23 = cbrtf( n * n ); + +for( k=0; k<=4; k++ ) + { + fk = F[k]*nk; + pp += fk; + if( k != 4 ) + { + gk = G[k]*nk; + qq += gk; + } +#if DEBUG + printf("fk[%d] %.5E, gk[%d] %.5E\n", k, fk, k, gk ); +#endif + nk /= n23; + } + +fk = cbtwo * ai * pp/cbn + cbrtf(4.0) * aip * qq/n; +return(fk); +} diff --git a/libm/float/k0f.c b/libm/float/k0f.c new file mode 100644 index 000000000..e0e0698ac --- /dev/null +++ b/libm/float/k0f.c @@ -0,0 +1,175 @@ +/* k0f.c + * + * Modified Bessel function, third kind, order zero + * + * + * + * SYNOPSIS: + * + * float x, y, k0f(); + * + * y = k0f( x ); + * + * + * + * DESCRIPTION: + * + * Returns modified Bessel function of the third kind + * of order zero of the argument. + * + * The range is partitioned into the two intervals [0,8] and + * (8, infinity). Chebyshev polynomial expansions are employed + * in each interval. + * + * + * + * ACCURACY: + * + * Tested at 2000 random points between 0 and 8. Peak absolute + * error (relative when K0 > 1) was 1.46e-14; rms, 4.26e-15. + * Relative error: + * arithmetic domain # trials peak rms + * IEEE 0, 30 30000 7.8e-7 8.5e-8 + * + * ERROR MESSAGES: + * + * message condition value returned + * K0 domain x <= 0 MAXNUM + * + */ + /* k0ef() + * + * Modified Bessel function, third kind, order zero, + * exponentially scaled + * + * + * + * SYNOPSIS: + * + * float x, y, k0ef(); + * + * y = k0ef( x ); + * + * + * + * DESCRIPTION: + * + * Returns exponentially scaled modified Bessel function + * of the third kind of order zero of the argument. + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE 0, 30 30000 8.1e-7 7.8e-8 + * See k0(). + * + */ + +/* +Cephes Math Library Release 2.0: April, 1987 +Copyright 1984, 1987 by Stephen L. Moshier +Direct inquiries to 30 Frost Street, Cambridge, MA 02140 +*/ + +#include <math.h> + +/* Chebyshev coefficients for K0(x) + log(x/2) I0(x) + * in the interval [0,2]. The odd order coefficients are all + * zero; only the even order coefficients are listed. + * + * lim(x->0){ K0(x) + log(x/2) I0(x) } = -EUL. + */ + +static float A[] = +{ + 1.90451637722020886025E-9f, + 2.53479107902614945675E-7f, + 2.28621210311945178607E-5f, + 1.26461541144692592338E-3f, + 3.59799365153615016266E-2f, + 3.44289899924628486886E-1f, +-5.35327393233902768720E-1f +}; + + + +/* Chebyshev coefficients for exp(x) sqrt(x) K0(x) + * in the inverted interval [2,infinity]. + * + * lim(x->inf){ exp(x) sqrt(x) K0(x) } = sqrt(pi/2). + */ + +static float B[] = { +-1.69753450938905987466E-9f, + 8.57403401741422608519E-9f, +-4.66048989768794782956E-8f, + 2.76681363944501510342E-7f, +-1.83175552271911948767E-6f, + 1.39498137188764993662E-5f, +-1.28495495816278026384E-4f, + 1.56988388573005337491E-3f, +-3.14481013119645005427E-2f, + 2.44030308206595545468E0f +}; + +/* k0.c */ + +extern float MAXNUMF; + +#ifdef ANSIC +float chbevlf(float, float *, int); +float expf(float), i0f(float), logf(float), sqrtf(float); +#else +float chbevlf(), expf(), i0f(), logf(), sqrtf(); +#endif + + +float k0f( float xx ) +{ +float x, y, z; + +x = xx; +if( x <= 0.0f ) + { + mtherr( "k0f", DOMAIN ); + return( MAXNUMF ); + } + +if( x <= 2.0f ) + { + y = x * x - 2.0f; + y = chbevlf( y, A, 7 ) - logf( 0.5f * x ) * i0f(x); + return( y ); + } +z = 8.0f/x - 2.0f; +y = expf(-x) * chbevlf( z, B, 10 ) / sqrtf(x); +return(y); +} + + + +float k0ef( float xx ) +{ +float x, y; + + +x = xx; +if( x <= 0.0f ) + { + mtherr( "k0ef", DOMAIN ); + return( MAXNUMF ); + } + +if( x <= 2.0f ) + { + y = x * x - 2.0f; + y = chbevlf( y, A, 7 ) - logf( 0.5f * x ) * i0f(x); + return( y * expf(x) ); + } + +y = chbevlf( 8.0f/x - 2.0f, B, 10 ) / sqrtf(x); +return(y); +} diff --git a/libm/float/k1f.c b/libm/float/k1f.c new file mode 100644 index 000000000..d5b9bdfce --- /dev/null +++ b/libm/float/k1f.c @@ -0,0 +1,174 @@ +/* k1f.c + * + * Modified Bessel function, third kind, order one + * + * + * + * SYNOPSIS: + * + * float x, y, k1f(); + * + * y = k1f( x ); + * + * + * + * DESCRIPTION: + * + * Computes the modified Bessel function of the third kind + * of order one of the argument. + * + * The range is partitioned into the two intervals [0,2] and + * (2, infinity). Chebyshev polynomial expansions are employed + * in each interval. + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE 0, 30 30000 4.6e-7 7.6e-8 + * + * ERROR MESSAGES: + * + * message condition value returned + * k1 domain x <= 0 MAXNUM + * + */ + /* k1ef.c + * + * Modified Bessel function, third kind, order one, + * exponentially scaled + * + * + * + * SYNOPSIS: + * + * float x, y, k1ef(); + * + * y = k1ef( x ); + * + * + * + * DESCRIPTION: + * + * Returns exponentially scaled modified Bessel function + * of the third kind of order one of the argument: + * + * k1e(x) = exp(x) * k1(x). + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE 0, 30 30000 4.9e-7 6.7e-8 + * See k1(). + * + */ + +/* +Cephes Math Library Release 2.2: June, 1992 +Copyright 1984, 1987, 1992 by Stephen L. Moshier +Direct inquiries to 30 Frost Street, Cambridge, MA 02140 +*/ + +#include <math.h> + +/* Chebyshev coefficients for x(K1(x) - log(x/2) I1(x)) + * in the interval [0,2]. + * + * lim(x->0){ x(K1(x) - log(x/2) I1(x)) } = 1. + */ + +#define MINNUMF 6.0e-39 +static float A[] = +{ +-2.21338763073472585583E-8f, +-2.43340614156596823496E-6f, +-1.73028895751305206302E-4f, +-6.97572385963986435018E-3f, +-1.22611180822657148235E-1f, +-3.53155960776544875667E-1f, + 1.52530022733894777053E0f +}; + + + + +/* Chebyshev coefficients for exp(x) sqrt(x) K1(x) + * in the interval [2,infinity]. + * + * lim(x->inf){ exp(x) sqrt(x) K1(x) } = sqrt(pi/2). + */ + +static float B[] = +{ + 2.01504975519703286596E-9f, +-1.03457624656780970260E-8f, + 5.74108412545004946722E-8f, +-3.50196060308781257119E-7f, + 2.40648494783721712015E-6f, +-1.93619797416608296024E-5f, + 1.95215518471351631108E-4f, +-2.85781685962277938680E-3f, + 1.03923736576817238437E-1f, + 2.72062619048444266945E0f +}; + + + +extern float MAXNUMF; +#ifdef ANSIC +float chbevlf(float, float *, int); +float expf(float), i1f(float), logf(float), sqrtf(float); +#else +float chbevlf(), expf(), i1f(), logf(), sqrtf(); +#endif + +float k1f(float xx) +{ +float x, y; + +x = xx; +if( x <= MINNUMF ) + { + mtherr( "k1f", DOMAIN ); + return( MAXNUMF ); + } + +if( x <= 2.0f ) + { + y = x * x - 2.0f; + y = logf( 0.5f * x ) * i1f(x) + chbevlf( y, A, 7 ) / x; + return( y ); + } + +return( expf(-x) * chbevlf( 8.0f/x - 2.0f, B, 10 ) / sqrtf(x) ); + +} + + + +float k1ef( float xx ) +{ +float x, y; + +x = xx; +if( x <= 0.0f ) + { + mtherr( "k1ef", DOMAIN ); + return( MAXNUMF ); + } + +if( x <= 2.0f ) + { + y = x * x - 2.0f; + y = logf( 0.5f * x ) * i1f(x) + chbevlf( y, A, 7 ) / x; + return( y * expf(x) ); + } + +return( chbevlf( 8.0f/x - 2.0f, B, 10 ) / sqrtf(x) ); + +} diff --git a/libm/float/knf.c b/libm/float/knf.c new file mode 100644 index 000000000..85e297390 --- /dev/null +++ b/libm/float/knf.c @@ -0,0 +1,252 @@ +/* knf.c + * + * Modified Bessel function, third kind, integer order + * + * + * + * SYNOPSIS: + * + * float x, y, knf(); + * int n; + * + * y = knf( n, x ); + * + * + * + * DESCRIPTION: + * + * Returns modified Bessel function of the third kind + * of order n of the argument. + * + * The range is partitioned into the two intervals [0,9.55] and + * (9.55, infinity). An ascending power series is used in the + * low range, and an asymptotic expansion in the high range. + * + * + * + * ACCURACY: + * + * Absolute error, relative when function > 1: + * arithmetic domain # trials peak rms + * IEEE 0,30 10000 2.0e-4 3.8e-6 + * + * Error is high only near the crossover point x = 9.55 + * between the two expansions used. + */ + + +/* +Cephes Math Library Release 2.2: June, 1992 +Copyright 1984, 1987, 1988, 1992 by Stephen L. Moshier +Direct inquiries to 30 Frost Street, Cambridge, MA 02140 + +*/ + + +/* +Algorithm for Kn. + n-1 + -n - (n-k-1)! 2 k +K (x) = 0.5 (x/2) > -------- (-x /4) + n - k! + k=0 + + inf. 2 k + n n - (x /4) + + (-1) 0.5(x/2) > {p(k+1) + p(n+k+1) - 2log(x/2)} --------- + - k! (n+k)! + k=0 + +where p(m) is the psi function: p(1) = -EUL and + + m-1 + - + p(m) = -EUL + > 1/k + - + k=1 + +For large x, + 2 2 2 + u-1 (u-1 )(u-3 ) +K (z) = sqrt(pi/2z) exp(-z) { 1 + ------- + ------------ + ...} + v 1 2 + 1! (8z) 2! (8z) +asymptotically, where + + 2 + u = 4 v . + +*/ + +#include <math.h> + +#define EUL 5.772156649015328606065e-1 +#define MAXFAC 31 +extern float MACHEPF, MAXNUMF, MAXLOGF, PIF; + +#define fabsf(x) ( (x) < 0 ? -(x) : (x) ) + +float expf(float), logf(float), sqrtf(float); + +float knf( int nnn, float xx ) +{ +float x, k, kf, nk1f, nkf, zn, t, s, z0, z; +float ans, fn, pn, pk, zmn, tlg, tox; +int i, n, nn; + +nn = nnn; +x = xx; +if( nn < 0 ) + n = -nn; +else + n = nn; + +if( n > MAXFAC ) + { +overf: + mtherr( "knf", OVERFLOW ); + return( MAXNUMF ); + } + +if( x <= 0.0 ) + { + if( x < 0.0 ) + mtherr( "knf", DOMAIN ); + else + mtherr( "knf", SING ); + return( MAXNUMF ); + } + + +if( x > 9.55 ) + goto asymp; + +ans = 0.0; +z0 = 0.25 * x * x; +fn = 1.0; +pn = 0.0; +zmn = 1.0; +tox = 2.0/x; + +if( n > 0 ) + { + /* compute factorial of n and psi(n) */ + pn = -EUL; + k = 1.0; + for( i=1; i<n; i++ ) + { + pn += 1.0/k; + k += 1.0; + fn *= k; + } + + zmn = tox; + + if( n == 1 ) + { + ans = 1.0/x; + } + else + { + nk1f = fn/n; + kf = 1.0; + s = nk1f; + z = -z0; + zn = 1.0; + for( i=1; i<n; i++ ) + { + nk1f = nk1f/(n-i); + kf = kf * i; + zn *= z; + t = nk1f * zn / kf; + s += t; + if( (MAXNUMF - fabsf(t)) < fabsf(s) ) + goto overf; + if( (tox > 1.0) && ((MAXNUMF/tox) < zmn) ) + goto overf; + zmn *= tox; + } + s *= 0.5; + t = fabsf(s); + if( (zmn > 1.0) && ((MAXNUMF/zmn) < t) ) + goto overf; + if( (t > 1.0) && ((MAXNUMF/t) < zmn) ) + goto overf; + ans = s * zmn; + } + } + + +tlg = 2.0 * logf( 0.5 * x ); +pk = -EUL; +if( n == 0 ) + { + pn = pk; + t = 1.0; + } +else + { + pn = pn + 1.0/n; + t = 1.0/fn; + } +s = (pk+pn-tlg)*t; +k = 1.0; +do + { + t *= z0 / (k * (k+n)); + pk += 1.0/k; + pn += 1.0/(k+n); + s += (pk+pn-tlg)*t; + k += 1.0; + } +while( fabsf(t/s) > MACHEPF ); + +s = 0.5 * s / zmn; +if( n & 1 ) + s = -s; +ans += s; + +return(ans); + + + +/* Asymptotic expansion for Kn(x) */ +/* Converges to 1.4e-17 for x > 18.4 */ + +asymp: + +if( x > MAXLOGF ) + { + mtherr( "knf", UNDERFLOW ); + return(0.0); + } +k = n; +pn = 4.0 * k * k; +pk = 1.0; +z0 = 8.0 * x; +fn = 1.0; +t = 1.0; +s = t; +nkf = MAXNUMF; +i = 0; +do + { + z = pn - pk * pk; + t = t * z /(fn * z0); + nk1f = fabsf(t); + if( (i >= n) && (nk1f > nkf) ) + { + goto adone; + } + nkf = nk1f; + s += t; + fn += 1.0; + pk += 2.0; + i += 1; + } +while( fabsf(t/s) > MACHEPF ); + +adone: +ans = expf(-x) * sqrtf( PIF/(2.0*x) ) * s; +return(ans); +} diff --git a/libm/float/log10f.c b/libm/float/log10f.c new file mode 100644 index 000000000..6cb2e4d87 --- /dev/null +++ b/libm/float/log10f.c @@ -0,0 +1,129 @@ +/* log10f.c + * + * Common logarithm + * + * + * + * SYNOPSIS: + * + * float x, y, log10f(); + * + * y = log10f( x ); + * + * + * + * DESCRIPTION: + * + * Returns logarithm to the base 10 of x. + * + * The argument is separated into its exponent and fractional + * parts. The logarithm of the fraction is approximated by + * + * log(1+x) = x - 0.5 x**2 + x**3 P(x). + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE 0.5, 2.0 100000 1.3e-7 3.4e-8 + * IEEE 0, MAXNUMF 100000 1.3e-7 2.6e-8 + * + * In the tests over the interval [0, MAXNUM], the logarithms + * of the random arguments were uniformly distributed over + * [-MAXL10, MAXL10]. + * + * ERROR MESSAGES: + * + * log10f singularity: x = 0; returns -MAXL10 + * log10f domain: x < 0; returns -MAXL10 + * MAXL10 = 38.230809449325611792 + */ + +/* +Cephes Math Library Release 2.1: December, 1988 +Copyright 1984, 1987, 1988 by Stephen L. Moshier +Direct inquiries to 30 Frost Street, Cambridge, MA 02140 +*/ + +#include <math.h> +static char fname[] = {"log10"}; + +/* Coefficients for log(1+x) = x - x**2/2 + x**3 P(x)/Q(x) + * 1/sqrt(2) <= x < sqrt(2) + */ +static float P[] = { + 7.0376836292E-2, +-1.1514610310E-1, + 1.1676998740E-1, +-1.2420140846E-1, + 1.4249322787E-1, +-1.6668057665E-1, + 2.0000714765E-1, +-2.4999993993E-1, + 3.3333331174E-1 +}; + + +#define SQRTH 0.70710678118654752440 +#define L102A 3.0078125E-1 +#define L102B 2.48745663981195213739E-4 +#define L10EA 4.3359375E-1 +#define L10EB 7.00731903251827651129E-4 + +static float MAXL10 = 38.230809449325611792; + +float frexpf(float, int *), polevlf(float, float *, int); + +float log10f(float xx) +{ +float x, y, z; +int e; + +x = xx; +/* Test for domain */ +if( x <= 0.0 ) + { + if( x == 0.0 ) + mtherr( fname, SING ); + else + mtherr( fname, DOMAIN ); + return( -MAXL10 ); + } + +/* separate mantissa from exponent */ + +x = frexpf( x, &e ); + +/* logarithm using log(1+x) = x - .5x**2 + x**3 P(x) */ + +if( x < SQRTH ) + { + e -= 1; + x = 2.0*x - 1.0; + } +else + { + x = x - 1.0; + } + + +/* rational form */ +z = x*x; +y = x * ( z * polevlf( x, P, 8 ) ); +y = y - 0.5 * z; /* y - 0.5 * x**2 */ + +/* multiply log of fraction by log10(e) + * and base 2 exponent by log10(2) + */ +z = (x + y) * L10EB; /* accumulate terms in order of size */ +z += y * L10EA; +z += x * L10EA; +x = e; +z += x * L102B; +z += x * L102A; + + +return( z ); +} diff --git a/libm/float/log2f.c b/libm/float/log2f.c new file mode 100644 index 000000000..5cd5f4838 --- /dev/null +++ b/libm/float/log2f.c @@ -0,0 +1,129 @@ +/* log2f.c + * + * Base 2 logarithm + * + * + * + * SYNOPSIS: + * + * float x, y, log2f(); + * + * y = log2f( x ); + * + * + * + * DESCRIPTION: + * + * Returns the base 2 logarithm of x. + * + * The argument is separated into its exponent and fractional + * parts. If the exponent is between -1 and +1, the base e + * logarithm of the fraction is approximated by + * + * log(1+x) = x - 0.5 x**2 + x**3 P(x)/Q(x). + * + * Otherwise, setting z = 2(x-1)/x+1), + * + * log(x) = z + z**3 P(z)/Q(z). + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE exp(+-88) 100000 1.1e-7 2.4e-8 + * IEEE 0.5, 2.0 100000 1.1e-7 3.0e-8 + * + * In the tests over the interval [exp(+-88)], the logarithms + * of the random arguments were uniformly distributed. + * + * ERROR MESSAGES: + * + * log singularity: x = 0; returns MINLOGF/log(2) + * log domain: x < 0; returns MINLOGF/log(2) + */ + +/* +Cephes Math Library Release 2.2: June, 1992 +Copyright 1984, 1992 by Stephen L. Moshier +Direct inquiries to 30 Frost Street, Cambridge, MA 02140 +*/ + +#include <math.h> +static char fname[] = {"log2"}; + +/* Coefficients for log(1+x) = x - x**2/2 + x**3 P(x) + * 1/sqrt(2) <= x < sqrt(2) + */ + +static float P[] = { + 7.0376836292E-2, +-1.1514610310E-1, + 1.1676998740E-1, +-1.2420140846E-1, + 1.4249322787E-1, +-1.6668057665E-1, + 2.0000714765E-1, +-2.4999993993E-1, + 3.3333331174E-1 +}; + +#define LOG2EA 0.44269504088896340735992 +#define SQRTH 0.70710678118654752440 +extern float MINLOGF, LOGE2F; + +float frexpf(float, int *), polevlf(float, float *, int); + +float log2f(float xx) +{ +float x, y, z; +int e; + +x = xx; +/* Test for domain */ +if( x <= 0.0 ) + { + if( x == 0.0 ) + mtherr( fname, SING ); + else + mtherr( fname, DOMAIN ); + return( MINLOGF/LOGE2F ); + } + +/* separate mantissa from exponent */ +x = frexpf( x, &e ); + + +/* logarithm using log(1+x) = x - .5x**2 + x**3 P(x)/Q(x) */ + +if( x < SQRTH ) + { + e -= 1; + x = 2.0*x - 1.0; + } +else + { + x = x - 1.0; + } + +z = x*x; +y = x * ( z * polevlf( x, P, 8 ) ); +y = y - 0.5 * z; /* y - 0.5 * x**2 */ + + +/* Multiply log of fraction by log2(e) + * and base 2 exponent by 1 + * + * ***CAUTION*** + * + * This sequence of operations is critical and it may + * be horribly defeated by some compiler optimizers. + */ +z = y * LOG2EA; +z += x * LOG2EA; +z += y; +z += x; +z += (float )e; +return( z ); +} diff --git a/libm/float/logf.c b/libm/float/logf.c new file mode 100644 index 000000000..750138564 --- /dev/null +++ b/libm/float/logf.c @@ -0,0 +1,128 @@ +/* logf.c + * + * Natural logarithm + * + * + * + * SYNOPSIS: + * + * float x, y, logf(); + * + * y = logf( x ); + * + * + * + * DESCRIPTION: + * + * Returns the base e (2.718...) logarithm of x. + * + * The argument is separated into its exponent and fractional + * parts. If the exponent is between -1 and +1, the logarithm + * of the fraction is approximated by + * + * log(1+x) = x - 0.5 x**2 + x**3 P(x) + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE 0.5, 2.0 100000 7.6e-8 2.7e-8 + * IEEE 1, MAXNUMF 100000 2.6e-8 + * + * In the tests over the interval [1, MAXNUM], the logarithms + * of the random arguments were uniformly distributed over + * [0, MAXLOGF]. + * + * ERROR MESSAGES: + * + * logf singularity: x = 0; returns MINLOG + * logf domain: x < 0; returns MINLOG + */ + +/* +Cephes Math Library Release 2.2: June, 1992 +Copyright 1984, 1987, 1988, 1992 by Stephen L. Moshier +Direct inquiries to 30 Frost Street, Cambridge, MA 02140 +*/ + +/* Single precision natural logarithm + * test interval: [sqrt(2)/2, sqrt(2)] + * trials: 10000 + * peak relative error: 7.1e-8 + * rms relative error: 2.7e-8 + */ + +#include <math.h> +extern float MINLOGF, SQRTHF; + + +float frexpf( float, int * ); + +float logf( float xx ) +{ +register float y; +float x, z, fe; +int e; + +x = xx; +fe = 0.0; +/* Test for domain */ +if( x <= 0.0 ) + { + if( x == 0.0 ) + mtherr( "logf", SING ); + else + mtherr( "logf", DOMAIN ); + return( MINLOGF ); + } + +x = frexpf( x, &e ); +if( x < SQRTHF ) + { + e -= 1; + x = x + x - 1.0; /* 2x - 1 */ + } +else + { + x = x - 1.0; + } +z = x * x; +/* 3.4e-9 */ +/* +p = logfcof; +y = *p++ * x; +for( i=0; i<8; i++ ) + { + y += *p++; + y *= x; + } +y *= z; +*/ + +y = +(((((((( 7.0376836292E-2 * x +- 1.1514610310E-1) * x ++ 1.1676998740E-1) * x +- 1.2420140846E-1) * x ++ 1.4249322787E-1) * x +- 1.6668057665E-1) * x ++ 2.0000714765E-1) * x +- 2.4999993993E-1) * x ++ 3.3333331174E-1) * x * z; + +if( e ) + { + fe = e; + y += -2.12194440e-4 * fe; + } + +y += -0.5 * z; /* y - 0.5 x^2 */ +z = x + y; /* ... + x */ + +if( e ) + z += 0.693359375 * fe; + +return( z ); +} diff --git a/libm/float/mtherr.c b/libm/float/mtherr.c new file mode 100644 index 000000000..d67dc042e --- /dev/null +++ b/libm/float/mtherr.c @@ -0,0 +1,99 @@ +/* mtherr.c + * + * Library common error handling routine + * + * + * + * SYNOPSIS: + * + * char *fctnam; + * int code; + * void mtherr(); + * + * mtherr( fctnam, code ); + * + * + * + * DESCRIPTION: + * + * This routine may be called to report one of the following + * error conditions (in the include file math.h). + * + * Mnemonic Value Significance + * + * DOMAIN 1 argument domain error + * SING 2 function singularity + * OVERFLOW 3 overflow range error + * UNDERFLOW 4 underflow range error + * TLOSS 5 total loss of precision + * PLOSS 6 partial loss of precision + * EDOM 33 Unix domain error code + * ERANGE 34 Unix range error code + * + * The default version of the file prints the function name, + * passed to it by the pointer fctnam, followed by the + * error condition. The display is directed to the standard + * output device. The routine then returns to the calling + * program. Users may wish to modify the program to abort by + * calling exit() under severe error conditions such as domain + * errors. + * + * Since all error conditions pass control to this function, + * the display may be easily changed, eliminated, or directed + * to an error logging device. + * + * SEE ALSO: + * + * math.h + * + */ + +/* +Cephes Math Library Release 2.0: April, 1987 +Copyright 1984, 1987 by Stephen L. Moshier +Direct inquiries to 30 Frost Street, Cambridge, MA 02140 +*/ + +#include <math.h> + +/* Notice: the order of appearance of the following + * messages is bound to the error codes defined + * in math.h. + */ +static char *ermsg[7] = { +"unknown", /* error code 0 */ +"domain", /* error code 1 */ +"singularity", /* et seq. */ +"overflow", +"underflow", +"total loss of precision", +"partial loss of precision" +}; + + +void printf(); + +int mtherr( name, code ) +char *name; +int code; +{ + +/* Display string passed by calling program, + * which is supposed to be the name of the + * function in which the error occurred: + */ +printf( "\n%s ", name ); + /* exit(2); */ + +/* Display error message defined + * by the code argument. + */ +if( (code <= 0) || (code >= 6) ) + code = 0; +printf( "%s error\n", ermsg[code] ); + +/* Return to calling + * program + */ +return 0; +} diff --git a/libm/float/nantst.c b/libm/float/nantst.c new file mode 100644 index 000000000..7edd992ae --- /dev/null +++ b/libm/float/nantst.c @@ -0,0 +1,54 @@ +float inf = 1.0f/0.0f; +float nnn = 1.0f/0.0f - 1.0f/0.0f; +float fin = 1.0f; +float neg = -1.0f; +float nn2; + +int isnanf(), isfinitef(), signbitf(); + +void pvalue (char *str, float x) +{ +union + { + float f; + unsigned int i; + }u; + +printf("%s ", str); +u.f = x; +printf("%08x\n", u.i); +} + + +int +main() +{ + +if (!isnanf(nnn)) + abort(); +pvalue("nnn", nnn); +pvalue("inf", inf); +nn2 = inf - inf; +pvalue("inf - inf", nn2); +if (isnanf(fin)) + abort(); +if (isnanf(inf)) + abort(); +if (!isfinitef(fin)) + abort(); +if (isfinitef(nnn)) + abort(); +if (isfinitef(inf)) + abort(); +if (!signbitf(neg)) + abort(); +if (signbitf(fin)) + abort(); +if (signbitf(inf)) + abort(); +/* +if (signbitf(nnn)) + abort(); + */ +exit (0); +} diff --git a/libm/float/nbdtrf.c b/libm/float/nbdtrf.c new file mode 100644 index 000000000..e9b02753b --- /dev/null +++ b/libm/float/nbdtrf.c @@ -0,0 +1,141 @@ +/* nbdtrf.c + * + * Negative binomial distribution + * + * + * + * SYNOPSIS: + * + * int k, n; + * float p, y, nbdtrf(); + * + * y = nbdtrf( k, n, p ); + * + * + * + * DESCRIPTION: + * + * Returns the sum of the terms 0 through k of the negative + * binomial distribution: + * + * k + * -- ( n+j-1 ) n j + * > ( ) p (1-p) + * -- ( j ) + * j=0 + * + * In a sequence of Bernoulli trials, this is the probability + * that k or fewer failures precede the nth success. + * + * The terms are not computed individually; instead the incomplete + * beta integral is employed, according to the formula + * + * y = nbdtr( k, n, p ) = incbet( n, k+1, p ). + * + * The arguments must be positive, with p ranging from 0 to 1. + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE 0,100 5000 1.5e-4 1.9e-5 + * + */ + /* nbdtrcf.c + * + * Complemented negative binomial distribution + * + * + * + * SYNOPSIS: + * + * int k, n; + * float p, y, nbdtrcf(); + * + * y = nbdtrcf( k, n, p ); + * + * + * + * DESCRIPTION: + * + * Returns the sum of the terms k+1 to infinity of the negative + * binomial distribution: + * + * inf + * -- ( n+j-1 ) n j + * > ( ) p (1-p) + * -- ( j ) + * j=k+1 + * + * The terms are not computed individually; instead the incomplete + * beta integral is employed, according to the formula + * + * y = nbdtrc( k, n, p ) = incbet( k+1, n, 1-p ). + * + * The arguments must be positive, with p ranging from 0 to 1. + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE 0,100 5000 1.4e-4 2.0e-5 + * + */ + +/* +Cephes Math Library Release 2.2: July, 1992 +Copyright 1984, 1987 by Stephen L. Moshier +Direct inquiries to 30 Frost Street, Cambridge, MA 02140 +*/ + +#include <math.h> + +#ifdef ANSIC +float incbetf(float, float, float); +#else +float incbetf(); +#endif + + +float nbdtrcf( int k, int n, float pp ) +{ +float dk, dn, p; + +p = pp; +if( (p < 0.0) || (p > 1.0) ) + goto domerr; +if( k < 0 ) + { +domerr: + mtherr( "nbdtrf", DOMAIN ); + return( 0.0 ); + } + +dk = k+1; +dn = n; +return( incbetf( dk, dn, 1.0 - p ) ); +} + + + +float nbdtrf( int k, int n, float pp ) +{ +float dk, dn, p; + +p = pp; +if( (p < 0.0) || (p > 1.0) ) + goto domerr; +if( k < 0 ) + { +domerr: + mtherr( "nbdtrf", DOMAIN ); + return( 0.0 ); + } +dk = k+1; +dn = n; +return( incbetf( dn, dk, p ) ); +} diff --git a/libm/float/ndtrf.c b/libm/float/ndtrf.c new file mode 100644 index 000000000..c08d69eca --- /dev/null +++ b/libm/float/ndtrf.c @@ -0,0 +1,281 @@ +/* ndtrf.c + * + * Normal distribution function + * + * + * + * SYNOPSIS: + * + * float x, y, ndtrf(); + * + * y = ndtrf( x ); + * + * + * + * DESCRIPTION: + * + * Returns the area under the Gaussian probability density + * function, integrated from minus infinity to x: + * + * x + * - + * 1 | | 2 + * ndtr(x) = --------- | exp( - t /2 ) dt + * sqrt(2pi) | | + * - + * -inf. + * + * = ( 1 + erf(z) ) / 2 + * = erfc(z) / 2 + * + * where z = x/sqrt(2). Computation is via the functions + * erf and erfc. + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE -13,0 50000 1.5e-5 2.6e-6 + * + * + * ERROR MESSAGES: + * + * See erfcf(). + * + */ + /* erff.c + * + * Error function + * + * + * + * SYNOPSIS: + * + * float x, y, erff(); + * + * y = erff( x ); + * + * + * + * DESCRIPTION: + * + * The integral is + * + * x + * - + * 2 | | 2 + * erf(x) = -------- | exp( - t ) dt. + * sqrt(pi) | | + * - + * 0 + * + * The magnitude of x is limited to 9.231948545 for DEC + * arithmetic; 1 or -1 is returned outside this range. + * + * For 0 <= |x| < 1, erf(x) = x * P(x**2); otherwise + * erf(x) = 1 - erfc(x). + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE -9.3,9.3 50000 1.7e-7 2.8e-8 + * + */ + /* erfcf.c + * + * Complementary error function + * + * + * + * SYNOPSIS: + * + * float x, y, erfcf(); + * + * y = erfcf( x ); + * + * + * + * DESCRIPTION: + * + * + * 1 - erf(x) = + * + * inf. + * - + * 2 | | 2 + * erfc(x) = -------- | exp( - t ) dt + * sqrt(pi) | | + * - + * x + * + * + * For small x, erfc(x) = 1 - erf(x); otherwise polynomial + * approximations 1/x P(1/x**2) are computed. + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE -9.3,9.3 50000 3.9e-6 7.2e-7 + * + * + * ERROR MESSAGES: + * + * message condition value returned + * erfcf underflow x**2 > MAXLOGF 0.0 + * + * + */ + + +/* +Cephes Math Library Release 2.2: June, 1992 +Copyright 1984, 1987, 1988 by Stephen L. Moshier +Direct inquiries to 30 Frost Street, Cambridge, MA 02140 +*/ + + +#include <math.h> + +extern float MAXLOGF, SQRTHF; + + +/* erfc(x) = exp(-x^2) P(1/x), 1 < x < 2 */ +static float P[] = { + 2.326819970068386E-002, +-1.387039388740657E-001, + 3.687424674597105E-001, +-5.824733027278666E-001, + 6.210004621745983E-001, +-4.944515323274145E-001, + 3.404879937665872E-001, +-2.741127028184656E-001, + 5.638259427386472E-001 +}; + +/* erfc(x) = exp(-x^2) 1/x P(1/x^2), 2 < x < 14 */ +static float R[] = { +-1.047766399936249E+001, + 1.297719955372516E+001, +-7.495518717768503E+000, + 2.921019019210786E+000, +-1.015265279202700E+000, + 4.218463358204948E-001, +-2.820767439740514E-001, + 5.641895067754075E-001 +}; + +/* erf(x) = x P(x^2), 0 < x < 1 */ +static float T[] = { + 7.853861353153693E-005, +-8.010193625184903E-004, + 5.188327685732524E-003, +-2.685381193529856E-002, + 1.128358514861418E-001, +-3.761262582423300E-001, + 1.128379165726710E+000 +}; + +/*#define UTHRESH 37.519379347*/ + +#define UTHRESH 14.0 + +#define fabsf(x) ( (x) < 0 ? -(x) : (x) ) + +#ifdef ANSIC +float polevlf(float, float *, int); +float expf(float), logf(float), erff(float), erfcf(float); +#else +float polevlf(), expf(), logf(), erff(), erfcf(); +#endif + + + +float ndtrf(float aa) +{ +float x, y, z; + +x = aa; +x *= SQRTHF; +z = fabsf(x); + +if( z < SQRTHF ) + y = 0.5 + 0.5 * erff(x); +else + { + y = 0.5 * erfcf(z); + + if( x > 0 ) + y = 1.0 - y; + } + +return(y); +} + + +float erfcf(float aa) +{ +float a, p,q,x,y,z; + + +a = aa; +x = fabsf(a); + +if( x < 1.0 ) + return( 1.0 - erff(a) ); + +z = -a * a; + +if( z < -MAXLOGF ) + { +under: + mtherr( "erfcf", UNDERFLOW ); + if( a < 0 ) + return( 2.0 ); + else + return( 0.0 ); + } + +z = expf(z); +q = 1.0/x; +y = q * q; +if( x < 2.0 ) + { + p = polevlf( y, P, 8 ); + } +else + { + p = polevlf( y, R, 7 ); + } + +y = z * q * p; + +if( a < 0 ) + y = 2.0 - y; + +if( y == 0.0 ) + goto under; + +return(y); +} + + +float erff(float xx) +{ +float x, y, z; + +x = xx; +if( fabsf(x) > 1.0 ) + return( 1.0 - erfcf(x) ); + +z = x * x; +y = x * polevlf( z, T, 6 ); +return( y ); + +} diff --git a/libm/float/ndtrif.c b/libm/float/ndtrif.c new file mode 100644 index 000000000..3e33bc2c5 --- /dev/null +++ b/libm/float/ndtrif.c @@ -0,0 +1,186 @@ +/* ndtrif.c + * + * Inverse of Normal distribution function + * + * + * + * SYNOPSIS: + * + * float x, y, ndtrif(); + * + * x = ndtrif( y ); + * + * + * + * DESCRIPTION: + * + * Returns the argument, x, for which the area under the + * Gaussian probability density function (integrated from + * minus infinity to x) is equal to y. + * + * + * For small arguments 0 < y < exp(-2), the program computes + * z = sqrt( -2.0 * log(y) ); then the approximation is + * x = z - log(z)/z - (1/z) P(1/z) / Q(1/z). + * There are two rational functions P/Q, one for 0 < y < exp(-32) + * and the other for y up to exp(-2). For larger arguments, + * w = y - 0.5, and x/sqrt(2pi) = w + w**3 R(w**2)/S(w**2)). + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE 1e-38, 1 30000 3.6e-7 5.0e-8 + * + * + * ERROR MESSAGES: + * + * message condition value returned + * ndtrif domain x <= 0 -MAXNUM + * ndtrif domain x >= 1 MAXNUM + * + */ + + +/* +Cephes Math Library Release 2.2: July, 1992 +Copyright 1984, 1987, 1989, 1992 by Stephen L. Moshier +Direct inquiries to 30 Frost Street, Cambridge, MA 02140 +*/ + +#include <math.h> +extern float MAXNUMF; + +/* sqrt(2pi) */ +static float s2pi = 2.50662827463100050242; + +/* approximation for 0 <= |y - 0.5| <= 3/8 */ +static float P0[5] = { +-5.99633501014107895267E1, + 9.80010754185999661536E1, +-5.66762857469070293439E1, + 1.39312609387279679503E1, +-1.23916583867381258016E0, +}; +static float Q0[8] = { +/* 1.00000000000000000000E0,*/ + 1.95448858338141759834E0, + 4.67627912898881538453E0, + 8.63602421390890590575E1, +-2.25462687854119370527E2, + 2.00260212380060660359E2, +-8.20372256168333339912E1, + 1.59056225126211695515E1, +-1.18331621121330003142E0, +}; + +/* Approximation for interval z = sqrt(-2 log y ) between 2 and 8 + * i.e., y between exp(-2) = .135 and exp(-32) = 1.27e-14. + */ +static float P1[9] = { + 4.05544892305962419923E0, + 3.15251094599893866154E1, + 5.71628192246421288162E1, + 4.40805073893200834700E1, + 1.46849561928858024014E1, + 2.18663306850790267539E0, +-1.40256079171354495875E-1, +-3.50424626827848203418E-2, +-8.57456785154685413611E-4, +}; +static float Q1[8] = { +/* 1.00000000000000000000E0,*/ + 1.57799883256466749731E1, + 4.53907635128879210584E1, + 4.13172038254672030440E1, + 1.50425385692907503408E1, + 2.50464946208309415979E0, +-1.42182922854787788574E-1, +-3.80806407691578277194E-2, +-9.33259480895457427372E-4, +}; + + +/* Approximation for interval z = sqrt(-2 log y ) between 8 and 64 + * i.e., y between exp(-32) = 1.27e-14 and exp(-2048) = 3.67e-890. + */ + +static float P2[9] = { + 3.23774891776946035970E0, + 6.91522889068984211695E0, + 3.93881025292474443415E0, + 1.33303460815807542389E0, + 2.01485389549179081538E-1, + 1.23716634817820021358E-2, + 3.01581553508235416007E-4, + 2.65806974686737550832E-6, + 6.23974539184983293730E-9, +}; +static float Q2[8] = { +/* 1.00000000000000000000E0,*/ + 6.02427039364742014255E0, + 3.67983563856160859403E0, + 1.37702099489081330271E0, + 2.16236993594496635890E-1, + 1.34204006088543189037E-2, + 3.28014464682127739104E-4, + 2.89247864745380683936E-6, + 6.79019408009981274425E-9, +}; + +#ifdef ANSIC +float polevlf(float, float *, int); +float p1evlf(float, float *, int); +float logf(float), sqrtf(float); +#else +float polevlf(), p1evlf(), logf(), sqrtf(); +#endif + + +float ndtrif(float yy0) +{ +float y0, x, y, z, y2, x0, x1; +int code; + +y0 = yy0; +if( y0 <= 0.0 ) + { + mtherr( "ndtrif", DOMAIN ); + return( -MAXNUMF ); + } +if( y0 >= 1.0 ) + { + mtherr( "ndtrif", DOMAIN ); + return( MAXNUMF ); + } +code = 1; +y = y0; +if( y > (1.0 - 0.13533528323661269189) ) /* 0.135... = exp(-2) */ + { + y = 1.0 - y; + code = 0; + } + +if( y > 0.13533528323661269189 ) + { + y = y - 0.5; + y2 = y * y; + x = y + y * (y2 * polevlf( y2, P0, 4)/p1evlf( y2, Q0, 8 )); + x = x * s2pi; + return(x); + } + +x = sqrtf( -2.0 * logf(y) ); +x0 = x - logf(x)/x; + +z = 1.0/x; +if( x < 8.0 ) /* y > exp(-32) = 1.2664165549e-14 */ + x1 = z * polevlf( z, P1, 8 )/p1evlf( z, Q1, 8 ); +else + x1 = z * polevlf( z, P2, 8 )/p1evlf( z, Q2, 8 ); +x = x0 - x1; +if( code != 0 ) + x = -x; +return( x ); +} diff --git a/libm/float/pdtrf.c b/libm/float/pdtrf.c new file mode 100644 index 000000000..17a05ee13 --- /dev/null +++ b/libm/float/pdtrf.c @@ -0,0 +1,188 @@ +/* pdtrf.c + * + * Poisson distribution + * + * + * + * SYNOPSIS: + * + * int k; + * float m, y, pdtrf(); + * + * y = pdtrf( k, m ); + * + * + * + * DESCRIPTION: + * + * Returns the sum of the first k terms of the Poisson + * distribution: + * + * k j + * -- -m m + * > e -- + * -- j! + * j=0 + * + * The terms are not summed directly; instead the incomplete + * gamma integral is employed, according to the relation + * + * y = pdtr( k, m ) = igamc( k+1, m ). + * + * The arguments must both be positive. + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE 0,100 5000 6.9e-5 8.0e-6 + * + */ + /* pdtrcf() + * + * Complemented poisson distribution + * + * + * + * SYNOPSIS: + * + * int k; + * float m, y, pdtrcf(); + * + * y = pdtrcf( k, m ); + * + * + * + * DESCRIPTION: + * + * Returns the sum of the terms k+1 to infinity of the Poisson + * distribution: + * + * inf. j + * -- -m m + * > e -- + * -- j! + * j=k+1 + * + * The terms are not summed directly; instead the incomplete + * gamma integral is employed, according to the formula + * + * y = pdtrc( k, m ) = igam( k+1, m ). + * + * The arguments must both be positive. + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE 0,100 5000 8.4e-5 1.2e-5 + * + */ + /* pdtrif() + * + * Inverse Poisson distribution + * + * + * + * SYNOPSIS: + * + * int k; + * float m, y, pdtrf(); + * + * m = pdtrif( k, y ); + * + * + * + * + * DESCRIPTION: + * + * Finds the Poisson variable x such that the integral + * from 0 to x of the Poisson density is equal to the + * given probability y. + * + * This is accomplished using the inverse gamma integral + * function and the relation + * + * m = igami( k+1, y ). + * + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE 0,100 5000 8.7e-6 1.4e-6 + * + * ERROR MESSAGES: + * + * message condition value returned + * pdtri domain y < 0 or y >= 1 0.0 + * k < 0 + * + */ + +/* +Cephes Math Library Release 2.2: July, 1992 +Copyright 1984, 1987, 1992 by Stephen L. Moshier +Direct inquiries to 30 Frost Street, Cambridge, MA 02140 +*/ + +#include <math.h> + +#ifdef ANSIC +float igamf(float, float), igamcf(float, float), igamif(float, float); +#else +float igamf(), igamcf(), igamif(); +#endif + + +float pdtrcf( int k, float mm ) +{ +float v, m; + +m = mm; +if( (k < 0) || (m <= 0.0) ) + { + mtherr( "pdtrcf", DOMAIN ); + return( 0.0 ); + } +v = k+1; +return( igamf( v, m ) ); +} + + + +float pdtrf( int k, float mm ) +{ +float v, m; + +m = mm; +if( (k < 0) || (m <= 0.0) ) + { + mtherr( "pdtr", DOMAIN ); + return( 0.0 ); + } +v = k+1; +return( igamcf( v, m ) ); +} + + +float pdtrif( int k, float yy ) +{ +float v, y; + +y = yy; +if( (k < 0) || (y < 0.0) || (y >= 1.0) ) + { + mtherr( "pdtrif", DOMAIN ); + return( 0.0 ); + } +v = k+1; +v = igamif( v, y ); +return( v ); +} diff --git a/libm/float/polevlf.c b/libm/float/polevlf.c new file mode 100644 index 000000000..7d7b4d0b7 --- /dev/null +++ b/libm/float/polevlf.c @@ -0,0 +1,99 @@ +/* polevlf.c + * p1evlf.c + * + * Evaluate polynomial + * + * + * + * SYNOPSIS: + * + * int N; + * float x, y, coef[N+1], polevlf[]; + * + * y = polevlf( x, coef, N ); + * + * + * + * DESCRIPTION: + * + * Evaluates polynomial of degree N: + * + * 2 N + * y = C + C x + C x +...+ C x + * 0 1 2 N + * + * Coefficients are stored in reverse order: + * + * coef[0] = C , ..., coef[N] = C . + * N 0 + * + * The function p1evl() assumes that coef[N] = 1.0 and is + * omitted from the array. Its calling arguments are + * otherwise the same as polevl(). + * + * + * SPEED: + * + * In the interest of speed, there are no checks for out + * of bounds arithmetic. This routine is used by most of + * the functions in the library. Depending on available + * equipment features, the user may wish to rewrite the + * program in microcode or assembly language. + * + */ + + +/* +Cephes Math Library Release 2.1: December, 1988 +Copyright 1984, 1987, 1988 by Stephen L. Moshier +Direct inquiries to 30 Frost Street, Cambridge, MA 02140 +*/ + +#include <math.h> + +float polevlf( float xx, float *coef, int N ) +{ +float ans, x; +float *p; +int i; + +x = xx; +p = coef; +ans = *p++; + +/* +for( i=0; i<N; i++ ) + ans = ans * x + *p++; +*/ + +i = N; +do + ans = ans * x + *p++; +while( --i ); + +return( ans ); +} + +/* p1evl() */ +/* N + * Evaluate polynomial when coefficient of x is 1.0. + * Otherwise same as polevl. + */ + +float p1evlf( float xx, float *coef, int N ) +{ +float ans, x; +float *p; +int i; + +x = xx; +p = coef; +ans = x + *p++; +i = N-1; + +do + ans = ans * x + *p++; +while( --i ); + +return( ans ); +} diff --git a/libm/float/polynf.c b/libm/float/polynf.c new file mode 100644 index 000000000..48c6675d4 --- /dev/null +++ b/libm/float/polynf.c @@ -0,0 +1,520 @@ +/* polynf.c + * polyrf.c + * Arithmetic operations on polynomials + * + * In the following descriptions a, b, c are polynomials of degree + * na, nb, nc respectively. The degree of a polynomial cannot + * exceed a run-time value MAXPOLF. An operation that attempts + * to use or generate a polynomial of higher degree may produce a + * result that suffers truncation at degree MAXPOL. The value of + * MAXPOL is set by calling the function + * + * polinif( maxpol ); + * + * where maxpol is the desired maximum degree. This must be + * done prior to calling any of the other functions in this module. + * Memory for internal temporary polynomial storage is allocated + * by polinif(). + * + * Each polynomial is represented by an array containing its + * coefficients, together with a separately declared integer equal + * to the degree of the polynomial. The coefficients appear in + * ascending order; that is, + * + * 2 na + * a(x) = a[0] + a[1] * x + a[2] * x + ... + a[na] * x . + * + * + * + * sum = poleva( a, na, x ); Evaluate polynomial a(t) at t = x. + * polprtf( a, na, D ); Print the coefficients of a to D digits. + * polclrf( a, na ); Set a identically equal to zero, up to a[na]. + * polmovf( a, na, b ); Set b = a. + * poladdf( a, na, b, nb, c ); c = b + a, nc = max(na,nb) + * polsubf( a, na, b, nb, c ); c = b - a, nc = max(na,nb) + * polmulf( a, na, b, nb, c ); c = b * a, nc = na+nb + * + * + * Division: + * + * i = poldivf( a, na, b, nb, c ); c = b / a, nc = MAXPOL + * + * returns i = the degree of the first nonzero coefficient of a. + * The computed quotient c must be divided by x^i. An error message + * is printed if a is identically zero. + * + * + * Change of variables: + * If a and b are polynomials, and t = a(x), then + * c(t) = b(a(x)) + * is a polynomial found by substituting a(x) for t. The + * subroutine call for this is + * + * polsbtf( a, na, b, nb, c ); + * + * + * Notes: + * poldivf() is an integer routine; polevaf() is float. + * Any of the arguments a, b, c may refer to the same array. + * + */ + +#ifndef NULL +#define NULL 0 +#endif +#include <math.h> + +#ifdef ANSIC +void printf(), sprintf(), exit(); +void free(void *); +void *malloc(int); +#else +void printf(), sprintf(), free(), exit(); +void *malloc(); +#endif +/* near pointer version of malloc() */ +/*#define malloc _nmalloc*/ +/*#define free _nfree*/ + +/* Pointers to internal arrays. Note poldiv() allocates + * and deallocates some temporary arrays every time it is called. + */ +static float *pt1 = 0; +static float *pt2 = 0; +static float *pt3 = 0; + +/* Maximum degree of polynomial. */ +int MAXPOLF = 0; +extern int MAXPOLF; + +/* Number of bytes (chars) in maximum size polynomial. */ +static int psize = 0; + + +/* Initialize max degree of polynomials + * and allocate temporary storage. + */ +#ifdef ANSIC +void polinif( int maxdeg ) +#else +int polinif( maxdeg ) +int maxdeg; +#endif +{ + +MAXPOLF = maxdeg; +psize = (maxdeg + 1) * sizeof(float); + +/* Release previously allocated memory, if any. */ +if( pt3 ) + free(pt3); +if( pt2 ) + free(pt2); +if( pt1 ) + free(pt1); + +/* Allocate new arrays */ +pt1 = (float * )malloc(psize); /* used by polsbtf */ +pt2 = (float * )malloc(psize); /* used by polsbtf */ +pt3 = (float * )malloc(psize); /* used by polmul */ + +/* Report if failure */ +if( (pt1 == NULL) || (pt2 == NULL) || (pt3 == NULL) ) + { + mtherr( "polinif", ERANGE ); + exit(1); + } +#if !ANSIC +return 0; +#endif +} + + + +/* Print the coefficients of a, with d decimal precision. + */ +static char *form = "abcdefghijk"; + +#ifdef ANSIC +void polprtf( float *a, int na, int d ) +#else +int polprtf( a, na, d ) +float a[]; +int na, d; +#endif +{ +int i, j, d1; +char *p; + +/* Create format descriptor string for the printout. + * Do this partly by hand, since sprintf() may be too + * bug-ridden to accomplish this feat by itself. + */ +p = form; +*p++ = '%'; +d1 = d + 8; +(void )sprintf( p, "%d ", d1 ); +p += 1; +if( d1 >= 10 ) + p += 1; +*p++ = '.'; +(void )sprintf( p, "%d ", d ); +p += 1; +if( d >= 10 ) + p += 1; +*p++ = 'e'; +*p++ = ' '; +*p++ = '\0'; + + +/* Now do the printing. + */ +d1 += 1; +j = 0; +for( i=0; i<=na; i++ ) + { +/* Detect end of available line */ + j += d1; + if( j >= 78 ) + { + printf( "\n" ); + j = d1; + } + printf( form, a[i] ); + } +printf( "\n" ); +#if !ANSIC +return 0; +#endif +} + + + +/* Set a = 0. + */ +#ifdef ANSIC +void polclrf( register float *a, int n ) +#else +int polclrf( a, n ) +register float *a; +int n; +#endif +{ +int i; + +if( n > MAXPOLF ) + n = MAXPOLF; +for( i=0; i<=n; i++ ) + *a++ = 0.0; +#if !ANSIC +return 0; +#endif +} + + + +/* Set b = a. + */ +#ifdef ANSIC +void polmovf( register float *a, int na, register float *b ) +#else +int polmovf( a, na, b ) +register float *a, *b; +int na; +#endif +{ +int i; + +if( na > MAXPOLF ) + na = MAXPOLF; + +for( i=0; i<= na; i++ ) + { + *b++ = *a++; + } +#if !ANSIC +return 0; +#endif +} + + +/* c = b * a. + */ +#ifdef ANSIC +void polmulf( float a[], int na, float b[], int nb, float c[] ) +#else +int polmulf( a, na, b, nb, c ) +float a[], b[], c[]; +int na, nb; +#endif +{ +int i, j, k, nc; +float x; + +nc = na + nb; +polclrf( pt3, MAXPOLF ); + +for( i=0; i<=na; i++ ) + { + x = a[i]; + for( j=0; j<=nb; j++ ) + { + k = i + j; + if( k > MAXPOLF ) + break; + pt3[k] += x * b[j]; + } + } + +if( nc > MAXPOLF ) + nc = MAXPOLF; +for( i=0; i<=nc; i++ ) + c[i] = pt3[i]; +#if !ANSIC +return 0; +#endif +} + + + + +/* c = b + a. + */ +#ifdef ANSIC +void poladdf( float a[], int na, float b[], int nb, float c[] ) +#else +int poladdf( a, na, b, nb, c ) +float a[], b[], c[]; +int na, nb; +#endif +{ +int i, n; + + +if( na > nb ) + n = na; +else + n = nb; + +if( n > MAXPOLF ) + n = MAXPOLF; + +for( i=0; i<=n; i++ ) + { + if( i > na ) + c[i] = b[i]; + else if( i > nb ) + c[i] = a[i]; + else + c[i] = b[i] + a[i]; + } +#if !ANSIC +return 0; +#endif +} + +/* c = b - a. + */ +#ifdef ANSIC +void polsubf( float a[], int na, float b[], int nb, float c[] ) +#else +int polsubf( a, na, b, nb, c ) +float a[], b[], c[]; +int na, nb; +#endif +{ +int i, n; + + +if( na > nb ) + n = na; +else + n = nb; + +if( n > MAXPOLF ) + n = MAXPOLF; + +for( i=0; i<=n; i++ ) + { + if( i > na ) + c[i] = b[i]; + else if( i > nb ) + c[i] = -a[i]; + else + c[i] = b[i] - a[i]; + } +#if !ANSIC +return 0; +#endif +} + + + +/* c = b/a + */ +#ifdef ANSIC +int poldivf( float a[], int na, float b[], int nb, float c[] ) +#else +int poldivf( a, na, b, nb, c ) +float a[], b[], c[]; +int na, nb; +#endif +{ +float quot; +float *ta, *tb, *tq; +int i, j, k, sing; + +sing = 0; + +/* Allocate temporary arrays. This would be quicker + * if done automatically on the stack, but stack space + * may be hard to obtain on a small computer. + */ +ta = (float * )malloc( psize ); +polclrf( ta, MAXPOLF ); +polmovf( a, na, ta ); + +tb = (float * )malloc( psize ); +polclrf( tb, MAXPOLF ); +polmovf( b, nb, tb ); + +tq = (float * )malloc( psize ); +polclrf( tq, MAXPOLF ); + +/* What to do if leading (constant) coefficient + * of denominator is zero. + */ +if( a[0] == 0.0 ) + { + for( i=0; i<=na; i++ ) + { + if( ta[i] != 0.0 ) + goto nzero; + } + mtherr( "poldivf", SING ); + goto done; + +nzero: +/* Reduce the degree of the denominator. */ + for( i=0; i<na; i++ ) + ta[i] = ta[i+1]; + ta[na] = 0.0; + + if( b[0] != 0.0 ) + { +/* Optional message: + printf( "poldivf singularity, divide quotient by x\n" ); +*/ + sing += 1; + } + else + { +/* Reduce degree of numerator. */ + for( i=0; i<nb; i++ ) + tb[i] = tb[i+1]; + tb[nb] = 0.0; + } +/* Call self, using reduced polynomials. */ + sing += poldivf( ta, na, tb, nb, c ); + goto done; + } + +/* Long division algorithm. ta[0] is nonzero. + */ +for( i=0; i<=MAXPOLF; i++ ) + { + quot = tb[i]/ta[0]; + for( j=0; j<=MAXPOLF; j++ ) + { + k = j + i; + if( k > MAXPOLF ) + break; + tb[k] -= quot * ta[j]; + } + tq[i] = quot; + } +/* Send quotient to output array. */ +polmovf( tq, MAXPOLF, c ); + +done: + +/* Restore allocated memory. */ +free(tq); +free(tb); +free(ta); +return( sing ); +} + + + + +/* Change of variables + * Substitute a(y) for the variable x in b(x). + * x = a(y) + * c(x) = b(x) = b(a(y)). + */ + +#ifdef ANSIC +void polsbtf( float a[], int na, float b[], int nb, float c[] ) +#else +int polsbtf( a, na, b, nb, c ) +float a[], b[], c[]; +int na, nb; +#endif +{ +int i, j, k, n2; +float x; + +/* 0th degree term: + */ +polclrf( pt1, MAXPOLF ); +pt1[0] = b[0]; + +polclrf( pt2, MAXPOLF ); +pt2[0] = 1.0; +n2 = 0; + +for( i=1; i<=nb; i++ ) + { +/* Form ith power of a. */ + polmulf( a, na, pt2, n2, pt2 ); + n2 += na; + x = b[i]; +/* Add the ith coefficient of b times the ith power of a. */ + for( j=0; j<=n2; j++ ) + { + if( j > MAXPOLF ) + break; + pt1[j] += x * pt2[j]; + } + } + +k = n2 + nb; +if( k > MAXPOLF ) + k = MAXPOLF; +for( i=0; i<=k; i++ ) + c[i] = pt1[i]; +#if !ANSIC +return 0; +#endif +} + + + + +/* Evaluate polynomial a(t) at t = x. + */ +float polevaf( float *a, int na, float xx ) +{ +float x, s; +int i; + +x = xx; +s = a[na]; +for( i=na-1; i>=0; i-- ) + { + s = s * x + a[i]; + } +return(s); +} + diff --git a/libm/float/powf.c b/libm/float/powf.c new file mode 100644 index 000000000..367a39ad4 --- /dev/null +++ b/libm/float/powf.c @@ -0,0 +1,338 @@ +/* powf.c + * + * Power function + * + * + * + * SYNOPSIS: + * + * float x, y, z, powf(); + * + * z = powf( x, y ); + * + * + * + * DESCRIPTION: + * + * Computes x raised to the yth power. Analytically, + * + * x**y = exp( y log(x) ). + * + * Following Cody and Waite, this program uses a lookup table + * of 2**-i/16 and pseudo extended precision arithmetic to + * obtain an extra three bits of accuracy in both the logarithm + * and the exponential. + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE -10,10 100,000 1.4e-7 3.6e-8 + * 1/10 < x < 10, x uniformly distributed. + * -10 < y < 10, y uniformly distributed. + * + * + * ERROR MESSAGES: + * + * message condition value returned + * powf overflow x**y > MAXNUMF MAXNUMF + * powf underflow x**y < 1/MAXNUMF 0.0 + * powf domain x<0 and y noninteger 0.0 + * + */ + +/* +Cephes Math Library Release 2.2: June, 1992 +Copyright 1984, 1987, 1988 by Stephen L. Moshier +Direct inquiries to 30 Frost Street, Cambridge, MA 02140 +*/ + + +#include <math.h> +static char fname[] = {"powf"}; + + +/* 2^(-i/16) + * The decimal values are rounded to 24-bit precision + */ +static float A[] = { + 1.00000000000000000000E0, + 9.57603275775909423828125E-1, + 9.17004048824310302734375E-1, + 8.78126084804534912109375E-1, + 8.40896427631378173828125E-1, + 8.05245161056518554687500E-1, + 7.71105408668518066406250E-1, + 7.38413095474243164062500E-1, + 7.07106769084930419921875E-1, + 6.77127778530120849609375E-1, + 6.48419797420501708984375E-1, + 6.20928883552551269531250E-1, + 5.94603538513183593750000E-1, + 5.69394290447235107421875E-1, + 5.45253872871398925781250E-1, + 5.22136867046356201171875E-1, + 5.00000000000000000000E-1 +}; +/* continuation, for even i only + * 2^(i/16) = A[i] + B[i/2] + */ +static float B[] = { + 0.00000000000000000000E0, +-5.61963907099083340520586E-9, +-1.23776636307969995237668E-8, + 4.03545234539989593104537E-9, + 1.21016171044789693621048E-8, +-2.00949968760174979411038E-8, + 1.89881769396087499852802E-8, +-6.53877009617774467211965E-9, + 0.00000000000000000000E0 +}; + +/* 1 / A[i] + * The decimal values are full precision + */ +static float Ainv[] = { + 1.00000000000000000000000E0, + 1.04427378242741384032197E0, + 1.09050773266525765920701E0, + 1.13878863475669165370383E0, + 1.18920711500272106671750E0, + 1.24185781207348404859368E0, + 1.29683955465100966593375E0, + 1.35425554693689272829801E0, + 1.41421356237309504880169E0, + 1.47682614593949931138691E0, + 1.54221082540794082361229E0, + 1.61049033194925430817952E0, + 1.68179283050742908606225E0, + 1.75625216037329948311216E0, + 1.83400808640934246348708E0, + 1.91520656139714729387261E0, + 2.00000000000000000000000E0 +}; + +#ifdef DEC +#define MEXP 2032.0 +#define MNEXP -2032.0 +#else +#define MEXP 2048.0 +#define MNEXP -2400.0 +#endif + +/* log2(e) - 1 */ +#define LOG2EA 0.44269504088896340736F +extern float MAXNUMF; + +#define F W +#define Fa Wa +#define Fb Wb +#define G W +#define Ga Wa +#define Gb u +#define H W +#define Ha Wb +#define Hb Wb + + +#ifdef ANSIC +float floorf( float ); +float frexpf( float, int *); +float ldexpf( float, int ); +float powif( float, int ); +#else +float floorf(), frexpf(), ldexpf(), powif(); +#endif + +/* Find a multiple of 1/16 that is within 1/16 of x. */ +#define reduc(x) 0.0625 * floorf( 16 * (x) ) + +#ifdef ANSIC +float powf( float x, float y ) +#else +float powf( x, y ) +float x, y; +#endif +{ +float u, w, z, W, Wa, Wb, ya, yb; +/* float F, Fa, Fb, G, Ga, Gb, H, Ha, Hb */ +int e, i, nflg; + + +nflg = 0; /* flag = 1 if x<0 raised to integer power */ +w = floorf(y); +if( w < 0 ) + z = -w; +else + z = w; +if( (w == y) && (z < 32768.0) ) + { + i = w; + w = powif( x, i ); + return( w ); + } + + +if( x <= 0.0F ) + { + if( x == 0.0 ) + { + if( y == 0.0 ) + return( 1.0 ); /* 0**0 */ + else + return( 0.0 ); /* 0**y */ + } + else + { + if( w != y ) + { /* noninteger power of negative number */ + mtherr( fname, DOMAIN ); + return(0.0); + } + nflg = 1; + if( x < 0 ) + x = -x; + } + } + +/* separate significand from exponent */ +x = frexpf( x, &e ); + +/* find significand in antilog table A[] */ +i = 1; +if( x <= A[9] ) + i = 9; +if( x <= A[i+4] ) + i += 4; +if( x <= A[i+2] ) + i += 2; +if( x >= A[1] ) + i = -1; +i += 1; + + +/* Find (x - A[i])/A[i] + * in order to compute log(x/A[i]): + * + * log(x) = log( a x/a ) = log(a) + log(x/a) + * + * log(x/a) = log(1+v), v = x/a - 1 = (x-a)/a + */ +x -= A[i]; +x -= B[ i >> 1 ]; +x *= Ainv[i]; + + +/* rational approximation for log(1+v): + * + * log(1+v) = v - 0.5 v^2 + v^3 P(v) + * Theoretical relative error of the approximation is 3.5e-11 + * on the interval 2^(1/16) - 1 > v > 2^(-1/16) - 1 + */ +z = x*x; +w = (((-0.1663883081054895 * x + + 0.2003770364206271) * x + - 0.2500006373383951) * x + + 0.3333331095506474) * x * z; +w -= 0.5 * z; + +/* Convert to base 2 logarithm: + * multiply by log2(e) + */ +w = w + LOG2EA * w; +/* Note x was not yet added in + * to above rational approximation, + * so do it now, while multiplying + * by log2(e). + */ +z = w + LOG2EA * x; +z = z + x; + +/* Compute exponent term of the base 2 logarithm. */ +w = -i; +w *= 0.0625; /* divide by 16 */ +w += e; +/* Now base 2 log of x is w + z. */ + +/* Multiply base 2 log by y, in extended precision. */ + +/* separate y into large part ya + * and small part yb less than 1/16 + */ +ya = reduc(y); +yb = y - ya; + + +F = z * y + w * yb; +Fa = reduc(F); +Fb = F - Fa; + +G = Fa + w * ya; +Ga = reduc(G); +Gb = G - Ga; + +H = Fb + Gb; +Ha = reduc(H); +w = 16 * (Ga + Ha); + +/* Test the power of 2 for overflow */ +if( w > MEXP ) + { + mtherr( fname, OVERFLOW ); + return( MAXNUMF ); + } + +if( w < MNEXP ) + { + mtherr( fname, UNDERFLOW ); + return( 0.0 ); + } + +e = w; +Hb = H - Ha; + +if( Hb > 0.0 ) + { + e += 1; + Hb -= 0.0625; + } + +/* Now the product y * log2(x) = Hb + e/16.0. + * + * Compute base 2 exponential of Hb, + * where -0.0625 <= Hb <= 0. + * Theoretical relative error of the approximation is 2.8e-12. + */ +/* z = 2**Hb - 1 */ +z = ((( 9.416993633606397E-003 * Hb + + 5.549356188719141E-002) * Hb + + 2.402262883964191E-001) * Hb + + 6.931471791490764E-001) * Hb; + +/* Express e/16 as an integer plus a negative number of 16ths. + * Find lookup table entry for the fractional power of 2. + */ +if( e < 0 ) + i = -( -e >> 4 ); +else + i = (e >> 4) + 1; +e = (i << 4) - e; +w = A[e]; +z = w + w * z; /* 2**-e * ( 1 + (2**Hb-1) ) */ +z = ldexpf( z, i ); /* multiply by integer power of 2 */ + +if( nflg ) + { +/* For negative x, + * find out if the integer exponent + * is odd or even. + */ + w = 2 * floorf( (float) 0.5 * w ); + if( w != y ) + z = -z; /* odd exponent */ + } + +return( z ); +} diff --git a/libm/float/powif.c b/libm/float/powif.c new file mode 100644 index 000000000..d226896ba --- /dev/null +++ b/libm/float/powif.c @@ -0,0 +1,156 @@ +/* powif.c + * + * Real raised to integer power + * + * + * + * SYNOPSIS: + * + * float x, y, powif(); + * int n; + * + * y = powif( x, n ); + * + * + * + * DESCRIPTION: + * + * Returns argument x raised to the nth power. + * The routine efficiently decomposes n as a sum of powers of + * two. The desired power is a product of two-to-the-kth + * powers of x. Thus to compute the 32767 power of x requires + * 28 multiplications instead of 32767 multiplications. + * + * + * + * ACCURACY: + * + * + * Relative error: + * arithmetic x domain n domain # trials peak rms + * IEEE .04,26 -26,26 100000 1.1e-6 2.0e-7 + * IEEE 1,2 -128,128 100000 1.1e-5 1.0e-6 + * + * Returns MAXNUMF on overflow, zero on underflow. + * + */ + +/* powi.c */ + +/* +Cephes Math Library Release 2.2: June, 1992 +Copyright 1984, 1987, 1989 by Stephen L. Moshier +Direct inquiries to 30 Frost Street, Cambridge, MA 02140 +*/ + +#include <math.h> +extern float MAXNUMF, MAXLOGF, MINLOGF, LOGE2F; + +float frexpf( float, int * ); + +float powif( float x, int nn ) +{ +int n, e, sign, asign, lx; +float w, y, s; + +if( x == 0.0 ) + { + if( nn == 0 ) + return( 1.0 ); + else if( nn < 0 ) + return( MAXNUMF ); + else + return( 0.0 ); + } + +if( nn == 0 ) + return( 1.0 ); + + +if( x < 0.0 ) + { + asign = -1; + x = -x; + } +else + asign = 0; + + +if( nn < 0 ) + { + sign = -1; + n = -nn; +/* + x = 1.0/x; +*/ + } +else + { + sign = 0; + n = nn; + } + +/* Overflow detection */ + +/* Calculate approximate logarithm of answer */ +s = frexpf( x, &lx ); +e = (lx - 1)*n; +if( (e == 0) || (e > 64) || (e < -64) ) + { + s = (s - 7.0710678118654752e-1) / (s + 7.0710678118654752e-1); + s = (2.9142135623730950 * s - 0.5 + lx) * nn * LOGE2F; + } +else + { + s = LOGE2F * e; + } + +if( s > MAXLOGF ) + { + mtherr( "powi", OVERFLOW ); + y = MAXNUMF; + goto done; + } + +if( s < MINLOGF ) + return(0.0); + +/* Handle tiny denormal answer, but with less accuracy + * since roundoff error in 1.0/x will be amplified. + * The precise demarcation should be the gradual underflow threshold. + */ +if( s < (-MAXLOGF+2.0) ) + { + x = 1.0/x; + sign = 0; + } + +/* First bit of the power */ +if( n & 1 ) + y = x; + +else + { + y = 1.0; + asign = 0; + } + +w = x; +n >>= 1; +while( n ) + { + w = w * w; /* arg to the 2-to-the-kth power */ + if( n & 1 ) /* if that bit is set, then include in product */ + y *= w; + n >>= 1; + } + + +done: + +if( asign ) + y = -y; /* odd power of negative number */ +if( sign ) + y = 1.0/y; +return(y); +} diff --git a/libm/float/powtst.c b/libm/float/powtst.c new file mode 100644 index 000000000..ff4845de2 --- /dev/null +++ b/libm/float/powtst.c @@ -0,0 +1,41 @@ +#include <stdio.h> +#include <math.h> +extern float MAXNUMF, MAXLOGF, MINLOGF; + +int +main() +{ +float exp1, minnum, x, y, z, e; +exp1 = expf(1.0F); + +minnum = powif(2.0F,-149); + +x = exp1; +y = MINLOGF + logf(0.501); +/*y = MINLOGF - 0.405;*/ +z = powf(x,y); +e = (z - minnum) / minnum; +printf("%.16e %.16e\n", z, e); + +x = exp1; +y = MAXLOGF; +z = powf(x,y); +e = (z - MAXNUMF) / MAXNUMF; +printf("%.16e %.16e\n", z, e); + +x = MAXNUMF; +y = 1.0F/MAXLOGF; +z = powf(x,y); +e = (z - exp1) / exp1; +printf("%.16e %.16e\n", z, e); + + +x = exp1; +y = MINLOGF; +z = powf(x,y); +e = (z - minnum) / minnum; +printf("%.16e %.16e\n", z, e); + + +exit(0); +} diff --git a/libm/float/psif.c b/libm/float/psif.c new file mode 100644 index 000000000..2d9187c67 --- /dev/null +++ b/libm/float/psif.c @@ -0,0 +1,153 @@ +/* psif.c + * + * Psi (digamma) function + * + * + * SYNOPSIS: + * + * float x, y, psif(); + * + * y = psif( x ); + * + * + * DESCRIPTION: + * + * d - + * psi(x) = -- ln | (x) + * dx + * + * is the logarithmic derivative of the gamma function. + * For integer x, + * n-1 + * - + * psi(n) = -EUL + > 1/k. + * - + * k=1 + * + * This formula is used for 0 < n <= 10. If x is negative, it + * is transformed to a positive argument by the reflection + * formula psi(1-x) = psi(x) + pi cot(pi x). + * For general positive x, the argument is made greater than 10 + * using the recurrence psi(x+1) = psi(x) + 1/x. + * Then the following asymptotic expansion is applied: + * + * inf. B + * - 2k + * psi(x) = log(x) - 1/2x - > ------- + * - 2k + * k=1 2k x + * + * where the B2k are Bernoulli numbers. + * + * ACCURACY: + * Absolute error, relative when |psi| > 1 : + * arithmetic domain # trials peak rms + * IEEE -33,0 30000 8.2e-7 1.2e-7 + * IEEE 0,33 100000 7.3e-7 7.7e-8 + * + * ERROR MESSAGES: + * message condition value returned + * psi singularity x integer <=0 MAXNUMF + */ + +/* +Cephes Math Library Release 2.2: June, 1992 +Copyright 1984, 1987, 1992 by Stephen L. Moshier +Direct inquiries to 30 Frost Street, Cambridge, MA 02140 +*/ + +#include <math.h> + + +static float A[] = { +-4.16666666666666666667E-3, + 3.96825396825396825397E-3, +-8.33333333333333333333E-3, + 8.33333333333333333333E-2 +}; + + +#define EUL 0.57721566490153286061 + +extern float PIF, MAXNUMF; + + + +float floorf(float), logf(float), tanf(float); +float polevlf(float, float *, int); + +float psif(float xx) +{ +float p, q, nz, x, s, w, y, z; +int i, n, negative; + + +x = xx; +nz = 0.0; +negative = 0; +if( x <= 0.0 ) + { + negative = 1; + q = x; + p = floorf(q); + if( p == q ) + { + mtherr( "psif", SING ); + return( MAXNUMF ); + } + nz = q - p; + if( nz != 0.5 ) + { + if( nz > 0.5 ) + { + p += 1.0; + nz = q - p; + } + nz = PIF/tanf(PIF*nz); + } + else + { + nz = 0.0; + } + x = 1.0 - x; + } + +/* check for positive integer up to 10 */ +if( (x <= 10.0) && (x == floorf(x)) ) + { + y = 0.0; + n = x; + for( i=1; i<n; i++ ) + { + w = i; + y += 1.0/w; + } + y -= EUL; + goto done; + } + +s = x; +w = 0.0; +while( s < 10.0 ) + { + w += 1.0/s; + s += 1.0; + } + +if( s < 1.0e8 ) + { + z = 1.0/(s * s); + y = z * polevlf( z, A, 3 ); + } +else + y = 0.0; + +y = logf(s) - (0.5/s) - y - w; + +done: +if( negative ) + { + y -= nz; + } +return(y); +} diff --git a/libm/float/rgammaf.c b/libm/float/rgammaf.c new file mode 100644 index 000000000..5afa25e91 --- /dev/null +++ b/libm/float/rgammaf.c @@ -0,0 +1,130 @@ +/* rgammaf.c + * + * Reciprocal gamma function + * + * + * + * SYNOPSIS: + * + * float x, y, rgammaf(); + * + * y = rgammaf( x ); + * + * + * + * DESCRIPTION: + * + * Returns one divided by the gamma function of the argument. + * + * The function is approximated by a Chebyshev expansion in + * the interval [0,1]. Range reduction is by recurrence + * for arguments between -34.034 and +34.84425627277176174. + * 1/MAXNUMF is returned for positive arguments outside this + * range. + * + * The reciprocal gamma function has no singularities, + * but overflow and underflow may occur for large arguments. + * These conditions return either MAXNUMF or 1/MAXNUMF with + * appropriate sign. + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE -34,+34 100000 8.9e-7 1.1e-7 + */ + +/* +Cephes Math Library Release 2.2: June, 1992 +Copyright 1985, 1987, 1992 by Stephen L. Moshier +Direct inquiries to 30 Frost Street, Cambridge, MA 02140 +*/ + +#include <math.h> + +/* Chebyshev coefficients for reciprocal gamma function + * in interval 0 to 1. Function is 1/(x gamma(x)) - 1 + */ + +static float R[] = { + 1.08965386454418662084E-9, +-3.33964630686836942556E-8, + 2.68975996440595483619E-7, + 2.96001177518801696639E-6, +-8.04814124978471142852E-5, + 4.16609138709688864714E-4, + 5.06579864028608725080E-3, +-6.41925436109158228810E-2, +-4.98558728684003594785E-3, + 1.27546015610523951063E-1 +}; + + +static char name[] = "rgammaf"; + +extern float PIF, MAXLOGF, MAXNUMF; + + + +float chbevlf(float, float *, int); +float expf(float), logf(float), sinf(float), lgamf(float); + +float rgammaf(float xx) +{ +float x, w, y, z; +int sign; + +x = xx; +if( x > 34.84425627277176174) + { + mtherr( name, UNDERFLOW ); + return(1.0/MAXNUMF); + } +if( x < -34.034 ) + { + w = -x; + z = sinf( PIF*w ); + if( z == 0.0 ) + return(0.0); + if( z < 0.0 ) + { + sign = 1; + z = -z; + } + else + sign = -1; + + y = logf( w * z / PIF ) + lgamf(w); + if( y < -MAXLOGF ) + { + mtherr( name, UNDERFLOW ); + return( sign * 1.0 / MAXNUMF ); + } + if( y > MAXLOGF ) + { + mtherr( name, OVERFLOW ); + return( sign * MAXNUMF ); + } + return( sign * expf(y)); + } +z = 1.0; +w = x; + +while( w > 1.0 ) /* Downward recurrence */ + { + w -= 1.0; + z *= w; + } +while( w < 0.0 ) /* Upward recurrence */ + { + z /= w; + w += 1.0; + } +if( w == 0.0 ) /* Nonpositive integer */ + return(0.0); +if( w == 1.0 ) /* Other integer */ + return( 1.0/z ); + +y = w * ( 1.0 + chbevlf( 4.0*w-2.0, R, 10 ) ) / z; +return(y); +} diff --git a/libm/float/setprec.c b/libm/float/setprec.c new file mode 100644 index 000000000..a5222ae73 --- /dev/null +++ b/libm/float/setprec.c @@ -0,0 +1,10 @@ +/* Null stubs for coprocessor precision settings */ + +int +sprec() {return 0; } + +int +dprec() {return 0; } + +int +ldprec() {return 0; } diff --git a/libm/float/shichif.c b/libm/float/shichif.c new file mode 100644 index 000000000..ae98021a9 --- /dev/null +++ b/libm/float/shichif.c @@ -0,0 +1,212 @@ +/* shichif.c + * + * Hyperbolic sine and cosine integrals + * + * + * + * SYNOPSIS: + * + * float x, Chi, Shi; + * + * shichi( x, &Chi, &Shi ); + * + * + * DESCRIPTION: + * + * Approximates the integrals + * + * x + * - + * | | cosh t - 1 + * Chi(x) = eul + ln x + | ----------- dt, + * | | t + * - + * 0 + * + * x + * - + * | | sinh t + * Shi(x) = | ------ dt + * | | t + * - + * 0 + * + * where eul = 0.57721566490153286061 is Euler's constant. + * The integrals are evaluated by power series for x < 8 + * and by Chebyshev expansions for x between 8 and 88. + * For large x, both functions approach exp(x)/2x. + * Arguments greater than 88 in magnitude return MAXNUM. + * + * + * ACCURACY: + * + * Test interval 0 to 88. + * Relative error: + * arithmetic function # trials peak rms + * IEEE Shi 20000 3.5e-7 7.0e-8 + * Absolute error, except relative when |Chi| > 1: + * IEEE Chi 20000 3.8e-7 7.6e-8 + */ + +/* +Cephes Math Library Release 2.2: July, 1992 +Copyright 1984, 1987, 1992 by Stephen L. Moshier +Direct inquiries to 30 Frost Street, Cambridge, MA 02140 +*/ + + +#include <math.h> + +/* x exp(-x) shi(x), inverted interval 8 to 18 */ +static float S1[] = { +-3.56699611114982536845E-8, + 1.44818877384267342057E-7, + 7.82018215184051295296E-7, +-5.39919118403805073710E-6, +-3.12458202168959833422E-5, + 8.90136741950727517826E-5, + 2.02558474743846862168E-3, + 2.96064440855633256972E-2, + 1.11847751047257036625E0 +}; + +/* x exp(-x) shi(x), inverted interval 18 to 88 */ +static float S2[] = { + 1.69050228879421288846E-8, + 1.25391771228487041649E-7, + 1.16229947068677338732E-6, + 1.61038260117376323993E-5, + 3.49810375601053973070E-4, + 1.28478065259647610779E-2, + 1.03665722588798326712E0 +}; + + +/* x exp(-x) chin(x), inverted interval 8 to 18 */ +static float C1[] = { + 1.31458150989474594064E-8, +-4.75513930924765465590E-8, +-2.21775018801848880741E-7, + 1.94635531373272490962E-6, + 4.33505889257316408893E-6, +-6.13387001076494349496E-5, +-3.13085477492997465138E-4, + 4.97164789823116062801E-4, + 2.64347496031374526641E-2, + 1.11446150876699213025E0 +}; + +/* x exp(-x) chin(x), inverted interval 18 to 88 */ +static float C2[] = { +-3.00095178028681682282E-9, + 7.79387474390914922337E-8, + 1.06942765566401507066E-6, + 1.59503164802313196374E-5, + 3.49592575153777996871E-4, + 1.28475387530065247392E-2, + 1.03665693917934275131E0 +}; + + + +/* Sine and cosine integrals */ + +#define EUL 0.57721566490153286061 +extern float MACHEPF, MAXNUMF; + +#define fabsf(x) ( (x) < 0 ? -(x) : (x) ) + +#ifdef ANSIC +float logf(float ), expf(float), chbevlf(float, float *, int); +#else +float logf(), expf(), chbevlf(); +#endif + + + +int shichif( float xx, float *si, float *ci ) +{ +float x, k, z, c, s, a; +short sign; + +x = xx; +if( x < 0.0 ) + { + sign = -1; + x = -x; + } +else + sign = 0; + + +if( x == 0.0 ) + { + *si = 0.0; + *ci = -MAXNUMF; + return( 0 ); + } + +if( x >= 8.0 ) + goto chb; + +z = x * x; + +/* Direct power series expansion */ + +a = 1.0; +s = 1.0; +c = 0.0; +k = 2.0; + +do + { + a *= z/k; + c += a/k; + k += 1.0; + a /= k; + s += a/k; + k += 1.0; + } +while( fabsf(a/s) > MACHEPF ); + +s *= x; +goto done; + + +chb: + +if( x < 18.0 ) + { + a = (576.0/x - 52.0)/10.0; + k = expf(x) / x; + s = k * chbevlf( a, S1, 9 ); + c = k * chbevlf( a, C1, 10 ); + goto done; + } + +if( x <= 88.0 ) + { + a = (6336.0/x - 212.0)/70.0; + k = expf(x) / x; + s = k * chbevlf( a, S2, 7 ); + c = k * chbevlf( a, C2, 7 ); + goto done; + } +else + { + if( sign ) + *si = -MAXNUMF; + else + *si = MAXNUMF; + *ci = MAXNUMF; + return(0); + } +done: +if( sign ) + s = -s; + +*si = s; + +*ci = EUL + logf(x) + c; +return(0); +} diff --git a/libm/float/sicif.c b/libm/float/sicif.c new file mode 100644 index 000000000..04633ee68 --- /dev/null +++ b/libm/float/sicif.c @@ -0,0 +1,279 @@ +/* sicif.c + * + * Sine and cosine integrals + * + * + * + * SYNOPSIS: + * + * float x, Ci, Si; + * + * sicif( x, &Si, &Ci ); + * + * + * DESCRIPTION: + * + * Evaluates the integrals + * + * x + * - + * | cos t - 1 + * Ci(x) = eul + ln x + | --------- dt, + * | t + * - + * 0 + * x + * - + * | sin t + * Si(x) = | ----- dt + * | t + * - + * 0 + * + * where eul = 0.57721566490153286061 is Euler's constant. + * The integrals are approximated by rational functions. + * For x > 8 auxiliary functions f(x) and g(x) are employed + * such that + * + * Ci(x) = f(x) sin(x) - g(x) cos(x) + * Si(x) = pi/2 - f(x) cos(x) - g(x) sin(x) + * + * + * ACCURACY: + * Test interval = [0,50]. + * Absolute error, except relative when > 1: + * arithmetic function # trials peak rms + * IEEE Si 30000 2.1e-7 4.3e-8 + * IEEE Ci 30000 3.9e-7 2.2e-8 + */ + +/* +Cephes Math Library Release 2.1: January, 1989 +Copyright 1984, 1987, 1989 by Stephen L. Moshier +Direct inquiries to 30 Frost Street, Cambridge, MA 02140 +*/ + +#include <math.h> + +static float SN[] = { +-8.39167827910303881427E-11, + 4.62591714427012837309E-8, +-9.75759303843632795789E-6, + 9.76945438170435310816E-4, +-4.13470316229406538752E-2, + 1.00000000000000000302E0, +}; +static float SD[] = { + 2.03269266195951942049E-12, + 1.27997891179943299903E-9, + 4.41827842801218905784E-7, + 9.96412122043875552487E-5, + 1.42085239326149893930E-2, + 9.99999999999999996984E-1, +}; + +static float CN[] = { + 2.02524002389102268789E-11, +-1.35249504915790756375E-8, + 3.59325051419993077021E-6, +-4.74007206873407909465E-4, + 2.89159652607555242092E-2, +-1.00000000000000000080E0, +}; +static float CD[] = { + 4.07746040061880559506E-12, + 3.06780997581887812692E-9, + 1.23210355685883423679E-6, + 3.17442024775032769882E-4, + 5.10028056236446052392E-2, + 4.00000000000000000080E0, +}; + + +static float FN4[] = { + 4.23612862892216586994E0, + 5.45937717161812843388E0, + 1.62083287701538329132E0, + 1.67006611831323023771E-1, + 6.81020132472518137426E-3, + 1.08936580650328664411E-4, + 5.48900223421373614008E-7, +}; +static float FD4[] = { +/* 1.00000000000000000000E0,*/ + 8.16496634205391016773E0, + 7.30828822505564552187E0, + 1.86792257950184183883E0, + 1.78792052963149907262E-1, + 7.01710668322789753610E-3, + 1.10034357153915731354E-4, + 5.48900252756255700982E-7, +}; + + +static float FN8[] = { + 4.55880873470465315206E-1, + 7.13715274100146711374E-1, + 1.60300158222319456320E-1, + 1.16064229408124407915E-2, + 3.49556442447859055605E-4, + 4.86215430826454749482E-6, + 3.20092790091004902806E-8, + 9.41779576128512936592E-11, + 9.70507110881952024631E-14, +}; +static float FD8[] = { +/* 1.00000000000000000000E0,*/ + 9.17463611873684053703E-1, + 1.78685545332074536321E-1, + 1.22253594771971293032E-2, + 3.58696481881851580297E-4, + 4.92435064317881464393E-6, + 3.21956939101046018377E-8, + 9.43720590350276732376E-11, + 9.70507110881952025725E-14, +}; + +static float GN4[] = { + 8.71001698973114191777E-2, + 6.11379109952219284151E-1, + 3.97180296392337498885E-1, + 7.48527737628469092119E-2, + 5.38868681462177273157E-3, + 1.61999794598934024525E-4, + 1.97963874140963632189E-6, + 7.82579040744090311069E-9, +}; +static float GD4[] = { +/* 1.00000000000000000000E0,*/ + 1.64402202413355338886E0, + 6.66296701268987968381E-1, + 9.88771761277688796203E-2, + 6.22396345441768420760E-3, + 1.73221081474177119497E-4, + 2.02659182086343991969E-6, + 7.82579218933534490868E-9, +}; + +static float GN8[] = { + 6.97359953443276214934E-1, + 3.30410979305632063225E-1, + 3.84878767649974295920E-2, + 1.71718239052347903558E-3, + 3.48941165502279436777E-5, + 3.47131167084116673800E-7, + 1.70404452782044526189E-9, + 3.85945925430276600453E-12, + 3.14040098946363334640E-15, +}; +static float GD8[] = { +/* 1.00000000000000000000E0,*/ + 1.68548898811011640017E0, + 4.87852258695304967486E-1, + 4.67913194259625806320E-2, + 1.90284426674399523638E-3, + 3.68475504442561108162E-5, + 3.57043223443740838771E-7, + 1.72693748966316146736E-9, + 3.87830166023954706752E-12, + 3.14040098946363335242E-15, +}; + +#define EUL 0.57721566490153286061 +extern float MAXNUMF, PIO2F, MACHEPF; + + + +#ifdef ANSIC +float logf(float), sinf(float), cosf(float); +float polevlf(float, float *, int); +float p1evlf(float, float *, int); +#else +float logf(), sinf(), cosf(), polevlf(), p1evlf(); +#endif + + +int sicif( float xx, float *si, float *ci ) +{ +float x, z, c, s, f, g; +int sign; + +x = xx; +if( x < 0.0 ) + { + sign = -1; + x = -x; + } +else + sign = 0; + + +if( x == 0.0 ) + { + *si = 0.0; + *ci = -MAXNUMF; + return( 0 ); + } + + +if( x > 1.0e9 ) + { + *si = PIO2F - cosf(x)/x; + *ci = sinf(x)/x; + return( 0 ); + } + + + +if( x > 4.0 ) + goto asympt; + +z = x * x; +s = x * polevlf( z, SN, 5 ) / polevlf( z, SD, 5 ); +c = z * polevlf( z, CN, 5 ) / polevlf( z, CD, 5 ); + +if( sign ) + s = -s; +*si = s; +*ci = EUL + logf(x) + c; /* real part if x < 0 */ +return(0); + + + +/* The auxiliary functions are: + * + * + * *si = *si - PIO2; + * c = cos(x); + * s = sin(x); + * + * t = *ci * s - *si * c; + * a = *ci * c + *si * s; + * + * *si = t; + * *ci = -a; + */ + + +asympt: + +s = sinf(x); +c = cosf(x); +z = 1.0/(x*x); +if( x < 8.0 ) + { + f = polevlf( z, FN4, 6 ) / (x * p1evlf( z, FD4, 7 )); + g = z * polevlf( z, GN4, 7 ) / p1evlf( z, GD4, 7 ); + } +else + { + f = polevlf( z, FN8, 8 ) / (x * p1evlf( z, FD8, 8 )); + g = z * polevlf( z, GN8, 8 ) / p1evlf( z, GD8, 9 ); + } +*si = PIO2F - f * c - g * s; +if( sign ) + *si = -( *si ); +*ci = f * s - g * c; + +return(0); +} diff --git a/libm/float/sindgf.c b/libm/float/sindgf.c new file mode 100644 index 000000000..a3f5851c8 --- /dev/null +++ b/libm/float/sindgf.c @@ -0,0 +1,232 @@ +/* sindgf.c + * + * Circular sine of angle in degrees + * + * + * + * SYNOPSIS: + * + * float x, y, sindgf(); + * + * y = sindgf( x ); + * + * + * + * DESCRIPTION: + * + * Range reduction is into intervals of 45 degrees. + * + * Two polynomial approximating functions are employed. + * Between 0 and pi/4 the sine is approximated by + * x + x**3 P(x**2). + * Between pi/4 and pi/2 the cosine is represented as + * 1 - x**2 Q(x**2). + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE +-3600 100,000 1.2e-7 3.0e-8 + * + * ERROR MESSAGES: + * + * message condition value returned + * sin total loss x > 2^24 0.0 + * + */ + +/* cosdgf.c + * + * Circular cosine of angle in degrees + * + * + * + * SYNOPSIS: + * + * float x, y, cosdgf(); + * + * y = cosdgf( x ); + * + * + * + * DESCRIPTION: + * + * Range reduction is into intervals of 45 degrees. + * + * Two polynomial approximating functions are employed. + * Between 0 and pi/4 the cosine is approximated by + * 1 - x**2 Q(x**2). + * Between pi/4 and pi/2 the sine is represented as + * x + x**3 P(x**2). + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE -8192,+8192 100,000 3.0e-7 3.0e-8 + */ + +/* +Cephes Math Library Release 2.2: June, 1992 +Copyright 1985, 1987, 1988, 1992 by Stephen L. Moshier +Direct inquiries to 30 Frost Street, Cambridge, MA 02140 +*/ + + +/* Single precision circular sine + * test interval: [-pi/4, +pi/4] + * trials: 10000 + * peak relative error: 6.8e-8 + * rms relative error: 2.6e-8 + */ +#include <math.h> + + +/*static float FOPI = 1.27323954473516;*/ + +extern float PIO4F; + +/* These are for a 24-bit significand: */ +static float T24M1 = 16777215.; + +static float PI180 = 0.0174532925199432957692; /* pi/180 */ + +float sindgf( float xx ) +{ +float x, y, z; +long j; +int sign; + +sign = 1; +x = xx; +if( xx < 0 ) + { + sign = -1; + x = -xx; + } +if( x > T24M1 ) + { + mtherr( "sindgf", TLOSS ); + return(0.0); + } +j = 0.022222222222222222222 * x; /* integer part of x/45 */ +y = j; +/* map zeros to origin */ +if( j & 1 ) + { + j += 1; + y += 1.0; + } +j &= 7; /* octant modulo 360 degrees */ +/* reflect in x axis */ +if( j > 3) + { + sign = -sign; + j -= 4; + } + +x = x - y * 45.0; +x *= PI180; /* multiply by pi/180 to convert to radians */ + +z = x * x; +if( (j==1) || (j==2) ) + { +/* + y = ((( 2.4462803166E-5 * z + - 1.3887580023E-3) * z + + 4.1666650433E-2) * z + - 4.9999999968E-1) * z + + 1.0; +*/ + +/* measured relative error in +/- pi/4 is 7.8e-8 */ + y = (( 2.443315711809948E-005 * z + - 1.388731625493765E-003) * z + + 4.166664568298827E-002) * z * z; + y -= 0.5 * z; + y += 1.0; + } +else + { +/* Theoretical relative error = 3.8e-9 in [-pi/4, +pi/4] */ + y = ((-1.9515295891E-4 * z + + 8.3321608736E-3) * z + - 1.6666654611E-1) * z * x; + y += x; + } + +if(sign < 0) + y = -y; +return( y); +} + + +/* Single precision circular cosine + * test interval: [-pi/4, +pi/4] + * trials: 10000 + * peak relative error: 8.3e-8 + * rms relative error: 2.2e-8 + */ + +float cosdgf( float xx ) +{ +register float x, y, z; +int j, sign; + +/* make argument positive */ +sign = 1; +x = xx; +if( x < 0 ) + x = -x; + +if( x > T24M1 ) + { + mtherr( "cosdgf", TLOSS ); + return(0.0); + } + +j = 0.02222222222222222222222 * x; /* integer part of x/PIO4 */ +y = j; +/* integer and fractional part modulo one octant */ +if( j & 1 ) /* map zeros to origin */ + { + j += 1; + y += 1.0; + } +j &= 7; +if( j > 3) + { + j -=4; + sign = -sign; + } + +if( j > 1 ) + sign = -sign; + +x = x - y * 45.0; /* x mod 45 degrees */ +x *= PI180; /* multiply by pi/180 to convert to radians */ + +z = x * x; + +if( (j==1) || (j==2) ) + { + y = (((-1.9515295891E-4 * z + + 8.3321608736E-3) * z + - 1.6666654611E-1) * z * x) + + x; + } +else + { + y = (( 2.443315711809948E-005 * z + - 1.388731625493765E-003) * z + + 4.166664568298827E-002) * z * z; + y -= 0.5 * z; + y += 1.0; + } +if(sign < 0) + y = -y; +return( y ); +} + diff --git a/libm/float/sinf.c b/libm/float/sinf.c new file mode 100644 index 000000000..2f1bb45b8 --- /dev/null +++ b/libm/float/sinf.c @@ -0,0 +1,283 @@ +/* sinf.c + * + * Circular sine + * + * + * + * SYNOPSIS: + * + * float x, y, sinf(); + * + * y = sinf( x ); + * + * + * + * DESCRIPTION: + * + * Range reduction is into intervals of pi/4. The reduction + * error is nearly eliminated by contriving an extended precision + * modular arithmetic. + * + * Two polynomial approximating functions are employed. + * Between 0 and pi/4 the sine is approximated by + * x + x**3 P(x**2). + * Between pi/4 and pi/2 the cosine is represented as + * 1 - x**2 Q(x**2). + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE -4096,+4096 100,000 1.2e-7 3.0e-8 + * IEEE -8192,+8192 100,000 3.0e-7 3.0e-8 + * + * ERROR MESSAGES: + * + * message condition value returned + * sin total loss x > 2^24 0.0 + * + * Partial loss of accuracy begins to occur at x = 2^13 + * = 8192. Results may be meaningless for x >= 2^24 + * The routine as implemented flags a TLOSS error + * for x >= 2^24 and returns 0.0. + */ + +/* cosf.c + * + * Circular cosine + * + * + * + * SYNOPSIS: + * + * float x, y, cosf(); + * + * y = cosf( x ); + * + * + * + * DESCRIPTION: + * + * Range reduction is into intervals of pi/4. The reduction + * error is nearly eliminated by contriving an extended precision + * modular arithmetic. + * + * Two polynomial approximating functions are employed. + * Between 0 and pi/4 the cosine is approximated by + * 1 - x**2 Q(x**2). + * Between pi/4 and pi/2 the sine is represented as + * x + x**3 P(x**2). + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE -8192,+8192 100,000 3.0e-7 3.0e-8 + */ + +/* +Cephes Math Library Release 2.2: June, 1992 +Copyright 1985, 1987, 1988, 1992 by Stephen L. Moshier +Direct inquiries to 30 Frost Street, Cambridge, MA 02140 +*/ + + +/* Single precision circular sine + * test interval: [-pi/4, +pi/4] + * trials: 10000 + * peak relative error: 6.8e-8 + * rms relative error: 2.6e-8 + */ +#include <math.h> + + +static float FOPI = 1.27323954473516; + +extern float PIO4F; +/* Note, these constants are for a 32-bit significand: */ +/* +static float DP1 = 0.7853851318359375; +static float DP2 = 1.30315311253070831298828125e-5; +static float DP3 = 3.03855025325309630e-11; +static float lossth = 65536.; +*/ + +/* These are for a 24-bit significand: */ +static float DP1 = 0.78515625; +static float DP2 = 2.4187564849853515625e-4; +static float DP3 = 3.77489497744594108e-8; +static float lossth = 8192.; +static float T24M1 = 16777215.; + +static float sincof[] = { +-1.9515295891E-4, + 8.3321608736E-3, +-1.6666654611E-1 +}; +static float coscof[] = { + 2.443315711809948E-005, +-1.388731625493765E-003, + 4.166664568298827E-002 +}; + +float sinf( float xx ) +{ +float *p; +float x, y, z; +register unsigned long j; +register int sign; + +sign = 1; +x = xx; +if( xx < 0 ) + { + sign = -1; + x = -xx; + } +if( x > T24M1 ) + { + mtherr( "sinf", TLOSS ); + return(0.0); + } +j = FOPI * x; /* integer part of x/(PI/4) */ +y = j; +/* map zeros to origin */ +if( j & 1 ) + { + j += 1; + y += 1.0; + } +j &= 7; /* octant modulo 360 degrees */ +/* reflect in x axis */ +if( j > 3) + { + sign = -sign; + j -= 4; + } + +if( x > lossth ) + { + mtherr( "sinf", PLOSS ); + x = x - y * PIO4F; + } +else + { +/* Extended precision modular arithmetic */ + x = ((x - y * DP1) - y * DP2) - y * DP3; + } +/*einits();*/ +z = x * x; +if( (j==1) || (j==2) ) + { +/* measured relative error in +/- pi/4 is 7.8e-8 */ +/* + y = (( 2.443315711809948E-005 * z + - 1.388731625493765E-003) * z + + 4.166664568298827E-002) * z * z; +*/ + p = coscof; + y = *p++; + y = y * z + *p++; + y = y * z + *p++; + y *= z * z; + y -= 0.5 * z; + y += 1.0; + } +else + { +/* Theoretical relative error = 3.8e-9 in [-pi/4, +pi/4] */ +/* + y = ((-1.9515295891E-4 * z + + 8.3321608736E-3) * z + - 1.6666654611E-1) * z * x; + y += x; +*/ + p = sincof; + y = *p++; + y = y * z + *p++; + y = y * z + *p++; + y *= z * x; + y += x; + } +/*einitd();*/ +if(sign < 0) + y = -y; +return( y); +} + + +/* Single precision circular cosine + * test interval: [-pi/4, +pi/4] + * trials: 10000 + * peak relative error: 8.3e-8 + * rms relative error: 2.2e-8 + */ + +float cosf( float xx ) +{ +float x, y, z; +int j, sign; + +/* make argument positive */ +sign = 1; +x = xx; +if( x < 0 ) + x = -x; + +if( x > T24M1 ) + { + mtherr( "cosf", TLOSS ); + return(0.0); + } + +j = FOPI * x; /* integer part of x/PIO4 */ +y = j; +/* integer and fractional part modulo one octant */ +if( j & 1 ) /* map zeros to origin */ + { + j += 1; + y += 1.0; + } +j &= 7; +if( j > 3) + { + j -=4; + sign = -sign; + } + +if( j > 1 ) + sign = -sign; + +if( x > lossth ) + { + mtherr( "cosf", PLOSS ); + x = x - y * PIO4F; + } +else +/* Extended precision modular arithmetic */ + x = ((x - y * DP1) - y * DP2) - y * DP3; + +z = x * x; + +if( (j==1) || (j==2) ) + { + y = (((-1.9515295891E-4 * z + + 8.3321608736E-3) * z + - 1.6666654611E-1) * z * x) + + x; + } +else + { + y = (( 2.443315711809948E-005 * z + - 1.388731625493765E-003) * z + + 4.166664568298827E-002) * z * z; + y -= 0.5 * z; + y += 1.0; + } +if(sign < 0) + y = -y; +return( y ); +} + diff --git a/libm/float/sinhf.c b/libm/float/sinhf.c new file mode 100644 index 000000000..e8baaf4fa --- /dev/null +++ b/libm/float/sinhf.c @@ -0,0 +1,87 @@ +/* sinhf.c + * + * Hyperbolic sine + * + * + * + * SYNOPSIS: + * + * float x, y, sinhf(); + * + * y = sinhf( x ); + * + * + * + * DESCRIPTION: + * + * Returns hyperbolic sine of argument in the range MINLOGF to + * MAXLOGF. + * + * The range is partitioned into two segments. If |x| <= 1, a + * polynomial approximation is used. + * Otherwise the calculation is sinh(x) = ( exp(x) - exp(-x) )/2. + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE +-MAXLOG 100000 1.1e-7 2.9e-8 + * + */ + +/* +Cephes Math Library Release 2.2: June, 1992 +Copyright 1984, 1987, 1989, 1992 by Stephen L. Moshier +Direct inquiries to 30 Frost Street, Cambridge, MA 02140 +*/ + +/* Single precision hyperbolic sine + * test interval: [-1, +1] + * trials: 10000 + * peak relative error: 9.0e-8 + * rms relative error: 3.0e-8 + */ +#include <math.h> +extern float MAXLOGF, MAXNUMF; + +float expf( float ); + +float sinhf( float xx ) +{ +register float z; +float x; + +x = xx; +if( xx < 0 ) + z = -x; +else + z = x; + +if( z > MAXLOGF ) + { + mtherr( "sinhf", DOMAIN ); + if( x > 0 ) + return( MAXNUMF ); + else + return( -MAXNUMF ); + } +if( z > 1.0 ) + { + z = expf(z); + z = 0.5*z - (0.5/z); + if( x < 0 ) + z = -z; + } +else + { + z = x * x; + z = + (( 2.03721912945E-4 * z + + 8.33028376239E-3) * z + + 1.66667160211E-1) * z * x + + x; + } +return( z ); +} diff --git a/libm/float/spencef.c b/libm/float/spencef.c new file mode 100644 index 000000000..52799babe --- /dev/null +++ b/libm/float/spencef.c @@ -0,0 +1,135 @@ +/* spencef.c + * + * Dilogarithm + * + * + * + * SYNOPSIS: + * + * float x, y, spencef(); + * + * y = spencef( x ); + * + * + * + * DESCRIPTION: + * + * Computes the integral + * + * x + * - + * | | log t + * spence(x) = - | ----- dt + * | | t - 1 + * - + * 1 + * + * for x >= 0. A rational approximation gives the integral in + * the interval (0.5, 1.5). Transformation formulas for 1/x + * and 1-x are employed outside the basic expansion range. + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE 0,4 30000 4.4e-7 6.3e-8 + * + * + */ + +/* spence.c */ + + +/* +Cephes Math Library Release 2.1: January, 1989 +Copyright 1985, 1987, 1989 by Stephen L. Moshier +Direct inquiries to 30 Frost Street, Cambridge, MA 02140 +*/ + +#include <math.h> + +static float A[8] = { + 4.65128586073990045278E-5, + 7.31589045238094711071E-3, + 1.33847639578309018650E-1, + 8.79691311754530315341E-1, + 2.71149851196553469920E0, + 4.25697156008121755724E0, + 3.29771340985225106936E0, + 1.00000000000000000126E0, +}; +static float B[8] = { + 6.90990488912553276999E-4, + 2.54043763932544379113E-2, + 2.82974860602568089943E-1, + 1.41172597751831069617E0, + 3.63800533345137075418E0, + 5.03278880143316990390E0, + 3.54771340985225096217E0, + 9.99999999999999998740E-1, +}; + +extern float PIF, MACHEPF; + +/* pi * pi / 6 */ +#define PIFS 1.64493406684822643647 + + +float logf(float), polevlf(float, float *, int); +float spencef(float xx) +{ +float x, w, y, z; +int flag; + +x = xx; +if( x < 0.0 ) + { + mtherr( "spencef", DOMAIN ); + return(0.0); + } + +if( x == 1.0 ) + return( 0.0 ); + +if( x == 0.0 ) + return( PIFS ); + +flag = 0; + +if( x > 2.0 ) + { + x = 1.0/x; + flag |= 2; + } + +if( x > 1.5 ) + { + w = (1.0/x) - 1.0; + flag |= 2; + } + +else if( x < 0.5 ) + { + w = -x; + flag |= 1; + } + +else + w = x - 1.0; + + +y = -w * polevlf( w, A, 7) / polevlf( w, B, 7 ); + +if( flag & 1 ) + y = PIFS - logf(x) * logf(1.0-x) - y; + +if( flag & 2 ) + { + z = logf(x); + y = -0.5 * z * z - y; + } + +return( y ); +} diff --git a/libm/float/sqrtf.c b/libm/float/sqrtf.c new file mode 100644 index 000000000..bc75a907b --- /dev/null +++ b/libm/float/sqrtf.c @@ -0,0 +1,140 @@ +/* sqrtf.c + * + * Square root + * + * + * + * SYNOPSIS: + * + * float x, y, sqrtf(); + * + * y = sqrtf( x ); + * + * + * + * DESCRIPTION: + * + * Returns the square root of x. + * + * Range reduction involves isolating the power of two of the + * argument and using a polynomial approximation to obtain + * a rough value for the square root. Then Heron's iteration + * is used three times to converge to an accurate value. + * + * + * + * ACCURACY: + * + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE 0,1.e38 100000 8.7e-8 2.9e-8 + * + * + * ERROR MESSAGES: + * + * message condition value returned + * sqrtf domain x < 0 0.0 + * + */ + +/* +Cephes Math Library Release 2.2: June, 1992 +Copyright 1984, 1987, 1988, 1992 by Stephen L. Moshier +Direct inquiries to 30 Frost Street, Cambridge, MA 02140 +*/ + +/* Single precision square root + * test interval: [sqrt(2)/2, sqrt(2)] + * trials: 30000 + * peak relative error: 8.8e-8 + * rms relative error: 3.3e-8 + * + * test interval: [0.01, 100.0] + * trials: 50000 + * peak relative error: 8.7e-8 + * rms relative error: 3.3e-8 + * + * Copyright (C) 1989 by Stephen L. Moshier. All rights reserved. + */ +#include <math.h> + +#ifdef ANSIC +float frexpf( float, int * ); +float ldexpf( float, int ); + +float sqrtf( float xx ) +#else +float frexpf(), ldexpf(); + +float sqrtf(xx) +float xx; +#endif +{ +float f, x, y; +int e; + +f = xx; +if( f <= 0.0 ) + { + if( f < 0.0 ) + mtherr( "sqrtf", DOMAIN ); + return( 0.0 ); + } + +x = frexpf( f, &e ); /* f = x * 2**e, 0.5 <= x < 1.0 */ +/* If power of 2 is odd, double x and decrement the power of 2. */ +if( e & 1 ) + { + x = x + x; + e -= 1; + } + +e >>= 1; /* The power of 2 of the square root. */ + +if( x > 1.41421356237 ) + { +/* x is between sqrt(2) and 2. */ + x = x - 2.0; + y = + ((((( -9.8843065718E-4 * x + + 7.9479950957E-4) * x + - 3.5890535377E-3) * x + + 1.1028809744E-2) * x + - 4.4195203560E-2) * x + + 3.5355338194E-1) * x + + 1.41421356237E0; + goto sqdon; + } + +if( x > 0.707106781187 ) + { +/* x is between sqrt(2)/2 and sqrt(2). */ + x = x - 1.0; + y = + ((((( 1.35199291026E-2 * x + - 2.26657767832E-2) * x + + 2.78720776889E-2) * x + - 3.89582788321E-2) * x + + 6.24811144548E-2) * x + - 1.25001503933E-1) * x * x + + 0.5 * x + + 1.0; + goto sqdon; + } + +/* x is between 0.5 and sqrt(2)/2. */ +x = x - 0.5; +y = +((((( -3.9495006054E-1 * x + + 5.1743034569E-1) * x + - 4.3214437330E-1) * x + + 3.5310730460E-1) * x + - 3.5354581892E-1) * x + + 7.0710676017E-1) * x + + 7.07106781187E-1; + +sqdon: +y = ldexpf( y, e ); /* y = y * 2**e */ +return( y); +} diff --git a/libm/float/stdtrf.c b/libm/float/stdtrf.c new file mode 100644 index 000000000..76b14c1f6 --- /dev/null +++ b/libm/float/stdtrf.c @@ -0,0 +1,154 @@ +/* stdtrf.c + * + * Student's t distribution + * + * + * + * SYNOPSIS: + * + * float t, stdtrf(); + * short k; + * + * y = stdtrf( k, t ); + * + * + * DESCRIPTION: + * + * Computes the integral from minus infinity to t of the Student + * t distribution with integer k > 0 degrees of freedom: + * + * t + * - + * | | + * - | 2 -(k+1)/2 + * | ( (k+1)/2 ) | ( x ) + * ---------------------- | ( 1 + --- ) dx + * - | ( k ) + * sqrt( k pi ) | ( k/2 ) | + * | | + * - + * -inf. + * + * Relation to incomplete beta integral: + * + * 1 - stdtr(k,t) = 0.5 * incbet( k/2, 1/2, z ) + * where + * z = k/(k + t**2). + * + * For t < -1, this is the method of computation. For higher t, + * a direct method is derived from integration by parts. + * Since the function is symmetric about t=0, the area under the + * right tail of the density is found by calling the function + * with -t instead of t. + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE +/- 100 5000 2.3e-5 2.9e-6 + */ + + +/* +Cephes Math Library Release 2.2: July, 1992 +Copyright 1984, 1987, 1992 by Stephen L. Moshier +Direct inquiries to 30 Frost Street, Cambridge, MA 02140 +*/ + +#include <math.h> + +extern float PIF, MACHEPF; + +#ifdef ANSIC +float sqrtf(float), atanf(float), incbetf(float, float, float); +#else +float sqrtf(), atanf(), incbetf(); +#endif + + + +float stdtrf( int k, float tt ) +{ +float t, x, rk, z, f, tz, p, xsqk; +int j; + +t = tt; +if( k <= 0 ) + { + mtherr( "stdtrf", DOMAIN ); + return(0.0); + } + +if( t == 0 ) + return( 0.5 ); + +if( t < -1.0 ) + { + rk = k; + z = rk / (rk + t * t); + p = 0.5 * incbetf( 0.5*rk, 0.5, z ); + return( p ); + } + +/* compute integral from -t to + t */ + +if( t < 0 ) + x = -t; +else + x = t; + +rk = k; /* degrees of freedom */ +z = 1.0 + ( x * x )/rk; + +/* test if k is odd or even */ +if( (k & 1) != 0) + { + + /* computation for odd k */ + + xsqk = x/sqrtf(rk); + p = atanf( xsqk ); + if( k > 1 ) + { + f = 1.0; + tz = 1.0; + j = 3; + while( (j<=(k-2)) && ( (tz/f) > MACHEPF ) ) + { + tz *= (j-1)/( z * j ); + f += tz; + j += 2; + } + p += f * xsqk/z; + } + p *= 2.0/PIF; + } + + +else + { + + /* computation for even k */ + + f = 1.0; + tz = 1.0; + j = 2; + + while( ( j <= (k-2) ) && ( (tz/f) > MACHEPF ) ) + { + tz *= (j - 1)/( z * j ); + f += tz; + j += 2; + } + p = f * x/sqrtf(z*rk); + } + +/* common exit */ + + +if( t < 0 ) + p = -p; /* note destruction of relative accuracy */ + + p = 0.5 + 0.5 * p; +return(p); +} diff --git a/libm/float/struvef.c b/libm/float/struvef.c new file mode 100644 index 000000000..4cf8854ed --- /dev/null +++ b/libm/float/struvef.c @@ -0,0 +1,315 @@ +/* struvef.c + * + * Struve function + * + * + * + * SYNOPSIS: + * + * float v, x, y, struvef(); + * + * y = struvef( v, x ); + * + * + * + * DESCRIPTION: + * + * Computes the Struve function Hv(x) of order v, argument x. + * Negative x is rejected unless v is an integer. + * + * This module also contains the hypergeometric functions 1F2 + * and 3F0 and a routine for the Bessel function Yv(x) with + * noninteger v. + * + * + * + * ACCURACY: + * + * v varies from 0 to 10. + * Absolute error (relative error when |Hv(x)| > 1): + * arithmetic domain # trials peak rms + * IEEE -10,10 100000 9.0e-5 4.0e-6 + * + */ + + +/* +Cephes Math Library Release 2.2: July, 1992 +Copyright 1984, 1987, 1989 by Stephen L. Moshier +Direct inquiries to 30 Frost Street, Cambridge, MA 02140 +*/ + +#include <math.h> +#define DEBUG 0 + +extern float MACHEPF, MAXNUMF, PIF; + +#define fabsf(x) ( (x) < 0 ? -(x) : (x) ) + +#ifdef ANSIC +float gammaf(float), powf(float, float), sqrtf(float); +float yvf(float, float); +float floorf(float), ynf(int, float); +float jvf(float, float); +float sinf(float), cosf(float); +#else +float gammaf(), powf(), sqrtf(), yvf(); +float floorf(), ynf(), jvf(), sinf(), cosf(); +#endif + +float onef2f( float aa, float bb, float cc, float xx, float *err ) +{ +float a, b, c, x, n, a0, sum, t; +float an, bn, cn, max, z; + +a = aa; +b = bb; +c = cc; +x = xx; +an = a; +bn = b; +cn = c; +a0 = 1.0; +sum = 1.0; +n = 1.0; +t = 1.0; +max = 0.0; + +do + { + if( an == 0 ) + goto done; + if( bn == 0 ) + goto error; + if( cn == 0 ) + goto error; + if( (a0 > 1.0e34) || (n > 200) ) + goto error; + a0 *= (an * x) / (bn * cn * n); + sum += a0; + an += 1.0; + bn += 1.0; + cn += 1.0; + n += 1.0; + z = fabsf( a0 ); + if( z > max ) + max = z; + if( sum != 0 ) + t = fabsf( a0 / sum ); + else + t = z; + } +while( t > MACHEPF ); + +done: + +*err = fabsf( MACHEPF*max /sum ); + +#if DEBUG + printf(" onef2f cancellation error %.5E\n", *err ); +#endif + +goto xit; + +error: +#if DEBUG +printf("onef2f does not converge\n"); +#endif +*err = MAXNUMF; + +xit: + +#if DEBUG +printf("onef2( %.2E %.2E %.2E %.5E ) = %.3E %.6E\n", a, b, c, x, n, sum); +#endif +return(sum); +} + + + +float threef0f( float aa, float bb, float cc, float xx, float *err ) +{ +float a, b, c, x, n, a0, sum, t, conv, conv1; +float an, bn, cn, max, z; + +a = aa; +b = bb; +c = cc; +x = xx; +an = a; +bn = b; +cn = c; +a0 = 1.0; +sum = 1.0; +n = 1.0; +t = 1.0; +max = 0.0; +conv = 1.0e38; +conv1 = conv; + +do + { + if( an == 0.0 ) + goto done; + if( bn == 0.0 ) + goto done; + if( cn == 0.0 ) + goto done; + if( (a0 > 1.0e34) || (n > 200) ) + goto error; + a0 *= (an * bn * cn * x) / n; + an += 1.0; + bn += 1.0; + cn += 1.0; + n += 1.0; + z = fabsf( a0 ); + if( z > max ) + max = z; + if( z >= conv ) + { + if( (z < max) && (z > conv1) ) + goto done; + } + conv1 = conv; + conv = z; + sum += a0; + if( sum != 0 ) + t = fabsf( a0 / sum ); + else + t = z; + } +while( t > MACHEPF ); + +done: + +t = fabsf( MACHEPF*max/sum ); +#if DEBUG + printf(" threef0f cancellation error %.5E\n", t ); +#endif + +max = fabsf( conv/sum ); +if( max > t ) + t = max; +#if DEBUG + printf(" threef0f convergence %.5E\n", max ); +#endif + +goto xit; + +error: +#if DEBUG +printf("threef0f does not converge\n"); +#endif +t = MAXNUMF; + +xit: + +#if DEBUG +printf("threef0f( %.2E %.2E %.2E %.5E ) = %.3E %.6E\n", a, b, c, x, n, sum); +#endif + +*err = t; +return(sum); +} + + + + +float struvef( float vv, float xx ) +{ +float v, x, y, ya, f, g, h, t; +float onef2err, threef0err; + +v = vv; +x = xx; +f = floorf(v); +if( (v < 0) && ( v-f == 0.5 ) ) + { + y = jvf( -v, x ); + f = 1.0 - f; + g = 2.0 * floorf(0.5*f); + if( g != f ) + y = -y; + return(y); + } +t = 0.25*x*x; +f = fabsf(x); +g = 1.5 * fabsf(v); +if( (f > 30.0) && (f > g) ) + { + onef2err = MAXNUMF; + y = 0.0; + } +else + { + y = onef2f( 1.0, 1.5, 1.5+v, -t, &onef2err ); + } + +if( (f < 18.0) || (x < 0.0) ) + { + threef0err = MAXNUMF; + ya = 0.0; + } +else + { + ya = threef0f( 1.0, 0.5, 0.5-v, -1.0/t, &threef0err ); + } + +f = sqrtf( PIF ); +h = powf( 0.5*x, v-1.0 ); + +if( onef2err <= threef0err ) + { + g = gammaf( v + 1.5 ); + y = y * h * t / ( 0.5 * f * g ); + return(y); + } +else + { + g = gammaf( v + 0.5 ); + ya = ya * h / ( f * g ); + ya = ya + yvf( v, x ); + return(ya); + } +} + + + + +/* Bessel function of noninteger order + */ + +float yvf( float vv, float xx ) +{ +float v, x, y, t; +int n; + +v = vv; +x = xx; +y = floorf( v ); +if( y == v ) + { + n = v; + y = ynf( n, x ); + return( y ); + } +t = PIF * v; +y = (cosf(t) * jvf( v, x ) - jvf( -v, x ))/sinf(t); +return( y ); +} + +/* Crossover points between ascending series and asymptotic series + * for Struve function + * + * v x + * + * 0 19.2 + * 1 18.95 + * 2 19.15 + * 3 19.3 + * 5 19.7 + * 10 21.35 + * 20 26.35 + * 30 32.31 + * 40 40.0 + */ diff --git a/libm/float/tandgf.c b/libm/float/tandgf.c new file mode 100644 index 000000000..dc55ad5e4 --- /dev/null +++ b/libm/float/tandgf.c @@ -0,0 +1,206 @@ +/* tandgf.c + * + * Circular tangent of angle in degrees + * + * + * + * SYNOPSIS: + * + * float x, y, tandgf(); + * + * y = tandgf( x ); + * + * + * + * DESCRIPTION: + * + * Returns the circular tangent of the radian argument x. + * + * Range reduction is into intervals of 45 degrees. + * + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE +-2^24 50000 2.4e-7 4.8e-8 + * + * ERROR MESSAGES: + * + * message condition value returned + * tanf total loss x > 2^24 0.0 + * + */ + /* cotdgf.c + * + * Circular cotangent of angle in degrees + * + * + * + * SYNOPSIS: + * + * float x, y, cotdgf(); + * + * y = cotdgf( x ); + * + * + * + * DESCRIPTION: + * + * Range reduction is into intervals of 45 degrees. + * A common routine computes either the tangent or cotangent. + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE +-2^24 50000 2.4e-7 4.8e-8 + * + * + * ERROR MESSAGES: + * + * message condition value returned + * cot total loss x > 2^24 0.0 + * cot singularity x = 0 MAXNUMF + * + */ + +/* +Cephes Math Library Release 2.2: June, 1992 +Copyright 1984, 1987, 1989, 1992 by Stephen L. Moshier +Direct inquiries to 30 Frost Street, Cambridge, MA 02140 +*/ + +/* Single precision circular tangent + * test interval: [-pi/4, +pi/4] + * trials: 10000 + * peak relative error: 8.7e-8 + * rms relative error: 2.8e-8 + */ +#include <math.h> + +extern float MAXNUMF; + +static float T24M1 = 16777215.; +static float PI180 = 0.0174532925199432957692; /* pi/180 */ + +static float tancotf( float xx, int cotflg ) +{ +float x, y, z, zz; +long j; +int sign; + + +/* make argument positive but save the sign */ +if( xx < 0.0 ) + { + x = -xx; + sign = -1; + } +else + { + x = xx; + sign = 1; + } + +if( x > T24M1 ) + { + if( cotflg ) + mtherr( "cotdgf", TLOSS ); + else + mtherr( "tandgf", TLOSS ); + return(0.0); + } + +/* compute x mod PIO4 */ +j = 0.022222222222222222222 * x; /* integer part of x/45 */ +y = j; + +/* map zeros and singularities to origin */ +if( j & 1 ) + { + j += 1; + y += 1.0; + } + +z = x - y * 45.0; +z *= PI180; /* multiply by pi/180 to convert to radians */ + +zz = z * z; + +if( x > 1.0e-4 ) + { +/* 1.7e-8 relative error in [-pi/4, +pi/4] */ + y = + ((((( 9.38540185543E-3 * zz + + 3.11992232697E-3) * zz + + 2.44301354525E-2) * zz + + 5.34112807005E-2) * zz + + 1.33387994085E-1) * zz + + 3.33331568548E-1) * zz * z + + z; + } +else + { + y = z; + } + +if( j & 2 ) + { + if( cotflg ) + y = -y; + else + { + if( y != 0.0 ) + { + y = -1.0/y; + } + else + { + mtherr( "tandgf", SING ); + y = MAXNUMF; + } + } + } +else + { + if( cotflg ) + { + if( y != 0.0 ) + y = 1.0/y; + else + { + mtherr( "cotdgf", SING ); + y = MAXNUMF; + } + } + } + +if( sign < 0 ) + y = -y; + +return( y ); +} + + +float tandgf( float x ) +{ + +return( tancotf(x,0) ); +} + +float cotdgf( float x ) +{ + +if( x == 0.0 ) + { + mtherr( "cotdgf", SING ); + return( MAXNUMF ); + } +return( tancotf(x,1) ); +} + diff --git a/libm/float/tanf.c b/libm/float/tanf.c new file mode 100644 index 000000000..5bbf43075 --- /dev/null +++ b/libm/float/tanf.c @@ -0,0 +1,192 @@ +/* tanf.c + * + * Circular tangent + * + * + * + * SYNOPSIS: + * + * float x, y, tanf(); + * + * y = tanf( x ); + * + * + * + * DESCRIPTION: + * + * Returns the circular tangent of the radian argument x. + * + * Range reduction is modulo pi/4. A polynomial approximation + * is employed in the basic interval [0, pi/4]. + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE +-4096 100000 3.3e-7 4.5e-8 + * + * ERROR MESSAGES: + * + * message condition value returned + * tanf total loss x > 2^24 0.0 + * + */ + /* cotf.c + * + * Circular cotangent + * + * + * + * SYNOPSIS: + * + * float x, y, cotf(); + * + * y = cotf( x ); + * + * + * + * DESCRIPTION: + * + * Returns the circular cotangent of the radian argument x. + * A common routine computes either the tangent or cotangent. + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE +-4096 100000 3.0e-7 4.5e-8 + * + * + * ERROR MESSAGES: + * + * message condition value returned + * cot total loss x > 2^24 0.0 + * cot singularity x = 0 MAXNUMF + * + */ + +/* +Cephes Math Library Release 2.2: June, 1992 +Copyright 1984, 1987, 1989 by Stephen L. Moshier +Direct inquiries to 30 Frost Street, Cambridge, MA 02140 +*/ + +/* Single precision circular tangent + * test interval: [-pi/4, +pi/4] + * trials: 10000 + * peak relative error: 8.7e-8 + * rms relative error: 2.8e-8 + */ +#include <math.h> + +extern float MAXNUMF; + +static float DP1 = 0.78515625; +static float DP2 = 2.4187564849853515625e-4; +static float DP3 = 3.77489497744594108e-8; +float FOPI = 1.27323954473516; /* 4/pi */ +static float lossth = 8192.; +/*static float T24M1 = 16777215.;*/ + + +static float tancotf( float xx, int cotflg ) +{ +float x, y, z, zz; +long j; +int sign; + + +/* make argument positive but save the sign */ +if( xx < 0.0 ) + { + x = -xx; + sign = -1; + } +else + { + x = xx; + sign = 1; + } + +if( x > lossth ) + { + if( cotflg ) + mtherr( "cotf", TLOSS ); + else + mtherr( "tanf", TLOSS ); + return(0.0); + } + +/* compute x mod PIO4 */ +j = FOPI * x; /* integer part of x/(PI/4) */ +y = j; + +/* map zeros and singularities to origin */ +if( j & 1 ) + { + j += 1; + y += 1.0; + } + +z = ((x - y * DP1) - y * DP2) - y * DP3; + +zz = z * z; + +if( x > 1.0e-4 ) + { +/* 1.7e-8 relative error in [-pi/4, +pi/4] */ + y = + ((((( 9.38540185543E-3 * zz + + 3.11992232697E-3) * zz + + 2.44301354525E-2) * zz + + 5.34112807005E-2) * zz + + 1.33387994085E-1) * zz + + 3.33331568548E-1) * zz * z + + z; + } +else + { + y = z; + } + +if( j & 2 ) + { + if( cotflg ) + y = -y; + else + y = -1.0/y; + } +else + { + if( cotflg ) + y = 1.0/y; + } + +if( sign < 0 ) + y = -y; + +return( y ); +} + + +float tanf( float x ) +{ + +return( tancotf(x,0) ); +} + +float cotf( float x ) +{ + +if( x == 0.0 ) + { + mtherr( "cotf", SING ); + return( MAXNUMF ); + } +return( tancotf(x,1) ); +} + diff --git a/libm/float/tanhf.c b/libm/float/tanhf.c new file mode 100644 index 000000000..4636192c2 --- /dev/null +++ b/libm/float/tanhf.c @@ -0,0 +1,88 @@ +/* tanhf.c + * + * Hyperbolic tangent + * + * + * + * SYNOPSIS: + * + * float x, y, tanhf(); + * + * y = tanhf( x ); + * + * + * + * DESCRIPTION: + * + * Returns hyperbolic tangent of argument in the range MINLOG to + * MAXLOG. + * + * A polynomial approximation is used for |x| < 0.625. + * Otherwise, + * + * tanh(x) = sinh(x)/cosh(x) = 1 - 2/(exp(2x) + 1). + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE -2,2 100000 1.3e-7 2.6e-8 + * + */ + +/* +Cephes Math Library Release 2.2: June, 1992 +Copyright 1984, 1987, 1989, 1992 by Stephen L. Moshier +Direct inquiries to 30 Frost Street, Cambridge, MA 02140 +*/ + +/* Single precision hyperbolic tangent + * test interval: [-0.625, +0.625] + * trials: 10000 + * peak relative error: 7.2e-8 + * rms relative error: 2.6e-8 + */ +#include <math.h> + +extern float MAXLOGF; + +float expf( float ); + +float tanhf( float xx ) +{ +float x, z; + +if( xx < 0 ) + x = -xx; +else + x = xx; + +if( x > 0.5 * MAXLOGF ) + { + if( xx > 0 ) + return( 1.0 ); + else + return( -1.0 ); + } +if( x >= 0.625 ) + { + x = expf(x+x); + z = 1.0 - 2.0/(x + 1.0); + if( xx < 0 ) + z = -z; + } +else + { + z = x * x; + z = + (((( -5.70498872745E-3 * z + + 2.06390887954E-2) * z + - 5.37397155531E-2) * z + + 1.33314422036E-1) * z + - 3.33332819422E-1) * z * xx + + xx; + } +return( z ); +} diff --git a/libm/float/ynf.c b/libm/float/ynf.c new file mode 100644 index 000000000..55d984b26 --- /dev/null +++ b/libm/float/ynf.c @@ -0,0 +1,120 @@ +/* ynf.c + * + * Bessel function of second kind of integer order + * + * + * + * SYNOPSIS: + * + * float x, y, ynf(); + * int n; + * + * y = ynf( n, x ); + * + * + * + * DESCRIPTION: + * + * Returns Bessel function of order n, where n is a + * (possibly negative) integer. + * + * The function is evaluated by forward recurrence on + * n, starting with values computed by the routines + * y0() and y1(). + * + * If n = 0 or 1 the routine for y0 or y1 is called + * directly. + * + * + * + * ACCURACY: + * + * + * Absolute error, except relative when y > 1: + * + * arithmetic domain # trials peak rms + * IEEE 0, 30 10000 2.3e-6 3.4e-7 + * + * + * ERROR MESSAGES: + * + * message condition value returned + * yn singularity x = 0 MAXNUMF + * yn overflow MAXNUMF + * + * Spot checked against tables for x, n between 0 and 100. + * + */ + +/* +Cephes Math Library Release 2.2: June, 1992 +Copyright 1984, 1987, 1992 by Stephen L. Moshier +Direct inquiries to 30 Frost Street, Cambridge, MA 02140 +*/ + +#include <math.h> +extern float MAXNUMF, MAXLOGF; + +float y0f(float), y1f(float), logf(float); + +float ynf( int nn, float xx ) +{ +float x, an, anm1, anm2, r, xinv; +int k, n, sign; + +x = xx; +n = nn; +if( n < 0 ) + { + n = -n; + if( (n & 1) == 0 ) /* -1**n */ + sign = 1; + else + sign = -1; + } +else + sign = 1; + + +if( n == 0 ) + return( sign * y0f(x) ); +if( n == 1 ) + return( sign * y1f(x) ); + +/* test for overflow */ +if( x <= 0.0 ) + { + mtherr( "ynf", SING ); + return( -MAXNUMF ); + } +if( (x < 1.0) || (n > 29) ) + { + an = (float )n; + r = an * logf( an/x ); + if( r > MAXLOGF ) + { + mtherr( "ynf", OVERFLOW ); + return( -MAXNUMF ); + } + } + +/* forward recurrence on n */ + +anm2 = y0f(x); +anm1 = y1f(x); +k = 1; +r = 2 * k; +xinv = 1.0/x; +do + { + an = r * anm1 * xinv - anm2; + anm2 = anm1; + anm1 = an; + r += 2.0; + ++k; + } +while( k < n ); + + +return( sign * an ); +} diff --git a/libm/float/zetacf.c b/libm/float/zetacf.c new file mode 100644 index 000000000..da2ace6a4 --- /dev/null +++ b/libm/float/zetacf.c @@ -0,0 +1,266 @@ + /* zetacf.c + * + * Riemann zeta function + * + * + * + * SYNOPSIS: + * + * float x, y, zetacf(); + * + * y = zetacf( x ); + * + * + * + * DESCRIPTION: + * + * + * + * inf. + * - -x + * zetac(x) = > k , x > 1, + * - + * k=2 + * + * is related to the Riemann zeta function by + * + * Riemann zeta(x) = zetac(x) + 1. + * + * Extension of the function definition for x < 1 is implemented. + * Zero is returned for x > log2(MAXNUM). + * + * An overflow error may occur for large negative x, due to the + * gamma function in the reflection formula. + * + * ACCURACY: + * + * Tabulated values have full machine accuracy. + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE 1,50 30000 5.5e-7 7.5e-8 + * + * + */ + +/* +Cephes Math Library Release 2.2: July, 1992 +Copyright 1984, 1987, 1989, 1992 by Stephen L. Moshier +Direct inquiries to 30 Frost Street, Cambridge, MA 02140 +*/ + +#include <math.h> + + +/* Riemann zeta(x) - 1 + * for integer arguments between 0 and 30. + */ +static float azetacf[] = { +-1.50000000000000000000E0, + 1.70141183460469231730E38, /* infinity. */ + 6.44934066848226436472E-1, + 2.02056903159594285400E-1, + 8.23232337111381915160E-2, + 3.69277551433699263314E-2, + 1.73430619844491397145E-2, + 8.34927738192282683980E-3, + 4.07735619794433937869E-3, + 2.00839282608221441785E-3, + 9.94575127818085337146E-4, + 4.94188604119464558702E-4, + 2.46086553308048298638E-4, + 1.22713347578489146752E-4, + 6.12481350587048292585E-5, + 3.05882363070204935517E-5, + 1.52822594086518717326E-5, + 7.63719763789976227360E-6, + 3.81729326499983985646E-6, + 1.90821271655393892566E-6, + 9.53962033872796113152E-7, + 4.76932986787806463117E-7, + 2.38450502727732990004E-7, + 1.19219925965311073068E-7, + 5.96081890512594796124E-8, + 2.98035035146522801861E-8, + 1.49015548283650412347E-8, + 7.45071178983542949198E-9, + 3.72533402478845705482E-9, + 1.86265972351304900640E-9, + 9.31327432419668182872E-10 +}; + + +/* 2**x (1 - 1/x) (zeta(x) - 1) = P(1/x)/Q(1/x), 1 <= x <= 10 */ +static float P[9] = { + 5.85746514569725319540E11, + 2.57534127756102572888E11, + 4.87781159567948256438E10, + 5.15399538023885770696E9, + 3.41646073514754094281E8, + 1.60837006880656492731E7, + 5.92785467342109522998E5, + 1.51129169964938823117E4, + 2.01822444485997955865E2, +}; +static float Q[8] = { +/* 1.00000000000000000000E0,*/ + 3.90497676373371157516E11, + 5.22858235368272161797E10, + 5.64451517271280543351E9, + 3.39006746015350418834E8, + 1.79410371500126453702E7, + 5.66666825131384797029E5, + 1.60382976810944131506E4, + 1.96436237223387314144E2, +}; + +/* log(zeta(x) - 1 - 2**-x), 10 <= x <= 50 */ +static float A[11] = { + 8.70728567484590192539E6, + 1.76506865670346462757E8, + 2.60889506707483264896E10, + 5.29806374009894791647E11, + 2.26888156119238241487E13, + 3.31884402932705083599E14, + 5.13778997975868230192E15, +-1.98123688133907171455E15, +-9.92763810039983572356E16, + 7.82905376180870586444E16, + 9.26786275768927717187E16, +}; +static float B[10] = { +/* 1.00000000000000000000E0,*/ +-7.92625410563741062861E6, +-1.60529969932920229676E8, +-2.37669260975543221788E10, +-4.80319584350455169857E11, +-2.07820961754173320170E13, +-2.96075404507272223680E14, +-4.86299103694609136686E15, + 5.34589509675789930199E15, + 5.71464111092297631292E16, +-1.79915597658676556828E16, +}; + +/* (1-x) (zeta(x) - 1), 0 <= x <= 1 */ + +static float R[6] = { +-3.28717474506562731748E-1, + 1.55162528742623950834E1, +-2.48762831680821954401E2, + 1.01050368053237678329E3, + 1.26726061410235149405E4, +-1.11578094770515181334E5, +}; +static float S[5] = { +/* 1.00000000000000000000E0,*/ + 1.95107674914060531512E1, + 3.17710311750646984099E2, + 3.03835500874445748734E3, + 2.03665876435770579345E4, + 7.43853965136767874343E4, +}; + + +#define MAXL2 127 + +/* + * Riemann zeta function, minus one + */ + +extern float MACHEPF, PIO2F, MAXNUMF, PIF; + +#ifdef ANSIC +extern float sinf ( float xx ); +extern float floorf ( float x ); +extern float gammaf ( float xx ); +extern float powf ( float x, float y ); +extern float expf ( float xx ); +extern float polevlf ( float xx, float *coef, int N ); +extern float p1evlf ( float xx, float *coef, int N ); +#else +float sinf(), floorf(), gammaf(), powf(), expf(); +float polevlf(), p1evlf(); +#endif + +float zetacf(float xx) +{ +int i; +float x, a, b, s, w; + +x = xx; +if( x < 0.0 ) + { + if( x < -30.8148 ) + { + mtherr( "zetacf", OVERFLOW ); + return(0.0); + } + s = 1.0 - x; + w = zetacf( s ); + b = sinf(PIO2F*x) * powf(2.0*PIF, x) * gammaf(s) * (1.0 + w) / PIF; + return(b - 1.0); + } + +if( x >= MAXL2 ) + return(0.0); /* because first term is 2**-x */ + +/* Tabulated values for integer argument */ +w = floorf(x); +if( w == x ) + { + i = x; + if( i < 31 ) + { + return( azetacf[i] ); + } + } + + +if( x < 1.0 ) + { + w = 1.0 - x; + a = polevlf( x, R, 5 ) / ( w * p1evlf( x, S, 5 )); + return( a ); + } + +if( x == 1.0 ) + { + mtherr( "zetacf", SING ); + return( MAXNUMF ); + } + +if( x <= 10.0 ) + { + b = powf( 2.0, x ) * (x - 1.0); + w = 1.0/x; + s = (x * polevlf( w, P, 8 )) / (b * p1evlf( w, Q, 8 )); + return( s ); + } + +if( x <= 50.0 ) + { + b = powf( 2.0, -x ); + w = polevlf( x, A, 10 ) / p1evlf( x, B, 10 ); + w = expf(w) + b; + return(w); + } + + +/* Basic sum of inverse powers */ + + +s = 0.0; +a = 1.0; +do + { + a += 2.0; + b = powf( a, -x ); + s += b; + } +while( b/s > MACHEPF ); + +b = powf( 2.0, -x ); +s = (s + b)/(1.0-b); +return(s); +} diff --git a/libm/float/zetaf.c b/libm/float/zetaf.c new file mode 100644 index 000000000..d01f1d2b2 --- /dev/null +++ b/libm/float/zetaf.c @@ -0,0 +1,175 @@ +/* zetaf.c + * + * Riemann zeta function of two arguments + * + * + * + * SYNOPSIS: + * + * float x, q, y, zetaf(); + * + * y = zetaf( x, q ); + * + * + * + * DESCRIPTION: + * + * + * + * inf. + * - -x + * zeta(x,q) = > (k+q) + * - + * k=0 + * + * where x > 1 and q is not a negative integer or zero. + * The Euler-Maclaurin summation formula is used to obtain + * the expansion + * + * n + * - -x + * zeta(x,q) = > (k+q) + * - + * k=1 + * + * 1-x inf. B x(x+1)...(x+2j) + * (n+q) 1 - 2j + * + --------- - ------- + > -------------------- + * x-1 x - x+2j+1 + * 2(n+q) j=1 (2j)! (n+q) + * + * where the B2j are Bernoulli numbers. Note that (see zetac.c) + * zeta(x,1) = zetac(x) + 1. + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE 0,25 10000 6.9e-7 1.0e-7 + * + * Large arguments may produce underflow in powf(), in which + * case the results are inaccurate. + * + * REFERENCE: + * + * Gradshteyn, I. S., and I. M. Ryzhik, Tables of Integrals, + * Series, and Products, p. 1073; Academic Press, 1980. + * + */ + +/* +Cephes Math Library Release 2.2: July, 1992 +Copyright 1984, 1987, 1992 by Stephen L. Moshier +Direct inquiries to 30 Frost Street, Cambridge, MA 02140 +*/ + +#include <math.h> +extern float MAXNUMF, MACHEPF; + +/* Expansion coefficients + * for Euler-Maclaurin summation formula + * (2k)! / B2k + * where B2k are Bernoulli numbers + */ +static float A[] = { +12.0, +-720.0, +30240.0, +-1209600.0, +47900160.0, +-1.8924375803183791606e9, /*1.307674368e12/691*/ +7.47242496e10, +-2.950130727918164224e12, /*1.067062284288e16/3617*/ +1.1646782814350067249e14, /*5.109094217170944e18/43867*/ +-4.5979787224074726105e15, /*8.028576626982912e20/174611*/ +1.8152105401943546773e17, /*1.5511210043330985984e23/854513*/ +-7.1661652561756670113e18 /*1.6938241367317436694528e27/236364091*/ +}; +/* 30 Nov 86 -- error in third coefficient fixed */ + + +#define fabsf(x) ( (x) < 0 ? -(x) : (x) ) + + +float powf( float, float ); +float zetaf(float xx, float qq) +{ +int i; +float x, q, a, b, k, s, w, t; + +x = xx; +q = qq; +if( x == 1.0 ) + return( MAXNUMF ); + +if( x < 1.0 ) + { + mtherr( "zetaf", DOMAIN ); + return(0.0); + } + + +/* Euler-Maclaurin summation formula */ +/* +if( x < 25.0 ) +{ +*/ +w = 9.0; +s = powf( q, -x ); +a = q; +for( i=0; i<9; i++ ) + { + a += 1.0; + b = powf( a, -x ); + s += b; + if( b/s < MACHEPF ) + goto done; + } + +w = a; +s += b*w/(x-1.0); +s -= 0.5 * b; +a = 1.0; +k = 0.0; +for( i=0; i<12; i++ ) + { + a *= x + k; + b /= w; + t = a*b/A[i]; + s = s + t; + t = fabsf(t/s); + if( t < MACHEPF ) + goto done; + k += 1.0; + a *= x + k; + b /= w; + k += 1.0; + } +done: +return(s); +/* +} +*/ + + +/* Basic sum of inverse powers */ +/* +pseres: + +s = powf( q, -x ); +a = q; +do + { + a += 2.0; + b = powf( a, -x ); + s += b; + } +while( b/s > MACHEPF ); + +b = powf( 2.0, -x ); +s = (s + b)/(1.0-b); +return(s); +*/ +} |