summaryrefslogtreecommitdiff
path: root/libm/ldouble/j1l.c
diff options
context:
space:
mode:
Diffstat (limited to 'libm/ldouble/j1l.c')
-rw-r--r--libm/ldouble/j1l.c551
1 files changed, 0 insertions, 551 deletions
diff --git a/libm/ldouble/j1l.c b/libm/ldouble/j1l.c
deleted file mode 100644
index 83428473e..000000000
--- a/libm/ldouble/j1l.c
+++ /dev/null
@@ -1,551 +0,0 @@
-/* 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;
-}