summaryrefslogtreecommitdiff
path: root/libm/double
diff options
context:
space:
mode:
authorEric Andersen <andersen@codepoet.org>2001-05-10 00:40:28 +0000
committerEric Andersen <andersen@codepoet.org>2001-05-10 00:40:28 +0000
commit1077fa4d772832f77a677ce7fb7c2d513b959e3f (patch)
tree579bee13fb0b58d2800206366ec2caecbb15f3fc /libm/double
parent22358dd7ce7bb49792204b698f01a6f69b9c8e08 (diff)
uClibc now has a math library. muahahahaha!
-Erik
Diffstat (limited to 'libm/double')
-rw-r--r--libm/double/Makefile115
-rw-r--r--libm/double/README.txt5845
-rw-r--r--libm/double/acosh.c167
-rw-r--r--libm/double/airy.c965
-rw-r--r--libm/double/arcdot.c110
-rw-r--r--libm/double/asin.c324
-rw-r--r--libm/double/asinh.c165
-rw-r--r--libm/double/atan.c393
-rw-r--r--libm/double/atanh.c156
-rw-r--r--libm/double/bdtr.c263
-rw-r--r--libm/double/bernum.c74
-rw-r--r--libm/double/beta.c201
-rw-r--r--libm/double/btdtr.c64
-rw-r--r--libm/double/cbrt.c142
-rw-r--r--libm/double/chbevl.c82
-rw-r--r--libm/double/chdtr.c200
-rw-r--r--libm/double/cheby.c149
-rw-r--r--libm/double/clog.c1043
-rw-r--r--libm/double/cmplx.c461
-rw-r--r--libm/double/coil.c63
-rw-r--r--libm/double/const.c252
-rw-r--r--libm/double/cosh.c83
-rw-r--r--libm/double/cpmul.c104
-rw-r--r--libm/double/dawsn.c392
-rw-r--r--libm/double/dcalc.c1512
-rw-r--r--libm/double/dcalc.h77
-rw-r--r--libm/double/dtestvec.c543
-rw-r--r--libm/double/ei.c1062
-rw-r--r--libm/double/eigens.c181
-rw-r--r--libm/double/ellie.c148
-rw-r--r--libm/double/ellik.c148
-rw-r--r--libm/double/ellpe.c195
-rw-r--r--libm/double/ellpj.c171
-rw-r--r--libm/double/ellpk.c234
-rw-r--r--libm/double/eltst.c37
-rw-r--r--libm/double/euclid.c251
-rw-r--r--libm/double/exp.c203
-rw-r--r--libm/double/exp10.c223
-rw-r--r--libm/double/exp2.c183
-rw-r--r--libm/double/expn.c208
-rw-r--r--libm/double/fabs.c56
-rw-r--r--libm/double/fac.c263
-rw-r--r--libm/double/fdtr.c237
-rw-r--r--libm/double/fftr.c237
-rw-r--r--libm/double/floor.c453
-rw-r--r--libm/double/fltest.c272
-rw-r--r--libm/double/fltest2.c18
-rw-r--r--libm/double/fltest3.c259
-rw-r--r--libm/double/fresnl.c515
-rw-r--r--libm/double/gamma.c685
-rw-r--r--libm/double/gdtr.c130
-rw-r--r--libm/double/gels.c232
-rw-r--r--libm/double/hyp2f1.c460
-rw-r--r--libm/double/hyperg.c386
-rw-r--r--libm/double/i0.c397
-rw-r--r--libm/double/i1.c402
-rw-r--r--libm/double/igam.c210
-rw-r--r--libm/double/igami.c187
-rw-r--r--libm/double/incbet.c409
-rw-r--r--libm/double/incbi.c313
-rw-r--r--libm/double/isnan.c237
-rw-r--r--libm/double/iv.c116
-rw-r--r--libm/double/j0.c543
-rw-r--r--libm/double/j1.c515
-rw-r--r--libm/double/jn.c133
-rw-r--r--libm/double/jv.c884
-rw-r--r--libm/double/k0.c333
-rw-r--r--libm/double/k1.c335
-rw-r--r--libm/double/kn.c255
-rw-r--r--libm/double/kolmogorov.c243
-rw-r--r--libm/double/levnsn.c82
-rw-r--r--libm/double/log.c341
-rw-r--r--libm/double/log10.c250
-rw-r--r--libm/double/log2.c348
-rw-r--r--libm/double/lrand.c86
-rw-r--r--libm/double/lsqrt.c85
-rw-r--r--libm/double/ltstd.c469
-rw-r--r--libm/double/minv.c61
-rw-r--r--libm/double/mod2pi.c122
-rw-r--r--libm/double/monot.c308
-rw-r--r--libm/double/mtherr.c102
-rw-r--r--libm/double/mtransp.c61
-rw-r--r--libm/double/mtst.c464
-rw-r--r--libm/double/nbdtr.c222
-rw-r--r--libm/double/ndtr.c481
-rw-r--r--libm/double/ndtri.c417
-rw-r--r--libm/double/paranoia.c2156
-rw-r--r--libm/double/pdtr.c184
-rw-r--r--libm/double/planck.c223
-rw-r--r--libm/double/polevl.c97
-rw-r--r--libm/double/polmisc.c309
-rw-r--r--libm/double/polrt.c227
-rw-r--r--libm/double/polylog.c467
-rw-r--r--libm/double/polyn.c471
-rw-r--r--libm/double/polyr.c533
-rw-r--r--libm/double/pow.c756
-rw-r--r--libm/double/powi.c186
-rw-r--r--libm/double/psi.c201
-rw-r--r--libm/double/revers.c156
-rw-r--r--libm/double/rgamma.c209
-rw-r--r--libm/double/round.c70
-rw-r--r--libm/double/setprec.c10
-rw-r--r--libm/double/shichi.c599
-rw-r--r--libm/double/sici.c675
-rw-r--r--libm/double/simpsn.c81
-rw-r--r--libm/double/simq.c180
-rw-r--r--libm/double/sin.c387
-rw-r--r--libm/double/sincos.c364
-rw-r--r--libm/double/sindg.c308
-rw-r--r--libm/double/sinh.c148
-rw-r--r--libm/double/spence.c205
-rw-r--r--libm/double/sqrt.c178
-rw-r--r--libm/double/stdtr.c225
-rw-r--r--libm/double/struve.c312
-rw-r--r--libm/double/tan.c304
-rw-r--r--libm/double/tandg.c267
-rw-r--r--libm/double/tanh.c141
-rw-r--r--libm/double/time-it.c38
-rw-r--r--libm/double/unity.c138
-rw-r--r--libm/double/yn.c114
-rw-r--r--libm/double/zeta.c189
-rw-r--r--libm/double/zetac.c599
122 files changed, 42510 insertions, 0 deletions
diff --git a/libm/double/Makefile b/libm/double/Makefile
new file mode 100644
index 000000000..be3c5878a
--- /dev/null
+++ b/libm/double/Makefile
@@ -0,0 +1,115 @@
+# 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=acosh.c airy.c asin.c asinh.c atan.c atanh.c bdtr.c beta.c \
+ btdtr.c cbrt.c chbevl.c chdtr.c clog.c cmplx.c const.c \
+ cosh.c dawsn.c ei.c ellie.c ellik.c ellpe.c ellpj.c ellpk.c \
+ exp.c exp10.c exp2.c expn.c fabs.c fac.c fdtr.c \
+ fresnl.c gamma.c gdtr.c hyp2f1.c hyperg.c i0.c i1.c igami.c incbet.c \
+ incbi.c igam.c isnan.c iv.c j0.c j1.c jn.c jv.c k0.c k1.c kn.c kolmogorov.c \
+ log.c log2.c log10.c lrand.c nbdtr.c ndtr.c ndtri.c pdtr.c planck.c \
+ polevl.c polmisc.c polylog.c polyn.c pow.c powi.c psi.c rgamma.c round.c \
+ shichi.c sici.c sin.c sindg.c sinh.c spence.c stdtr.c struve.c \
+ tan.c tandg.c tanh.c unity.c yn.c zeta.c zetac.c \
+ sqrt.c floor.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
+
+
+
+#-----------------------------------------
+
+#all: libmd.a mtst dtestvec monot dcalc paranoia
+
+time-it: time-it.o
+ $(CC) -o time-it time-it.o
+
+time-it.o: time-it.c
+ $(CC) -O2 -c time-it.c
+
+dcalc: dcalc.o libmd.a
+ $(CC) -o dcalc dcalc.o libmd.a
+
+mtst: mtst.o libmd.a
+ $(CC) -v -o mtst mtst.o libmd.a
+
+mtst.o: mtst.c
+ $(CC) -O2 -Wall -c mtst.c
+
+dtestvec: dtestvec.o libmd.a
+ $(CC) -o dtestvec dtestvec.o libmd.a
+
+dtestvec.o: dtestvec.c
+ $(CC) -g -c dtestvec.c
+
+monot: monot.o libmd.a
+ $(CC) -o monot monot.o libmd.a
+
+monot.o: monot.c
+ $(CC) -g -c monot.c
+
+paranoia: paranoia.o setprec.o libmd.a
+ $(CC) -o paranoia paranoia.o setprec.o libmd.a
+
+paranoia.o: paranoia.c
+ $(CC) $(CFLAGS) -Wno-implicit -c paranoia.c
+
+libmd.a: $(OBJS) $(INCS)
+ $(AR) rv libmd.a $(OBJS)
+
+#clean:
+# rm -f *.o
+# rm -f mtst
+# rm -f paranoia
+# rm -f dcalc
+# rm -f dtestvec
+# rm -f monot
+# rm -f libmd.a
+# rm -f time-it
+# rm -f dtestvec
+
+
diff --git a/libm/double/README.txt b/libm/double/README.txt
new file mode 100644
index 000000000..f2cb6c3dc
--- /dev/null
+++ b/libm/double/README.txt
@@ -0,0 +1,5845 @@
+/* acosh.c
+ *
+ * Inverse hyperbolic cosine
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, acosh();
+ *
+ * y = acosh( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns inverse hyperbolic cosine of argument.
+ *
+ * If 1 <= x < 1.5, a rational approximation
+ *
+ * sqrt(z) * P(z)/Q(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
+ * DEC 1,3 30000 4.2e-17 1.1e-17
+ * IEEE 1,3 30000 4.6e-16 8.7e-17
+ *
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * acosh domain |x| < 1 NAN
+ *
+ */
+
+/* airy.c
+ *
+ * Airy function
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, ai, aip, bi, bip;
+ * int airy();
+ *
+ * airy( 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 10000 1.6e-15 2.7e-16
+ * IEEE 0, 10 Ai 10000 2.3e-14* 1.8e-15*
+ * IEEE -10, 0 Ai' 10000 4.6e-15 7.6e-16
+ * IEEE 0, 10 Ai' 10000 1.8e-14* 1.5e-15*
+ * IEEE -10, 10 Bi 30000 4.2e-15 5.3e-16
+ * IEEE -10, 10 Bi' 30000 4.9e-15 7.3e-16
+ * DEC -10, 0 Ai 5000 1.7e-16 2.8e-17
+ * DEC 0, 10 Ai 5000 2.1e-15* 1.7e-16*
+ * DEC -10, 0 Ai' 5000 4.7e-16 7.8e-17
+ * DEC 0, 10 Ai' 12000 1.8e-15* 1.5e-16*
+ * DEC -10, 10 Bi 10000 5.5e-16 6.8e-17
+ * DEC -10, 10 Bi' 7000 5.3e-16 8.7e-17
+ *
+ */
+
+/* asin.c
+ *
+ * Inverse circular sine
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, asin();
+ *
+ * y = asin( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns radian angle between -pi/2 and +pi/2 whose sine is x.
+ *
+ * A rational function of the form x + x**3 P(x**2)/Q(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
+ * DEC -1, 1 40000 2.6e-17 7.1e-18
+ * IEEE -1, 1 10^6 1.9e-16 5.4e-17
+ *
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * asin domain |x| > 1 NAN
+ *
+ */
+ /* acos()
+ *
+ * Inverse circular cosine
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, acos();
+ *
+ * y = acos( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns radian angle between 0 and pi 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
+ * DEC -1, 1 50000 3.3e-17 8.2e-18
+ * IEEE -1, 1 10^6 2.2e-16 6.5e-17
+ *
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * asin domain |x| > 1 NAN
+ */
+
+/* asinh.c
+ *
+ * Inverse hyperbolic sine
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, asinh();
+ *
+ * y = asinh( 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
+ * DEC -3,3 75000 4.6e-17 1.1e-17
+ * IEEE -1,1 30000 3.7e-16 7.8e-17
+ * IEEE 1,3 30000 2.5e-16 6.7e-17
+ *
+ */
+
+/* atan.c
+ *
+ * Inverse circular tangent
+ * (arctangent)
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, atan();
+ *
+ * y = atan( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns radian angle between -pi/2 and +pi/2 whose tangent
+ * is x.
+ *
+ * Range reduction is from three intervals into the interval
+ * from zero to 0.66. The approximant uses a rational
+ * function of degree 4/5 of the form x + x**3 P(x)/Q(x).
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * DEC -10, 10 50000 2.4e-17 8.3e-18
+ * IEEE -10, 10 10^6 1.8e-16 5.0e-17
+ *
+ */
+ /* atan2()
+ *
+ * Quadrant correct inverse circular tangent
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, z, atan2();
+ *
+ * z = atan2( 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 10^6 2.5e-16 6.9e-17
+ * See atan.c.
+ *
+ */
+
+/* atanh.c
+ *
+ * Inverse hyperbolic tangent
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, atanh();
+ *
+ * y = atanh( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns inverse hyperbolic tangent of argument in the range
+ * MINLOG to MAXLOG.
+ *
+ * If |x| < 0.5, the rational form x + x**3 P(x)/Q(x) is
+ * employed. Otherwise,
+ * atanh(x) = 0.5 * log( (1+x)/(1-x) ).
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * DEC -1,1 50000 2.4e-17 6.4e-18
+ * IEEE -1,1 30000 1.9e-16 5.2e-17
+ *
+ */
+
+/* bdtr.c
+ *
+ * Binomial distribution
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * int k, n;
+ * double p, y, bdtr();
+ *
+ * y = bdtr( 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:
+ *
+ * Tested at random points (a,b,p), with p between 0 and 1.
+ *
+ * a,b Relative error:
+ * arithmetic domain # trials peak rms
+ * For p between 0.001 and 1:
+ * IEEE 0,100 100000 4.3e-15 2.6e-16
+ * See also incbet.c.
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * bdtr domain k < 0 0.0
+ * n < k
+ * x < 0, x > 1
+ */
+ /* bdtrc()
+ *
+ * Complemented binomial distribution
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * int k, n;
+ * double p, y, bdtrc();
+ *
+ * y = bdtrc( 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:
+ *
+ * Tested at random points (a,b,p).
+ *
+ * a,b Relative error:
+ * arithmetic domain # trials peak rms
+ * For p between 0.001 and 1:
+ * IEEE 0,100 100000 6.7e-15 8.2e-16
+ * For p between 0 and .001:
+ * IEEE 0,100 100000 1.5e-13 2.7e-15
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * bdtrc domain x<0, x>1, n<k 0.0
+ */
+ /* bdtri()
+ *
+ * Inverse binomial distribution
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * int k, n;
+ * double p, y, bdtri();
+ *
+ * p = bdtr( 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:
+ *
+ * Tested at random points (a,b,p).
+ *
+ * a,b Relative error:
+ * arithmetic domain # trials peak rms
+ * For p between 0.001 and 1:
+ * IEEE 0,100 100000 2.3e-14 6.4e-16
+ * IEEE 0,10000 100000 6.6e-12 1.2e-13
+ * For p between 10^-6 and 0.001:
+ * IEEE 0,100 100000 2.0e-12 1.3e-14
+ * IEEE 0,10000 100000 1.5e-12 3.2e-14
+ * See also incbi.c.
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * bdtri domain k < 0, n <= k 0.0
+ * x < 0, x > 1
+ */
+
+/* beta.c
+ *
+ * Beta function
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double a, b, y, beta();
+ *
+ * y = beta( 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
+ * DEC 0,30 1700 7.7e-15 1.5e-15
+ * IEEE 0,30 30000 8.1e-14 1.1e-14
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * beta overflow log(beta) > MAXLOG 0.0
+ * a or b <0 integer 0.0
+ *
+ */
+
+/* btdtr.c
+ *
+ * Beta distribution
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double a, b, x, y, btdtr();
+ *
+ * y = btdtr( a, b, x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns the area from zero to x under the beta density
+ * function:
+ *
+ *
+ * x
+ * - -
+ * | (a+b) | | a-1 b-1
+ * P(x) = ---------- | t (1-t) dt
+ * - - | |
+ * | (a) | (b) -
+ * 0
+ *
+ *
+ * This function is identical to the incomplete beta
+ * integral function incbet(a, b, x).
+ *
+ * The complemented function is
+ *
+ * 1 - P(1-x) = incbet( b, a, x );
+ *
+ *
+ * ACCURACY:
+ *
+ * See incbet.c.
+ *
+ */
+
+/* cbrt.c
+ *
+ * Cube root
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, cbrt();
+ *
+ * y = cbrt( 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 three times to converge to an accurate
+ * result.
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * DEC -10,10 200000 1.8e-17 6.2e-18
+ * IEEE 0,1e308 30000 1.5e-16 5.0e-17
+ *
+ */
+
+/* chbevl.c
+ *
+ * Evaluate Chebyshev series
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * int N;
+ * double x, y, coef[N], chebevl();
+ *
+ * y = chbevl( 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.
+ *
+ */
+
+/* chdtr.c
+ *
+ * Chi-square distribution
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double df, x, y, chdtr();
+ *
+ * y = chdtr( 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:
+ *
+ * See igam().
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * chdtr domain x < 0 or v < 1 0.0
+ */
+ /* chdtrc()
+ *
+ * Complemented Chi-square distribution
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double v, x, y, chdtrc();
+ *
+ * y = chdtrc( 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:
+ *
+ * See igamc().
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * chdtrc domain x < 0 or v < 1 0.0
+ */
+ /* chdtri()
+ *
+ * Inverse of complemented Chi-square distribution
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double df, x, y, chdtri();
+ *
+ * x = chdtri( 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:
+ *
+ * See igami.c.
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * chdtri domain y < 0 or y > 1 0.0
+ * v < 1
+ *
+ */
+
+/* clog.c
+ *
+ * Complex natural logarithm
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * void clog();
+ * cmplx z, w;
+ *
+ * clog( &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
+ * DEC -10,+10 7000 8.5e-17 1.9e-17
+ * IEEE -10,+10 30000 5.0e-15 1.1e-16
+ *
+ * Larger relative error can be observed for z near 1 +i0.
+ * In IEEE arithmetic the peak absolute error is 5.2e-16, rms
+ * absolute error 1.0e-16.
+ */
+
+/* cexp()
+ *
+ * Complex exponential function
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * void cexp();
+ * cmplx z, w;
+ *
+ * cexp( &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
+ * DEC -10,+10 8700 3.7e-17 1.1e-17
+ * IEEE -10,+10 30000 3.0e-16 8.7e-17
+ *
+ */
+ /* csin()
+ *
+ * Complex circular sine
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * void csin();
+ * cmplx z, w;
+ *
+ * csin( &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
+ * DEC -10,+10 8400 5.3e-17 1.3e-17
+ * IEEE -10,+10 30000 3.8e-16 1.0e-16
+ * Also tested by csin(casin(z)) = z.
+ *
+ */
+ /* ccos()
+ *
+ * Complex circular cosine
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * void ccos();
+ * cmplx z, w;
+ *
+ * ccos( &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
+ * DEC -10,+10 8400 4.5e-17 1.3e-17
+ * IEEE -10,+10 30000 3.8e-16 1.0e-16
+ */
+ /* ctan()
+ *
+ * Complex circular tangent
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * void ctan();
+ * cmplx z, w;
+ *
+ * ctan( &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
+ * DEC -10,+10 5200 7.1e-17 1.6e-17
+ * IEEE -10,+10 30000 7.2e-16 1.2e-16
+ * Also tested by ctan * ccot = 1 and catan(ctan(z)) = z.
+ */
+ /* ccot()
+ *
+ * Complex circular cotangent
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * void ccot();
+ * cmplx z, w;
+ *
+ * ccot( &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
+ * DEC -10,+10 3000 6.5e-17 1.6e-17
+ * IEEE -10,+10 30000 9.2e-16 1.2e-16
+ * Also tested by ctan * ccot = 1 + i0.
+ */
+ /* casin()
+ *
+ * Complex circular arc sine
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * void casin();
+ * cmplx z, w;
+ *
+ * casin( &z, &w );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Inverse complex sine:
+ *
+ * 2
+ * w = -i clog( iz + csqrt( 1 - z ) ).
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * DEC -10,+10 10100 2.1e-15 3.4e-16
+ * IEEE -10,+10 30000 2.2e-14 2.7e-15
+ * Larger relative error can be observed for z near zero.
+ * Also tested by csin(casin(z)) = z.
+ */
+
+ /* cacos()
+ *
+ * Complex circular arc cosine
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * void cacos();
+ * cmplx z, w;
+ *
+ * cacos( &z, &w );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ *
+ * w = arccos z = PI/2 - arcsin z.
+ *
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * DEC -10,+10 5200 1.6e-15 2.8e-16
+ * IEEE -10,+10 30000 1.8e-14 2.2e-15
+ */
+ /* catan()
+ *
+ * Complex circular arc tangent
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * void catan();
+ * cmplx 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
+ * DEC -10,+10 5900 1.3e-16 7.8e-18
+ * IEEE -10,+10 30000 2.3e-15 8.5e-17
+ * The check catan( ctan(z) ) = z, with |x| and |y| < PI/2,
+ * had peak relative error 1.5e-16, rms relative error
+ * 2.9e-17. See also clog().
+ */
+
+/* cmplx.c
+ *
+ * Complex number arithmetic
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * typedef struct {
+ * double r; real part
+ * double i; imaginary part
+ * }cmplx;
+ *
+ * cmplx *a, *b, *c;
+ *
+ * cadd( a, b, c ); c = b + a
+ * csub( a, b, c ); c = b - a
+ * cmul( a, b, c ); c = b * a
+ * cdiv( a, b, c ); c = b / a
+ * cneg( c ); c = -c
+ * cmov( 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
+ * DEC cadd 10000 1.4e-17 3.4e-18
+ * IEEE cadd 100000 1.1e-16 2.7e-17
+ * DEC csub 10000 1.4e-17 4.5e-18
+ * IEEE csub 100000 1.1e-16 3.4e-17
+ * DEC cmul 3000 2.3e-17 8.7e-18
+ * IEEE cmul 100000 2.1e-16 6.9e-17
+ * DEC cdiv 18000 4.9e-17 1.3e-17
+ * IEEE cdiv 100000 3.7e-16 1.1e-16
+ */
+
+/* cabs()
+ *
+ * Complex absolute value
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double cabs();
+ * cmplx z;
+ * double a;
+ *
+ * a = cabs( &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
+ * DEC -30,+30 30000 3.2e-17 9.2e-18
+ * IEEE -10,+10 100000 2.7e-16 6.9e-17
+ */
+ /* csqrt()
+ *
+ * Complex square root
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * void csqrt();
+ * cmplx z, w;
+ *
+ * csqrt( &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 root chosen
+ * 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
+ * DEC -10,+10 25000 3.2e-17 9.6e-18
+ * IEEE -10,+10 100000 3.2e-16 7.7e-17
+ *
+ * 2
+ * Also tested by csqrt( z ) = z, and tested by arguments
+ * close to the real axis.
+ */
+
+/* const.c
+ *
+ * Globally declared constants
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * extern double nameofconstant;
+ *
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * This file contains a number of mathematical constants and
+ * also some needed size parameters of the computer arithmetic.
+ * The values are supplied as arrays of hexadecimal integers
+ * for IEEE arithmetic; arrays of octal constants for DEC
+ * arithmetic; and in a normal decimal scientific notation for
+ * other machines. The particular notation used is determined
+ * by a symbol (DEC, IBMPC, or UNK) defined in the include file
+ * math.h.
+ *
+ * The default size parameters are as follows.
+ *
+ * For DEC and UNK modes:
+ * MACHEP = 1.38777878078144567553E-17 2**-56
+ * MAXLOG = 8.8029691931113054295988E1 log(2**127)
+ * MINLOG = -8.872283911167299960540E1 log(2**-128)
+ * MAXNUM = 1.701411834604692317316873e38 2**127
+ *
+ * For IEEE arithmetic (IBMPC):
+ * MACHEP = 1.11022302462515654042E-16 2**-53
+ * MAXLOG = 7.09782712893383996843E2 log(2**1024)
+ * MINLOG = -7.08396418532264106224E2 log(2**-1022)
+ * MAXNUM = 1.7976931348623158E308 2**1024
+ *
+ * The global symbols for mathematical constants are
+ * PI = 3.14159265358979323846 pi
+ * PIO2 = 1.57079632679489661923 pi/2
+ * PIO4 = 7.85398163397448309616E-1 pi/4
+ * SQRT2 = 1.41421356237309504880 sqrt(2)
+ * SQRTH = 7.07106781186547524401E-1 sqrt(2)/2
+ * LOG2E = 1.4426950408889634073599 1/log(2)
+ * SQ2OPI = 7.9788456080286535587989E-1 sqrt( 2/pi )
+ * LOGE2 = 6.93147180559945309417E-1 log(2)
+ * LOGSQ2 = 3.46573590279972654709E-1 log(2)/2
+ * THPIO4 = 2.35619449019234492885 3*pi/4
+ * TWOOPI = 6.36619772367581343075535E-1 2/pi
+ *
+ * These lists are subject to change.
+ */
+
+/* cosh.c
+ *
+ * Hyperbolic cosine
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, cosh();
+ *
+ * y = cosh( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns hyperbolic cosine of argument in the range MINLOG to
+ * MAXLOG.
+ *
+ * cosh(x) = ( exp(x) + exp(-x) )/2.
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * DEC +- 88 50000 4.0e-17 7.7e-18
+ * IEEE +-MAXLOG 30000 2.6e-16 5.7e-17
+ *
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * cosh overflow |x| > MAXLOG MAXNUM
+ *
+ *
+ */
+
+/* cpmul.c
+ *
+ * Multiply two polynomials with complex coefficients
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * typedef struct
+ * {
+ * double r;
+ * double i;
+ * }cmplx;
+ *
+ * cmplx a[], b[], c[];
+ * int da, db, dc;
+ *
+ * cpmul( a, da, b, db, c, &dc );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * The two argument polynomials are multiplied together, and
+ * their product is placed in c.
+ *
+ * Each polynomial is represented by its coefficients stored
+ * as an array of complex number structures (see the typedef).
+ * The degree of a is da, which must be passed to the routine
+ * as an argument; similarly the degree db of b is an argument.
+ * Array a has da + 1 elements and array b has db + 1 elements.
+ * Array c must have storage allocated for at least da + db + 1
+ * elements. The value da + db is returned in dc; this is
+ * the degree of the product polynomial.
+ *
+ * Polynomial coefficients are stored in ascending order; i.e.,
+ * a(x) = a[0]*x**0 + a[1]*x**1 + ... + a[da]*x**da.
+ *
+ *
+ * If desired, c may be the same as either a or b, in which
+ * case the input argument array is replaced by the product
+ * array (but only up to terms of degree da + db).
+ *
+ */
+
+/* dawsn.c
+ *
+ * Dawson's Integral
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, dawsn();
+ *
+ * y = dawsn( 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 10000 6.9e-16 1.0e-16
+ * DEC 0,10 6000 7.4e-17 1.4e-17
+ *
+ *
+ */
+
+/* drand.c
+ *
+ * Pseudorandom number generator
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double y, drand();
+ *
+ * drand( &y );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Yields a random number 1.0 <= y < 2.0.
+ *
+ * The three-generator congruential algorithm by Brian
+ * Wichmann and David Hill (BYTE magazine, March, 1987,
+ * pp 127-8) is used. The period, given by them, is
+ * 6953607871644.
+ *
+ * Versions invoked by the different arithmetic compile
+ * time options DEC, IBMPC, and MIEEE, produce
+ * approximately the same sequences, differing only in the
+ * least significant bits of the numbers. The UNK option
+ * implements the algorithm as recommended in the BYTE
+ * article. It may be used on all computers. However,
+ * the low order bits of a double precision number may
+ * not be adequately random, and may vary due to arithmetic
+ * implementation details on different computers.
+ *
+ * The other compile options generate an additional random
+ * integer that overwrites the low order bits of the double
+ * precision number. This reduces the period by a factor of
+ * two but tends to overcome the problems mentioned.
+ *
+ */
+
+/* eigens.c
+ *
+ * Eigenvalues and eigenvectors of a real symmetric matrix
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * int n;
+ * double A[n*(n+1)/2], EV[n*n], E[n];
+ * void eigens( A, EV, E, n );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * The algorithm is due to J. vonNeumann.
+ *
+ * A[] is a symmetric matrix stored in lower triangular form.
+ * That is, A[ row, column ] = A[ (row*row+row)/2 + column ]
+ * or equivalently with row and column interchanged. The
+ * indices row and column run from 0 through n-1.
+ *
+ * EV[] is the output matrix of eigenvectors stored columnwise.
+ * That is, the elements of each eigenvector appear in sequential
+ * memory order. The jth element of the ith eigenvector is
+ * EV[ n*i+j ] = EV[i][j].
+ *
+ * E[] is the output matrix of eigenvalues. The ith element
+ * of E corresponds to the ith eigenvector (the ith row of EV).
+ *
+ * On output, the matrix A will have been diagonalized and its
+ * orginal contents are destroyed.
+ *
+ * ACCURACY:
+ *
+ * The error is controlled by an internal parameter called RANGE
+ * which is set to 1e-10. After diagonalization, the
+ * off-diagonal elements of A will have been reduced by
+ * this factor.
+ *
+ * ERROR MESSAGES:
+ *
+ * None.
+ *
+ */
+
+/* ellie.c
+ *
+ * Incomplete elliptic integral of the second kind
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double phi, m, y, ellie();
+ *
+ * y = ellie( 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 [-10, 10] and m in
+ * [0, 1].
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * DEC 0,2 2000 1.9e-16 3.4e-17
+ * IEEE -10,10 150000 3.3e-15 1.4e-16
+ *
+ *
+ */
+
+/* ellik.c
+ *
+ * Incomplete elliptic integral of the first kind
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double phi, m, y, ellik();
+ *
+ * y = ellik( 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 m in [0, 1] and phi as indicated.
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE -10,10 200000 7.4e-16 1.0e-16
+ *
+ *
+ */
+
+/* ellpe.c
+ *
+ * Complete elliptic integral of the second kind
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double m1, y, ellpe();
+ *
+ * y = ellpe( 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
+ * DEC 0, 1 13000 3.1e-17 9.4e-18
+ * IEEE 0, 1 10000 2.1e-16 7.3e-17
+ *
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * ellpe domain x<0, x>1 0.0
+ *
+ */
+
+/* ellpj.c
+ *
+ * Jacobian Elliptic Functions
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double 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
+ * DEC sn 1800 4.5e-16 8.7e-17
+ * IEEE phi 10000 9.2e-16* 1.4e-16*
+ * IEEE sn 50000 4.1e-15 4.6e-16
+ * IEEE cn 40000 3.6e-15 4.4e-16
+ * IEEE dn 10000 1.3e-12 1.8e-14
+ *
+ * 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.
+ *
+ */
+
+/* ellpk.c
+ *
+ * Complete elliptic integral of the first kind
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double m1, y, ellpk();
+ *
+ * y = ellpk( 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
+ * DEC 0,1 16000 3.5e-17 1.1e-17
+ * IEEE 0,1 30000 2.5e-16 6.8e-17
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * ellpk domain x<0, x>1 0.0
+ *
+ */
+
+/* euclid.c
+ *
+ * Rational arithmetic routines
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ *
+ * typedef struct
+ * {
+ * double n; numerator
+ * double d; denominator
+ * }fract;
+ *
+ * radd( a, b, c ) c = b + a
+ * rsub( a, b, c ) c = b - a
+ * rmul( a, b, c ) c = b * a
+ * rdiv( a, b, c ) c = b / a
+ * euclid( &n, &d ) Reduce n/d to lowest terms,
+ * return greatest common divisor.
+ *
+ * Arguments of the routines are pointers to the structures.
+ * The double precision numbers are assumed, without checking,
+ * to be integer valued. Overflow conditions are reported.
+ */
+
+/* exp.c
+ *
+ * Exponential function
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, exp();
+ *
+ * y = exp( 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 Pade' form 1 + 2x P(x**2)/( Q(x**2) - P(x**2) )
+ * of degree 2/3 is used to approximate exp(f) in the basic
+ * interval [-0.5, 0.5].
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * DEC +- 88 50000 2.8e-17 7.0e-18
+ * IEEE +- 708 40000 2.0e-16 5.6e-17
+ *
+ *
+ * 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
+ * exp underflow x < MINLOG 0.0
+ * exp overflow x > MAXLOG INFINITY
+ *
+ */
+
+/* exp10.c
+ *
+ * Base 10 exponential function
+ * (Common antilogarithm)
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, exp10();
+ *
+ * y = exp10( 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).
+ * The Pade' form
+ *
+ * 1 + 2x P(x**2)/( Q(x**2) - P(x**2) )
+ *
+ * is used to approximate 10**f.
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE -307,+307 30000 2.2e-16 5.5e-17
+ * Test result from an earlier version (2.1):
+ * DEC -38,+38 70000 3.1e-17 7.0e-18
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * exp10 underflow x < -MAXL10 0.0
+ * exp10 overflow x > MAXL10 MAXNUM
+ *
+ * DEC arithmetic: MAXL10 = 38.230809449325611792.
+ * IEEE arithmetic: MAXL10 = 308.2547155599167.
+ *
+ */
+
+/* exp2.c
+ *
+ * Base 2 exponential function
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, exp2();
+ *
+ * y = exp2( 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 Pade' form
+ *
+ * 1 + 2x P(x**2) / (Q(x**2) - x P(x**2) )
+ *
+ * approximates 2**x in the basic range [-0.5, 0.5].
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE -1022,+1024 30000 1.8e-16 5.4e-17
+ *
+ *
+ * See exp.c for comments on error amplification.
+ *
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * exp underflow x < -MAXL2 0.0
+ * exp overflow x > MAXL2 MAXNUM
+ *
+ * For DEC arithmetic, MAXL2 = 127.
+ * For IEEE arithmetic, MAXL2 = 1024.
+ */
+
+/* expn.c
+ *
+ * Exponential integral En
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * int n;
+ * double x, y, expn();
+ *
+ * y = expn( 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
+ * DEC 0, 30 5000 2.0e-16 4.6e-17
+ * IEEE 0, 30 10000 1.7e-15 3.6e-16
+ *
+ */
+
+/* fabs.c
+ *
+ * Absolute value
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y;
+ *
+ * y = fabs( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns the absolute value of the argument.
+ *
+ */
+
+/* fac.c
+ *
+ * Factorial function
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double y, fac();
+ * int i;
+ *
+ * y = fac( 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 DEC arithmetic or 170 in IEEE
+ * 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. If i > 55, fac(i) = gamma(i+1);
+ * see gamma.c.
+ *
+ * Relative error:
+ * arithmetic domain peak
+ * IEEE 0, 170 1.4e-15
+ * DEC 0, 33 1.4e-17
+ *
+ */
+
+/* fdtr.c
+ *
+ * F distribution
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * int df1, df2;
+ * double x, y, fdtr();
+ *
+ * y = fdtr( 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 is
+ * nonnegative.
+ *
+ * ACCURACY:
+ *
+ * Tested at random points (a,b,x).
+ *
+ * x a,b Relative error:
+ * arithmetic domain domain # trials peak rms
+ * IEEE 0,1 0,100 100000 9.8e-15 1.7e-15
+ * IEEE 1,5 0,100 100000 6.5e-15 3.5e-16
+ * IEEE 0,1 1,10000 100000 2.2e-11 3.3e-12
+ * IEEE 1,5 1,10000 100000 1.1e-11 1.7e-13
+ * See also incbet.c.
+ *
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * fdtr domain a<0, b<0, x<0 0.0
+ *
+ */
+ /* fdtrc()
+ *
+ * Complemented F distribution
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * int df1, df2;
+ * double x, y, fdtrc();
+ *
+ * y = fdtrc( 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
+ *
+ *
+ * The incomplete beta integral is used, according to the
+ * formula
+ *
+ * P(x) = incbet( df2/2, df1/2, (df2/(df2 + df1*x) ).
+ *
+ *
+ * ACCURACY:
+ *
+ * Tested at random points (a,b,x) in the indicated intervals.
+ * x a,b Relative error:
+ * arithmetic domain domain # trials peak rms
+ * IEEE 0,1 1,100 100000 3.7e-14 5.9e-16
+ * IEEE 1,5 1,100 100000 8.0e-15 1.6e-15
+ * IEEE 0,1 1,10000 100000 1.8e-11 3.5e-13
+ * IEEE 1,5 1,10000 100000 2.0e-11 3.0e-12
+ * See also incbet.c.
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * fdtrc domain a<0, b<0, x<0 0.0
+ *
+ */
+ /* fdtri()
+ *
+ * Inverse of complemented F distribution
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * int df1, df2;
+ * double x, p, fdtri();
+ *
+ * x = fdtri( df1, df2, p );
+ *
+ * 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 p.
+ *
+ * This is accomplished using the inverse beta integral
+ * function and the relations
+ *
+ * z = incbi( df2/2, df1/2, p )
+ * 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, p )
+ * x = df2 z / (df1 (1-z)).
+ *
+ * ACCURACY:
+ *
+ * Tested at random points (a,b,p).
+ *
+ * a,b Relative error:
+ * arithmetic domain # trials peak rms
+ * For p between .001 and 1:
+ * IEEE 1,100 100000 8.3e-15 4.7e-16
+ * IEEE 1,10000 100000 2.1e-11 1.4e-13
+ * For p between 10^-6 and 10^-3:
+ * IEEE 1,100 50000 1.3e-12 8.4e-15
+ * IEEE 1,10000 50000 3.0e-12 4.8e-14
+ * See also fdtrc.c.
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * fdtri domain p <= 0 or p > 1 0.0
+ * v < 1
+ *
+ */
+
+/* fftr.c
+ *
+ * FFT of Real Valued Sequence
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x[], sine[];
+ * int m;
+ *
+ * fftr( x, m, sine );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Computes the (complex valued) discrete Fourier transform of
+ * the real valued sequence x[]. The input sequence x[] contains
+ * n = 2**m samples. The program fills array sine[k] with
+ * n/4 + 1 values of sin( 2 PI k / n ).
+ *
+ * Data format for complex valued output is real part followed
+ * by imaginary part. The output is developed in the input
+ * array x[].
+ *
+ * The algorithm takes advantage of the fact that the FFT of an
+ * n point real sequence can be obtained from an n/2 point
+ * complex FFT.
+ *
+ * A radix 2 FFT algorithm is used.
+ *
+ * Execution time on an LSI-11/23 with floating point chip
+ * is 1.0 sec for n = 256.
+ *
+ *
+ *
+ * REFERENCE:
+ *
+ * E. Oran Brigham, The Fast Fourier Transform;
+ * Prentice-Hall, Inc., 1974
+ *
+ */
+
+/* ceil()
+ * floor()
+ * frexp()
+ * ldexp()
+ * signbit()
+ * isnan()
+ * isfinite()
+ *
+ * Floating point numeric utilities
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double ceil(), floor(), frexp(), ldexp();
+ * int signbit(), isnan(), isfinite();
+ * double x, y;
+ * int expnt, n;
+ *
+ * y = floor(x);
+ * y = ceil(x);
+ * y = frexp( x, &expnt );
+ * y = ldexp( x, n );
+ * n = signbit(x);
+ * n = isnan(x);
+ * n = isfinite(x);
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * All four routines return a double precision floating point
+ * result.
+ *
+ * floor() returns the largest integer less than or equal to x.
+ * It truncates toward minus infinity.
+ *
+ * ceil() returns the smallest integer greater than or equal
+ * to x. It truncates toward plus infinity.
+ *
+ * frexp() 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.
+ *
+ * ldexp() 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.
+ */
+
+/* fresnl.c
+ *
+ * Fresnel integral
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, S, C;
+ * void fresnl();
+ *
+ * fresnl( 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 a power series for x < 1.
+ * 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 10000 2.0e-15 3.2e-16
+ * IEEE C(x) 0, 10 10000 1.8e-15 3.3e-16
+ * DEC S(x) 0, 10 6000 2.2e-16 3.9e-17
+ * DEC C(x) 0, 10 5000 2.3e-16 3.9e-17
+ */
+
+/* gamma.c
+ *
+ * Gamma function
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, gamma();
+ * extern int sgngam;
+ *
+ * y = gamma( 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 sgngam.
+ * This variable is also filled in by the logarithmic gamma
+ * function lgam().
+ *
+ * Arguments |x| <= 34 are reduced by recurrence and the function
+ * approximated by a rational function of degree 6/7 in the
+ * interval (2,3). Large arguments are handled by Stirling's
+ * formula. Large negative arguments are made positive using
+ * a reflection formula.
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * DEC -34, 34 10000 1.3e-16 2.5e-17
+ * IEEE -170,-33 20000 2.3e-15 3.3e-16
+ * IEEE -33, 33 20000 9.4e-16 2.2e-16
+ * IEEE 33, 171.6 20000 2.3e-15 3.2e-16
+ *
+ * Error for arguments outside the test range will be larger
+ * owing to error amplification by the exponential function.
+ *
+ */
+/* lgam()
+ *
+ * Natural logarithm of gamma function
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, lgam();
+ * extern int sgngam;
+ *
+ * y = lgam( 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 sgngam.
+ *
+ * For arguments greater than 13, the logarithm of the gamma
+ * function is approximated by the logarithmic version of
+ * Stirling's formula using a polynomial approximation of
+ * degree 4. Arguments between -33 and +33 are reduced by
+ * recurrence to the interval [2,3] of a rational approximation.
+ * The cosecant reflection formula is employed for arguments
+ * less than -33.
+ *
+ * Arguments greater than MAXLGM return MAXNUM and an error
+ * message. MAXLGM = 2.035093e36 for DEC
+ * arithmetic or 2.556348e305 for IEEE arithmetic.
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ *
+ * arithmetic domain # trials peak rms
+ * DEC 0, 3 7000 5.2e-17 1.3e-17
+ * DEC 2.718, 2.035e36 5000 3.9e-17 9.9e-18
+ * IEEE 0, 3 28000 5.4e-16 1.1e-16
+ * IEEE 2.718, 2.556e305 40000 3.5e-16 8.3e-17
+ * The error criterion was relative when the function magnitude
+ * was greater than one but absolute when it was less than one.
+ *
+ * The following test used the relative error criterion, though
+ * at certain points the relative error could be much higher than
+ * indicated.
+ * IEEE -200, -4 10000 4.8e-16 1.3e-16
+ *
+ */
+
+/* gdtr.c
+ *
+ * Gamma distribution function
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double a, b, x, y, gdtr();
+ *
+ * y = gdtr( 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:
+ *
+ * See igam().
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * gdtr domain x < 0 0.0
+ *
+ */
+ /* gdtrc.c
+ *
+ * Complemented gamma distribution function
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double a, b, x, y, gdtrc();
+ *
+ * y = gdtrc( 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:
+ *
+ * See igamc().
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * gdtrc domain x < 0 0.0
+ *
+ */
+
+/*
+C
+C ..................................................................
+C
+C SUBROUTINE GELS
+C
+C PURPOSE
+C TO SOLVE A SYSTEM OF SIMULTANEOUS LINEAR EQUATIONS WITH
+C SYMMETRIC COEFFICIENT MATRIX UPPER TRIANGULAR PART OF WHICH
+C IS ASSUMED TO BE STORED COLUMNWISE.
+C
+C USAGE
+C CALL GELS(R,A,M,N,EPS,IER,AUX)
+C
+C DESCRIPTION OF PARAMETERS
+C R - M BY N RIGHT HAND SIDE MATRIX. (DESTROYED)
+C ON RETURN R CONTAINS THE SOLUTION OF THE EQUATIONS.
+C A - UPPER TRIANGULAR PART OF THE SYMMETRIC
+C M BY M COEFFICIENT MATRIX. (DESTROYED)
+C M - THE NUMBER OF EQUATIONS IN THE SYSTEM.
+C N - THE NUMBER OF RIGHT HAND SIDE VECTORS.
+C EPS - AN INPUT CONSTANT WHICH IS USED AS RELATIVE
+C TOLERANCE FOR TEST ON LOSS OF SIGNIFICANCE.
+C IER - RESULTING ERROR PARAMETER CODED AS FOLLOWS
+C IER=0 - NO ERROR,
+C IER=-1 - NO RESULT BECAUSE OF M LESS THAN 1 OR
+C PIVOT ELEMENT AT ANY ELIMINATION STEP
+C EQUAL TO 0,
+C IER=K - WARNING DUE TO POSSIBLE LOSS OF SIGNIFI-
+C CANCE INDICATED AT ELIMINATION STEP K+1,
+C WHERE PIVOT ELEMENT WAS LESS THAN OR
+C EQUAL TO THE INTERNAL TOLERANCE EPS TIMES
+C ABSOLUTELY GREATEST MAIN DIAGONAL
+C ELEMENT OF MATRIX A.
+C AUX - AN AUXILIARY STORAGE ARRAY WITH DIMENSION M-1.
+C
+C REMARKS
+C UPPER TRIANGULAR PART OF MATRIX A IS ASSUMED TO BE STORED
+C COLUMNWISE IN M*(M+1)/2 SUCCESSIVE STORAGE LOCATIONS, RIGHT
+C HAND SIDE MATRIX R COLUMNWISE IN N*M SUCCESSIVE STORAGE
+C LOCATIONS. ON RETURN SOLUTION MATRIX R IS STORED COLUMNWISE
+C TOO.
+C THE PROCEDURE GIVES RESULTS IF THE NUMBER OF EQUATIONS M IS
+C GREATER THAN 0 AND PIVOT ELEMENTS AT ALL ELIMINATION STEPS
+C ARE DIFFERENT FROM 0. HOWEVER WARNING IER=K - IF GIVEN -
+C INDICATES POSSIBLE LOSS OF SIGNIFICANCE. IN CASE OF A WELL
+C SCALED MATRIX A AND APPROPRIATE TOLERANCE EPS, IER=K MAY BE
+C INTERPRETED THAT MATRIX A HAS THE RANK K. NO WARNING IS
+C GIVEN IN CASE M=1.
+C ERROR PARAMETER IER=-1 DOES NOT NECESSARILY MEAN THAT
+C MATRIX A IS SINGULAR, AS ONLY MAIN DIAGONAL ELEMENTS
+C ARE USED AS PIVOT ELEMENTS. POSSIBLY SUBROUTINE GELG (WHICH
+C WORKS WITH TOTAL PIVOTING) WOULD BE ABLE TO FIND A SOLUTION.
+C
+C SUBROUTINES AND FUNCTION SUBPROGRAMS REQUIRED
+C NONE
+C
+C METHOD
+C SOLUTION IS DONE BY MEANS OF GAUSS-ELIMINATION WITH
+C PIVOTING IN MAIN DIAGONAL, IN ORDER TO PRESERVE
+C SYMMETRY IN REMAINING COEFFICIENT MATRICES.
+C
+C ..................................................................
+C
+*/
+
+/* hyp2f1.c
+ *
+ * Gauss hypergeometric function F
+ * 2 1
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double a, b, c, x, y, hyp2f1();
+ *
+ * y = hyp2f1( 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-14 of the nearest integer
+ * (1.0e-13 for IEEE arithmetic).
+ *
+ * ACCURACY:
+ *
+ *
+ * Relative error (-1 < x < 1):
+ * arithmetic domain # trials peak rms
+ * IEEE -1,7 230000 1.2e-11 5.2e-14
+ *
+ * Several special cases also tested with a, b, c in
+ * the range -7 to 7.
+ *
+ * ERROR MESSAGES:
+ *
+ * A "partial loss of precision" message is printed if
+ * the internally estimated relative error exceeds 1^-12.
+ * A "singularity" message is printed on overflow or
+ * in cases not addressed (such as x < -1).
+ */
+
+/* hyperg.c
+ *
+ * Confluent hypergeometric function
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double a, b, x, y, hyperg();
+ *
+ * y = hyperg( 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
+ * DEC 0,30 2000 1.2e-15 1.3e-16
+ * IEEE 0,30 30000 1.8e-14 1.1e-15
+ *
+ * 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-12.
+ *
+ */
+
+/* i0.c
+ *
+ * Modified Bessel function of order zero
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, i0();
+ *
+ * y = i0( 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
+ * DEC 0,30 6000 8.2e-17 1.9e-17
+ * IEEE 0,30 30000 5.8e-16 1.4e-16
+ *
+ */
+ /* i0e.c
+ *
+ * Modified Bessel function of order zero,
+ * exponentially scaled
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, i0e();
+ *
+ * y = i0e( 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 30000 5.4e-16 1.2e-16
+ * See i0().
+ *
+ */
+
+/* i1.c
+ *
+ * Modified Bessel function of order one
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, i1();
+ *
+ * y = i1( 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
+ * DEC 0, 30 3400 1.2e-16 2.3e-17
+ * IEEE 0, 30 30000 1.9e-15 2.1e-16
+ *
+ *
+ */
+ /* i1e.c
+ *
+ * Modified Bessel function of order one,
+ * exponentially scaled
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, i1e();
+ *
+ * y = i1e( 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 2.0e-15 2.0e-16
+ * See i1().
+ *
+ */
+
+/* igam.c
+ *
+ * Incomplete gamma integral
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double a, x, y, igam();
+ *
+ * y = igam( 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 200000 3.6e-14 2.9e-15
+ * IEEE 0,100 300000 9.9e-14 1.5e-14
+ */
+ /* igamc()
+ *
+ * Complemented incomplete gamma integral
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double a, x, y, igamc();
+ *
+ * y = igamc( 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:
+ *
+ * Tested at random a, x.
+ * a x Relative error:
+ * arithmetic domain domain # trials peak rms
+ * IEEE 0.5,100 0,100 200000 1.9e-14 1.7e-15
+ * IEEE 0.01,0.5 0,100 200000 1.4e-13 1.6e-15
+ */
+
+/* igami()
+ *
+ * Inverse of complemented imcomplete gamma integral
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double a, x, p, igami();
+ *
+ * x = igami( a, p );
+ *
+ * DESCRIPTION:
+ *
+ * Given p, the function finds x such that
+ *
+ * igamc( a, x ) = p.
+ *
+ * Starting with the approximate value
+ *
+ * 3
+ * x = a t
+ *
+ * where
+ *
+ * t = 1 - d - ndtri(p) sqrt(d)
+ *
+ * and
+ *
+ * d = 1/9a,
+ *
+ * the routine performs up to 10 Newton iterations to find the
+ * root of igamc(a,x) - p = 0.
+ *
+ * ACCURACY:
+ *
+ * Tested at random a, p in the intervals indicated.
+ *
+ * a p Relative error:
+ * arithmetic domain domain # trials peak rms
+ * IEEE 0.5,100 0,0.5 100000 1.0e-14 1.7e-15
+ * IEEE 0.01,0.5 0,0.5 100000 9.0e-14 3.4e-15
+ * IEEE 0.5,10000 0,0.5 20000 2.3e-13 3.8e-14
+ */
+
+/* incbet.c
+ *
+ * Incomplete beta integral
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double a, b, x, y, incbet();
+ *
+ * y = incbet( 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
+ * or, when b*x is small, by a power series.
+ *
+ * ACCURACY:
+ *
+ * Tested at uniformly distributed random points (a,b,x) with a and b
+ * in "domain" and x between 0 and 1.
+ * Relative error
+ * arithmetic domain # trials peak rms
+ * IEEE 0,5 10000 6.9e-15 4.5e-16
+ * IEEE 0,85 250000 2.2e-13 1.7e-14
+ * IEEE 0,1000 30000 5.3e-12 6.3e-13
+ * IEEE 0,10000 250000 9.3e-11 7.1e-12
+ * IEEE 0,100000 10000 8.7e-10 4.8e-11
+ * Outputs smaller than the IEEE gradual underflow threshold
+ * were excluded from these statistics.
+ *
+ * ERROR MESSAGES:
+ * message condition value returned
+ * incbet domain x<0, x>1 0.0
+ * incbet underflow 0.0
+ */
+
+/* incbi()
+ *
+ * Inverse of imcomplete beta integral
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double a, b, x, y, incbi();
+ *
+ * x = incbi( a, b, y );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Given y, the function finds x such that
+ *
+ * incbet( a, b, x ) = y .
+ *
+ * The routine performs interval halving or 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 .5,10000 50000 5.8e-12 1.3e-13
+ * IEEE 0,1 .25,100 100000 1.8e-13 3.9e-15
+ * IEEE 0,1 0,5 50000 1.1e-12 5.5e-15
+ * VAX 0,1 .5,100 25000 3.5e-14 1.1e-15
+ * With a and b constrained to half-integer or integer values:
+ * IEEE 0,1 .5,10000 50000 5.8e-12 1.1e-13
+ * IEEE 0,1 .5,100 100000 1.7e-14 7.9e-16
+ * With a = .5, b constrained to half-integer or integer values:
+ * IEEE 0,1 .5,10000 10000 8.3e-11 1.0e-11
+ */
+
+/* iv.c
+ *
+ * Modified Bessel function of noninteger order
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double v, x, y, iv();
+ *
+ * y = iv( 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.
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * DEC 0,30 2000 3.1e-15 5.4e-16
+ * IEEE 0,30 10000 1.7e-14 2.7e-15
+ *
+ * Accuracy is diminished if v is near a negative integer.
+ *
+ * See also hyperg.c.
+ *
+ */
+
+/* j0.c
+ *
+ * Bessel function of order zero
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, j0();
+ *
+ * y = j0( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns Bessel function of order zero of the argument.
+ *
+ * The domain is divided into the intervals [0, 5] and
+ * (5, infinity). In the first interval the following rational
+ * approximation is used:
+ *
+ *
+ * 2 2
+ * (w - r ) (w - r ) P (w) / Q (w)
+ * 1 2 3 8
+ *
+ * 2
+ * where w = x and the two r's are zeros of the function.
+ *
+ * In the second interval, the Hankel asymptotic expansion
+ * is employed with two rational functions of degree 6/6
+ * and 7/7.
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Absolute error:
+ * arithmetic domain # trials peak rms
+ * DEC 0, 30 10000 4.4e-17 6.3e-18
+ * IEEE 0, 30 60000 4.2e-16 1.1e-16
+ *
+ */
+ /* y0.c
+ *
+ * Bessel function of the second kind, order zero
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, y0();
+ *
+ * y = y0( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns Bessel function of the second kind, of order
+ * zero, of the argument.
+ *
+ * The domain is divided into the intervals [0, 5] and
+ * (5, infinity). In the first interval a rational approximation
+ * R(x) is employed to compute
+ * y0(x) = R(x) + 2 * log(x) * j0(x) / PI.
+ * Thus a call to j0() is required.
+ *
+ * In the second interval, the Hankel asymptotic expansion
+ * is employed with two rational functions of degree 6/6
+ * and 7/7.
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Absolute error, when y0(x) < 1; else relative error:
+ *
+ * arithmetic domain # trials peak rms
+ * DEC 0, 30 9400 7.0e-17 7.9e-18
+ * IEEE 0, 30 30000 1.3e-15 1.6e-16
+ *
+ */
+
+/* j1.c
+ *
+ * Bessel function of order one
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, j1();
+ *
+ * y = j1( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns Bessel function of order one of the argument.
+ *
+ * The domain is divided into the intervals [0, 8] and
+ * (8, infinity). In the first interval a 24 term Chebyshev
+ * expansion is used. In the second, the asymptotic
+ * trigonometric representation is employed using two
+ * rational functions of degree 5/5.
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Absolute error:
+ * arithmetic domain # trials peak rms
+ * DEC 0, 30 10000 4.0e-17 1.1e-17
+ * IEEE 0, 30 30000 2.6e-16 1.1e-16
+ *
+ *
+ */
+ /* 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, 8] and
+ * (8, infinity). In the first interval a 25 term Chebyshev
+ * expansion is used, and a call to j1() is required.
+ * In the second, the asymptotic trigonometric representation
+ * is employed using two rational functions of degree 5/5.
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Absolute error:
+ * arithmetic domain # trials peak rms
+ * DEC 0, 30 10000 8.6e-17 1.3e-17
+ * IEEE 0, 30 30000 1.0e-15 1.3e-16
+ *
+ * (error criterion relative when |y1| > 1).
+ *
+ */
+
+/* jn.c
+ *
+ * Bessel function of integer order
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * int n;
+ * double x, y, jn();
+ *
+ * y = jn( 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
+ * DEC 0, 30 5500 6.9e-17 9.3e-18
+ * IEEE 0, 30 5000 4.4e-16 7.9e-17
+ *
+ *
+ * Not suitable for large n or x. Use jv() instead.
+ *
+ */
+
+/* jv.c
+ *
+ * Bessel function of noninteger order
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double v, x, y, jv();
+ *
+ * y = jv( 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 transitional expansions give 12D accuracy for v > 500.
+ *
+ *
+ *
+ * ACCURACY:
+ * Results for integer v are indicated by *, where x and v
+ * both vary from -125 to +125. Otherwise,
+ * x ranges from 0 to 125, v ranges as indicated by "domain."
+ * Error criterion is absolute, except relative when |jv()| > 1.
+ *
+ * arithmetic v domain x domain # trials peak rms
+ * IEEE 0,125 0,125 100000 4.6e-15 2.2e-16
+ * IEEE -125,0 0,125 40000 5.4e-11 3.7e-13
+ * IEEE 0,500 0,500 20000 4.4e-15 4.0e-16
+ * Integer v:
+ * IEEE -125,125 -125,125 50000 3.5e-15* 1.9e-16*
+ *
+ */
+
+/* k0.c
+ *
+ * Modified Bessel function, third kind, order zero
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, k0();
+ *
+ * y = k0( 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
+ * DEC 0, 30 3100 1.3e-16 2.1e-17
+ * IEEE 0, 30 30000 1.2e-15 1.6e-16
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * K0 domain x <= 0 MAXNUM
+ *
+ */
+ /* k0e()
+ *
+ * Modified Bessel function, third kind, order zero,
+ * exponentially scaled
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, k0e();
+ *
+ * y = k0e( 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 1.4e-15 1.4e-16
+ * See k0().
+ *
+ */
+
+/* k1.c
+ *
+ * Modified Bessel function, third kind, order one
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, k1();
+ *
+ * y = k1( 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
+ * DEC 0, 30 3300 8.9e-17 2.2e-17
+ * IEEE 0, 30 30000 1.2e-15 1.6e-16
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * k1 domain x <= 0 MAXNUM
+ *
+ */
+ /* k1e.c
+ *
+ * Modified Bessel function, third kind, order one,
+ * exponentially scaled
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, k1e();
+ *
+ * y = k1e( 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 7.8e-16 1.2e-16
+ * See k1().
+ *
+ */
+
+/* kn.c
+ *
+ * Modified Bessel function, third kind, integer order
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, kn();
+ * int n;
+ *
+ * y = kn( 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:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * DEC 0,30 3000 1.3e-9 5.8e-11
+ * IEEE 0,30 90000 1.8e-8 3.0e-10
+ *
+ * Error is high only near the crossover point x = 9.55
+ * between the two expansions used.
+ */
+
+
+/* Re Kolmogorov statistics, here is Birnbaum and Tingey's formula for the
+ distribution of D+, the maximum of all positive deviations between a
+ theoretical distribution function P(x) and an empirical one Sn(x)
+ from n samples.
+
+ +
+ D = sup [ P(x) - Sn(x) ]
+ n -inf < x < inf
+
+
+ [n(1-e)]
+ + - v-1 n-v
+ Pr{D > e} = > C e (e + v/n) (1 - e - v/n)
+ n - n v
+ v=0
+ [n(1-e)] is the largest integer not exceeding n(1-e).
+ nCv is the number of combinations of n things taken v at a time.
+
+ Exact Smirnov statistic, for one-sided test:
+double
+smirnov (n, e)
+ int n;
+ double e;
+
+ Kolmogorov's limiting distribution of two-sided test, returns
+ probability that sqrt(n) * max deviation > y,
+ or that max deviation > y/sqrt(n).
+ The approximation is useful for the tail of the distribution
+ when n is large.
+double
+kolmogorov (y)
+ double y;
+
+
+ Functional inverse of Smirnov distribution
+ finds e such that smirnov(n,e) = p.
+double
+smirnovi (n, p)
+ int n;
+ double p;
+
+ Functional inverse of Kolmogorov statistic for two-sided test.
+ Finds y such that kolmogorov(y) = p.
+ If e = smirnovi (n,p), then kolmogi(2 * p) / sqrt(n) should
+ be close to e.
+double
+kolmogi (p)
+ double p;
+ */
+
+/* Levnsn.c */
+/* Levinson-Durbin LPC
+ *
+ * | R0 R1 R2 ... RN-1 | | A1 | | -R1 |
+ * | R1 R0 R1 ... RN-2 | | A2 | | -R2 |
+ * | R2 R1 R0 ... RN-3 | | A3 | = | -R3 |
+ * | ... | | ...| | ... |
+ * | RN-1 RN-2... R0 | | AN | | -RN |
+ *
+ * Ref: John Makhoul, "Linear Prediction, A Tutorial Review"
+ * Proc. IEEE Vol. 63, PP 561-580 April, 1975.
+ *
+ * R is the input autocorrelation function. R0 is the zero lag
+ * term. A is the output array of predictor coefficients. Note
+ * that a filter impulse response has a coefficient of 1.0 preceding
+ * A1. E is an array of mean square error for each prediction order
+ * 1 to N. REFL is an output array of the reflection coefficients.
+ */
+
+/* log.c
+ *
+ * Natural logarithm
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, log();
+ *
+ * y = log( 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)/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 0.5, 2.0 150000 1.44e-16 5.06e-17
+ * IEEE +-MAXNUM 30000 1.20e-16 4.78e-17
+ * DEC 0, 10 170000 1.8e-17 6.3e-18
+ *
+ * In the tests over the interval [+-MAXNUM], the logarithms
+ * of the random arguments were uniformly distributed over
+ * [0, MAXLOG].
+ *
+ * ERROR MESSAGES:
+ *
+ * log singularity: x = 0; returns -INFINITY
+ * log domain: x < 0; returns NAN
+ */
+
+/* log10.c
+ *
+ * Common logarithm
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, log10();
+ *
+ * y = log10( 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)/Q(x).
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE 0.5, 2.0 30000 1.5e-16 5.0e-17
+ * IEEE 0, MAXNUM 30000 1.4e-16 4.8e-17
+ * DEC 1, MAXNUM 50000 2.5e-17 6.0e-18
+ *
+ * In the tests over the interval [1, MAXNUM], the logarithms
+ * of the random arguments were uniformly distributed over
+ * [0, MAXLOG].
+ *
+ * ERROR MESSAGES:
+ *
+ * log10 singularity: x = 0; returns -INFINITY
+ * log10 domain: x < 0; returns NAN
+ */
+
+/* log2.c
+ *
+ * Base 2 logarithm
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, log2();
+ *
+ * y = log2( 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 0.5, 2.0 30000 2.0e-16 5.5e-17
+ * IEEE exp(+-700) 40000 1.3e-16 4.6e-17
+ *
+ * In the tests over the interval [exp(+-700)], the logarithms
+ * of the random arguments were uniformly distributed.
+ *
+ * ERROR MESSAGES:
+ *
+ * log2 singularity: x = 0; returns -INFINITY
+ * log2 domain: x < 0; returns NAN
+ */
+
+/* lrand.c
+ *
+ * Pseudorandom number generator
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long y, drand();
+ *
+ * drand( &y );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Yields a long integer random number.
+ *
+ * The three-generator congruential algorithm by Brian
+ * Wichmann and David Hill (BYTE magazine, March, 1987,
+ * pp 127-8) is used. The period, given by them, is
+ * 6953607871644.
+ *
+ *
+ */
+
+/* lsqrt.c
+ *
+ * Integer square root
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long x, y;
+ * long lsqrt();
+ *
+ * y = lsqrt( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns a long integer square root of the long integer
+ * argument. The computation is by binary long division.
+ *
+ * The largest possible result is lsqrt(2,147,483,647)
+ * = 46341.
+ *
+ * If x < 0, the square root of |x| is returned, and an
+ * error message is printed.
+ *
+ *
+ * ACCURACY:
+ *
+ * An extra, roundoff, bit is computed; hence the result
+ * is the nearest integer to the actual square root.
+ * NOTE: only DEC arithmetic is currently supported.
+ *
+ */
+
+/* minv.c
+ *
+ * Matrix inversion
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * int n, errcod;
+ * double A[n*n], X[n*n];
+ * double B[n];
+ * int IPS[n];
+ * int minv();
+ *
+ * errcod = minv( A, X, n, B, IPS );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Finds the inverse of the n by n matrix A. The result goes
+ * to X. B and IPS are scratch pad arrays of length n.
+ * The contents of matrix A are destroyed.
+ *
+ * The routine returns nonzero on error; error messages are printed
+ * by subroutine simq().
+ *
+ */
+
+/* mmmpy.c
+ *
+ * Matrix multiply
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * int r, c;
+ * double A[r*c], B[c*r], Y[r*r];
+ *
+ * mmmpy( r, c, A, B, Y );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Y = A B
+ * c-1
+ * --
+ * Y[i][j] = > A[i][k] B[k][j]
+ * --
+ * k=0
+ *
+ * Multiplies an r (rows) by c (columns) matrix A on the left
+ * by a c (rows) by r (columns) matrix B on the right
+ * to produce an r by r matrix Y.
+ *
+ *
+ */
+
+/* mtherr.c
+ *
+ * Library common error handling routine
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * char *fctnam;
+ * int code;
+ * int 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
+ *
+ */
+
+/* mtransp.c
+ *
+ * Matrix transpose
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * int n;
+ * double A[n*n], T[n*n];
+ *
+ * mtransp( n, A, T );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ *
+ * T[r][c] = A[c][r]
+ *
+ *
+ * Transposes the n by n square matrix A and puts the result in T.
+ * The output, T, may occupy the same storage as A.
+ *
+ *
+ *
+ */
+
+/* mvmpy.c
+ *
+ * Matrix times vector
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * int r, c;
+ * double A[r*c], V[c], Y[r];
+ *
+ * mvmpy( r, c, A, V, Y );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * c-1
+ * --
+ * Y[j] = > A[j][k] V[k] , j = 1, ..., r
+ * --
+ * k=0
+ *
+ * Multiplies the r (rows) by c (columns) matrix A on the left
+ * by column vector V of dimension c on the right
+ * to produce a (column) vector Y output of dimension r.
+ *
+ *
+ *
+ *
+ */
+
+/* nbdtr.c
+ *
+ * Negative binomial distribution
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * int k, n;
+ * double p, y, nbdtr();
+ *
+ * y = nbdtr( 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:
+ *
+ * Tested at random points (a,b,p), with p between 0 and 1.
+ *
+ * a,b Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE 0,100 100000 1.7e-13 8.8e-15
+ * See also incbet.c.
+ *
+ */
+ /* nbdtrc.c
+ *
+ * Complemented negative binomial distribution
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * int k, n;
+ * double p, y, nbdtrc();
+ *
+ * y = nbdtrc( 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:
+ *
+ * Tested at random points (a,b,p), with p between 0 and 1.
+ *
+ * a,b Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE 0,100 100000 1.7e-13 8.8e-15
+ * See also incbet.c.
+ */
+
+/* nbdtrc
+ *
+ * Complemented negative binomial distribution
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * int k, n;
+ * double p, y, nbdtrc();
+ *
+ * y = nbdtrc( 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:
+ *
+ * See incbet.c.
+ */
+ /* nbdtri
+ *
+ * Functional inverse of negative binomial distribution
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * int k, n;
+ * double p, y, nbdtri();
+ *
+ * p = nbdtri( k, n, y );
+ *
+ * DESCRIPTION:
+ *
+ * Finds the argument p such that nbdtr(k,n,p) is equal to y.
+ *
+ * ACCURACY:
+ *
+ * Tested at random points (a,b,y), with y between 0 and 1.
+ *
+ * a,b Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE 0,100 100000 1.5e-14 8.5e-16
+ * See also incbi.c.
+ */
+
+/* ndtr.c
+ *
+ * Normal distribution function
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, ndtr();
+ *
+ * y = ndtr( 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
+ * DEC -13,0 8000 2.1e-15 4.8e-16
+ * IEEE -13,0 30000 3.4e-14 6.7e-15
+ *
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * erfc underflow x > 37.519379347 0.0
+ *
+ */
+ /* erf.c
+ *
+ * Error function
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, erf();
+ *
+ * y = erf( 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 * P4(x**2)/Q5(x**2); otherwise
+ * erf(x) = 1 - erfc(x).
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * DEC 0,1 14000 4.7e-17 1.5e-17
+ * IEEE 0,1 30000 3.7e-16 1.0e-16
+ *
+ */
+ /* erfc.c
+ *
+ * Complementary error function
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, erfc();
+ *
+ * y = erfc( 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 rational
+ * approximations are computed.
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * DEC 0, 9.2319 12000 5.1e-16 1.2e-16
+ * IEEE 0,26.6417 30000 5.7e-14 1.5e-14
+ *
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * erfc underflow x > 9.231948545 (DEC) 0.0
+ *
+ *
+ */
+
+/* ndtri.c
+ *
+ * Inverse of Normal distribution function
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, ndtri();
+ *
+ * x = ndtri( 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
+ * DEC 0.125, 1 5500 9.5e-17 2.1e-17
+ * DEC 6e-39, 0.135 3500 5.7e-17 1.3e-17
+ * IEEE 0.125, 1 20000 7.2e-16 1.3e-16
+ * IEEE 3e-308, 0.135 50000 4.6e-16 9.8e-17
+ *
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * ndtri domain x <= 0 -MAXNUM
+ * ndtri domain x >= 1 MAXNUM
+ *
+ */
+
+/* pdtr.c
+ *
+ * Poisson distribution
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * int k;
+ * double m, y, pdtr();
+ *
+ * y = pdtr( 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:
+ *
+ * See igamc().
+ *
+ */
+ /* pdtrc()
+ *
+ * Complemented poisson distribution
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * int k;
+ * double m, y, pdtrc();
+ *
+ * y = pdtrc( 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:
+ *
+ * See igam.c.
+ *
+ */
+ /* pdtri()
+ *
+ * Inverse Poisson distribution
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * int k;
+ * double m, y, pdtr();
+ *
+ * m = pdtri( 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:
+ *
+ * See igami.c.
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * pdtri domain y < 0 or y >= 1 0.0
+ * k < 0
+ *
+ */
+
+/* polevl.c
+ * p1evl.c
+ *
+ * Evaluate polynomial
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * int N;
+ * double x, y, coef[N+1], polevl[];
+ *
+ * y = polevl( 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.
+ *
+ */
+
+/* polmisc.c
+ * Square root, sine, cosine, and arctangent of polynomial.
+ * See polyn.c for data structures and discussion.
+ */
+
+/* polrt.c
+ *
+ * Find roots of a polynomial
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * typedef struct
+ * {
+ * double r;
+ * double i;
+ * }cmplx;
+ *
+ * double xcof[], cof[];
+ * int m;
+ * cmplx root[];
+ *
+ * polrt( xcof, cof, m, root )
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Iterative determination of the roots of a polynomial of
+ * degree m whose coefficient vector is xcof[]. The
+ * coefficients are arranged in ascending order; i.e., the
+ * coefficient of x**m is xcof[m].
+ *
+ * The array cof[] is working storage the same size as xcof[].
+ * root[] is the output array containing the complex roots.
+ *
+ *
+ * ACCURACY:
+ *
+ * Termination depends on evaluation of the polynomial at
+ * the trial values of the roots. The values of multiple roots
+ * or of roots that are nearly equal may have poor relative
+ * accuracy after the first root in the neighborhood has been
+ * found.
+ *
+ */
+
+/* polyn.c
+ * polyr.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 MAXPOL. 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
+ *
+ * polini( 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 polini().
+ *
+ * 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.
+ * polprt( a, na, D ); Print the coefficients of a to D digits.
+ * polclr( a, na ); Set a identically equal to zero, up to a[na].
+ * polmov( a, na, b ); Set b = a.
+ * poladd( a, na, b, nb, c ); c = b + a, nc = max(na,nb)
+ * polsub( a, na, b, nb, c ); c = b - a, nc = max(na,nb)
+ * polmul( a, na, b, nb, c ); c = b * a, nc = na+nb
+ *
+ *
+ * Division:
+ *
+ * i = poldiv( 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
+ *
+ * polsbt( a, na, b, nb, c );
+ *
+ *
+ * Notes:
+ * poldiv() is an integer routine; poleva() is double.
+ * Any of the arguments a, b, c may refer to the same array.
+ *
+ */
+
+/* pow.c
+ *
+ * Power function
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, z, pow();
+ *
+ * z = pow( 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 -26,26 30000 4.2e-16 7.7e-17
+ * DEC -26,26 60000 4.8e-17 9.1e-18
+ * 1/26 < x < 26, with log(x) uniformly distributed.
+ * -26 < y < 26, y uniformly distributed.
+ * IEEE 0,8700 30000 1.5e-14 2.1e-15
+ * 0.99 < x < 1.01, 0 < y < 8700, uniformly distributed.
+ *
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * pow overflow x**y > MAXNUM INFINITY
+ * pow underflow x**y < 1/MAXNUM 0.0
+ * pow domain x<0 and y noninteger 0.0
+ *
+ */
+
+/* powi.c
+ *
+ * Real raised to integer power
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, powi();
+ * int n;
+ *
+ * y = powi( 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
+ * DEC .04,26 -26,26 100000 2.7e-16 4.3e-17
+ * IEEE .04,26 -26,26 50000 2.0e-15 3.8e-16
+ * IEEE 1,2 -1022,1023 50000 8.6e-14 1.6e-14
+ *
+ * Returns MAXNUM on overflow, zero on underflow.
+ *
+ */
+
+/* psi.c
+ *
+ * Psi (digamma) function
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, psi();
+ *
+ * y = psi( 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:
+ * Relative error (except absolute when |psi| < 1):
+ * arithmetic domain # trials peak rms
+ * DEC 0,30 2500 1.7e-16 2.0e-17
+ * IEEE 0,30 30000 1.3e-15 1.4e-16
+ * IEEE -30,0 40000 1.5e-15 2.2e-16
+ *
+ * ERROR MESSAGES:
+ * message condition value returned
+ * psi singularity x integer <=0 MAXNUM
+ */
+
+/* revers.c
+ *
+ * Reversion of power series
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * extern int MAXPOL;
+ * int n;
+ * double x[n+1], y[n+1];
+ *
+ * polini(n);
+ * revers( y, x, n );
+ *
+ * Note, polini() initializes the polynomial arithmetic subroutines;
+ * see polyn.c.
+ *
+ *
+ * DESCRIPTION:
+ *
+ * If
+ *
+ * inf
+ * - i
+ * y(x) = > a x
+ * - i
+ * i=1
+ *
+ * then
+ *
+ * inf
+ * - j
+ * x(y) = > A y ,
+ * - j
+ * j=1
+ *
+ * where
+ * 1
+ * A = ---
+ * 1 a
+ * 1
+ *
+ * etc. The coefficients of x(y) are found by expanding
+ *
+ * inf inf
+ * - - i
+ * x(y) = > A > a x
+ * - j - i
+ * j=1 i=1
+ *
+ * and setting each coefficient of x , higher than the first,
+ * to zero.
+ *
+ *
+ *
+ * RESTRICTIONS:
+ *
+ * y[0] must be zero, and y[1] must be nonzero.
+ *
+ */
+
+/* rgamma.c
+ *
+ * Reciprocal gamma function
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, rgamma();
+ *
+ * y = rgamma( 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/MAXNUM is returned for positive arguments outside this
+ * range. For arguments less than -34.034 the cosecant
+ * reflection formula is applied; lograrithms are employed
+ * to avoid unnecessary overflow.
+ *
+ * The reciprocal gamma function has no singularities,
+ * but overflow and underflow may occur for large arguments.
+ * These conditions return either MAXNUM or 1/MAXNUM with
+ * appropriate sign.
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * DEC -30,+30 4000 1.2e-16 1.8e-17
+ * IEEE -30,+30 30000 1.1e-15 2.0e-16
+ * For arguments less than -34.034 the peak error is on the
+ * order of 5e-15 (DEC), excepting overflow or underflow.
+ */
+
+/* round.c
+ *
+ * Round double to nearest or even integer valued double
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, round();
+ *
+ * y = round(x);
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns the nearest integer to x as a double precision
+ * floating point result. If x ends in 0.5 exactly, the
+ * nearest even integer is chosen.
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * If x is greater than 1/(2*MACHEP), its closest machine
+ * representation is already an integer, so rounding does
+ * not change it.
+ */
+
+/* shichi.c
+ *
+ * Hyperbolic sine and cosine integrals
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, Chi, Shi, shichi();
+ *
+ * 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
+ * DEC Shi 3000 9.1e-17
+ * IEEE Shi 30000 6.9e-16 1.6e-16
+ * Absolute error, except relative when |Chi| > 1:
+ * DEC Chi 2500 9.3e-17
+ * IEEE Chi 30000 8.4e-16 1.4e-16
+ */
+
+/* sici.c
+ *
+ * Sine and cosine integrals
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, Ci, Si, sici();
+ *
+ * sici( 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 4.4e-16 7.3e-17
+ * IEEE Ci 30000 6.9e-16 5.1e-17
+ * DEC Si 5000 4.4e-17 9.0e-18
+ * DEC Ci 5300 7.9e-17 5.2e-18
+ */
+
+/* simpsn.c */
+ * Numerical integration of function tabulated
+ * at equally spaced arguments
+ */
+
+/* simq.c
+ *
+ * Solution of simultaneous linear equations AX = B
+ * by Gaussian elimination with partial pivoting
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double A[n*n], B[n], X[n];
+ * int n, flag;
+ * int IPS[];
+ * int simq();
+ *
+ * ercode = simq( A, B, X, n, flag, IPS );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * B, X, IPS are vectors of length n.
+ * A is an n x n matrix (i.e., a vector of length n*n),
+ * stored row-wise: that is, A(i,j) = A[ij],
+ * where ij = i*n + j, which is the transpose of the normal
+ * column-wise storage.
+ *
+ * The contents of matrix A are destroyed.
+ *
+ * Set flag=0 to solve.
+ * Set flag=-1 to do a new back substitution for different B vector
+ * using the same A matrix previously reduced when flag=0.
+ *
+ * The routine returns nonzero on error; messages are printed.
+ *
+ *
+ * ACCURACY:
+ *
+ * Depends on the conditioning (range of eigenvalues) of matrix A.
+ *
+ *
+ * REFERENCE:
+ *
+ * Computer Solution of Linear Algebraic Systems,
+ * by George E. Forsythe and Cleve B. Moler; Prentice-Hall, 1967.
+ *
+ */
+
+/* sin.c
+ *
+ * Circular sine
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, sin();
+ *
+ * y = sin( 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
+ * DEC 0, 10 150000 3.0e-17 7.8e-18
+ * IEEE -1.07e9,+1.07e9 130000 2.1e-16 5.4e-17
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * sin total loss x > 1.073741824e9 0.0
+ *
+ * Partial loss of accuracy begins to occur at x = 2**30
+ * = 1.074e9. The loss is not gradual, but jumps suddenly to
+ * about 1 part in 10e7. Results may be meaningless for
+ * x > 2**49 = 5.6e14. The routine as implemented flags a
+ * TLOSS error for x > 2**30 and returns 0.0.
+ */
+ /* cos.c
+ *
+ * Circular cosine
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, cos();
+ *
+ * y = cos( 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 -1.07e9,+1.07e9 130000 2.1e-16 5.4e-17
+ * DEC 0,+1.07e9 17000 3.0e-17 7.2e-18
+ */
+
+/* sincos.c
+ *
+ * Circular sine and cosine of argument in degrees
+ * Table lookup and interpolation algorithm
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, sine, cosine, flg, sincos();
+ *
+ * sincos( x, &sine, &cosine, flg );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns both the sine and the cosine of the argument x.
+ * Several different compile time options and minimax
+ * approximations are supplied to permit tailoring the
+ * tradeoff between computation speed and accuracy.
+ *
+ * Since range reduction is time consuming, the reduction
+ * of x modulo 360 degrees is also made optional.
+ *
+ * sin(i) is internally tabulated for 0 <= i <= 90 degrees.
+ * Approximation polynomials, ranging from linear interpolation
+ * to cubics in (x-i)**2, compute the sine and cosine
+ * of the residual x-i which is between -0.5 and +0.5 degree.
+ * In the case of the high accuracy options, the residual
+ * and the tabulated values are combined using the trigonometry
+ * formulas for sin(A+B) and cos(A+B).
+ *
+ * Compile time options are supplied for 5, 11, or 17 decimal
+ * relative accuracy (ACC5, ACC11, ACC17 respectively).
+ * A subroutine flag argument "flg" chooses betwen this
+ * accuracy and table lookup only (peak absolute error
+ * = 0.0087).
+ *
+ * If the argument flg = 1, then the tabulated value is
+ * returned for the nearest whole number of degrees. The
+ * approximation polynomials are not computed. At
+ * x = 0.5 deg, the absolute error is then sin(0.5) = 0.0087.
+ *
+ * An intermediate speed and precision can be obtained using
+ * the compile time option LINTERP and flg = 1. This yields
+ * a linear interpolation using a slope estimated from the sine
+ * or cosine at the nearest integer argument. The peak absolute
+ * error with this option is 3.8e-5. Relative error at small
+ * angles is about 1e-5.
+ *
+ * If flg = 0, then the approximation polynomials are computed
+ * and applied.
+ *
+ *
+ *
+ * SPEED:
+ *
+ * Relative speed comparisons follow for 6MHz IBM AT clone
+ * and Microsoft C version 4.0. These figures include
+ * software overhead of do loop and function calls.
+ * Since system hardware and software vary widely, the
+ * numbers should be taken as representative only.
+ *
+ * flg=0 flg=0 flg=1 flg=1
+ * ACC11 ACC5 LINTERP Lookup only
+ * In-line 8087 (/FPi)
+ * sin(), cos() 1.0 1.0 1.0 1.0
+ *
+ * In-line 8087 (/FPi)
+ * sincos() 1.1 1.4 1.9 3.0
+ *
+ * Software (/FPa)
+ * sin(), cos() 0.19 0.19 0.19 0.19
+ *
+ * Software (/FPa)
+ * sincos() 0.39 0.50 0.73 1.7
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * The accurate approximations are designed with a relative error
+ * criterion. The absolute error is greatest at x = 0.5 degree.
+ * It decreases from a local maximum at i+0.5 degrees to full
+ * machine precision at each integer i degrees. With the
+ * ACC5 option, the relative error of 6.3e-6 is equivalent to
+ * an absolute angular error of 0.01 arc second in the argument
+ * at x = i+0.5 degrees. For small angles < 0.5 deg, the ACC5
+ * accuracy is 6.3e-6 (.00063%) of reading; i.e., the absolute
+ * error decreases in proportion to the argument. This is true
+ * for both the sine and cosine approximations, since the latter
+ * is for the function 1 - cos(x).
+ *
+ * If absolute error is of most concern, use the compile time
+ * option ABSERR to obtain an absolute error of 2.7e-8 for ACC5
+ * precision. This is about half the absolute error of the
+ * relative precision option. In this case the relative error
+ * for small angles will increase to 9.5e-6 -- a reasonable
+ * tradeoff.
+ */
+
+/* sindg.c
+ *
+ * Circular sine of angle in degrees
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, sindg();
+ *
+ * y = sindg( 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 P(x**2).
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * DEC +-1000 3100 3.3e-17 9.0e-18
+ * IEEE +-1000 30000 2.3e-16 5.6e-17
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * sindg total loss x > 8.0e14 (DEC) 0.0
+ * x > 1.0e14 (IEEE)
+ *
+ */
+ /* cosdg.c
+ *
+ * Circular cosine of angle in degrees
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, cosdg();
+ *
+ * y = cosdg( 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 P(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
+ * DEC +-1000 3400 3.5e-17 9.1e-18
+ * IEEE +-1000 30000 2.1e-16 5.7e-17
+ * See also sin().
+ *
+ */
+
+/* sinh.c
+ *
+ * Hyperbolic sine
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, sinh();
+ *
+ * y = sinh( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns hyperbolic sine of argument in the range MINLOG to
+ * MAXLOG.
+ *
+ * The range is partitioned into two segments. If |x| <= 1, a
+ * rational function of the form x + x**3 P(x)/Q(x) is employed.
+ * Otherwise the calculation is sinh(x) = ( exp(x) - exp(-x) )/2.
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * DEC +- 88 50000 4.0e-17 7.7e-18
+ * IEEE +-MAXLOG 30000 2.6e-16 5.7e-17
+ *
+ */
+
+/* spence.c
+ *
+ * Dilogarithm
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, spence();
+ *
+ * y = spence( 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 3.9e-15 5.4e-16
+ * DEC 0,4 3000 2.5e-16 4.5e-17
+ *
+ *
+ */
+
+/* sqrt.c
+ *
+ * Square root
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, sqrt();
+ *
+ * y = sqrt( 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
+ * DEC 0, 10 60000 2.1e-17 7.9e-18
+ * IEEE 0,1.7e308 30000 1.7e-16 6.3e-17
+ *
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * sqrt domain x < 0 0.0
+ *
+ */
+
+/* stdtr.c
+ *
+ * Student's t distribution
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double t, stdtr();
+ * short k;
+ *
+ * y = stdtr( 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 < -2, 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:
+ *
+ * Tested at random 1 <= k <= 25. The "domain" refers to t.
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE -100,-2 50000 5.9e-15 1.4e-15
+ * IEEE -2,100 500000 2.7e-15 4.9e-17
+ */
+
+/* stdtri.c
+ *
+ * Functional inverse of Student's t distribution
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double p, t, stdtri();
+ * int k;
+ *
+ * t = stdtri( k, p );
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Given probability p, finds the argument t such that stdtr(k,t)
+ * is equal to p.
+ *
+ * ACCURACY:
+ *
+ * Tested at random 1 <= k <= 100. The "domain" refers to p:
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE .001,.999 25000 5.7e-15 8.0e-16
+ * IEEE 10^-6,.001 25000 2.0e-12 2.9e-14
+ */
+
+/* struve.c
+ *
+ * Struve function
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double v, x, y, struve();
+ *
+ * y = struve( 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:
+ *
+ * Not accurately characterized, but spot checked against tables.
+ *
+ */
+
+/* tan.c
+ *
+ * Circular tangent
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, tan();
+ *
+ * y = tan( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns the circular tangent of the radian argument x.
+ *
+ * Range reduction is modulo pi/4. A rational function
+ * x + x**3 P(x**2)/Q(x**2)
+ * is employed in the basic interval [0, pi/4].
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * DEC +-1.07e9 44000 4.1e-17 1.0e-17
+ * IEEE +-1.07e9 30000 2.9e-16 8.1e-17
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * tan total loss x > 1.073741824e9 0.0
+ *
+ */
+ /* cot.c
+ *
+ * Circular cotangent
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, cot();
+ *
+ * y = cot( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns the circular cotangent of the radian argument x.
+ *
+ * Range reduction is modulo pi/4. A rational function
+ * x + x**3 P(x**2)/Q(x**2)
+ * is employed in the basic interval [0, pi/4].
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE +-1.07e9 30000 2.9e-16 8.2e-17
+ *
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * cot total loss x > 1.073741824e9 0.0
+ * cot singularity x = 0 INFINITY
+ *
+ */
+
+/* tandg.c
+ *
+ * Circular tangent of argument in degrees
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, tandg();
+ *
+ * y = tandg( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns the circular tangent of the argument x in degrees.
+ *
+ * Range reduction is modulo pi/4. A rational function
+ * x + x**3 P(x**2)/Q(x**2)
+ * is employed in the basic interval [0, pi/4].
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * DEC 0,10 8000 3.4e-17 1.2e-17
+ * IEEE 0,10 30000 3.2e-16 8.4e-17
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * tandg total loss x > 8.0e14 (DEC) 0.0
+ * x > 1.0e14 (IEEE)
+ * tandg singularity x = 180 k + 90 MAXNUM
+ */
+ /* cotdg.c
+ *
+ * Circular cotangent of argument in degrees
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, cotdg();
+ *
+ * y = cotdg( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns the circular cotangent of the argument x in degrees.
+ *
+ * Range reduction is modulo pi/4. A rational function
+ * x + x**3 P(x**2)/Q(x**2)
+ * is employed in the basic interval [0, pi/4].
+ *
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * cotdg total loss x > 8.0e14 (DEC) 0.0
+ * x > 1.0e14 (IEEE)
+ * cotdg singularity x = 180 k MAXNUM
+ */
+
+/* tanh.c
+ *
+ * Hyperbolic tangent
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, tanh();
+ *
+ * y = tanh( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns hyperbolic tangent of argument in the range MINLOG to
+ * MAXLOG.
+ *
+ * A rational function is used for |x| < 0.625. The form
+ * x + x**3 P(x)/Q(x) of Cody _& Waite is employed.
+ * Otherwise,
+ * tanh(x) = sinh(x)/cosh(x) = 1 - 2/(exp(2x) + 1).
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * DEC -2,2 50000 3.3e-17 6.4e-18
+ * IEEE -2,2 30000 2.5e-16 5.8e-17
+ *
+ */
+
+/* unity.c
+ *
+ * Relative error approximations for function arguments near
+ * unity.
+ *
+ * log1p(x) = log(1+x)
+ * expm1(x) = exp(x) - 1
+ * cosm1(x) = cos(x) - 1
+ *
+ */
+
+/* yn.c
+ *
+ * Bessel function of second kind of integer order
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, yn();
+ * int n;
+ *
+ * y = yn( 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
+ * DEC 0, 30 2200 2.9e-16 5.3e-17
+ * IEEE 0, 30 30000 3.4e-15 4.3e-16
+ *
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * yn singularity x = 0 MAXNUM
+ * yn overflow MAXNUM
+ *
+ * Spot checked against tables for x, n between 0 and 100.
+ *
+ */
+
+/* zeta.c
+ *
+ * Riemann zeta function of two arguments
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, q, y, zeta();
+ *
+ * y = zeta( 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:
+ *
+ *
+ *
+ * REFERENCE:
+ *
+ * Gradshteyn, I. S., and I. M. Ryzhik, Tables of Integrals,
+ * Series, and Products, p. 1073; Academic Press, 1980.
+ *
+ */
+
+ /* zetac.c
+ *
+ * Riemann zeta function
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, zetac();
+ *
+ * y = zetac( 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 10000 9.8e-16 1.3e-16
+ * DEC 1,50 2000 1.1e-16 1.9e-17
+ *
+ *
+ */
diff --git a/libm/double/acosh.c b/libm/double/acosh.c
new file mode 100644
index 000000000..49d9a40e2
--- /dev/null
+++ b/libm/double/acosh.c
@@ -0,0 +1,167 @@
+/* acosh.c
+ *
+ * Inverse hyperbolic cosine
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, acosh();
+ *
+ * y = acosh( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns inverse hyperbolic cosine of argument.
+ *
+ * If 1 <= x < 1.5, a rational approximation
+ *
+ * sqrt(z) * P(z)/Q(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
+ * DEC 1,3 30000 4.2e-17 1.1e-17
+ * IEEE 1,3 30000 4.6e-16 8.7e-17
+ *
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * acosh domain |x| < 1 NAN
+ *
+ */
+
+/* acosh.c */
+
+/*
+Cephes Math Library Release 2.8: June, 2000
+Copyright 1984, 1995, 2000 by Stephen L. Moshier
+*/
+
+
+/* acosh(z) = sqrt(x) * R(x), z = x + 1, interval 0 < x < 0.5 */
+
+#include <math.h>
+
+#ifdef UNK
+static double P[] = {
+ 1.18801130533544501356E2,
+ 3.94726656571334401102E3,
+ 3.43989375926195455866E4,
+ 1.08102874834699867335E5,
+ 1.10855947270161294369E5
+};
+static double Q[] = {
+/* 1.00000000000000000000E0,*/
+ 1.86145380837903397292E2,
+ 4.15352677227719831579E3,
+ 2.97683430363289370382E4,
+ 8.29725251988426222434E4,
+ 7.83869920495893927727E4
+};
+#endif
+
+#ifdef DEC
+static unsigned short P[] = {
+0041755,0115055,0144002,0146444,
+0043166,0132103,0155150,0150302,
+0044006,0057360,0003021,0162753,
+0044323,0021557,0175225,0056253,
+0044330,0101771,0040046,0006636
+};
+static unsigned short Q[] = {
+/*0040200,0000000,0000000,0000000,*/
+0042072,0022467,0126670,0041232,
+0043201,0146066,0152142,0034015,
+0043750,0110257,0121165,0026100,
+0044242,0007103,0034667,0033173,
+0044231,0014576,0175573,0017472
+};
+#endif
+
+#ifdef IBMPC
+static unsigned short P[] = {
+0x59a4,0xb900,0xb345,0x405d,
+0x1a18,0x7b4d,0xd688,0x40ae,
+0x3cbd,0x00c2,0xcbde,0x40e0,
+0xab95,0xff52,0x646d,0x40fa,
+0xc1b4,0x2804,0x107f,0x40fb
+};
+static unsigned short Q[] = {
+/*0x0000,0x0000,0x0000,0x3ff0,*/
+0x0853,0xf5b7,0x44a6,0x4067,
+0x4702,0xda8c,0x3986,0x40b0,
+0xa588,0xf44e,0x1215,0x40dd,
+0xe6cf,0x6736,0x41c8,0x40f4,
+0x63e7,0xdf6f,0x232f,0x40f3
+};
+#endif
+
+#ifdef MIEEE
+static unsigned short P[] = {
+0x405d,0xb345,0xb900,0x59a4,
+0x40ae,0xd688,0x7b4d,0x1a18,
+0x40e0,0xcbde,0x00c2,0x3cbd,
+0x40fa,0x646d,0xff52,0xab95,
+0x40fb,0x107f,0x2804,0xc1b4
+};
+static unsigned short Q[] = {
+0x4067,0x44a6,0xf5b7,0x0853,
+0x40b0,0x3986,0xda8c,0x4702,
+0x40dd,0x1215,0xf44e,0xa588,
+0x40f4,0x41c8,0x6736,0xe6cf,
+0x40f3,0x232f,0xdf6f,0x63e7,
+};
+#endif
+
+#ifdef ANSIPROT
+extern double polevl ( double, void *, int );
+extern double p1evl ( double, void *, int );
+extern double log ( double );
+extern double sqrt ( double );
+#else
+double log(), sqrt(), polevl(), p1evl();
+#endif
+extern double LOGE2, INFINITY, NAN;
+
+double acosh(x)
+double x;
+{
+double a, z;
+
+if( x < 1.0 )
+ {
+ mtherr( "acosh", DOMAIN );
+ return(NAN);
+ }
+
+if( x > 1.0e8 )
+ {
+#ifdef INFINITIES
+ if( x == INFINITY )
+ return( INFINITY );
+#endif
+ return( log(x) + LOGE2 );
+ }
+
+z = x - 1.0;
+
+if( z < 0.5 )
+ {
+ a = sqrt(z) * (polevl(z, P, 4) / p1evl(z, Q, 5) );
+ return( a );
+ }
+
+a = sqrt( z*(x+1.0) );
+return( log(x + a) );
+}
diff --git a/libm/double/airy.c b/libm/double/airy.c
new file mode 100644
index 000000000..91e29088a
--- /dev/null
+++ b/libm/double/airy.c
@@ -0,0 +1,965 @@
+/* airy.c
+ *
+ * Airy function
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, ai, aip, bi, bip;
+ * int airy();
+ *
+ * airy( 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 10000 1.6e-15 2.7e-16
+ * IEEE 0, 10 Ai 10000 2.3e-14* 1.8e-15*
+ * IEEE -10, 0 Ai' 10000 4.6e-15 7.6e-16
+ * IEEE 0, 10 Ai' 10000 1.8e-14* 1.5e-15*
+ * IEEE -10, 10 Bi 30000 4.2e-15 5.3e-16
+ * IEEE -10, 10 Bi' 30000 4.9e-15 7.3e-16
+ * DEC -10, 0 Ai 5000 1.7e-16 2.8e-17
+ * DEC 0, 10 Ai 5000 2.1e-15* 1.7e-16*
+ * DEC -10, 0 Ai' 5000 4.7e-16 7.8e-17
+ * DEC 0, 10 Ai' 12000 1.8e-15* 1.5e-16*
+ * DEC -10, 10 Bi 10000 5.5e-16 6.8e-17
+ * DEC -10, 10 Bi' 7000 5.3e-16 8.7e-17
+ *
+ */
+ /* airy.c */
+
+/*
+Cephes Math Library Release 2.8: June, 2000
+Copyright 1984, 1987, 1989, 2000 by Stephen L. Moshier
+*/
+
+#include <math.h>
+
+static double c1 = 0.35502805388781723926;
+static double c2 = 0.258819403792806798405;
+static double sqrt3 = 1.732050807568877293527;
+static double sqpii = 5.64189583547756286948E-1;
+extern double PI;
+
+extern double MAXNUM, MACHEP;
+#ifdef UNK
+#define MAXAIRY 25.77
+#endif
+#ifdef DEC
+#define MAXAIRY 25.77
+#endif
+#ifdef IBMPC
+#define MAXAIRY 103.892
+#endif
+#ifdef MIEEE
+#define MAXAIRY 103.892
+#endif
+
+
+#ifdef UNK
+static double AN[8] = {
+ 3.46538101525629032477E-1,
+ 1.20075952739645805542E1,
+ 7.62796053615234516538E1,
+ 1.68089224934630576269E2,
+ 1.59756391350164413639E2,
+ 7.05360906840444183113E1,
+ 1.40264691163389668864E1,
+ 9.99999999999999995305E-1,
+};
+static double AD[8] = {
+ 5.67594532638770212846E-1,
+ 1.47562562584847203173E1,
+ 8.45138970141474626562E1,
+ 1.77318088145400459522E2,
+ 1.64234692871529701831E2,
+ 7.14778400825575695274E1,
+ 1.40959135607834029598E1,
+ 1.00000000000000000470E0,
+};
+#endif
+#ifdef DEC
+static unsigned short AN[32] = {
+0037661,0066561,0024675,0131301,
+0041100,0017434,0034324,0101466,
+0041630,0107450,0067427,0007430,
+0042050,0013327,0071000,0034737,
+0042037,0140642,0156417,0167366,
+0041615,0011172,0075147,0051165,
+0041140,0066152,0160520,0075146,
+0040200,0000000,0000000,0000000,
+};
+static unsigned short AD[32] = {
+0040021,0046740,0011422,0064606,
+0041154,0014640,0024631,0062450,
+0041651,0003435,0101152,0106401,
+0042061,0050556,0034605,0136602,
+0042044,0036024,0152377,0151414,
+0041616,0172247,0072216,0115374,
+0041141,0104334,0124154,0166007,
+0040200,0000000,0000000,0000000,
+};
+#endif
+#ifdef IBMPC
+static unsigned short AN[32] = {
+0xb658,0x2537,0x2dae,0x3fd6,
+0x9067,0x871a,0x03e3,0x4028,
+0xe1e3,0x0de2,0x11e5,0x4053,
+0x073c,0xee40,0x02da,0x4065,
+0xfddf,0x5ba1,0xf834,0x4063,
+0xea4f,0x4f4c,0xa24f,0x4051,
+0x0f4d,0x5c2a,0x0d8d,0x402c,
+0x0000,0x0000,0x0000,0x3ff0,
+};
+static unsigned short AD[32] = {
+0x4d31,0x0262,0x29bc,0x3fe2,
+0x2ca5,0x0533,0x8334,0x402d,
+0x51a0,0xb04d,0x20e3,0x4055,
+0xb7b0,0xc730,0x2a2d,0x4066,
+0xfa61,0x9a9f,0x8782,0x4064,
+0xd35f,0xee91,0xde94,0x4051,
+0x9d81,0x950d,0x311b,0x402c,
+0x0000,0x0000,0x0000,0x3ff0,
+};
+#endif
+#ifdef MIEEE
+static unsigned short AN[32] = {
+0x3fd6,0x2dae,0x2537,0xb658,
+0x4028,0x03e3,0x871a,0x9067,
+0x4053,0x11e5,0x0de2,0xe1e3,
+0x4065,0x02da,0xee40,0x073c,
+0x4063,0xf834,0x5ba1,0xfddf,
+0x4051,0xa24f,0x4f4c,0xea4f,
+0x402c,0x0d8d,0x5c2a,0x0f4d,
+0x3ff0,0x0000,0x0000,0x0000,
+};
+static unsigned short AD[32] = {
+0x3fe2,0x29bc,0x0262,0x4d31,
+0x402d,0x8334,0x0533,0x2ca5,
+0x4055,0x20e3,0xb04d,0x51a0,
+0x4066,0x2a2d,0xc730,0xb7b0,
+0x4064,0x8782,0x9a9f,0xfa61,
+0x4051,0xde94,0xee91,0xd35f,
+0x402c,0x311b,0x950d,0x9d81,
+0x3ff0,0x0000,0x0000,0x0000,
+};
+#endif
+
+#ifdef UNK
+static double APN[8] = {
+ 6.13759184814035759225E-1,
+ 1.47454670787755323881E1,
+ 8.20584123476060982430E1,
+ 1.71184781360976385540E2,
+ 1.59317847137141783523E2,
+ 6.99778599330103016170E1,
+ 1.39470856980481566958E1,
+ 1.00000000000000000550E0,
+};
+static double APD[8] = {
+ 3.34203677749736953049E-1,
+ 1.11810297306158156705E1,
+ 7.11727352147859965283E1,
+ 1.58778084372838313640E2,
+ 1.53206427475809220834E2,
+ 6.86752304592780337944E1,
+ 1.38498634758259442477E1,
+ 9.99999999999999994502E-1,
+};
+#endif
+#ifdef DEC
+static unsigned short APN[32] = {
+0040035,0017522,0065145,0054755,
+0041153,0166556,0161471,0057174,
+0041644,0016750,0034445,0046462,
+0042053,0027515,0152316,0046717,
+0042037,0050536,0067023,0023264,
+0041613,0172252,0007240,0131055,
+0041137,0023503,0052472,0002305,
+0040200,0000000,0000000,0000000,
+};
+static unsigned short APD[32] = {
+0037653,0016276,0112106,0126625,
+0041062,0162577,0067111,0111761,
+0041616,0054160,0140004,0137455,
+0042036,0143460,0104626,0157206,
+0042031,0032330,0067131,0114260,
+0041611,0054667,0147207,0134564,
+0041135,0114412,0070653,0146015,
+0040200,0000000,0000000,0000000,
+};
+#endif
+#ifdef IBMPC
+static unsigned short APN[32] = {
+0xab3e,0x4d4c,0xa3ea,0x3fe3,
+0x2bcf,0xdc67,0x7dad,0x402d,
+0xa9a6,0x0724,0x83bd,0x4054,
+0xc9ba,0xba99,0x65e9,0x4065,
+0x64d7,0xcdc2,0xea2b,0x4063,
+0x1646,0x41d4,0x7e95,0x4051,
+0x4099,0x6aa7,0xe4e8,0x402b,
+0x0000,0x0000,0x0000,0x3ff0,
+};
+static unsigned short APD[32] = {
+0xd5b3,0xd288,0x6397,0x3fd5,
+0x327e,0xedc9,0x5caf,0x4026,
+0x97e6,0x1800,0xcb0e,0x4051,
+0xdbd1,0x1132,0xd8e6,0x4063,
+0x3316,0x0dcb,0x269b,0x4063,
+0xf72f,0xf9d0,0x2b36,0x4051,
+0x7982,0x4e35,0xb321,0x402b,
+0x0000,0x0000,0x0000,0x3ff0,
+};
+#endif
+#ifdef MIEEE
+static unsigned short APN[32] = {
+0x3fe3,0xa3ea,0x4d4c,0xab3e,
+0x402d,0x7dad,0xdc67,0x2bcf,
+0x4054,0x83bd,0x0724,0xa9a6,
+0x4065,0x65e9,0xba99,0xc9ba,
+0x4063,0xea2b,0xcdc2,0x64d7,
+0x4051,0x7e95,0x41d4,0x1646,
+0x402b,0xe4e8,0x6aa7,0x4099,
+0x3ff0,0x0000,0x0000,0x0000,
+};
+static unsigned short APD[32] = {
+0x3fd5,0x6397,0xd288,0xd5b3,
+0x4026,0x5caf,0xedc9,0x327e,
+0x4051,0xcb0e,0x1800,0x97e6,
+0x4063,0xd8e6,0x1132,0xdbd1,
+0x4063,0x269b,0x0dcb,0x3316,
+0x4051,0x2b36,0xf9d0,0xf72f,
+0x402b,0xb321,0x4e35,0x7982,
+0x3ff0,0x0000,0x0000,0x0000,
+};
+#endif
+
+#ifdef UNK
+static double BN16[5] = {
+-2.53240795869364152689E-1,
+ 5.75285167332467384228E-1,
+-3.29907036873225371650E-1,
+ 6.44404068948199951727E-2,
+-3.82519546641336734394E-3,
+};
+static double BD16[5] = {
+/* 1.00000000000000000000E0,*/
+-7.15685095054035237902E0,
+ 1.06039580715664694291E1,
+-5.23246636471251500874E0,
+ 9.57395864378383833152E-1,
+-5.50828147163549611107E-2,
+};
+#endif
+#ifdef DEC
+static unsigned short BN16[20] = {
+0137601,0124307,0010213,0035210,
+0040023,0042743,0101621,0016031,
+0137650,0164623,0036056,0074511,
+0037203,0174525,0000473,0142474,
+0136172,0130041,0066726,0064324,
+};
+static unsigned short BD16[20] = {
+/*0040200,0000000,0000000,0000000,*/
+0140745,0002354,0044335,0055276,
+0041051,0124717,0170130,0104013,
+0140647,0070135,0046473,0103501,
+0040165,0013745,0033324,0127766,
+0137141,0117204,0076164,0033107,
+};
+#endif
+#ifdef IBMPC
+static unsigned short BN16[20] = {
+0x6751,0xe211,0x3518,0xbfd0,
+0x2383,0x7072,0x68bc,0x3fe2,
+0xcf29,0x6785,0x1d32,0xbfd5,
+0x78a8,0xa027,0x7f2a,0x3fb0,
+0xcd1b,0x2dba,0x5604,0xbf6f,
+};
+static unsigned short BD16[20] = {
+/*0x0000,0x0000,0x0000,0x3ff0,*/
+0xab58,0x891b,0xa09d,0xc01c,
+0x1101,0xfe0b,0x3539,0x4025,
+0x70e8,0xa9a7,0xee0b,0xc014,
+0x95ff,0xa6da,0xa2fc,0x3fee,
+0x86c9,0x8f8e,0x33d0,0xbfac,
+};
+#endif
+#ifdef MIEEE
+static unsigned short BN16[20] = {
+0xbfd0,0x3518,0xe211,0x6751,
+0x3fe2,0x68bc,0x7072,0x2383,
+0xbfd5,0x1d32,0x6785,0xcf29,
+0x3fb0,0x7f2a,0xa027,0x78a8,
+0xbf6f,0x5604,0x2dba,0xcd1b,
+};
+static unsigned short BD16[20] = {
+/*0x3ff0,0x0000,0x0000,0x0000,*/
+0xc01c,0xa09d,0x891b,0xab58,
+0x4025,0x3539,0xfe0b,0x1101,
+0xc014,0xee0b,0xa9a7,0x70e8,
+0x3fee,0xa2fc,0xa6da,0x95ff,
+0xbfac,0x33d0,0x8f8e,0x86c9,
+};
+#endif
+
+#ifdef UNK
+static double BPPN[5] = {
+ 4.65461162774651610328E-1,
+-1.08992173800493920734E0,
+ 6.38800117371827987759E-1,
+-1.26844349553102907034E-1,
+ 7.62487844342109852105E-3,
+};
+static double BPPD[5] = {
+/* 1.00000000000000000000E0,*/
+-8.70622787633159124240E0,
+ 1.38993162704553213172E1,
+-7.14116144616431159572E0,
+ 1.34008595960680518666E0,
+-7.84273211323341930448E-2,
+};
+#endif
+#ifdef DEC
+static unsigned short BPPN[20] = {
+0037756,0050354,0167531,0135731,
+0140213,0101216,0032767,0020375,
+0040043,0104147,0106312,0177632,
+0137401,0161574,0032015,0043714,
+0036371,0155035,0143165,0142262,
+};
+static unsigned short BPPD[20] = {
+/*0040200,0000000,0000000,0000000,*/
+0141013,0046265,0115005,0161053,
+0041136,0061631,0072445,0156131,
+0140744,0102145,0001127,0065304,
+0040253,0103757,0146453,0102513,
+0137240,0117200,0155402,0113500,
+};
+#endif
+#ifdef IBMPC
+static unsigned short BPPN[20] = {
+0x377b,0x9deb,0xca1d,0x3fdd,
+0xe420,0xc6be,0x7051,0xbff1,
+0x5ff3,0xf199,0x710c,0x3fe4,
+0xa8fa,0x8681,0x3c6f,0xbfc0,
+0xb896,0xb8ce,0x3b43,0x3f7f,
+};
+static unsigned short BPPD[20] = {
+/*0x0000,0x0000,0x0000,0x3ff0,*/
+0xbc45,0xb340,0x6996,0xc021,
+0xbb8b,0x2ea4,0xcc73,0x402b,
+0xed59,0xa04a,0x908c,0xc01c,
+0x70a9,0xf9a5,0x70fd,0x3ff5,
+0x52e8,0x1b60,0x13d0,0xbfb4,
+};
+#endif
+#ifdef MIEEE
+static unsigned short BPPN[20] = {
+0x3fdd,0xca1d,0x9deb,0x377b,
+0xbff1,0x7051,0xc6be,0xe420,
+0x3fe4,0x710c,0xf199,0x5ff3,
+0xbfc0,0x3c6f,0x8681,0xa8fa,
+0x3f7f,0x3b43,0xb8ce,0xb896,
+};
+static unsigned short BPPD[20] = {
+/*0x3ff0,0x0000,0x0000,0x0000,*/
+0xc021,0x6996,0xb340,0xbc45,
+0x402b,0xcc73,0x2ea4,0xbb8b,
+0xc01c,0x908c,0xa04a,0xed59,
+0x3ff5,0x70fd,0xf9a5,0x70a9,
+0xbfb4,0x13d0,0x1b60,0x52e8,
+};
+#endif
+
+#ifdef UNK
+static double 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 double 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,
+};
+#endif
+#ifdef DEC
+static unsigned short AFN[36] = {
+0137406,0155546,0124127,0033732,
+0140040,0057564,0141263,0041222,
+0140061,0071316,0013674,0175754,
+0137617,0037522,0056637,0120130,
+0137111,0075567,0121755,0166122,
+0136205,0020016,0043317,0002201,
+0135047,0001565,0075130,0002334,
+0133472,0051700,0165021,0131551,
+0131620,0020347,0132165,0013215,
+};
+static unsigned short AFD[36] = {
+/*0040200,0000000,0000000,0000000,*/
+0041125,0131131,0025627,0067623,
+0041402,0135342,0021703,0154315,
+0041325,0162305,0016671,0120175,
+0041022,0177101,0053114,0141632,
+0040274,0153131,0147364,0114306,
+0037354,0166545,0120042,0150530,
+0036220,0043127,0000727,0130273,
+0034636,0043275,0075667,0034733,
+0032762,0112715,0146250,0142474,
+};
+#endif
+#ifdef IBMPC
+static unsigned short AFN[36] = {
+0xe6fb,0xd50a,0xdb6c,0xbfc0,
+0x6852,0x9856,0x0bee,0xbfe4,
+0x9f7d,0xc2f7,0x2e59,0xbfe6,
+0xf40b,0x4bb3,0xe7ea,0xbfd1,
+0xbd8a,0xf47d,0x2f6e,0xbfa9,
+0xe090,0xc8d9,0xa401,0xbf70,
+0x009c,0xaf4b,0xe06e,0xbf24,
+0x366d,0x1d42,0x4a78,0xbec7,
+0xa2d2,0xf68e,0x041c,0xbe52,
+};
+static unsigned short AFD[36] = {
+/*0x0000,0x0000,0x0000,0x3ff0,*/
+0xedf2,0x2572,0xb64b,0x402a,
+0x7b1a,0x4478,0x575c,0x4040,
+0x3410,0xa3b7,0xbc98,0x403a,
+0x9873,0x2ac9,0x5fc8,0x4022,
+0x9319,0x39de,0x9acb,0x3ff7,
+0x5a2b,0xb404,0x9dac,0x3fbd,
+0xf617,0xe03a,0x08ca,0x3f72,
+0xe73b,0xaf76,0xc8d7,0x3f13,
+0x18a7,0xb995,0x52b9,0x3e9e,
+};
+#endif
+#ifdef MIEEE
+static unsigned short AFN[36] = {
+0xbfc0,0xdb6c,0xd50a,0xe6fb,
+0xbfe4,0x0bee,0x9856,0x6852,
+0xbfe6,0x2e59,0xc2f7,0x9f7d,
+0xbfd1,0xe7ea,0x4bb3,0xf40b,
+0xbfa9,0x2f6e,0xf47d,0xbd8a,
+0xbf70,0xa401,0xc8d9,0xe090,
+0xbf24,0xe06e,0xaf4b,0x009c,
+0xbec7,0x4a78,0x1d42,0x366d,
+0xbe52,0x041c,0xf68e,0xa2d2,
+};
+static unsigned short AFD[36] = {
+/*0x3ff0,0x0000,0x0000,0x0000,*/
+0x402a,0xb64b,0x2572,0xedf2,
+0x4040,0x575c,0x4478,0x7b1a,
+0x403a,0xbc98,0xa3b7,0x3410,
+0x4022,0x5fc8,0x2ac9,0x9873,
+0x3ff7,0x9acb,0x39de,0x9319,
+0x3fbd,0x9dac,0xb404,0x5a2b,
+0x3f72,0x08ca,0xe03a,0xf617,
+0x3f13,0xc8d7,0xaf76,0xe73b,
+0x3e9e,0x52b9,0xb995,0x18a7,
+};
+#endif
+
+#ifdef UNK
+static double 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 double 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,
+};
+#endif
+#ifdef DEC
+static unsigned short AGN[44] = {
+0036641,0124456,0167175,0157354,
+0037710,0037250,0001441,0136671,
+0040210,0066031,0150401,0123532,
+0040160,0066545,0003570,0153133,
+0037663,0171516,0072507,0170345,
+0037201,0151011,0007510,0045702,
+0036277,0172317,0104572,0101030,
+0035224,0045663,0000160,0136422,
+0033752,0074753,0047702,0135160,
+0032256,0052225,0156550,0107103,
+0030273,0142443,0166277,0071720,
+};
+static unsigned short AGD[40] = {
+/*0040200,0000000,0000000,0000000,*/
+0041024,0170537,0117253,0055003,
+0041236,0127256,0003570,0143240,
+0041171,0004333,0172476,0160645,
+0040657,0041161,0055716,0157161,
+0040164,0046226,0006257,0063431,
+0037261,0010357,0065445,0047563,
+0036207,0034043,0057434,0116732,
+0034724,0055416,0130035,0026377,
+0033235,0041056,0154071,0023502,
+0031250,0177071,0167254,0047242,
+};
+#endif
+#ifdef IBMPC
+static unsigned short AGN[44] = {
+0xbbde,0xddcf,0x3525,0x3f94,
+0x37b7,0x0064,0x07d5,0x3fd9,
+0x34eb,0x3a20,0x0d83,0x3ff1,
+0x1acb,0xa0ef,0x0dac,0x3fee,
+0xfe1d,0xcea8,0x7e69,0x3fd6,
+0x0978,0x21e9,0x3a41,0x3fb0,
+0x5043,0xf12f,0xfe99,0x3f77,
+0x17a2,0x600e,0x8976,0x3f32,
+0x574e,0x69f8,0x4f3d,0x3edd,
+0x11c8,0xbbad,0xca92,0x3e75,
+0xee7a,0x7d97,0x78a4,0x3df7,
+};
+static unsigned short AGD[40] = {
+/*0x0000,0x0000,0x0000,0x3ff0,*/
+0x6b40,0xf3d5,0x9e2b,0x4022,
+0x18d4,0xc0ef,0xd5d5,0x4033,
+0xdc35,0x7ea7,0x211b,0x402f,
+0xdbce,0x2b79,0xe84e,0x4015,
+0xece3,0xc195,0x8992,0x3fee,
+0xa9ee,0xed64,0x221d,0x3fb6,
+0x93bb,0x6be3,0xe704,0x3f70,
+0xa5a0,0xd603,0x8b61,0x3f1a,
+0x24e8,0xdb07,0xa845,0x3eb3,
+0x89d4,0x3dd5,0x1fc7,0x3e35,
+};
+#endif
+#ifdef MIEEE
+static unsigned short AGN[44] = {
+0x3f94,0x3525,0xddcf,0xbbde,
+0x3fd9,0x07d5,0x0064,0x37b7,
+0x3ff1,0x0d83,0x3a20,0x34eb,
+0x3fee,0x0dac,0xa0ef,0x1acb,
+0x3fd6,0x7e69,0xcea8,0xfe1d,
+0x3fb0,0x3a41,0x21e9,0x0978,
+0x3f77,0xfe99,0xf12f,0x5043,
+0x3f32,0x8976,0x600e,0x17a2,
+0x3edd,0x4f3d,0x69f8,0x574e,
+0x3e75,0xca92,0xbbad,0x11c8,
+0x3df7,0x78a4,0x7d97,0xee7a,
+};
+static unsigned short AGD[40] = {
+/*0x3ff0,0x0000,0x0000,0x0000,*/
+0x4022,0x9e2b,0xf3d5,0x6b40,
+0x4033,0xd5d5,0xc0ef,0x18d4,
+0x402f,0x211b,0x7ea7,0xdc35,
+0x4015,0xe84e,0x2b79,0xdbce,
+0x3fee,0x8992,0xc195,0xece3,
+0x3fb6,0x221d,0xed64,0xa9ee,
+0x3f70,0xe704,0x6be3,0x93bb,
+0x3f1a,0x8b61,0xd603,0xa5a0,
+0x3eb3,0xa845,0xdb07,0x24e8,
+0x3e35,0x1fc7,0x3dd5,0x89d4,
+};
+#endif
+
+#ifdef UNK
+static double 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 double 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,
+};
+#endif
+#ifdef DEC
+static unsigned short APFN[36] = {
+0037475,0150174,0071752,0166651,
+0040142,0177621,0164246,0101757,
+0040174,0142670,0106760,0006573,
+0037715,0067570,0116274,0022404,
+0037221,0074157,0053341,0117207,
+0036301,0104257,0015075,0004777,
+0035164,0057502,0164034,0001313,
+0033611,0022254,0176000,0112565,
+0031725,0055523,0025153,0166057,
+};
+static unsigned short APFD[36] = {
+/*0040200,0000000,0000000,0000000,*/
+0041153,0140334,0130506,0061402,
+0041426,0025551,0024440,0070611,
+0041373,0134750,0047147,0176702,
+0041057,0171532,0105430,0017674,
+0040344,0174416,0001726,0047754,
+0037421,0021207,0020167,0136264,
+0036262,0043621,0151321,0124324,
+0034705,0001313,0163733,0016407,
+0033027,0166702,0150440,0170561,
+};
+#endif
+#ifdef IBMPC
+static unsigned short APFN[36] = {
+0x5db5,0x8e7d,0xba0f,0x3fc7,
+0xd07e,0x3d14,0x5ff2,0x3fec,
+0x01af,0x11be,0x98b7,0x3fef,
+0x84a1,0x1397,0xadef,0x3fd9,
+0x33d1,0xeadc,0x2f0d,0x3fb2,
+0xa140,0xe347,0x3115,0x3f78,
+0x8059,0x5d03,0x8be8,0x3f2e,
+0x12af,0x9f80,0x2495,0x3ed1,
+0x7d86,0x654d,0xab6a,0x3e5a,
+};
+static unsigned short APFD[36] = {
+/*0x0000,0x0000,0x0000,0x3ff0,*/
+0xcc60,0x9628,0x781b,0x402d,
+0x0e31,0x2524,0xc56d,0x4042,
+0xffb8,0x09cc,0x773d,0x403f,
+0x03f7,0x5163,0xfe6b,0x4025,
+0xc9fd,0xc07a,0x9f21,0x3ffc,
+0xf796,0xe40e,0x2450,0x3fc2,
+0x351a,0x3a5a,0x48f2,0x3f76,
+0x63a1,0x7cfb,0xa059,0x3f18,
+0x1e2e,0x5a24,0xfdb8,0x3ea2,
+};
+#endif
+#ifdef MIEEE
+static unsigned short APFN[36] = {
+0x3fc7,0xba0f,0x8e7d,0x5db5,
+0x3fec,0x5ff2,0x3d14,0xd07e,
+0x3fef,0x98b7,0x11be,0x01af,
+0x3fd9,0xadef,0x1397,0x84a1,
+0x3fb2,0x2f0d,0xeadc,0x33d1,
+0x3f78,0x3115,0xe347,0xa140,
+0x3f2e,0x8be8,0x5d03,0x8059,
+0x3ed1,0x2495,0x9f80,0x12af,
+0x3e5a,0xab6a,0x654d,0x7d86,
+};
+static unsigned short APFD[36] = {
+/*0x3ff0,0x0000,0x0000,0x0000,*/
+0x402d,0x781b,0x9628,0xcc60,
+0x4042,0xc56d,0x2524,0x0e31,
+0x403f,0x773d,0x09cc,0xffb8,
+0x4025,0xfe6b,0x5163,0x03f7,
+0x3ffc,0x9f21,0xc07a,0xc9fd,
+0x3fc2,0x2450,0xe40e,0xf796,
+0x3f76,0x48f2,0x3a5a,0x351a,
+0x3f18,0xa059,0x7cfb,0x63a1,
+0x3ea2,0xfdb8,0x5a24,0x1e2e,
+};
+#endif
+
+#ifdef UNK
+static double 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 double 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,
+};
+#endif
+#ifdef DEC
+static unsigned short APGN[44] = {
+0137021,0124372,0176075,0075331,
+0140043,0023330,0177672,0161655,
+0140332,0131126,0010413,0171112,
+0140300,0044263,0175560,0054070,
+0140020,0044206,0142603,0073324,
+0137321,0015130,0066144,0144033,
+0136433,0061243,0175542,0103373,
+0135361,0053721,0020441,0053203,
+0134077,0141725,0160277,0130612,
+0132417,0040372,0100363,0060200,
+0130432,0175052,0171064,0034147,
+};
+static unsigned short APGD[40] = {
+/*0040200,0000000,0000000,0000000,*/
+0041035,0136420,0030124,0140220,
+0041255,0017432,0034447,0162256,
+0041212,0100456,0154544,0006321,
+0040705,0134026,0127154,0123414,
+0040213,0051612,0044470,0172607,
+0037313,0143362,0053273,0157051,
+0036234,0144322,0054536,0007264,
+0034767,0146170,0054265,0170342,
+0033270,0102777,0167362,0073631,
+0031307,0040644,0167103,0021763,
+};
+#endif
+#ifdef IBMPC
+static unsigned short APGN[44] = {
+0xaf5b,0x5f87,0x351f,0xbfa2,
+0x5c76,0x1ff7,0x64db,0xbfe4,
+0x7e49,0xc221,0x564a,0xbffb,
+0x0b07,0x7f6e,0x0916,0xbff8,
+0x6edb,0xd8b0,0x0910,0xbfe2,
+0x9903,0x0d8c,0x234b,0xbfba,
+0x50df,0x7f6c,0x6c54,0xbf83,
+0x2ad0,0x2424,0x2afa,0xbf3e,
+0xf631,0xbc17,0xf87a,0xbee7,
+0x6c10,0x501e,0xe81f,0xbe81,
+0x870d,0x5e46,0x5f45,0xbe03,
+};
+static unsigned short APGD[40] = {
+/*0x0000,0x0000,0x0000,0x3ff0,*/
+0x9812,0x060a,0xb7a2,0x4023,
+0xfc96,0x4724,0xa3e3,0x4035,
+0x819a,0xdb2c,0x5025,0x4031,
+0x94e2,0xd5cd,0xb702,0x4018,
+0x1eb1,0x4927,0x6a71,0x3ff1,
+0x7bc5,0x4ad7,0x78de,0x3fb9,
+0xc1d7,0x4b2b,0x991a,0x3f73,
+0xbe1c,0x0b16,0xf98f,0x3f1e,
+0x4ef3,0xfdde,0x10bf,0x3eb7,
+0x647e,0x9dc8,0xe834,0x3e38,
+};
+#endif
+#ifdef MIEEE
+static unsigned short APGN[44] = {
+0xbfa2,0x351f,0x5f87,0xaf5b,
+0xbfe4,0x64db,0x1ff7,0x5c76,
+0xbffb,0x564a,0xc221,0x7e49,
+0xbff8,0x0916,0x7f6e,0x0b07,
+0xbfe2,0x0910,0xd8b0,0x6edb,
+0xbfba,0x234b,0x0d8c,0x9903,
+0xbf83,0x6c54,0x7f6c,0x50df,
+0xbf3e,0x2afa,0x2424,0x2ad0,
+0xbee7,0xf87a,0xbc17,0xf631,
+0xbe81,0xe81f,0x501e,0x6c10,
+0xbe03,0x5f45,0x5e46,0x870d,
+};
+static unsigned short APGD[40] = {
+/*0x3ff0,0x0000,0x0000,0x0000,*/
+0x4023,0xb7a2,0x060a,0x9812,
+0x4035,0xa3e3,0x4724,0xfc96,
+0x4031,0x5025,0xdb2c,0x819a,
+0x4018,0xb702,0xd5cd,0x94e2,
+0x3ff1,0x6a71,0x4927,0x1eb1,
+0x3fb9,0x78de,0x4ad7,0x7bc5,
+0x3f73,0x991a,0x4b2b,0xc1d7,
+0x3f1e,0xf98f,0x0b16,0xbe1c,
+0x3eb7,0x10bf,0xfdde,0x4ef3,
+0x3e38,0xe834,0x9dc8,0x647e,
+};
+#endif
+
+#ifdef ANSIPROT
+extern double fabs ( double );
+extern double exp ( double );
+extern double sqrt ( double );
+extern double polevl ( double, void *, int );
+extern double p1evl ( double, void *, int );
+extern double sin ( double );
+extern double cos ( double );
+#else
+double fabs(), exp(), sqrt();
+double polevl(), p1evl(), sin(), cos();
+#endif
+
+int airy( x, ai, aip, bi, bip )
+double x, *ai, *aip, *bi, *bip;
+{
+double z, zz, t, f, g, uf, ug, k, zeta, theta;
+int domflg;
+
+domflg = 0;
+if( x > MAXAIRY )
+ {
+ *ai = 0;
+ *aip = 0;
+ *bi = MAXNUM;
+ *bip = MAXNUM;
+ return(-1);
+ }
+
+if( x < -2.09 )
+ {
+ domflg = 15;
+ t = sqrt(-x);
+ zeta = -2.0 * x * t / 3.0;
+ t = sqrt(t);
+ k = sqpii / t;
+ z = 1.0/zeta;
+ zz = z * z;
+ uf = 1.0 + zz * polevl( zz, AFN, 8 ) / p1evl( zz, AFD, 9 );
+ ug = z * polevl( zz, AGN, 10 ) / p1evl( zz, AGD, 10 );
+ theta = zeta + 0.25 * PI;
+ f = sin( theta );
+ g = cos( theta );
+ *ai = k * (f * uf - g * ug);
+ *bi = k * (g * uf + f * ug);
+ uf = 1.0 + zz * polevl( zz, APFN, 8 ) / p1evl( zz, APFD, 9 );
+ ug = z * polevl( zz, APGN, 10 ) / p1evl( 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 = sqrt(x);
+ zeta = 2.0 * x * t / 3.0;
+ g = exp( zeta );
+ t = sqrt(t);
+ k = 2.0 * t * g;
+ z = 1.0/zeta;
+ f = polevl( z, AN, 7 ) / polevl( z, AD, 7 );
+ *ai = sqpii * f / k;
+ k = -0.5 * sqpii * t / g;
+ f = polevl( z, APN, 7 ) / polevl( z, APD, 7 );
+ *aip = f * k;
+
+ if( x > 8.3203353 ) /* zeta > 16 */
+ {
+ f = z * polevl( z, BN16, 4 ) / p1evl( z, BD16, 5 );
+ k = sqpii * g;
+ *bi = k * (1.0 + f) / t;
+ f = z * polevl( z, BPPN, 4 ) / p1evl( 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 > MACHEP )
+ {
+ 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 = fabs(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 > MACHEP )
+ {
+ 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 = fabs(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/double/arcdot.c b/libm/double/arcdot.c
new file mode 100644
index 000000000..44c057229
--- /dev/null
+++ b/libm/double/arcdot.c
@@ -0,0 +1,110 @@
+/* arcdot.c
+ *
+ * Angle between two vectors
+ *
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double p[3], q[3], arcdot();
+ *
+ * y = arcdot( p, q );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * For two vectors p, q, the angle A between them is given by
+ *
+ * p.q / (|p| |q|) = cos A .
+ *
+ * where "." represents inner product, "|x|" the length of vector x.
+ * If the angle is small, an expression in sin A is preferred.
+ * Set r = q - p. Then
+ *
+ * p.q = p.p + p.r ,
+ *
+ * |p|^2 = p.p ,
+ *
+ * |q|^2 = p.p + 2 p.r + r.r ,
+ *
+ * p.p^2 + 2 p.p p.r + p.r^2
+ * cos^2 A = ----------------------------
+ * p.p (p.p + 2 p.r + r.r)
+ *
+ * p.p + 2 p.r + p.r^2 / p.p
+ * = --------------------------- ,
+ * p.p + 2 p.r + r.r
+ *
+ * sin^2 A = 1 - cos^2 A
+ *
+ * r.r - p.r^2 / p.p
+ * = --------------------
+ * p.p + 2 p.r + r.r
+ *
+ * = (r.r - p.r^2 / p.p) / q.q .
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE -1, 1 10^6 1.7e-16 4.2e-17
+ *
+ */
+
+/*
+Cephes Math Library Release 2.3: November, 1995
+Copyright 1995 by Stephen L. Moshier
+*/
+
+#include <math.h>
+#ifdef ANSIPROT
+extern double sqrt ( double );
+extern double acos ( double );
+extern double asin ( double );
+extern double atan ( double );
+#else
+double sqrt(), acos(), asin(), atan();
+#endif
+extern double PI;
+
+double arcdot(p,q)
+double p[], q[];
+{
+double pp, pr, qq, rr, rt, pt, qt, pq;
+int i;
+
+pq = 0.0;
+qq = 0.0;
+pp = 0.0;
+pr = 0.0;
+rr = 0.0;
+for (i=0; i<3; i++)
+ {
+ pt = p[i];
+ qt = q[i];
+ pq += pt * qt;
+ qq += qt * qt;
+ pp += pt * pt;
+ rt = qt - pt;
+ pr += pt * rt;
+ rr += rt * rt;
+ }
+if (rr == 0.0 || pp == 0.0 || qq == 0.0)
+ return 0.0;
+rt = (rr - (pr * pr) / pp) / qq;
+if (rt <= 0.75)
+ {
+ rt = sqrt(rt);
+ qt = asin(rt);
+ if (pq < 0.0)
+ qt = PI - qt;
+ }
+else
+ {
+ pt = pq / sqrt(pp*qq);
+ qt = acos(pt);
+ }
+return qt;
+}
diff --git a/libm/double/asin.c b/libm/double/asin.c
new file mode 100644
index 000000000..1f83eccc8
--- /dev/null
+++ b/libm/double/asin.c
@@ -0,0 +1,324 @@
+/* asin.c
+ *
+ * Inverse circular sine
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, asin();
+ *
+ * y = asin( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns radian angle between -pi/2 and +pi/2 whose sine is x.
+ *
+ * A rational function of the form x + x**3 P(x**2)/Q(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
+ * DEC -1, 1 40000 2.6e-17 7.1e-18
+ * IEEE -1, 1 10^6 1.9e-16 5.4e-17
+ *
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * asin domain |x| > 1 NAN
+ *
+ */
+ /* acos()
+ *
+ * Inverse circular cosine
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, acos();
+ *
+ * y = acos( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns radian angle between 0 and pi 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
+ * DEC -1, 1 50000 3.3e-17 8.2e-18
+ * IEEE -1, 1 10^6 2.2e-16 6.5e-17
+ *
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * asin domain |x| > 1 NAN
+ */
+
+/* asin.c */
+
+/*
+Cephes Math Library Release 2.8: June, 2000
+Copyright 1984, 1995, 2000 by Stephen L. Moshier
+*/
+
+#include <math.h>
+
+/* arcsin(x) = x + x^3 P(x^2)/Q(x^2)
+ 0 <= x <= 0.625
+ Peak relative error = 1.2e-18 */
+#if UNK
+static double P[6] = {
+ 4.253011369004428248960E-3,
+-6.019598008014123785661E-1,
+ 5.444622390564711410273E0,
+-1.626247967210700244449E1,
+ 1.956261983317594739197E1,
+-8.198089802484824371615E0,
+};
+static double Q[5] = {
+/* 1.000000000000000000000E0, */
+-1.474091372988853791896E1,
+ 7.049610280856842141659E1,
+-1.471791292232726029859E2,
+ 1.395105614657485689735E2,
+-4.918853881490881290097E1,
+};
+#endif
+#if DEC
+static short P[24] = {
+0036213,0056330,0057244,0053234,
+0140032,0015011,0114762,0160255,
+0040656,0035130,0136121,0067313,
+0141202,0014616,0170474,0101731,
+0041234,0100076,0151674,0111310,
+0141003,0025540,0033165,0077246,
+};
+static short Q[20] = {
+/* 0040200,0000000,0000000,0000000, */
+0141153,0155310,0055360,0072530,
+0041614,0177001,0027764,0101237,
+0142023,0026733,0064653,0133266,
+0042013,0101264,0023775,0176351,
+0141504,0140420,0050660,0036543,
+};
+#endif
+#if IBMPC
+static short P[24] = {
+0x8ad3,0x0bd4,0x6b9b,0x3f71,
+0x5c16,0x333e,0x4341,0xbfe3,
+0x2dd9,0x178a,0xc74b,0x4015,
+0x907b,0xde27,0x4331,0xc030,
+0x9259,0xda77,0x9007,0x4033,
+0xafd5,0x06ce,0x656c,0xc020,
+};
+static short Q[20] = {
+/* 0x0000,0x0000,0x0000,0x3ff0, */
+0x0eab,0x0b5e,0x7b59,0xc02d,
+0x9054,0x25fe,0x9fc0,0x4051,
+0x76d7,0x6d35,0x65bb,0xc062,
+0xbf9d,0x84ff,0x7056,0x4061,
+0x07ac,0x0a36,0x9822,0xc048,
+};
+#endif
+#if MIEEE
+static short P[24] = {
+0x3f71,0x6b9b,0x0bd4,0x8ad3,
+0xbfe3,0x4341,0x333e,0x5c16,
+0x4015,0xc74b,0x178a,0x2dd9,
+0xc030,0x4331,0xde27,0x907b,
+0x4033,0x9007,0xda77,0x9259,
+0xc020,0x656c,0x06ce,0xafd5,
+};
+static short Q[20] = {
+/* 0x3ff0,0x0000,0x0000,0x0000, */
+0xc02d,0x7b59,0x0b5e,0x0eab,
+0x4051,0x9fc0,0x25fe,0x9054,
+0xc062,0x65bb,0x6d35,0x76d7,
+0x4061,0x7056,0x84ff,0xbf9d,
+0xc048,0x9822,0x0a36,0x07ac,
+};
+#endif
+
+/* arcsin(1-x) = pi/2 - sqrt(2x)(1+R(x))
+ 0 <= x <= 0.5
+ Peak relative error = 4.2e-18 */
+#if UNK
+static double R[5] = {
+ 2.967721961301243206100E-3,
+-5.634242780008963776856E-1,
+ 6.968710824104713396794E0,
+-2.556901049652824852289E1,
+ 2.853665548261061424989E1,
+};
+static double S[4] = {
+/* 1.000000000000000000000E0, */
+-2.194779531642920639778E1,
+ 1.470656354026814941758E2,
+-3.838770957603691357202E2,
+ 3.424398657913078477438E2,
+};
+#endif
+#if DEC
+static short R[20] = {
+0036102,0077034,0142164,0174103,
+0140020,0036222,0147711,0044173,
+0040736,0177655,0153631,0171523,
+0141314,0106525,0060015,0055474,
+0041344,0045422,0003630,0040344,
+};
+static short S[16] = {
+/* 0040200,0000000,0000000,0000000, */
+0141257,0112425,0132772,0166136,
+0042023,0010315,0075523,0175020,
+0142277,0170104,0126203,0017563,
+0042253,0034115,0102662,0022757,
+};
+#endif
+#if IBMPC
+static short R[20] = {
+0x9f08,0x988e,0x4fc3,0x3f68,
+0x290f,0x59f9,0x0792,0xbfe2,
+0x3e6a,0xbaf3,0xdff5,0x401b,
+0xab68,0xac01,0x91aa,0xc039,
+0x081d,0x40f3,0x8962,0x403c,
+};
+static short S[16] = {
+/* 0x0000,0x0000,0x0000,0x3ff0, */
+0x5d8c,0xb6bf,0xf2a2,0xc035,
+0x7f42,0xaf6a,0x6219,0x4062,
+0x63ee,0x9590,0xfe08,0xc077,
+0x44be,0xb0b6,0x6709,0x4075,
+};
+#endif
+#if MIEEE
+static short R[20] = {
+0x3f68,0x4fc3,0x988e,0x9f08,
+0xbfe2,0x0792,0x59f9,0x290f,
+0x401b,0xdff5,0xbaf3,0x3e6a,
+0xc039,0x91aa,0xac01,0xab68,
+0x403c,0x8962,0x40f3,0x081d,
+};
+static short S[16] = {
+/* 0x3ff0,0x0000,0x0000,0x0000, */
+0xc035,0xf2a2,0xb6bf,0x5d8c,
+0x4062,0x6219,0xaf6a,0x7f42,
+0xc077,0xfe08,0x9590,0x63ee,
+0x4075,0x6709,0xb0b6,0x44be,
+};
+#endif
+
+/* pi/2 = PIO2 + MOREBITS. */
+#ifdef DEC
+#define MOREBITS 5.721188726109831840122E-18
+#else
+#define MOREBITS 6.123233995736765886130E-17
+#endif
+
+#ifdef ANSIPROT
+extern double polevl ( double, void *, int );
+extern double p1evl ( double, void *, int );
+extern double sqrt ( double );
+double asin ( double );
+#else
+double sqrt(), polevl(), p1evl();
+double asin();
+#endif
+extern double PIO2, PIO4, NAN;
+
+double asin(x)
+double x;
+{
+double a, p, z, zz;
+short sign;
+
+if( x > 0 )
+ {
+ sign = 1;
+ a = x;
+ }
+else
+ {
+ sign = -1;
+ a = -x;
+ }
+
+if( a > 1.0 )
+ {
+ mtherr( "asin", DOMAIN );
+ return( NAN );
+ }
+
+if( a > 0.625 )
+ {
+ /* arcsin(1-x) = pi/2 - sqrt(2x)(1+R(x)) */
+ zz = 1.0 - a;
+ p = zz * polevl( zz, R, 4)/p1evl( zz, S, 4);
+ zz = sqrt(zz+zz);
+ z = PIO4 - zz;
+ zz = zz * p - MOREBITS;
+ z = z - zz;
+ z = z + PIO4;
+ }
+else
+ {
+ if( a < 1.0e-8 )
+ {
+ return(x);
+ }
+ zz = a * a;
+ z = zz * polevl( zz, P, 5)/p1evl( zz, Q, 5);
+ z = a * z + a;
+ }
+if( sign < 0 )
+ z = -z;
+return(z);
+}
+
+
+
+double acos(x)
+double x;
+{
+double z;
+
+if( (x < -1.0) || (x > 1.0) )
+ {
+ mtherr( "acos", DOMAIN );
+ return( NAN );
+ }
+if( x > 0.5 )
+ {
+ return( 2.0 * asin( sqrt(0.5 - 0.5*x) ) );
+ }
+z = PIO4 - asin(x);
+z = z + MOREBITS;
+z = z + PIO4;
+return( z );
+}
diff --git a/libm/double/asinh.c b/libm/double/asinh.c
new file mode 100644
index 000000000..57966d264
--- /dev/null
+++ b/libm/double/asinh.c
@@ -0,0 +1,165 @@
+/* asinh.c
+ *
+ * Inverse hyperbolic sine
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, asinh();
+ *
+ * y = asinh( 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
+ * DEC -3,3 75000 4.6e-17 1.1e-17
+ * IEEE -1,1 30000 3.7e-16 7.8e-17
+ * IEEE 1,3 30000 2.5e-16 6.7e-17
+ *
+ */
+
+/* asinh.c */
+
+/*
+Cephes Math Library Release 2.8: June, 2000
+Copyright 1984, 1995, 2000 by Stephen L. Moshier
+*/
+
+
+#include <math.h>
+
+#ifdef UNK
+static double P[] = {
+-4.33231683752342103572E-3,
+-5.91750212056387121207E-1,
+-4.37390226194356683570E0,
+-9.09030533308377316566E0,
+-5.56682227230859640450E0
+};
+static double Q[] = {
+/* 1.00000000000000000000E0,*/
+ 1.28757002067426453537E1,
+ 4.86042483805291788324E1,
+ 6.95722521337257608734E1,
+ 3.34009336338516356383E1
+};
+#endif
+
+#ifdef DEC
+static unsigned short P[] = {
+0136215,0173033,0110410,0105475,
+0140027,0076361,0020056,0164520,
+0140613,0173401,0160136,0053142,
+0141021,0070744,0000503,0176261,
+0140662,0021550,0073106,0133351
+};
+static unsigned short Q[] = {
+/* 0040200,0000000,0000000,0000000,*/
+0041116,0001336,0034120,0173054,
+0041502,0065300,0013144,0021231,
+0041613,0022376,0035516,0153063,
+0041405,0115216,0054265,0004557
+};
+#endif
+
+#ifdef IBMPC
+static unsigned short P[] = {
+0x1168,0x7221,0xbec3,0xbf71,
+0xdd2a,0x2405,0xef9e,0xbfe2,
+0xcacc,0x3c0b,0x7ee0,0xc011,
+0x7f96,0x8028,0x2e3c,0xc022,
+0xd6dd,0x0ec8,0x446d,0xc016
+};
+static unsigned short Q[] = {
+/* 0x0000,0x0000,0x0000,0x3ff0,*/
+0x1ec5,0xc70a,0xc05b,0x4029,
+0x8453,0x02cc,0x4d58,0x4048,
+0xdac6,0xc769,0x649f,0x4051,
+0xa12e,0xcb16,0xb351,0x4040
+};
+#endif
+
+#ifdef MIEEE
+static unsigned short P[] = {
+0xbf71,0xbec3,0x7221,0x1168,
+0xbfe2,0xef9e,0x2405,0xdd2a,
+0xc011,0x7ee0,0x3c0b,0xcacc,
+0xc022,0x2e3c,0x8028,0x7f96,
+0xc016,0x446d,0x0ec8,0xd6dd
+};
+static unsigned short Q[] = {
+0x4029,0xc05b,0xc70a,0x1ec5,
+0x4048,0x4d58,0x02cc,0x8453,
+0x4051,0x649f,0xc769,0xdac6,
+0x4040,0xb351,0xcb16,0xa12e
+};
+#endif
+
+#ifdef ANSIPROT
+extern double polevl ( double, void *, int );
+extern double p1evl ( double, void *, int );
+extern double sqrt ( double );
+extern double log ( double );
+#else
+double log(), sqrt(), polevl(), p1evl();
+#endif
+extern double LOGE2, INFINITY;
+
+double asinh(xx)
+double xx;
+{
+double a, z, x;
+int sign;
+
+#ifdef MINUSZERO
+if( xx == 0.0 )
+ return(xx);
+#endif
+if( xx < 0.0 )
+ {
+ sign = -1;
+ x = -xx;
+ }
+else
+ {
+ sign = 1;
+ x = xx;
+ }
+
+if( x > 1.0e8 )
+ {
+#ifdef INFINITIES
+ if( x == INFINITY )
+ return(xx);
+#endif
+ return( sign * (log(x) + LOGE2) );
+ }
+
+z = x * x;
+if( x < 0.5 )
+ {
+ a = ( polevl(z, P, 4)/p1evl(z, Q, 4) ) * z;
+ a = a * x + x;
+ if( sign < 0 )
+ a = -a;
+ return(a);
+ }
+
+a = sqrt( z + 1.0 );
+return( sign * log(x + a) );
+}
diff --git a/libm/double/atan.c b/libm/double/atan.c
new file mode 100644
index 000000000..f2d50768d
--- /dev/null
+++ b/libm/double/atan.c
@@ -0,0 +1,393 @@
+/* atan.c
+ *
+ * Inverse circular tangent
+ * (arctangent)
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, atan();
+ *
+ * y = atan( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns radian angle between -pi/2 and +pi/2 whose tangent
+ * is x.
+ *
+ * Range reduction is from three intervals into the interval
+ * from zero to 0.66. The approximant uses a rational
+ * function of degree 4/5 of the form x + x**3 P(x)/Q(x).
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * DEC -10, 10 50000 2.4e-17 8.3e-18
+ * IEEE -10, 10 10^6 1.8e-16 5.0e-17
+ *
+ */
+ /* atan2()
+ *
+ * Quadrant correct inverse circular tangent
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, z, atan2();
+ *
+ * z = atan2( 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 10^6 2.5e-16 6.9e-17
+ * See atan.c.
+ *
+ */
+
+/* atan.c */
+
+
+/*
+Cephes Math Library Release 2.8: June, 2000
+Copyright 1984, 1995, 2000 by Stephen L. Moshier
+*/
+
+
+#include <math.h>
+
+/* arctan(x) = x + x^3 P(x^2)/Q(x^2)
+ 0 <= x <= 0.66
+ Peak relative error = 2.6e-18 */
+#ifdef UNK
+static double P[5] = {
+-8.750608600031904122785E-1,
+-1.615753718733365076637E1,
+-7.500855792314704667340E1,
+-1.228866684490136173410E2,
+-6.485021904942025371773E1,
+};
+static double Q[5] = {
+/* 1.000000000000000000000E0, */
+ 2.485846490142306297962E1,
+ 1.650270098316988542046E2,
+ 4.328810604912902668951E2,
+ 4.853903996359136964868E2,
+ 1.945506571482613964425E2,
+};
+
+/* tan( 3*pi/8 ) */
+static double T3P8 = 2.41421356237309504880;
+#endif
+
+#ifdef DEC
+static short P[20] = {
+0140140,0001775,0007671,0026242,
+0141201,0041242,0155534,0001715,
+0141626,0002141,0132100,0011625,
+0141765,0142771,0064055,0150453,
+0141601,0131517,0164507,0062164,
+};
+static short Q[20] = {
+/* 0040200,0000000,0000000,0000000, */
+0041306,0157042,0154243,0000742,
+0042045,0003352,0016707,0150452,
+0042330,0070306,0113425,0170730,
+0042362,0130770,0116602,0047520,
+0042102,0106367,0156753,0013541,
+};
+
+/* tan( 3*pi/8 ) = 2.41421356237309504880 */
+static unsigned short T3P8A[] = {040432,0101171,0114774,0167462,};
+#define T3P8 *(double *)T3P8A
+#endif
+
+#ifdef IBMPC
+static short P[20] = {
+0x2594,0xa1f7,0x007f,0xbfec,
+0x807a,0x5b6b,0x2854,0xc030,
+0x0273,0x3688,0xc08c,0xc052,
+0xba25,0x2d05,0xb8bf,0xc05e,
+0xec8e,0xfd28,0x3669,0xc050,
+};
+static short Q[20] = {
+/* 0x0000,0x0000,0x0000,0x3ff0, */
+0x603c,0x5b14,0xdbc4,0x4038,
+0xfa25,0x43b8,0xa0dd,0x4064,
+0xbe3b,0xd2e2,0x0e18,0x407b,
+0x49ea,0x13b0,0x563f,0x407e,
+0x62ec,0xfbbd,0x519e,0x4068,
+};
+
+/* tan( 3*pi/8 ) = 2.41421356237309504880 */
+static unsigned short T3P8A[] = {0x9de6,0x333f,0x504f,0x4003};
+#define T3P8 *(double *)T3P8A
+#endif
+
+#ifdef MIEEE
+static short P[20] = {
+0xbfec,0x007f,0xa1f7,0x2594,
+0xc030,0x2854,0x5b6b,0x807a,
+0xc052,0xc08c,0x3688,0x0273,
+0xc05e,0xb8bf,0x2d05,0xba25,
+0xc050,0x3669,0xfd28,0xec8e,
+};
+static short Q[20] = {
+/* 0x3ff0,0x0000,0x0000,0x0000, */
+0x4038,0xdbc4,0x5b14,0x603c,
+0x4064,0xa0dd,0x43b8,0xfa25,
+0x407b,0x0e18,0xd2e2,0xbe3b,
+0x407e,0x563f,0x13b0,0x49ea,
+0x4068,0x519e,0xfbbd,0x62ec,
+};
+
+/* tan( 3*pi/8 ) = 2.41421356237309504880 */
+static unsigned short T3P8A[] = {
+0x4003,0x504f,0x333f,0x9de6
+};
+#define T3P8 *(double *)T3P8A
+#endif
+
+#ifdef ANSIPROT
+extern double polevl ( double, void *, int );
+extern double p1evl ( double, void *, int );
+extern double atan ( double );
+extern double fabs ( double );
+extern int signbit ( double );
+extern int isnan ( double );
+#else
+double polevl(), p1evl(), atan(), fabs();
+//int signbit(), isnan();
+#endif
+extern double PI, PIO2, PIO4, INFINITY, NEGZERO, MAXNUM;
+
+/* pi/2 = PIO2 + MOREBITS. */
+#ifdef DEC
+#define MOREBITS 5.721188726109831840122E-18
+#else
+#define MOREBITS 6.123233995736765886130E-17
+#endif
+
+
+double atan(x)
+double x;
+{
+double y, z;
+short sign, flag;
+
+#ifdef MINUSZERO
+if( x == 0.0 )
+ return(x);
+#endif
+#ifdef INFINITIES
+if(x == INFINITY)
+ return(PIO2);
+if(x == -INFINITY)
+ return(-PIO2);
+#endif
+/* make argument positive and save the sign */
+sign = 1;
+if( x < 0.0 )
+ {
+ sign = -1;
+ x = -x;
+ }
+/* range reduction */
+flag = 0;
+if( x > T3P8 )
+ {
+ y = PIO2;
+ flag = 1;
+ x = -( 1.0/x );
+ }
+else if( x <= 0.66 )
+ {
+ y = 0.0;
+ }
+else
+ {
+ y = PIO4;
+ flag = 2;
+ x = (x-1.0)/(x+1.0);
+ }
+z = x * x;
+z = z * polevl( z, P, 4 ) / p1evl( z, Q, 5 );
+z = x * z + x;
+if( flag == 2 )
+ z += 0.5 * MOREBITS;
+else if( flag == 1 )
+ z += MOREBITS;
+y = y + z;
+if( sign < 0 )
+ y = -y;
+return(y);
+}
+
+/* atan2 */
+
+#ifdef ANSIC
+double atan2( y, x )
+#else
+double atan2( x, y )
+#endif
+double x, y;
+{
+double z, w;
+short code;
+
+code = 0;
+
+#ifdef NANS
+if( isnan(x) )
+ return(x);
+if( isnan(y) )
+ return(y);
+#endif
+#ifdef MINUSZERO
+if( y == 0.0 )
+ {
+ if( signbit(y) )
+ {
+ if( x > 0.0 )
+ z = y;
+ else if( x < 0.0 )
+ z = -PI;
+ else
+ {
+ if( signbit(x) )
+ z = -PI;
+ else
+ z = y;
+ }
+ }
+ else /* y is +0 */
+ {
+ if( x == 0.0 )
+ {
+ if( signbit(x) )
+ z = PI;
+ else
+ z = 0.0;
+ }
+ else if( x > 0.0 )
+ z = 0.0;
+ else
+ z = PI;
+ }
+ return z;
+ }
+if( x == 0.0 )
+ {
+ if( y > 0.0 )
+ z = PIO2;
+ else
+ z = -PIO2;
+ return z;
+ }
+#endif /* MINUSZERO */
+#ifdef INFINITIES
+if( x == INFINITY )
+ {
+ if( y == INFINITY )
+ z = 0.25 * PI;
+ else if( y == -INFINITY )
+ z = -0.25 * PI;
+ else if( y < 0.0 )
+ z = NEGZERO;
+ else
+ z = 0.0;
+ return z;
+ }
+if( x == -INFINITY )
+ {
+ if( y == INFINITY )
+ z = 0.75 * PI;
+ else if( y <= -INFINITY )
+ z = -0.75 * PI;
+ else if( y >= 0.0 )
+ z = PI;
+ else
+ z = -PI;
+ return z;
+ }
+if( y == INFINITY )
+ return( PIO2 );
+if( y == -INFINITY )
+ return( -PIO2 );
+#endif
+
+if( x < 0.0 )
+ code = 2;
+if( y < 0.0 )
+ code |= 1;
+
+#ifdef INFINITIES
+if( x == 0.0 )
+#else
+if( fabs(x) <= (fabs(y) / MAXNUM) )
+#endif
+ {
+ if( code & 1 )
+ {
+#if ANSIC
+ return( -PIO2 );
+#else
+ return( 3.0*PIO2 );
+#endif
+ }
+ if( y == 0.0 )
+ return( 0.0 );
+ return( PIO2 );
+ }
+
+if( y == 0.0 )
+ {
+ if( code & 2 )
+ return( PI );
+ return( 0.0 );
+ }
+
+
+switch( code )
+ {
+#if ANSIC
+ default:
+ case 0:
+ case 1: w = 0.0; break;
+ case 2: w = PI; break;
+ case 3: w = -PI; break;
+#else
+ default:
+ case 0: w = 0.0; break;
+ case 1: w = 2.0 * PI; break;
+ case 2:
+ case 3: w = PI; break;
+#endif
+ }
+
+z = w + atan( y/x );
+#ifdef MINUSZERO
+if( z == 0.0 && y < 0 )
+ z = NEGZERO;
+#endif
+return( z );
+}
diff --git a/libm/double/atanh.c b/libm/double/atanh.c
new file mode 100644
index 000000000..7bb742d3d
--- /dev/null
+++ b/libm/double/atanh.c
@@ -0,0 +1,156 @@
+/* atanh.c
+ *
+ * Inverse hyperbolic tangent
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, atanh();
+ *
+ * y = atanh( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns inverse hyperbolic tangent of argument in the range
+ * MINLOG to MAXLOG.
+ *
+ * If |x| < 0.5, the rational form x + x**3 P(x)/Q(x) is
+ * employed. Otherwise,
+ * atanh(x) = 0.5 * log( (1+x)/(1-x) ).
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * DEC -1,1 50000 2.4e-17 6.4e-18
+ * IEEE -1,1 30000 1.9e-16 5.2e-17
+ *
+ */
+
+/* atanh.c */
+
+
+/*
+Cephes Math Library Release 2.8: June, 2000
+Copyright (C) 1987, 1995, 2000 by Stephen L. Moshier
+*/
+
+#include <math.h>
+
+#ifdef UNK
+static double P[] = {
+-8.54074331929669305196E-1,
+ 1.20426861384072379242E1,
+-4.61252884198732692637E1,
+ 6.54566728676544377376E1,
+-3.09092539379866942570E1
+};
+static double Q[] = {
+/* 1.00000000000000000000E0,*/
+-1.95638849376911654834E1,
+ 1.08938092147140262656E2,
+-2.49839401325893582852E2,
+ 2.52006675691344555838E2,
+-9.27277618139601130017E1
+};
+#endif
+#ifdef DEC
+static unsigned short P[] = {
+0140132,0122235,0105775,0130300,
+0041100,0127327,0124407,0034722,
+0141470,0100113,0115607,0130535,
+0041602,0164721,0003257,0013673,
+0141367,0043046,0166673,0045750
+};
+static unsigned short Q[] = {
+/*0040200,0000000,0000000,0000000,*/
+0141234,0101326,0015460,0134564,
+0041731,0160115,0116451,0032045,
+0142171,0153343,0000532,0167226,
+0042174,0000665,0077604,0000310,
+0141671,0072235,0031114,0074377
+};
+#endif
+
+#ifdef IBMPC
+static unsigned short P[] = {
+0xb618,0xb17f,0x5493,0xbfeb,
+0xe73a,0xf520,0x15da,0x4028,
+0xf62c,0x7370,0x1009,0xc047,
+0xe2f7,0x20d5,0x5d3a,0x4050,
+0x697d,0xddb7,0xe8c4,0xc03e
+};
+static unsigned short Q[] = {
+/*0x0000,0x0000,0x0000,0x3ff0,*/
+0x172f,0xc366,0x905a,0xc033,
+0x2685,0xb3a5,0x3c09,0x405b,
+0x5dd3,0x602b,0x3adc,0xc06f,
+0x8019,0xaff0,0x8036,0x406f,
+0x8f20,0xa649,0x2e93,0xc057
+};
+#endif
+
+#ifdef MIEEE
+static unsigned short P[] = {
+0xbfeb,0x5493,0xb17f,0xb618,
+0x4028,0x15da,0xf520,0xe73a,
+0xc047,0x1009,0x7370,0xf62c,
+0x4050,0x5d3a,0x20d5,0xe2f7,
+0xc03e,0xe8c4,0xddb7,0x697d
+};
+static unsigned short Q[] = {
+0xc033,0x905a,0xc366,0x172f,
+0x405b,0x3c09,0xb3a5,0x2685,
+0xc06f,0x3adc,0x602b,0x5dd3,
+0x406f,0x8036,0xaff0,0x8019,
+0xc057,0x2e93,0xa649,0x8f20
+};
+#endif
+
+#ifdef ANSIPROT
+extern double fabs ( double );
+extern double log ( double x );
+extern double polevl ( double x, void *P, int N );
+extern double p1evl ( double x, void *P, int N );
+#else
+double fabs(), log(), polevl(), p1evl();
+#endif
+extern double INFINITY, NAN;
+
+double atanh(x)
+double x;
+{
+double s, z;
+
+#ifdef MINUSZERO
+if( x == 0.0 )
+ return(x);
+#endif
+z = fabs(x);
+if( z >= 1.0 )
+ {
+ if( x == 1.0 )
+ return( INFINITY );
+ if( x == -1.0 )
+ return( -INFINITY );
+ mtherr( "atanh", DOMAIN );
+ return( NAN );
+ }
+
+if( z < 1.0e-7 )
+ return(x);
+
+if( z < 0.5 )
+ {
+ z = x * x;
+ s = x + x * z * (polevl(z, P, 4) / p1evl(z, Q, 5));
+ return(s);
+ }
+
+return( 0.5 * log((1.0+x)/(1.0-x)) );
+}
diff --git a/libm/double/bdtr.c b/libm/double/bdtr.c
new file mode 100644
index 000000000..a268c7a10
--- /dev/null
+++ b/libm/double/bdtr.c
@@ -0,0 +1,263 @@
+/* bdtr.c
+ *
+ * Binomial distribution
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * int k, n;
+ * double p, y, bdtr();
+ *
+ * y = bdtr( 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:
+ *
+ * Tested at random points (a,b,p), with p between 0 and 1.
+ *
+ * a,b Relative error:
+ * arithmetic domain # trials peak rms
+ * For p between 0.001 and 1:
+ * IEEE 0,100 100000 4.3e-15 2.6e-16
+ * See also incbet.c.
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * bdtr domain k < 0 0.0
+ * n < k
+ * x < 0, x > 1
+ */
+ /* bdtrc()
+ *
+ * Complemented binomial distribution
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * int k, n;
+ * double p, y, bdtrc();
+ *
+ * y = bdtrc( 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:
+ *
+ * Tested at random points (a,b,p).
+ *
+ * a,b Relative error:
+ * arithmetic domain # trials peak rms
+ * For p between 0.001 and 1:
+ * IEEE 0,100 100000 6.7e-15 8.2e-16
+ * For p between 0 and .001:
+ * IEEE 0,100 100000 1.5e-13 2.7e-15
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * bdtrc domain x<0, x>1, n<k 0.0
+ */
+ /* bdtri()
+ *
+ * Inverse binomial distribution
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * int k, n;
+ * double p, y, bdtri();
+ *
+ * p = bdtr( 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:
+ *
+ * Tested at random points (a,b,p).
+ *
+ * a,b Relative error:
+ * arithmetic domain # trials peak rms
+ * For p between 0.001 and 1:
+ * IEEE 0,100 100000 2.3e-14 6.4e-16
+ * IEEE 0,10000 100000 6.6e-12 1.2e-13
+ * For p between 10^-6 and 0.001:
+ * IEEE 0,100 100000 2.0e-12 1.3e-14
+ * IEEE 0,10000 100000 1.5e-12 3.2e-14
+ * See also incbi.c.
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * bdtri domain k < 0, n <= k 0.0
+ * x < 0, x > 1
+ */
+
+/* bdtr() */
+
+
+/*
+Cephes Math Library Release 2.8: June, 2000
+Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier
+*/
+
+#include <math.h>
+#ifdef ANSIPROT
+extern double incbet ( double, double, double );
+extern double incbi ( double, double, double );
+extern double pow ( double, double );
+extern double log1p ( double );
+extern double expm1 ( double );
+#else
+double incbet(), incbi(), pow(), log1p(), expm1();
+#endif
+
+double bdtrc( k, n, p )
+int k, n;
+double p;
+{
+double dk, dn;
+
+if( (p < 0.0) || (p > 1.0) )
+ goto domerr;
+if( k < 0 )
+ return( 1.0 );
+
+if( n < k )
+ {
+domerr:
+ mtherr( "bdtrc", DOMAIN );
+ return( 0.0 );
+ }
+
+if( k == n )
+ return( 0.0 );
+dn = n - k;
+if( k == 0 )
+ {
+ if( p < .01 )
+ dk = -expm1( dn * log1p(-p) );
+ else
+ dk = 1.0 - pow( 1.0-p, dn );
+ }
+else
+ {
+ dk = k + 1;
+ dk = incbet( dk, dn, p );
+ }
+return( dk );
+}
+
+
+
+double bdtr( k, n, p )
+int k, n;
+double p;
+{
+double dk, dn;
+
+if( (p < 0.0) || (p > 1.0) )
+ goto domerr;
+if( (k < 0) || (n < k) )
+ {
+domerr:
+ mtherr( "bdtr", DOMAIN );
+ return( 0.0 );
+ }
+
+if( k == n )
+ return( 1.0 );
+
+dn = n - k;
+if( k == 0 )
+ {
+ dk = pow( 1.0-p, dn );
+ }
+else
+ {
+ dk = k + 1;
+ dk = incbet( dn, dk, 1.0 - p );
+ }
+return( dk );
+}
+
+
+double bdtri( k, n, y )
+int k, n;
+double y;
+{
+double dk, dn, p;
+
+if( (y < 0.0) || (y > 1.0) )
+ goto domerr;
+if( (k < 0) || (n <= k) )
+ {
+domerr:
+ mtherr( "bdtri", DOMAIN );
+ return( 0.0 );
+ }
+
+dn = n - k;
+if( k == 0 )
+ {
+ if( y > 0.8 )
+ p = -expm1( log1p(y-1.0) / dn );
+ else
+ p = 1.0 - pow( y, 1.0/dn );
+ }
+else
+ {
+ dk = k + 1;
+ p = incbet( dn, dk, 0.5 );
+ if( p > 0.5 )
+ p = incbi( dk, dn, 1.0-y );
+ else
+ p = 1.0 - incbi( dn, dk, y );
+ }
+return( p );
+}
diff --git a/libm/double/bernum.c b/libm/double/bernum.c
new file mode 100644
index 000000000..e401ff5df
--- /dev/null
+++ b/libm/double/bernum.c
@@ -0,0 +1,74 @@
+/* This program computes the Bernoulli numbers.
+ * See radd.c for rational arithmetic.
+ */
+
+typedef struct{
+ double n;
+ double d;
+ }fract;
+
+#define PD 44
+fract x[PD+1] = {0.0};
+fract p[PD+1] = {0.0};
+#include <math.h>
+#ifdef ANSIPROT
+extern double fabs ( double );
+extern double log10 ( double );
+#else
+double fabs(), log10();
+#endif
+extern double MACHEP;
+
+main()
+{
+int nx, np, nu;
+int i, j, k, n, sign;
+fract r, s, t;
+
+
+for(i=0; i<=PD; i++ )
+ {
+ x[i].n = 0.0;
+ x[i].d = 1.0;
+ p[i].n = 0.0;
+ p[i].d = 1.0;
+ }
+p[0].n = 1.0;
+p[0].d = 1.0;
+p[1].n = 1.0;
+p[1].d = 1.0;
+np = 1;
+x[0].n = 1.0;
+x[0].d = 1.0;
+
+for( n=1; n<PD-2; n++ )
+{
+
+/* Create line of Pascal's triangle */
+/* multiply p = u * p */
+for( k=0; k<=np; k++ )
+ {
+ radd( &p[np-k+1], &p[np-k], &p[np-k+1] );
+ }
+np += 1;
+
+/* B0 + nC1 B1 + ... + nCn-1 Bn-1 = 0 */
+s.n = 0.0;
+s.d = 1.0;
+
+for( i=0; i<n; i++ )
+ {
+ rmul( &p[i], &x[i], &t );
+ radd( &s, &t, &s );
+ }
+
+
+rdiv( &p[n], &s, &x[n] ); /* x[n] = -s/p[n] */
+x[n].n = -x[n].n;
+nx += 1;
+printf( "%2d %.15e / %.15e\n", n, x[n].n, x[n].d );
+}
+
+
+}
+
diff --git a/libm/double/beta.c b/libm/double/beta.c
new file mode 100644
index 000000000..410760f32
--- /dev/null
+++ b/libm/double/beta.c
@@ -0,0 +1,201 @@
+/* beta.c
+ *
+ * Beta function
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double a, b, y, beta();
+ *
+ * y = beta( 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
+ * DEC 0,30 1700 7.7e-15 1.5e-15
+ * IEEE 0,30 30000 8.1e-14 1.1e-14
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * beta overflow log(beta) > MAXLOG 0.0
+ * a or b <0 integer 0.0
+ *
+ */
+
+/* beta.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>
+
+#ifdef UNK
+#define MAXGAM 34.84425627277176174
+#endif
+#ifdef DEC
+#define MAXGAM 34.84425627277176174
+#endif
+#ifdef IBMPC
+#define MAXGAM 171.624376956302725
+#endif
+#ifdef MIEEE
+#define MAXGAM 171.624376956302725
+#endif
+
+#ifdef ANSIPROT
+extern double fabs ( double );
+extern double gamma ( double );
+extern double lgam ( double );
+extern double exp ( double );
+extern double log ( double );
+extern double floor ( double );
+#else
+double fabs(), gamma(), lgam(), exp(), log(), floor();
+#endif
+extern double MAXLOG, MAXNUM;
+extern int sgngam;
+
+double beta( a, b )
+double a, b;
+{
+double y;
+int sign;
+
+sign = 1;
+
+if( a <= 0.0 )
+ {
+ if( a == floor(a) )
+ goto over;
+ }
+if( b <= 0.0 )
+ {
+ if( b == floor(b) )
+ goto over;
+ }
+
+
+y = a + b;
+if( fabs(y) > MAXGAM )
+ {
+ y = lgam(y);
+ sign *= sgngam; /* keep track of the sign */
+ y = lgam(b) - y;
+ sign *= sgngam;
+ y = lgam(a) + y;
+ sign *= sgngam;
+ if( y > MAXLOG )
+ {
+over:
+ mtherr( "beta", OVERFLOW );
+ return( sign * MAXNUM );
+ }
+ return( sign * exp(y) );
+ }
+
+y = gamma(y);
+if( y == 0.0 )
+ goto over;
+
+if( a > b )
+ {
+ y = gamma(a)/y;
+ y *= gamma(b);
+ }
+else
+ {
+ y = gamma(b)/y;
+ y *= gamma(a);
+ }
+
+return(y);
+}
+
+
+
+/* Natural log of |beta|. Return the sign of beta in sgngam. */
+
+double lbeta( a, b )
+double a, b;
+{
+double y;
+int sign;
+
+sign = 1;
+
+if( a <= 0.0 )
+ {
+ if( a == floor(a) )
+ goto over;
+ }
+if( b <= 0.0 )
+ {
+ if( b == floor(b) )
+ goto over;
+ }
+
+
+y = a + b;
+if( fabs(y) > MAXGAM )
+ {
+ y = lgam(y);
+ sign *= sgngam; /* keep track of the sign */
+ y = lgam(b) - y;
+ sign *= sgngam;
+ y = lgam(a) + y;
+ sign *= sgngam;
+ sgngam = sign;
+ return( y );
+ }
+
+y = gamma(y);
+if( y == 0.0 )
+ {
+over:
+ mtherr( "lbeta", OVERFLOW );
+ return( sign * MAXNUM );
+ }
+
+if( a > b )
+ {
+ y = gamma(a)/y;
+ y *= gamma(b);
+ }
+else
+ {
+ y = gamma(b)/y;
+ y *= gamma(a);
+ }
+
+if( y < 0 )
+ {
+ sgngam = -1;
+ y = -y;
+ }
+else
+ sgngam = 1;
+
+return( log(y) );
+}
diff --git a/libm/double/btdtr.c b/libm/double/btdtr.c
new file mode 100644
index 000000000..633ba7591
--- /dev/null
+++ b/libm/double/btdtr.c
@@ -0,0 +1,64 @@
+
+/* btdtr.c
+ *
+ * Beta distribution
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double a, b, x, y, btdtr();
+ *
+ * y = btdtr( a, b, x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns the area from zero to x under the beta density
+ * function:
+ *
+ *
+ * x
+ * - -
+ * | (a+b) | | a-1 b-1
+ * P(x) = ---------- | t (1-t) dt
+ * - - | |
+ * | (a) | (b) -
+ * 0
+ *
+ *
+ * This function is identical to the incomplete beta
+ * integral function incbet(a, b, x).
+ *
+ * The complemented function is
+ *
+ * 1 - P(1-x) = incbet( b, a, x );
+ *
+ *
+ * ACCURACY:
+ *
+ * See incbet.c.
+ *
+ */
+
+/* btdtr() */
+
+
+/*
+Cephes Math Library Release 2.8: June, 2000
+Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier
+*/
+#include <math.h>
+#ifdef ANSIPROT
+extern double incbet ( double, double, double );
+#else
+double incbet();
+#endif
+
+double btdtr( a, b, x )
+double a, b, x;
+{
+
+return( incbet( a, b, x ) );
+}
diff --git a/libm/double/cbrt.c b/libm/double/cbrt.c
new file mode 100644
index 000000000..026207275
--- /dev/null
+++ b/libm/double/cbrt.c
@@ -0,0 +1,142 @@
+/* cbrt.c
+ *
+ * Cube root
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, cbrt();
+ *
+ * y = cbrt( 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 three times to converge to an accurate
+ * result.
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * DEC -10,10 200000 1.8e-17 6.2e-18
+ * IEEE 0,1e308 30000 1.5e-16 5.0e-17
+ *
+ */
+ /* cbrt.c */
+
+/*
+Cephes Math Library Release 2.8: June, 2000
+Copyright 1984, 1991, 2000 by Stephen L. Moshier
+*/
+
+
+#include <math.h>
+
+static double CBRT2 = 1.2599210498948731647672;
+static double CBRT4 = 1.5874010519681994747517;
+static double CBRT2I = 0.79370052598409973737585;
+static double CBRT4I = 0.62996052494743658238361;
+
+#ifdef ANSIPROT
+extern double frexp ( double, int * );
+extern double ldexp ( double, int );
+extern int isnan ( double );
+extern int isfinite ( double );
+#else
+double frexp(), ldexp();
+int isnan(), isfinite();
+#endif
+
+double cbrt(x)
+double x;
+{
+int e, rem, sign;
+double z;
+
+#ifdef NANS
+if( isnan(x) )
+ return x;
+#endif
+#ifdef INFINITIES
+if( !isfinite(x) )
+ return x;
+#endif
+if( x == 0 )
+ return( x );
+if( x > 0 )
+ sign = 1;
+else
+ {
+ sign = -1;
+ x = -x;
+ }
+
+z = x;
+/* extract power of 2, leaving
+ * mantissa between 0.5 and 1
+ */
+x = frexp( x, &e );
+
+/* Approximate cube root of number between .5 and 1,
+ * peak relative error = 9.2e-6
+ */
+x = (((-1.3466110473359520655053e-1 * x
+ + 5.4664601366395524503440e-1) * x
+ - 9.5438224771509446525043e-1) * x
+ + 1.1399983354717293273738e0 ) * x
+ + 4.0238979564544752126924e-1;
+
+/* 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 *= CBRT2I;
+ else if( rem == 2 )
+ x *= CBRT4I;
+ e = -e;
+ }
+
+/* multiply by power of 2 */
+x = ldexp( x, e );
+
+/* Newton iteration */
+x -= ( x - (z/(x*x)) )*0.33333333333333333333;
+#ifdef DEC
+x -= ( x - (z/(x*x)) )/3.0;
+#else
+x -= ( x - (z/(x*x)) )*0.33333333333333333333;
+#endif
+
+if( sign < 0 )
+ x = -x;
+return(x);
+}
diff --git a/libm/double/chbevl.c b/libm/double/chbevl.c
new file mode 100644
index 000000000..539388164
--- /dev/null
+++ b/libm/double/chbevl.c
@@ -0,0 +1,82 @@
+/* chbevl.c
+ *
+ * Evaluate Chebyshev series
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * int N;
+ * double x, y, coef[N], chebevl();
+ *
+ * y = chbevl( 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
+*/
+
+double chbevl( x, array, n )
+double x;
+double array[];
+int n;
+{
+double 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/double/chdtr.c b/libm/double/chdtr.c
new file mode 100644
index 000000000..a29da7535
--- /dev/null
+++ b/libm/double/chdtr.c
@@ -0,0 +1,200 @@
+/* chdtr.c
+ *
+ * Chi-square distribution
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double df, x, y, chdtr();
+ *
+ * y = chdtr( 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:
+ *
+ * See igam().
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * chdtr domain x < 0 or v < 1 0.0
+ */
+ /* chdtrc()
+ *
+ * Complemented Chi-square distribution
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double v, x, y, chdtrc();
+ *
+ * y = chdtrc( 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:
+ *
+ * See igamc().
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * chdtrc domain x < 0 or v < 1 0.0
+ */
+ /* chdtri()
+ *
+ * Inverse of complemented Chi-square distribution
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double df, x, y, chdtri();
+ *
+ * x = chdtri( 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:
+ *
+ * See igami.c.
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * chdtri domain y < 0 or y > 1 0.0
+ * v < 1
+ *
+ */
+
+/* chdtr() */
+
+
+/*
+Cephes Math Library Release 2.8: June, 2000
+Copyright 1984, 1987, 2000 by Stephen L. Moshier
+*/
+
+#include <math.h>
+#ifdef ANSIPROT
+extern double igamc ( double, double );
+extern double igam ( double, double );
+extern double igami ( double, double );
+#else
+double igamc(), igam(), igami();
+#endif
+
+double chdtrc(df,x)
+double df, x;
+{
+
+if( (x < 0.0) || (df < 1.0) )
+ {
+ mtherr( "chdtrc", DOMAIN );
+ return(0.0);
+ }
+return( igamc( df/2.0, x/2.0 ) );
+}
+
+
+
+double chdtr(df,x)
+double df, x;
+{
+
+if( (x < 0.0) || (df < 1.0) )
+ {
+ mtherr( "chdtr", DOMAIN );
+ return(0.0);
+ }
+return( igam( df/2.0, x/2.0 ) );
+}
+
+
+
+double chdtri( df, y )
+double df, y;
+{
+double x;
+
+if( (y < 0.0) || (y > 1.0) || (df < 1.0) )
+ {
+ mtherr( "chdtri", DOMAIN );
+ return(0.0);
+ }
+
+x = igami( 0.5 * df, y );
+return( 2.0 * x );
+}
diff --git a/libm/double/cheby.c b/libm/double/cheby.c
new file mode 100644
index 000000000..8da9b350e
--- /dev/null
+++ b/libm/double/cheby.c
@@ -0,0 +1,149 @@
+/* cheby.c
+ *
+ * Program to calculate coefficients of the Chebyshev polynomial
+ * expansion of a given input function. The algorithm computes
+ * the discrete Fourier cosine transform of the function evaluated
+ * at unevenly spaced points. Library routine chbevl.c uses the
+ * coefficients to calculate an approximate value of the original
+ * function.
+ * -- S. L. Moshier
+ */
+
+extern double PI; /* 3.14159... */
+extern double PIO2;
+double cosi[33] = {0.0,}; /* cosine array for Fourier transform */
+double func[65] = {0.0,}; /* values of the function */
+double cos(), log(), exp(), sqrt();
+
+main()
+{
+double c, r, s, t, x, y, z, temp;
+double low, high, dtemp;
+long n;
+int i, ii, j, n2, k, rr, invflg;
+short *p;
+char st[40];
+
+low = 0.0; /* low end of approximation interval */
+high = 1.0; /* high end */
+invflg = 0; /* set to 1 if inverted interval, else zero */
+/* Note: inverted interval goes from 1/high to 1/low */
+z = 0.0;
+n = 64; /* will find 64 coefficients */
+ /* but use only those greater than roundoff error */
+n2 = n/2;
+t = n;
+t = PI/t;
+
+/* calculate array of cosines */
+puts("calculating cosines");
+s = 1.0;
+cosi[0] = 1.0;
+i = 1;
+while( i < 32 )
+ {
+ y = cos( s * t );
+ cosi[i] = y;
+ s += 1.0;
+ ++i;
+ }
+cosi[32] = 0.0;
+
+/* cheby.c 2 */
+
+/* calculate function at special values of the argument */
+puts("calculating function values");
+x = low;
+y = high;
+if( invflg && (low != 0.0) )
+ { /* inverted interval */
+ temp = 1.0/x;
+ x = 1.0/y;
+ y = temp;
+ }
+r = (x + y)/2.0;
+printf( "center %.15E ", r);
+s = (y - x)/2.0;
+printf( "width %.15E\n", s);
+i = 0;
+while( i < 65 )
+ {
+ if( i < n2 )
+ c = cosi[i];
+ else
+ c = -cosi[64-i];
+ temp = r + s * c;
+/* if inverted interval, compute function(1/x) */
+ if( invflg && (temp != 0.0) )
+ temp = 1.0/temp;
+
+ printf( "%.15E ", temp );
+
+/* insert call to function routine here: */
+/**********************************/
+
+ if( temp == 0.0 )
+ y = 1.0;
+ else
+ y = exp( temp * log(2.0) );
+
+/**********************************/
+ func[i] = y;
+ printf( "%.15E\n", y );
+ ++i;
+ }
+
+/* cheby.c 3 */
+
+puts( "calculating Chebyshev coefficients");
+rr = 0;
+while( rr < 65 )
+ {
+ z = func[0]/2.0;
+ j = 1;
+ while( j < 65 )
+ {
+ k = (rr * j)/n2;
+ i = rr * j - n2 * k;
+ k &= 3;
+ if( k == 0 )
+ c = cosi[i];
+ if( k == 1 )
+ {
+ i = 32-i;
+ c = -cosi[i];
+ if( i == 32 )
+ c = -c;
+ }
+ if( k == 2 )
+ {
+ c = -cosi[i];
+ }
+ if( k == 3 )
+ {
+ i = 32-i;
+ c = cosi[i];
+ }
+ if( i != 32)
+ {
+ temp = func[j];
+ temp = c * temp;
+ z += temp;
+ }
+ ++j;
+ }
+
+ if( i != 32 )
+ {
+ temp /= 2.0;
+ z = z - temp;
+ }
+ z *= 2.0;
+ temp = n;
+ z /= temp;
+ dtemp = z;
+ ++rr;
+ sprintf( st, "/* %.16E */", dtemp );
+ puts( st );
+ }
+}
diff --git a/libm/double/clog.c b/libm/double/clog.c
new file mode 100644
index 000000000..70a318a50
--- /dev/null
+++ b/libm/double/clog.c
@@ -0,0 +1,1043 @@
+/* clog.c
+ *
+ * Complex natural logarithm
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * void clog();
+ * cmplx z, w;
+ *
+ * clog( &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
+ * DEC -10,+10 7000 8.5e-17 1.9e-17
+ * IEEE -10,+10 30000 5.0e-15 1.1e-16
+ *
+ * Larger relative error can be observed for z near 1 +i0.
+ * In IEEE arithmetic the peak absolute error is 5.2e-16, rms
+ * absolute error 1.0e-16.
+ */
+
+/*
+Cephes Math Library Release 2.8: June, 2000
+Copyright 1984, 1995, 2000 by Stephen L. Moshier
+*/
+#include <math.h>
+#ifdef ANSIPROT
+static void cchsh ( double x, double *c, double *s );
+static double redupi ( double x );
+static double ctans ( cmplx *z );
+/* These are supposed to be in some standard place. */
+double fabs (double);
+double sqrt (double);
+double pow (double, double);
+double log (double);
+double exp (double);
+double atan2 (double, double);
+double cosh (double);
+double sinh (double);
+double asin (double);
+double sin (double);
+double cos (double);
+double cabs (cmplx *);
+void cadd ( cmplx *, cmplx *, cmplx * );
+void cmul ( cmplx *, cmplx *, cmplx * );
+void csqrt ( cmplx *, cmplx * );
+static void cchsh ( double, double *, double * );
+static double redupi ( double );
+static double ctans ( cmplx * );
+void clog ( cmplx *, cmplx * );
+void casin ( cmplx *, cmplx * );
+void cacos ( cmplx *, cmplx * );
+void catan ( cmplx *, cmplx * );
+#else
+static void cchsh();
+static double redupi();
+static double ctans();
+double cabs(), fabs(), sqrt(), pow();
+double log(), exp(), atan2(), cosh(), sinh();
+double asin(), sin(), cos();
+void cadd(), cmul(), csqrt();
+void clog(), casin(), cacos(), catan();
+#endif
+
+
+extern double MAXNUM, MACHEP, PI, PIO2;
+
+void clog( z, w )
+register cmplx *z, *w;
+{
+double p, rr;
+
+/*rr = sqrt( z->r * z->r + z->i * z->i );*/
+rr = cabs(z);
+p = log(rr);
+#if ANSIC
+rr = atan2( z->i, z->r );
+#else
+rr = atan2( z->r, z->i );
+if( rr > PI )
+ rr -= PI + PI;
+#endif
+w->i = rr;
+w->r = p;
+}
+ /* cexp()
+ *
+ * Complex exponential function
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * void cexp();
+ * cmplx z, w;
+ *
+ * cexp( &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
+ * DEC -10,+10 8700 3.7e-17 1.1e-17
+ * IEEE -10,+10 30000 3.0e-16 8.7e-17
+ *
+ */
+
+void cexp( z, w )
+register cmplx *z, *w;
+{
+double r;
+
+r = exp( z->r );
+w->r = r * cos( z->i );
+w->i = r * sin( z->i );
+}
+ /* csin()
+ *
+ * Complex circular sine
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * void csin();
+ * cmplx z, w;
+ *
+ * csin( &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
+ * DEC -10,+10 8400 5.3e-17 1.3e-17
+ * IEEE -10,+10 30000 3.8e-16 1.0e-16
+ * Also tested by csin(casin(z)) = z.
+ *
+ */
+
+void csin( z, w )
+register cmplx *z, *w;
+{
+double ch, sh;
+
+cchsh( z->i, &ch, &sh );
+w->r = sin( z->r ) * ch;
+w->i = cos( z->r ) * sh;
+}
+
+
+
+/* calculate cosh and sinh */
+
+static void cchsh( x, c, s )
+double x, *c, *s;
+{
+double e, ei;
+
+if( fabs(x) <= 0.5 )
+ {
+ *c = cosh(x);
+ *s = sinh(x);
+ }
+else
+ {
+ e = exp(x);
+ ei = 0.5/e;
+ e = 0.5 * e;
+ *s = e - ei;
+ *c = e + ei;
+ }
+}
+
+ /* ccos()
+ *
+ * Complex circular cosine
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * void ccos();
+ * cmplx z, w;
+ *
+ * ccos( &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
+ * DEC -10,+10 8400 4.5e-17 1.3e-17
+ * IEEE -10,+10 30000 3.8e-16 1.0e-16
+ */
+
+void ccos( z, w )
+register cmplx *z, *w;
+{
+double ch, sh;
+
+cchsh( z->i, &ch, &sh );
+w->r = cos( z->r ) * ch;
+w->i = -sin( z->r ) * sh;
+}
+ /* ctan()
+ *
+ * Complex circular tangent
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * void ctan();
+ * cmplx z, w;
+ *
+ * ctan( &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
+ * DEC -10,+10 5200 7.1e-17 1.6e-17
+ * IEEE -10,+10 30000 7.2e-16 1.2e-16
+ * Also tested by ctan * ccot = 1 and catan(ctan(z)) = z.
+ */
+
+void ctan( z, w )
+register cmplx *z, *w;
+{
+double d;
+
+d = cos( 2.0 * z->r ) + cosh( 2.0 * z->i );
+
+if( fabs(d) < 0.25 )
+ d = ctans(z);
+
+if( d == 0.0 )
+ {
+ mtherr( "ctan", OVERFLOW );
+ w->r = MAXNUM;
+ w->i = MAXNUM;
+ return;
+ }
+
+w->r = sin( 2.0 * z->r ) / d;
+w->i = sinh( 2.0 * z->i ) / d;
+}
+ /* ccot()
+ *
+ * Complex circular cotangent
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * void ccot();
+ * cmplx z, w;
+ *
+ * ccot( &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
+ * DEC -10,+10 3000 6.5e-17 1.6e-17
+ * IEEE -10,+10 30000 9.2e-16 1.2e-16
+ * Also tested by ctan * ccot = 1 + i0.
+ */
+
+void ccot( z, w )
+register cmplx *z, *w;
+{
+double d;
+
+d = cosh(2.0 * z->i) - cos(2.0 * z->r);
+
+if( fabs(d) < 0.25 )
+ d = ctans(z);
+
+if( d == 0.0 )
+ {
+ mtherr( "ccot", OVERFLOW );
+ w->r = MAXNUM;
+ w->i = MAXNUM;
+ return;
+ }
+
+w->r = sin( 2.0 * z->r ) / d;
+w->i = -sinh( 2.0 * z->i ) / d;
+}
+
+/* Program to subtract nearest integer multiple of PI */
+/* extended precision value of PI: */
+#ifdef UNK
+static double DP1 = 3.14159265160560607910E0;
+static double DP2 = 1.98418714791870343106E-9;
+static double DP3 = 1.14423774522196636802E-17;
+#endif
+
+#ifdef DEC
+static unsigned short P1[] = {0040511,0007732,0120000,0000000,};
+static unsigned short P2[] = {0031010,0055060,0100000,0000000,};
+static unsigned short P3[] = {0022123,0011431,0105056,0001560,};
+#define DP1 *(double *)P1
+#define DP2 *(double *)P2
+#define DP3 *(double *)P3
+#endif
+
+#ifdef IBMPC
+static unsigned short P1[] = {0x0000,0x5400,0x21fb,0x4009};
+static unsigned short P2[] = {0x0000,0x1000,0x0b46,0x3e21};
+static unsigned short P3[] = {0xc06e,0x3145,0x6263,0x3c6a};
+#define DP1 *(double *)P1
+#define DP2 *(double *)P2
+#define DP3 *(double *)P3
+#endif
+
+#ifdef MIEEE
+static unsigned short P1[] = {
+0x4009,0x21fb,0x5400,0x0000
+};
+static unsigned short P2[] = {
+0x3e21,0x0b46,0x1000,0x0000
+};
+static unsigned short P3[] = {
+0x3c6a,0x6263,0x3145,0xc06e
+};
+#define DP1 *(double *)P1
+#define DP2 *(double *)P2
+#define DP3 *(double *)P3
+#endif
+
+static double redupi(x)
+double x;
+{
+double t;
+long i;
+
+t = x/PI;
+if( t >= 0.0 )
+ t += 0.5;
+else
+ t -= 0.5;
+
+i = t; /* the multiple */
+t = i;
+t = ((x - t * DP1) - t * DP2) - t * DP3;
+return(t);
+}
+
+/* Taylor series expansion for cosh(2y) - cos(2x) */
+
+static double ctans(z)
+cmplx *z;
+{
+double f, x, x2, y, y2, rn, t;
+double d;
+
+x = fabs( 2.0 * z->r );
+y = fabs( 2.0 * z->i );
+
+x = redupi(x);
+
+x = x * x;
+y = y * y;
+x2 = 1.0;
+y2 = 1.0;
+f = 1.0;
+rn = 0.0;
+d = 0.0;
+do
+ {
+ rn += 1.0;
+ f *= rn;
+ rn += 1.0;
+ f *= rn;
+ x2 *= x;
+ y2 *= y;
+ t = y2 + x2;
+ t /= f;
+ d += t;
+
+ rn += 1.0;
+ f *= rn;
+ rn += 1.0;
+ f *= rn;
+ x2 *= x;
+ y2 *= y;
+ t = y2 - x2;
+ t /= f;
+ d += t;
+ }
+while( fabs(t/d) > MACHEP );
+return(d);
+}
+ /* casin()
+ *
+ * Complex circular arc sine
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * void casin();
+ * cmplx z, w;
+ *
+ * casin( &z, &w );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Inverse complex sine:
+ *
+ * 2
+ * w = -i clog( iz + csqrt( 1 - z ) ).
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * DEC -10,+10 10100 2.1e-15 3.4e-16
+ * IEEE -10,+10 30000 2.2e-14 2.7e-15
+ * Larger relative error can be observed for z near zero.
+ * Also tested by csin(casin(z)) = z.
+ */
+
+void casin( z, w )
+cmplx *z, *w;
+{
+static cmplx ca, ct, zz, z2;
+double x, y;
+
+x = z->r;
+y = z->i;
+
+if( y == 0.0 )
+ {
+ if( fabs(x) > 1.0 )
+ {
+ w->r = PIO2;
+ w->i = 0.0;
+ mtherr( "casin", DOMAIN );
+ }
+ else
+ {
+ w->r = asin(x);
+ w->i = 0.0;
+ }
+ return;
+ }
+
+/* Power series expansion */
+/*
+b = cabs(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 = fabs(ct.r) + fabs(ct.i);
+ }
+while( b > MACHEP );
+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.0 * ca.r * ca.i;
+
+zz.r = 1.0 - zz.r;
+zz.i = -zz.i;
+csqrt( &zz, &z2 );
+
+cadd( &z2, &ct, &zz );
+clog( &zz, &zz );
+w->r = zz.i; /* mult by 1/i = -i */
+w->i = -zz.r;
+return;
+}
+ /* cacos()
+ *
+ * Complex circular arc cosine
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * void cacos();
+ * cmplx z, w;
+ *
+ * cacos( &z, &w );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ *
+ * w = arccos z = PI/2 - arcsin z.
+ *
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * DEC -10,+10 5200 1.6e-15 2.8e-16
+ * IEEE -10,+10 30000 1.8e-14 2.2e-15
+ */
+
+void cacos( z, w )
+cmplx *z, *w;
+{
+
+casin( z, w );
+w->r = PIO2 - w->r;
+w->i = -w->i;
+}
+ /* catan()
+ *
+ * Complex circular arc tangent
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * void catan();
+ * cmplx 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
+ * DEC -10,+10 5900 1.3e-16 7.8e-18
+ * IEEE -10,+10 30000 2.3e-15 8.5e-17
+ * The check catan( ctan(z) ) = z, with |x| and |y| < PI/2,
+ * had peak relative error 1.5e-16, rms relative error
+ * 2.9e-17. See also clog().
+ */
+
+void catan( z, w )
+cmplx *z, *w;
+{
+double a, t, x, x2, y;
+
+x = z->r;
+y = z->i;
+
+if( (x == 0.0) && (y > 1.0) )
+ goto ovrf;
+
+x2 = x * x;
+a = 1.0 - x2 - (y * y);
+if( a == 0.0 )
+ goto ovrf;
+
+#if ANSIC
+t = atan2( 2.0 * x, a )/2.0;
+#else
+t = atan2( a, 2.0 * x )/2.0;
+#endif
+w->r = redupi( t );
+
+t = y - 1.0;
+a = x2 + (t * t);
+if( a == 0.0 )
+ goto ovrf;
+
+t = y + 1.0;
+a = (x2 + (t * t))/a;
+w->i = log(a)/4.0;
+return;
+
+ovrf:
+mtherr( "catan", OVERFLOW );
+w->r = MAXNUM;
+w->i = MAXNUM;
+}
+
+
+/* csinh
+ *
+ * Complex hyperbolic sine
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * void csinh();
+ * cmplx z, w;
+ *
+ * csinh( &z, &w );
+ *
+ *
+ * DESCRIPTION:
+ *
+ * csinh z = (cexp(z) - cexp(-z))/2
+ * = sinh x * cos y + i cosh x * sin y .
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE -10,+10 30000 3.1e-16 8.2e-17
+ *
+ */
+
+void
+csinh (z, w)
+ cmplx *z, *w;
+{
+ double x, y;
+
+ x = z->r;
+ y = z->i;
+ w->r = sinh (x) * cos (y);
+ w->i = cosh (x) * sin (y);
+}
+
+
+/* casinh
+ *
+ * Complex inverse hyperbolic sine
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * void casinh();
+ * cmplx z, w;
+ *
+ * casinh (&z, &w);
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * casinh z = -i casin iz .
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE -10,+10 30000 1.8e-14 2.6e-15
+ *
+ */
+
+void
+casinh (z, w)
+ cmplx *z, *w;
+{
+ cmplx u;
+
+ u.r = 0.0;
+ u.i = 1.0;
+ cmul( z, &u, &u );
+ casin( &u, w );
+ u.r = 0.0;
+ u.i = -1.0;
+ cmul( &u, w, w );
+}
+
+/* ccosh
+ *
+ * Complex hyperbolic cosine
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * void ccosh();
+ * cmplx z, w;
+ *
+ * ccosh (&z, &w);
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * ccosh(z) = cosh x cos y + i sinh x sin y .
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE -10,+10 30000 2.9e-16 8.1e-17
+ *
+ */
+
+void
+ccosh (z, w)
+ cmplx *z, *w;
+{
+ double x, y;
+
+ x = z->r;
+ y = z->i;
+ w->r = cosh (x) * cos (y);
+ w->i = sinh (x) * sin (y);
+}
+
+
+/* cacosh
+ *
+ * Complex inverse hyperbolic cosine
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * void cacosh();
+ * cmplx z, w;
+ *
+ * cacosh (&z, &w);
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * acosh z = i acos z .
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE -10,+10 30000 1.6e-14 2.1e-15
+ *
+ */
+
+void
+cacosh (z, w)
+ cmplx *z, *w;
+{
+ cmplx u;
+
+ cacos( z, w );
+ u.r = 0.0;
+ u.i = 1.0;
+ cmul( &u, w, w );
+}
+
+
+/* ctanh
+ *
+ * Complex hyperbolic tangent
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * void ctanh();
+ * cmplx z, w;
+ *
+ * ctanh (&z, &w);
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * tanh z = (sinh 2x + i sin 2y) / (cosh 2x + cos 2y) .
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE -10,+10 30000 1.7e-14 2.4e-16
+ *
+ */
+
+/* 5.253E-02,1.550E+00 1.643E+01,6.553E+00 1.729E-14 21355 */
+
+void
+ctanh (z, w)
+ cmplx *z, *w;
+{
+ double x, y, d;
+
+ x = z->r;
+ y = z->i;
+ d = cosh (2.0 * x) + cos (2.0 * y);
+ w->r = sinh (2.0 * x) / d;
+ w->i = sin (2.0 * y) / d;
+ return;
+}
+
+
+/* catanh
+ *
+ * Complex inverse hyperbolic tangent
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * void catanh();
+ * cmplx z, w;
+ *
+ * catanh (&z, &w);
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Inverse tanh, equal to -i catan (iz);
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE -10,+10 30000 2.3e-16 6.2e-17
+ *
+ */
+
+void
+catanh (z, w)
+ cmplx *z, *w;
+{
+ cmplx u;
+
+ u.r = 0.0;
+ u.i = 1.0;
+ cmul (z, &u, &u); /* i z */
+ catan (&u, w);
+ u.r = 0.0;
+ u.i = -1.0;
+ cmul (&u, w, w); /* -i catan iz */
+ return;
+}
+
+
+/* cpow
+ *
+ * Complex power function
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * void cpow();
+ * cmplx a, z, w;
+ *
+ * cpow (&a, &z, &w);
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Raises complex A to the complex Zth power.
+ * Definition is per AMS55 # 4.2.8,
+ * analytically equivalent to cpow(a,z) = cexp(z clog(a)).
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE -10,+10 30000 9.4e-15 1.5e-15
+ *
+ */
+
+
+void
+cpow (a, z, w)
+ cmplx *a, *z, *w;
+{
+ double x, y, r, theta, absa, arga;
+
+ x = z->r;
+ y = z->i;
+ absa = cabs (a);
+ if (absa == 0.0)
+ {
+ w->r = 0.0;
+ w->i = 0.0;
+ return;
+ }
+ arga = atan2 (a->i, a->r);
+ r = pow (absa, x);
+ theta = x * arga;
+ if (y != 0.0)
+ {
+ r = r * exp (-y * arga);
+ theta = theta + y * log (absa);
+ }
+ w->r = r * cos (theta);
+ w->i = r * sin (theta);
+ return;
+}
diff --git a/libm/double/cmplx.c b/libm/double/cmplx.c
new file mode 100644
index 000000000..dcd972bea
--- /dev/null
+++ b/libm/double/cmplx.c
@@ -0,0 +1,461 @@
+/* cmplx.c
+ *
+ * Complex number arithmetic
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * typedef struct {
+ * double r; real part
+ * double i; imaginary part
+ * }cmplx;
+ *
+ * cmplx *a, *b, *c;
+ *
+ * cadd( a, b, c ); c = b + a
+ * csub( a, b, c ); c = b - a
+ * cmul( a, b, c ); c = b * a
+ * cdiv( a, b, c ); c = b / a
+ * cneg( c ); c = -c
+ * cmov( 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
+ * DEC cadd 10000 1.4e-17 3.4e-18
+ * IEEE cadd 100000 1.1e-16 2.7e-17
+ * DEC csub 10000 1.4e-17 4.5e-18
+ * IEEE csub 100000 1.1e-16 3.4e-17
+ * DEC cmul 3000 2.3e-17 8.7e-18
+ * IEEE cmul 100000 2.1e-16 6.9e-17
+ * DEC cdiv 18000 4.9e-17 1.3e-17
+ * IEEE cdiv 100000 3.7e-16 1.1e-16
+ */
+ /* cmplx.c
+ * complex number arithmetic
+ */
+
+
+/*
+Cephes Math Library Release 2.8: June, 2000
+Copyright 1984, 1995, 2000 by Stephen L. Moshier
+*/
+
+
+#include <math.h>
+
+#ifdef ANSIPROT
+extern double fabs ( double );
+extern double cabs ( cmplx * );
+extern double sqrt ( double );
+extern double atan2 ( double, double );
+extern double cos ( double );
+extern double sin ( double );
+extern double sqrt ( double );
+extern double frexp ( double, int * );
+extern double ldexp ( double, int );
+int isnan ( double );
+void cdiv ( cmplx *, cmplx *, cmplx * );
+void cadd ( cmplx *, cmplx *, cmplx * );
+#else
+double fabs(), cabs(), sqrt(), atan2(), cos(), sin();
+double sqrt(), frexp(), ldexp();
+int isnan();
+void cdiv(), cadd();
+#endif
+
+extern double MAXNUM, MACHEP, PI, PIO2, INFINITY, NAN;
+/*
+typedef struct
+ {
+ double r;
+ double i;
+ }cmplx;
+*/
+cmplx czero = {0.0, 0.0};
+extern cmplx czero;
+cmplx cone = {1.0, 0.0};
+extern cmplx cone;
+
+/* c = b + a */
+
+void cadd( a, b, c )
+register cmplx *a, *b;
+cmplx *c;
+{
+
+c->r = b->r + a->r;
+c->i = b->i + a->i;
+}
+
+
+/* c = b - a */
+
+void csub( a, b, c )
+register cmplx *a, *b;
+cmplx *c;
+{
+
+c->r = b->r - a->r;
+c->i = b->i - a->i;
+}
+
+/* c = b * a */
+
+void cmul( a, b, c )
+register cmplx *a, *b;
+cmplx *c;
+{
+double 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 cdiv( a, b, c )
+register cmplx *a, *b;
+cmplx *c;
+{
+double 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.0 )
+ {
+ w = MAXNUM * y;
+ if( (fabs(p) > w) || (fabs(q) > w) || (y == 0.0) )
+ {
+ c->r = MAXNUM;
+ c->i = MAXNUM;
+ mtherr( "cdiv", OVERFLOW );
+ return;
+ }
+ }
+c->r = p/y;
+c->i = q/y;
+}
+
+
+/* b = a
+ Caution, a `short' is assumed to be 16 bits wide. */
+
+void cmov( a, b )
+void *a, *b;
+{
+register short *pa, *pb;
+int i;
+
+pa = (short *) a;
+pb = (short *) b;
+i = 8;
+do
+ *pb++ = *pa++;
+while( --i );
+}
+
+
+void cneg( a )
+register cmplx *a;
+{
+
+a->r = -a->r;
+a->i = -a->i;
+}
+
+/* cabs()
+ *
+ * Complex absolute value
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double cabs();
+ * cmplx z;
+ * double a;
+ *
+ * a = cabs( &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
+ * DEC -30,+30 30000 3.2e-17 9.2e-18
+ * IEEE -10,+10 100000 2.7e-16 6.9e-17
+ */
+
+
+/*
+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
+ {
+ double r;
+ double i;
+ }cmplx;
+*/
+
+#ifdef UNK
+#define PREC 27
+#define MAXEXP 1024
+#define MINEXP -1077
+#endif
+#ifdef DEC
+#define PREC 29
+#define MAXEXP 128
+#define MINEXP -128
+#endif
+#ifdef IBMPC
+#define PREC 27
+#define MAXEXP 1024
+#define MINEXP -1077
+#endif
+#ifdef MIEEE
+#define PREC 27
+#define MAXEXP 1024
+#define MINEXP -1077
+#endif
+
+
+double cabs( z )
+register cmplx *z;
+{
+double x, y, b, re, im;
+int ex, ey, e;
+
+#ifdef INFINITIES
+/* Note, cabs(INFINITY,NAN) = INFINITY. */
+if( z->r == INFINITY || z->i == INFINITY
+ || z->r == -INFINITY || z->i == -INFINITY )
+ return( INFINITY );
+#endif
+
+#ifdef NANS
+if( isnan(z->r) )
+ return(z->r);
+if( isnan(z->i) )
+ return(z->i);
+#endif
+
+re = fabs( z->r );
+im = fabs( z->i );
+
+if( re == 0.0 )
+ return( im );
+if( im == 0.0 )
+ return( re );
+
+/* Get the exponents of the numbers */
+x = frexp( re, &ex );
+y = frexp( 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 = ldexp( re, -e );
+y = ldexp( im, -e );
+
+/* Hypotenuse of the right triangle */
+b = sqrt( x * x + y * y );
+
+/* Compute the exponent of the answer. */
+y = frexp( b, &ey );
+ey = e + ey;
+
+/* Check it for overflow and underflow. */
+if( ey > MAXEXP )
+ {
+ mtherr( "cabs", OVERFLOW );
+ return( INFINITY );
+ }
+if( ey < MINEXP )
+ return(0.0);
+
+/* Undo the scaling */
+b = ldexp( b, e );
+return( b );
+}
+ /* csqrt()
+ *
+ * Complex square root
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * void csqrt();
+ * cmplx z, w;
+ *
+ * csqrt( &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 root chosen
+ * 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
+ * DEC -10,+10 25000 3.2e-17 9.6e-18
+ * IEEE -10,+10 100000 3.2e-16 7.7e-17
+ *
+ * 2
+ * Also tested by csqrt( z ) = z, and tested by arguments
+ * close to the real axis.
+ */
+
+
+void csqrt( z, w )
+cmplx *z, *w;
+{
+cmplx q, s;
+double x, y, r, t;
+
+x = z->r;
+y = z->i;
+
+if( y == 0.0 )
+ {
+ if( x < 0.0 )
+ {
+ w->r = 0.0;
+ w->i = sqrt(-x);
+ return;
+ }
+ else
+ {
+ w->r = sqrt(x);
+ w->i = 0.0;
+ return;
+ }
+ }
+
+
+if( x == 0.0 )
+ {
+ r = fabs(y);
+ r = sqrt(0.5*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( (fabs(y) < 2.e-4 * fabs(x))
+ && (x > 0) )
+ {
+ t = 0.25*y*(y/x);
+ }
+else
+ {
+ r = cabs(z);
+ t = 0.5*(r - x);
+ }
+
+r = sqrt(t);
+q.i = r;
+q.r = y/(2.0*r);
+/* Heron iteration in complex arithmetic */
+cdiv( &q, z, &s );
+cadd( &q, &s, w );
+w->r *= 0.5;
+w->i *= 0.5;
+}
+
+
+double hypot( x, y )
+double x, y;
+{
+cmplx z;
+
+z.r = x;
+z.i = y;
+return( cabs(&z) );
+}
diff --git a/libm/double/coil.c b/libm/double/coil.c
new file mode 100644
index 000000000..f7156497c
--- /dev/null
+++ b/libm/double/coil.c
@@ -0,0 +1,63 @@
+/* Program to calculate the inductance of a coil
+ *
+ * Reference: E. Jahnke and F. Emde, _Tables of Functions_,
+ * 4th edition, Dover, 1945, pp 86-89.
+ */
+
+double sin(), cos(), atan(), ellpe(), ellpk();
+
+double d;
+double l;
+double N;
+
+/* double PI = 3.14159265358979323846; */
+extern double PI;
+
+main()
+{
+double a, f, tana, sina, K, E, m, L, t;
+
+printf( "Self inductance of circular solenoidal coil\n" );
+
+loop:
+getnum( "diameter in centimeters", &d );
+if( d < 0.0 )
+ exit(0); /* escape gracefully */
+getnum( "length in centimeters", &l );
+if( d < 0.0 )
+ exit(0);
+getnum( "total number of turns", &N );
+if( d < 0.0 )
+ exit(0);
+tana = d/l; /* form factor */
+a = atan( tana );
+sina = sin(a); /* modulus of the elliptic functions (k) */
+m = cos(a); /* subroutine argument = 1 - k^2 */
+m = m * m;
+K = ellpk(m);
+E = ellpe(m);
+tana = tana * tana; /* square of tan(a) */
+
+f = ((K + (tana - 1.0) * E)/sina - tana)/3.0;
+L = 4.e-9 * PI * N * N * d * f;
+printf( "L = %.4e Henries\n", L );
+goto loop;
+}
+
+
+/* Get value entered on keyboard
+ */
+getnum( str, pd )
+char *str;
+double *pd;
+{
+char s[40];
+
+printf( "%s (%.10e) ? ", str, *pd );
+gets(s);
+if( s[0] != '\0' )
+ {
+ sscanf( s, "%lf", pd );
+ printf( "%.10e\n", *pd );
+ }
+}
diff --git a/libm/double/const.c b/libm/double/const.c
new file mode 100644
index 000000000..de4451497
--- /dev/null
+++ b/libm/double/const.c
@@ -0,0 +1,252 @@
+/* const.c
+ *
+ * Globally declared constants
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * extern double nameofconstant;
+ *
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * This file contains a number of mathematical constants and
+ * also some needed size parameters of the computer arithmetic.
+ * The values are supplied as arrays of hexadecimal integers
+ * for IEEE arithmetic; arrays of octal constants for DEC
+ * arithmetic; and in a normal decimal scientific notation for
+ * other machines. The particular notation used is determined
+ * by a symbol (DEC, IBMPC, or UNK) defined in the include file
+ * math.h.
+ *
+ * The default size parameters are as follows.
+ *
+ * For DEC and UNK modes:
+ * MACHEP = 1.38777878078144567553E-17 2**-56
+ * MAXLOG = 8.8029691931113054295988E1 log(2**127)
+ * MINLOG = -8.872283911167299960540E1 log(2**-128)
+ * MAXNUM = 1.701411834604692317316873e38 2**127
+ *
+ * For IEEE arithmetic (IBMPC):
+ * MACHEP = 1.11022302462515654042E-16 2**-53
+ * MAXLOG = 7.09782712893383996843E2 log(2**1024)
+ * MINLOG = -7.08396418532264106224E2 log(2**-1022)
+ * MAXNUM = 1.7976931348623158E308 2**1024
+ *
+ * The global symbols for mathematical constants are
+ * PI = 3.14159265358979323846 pi
+ * PIO2 = 1.57079632679489661923 pi/2
+ * PIO4 = 7.85398163397448309616E-1 pi/4
+ * SQRT2 = 1.41421356237309504880 sqrt(2)
+ * SQRTH = 7.07106781186547524401E-1 sqrt(2)/2
+ * LOG2E = 1.4426950408889634073599 1/log(2)
+ * SQ2OPI = 7.9788456080286535587989E-1 sqrt( 2/pi )
+ * LOGE2 = 6.93147180559945309417E-1 log(2)
+ * LOGSQ2 = 3.46573590279972654709E-1 log(2)/2
+ * THPIO4 = 2.35619449019234492885 3*pi/4
+ * TWOOPI = 6.36619772367581343075535E-1 2/pi
+ *
+ * These lists are subject to change.
+ */
+
+/* const.c */
+
+/*
+Cephes Math Library Release 2.3: March, 1995
+Copyright 1984, 1995 by Stephen L. Moshier
+*/
+
+#include <math.h>
+
+#ifdef UNK
+#if 1
+double MACHEP = 1.11022302462515654042E-16; /* 2**-53 */
+#else
+double MACHEP = 1.38777878078144567553E-17; /* 2**-56 */
+#endif
+double UFLOWTHRESH = 2.22507385850720138309E-308; /* 2**-1022 */
+#ifdef DENORMAL
+double MAXLOG = 7.09782712893383996732E2; /* log(MAXNUM) */
+/* double MINLOG = -7.44440071921381262314E2; */ /* log(2**-1074) */
+double MINLOG = -7.451332191019412076235E2; /* log(2**-1075) */
+#else
+double MAXLOG = 7.08396418532264106224E2; /* log 2**1022 */
+double MINLOG = -7.08396418532264106224E2; /* log 2**-1022 */
+#endif
+double MAXNUM = 1.79769313486231570815E308; /* 2**1024*(1-MACHEP) */
+double PI = 3.14159265358979323846; /* pi */
+double PIO2 = 1.57079632679489661923; /* pi/2 */
+double PIO4 = 7.85398163397448309616E-1; /* pi/4 */
+double SQRT2 = 1.41421356237309504880; /* sqrt(2) */
+double SQRTH = 7.07106781186547524401E-1; /* sqrt(2)/2 */
+double LOG2E = 1.4426950408889634073599; /* 1/log(2) */
+double SQ2OPI = 7.9788456080286535587989E-1; /* sqrt( 2/pi ) */
+double LOGE2 = 6.93147180559945309417E-1; /* log(2) */
+double LOGSQ2 = 3.46573590279972654709E-1; /* log(2)/2 */
+double THPIO4 = 2.35619449019234492885; /* 3*pi/4 */
+double TWOOPI = 6.36619772367581343075535E-1; /* 2/pi */
+#ifdef INFINITIES
+double INFINITY = 1.0/0.0; /* 99e999; */
+#else
+double INFINITY = 1.79769313486231570815E308; /* 2**1024*(1-MACHEP) */
+#endif
+#ifdef NANS
+double NAN = 1.0/0.0 - 1.0/0.0;
+#else
+double NAN = 0.0;
+#endif
+#ifdef MINUSZERO
+double NEGZERO = -0.0;
+#else
+double NEGZERO = 0.0;
+#endif
+#endif
+
+#ifdef IBMPC
+ /* 2**-53 = 1.11022302462515654042E-16 */
+unsigned short MACHEP[4] = {0x0000,0x0000,0x0000,0x3ca0};
+unsigned short UFLOWTHRESH[4] = {0x0000,0x0000,0x0000,0x0010};
+#ifdef DENORMAL
+ /* log(MAXNUM) = 7.09782712893383996732224E2 */
+unsigned short MAXLOG[4] = {0x39ef,0xfefa,0x2e42,0x4086};
+ /* log(2**-1074) = - -7.44440071921381262314E2 */
+/*unsigned short MINLOG[4] = {0x71c3,0x446d,0x4385,0xc087};*/
+unsigned short MINLOG[4] = {0x3052,0xd52d,0x4910,0xc087};
+#else
+ /* log(2**1022) = 7.08396418532264106224E2 */
+unsigned short MAXLOG[4] = {0xbcd2,0xdd7a,0x232b,0x4086};
+ /* log(2**-1022) = - 7.08396418532264106224E2 */
+unsigned short MINLOG[4] = {0xbcd2,0xdd7a,0x232b,0xc086};
+#endif
+ /* 2**1024*(1-MACHEP) = 1.7976931348623158E308 */
+unsigned short MAXNUM[4] = {0xffff,0xffff,0xffff,0x7fef};
+unsigned short PI[4] = {0x2d18,0x5444,0x21fb,0x4009};
+unsigned short PIO2[4] = {0x2d18,0x5444,0x21fb,0x3ff9};
+unsigned short PIO4[4] = {0x2d18,0x5444,0x21fb,0x3fe9};
+unsigned short SQRT2[4] = {0x3bcd,0x667f,0xa09e,0x3ff6};
+unsigned short SQRTH[4] = {0x3bcd,0x667f,0xa09e,0x3fe6};
+unsigned short LOG2E[4] = {0x82fe,0x652b,0x1547,0x3ff7};
+unsigned short SQ2OPI[4] = {0x3651,0x33d4,0x8845,0x3fe9};
+unsigned short LOGE2[4] = {0x39ef,0xfefa,0x2e42,0x3fe6};
+unsigned short LOGSQ2[4] = {0x39ef,0xfefa,0x2e42,0x3fd6};
+unsigned short THPIO4[4] = {0x21d2,0x7f33,0xd97c,0x4002};
+unsigned short TWOOPI[4] = {0xc883,0x6dc9,0x5f30,0x3fe4};
+#ifdef INFINITIES
+unsigned short INFINITY[4] = {0x0000,0x0000,0x0000,0x7ff0};
+#else
+unsigned short INFINITY[4] = {0xffff,0xffff,0xffff,0x7fef};
+#endif
+#ifdef NANS
+unsigned short NAN[4] = {0x0000,0x0000,0x0000,0x7ffc};
+#else
+unsigned short NAN[4] = {0x0000,0x0000,0x0000,0x0000};
+#endif
+#ifdef MINUSZERO
+unsigned short NEGZERO[4] = {0x0000,0x0000,0x0000,0x8000};
+#else
+unsigned short NEGZERO[4] = {0x0000,0x0000,0x0000,0x0000};
+#endif
+#endif
+
+#ifdef MIEEE
+ /* 2**-53 = 1.11022302462515654042E-16 */
+unsigned short MACHEP[4] = {0x3ca0,0x0000,0x0000,0x0000};
+unsigned short UFLOWTHRESH[4] = {0x0010,0x0000,0x0000,0x0000};
+#ifdef DENORMAL
+ /* log(2**1024) = 7.09782712893383996843E2 */
+unsigned short MAXLOG[4] = {0x4086,0x2e42,0xfefa,0x39ef};
+ /* log(2**-1074) = - -7.44440071921381262314E2 */
+/* unsigned short MINLOG[4] = {0xc087,0x4385,0x446d,0x71c3}; */
+unsigned short MINLOG[4] = {0xc087,0x4910,0xd52d,0x3052};
+#else
+ /* log(2**1022) = 7.08396418532264106224E2 */
+unsigned short MAXLOG[4] = {0x4086,0x232b,0xdd7a,0xbcd2};
+ /* log(2**-1022) = - 7.08396418532264106224E2 */
+unsigned short MINLOG[4] = {0xc086,0x232b,0xdd7a,0xbcd2};
+#endif
+ /* 2**1024*(1-MACHEP) = 1.7976931348623158E308 */
+unsigned short MAXNUM[4] = {0x7fef,0xffff,0xffff,0xffff};
+unsigned short PI[4] = {0x4009,0x21fb,0x5444,0x2d18};
+unsigned short PIO2[4] = {0x3ff9,0x21fb,0x5444,0x2d18};
+unsigned short PIO4[4] = {0x3fe9,0x21fb,0x5444,0x2d18};
+unsigned short SQRT2[4] = {0x3ff6,0xa09e,0x667f,0x3bcd};
+unsigned short SQRTH[4] = {0x3fe6,0xa09e,0x667f,0x3bcd};
+unsigned short LOG2E[4] = {0x3ff7,0x1547,0x652b,0x82fe};
+unsigned short SQ2OPI[4] = {0x3fe9,0x8845,0x33d4,0x3651};
+unsigned short LOGE2[4] = {0x3fe6,0x2e42,0xfefa,0x39ef};
+unsigned short LOGSQ2[4] = {0x3fd6,0x2e42,0xfefa,0x39ef};
+unsigned short THPIO4[4] = {0x4002,0xd97c,0x7f33,0x21d2};
+unsigned short TWOOPI[4] = {0x3fe4,0x5f30,0x6dc9,0xc883};
+#ifdef INFINITIES
+unsigned short INFINITY[4] = {0x7ff0,0x0000,0x0000,0x0000};
+#else
+unsigned short INFINITY[4] = {0x7fef,0xffff,0xffff,0xffff};
+#endif
+#ifdef NANS
+unsigned short NAN[4] = {0x7ff8,0x0000,0x0000,0x0000};
+#else
+unsigned short NAN[4] = {0x0000,0x0000,0x0000,0x0000};
+#endif
+#ifdef MINUSZERO
+unsigned short NEGZERO[4] = {0x8000,0x0000,0x0000,0x0000};
+#else
+unsigned short NEGZERO[4] = {0x0000,0x0000,0x0000,0x0000};
+#endif
+#endif
+
+#ifdef DEC
+ /* 2**-56 = 1.38777878078144567553E-17 */
+unsigned short MACHEP[4] = {0022200,0000000,0000000,0000000};
+unsigned short UFLOWTHRESH[4] = {0x0080,0x0000,0x0000,0x0000};
+ /* log 2**127 = 88.029691931113054295988 */
+unsigned short MAXLOG[4] = {041660,007463,0143742,025733,};
+ /* log 2**-128 = -88.72283911167299960540 */
+unsigned short MINLOG[4] = {0141661,071027,0173721,0147572,};
+ /* 2**127 = 1.701411834604692317316873e38 */
+unsigned short MAXNUM[4] = {077777,0177777,0177777,0177777,};
+unsigned short PI[4] = {040511,007732,0121041,064302,};
+unsigned short PIO2[4] = {040311,007732,0121041,064302,};
+unsigned short PIO4[4] = {040111,007732,0121041,064302,};
+unsigned short SQRT2[4] = {040265,002363,031771,0157145,};
+unsigned short SQRTH[4] = {040065,002363,031771,0157144,};
+unsigned short LOG2E[4] = {040270,0125073,024534,013761,};
+unsigned short SQ2OPI[4] = {040114,041051,0117241,0131204,};
+unsigned short LOGE2[4] = {040061,071027,0173721,0147572,};
+unsigned short LOGSQ2[4] = {037661,071027,0173721,0147572,};
+unsigned short THPIO4[4] = {040426,0145743,0174631,007222,};
+unsigned short TWOOPI[4] = {040042,0174603,067116,042025,};
+/* Approximate infinity by MAXNUM. */
+unsigned short INFINITY[4] = {077777,0177777,0177777,0177777,};
+unsigned short NAN[4] = {0000000,0000000,0000000,0000000};
+#ifdef MINUSZERO
+unsigned short NEGZERO[4] = {0000000,0000000,0000000,0100000};
+#else
+unsigned short NEGZERO[4] = {0000000,0000000,0000000,0000000};
+#endif
+#endif
+
+#ifndef UNK
+extern unsigned short MACHEP[];
+extern unsigned short UFLOWTHRESH[];
+extern unsigned short MAXLOG[];
+extern unsigned short UNDLOG[];
+extern unsigned short MINLOG[];
+extern unsigned short MAXNUM[];
+extern unsigned short PI[];
+extern unsigned short PIO2[];
+extern unsigned short PIO4[];
+extern unsigned short SQRT2[];
+extern unsigned short SQRTH[];
+extern unsigned short LOG2E[];
+extern unsigned short SQ2OPI[];
+extern unsigned short LOGE2[];
+extern unsigned short LOGSQ2[];
+extern unsigned short THPIO4[];
+extern unsigned short TWOOPI[];
+extern unsigned short INFINITY[];
+extern unsigned short NAN[];
+extern unsigned short NEGZERO[];
+#endif
diff --git a/libm/double/cosh.c b/libm/double/cosh.c
new file mode 100644
index 000000000..77a70da3e
--- /dev/null
+++ b/libm/double/cosh.c
@@ -0,0 +1,83 @@
+/* cosh.c
+ *
+ * Hyperbolic cosine
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, cosh();
+ *
+ * y = cosh( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns hyperbolic cosine of argument in the range MINLOG to
+ * MAXLOG.
+ *
+ * cosh(x) = ( exp(x) + exp(-x) )/2.
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * DEC +- 88 50000 4.0e-17 7.7e-18
+ * IEEE +-MAXLOG 30000 2.6e-16 5.7e-17
+ *
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * cosh overflow |x| > MAXLOG MAXNUM
+ *
+ *
+ */
+
+/* cosh.c */
+
+/*
+Cephes Math Library Release 2.8: June, 2000
+Copyright 1985, 1995, 2000 by Stephen L. Moshier
+*/
+
+#include <math.h>
+#ifdef ANSIPROT
+extern double exp ( double );
+extern int isnan ( double );
+extern int isfinite ( double );
+#else
+double exp();
+int isnan(), isfinite();
+#endif
+extern double MAXLOG, INFINITY, LOGE2;
+
+double cosh(x)
+double x;
+{
+double y;
+
+#ifdef NANS
+if( isnan(x) )
+ return(x);
+#endif
+if( x < 0 )
+ x = -x;
+if( x > (MAXLOG + LOGE2) )
+ {
+ mtherr( "cosh", OVERFLOW );
+ return( INFINITY );
+ }
+if( x >= (MAXLOG - LOGE2) )
+ {
+ y = exp(0.5 * x);
+ y = (0.5 * y) * y;
+ return(y);
+ }
+y = exp(x);
+y = 0.5 * (y + 1.0 / y);
+return( y );
+}
diff --git a/libm/double/cpmul.c b/libm/double/cpmul.c
new file mode 100644
index 000000000..3880ac5a1
--- /dev/null
+++ b/libm/double/cpmul.c
@@ -0,0 +1,104 @@
+/* cpmul.c
+ *
+ * Multiply two polynomials with complex coefficients
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * typedef struct
+ * {
+ * double r;
+ * double i;
+ * }cmplx;
+ *
+ * cmplx a[], b[], c[];
+ * int da, db, dc;
+ *
+ * cpmul( a, da, b, db, c, &dc );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * The two argument polynomials are multiplied together, and
+ * their product is placed in c.
+ *
+ * Each polynomial is represented by its coefficients stored
+ * as an array of complex number structures (see the typedef).
+ * The degree of a is da, which must be passed to the routine
+ * as an argument; similarly the degree db of b is an argument.
+ * Array a has da + 1 elements and array b has db + 1 elements.
+ * Array c must have storage allocated for at least da + db + 1
+ * elements. The value da + db is returned in dc; this is
+ * the degree of the product polynomial.
+ *
+ * Polynomial coefficients are stored in ascending order; i.e.,
+ * a(x) = a[0]*x**0 + a[1]*x**1 + ... + a[da]*x**da.
+ *
+ *
+ * If desired, c may be the same as either a or b, in which
+ * case the input argument array is replaced by the product
+ * array (but only up to terms of degree da + db).
+ *
+ */
+
+/* cpmul */
+
+typedef struct
+ {
+ double r;
+ double i;
+ }cmplx;
+
+int cpmul( a, da, b, db, c, dc )
+cmplx *a, *b, *c;
+int da, db;
+int *dc;
+{
+int i, j, k;
+cmplx y;
+register cmplx *pa, *pb, *pc;
+
+if( da > db ) /* Know which polynomial has higher degree */
+ {
+ i = da; /* Swapping is OK because args are on the stack */
+ da = db;
+ db = i;
+ pa = a;
+ a = b;
+ b = pa;
+ }
+
+k = da + db;
+*dc = k; /* Output the degree of the product */
+pc = &c[db+1];
+for( i=db+1; i<=k; i++ ) /* Clear high order terms of output */
+ {
+ pc->r = 0;
+ pc->i = 0;
+ pc++;
+ }
+/* To permit replacement of input, work backward from highest degree */
+pb = &b[db];
+for( j=0; j<=db; j++ )
+ {
+ pa = &a[da];
+ pc = &c[k-j];
+ for( i=0; i<da; i++ )
+ {
+ y.r = pa->r * pb->r - pa->i * pb->i; /* cmpx multiply */
+ y.i = pa->r * pb->i + pa->i * pb->r;
+ pc->r += y.r; /* accumulate partial product */
+ pc->i += y.i;
+ pa--;
+ pc--;
+ }
+ y.r = pa->r * pb->r - pa->i * pb->i; /* replace last term, */
+ y.i = pa->r * pb->i + pa->i * pb->r; /* ...do not accumulate */
+ pc->r = y.r;
+ pc->i = y.i;
+ pb--;
+ }
+ return 0;
+}
diff --git a/libm/double/dawsn.c b/libm/double/dawsn.c
new file mode 100644
index 000000000..4f8d27a0c
--- /dev/null
+++ b/libm/double/dawsn.c
@@ -0,0 +1,392 @@
+/* dawsn.c
+ *
+ * Dawson's Integral
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, dawsn();
+ *
+ * y = dawsn( 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 10000 6.9e-16 1.0e-16
+ * DEC 0,10 6000 7.4e-17 1.4e-17
+ *
+ *
+ */
+
+/* dawsn.c */
+
+
+/*
+Cephes Math Library Release 2.8: June, 2000
+Copyright 1984, 1987, 1989, 2000 by Stephen L. Moshier
+*/
+
+#include <math.h>
+/* Dawson's integral, interval 0 to 3.25 */
+#ifdef UNK
+static double 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 double 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,
+};
+#endif
+#ifdef DEC
+static unsigned short AN[40] = {
+0027107,0176630,0075752,0107612,
+0030551,0070604,0166707,0127727,
+0031647,0002210,0117120,0056376,
+0033177,0156026,0141275,0140627,
+0033516,0112200,0037035,0165515,
+0035270,0150613,0016423,0105634,
+0135536,0156227,0023515,0044413,
+0037055,0015273,0105147,0064025,
+0137273,0163145,0014460,0166465,
+0040200,0000000,0000000,0000000,
+};
+static unsigned short AD[44] = {
+0027323,0067372,0115566,0131320,
+0030714,0114432,0074206,0006637,
+0032137,0160671,0044203,0026344,
+0033252,0146656,0020247,0100231,
+0034303,0003346,0123260,0022433,
+0035252,0125460,0173041,0155415,
+0036144,0113747,0125203,0124617,
+0036744,0166232,0143671,0133670,
+0037442,0127755,0162625,0000100,
+0040023,0026736,0003604,0106265,
+0040200,0000000,0000000,0000000,
+};
+#endif
+#ifdef IBMPC
+static unsigned short AN[40] = {
+0x51f1,0x0f7d,0xffb3,0x3da8,
+0xf5fb,0x9db8,0x2e30,0x3e0d,
+0x0ba0,0x13ca,0xe091,0x3e54,
+0xb833,0xd857,0xfb82,0x3eaf,
+0xbd6a,0x07c3,0xd290,0x3ec9,
+0x7174,0x63a2,0x1a31,0x3f37,
+0xa921,0xe4e9,0xdb92,0xbf4b,
+0xed03,0x714c,0xa357,0x3fa5,
+0x1da7,0xa326,0x7ccc,0xbfb7,
+0x0000,0x0000,0x0000,0x3ff0,
+};
+static unsigned short AD[44] = {
+0xd65a,0x536e,0x6ddf,0x3dba,
+0xc1b4,0x4f10,0x9323,0x3e19,
+0x659c,0x2910,0xfc37,0x3e6b,
+0xf013,0xc414,0x59b5,0x3eb5,
+0x04a3,0xd4d6,0x60dc,0x3ef8,
+0x3b62,0x1ec4,0x5566,0x3f35,
+0x7532,0xf550,0x92fc,0x3f6c,
+0x36f7,0x58f7,0x9d93,0x3f9c,
+0xa008,0xbcb2,0x55fd,0x3fc4,
+0x9197,0xc0f0,0x65bb,0x3fe2,
+0x0000,0x0000,0x0000,0x3ff0,
+};
+#endif
+#ifdef MIEEE
+static unsigned short AN[40] = {
+0x3da8,0xffb3,0x0f7d,0x51f1,
+0x3e0d,0x2e30,0x9db8,0xf5fb,
+0x3e54,0xe091,0x13ca,0x0ba0,
+0x3eaf,0xfb82,0xd857,0xb833,
+0x3ec9,0xd290,0x07c3,0xbd6a,
+0x3f37,0x1a31,0x63a2,0x7174,
+0xbf4b,0xdb92,0xe4e9,0xa921,
+0x3fa5,0xa357,0x714c,0xed03,
+0xbfb7,0x7ccc,0xa326,0x1da7,
+0x3ff0,0x0000,0x0000,0x0000,
+};
+static unsigned short AD[44] = {
+0x3dba,0x6ddf,0x536e,0xd65a,
+0x3e19,0x9323,0x4f10,0xc1b4,
+0x3e6b,0xfc37,0x2910,0x659c,
+0x3eb5,0x59b5,0xc414,0xf013,
+0x3ef8,0x60dc,0xd4d6,0x04a3,
+0x3f35,0x5566,0x1ec4,0x3b62,
+0x3f6c,0x92fc,0xf550,0x7532,
+0x3f9c,0x9d93,0x58f7,0x36f7,
+0x3fc4,0x55fd,0xbcb2,0xa008,
+0x3fe2,0x65bb,0xc0f0,0x9197,
+0x3ff0,0x0000,0x0000,0x0000,
+};
+#endif
+
+/* interval 3.25 to 6.25 */
+#ifdef UNK
+static double 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 double 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,
+};
+#endif
+#ifdef DEC
+static unsigned short BN[44] = {
+0040002,0045342,0113762,0004360,
+0137572,0120346,0172745,0144046,
+0037300,0151134,0123440,0117047,
+0136663,0025423,0014755,0046026,
+0036157,0177561,0027535,0046744,
+0135335,0161052,0071243,0146535,
+0034426,0154060,0164506,0135625,
+0133420,0005356,0100017,0151334,
+0032303,0066137,0024013,0046212,
+0131045,0016612,0066270,0047574,
+0027435,0177025,0060625,0116363,
+};
+static unsigned short BD[40] = {
+/*0040200,0000000,0000000,0000000,*/
+0140041,0140101,0174552,0037073,
+0037562,0061503,0124271,0160756,
+0137131,0151760,0073210,0110534,
+0036412,0170562,0117017,0155377,
+0135570,0101374,0074056,0037276,
+0034643,0145376,0001516,0060636,
+0133630,0173540,0121344,0155231,
+0032513,0005602,0134516,0007144,
+0131250,0150540,0075747,0105341,
+0027635,0177020,0012465,0125402,
+};
+#endif
+#ifdef IBMPC
+static unsigned short BN[44] = {
+0x411e,0x52fe,0x495c,0x3fe0,
+0xb905,0xdebc,0x541c,0xbfcf,
+0x13c5,0x94e4,0x1a4b,0x3fb8,
+0xa983,0x633d,0x6562,0xbf96,
+0xa9bd,0x25eb,0xffee,0x3f6d,
+0x79ac,0x4e54,0xbc45,0xbf3b,
+0xd773,0x1d28,0xdb06,0x3f02,
+0xfa5b,0xd001,0x015d,0xbec2,
+0x6991,0xe501,0x6d8b,0x3e78,
+0x09f0,0x4d97,0xa3b1,0xbe24,
+0xb39e,0xac32,0xbfc2,0x3dc3,
+};
+static unsigned short BD[40] = {
+/*0x0000,0x0000,0x0000,0x3ff0,*/
+0x47c7,0x3f2d,0x3808,0xbfe4,
+0x3c3e,0x7517,0x4c68,0x3fce,
+0x122b,0x0ed1,0x3a7e,0xbfab,
+0xfb60,0x53c1,0x5e2e,0x3f81,
+0xc7d8,0x8f05,0x105f,0xbf4f,
+0xcc34,0xc069,0x795f,0x3f14,
+0x9b53,0x145c,0x1eec,0xbed3,
+0xc1cd,0x5729,0x6170,0x3e89,
+0xf15c,0x0f7c,0x1a2c,0xbe35,
+0xb560,0x02a6,0xbfc2,0x3dd3,
+};
+#endif
+#ifdef MIEEE
+static unsigned short BN[44] = {
+0x3fe0,0x495c,0x52fe,0x411e,
+0xbfcf,0x541c,0xdebc,0xb905,
+0x3fb8,0x1a4b,0x94e4,0x13c5,
+0xbf96,0x6562,0x633d,0xa983,
+0x3f6d,0xffee,0x25eb,0xa9bd,
+0xbf3b,0xbc45,0x4e54,0x79ac,
+0x3f02,0xdb06,0x1d28,0xd773,
+0xbec2,0x015d,0xd001,0xfa5b,
+0x3e78,0x6d8b,0xe501,0x6991,
+0xbe24,0xa3b1,0x4d97,0x09f0,
+0x3dc3,0xbfc2,0xac32,0xb39e,
+};
+static unsigned short BD[40] = {
+/*0x3ff0,0x0000,0x0000,0x0000,*/
+0xbfe4,0x3808,0x3f2d,0x47c7,
+0x3fce,0x4c68,0x7517,0x3c3e,
+0xbfab,0x3a7e,0x0ed1,0x122b,
+0x3f81,0x5e2e,0x53c1,0xfb60,
+0xbf4f,0x105f,0x8f05,0xc7d8,
+0x3f14,0x795f,0xc069,0xcc34,
+0xbed3,0x1eec,0x145c,0x9b53,
+0x3e89,0x6170,0x5729,0xc1cd,
+0xbe35,0x1a2c,0x0f7c,0xf15c,
+0x3dd3,0xbfc2,0x02a6,0xb560,
+};
+#endif
+
+/* 6.25 to infinity */
+#ifdef UNK
+static double CN[5] = {
+-5.90592860534773254987E-1,
+ 6.29235242724368800674E-1,
+-1.72858975380388136411E-1,
+ 1.64837047825189632310E-2,
+-4.86827613020462700845E-4,
+};
+static double CD[5] = {
+/* 1.00000000000000000000E0,*/
+-2.69820057197544900361E0,
+ 1.73270799045947845857E0,
+-3.93708582281939493482E-1,
+ 3.44278924041233391079E-2,
+-9.73655226040941223894E-4,
+};
+#endif
+#ifdef DEC
+static unsigned short CN[20] = {
+0140027,0030427,0176477,0074402,
+0040041,0012617,0112375,0162657,
+0137461,0000761,0074120,0135160,
+0036607,0004325,0117246,0115525,
+0135377,0036345,0064750,0047732,
+};
+static unsigned short CD[20] = {
+/*0040200,0000000,0000000,0000000,*/
+0140454,0127521,0071653,0133415,
+0040335,0144540,0016105,0045241,
+0137711,0112053,0155034,0062237,
+0037015,0002102,0177442,0074546,
+0135577,0036345,0064750,0052152,
+};
+#endif
+#ifdef IBMPC
+static unsigned short CN[20] = {
+0xef20,0xffa7,0xe622,0xbfe2,
+0xbcb6,0xf29f,0x22b1,0x3fe4,
+0x174e,0x2f0a,0x203e,0xbfc6,
+0xd36b,0xb3d4,0xe11a,0x3f90,
+0x09fb,0xad3d,0xe79c,0xbf3f,
+};
+static unsigned short CD[20] = {
+/*0x0000,0x0000,0x0000,0x3ff0,*/
+0x76e2,0x2e75,0x95ea,0xc005,
+0xa954,0x0388,0xb92c,0x3ffb,
+0x8c94,0x7b43,0x3285,0xbfd9,
+0x4f2d,0x5fe4,0xa088,0x3fa1,
+0x0a8d,0xad3d,0xe79c,0xbf4f,
+};
+#endif
+#ifdef MIEEE
+static unsigned short CN[20] = {
+0xbfe2,0xe622,0xffa7,0xef20,
+0x3fe4,0x22b1,0xf29f,0xbcb6,
+0xbfc6,0x203e,0x2f0a,0x174e,
+0x3f90,0xe11a,0xb3d4,0xd36b,
+0xbf3f,0xe79c,0xad3d,0x09fb,
+};
+static unsigned short CD[20] = {
+/*0x3ff0,0x0000,0x0000,0x0000,*/
+0xc005,0x95ea,0x2e75,0x76e2,
+0x3ffb,0xb92c,0x0388,0xa954,
+0xbfd9,0x3285,0x7b43,0x8c94,
+0x3fa1,0xa088,0x5fe4,0x4f2d,
+0xbf4f,0xe79c,0xad3d,0x0a8d,
+};
+#endif
+
+#ifdef ANSIPROT
+extern double chbevl ( double, void *, int );
+extern double sqrt ( double );
+extern double fabs ( double );
+extern double polevl ( double, void *, int );
+extern double p1evl ( double, void *, int );
+#else
+double chbevl(), sqrt(), fabs(), polevl(), p1evl();
+#endif
+extern double PI, MACHEP;
+
+double dawsn( xx )
+double xx;
+{
+double x, y;
+int sign;
+
+
+sign = 1;
+if( xx < 0.0 )
+ {
+ sign = -1;
+ xx = -xx;
+ }
+
+if( xx < 3.25 )
+{
+x = xx*xx;
+y = xx * polevl( x, AN, 9 )/polevl( x, AD, 10 );
+return( sign * y );
+}
+
+
+x = 1.0/(xx*xx);
+
+if( xx < 6.25 )
+ {
+ y = 1.0/xx + x * polevl( x, BN, 10) / (p1evl( 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 * polevl( x, CN, 4) / (p1evl( x, CD, 5) * xx);
+return( sign * 0.5 * y );
+}
diff --git a/libm/double/dcalc.c b/libm/double/dcalc.c
new file mode 100644
index 000000000..b740edae2
--- /dev/null
+++ b/libm/double/dcalc.c
@@ -0,0 +1,1512 @@
+/* calc.c */
+/* Keyboard command interpreter */
+/* by Stephen L. Moshier */
+
+
+/* length of command line: */
+#define LINLEN 128
+
+#define XON 0x11
+#define XOFF 0x13
+
+#define SALONE 1
+#define DECPDP 0
+#define INTLOGIN 0
+#define INTHELP 1
+#ifndef TRUE
+#define TRUE 1
+#endif
+
+/* Initialize squirrel printf: */
+#define INIPRINTF 0
+
+#if DECPDP
+#define TRUE 1
+#endif
+
+#include <stdio.h>
+#include <string.h>
+
+static char idterp[] = {
+"\n\nSteve Moshier's command interpreter V1.3\n"};
+#define ISLOWER(c) ((c >= 'a') && (c <= 'z'))
+#define ISUPPER(c) ((c >= 'A') && (c <= 'Z'))
+#define ISALPHA(c) (ISLOWER(c) || ISUPPER(c))
+#define ISDIGIT(c) ((c >= '0') && (c <= '9'))
+#define ISATF(c) (((c >= 'a')&&(c <= 'f')) || ((c >= 'A')&&(c <= 'F')))
+#define ISXDIGIT(c) (ISDIGIT(c) || ISATF(c))
+#define ISOCTAL(c) ((c >= '0') && (c < '8'))
+#define ISALNUM(c) (ISALPHA(c) || (ISDIGIT(c))
+FILE *fopen();
+
+#include "dcalc.h"
+/* #include "ehead.h" */
+#include <math.h>
+/* int strlen(), strcmp(); */
+int system();
+
+/* space for working precision numbers */
+static double vs[22];
+
+/* the symbol table of temporary variables: */
+
+#define NTEMP 4
+struct varent temp[NTEMP] = {
+{"T", OPR | TEMP, &vs[14]},
+{"T", OPR | TEMP, &vs[15]},
+{"T", OPR | TEMP, &vs[16]},
+{"\0", OPR | TEMP, &vs[17]}
+};
+
+/* the symbol table of operators */
+/* EOL is interpreted on null, newline, or ; */
+struct symbol oprtbl[] = {
+{"BOL", OPR | BOL, 0},
+{"EOL", OPR | EOL, 0},
+{"-", OPR | UMINUS, 8},
+/*"~", OPR | COMP, 8,*/
+{",", OPR | EOE, 1},
+{"=", OPR | EQU, 2},
+/*"|", OPR | LOR, 3,*/
+/*"^", OPR | LXOR, 4,*/
+/*"&", OPR | LAND, 5,*/
+{"+", OPR | PLUS, 6},
+{"-", OPR | MINUS, 6},
+{"*", OPR | MULT, 7},
+{"/", OPR | DIV, 7},
+/*"%", OPR | MOD, 7,*/
+{"(", OPR | LPAREN, 11},
+{")", OPR | RPAREN, 11},
+{"\0", ILLEG, 0}
+};
+
+#define NOPR 8
+
+/* the symbol table of indirect variables: */
+extern double PI;
+struct varent indtbl[] = {
+{"t", VAR | IND, &vs[21]},
+{"u", VAR | IND, &vs[20]},
+{"v", VAR | IND, &vs[19]},
+{"w", VAR | IND, &vs[18]},
+{"x", VAR | IND, &vs[10]},
+{"y", VAR | IND, &vs[11]},
+{"z", VAR | IND, &vs[12]},
+{"pi", VAR | IND, &PI},
+{"\0", ILLEG, 0}
+};
+
+/* the symbol table of constants: */
+
+#define NCONST 10
+struct varent contbl[NCONST] = {
+{"C",CONST,&vs[0]},
+{"C",CONST,&vs[1]},
+{"C",CONST,&vs[2]},
+{"C",CONST,&vs[3]},
+{"C",CONST,&vs[4]},
+{"C",CONST,&vs[5]},
+{"C",CONST,&vs[6]},
+{"C",CONST,&vs[7]},
+{"C",CONST,&vs[8]},
+{"\0",CONST,&vs[9]}
+};
+
+/* the symbol table of string variables: */
+
+static char strngs[160] = {0};
+
+#define NSTRNG 5
+struct strent strtbl[NSTRNG] = {
+{0, VAR | STRING, 0},
+{0, VAR | STRING, 0},
+{0, VAR | STRING, 0},
+{0, VAR | STRING, 0},
+{"\0",ILLEG,0},
+};
+
+
+/* Help messages */
+#if INTHELP
+static char *intmsg[] = {
+"?",
+"Unkown symbol",
+"Expression ends in illegal operator",
+"Precede ( by operator",
+")( is illegal",
+"Unmatched )",
+"Missing )",
+"Illegal left hand side",
+"Missing symbol",
+"Must assign to a variable",
+"Divide by zero",
+"Missing symbol",
+"Missing operator",
+"Precede quantity by operator",
+"Quantity preceded by )",
+"Function syntax",
+"Too many function args",
+"No more temps",
+"Arg list"
+};
+#endif
+
+#ifdef ANSIPROT
+double floor ( double );
+int dprec ( void );
+#else
+double floor();
+int dprec();
+#endif
+/* the symbol table of functions: */
+#if SALONE
+#ifdef ANSIPROT
+extern double floor ( double );
+extern double log ( double );
+extern double pow ( double, double );
+extern double sqrt ( double );
+extern double tanh ( double );
+extern double exp ( double );
+extern double fabs ( double );
+extern double hypot ( double, double );
+extern double frexp ( double, int * );
+extern double ldexp ( double, int );
+extern double incbet ( double, double, double );
+extern double incbi ( double, double, double );
+extern double sin ( double );
+extern double cos ( double );
+extern double atan ( double );
+extern double atan2 ( double, double );
+extern double gamma ( double );
+extern double lgam ( double );
+double zfrexp ( double );
+double zldexp ( double, double );
+double makenan ( double );
+double makeinfinity ( double );
+double hex ( double );
+double hexinput ( double, double );
+double cmdh ( void );
+double cmdhlp ( void );
+double init ( void );
+double cmddm ( void );
+double cmdtm ( void );
+double cmdem ( double );
+double take ( char * );
+double mxit ( void );
+double bits ( double );
+double csys ( char * );
+double cmddig ( double );
+double prhlst ( void * );
+double abmac ( void );
+double ifrac ( double );
+double xcmpl ( double, double );
+void exit ( int );
+#else
+void exit();
+double hex(), hexinput(), cmdh(), cmdhlp(), init();
+double cmddm(), cmdtm(), cmdem();
+double take(), mxit(), bits(), csys();
+double cmddig(), prhlst(), abmac();
+double ifrac(), xcmpl();
+double floor(), log(), pow(), sqrt(), tanh(), exp(), fabs(), hypot();
+double frexp(), zfrexp(), ldexp(), zldexp(), makenan(), makeinfinity();
+double incbet(), incbi(), sin(), cos(), atan(), atan2(), gamma(), lgam();
+#define GLIBC2 0
+#if GLIBC2
+double lgamma();
+#endif
+#endif /* not ANSIPROT */
+struct funent funtbl[] = {
+{"h", OPR | FUNC, cmdh},
+{"help", OPR | FUNC, cmdhlp},
+{"hex", OPR | FUNC, hex},
+{"hexinput", OPR | FUNC, hexinput},
+/*"view", OPR | FUNC, view,*/
+{"exp", OPR | FUNC, exp},
+{"floor", OPR | FUNC, floor},
+{"log", OPR | FUNC, log},
+{"pow", OPR | FUNC, pow},
+{"sqrt", OPR | FUNC, sqrt},
+{"tanh", OPR | FUNC, tanh},
+{"sin", OPR | FUNC, sin},
+{"cos", OPR | FUNC, cos},
+{"atan", OPR | FUNC, atan},
+{"atantwo", OPR | FUNC, atan2},
+{"tanh", OPR | FUNC, tanh},
+{"gamma", OPR | FUNC, gamma},
+#if GLIBC2
+{"lgamma", OPR | FUNC, lgamma},
+#else
+{"lgam", OPR | FUNC, lgam},
+#endif
+{"incbet", OPR | FUNC, incbet},
+{"incbi", OPR | FUNC, incbi},
+{"fabs", OPR | FUNC, fabs},
+{"hypot", OPR | FUNC, hypot},
+{"ldexp", OPR | FUNC, zldexp},
+{"frexp", OPR | FUNC, zfrexp},
+{"nan", OPR | FUNC, makenan},
+{"infinity", OPR | FUNC, makeinfinity},
+{"ifrac", OPR | FUNC, ifrac},
+{"cmp", OPR | FUNC, xcmpl},
+{"bits", OPR | FUNC, bits},
+{"digits", OPR | FUNC, cmddig},
+{"dm", OPR | FUNC, cmddm},
+{"tm", OPR | FUNC, cmdtm},
+{"em", OPR | FUNC, cmdem},
+{"take", OPR | FUNC | COMMAN, take},
+{"system", OPR | FUNC | COMMAN, csys},
+{"exit", OPR | FUNC, mxit},
+/*
+"remain", OPR | FUNC, eremain,
+*/
+{"\0", OPR | FUNC, 0}
+};
+
+/* the symbol table of key words */
+struct funent keytbl[] = {
+{"\0", ILLEG, 0}
+};
+#endif
+
+void zgets();
+
+/* Number of decimals to display */
+#define DEFDIS 70
+static int ndigits = DEFDIS;
+
+/* Menu stack */
+struct funent *menstk[5] = {&funtbl[0], NULL, NULL, NULL, NULL};
+int menptr = 0;
+
+/* Take file stack */
+FILE *takstk[10] = {0};
+int takptr = -1;
+
+/* size of the expression scan list: */
+#define NSCAN 20
+
+/* previous token, saved for syntax checking: */
+struct symbol *lastok = 0;
+
+/* variables used by parser: */
+static char str[128] = {0};
+int uposs = 0; /* possible unary operator */
+static double qnc;
+char lc[40] = { '\n' }; /* ASCII string of token symbol */
+static char line[LINLEN] = { '\n','\0' }; /* input command line */
+static char maclin[LINLEN] = { '\n','\0' }; /* macro command */
+char *interl = line; /* pointer into line */
+extern char *interl;
+static int maccnt = 0; /* number of times to execute macro command */
+static int comptr = 0; /* comma stack pointer */
+static double comstk[5]; /* comma argument stack */
+static int narptr = 0; /* pointer to number of args */
+static int narstk[5] = {0}; /* stack of number of function args */
+
+/* main() */
+
+/* Entire program starts here */
+
+int main()
+{
+
+/* the scan table: */
+
+/* array of pointers to symbols which have been parsed: */
+struct symbol *ascsym[NSCAN];
+
+/* current place in ascsym: */
+register struct symbol **as;
+
+/* array of attributes of operators parsed: */
+int ascopr[NSCAN];
+
+/* current place in ascopr: */
+register int *ao;
+
+#if LARGEMEM
+/* array of precedence levels of operators: */
+long asclev[NSCAN];
+/* current place in asclev: */
+long *al;
+long symval; /* value of symbol just parsed */
+#else
+int asclev[NSCAN];
+int *al;
+int symval;
+#endif
+
+double acc; /* the accumulator, for arithmetic */
+int accflg; /* flags accumulator in use */
+double val; /* value to be combined into accumulator */
+register struct symbol *psym; /* pointer to symbol just parsed */
+struct varent *pvar; /* pointer to an indirect variable symbol */
+struct funent *pfun; /* pointer to a function symbol */
+struct strent *pstr; /* pointer to a string symbol */
+int att; /* attributes of symbol just parsed */
+int i; /* counter */
+int offset; /* parenthesis level */
+int lhsflg; /* kluge to detect illegal assignments */
+struct symbol *parser(); /* parser returns pointer to symbol */
+int errcod; /* for syntax error printout */
+
+
+/* Perform general initialization */
+
+init();
+
+menstk[0] = &funtbl[0];
+menptr = 0;
+cmdhlp(); /* print out list of symbols */
+
+
+/* Return here to get next command line to execute */
+getcmd:
+
+/* initialize registers and mutable symbols */
+
+accflg = 0; /* Accumulator not in use */
+acc = 0.0; /* Clear the accumulator */
+offset = 0; /* Parenthesis level zero */
+comptr = 0; /* Start of comma stack */
+narptr = -1; /* Start of function arg counter stack */
+
+psym = (struct symbol *)&contbl[0];
+for( i=0; i<NCONST; i++ )
+ {
+ psym->attrib = CONST; /* clearing the busy bit */
+ ++psym;
+ }
+psym = (struct symbol *)&temp[0];
+for( i=0; i<NTEMP; i++ )
+ {
+ psym->attrib = VAR | TEMP; /* clearing the busy bit */
+ ++psym;
+ }
+
+pstr = &strtbl[0];
+for( i=0; i<NSTRNG; i++ )
+ {
+ pstr->spel = &strngs[ 40*i ];
+ pstr->attrib = STRING | VAR;
+ pstr->string = &strngs[ 40*i ];
+ ++pstr;
+ }
+
+/* List of scanned symbols is empty: */
+as = &ascsym[0];
+*as = 0;
+--as;
+/* First item in scan list is Beginning of Line operator */
+ao = &ascopr[0];
+*ao = oprtbl[0].attrib & 0xf; /* BOL */
+/* value of first item: */
+al = &asclev[0];
+*al = oprtbl[0].sym;
+
+lhsflg = 0; /* illegal left hand side flag */
+psym = &oprtbl[0]; /* pointer to current token */
+
+/* get next token from input string */
+
+gettok:
+lastok = psym; /* last token = current token */
+psym = parser(); /* get a new current token */
+/*printf( "%s attrib %7o value %7o\n", psym->spel, psym->attrib & 0xffff,
+ psym->sym );*/
+
+/* Examine attributes of the symbol returned by the parser */
+att = psym->attrib;
+if( att == ILLEG )
+ {
+ errcod = 1;
+ goto synerr;
+ }
+
+/* Push functions onto scan list without analyzing further */
+if( att & FUNC )
+ {
+ /* A command is a function whose argument is
+ * a pointer to the rest of the input line.
+ * A second argument is also passed: the address
+ * of the last token parsed.
+ */
+ if( att & COMMAN )
+ {
+ pfun = (struct funent *)psym;
+ ( *(pfun->fun))( interl, lastok );
+ abmac(); /* scrub the input line */
+ goto getcmd; /* and ask for more input */
+ }
+ ++narptr; /* offset to number of args */
+ narstk[narptr] = 0;
+ i = lastok->attrib & 0xffff; /* attrib=short, i=int */
+ if( ((i & OPR) == 0)
+ || (i == (OPR | RPAREN))
+ || (i == (OPR | FUNC)) )
+ {
+ errcod = 15;
+ goto synerr;
+ }
+
+ ++lhsflg;
+ ++as;
+ *as = psym;
+ ++ao;
+ *ao = FUNC;
+ ++al;
+ *al = offset + UMINUS;
+ goto gettok;
+ }
+
+/* deal with operators */
+if( att & OPR )
+ {
+ att &= 0xf;
+ /* expression cannot end with an operator other than
+ * (, ), BOL, or a function
+ */
+ if( (att == RPAREN) || (att == EOL) || (att == EOE))
+ {
+ i = lastok->attrib & 0xffff; /* attrib=short, i=int */
+ if( (i & OPR)
+ && (i != (OPR | RPAREN))
+ && (i != (OPR | LPAREN))
+ && (i != (OPR | FUNC))
+ && (i != (OPR | BOL)) )
+ {
+ errcod = 2;
+ goto synerr;
+ }
+ }
+ ++lhsflg; /* any operator but ( and = is not a legal lhs */
+
+/* operator processing, continued */
+
+ switch( att )
+ {
+ case EOE:
+ lhsflg = 0;
+ break;
+ case LPAREN:
+ /* ( must be preceded by an operator of some sort. */
+ if( ((lastok->attrib & OPR) == 0) )
+ {
+ errcod = 3;
+ goto synerr;
+ }
+ /* also, a preceding ) is illegal */
+ if( (unsigned short )lastok->attrib == (OPR|RPAREN))
+ {
+ errcod = 4;
+ goto synerr;
+ }
+ /* Begin looking for illegal left hand sides: */
+ lhsflg = 0;
+ offset += RPAREN; /* new parenthesis level */
+ goto gettok;
+ case RPAREN:
+ offset -= RPAREN; /* parenthesis level */
+ if( offset < 0 )
+ {
+ errcod = 5; /* parenthesis error */
+ goto synerr;
+ }
+ goto gettok;
+ case EOL:
+ if( offset != 0 )
+ {
+ errcod = 6; /* parenthesis error */
+ goto synerr;
+ }
+ break;
+ case EQU:
+ if( --lhsflg ) /* was incremented before switch{} */
+ {
+ errcod = 7;
+ goto synerr;
+ }
+ case UMINUS:
+ case COMP:
+ goto pshopr; /* evaluate right to left */
+ default: ;
+ }
+
+
+/* evaluate expression whenever precedence is not increasing */
+
+symval = psym->sym + offset;
+
+while( symval <= *al )
+ {
+ /* if just starting, must fill accumulator with last
+ * thing on the line
+ */
+ if( (accflg == 0) && (as >= ascsym) && (((*as)->attrib & FUNC) == 0 ))
+ {
+ pvar = (struct varent *)*as;
+/*
+ if( pvar->attrib & STRING )
+ strcpy( (char *)&acc, (char *)pvar->value );
+ else
+*/
+ acc = *pvar->value;
+ --as;
+ accflg = 1;
+ }
+
+/* handle beginning of line type cases, where the symbol
+ * list ascsym[] may be empty.
+ */
+ switch( *ao )
+ {
+ case BOL:
+ printf( "%.16e\n", acc );
+#if 0
+#if NE == 6
+ e64toasc( &acc, str, 100 );
+#else
+ e113toasc( &acc, str, 100 );
+#endif
+#endif
+ printf( "%s\n", str );
+ goto getcmd; /* all finished */
+ case UMINUS:
+ acc = -acc;
+ goto nochg;
+/*
+ case COMP:
+ acc = ~acc;
+ goto nochg;
+*/
+ default: ;
+ }
+/* Now it is illegal for symbol list to be empty,
+ * because we are going to need a symbol below.
+ */
+ if( as < &ascsym[0] )
+ {
+ errcod = 8;
+ goto synerr;
+ }
+/* get attributes and value of current symbol */
+ att = (*as)->attrib;
+ pvar = (struct varent *)*as;
+ if( att & FUNC )
+ val = 0.0;
+ else
+ {
+/*
+ if( att & STRING )
+ strcpy( (char *)&val, (char *)pvar->value );
+ else
+*/
+ val = *pvar->value;
+ }
+
+/* Expression evaluation, continued. */
+
+ switch( *ao )
+ {
+ case FUNC:
+ pfun = (struct funent *)*as;
+ /* Call the function with appropriate number of args */
+ i = narstk[ narptr ];
+ --narptr;
+ switch(i)
+ {
+ case 0:
+ acc = ( *(pfun->fun) )(acc);
+ break;
+ case 1:
+ acc = ( *(pfun->fun) )(acc, comstk[comptr-1]);
+ break;
+ case 2:
+ acc = ( *(pfun->fun) )(acc, comstk[comptr-2],
+ comstk[comptr-1]);
+ break;
+ case 3:
+ acc = ( *(pfun->fun) )(acc, comstk[comptr-3],
+ comstk[comptr-2], comstk[comptr-1]);
+ break;
+ default:
+ errcod = 16;
+ goto synerr;
+ }
+ comptr -= i;
+ accflg = 1; /* in case at end of line */
+ break;
+ case EQU:
+ if( ( att & TEMP) || ((att & VAR) == 0) || (att & STRING) )
+ {
+ errcod = 9;
+ goto synerr; /* can only assign to a variable */
+ }
+ pvar = (struct varent *)*as;
+ *pvar->value = acc;
+ break;
+ case PLUS:
+ acc = acc + val; break;
+ case MINUS:
+ acc = val - acc; break;
+ case MULT:
+ acc = acc * val; break;
+ case DIV:
+ if( acc == 0.0 )
+ {
+/*
+divzer:
+*/
+ errcod = 10;
+ goto synerr;
+ }
+ acc = val / acc; break;
+/*
+ case MOD:
+ if( acc == 0 )
+ goto divzer;
+ acc = val % acc; break;
+ case LOR:
+ acc |= val; break;
+ case LXOR:
+ acc ^= val; break;
+ case LAND:
+ acc &= val; break;
+*/
+ case EOE:
+ if( narptr < 0 )
+ {
+ errcod = 18;
+ goto synerr;
+ }
+ narstk[narptr] += 1;
+ comstk[comptr++] = acc;
+/* printf( "\ncomptr: %d narptr: %d %d\n", comptr, narptr, acc );*/
+ acc = val;
+ break;
+ }
+
+
+/* expression evaluation, continued */
+
+/* Pop evaluated tokens from scan list: */
+ /* make temporary variable not busy */
+ if( att & TEMP )
+ (*as)->attrib &= ~BUSY;
+ if( as < &ascsym[0] ) /* can this happen? */
+ {
+ errcod = 11;
+ goto synerr;
+ }
+ --as;
+nochg:
+ --ao;
+ --al;
+ if( ao < &ascopr[0] ) /* can this happen? */
+ {
+ errcod = 12;
+ goto synerr;
+ }
+/* If precedence level will now increase, then */
+/* save accumulator in a temporary location */
+ if( symval > *al )
+ {
+ /* find a free temp location */
+ pvar = &temp[0];
+ for( i=0; i<NTEMP; i++ )
+ {
+ if( (pvar->attrib & BUSY) == 0)
+ goto temfnd;
+ ++pvar;
+ }
+ errcod = 17;
+ printf( "no more temps\n" );
+ pvar = &temp[0];
+ goto synerr;
+
+ temfnd:
+ pvar->attrib |= BUSY;
+ *pvar->value = acc;
+ /*printf( "temp %d\n", acc );*/
+ accflg = 0;
+ ++as; /* push the temp onto the scan list */
+ *as = (struct symbol *)pvar;
+ }
+ } /* End of evaluation loop */
+
+
+/* Push operator onto scan list when precedence increases */
+
+pshopr:
+ ++ao;
+ *ao = psym->attrib & 0xf;
+ ++al;
+ *al = psym->sym + offset;
+ goto gettok;
+ } /* end of OPR processing */
+
+
+/* Token was not an operator. Push symbol onto scan list. */
+if( (lastok->attrib & OPR) == 0 )
+ {
+ errcod = 13;
+ goto synerr; /* quantities must be preceded by an operator */
+ }
+if( (unsigned short )lastok->attrib == (OPR | RPAREN) ) /* ...but not by ) */
+ {
+ errcod = 14;
+ goto synerr;
+ }
+++as;
+*as = psym;
+goto gettok;
+
+synerr:
+
+#if INTHELP
+printf( "%s ", intmsg[errcod] );
+#endif
+printf( " error %d\n", errcod );
+abmac(); /* flush the command line */
+goto getcmd;
+} /* end of program */
+
+/* parser() */
+
+/* Get token from input string and identify it. */
+
+
+static char number[128];
+
+struct symbol *parser( )
+{
+register struct symbol *psym;
+register char *pline;
+struct varent *pvar;
+struct strent *pstr;
+char *cp, *plc, *pn;
+long lnc;
+int i;
+double tem;
+
+/* reference for old Whitesmiths compiler: */
+/*
+ *extern FILE *stdout;
+ */
+
+pline = interl; /* get current location in command string */
+
+
+/* If at beginning of string, must ask for more input */
+if( pline == line )
+ {
+
+ if( maccnt > 0 )
+ {
+ --maccnt;
+ cp = maclin;
+ plc = pline;
+ while( (*plc++ = *cp++) != 0 )
+ ;
+ goto mstart;
+ }
+ if( takptr < 0 )
+ { /* no take file active: prompt keyboard input */
+ printf("* ");
+ }
+/* Various ways of typing in a command line. */
+
+/*
+ * Old Whitesmiths call to print "*" immediately
+ * use RT11 .GTLIN to get command string
+ * from command file or terminal
+ */
+
+/*
+ * fflush(stdout);
+ * gtlin(line);
+ */
+
+
+ zgets( line, TRUE ); /* keyboard input for other systems: */
+
+
+mstart:
+ uposs = 1; /* unary operators possible at start of line */
+ }
+
+ignore:
+/* Skip over spaces */
+while( *pline == ' ' )
+ ++pline;
+
+/* unary minus after operator */
+if( uposs && (*pline == '-') )
+ {
+ psym = &oprtbl[2]; /* UMINUS */
+ ++pline;
+ goto pdon3;
+ }
+ /* COMP */
+/*
+if( uposs && (*pline == '~') )
+ {
+ psym = &oprtbl[3];
+ ++pline;
+ goto pdon3;
+ }
+*/
+if( uposs && (*pline == '+') ) /* ignore leading plus sign */
+ {
+ ++pline;
+ goto ignore;
+ }
+
+/* end of null terminated input */
+if( (*pline == '\n') || (*pline == '\0') || (*pline == '\r') )
+ {
+ pline = line;
+ goto endlin;
+ }
+if( *pline == ';' )
+ {
+ ++pline;
+endlin:
+ psym = &oprtbl[1]; /* EOL */
+ goto pdon2;
+ }
+
+
+/* parser() */
+
+
+/* Test for numeric input */
+if( (ISDIGIT(*pline)) || (*pline == '.') )
+ {
+ lnc = 0; /* initialize numeric input to zero */
+ qnc = 0.0;
+ if( *pline == '0' )
+ { /* leading "0" may mean octal or hex radix */
+ ++pline;
+ if( *pline == '.' )
+ goto decimal; /* 0.ddd */
+ /* leading "0x" means hexadecimal radix */
+ if( (*pline == 'x') || (*pline == 'X') )
+ {
+ ++pline;
+ while( ISXDIGIT(*pline) )
+ {
+ i = *pline++ & 0xff;
+ if( i >= 'a' )
+ i -= 047;
+ if( i >= 'A' )
+ i -= 07;
+ i -= 060;
+ lnc = (lnc << 4) + i;
+ qnc = lnc;
+ }
+ goto numdon;
+ }
+ else
+ {
+ while( ISOCTAL( *pline ) )
+ {
+ i = ((*pline++) & 0xff) - 060;
+ lnc = (lnc << 3) + i;
+ qnc = lnc;
+ }
+ goto numdon;
+ }
+ }
+ else
+ {
+ /* no leading "0" means decimal radix */
+/******/
+decimal:
+ pn = number;
+ while( (ISDIGIT(*pline)) || (*pline == '.') )
+ *pn++ = *pline++;
+/* get possible exponent field */
+ if( (*pline == 'e') || (*pline == 'E') )
+ *pn++ = *pline++;
+ else
+ goto numcvt;
+ if( (*pline == '-') || (*pline == '+') )
+ *pn++ = *pline++;
+ while( ISDIGIT(*pline) )
+ *pn++ = *pline++;
+numcvt:
+ *pn++ = ' ';
+ *pn++ = 0;
+#if 0
+#if NE == 6
+ asctoe64( number, &qnc );
+#else
+ asctoe113( number, &qnc );
+#endif
+#endif
+ sscanf( number, "%le", &qnc );
+ }
+/* output the number */
+numdon:
+ /* search the symbol table of constants */
+ pvar = &contbl[0];
+ for( i=0; i<NCONST; i++ )
+ {
+ if( (pvar->attrib & BUSY) == 0 )
+ goto confnd;
+ tem = *pvar->value;
+ if( tem == qnc )
+ {
+ psym = (struct symbol *)pvar;
+ goto pdon2;
+ }
+ ++pvar;
+ }
+ printf( "no room for constant\n" );
+ psym = (struct symbol *)&contbl[0];
+ goto pdon2;
+
+confnd:
+ pvar->spel= contbl[0].spel;
+ pvar->attrib = CONST | BUSY;
+ *pvar->value = qnc;
+ psym = (struct symbol *)pvar;
+ goto pdon2;
+ }
+
+/* check for operators */
+psym = &oprtbl[3];
+for( i=0; i<NOPR; i++ )
+ {
+ if( *pline == *(psym->spel) )
+ goto pdon1;
+ ++psym;
+ }
+
+/* if quoted, it is a string variable */
+if( *pline == '"' )
+ {
+ /* find an empty slot for the string */
+ pstr = strtbl; /* string table */
+ for( i=0; i<NSTRNG-1; i++ )
+ {
+ if( (pstr->attrib & BUSY) == 0 )
+ goto fndstr;
+ ++pstr;
+ }
+ printf( "No room for string\n" );
+ pstr->attrib |= ILLEG;
+ psym = (struct symbol *)pstr;
+ goto pdon0;
+
+fndstr:
+ pstr->attrib |= BUSY;
+ plc = pstr->string;
+ ++pline;
+ for( i=0; i<39; i++ )
+ {
+ *plc++ = *pline;
+ if( (*pline == '\n') || (*pline == '\0') || (*pline == '\r') )
+ {
+illstr:
+ pstr = &strtbl[NSTRNG-1];
+ pstr->attrib |= ILLEG;
+ printf( "Missing string terminator\n" );
+ psym = (struct symbol *)pstr;
+ goto pdon0;
+ }
+ if( *pline++ == '"' )
+ goto finstr;
+ }
+
+ goto illstr; /* no terminator found */
+
+finstr:
+ --plc;
+ *plc = '\0';
+ psym = (struct symbol *)pstr;
+ goto pdon2;
+ }
+/* If none of the above, search function and symbol tables: */
+
+/* copy character string to array lc[] */
+plc = &lc[0];
+while( ISALPHA(*pline) )
+ {
+ /* convert to lower case characters */
+ if( ISUPPER( *pline ) )
+ *pline += 040;
+ *plc++ = *pline++;
+ }
+*plc = 0; /* Null terminate the output string */
+
+/* parser() */
+
+psym = (struct symbol *)menstk[menptr]; /* function table */
+plc = &lc[0];
+cp = psym->spel;
+do
+ {
+ if( strcmp( plc, cp ) == 0 )
+ goto pdon3; /* following unary minus is possible */
+ ++psym;
+ cp = psym->spel;
+ }
+while( *cp != '\0' );
+
+psym = (struct symbol *)&indtbl[0]; /* indirect symbol table */
+plc = &lc[0];
+cp = psym->spel;
+do
+ {
+ if( strcmp( plc, cp ) == 0 )
+ goto pdon2;
+ ++psym;
+ cp = psym->spel;
+ }
+while( *cp != '\0' );
+
+pdon0:
+pline = line; /* scrub line if illegal symbol */
+goto pdon2;
+
+pdon1:
+++pline;
+if( (psym->attrib & 0xf) == RPAREN )
+pdon2: uposs = 0;
+else
+pdon3: uposs = 1;
+
+interl = pline;
+return( psym );
+} /* end of parser */
+
+/* exit from current menu */
+
+double cmdex()
+{
+
+if( menptr == 0 )
+ {
+ printf( "Main menu is active.\n" );
+ }
+else
+ --menptr;
+
+cmdh();
+return(0.0);
+}
+
+
+/* gets() */
+
+void zgets( gline, echo )
+char *gline;
+int echo;
+{
+register char *pline;
+register int i;
+
+
+scrub:
+pline = gline;
+getsl:
+ if( (pline - gline) >= LINLEN )
+ {
+ printf( "\nLine too long\n *" );
+ goto scrub;
+ }
+ if( takptr < 0 )
+ { /* get character from keyboard */
+/*
+if DECPDP
+ gtlin( gline );
+ return(0);
+else
+*/
+ *pline = getchar();
+/*endif*/
+ }
+ else
+ { /* get a character from take file */
+ i = fgetc( takstk[takptr] );
+ if( i == -1 )
+ { /* end of take file */
+ if( takptr >= 0 )
+ { /* close file and bump take stack */
+ fclose( takstk[takptr] );
+ takptr -= 1;
+ }
+ if( takptr < 0 ) /* no more take files: */
+ printf( "*" ); /* prompt keyboard input */
+ goto scrub; /* start a new input line */
+ }
+ *pline = i;
+ }
+
+ *pline &= 0x7f;
+ /* xon or xoff characters need filtering out. */
+ if ( *pline == XON || *pline == XOFF )
+ goto getsl;
+
+ /* control U or control C */
+ if( (*pline == 025) || (*pline == 03) )
+ {
+ printf( "\n" );
+ goto scrub;
+ }
+
+ /* Backspace or rubout */
+ if( (*pline == 010) || (*pline == 0177) )
+ {
+ pline -= 1;
+ if( pline >= gline )
+ {
+ if ( echo )
+ printf( "\010\040\010" );
+ goto getsl;
+ }
+ else
+ goto scrub;
+ }
+ if ( echo )
+ printf( "%c", *pline );
+ if( (*pline != '\n') && (*pline != '\r') )
+ {
+ ++pline;
+ goto getsl;
+ }
+ *pline = 0;
+ if ( echo )
+ printf( "%c", '\n' ); /* \r already echoed */
+}
+
+
+/* help function */
+double cmdhlp()
+{
+
+printf( "%s", idterp );
+printf( "\nFunctions:\n" );
+prhlst( &funtbl[0] );
+printf( "\nVariables:\n" );
+prhlst( &indtbl[0] );
+printf( "\nOperators:\n" );
+prhlst( &oprtbl[2] );
+printf("\n");
+return(0.0);
+}
+
+
+double cmdh()
+{
+
+prhlst( menstk[menptr] );
+printf( "\n" );
+return(0.0);
+}
+
+/* print keyword spellings */
+
+double prhlst(vps)
+void *vps;
+{
+register int j, k;
+int m;
+register struct symbol *ps = vps;
+
+j = 0;
+while( *(ps->spel) != '\0' )
+ {
+ k = strlen( ps->spel ) - 1;
+/* size of a tab field is 2**3 chars */
+ m = ((k >> 3) + 1) << 3;
+ j += m;
+ if( j > 72 )
+ {
+ printf( "\n" );
+ j = m;
+ }
+ printf( "%s\t", ps->spel );
+ ++ps;
+ }
+return(0.0);
+}
+
+
+#if SALONE
+double init()
+{
+/* Set coprocessor to double precision. */
+dprec();
+return 0.0;
+}
+#endif
+
+
+/* macro commands */
+
+/* define macro */
+double cmddm()
+{
+
+zgets( maclin, TRUE );
+return(0.0);
+}
+
+/* type (i.e., display) macro */
+double cmdtm()
+{
+
+printf( "%s\n", maclin );
+return 0.0;
+}
+
+/* execute macro # times */
+double cmdem( arg )
+double arg;
+{
+double f;
+long n;
+
+f = floor(arg);
+n = f;
+if( n <= 0 )
+ n = 1;
+maccnt = n;
+return(0.0);
+}
+
+
+/* open a take file */
+
+double take( fname )
+char *fname;
+{
+FILE *f;
+
+while( *fname == ' ' )
+ fname += 1;
+f = fopen( fname, "r" );
+
+if( f == 0 )
+ {
+ printf( "Can't open take file %s\n", fname );
+ takptr = -1; /* terminate all take file input */
+ return 0.0;
+ }
+takptr += 1;
+takstk[ takptr ] = f;
+printf( "Running %s\n", fname );
+return(0.0);
+}
+
+
+/* abort macro execution */
+double abmac()
+{
+
+maccnt = 0;
+interl = line;
+return(0.0);
+}
+
+
+/* display integer part in hex, octal, and decimal
+ */
+double hex(qx)
+double qx;
+{
+double f;
+long z;
+
+f = floor(qx);
+z = f;
+printf( "0%lo 0x%lx %ld.\n", z, z, z );
+return(qx);
+}
+
+#define NASC 16
+
+double bits( x )
+double x;
+{
+union
+ {
+ double d;
+ short i[4];
+ } du;
+union
+ {
+ float f;
+ short i[2];
+ } df;
+int i;
+
+du.d = x;
+printf( "double: " );
+for( i=0; i<4; i++ )
+ printf( "0x%04x,", du.i[i] & 0xffff );
+printf( "\n" );
+
+df.f = (float) x;
+printf( "float: " );
+for( i=0; i<2; i++ )
+ printf( "0x%04x,", df.i[i] & 0xffff );
+printf( "\n" );
+return(x);
+}
+
+
+/* Exit to monitor. */
+double mxit()
+{
+
+exit(0);
+return(0.0);
+}
+
+
+double cmddig( x )
+double x;
+{
+double f;
+long lx;
+
+f = floor(x);
+lx = f;
+ndigits = lx;
+if( ndigits <= 0 )
+ ndigits = DEFDIS;
+return(f);
+}
+
+
+double csys(x)
+char *x;
+{
+
+system( x+1 );
+cmdh();
+return(0.0);
+}
+
+
+double ifrac(x)
+double x;
+{
+unsigned long lx;
+long double y, z;
+
+z = floor(x);
+lx = z;
+y = x - z;
+printf( " int = %lx\n", lx );
+return(y);
+}
+
+double xcmpl(x,y)
+double x,y;
+{
+double ans;
+
+ans = -2.0;
+if( x == y )
+ {
+ printf( "x == y " );
+ ans = 0.0;
+ }
+if( x < y )
+ {
+ printf( "x < y" );
+ ans = -1.0;
+ }
+if( x > y )
+ {
+ printf( "x > y" );
+ ans = 1.0;
+ }
+return( ans );
+}
+
+extern double INFINITY, NAN;
+
+double makenan(x)
+double x;
+{
+return(NAN);
+}
+
+double makeinfinity(x)
+double x;
+{
+return(INFINITY);
+}
+
+double zfrexp(x)
+double x;
+{
+double y;
+int e;
+y = frexp(x, &e);
+printf("exponent = %d, significand = ", e );
+return(y);
+}
+
+double zldexp(x,e)
+double x, e;
+{
+double y;
+int i;
+
+i = e;
+y = ldexp(x,i);
+return(y);
+}
+
+double hexinput(a, b)
+double a,b;
+{
+union
+ {
+ double d;
+ unsigned short i[4];
+ } u;
+unsigned long l;
+
+#ifdef IBMPC
+l = a;
+u.i[3] = l >> 16;
+u.i[2] = l;
+l = b;
+u.i[1] = l >> 16;
+u.i[0] = l;
+#endif
+#ifdef DEC
+l = a;
+u.i[3] = l >> 16;
+u.i[2] = l;
+l = b;
+u.i[1] = l >> 16;
+u.i[0] = l;
+#endif
+#ifdef MIEEE
+l = a;
+u.i[0] = l >> 16;
+u.i[1] = l;
+l = b;
+u.i[2] = l >> 16;
+u.i[3] = l;
+#endif
+#ifdef UNK
+l = a;
+u.i[0] = l >> 16;
+u.i[1] = l;
+l = b;
+u.i[2] = l >> 16;
+u.i[3] = l;
+#endif
+return(u.d);
+}
diff --git a/libm/double/dcalc.h b/libm/double/dcalc.h
new file mode 100644
index 000000000..0ec2a46da
--- /dev/null
+++ b/libm/double/dcalc.h
@@ -0,0 +1,77 @@
+/* calc.h
+ * include file for calc.c
+ */
+
+/* 32 bit memory addresses: */
+#define LARGEMEM 1
+
+/* data structure of symbol table */
+struct symbol
+ {
+ char *spel;
+ short attrib;
+#if LARGEMEM
+ long sym;
+#else
+ short sym;
+#endif
+ };
+
+struct funent
+ {
+ char *spel;
+ short attrib;
+ double (*fun )();
+ };
+
+struct varent
+ {
+ char *spel;
+ short attrib;
+ double *value;
+ };
+
+struct strent
+ {
+ char *spel;
+ short attrib;
+ char *string;
+ };
+
+
+/* general symbol attributes: */
+#define OPR 0x8000
+#define VAR 0x4000
+#define CONST 0x2000
+#define FUNC 0x1000
+#define ILLEG 0x800
+#define BUSY 0x400
+#define TEMP 0x200
+#define STRING 0x100
+#define COMMAN 0x80
+#define IND 0x1
+
+/* attributes of operators (ordered by precedence): */
+#define BOL 1
+#define EOL 2
+/* end of expression (comma): */
+#define EOE 3
+#define EQU 4
+#define PLUS 5
+#define MINUS 6
+#define MULT 7
+#define DIV 8
+#define UMINUS 9
+#define LPAREN 10
+#define RPAREN 11
+#define COMP 12
+#define MOD 13
+#define LAND 14
+#define LOR 15
+#define LXOR 16
+
+
+extern struct funent funtbl[];
+/*extern struct symbol symtbl[];*/
+extern struct varent indtbl[];
+
diff --git a/libm/double/dtestvec.c b/libm/double/dtestvec.c
new file mode 100644
index 000000000..ea494029b
--- /dev/null
+++ b/libm/double/dtestvec.c
@@ -0,0 +1,543 @@
+
+/* Test vectors for math functions.
+ See C9X section F.9. */
+/*
+Cephes Math Library Release 2.8: June, 2000
+Copyright 1998, 2000 by Stephen L. Moshier
+*/
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+int isfinite (double);
+
+/* C9X spells lgam lgamma. */
+#define GLIBC2 0
+
+extern double PI;
+static double MPI, PIO2, MPIO2, PIO4, MPIO4, THPIO4, MTHPIO4;
+
+#if 0
+#define PI 3.141592653589793238463E0
+#define PIO2 1.570796326794896619231E0
+#define PIO4 7.853981633974483096157E-1
+#define THPIO4 2.35619449019234492884698
+#define SQRT2 1.414213562373095048802E0
+#define SQRTH 7.071067811865475244008E-1
+#define INF (1.0/0.0)
+#define MINF (-1.0/0.0)
+#endif
+
+extern double MACHEP, SQRTH, SQRT2;
+extern double NAN, INFINITY, NEGZERO;
+static double INF, MINF;
+static double ZERO, MZERO, HALF, MHALF, ONE, MONE, TWO, MTWO, THREE, MTHREE;
+/* #define NAN (1.0/0.0 - 1.0/0.0) */
+
+/* Functions of one variable. */
+double log (double);
+double exp ( double);
+double atan (double);
+double sin (double);
+double cos (double);
+double tan (double);
+double acos (double);
+double asin (double);
+double acosh (double);
+double asinh (double);
+double atanh (double);
+double sinh (double);
+double cosh (double);
+double tanh (double);
+double exp2 (double);
+double expm1 (double);
+double log10 (double);
+double log1p (double);
+double log2 (double);
+double fabs (double);
+double erf (double);
+double erfc (double);
+double gamma (double);
+double floor (double);
+double ceil (double);
+double cbrt (double);
+#if GLIBC2
+double lgamma (double);
+#else
+double lgam (double);
+#endif
+
+struct oneargument
+ {
+ char *name; /* Name of the function. */
+ double (*func) (double);
+ double *arg1;
+ double *answer;
+ int thresh; /* Error report threshold. */
+ };
+
+struct oneargument test1[] =
+{
+ {"atan", atan, &ONE, &PIO4, 0},
+ {"sin", sin, &PIO2, &ONE, 0},
+#if 0
+ {"cos", cos, &PIO4, &SQRTH, 0},
+ {"sin", sin, 32767., 1.8750655394138942394239E-1, 0},
+ {"cos", cos, 32767., 9.8226335176928229845654E-1, 0},
+ {"tan", tan, 32767., 1.9089234430221485740826E-1, 0},
+ {"sin", sin, 8388607., 9.9234509376961249835628E-1, 0},
+ {"cos", cos, 8388607., -1.2349580912475928183718E-1, 0},
+ {"tan", tan, 8388607., -8.0354556223613614748329E0, 0},
+ /*
+ {"sin", sin, 2147483647., -7.2491655514455639054829E-1, 0},
+ {"cos", cos, 2147483647., -6.8883669187794383467976E-1, 0},
+ {"tan", tan, 2147483647., 1.0523779637351339136698E0, 0},
+ */
+ {"cos", cos, &PIO2, 6.1232339957367574e-17, 1},
+ {"sin", sin, &PIO4, &SQRTH, 1},
+#endif
+ {"acos", acos, &NAN, &NAN, 0},
+ {"acos", acos, &ONE, &ZERO, 0},
+ {"acos", acos, &TWO, &NAN, 0},
+ {"acos", acos, &MTWO, &NAN, 0},
+ {"asin", asin, &NAN, &NAN, 0},
+ {"asin", asin, &ZERO, &ZERO, 0},
+ {"asin", asin, &MZERO, &MZERO, 0},
+ {"asin", asin, &TWO, &NAN, 0},
+ {"asin", asin, &MTWO, &NAN, 0},
+ {"atan", atan, &NAN, &NAN, 0},
+ {"atan", atan, &ZERO, &ZERO, 0},
+ {"atan", atan, &MZERO, &MZERO, 0},
+ {"atan", atan, &INF, &PIO2, 0},
+ {"atan", atan, &MINF, &MPIO2, 0},
+ {"cos", cos, &NAN, &NAN, 0},
+ {"cos", cos, &ZERO, &ONE, 0},
+ {"cos", cos, &MZERO, &ONE, 0},
+ {"cos", cos, &INF, &NAN, 0},
+ {"cos", cos, &MINF, &NAN, 0},
+ {"sin", sin, &NAN, &NAN, 0},
+ {"sin", sin, &MZERO, &MZERO, 0},
+ {"sin", sin, &ZERO, &ZERO, 0},
+ {"sin", sin, &INF, &NAN, 0},
+ {"sin", sin, &MINF, &NAN, 0},
+ {"tan", tan, &NAN, &NAN, 0},
+ {"tan", tan, &ZERO, &ZERO, 0},
+ {"tan", tan, &MZERO, &MZERO, 0},
+ {"tan", tan, &INF, &NAN, 0},
+ {"tan", tan, &MINF, &NAN, 0},
+ {"acosh", acosh, &NAN, &NAN, 0},
+ {"acosh", acosh, &ONE, &ZERO, 0},
+ {"acosh", acosh, &INF, &INF, 0},
+ {"acosh", acosh, &HALF, &NAN, 0},
+ {"acosh", acosh, &MONE, &NAN, 0},
+ {"asinh", asinh, &NAN, &NAN, 0},
+ {"asinh", asinh, &ZERO, &ZERO, 0},
+ {"asinh", asinh, &MZERO, &MZERO, 0},
+ {"asinh", asinh, &INF, &INF, 0},
+ {"asinh", asinh, &MINF, &MINF, 0},
+ {"atanh", atanh, &NAN, &NAN, 0},
+ {"atanh", atanh, &ZERO, &ZERO, 0},
+ {"atanh", atanh, &MZERO, &MZERO, 0},
+ {"atanh", atanh, &ONE, &INF, 0},
+ {"atanh", atanh, &MONE, &MINF, 0},
+ {"atanh", atanh, &TWO, &NAN, 0},
+ {"atanh", atanh, &MTWO, &NAN, 0},
+ {"cosh", cosh, &NAN, &NAN, 0},
+ {"cosh", cosh, &ZERO, &ONE, 0},
+ {"cosh", cosh, &MZERO, &ONE, 0},
+ {"cosh", cosh, &INF, &INF, 0},
+ {"cosh", cosh, &MINF, &INF, 0},
+ {"sinh", sinh, &NAN, &NAN, 0},
+ {"sinh", sinh, &ZERO, &ZERO, 0},
+ {"sinh", sinh, &MZERO, &MZERO, 0},
+ {"sinh", sinh, &INF, &INF, 0},
+ {"sinh", sinh, &MINF, &MINF, 0},
+ {"tanh", tanh, &NAN, &NAN, 0},
+ {"tanh", tanh, &ZERO, &ZERO, 0},
+ {"tanh", tanh, &MZERO, &MZERO, 0},
+ {"tanh", tanh, &INF, &ONE, 0},
+ {"tanh", tanh, &MINF, &MONE, 0},
+ {"exp", exp, &NAN, &NAN, 0},
+ {"exp", exp, &ZERO, &ONE, 0},
+ {"exp", exp, &MZERO, &ONE, 0},
+ {"exp", exp, &INF, &INF, 0},
+ {"exp", exp, &MINF, &ZERO, 0},
+#if !GLIBC2
+ {"exp2", exp2, &NAN, &NAN, 0},
+ {"exp2", exp2, &ZERO, &ONE, 0},
+ {"exp2", exp2, &MZERO, &ONE, 0},
+ {"exp2", exp2, &INF, &INF, 0},
+ {"exp2", exp2, &MINF, &ZERO, 0},
+#endif
+ {"expm1", expm1, &NAN, &NAN, 0},
+ {"expm1", expm1, &ZERO, &ZERO, 0},
+ {"expm1", expm1, &MZERO, &MZERO, 0},
+ {"expm1", expm1, &INF, &INF, 0},
+ {"expm1", expm1, &MINF, &MONE, 0},
+ {"log", log, &NAN, &NAN, 0},
+ {"log", log, &ZERO, &MINF, 0},
+ {"log", log, &MZERO, &MINF, 0},
+ {"log", log, &ONE, &ZERO, 0},
+ {"log", log, &MONE, &NAN, 0},
+ {"log", log, &INF, &INF, 0},
+ {"log10", log10, &NAN, &NAN, 0},
+ {"log10", log10, &ZERO, &MINF, 0},
+ {"log10", log10, &MZERO, &MINF, 0},
+ {"log10", log10, &ONE, &ZERO, 0},
+ {"log10", log10, &MONE, &NAN, 0},
+ {"log10", log10, &INF, &INF, 0},
+ {"log1p", log1p, &NAN, &NAN, 0},
+ {"log1p", log1p, &ZERO, &ZERO, 0},
+ {"log1p", log1p, &MZERO, &MZERO, 0},
+ {"log1p", log1p, &MONE, &MINF, 0},
+ {"log1p", log1p, &MTWO, &NAN, 0},
+ {"log1p", log1p, &INF, &INF, 0},
+#if !GLIBC2
+ {"log2", log2, &NAN, &NAN, 0},
+ {"log2", log2, &ZERO, &MINF, 0},
+ {"log2", log2, &MZERO, &MINF, 0},
+ {"log2", log2, &MONE, &NAN, 0},
+ {"log2", log2, &INF, &INF, 0},
+#endif
+ /* {"fabs", fabs, NAN, NAN, 0}, */
+ {"fabs", fabs, &ONE, &ONE, 0},
+ {"fabs", fabs, &MONE, &ONE, 0},
+ {"fabs", fabs, &ZERO, &ZERO, 0},
+ {"fabs", fabs, &MZERO, &ZERO, 0},
+ {"fabs", fabs, &INF, &INF, 0},
+ {"fabs", fabs, &MINF, &INF, 0},
+ {"cbrt", cbrt, &NAN, &NAN, 0},
+ {"cbrt", cbrt, &ZERO, &ZERO, 0},
+ {"cbrt", cbrt, &MZERO, &MZERO, 0},
+ {"cbrt", cbrt, &INF, &INF, 0},
+ {"cbrt", cbrt, &MINF, &MINF, 0},
+ {"erf", erf, &NAN, &NAN, 0},
+ {"erf", erf, &ZERO, &ZERO, 0},
+ {"erf", erf, &MZERO, &MZERO, 0},
+ {"erf", erf, &INF, &ONE, 0},
+ {"erf", erf, &MINF, &MONE, 0},
+ {"erfc", erfc, &NAN, &NAN, 0},
+ {"erfc", erfc, &INF, &ZERO, 0},
+ {"erfc", erfc, &MINF, &TWO, 0},
+ {"gamma", gamma, &NAN, &NAN, 0},
+ {"gamma", gamma, &INF, &INF, 0},
+ {"gamma", gamma, &MONE, &NAN, 0},
+ {"gamma", gamma, &ZERO, &NAN, 0},
+ {"gamma", gamma, &MINF, &NAN, 0},
+#if GLIBC2
+ {"lgamma", lgamma, &NAN, &NAN, 0},
+ {"lgamma", lgamma, &INF, &INF, 0},
+ {"lgamma", lgamma, &MONE, &INF, 0},
+ {"lgamma", lgamma, &ZERO, &INF, 0},
+ {"lgamma", lgamma, &MINF, &INF, 0},
+#else
+ {"lgam", lgam, &NAN, &NAN, 0},
+ {"lgam", lgam, &INF, &INF, 0},
+ {"lgam", lgam, &MONE, &INF, 0},
+ {"lgam", lgam, &ZERO, &INF, 0},
+ {"lgam", lgam, &MINF, &INF, 0},
+#endif
+ {"ceil", ceil, &NAN, &NAN, 0},
+ {"ceil", ceil, &ZERO, &ZERO, 0},
+ {"ceil", ceil, &MZERO, &MZERO, 0},
+ {"ceil", ceil, &INF, &INF, 0},
+ {"ceil", ceil, &MINF, &MINF, 0},
+ {"floor", floor, &NAN, &NAN, 0},
+ {"floor", floor, &ZERO, &ZERO, 0},
+ {"floor", floor, &MZERO, &MZERO, 0},
+ {"floor", floor, &INF, &INF, 0},
+ {"floor", floor, &MINF, &MINF, 0},
+ {"null", NULL, &ZERO, &ZERO, 0},
+};
+
+/* Functions of two variables. */
+double atan2 (double, double);
+double pow (double, double);
+
+struct twoarguments
+ {
+ char *name; /* Name of the function. */
+ double (*func) (double, double);
+ double *arg1;
+ double *arg2;
+ double *answer;
+ int thresh;
+ };
+
+struct twoarguments test2[] =
+{
+ {"atan2", atan2, &ZERO, &ONE, &ZERO, 0},
+ {"atan2", atan2, &MZERO, &ONE, &MZERO, 0},
+ {"atan2", atan2, &ZERO, &ZERO, &ZERO, 0},
+ {"atan2", atan2, &MZERO, &ZERO, &MZERO, 0},
+ {"atan2", atan2, &ZERO, &MONE, &PI, 0},
+ {"atan2", atan2, &MZERO, &MONE, &MPI, 0},
+ {"atan2", atan2, &ZERO, &MZERO, &PI, 0},
+ {"atan2", atan2, &MZERO, &MZERO, &MPI, 0},
+ {"atan2", atan2, &ONE, &ZERO, &PIO2, 0},
+ {"atan2", atan2, &ONE, &MZERO, &PIO2, 0},
+ {"atan2", atan2, &MONE, &ZERO, &MPIO2, 0},
+ {"atan2", atan2, &MONE, &MZERO, &MPIO2, 0},
+ {"atan2", atan2, &ONE, &INF, &ZERO, 0},
+ {"atan2", atan2, &MONE, &INF, &MZERO, 0},
+ {"atan2", atan2, &INF, &ONE, &PIO2, 0},
+ {"atan2", atan2, &INF, &MONE, &PIO2, 0},
+ {"atan2", atan2, &MINF, &ONE, &MPIO2, 0},
+ {"atan2", atan2, &MINF, &MONE, &MPIO2, 0},
+ {"atan2", atan2, &ONE, &MINF, &PI, 0},
+ {"atan2", atan2, &MONE, &MINF, &MPI, 0},
+ {"atan2", atan2, &INF, &INF, &PIO4, 0},
+ {"atan2", atan2, &MINF, &INF, &MPIO4, 0},
+ {"atan2", atan2, &INF, &MINF, &THPIO4, 0},
+ {"atan2", atan2, &MINF, &MINF, &MTHPIO4, 0},
+ {"atan2", atan2, &ONE, &ONE, &PIO4, 0},
+ {"atan2", atan2, &NAN, &ONE, &NAN, 0},
+ {"atan2", atan2, &ONE, &NAN, &NAN, 0},
+ {"atan2", atan2, &NAN, &NAN, &NAN, 0},
+ {"pow", pow, &ONE, &ZERO, &ONE, 0},
+ {"pow", pow, &ONE, &MZERO, &ONE, 0},
+ {"pow", pow, &MONE, &ZERO, &ONE, 0},
+ {"pow", pow, &MONE, &MZERO, &ONE, 0},
+ {"pow", pow, &INF, &ZERO, &ONE, 0},
+ {"pow", pow, &INF, &MZERO, &ONE, 0},
+ {"pow", pow, &NAN, &ZERO, &ONE, 0},
+ {"pow", pow, &NAN, &MZERO, &ONE, 0},
+ {"pow", pow, &TWO, &INF, &INF, 0},
+ {"pow", pow, &MTWO, &INF, &INF, 0},
+ {"pow", pow, &HALF, &INF, &ZERO, 0},
+ {"pow", pow, &MHALF, &INF, &ZERO, 0},
+ {"pow", pow, &TWO, &MINF, &ZERO, 0},
+ {"pow", pow, &MTWO, &MINF, &ZERO, 0},
+ {"pow", pow, &HALF, &MINF, &INF, 0},
+ {"pow", pow, &MHALF, &MINF, &INF, 0},
+ {"pow", pow, &INF, &HALF, &INF, 0},
+ {"pow", pow, &INF, &TWO, &INF, 0},
+ {"pow", pow, &INF, &MHALF, &ZERO, 0},
+ {"pow", pow, &INF, &MTWO, &ZERO, 0},
+ {"pow", pow, &MINF, &THREE, &MINF, 0},
+ {"pow", pow, &MINF, &TWO, &INF, 0},
+ {"pow", pow, &MINF, &MTHREE, &MZERO, 0},
+ {"pow", pow, &MINF, &MTWO, &ZERO, 0},
+ {"pow", pow, &NAN, &ONE, &NAN, 0},
+ {"pow", pow, &ONE, &NAN, &NAN, 0},
+ {"pow", pow, &NAN, &NAN, &NAN, 0},
+ {"pow", pow, &ONE, &INF, &NAN, 0},
+ {"pow", pow, &MONE, &INF, &NAN, 0},
+ {"pow", pow, &ONE, &MINF, &NAN, 0},
+ {"pow", pow, &MONE, &MINF, &NAN, 0},
+ {"pow", pow, &MTWO, &HALF, &NAN, 0},
+ {"pow", pow, &ZERO, &MTHREE, &INF, 0},
+ {"pow", pow, &MZERO, &MTHREE, &MINF, 0},
+ {"pow", pow, &ZERO, &MHALF, &INF, 0},
+ {"pow", pow, &MZERO, &MHALF, &INF, 0},
+ {"pow", pow, &ZERO, &THREE, &ZERO, 0},
+ {"pow", pow, &MZERO, &THREE, &MZERO, 0},
+ {"pow", pow, &ZERO, &HALF, &ZERO, 0},
+ {"pow", pow, &MZERO, &HALF, &ZERO, 0},
+ {"null", NULL, &ZERO, &ZERO, &ZERO, 0},
+};
+
+/* Integer functions of one variable. */
+
+int isnan (double);
+int signbit (double);
+
+struct intans
+ {
+ char *name; /* Name of the function. */
+ int (*func) (double);
+ double *arg1;
+ int ianswer;
+ };
+
+struct intans test3[] =
+{
+ {"isfinite", isfinite, &ZERO, 1},
+ {"isfinite", isfinite, &INF, 0},
+ {"isfinite", isfinite, &MINF, 0},
+ {"isnan", isnan, &NAN, 1},
+ {"isnan", isnan, &INF, 0},
+ {"isnan", isnan, &ZERO, 0},
+ {"isnan", isnan, &MZERO, 0},
+ {"signbit", signbit, &MZERO, 1},
+ {"signbit", signbit, &MONE, 1},
+ {"signbit", signbit, &ZERO, 0},
+ {"signbit", signbit, &ONE, 0},
+ {"signbit", signbit, &MINF, 1},
+ {"signbit", signbit, &INF, 0},
+ {"null", NULL, &ZERO, 0},
+};
+
+static volatile double x1;
+static volatile double x2;
+static volatile double y;
+static volatile double answer;
+
+void
+pvec(x)
+double x;
+{
+ union
+ {
+ double d;
+ unsigned short s[4];
+ } u;
+ int i;
+
+ u.d = x;
+ for (i = 0; i < 4; i++)
+ printf ("0x%04x ", u.s[i]);
+ printf ("\n");
+}
+
+
+int
+main ()
+{
+ int i, nerrors, k, ianswer, ntests;
+ double (*fun1) (double);
+ double (*fun2) (double, double);
+ int (*fun3) (double);
+ double e;
+ union
+ {
+ double d;
+ char c[8];
+ } u, v;
+
+ ZERO = 0.0;
+ MZERO = NEGZERO;
+ HALF = 0.5;
+ MHALF = -HALF;
+ ONE = 1.0;
+ MONE = -ONE;
+ TWO = 2.0;
+ MTWO = -TWO;
+ THREE = 3.0;
+ MTHREE = -THREE;
+ INF = INFINITY;
+ MINF = -INFINITY;
+ MPI = -PI;
+ PIO2 = 0.5 * PI;
+ MPIO2 = -PIO2;
+ PIO4 = 0.5 * PIO2;
+ MPIO4 = -PIO4;
+ THPIO4 = 3.0 * PIO4;
+ MTHPIO4 = -THPIO4;
+
+ nerrors = 0;
+ ntests = 0;
+ i = 0;
+ for (;;)
+ {
+ fun1 = test1[i].func;
+ if (fun1 == NULL)
+ break;
+ x1 = *(test1[i].arg1);
+ y = (*(fun1)) (x1);
+ answer = *(test1[i].answer);
+ if (test1[i].thresh == 0)
+ {
+ v.d = answer;
+ u.d = y;
+ if (memcmp(u.c, v.c, 8) != 0)
+ {
+ if( isnan(v.d) && isnan(u.d) )
+ goto nxttest1;
+ goto wrongone;
+ }
+ else
+ goto nxttest1;
+ }
+ if (y != answer)
+ {
+ e = y - answer;
+ if (answer != 0.0)
+ e = e / answer;
+ if (e < 0)
+ e = -e;
+ if (e > test1[i].thresh * MACHEP)
+ {
+wrongone:
+ printf ("%s (%.16e) = %.16e\n should be %.16e\n",
+ test1[i].name, x1, y, answer);
+ nerrors += 1;
+ }
+ }
+nxttest1:
+ ntests += 1;
+ i += 1;
+ }
+
+ i = 0;
+ for (;;)
+ {
+ fun2 = test2[i].func;
+ if (fun2 == NULL)
+ break;
+ x1 = *(test2[i].arg1);
+ x2 = *(test2[i].arg2);
+ y = (*(fun2)) (x1, x2);
+ answer = *(test2[i].answer);
+ if (test2[i].thresh == 0)
+ {
+ v.d = answer;
+ u.d = y;
+ if (memcmp(u.c, v.c, 8) != 0)
+ {
+ if( isnan(v.d) && isnan(u.d) )
+ goto nxttest2;
+#if 0
+ if( isnan(v.d) )
+ pvec(v.d);
+ if( isnan(u.d) )
+ pvec(u.d);
+#endif
+ goto wrongtwo;
+ }
+ else
+ goto nxttest2;
+ }
+ if (y != answer)
+ {
+ e = y - answer;
+ if (answer != 0.0)
+ e = e / answer;
+ if (e < 0)
+ e = -e;
+ if (e > test2[i].thresh * MACHEP)
+ {
+wrongtwo:
+ printf ("%s (%.16e, %.16e) = %.16e\n should be %.16e\n",
+ test2[i].name, x1, x2, y, answer);
+ nerrors += 1;
+ }
+ }
+nxttest2:
+ ntests += 1;
+ i += 1;
+ }
+
+
+ i = 0;
+ for (;;)
+ {
+ fun3 = test3[i].func;
+ if (fun3 == NULL)
+ break;
+ x1 = *(test3[i].arg1);
+ k = (*(fun3)) (x1);
+ ianswer = test3[i].ianswer;
+ if (k != ianswer)
+ {
+ printf ("%s (%.16e) = %d\n should be. %d\n",
+ test3[i].name, x1, k, ianswer);
+ nerrors += 1;
+ }
+ ntests += 1;
+ i += 1;
+ }
+
+ printf ("testvect: %d errors in %d tests\n", nerrors, ntests);
+ exit (0);
+}
diff --git a/libm/double/ei.c b/libm/double/ei.c
new file mode 100644
index 000000000..4994fa99c
--- /dev/null
+++ b/libm/double/ei.c
@@ -0,0 +1,1062 @@
+/* ei.c
+ *
+ * Exponential integral
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, ei();
+ *
+ * y = ei( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * x
+ * - t
+ * | | e
+ * Ei(x) = -|- --- dt .
+ * | | t
+ * -
+ * -inf
+ *
+ * Not defined for x <= 0.
+ * See also expn.c.
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE 0,100 50000 8.6e-16 1.3e-16
+ *
+ */
+
+/*
+Cephes Math Library Release 2.8: May, 1999
+Copyright 1999 by Stephen L. Moshier
+*/
+
+#include <math.h>
+#ifdef ANSIPROT
+extern double log ( double );
+extern double exp ( double );
+extern double polevl ( double, void *, int );
+extern double p1evl ( double, void *, int );
+#else
+extern double log(), exp(), polevl(), p1evl();
+#endif
+
+#define EUL 5.772156649015328606065e-1
+
+/* 0 < x <= 2
+ Ei(x) - EUL - ln(x) = x A(x)/B(x)
+ Theoretical peak relative error 9.73e-18 */
+#if UNK
+static double A[6] = {
+-5.350447357812542947283E0,
+ 2.185049168816613393830E2,
+-4.176572384826693777058E3,
+ 5.541176756393557601232E4,
+-3.313381331178144034309E5,
+ 1.592627163384945414220E6,
+};
+static double B[6] = {
+ /* 1.000000000000000000000E0, */
+-5.250547959112862969197E1,
+ 1.259616186786790571525E3,
+-1.756549581973534652631E4,
+ 1.493062117002725991967E5,
+-7.294949239640527645655E5,
+ 1.592627163384945429726E6,
+};
+#endif
+#if DEC
+static short A[24] = {
+0140653,0033335,0060230,0144217,
+0042132,0100502,0035625,0167413,
+0143202,0102224,0037176,0175403,
+0044130,0071704,0077421,0170343,
+0144641,0144504,0041200,0045154,
+0045302,0064631,0047234,0142052,
+};
+static short B[24] = {
+ /* 0040200,0000000,0000000,0000000, */
+0141522,0002634,0070442,0142614,
+0042635,0071667,0146532,0027705,
+0143611,0035375,0156025,0114015,
+0044421,0147215,0106177,0046330,
+0145062,0014556,0144216,0103725,
+0045302,0064631,0047234,0142052,
+};
+#endif
+#if IBMPC
+static short A[24] = {
+0x1912,0xac13,0x66db,0xc015,
+0xbde1,0x4772,0x5028,0x406b,
+0xdf60,0x87cf,0x5092,0xc0b0,
+0x3e1c,0x8fe2,0x0e78,0x40eb,
+0x094e,0x8850,0x3928,0xc114,
+0x9885,0x29d3,0x4d33,0x4138,
+};
+static short B[24] = {
+ /* 0x0000,0x0000,0x0000,0x3ff0, */
+0x58b1,0x8e24,0x40b3,0xc04a,
+0x45f9,0xf9ab,0xae76,0x4093,
+0xb302,0xbb82,0x275f,0xc0d1,
+0xe99b,0xb18f,0x39d1,0x4102,
+0xd0fb,0xd911,0x432d,0xc126,
+0x9885,0x29d3,0x4d33,0x4138,
+};
+#endif
+#if MIEEE
+static short A[24] = {
+0xc015,0x66db,0xac13,0x1912,
+0x406b,0x5028,0x4772,0xbde1,
+0xc0b0,0x5092,0x87cf,0xdf60,
+0x40eb,0x0e78,0x8fe2,0x3e1c,
+0xc114,0x3928,0x8850,0x094e,
+0x4138,0x4d33,0x29d3,0x9885,
+};
+static short B[24] = {
+ /* 0x3ff0,0x0000,0x0000,0x0000, */
+0xc04a,0x40b3,0x8e24,0x58b1,
+0x4093,0xae76,0xf9ab,0x45f9,
+0xc0d1,0x275f,0xbb82,0xb302,
+0x4102,0x39d1,0xb18f,0xe99b,
+0xc126,0x432d,0xd911,0xd0fb,
+0x4138,0x4d33,0x29d3,0x9885,
+};
+#endif
+
+#if 0
+/* 0 < x <= 4
+ Ei(x) - EUL - ln(x) = x A(x)/B(x)
+ Theoretical peak relative error 4.75e-17 */
+#if UNK
+static double A[7] = {
+-6.831869820732773831942E0,
+ 2.920190530726774500309E2,
+-1.195883839286649567993E4,
+ 1.761045255472548975666E5,
+-2.623034438354006526979E6,
+ 1.472430336917880803157E7,
+-8.205359388213261174960E7,
+};
+static double B[7] = {
+ /* 1.000000000000000000000E0, */
+-7.731946237840033971071E1,
+ 2.751808700543578450827E3,
+-5.829268609072186897994E4,
+ 7.916610857961870631379E5,
+-6.873926904825733094076E6,
+ 3.523770183971164032710E7,
+-8.205359388213260785363E7,
+};
+#endif
+#if DEC
+static short A[28] = {
+0140732,0117255,0072522,0071743,
+0042222,0001160,0052302,0002334,
+0143472,0155532,0101650,0155462,
+0044453,0175041,0121220,0172022,
+0145440,0014351,0140337,0157550,
+0046140,0126317,0057202,0100233,
+0146634,0100473,0036072,0067054,
+};
+static short B[28] = {
+ /* 0040200,0000000,0000000,0000000, */
+0141632,0121620,0111247,0010115,
+0043053,0176360,0067773,0027324,
+0144143,0132257,0121644,0036204,
+0045101,0043321,0057553,0151231,
+0145721,0143215,0147505,0050610,
+0046406,0065721,0072675,0152744,
+0146634,0100473,0036072,0067052,
+};
+#endif
+#if IBMPC
+static short A[28] = {
+0x4e7c,0xaeaa,0x53d5,0xc01b,
+0x409b,0x0a98,0x404e,0x4072,
+0x1b66,0x5075,0x5b6b,0xc0c7,
+0x1e82,0x3452,0x7f44,0x4105,
+0xfbed,0x381b,0x031d,0xc144,
+0x5013,0xebd0,0x1599,0x416c,
+0x4dc5,0x6787,0x9027,0xc193,
+};
+static short B[28] = {
+ /* 0x0000,0x0000,0x0000,0x3ff0, */
+0xe20a,0x1254,0x5472,0xc053,
+0x65db,0x0dff,0x7f9e,0x40a5,
+0x8791,0xf474,0x7695,0xc0ec,
+0x7a53,0x2bed,0x28da,0x4128,
+0xaa31,0xb9e8,0x38d1,0xc15a,
+0xbabd,0x2eb7,0xcd7a,0x4180,
+0x4dc5,0x6787,0x9027,0xc193,
+};
+#endif
+#if MIEEE
+static short A[28] = {
+0xc01b,0x53d5,0xaeaa,0x4e7c,
+0x4072,0x404e,0x0a98,0x409b,
+0xc0c7,0x5b6b,0x5075,0x1b66,
+0x4105,0x7f44,0x3452,0x1e82,
+0xc144,0x031d,0x381b,0xfbed,
+0x416c,0x1599,0xebd0,0x5013,
+0xc193,0x9027,0x6787,0x4dc5,
+};
+static short B[28] = {
+ /* 0x3ff0,0x0000,0x0000,0x0000, */
+0xc053,0x5472,0x1254,0xe20a,
+0x40a5,0x7f9e,0x0dff,0x65db,
+0xc0ec,0x7695,0xf474,0x8791,
+0x4128,0x28da,0x2bed,0x7a53,
+0xc15a,0x38d1,0xb9e8,0xaa31,
+0x4180,0xcd7a,0x2eb7,0xbabd,
+0xc193,0x9027,0x6787,0x4dc5,
+};
+#endif
+#endif /* 0 */
+
+#if 0
+/* 0 < x <= 8
+ Ei(x) - EUL - ln(x) = x A(x)/B(x)
+ Theoretical peak relative error 2.14e-17 */
+
+#if UNK
+static double A[9] = {
+-1.111230942210860450145E1,
+ 3.688203982071386319616E2,
+-4.924786153494029574350E4,
+ 1.050677503345557903241E6,
+-3.626713709916703688968E7,
+ 4.353499908839918635414E8,
+-6.454613717232006895409E9,
+ 3.408243056457762907071E10,
+-1.995466674647028468613E11,
+};
+static double B[9] = {
+ /* 1.000000000000000000000E0, */
+-1.356757648138514017969E2,
+ 8.562181317107341736606E3,
+-3.298257180413775117555E5,
+ 8.543534058481435917210E6,
+-1.542380618535140055068E8,
+ 1.939251779195993632028E9,
+-1.636096210465615015435E10,
+ 8.396909743075306970605E10,
+-1.995466674647028425886E11,
+};
+#endif
+#if DEC
+static short A[36] = {
+0141061,0146004,0173357,0151553,
+0042270,0064402,0147366,0126701,
+0144100,0057734,0106615,0144356,
+0045200,0040654,0003332,0004456,
+0146412,0054440,0043130,0140263,
+0047317,0113517,0033422,0065123,
+0150300,0056313,0065235,0131147,
+0050775,0167423,0146222,0075760,
+0151471,0153642,0003442,0147667,
+};
+static short B[36] = {
+ /* 0040200,0000000,0000000,0000000, */
+0142007,0126376,0166077,0043600,
+0043405,0144271,0125461,0014364,
+0144641,0006066,0175061,0164463,
+0046002,0056456,0007370,0121657,
+0147023,0013706,0156647,0177115,
+0047747,0026504,0103144,0054507,
+0150563,0146036,0007051,0177135,
+0051234,0063625,0173266,0003111,
+0151471,0153642,0003442,0147666,
+};
+#endif
+#if IBMPC
+static short A[36] = {
+0xfa6d,0x9edd,0x3980,0xc026,
+0xd5b8,0x59de,0x0d20,0x4077,
+0xb91e,0x91b1,0x0bfb,0xc0e8,
+0x4126,0x80db,0x0835,0x4130,
+0x1816,0x08cb,0x4b24,0xc181,
+0x4d4a,0xe6e2,0xf2e9,0x41b9,
+0xb64d,0x6d53,0x0b99,0xc1f8,
+0x4f7e,0x7992,0xbde2,0x421f,
+0x59f7,0x40e4,0x3af4,0xc247,
+};
+static short B[36] = {
+ /* 0x0000,0x0000,0x0000,0x3ff0, */
+0xe8f0,0xdd87,0xf59f,0xc060,
+0x231e,0x3566,0xb917,0x40c0,
+0x3d26,0xdf46,0x2186,0xc114,
+0x1476,0xc1df,0x4ba5,0x4160,
+0xffca,0xdbb4,0x62f8,0xc1a2,
+0x8b29,0x90cc,0xe5a8,0x41dc,
+0x3fcc,0xc1c5,0x7983,0xc20e,
+0xc0c9,0xbed6,0x8cf2,0x4233,
+0x59f7,0x40e4,0x3af4,0xc247,
+};
+#endif
+#if MIEEE
+static short A[36] = {
+0xc026,0x3980,0x9edd,0xfa6d,
+0x4077,0x0d20,0x59de,0xd5b8,
+0xc0e8,0x0bfb,0x91b1,0xb91e,
+0x4130,0x0835,0x80db,0x4126,
+0xc181,0x4b24,0x08cb,0x1816,
+0x41b9,0xf2e9,0xe6e2,0x4d4a,
+0xc1f8,0x0b99,0x6d53,0xb64d,
+0x421f,0xbde2,0x7992,0x4f7e,
+0xc247,0x3af4,0x40e4,0x59f7,
+};
+static short B[36] = {
+ /* 0x3ff0,0x0000,0x0000,0x0000, */
+0xc060,0xf59f,0xdd87,0xe8f0,
+0x40c0,0xb917,0x3566,0x231e,
+0xc114,0x2186,0xdf46,0x3d26,
+0x4160,0x4ba5,0xc1df,0x1476,
+0xc1a2,0x62f8,0xdbb4,0xffca,
+0x41dc,0xe5a8,0x90cc,0x8b29,
+0xc20e,0x7983,0xc1c5,0x3fcc,
+0x4233,0x8cf2,0xbed6,0xc0c9,
+0xc247,0x3af4,0x40e4,0x59f7,
+};
+#endif
+#endif /* 0 */
+
+/* 8 <= x <= 20
+ x exp(-x) Ei(x) - 1 = 1/x R(1/x)
+ Theoretical peak absolute error = 1.07e-17 */
+#if UNK
+static double A2[10] = {
+-2.106934601691916512584E0,
+ 1.732733869664688041885E0,
+-2.423619178935841904839E-1,
+ 2.322724180937565842585E-2,
+ 2.372880440493179832059E-4,
+-8.343219561192552752335E-5,
+ 1.363408795605250394881E-5,
+-3.655412321999253963714E-7,
+ 1.464941733975961318456E-8,
+ 6.176407863710360207074E-10,
+};
+static double B2[9] = {
+ /* 1.000000000000000000000E0, */
+-2.298062239901678075778E-1,
+ 1.105077041474037862347E-1,
+-1.566542966630792353556E-2,
+ 2.761106850817352773874E-3,
+-2.089148012284048449115E-4,
+ 1.708528938807675304186E-5,
+-4.459311796356686423199E-7,
+ 1.394634930353847498145E-8,
+ 6.150865933977338354138E-10,
+};
+#endif
+#if DEC
+static short A2[40] = {
+0140406,0154004,0035104,0173336,
+0040335,0145071,0031560,0150165,
+0137570,0026670,0176230,0055040,
+0036676,0043416,0077122,0054476,
+0035170,0150206,0034407,0175571,
+0134656,0174121,0123231,0021751,
+0034144,0136766,0036746,0121115,
+0132704,0037632,0135077,0107300,
+0031573,0126321,0117076,0004314,
+0030451,0143233,0041352,0172464,
+};
+static short B2[36] = {
+ /* 0040200,0000000,0000000,0000000, */
+0137553,0051122,0120721,0170437,
+0037342,0050734,0175047,0032132,
+0136600,0052311,0101406,0147050,
+0036064,0171657,0120001,0071165,
+0135133,0010043,0151244,0066340,
+0034217,0051141,0026115,0043305,
+0132757,0064120,0106341,0051217,
+0031557,0114261,0060663,0135017,
+0030451,0011337,0001344,0175542,
+};
+#endif
+#if IBMPC
+static short A2[40] = {
+0x9edc,0x8748,0xdb00,0xc000,
+0x1a0f,0x266e,0xb947,0x3ffb,
+0x0b44,0x1f93,0x05b7,0xbfcf,
+0x4b28,0xcfca,0xc8e1,0x3f97,
+0xff6f,0xc720,0x1a10,0x3f2f,
+0x247d,0x34d3,0xdf0a,0xbf15,
+0xd44a,0xc7bc,0x97be,0x3eec,
+0xf1d8,0x5747,0x87f3,0xbe98,
+0xc119,0x33c7,0x759a,0x3e4f,
+0x5ea6,0x685d,0x38d3,0x3e05,
+};
+static short B2[36] = {
+ /* 0x0000,0x0000,0x0000,0x3ff0, */
+0x3e24,0x543a,0x6a4a,0xbfcd,
+0xe68b,0x9f44,0x4a3b,0x3fbc,
+0xd9c5,0x3060,0x0a99,0xbf90,
+0x2e4f,0xf400,0x9e75,0x3f66,
+0x8d9c,0x7a54,0x6204,0xbf2b,
+0xa8d9,0x2589,0xea4c,0x3ef1,
+0x2a52,0x119c,0xed0a,0xbe9d,
+0x7742,0x2c36,0xf316,0x3e4d,
+0x9f6c,0xe05c,0x225b,0x3e05,
+};
+#endif
+#if MIEEE
+static short A2[40] = {
+0xc000,0xdb00,0x8748,0x9edc,
+0x3ffb,0xb947,0x266e,0x1a0f,
+0xbfcf,0x05b7,0x1f93,0x0b44,
+0x3f97,0xc8e1,0xcfca,0x4b28,
+0x3f2f,0x1a10,0xc720,0xff6f,
+0xbf15,0xdf0a,0x34d3,0x247d,
+0x3eec,0x97be,0xc7bc,0xd44a,
+0xbe98,0x87f3,0x5747,0xf1d8,
+0x3e4f,0x759a,0x33c7,0xc119,
+0x3e05,0x38d3,0x685d,0x5ea6,
+};
+static short B2[36] = {
+ /* 0x3ff0,0x0000,0x0000,0x0000, */
+0xbfcd,0x6a4a,0x543a,0x3e24,
+0x3fbc,0x4a3b,0x9f44,0xe68b,
+0xbf90,0x0a99,0x3060,0xd9c5,
+0x3f66,0x9e75,0xf400,0x2e4f,
+0xbf2b,0x6204,0x7a54,0x8d9c,
+0x3ef1,0xea4c,0x2589,0xa8d9,
+0xbe9d,0xed0a,0x119c,0x2a52,
+0x3e4d,0xf316,0x2c36,0x7742,
+0x3e05,0x225b,0xe05c,0x9f6c,
+};
+#endif
+
+/* x > 20
+ x exp(-x) Ei(x) - 1 = 1/x A3(1/x)/B3(1/x)
+ Theoretical absolute error = 6.15e-17 */
+#if UNK
+static double A3[9] = {
+-7.657847078286127362028E-1,
+ 6.886192415566705051750E-1,
+-2.132598113545206124553E-1,
+ 3.346107552384193813594E-2,
+-3.076541477344756050249E-3,
+ 1.747119316454907477380E-4,
+-6.103711682274170530369E-6,
+ 1.218032765428652199087E-7,
+-1.086076102793290233007E-9,
+};
+static double B3[9] = {
+ /* 1.000000000000000000000E0, */
+-1.888802868662308731041E0,
+ 1.066691687211408896850E0,
+-2.751915982306380647738E-1,
+ 3.930852688233823569726E-2,
+-3.414684558602365085394E-3,
+ 1.866844370703555398195E-4,
+-6.345146083130515357861E-6,
+ 1.239754287483206878024E-7,
+-1.086076102793126632978E-9,
+};
+#endif
+#if DEC
+static short A3[36] = {
+0140104,0005167,0071746,0115510,
+0040060,0044531,0140741,0154556,
+0137532,0060307,0126506,0071123,
+0037011,0007173,0010405,0127224,
+0136111,0117715,0003654,0175577,
+0035067,0031340,0102657,0147714,
+0133714,0147173,0167473,0136640,
+0032402,0144407,0115547,0060114,
+0130625,0042347,0156431,0113425,
+};
+static short B3[36] = {
+ /* 0040200,0000000,0000000,0000000, */
+0140361,0142112,0155277,0067714,
+0040210,0104532,0065676,0074326,
+0137614,0162751,0142421,0131033,
+0037041,0000772,0053236,0002632,
+0136137,0144346,0100536,0153136,
+0035103,0140270,0152211,0166215,
+0133724,0164143,0145763,0021153,
+0032405,0017033,0035333,0025736,
+0130625,0042347,0156431,0077134,
+};
+#endif
+#if IBMPC
+static short A3[36] = {
+0xd369,0xee7c,0x814e,0xbfe8,
+0x3b2e,0x383c,0x092b,0x3fe6,
+0xce4a,0xf5a8,0x4c18,0xbfcb,
+0xb5d2,0x6220,0x21cf,0x3fa1,
+0x9f70,0xa0f5,0x33f9,0xbf69,
+0xf9f9,0x10b5,0xe65c,0x3f26,
+0x77b4,0x7de7,0x99cf,0xbed9,
+0xec09,0xf36c,0x5920,0x3e80,
+0x32e3,0xfba3,0xa89c,0xbe12,
+};
+static short B3[36] = {
+ /* 0x0000,0x0000,0x0000,0x3ff0, */
+0xedf9,0x5b57,0x3889,0xbffe,
+0xcf1b,0x4d77,0x112b,0x3ff1,
+0x3643,0x38a2,0x9cbd,0xbfd1,
+0xc0b3,0x4ad3,0x203f,0x3fa4,
+0xdacc,0xd02b,0xf91c,0xbf6b,
+0x3d92,0x1a91,0x7817,0x3f28,
+0x644d,0x797e,0x9d0c,0xbeda,
+0x657c,0x675b,0xa3c3,0x3e80,
+0x2fcb,0xfba3,0xa89c,0xbe12,
+};
+#endif
+#if MIEEE
+static short A3[36] = {
+0xbfe8,0x814e,0xee7c,0xd369,
+0x3fe6,0x092b,0x383c,0x3b2e,
+0xbfcb,0x4c18,0xf5a8,0xce4a,
+0x3fa1,0x21cf,0x6220,0xb5d2,
+0xbf69,0x33f9,0xa0f5,0x9f70,
+0x3f26,0xe65c,0x10b5,0xf9f9,
+0xbed9,0x99cf,0x7de7,0x77b4,
+0x3e80,0x5920,0xf36c,0xec09,
+0xbe12,0xa89c,0xfba3,0x32e3,
+};
+static short B3[36] = {
+/* 0x3ff0,0x0000,0x0000,0x0000, */
+0xbffe,0x3889,0x5b57,0xedf9,
+0x3ff1,0x112b,0x4d77,0xcf1b,
+0xbfd1,0x9cbd,0x38a2,0x3643,
+0x3fa4,0x203f,0x4ad3,0xc0b3,
+0xbf6b,0xf91c,0xd02b,0xdacc,
+0x3f28,0x7817,0x1a91,0x3d92,
+0xbeda,0x9d0c,0x797e,0x644d,
+0x3e80,0xa3c3,0x675b,0x657c,
+0xbe12,0xa89c,0xfba3,0x2fcb,
+};
+#endif
+
+/* 16 <= x <= 32
+ x exp(-x) Ei(x) - 1 = 1/x A4(1/x) / B4(1/x)
+ Theoretical absolute error = 1.22e-17 */
+#if UNK
+static double A4[8] = {
+-2.458119367674020323359E-1,
+-1.483382253322077687183E-1,
+ 7.248291795735551591813E-2,
+-1.348315687380940523823E-2,
+ 1.342775069788636972294E-3,
+-7.942465637159712264564E-5,
+ 2.644179518984235952241E-6,
+-4.239473659313765177195E-8,
+};
+static double B4[8] = {
+ /* 1.000000000000000000000E0, */
+-1.044225908443871106315E-1,
+-2.676453128101402655055E-1,
+ 9.695000254621984627876E-2,
+-1.601745692712991078208E-2,
+ 1.496414899205908021882E-3,
+-8.462452563778485013756E-5,
+ 2.728938403476726394024E-6,
+-4.239462431819542051337E-8,
+};
+#endif
+#if DEC
+static short A4[32] = {
+0137573,0133037,0152607,0113356,
+0137427,0162771,0145061,0126345,
+0037224,0070754,0110451,0174104,
+0136534,0164165,0072170,0063753,
+0035660,0000016,0002560,0147751,
+0134646,0110311,0123316,0047432,
+0033461,0071250,0101031,0075202,
+0132066,0012601,0077305,0170177,
+};
+static short B4[32] = {
+ /* 0040200,0000000,0000000,0000000, */
+0137325,0155602,0162437,0030710,
+0137611,0004316,0071344,0176361,
+0037306,0106671,0011103,0155053,
+0136603,0033412,0132530,0175171,
+0035704,0021532,0015516,0166130,
+0134661,0074162,0036741,0073466,
+0033467,0021316,0003100,0171325,
+0132066,0012541,0162202,0150160,
+};
+#endif
+#if IBMPC
+static short A4[] = {
+0xf2de,0xfab0,0x76c3,0xbfcf,
+0x359d,0x3946,0xfcbf,0xbfc2,
+0x3f09,0x9225,0x8e3d,0x3fb2,
+0x0cfd,0xae8f,0x9d0e,0xbf8b,
+0x19fd,0xc0ae,0x0001,0x3f56,
+0xc9e3,0x34d9,0xd219,0xbf14,
+0x2f50,0x1043,0x2e55,0x3ec6,
+0xbe10,0x2fd8,0xc2b0,0xbe66,
+};
+static short B4[] = {
+ /* 0x0000,0x0000,0x0000,0x3ff0, */
+0xe639,0x5ca3,0xbb70,0xbfba,
+0x9f9e,0xce5c,0x2119,0xbfd1,
+0x7b45,0x2248,0xd1b7,0x3fb8,
+0x1f4f,0x56ab,0x66e1,0xbf90,
+0xdd8b,0x4369,0x846b,0x3f58,
+0x2ee7,0x47bc,0x2f0e,0xbf16,
+0x1e5b,0xc0c8,0xe459,0x3ec6,
+0x5a0e,0x3c90,0xc2ac,0xbe66,
+};
+#endif
+#if MIEEE
+static short A4[32] = {
+0xbfcf,0x76c3,0xfab0,0xf2de,
+0xbfc2,0xfcbf,0x3946,0x359d,
+0x3fb2,0x8e3d,0x9225,0x3f09,
+0xbf8b,0x9d0e,0xae8f,0x0cfd,
+0x3f56,0x0001,0xc0ae,0x19fd,
+0xbf14,0xd219,0x34d9,0xc9e3,
+0x3ec6,0x2e55,0x1043,0x2f50,
+0xbe66,0xc2b0,0x2fd8,0xbe10,
+};
+static short B4[32] = {
+ /* 0x3ff0,0x0000,0x0000,0x0000, */
+0xbfba,0xbb70,0x5ca3,0xe639,
+0xbfd1,0x2119,0xce5c,0x9f9e,
+0x3fb8,0xd1b7,0x2248,0x7b45,
+0xbf90,0x66e1,0x56ab,0x1f4f,
+0x3f58,0x846b,0x4369,0xdd8b,
+0xbf16,0x2f0e,0x47bc,0x2ee7,
+0x3ec6,0xe459,0xc0c8,0x1e5b,
+0xbe66,0xc2ac,0x3c90,0x5a0e,
+};
+#endif
+
+
+#if 0
+/* 20 <= x <= 40
+ x exp(-x) Ei(x) - 1 = 1/x A4(1/x) / B4(1/x)
+ Theoretical absolute error = 1.78e-17 */
+#if UNK
+static double A4[8] = {
+ 2.067245813525780707978E-1,
+-5.153749551345223645670E-1,
+ 1.928289589546695033096E-1,
+-3.124468842857260044075E-2,
+ 2.740283734277352539912E-3,
+-1.377775664366875175601E-4,
+ 3.803788980664744242323E-6,
+-4.611038277393688031154E-8,
+};
+static double B4[8] = {
+ /* 1.000000000000000000000E0, */
+-8.544436025219516861531E-1,
+ 2.507436807692907385181E-1,
+-3.647688090228423114064E-2,
+ 3.008576950332041388892E-3,
+-1.452926405348421286334E-4,
+ 3.896007735260115431965E-6,
+-4.611037642697098234083E-8,
+};
+#endif
+#if DEC
+static short A4[32] = {
+0037523,0127633,0150301,0022031,
+0140003,0167634,0170572,0170420,
+0037505,0072364,0060672,0063220,
+0136777,0172334,0057456,0102640,
+0036063,0113125,0002476,0047251,
+0135020,0074142,0042600,0043630,
+0033577,0042230,0155372,0136105,
+0132106,0005346,0165333,0114541,
+};
+static short B4[28] = {
+ /* 0040200,0000000,0000000,0000000, */
+0140132,0136320,0160433,0131535,
+0037600,0060571,0144452,0060214,
+0137025,0064310,0024220,0176472,
+0036105,0025613,0115762,0166605,
+0135030,0054662,0035454,0061763,
+0033602,0135163,0116430,0000066,
+0132106,0005345,0020602,0137133,
+};
+#endif
+#if IBMPC
+static short A4[32] = {
+0x2483,0x7a18,0x75f3,0x3fca,
+0x5e22,0x9e2f,0x7df3,0xbfe0,
+0x4cd2,0x8c37,0xae9e,0x3fc8,
+0xd0b4,0x8be5,0xfe9b,0xbf9f,
+0xc9d5,0xa0a7,0x72ca,0x3f66,
+0x08f3,0x48b0,0x0f0c,0xbf22,
+0x5789,0x1b5f,0xe893,0x3ecf,
+0x732c,0xdd5b,0xc15c,0xbe68,
+};
+static short B4[28] = {
+ /* 0x0000,0x0000,0x0000,0x3ff0, */
+0x766c,0x1c23,0x579a,0xbfeb,
+0x4c11,0x3925,0x0c2f,0x3fd0,
+0x1fa7,0x0512,0xad19,0xbfa2,
+0x5db1,0x737e,0xa571,0x3f68,
+0x8c7e,0x4765,0x0b36,0xbf23,
+0x0007,0x73a3,0x574e,0x3ed0,
+0x57cb,0xa430,0xc15c,0xbe68,
+};
+#endif
+#if MIEEE
+static short A4[32] = {
+0x3fca,0x75f3,0x7a18,0x2483,
+0xbfe0,0x7df3,0x9e2f,0x5e22,
+0x3fc8,0xae9e,0x8c37,0x4cd2,
+0xbf9f,0xfe9b,0x8be5,0xd0b4,
+0x3f66,0x72ca,0xa0a7,0xc9d5,
+0xbf22,0x0f0c,0x48b0,0x08f3,
+0x3ecf,0xe893,0x1b5f,0x5789,
+0xbe68,0xc15c,0xdd5b,0x732c,
+};
+static short B4[28] = {
+ /* 0x3ff0,0x0000,0x0000,0x0000, */
+0xbfeb,0x579a,0x1c23,0x766c,
+0x3fd0,0x0c2f,0x3925,0x4c11,
+0xbfa2,0xad19,0x0512,0x1fa7,
+0x3f68,0xa571,0x737e,0x5db1,
+0xbf23,0x0b36,0x4765,0x8c7e,
+0x3ed0,0x574e,0x73a3,0x0007,
+0xbe68,0xc15c,0xa430,0x57cb,
+};
+#endif
+#endif /* 0 */
+
+/* 4 <= x <= 8
+ x exp(-x) Ei(x) - 1 = 1/x A5(1/x) / B5(1/x)
+ Theoretical absolute error = 2.20e-17 */
+#if UNK
+static double A5[8] = {
+-1.373215375871208729803E0,
+-7.084559133740838761406E-1,
+ 1.580806855547941010501E0,
+-2.601500427425622944234E-1,
+ 2.994674694113713763365E-2,
+-1.038086040188744005513E-3,
+ 4.371064420753005429514E-5,
+ 2.141783679522602903795E-6,
+};
+static double B5[8] = {
+ /* 1.000000000000000000000E0, */
+ 8.585231423622028380768E-1,
+ 4.483285822873995129957E-1,
+ 7.687932158124475434091E-2,
+ 2.449868241021887685904E-2,
+ 8.832165941927796567926E-4,
+ 4.590952299511353531215E-4,
+-4.729848351866523044863E-6,
+ 2.665195537390710170105E-6,
+};
+#endif
+#if DEC
+static short A5[32] = {
+0140257,0142605,0076335,0113632,
+0140065,0056535,0161231,0074311,
+0040312,0053741,0004357,0076405,
+0137605,0031142,0165503,0136705,
+0036765,0051341,0053573,0007602,
+0135610,0010143,0027643,0110522,
+0034467,0052762,0062024,0120161,
+0033417,0135620,0036500,0062647,
+};
+static short B[32] = {
+ /* 0040200,0000000,0000000,0000000, */
+0040133,0144054,0031516,0004100,
+0037745,0105522,0166622,0123146,
+0037235,0071347,0157560,0157464,
+0036710,0130565,0173747,0041670,
+0035547,0103651,0106243,0101240,
+0035360,0131267,0176263,0140257,
+0133636,0132426,0102537,0102531,
+0033462,0155665,0167503,0176350,
+};
+#endif
+#if IBMPC
+static short A5[32] = {
+0xb2f3,0xaf9b,0xf8b0,0xbff5,
+0x2f19,0xbc53,0xabab,0xbfe6,
+0xefa1,0x211d,0x4afc,0x3ff9,
+0x77b9,0x5d68,0xa64c,0xbfd0,
+0x61f0,0x2aef,0xaa5c,0x3f9e,
+0x722a,0x65f4,0x020c,0xbf51,
+0x940e,0x4c82,0xeabe,0x3f06,
+0x0cb5,0x07a8,0xf772,0x3ec1,
+};
+static short B5[32] = {
+ /* 0x0000,0x0000,0x0000,0x3ff0, */
+0xc108,0x8669,0x7905,0x3feb,
+0x54cd,0x5db2,0xb16a,0x3fdc,
+0x1be7,0xfbee,0xae5c,0x3fb3,
+0xe877,0xbefc,0x162e,0x3f99,
+0x7054,0x3194,0xf0f5,0x3f4c,
+0x7816,0xff96,0x1656,0x3f3e,
+0xf0ab,0xd0ab,0xd6a2,0xbed3,
+0x7f9d,0xbde8,0x5b76,0x3ec6,
+};
+#endif
+#if MIEEE
+static short A5[32] = {
+0xbff5,0xf8b0,0xaf9b,0xb2f3,
+0xbfe6,0xabab,0xbc53,0x2f19,
+0x3ff9,0x4afc,0x211d,0xefa1,
+0xbfd0,0xa64c,0x5d68,0x77b9,
+0x3f9e,0xaa5c,0x2aef,0x61f0,
+0xbf51,0x020c,0x65f4,0x722a,
+0x3f06,0xeabe,0x4c82,0x940e,
+0x3ec1,0xf772,0x07a8,0x0cb5,
+};
+static short B5[32] = {
+ /* 0x3ff0,0x0000,0x0000,0x0000, */
+0x3feb,0x7905,0x8669,0xc108,
+0x3fdc,0xb16a,0x5db2,0x54cd,
+0x3fb3,0xae5c,0xfbee,0x1be7,
+0x3f99,0x162e,0xbefc,0xe877,
+0x3f4c,0xf0f5,0x3194,0x7054,
+0x3f3e,0x1656,0xff96,0x7816,
+0xbed3,0xd6a2,0xd0ab,0xf0ab,
+0x3ec6,0x5b76,0xbde8,0x7f9d,
+};
+#endif
+/* 2 <= x <= 4
+ x exp(-x) Ei(x) - 1 = 1/x A6(1/x) / B6(1/x)
+ Theoretical absolute error = 4.89e-17 */
+#if UNK
+static double A6[8] = {
+ 1.981808503259689673238E-2,
+-1.271645625984917501326E0,
+-2.088160335681228318920E0,
+ 2.755544509187936721172E0,
+-4.409507048701600257171E-1,
+ 4.665623805935891391017E-2,
+-1.545042679673485262580E-3,
+ 7.059980605299617478514E-5,
+};
+static double B6[7] = {
+ /* 1.000000000000000000000E0, */
+ 1.476498670914921440652E0,
+ 5.629177174822436244827E-1,
+ 1.699017897879307263248E-1,
+ 2.291647179034212017463E-2,
+ 4.450150439728752875043E-3,
+ 1.727439612206521482874E-4,
+ 3.953167195549672482304E-5,
+};
+#endif
+#if DEC
+static short A6[32] = {
+0036642,0054611,0061263,0000140,
+0140242,0142510,0125732,0072035,
+0140405,0122153,0037643,0104527,
+0040460,0055327,0055550,0116240,
+0137741,0142112,0070441,0103510,
+0037077,0015234,0104750,0146765,
+0135712,0101407,0107554,0020253,
+0034624,0007373,0072621,0063735,
+};
+static short B6[28] = {
+ /* 0040200,0000000,0000000,0000000, */
+0040274,0176750,0110025,0061006,
+0040020,0015540,0021354,0155050,
+0037455,0175274,0015257,0021112,
+0036673,0135523,0016042,0117203,
+0036221,0151221,0046352,0144174,
+0035065,0021232,0117727,0152432,
+0034445,0147317,0037300,0067123,
+};
+#endif
+#if IBMPC
+static short A6[32] = {
+0x600c,0x2c56,0x4b31,0x3f94,
+0x4e84,0x157b,0x58a9,0xbff4,
+0x712b,0x67f4,0xb48d,0xc000,
+0x1394,0xeb6d,0x0b5a,0x4006,
+0x30e9,0x4e24,0x3889,0xbfdc,
+0x19bf,0x913d,0xe353,0x3fa7,
+0x8415,0xf1ed,0x5060,0xbf59,
+0x2cfc,0x6eb2,0x81df,0x3f12,
+};
+static short B6[28] = {
+ /* 0x0000,0x0000,0x0000,0x3ff0, */
+0xac41,0x1202,0x9fbd,0x3ff7,
+0x9b45,0x045d,0x036c,0x3fe2,
+0xe449,0x8355,0xbf57,0x3fc5,
+0x53d0,0x6384,0x776a,0x3f97,
+0x590f,0x299d,0x3a52,0x3f72,
+0xfaa3,0x53fa,0xa453,0x3f26,
+0x0dca,0xe7d8,0xb9d9,0x3f04,
+};
+#endif
+#if MIEEE
+static short A6[32] = {
+0x3f94,0x4b31,0x2c56,0x600c,
+0xbff4,0x58a9,0x157b,0x4e84,
+0xc000,0xb48d,0x67f4,0x712b,
+0x4006,0x0b5a,0xeb6d,0x1394,
+0xbfdc,0x3889,0x4e24,0x30e9,
+0x3fa7,0xe353,0x913d,0x19bf,
+0xbf59,0x5060,0xf1ed,0x8415,
+0x3f12,0x81df,0x6eb2,0x2cfc,
+};
+static short B6[28] = {
+ /* 0x3ff0,0x0000,0x0000,0x0000, */
+0x3ff7,0x9fbd,0x1202,0xac41,
+0x3fe2,0x036c,0x045d,0x9b45,
+0x3fc5,0xbf57,0x8355,0xe449,
+0x3f97,0x776a,0x6384,0x53d0,
+0x3f72,0x3a52,0x299d,0x590f,
+0x3f26,0xa453,0x53fa,0xfaa3,
+0x3f04,0xb9d9,0xe7d8,0x0dca,
+};
+#endif
+/* 32 <= x <= 64
+ x exp(-x) Ei(x) - 1 = 1/x A7(1/x) / B7(1/x)
+ Theoretical absolute error = 7.71e-18 */
+#if UNK
+static double A7[6] = {
+ 1.212561118105456670844E-1,
+-5.823133179043894485122E-1,
+ 2.348887314557016779211E-1,
+-3.040034318113248237280E-2,
+ 1.510082146865190661777E-3,
+-2.523137095499571377122E-5,
+};
+static double B7[5] = {
+ /* 1.000000000000000000000E0, */
+-1.002252150365854016662E0,
+ 2.928709694872224144953E-1,
+-3.337004338674007801307E-2,
+ 1.560544881127388842819E-3,
+-2.523137093603234562648E-5,
+};
+#endif
+#if DEC
+static short A7[24] = {
+0037370,0052437,0152524,0150125,
+0140025,0011174,0050154,0131330,
+0037560,0103253,0167464,0062245,
+0136771,0005043,0174001,0023345,
+0035705,0166762,0157300,0016451,
+0134323,0123764,0157767,0134477,
+};
+static short B7[20] = {
+ /* 0040200,0000000,0000000,0000000, */
+0140200,0044714,0064025,0060324,
+0037625,0171457,0003712,0073131,
+0137010,0127406,0150061,0141746,
+0035714,0105462,0072356,0103712,
+0134323,0123764,0156514,0077414,
+};
+#endif
+#if IBMPC
+static short A7[24] = {
+0x9a0b,0xfaaa,0x0aa3,0x3fbf,
+0x965b,0x8a0d,0xa24f,0xbfe2,
+0x8c95,0x7de6,0x10d5,0x3fce,
+0x24dd,0x7f00,0x2144,0xbf9f,
+0x03a5,0x5bd8,0xbdbe,0x3f58,
+0xf728,0x9bfe,0x74fe,0xbefa,
+};
+static short B7[20] = {
+ /* 0x0000,0x0000,0x0000,0x3ff0, */
+0xac1a,0x8d02,0x0939,0xbff0,
+0x4ecb,0xe0f9,0xbe65,0x3fd2,
+0x387d,0xda06,0x15e0,0xbfa1,
+0xd0f9,0x4e9d,0x9166,0x3f59,
+0x8fe2,0x9ba9,0x74fe,0xbefa,
+};
+#endif
+#if MIEEE
+static short A7[24] = {
+0x3fbf,0x0aa3,0xfaaa,0x9a0b,
+0xbfe2,0xa24f,0x8a0d,0x965b,
+0x3fce,0x10d5,0x7de6,0x8c95,
+0xbf9f,0x2144,0x7f00,0x24dd,
+0x3f58,0xbdbe,0x5bd8,0x03a5,
+0xbefa,0x74fe,0x9bfe,0xf728,
+};
+static short B7[20] = {
+ /* 0x3ff0,0x0000,0x0000,0x0000, */
+0xbff0,0x0939,0x8d02,0xac1a,
+0x3fd2,0xbe65,0xe0f9,0x4ecb,
+0xbfa1,0x15e0,0xda06,0x387d,
+0x3f59,0x9166,0x4e9d,0xd0f9,
+0xbefa,0x74fe,0x9ba9,0x8fe2,
+};
+#endif
+
+double ei (x)
+double x;
+{
+ double f, w;
+
+ if (x <= 0.0)
+ {
+ mtherr("ei", DOMAIN);
+ return 0.0;
+ }
+ else if (x < 2.0)
+ {
+ /* Power series.
+ inf n
+ - x
+ Ei(x) = EUL + ln x + > ----
+ - n n!
+ n=1
+ */
+ f = polevl(x,A,5) / p1evl(x,B,6);
+ /* f = polevl(x,A,6) / p1evl(x,B,7); */
+ /* f = polevl(x,A,8) / p1evl(x,B,9); */
+ return (EUL + log(x) + x * f);
+ }
+ else if (x < 4.0)
+ {
+ /* Asymptotic expansion.
+ 1 2 6
+ x exp(-x) Ei(x) = 1 + --- + --- + ---- + ...
+ x 2 3
+ x x
+ */
+ w = 1.0/x;
+ f = polevl(w,A6,7) / p1evl(w,B6,7);
+ return (exp(x) * w * (1.0 + w * f));
+ }
+ else if (x < 8.0)
+ {
+ w = 1.0/x;
+ f = polevl(w,A5,7) / p1evl(w,B5,8);
+ return (exp(x) * w * (1.0 + w * f));
+ }
+ else if (x < 16.0)
+ {
+ w = 1.0/x;
+ f = polevl(w,A2,9) / p1evl(w,B2,9);
+ return (exp(x) * w * (1.0 + w * f));
+ }
+ else if (x < 32.0)
+ {
+ w = 1.0/x;
+ f = polevl(w,A4,7) / p1evl(w,B4,8);
+ return (exp(x) * w * (1.0 + w * f));
+ }
+ else if (x < 64.0)
+ {
+ w = 1.0/x;
+ f = polevl(w,A7,5) / p1evl(w,B7,5);
+ return (exp(x) * w * (1.0 + w * f));
+ }
+ else
+ {
+ w = 1.0/x;
+ f = polevl(w,A3,8) / p1evl(w,B3,9);
+ return (exp(x) * w * (1.0 + w * f));
+ }
+}
diff --git a/libm/double/eigens.c b/libm/double/eigens.c
new file mode 100644
index 000000000..4035e76a1
--- /dev/null
+++ b/libm/double/eigens.c
@@ -0,0 +1,181 @@
+/* eigens.c
+ *
+ * Eigenvalues and eigenvectors of a real symmetric matrix
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * int n;
+ * double A[n*(n+1)/2], EV[n*n], E[n];
+ * void eigens( A, EV, E, n );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * The algorithm is due to J. vonNeumann.
+ *
+ * A[] is a symmetric matrix stored in lower triangular form.
+ * That is, A[ row, column ] = A[ (row*row+row)/2 + column ]
+ * or equivalently with row and column interchanged. The
+ * indices row and column run from 0 through n-1.
+ *
+ * EV[] is the output matrix of eigenvectors stored columnwise.
+ * That is, the elements of each eigenvector appear in sequential
+ * memory order. The jth element of the ith eigenvector is
+ * EV[ n*i+j ] = EV[i][j].
+ *
+ * E[] is the output matrix of eigenvalues. The ith element
+ * of E corresponds to the ith eigenvector (the ith row of EV).
+ *
+ * On output, the matrix A will have been diagonalized and its
+ * orginal contents are destroyed.
+ *
+ * ACCURACY:
+ *
+ * The error is controlled by an internal parameter called RANGE
+ * which is set to 1e-10. After diagonalization, the
+ * off-diagonal elements of A will have been reduced by
+ * this factor.
+ *
+ * ERROR MESSAGES:
+ *
+ * None.
+ *
+ */
+
+#include <math.h>
+#ifdef ANSIPROT
+extern double sqrt ( double );
+extern double fabs ( double );
+#else
+double sqrt(), fabs();
+#endif
+
+void eigens( A, RR, E, N )
+double A[], RR[], E[];
+int N;
+{
+int IND, L, LL, LM, M, MM, MQ, I, J, IA, LQ;
+int IQ, IM, IL, NLI, NMI;
+double ANORM, ANORMX, AIA, THR, ALM, ALL, AMM, X, Y;
+double SINX, SINX2, COSX, COSX2, SINCS, AIL, AIM;
+double RLI, RMI;
+static double RANGE = 1.0e-10; /*3.0517578e-5;*/
+
+
+/* Initialize identity matrix in RR[] */
+for( J=0; J<N*N; J++ )
+ RR[J] = 0.0;
+MM = 0;
+for( J=0; J<N; J++ )
+ {
+ RR[MM + J] = 1.0;
+ MM += N;
+ }
+
+ANORM=0.0;
+for( I=0; I<N; I++ )
+ {
+ for( J=0; J<N; J++ )
+ {
+ if( I != J )
+ {
+ IA = I + (J*J+J)/2;
+ AIA = A[IA];
+ ANORM += AIA * AIA;
+ }
+ }
+ }
+if( ANORM <= 0.0 )
+ goto done;
+ANORM = sqrt( ANORM + ANORM );
+ANORMX = ANORM * RANGE / N;
+THR = ANORM;
+
+while( THR > ANORMX )
+{
+THR=THR/N;
+
+do
+{ /* while IND != 0 */
+IND = 0;
+
+for( L=0; L<N-1; L++ )
+ {
+
+for( M=L+1; M<N; M++ )
+ {
+ MQ=(M*M+M)/2;
+ LM=L+MQ;
+ ALM=A[LM];
+ if( fabs(ALM) < THR )
+ continue;
+
+ IND=1;
+ LQ=(L*L+L)/2;
+ LL=L+LQ;
+ MM=M+MQ;
+ ALL=A[LL];
+ AMM=A[MM];
+ X=(ALL-AMM)/2.0;
+ Y=-ALM/sqrt(ALM*ALM+X*X);
+ if(X < 0.0)
+ Y=-Y;
+ SINX = Y / sqrt( 2.0 * (1.0 + sqrt( 1.0-Y*Y)) );
+ SINX2=SINX*SINX;
+ COSX=sqrt(1.0-SINX2);
+ COSX2=COSX*COSX;
+ SINCS=SINX*COSX;
+
+/* ROTATE L AND M COLUMNS */
+for( I=0; I<N; I++ )
+ {
+ IQ=(I*I+I)/2;
+ if( (I != M) && (I != L) )
+ {
+ if(I > M)
+ IM=M+IQ;
+ else
+ IM=I+MQ;
+ if(I >= L)
+ IL=L+IQ;
+ else
+ IL=I+LQ;
+ AIL=A[IL];
+ AIM=A[IM];
+ X=AIL*COSX-AIM*SINX;
+ A[IM]=AIL*SINX+AIM*COSX;
+ A[IL]=X;
+ }
+ NLI = N*L + I;
+ NMI = N*M + I;
+ RLI = RR[ NLI ];
+ RMI = RR[ NMI ];
+ RR[NLI]=RLI*COSX-RMI*SINX;
+ RR[NMI]=RLI*SINX+RMI*COSX;
+ }
+
+ X=2.0*ALM*SINCS;
+ A[LL]=ALL*COSX2+AMM*SINX2-X;
+ A[MM]=ALL*SINX2+AMM*COSX2+X;
+ A[LM]=(ALL-AMM)*SINCS+ALM*(COSX2-SINX2);
+ } /* for M=L+1 to N-1 */
+ } /* for L=0 to N-2 */
+
+ }
+while( IND != 0 );
+
+} /* while THR > ANORMX */
+
+done: ;
+
+/* Extract eigenvalues from the reduced matrix */
+L=0;
+for( J=1; J<=N; J++ )
+ {
+ L=L+J;
+ E[J-1]=A[L-1];
+ }
+}
diff --git a/libm/double/ellie.c b/libm/double/ellie.c
new file mode 100644
index 000000000..4f3379aa6
--- /dev/null
+++ b/libm/double/ellie.c
@@ -0,0 +1,148 @@
+/* ellie.c
+ *
+ * Incomplete elliptic integral of the second kind
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double phi, m, y, ellie();
+ *
+ * y = ellie( 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 [-10, 10] and m in
+ * [0, 1].
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * DEC 0,2 2000 1.9e-16 3.4e-17
+ * IEEE -10,10 150000 3.3e-15 1.4e-16
+ *
+ *
+ */
+
+
+/*
+Cephes Math Library Release 2.8: June, 2000
+Copyright 1984, 1987, 1993, 2000 by Stephen L. Moshier
+*/
+
+/* Incomplete elliptic integral of second kind */
+#include <math.h>
+extern double PI, PIO2, MACHEP;
+#ifdef ANSIPROT
+extern double sqrt ( double );
+extern double fabs ( double );
+extern double log ( double );
+extern double sin ( double x );
+extern double tan ( double x );
+extern double atan ( double );
+extern double floor ( double );
+extern double ellpe ( double );
+extern double ellpk ( double );
+double ellie ( double, double );
+#else
+double sqrt(), fabs(), log(), sin(), tan(), atan(), floor();
+double ellpe(), ellpk(), ellie();
+#endif
+
+double ellie( phi, m )
+double phi, m;
+{
+double a, b, c, e, temp;
+double lphi, t, E;
+int d, mod, npio2, sign;
+
+if( m == 0.0 )
+ return( phi );
+lphi = phi;
+npio2 = floor( lphi/PIO2 );
+if( npio2 & 1 )
+ npio2 += 1;
+lphi = lphi - npio2 * PIO2;
+if( lphi < 0.0 )
+ {
+ lphi = -lphi;
+ sign = -1;
+ }
+else
+ {
+ sign = 1;
+ }
+a = 1.0 - m;
+E = ellpe( a );
+if( a == 0.0 )
+ {
+ temp = sin( lphi );
+ goto done;
+ }
+t = tan( lphi );
+b = sqrt(a);
+/* Thanks to Brian Fitzgerald <fitzgb@mml0.meche.rpi.edu>
+ for pointing out an instability near odd multiples of pi/2. */
+if( fabs(t) > 10.0 )
+ {
+ /* Transform the amplitude */
+ e = 1.0/(b*t);
+ /* ... but avoid multiple recursions. */
+ if( fabs(e) < 10.0 )
+ {
+ e = atan(e);
+ temp = E + m * sin( lphi ) * sin( e ) - ellie( e, m );
+ goto done;
+ }
+ }
+c = sqrt(m);
+a = 1.0;
+d = 1;
+e = 0.0;
+mod = 0;
+
+while( fabs(c/a) > MACHEP )
+ {
+ temp = b/a;
+ lphi = lphi + atan(t*temp) + mod * PI;
+ mod = (lphi + PIO2)/PI;
+ t = t * ( 1.0 + temp )/( 1.0 - temp * t * t );
+ c = ( a - b )/2.0;
+ temp = sqrt( a * b );
+ a = ( a + b )/2.0;
+ b = temp;
+ d += d;
+ e += c * sin(lphi);
+ }
+
+temp = E / ellpk( 1.0 - m );
+temp *= (atan(t) + mod * PI)/(d * a);
+temp += e;
+
+done:
+
+if( sign < 0 )
+ temp = -temp;
+temp += npio2 * E;
+return( temp );
+}
diff --git a/libm/double/ellik.c b/libm/double/ellik.c
new file mode 100644
index 000000000..1c9053676
--- /dev/null
+++ b/libm/double/ellik.c
@@ -0,0 +1,148 @@
+/* ellik.c
+ *
+ * Incomplete elliptic integral of the first kind
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double phi, m, y, ellik();
+ *
+ * y = ellik( 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 m in [0, 1] and phi as indicated.
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE -10,10 200000 7.4e-16 1.0e-16
+ *
+ *
+ */
+
+
+/*
+Cephes Math Library Release 2.8: June, 2000
+Copyright 1984, 1987, 2000 by Stephen L. Moshier
+*/
+
+/* Incomplete elliptic integral of first kind */
+
+#include <math.h>
+#ifdef ANSIPROT
+extern double sqrt ( double );
+extern double fabs ( double );
+extern double log ( double );
+extern double tan ( double );
+extern double atan ( double );
+extern double floor ( double );
+extern double ellpk ( double );
+double ellik ( double, double );
+#else
+double sqrt(), fabs(), log(), tan(), atan(), floor(), ellpk();
+double ellik();
+#endif
+extern double PI, PIO2, MACHEP, MAXNUM;
+
+double ellik( phi, m )
+double phi, m;
+{
+double a, b, c, e, temp, t, K;
+int d, mod, sign, npio2;
+
+if( m == 0.0 )
+ return( phi );
+a = 1.0 - m;
+if( a == 0.0 )
+ {
+ if( fabs(phi) >= PIO2 )
+ {
+ mtherr( "ellik", SING );
+ return( MAXNUM );
+ }
+ return( log( tan( (PIO2 + phi)/2.0 ) ) );
+ }
+npio2 = floor( phi/PIO2 );
+if( npio2 & 1 )
+ npio2 += 1;
+if( npio2 )
+ {
+ K = ellpk( a );
+ phi = phi - npio2 * PIO2;
+ }
+else
+ K = 0.0;
+if( phi < 0.0 )
+ {
+ phi = -phi;
+ sign = -1;
+ }
+else
+ sign = 0;
+b = sqrt(a);
+t = tan( phi );
+if( fabs(t) > 10.0 )
+ {
+ /* Transform the amplitude */
+ e = 1.0/(b*t);
+ /* ... but avoid multiple recursions. */
+ if( fabs(e) < 10.0 )
+ {
+ e = atan(e);
+ if( npio2 == 0 )
+ K = ellpk( a );
+ temp = K - ellik( e, m );
+ goto done;
+ }
+ }
+a = 1.0;
+c = sqrt(m);
+d = 1;
+mod = 0;
+
+while( fabs(c/a) > MACHEP )
+ {
+ temp = b/a;
+ phi = phi + atan(t*temp) + mod * PI;
+ mod = (phi + PIO2)/PI;
+ t = t * ( 1.0 + temp )/( 1.0 - temp * t * t );
+ c = ( a - b )/2.0;
+ temp = sqrt( a * b );
+ a = ( a + b )/2.0;
+ b = temp;
+ d += d;
+ }
+
+temp = (atan(t) + mod * PI)/(d * a);
+
+done:
+if( sign < 0 )
+ temp = -temp;
+temp += npio2 * K;
+return( temp );
+}
diff --git a/libm/double/ellpe.c b/libm/double/ellpe.c
new file mode 100644
index 000000000..9b2438e0e
--- /dev/null
+++ b/libm/double/ellpe.c
@@ -0,0 +1,195 @@
+/* ellpe.c
+ *
+ * Complete elliptic integral of the second kind
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double m1, y, ellpe();
+ *
+ * y = ellpe( 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
+ * DEC 0, 1 13000 3.1e-17 9.4e-18
+ * IEEE 0, 1 10000 2.1e-16 7.3e-17
+ *
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * ellpe domain x<0, x>1 0.0
+ *
+ */
+
+/* ellpe.c */
+
+/* Elliptic integral of second kind */
+
+/*
+Cephes Math Library, Release 2.8: June, 2000
+Copyright 1984, 1987, 1989, 2000 by Stephen L. Moshier
+*/
+
+#include <math.h>
+
+#ifdef UNK
+static double 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 double 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
+};
+#endif
+
+#ifdef DEC
+static unsigned short P[] = {
+0035041,0001364,0141572,0117555,
+0036044,0066032,0130027,0033404,
+0036416,0053617,0064456,0102632,
+0036457,0161100,0061177,0122612,
+0036376,0136251,0012403,0124162,
+0036370,0101316,0151715,0131613,
+0036475,0105477,0050317,0133272,
+0036662,0154232,0024645,0171552,
+0037150,0126220,0047054,0030064,
+0037742,0162057,0167645,0165612,
+0040200,0000000,0000000,0000000
+};
+static unsigned short Q[] = {
+0034411,0106743,0115771,0055462,
+0035604,0052575,0155171,0045540,
+0036325,0030424,0064332,0167756,
+0036612,0052366,0063006,0115175,
+0036726,0070430,0004533,0124654,
+0037011,0022741,0030675,0030711,
+0037056,0174452,0127062,0132122,
+0037157,0177750,0142041,0072523,
+0037277,0177777,0173137,0002627,
+0037577,0177777,0177777,0101101
+};
+#endif
+
+#ifdef IBMPC
+static unsigned short P[] = {
+0x53ee,0x986f,0x205e,0x3f24,
+0xe6e0,0x5602,0x8d83,0x3f64,
+0xd0b3,0xed25,0xcaf1,0x3f81,
+0xf4b1,0x0c4f,0xfc48,0x3f85,
+0x750e,0x22a0,0xd795,0x3f7f,
+0xb671,0xda79,0x1059,0x3f7f,
+0xf6d7,0xea19,0xb167,0x3f87,
+0xbe6d,0x4534,0x5b13,0x3f96,
+0x8607,0x09c5,0x1592,0x3fad,
+0xbd71,0xfdf4,0x5c85,0x3fdc,
+0x0000,0x0000,0x0000,0x3ff0
+};
+static unsigned short Q[] = {
+0x2b66,0x737f,0x31bc,0x3f01,
+0x296c,0xbb4f,0x8aaf,0x3f50,
+0x5dfe,0x8d1b,0xa622,0x3f7a,
+0xd350,0xccc0,0x4a9e,0x3f91,
+0x7535,0x012b,0xce23,0x3f9a,
+0xa639,0x2637,0x24bc,0x3fa1,
+0x568a,0x55c6,0xdf25,0x3fa5,
+0x2eaa,0x1884,0xfffd,0x3fad,
+0xe0b3,0xfecb,0xffff,0x3fb7,
+0xf048,0xffff,0xffff,0x3fcf
+};
+#endif
+
+#ifdef MIEEE
+static unsigned short P[] = {
+0x3f24,0x205e,0x986f,0x53ee,
+0x3f64,0x8d83,0x5602,0xe6e0,
+0x3f81,0xcaf1,0xed25,0xd0b3,
+0x3f85,0xfc48,0x0c4f,0xf4b1,
+0x3f7f,0xd795,0x22a0,0x750e,
+0x3f7f,0x1059,0xda79,0xb671,
+0x3f87,0xb167,0xea19,0xf6d7,
+0x3f96,0x5b13,0x4534,0xbe6d,
+0x3fad,0x1592,0x09c5,0x8607,
+0x3fdc,0x5c85,0xfdf4,0xbd71,
+0x3ff0,0x0000,0x0000,0x0000
+};
+static unsigned short Q[] = {
+0x3f01,0x31bc,0x737f,0x2b66,
+0x3f50,0x8aaf,0xbb4f,0x296c,
+0x3f7a,0xa622,0x8d1b,0x5dfe,
+0x3f91,0x4a9e,0xccc0,0xd350,
+0x3f9a,0xce23,0x012b,0x7535,
+0x3fa1,0x24bc,0x2637,0xa639,
+0x3fa5,0xdf25,0x55c6,0x568a,
+0x3fad,0xfffd,0x1884,0x2eaa,
+0x3fb7,0xffff,0xfecb,0xe0b3,
+0x3fcf,0xffff,0xffff,0xf048
+};
+#endif
+
+#ifdef ANSIPROT
+extern double polevl ( double, void *, int );
+extern double log ( double );
+#else
+double polevl(), log();
+#endif
+
+double ellpe(x)
+double x;
+{
+
+if( (x <= 0.0) || (x > 1.0) )
+ {
+ if( x == 0.0 )
+ return( 1.0 );
+ mtherr( "ellpe", DOMAIN );
+ return( 0.0 );
+ }
+return( polevl(x,P,10) - log(x) * (x * polevl(x,Q,9)) );
+}
diff --git a/libm/double/ellpj.c b/libm/double/ellpj.c
new file mode 100644
index 000000000..327fc56e8
--- /dev/null
+++ b/libm/double/ellpj.c
@@ -0,0 +1,171 @@
+/* ellpj.c
+ *
+ * Jacobian Elliptic Functions
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double 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
+ * DEC sn 1800 4.5e-16 8.7e-17
+ * IEEE phi 10000 9.2e-16* 1.4e-16*
+ * IEEE sn 50000 4.1e-15 4.6e-16
+ * IEEE cn 40000 3.6e-15 4.4e-16
+ * IEEE dn 10000 1.3e-12 1.8e-14
+ *
+ * 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.8: June, 2000
+Copyright 1984, 1987, 2000 by Stephen L. Moshier
+*/
+
+#include <math.h>
+#ifdef ANSIPROT
+extern double sqrt ( double );
+extern double fabs ( double );
+extern double sin ( double );
+extern double cos ( double );
+extern double asin ( double );
+extern double tanh ( double );
+extern double sinh ( double );
+extern double cosh ( double );
+extern double atan ( double );
+extern double exp ( double );
+#else
+double sqrt(), fabs(), sin(), cos(), asin(), tanh();
+double sinh(), cosh(), atan(), exp();
+#endif
+extern double PIO2, MACHEP;
+
+int ellpj( u, m, sn, cn, dn, ph )
+double u, m;
+double *sn, *cn, *dn, *ph;
+{
+double ai, b, phi, t, twon;
+double a[9], c[9];
+int i;
+
+
+/* Check for special cases */
+
+if( m < 0.0 || m > 1.0 )
+ {
+ mtherr( "ellpj", DOMAIN );
+ *sn = 0.0;
+ *cn = 0.0;
+ *ph = 0.0;
+ *dn = 0.0;
+ return(-1);
+ }
+if( m < 1.0e-9 )
+ {
+ t = sin(u);
+ b = cos(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.9999999999 )
+ {
+ ai = 0.25 * (1.0-m);
+ b = cosh(u);
+ t = tanh(u);
+ phi = 1.0/b;
+ twon = b * sinh(u);
+ *sn = t + ai * (twon - u)/(b*b);
+ *ph = 2.0*atan(exp(u)) - PIO2 + 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 = sqrt(1.0 - m);
+c[0] = sqrt(m);
+twon = 1.0;
+i = 0;
+
+while( fabs(c[i]/a[i]) > MACHEP )
+ {
+ if( i > 7 )
+ {
+ mtherr( "ellpj", OVERFLOW );
+ goto done;
+ }
+ ai = a[i];
+ ++i;
+ c[i] = ( ai - b )/2.0;
+ t = sqrt( ai * b );
+ a[i] = ( ai + b )/2.0;
+ b = t;
+ twon *= 2.0;
+ }
+
+done:
+
+/* backward recurrence */
+phi = twon * a[i] * u;
+do
+ {
+ t = c[i] * sin(phi) / a[i];
+ b = phi;
+ phi = (asin(t) + phi)/2.0;
+ }
+while( --i );
+
+*sn = sin(phi);
+t = cos(phi);
+*cn = t;
+*dn = t/cos(phi-b);
+*ph = phi;
+return(0);
+}
diff --git a/libm/double/ellpk.c b/libm/double/ellpk.c
new file mode 100644
index 000000000..8b36690e2
--- /dev/null
+++ b/libm/double/ellpk.c
@@ -0,0 +1,234 @@
+/* ellpk.c
+ *
+ * Complete elliptic integral of the first kind
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double m1, y, ellpk();
+ *
+ * y = ellpk( 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
+ * DEC 0,1 16000 3.5e-17 1.1e-17
+ * IEEE 0,1 30000 2.5e-16 6.8e-17
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * ellpk domain x<0, x>1 0.0
+ *
+ */
+
+/* ellpk.c */
+
+
+/*
+Cephes Math Library, Release 2.8: June, 2000
+Copyright 1984, 1987, 2000 by Stephen L. Moshier
+*/
+
+#include <math.h>
+
+#ifdef DEC
+static unsigned short P[] =
+{
+0035020,0127576,0040430,0051544,
+0036025,0070136,0042703,0153716,
+0036402,0122614,0062555,0077777,
+0036441,0102130,0072334,0025172,
+0036341,0043320,0117242,0172076,
+0036312,0146456,0077242,0154141,
+0036420,0003467,0013727,0035407,
+0036564,0137263,0110651,0020237,
+0036775,0001330,0144056,0020305,
+0037305,0144137,0157521,0141734,
+0040261,0071027,0173721,0147572
+};
+static unsigned short Q[] =
+{
+0034366,0130371,0103453,0077633,
+0035557,0122745,0173515,0113016,
+0036302,0124470,0167304,0074473,
+0036575,0132403,0117226,0117576,
+0036703,0156271,0047124,0147733,
+0036766,0137465,0002053,0157312,
+0037031,0014423,0154274,0176515,
+0037107,0177747,0143216,0016145,
+0037217,0177777,0172621,0074000,
+0037377,0177777,0177776,0156435,
+0040000,0000000,0000000,0000000
+};
+static unsigned short ac1[] = {0040261,0071027,0173721,0147572};
+#define C1 (*(double *)ac1)
+#endif
+
+#ifdef IBMPC
+static unsigned short P[] =
+{
+0x0a6d,0xc823,0x15ef,0x3f22,
+0x7afa,0xc8b8,0xae0b,0x3f62,
+0xb000,0x8cad,0x54b1,0x3f80,
+0x854f,0x0e9b,0x308b,0x3f84,
+0x5e88,0x13d4,0x28da,0x3f7c,
+0x5b0c,0xcfd4,0x59a5,0x3f79,
+0xe761,0xe2fa,0x00e6,0x3f82,
+0x2414,0x7235,0x97d6,0x3f8e,
+0xc419,0x1905,0xa05b,0x3f9f,
+0x387c,0xfbea,0xb90b,0x3fb8,
+0x39ef,0xfefa,0x2e42,0x3ff6
+};
+static unsigned short Q[] =
+{
+0x6ff3,0x30e5,0xd61f,0x3efe,
+0xb2c2,0xbee9,0xf4bc,0x3f4d,
+0x8f27,0x1dd8,0x5527,0x3f78,
+0xd3f0,0x73d2,0xb6a0,0x3f8f,
+0x99fb,0x29ca,0x7b97,0x3f98,
+0x7bd9,0xa085,0xd7e6,0x3f9e,
+0x9faa,0x7b17,0x2322,0x3fa3,
+0xc38d,0xf8d1,0xfffc,0x3fa8,
+0x2f00,0xfeb2,0xffff,0x3fb1,
+0xdba4,0xffff,0xffff,0x3fbf,
+0x0000,0x0000,0x0000,0x3fe0
+};
+static unsigned short ac1[] = {0x39ef,0xfefa,0x2e42,0x3ff6};
+#define C1 (*(double *)ac1)
+#endif
+
+#ifdef MIEEE
+static unsigned short P[] =
+{
+0x3f22,0x15ef,0xc823,0x0a6d,
+0x3f62,0xae0b,0xc8b8,0x7afa,
+0x3f80,0x54b1,0x8cad,0xb000,
+0x3f84,0x308b,0x0e9b,0x854f,
+0x3f7c,0x28da,0x13d4,0x5e88,
+0x3f79,0x59a5,0xcfd4,0x5b0c,
+0x3f82,0x00e6,0xe2fa,0xe761,
+0x3f8e,0x97d6,0x7235,0x2414,
+0x3f9f,0xa05b,0x1905,0xc419,
+0x3fb8,0xb90b,0xfbea,0x387c,
+0x3ff6,0x2e42,0xfefa,0x39ef
+};
+static unsigned short Q[] =
+{
+0x3efe,0xd61f,0x30e5,0x6ff3,
+0x3f4d,0xf4bc,0xbee9,0xb2c2,
+0x3f78,0x5527,0x1dd8,0x8f27,
+0x3f8f,0xb6a0,0x73d2,0xd3f0,
+0x3f98,0x7b97,0x29ca,0x99fb,
+0x3f9e,0xd7e6,0xa085,0x7bd9,
+0x3fa3,0x2322,0x7b17,0x9faa,
+0x3fa8,0xfffc,0xf8d1,0xc38d,
+0x3fb1,0xffff,0xfeb2,0x2f00,
+0x3fbf,0xffff,0xffff,0xdba4,
+0x3fe0,0x0000,0x0000,0x0000
+};
+static unsigned short ac1[] = {
+0x3ff6,0x2e42,0xfefa,0x39ef
+};
+#define C1 (*(double *)ac1)
+#endif
+
+#ifdef UNK
+static double 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 double 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 double C1 = 1.3862943611198906188E0; /* log(4) */
+#endif
+
+#ifdef ANSIPROT
+extern double polevl ( double, void *, int );
+extern double p1evl ( double, void *, int );
+extern double log ( double );
+#else
+double polevl(), p1evl(), log();
+#endif
+extern double MACHEP, MAXNUM;
+
+double ellpk(x)
+double x;
+{
+
+if( (x < 0.0) || (x > 1.0) )
+ {
+ mtherr( "ellpk", DOMAIN );
+ return( 0.0 );
+ }
+
+if( x > MACHEP )
+ {
+ return( polevl(x,P,10) - log(x) * polevl(x,Q,10) );
+ }
+else
+ {
+ if( x == 0.0 )
+ {
+ mtherr( "ellpk", SING );
+ return( MAXNUM );
+ }
+ else
+ {
+ return( C1 - 0.5 * log(x) );
+ }
+ }
+}
diff --git a/libm/double/eltst.c b/libm/double/eltst.c
new file mode 100644
index 000000000..cef249eaf
--- /dev/null
+++ b/libm/double/eltst.c
@@ -0,0 +1,37 @@
+extern double MACHEP, PIO2, PI;
+double ellie(), ellpe(), floor(), fabs();
+double ellie2();
+
+main()
+{
+double y, m, phi, e, E, phipi, y1;
+int i, j, npi;
+
+/* dprec(); */
+m = 0.9;
+E = ellpe(0.1);
+for( j=-10; j<=10; j++ )
+ {
+ printf( "%d * PIO2\n", j );
+ for( i=-2; i<=2; i++ )
+ {
+ phi = PIO2 * j + 50 * MACHEP * i;
+ npi = floor(phi/PIO2);
+ if( npi & 1 )
+ npi += 1;
+ phipi = phi - npi * PIO2;
+ npi = floor(phi/PIO2);
+ if( npi & 1 )
+ npi += 1;
+ phipi = phi - npi * PIO2;
+ printf( "phi %.9e npi %d ", phi, npi );
+ y1 = E * npi + ellie(phipi,m);
+ y = ellie2( phi, m );
+ printf( "y %.9e ", y );
+ e = fabs(y - y1);
+ if( y1 != 0.0 )
+ e /= y1;
+ printf( "e %.4e\n", e );
+ }
+ }
+}
diff --git a/libm/double/euclid.c b/libm/double/euclid.c
new file mode 100644
index 000000000..3a899a6d2
--- /dev/null
+++ b/libm/double/euclid.c
@@ -0,0 +1,251 @@
+/* euclid.c
+ *
+ * Rational arithmetic routines
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ *
+ * typedef struct
+ * {
+ * double n; numerator
+ * double d; denominator
+ * }fract;
+ *
+ * radd( a, b, c ) c = b + a
+ * rsub( a, b, c ) c = b - a
+ * rmul( a, b, c ) c = b * a
+ * rdiv( a, b, c ) c = b / a
+ * euclid( &n, &d ) Reduce n/d to lowest terms,
+ * return greatest common divisor.
+ *
+ * Arguments of the routines are pointers to the structures.
+ * The double precision numbers are assumed, without checking,
+ * to be integer valued. Overflow conditions are reported.
+ */
+
+
+#include <math.h>
+#ifdef ANSIPROT
+extern double fabs ( double );
+extern double floor ( double );
+double euclid( double *, double * );
+#else
+double fabs(), floor(), euclid();
+#endif
+
+extern double MACHEP;
+#define BIG (1.0/MACHEP)
+
+typedef struct
+ {
+ double n; /* numerator */
+ double d; /* denominator */
+ }fract;
+
+/* Add fractions. */
+
+void radd( f1, f2, f3 )
+fract *f1, *f2, *f3;
+{
+double gcd, d1, d2, gcn, n1, n2;
+
+n1 = f1->n;
+d1 = f1->d;
+n2 = f2->n;
+d2 = f2->d;
+if( n1 == 0.0 )
+ {
+ f3->n = n2;
+ f3->d = d2;
+ return;
+ }
+if( n2 == 0.0 )
+ {
+ f3->n = n1;
+ f3->d = d1;
+ return;
+ }
+
+gcd = euclid( &d1, &d2 ); /* common divisors of denominators */
+gcn = euclid( &n1, &n2 ); /* common divisors of numerators */
+/* Note, factoring the numerators
+ * makes overflow slightly less likely.
+ */
+f3->n = ( n1 * d2 + n2 * d1) * gcn;
+f3->d = d1 * d2 * gcd;
+euclid( &f3->n, &f3->d );
+}
+
+
+/* Subtract fractions. */
+
+void rsub( f1, f2, f3 )
+fract *f1, *f2, *f3;
+{
+double gcd, d1, d2, gcn, n1, n2;
+
+n1 = f1->n;
+d1 = f1->d;
+n2 = f2->n;
+d2 = f2->d;
+if( n1 == 0.0 )
+ {
+ f3->n = n2;
+ f3->d = d2;
+ return;
+ }
+if( n2 == 0.0 )
+ {
+ f3->n = -n1;
+ f3->d = d1;
+ return;
+ }
+
+gcd = euclid( &d1, &d2 );
+gcn = euclid( &n1, &n2 );
+f3->n = (n2 * d1 - n1 * d2) * gcn;
+f3->d = d1 * d2 * gcd;
+euclid( &f3->n, &f3->d );
+}
+
+
+
+
+/* Multiply fractions. */
+
+void rmul( ff1, ff2, ff3 )
+fract *ff1, *ff2, *ff3;
+{
+double d1, d2, n1, n2;
+
+n1 = ff1->n;
+d1 = ff1->d;
+n2 = ff2->n;
+d2 = ff2->d;
+
+if( (n1 == 0.0) || (n2 == 0.0) )
+ {
+ ff3->n = 0.0;
+ ff3->d = 1.0;
+ return;
+ }
+euclid( &n1, &d2 ); /* cross cancel common divisors */
+euclid( &n2, &d1 );
+ff3->n = n1 * n2;
+ff3->d = d1 * d2;
+/* Report overflow. */
+if( (fabs(ff3->n) >= BIG) || (fabs(ff3->d) >= BIG) )
+ {
+ mtherr( "rmul", OVERFLOW );
+ return;
+ }
+/* euclid( &ff3->n, &ff3->d );*/
+}
+
+
+
+/* Divide fractions. */
+
+void rdiv( ff1, ff2, ff3 )
+fract *ff1, *ff2, *ff3;
+{
+double d1, d2, n1, n2;
+
+n1 = ff1->d; /* Invert ff1, then multiply */
+d1 = ff1->n;
+if( d1 < 0.0 )
+ { /* keep denominator positive */
+ n1 = -n1;
+ d1 = -d1;
+ }
+n2 = ff2->n;
+d2 = ff2->d;
+if( (n1 == 0.0) || (n2 == 0.0) )
+ {
+ ff3->n = 0.0;
+ ff3->d = 1.0;
+ return;
+ }
+
+euclid( &n1, &d2 ); /* cross cancel any common divisors */
+euclid( &n2, &d1 );
+ff3->n = n1 * n2;
+ff3->d = d1 * d2;
+/* Report overflow. */
+if( (fabs(ff3->n) >= BIG) || (fabs(ff3->d) >= BIG) )
+ {
+ mtherr( "rdiv", OVERFLOW );
+ return;
+ }
+/* euclid( &ff3->n, &ff3->d );*/
+}
+
+
+
+
+
+/* Euclidean algorithm
+ * reduces fraction to lowest terms,
+ * returns greatest common divisor.
+ */
+
+
+double euclid( num, den )
+double *num, *den;
+{
+double n, d, q, r;
+
+n = *num; /* Numerator. */
+d = *den; /* Denominator. */
+
+/* Make numbers positive, locally. */
+if( n < 0.0 )
+ n = -n;
+if( d < 0.0 )
+ d = -d;
+
+/* Abort if numbers are too big for integer arithmetic. */
+if( (n >= BIG) || (d >= BIG) )
+ {
+ mtherr( "euclid", OVERFLOW );
+ return(1.0);
+ }
+
+/* Divide by zero, gcd = 1. */
+if(d == 0.0)
+ return( 1.0 );
+
+/* Zero. Return 0/1, gcd = denominator. */
+if(n == 0.0)
+ {
+/*
+ if( *den < 0.0 )
+ *den = -1.0;
+ else
+ *den = 1.0;
+*/
+ *den = 1.0;
+ return( d );
+ }
+
+while( d > 0.5 )
+ {
+/* Find integer part of n divided by d. */
+ q = floor( n/d );
+/* Find remainder after dividing n by d. */
+ r = n - d * q;
+/* The next fraction is d/r. */
+ n = d;
+ d = r;
+ }
+
+if( n < 0.0 )
+ mtherr( "euclid", UNDERFLOW );
+
+*num /= n;
+*den /= n;
+return( n );
+}
+
diff --git a/libm/double/exp.c b/libm/double/exp.c
new file mode 100644
index 000000000..6d0a8a872
--- /dev/null
+++ b/libm/double/exp.c
@@ -0,0 +1,203 @@
+/* exp.c
+ *
+ * Exponential function
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, exp();
+ *
+ * y = exp( 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 Pade' form 1 + 2x P(x**2)/( Q(x**2) - P(x**2) )
+ * of degree 2/3 is used to approximate exp(f) in the basic
+ * interval [-0.5, 0.5].
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * DEC +- 88 50000 2.8e-17 7.0e-18
+ * IEEE +- 708 40000 2.0e-16 5.6e-17
+ *
+ *
+ * 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
+ * exp underflow x < MINLOG 0.0
+ * exp overflow x > MAXLOG INFINITY
+ *
+ */
+
+/*
+Cephes Math Library Release 2.8: June, 2000
+Copyright 1984, 1995, 2000 by Stephen L. Moshier
+*/
+
+
+/* Exponential function */
+
+#include <math.h>
+
+#ifdef UNK
+
+static double P[] = {
+ 1.26177193074810590878E-4,
+ 3.02994407707441961300E-2,
+ 9.99999999999999999910E-1,
+};
+static double Q[] = {
+ 3.00198505138664455042E-6,
+ 2.52448340349684104192E-3,
+ 2.27265548208155028766E-1,
+ 2.00000000000000000009E0,
+};
+static double C1 = 6.93145751953125E-1;
+static double C2 = 1.42860682030941723212E-6;
+#endif
+
+#ifdef DEC
+static unsigned short P[] = {
+0035004,0047156,0127442,0057502,
+0036770,0033210,0063121,0061764,
+0040200,0000000,0000000,0000000,
+};
+static unsigned short Q[] = {
+0033511,0072665,0160662,0176377,
+0036045,0070715,0124105,0132777,
+0037550,0134114,0142077,0001637,
+0040400,0000000,0000000,0000000,
+};
+static unsigned short sc1[] = {0040061,0071000,0000000,0000000};
+#define C1 (*(double *)sc1)
+static unsigned short sc2[] = {0033277,0137216,0075715,0057117};
+#define C2 (*(double *)sc2)
+#endif
+
+#ifdef IBMPC
+static unsigned short P[] = {
+0x4be8,0xd5e4,0x89cd,0x3f20,
+0x2c7e,0x0cca,0x06d1,0x3f9f,
+0x0000,0x0000,0x0000,0x3ff0,
+};
+static unsigned short Q[] = {
+0x5fa0,0xbc36,0x2eb6,0x3ec9,
+0xb6c0,0xb508,0xae39,0x3f64,
+0xe074,0x9887,0x1709,0x3fcd,
+0x0000,0x0000,0x0000,0x4000,
+};
+static unsigned short sc1[] = {0x0000,0x0000,0x2e40,0x3fe6};
+#define C1 (*(double *)sc1)
+static unsigned short sc2[] = {0xabca,0xcf79,0xf7d1,0x3eb7};
+#define C2 (*(double *)sc2)
+#endif
+
+#ifdef MIEEE
+static unsigned short P[] = {
+0x3f20,0x89cd,0xd5e4,0x4be8,
+0x3f9f,0x06d1,0x0cca,0x2c7e,
+0x3ff0,0x0000,0x0000,0x0000,
+};
+static unsigned short Q[] = {
+0x3ec9,0x2eb6,0xbc36,0x5fa0,
+0x3f64,0xae39,0xb508,0xb6c0,
+0x3fcd,0x1709,0x9887,0xe074,
+0x4000,0x0000,0x0000,0x0000,
+};
+static unsigned short sc1[] = {0x3fe6,0x2e40,0x0000,0x0000};
+#define C1 (*(double *)sc1)
+static unsigned short sc2[] = {0x3eb7,0xf7d1,0xcf79,0xabca};
+#define C2 (*(double *)sc2)
+#endif
+
+#ifdef ANSIPROT
+extern double polevl ( double, void *, int );
+extern double p1evl ( double, void *, int );
+extern double floor ( double );
+extern double ldexp ( double, int );
+extern int isnan ( double );
+extern int isfinite ( double );
+#else
+double polevl(), p1evl(), floor(), ldexp();
+int isnan(), isfinite();
+#endif
+extern double LOGE2, LOG2E, MAXLOG, MINLOG, MAXNUM;
+#ifdef INFINITIES
+extern double INFINITY;
+#endif
+
+double exp(x)
+double x;
+{
+double px, xx;
+int n;
+
+#ifdef NANS
+if( isnan(x) )
+ return(x);
+#endif
+if( x > MAXLOG)
+ {
+#ifdef INFINITIES
+ return( INFINITY );
+#else
+ mtherr( "exp", OVERFLOW );
+ return( MAXNUM );
+#endif
+ }
+
+if( x < MINLOG )
+ {
+#ifndef INFINITIES
+ mtherr( "exp", UNDERFLOW );
+#endif
+ return(0.0);
+ }
+
+/* Express e**x = e**g 2**n
+ * = e**g e**( n loge(2) )
+ * = e**( g + n loge(2) )
+ */
+px = floor( LOG2E * x + 0.5 ); /* floor() truncates toward -infinity. */
+n = px;
+x -= px * C1;
+x -= px * C2;
+
+/* rational approximation for exponential
+ * of the fractional part:
+ * e**x = 1 + 2x P(x**2)/( Q(x**2) - P(x**2) )
+ */
+xx = x * x;
+px = x * polevl( xx, P, 2 );
+x = px/( polevl( xx, Q, 3 ) - px );
+x = 1.0 + 2.0 * x;
+
+/* multiply by power of 2 */
+x = ldexp( x, n );
+return(x);
+}
diff --git a/libm/double/exp10.c b/libm/double/exp10.c
new file mode 100644
index 000000000..dd0e5a48f
--- /dev/null
+++ b/libm/double/exp10.c
@@ -0,0 +1,223 @@
+/* exp10.c
+ *
+ * Base 10 exponential function
+ * (Common antilogarithm)
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, exp10();
+ *
+ * y = exp10( 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).
+ * The Pade' form
+ *
+ * 1 + 2x P(x**2)/( Q(x**2) - P(x**2) )
+ *
+ * is used to approximate 10**f.
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE -307,+307 30000 2.2e-16 5.5e-17
+ * Test result from an earlier version (2.1):
+ * DEC -38,+38 70000 3.1e-17 7.0e-18
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * exp10 underflow x < -MAXL10 0.0
+ * exp10 overflow x > MAXL10 MAXNUM
+ *
+ * DEC arithmetic: MAXL10 = 38.230809449325611792.
+ * IEEE arithmetic: MAXL10 = 308.2547155599167.
+ *
+ */
+
+/*
+Cephes Math Library Release 2.8: June, 2000
+Copyright 1984, 1991, 2000 by Stephen L. Moshier
+*/
+
+
+#include <math.h>
+
+#ifdef UNK
+static double P[] = {
+ 4.09962519798587023075E-2,
+ 1.17452732554344059015E1,
+ 4.06717289936872725516E2,
+ 2.39423741207388267439E3,
+};
+static double Q[] = {
+/* 1.00000000000000000000E0,*/
+ 8.50936160849306532625E1,
+ 1.27209271178345121210E3,
+ 2.07960819286001865907E3,
+};
+/* static double LOG102 = 3.01029995663981195214e-1; */
+static double LOG210 = 3.32192809488736234787e0;
+static double LG102A = 3.01025390625000000000E-1;
+static double LG102B = 4.60503898119521373889E-6;
+/* static double MAXL10 = 38.230809449325611792; */
+static double MAXL10 = 308.2547155599167;
+#endif
+
+#ifdef DEC
+static unsigned short P[] = {
+0037047,0165657,0114061,0067234,
+0041073,0166243,0123052,0144643,
+0042313,0055720,0024032,0047443,
+0043025,0121714,0070232,0050007,
+};
+static unsigned short Q[] = {
+/*0040200,0000000,0000000,0000000,*/
+0041652,0027756,0071216,0050075,
+0042637,0001367,0077263,0136017,
+0043001,0174673,0024157,0133416,
+};
+/*
+static unsigned short L102[] = {0037632,0020232,0102373,0147770};
+#define LOG102 *(double *)L102
+*/
+static unsigned short L210[] = {0040524,0115170,0045715,0015613};
+#define LOG210 *(double *)L210
+static unsigned short L102A[] = {0037632,0020000,0000000,0000000,};
+#define LG102A *(double *)L102A
+static unsigned short L102B[] = {0033632,0102373,0147767,0114220,};
+#define LG102B *(double *)L102B
+static unsigned short MXL[] = {0041430,0166131,0047761,0154130,};
+#define MAXL10 ( *(double *)MXL )
+#endif
+
+#ifdef IBMPC
+static unsigned short P[] = {
+0x2dd4,0xf306,0xfd75,0x3fa4,
+0x5934,0x74c5,0x7d94,0x4027,
+0x49e4,0x0503,0x6b7a,0x4079,
+0x4a01,0x8e13,0xb479,0x40a2,
+};
+static unsigned short Q[] = {
+/*0x0000,0x0000,0x0000,0x3ff0,*/
+0xca08,0xce51,0x45fd,0x4055,
+0x7782,0xefd6,0xe05e,0x4093,
+0xf6e2,0x650d,0x3f37,0x40a0,
+};
+/*
+static unsigned short L102[] = {0x79ff,0x509f,0x4413,0x3fd3};
+#define LOG102 *(double *)L102
+*/
+static unsigned short L210[] = {0xa371,0x0979,0x934f,0x400a};
+#define LOG210 *(double *)L210
+static unsigned short L102A[] = {0x0000,0x0000,0x4400,0x3fd3,};
+#define LG102A *(double *)L102A
+static unsigned short L102B[] = {0xf312,0x79fe,0x509f,0x3ed3,};
+#define LG102B *(double *)L102B
+static double MAXL10 = 308.2547155599167;
+#endif
+
+#ifdef MIEEE
+static unsigned short P[] = {
+0x3fa4,0xfd75,0xf306,0x2dd4,
+0x4027,0x7d94,0x74c5,0x5934,
+0x4079,0x6b7a,0x0503,0x49e4,
+0x40a2,0xb479,0x8e13,0x4a01,
+};
+static unsigned short Q[] = {
+/*0x3ff0,0x0000,0x0000,0x0000,*/
+0x4055,0x45fd,0xce51,0xca08,
+0x4093,0xe05e,0xefd6,0x7782,
+0x40a0,0x3f37,0x650d,0xf6e2,
+};
+/*
+static unsigned short L102[] = {0x3fd3,0x4413,0x509f,0x79ff};
+#define LOG102 *(double *)L102
+*/
+static unsigned short L210[] = {0x400a,0x934f,0x0979,0xa371};
+#define LOG210 *(double *)L210
+static unsigned short L102A[] = {0x3fd3,0x4400,0x0000,0x0000,};
+#define LG102A *(double *)L102A
+static unsigned short L102B[] = {0x3ed3,0x509f,0x79fe,0xf312,};
+#define LG102B *(double *)L102B
+static double MAXL10 = 308.2547155599167;
+#endif
+
+#ifdef ANSIPROT
+extern double floor ( double );
+extern double ldexp ( double, int );
+extern double polevl ( double, void *, int );
+extern double p1evl ( double, void *, int );
+extern int isnan ( double );
+extern int isfinite ( double );
+#else
+double floor(), ldexp(), polevl(), p1evl();
+int isnan(), isfinite();
+#endif
+extern double MAXNUM;
+#ifdef INFINITIES
+extern double INFINITY;
+#endif
+
+double exp10(x)
+double x;
+{
+double px, xx;
+short n;
+
+#ifdef NANS
+if( isnan(x) )
+ return(x);
+#endif
+if( x > MAXL10 )
+ {
+#ifdef INFINITIES
+ return( INFINITY );
+#else
+ mtherr( "exp10", OVERFLOW );
+ return( MAXNUM );
+#endif
+ }
+
+if( x < -MAXL10 ) /* Would like to use MINLOG but can't */
+ {
+#ifndef INFINITIES
+ mtherr( "exp10", UNDERFLOW );
+#endif
+ return(0.0);
+ }
+
+/* Express 10**x = 10**g 2**n
+ * = 10**g 10**( n log10(2) )
+ * = 10**( g + n log10(2) )
+ */
+px = floor( LOG210 * x + 0.5 );
+n = px;
+x -= px * LG102A;
+x -= px * LG102B;
+
+/* rational approximation for exponential
+ * of the fractional part:
+ * 10**x = 1 + 2x P(x**2)/( Q(x**2) - P(x**2) )
+ */
+xx = x * x;
+px = x * polevl( xx, P, 3 );
+x = px/( p1evl( xx, Q, 3 ) - px );
+x = 1.0 + ldexp( x, 1 );
+
+/* multiply by power of 2 */
+x = ldexp( x, n );
+
+return(x);
+}
diff --git a/libm/double/exp2.c b/libm/double/exp2.c
new file mode 100644
index 000000000..be5bdfd0c
--- /dev/null
+++ b/libm/double/exp2.c
@@ -0,0 +1,183 @@
+/* exp2.c
+ *
+ * Base 2 exponential function
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, exp2();
+ *
+ * y = exp2( 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 Pade' form
+ *
+ * 1 + 2x P(x**2) / (Q(x**2) - x P(x**2) )
+ *
+ * approximates 2**x in the basic range [-0.5, 0.5].
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE -1022,+1024 30000 1.8e-16 5.4e-17
+ *
+ *
+ * See exp.c for comments on error amplification.
+ *
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * exp underflow x < -MAXL2 0.0
+ * exp overflow x > MAXL2 MAXNUM
+ *
+ * For DEC arithmetic, MAXL2 = 127.
+ * For IEEE arithmetic, MAXL2 = 1024.
+ */
+
+
+/*
+Cephes Math Library Release 2.8: June, 2000
+Copyright 1984, 1995, 2000 by Stephen L. Moshier
+*/
+
+
+
+#include <math.h>
+
+#ifdef UNK
+static double P[] = {
+ 2.30933477057345225087E-2,
+ 2.02020656693165307700E1,
+ 1.51390680115615096133E3,
+};
+static double Q[] = {
+/* 1.00000000000000000000E0,*/
+ 2.33184211722314911771E2,
+ 4.36821166879210612817E3,
+};
+#define MAXL2 1024.0
+#define MINL2 -1024.0
+#endif
+
+#ifdef DEC
+static unsigned short P[] = {
+0036675,0027102,0122327,0053227,
+0041241,0116724,0115412,0157355,
+0042675,0036404,0101733,0132226,
+};
+static unsigned short Q[] = {
+/*0040200,0000000,0000000,0000000,*/
+0042151,0027450,0077732,0160744,
+0043210,0100661,0077550,0056560,
+};
+#define MAXL2 127.0
+#define MINL2 -127.0
+#endif
+
+#ifdef IBMPC
+static unsigned short P[] = {
+0xead3,0x549a,0xa5c8,0x3f97,
+0x5bde,0x9361,0x33ba,0x4034,
+0x7693,0x907b,0xa7a0,0x4097,
+};
+static unsigned short Q[] = {
+/*0x0000,0x0000,0x0000,0x3ff0,*/
+0x5c3c,0x0ffb,0x25e5,0x406d,
+0x0bae,0x2fed,0x1036,0x40b1,
+};
+#define MAXL2 1024.0
+#define MINL2 -1022.0
+#endif
+
+#ifdef MIEEE
+static unsigned short P[] = {
+0x3f97,0xa5c8,0x549a,0xead3,
+0x4034,0x33ba,0x9361,0x5bde,
+0x4097,0xa7a0,0x907b,0x7693,
+};
+static unsigned short Q[] = {
+/*0x3ff0,0x0000,0x0000,0x0000,*/
+0x406d,0x25e5,0x0ffb,0x5c3c,
+0x40b1,0x1036,0x2fed,0x0bae,
+};
+#define MAXL2 1024.0
+#define MINL2 -1022.0
+#endif
+
+#ifdef ANSIPROT
+extern double polevl ( double, void *, int );
+extern double p1evl ( double, void *, int );
+extern double floor ( double );
+extern double ldexp ( double, int );
+extern int isnan ( double );
+extern int isfinite ( double );
+#else
+double polevl(), p1evl(), floor(), ldexp();
+int isnan(), isfinite();
+#endif
+#ifdef INFINITIES
+extern double INFINITY;
+#endif
+extern double MAXNUM;
+
+double exp2(x)
+double x;
+{
+double px, xx;
+short n;
+
+#ifdef NANS
+if( isnan(x) )
+ return(x);
+#endif
+if( x > MAXL2)
+ {
+#ifdef INFINITIES
+ return( INFINITY );
+#else
+ mtherr( "exp2", OVERFLOW );
+ return( MAXNUM );
+#endif
+ }
+
+if( x < MINL2 )
+ {
+#ifndef INFINITIES
+ mtherr( "exp2", UNDERFLOW );
+#endif
+ return(0.0);
+ }
+
+xx = x; /* save x */
+/* separate into integer and fractional parts */
+px = floor(x+0.5);
+n = px;
+x = x - px;
+
+/* rational approximation
+ * exp2(x) = 1 + 2xP(xx)/(Q(xx) - P(xx))
+ * where xx = x**2
+ */
+xx = x * x;
+px = x * polevl( xx, P, 2 );
+x = px / ( p1evl( xx, Q, 2 ) - px );
+x = 1.0 + ldexp( x, 1 );
+
+/* scale by power of 2 */
+x = ldexp( x, n );
+return(x);
+}
diff --git a/libm/double/expn.c b/libm/double/expn.c
new file mode 100644
index 000000000..89b6b139e
--- /dev/null
+++ b/libm/double/expn.c
@@ -0,0 +1,208 @@
+/* expn.c
+ *
+ * Exponential integral En
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * int n;
+ * double x, y, expn();
+ *
+ * y = expn( 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
+ * DEC 0, 30 5000 2.0e-16 4.6e-17
+ * IEEE 0, 30 10000 1.7e-15 3.6e-16
+ *
+ */
+
+/* expn.c */
+
+/* Cephes Math Library Release 2.8: June, 2000
+ Copyright 1985, 2000 by Stephen L. Moshier */
+
+#include <math.h>
+#ifdef ANSIPROT
+extern double pow ( double, double );
+extern double gamma ( double );
+extern double log ( double );
+extern double exp ( double );
+extern double fabs ( double );
+#else
+double pow(), gamma(), log(), exp(), fabs();
+#endif
+#define EUL 0.57721566490153286060
+#define BIG 1.44115188075855872E+17
+extern double MAXNUM, MACHEP, MAXLOG;
+
+double expn( n, x )
+int n;
+double x;
+{
+double ans, r, t, yk, xk;
+double pk, pkm1, pkm2, qk, qkm1, qkm2;
+double psi, z;
+int i, k;
+static double big = BIG;
+
+if( n < 0 )
+ goto domerr;
+
+if( x < 0 )
+ {
+domerr: mtherr( "expn", DOMAIN );
+ return( MAXNUM );
+ }
+
+if( x > MAXLOG )
+ return( 0.0 );
+
+if( x == 0.0 )
+ {
+ if( n < 2 )
+ {
+ mtherr( "expn", SING );
+ return( MAXNUM );
+ }
+ else
+ return( 1.0/(n-1.0) );
+ }
+
+if( n == 0 )
+ return( exp(-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) * exp( -x ) / xk;
+ goto done;
+ }
+
+if( x > 1.0 )
+ goto cfrac;
+
+/* expn.c */
+
+/* Power series expansion */
+
+psi = -EUL - log(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 = fabs(yk/ans);
+ else
+ t = 1.0;
+ }
+while( t > MACHEP );
+k = xk;
+t = n;
+r = n - 1;
+ans = (pow(z, r) * psi / gamma(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 = fabs( (ans - r)/r );
+ ans = r;
+ }
+ else
+ t = 1.0;
+ pkm2 = pkm1;
+ pkm1 = pk;
+ qkm2 = qkm1;
+ qkm1 = qk;
+if( fabs(pk) > big )
+ {
+ pkm2 /= big;
+ pkm1 /= big;
+ qkm2 /= big;
+ qkm1 /= big;
+ }
+ }
+while( t > MACHEP );
+
+ans *= exp( -x );
+
+done:
+return( ans );
+}
+
diff --git a/libm/double/fabs.c b/libm/double/fabs.c
new file mode 100644
index 000000000..0c4531a6c
--- /dev/null
+++ b/libm/double/fabs.c
@@ -0,0 +1,56 @@
+/* fabs.c
+ *
+ * Absolute value
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y;
+ *
+ * y = fabs( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns the absolute value of the argument.
+ *
+ */
+
+
+#include <math.h>
+/* Avoid using UNK if possible. */
+#ifdef UNK
+#if BIGENDIAN
+#define MIEEE 1
+#else
+#define IBMPC 1
+#endif
+#endif
+
+double fabs(x)
+double x;
+{
+union
+ {
+ double d;
+ short i[4];
+ } u;
+
+u.d = x;
+#ifdef IBMPC
+ u.i[3] &= 0x7fff;
+#endif
+#ifdef MIEEE
+ u.i[0] &= 0x7fff;
+#endif
+#ifdef DEC
+ u.i[3] &= 0x7fff;
+#endif
+#ifdef UNK
+if( u.d < 0 )
+ u.d = -u.d;
+#endif
+return( u.d );
+}
diff --git a/libm/double/fac.c b/libm/double/fac.c
new file mode 100644
index 000000000..a5748ac74
--- /dev/null
+++ b/libm/double/fac.c
@@ -0,0 +1,263 @@
+/* fac.c
+ *
+ * Factorial function
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double y, fac();
+ * int i;
+ *
+ * y = fac( 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 DEC arithmetic or 170 in IEEE
+ * 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. If i > 55, fac(i) = gamma(i+1);
+ * see gamma.c.
+ *
+ * Relative error:
+ * arithmetic domain peak
+ * IEEE 0, 170 1.4e-15
+ * DEC 0, 33 1.4e-17
+ *
+ */
+
+/*
+Cephes Math Library Release 2.8: June, 2000
+Copyright 1984, 1987, 2000 by Stephen L. Moshier
+*/
+
+#include <math.h>
+
+/* Factorials of integers from 0 through 33 */
+#ifdef UNK
+static double 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 MAXFAC 33
+#endif
+
+#ifdef DEC
+static unsigned short factbl[] = {
+0040200,0000000,0000000,0000000,
+0040200,0000000,0000000,0000000,
+0040400,0000000,0000000,0000000,
+0040700,0000000,0000000,0000000,
+0041300,0000000,0000000,0000000,
+0041760,0000000,0000000,0000000,
+0042464,0000000,0000000,0000000,
+0043235,0100000,0000000,0000000,
+0044035,0100000,0000000,0000000,
+0044661,0030000,0000000,0000000,
+0045535,0076000,0000000,0000000,
+0046430,0042500,0000000,0000000,
+0047344,0063740,0000000,0000000,
+0050271,0112146,0000000,0000000,
+0051242,0060731,0040000,0000000,
+0052230,0035673,0126000,0000000,
+0053230,0035673,0126000,0000000,
+0054241,0137567,0063300,0000000,
+0055265,0173546,0051630,0000000,
+0056330,0012711,0101504,0100000,
+0057407,0006635,0171012,0150000,
+0060461,0040737,0046656,0030400,
+0061563,0135223,0005317,0101540,
+0062657,0027031,0127705,0023155,
+0064003,0061223,0041723,0156322,
+0065115,0045006,0014773,0004410,
+0066246,0146044,0172433,0173526,
+0067414,0136077,0027317,0114261,
+0070566,0044556,0110753,0045465,
+0071737,0031214,0032075,0036050,
+0073121,0037543,0070371,0064146,
+0074312,0132550,0052561,0116443,
+0075512,0132550,0052561,0116443,
+0076721,0005423,0114035,0025014
+};
+#define MAXFAC 33
+#endif
+
+#ifdef IBMPC
+static unsigned short factbl[] = {
+0x0000,0x0000,0x0000,0x3ff0,
+0x0000,0x0000,0x0000,0x3ff0,
+0x0000,0x0000,0x0000,0x4000,
+0x0000,0x0000,0x0000,0x4018,
+0x0000,0x0000,0x0000,0x4038,
+0x0000,0x0000,0x0000,0x405e,
+0x0000,0x0000,0x8000,0x4086,
+0x0000,0x0000,0xb000,0x40b3,
+0x0000,0x0000,0xb000,0x40e3,
+0x0000,0x0000,0x2600,0x4116,
+0x0000,0x0000,0xaf80,0x414b,
+0x0000,0x0000,0x08a8,0x4183,
+0x0000,0x0000,0x8cfc,0x41bc,
+0x0000,0xc000,0x328c,0x41f7,
+0x0000,0x2800,0x4c3b,0x4234,
+0x0000,0x7580,0x0777,0x4273,
+0x0000,0x7580,0x0777,0x42b3,
+0x0000,0xecd8,0x37ee,0x42f4,
+0x0000,0xca73,0xbeec,0x4336,
+0x9000,0x3068,0x02b9,0x437b,
+0x5a00,0xbe41,0xe1b3,0x43c0,
+0xc620,0xe9b5,0x283b,0x4406,
+0xf06c,0x6159,0x7752,0x444e,
+0xa4ce,0x35f8,0xe5c3,0x4495,
+0x7b9a,0x687a,0x6c52,0x44e0,
+0x6121,0xc33f,0xa940,0x4529,
+0x7eeb,0x9ea3,0xd984,0x4574,
+0xf316,0xe5d9,0x9787,0x45c1,
+0x6967,0xd23d,0xc92d,0x460e,
+0xa785,0x8687,0xe651,0x465b,
+0x2d0d,0x6e1f,0x27ec,0x46aa,
+0x33a4,0x0aae,0x56ad,0x46f9,
+0x33a4,0x0aae,0x56ad,0x4749,
+0xa541,0x7303,0x2162,0x479a
+};
+#define MAXFAC 170
+#endif
+
+#ifdef MIEEE
+static unsigned short factbl[] = {
+0x3ff0,0x0000,0x0000,0x0000,
+0x3ff0,0x0000,0x0000,0x0000,
+0x4000,0x0000,0x0000,0x0000,
+0x4018,0x0000,0x0000,0x0000,
+0x4038,0x0000,0x0000,0x0000,
+0x405e,0x0000,0x0000,0x0000,
+0x4086,0x8000,0x0000,0x0000,
+0x40b3,0xb000,0x0000,0x0000,
+0x40e3,0xb000,0x0000,0x0000,
+0x4116,0x2600,0x0000,0x0000,
+0x414b,0xaf80,0x0000,0x0000,
+0x4183,0x08a8,0x0000,0x0000,
+0x41bc,0x8cfc,0x0000,0x0000,
+0x41f7,0x328c,0xc000,0x0000,
+0x4234,0x4c3b,0x2800,0x0000,
+0x4273,0x0777,0x7580,0x0000,
+0x42b3,0x0777,0x7580,0x0000,
+0x42f4,0x37ee,0xecd8,0x0000,
+0x4336,0xbeec,0xca73,0x0000,
+0x437b,0x02b9,0x3068,0x9000,
+0x43c0,0xe1b3,0xbe41,0x5a00,
+0x4406,0x283b,0xe9b5,0xc620,
+0x444e,0x7752,0x6159,0xf06c,
+0x4495,0xe5c3,0x35f8,0xa4ce,
+0x44e0,0x6c52,0x687a,0x7b9a,
+0x4529,0xa940,0xc33f,0x6121,
+0x4574,0xd984,0x9ea3,0x7eeb,
+0x45c1,0x9787,0xe5d9,0xf316,
+0x460e,0xc92d,0xd23d,0x6967,
+0x465b,0xe651,0x8687,0xa785,
+0x46aa,0x27ec,0x6e1f,0x2d0d,
+0x46f9,0x56ad,0x0aae,0x33a4,
+0x4749,0x56ad,0x0aae,0x33a4,
+0x479a,0x2162,0x7303,0xa541
+};
+#define MAXFAC 170
+#endif
+
+#ifdef ANSIPROT
+double gamma ( double );
+#else
+double gamma();
+#endif
+extern double MAXNUM;
+
+double fac(i)
+int i;
+{
+double x, f, n;
+int j;
+
+if( i < 0 )
+ {
+ mtherr( "fac", SING );
+ return( MAXNUM );
+ }
+
+if( i > MAXFAC )
+ {
+ mtherr( "fac", OVERFLOW );
+ return( MAXNUM );
+ }
+
+/* Get answer from table for small i. */
+if( i < 34 )
+ {
+#ifdef UNK
+ return( factbl[i] );
+#else
+ return( *(double *)(&factbl[4*i]) );
+#endif
+ }
+/* Use gamma function for large i. */
+if( i > 55 )
+ {
+ x = i + 1;
+ return( gamma(x) );
+ }
+/* Compute directly for intermediate i. */
+n = 34.0;
+f = 34.0;
+for( j=35; j<=i; j++ )
+ {
+ n += 1.0;
+ f *= n;
+ }
+#ifdef UNK
+ f *= factbl[33];
+#else
+ f *= *(double *)(&factbl[4*33]);
+#endif
+return( f );
+}
diff --git a/libm/double/fdtr.c b/libm/double/fdtr.c
new file mode 100644
index 000000000..469b7bedf
--- /dev/null
+++ b/libm/double/fdtr.c
@@ -0,0 +1,237 @@
+/* fdtr.c
+ *
+ * F distribution
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * int df1, df2;
+ * double x, y, fdtr();
+ *
+ * y = fdtr( 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 is
+ * nonnegative.
+ *
+ * ACCURACY:
+ *
+ * Tested at random points (a,b,x).
+ *
+ * x a,b Relative error:
+ * arithmetic domain domain # trials peak rms
+ * IEEE 0,1 0,100 100000 9.8e-15 1.7e-15
+ * IEEE 1,5 0,100 100000 6.5e-15 3.5e-16
+ * IEEE 0,1 1,10000 100000 2.2e-11 3.3e-12
+ * IEEE 1,5 1,10000 100000 1.1e-11 1.7e-13
+ * See also incbet.c.
+ *
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * fdtr domain a<0, b<0, x<0 0.0
+ *
+ */
+ /* fdtrc()
+ *
+ * Complemented F distribution
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * int df1, df2;
+ * double x, y, fdtrc();
+ *
+ * y = fdtrc( 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
+ *
+ *
+ * The incomplete beta integral is used, according to the
+ * formula
+ *
+ * P(x) = incbet( df2/2, df1/2, (df2/(df2 + df1*x) ).
+ *
+ *
+ * ACCURACY:
+ *
+ * Tested at random points (a,b,x) in the indicated intervals.
+ * x a,b Relative error:
+ * arithmetic domain domain # trials peak rms
+ * IEEE 0,1 1,100 100000 3.7e-14 5.9e-16
+ * IEEE 1,5 1,100 100000 8.0e-15 1.6e-15
+ * IEEE 0,1 1,10000 100000 1.8e-11 3.5e-13
+ * IEEE 1,5 1,10000 100000 2.0e-11 3.0e-12
+ * See also incbet.c.
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * fdtrc domain a<0, b<0, x<0 0.0
+ *
+ */
+ /* fdtri()
+ *
+ * Inverse of complemented F distribution
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * int df1, df2;
+ * double x, p, fdtri();
+ *
+ * x = fdtri( df1, df2, p );
+ *
+ * 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 p.
+ *
+ * This is accomplished using the inverse beta integral
+ * function and the relations
+ *
+ * z = incbi( df2/2, df1/2, p )
+ * 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, p )
+ * x = df2 z / (df1 (1-z)).
+ *
+ * ACCURACY:
+ *
+ * Tested at random points (a,b,p).
+ *
+ * a,b Relative error:
+ * arithmetic domain # trials peak rms
+ * For p between .001 and 1:
+ * IEEE 1,100 100000 8.3e-15 4.7e-16
+ * IEEE 1,10000 100000 2.1e-11 1.4e-13
+ * For p between 10^-6 and 10^-3:
+ * IEEE 1,100 50000 1.3e-12 8.4e-15
+ * IEEE 1,10000 50000 3.0e-12 4.8e-14
+ * See also fdtrc.c.
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * fdtri domain p <= 0 or p > 1 0.0
+ * v < 1
+ *
+ */
+
+
+/*
+Cephes Math Library Release 2.8: June, 2000
+Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier
+*/
+
+
+#include <math.h>
+#ifdef ANSIPROT
+extern double incbet ( double, double, double );
+extern double incbi ( double, double, double );
+#else
+double incbet(), incbi();
+#endif
+
+double fdtrc( ia, ib, x )
+int ia, ib;
+double x;
+{
+double a, b, w;
+
+if( (ia < 1) || (ib < 1) || (x < 0.0) )
+ {
+ mtherr( "fdtrc", DOMAIN );
+ return( 0.0 );
+ }
+a = ia;
+b = ib;
+w = b / (b + a * x);
+return( incbet( 0.5*b, 0.5*a, w ) );
+}
+
+
+
+double fdtr( ia, ib, x )
+int ia, ib;
+double x;
+{
+double a, b, w;
+
+if( (ia < 1) || (ib < 1) || (x < 0.0) )
+ {
+ mtherr( "fdtr", DOMAIN );
+ return( 0.0 );
+ }
+a = ia;
+b = ib;
+w = a * x;
+w = w / (b + w);
+return( incbet(0.5*a, 0.5*b, w) );
+}
+
+
+double fdtri( ia, ib, y )
+int ia, ib;
+double y;
+{
+double a, b, w, x;
+
+if( (ia < 1) || (ib < 1) || (y <= 0.0) || (y > 1.0) )
+ {
+ mtherr( "fdtri", DOMAIN );
+ return( 0.0 );
+ }
+a = ia;
+b = ib;
+/* Compute probability for x = 0.5. */
+w = incbet( 0.5*b, 0.5*a, 0.5 );
+/* If that is greater than y, then the solution w < .5.
+ Otherwise, solve at 1-y to remove cancellation in (b - b*w). */
+if( w > y || y < 0.001)
+ {
+ w = incbi( 0.5*b, 0.5*a, y );
+ x = (b - b*w)/(a*w);
+ }
+else
+ {
+ w = incbi( 0.5*a, 0.5*b, 1.0-y );
+ x = b*w/(a*(1.0-w));
+ }
+return(x);
+}
diff --git a/libm/double/fftr.c b/libm/double/fftr.c
new file mode 100644
index 000000000..d4ce23463
--- /dev/null
+++ b/libm/double/fftr.c
@@ -0,0 +1,237 @@
+/* fftr.c
+ *
+ * FFT of Real Valued Sequence
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x[], sine[];
+ * int m;
+ *
+ * fftr( x, m, sine );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Computes the (complex valued) discrete Fourier transform of
+ * the real valued sequence x[]. The input sequence x[] contains
+ * n = 2**m samples. The program fills array sine[k] with
+ * n/4 + 1 values of sin( 2 PI k / n ).
+ *
+ * Data format for complex valued output is real part followed
+ * by imaginary part. The output is developed in the input
+ * array x[].
+ *
+ * The algorithm takes advantage of the fact that the FFT of an
+ * n point real sequence can be obtained from an n/2 point
+ * complex FFT.
+ *
+ * A radix 2 FFT algorithm is used.
+ *
+ * Execution time on an LSI-11/23 with floating point chip
+ * is 1.0 sec for n = 256.
+ *
+ *
+ *
+ * REFERENCE:
+ *
+ * E. Oran Brigham, The Fast Fourier Transform;
+ * Prentice-Hall, Inc., 1974
+ *
+ */
+
+
+#include <math.h>
+
+static short n0 = 0;
+static short n4 = 0;
+static short msav = 0;
+
+extern double PI;
+
+#ifdef ANSIPROT
+extern double sin ( double );
+static int bitrv(int, int);
+#else
+double sin();
+static int bitrv();
+#endif
+
+fftr( x, m0, sine )
+double x[];
+int m0;
+double sine[];
+{
+int th, nd, pth, nj, dth, m;
+int n, n2, j, k, l, r;
+double xr, xi, tr, ti, co, si;
+double a, b, c, d, bc, cs, bs, cc;
+double *p, *q;
+
+/* Array x assumed filled with real-valued data */
+/* m0 = log2(n0) */
+/* n0 is the number of real data samples */
+
+if( m0 != msav )
+ {
+ msav = m0;
+
+ /* Find n0 = 2**m0 */
+ n0 = 1;
+ for( j=0; j<m0; j++ )
+ n0 <<= 1;
+
+ n4 = n0 >> 2;
+
+ /* Calculate array of sines */
+ xr = 2.0 * PI / n0;
+ for( j=0; j<=n4; j++ )
+ sine[j] = sin( j * xr );
+ }
+
+n = n0 >> 1; /* doing half length transform */
+m = m0 - 1;
+
+
+/* fftr.c */
+
+/* Complex Fourier Transform of n Complex Data Points */
+
+/* First, bit reverse the input data */
+
+for( k=0; k<n; k++ )
+ {
+ j = bitrv( k, m );
+ if( j > k )
+ { /* executed approx. n/2 times */
+ p = &x[2*k];
+ tr = *p++;
+ ti = *p;
+ q = &x[2*j+1];
+ *p = *q;
+ *(--p) = *(--q);
+ *q++ = tr;
+ *q = ti;
+ }
+ }
+
+/* fftr.c */
+/* Radix 2 Complex FFT */
+n2 = n/2;
+nj = 1;
+pth = 1;
+dth = 0;
+th = 0;
+
+for( l=0; l<m; l++ )
+ { /* executed log2(n) times, total */
+ j = 0;
+ do
+ { /* executed n-1 times, total */
+ r = th << 1;
+ si = sine[r];
+ co = sine[ n4 - r ];
+ if( j >= pth )
+ {
+ th -= dth;
+ co = -co;
+ }
+ else
+ th += dth;
+
+ nd = j;
+
+ do
+ { /* executed n/2 log2(n) times, total */
+ r = (nd << 1) + (nj << 1);
+ p = &x[ r ];
+ xr = *p++;
+ xi = *p;
+ tr = xr * co + xi * si;
+ ti = xi * co - xr * si;
+ r = nd << 1;
+ q = &x[ r ];
+ xr = *q++;
+ xi = *q;
+ *p = xi - ti;
+ *(--p) = xr - tr;
+ *q = xi + ti;
+ *(--q) = xr + tr;
+ nd += nj << 1;
+ }
+ while( nd < n );
+ }
+ while( ++j < nj );
+
+ n2 >>= 1;
+ dth = n2;
+ pth = nj;
+ nj <<= 1;
+ }
+
+/* fftr.c */
+
+/* Special trick algorithm */
+/* converts to spectrum of real series */
+
+/* Highest frequency term; add space to input array if wanted */
+/*
+x[2*n] = x[0] - x[1];
+x[2*n+1] = 0.0;
+*/
+
+/* Zero frequency term */
+x[0] = x[0] + x[1];
+x[1] = 0.0;
+n2 = n/2;
+
+for( j=1; j<=n2; j++ )
+ { /* executed n/2 times */
+ si = sine[j];
+ co = sine[ n4 - j ];
+ p = &x[ 2*j ];
+ xr = *p++;
+ xi = *p;
+ q = &x[ 2*(n-j) ];
+ tr = *q++;
+ ti = *q;
+ a = xr + tr;
+ b = xi + ti;
+ c = xr - tr;
+ d = xi - ti;
+ bc = b * co;
+ cs = c * si;
+ bs = b * si;
+ cc = c * co;
+ *p = ( d - bs - cc )/2.0;
+ *(--p) = ( a + bc - cs )/2.0;
+ *q = -( d + bs + cc )/2.0;
+ *(--q) = ( a - bc + cs )/2.0;
+ }
+
+return(0);
+}
+
+/* fftr.c */
+
+/* Bit reverser */
+
+int bitrv( j, m )
+int j, m;
+{
+register int j1, ans;
+short k;
+
+ans = 0;
+j1 = j;
+
+for( k=0; k<m; k++ )
+ {
+ ans = (ans << 1) + (j1 & 1);
+ j1 >>= 1;
+ }
+
+return( ans );
+}
diff --git a/libm/double/floor.c b/libm/double/floor.c
new file mode 100644
index 000000000..dcc1a10f1
--- /dev/null
+++ b/libm/double/floor.c
@@ -0,0 +1,453 @@
+/* ceil()
+ * floor()
+ * frexp()
+ * ldexp()
+ * signbit()
+ * isnan()
+ * isfinite()
+ *
+ * Floating point numeric utilities
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double ceil(), floor(), frexp(), ldexp();
+ * int signbit(), isnan(), isfinite();
+ * double x, y;
+ * int expnt, n;
+ *
+ * y = floor(x);
+ * y = ceil(x);
+ * y = frexp( x, &expnt );
+ * y = ldexp( x, n );
+ * n = signbit(x);
+ * n = isnan(x);
+ * n = isfinite(x);
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * All four routines return a double precision floating point
+ * result.
+ *
+ * floor() returns the largest integer less than or equal to x.
+ * It truncates toward minus infinity.
+ *
+ * ceil() returns the smallest integer greater than or equal
+ * to x. It truncates toward plus infinity.
+ *
+ * frexp() 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.
+ *
+ * ldexp() 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.8: June, 2000
+Copyright 1984, 1995, 2000 by Stephen L. Moshier
+*/
+
+
+#include <math.h>
+
+#ifdef UNK
+/* ceil(), floor(), frexp(), ldexp() may need to be rewritten. */
+#undef UNK
+#if BIGENDIAN
+#define MIEEE 1
+#else
+#define IBMPC 1
+#endif
+#endif
+
+#ifdef DEC
+#define EXPMSK 0x807f
+#define MEXP 255
+#define NBITS 56
+#endif
+
+#ifdef IBMPC
+#define EXPMSK 0x800f
+#define MEXP 0x7ff
+#define NBITS 53
+#endif
+
+#ifdef MIEEE
+#define EXPMSK 0x800f
+#define MEXP 0x7ff
+#define NBITS 53
+#endif
+
+extern double MAXNUM, NEGZERO;
+#ifdef ANSIPROT
+double floor ( double );
+int isnan ( double );
+int isfinite ( double );
+double ldexp ( double, int );
+#else
+double floor();
+int isnan(), isfinite();
+double ldexp();
+#endif
+
+double ceil(x)
+double x;
+{
+double y;
+
+#ifdef UNK
+mtherr( "ceil", DOMAIN );
+return(0.0);
+#endif
+#ifdef NANS
+if( isnan(x) )
+ return( x );
+#endif
+#ifdef INFINITIES
+if(!isfinite(x))
+ return(x);
+#endif
+
+y = floor(x);
+if( y < x )
+ y += 1.0;
+#ifdef MINUSZERO
+if( y == 0.0 && x < 0.0 )
+ return( NEGZERO );
+#endif
+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,
+};
+
+
+
+
+
+double floor(x)
+double x;
+{
+union
+ {
+ double y;
+ unsigned short sh[4];
+ } u;
+unsigned short *p;
+int e;
+
+#ifdef UNK
+mtherr( "floor", DOMAIN );
+return(0.0);
+#endif
+#ifdef NANS
+if( isnan(x) )
+ return( x );
+#endif
+#ifdef INFINITIES
+if(!isfinite(x))
+ return(x);
+#endif
+#ifdef MINUSZERO
+if(x == 0.0L)
+ return(x);
+#endif
+u.y = x;
+/* find the exponent (power of 2) */
+#ifdef DEC
+p = (unsigned short *)&u.sh[0];
+e = (( *p >> 7) & 0377) - 0201;
+p += 3;
+#endif
+
+#ifdef IBMPC
+p = (unsigned short *)&u.sh[3];
+e = (( *p >> 4) & 0x7ff) - 0x3ff;
+p -= 3;
+#endif
+
+#ifdef MIEEE
+p = (unsigned short *)&u.sh[0];
+e = (( *p >> 4) & 0x7ff) - 0x3ff;
+p += 3;
+#endif
+
+if( e < 0 )
+ {
+ if( u.y < 0.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);
+}
+
+
+
+
+double frexp( x, pw2 )
+double x;
+int *pw2;
+{
+union
+ {
+ double y;
+ unsigned short sh[4];
+ } u;
+int i;
+#ifdef DENORMAL
+int k;
+#endif
+short *q;
+
+u.y = x;
+
+#ifdef UNK
+mtherr( "frexp", DOMAIN );
+return(0.0);
+#endif
+
+#ifdef IBMPC
+q = (short *)&u.sh[3];
+#endif
+
+#ifdef DEC
+q = (short *)&u.sh[0];
+#endif
+
+#ifdef MIEEE
+q = (short *)&u.sh[0];
+#endif
+
+/* find the exponent (power of 2) */
+#ifdef DEC
+i = ( *q >> 7) & 0377;
+if( i == 0 )
+ {
+ *pw2 = 0;
+ return(0.0);
+ }
+i -= 0200;
+*pw2 = i;
+*q &= 0x807f; /* strip all exponent bits */
+*q |= 040000; /* mantissa between 0.5 and 1 */
+return(u.y);
+#endif
+
+#ifdef IBMPC
+i = ( *q >> 4) & 0x7ff;
+if( i != 0 )
+ goto ieeedon;
+#endif
+
+#ifdef MIEEE
+i = *q >> 4;
+i &= 0x7ff;
+if( i != 0 )
+ goto ieeedon;
+#ifdef DENORMAL
+
+#else
+*pw2 = 0;
+return(0.0);
+#endif
+
+#endif
+
+
+#ifndef DEC
+/* Number is denormal or zero */
+#ifdef DENORMAL
+if( u.y == 0.0 )
+ {
+ *pw2 = 0;
+ return( 0.0 );
+ }
+
+
+/* Handle denormal number. */
+do
+ {
+ u.y *= 2.0;
+ i -= 1;
+ k = ( *q >> 4) & 0x7ff;
+ }
+while( k == 0 );
+i = i + k;
+#endif /* DENORMAL */
+
+ieeedon:
+
+i -= 0x3fe;
+*pw2 = i;
+*q &= 0x800f;
+*q |= 0x3fe0;
+return( u.y );
+#endif
+}
+
+
+
+
+
+
+
+double ldexp( x, pw2 )
+double x;
+int pw2;
+{
+union
+ {
+ double y;
+ unsigned short sh[4];
+ } u;
+short *q;
+int e;
+
+#ifdef UNK
+mtherr( "ldexp", DOMAIN );
+return(0.0);
+#endif
+
+u.y = x;
+#ifdef DEC
+q = (short *)&u.sh[0];
+e = ( *q >> 7) & 0377;
+if( e == 0 )
+ return(0.0);
+#else
+
+#ifdef IBMPC
+q = (short *)&u.sh[3];
+#endif
+#ifdef MIEEE
+q = (short *)&u.sh[0];
+#endif
+while( (e = (*q & 0x7ff0) >> 4) == 0 )
+ {
+ if( u.y == 0.0 )
+ {
+ return( 0.0 );
+ }
+/* Input is denormal. */
+ if( pw2 > 0 )
+ {
+ u.y *= 2.0;
+ pw2 -= 1;
+ }
+ if( pw2 < 0 )
+ {
+ if( pw2 < -53 )
+ return(0.0);
+ u.y /= 2.0;
+ pw2 += 1;
+ }
+ if( pw2 == 0 )
+ return(u.y);
+ }
+#endif /* not DEC */
+
+e += pw2;
+
+/* Handle overflow */
+#ifdef DEC
+if( e > MEXP )
+ return( MAXNUM );
+#else
+if( e >= MEXP )
+ return( 2.0*MAXNUM );
+#endif
+
+/* Handle denormalized results */
+if( e < 1 )
+ {
+#ifdef DENORMAL
+ if( e < -53 )
+ return(0.0);
+ *q &= 0x800f;
+ *q |= 0x10;
+ /* 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 *= ldexp(1.0, e-1);
+ return(u.y);
+#else
+ return(0.0);
+#endif
+ }
+else
+ {
+#ifdef DEC
+ *q &= 0x807f; /* strip all exponent bits */
+ *q |= (e & 0xff) << 7;
+#else
+ *q &= 0x800f;
+ *q |= (e & 0x7ff) << 4;
+#endif
+ return(u.y);
+ }
+}
diff --git a/libm/double/fltest.c b/libm/double/fltest.c
new file mode 100644
index 000000000..f2e3d8665
--- /dev/null
+++ b/libm/double/fltest.c
@@ -0,0 +1,272 @@
+/* fltest.c
+ * Test program for floor(), frexp(), ldexp()
+ */
+
+/*
+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 double MACHEP;
+#define UTH -1023
+
+main()
+{
+double x, y, y0, z, f, x00, y00;
+int i, j, k, e, e0;
+int errfr, errld, errfl, underexp, err, errth, e00;
+double frexp(), ldexp(), floor();
+
+
+/*
+if( 1 )
+ goto flrtst;
+*/
+
+printf( "Testing frexp() and ldexp().\n" );
+errfr = 0;
+errld = 0;
+underexp = 0;
+f = 1.0;
+x00 = 2.0;
+y00 = 0.5;
+e00 = 2;
+
+for( j=0; j<20; j++ )
+{
+if( j == 10 )
+ {
+ f = 1.0;
+ x00 = 2.0;
+ e00 = 1;
+/* Find 2**(2**10) / 2 */
+#ifdef DEC
+ for( i=0; i<5; i++ )
+#else
+ for( i=0; i<9; i++ )
+#endif
+ {
+ x00 *= x00;
+ e00 += e00;
+ }
+ y00 = x00/2.0;
+ x00 = x00 * y00;
+ e00 += e00;
+ y00 = 0.5;
+ }
+x = x00 * f;
+y0 = y00 * f;
+e0 = e00;
+for( i=0; i<2200; i++ )
+ {
+ x /= 2.0;
+ e0 -= 1;
+ if( x == 0.0 )
+ {
+ if( f == 1.0 )
+ underexp = e0;
+ y0 = 0.0;
+ e0 = 0;
+ }
+ y = frexp( x, &e );
+ if( (e0 < -1023) && (e != e0) )
+ {
+ if( e == (e0 - 1) )
+ {
+ e += 1;
+ y /= 2.0;
+ }
+ if( e == (e0 + 1) )
+ {
+ e -= 1;
+ y *= 2.0;
+ }
+ }
+ err = y - y0;
+ if( y0 != 0.0 )
+ err /= y0;
+ if( err < 0.0 )
+ err = -err;
+ if( e0 > -1023 )
+ errth = 0.0;
+ else
+ {/* Denormal numbers may have rounding errors */
+ if( e0 == -1023 )
+ {
+ errth = 2.0 * MACHEP;
+ }
+ else
+ {
+ errth *= 2.0;
+ }
+ }
+
+ if( (x != 0.0) && ((err > errth) || (e != e0)) )
+ {
+ printf( "Test %d: ", j+1 );
+ printf( " frexp( %.15e) =?= %.15e * 2**%d;", x, y, e );
+ printf( " should be %.15e * 2**%d\n", y0, e0 );
+ errfr += 1;
+ }
+ y = ldexp( x, 1-e0 );
+ err = y - 1.0;
+ if( err < 0.0 )
+ err = -err;
+ if( (err > errth) && ((x == 0.0) && (y != 0.0)) )
+ {
+ printf( "Test %d: ", j+1 );
+ printf( "ldexp( %.15e, %d ) =?= %.15e;", x, 1-e0, y );
+ if( x != 0.0 )
+ printf( " should be %.15e\n", f );
+ else
+ printf( " should be %.15e\n", 0.0 );
+ errld += 1;
+ }
+ if( x == 0.0 )
+ {
+ break;
+ }
+ }
+f = f * 1.08005973889;
+}
+
+
+x = 2.22507385850720138309e-308;
+for (i = 0; i < 52; i++)
+ {
+ y = ldexp (x, -i);
+ z = ldexp (y, i);
+ if (x != z)
+ {
+ printf ("x %.16e, i %d, y %.16e, z %.16e\n", x, i, y, z);
+ errld += 1;
+ }
+ }
+
+
+if( (errld == 0) && (errfr == 0) )
+ {
+ printf( "No errors found.\n" );
+ }
+
+flrtst:
+
+printf( "Testing floor().\n" );
+errfl = 0;
+
+f = 1.0/MACHEP;
+x00 = 1.0;
+for( j=0; j<57; j++ )
+{
+x = x00 - 1.0;
+for( i=0; i<128; i++ )
+ {
+ y = floor(x);
+ if( y != x )
+ {
+ flierr( x, y, j );
+ errfl += 1;
+ }
+/* Warning! the if() statement is compiler dependent,
+ * since x-0.49 may be held in extra precision accumulator
+ * so would never compare equal to x! The subroutine call
+ * y = floor() forces z to be stored as a double and reloaded
+ * for the if() statement.
+ */
+ z = x - 0.49;
+ y = floor(z);
+ if( z == x )
+ break;
+ if( y != (x - 1.0) )
+ {
+ flierr( z, y, j );
+ errfl += 1;
+ }
+
+ z = x + 0.49;
+ y = floor(z);
+ if( z != x )
+ {
+ if( y != x )
+ {
+ flierr( z, y, j );
+ errfl += 1;
+ }
+ }
+ x = -x;
+ y = floor(x);
+ if( z != x )
+ {
+ if( y != x )
+ {
+ flierr( x, y, j );
+ errfl += 1;
+ }
+ }
+ z = x + 0.49;
+ y = floor(z);
+ if( z != x )
+ {
+ if( y != x )
+ {
+ flierr( z, y, j );
+ errfl += 1;
+ }
+ }
+ z = x - 0.49;
+ y = floor(z);
+ if( z != x )
+ {
+ if( y != (x - 1.0) )
+ {
+ flierr( z, y, j );
+ errfl += 1;
+ }
+ }
+ x = -x;
+ x += 1.0;
+ }
+x00 = x00 + x00;
+}
+y = floor(0.0);
+if( y != 0.0 )
+ {
+ flierr( 0.0, y, 57 );
+ errfl += 1;
+ }
+y = floor(-0.0);
+if( y != 0.0 )
+ {
+ flierr( -0.0, y, 58 );
+ errfl += 1;
+ }
+y = floor(-1.0);
+if( y != -1.0 )
+ {
+ flierr( -1.0, y, 59 );
+ errfl += 1;
+ }
+y = floor(-0.1);
+if( y != -1.0 )
+ {
+ flierr( -0.1, y, 60 );
+ errfl += 1;
+ }
+
+if( errfl == 0 )
+ printf( "No errors found in floor().\n" );
+
+}
+
+
+flierr( x, y, k )
+double x, y;
+int k;
+{
+printf( "Test %d: ", k+1 );
+printf( "floor(%.15e) =?= %.15e\n", x, y );
+}
diff --git a/libm/double/fltest2.c b/libm/double/fltest2.c
new file mode 100644
index 000000000..405b81b6a
--- /dev/null
+++ b/libm/double/fltest2.c
@@ -0,0 +1,18 @@
+int drand();
+double exp(), frexp(), ldexp();
+volatile double x, y, z;
+
+main()
+{
+int i, e;
+
+for( i=0; i<100000; i++ )
+ {
+ drand(&x);
+ x = exp( 10.0*(x - 1.5) );
+ y = frexp( x, &e );
+ z = ldexp( y, e );
+ if( z != x )
+ abort();
+ }
+}
diff --git a/libm/double/fltest3.c b/libm/double/fltest3.c
new file mode 100644
index 000000000..f3025777e
--- /dev/null
+++ b/libm/double/fltest3.c
@@ -0,0 +1,259 @@
+/* fltest.c
+ * Test program for floor(), frexp(), ldexp()
+ */
+
+/*
+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 double MACHEP;*/
+#define MACHEP 2.3e-16
+#define UTH -1023
+
+main()
+{
+double x, y, y0, z, f, x00, y00;
+int i, j, k, e, e0;
+int errfr, errld, errfl, underexp, err, errth, e00;
+double frexp(), ldexp(), floor();
+
+
+/*
+if( 1 )
+ goto flrtst;
+*/
+
+printf( "Testing frexp() and ldexp().\n" );
+errfr = 0;
+errld = 0;
+underexp = 0;
+f = 1.0;
+x00 = 2.0;
+y00 = 0.5;
+e00 = 2;
+
+for( j=0; j<20; j++ )
+{
+if( j == 10 )
+ {
+ f = 1.0;
+ x00 = 2.0;
+ e00 = 1;
+/* Find 2**(2**10) / 2 */
+#ifdef DEC
+ for( i=0; i<5; i++ )
+#else
+ for( i=0; i<9; i++ )
+#endif
+ {
+ x00 *= x00;
+ e00 += e00;
+ }
+ y00 = x00/2.0;
+ x00 = x00 * y00;
+ e00 += e00;
+ y00 = 0.5;
+ }
+x = x00 * f;
+y0 = y00 * f;
+e0 = e00;
+for( i=0; i<2200; i++ )
+ {
+ x /= 2.0;
+ e0 -= 1;
+ if( x == 0.0 )
+ {
+ if( f == 1.0 )
+ underexp = e0;
+ y0 = 0.0;
+ e0 = 0;
+ }
+ y = frexp( x, &e );
+ if( (e0 < -1023) && (e != e0) )
+ {
+ if( e == (e0 - 1) )
+ {
+ e += 1;
+ y /= 2.0;
+ }
+ if( e == (e0 + 1) )
+ {
+ e -= 1;
+ y *= 2.0;
+ }
+ }
+ err = y - y0;
+ if( y0 != 0.0 )
+ err /= y0;
+ if( err < 0.0 )
+ err = -err;
+ if( e0 > -1023 )
+ errth = 0.0;
+ else
+ {/* Denormal numbers may have rounding errors */
+ if( e0 == -1023 )
+ {
+ errth = 2.0 * MACHEP;
+ }
+ else
+ {
+ errth *= 2.0;
+ }
+ }
+
+ if( (x != 0.0) && ((err > errth) || (e != e0)) )
+ {
+ printf( "Test %d: ", j+1 );
+ printf( " frexp( %.15e) =?= %.15e * 2**%d;", x, y, e );
+ printf( " should be %.15e * 2**%d\n", y0, e0 );
+ errfr += 1;
+ }
+ y = ldexp( x, 1-e0 );
+ err = y - 1.0;
+ if( err < 0.0 )
+ err = -err;
+ if( (err > errth) && ((x == 0.0) && (y != 0.0)) )
+ {
+ printf( "Test %d: ", j+1 );
+ printf( "ldexp( %.15e, %d ) =?= %.15e;", x, 1-e0, y );
+ if( x != 0.0 )
+ printf( " should be %.15e\n", f );
+ else
+ printf( " should be %.15e\n", 0.0 );
+ errld += 1;
+ }
+ if( x == 0.0 )
+ {
+ break;
+ }
+ }
+f = f * 1.08005973889;
+}
+
+if( (errld == 0) && (errfr == 0) )
+ {
+ printf( "No errors found.\n" );
+ }
+
+flrtst:
+
+printf( "Testing floor().\n" );
+errfl = 0;
+
+f = 1.0/MACHEP;
+x00 = 1.0;
+for( j=0; j<57; j++ )
+{
+x = x00 - 1.0;
+for( i=0; i<128; i++ )
+ {
+ y = floor(x);
+ if( y != x )
+ {
+ flierr( x, y, j );
+ errfl += 1;
+ }
+/* Warning! the if() statement is compiler dependent,
+ * since x-0.49 may be held in extra precision accumulator
+ * so would never compare equal to x! The subroutine call
+ * y = floor() forces z to be stored as a double and reloaded
+ * for the if() statement.
+ */
+ z = x - 0.49;
+ y = floor(z);
+ if( z == x )
+ break;
+ if( y != (x - 1.0) )
+ {
+ flierr( z, y, j );
+ errfl += 1;
+ }
+
+ z = x + 0.49;
+ y = floor(z);
+ if( z != x )
+ {
+ if( y != x )
+ {
+ flierr( z, y, j );
+ errfl += 1;
+ }
+ }
+ x = -x;
+ y = floor(x);
+ if( z != x )
+ {
+ if( y != x )
+ {
+ flierr( x, y, j );
+ errfl += 1;
+ }
+ }
+ z = x + 0.49;
+ y = floor(z);
+ if( z != x )
+ {
+ if( y != x )
+ {
+ flierr( z, y, j );
+ errfl += 1;
+ }
+ }
+ z = x - 0.49;
+ y = floor(z);
+ if( z != x )
+ {
+ if( y != (x - 1.0) )
+ {
+ flierr( z, y, j );
+ errfl += 1;
+ }
+ }
+ x = -x;
+ x += 1.0;
+ }
+x00 = x00 + x00;
+}
+y = floor(0.0);
+if( y != 0.0 )
+ {
+ flierr( 0.0, y, 57 );
+ errfl += 1;
+ }
+y = floor(-0.0);
+if( y != 0.0 )
+ {
+ flierr( -0.0, y, 58 );
+ errfl += 1;
+ }
+y = floor(-1.0);
+if( y != -1.0 )
+ {
+ flierr( -1.0, y, 59 );
+ errfl += 1;
+ }
+y = floor(-0.1);
+if( y != -1.0 )
+ {
+ flierr( -0.1, y, 60 );
+ errfl += 1;
+ }
+
+if( errfl == 0 )
+ printf( "No errors found in floor().\n" );
+
+}
+
+
+flierr( x, y, k )
+double x, y;
+int k;
+{
+printf( "Test %d: ", k+1 );
+printf( "floor(%.15e) =?= %.15e\n", x, y );
+}
diff --git a/libm/double/fresnl.c b/libm/double/fresnl.c
new file mode 100644
index 000000000..0872d107a
--- /dev/null
+++ b/libm/double/fresnl.c
@@ -0,0 +1,515 @@
+/* fresnl.c
+ *
+ * Fresnel integral
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, S, C;
+ * void fresnl();
+ *
+ * fresnl( 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 a power series for x < 1.
+ * 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 10000 2.0e-15 3.2e-16
+ * IEEE C(x) 0, 10 10000 1.8e-15 3.3e-16
+ * DEC S(x) 0, 10 6000 2.2e-16 3.9e-17
+ * DEC C(x) 0, 10 5000 2.3e-16 3.9e-17
+ */
+
+/*
+Cephes Math Library Release 2.8: June, 2000
+Copyright 1984, 1987, 1989, 2000 by Stephen L. Moshier
+*/
+
+#include <math.h>
+
+/* S(x) for small x */
+#ifdef UNK
+static double sn[6] = {
+-2.99181919401019853726E3,
+ 7.08840045257738576863E5,
+-6.29741486205862506537E7,
+ 2.54890880573376359104E9,
+-4.42979518059697779103E10,
+ 3.18016297876567817986E11,
+};
+static double sd[6] = {
+/* 1.00000000000000000000E0,*/
+ 2.81376268889994315696E2,
+ 4.55847810806532581675E4,
+ 5.17343888770096400730E6,
+ 4.19320245898111231129E8,
+ 2.24411795645340920940E10,
+ 6.07366389490084639049E11,
+};
+#endif
+#ifdef DEC
+static unsigned short sn[24] = {
+0143072,0176433,0065455,0127034,
+0045055,0007200,0134540,0026661,
+0146560,0035061,0023667,0127545,
+0050027,0166503,0002673,0153756,
+0151045,0002721,0121737,0102066,
+0051624,0013177,0033451,0021271,
+};
+static unsigned short sd[24] = {
+/*0040200,0000000,0000000,0000000,*/
+0042214,0130051,0112070,0101617,
+0044062,0010307,0172346,0152510,
+0045635,0160575,0143200,0136642,
+0047307,0171215,0127457,0052361,
+0050647,0031447,0032621,0013510,
+0052015,0064733,0117362,0012653,
+};
+#endif
+#ifdef IBMPC
+static unsigned short sn[24] = {
+0xb5c3,0x6d65,0x5fa3,0xc0a7,
+0x05b6,0x172c,0xa1d0,0x4125,
+0xf5ed,0x24f6,0x0746,0xc18e,
+0x7afe,0x60b7,0xfda8,0x41e2,
+0xf087,0x347b,0xa0ba,0xc224,
+0x2457,0xe6e5,0x82cf,0x4252,
+};
+static unsigned short sd[24] = {
+/*0x0000,0x0000,0x0000,0x3ff0,*/
+0x1072,0x3287,0x9605,0x4071,
+0xdaa9,0xfe9c,0x4218,0x40e6,
+0x17b4,0xb8d0,0xbc2f,0x4153,
+0xea9e,0xb5e5,0xfe51,0x41b8,
+0x22e9,0xe6b2,0xe664,0x4214,
+0x42b5,0x73de,0xad3b,0x4261,
+};
+#endif
+#ifdef MIEEE
+static unsigned short sn[24] = {
+0xc0a7,0x5fa3,0x6d65,0xb5c3,
+0x4125,0xa1d0,0x172c,0x05b6,
+0xc18e,0x0746,0x24f6,0xf5ed,
+0x41e2,0xfda8,0x60b7,0x7afe,
+0xc224,0xa0ba,0x347b,0xf087,
+0x4252,0x82cf,0xe6e5,0x2457,
+};
+static unsigned short sd[24] = {
+/*0x3ff0,0x0000,0x0000,0x0000,*/
+0x4071,0x9605,0x3287,0x1072,
+0x40e6,0x4218,0xfe9c,0xdaa9,
+0x4153,0xbc2f,0xb8d0,0x17b4,
+0x41b8,0xfe51,0xb5e5,0xea9e,
+0x4214,0xe664,0xe6b2,0x22e9,
+0x4261,0xad3b,0x73de,0x42b5,
+};
+#endif
+
+/* C(x) for small x */
+#ifdef UNK
+static double cn[6] = {
+-4.98843114573573548651E-8,
+ 9.50428062829859605134E-6,
+-6.45191435683965050962E-4,
+ 1.88843319396703850064E-2,
+-2.05525900955013891793E-1,
+ 9.99999999999999998822E-1,
+};
+static double cd[7] = {
+ 3.99982968972495980367E-12,
+ 9.15439215774657478799E-10,
+ 1.25001862479598821474E-7,
+ 1.22262789024179030997E-5,
+ 8.68029542941784300606E-4,
+ 4.12142090722199792936E-2,
+ 1.00000000000000000118E0,
+};
+#endif
+#ifdef DEC
+static unsigned short cn[24] = {
+0132126,0040141,0063733,0013231,
+0034037,0072223,0010200,0075637,
+0135451,0021020,0073264,0036057,
+0036632,0131520,0101316,0060233,
+0137522,0072541,0136124,0132202,
+0040200,0000000,0000000,0000000,
+};
+static unsigned short cd[28] = {
+0026614,0135503,0051776,0032631,
+0030573,0121116,0154033,0126712,
+0032406,0034100,0012442,0106212,
+0034115,0017567,0150520,0164623,
+0035543,0106171,0177336,0146351,
+0037050,0150073,0000607,0171635,
+0040200,0000000,0000000,0000000,
+};
+#endif
+#ifdef IBMPC
+static unsigned short cn[24] = {
+0x62d3,0x2cfb,0xc80c,0xbe6a,
+0x0f74,0x6210,0xee92,0x3ee3,
+0x8786,0x0ed6,0x2442,0xbf45,
+0xcc13,0x1059,0x566a,0x3f93,
+0x9690,0x378a,0x4eac,0xbfca,
+0x0000,0x0000,0x0000,0x3ff0,
+};
+static unsigned short cd[28] = {
+0xc6b3,0x6a7f,0x9768,0x3d91,
+0x75b9,0xdb03,0x7449,0x3e0f,
+0x5191,0x02a4,0xc708,0x3e80,
+0x1d32,0xfa2a,0xa3ee,0x3ee9,
+0xd99d,0x3fdb,0x718f,0x3f4c,
+0xfe74,0x6030,0x1a07,0x3fa5,
+0x0000,0x0000,0x0000,0x3ff0,
+};
+#endif
+#ifdef MIEEE
+static unsigned short cn[24] = {
+0xbe6a,0xc80c,0x2cfb,0x62d3,
+0x3ee3,0xee92,0x6210,0x0f74,
+0xbf45,0x2442,0x0ed6,0x8786,
+0x3f93,0x566a,0x1059,0xcc13,
+0xbfca,0x4eac,0x378a,0x9690,
+0x3ff0,0x0000,0x0000,0x0000,
+};
+static unsigned short cd[28] = {
+0x3d91,0x9768,0x6a7f,0xc6b3,
+0x3e0f,0x7449,0xdb03,0x75b9,
+0x3e80,0xc708,0x02a4,0x5191,
+0x3ee9,0xa3ee,0xfa2a,0x1d32,
+0x3f4c,0x718f,0x3fdb,0xd99d,
+0x3fa5,0x1a07,0x6030,0xfe74,
+0x3ff0,0x0000,0x0000,0x0000,
+};
+#endif
+
+/* Auxiliary function f(x) */
+#ifdef UNK
+static double fn[10] = {
+ 4.21543555043677546506E-1,
+ 1.43407919780758885261E-1,
+ 1.15220955073585758835E-2,
+ 3.45017939782574027900E-4,
+ 4.63613749287867322088E-6,
+ 3.05568983790257605827E-8,
+ 1.02304514164907233465E-10,
+ 1.72010743268161828879E-13,
+ 1.34283276233062758925E-16,
+ 3.76329711269987889006E-20,
+};
+static double fd[10] = {
+/* 1.00000000000000000000E0,*/
+ 7.51586398353378947175E-1,
+ 1.16888925859191382142E-1,
+ 6.44051526508858611005E-3,
+ 1.55934409164153020873E-4,
+ 1.84627567348930545870E-6,
+ 1.12699224763999035261E-8,
+ 3.60140029589371370404E-11,
+ 5.88754533621578410010E-14,
+ 4.52001434074129701496E-17,
+ 1.25443237090011264384E-20,
+};
+#endif
+#ifdef DEC
+static unsigned short fn[40] = {
+0037727,0152216,0106601,0016214,
+0037422,0154606,0112710,0071355,
+0036474,0143453,0154253,0166545,
+0035264,0161606,0022250,0073743,
+0033633,0110036,0024653,0136246,
+0032003,0036652,0041164,0036413,
+0027740,0174122,0046305,0036726,
+0025501,0125270,0121317,0167667,
+0023032,0150555,0076175,0047443,
+0020061,0133570,0070130,0027657,
+};
+static unsigned short fd[40] = {
+/*0040200,0000000,0000000,0000000,*/
+0040100,0063767,0054413,0151452,
+0037357,0061566,0007243,0065754,
+0036323,0005365,0033552,0133625,
+0035043,0101123,0000275,0165402,
+0033367,0146614,0110623,0023647,
+0031501,0116644,0125222,0144263,
+0027436,0062051,0117235,0001411,
+0025204,0111543,0056370,0036201,
+0022520,0071351,0015227,0122144,
+0017554,0172240,0112713,0005006,
+};
+#endif
+#ifdef IBMPC
+static unsigned short fn[40] = {
+0x2391,0xd1b0,0xfa91,0x3fda,
+0x0e5e,0xd2b9,0x5b30,0x3fc2,
+0x7dad,0x7b15,0x98e5,0x3f87,
+0x0efc,0xc495,0x9c70,0x3f36,
+0x7795,0xc535,0x7203,0x3ed3,
+0x87a1,0x484e,0x67b5,0x3e60,
+0xa7bb,0x4998,0x1f0a,0x3ddc,
+0xfdf7,0x1459,0x3557,0x3d48,
+0xa9e4,0xaf8f,0x5a2d,0x3ca3,
+0x05f6,0x0e0b,0x36ef,0x3be6,
+};
+static unsigned short fd[40] = {
+/*0x0000,0x0000,0x0000,0x3ff0,*/
+0x7a65,0xeb21,0x0cfe,0x3fe8,
+0x6d7d,0xc1d4,0xec6e,0x3fbd,
+0x56f3,0xa6ed,0x615e,0x3f7a,
+0xbd60,0x6017,0x704a,0x3f24,
+0x64f5,0x9232,0xf9b1,0x3ebe,
+0x5916,0x9552,0x33b4,0x3e48,
+0xa061,0x33d3,0xcc85,0x3dc3,
+0x0790,0x6b9f,0x926c,0x3d30,
+0xf48d,0x2352,0x0e5d,0x3c8a,
+0x6141,0x12b9,0x9e94,0x3bcd,
+};
+#endif
+#ifdef MIEEE
+static unsigned short fn[40] = {
+0x3fda,0xfa91,0xd1b0,0x2391,
+0x3fc2,0x5b30,0xd2b9,0x0e5e,
+0x3f87,0x98e5,0x7b15,0x7dad,
+0x3f36,0x9c70,0xc495,0x0efc,
+0x3ed3,0x7203,0xc535,0x7795,
+0x3e60,0x67b5,0x484e,0x87a1,
+0x3ddc,0x1f0a,0x4998,0xa7bb,
+0x3d48,0x3557,0x1459,0xfdf7,
+0x3ca3,0x5a2d,0xaf8f,0xa9e4,
+0x3be6,0x36ef,0x0e0b,0x05f6,
+};
+static unsigned short fd[40] = {
+/*0x3ff0,0x0000,0x0000,0x0000,*/
+0x3fe8,0x0cfe,0xeb21,0x7a65,
+0x3fbd,0xec6e,0xc1d4,0x6d7d,
+0x3f7a,0x615e,0xa6ed,0x56f3,
+0x3f24,0x704a,0x6017,0xbd60,
+0x3ebe,0xf9b1,0x9232,0x64f5,
+0x3e48,0x33b4,0x9552,0x5916,
+0x3dc3,0xcc85,0x33d3,0xa061,
+0x3d30,0x926c,0x6b9f,0x0790,
+0x3c8a,0x0e5d,0x2352,0xf48d,
+0x3bcd,0x9e94,0x12b9,0x6141,
+};
+#endif
+
+
+/* Auxiliary function g(x) */
+#ifdef UNK
+static double gn[11] = {
+ 5.04442073643383265887E-1,
+ 1.97102833525523411709E-1,
+ 1.87648584092575249293E-2,
+ 6.84079380915393090172E-4,
+ 1.15138826111884280931E-5,
+ 9.82852443688422223854E-8,
+ 4.45344415861750144738E-10,
+ 1.08268041139020870318E-12,
+ 1.37555460633261799868E-15,
+ 8.36354435630677421531E-19,
+ 1.86958710162783235106E-22,
+};
+static double gd[11] = {
+/* 1.00000000000000000000E0,*/
+ 1.47495759925128324529E0,
+ 3.37748989120019970451E-1,
+ 2.53603741420338795122E-2,
+ 8.14679107184306179049E-4,
+ 1.27545075667729118702E-5,
+ 1.04314589657571990585E-7,
+ 4.60680728146520428211E-10,
+ 1.10273215066240270757E-12,
+ 1.38796531259578871258E-15,
+ 8.39158816283118707363E-19,
+ 1.86958710162783236342E-22,
+};
+#endif
+#ifdef DEC
+static unsigned short gn[44] = {
+0040001,0021435,0120406,0053123,
+0037511,0152523,0037703,0122011,
+0036631,0134302,0122721,0110235,
+0035463,0051712,0043215,0114732,
+0034101,0025677,0147725,0057630,
+0032323,0010342,0067523,0002206,
+0030364,0152247,0110007,0054107,
+0026230,0057654,0035464,0047124,
+0023706,0036401,0167705,0045440,
+0021166,0154447,0105632,0142461,
+0016142,0002353,0011175,0170530,
+};
+static unsigned short gd[44] = {
+/*0040200,0000000,0000000,0000000,*/
+0040274,0145551,0016742,0127005,
+0037654,0166557,0076416,0015165,
+0036717,0140217,0030675,0050111,
+0035525,0110060,0076405,0070502,
+0034125,0176061,0060120,0031730,
+0032340,0001615,0054343,0120501,
+0030375,0041414,0070747,0107060,
+0026233,0031034,0160757,0074526,
+0023710,0003341,0137100,0144664,
+0021167,0126414,0023774,0015435,
+0016142,0002353,0011175,0170530,
+};
+#endif
+#ifdef IBMPC
+static unsigned short gn[44] = {
+0xcaca,0xb420,0x2463,0x3fe0,
+0x7481,0x67f8,0x3aaa,0x3fc9,
+0x3214,0x54ba,0x3718,0x3f93,
+0xb33b,0x48d1,0x6a79,0x3f46,
+0xabf3,0xf9fa,0x2577,0x3ee8,
+0x6091,0x4dea,0x621c,0x3e7a,
+0xeb09,0xf200,0x9a94,0x3dfe,
+0x89cb,0x8766,0x0bf5,0x3d73,
+0xa964,0x3df8,0xc7a0,0x3cd8,
+0x58a6,0xf173,0xdb24,0x3c2e,
+0xbe2b,0x624f,0x409d,0x3b6c,
+};
+static unsigned short gd[44] = {
+/*0x0000,0x0000,0x0000,0x3ff0,*/
+0x55c1,0x23bc,0x996d,0x3ff7,
+0xc34f,0xefa1,0x9dad,0x3fd5,
+0xaa09,0xe637,0xf811,0x3f99,
+0xae28,0x0fa0,0xb206,0x3f4a,
+0x067b,0x2c0a,0xbf86,0x3eea,
+0x7428,0xab1c,0x0071,0x3e7c,
+0xf1c6,0x8e3c,0xa861,0x3dff,
+0xef2b,0x9c3d,0x6643,0x3d73,
+0x1936,0x37c8,0x00dc,0x3cd9,
+0x8364,0x84ff,0xf5a1,0x3c2e,
+0xbe2b,0x624f,0x409d,0x3b6c,
+};
+#endif
+#ifdef MIEEE
+static unsigned short gn[44] = {
+0x3fe0,0x2463,0xb420,0xcaca,
+0x3fc9,0x3aaa,0x67f8,0x7481,
+0x3f93,0x3718,0x54ba,0x3214,
+0x3f46,0x6a79,0x48d1,0xb33b,
+0x3ee8,0x2577,0xf9fa,0xabf3,
+0x3e7a,0x621c,0x4dea,0x6091,
+0x3dfe,0x9a94,0xf200,0xeb09,
+0x3d73,0x0bf5,0x8766,0x89cb,
+0x3cd8,0xc7a0,0x3df8,0xa964,
+0x3c2e,0xdb24,0xf173,0x58a6,
+0x3b6c,0x409d,0x624f,0xbe2b,
+};
+static unsigned short gd[44] = {
+/*0x3ff0,0x0000,0x0000,0x0000,*/
+0x3ff7,0x996d,0x23bc,0x55c1,
+0x3fd5,0x9dad,0xefa1,0xc34f,
+0x3f99,0xf811,0xe637,0xaa09,
+0x3f4a,0xb206,0x0fa0,0xae28,
+0x3eea,0xbf86,0x2c0a,0x067b,
+0x3e7c,0x0071,0xab1c,0x7428,
+0x3dff,0xa861,0x8e3c,0xf1c6,
+0x3d73,0x6643,0x9c3d,0xef2b,
+0x3cd9,0x00dc,0x37c8,0x1936,
+0x3c2e,0xf5a1,0x84ff,0x8364,
+0x3b6c,0x409d,0x624f,0xbe2b,
+};
+#endif
+
+#ifdef ANSIPROT
+extern double fabs ( double );
+extern double cos ( double );
+extern double sin ( double );
+extern double polevl ( double, void *, int );
+extern double p1evl ( double, void *, int );
+#else
+double fabs(), cos(), sin(), polevl(), p1evl();
+#endif
+extern double PI, PIO2, MACHEP;
+
+int fresnl( xxa, ssa, cca )
+double xxa, *ssa, *cca;
+{
+double f, g, cc, ss, c, s, t, u;
+double x, x2;
+
+x = fabs(xxa);
+x2 = x * x;
+if( x2 < 2.5625 )
+ {
+ t = x2 * x2;
+ ss = x * x2 * polevl( t, sn, 5)/p1evl( t, sd, 6 );
+ cc = x * polevl( t, cn, 5)/polevl(t, cd, 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 = PI * x2;
+ u = 1.0/(t * t);
+ t = 1.0/t;
+ f = 1.0 - u * polevl( u, fn, 9)/p1evl(u, fd, 10);
+ g = t * polevl( u, gn, 10)/p1evl(u, gd, 11);
+
+ t = PIO2 * x2;
+ c = cos(t);
+ s = sin(t);
+ t = PI * 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;
+return(0);
+}
diff --git a/libm/double/gamma.c b/libm/double/gamma.c
new file mode 100644
index 000000000..341b4e915
--- /dev/null
+++ b/libm/double/gamma.c
@@ -0,0 +1,685 @@
+/* gamma.c
+ *
+ * Gamma function
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, gamma();
+ * extern int sgngam;
+ *
+ * y = gamma( 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 sgngam.
+ * This variable is also filled in by the logarithmic gamma
+ * function lgam().
+ *
+ * Arguments |x| <= 34 are reduced by recurrence and the function
+ * approximated by a rational function of degree 6/7 in the
+ * interval (2,3). Large arguments are handled by Stirling's
+ * formula. Large negative arguments are made positive using
+ * a reflection formula.
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * DEC -34, 34 10000 1.3e-16 2.5e-17
+ * IEEE -170,-33 20000 2.3e-15 3.3e-16
+ * IEEE -33, 33 20000 9.4e-16 2.2e-16
+ * IEEE 33, 171.6 20000 2.3e-15 3.2e-16
+ *
+ * Error for arguments outside the test range will be larger
+ * owing to error amplification by the exponential function.
+ *
+ */
+/* lgam()
+ *
+ * Natural logarithm of gamma function
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, lgam();
+ * extern int sgngam;
+ *
+ * y = lgam( 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 sgngam.
+ *
+ * For arguments greater than 13, the logarithm of the gamma
+ * function is approximated by the logarithmic version of
+ * Stirling's formula using a polynomial approximation of
+ * degree 4. Arguments between -33 and +33 are reduced by
+ * recurrence to the interval [2,3] of a rational approximation.
+ * The cosecant reflection formula is employed for arguments
+ * less than -33.
+ *
+ * Arguments greater than MAXLGM return MAXNUM and an error
+ * message. MAXLGM = 2.035093e36 for DEC
+ * arithmetic or 2.556348e305 for IEEE arithmetic.
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ *
+ * arithmetic domain # trials peak rms
+ * DEC 0, 3 7000 5.2e-17 1.3e-17
+ * DEC 2.718, 2.035e36 5000 3.9e-17 9.9e-18
+ * IEEE 0, 3 28000 5.4e-16 1.1e-16
+ * IEEE 2.718, 2.556e305 40000 3.5e-16 8.3e-17
+ * The error criterion was relative when the function magnitude
+ * was greater than one but absolute when it was less than one.
+ *
+ * The following test used the relative error criterion, though
+ * at certain points the relative error could be much higher than
+ * indicated.
+ * IEEE -200, -4 10000 4.8e-16 1.3e-16
+ *
+ */
+
+/* gamma.c */
+/* gamma function */
+
+/*
+Cephes Math Library Release 2.8: June, 2000
+Copyright 1984, 1987, 1989, 1992, 2000 by Stephen L. Moshier
+*/
+
+
+#include <math.h>
+
+#ifdef UNK
+static double P[] = {
+ 1.60119522476751861407E-4,
+ 1.19135147006586384913E-3,
+ 1.04213797561761569935E-2,
+ 4.76367800457137231464E-2,
+ 2.07448227648435975150E-1,
+ 4.94214826801497100753E-1,
+ 9.99999999999999996796E-1
+};
+static double Q[] = {
+-2.31581873324120129819E-5,
+ 5.39605580493303397842E-4,
+-4.45641913851797240494E-3,
+ 1.18139785222060435552E-2,
+ 3.58236398605498653373E-2,
+-2.34591795718243348568E-1,
+ 7.14304917030273074085E-2,
+ 1.00000000000000000320E0
+};
+#define MAXGAM 171.624376956302725
+static double LOGPI = 1.14472988584940017414;
+#endif
+
+#ifdef DEC
+static unsigned short P[] = {
+0035047,0162701,0146301,0005234,
+0035634,0023437,0032065,0176530,
+0036452,0137157,0047330,0122574,
+0037103,0017310,0143041,0017232,
+0037524,0066516,0162563,0164605,
+0037775,0004671,0146237,0014222,
+0040200,0000000,0000000,0000000
+};
+static unsigned short Q[] = {
+0134302,0041724,0020006,0116565,
+0035415,0072121,0044251,0025634,
+0136222,0003447,0035205,0121114,
+0036501,0107552,0154335,0104271,
+0037022,0135717,0014776,0171471,
+0137560,0034324,0165024,0037021,
+0037222,0045046,0047151,0161213,
+0040200,0000000,0000000,0000000
+};
+#define MAXGAM 34.84425627277176174
+static unsigned short LPI[4] = {
+0040222,0103202,0043475,0006750,
+};
+#define LOGPI *(double *)LPI
+#endif
+
+#ifdef IBMPC
+static unsigned short P[] = {
+0x2153,0x3998,0xfcb8,0x3f24,
+0xbfab,0xe686,0x84e3,0x3f53,
+0x14b0,0xe9db,0x57cd,0x3f85,
+0x23d3,0x18c4,0x63d9,0x3fa8,
+0x7d31,0xdcae,0x8da9,0x3fca,
+0xe312,0x3993,0xa137,0x3fdf,
+0x0000,0x0000,0x0000,0x3ff0
+};
+static unsigned short Q[] = {
+0xd3af,0x8400,0x487a,0xbef8,
+0x2573,0x2915,0xae8a,0x3f41,
+0xb44a,0xe750,0x40e4,0xbf72,
+0xb117,0x5b1b,0x31ed,0x3f88,
+0xde67,0xe33f,0x5779,0x3fa2,
+0x87c2,0x9d42,0x071a,0xbfce,
+0x3c51,0xc9cd,0x4944,0x3fb2,
+0x0000,0x0000,0x0000,0x3ff0
+};
+#define MAXGAM 171.624376956302725
+static unsigned short LPI[4] = {
+0xa1bd,0x48e7,0x50d0,0x3ff2,
+};
+#define LOGPI *(double *)LPI
+#endif
+
+#ifdef MIEEE
+static unsigned short P[] = {
+0x3f24,0xfcb8,0x3998,0x2153,
+0x3f53,0x84e3,0xe686,0xbfab,
+0x3f85,0x57cd,0xe9db,0x14b0,
+0x3fa8,0x63d9,0x18c4,0x23d3,
+0x3fca,0x8da9,0xdcae,0x7d31,
+0x3fdf,0xa137,0x3993,0xe312,
+0x3ff0,0x0000,0x0000,0x0000
+};
+static unsigned short Q[] = {
+0xbef8,0x487a,0x8400,0xd3af,
+0x3f41,0xae8a,0x2915,0x2573,
+0xbf72,0x40e4,0xe750,0xb44a,
+0x3f88,0x31ed,0x5b1b,0xb117,
+0x3fa2,0x5779,0xe33f,0xde67,
+0xbfce,0x071a,0x9d42,0x87c2,
+0x3fb2,0x4944,0xc9cd,0x3c51,
+0x3ff0,0x0000,0x0000,0x0000
+};
+#define MAXGAM 171.624376956302725
+static unsigned short LPI[4] = {
+0x3ff2,0x50d0,0x48e7,0xa1bd,
+};
+#define LOGPI *(double *)LPI
+#endif
+
+/* Stirling's formula for the gamma function */
+#if UNK
+static double STIR[5] = {
+ 7.87311395793093628397E-4,
+-2.29549961613378126380E-4,
+-2.68132617805781232825E-3,
+ 3.47222221605458667310E-3,
+ 8.33333333333482257126E-2,
+};
+#define MAXSTIR 143.01608
+static double SQTPI = 2.50662827463100050242E0;
+#endif
+#if DEC
+static unsigned short STIR[20] = {
+0035516,0061622,0144553,0112224,
+0135160,0131531,0037460,0165740,
+0136057,0134460,0037242,0077270,
+0036143,0107070,0156306,0027751,
+0037252,0125252,0125252,0146064,
+};
+#define MAXSTIR 26.77
+static unsigned short SQT[4] = {
+0040440,0066230,0177661,0034055,
+};
+#define SQTPI *(double *)SQT
+#endif
+#if IBMPC
+static unsigned short STIR[20] = {
+0x7293,0x592d,0xcc72,0x3f49,
+0x1d7c,0x27e6,0x166b,0xbf2e,
+0x4fd7,0x07d4,0xf726,0xbf65,
+0xc5fd,0x1b98,0x71c7,0x3f6c,
+0x5986,0x5555,0x5555,0x3fb5,
+};
+#define MAXSTIR 143.01608
+static unsigned short SQT[4] = {
+0x2706,0x1ff6,0x0d93,0x4004,
+};
+#define SQTPI *(double *)SQT
+#endif
+#if MIEEE
+static unsigned short STIR[20] = {
+0x3f49,0xcc72,0x592d,0x7293,
+0xbf2e,0x166b,0x27e6,0x1d7c,
+0xbf65,0xf726,0x07d4,0x4fd7,
+0x3f6c,0x71c7,0x1b98,0xc5fd,
+0x3fb5,0x5555,0x5555,0x5986,
+};
+#define MAXSTIR 143.01608
+static unsigned short SQT[4] = {
+0x4004,0x0d93,0x1ff6,0x2706,
+};
+#define SQTPI *(double *)SQT
+#endif
+
+int sgngam = 0;
+extern int sgngam;
+extern double MAXLOG, MAXNUM, PI;
+#ifdef ANSIPROT
+extern double pow ( double, double );
+extern double log ( double );
+extern double exp ( double );
+extern double sin ( double );
+extern double polevl ( double, void *, int );
+extern double p1evl ( double, void *, int );
+extern double floor ( double );
+extern double fabs ( double );
+extern int isnan ( double );
+extern int isfinite ( double );
+static double stirf ( double );
+double lgam ( double );
+#else
+double pow(), log(), exp(), sin(), polevl(), p1evl(), floor(), fabs();
+int isnan(), isfinite();
+static double stirf();
+double lgam();
+#endif
+#ifdef INFINITIES
+extern double INFINITY;
+#endif
+#ifdef NANS
+extern double NAN;
+#endif
+
+/* Gamma function computed by Stirling's formula.
+ * The polynomial STIR is valid for 33 <= x <= 172.
+ */
+static double stirf(x)
+double x;
+{
+double y, w, v;
+
+w = 1.0/x;
+w = 1.0 + w * polevl( w, STIR, 4 );
+y = exp(x);
+if( x > MAXSTIR )
+ { /* Avoid overflow in pow() */
+ v = pow( x, 0.5 * x - 0.25 );
+ y = v * (v / y);
+ }
+else
+ {
+ y = pow( x, x - 0.5 ) / y;
+ }
+y = SQTPI * y * w;
+return( y );
+}
+
+
+
+double gamma(x)
+double x;
+{
+double p, q, z;
+int i;
+
+sgngam = 1;
+#ifdef NANS
+if( isnan(x) )
+ return(x);
+#endif
+#ifdef INFINITIES
+#ifdef NANS
+if( x == INFINITY )
+ return(x);
+if( x == -INFINITY )
+ return(NAN);
+#else
+if( !isfinite(x) )
+ return(x);
+#endif
+#endif
+q = fabs(x);
+
+if( q > 33.0 )
+ {
+ if( x < 0.0 )
+ {
+ p = floor(q);
+ if( p == q )
+ {
+#ifdef NANS
+gamnan:
+ mtherr( "gamma", DOMAIN );
+ return (NAN);
+#else
+ goto goverf;
+#endif
+ }
+ i = p;
+ if( (i & 1) == 0 )
+ sgngam = -1;
+ z = q - p;
+ if( z > 0.5 )
+ {
+ p += 1.0;
+ z = q - p;
+ }
+ z = q * sin( PI * z );
+ if( z == 0.0 )
+ {
+#ifdef INFINITIES
+ return( sgngam * INFINITY);
+#else
+goverf:
+ mtherr( "gamma", OVERFLOW );
+ return( sgngam * MAXNUM);
+#endif
+ }
+ z = fabs(z);
+ z = PI/(z * stirf(q) );
+ }
+ else
+ {
+ z = stirf(x);
+ }
+ return( sgngam * z );
+ }
+
+z = 1.0;
+while( x >= 3.0 )
+ {
+ x -= 1.0;
+ z *= x;
+ }
+
+while( x < 0.0 )
+ {
+ if( x > -1.E-9 )
+ goto small;
+ z /= x;
+ x += 1.0;
+ }
+
+while( x < 2.0 )
+ {
+ if( x < 1.e-9 )
+ goto small;
+ z /= x;
+ x += 1.0;
+ }
+
+if( x == 2.0 )
+ return(z);
+
+x -= 2.0;
+p = polevl( x, P, 6 );
+q = polevl( x, Q, 7 );
+return( z * p / q );
+
+small:
+if( x == 0.0 )
+ {
+#ifdef INFINITIES
+#ifdef NANS
+ goto gamnan;
+#else
+ return( INFINITY );
+#endif
+#else
+ mtherr( "gamma", SING );
+ return( MAXNUM );
+#endif
+ }
+else
+ return( z/((1.0 + 0.5772156649015329 * x) * x) );
+}
+
+
+
+/* A[]: Stirling's formula expansion of log gamma
+ * B[], C[]: log gamma function between 2 and 3
+ */
+#ifdef UNK
+static double A[] = {
+ 8.11614167470508450300E-4,
+-5.95061904284301438324E-4,
+ 7.93650340457716943945E-4,
+-2.77777777730099687205E-3,
+ 8.33333333333331927722E-2
+};
+static double B[] = {
+-1.37825152569120859100E3,
+-3.88016315134637840924E4,
+-3.31612992738871184744E5,
+-1.16237097492762307383E6,
+-1.72173700820839662146E6,
+-8.53555664245765465627E5
+};
+static double C[] = {
+/* 1.00000000000000000000E0, */
+-3.51815701436523470549E2,
+-1.70642106651881159223E4,
+-2.20528590553854454839E5,
+-1.13933444367982507207E6,
+-2.53252307177582951285E6,
+-2.01889141433532773231E6
+};
+/* log( sqrt( 2*pi ) ) */
+static double LS2PI = 0.91893853320467274178;
+#define MAXLGM 2.556348e305
+#endif
+
+#ifdef DEC
+static unsigned short A[] = {
+0035524,0141201,0034633,0031405,
+0135433,0176755,0126007,0045030,
+0035520,0006371,0003342,0172730,
+0136066,0005540,0132605,0026407,
+0037252,0125252,0125252,0125132
+};
+static unsigned short B[] = {
+0142654,0044014,0077633,0035410,
+0144027,0110641,0125335,0144760,
+0144641,0165637,0142204,0047447,
+0145215,0162027,0146246,0155211,
+0145322,0026110,0010317,0110130,
+0145120,0061472,0120300,0025363
+};
+static unsigned short C[] = {
+/*0040200,0000000,0000000,0000000*/
+0142257,0164150,0163630,0112622,
+0143605,0050153,0156116,0135272,
+0144527,0056045,0145642,0062332,
+0145213,0012063,0106250,0001025,
+0145432,0111254,0044577,0115142,
+0145366,0071133,0050217,0005122
+};
+/* log( sqrt( 2*pi ) ) */
+static unsigned short LS2P[] = {040153,037616,041445,0172645,};
+#define LS2PI *(double *)LS2P
+#define MAXLGM 2.035093e36
+#endif
+
+#ifdef IBMPC
+static unsigned short A[] = {
+0x6661,0x2733,0x9850,0x3f4a,
+0xe943,0xb580,0x7fbd,0xbf43,
+0x5ebb,0x20dc,0x019f,0x3f4a,
+0xa5a1,0x16b0,0xc16c,0xbf66,
+0x554b,0x5555,0x5555,0x3fb5
+};
+static unsigned short B[] = {
+0x6761,0x8ff3,0x8901,0xc095,
+0xb93e,0x355b,0xf234,0xc0e2,
+0x89e5,0xf890,0x3d73,0xc114,
+0xdb51,0xf994,0xbc82,0xc131,
+0xf20b,0x0219,0x4589,0xc13a,
+0x055e,0x5418,0x0c67,0xc12a
+};
+static unsigned short C[] = {
+/*0x0000,0x0000,0x0000,0x3ff0,*/
+0x12b2,0x1cf3,0xfd0d,0xc075,
+0xd757,0x7b89,0xaa0d,0xc0d0,
+0x4c9b,0xb974,0xeb84,0xc10a,
+0x0043,0x7195,0x6286,0xc131,
+0xf34c,0x892f,0x5255,0xc143,
+0xe14a,0x6a11,0xce4b,0xc13e
+};
+/* log( sqrt( 2*pi ) ) */
+static unsigned short LS2P[] = {
+0xbeb5,0xc864,0x67f1,0x3fed
+};
+#define LS2PI *(double *)LS2P
+#define MAXLGM 2.556348e305
+#endif
+
+#ifdef MIEEE
+static unsigned short A[] = {
+0x3f4a,0x9850,0x2733,0x6661,
+0xbf43,0x7fbd,0xb580,0xe943,
+0x3f4a,0x019f,0x20dc,0x5ebb,
+0xbf66,0xc16c,0x16b0,0xa5a1,
+0x3fb5,0x5555,0x5555,0x554b
+};
+static unsigned short B[] = {
+0xc095,0x8901,0x8ff3,0x6761,
+0xc0e2,0xf234,0x355b,0xb93e,
+0xc114,0x3d73,0xf890,0x89e5,
+0xc131,0xbc82,0xf994,0xdb51,
+0xc13a,0x4589,0x0219,0xf20b,
+0xc12a,0x0c67,0x5418,0x055e
+};
+static unsigned short C[] = {
+0xc075,0xfd0d,0x1cf3,0x12b2,
+0xc0d0,0xaa0d,0x7b89,0xd757,
+0xc10a,0xeb84,0xb974,0x4c9b,
+0xc131,0x6286,0x7195,0x0043,
+0xc143,0x5255,0x892f,0xf34c,
+0xc13e,0xce4b,0x6a11,0xe14a
+};
+/* log( sqrt( 2*pi ) ) */
+static unsigned short LS2P[] = {
+0x3fed,0x67f1,0xc864,0xbeb5
+};
+#define LS2PI *(double *)LS2P
+#define MAXLGM 2.556348e305
+#endif
+
+
+/* Logarithm of gamma function */
+
+
+double lgam(x)
+double x;
+{
+double p, q, u, w, z;
+int i;
+
+sgngam = 1;
+#ifdef NANS
+if( isnan(x) )
+ return(x);
+#endif
+
+#ifdef INFINITIES
+if( !isfinite(x) )
+ return(INFINITY);
+#endif
+
+if( x < -34.0 )
+ {
+ q = -x;
+ w = lgam(q); /* note this modifies sgngam! */
+ p = floor(q);
+ if( p == q )
+ {
+lgsing:
+#ifdef INFINITIES
+ mtherr( "lgam", SING );
+ return (INFINITY);
+#else
+ goto loverf;
+#endif
+ }
+ i = p;
+ if( (i & 1) == 0 )
+ sgngam = -1;
+ else
+ sgngam = 1;
+ z = q - p;
+ if( z > 0.5 )
+ {
+ p += 1.0;
+ z = p - q;
+ }
+ z = q * sin( PI * z );
+ if( z == 0.0 )
+ goto lgsing;
+/* z = log(PI) - log( z ) - w;*/
+ z = LOGPI - log( z ) - w;
+ return( z );
+ }
+
+if( x < 13.0 )
+ {
+ z = 1.0;
+ p = 0.0;
+ u = x;
+ while( u >= 3.0 )
+ {
+ p -= 1.0;
+ u = x + p;
+ z *= u;
+ }
+ while( u < 2.0 )
+ {
+ if( u == 0.0 )
+ goto lgsing;
+ z /= u;
+ p += 1.0;
+ u = x + p;
+ }
+ if( z < 0.0 )
+ {
+ sgngam = -1;
+ z = -z;
+ }
+ else
+ sgngam = 1;
+ if( u == 2.0 )
+ return( log(z) );
+ p -= 2.0;
+ x = x + p;
+ p = x * polevl( x, B, 5 ) / p1evl( x, C, 6);
+ return( log(z) + p );
+ }
+
+if( x > MAXLGM )
+ {
+#ifdef INFINITIES
+ return( sgngam * INFINITY );
+#else
+loverf:
+ mtherr( "lgam", OVERFLOW );
+ return( sgngam * MAXNUM );
+#endif
+ }
+
+q = ( x - 0.5 ) * log(x) - x + LS2PI;
+if( x > 1.0e8 )
+ return( q );
+
+p = 1.0/(x*x);
+if( x >= 1000.0 )
+ q += (( 7.9365079365079365079365e-4 * p
+ - 2.7777777777777777777778e-3) *p
+ + 0.0833333333333333333333) / x;
+else
+ q += polevl( p, A, 4 ) / x;
+return( q );
+}
diff --git a/libm/double/gdtr.c b/libm/double/gdtr.c
new file mode 100644
index 000000000..6b27d9abb
--- /dev/null
+++ b/libm/double/gdtr.c
@@ -0,0 +1,130 @@
+/* gdtr.c
+ *
+ * Gamma distribution function
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double a, b, x, y, gdtr();
+ *
+ * y = gdtr( 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:
+ *
+ * See igam().
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * gdtr domain x < 0 0.0
+ *
+ */
+ /* gdtrc.c
+ *
+ * Complemented gamma distribution function
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double a, b, x, y, gdtrc();
+ *
+ * y = gdtrc( 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:
+ *
+ * See igamc().
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * gdtrc domain x < 0 0.0
+ *
+ */
+
+/* gdtr() */
+
+
+/*
+Cephes Math Library Release 2.8: June, 2000
+Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier
+*/
+
+#include <math.h>
+#ifdef ANSIPROT
+extern double igam ( double, double );
+extern double igamc ( double, double );
+#else
+double igam(), igamc();
+#endif
+
+double gdtr( a, b, x )
+double a, b, x;
+{
+
+if( x < 0.0 )
+ {
+ mtherr( "gdtr", DOMAIN );
+ return( 0.0 );
+ }
+return( igam( b, a * x ) );
+}
+
+
+
+double gdtrc( a, b, x )
+double a, b, x;
+{
+
+if( x < 0.0 )
+ {
+ mtherr( "gdtrc", DOMAIN );
+ return( 0.0 );
+ }
+return( igamc( b, a * x ) );
+}
diff --git a/libm/double/gels.c b/libm/double/gels.c
new file mode 100644
index 000000000..4d548d050
--- /dev/null
+++ b/libm/double/gels.c
@@ -0,0 +1,232 @@
+/*
+C
+C ..................................................................
+C
+C SUBROUTINE GELS
+C
+C PURPOSE
+C TO SOLVE A SYSTEM OF SIMULTANEOUS LINEAR EQUATIONS WITH
+C SYMMETRIC COEFFICIENT MATRIX UPPER TRIANGULAR PART OF WHICH
+C IS ASSUMED TO BE STORED COLUMNWISE.
+C
+C USAGE
+C CALL GELS(R,A,M,N,EPS,IER,AUX)
+C
+C DESCRIPTION OF PARAMETERS
+C R - M BY N RIGHT HAND SIDE MATRIX. (DESTROYED)
+C ON RETURN R CONTAINS THE SOLUTION OF THE EQUATIONS.
+C A - UPPER TRIANGULAR PART OF THE SYMMETRIC
+C M BY M COEFFICIENT MATRIX. (DESTROYED)
+C M - THE NUMBER OF EQUATIONS IN THE SYSTEM.
+C N - THE NUMBER OF RIGHT HAND SIDE VECTORS.
+C EPS - AN INPUT CONSTANT WHICH IS USED AS RELATIVE
+C TOLERANCE FOR TEST ON LOSS OF SIGNIFICANCE.
+C IER - RESULTING ERROR PARAMETER CODED AS FOLLOWS
+C IER=0 - NO ERROR,
+C IER=-1 - NO RESULT BECAUSE OF M LESS THAN 1 OR
+C PIVOT ELEMENT AT ANY ELIMINATION STEP
+C EQUAL TO 0,
+C IER=K - WARNING DUE TO POSSIBLE LOSS OF SIGNIFI-
+C CANCE INDICATED AT ELIMINATION STEP K+1,
+C WHERE PIVOT ELEMENT WAS LESS THAN OR
+C EQUAL TO THE INTERNAL TOLERANCE EPS TIMES
+C ABSOLUTELY GREATEST MAIN DIAGONAL
+C ELEMENT OF MATRIX A.
+C AUX - AN AUXILIARY STORAGE ARRAY WITH DIMENSION M-1.
+C
+C REMARKS
+C UPPER TRIANGULAR PART OF MATRIX A IS ASSUMED TO BE STORED
+C COLUMNWISE IN M*(M+1)/2 SUCCESSIVE STORAGE LOCATIONS, RIGHT
+C HAND SIDE MATRIX R COLUMNWISE IN N*M SUCCESSIVE STORAGE
+C LOCATIONS. ON RETURN SOLUTION MATRIX R IS STORED COLUMNWISE
+C TOO.
+C THE PROCEDURE GIVES RESULTS IF THE NUMBER OF EQUATIONS M IS
+C GREATER THAN 0 AND PIVOT ELEMENTS AT ALL ELIMINATION STEPS
+C ARE DIFFERENT FROM 0. HOWEVER WARNING IER=K - IF GIVEN -
+C INDICATES POSSIBLE LOSS OF SIGNIFICANCE. IN CASE OF A WELL
+C SCALED MATRIX A AND APPROPRIATE TOLERANCE EPS, IER=K MAY BE
+C INTERPRETED THAT MATRIX A HAS THE RANK K. NO WARNING IS
+C GIVEN IN CASE M=1.
+C ERROR PARAMETER IER=-1 DOES NOT NECESSARILY MEAN THAT
+C MATRIX A IS SINGULAR, AS ONLY MAIN DIAGONAL ELEMENTS
+C ARE USED AS PIVOT ELEMENTS. POSSIBLY SUBROUTINE GELG (WHICH
+C WORKS WITH TOTAL PIVOTING) WOULD BE ABLE TO FIND A SOLUTION.
+C
+C SUBROUTINES AND FUNCTION SUBPROGRAMS REQUIRED
+C NONE
+C
+C METHOD
+C SOLUTION IS DONE BY MEANS OF GAUSS-ELIMINATION WITH
+C PIVOTING IN MAIN DIAGONAL, IN ORDER TO PRESERVE
+C SYMMETRY IN REMAINING COEFFICIENT MATRICES.
+C
+C ..................................................................
+C
+*/
+#include <math.h>
+#ifdef ANSIPROT
+extern double fabs ( double );
+#else
+double fabs();
+#endif
+
+gels( A, R, M, EPS, AUX )
+double A[],R[];
+int M;
+double EPS;
+double AUX[];
+{
+int I, J, K, L, IER;
+int II, LL, LLD, LR, LT, LST, LLST, LEND;
+double tb, piv, tol, pivi;
+
+if( M <= 0 )
+ {
+fatal:
+ IER = -1;
+ goto done;
+ }
+/* SEARCH FOR GREATEST MAIN DIAGONAL ELEMENT */
+
+/* Diagonal elements are at A(i,i) = 1, 3, 6, 10, ...
+ * A(i,j) = A( i(i-1)/2 + j )
+ */
+IER = 0;
+piv = 0.0;
+L = 0;
+for( K=1; K<=M; K++ )
+ {
+ L += K;
+ tb = fabs( A[L-1] );
+ if( tb > piv )
+ {
+ piv = tb;
+ I = L;
+ J = K;
+ }
+ }
+tol = EPS * piv;
+
+/*
+C MAIN DIAGONAL ELEMENT A(I)=A(J,J) IS FIRST PIVOT ELEMENT.
+C PIV CONTAINS THE ABSOLUTE VALUE OF A(I).
+*/
+
+/* START ELIMINATION LOOP */
+LST = 0;
+LEND = M - 1;
+for( K=1; K<=M; K++ )
+ {
+/* TEST ON USEFULNESS OF SYMMETRIC ALGORITHM */
+ if( piv <= 0.0 )
+ goto fatal;
+ if( IER == 0 )
+ {
+ if( piv <= tol )
+ {
+ IER = K - 1;
+ }
+ }
+ LT = J - K;
+ LST += K;
+
+/* PIVOT ROW REDUCTION AND ROW INTERCHANGE IN RIGHT HAND SIDE R */
+ pivi = 1.0 / A[I-1];
+ L = K;
+ LL = L + LT;
+ tb = pivi * R[LL-1];
+ R[LL-1] = R[L-1];
+ R[L-1] = tb;
+/* IS ELIMINATION TERMINATED */
+ if( K >= M )
+ break;
+/*
+C ROW AND COLUMN INTERCHANGE AND PIVOT ROW REDUCTION IN MATRIX A.
+C ELEMENTS OF PIVOT COLUMN ARE SAVED IN AUXILIARY VECTOR AUX.
+*/
+ LR = LST + (LT*(K+J-1))/2;
+ LL = LR;
+ L=LST;
+ for( II=K; II<=LEND; II++ )
+ {
+ L += II;
+ LL += 1;
+ if( L == LR )
+ {
+ A[LL-1] = A[LST-1];
+ tb = A[L-1];
+ goto lab13;
+ }
+ if( L > LR )
+ LL = L + LT;
+
+ tb = A[LL-1];
+ A[LL-1] = A[L-1];
+lab13:
+ AUX[II-1] = tb;
+ A[L-1] = pivi * tb;
+ }
+/* SAVE COLUMN INTERCHANGE INFORMATION */
+ A[LST-1] = LT;
+/* ELEMENT REDUCTION AND SEARCH FOR NEXT PIVOT */
+ piv = 0.0;
+ LLST = LST;
+ LT = 0;
+ for( II=K; II<=LEND; II++ )
+ {
+ pivi = -AUX[II-1];
+ LL = LLST;
+ LT += 1;
+ for( LLD=II; LLD<=LEND; LLD++ )
+ {
+ LL += LLD;
+ L = LL + LT;
+ A[L-1] += pivi * A[LL-1];
+ }
+ LLST += II;
+ LR = LLST + LT;
+ tb =fabs( A[LR-1] );
+ if( tb > piv )
+ {
+ piv = tb;
+ I = LR;
+ J = II + 1;
+ }
+ LR = K;
+ LL = LR + LT;
+ R[LL-1] += pivi * R[LR-1];
+ }
+ }
+/* END OF ELIMINATION LOOP */
+
+/* BACK SUBSTITUTION AND BACK INTERCHANGE */
+
+if( LEND <= 0 )
+ {
+ if( LEND < 0 )
+ goto fatal;
+ goto done;
+ }
+II = M;
+for( I=2; I<=M; I++ )
+ {
+ LST -= II;
+ II -= 1;
+ L = A[LST-1] + 0.5;
+ J = II;
+ tb = R[J-1];
+ LL = J;
+ K = LST;
+ for( LT=II; LT<=LEND; LT++ )
+ {
+ LL += 1;
+ K += LT;
+ tb -= A[K-1] * R[LL-1];
+ }
+ K = J + L;
+ R[J-1] = R[K-1];
+ R[K-1] = tb;
+ }
+done:
+return( IER );
+}
diff --git a/libm/double/hyp2f1.c b/libm/double/hyp2f1.c
new file mode 100644
index 000000000..f2e93106c
--- /dev/null
+++ b/libm/double/hyp2f1.c
@@ -0,0 +1,460 @@
+/* hyp2f1.c
+ *
+ * Gauss hypergeometric function F
+ * 2 1
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double a, b, c, x, y, hyp2f1();
+ *
+ * y = hyp2f1( 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-14 of the nearest integer
+ * (1.0e-13 for IEEE arithmetic).
+ *
+ * ACCURACY:
+ *
+ *
+ * Relative error (-1 < x < 1):
+ * arithmetic domain # trials peak rms
+ * IEEE -1,7 230000 1.2e-11 5.2e-14
+ *
+ * Several special cases also tested with a, b, c in
+ * the range -7 to 7.
+ *
+ * ERROR MESSAGES:
+ *
+ * A "partial loss of precision" message is printed if
+ * the internally estimated relative error exceeds 1^-12.
+ * A "singularity" message is printed on overflow or
+ * in cases not addressed (such as x < -1).
+ */
+
+/* hyp2f1 */
+
+
+/*
+Cephes Math Library Release 2.8: June, 2000
+Copyright 1984, 1987, 1992, 2000 by Stephen L. Moshier
+*/
+
+
+#include <math.h>
+
+#ifdef DEC
+#define EPS 1.0e-14
+#define EPS2 1.0e-11
+#endif
+
+#ifdef IBMPC
+#define EPS 1.0e-13
+#define EPS2 1.0e-10
+#endif
+
+#ifdef MIEEE
+#define EPS 1.0e-13
+#define EPS2 1.0e-10
+#endif
+
+#ifdef UNK
+#define EPS 1.0e-13
+#define EPS2 1.0e-10
+#endif
+
+#define ETHRESH 1.0e-12
+
+#ifdef ANSIPROT
+extern double fabs ( double );
+extern double pow ( double, double );
+extern double round ( double );
+extern double gamma ( double );
+extern double log ( double );
+extern double exp ( double );
+extern double psi ( double );
+static double hyt2f1(double, double, double, double, double *);
+static double hys2f1(double, double, double, double, double *);
+double hyp2f1(double, double, double, double);
+#else
+double fabs(), pow(), round(), gamma(), log(), exp(), psi();
+static double hyt2f1();
+static double hys2f1();
+double hyp2f1();
+#endif
+extern double MAXNUM, MACHEP;
+
+double hyp2f1( a, b, c, x )
+double a, b, c, x;
+{
+double d, d1, d2, e;
+double p, q, r, s, y, ax;
+double ia, ib, ic, id, err;
+int flag, i, aid;
+
+err = 0.0;
+ax = fabs(x);
+s = 1.0 - x;
+flag = 0;
+ia = round(a); /* nearest integer to a */
+ib = round(b);
+
+if( a <= 0 )
+ {
+ if( fabs(a-ia) < EPS ) /* a is a negative integer */
+ flag |= 1;
+ }
+
+if( b <= 0 )
+ {
+ if( fabs(b-ib) < EPS ) /* b is a negative integer */
+ flag |= 2;
+ }
+
+if( ax < 1.0 )
+ {
+ if( fabs(b-c) < EPS ) /* b = c */
+ {
+ y = pow( s, -a ); /* s to the -a power */
+ goto hypdon;
+ }
+ if( fabs(a-c) < EPS ) /* a = c */
+ {
+ y = pow( s, -b ); /* s to the -b power */
+ goto hypdon;
+ }
+ }
+
+
+
+if( c <= 0.0 )
+ {
+ ic = round(c); /* nearest integer to c */
+ if( fabs(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 = round(p); /* nearest integer to c-a */
+if( (ia <= 0.0) && (fabs(p-ia) < EPS) ) /* negative int c - a */
+ flag |= 4;
+
+r = c - b;
+ib = round(r); /* nearest integer to c-b */
+if( (ib <= 0.0) && (fabs(r-ib) < EPS) ) /* negative int c - b */
+ flag |= 8;
+
+d = c - a - b;
+id = round(d); /* nearest integer to d */
+q = fabs(d-id);
+
+/* Thanks to Christian Burger <BURGER@DMRHRZ11.HRZ.Uni-Marburg.DE>
+ * for reporting a bug here. */
+if( fabs(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 = gamma(c)*gamma(d)/(gamma(p)*gamma(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 = hyt2f1( 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 = hyp2f1(a,b,e,x);
+ d1 = hyp2f1(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 = hyt2f1( 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 = pow( s, d ) * hys2f1( c-a, c-b, c, x, &err );
+goto hypdon;
+
+/* The alarm exit */
+hypdiv:
+mtherr( "hyp2f1", OVERFLOW );
+return( MAXNUM );
+}
+
+
+
+
+
+
+/* Apply transformations for |x| near 1
+ * then call the power series
+ */
+static double hyt2f1( a, b, c, x, loss )
+double a, b, c, x;
+double *loss;
+{
+double p, q, r, s, t, y, d, err, err1;
+double ax, id, d1, d2, e, y1;
+int i, aid;
+
+err = 0.0;
+s = 1.0 - x;
+if( x < -0.5 )
+ {
+ if( b > a )
+ y = pow( s, -a ) * hys2f1( a, c-b, c, -x/s, &err );
+
+ else
+ y = pow( s, -b ) * hys2f1( c-a, b, c, -x/s, &err );
+
+ goto done;
+ }
+
+d = c - a - b;
+id = round(d); /* nearest integer to d */
+
+if( x > 0.9 )
+{
+if( fabs(d-id) > EPS ) /* test for integer c-a-b */
+ {
+/* Try the power series first */
+ y = hys2f1( a, b, c, x, &err );
+ if( err < ETHRESH )
+ goto done;
+/* If power series fails, then apply AMS55 #15.3.6 */
+ q = hys2f1( a, b, 1.0-d, s, &err );
+ q *= gamma(d) /(gamma(c-a) * gamma(c-b));
+ r = pow(s,d) * hys2f1( c-a, c-b, d+1.0, s, &err1 );
+ r *= gamma(-d)/(gamma(a) * gamma(b));
+ y = q + r;
+
+ q = fabs(q); /* estimate cancellation error */
+ r = fabs(r);
+ if( q > r )
+ r = q;
+ err += err1 + (MACHEP*r)/y;
+
+ y *= gamma(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 = log(s);
+
+ /* sum for t = 0 */
+ y = psi(1.0) + psi(1.0+e) - psi(a+d1) - psi(b+d1) - ax;
+ y /= gamma(e+1.0);
+
+ p = (a+d1) * (b+d1) * s / gamma(e+2.0); /* Poch for t=1 */
+ t = 1.0;
+ do
+ {
+ r = psi(1.0+t) + psi(1.0+t+e) - psi(a+t+d1)
+ - psi(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( fabs(q/y) > EPS );
+
+
+ if( id == 0.0 )
+ {
+ y *= gamma(c)/(gamma(a)*gamma(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 = gamma(c);
+ y1 *= gamma(e) * p / (gamma(a+d1) * gamma(b+d1));
+
+ y *= p / (gamma(a+d2) * gamma(b+d2));
+ if( (aid & 1) != 0 )
+ y = -y;
+
+ q = pow( 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 = hys2f1( a, b, c, x, &err );
+
+done:
+*loss = err;
+return(y);
+}
+
+
+
+
+
+/* Defining power series expansion of Gauss hypergeometric function */
+
+static double hys2f1( a, b, c, x, loss )
+double a, b, c, x;
+double *loss; /* estimates loss of significance */
+{
+double f, g, h, k, m, s, u, umax;
+int i;
+
+i = 0;
+umax = 0.0;
+f = a;
+g = b;
+h = c;
+s = 1.0;
+u = 1.0;
+k = 0.0;
+do
+ {
+ if( fabs(h) < EPS )
+ {
+ *loss = 1.0;
+ return( MAXNUM );
+ }
+ m = k + 1.0;
+ u = u * ((f+k) * (g+k) * x / ((h+k) * m));
+ s += u;
+ k = fabs(u); /* remember largest term summed */
+ if( k > umax )
+ umax = k;
+ k = m;
+ if( ++i > 10000 ) /* should never happen */
+ {
+ *loss = 1.0;
+ return(s);
+ }
+ }
+while( fabs(u/s) > MACHEP );
+
+/* return estimated relative error */
+*loss = (MACHEP*umax)/fabs(s) + (MACHEP*i);
+
+return(s);
+}
diff --git a/libm/double/hyperg.c b/libm/double/hyperg.c
new file mode 100644
index 000000000..36a3f9781
--- /dev/null
+++ b/libm/double/hyperg.c
@@ -0,0 +1,386 @@
+/* hyperg.c
+ *
+ * Confluent hypergeometric function
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double a, b, x, y, hyperg();
+ *
+ * y = hyperg( 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
+ * DEC 0,30 2000 1.2e-15 1.3e-16
+ qtst1:
+ 21800 max = 1.4200E-14 rms = 1.0841E-15 ave = -5.3640E-17
+ ltstd:
+ 25500 max = 1.2759e-14 rms = 3.7155e-16 ave = 1.5384e-18
+ * IEEE 0,30 30000 1.8e-14 1.1e-15
+ *
+ * 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-12.
+ *
+ */
+
+/* hyperg.c */
+
+
+/*
+Cephes Math Library Release 2.8: June, 2000
+Copyright 1984, 1987, 1988, 2000 by Stephen L. Moshier
+*/
+
+#include <math.h>
+
+#ifdef ANSIPROT
+extern double exp ( double );
+extern double log ( double );
+extern double gamma ( double );
+extern double lgam ( double );
+extern double fabs ( double );
+double hyp2f0 ( double, double, double, int, double * );
+static double hy1f1p(double, double, double, double *);
+static double hy1f1a(double, double, double, double *);
+double hyperg (double, double, double);
+#else
+double exp(), log(), gamma(), lgam(), fabs(), hyp2f0();
+static double hy1f1p();
+static double hy1f1a();
+double hyperg();
+#endif
+extern double MAXNUM, MACHEP;
+
+double hyperg( a, b, x)
+double a, b, x;
+{
+double asum, psum, acanc, pcanc, temp;
+
+/* See if a Kummer transformation will help */
+temp = b - a;
+if( fabs(temp) < 0.001 * fabs(a) )
+ return( exp(x) * hyperg( temp, b, -x ) );
+
+
+psum = hy1f1p( a, b, x, &pcanc );
+if( pcanc < 1.0e-15 )
+ goto done;
+
+
+/* try asymptotic series */
+
+asum = hy1f1a( a, b, x, &acanc );
+
+
+/* Pick the result with less estimated error */
+
+if( acanc < pcanc )
+ {
+ pcanc = acanc;
+ psum = asum;
+ }
+
+done:
+if( pcanc > 1.0e-12 )
+ mtherr( "hyperg", PLOSS );
+
+return( psum );
+}
+
+
+
+
+/* Power series summation for confluent hypergeometric function */
+
+
+static double hy1f1p( a, b, x, err )
+double a, b, x;
+double *err;
+{
+double n, a0, sum, t, u, temp;
+double an, bn, maxt, pcanc;
+
+
+/* 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 > MACHEP )
+ {
+ if( bn == 0 ) /* check bn first since if both */
+ {
+ mtherr( "hyperg", SING );
+ return( MAXNUM ); /* 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 = fabs(u);
+ if( (temp > 1.0 ) && (maxt > (MAXNUM/temp)) )
+ {
+ pcanc = 1.0; /* estimate 100% error */
+ goto blowup;
+ }
+
+ a0 *= u;
+ sum += a0;
+ t = fabs(a0);
+ if( t > maxt )
+ maxt = t;
+/*
+ if( (maxt/fabs(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 /= fabs(sum);
+maxt *= MACHEP; /* this way avoids multiply overflow */
+pcanc = fabs( MACHEP * 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 double hy1f1a( a, b, x, err )
+double a, b, x;
+double *err;
+{
+double h1, h2, t, u, temp, acanc, asum, err1, err2;
+
+if( x == 0 )
+ {
+ acanc = 1.0;
+ asum = MAXNUM;
+ goto adone;
+ }
+temp = log( fabs(x) );
+t = x + temp * (a-b);
+u = -temp * a;
+
+if( b > 0 )
+ {
+ temp = lgam(b);
+ t += temp;
+ u += temp;
+ }
+
+h1 = hyp2f0( a, a-b+1, -1.0/x, 1, &err1 );
+
+temp = exp(u) / gamma(b-a);
+h1 *= temp;
+err1 *= temp;
+
+h2 = hyp2f0( b-a, 1.0-a, 1.0/x, 2, &err2 );
+
+if( a < 0 )
+ temp = exp(t) / gamma(a);
+else
+ temp = exp( t - lgam(a) );
+
+h2 *= temp;
+err2 *= temp;
+
+if( x < 0.0 )
+ asum = h1;
+else
+ asum = h2;
+
+acanc = fabs(err1) + fabs(err2);
+
+
+if( b < 0 )
+ {
+ temp = gamma(b);
+ asum *= temp;
+ acanc *= fabs(temp);
+ }
+
+
+if( asum != 0.0 )
+ acanc /= fabs(asum);
+
+acanc *= 30.0; /* fudge factor, since error of asymptotic formula
+ * often seems this much larger than advertised */
+
+adone:
+
+
+*err = acanc;
+return( asum );
+}
+
+/* hyp2f0() */
+
+double hyp2f0( a, b, x, type, err )
+double a, b, x;
+int type; /* determines what converging factor to use */
+double *err;
+{
+double a0, alast, t, tlast, maxt;
+double n, an, bn, u, sum, temp;
+
+an = a;
+bn = b;
+a0 = 1.0e0;
+alast = 1.0e0;
+sum = 0.0;
+n = 1.0e0;
+t = 1.0e0;
+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 = fabs(u);
+ if( (temp > 1.0 ) && (maxt > (MAXNUM/temp)) )
+ goto error;
+
+ a0 *= u;
+ t = fabs(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.0e0;
+ bn += 1.0e0;
+ n += 1.0e0;
+ if( t > maxt )
+ maxt = t;
+ }
+while( t > MACHEP );
+
+
+pdone: /* series converged! */
+
+/* estimate error due to roundoff and cancellation */
+*err = fabs( MACHEP * (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 = MACHEP * (n + maxt) + fabs ( a0 );
+
+
+done:
+sum += alast;
+return( sum );
+
+/* series blew up: */
+error:
+*err = MAXNUM;
+mtherr( "hyperg", TLOSS );
+return( sum );
+}
diff --git a/libm/double/i0.c b/libm/double/i0.c
new file mode 100644
index 000000000..a4844ab7e
--- /dev/null
+++ b/libm/double/i0.c
@@ -0,0 +1,397 @@
+/* i0.c
+ *
+ * Modified Bessel function of order zero
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, i0();
+ *
+ * y = i0( 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
+ * DEC 0,30 6000 8.2e-17 1.9e-17
+ * IEEE 0,30 30000 5.8e-16 1.4e-16
+ *
+ */
+ /* i0e.c
+ *
+ * Modified Bessel function of order zero,
+ * exponentially scaled
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, i0e();
+ *
+ * y = i0e( 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 30000 5.4e-16 1.2e-16
+ * See i0().
+ *
+ */
+
+/* i0.c */
+
+
+/*
+Cephes Math Library Release 2.8: June, 2000
+Copyright 1984, 1987, 2000 by Stephen L. Moshier
+*/
+
+#include <math.h>
+
+/* Chebyshev coefficients for exp(-x) I0(x)
+ * in the interval [0,8].
+ *
+ * lim(x->0){ exp(-x) I0(x) } = 1.
+ */
+
+#ifdef UNK
+static double A[] =
+{
+-4.41534164647933937950E-18,
+ 3.33079451882223809783E-17,
+-2.43127984654795469359E-16,
+ 1.71539128555513303061E-15,
+-1.16853328779934516808E-14,
+ 7.67618549860493561688E-14,
+-4.85644678311192946090E-13,
+ 2.95505266312963983461E-12,
+-1.72682629144155570723E-11,
+ 9.67580903537323691224E-11,
+-5.18979560163526290666E-10,
+ 2.65982372468238665035E-9,
+-1.30002500998624804212E-8,
+ 6.04699502254191894932E-8,
+-2.67079385394061173391E-7,
+ 1.11738753912010371815E-6,
+-4.41673835845875056359E-6,
+ 1.64484480707288970893E-5,
+-5.75419501008210370398E-5,
+ 1.88502885095841655729E-4,
+-5.76375574538582365885E-4,
+ 1.63947561694133579842E-3,
+-4.32430999505057594430E-3,
+ 1.05464603945949983183E-2,
+-2.37374148058994688156E-2,
+ 4.93052842396707084878E-2,
+-9.49010970480476444210E-2,
+ 1.71620901522208775349E-1,
+-3.04682672343198398683E-1,
+ 6.76795274409476084995E-1
+};
+#endif
+
+#ifdef DEC
+static unsigned short A[] = {
+0121642,0162671,0004646,0103567,
+0022431,0115424,0135755,0026104,
+0123214,0023533,0110365,0156635,
+0023767,0033304,0117662,0172716,
+0124522,0100426,0012277,0157531,
+0025254,0155062,0054461,0030465,
+0126010,0131143,0013560,0153604,
+0026517,0170577,0006336,0114437,
+0127227,0162253,0152243,0052734,
+0027724,0142766,0061641,0160200,
+0130416,0123760,0116564,0125262,
+0031066,0144035,0021246,0054641,
+0131537,0053664,0060131,0102530,
+0032201,0155664,0165153,0020652,
+0132617,0061434,0074423,0176145,
+0033225,0174444,0136147,0122542,
+0133624,0031576,0056453,0020470,
+0034211,0175305,0172321,0041314,
+0134561,0054462,0147040,0165315,
+0035105,0124333,0120203,0162532,
+0135427,0013750,0174257,0055221,
+0035726,0161654,0050220,0100162,
+0136215,0131361,0000325,0041110,
+0036454,0145417,0117357,0017352,
+0136702,0072367,0104415,0133574,
+0037111,0172126,0072505,0014544,
+0137302,0055601,0120550,0033523,
+0037457,0136543,0136544,0043002,
+0137633,0177536,0001276,0066150,
+0040055,0041164,0100655,0010521
+};
+#endif
+
+#ifdef IBMPC
+static unsigned short A[] = {
+0xd0ef,0x2134,0x5cb7,0xbc54,
+0xa589,0x977d,0x3362,0x3c83,
+0xbbb4,0x721e,0x84eb,0xbcb1,
+0x5eba,0x93f6,0xe6d8,0x3cde,
+0xfbeb,0xc297,0x5022,0xbd0a,
+0x2627,0x4b26,0x9b46,0x3d35,
+0x1af0,0x62ee,0x164c,0xbd61,
+0xd324,0xe19b,0xfe2f,0x3d89,
+0x6abc,0x7a94,0xfc95,0xbdb2,
+0x3c10,0xcc74,0x98be,0x3dda,
+0x9556,0x13ae,0xd4fe,0xbe01,
+0xcb34,0xa454,0xd903,0x3e26,
+0x30ab,0x8c0b,0xeaf6,0xbe4b,
+0x6435,0x9d4d,0x3b76,0x3e70,
+0x7f8d,0x8f22,0xec63,0xbe91,
+0xf4ac,0x978c,0xbf24,0x3eb2,
+0x6427,0xcba5,0x866f,0xbed2,
+0x2859,0xbe9a,0x3f58,0x3ef1,
+0x1d5a,0x59c4,0x2b26,0xbf0e,
+0x7cab,0x7410,0xb51b,0x3f28,
+0xeb52,0x1f15,0xe2fd,0xbf42,
+0x100e,0x8a12,0xdc75,0x3f5a,
+0xa849,0x201a,0xb65e,0xbf71,
+0xe3dd,0xf3dd,0x9961,0x3f85,
+0xb6f0,0xf121,0x4e9e,0xbf98,
+0xa32d,0xcea8,0x3e8a,0x3fa9,
+0x06ea,0x342d,0x4b70,0xbfb8,
+0x88c0,0x77ac,0xf7ac,0x3fc5,
+0xcd8d,0xc057,0x7feb,0xbfd3,
+0xa22a,0x9035,0xa84e,0x3fe5,
+};
+#endif
+
+#ifdef MIEEE
+static unsigned short A[] = {
+0xbc54,0x5cb7,0x2134,0xd0ef,
+0x3c83,0x3362,0x977d,0xa589,
+0xbcb1,0x84eb,0x721e,0xbbb4,
+0x3cde,0xe6d8,0x93f6,0x5eba,
+0xbd0a,0x5022,0xc297,0xfbeb,
+0x3d35,0x9b46,0x4b26,0x2627,
+0xbd61,0x164c,0x62ee,0x1af0,
+0x3d89,0xfe2f,0xe19b,0xd324,
+0xbdb2,0xfc95,0x7a94,0x6abc,
+0x3dda,0x98be,0xcc74,0x3c10,
+0xbe01,0xd4fe,0x13ae,0x9556,
+0x3e26,0xd903,0xa454,0xcb34,
+0xbe4b,0xeaf6,0x8c0b,0x30ab,
+0x3e70,0x3b76,0x9d4d,0x6435,
+0xbe91,0xec63,0x8f22,0x7f8d,
+0x3eb2,0xbf24,0x978c,0xf4ac,
+0xbed2,0x866f,0xcba5,0x6427,
+0x3ef1,0x3f58,0xbe9a,0x2859,
+0xbf0e,0x2b26,0x59c4,0x1d5a,
+0x3f28,0xb51b,0x7410,0x7cab,
+0xbf42,0xe2fd,0x1f15,0xeb52,
+0x3f5a,0xdc75,0x8a12,0x100e,
+0xbf71,0xb65e,0x201a,0xa849,
+0x3f85,0x9961,0xf3dd,0xe3dd,
+0xbf98,0x4e9e,0xf121,0xb6f0,
+0x3fa9,0x3e8a,0xcea8,0xa32d,
+0xbfb8,0x4b70,0x342d,0x06ea,
+0x3fc5,0xf7ac,0x77ac,0x88c0,
+0xbfd3,0x7feb,0xc057,0xcd8d,
+0x3fe5,0xa84e,0x9035,0xa22a
+};
+#endif
+
+
+/* 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).
+ */
+
+#ifdef UNK
+static double B[] =
+{
+-7.23318048787475395456E-18,
+-4.83050448594418207126E-18,
+ 4.46562142029675999901E-17,
+ 3.46122286769746109310E-17,
+-2.82762398051658348494E-16,
+-3.42548561967721913462E-16,
+ 1.77256013305652638360E-15,
+ 3.81168066935262242075E-15,
+-9.55484669882830764870E-15,
+-4.15056934728722208663E-14,
+ 1.54008621752140982691E-14,
+ 3.85277838274214270114E-13,
+ 7.18012445138366623367E-13,
+-1.79417853150680611778E-12,
+-1.32158118404477131188E-11,
+-3.14991652796324136454E-11,
+ 1.18891471078464383424E-11,
+ 4.94060238822496958910E-10,
+ 3.39623202570838634515E-9,
+ 2.26666899049817806459E-8,
+ 2.04891858946906374183E-7,
+ 2.89137052083475648297E-6,
+ 6.88975834691682398426E-5,
+ 3.36911647825569408990E-3,
+ 8.04490411014108831608E-1
+};
+#endif
+
+#ifdef DEC
+static unsigned short B[] = {
+0122005,0066672,0123124,0054311,
+0121662,0033323,0030214,0104602,
+0022515,0170300,0113314,0020413,
+0022437,0117350,0035402,0007146,
+0123243,0000135,0057220,0177435,
+0123305,0073476,0144106,0170702,
+0023777,0071755,0017527,0154373,
+0024211,0052214,0102247,0033270,
+0124454,0017763,0171453,0012322,
+0125072,0166316,0075505,0154616,
+0024612,0133770,0065376,0025045,
+0025730,0162143,0056036,0001632,
+0026112,0015077,0150464,0063542,
+0126374,0101030,0014274,0065457,
+0127150,0077271,0125763,0157617,
+0127412,0104350,0040713,0120445,
+0027121,0023765,0057500,0001165,
+0030407,0147146,0003643,0075644,
+0031151,0061445,0044422,0156065,
+0031702,0132224,0003266,0125551,
+0032534,0000076,0147153,0005555,
+0033502,0004536,0004016,0026055,
+0034620,0076433,0142314,0171215,
+0036134,0146145,0013454,0101104,
+0040115,0171425,0062500,0047133
+};
+#endif
+
+#ifdef IBMPC
+static unsigned short B[] = {
+0x8b19,0x54ca,0xadb7,0xbc60,
+0x9130,0x6611,0x46da,0xbc56,
+0x8421,0x12d9,0xbe18,0x3c89,
+0x41cd,0x0760,0xf3dd,0x3c83,
+0x1fe4,0xabd2,0x600b,0xbcb4,
+0xde38,0xd908,0xaee7,0xbcb8,
+0xfb1f,0xa3ea,0xee7d,0x3cdf,
+0xe6d7,0x9094,0x2a91,0x3cf1,
+0x629a,0x7e65,0x83fe,0xbd05,
+0xbb32,0xcf68,0x5d99,0xbd27,
+0xc545,0x0d5f,0x56ff,0x3d11,
+0xc073,0x6b83,0x1c8c,0x3d5b,
+0x8cec,0xfa26,0x4347,0x3d69,
+0x8d66,0x0317,0x9043,0xbd7f,
+0x7bf2,0x357e,0x0fd7,0xbdad,
+0x7425,0x0839,0x511d,0xbdc1,
+0x004f,0xabe8,0x24fe,0x3daa,
+0x6f75,0xc0f4,0xf9cc,0x3e00,
+0x5b87,0xa922,0x2c64,0x3e2d,
+0xd56d,0x80d6,0x5692,0x3e58,
+0x616e,0xd9cd,0x8007,0x3e8b,
+0xc586,0xc101,0x412b,0x3ec8,
+0x9e52,0x7899,0x0fa3,0x3f12,
+0x9049,0xa2e5,0x998c,0x3f6b,
+0x09cb,0xaca8,0xbe62,0x3fe9
+};
+#endif
+
+#ifdef MIEEE
+static unsigned short B[] = {
+0xbc60,0xadb7,0x54ca,0x8b19,
+0xbc56,0x46da,0x6611,0x9130,
+0x3c89,0xbe18,0x12d9,0x8421,
+0x3c83,0xf3dd,0x0760,0x41cd,
+0xbcb4,0x600b,0xabd2,0x1fe4,
+0xbcb8,0xaee7,0xd908,0xde38,
+0x3cdf,0xee7d,0xa3ea,0xfb1f,
+0x3cf1,0x2a91,0x9094,0xe6d7,
+0xbd05,0x83fe,0x7e65,0x629a,
+0xbd27,0x5d99,0xcf68,0xbb32,
+0x3d11,0x56ff,0x0d5f,0xc545,
+0x3d5b,0x1c8c,0x6b83,0xc073,
+0x3d69,0x4347,0xfa26,0x8cec,
+0xbd7f,0x9043,0x0317,0x8d66,
+0xbdad,0x0fd7,0x357e,0x7bf2,
+0xbdc1,0x511d,0x0839,0x7425,
+0x3daa,0x24fe,0xabe8,0x004f,
+0x3e00,0xf9cc,0xc0f4,0x6f75,
+0x3e2d,0x2c64,0xa922,0x5b87,
+0x3e58,0x5692,0x80d6,0xd56d,
+0x3e8b,0x8007,0xd9cd,0x616e,
+0x3ec8,0x412b,0xc101,0xc586,
+0x3f12,0x0fa3,0x7899,0x9e52,
+0x3f6b,0x998c,0xa2e5,0x9049,
+0x3fe9,0xbe62,0xaca8,0x09cb
+};
+#endif
+
+#ifdef ANSIPROT
+extern double chbevl ( double, void *, int );
+extern double exp ( double );
+extern double sqrt ( double );
+#else
+double chbevl(), exp(), sqrt();
+#endif
+
+double i0(x)
+double x;
+{
+double y;
+
+if( x < 0 )
+ x = -x;
+if( x <= 8.0 )
+ {
+ y = (x/2.0) - 2.0;
+ return( exp(x) * chbevl( y, A, 30 ) );
+ }
+
+return( exp(x) * chbevl( 32.0/x - 2.0, B, 25 ) / sqrt(x) );
+
+}
+
+
+
+
+double i0e( x )
+double x;
+{
+double y;
+
+if( x < 0 )
+ x = -x;
+if( x <= 8.0 )
+ {
+ y = (x/2.0) - 2.0;
+ return( chbevl( y, A, 30 ) );
+ }
+
+return( chbevl( 32.0/x - 2.0, B, 25 ) / sqrt(x) );
+
+}
diff --git a/libm/double/i1.c b/libm/double/i1.c
new file mode 100644
index 000000000..dfde216dc
--- /dev/null
+++ b/libm/double/i1.c
@@ -0,0 +1,402 @@
+/* i1.c
+ *
+ * Modified Bessel function of order one
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, i1();
+ *
+ * y = i1( 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
+ * DEC 0, 30 3400 1.2e-16 2.3e-17
+ * IEEE 0, 30 30000 1.9e-15 2.1e-16
+ *
+ *
+ */
+ /* i1e.c
+ *
+ * Modified Bessel function of order one,
+ * exponentially scaled
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, i1e();
+ *
+ * y = i1e( 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 2.0e-15 2.0e-16
+ * See i1().
+ *
+ */
+
+/* i1.c 2 */
+
+
+/*
+Cephes Math Library Release 2.8: June, 2000
+Copyright 1985, 1987, 2000 by Stephen L. Moshier
+*/
+
+#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.
+ */
+
+#ifdef UNK
+static double A[] =
+{
+ 2.77791411276104639959E-18,
+-2.11142121435816608115E-17,
+ 1.55363195773620046921E-16,
+-1.10559694773538630805E-15,
+ 7.60068429473540693410E-15,
+-5.04218550472791168711E-14,
+ 3.22379336594557470981E-13,
+-1.98397439776494371520E-12,
+ 1.17361862988909016308E-11,
+-6.66348972350202774223E-11,
+ 3.62559028155211703701E-10,
+-1.88724975172282928790E-9,
+ 9.38153738649577178388E-9,
+-4.44505912879632808065E-8,
+ 2.00329475355213526229E-7,
+-8.56872026469545474066E-7,
+ 3.47025130813767847674E-6,
+-1.32731636560394358279E-5,
+ 4.78156510755005422638E-5,
+-1.61760815825896745588E-4,
+ 5.12285956168575772895E-4,
+-1.51357245063125314899E-3,
+ 4.15642294431288815669E-3,
+-1.05640848946261981558E-2,
+ 2.47264490306265168283E-2,
+-5.29459812080949914269E-2,
+ 1.02643658689847095384E-1,
+-1.76416518357834055153E-1,
+ 2.52587186443633654823E-1
+};
+#endif
+
+#ifdef DEC
+static unsigned short A[] = {
+0021514,0174520,0060742,0000241,
+0122302,0137206,0016120,0025663,
+0023063,0017437,0026235,0176536,
+0123637,0052523,0170150,0125632,
+0024410,0165770,0030251,0044134,
+0125143,0012160,0162170,0054727,
+0025665,0075702,0035716,0145247,
+0126413,0116032,0176670,0015462,
+0027116,0073425,0110351,0105242,
+0127622,0104034,0137530,0037364,
+0030307,0050645,0120776,0175535,
+0131001,0130331,0043523,0037455,
+0031441,0026160,0010712,0100174,
+0132076,0164761,0022706,0017500,
+0032527,0015045,0115076,0104076,
+0133146,0001714,0015434,0144520,
+0033550,0161166,0124215,0077050,
+0134136,0127715,0143365,0157170,
+0034510,0106652,0013070,0064130,
+0135051,0117126,0117264,0123761,
+0035406,0045355,0133066,0175751,
+0135706,0061420,0054746,0122440,
+0036210,0031232,0047235,0006640,
+0136455,0012373,0144235,0011523,
+0036712,0107437,0036731,0015111,
+0137130,0156742,0115744,0172743,
+0037322,0033326,0124667,0124740,
+0137464,0123210,0021510,0144556,
+0037601,0051433,0111123,0177721
+};
+#endif
+
+#ifdef IBMPC
+static unsigned short A[] = {
+0x4014,0x0c3c,0x9f2a,0x3c49,
+0x0576,0xc38a,0x57d0,0xbc78,
+0xbfac,0xe593,0x63e3,0x3ca6,
+0x1573,0x7e0d,0xeaaa,0xbcd3,
+0x290c,0x0615,0x1d7f,0x3d01,
+0x0b3b,0x1c8f,0x628e,0xbd2c,
+0xd955,0x4779,0xaf78,0x3d56,
+0x0366,0x5fb7,0x7383,0xbd81,
+0x3154,0xb21d,0xcee2,0x3da9,
+0x07de,0x97eb,0x5103,0xbdd2,
+0xdf6c,0xb43f,0xea34,0x3df8,
+0x67e6,0x28ea,0x361b,0xbe20,
+0x5010,0x0239,0x258e,0x3e44,
+0xc3e8,0x24b8,0xdd3e,0xbe67,
+0xd108,0xb347,0xe344,0x3e8a,
+0x992a,0x8363,0xc079,0xbeac,
+0xafc5,0xd511,0x1c4e,0x3ecd,
+0xbbcf,0xb8de,0xd5f9,0xbeeb,
+0x0d0b,0x42c7,0x11b5,0x3f09,
+0x94fe,0xd3d6,0x33ca,0xbf25,
+0xdf7d,0xb6c6,0xc95d,0x3f40,
+0xd4a4,0x0b3c,0xcc62,0xbf58,
+0xa1b4,0x49d3,0x0653,0x3f71,
+0xa26a,0x7913,0xa29f,0xbf85,
+0x2349,0xe7bb,0x51e3,0x3f99,
+0x9ebc,0x537c,0x1bbc,0xbfab,
+0xf53c,0xd536,0x46da,0x3fba,
+0x192e,0x0469,0x94d1,0xbfc6,
+0x7ffa,0x724a,0x2a63,0x3fd0
+};
+#endif
+
+#ifdef MIEEE
+static unsigned short A[] = {
+0x3c49,0x9f2a,0x0c3c,0x4014,
+0xbc78,0x57d0,0xc38a,0x0576,
+0x3ca6,0x63e3,0xe593,0xbfac,
+0xbcd3,0xeaaa,0x7e0d,0x1573,
+0x3d01,0x1d7f,0x0615,0x290c,
+0xbd2c,0x628e,0x1c8f,0x0b3b,
+0x3d56,0xaf78,0x4779,0xd955,
+0xbd81,0x7383,0x5fb7,0x0366,
+0x3da9,0xcee2,0xb21d,0x3154,
+0xbdd2,0x5103,0x97eb,0x07de,
+0x3df8,0xea34,0xb43f,0xdf6c,
+0xbe20,0x361b,0x28ea,0x67e6,
+0x3e44,0x258e,0x0239,0x5010,
+0xbe67,0xdd3e,0x24b8,0xc3e8,
+0x3e8a,0xe344,0xb347,0xd108,
+0xbeac,0xc079,0x8363,0x992a,
+0x3ecd,0x1c4e,0xd511,0xafc5,
+0xbeeb,0xd5f9,0xb8de,0xbbcf,
+0x3f09,0x11b5,0x42c7,0x0d0b,
+0xbf25,0x33ca,0xd3d6,0x94fe,
+0x3f40,0xc95d,0xb6c6,0xdf7d,
+0xbf58,0xcc62,0x0b3c,0xd4a4,
+0x3f71,0x0653,0x49d3,0xa1b4,
+0xbf85,0xa29f,0x7913,0xa26a,
+0x3f99,0x51e3,0xe7bb,0x2349,
+0xbfab,0x1bbc,0x537c,0x9ebc,
+0x3fba,0x46da,0xd536,0xf53c,
+0xbfc6,0x94d1,0x0469,0x192e,
+0x3fd0,0x2a63,0x724a,0x7ffa
+};
+#endif
+
+/* i1.c */
+
+/* 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).
+ */
+
+#ifdef UNK
+static double B[] =
+{
+ 7.51729631084210481353E-18,
+ 4.41434832307170791151E-18,
+-4.65030536848935832153E-17,
+-3.20952592199342395980E-17,
+ 2.96262899764595013876E-16,
+ 3.30820231092092828324E-16,
+-1.88035477551078244854E-15,
+-3.81440307243700780478E-15,
+ 1.04202769841288027642E-14,
+ 4.27244001671195135429E-14,
+-2.10154184277266431302E-14,
+-4.08355111109219731823E-13,
+-7.19855177624590851209E-13,
+ 2.03562854414708950722E-12,
+ 1.41258074366137813316E-11,
+ 3.25260358301548823856E-11,
+-1.89749581235054123450E-11,
+-5.58974346219658380687E-10,
+-3.83538038596423702205E-9,
+-2.63146884688951950684E-8,
+-2.51223623787020892529E-7,
+-3.88256480887769039346E-6,
+-1.10588938762623716291E-4,
+-9.76109749136146840777E-3,
+ 7.78576235018280120474E-1
+};
+#endif
+
+#ifdef DEC
+static unsigned short B[] = {
+0022012,0125555,0115227,0043456,
+0021642,0156127,0052075,0145203,
+0122526,0072435,0111231,0011664,
+0122424,0001544,0161671,0114403,
+0023252,0144257,0163532,0142121,
+0023276,0132162,0174045,0013204,
+0124007,0077154,0057046,0110517,
+0124211,0066650,0116127,0157073,
+0024473,0133413,0130551,0107504,
+0025100,0064741,0032631,0040364,
+0124675,0045101,0071551,0012400,
+0125745,0161054,0071637,0011247,
+0126112,0117410,0035525,0122231,
+0026417,0037237,0131034,0176427,
+0027170,0100373,0024742,0025725,
+0027417,0006417,0105303,0141446,
+0127246,0163716,0121202,0060137,
+0130431,0123122,0120436,0166000,
+0131203,0144134,0153251,0124500,
+0131742,0005234,0122732,0033006,
+0132606,0157751,0072362,0121031,
+0133602,0043372,0047120,0015626,
+0134747,0165774,0001125,0046462,
+0136437,0166402,0117746,0155137,
+0040107,0050305,0125330,0124241
+};
+#endif
+
+#ifdef IBMPC
+static unsigned short B[] = {
+0xe8e6,0xb352,0x556d,0x3c61,
+0xb950,0xea87,0x5b8a,0x3c54,
+0x2277,0xb253,0xcea3,0xbc8a,
+0x3320,0x9c77,0x806c,0xbc82,
+0x588a,0xfceb,0x5915,0x3cb5,
+0xa2d1,0x5f04,0xd68e,0x3cb7,
+0xd22a,0x8bc4,0xefcd,0xbce0,
+0xfbc7,0x138a,0x2db5,0xbcf1,
+0x31e8,0x762d,0x76e1,0x3d07,
+0x281e,0x26b3,0x0d3c,0x3d28,
+0x22a0,0x2e6d,0xa948,0xbd17,
+0xe255,0x8e73,0xbc45,0xbd5c,
+0xb493,0x076a,0x53e1,0xbd69,
+0x9fa3,0xf643,0xe7d3,0x3d81,
+0x457b,0x653c,0x101f,0x3daf,
+0x7865,0xf158,0xe1a1,0x3dc1,
+0x4c0c,0xd450,0xdcf9,0xbdb4,
+0xdd80,0x5423,0x34ca,0xbe03,
+0x3528,0x9ad5,0x790b,0xbe30,
+0x46c1,0x94bb,0x4153,0xbe5c,
+0x5443,0x2e9e,0xdbfd,0xbe90,
+0x0373,0x49ca,0x48df,0xbed0,
+0xa9a6,0x804a,0xfd7f,0xbf1c,
+0xdb4c,0x53fc,0xfda0,0xbf83,
+0x1514,0xb55b,0xea18,0x3fe8
+};
+#endif
+
+#ifdef MIEEE
+static unsigned short B[] = {
+0x3c61,0x556d,0xb352,0xe8e6,
+0x3c54,0x5b8a,0xea87,0xb950,
+0xbc8a,0xcea3,0xb253,0x2277,
+0xbc82,0x806c,0x9c77,0x3320,
+0x3cb5,0x5915,0xfceb,0x588a,
+0x3cb7,0xd68e,0x5f04,0xa2d1,
+0xbce0,0xefcd,0x8bc4,0xd22a,
+0xbcf1,0x2db5,0x138a,0xfbc7,
+0x3d07,0x76e1,0x762d,0x31e8,
+0x3d28,0x0d3c,0x26b3,0x281e,
+0xbd17,0xa948,0x2e6d,0x22a0,
+0xbd5c,0xbc45,0x8e73,0xe255,
+0xbd69,0x53e1,0x076a,0xb493,
+0x3d81,0xe7d3,0xf643,0x9fa3,
+0x3daf,0x101f,0x653c,0x457b,
+0x3dc1,0xe1a1,0xf158,0x7865,
+0xbdb4,0xdcf9,0xd450,0x4c0c,
+0xbe03,0x34ca,0x5423,0xdd80,
+0xbe30,0x790b,0x9ad5,0x3528,
+0xbe5c,0x4153,0x94bb,0x46c1,
+0xbe90,0xdbfd,0x2e9e,0x5443,
+0xbed0,0x48df,0x49ca,0x0373,
+0xbf1c,0xfd7f,0x804a,0xa9a6,
+0xbf83,0xfda0,0x53fc,0xdb4c,
+0x3fe8,0xea18,0xb55b,0x1514
+};
+#endif
+
+/* i1.c */
+#ifdef ANSIPROT
+extern double chbevl ( double, void *, int );
+extern double exp ( double );
+extern double sqrt ( double );
+extern double fabs ( double );
+#else
+double chbevl(), exp(), sqrt(), fabs();
+#endif
+
+double i1(x)
+double x;
+{
+double y, z;
+
+z = fabs(x);
+if( z <= 8.0 )
+ {
+ y = (z/2.0) - 2.0;
+ z = chbevl( y, A, 29 ) * z * exp(z);
+ }
+else
+ {
+ z = exp(z) * chbevl( 32.0/z - 2.0, B, 25 ) / sqrt(z);
+ }
+if( x < 0.0 )
+ z = -z;
+return( z );
+}
+
+/* i1e() */
+
+double i1e( x )
+double x;
+{
+double y, z;
+
+z = fabs(x);
+if( z <= 8.0 )
+ {
+ y = (z/2.0) - 2.0;
+ z = chbevl( y, A, 29 ) * z;
+ }
+else
+ {
+ z = chbevl( 32.0/z - 2.0, B, 25 ) / sqrt(z);
+ }
+if( x < 0.0 )
+ z = -z;
+return( z );
+}
diff --git a/libm/double/igam.c b/libm/double/igam.c
new file mode 100644
index 000000000..a1d0bab36
--- /dev/null
+++ b/libm/double/igam.c
@@ -0,0 +1,210 @@
+/* igam.c
+ *
+ * Incomplete gamma integral
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double a, x, y, igam();
+ *
+ * y = igam( 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 200000 3.6e-14 2.9e-15
+ * IEEE 0,100 300000 9.9e-14 1.5e-14
+ */
+ /* igamc()
+ *
+ * Complemented incomplete gamma integral
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double a, x, y, igamc();
+ *
+ * y = igamc( 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:
+ *
+ * Tested at random a, x.
+ * a x Relative error:
+ * arithmetic domain domain # trials peak rms
+ * IEEE 0.5,100 0,100 200000 1.9e-14 1.7e-15
+ * IEEE 0.01,0.5 0,100 200000 1.4e-13 1.6e-15
+ */
+
+/*
+Cephes Math Library Release 2.8: June, 2000
+Copyright 1985, 1987, 2000 by Stephen L. Moshier
+*/
+
+#include <math.h>
+#ifdef ANSIPROT
+extern double lgam ( double );
+extern double exp ( double );
+extern double log ( double );
+extern double fabs ( double );
+extern double igam ( double, double );
+extern double igamc ( double, double );
+#else
+double lgam(), exp(), log(), fabs(), igam(), igamc();
+#endif
+
+extern double MACHEP, MAXLOG;
+static double big = 4.503599627370496e15;
+static double biginv = 2.22044604925031308085e-16;
+
+double igamc( a, x )
+double a, x;
+{
+double ans, ax, c, yc, r, t, y, z;
+double pk, pkm1, pkm2, qk, qkm1, qkm2;
+
+if( (x <= 0) || ( a <= 0) )
+ return( 1.0 );
+
+if( (x < 1.0) || (x < a) )
+ return( 1.0 - igam(a,x) );
+
+ax = a * log(x) - x - lgam(a);
+if( ax < -MAXLOG )
+ {
+ mtherr( "igamc", UNDERFLOW );
+ return( 0.0 );
+ }
+ax = exp(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 = fabs( (ans - r)/r );
+ ans = r;
+ }
+ else
+ t = 1.0;
+ pkm2 = pkm1;
+ pkm1 = pk;
+ qkm2 = qkm1;
+ qkm1 = qk;
+ if( fabs(pk) > big )
+ {
+ pkm2 *= biginv;
+ pkm1 *= biginv;
+ qkm2 *= biginv;
+ qkm1 *= biginv;
+ }
+ }
+while( t > MACHEP );
+
+return( ans * ax );
+}
+
+
+
+/* left tail of incomplete gamma function:
+ *
+ * inf. k
+ * a -x - x
+ * x e > ----------
+ * - -
+ * k=0 | (a+k+1)
+ *
+ */
+
+double igam( a, x )
+double a, x;
+{
+double ans, ax, c, r;
+
+if( (x <= 0) || ( a <= 0) )
+ return( 0.0 );
+
+if( (x > 1.0) && (x > a ) )
+ return( 1.0 - igamc(a,x) );
+
+/* Compute x**a * exp(-x) / gamma(a) */
+ax = a * log(x) - x - lgam(a);
+if( ax < -MAXLOG )
+ {
+ mtherr( "igam", UNDERFLOW );
+ return( 0.0 );
+ }
+ax = exp(ax);
+
+/* power series */
+r = a;
+c = 1.0;
+ans = 1.0;
+
+do
+ {
+ r += 1.0;
+ c *= x/r;
+ ans += c;
+ }
+while( c/ans > MACHEP );
+
+return( ans * ax/a );
+}
diff --git a/libm/double/igami.c b/libm/double/igami.c
new file mode 100644
index 000000000..e93ba2a14
--- /dev/null
+++ b/libm/double/igami.c
@@ -0,0 +1,187 @@
+/* igami()
+ *
+ * Inverse of complemented imcomplete gamma integral
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double a, x, p, igami();
+ *
+ * x = igami( a, p );
+ *
+ * DESCRIPTION:
+ *
+ * Given p, the function finds x such that
+ *
+ * igamc( a, x ) = p.
+ *
+ * Starting with the approximate value
+ *
+ * 3
+ * x = a t
+ *
+ * where
+ *
+ * t = 1 - d - ndtri(p) sqrt(d)
+ *
+ * and
+ *
+ * d = 1/9a,
+ *
+ * the routine performs up to 10 Newton iterations to find the
+ * root of igamc(a,x) - p = 0.
+ *
+ * ACCURACY:
+ *
+ * Tested at random a, p in the intervals indicated.
+ *
+ * a p Relative error:
+ * arithmetic domain domain # trials peak rms
+ * IEEE 0.5,100 0,0.5 100000 1.0e-14 1.7e-15
+ * IEEE 0.01,0.5 0,0.5 100000 9.0e-14 3.4e-15
+ * IEEE 0.5,10000 0,0.5 20000 2.3e-13 3.8e-14
+ */
+
+/*
+Cephes Math Library Release 2.8: June, 2000
+Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier
+*/
+
+#include <math.h>
+
+extern double MACHEP, MAXNUM, MAXLOG, MINLOG;
+#ifdef ANSIPROT
+extern double igamc ( double, double );
+extern double ndtri ( double );
+extern double exp ( double );
+extern double fabs ( double );
+extern double log ( double );
+extern double sqrt ( double );
+extern double lgam ( double );
+#else
+double igamc(), ndtri(), exp(), fabs(), log(), sqrt(), lgam();
+#endif
+
+double igami( a, y0 )
+double a, y0;
+{
+double x0, x1, x, yl, yh, y, d, lgm, dithresh;
+int i, dir;
+
+/* bound the solution */
+x0 = MAXNUM;
+yl = 0;
+x1 = 0;
+yh = 1.0;
+dithresh = 5.0 * MACHEP;
+
+/* approximation to inverse function */
+d = 1.0/(9.0*a);
+y = ( 1.0 - d - ndtri(y0) * sqrt(d) );
+x = a * y * y * y;
+
+lgm = lgam(a);
+
+for( i=0; i<10; i++ )
+ {
+ if( x > x0 || x < x1 )
+ goto ihalve;
+ y = igamc(a,x);
+ if( y < yl || y > yh )
+ goto ihalve;
+ if( y < y0 )
+ {
+ x0 = x;
+ yl = y;
+ }
+ else
+ {
+ x1 = x;
+ yh = y;
+ }
+/* compute the derivative of the function at this point */
+ d = (a - 1.0) * log(x) - x - lgm;
+ if( d < -MAXLOG )
+ goto ihalve;
+ d = -exp(d);
+/* compute the step to the next approximation of x */
+ d = (y - y0)/d;
+ if( fabs(d/x) < MACHEP )
+ goto done;
+ x = x - d;
+ }
+
+/* Resort to interval halving if Newton iteration did not converge. */
+ihalve:
+
+d = 0.0625;
+if( x0 == MAXNUM )
+ {
+ if( x <= 0.0 )
+ x = 1.0;
+ while( x0 == MAXNUM )
+ {
+ x = (1.0 + d) * x;
+ y = igamc( a, x );
+ if( y < y0 )
+ {
+ x0 = x;
+ yl = y;
+ break;
+ }
+ d = d + d;
+ }
+ }
+d = 0.5;
+dir = 0;
+
+for( i=0; i<400; i++ )
+ {
+ x = x1 + d * (x0 - x1);
+ y = igamc( a, x );
+ lgm = (x0 - x1)/(x1 + x0);
+ if( fabs(lgm) < dithresh )
+ break;
+ lgm = (y - y0)/y0;
+ if( fabs(lgm) < dithresh )
+ break;
+ if( x <= 0.0 )
+ break;
+ if( y >= y0 )
+ {
+ x1 = x;
+ yh = y;
+ if( dir < 0 )
+ {
+ dir = 0;
+ d = 0.5;
+ }
+ else if( dir > 1 )
+ d = 0.5 * d + 0.5;
+ else
+ d = (y0 - yl)/(yh - yl);
+ dir += 1;
+ }
+ else
+ {
+ x0 = x;
+ yl = y;
+ if( dir > 0 )
+ {
+ dir = 0;
+ d = 0.5;
+ }
+ else if( dir < -1 )
+ d = 0.5 * d;
+ else
+ d = (y0 - yl)/(yh - yl);
+ dir -= 1;
+ }
+ }
+if( x == 0.0 )
+ mtherr( "igami", UNDERFLOW );
+
+done:
+return( x );
+}
diff --git a/libm/double/incbet.c b/libm/double/incbet.c
new file mode 100644
index 000000000..ec236747d
--- /dev/null
+++ b/libm/double/incbet.c
@@ -0,0 +1,409 @@
+/* incbet.c
+ *
+ * Incomplete beta integral
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double a, b, x, y, incbet();
+ *
+ * y = incbet( 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
+ * or, when b*x is small, by a power series.
+ *
+ * ACCURACY:
+ *
+ * Tested at uniformly distributed random points (a,b,x) with a and b
+ * in "domain" and x between 0 and 1.
+ * Relative error
+ * arithmetic domain # trials peak rms
+ * IEEE 0,5 10000 6.9e-15 4.5e-16
+ * IEEE 0,85 250000 2.2e-13 1.7e-14
+ * IEEE 0,1000 30000 5.3e-12 6.3e-13
+ * IEEE 0,10000 250000 9.3e-11 7.1e-12
+ * IEEE 0,100000 10000 8.7e-10 4.8e-11
+ * Outputs smaller than the IEEE gradual underflow threshold
+ * were excluded from these statistics.
+ *
+ * ERROR MESSAGES:
+ * message condition value returned
+ * incbet domain x<0, x>1 0.0
+ * incbet underflow 0.0
+ */
+
+
+/*
+Cephes Math Library, Release 2.8: June, 2000
+Copyright 1984, 1995, 2000 by Stephen L. Moshier
+*/
+
+#include <math.h>
+
+#ifdef DEC
+#define MAXGAM 34.84425627277176174
+#else
+#define MAXGAM 171.624376956302725
+#endif
+
+extern double MACHEP, MINLOG, MAXLOG;
+#ifdef ANSIPROT
+extern double gamma ( double );
+extern double lgam ( double );
+extern double exp ( double );
+extern double log ( double );
+extern double pow ( double, double );
+extern double fabs ( double );
+static double incbcf(double, double, double);
+static double incbd(double, double, double);
+static double pseries(double, double, double);
+#else
+double gamma(), lgam(), exp(), log(), pow(), fabs();
+static double incbcf(), incbd(), pseries();
+#endif
+
+static double big = 4.503599627370496e15;
+static double biginv = 2.22044604925031308085e-16;
+
+
+double incbet( aa, bb, xx )
+double aa, bb, xx;
+{
+double a, b, t, x, xc, w, y;
+int flag;
+
+if( aa <= 0.0 || bb <= 0.0 )
+ goto domerr;
+
+if( (xx <= 0.0) || ( xx >= 1.0) )
+ {
+ if( xx == 0.0 )
+ return(0.0);
+ if( xx == 1.0 )
+ return( 1.0 );
+domerr:
+ mtherr( "incbet", DOMAIN );
+ return( 0.0 );
+ }
+
+flag = 0;
+if( (bb * xx) <= 1.0 && xx <= 0.95)
+ {
+ t = pseries(aa, bb, xx);
+ goto done;
+ }
+
+w = 1.0 - xx;
+
+/* Reverse a and b if x is greater than the mean. */
+if( xx > (aa/(aa+bb)) )
+ {
+ flag = 1;
+ a = bb;
+ b = aa;
+ xc = xx;
+ x = w;
+ }
+else
+ {
+ a = aa;
+ b = bb;
+ xc = w;
+ x = xx;
+ }
+
+if( flag == 1 && (b * x) <= 1.0 && x <= 0.95)
+ {
+ t = pseries(a, b, x);
+ goto done;
+ }
+
+/* Choose expansion for better convergence. */
+y = x * (a+b-2.0) - (a-1.0);
+if( y < 0.0 )
+ w = incbcf( a, b, x );
+else
+ w = incbd( a, b, x ) / xc;
+
+/* Multiply w by the factor
+ a b _ _ _
+ x (1-x) | (a+b) / ( a | (a) | (b) ) . */
+
+y = a * log(x);
+t = b * log(xc);
+if( (a+b) < MAXGAM && fabs(y) < MAXLOG && fabs(t) < MAXLOG )
+ {
+ t = pow(xc,b);
+ t *= pow(x,a);
+ t /= a;
+ t *= w;
+ t *= gamma(a+b) / (gamma(a) * gamma(b));
+ goto done;
+ }
+/* Resort to logarithms. */
+y += t + lgam(a+b) - lgam(a) - lgam(b);
+y += log(w/a);
+if( y < MINLOG )
+ t = 0.0;
+else
+ t = exp(y);
+
+done:
+
+if( flag == 1 )
+ {
+ if( t <= MACHEP )
+ t = 1.0 - MACHEP;
+ else
+ t = 1.0 - t;
+ }
+return( t );
+}
+
+/* Continued fraction expansion #1
+ * for incomplete beta integral
+ */
+
+static double incbcf( a, b, x )
+double a, b, x;
+{
+double xk, pk, pkm1, pkm2, qk, qkm1, qkm2;
+double k1, k2, k3, k4, k5, k6, k7, k8;
+double r, t, ans, thresh;
+int n;
+
+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 = 1.0;
+n = 0;
+thresh = 3.0 * MACHEP;
+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 = fabs( (ans - r)/r );
+ ans = r;
+ }
+ else
+ t = 1.0;
+
+ if( t < thresh )
+ 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( (fabs(qk) + fabs(pk)) > big )
+ {
+ pkm2 *= biginv;
+ pkm1 *= biginv;
+ qkm2 *= biginv;
+ qkm1 *= biginv;
+ }
+ if( (fabs(qk) < biginv) || (fabs(pk) < biginv) )
+ {
+ pkm2 *= big;
+ pkm1 *= big;
+ qkm2 *= big;
+ qkm1 *= big;
+ }
+ }
+while( ++n < 300 );
+
+cdone:
+return(ans);
+}
+
+
+/* Continued fraction expansion #2
+ * for incomplete beta integral
+ */
+
+static double incbd( a, b, x )
+double a, b, x;
+{
+double xk, pk, pkm1, pkm2, qk, qkm1, qkm2;
+double k1, k2, k3, k4, k5, k6, k7, k8;
+double r, t, ans, z, thresh;
+int n;
+
+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 = 1.0;
+n = 0;
+thresh = 3.0 * MACHEP;
+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 = fabs( (ans - r)/r );
+ ans = r;
+ }
+ else
+ t = 1.0;
+
+ if( t < thresh )
+ 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( (fabs(qk) + fabs(pk)) > big )
+ {
+ pkm2 *= biginv;
+ pkm1 *= biginv;
+ qkm2 *= biginv;
+ qkm1 *= biginv;
+ }
+ if( (fabs(qk) < biginv) || (fabs(pk) < biginv) )
+ {
+ pkm2 *= big;
+ pkm1 *= big;
+ qkm2 *= big;
+ qkm1 *= big;
+ }
+ }
+while( ++n < 300 );
+cdone:
+return(ans);
+}
+
+/* Power series for incomplete beta integral.
+ Use when b*x is small and x not too close to 1. */
+
+static double pseries( a, b, x )
+double a, b, x;
+{
+double s, t, u, v, n, t1, z, ai;
+
+ai = 1.0 / a;
+u = (1.0 - b) * x;
+v = u / (a + 1.0);
+t1 = v;
+t = u;
+n = 2.0;
+s = 0.0;
+z = MACHEP * ai;
+while( fabs(v) > z )
+ {
+ u = (n - b) * x / n;
+ t *= u;
+ v = t / (a + n);
+ s += v;
+ n += 1.0;
+ }
+s += t1;
+s += ai;
+
+u = a * log(x);
+if( (a+b) < MAXGAM && fabs(u) < MAXLOG )
+ {
+ t = gamma(a+b)/(gamma(a)*gamma(b));
+ s = s * t * pow(x,a);
+ }
+else
+ {
+ t = lgam(a+b) - lgam(a) - lgam(b) + u + log(s);
+ if( t < MINLOG )
+ s = 0.0;
+ else
+ s = exp(t);
+ }
+return(s);
+}
diff --git a/libm/double/incbi.c b/libm/double/incbi.c
new file mode 100644
index 000000000..817219c4a
--- /dev/null
+++ b/libm/double/incbi.c
@@ -0,0 +1,313 @@
+/* incbi()
+ *
+ * Inverse of imcomplete beta integral
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double a, b, x, y, incbi();
+ *
+ * x = incbi( a, b, y );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Given y, the function finds x such that
+ *
+ * incbet( a, b, x ) = y .
+ *
+ * The routine performs interval halving or 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 .5,10000 50000 5.8e-12 1.3e-13
+ * IEEE 0,1 .25,100 100000 1.8e-13 3.9e-15
+ * IEEE 0,1 0,5 50000 1.1e-12 5.5e-15
+ * VAX 0,1 .5,100 25000 3.5e-14 1.1e-15
+ * With a and b constrained to half-integer or integer values:
+ * IEEE 0,1 .5,10000 50000 5.8e-12 1.1e-13
+ * IEEE 0,1 .5,100 100000 1.7e-14 7.9e-16
+ * With a = .5, b constrained to half-integer or integer values:
+ * IEEE 0,1 .5,10000 10000 8.3e-11 1.0e-11
+ */
+
+
+/*
+Cephes Math Library Release 2.8: June, 2000
+Copyright 1984, 1996, 2000 by Stephen L. Moshier
+*/
+
+#include <math.h>
+
+extern double MACHEP, MAXNUM, MAXLOG, MINLOG;
+#ifdef ANSIPROT
+extern double ndtri ( double );
+extern double exp ( double );
+extern double fabs ( double );
+extern double log ( double );
+extern double sqrt ( double );
+extern double lgam ( double );
+extern double incbet ( double, double, double );
+#else
+double ndtri(), exp(), fabs(), log(), sqrt(), lgam(), incbet();
+#endif
+
+double incbi( aa, bb, yy0 )
+double aa, bb, yy0;
+{
+double a, b, y0, d, y, x, x0, x1, lgm, yp, di, dithresh, yl, yh, xt;
+int i, rflg, dir, nflg;
+
+
+i = 0;
+if( yy0 <= 0 )
+ return(0.0);
+if( yy0 >= 1.0 )
+ return(1.0);
+x0 = 0.0;
+yl = 0.0;
+x1 = 1.0;
+yh = 1.0;
+nflg = 0;
+
+if( aa <= 1.0 || bb <= 1.0 )
+ {
+ dithresh = 1.0e-6;
+ rflg = 0;
+ a = aa;
+ b = bb;
+ y0 = yy0;
+ x = a/(a+b);
+ y = incbet( a, b, x );
+ goto ihalve;
+ }
+else
+ {
+ dithresh = 1.0e-4;
+ }
+/* approximation to inverse function */
+
+yp = -ndtri(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;
+ }
+
+lgm = (yp * yp - 3.0)/6.0;
+x = 2.0/( 1.0/(2.0*a-1.0) + 1.0/(2.0*b-1.0) );
+d = yp * sqrt( x + lgm ) / x
+ - ( 1.0/(2.0*b-1.0) - 1.0/(2.0*a-1.0) )
+ * (lgm + 5.0/6.0 - 2.0/(3.0*x));
+d = 2.0 * d;
+if( d < MINLOG )
+ {
+ x = 1.0;
+ goto under;
+ }
+x = a/( a + b * exp(d) );
+y = incbet( a, b, x );
+yp = (y - y0)/y0;
+if( fabs(yp) < 0.2 )
+ goto newt;
+
+/* Resort to interval halving if not close enough. */
+ihalve:
+
+dir = 0;
+di = 0.5;
+for( i=0; i<100; i++ )
+ {
+ if( i != 0 )
+ {
+ x = x0 + di * (x1 - x0);
+ if( x == 1.0 )
+ x = 1.0 - MACHEP;
+ if( x == 0.0 )
+ {
+ di = 0.5;
+ x = x0 + di * (x1 - x0);
+ if( x == 0.0 )
+ goto under;
+ }
+ y = incbet( a, b, x );
+ yp = (x1 - x0)/(x1 + x0);
+ if( fabs(yp) < dithresh )
+ goto newt;
+ yp = (y-y0)/y0;
+ if( fabs(yp) < dithresh )
+ goto newt;
+ }
+ if( y < y0 )
+ {
+ x0 = x;
+ yl = y;
+ if( dir < 0 )
+ {
+ dir = 0;
+ di = 0.5;
+ }
+ else if( dir > 3 )
+ di = 1.0 - (1.0 - di) * (1.0 - di);
+ else if( dir > 1 )
+ di = 0.5 * di + 0.5;
+ else
+ di = (y0 - y)/(yh - yl);
+ dir += 1;
+ if( x0 > 0.75 )
+ {
+ if( rflg == 1 )
+ {
+ rflg = 0;
+ a = aa;
+ b = bb;
+ y0 = yy0;
+ }
+ else
+ {
+ rflg = 1;
+ a = bb;
+ b = aa;
+ y0 = 1.0 - yy0;
+ }
+ x = 1.0 - x;
+ y = incbet( a, b, x );
+ x0 = 0.0;
+ yl = 0.0;
+ x1 = 1.0;
+ yh = 1.0;
+ goto ihalve;
+ }
+ }
+ else
+ {
+ x1 = x;
+ if( rflg == 1 && x1 < MACHEP )
+ {
+ x = 0.0;
+ goto done;
+ }
+ yh = y;
+ if( dir > 0 )
+ {
+ dir = 0;
+ di = 0.5;
+ }
+ else if( dir < -3 )
+ di = di * di;
+ else if( dir < -1 )
+ di = 0.5 * di;
+ else
+ di = (y - y0)/(yh - yl);
+ dir -= 1;
+ }
+ }
+mtherr( "incbi", PLOSS );
+if( x0 >= 1.0 )
+ {
+ x = 1.0 - MACHEP;
+ goto done;
+ }
+if( x <= 0.0 )
+ {
+under:
+ mtherr( "incbi", UNDERFLOW );
+ x = 0.0;
+ goto done;
+ }
+
+newt:
+
+if( nflg )
+ goto done;
+nflg = 1;
+lgm = lgam(a+b) - lgam(a) - lgam(b);
+
+for( i=0; i<8; i++ )
+ {
+ /* Compute the function at this point. */
+ if( i != 0 )
+ y = incbet(a,b,x);
+ if( y < yl )
+ {
+ x = x0;
+ y = yl;
+ }
+ else if( y > yh )
+ {
+ x = x1;
+ y = yh;
+ }
+ else if( y < y0 )
+ {
+ x0 = x;
+ yl = y;
+ }
+ else
+ {
+ x1 = x;
+ yh = y;
+ }
+ if( x == 1.0 || x == 0.0 )
+ break;
+ /* Compute the derivative of the function at this point. */
+ d = (a - 1.0) * log(x) + (b - 1.0) * log(1.0-x) + lgm;
+ if( d < MINLOG )
+ goto done;
+ if( d > MAXLOG )
+ break;
+ d = exp(d);
+ /* Compute the step to the next approximation of x. */
+ d = (y - y0)/d;
+ xt = x - d;
+ if( xt <= x0 )
+ {
+ y = (x - x0) / (x1 - x0);
+ xt = x0 + 0.5 * y * (x - x0);
+ if( xt <= 0.0 )
+ break;
+ }
+ if( xt >= x1 )
+ {
+ y = (x1 - x) / (x1 - x0);
+ xt = x1 - 0.5 * y * (x1 - x);
+ if( xt >= 1.0 )
+ break;
+ }
+ x = xt;
+ if( fabs(d/x) < 128.0 * MACHEP )
+ goto done;
+ }
+/* Did not converge. */
+dithresh = 256.0 * MACHEP;
+goto ihalve;
+
+done:
+
+if( rflg )
+ {
+ if( x <= MACHEP )
+ x = 1.0 - MACHEP;
+ else
+ x = 1.0 - x;
+ }
+return( x );
+}
diff --git a/libm/double/isnan.c b/libm/double/isnan.c
new file mode 100644
index 000000000..8ae83bcba
--- /dev/null
+++ b/libm/double/isnan.c
@@ -0,0 +1,237 @@
+/* isnan()
+ * signbit()
+ * isfinite()
+ *
+ * Floating point numeric utilities
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double ceil(), floor(), frexp(), ldexp();
+ * int signbit(), isnan(), isfinite();
+ * double x, y;
+ * int expnt, n;
+ *
+ * y = floor(x);
+ * y = ceil(x);
+ * y = frexp( x, &expnt );
+ * y = ldexp( x, n );
+ * n = signbit(x);
+ * n = isnan(x);
+ * n = isfinite(x);
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * All four routines return a double precision floating point
+ * result.
+ *
+ * floor() returns the largest integer less than or equal to x.
+ * It truncates toward minus infinity.
+ *
+ * ceil() returns the smallest integer greater than or equal
+ * to x. It truncates toward plus infinity.
+ *
+ * frexp() 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.
+ *
+ * ldexp() 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.3: March, 1995
+Copyright 1984, 1995 by Stephen L. Moshier
+*/
+
+
+#include <math.h>
+
+#ifdef UNK
+/* ceil(), floor(), frexp(), ldexp() may need to be rewritten. */
+#undef UNK
+#if BIGENDIAN
+#define MIEEE 1
+#else
+#define IBMPC 1
+#endif
+#endif
+
+
+/* Return 1 if the sign bit of x is 1, else 0. */
+
+int signbit(x)
+double x;
+{
+union
+ {
+ double d;
+ short s[4];
+ int i[2];
+ } u;
+
+u.d = x;
+
+if( sizeof(int) == 4 )
+ {
+#ifdef IBMPC
+ return( u.i[1] < 0 );
+#endif
+#ifdef DEC
+ return( u.s[3] < 0 );
+#endif
+#ifdef MIEEE
+ return( u.i[0] < 0 );
+#endif
+ }
+else
+ {
+#ifdef IBMPC
+ return( u.s[3] < 0 );
+#endif
+#ifdef DEC
+ return( u.s[3] < 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 isnan(x)
+double x;
+{
+#ifdef NANS
+union
+ {
+ double d;
+ unsigned short s[4];
+ unsigned int i[2];
+ } u;
+
+u.d = x;
+
+if( sizeof(int) == 4 )
+ {
+#ifdef IBMPC
+ if( ((u.i[1] & 0x7ff00000) == 0x7ff00000)
+ && (((u.i[1] & 0x000fffff) != 0) || (u.i[0] != 0)))
+ return 1;
+#endif
+#ifdef DEC
+ if( (u.s[1] & 0x7fff) == 0)
+ {
+ if( (u.s[2] | u.s[1] | u.s[0]) != 0 )
+ return(1);
+ }
+#endif
+#ifdef MIEEE
+ if( ((u.i[0] & 0x7ff00000) == 0x7ff00000)
+ && (((u.i[0] & 0x000fffff) != 0) || (u.i[1] != 0)))
+ return 1;
+#endif
+ return(0);
+ }
+else
+ { /* size int not 4 */
+#ifdef IBMPC
+ if( (u.s[3] & 0x7ff0) == 0x7ff0)
+ {
+ if( ((u.s[3] & 0x000f) | u.s[2] | u.s[1] | u.s[0]) != 0 )
+ return(1);
+ }
+#endif
+#ifdef DEC
+ if( (u.s[3] & 0x7fff) == 0)
+ {
+ if( (u.s[2] | u.s[1] | u.s[0]) != 0 )
+ return(1);
+ }
+#endif
+#ifdef MIEEE
+ if( (u.s[0] & 0x7ff0) == 0x7ff0)
+ {
+ if( ((u.s[0] & 0x000f) | u.s[1] | u.s[2] | u.s[3]) != 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 isfinite(x)
+double x;
+{
+#ifdef INFINITIES
+union
+ {
+ double d;
+ unsigned short s[4];
+ unsigned int i[2];
+ } u;
+
+u.d = x;
+
+if( sizeof(int) == 4 )
+ {
+#ifdef IBMPC
+ if( (u.i[1] & 0x7ff00000) != 0x7ff00000)
+ return 1;
+#endif
+#ifdef DEC
+ if( (u.s[3] & 0x7fff) != 0)
+ return 1;
+#endif
+#ifdef MIEEE
+ if( (u.i[0] & 0x7ff00000) != 0x7ff00000)
+ return 1;
+#endif
+ return(0);
+ }
+else
+ {
+#ifdef IBMPC
+ if( (u.s[3] & 0x7ff0) != 0x7ff0)
+ return 1;
+#endif
+#ifdef DEC
+ if( (u.s[3] & 0x7fff) != 0)
+ return 1;
+#endif
+#ifdef MIEEE
+ if( (u.s[0] & 0x7ff0) != 0x7ff0)
+ return 1;
+#endif
+ return(0);
+ }
+#else
+/* No INFINITY. */
+return(1);
+#endif
+}
diff --git a/libm/double/iv.c b/libm/double/iv.c
new file mode 100644
index 000000000..ec0e96244
--- /dev/null
+++ b/libm/double/iv.c
@@ -0,0 +1,116 @@
+/* iv.c
+ *
+ * Modified Bessel function of noninteger order
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double v, x, y, iv();
+ *
+ * y = iv( 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.
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * DEC 0,30 2000 3.1e-15 5.4e-16
+ * IEEE 0,30 10000 1.7e-14 2.7e-15
+ *
+ * Accuracy is diminished if v is near a negative integer.
+ *
+ * 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.8: June, 2000
+Copyright 1984, 1987, 1988, 2000 by Stephen L. Moshier
+*/
+
+
+#include <math.h>
+#ifdef ANSIPROT
+extern double hyperg ( double, double, double );
+extern double exp ( double );
+extern double gamma ( double );
+extern double log ( double );
+extern double fabs ( double );
+extern double floor ( double );
+#else
+double hyperg(), exp(), gamma(), log(), fabs(), floor();
+#endif
+extern double MACHEP, MAXNUM;
+
+double iv( v, x )
+double v, x;
+{
+int sign;
+double t, ax;
+
+/* If v is a negative integer, invoke symmetry */
+t = floor(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( "iv", DOMAIN );
+ return( 0.0 );
+ }
+ if( v != 2.0 * floor(v/2.0) )
+ sign = -1;
+ }
+
+/* Avoid logarithm singularity */
+if( x == 0.0 )
+ {
+ if( v == 0.0 )
+ return( 1.0 );
+ if( v < 0.0 )
+ {
+ mtherr( "iv", OVERFLOW );
+ return( MAXNUM );
+ }
+ else
+ return( 0.0 );
+ }
+
+ax = fabs(x);
+t = v * log( 0.5 * ax ) - x;
+t = sign * exp(t) / gamma( v + 1.0 );
+ax = v + 0.5;
+return( t * hyperg( ax, 2.0 * ax, 2.0 * x ) );
+}
diff --git a/libm/double/j0.c b/libm/double/j0.c
new file mode 100644
index 000000000..c0f1bd4b8
--- /dev/null
+++ b/libm/double/j0.c
@@ -0,0 +1,543 @@
+/* j0.c
+ *
+ * Bessel function of order zero
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, j0();
+ *
+ * y = j0( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns Bessel function of order zero of the argument.
+ *
+ * The domain is divided into the intervals [0, 5] and
+ * (5, infinity). In the first interval the following rational
+ * approximation is used:
+ *
+ *
+ * 2 2
+ * (w - r ) (w - r ) P (w) / Q (w)
+ * 1 2 3 8
+ *
+ * 2
+ * where w = x and the two r's are zeros of the function.
+ *
+ * In the second interval, the Hankel asymptotic expansion
+ * is employed with two rational functions of degree 6/6
+ * and 7/7.
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Absolute error:
+ * arithmetic domain # trials peak rms
+ * DEC 0, 30 10000 4.4e-17 6.3e-18
+ * IEEE 0, 30 60000 4.2e-16 1.1e-16
+ *
+ */
+ /* y0.c
+ *
+ * Bessel function of the second kind, order zero
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, y0();
+ *
+ * y = y0( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns Bessel function of the second kind, of order
+ * zero, of the argument.
+ *
+ * The domain is divided into the intervals [0, 5] and
+ * (5, infinity). In the first interval a rational approximation
+ * R(x) is employed to compute
+ * y0(x) = R(x) + 2 * log(x) * j0(x) / PI.
+ * Thus a call to j0() is required.
+ *
+ * In the second interval, the Hankel asymptotic expansion
+ * is employed with two rational functions of degree 6/6
+ * and 7/7.
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Absolute error, when y0(x) < 1; else relative error:
+ *
+ * arithmetic domain # trials peak rms
+ * DEC 0, 30 9400 7.0e-17 7.9e-18
+ * IEEE 0, 30 30000 1.3e-15 1.6e-16
+ *
+ */
+
+/*
+Cephes Math Library Release 2.8: June, 2000
+Copyright 1984, 1987, 1989, 2000 by Stephen L. Moshier
+*/
+
+/* Note: all coefficients satisfy the relative error criterion
+ * except YP, YQ which are designed for absolute error. */
+
+#include <math.h>
+
+#ifdef UNK
+static double PP[7] = {
+ 7.96936729297347051624E-4,
+ 8.28352392107440799803E-2,
+ 1.23953371646414299388E0,
+ 5.44725003058768775090E0,
+ 8.74716500199817011941E0,
+ 5.30324038235394892183E0,
+ 9.99999999999999997821E-1,
+};
+static double PQ[7] = {
+ 9.24408810558863637013E-4,
+ 8.56288474354474431428E-2,
+ 1.25352743901058953537E0,
+ 5.47097740330417105182E0,
+ 8.76190883237069594232E0,
+ 5.30605288235394617618E0,
+ 1.00000000000000000218E0,
+};
+#endif
+#ifdef DEC
+static unsigned short PP[28] = {
+0035520,0164604,0140733,0054470,
+0037251,0122605,0115356,0107170,
+0040236,0124412,0071500,0056303,
+0040656,0047737,0045720,0045263,
+0041013,0172143,0045004,0142103,
+0040651,0132045,0026241,0026406,
+0040200,0000000,0000000,0000000,
+};
+static unsigned short PQ[28] = {
+0035562,0052006,0070034,0134666,
+0037257,0057055,0055242,0123424,
+0040240,0071626,0046630,0032371,
+0040657,0011077,0032013,0012731,
+0041014,0030307,0050331,0006414,
+0040651,0145457,0065021,0150304,
+0040200,0000000,0000000,0000000,
+};
+#endif
+#ifdef IBMPC
+static unsigned short PP[28] = {
+0x6b27,0x983b,0x1d30,0x3f4a,
+0xd1cf,0xb35d,0x34b0,0x3fb5,
+0x0b98,0x4e68,0xd521,0x3ff3,
+0x0956,0xe97a,0xc9fb,0x4015,
+0x9888,0x6940,0x7e8c,0x4021,
+0x25a1,0xa594,0x3684,0x4015,
+0x0000,0x0000,0x0000,0x3ff0,
+};
+static unsigned short PQ[28] = {
+0x9737,0xce03,0x4a80,0x3f4e,
+0x54e3,0xab54,0xebc5,0x3fb5,
+0x069f,0xc9b3,0x0e72,0x3ff4,
+0x62bb,0xe681,0xe247,0x4015,
+0x21a1,0xea1b,0x8618,0x4021,
+0x3a19,0xed42,0x3965,0x4015,
+0x0000,0x0000,0x0000,0x3ff0,
+};
+#endif
+#ifdef MIEEE
+static unsigned short PP[28] = {
+0x3f4a,0x1d30,0x983b,0x6b27,
+0x3fb5,0x34b0,0xb35d,0xd1cf,
+0x3ff3,0xd521,0x4e68,0x0b98,
+0x4015,0xc9fb,0xe97a,0x0956,
+0x4021,0x7e8c,0x6940,0x9888,
+0x4015,0x3684,0xa594,0x25a1,
+0x3ff0,0x0000,0x0000,0x0000,
+};
+static unsigned short PQ[28] = {
+0x3f4e,0x4a80,0xce03,0x9737,
+0x3fb5,0xebc5,0xab54,0x54e3,
+0x3ff4,0x0e72,0xc9b3,0x069f,
+0x4015,0xe247,0xe681,0x62bb,
+0x4021,0x8618,0xea1b,0x21a1,
+0x4015,0x3965,0xed42,0x3a19,
+0x3ff0,0x0000,0x0000,0x0000,
+};
+#endif
+
+#ifdef UNK
+static double QP[8] = {
+-1.13663838898469149931E-2,
+-1.28252718670509318512E0,
+-1.95539544257735972385E1,
+-9.32060152123768231369E1,
+-1.77681167980488050595E2,
+-1.47077505154951170175E2,
+-5.14105326766599330220E1,
+-6.05014350600728481186E0,
+};
+static double QQ[7] = {
+/* 1.00000000000000000000E0,*/
+ 6.43178256118178023184E1,
+ 8.56430025976980587198E2,
+ 3.88240183605401609683E3,
+ 7.24046774195652478189E3,
+ 5.93072701187316984827E3,
+ 2.06209331660327847417E3,
+ 2.42005740240291393179E2,
+};
+#endif
+#ifdef DEC
+static unsigned short QP[32] = {
+0136472,0035021,0142451,0141115,
+0140244,0024731,0150620,0105642,
+0141234,0067177,0124161,0060141,
+0141672,0064572,0151557,0043036,
+0142061,0127141,0003127,0043517,
+0142023,0011727,0060271,0144544,
+0141515,0122142,0126620,0143150,
+0140701,0115306,0106715,0007344,
+};
+static unsigned short QQ[28] = {
+/*0040200,0000000,0000000,0000000,*/
+0041600,0121272,0004741,0026544,
+0042526,0015605,0105654,0161771,
+0043162,0123155,0165644,0062645,
+0043342,0041675,0167576,0130756,
+0043271,0052720,0165631,0154214,
+0043000,0160576,0034614,0172024,
+0042162,0000570,0030500,0051235,
+};
+#endif
+#ifdef IBMPC
+static unsigned short QP[32] = {
+0x384a,0x38a5,0x4742,0xbf87,
+0x1174,0x3a32,0x853b,0xbff4,
+0x2c0c,0xf50e,0x8dcf,0xc033,
+0xe8c4,0x5a6d,0x4d2f,0xc057,
+0xe8ea,0x20ca,0x35cc,0xc066,
+0x392d,0xec17,0x627a,0xc062,
+0x18cd,0x55b2,0xb48c,0xc049,
+0xa1dd,0xd1b9,0x3358,0xc018,
+};
+static unsigned short QQ[28] = {
+/*0x0000,0x0000,0x0000,0x3ff0,*/
+0x25ac,0x413c,0x1457,0x4050,
+0x9c7f,0xb175,0xc370,0x408a,
+0x8cb5,0xbd74,0x54cd,0x40ae,
+0xd63e,0xbdef,0x4877,0x40bc,
+0x3b11,0x1d73,0x2aba,0x40b7,
+0x9e82,0xc731,0x1c2f,0x40a0,
+0x0a54,0x0628,0x402f,0x406e,
+};
+#endif
+#ifdef MIEEE
+static unsigned short QP[32] = {
+0xbf87,0x4742,0x38a5,0x384a,
+0xbff4,0x853b,0x3a32,0x1174,
+0xc033,0x8dcf,0xf50e,0x2c0c,
+0xc057,0x4d2f,0x5a6d,0xe8c4,
+0xc066,0x35cc,0x20ca,0xe8ea,
+0xc062,0x627a,0xec17,0x392d,
+0xc049,0xb48c,0x55b2,0x18cd,
+0xc018,0x3358,0xd1b9,0xa1dd,
+};
+static unsigned short QQ[28] = {
+/*0x3ff0,0x0000,0x0000,0x0000,*/
+0x4050,0x1457,0x413c,0x25ac,
+0x408a,0xc370,0xb175,0x9c7f,
+0x40ae,0x54cd,0xbd74,0x8cb5,
+0x40bc,0x4877,0xbdef,0xd63e,
+0x40b7,0x2aba,0x1d73,0x3b11,
+0x40a0,0x1c2f,0xc731,0x9e82,
+0x406e,0x402f,0x0628,0x0a54,
+};
+#endif
+
+
+#ifdef UNK
+static double YP[8] = {
+ 1.55924367855235737965E4,
+-1.46639295903971606143E7,
+ 5.43526477051876500413E9,
+-9.82136065717911466409E11,
+ 8.75906394395366999549E13,
+-3.46628303384729719441E15,
+ 4.42733268572569800351E16,
+-1.84950800436986690637E16,
+};
+static double YQ[7] = {
+/* 1.00000000000000000000E0,*/
+ 1.04128353664259848412E3,
+ 6.26107330137134956842E5,
+ 2.68919633393814121987E8,
+ 8.64002487103935000337E10,
+ 2.02979612750105546709E13,
+ 3.17157752842975028269E15,
+ 2.50596256172653059228E17,
+};
+#endif
+#ifdef DEC
+static unsigned short YP[32] = {
+0043563,0120677,0042264,0046166,
+0146137,0140371,0113444,0042260,
+0050241,0175707,0100502,0063344,
+0152144,0125737,0007265,0164526,
+0053637,0051621,0163035,0060546,
+0155105,0004416,0107306,0060023,
+0056035,0045133,0030132,0000024,
+0155603,0065132,0144061,0131732,
+};
+static unsigned short YQ[28] = {
+/*0040200,0000000,0000000,0000000,*/
+0042602,0024422,0135557,0162663,
+0045030,0155665,0044075,0160135,
+0047200,0035432,0105446,0104005,
+0051240,0167331,0056063,0022743,
+0053223,0127746,0025764,0012160,
+0055064,0044206,0177532,0145545,
+0056536,0111375,0163715,0127201,
+};
+#endif
+#ifdef IBMPC
+static unsigned short YP[32] = {
+0x898f,0xe896,0x7437,0x40ce,
+0x8896,0x32e4,0xf81f,0xc16b,
+0x4cdd,0xf028,0x3f78,0x41f4,
+0xbd2b,0xe1d6,0x957b,0xc26c,
+0xac2d,0x3cc3,0xea72,0x42d3,
+0xcc02,0xd1d8,0xa121,0xc328,
+0x4003,0x660b,0xa94b,0x4363,
+0x367b,0x5906,0x6d4b,0xc350,
+};
+static unsigned short YQ[28] = {
+/*0x0000,0x0000,0x0000,0x3ff0,*/
+0xfcb6,0x576d,0x4522,0x4090,
+0xbc0c,0xa907,0x1b76,0x4123,
+0xd101,0x5164,0x0763,0x41b0,
+0x64bc,0x2b86,0x1ddb,0x4234,
+0x828e,0xc57e,0x75fc,0x42b2,
+0x596d,0xdfeb,0x8910,0x4326,
+0xb5d0,0xbcf9,0xd25f,0x438b,
+};
+#endif
+#ifdef MIEEE
+static unsigned short YP[32] = {
+0x40ce,0x7437,0xe896,0x898f,
+0xc16b,0xf81f,0x32e4,0x8896,
+0x41f4,0x3f78,0xf028,0x4cdd,
+0xc26c,0x957b,0xe1d6,0xbd2b,
+0x42d3,0xea72,0x3cc3,0xac2d,
+0xc328,0xa121,0xd1d8,0xcc02,
+0x4363,0xa94b,0x660b,0x4003,
+0xc350,0x6d4b,0x5906,0x367b,
+};
+static unsigned short YQ[28] = {
+/*0x3ff0,0x0000,0x0000,0x0000,*/
+0x4090,0x4522,0x576d,0xfcb6,
+0x4123,0x1b76,0xa907,0xbc0c,
+0x41b0,0x0763,0x5164,0xd101,
+0x4234,0x1ddb,0x2b86,0x64bc,
+0x42b2,0x75fc,0xc57e,0x828e,
+0x4326,0x8910,0xdfeb,0x596d,
+0x438b,0xd25f,0xbcf9,0xb5d0,
+};
+#endif
+
+#ifdef UNK
+/* 5.783185962946784521175995758455807035071 */
+static double DR1 = 5.78318596294678452118E0;
+/* 30.47126234366208639907816317502275584842 */
+static double DR2 = 3.04712623436620863991E1;
+#endif
+
+#ifdef DEC
+static unsigned short R1[] = {0040671,0007734,0001061,0056734};
+#define DR1 *(double *)R1
+static unsigned short R2[] = {0041363,0142445,0030416,0165567};
+#define DR2 *(double *)R2
+#endif
+
+#ifdef IBMPC
+static unsigned short R1[] = {0x2bbb,0x8046,0x21fb,0x4017};
+#define DR1 *(double *)R1
+static unsigned short R2[] = {0xdd6f,0xa621,0x78a4,0x403e};
+#define DR2 *(double *)R2
+#endif
+
+#ifdef MIEEE
+static unsigned short R1[] = {0x4017,0x21fb,0x8046,0x2bbb};
+#define DR1 *(double *)R1
+static unsigned short R2[] = {0x403e,0x78a4,0xa621,0xdd6f};
+#define DR2 *(double *)R2
+#endif
+
+#ifdef UNK
+static double RP[4] = {
+-4.79443220978201773821E9,
+ 1.95617491946556577543E12,
+-2.49248344360967716204E14,
+ 9.70862251047306323952E15,
+};
+static double RQ[8] = {
+/* 1.00000000000000000000E0,*/
+ 4.99563147152651017219E2,
+ 1.73785401676374683123E5,
+ 4.84409658339962045305E7,
+ 1.11855537045356834862E10,
+ 2.11277520115489217587E12,
+ 3.10518229857422583814E14,
+ 3.18121955943204943306E16,
+ 1.71086294081043136091E18,
+};
+#endif
+#ifdef DEC
+static unsigned short RP[16] = {
+0150216,0161235,0064344,0014450,
+0052343,0135216,0035624,0144153,
+0154142,0130247,0003310,0003667,
+0055411,0173703,0047772,0176635,
+};
+static unsigned short RQ[32] = {
+/*0040200,0000000,0000000,0000000,*/
+0042371,0144025,0032265,0136137,
+0044451,0133131,0132420,0151466,
+0046470,0144641,0072540,0030636,
+0050446,0126600,0045042,0044243,
+0052365,0172633,0110301,0071063,
+0054215,0032424,0062272,0043513,
+0055742,0005013,0171731,0072335,
+0057275,0170646,0036663,0013134,
+};
+#endif
+#ifdef IBMPC
+static unsigned short RP[16] = {
+0x8325,0xad1c,0xdc53,0xc1f1,
+0x990d,0xc772,0x7751,0x427c,
+0x00f7,0xe0d9,0x5614,0xc2ec,
+0x5fb4,0x69ff,0x3ef8,0x4341,
+};
+static unsigned short RQ[32] = {
+/*0x0000,0x0000,0x0000,0x3ff0,*/
+0xb78c,0xa696,0x3902,0x407f,
+0x1a67,0x36a2,0x36cb,0x4105,
+0x0634,0x2eac,0x1934,0x4187,
+0x4914,0x0944,0xd5b0,0x4204,
+0x2e46,0x7218,0xbeb3,0x427e,
+0x48e9,0x8c97,0xa6a2,0x42f1,
+0x2e9c,0x7e7b,0x4141,0x435c,
+0x62cc,0xc7b6,0xbe34,0x43b7,
+};
+#endif
+#ifdef MIEEE
+static unsigned short RP[16] = {
+0xc1f1,0xdc53,0xad1c,0x8325,
+0x427c,0x7751,0xc772,0x990d,
+0xc2ec,0x5614,0xe0d9,0x00f7,
+0x4341,0x3ef8,0x69ff,0x5fb4,
+};
+static unsigned short RQ[32] = {
+/*0x3ff0,0x0000,0x0000,0x0000,*/
+0x407f,0x3902,0xa696,0xb78c,
+0x4105,0x36cb,0x36a2,0x1a67,
+0x4187,0x1934,0x2eac,0x0634,
+0x4204,0xd5b0,0x0944,0x4914,
+0x427e,0xbeb3,0x7218,0x2e46,
+0x42f1,0xa6a2,0x8c97,0x48e9,
+0x435c,0x4141,0x7e7b,0x2e9c,
+0x43b7,0xbe34,0xc7b6,0x62cc,
+};
+#endif
+
+#ifdef ANSIPROT
+extern double polevl ( double, void *, int );
+extern double p1evl ( double, void *, int );
+extern double log ( double );
+extern double sin ( double );
+extern double cos ( double );
+extern double sqrt ( double );
+double j0 ( double );
+#else
+double polevl(), p1evl(), log(), sin(), cos(), sqrt();
+double j0();
+#endif
+extern double TWOOPI, SQ2OPI, PIO4;
+
+double j0(x)
+double x;
+{
+double w, z, p, q, xn;
+
+if( x < 0 )
+ x = -x;
+
+if( x <= 5.0 )
+ {
+ z = x * x;
+ if( x < 1.0e-5 )
+ return( 1.0 - z/4.0 );
+
+ p = (z - DR1) * (z - DR2);
+ p = p * polevl( z, RP, 3)/p1evl( z, RQ, 8 );
+ return( p );
+ }
+
+w = 5.0/x;
+q = 25.0/(x*x);
+p = polevl( q, PP, 6)/polevl( q, PQ, 6 );
+q = polevl( q, QP, 7)/p1evl( q, QQ, 7 );
+xn = x - PIO4;
+p = p * cos(xn) - w * q * sin(xn);
+return( p * SQ2OPI / sqrt(x) );
+}
+
+/* y0() 2 */
+/* Bessel function of second kind, order zero */
+
+/* Rational approximation coefficients YP[], YQ[] are used here.
+ * The function computed is y0(x) - 2 * log(x) * j0(x) / PI,
+ * whose value at x = 0 is 2 * ( log(0.5) + EUL ) / PI
+ * = 0.073804295108687225.
+ */
+
+/*
+#define PIO4 .78539816339744830962
+#define SQ2OPI .79788456080286535588
+*/
+extern double MAXNUM;
+
+double y0(x)
+double x;
+{
+double w, z, p, q, xn;
+
+if( x <= 5.0 )
+ {
+ if( x <= 0.0 )
+ {
+ mtherr( "y0", DOMAIN );
+ return( -MAXNUM );
+ }
+ z = x * x;
+ w = polevl( z, YP, 7) / p1evl( z, YQ, 7 );
+ w += TWOOPI * log(x) * j0(x);
+ return( w );
+ }
+
+w = 5.0/x;
+z = 25.0 / (x * x);
+p = polevl( z, PP, 6)/polevl( z, PQ, 6 );
+q = polevl( z, QP, 7)/p1evl( z, QQ, 7 );
+xn = x - PIO4;
+p = p * sin(xn) + w * q * cos(xn);
+return( p * SQ2OPI / sqrt(x) );
+}
diff --git a/libm/double/j1.c b/libm/double/j1.c
new file mode 100644
index 000000000..95e46ea79
--- /dev/null
+++ b/libm/double/j1.c
@@ -0,0 +1,515 @@
+/* j1.c
+ *
+ * Bessel function of order one
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, j1();
+ *
+ * y = j1( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns Bessel function of order one of the argument.
+ *
+ * The domain is divided into the intervals [0, 8] and
+ * (8, infinity). In the first interval a 24 term Chebyshev
+ * expansion is used. In the second, the asymptotic
+ * trigonometric representation is employed using two
+ * rational functions of degree 5/5.
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Absolute error:
+ * arithmetic domain # trials peak rms
+ * DEC 0, 30 10000 4.0e-17 1.1e-17
+ * IEEE 0, 30 30000 2.6e-16 1.1e-16
+ *
+ *
+ */
+ /* 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, 8] and
+ * (8, infinity). In the first interval a 25 term Chebyshev
+ * expansion is used, and a call to j1() is required.
+ * In the second, the asymptotic trigonometric representation
+ * is employed using two rational functions of degree 5/5.
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Absolute error:
+ * arithmetic domain # trials peak rms
+ * DEC 0, 30 10000 8.6e-17 1.3e-17
+ * IEEE 0, 30 30000 1.0e-15 1.3e-16
+ *
+ * (error criterion relative when |y1| > 1).
+ *
+ */
+
+
+/*
+Cephes Math Library Release 2.8: June, 2000
+Copyright 1984, 1987, 1989, 2000 by Stephen L. Moshier
+*/
+
+/*
+#define PIO4 .78539816339744830962
+#define THPIO4 2.35619449019234492885
+#define SQ2OPI .79788456080286535588
+*/
+
+#include <math.h>
+
+#ifdef UNK
+static double RP[4] = {
+-8.99971225705559398224E8,
+ 4.52228297998194034323E11,
+-7.27494245221818276015E13,
+ 3.68295732863852883286E15,
+};
+static double RQ[8] = {
+/* 1.00000000000000000000E0,*/
+ 6.20836478118054335476E2,
+ 2.56987256757748830383E5,
+ 8.35146791431949253037E7,
+ 2.21511595479792499675E10,
+ 4.74914122079991414898E12,
+ 7.84369607876235854894E14,
+ 8.95222336184627338078E16,
+ 5.32278620332680085395E18,
+};
+#endif
+#ifdef DEC
+static unsigned short RP[16] = {
+0147526,0110742,0063322,0077052,
+0051722,0112720,0065034,0061530,
+0153604,0052227,0033147,0105650,
+0055121,0055025,0032276,0022015,
+};
+static unsigned short RQ[32] = {
+/*0040200,0000000,0000000,0000000,*/
+0042433,0032610,0155604,0033473,
+0044572,0173320,0067270,0006616,
+0046637,0045246,0162225,0006606,
+0050645,0004773,0157577,0053004,
+0052612,0033734,0001667,0176501,
+0054462,0054121,0173147,0121367,
+0056237,0002777,0121451,0176007,
+0057623,0136253,0131601,0044710,
+};
+#endif
+#ifdef IBMPC
+static unsigned short RP[16] = {
+0x4fc5,0x4cda,0xd23c,0xc1ca,
+0x8c6b,0x0d43,0x52ba,0x425a,
+0xf175,0xe6cc,0x8a92,0xc2d0,
+0xc482,0xa697,0x2b42,0x432a,
+};
+static unsigned short RQ[32] = {
+/*0x0000,0x0000,0x0000,0x3ff0,*/
+0x86e7,0x1b70,0x66b1,0x4083,
+0x01b2,0x0dd7,0x5eda,0x410f,
+0xa1b1,0xdc92,0xe954,0x4193,
+0xeac1,0x7bef,0xa13f,0x4214,
+0xffa8,0x8076,0x46fb,0x4291,
+0xf45f,0x3ecc,0x4b0a,0x4306,
+0x3f81,0xf465,0xe0bf,0x4373,
+0x2939,0x7670,0x7795,0x43d2,
+};
+#endif
+#ifdef MIEEE
+static unsigned short RP[16] = {
+0xc1ca,0xd23c,0x4cda,0x4fc5,
+0x425a,0x52ba,0x0d43,0x8c6b,
+0xc2d0,0x8a92,0xe6cc,0xf175,
+0x432a,0x2b42,0xa697,0xc482,
+};
+static unsigned short RQ[32] = {
+/*0x3ff0,0x0000,0x0000,0x0000,*/
+0x4083,0x66b1,0x1b70,0x86e7,
+0x410f,0x5eda,0x0dd7,0x01b2,
+0x4193,0xe954,0xdc92,0xa1b1,
+0x4214,0xa13f,0x7bef,0xeac1,
+0x4291,0x46fb,0x8076,0xffa8,
+0x4306,0x4b0a,0x3ecc,0xf45f,
+0x4373,0xe0bf,0xf465,0x3f81,
+0x43d2,0x7795,0x7670,0x2939,
+};
+#endif
+
+#ifdef UNK
+static double PP[7] = {
+ 7.62125616208173112003E-4,
+ 7.31397056940917570436E-2,
+ 1.12719608129684925192E0,
+ 5.11207951146807644818E0,
+ 8.42404590141772420927E0,
+ 5.21451598682361504063E0,
+ 1.00000000000000000254E0,
+};
+static double PQ[7] = {
+ 5.71323128072548699714E-4,
+ 6.88455908754495404082E-2,
+ 1.10514232634061696926E0,
+ 5.07386386128601488557E0,
+ 8.39985554327604159757E0,
+ 5.20982848682361821619E0,
+ 9.99999999999999997461E-1,
+};
+#endif
+#ifdef DEC
+static unsigned short PP[28] = {
+0035507,0144542,0061543,0024326,
+0037225,0145105,0017766,0022661,
+0040220,0043766,0010254,0133255,
+0040643,0113047,0142611,0151521,
+0041006,0144344,0055351,0074261,
+0040646,0156520,0120574,0006416,
+0040200,0000000,0000000,0000000,
+};
+static unsigned short PQ[28] = {
+0035425,0142330,0115041,0165514,
+0037214,0177352,0145105,0052026,
+0040215,0072515,0141207,0073255,
+0040642,0056427,0137222,0106405,
+0041006,0062716,0166427,0165450,
+0040646,0133352,0035425,0123304,
+0040200,0000000,0000000,0000000,
+};
+#endif
+#ifdef IBMPC
+static unsigned short PP[28] = {
+0x651b,0x4c6c,0xf92c,0x3f48,
+0xc4b6,0xa3fe,0xb948,0x3fb2,
+0x96d6,0xc215,0x08fe,0x3ff2,
+0x3a6a,0xf8b1,0x72c4,0x4014,
+0x2f16,0x8b5d,0xd91c,0x4020,
+0x81a2,0x142f,0xdbaa,0x4014,
+0x0000,0x0000,0x0000,0x3ff0,
+};
+static unsigned short PQ[28] = {
+0x3d69,0x1344,0xb89b,0x3f42,
+0xaa83,0x5948,0x9fdd,0x3fb1,
+0xeed6,0xb850,0xaea9,0x3ff1,
+0x51a1,0xf7d2,0x4ba2,0x4014,
+0xfd65,0xdda2,0xccb9,0x4020,
+0xb4d9,0x4762,0xd6dd,0x4014,
+0x0000,0x0000,0x0000,0x3ff0,
+};
+#endif
+#ifdef MIEEE
+static unsigned short PP[28] = {
+0x3f48,0xf92c,0x4c6c,0x651b,
+0x3fb2,0xb948,0xa3fe,0xc4b6,
+0x3ff2,0x08fe,0xc215,0x96d6,
+0x4014,0x72c4,0xf8b1,0x3a6a,
+0x4020,0xd91c,0x8b5d,0x2f16,
+0x4014,0xdbaa,0x142f,0x81a2,
+0x3ff0,0x0000,0x0000,0x0000,
+};
+static unsigned short PQ[28] = {
+0x3f42,0xb89b,0x1344,0x3d69,
+0x3fb1,0x9fdd,0x5948,0xaa83,
+0x3ff1,0xaea9,0xb850,0xeed6,
+0x4014,0x4ba2,0xf7d2,0x51a1,
+0x4020,0xccb9,0xdda2,0xfd65,
+0x4014,0xd6dd,0x4762,0xb4d9,
+0x3ff0,0x0000,0x0000,0x0000,
+};
+#endif
+
+#ifdef UNK
+static double QP[8] = {
+ 5.10862594750176621635E-2,
+ 4.98213872951233449420E0,
+ 7.58238284132545283818E1,
+ 3.66779609360150777800E2,
+ 7.10856304998926107277E2,
+ 5.97489612400613639965E2,
+ 2.11688757100572135698E2,
+ 2.52070205858023719784E1,
+};
+static double QQ[7] = {
+/* 1.00000000000000000000E0,*/
+ 7.42373277035675149943E1,
+ 1.05644886038262816351E3,
+ 4.98641058337653607651E3,
+ 9.56231892404756170795E3,
+ 7.99704160447350683650E3,
+ 2.82619278517639096600E3,
+ 3.36093607810698293419E2,
+};
+#endif
+#ifdef DEC
+static unsigned short QP[32] = {
+0037121,0037723,0055605,0151004,
+0040637,0066656,0031554,0077264,
+0041627,0122714,0153170,0161466,
+0042267,0061712,0036520,0140145,
+0042461,0133315,0131573,0071176,
+0042425,0057525,0147500,0013201,
+0042123,0130122,0061245,0154131,
+0041311,0123772,0064254,0172650,
+};
+static unsigned short QQ[28] = {
+/*0040200,0000000,0000000,0000000,*/
+0041624,0074603,0002112,0101670,
+0042604,0007135,0010162,0175565,
+0043233,0151510,0157757,0172010,
+0043425,0064506,0112006,0104276,
+0043371,0164125,0032271,0164242,
+0043060,0121425,0122750,0136013,
+0042250,0005773,0053472,0146267,
+};
+#endif
+#ifdef IBMPC
+static unsigned short QP[32] = {
+0xba40,0x6b70,0x27fa,0x3faa,
+0x8fd6,0xc66d,0xedb5,0x4013,
+0x1c67,0x9acf,0xf4b9,0x4052,
+0x180d,0x47aa,0xec79,0x4076,
+0x6e50,0xb66f,0x36d9,0x4086,
+0x02d0,0xb9e8,0xabea,0x4082,
+0xbb0b,0x4c54,0x760a,0x406a,
+0x9eb5,0x4d15,0x34ff,0x4039,
+};
+static unsigned short QQ[28] = {
+/*0x0000,0x0000,0x0000,0x3ff0,*/
+0x5077,0x6089,0x8f30,0x4052,
+0x5f6f,0xa20e,0x81cb,0x4090,
+0xfe81,0x1bfd,0x7a69,0x40b3,
+0xd118,0xd280,0xad28,0x40c2,
+0x3d14,0xa697,0x3d0a,0x40bf,
+0x1781,0xb4bd,0x1462,0x40a6,
+0x5997,0x6ae7,0x017f,0x4075,
+};
+#endif
+#ifdef MIEEE
+static unsigned short QP[32] = {
+0x3faa,0x27fa,0x6b70,0xba40,
+0x4013,0xedb5,0xc66d,0x8fd6,
+0x4052,0xf4b9,0x9acf,0x1c67,
+0x4076,0xec79,0x47aa,0x180d,
+0x4086,0x36d9,0xb66f,0x6e50,
+0x4082,0xabea,0xb9e8,0x02d0,
+0x406a,0x760a,0x4c54,0xbb0b,
+0x4039,0x34ff,0x4d15,0x9eb5,
+};
+static unsigned short QQ[28] = {
+/*0x3ff0,0x0000,0x0000,0x0000,*/
+0x4052,0x8f30,0x6089,0x5077,
+0x4090,0x81cb,0xa20e,0x5f6f,
+0x40b3,0x7a69,0x1bfd,0xfe81,
+0x40c2,0xad28,0xd280,0xd118,
+0x40bf,0x3d0a,0xa697,0x3d14,
+0x40a6,0x1462,0xb4bd,0x1781,
+0x4075,0x017f,0x6ae7,0x5997,
+};
+#endif
+
+#ifdef UNK
+static double YP[6] = {
+ 1.26320474790178026440E9,
+-6.47355876379160291031E11,
+ 1.14509511541823727583E14,
+-8.12770255501325109621E15,
+ 2.02439475713594898196E17,
+-7.78877196265950026825E17,
+};
+static double YQ[8] = {
+/* 1.00000000000000000000E0,*/
+ 5.94301592346128195359E2,
+ 2.35564092943068577943E5,
+ 7.34811944459721705660E7,
+ 1.87601316108706159478E10,
+ 3.88231277496238566008E12,
+ 6.20557727146953693363E14,
+ 6.87141087355300489866E16,
+ 3.97270608116560655612E18,
+};
+#endif
+#ifdef DEC
+static unsigned short YP[24] = {
+0047626,0112763,0013715,0133045,
+0152026,0134552,0142033,0024411,
+0053720,0045245,0102210,0077565,
+0155347,0000321,0136415,0102031,
+0056463,0146550,0055633,0032605,
+0157054,0171012,0167361,0054265,
+};
+static unsigned short YQ[32] = {
+/*0040200,0000000,0000000,0000000,*/
+0042424,0111515,0044773,0153014,
+0044546,0005405,0171307,0075774,
+0046614,0023575,0047105,0063556,
+0050613,0143034,0101533,0156026,
+0052541,0175367,0166514,0114257,
+0054415,0014466,0134350,0171154,
+0056164,0017436,0025075,0022101,
+0057534,0103614,0103663,0121772,
+};
+#endif
+#ifdef IBMPC
+static unsigned short YP[24] = {
+0xb6c5,0x62f9,0xd2be,0x41d2,
+0x6521,0x5883,0xd72d,0xc262,
+0x0fef,0xb091,0x0954,0x42da,
+0xb083,0x37a1,0xe01a,0xc33c,
+0x66b1,0x0b73,0x79ad,0x4386,
+0x2b17,0x5dde,0x9e41,0xc3a5,
+};
+static unsigned short YQ[32] = {
+/*0x0000,0x0000,0x0000,0x3ff0,*/
+0x7ac2,0xa93f,0x9269,0x4082,
+0xef7f,0xbe58,0xc160,0x410c,
+0xacee,0xa9c8,0x84ef,0x4191,
+0x7b83,0x906b,0x78c3,0x4211,
+0x9316,0xfda9,0x3f5e,0x428c,
+0x1e4e,0xd71d,0xa326,0x4301,
+0xa488,0xc547,0x83e3,0x436e,
+0x747f,0x90f6,0x90f1,0x43cb,
+};
+#endif
+#ifdef MIEEE
+static unsigned short YP[24] = {
+0x41d2,0xd2be,0x62f9,0xb6c5,
+0xc262,0xd72d,0x5883,0x6521,
+0x42da,0x0954,0xb091,0x0fef,
+0xc33c,0xe01a,0x37a1,0xb083,
+0x4386,0x79ad,0x0b73,0x66b1,
+0xc3a5,0x9e41,0x5dde,0x2b17,
+};
+static unsigned short YQ[32] = {
+/*0x3ff0,0x0000,0x0000,0x0000,*/
+0x4082,0x9269,0xa93f,0x7ac2,
+0x410c,0xc160,0xbe58,0xef7f,
+0x4191,0x84ef,0xa9c8,0xacee,
+0x4211,0x78c3,0x906b,0x7b83,
+0x428c,0x3f5e,0xfda9,0x9316,
+0x4301,0xa326,0xd71d,0x1e4e,
+0x436e,0x83e3,0xc547,0xa488,
+0x43cb,0x90f1,0x90f6,0x747f,
+};
+#endif
+
+
+#ifdef UNK
+static double Z1 = 1.46819706421238932572E1;
+static double Z2 = 4.92184563216946036703E1;
+#endif
+
+#ifdef DEC
+static unsigned short DZ1[] = {0041152,0164532,0006114,0010540};
+static unsigned short DZ2[] = {0041504,0157663,0001625,0020621};
+#define Z1 (*(double *)DZ1)
+#define Z2 (*(double *)DZ2)
+#endif
+
+#ifdef IBMPC
+static unsigned short DZ1[] = {0x822c,0x4189,0x5d2b,0x402d};
+static unsigned short DZ2[] = {0xa432,0x6072,0x9bf6,0x4048};
+#define Z1 (*(double *)DZ1)
+#define Z2 (*(double *)DZ2)
+#endif
+
+#ifdef MIEEE
+static unsigned short DZ1[] = {0x402d,0x5d2b,0x4189,0x822c};
+static unsigned short DZ2[] = {0x4048,0x9bf6,0x6072,0xa432};
+#define Z1 (*(double *)DZ1)
+#define Z2 (*(double *)DZ2)
+#endif
+
+#ifdef ANSIPROT
+extern double polevl ( double, void *, int );
+extern double p1evl ( double, void *, int );
+extern double log ( double );
+extern double sin ( double );
+extern double cos ( double );
+extern double sqrt ( double );
+double j1 ( double );
+#else
+double polevl(), p1evl(), log(), sin(), cos(), sqrt();
+double j1();
+#endif
+extern double TWOOPI, THPIO4, SQ2OPI;
+
+double j1(x)
+double x;
+{
+double w, z, p, q, xn;
+
+w = x;
+if( x < 0 )
+ w = -x;
+
+if( w <= 5.0 )
+ {
+ z = x * x;
+ w = polevl( z, RP, 3 ) / p1evl( z, RQ, 8 );
+ w = w * x * (z - Z1) * (z - Z2);
+ return( w );
+ }
+
+w = 5.0/x;
+z = w * w;
+p = polevl( z, PP, 6)/polevl( z, PQ, 6 );
+q = polevl( z, QP, 7)/p1evl( z, QQ, 7 );
+xn = x - THPIO4;
+p = p * cos(xn) - w * q * sin(xn);
+return( p * SQ2OPI / sqrt(x) );
+}
+
+
+extern double MAXNUM;
+
+double y1(x)
+double x;
+{
+double w, z, p, q, xn;
+
+if( x <= 5.0 )
+ {
+ if( x <= 0.0 )
+ {
+ mtherr( "y1", DOMAIN );
+ return( -MAXNUM );
+ }
+ z = x * x;
+ w = x * (polevl( z, YP, 5 ) / p1evl( z, YQ, 8 ));
+ w += TWOOPI * ( j1(x) * log(x) - 1.0/x );
+ return( w );
+ }
+
+w = 5.0/x;
+z = w * w;
+p = polevl( z, PP, 6)/polevl( z, PQ, 6 );
+q = polevl( z, QP, 7)/p1evl( z, QQ, 7 );
+xn = x - THPIO4;
+p = p * sin(xn) + w * q * cos(xn);
+return( p * SQ2OPI / sqrt(x) );
+}
diff --git a/libm/double/jn.c b/libm/double/jn.c
new file mode 100644
index 000000000..ee05395aa
--- /dev/null
+++ b/libm/double/jn.c
@@ -0,0 +1,133 @@
+/* jn.c
+ *
+ * Bessel function of integer order
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * int n;
+ * double x, y, jn();
+ *
+ * y = jn( 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
+ * DEC 0, 30 5500 6.9e-17 9.3e-18
+ * IEEE 0, 30 5000 4.4e-16 7.9e-17
+ *
+ *
+ * Not suitable for large n or x. Use jv() instead.
+ *
+ */
+
+/* jn.c
+Cephes Math Library Release 2.8: June, 2000
+Copyright 1984, 1987, 2000 by Stephen L. Moshier
+*/
+#include <math.h>
+#ifdef ANSIPROT
+extern double fabs ( double );
+extern double j0 ( double );
+extern double j1 ( double );
+#else
+double fabs(), j0(), j1();
+#endif
+extern double MACHEP;
+
+double jn( n, x )
+int n;
+double x;
+{
+double pkm2, pkm1, pk, xk, r, ans;
+int k, sign;
+
+if( n < 0 )
+ {
+ n = -n;
+ if( (n & 1) == 0 ) /* -1**n */
+ sign = 1;
+ else
+ sign = -1;
+ }
+else
+ sign = 1;
+
+if( x < 0.0 )
+ {
+ if( n & 1 )
+ sign = -sign;
+ x = -x;
+ }
+
+if( n == 0 )
+ return( sign * j0(x) );
+if( n == 1 )
+ return( sign * j1(x) );
+if( n == 2 )
+ return( sign * (2.0 * j1(x) / x - j0(x)) );
+
+if( x < MACHEP )
+ return( 0.0 );
+
+/* continued fraction */
+#ifdef DEC
+k = 56;
+#else
+k = 53;
+#endif
+
+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;
+k = n-1;
+r = 2 * k;
+
+do
+ {
+ pkm2 = (pkm1 * r - pk * x) / x;
+ pk = pkm1;
+ pkm1 = pkm2;
+ r -= 2.0;
+ }
+while( --k > 0 );
+
+if( fabs(pk) > fabs(pkm1) )
+ ans = j1(x)/pk;
+else
+ ans = j0(x)/pkm1;
+return( sign * ans );
+}
diff --git a/libm/double/jv.c b/libm/double/jv.c
new file mode 100644
index 000000000..5b8af3663
--- /dev/null
+++ b/libm/double/jv.c
@@ -0,0 +1,884 @@
+/* jv.c
+ *
+ * Bessel function of noninteger order
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double v, x, y, jv();
+ *
+ * y = jv( 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 transitional expansions give 12D accuracy for v > 500.
+ *
+ *
+ *
+ * ACCURACY:
+ * Results for integer v are indicated by *, where x and v
+ * both vary from -125 to +125. Otherwise,
+ * x ranges from 0 to 125, v ranges as indicated by "domain."
+ * Error criterion is absolute, except relative when |jv()| > 1.
+ *
+ * arithmetic v domain x domain # trials peak rms
+ * IEEE 0,125 0,125 100000 4.6e-15 2.2e-16
+ * IEEE -125,0 0,125 40000 5.4e-11 3.7e-13
+ * IEEE 0,500 0,500 20000 4.4e-15 4.0e-16
+ * Integer v:
+ * IEEE -125,125 -125,125 50000 3.5e-15* 1.9e-16*
+ *
+ */
+
+
+/*
+Cephes Math Library Release 2.8: June, 2000
+Copyright 1984, 1987, 1989, 1992, 2000 by Stephen L. Moshier
+*/
+
+
+#include <math.h>
+#define DEBUG 0
+
+#ifdef DEC
+#define MAXGAM 34.84425627277176174
+#else
+#define MAXGAM 171.624376956302725
+#endif
+
+#ifdef ANSIPROT
+extern int airy ( double, double *, double *, double *, double * );
+extern double fabs ( double );
+extern double floor ( double );
+extern double frexp ( double, int * );
+extern double polevl ( double, void *, int );
+extern double j0 ( double );
+extern double j1 ( double );
+extern double sqrt ( double );
+extern double cbrt ( double );
+extern double exp ( double );
+extern double log ( double );
+extern double sin ( double );
+extern double cos ( double );
+extern double acos ( double );
+extern double pow ( double, double );
+extern double gamma ( double );
+extern double lgam ( double );
+static double recur(double *, double, double *, int);
+static double jvs(double, double);
+static double hankel(double, double);
+static double jnx(double, double);
+static double jnt(double, double);
+#else
+int airy();
+double fabs(), floor(), frexp(), polevl(), j0(), j1(), sqrt(), cbrt();
+double exp(), log(), sin(), cos(), acos(), pow(), gamma(), lgam();
+static double recur(), jvs(), hankel(), jnx(), jnt();
+#endif
+
+extern double MAXNUM, MACHEP, MINLOG, MAXLOG;
+#define BIG 1.44115188075855872E+17
+
+double jv( n, x )
+double n, x;
+{
+double k, q, t, y, an;
+int i, sign, nint;
+
+nint = 0; /* Flag for integer n */
+sign = 1; /* Flag for sign inversion */
+an = fabs( n );
+y = floor( an );
+if( y == an )
+ {
+ nint = 1;
+ i = an - 16384.0 * floor( 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( j0(x) );
+ if( n == 1.0 )
+ return( sign * j1(x) );
+ }
+
+if( (x < 0.0) && (y != an) )
+ {
+ mtherr( "Jv", DOMAIN );
+ y = 0.0;
+ goto done;
+ }
+
+y = fabs(x);
+
+if( y < MACHEP )
+ goto underf;
+
+k = 3.6 * sqrt(y);
+t = 3.6 * sqrt(an);
+if( (y < t) && (an > 21.0) )
+ return( sign * jvs(n,x) );
+if( (an < k) && (y > 21.0) )
+ return( sign * hankel(n,x) );
+
+if( an < 500.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 = recur( &n, x, &k, 1 );
+ if( k == 0.0 )
+ {
+ y = j0(x)/q;
+ goto done;
+ }
+ if( k == 1.0 )
+ {
+ y = j1(x)/q;
+ goto done;
+ }
+ }
+
+if( an > 2.0 * y )
+ goto rlarger;
+
+ if( (n >= 0.0) && (n < 20.0)
+ && (y > 6.0) && (y < 20.0) )
+ {
+/* Recur backwards from a larger value of n
+ */
+rlarger:
+ k = n;
+
+ y = y + an + 1.0;
+ if( y < 30.0 )
+ y = 30.0;
+ y = n + floor(y-n);
+ q = recur( &y, x, &k, 0 );
+ y = jvs(y,x) * q;
+ goto done;
+ }
+
+ if( k <= 30.0 )
+ {
+ k = 2.0;
+ }
+ else if( k < 90.0 )
+ {
+ k = (3*k)/4;
+ }
+ if( an > (k + 3.0) )
+ {
+ if( n < 0.0 )
+ k = -k;
+ q = n - floor(n);
+ k = floor(k) + q;
+ if( n > 0.0 )
+ q = recur( &n, x, &k, 1 );
+ else
+ {
+ t = k;
+ k = n;
+ q = recur( &t, x, &k, 1 );
+ 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
+ */
+ y = fabs(k);
+ if( y < 26.0 )
+ t = (0.0083*y + 0.09)*y + 12.9;
+ else
+ t = 0.9 * y;
+
+ if( x > t )
+ y = hankel(k,x);
+ else
+ y = jvs(k,x);
+#if DEBUG
+printf( "y = %.16e, recur q = %.16e\n", y, q );
+#endif
+ if( n > 0.0 )
+ y /= q;
+ else
+ y *= q;
+ }
+
+else
+ {
+/* For large 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( "Jv", TLOSS );
+ y = 0.0;
+ goto done;
+ }
+ t = x/n;
+ t /= n;
+ if( t > 0.3 )
+ y = hankel(n,x);
+ else
+ y = jnx(n,x);
+ }
+
+done: return( sign * y);
+}
+
+/* Reduce the order by backward recurrence.
+ * AMS55 #9.1.27 and 9.1.73.
+ */
+
+static double recur( n, x, newn, cancel )
+double *n;
+double x;
+double *newn;
+int cancel;
+{
+double pkm2, pkm1, pk, qkm2, qkm1;
+/* double pkp1; */
+double k, ans, qk, xk, yk, r, t, kf;
+static double big = BIG;
+int nflag, ctr;
+
+/* continued fraction for Jn(x)/Jn-1(x) */
+if( *n < 0.0 )
+ nflag = 1;
+else
+ nflag = 0;
+
+fstart:
+
+#if DEBUG
+printf( "recur: 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 = fabs( (ans - r)/r );
+ ans = r;
+ }
+ else
+ t = 1.0;
+
+ if( ++ctr > 1000 )
+ {
+ mtherr( "jv", UNDERFLOW );
+ goto done;
+ }
+ if( t < MACHEP )
+ goto done;
+
+ if( fabs(pk) > big )
+ {
+ pkm2 /= big;
+ pkm1 /= big;
+ qkm2 /= big;
+ qkm1 /= big;
+ }
+ }
+while( t > MACHEP );
+
+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( fabs(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;
+do
+ {
+ pkm2 = (pkm1 * r - pk * x) / x;
+ /* pkp1 = pk; */
+ pk = pkm1;
+ pkm1 = pkm2;
+ r -= 2.0;
+/*
+ t = fabs(pkp1) + fabs(pk);
+ if( (k > (kf + 2.5)) && (fabs(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;
+ }
+*/
+ k -= 1.0;
+ }
+while( k > (kf + 0.5) );
+
+/* Take the larger of the last two iterates
+ * on the theory that it may have less cancellation error.
+ */
+
+if( cancel )
+ {
+ if( (kf >= 0.0) && (fabs(pk) > fabs(pkm1)) )
+ {
+ k += 1.0;
+ pkm2 = pk;
+ }
+ }
+*newn = k;
+#if DEBUG
+printf( "newn %.6e rans %.6e\n", k, pkm2 );
+#endif
+return( pkm2 );
+}
+
+
+
+/* Ascending power series for Jv(x).
+ * AMS55 #9.1.10.
+ */
+
+extern double PI;
+extern int sgngam;
+
+static double jvs( n, x )
+double n, x;
+{
+double t, u, y, z, k;
+int ex;
+
+z = -x * x / 4.0;
+u = 1.0;
+y = u;
+k = 1.0;
+t = 1.0;
+
+while( t > MACHEP )
+ {
+ u *= z / (k * (n+k));
+ y += u;
+ k += 1.0;
+ if( y != 0 )
+ t = fabs( u/y );
+ }
+#if DEBUG
+printf( "power series=%.5e ", y );
+#endif
+t = frexp( 0.5*x, &ex );
+ex = ex * n;
+if( (ex > -1023)
+ && (ex < 1023)
+ && (n > 0.0)
+ && (n < (MAXGAM-1.0)) )
+ {
+ t = pow( 0.5*x, n ) / gamma( n + 1.0 );
+#if DEBUG
+printf( "pow(.5*x, %.4e)/gamma(n+1)=%.5e\n", n, t );
+#endif
+ y *= t;
+ }
+else
+ {
+#if DEBUG
+ z = n * log(0.5*x);
+ k = lgam( n+1.0 );
+ t = z - k;
+ printf( "log pow=%.5e, lgam(%.4e)=%.5e\n", z, n+1.0, k );
+#else
+ t = n * log(0.5*x) - lgam(n + 1.0);
+#endif
+ if( y < 0 )
+ {
+ sgngam = -sgngam;
+ y = -y;
+ }
+ t += log(y);
+#if DEBUG
+printf( "log y=%.5e\n", log(y) );
+#endif
+ if( t < -MAXLOG )
+ {
+ return( 0.0 );
+ }
+ if( t > MAXLOG )
+ {
+ mtherr( "Jv", OVERFLOW );
+ return( MAXNUM );
+ }
+ y = sgngam * exp( t );
+ }
+return(y);
+}
+
+/* Hankel's asymptotic expansion
+ * for large x.
+ * AMS55 #9.2.5.
+ */
+
+static double hankel( n, x )
+double n, x;
+{
+double t, u, z, k, sign, conv;
+double p, q, j, m, pp, qq;
+int flag;
+
+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 > MACHEP )
+ {
+ 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 = fabs(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) * PI;
+t = sqrt( 2.0/(PI*x) ) * ( pp * cos(u) - qq * sin(u) );
+#if DEBUG
+printf( "hank: %.6e\n", t );
+#endif
+return( t );
+}
+
+
+/* Asymptotic expansion for large n.
+ * AMS55 #9.3.35.
+ */
+
+static double 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 double 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 double P1[] = {
+ -2.083333333333333333333333E-1,
+ 1.250000000000000000000000E-1
+};
+static double P2[] = {
+ 3.342013888888888888888889E-1,
+ -4.010416666666666666666667E-1,
+ 7.031250000000000000000000E-2
+};
+static double P3[] = {
+ -1.025812596450617283950617E+0,
+ 1.846462673611111111111111E+0,
+ -8.912109375000000000000000E-1,
+ 7.324218750000000000000000E-2
+};
+static double P4[] = {
+ 4.669584423426247427983539E+0,
+ -1.120700261622299382716049E+1,
+ 8.789123535156250000000000E+0,
+ -2.364086914062500000000000E+0,
+ 1.121520996093750000000000E-1
+};
+static double P5[] = {
+ -2.8212072558200244877E1,
+ 8.4636217674600734632E1,
+ -9.1818241543240017361E1,
+ 4.2534998745388454861E1,
+ -7.3687943594796316964E0,
+ 2.27108001708984375E-1
+};
+static double P6[] = {
+ 2.1257013003921712286E2,
+ -7.6525246814118164230E2,
+ 1.0599904525279998779E3,
+ -6.9957962737613254123E2,
+ 2.1819051174421159048E2,
+ -2.6491430486951555525E1,
+ 5.7250142097473144531E-1
+};
+static double P7[] = {
+ -1.9194576623184069963E3,
+ 8.0617221817373093845E3,
+ -1.3586550006434137439E4,
+ 1.1655393336864533248E4,
+ -5.3056469786134031084E3,
+ 1.2009029132163524628E3,
+ -1.0809091978839465550E2,
+ 1.7277275025844573975E0
+};
+
+
+static double jnx( n, x )
+double n, x;
+{
+double zeta, sqz, zz, zp, np;
+double cbn, n23, t, z, sz;
+double pp, qq, z32i, zzi;
+double ak, bk, akl, bkl;
+int sign, doa, dob, nflg, k, s, tk, tkp1, m;
+static double u[8];
+static double ai, aip, bi, bip;
+
+/* Test for x very close to n.
+ * Use expansion for transition region if so.
+ */
+cbn = cbrt(n);
+z = (x - n)/cbn;
+if( fabs(z) <= 0.7 )
+ return( jnt(n,x) );
+
+z = x/n;
+zz = 1.0 - z*z;
+if( zz == 0.0 )
+ return(0.0);
+
+if( zz > 0.0 )
+ {
+ sz = sqrt( zz );
+ t = 1.5 * (log( (1.0+sz)/z ) - sz ); /* zeta ** 3/2 */
+ zeta = cbrt( t * t );
+ nflg = 1;
+ }
+else
+ {
+ sz = sqrt(-zz);
+ t = 1.5 * (sz - acos(1.0/z));
+ zeta = -cbrt( t * t );
+ nflg = -1;
+ }
+z32i = fabs(1.0/t);
+sqz = cbrt(t);
+
+/* Airy function */
+n23 = cbrt( n * n );
+t = n23 * zeta;
+
+#if DEBUG
+printf("zeta %.5E, Airy(%.5E)\n", zeta, t );
+#endif
+airy( t, &ai, &aip, &bi, &bip );
+
+/* polynomials in expansion */
+u[0] = 1.0;
+zzi = 1.0/zz;
+u[1] = polevl( zzi, P1, 1 )/sz;
+u[2] = polevl( zzi, P2, 2 )/zz;
+u[3] = polevl( zzi, P3, 3 )/(sz*zz);
+pp = zz*zz;
+u[4] = polevl( zzi, P4, 4 )/pp;
+u[5] = polevl( zzi, P5, 5 )/(pp*sz);
+pp *= zz;
+u[6] = polevl( zzi, P6, 6 )/pp;
+u[7] = polevl( 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 = MAXNUM;
+bkl = MAXNUM;
+
+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 = fabs(ak);
+ if( t < akl )
+ {
+ akl = t;
+ pp += ak;
+ }
+ else
+ doa = 0;
+ }
+
+ if( dob )
+ {
+ bk += lambda[tkp1] * zp * u[0];
+ bk *= -np/sqz;
+ t = fabs(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 < MACHEP )
+ break;
+ np /= n*n;
+ }
+
+/* normalizing factor ( 4*zeta/(1 - z**2) )**1/4 */
+t = 4.0 * zeta/zz;
+t = sqrt( sqrt(t) );
+
+t *= ai*pp/cbrt(n) + aip*qq/(n23*n);
+return(t);
+}
+
+/* Asymptotic expansion for transition region,
+ * n large and x close to n.
+ * AMS55 #9.3.23.
+ */
+
+static double PF2[] = {
+ -9.0000000000000000000e-2,
+ 8.5714285714285714286e-2
+};
+static double PF3[] = {
+ 1.3671428571428571429e-1,
+ -5.4920634920634920635e-2,
+ -4.4444444444444444444e-3
+};
+static double PF4[] = {
+ 1.3500000000000000000e-3,
+ -1.6036054421768707483e-1,
+ 4.2590187590187590188e-2,
+ 2.7330447330447330447e-3
+};
+static double PG1[] = {
+ -2.4285714285714285714e-1,
+ 1.4285714285714285714e-2
+};
+static double PG2[] = {
+ -9.0000000000000000000e-3,
+ 1.9396825396825396825e-1,
+ -1.1746031746031746032e-2
+};
+static double PG3[] = {
+ 1.9607142857142857143e-2,
+ -1.5983694083694083694e-1,
+ 6.3838383838383838384e-3
+};
+
+
+static double jnt( n, x )
+double n, x;
+{
+double z, zz, z3;
+double cbn, n23, cbtwo;
+double ai, aip, bi, bip; /* Airy functions */
+double nk, fk, gk, pp, qq;
+double F[5], G[4];
+int k;
+
+cbn = cbrt(n);
+z = (x - n)/cbn;
+cbtwo = cbrt( 2.0 );
+
+/* Airy function */
+zz = -cbtwo * z;
+airy( 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] = polevl( z3, PF2, 1 ) * zz;
+F[3] = polevl( z3, PF3, 2 );
+F[4] = polevl( z3, PF4, 3 ) * z;
+G[0] = 0.3 * zz;
+G[1] = polevl( z3, PG1, 1 );
+G[2] = polevl( z3, PG2, 2 ) * z;
+G[3] = polevl( 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 = cbrt( 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 + cbrt(4.0) * aip * qq/n;
+return(fk);
+}
diff --git a/libm/double/k0.c b/libm/double/k0.c
new file mode 100644
index 000000000..7d09cb4a1
--- /dev/null
+++ b/libm/double/k0.c
@@ -0,0 +1,333 @@
+/* k0.c
+ *
+ * Modified Bessel function, third kind, order zero
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, k0();
+ *
+ * y = k0( 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
+ * DEC 0, 30 3100 1.3e-16 2.1e-17
+ * IEEE 0, 30 30000 1.2e-15 1.6e-16
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * K0 domain x <= 0 MAXNUM
+ *
+ */
+ /* k0e()
+ *
+ * Modified Bessel function, third kind, order zero,
+ * exponentially scaled
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, k0e();
+ *
+ * y = k0e( 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 1.4e-15 1.4e-16
+ * See k0().
+ *
+ */
+
+/*
+Cephes Math Library Release 2.8: June, 2000
+Copyright 1984, 1987, 2000 by Stephen L. Moshier
+*/
+
+#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.
+ */
+
+#ifdef UNK
+static double A[] =
+{
+ 1.37446543561352307156E-16,
+ 4.25981614279661018399E-14,
+ 1.03496952576338420167E-11,
+ 1.90451637722020886025E-9,
+ 2.53479107902614945675E-7,
+ 2.28621210311945178607E-5,
+ 1.26461541144692592338E-3,
+ 3.59799365153615016266E-2,
+ 3.44289899924628486886E-1,
+-5.35327393233902768720E-1
+};
+#endif
+
+#ifdef DEC
+static unsigned short A[] = {
+0023036,0073417,0032477,0165673,
+0025077,0154126,0016046,0012517,
+0027066,0011342,0035211,0005041,
+0031002,0160233,0037454,0050224,
+0032610,0012747,0037712,0173741,
+0034277,0144007,0172147,0162375,
+0035645,0140563,0125431,0165626,
+0037023,0057662,0125124,0102051,
+0037660,0043304,0004411,0166707,
+0140011,0005467,0047227,0130370
+};
+#endif
+
+#ifdef IBMPC
+static unsigned short A[] = {
+0xfd77,0xe6a7,0xcee1,0x3ca3,
+0xc2aa,0xc384,0xfb0a,0x3d27,
+0x2144,0x4751,0xc25c,0x3da6,
+0x8a13,0x67e5,0x5c13,0x3e20,
+0x5efc,0xe7f9,0x02bc,0x3e91,
+0xfca0,0xfe8c,0xf900,0x3ef7,
+0x3d73,0x7563,0xb82e,0x3f54,
+0x9085,0x554a,0x6bf6,0x3fa2,
+0x3db9,0x8121,0x08d8,0x3fd6,
+0xf61f,0xe9d2,0x2166,0xbfe1
+};
+#endif
+
+#ifdef MIEEE
+static unsigned short A[] = {
+0x3ca3,0xcee1,0xe6a7,0xfd77,
+0x3d27,0xfb0a,0xc384,0xc2aa,
+0x3da6,0xc25c,0x4751,0x2144,
+0x3e20,0x5c13,0x67e5,0x8a13,
+0x3e91,0x02bc,0xe7f9,0x5efc,
+0x3ef7,0xf900,0xfe8c,0xfca0,
+0x3f54,0xb82e,0x7563,0x3d73,
+0x3fa2,0x6bf6,0x554a,0x9085,
+0x3fd6,0x08d8,0x8121,0x3db9,
+0xbfe1,0x2166,0xe9d2,0xf61f
+};
+#endif
+
+
+
+/* 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).
+ */
+
+#ifdef UNK
+static double B[] = {
+ 5.30043377268626276149E-18,
+-1.64758043015242134646E-17,
+ 5.21039150503902756861E-17,
+-1.67823109680541210385E-16,
+ 5.51205597852431940784E-16,
+-1.84859337734377901440E-15,
+ 6.34007647740507060557E-15,
+-2.22751332699166985548E-14,
+ 8.03289077536357521100E-14,
+-2.98009692317273043925E-13,
+ 1.14034058820847496303E-12,
+-4.51459788337394416547E-12,
+ 1.85594911495471785253E-11,
+-7.95748924447710747776E-11,
+ 3.57739728140030116597E-10,
+-1.69753450938905987466E-9,
+ 8.57403401741422608519E-9,
+-4.66048989768794782956E-8,
+ 2.76681363944501510342E-7,
+-1.83175552271911948767E-6,
+ 1.39498137188764993662E-5,
+-1.28495495816278026384E-4,
+ 1.56988388573005337491E-3,
+-3.14481013119645005427E-2,
+ 2.44030308206595545468E0
+};
+#endif
+
+#ifdef DEC
+static unsigned short B[] = {
+0021703,0106456,0076144,0173406,
+0122227,0173144,0116011,0030033,
+0022560,0044562,0006506,0067642,
+0123101,0076243,0123273,0131013,
+0023436,0157713,0056243,0141331,
+0124005,0032207,0063726,0164664,
+0024344,0066342,0051756,0162300,
+0124710,0121365,0154053,0077022,
+0025264,0161166,0066246,0077420,
+0125647,0141671,0006443,0103212,
+0026240,0076431,0077147,0160445,
+0126636,0153741,0174002,0105031,
+0027243,0040102,0035375,0163073,
+0127656,0176256,0113476,0044653,
+0030304,0125544,0006377,0130104,
+0130751,0047257,0110537,0127324,
+0031423,0046400,0014772,0012164,
+0132110,0025240,0155247,0112570,
+0032624,0105314,0007437,0021574,
+0133365,0155243,0174306,0116506,
+0034152,0004776,0061643,0102504,
+0135006,0136277,0036104,0175023,
+0035715,0142217,0162474,0115022,
+0137000,0147671,0065177,0134356,
+0040434,0026754,0175163,0044070
+};
+#endif
+
+#ifdef IBMPC
+static unsigned short B[] = {
+0x9ee1,0xcf8c,0x71a5,0x3c58,
+0x2603,0x9381,0xfecc,0xbc72,
+0xcdf4,0x41a8,0x092e,0x3c8e,
+0x7641,0x74d7,0x2f94,0xbca8,
+0x785b,0x6b94,0xdbf9,0x3cc3,
+0xdd36,0xecfa,0xa690,0xbce0,
+0xdc98,0x4a7d,0x8d9c,0x3cfc,
+0x6fc2,0xbb05,0x145e,0xbd19,
+0xcfe2,0xcd94,0x9c4e,0x3d36,
+0x70d1,0x21a4,0xf877,0xbd54,
+0xfc25,0x2fcc,0x0fa3,0x3d74,
+0x5143,0x3f00,0xdafc,0xbd93,
+0xbcc7,0x475f,0x6808,0x3db4,
+0xc935,0xd2e7,0xdf95,0xbdd5,
+0xf608,0x819f,0x956c,0x3df8,
+0xf5db,0xf22b,0x29d5,0xbe1d,
+0x428e,0x033f,0x69a0,0x3e42,
+0xf2af,0x1b54,0x0554,0xbe69,
+0xe46f,0x81e3,0x9159,0x3e92,
+0xd3a9,0x7f18,0xbb54,0xbebe,
+0x70a9,0xcc74,0x413f,0x3eed,
+0x9f42,0xe788,0xd797,0xbf20,
+0x9342,0xfca7,0xb891,0x3f59,
+0xf71e,0x2d4f,0x19f7,0xbfa0,
+0x6907,0x9f4e,0x85bd,0x4003
+};
+#endif
+
+#ifdef MIEEE
+static unsigned short B[] = {
+0x3c58,0x71a5,0xcf8c,0x9ee1,
+0xbc72,0xfecc,0x9381,0x2603,
+0x3c8e,0x092e,0x41a8,0xcdf4,
+0xbca8,0x2f94,0x74d7,0x7641,
+0x3cc3,0xdbf9,0x6b94,0x785b,
+0xbce0,0xa690,0xecfa,0xdd36,
+0x3cfc,0x8d9c,0x4a7d,0xdc98,
+0xbd19,0x145e,0xbb05,0x6fc2,
+0x3d36,0x9c4e,0xcd94,0xcfe2,
+0xbd54,0xf877,0x21a4,0x70d1,
+0x3d74,0x0fa3,0x2fcc,0xfc25,
+0xbd93,0xdafc,0x3f00,0x5143,
+0x3db4,0x6808,0x475f,0xbcc7,
+0xbdd5,0xdf95,0xd2e7,0xc935,
+0x3df8,0x956c,0x819f,0xf608,
+0xbe1d,0x29d5,0xf22b,0xf5db,
+0x3e42,0x69a0,0x033f,0x428e,
+0xbe69,0x0554,0x1b54,0xf2af,
+0x3e92,0x9159,0x81e3,0xe46f,
+0xbebe,0xbb54,0x7f18,0xd3a9,
+0x3eed,0x413f,0xcc74,0x70a9,
+0xbf20,0xd797,0xe788,0x9f42,
+0x3f59,0xb891,0xfca7,0x9342,
+0xbfa0,0x19f7,0x2d4f,0xf71e,
+0x4003,0x85bd,0x9f4e,0x6907
+};
+#endif
+
+/* k0.c */
+#ifdef ANSIPROT
+extern double chbevl ( double, void *, int );
+extern double exp ( double );
+extern double i0 ( double );
+extern double log ( double );
+extern double sqrt ( double );
+#else
+double chbevl(), exp(), i0(), log(), sqrt();
+#endif
+extern double PI;
+extern double MAXNUM;
+
+double k0(x)
+double x;
+{
+double y, z;
+
+if( x <= 0.0 )
+ {
+ mtherr( "k0", DOMAIN );
+ return( MAXNUM );
+ }
+
+if( x <= 2.0 )
+ {
+ y = x * x - 2.0;
+ y = chbevl( y, A, 10 ) - log( 0.5 * x ) * i0(x);
+ return( y );
+ }
+z = 8.0/x - 2.0;
+y = exp(-x) * chbevl( z, B, 25 ) / sqrt(x);
+return(y);
+}
+
+
+
+
+double k0e( x )
+double x;
+{
+double y;
+
+if( x <= 0.0 )
+ {
+ mtherr( "k0e", DOMAIN );
+ return( MAXNUM );
+ }
+
+if( x <= 2.0 )
+ {
+ y = x * x - 2.0;
+ y = chbevl( y, A, 10 ) - log( 0.5 * x ) * i0(x);
+ return( y * exp(x) );
+ }
+
+y = chbevl( 8.0/x - 2.0, B, 25 ) / sqrt(x);
+return(y);
+}
diff --git a/libm/double/k1.c b/libm/double/k1.c
new file mode 100644
index 000000000..a96305355
--- /dev/null
+++ b/libm/double/k1.c
@@ -0,0 +1,335 @@
+/* k1.c
+ *
+ * Modified Bessel function, third kind, order one
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, k1();
+ *
+ * y = k1( 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
+ * DEC 0, 30 3300 8.9e-17 2.2e-17
+ * IEEE 0, 30 30000 1.2e-15 1.6e-16
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * k1 domain x <= 0 MAXNUM
+ *
+ */
+ /* k1e.c
+ *
+ * Modified Bessel function, third kind, order one,
+ * exponentially scaled
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, k1e();
+ *
+ * y = k1e( 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 7.8e-16 1.2e-16
+ * See k1().
+ *
+ */
+
+/*
+Cephes Math Library Release 2.8: June, 2000
+Copyright 1984, 1987, 2000 by Stephen L. Moshier
+*/
+
+#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.
+ */
+
+#ifdef UNK
+static double A[] =
+{
+-7.02386347938628759343E-18,
+-2.42744985051936593393E-15,
+-6.66690169419932900609E-13,
+-1.41148839263352776110E-10,
+-2.21338763073472585583E-8,
+-2.43340614156596823496E-6,
+-1.73028895751305206302E-4,
+-6.97572385963986435018E-3,
+-1.22611180822657148235E-1,
+-3.53155960776544875667E-1,
+ 1.52530022733894777053E0
+};
+#endif
+
+#ifdef DEC
+static unsigned short A[] = {
+0122001,0110501,0164746,0151255,
+0124056,0165213,0150034,0147377,
+0126073,0124026,0167207,0001044,
+0130033,0030735,0141061,0033116,
+0131676,0020350,0121341,0107175,
+0133443,0046631,0062031,0070716,
+0135065,0067427,0026435,0164022,
+0136344,0112234,0165752,0006222,
+0137373,0015622,0017016,0155636,
+0137664,0150333,0125730,0067240,
+0040303,0036411,0130200,0043120
+};
+#endif
+
+#ifdef IBMPC
+static unsigned short A[] = {
+0xda56,0x3d3c,0x3228,0xbc60,
+0x99e0,0x7a03,0xdd51,0xbce5,
+0xe045,0xddd0,0x7502,0xbd67,
+0x26ca,0xb846,0x663b,0xbde3,
+0x31d0,0x145c,0xc41d,0xbe57,
+0x2e3a,0x2c83,0x69b3,0xbec4,
+0xbd02,0xe5a3,0xade2,0xbf26,
+0x4192,0x9d7d,0x9293,0xbf7c,
+0xdb74,0x43c1,0x6372,0xbfbf,
+0x0dd4,0x757b,0x9a1b,0xbfd6,
+0x08ca,0x3610,0x67a1,0x3ff8
+};
+#endif
+
+#ifdef MIEEE
+static unsigned short A[] = {
+0xbc60,0x3228,0x3d3c,0xda56,
+0xbce5,0xdd51,0x7a03,0x99e0,
+0xbd67,0x7502,0xddd0,0xe045,
+0xbde3,0x663b,0xb846,0x26ca,
+0xbe57,0xc41d,0x145c,0x31d0,
+0xbec4,0x69b3,0x2c83,0x2e3a,
+0xbf26,0xade2,0xe5a3,0xbd02,
+0xbf7c,0x9293,0x9d7d,0x4192,
+0xbfbf,0x6372,0x43c1,0xdb74,
+0xbfd6,0x9a1b,0x757b,0x0dd4,
+0x3ff8,0x67a1,0x3610,0x08ca
+};
+#endif
+
+
+
+/* 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).
+ */
+
+#ifdef UNK
+static double B[] =
+{
+-5.75674448366501715755E-18,
+ 1.79405087314755922667E-17,
+-5.68946255844285935196E-17,
+ 1.83809354436663880070E-16,
+-6.05704724837331885336E-16,
+ 2.03870316562433424052E-15,
+-7.01983709041831346144E-15,
+ 2.47715442448130437068E-14,
+-8.97670518232499435011E-14,
+ 3.34841966607842919884E-13,
+-1.28917396095102890680E-12,
+ 5.13963967348173025100E-12,
+-2.12996783842756842877E-11,
+ 9.21831518760500529508E-11,
+-4.19035475934189648750E-10,
+ 2.01504975519703286596E-9,
+-1.03457624656780970260E-8,
+ 5.74108412545004946722E-8,
+-3.50196060308781257119E-7,
+ 2.40648494783721712015E-6,
+-1.93619797416608296024E-5,
+ 1.95215518471351631108E-4,
+-2.85781685962277938680E-3,
+ 1.03923736576817238437E-1,
+ 2.72062619048444266945E0
+};
+#endif
+
+#ifdef DEC
+static unsigned short B[] = {
+0121724,0061352,0013041,0150076,
+0022245,0074324,0016172,0173232,
+0122603,0030250,0135670,0165221,
+0023123,0165362,0023561,0060124,
+0123456,0112436,0141654,0073623,
+0024022,0163557,0077564,0006753,
+0124374,0165221,0131014,0026524,
+0024737,0017512,0144250,0175451,
+0125312,0021456,0123136,0076633,
+0025674,0077720,0020125,0102607,
+0126265,0067543,0007744,0043701,
+0026664,0152702,0033002,0074202,
+0127273,0055234,0120016,0071733,
+0027712,0133200,0042441,0075515,
+0130346,0057000,0015456,0074470,
+0031012,0074441,0051636,0111155,
+0131461,0136444,0177417,0002101,
+0032166,0111743,0032176,0021410,
+0132674,0001224,0076555,0027060,
+0033441,0077430,0135226,0106663,
+0134242,0065610,0167155,0113447,
+0035114,0131304,0043664,0102163,
+0136073,0045065,0171465,0122123,
+0037324,0152767,0147401,0017732,
+0040456,0017275,0050061,0062120,
+};
+#endif
+
+#ifdef IBMPC
+static unsigned short B[] = {
+0x3a08,0x42c4,0x8c5d,0xbc5a,
+0x5ed3,0x838f,0xaf1a,0x3c74,
+0x1d52,0x1777,0x6615,0xbc90,
+0x2c0b,0x44ee,0x7d5e,0x3caa,
+0x8ef2,0xd875,0xd2a3,0xbcc5,
+0x81bd,0xefee,0x5ced,0x3ce2,
+0x85ab,0x3641,0x9d52,0xbcff,
+0x1f65,0x5915,0xe3e9,0x3d1b,
+0xcfb3,0xd4cb,0x4465,0xbd39,
+0xb0b1,0x040a,0x8ffa,0x3d57,
+0x88f8,0x61fc,0xadec,0xbd76,
+0x4f10,0x46c0,0x9ab8,0x3d96,
+0xce7b,0x9401,0x6b53,0xbdb7,
+0x2f6a,0x08a4,0x56d0,0x3dd9,
+0xcf27,0x0365,0xcbc0,0xbdfc,
+0xd24e,0x2a73,0x4f24,0x3e21,
+0xe088,0x9fe1,0x37a4,0xbe46,
+0xc461,0x668f,0xd27c,0x3e6e,
+0xa5c6,0x8fad,0x8052,0xbe97,
+0xd1b6,0x1752,0x2fe3,0x3ec4,
+0xb2e5,0x1dcd,0x4d71,0xbef4,
+0x908e,0x88f6,0x9658,0x3f29,
+0xb48a,0xbe66,0x6946,0xbf67,
+0x23fb,0xf9e0,0x9abe,0x3fba,
+0x2c8a,0xaa06,0xc3d7,0x4005
+};
+#endif
+
+#ifdef MIEEE
+static unsigned short B[] = {
+0xbc5a,0x8c5d,0x42c4,0x3a08,
+0x3c74,0xaf1a,0x838f,0x5ed3,
+0xbc90,0x6615,0x1777,0x1d52,
+0x3caa,0x7d5e,0x44ee,0x2c0b,
+0xbcc5,0xd2a3,0xd875,0x8ef2,
+0x3ce2,0x5ced,0xefee,0x81bd,
+0xbcff,0x9d52,0x3641,0x85ab,
+0x3d1b,0xe3e9,0x5915,0x1f65,
+0xbd39,0x4465,0xd4cb,0xcfb3,
+0x3d57,0x8ffa,0x040a,0xb0b1,
+0xbd76,0xadec,0x61fc,0x88f8,
+0x3d96,0x9ab8,0x46c0,0x4f10,
+0xbdb7,0x6b53,0x9401,0xce7b,
+0x3dd9,0x56d0,0x08a4,0x2f6a,
+0xbdfc,0xcbc0,0x0365,0xcf27,
+0x3e21,0x4f24,0x2a73,0xd24e,
+0xbe46,0x37a4,0x9fe1,0xe088,
+0x3e6e,0xd27c,0x668f,0xc461,
+0xbe97,0x8052,0x8fad,0xa5c6,
+0x3ec4,0x2fe3,0x1752,0xd1b6,
+0xbef4,0x4d71,0x1dcd,0xb2e5,
+0x3f29,0x9658,0x88f6,0x908e,
+0xbf67,0x6946,0xbe66,0xb48a,
+0x3fba,0x9abe,0xf9e0,0x23fb,
+0x4005,0xc3d7,0xaa06,0x2c8a
+};
+#endif
+
+#ifdef ANSIPROT
+extern double chbevl ( double, void *, int );
+extern double exp ( double );
+extern double i1 ( double );
+extern double log ( double );
+extern double sqrt ( double );
+#else
+double chbevl(), exp(), i1(), log(), sqrt();
+#endif
+extern double PI;
+extern double MINLOG, MAXNUM;
+
+double k1(x)
+double x;
+{
+double y, z;
+
+z = 0.5 * x;
+if( z <= 0.0 )
+ {
+ mtherr( "k1", DOMAIN );
+ return( MAXNUM );
+ }
+
+if( x <= 2.0 )
+ {
+ y = x * x - 2.0;
+ y = log(z) * i1(x) + chbevl( y, A, 11 ) / x;
+ return( y );
+ }
+
+return( exp(-x) * chbevl( 8.0/x - 2.0, B, 25 ) / sqrt(x) );
+}
+
+
+
+
+double k1e( x )
+double x;
+{
+double y;
+
+if( x <= 0.0 )
+ {
+ mtherr( "k1e", DOMAIN );
+ return( MAXNUM );
+ }
+
+if( x <= 2.0 )
+ {
+ y = x * x - 2.0;
+ y = log( 0.5 * x ) * i1(x) + chbevl( y, A, 11 ) / x;
+ return( y * exp(x) );
+ }
+
+return( chbevl( 8.0/x - 2.0, B, 25 ) / sqrt(x) );
+}
diff --git a/libm/double/kn.c b/libm/double/kn.c
new file mode 100644
index 000000000..72a1c1a53
--- /dev/null
+++ b/libm/double/kn.c
@@ -0,0 +1,255 @@
+/* kn.c
+ *
+ * Modified Bessel function, third kind, integer order
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, kn();
+ * int n;
+ *
+ * y = kn( 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:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * DEC 0,30 3000 1.3e-9 5.8e-11
+ * IEEE 0,30 90000 1.8e-8 3.0e-10
+ *
+ * Error is high only near the crossover point x = 9.55
+ * between the two expansions used.
+ */
+
+
+/*
+Cephes Math Library Release 2.8: June, 2000
+Copyright 1984, 1987, 1988, 2000 by Stephen L. Moshier
+*/
+
+
+/*
+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
+#ifdef ANSIPROT
+extern double fabs ( double );
+extern double exp ( double );
+extern double log ( double );
+extern double sqrt ( double );
+#else
+double fabs(), exp(), log(), sqrt();
+#endif
+extern double MACHEP, MAXNUM, MAXLOG, PI;
+
+double kn( nn, x )
+int nn;
+double x;
+{
+double k, kf, nk1f, nkf, zn, t, s, z0, z;
+double ans, fn, pn, pk, zmn, tlg, tox;
+int i, n;
+
+if( nn < 0 )
+ n = -nn;
+else
+ n = nn;
+
+if( n > MAXFAC )
+ {
+overf:
+ mtherr( "kn", OVERFLOW );
+ return( MAXNUM );
+ }
+
+if( x <= 0.0 )
+ {
+ if( x < 0.0 )
+ mtherr( "kn", DOMAIN );
+ else
+ mtherr( "kn", SING );
+ return( MAXNUM );
+ }
+
+
+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( (MAXNUM - fabs(t)) < fabs(s) )
+ goto overf;
+ if( (tox > 1.0) && ((MAXNUM/tox) < zmn) )
+ goto overf;
+ zmn *= tox;
+ }
+ s *= 0.5;
+ t = fabs(s);
+ if( (zmn > 1.0) && ((MAXNUM/zmn) < t) )
+ goto overf;
+ if( (t > 1.0) && ((MAXNUM/t) < zmn) )
+ goto overf;
+ ans = s * zmn;
+ }
+ }
+
+
+tlg = 2.0 * log( 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( fabs(t/s) > MACHEP );
+
+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 > MAXLOG )
+ {
+ mtherr( "kn", 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 = MAXNUM;
+i = 0;
+do
+ {
+ z = pn - pk * pk;
+ t = t * z /(fn * z0);
+ nk1f = fabs(t);
+ if( (i >= n) && (nk1f > nkf) )
+ {
+ goto adone;
+ }
+ nkf = nk1f;
+ s += t;
+ fn += 1.0;
+ pk += 2.0;
+ i += 1;
+ }
+while( fabs(t/s) > MACHEP );
+
+adone:
+ans = exp(-x) * sqrt( PI/(2.0*x) ) * s;
+return(ans);
+}
diff --git a/libm/double/kolmogorov.c b/libm/double/kolmogorov.c
new file mode 100644
index 000000000..0d6fe92bd
--- /dev/null
+++ b/libm/double/kolmogorov.c
@@ -0,0 +1,243 @@
+
+/* Re Kolmogorov statistics, here is Birnbaum and Tingey's formula for the
+ distribution of D+, the maximum of all positive deviations between a
+ theoretical distribution function P(x) and an empirical one Sn(x)
+ from n samples.
+
+ +
+ D = sup [P(x) - S (x)]
+ n -inf < x < inf n
+
+
+ [n(1-e)]
+ + - v-1 n-v
+ Pr{D > e} = > C e (e + v/n) (1 - e - v/n)
+ n - n v
+ v=0
+
+ [n(1-e)] is the largest integer not exceeding n(1-e).
+ nCv is the number of combinations of n things taken v at a time. */
+
+
+#include <math.h>
+#ifdef ANSIPROT
+extern double pow ( double, double );
+extern double floor ( double );
+extern double lgam ( double );
+extern double exp ( double );
+extern double sqrt ( double );
+extern double log ( double );
+extern double fabs ( double );
+double smirnov ( int, double );
+double kolmogorov ( double );
+#else
+double pow (), floor (), lgam (), exp (), sqrt (), log (), fabs ();
+double smirnov (), kolmogorov ();
+#endif
+extern double MAXLOG;
+
+/* Exact Smirnov statistic, for one-sided test. */
+double
+smirnov (n, e)
+ int n;
+ double e;
+{
+ int v, nn;
+ double evn, omevn, p, t, c, lgamnp1;
+
+ if (n <= 0 || e < 0.0 || e > 1.0)
+ return (-1.0);
+ nn = floor ((double) n * (1.0 - e));
+ p = 0.0;
+ if (n < 1013)
+ {
+ c = 1.0;
+ for (v = 0; v <= nn; v++)
+ {
+ evn = e + ((double) v) / n;
+ p += c * pow (evn, (double) (v - 1))
+ * pow (1.0 - evn, (double) (n - v));
+ /* Next combinatorial term; worst case error = 4e-15. */
+ c *= ((double) (n - v)) / (v + 1);
+ }
+ }
+ else
+ {
+ lgamnp1 = lgam ((double) (n + 1));
+ for (v = 0; v <= nn; v++)
+ {
+ evn = e + ((double) v) / n;
+ omevn = 1.0 - evn;
+ if (fabs (omevn) > 0.0)
+ {
+ t = lgamnp1
+ - lgam ((double) (v + 1))
+ - lgam ((double) (n - v + 1))
+ + (v - 1) * log (evn)
+ + (n - v) * log (omevn);
+ if (t > -MAXLOG)
+ p += exp (t);
+ }
+ }
+ }
+ return (p * e);
+}
+
+
+/* Kolmogorov's limiting distribution of two-sided test, returns
+ probability that sqrt(n) * max deviation > y,
+ or that max deviation > y/sqrt(n).
+ The approximation is useful for the tail of the distribution
+ when n is large. */
+double
+kolmogorov (y)
+ double y;
+{
+ double p, t, r, sign, x;
+
+ x = -2.0 * y * y;
+ sign = 1.0;
+ p = 0.0;
+ r = 1.0;
+ do
+ {
+ t = exp (x * r * r);
+ p += sign * t;
+ if (t == 0.0)
+ break;
+ r += 1.0;
+ sign = -sign;
+ }
+ while ((t / p) > 1.1e-16);
+ return (p + p);
+}
+
+/* Functional inverse of Smirnov distribution
+ finds e such that smirnov(n,e) = p. */
+double
+smirnovi (n, p)
+ int n;
+ double p;
+{
+ double e, t, dpde;
+
+ if (p <= 0.0 || p > 1.0)
+ {
+ mtherr ("smirnovi", DOMAIN);
+ return 0.0;
+ }
+ /* Start with approximation p = exp(-2 n e^2). */
+ e = sqrt (-log (p) / (2.0 * n));
+ do
+ {
+ /* Use approximate derivative in Newton iteration. */
+ t = -2.0 * n * e;
+ dpde = 2.0 * t * exp (t * e);
+ if (fabs (dpde) > 0.0)
+ t = (p - smirnov (n, e)) / dpde;
+ else
+ {
+ mtherr ("smirnovi", UNDERFLOW);
+ return 0.0;
+ }
+ e = e + t;
+ if (e >= 1.0 || e <= 0.0)
+ {
+ mtherr ("smirnovi", OVERFLOW);
+ return 0.0;
+ }
+ }
+ while (fabs (t / e) > 1e-10);
+ return (e);
+}
+
+
+/* Functional inverse of Kolmogorov statistic for two-sided test.
+ Finds y such that kolmogorov(y) = p.
+ If e = smirnovi (n,p), then kolmogi(2 * p) / sqrt(n) should
+ be close to e. */
+double
+kolmogi (p)
+ double p;
+{
+ double y, t, dpdy;
+
+ if (p <= 0.0 || p > 1.0)
+ {
+ mtherr ("kolmogi", DOMAIN);
+ return 0.0;
+ }
+ /* Start with approximation p = 2 exp(-2 y^2). */
+ y = sqrt (-0.5 * log (0.5 * p));
+ do
+ {
+ /* Use approximate derivative in Newton iteration. */
+ t = -2.0 * y;
+ dpdy = 4.0 * t * exp (t * y);
+ if (fabs (dpdy) > 0.0)
+ t = (p - kolmogorov (y)) / dpdy;
+ else
+ {
+ mtherr ("kolmogi", UNDERFLOW);
+ return 0.0;
+ }
+ y = y + t;
+ }
+ while (fabs (t / y) > 1e-10);
+ return (y);
+}
+
+
+#ifdef SALONE
+/* Type in a number. */
+void
+getnum (s, px)
+ char *s;
+ double *px;
+{
+ char str[30];
+
+ printf (" %s (%.15e) ? ", s, *px);
+ gets (str);
+ if (str[0] == '\0' || str[0] == '\n')
+ return;
+ sscanf (str, "%lf", px);
+ printf ("%.15e\n", *px);
+}
+
+/* Type in values, get answers. */
+void
+main ()
+{
+ int n;
+ double e, p, ps, pk, ek, y;
+
+ n = 5;
+ e = 0.0;
+ p = 0.1;
+loop:
+ ps = n;
+ getnum ("n", &ps);
+ n = ps;
+ if (n <= 0)
+ {
+ printf ("? Operator error.\n");
+ goto loop;
+ }
+ /*
+ getnum ("e", &e);
+ ps = smirnov (n, e);
+ y = sqrt ((double) n) * e;
+ printf ("y = %.4e\n", y);
+ pk = kolmogorov (y);
+ printf ("Smirnov = %.15e, Kolmogorov/2 = %.15e\n", ps, pk / 2.0);
+*/
+ getnum ("p", &p);
+ e = smirnovi (n, p);
+ printf ("Smirnov e = %.15e\n", e);
+ y = kolmogi (2.0 * p);
+ ek = y / sqrt ((double) n);
+ printf ("Kolmogorov e = %.15e\n", ek);
+ goto loop;
+}
+#endif
diff --git a/libm/double/levnsn.c b/libm/double/levnsn.c
new file mode 100644
index 000000000..3fda5d6bd
--- /dev/null
+++ b/libm/double/levnsn.c
@@ -0,0 +1,82 @@
+/* Levnsn.c */
+/* Levinson-Durbin LPC
+ *
+ * | R0 R1 R2 ... RN-1 | | A1 | | -R1 |
+ * | R1 R0 R1 ... RN-2 | | A2 | | -R2 |
+ * | R2 R1 R0 ... RN-3 | | A3 | = | -R3 |
+ * | ... | | ...| | ... |
+ * | RN-1 RN-2... R0 | | AN | | -RN |
+ *
+ * Ref: John Makhoul, "Linear Prediction, A Tutorial Review"
+ * Proc. IEEE Vol. 63, PP 561-580 April, 1975.
+ *
+ * R is the input autocorrelation function. R0 is the zero lag
+ * term. A is the output array of predictor coefficients. Note
+ * that a filter impulse response has a coefficient of 1.0 preceding
+ * A1. E is an array of mean square error for each prediction order
+ * 1 to N. REFL is an output array of the reflection coefficients.
+ */
+
+#define abs(x) ( (x) < 0 ? -(x) : (x) )
+
+int levnsn( n, r, a, e, refl )
+int n;
+double r[], a[], e[], refl[];
+{
+int k, km1, i, kmi, j;
+double ai, akk, err, err1, r0, t, akmi;
+double *pa, *pr;
+
+for( i=0; i<n; i++ )
+ {
+ a[i] = 0.0;
+ e[i] = 0.0;
+ refl[i] = 0.0;
+ }
+r0 = r[0];
+e[0] = r0;
+err = r0;
+
+akk = -r[1]/err;
+err = (1.0 - akk*akk) * err;
+e[1] = err;
+a[1] = akk;
+refl[1] = akk;
+
+if( err < 1.0e-2 )
+ return 0;
+
+for( k=2; k<n; k++ )
+ {
+ t = 0.0;
+ pa = &a[1];
+ pr = &r[k-1];
+ for( j=1; j<k; j++ )
+ t += *pa++ * *pr--;
+ akk = -( r[k] + t )/err;
+ refl[k] = akk;
+ km1 = k/2;
+ for( j=1; j<=km1; j++ )
+ {
+ kmi = k-j;
+ ai = a[j];
+ akmi = a[kmi];
+ a[j] = ai + akk*akmi;
+ if( i == kmi )
+ goto nxtk;
+ a[kmi] = akmi + akk*ai;
+ }
+nxtk:
+ a[k] = akk;
+ err1 = (1.0 - akk*akk)*err;
+ e[k] = err1;
+ if( err1 < 0 )
+ err1 = -err1;
+/* err1 = abs(err1);*/
+/* if( (err1 < 1.0e-2) || (err1 >= err) )*/
+ if( err1 < 1.0e-2 )
+ return 0;
+ err = err1;
+ }
+ return 0;
+}
diff --git a/libm/double/log.c b/libm/double/log.c
new file mode 100644
index 000000000..2fdea17a7
--- /dev/null
+++ b/libm/double/log.c
@@ -0,0 +1,341 @@
+/* log.c
+ *
+ * Natural logarithm
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, log();
+ *
+ * y = log( 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)/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 0.5, 2.0 150000 1.44e-16 5.06e-17
+ * IEEE +-MAXNUM 30000 1.20e-16 4.78e-17
+ * DEC 0, 10 170000 1.8e-17 6.3e-18
+ *
+ * In the tests over the interval [+-MAXNUM], the logarithms
+ * of the random arguments were uniformly distributed over
+ * [0, MAXLOG].
+ *
+ * ERROR MESSAGES:
+ *
+ * log singularity: x = 0; returns -INFINITY
+ * log domain: x < 0; returns NAN
+ */
+
+/*
+Cephes Math Library Release 2.8: June, 2000
+Copyright 1984, 1995, 2000 by Stephen L. Moshier
+*/
+
+#include <math.h>
+static char fname[] = {"log"};
+
+/* Coefficients for log(1+x) = x - x**2/2 + x**3 P(x)/Q(x)
+ * 1/sqrt(2) <= x < sqrt(2)
+ */
+#ifdef UNK
+static double P[] = {
+ 1.01875663804580931796E-4,
+ 4.97494994976747001425E-1,
+ 4.70579119878881725854E0,
+ 1.44989225341610930846E1,
+ 1.79368678507819816313E1,
+ 7.70838733755885391666E0,
+};
+static double Q[] = {
+/* 1.00000000000000000000E0, */
+ 1.12873587189167450590E1,
+ 4.52279145837532221105E1,
+ 8.29875266912776603211E1,
+ 7.11544750618563894466E1,
+ 2.31251620126765340583E1,
+};
+#endif
+
+#ifdef DEC
+static unsigned short P[] = {
+0037777,0127270,0162547,0057274,
+0041001,0054665,0164317,0005341,
+0041451,0034104,0031640,0105773,
+0041677,0011276,0123617,0160135,
+0041701,0126603,0053215,0117250,
+0041420,0115777,0135206,0030232,
+};
+static unsigned short Q[] = {
+/*0040200,0000000,0000000,0000000,*/
+0041220,0144332,0045272,0174241,
+0041742,0164566,0035720,0130431,
+0042246,0126327,0166065,0116357,
+0042372,0033420,0157525,0124560,
+0042271,0167002,0066537,0172303,
+0041730,0164777,0113711,0044407,
+};
+#endif
+
+#ifdef IBMPC
+static unsigned short P[] = {
+0x1bb0,0x93c3,0xb4c2,0x3f1a,
+0x52f2,0x3f56,0xd6f5,0x3fdf,
+0x6911,0xed92,0xd2ba,0x4012,
+0xeb2e,0xc63e,0xff72,0x402c,
+0xc84d,0x924b,0xefd6,0x4031,
+0xdcf8,0x7d7e,0xd563,0x401e,
+};
+static unsigned short Q[] = {
+/*0x0000,0x0000,0x0000,0x3ff0,*/
+0xef8e,0xae97,0x9320,0x4026,
+0xc033,0x4e19,0x9d2c,0x4046,
+0xbdbd,0xa326,0xbf33,0x4054,
+0xae21,0xeb5e,0xc9e2,0x4051,
+0x25b2,0x9e1f,0x200a,0x4037,
+};
+#endif
+
+#ifdef MIEEE
+static unsigned short P[] = {
+0x3f1a,0xb4c2,0x93c3,0x1bb0,
+0x3fdf,0xd6f5,0x3f56,0x52f2,
+0x4012,0xd2ba,0xed92,0x6911,
+0x402c,0xff72,0xc63e,0xeb2e,
+0x4031,0xefd6,0x924b,0xc84d,
+0x401e,0xd563,0x7d7e,0xdcf8,
+};
+static unsigned short Q[] = {
+/*0x3ff0,0x0000,0x0000,0x0000,*/
+0x4026,0x9320,0xae97,0xef8e,
+0x4046,0x9d2c,0x4e19,0xc033,
+0x4054,0xbf33,0xa326,0xbdbd,
+0x4051,0xc9e2,0xeb5e,0xae21,
+0x4037,0x200a,0x9e1f,0x25b2,
+};
+#endif
+
+/* Coefficients for log(x) = z + z**3 P(z)/Q(z),
+ * where z = 2(x-1)/(x+1)
+ * 1/sqrt(2) <= x < sqrt(2)
+ */
+
+#ifdef UNK
+static double R[3] = {
+-7.89580278884799154124E-1,
+ 1.63866645699558079767E1,
+-6.41409952958715622951E1,
+};
+static double S[3] = {
+/* 1.00000000000000000000E0,*/
+-3.56722798256324312549E1,
+ 3.12093766372244180303E2,
+-7.69691943550460008604E2,
+};
+#endif
+#ifdef DEC
+static unsigned short R[12] = {
+0140112,0020756,0161540,0072035,
+0041203,0013743,0114023,0155527,
+0141600,0044060,0104421,0050400,
+};
+static unsigned short S[12] = {
+/*0040200,0000000,0000000,0000000,*/
+0141416,0130152,0017543,0064122,
+0042234,0006000,0104527,0020155,
+0142500,0066110,0146631,0174731,
+};
+#endif
+#ifdef IBMPC
+static unsigned short R[12] = {
+0x0e84,0xdc6c,0x443d,0xbfe9,
+0x7b6b,0x7302,0x62fc,0x4030,
+0x2a20,0x1122,0x0906,0xc050,
+};
+static unsigned short S[12] = {
+/*0x0000,0x0000,0x0000,0x3ff0,*/
+0x6d0a,0x43ec,0xd60d,0xc041,
+0xe40e,0x112a,0x8180,0x4073,
+0x3f3b,0x19b3,0x0d89,0xc088,
+};
+#endif
+#ifdef MIEEE
+static unsigned short R[12] = {
+0xbfe9,0x443d,0xdc6c,0x0e84,
+0x4030,0x62fc,0x7302,0x7b6b,
+0xc050,0x0906,0x1122,0x2a20,
+};
+static unsigned short S[12] = {
+/*0x3ff0,0x0000,0x0000,0x0000,*/
+0xc041,0xd60d,0x43ec,0x6d0a,
+0x4073,0x8180,0x112a,0xe40e,
+0xc088,0x0d89,0x19b3,0x3f3b,
+};
+#endif
+
+#ifdef ANSIPROT
+extern double frexp ( double, int * );
+extern double ldexp ( double, int );
+extern double polevl ( double, void *, int );
+extern double p1evl ( double, void *, int );
+extern int isnan ( double );
+extern int isfinite ( double );
+#else
+double frexp(), ldexp(), polevl(), p1evl();
+int isnan(), isfinite();
+#endif
+#define SQRTH 0.70710678118654752440
+extern double INFINITY, NAN;
+
+double log(x)
+double x;
+{
+int e;
+#ifdef DEC
+short *q;
+#endif
+double y, z;
+
+#ifdef NANS
+if( isnan(x) )
+ return(x);
+#endif
+#ifdef INFINITIES
+if( x == INFINITY )
+ return(x);
+#endif
+/* Test for domain */
+if( x <= 0.0 )
+ {
+ if( x == 0.0 )
+ {
+ mtherr( fname, SING );
+ return( -INFINITY );
+ }
+ else
+ {
+ mtherr( fname, DOMAIN );
+ return( NAN );
+ }
+ }
+
+/* separate mantissa from exponent */
+
+#ifdef DEC
+q = (short *)&x;
+e = *q; /* short containing exponent */
+e = ((e >> 7) & 0377) - 0200; /* the exponent */
+*q &= 0177; /* strip exponent from x */
+*q |= 040000; /* x now between 0.5 and 1 */
+#endif
+
+/* Note, frexp is used so that denormal numbers
+ * will be handled properly.
+ */
+#ifdef IBMPC
+x = frexp( x, &e );
+/*
+q = (short *)&x;
+q += 3;
+e = *q;
+e = ((e >> 4) & 0x0fff) - 0x3fe;
+*q &= 0x0f;
+*q |= 0x3fe0;
+*/
+#endif
+
+/* Equivalent C language standard library function: */
+#ifdef UNK
+x = frexp( x, &e );
+#endif
+
+#ifdef MIEEE
+x = frexp( x, &e );
+#endif
+
+
+
+/* logarithm using log(x) = z + z**3 P(z)/Q(z),
+ * where z = 2(x-1)/x+1)
+ */
+
+if( (e > 2) || (e < -2) )
+{
+if( x < SQRTH )
+ { /* 2( 2x-1 )/( 2x+1 ) */
+ e -= 1;
+ z = x - 0.5;
+ y = 0.5 * z + 0.5;
+ }
+else
+ { /* 2 (x-1)/(x+1) */
+ z = x - 0.5;
+ z -= 0.5;
+ y = 0.5 * x + 0.5;
+ }
+
+x = z / y;
+
+
+/* rational form */
+z = x*x;
+z = x * ( z * polevl( z, R, 2 ) / p1evl( z, S, 3 ) );
+y = e;
+z = z - y * 2.121944400546905827679e-4;
+z = z + x;
+z = z + e * 0.693359375;
+goto ldone;
+}
+
+
+
+/* logarithm using log(1+x) = x - .5x**2 + x**3 P(x)/Q(x) */
+
+if( x < SQRTH )
+ {
+ e -= 1;
+ x = ldexp( x, 1 ) - 1.0; /* 2x - 1 */
+ }
+else
+ {
+ x = x - 1.0;
+ }
+
+
+/* rational form */
+z = x*x;
+#if DEC
+y = x * ( z * polevl( x, P, 5 ) / p1evl( x, Q, 6 ) );
+#else
+y = x * ( z * polevl( x, P, 5 ) / p1evl( x, Q, 5 ) );
+#endif
+if( e )
+ y = y - e * 2.121944400546905827679e-4;
+y = y - ldexp( z, -1 ); /* y - 0.5 * z */
+z = x + y;
+if( e )
+ z = z + e * 0.693359375;
+
+ldone:
+
+return( z );
+}
diff --git a/libm/double/log10.c b/libm/double/log10.c
new file mode 100644
index 000000000..7dc72e253
--- /dev/null
+++ b/libm/double/log10.c
@@ -0,0 +1,250 @@
+/* log10.c
+ *
+ * Common logarithm
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, log10();
+ *
+ * y = log10( 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)/Q(x).
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE 0.5, 2.0 30000 1.5e-16 5.0e-17
+ * IEEE 0, MAXNUM 30000 1.4e-16 4.8e-17
+ * DEC 1, MAXNUM 50000 2.5e-17 6.0e-18
+ *
+ * In the tests over the interval [1, MAXNUM], the logarithms
+ * of the random arguments were uniformly distributed over
+ * [0, MAXLOG].
+ *
+ * ERROR MESSAGES:
+ *
+ * log10 singularity: x = 0; returns -INFINITY
+ * log10 domain: x < 0; returns NAN
+ */
+
+/*
+Cephes Math Library Release 2.8: June, 2000
+Copyright 1984, 1995, 2000 by Stephen L. Moshier
+*/
+
+#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)
+ */
+#ifdef UNK
+static double P[] = {
+ 4.58482948458143443514E-5,
+ 4.98531067254050724270E-1,
+ 6.56312093769992875930E0,
+ 2.97877425097986925891E1,
+ 6.06127134467767258030E1,
+ 5.67349287391754285487E1,
+ 1.98892446572874072159E1
+};
+static double Q[] = {
+/* 1.00000000000000000000E0, */
+ 1.50314182634250003249E1,
+ 8.27410449222435217021E1,
+ 2.20664384982121929218E2,
+ 3.07254189979530058263E2,
+ 2.14955586696422947765E2,
+ 5.96677339718622216300E1
+};
+#endif
+
+#ifdef DEC
+static unsigned short P[] = {
+0034500,0046473,0051374,0135174,
+0037777,0037566,0145712,0150321,
+0040722,0002426,0031543,0123107,
+0041356,0046513,0170752,0004346,
+0041562,0071553,0023536,0163343,
+0041542,0170221,0024316,0114216,
+0041237,0016454,0046611,0104602
+};
+static unsigned short Q[] = {
+/*0040200,0000000,0000000,0000000,*/
+0041160,0100260,0067736,0102424,
+0041645,0075552,0036563,0147072,
+0042134,0125025,0021132,0025320,
+0042231,0120211,0046030,0103271,
+0042126,0172241,0052151,0120426,
+0041556,0125702,0072116,0047103
+};
+#endif
+
+#ifdef IBMPC
+static unsigned short P[] = {
+0x974f,0x6a5f,0x09a7,0x3f08,
+0x5a1a,0xd979,0xe7ee,0x3fdf,
+0x74c9,0xc66c,0x40a2,0x401a,
+0x411d,0x7e3d,0xc9a9,0x403d,
+0xdcdc,0x64eb,0x4e6d,0x404e,
+0xd312,0x2519,0x5e12,0x404c,
+0x3130,0x89b1,0xe3a5,0x4033
+};
+static unsigned short Q[] = {
+/*0x0000,0x0000,0x0000,0x3ff0,*/
+0xd0a2,0x0dfb,0x1016,0x402e,
+0x79c7,0x47ae,0xaf6d,0x4054,
+0x455a,0xa44b,0x9542,0x406b,
+0x10d7,0x2983,0x3411,0x4073,
+0x3423,0x2a8d,0xde94,0x406a,
+0xc9c8,0x4e89,0xd578,0x404d
+};
+#endif
+
+#ifdef MIEEE
+static unsigned short P[] = {
+0x3f08,0x09a7,0x6a5f,0x974f,
+0x3fdf,0xe7ee,0xd979,0x5a1a,
+0x401a,0x40a2,0xc66c,0x74c9,
+0x403d,0xc9a9,0x7e3d,0x411d,
+0x404e,0x4e6d,0x64eb,0xdcdc,
+0x404c,0x5e12,0x2519,0xd312,
+0x4033,0xe3a5,0x89b1,0x3130
+};
+static unsigned short Q[] = {
+0x402e,0x1016,0x0dfb,0xd0a2,
+0x4054,0xaf6d,0x47ae,0x79c7,
+0x406b,0x9542,0xa44b,0x455a,
+0x4073,0x3411,0x2983,0x10d7,
+0x406a,0xde94,0x2a8d,0x3423,
+0x404d,0xd578,0x4e89,0xc9c8
+};
+#endif
+
+#define SQRTH 0.70710678118654752440
+#define L102A 3.0078125E-1
+#define L102B 2.48745663981195213739E-4
+#define L10EA 4.3359375E-1
+#define L10EB 7.00731903251827651129E-4
+
+#ifdef ANSIPROT
+extern double frexp ( double, int * );
+extern double ldexp ( double, int );
+extern double polevl ( double, void *, int );
+extern double p1evl ( double, void *, int );
+extern int isnan ( double );
+extern int isfinite ( double );
+#else
+double frexp(), ldexp(), polevl(), p1evl();
+int isnan(), isfinite();
+#endif
+extern double LOGE2, SQRT2, INFINITY, NAN;
+
+double log10(x)
+double x;
+{
+VOLATILE double z;
+double y;
+#ifdef DEC
+short *q;
+#endif
+int e;
+
+#ifdef NANS
+if( isnan(x) )
+ return(x);
+#endif
+#ifdef INFINITIES
+if( x == INFINITY )
+ return(x);
+#endif
+/* Test for domain */
+if( x <= 0.0 )
+ {
+ if( x == 0.0 )
+ {
+ mtherr( fname, SING );
+ return( -INFINITY );
+ }
+ else
+ {
+ mtherr( fname, DOMAIN );
+ return( NAN );
+ }
+ }
+
+/* separate mantissa from exponent */
+
+#ifdef DEC
+q = (short *)&x;
+e = *q; /* short containing exponent */
+e = ((e >> 7) & 0377) - 0200; /* the exponent */
+*q &= 0177; /* strip exponent from x */
+*q |= 040000; /* x now between 0.5 and 1 */
+#endif
+
+#ifdef IBMPC
+x = frexp( x, &e );
+/*
+q = (short *)&x;
+q += 3;
+e = *q;
+e = ((e >> 4) & 0x0fff) - 0x3fe;
+*q &= 0x0f;
+*q |= 0x3fe0;
+*/
+#endif
+
+/* Equivalent C language standard library function: */
+#ifdef UNK
+x = frexp( x, &e );
+#endif
+
+#ifdef MIEEE
+x = frexp( x, &e );
+#endif
+
+/* logarithm using log(1+x) = x - .5x**2 + x**3 P(x)/Q(x) */
+
+if( x < SQRTH )
+ {
+ e -= 1;
+ x = ldexp( x, 1 ) - 1.0; /* 2x - 1 */
+ }
+else
+ {
+ x = x - 1.0;
+ }
+
+
+/* rational form */
+z = x*x;
+y = x * ( z * polevl( x, P, 6 ) / p1evl( x, Q, 6 ) );
+y = y - ldexp( z, -1 ); /* 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;
+z += e * L102B;
+z += e * L102A;
+
+
+return( z );
+}
diff --git a/libm/double/log2.c b/libm/double/log2.c
new file mode 100644
index 000000000..e73782712
--- /dev/null
+++ b/libm/double/log2.c
@@ -0,0 +1,348 @@
+/* log2.c
+ *
+ * Base 2 logarithm
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, log2();
+ *
+ * y = log2( 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 0.5, 2.0 30000 2.0e-16 5.5e-17
+ * IEEE exp(+-700) 40000 1.3e-16 4.6e-17
+ *
+ * In the tests over the interval [exp(+-700)], the logarithms
+ * of the random arguments were uniformly distributed.
+ *
+ * ERROR MESSAGES:
+ *
+ * log2 singularity: x = 0; returns -INFINITY
+ * log2 domain: x < 0; returns NAN
+ */
+
+/*
+Cephes Math Library Release 2.8: June, 2000
+Copyright 1984, 1995, 2000 by Stephen L. Moshier
+*/
+
+#include <math.h>
+static char fname[] = {"log2"};
+
+/* Coefficients for log(1+x) = x - x**2/2 + x**3 P(x)/Q(x)
+ * 1/sqrt(2) <= x < sqrt(2)
+ */
+#ifdef UNK
+static double P[] = {
+ 1.01875663804580931796E-4,
+ 4.97494994976747001425E-1,
+ 4.70579119878881725854E0,
+ 1.44989225341610930846E1,
+ 1.79368678507819816313E1,
+ 7.70838733755885391666E0,
+};
+static double Q[] = {
+/* 1.00000000000000000000E0, */
+ 1.12873587189167450590E1,
+ 4.52279145837532221105E1,
+ 8.29875266912776603211E1,
+ 7.11544750618563894466E1,
+ 2.31251620126765340583E1,
+};
+#define LOG2EA 0.44269504088896340735992
+#endif
+
+#ifdef DEC
+static unsigned short P[] = {
+0037777,0127270,0162547,0057274,
+0041001,0054665,0164317,0005341,
+0041451,0034104,0031640,0105773,
+0041677,0011276,0123617,0160135,
+0041701,0126603,0053215,0117250,
+0041420,0115777,0135206,0030232,
+};
+static unsigned short Q[] = {
+/*0040200,0000000,0000000,0000000,*/
+0041220,0144332,0045272,0174241,
+0041742,0164566,0035720,0130431,
+0042246,0126327,0166065,0116357,
+0042372,0033420,0157525,0124560,
+0042271,0167002,0066537,0172303,
+0041730,0164777,0113711,0044407,
+};
+static unsigned short L[5] = {0037742,0124354,0122560,0057703};
+#define LOG2EA (*(double *)(&L[0]))
+#endif
+
+#ifdef IBMPC
+static unsigned short P[] = {
+0x1bb0,0x93c3,0xb4c2,0x3f1a,
+0x52f2,0x3f56,0xd6f5,0x3fdf,
+0x6911,0xed92,0xd2ba,0x4012,
+0xeb2e,0xc63e,0xff72,0x402c,
+0xc84d,0x924b,0xefd6,0x4031,
+0xdcf8,0x7d7e,0xd563,0x401e,
+};
+static unsigned short Q[] = {
+/*0x0000,0x0000,0x0000,0x3ff0,*/
+0xef8e,0xae97,0x9320,0x4026,
+0xc033,0x4e19,0x9d2c,0x4046,
+0xbdbd,0xa326,0xbf33,0x4054,
+0xae21,0xeb5e,0xc9e2,0x4051,
+0x25b2,0x9e1f,0x200a,0x4037,
+};
+static unsigned short L[5] = {0x0bf8,0x94ae,0x551d,0x3fdc};
+#define LOG2EA (*(double *)(&L[0]))
+#endif
+
+#ifdef MIEEE
+static unsigned short P[] = {
+0x3f1a,0xb4c2,0x93c3,0x1bb0,
+0x3fdf,0xd6f5,0x3f56,0x52f2,
+0x4012,0xd2ba,0xed92,0x6911,
+0x402c,0xff72,0xc63e,0xeb2e,
+0x4031,0xefd6,0x924b,0xc84d,
+0x401e,0xd563,0x7d7e,0xdcf8,
+};
+static unsigned short Q[] = {
+/*0x3ff0,0x0000,0x0000,0x0000,*/
+0x4026,0x9320,0xae97,0xef8e,
+0x4046,0x9d2c,0x4e19,0xc033,
+0x4054,0xbf33,0xa326,0xbdbd,
+0x4051,0xc9e2,0xeb5e,0xae21,
+0x4037,0x200a,0x9e1f,0x25b2,
+};
+static unsigned short L[5] = {0x3fdc,0x551d,0x94ae,0x0bf8};
+#define LOG2EA (*(double *)(&L[0]))
+#endif
+
+/* Coefficients for log(x) = z + z**3 P(z)/Q(z),
+ * where z = 2(x-1)/(x+1)
+ * 1/sqrt(2) <= x < sqrt(2)
+ */
+
+#ifdef UNK
+static double R[3] = {
+-7.89580278884799154124E-1,
+ 1.63866645699558079767E1,
+-6.41409952958715622951E1,
+};
+static double S[3] = {
+/* 1.00000000000000000000E0,*/
+-3.56722798256324312549E1,
+ 3.12093766372244180303E2,
+-7.69691943550460008604E2,
+};
+/* log2(e) - 1 */
+#define LOG2EA 0.44269504088896340735992
+#endif
+#ifdef DEC
+static unsigned short R[12] = {
+0140112,0020756,0161540,0072035,
+0041203,0013743,0114023,0155527,
+0141600,0044060,0104421,0050400,
+};
+static unsigned short S[12] = {
+/*0040200,0000000,0000000,0000000,*/
+0141416,0130152,0017543,0064122,
+0042234,0006000,0104527,0020155,
+0142500,0066110,0146631,0174731,
+};
+/* log2(e) - 1 */
+#define LOG2EA 0.44269504088896340735992L
+#endif
+#ifdef IBMPC
+static unsigned short R[12] = {
+0x0e84,0xdc6c,0x443d,0xbfe9,
+0x7b6b,0x7302,0x62fc,0x4030,
+0x2a20,0x1122,0x0906,0xc050,
+};
+static unsigned short S[12] = {
+/*0x0000,0x0000,0x0000,0x3ff0,*/
+0x6d0a,0x43ec,0xd60d,0xc041,
+0xe40e,0x112a,0x8180,0x4073,
+0x3f3b,0x19b3,0x0d89,0xc088,
+};
+#endif
+#ifdef MIEEE
+static unsigned short R[12] = {
+0xbfe9,0x443d,0xdc6c,0x0e84,
+0x4030,0x62fc,0x7302,0x7b6b,
+0xc050,0x0906,0x1122,0x2a20,
+};
+static unsigned short S[12] = {
+/*0x3ff0,0x0000,0x0000,0x0000,*/
+0xc041,0xd60d,0x43ec,0x6d0a,
+0x4073,0x8180,0x112a,0xe40e,
+0xc088,0x0d89,0x19b3,0x3f3b,
+};
+#endif
+
+#ifdef ANSIPROT
+extern double frexp ( double, int * );
+extern double ldexp ( double, int );
+extern double polevl ( double, void *, int );
+extern double p1evl ( double, void *, int );
+extern int isnan ( double );
+extern int isfinite ( double );
+#else
+double frexp(), ldexp(), polevl(), p1evl();
+int isnan(), isfinite();
+#endif
+#define SQRTH 0.70710678118654752440
+extern double LOGE2, INFINITY, NAN;
+
+double log2(x)
+double x;
+{
+int e;
+double y;
+VOLATILE double z;
+#ifdef DEC
+short *q;
+#endif
+
+#ifdef NANS
+if( isnan(x) )
+ return(x);
+#endif
+#ifdef INFINITIES
+if( x == INFINITY )
+ return(x);
+#endif
+/* Test for domain */
+if( x <= 0.0 )
+ {
+ if( x == 0.0 )
+ {
+ mtherr( fname, SING );
+ return( -INFINITY );
+ }
+ else
+ {
+ mtherr( fname, DOMAIN );
+ return( NAN );
+ }
+ }
+
+/* separate mantissa from exponent */
+
+#ifdef DEC
+q = (short *)&x;
+e = *q; /* short containing exponent */
+e = ((e >> 7) & 0377) - 0200; /* the exponent */
+*q &= 0177; /* strip exponent from x */
+*q |= 040000; /* x now between 0.5 and 1 */
+#endif
+
+/* Note, frexp is used so that denormal numbers
+ * will be handled properly.
+ */
+#ifdef IBMPC
+x = frexp( x, &e );
+/*
+q = (short *)&x;
+q += 3;
+e = *q;
+e = ((e >> 4) & 0x0fff) - 0x3fe;
+*q &= 0x0f;
+*q |= 0x3fe0;
+*/
+#endif
+
+/* Equivalent C language standard library function: */
+#ifdef UNK
+x = frexp( x, &e );
+#endif
+
+#ifdef MIEEE
+x = frexp( x, &e );
+#endif
+
+
+/* logarithm using log(x) = z + z**3 P(z)/Q(z),
+ * where z = 2(x-1)/x+1)
+ */
+
+if( (e > 2) || (e < -2) )
+{
+if( x < SQRTH )
+ { /* 2( 2x-1 )/( 2x+1 ) */
+ e -= 1;
+ z = x - 0.5;
+ y = 0.5 * z + 0.5;
+ }
+else
+ { /* 2 (x-1)/(x+1) */
+ z = x - 0.5;
+ z -= 0.5;
+ y = 0.5 * x + 0.5;
+ }
+
+x = z / y;
+z = x*x;
+y = x * ( z * polevl( z, R, 2 ) / p1evl( z, S, 3 ) );
+goto ldone;
+}
+
+
+
+/* logarithm using log(1+x) = x - .5x**2 + x**3 P(x)/Q(x) */
+
+if( x < SQRTH )
+ {
+ e -= 1;
+ x = ldexp( x, 1 ) - 1.0; /* 2x - 1 */
+ }
+else
+ {
+ x = x - 1.0;
+ }
+
+z = x*x;
+#if DEC
+y = x * ( z * polevl( x, P, 5 ) / p1evl( x, Q, 6 ) ) - ldexp( z, -1 );
+#else
+y = x * ( z * polevl( x, P, 5 ) / p1evl( x, Q, 5 ) ) - ldexp( z, -1 );
+#endif
+
+ldone:
+
+/* 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 += e;
+return( z );
+}
diff --git a/libm/double/lrand.c b/libm/double/lrand.c
new file mode 100644
index 000000000..cfdaa9f28
--- /dev/null
+++ b/libm/double/lrand.c
@@ -0,0 +1,86 @@
+/* lrand.c
+ *
+ * Pseudorandom number generator
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long y, drand();
+ *
+ * drand( &y );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Yields a long integer random number.
+ *
+ * The three-generator congruential algorithm by Brian
+ * Wichmann and David Hill (BYTE magazine, March, 1987,
+ * pp 127-8) is used. The period, given by them, is
+ * 6953607871644.
+ *
+ *
+ */
+
+
+
+#include <math.h>
+
+
+/* Three-generator random number algorithm
+ * of Brian Wichmann and David Hill
+ * BYTE magazine, March, 1987 pp 127-8
+ *
+ * The period, given by them, is (p-1)(q-1)(r-1)/4 = 6.95e12.
+ */
+
+static int sx = 1;
+static int sy = 10000;
+static int sz = 3000;
+
+/* This function implements the three
+ * congruential generators.
+ */
+
+long lrand()
+{
+int r, s;
+unsigned long ans;
+
+/*
+if( arg )
+ {
+ sx = 1;
+ sy = 10000;
+ sz = 3000;
+ }
+*/
+
+/* sx = sx * 171 mod 30269 */
+r = sx/177;
+s = sx - 177 * r;
+sx = 171 * s - 2 * r;
+if( sx < 0 )
+ sx += 30269;
+
+
+/* sy = sy * 172 mod 30307 */
+r = sy/176;
+s = sy - 176 * r;
+sy = 172 * s - 35 * r;
+if( sy < 0 )
+ sy += 30307;
+
+/* sz = 170 * sz mod 30323 */
+r = sz/178;
+s = sz - 178 * r;
+sz = 170 * s - 63 * r;
+if( sz < 0 )
+ sz += 30323;
+
+ans = sx * sy * sz;
+return(ans);
+}
+
diff --git a/libm/double/lsqrt.c b/libm/double/lsqrt.c
new file mode 100644
index 000000000..bf85a54f1
--- /dev/null
+++ b/libm/double/lsqrt.c
@@ -0,0 +1,85 @@
+/* lsqrt.c
+ *
+ * Integer square root
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long x, y;
+ * long lsqrt();
+ *
+ * y = lsqrt( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns a long integer square root of the long integer
+ * argument. The computation is by binary long division.
+ *
+ * The largest possible result is lsqrt(2,147,483,647)
+ * = 46341.
+ *
+ * If x < 0, the square root of |x| is returned, and an
+ * error message is printed.
+ *
+ *
+ * ACCURACY:
+ *
+ * An extra, roundoff, bit is computed; hence the result
+ * is the nearest integer to the actual square root.
+ * NOTE: only DEC arithmetic is currently supported.
+ *
+ */
+
+/*
+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>
+
+long lsqrt(x)
+long x;
+{
+long num, sq;
+long temp;
+int i, j, k, n;
+
+if( x < 0 )
+ {
+ mtherr( "lsqrt", DOMAIN );
+ x = -x;
+ }
+
+num = 0;
+sq = 0;
+k = 24;
+n = 4;
+
+for( j=0; j<4; j++ )
+ {
+ num |= (x >> k) & 0xff; /* bring in next byte of arg */
+ if( j == 3 ) /* do roundoff bit at end */
+ n = 5;
+ for( i=0; i<n; i++ )
+ {
+ num <<= 2; /* next 2 bits of arg */
+ sq <<= 1; /* shift up answer */
+ temp = (sq << 1) + 256; /* trial divisor */
+ temp = num - temp;
+ if( temp >= 0 )
+ {
+ num = temp; /* it went in */
+ sq += 256; /* answer bit = 1 */
+ }
+ }
+ k -= 8; /* shift count to get next byte of arg */
+ }
+
+sq += 256; /* add roundoff bit */
+sq >>= 9; /* truncate */
+return( sq );
+}
diff --git a/libm/double/ltstd.c b/libm/double/ltstd.c
new file mode 100644
index 000000000..f47fc3907
--- /dev/null
+++ b/libm/double/ltstd.c
@@ -0,0 +1,469 @@
+/* ltstd.c */
+/* Function test routine.
+ * Requires long double type check routine and double precision function
+ * under test. Indicate function name and range in #define statements
+ * below. Modifications for two argument functions and absolute
+ * rather than relative accuracy report are indicated.
+ */
+
+#include <stdio.h>
+/* int printf(), gets(), sscanf(); */
+
+#include <math.h>
+#ifdef ANSIPROT
+int drand ( void );
+int dprec ( void );
+int ldprec ( void );
+double exp ( double );
+double sqrt ( double );
+double fabs ( double );
+double floor ( double );
+long double sqrtl ( long double );
+long double fabsl ( long double );
+#else
+int drand();
+int dprec(), ldprec();
+double exp(), sqrt(), fabs(), floor();
+long double sqrtl(), fabsl();
+#endif
+
+#define RELERR 1
+#define ONEARG 0
+#define ONEINT 0
+#define TWOARG 0
+#define TWOINT 0
+#define THREEARG 1
+#define THREEINT 0
+#define FOURARG 0
+#define VECARG 0
+#define FOURANS 0
+#define TWOANS 0
+#define PROB 0
+#define EXPSCALE 0
+#define EXPSC2 0
+/* insert function to be tested here: */
+#define FUNC hyperg
+double FUNC();
+#define QFUNC hypergl
+long double QFUNC();
+/*extern int aiconf;*/
+
+extern double MAXLOG;
+extern double MINLOG;
+extern double MAXNUM;
+#define LTS 3.258096538
+/* insert low end and width of test interval */
+#define LOW 0.0
+#define WIDTH 30.0
+#define LOWA 0.0
+#define WIDTHA 30.0
+/* 1.073741824e9 */
+/* 2.147483648e9 */
+long double qone = 1.0L;
+static long double q1, q2, q3, qa, qb, qc, qz, qy1, qy2, qy3, qy4;
+static double y2, y3, y4, a, b, c, x, y, z, e;
+static long double qe, qmax, qrmsa, qave;
+volatile double v;
+static long double lp[3], lq[3];
+static double dp[3], dq[3];
+
+char strave[20];
+char strrms[20];
+char strmax[20];
+double underthresh = 2.22507385850720138309E-308; /* 2^-1022 */
+
+void main()
+{
+char s[80];
+int i, j, k;
+long m, n;
+
+merror = 0;
+ldprec(); /* set up coprocessor. */
+/*aiconf = -1;*/ /* configure Airy function */
+x = 1.0;
+z = x * x;
+qmax = 0.0L;
+sprintf(strmax, "%.4Le", qmax );
+qrmsa = 0.0L;
+qave = 0.0L;
+
+#if 1
+printf(" Start at random number #:" );
+gets( s );
+sscanf( s, "%ld", &n );
+printf("%ld\n", n );
+#else
+n = 0;
+#endif
+
+for( m=0; m<n; m++ )
+ drand( &x );
+n = 0;
+m = 0;
+x = floor( x );
+
+loop:
+
+for( i=0; i<500; i++ )
+{
+n++;
+m++;
+
+#if ONEARG || TWOARG || THREEARG || FOURARG
+/*ldprec();*/ /* set up floating point coprocessor */
+/* make random number in desired range */
+drand( &x );
+x = WIDTH * ( x - 1.0 ) + LOW;
+#if EXPSCALE
+x = exp(x);
+drand( &a );
+a = 1.0e-13 * x * a;
+if( x > 0.0 )
+ x -= a;
+else
+ x += a;
+#endif
+#if ONEINT
+k = x;
+x = k;
+#endif
+v = x;
+q1 = v; /* double number to q type */
+#endif
+
+/* do again if second argument required */
+
+#if TWOARG || THREEARG || FOURARG
+drand( &a );
+a = WIDTHA * ( a - 1.0 ) + LOWA;
+/*a /= 50.0;*/
+#if EXPSC2
+a = exp(a);
+drand( &y2 );
+y2 = 1.0e-13 * y2 * a;
+if( a > 0.0 )
+ a -= y2;
+else
+ a += y2;
+#endif
+#if TWOINT || THREEINT
+k = a + 0.25;
+a = k;
+#endif
+v = a;
+qy4 = v;
+#endif
+
+#if THREEARG || FOURARG
+drand( &b );
+#if PROB
+/*
+b = b - 1.0;
+b = a * b;
+*/
+#if 1
+/* This makes b <= a, for bdtr. */
+b = (a - LOWA) * ( b - 1.0 ) + LOWA;
+if( b > 1.0 && a > 1.0 )
+ b -= 1.0;
+else
+ {
+ a += 1.0;
+ k = a;
+ a = k;
+ v = a;
+ qy4 = v;
+ }
+#else
+b = WIDTHA * ( b - 1.0 ) + LOWA;
+#endif
+
+/* Half-integer a and b */
+/*
+a = 0.5*floor(2.0*a+1.0);
+b = 0.5*floor(2.0*b+1.0);
+*/
+v = a;
+qy4 = v;
+/*x = (a / (a+b));*/
+
+#else
+b = WIDTHA * ( b - 1.0 ) + LOWA;
+#endif
+#if THREEINT
+j = b + 0.25;
+b = j;
+#endif
+v = b;
+qb = v;
+#endif
+
+#if FOURARG
+drand( &c );
+c = WIDTHA * ( c - 1.0 ) + LOWA;
+/* for hyp2f1 to ensure c-a-b > -1 */
+/*
+z = c-a-b;
+if( z < -1.0 )
+ c -= 1.6 * z;
+*/
+v = c;
+qc = v;
+#endif
+
+#if VECARG
+for( j=0; j<3; j++)
+ {
+ drand( &x );
+ x = WIDTH * ( x - 1.0 ) + LOW;
+ v = x;
+ dp[j] = v;
+ q1 = v; /* double number to q type */
+ lp[j] = q1;
+ drand( &x );
+ x = WIDTH * ( x - 1.0 ) + LOW;
+ v = x;
+ dq[j] = v;
+ q1 = v; /* double number to q type */
+ lq[j] = q1;
+ }
+#endif /* VECARG */
+
+/*printf("%.16E %.16E\n", a, x);*/
+/* compute function under test */
+/* Set to double precision */
+/*dprec();*/
+#if ONEARG
+#if FOURANS
+/*FUNC( x, &z, &y2, &y3, &y4 );*/
+FUNC( x, &y4, &y2, &y3, &z );
+#else
+#if TWOANS
+FUNC( x, &z, &y2 );
+/*FUNC( x, &y2, &z );*/
+#else
+#if ONEINT
+z = FUNC( k );
+#else
+z = FUNC( x );
+#endif
+#endif
+#endif
+#endif
+
+#if TWOARG
+#if TWOINT
+z = FUNC( k, x );
+/*z = FUNC( x, k );*/
+/*z = FUNC( a, x );*/
+#else
+#if FOURANS
+FUNC( a, x, &z, &y2, &y3, &y4 );
+#else
+z = FUNC( a, x );
+#endif
+#endif
+#endif
+
+#if THREEARG
+#if THREEINT
+z = FUNC( j, k, x );
+#else
+z = FUNC( a, b, x );
+#endif
+#endif
+
+#if FOURARG
+z = FUNC( a, b, c, x );
+#endif
+
+#if VECARG
+z = FUNC( dp, dq );
+#endif
+
+q2 = z;
+/* handle detected overflow */
+if( (z == MAXNUM) || (z == -MAXNUM) )
+ {
+ printf("detected overflow ");
+#if FOURARG
+ printf("%.4E %.4E %.4E %.4E %.4E %6ld \n",
+ a, b, c, x, y, n);
+#else
+ printf("%.16E %.4E %.4E %6ld \n", x, a, z, n);
+#endif
+ e = 0.0;
+ m -= 1;
+ goto endlup;
+ }
+/* Skip high precision if underflow. */
+if( merror == UNDERFLOW )
+ goto underf;
+
+/* compute high precision function */
+/*ldprec();*/
+#if ONEARG
+#if FOURANS
+/*qy4 = QFUNC( q1, qz, qy2, qy3 );*/
+qz = QFUNC( q1, qy4, qy2, qy3 );
+#else
+#if TWOANS
+qy2 = QFUNC( q1, qz );
+/*qz = QFUNC( q1, qy2 );*/
+#else
+/* qy4 = 0.0L;*/
+/* qy4 = 1.0L;*/
+/*qz = QFUNC( qy4, q1 );*/
+/*qz = QFUNC( 1, q1 );*/
+qz = QFUNC( q1 ); /* normal */
+#endif
+#endif
+#endif
+
+#if TWOARG
+#if TWOINT
+qz = QFUNC( k, q1 );
+/*qz = QFUNC( q1, qy4 );*/
+/*qz = QFUNC( qy4, q1 );*/
+#else
+#if FOURANS
+qc = QFUNC( qy4, q1, qz, qy2, qy3 );
+#else
+/*qy4 = 0.0L;;*/
+/*qy4 = 1.0L );*/
+qz = QFUNC( qy4, q1 );
+#endif
+#endif
+#endif
+
+#if THREEARG
+#if THREEINT
+qz = QFUNC( j, k, q1 );
+#else
+qz = QFUNC( qy4, qb, q1 );
+#endif
+#endif
+
+#if FOURARG
+qz = QFUNC( qy4, qb, qc, q1 );
+#endif
+
+#if VECARG
+qz = QFUNC( lp, lq );
+#endif
+
+y = qz; /* correct answer, in double precision */
+
+/* get absolute error, in extended precision */
+qe = q2 - qz;
+e = qe; /* the error in double precision */
+
+/* handle function result equal to zero
+ or underflowed. */
+if( qz == 0.0L || merror == UNDERFLOW || fabs(z) < underthresh )
+ {
+underf:
+ merror = 0;
+/* Don't bother to print anything. */
+#if 0
+ printf("ans 0 ");
+#if ONEARG
+ printf("%.8E %.8E %.4E %6ld \n", x, y, e, n);
+#endif
+
+#if TWOARG
+#if TWOINT
+ printf("%d %.8E %.8E %.4E %6ld \n", k, x, y, e, n);
+#else
+ printf("%.6E %.6E %.6E %.4E %6ld \n", a, x, y, e, n);
+#endif
+#endif
+
+#if THREEARG
+ printf("%.6E %.6E %.6E %.6E %.4E %6ld \n", a, b, x, y, e, n);
+#endif
+
+#if FOURARG
+ printf("%.4E %.4E %.4E %.4E %.4E %.4E %6ld \n",
+ a, b, c, x, y, e, n);
+#endif
+#endif /* 0 */
+ qe = 0.0L;
+ e = 0.0;
+ m -= 1;
+ goto endlup;
+ }
+
+else
+
+/* relative error */
+
+/* comment out the following two lines if absolute accuracy report */
+
+#if RELERR
+ qe = qe / qz;
+#else
+ {
+ q2 = qz;
+ q2 = fabsl(q2);
+ if( q2 > 1.0L )
+ qe = qe / qz;
+ }
+#endif
+
+qave = qave + qe;
+/* absolute value of error */
+qe = fabs(qe);
+
+/* peak detect the error */
+if( qe > qmax )
+ {
+ qmax = qe;
+ sprintf(strmax, "%.4Le", qmax );
+#if ONEARG
+ printf("%.8E %.8E %s %6ld \n", x, y, strmax, n);
+#endif
+#if TWOARG
+#if TWOINT
+ printf("%d %.8E %.8E %s %6ld \n", k, x, y, strmax, n);
+#else
+ printf("%.6E %.6E %.6E %s %6ld \n", a, x, y, strmax, n);
+#endif
+#endif
+#if THREEARG
+ printf("%.6E %.6E %.6E %.6E %s %6ld \n", a, b, x, y, strmax, n);
+#endif
+#if FOURARG
+ printf("%.4E %.4E %.4E %.4E %.4E %s %6ld \n",
+ a, b, c, x, y, strmax, n);
+#endif
+#if VECARG
+ printf("%.8E %s %6ld \n", y, strmax, n);
+#endif
+ }
+
+/* accumulate rms error */
+/* rmsa += e * e; accumulate the square of the error */
+q2 = qe * qe;
+qrmsa = qrmsa + q2;
+endlup: ;
+/*ldprec();*/
+}
+
+/* report every 500 trials */
+/* rms = sqrt( rmsa/m ); */
+q1 = m;
+q2 = qrmsa / q1;
+q2 = sqrtl(q2);
+sprintf(strrms, "%.4Le", q2 );
+
+q2 = qave / q1;
+sprintf(strave, "%.4Le", q2 );
+/*
+printf("%6ld max = %s rms = %s ave = %s \n", m, strmax, strrms, strave );
+*/
+printf("%6ld max = %s rms = %s ave = %s \r", m, strmax, strrms, strave );
+fflush(stdout);
+goto loop;
+}
diff --git a/libm/double/minv.c b/libm/double/minv.c
new file mode 100644
index 000000000..df788fecf
--- /dev/null
+++ b/libm/double/minv.c
@@ -0,0 +1,61 @@
+/* minv.c
+ *
+ * Matrix inversion
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * int n, errcod;
+ * double A[n*n], X[n*n];
+ * double B[n];
+ * int IPS[n];
+ * int minv();
+ *
+ * errcod = minv( A, X, n, B, IPS );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Finds the inverse of the n by n matrix A. The result goes
+ * to X. B and IPS are scratch pad arrays of length n.
+ * The contents of matrix A are destroyed.
+ *
+ * The routine returns nonzero on error; error messages are printed
+ * by subroutine simq().
+ *
+ */
+
+minv( A, X, n, B, IPS )
+double A[], X[];
+int n;
+double B[];
+int IPS[];
+{
+double *pX;
+int i, j, k;
+
+for( i=1; i<n; i++ )
+ B[i] = 0.0;
+B[0] = 1.0;
+/* Reduce the matrix and solve for first right hand side vector */
+pX = X;
+k = simq( A, B, pX, n, 1, IPS );
+if( k )
+ return(-1);
+/* Solve for the remaining right hand side vectors */
+for( i=1; i<n; i++ )
+ {
+ B[i-1] = 0.0;
+ B[i] = 1.0;
+ pX += n;
+ k = simq( A, B, pX, n, -1, IPS );
+ if( k )
+ return(-1);
+ }
+/* Transpose the array of solution vectors */
+mtransp( n, X, X );
+return(0);
+}
+
diff --git a/libm/double/mod2pi.c b/libm/double/mod2pi.c
new file mode 100644
index 000000000..057954a9b
--- /dev/null
+++ b/libm/double/mod2pi.c
@@ -0,0 +1,122 @@
+/* Program to test range reduction of trigonometry functions
+ *
+ * -- Steve Moshier
+ */
+
+#include <math.h>
+#ifdef ANSIPROT
+extern double floor ( double );
+extern double ldexp ( double, int );
+extern double sin ( double );
+#else
+double floor(), ldexp(), sin();
+#endif
+
+#define TPI 6.283185307179586476925
+
+main()
+{
+char s[40];
+double a, n, t, x, y, z;
+int lflg;
+
+x = TPI/4.0;
+t = 1.0;
+
+loop:
+
+t = 2.0 * t;
+
+/* Stop testing at a point beyond which the integer part of
+ * x/2pi cannot be represented exactly by a double precision number.
+ * The library trigonometry functions will probably give up long before
+ * this point is reached.
+ */
+if( t > 1.0e16 )
+ exit(0);
+
+/* Adjust the following to choose a nontrivial x
+ * where test function(x) has a slope of about 1 or more.
+ */
+x = TPI * t + 0.5;
+
+z = x;
+lflg = 0;
+
+inlup:
+
+/* floor() returns the largest integer less than its argument.
+ * If you do not have this, or AINT(), then you may convert x/TPI
+ * to a long integer and then back to double; but in that case
+ * x will be limited to the largest value that will fit into a
+ * long integer.
+ */
+n = floor( z/TPI );
+
+/* Carefully subtract 2 pi n from x.
+ * This is done by subtracting n * 2**k in such a way that there
+ * is no arithmetic cancellation error at any step. The k are the
+ * bits in the number 2 pi.
+ *
+ * If you do not have ldexp(), then you may multiply or
+ * divide n by an appropriate power of 2 after each step.
+ * For example:
+ * a = z - 4*n;
+ * a -= 2*n;
+ * n /= 4;
+ * a -= n; n/4
+ * n /= 8;
+ * a -= n; n/32
+ * etc.
+ * This will only work if division by a power of 2 is exact.
+ */
+
+a = z - ldexp(n, 2); /* 4n */
+a -= ldexp( n, 1); /* 2n */
+a -= ldexp( n, -2 ); /* n/4 */
+a -= ldexp( n, -5 ); /* n/32 */
+a -= ldexp( n, -9 ); /* n/512 */
+a += ldexp( n, -15 ); /* add n/32768 */
+a -= ldexp( n, -17 ); /* n/131072 */
+a -= ldexp( n, -18 );
+a -= ldexp( n, -20 );
+a -= ldexp( n, -22 );
+a -= ldexp( n, -24 );
+a -= ldexp( n, -28 );
+a -= ldexp( n, -32 );
+a -= ldexp( n, -37 );
+a -= ldexp( n, -39 );
+a -= ldexp( n, -40 );
+a -= ldexp( n, -42 );
+a -= ldexp( n, -46 );
+a -= ldexp( n, -47 );
+
+/* Subtract what is left of 2 pi n after all the above reductions.
+ */
+a -= 2.44929359829470635445e-16 * n;
+
+/* If the test is extended too far, it is possible
+ * to have chosen the wrong value of n. The following
+ * will fix that, but at some reduction in accuracy.
+ */
+if( (a > TPI) || (a < -1e-11) )
+ {
+ z = a;
+ lflg += 1;
+ printf( "Warning! Reduction failed on first try.\n" );
+ goto inlup;
+ }
+if( a < 0.0 )
+ {
+ printf( "Warning! Reduced value < 0\n" );
+ a += TPI;
+ }
+
+/* Compute the test function at x and at a = x mod 2 pi.
+ */
+y = sin(x);
+z = sin(a);
+printf( "sin(%.15e) error = %.3e\n", x, y-z );
+goto loop;
+}
+
diff --git a/libm/double/monot.c b/libm/double/monot.c
new file mode 100644
index 000000000..bb00c5f28
--- /dev/null
+++ b/libm/double/monot.c
@@ -0,0 +1,308 @@
+
+/* monot.c
+ Floating point function test vectors.
+
+ Arguments and function values are synthesized for NPTS points in
+ the vicinity of each given tabulated test point. The points are
+ chosen to be near and on either side of the likely function algorithm
+ domain boundaries. Since the function programs change their methods
+ at these points, major coding errors or monotonicity failures might be
+ detected.
+
+ August, 1998
+ S. L. Moshier */
+
+
+#include <stdio.h>
+
+/* Avoid including math.h. */
+double frexp (double, int *);
+double ldexp (double, int);
+
+/* Number of test points to generate on each side of tabulated point. */
+#define NPTS 100
+
+/* Functions of one variable. */
+double exp (double);
+double log (double);
+double sin (double);
+double cos (double);
+double tan (double);
+double atan (double);
+double asin (double);
+double acos (double);
+double sinh (double);
+double cosh (double);
+double tanh (double);
+double asinh (double);
+double acosh (double);
+double atanh (double);
+double gamma (double);
+double fabs (double);
+double floor (double);
+
+struct oneargument
+ {
+ char *name; /* Name of the function. */
+ double (*func) (double);
+ double arg1; /* Function argument, assumed exact. */
+ double answer1; /* Exact, close to function value. */
+ double answer2; /* answer1 + answer2 has extended precision. */
+ double derivative; /* dy/dx evaluated at x = arg1. */
+ int thresh; /* Error report threshold. 2 = 1 ULP approx. */
+ };
+
+/* Add this to error threshold test[i].thresh. */
+#define OKERROR 0
+
+/* Unit of relative error in test[i].thresh. */
+static double MACHEP = 1.1102230246251565404e-16;
+/* extern double MACHEP; */
+
+
+struct oneargument test1[] =
+{
+ {"exp", exp, 1.0, 2.7182769775390625,
+ 4.85091998273536028747e-6, 2.71828182845904523536, 2},
+ {"exp", exp, -1.0, 3.678741455078125e-1,
+ 5.29566362982159552377e-6, 3.678794411714423215955e-1, 2},
+ {"exp", exp, 0.5, 1.648712158203125,
+ 9.1124970031468486507878e-6, 1.64872127070012814684865, 2},
+ {"exp", exp, -0.5, 6.065216064453125e-1,
+ 9.0532673209236037995e-6, 6.0653065971263342360e-1, 2},
+ {"exp", exp, 2.0, 7.3890533447265625,
+ 2.75420408772723042746e-6, 7.38905609893065022723, 2},
+ {"exp", exp, -2.0, 1.353302001953125e-1,
+ 5.08304130019189399949e-6, 1.3533528323661269189e-1, 2},
+ {"log", log, 1.41421356237309492343, 3.465728759765625e-1,
+ 7.1430341006605745676897e-7, 7.0710678118654758708668e-1, 2},
+ {"log", log, 7.07106781186547461715e-1, -3.46588134765625e-1,
+ 1.45444856522566402246e-5, 1.41421356237309517417, 2},
+ {"sin", sin, 7.85398163397448278999e-1, 7.0709228515625e-1,
+ 1.4496030297502751942956e-5, 7.071067811865475460497e-1, 2},
+ {"sin", sin, -7.85398163397448501044e-1, -7.071075439453125e-1,
+ 7.62758764840238811175e-7, 7.07106781186547389040e-1, 2},
+ {"sin", sin, 1.570796326794896558, 9.999847412109375e-1,
+ 1.52587890625e-5, 6.12323399573676588613e-17, 2},
+ {"sin", sin, -1.57079632679489678004, -1.0,
+ 1.29302922820150306903e-32, -1.60812264967663649223e-16, 2},
+ {"sin", sin, 4.712388980384689674, -1.0,
+ 1.68722975549458979398e-32, -1.83697019872102976584e-16, 2},
+ {"sin", sin, -4.71238898038468989604, 9.999847412109375e-1,
+ 1.52587890625e-5, 3.83475850529283315008e-17, 2},
+ {"cos", cos, 3.92699081698724139500E-1, 9.23873901367187500000E-1,
+ 5.63114409926198633370E-6, -3.82683432365089757586E-1, 2},
+ {"cos", cos, 7.85398163397448278999E-1, 7.07092285156250000000E-1,
+ 1.44960302975460497458E-5, -7.07106781186547502752E-1, 2},
+ {"cos", cos, 1.17809724509617241850E0, 3.82675170898437500000E-1,
+ 8.26146665231415693919E-6, -9.23879532511286738554E-1, 2},
+ {"cos", cos, 1.96349540849362069750E0, -3.82690429687500000000E-1,
+ 6.99732241029898567203E-6, -9.23879532511286785419E-1, 2},
+ {"cos", cos, 2.35619449019234483700E0, -7.07107543945312500000E-1,
+ 7.62758765040545859856E-7, -7.07106781186547589348E-1, 2},
+ {"cos", cos, 2.74889357189106897650E0, -9.23889160156250000000E-1,
+ 9.62764496328487887036E-6, -3.82683432365089870728E-1, 2},
+ {"cos", cos, 3.14159265358979311600E0, -1.00000000000000000000E0,
+ 7.49879891330928797323E-33, -1.22464679914735317723E-16, 2},
+ {"tan", tan, 7.85398163397448278999E-1, 9.999847412109375e-1,
+ 1.52587890624387676600E-5, 1.99999999999999987754E0, 2},
+ {"tan", tan, 1.17809724509617241850E0, 2.41419982910156250000E0,
+ 1.37332715322352112604E-5, 6.82842712474618858345E0, 2},
+ {"tan", tan, 1.96349540849362069750E0, -2.41421508789062500000E0,
+ 1.52551752942854759743E-6, 6.82842712474619262118E0, 2},
+ {"tan", tan, 2.35619449019234483700E0, -1.00001525878906250000E0,
+ 1.52587890623163029801E-5, 2.00000000000000036739E0, 2},
+ {"tan", tan, 2.74889357189106897650E0, -4.14215087890625000000E-1,
+ 1.52551752982565655126E-6, 1.17157287525381000640E0, 2},
+ {"atan", atan, 4.14213562373094923430E-1, 3.92684936523437500000E-1,
+ 1.41451752865477964149E-5, 8.53553390593273837869E-1, 2},
+ {"atan", atan, 1.0, 7.85385131835937500000E-1,
+ 1.30315615108096156608E-5, 0.5, 2},
+ {"atan", atan, 2.41421356237309492343E0, 1.17808532714843750000E0,
+ 1.19179477349460632350E-5, 1.46446609406726250782E-1, 2},
+ {"atan", atan, -2.41421356237309514547E0, -1.17810058593750000000E0,
+ 3.34084132752141908545E-6, 1.46446609406726227789E-1, 2},
+ {"atan", atan, -1.0, -7.85400390625000000000E-1,
+ 2.22722755169038433915E-6, 0.5, 2},
+ {"atan", atan, -4.14213562373095145475E-1, -3.92700195312500000000E-1,
+ 1.11361377576267665972E-6, 8.53553390593273703853E-1, 2},
+ {"asin", asin, 3.82683432365089615246E-1, 3.92684936523437500000E-1,
+ 1.41451752864854321970E-5, 1.08239220029239389286E0, 2},
+ {"asin", asin, 0.5, 5.23590087890625000000E-1,
+ 8.68770767387307710723E-6, 1.15470053837925152902E0, 2},
+ {"asin", asin, 7.07106781186547461715E-1, 7.85385131835937500000E-1,
+ 1.30315615107209645016E-5, 1.41421356237309492343E0, 2},
+ {"asin", asin, 9.23879532511286738483E-1, 1.17808532714843750000E0,
+ 1.19179477349183147612E-5, 2.61312592975275276483E0, 2},
+ {"asin", asin, -0.5, -5.23605346679687500000E-1,
+ 6.57108138862692289277E-6, 1.15470053837925152902E0, 2},
+ {"acos", acos, 1.95090322016128192573E-1, 1.37443542480468750000E0,
+ 1.13611408471185777914E-5, -1.01959115820831832232E0, 2},
+ {"acos", acos, 3.82683432365089615246E-1, 1.17808532714843750000E0,
+ 1.19179477351337991247E-5, -1.08239220029239389286E0, 2},
+ {"acos", acos, 0.5, 1.04719543457031250000E0,
+ 2.11662628524615421446E-6, -1.15470053837925152902E0, 2},
+ {"acos", acos, 7.07106781186547461715E-1, 7.85385131835937500000E-1,
+ 1.30315615108982668201E-5, -1.41421356237309492343E0, 2},
+ {"acos", acos, 9.23879532511286738483E-1, 3.92684936523437500000E-1,
+ 1.41451752867009165605E-5, -2.61312592975275276483E0, 2},
+ {"acos", acos, 9.80785280403230430579E-1, 1.96334838867187500000E-1,
+ 1.47019821746724723933E-5, -5.12583089548300990774E0, 2},
+ {"acos", acos, -0.5, 2.09439086914062500000E0,
+ 4.23325257049230842892E-6, -1.15470053837925152902E0, 2},
+ {"sinh", sinh, 1.0, 1.17518615722656250000E0,
+ 1.50364172389568823819E-5, 1.54308063481524377848E0, 2},
+ {"sinh", sinh, 7.09089565712818057364E2, 4.49423283712885057274E307,
+ 4.25947714184369757620E208, 4.49423283712885057274E307, 2},
+ {"sinh", sinh, 2.22044604925031308085E-16, 0.00000000000000000000E0,
+ 2.22044604925031308085E-16, 1.00000000000000000000E0, 2},
+ {"cosh", cosh, 7.09089565712818057364E2, 4.49423283712885057274E307,
+ 4.25947714184369757620E208, 4.49423283712885057274E307, 2},
+ {"cosh", cosh, 1.0, 1.54307556152343750000E0,
+ 5.07329180627847790562E-6, 1.17520119364380145688E0, 2},
+ {"cosh", cosh, 0.5, 1.12762451171875000000E0,
+ 1.45348763078522622516E-6, 5.21095305493747361622E-1, 2},
+ {"tanh", tanh, 0.5, 4.62112426757812500000E-1,
+ 4.73050219725850231848E-6, 7.86447732965927410150E-1, 2},
+ {"tanh", tanh, 5.49306144334054780032E-1, 4.99984741210937500000E-1,
+ 1.52587890624507506378E-5, 7.50000000000000049249E-1, 2},
+ {"tanh", tanh, 0.625, 5.54595947265625000000E-1,
+ 3.77508375729399903910E-6, 6.92419147969988069631E-1, 2},
+ {"asinh", asinh, 0.5, 4.81201171875000000000E-1,
+ 1.06531846034474977589E-5, 8.94427190999915878564E-1, 2},
+ {"asinh", asinh, 1.0, 8.81362915039062500000E-1,
+ 1.06719804805252326093E-5, 7.07106781186547524401E-1, 2},
+ {"asinh", asinh, 2.0, 1.44363403320312500000E0,
+ 1.44197568534249327674E-6, 4.47213595499957939282E-1, 2},
+ {"acosh", acosh, 2.0, 1.31695556640625000000E0,
+ 2.33051856670862504635E-6, 5.77350269189625764509E-1, 2},
+ {"acosh", acosh, 1.5, 9.62417602539062500000E-1,
+ 6.04758014439499551783E-6, 8.94427190999915878564E-1, 2},
+ {"acosh", acosh, 1.03125, 2.49343872070312500000E-1,
+ 9.62177257298785143908E-6, 3.96911150685467059809E0, 2},
+ {"atanh", atanh, 0.5, 5.49301147460937500000E-1,
+ 4.99687311734569762262E-6, 1.33333333333333333333E0, 2},
+#if 0
+ {"gamma", gamma, 1.0, 1.0,
+ 0.0, -5.772156649015328606e-1, 2},
+ {"gamma", gamma, 2.0, 1.0,
+ 0.0, 4.2278433509846713939e-1, 2},
+ {"gamma", gamma, 3.0, 2.0,
+ 0.0, 1.845568670196934279, 2},
+ {"gamma", gamma, 4.0, 6.0,
+ 0.0, 7.536706010590802836, 2},
+#endif
+ {"null", NULL, 0.0, 0.0, 0.0, 2},
+};
+
+/* These take care of extra-precise floating point register problems. */
+volatile double volat1;
+volatile double volat2;
+
+
+/* Return the next nearest floating point value to X
+ in the direction of UPDOWN (+1 or -1).
+ (Fails if X is denormalized.) */
+
+double
+nextval (x, updown)
+ double x;
+ int updown;
+{
+ double m;
+ int i;
+
+ volat1 = x;
+ m = 0.25 * MACHEP * volat1 * updown;
+ volat2 = volat1 + m;
+ if (volat2 != volat1)
+ printf ("successor failed\n");
+
+ for (i = 2; i < 10; i++)
+ {
+ volat2 = volat1 + i * m;
+ if (volat1 != volat2)
+ return volat2;
+ }
+
+ printf ("nextval failed\n");
+ return volat1;
+}
+
+
+
+
+int
+main ()
+{
+ double (*fun1) (double);
+ int i, j, errs, tests;
+ double x, x0, y, dy, err;
+
+ /* Set math coprocessor to double precision. */
+ /* dprec (); */
+ errs = 0;
+ tests = 0;
+ i = 0;
+
+ for (;;)
+ {
+ fun1 = test1[i].func;
+ if (fun1 == NULL)
+ break;
+ volat1 = test1[i].arg1;
+ x0 = volat1;
+ x = volat1;
+ for (j = 0; j <= NPTS; j++)
+ {
+ volat1 = x - x0;
+ dy = volat1 * test1[i].derivative;
+ dy = test1[i].answer2 + dy;
+ volat1 = test1[i].answer1 + dy;
+ volat2 = (*(fun1)) (x);
+ if (volat2 != volat1)
+ {
+ /* Report difference between program result
+ and extended precision function value. */
+ err = volat2 - test1[i].answer1;
+ err = err - dy;
+ err = err / volat1;
+ if (fabs (err) > ((OKERROR + test1[i].thresh) * MACHEP))
+ {
+ printf ("%d %s(%.16e) = %.16e, rel err = %.3e\n",
+ j, test1[i].name, x, volat2, err);
+ errs += 1;
+ }
+ }
+ x = nextval (x, 1);
+ tests += 1;
+ }
+
+ x = x0;
+ x = nextval (x, -1);
+ for (j = 1; j < NPTS; j++)
+ {
+ volat1 = x - x0;
+ dy = volat1 * test1[i].derivative;
+ dy = test1[i].answer2 + dy;
+ volat1 = test1[i].answer1 + dy;
+ volat2 = (*(fun1)) (x);
+ if (volat2 != volat1)
+ {
+ err = volat2 - test1[i].answer1;
+ err = err - dy;
+ err = err / volat1;
+ if (fabs (err) > ((OKERROR + test1[i].thresh) * MACHEP))
+ {
+ printf ("%d %s(%.16e) = %.16e, rel err = %.3e\n",
+ j, test1[i].name, x, volat2, err);
+ errs += 1;
+ }
+ }
+ x = nextval (x, -1);
+ tests += 1;
+ }
+ i += 1;
+ }
+ printf ("%d errors in %d tests\n", errs, tests);
+}
diff --git a/libm/double/mtherr.c b/libm/double/mtherr.c
new file mode 100644
index 000000000..ed3d26d51
--- /dev/null
+++ b/libm/double/mtherr.c
@@ -0,0 +1,102 @@
+/* mtherr.c
+ *
+ * Library common error handling routine
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * char *fctnam;
+ * int code;
+ * int 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 <stdio.h>
+#include <math.h>
+
+int merror = 0;
+
+/* 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"
+};
+
+
+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 );
+
+/* Set global error message word */
+merror = code;
+
+/* Display error message defined
+ * by the code argument.
+ */
+if( (code <= 0) || (code >= 7) )
+ code = 0;
+printf( "%s error\n", ermsg[code] );
+
+/* Return to calling
+ * program
+ */
+return( 0 );
+}
diff --git a/libm/double/mtransp.c b/libm/double/mtransp.c
new file mode 100644
index 000000000..b4a54dd0f
--- /dev/null
+++ b/libm/double/mtransp.c
@@ -0,0 +1,61 @@
+/* mtransp.c
+ *
+ * Matrix transpose
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * int n;
+ * double A[n*n], T[n*n];
+ *
+ * mtransp( n, A, T );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ *
+ * T[r][c] = A[c][r]
+ *
+ *
+ * Transposes the n by n square matrix A and puts the result in T.
+ * The output, T, may occupy the same storage as A.
+ *
+ *
+ *
+ */
+
+
+mtransp( n, A, T )
+int n;
+double *A, *T;
+{
+int i, j, np1;
+double *pAc, *pAr, *pTc, *pTr, *pA0, *pT0;
+double x, y;
+
+np1 = n+1;
+pA0 = A;
+pT0 = T;
+for( i=0; i<n-1; i++ ) /* row index */
+ {
+ pAc = pA0; /* next diagonal element of input */
+ pAr = pAc + n; /* next row down underneath the diagonal element */
+ pTc = pT0; /* next diagonal element of the output */
+ pTr = pTc + n; /* next row underneath */
+ *pTc++ = *pAc++; /* copy the diagonal element */
+ for( j=i+1; j<n; j++ ) /* column index */
+ {
+ x = *pAr;
+ *pTr = *pAc++;
+ *pTc++ = x;
+ pAr += n;
+ pTr += n;
+ }
+ pA0 += np1; /* &A[n*i+i] for next i */
+ pT0 += np1; /* &T[n*i+i] for next i */
+ }
+*pT0 = *pA0; /* copy the diagonal element */
+}
+
diff --git a/libm/double/mtst.c b/libm/double/mtst.c
new file mode 100644
index 000000000..2559d2340
--- /dev/null
+++ b/libm/double/mtst.c
@@ -0,0 +1,464 @@
+/* mtst.c
+ Consistency tests for math functions.
+ To get strict rounding rules on a 386 or 68000 computer,
+ define SETPREC to 1.
+
+ With NTRIALS=10000, the following are typical results for
+ IEEE double precision arithmetic.
+
+Consistency test of math functions.
+Max and rms relative errors for 10000 random arguments.
+x = cbrt( cube(x) ): max = 0.00E+00 rms = 0.00E+00
+x = atan( tan(x) ): max = 2.21E-16 rms = 3.27E-17
+x = sin( asin(x) ): max = 2.13E-16 rms = 2.95E-17
+x = sqrt( square(x) ): max = 0.00E+00 rms = 0.00E+00
+x = log( exp(x) ): max = 1.11E-16 A rms = 4.35E-18 A
+x = tanh( atanh(x) ): max = 2.22E-16 rms = 2.43E-17
+x = asinh( sinh(x) ): max = 2.05E-16 rms = 3.49E-18
+x = acosh( cosh(x) ): max = 1.43E-15 A rms = 1.54E-17 A
+x = log10( exp10(x) ): max = 5.55E-17 A rms = 1.27E-18 A
+x = pow( pow(x,a),1/a ): max = 7.60E-14 rms = 1.05E-15
+x = cos( acos(x) ): max = 2.22E-16 A rms = 6.90E-17 A
+*/
+
+/*
+Cephes Math Library Release 2.8: June, 2000
+Copyright 1984, 1987, 1988, 2000 by Stephen L. Moshier
+*/
+
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <math.h>
+
+#ifndef NTRIALS
+#define NTRIALS 10000
+#endif
+
+#define SETPREC 1
+#define STRTST 0
+
+#define WTRIALS (NTRIALS/5)
+
+#ifdef ANSIPROT
+extern double fabs ( double );
+extern double sqrt ( double );
+extern double cbrt ( double );
+extern double exp ( double );
+extern double log ( double );
+extern double exp10 ( double );
+extern double log10 ( double );
+extern double tan ( double );
+extern double atan ( double );
+extern double sin ( double );
+extern double asin ( double );
+extern double cos ( double );
+extern double acos ( double );
+extern double pow ( double, double );
+extern double tanh ( double );
+extern double atanh ( double );
+extern double sinh ( double );
+extern double asinh ( double x );
+extern double cosh ( double );
+extern double acosh ( double );
+extern double gamma ( double );
+extern double lgam ( double );
+#else
+double fabs(), sqrt(), cbrt(), exp(), log();
+double exp10(), log10(), tan(), atan();
+double sin(), asin(), cos(), acos(), pow();
+double tanh(), atanh(), sinh(), asinh(), cosh(), acosh();
+double gamma(), lgam();
+#endif
+
+/* C9X spells lgam lgamma. */
+#define GLIBC2 0
+#if GLIBC2
+double lgamma (double);
+#endif
+
+#if SETPREC
+int dprec();
+#endif
+
+int drand();
+/* void exit(); */
+/* int printf(); */
+
+
+/* Provide inverses for square root and cube root: */
+double square(x)
+double x;
+{
+return( x * x );
+}
+
+double cube(x)
+double x;
+{
+return( x * x * x );
+}
+
+/* lookup table for each function */
+struct fundef
+ {
+ char *nam1; /* the function */
+ double (*name )();
+ char *nam2; /* its inverse */
+ double (*inv )();
+ int nargs; /* number of function arguments */
+ int tstyp; /* type code of the function */
+ long ctrl; /* relative error flag */
+ double arg1w; /* width of domain for 1st arg */
+ double arg1l; /* lower bound domain 1st arg */
+ long arg1f; /* flags, e.g. integer arg */
+ double arg2w; /* same info for args 2, 3, 4 */
+ double arg2l;
+ long arg2f;
+/*
+ double arg3w;
+ double arg3l;
+ long arg3f;
+ double arg4w;
+ double arg4l;
+ long arg4f;
+*/
+ };
+
+
+/* fundef.ctrl bits: */
+#define RELERR 1
+
+/* fundef.tstyp test types: */
+#define POWER 1
+#define ELLIP 2
+#define GAMMA 3
+#define WRONK1 4
+#define WRONK2 5
+#define WRONK3 6
+
+/* fundef.argNf argument flag bits: */
+#define INT 2
+#define EXPSCAL 4
+
+extern double MINLOG;
+extern double MAXLOG;
+extern double PI;
+extern double PIO2;
+/*
+define MINLOG -170.0
+define MAXLOG +170.0
+define PI 3.14159265358979323846
+define PIO2 1.570796326794896619
+*/
+
+#define NTESTS 12
+struct fundef defs[NTESTS] = {
+{" cube", cube, " cbrt", cbrt, 1, 0, 1, 2002.0, -1001.0, 0,
+0.0, 0.0, 0},
+{" tan", tan, " atan", atan, 1, 0, 1, 0.0, 0.0, 0,
+0.0, 0.0, 0},
+{" asin", asin, " sin", sin, 1, 0, 1, 2.0, -1.0, 0,
+0.0, 0.0, 0},
+{"square", square, " sqrt", sqrt, 1, 0, 1, 170.0, -85.0, EXPSCAL,
+0.0, 0.0, 0},
+{" exp", exp, " log", log, 1, 0, 0, 340.0, -170.0, 0,
+0.0, 0.0, 0},
+{" atanh", atanh, " tanh", tanh, 1, 0, 1, 2.0, -1.0, 0,
+0.0, 0.0, 0},
+{" sinh", sinh, " asinh", asinh, 1, 0, 1, 340.0, 0.0, 0,
+0.0, 0.0, 0},
+{" cosh", cosh, " acosh", acosh, 1, 0, 0, 340.0, 0.0, 0,
+0.0, 0.0, 0},
+{" exp10", exp10, " log10", log10, 1, 0, 0, 340.0, -170.0, 0,
+0.0, 0.0, 0},
+{"pow", pow, "pow", pow, 2, POWER, 1, 21.0, 0.0, 0,
+42.0, -21.0, 0},
+{" acos", acos, " cos", cos, 1, 0, 0, 2.0, -1.0, 0,
+0.0, 0.0, 0},
+#if GLIBC2
+{ "gamma", gamma, "lgamma", lgamma, 1, GAMMA, 0, 34.0, 0.0, 0,
+0.0, 0.0, 0},
+#else
+{ "gamma", gamma, "lgam", lgam, 1, GAMMA, 0, 34.0, 0.0, 0,
+0.0, 0.0, 0},
+#endif
+};
+
+static char *headrs[] = {
+"x = %s( %s(x) ): ",
+"x = %s( %s(x,a),1/a ): ", /* power */
+"Legendre %s, %s: ", /* ellip */
+"%s(x) = log(%s(x)): ", /* gamma */
+"Wronksian of %s, %s: ",
+"Wronksian of %s, %s: ",
+"Wronksian of %s, %s: "
+};
+
+static double yy1 = 0.0;
+static double y2 = 0.0;
+static double y3 = 0.0;
+static double y4 = 0.0;
+static double a = 0.0;
+static double x = 0.0;
+static double y = 0.0;
+static double z = 0.0;
+static double e = 0.0;
+static double max = 0.0;
+static double rmsa = 0.0;
+static double rms = 0.0;
+static double ave = 0.0;
+
+
+int main()
+{
+double (*fun )();
+double (*ifun )();
+struct fundef *d;
+int i, k, itst;
+int m, ntr;
+
+#if SETPREC
+dprec(); /* set coprocessor precision */
+#endif
+ntr = NTRIALS;
+printf( "Consistency test of math functions.\n" );
+printf( "Max and rms relative errors for %d random arguments.\n",
+ ntr );
+
+/* Initialize machine dependent parameters: */
+defs[1].arg1w = PI;
+defs[1].arg1l = -PI/2.0;
+/* Microsoft C has trouble with denormal numbers. */
+#if 0
+defs[3].arg1w = MAXLOG;
+defs[3].arg1l = -MAXLOG/2.0;
+defs[4].arg1w = 2*MAXLOG;
+defs[4].arg1l = -MAXLOG;
+#endif
+defs[6].arg1w = 2.0*MAXLOG;
+defs[6].arg1l = -MAXLOG;
+defs[7].arg1w = MAXLOG;
+defs[7].arg1l = 0.0;
+
+
+/* Outer loop, on the test number: */
+
+for( itst=STRTST; itst<NTESTS; itst++ )
+{
+d = &defs[itst];
+k = 0;
+m = 0;
+max = 0.0;
+rmsa = 0.0;
+ave = 0.0;
+fun = d->name;
+ifun = d->inv;
+
+/* Absolute error criterion starts with gamma function
+ * (put all such at end of table)
+ */
+if( d->tstyp == GAMMA )
+ printf( "Absolute error criterion (but relative if >1):\n" );
+
+/* Smaller number of trials for Wronksians
+ * (put them at end of list)
+ */
+if( d->tstyp == WRONK1 )
+ {
+ ntr = WTRIALS;
+ printf( "Absolute error and only %d trials:\n", ntr );
+ }
+
+printf( headrs[d->tstyp], d->nam2, d->nam1 );
+
+for( i=0; i<ntr; i++ )
+{
+m++;
+
+/* make random number(s) in desired range(s) */
+switch( d->nargs )
+{
+
+default:
+goto illegn;
+
+case 2:
+drand( &a );
+a = d->arg2w * ( a - 1.0 ) + d->arg2l;
+if( d->arg2f & EXPSCAL )
+ {
+ a = exp(a);
+ drand( &y2 );
+ a -= 1.0e-13 * a * y2;
+ }
+if( d->arg2f & INT )
+ {
+ k = a + 0.25;
+ a = k;
+ }
+
+case 1:
+drand( &x );
+x = d->arg1w * ( x - 1.0 ) + d->arg1l;
+if( d->arg1f & EXPSCAL )
+ {
+ x = exp(x);
+ drand( &a );
+ x += 1.0e-13 * x * a;
+ }
+}
+
+
+/* compute function under test */
+switch( d->nargs )
+ {
+ case 1:
+ switch( d->tstyp )
+ {
+ case ELLIP:
+ yy1 = ( *(fun) )(x);
+ y2 = ( *(fun) )(1.0-x);
+ y3 = ( *(ifun) )(x);
+ y4 = ( *(ifun) )(1.0-x);
+ break;
+
+#if 1
+ case GAMMA:
+#if GLIBC2
+ y = lgamma(x);
+#else
+ y = lgam(x);
+#endif
+ x = log( gamma(x) );
+ break;
+#endif
+ default:
+ z = ( *(fun) )(x);
+ y = ( *(ifun) )(z);
+ }
+ break;
+
+ case 2:
+ if( d->arg2f & INT )
+ {
+ switch( d->tstyp )
+ {
+ case WRONK1:
+ yy1 = (*fun)( k, x ); /* jn */
+ y2 = (*fun)( k+1, x );
+ y3 = (*ifun)( k, x ); /* yn */
+ y4 = (*ifun)( k+1, x );
+ break;
+
+ case WRONK2:
+ yy1 = (*fun)( a, x ); /* iv */
+ y2 = (*fun)( a+1.0, x );
+ y3 = (*ifun)( k, x ); /* kn */
+ y4 = (*ifun)( k+1, x );
+ break;
+
+ default:
+ z = (*fun)( k, x );
+ y = (*ifun)( k, z );
+ }
+ }
+ else
+ {
+ if( d->tstyp == POWER )
+ {
+ z = (*fun)( x, a );
+ y = (*ifun)( z, 1.0/a );
+ }
+ else
+ {
+ z = (*fun)( a, x );
+ y = (*ifun)( a, z );
+ }
+ }
+ break;
+
+
+ default:
+illegn:
+ printf( "Illegal nargs= %d", d->nargs );
+ exit(1);
+ }
+
+switch( d->tstyp )
+ {
+ case WRONK1:
+ e = (y2*y3 - yy1*y4) - 2.0/(PI*x); /* Jn, Yn */
+ break;
+
+ case WRONK2:
+ e = (y2*y3 + yy1*y4) - 1.0/x; /* In, Kn */
+ break;
+
+ case ELLIP:
+ e = (yy1-y3)*y4 + y3*y2 - PIO2;
+ break;
+
+ default:
+ e = y - x;
+ break;
+ }
+
+if( d->ctrl & RELERR )
+ e /= x;
+else
+ {
+ if( fabs(x) > 1.0 )
+ e /= x;
+ }
+
+ave += e;
+/* absolute value of error */
+if( e < 0 )
+ e = -e;
+
+/* peak detect the error */
+if( e > max )
+ {
+ max = e;
+
+ if( e > 1.0e-10 )
+ {
+ printf("x %.6E z %.6E y %.6E max %.4E\n",
+ x, z, y, max);
+ if( d->tstyp == POWER )
+ {
+ printf( "a %.6E\n", a );
+ }
+ if( d->tstyp >= WRONK1 )
+ {
+ printf( "yy1 %.4E y2 %.4E y3 %.4E y4 %.4E k %d x %.4E\n",
+ yy1, y2, y3, y4, k, x );
+ }
+ }
+
+/*
+ printf("%.8E %.8E %.4E %6ld \n", x, y, max, n);
+ printf("%d %.8E %.8E %.4E %6ld \n", k, x, y, max, n);
+ printf("%.6E %.6E %.6E %.4E %6ld \n", a, x, y, max, n);
+ printf("%.6E %.6E %.6E %.6E %.4E %6ld \n", a, b, x, y, max, n);
+ printf("%.4E %.4E %.4E %.4E %.4E %.4E %6ld \n",
+ a, b, c, x, y, max, n);
+*/
+ }
+
+/* accumulate rms error */
+e *= 1.0e16; /* adjust range */
+rmsa += e * e; /* accumulate the square of the error */
+}
+
+/* report after NTRIALS trials */
+rms = 1.0e-16 * sqrt( rmsa/m );
+if(d->ctrl & RELERR)
+ printf(" max = %.2E rms = %.2E\n", max, rms );
+else
+ printf(" max = %.2E A rms = %.2E A\n", max, rms );
+} /* loop on itst */
+
+exit(0);
+}
diff --git a/libm/double/nbdtr.c b/libm/double/nbdtr.c
new file mode 100644
index 000000000..9930a4087
--- /dev/null
+++ b/libm/double/nbdtr.c
@@ -0,0 +1,222 @@
+/* nbdtr.c
+ *
+ * Negative binomial distribution
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * int k, n;
+ * double p, y, nbdtr();
+ *
+ * y = nbdtr( 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:
+ *
+ * Tested at random points (a,b,p), with p between 0 and 1.
+ *
+ * a,b Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE 0,100 100000 1.7e-13 8.8e-15
+ * See also incbet.c.
+ *
+ */
+ /* nbdtrc.c
+ *
+ * Complemented negative binomial distribution
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * int k, n;
+ * double p, y, nbdtrc();
+ *
+ * y = nbdtrc( 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:
+ *
+ * Tested at random points (a,b,p), with p between 0 and 1.
+ *
+ * a,b Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE 0,100 100000 1.7e-13 8.8e-15
+ * See also incbet.c.
+ */
+
+/* nbdtrc
+ *
+ * Complemented negative binomial distribution
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * int k, n;
+ * double p, y, nbdtrc();
+ *
+ * y = nbdtrc( 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:
+ *
+ * See incbet.c.
+ */
+ /* nbdtri
+ *
+ * Functional inverse of negative binomial distribution
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * int k, n;
+ * double p, y, nbdtri();
+ *
+ * p = nbdtri( k, n, y );
+ *
+ * DESCRIPTION:
+ *
+ * Finds the argument p such that nbdtr(k,n,p) is equal to y.
+ *
+ * ACCURACY:
+ *
+ * Tested at random points (a,b,y), with y between 0 and 1.
+ *
+ * a,b Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE 0,100 100000 1.5e-14 8.5e-16
+ * See also incbi.c.
+ */
+
+/*
+Cephes Math Library Release 2.8: June, 2000
+Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier
+*/
+
+#include <math.h>
+#ifdef ANSIPROT
+extern double incbet ( double, double, double );
+extern double incbi ( double, double, double );
+#else
+double incbet(), incbi();
+#endif
+
+double nbdtrc( k, n, p )
+int k, n;
+double p;
+{
+double dk, dn;
+
+if( (p < 0.0) || (p > 1.0) )
+ goto domerr;
+if( k < 0 )
+ {
+domerr:
+ mtherr( "nbdtr", DOMAIN );
+ return( 0.0 );
+ }
+
+dk = k+1;
+dn = n;
+return( incbet( dk, dn, 1.0 - p ) );
+}
+
+
+
+double nbdtr( k, n, p )
+int k, n;
+double p;
+{
+double dk, dn;
+
+if( (p < 0.0) || (p > 1.0) )
+ goto domerr;
+if( k < 0 )
+ {
+domerr:
+ mtherr( "nbdtr", DOMAIN );
+ return( 0.0 );
+ }
+dk = k+1;
+dn = n;
+return( incbet( dn, dk, p ) );
+}
+
+
+
+double nbdtri( k, n, p )
+int k, n;
+double p;
+{
+double dk, dn, w;
+
+if( (p < 0.0) || (p > 1.0) )
+ goto domerr;
+if( k < 0 )
+ {
+domerr:
+ mtherr( "nbdtri", DOMAIN );
+ return( 0.0 );
+ }
+dk = k+1;
+dn = n;
+w = incbi( dn, dk, p );
+return( w );
+}
diff --git a/libm/double/ndtr.c b/libm/double/ndtr.c
new file mode 100644
index 000000000..75d59ab54
--- /dev/null
+++ b/libm/double/ndtr.c
@@ -0,0 +1,481 @@
+/* ndtr.c
+ *
+ * Normal distribution function
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, ndtr();
+ *
+ * y = ndtr( 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
+ * DEC -13,0 8000 2.1e-15 4.8e-16
+ * IEEE -13,0 30000 3.4e-14 6.7e-15
+ *
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * erfc underflow x > 37.519379347 0.0
+ *
+ */
+ /* erf.c
+ *
+ * Error function
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, erf();
+ *
+ * y = erf( 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 * P4(x**2)/Q5(x**2); otherwise
+ * erf(x) = 1 - erfc(x).
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * DEC 0,1 14000 4.7e-17 1.5e-17
+ * IEEE 0,1 30000 3.7e-16 1.0e-16
+ *
+ */
+ /* erfc.c
+ *
+ * Complementary error function
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, erfc();
+ *
+ * y = erfc( 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 rational
+ * approximations are computed.
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * DEC 0, 9.2319 12000 5.1e-16 1.2e-16
+ * IEEE 0,26.6417 30000 5.7e-14 1.5e-14
+ *
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * erfc underflow x > 9.231948545 (DEC) 0.0
+ *
+ *
+ */
+
+
+/*
+Cephes Math Library Release 2.8: June, 2000
+Copyright 1984, 1987, 1988, 1992, 2000 by Stephen L. Moshier
+*/
+
+
+#include <math.h>
+
+extern double SQRTH;
+extern double MAXLOG;
+
+
+#ifdef UNK
+static double P[] = {
+ 2.46196981473530512524E-10,
+ 5.64189564831068821977E-1,
+ 7.46321056442269912687E0,
+ 4.86371970985681366614E1,
+ 1.96520832956077098242E2,
+ 5.26445194995477358631E2,
+ 9.34528527171957607540E2,
+ 1.02755188689515710272E3,
+ 5.57535335369399327526E2
+};
+static double Q[] = {
+/* 1.00000000000000000000E0,*/
+ 1.32281951154744992508E1,
+ 8.67072140885989742329E1,
+ 3.54937778887819891062E2,
+ 9.75708501743205489753E2,
+ 1.82390916687909736289E3,
+ 2.24633760818710981792E3,
+ 1.65666309194161350182E3,
+ 5.57535340817727675546E2
+};
+static double R[] = {
+ 5.64189583547755073984E-1,
+ 1.27536670759978104416E0,
+ 5.01905042251180477414E0,
+ 6.16021097993053585195E0,
+ 7.40974269950448939160E0,
+ 2.97886665372100240670E0
+};
+static double S[] = {
+/* 1.00000000000000000000E0,*/
+ 2.26052863220117276590E0,
+ 9.39603524938001434673E0,
+ 1.20489539808096656605E1,
+ 1.70814450747565897222E1,
+ 9.60896809063285878198E0,
+ 3.36907645100081516050E0
+};
+static double T[] = {
+ 9.60497373987051638749E0,
+ 9.00260197203842689217E1,
+ 2.23200534594684319226E3,
+ 7.00332514112805075473E3,
+ 5.55923013010394962768E4
+};
+static double U[] = {
+/* 1.00000000000000000000E0,*/
+ 3.35617141647503099647E1,
+ 5.21357949780152679795E2,
+ 4.59432382970980127987E3,
+ 2.26290000613890934246E4,
+ 4.92673942608635921086E4
+};
+
+#define UTHRESH 37.519379347
+#endif
+
+#ifdef DEC
+static unsigned short P[] = {
+0030207,0054445,0011173,0021706,
+0040020,0067272,0030661,0122075,
+0040756,0151236,0173053,0067042,
+0041502,0106175,0062555,0151457,
+0042104,0102525,0047401,0003667,
+0042403,0116176,0011446,0075303,
+0042551,0120723,0061641,0123275,
+0042600,0070651,0007264,0134516,
+0042413,0061102,0167507,0176625
+};
+static unsigned short Q[] = {
+/*0040200,0000000,0000000,0000000,*/
+0041123,0123257,0165741,0017142,
+0041655,0065027,0173413,0115450,
+0042261,0074011,0021573,0004150,
+0042563,0166530,0013662,0007200,
+0042743,0176427,0162443,0105214,
+0043014,0062546,0153727,0123772,
+0042717,0012470,0006227,0067424,
+0042413,0061103,0003042,0013254
+};
+static unsigned short R[] = {
+0040020,0067272,0101024,0155421,
+0040243,0037467,0056706,0026462,
+0040640,0116017,0120665,0034315,
+0040705,0020162,0143350,0060137,
+0040755,0016234,0134304,0130157,
+0040476,0122700,0051070,0015473
+};
+static unsigned short S[] = {
+/*0040200,0000000,0000000,0000000,*/
+0040420,0126200,0044276,0070413,
+0041026,0053051,0007302,0063746,
+0041100,0144203,0174051,0061151,
+0041210,0123314,0126343,0177646,
+0041031,0137125,0051431,0033011,
+0040527,0117362,0152661,0066201
+};
+static unsigned short T[] = {
+0041031,0126770,0170672,0166101,
+0041664,0006522,0072360,0031770,
+0043013,0100025,0162641,0126671,
+0043332,0155231,0161627,0076200,
+0044131,0024115,0021020,0117343
+};
+static unsigned short U[] = {
+/*0040200,0000000,0000000,0000000,*/
+0041406,0037461,0177575,0032714,
+0042402,0053350,0123061,0153557,
+0043217,0111227,0032007,0164217,
+0043660,0145000,0004013,0160114,
+0044100,0071544,0167107,0125471
+};
+#define UTHRESH 14.0
+#endif
+
+#ifdef IBMPC
+static unsigned short P[] = {
+0x6479,0xa24f,0xeb24,0x3df0,
+0x3488,0x4636,0x0dd7,0x3fe2,
+0x6dc4,0xdec5,0xda53,0x401d,
+0xba66,0xacad,0x518f,0x4048,
+0x20f7,0xa9e0,0x90aa,0x4068,
+0xcf58,0xc264,0x738f,0x4080,
+0x34d8,0x6c74,0x343a,0x408d,
+0x972a,0x21d6,0x0e35,0x4090,
+0xffb3,0x5de8,0x6c48,0x4081
+};
+static unsigned short Q[] = {
+/*0x0000,0x0000,0x0000,0x3ff0,*/
+0x23cc,0xfd7c,0x74d5,0x402a,
+0x7365,0xfee1,0xad42,0x4055,
+0x610d,0x246f,0x2f01,0x4076,
+0x41d0,0x02f6,0x7dab,0x408e,
+0x7151,0xfca4,0x7fa2,0x409c,
+0xf4ff,0xdafa,0x8cac,0x40a1,
+0xede2,0x0192,0xe2a7,0x4099,
+0x42d6,0x60c4,0x6c48,0x4081
+};
+static unsigned short R[] = {
+0x9b62,0x5042,0x0dd7,0x3fe2,
+0xc5a6,0xebb8,0x67e6,0x3ff4,
+0xa71a,0xf436,0x1381,0x4014,
+0x0c0c,0x58dd,0xa40e,0x4018,
+0x960e,0x9718,0xa393,0x401d,
+0x0367,0x0a47,0xd4b8,0x4007
+};
+static unsigned short S[] = {
+/*0x0000,0x0000,0x0000,0x3ff0,*/
+0xce21,0x0917,0x1590,0x4002,
+0x4cfd,0x21d8,0xcac5,0x4022,
+0x2c4d,0x7f05,0x1910,0x4028,
+0x7ff5,0x959c,0x14d9,0x4031,
+0x26c1,0xaa63,0x37ca,0x4023,
+0x2d90,0x5ab6,0xf3de,0x400a
+};
+static unsigned short T[] = {
+0x5d88,0x1e37,0x35bf,0x4023,
+0x067f,0x4e9e,0x81aa,0x4056,
+0x35b7,0xbcb4,0x7002,0x40a1,
+0xef90,0x3c72,0x5b53,0x40bb,
+0x13dc,0xa442,0x2509,0x40eb
+};
+static unsigned short U[] = {
+/*0x0000,0x0000,0x0000,0x3ff0,*/
+0xa6ba,0x3fef,0xc7e6,0x4040,
+0x3aee,0x14c6,0x4add,0x4080,
+0xfd12,0xe680,0xf252,0x40b1,
+0x7c0a,0x0101,0x1940,0x40d6,
+0xf567,0x9dc8,0x0e6c,0x40e8
+};
+#define UTHRESH 37.519379347
+#endif
+
+#ifdef MIEEE
+static unsigned short P[] = {
+0x3df0,0xeb24,0xa24f,0x6479,
+0x3fe2,0x0dd7,0x4636,0x3488,
+0x401d,0xda53,0xdec5,0x6dc4,
+0x4048,0x518f,0xacad,0xba66,
+0x4068,0x90aa,0xa9e0,0x20f7,
+0x4080,0x738f,0xc264,0xcf58,
+0x408d,0x343a,0x6c74,0x34d8,
+0x4090,0x0e35,0x21d6,0x972a,
+0x4081,0x6c48,0x5de8,0xffb3
+};
+static unsigned short Q[] = {
+0x402a,0x74d5,0xfd7c,0x23cc,
+0x4055,0xad42,0xfee1,0x7365,
+0x4076,0x2f01,0x246f,0x610d,
+0x408e,0x7dab,0x02f6,0x41d0,
+0x409c,0x7fa2,0xfca4,0x7151,
+0x40a1,0x8cac,0xdafa,0xf4ff,
+0x4099,0xe2a7,0x0192,0xede2,
+0x4081,0x6c48,0x60c4,0x42d6
+};
+static unsigned short R[] = {
+0x3fe2,0x0dd7,0x5042,0x9b62,
+0x3ff4,0x67e6,0xebb8,0xc5a6,
+0x4014,0x1381,0xf436,0xa71a,
+0x4018,0xa40e,0x58dd,0x0c0c,
+0x401d,0xa393,0x9718,0x960e,
+0x4007,0xd4b8,0x0a47,0x0367
+};
+static unsigned short S[] = {
+0x4002,0x1590,0x0917,0xce21,
+0x4022,0xcac5,0x21d8,0x4cfd,
+0x4028,0x1910,0x7f05,0x2c4d,
+0x4031,0x14d9,0x959c,0x7ff5,
+0x4023,0x37ca,0xaa63,0x26c1,
+0x400a,0xf3de,0x5ab6,0x2d90
+};
+static unsigned short T[] = {
+0x4023,0x35bf,0x1e37,0x5d88,
+0x4056,0x81aa,0x4e9e,0x067f,
+0x40a1,0x7002,0xbcb4,0x35b7,
+0x40bb,0x5b53,0x3c72,0xef90,
+0x40eb,0x2509,0xa442,0x13dc
+};
+static unsigned short U[] = {
+0x4040,0xc7e6,0x3fef,0xa6ba,
+0x4080,0x4add,0x14c6,0x3aee,
+0x40b1,0xf252,0xe680,0xfd12,
+0x40d6,0x1940,0x0101,0x7c0a,
+0x40e8,0x0e6c,0x9dc8,0xf567
+};
+#define UTHRESH 37.519379347
+#endif
+
+#ifdef ANSIPROT
+extern double polevl ( double, void *, int );
+extern double p1evl ( double, void *, int );
+extern double exp ( double );
+extern double log ( double );
+extern double fabs ( double );
+double erf ( double );
+double erfc ( double );
+#else
+double polevl(), p1evl(), exp(), log(), fabs();
+double erf(), erfc();
+#endif
+
+double ndtr(a)
+double a;
+{
+double x, y, z;
+
+x = a * SQRTH;
+z = fabs(x);
+
+if( z < SQRTH )
+ y = 0.5 + 0.5 * erf(x);
+
+else
+ {
+ y = 0.5 * erfc(z);
+
+ if( x > 0 )
+ y = 1.0 - y;
+ }
+
+return(y);
+}
+
+
+double erfc(a)
+double a;
+{
+double p,q,x,y,z;
+
+
+if( a < 0.0 )
+ x = -a;
+else
+ x = a;
+
+if( x < 1.0 )
+ return( 1.0 - erf(a) );
+
+z = -a * a;
+
+if( z < -MAXLOG )
+ {
+under:
+ mtherr( "erfc", UNDERFLOW );
+ if( a < 0 )
+ return( 2.0 );
+ else
+ return( 0.0 );
+ }
+
+z = exp(z);
+
+if( x < 8.0 )
+ {
+ p = polevl( x, P, 8 );
+ q = p1evl( x, Q, 8 );
+ }
+else
+ {
+ p = polevl( x, R, 5 );
+ q = p1evl( x, S, 6 );
+ }
+y = (z * p)/q;
+
+if( a < 0 )
+ y = 2.0 - y;
+
+if( y == 0.0 )
+ goto under;
+
+return(y);
+}
+
+
+
+double erf(x)
+double x;
+{
+double y, z;
+
+if( fabs(x) > 1.0 )
+ return( 1.0 - erfc(x) );
+z = x * x;
+y = x * polevl( z, T, 4 ) / p1evl( z, U, 5 );
+return( y );
+
+}
diff --git a/libm/double/ndtri.c b/libm/double/ndtri.c
new file mode 100644
index 000000000..948e36c50
--- /dev/null
+++ b/libm/double/ndtri.c
@@ -0,0 +1,417 @@
+/* ndtri.c
+ *
+ * Inverse of Normal distribution function
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, ndtri();
+ *
+ * x = ndtri( 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
+ * DEC 0.125, 1 5500 9.5e-17 2.1e-17
+ * DEC 6e-39, 0.135 3500 5.7e-17 1.3e-17
+ * IEEE 0.125, 1 20000 7.2e-16 1.3e-16
+ * IEEE 3e-308, 0.135 50000 4.6e-16 9.8e-17
+ *
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * ndtri domain x <= 0 -MAXNUM
+ * ndtri domain x >= 1 MAXNUM
+ *
+ */
+
+
+/*
+Cephes Math Library Release 2.8: June, 2000
+Copyright 1984, 1987, 1989, 2000 by Stephen L. Moshier
+*/
+
+#include <math.h>
+extern double MAXNUM;
+
+#ifdef UNK
+/* sqrt(2pi) */
+static double s2pi = 2.50662827463100050242E0;
+#endif
+
+#ifdef DEC
+static unsigned short s2p[] = {0040440,0066230,0177661,0034055};
+#define s2pi *(double *)s2p
+#endif
+
+#ifdef IBMPC
+static unsigned short s2p[] = {0x2706,0x1ff6,0x0d93,0x4004};
+#define s2pi *(double *)s2p
+#endif
+
+#ifdef MIEEE
+static unsigned short s2p[] = {
+0x4004,0x0d93,0x1ff6,0x2706
+};
+#define s2pi *(double *)s2p
+#endif
+
+/* approximation for 0 <= |y - 0.5| <= 3/8 */
+#ifdef UNK
+static double P0[5] = {
+-5.99633501014107895267E1,
+ 9.80010754185999661536E1,
+-5.66762857469070293439E1,
+ 1.39312609387279679503E1,
+-1.23916583867381258016E0,
+};
+static double Q0[8] = {
+/* 1.00000000000000000000E0,*/
+ 1.95448858338141759834E0,
+ 4.67627912898881538453E0,
+ 8.63602421390890590575E1,
+-2.25462687854119370527E2,
+ 2.00260212380060660359E2,
+-8.20372256168333339912E1,
+ 1.59056225126211695515E1,
+-1.18331621121330003142E0,
+};
+#endif
+#ifdef DEC
+static unsigned short P0[20] = {
+0141557,0155170,0071360,0120550,
+0041704,0000214,0172417,0067307,
+0141542,0132204,0040066,0156723,
+0041136,0163161,0157276,0007747,
+0140236,0116374,0073666,0051764,
+};
+static unsigned short Q0[32] = {
+/*0040200,0000000,0000000,0000000,*/
+0040372,0026256,0110403,0123707,
+0040625,0122024,0020277,0026661,
+0041654,0134161,0124134,0007244,
+0142141,0073162,0133021,0131371,
+0042110,0041235,0043516,0057767,
+0141644,0011417,0036155,0137305,
+0041176,0076556,0004043,0125430,
+0140227,0073347,0152776,0067251,
+};
+#endif
+#ifdef IBMPC
+static unsigned short P0[20] = {
+0x142d,0x0e5e,0xfb4f,0xc04d,
+0xedd9,0x9ea1,0x8011,0x4058,
+0xdbba,0x8806,0x5690,0xc04c,
+0xc1fd,0x3bd7,0xdcce,0x402b,
+0xca7e,0x8ef6,0xd39f,0xbff3,
+};
+static unsigned short Q0[36] = {
+/*0x0000,0x0000,0x0000,0x3ff0,*/
+0x74f9,0xd220,0x4595,0x3fff,
+0xe5b6,0x8417,0xb482,0x4012,
+0x81d4,0x350b,0x970e,0x4055,
+0x365f,0x56c2,0x2ece,0xc06c,
+0xcbff,0xa8e9,0x0853,0x4069,
+0xb7d9,0xe78d,0x8261,0xc054,
+0x7563,0xc104,0xcfad,0x402f,
+0xcdd5,0xfabf,0xeedc,0xbff2,
+};
+#endif
+#ifdef MIEEE
+static unsigned short P0[20] = {
+0xc04d,0xfb4f,0x0e5e,0x142d,
+0x4058,0x8011,0x9ea1,0xedd9,
+0xc04c,0x5690,0x8806,0xdbba,
+0x402b,0xdcce,0x3bd7,0xc1fd,
+0xbff3,0xd39f,0x8ef6,0xca7e,
+};
+static unsigned short Q0[32] = {
+/*0x3ff0,0x0000,0x0000,0x0000,*/
+0x3fff,0x4595,0xd220,0x74f9,
+0x4012,0xb482,0x8417,0xe5b6,
+0x4055,0x970e,0x350b,0x81d4,
+0xc06c,0x2ece,0x56c2,0x365f,
+0x4069,0x0853,0xa8e9,0xcbff,
+0xc054,0x8261,0xe78d,0xb7d9,
+0x402f,0xcfad,0xc104,0x7563,
+0xbff2,0xeedc,0xfabf,0xcdd5,
+};
+#endif
+
+
+/* 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.
+ */
+#ifdef UNK
+static double P1[9] = {
+ 4.05544892305962419923E0,
+ 3.15251094599893866154E1,
+ 5.71628192246421288162E1,
+ 4.40805073893200834700E1,
+ 1.46849561928858024014E1,
+ 2.18663306850790267539E0,
+-1.40256079171354495875E-1,
+-3.50424626827848203418E-2,
+-8.57456785154685413611E-4,
+};
+static double Q1[8] = {
+/* 1.00000000000000000000E0,*/
+ 1.57799883256466749731E1,
+ 4.53907635128879210584E1,
+ 4.13172038254672030440E1,
+ 1.50425385692907503408E1,
+ 2.50464946208309415979E0,
+-1.42182922854787788574E-1,
+-3.80806407691578277194E-2,
+-9.33259480895457427372E-4,
+};
+#endif
+#ifdef DEC
+static unsigned short P1[36] = {
+0040601,0143074,0150744,0073326,
+0041374,0031554,0113253,0146016,
+0041544,0123272,0012463,0176771,
+0041460,0051160,0103560,0156511,
+0041152,0172624,0117772,0030755,
+0040413,0170713,0151545,0176413,
+0137417,0117512,0022154,0131671,
+0137017,0104257,0071432,0007072,
+0135540,0143363,0063137,0036166,
+};
+static unsigned short Q1[32] = {
+/*0040200,0000000,0000000,0000000,*/
+0041174,0075325,0004736,0120326,
+0041465,0110044,0047561,0045567,
+0041445,0042321,0012142,0030340,
+0041160,0127074,0166076,0141051,
+0040440,0046055,0040745,0150400,
+0137421,0114146,0067330,0010621,
+0137033,0175162,0025555,0114351,
+0135564,0122773,0145750,0030357,
+};
+#endif
+#ifdef IBMPC
+static unsigned short P1[36] = {
+0x8edb,0x9a3c,0x38c7,0x4010,
+0x7982,0x92d5,0x866d,0x403f,
+0x7fbf,0x42a6,0x94d7,0x404c,
+0x1ba9,0x10ee,0x0a4e,0x4046,
+0x463e,0x93ff,0x5eb2,0x402d,
+0xbfa1,0x7a6c,0x7e39,0x4001,
+0x9677,0x448d,0xf3e9,0xbfc1,
+0x41c7,0xee63,0xf115,0xbfa1,
+0xe78f,0x6ccb,0x18de,0xbf4c,
+};
+static unsigned short Q1[32] = {
+/*0x0000,0x0000,0x0000,0x3ff0,*/
+0xd41b,0xa13b,0x8f5a,0x402f,
+0x296f,0x89ee,0xb204,0x4046,
+0x461c,0x228c,0xa89a,0x4044,
+0xd845,0x9d87,0x15c7,0x402e,
+0xba20,0xa83c,0x0985,0x4004,
+0x0232,0xcddb,0x330c,0xbfc2,
+0xb31d,0x456d,0x7f4e,0xbfa3,
+0x061e,0x797d,0x94bf,0xbf4e,
+};
+#endif
+#ifdef MIEEE
+static unsigned short P1[36] = {
+0x4010,0x38c7,0x9a3c,0x8edb,
+0x403f,0x866d,0x92d5,0x7982,
+0x404c,0x94d7,0x42a6,0x7fbf,
+0x4046,0x0a4e,0x10ee,0x1ba9,
+0x402d,0x5eb2,0x93ff,0x463e,
+0x4001,0x7e39,0x7a6c,0xbfa1,
+0xbfc1,0xf3e9,0x448d,0x9677,
+0xbfa1,0xf115,0xee63,0x41c7,
+0xbf4c,0x18de,0x6ccb,0xe78f,
+};
+static unsigned short Q1[32] = {
+/*0x3ff0,0x0000,0x0000,0x0000,*/
+0x402f,0x8f5a,0xa13b,0xd41b,
+0x4046,0xb204,0x89ee,0x296f,
+0x4044,0xa89a,0x228c,0x461c,
+0x402e,0x15c7,0x9d87,0xd845,
+0x4004,0x0985,0xa83c,0xba20,
+0xbfc2,0x330c,0xcddb,0x0232,
+0xbfa3,0x7f4e,0x456d,0xb31d,
+0xbf4e,0x94bf,0x797d,0x061e,
+};
+#endif
+
+/* 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.
+ */
+
+#ifdef UNK
+static double 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 double 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,
+};
+#endif
+#ifdef DEC
+static unsigned short P2[36] = {
+0040517,0033507,0036236,0125641,
+0040735,0044616,0014473,0140133,
+0040574,0012567,0114535,0102541,
+0040252,0120340,0143474,0150135,
+0037516,0051057,0115361,0031211,
+0036512,0131204,0101511,0125144,
+0035236,0016627,0043160,0140216,
+0033462,0060512,0060141,0010641,
+0031326,0062541,0101304,0077706,
+};
+static unsigned short Q2[32] = {
+/*0040200,0000000,0000000,0000000,*/
+0040700,0143322,0132137,0040501,
+0040553,0101155,0053221,0140257,
+0040260,0041071,0052573,0010004,
+0037535,0066472,0177261,0162330,
+0036533,0160475,0066666,0036132,
+0035253,0174533,0027771,0044027,
+0033502,0016147,0117666,0063671,
+0031351,0047455,0141663,0054751,
+};
+#endif
+#ifdef IBMPC
+static unsigned short P2[36] = {
+0xd574,0xe793,0xe6e8,0x4009,
+0x780b,0xc327,0xa931,0x401b,
+0xb0ac,0xf32b,0x82ae,0x400f,
+0x9a0c,0x18e7,0x541c,0x3ff5,
+0x2651,0xf35e,0xca45,0x3fc9,
+0x354d,0x9069,0x5650,0x3f89,
+0x1812,0xe8ce,0xc3b2,0x3f33,
+0x2234,0x4c0c,0x4c29,0x3ec6,
+0x8ff9,0x3058,0xccac,0x3e3a,
+};
+static unsigned short Q2[32] = {
+/*0x0000,0x0000,0x0000,0x3ff0,*/
+0xe828,0x568b,0x18da,0x4018,
+0x3816,0xaad2,0x704d,0x400d,
+0x6200,0x2aaf,0x0847,0x3ff6,
+0x3c9b,0x5fd6,0xada7,0x3fcb,
+0xc78b,0xadb6,0x7c27,0x3f8b,
+0x2903,0x65ff,0x7f2b,0x3f35,
+0xccf7,0xf3f6,0x438c,0x3ec8,
+0x6b3d,0xb876,0x29e5,0x3e3d,
+};
+#endif
+#ifdef MIEEE
+static unsigned short P2[36] = {
+0x4009,0xe6e8,0xe793,0xd574,
+0x401b,0xa931,0xc327,0x780b,
+0x400f,0x82ae,0xf32b,0xb0ac,
+0x3ff5,0x541c,0x18e7,0x9a0c,
+0x3fc9,0xca45,0xf35e,0x2651,
+0x3f89,0x5650,0x9069,0x354d,
+0x3f33,0xc3b2,0xe8ce,0x1812,
+0x3ec6,0x4c29,0x4c0c,0x2234,
+0x3e3a,0xccac,0x3058,0x8ff9,
+};
+static unsigned short Q2[32] = {
+/*0x3ff0,0x0000,0x0000,0x0000,*/
+0x4018,0x18da,0x568b,0xe828,
+0x400d,0x704d,0xaad2,0x3816,
+0x3ff6,0x0847,0x2aaf,0x6200,
+0x3fcb,0xada7,0x5fd6,0x3c9b,
+0x3f8b,0x7c27,0xadb6,0xc78b,
+0x3f35,0x7f2b,0x65ff,0x2903,
+0x3ec8,0x438c,0xf3f6,0xccf7,
+0x3e3d,0x29e5,0xb876,0x6b3d,
+};
+#endif
+
+#ifdef ANSIPROT
+extern double polevl ( double, void *, int );
+extern double p1evl ( double, void *, int );
+extern double log ( double );
+extern double sqrt ( double );
+#else
+double polevl(), p1evl(), log(), sqrt();
+#endif
+
+double ndtri(y0)
+double y0;
+{
+double x, y, z, y2, x0, x1;
+int code;
+
+if( y0 <= 0.0 )
+ {
+ mtherr( "ndtri", DOMAIN );
+ return( -MAXNUM );
+ }
+if( y0 >= 1.0 )
+ {
+ mtherr( "ndtri", DOMAIN );
+ return( MAXNUM );
+ }
+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 * polevl( y2, P0, 4)/p1evl( y2, Q0, 8 ));
+ x = x * s2pi;
+ return(x);
+ }
+
+x = sqrt( -2.0 * log(y) );
+x0 = x - log(x)/x;
+
+z = 1.0/x;
+if( x < 8.0 ) /* y > exp(-32) = 1.2664165549e-14 */
+ x1 = z * polevl( z, P1, 8 )/p1evl( z, Q1, 8 );
+else
+ x1 = z * polevl( z, P2, 8 )/p1evl( z, Q2, 8 );
+x = x0 - x1;
+if( code != 0 )
+ x = -x;
+return( x );
+}
diff --git a/libm/double/paranoia.c b/libm/double/paranoia.c
new file mode 100644
index 000000000..49ff72623
--- /dev/null
+++ b/libm/double/paranoia.c
@@ -0,0 +1,2156 @@
+/* A C version of Kahan's Floating Point Test "Paranoia"
+
+ Thos Sumner, UCSF, Feb. 1985
+ David Gay, BTL, Jan. 1986
+
+ This is a rewrite from the Pascal version by
+
+ B. A. Wichmann, 18 Jan. 1985
+
+ (and does NOT exhibit good C programming style).
+
+(C) Apr 19 1983 in BASIC version by:
+ Professor W. M. Kahan,
+ 567 Evans Hall
+ Electrical Engineering & Computer Science Dept.
+ University of California
+ Berkeley, California 94720
+ USA
+
+converted to Pascal by:
+ B. A. Wichmann
+ National Physical Laboratory
+ Teddington Middx
+ TW11 OLW
+ UK
+
+converted to C by:
+
+ David M. Gay and Thos Sumner
+ AT&T Bell Labs Computer Center, Rm. U-76
+ 600 Mountainn Avenue University of California
+ Murray Hill, NJ 07974 San Francisco, CA 94143
+ USA USA
+
+with simultaneous corrections to the Pascal source (reflected
+in the Pascal source available over netlib).
+
+Reports of results on various systems from all the versions
+of Paranoia are being collected by Richard Karpinski at the
+same address as Thos Sumner. This includes sample outputs,
+bug reports, and criticisms.
+
+You may copy this program freely if you acknowledge its source.
+Comments on the Pascal version to NPL, please.
+
+
+The C version catches signals from floating-point exceptions.
+If signal(SIGFPE,...) is unavailable in your environment, you may
+#define NOSIGNAL to comment out the invocations of signal.
+
+This source file is too big for some C compilers, but may be split
+into pieces. Comments containing "SPLIT" suggest convenient places
+for this splitting. At the end of these comments is an "ed script"
+(for the UNIX(tm) editor ed) that will do this splitting.
+
+By #defining Single when you compile this source, you may obtain
+a single-precision C version of Paranoia.
+
+
+The following is from the introductory commentary from Wichmann's work:
+
+The BASIC program of Kahan is written in Microsoft BASIC using many
+facilities which have no exact analogy in Pascal. The Pascal
+version below cannot therefore be exactly the same. Rather than be
+a minimal transcription of the BASIC program, the Pascal coding
+follows the conventional style of block-structured languages. Hence
+the Pascal version could be useful in producing versions in other
+structured languages.
+
+Rather than use identifiers of minimal length (which therefore have
+little mnemonic significance), the Pascal version uses meaningful
+identifiers as follows [Note: A few changes have been made for C]:
+
+
+BASIC C BASIC C BASIC C
+
+ A J S StickyBit
+ A1 AInverse J0 NoErrors T
+ B Radix [Failure] T0 Underflow
+ B1 BInverse J1 NoErrors T2 ThirtyTwo
+ B2 RadixD2 [SeriousDefect] T5 OneAndHalf
+ B9 BMinusU2 J2 NoErrors T7 TwentySeven
+ C [Defect] T8 TwoForty
+ C1 CInverse J3 NoErrors U OneUlp
+ D [Flaw] U0 UnderflowThreshold
+ D4 FourD K PageNo U1
+ E0 L Milestone U2
+ E1 M V
+ E2 Exp2 N V0
+ E3 N1 V8
+ E5 MinSqEr O Zero V9
+ E6 SqEr O1 One W
+ E7 MaxSqEr O2 Two X
+ E8 O3 Three X1
+ E9 O4 Four X8
+ F1 MinusOne O5 Five X9 Random1
+ F2 Half O8 Eight Y
+ F3 Third O9 Nine Y1
+ F6 P Precision Y2
+ F9 Q Y9 Random2
+ G1 GMult Q8 Z
+ G2 GDiv Q9 Z0 PseudoZero
+ G3 GAddSub R Z1
+ H R1 RMult Z2
+ H1 HInverse R2 RDiv Z9
+ I R3 RAddSub
+ IO NoTrials R4 RSqrt
+ I3 IEEE R9 Random9
+
+ SqRWrng
+
+All the variables in BASIC are true variables and in consequence,
+the program is more difficult to follow since the "constants" must
+be determined (the glossary is very helpful). The Pascal version
+uses Real constants, but checks are added to ensure that the values
+are correctly converted by the compiler.
+
+The major textual change to the Pascal version apart from the
+identifiersis that named procedures are used, inserting parameters
+wherehelpful. New procedures are also introduced. The
+correspondence is as follows:
+
+
+BASIC Pascal
+lines
+
+ 90- 140 Pause
+ 170- 250 Instructions
+ 380- 460 Heading
+ 480- 670 Characteristics
+ 690- 870 History
+2940-2950 Random
+3710-3740 NewD
+4040-4080 DoesYequalX
+4090-4110 PrintIfNPositive
+4640-4850 TestPartialUnderflow
+
+=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=
+
+Below is an "ed script" that splits para.c into 10 files
+of the form part[1-8].c, subs.c, and msgs.c, plus a header
+file, paranoia.h, that these files require.
+r paranoia.c
+$
+?SPLIT
++,$w msgs.c
+.,$d
+?SPLIT
+.d
++d
+-,$w subs.c
+-,$d
+?part8
++d
+?include
+.,$w part8.c
+.,$d
+-d
+?part7
++d
+?include
+.,$w part7.c
+.,$d
+-d
+?part6
++d
+?include
+.,$w part6.c
+.,$d
+-d
+?part5
++d
+?include
+.,$w part5.c
+.,$d
+-d
+?part4
++d
+?include
+.,$w part4.c
+.,$d
+-d
+?part3
++d
+?include
+.,$w part3.c
+.,$d
+-d
+?part2
++d
+?include
+.,$w part2.c
+.,$d
+?SPLIT
+.d
+1,/^#include/-1d
+1,$w part1.c
+/Computed constants/,$d
+1,$s/^int/extern &/
+1,$s/^FLOAT/extern &/
+1,$s! = .*!;!
+/^Guard/,/^Round/s/^/extern /
+/^jmp_buf/s/^/extern /
+/^Sig_type/s/^/extern /
+a
+extern int sigfpe();
+.
+w paranoia.h
+q
+
+*/
+
+#include <stdio.h>
+#ifndef NOSIGNAL
+#include <signal.h>
+#endif
+#include <setjmp.h>
+
+extern double fabs(), floor(), log(), pow(), sqrt();
+
+#ifdef Single
+#define FLOAT float
+#define FABS(x) (float)fabs((double)(x))
+#define FLOOR(x) (float)floor((double)(x))
+#define LOG(x) (float)log((double)(x))
+#define POW(x,y) (float)pow((double)(x),(double)(y))
+#define SQRT(x) (float)sqrt((double)(x))
+#else
+#define FLOAT double
+#define FABS(x) fabs(x)
+#define FLOOR(x) floor(x)
+#define LOG(x) log(x)
+#define POW(x,y) pow(x,y)
+#define SQRT(x) sqrt(x)
+#endif
+
+jmp_buf ovfl_buf;
+typedef int (*Sig_type)();
+Sig_type sigsave;
+
+#define KEYBOARD 0
+
+FLOAT Radix, BInvrse, RadixD2, BMinusU2;
+FLOAT Sign(), Random();
+
+/*Small floating point constants.*/
+FLOAT Zero = 0.0;
+FLOAT Half = 0.5;
+FLOAT One = 1.0;
+FLOAT Two = 2.0;
+FLOAT Three = 3.0;
+FLOAT Four = 4.0;
+FLOAT Five = 5.0;
+FLOAT Eight = 8.0;
+FLOAT Nine = 9.0;
+FLOAT TwentySeven = 27.0;
+FLOAT ThirtyTwo = 32.0;
+FLOAT TwoForty = 240.0;
+FLOAT MinusOne = -1.0;
+FLOAT OneAndHalf = 1.5;
+/*Integer constants*/
+int NoTrials = 20; /*Number of tests for commutativity. */
+#define False 0
+#define True 1
+
+/* Definitions for declared types
+ Guard == (Yes, No);
+ Rounding == (Chopped, Rounded, Other);
+ Message == packed array [1..40] of char;
+ Class == (Flaw, Defect, Serious, Failure);
+ */
+#define Yes 1
+#define No 0
+#define Chopped 2
+#define Rounded 1
+#define Other 0
+#define Flaw 3
+#define Defect 2
+#define Serious 1
+#define Failure 0
+typedef int Guard, Rounding, Class;
+typedef char Message;
+
+/* Declarations of Variables */
+int Indx;
+char ch[8];
+FLOAT AInvrse, A1;
+FLOAT C, CInvrse;
+FLOAT D, FourD;
+FLOAT E0, E1, Exp2, E3, MinSqEr;
+FLOAT SqEr, MaxSqEr, E9;
+FLOAT Third;
+FLOAT F6, F9;
+FLOAT H, HInvrse;
+int I;
+FLOAT StickyBit, J;
+FLOAT MyZero;
+FLOAT Precision;
+FLOAT Q, Q9;
+FLOAT R, Random9;
+FLOAT T, Underflow, S;
+FLOAT OneUlp, UfThold, U1, U2;
+FLOAT V, V0, V9;
+FLOAT W;
+FLOAT X, X1, X2, X8, Random1;
+FLOAT Y, Y1, Y2, Random2;
+FLOAT Z, PseudoZero, Z1, Z2, Z9;
+volatile FLOAT VV;
+int ErrCnt[4];
+int fpecount;
+int Milestone;
+int PageNo;
+int M, N, N1;
+Guard GMult, GDiv, GAddSub;
+Rounding RMult, RDiv, RAddSub, RSqrt;
+int Break, Done, NotMonot, Monot, Anomaly, IEEE,
+ SqRWrng, UfNGrad;
+/* Computed constants. */
+/*U1 gap below 1.0, i.e, 1.0-U1 is next number below 1.0 */
+/*U2 gap above 1.0, i.e, 1.0+U2 is next number above 1.0 */
+
+/* floating point exception receiver */
+sigfpe()
+{
+ fpecount++;
+ printf("\n* * * FLOATING-POINT ERROR * * *\n");
+ fflush(stdout);
+ if (sigsave) {
+#ifndef NOSIGNAL
+ signal(SIGFPE, sigsave);
+#endif
+ sigsave = 0;
+ longjmp(ovfl_buf, 1);
+ }
+ abort();
+}
+
+main()
+{
+ /* Set coprocessor to double precision, no arith traps. */
+ /* __setfpucw(0x127f);*/
+ dprec();
+ /* First two assignments use integer right-hand sides. */
+ Zero = 0;
+ One = 1;
+ Two = One + One;
+ Three = Two + One;
+ Four = Three + One;
+ Five = Four + One;
+ Eight = Four + Four;
+ Nine = Three * Three;
+ TwentySeven = Nine * Three;
+ ThirtyTwo = Four * Eight;
+ TwoForty = Four * Five * Three * Four;
+ MinusOne = -One;
+ Half = One / Two;
+ OneAndHalf = One + Half;
+ ErrCnt[Failure] = 0;
+ ErrCnt[Serious] = 0;
+ ErrCnt[Defect] = 0;
+ ErrCnt[Flaw] = 0;
+ PageNo = 1;
+ /*=============================================*/
+ Milestone = 0;
+ /*=============================================*/
+#ifndef NOSIGNAL
+ signal(SIGFPE, sigfpe);
+#endif
+ Instructions();
+ Pause();
+ Heading();
+ Pause();
+ Characteristics();
+ Pause();
+ History();
+ Pause();
+ /*=============================================*/
+ Milestone = 7;
+ /*=============================================*/
+ printf("Program is now RUNNING tests on small integers:\n");
+
+ TstCond (Failure, (Zero + Zero == Zero) && (One - One == Zero)
+ && (One > Zero) && (One + One == Two),
+ "0+0 != 0, 1-1 != 0, 1 <= 0, or 1+1 != 2");
+ Z = - Zero;
+ if (Z == 0.0) {
+ U1 = 0.001;
+ Radix = 1;
+ TstPtUf();
+ }
+ else {
+ ErrCnt[Failure] = ErrCnt[Failure] + 1;
+ printf("Comparison alleges that -0.0 is Non-zero!\n");
+ }
+ TstCond (Failure, (Three == Two + One) && (Four == Three + One)
+ && (Four + Two * (- Two) == Zero)
+ && (Four - Three - One == Zero),
+ "3 != 2+1, 4 != 3+1, 4+2*(-2) != 0, or 4-3-1 != 0");
+ TstCond (Failure, (MinusOne == (0 - One))
+ && (MinusOne + One == Zero ) && (One + MinusOne == Zero)
+ && (MinusOne + FABS(One) == Zero)
+ && (MinusOne + MinusOne * MinusOne == Zero),
+ "-1+1 != 0, (-1)+abs(1) != 0, or -1+(-1)*(-1) != 0");
+ TstCond (Failure, Half + MinusOne + Half == Zero,
+ "1/2 + (-1) + 1/2 != 0");
+ /*=============================================*/
+ /*SPLIT
+ part2();
+ part3();
+ part4();
+ part5();
+ part6();
+ part7();
+ part8();
+ }
+#include "paranoia.h"
+part2(){
+*/
+ Milestone = 10;
+ /*=============================================*/
+ TstCond (Failure, (Nine == Three * Three)
+ && (TwentySeven == Nine * Three) && (Eight == Four + Four)
+ && (ThirtyTwo == Eight * Four)
+ && (ThirtyTwo - TwentySeven - Four - One == Zero),
+ "9 != 3*3, 27 != 9*3, 32 != 8*4, or 32-27-4-1 != 0");
+ TstCond (Failure, (Five == Four + One) &&
+ (TwoForty == Four * Five * Three * Four)
+ && (TwoForty / Three - Four * Four * Five == Zero)
+ && ( TwoForty / Four - Five * Three * Four == Zero)
+ && ( TwoForty / Five - Four * Three * Four == Zero),
+ "5 != 4+1, 240/3 != 80, 240/4 != 60, or 240/5 != 48");
+ if (ErrCnt[Failure] == 0) {
+ printf("-1, 0, 1/2, 1, 2, 3, 4, 5, 9, 27, 32 & 240 are O.K.\n");
+ printf("\n");
+ }
+ printf("Searching for Radix and Precision.\n");
+ W = One;
+ do {
+ W = W + W;
+ Y = W + One;
+ Z = Y - W;
+ Y = Z - One;
+ } while (MinusOne + FABS(Y) < Zero);
+ /*.. now W is just big enough that |((W+1)-W)-1| >= 1 ...*/
+ Precision = Zero;
+ Y = One;
+ do {
+ Radix = W + Y;
+ Y = Y + Y;
+ Radix = Radix - W;
+ } while ( Radix == Zero);
+ if (Radix < Two) Radix = One;
+ printf("Radix = %f .\n", Radix);
+ if (Radix != 1) {
+ W = One;
+ do {
+ Precision = Precision + One;
+ W = W * Radix;
+ Y = W + One;
+ } while ((Y - W) == One);
+ }
+ /*... now W == Radix^Precision is barely too big to satisfy (W+1)-W == 1
+ ...*/
+ U1 = One / W;
+ U2 = Radix * U1;
+ printf("Closest relative separation found is U1 = %.7e .\n\n", U1);
+ printf("Recalculating radix and precision.");
+
+ /*save old values*/
+ E0 = Radix;
+ E1 = U1;
+ E9 = U2;
+ E3 = Precision;
+
+ X = Four / Three;
+ Third = X - One;
+ F6 = Half - Third;
+ X = F6 + F6;
+ X = FABS(X - Third);
+ if (X < U2) X = U2;
+
+ /*... now X = (unknown no.) ulps of 1+...*/
+ do {
+ U2 = X;
+ Y = Half * U2 + ThirtyTwo * U2 * U2;
+ Y = One + Y;
+ X = Y - One;
+ } while ( ! ((U2 <= X) || (X <= Zero)));
+
+ /*... now U2 == 1 ulp of 1 + ... */
+ X = Two / Three;
+ F6 = X - Half;
+ Third = F6 + F6;
+ X = Third - Half;
+ X = FABS(X + F6);
+ if (X < U1) X = U1;
+
+ /*... now X == (unknown no.) ulps of 1 -... */
+ do {
+ U1 = X;
+ Y = Half * U1 + ThirtyTwo * U1 * U1;
+ Y = Half - Y;
+ X = Half + Y;
+ Y = Half - X;
+ X = Half + Y;
+ } while ( ! ((U1 <= X) || (X <= Zero)));
+ /*... now U1 == 1 ulp of 1 - ... */
+ if (U1 == E1) printf("confirms closest relative separation U1 .\n");
+ else printf("gets better closest relative separation U1 = %.7e .\n", U1);
+ W = One / U1;
+ F9 = (Half - U1) + Half;
+ Radix = FLOOR(0.01 + U2 / U1);
+ if (Radix == E0) printf("Radix confirmed.\n");
+ else printf("MYSTERY: recalculated Radix = %.7e .\n", Radix);
+ TstCond (Defect, Radix <= Eight + Eight,
+ "Radix is too big: roundoff problems");
+ TstCond (Flaw, (Radix == Two) || (Radix == 10)
+ || (Radix == One), "Radix is not as good as 2 or 10");
+ /*=============================================*/
+ Milestone = 20;
+ /*=============================================*/
+ TstCond (Failure, F9 - Half < Half,
+ "(1-U1)-1/2 < 1/2 is FALSE, prog. fails?");
+ X = F9;
+ I = 1;
+ Y = X - Half;
+ Z = Y - Half;
+ TstCond (Failure, (X != One)
+ || (Z == Zero), "Comparison is fuzzy,X=1 but X-1/2-1/2 != 0");
+ X = One + U2;
+ I = 0;
+ /*=============================================*/
+ Milestone = 25;
+ /*=============================================*/
+ /*... BMinusU2 = nextafter(Radix, 0) */
+ BMinusU2 = Radix - One;
+ BMinusU2 = (BMinusU2 - U2) + One;
+ /* Purify Integers */
+ if (Radix != One) {
+ X = - TwoForty * LOG(U1) / LOG(Radix);
+ Y = FLOOR(Half + X);
+ if (FABS(X - Y) * Four < One) X = Y;
+ Precision = X / TwoForty;
+ Y = FLOOR(Half + Precision);
+ if (FABS(Precision - Y) * TwoForty < Half) Precision = Y;
+ }
+ if ((Precision != FLOOR(Precision)) || (Radix == One)) {
+ printf("Precision cannot be characterized by an Integer number\n");
+ printf("of significant digits but, by itself, this is a minor flaw.\n");
+ }
+ if (Radix == One)
+ printf("logarithmic encoding has precision characterized solely by U1.\n");
+ else printf("The number of significant digits of the Radix is %f .\n",
+ Precision);
+ TstCond (Serious, U2 * Nine * Nine * TwoForty < One,
+ "Precision worse than 5 decimal figures ");
+ /*=============================================*/
+ Milestone = 30;
+ /*=============================================*/
+ /* Test for extra-precise subepressions */
+ X = FABS(((Four / Three - One) - One / Four) * Three - One / Four);
+ do {
+ Z2 = X;
+ X = (One + (Half * Z2 + ThirtyTwo * Z2 * Z2)) - One;
+ } while ( ! ((Z2 <= X) || (X <= Zero)));
+ X = Y = Z = FABS((Three / Four - Two / Three) * Three - One / Four);
+ do {
+ Z1 = Z;
+ Z = (One / Two - ((One / Two - (Half * Z1 + ThirtyTwo * Z1 * Z1))
+ + One / Two)) + One / Two;
+ } while ( ! ((Z1 <= Z) || (Z <= Zero)));
+ do {
+ do {
+ Y1 = Y;
+ Y = (Half - ((Half - (Half * Y1 + ThirtyTwo * Y1 * Y1)) + Half
+ )) + Half;
+ } while ( ! ((Y1 <= Y) || (Y <= Zero)));
+ X1 = X;
+ X = ((Half * X1 + ThirtyTwo * X1 * X1) - F9) + F9;
+ } while ( ! ((X1 <= X) || (X <= Zero)));
+ if ((X1 != Y1) || (X1 != Z1)) {
+ BadCond(Serious, "Disagreements among the values X1, Y1, Z1,\n");
+ printf("respectively %.7e, %.7e, %.7e,\n", X1, Y1, Z1);
+ printf("are symptoms of inconsistencies introduced\n");
+ printf("by extra-precise evaluation of arithmetic subexpressions.\n");
+ notify("Possibly some part of this");
+ if ((X1 == U1) || (Y1 == U1) || (Z1 == U1)) printf(
+ "That feature is not tested further by this program.\n") ;
+ }
+ else {
+ if ((Z1 != U1) || (Z2 != U2)) {
+ if ((Z1 >= U1) || (Z2 >= U2)) {
+ BadCond(Failure, "");
+ notify("Precision");
+ printf("\tU1 = %.7e, Z1 - U1 = %.7e\n",U1,Z1-U1);
+ printf("\tU2 = %.7e, Z2 - U2 = %.7e\n",U2,Z2-U2);
+ }
+ else {
+ if ((Z1 <= Zero) || (Z2 <= Zero)) {
+ printf("Because of unusual Radix = %f", Radix);
+ printf(", or exact rational arithmetic a result\n");
+ printf("Z1 = %.7e, or Z2 = %.7e ", Z1, Z2);
+ notify("of an\nextra-precision");
+ }
+ if (Z1 != Z2 || Z1 > Zero) {
+ X = Z1 / U1;
+ Y = Z2 / U2;
+ if (Y > X) X = Y;
+ Q = - LOG(X);
+ printf("Some subexpressions appear to be calculated extra\n");
+ printf("precisely with about %g extra B-digits, i.e.\n",
+ (Q / LOG(Radix)));
+ printf("roughly %g extra significant decimals.\n",
+ Q / LOG(10.));
+ }
+ printf("That feature is not tested further by this program.\n");
+ }
+ }
+ }
+ Pause();
+ /*=============================================*/
+ /*SPLIT
+ }
+#include "paranoia.h"
+part3(){
+*/
+ Milestone = 35;
+ /*=============================================*/
+ if (Radix >= Two) {
+ X = W / (Radix * Radix);
+ Y = X + One;
+ Z = Y - X;
+ T = Z + U2;
+ X = T - Z;
+ TstCond (Failure, X == U2,
+ "Subtraction is not normalized X=Y,X+Z != Y+Z!");
+ if (X == U2) printf(
+ "Subtraction appears to be normalized, as it should be.");
+ }
+ printf("\nChecking for guard digit in *, /, and -.\n");
+ Y = F9 * One;
+ Z = One * F9;
+ X = F9 - Half;
+ Y = (Y - Half) - X;
+ Z = (Z - Half) - X;
+ X = One + U2;
+ T = X * Radix;
+ R = Radix * X;
+ X = T - Radix;
+ X = X - Radix * U2;
+ T = R - Radix;
+ T = T - Radix * U2;
+ X = X * (Radix - One);
+ T = T * (Radix - One);
+ if ((X == Zero) && (Y == Zero) && (Z == Zero) && (T == Zero)) GMult = Yes;
+ else {
+ GMult = No;
+ TstCond (Serious, False,
+ "* lacks a Guard Digit, so 1*X != X");
+ }
+ Z = Radix * U2;
+ X = One + Z;
+ Y = FABS((X + Z) - X * X) - U2;
+ X = One - U2;
+ Z = FABS((X - U2) - X * X) - U1;
+ TstCond (Failure, (Y <= Zero)
+ && (Z <= Zero), "* gets too many final digits wrong.\n");
+ Y = One - U2;
+ X = One + U2;
+ Z = One / Y;
+ Y = Z - X;
+ X = One / Three;
+ Z = Three / Nine;
+ X = X - Z;
+ T = Nine / TwentySeven;
+ Z = Z - T;
+ TstCond(Defect, X == Zero && Y == Zero && Z == Zero,
+ "Division lacks a Guard Digit, so error can exceed 1 ulp\n\
+or 1/3 and 3/9 and 9/27 may disagree");
+ Y = F9 / One;
+ X = F9 - Half;
+ Y = (Y - Half) - X;
+ X = One + U2;
+ T = X / One;
+ X = T - X;
+ if ((X == Zero) && (Y == Zero) && (Z == Zero)) GDiv = Yes;
+ else {
+ GDiv = No;
+ TstCond (Serious, False,
+ "Division lacks a Guard Digit, so X/1 != X");
+ }
+ X = One / (One + U2);
+ Y = X - Half - Half;
+ TstCond (Serious, Y < Zero,
+ "Computed value of 1/1.000..1 >= 1");
+ X = One - U2;
+ Y = One + Radix * U2;
+ Z = X * Radix;
+ T = Y * Radix;
+ R = Z / Radix;
+ StickyBit = T / Radix;
+ X = R - X;
+ Y = StickyBit - Y;
+ TstCond (Failure, X == Zero && Y == Zero,
+ "* and/or / gets too many last digits wrong");
+ Y = One - U1;
+ X = One - F9;
+ Y = One - Y;
+ T = Radix - U2;
+ Z = Radix - BMinusU2;
+ T = Radix - T;
+ if ((X == U1) && (Y == U1) && (Z == U2) && (T == U2)) GAddSub = Yes;
+ else {
+ GAddSub = No;
+ TstCond (Serious, False,
+ "- lacks Guard Digit, so cancellation is obscured");
+ }
+ if (F9 != One && F9 - One >= Zero) {
+ BadCond(Serious, "comparison alleges (1-U1) < 1 although\n");
+ printf(" subtration yields (1-U1) - 1 = 0 , thereby vitiating\n");
+ printf(" such precautions against division by zero as\n");
+ printf(" ... if (X == 1.0) {.....} else {.../(X-1.0)...}\n");
+ }
+ if (GMult == Yes && GDiv == Yes && GAddSub == Yes) printf(
+ " *, /, and - appear to have guard digits, as they should.\n");
+ /*=============================================*/
+ Milestone = 40;
+ /*=============================================*/
+ Pause();
+ printf("Checking rounding on multiply, divide and add/subtract.\n");
+ RMult = Other;
+ RDiv = Other;
+ RAddSub = Other;
+ RadixD2 = Radix / Two;
+ A1 = Two;
+ Done = False;
+ do {
+ AInvrse = Radix;
+ do {
+ X = AInvrse;
+ AInvrse = AInvrse / A1;
+ } while ( ! (FLOOR(AInvrse) != AInvrse));
+ Done = (X == One) || (A1 > Three);
+ if (! Done) A1 = Nine + One;
+ } while ( ! (Done));
+ if (X == One) A1 = Radix;
+ AInvrse = One / A1;
+ X = A1;
+ Y = AInvrse;
+ Done = False;
+ do {
+ Z = X * Y - Half;
+ TstCond (Failure, Z == Half,
+ "X * (1/X) differs from 1");
+ Done = X == Radix;
+ X = Radix;
+ Y = One / X;
+ } while ( ! (Done));
+ Y2 = One + U2;
+ Y1 = One - U2;
+ X = OneAndHalf - U2;
+ Y = OneAndHalf + U2;
+ Z = (X - U2) * Y2;
+ T = Y * Y1;
+ Z = Z - X;
+ T = T - X;
+ X = X * Y2;
+ Y = (Y + U2) * Y1;
+ X = X - OneAndHalf;
+ Y = Y - OneAndHalf;
+ if ((X == Zero) && (Y == Zero) && (Z == Zero) && (T <= Zero)) {
+ X = (OneAndHalf + U2) * Y2;
+ Y = OneAndHalf - U2 - U2;
+ Z = OneAndHalf + U2 + U2;
+ T = (OneAndHalf - U2) * Y1;
+ X = X - (Z + U2);
+ StickyBit = Y * Y1;
+ S = Z * Y2;
+ T = T - Y;
+ Y = (U2 - Y) + StickyBit;
+ Z = S - (Z + U2 + U2);
+ StickyBit = (Y2 + U2) * Y1;
+ Y1 = Y2 * Y1;
+ StickyBit = StickyBit - Y2;
+ Y1 = Y1 - Half;
+ if ((X == Zero) && (Y == Zero) && (Z == Zero) && (T == Zero)
+ && ( StickyBit == Zero) && (Y1 == Half)) {
+ RMult = Rounded;
+ printf("Multiplication appears to round correctly.\n");
+ }
+ else if ((X + U2 == Zero) && (Y < Zero) && (Z + U2 == Zero)
+ && (T < Zero) && (StickyBit + U2 == Zero)
+ && (Y1 < Half)) {
+ RMult = Chopped;
+ printf("Multiplication appears to chop.\n");
+ }
+ else printf("* is neither chopped nor correctly rounded.\n");
+ if ((RMult == Rounded) && (GMult == No)) notify("Multiplication");
+ }
+ else printf("* is neither chopped nor correctly rounded.\n");
+ /*=============================================*/
+ Milestone = 45;
+ /*=============================================*/
+ Y2 = One + U2;
+ Y1 = One - U2;
+ Z = OneAndHalf + U2 + U2;
+ X = Z / Y2;
+ T = OneAndHalf - U2 - U2;
+ Y = (T - U2) / Y1;
+ Z = (Z + U2) / Y2;
+ X = X - OneAndHalf;
+ Y = Y - T;
+ T = T / Y1;
+ Z = Z - (OneAndHalf + U2);
+ T = (U2 - OneAndHalf) + T;
+ if (! ((X > Zero) || (Y > Zero) || (Z > Zero) || (T > Zero))) {
+ X = OneAndHalf / Y2;
+ Y = OneAndHalf - U2;
+ Z = OneAndHalf + U2;
+ X = X - Y;
+ T = OneAndHalf / Y1;
+ Y = Y / Y1;
+ T = T - (Z + U2);
+ Y = Y - Z;
+ Z = Z / Y2;
+ Y1 = (Y2 + U2) / Y2;
+ Z = Z - OneAndHalf;
+ Y2 = Y1 - Y2;
+ Y1 = (F9 - U1) / F9;
+ if ((X == Zero) && (Y == Zero) && (Z == Zero) && (T == Zero)
+ && (Y2 == Zero) && (Y2 == Zero)
+ && (Y1 - Half == F9 - Half )) {
+ RDiv = Rounded;
+ printf("Division appears to round correctly.\n");
+ if (GDiv == No) notify("Division");
+ }
+ else if ((X < Zero) && (Y < Zero) && (Z < Zero) && (T < Zero)
+ && (Y2 < Zero) && (Y1 - Half < F9 - Half)) {
+ RDiv = Chopped;
+ printf("Division appears to chop.\n");
+ }
+ }
+ if (RDiv == Other) printf("/ is neither chopped nor correctly rounded.\n");
+ BInvrse = One / Radix;
+ TstCond (Failure, (BInvrse * Radix - Half == Half),
+ "Radix * ( 1 / Radix ) differs from 1");
+ /*=============================================*/
+ /*SPLIT
+ }
+#include "paranoia.h"
+part4(){
+*/
+ Milestone = 50;
+ /*=============================================*/
+ TstCond (Failure, ((F9 + U1) - Half == Half)
+ && ((BMinusU2 + U2 ) - One == Radix - One),
+ "Incomplete carry-propagation in Addition");
+ X = One - U1 * U1;
+ Y = One + U2 * (One - U2);
+ Z = F9 - Half;
+ X = (X - Half) - Z;
+ Y = Y - One;
+ if ((X == Zero) && (Y == Zero)) {
+ RAddSub = Chopped;
+ printf("Add/Subtract appears to be chopped.\n");
+ }
+ if (GAddSub == Yes) {
+ X = (Half + U2) * U2;
+ Y = (Half - U2) * U2;
+ X = One + X;
+ Y = One + Y;
+ X = (One + U2) - X;
+ Y = One - Y;
+ if ((X == Zero) && (Y == Zero)) {
+ X = (Half + U2) * U1;
+ Y = (Half - U2) * U1;
+ X = One - X;
+ Y = One - Y;
+ X = F9 - X;
+ Y = One - Y;
+ if ((X == Zero) && (Y == Zero)) {
+ RAddSub = Rounded;
+ printf("Addition/Subtraction appears to round correctly.\n");
+ if (GAddSub == No) notify("Add/Subtract");
+ }
+ else printf("Addition/Subtraction neither rounds nor chops.\n");
+ }
+ else printf("Addition/Subtraction neither rounds nor chops.\n");
+ }
+ else printf("Addition/Subtraction neither rounds nor chops.\n");
+ S = One;
+ X = One + Half * (One + Half);
+ Y = (One + U2) * Half;
+ Z = X - Y;
+ T = Y - X;
+ StickyBit = Z + T;
+ if (StickyBit != Zero) {
+ S = Zero;
+ BadCond(Flaw, "(X - Y) + (Y - X) is non zero!\n");
+ }
+ StickyBit = Zero;
+ if ((GMult == Yes) && (GDiv == Yes) && (GAddSub == Yes)
+ && (RMult == Rounded) && (RDiv == Rounded)
+ && (RAddSub == Rounded) && (FLOOR(RadixD2) == RadixD2)) {
+ printf("Checking for sticky bit.\n");
+ X = (Half + U1) * U2;
+ Y = Half * U2;
+ Z = One + Y;
+ T = One + X;
+ if ((Z - One <= Zero) && (T - One >= U2)) {
+ Z = T + Y;
+ Y = Z - X;
+ if ((Z - T >= U2) && (Y - T == Zero)) {
+ X = (Half + U1) * U1;
+ Y = Half * U1;
+ Z = One - Y;
+ T = One - X;
+ if ((Z - One == Zero) && (T - F9 == Zero)) {
+ Z = (Half - U1) * U1;
+ T = F9 - Z;
+ Q = F9 - Y;
+ if ((T - F9 == Zero) && (F9 - U1 - Q == Zero)) {
+ Z = (One + U2) * OneAndHalf;
+ T = (OneAndHalf + U2) - Z + U2;
+ X = One + Half / Radix;
+ Y = One + Radix * U2;
+ Z = X * Y;
+ if (T == Zero && X + Radix * U2 - Z == Zero) {
+ if (Radix != Two) {
+ X = Two + U2;
+ Y = X / Two;
+ if ((Y - One == Zero)) StickyBit = S;
+ }
+ else StickyBit = S;
+ }
+ }
+ }
+ }
+ }
+ }
+ if (StickyBit == One) printf("Sticky bit apparently used correctly.\n");
+ else printf("Sticky bit used incorrectly or not at all.\n");
+ TstCond (Flaw, !(GMult == No || GDiv == No || GAddSub == No ||
+ RMult == Other || RDiv == Other || RAddSub == Other),
+ "lack(s) of guard digits or failure(s) to correctly round or chop\n\
+(noted above) count as one flaw in the final tally below");
+ /*=============================================*/
+ Milestone = 60;
+ /*=============================================*/
+ printf("\n");
+ printf("Does Multiplication commute? ");
+ printf("Testing on %d random pairs.\n", NoTrials);
+ Random9 = SQRT(3.0);
+ Random1 = Third;
+ I = 1;
+ do {
+ X = Random();
+ Y = Random();
+ Z9 = Y * X;
+ Z = X * Y;
+ Z9 = Z - Z9;
+ I = I + 1;
+ } while ( ! ((I > NoTrials) || (Z9 != Zero)));
+ if (I == NoTrials) {
+ Random1 = One + Half / Three;
+ Random2 = (U2 + U1) + One;
+ Z = Random1 * Random2;
+ Y = Random2 * Random1;
+ Z9 = (One + Half / Three) * ((U2 + U1) + One) - (One + Half /
+ Three) * ((U2 + U1) + One);
+ }
+ if (! ((I == NoTrials) || (Z9 == Zero)))
+ BadCond(Defect, "X * Y == Y * X trial fails.\n");
+ else printf(" No failures found in %d integer pairs.\n", NoTrials);
+ /*=============================================*/
+ Milestone = 70;
+ /*=============================================*/
+ printf("\nRunning test of square root(x).\n");
+ TstCond (Failure, (Zero == SQRT(Zero))
+ && (- Zero == SQRT(- Zero))
+ && (One == SQRT(One)), "Square root of 0.0, -0.0 or 1.0 wrong");
+ MinSqEr = Zero;
+ MaxSqEr = Zero;
+ J = Zero;
+ X = Radix;
+ OneUlp = U2;
+ SqXMinX (Serious);
+ X = BInvrse;
+ OneUlp = BInvrse * U1;
+ SqXMinX (Serious);
+ X = U1;
+ OneUlp = U1 * U1;
+ SqXMinX (Serious);
+ if (J != Zero) Pause();
+ printf("Testing if sqrt(X * X) == X for %d Integers X.\n", NoTrials);
+ J = Zero;
+ X = Two;
+ Y = Radix;
+ if ((Radix != One)) do {
+ X = Y;
+ Y = Radix * Y;
+ } while ( ! ((Y - X >= NoTrials)));
+ OneUlp = X * U2;
+ I = 1;
+ while (I < 10) {
+ X = X + One;
+ SqXMinX (Defect);
+ if (J > Zero) break;
+ I = I + 1;
+ }
+ printf("Test for sqrt monotonicity.\n");
+ I = - 1;
+ X = BMinusU2;
+ Y = Radix;
+ Z = Radix + Radix * U2;
+ NotMonot = False;
+ Monot = False;
+ while ( ! (NotMonot || Monot)) {
+ I = I + 1;
+ X = SQRT(X);
+ Q = SQRT(Y);
+ Z = SQRT(Z);
+ if ((X > Q) || (Q > Z)) NotMonot = True;
+ else {
+ Q = FLOOR(Q + Half);
+ if ((I > 0) || (Radix == Q * Q)) Monot = True;
+ else if (I > 0) {
+ if (I > 1) Monot = True;
+ else {
+ Y = Y * BInvrse;
+ X = Y - U1;
+ Z = Y + U1;
+ }
+ }
+ else {
+ Y = Q;
+ X = Y - U2;
+ Z = Y + U2;
+ }
+ }
+ }
+ if (Monot) printf("sqrt has passed a test for Monotonicity.\n");
+ else {
+ BadCond(Defect, "");
+ printf("sqrt(X) is non-monotonic for X near %.7e .\n", Y);
+ }
+ /*=============================================*/
+ /*SPLIT
+ }
+#include "paranoia.h"
+part5(){
+*/
+ Milestone = 80;
+ /*=============================================*/
+ MinSqEr = MinSqEr + Half;
+ MaxSqEr = MaxSqEr - Half;
+ Y = (SQRT(One + U2) - One) / U2;
+ SqEr = (Y - One) + U2 / Eight;
+ if (SqEr > MaxSqEr) MaxSqEr = SqEr;
+ SqEr = Y + U2 / Eight;
+ if (SqEr < MinSqEr) MinSqEr = SqEr;
+ Y = ((SQRT(F9) - U2) - (One - U2)) / U1;
+ SqEr = Y + U1 / Eight;
+ if (SqEr > MaxSqEr) MaxSqEr = SqEr;
+ SqEr = (Y + One) + U1 / Eight;
+ if (SqEr < MinSqEr) MinSqEr = SqEr;
+ OneUlp = U2;
+ X = OneUlp;
+ for( Indx = 1; Indx <= 3; ++Indx) {
+ Y = SQRT((X + U1 + X) + F9);
+ Y = ((Y - U2) - ((One - U2) + X)) / OneUlp;
+ Z = ((U1 - X) + F9) * Half * X * X / OneUlp;
+ SqEr = (Y + Half) + Z;
+ if (SqEr < MinSqEr) MinSqEr = SqEr;
+ SqEr = (Y - Half) + Z;
+ if (SqEr > MaxSqEr) MaxSqEr = SqEr;
+ if (((Indx == 1) || (Indx == 3)))
+ X = OneUlp * Sign (X) * FLOOR(Eight / (Nine * SQRT(OneUlp)));
+ else {
+ OneUlp = U1;
+ X = - OneUlp;
+ }
+ }
+ /*=============================================*/
+ Milestone = 85;
+ /*=============================================*/
+ SqRWrng = False;
+ Anomaly = False;
+ if (Radix != One) {
+ printf("Testing whether sqrt is rounded or chopped.\n");
+ D = FLOOR(Half + POW(Radix, One + Precision - FLOOR(Precision)));
+ /* ... == Radix^(1 + fract) if (Precision == Integer + fract. */
+ X = D / Radix;
+ Y = D / A1;
+ if ((X != FLOOR(X)) || (Y != FLOOR(Y))) {
+ Anomaly = True;
+ }
+ else {
+ X = Zero;
+ Z2 = X;
+ Y = One;
+ Y2 = Y;
+ Z1 = Radix - One;
+ FourD = Four * D;
+ do {
+ if (Y2 > Z2) {
+ Q = Radix;
+ Y1 = Y;
+ do {
+ X1 = FABS(Q + FLOOR(Half - Q / Y1) * Y1);
+ Q = Y1;
+ Y1 = X1;
+ } while ( ! (X1 <= Zero));
+ if (Q <= One) {
+ Z2 = Y2;
+ Z = Y;
+ }
+ }
+ Y = Y + Two;
+ X = X + Eight;
+ Y2 = Y2 + X;
+ if (Y2 >= FourD) Y2 = Y2 - FourD;
+ } while ( ! (Y >= D));
+ X8 = FourD - Z2;
+ Q = (X8 + Z * Z) / FourD;
+ X8 = X8 / Eight;
+ if (Q != FLOOR(Q)) Anomaly = True;
+ else {
+ Break = False;
+ do {
+ X = Z1 * Z;
+ X = X - FLOOR(X / Radix) * Radix;
+ if (X == One)
+ Break = True;
+ else
+ Z1 = Z1 - One;
+ } while ( ! (Break || (Z1 <= Zero)));
+ if ((Z1 <= Zero) && (! Break)) Anomaly = True;
+ else {
+ if (Z1 > RadixD2) Z1 = Z1 - Radix;
+ do {
+ NewD();
+ } while ( ! (U2 * D >= F9));
+ if (D * Radix - D != W - D) Anomaly = True;
+ else {
+ Z2 = D;
+ I = 0;
+ Y = D + (One + Z) * Half;
+ X = D + Z + Q;
+ SR3750();
+ Y = D + (One - Z) * Half + D;
+ X = D - Z + D;
+ X = X + Q + X;
+ SR3750();
+ NewD();
+ if (D - Z2 != W - Z2) Anomaly = True;
+ else {
+ Y = (D - Z2) + (Z2 + (One - Z) * Half);
+ X = (D - Z2) + (Z2 - Z + Q);
+ SR3750();
+ Y = (One + Z) * Half;
+ X = Q;
+ SR3750();
+ if (I == 0) Anomaly = True;
+ }
+ }
+ }
+ }
+ }
+ if ((I == 0) || Anomaly) {
+ BadCond(Failure, "Anomalous arithmetic with Integer < ");
+ printf("Radix^Precision = %.7e\n", W);
+ printf(" fails test whether sqrt rounds or chops.\n");
+ SqRWrng = True;
+ }
+ }
+ if (! Anomaly) {
+ if (! ((MinSqEr < Zero) || (MaxSqEr > Zero))) {
+ RSqrt = Rounded;
+ printf("Square root appears to be correctly rounded.\n");
+ }
+ else {
+ if ((MaxSqEr + U2 > U2 - Half) || (MinSqEr > Half)
+ || (MinSqEr + Radix < Half)) SqRWrng = True;
+ else {
+ RSqrt = Chopped;
+ printf("Square root appears to be chopped.\n");
+ }
+ }
+ }
+ if (SqRWrng) {
+ printf("Square root is neither chopped nor correctly rounded.\n");
+ printf("Observed errors run from %.7e ", MinSqEr - Half);
+ printf("to %.7e ulps.\n", Half + MaxSqEr);
+ TstCond (Serious, MaxSqEr - MinSqEr < Radix * Radix,
+ "sqrt gets too many last digits wrong");
+ }
+ /*=============================================*/
+ Milestone = 90;
+ /*=============================================*/
+ Pause();
+ printf("Testing powers Z^i for small Integers Z and i.\n");
+ N = 0;
+ /* ... test powers of zero. */
+ I = 0;
+ Z = -Zero;
+ M = 3.0;
+ Break = False;
+ do {
+ X = One;
+ SR3980();
+ if (I <= 10) {
+ I = 1023;
+ SR3980();
+ }
+ if (Z == MinusOne) Break = True;
+ else {
+ Z = MinusOne;
+ PrintIfNPositive();
+ N = 0;
+ /* .. if(-1)^N is invalid, replace MinusOne by One. */
+ I = - 4;
+ }
+ } while ( ! Break);
+ PrintIfNPositive();
+ N1 = N;
+ N = 0;
+ Z = A1;
+ M = FLOOR(Two * LOG(W) / LOG(A1));
+ Break = False;
+ do {
+ X = Z;
+ I = 1;
+ SR3980();
+ if (Z == AInvrse) Break = True;
+ else Z = AInvrse;
+ } while ( ! (Break));
+ /*=============================================*/
+ Milestone = 100;
+ /*=============================================*/
+ /* Powers of Radix have been tested, */
+ /* next try a few primes */
+ M = NoTrials;
+ Z = Three;
+ do {
+ X = Z;
+ I = 1;
+ SR3980();
+ do {
+ Z = Z + Two;
+ } while ( Three * FLOOR(Z / Three) == Z );
+ } while ( Z < Eight * Three );
+ if (N > 0) {
+ printf("Errors like this may invalidate financial calculations\n");
+ printf("\tinvolving interest rates.\n");
+ }
+ PrintIfNPositive();
+ N += N1;
+ if (N == 0) printf("... no discrepancis found.\n");
+ if (N > 0) Pause();
+ else printf("\n");
+ /*=============================================*/
+ /*SPLIT
+ }
+#include "paranoia.h"
+part6(){
+*/
+ Milestone = 110;
+ /*=============================================*/
+ printf("Seeking Underflow thresholds UfThold and E0.\n");
+ D = U1;
+ if (Precision != FLOOR(Precision)) {
+ D = BInvrse;
+ X = Precision;
+ do {
+ D = D * BInvrse;
+ X = X - One;
+ } while ( X > Zero);
+ }
+ Y = One;
+ Z = D;
+ /* ... D is power of 1/Radix < 1. */
+ do {
+ C = Y;
+ Y = Z;
+ Z = Y * Y;
+ VV = Z;
+ } while ((Y > Z) && (VV + VV > VV));
+ Y = C;
+ Z = Y * D;
+ do {
+ C = Y;
+ Y = Z;
+ Z = Y * D;
+ VV = Z;
+ } while ((Y > Z) && (VV + VV > VV));
+ if (Radix < Two) HInvrse = Two;
+ else HInvrse = Radix;
+ H = One / HInvrse;
+ /* ... 1/HInvrse == H == Min(1/Radix, 1/2) */
+ CInvrse = One / C;
+ E0 = C;
+ Z = E0 * H;
+ /* ...1/Radix^(BIG Integer) << 1 << CInvrse == 1/C */
+ do {
+ Y = E0;
+ E0 = Z;
+ Z = E0 * H;
+ VV = Z;
+ } while ((E0 > VV) && (VV + VV > VV));
+ UfThold = E0;
+ E1 = Zero;
+ Q = Zero;
+ E9 = U2;
+ S = One + E9;
+ D = C * S;
+ if (D <= C) {
+ E9 = Radix * U2;
+ S = One + E9;
+ D = C * S;
+ if (D <= C) {
+ BadCond(Failure, "multiplication gets too many last digits wrong.\n");
+ Underflow = E0;
+ Y1 = Zero;
+ PseudoZero = Z;
+ Pause();
+ }
+ }
+ else {
+ Underflow = D;
+ PseudoZero = Underflow * H;
+ UfThold = Zero;
+ do {
+ Y1 = Underflow;
+ Underflow = PseudoZero;
+ if (E1 + E1 <= E1) {
+ Y2 = Underflow * HInvrse;
+ E1 = FABS(Y1 - Y2);
+ Q = Y1;
+ if ((UfThold == Zero) && (Y1 != Y2)) UfThold = Y1;
+ }
+ PseudoZero = PseudoZero * H;
+ VV = PseudoZero;
+ } while ((Underflow > VV)
+ && (VV + VV > VV));
+ }
+ /* Comment line 4530 .. 4560 */
+ if (PseudoZero != Zero) {
+ printf("\n");
+ Z = PseudoZero;
+ /* ... Test PseudoZero for "phoney- zero" violates */
+ /* ... PseudoZero < Underflow or PseudoZero < PseudoZero + PseudoZero
+ ... */
+ if (PseudoZero <= Zero) {
+ BadCond(Failure, "Positive expressions can underflow to an\n");
+ printf("allegedly negative value\n");
+ printf("PseudoZero that prints out as: %g .\n", PseudoZero);
+ X = - PseudoZero;
+ if (X <= Zero) {
+ printf("But -PseudoZero, which should be\n");
+ printf("positive, isn't; it prints out as %g .\n", X);
+ }
+ }
+ else {
+ BadCond(Flaw, "Underflow can stick at an allegedly positive\n");
+ printf("value PseudoZero that prints out as %g .\n", PseudoZero);
+ }
+ TstPtUf();
+ }
+ /*=============================================*/
+ Milestone = 120;
+ /*=============================================*/
+ if (CInvrse * Y > CInvrse * Y1) {
+ S = H * S;
+ E0 = Underflow;
+ }
+ if (! ((E1 == Zero) || (E1 == E0))) {
+ BadCond(Defect, "");
+ if (E1 < E0) {
+ printf("Products underflow at a higher");
+ printf(" threshold than differences.\n");
+ if (PseudoZero == Zero)
+ E0 = E1;
+ }
+ else {
+ printf("Difference underflows at a higher");
+ printf(" threshold than products.\n");
+ }
+ }
+ printf("Smallest strictly positive number found is E0 = %g .\n", E0);
+ Z = E0;
+ TstPtUf();
+ Underflow = E0;
+ if (N == 1) Underflow = Y;
+ I = 4;
+ if (E1 == Zero) I = 3;
+ if (UfThold == Zero) I = I - 2;
+ UfNGrad = True;
+ switch (I) {
+ case 1:
+ UfThold = Underflow;
+ if ((CInvrse * Q) != ((CInvrse * Y) * S)) {
+ UfThold = Y;
+ BadCond(Failure, "Either accuracy deteriorates as numbers\n");
+ printf("approach a threshold = %.17e\n", UfThold);;
+ printf(" coming down from %.17e\n", C);
+ printf(" or else multiplication gets too many last digits wrong.\n");
+ }
+ Pause();
+ break;
+
+ case 2:
+ BadCond(Failure, "Underflow confuses Comparison which alleges that\n");
+ printf("Q == Y while denying that |Q - Y| == 0; these values\n");
+ printf("print out as Q = %.17e, Y = %.17e .\n", Q, Y);
+ printf ("|Q - Y| = %.17e .\n" , FABS(Q - Y2));
+ UfThold = Q;
+ break;
+
+ case 3:
+ X = X;
+ break;
+
+ case 4:
+ if ((Q == UfThold) && (E1 == E0)
+ && (FABS( UfThold - E1 / E9) <= E1)) {
+ UfNGrad = False;
+ printf("Underflow is gradual; it incurs Absolute Error =\n");
+ printf("(roundoff in UfThold) < E0.\n");
+ Y = E0 * CInvrse;
+ Y = Y * (OneAndHalf + U2);
+ X = CInvrse * (One + U2);
+ Y = Y / X;
+ IEEE = (Y == E0);
+ }
+ }
+ if (UfNGrad) {
+ printf("\n");
+ R = SQRT(Underflow / UfThold);
+ if (R <= H) {
+ Z = R * UfThold;
+ X = Z * (One + R * H * (One + H));
+ }
+ else {
+ Z = UfThold;
+ X = Z * (One + H * H * (One + H));
+ }
+ if (! ((X == Z) || (X - Z != Zero))) {
+ BadCond(Flaw, "");
+ printf("X = %.17e\n\tis not equal to Z = %.17e .\n", X, Z);
+ Z9 = X - Z;
+ printf("yet X - Z yields %.17e .\n", Z9);
+ printf(" Should this NOT signal Underflow, ");
+ printf("this is a SERIOUS DEFECT\nthat causes ");
+ printf("confusion when innocent statements like\n");;
+ printf(" if (X == Z) ... else");
+ printf(" ... (f(X) - f(Z)) / (X - Z) ...\n");
+ printf("encounter Division by Zero although actually\n");
+ printf("X / Z = 1 + %g .\n", (X / Z - Half) - Half);
+ }
+ }
+ printf("The Underflow threshold is %.17e, %s\n", UfThold,
+ " below which");
+ printf("calculation may suffer larger Relative error than ");
+ printf("merely roundoff.\n");
+ Y2 = U1 * U1;
+ Y = Y2 * Y2;
+ Y2 = Y * U1;
+ if (Y2 <= UfThold) {
+ if (Y > E0) {
+ BadCond(Defect, "");
+ I = 5;
+ }
+ else {
+ BadCond(Serious, "");
+ I = 4;
+ }
+ printf("Range is too narrow; U1^%d Underflows.\n", I);
+ }
+ /*=============================================*/
+ /*SPLIT
+ }
+#include "paranoia.h"
+part7(){
+*/
+ Milestone = 130;
+ /*=============================================*/
+ Y = - FLOOR(Half - TwoForty * LOG(UfThold) / LOG(HInvrse)) / TwoForty;
+ Y2 = Y + Y;
+ printf("Since underflow occurs below the threshold\n");
+ printf("UfThold = (%.17e) ^ (%.17e)\nonly underflow ", HInvrse, Y);
+ printf("should afflict the expression\n\t(%.17e) ^ (%.17e);\n", HInvrse, Y);
+ V9 = POW(HInvrse, Y2);
+ printf("actually calculating yields: %.17e .\n", V9);
+ if (! ((V9 >= Zero) && (V9 <= (Radix + Radix + E9) * UfThold))) {
+ BadCond(Serious, "this is not between 0 and underflow\n");
+ printf(" threshold = %.17e .\n", UfThold);
+ }
+ else if (! (V9 > UfThold * (One + E9)))
+ printf("This computed value is O.K.\n");
+ else {
+ BadCond(Defect, "this is not between 0 and underflow\n");
+ printf(" threshold = %.17e .\n", UfThold);
+ }
+ /*=============================================*/
+ Milestone = 140;
+ /*=============================================*/
+ printf("\n");
+ /* ...calculate Exp2 == exp(2) == 7.389056099... */
+ X = Zero;
+ I = 2;
+ Y = Two * Three;
+ Q = Zero;
+ N = 0;
+ do {
+ Z = X;
+ I = I + 1;
+ Y = Y / (I + I);
+ R = Y + Q;
+ X = Z + R;
+ Q = (Z - X) + R;
+ } while(X > Z);
+ Z = (OneAndHalf + One / Eight) + X / (OneAndHalf * ThirtyTwo);
+ X = Z * Z;
+ Exp2 = X * X;
+ X = F9;
+ Y = X - U1;
+ printf("Testing X^((X + 1) / (X - 1)) vs. exp(2) = %.17e as X -> 1.\n",
+ Exp2);
+ for(I = 1;;) {
+ Z = X - BInvrse;
+ Z = (X + One) / (Z - (One - BInvrse));
+ Q = POW(X, Z) - Exp2;
+ if (FABS(Q) > TwoForty * U2) {
+ N = 1;
+ V9 = (X - BInvrse) - (One - BInvrse);
+ BadCond(Defect, "Calculated");
+ printf(" %.17e for\n", POW(X,Z));
+ printf("\t(1 + (%.17e) ^ (%.17e);\n", V9, Z);
+ printf("\tdiffers from correct value by %.17e .\n", Q);
+ printf("\tThis much error may spoil financial\n");
+ printf("\tcalculations involving tiny interest rates.\n");
+ break;
+ }
+ else {
+ Z = (Y - X) * Two + Y;
+ X = Y;
+ Y = Z;
+ Z = One + (X - F9)*(X - F9);
+ if (Z > One && I < NoTrials) I++;
+ else {
+ if (X > One) {
+ if (N == 0)
+ printf("Accuracy seems adequate.\n");
+ break;
+ }
+ else {
+ X = One + U2;
+ Y = U2 + U2;
+ Y += X;
+ I = 1;
+ }
+ }
+ }
+ }
+ /*=============================================*/
+ Milestone = 150;
+ /*=============================================*/
+ printf("Testing powers Z^Q at four nearly extreme values.\n");
+ N = 0;
+ Z = A1;
+ Q = FLOOR(Half - LOG(C) / LOG(A1));
+ Break = False;
+ do {
+ X = CInvrse;
+ Y = POW(Z, Q);
+ IsYeqX();
+ Q = - Q;
+ X = C;
+ Y = POW(Z, Q);
+ IsYeqX();
+ if (Z < One) Break = True;
+ else Z = AInvrse;
+ } while ( ! (Break));
+ PrintIfNPositive();
+ if (N == 0) printf(" ... no discrepancies found.\n");
+ printf("\n");
+
+ /*=============================================*/
+ Milestone = 160;
+ /*=============================================*/
+ Pause();
+ printf("Searching for Overflow threshold:\n");
+ printf("This may generate an error.\n");
+ sigsave = sigfpe;
+ I = 0;
+ Y = - CInvrse;
+ V9 = HInvrse * Y;
+ if (setjmp(ovfl_buf)) goto overflow;
+ do {
+ V = Y;
+ Y = V9;
+ V9 = HInvrse * Y;
+ } while(V9 < Y);
+ I = 1;
+overflow:
+ Z = V9;
+ printf("Can `Z = -Y' overflow?\n");
+ printf("Trying it on Y = %.17e .\n", Y);
+ V9 = - Y;
+ V0 = V9;
+ if (V - Y == V + V0) printf("Seems O.K.\n");
+ else {
+ printf("finds a ");
+ BadCond(Flaw, "-(-Y) differs from Y.\n");
+ }
+ if (Z != Y) {
+ BadCond(Serious, "");
+ printf("overflow past %.17e\n\tshrinks to %.17e .\n", Y, Z);
+ }
+ Y = V * (HInvrse * U2 - HInvrse);
+ Z = Y + ((One - HInvrse) * U2) * V;
+ if (Z < V0) Y = Z;
+ if (Y < V0) V = Y;
+ if (V0 - V < V0) V = V0;
+ printf("Overflow threshold is V = %.17e .\n", V);
+ if (I) printf("Overflow saturates at V0 = %.17e .\n", V0);
+ else printf("There is no saturation value because \
+the system traps on overflow.\n");
+ V9 = V * One;
+ printf("No Overflow should be signaled for V * 1 = %.17e\n", V9);
+ V9 = V / One;
+ printf(" nor for V / 1 = %.17e .\n", V9);
+ printf("Any overflow signal separating this * from the one\n");
+ printf("above is a DEFECT.\n");
+ /*=============================================*/
+ Milestone = 170;
+ /*=============================================*/
+ if (!(-V < V && -V0 < V0 && -UfThold < V && UfThold < V)) {
+ BadCond(Failure, "Comparisons involving ");
+ printf("+-%g, +-%g\nand +-%g are confused by Overflow.",
+ V, V0, UfThold);
+ }
+ /*=============================================*/
+ Milestone = 175;
+ /*=============================================*/
+ printf("\n");
+ for(Indx = 1; Indx <= 3; ++Indx) {
+ switch (Indx) {
+ case 1: Z = UfThold; break;
+ case 2: Z = E0; break;
+ case 3: Z = PseudoZero; break;
+ }
+ if (Z != Zero) {
+ V9 = SQRT(Z);
+ Y = V9 * V9;
+ if (Y / (One - Radix * E9) < Z
+ || Y > (One + Radix + E9) * Z) {
+ if (V9 > U1) BadCond(Serious, "");
+ else BadCond(Defect, "");
+ printf("Comparison alleges that what prints as Z = %.17e\n", Z);
+ printf(" is too far from sqrt(Z) ^ 2 = %.17e .\n", Y);
+ }
+ }
+ }
+ /*=============================================*/
+ Milestone = 180;
+ /*=============================================*/
+ for(Indx = 1; Indx <= 2; ++Indx) {
+ if (Indx == 1) Z = V;
+ else Z = V0;
+ V9 = SQRT(Z);
+ X = (One - Radix * E9) * V9;
+ V9 = V9 * X;
+ if (((V9 < (One - Two * Radix * E9) * Z) || (V9 > Z))) {
+ Y = V9;
+ if (X < W) BadCond(Serious, "");
+ else BadCond(Defect, "");
+ printf("Comparison alleges that Z = %17e\n", Z);
+ printf(" is too far from sqrt(Z) ^ 2 (%.17e) .\n", Y);
+ }
+ }
+ /*=============================================*/
+ /*SPLIT
+ }
+#include "paranoia.h"
+part8(){
+*/
+ Milestone = 190;
+ /*=============================================*/
+ Pause();
+ X = UfThold * V;
+ Y = Radix * Radix;
+ if (X*Y < One || X > Y) {
+ if (X * Y < U1 || X > Y/U1) BadCond(Defect, "Badly");
+ else BadCond(Flaw, "");
+
+ printf(" unbalanced range; UfThold * V = %.17e\n\t%s\n",
+ X, "is too far from 1.\n");
+ }
+ /*=============================================*/
+ Milestone = 200;
+ /*=============================================*/
+ for (Indx = 1; Indx <= 5; ++Indx) {
+ X = F9;
+ switch (Indx) {
+ case 2: X = One + U2; break;
+ case 3: X = V; break;
+ case 4: X = UfThold; break;
+ case 5: X = Radix;
+ }
+ Y = X;
+ sigsave = sigfpe;
+ if (setjmp(ovfl_buf))
+ printf(" X / X traps when X = %g\n", X);
+ else {
+ V9 = (Y / X - Half) - Half;
+ if (V9 == Zero) continue;
+ if (V9 == - U1 && Indx < 5) BadCond(Flaw, "");
+ else BadCond(Serious, "");
+ printf(" X / X differs from 1 when X = %.17e\n", X);
+ printf(" instead, X / X - 1/2 - 1/2 = %.17e .\n", V9);
+ }
+ }
+ /*=============================================*/
+ Milestone = 210;
+ /*=============================================*/
+ MyZero = Zero;
+ printf("\n");
+ printf("What message and/or values does Division by Zero produce?\n") ;
+#ifndef NOPAUSE
+ printf("This can interupt your program. You can ");
+ printf("skip this part if you wish.\n");
+ printf("Do you wish to compute 1 / 0? ");
+ fflush(stdout);
+ read (KEYBOARD, ch, 8);
+ if ((ch[0] == 'Y') || (ch[0] == 'y')) {
+#endif
+ sigsave = sigfpe;
+ printf(" Trying to compute 1 / 0 produces ...");
+ if (!setjmp(ovfl_buf)) printf(" %.7e .\n", One / MyZero);
+#ifndef NOPAUSE
+ }
+ else printf("O.K.\n");
+ printf("\nDo you wish to compute 0 / 0? ");
+ fflush(stdout);
+ read (KEYBOARD, ch, 80);
+ if ((ch[0] == 'Y') || (ch[0] == 'y')) {
+#endif
+ sigsave = sigfpe;
+ printf("\n Trying to compute 0 / 0 produces ...");
+ if (!setjmp(ovfl_buf)) printf(" %.7e .\n", Zero / MyZero);
+#ifndef NOPAUSE
+ }
+ else printf("O.K.\n");
+#endif
+ /*=============================================*/
+ Milestone = 220;
+ /*=============================================*/
+ Pause();
+ printf("\n");
+ {
+ static char *msg[] = {
+ "FAILUREs encountered =",
+ "SERIOUS DEFECTs discovered =",
+ "DEFECTs discovered =",
+ "FLAWs discovered =" };
+ int i;
+ for(i = 0; i < 4; i++) if (ErrCnt[i])
+ printf("The number of %-29s %d.\n",
+ msg[i], ErrCnt[i]);
+ }
+ printf("\n");
+ if ((ErrCnt[Failure] + ErrCnt[Serious] + ErrCnt[Defect]
+ + ErrCnt[Flaw]) > 0) {
+ if ((ErrCnt[Failure] + ErrCnt[Serious] + ErrCnt[
+ Defect] == 0) && (ErrCnt[Flaw] > 0)) {
+ printf("The arithmetic diagnosed seems ");
+ printf("satisfactory though flawed.\n");
+ }
+ if ((ErrCnt[Failure] + ErrCnt[Serious] == 0)
+ && ( ErrCnt[Defect] > 0)) {
+ printf("The arithmetic diagnosed may be acceptable\n");
+ printf("despite inconvenient Defects.\n");
+ }
+ if ((ErrCnt[Failure] + ErrCnt[Serious]) > 0) {
+ printf("The arithmetic diagnosed has ");
+ printf("unacceptable serious defects.\n");
+ }
+ if (ErrCnt[Failure] > 0) {
+ printf("Fatal FAILURE may have spoiled this");
+ printf(" program's subsequent diagnoses.\n");
+ }
+ }
+ else {
+ printf("No failures, defects nor flaws have been discovered.\n");
+ if (! ((RMult == Rounded) && (RDiv == Rounded)
+ && (RAddSub == Rounded) && (RSqrt == Rounded)))
+ printf("The arithmetic diagnosed seems satisfactory.\n");
+ else {
+ if (StickyBit >= One &&
+ (Radix - Two) * (Radix - Nine - One) == Zero) {
+ printf("Rounding appears to conform to ");
+ printf("the proposed IEEE standard P");
+ if ((Radix == Two) &&
+ ((Precision - Four * Three * Two) *
+ ( Precision - TwentySeven -
+ TwentySeven + One) == Zero))
+ printf("754");
+ else printf("854");
+ if (IEEE) printf(".\n");
+ else {
+ printf(",\nexcept for possibly Double Rounding");
+ printf(" during Gradual Underflow.\n");
+ }
+ }
+ printf("The arithmetic diagnosed appears to be excellent!\n");
+ }
+ }
+ if (fpecount)
+ printf("\nA total of %d floating point exceptions were registered.\n",
+ fpecount);
+ printf("END OF TEST.\n");
+ }
+
+/*SPLIT subs.c
+#include "paranoia.h"
+*/
+
+/* Sign */
+
+FLOAT Sign (X)
+FLOAT X;
+{ return X >= 0. ? 1.0 : -1.0; }
+
+/* Pause */
+
+Pause()
+{
+ char ch[8];
+
+#ifndef NOPAUSE
+ printf("\nTo continue, press RETURN");
+ fflush(stdout);
+ read(KEYBOARD, ch, 8);
+#endif
+ printf("\nDiagnosis resumes after milestone Number %d", Milestone);
+ printf(" Page: %d\n\n", PageNo);
+ ++Milestone;
+ ++PageNo;
+ }
+
+ /* TstCond */
+
+TstCond (K, Valid, T)
+int K, Valid;
+char *T;
+{ if (! Valid) { BadCond(K,T); printf(".\n"); } }
+
+BadCond(K, T)
+int K;
+char *T;
+{
+ static char *msg[] = { "FAILURE", "SERIOUS DEFECT", "DEFECT", "FLAW" };
+
+ ErrCnt [K] = ErrCnt [K] + 1;
+ printf("%s: %s", msg[K], T);
+ }
+
+/* Random */
+/* Random computes
+ X = (Random1 + Random9)^5
+ Random1 = X - FLOOR(X) + 0.000005 * X;
+ and returns the new value of Random1
+*/
+
+FLOAT Random()
+{
+ FLOAT X, Y;
+
+ X = Random1 + Random9;
+ Y = X * X;
+ Y = Y * Y;
+ X = X * Y;
+ Y = X - FLOOR(X);
+ Random1 = Y + X * 0.000005;
+ return(Random1);
+ }
+
+/* SqXMinX */
+
+SqXMinX (ErrKind)
+int ErrKind;
+{
+ FLOAT XA, XB;
+
+ XB = X * BInvrse;
+ XA = X - XB;
+ SqEr = ((SQRT(X * X) - XB) - XA) / OneUlp;
+ if (SqEr != Zero) {
+ if (SqEr < MinSqEr) MinSqEr = SqEr;
+ if (SqEr > MaxSqEr) MaxSqEr = SqEr;
+ J = J + 1.0;
+ BadCond(ErrKind, "\n");
+ printf("sqrt( %.17e) - %.17e = %.17e\n", X * X, X, OneUlp * SqEr);
+ printf("\tinstead of correct value 0 .\n");
+ }
+ }
+
+/* NewD */
+
+NewD()
+{
+ X = Z1 * Q;
+ X = FLOOR(Half - X / Radix) * Radix + X;
+ Q = (Q - X * Z) / Radix + X * X * (D / Radix);
+ Z = Z - Two * X * D;
+ if (Z <= Zero) {
+ Z = - Z;
+ Z1 = - Z1;
+ }
+ D = Radix * D;
+ }
+
+/* SR3750 */
+
+SR3750()
+{
+ if (! ((X - Radix < Z2 - Radix) || (X - Z2 > W - Z2))) {
+ I = I + 1;
+ X2 = SQRT(X * D);
+ Y2 = (X2 - Z2) - (Y - Z2);
+ X2 = X8 / (Y - Half);
+ X2 = X2 - Half * X2 * X2;
+ SqEr = (Y2 + Half) + (Half - X2);
+ if (SqEr < MinSqEr) MinSqEr = SqEr;
+ SqEr = Y2 - X2;
+ if (SqEr > MaxSqEr) MaxSqEr = SqEr;
+ }
+ }
+
+/* IsYeqX */
+
+IsYeqX()
+{
+ if (Y != X) {
+ if (N <= 0) {
+ if (Z == Zero && Q <= Zero)
+ printf("WARNING: computing\n");
+ else BadCond(Defect, "computing\n");
+ printf("\t(%.17e) ^ (%.17e)\n", Z, Q);
+ printf("\tyielded %.17e;\n", Y);
+ printf("\twhich compared unequal to correct %.17e ;\n",
+ X);
+ printf("\t\tthey differ by %.17e .\n", Y - X);
+ }
+ N = N + 1; /* ... count discrepancies. */
+ }
+ }
+
+/* SR3980 */
+
+SR3980()
+{
+ do {
+ Q = (FLOAT) I;
+ Y = POW(Z, Q);
+ IsYeqX();
+ if (++I > M) break;
+ X = Z * X;
+ } while ( X < W );
+ }
+
+/* PrintIfNPositive */
+
+PrintIfNPositive()
+{
+ if (N > 0) printf("Similar discrepancies have occurred %d times.\n", N);
+ }
+
+/* TstPtUf */
+
+TstPtUf()
+{
+ N = 0;
+ if (Z != Zero) {
+ printf("Since comparison denies Z = 0, evaluating ");
+ printf("(Z + Z) / Z should be safe.\n");
+ sigsave = sigfpe;
+ if (setjmp(ovfl_buf)) goto very_serious;
+ Q9 = (Z + Z) / Z;
+ printf("What the machine gets for (Z + Z) / Z is %.17e .\n",
+ Q9);
+ if (FABS(Q9 - Two) < Radix * U2) {
+ printf("This is O.K., provided Over/Underflow");
+ printf(" has NOT just been signaled.\n");
+ }
+ else {
+ if ((Q9 < One) || (Q9 > Two)) {
+very_serious:
+ N = 1;
+ ErrCnt [Serious] = ErrCnt [Serious] + 1;
+ printf("This is a VERY SERIOUS DEFECT!\n");
+ }
+ else {
+ N = 1;
+ ErrCnt [Defect] = ErrCnt [Defect] + 1;
+ printf("This is a DEFECT!\n");
+ }
+ }
+ V9 = Z * One;
+ Random1 = V9;
+ V9 = One * Z;
+ Random2 = V9;
+ V9 = Z / One;
+ if ((Z == Random1) && (Z == Random2) && (Z == V9)) {
+ if (N > 0) Pause();
+ }
+ else {
+ N = 1;
+ BadCond(Defect, "What prints as Z = ");
+ printf("%.17e\n\tcompares different from ", Z);
+ if (Z != Random1) printf("Z * 1 = %.17e ", Random1);
+ if (! ((Z == Random2)
+ || (Random2 == Random1)))
+ printf("1 * Z == %g\n", Random2);
+ if (! (Z == V9)) printf("Z / 1 = %.17e\n", V9);
+ if (Random2 != Random1) {
+ ErrCnt [Defect] = ErrCnt [Defect] + 1;
+ BadCond(Defect, "Multiplication does not commute!\n");
+ printf("\tComparison alleges that 1 * Z = %.17e\n",
+ Random2);
+ printf("\tdiffers from Z * 1 = %.17e\n", Random1);
+ }
+ Pause();
+ }
+ }
+ }
+
+notify(s)
+char *s;
+{
+ printf("%s test appears to be inconsistent...\n", s);
+ printf(" PLEASE NOTIFY KARPINKSI!\n");
+ }
+
+/*SPLIT msgs.c */
+
+/* Instructions */
+
+msglist(s)
+char **s;
+{ while(*s) printf("%s\n", *s++); }
+
+Instructions()
+{
+ static char *instr[] = {
+ "Lest this program stop prematurely, i.e. before displaying\n",
+ " `END OF TEST',\n",
+ "try to persuade the computer NOT to terminate execution when an",
+ "error like Over/Underflow or Division by Zero occurs, but rather",
+ "to persevere with a surrogate value after, perhaps, displaying some",
+ "warning. If persuasion avails naught, don't despair but run this",
+ "program anyway to see how many milestones it passes, and then",
+ "amend it to make further progress.\n",
+ "Answer questions with Y, y, N or n (unless otherwise indicated).\n",
+ 0};
+
+ msglist(instr);
+ }
+
+/* Heading */
+
+Heading()
+{
+ static char *head[] = {
+ "Users are invited to help debug and augment this program so it will",
+ "cope with unanticipated and newly uncovered arithmetic pathologies.\n",
+ "Please send suggestions and interesting results to",
+ "\tRichard Karpinski",
+ "\tComputer Center U-76",
+ "\tUniversity of California",
+ "\tSan Francisco, CA 94143-0704, USA\n",
+ "In doing so, please include the following information:",
+#ifdef Single
+ "\tPrecision:\tsingle;",
+#else
+ "\tPrecision:\tdouble;",
+#endif
+ "\tVersion:\t27 January 1986;",
+ "\tComputer:\n",
+ "\tCompiler:\n",
+ "\tOptimization level:\n",
+ "\tOther relevant compiler options:",
+ 0};
+
+ msglist(head);
+ }
+
+/* Characteristics */
+
+Characteristics()
+{
+ static char *chars[] = {
+ "Running this program should reveal these characteristics:",
+ " Radix = 1, 2, 4, 8, 10, 16, 100, 256 ...",
+ " Precision = number of significant digits carried.",
+ " U2 = Radix/Radix^Precision = One Ulp",
+ "\t(OneUlpnit in the Last Place) of 1.000xxx .",
+ " U1 = 1/Radix^Precision = One Ulp of numbers a little less than 1.0 .",
+ " Adequacy of guard digits for Mult., Div. and Subt.",
+ " Whether arithmetic is chopped, correctly rounded, or something else",
+ "\tfor Mult., Div., Add/Subt. and Sqrt.",
+ " Whether a Sticky Bit used correctly for rounding.",
+ " UnderflowThreshold = an underflow threshold.",
+ " E0 and PseudoZero tell whether underflow is abrupt, gradual, or fuzzy.",
+ " V = an overflow threshold, roughly.",
+ " V0 tells, roughly, whether Infinity is represented.",
+ " Comparisions are checked for consistency with subtraction",
+ "\tand for contamination with pseudo-zeros.",
+ " Sqrt is tested. Y^X is not tested.",
+ " Extra-precise subexpressions are revealed but NOT YET tested.",
+ " Decimal-Binary conversion is NOT YET tested for accuracy.",
+ 0};
+
+ msglist(chars);
+ }
+
+History()
+
+{ /* History */
+ /* Converted from Brian Wichmann's Pascal version to C by Thos Sumner,
+ with further massaging by David M. Gay. */
+
+ static char *hist[] = {
+ "The program attempts to discriminate among",
+ " FLAWs, like lack of a sticky bit,",
+ " Serious DEFECTs, like lack of a guard digit, and",
+ " FAILUREs, like 2+2 == 5 .",
+ "Failures may confound subsequent diagnoses.\n",
+ "The diagnostic capabilities of this program go beyond an earlier",
+ "program called `MACHAR', which can be found at the end of the",
+ "book `Software Manual for the Elementary Functions' (1980) by",
+ "W. J. Cody and W. Waite. Although both programs try to discover",
+ "the Radix, Precision and range (over/underflow thresholds)",
+ "of the arithmetic, this program tries to cope with a wider variety",
+ "of pathologies, and to say how well the arithmetic is implemented.",
+ "\nThe program is based upon a conventional radix representation for",
+ "floating-point numbers, but also allows logarithmic encoding",
+ "as used by certain early WANG machines.\n",
+ "BASIC version of this program (C) 1983 by Prof. W. M. Kahan;",
+ "see source comments for more history.",
+ 0};
+
+ msglist(hist);
+ }
diff --git a/libm/double/pdtr.c b/libm/double/pdtr.c
new file mode 100644
index 000000000..5b4ae4054
--- /dev/null
+++ b/libm/double/pdtr.c
@@ -0,0 +1,184 @@
+/* pdtr.c
+ *
+ * Poisson distribution
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * int k;
+ * double m, y, pdtr();
+ *
+ * y = pdtr( 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:
+ *
+ * See igamc().
+ *
+ */
+ /* pdtrc()
+ *
+ * Complemented poisson distribution
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * int k;
+ * double m, y, pdtrc();
+ *
+ * y = pdtrc( 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:
+ *
+ * See igam.c.
+ *
+ */
+ /* pdtri()
+ *
+ * Inverse Poisson distribution
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * int k;
+ * double m, y, pdtr();
+ *
+ * m = pdtri( 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:
+ *
+ * See igami.c.
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * pdtri domain y < 0 or y >= 1 0.0
+ * k < 0
+ *
+ */
+
+/*
+Cephes Math Library Release 2.8: June, 2000
+Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier
+*/
+
+#include <math.h>
+#ifdef ANSIPROT
+extern double igam ( double, double );
+extern double igamc ( double, double );
+extern double igami ( double, double );
+#else
+double igam(), igamc(), igami();
+#endif
+
+double pdtrc( k, m )
+int k;
+double m;
+{
+double v;
+
+if( (k < 0) || (m <= 0.0) )
+ {
+ mtherr( "pdtrc", DOMAIN );
+ return( 0.0 );
+ }
+v = k+1;
+return( igam( v, m ) );
+}
+
+
+
+double pdtr( k, m )
+int k;
+double m;
+{
+double v;
+
+if( (k < 0) || (m <= 0.0) )
+ {
+ mtherr( "pdtr", DOMAIN );
+ return( 0.0 );
+ }
+v = k+1;
+return( igamc( v, m ) );
+}
+
+
+double pdtri( k, y )
+int k;
+double y;
+{
+double v;
+
+if( (k < 0) || (y < 0.0) || (y >= 1.0) )
+ {
+ mtherr( "pdtri", DOMAIN );
+ return( 0.0 );
+ }
+v = k+1;
+v = igami( v, y );
+return( v );
+}
diff --git a/libm/double/planck.c b/libm/double/planck.c
new file mode 100644
index 000000000..834c85dff
--- /dev/null
+++ b/libm/double/planck.c
@@ -0,0 +1,223 @@
+/* planck.c
+ *
+ * Integral of Planck's black body radiation formula
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double lambda, T, y, plancki();
+ *
+ * y = plancki( lambda, T );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Evaluates the definite integral, from wavelength 0 to lambda,
+ * of Planck's radiation formula
+ * -5
+ * c1 lambda
+ * E = ------------------
+ * c2/(lambda T)
+ * e - 1
+ *
+ * Physical constants c1 = 3.7417749e-16 and c2 = 0.01438769 are built in
+ * to the function program. They are scaled to provide a result
+ * in watts per square meter. Argument T represents temperature in degrees
+ * Kelvin; lambda is wavelength in meters.
+ *
+ * The integral is expressed in closed form, in terms of polylogarithms
+ * (see polylog.c).
+ *
+ * The total area under the curve is
+ * (-1/8) (42 zeta(4) - 12 pi^2 zeta(2) + pi^4 ) c1 (T/c2)^4
+ * = (pi^4 / 15) c1 (T/c2)^4
+ * = 5.6705032e-8 T^4
+ * where sigma = 5.6705032e-8 W m^2 K^-4 is the Stefan-Boltzmann constant.
+ *
+ *
+ * ACCURACY:
+ *
+ * The left tail of the function experiences some relative error
+ * amplification in computing the dominant term exp(-c2/(lambda T)).
+ * For the right-hand tail see planckc, below.
+ *
+ * Relative error.
+ * The domain refers to lambda T / c2.
+ * arithmetic domain # trials peak rms
+ * IEEE 0.1, 10 50000 7.1e-15 5.4e-16
+ *
+ */
+
+
+/*
+Cephes Math Library Release 2.8: July, 1999
+Copyright 1999 by Stephen L. Moshier
+*/
+
+#include <math.h>
+#ifdef ANSIPROT
+extern double polylog (int, double);
+extern double exp (double);
+extern double log1p (double); /* log(1+x) */
+extern double expm1 (double); /* exp(x) - 1 */
+double planckc(double, double);
+double plancki(double, double);
+#else
+double polylog(), exp(), log1p(), expm1();
+double planckc(), plancki();
+#endif
+
+/* NIST value (1999): 2 pi h c^2 = 3.741 7749(22) × 10-16 W m2 */
+double planck_c1 = 3.7417749e-16;
+/* NIST value (1999): h c / k = 0.014 387 69 m K */
+double planck_c2 = 0.01438769;
+
+
+double
+plancki(w, T)
+ double w, T;
+{
+ double b, h, y, bw;
+
+ b = T / planck_c2;
+ bw = b * w;
+
+ if (bw > 0.59375)
+ {
+ y = b * b;
+ h = y * y;
+ /* Right tail. */
+ y = planckc (w, T);
+ /* pi^4 / 15 */
+ y = 6.493939402266829149096 * planck_c1 * h - y;
+ return y;
+ }
+
+ h = exp(-planck_c2/(w*T));
+ y = 6. * polylog (4, h) * bw;
+ y = (y + 6. * polylog (3, h)) * bw;
+ y = (y + 3. * polylog (2, h)) * bw;
+ y = (y - log1p (-h)) * bw;
+ h = w * w;
+ h = h * h;
+ y = y * (planck_c1 / h);
+ return y;
+}
+
+/* planckc
+ *
+ * Complemented Planck radiation integral
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double lambda, T, y, planckc();
+ *
+ * y = planckc( lambda, T );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Integral from w to infinity (area under right hand tail)
+ * of Planck's radiation formula.
+ *
+ * The program for large lambda uses an asymptotic series in inverse
+ * powers of the wavelength.
+ *
+ * ACCURACY:
+ *
+ * Relative error.
+ * The domain refers to lambda T / c2.
+ * arithmetic domain # trials peak rms
+ * IEEE 0.6, 10 50000 1.1e-15 2.2e-16
+ *
+ */
+
+double
+planckc (w, T)
+ double w;
+ double T;
+{
+ double b, d, p, u, y;
+
+ b = T / planck_c2;
+ d = b*w;
+ if (d <= 0.59375)
+ {
+ y = 6.493939402266829149096 * planck_c1 * b*b*b*b;
+ return (y - plancki(w,T));
+ }
+ u = 1.0/d;
+ p = u * u;
+#if 0
+ y = 236364091.*p/365866013534056632601804800000.;
+ y = (y - 15458917./475677107995483570176000000.)*p;
+ y = (y + 174611./123104841613737984000000.)*p;
+ y = (y - 43867./643745871363538944000.)*p;
+ y = ((y + 3617./1081289781411840000.)*p - 1./5928123801600.)*p;
+ y = ((y + 691./78460462080000.)*p - 1./2075673600.)*p;
+ y = ((((y + 1./35481600.)*p - 1.0/544320.)*p + 1.0/6720.)*p - 1./40.)*p;
+ y = y + log(d * expm1(u));
+ y = y - 5.*u/8. + 1./3.;
+#else
+ y = -236364091.*p/45733251691757079075225600000.;
+ y = (y + 77683./352527500984795136000000.)*p;
+ y = (y - 174611./18465726242060697600000.)*p;
+ y = (y + 43867./107290978560589824000.)*p;
+ y = ((y - 3617./202741834014720000.)*p + 1./1270312243200.)*p;
+ y = ((y - 691./19615115520000.)*p + 1./622702080.)*p;
+ y = ((((y - 1./13305600.)*p + 1./272160.)*p - 1./5040.)*p + 1./60.)*p;
+ y = y - 0.125*u + 1./3.;
+#endif
+ y = y * planck_c1 * b / (w*w*w);
+ return y;
+}
+
+
+/* planckd
+ *
+ * Planck's black body radiation formula
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double lambda, T, y, planckd();
+ *
+ * y = planckd( lambda, T );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Evaluates Planck's radiation formula
+ * -5
+ * c1 lambda
+ * E = ------------------
+ * c2/(lambda T)
+ * e - 1
+ *
+ */
+
+double
+planckd(w, T)
+ double w, T;
+{
+ return (planck_c2 / ((w*w*w*w*w) * (exp(planck_c2/(w*T)) - 1.0)));
+}
+
+
+/* Wavelength, w, of maximum radiation at given temperature T.
+ c2/wT = constant
+ Wein displacement law.
+ */
+double
+planckw(T)
+ double T;
+{
+ return (planck_c2 / (4.96511423174427630 * T));
+}
diff --git a/libm/double/polevl.c b/libm/double/polevl.c
new file mode 100644
index 000000000..4d050fbfc
--- /dev/null
+++ b/libm/double/polevl.c
@@ -0,0 +1,97 @@
+/* polevl.c
+ * p1evl.c
+ *
+ * Evaluate polynomial
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * int N;
+ * double x, y, coef[N+1], polevl[];
+ *
+ * y = polevl( 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
+*/
+
+
+double polevl( x, coef, N )
+double x;
+double coef[];
+int N;
+{
+double ans;
+int i;
+double *p;
+
+p = coef;
+ans = *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.
+ */
+
+double p1evl( x, coef, N )
+double x;
+double coef[];
+int N;
+{
+double ans;
+double *p;
+int i;
+
+p = coef;
+ans = x + *p++;
+i = N-1;
+
+do
+ ans = ans * x + *p++;
+while( --i );
+
+return( ans );
+}
diff --git a/libm/double/polmisc.c b/libm/double/polmisc.c
new file mode 100644
index 000000000..7d517ae69
--- /dev/null
+++ b/libm/double/polmisc.c
@@ -0,0 +1,309 @@
+
+/* Square root, sine, cosine, and arctangent of polynomial.
+ * See polyn.c for data structures and discussion.
+ */
+
+#include <stdio.h>
+#include <math.h>
+#ifdef ANSIPROT
+extern double atan2 ( double, double );
+extern double sqrt ( double );
+extern double fabs ( double );
+extern double sin ( double );
+extern double cos ( double );
+extern void polclr ( double *a, int n );
+extern void polmov ( double *a, int na, double *b );
+extern void polmul ( double a[], int na, double b[], int nb, double c[] );
+extern void poladd ( double a[], int na, double b[], int nb, double c[] );
+extern void polsub ( double a[], int na, double b[], int nb, double c[] );
+extern int poldiv ( double a[], int na, double b[], int nb, double c[] );
+extern void polsbt ( double a[], int na, double b[], int nb, double c[] );
+extern void * malloc ( long );
+extern void free ( void * );
+#else
+double atan2(), sqrt(), fabs(), sin(), cos();
+void polclr(), polmov(), polsbt(), poladd(), polsub(), polmul();
+int poldiv();
+void * malloc();
+void free ();
+#endif
+
+/* Highest degree of polynomial to be handled
+ by the polyn.c subroutine package. */
+#define N 16
+/* Highest degree actually initialized at runtime. */
+extern int MAXPOL;
+
+/* Taylor series coefficients for various functions
+ */
+double patan[N+1] = {
+ 0.0, 1.0, 0.0, -1.0/3.0, 0.0,
+ 1.0/5.0, 0.0, -1.0/7.0, 0.0, 1.0/9.0, 0.0, -1.0/11.0,
+ 0.0, 1.0/13.0, 0.0, -1.0/15.0, 0.0 };
+
+double psin[N+1] = {
+ 0.0, 1.0, 0.0, -1.0/6.0, 0.0, 1.0/120.0, 0.0,
+ -1.0/5040.0, 0.0, 1.0/362880.0, 0.0, -1.0/39916800.0,
+ 0.0, 1.0/6227020800.0, 0.0, -1.0/1.307674368e12, 0.0};
+
+double pcos[N+1] = {
+ 1.0, 0.0, -1.0/2.0, 0.0, 1.0/24.0, 0.0,
+ -1.0/720.0, 0.0, 1.0/40320.0, 0.0, -1.0/3628800.0, 0.0,
+ 1.0/479001600.0, 0.0, -1.0/8.7179291e10, 0.0, 1.0/2.0922789888e13};
+
+double pasin[N+1] = {
+ 0.0, 1.0, 0.0, 1.0/6.0, 0.0,
+ 3.0/40.0, 0.0, 15.0/336.0, 0.0, 105.0/3456.0, 0.0, 945.0/42240.0,
+ 0.0, 10395.0/599040.0 , 0.0, 135135.0/9676800.0 , 0.0
+};
+
+/* Square root of 1 + x. */
+double psqrt[N+1] = {
+ 1.0, 1./2., -1./8., 1./16., -5./128., 7./256., -21./1024., 33./2048.,
+ -429./32768., 715./65536., -2431./262144., 4199./524288., -29393./4194304.,
+ 52003./8388608., -185725./33554432., 334305./67108864.,
+ -9694845./2147483648.};
+
+/* Arctangent of the ratio num/den of two polynomials.
+ */
+void
+polatn( num, den, ans, nn )
+ double num[], den[], ans[];
+ int nn;
+{
+ double a, t;
+ double *polq, *polu, *polt;
+ int i;
+
+ if (nn > N)
+ {
+ mtherr ("polatn", OVERFLOW);
+ return;
+ }
+ /* arctan( a + b ) = arctan(a) + arctan( b/(1 + ab + a**2) ) */
+ t = num[0];
+ a = den[0];
+ if( (t == 0.0) && (a == 0.0 ) )
+ {
+ t = num[1];
+ a = den[1];
+ }
+ t = atan2( t, a ); /* arctan(num/den), the ANSI argument order */
+ polq = (double * )malloc( (MAXPOL+1) * sizeof (double) );
+ polu = (double * )malloc( (MAXPOL+1) * sizeof (double) );
+ polt = (double * )malloc( (MAXPOL+1) * sizeof (double) );
+ polclr( polq, MAXPOL );
+ i = poldiv( den, nn, num, nn, polq );
+ a = polq[0]; /* a */
+ polq[0] = 0.0; /* b */
+ polmov( polq, nn, polu ); /* b */
+ /* Form the polynomial
+ 1 + ab + a**2
+ where a is a scalar. */
+ for( i=0; i<=nn; i++ )
+ polu[i] *= a;
+ polu[0] += 1.0 + a * a;
+ poldiv( polu, nn, polq, nn, polt ); /* divide into b */
+ polsbt( polt, nn, patan, nn, polu ); /* arctan(b) */
+ polu[0] += t; /* plus arctan(a) */
+ polmov( polu, nn, ans );
+ free( polt );
+ free( polu );
+ free( polq );
+}
+
+
+
+/* Square root of a polynomial.
+ * Assumes the lowest degree nonzero term is dominant
+ * and of even degree. An error message is given
+ * if the Newton iteration does not converge.
+ */
+void
+polsqt( pol, ans, nn )
+ double pol[], ans[];
+ int nn;
+{
+ double t;
+ double *x, *y;
+ int i, n;
+#if 0
+ double z[N+1];
+ double u;
+#endif
+
+ if (nn > N)
+ {
+ mtherr ("polatn", OVERFLOW);
+ return;
+ }
+ x = (double * )malloc( (MAXPOL+1) * sizeof (double) );
+ y = (double * )malloc( (MAXPOL+1) * sizeof (double) );
+ polmov( pol, nn, x );
+ polclr( y, MAXPOL );
+
+ /* Find lowest degree nonzero term. */
+ t = 0.0;
+ for( n=0; n<nn; n++ )
+ {
+ if( x[n] != 0.0 )
+ goto nzero;
+ }
+ polmov( y, nn, ans );
+ return;
+
+nzero:
+
+ if( n > 0 )
+ {
+ if (n & 1)
+ {
+ printf("error, sqrt of odd polynomial\n");
+ return;
+ }
+ /* Divide by x^n. */
+ y[n] = x[n];
+ poldiv (y, nn, pol, N, x);
+ }
+
+ t = x[0];
+ for( i=1; i<=nn; i++ )
+ x[i] /= t;
+ x[0] = 0.0;
+ /* series development sqrt(1+x) = 1 + x / 2 - x**2 / 8 + x**3 / 16
+ hopes that first (constant) term is greater than what follows */
+ polsbt( x, nn, psqrt, nn, y);
+ t = sqrt( t );
+ for( i=0; i<=nn; i++ )
+ y[i] *= t;
+
+ /* If first nonzero coefficient was at degree n > 0, multiply by
+ x^(n/2). */
+ if (n > 0)
+ {
+ polclr (x, MAXPOL);
+ x[n/2] = 1.0;
+ polmul (x, nn, y, nn, y);
+ }
+#if 0
+/* Newton iterations */
+for( n=0; n<10; n++ )
+ {
+ poldiv( y, nn, pol, nn, z );
+ poladd( y, nn, z, nn, y );
+ for( i=0; i<=nn; i++ )
+ y[i] *= 0.5;
+ for( i=0; i<=nn; i++ )
+ {
+ u = fabs( y[i] - z[i] );
+ if( u > 1.0e-15 )
+ goto more;
+ }
+ goto done;
+more: ;
+ }
+printf( "square root did not converge\n" );
+done:
+#endif /* 0 */
+
+polmov( y, nn, ans );
+free( y );
+free( x );
+}
+
+
+
+/* Sine of a polynomial.
+ * The computation uses
+ * sin(a+b) = sin(a) cos(b) + cos(a) sin(b)
+ * where a is the constant term of the polynomial and
+ * b is the sum of the rest of the terms.
+ * Since sin(b) and cos(b) are computed by series expansions,
+ * the value of b should be small.
+ */
+void
+polsin( x, y, nn )
+ double x[], y[];
+ int nn;
+{
+ double a, sc;
+ double *w, *c;
+ int i;
+
+ if (nn > N)
+ {
+ mtherr ("polatn", OVERFLOW);
+ return;
+ }
+ w = (double * )malloc( (MAXPOL+1) * sizeof (double) );
+ c = (double * )malloc( (MAXPOL+1) * sizeof (double) );
+ polmov( x, nn, w );
+ polclr( c, MAXPOL );
+ polclr( y, nn );
+ /* a, in the description, is x[0]. b is the polynomial x - x[0]. */
+ a = w[0];
+ /* c = cos (b) */
+ w[0] = 0.0;
+ polsbt( w, nn, pcos, nn, c );
+ sc = sin(a);
+ /* sin(a) cos (b) */
+ for( i=0; i<=nn; i++ )
+ c[i] *= sc;
+ /* y = sin (b) */
+ polsbt( w, nn, psin, nn, y );
+ sc = cos(a);
+ /* cos(a) sin(b) */
+ for( i=0; i<=nn; i++ )
+ y[i] *= sc;
+ poladd( c, nn, y, nn, y );
+ free( c );
+ free( w );
+}
+
+
+/* Cosine of a polynomial.
+ * The computation uses
+ * cos(a+b) = cos(a) cos(b) - sin(a) sin(b)
+ * where a is the constant term of the polynomial and
+ * b is the sum of the rest of the terms.
+ * Since sin(b) and cos(b) are computed by series expansions,
+ * the value of b should be small.
+ */
+void
+polcos( x, y, nn )
+ double x[], y[];
+ int nn;
+{
+ double a, sc;
+ double *w, *c;
+ int i;
+ double sin(), cos();
+
+ if (nn > N)
+ {
+ mtherr ("polatn", OVERFLOW);
+ return;
+ }
+ w = (double * )malloc( (MAXPOL+1) * sizeof (double) );
+ c = (double * )malloc( (MAXPOL+1) * sizeof (double) );
+ polmov( x, nn, w );
+ polclr( c, MAXPOL );
+ polclr( y, nn );
+ a = w[0];
+ w[0] = 0.0;
+ /* c = cos(b) */
+ polsbt( w, nn, pcos, nn, c );
+ sc = cos(a);
+ /* cos(a) cos(b) */
+ for( i=0; i<=nn; i++ )
+ c[i] *= sc;
+ /* y = sin(b) */
+ polsbt( w, nn, psin, nn, y );
+ sc = sin(a);
+ /* sin(a) sin(b) */
+ for( i=0; i<=nn; i++ )
+ y[i] *= sc;
+ polsub( y, nn, c, nn, y );
+ free( c );
+ free( w );
+}
diff --git a/libm/double/polrt.c b/libm/double/polrt.c
new file mode 100644
index 000000000..b1cd88087
--- /dev/null
+++ b/libm/double/polrt.c
@@ -0,0 +1,227 @@
+/* polrt.c
+ *
+ * Find roots of a polynomial
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * typedef struct
+ * {
+ * double r;
+ * double i;
+ * }cmplx;
+ *
+ * double xcof[], cof[];
+ * int m;
+ * cmplx root[];
+ *
+ * polrt( xcof, cof, m, root )
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Iterative determination of the roots of a polynomial of
+ * degree m whose coefficient vector is xcof[]. The
+ * coefficients are arranged in ascending order; i.e., the
+ * coefficient of x**m is xcof[m].
+ *
+ * The array cof[] is working storage the same size as xcof[].
+ * root[] is the output array containing the complex roots.
+ *
+ *
+ * ACCURACY:
+ *
+ * Termination depends on evaluation of the polynomial at
+ * the trial values of the roots. The values of multiple roots
+ * or of roots that are nearly equal may have poor relative
+ * accuracy after the first root in the neighborhood has been
+ * found.
+ *
+ */
+
+/* polrt */
+/* Complex roots of real polynomial */
+/* number of coefficients is m + 1 ( i.e., m is degree of polynomial) */
+
+#include <math.h>
+/*
+typedef struct
+ {
+ double r;
+ double i;
+ }cmplx;
+*/
+#ifdef ANSIPROT
+extern double fabs ( double );
+#else
+double fabs();
+#endif
+
+int polrt( xcof, cof, m, root )
+double xcof[], cof[];
+int m;
+cmplx root[];
+{
+register double *p, *q;
+int i, j, nsav, n, n1, n2, nroot, iter, retry;
+int final;
+double mag, cofj;
+cmplx x0, x, xsav, dx, t, t1, u, ud;
+
+final = 0;
+n = m;
+if( n <= 0 )
+ return(1);
+if( n > 36 )
+ return(2);
+if( xcof[m] == 0.0 )
+ return(4);
+
+n1 = n;
+n2 = n;
+nroot = 0;
+nsav = n;
+q = &xcof[0];
+p = &cof[n];
+for( j=0; j<=nsav; j++ )
+ *p-- = *q++; /* cof[ n-j ] = xcof[j];*/
+xsav.r = 0.0;
+xsav.i = 0.0;
+
+nxtrut:
+x0.r = 0.00500101;
+x0.i = 0.01000101;
+retry = 0;
+
+tryagn:
+retry += 1;
+x.r = x0.r;
+
+x0.r = -10.0 * x0.i;
+x0.i = -10.0 * x.r;
+
+x.r = x0.r;
+x.i = x0.i;
+
+finitr:
+iter = 0;
+
+while( iter < 500 )
+{
+u.r = cof[n];
+if( u.r == 0.0 )
+ { /* this root is zero */
+ x.r = 0;
+ n1 -= 1;
+ n2 -= 1;
+ goto zerrut;
+ }
+u.i = 0;
+ud.r = 0;
+ud.i = 0;
+t.r = 1.0;
+t.i = 0;
+p = &cof[n-1];
+for( i=0; i<n; i++ )
+ {
+ t1.r = x.r * t.r - x.i * t.i;
+ t1.i = x.r * t.i + x.i * t.r;
+ cofj = *p--; /* evaluate polynomial */
+ u.r += cofj * t1.r;
+ u.i += cofj * t1.i;
+ cofj = cofj * (i+1); /* derivative */
+ ud.r += cofj * t.r;
+ ud.i -= cofj * t.i;
+ t.r = t1.r;
+ t.i = t1.i;
+ }
+
+mag = ud.r * ud.r + ud.i * ud.i;
+if( mag == 0.0 )
+ {
+ if( !final )
+ goto tryagn;
+ x.r = xsav.r;
+ x.i = xsav.i;
+ goto findon;
+ }
+dx.r = (u.i * ud.i - u.r * ud.r)/mag;
+x.r += dx.r;
+dx.i = -(u.r * ud.i + u.i * ud.r)/mag;
+x.i += dx.i;
+if( (fabs(dx.i) + fabs(dx.r)) < 1.0e-6 )
+ goto lupdon;
+iter += 1;
+} /* while iter < 500 */
+
+if( final )
+ goto lupdon;
+if( retry < 5 )
+ goto tryagn;
+return(3);
+
+lupdon:
+/* Swap original and reduced polynomials */
+q = &xcof[nsav];
+p = &cof[0];
+for( j=0; j<=n2; j++ )
+ {
+ cofj = *q;
+ *q-- = *p;
+ *p++ = cofj;
+ }
+i = n;
+n = n1;
+n1 = i;
+
+if( !final )
+ {
+ final = 1;
+ if( fabs(x.i/x.r) < 1.0e-4 )
+ x.i = 0.0;
+ xsav.r = x.r;
+ xsav.i = x.i;
+ goto finitr; /* do final iteration on original polynomial */
+ }
+
+findon:
+final = 0;
+if( fabs(x.i/x.r) >= 1.0e-5 )
+ {
+ cofj = x.r + x.r;
+ mag = x.r * x.r + x.i * x.i;
+ n -= 2;
+ }
+else
+ { /* root is real */
+zerrut:
+ x.i = 0;
+ cofj = x.r;
+ mag = 0;
+ n -= 1;
+ }
+/* divide working polynomial cof(z) by z - x */
+p = &cof[1];
+*p += cofj * *(p-1);
+for( j=1; j<n; j++ )
+ {
+ *(p+1) += cofj * *p - mag * *(p-1);
+ p++;
+ }
+
+setrut:
+root[nroot].r = x.r;
+root[nroot].i = x.i;
+nroot += 1;
+if( mag != 0.0 )
+ {
+ x.i = -x.i;
+ mag = 0;
+ goto setrut; /* fill in the complex conjugate root */
+ }
+if( n > 0 )
+ goto nxtrut;
+return(0);
+}
diff --git a/libm/double/polylog.c b/libm/double/polylog.c
new file mode 100644
index 000000000..c21e04449
--- /dev/null
+++ b/libm/double/polylog.c
@@ -0,0 +1,467 @@
+/* polylog.c
+ *
+ * Polylogarithms
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, polylog();
+ * int n;
+ *
+ * y = polylog( n, x );
+ *
+ *
+ * The polylogarithm of order n is defined by the series
+ *
+ *
+ * inf k
+ * - x
+ * Li (x) = > --- .
+ * n - n
+ * k=1 k
+ *
+ *
+ * For x = 1,
+ *
+ * inf
+ * - 1
+ * Li (1) = > --- = Riemann zeta function (n) .
+ * n - n
+ * k=1 k
+ *
+ *
+ * When n = 2, the function is the dilogarithm, related to Spence's integral:
+ *
+ * x 1-x
+ * - -
+ * | | -ln(1-t) | | ln t
+ * Li (x) = | -------- dt = | ------ dt = spence(1-x) .
+ * 2 | | t | | 1 - t
+ * - -
+ * 0 1
+ *
+ *
+ * See also the program cpolylog.c for the complex polylogarithm,
+ * whose definition is extended to x > 1.
+ *
+ * References:
+ *
+ * Lewin, L., _Polylogarithms and Associated Functions_,
+ * North Holland, 1981.
+ *
+ * Lewin, L., ed., _Structural Properties of Polylogarithms_,
+ * American Mathematical Society, 1991.
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain n # trials peak rms
+ * IEEE 0, 1 2 50000 6.2e-16 8.0e-17
+ * IEEE 0, 1 3 100000 2.5e-16 6.6e-17
+ * IEEE 0, 1 4 30000 1.7e-16 4.9e-17
+ * IEEE 0, 1 5 30000 5.1e-16 7.8e-17
+ *
+ */
+
+/*
+Cephes Math Library Release 2.8: July, 1999
+Copyright 1999 by Stephen L. Moshier
+*/
+
+#include <math.h>
+extern double PI;
+
+/* polylog(4, 1-x) = zeta(4) - x zeta(3) + x^2 A4(x)/B4(x)
+ 0 <= x <= 0.125
+ Theoretical peak absolute error 4.5e-18 */
+#if UNK
+static double A4[13] = {
+ 3.056144922089490701751E-2,
+ 3.243086484162581557457E-1,
+ 2.877847281461875922565E-1,
+ 7.091267785886180663385E-2,
+ 6.466460072456621248630E-3,
+ 2.450233019296542883275E-4,
+ 4.031655364627704957049E-6,
+ 2.884169163909467997099E-8,
+ 8.680067002466594858347E-11,
+ 1.025983405866370985438E-13,
+ 4.233468313538272640380E-17,
+ 4.959422035066206902317E-21,
+ 1.059365867585275714599E-25,
+};
+static double B4[12] = {
+ /* 1.000000000000000000000E0, */
+ 2.821262403600310974875E0,
+ 1.780221124881327022033E0,
+ 3.778888211867875721773E-1,
+ 3.193887040074337940323E-2,
+ 1.161252418498096498304E-3,
+ 1.867362374829870620091E-5,
+ 1.319022779715294371091E-7,
+ 3.942755256555603046095E-10,
+ 4.644326968986396928092E-13,
+ 1.913336021014307074861E-16,
+ 2.240041814626069927477E-20,
+ 4.784036597230791011855E-25,
+};
+#endif
+#if DEC
+static short A4[52] = {
+0036772,0056001,0016601,0164507,
+0037646,0005710,0076603,0176456,
+0037623,0054205,0013532,0026476,
+0037221,0035252,0101064,0065407,
+0036323,0162231,0042033,0107244,
+0035200,0073170,0106141,0136543,
+0033607,0043647,0163672,0055340,
+0031767,0137614,0173376,0072313,
+0027676,0160156,0161276,0034203,
+0025347,0003752,0123106,0064266,
+0022503,0035770,0160173,0177501,
+0017273,0056226,0033704,0132530,
+0013403,0022244,0175205,0052161,
+};
+static short B4[48] = {
+ /*0040200,0000000,0000000,0000000, */
+0040464,0107620,0027471,0071672,
+0040343,0157111,0025601,0137255,
+0037701,0075244,0140412,0160220,
+0037002,0151125,0036572,0057163,
+0035630,0032452,0050727,0161653,
+0034234,0122515,0034323,0172615,
+0032415,0120405,0123660,0003160,
+0030330,0140530,0161045,0150177,
+0026002,0134747,0014542,0002510,
+0023134,0113666,0035730,0035732,
+0017723,0110343,0041217,0007764,
+0014024,0007412,0175575,0160230,
+};
+#endif
+#if IBMPC
+static short A4[52] = {
+0x3d29,0x23b0,0x4b80,0x3f9f,
+0x7fa6,0x0fb0,0xc179,0x3fd4,
+0x45a8,0xa2eb,0x6b10,0x3fd2,
+0x8d61,0x5046,0x2755,0x3fb2,
+0x71d4,0x2883,0x7c93,0x3f7a,
+0x37ac,0x118c,0x0ecf,0x3f30,
+0x4b5c,0xfcf7,0xe8f4,0x3ed0,
+0xce99,0x9edf,0xf7f1,0x3e5e,
+0xc710,0xdc57,0xdc0d,0x3dd7,
+0xcd17,0x54c8,0xe0fd,0x3d3c,
+0x7fe8,0x1c0f,0x677f,0x3c88,
+0x96ab,0xc6f8,0x6b92,0x3bb7,
+0xaa8e,0x9f50,0x6494,0x3ac0,
+};
+static short B4[48] = {
+ /*0x0000,0x0000,0x0000,0x3ff0,*/
+0x2e77,0x05e7,0x91f2,0x4006,
+0x37d6,0x2570,0x7bc9,0x3ffc,
+0x5c12,0x9821,0x2f54,0x3fd8,
+0x4bce,0xa7af,0x5a4a,0x3fa0,
+0xfc75,0x4a3a,0x06a5,0x3f53,
+0x7eb2,0xa71a,0x94a9,0x3ef3,
+0x00ce,0xb4f6,0xb420,0x3e81,
+0xba10,0x1c44,0x182b,0x3dfb,
+0x40a9,0xe32c,0x573c,0x3d60,
+0x077b,0xc77b,0x92f6,0x3cab,
+0xe1fe,0x6851,0x721c,0x3bda,
+0xbc13,0x5f6f,0x81e1,0x3ae2,
+};
+#endif
+#if MIEEE
+static short A4[52] = {
+0x3f9f,0x4b80,0x23b0,0x3d29,
+0x3fd4,0xc179,0x0fb0,0x7fa6,
+0x3fd2,0x6b10,0xa2eb,0x45a8,
+0x3fb2,0x2755,0x5046,0x8d61,
+0x3f7a,0x7c93,0x2883,0x71d4,
+0x3f30,0x0ecf,0x118c,0x37ac,
+0x3ed0,0xe8f4,0xfcf7,0x4b5c,
+0x3e5e,0xf7f1,0x9edf,0xce99,
+0x3dd7,0xdc0d,0xdc57,0xc710,
+0x3d3c,0xe0fd,0x54c8,0xcd17,
+0x3c88,0x677f,0x1c0f,0x7fe8,
+0x3bb7,0x6b92,0xc6f8,0x96ab,
+0x3ac0,0x6494,0x9f50,0xaa8e,
+};
+static short B4[48] = {
+ /*0x3ff0,0x0000,0x0000,0x0000,*/
+0x4006,0x91f2,0x05e7,0x2e77,
+0x3ffc,0x7bc9,0x2570,0x37d6,
+0x3fd8,0x2f54,0x9821,0x5c12,
+0x3fa0,0x5a4a,0xa7af,0x4bce,
+0x3f53,0x06a5,0x4a3a,0xfc75,
+0x3ef3,0x94a9,0xa71a,0x7eb2,
+0x3e81,0xb420,0xb4f6,0x00ce,
+0x3dfb,0x182b,0x1c44,0xba10,
+0x3d60,0x573c,0xe32c,0x40a9,
+0x3cab,0x92f6,0xc77b,0x077b,
+0x3bda,0x721c,0x6851,0xe1fe,
+0x3ae2,0x81e1,0x5f6f,0xbc13,
+};
+#endif
+
+#ifdef ANSIPROT
+extern double spence ( double );
+extern double polevl ( double, void *, int );
+extern double p1evl ( double, void *, int );
+extern double zetac ( double );
+extern double pow ( double, double );
+extern double powi ( double, int );
+extern double log ( double );
+extern double fac ( int i );
+extern double fabs (double);
+double polylog (int, double);
+#else
+extern double spence(), polevl(), p1evl(), zetac();
+extern double pow(), powi(), log();
+extern double fac(); /* factorial */
+extern double fabs();
+double polylog();
+#endif
+extern double MACHEP;
+
+double
+polylog (n, x)
+ int n;
+ double x;
+{
+ double h, k, p, s, t, u, xc, z;
+ int i, j;
+
+/* This recurrence provides formulas for n < 2.
+
+ d 1
+ -- Li (x) = --- Li (x) .
+ dx n x n-1
+
+*/
+
+ if (n == -1)
+ {
+ p = 1.0 - x;
+ u = x / p;
+ s = u * u + u;
+ return s;
+ }
+
+ if (n == 0)
+ {
+ s = x / (1.0 - x);
+ return s;
+ }
+
+ /* Not implemented for n < -1.
+ Not defined for x > 1. Use cpolylog if you need that. */
+ if (x > 1.0 || n < -1)
+ {
+ mtherr("polylog", DOMAIN);
+ return 0.0;
+ }
+
+ if (n == 1)
+ {
+ s = -log (1.0 - x);
+ return s;
+ }
+
+ /* Argument +1 */
+ if (x == 1.0 && n > 1)
+ {
+ s = zetac ((double) n) + 1.0;
+ return s;
+ }
+
+ /* Argument -1.
+ 1-n
+ Li (-z) = - (1 - 2 ) Li (z)
+ n n
+ */
+ if (x == -1.0 && n > 1)
+ {
+ /* Li_n(1) = zeta(n) */
+ s = zetac ((double) n) + 1.0;
+ s = s * (powi (2.0, 1 - n) - 1.0);
+ return s;
+ }
+
+/* Inversion formula:
+ * [n/2] n-2r
+ * n 1 n - log (z)
+ * Li (-z) + (-1) Li (-1/z) = - --- log (z) + 2 > ----------- Li (-1)
+ * n n n! - (n - 2r)! 2r
+ * r=1
+ */
+ if (x < -1.0 && n > 1)
+ {
+ double q, w;
+ int r;
+
+ w = log (-x);
+ s = 0.0;
+ for (r = 1; r <= n / 2; r++)
+ {
+ j = 2 * r;
+ p = polylog (j, -1.0);
+ j = n - j;
+ if (j == 0)
+ {
+ s = s + p;
+ break;
+ }
+ q = (double) j;
+ q = pow (w, q) * p / fac (j);
+ s = s + q;
+ }
+ s = 2.0 * s;
+ q = polylog (n, 1.0 / x);
+ if (n & 1)
+ q = -q;
+ s = s - q;
+ s = s - pow (w, (double) n) / fac (n);
+ return s;
+ }
+
+ if (n == 2)
+ {
+ if (x < 0.0 || x > 1.0)
+ return (spence (1.0 - x));
+ }
+
+
+
+ /* The power series converges slowly when x is near 1. For n = 3, this
+ identity helps:
+
+ Li (-x/(1-x)) + Li (1-x) + Li (x)
+ 3 3 3
+ 2 2 3
+ = Li (1) + (pi /6) log(1-x) - (1/2) log(x) log (1-x) + (1/6) log (1-x)
+ 3
+ */
+
+ if (n == 3)
+ {
+ p = x * x * x;
+ if (x > 0.8)
+ {
+ u = log(x);
+ s = p / 6.0;
+ xc = 1.0 - x;
+ s = s - 0.5 * u * u * log(xc);
+ s = s + PI * PI * u / 6.0;
+ s = s - polylog (3, -xc/x);
+ s = s - polylog (3, xc);
+ s = s + zetac(3.0);
+ s = s + 1.0;
+ return s;
+ }
+ /* Power series */
+ t = p / 27.0;
+ t = t + .125 * x * x;
+ t = t + x;
+
+ s = 0.0;
+ k = 4.0;
+ do
+ {
+ p = p * x;
+ h = p / (k * k * k);
+ s = s + h;
+ k += 1.0;
+ }
+ while (fabs(h/s) > 1.1e-16);
+ return (s + t);
+ }
+
+if (n == 4)
+ {
+ if (x >= 0.875)
+ {
+ u = 1.0 - x;
+ s = polevl(u, A4, 12) / p1evl(u, B4, 12);
+ s = s * u * u - 1.202056903159594285400 * u;
+ s += 1.0823232337111381915160;
+ return s;
+ }
+ goto pseries;
+ }
+
+
+ if (x < 0.75)
+ goto pseries;
+
+
+/* This expansion in powers of log(x) is especially useful when
+ x is near 1.
+
+ See also the pari gp calculator.
+
+ inf j
+ - z(n-j) (log(x))
+ polylog(n,x) = > -----------------
+ - j!
+ j=0
+
+ where
+
+ z(j) = Riemann zeta function (j), j != 1
+
+ n-1
+ -
+ z(1) = -log(-log(x)) + > 1/k
+ -
+ k=1
+ */
+
+ z = log(x);
+ h = -log(-z);
+ for (i = 1; i < n; i++)
+ h = h + 1.0/i;
+ p = 1.0;
+ s = zetac((double)n) + 1.0;
+ for (j=1; j<=n+1; j++)
+ {
+ p = p * z / j;
+ if (j == n-1)
+ s = s + h * p;
+ else
+ s = s + (zetac((double)(n-j)) + 1.0) * p;
+ }
+ j = n + 3;
+ z = z * z;
+ for(;;)
+ {
+ p = p * z / ((j-1)*j);
+ h = (zetac((double)(n-j)) + 1.0);
+ h = h * p;
+ s = s + h;
+ if (fabs(h/s) < MACHEP)
+ break;
+ j += 2;
+ }
+ return s;
+
+
+pseries:
+
+ p = x * x * x;
+ k = 3.0;
+ s = 0.0;
+ do
+ {
+ p = p * x;
+ k += 1.0;
+ h = p / powi(k, n);
+ s = s + h;
+ }
+ while (fabs(h/s) > MACHEP);
+ s += x * x * x / powi(3.0,n);
+ s += x * x / powi(2.0,n);
+ s += x;
+ return s;
+}
diff --git a/libm/double/polyn.c b/libm/double/polyn.c
new file mode 100644
index 000000000..2927e77f0
--- /dev/null
+++ b/libm/double/polyn.c
@@ -0,0 +1,471 @@
+/* polyn.c
+ * polyr.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 MAXPOL. 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
+ *
+ * polini( 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 polini().
+ *
+ * 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.
+ * polprt( a, na, D ); Print the coefficients of a to D digits.
+ * polclr( a, na ); Set a identically equal to zero, up to a[na].
+ * polmov( a, na, b ); Set b = a.
+ * poladd( a, na, b, nb, c ); c = b + a, nc = max(na,nb)
+ * polsub( a, na, b, nb, c ); c = b - a, nc = max(na,nb)
+ * polmul( a, na, b, nb, c ); c = b * a, nc = na+nb
+ *
+ *
+ * Division:
+ *
+ * i = poldiv( 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
+ *
+ * polsbt( a, na, b, nb, c );
+ *
+ *
+ * Notes:
+ * poldiv() is an integer routine; poleva() is double.
+ * Any of the arguments a, b, c may refer to the same array.
+ *
+ */
+
+#include <stdio.h>
+#include <math.h>
+#if ANSIPROT
+void exit (int);
+extern void * malloc ( long );
+extern void free ( void * );
+void polclr ( double *, int );
+void polmov ( double *, int, double * );
+void polmul ( double *, int, double *, int, double * );
+int poldiv ( double *, int, double *, int, double * );
+#else
+void exit();
+void * malloc();
+void free ();
+void polclr(), polmov(), poldiv(), polmul();
+#endif
+#ifndef NULL
+#define NULL 0
+#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 double *pt1 = 0;
+static double *pt2 = 0;
+static double *pt3 = 0;
+
+/* Maximum degree of polynomial. */
+int MAXPOL = 0;
+extern int MAXPOL;
+
+/* Number of bytes (chars) in maximum size polynomial. */
+static int psize = 0;
+
+
+/* Initialize max degree of polynomials
+ * and allocate temporary storage.
+ */
+void polini( maxdeg )
+int maxdeg;
+{
+
+MAXPOL = maxdeg;
+psize = (maxdeg + 1) * sizeof(double);
+
+/* Release previously allocated memory, if any. */
+if( pt3 )
+ free(pt3);
+if( pt2 )
+ free(pt2);
+if( pt1 )
+ free(pt1);
+
+/* Allocate new arrays */
+pt1 = (double * )malloc(psize); /* used by polsbt */
+pt2 = (double * )malloc(psize); /* used by polsbt */
+pt3 = (double * )malloc(psize); /* used by polmul */
+
+/* Report if failure */
+if( (pt1 == NULL) || (pt2 == NULL) || (pt3 == NULL) )
+ {
+ mtherr( "polini", ERANGE );
+ exit(1);
+ }
+}
+
+
+
+/* Print the coefficients of a, with d decimal precision.
+ */
+static char *form = "abcdefghijk";
+
+void polprt( a, na, d )
+double a[];
+int na, d;
+{
+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;
+sprintf( p, "%d ", d1 );
+p += 1;
+if( d1 >= 10 )
+ p += 1;
+*p++ = '.';
+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" );
+}
+
+
+
+/* Set a = 0.
+ */
+void polclr( a, n )
+register double *a;
+int n;
+{
+int i;
+
+if( n > MAXPOL )
+ n = MAXPOL;
+for( i=0; i<=n; i++ )
+ *a++ = 0.0;
+}
+
+
+
+/* Set b = a.
+ */
+void polmov( a, na, b )
+register double *a, *b;
+int na;
+{
+int i;
+
+if( na > MAXPOL )
+ na = MAXPOL;
+
+for( i=0; i<= na; i++ )
+ {
+ *b++ = *a++;
+ }
+}
+
+
+/* c = b * a.
+ */
+void polmul( a, na, b, nb, c )
+double a[], b[], c[];
+int na, nb;
+{
+int i, j, k, nc;
+double x;
+
+nc = na + nb;
+polclr( pt3, MAXPOL );
+
+for( i=0; i<=na; i++ )
+ {
+ x = a[i];
+ for( j=0; j<=nb; j++ )
+ {
+ k = i + j;
+ if( k > MAXPOL )
+ break;
+ pt3[k] += x * b[j];
+ }
+ }
+
+if( nc > MAXPOL )
+ nc = MAXPOL;
+for( i=0; i<=nc; i++ )
+ c[i] = pt3[i];
+}
+
+
+
+
+/* c = b + a.
+ */
+void poladd( a, na, b, nb, c )
+double a[], b[], c[];
+int na, nb;
+{
+int i, n;
+
+
+if( na > nb )
+ n = na;
+else
+ n = nb;
+
+if( n > MAXPOL )
+ n = MAXPOL;
+
+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];
+ }
+}
+
+/* c = b - a.
+ */
+void polsub( a, na, b, nb, c )
+double a[], b[], c[];
+int na, nb;
+{
+int i, n;
+
+
+if( na > nb )
+ n = na;
+else
+ n = nb;
+
+if( n > MAXPOL )
+ n = MAXPOL;
+
+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];
+ }
+}
+
+
+
+/* c = b/a
+ */
+int poldiv( a, na, b, nb, c )
+double a[], b[], c[];
+int na, nb;
+{
+double quot;
+double *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 = (double * )malloc( psize );
+polclr( ta, MAXPOL );
+polmov( a, na, ta );
+
+tb = (double * )malloc( psize );
+polclr( tb, MAXPOL );
+polmov( b, nb, tb );
+
+tq = (double * )malloc( psize );
+polclr( tq, MAXPOL );
+
+/* 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( "poldiv", 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( "poldiv 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 += poldiv( ta, na, tb, nb, c );
+ goto done;
+ }
+
+/* Long division algorithm. ta[0] is nonzero.
+ */
+for( i=0; i<=MAXPOL; i++ )
+ {
+ quot = tb[i]/ta[0];
+ for( j=0; j<=MAXPOL; j++ )
+ {
+ k = j + i;
+ if( k > MAXPOL )
+ break;
+ tb[k] -= quot * ta[j];
+ }
+ tq[i] = quot;
+ }
+/* Send quotient to output array. */
+polmov( tq, MAXPOL, 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)).
+ */
+
+void polsbt( a, na, b, nb, c )
+double a[], b[], c[];
+int na, nb;
+{
+int i, j, k, n2;
+double x;
+
+/* 0th degree term:
+ */
+polclr( pt1, MAXPOL );
+pt1[0] = b[0];
+
+polclr( pt2, MAXPOL );
+pt2[0] = 1.0;
+n2 = 0;
+
+for( i=1; i<=nb; i++ )
+ {
+/* Form ith power of a. */
+ polmul( 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 > MAXPOL )
+ break;
+ pt1[j] += x * pt2[j];
+ }
+ }
+
+k = n2 + nb;
+if( k > MAXPOL )
+ k = MAXPOL;
+for( i=0; i<=k; i++ )
+ c[i] = pt1[i];
+}
+
+
+
+
+/* Evaluate polynomial a(t) at t = x.
+ */
+double poleva( a, na, x )
+double a[];
+int na;
+double x;
+{
+double s;
+int i;
+
+s = a[na];
+for( i=na-1; i>=0; i-- )
+ {
+ s = s * x + a[i];
+ }
+return(s);
+}
+
diff --git a/libm/double/polyr.c b/libm/double/polyr.c
new file mode 100644
index 000000000..81ca817e3
--- /dev/null
+++ b/libm/double/polyr.c
@@ -0,0 +1,533 @@
+
+/* Arithmetic operations on polynomials with rational coefficients
+ *
+ * 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 MAXPOL. 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
+ *
+ * polini( 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 polini().
+ *
+ * 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 .
+ *
+ *
+ *
+ * `a', `b', `c' are arrays of fracts.
+ * poleva( a, na, &x, &sum ); Evaluate polynomial a(t) at t = x.
+ * polprt( a, na, D ); Print the coefficients of a to D digits.
+ * polclr( a, na ); Set a identically equal to zero, up to a[na].
+ * polmov( a, na, b ); Set b = a.
+ * poladd( a, na, b, nb, c ); c = b + a, nc = max(na,nb)
+ * polsub( a, na, b, nb, c ); c = b - a, nc = max(na,nb)
+ * polmul( a, na, b, nb, c ); c = b * a, nc = na+nb
+ *
+ *
+ * Division:
+ *
+ * i = poldiv( 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
+ *
+ * polsbt( a, na, b, nb, c );
+ *
+ *
+ * Notes:
+ * poldiv() is an integer routine; poleva() is double.
+ * Any of the arguments a, b, c may refer to the same array.
+ *
+ */
+
+#include <stdio.h>
+#include <math.h>
+#ifndef NULL
+#define NULL 0
+#endif
+typedef struct{
+ double n;
+ double d;
+ }fract;
+
+#ifdef ANSIPROT
+extern void radd ( fract *, fract *, fract * );
+extern void rsub ( fract *, fract *, fract * );
+extern void rmul ( fract *, fract *, fract * );
+extern void rdiv ( fract *, fract *, fract * );
+void polmov ( fract *, int, fract * );
+void polmul ( fract *, int, fract *, int, fract * );
+int poldiv ( fract *, int, fract *, int, fract * );
+void * malloc ( long );
+void free ( void * );
+#else
+void radd(), rsub(), rmul(), rdiv();
+void polmov(), polmul();
+int poldiv();
+void * malloc();
+void free ();
+#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 fract *pt1 = 0;
+static fract *pt2 = 0;
+static fract *pt3 = 0;
+
+/* Maximum degree of polynomial. */
+int MAXPOL = 0;
+extern int MAXPOL;
+
+/* Number of bytes (chars) in maximum size polynomial. */
+static int psize = 0;
+
+
+/* Initialize max degree of polynomials
+ * and allocate temporary storage.
+ */
+void polini( maxdeg )
+int maxdeg;
+{
+
+MAXPOL = maxdeg;
+psize = (maxdeg + 1) * sizeof(fract);
+
+/* Release previously allocated memory, if any. */
+if( pt3 )
+ free(pt3);
+if( pt2 )
+ free(pt2);
+if( pt1 )
+ free(pt1);
+
+/* Allocate new arrays */
+pt1 = (fract * )malloc(psize); /* used by polsbt */
+pt2 = (fract * )malloc(psize); /* used by polsbt */
+pt3 = (fract * )malloc(psize); /* used by polmul */
+
+/* Report if failure */
+if( (pt1 == NULL) || (pt2 == NULL) || (pt3 == NULL) )
+ {
+ mtherr( "polini", ERANGE );
+ exit(1);
+ }
+}
+
+
+
+/* Print the coefficients of a, with d decimal precision.
+ */
+static char *form = "abcdefghijk";
+
+void polprt( a, na, d )
+fract a[];
+int na, d;
+{
+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;
+sprintf( p, "%d ", d1 );
+p += 1;
+if( d1 >= 10 )
+ p += 1;
+*p++ = '.';
+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].n );
+ j += d1;
+ if( j >= 78 )
+ {
+ printf( "\n" );
+ j = d1;
+ }
+ printf( form, a[i].d );
+ }
+printf( "\n" );
+}
+
+
+
+/* Set a = 0.
+ */
+void polclr( a, n )
+fract a[];
+int n;
+{
+int i;
+
+if( n > MAXPOL )
+ n = MAXPOL;
+for( i=0; i<=n; i++ )
+ {
+ a[i].n = 0.0;
+ a[i].d = 1.0;
+ }
+}
+
+
+
+/* Set b = a.
+ */
+void polmov( a, na, b )
+fract a[], b[];
+int na;
+{
+int i;
+
+if( na > MAXPOL )
+ na = MAXPOL;
+
+for( i=0; i<= na; i++ )
+ {
+ b[i].n = a[i].n;
+ b[i].d = a[i].d;
+ }
+}
+
+
+/* c = b * a.
+ */
+void polmul( a, na, b, nb, c )
+fract a[], b[], c[];
+int na, nb;
+{
+int i, j, k, nc;
+fract temp;
+fract *p;
+
+nc = na + nb;
+polclr( pt3, MAXPOL );
+
+p = &a[0];
+for( i=0; i<=na; i++ )
+ {
+ for( j=0; j<=nb; j++ )
+ {
+ k = i + j;
+ if( k > MAXPOL )
+ break;
+ rmul( p, &b[j], &temp ); /*pt3[k] += a[i] * b[j];*/
+ radd( &temp, &pt3[k], &pt3[k] );
+ }
+ ++p;
+ }
+
+if( nc > MAXPOL )
+ nc = MAXPOL;
+for( i=0; i<=nc; i++ )
+ {
+ c[i].n = pt3[i].n;
+ c[i].d = pt3[i].d;
+ }
+}
+
+
+
+
+/* c = b + a.
+ */
+void poladd( a, na, b, nb, c )
+fract a[], b[], c[];
+int na, nb;
+{
+int i, n;
+
+
+if( na > nb )
+ n = na;
+else
+ n = nb;
+
+if( n > MAXPOL )
+ n = MAXPOL;
+
+for( i=0; i<=n; i++ )
+ {
+ if( i > na )
+ {
+ c[i].n = b[i].n;
+ c[i].d = b[i].d;
+ }
+ else if( i > nb )
+ {
+ c[i].n = a[i].n;
+ c[i].d = a[i].d;
+ }
+ else
+ {
+ radd( &a[i], &b[i], &c[i] ); /*c[i] = b[i] + a[i];*/
+ }
+ }
+}
+
+/* c = b - a.
+ */
+void polsub( a, na, b, nb, c )
+fract a[], b[], c[];
+int na, nb;
+{
+int i, n;
+
+
+if( na > nb )
+ n = na;
+else
+ n = nb;
+
+if( n > MAXPOL )
+ n = MAXPOL;
+
+for( i=0; i<=n; i++ )
+ {
+ if( i > na )
+ {
+ c[i].n = b[i].n;
+ c[i].d = b[i].d;
+ }
+ else if( i > nb )
+ {
+ c[i].n = -a[i].n;
+ c[i].d = a[i].d;
+ }
+ else
+ {
+ rsub( &a[i], &b[i], &c[i] ); /*c[i] = b[i] - a[i];*/
+ }
+ }
+}
+
+
+
+/* c = b/a
+ */
+int poldiv( a, na, b, nb, c )
+fract a[], b[], c[];
+int na, nb;
+{
+fract *ta, *tb, *tq;
+fract quot;
+fract temp;
+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 = (fract * )malloc( psize );
+polclr( ta, MAXPOL );
+polmov( a, na, ta );
+
+tb = (fract * )malloc( psize );
+polclr( tb, MAXPOL );
+polmov( b, nb, tb );
+
+tq = (fract * )malloc( psize );
+polclr( tq, MAXPOL );
+
+/* What to do if leading (constant) coefficient
+ * of denominator is zero.
+ */
+if( a[0].n == 0.0 )
+ {
+ for( i=0; i<=na; i++ )
+ {
+ if( ta[i].n != 0.0 )
+ goto nzero;
+ }
+ mtherr( "poldiv", SING );
+ goto done;
+
+nzero:
+/* Reduce the degree of the denominator. */
+ for( i=0; i<na; i++ )
+ {
+ ta[i].n = ta[i+1].n;
+ ta[i].d = ta[i+1].d;
+ }
+ ta[na].n = 0.0;
+ ta[na].d = 1.0;
+
+ if( b[0].n != 0.0 )
+ {
+/* Optional message:
+ printf( "poldiv singularity, divide quotient by x\n" );
+*/
+ sing += 1;
+ }
+ else
+ {
+/* Reduce degree of numerator. */
+ for( i=0; i<nb; i++ )
+ {
+ tb[i].n = tb[i+1].n;
+ tb[i].d = tb[i+1].d;
+ }
+ tb[nb].n = 0.0;
+ tb[nb].d = 1.0;
+ }
+/* Call self, using reduced polynomials. */
+ sing += poldiv( ta, na, tb, nb, c );
+ goto done;
+ }
+
+/* Long division algorithm. ta[0] is nonzero.
+ */
+for( i=0; i<=MAXPOL; i++ )
+ {
+ rdiv( &ta[0], &tb[i], &quot ); /*quot = tb[i]/ta[0];*/
+ for( j=0; j<=MAXPOL; j++ )
+ {
+ k = j + i;
+ if( k > MAXPOL )
+ break;
+
+ rmul( &ta[j], &quot, &temp ); /*tb[k] -= quot * ta[j];*/
+ rsub( &temp, &tb[k], &tb[k] );
+ }
+ tq[i].n = quot.n;
+ tq[i].d = quot.d;
+ }
+/* Send quotient to output array. */
+polmov( tq, MAXPOL, 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)).
+ */
+
+void polsbt( a, na, b, nb, c )
+fract a[], b[], c[];
+int na, nb;
+{
+int i, j, k, n2;
+fract temp;
+fract *p;
+
+/* 0th degree term:
+ */
+polclr( pt1, MAXPOL );
+pt1[0].n = b[0].n;
+pt1[0].d = b[0].d;
+
+polclr( pt2, MAXPOL );
+pt2[0].n = 1.0;
+pt2[0].d = 1.0;
+n2 = 0;
+p = &b[1];
+
+for( i=1; i<=nb; i++ )
+ {
+/* Form ith power of a. */
+ polmul( a, na, pt2, n2, pt2 );
+ n2 += na;
+/* Add the ith coefficient of b times the ith power of a. */
+ for( j=0; j<=n2; j++ )
+ {
+ if( j > MAXPOL )
+ break;
+ rmul( &pt2[j], p, &temp ); /*pt1[j] += b[i] * pt2[j];*/
+ radd( &temp, &pt1[j], &pt1[j] );
+ }
+ ++p;
+ }
+
+k = n2 + nb;
+if( k > MAXPOL )
+ k = MAXPOL;
+for( i=0; i<=k; i++ )
+ {
+ c[i].n = pt1[i].n;
+ c[i].d = pt1[i].d;
+ }
+}
+
+
+
+
+/* Evaluate polynomial a(t) at t = x.
+ */
+void poleva( a, na, x, s )
+fract a[];
+int na;
+fract *x;
+fract *s;
+{
+int i;
+fract temp;
+
+s->n = a[na].n;
+s->d = a[na].d;
+for( i=na-1; i>=0; i-- )
+ {
+ rmul( s, x, &temp ); /*s = s * x + a[i];*/
+ radd( &a[i], &temp, s );
+ }
+}
+
diff --git a/libm/double/pow.c b/libm/double/pow.c
new file mode 100644
index 000000000..768ad1062
--- /dev/null
+++ b/libm/double/pow.c
@@ -0,0 +1,756 @@
+/* pow.c
+ *
+ * Power function
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, z, pow();
+ *
+ * z = pow( 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 -26,26 30000 4.2e-16 7.7e-17
+ * DEC -26,26 60000 4.8e-17 9.1e-18
+ * 1/26 < x < 26, with log(x) uniformly distributed.
+ * -26 < y < 26, y uniformly distributed.
+ * IEEE 0,8700 30000 1.5e-14 2.1e-15
+ * 0.99 < x < 1.01, 0 < y < 8700, uniformly distributed.
+ *
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * pow overflow x**y > MAXNUM INFINITY
+ * pow underflow x**y < 1/MAXNUM 0.0
+ * pow domain x<0 and y noninteger 0.0
+ *
+ */
+
+/*
+Cephes Math Library Release 2.8: June, 2000
+Copyright 1984, 1995, 2000 by Stephen L. Moshier
+*/
+
+
+#include <math.h>
+static char fname[] = {"pow"};
+
+#define SQRTH 0.70710678118654752440
+
+#ifdef UNK
+static double P[] = {
+ 4.97778295871696322025E-1,
+ 3.73336776063286838734E0,
+ 7.69994162726912503298E0,
+ 4.66651806774358464979E0
+};
+static double Q[] = {
+/* 1.00000000000000000000E0, */
+ 9.33340916416696166113E0,
+ 2.79999886606328401649E1,
+ 3.35994905342304405431E1,
+ 1.39995542032307539578E1
+};
+/* 2^(-i/16), IEEE precision */
+static double A[] = {
+ 1.00000000000000000000E0,
+ 9.57603280698573700036E-1,
+ 9.17004043204671215328E-1,
+ 8.78126080186649726755E-1,
+ 8.40896415253714502036E-1,
+ 8.05245165974627141736E-1,
+ 7.71105412703970372057E-1,
+ 7.38413072969749673113E-1,
+ 7.07106781186547572737E-1,
+ 6.77127773468446325644E-1,
+ 6.48419777325504820276E-1,
+ 6.20928906036742001007E-1,
+ 5.94603557501360513449E-1,
+ 5.69394317378345782288E-1,
+ 5.45253866332628844837E-1,
+ 5.22136891213706877402E-1,
+ 5.00000000000000000000E-1
+};
+static double B[] = {
+ 0.00000000000000000000E0,
+ 1.64155361212281360176E-17,
+ 4.09950501029074826006E-17,
+ 3.97491740484881042808E-17,
+-4.83364665672645672553E-17,
+ 1.26912513974441574796E-17,
+ 1.99100761573282305549E-17,
+-1.52339103990623557348E-17,
+ 0.00000000000000000000E0
+};
+static double R[] = {
+ 1.49664108433729301083E-5,
+ 1.54010762792771901396E-4,
+ 1.33335476964097721140E-3,
+ 9.61812908476554225149E-3,
+ 5.55041086645832347466E-2,
+ 2.40226506959099779976E-1,
+ 6.93147180559945308821E-1
+};
+
+#define douba(k) A[k]
+#define doubb(k) B[k]
+#define MEXP 16383.0
+#ifdef DENORMAL
+#define MNEXP -17183.0
+#else
+#define MNEXP -16383.0
+#endif
+#endif
+
+#ifdef DEC
+static unsigned short P[] = {
+0037776,0156313,0175332,0163602,
+0040556,0167577,0052366,0174245,
+0040766,0062753,0175707,0055564,
+0040625,0052035,0131344,0155636,
+};
+static unsigned short Q[] = {
+/*0040200,0000000,0000000,0000000,*/
+0041025,0052644,0154404,0105155,
+0041337,0177772,0007016,0047646,
+0041406,0062740,0154273,0020020,
+0041137,0177054,0106127,0044555,
+};
+static unsigned short A[] = {
+0040200,0000000,0000000,0000000,
+0040165,0022575,0012444,0103314,
+0040152,0140306,0163735,0022071,
+0040140,0146336,0166052,0112341,
+0040127,0042374,0145326,0116553,
+0040116,0022214,0012437,0102201,
+0040105,0063452,0010525,0003333,
+0040075,0004243,0117530,0006067,
+0040065,0002363,0031771,0157145,
+0040055,0054076,0165102,0120513,
+0040045,0177326,0124661,0050471,
+0040036,0172462,0060221,0120422,
+0040030,0033760,0050615,0134251,
+0040021,0141723,0071653,0010703,
+0040013,0112701,0161752,0105727,
+0040005,0125303,0063714,0044173,
+0040000,0000000,0000000,0000000
+};
+static unsigned short B[] = {
+0000000,0000000,0000000,0000000,
+0021473,0040265,0153315,0140671,
+0121074,0062627,0042146,0176454,
+0121413,0003524,0136332,0066212,
+0121767,0046404,0166231,0012553,
+0121257,0015024,0002357,0043574,
+0021736,0106532,0043060,0056206,
+0121310,0020334,0165705,0035326,
+0000000,0000000,0000000,0000000
+};
+
+static unsigned short R[] = {
+0034173,0014076,0137624,0115771,
+0035041,0076763,0003744,0111311,
+0035656,0141766,0041127,0074351,
+0036435,0112533,0073611,0116664,
+0037143,0054106,0134040,0152223,
+0037565,0176757,0176026,0025551,
+0040061,0071027,0173721,0147572
+};
+
+/*
+static double R[] = {
+0.14928852680595608186e-4,
+0.15400290440989764601e-3,
+0.13333541313585784703e-2,
+0.96181290595172416964e-2,
+0.55504108664085595326e-1,
+0.24022650695909537056e0,
+0.69314718055994529629e0
+};
+*/
+#define douba(k) (*(double *)&A[(k)<<2])
+#define doubb(k) (*(double *)&B[(k)<<2])
+#define MEXP 2031.0
+#define MNEXP -2031.0
+#endif
+
+#ifdef IBMPC
+static unsigned short P[] = {
+0x5cf0,0x7f5b,0xdb99,0x3fdf,
+0xdf15,0xea9e,0xddef,0x400d,
+0xeb6f,0x7f78,0xccbd,0x401e,
+0x9b74,0xb65c,0xaa83,0x4012,
+};
+static unsigned short Q[] = {
+/*0x0000,0x0000,0x0000,0x3ff0,*/
+0x914e,0x9b20,0xaab4,0x4022,
+0xc9f5,0x41c1,0xffff,0x403b,
+0x6402,0x1b17,0xccbc,0x4040,
+0xe92e,0x918a,0xffc5,0x402b,
+};
+static unsigned short A[] = {
+0x0000,0x0000,0x0000,0x3ff0,
+0x90da,0xa2a4,0xa4af,0x3fee,
+0xa487,0xdcfb,0x5818,0x3fed,
+0x529c,0xdd85,0x199b,0x3fec,
+0xd3ad,0x995a,0xe89f,0x3fea,
+0xf090,0x82a3,0xc491,0x3fe9,
+0xa0db,0x422a,0xace5,0x3fe8,
+0x0187,0x73eb,0xa114,0x3fe7,
+0x3bcd,0x667f,0xa09e,0x3fe6,
+0x5429,0xdd48,0xab07,0x3fe5,
+0x2a27,0xd536,0xbfda,0x3fe4,
+0x3422,0x4c12,0xdea6,0x3fe3,
+0xb715,0x0a31,0x06fe,0x3fe3,
+0x6238,0x6e75,0x387a,0x3fe2,
+0x517b,0x3c7d,0x72b8,0x3fe1,
+0x890f,0x6cf9,0xb558,0x3fe0,
+0x0000,0x0000,0x0000,0x3fe0
+};
+static unsigned short B[] = {
+0x0000,0x0000,0x0000,0x0000,
+0x3707,0xd75b,0xed02,0x3c72,
+0xcc81,0x345d,0xa1cd,0x3c87,
+0x4b27,0x5686,0xe9f1,0x3c86,
+0x6456,0x13b2,0xdd34,0xbc8b,
+0x42e2,0xafec,0x4397,0x3c6d,
+0x82e4,0xd231,0xf46a,0x3c76,
+0x8a76,0xb9d7,0x9041,0xbc71,
+0x0000,0x0000,0x0000,0x0000
+};
+static unsigned short R[] = {
+0x937f,0xd7f2,0x6307,0x3eef,
+0x9259,0x60fc,0x2fbe,0x3f24,
+0xef1d,0xc84a,0xd87e,0x3f55,
+0x33b7,0x6ef1,0xb2ab,0x3f83,
+0x1a92,0xd704,0x6b08,0x3fac,
+0xc56d,0xff82,0xbfbd,0x3fce,
+0x39ef,0xfefa,0x2e42,0x3fe6
+};
+
+#define douba(k) (*(double *)&A[(k)<<2])
+#define doubb(k) (*(double *)&B[(k)<<2])
+#define MEXP 16383.0
+#ifdef DENORMAL
+#define MNEXP -17183.0
+#else
+#define MNEXP -16383.0
+#endif
+#endif
+
+#ifdef MIEEE
+static unsigned short P[] = {
+0x3fdf,0xdb99,0x7f5b,0x5cf0,
+0x400d,0xddef,0xea9e,0xdf15,
+0x401e,0xccbd,0x7f78,0xeb6f,
+0x4012,0xaa83,0xb65c,0x9b74
+};
+static unsigned short Q[] = {
+0x4022,0xaab4,0x9b20,0x914e,
+0x403b,0xffff,0x41c1,0xc9f5,
+0x4040,0xccbc,0x1b17,0x6402,
+0x402b,0xffc5,0x918a,0xe92e
+};
+static unsigned short A[] = {
+0x3ff0,0x0000,0x0000,0x0000,
+0x3fee,0xa4af,0xa2a4,0x90da,
+0x3fed,0x5818,0xdcfb,0xa487,
+0x3fec,0x199b,0xdd85,0x529c,
+0x3fea,0xe89f,0x995a,0xd3ad,
+0x3fe9,0xc491,0x82a3,0xf090,
+0x3fe8,0xace5,0x422a,0xa0db,
+0x3fe7,0xa114,0x73eb,0x0187,
+0x3fe6,0xa09e,0x667f,0x3bcd,
+0x3fe5,0xab07,0xdd48,0x5429,
+0x3fe4,0xbfda,0xd536,0x2a27,
+0x3fe3,0xdea6,0x4c12,0x3422,
+0x3fe3,0x06fe,0x0a31,0xb715,
+0x3fe2,0x387a,0x6e75,0x6238,
+0x3fe1,0x72b8,0x3c7d,0x517b,
+0x3fe0,0xb558,0x6cf9,0x890f,
+0x3fe0,0x0000,0x0000,0x0000
+};
+static unsigned short B[] = {
+0x0000,0x0000,0x0000,0x0000,
+0x3c72,0xed02,0xd75b,0x3707,
+0x3c87,0xa1cd,0x345d,0xcc81,
+0x3c86,0xe9f1,0x5686,0x4b27,
+0xbc8b,0xdd34,0x13b2,0x6456,
+0x3c6d,0x4397,0xafec,0x42e2,
+0x3c76,0xf46a,0xd231,0x82e4,
+0xbc71,0x9041,0xb9d7,0x8a76,
+0x0000,0x0000,0x0000,0x0000
+};
+static unsigned short R[] = {
+0x3eef,0x6307,0xd7f2,0x937f,
+0x3f24,0x2fbe,0x60fc,0x9259,
+0x3f55,0xd87e,0xc84a,0xef1d,
+0x3f83,0xb2ab,0x6ef1,0x33b7,
+0x3fac,0x6b08,0xd704,0x1a92,
+0x3fce,0xbfbd,0xff82,0xc56d,
+0x3fe6,0x2e42,0xfefa,0x39ef
+};
+
+#define douba(k) (*(double *)&A[(k)<<2])
+#define doubb(k) (*(double *)&B[(k)<<2])
+#define MEXP 16383.0
+#ifdef DENORMAL
+#define MNEXP -17183.0
+#else
+#define MNEXP -16383.0
+#endif
+#endif
+
+/* log2(e) - 1 */
+#define LOG2EA 0.44269504088896340736
+
+#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 ANSIPROT
+extern double floor ( double );
+extern double fabs ( double );
+extern double frexp ( double, int * );
+extern double ldexp ( double, int );
+extern double polevl ( double, void *, int );
+extern double p1evl ( double, void *, int );
+extern double powi ( double, int );
+extern int signbit ( double );
+extern int isnan ( double );
+extern int isfinite ( double );
+static double reduc ( double );
+#else
+double floor(), fabs(), frexp(), ldexp();
+double polevl(), p1evl(), powi();
+int signbit(), isnan(), isfinite();
+static double reduc();
+#endif
+extern double MAXNUM;
+#ifdef INFINITIES
+extern double INFINITY;
+#endif
+#ifdef NANS
+extern double NAN;
+#endif
+#ifdef MINUSZERO
+extern double NEGZERO;
+#endif
+
+double pow( x, y )
+double x, y;
+{
+double w, z, W, Wa, Wb, ya, yb, u;
+/* double F, Fa, Fb, G, Ga, Gb, H, Ha, Hb */
+double aw, ay, wy;
+int e, i, nflg, iyflg, yoddint;
+
+if( y == 0.0 )
+ return( 1.0 );
+#ifdef NANS
+if( isnan(x) )
+ return( x );
+if( isnan(y) )
+ return( y );
+#endif
+if( y == 1.0 )
+ return( x );
+
+
+#ifdef INFINITIES
+if( !isfinite(y) && (x == 1.0 || x == -1.0) )
+ {
+ mtherr( "pow", DOMAIN );
+#ifdef NANS
+ return( NAN );
+#else
+ return( INFINITY );
+#endif
+ }
+#endif
+
+if( x == 1.0 )
+ return( 1.0 );
+
+if( y >= MAXNUM )
+ {
+#ifdef INFINITIES
+ if( x > 1.0 )
+ return( INFINITY );
+#else
+ if( x > 1.0 )
+ return( MAXNUM );
+#endif
+ if( x > 0.0 && x < 1.0 )
+ return( 0.0);
+ if( x < -1.0 )
+ {
+#ifdef INFINITIES
+ return( INFINITY );
+#else
+ return( MAXNUM );
+#endif
+ }
+ if( x > -1.0 && x < 0.0 )
+ return( 0.0 );
+ }
+if( y <= -MAXNUM )
+ {
+ if( x > 1.0 )
+ return( 0.0 );
+#ifdef INFINITIES
+ if( x > 0.0 && x < 1.0 )
+ return( INFINITY );
+#else
+ if( x > 0.0 && x < 1.0 )
+ return( MAXNUM );
+#endif
+ if( x < -1.0 )
+ return( 0.0 );
+#ifdef INFINITIES
+ if( x > -1.0 && x < 0.0 )
+ return( INFINITY );
+#else
+ if( x > -1.0 && x < 0.0 )
+ return( MAXNUM );
+#endif
+ }
+if( x >= MAXNUM )
+ {
+#if INFINITIES
+ if( y > 0.0 )
+ return( INFINITY );
+#else
+ if( y > 0.0 )
+ return( MAXNUM );
+#endif
+ return(0.0);
+ }
+/* Set iyflg to 1 if y is an integer. */
+iyflg = 0;
+w = floor(y);
+if( w == y )
+ iyflg = 1;
+
+/* Test for odd integer y. */
+yoddint = 0;
+if( iyflg )
+ {
+ ya = fabs(y);
+ ya = floor(0.5 * ya);
+ yb = 0.5 * fabs(w);
+ if( ya != yb )
+ yoddint = 1;
+ }
+
+if( x <= -MAXNUM )
+ {
+ if( y > 0.0 )
+ {
+#ifdef INFINITIES
+ if( yoddint )
+ return( -INFINITY );
+ return( INFINITY );
+#else
+ if( yoddint )
+ return( -MAXNUM );
+ return( MAXNUM );
+#endif
+ }
+ if( y < 0.0 )
+ {
+#ifdef MINUSZERO
+ if( yoddint )
+ return( NEGZERO );
+#endif
+ return( 0.0 );
+ }
+ }
+
+nflg = 0; /* flag = 1 if x<0 raised to integer power */
+if( x <= 0.0 )
+ {
+ if( x == 0.0 )
+ {
+ if( y < 0.0 )
+ {
+#ifdef MINUSZERO
+ if( signbit(x) && yoddint )
+ return( -INFINITY );
+#endif
+#ifdef INFINITIES
+ return( INFINITY );
+#else
+ return( MAXNUM );
+#endif
+ }
+ if( y > 0.0 )
+ {
+#ifdef MINUSZERO
+ if( signbit(x) && yoddint )
+ return( NEGZERO );
+#endif
+ return( 0.0 );
+ }
+ return( 1.0 );
+ }
+ else
+ {
+ if( iyflg == 0 )
+ { /* noninteger power of negative number */
+ mtherr( fname, DOMAIN );
+#ifdef NANS
+ return(NAN);
+#else
+ return(0.0L);
+#endif
+ }
+ nflg = 1;
+ }
+ }
+
+/* Integer power of an integer. */
+
+if( iyflg )
+ {
+ i = w;
+ w = floor(x);
+ if( (w == x) && (fabs(y) < 32768.0) )
+ {
+ w = powi( x, (int) y );
+ return( w );
+ }
+ }
+
+if( nflg )
+ x = fabs(x);
+
+/* For results close to 1, use a series expansion. */
+w = x - 1.0;
+aw = fabs(w);
+ay = fabs(y);
+wy = w * y;
+ya = fabs(wy);
+if((aw <= 1.0e-3 && ay <= 1.0)
+ || (ya <= 1.0e-3 && ay >= 1.0))
+ {
+ z = (((((w*(y-5.)/720. + 1./120.)*w*(y-4.) + 1./24.)*w*(y-3.)
+ + 1./6.)*w*(y-2.) + 0.5)*w*(y-1.) )*wy + wy + 1.;
+ goto done;
+ }
+/* These are probably too much trouble. */
+#if 0
+w = y * log(x);
+if (aw > 1.0e-3 && fabs(w) < 1.0e-3)
+ {
+ z = ((((((
+ w/7. + 1.)*w/6. + 1.)*w/5. + 1.)*w/4. + 1.)*w/3. + 1.)*w/2. + 1.)*w + 1.;
+ goto done;
+ }
+
+if(ya <= 1.0e-3 && aw <= 1.0e-4)
+ {
+ z = (((((
+ wy*1./720.
+ + (-w*1./48. + 1./120.) )*wy
+ + ((w*17./144. - 1./12.)*w + 1./24.) )*wy
+ + (((-w*5./16. + 7./24.)*w - 1./4.)*w + 1./6.) )*wy
+ + ((((w*137./360. - 5./12.)*w + 11./24.)*w - 1./2.)*w + 1./2.) )*wy
+ + (((((-w*1./6. + 1./5.)*w - 1./4)*w + 1./3.)*w -1./2.)*w ) )*wy
+ + wy + 1.0;
+ goto done;
+ }
+#endif
+
+/* separate significand from exponent */
+x = frexp( x, &e );
+
+#if 0
+/* For debugging, check for gross overflow. */
+if( (e * y) > (MEXP + 1024) )
+ goto overflow;
+#endif
+
+/* Find significand of x in antilog table A[]. */
+i = 1;
+if( x <= douba(9) )
+ i = 9;
+if( x <= douba(i+4) )
+ i += 4;
+if( x <= douba(i+2) )
+ i += 2;
+if( x >= douba(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 -= douba(i);
+x -= doubb(i/2);
+x /= douba(i);
+
+
+/* rational approximation for log(1+v):
+ *
+ * log(1+v) = v - v**2/2 + v**3 P(v) / Q(v)
+ */
+z = x*x;
+w = x * ( z * polevl( x, P, 3 ) / p1evl( x, Q, 4 ) );
+w = w - ldexp( z, -1 ); /* 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 = ldexp( w, -4 ); /* 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 = ldexp( Ga+Ha, 4 );
+
+/* Test the power of 2 for overflow */
+if( w > MEXP )
+ {
+#ifndef INFINITIES
+ mtherr( fname, OVERFLOW );
+#endif
+#ifdef INFINITIES
+ if( nflg && yoddint )
+ return( -INFINITY );
+ return( INFINITY );
+#else
+ if( nflg && yoddint )
+ return( -MAXNUM );
+ return( MAXNUM );
+#endif
+ }
+
+if( w < (MNEXP - 1) )
+ {
+#ifndef DENORMAL
+ mtherr( fname, UNDERFLOW );
+#endif
+#ifdef MINUSZERO
+ if( nflg && yoddint )
+ return( NEGZERO );
+#endif
+ 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.
+ */
+z = Hb * polevl( Hb, R, 6 ); /* z = 2**Hb - 1 */
+
+/* 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 = 0;
+else
+ i = 1;
+i = e/16 + i;
+e = 16*i - e;
+w = douba( e );
+z = w + w * z; /* 2**-e * ( 1 + (2**Hb-1) ) */
+z = ldexp( z, i ); /* multiply by integer power of 2 */
+
+done:
+
+/* Negate if odd integer power of negative number */
+if( nflg && yoddint )
+ {
+#ifdef MINUSZERO
+ if( z == 0.0 )
+ z = NEGZERO;
+ else
+#endif
+ z = -z;
+ }
+return( z );
+}
+
+
+/* Find a multiple of 1/16 that is within 1/16 of x. */
+static double reduc(x)
+double x;
+{
+double t;
+
+t = ldexp( x, 4 );
+t = floor( t );
+t = ldexp( t, -4 );
+return(t);
+}
diff --git a/libm/double/powi.c b/libm/double/powi.c
new file mode 100644
index 000000000..46d9a1400
--- /dev/null
+++ b/libm/double/powi.c
@@ -0,0 +1,186 @@
+/* powi.c
+ *
+ * Real raised to integer power
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, powi();
+ * int n;
+ *
+ * y = powi( 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
+ * DEC .04,26 -26,26 100000 2.7e-16 4.3e-17
+ * IEEE .04,26 -26,26 50000 2.0e-15 3.8e-16
+ * IEEE 1,2 -1022,1023 50000 8.6e-14 1.6e-14
+ *
+ * Returns MAXNUM on overflow, zero on underflow.
+ *
+ */
+
+/* powi.c */
+
+/*
+Cephes Math Library Release 2.8: June, 2000
+Copyright 1984, 1995, 2000 by Stephen L. Moshier
+*/
+
+#include <math.h>
+#ifdef ANSIPROT
+extern double log ( double );
+extern double frexp ( double, int * );
+extern int signbit ( double );
+#else
+double log(), frexp();
+int signbit();
+#endif
+extern double NEGZERO, INFINITY, MAXNUM, MAXLOG, MINLOG, LOGE2;
+
+double powi( x, nn )
+double x;
+int nn;
+{
+int n, e, sign, asign, lx;
+double w, y, s;
+
+/* See pow.c for these tests. */
+if( x == 0.0 )
+ {
+ if( nn == 0 )
+ return( 1.0 );
+ else if( nn < 0 )
+ return( INFINITY );
+ else
+ {
+ if( nn & 1 )
+ return( x );
+ else
+ return( 0.0 );
+ }
+ }
+
+if( nn == 0 )
+ return( 1.0 );
+
+if( nn == -1 )
+ return( 1.0/x );
+
+if( x < 0.0 )
+ {
+ asign = -1;
+ x = -x;
+ }
+else
+ asign = 0;
+
+
+if( nn < 0 )
+ {
+ sign = -1;
+ n = -nn;
+ }
+else
+ {
+ sign = 1;
+ n = nn;
+ }
+
+/* Even power will be positive. */
+if( (n & 1) == 0 )
+ asign = 0;
+
+/* Overflow detection */
+
+/* Calculate approximate logarithm of answer */
+s = frexp( 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 * LOGE2;
+ }
+else
+ {
+ s = LOGE2 * e;
+ }
+
+if( s > MAXLOG )
+ {
+ mtherr( "powi", OVERFLOW );
+ y = INFINITY;
+ goto done;
+ }
+
+#if DENORMAL
+if( s < MINLOG )
+ {
+ y = 0.0;
+ goto done;
+ }
+
+/* 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 < (-MAXLOG+2.0)) && (sign < 0) )
+ {
+ x = 1.0/x;
+ sign = -sign;
+ }
+#else
+/* do not produce denormal answer */
+if( s < -MAXLOG )
+ return(0.0);
+#endif
+
+
+/* First bit of the power */
+if( n & 1 )
+ y = x;
+
+else
+ y = 1.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;
+ }
+
+if( sign < 0 )
+ y = 1.0/y;
+
+done:
+
+if( asign )
+ {
+ /* odd power of negative number */
+ if( y == 0.0 )
+ y = NEGZERO;
+ else
+ y = -y;
+ }
+return(y);
+}
diff --git a/libm/double/psi.c b/libm/double/psi.c
new file mode 100644
index 000000000..6da2aa0c2
--- /dev/null
+++ b/libm/double/psi.c
@@ -0,0 +1,201 @@
+/* psi.c
+ *
+ * Psi (digamma) function
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, psi();
+ *
+ * y = psi( 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:
+ * Relative error (except absolute when |psi| < 1):
+ * arithmetic domain # trials peak rms
+ * DEC 0,30 2500 1.7e-16 2.0e-17
+ * IEEE 0,30 30000 1.3e-15 1.4e-16
+ * IEEE -30,0 40000 1.5e-15 2.2e-16
+ *
+ * ERROR MESSAGES:
+ * message condition value returned
+ * psi singularity x integer <=0 MAXNUM
+ */
+
+/*
+Cephes Math Library Release 2.8: June, 2000
+Copyright 1984, 1987, 1992, 2000 by Stephen L. Moshier
+*/
+
+#include <math.h>
+
+#ifdef UNK
+static double A[] = {
+ 8.33333333333333333333E-2,
+-2.10927960927960927961E-2,
+ 7.57575757575757575758E-3,
+-4.16666666666666666667E-3,
+ 3.96825396825396825397E-3,
+-8.33333333333333333333E-3,
+ 8.33333333333333333333E-2
+};
+#endif
+
+#ifdef DEC
+static unsigned short A[] = {
+0037252,0125252,0125252,0125253,
+0136654,0145314,0126312,0146255,
+0036370,0037017,0101740,0174076,
+0136210,0104210,0104210,0104211,
+0036202,0004040,0101010,0020202,
+0136410,0104210,0104210,0104211,
+0037252,0125252,0125252,0125253
+};
+#endif
+
+#ifdef IBMPC
+static unsigned short A[] = {
+0x5555,0x5555,0x5555,0x3fb5,
+0x5996,0x9599,0x9959,0xbf95,
+0x1f08,0xf07c,0x07c1,0x3f7f,
+0x1111,0x1111,0x1111,0xbf71,
+0x0410,0x1041,0x4104,0x3f70,
+0x1111,0x1111,0x1111,0xbf81,
+0x5555,0x5555,0x5555,0x3fb5
+};
+#endif
+
+#ifdef MIEEE
+static unsigned short A[] = {
+0x3fb5,0x5555,0x5555,0x5555,
+0xbf95,0x9959,0x9599,0x5996,
+0x3f7f,0x07c1,0xf07c,0x1f08,
+0xbf71,0x1111,0x1111,0x1111,
+0x3f70,0x4104,0x1041,0x0410,
+0xbf81,0x1111,0x1111,0x1111,
+0x3fb5,0x5555,0x5555,0x5555
+};
+#endif
+
+#define EUL 0.57721566490153286061
+
+#ifdef ANSIPROT
+extern double floor ( double );
+extern double log ( double );
+extern double tan ( double );
+extern double polevl ( double, void *, int );
+#else
+double floor(), log(), tan(), polevl();
+#endif
+extern double PI, MAXNUM;
+
+
+double psi(x)
+double x;
+{
+double p, q, nz, s, w, y, z;
+int i, n, negative;
+
+negative = 0;
+nz = 0.0;
+
+if( x <= 0.0 )
+ {
+ negative = 1;
+ q = x;
+ p = floor(q);
+ if( p == q )
+ {
+ mtherr( "psi", SING );
+ return( MAXNUM );
+ }
+/* Remove the zeros of tan(PI x)
+ * by subtracting the nearest integer from x
+ */
+ nz = q - p;
+ if( nz != 0.5 )
+ {
+ if( nz > 0.5 )
+ {
+ p += 1.0;
+ nz = q - p;
+ }
+ nz = PI/tan(PI*nz);
+ }
+ else
+ {
+ nz = 0.0;
+ }
+ x = 1.0 - x;
+ }
+
+/* check for positive integer up to 10 */
+if( (x <= 10.0) && (x == floor(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.0e17 )
+ {
+ z = 1.0/(s * s);
+ y = z * polevl( z, A, 6 );
+ }
+else
+ y = 0.0;
+
+y = log(s) - (0.5/s) - y - w;
+
+done:
+
+if( negative )
+ {
+ y -= nz;
+ }
+
+return(y);
+}
diff --git a/libm/double/revers.c b/libm/double/revers.c
new file mode 100644
index 000000000..370bdb5d6
--- /dev/null
+++ b/libm/double/revers.c
@@ -0,0 +1,156 @@
+/* revers.c
+ *
+ * Reversion of power series
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * extern int MAXPOL;
+ * int n;
+ * double x[n+1], y[n+1];
+ *
+ * polini(n);
+ * revers( y, x, n );
+ *
+ * Note, polini() initializes the polynomial arithmetic subroutines;
+ * see polyn.c.
+ *
+ *
+ * DESCRIPTION:
+ *
+ * If
+ *
+ * inf
+ * - i
+ * y(x) = > a x
+ * - i
+ * i=1
+ *
+ * then
+ *
+ * inf
+ * - j
+ * x(y) = > A y ,
+ * - j
+ * j=1
+ *
+ * where
+ * 1
+ * A = ---
+ * 1 a
+ * 1
+ *
+ * etc. The coefficients of x(y) are found by expanding
+ *
+ * inf inf
+ * - - i
+ * x(y) = > A > a x
+ * - j - i
+ * j=1 i=1
+ *
+ * and setting each coefficient of x , higher than the first,
+ * to zero.
+ *
+ *
+ *
+ * RESTRICTIONS:
+ *
+ * y[0] must be zero, and y[1] must be nonzero.
+ *
+ */
+
+/*
+Cephes Math Library Release 2.8: June, 2000
+Copyright 1984, 1987, 1989, 1992, 2000 by Stephen L. Moshier
+*/
+
+#include <math.h>
+
+extern int MAXPOL; /* initialized by polini() */
+
+#ifdef ANSIPROT
+/* See polyn.c. */
+void polmov ( double *, int, double * );
+void polclr ( double *, int );
+void poladd ( double *, int, double *, int, double * );
+void polmul ( double *, int, double *, int, double * );
+void * malloc ( long );
+void free ( void * );
+#else
+void polmov(), polclr(), poladd(), polmul();
+void * malloc();
+void free ();
+#endif
+
+void revers( y, x, n)
+double y[], x[];
+int n;
+{
+double *yn, *yp, *ysum;
+int j;
+
+if( y[1] == 0.0 )
+ mtherr( "revers", DOMAIN );
+/* printf( "revers: y[1] = 0\n" );*/
+j = (MAXPOL + 1) * sizeof(double);
+yn = (double *)malloc(j);
+yp = (double *)malloc(j);
+ysum = (double *)malloc(j);
+
+polmov( y, n, yn );
+polclr( ysum, n );
+x[0] = 0.0;
+x[1] = 1.0/y[1];
+for( j=2; j<=n; j++ )
+ {
+/* A_(j-1) times the expansion of y^(j-1) */
+ polmul( &x[j-1], 0, yn, n, yp );
+/* The expansion of the sum of A_k y^k up to k=j-1 */
+ poladd( yp, n, ysum, n, ysum );
+/* The expansion of y^j */
+ polmul( yn, n, y, n, yn );
+/* The coefficient A_j to make the sum up to k=j equal to zero */
+ x[j] = -ysum[j]/yn[j];
+ }
+free(yn);
+free(yp);
+free(ysum);
+}
+
+
+#if 0
+/* Demonstration program
+ */
+#define N 10
+double y[N], x[N];
+double fac();
+
+main()
+{
+double a, odd;
+int i;
+
+polini( N-1 );
+a = 1.0;
+y[0] = 0.0;
+odd = 1.0;
+for( i=1; i<N; i++ )
+ {
+/* sin(x) */
+/*
+ if( i & 1 )
+ {
+ y[i] = odd/fac(i);
+ odd = -odd;
+ }
+ else
+ y[i] = 0.0;
+*/
+ y[i] = 1.0/fac(i);
+ }
+revers( y, x, N-1 );
+for( i=0; i<N; i++ )
+ printf( "%2d %.10e %.10e\n", i, x[i], y[i] );
+}
+#endif
diff --git a/libm/double/rgamma.c b/libm/double/rgamma.c
new file mode 100644
index 000000000..1d6ff3840
--- /dev/null
+++ b/libm/double/rgamma.c
@@ -0,0 +1,209 @@
+/* rgamma.c
+ *
+ * Reciprocal gamma function
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, rgamma();
+ *
+ * y = rgamma( 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/MAXNUM is returned for positive arguments outside this
+ * range. For arguments less than -34.034 the cosecant
+ * reflection formula is applied; lograrithms are employed
+ * to avoid unnecessary overflow.
+ *
+ * The reciprocal gamma function has no singularities,
+ * but overflow and underflow may occur for large arguments.
+ * These conditions return either MAXNUM or 1/MAXNUM with
+ * appropriate sign.
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * DEC -30,+30 4000 1.2e-16 1.8e-17
+ * IEEE -30,+30 30000 1.1e-15 2.0e-16
+ * For arguments less than -34.034 the peak error is on the
+ * order of 5e-15 (DEC), excepting overflow or underflow.
+ */
+
+/*
+Cephes Math Library Release 2.8: June, 2000
+Copyright 1985, 1987, 2000 by Stephen L. Moshier
+*/
+
+#include <math.h>
+
+/* Chebyshev coefficients for reciprocal gamma function
+ * in interval 0 to 1. Function is 1/(x gamma(x)) - 1
+ */
+
+#ifdef UNK
+static double R[] = {
+ 3.13173458231230000000E-17,
+-6.70718606477908000000E-16,
+ 2.20039078172259550000E-15,
+ 2.47691630348254132600E-13,
+-6.60074100411295197440E-12,
+ 5.13850186324226978840E-11,
+ 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
+};
+#endif
+
+#ifdef DEC
+static unsigned short R[] = {
+0022420,0066376,0176751,0071636,
+0123501,0051114,0042104,0131153,
+0024036,0107013,0126504,0033361,
+0025613,0070040,0035174,0162316,
+0126750,0037060,0077775,0122202,
+0027541,0177143,0037675,0105150,
+0030625,0141311,0075005,0115436,
+0132017,0067714,0125033,0014721,
+0032620,0063707,0105256,0152643,
+0033506,0122235,0072757,0170053,
+0134650,0144041,0015617,0016143,
+0035332,0066125,0000776,0006215,
+0036245,0177377,0137173,0131432,
+0137203,0073541,0055645,0141150,
+0136243,0057043,0026226,0017362,
+0037402,0115554,0033441,0012310
+};
+#endif
+
+#ifdef IBMPC
+static unsigned short R[] = {
+0x2e74,0xdfbd,0x0d9f,0x3c82,
+0x964d,0x8888,0x2a49,0xbcc8,
+0x86de,0x75a8,0xd1c1,0x3ce3,
+0x9c9a,0x074f,0x6e04,0x3d51,
+0xb490,0x0fff,0x07c6,0xbd9d,
+0xb14d,0x67f7,0x3fcc,0x3dcc,
+0xb364,0x2f40,0xb859,0x3e12,
+0x633a,0x9543,0xedf9,0xbe61,
+0xdab4,0xf155,0x0cf8,0x3e92,
+0xfe05,0xaebd,0xd493,0x3ec8,
+0xe38c,0x2371,0x1904,0xbf15,
+0xc192,0xa03f,0x4d8a,0x3f3b,
+0x7663,0xf7cf,0xbfdf,0x3f74,
+0xb84d,0x2b74,0x6eec,0xbfb0,
+0xc3de,0x6592,0x6bc4,0xbf74,
+0x2299,0x86e4,0x536d,0x3fc0
+};
+#endif
+
+#ifdef MIEEE
+static unsigned short R[] = {
+0x3c82,0x0d9f,0xdfbd,0x2e74,
+0xbcc8,0x2a49,0x8888,0x964d,
+0x3ce3,0xd1c1,0x75a8,0x86de,
+0x3d51,0x6e04,0x074f,0x9c9a,
+0xbd9d,0x07c6,0x0fff,0xb490,
+0x3dcc,0x3fcc,0x67f7,0xb14d,
+0x3e12,0xb859,0x2f40,0xb364,
+0xbe61,0xedf9,0x9543,0x633a,
+0x3e92,0x0cf8,0xf155,0xdab4,
+0x3ec8,0xd493,0xaebd,0xfe05,
+0xbf15,0x1904,0x2371,0xe38c,
+0x3f3b,0x4d8a,0xa03f,0xc192,
+0x3f74,0xbfdf,0xf7cf,0x7663,
+0xbfb0,0x6eec,0x2b74,0xb84d,
+0xbf74,0x6bc4,0x6592,0xc3de,
+0x3fc0,0x536d,0x86e4,0x2299
+};
+#endif
+
+static char name[] = "rgamma";
+
+#ifdef ANSIPROT
+extern double chbevl ( double, void *, int );
+extern double exp ( double );
+extern double log ( double );
+extern double sin ( double );
+extern double lgam ( double );
+#else
+double chbevl(), exp(), log(), sin(), lgam();
+#endif
+extern double PI, MAXLOG, MAXNUM;
+
+
+double rgamma(x)
+double x;
+{
+double w, y, z;
+int sign;
+
+if( x > 34.84425627277176174)
+ {
+ mtherr( name, UNDERFLOW );
+ return(1.0/MAXNUM);
+ }
+if( x < -34.034 )
+ {
+ w = -x;
+ z = sin( PI*w );
+ if( z == 0.0 )
+ return(0.0);
+ if( z < 0.0 )
+ {
+ sign = 1;
+ z = -z;
+ }
+ else
+ sign = -1;
+
+ y = log( w * z ) - log(PI) + lgam(w);
+ if( y < -MAXLOG )
+ {
+ mtherr( name, UNDERFLOW );
+ return( sign * 1.0 / MAXNUM );
+ }
+ if( y > MAXLOG )
+ {
+ mtherr( name, OVERFLOW );
+ return( sign * MAXNUM );
+ }
+ return( sign * exp(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 + chbevl( 4.0*w-2.0, R, 16 ) ) / z;
+return(y);
+}
diff --git a/libm/double/round.c b/libm/double/round.c
new file mode 100644
index 000000000..df4564a0f
--- /dev/null
+++ b/libm/double/round.c
@@ -0,0 +1,70 @@
+/* round.c
+ *
+ * Round double to nearest or even integer valued double
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, round();
+ *
+ * y = round(x);
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns the nearest integer to x as a double precision
+ * floating point result. If x ends in 0.5 exactly, the
+ * nearest even integer is chosen.
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * If x is greater than 1/(2*MACHEP), its closest machine
+ * representation is already an integer, so rounding does
+ * not change it.
+ */
+
+/*
+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>
+#ifdef ANSIPROT
+double floor ( double );
+#else
+double floor();
+#endif
+
+double round(x)
+double x;
+{
+double y, r;
+
+/* Largest integer <= x */
+y = floor(x);
+
+/* Fractional part */
+r = x - y;
+
+/* Round up to nearest. */
+if( r > 0.5 )
+ goto rndup;
+
+/* Round to even */
+if( r == 0.5 )
+ {
+ r = y - 2.0 * floor( 0.5 * y );
+ if( r == 1.0 )
+ {
+rndup:
+ y += 1.0;
+ }
+ }
+
+/* Else round down. */
+return(y);
+}
diff --git a/libm/double/setprec.c b/libm/double/setprec.c
new file mode 100644
index 000000000..a5222ae73
--- /dev/null
+++ b/libm/double/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/double/shichi.c b/libm/double/shichi.c
new file mode 100644
index 000000000..a1497fc34
--- /dev/null
+++ b/libm/double/shichi.c
@@ -0,0 +1,599 @@
+/* shichi.c
+ *
+ * Hyperbolic sine and cosine integrals
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, Chi, Shi, shichi();
+ *
+ * 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
+ * DEC Shi 3000 9.1e-17
+ * IEEE Shi 30000 6.9e-16 1.6e-16
+ * Absolute error, except relative when |Chi| > 1:
+ * DEC Chi 2500 9.3e-17
+ * IEEE Chi 30000 8.4e-16 1.4e-16
+ */
+
+/*
+Cephes Math Library Release 2.8: June, 2000
+Copyright 1984, 1987, 2000 by Stephen L. Moshier
+*/
+
+
+#include <math.h>
+
+#ifdef UNK
+/* x exp(-x) shi(x), inverted interval 8 to 18 */
+static double S1[] = {
+ 1.83889230173399459482E-17,
+-9.55485532279655569575E-17,
+ 2.04326105980879882648E-16,
+ 1.09896949074905343022E-15,
+-1.31313534344092599234E-14,
+ 5.93976226264314278932E-14,
+-3.47197010497749154755E-14,
+-1.40059764613117131000E-12,
+ 9.49044626224223543299E-12,
+-1.61596181145435454033E-11,
+-1.77899784436430310321E-10,
+ 1.35455469767246947469E-9,
+-1.03257121792819495123E-9,
+-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 double S2[] = {
+-1.05311574154850938805E-17,
+ 2.62446095596355225821E-17,
+ 8.82090135625368160657E-17,
+-3.38459811878103047136E-16,
+-8.30608026366935789136E-16,
+ 3.93397875437050071776E-15,
+ 1.01765565969729044505E-14,
+-4.21128170307640802703E-14,
+-1.60818204519802480035E-13,
+ 3.34714954175994481761E-13,
+ 2.72600352129153073807E-12,
+ 1.66894954752839083608E-12,
+-3.49278141024730899554E-11,
+-1.58580661666482709598E-10,
+-1.79289437183355633342E-10,
+ 1.76281629144264523277E-9,
+ 1.69050228879421288846E-8,
+ 1.25391771228487041649E-7,
+ 1.16229947068677338732E-6,
+ 1.61038260117376323993E-5,
+ 3.49810375601053973070E-4,
+ 1.28478065259647610779E-2,
+ 1.03665722588798326712E0
+};
+#endif
+
+#ifdef DEC
+static unsigned short S1[] = {
+0022251,0115635,0165120,0006574,
+0122734,0050751,0020305,0101356,
+0023153,0111154,0011103,0177462,
+0023636,0060321,0060253,0124246,
+0124554,0106655,0152525,0166400,
+0025205,0140145,0171006,0106556,
+0125034,0056427,0004205,0176022,
+0126305,0016731,0025011,0134453,
+0027046,0172453,0112604,0116235,
+0127216,0022071,0116600,0137667,
+0130103,0115126,0071104,0052535,
+0030672,0025450,0010071,0141414,
+0130615,0165136,0132137,0177737,
+0132031,0031611,0074436,0175407,
+0032433,0077602,0104345,0060076,
+0033121,0165741,0167177,0172433,
+0133665,0025262,0174621,0022612,
+0134403,0006761,0124566,0145405,
+0034672,0126332,0034737,0116744,
+0036004,0137654,0037332,0131766,
+0036762,0104466,0121445,0124326,
+0040217,0025105,0062145,0042640
+};
+
+static unsigned short S2[] = {
+0122102,0041774,0016051,0055137,
+0022362,0010125,0007651,0015773,
+0022713,0062551,0040227,0071645,
+0123303,0015732,0025731,0146570,
+0123557,0064016,0002067,0067711,
+0024215,0136214,0132374,0124234,
+0024467,0051425,0071066,0064210,
+0125075,0124305,0135123,0024170,
+0125465,0010261,0005560,0034232,
+0025674,0066602,0030724,0174557,
+0026477,0151520,0051510,0067250,
+0026352,0161076,0113154,0116271,
+0127431,0116470,0177465,0127274,
+0130056,0056174,0170315,0013321,
+0130105,0020575,0075327,0036710,
+0030762,0043625,0113046,0125035,
+0031621,0033211,0154354,0022077,
+0032406,0121555,0074270,0041141,
+0033234,0000116,0041611,0173743,
+0034207,0013263,0174715,0115563,
+0035267,0063300,0175753,0117266,
+0036522,0077633,0033255,0136200,
+0040204,0130457,0014454,0166254
+};
+#endif
+
+#ifdef IBMPC
+static unsigned short S1[] = {
+0x01b0,0xbd4a,0x3373,0x3c75,
+0xb05e,0x2418,0x8a3d,0xbc9b,
+0x7fe6,0x8248,0x724d,0x3cad,
+0x7515,0x2c15,0xcc1a,0x3cd3,
+0xbda0,0xbaaa,0x91b5,0xbd0d,
+0xd1ae,0xbe40,0xb80c,0x3d30,
+0xbf82,0xe110,0x8ba2,0xbd23,
+0x3725,0x2541,0xa3bb,0xbd78,
+0x9394,0x72b0,0xdea5,0x3da4,
+0x17f7,0x33b0,0xc487,0xbdb1,
+0x8aac,0xce48,0x734a,0xbde8,
+0x3862,0x0207,0x4565,0x3e17,
+0xfffc,0xd68b,0xbd4b,0xbe11,
+0xdf61,0x2f23,0x2671,0xbe63,
+0xac08,0x511c,0x6ff0,0x3e83,
+0xfea3,0x3dcf,0x3d7c,0x3eaa,
+0x24b1,0x5f32,0xa556,0xbed6,
+0xd961,0x352e,0x61be,0xbf00,
+0xf3bd,0x473b,0x559b,0x3f17,
+0x567f,0x87db,0x97f5,0x3f60,
+0xb51b,0xd464,0x5126,0x3f9e,
+0xa8b4,0xac8c,0xe548,0x3ff1
+};
+
+static unsigned short S2[] = {
+0x2b4c,0x8385,0x487f,0xbc68,
+0x237f,0xa1f5,0x420a,0x3c7e,
+0xee75,0x2812,0x6cad,0x3c99,
+0x39af,0x457b,0x637b,0xbcb8,
+0xedf9,0xc086,0xed01,0xbccd,
+0x9513,0x969f,0xb791,0x3cf1,
+0xcd11,0xae46,0xea62,0x3d06,
+0x650f,0xb74a,0xb518,0xbd27,
+0x0713,0x216e,0xa216,0xbd46,
+0x9f2e,0x463a,0x8db0,0x3d57,
+0x0dd5,0x0a69,0xfa6a,0x3d87,
+0x9397,0xd2cd,0x5c47,0x3d7d,
+0xb5d8,0x1fe6,0x33a7,0xbdc3,
+0xa2da,0x9e19,0xcb8f,0xbde5,
+0xe7b9,0xaf5a,0xa42f,0xbde8,
+0xd544,0xb2c4,0x48f2,0x3e1e,
+0x8488,0x3b1d,0x26d1,0x3e52,
+0x084c,0xaf17,0xd46d,0x3e80,
+0x3efc,0xc871,0x8009,0x3eb3,
+0xb36e,0x7f39,0xe2d6,0x3ef0,
+0x73d7,0x1f7d,0xecd8,0x3f36,
+0xb790,0x66d5,0x4ff3,0x3f8a,
+0x9d96,0xe325,0x9625,0x3ff0
+};
+#endif
+
+#ifdef MIEEE
+static unsigned short S1[] = {
+0x3c75,0x3373,0xbd4a,0x01b0,
+0xbc9b,0x8a3d,0x2418,0xb05e,
+0x3cad,0x724d,0x8248,0x7fe6,
+0x3cd3,0xcc1a,0x2c15,0x7515,
+0xbd0d,0x91b5,0xbaaa,0xbda0,
+0x3d30,0xb80c,0xbe40,0xd1ae,
+0xbd23,0x8ba2,0xe110,0xbf82,
+0xbd78,0xa3bb,0x2541,0x3725,
+0x3da4,0xdea5,0x72b0,0x9394,
+0xbdb1,0xc487,0x33b0,0x17f7,
+0xbde8,0x734a,0xce48,0x8aac,
+0x3e17,0x4565,0x0207,0x3862,
+0xbe11,0xbd4b,0xd68b,0xfffc,
+0xbe63,0x2671,0x2f23,0xdf61,
+0x3e83,0x6ff0,0x511c,0xac08,
+0x3eaa,0x3d7c,0x3dcf,0xfea3,
+0xbed6,0xa556,0x5f32,0x24b1,
+0xbf00,0x61be,0x352e,0xd961,
+0x3f17,0x559b,0x473b,0xf3bd,
+0x3f60,0x97f5,0x87db,0x567f,
+0x3f9e,0x5126,0xd464,0xb51b,
+0x3ff1,0xe548,0xac8c,0xa8b4
+};
+
+static unsigned short S2[] = {
+0xbc68,0x487f,0x8385,0x2b4c,
+0x3c7e,0x420a,0xa1f5,0x237f,
+0x3c99,0x6cad,0x2812,0xee75,
+0xbcb8,0x637b,0x457b,0x39af,
+0xbccd,0xed01,0xc086,0xedf9,
+0x3cf1,0xb791,0x969f,0x9513,
+0x3d06,0xea62,0xae46,0xcd11,
+0xbd27,0xb518,0xb74a,0x650f,
+0xbd46,0xa216,0x216e,0x0713,
+0x3d57,0x8db0,0x463a,0x9f2e,
+0x3d87,0xfa6a,0x0a69,0x0dd5,
+0x3d7d,0x5c47,0xd2cd,0x9397,
+0xbdc3,0x33a7,0x1fe6,0xb5d8,
+0xbde5,0xcb8f,0x9e19,0xa2da,
+0xbde8,0xa42f,0xaf5a,0xe7b9,
+0x3e1e,0x48f2,0xb2c4,0xd544,
+0x3e52,0x26d1,0x3b1d,0x8488,
+0x3e80,0xd46d,0xaf17,0x084c,
+0x3eb3,0x8009,0xc871,0x3efc,
+0x3ef0,0xe2d6,0x7f39,0xb36e,
+0x3f36,0xecd8,0x1f7d,0x73d7,
+0x3f8a,0x4ff3,0x66d5,0xb790,
+0x3ff0,0x9625,0xe325,0x9d96
+};
+#endif
+
+
+#ifdef UNK
+/* x exp(-x) chin(x), inverted interval 8 to 18 */
+static double C1[] = {
+-8.12435385225864036372E-18,
+ 2.17586413290339214377E-17,
+ 5.22624394924072204667E-17,
+-9.48812110591690559363E-16,
+ 5.35546311647465209166E-15,
+-1.21009970113732918701E-14,
+-6.00865178553447437951E-14,
+ 7.16339649156028587775E-13,
+-2.93496072607599856104E-12,
+-1.40359438136491256904E-12,
+ 8.76302288609054966081E-11,
+-4.40092476213282340617E-10,
+-1.87992075640569295479E-10,
+ 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 double C2[] = {
+ 8.06913408255155572081E-18,
+-2.08074168180148170312E-17,
+-5.98111329658272336816E-17,
+ 2.68533951085945765591E-16,
+ 4.52313941698904694774E-16,
+-3.10734917335299464535E-15,
+-4.42823207332531972288E-15,
+ 3.49639695410806959872E-14,
+ 6.63406731718911586609E-14,
+-3.71902448093119218395E-13,
+-1.27135418132338309016E-12,
+ 2.74851141935315395333E-12,
+ 2.33781843985453438400E-11,
+ 2.71436006377612442764E-11,
+-2.56600180000355990529E-10,
+-1.61021375163803438552E-9,
+-4.72543064876271773512E-9,
+-3.00095178028681682282E-9,
+ 7.79387474390914922337E-8,
+ 1.06942765566401507066E-6,
+ 1.59503164802313196374E-5,
+ 3.49592575153777996871E-4,
+ 1.28475387530065247392E-2,
+ 1.03665693917934275131E0
+};
+#endif
+
+#ifdef DEC
+static unsigned short C1[] = {
+0122025,0157055,0021702,0021427,
+0022310,0130043,0123265,0022340,
+0022561,0002231,0017746,0013043,
+0123610,0136375,0002352,0024467,
+0024300,0171555,0141300,0000446,
+0124531,0176777,0126210,0035616,
+0125207,0046604,0167760,0077132,
+0026111,0120666,0026606,0064143,
+0126516,0103615,0054127,0005436,
+0126305,0104721,0025415,0004134,
+0027700,0131556,0164725,0157553,
+0130361,0170602,0077274,0055406,
+0130116,0131420,0125472,0017231,
+0031541,0153747,0177312,0056304,
+0132114,0035517,0041545,0043151,
+0132556,0020415,0110044,0172442,
+0033402,0117041,0031152,0010364,
+0033621,0072737,0050647,0013720,
+0134600,0121366,0140010,0063265,
+0135244,0022637,0013756,0044742,
+0035402,0052052,0006523,0043564,
+0036730,0106660,0020277,0162146,
+0040216,0123254,0135147,0005724
+};
+
+static unsigned short C2[] = {
+0022024,0154550,0104311,0144257,
+0122277,0165037,0133443,0155601,
+0122611,0165102,0157053,0055252,
+0023232,0146235,0153511,0113222,
+0023402,0057340,0145304,0010471,
+0124137,0164171,0113071,0100002,
+0124237,0105473,0056130,0022022,
+0025035,0073266,0056746,0164433,
+0025225,0061313,0055600,0165407,
+0125721,0056312,0107613,0051215,
+0126262,0166534,0115336,0066653,
+0026501,0064307,0127442,0065573,
+0027315,0121375,0142020,0045356,
+0027356,0140764,0070641,0046570,
+0130215,0010503,0146335,0177737,
+0130735,0047134,0015215,0163665,
+0131242,0056523,0155276,0050053,
+0131116,0034515,0050707,0163512,
+0032247,0057507,0107545,0032007,
+0033217,0104501,0021706,0025047,
+0034205,0146413,0033746,0076562,
+0035267,0044605,0065355,0002772,
+0036522,0077173,0130716,0170304,
+0040204,0130454,0130571,0027270
+};
+#endif
+
+#ifdef IBMPC
+static unsigned short C1[] = {
+0x4463,0xa478,0xbbc5,0xbc62,
+0xa49c,0x74d6,0x1604,0x3c79,
+0xc2c4,0x23fc,0x2093,0x3c8e,
+0x4527,0xa09d,0x179f,0xbcd1,
+0x0025,0xb858,0x1e6d,0x3cf8,
+0x0772,0xf591,0x3fbf,0xbd0b,
+0x0fcb,0x9dfe,0xe9b0,0xbd30,
+0xcd0c,0xc5b0,0x3436,0x3d69,
+0xe164,0xab0a,0xd0f1,0xbd89,
+0xa10c,0x2561,0xb13a,0xbd78,
+0xbbed,0xdd3a,0x166d,0x3dd8,
+0x8b61,0x4fd7,0x3e30,0xbdfe,
+0x43d3,0x1567,0xd662,0xbde9,
+0x4b98,0xffd9,0x3afc,0x3e4c,
+0xa8cd,0xe86c,0x8769,0xbe69,
+0x9ea4,0xb204,0xc421,0xbe8d,
+0x421f,0x264d,0x53c4,0x3ec0,
+0xe2fa,0xea34,0x2ebb,0x3ed2,
+0x0cd7,0xd801,0x145e,0xbf10,
+0xc93c,0xe2fd,0x84b3,0xbf34,
+0x68ef,0x41aa,0x4a85,0x3f40,
+0xfc8d,0x0417,0x11b6,0x3f9b,
+0xe17b,0x974c,0xd4d5,0x3ff1
+};
+
+static unsigned short C2[] = {
+0x3916,0x1119,0x9b2d,0x3c62,
+0x7b70,0xf6e4,0xfd43,0xbc77,
+0x6b55,0x5bc5,0x3d48,0xbc91,
+0x32d2,0xbae9,0x5993,0x3cb3,
+0x8227,0x1958,0x4bdc,0x3cc0,
+0x3000,0x32c7,0xfd0f,0xbceb,
+0x0482,0x6b8b,0xf167,0xbcf3,
+0xdd23,0xcbbc,0xaed6,0x3d23,
+0x1d61,0x6b70,0xac59,0x3d32,
+0x6a52,0x51f1,0x2b99,0xbd5a,
+0xcdb5,0x935b,0x5dab,0xbd76,
+0x4d6f,0xf5e4,0x2d18,0x3d88,
+0x095e,0xb882,0xb45f,0x3db9,
+0x29af,0x8e34,0xd83e,0x3dbd,
+0xbffc,0x799b,0xa228,0xbdf1,
+0xbcf7,0x8351,0xa9cb,0xbe1b,
+0xca05,0x7b57,0x4baa,0xbe34,
+0xfce9,0xaa38,0xc729,0xbe29,
+0xa681,0xf1ec,0xebe8,0x3e74,
+0xc545,0x2478,0xf128,0x3eb1,
+0xcfae,0x66fc,0xb9a1,0x3ef0,
+0xa0bf,0xad5d,0xe930,0x3f36,
+0xde19,0x7639,0x4fcf,0x3f8a,
+0x25d7,0x962f,0x9625,0x3ff0
+};
+#endif
+
+#ifdef MIEEE
+static unsigned short C1[] = {
+0xbc62,0xbbc5,0xa478,0x4463,
+0x3c79,0x1604,0x74d6,0xa49c,
+0x3c8e,0x2093,0x23fc,0xc2c4,
+0xbcd1,0x179f,0xa09d,0x4527,
+0x3cf8,0x1e6d,0xb858,0x0025,
+0xbd0b,0x3fbf,0xf591,0x0772,
+0xbd30,0xe9b0,0x9dfe,0x0fcb,
+0x3d69,0x3436,0xc5b0,0xcd0c,
+0xbd89,0xd0f1,0xab0a,0xe164,
+0xbd78,0xb13a,0x2561,0xa10c,
+0x3dd8,0x166d,0xdd3a,0xbbed,
+0xbdfe,0x3e30,0x4fd7,0x8b61,
+0xbde9,0xd662,0x1567,0x43d3,
+0x3e4c,0x3afc,0xffd9,0x4b98,
+0xbe69,0x8769,0xe86c,0xa8cd,
+0xbe8d,0xc421,0xb204,0x9ea4,
+0x3ec0,0x53c4,0x264d,0x421f,
+0x3ed2,0x2ebb,0xea34,0xe2fa,
+0xbf10,0x145e,0xd801,0x0cd7,
+0xbf34,0x84b3,0xe2fd,0xc93c,
+0x3f40,0x4a85,0x41aa,0x68ef,
+0x3f9b,0x11b6,0x0417,0xfc8d,
+0x3ff1,0xd4d5,0x974c,0xe17b
+};
+
+static unsigned short C2[] = {
+0x3c62,0x9b2d,0x1119,0x3916,
+0xbc77,0xfd43,0xf6e4,0x7b70,
+0xbc91,0x3d48,0x5bc5,0x6b55,
+0x3cb3,0x5993,0xbae9,0x32d2,
+0x3cc0,0x4bdc,0x1958,0x8227,
+0xbceb,0xfd0f,0x32c7,0x3000,
+0xbcf3,0xf167,0x6b8b,0x0482,
+0x3d23,0xaed6,0xcbbc,0xdd23,
+0x3d32,0xac59,0x6b70,0x1d61,
+0xbd5a,0x2b99,0x51f1,0x6a52,
+0xbd76,0x5dab,0x935b,0xcdb5,
+0x3d88,0x2d18,0xf5e4,0x4d6f,
+0x3db9,0xb45f,0xb882,0x095e,
+0x3dbd,0xd83e,0x8e34,0x29af,
+0xbdf1,0xa228,0x799b,0xbffc,
+0xbe1b,0xa9cb,0x8351,0xbcf7,
+0xbe34,0x4baa,0x7b57,0xca05,
+0xbe29,0xc729,0xaa38,0xfce9,
+0x3e74,0xebe8,0xf1ec,0xa681,
+0x3eb1,0xf128,0x2478,0xc545,
+0x3ef0,0xb9a1,0x66fc,0xcfae,
+0x3f36,0xe930,0xad5d,0xa0bf,
+0x3f8a,0x4fcf,0x7639,0xde19,
+0x3ff0,0x9625,0x962f,0x25d7
+};
+#endif
+
+
+
+/* Sine and cosine integrals */
+
+#ifdef ANSIPROT
+extern double log ( double );
+extern double exp ( double );
+extern double fabs ( double );
+extern double chbevl ( double, void *, int );
+#else
+double log(), exp(), fabs(), chbevl();
+#endif
+#define EUL 0.57721566490153286061
+extern double MACHEP, MAXNUM, PIO2;
+
+int shichi( x, si, ci )
+double x;
+double *si, *ci;
+{
+double k, z, c, s, a;
+short sign;
+
+if( x < 0.0 )
+ {
+ sign = -1;
+ x = -x;
+ }
+else
+ sign = 0;
+
+
+if( x == 0.0 )
+ {
+ *si = 0.0;
+ *ci = -MAXNUM;
+ 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( fabs(a/s) > MACHEP );
+
+s *= x;
+goto done;
+
+
+chb:
+
+if( x < 18.0 )
+ {
+ a = (576.0/x - 52.0)/10.0;
+ k = exp(x) / x;
+ s = k * chbevl( a, S1, 22 );
+ c = k * chbevl( a, C1, 23 );
+ goto done;
+ }
+
+if( x <= 88.0 )
+ {
+ a = (6336.0/x - 212.0)/70.0;
+ k = exp(x) / x;
+ s = k * chbevl( a, S2, 23 );
+ c = k * chbevl( a, C2, 24 );
+ goto done;
+ }
+else
+ {
+ if( sign )
+ *si = -MAXNUM;
+ else
+ *si = MAXNUM;
+ *ci = MAXNUM;
+ return(0);
+ }
+done:
+if( sign )
+ s = -s;
+
+*si = s;
+
+*ci = EUL + log(x) + c;
+return(0);
+}
diff --git a/libm/double/sici.c b/libm/double/sici.c
new file mode 100644
index 000000000..b00b9c449
--- /dev/null
+++ b/libm/double/sici.c
@@ -0,0 +1,675 @@
+/* sici.c
+ *
+ * Sine and cosine integrals
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, Ci, Si, sici();
+ *
+ * sici( 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 4.4e-16 7.3e-17
+ * IEEE Ci 30000 6.9e-16 5.1e-17
+ * DEC Si 5000 4.4e-17 9.0e-18
+ * DEC Ci 5300 7.9e-17 5.2e-18
+ */
+
+/*
+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>
+
+#ifdef UNK
+static double SN[] = {
+-8.39167827910303881427E-11,
+ 4.62591714427012837309E-8,
+-9.75759303843632795789E-6,
+ 9.76945438170435310816E-4,
+-4.13470316229406538752E-2,
+ 1.00000000000000000302E0,
+};
+static double SD[] = {
+ 2.03269266195951942049E-12,
+ 1.27997891179943299903E-9,
+ 4.41827842801218905784E-7,
+ 9.96412122043875552487E-5,
+ 1.42085239326149893930E-2,
+ 9.99999999999999996984E-1,
+};
+#endif
+#ifdef DEC
+static unsigned short SN[] = {
+0127670,0104362,0167505,0035161,
+0032106,0127177,0032131,0056461,
+0134043,0132213,0000476,0172351,
+0035600,0006331,0064761,0032665,
+0137051,0055601,0044667,0017645,
+0040200,0000000,0000000,0000000,
+};
+static unsigned short SD[] = {
+0026417,0004674,0052064,0001573,
+0030657,0165501,0014666,0131526,
+0032755,0032133,0034147,0024124,
+0034720,0173167,0166624,0154477,
+0036550,0145336,0063534,0063220,
+0040200,0000000,0000000,0000000,
+};
+#endif
+#ifdef IBMPC
+static unsigned short SN[] = {
+0xa74e,0x5de8,0x111e,0xbdd7,
+0x2ba6,0xe68b,0xd5cf,0x3e68,
+0xde9d,0x6027,0x7691,0xbee4,
+0x26b7,0x2d3e,0x019b,0x3f50,
+0xe3f5,0x2936,0x2b70,0xbfa5,
+0x0000,0x0000,0x0000,0x3ff0,
+};
+static unsigned short SD[] = {
+0x806f,0x8a86,0xe137,0x3d81,
+0xd66b,0x2336,0xfd68,0x3e15,
+0xe50a,0x670c,0xa68b,0x3e9d,
+0x9b28,0xfdb2,0x1ece,0x3f1a,
+0x8cd2,0xcceb,0x195b,0x3f8d,
+0x0000,0x0000,0x0000,0x3ff0,
+};
+#endif
+#ifdef MIEEE
+static unsigned short SN[] = {
+0xbdd7,0x111e,0x5de8,0xa74e,
+0x3e68,0xd5cf,0xe68b,0x2ba6,
+0xbee4,0x7691,0x6027,0xde9d,
+0x3f50,0x019b,0x2d3e,0x26b7,
+0xbfa5,0x2b70,0x2936,0xe3f5,
+0x3ff0,0x0000,0x0000,0x0000,
+};
+static unsigned short SD[] = {
+0x3d81,0xe137,0x8a86,0x806f,
+0x3e15,0xfd68,0x2336,0xd66b,
+0x3e9d,0xa68b,0x670c,0xe50a,
+0x3f1a,0x1ece,0xfdb2,0x9b28,
+0x3f8d,0x195b,0xcceb,0x8cd2,
+0x3ff0,0x0000,0x0000,0x0000,
+};
+#endif
+#ifdef UNK
+static double CN[] = {
+ 2.02524002389102268789E-11,
+-1.35249504915790756375E-8,
+ 3.59325051419993077021E-6,
+-4.74007206873407909465E-4,
+ 2.89159652607555242092E-2,
+-1.00000000000000000080E0,
+};
+static double CD[] = {
+ 4.07746040061880559506E-12,
+ 3.06780997581887812692E-9,
+ 1.23210355685883423679E-6,
+ 3.17442024775032769882E-4,
+ 5.10028056236446052392E-2,
+ 4.00000000000000000080E0,
+};
+#endif
+#ifdef DEC
+static unsigned short CN[] = {
+0027262,0022131,0160257,0020166,
+0131550,0055534,0077637,0000557,
+0033561,0021622,0161463,0026575,
+0135370,0102053,0116333,0000466,
+0036754,0160454,0122022,0024622,
+0140200,0000000,0000000,0000000,
+};
+static unsigned short CD[] = {
+0026617,0073177,0107543,0104425,
+0031122,0150573,0156453,0041517,
+0033245,0057301,0077706,0110510,
+0035246,0067130,0165424,0044543,
+0037120,0164121,0061206,0053657,
+0040600,0000000,0000000,0000000,
+};
+#endif
+#ifdef IBMPC
+static unsigned short CN[] = {
+0xe40f,0x3c15,0x448b,0x3db6,
+0xe02e,0x8ff3,0x0b6b,0xbe4d,
+0x65b0,0x5c66,0x2472,0x3ece,
+0x6027,0x739b,0x1085,0xbf3f,
+0x4532,0x9482,0x9c25,0x3f9d,
+0x0000,0x0000,0x0000,0xbff0,
+};
+static unsigned short CD[] = {
+0x7123,0xf1ec,0xeecf,0x3d91,
+0x686a,0x7ba5,0x5a2f,0x3e2a,
+0xd229,0x2ff8,0xabd8,0x3eb4,
+0x892c,0x1d62,0xcdcb,0x3f34,
+0xcaf6,0x2c50,0x1d0a,0x3faa,
+0x0000,0x0000,0x0000,0x4010,
+};
+#endif
+#ifdef MIEEE
+static unsigned short CN[] = {
+0x3db6,0x448b,0x3c15,0xe40f,
+0xbe4d,0x0b6b,0x8ff3,0xe02e,
+0x3ece,0x2472,0x5c66,0x65b0,
+0xbf3f,0x1085,0x739b,0x6027,
+0x3f9d,0x9c25,0x9482,0x4532,
+0xbff0,0x0000,0x0000,0x0000,
+};
+static unsigned short CD[] = {
+0x3d91,0xeecf,0xf1ec,0x7123,
+0x3e2a,0x5a2f,0x7ba5,0x686a,
+0x3eb4,0xabd8,0x2ff8,0xd229,
+0x3f34,0xcdcb,0x1d62,0x892c,
+0x3faa,0x1d0a,0x2c50,0xcaf6,
+0x4010,0x0000,0x0000,0x0000,
+};
+#endif
+
+
+#ifdef UNK
+static double FN4[] = {
+ 4.23612862892216586994E0,
+ 5.45937717161812843388E0,
+ 1.62083287701538329132E0,
+ 1.67006611831323023771E-1,
+ 6.81020132472518137426E-3,
+ 1.08936580650328664411E-4,
+ 5.48900223421373614008E-7,
+};
+static double FD4[] = {
+/* 1.00000000000000000000E0,*/
+ 8.16496634205391016773E0,
+ 7.30828822505564552187E0,
+ 1.86792257950184183883E0,
+ 1.78792052963149907262E-1,
+ 7.01710668322789753610E-3,
+ 1.10034357153915731354E-4,
+ 5.48900252756255700982E-7,
+};
+#endif
+#ifdef DEC
+static unsigned short FN4[] = {
+0040607,0107135,0120133,0153471,
+0040656,0131467,0140424,0017567,
+0040317,0073563,0121610,0002511,
+0037453,0001710,0000040,0006334,
+0036337,0024033,0176003,0171425,
+0034744,0072341,0121657,0126035,
+0033023,0054042,0154652,0000451,
+};
+static unsigned short FD4[] = {
+/*0040200,0000000,0000000,0000000,*/
+0041002,0121663,0137500,0177450,
+0040751,0156577,0042213,0061552,
+0040357,0014026,0045465,0147265,
+0037467,0012503,0110413,0131772,
+0036345,0167701,0155706,0160551,
+0034746,0141076,0162250,0123547,
+0033023,0054043,0056706,0151050,
+};
+#endif
+#ifdef IBMPC
+static unsigned short FN4[] = {
+0x7ae7,0xb40b,0xf1cb,0x4010,
+0x83ef,0xf822,0xd666,0x4015,
+0x00a9,0x7471,0xeeee,0x3ff9,
+0x019c,0x0004,0x6079,0x3fc5,
+0x7e63,0x7f80,0xe503,0x3f7b,
+0xf584,0x3475,0x8e9c,0x3f1c,
+0x4025,0x5b35,0x6b04,0x3ea2,
+};
+static unsigned short FD4[] = {
+/*0x0000,0x0000,0x0000,0x3ff0,*/
+0x1fe5,0x77e8,0x5476,0x4020,
+0x6c6d,0xe891,0x3baf,0x401d,
+0xb9d7,0xc966,0xe302,0x3ffd,
+0x767f,0x7221,0xe2a8,0x3fc6,
+0xdc2d,0x3b78,0xbdf8,0x3f7c,
+0x14ed,0xdc95,0xd847,0x3f1c,
+0xda45,0x6bb8,0x6b04,0x3ea2,
+};
+#endif
+#ifdef MIEEE
+static unsigned short FN4[] = {
+0x4010,0xf1cb,0xb40b,0x7ae7,
+0x4015,0xd666,0xf822,0x83ef,
+0x3ff9,0xeeee,0x7471,0x00a9,
+0x3fc5,0x6079,0x0004,0x019c,
+0x3f7b,0xe503,0x7f80,0x7e63,
+0x3f1c,0x8e9c,0x3475,0xf584,
+0x3ea2,0x6b04,0x5b35,0x4025,
+};
+static unsigned short FD4[] = {
+/* 0x3ff0,0x0000,0x0000,0x0000,*/
+0x4020,0x5476,0x77e8,0x1fe5,
+0x401d,0x3baf,0xe891,0x6c6d,
+0x3ffd,0xe302,0xc966,0xb9d7,
+0x3fc6,0xe2a8,0x7221,0x767f,
+0x3f7c,0xbdf8,0x3b78,0xdc2d,
+0x3f1c,0xd847,0xdc95,0x14ed,
+0x3ea2,0x6b04,0x6bb8,0xda45,
+};
+#endif
+
+#ifdef UNK
+static double 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 double 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,
+};
+#endif
+#ifdef DEC
+static unsigned short FN8[] = {
+0037751,0064467,0142332,0164573,
+0040066,0133013,0050352,0071102,
+0037444,0022671,0102157,0013535,
+0036476,0024335,0136423,0146444,
+0035267,0042253,0164110,0110460,
+0033643,0022626,0062535,0060320,
+0032011,0075223,0010110,0153413,
+0027717,0014572,0011360,0014034,
+0025332,0104755,0004563,0152354,
+};
+static unsigned short FD8[] = {
+/*0040200,0000000,0000000,0000000,*/
+0040152,0157345,0030104,0075616,
+0037466,0174527,0172740,0071060,
+0036510,0046337,0144272,0156552,
+0035274,0007555,0042537,0015572,
+0033645,0035731,0112465,0026474,
+0032012,0043612,0030613,0030123,
+0027717,0103277,0004564,0151000,
+0025332,0104755,0004563,0152354,
+};
+#endif
+#ifdef IBMPC
+static unsigned short FN8[] = {
+0x5d2f,0xf89b,0x2d26,0x3fdd,
+0x4e48,0x6a1d,0xd6c1,0x3fe6,
+0xe2ec,0x308d,0x84b7,0x3fc4,
+0x79a4,0xb7a2,0xc51b,0x3f87,
+0x1226,0x7d09,0xe895,0x3f36,
+0xac1a,0xccab,0x64b2,0x3ed4,
+0x1ae1,0x6209,0x2f52,0x3e61,
+0x0304,0x425e,0xe32f,0x3dd9,
+0x7a9d,0xa12e,0x513d,0x3d3b,
+};
+static unsigned short FD8[] = {
+/*0x0000,0x0000,0x0000,0x3ff0,*/
+0x8f72,0xa608,0x5bdc,0x3fed,
+0x0e46,0xfebc,0xdf2a,0x3fc6,
+0x5bad,0xf917,0x099b,0x3f89,
+0xe36f,0xa8ab,0x81ed,0x3f37,
+0xa5a8,0x32a6,0xa77b,0x3ed4,
+0x660a,0x4631,0x48f1,0x3e61,
+0x9a40,0xe12e,0xf0d7,0x3dd9,
+0x7a9d,0xa12e,0x513d,0x3d3b,
+};
+#endif
+#ifdef MIEEE
+static unsigned short FN8[] = {
+0x3fdd,0x2d26,0xf89b,0x5d2f,
+0x3fe6,0xd6c1,0x6a1d,0x4e48,
+0x3fc4,0x84b7,0x308d,0xe2ec,
+0x3f87,0xc51b,0xb7a2,0x79a4,
+0x3f36,0xe895,0x7d09,0x1226,
+0x3ed4,0x64b2,0xccab,0xac1a,
+0x3e61,0x2f52,0x6209,0x1ae1,
+0x3dd9,0xe32f,0x425e,0x0304,
+0x3d3b,0x513d,0xa12e,0x7a9d,
+};
+static unsigned short FD8[] = {
+/*0x3ff0,0x0000,0x0000,0x0000,*/
+0x3fed,0x5bdc,0xa608,0x8f72,
+0x3fc6,0xdf2a,0xfebc,0x0e46,
+0x3f89,0x099b,0xf917,0x5bad,
+0x3f37,0x81ed,0xa8ab,0xe36f,
+0x3ed4,0xa77b,0x32a6,0xa5a8,
+0x3e61,0x48f1,0x4631,0x660a,
+0x3dd9,0xf0d7,0xe12e,0x9a40,
+0x3d3b,0x513d,0xa12e,0x7a9d,
+};
+#endif
+
+#ifdef UNK
+static double 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 double GD4[] = {
+/* 1.00000000000000000000E0,*/
+ 1.64402202413355338886E0,
+ 6.66296701268987968381E-1,
+ 9.88771761277688796203E-2,
+ 6.22396345441768420760E-3,
+ 1.73221081474177119497E-4,
+ 2.02659182086343991969E-6,
+ 7.82579218933534490868E-9,
+};
+#endif
+#ifdef DEC
+static unsigned short GN4[] = {
+0037262,0060622,0164572,0157515,
+0040034,0101527,0061263,0147204,
+0037713,0055467,0037475,0144512,
+0037231,0046151,0035234,0045261,
+0036260,0111624,0150617,0053536,
+0035051,0157175,0016675,0155456,
+0033404,0154757,0041211,0000055,
+0031406,0071060,0130322,0033322,
+};
+static unsigned short GD4[] = {
+/* 0040200,0000000,0000000,0000000,*/
+0040322,0067520,0046707,0053275,
+0040052,0111153,0126542,0005516,
+0037312,0100035,0167121,0014552,
+0036313,0171143,0137176,0014213,
+0035065,0121256,0012033,0150603,
+0033410,0000225,0013121,0071643,
+0031406,0071062,0131152,0150454,
+};
+#endif
+#ifdef IBMPC
+static unsigned short GN4[] = {
+0x5bea,0x5d2f,0x4c32,0x3fb6,
+0x79d1,0xec56,0x906a,0x3fe3,
+0xb929,0xe7e7,0x6b66,0x3fd9,
+0x8956,0x2753,0x298d,0x3fb3,
+0xeaec,0x9a31,0x1272,0x3f76,
+0xbb66,0xa3b7,0x3bcf,0x3f25,
+0x2006,0xe851,0x9b3d,0x3ec0,
+0x46da,0x161a,0xce46,0x3e40,
+};
+static unsigned short GD4[] = {
+/* 0x0000,0x0000,0x0000,0x3ff0,*/
+0xead8,0x09b8,0x4dea,0x3ffa,
+0x416a,0x75ac,0x524d,0x3fe5,
+0x232d,0xbdca,0x5003,0x3fb9,
+0xc311,0x77cf,0x7e4c,0x3f79,
+0x7a30,0xc283,0xb455,0x3f26,
+0x2e74,0xa2ca,0x0012,0x3ec1,
+0x5a26,0x564d,0xce46,0x3e40,
+};
+#endif
+#ifdef MIEEE
+static unsigned short GN4[] = {
+0x3fb6,0x4c32,0x5d2f,0x5bea,
+0x3fe3,0x906a,0xec56,0x79d1,
+0x3fd9,0x6b66,0xe7e7,0xb929,
+0x3fb3,0x298d,0x2753,0x8956,
+0x3f76,0x1272,0x9a31,0xeaec,
+0x3f25,0x3bcf,0xa3b7,0xbb66,
+0x3ec0,0x9b3d,0xe851,0x2006,
+0x3e40,0xce46,0x161a,0x46da,
+};
+static unsigned short GD4[] = {
+/*0x3ff0,0x0000,0x0000,0x0000,*/
+0x3ffa,0x4dea,0x09b8,0xead8,
+0x3fe5,0x524d,0x75ac,0x416a,
+0x3fb9,0x5003,0xbdca,0x232d,
+0x3f79,0x7e4c,0x77cf,0xc311,
+0x3f26,0xb455,0xc283,0x7a30,
+0x3ec1,0x0012,0xa2ca,0x2e74,
+0x3e40,0xce46,0x564d,0x5a26,
+};
+#endif
+
+#ifdef UNK
+static double 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 double 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,
+};
+#endif
+#ifdef DEC
+static unsigned short GN8[] = {
+0040062,0103056,0110624,0033123,
+0037651,0025640,0136266,0145647,
+0037035,0122566,0137770,0061777,
+0035741,0011424,0065311,0013370,
+0034422,0055505,0134324,0016755,
+0032672,0056530,0022565,0014747,
+0030752,0031674,0114735,0013162,
+0026607,0145353,0022020,0123625,
+0024142,0045054,0060033,0016505,
+};
+static unsigned short GD8[] = {
+/*0040200,0000000,0000000,0000000,*/
+0040327,0137032,0064331,0136425,
+0037771,0143705,0070300,0105711,
+0037077,0124101,0025275,0035356,
+0035771,0064333,0145103,0105357,
+0034432,0106301,0105311,0010713,
+0032677,0127645,0120034,0157551,
+0030755,0054466,0010743,0105566,
+0026610,0072242,0142530,0135744,
+0024142,0045054,0060033,0016505,
+};
+#endif
+#ifdef IBMPC
+static unsigned short GN8[] = {
+0x86ca,0xd232,0x50c5,0x3fe6,
+0xd975,0x1796,0x2574,0x3fd5,
+0x0c80,0xd7ff,0xb4ae,0x3fa3,
+0x22df,0x8d59,0x2262,0x3f5c,
+0x83be,0xb71a,0x4b68,0x3f02,
+0xa33d,0x04ae,0x4bab,0x3e97,
+0xa2ce,0x933b,0x4677,0x3e1d,
+0x14f3,0x6482,0xf95d,0x3d90,
+0x63a9,0x8c03,0x4945,0x3cec,
+};
+static unsigned short GD8[] = {
+/*0x0000,0x0000,0x0000,0x3ff0,*/
+0x37a3,0x4d1b,0xf7c3,0x3ffa,
+0x1179,0xae18,0x38f8,0x3fdf,
+0xa75e,0x2557,0xf508,0x3fa7,
+0x715e,0x7948,0x2d1b,0x3f5f,
+0x2239,0x3159,0x5198,0x3f03,
+0x9bed,0xb403,0xf5f4,0x3e97,
+0x716f,0xc23c,0xab26,0x3e1d,
+0x177c,0x58ab,0x0e94,0x3d91,
+0x63a9,0x8c03,0x4945,0x3cec,
+};
+#endif
+#ifdef MIEEE
+static unsigned short GN8[] = {
+0x3fe6,0x50c5,0xd232,0x86ca,
+0x3fd5,0x2574,0x1796,0xd975,
+0x3fa3,0xb4ae,0xd7ff,0x0c80,
+0x3f5c,0x2262,0x8d59,0x22df,
+0x3f02,0x4b68,0xb71a,0x83be,
+0x3e97,0x4bab,0x04ae,0xa33d,
+0x3e1d,0x4677,0x933b,0xa2ce,
+0x3d90,0xf95d,0x6482,0x14f3,
+0x3cec,0x4945,0x8c03,0x63a9,
+};
+static unsigned short GD8[] = {
+/*0x3ff0,0x0000,0x0000,0x0000,*/
+0x3ffa,0xf7c3,0x4d1b,0x37a3,
+0x3fdf,0x38f8,0xae18,0x1179,
+0x3fa7,0xf508,0x2557,0xa75e,
+0x3f5f,0x2d1b,0x7948,0x715e,
+0x3f03,0x5198,0x3159,0x2239,
+0x3e97,0xf5f4,0xb403,0x9bed,
+0x3e1d,0xab26,0xc23c,0x716f,
+0x3d91,0x0e94,0x58ab,0x177c,
+0x3cec,0x4945,0x8c03,0x63a9,
+};
+#endif
+
+#ifdef ANSIPROT
+extern double log ( double );
+extern double sin ( double );
+extern double cos ( double );
+extern double polevl ( double, void *, int );
+extern double p1evl ( double, void *, int );
+#else
+double log(), sin(), cos(), polevl(), p1evl();
+#endif
+#define EUL 0.57721566490153286061
+extern double MAXNUM, PIO2, MACHEP;
+
+
+int sici( x, si, ci )
+double x;
+double *si, *ci;
+{
+double z, c, s, f, g;
+short sign;
+
+if( x < 0.0 )
+ {
+ sign = -1;
+ x = -x;
+ }
+else
+ sign = 0;
+
+
+if( x == 0.0 )
+ {
+ *si = 0.0;
+ *ci = -MAXNUM;
+ return( 0 );
+ }
+
+
+if( x > 1.0e9 )
+ {
+ *si = PIO2 - cos(x)/x;
+ *ci = sin(x)/x;
+ return( 0 );
+ }
+
+
+
+if( x > 4.0 )
+ goto asympt;
+
+z = x * x;
+s = x * polevl( z, SN, 5 ) / polevl( z, SD, 5 );
+c = z * polevl( z, CN, 5 ) / polevl( z, CD, 5 );
+
+if( sign )
+ s = -s;
+*si = s;
+*ci = EUL + log(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 = sin(x);
+c = cos(x);
+z = 1.0/(x*x);
+if( x < 8.0 )
+ {
+ f = polevl( z, FN4, 6 ) / (x * p1evl( z, FD4, 7 ));
+ g = z * polevl( z, GN4, 7 ) / p1evl( z, GD4, 7 );
+ }
+else
+ {
+ f = polevl( z, FN8, 8 ) / (x * p1evl( z, FD8, 8 ));
+ g = z * polevl( z, GN8, 8 ) / p1evl( z, GD8, 9 );
+ }
+*si = PIO2 - f * c - g * s;
+if( sign )
+ *si = -( *si );
+*ci = f * s - g * c;
+
+return(0);
+}
diff --git a/libm/double/simpsn.c b/libm/double/simpsn.c
new file mode 100644
index 000000000..4eb19460b
--- /dev/null
+++ b/libm/double/simpsn.c
@@ -0,0 +1,81 @@
+/* simpsn.c */
+/* simpsn.c
+ * Numerical integration of function tabulated
+ * at equally spaced arguments
+ */
+
+/* Coefficients for Cote integration formulas */
+
+/* Note: these numbers were computed using 40-decimal precision. */
+
+#define NCOTE 8
+
+/* 6th order formula */
+/*
+static double simcon[] =
+{
+ 4.88095238095238095E-2,
+ 2.57142857142857142857E-1,
+ 3.2142857142857142857E-2,
+ 3.2380952380952380952E-1,
+};
+*/
+
+/* 8th order formula */
+static double simcon[] =
+{
+ 3.488536155202821869E-2,
+ 2.076895943562610229E-1,
+ -3.27336860670194003527E-2,
+ 3.7022927689594356261E-1,
+ -1.6014109347442680776E-1,
+};
+
+/* 10th order formula */
+/*
+static double simcon[] =
+{
+ 2.68341483619261397039E-2,
+ 1.77535941424830313719E-1,
+ -8.1043570626903960237E-2,
+ 4.5494628827962161295E-1,
+ -4.3515512265512265512E-1,
+ 7.1376463043129709796E-1,
+};
+*/
+
+/* simpsn.c 2 */
+/* 20th order formula */
+/*
+static double simcon[] =
+{
+ 1.182527324903160319E-2,
+ 1.14137717644606974987E-1,
+ -2.36478370511426964E-1,
+ 1.20618689348187566E+0,
+ -3.7710317267153304677E+0,
+ 1.03367982199398011435E+1,
+ -2.270881584397951229796E+1,
+ 4.1828057422193554603E+1,
+ -6.4075279490154004651555E+1,
+ 8.279728347247285172085E+1,
+ -9.0005367135242894657916E+1,
+};
+*/
+
+/* simpsn.c 3 */
+double simpsn( f, delta )
+double f[]; /* tabulated function */
+double delta; /* spacing of arguments */
+{
+extern double simcon[];
+double ans;
+int i;
+
+
+ans = simcon[NCOTE/2] * f[NCOTE/2];
+for( i=0; i < NCOTE/2; i++ )
+ ans += simcon[i] * ( f[i] + f[NCOTE-i] );
+
+return( ans * delta * NCOTE );
+}
diff --git a/libm/double/simq.c b/libm/double/simq.c
new file mode 100644
index 000000000..96d63e521
--- /dev/null
+++ b/libm/double/simq.c
@@ -0,0 +1,180 @@
+/* simq.c
+ *
+ * Solution of simultaneous linear equations AX = B
+ * by Gaussian elimination with partial pivoting
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double A[n*n], B[n], X[n];
+ * int n, flag;
+ * int IPS[];
+ * int simq();
+ *
+ * ercode = simq( A, B, X, n, flag, IPS );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * B, X, IPS are vectors of length n.
+ * A is an n x n matrix (i.e., a vector of length n*n),
+ * stored row-wise: that is, A(i,j) = A[ij],
+ * where ij = i*n + j, which is the transpose of the normal
+ * column-wise storage.
+ *
+ * The contents of matrix A are destroyed.
+ *
+ * Set flag=0 to solve.
+ * Set flag=-1 to do a new back substitution for different B vector
+ * using the same A matrix previously reduced when flag=0.
+ *
+ * The routine returns nonzero on error; messages are printed.
+ *
+ *
+ * ACCURACY:
+ *
+ * Depends on the conditioning (range of eigenvalues) of matrix A.
+ *
+ *
+ * REFERENCE:
+ *
+ * Computer Solution of Linear Algebraic Systems,
+ * by George E. Forsythe and Cleve B. Moler; Prentice-Hall, 1967.
+ *
+ */
+
+/* simq 2 */
+
+#include <stdio.h>
+#define fabs(x) ((x) < 0 ? -(x) : (x))
+
+int simq( A, B, X, n, flag, IPS )
+double A[], B[], X[];
+int n, flag;
+int IPS[];
+{
+int i, j, ij, ip, ipj, ipk, ipn;
+int idxpiv, iback;
+int k, kp, kp1, kpk, kpn;
+int nip, nkp, nm1;
+double em, q, rownrm, big, size, pivot, sum;
+
+nm1 = n-1;
+if( flag < 0 )
+ goto solve;
+
+/* Initialize IPS and X */
+
+ij=0;
+for( i=0; i<n; i++ )
+ {
+ IPS[i] = i;
+ rownrm = 0.0;
+ for( j=0; j<n; j++ )
+ {
+ q = fabs( A[ij] );
+ if( rownrm < q )
+ rownrm = q;
+ ++ij;
+ }
+ if( rownrm == 0.0 )
+ {
+ printf("SIMQ ROWNRM=0");
+ return(1);
+ }
+ X[i] = 1.0/rownrm;
+ }
+
+/* simq 3 */
+/* Gaussian elimination with partial pivoting */
+
+for( k=0; k<nm1; k++ )
+ {
+ big= 0.0;
+ idxpiv = 0;
+ for( i=k; i<n; i++ )
+ {
+ ip = IPS[i];
+ ipk = n*ip + k;
+ size = fabs( A[ipk] ) * X[ip];
+ if( size > big )
+ {
+ big = size;
+ idxpiv = i;
+ }
+ }
+
+ if( big == 0.0 )
+ {
+ printf( "SIMQ BIG=0" );
+ return(2);
+ }
+ if( idxpiv != k )
+ {
+ j = IPS[k];
+ IPS[k] = IPS[idxpiv];
+ IPS[idxpiv] = j;
+ }
+ kp = IPS[k];
+ kpk = n*kp + k;
+ pivot = A[kpk];
+ kp1 = k+1;
+ for( i=kp1; i<n; i++ )
+ {
+ ip = IPS[i];
+ ipk = n*ip + k;
+ em = -A[ipk]/pivot;
+ A[ipk] = -em;
+ nip = n*ip;
+ nkp = n*kp;
+ for( j=kp1; j<n; j++ )
+ {
+ ipj = nip + j;
+ A[ipj] = A[ipj] + em * A[nkp + j];
+ }
+ }
+ }
+kpn = n * IPS[n-1] + n - 1; /* last element of IPS[n] th row */
+if( A[kpn] == 0.0 )
+ {
+ printf( "SIMQ A[kpn]=0");
+ return(3);
+ }
+
+/* simq 4 */
+/* back substitution */
+
+solve:
+ip = IPS[0];
+X[0] = B[ip];
+for( i=1; i<n; i++ )
+ {
+ ip = IPS[i];
+ ipj = n * ip;
+ sum = 0.0;
+ for( j=0; j<i; j++ )
+ {
+ sum += A[ipj] * X[j];
+ ++ipj;
+ }
+ X[i] = B[ip] - sum;
+ }
+
+ipn = n * IPS[n-1] + n - 1;
+X[n-1] = X[n-1]/A[ipn];
+
+for( iback=1; iback<n; iback++ )
+ {
+/* i goes (n-1),...,1 */
+ i = nm1 - iback;
+ ip = IPS[i];
+ nip = n*ip;
+ sum = 0.0;
+ for( j=i+1; j<n; j++ )
+ sum += A[nip+j] * X[j];
+ X[i] = (X[i] - sum)/A[nip+i];
+ }
+return(0);
+}
diff --git a/libm/double/sin.c b/libm/double/sin.c
new file mode 100644
index 000000000..24746d79d
--- /dev/null
+++ b/libm/double/sin.c
@@ -0,0 +1,387 @@
+/* sin.c
+ *
+ * Circular sine
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, sin();
+ *
+ * y = sin( 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
+ * DEC 0, 10 150000 3.0e-17 7.8e-18
+ * IEEE -1.07e9,+1.07e9 130000 2.1e-16 5.4e-17
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * sin total loss x > 1.073741824e9 0.0
+ *
+ * Partial loss of accuracy begins to occur at x = 2**30
+ * = 1.074e9. The loss is not gradual, but jumps suddenly to
+ * about 1 part in 10e7. Results may be meaningless for
+ * x > 2**49 = 5.6e14. The routine as implemented flags a
+ * TLOSS error for x > 2**30 and returns 0.0.
+ */
+ /* cos.c
+ *
+ * Circular cosine
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, cos();
+ *
+ * y = cos( 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 -1.07e9,+1.07e9 130000 2.1e-16 5.4e-17
+ * DEC 0,+1.07e9 17000 3.0e-17 7.2e-18
+ */
+
+/* sin.c */
+
+/*
+Cephes Math Library Release 2.8: June, 2000
+Copyright 1985, 1995, 2000 by Stephen L. Moshier
+*/
+
+#include <math.h>
+
+#ifdef UNK
+static double sincof[] = {
+ 1.58962301576546568060E-10,
+-2.50507477628578072866E-8,
+ 2.75573136213857245213E-6,
+-1.98412698295895385996E-4,
+ 8.33333333332211858878E-3,
+-1.66666666666666307295E-1,
+};
+static double coscof[6] = {
+-1.13585365213876817300E-11,
+ 2.08757008419747316778E-9,
+-2.75573141792967388112E-7,
+ 2.48015872888517045348E-5,
+-1.38888888888730564116E-3,
+ 4.16666666666665929218E-2,
+};
+static double DP1 = 7.85398125648498535156E-1;
+static double DP2 = 3.77489470793079817668E-8;
+static double DP3 = 2.69515142907905952645E-15;
+/* static double lossth = 1.073741824e9; */
+#endif
+
+#ifdef DEC
+static unsigned short sincof[] = {
+0030056,0143750,0177214,0163153,
+0131727,0027455,0044510,0175352,
+0033470,0167432,0131752,0042414,
+0135120,0006400,0146776,0174027,
+0036410,0104210,0104207,0137202,
+0137452,0125252,0125252,0125103,
+};
+static unsigned short coscof[24] = {
+0127107,0151115,0002060,0152325,
+0031017,0072353,0155161,0174053,
+0132623,0171173,0172542,0057056,
+0034320,0006400,0147102,0023652,
+0135666,0005540,0133012,0076213,
+0037052,0125252,0125252,0125126,
+};
+/* 7.853981629014015197753906250000E-1 */
+static unsigned short P1[] = {0040111,0007732,0120000,0000000,};
+/* 4.960467869796758577649598009884E-10 */
+static unsigned short P2[] = {0030410,0055060,0100000,0000000,};
+/* 2.860594363054915898381331279295E-18 */
+static unsigned short P3[] = {0021523,0011431,0105056,0001560,};
+#define DP1 *(double *)P1
+#define DP2 *(double *)P2
+#define DP3 *(double *)P3
+#endif
+
+#ifdef IBMPC
+static unsigned short sincof[] = {
+0x9ccd,0x1fd1,0xd8fd,0x3de5,
+0x1f5d,0xa929,0xe5e5,0xbe5a,
+0x48a1,0x567d,0x1de3,0x3ec7,
+0xdf03,0x19bf,0x01a0,0xbf2a,
+0xf7d0,0x1110,0x1111,0x3f81,
+0x5548,0x5555,0x5555,0xbfc5,
+};
+static unsigned short coscof[24] = {
+0x1a9b,0xa086,0xfa49,0xbda8,
+0x3f05,0x7b4e,0xee9d,0x3e21,
+0x4bc6,0x7eac,0x7e4f,0xbe92,
+0x44f5,0x19c8,0x01a0,0x3efa,
+0x4f91,0x16c1,0xc16c,0xbf56,
+0x554b,0x5555,0x5555,0x3fa5,
+};
+/*
+ 7.85398125648498535156E-1,
+ 3.77489470793079817668E-8,
+ 2.69515142907905952645E-15,
+*/
+static unsigned short P1[] = {0x0000,0x4000,0x21fb,0x3fe9};
+static unsigned short P2[] = {0x0000,0x0000,0x442d,0x3e64};
+static unsigned short P3[] = {0x5170,0x98cc,0x4698,0x3ce8};
+#define DP1 *(double *)P1
+#define DP2 *(double *)P2
+#define DP3 *(double *)P3
+#endif
+
+#ifdef MIEEE
+static unsigned short sincof[] = {
+0x3de5,0xd8fd,0x1fd1,0x9ccd,
+0xbe5a,0xe5e5,0xa929,0x1f5d,
+0x3ec7,0x1de3,0x567d,0x48a1,
+0xbf2a,0x01a0,0x19bf,0xdf03,
+0x3f81,0x1111,0x1110,0xf7d0,
+0xbfc5,0x5555,0x5555,0x5548,
+};
+static unsigned short coscof[24] = {
+0xbda8,0xfa49,0xa086,0x1a9b,
+0x3e21,0xee9d,0x7b4e,0x3f05,
+0xbe92,0x7e4f,0x7eac,0x4bc6,
+0x3efa,0x01a0,0x19c8,0x44f5,
+0xbf56,0xc16c,0x16c1,0x4f91,
+0x3fa5,0x5555,0x5555,0x554b,
+};
+static unsigned short P1[] = {0x3fe9,0x21fb,0x4000,0x0000};
+static unsigned short P2[] = {0x3e64,0x442d,0x0000,0x0000};
+static unsigned short P3[] = {0x3ce8,0x4698,0x98cc,0x5170};
+#define DP1 *(double *)P1
+#define DP2 *(double *)P2
+#define DP3 *(double *)P3
+#endif
+
+#ifdef ANSIPROT
+extern double polevl ( double, void *, int );
+extern double p1evl ( double, void *, int );
+extern double floor ( double );
+extern double ldexp ( double, int );
+extern int isnan ( double );
+extern int isfinite ( double );
+#else
+double polevl(), floor(), ldexp();
+int isnan(), isfinite();
+#endif
+extern double PIO4;
+static double lossth = 1.073741824e9;
+#ifdef NANS
+extern double NAN;
+#endif
+#ifdef INFINITIES
+extern double INFINITY;
+#endif
+
+
+double sin(x)
+double x;
+{
+double y, z, zz;
+int j, sign;
+
+#ifdef MINUSZERO
+if( x == 0.0 )
+ return(x);
+#endif
+#ifdef NANS
+if( isnan(x) )
+ return(x);
+if( !isfinite(x) )
+ {
+ mtherr( "sin", DOMAIN );
+ return(NAN);
+ }
+#endif
+/* make argument positive but save the sign */
+sign = 1;
+if( x < 0 )
+ {
+ x = -x;
+ sign = -1;
+ }
+
+if( x > lossth )
+ {
+ mtherr( "sin", TLOSS );
+ return(0.0);
+ }
+
+y = floor( x/PIO4 ); /* integer part of x/PIO4 */
+
+/* strip high bits of integer part to prevent integer overflow */
+z = ldexp( y, -4 );
+z = floor(z); /* integer part of y/8 */
+z = y - ldexp( z, 4 ); /* y - 16 * (y/16) */
+
+j = z; /* convert to integer for tests on the phase angle */
+/* map zeros to origin */
+if( j & 1 )
+ {
+ j += 1;
+ y += 1.0;
+ }
+j = j & 07; /* octant modulo 360 degrees */
+/* reflect in x axis */
+if( j > 3)
+ {
+ sign = -sign;
+ j -= 4;
+ }
+
+/* Extended precision modular arithmetic */
+z = ((x - y * DP1) - y * DP2) - y * DP3;
+
+zz = z * z;
+
+if( (j==1) || (j==2) )
+ {
+ y = 1.0 - ldexp(zz,-1) + zz * zz * polevl( zz, coscof, 5 );
+ }
+else
+ {
+/* y = z + z * (zz * polevl( zz, sincof, 5 ));*/
+ y = z + z * z * z * polevl( zz, sincof, 5 );
+ }
+
+if(sign < 0)
+ y = -y;
+
+return(y);
+}
+
+
+
+
+
+double cos(x)
+double x;
+{
+double y, z, zz;
+long i;
+int j, sign;
+
+#ifdef NANS
+if( isnan(x) )
+ return(x);
+if( !isfinite(x) )
+ {
+ mtherr( "cos", DOMAIN );
+ return(NAN);
+ }
+#endif
+
+/* make argument positive */
+sign = 1;
+if( x < 0 )
+ x = -x;
+
+if( x > lossth )
+ {
+ mtherr( "cos", TLOSS );
+ return(0.0);
+ }
+
+y = floor( x/PIO4 );
+z = ldexp( y, -4 );
+z = floor(z); /* integer part of y/8 */
+z = y - ldexp( z, 4 ); /* y - 16 * (y/16) */
+
+/* integer and fractional part modulo one octant */
+i = z;
+if( i & 1 ) /* map zeros to origin */
+ {
+ i += 1;
+ y += 1.0;
+ }
+j = i & 07;
+if( j > 3)
+ {
+ j -=4;
+ sign = -sign;
+ }
+
+if( j > 1 )
+ sign = -sign;
+
+/* Extended precision modular arithmetic */
+z = ((x - y * DP1) - y * DP2) - y * DP3;
+
+zz = z * z;
+
+if( (j==1) || (j==2) )
+ {
+/* y = z + z * (zz * polevl( zz, sincof, 5 ));*/
+ y = z + z * z * z * polevl( zz, sincof, 5 );
+ }
+else
+ {
+ y = 1.0 - ldexp(zz,-1) + zz * zz * polevl( zz, coscof, 5 );
+ }
+
+if(sign < 0)
+ y = -y;
+
+return(y);
+}
+
+
+
+
+
+/* Degrees, minutes, seconds to radians: */
+
+/* 1 arc second, in radians = 4.8481368110953599358991410e-5 */
+#ifdef DEC
+static unsigned short P648[] = {034513,054170,0176773,0116043,};
+#define P64800 *(double *)P648
+#else
+static double P64800 = 4.8481368110953599358991410e-5;
+#endif
+
+double radian(d,m,s)
+double d,m,s;
+{
+
+return( ((d*60.0 + m)*60.0 + s)*P64800 );
+}
diff --git a/libm/double/sincos.c b/libm/double/sincos.c
new file mode 100644
index 000000000..8a4a3784c
--- /dev/null
+++ b/libm/double/sincos.c
@@ -0,0 +1,364 @@
+/* sincos.c
+ *
+ * Circular sine and cosine of argument in degrees
+ * Table lookup and interpolation algorithm
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, sine, cosine, flg, sincos();
+ *
+ * sincos( x, &sine, &cosine, flg );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns both the sine and the cosine of the argument x.
+ * Several different compile time options and minimax
+ * approximations are supplied to permit tailoring the
+ * tradeoff between computation speed and accuracy.
+ *
+ * Since range reduction is time consuming, the reduction
+ * of x modulo 360 degrees is also made optional.
+ *
+ * sin(i) is internally tabulated for 0 <= i <= 90 degrees.
+ * Approximation polynomials, ranging from linear interpolation
+ * to cubics in (x-i)**2, compute the sine and cosine
+ * of the residual x-i which is between -0.5 and +0.5 degree.
+ * In the case of the high accuracy options, the residual
+ * and the tabulated values are combined using the trigonometry
+ * formulas for sin(A+B) and cos(A+B).
+ *
+ * Compile time options are supplied for 5, 11, or 17 decimal
+ * relative accuracy (ACC5, ACC11, ACC17 respectively).
+ * A subroutine flag argument "flg" chooses betwen this
+ * accuracy and table lookup only (peak absolute error
+ * = 0.0087).
+ *
+ * If the argument flg = 1, then the tabulated value is
+ * returned for the nearest whole number of degrees. The
+ * approximation polynomials are not computed. At
+ * x = 0.5 deg, the absolute error is then sin(0.5) = 0.0087.
+ *
+ * An intermediate speed and precision can be obtained using
+ * the compile time option LINTERP and flg = 1. This yields
+ * a linear interpolation using a slope estimated from the sine
+ * or cosine at the nearest integer argument. The peak absolute
+ * error with this option is 3.8e-5. Relative error at small
+ * angles is about 1e-5.
+ *
+ * If flg = 0, then the approximation polynomials are computed
+ * and applied.
+ *
+ *
+ *
+ * SPEED:
+ *
+ * Relative speed comparisons follow for 6MHz IBM AT clone
+ * and Microsoft C version 4.0. These figures include
+ * software overhead of do loop and function calls.
+ * Since system hardware and software vary widely, the
+ * numbers should be taken as representative only.
+ *
+ * flg=0 flg=0 flg=1 flg=1
+ * ACC11 ACC5 LINTERP Lookup only
+ * In-line 8087 (/FPi)
+ * sin(), cos() 1.0 1.0 1.0 1.0
+ *
+ * In-line 8087 (/FPi)
+ * sincos() 1.1 1.4 1.9 3.0
+ *
+ * Software (/FPa)
+ * sin(), cos() 0.19 0.19 0.19 0.19
+ *
+ * Software (/FPa)
+ * sincos() 0.39 0.50 0.73 1.7
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * The accurate approximations are designed with a relative error
+ * criterion. The absolute error is greatest at x = 0.5 degree.
+ * It decreases from a local maximum at i+0.5 degrees to full
+ * machine precision at each integer i degrees. With the
+ * ACC5 option, the relative error of 6.3e-6 is equivalent to
+ * an absolute angular error of 0.01 arc second in the argument
+ * at x = i+0.5 degrees. For small angles < 0.5 deg, the ACC5
+ * accuracy is 6.3e-6 (.00063%) of reading; i.e., the absolute
+ * error decreases in proportion to the argument. This is true
+ * for both the sine and cosine approximations, since the latter
+ * is for the function 1 - cos(x).
+ *
+ * If absolute error is of most concern, use the compile time
+ * option ABSERR to obtain an absolute error of 2.7e-8 for ACC5
+ * precision. This is about half the absolute error of the
+ * relative precision option. In this case the relative error
+ * for small angles will increase to 9.5e-6 -- a reasonable
+ * tradeoff.
+ */
+
+
+#include <math.h>
+
+/* Define one of the following to be 1:
+ */
+#define ACC5 1
+#define ACC11 0
+#define ACC17 0
+
+/* Option for linear interpolation when flg = 1
+ */
+#define LINTERP 1
+
+/* Option for absolute error criterion
+ */
+#define ABSERR 1
+
+/* Option to include modulo 360 function:
+ */
+#define MOD360 0
+
+/*
+Cephes Math Library Release 2.1
+Copyright 1987 by Stephen L. Moshier
+Direct inquiries to 30 Frost Street, Cambridge, MA 02140
+*/
+
+
+/* Table of sin(i degrees)
+ * for 0 <= i <= 90
+ */
+static double sintbl[92] = {
+ 0.00000000000000000000E0,
+ 1.74524064372835128194E-2,
+ 3.48994967025009716460E-2,
+ 5.23359562429438327221E-2,
+ 6.97564737441253007760E-2,
+ 8.71557427476581735581E-2,
+ 1.04528463267653471400E-1,
+ 1.21869343405147481113E-1,
+ 1.39173100960065444112E-1,
+ 1.56434465040230869010E-1,
+ 1.73648177666930348852E-1,
+ 1.90808995376544812405E-1,
+ 2.07911690817759337102E-1,
+ 2.24951054343864998051E-1,
+ 2.41921895599667722560E-1,
+ 2.58819045102520762349E-1,
+ 2.75637355816999185650E-1,
+ 2.92371704722736728097E-1,
+ 3.09016994374947424102E-1,
+ 3.25568154457156668714E-1,
+ 3.42020143325668733044E-1,
+ 3.58367949545300273484E-1,
+ 3.74606593415912035415E-1,
+ 3.90731128489273755062E-1,
+ 4.06736643075800207754E-1,
+ 4.22618261740699436187E-1,
+ 4.38371146789077417453E-1,
+ 4.53990499739546791560E-1,
+ 4.69471562785890775959E-1,
+ 4.84809620246337029075E-1,
+ 5.00000000000000000000E-1,
+ 5.15038074910054210082E-1,
+ 5.29919264233204954047E-1,
+ 5.44639035015027082224E-1,
+ 5.59192903470746830160E-1,
+ 5.73576436351046096108E-1,
+ 5.87785252292473129169E-1,
+ 6.01815023152048279918E-1,
+ 6.15661475325658279669E-1,
+ 6.29320391049837452706E-1,
+ 6.42787609686539326323E-1,
+ 6.56059028990507284782E-1,
+ 6.69130606358858213826E-1,
+ 6.81998360062498500442E-1,
+ 6.94658370458997286656E-1,
+ 7.07106781186547524401E-1,
+ 7.19339800338651139356E-1,
+ 7.31353701619170483288E-1,
+ 7.43144825477394235015E-1,
+ 7.54709580222771997943E-1,
+ 7.66044443118978035202E-1,
+ 7.77145961456970879980E-1,
+ 7.88010753606721956694E-1,
+ 7.98635510047292846284E-1,
+ 8.09016994374947424102E-1,
+ 8.19152044288991789684E-1,
+ 8.29037572555041692006E-1,
+ 8.38670567945424029638E-1,
+ 8.48048096156425970386E-1,
+ 8.57167300702112287465E-1,
+ 8.66025403784438646764E-1,
+ 8.74619707139395800285E-1,
+ 8.82947592858926942032E-1,
+ 8.91006524188367862360E-1,
+ 8.98794046299166992782E-1,
+ 9.06307787036649963243E-1,
+ 9.13545457642600895502E-1,
+ 9.20504853452440327397E-1,
+ 9.27183854566787400806E-1,
+ 9.33580426497201748990E-1,
+ 9.39692620785908384054E-1,
+ 9.45518575599316810348E-1,
+ 9.51056516295153572116E-1,
+ 9.56304755963035481339E-1,
+ 9.61261695938318861916E-1,
+ 9.65925826289068286750E-1,
+ 9.70295726275996472306E-1,
+ 9.74370064785235228540E-1,
+ 9.78147600733805637929E-1,
+ 9.81627183447663953497E-1,
+ 9.84807753012208059367E-1,
+ 9.87688340595137726190E-1,
+ 9.90268068741570315084E-1,
+ 9.92546151641322034980E-1,
+ 9.94521895368273336923E-1,
+ 9.96194698091745532295E-1,
+ 9.97564050259824247613E-1,
+ 9.98629534754573873784E-1,
+ 9.99390827019095730006E-1,
+ 9.99847695156391239157E-1,
+ 1.00000000000000000000E0,
+ 9.99847695156391239157E-1,
+};
+
+#ifdef ANSIPROT
+double floor ( double );
+#else
+double floor();
+#endif
+
+int sincos(x, s, c, flg)
+double x;
+double *s, *c;
+int flg;
+{
+int ix, ssign, csign, xsign;
+double y, z, sx, sz, cx, cz;
+
+/* Make argument nonnegative.
+ */
+xsign = 1;
+if( x < 0.0 )
+ {
+ xsign = -1;
+ x = -x;
+ }
+
+
+#if MOD360
+x = x - 360.0 * floor( x/360.0 );
+#endif
+
+/* Find nearest integer to x.
+ * Note there should be a domain error test here,
+ * but this is omitted to gain speed.
+ */
+ix = x + 0.5;
+z = x - ix; /* the residual */
+
+/* Look up the sine and cosine of the integer.
+ */
+if( ix <= 180 )
+ {
+ ssign = 1;
+ csign = 1;
+ }
+else
+ {
+ ssign = -1;
+ csign = -1;
+ ix -= 180;
+ }
+
+if( ix > 90 )
+ {
+ csign = -csign;
+ ix = 180 - ix;
+ }
+
+sx = sintbl[ix];
+if( ssign < 0 )
+ sx = -sx;
+cx = sintbl[ 90-ix ];
+if( csign < 0 )
+ cx = -cx;
+
+/* If the flag argument is set, then just return
+ * the tabulated values for arg to the nearest whole degree.
+ */
+if( flg )
+ {
+#if LINTERP
+ y = sx + 1.74531263774940077459e-2 * z * cx;
+ cx -= 1.74531263774940077459e-2 * z * sx;
+ sx = y;
+#endif
+ if( xsign < 0 )
+ sx = -sx;
+ *s = sx; /* sine */
+ *c = cx; /* cosine */
+ return 0;
+ }
+
+
+if( ssign < 0 )
+ sx = -sx;
+if( csign < 0 )
+ cx = -cx;
+
+/* Find sine and cosine
+ * of the residual angle between -0.5 and +0.5 degree.
+ */
+#if ACC5
+#if ABSERR
+/* absolute error = 2.769e-8: */
+sz = 1.74531263774940077459e-2 * z;
+/* absolute error = 4.146e-11: */
+cz = 1.0 - 1.52307909153324666207e-4 * z * z;
+#else
+/* relative error = 6.346e-6: */
+sz = 1.74531817576426662296e-2 * z;
+/* relative error = 3.173e-6: */
+cz = 1.0 - 1.52308226602566149927e-4 * z * z;
+#endif
+#else
+y = z * z;
+#endif
+
+
+#if ACC11
+sz = ( -8.86092781698004819918e-7 * y
+ + 1.74532925198378577601e-2 ) * z;
+
+cz = 1.0 - ( -3.86631403698859047896e-9 * y
+ + 1.52308709893047593702e-4 ) * y;
+#endif
+
+
+#if ACC17
+sz = (( 1.34959795251974073996e-11 * y
+ - 8.86096155697856783296e-7 ) * y
+ + 1.74532925199432957214e-2 ) * z;
+
+cz = 1.0 - (( 3.92582397764340914444e-14 * y
+ - 3.86632385155548605680e-9 ) * y
+ + 1.52308709893354299569e-4 ) * y;
+#endif
+
+
+/* Combine the tabulated part and the calculated part
+ * by trigonometry.
+ */
+y = sx * cz + cx * sz;
+if( xsign < 0 )
+ y = - y;
+*s = y; /* sine */
+
+*c = cx * cz - sx * sz; /* cosine */
+return 0;
+}
diff --git a/libm/double/sindg.c b/libm/double/sindg.c
new file mode 100644
index 000000000..8057ab68d
--- /dev/null
+++ b/libm/double/sindg.c
@@ -0,0 +1,308 @@
+/* sindg.c
+ *
+ * Circular sine of angle in degrees
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, sindg();
+ *
+ * y = sindg( 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 P(x**2).
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * DEC +-1000 3100 3.3e-17 9.0e-18
+ * IEEE +-1000 30000 2.3e-16 5.6e-17
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * sindg total loss x > 8.0e14 (DEC) 0.0
+ * x > 1.0e14 (IEEE)
+ *
+ */
+ /* cosdg.c
+ *
+ * Circular cosine of angle in degrees
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, cosdg();
+ *
+ * y = cosdg( 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 P(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
+ * DEC +-1000 3400 3.5e-17 9.1e-18
+ * IEEE +-1000 30000 2.1e-16 5.7e-17
+ * See also sin().
+ *
+ */
+
+/* Cephes Math Library Release 2.0: April, 1987
+ * Copyright 1985, 1987 by Stephen L. Moshier
+ * Direct inquiries to 30 Frost Street, Cambridge, MA 02140 */
+
+#include <math.h>
+
+#ifdef UNK
+static double sincof[] = {
+ 1.58962301572218447952E-10,
+-2.50507477628503540135E-8,
+ 2.75573136213856773549E-6,
+-1.98412698295895384658E-4,
+ 8.33333333332211858862E-3,
+-1.66666666666666307295E-1
+};
+static double coscof[] = {
+ 1.13678171382044553091E-11,
+-2.08758833757683644217E-9,
+ 2.75573155429816611547E-7,
+-2.48015872936186303776E-5,
+ 1.38888888888806666760E-3,
+-4.16666666666666348141E-2,
+ 4.99999999999999999798E-1
+};
+static double PI180 = 1.74532925199432957692E-2; /* pi/180 */
+static double lossth = 1.0e14;
+#endif
+
+#ifdef DEC
+static unsigned short sincof[] = {
+0030056,0143750,0177170,0073013,
+0131727,0027455,0044510,0132205,
+0033470,0167432,0131752,0042263,
+0135120,0006400,0146776,0174027,
+0036410,0104210,0104207,0137202,
+0137452,0125252,0125252,0125103
+};
+static unsigned short coscof[] = {
+0027107,0176030,0153315,0110312,
+0131017,0072476,0007450,0123243,
+0032623,0171174,0070066,0146445,
+0134320,0006400,0147355,0163313,
+0035666,0005540,0133012,0165067,
+0137052,0125252,0125252,0125206,
+0040000,0000000,0000000,0000000
+};
+static unsigned short P1[] = {0036616,0175065,0011224,0164711};
+#define PI180 *(double *)P1
+static double lossth = 8.0e14;
+#endif
+
+#ifdef IBMPC
+static unsigned short sincof[] = {
+0x0ec1,0x1fcf,0xd8fd,0x3de5,
+0x1691,0xa929,0xe5e5,0xbe5a,
+0x4896,0x567d,0x1de3,0x3ec7,
+0xdf03,0x19bf,0x01a0,0xbf2a,
+0xf7d0,0x1110,0x1111,0x3f81,
+0x5548,0x5555,0x5555,0xbfc5
+};
+static unsigned short coscof[] = {
+0xb219,0x1ad9,0xff83,0x3da8,
+0x14d4,0xc1e5,0xeea7,0xbe21,
+0xd9a5,0x8e06,0x7e4f,0x3e92,
+0xbcd9,0x19dd,0x01a0,0xbefa,
+0x5d47,0x16c1,0xc16c,0x3f56,
+0x5551,0x5555,0x5555,0xbfa5,
+0x0000,0x0000,0x0000,0x3fe0
+};
+
+static unsigned short P1[] = {0x9d39,0xa252,0xdf46,0x3f91};
+#define PI180 *(double *)P1
+static double lossth = 1.0e14;
+#endif
+
+#ifdef MIEEE
+static unsigned short sincof[] = {
+0x3de5,0xd8fd,0x1fcf,0x0ec1,
+0xbe5a,0xe5e5,0xa929,0x1691,
+0x3ec7,0x1de3,0x567d,0x4896,
+0xbf2a,0x01a0,0x19bf,0xdf03,
+0x3f81,0x1111,0x1110,0xf7d0,
+0xbfc5,0x5555,0x5555,0x5548
+};
+static unsigned short coscof[] = {
+0x3da8,0xff83,0x1ad9,0xb219,
+0xbe21,0xeea7,0xc1e5,0x14d4,
+0x3e92,0x7e4f,0x8e06,0xd9a5,
+0xbefa,0x01a0,0x19dd,0xbcd9,
+0x3f56,0xc16c,0x16c1,0x5d47,
+0xbfa5,0x5555,0x5555,0x5551,
+0x3fe0,0x0000,0x0000,0x0000
+};
+
+static unsigned short P1[] = {
+0x3f91,0xdf46,0xa252,0x9d39
+};
+#define PI180 *(double *)P1
+static double lossth = 1.0e14;
+#endif
+
+#ifdef ANSIPROT
+extern double polevl ( double, void *, int );
+extern double floor ( double );
+extern double ldexp ( double, int );
+#else
+double polevl(), floor(), ldexp();
+#endif
+extern double PIO4;
+
+double sindg(x)
+double x;
+{
+double y, z, zz;
+int j, sign;
+
+/* make argument positive but save the sign */
+sign = 1;
+if( x < 0 )
+ {
+ x = -x;
+ sign = -1;
+ }
+
+if( x > lossth )
+ {
+ mtherr( "sindg", TLOSS );
+ return(0.0);
+ }
+
+y = floor( x/45.0 ); /* integer part of x/PIO4 */
+
+/* strip high bits of integer part to prevent integer overflow */
+z = ldexp( y, -4 );
+z = floor(z); /* integer part of y/8 */
+z = y - ldexp( z, 4 ); /* y - 16 * (y/16) */
+
+j = z; /* convert to integer for tests on the phase angle */
+/* map zeros to origin */
+if( j & 1 )
+ {
+ j += 1;
+ y += 1.0;
+ }
+j = j & 07; /* octant modulo 360 degrees */
+/* reflect in x axis */
+if( j > 3)
+ {
+ sign = -sign;
+ j -= 4;
+ }
+
+z = x - y * 45.0; /* x mod 45 degrees */
+z *= PI180; /* multiply by pi/180 to convert to radians */
+zz = z * z;
+
+if( (j==1) || (j==2) )
+ {
+ y = 1.0 - zz * polevl( zz, coscof, 6 );
+ }
+else
+ {
+ y = z + z * (zz * polevl( zz, sincof, 5 ));
+ }
+
+if(sign < 0)
+ y = -y;
+
+return(y);
+}
+
+
+
+
+
+double cosdg(x)
+double x;
+{
+double y, z, zz;
+int j, sign;
+
+/* make argument positive */
+sign = 1;
+if( x < 0 )
+ x = -x;
+
+if( x > lossth )
+ {
+ mtherr( "cosdg", TLOSS );
+ return(0.0);
+ }
+
+y = floor( x/45.0 );
+z = ldexp( y, -4 );
+z = floor(z); /* integer part of y/8 */
+z = y - ldexp( z, 4 ); /* y - 16 * (y/16) */
+
+/* integer and fractional part modulo one octant */
+j = z;
+if( j & 1 ) /* map zeros to origin */
+ {
+ j += 1;
+ y += 1.0;
+ }
+j = j & 07;
+if( j > 3)
+ {
+ j -=4;
+ sign = -sign;
+ }
+
+if( j > 1 )
+ sign = -sign;
+
+z = x - y * 45.0; /* x mod 45 degrees */
+z *= PI180; /* multiply by pi/180 to convert to radians */
+
+zz = z * z;
+
+if( (j==1) || (j==2) )
+ {
+ y = z + z * (zz * polevl( zz, sincof, 5 ));
+ }
+else
+ {
+ y = 1.0 - zz * polevl( zz, coscof, 6 );
+ }
+
+if(sign < 0)
+ y = -y;
+
+return(y);
+}
diff --git a/libm/double/sinh.c b/libm/double/sinh.c
new file mode 100644
index 000000000..545bd6826
--- /dev/null
+++ b/libm/double/sinh.c
@@ -0,0 +1,148 @@
+/* sinh.c
+ *
+ * Hyperbolic sine
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, sinh();
+ *
+ * y = sinh( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns hyperbolic sine of argument in the range MINLOG to
+ * MAXLOG.
+ *
+ * The range is partitioned into two segments. If |x| <= 1, a
+ * rational function of the form x + x**3 P(x)/Q(x) is employed.
+ * Otherwise the calculation is sinh(x) = ( exp(x) - exp(-x) )/2.
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * DEC +- 88 50000 4.0e-17 7.7e-18
+ * IEEE +-MAXLOG 30000 2.6e-16 5.7e-17
+ *
+ */
+
+/*
+Cephes Math Library Release 2.8: June, 2000
+Copyright 1984, 1995, 2000 by Stephen L. Moshier
+*/
+
+#include <math.h>
+
+#ifdef UNK
+static double P[] = {
+-7.89474443963537015605E-1,
+-1.63725857525983828727E2,
+-1.15614435765005216044E4,
+-3.51754964808151394800E5
+};
+static double Q[] = {
+/* 1.00000000000000000000E0,*/
+-2.77711081420602794433E2,
+ 3.61578279834431989373E4,
+-2.11052978884890840399E6
+};
+#endif
+
+#ifdef DEC
+static unsigned short P[] = {
+0140112,0015377,0042731,0163255,
+0142043,0134721,0146177,0123761,
+0143464,0122706,0034353,0006017,
+0144653,0140536,0157665,0054045
+};
+static unsigned short Q[] = {
+/*0040200,0000000,0000000,0000000,*/
+0142212,0155404,0133513,0022040,
+0044015,0036723,0173271,0011053,
+0145400,0150407,0023710,0001034
+};
+#endif
+
+#ifdef IBMPC
+static unsigned short P[] = {
+0x3cd6,0xe8bb,0x435f,0xbfe9,
+0xf4fe,0x398f,0x773a,0xc064,
+0x6182,0xc71d,0x94b8,0xc0c6,
+0xab05,0xdbf6,0x782b,0xc115
+};
+static unsigned short Q[] = {
+/*0x0000,0x0000,0x0000,0x3ff0,*/
+0x6484,0x96e9,0x5b60,0xc071,
+0x2245,0x7ed7,0xa7ba,0x40e1,
+0x0044,0xe4f9,0x1a20,0xc140
+};
+#endif
+
+#ifdef MIEEE
+static unsigned short P[] = {
+0xbfe9,0x435f,0xe8bb,0x3cd6,
+0xc064,0x773a,0x398f,0xf4fe,
+0xc0c6,0x94b8,0xc71d,0x6182,
+0xc115,0x782b,0xdbf6,0xab05
+};
+static unsigned short Q[] = {
+0xc071,0x5b60,0x96e9,0x6484,
+0x40e1,0xa7ba,0x7ed7,0x2245,
+0xc140,0x1a20,0xe4f9,0x0044
+};
+#endif
+
+#ifdef ANSIPROT
+extern double fabs ( double );
+extern double exp ( double );
+extern double polevl ( double, void *, int );
+extern double p1evl ( double, void *, int );
+#else
+double fabs(), exp(), polevl(), p1evl();
+#endif
+extern double INFINITY, MINLOG, MAXLOG, LOGE2;
+
+double sinh(x)
+double x;
+{
+double a;
+
+#ifdef MINUSZERO
+if( x == 0.0 )
+ return(x);
+#endif
+a = fabs(x);
+if( (x > (MAXLOG + LOGE2)) || (x > -(MINLOG-LOGE2) ) )
+ {
+ mtherr( "sinh", DOMAIN );
+ if( x > 0 )
+ return( INFINITY );
+ else
+ return( -INFINITY );
+ }
+if( a > 1.0 )
+ {
+ if( a >= (MAXLOG - LOGE2) )
+ {
+ a = exp(0.5*a);
+ a = (0.5 * a) * a;
+ if( x < 0 )
+ a = -a;
+ return(a);
+ }
+ a = exp(a);
+ a = 0.5*a - (0.5/a);
+ if( x < 0 )
+ a = -a;
+ return(a);
+ }
+
+a *= a;
+return( x + x * a * (polevl(a,P,3)/p1evl(a,Q,3)) );
+}
diff --git a/libm/double/spence.c b/libm/double/spence.c
new file mode 100644
index 000000000..e2a56176b
--- /dev/null
+++ b/libm/double/spence.c
@@ -0,0 +1,205 @@
+/* spence.c
+ *
+ * Dilogarithm
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, spence();
+ *
+ * y = spence( 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 3.9e-15 5.4e-16
+ * DEC 0,4 3000 2.5e-16 4.5e-17
+ *
+ *
+ */
+
+/* spence.c */
+
+
+/*
+Cephes Math Library Release 2.8: June, 2000
+Copyright 1985, 1987, 1989, 2000 by Stephen L. Moshier
+*/
+
+#include <math.h>
+
+#ifdef UNK
+static double A[8] = {
+ 4.65128586073990045278E-5,
+ 7.31589045238094711071E-3,
+ 1.33847639578309018650E-1,
+ 8.79691311754530315341E-1,
+ 2.71149851196553469920E0,
+ 4.25697156008121755724E0,
+ 3.29771340985225106936E0,
+ 1.00000000000000000126E0,
+};
+static double B[8] = {
+ 6.90990488912553276999E-4,
+ 2.54043763932544379113E-2,
+ 2.82974860602568089943E-1,
+ 1.41172597751831069617E0,
+ 3.63800533345137075418E0,
+ 5.03278880143316990390E0,
+ 3.54771340985225096217E0,
+ 9.99999999999999998740E-1,
+};
+#endif
+#ifdef DEC
+static unsigned short A[32] = {
+0034503,0013315,0034120,0157771,
+0036357,0135043,0016766,0150637,
+0037411,0007533,0005212,0161475,
+0040141,0031563,0023217,0120331,
+0040455,0104461,0007002,0155522,
+0040610,0034434,0065721,0120465,
+0040523,0006674,0105671,0054427,
+0040200,0000000,0000000,0000000,
+};
+static unsigned short B[32] = {
+0035465,0021626,0032367,0144157,
+0036720,0016326,0134431,0000406,
+0037620,0161024,0133701,0120766,
+0040264,0131557,0152055,0064512,
+0040550,0152424,0051166,0034272,
+0040641,0006233,0014672,0111572,
+0040543,0006674,0105671,0054425,
+0040200,0000000,0000000,0000000,
+};
+#endif
+#ifdef IBMPC
+static unsigned short A[32] = {
+0x1bff,0xa70a,0x62d9,0x3f08,
+0xda34,0x63be,0xf744,0x3f7d,
+0x5c68,0x6151,0x21eb,0x3fc1,
+0xf41b,0x64d1,0x266e,0x3fec,
+0x5b6a,0x21c0,0xb126,0x4005,
+0x3427,0x8d7a,0x0723,0x4011,
+0x2b23,0x9177,0x61b7,0x400a,
+0x0000,0x0000,0x0000,0x3ff0,
+};
+static unsigned short B[32] = {
+0xf90e,0xc69e,0xa472,0x3f46,
+0x2021,0xd723,0x039a,0x3f9a,
+0x343f,0x96f8,0x1c42,0x3fd2,
+0xad29,0xfa85,0x966d,0x3ff6,
+0xc717,0x8a4e,0x1aa2,0x400d,
+0x526f,0x6337,0x2193,0x4014,
+0x2b23,0x9177,0x61b7,0x400c,
+0x0000,0x0000,0x0000,0x3ff0,
+};
+#endif
+#ifdef MIEEE
+static unsigned short A[32] = {
+0x3f08,0x62d9,0xa70a,0x1bff,
+0x3f7d,0xf744,0x63be,0xda34,
+0x3fc1,0x21eb,0x6151,0x5c68,
+0x3fec,0x266e,0x64d1,0xf41b,
+0x4005,0xb126,0x21c0,0x5b6a,
+0x4011,0x0723,0x8d7a,0x3427,
+0x400a,0x61b7,0x9177,0x2b23,
+0x3ff0,0x0000,0x0000,0x0000,
+};
+static unsigned short B[32] = {
+0x3f46,0xa472,0xc69e,0xf90e,
+0x3f9a,0x039a,0xd723,0x2021,
+0x3fd2,0x1c42,0x96f8,0x343f,
+0x3ff6,0x966d,0xfa85,0xad29,
+0x400d,0x1aa2,0x8a4e,0xc717,
+0x4014,0x2193,0x6337,0x526f,
+0x400c,0x61b7,0x9177,0x2b23,
+0x3ff0,0x0000,0x0000,0x0000,
+};
+#endif
+
+#ifdef ANSIPROT
+extern double fabs ( double );
+extern double log ( double );
+extern double polevl ( double, void *, int );
+#else
+double fabs(), log(), polevl();
+#endif
+extern double PI, MACHEP;
+
+double spence(x)
+double x;
+{
+double w, y, z;
+int flag;
+
+if( x < 0.0 )
+ {
+ mtherr( "spence", DOMAIN );
+ return(0.0);
+ }
+
+if( x == 1.0 )
+ return( 0.0 );
+
+if( x == 0.0 )
+ return( PI*PI/6.0 );
+
+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 * polevl( w, A, 7) / polevl( w, B, 7 );
+
+if( flag & 1 )
+ y = (PI * PI)/6.0 - log(x) * log(1.0-x) - y;
+
+if( flag & 2 )
+ {
+ z = log(x);
+ y = -0.5 * z * z - y;
+ }
+
+return( y );
+}
diff --git a/libm/double/sqrt.c b/libm/double/sqrt.c
new file mode 100644
index 000000000..92bbce53b
--- /dev/null
+++ b/libm/double/sqrt.c
@@ -0,0 +1,178 @@
+/* sqrt.c
+ *
+ * Square root
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, sqrt();
+ *
+ * y = sqrt( 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
+ * DEC 0, 10 60000 2.1e-17 7.9e-18
+ * IEEE 0,1.7e308 30000 1.7e-16 6.3e-17
+ *
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * sqrt domain x < 0 0.0
+ *
+ */
+
+/*
+Cephes Math Library Release 2.8: June, 2000
+Copyright 1984, 1987, 1988, 2000 by Stephen L. Moshier
+*/
+
+
+#include <math.h>
+#ifdef ANSIPROT
+extern double frexp ( double, int * );
+extern double ldexp ( double, int );
+#else
+double frexp(), ldexp();
+#endif
+extern double SQRT2; /* SQRT2 = 1.41421356237309504880 */
+
+double sqrt(x)
+double x;
+{
+int e;
+#ifndef UNK
+short *q;
+#endif
+double z, w;
+
+if( x <= 0.0 )
+ {
+ if( x < 0.0 )
+ mtherr( "sqrt", DOMAIN );
+ return( 0.0 );
+ }
+w = x;
+/* separate exponent and significand */
+#ifdef UNK
+z = frexp( x, &e );
+#endif
+#ifdef DEC
+q = (short *)&x;
+e = ((*q >> 7) & 0377) - 0200;
+*q &= 0177;
+*q |= 040000;
+z = x;
+#endif
+
+/* Note, frexp and ldexp are used in order to
+ * handle denormal numbers properly.
+ */
+#ifdef IBMPC
+z = frexp( x, &e );
+q = (short *)&x;
+q += 3;
+/*
+e = ((*q >> 4) & 0x0fff) - 0x3fe;
+*q &= 0x000f;
+*q |= 0x3fe0;
+z = x;
+*/
+#endif
+#ifdef MIEEE
+z = frexp( x, &e );
+q = (short *)&x;
+/*
+e = ((*q >> 4) & 0x0fff) - 0x3fe;
+*q &= 0x000f;
+*q |= 0x3fe0;
+z = x;
+*/
+#endif
+
+/* approximate square root of number between 0.5 and 1
+ * relative error of approximation = 7.47e-3
+ */
+x = 4.173075996388649989089E-1 + 5.9016206709064458299663E-1 * z;
+
+/* adjust for odd powers of 2 */
+if( (e & 1) != 0 )
+ x *= SQRT2;
+
+/* re-insert exponent */
+#ifdef UNK
+x = ldexp( x, (e >> 1) );
+#endif
+#ifdef DEC
+*q += ((e >> 1) & 0377) << 7;
+*q &= 077777;
+#endif
+#ifdef IBMPC
+x = ldexp( x, (e >> 1) );
+/*
+*q += ((e >>1) & 0x7ff) << 4;
+*q &= 077777;
+*/
+#endif
+#ifdef MIEEE
+x = ldexp( x, (e >> 1) );
+/*
+*q += ((e >>1) & 0x7ff) << 4;
+*q &= 077777;
+*/
+#endif
+
+/* Newton iterations: */
+#ifdef UNK
+x = 0.5*(x + w/x);
+x = 0.5*(x + w/x);
+x = 0.5*(x + w/x);
+#endif
+
+/* Note, assume the square root cannot be denormal,
+ * so it is safe to use integer exponent operations here.
+ */
+#ifdef DEC
+x += w/x;
+*q -= 0200;
+x += w/x;
+*q -= 0200;
+x += w/x;
+*q -= 0200;
+#endif
+#ifdef IBMPC
+x += w/x;
+*q -= 0x10;
+x += w/x;
+*q -= 0x10;
+x += w/x;
+*q -= 0x10;
+#endif
+#ifdef MIEEE
+x += w/x;
+*q -= 0x10;
+x += w/x;
+*q -= 0x10;
+x += w/x;
+*q -= 0x10;
+#endif
+
+return(x);
+}
diff --git a/libm/double/stdtr.c b/libm/double/stdtr.c
new file mode 100644
index 000000000..743e01704
--- /dev/null
+++ b/libm/double/stdtr.c
@@ -0,0 +1,225 @@
+/* stdtr.c
+ *
+ * Student's t distribution
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double t, stdtr();
+ * short k;
+ *
+ * y = stdtr( 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 < -2, 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:
+ *
+ * Tested at random 1 <= k <= 25. The "domain" refers to t.
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE -100,-2 50000 5.9e-15 1.4e-15
+ * IEEE -2,100 500000 2.7e-15 4.9e-17
+ */
+
+/* stdtri.c
+ *
+ * Functional inverse of Student's t distribution
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double p, t, stdtri();
+ * int k;
+ *
+ * t = stdtri( k, p );
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Given probability p, finds the argument t such that stdtr(k,t)
+ * is equal to p.
+ *
+ * ACCURACY:
+ *
+ * Tested at random 1 <= k <= 100. The "domain" refers to p:
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE .001,.999 25000 5.7e-15 8.0e-16
+ * IEEE 10^-6,.001 25000 2.0e-12 2.9e-14
+ */
+
+
+/*
+Cephes Math Library Release 2.8: June, 2000
+Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier
+*/
+
+#include <math.h>
+
+extern double PI, MACHEP, MAXNUM;
+#ifdef ANSIPROT
+extern double sqrt ( double );
+extern double atan ( double );
+extern double incbet ( double, double, double );
+extern double incbi ( double, double, double );
+extern double fabs ( double );
+#else
+double sqrt(), atan(), incbet(), incbi(), fabs();
+#endif
+
+double stdtr( k, t )
+int k;
+double t;
+{
+double x, rk, z, f, tz, p, xsqk;
+int j;
+
+if( k <= 0 )
+ {
+ mtherr( "stdtr", DOMAIN );
+ return(0.0);
+ }
+
+if( t == 0 )
+ return( 0.5 );
+
+if( t < -2.0 )
+ {
+ rk = k;
+ z = rk / (rk + t * t);
+ p = 0.5 * incbet( 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/sqrt(rk);
+ p = atan( xsqk );
+ if( k > 1 )
+ {
+ f = 1.0;
+ tz = 1.0;
+ j = 3;
+ while( (j<=(k-2)) && ( (tz/f) > MACHEP ) )
+ {
+ tz *= (j-1)/( z * j );
+ f += tz;
+ j += 2;
+ }
+ p += f * xsqk/z;
+ }
+ p *= 2.0/PI;
+ }
+
+
+else
+ {
+
+ /* computation for even k */
+
+ f = 1.0;
+ tz = 1.0;
+ j = 2;
+
+ while( ( j <= (k-2) ) && ( (tz/f) > MACHEP ) )
+ {
+ tz *= (j - 1)/( z * j );
+ f += tz;
+ j += 2;
+ }
+ p = f * x/sqrt(z*rk);
+ }
+
+/* common exit */
+
+
+if( t < 0 )
+ p = -p; /* note destruction of relative accuracy */
+
+ p = 0.5 + 0.5 * p;
+return(p);
+}
+
+double stdtri( k, p )
+int k;
+double p;
+{
+double t, rk, z;
+int rflg;
+
+if( k <= 0 || p <= 0.0 || p >= 1.0 )
+ {
+ mtherr( "stdtri", DOMAIN );
+ return(0.0);
+ }
+
+rk = k;
+
+if( p > 0.25 && p < 0.75 )
+ {
+ if( p == 0.5 )
+ return( 0.0 );
+ z = 1.0 - 2.0 * p;
+ z = incbi( 0.5, 0.5*rk, fabs(z) );
+ t = sqrt( rk*z/(1.0-z) );
+ if( p < 0.5 )
+ t = -t;
+ return( t );
+ }
+rflg = -1;
+if( p >= 0.5)
+ {
+ p = 1.0 - p;
+ rflg = 1;
+ }
+z = incbi( 0.5*rk, 0.5, 2.0*p );
+
+if( MAXNUM * z < rk )
+ return(rflg* MAXNUM);
+t = sqrt( rk/z - rk );
+return( rflg * t );
+}
diff --git a/libm/double/struve.c b/libm/double/struve.c
new file mode 100644
index 000000000..fabf0735e
--- /dev/null
+++ b/libm/double/struve.c
@@ -0,0 +1,312 @@
+/* struve.c
+ *
+ * Struve function
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double v, x, y, struve();
+ *
+ * y = struve( 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:
+ *
+ * Not accurately characterized, but spot checked against tables.
+ *
+ */
+
+
+/*
+Cephes Math Library Release 2.81: June, 2000
+Copyright 1984, 1987, 1989, 2000 by Stephen L. Moshier
+*/
+#include <math.h>
+#define DEBUG 0
+#ifdef ANSIPROT
+extern double gamma ( double );
+extern double pow ( double, double );
+extern double sqrt ( double );
+extern double yn ( int, double );
+extern double jv ( double, double );
+extern double fabs ( double );
+extern double floor ( double );
+extern double sin ( double );
+extern double cos ( double );
+double yv ( double, double );
+double onef2 (double, double, double, double, double * );
+double threef0 (double, double, double, double, double * );
+#else
+double gamma(), pow(), sqrt(), yn(), yv(), jv(), fabs(), floor();
+double sin(), cos();
+double onef2(), threef0();
+#endif
+static double stop = 1.37e-17;
+extern double MACHEP;
+
+double onef2( a, b, c, x, err )
+double a, b, c, x;
+double *err;
+{
+double n, a0, sum, t;
+double an, bn, cn, max, z;
+
+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 = fabs( a0 );
+ if( z > max )
+ max = z;
+ if( sum != 0 )
+ t = fabs( a0 / sum );
+ else
+ t = z;
+ }
+while( t > stop );
+
+done:
+
+*err = fabs( MACHEP*max /sum );
+
+#if DEBUG
+ printf(" onef2 cancellation error %.5E\n", *err );
+#endif
+
+goto xit;
+
+error:
+#if DEBUG
+printf("onef2 does not converge\n");
+#endif
+*err = 1.0e38;
+
+xit:
+
+#if DEBUG
+printf("onef2( %.2E %.2E %.2E %.5E ) = %.3E %.6E\n", a, b, c, x, n, sum);
+#endif
+return(sum);
+}
+
+
+
+
+double threef0( a, b, c, x, err )
+double a, b, c, x;
+double *err;
+{
+double n, a0, sum, t, conv, conv1;
+double an, bn, cn, max, z;
+
+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 = fabs( 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 = fabs( a0 / sum );
+ else
+ t = z;
+ }
+while( t > stop );
+
+done:
+
+t = fabs( MACHEP*max/sum );
+#if DEBUG
+ printf(" threef0 cancellation error %.5E\n", t );
+#endif
+
+max = fabs( conv/sum );
+if( max > t )
+ t = max;
+#if DEBUG
+ printf(" threef0 convergence %.5E\n", max );
+#endif
+
+goto xit;
+
+error:
+#if DEBUG
+printf("threef0 does not converge\n");
+#endif
+t = 1.0e38;
+
+xit:
+
+#if DEBUG
+printf("threef0( %.2E %.2E %.2E %.5E ) = %.3E %.6E\n", a, b, c, x, n, sum);
+#endif
+
+*err = t;
+return(sum);
+}
+
+
+
+
+extern double PI;
+
+double struve( v, x )
+double v, x;
+{
+double y, ya, f, g, h, t;
+double onef2err, threef0err;
+
+f = floor(v);
+if( (v < 0) && ( v-f == 0.5 ) )
+ {
+ y = jv( -v, x );
+ f = 1.0 - f;
+ g = 2.0 * floor(f/2.0);
+ if( g != f )
+ y = -y;
+ return(y);
+ }
+t = 0.25*x*x;
+f = fabs(x);
+g = 1.5 * fabs(v);
+if( (f > 30.0) && (f > g) )
+ {
+ onef2err = 1.0e38;
+ y = 0.0;
+ }
+else
+ {
+ y = onef2( 1.0, 1.5, 1.5+v, -t, &onef2err );
+ }
+
+if( (f < 18.0) || (x < 0.0) )
+ {
+ threef0err = 1.0e38;
+ ya = 0.0;
+ }
+else
+ {
+ ya = threef0( 1.0, 0.5, 0.5-v, -1.0/t, &threef0err );
+ }
+
+f = sqrt( PI );
+h = pow( 0.5*x, v-1.0 );
+
+if( onef2err <= threef0err )
+ {
+ g = gamma( v + 1.5 );
+ y = y * h * t / ( 0.5 * f * g );
+ return(y);
+ }
+else
+ {
+ g = gamma( v + 0.5 );
+ ya = ya * h / ( f * g );
+ ya = ya + yv( v, x );
+ return(ya);
+ }
+}
+
+
+
+
+/* Bessel function of noninteger order
+ */
+
+double yv( v, x )
+double v, x;
+{
+double y, t;
+int n;
+
+y = floor( v );
+if( y == v )
+ {
+ n = v;
+ y = yn( n, x );
+ return( y );
+ }
+t = PI * v;
+y = (cos(t) * jv( v, x ) - jv( -v, x ))/sin(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/double/tan.c b/libm/double/tan.c
new file mode 100644
index 000000000..603f4b6a9
--- /dev/null
+++ b/libm/double/tan.c
@@ -0,0 +1,304 @@
+/* tan.c
+ *
+ * Circular tangent
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, tan();
+ *
+ * y = tan( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns the circular tangent of the radian argument x.
+ *
+ * Range reduction is modulo pi/4. A rational function
+ * x + x**3 P(x**2)/Q(x**2)
+ * is employed in the basic interval [0, pi/4].
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * DEC +-1.07e9 44000 4.1e-17 1.0e-17
+ * IEEE +-1.07e9 30000 2.9e-16 8.1e-17
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * tan total loss x > 1.073741824e9 0.0
+ *
+ */
+ /* cot.c
+ *
+ * Circular cotangent
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, cot();
+ *
+ * y = cot( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns the circular cotangent of the radian argument x.
+ *
+ * Range reduction is modulo pi/4. A rational function
+ * x + x**3 P(x**2)/Q(x**2)
+ * is employed in the basic interval [0, pi/4].
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE +-1.07e9 30000 2.9e-16 8.2e-17
+ *
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * cot total loss x > 1.073741824e9 0.0
+ * cot singularity x = 0 INFINITY
+ *
+ */
+
+/*
+Cephes Math Library Release 2.8: June, 2000
+yright 1984, 1995, 2000 by Stephen L. Moshier
+*/
+
+#include <math.h>
+
+#ifdef UNK
+static double P[] = {
+-1.30936939181383777646E4,
+ 1.15351664838587416140E6,
+-1.79565251976484877988E7
+};
+static double Q[] = {
+/* 1.00000000000000000000E0,*/
+ 1.36812963470692954678E4,
+-1.32089234440210967447E6,
+ 2.50083801823357915839E7,
+-5.38695755929454629881E7
+};
+static double DP1 = 7.853981554508209228515625E-1;
+static double DP2 = 7.94662735614792836714E-9;
+static double DP3 = 3.06161699786838294307E-17;
+static double lossth = 1.073741824e9;
+#endif
+
+#ifdef DEC
+static unsigned short P[] = {
+0143514,0113306,0111171,0174674,
+0045214,0147545,0027744,0167346,
+0146210,0177526,0114514,0105660
+};
+static unsigned short Q[] = {
+/*0040200,0000000,0000000,0000000,*/
+0043525,0142457,0072633,0025617,
+0145241,0036742,0140525,0162256,
+0046276,0146176,0013526,0143573,
+0146515,0077401,0162762,0150607
+};
+/* 7.853981629014015197753906250000E-1 */
+static unsigned short P1[] = {0040111,0007732,0120000,0000000,};
+/* 4.960467869796758577649598009884E-10 */
+static unsigned short P2[] = {0030410,0055060,0100000,0000000,};
+/* 2.860594363054915898381331279295E-18 */
+static unsigned short P3[] = {0021523,0011431,0105056,0001560,};
+#define DP1 *(double *)P1
+#define DP2 *(double *)P2
+#define DP3 *(double *)P3
+static double lossth = 1.073741824e9;
+#endif
+
+#ifdef IBMPC
+static unsigned short P[] = {
+0x3f38,0xd24f,0x92d8,0xc0c9,
+0x9ddd,0xa5fc,0x99ec,0x4131,
+0x9176,0xd329,0x1fea,0xc171
+};
+static unsigned short Q[] = {
+/*0x0000,0x0000,0x0000,0x3ff0,*/
+0x6572,0xeeb3,0xb8a5,0x40ca,
+0xbc96,0x582a,0x27bc,0xc134,
+0xd8ef,0xc2ea,0xd98f,0x4177,
+0x5a31,0x3cbe,0xafe0,0xc189
+};
+/*
+ 7.85398125648498535156E-1,
+ 3.77489470793079817668E-8,
+ 2.69515142907905952645E-15,
+*/
+static unsigned short P1[] = {0x0000,0x4000,0x21fb,0x3fe9};
+static unsigned short P2[] = {0x0000,0x0000,0x442d,0x3e64};
+static unsigned short P3[] = {0x5170,0x98cc,0x4698,0x3ce8};
+#define DP1 *(double *)P1
+#define DP2 *(double *)P2
+#define DP3 *(double *)P3
+static double lossth = 1.073741824e9;
+#endif
+
+#ifdef MIEEE
+static unsigned short P[] = {
+0xc0c9,0x92d8,0xd24f,0x3f38,
+0x4131,0x99ec,0xa5fc,0x9ddd,
+0xc171,0x1fea,0xd329,0x9176
+};
+static unsigned short Q[] = {
+0x40ca,0xb8a5,0xeeb3,0x6572,
+0xc134,0x27bc,0x582a,0xbc96,
+0x4177,0xd98f,0xc2ea,0xd8ef,
+0xc189,0xafe0,0x3cbe,0x5a31
+};
+static unsigned short P1[] = {
+0x3fe9,0x21fb,0x4000,0x0000
+};
+static unsigned short P2[] = {
+0x3e64,0x442d,0x0000,0x0000
+};
+static unsigned short P3[] = {
+0x3ce8,0x4698,0x98cc,0x5170,
+};
+#define DP1 *(double *)P1
+#define DP2 *(double *)P2
+#define DP3 *(double *)P3
+static double lossth = 1.073741824e9;
+#endif
+
+#ifdef ANSIPROT
+extern double polevl ( double, void *, int );
+extern double p1evl ( double, void *, int );
+extern double floor ( double );
+extern double ldexp ( double, int );
+extern int isnan ( double );
+extern int isfinite ( double );
+static double tancot(double, int);
+#else
+double polevl(), p1evl(), floor(), ldexp();
+static double tancot();
+int isnan(), isfinite();
+#endif
+extern double PIO4;
+extern double INFINITY;
+extern double NAN;
+
+double tan(x)
+double x;
+{
+#ifdef MINUSZERO
+if( x == 0.0 )
+ return(x);
+#endif
+#ifdef NANS
+if( isnan(x) )
+ return(x);
+if( !isfinite(x) )
+ {
+ mtherr( "tan", DOMAIN );
+ return(NAN);
+ }
+#endif
+return( tancot(x,0) );
+}
+
+
+double cot(x)
+double x;
+{
+
+if( x == 0.0 )
+ {
+ mtherr( "cot", SING );
+ return( INFINITY );
+ }
+return( tancot(x,1) );
+}
+
+
+static double tancot( xx, cotflg )
+double xx;
+int cotflg;
+{
+double x, y, z, zz;
+int j, sign;
+
+/* make argument positive but save the sign */
+if( xx < 0 )
+ {
+ x = -xx;
+ sign = -1;
+ }
+else
+ {
+ x = xx;
+ sign = 1;
+ }
+
+if( x > lossth )
+ {
+ if( cotflg )
+ mtherr( "cot", TLOSS );
+ else
+ mtherr( "tan", TLOSS );
+ return(0.0);
+ }
+
+/* compute x mod PIO4 */
+y = floor( x/PIO4 );
+
+/* strip high bits of integer part */
+z = ldexp( y, -3 );
+z = floor(z); /* integer part of y/8 */
+z = y - ldexp( z, 3 ); /* y - 16 * (y/16) */
+
+/* integer and fractional part modulo one octant */
+j = z;
+
+/* 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( zz > 1.0e-14 )
+ y = z + z * (zz * polevl( zz, P, 2 )/p1evl(zz, Q, 4));
+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 );
+}
diff --git a/libm/double/tandg.c b/libm/double/tandg.c
new file mode 100644
index 000000000..92fd1e56b
--- /dev/null
+++ b/libm/double/tandg.c
@@ -0,0 +1,267 @@
+/* tandg.c
+ *
+ * Circular tangent of argument in degrees
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, tandg();
+ *
+ * y = tandg( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns the circular tangent of the argument x in degrees.
+ *
+ * Range reduction is modulo pi/4. A rational function
+ * x + x**3 P(x**2)/Q(x**2)
+ * is employed in the basic interval [0, pi/4].
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * DEC 0,10 8000 3.4e-17 1.2e-17
+ * IEEE 0,10 30000 3.2e-16 8.4e-17
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * tandg total loss x > 8.0e14 (DEC) 0.0
+ * x > 1.0e14 (IEEE)
+ * tandg singularity x = 180 k + 90 MAXNUM
+ */
+ /* cotdg.c
+ *
+ * Circular cotangent of argument in degrees
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, cotdg();
+ *
+ * y = cotdg( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns the circular cotangent of the argument x in degrees.
+ *
+ * Range reduction is modulo pi/4. A rational function
+ * x + x**3 P(x**2)/Q(x**2)
+ * is employed in the basic interval [0, pi/4].
+ *
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * cotdg total loss x > 8.0e14 (DEC) 0.0
+ * x > 1.0e14 (IEEE)
+ * cotdg singularity x = 180 k MAXNUM
+ */
+
+/*
+Cephes Math Library Release 2.8: June, 2000
+Copyright 1984, 1987, 2000 by Stephen L. Moshier
+*/
+
+#include <math.h>
+
+#ifdef UNK
+static double P[] = {
+-1.30936939181383777646E4,
+ 1.15351664838587416140E6,
+-1.79565251976484877988E7
+};
+static double Q[] = {
+/* 1.00000000000000000000E0,*/
+ 1.36812963470692954678E4,
+-1.32089234440210967447E6,
+ 2.50083801823357915839E7,
+-5.38695755929454629881E7
+};
+static double PI180 = 1.74532925199432957692E-2;
+static double lossth = 1.0e14;
+#endif
+
+#ifdef DEC
+static unsigned short P[] = {
+0143514,0113306,0111171,0174674,
+0045214,0147545,0027744,0167346,
+0146210,0177526,0114514,0105660
+};
+static unsigned short Q[] = {
+/*0040200,0000000,0000000,0000000,*/
+0043525,0142457,0072633,0025617,
+0145241,0036742,0140525,0162256,
+0046276,0146176,0013526,0143573,
+0146515,0077401,0162762,0150607
+};
+static unsigned short P1[] = {0036616,0175065,0011224,0164711};
+#define PI180 *(double *)P1
+static double lossth = 8.0e14;
+#endif
+
+#ifdef IBMPC
+static unsigned short P[] = {
+0x3f38,0xd24f,0x92d8,0xc0c9,
+0x9ddd,0xa5fc,0x99ec,0x4131,
+0x9176,0xd329,0x1fea,0xc171
+};
+static unsigned short Q[] = {
+/*0x0000,0x0000,0x0000,0x3ff0,*/
+0x6572,0xeeb3,0xb8a5,0x40ca,
+0xbc96,0x582a,0x27bc,0xc134,
+0xd8ef,0xc2ea,0xd98f,0x4177,
+0x5a31,0x3cbe,0xafe0,0xc189
+};
+static unsigned short P1[] = {0x9d39,0xa252,0xdf46,0x3f91};
+#define PI180 *(double *)P1
+static double lossth = 1.0e14;
+#endif
+
+#ifdef MIEEE
+static unsigned short P[] = {
+0xc0c9,0x92d8,0xd24f,0x3f38,
+0x4131,0x99ec,0xa5fc,0x9ddd,
+0xc171,0x1fea,0xd329,0x9176
+};
+static unsigned short Q[] = {
+0x40ca,0xb8a5,0xeeb3,0x6572,
+0xc134,0x27bc,0x582a,0xbc96,
+0x4177,0xd98f,0xc2ea,0xd8ef,
+0xc189,0xafe0,0x3cbe,0x5a31
+};
+static unsigned short P1[] = {
+0x3f91,0xdf46,0xa252,0x9d39
+};
+#define PI180 *(double *)P1
+static double lossth = 1.0e14;
+#endif
+
+#ifdef ANSIPROT
+extern double polevl ( double, void *, int );
+extern double p1evl ( double, void *, int );
+extern double floor ( double );
+extern double ldexp ( double, int );
+static double tancot( double, int );
+#else
+double polevl(), p1evl(), floor(), ldexp();
+static double tancot();
+#endif
+extern double MAXNUM;
+extern double PIO4;
+
+
+double tandg(x)
+double x;
+{
+
+return( tancot(x,0) );
+}
+
+
+double cotdg(x)
+double x;
+{
+
+return( tancot(x,1) );
+}
+
+
+static double tancot( xx, cotflg )
+double xx;
+int cotflg;
+{
+double x, y, z, zz;
+int j, sign;
+
+/* make argument positive but save the sign */
+if( xx < 0 )
+ {
+ x = -xx;
+ sign = -1;
+ }
+else
+ {
+ x = xx;
+ sign = 1;
+ }
+
+if( x > lossth )
+ {
+ mtherr( "tandg", TLOSS );
+ return(0.0);
+ }
+
+/* compute x mod PIO4 */
+y = floor( x/45.0 );
+
+/* strip high bits of integer part */
+z = ldexp( y, -3 );
+z = floor(z); /* integer part of y/8 */
+z = y - ldexp( z, 3 ); /* y - 16 * (y/16) */
+
+/* integer and fractional part modulo one octant */
+j = z;
+
+/* map zeros and singularities to origin */
+if( j & 1 )
+ {
+ j += 1;
+ y += 1.0;
+ }
+
+z = x - y * 45.0;
+z *= PI180;
+
+zz = z * z;
+
+if( zz > 1.0e-14 )
+ y = z + z * (zz * polevl( zz, P, 2 )/p1evl(zz, Q, 4));
+else
+ y = z;
+
+if( j & 2 )
+ {
+ if( cotflg )
+ y = -y;
+ else
+ {
+ if( y != 0.0 )
+ {
+ y = -1.0/y;
+ }
+ else
+ {
+ mtherr( "tandg", SING );
+ y = MAXNUM;
+ }
+ }
+ }
+else
+ {
+ if( cotflg )
+ {
+ if( y != 0.0 )
+ y = 1.0/y;
+ else
+ {
+ mtherr( "cotdg", SING );
+ y = MAXNUM;
+ }
+ }
+ }
+
+if( sign < 0 )
+ y = -y;
+
+return( y );
+}
diff --git a/libm/double/tanh.c b/libm/double/tanh.c
new file mode 100644
index 000000000..910a4188e
--- /dev/null
+++ b/libm/double/tanh.c
@@ -0,0 +1,141 @@
+/* tanh.c
+ *
+ * Hyperbolic tangent
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, tanh();
+ *
+ * y = tanh( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns hyperbolic tangent of argument in the range MINLOG to
+ * MAXLOG.
+ *
+ * A rational function is used for |x| < 0.625. The form
+ * x + x**3 P(x)/Q(x) of Cody _& Waite is employed.
+ * Otherwise,
+ * tanh(x) = sinh(x)/cosh(x) = 1 - 2/(exp(2x) + 1).
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * DEC -2,2 50000 3.3e-17 6.4e-18
+ * IEEE -2,2 30000 2.5e-16 5.8e-17
+ *
+ */
+
+/*
+Cephes Math Library Release 2.8: June, 2000
+Copyright 1984, 1995, 2000 by Stephen L. Moshier
+*/
+
+#include <math.h>
+
+#ifdef UNK
+static double P[] = {
+-9.64399179425052238628E-1,
+-9.92877231001918586564E1,
+-1.61468768441708447952E3
+};
+static double Q[] = {
+/* 1.00000000000000000000E0,*/
+ 1.12811678491632931402E2,
+ 2.23548839060100448583E3,
+ 4.84406305325125486048E3
+};
+#endif
+#ifdef DEC
+static unsigned short P[] = {
+0140166,0161335,0053753,0075126,
+0141706,0111520,0070463,0040552,
+0142711,0153001,0101300,0025430
+};
+static unsigned short Q[] = {
+/*0040200,0000000,0000000,0000000,*/
+0041741,0117624,0051300,0156060,
+0043013,0133720,0071251,0127717,
+0043227,0060201,0021020,0020136
+};
+#endif
+
+#ifdef IBMPC
+static unsigned short P[] = {
+0x6f4b,0xaafd,0xdc5b,0xbfee,
+0x682d,0x0e26,0xd26a,0xc058,
+0x0563,0x3058,0x3ac0,0xc099
+};
+static unsigned short Q[] = {
+/*0x0000,0x0000,0x0000,0x3ff0,*/
+0x1b86,0x8a58,0x33f2,0x405c,
+0x35fa,0x0e55,0x76fa,0x40a1,
+0x040c,0x2442,0xec10,0x40b2
+};
+#endif
+
+#ifdef MIEEE
+static unsigned short P[] = {
+0xbfee,0xdc5b,0xaafd,0x6f4b,
+0xc058,0xd26a,0x0e26,0x682d,
+0xc099,0x3ac0,0x3058,0x0563
+};
+static unsigned short Q[] = {
+0x405c,0x33f2,0x8a58,0x1b86,
+0x40a1,0x76fa,0x0e55,0x35fa,
+0x40b2,0xec10,0x2442,0x040c
+};
+#endif
+
+#ifdef ANSIPROT
+extern double fabs ( double );
+extern double exp ( double );
+extern double polevl ( double, void *, int );
+extern double p1evl ( double, void *, int );
+#else
+double fabs(), exp(), polevl(), p1evl();
+#endif
+extern double MAXLOG;
+
+double tanh(x)
+double x;
+{
+double s, z;
+
+#ifdef MINUSZERO
+if( x == 0.0 )
+ return(x);
+#endif
+z = fabs(x);
+if( z > 0.5 * MAXLOG )
+ {
+ if( x > 0 )
+ return( 1.0 );
+ else
+ return( -1.0 );
+ }
+if( z >= 0.625 )
+ {
+ s = exp(2.0*z);
+ z = 1.0 - 2.0/(s + 1.0);
+ if( x < 0 )
+ z = -z;
+ }
+else
+ {
+ if( x == 0.0 )
+ return(x);
+ s = x * x;
+ z = polevl( s, P, 2 )/p1evl(s, Q, 3);
+ z = x * s * z;
+ z = x + z;
+ }
+return( z );
+}
diff --git a/libm/double/time-it.c b/libm/double/time-it.c
new file mode 100644
index 000000000..32d07db4e
--- /dev/null
+++ b/libm/double/time-it.c
@@ -0,0 +1,38 @@
+/* Reports run time, in seconds, for a command.
+ The command argument can have multiple words, but then
+ it has to be quoted, as for example
+
+ time-it "command < file1 > file2"
+
+ The time interval resolution is one whole second. */
+
+
+#include <time.h>
+int system ();
+int printf ();
+
+int
+main (argv, argc)
+ int argv;
+ char **argc;
+{
+ time_t t0, t1;
+
+ if (argv < 2)
+ {
+ printf ("Usage: time-it name_of_program_to_be_timed\n");
+ exit (1);
+ }
+ time (&t0);
+ /* Wait til the clock changes before starting. */
+ do
+ {
+ time (&t1);
+ }
+ while (t1 == t0);
+ system (argc[1]);
+ t0 = t1;
+ time (&t1);
+ printf ("%ld seconds.\n", t1 - t0);
+ exit (0);
+}
diff --git a/libm/double/unity.c b/libm/double/unity.c
new file mode 100644
index 000000000..9223e0edf
--- /dev/null
+++ b/libm/double/unity.c
@@ -0,0 +1,138 @@
+/* unity.c
+ *
+ * Relative error approximations for function arguments near
+ * unity.
+ *
+ * log1p(x) = log(1+x)
+ * expm1(x) = exp(x) - 1
+ * cosm1(x) = cos(x) - 1
+ *
+ */
+
+#include <math.h>
+
+#ifdef ANSIPROT
+extern int isnan (double);
+extern int isfinite (double);
+extern double log ( double );
+extern double polevl ( double, void *, int );
+extern double p1evl ( double, void *, int );
+extern double exp ( double );
+extern double cos ( double );
+#else
+double log(), polevl(), p1evl(), exp(), cos();
+int isnan(), isfinite();
+#endif
+extern double INFINITY;
+
+/* log1p(x) = log(1 + x) */
+
+/* Coefficients for log(1+x) = x - x**2/2 + x**3 P(x)/Q(x)
+ * 1/sqrt(2) <= x < sqrt(2)
+ * Theoretical peak relative error = 2.32e-20
+ */
+static double LP[] = {
+ 4.5270000862445199635215E-5,
+ 4.9854102823193375972212E-1,
+ 6.5787325942061044846969E0,
+ 2.9911919328553073277375E1,
+ 6.0949667980987787057556E1,
+ 5.7112963590585538103336E1,
+ 2.0039553499201281259648E1,
+};
+static double LQ[] = {
+/* 1.0000000000000000000000E0,*/
+ 1.5062909083469192043167E1,
+ 8.3047565967967209469434E1,
+ 2.2176239823732856465394E2,
+ 3.0909872225312059774938E2,
+ 2.1642788614495947685003E2,
+ 6.0118660497603843919306E1,
+};
+
+#define SQRTH 0.70710678118654752440
+#define SQRT2 1.41421356237309504880
+
+double log1p(x)
+double x;
+{
+double z;
+
+z = 1.0 + x;
+if( (z < SQRTH) || (z > SQRT2) )
+ return( log(z) );
+z = x*x;
+z = -0.5 * z + x * ( z * polevl( x, LP, 6 ) / p1evl( x, LQ, 6 ) );
+return (x + z);
+}
+
+
+
+/* expm1(x) = exp(x) - 1 */
+
+/* e^x = 1 + 2x P(x^2)/( Q(x^2) - P(x^2) )
+ * -0.5 <= x <= 0.5
+ */
+
+static double EP[3] = {
+ 1.2617719307481059087798E-4,
+ 3.0299440770744196129956E-2,
+ 9.9999999999999999991025E-1,
+};
+static double EQ[4] = {
+ 3.0019850513866445504159E-6,
+ 2.5244834034968410419224E-3,
+ 2.2726554820815502876593E-1,
+ 2.0000000000000000000897E0,
+};
+
+double expm1(x)
+double x;
+{
+double r, xx;
+
+#ifdef NANS
+if( isnan(x) )
+ return(x);
+#endif
+#ifdef INFINITIES
+if( x == INFINITY )
+ return(INFINITY);
+if( x == -INFINITY )
+ return(-1.0);
+#endif
+if( (x < -0.5) || (x > 0.5) )
+ return( exp(x) - 1.0 );
+xx = x * x;
+r = x * polevl( xx, EP, 2 );
+r = r/( polevl( xx, EQ, 3 ) - r );
+return (r + r);
+}
+
+
+
+/* cosm1(x) = cos(x) - 1 */
+
+static double coscof[7] = {
+ 4.7377507964246204691685E-14,
+-1.1470284843425359765671E-11,
+ 2.0876754287081521758361E-9,
+-2.7557319214999787979814E-7,
+ 2.4801587301570552304991E-5,
+-1.3888888888888872993737E-3,
+ 4.1666666666666666609054E-2,
+};
+
+extern double PIO4;
+
+double cosm1(x)
+double x;
+{
+double xx;
+
+if( (x < -PIO4) || (x > PIO4) )
+ return( cos(x) - 1.0 );
+xx = x * x;
+xx = -0.5*xx + xx * xx * polevl( xx, coscof, 6 );
+return xx;
+}
diff --git a/libm/double/yn.c b/libm/double/yn.c
new file mode 100644
index 000000000..0c569a925
--- /dev/null
+++ b/libm/double/yn.c
@@ -0,0 +1,114 @@
+/* yn.c
+ *
+ * Bessel function of second kind of integer order
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, yn();
+ * int n;
+ *
+ * y = yn( 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
+ * DEC 0, 30 2200 2.9e-16 5.3e-17
+ * IEEE 0, 30 30000 3.4e-15 4.3e-16
+ *
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * yn singularity x = 0 MAXNUM
+ * yn overflow MAXNUM
+ *
+ * Spot checked against tables for x, n between 0 and 100.
+ *
+ */
+
+/*
+Cephes Math Library Release 2.8: June, 2000
+Copyright 1984, 1987, 2000 by Stephen L. Moshier
+*/
+
+#include <math.h>
+#ifdef ANSIPROT
+extern double y0 ( double );
+extern double y1 ( double );
+extern double log ( double );
+#else
+double y0(), y1(), log();
+#endif
+extern double MAXNUM, MAXLOG;
+
+double yn( n, x )
+int n;
+double x;
+{
+double an, anm1, anm2, r;
+int k, sign;
+
+if( n < 0 )
+ {
+ n = -n;
+ if( (n & 1) == 0 ) /* -1**n */
+ sign = 1;
+ else
+ sign = -1;
+ }
+else
+ sign = 1;
+
+
+if( n == 0 )
+ return( sign * y0(x) );
+if( n == 1 )
+ return( sign * y1(x) );
+
+/* test for overflow */
+if( x <= 0.0 )
+ {
+ mtherr( "yn", SING );
+ return( -MAXNUM );
+ }
+
+/* forward recurrence on n */
+
+anm2 = y0(x);
+anm1 = y1(x);
+k = 1;
+r = 2 * k;
+do
+ {
+ an = r * anm1 / x - anm2;
+ anm2 = anm1;
+ anm1 = an;
+ r += 2.0;
+ ++k;
+ }
+while( k < n );
+
+
+return( sign * an );
+}
diff --git a/libm/double/zeta.c b/libm/double/zeta.c
new file mode 100644
index 000000000..a49c619d5
--- /dev/null
+++ b/libm/double/zeta.c
@@ -0,0 +1,189 @@
+/* zeta.c
+ *
+ * Riemann zeta function of two arguments
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, q, y, zeta();
+ *
+ * y = zeta( 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:
+ *
+ *
+ *
+ * REFERENCE:
+ *
+ * Gradshteyn, I. S., and I. M. Ryzhik, Tables of Integrals,
+ * Series, and Products, p. 1073; Academic Press, 1980.
+ *
+ */
+
+/*
+Cephes Math Library Release 2.8: June, 2000
+Copyright 1984, 1987, 2000 by Stephen L. Moshier
+*/
+
+#include <math.h>
+#ifdef ANSIPROT
+extern double fabs ( double );
+extern double pow ( double, double );
+extern double floor ( double );
+#else
+double fabs(), pow(), floor();
+#endif
+extern double MAXNUM, MACHEP;
+
+/* Expansion coefficients
+ * for Euler-Maclaurin summation formula
+ * (2k)! / B2k
+ * where B2k are Bernoulli numbers
+ */
+static double 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 */
+
+
+double zeta(x,q)
+double x,q;
+{
+int i;
+double a, b, k, s, t, w;
+
+if( x == 1.0 )
+ goto retinf;
+
+if( x < 1.0 )
+ {
+domerr:
+ mtherr( "zeta", DOMAIN );
+ return(0.0);
+ }
+
+if( q <= 0.0 )
+ {
+ if(q == floor(q))
+ {
+ mtherr( "zeta", SING );
+retinf:
+ return( MAXNUM );
+ }
+ if( x != floor(x) )
+ goto domerr; /* because q^-x not defined */
+ }
+
+/* Euler-Maclaurin summation formula */
+/*
+if( x < 25.0 )
+*/
+{
+/* Permit negative q but continue sum until n+q > +9 .
+ * This case should be handled by a reflection formula.
+ * If q<0 and x is an integer, there is a relation to
+ * the polygamma function.
+ */
+s = pow( q, -x );
+a = q;
+i = 0;
+b = 0.0;
+while( (i < 9) || (a <= 9.0) )
+ {
+ i += 1;
+ a += 1.0;
+ b = pow( a, -x );
+ s += b;
+ if( fabs(b/s) < MACHEP )
+ 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 = fabs(t/s);
+ if( t < MACHEP )
+ goto done;
+ k += 1.0;
+ a *= x + k;
+ b /= w;
+ k += 1.0;
+ }
+done:
+return(s);
+}
+
+
+
+/* Basic sum of inverse powers */
+/*
+pseres:
+
+s = pow( q, -x );
+a = q;
+do
+ {
+ a += 2.0;
+ b = pow( a, -x );
+ s += b;
+ }
+while( b/s > MACHEP );
+
+b = pow( 2.0, -x );
+s = (s + b)/(1.0-b);
+return(s);
+*/
+}
diff --git a/libm/double/zetac.c b/libm/double/zetac.c
new file mode 100644
index 000000000..cc28590b3
--- /dev/null
+++ b/libm/double/zetac.c
@@ -0,0 +1,599 @@
+ /* zetac.c
+ *
+ * Riemann zeta function
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, zetac();
+ *
+ * y = zetac( 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 10000 9.8e-16 1.3e-16
+ * DEC 1,50 2000 1.1e-16 1.9e-17
+ *
+ *
+ */
+
+/*
+Cephes Math Library Release 2.8: June, 2000
+Copyright 1984, 1987, 1989, 2000 by Stephen L. Moshier
+*/
+
+#include <math.h>
+
+extern double MAXNUM, PI;
+
+/* Riemann zeta(x) - 1
+ * for integer arguments between 0 and 30.
+ */
+#ifdef UNK
+static double azetac[] = {
+-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
+};
+#endif
+
+#ifdef DEC
+static unsigned short azetac[] = {
+0140300,0000000,0000000,0000000,
+0077777,0177777,0177777,0177777,
+0040045,0015146,0022460,0076462,
+0037516,0164001,0036001,0104116,
+0037250,0114425,0061754,0022033,
+0037027,0040616,0145174,0146670,
+0036616,0011411,0100444,0104437,
+0036410,0145550,0051474,0161067,
+0036205,0115527,0141434,0133506,
+0036003,0117475,0100553,0053403,
+0035602,0056147,0045567,0027703,
+0035401,0106157,0111054,0145242,
+0035201,0002455,0113151,0101015,
+0035000,0126235,0004273,0157260,
+0034600,0071127,0112647,0005261,
+0034400,0045736,0057610,0157550,
+0034200,0031146,0172621,0074172,
+0034000,0020603,0115503,0032007,
+0033600,0013114,0124672,0023135,
+0033400,0007330,0043715,0151117,
+0033200,0004742,0145043,0033514,
+0033000,0003225,0152624,0004411,
+0032600,0002143,0033166,0035746,
+0032400,0001354,0074234,0026143,
+0032200,0000762,0147776,0170220,
+0032000,0000514,0072452,0130631,
+0031600,0000335,0114266,0063315,
+0031400,0000223,0132710,0041045,
+0031200,0000142,0073202,0153426,
+0031000,0000101,0121400,0152065,
+0030600,0000053,0140525,0072761
+};
+#endif
+
+#ifdef IBMPC
+static unsigned short azetac[] = {
+0x0000,0x0000,0x0000,0xbff8,
+0xffff,0xffff,0xffff,0x7fef,
+0x0fa6,0xc4a6,0xa34c,0x3fe4,
+0x310a,0x2780,0xdd00,0x3fc9,
+0x8483,0xac7d,0x1322,0x3fb5,
+0x99b7,0xd94f,0xe831,0x3fa2,
+0x9124,0x3024,0xc261,0x3f91,
+0x9c47,0x0a67,0x196d,0x3f81,
+0x96e9,0xf863,0xb36a,0x3f70,
+0x6ae0,0xb02d,0x73e7,0x3f60,
+0xe5f8,0xe96e,0x4b8c,0x3f50,
+0x9954,0xf245,0x318d,0x3f40,
+0x3042,0xb2cd,0x20a5,0x3f30,
+0x7bd6,0xa117,0x1593,0x3f20,
+0xe156,0xf2b4,0x0e4a,0x3f10,
+0x1bed,0xcbf1,0x097b,0x3f00,
+0x2f0f,0xdeb2,0x064c,0x3ef0,
+0x6681,0x7368,0x0430,0x3ee0,
+0x44cc,0x9537,0x02c9,0x3ed0,
+0xba4a,0x08f9,0x01db,0x3ec0,
+0x66ea,0x5944,0x013c,0x3eb0,
+0x8121,0xbab2,0x00d2,0x3ea0,
+0xc77d,0x66ce,0x008c,0x3e90,
+0x858c,0x8f13,0x005d,0x3e80,
+0xde12,0x59ff,0x003e,0x3e70,
+0x5633,0x8ea5,0x0029,0x3e60,
+0xccda,0xb316,0x001b,0x3e50,
+0x0845,0x76b9,0x0012,0x3e40,
+0x5ae3,0x4ed0,0x000c,0x3e30,
+0x1a87,0x3460,0x0008,0x3e20,
+0xaebe,0x782a,0x0005,0x3e10
+};
+#endif
+
+#ifdef MIEEE
+static unsigned short azetac[] = {
+0xbff8,0x0000,0x0000,0x0000,
+0x7fef,0xffff,0xffff,0xffff,
+0x3fe4,0xa34c,0xc4a6,0x0fa6,
+0x3fc9,0xdd00,0x2780,0x310a,
+0x3fb5,0x1322,0xac7d,0x8483,
+0x3fa2,0xe831,0xd94f,0x99b7,
+0x3f91,0xc261,0x3024,0x9124,
+0x3f81,0x196d,0x0a67,0x9c47,
+0x3f70,0xb36a,0xf863,0x96e9,
+0x3f60,0x73e7,0xb02d,0x6ae0,
+0x3f50,0x4b8c,0xe96e,0xe5f8,
+0x3f40,0x318d,0xf245,0x9954,
+0x3f30,0x20a5,0xb2cd,0x3042,
+0x3f20,0x1593,0xa117,0x7bd6,
+0x3f10,0x0e4a,0xf2b4,0xe156,
+0x3f00,0x097b,0xcbf1,0x1bed,
+0x3ef0,0x064c,0xdeb2,0x2f0f,
+0x3ee0,0x0430,0x7368,0x6681,
+0x3ed0,0x02c9,0x9537,0x44cc,
+0x3ec0,0x01db,0x08f9,0xba4a,
+0x3eb0,0x013c,0x5944,0x66ea,
+0x3ea0,0x00d2,0xbab2,0x8121,
+0x3e90,0x008c,0x66ce,0xc77d,
+0x3e80,0x005d,0x8f13,0x858c,
+0x3e70,0x003e,0x59ff,0xde12,
+0x3e60,0x0029,0x8ea5,0x5633,
+0x3e50,0x001b,0xb316,0xccda,
+0x3e40,0x0012,0x76b9,0x0845,
+0x3e30,0x000c,0x4ed0,0x5ae3,
+0x3e20,0x0008,0x3460,0x1a87,
+0x3e10,0x0005,0x782a,0xaebe
+};
+#endif
+
+
+/* 2**x (1 - 1/x) (zeta(x) - 1) = P(1/x)/Q(1/x), 1 <= x <= 10 */
+#ifdef UNK
+static double P[9] = {
+ 5.85746514569725319540E11,
+ 2.57534127756102572888E11,
+ 4.87781159567948256438E10,
+ 5.15399538023885770696E9,
+ 3.41646073514754094281E8,
+ 1.60837006880656492731E7,
+ 5.92785467342109522998E5,
+ 1.51129169964938823117E4,
+ 2.01822444485997955865E2,
+};
+static double Q[8] = {
+/* 1.00000000000000000000E0,*/
+ 3.90497676373371157516E11,
+ 5.22858235368272161797E10,
+ 5.64451517271280543351E9,
+ 3.39006746015350418834E8,
+ 1.79410371500126453702E7,
+ 5.66666825131384797029E5,
+ 1.60382976810944131506E4,
+ 1.96436237223387314144E2,
+};
+#endif
+#ifdef DEC
+static unsigned short P[36] = {
+0052010,0060466,0101211,0134657,
+0051557,0154353,0135060,0064411,
+0051065,0133157,0133514,0133633,
+0050231,0114735,0035036,0111344,
+0047242,0164327,0146036,0033545,
+0046165,0065364,0130045,0011005,
+0045020,0134427,0075073,0134107,
+0043554,0021653,0000440,0177426,
+0042111,0151213,0134312,0021402,
+};
+static unsigned short Q[32] = {
+/*0040200,0000000,0000000,0000000,*/
+0051665,0153363,0054252,0137010,
+0051102,0143645,0121415,0036107,
+0050250,0034073,0131133,0036465,
+0047241,0123250,0150037,0070012,
+0046210,0160426,0111463,0116507,
+0045012,0054255,0031674,0173612,
+0043572,0114460,0151520,0012221,
+0042104,0067655,0037037,0137421,
+};
+#endif
+#ifdef IBMPC
+static unsigned short P[36] = {
+0x3736,0xd051,0x0c26,0x4261,
+0x0d21,0x7746,0xfb1d,0x424d,
+0x96f3,0xf6e9,0xb6cd,0x4226,
+0xd25c,0xa743,0x333b,0x41f3,
+0xc6ed,0xf983,0x5d1a,0x41b4,
+0xa241,0x9604,0xad5e,0x416e,
+0x7709,0xef47,0x1722,0x4122,
+0x1fe3,0x6024,0x8475,0x40cd,
+0x4460,0x7719,0x3a51,0x4069,
+};
+static unsigned short Q[32] = {
+/*0x0000,0x0000,0x0000,0x3ff0,*/
+0x57c1,0x6b15,0xbade,0x4256,
+0xa789,0xb461,0x58f4,0x4228,
+0x67a7,0x764b,0x0707,0x41f5,
+0xee01,0x1a03,0x34d5,0x41b4,
+0x73a9,0xd266,0x1c22,0x4171,
+0x9ef1,0xa677,0x4b15,0x4121,
+0x0292,0x1a6a,0x5326,0x40cf,
+0xf7e2,0xa7c3,0x8df5,0x4068,
+};
+#endif
+#ifdef MIEEE
+static unsigned short P[36] = {
+0x4261,0x0c26,0xd051,0x3736,
+0x424d,0xfb1d,0x7746,0x0d21,
+0x4226,0xb6cd,0xf6e9,0x96f3,
+0x41f3,0x333b,0xa743,0xd25c,
+0x41b4,0x5d1a,0xf983,0xc6ed,
+0x416e,0xad5e,0x9604,0xa241,
+0x4122,0x1722,0xef47,0x7709,
+0x40cd,0x8475,0x6024,0x1fe3,
+0x4069,0x3a51,0x7719,0x4460,
+};
+static unsigned short Q[32] = {
+/*0x3ff0,0x0000,0x0000,0x0000,*/
+0x4256,0xbade,0x6b15,0x57c1,
+0x4228,0x58f4,0xb461,0xa789,
+0x41f5,0x0707,0x764b,0x67a7,
+0x41b4,0x34d5,0x1a03,0xee01,
+0x4171,0x1c22,0xd266,0x73a9,
+0x4121,0x4b15,0xa677,0x9ef1,
+0x40cf,0x5326,0x1a6a,0x0292,
+0x4068,0x8df5,0xa7c3,0xf7e2,
+};
+#endif
+
+/* log(zeta(x) - 1 - 2**-x), 10 <= x <= 50 */
+#ifdef UNK
+static double 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 double B[10] = {
+/* 1.00000000000000000000E0,*/
+-7.92625410563741062861E6,
+-1.60529969932920229676E8,
+-2.37669260975543221788E10,
+-4.80319584350455169857E11,
+-2.07820961754173320170E13,
+-2.96075404507272223680E14,
+-4.86299103694609136686E15,
+ 5.34589509675789930199E15,
+ 5.71464111092297631292E16,
+-1.79915597658676556828E16,
+};
+#endif
+#ifdef DEC
+static unsigned short A[44] = {
+0046004,0156325,0126302,0131567,
+0047050,0052177,0015271,0136466,
+0050702,0060271,0070727,0171112,
+0051766,0132727,0064363,0145042,
+0053245,0012466,0056000,0117230,
+0054226,0166155,0174275,0170213,
+0055222,0003127,0112544,0101322,
+0154741,0036625,0010346,0053767,
+0156260,0054653,0154052,0031113,
+0056213,0011152,0021000,0007111,
+0056244,0120534,0040576,0163262,
+};
+static unsigned short B[40] = {
+/*0040200,0000000,0000000,0000000,*/
+0145761,0161734,0033026,0015520,
+0147031,0013743,0017355,0036703,
+0150661,0011720,0061061,0136402,
+0151737,0125216,0070274,0164414,
+0153227,0032653,0127211,0145250,
+0154206,0121666,0123774,0042035,
+0155212,0033352,0125154,0132533,
+0055227,0170201,0110775,0072132,
+0056113,0003133,0127132,0122303,
+0155577,0126351,0141462,0171037,
+};
+#endif
+#ifdef IBMPC
+static unsigned short A[44] = {
+0x566f,0xb598,0x9b9a,0x4160,
+0x37a7,0xe357,0x0a8f,0x41a5,
+0xfe49,0x2e3a,0x4c17,0x4218,
+0x7944,0xed1e,0xd6ba,0x425e,
+0x13d3,0xcb80,0xa2a6,0x42b4,
+0xbe11,0xbf17,0xdd8d,0x42f2,
+0x905a,0xf2ac,0x40ca,0x4332,
+0xcaff,0xa21c,0x27b2,0xc31c,
+0x4649,0x7b05,0x0b35,0xc376,
+0x01c9,0x4440,0x624d,0x4371,
+0xdcd6,0x882f,0x942b,0x4374,
+};
+static unsigned short B[40] = {
+/*0x0000,0x0000,0x0000,0x3ff0,*/
+0xc36a,0x86c2,0x3c7b,0xc15e,
+0xa7b8,0x63dd,0x22fc,0xc1a3,
+0x37a0,0x0c46,0x227a,0xc216,
+0x9d22,0xce17,0xf551,0xc25b,
+0x3955,0x75d1,0xe6b5,0xc2b2,
+0x8884,0xd4ff,0xd476,0xc2f0,
+0x96ab,0x554d,0x46dd,0xc331,
+0xae8b,0x323f,0xfe10,0x4332,
+0x5498,0x75cb,0x60cb,0x4369,
+0x5e44,0x3866,0xf59d,0xc34f,
+};
+#endif
+#ifdef MIEEE
+static unsigned short A[44] = {
+0x4160,0x9b9a,0xb598,0x566f,
+0x41a5,0x0a8f,0xe357,0x37a7,
+0x4218,0x4c17,0x2e3a,0xfe49,
+0x425e,0xd6ba,0xed1e,0x7944,
+0x42b4,0xa2a6,0xcb80,0x13d3,
+0x42f2,0xdd8d,0xbf17,0xbe11,
+0x4332,0x40ca,0xf2ac,0x905a,
+0xc31c,0x27b2,0xa21c,0xcaff,
+0xc376,0x0b35,0x7b05,0x4649,
+0x4371,0x624d,0x4440,0x01c9,
+0x4374,0x942b,0x882f,0xdcd6,
+};
+static unsigned short B[40] = {
+/*0x3ff0,0x0000,0x0000,0x0000,*/
+0xc15e,0x3c7b,0x86c2,0xc36a,
+0xc1a3,0x22fc,0x63dd,0xa7b8,
+0xc216,0x227a,0x0c46,0x37a0,
+0xc25b,0xf551,0xce17,0x9d22,
+0xc2b2,0xe6b5,0x75d1,0x3955,
+0xc2f0,0xd476,0xd4ff,0x8884,
+0xc331,0x46dd,0x554d,0x96ab,
+0x4332,0xfe10,0x323f,0xae8b,
+0x4369,0x60cb,0x75cb,0x5498,
+0xc34f,0xf59d,0x3866,0x5e44,
+};
+#endif
+
+/* (1-x) (zeta(x) - 1), 0 <= x <= 1 */
+
+#ifdef UNK
+static double R[6] = {
+-3.28717474506562731748E-1,
+ 1.55162528742623950834E1,
+-2.48762831680821954401E2,
+ 1.01050368053237678329E3,
+ 1.26726061410235149405E4,
+-1.11578094770515181334E5,
+};
+static double S[5] = {
+/* 1.00000000000000000000E0,*/
+ 1.95107674914060531512E1,
+ 3.17710311750646984099E2,
+ 3.03835500874445748734E3,
+ 2.03665876435770579345E4,
+ 7.43853965136767874343E4,
+};
+#endif
+#ifdef DEC
+static unsigned short R[24] = {
+0137650,0046650,0022502,0040316,
+0041170,0041222,0057666,0142216,
+0142170,0141510,0167741,0075646,
+0042574,0120074,0046505,0106053,
+0043506,0001154,0130073,0101413,
+0144331,0166414,0020560,0131652,
+};
+static unsigned short S[20] = {
+/*0040200,0000000,0000000,0000000,*/
+0041234,0013015,0042073,0113570,
+0042236,0155353,0077325,0077445,
+0043075,0162656,0016646,0031723,
+0043637,0016454,0157636,0071126,
+0044221,0044262,0140365,0146434,
+};
+#endif
+#ifdef IBMPC
+static unsigned short R[24] = {
+0x481a,0x04a8,0x09b5,0xbfd5,
+0xd892,0x4bf6,0x0852,0x402f,
+0x2f75,0x1dfc,0x1869,0xc06f,
+0xb185,0x89a8,0x9407,0x408f,
+0x7061,0x9607,0xc04d,0x40c8,
+0x1675,0x842e,0x3da1,0xc0fb,
+};
+static unsigned short S[20] = {
+/*0x0000,0x0000,0x0000,0x3ff0,*/
+0x72ef,0xa887,0x82c1,0x4033,
+0xafe5,0x6fda,0xdb5d,0x4073,
+0xc67a,0xc3b4,0xbcb5,0x40a7,
+0xce4b,0x9bf3,0xe3a5,0x40d3,
+0xb9a3,0x581e,0x2916,0x40f2,
+};
+#endif
+#ifdef MIEEE
+static unsigned short R[24] = {
+0xbfd5,0x09b5,0x04a8,0x481a,
+0x402f,0x0852,0x4bf6,0xd892,
+0xc06f,0x1869,0x1dfc,0x2f75,
+0x408f,0x9407,0x89a8,0xb185,
+0x40c8,0xc04d,0x9607,0x7061,
+0xc0fb,0x3da1,0x842e,0x1675,
+};
+static unsigned short S[20] = {
+/*0x3ff0,0x0000,0x0000,0x0000,*/
+0x4033,0x82c1,0xa887,0x72ef,
+0x4073,0xdb5d,0x6fda,0xafe5,
+0x40a7,0xbcb5,0xc3b4,0xc67a,
+0x40d3,0xe3a5,0x9bf3,0xce4b,
+0x40f2,0x2916,0x581e,0xb9a3,
+};
+#endif
+
+#define MAXL2 127
+
+/*
+ * Riemann zeta function, minus one
+ */
+#ifdef ANSIPROT
+extern double sin ( double );
+extern double floor ( double );
+extern double gamma ( double );
+extern double pow ( double, double );
+extern double exp ( double );
+extern double polevl ( double, void *, int );
+extern double p1evl ( double, void *, int );
+double zetac ( double );
+#else
+double sin(), floor(), gamma(), pow(), exp();
+double polevl(), p1evl(), zetac();
+#endif
+extern double MACHEP;
+
+double zetac(x)
+double x;
+{
+int i;
+double a, b, s, w;
+
+if( x < 0.0 )
+ {
+#ifdef DEC
+ if( x < -30.8148 )
+#else
+ if( x < -170.6243 )
+#endif
+ {
+ mtherr( "zetac", OVERFLOW );
+ return(0.0);
+ }
+ s = 1.0 - x;
+ w = zetac( s );
+ b = sin(0.5*PI*x) * pow(2.0*PI, x) * gamma(s) * (1.0 + w) / PI;
+ return(b - 1.0);
+ }
+
+if( x >= MAXL2 )
+ return(0.0); /* because first term is 2**-x */
+
+/* Tabulated values for integer argument */
+w = floor(x);
+if( w == x )
+ {
+ i = x;
+ if( i < 31 )
+ {
+#ifdef UNK
+ return( azetac[i] );
+#else
+ return( *(double *)&azetac[4*i] );
+#endif
+ }
+ }
+
+
+if( x < 1.0 )
+ {
+ w = 1.0 - x;
+ a = polevl( x, R, 5 ) / ( w * p1evl( x, S, 5 ));
+ return( a );
+ }
+
+if( x == 1.0 )
+ {
+ mtherr( "zetac", SING );
+ return( MAXNUM );
+ }
+
+if( x <= 10.0 )
+ {
+ b = pow( 2.0, x ) * (x - 1.0);
+ w = 1.0/x;
+ s = (x * polevl( w, P, 8 )) / (b * p1evl( w, Q, 8 ));
+ return( s );
+ }
+
+if( x <= 50.0 )
+ {
+ b = pow( 2.0, -x );
+ w = polevl( x, A, 10 ) / p1evl( x, B, 10 );
+ w = exp(w) + b;
+ return(w);
+ }
+
+
+/* Basic sum of inverse powers */
+
+
+s = 0.0;
+a = 1.0;
+do
+ {
+ a += 2.0;
+ b = pow( a, -x );
+ s += b;
+ }
+while( b/s > MACHEP );
+
+b = pow( 2.0, -x );
+s = (s + b)/(1.0-b);
+return(s);
+}