aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Eric Andersen <andersen@codepoet.org>2001-11-22 14:04:29 +0000
committerGravatar Eric Andersen <andersen@codepoet.org>2001-11-22 14:04:29 +0000
commit7ce331c01ce6eb7b3f5c715a38a24359da9c6ee2 (patch)
tree3a7e8476e868ae15f4da1b7ce26b2db6f434468c
parentc117dd5fb183afb1a4790a6f6110d88704be6bf8 (diff)
downloaduClibc-7ce331c01ce6eb7b3f5c715a38a24359da9c6ee2.tar.gz
uClibc-7ce331c01ce6eb7b3f5c715a38a24359da9c6ee2.tar.bz2
Totally rework the math library, this time based on the MacOs X
math library (which is itself based on the math lib from FreeBSD). -Erik
-rw-r--r--include/math.h719
-rw-r--r--libm/Makefile62
-rw-r--r--libm/README50
-rw-r--r--libm/ceilfloor.c179
-rw-r--r--libm/double/Makefile114
-rw-r--r--libm/double/README.txt5845
-rw-r--r--libm/double/acos.c58
-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.c531
-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/noncephes.c127
-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.c79
-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
-rw-r--r--libm/e_acos.c111
-rw-r--r--libm/e_acosh.c69
-rw-r--r--libm/e_asin.c120
-rw-r--r--libm/e_atan2.c130
-rw-r--r--libm/e_atanh.c74
-rw-r--r--libm/e_cosh.c93
-rw-r--r--libm/e_exp.c167
-rw-r--r--libm/e_fmod.c140
-rw-r--r--libm/e_gamma.c34
-rw-r--r--libm/e_gamma_r.c33
-rw-r--r--libm/e_hypot.c128
-rw-r--r--libm/e_j0.c487
-rw-r--r--libm/e_j1.c486
-rw-r--r--libm/e_jn.c281
-rw-r--r--libm/e_lgamma.c34
-rw-r--r--libm/e_lgamma_r.c316
-rw-r--r--libm/e_log.c146
-rw-r--r--libm/e_log10.c98
-rw-r--r--libm/e_pow.c308
-rw-r--r--libm/e_rem_pio2.c183
-rw-r--r--libm/e_remainder.c80
-rw-r--r--libm/e_scalb.c55
-rw-r--r--libm/e_sinh.c86
-rw-r--r--libm/e_sqrt.c453
-rw-r--r--libm/float/Makefile59
-rw-r--r--libm/float/README.txt4721
-rw-r--r--libm/float/acoshf.c97
-rw-r--r--libm/float/airyf.c377
-rw-r--r--libm/float/asinf.c186
-rw-r--r--libm/float/asinhf.c88
-rw-r--r--libm/float/atanf.c190
-rw-r--r--libm/float/atanhf.c92
-rw-r--r--libm/float/bdtrf.c247
-rw-r--r--libm/float/betaf.c122
-rw-r--r--libm/float/cbrtf.c119
-rw-r--r--libm/float/chbevlf.c86
-rw-r--r--libm/float/chdtrf.c210
-rw-r--r--libm/float/clogf.c669
-rw-r--r--libm/float/cmplxf.c407
-rw-r--r--libm/float/constf.c20
-rw-r--r--libm/float/coshf.c67
-rw-r--r--libm/float/dawsnf.c168
-rw-r--r--libm/float/ellief.c115
-rw-r--r--libm/float/ellikf.c113
-rw-r--r--libm/float/ellpef.c105
-rw-r--r--libm/float/ellpjf.c161
-rw-r--r--libm/float/ellpkf.c128
-rw-r--r--libm/float/exp10f.c115
-rw-r--r--libm/float/exp2f.c116
-rw-r--r--libm/float/expf.c122
-rw-r--r--libm/float/expnf.c207
-rw-r--r--libm/float/facf.c106
-rw-r--r--libm/float/fdtrf.c214
-rw-r--r--libm/float/floorf.c526
-rw-r--r--libm/float/fresnlf.c173
-rw-r--r--libm/float/gammaf.c423
-rw-r--r--libm/float/gdtrf.c144
-rw-r--r--libm/float/hyp2f1f.c442
-rw-r--r--libm/float/hypergf.c384
-rw-r--r--libm/float/i0f.c160
-rw-r--r--libm/float/i1f.c177
-rw-r--r--libm/float/igamf.c223
-rw-r--r--libm/float/igamif.c112
-rw-r--r--libm/float/incbetf.c424
-rw-r--r--libm/float/incbif.c197
-rw-r--r--libm/float/ivf.c114
-rw-r--r--libm/float/j0f.c228
-rw-r--r--libm/float/j0tst.c43
-rw-r--r--libm/float/j1f.c211
-rw-r--r--libm/float/jnf.c124
-rw-r--r--libm/float/jvf.c848
-rw-r--r--libm/float/k0f.c175
-rw-r--r--libm/float/k1f.c174
-rw-r--r--libm/float/knf.c252
-rw-r--r--libm/float/log10f.c129
-rw-r--r--libm/float/log2f.c129
-rw-r--r--libm/float/logf.c128
-rw-r--r--libm/float/mtherr.c99
-rw-r--r--libm/float/nantst.c54
-rw-r--r--libm/float/nbdtrf.c141
-rw-r--r--libm/float/ndtrf.c281
-rw-r--r--libm/float/ndtrif.c186
-rw-r--r--libm/float/pdtrf.c188
-rw-r--r--libm/float/polevlf.c99
-rw-r--r--libm/float/polynf.c520
-rw-r--r--libm/float/powf.c338
-rw-r--r--libm/float/powif.c156
-rw-r--r--libm/float/powtst.c41
-rw-r--r--libm/float/psif.c153
-rw-r--r--libm/float/rgammaf.c130
-rw-r--r--libm/float/setprec.c10
-rw-r--r--libm/float/shichif.c212
-rw-r--r--libm/float/sicif.c279
-rw-r--r--libm/float/sindgf.c232
-rw-r--r--libm/float/sinf.c283
-rw-r--r--libm/float/sinhf.c87
-rw-r--r--libm/float/spencef.c135
-rw-r--r--libm/float/sqrtf.c140
-rw-r--r--libm/float/stdtrf.c154
-rw-r--r--libm/float/struvef.c315
-rw-r--r--libm/float/tandgf.c206
-rw-r--r--libm/float/tanf.c192
-rw-r--r--libm/float/tanhf.c88
-rw-r--r--libm/float/ynf.c120
-rw-r--r--libm/float/zetacf.c266
-rw-r--r--libm/float/zetaf.c175
-rw-r--r--libm/fp_private.h112
-rw-r--r--libm/fpmacros.c239
-rw-r--r--libm/frexpldexp.c73
-rw-r--r--libm/k_cos.c96
-rw-r--r--libm/k_rem_pio2.c320
-rw-r--r--libm/k_sin.c79
-rw-r--r--libm/k_standard.c782
-rw-r--r--libm/k_tan.c131
-rw-r--r--libm/ldouble/Makefile122
-rw-r--r--libm/ldouble/README.txt3502
-rw-r--r--libm/ldouble/acoshl.c167
-rw-r--r--libm/ldouble/arcdotl.c108
-rw-r--r--libm/ldouble/asinhl.c156
-rw-r--r--libm/ldouble/asinl.c249
-rw-r--r--libm/ldouble/atanhl.c163
-rw-r--r--libm/ldouble/atanl.c376
-rw-r--r--libm/ldouble/bdtrl.c260
-rw-r--r--libm/ldouble/btdtrl.c68
-rw-r--r--libm/ldouble/cbrtl.c143
-rw-r--r--libm/ldouble/chdtrl.c200
-rw-r--r--libm/ldouble/clogl.c720
-rw-r--r--libm/ldouble/cmplxl.c461
-rw-r--r--libm/ldouble/coshl.c89
-rw-r--r--libm/ldouble/econst.c96
-rw-r--r--libm/ldouble/ehead.h45
-rw-r--r--libm/ldouble/elliel.c146
-rw-r--r--libm/ldouble/ellikl.c148
-rw-r--r--libm/ldouble/ellpel.c173
-rw-r--r--libm/ldouble/ellpjl.c164
-rw-r--r--libm/ldouble/ellpkl.c203
-rw-r--r--libm/ldouble/exp10l.c192
-rw-r--r--libm/ldouble/exp2l.c166
-rw-r--r--libm/ldouble/expl.c183
-rw-r--r--libm/ldouble/fdtrl.c237
-rw-r--r--libm/ldouble/floorl.c432
-rw-r--r--libm/ldouble/flrtstl.c104
-rw-r--r--libm/ldouble/fltestl.c265
-rw-r--r--libm/ldouble/gammal.c764
-rw-r--r--libm/ldouble/gdtrl.c130
-rw-r--r--libm/ldouble/gelsl.c240
-rw-r--r--libm/ldouble/ieee.c4182
-rw-r--r--libm/ldouble/igamil.c193
-rw-r--r--libm/ldouble/igaml.c220
-rw-r--r--libm/ldouble/incbetl.c406
-rw-r--r--libm/ldouble/incbil.c305
-rw-r--r--libm/ldouble/isnanl.c186
-rw-r--r--libm/ldouble/j0l.c541
-rw-r--r--libm/ldouble/j1l.c551
-rw-r--r--libm/ldouble/jnl.c130
-rw-r--r--libm/ldouble/lcalc.c1484
-rw-r--r--libm/ldouble/lcalc.h79
-rw-r--r--libm/ldouble/ldrand.c175
-rw-r--r--libm/ldouble/log10l.c319
-rw-r--r--libm/ldouble/log2l.c302
-rw-r--r--libm/ldouble/logl.c292
-rw-r--r--libm/ldouble/lparanoi.c2348
-rw-r--r--libm/ldouble/monotl.c307
-rw-r--r--libm/ldouble/mtherr.c102
-rw-r--r--libm/ldouble/mtstl.c521
-rw-r--r--libm/ldouble/nantst.c61
-rw-r--r--libm/ldouble/nbdtrl.c197
-rw-r--r--libm/ldouble/ndtril.c416
-rw-r--r--libm/ldouble/ndtrl.c473
-rw-r--r--libm/ldouble/pdtrl.c184
-rw-r--r--libm/ldouble/polevll.c182
-rw-r--r--libm/ldouble/powil.c164
-rw-r--r--libm/ldouble/powl.c739
-rw-r--r--libm/ldouble/sinhl.c150
-rw-r--r--libm/ldouble/sinl.c342
-rw-r--r--libm/ldouble/sqrtl.c172
-rw-r--r--libm/ldouble/stdtrl.c225
-rw-r--r--libm/ldouble/tanhl.c129
-rw-r--r--libm/ldouble/tanl.c279
-rw-r--r--libm/ldouble/testvect.c497
-rw-r--r--libm/ldouble/unityl.c128
-rw-r--r--libm/ldouble/wronkl.c67
-rw-r--r--libm/ldouble/ynl.c113
-rw-r--r--libm/logb.c104
-rw-r--r--libm/math_private.h231
-rw-r--r--libm/rndint.c627
-rw-r--r--libm/s_asinh.c65
-rw-r--r--libm/s_atan.c139
-rw-r--r--libm/s_cbrt.c93
-rw-r--r--libm/s_ceil.c82
-rw-r--r--libm/s_copysign.c40
-rw-r--r--libm/s_cos.c82
-rw-r--r--libm/s_erf.c314
-rw-r--r--libm/s_expm1.c228
-rw-r--r--libm/s_fabs.c35
-rw-r--r--libm/s_finite.c35
-rw-r--r--libm/s_floor.c83
-rw-r--r--libm/s_frexp.c61
-rw-r--r--libm/s_ilogb.c51
-rw-r--r--libm/s_ldexp.c34
-rw-r--r--libm/s_lib_version.c39
-rw-r--r--libm/s_log1p.c173
-rw-r--r--libm/s_logb.c44
-rw-r--r--libm/s_matherr.c30
-rw-r--r--libm/s_modf.c85
-rw-r--r--libm/s_nextafter.c79
-rw-r--r--libm/s_rint.c88
-rw-r--r--libm/s_scalbn.c66
-rw-r--r--libm/s_signgam.c3
-rw-r--r--libm/s_significand.c34
-rw-r--r--libm/s_sin.c82
-rw-r--r--libm/s_tan.c76
-rw-r--r--libm/s_tanh.c86
-rw-r--r--libm/scalb.c87
-rw-r--r--libm/sign.c58
-rw-r--r--libm/w_acos.c43
-rw-r--r--libm/w_acosh.c42
-rw-r--r--libm/w_asin.c44
-rw-r--r--libm/w_atan2.c42
-rw-r--r--libm/w_atanh.c47
-rw-r--r--libm/w_cabs.c20
-rw-r--r--libm/w_cosh.c42
-rw-r--r--libm/w_drem.c15
-rw-r--r--libm/w_exp.c53
-rw-r--r--libm/w_fmod.c43
-rw-r--r--libm/w_gamma.c49
-rw-r--r--libm/w_gamma_r.c46
-rw-r--r--libm/w_hypot.c43
-rw-r--r--libm/w_j0.c69
-rw-r--r--libm/w_j1.c70
-rw-r--r--libm/w_jn.c92
-rw-r--r--libm/w_lgamma.c49
-rw-r--r--libm/w_lgamma_r.c46
-rw-r--r--libm/w_log.c43
-rw-r--r--libm/w_log10.c46
-rw-r--r--libm/w_pow.c61
-rw-r--r--libm/w_remainder.c42
-rw-r--r--libm/w_scalb.c62
-rw-r--r--libm/w_sinh.c42
-rw-r--r--libm/w_sqrt.c42
368 files changed, 10956 insertions, 91586 deletions
diff --git a/include/math.h b/include/math.h
index 955e66a83..8a2e86c2f 100644
--- a/include/math.h
+++ b/include/math.h
@@ -1,212 +1,121 @@
-/* mconf.h
- * <math.h>
- * ISO/IEC 9899:1999 -- Programming Languages C: 7.12 Mathematics
- * Derived from the Cephes Math Library Release 2.3
- * Copyright 1984, 1987, 1989, 1995 by Stephen L. Moshier
- *
- *
- * DESCRIPTION:
- *
- * The file also includes a conditional assembly definition
- * for the type of computer arithmetic (IEEE, DEC, Motorola
- * IEEE, or UNKnown).
- *
- * For Digital Equipment PDP-11 and VAX computers, certain
- * IBM systems, and others that use numbers with a 56-bit
- * significand, the symbol DEC should be defined. In this
- * mode, most floating point constants are given as arrays
- * of octal integers to eliminate decimal to binary conversion
- * errors that might be introduced by the compiler.
- *
- * For little-endian computers, such as IBM PC, that follow the
- * IEEE Standard for Binary Floating Point Arithmetic (ANSI/IEEE
- * Std 754-1985), the symbol IBMPC should be defined. These
- * numbers have 53-bit significands. In this mode, constants
- * are provided as arrays of hexadecimal 16 bit integers.
- *
- * Big-endian IEEE format is denoted MIEEE. On some RISC
- * systems such as Sun SPARC, double precision constants
- * must be stored on 8-byte address boundaries. Since integer
- * arrays may be aligned differently, the MIEEE configuration
- * may fail on such machines.
- *
- * To accommodate other types of computer arithmetic, all
- * constants are also provided in a normal decimal radix
- * which one can hope are correctly converted to a suitable
- * format by the available C language compiler. To invoke
- * this mode, define the symbol UNK.
- *
- * An important difference among these modes is a predefined
- * set of machine arithmetic constants for each. The numbers
- * MACHEP (the machine roundoff error), MAXNUM (largest number
- * represented), and several other parameters are preset by
- * the configuration symbol. Check the file const.c to
- * ensure that these values are correct for your computer.
- *
- * Configurations NANS, INFINITIES, MINUSZERO, and DENORMAL
- * may fail on many systems. Verify that they are supposed
- * to work on your computer.
+/* Declarations for math functions.
+ Copyright (C) 1991,92,93,95,96,97,98,99,2001 Free Software Foundation, Inc.
+ This file is part of the GNU C Library.
+
+ The GNU C Library is free software; you can redistribute it and/or
+ modify it under the terms of the GNU Lesser General Public
+ License as published by the Free Software Foundation; either
+ version 2.1 of the License, or (at your option) any later version.
+
+ The GNU C Library is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ Lesser General Public License for more details.
+
+ You should have received a copy of the GNU Lesser General Public
+ License along with the GNU C Library; if not, write to the Free
+ Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
+ 02111-1307 USA. */
+
+/*
+ * ISO C99 Standard: 7.12 Mathematics <math.h>
*/
-
#ifndef _MATH_H
#define _MATH_H 1
#include <features.h>
-#include <bits/huge_val.h>
-
-/* Type of computer arithmetic */
-
-/* PDP-11, Pro350, VAX:
- */
-/* #define DEC 1 */
-
-/* Intel IEEE, low order words come first:
- */
-/* #define IBMPC 1 */
-
-/* Motorola IEEE, high order words come first
- * (Sun 680x0 workstation):
- */
-/* #define MIEEE 1 */
-
-/* UNKnown arithmetic, invokes coefficients given in
- * normal decimal format. Beware of range boundary
- * problems (MACHEP, MAXLOG, etc. in const.c) and
- * roundoff problems in pow.c:
- * (Sun SPARCstation)
- */
-#define UNK 1
+__BEGIN_DECLS
-/* Define if the `long double' type works. */
-#define HAVE_LONG_DOUBLE 1
-
-/* Define as the return type of signal handlers (int or void). */
-#define RETSIGTYPE void
-
-/* Define if you have the ANSI C header files. */
-#define STDC_HEADERS 1
-
-/* Define if your processor stores words with the most significant
- byte first (like Motorola and SPARC, unlike Intel and VAX). */
-/* #undef WORDS_BIGENDIAN */
-
-/* Define if floating point words are bigendian. */
-/* #undef FLOAT_WORDS_BIGENDIAN */
-
-/* The number of bytes in a int. */
-#define SIZEOF_INT 4
-
-/* Define if you have the <string.h> header file. */
-#define HAVE_STRING_H 1
-
-
-/* Define this `volatile' if your compiler thinks
- * that floating point arithmetic obeys the associative
- * and distributive laws. It will defeat some optimizations
- * (but probably not enough of them).
- *
- * #define VOLATILE volatile
- */
-#define VOLATILE
-
-/* For 12-byte long doubles on an i386, pad a 16-bit short 0
- * to the end of real constants initialized by integer arrays.
- *
- * #define XPD 0,
- *
- * Otherwise, the type is 10 bytes long and XPD should be
- * defined blank (e.g., Microsoft C).
- *
- * #define XPD
- */
-#define XPD 0,
-
-/* Define to support tiny denormal numbers, else undefine. */
-#define DENORMAL 1
-
-/* Define to ask for infinity support, else undefine. */
-#define INFINITIES 1
-
-/* Define to ask for support of numbers that are Not-a-Number,
- else undefine. This may automatically define INFINITIES in some files. */
-#define NANS 1
-
-/* Define to distinguish between -0.0 and +0.0. */
-#define MINUSZERO 1
-
-/* Define 1 for ANSI C atan2() function
- and ANSI prototypes for float arguments.
- See atan.c and clog.c. */
-#define ANSIC 1
-#define ANSIPROT 1
-
-
-/* Constant definitions for math error conditions */
-
-#define DOMAIN 1 /* argument domain error */
-#define SING 2 /* argument singularity */
-#define OVERFLOW 3 /* overflow range error */
-#define UNDERFLOW 4 /* underflow range error */
-#define TLOSS 5 /* total loss of precision */
-#define PLOSS 6 /* partial loss of precision */
-
-#define EDOM 33
-#define ERANGE 34
+/* Get machine-dependent HUGE_VAL value (returned on overflow).
+ On all IEEE754 machines, this is +Infinity. */
+#include <bits/huge_val.h>
-/* Complex numeral. */
-#ifdef __UCLIBC_HAS_LIBM_DOUBLE__
-typedef struct
- {
- double r;
- double i;
- } cmplx;
+/* Get machine-dependent NAN value (returned for some domain errors). */
+#ifdef __USE_ISOC99
+# include <bits/nan.h>
#endif
+/* Get general and ISO C99 specific information. */
+#include <bits/mathdef.h>
-#ifdef __UCLIBC_HAS_LIBM_FLOAT__
-typedef struct
- {
- float r;
- float i;
- } cmplxf;
-#endif
-#ifdef __UCLIBC_HAS_LIBM_LONG_DOUBLE__
-/* Long double complex numeral. */
-typedef struct
- {
- long double r;
- long double i;
- } cmplxl;
-#endif
+/* The file <bits/mathcalls.h> contains the prototypes for all the
+ actual math functions. These macros are used for those prototypes,
+ so we can easily declare each function as both `name' and `__name',
+ and can declare the float versions `namef' and `__namef'. */
+#define __MATHCALL(function,suffix, args) \
+ __MATHDECL (_Mdouble_,function,suffix, args)
+#define __MATHDECL(type, function,suffix, args) \
+ __MATHDECL_1(type, function,suffix, args); \
+ __MATHDECL_1(type, __CONCAT(__,function),suffix, args)
+#define __MATHCALLX(function,suffix, args, attrib) \
+ __MATHDECLX (_Mdouble_,function,suffix, args, attrib)
+#define __MATHDECLX(type, function,suffix, args, attrib) \
+ __MATHDECL_1(type, function,suffix, args) __attribute__ (attrib); \
+ __MATHDECL_1(type, __CONCAT(__,function),suffix, args) __attribute__ (attrib)
+#define __MATHDECL_1(type, function,suffix, args) \
+ extern type __MATH_PRECNAME(function,suffix) args __THROW
+#define _Mdouble_ double
+#define __MATH_PRECNAME(name,r) __CONCAT(name,r)
+#include <bits/mathcalls.h>
+#undef _Mdouble_
+#undef __MATH_PRECNAME
+
+#if defined __USE_MISC || defined __USE_ISOC99
-/* Variable for error reporting. See mtherr.c. */
-__BEGIN_DECLS
-extern int mtherr(char *name, int code);
-extern int merror;
-__END_DECLS
+/* Include the file of declarations again, this time using `float'
+ instead of `double' and appending f to each function name. */
-/* If you define UNK, then be sure to set BIGENDIAN properly. */
-#include <endian.h>
-#if __BYTE_ORDER == __BIG_ENDIAN
-# define BIGENDIAN 1
-#else /* __BYTE_ORDER == __LITTLE_ENDIAN */
-# define BIGENDIAN 0
+# ifndef _Mfloat_
+# define _Mfloat_ float
+# endif
+# define _Mdouble_ _Mfloat_
+# ifdef __STDC__
+# define __MATH_PRECNAME(name,r) name##f##r
+# else
+# define __MATH_PRECNAME(name,r) name/**/f/**/r
+# endif
+# include <bits/mathcalls.h>
+# undef _Mdouble_
+# undef __MATH_PRECNAME
+
+# if (__STDC__ - 0 || __GNUC__ - 0) && !defined __NO_LONG_DOUBLE_MATH
+/* Include the file of declarations again, this time using `long double'
+ instead of `double' and appending l to each function name. */
+
+# ifndef _Mlong_double_
+# define _Mlong_double_ long double
+# endif
+# define _Mdouble_ _Mlong_double_
+# ifdef __STDC__
+# define __MATH_PRECNAME(name,r) name##l##r
+# else
+# define __MATH_PRECNAME(name,r) name/**/l/**/r
+# endif
+# include <bits/mathcalls.h>
+# undef _Mdouble_
+# undef __MATH_PRECNAME
+
+# endif /* __STDC__ || __GNUC__ */
+
+#endif /* Use misc or ISO C99. */
+#undef __MATHDECL_1
+#undef __MATHDECL
+#undef __MATHCALL
+
+
+#if defined __USE_MISC || defined __USE_XOPEN
+/* This variable is used by `gamma' and `lgamma'. */
+extern int signgam;
#endif
-
-#define __USE_ISOC9X
-/* Get general and ISO C 9X specific information. */
-#include <bits/mathdef.h>
-#undef INFINITY
-#undef DECIMAL_DIG
-#undef FP_ILOGB0
-#undef FP_ILOGBNAN
+/* ISO C99 defines some generic macros which work on any data type. */
+#if __USE_ISOC99
/* Get the architecture specific values describing the floating-point
evaluation. The following symbols will get defined:
@@ -257,47 +166,139 @@ enum
};
/* Return number of classification appropriate for X. */
-#ifdef __UCLIBC_HAS_LIBM_DOUBLE__
-# define fpclassify(x) \
- (sizeof (x) == sizeof (float) ? \
- __fpclassifyf (x) \
- : sizeof (x) == sizeof (double) ? \
- __fpclassify (x) : __fpclassifyl (x))
-#else
+# ifdef __NO_LONG_DOUBLE_MATH
# define fpclassify(x) \
(sizeof (x) == sizeof (float) ? __fpclassifyf (x) : __fpclassify (x))
-#endif
-
-__BEGIN_DECLS
+# else
+# define fpclassify(x) \
+ (sizeof (x) == sizeof (float) \
+ ? __fpclassifyf (x) \
+ : sizeof (x) == sizeof (double) \
+ ? __fpclassify (x) : __fpclassifyl (x))
+# endif
-#ifdef __UCLIBC_HAS_LIBM_DOUBLE__
/* Return nonzero value if sign of X is negative. */
-extern int signbit(double x);
+# ifdef __NO_LONG_DOUBLE_MATH
+# define signbit(x) \
+ (sizeof (x) == sizeof (float) ? __signbitf (x) : __signbit (x))
+# else
+# define signbit(x) \
+ (sizeof (x) == sizeof (float) \
+ ? __signbitf (x) \
+ : sizeof (x) == sizeof (double) \
+ ? __signbit (x) : __signbitl (x))
+# endif
+
/* Return nonzero value if X is not +-Inf or NaN. */
-extern int isfinite(double x);
+# ifdef __NO_LONG_DOUBLE_MATH
+# define isfinite(x) \
+ (sizeof (x) == sizeof (float) ? __finitef (x) : __finite (x))
+# else
+# define isfinite(x) \
+ (sizeof (x) == sizeof (float) \
+ ? __finitef (x) \
+ : sizeof (x) == sizeof (double) \
+ ? __finite (x) : __finitel (x))
+# endif
+
/* Return nonzero value if X is neither zero, subnormal, Inf, nor NaN. */
# define isnormal(x) (fpclassify (x) == FP_NORMAL)
-/* Return nonzero value if X is a NaN */
-extern int isnan(double x);
-#define isinf(x) \
- (sizeof (x) == sizeof (float) ? \
- __isinff (x) \
- : sizeof (x) == sizeof (double) ? \
- __isinf (x) : __isinfl (x))
-#else
+
+/* Return nonzero value if X is a NaN. We could use `fpclassify' but
+ we already have this functions `__isnan' and it is faster. */
+# ifdef __NO_LONG_DOUBLE_MATH
+# define isnan(x) \
+ (sizeof (x) == sizeof (float) ? __isnanf (x) : __isnan (x))
+# else
+# define isnan(x) \
+ (sizeof (x) == sizeof (float) \
+ ? __isnanf (x) \
+ : sizeof (x) == sizeof (double) \
+ ? __isnan (x) : __isnanl (x))
+# endif
+
+/* Return nonzero value is X is positive or negative infinity. */
+# ifdef __NO_LONG_DOUBLE_MATH
# define isinf(x) \
(sizeof (x) == sizeof (float) ? __isinff (x) : __isinf (x))
+# else
+# define isinf(x) \
+ (sizeof (x) == sizeof (float) \
+ ? __isinff (x) \
+ : sizeof (x) == sizeof (double) \
+ ? __isinf (x) : __isinfl (x))
+# endif
+
+/* Bitmasks for the math_errhandling macro. */
+# define MATH_ERRNO 1 /* errno set by math functions. */
+# define MATH_ERREXCEPT 2 /* Exceptions raised by math functions. */
+
+#endif /* Use ISO C99. */
+
+#ifdef __USE_MISC
+/* Support for various different standard error handling behaviors. */
+typedef enum
+{
+ _IEEE_ = -1, /* According to IEEE 754/IEEE 854. */
+ _SVID_, /* According to System V, release 4. */
+ _XOPEN_, /* Nowadays also Unix98. */
+ _POSIX_,
+ _ISOC_ /* Actually this is ISO C99. */
+} _LIB_VERSION_TYPE;
+
+/* This variable can be changed at run-time to any of the values above to
+ affect floating point error handling behavior (it may also be necessary
+ to change the hardware FPU exception settings). */
+extern _LIB_VERSION_TYPE _LIB_VERSION;
#endif
-#ifdef __UCLIBC_HAS_LIBM_LONG_DOUBLE__
-/* Return nonzero value if sign of X is negative. */
-extern int signbitl(long double x);
-/* Return nonzero value if X is not +-Inf or NaN. */
-extern int isfinitel(long double x);
-/* Return nonzero value if X is a NaN */
-extern int isnanl(long double x);
-#endif
+#ifdef __USE_SVID
+/* In SVID error handling, `matherr' is called with this description
+ of the exceptional condition.
+
+ We have a problem when using C++ since `exception' is a reserved
+ name in C++. */
+# ifdef __cplusplus
+struct __exception
+# else
+struct exception
+# endif
+ {
+ int type;
+ char *name;
+ double arg1;
+ double arg2;
+ double retval;
+ };
+
+# ifdef __cplusplus
+extern int matherr (struct __exception *__exc) throw ();
+# else
+extern int matherr (struct exception *__exc);
+# endif
+
+# define X_TLOSS 1.41484755040568800000e+16
+
+/* Types of exceptions in the `type' field. */
+# define DOMAIN 1
+# define SING 2
+# define OVERFLOW 3
+# define UNDERFLOW 4
+# define TLOSS 5
+# define PLOSS 6
+
+/* SVID mode specifies returning this large value instead of infinity. */
+# define HUGE 3.40282347e+38F
+
+#else /* !SVID */
+
+# ifdef __USE_XOPEN
+/* X/Open wants another strange constant. */
+# define MAXFLOAT 3.40282347e+38F
+# endif
+
+#endif /* SVID */
/* Some useful constants. */
@@ -316,257 +317,48 @@ extern int isnanl(long double x);
# define M_SQRT2 1.41421356237309504880 /* sqrt(2) */
# define M_SQRT1_2 0.70710678118654752440 /* 1/sqrt(2) */
#endif
+
+/* The above constants are not adequate for computation using `long double's.
+ Therefore we provide as an extension constants with similar names as a
+ GNU extension. Provide enough digits for the 128-bit IEEE quad. */
#ifdef __USE_GNU
-# define M_El M_E
-# define M_LOG2El M_LOG2E
-# define M_LOG10El M_LOG10E
-# define M_LN2l M_LN2
-# define M_LN10l M_LN10
-# define M_PIl M_PI
-# define M_PI_2l M_PI_2
-# define M_PI_4l M_PI_4
-# define M_1_PIl M_1_PI
-# define M_2_PIl M_2_PI
-# define M_2_SQRTPIl M_2_SQRTPI
-# define M_SQRT2l M_SQRT2
-# define M_SQRT1_2l M_SQRT1_2
+# define M_El 2.7182818284590452353602874713526625L /* e */
+# define M_LOG2El 1.4426950408889634073599246810018922L /* log_2 e */
+# define M_LOG10El 0.4342944819032518276511289189166051L /* log_10 e */
+# define M_LN2l 0.6931471805599453094172321214581766L /* log_e 2 */
+# define M_LN10l 2.3025850929940456840179914546843642L /* log_e 10 */
+# define M_PIl 3.1415926535897932384626433832795029L /* pi */
+# define M_PI_2l 1.5707963267948966192313216916397514L /* pi/2 */
+# define M_PI_4l 0.7853981633974483096156608458198757L /* pi/4 */
+# define M_1_PIl 0.3183098861837906715377675267450287L /* 1/pi */
+# define M_2_PIl 0.6366197723675813430755350534900574L /* 2/pi */
+# define M_2_SQRTPIl 1.1283791670955125738961589031215452L /* 2/sqrt(pi) */
+# define M_SQRT2l 1.4142135623730950488016887242096981L /* sqrt(2) */
+# define M_SQRT1_2l 0.7071067811865475244008443621048490L /* 1/sqrt(2) */
#endif
+/* When compiling in strict ISO C compatible mode we must not use the
+ inline functions since they, among other things, do not set the
+ `errno' variable correctly. */
+#if defined __STRICT_ANSI__ && !defined __NO_MATH_INLINES
+# define __NO_MATH_INLINES 1
+#endif
-#ifdef __UCLIBC_HAS_LIBM_DOUBLE__
-/* 7.12.4 Trigonometric functions */
-extern double acos(double x);
-extern double asin(double x);
-extern double atan(double x);
-extern double atan2(double y, double x);
-extern double cos(double x);
-extern double sin(double x);
-extern double tan(double x);
-
-/* 7.12.5 Hyperbolic functions */
-extern double acosh(double x);
-extern double asinh(double x);
-extern double atanh(double x);
-extern double cosh(double x);
-extern double sinh(double x);
-extern double tanh(double x);
-
-/* 7.12.6 Exponential and logarithmic functions */
-extern double exp(double x);
-extern double exp2(double x);
-extern double expm1(double x);
-extern double frexp(double value, int *ex);
-extern int ilogb(double x);
-extern double ldexp(double x, int ex);
-extern double log(double x);
-extern double log10(double x);
-extern double log1p(double x);
-extern double log2(double x);
-extern double logb(double x);
-extern double modf(double value, double *iptr);
-extern double scalbn(double x, int n);
-extern double scalbln(double x, long int n);
-
-/* 7.12.7 Power and absolute-value functions */
-extern double fabs(double x);
-extern double hypot(double x, double y);
-extern double pow(double x, double y);
-extern double sqrt(double x);
-
-/* 7.12.8 Error and gamma functions */
-extern double erf(double x);
-extern double erfc(double x);
-extern double lgamma(double x);
-extern double tgamma(double x);
-
-/* 7.12.9 Nearest integer functions */
-extern double ceil(double x);
-extern double floor(double x);
-extern double nearbyint(double x);
-extern double rint(double x);
-extern long int lrint(double x);
-extern long long int llrint(double x);
-extern double round(double x);
-extern long int lround(double x);
-extern long long int llround(double x);
-extern double trunc(double x);
-
-/* 7.12.10 Remainder functions */
-extern double fmod(double x, double y);
-extern double remainder(double x, double y);
-extern double remquo(double x, double y, int *quo);
-
-/* 7.12.11 Manipulation functions */
-extern double copysign(double x, double y);
-extern double nan(const char *tagp);
-extern double nextafter(double x, double y);
-
-/* 7.12.12 Maximum, minimum, and positive difference functions */
-extern double fdim(double x, double y);
-extern double fmax(double x, double y);
-extern double fmin(double x, double y);
-
-/* 7.12.13 Floating multiply-add */
-extern double fma(double x, double y, double z);
-#endif
-
-#ifdef __UCLIBC_HAS_LIBM_FLOAT__
-/* 7.12.4 Trigonometric functions */
-extern float acosf(float x);
-extern float asinf(float x);
-extern float atanf(float x);
-extern float atan2f(float y, float x);
-extern float cosf(float x);
-extern float sinf(float x);
-extern float tanf(float x);
-
-/* 7.12.5 Hyperbolic functions */
-extern float acoshf(float x);
-extern float asinhf(float x);
-extern float atanhf(float x);
-extern float coshf(float x);
-extern float sinhf(float x);
-extern float tanhf(float x);
-
-/* 7.12.6 Exponential and logarithmic functions */
-extern float expf(float x);
-extern float exp2f(float x);
-extern float expm1f(float x);
-extern float frexpf(float value, int *ex);
-extern int ilogbf(float x);
-extern float ldexpf(float x, int ex);
-extern float logf(float x);
-extern float log10f(float x);
-extern float log1pf(float x);
-extern float log2f(float x);
-extern float logbf(float x);
-extern float modff(float value, float *iptr);
-extern float scalbnf(float x, int n);
-extern float scalblnf(float x, long int n);
-
-/* 7.12.7 Power and absolute-value functions */
-extern float fabsf(float x);
-extern float hypotf(float x, float y);
-extern float powf(float x, float y);
-extern float sqrtf(float x);
-
-/* 7.12.8 Error and gamma functions */
-extern float erff(float x);
-extern float erfcf(float x);
-extern float lgammaf(float x);
-extern float tgammaf(float x);
-
-/* 7.12.9 Nearest integer functions */
-extern float ceilf(float x);
-extern float floorf(float x);
-extern float nearbyintf(float x);
-extern float rintf(float x);
-extern long int lrintf(float x);
-extern long long int llrintf(float x);
-extern float roundf(float x);
-extern long int lroundf(float x);
-extern long long int llroundf(float x);
-extern float truncf(float x);
-
-/* 7.12.10 Remainder functions */
-extern float fmodf(float x, float y);
-extern float remainderf(float x, float y);
-extern float remquof(float x, float y, int *quo);
-
-/* 7.12.11 Manipulation functions */
-extern float copysignf(float x, float y);
-extern float nanf(const char *tagp);
-extern float nextafterf(float x, float y);
-
-/* 7.12.12 Maximum, minimum, and positive difference functions */
-extern float fdimf(float x, float y);
-extern float fmaxf(float x, float y);
-extern float fminf(float x, float y);
-
-/* 7.12.13 Floating multiply-add */
-extern float fmaf(float x, float y, float z);
-#endif
-
-#ifdef __UCLIBC_HAS_LIBM_LONG_DOUBLE__
-/* 7.12.4 Trigonometric functions */
-extern long double acosl(long double x);
-extern long double asinl(long double x);
-extern long double atanl(long double x);
-extern long double atan2l(long double y, long double x);
-extern long double cosl(long double x);
-extern long double sinl(long double x);
-extern long double tanl(long double x);
-
-/* 7.12.5 Hyperbolic functions */
-extern long double acoshl(long double x);
-extern long double asinhl(long double x);
-extern long double atanhl(long double x);
-extern long double coshl(long double x);
-extern long double sinhl(long double x);
-extern long double tanhl(long double x);
-
-/* 7.12.6 Exponential and logarithmic functions */
-extern long double expl(long double x);
-extern long double exp2l(long double x);
-extern long double expm1l(long double x);
-extern long double frexpl(long double value, int *ex);
-extern int ilogbl(long double x);
-extern long double ldexpl(long double x, int ex);
-extern long double logl(long double x);
-extern long double log10l(long double x);
-extern long double log1pl(long double x);
-extern long double log2l(long double x);
-extern long double logbl(long double x);
-extern long double modfl(long double value, long double *iptr);
-extern long double scalbnl(long double x, int n);
-extern long double scalblnl(long double x, long int n);
-
-/* 7.12.7 Power and absolute-value functions */
-extern long double fabsl(long double x);
-extern long double hypotl(long double x, long double y);
-extern long double powl(long double x, long double y);
-extern long double sqrtl(long double x);
-
-/* 7.12.8 Error and gamma functions */
-extern long double erfl(long double x);
-extern long double erfcl(long double x);
-extern long double lgammal(long double x);
-extern long double tgammal(long double x);
-
-/* 7.12.9 Nearest integer functions */
-extern long double ceill(long double x);
-extern long double floorl(long double x);
-extern long double nearbyintl(long double x);
-extern long double rintl(long double x);
-extern long int lrintl(long double x);
-extern long long int llrintl(long double x);
-extern long double roundl(long double x);
-extern long int lroundl(long double x);
-extern long long int llroundl(long double x);
-extern long double truncl(long double x);
-
-/* 7.12.10 Remainder functions */
-extern long double fmodl(long double x, long double y);
-extern long double remainderl(long double x, long double y);
-extern long double remquol(long double x, long double y, int *quo);
-
-/* 7.12.11 Manipulation functions */
-extern long double copysignl(long double x, long double y);
-extern long double nanl(const char *tagp);
-extern long double nextafterl(long double x, long double y);
-extern long double nexttowardl(long double x, long double y);
-
-/* 7.12.12 Maximum, minimum, and positive difference functions */
-extern long double fdiml(long double x, long double y);
-extern long double fmaxl(long double x, long double y);
-extern long double fminl(long double x, long double y);
-
-/* 7.12.13 Floating multiply-add */
-extern long double fmal(long double x, long double y, long double z);
+/* Get machine-dependent inline versions (if there are any). */
+#ifdef __USE_EXTERN_INLINES
+# include <bits/mathinline.h>
#endif
-/* 7.12.14 Comparison macros */
+
+#if __USE_ISOC99
+/* ISO C99 defines some macros to compare number while taking care
+ for unordered numbers. Since many FPUs provide special
+ instructions to support these operations and these tests are
+ defined in <bits/mathinline.h>, we define the generic macros at
+ this late point and only if they are not defined yet. */
+
+/* Return nonzero value if X is greater than Y. */
# ifndef isgreater
# define isgreater(x, y) \
(__extension__ \
@@ -614,6 +406,9 @@ extern long double fmal(long double x, long double y, long double z);
fpclassify (__u) == FP_NAN || fpclassify (__v) == FP_NAN; }))
# endif
+#endif
+
__END_DECLS
+
#endif /* math.h */
diff --git a/libm/Makefile b/libm/Makefile
index 5813ee9e3..b5ac92f80 100644
--- a/libm/Makefile
+++ b/libm/Makefile
@@ -25,31 +25,43 @@ include $(TOPDIR)Rules.mak
LIBM=libm.a
LIBM_SHARED=libm.so
LIBM_SHARED_FULLNAME=libm-$(MAJOR_VERSION).$(MINOR_VERSION).so
+TARGET_CC= $(TOPDIR)extra/gcc-uClibc/$(TARGET_ARCH)-uclibc-gcc
+TARGET_CFLAGS+=-D_IEEE_LIBM -D_ISOC99_SOURCE -D_SVID_SOURCE
-DIRS=
-ifeq ($(strip $(HAS_LIBM_FLOAT)),true)
- DIRS+=float
+ifeq ($(strip $(DO_C89_ONLY)),true)
+CSRC = FIXME
+else
+CSRC = e_acos.c e_acosh.c e_asin.c e_atan2.c e_atanh.c e_cosh.c\
+ e_exp.c e_fmod.c e_gamma.c e_gamma_r.c e_hypot.c e_j0.c\
+ e_j1.c e_jn.c e_lgamma.c e_lgamma_r.c e_log.c e_log10.c\
+ e_pow.c e_remainder.c e_rem_pio2.c e_scalb.c e_sinh.c\
+ e_sqrt.c k_cos.c k_rem_pio2.c k_sin.c k_standard.c k_tan.c\
+ s_asinh.c s_atan.c s_cbrt.c s_ceil.c s_copysign.c s_cos.c\
+ s_erf.c s_expm1.c s_fabs.c s_finite.c s_floor.c s_frexp.c\
+ s_ilogb.c s_ldexp.c s_lib_version.c s_log1p.c s_logb.c\
+ s_matherr.c s_modf.c s_nextafter.c s_rint.c s_scalbn.c\
+ s_signgam.c s_significand.c s_sin.c s_tan.c s_tanh.c\
+ w_acos.c w_acosh.c w_asin.c w_atan2.c w_atanh.c w_cabs.c\
+ w_cosh.c w_drem.c w_exp.c w_fmod.c w_gamma.c w_gamma_r.c\
+ w_hypot.c w_j0.c w_j1.c w_jn.c w_lgamma.c w_lgamma_r.c\
+ w_log.c w_log10.c w_pow.c w_remainder.c w_scalb.c w_sinh.c\
+ w_sqrt.c ceilfloor.c fpmacros.c frexpldexp.c logb.c rndint.c\
+ scalb.c sign.c
endif
-ifeq ($(strip $(HAS_LIBM_DOUBLE)),true)
- DIRS+=double
-endif
-ifeq ($(strip $(HAS_LIBM_LONG_DOUBLE)),true)
- DIRS+=ldouble
-endif
-ALL_SUBDIRS = float double ldouble
+COBJS=$(patsubst %.c,%.o, $(CSRC))
+OBJS=$(COBJS)
+
-all: $(LIBM)
-$(LIBM): subdirs
+all: $(OBJS) $(LIBM)
+
+$(LIBM): ar-target
@if [ -f $(LIBM) ] ; then \
install -d $(TOPDIR)lib; \
rm -f $(TOPDIR)lib/$(LIBM); \
install -m 644 $(LIBM) $(TOPDIR)lib; \
fi;
-tags:
- ctags -R
-
shared: all
if [ -f $(LIBM) ] ; then \
$(TARGET_CC) $(TARGET_LDFLAGS) -nostdlib -shared -o $(LIBM_SHARED_FULLNAME) \
@@ -61,18 +73,18 @@ shared: all
(cd $(TOPDIR)lib; ln -sf $(LIBM_SHARED_FULLNAME) $(LIBM_SHARED).$(MAJOR_VERSION)); \
fi;
-subdirs: $(patsubst %, _dir_%, $(DIRS))
-subdirs_clean: $(patsubst %, _dirclean_%, $(ALL_SUBDIRS))
-
-$(patsubst %, _dir_%, $(DIRS)) : dummy
- $(MAKE) -C $(patsubst _dir_%, %, $@)
+ar-target: $(OBJS)
+ $(AR) $(ARFLAGS) $(LIBM) $(OBJS)
-$(patsubst %, _dirclean_%, $(ALL_SUBDIRS)) : dummy
- $(MAKE) -C $(patsubst _dirclean_%, %, $@) clean
+$(COBJS): %.o : %.c
+ $(TARGET_CC) $(TARGET_CFLAGS) -c $< -o $@
+ $(STRIPTOOL) -x -R .note -R .comment $*.o
-clean: subdirs_clean
- rm -f *.[oa] *~ core $(LIBM_SHARED)* $(LIBM_SHARED_FULLNAME)*
+$(OBJ): Makefile
-.PHONY: dummy
+tags:
+ ctags -R
+clean:
+ rm -f *.[oa] *~ core $(LIBM_SHARED)* $(LIBM_SHARED_FULLNAME)*
diff --git a/libm/README b/libm/README
index 023e46846..c275d1b9a 100644
--- a/libm/README
+++ b/libm/README
@@ -1,42 +1,16 @@
-The actual routines included in this math library are derived almost
-exclusively from the Cephes Mathematical Library, which "is copyrighted by the
-author [and] may be used freely but ... comes with no support or guarantee"
+The routines included in this math library are derived from the
+math library for Apple's MacOS X/Darwin math library, which was
+itself swiped from FreeBSD. The original copyright information
+is as follows:
-It has been ported to fit into uClibc and generally behave
-by Erik Andersen <andersen@lineo.com>, <andersee@debian.org>
- 5 May, 2001
+ Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
---------------------------------------------------
+ Developed at SunPro, a Sun Microsystems, Inc. business.
+ Permission to use, copy, modify, and distribute this
+ software is freely granted, provided that this notice
+ is preserved.
- Some software in this archive may be from the book _Methods and
-Programs for Mathematical Functions_ (Prentice-Hall, 1989) or
-from the Cephes Mathematical Library, a commercial product. In
-either event, it is copyrighted by the author. What you see here
-may be used freely but it comes with no support or guarantee.
+It has been ported to work with uClibc and generally behave
+by Erik Andersen <andersen@codepoet.org>
+ 22 May, 2001
- The two known misprints in the book are repaired here in the
-source listings for the gamma function and the incomplete beta
-integral.
-
-
- Stephen L. Moshier
- moshier@world.std.com
-
---------------------------------------------------
-
-19 November 1992
-
-ZIP archive constructed and index compiled.
-
-To reconstruct the original directory structure, use the -d switch:
-
- C:\CEPHES>pkunzip -d cephes
-
-This archive includes all the programs in the /netlib/cephes directory
-on research.att.com as of 17 Nov 92. The file "index" will tell you in
-what directory and file each function can be found. If there is
-something else mentioned in cephes.doc that you need, you can check
-research.att.com to see whether it has been added. Failing that, you
-can contact Stephen Moshier.
-
- Jim Van Zandt <jrv@mbunix.mitre.org>
diff --git a/libm/ceilfloor.c b/libm/ceilfloor.c
new file mode 100644
index 000000000..9607435c3
--- /dev/null
+++ b/libm/ceilfloor.c
@@ -0,0 +1,179 @@
+#if defined(__ppc__)
+/*******************************************************************************
+* *
+* File ceilfloor.c, *
+* Function ceil(x) and floor(x), *
+* Implementation of ceil and floor for the PowerPC. *
+* *
+* Copyright 1991 Apple Computer, Inc. All rights reserved. *
+* *
+* Written by Ali Sazegari, started on November 1991, *
+* *
+* based on math.h, library code for Macintoshes with a 68881/68882 *
+* by Jim Thomas. *
+* *
+* W A R N I N G: This routine expects a 64 bit double model. *
+* *
+* December 03 1992: first rs6000 port. *
+* July 14 1993: comment changes and addition of #pragma fenv_access. *
+* May 06 1997: port of the ibm/taligent ceil and floor routines. *
+* April 11 2001: first port to os x using gcc. *
+* June 13 2001: replaced __setflm with in-line assembly *
+* *
+*******************************************************************************/
+
+#if !defined(__ppc__)
+#define asm(x)
+#endif
+
+static const double twoTo52 = 4503599627370496.0;
+static const unsigned long signMask = 0x80000000ul;
+
+typedef union
+ {
+ struct {
+#if defined(__BIG_ENDIAN__)
+ unsigned long int hi;
+ unsigned long int lo;
+#else
+ unsigned long int lo;
+ unsigned long int hi;
+#endif
+ } words;
+ double dbl;
+ } DblInHex;
+
+/*******************************************************************************
+* Functions needed for the computation. *
+*******************************************************************************/
+
+/*******************************************************************************
+* Ceil(x) returns the smallest integer not less than x. *
+*******************************************************************************/
+
+double ceil ( double x )
+ {
+ DblInHex xInHex,OldEnvironment;
+ register double y;
+ register unsigned long int xhi;
+ register int target;
+
+ xInHex.dbl = x;
+ xhi = xInHex.words.hi & 0x7fffffffUL; // xhi is the high half of |x|
+ target = ( xInHex.words.hi < signMask );
+
+ if ( xhi < 0x43300000ul )
+/*******************************************************************************
+* Is |x| < 2.0^52? *
+*******************************************************************************/
+ {
+ if ( xhi < 0x3ff00000ul )
+/*******************************************************************************
+* Is |x| < 1.0? *
+*******************************************************************************/
+ {
+ if ( ( xhi | xInHex.words.lo ) == 0ul ) // zero x is exact case
+ return ( x );
+ else
+ { // inexact case
+ asm ("mffs %0" : "=f" (OldEnvironment.dbl));
+ OldEnvironment.words.lo |= 0x02000000ul;
+ asm ("mtfsf 255,%0" : /*NULLOUT*/ : /*IN*/ "f" ( OldEnvironment.dbl ));
+ if ( target )
+ return ( 1.0 );
+ else
+ return ( -0.0 );
+ }
+ }
+/*******************************************************************************
+* Is 1.0 < |x| < 2.0^52? *
+*******************************************************************************/
+ if ( target )
+ {
+ y = ( x + twoTo52 ) - twoTo52; // round at binary pt.
+ if ( y < x )
+ return ( y + 1.0 );
+ else
+ return ( y );
+ }
+
+ else
+ {
+ y = ( x - twoTo52 ) + twoTo52; // round at binary pt.
+ if ( y < x )
+ return ( y + 1.0 );
+ else
+ return ( y );
+ }
+ }
+/*******************************************************************************
+* |x| >= 2.0^52 or x is a NaN. *
+*******************************************************************************/
+ return ( x );
+ }
+
+/*******************************************************************************
+* Floor(x) returns the largest integer not greater than x. *
+*******************************************************************************/
+
+double floor ( double x )
+ {
+ DblInHex xInHex,OldEnvironment;
+ register double y;
+ register unsigned long int xhi;
+ register long int target;
+
+ xInHex.dbl = x;
+ xhi = xInHex.words.hi & 0x7fffffffUL; // xhi is the high half of |x|
+ target = ( xInHex.words.hi < signMask );
+
+ if ( xhi < 0x43300000ul )
+/*******************************************************************************
+* Is |x| < 2.0^52? *
+*******************************************************************************/
+ {
+ if ( xhi < 0x3ff00000ul )
+/*******************************************************************************
+* Is |x| < 1.0? *
+*******************************************************************************/
+ {
+ if ( ( xhi | xInHex.words.lo ) == 0ul ) // zero x is exact case
+ return ( x );
+ else
+ { // inexact case
+ asm ("mffs %0" : "=f" (OldEnvironment.dbl));
+ OldEnvironment.words.lo |= 0x02000000ul;
+ asm ("mtfsf 255,%0" : /*NULLOUT*/ : /*IN*/ "f" ( OldEnvironment.dbl ));
+ if ( target )
+ return ( 0.0 );
+ else
+ return ( -1.0 );
+ }
+ }
+/*******************************************************************************
+* Is 1.0 < |x| < 2.0^52? *
+*******************************************************************************/
+ if ( target )
+ {
+ y = ( x + twoTo52 ) - twoTo52; // round at binary pt.
+ if ( y > x )
+ return ( y - 1.0 );
+ else
+ return ( y );
+ }
+
+ else
+ {
+ y = ( x - twoTo52 ) + twoTo52; // round at binary pt.
+ if ( y > x )
+ return ( y - 1.0 );
+ else
+ return ( y );
+ }
+ }
+/*******************************************************************************
+* |x| >= 2.0^52 or x is a NaN. *
+*******************************************************************************/
+ return ( x );
+ }
+#endif /* __ppc__ */
diff --git a/libm/double/Makefile b/libm/double/Makefile
deleted file mode 100644
index a53b44d2e..000000000
--- a/libm/double/Makefile
+++ /dev/null
@@ -1,114 +0,0 @@
-# Makefile for uClibc's math library
-# Copyright (C) 2001 by Lineo, inc.
-#
-# This math library is derived primarily from the Cephes Math Library,
-# copyright by Stephen L. Moshier <moshier@world.std.com>
-#
-# 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
-#
-
-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 noncephes.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) $(TARGET_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
- $(TARGET_CC) -o time-it time-it.o
-
-time-it.o: time-it.c
- $(TARGET_CC) -O2 -c time-it.c
-
-dcalc: dcalc.o libmd.a
- $(TARGET_CC) -o dcalc dcalc.o libmd.a
-
-mtst: mtst.o libmd.a
- $(TARGET_CC) -v -o mtst mtst.o libmd.a
-
-mtst.o: mtst.c
- $(TARGET_CC) -O2 -Wall -c mtst.c
-
-dtestvec: dtestvec.o libmd.a
- $(TARGET_CC) -o dtestvec dtestvec.o libmd.a
-
-dtestvec.o: dtestvec.c
- $(TARGET_CC) -g -c dtestvec.c
-
-monot: monot.o libmd.a
- $(TARGET_CC) -o monot monot.o libmd.a
-
-monot.o: monot.c
- $(TARGET_CC) -g -c monot.c
-
-paranoia: paranoia.o setprec.o libmd.a
- $(TARGET_CC) -o paranoia paranoia.o setprec.o libmd.a
-
-paranoia.o: paranoia.c
- $(TARGET_CC) $(TARGET_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
deleted file mode 100644
index f2cb6c3dc..000000000
--- a/libm/double/README.txt
+++ /dev/null
@@ -1,5845 +0,0 @@
-/* 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/acos.c b/libm/double/acos.c
deleted file mode 100644
index 60f61dc98..000000000
--- a/libm/double/acos.c
+++ /dev/null
@@ -1,58 +0,0 @@
-/* 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
- */
-
-#define __USE_BSD
-#include <math.h>
-
-double acos(double x)
-{
- if (x < -0.5) {
- return (M_PI - 2.0 * asin( sqrt((1+x)/2) ));
- }
- if (x > 0.5) {
- return (2.0 * asin( sqrt((1-x)/2) ));
- }
-
- return(M_PI_2 - asin(x));
-}
diff --git a/libm/double/acosh.c b/libm/double/acosh.c
deleted file mode 100644
index 49d9a40e2..000000000
--- a/libm/double/acosh.c
+++ /dev/null
@@ -1,167 +0,0 @@
-/* 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
deleted file mode 100644
index 91e29088a..000000000
--- a/libm/double/airy.c
+++ /dev/null
@@ -1,965 +0,0 @@
-/* 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
deleted file mode 100644
index 44c057229..000000000
--- a/libm/double/arcdot.c
+++ /dev/null
@@ -1,110 +0,0 @@
-/* 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
deleted file mode 100644
index 1f83eccc8..000000000
--- a/libm/double/asin.c
+++ /dev/null
@@ -1,324 +0,0 @@
-/* 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
deleted file mode 100644
index 57966d264..000000000
--- a/libm/double/asinh.c
+++ /dev/null
@@ -1,165 +0,0 @@
-/* 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
deleted file mode 100644
index f2d50768d..000000000
--- a/libm/double/atan.c
+++ /dev/null
@@ -1,393 +0,0 @@
-/* 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
deleted file mode 100644
index 7bb742d3d..000000000
--- a/libm/double/atanh.c
+++ /dev/null
@@ -1,156 +0,0 @@
-/* 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
deleted file mode 100644
index a268c7a10..000000000
--- a/libm/double/bdtr.c
+++ /dev/null
@@ -1,263 +0,0 @@
-/* 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
deleted file mode 100644
index e401ff5df..000000000
--- a/libm/double/bernum.c
+++ /dev/null
@@ -1,74 +0,0 @@
-/* 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
deleted file mode 100644
index 410760f32..000000000
--- a/libm/double/beta.c
+++ /dev/null
@@ -1,201 +0,0 @@
-/* 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
deleted file mode 100644
index 633ba7591..000000000
--- a/libm/double/btdtr.c
+++ /dev/null
@@ -1,64 +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.
- *
- */
-
-/* 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
deleted file mode 100644
index 026207275..000000000
--- a/libm/double/cbrt.c
+++ /dev/null
@@ -1,142 +0,0 @@
-/* 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
deleted file mode 100644
index 539388164..000000000
--- a/libm/double/chbevl.c
+++ /dev/null
@@ -1,82 +0,0 @@
-/* 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
deleted file mode 100644
index a29da7535..000000000
--- a/libm/double/chdtr.c
+++ /dev/null
@@ -1,200 +0,0 @@
-/* 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
deleted file mode 100644
index 8da9b350e..000000000
--- a/libm/double/cheby.c
+++ /dev/null
@@ -1,149 +0,0 @@
-/* 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
deleted file mode 100644
index 70a318a50..000000000
--- a/libm/double/clog.c
+++ /dev/null
@@ -1,1043 +0,0 @@
-/* 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
deleted file mode 100644
index dcd972bea..000000000
--- a/libm/double/cmplx.c
+++ /dev/null
@@ -1,461 +0,0 @@
-/* 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
deleted file mode 100644
index f7156497c..000000000
--- a/libm/double/coil.c
+++ /dev/null
@@ -1,63 +0,0 @@
-/* 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
deleted file mode 100644
index de4451497..000000000
--- a/libm/double/const.c
+++ /dev/null
@@ -1,252 +0,0 @@
-/* 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
deleted file mode 100644
index 77a70da3e..000000000
--- a/libm/double/cosh.c
+++ /dev/null
@@ -1,83 +0,0 @@
-/* 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
deleted file mode 100644
index 3880ac5a1..000000000
--- a/libm/double/cpmul.c
+++ /dev/null
@@ -1,104 +0,0 @@
-/* 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
deleted file mode 100644
index 4f8d27a0c..000000000
--- a/libm/double/dawsn.c
+++ /dev/null
@@ -1,392 +0,0 @@
-/* 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
deleted file mode 100644
index b740edae2..000000000
--- a/libm/double/dcalc.c
+++ /dev/null
@@ -1,1512 +0,0 @@
-/* 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
deleted file mode 100644
index 0ec2a46da..000000000
--- a/libm/double/dcalc.h
+++ /dev/null
@@ -1,77 +0,0 @@
-/* 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
deleted file mode 100644
index ea494029b..000000000
--- a/libm/double/dtestvec.c
+++ /dev/null
@@ -1,543 +0,0 @@
-
-/* 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
deleted file mode 100644
index 4994fa99c..000000000
--- a/libm/double/ei.c
+++ /dev/null
@@ -1,1062 +0,0 @@
-/* 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
deleted file mode 100644
index 4035e76a1..000000000
--- a/libm/double/eigens.c
+++ /dev/null
@@ -1,181 +0,0 @@
-/* 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
deleted file mode 100644
index 4f3379aa6..000000000
--- a/libm/double/ellie.c
+++ /dev/null
@@ -1,148 +0,0 @@
-/* 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
deleted file mode 100644
index 1c9053676..000000000
--- a/libm/double/ellik.c
+++ /dev/null
@@ -1,148 +0,0 @@
-/* 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
deleted file mode 100644
index 9b2438e0e..000000000
--- a/libm/double/ellpe.c
+++ /dev/null
@@ -1,195 +0,0 @@
-/* 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
deleted file mode 100644
index 327fc56e8..000000000
--- a/libm/double/ellpj.c
+++ /dev/null
@@ -1,171 +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.
- *
- */
-
-/* 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
deleted file mode 100644
index 8b36690e2..000000000
--- a/libm/double/ellpk.c
+++ /dev/null
@@ -1,234 +0,0 @@
-/* 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
deleted file mode 100644
index cef249eaf..000000000
--- a/libm/double/eltst.c
+++ /dev/null
@@ -1,37 +0,0 @@
-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
deleted file mode 100644
index 3a899a6d2..000000000
--- a/libm/double/euclid.c
+++ /dev/null
@@ -1,251 +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.
- */
-
-
-#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
deleted file mode 100644
index 6d0a8a872..000000000
--- a/libm/double/exp.c
+++ /dev/null
@@ -1,203 +0,0 @@
-/* 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
deleted file mode 100644
index dd0e5a48f..000000000
--- a/libm/double/exp10.c
+++ /dev/null
@@ -1,223 +0,0 @@
-/* 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
deleted file mode 100644
index be5bdfd0c..000000000
--- a/libm/double/exp2.c
+++ /dev/null
@@ -1,183 +0,0 @@
-/* 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
deleted file mode 100644
index 89b6b139e..000000000
--- a/libm/double/expn.c
+++ /dev/null
@@ -1,208 +0,0 @@
-/* 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
deleted file mode 100644
index 0c4531a6c..000000000
--- a/libm/double/fabs.c
+++ /dev/null
@@ -1,56 +0,0 @@
-/* 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
deleted file mode 100644
index a5748ac74..000000000
--- a/libm/double/fac.c
+++ /dev/null
@@ -1,263 +0,0 @@
-/* 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
deleted file mode 100644
index 469b7bedf..000000000
--- a/libm/double/fdtr.c
+++ /dev/null
@@ -1,237 +0,0 @@
-/* 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
deleted file mode 100644
index d4ce23463..000000000
--- a/libm/double/fftr.c
+++ /dev/null
@@ -1,237 +0,0 @@
-/* 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
deleted file mode 100644
index affc7753e..000000000
--- a/libm/double/floor.c
+++ /dev/null
@@ -1,531 +0,0 @@
-/* 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);
- }
-}
-
-/**********************************************************************/
-/*
- * trunc is just a slightly modified version of floor above.
- */
-
-double trunc(double x)
-{
- union {
- double y;
- unsigned short sh[4];
- } u;
- unsigned short *p;
- int e;
-
-#ifdef UNK
- mtherr( "trunc", 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 )
- 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];
-
- return(u.y);
-}
diff --git a/libm/double/fltest.c b/libm/double/fltest.c
deleted file mode 100644
index f2e3d8665..000000000
--- a/libm/double/fltest.c
+++ /dev/null
@@ -1,272 +0,0 @@
-/* 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()