summaryrefslogtreecommitdiff
path: root/libm/ldouble/j0l.c
diff options
context:
space:
mode:
authorEric Andersen <andersen@codepoet.org>2001-11-22 14:04:29 +0000
committerEric Andersen <andersen@codepoet.org>2001-11-22 14:04:29 +0000
commit7ce331c01ce6eb7b3f5c715a38a24359da9c6ee2 (patch)
tree3a7e8476e868ae15f4da1b7ce26b2db6f434468c /libm/ldouble/j0l.c
parentc117dd5fb183afb1a4790a6f6110d88704be6bf8 (diff)
Totally rework the math library, this time based on the MacOs X
math library (which is itself based on the math lib from FreeBSD). -Erik
Diffstat (limited to 'libm/ldouble/j0l.c')
-rw-r--r--libm/ldouble/j0l.c541
1 files changed, 0 insertions, 541 deletions
diff --git a/libm/ldouble/j0l.c b/libm/ldouble/j0l.c
deleted file mode 100644
index a30a65a4f..000000000
--- a/libm/ldouble/j0l.c
+++ /dev/null
@@ -1,541 +0,0 @@
-/* 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;
-}