xref: /csrg-svn/lib/libm/common_source/j0.c (revision 31853)
124597Szliu #ifndef lint
224706Selefunt static char sccsid[] =
3*31853Szliu "@(#)j0.c	4.2 (Berkeley) 8/21/85; 1.3 (ucb.elefunt) 07/13/87";
4*31853Szliu #endif	/* not lint */
524597Szliu 
624597Szliu /*
724597Szliu 	floating point Bessel's function
824597Szliu 	of the first and second kinds
924597Szliu 	of order zero
1024597Szliu 
1124597Szliu 	j0(x) returns the value of J0(x)
1224597Szliu 	for all real values of x.
1324597Szliu 
1424597Szliu 	There are no error returns.
1524597Szliu 	Calls sin, cos, sqrt.
1624597Szliu 
1724597Szliu 	There is a niggling bug in J0 which
1824597Szliu 	causes errors up to 2e-16 for x in the
1924597Szliu 	interval [-8,8].
2024597Szliu 	The bug is caused by an inappropriate order
2124597Szliu 	of summation of the series.  rhm will fix it
2224597Szliu 	someday.
2324597Szliu 
2424597Szliu 	Coefficients are from Hart & Cheney.
2524597Szliu 	#5849 (19.22D)
2624597Szliu 	#6549 (19.25D)
2724597Szliu 	#6949 (19.41D)
2824597Szliu 
2924597Szliu 	y0(x) returns the value of Y0(x)
3024597Szliu 	for positive real values of x.
3124597Szliu 	For x<=0, if on the VAX, error number EDOM is set and
3224597Szliu 	the reserved operand fault is generated;
3324597Szliu 	otherwise (an IEEE machine) an invalid operation is performed.
3424597Szliu 
3524597Szliu 	Calls sin, cos, sqrt, log, j0.
3624597Szliu 
3724597Szliu 	The values of Y0 have not been checked
3824597Szliu 	to more than ten places.
3924597Szliu 
4024597Szliu 	Coefficients are from Hart & Cheney.
4124597Szliu 	#6245 (18.78D)
4224597Szliu 	#6549 (19.25D)
4324597Szliu 	#6949 (19.41D)
4424597Szliu */
4524597Szliu 
4624597Szliu #include <math.h>
47*31853Szliu #if defined(vax)||defined(tahoe)
4824597Szliu #include <errno.h>
49*31853Szliu #else	/* defined(vax)||defined(tahoe) */
5024597Szliu static double zero = 0.e0;
51*31853Szliu #endif	/* defined(vax)||defined(tahoe) */
5224597Szliu static double pzero, qzero;
5324597Szliu static double tpi	= .6366197723675813430755350535e0;
5424597Szliu static double pio4	= .7853981633974483096156608458e0;
5524597Szliu static double p1[] = {
5624597Szliu 	0.4933787251794133561816813446e21,
5724597Szliu 	-.1179157629107610536038440800e21,
5824597Szliu 	0.6382059341072356562289432465e19,
5924597Szliu 	-.1367620353088171386865416609e18,
6024597Szliu 	0.1434354939140344111664316553e16,
6124597Szliu 	-.8085222034853793871199468171e13,
6224597Szliu 	0.2507158285536881945555156435e11,
6324597Szliu 	-.4050412371833132706360663322e8,
6424597Szliu 	0.2685786856980014981415848441e5,
6524597Szliu };
6624597Szliu static double q1[] = {
6724597Szliu 	0.4933787251794133562113278438e21,
6824597Szliu 	0.5428918384092285160200195092e19,
6924597Szliu 	0.3024635616709462698627330784e17,
7024597Szliu 	0.1127756739679798507056031594e15,
7124597Szliu 	0.3123043114941213172572469442e12,
7224597Szliu 	0.6699987672982239671814028660e9,
7324597Szliu 	0.1114636098462985378182402543e7,
7424597Szliu 	0.1363063652328970604442810507e4,
7524597Szliu 	1.0
7624597Szliu };
7724597Szliu static double p2[] = {
7824597Szliu 	0.5393485083869438325262122897e7,
7924597Szliu 	0.1233238476817638145232406055e8,
8024597Szliu 	0.8413041456550439208464315611e7,
8124597Szliu 	0.2016135283049983642487182349e7,
8224597Szliu 	0.1539826532623911470917825993e6,
8324597Szliu 	0.2485271928957404011288128951e4,
8424597Szliu 	0.0,
8524597Szliu };
8624597Szliu static double q2[] = {
8724597Szliu 	0.5393485083869438325560444960e7,
8824597Szliu 	0.1233831022786324960844856182e8,
8924597Szliu 	0.8426449050629797331554404810e7,
9024597Szliu 	0.2025066801570134013891035236e7,
9124597Szliu 	0.1560017276940030940592769933e6,
9224597Szliu 	0.2615700736920839685159081813e4,
9324597Szliu 	1.0,
9424597Szliu };
9524597Szliu static double p3[] = {
9624597Szliu 	-.3984617357595222463506790588e4,
9724597Szliu 	-.1038141698748464093880530341e5,
9824597Szliu 	-.8239066313485606568803548860e4,
9924597Szliu 	-.2365956170779108192723612816e4,
10024597Szliu 	-.2262630641933704113967255053e3,
10124597Szliu 	-.4887199395841261531199129300e1,
10224597Szliu 	0.0,
10324597Szliu };
10424597Szliu static double q3[] = {
10524597Szliu 	0.2550155108860942382983170882e6,
10624597Szliu 	0.6667454239319826986004038103e6,
10724597Szliu 	0.5332913634216897168722255057e6,
10824597Szliu 	0.1560213206679291652539287109e6,
10924597Szliu 	0.1570489191515395519392882766e5,
11024597Szliu 	0.4087714673983499223402830260e3,
11124597Szliu 	1.0,
11224597Szliu };
11324597Szliu static double p4[] = {
11424597Szliu 	-.2750286678629109583701933175e20,
11524597Szliu 	0.6587473275719554925999402049e20,
11624597Szliu 	-.5247065581112764941297350814e19,
11724597Szliu 	0.1375624316399344078571335453e18,
11824597Szliu 	-.1648605817185729473122082537e16,
11924597Szliu 	0.1025520859686394284509167421e14,
12024597Szliu 	-.3436371222979040378171030138e11,
12124597Szliu 	0.5915213465686889654273830069e8,
12224597Szliu 	-.4137035497933148554125235152e5,
12324597Szliu };
12424597Szliu static double q4[] = {
12524597Szliu 	0.3726458838986165881989980e21,
12624597Szliu 	0.4192417043410839973904769661e19,
12724597Szliu 	0.2392883043499781857439356652e17,
12824597Szliu 	0.9162038034075185262489147968e14,
12924597Szliu 	0.2613065755041081249568482092e12,
13024597Szliu 	0.5795122640700729537480087915e9,
13124597Szliu 	0.1001702641288906265666651753e7,
13224597Szliu 	0.1282452772478993804176329391e4,
13324597Szliu 	1.0,
13424597Szliu };
13524597Szliu 
13624597Szliu double
13724597Szliu j0(arg) double arg;{
13824597Szliu 	double argsq, n, d;
13924597Szliu 	double sin(), cos(), sqrt();
14024597Szliu 	int i;
14124597Szliu 
14224597Szliu 	if(arg < 0.) arg = -arg;
14324597Szliu 	if(arg > 8.){
14424597Szliu 		asympt(arg);
14524597Szliu 		n = arg - pio4;
14624597Szliu 		return(sqrt(tpi/arg)*(pzero*cos(n) - qzero*sin(n)));
14724597Szliu 	}
14824597Szliu 	argsq = arg*arg;
14924597Szliu 	for(n=0,d=0,i=8;i>=0;i--){
15024597Szliu 		n = n*argsq + p1[i];
15124597Szliu 		d = d*argsq + q1[i];
15224597Szliu 	}
15324597Szliu 	return(n/d);
15424597Szliu }
15524597Szliu 
15624597Szliu double
15724597Szliu y0(arg) double arg;{
15824597Szliu 	double argsq, n, d;
15924597Szliu 	double sin(), cos(), sqrt(), log(), j0();
16024597Szliu 	int i;
16124597Szliu 
16224597Szliu 	if(arg <= 0.){
163*31853Szliu #if defined(vax)||defined(tahoe)
16424597Szliu 		extern double infnan();
16524597Szliu 		return(infnan(EDOM));		/* NaN */
166*31853Szliu #else	/* defined(vax)||defined(tahoe) */
16724597Szliu 		return(zero/zero);	/* IEEE machines: invalid operation */
168*31853Szliu #endif	/* defined(vax)||defined(tahoe) */
16924597Szliu 	}
17024597Szliu 	if(arg > 8.){
17124597Szliu 		asympt(arg);
17224597Szliu 		n = arg - pio4;
17324597Szliu 		return(sqrt(tpi/arg)*(pzero*sin(n) + qzero*cos(n)));
17424597Szliu 	}
17524597Szliu 	argsq = arg*arg;
17624597Szliu 	for(n=0,d=0,i=8;i>=0;i--){
17724597Szliu 		n = n*argsq + p4[i];
17824597Szliu 		d = d*argsq + q4[i];
17924597Szliu 	}
18024597Szliu 	return(n/d + tpi*j0(arg)*log(arg));
18124597Szliu }
18224597Szliu 
18324597Szliu static
18424597Szliu asympt(arg) double arg;{
18524597Szliu 	double zsq, n, d;
18624597Szliu 	int i;
18724597Szliu 	zsq = 64./(arg*arg);
18824597Szliu 	for(n=0,d=0,i=6;i>=0;i--){
18924597Szliu 		n = n*zsq + p2[i];
19024597Szliu 		d = d*zsq + q2[i];
19124597Szliu 	}
19224597Szliu 	pzero = n/d;
19324597Szliu 	for(n=0,d=0,i=6;i>=0;i--){
19424597Szliu 		n = n*zsq + p3[i];
19524597Szliu 		d = d*zsq + q3[i];
19624597Szliu 	}
19724597Szliu 	qzero = (8./arg)*(n/d);
19824597Szliu }
199