1 files changed, 541 insertions, 0 deletions
diff --git a/libm/ldouble/j0l.c b/libm/ldouble/j0l.c
new file mode 100644
index 000000000..a30a65a4f
--- /dev/null
+++ b/libm/ldouble/j0l.c
@@ -0,0 +1,541 @@
+/*							j0l.c
+ *
+ *	Bessel function of order zero
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double x, y, j0l();
+ *
+ * y = j0l( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns Bessel function of first kind, order zero 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) P7(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 M0(x) = sqrt(J0(x)^2 + Y0(x)^2) and phase  P0(x)
+ * = atan(Y0(x)/J0(x)).  M0 is approximated by sqrt(1/x)P7(1/x)/Q7(1/x).
+ * The approximation to J0 is M0 * cos(x -  pi/4 + 1/x P5(1/x^2)/Q6(1/x^2)).
+ *
+ *
+ * ACCURACY:
+ *
+ *                      Absolute error:
+ * arithmetic   domain      # trials      peak         rms
+ *    IEEE      0, 30       100000      2.8e-19      7.4e-20
+ *
+ *
+ */
+/*							y0l.c
+ *
+ *	Bessel function of the second kind, order zero
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, y0l();
+ *
+ * y = y0l( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns Bessel function of the second kind, of order
+ * zero, of the argument.
+ *
+ * The domain is divided into the intervals [0, 5>, [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)P7(x)/Q7(x)
+ * where p, q, r, s are zeros of y0(x).
+ *
+ * The third interval uses the same approximations to modulus
+ * and phase as j0(x), whence y0(x) = modulus * sin(phase).
+ *
+ * ACCURACY:
+ *
+ *  Absolute error, when y0(x) < 1; else relative error:
+ *
+ * arithmetic   domain     # trials      peak         rms
+ *    IEEE      0, 30       100000      3.4e-19     7.6e-20
+ *
+ */
+
+/* Copyright 1994 by Stephen L. Moshier (moshier@world.std.com).  */
+
+#include <math.h>
+
+/*
+j0(x) = (x^2-JZ1)(x^2-JZ2)(x^2-JZ3)P(x**2)/Q(x**2)
+0 <= x <= 9
+Relative error
+n=7, d=8
+Peak error =  8.49e-22
+Relative error spread =  2.2e-3
+*/
+#if UNK
+static long double j0n[8] = {
+ 1.296848754518641770562E0L,
+-3.239201943301299801018E3L,
+ 3.490002040733471400107E6L,
+-2.076797068740966813173E9L,
+ 7.283696461857171054941E11L,
+-1.487926133645291056388E14L,
+ 1.620335009643150402368E16L,
+-7.173386747526788067407E17L,
+};
+static long double j0d[8] = {
+/* 1.000000000000000000000E0L,*/
+ 2.281959869176887763845E3L,
+ 2.910386840401647706984E6L,
+ 2.608400226578100610991E9L,
+ 1.752689035792859338860E12L,
+ 8.879132373286001289461E14L,
+ 3.265560832845194013669E17L,
+ 7.881340554308432241892E19L,
+ 9.466475654163919450528E21L,
+};
+#endif
+#if IBMPC
+static short j0n[] = {
+0xf759,0x4208,0x23d6,0xa5ff,0x3fff, XPD
+0xa9a8,0xe62b,0x3b28,0xca73,0xc00a, XPD
+0xfe10,0xb608,0x4829,0xd503,0x4014, XPD
+0x008c,0x7b60,0xd119,0xf792,0xc01d, XPD
+0x943a,0x69b7,0x36ca,0xa996,0x4026, XPD
+0x1b0b,0x6331,0x7add,0x8753,0xc02e, XPD
+0x4018,0xad26,0x71ba,0xe643,0x4034, XPD
+0xb96c,0xc486,0xfb95,0x9f47,0xc03a, XPD
+};
+static short j0d[] = {
+/*0x0000,0x0000,0x0000,0x8000,0x3fff, XPD*/
+0xbdfe,0xc832,0x5b9f,0x8e9f,0x400a, XPD
+0xe1a0,0x923f,0xcb5c,0xb1a2,0x4014, XPD
+0x66d2,0x93fe,0x0762,0x9b79,0x401e, XPD
+0xfed1,0x086d,0x3425,0xcc0a,0x4027, XPD
+0x0841,0x8cb6,0x5a46,0xc9e3,0x4030, XPD
+0x3d2c,0xed55,0x20e1,0x9105,0x4039, XPD
+0xfdce,0xa4ca,0x2ed8,0x88b8,0x4041, XPD
+0x00ac,0xfb2b,0x6f62,0x804b,0x4048, XPD
+};
+#endif
+#if MIEEE
+static long j0n[24] = {
+0x3fff0000,0xa5ff23d6,0x4208f759,
+0xc00a0000,0xca733b28,0xe62ba9a8,
+0x40140000,0xd5034829,0xb608fe10,
+0xc01d0000,0xf792d119,0x7b60008c,
+0x40260000,0xa99636ca,0x69b7943a,
+0xc02e0000,0x87537add,0x63311b0b,
+0x40340000,0xe64371ba,0xad264018,
+0xc03a0000,0x9f47fb95,0xc486b96c,
+};
+static long j0d[24] = {
+/*0x3fff0000,0x80000000,0x00000000,*/
+0x400a0000,0x8e9f5b9f,0xc832bdfe,
+0x40140000,0xb1a2cb5c,0x923fe1a0,
+0x401e0000,0x9b790762,0x93fe66d2,
+0x40270000,0xcc0a3425,0x086dfed1,
+0x40300000,0xc9e35a46,0x8cb60841,
+0x40390000,0x910520e1,0xed553d2c,
+0x40410000,0x88b82ed8,0xa4cafdce,
+0x40480000,0x804b6f62,0xfb2b00ac,
+};
+#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=7
+Peak error =  1.80e-20
+Relative error spread =  5.1e-2
+*/
+#if UNK
+static long double modulusn[8] = {
+ 3.947542376069224461532E-1L,
+ 6.864682945702134624126E0L,
+ 1.021369773577974343844E1L,
+ 7.626141421290849630523E0L,
+ 2.842537511425216145635E0L,
+ 7.162842530423205720962E-1L,
+ 9.036664453160200052296E-2L,
+ 8.461833426898867839659E-3L,
+};
+static long double modulusd[7] = {
+/* 1.000000000000000000000E0L,*/
+ 9.117176038171821115904E0L,
+ 1.301235226061478261481E1L,
+ 9.613002539386213788182E0L,
+ 3.569671060989910901903E0L,
+ 8.983920141407590632423E-1L,
+ 1.132577931332212304986E-1L,
+ 1.060533546154121770442E-2L,
+};
+#endif
+#if IBMPC
+static short modulusn[] = {
+0x8559,0xf552,0x3a38,0xca1d,0x3ffd, XPD
+0x38a3,0xa663,0x7b91,0xdbab,0x4001, XPD
+0xb343,0x2673,0x4e51,0xa36b,0x4002, XPD
+0x5e4b,0xe3af,0x59bb,0xf409,0x4001, XPD
+0xb1cd,0x4e5e,0x2274,0xb5ec,0x4000, XPD
+0xcfe9,0x74e0,0x67a1,0xb75e,0x3ffe, XPD
+0x6b78,0x4cc6,0x25b7,0xb912,0x3ffb, XPD
+0xcb2b,0x4b73,0x8075,0x8aa3,0x3ff8, XPD
+};
+static short modulusd[] = {
+/*0x0000,0x0000,0x0000,0x8000,0x3fff, XPD*/
+0x4498,0x3d2a,0xf3fb,0x91df,0x4002, XPD
+0x5e3d,0xb5f4,0x9848,0xd032,0x4002, XPD
+0xb837,0x3075,0xdbc0,0x99ce,0x4002, XPD
+0x775a,0x1b79,0x7d9c,0xe475,0x4000, XPD
+0x7e3f,0xb8dd,0x04df,0xe5fd,0x3ffe, XPD
+0xed5a,0x31cd,0xb3ac,0xe7f3,0x3ffb, XPD
+0x8a83,0x1b80,0x003e,0xadc2,0x3ff8, XPD
+};
+#endif
+#if MIEEE
+static long modulusn[24] = {
+0x3ffd0000,0xca1d3a38,0xf5528559,
+0x40010000,0xdbab7b91,0xa66338a3,
+0x40020000,0xa36b4e51,0x2673b343,
+0x40010000,0xf40959bb,0xe3af5e4b,
+0x40000000,0xb5ec2274,0x4e5eb1cd,
+0x3ffe0000,0xb75e67a1,0x74e0cfe9,
+0x3ffb0000,0xb91225b7,0x4cc66b78,
+0x3ff80000,0x8aa38075,0x4b73cb2b,
+};
+static long modulusd[21] = {
+/*0x3fff0000,0x80000000,0x00000000,*/
+0x40020000,0x91dff3fb,0x3d2a4498,
+0x40020000,0xd0329848,0xb5f45e3d,
+0x40020000,0x99cedbc0,0x3075b837,
+0x40000000,0xe4757d9c,0x1b79775a,
+0x3ffe0000,0xe5fd04df,0xb8dd7e3f,
+0x3ffb0000,0xe7f3b3ac,0x31cded5a,
+0x3ff80000,0xadc2003e,0x1b808a83,
+};
+#endif
+/*
+atan(y0(x)/j0(x)) = x - pi/4 + x P(x**2)/Q(x**2)
+Absolute error
+n=5, d=6
+Peak error =  2.80e-21
+Relative error spread =  5.5e-1
+*/
+#if UNK
+static long double phasen[6] = {
+-7.356766355393571519038E-1L,
+-5.001635199922493694706E-1L,
+-7.737323518141516881715E-2L,
+-3.998893155826990642730E-3L,
+-7.496317036829964150970E-5L,
+-4.290885090773112963542E-7L,
+};
+static long double phased[6] = {
+/* 1.000000000000000000000E0L,*/
+ 7.377856408614376072745E0L,
+ 4.285043297797736118069E0L,
+ 6.348446472935245102890E-1L,
+ 3.229866782185025048457E-2L,
+ 6.014932317342190404134E-4L,
+ 3.432708072618490390095E-6L,
+};
+#endif
+#if IBMPC
+static short phasen[] = {
+0x5106,0x12a6,0x4dd2,0xbc55,0xbffe, XPD
+0x1e30,0x04da,0xb769,0x800a,0xbffe, XPD
+0x8d8a,0x84e7,0xdbd5,0x9e75,0xbffb, XPD
+0xe514,0x8866,0x25a9,0x8309,0xbff7, XPD
+0xdc17,0x325e,0x8baf,0x9d35,0xbff1, XPD
+0x4c2f,0x2dd8,0x79c3,0xe65d,0xbfe9, XPD
+};
+static short phased[] = {
+/*0x0000,0x0000,0x0000,0x8000,0x3fff, XPD*/
+0xf3e9,0xb2a5,0x6652,0xec17,0x4001, XPD
+0x4b69,0x3f87,0x131f,0x891f,0x4001, XPD
+0x6f25,0x2a95,0x2dc6,0xa285,0x3ffe, XPD
+0x37bf,0xfcc8,0x9b9f,0x844b,0x3ffa, XPD
+0xac5c,0x4806,0x8709,0x9dad,0x3ff4, XPD
+0x4c8c,0x2dd8,0x79c3,0xe65d,0x3fec, XPD
+};
+#endif
+#if MIEEE
+static long phasen[18] = {
+0xbffe0000,0xbc554dd2,0x12a65106,
+0xbffe0000,0x800ab769,0x04da1e30,
+0xbffb0000,0x9e75dbd5,0x84e78d8a,
+0xbff70000,0x830925a9,0x8866e514,
+0xbff10000,0x9d358baf,0x325edc17,
+0xbfe90000,0xe65d79c3,0x2dd84c2f,
+};
+static long phased[18] = {
+/*0x3fff0000,0x80000000,0x00000000,*/
+0x40010000,0xec176652,0xb2a5f3e9,
+0x40010000,0x891f131f,0x3f874b69,
+0x3ffe0000,0xa2852dc6,0x2a956f25,
+0x3ffa0000,0x844b9b9f,0xfcc837bf,
+0x3ff40000,0x9dad8709,0x4806ac5c,
+0x3fec0000,0xe65d79c3,0x2dd84c8c,
+};
+#endif
+#define JZ1 5.783185962946784521176L
+#define JZ2 30.47126234366208639908L
+#define JZ3 7.488700679069518344489e1L
+
+#define PIO4L 0.78539816339744830961566L
+#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 j0l ( long double );
+#else
+long double sqrtl(), fabsl(), polevll(), p1evll(), cosl(), sinl(), logl();
+long double j0l();
+#endif
+
+long double j0l(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 *= polevll( xx, j0n, 7 ) / p1evll( xx, j0d, 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, 7 );
+
+y = modulus * cosl( y -  PIO4L + z*phase) / sqrtl(y);
+return y;
+}
+
+
+/*
+y0(x) = 2/pi * log(x) * j0(x) + P(z**2)/Q(z**2)
+0 <= x <= 5
+Absolute error
+n=7, d=7
+Peak error =  8.55e-22
+Relative error spread =  2.7e-1
+*/
+#if UNK
+static long double y0n[8] = {
+ 1.556909814120445353691E4L,
+-1.464324149797947303151E7L,
+ 5.427926320587133391307E9L,
+-9.808510181632626683952E11L,
+ 8.747842804834934784972E13L,
+-3.461898868011666236539E15L,
+ 4.421767595991969611983E16L,
+-1.847183690384811186958E16L,
+};
+static long double y0d[7] = {
+/* 1.000000000000000000000E0L,*/
+ 1.040792201755841697889E3L,
+ 6.256391154086099882302E5L,
+ 2.686702051957904669677E8L,
+ 8.630939306572281881328E10L,
+ 2.027480766502742538763E13L,
+ 3.167750475899536301562E15L,
+ 2.502813268068711844040E17L,
+};
+#endif
+#if IBMPC
+static short y0n[] = {
+0x126c,0x20be,0x647f,0xf344,0x400c, XPD
+0x2ec0,0x7b95,0x297f,0xdf70,0xc016, XPD
+0x2fdd,0x4b27,0xca98,0xa1c3,0x401f, XPD
+0x3e3c,0xb343,0x46c9,0xe45f,0xc026, XPD
+0xb219,0x37ba,0x5142,0x9f1f,0x402d, XPD
+0x23c9,0x6b29,0x4244,0xc4c9,0xc032, XPD
+0x501f,0x6264,0xbdf4,0x9d17,0x4036, XPD
+0x5fbd,0x0171,0x135a,0x8340,0xc035, XPD
+};
+static short y0d[] = {
+/*0x0000,0x0000,0x0000,0x8000,0x3fff, XPD*/
+0x9057,0x7f25,0x59b7,0x8219,0x4009, XPD
+0xd938,0xb6b2,0x71d8,0x98be,0x4012, XPD
+0x97a4,0x90fa,0xa7e9,0x801c,0x401b, XPD
+0x553b,0x4dc8,0x8695,0xa0c3,0x4023, XPD
+0x6732,0x8c1b,0xc5ab,0x9384,0x402b, XPD
+0x04d3,0xa629,0xd61d,0xb410,0x4032, XPD
+0x241a,0x8f2b,0x629a,0xde4b,0x4038, XPD
+};
+#endif
+#if MIEEE
+static long y0n[24] = {
+0x400c0000,0xf344647f,0x20be126c,
+0xc0160000,0xdf70297f,0x7b952ec0,
+0x401f0000,0xa1c3ca98,0x4b272fdd,
+0xc0260000,0xe45f46c9,0xb3433e3c,
+0x402d0000,0x9f1f5142,0x37bab219,
+0xc0320000,0xc4c94244,0x6b2923c9,
+0x40360000,0x9d17bdf4,0x6264501f,
+0xc0350000,0x8340135a,0x01715fbd,
+};
+static long y0d[21] = {
+/*0x3fff0000,0x80000000,0x00000000,*/
+0x40090000,0x821959b7,0x7f259057,
+0x40120000,0x98be71d8,0xb6b2d938,
+0x401b0000,0x801ca7e9,0x90fa97a4,
+0x40230000,0xa0c38695,0x4dc8553b,
+0x402b0000,0x9384c5ab,0x8c1b6732,
+0x40320000,0xb410d61d,0xa62904d3,
+0x40380000,0xde4b629a,0x8f2b241a,
+};
+#endif
+/*
+y0(x) = (x-Y0Z1)(x-Y0Z2)(x-Y0Z3)(x-Y0Z4)P(x)/Q(x)
+4.5 <= x <= 9
+Absolute error
+n=9, d=9
+Peak error =  2.35e-20
+Relative error spread =  7.8e-13
+*/
+#if UNK
+static long double y059n[10] = {
+ 2.368715538373384869796E-2L,
+-1.472923738545276751402E0L,
+ 2.525993724177105060507E1L,
+ 7.727403527387097461580E1L,
+-4.578271827238477598563E3L,
+ 7.051411242092171161986E3L,
+ 1.951120419910720443331E5L,
+ 6.515211089266670755622E5L,
+-1.164760792144532266855E5L,
+-5.566567444353735925323E5L,
+};
+static long double y059d[9] = {
+/* 1.000000000000000000000E0L,*/
+-6.235501989189125881723E1L,
+ 2.224790285641017194158E3L,
+-5.103881883748705381186E4L,
+ 8.772616606054526158657E5L,
+-1.096162986826467060921E7L,
+ 1.083335477747278958468E8L,
+-7.045635226159434678833E8L,
+ 3.518324187204647941098E9L,
+ 1.173085288957116938494E9L,
+};
+#endif
+#if IBMPC
+static short y059n[] = {
+0x992f,0xab45,0x90b6,0xc20b,0x3ff9, XPD
+0x1207,0x46ea,0xc3db,0xbc88,0xbfff, XPD
+0x5504,0x035a,0x59fa,0xca14,0x4003, XPD
+0xd5a3,0xf673,0x4e59,0x9a8c,0x4005, XPD
+0x62e0,0xc25b,0x2cb3,0x8f12,0xc00b, XPD
+0xe8fa,0x4b44,0x4a39,0xdc5b,0x400b, XPD
+0x49e2,0xfb52,0x02af,0xbe8a,0x4010, XPD
+0x8c07,0x29e3,0x11be,0x9f10,0x4012, XPD
+0xfd54,0xb2fe,0x0a23,0xe37e,0xc00f, XPD
+0xf90c,0x3510,0x0be9,0x87e7,0xc012, XPD
+};
+static short y059d[] = {
+/*0x0000,0x0000,0x0000,0x8000,0x3fff, XPD*/
+0xdebf,0xa468,0x8a55,0xf96b,0xc004, XPD
+0xad09,0x8e6a,0xa502,0x8b0c,0x400a, XPD
+0xa28c,0x5563,0xd19f,0xc75e,0xc00e, XPD
+0xe8b6,0xd705,0xda91,0xd62c,0x4012, XPD
+0xec8a,0x4697,0xddde,0xa742,0xc016, XPD
+0x27ff,0xca92,0x3d78,0xcea1,0x4019, XPD
+0xe26b,0x76b9,0x250a,0xa7fb,0xc01c, XPD
+0xceb6,0x3463,0x5ddb,0xd1b5,0x401e, XPD
+0x3b3b,0xea0b,0xb8d1,0x8bd7,0x401d, XPD
+};
+#endif
+#if MIEEE
+static long y059n[30] = {
+0x3ff90000,0xc20b90b6,0xab45992f,
+0xbfff0000,0xbc88c3db,0x46ea1207,
+0x40030000,0xca1459fa,0x035a5504,
+0x40050000,0x9a8c4e59,0xf673d5a3,
+0xc00b0000,0x8f122cb3,0xc25b62e0,
+0x400b0000,0xdc5b4a39,0x4b44e8fa,
+0x40100000,0xbe8a02af,0xfb5249e2,
+0x40120000,0x9f1011be,0x29e38c07,
+0xc00f0000,0xe37e0a23,0xb2fefd54,
+0xc0120000,0x87e70be9,0x3510f90c,
+};
+static long y059d[27] = {
+/*0x3fff0000,0x80000000,0x00000000,*/
+0xc0040000,0xf96b8a55,0xa468debf,
+0x400a0000,0x8b0ca502,0x8e6aad09,
+0xc00e0000,0xc75ed19f,0x5563a28c,
+0x40120000,0xd62cda91,0xd705e8b6,
+0xc0160000,0xa742ddde,0x4697ec8a,
+0x40190000,0xcea13d78,0xca9227ff,
+0xc01c0000,0xa7fb250a,0x76b9e26b,
+0x401e0000,0xd1b55ddb,0x3463ceb6,
+0x401d0000,0x8bd7b8d1,0xea0b3b3b,
+};
+#endif
+#define TWOOPI 6.36619772367581343075535E-1L
+#define Y0Z1 3.957678419314857868376e0L
+#define Y0Z2 7.086051060301772697624e0L
+#define Y0Z3 1.022234504349641701900e1L
+#define Y0Z4 1.336109747387276347827e1L
+/* #define MAXNUML 1.189731495357231765021e4932L */
+extern long double MAXNUML;
+
+long double y0l(x)
+long double x;
+{
+long double xx, y, z, modulus, phase;
+
+if( x < 0.0 )
+  {
+    return (-MAXNUML);
+  }
+xx = x * x;
+if( xx < 81.0L )
+  {
+    if( xx < 20.25L )
+      {
+	y = TWOOPI * logl(x) * j0l(x);
+	y += polevll( xx, y0n, 7 ) / p1evll( xx, y0d, 7 );
+      }
+    else
+      {
+	y = (x - Y0Z1)*(x - Y0Z2)*(x - Y0Z3)*(x - Y0Z4);
+	y *= polevll( x, y059n, 9 ) / p1evll( x, y059d, 9 );
+      }
+    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, 7 );
+
+y = modulus * sinl( y -  PIO4L + z*phase) / sqrtl(y);
+return y;
+}