diff options
368 files changed, 10956 insertions, 91586 deletions
diff --git a/include/math.h b/include/math.h index 955e66a..8a2e86c 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 5813ee9..b5ac92f 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 023e468..c275d1b 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 0000000..9607435 --- /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 a53b44d..0000000 --- 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 f2cb6c3..0000000 --- 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 60f61dc..0000000 --- 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 49d9a40..0000000 --- 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 91e2908..0000000 --- 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 44c0572..0000000 --- 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 1f83ecc..0000000 --- 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 57966d2..0000000 --- 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 f2d5076..0000000 --- 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 7bb742d..0000000 --- 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 a268c7a..0000000 --- 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 e401ff5..0000000 --- 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 410760f..0000000 --- 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 633ba75..0000000 --- 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 0262072..0000000 --- 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 5393881..0000000 --- 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 a29da75..0000000 --- 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 8da9b35..0000000 --- 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 70a318a..0000000 --- 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 dcd972b..0000000 --- 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 f715649..0000000 --- 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 de44514..0000000 --- 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 77a70da..0000000 --- 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 3880ac5..0000000 --- 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 4f8d27a..0000000 --- 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 b740eda..0000000 --- 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 0ec2a46..0000000 --- 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 ea49402..0000000 --- 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 4994fa9..0000000 --- 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 4035e76..0000000 --- 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 4f3379a..0000000 --- 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 1c90536..0000000 --- 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 9b2438e..0000000 --- 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 327fc56..0000000 --- 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 8b36690..0000000 --- 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 cef249e..0000000 --- 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 3a899a6..0000000 --- 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 6d0a8a8..0000000 --- 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 dd0e5a4..0000000 --- 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 be5bdfd..0000000 --- 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 89b6b13..0000000 --- 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 0c4531a..0000000 --- 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 a5748ac..0000000 --- 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 469b7be..0000000 --- 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 d4ce234..0000000 --- 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 affc775..0000000 --- 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 - re |