diff options
author | Eric Andersen <andersen@codepoet.org> | 2001-05-10 00:40:28 +0000 |
---|---|---|
committer | Eric Andersen <andersen@codepoet.org> | 2001-05-10 00:40:28 +0000 |
commit | 1077fa4d772832f77a677ce7fb7c2d513b959e3f (patch) | |
tree | 579bee13fb0b58d2800206366ec2caecbb15f3fc /libm/ldouble/j1l.c | |
parent | 22358dd7ce7bb49792204b698f01a6f69b9c8e08 (diff) |
uClibc now has a math library. muahahahaha!
-Erik
Diffstat (limited to 'libm/ldouble/j1l.c')
-rw-r--r-- | libm/ldouble/j1l.c | 551 |
1 files changed, 551 insertions, 0 deletions
diff --git a/libm/ldouble/j1l.c b/libm/ldouble/j1l.c new file mode 100644 index 000000000..83428473e --- /dev/null +++ b/libm/ldouble/j1l.c @@ -0,0 +1,551 @@ +/* j1l.c + * + * Bessel function of order one + * + * + * + * SYNOPSIS: + * + * long double x, y, j1l(); + * + * y = j1l( x ); + * + * + * + * DESCRIPTION: + * + * Returns Bessel function of order one of the argument. + * + * The domain is divided into the intervals [0, 9] and + * (9, infinity). In the first interval the rational approximation + * is (x^2 - r^2) (x^2 - s^2) (x^2 - t^2) x P8(x^2) / Q8(x^2), + * where r, s, t are the first three zeros of the function. + * In the second interval the expansion is in terms of the + * modulus M1(x) = sqrt(J1(x)^2 + Y1(x)^2) and phase P1(x) + * = atan(Y1(x)/J1(x)). M1 is approximated by sqrt(1/x)P7(1/x)/Q8(1/x). + * The approximation to j1 is M1 * cos(x - 3 pi/4 + 1/x P5(1/x^2)/Q6(1/x^2)). + * + * + * ACCURACY: + * + * Absolute error: + * arithmetic domain # trials peak rms + * IEEE 0, 30 40000 1.8e-19 5.0e-20 + * + * + */ +/* y1l.c + * + * Bessel function of the second kind, order zero + * + * + * + * SYNOPSIS: + * + * double x, y, y1l(); + * + * y = y1l( x ); + * + * + * + * DESCRIPTION: + * + * Returns Bessel function of the second kind, of order + * zero, of the argument. + * + * The domain is divided into the intervals [0, 4.5>, [4.5,9> and + * [9, infinity). In the first interval a rational approximation + * R(x) is employed to compute y0(x) = R(x) + 2/pi * log(x) * j0(x). + * + * In the second interval, the approximation is + * (x - p)(x - q)(x - r)(x - s)P9(x)/Q10(x) + * where p, q, r, s are zeros of y1(x). + * + * The third interval uses the same approximations to modulus + * and phase as j1(x), whence y1(x) = modulus * sin(phase). + * + * ACCURACY: + * + * Absolute error, when y0(x) < 1; else relative error: + * + * arithmetic domain # trials peak rms + * IEEE 0, 30 36000 2.7e-19 5.3e-20 + * + */ + +/* Copyright 1994 by Stephen L. Moshier (moshier@world.std.com). */ + +#include <math.h> + +/* +j1(x) = (x^2-r0^2)(x^2-r1^2)(x^2-r2^2) x P(x**2)/Q(x**2) +0 <= x <= 9 +Relative error +n=8, d=8 +Peak error = 2e-21 +*/ +#if UNK +static long double j1n[9] = { +-2.63469779622127762897E-4L, + 9.31329762279632791262E-1L, +-1.46280142797793933909E3L, + 1.32000129539331214495E6L, +-7.41183271195454042842E8L, + 2.626500686552841932403E11L, +-5.68263073022183470933E13L, + 6.80006297997263446982E15L, +-3.41470097444474566748E17L, +}; +static long double j1d[8] = { +/* 1.00000000000000000000E0L,*/ + 2.95267951972943745733E3L, + 4.78723926343829674773E6L, + 5.37544732957807543920E9L, + 4.46866213886267829490E12L, + 2.76959756375961607085E15L, + 1.23367806884831151194E18L, + 3.57325874689695599524E20L, + 5.10779045516141578461E22L, +}; +#endif +#if IBMPC +static short j1n[] = { +0xf72f,0x18cc,0x50b2,0x8a22,0xbff3, XPD +0x6dc3,0xc850,0xa096,0xee6b,0x3ffe, XPD +0x29f3,0x496b,0xa54c,0xb6d9,0xc009, XPD +0x38f5,0xf72b,0x0a5c,0xa122,0x4013, XPD +0x1ac8,0xc825,0x3c9c,0xb0b6,0xc01c, XPD +0x038e,0xbd23,0xa7fa,0xf49c,0x4024, XPD +0x636c,0x4d29,0x9f71,0xcebb,0xc02c, XPD +0xd3c2,0xf8f0,0xf852,0xc144,0x4033, XPD +0xd8d8,0x7311,0xa7d2,0x97a4,0xc039, XPD +}; +static short j1d[] = { +/*0x0000,0x0000,0x0000,0x8000,0x3fff, XPD*/ +0xbaf9,0x146e,0xdf50,0xb88a,0x400a, XPD +0x6a17,0xe162,0x4e86,0x9218,0x4015, XPD +0x6041,0xc9fe,0x6890,0xa033,0x401f, XPD +0xb498,0xfdd5,0x209e,0x820e,0x4029, XPD +0x0122,0x56c0,0xf2ef,0x9d6e,0x4032, XPD +0xe6c0,0xa725,0x3d56,0x88f7,0x403b, XPD +0x665d,0xb178,0x242e,0x9af7,0x4043, XPD +0xdd67,0xf5b3,0x0522,0xad0f,0x404a, XPD +}; +#endif +#if MIEEE +static long j1n[27] = { +0xbff30000,0x8a2250b2,0x18ccf72f, +0x3ffe0000,0xee6ba096,0xc8506dc3, +0xc0090000,0xb6d9a54c,0x496b29f3, +0x40130000,0xa1220a5c,0xf72b38f5, +0xc01c0000,0xb0b63c9c,0xc8251ac8, +0x40240000,0xf49ca7fa,0xbd23038e, +0xc02c0000,0xcebb9f71,0x4d29636c, +0x40330000,0xc144f852,0xf8f0d3c2, +0xc0390000,0x97a4a7d2,0x7311d8d8, +}; +static long j1d[24] = { +/*0x3fff0000,0x80000000,0x00000000,*/ +0x400a0000,0xb88adf50,0x146ebaf9, +0x40150000,0x92184e86,0xe1626a17, +0x401f0000,0xa0336890,0xc9fe6041, +0x40290000,0x820e209e,0xfdd5b498, +0x40320000,0x9d6ef2ef,0x56c00122, +0x403b0000,0x88f73d56,0xa725e6c0, +0x40430000,0x9af7242e,0xb178665d, +0x404a0000,0xad0f0522,0xf5b3dd67, +}; +#endif +/* +sqrt(j0^2(1/x^2) + y0^2(1/x^2)) = z P(z**2)/Q(z**2) +z(x) = 1/sqrt(x) +Relative error +n=7, d=8 +Peak error = 1.35e=20 +Relative error spread = 9.9e0 +*/ +#if UNK +static long double modulusn[8] = { +-5.041742205078442098874E0L, + 3.918474430130242177355E-1L, + 2.527521168680500659056E0L, + 7.172146812845906480743E0L, + 2.859499532295180940060E0L, + 1.014671139779858141347E0L, + 1.255798064266130869132E-1L, + 1.596507617085714650238E-2L, +}; +static long double modulusd[8] = { +/* 1.000000000000000000000E0L,*/ +-6.233092094568239317498E0L, +-9.214128701852838347002E-1L, + 2.531772200570435289832E0L, + 8.755081357265851765640E0L, + 3.554340386955608261463E0L, + 1.267949948774331531237E0L, + 1.573909467558180942219E-1L, + 2.000925566825407466160E-2L, +}; +#endif +#if IBMPC +static short modulusn[] = { +0x3d53,0xb598,0xf3bf,0xa155,0xc001, XPD +0x3111,0x863a,0x3a61,0xc8a0,0x3ffd, XPD +0x7d55,0xdb8c,0xe825,0xa1c2,0x4000, XPD +0xe5e2,0x6914,0x3a08,0xe582,0x4001, XPD +0x71e6,0x88a5,0x0a53,0xb702,0x4000, XPD +0x2cb0,0xc657,0xbe70,0x81e0,0x3fff, XPD +0x6de4,0x8fae,0xfe26,0x8097,0x3ffc, XPD +0xa905,0x05fb,0x3101,0x82c9,0x3ff9, XPD +}; +static short modulusd[] = { +/*0x0000,0x0000,0x0000,0x8000,0x3fff, XPD*/ +0x2603,0x640e,0x7d8d,0xc775,0xc001, XPD +0x77b5,0x8f2d,0xb6bf,0xebe1,0xbffe, XPD +0x6420,0x97ce,0x8e44,0xa208,0x4000, XPD +0x0260,0x746b,0xd030,0x8c14,0x4002, XPD +0x77b6,0x34e2,0x501a,0xe37a,0x4000, XPD +0x37ce,0x79ae,0x2f15,0xa24c,0x3fff, XPD +0xfc82,0x02c7,0x17a4,0xa12b,0x3ffc, XPD +0x1237,0xcc6c,0x7356,0xa3ea,0x3ff9, XPD +}; +#endif +#if MIEEE +static long modulusn[24] = { +0xc0010000,0xa155f3bf,0xb5983d53, +0x3ffd0000,0xc8a03a61,0x863a3111, +0x40000000,0xa1c2e825,0xdb8c7d55, +0x40010000,0xe5823a08,0x6914e5e2, +0x40000000,0xb7020a53,0x88a571e6, +0x3fff0000,0x81e0be70,0xc6572cb0, +0x3ffc0000,0x8097fe26,0x8fae6de4, +0x3ff90000,0x82c93101,0x05fba905, +}; +static long modulusd[24] = { +/*0x3fff0000,0x80000000,0x00000000,*/ +0xc0010000,0xc7757d8d,0x640e2603, +0xbffe0000,0xebe1b6bf,0x8f2d77b5, +0x40000000,0xa2088e44,0x97ce6420, +0x40020000,0x8c14d030,0x746b0260, +0x40000000,0xe37a501a,0x34e277b6, +0x3fff0000,0xa24c2f15,0x79ae37ce, +0x3ffc0000,0xa12b17a4,0x02c7fc82, +0x3ff90000,0xa3ea7356,0xcc6c1237, +}; +#endif +/* +atan(y1(x)/j1(x)) = x - 3pi/4 + z P(z**2)/Q(z**2) +z(x) = 1/x +Absolute error +n=5, d=6 +Peak error = 4.83e-21 +Relative error spread = 1.9e0 +*/ +#if UNK +static long double phasen[6] = { + 2.010456367705144783933E0L, + 1.587378144541918176658E0L, + 2.682837461073751055565E-1L, + 1.472572645054468815027E-2L, + 2.884976126715926258586E-4L, + 1.708502235134706284899E-6L, +}; +static long double phased[6] = { +/* 1.000000000000000000000E0L,*/ + 6.809332495854873089362E0L, + 4.518597941618813112665E0L, + 7.320149039410806471101E-1L, + 3.960155028960712309814E-2L, + 7.713202197319040439861E-4L, + 4.556005960359216767984E-6L, +}; +#endif +#if IBMPC +static short phasen[] = { +0xebc0,0x5506,0x512f,0x80ab,0x4000, XPD +0x6050,0x98aa,0x3500,0xcb2f,0x3fff, XPD +0xe907,0x28b9,0x7cb7,0x895c,0x3ffd, XPD +0xa830,0xf4a3,0x2c60,0xf144,0x3ff8, XPD +0xf74f,0xbe87,0x7e7d,0x9741,0x3ff3, XPD +0x540c,0xc1d5,0xb096,0xe54f,0x3feb, XPD +}; +static short phased[] = { +/*0x0000,0x0000,0x0000,0x8000,0x3fff, XPD*/ +0xefe3,0x292c,0x0d43,0xd9e6,0x4001, XPD +0xb1f2,0xe0d2,0x5ab5,0x9098,0x4001, XPD +0xc39e,0x9c8c,0x5428,0xbb65,0x3ffe, XPD +0x98f8,0xd610,0x3c35,0xa235,0x3ffa, XPD +0xa853,0x55fb,0x6c79,0xca32,0x3ff4, XPD +0x8d72,0x2be3,0xcb0f,0x98df,0x3fed, XPD +}; +#endif +#if MIEEE +static long phasen[18] = { +0x40000000,0x80ab512f,0x5506ebc0, +0x3fff0000,0xcb2f3500,0x98aa6050, +0x3ffd0000,0x895c7cb7,0x28b9e907, +0x3ff80000,0xf1442c60,0xf4a3a830, +0x3ff30000,0x97417e7d,0xbe87f74f, +0x3feb0000,0xe54fb096,0xc1d5540c, +}; +static long phased[18] = { +/*0x3fff0000,0x80000000,0x00000000,*/ +0x40010000,0xd9e60d43,0x292cefe3, +0x40010000,0x90985ab5,0xe0d2b1f2, +0x3ffe0000,0xbb655428,0x9c8cc39e, +0x3ffa0000,0xa2353c35,0xd61098f8, +0x3ff40000,0xca326c79,0x55fba853, +0x3fed0000,0x98dfcb0f,0x2be38d72, +}; +#endif +#define JZ1 1.46819706421238932572e1L +#define JZ2 4.92184563216946036703e1L +#define JZ3 1.03499453895136580332e2L + +#define THPIO4L 2.35619449019234492885L +#ifdef ANSIPROT +extern long double sqrtl ( long double ); +extern long double fabsl ( long double ); +extern long double polevll ( long double, void *, int ); +extern long double p1evll ( long double, void *, int ); +extern long double cosl ( long double ); +extern long double sinl ( long double ); +extern long double logl ( long double ); +long double j1l (long double ); +#else +long double sqrtl(), fabsl(), polevll(), p1evll(), cosl(), sinl(), logl(); +long double j1l(); +#endif + +long double j1l(x) +long double x; +{ +long double xx, y, z, modulus, phase; + +xx = x * x; +if( xx < 81.0L ) + { + y = (xx - JZ1) * (xx - JZ2) * (xx - JZ3); + y *= x * polevll( xx, j1n, 8 ) / p1evll( xx, j1d, 8 ); + return y; + } + +y = fabsl(x); +xx = 1.0/xx; +phase = polevll( xx, phasen, 5 ) / p1evll( xx, phased, 6 ); + +z = 1.0/y; +modulus = polevll( z, modulusn, 7 ) / p1evll( z, modulusd, 8 ); + +y = modulus * cosl( y - THPIO4L + z*phase) / sqrtl(y); +if( x < 0 ) + y = -y; +return y; +} + +/* +y1(x) = 2/pi * (log(x) * j1(x) - 1/x) + R(x^2) z P(z**2)/Q(z**2) +0 <= x <= 4.5 +z(x) = x +Absolute error +n=6, d=7 +Peak error = 7.25e-22 +Relative error spread = 4.5e-2 +*/ +#if UNK +static long double y1n[7] = { +-1.288901054372751879531E5L, + 9.914315981558815369372E7L, +-2.906793378120403577274E10L, + 3.954354656937677136266E12L, +-2.445982226888344140154E14L, + 5.685362960165615942886E15L, +-2.158855258453711703120E16L, +}; +static long double y1d[7] = { +/* 1.000000000000000000000E0L,*/ + 8.926354644853231136073E2L, + 4.679841933793707979659E5L, + 1.775133253792677466651E8L, + 5.089532584184822833416E10L, + 1.076474894829072923244E13L, + 1.525917240904692387994E15L, + 1.101136026928555260168E17L, +}; +#endif +#if IBMPC +static short y1n[] = { +0x5b16,0xf7f8,0x0d7e,0xfbbd,0xc00f, XPD +0x53e4,0x194c,0xbefa,0xbd19,0x4019, XPD +0x7607,0xa687,0xaf0a,0xd892,0xc021, XPD +0x5633,0xaa6b,0x79e5,0xe62c,0x4028, XPD +0x69fd,0x1242,0xf62d,0xde75,0xc02e, XPD +0x7f8b,0x4757,0x75bd,0xa196,0x4033, XPD +0x3a10,0x0848,0x5930,0x9965,0xc035, XPD +}; +static short y1d[] = { +/*0x0000,0x0000,0x0000,0x8000,0x3fff, XPD*/ +0xdd1a,0x3b8e,0xab73,0xdf28,0x4008, XPD +0x298c,0x29ef,0x0630,0xe482,0x4011, XPD +0x0e86,0x117b,0x36d6,0xa94a,0x401a, XPD +0x57e0,0x1d92,0x90a9,0xbd99,0x4022, XPD +0xaaf0,0x342b,0xd098,0x9ca5,0x402a, XPD +0x8c6a,0x397e,0x0963,0xad7a,0x4031, XPD +0x7302,0xb91b,0xde7e,0xc399,0x4037, XPD +}; +#endif +#if MIEEE +static long y1n[21] = { +0xc00f0000,0xfbbd0d7e,0xf7f85b16, +0x40190000,0xbd19befa,0x194c53e4, +0xc0210000,0xd892af0a,0xa6877607, +0x40280000,0xe62c79e5,0xaa6b5633, +0xc02e0000,0xde75f62d,0x124269fd, +0x40330000,0xa19675bd,0x47577f8b, +0xc0350000,0x99655930,0x08483a10, +}; +static long y1d[21] = { +/*0x3fff0000,0x80000000,0x00000000,*/ +0x40080000,0xdf28ab73,0x3b8edd1a, +0x40110000,0xe4820630,0x29ef298c, +0x401a0000,0xa94a36d6,0x117b0e86, +0x40220000,0xbd9990a9,0x1d9257e0, +0x402a0000,0x9ca5d098,0x342baaf0, +0x40310000,0xad7a0963,0x397e8c6a, +0x40370000,0xc399de7e,0xb91b7302, +}; +#endif +/* +y1(x) = (x-YZ1)(x-YZ2)(x-YZ3)(x-YZ4)R(x) P(z)/Q(z) +z(x) = x +4.5 <= x <= 9 +Absolute error +n=9, d=10 +Peak error = 3.27e-22 +Relative error spread = 4.5e-2 +*/ +#if UNK +static long double y159n[10] = { +-6.806634906054210550896E-1L, + 4.306669585790359450532E1L, +-9.230477746767243316014E2L, + 6.171186628598134035237E3L, + 2.096869860275353982829E4L, +-1.238961670382216747944E5L, +-1.781314136808997406109E6L, +-1.803400156074242435454E6L, +-1.155761550219364178627E6L, + 3.112221202330688509818E5L, +}; +static long double y159d[10] = { +/* 1.000000000000000000000E0L,*/ +-6.181482377814679766978E1L, + 2.238187927382180589099E3L, +-5.225317824142187494326E4L, + 9.217235006983512475118E5L, +-1.183757638771741974521E7L, + 1.208072488974110742912E8L, +-8.193431077523942651173E8L, + 4.282669747880013349981E9L, +-1.171523459555524458808E9L, + 1.078445545755236785692E8L, +}; +#endif +#if IBMPC +static short y159n[] = { +0xb5e5,0xbb42,0xf667,0xae3f,0xbffe, XPD +0xfdf1,0x41e5,0x4beb,0xac44,0x4004, XPD +0xe917,0x8486,0x0ebd,0xe6c3,0xc008, XPD +0xdf40,0x226b,0x7e37,0xc0d9,0x400b, XPD +0xb2bf,0x4296,0x65af,0xa3d1,0x400d, XPD +0xa33b,0x8229,0x1561,0xf1fc,0xc00f, XPD +0xcd43,0x2f50,0x1118,0xd972,0xc013, XPD +0x3811,0xa3da,0x413f,0xdc24,0xc013, XPD +0xf62f,0xd968,0x8c66,0x8d15,0xc013, XPD +0x539b,0xf305,0xc3d8,0x97f6,0x4011, XPD +}; +static short y159d[] = { +/*0x0000,0x0000,0x0000,0x8000,0x3fff, XPD*/ +0x1a6c,0x1c93,0x612a,0xf742,0xc004, XPD +0xd0fe,0x2487,0x01c0,0x8be3,0x400a, XPD +0xbed4,0x3ad5,0x2da1,0xcc1d,0xc00e, XPD +0x3c4f,0xdc46,0xb802,0xe107,0x4012, XPD +0xe5e5,0x4172,0x8863,0xb4a0,0xc016, XPD +0x6de5,0xb797,0xea1c,0xe66b,0x4019, XPD +0xa46a,0x0273,0xbc0f,0xc358,0xc01c, XPD +0x8e0e,0xe148,0x5ab3,0xff44,0x401e, XPD +0xb3ad,0x1c6d,0x0f07,0x8ba8,0xc01d, XPD +0xa231,0x6ab0,0x7952,0xcdb2,0x4019, XPD +}; +#endif +#if MIEEE +static long y159n[30] = { +0xbffe0000,0xae3ff667,0xbb42b5e5, +0x40040000,0xac444beb,0x41e5fdf1, +0xc0080000,0xe6c30ebd,0x8486e917, +0x400b0000,0xc0d97e37,0x226bdf40, +0x400d0000,0xa3d165af,0x4296b2bf, +0xc00f0000,0xf1fc1561,0x8229a33b, +0xc0130000,0xd9721118,0x2f50cd43, +0xc0130000,0xdc24413f,0xa3da3811, +0xc0130000,0x8d158c66,0xd968f62f, +0x40110000,0x97f6c3d8,0xf305539b, +}; +static long y159d[30] = { +/*0x3fff0000,0x80000000,0x00000000,*/ +0xc0040000,0xf742612a,0x1c931a6c, +0x400a0000,0x8be301c0,0x2487d0fe, +0xc00e0000,0xcc1d2da1,0x3ad5bed4, +0x40120000,0xe107b802,0xdc463c4f, +0xc0160000,0xb4a08863,0x4172e5e5, +0x40190000,0xe66bea1c,0xb7976de5, +0xc01c0000,0xc358bc0f,0x0273a46a, +0x401e0000,0xff445ab3,0xe1488e0e, +0xc01d0000,0x8ba80f07,0x1c6db3ad, +0x40190000,0xcdb27952,0x6ab0a231, +}; +#endif + +extern long double MAXNUML; +/* #define MAXNUML 1.18973149535723176502e4932L */ +#define TWOOPI 6.36619772367581343075535e-1L +#define THPIO4 2.35619449019234492885L +#define Y1Z1 2.19714132603101703515e0L +#define Y1Z2 5.42968104079413513277e0L +#define Y1Z3 8.59600586833116892643e0L +#define Y1Z4 1.17491548308398812434e1L + +long double y1l(x) +long double x; +{ +long double xx, y, z, modulus, phase; + +if( x < 0.0 ) + { + return (-MAXNUML); + } +z = 1.0/x; +xx = x * x; +if( xx < 81.0L ) + { + if( xx < 20.25L ) + { + y = TWOOPI * (logl(x) * j1l(x) - z); + y += x * polevll( xx, y1n, 6 ) / p1evll( xx, y1d, 7 ); + } + else + { + y = (x - Y1Z1)*(x - Y1Z2)*(x - Y1Z3)*(x - Y1Z4); + y *= polevll( x, y159n, 9 ) / p1evll( x, y159d, 10 ); + } + return y; + } + +xx = 1.0/xx; +phase = polevll( xx, phasen, 5 ) / p1evll( xx, phased, 6 ); + +modulus = polevll( z, modulusn, 7 ) / p1evll( z, modulusd, 8 ); + +z = modulus * sinl( x - THPIO4L + z*phase) / sqrtl(x); +return z; +} |