xref: /csrg-svn/lib/libm/common_source/j1.c (revision 31853)
124598Szliu #ifndef lint
224706Selefunt static char sccsid[] =
3*31853Szliu "@(#)j1.c	4.2 (Berkeley) 8/21/85; 1.4 (ucb.elefunt) 07/13/87";
4*31853Szliu #endif	/* not lint */
524598Szliu 
624598Szliu /*
724598Szliu 	floating point Bessel's function
824598Szliu 	of the first and second kinds
924598Szliu 	of order one
1024598Szliu 
1124598Szliu 	j1(x) returns the value of J1(x)
1224598Szliu 	for all real values of x.
1324598Szliu 
1424598Szliu 	There are no error returns.
1524598Szliu 	Calls sin, cos, sqrt.
1624598Szliu 
1724598Szliu 	There is a niggling bug in J1 which
1824598Szliu 	causes errors up to 2e-16 for x in the
1924598Szliu 	interval [-8,8].
2024598Szliu 	The bug is caused by an inappropriate order
2124598Szliu 	of summation of the series.  rhm will fix it
2224598Szliu 	someday.
2324598Szliu 
2424598Szliu 	Coefficients are from Hart & Cheney.
2524598Szliu 	#6050 (20.98D)
2624598Szliu 	#6750 (19.19D)
2724598Szliu 	#7150 (19.35D)
2824598Szliu 
2924598Szliu 	y1(x) returns the value of Y1(x)
3024598Szliu 	for positive real values of x.
3124598Szliu 	For x<=0, if on the VAX, error number EDOM is set and
3224598Szliu 	the reserved operand fault is generated;
3324598Szliu 	otherwise (an IEEE machine) an invalid operation is performed.
3424598Szliu 
3524598Szliu 	Calls sin, cos, sqrt, log, j1.
3624598Szliu 
3724598Szliu 	The values of Y1 have not been checked
3824598Szliu 	to more than ten places.
3924598Szliu 
4024598Szliu 	Coefficients are from Hart & Cheney.
4124598Szliu 	#6447 (22.18D)
4224598Szliu 	#6750 (19.19D)
4324598Szliu 	#7150 (19.35D)
4424598Szliu */
4524598Szliu 
4624598Szliu #include <math.h>
47*31853Szliu #if defined(vax)||defined(tahoe)
4824598Szliu #include <errno.h>
49*31853Szliu #else	/* defined(vax)||defined(tahoe) */
5024598Szliu static double zero = 0.e0;
51*31853Szliu #endif	/* defined(vax)||defined(tahoe) */
5224598Szliu static double pzero, qzero;
5324598Szliu static double tpi	= .6366197723675813430755350535e0;
5424598Szliu static double pio4	= .7853981633974483096156608458e0;
5524598Szliu static double p1[] = {
5624598Szliu 	0.581199354001606143928050809e21,
5724598Szliu 	-.6672106568924916298020941484e20,
5824598Szliu 	0.2316433580634002297931815435e19,
5924598Szliu 	-.3588817569910106050743641413e17,
6024598Szliu 	0.2908795263834775409737601689e15,
6124598Szliu 	-.1322983480332126453125473247e13,
6224598Szliu 	0.3413234182301700539091292655e10,
6324598Szliu 	-.4695753530642995859767162166e7,
6424598Szliu 	0.2701122710892323414856790990e4,
6524598Szliu };
6624598Szliu static double q1[] = {
6724598Szliu 	0.1162398708003212287858529400e22,
6824598Szliu 	0.1185770712190320999837113348e20,
6924598Szliu 	0.6092061398917521746105196863e17,
7024598Szliu 	0.2081661221307607351240184229e15,
7124598Szliu 	0.5243710262167649715406728642e12,
7224598Szliu 	0.1013863514358673989967045588e10,
7324598Szliu 	0.1501793594998585505921097578e7,
7424598Szliu 	0.1606931573481487801970916749e4,
7524598Szliu 	1.0,
7624598Szliu };
7724598Szliu static double p2[] = {
7824598Szliu 	-.4435757816794127857114720794e7,
7924598Szliu 	-.9942246505077641195658377899e7,
8024598Szliu 	-.6603373248364939109255245434e7,
8124598Szliu 	-.1523529351181137383255105722e7,
8224598Szliu 	-.1098240554345934672737413139e6,
8324598Szliu 	-.1611616644324610116477412898e4,
8424598Szliu 	0.0,
8524598Szliu };
8624598Szliu static double q2[] = {
8724598Szliu 	-.4435757816794127856828016962e7,
8824598Szliu 	-.9934124389934585658967556309e7,
8924598Szliu 	-.6585339479723087072826915069e7,
9024598Szliu 	-.1511809506634160881644546358e7,
9124598Szliu 	-.1072638599110382011903063867e6,
9224598Szliu 	-.1455009440190496182453565068e4,
9324598Szliu 	1.0,
9424598Szliu };
9524598Szliu static double p3[] = {
9624598Szliu 	0.3322091340985722351859704442e5,
9724598Szliu 	0.8514516067533570196555001171e5,
9824598Szliu 	0.6617883658127083517939992166e5,
9924598Szliu 	0.1849426287322386679652009819e5,
10024598Szliu 	0.1706375429020768002061283546e4,
10124598Szliu 	0.3526513384663603218592175580e2,
10224598Szliu 	0.0,
10324598Szliu };
10424598Szliu static double q3[] = {
10524598Szliu 	0.7087128194102874357377502472e6,
10624598Szliu 	0.1819458042243997298924553839e7,
10724598Szliu 	0.1419460669603720892855755253e7,
10824598Szliu 	0.4002944358226697511708610813e6,
10924598Szliu 	0.3789022974577220264142952256e5,
11024598Szliu 	0.8638367769604990967475517183e3,
11124598Szliu 	1.0,
11224598Szliu };
11324598Szliu static double p4[] = {
11424598Szliu 	-.9963753424306922225996744354e23,
11524598Szliu 	0.2655473831434854326894248968e23,
11624598Szliu 	-.1212297555414509577913561535e22,
11724598Szliu 	0.2193107339917797592111427556e20,
11824598Szliu 	-.1965887462722140658820322248e18,
11924598Szliu 	0.9569930239921683481121552788e15,
12024598Szliu 	-.2580681702194450950541426399e13,
12124598Szliu 	0.3639488548124002058278999428e10,
12224598Szliu 	-.2108847540133123652824139923e7,
12324598Szliu 	0.0,
12424598Szliu };
12524598Szliu static double q4[] = {
12624598Szliu 	0.5082067366941243245314424152e24,
12724598Szliu 	0.5435310377188854170800653097e22,
12824598Szliu 	0.2954987935897148674290758119e20,
12924598Szliu 	0.1082258259408819552553850180e18,
13024598Szliu 	0.2976632125647276729292742282e15,
13124598Szliu 	0.6465340881265275571961681500e12,
13224598Szliu 	0.1128686837169442121732366891e10,
13324598Szliu 	0.1563282754899580604737366452e7,
13424598Szliu 	0.1612361029677000859332072312e4,
13524598Szliu 	1.0,
13624598Szliu };
13724598Szliu 
13824598Szliu double
13924598Szliu j1(arg) double arg;{
14024598Szliu 	double xsq, n, d, x;
14124598Szliu 	double sin(), cos(), sqrt();
14224598Szliu 	int i;
14324598Szliu 
14424598Szliu 	x = arg;
14524598Szliu 	if(x < 0.) x = -x;
14624598Szliu 	if(x > 8.){
14724598Szliu 		asympt(x);
14824598Szliu 		n = x - 3.*pio4;
14924598Szliu 		n = sqrt(tpi/x)*(pzero*cos(n) - qzero*sin(n));
15024598Szliu 		if(arg <0.) n = -n;
15124598Szliu 		return(n);
15224598Szliu 	}
15324598Szliu 	xsq = x*x;
15424598Szliu 	for(n=0,d=0,i=8;i>=0;i--){
15524598Szliu 		n = n*xsq + p1[i];
15624598Szliu 		d = d*xsq + q1[i];
15724598Szliu 	}
15824598Szliu 	return(arg*n/d);
15924598Szliu }
16024598Szliu 
16124598Szliu double
16224598Szliu y1(arg) double arg;{
16324598Szliu 	double xsq, n, d, x;
16424598Szliu 	double sin(), cos(), sqrt(), log(), j1();
16524598Szliu 	int i;
16624598Szliu 
16724598Szliu 	x = arg;
16824598Szliu 	if(x <= 0.){
169*31853Szliu #if defined(vax)||defined(tahoe)
17024598Szliu 		extern double infnan();
17124598Szliu 		return(infnan(EDOM));		/* NaN */
172*31853Szliu #else	/* defined(vax)||defined(tahoe) */
17324598Szliu 		return(zero/zero);	/* IEEE machines: invalid operation */
174*31853Szliu #endif	/* defined(vax)||defined(tahoe) */
17524598Szliu 	}
17624598Szliu 	if(x > 8.){
17724598Szliu 		asympt(x);
17824598Szliu 		n = x - 3*pio4;
17924598Szliu 		return(sqrt(tpi/x)*(pzero*sin(n) + qzero*cos(n)));
18024598Szliu 	}
18124598Szliu 	xsq = x*x;
18224598Szliu 	for(n=0,d=0,i=9;i>=0;i--){
18324598Szliu 		n = n*xsq + p4[i];
18424598Szliu 		d = d*xsq + q4[i];
18524598Szliu 	}
18624598Szliu 	return(x*n/d + tpi*(j1(x)*log(x)-1./x));
18724598Szliu }
18824598Szliu 
18924598Szliu static
19024598Szliu asympt(arg) double arg;{
19124598Szliu 	double zsq, n, d;
19224598Szliu 	int i;
19324598Szliu 	zsq = 64./(arg*arg);
19424598Szliu 	for(n=0,d=0,i=6;i>=0;i--){
19524598Szliu 		n = n*zsq + p2[i];
19624598Szliu 		d = d*zsq + q2[i];
19724598Szliu 	}
19824598Szliu 	pzero = n/d;
19924598Szliu 	for(n=0,d=0,i=6;i>=0;i--){
20024598Szliu 		n = n*zsq + p3[i];
20124598Szliu 		d = d*zsq + q3[i];
20224598Szliu 	}
20324598Szliu 	qzero = (8./arg)*(n/d);
20424598Szliu }
205