xref: /csrg-svn/lib/libm/common_source/j0.c (revision 35679)
134117Sbostic /*
234117Sbostic  * Copyright (c) 1985 Regents of the University of California.
334117Sbostic  * All rights reserved.  The Berkeley software License Agreement
434117Sbostic  * specifies the terms and conditions for redistribution.
534117Sbostic  */
634117Sbostic 
724597Szliu #ifndef lint
8*35679Sbostic static char sccsid[] = "@(#)j0.c	5.3 (Berkeley) 09/22/88";
934117Sbostic #endif /* not lint */
1024597Szliu 
1124597Szliu /*
1224597Szliu 	floating point Bessel's function
1324597Szliu 	of the first and second kinds
1424597Szliu 	of order zero
1524597Szliu 
1624597Szliu 	j0(x) returns the value of J0(x)
1724597Szliu 	for all real values of x.
1824597Szliu 
1924597Szliu 	There are no error returns.
2024597Szliu 	Calls sin, cos, sqrt.
2124597Szliu 
2224597Szliu 	There is a niggling bug in J0 which
2324597Szliu 	causes errors up to 2e-16 for x in the
2424597Szliu 	interval [-8,8].
2524597Szliu 	The bug is caused by an inappropriate order
2624597Szliu 	of summation of the series.  rhm will fix it
2724597Szliu 	someday.
2824597Szliu 
2924597Szliu 	Coefficients are from Hart & Cheney.
3024597Szliu 	#5849 (19.22D)
3124597Szliu 	#6549 (19.25D)
3224597Szliu 	#6949 (19.41D)
3324597Szliu 
3424597Szliu 	y0(x) returns the value of Y0(x)
3524597Szliu 	for positive real values of x.
3624597Szliu 	For x<=0, if on the VAX, error number EDOM is set and
3724597Szliu 	the reserved operand fault is generated;
3824597Szliu 	otherwise (an IEEE machine) an invalid operation is performed.
3924597Szliu 
4024597Szliu 	Calls sin, cos, sqrt, log, j0.
4124597Szliu 
4224597Szliu 	The values of Y0 have not been checked
4324597Szliu 	to more than ten places.
4424597Szliu 
4524597Szliu 	Coefficients are from Hart & Cheney.
4624597Szliu 	#6245 (18.78D)
4724597Szliu 	#6549 (19.25D)
4824597Szliu 	#6949 (19.41D)
4924597Szliu */
5024597Szliu 
51*35679Sbostic #include "mathimpl.h"
52*35679Sbostic 
5331853Szliu #if defined(vax)||defined(tahoe)
5424597Szliu #include <errno.h>
5531853Szliu #else	/* defined(vax)||defined(tahoe) */
56*35679Sbostic static const double zero = 0.e0;
5731853Szliu #endif	/* defined(vax)||defined(tahoe) */
58*35679Sbostic 
5924597Szliu static double pzero, qzero;
60*35679Sbostic 
61*35679Sbostic static const double tpi	= .6366197723675813430755350535e0;
62*35679Sbostic static const double pio4	= .7853981633974483096156608458e0;
63*35679Sbostic static const double p1[] = {
6424597Szliu 	0.4933787251794133561816813446e21,
6524597Szliu 	-.1179157629107610536038440800e21,
6624597Szliu 	0.6382059341072356562289432465e19,
6724597Szliu 	-.1367620353088171386865416609e18,
6824597Szliu 	0.1434354939140344111664316553e16,
6924597Szliu 	-.8085222034853793871199468171e13,
7024597Szliu 	0.2507158285536881945555156435e11,
7124597Szliu 	-.4050412371833132706360663322e8,
7224597Szliu 	0.2685786856980014981415848441e5,
7324597Szliu };
74*35679Sbostic static const double q1[] = {
7524597Szliu 	0.4933787251794133562113278438e21,
7624597Szliu 	0.5428918384092285160200195092e19,
7724597Szliu 	0.3024635616709462698627330784e17,
7824597Szliu 	0.1127756739679798507056031594e15,
7924597Szliu 	0.3123043114941213172572469442e12,
8024597Szliu 	0.6699987672982239671814028660e9,
8124597Szliu 	0.1114636098462985378182402543e7,
8224597Szliu 	0.1363063652328970604442810507e4,
8324597Szliu 	1.0
8424597Szliu };
85*35679Sbostic static const double p2[] = {
8624597Szliu 	0.5393485083869438325262122897e7,
8724597Szliu 	0.1233238476817638145232406055e8,
8824597Szliu 	0.8413041456550439208464315611e7,
8924597Szliu 	0.2016135283049983642487182349e7,
9024597Szliu 	0.1539826532623911470917825993e6,
9124597Szliu 	0.2485271928957404011288128951e4,
9224597Szliu 	0.0,
9324597Szliu };
94*35679Sbostic static const double q2[] = {
9524597Szliu 	0.5393485083869438325560444960e7,
9624597Szliu 	0.1233831022786324960844856182e8,
9724597Szliu 	0.8426449050629797331554404810e7,
9824597Szliu 	0.2025066801570134013891035236e7,
9924597Szliu 	0.1560017276940030940592769933e6,
10024597Szliu 	0.2615700736920839685159081813e4,
10124597Szliu 	1.0,
10224597Szliu };
103*35679Sbostic static const double p3[] = {
10424597Szliu 	-.3984617357595222463506790588e4,
10524597Szliu 	-.1038141698748464093880530341e5,
10624597Szliu 	-.8239066313485606568803548860e4,
10724597Szliu 	-.2365956170779108192723612816e4,
10824597Szliu 	-.2262630641933704113967255053e3,
10924597Szliu 	-.4887199395841261531199129300e1,
11024597Szliu 	0.0,
11124597Szliu };
112*35679Sbostic static const double q3[] = {
11324597Szliu 	0.2550155108860942382983170882e6,
11424597Szliu 	0.6667454239319826986004038103e6,
11524597Szliu 	0.5332913634216897168722255057e6,
11624597Szliu 	0.1560213206679291652539287109e6,
11724597Szliu 	0.1570489191515395519392882766e5,
11824597Szliu 	0.4087714673983499223402830260e3,
11924597Szliu 	1.0,
12024597Szliu };
121*35679Sbostic static const double p4[] = {
12224597Szliu 	-.2750286678629109583701933175e20,
12324597Szliu 	0.6587473275719554925999402049e20,
12424597Szliu 	-.5247065581112764941297350814e19,
12524597Szliu 	0.1375624316399344078571335453e18,
12624597Szliu 	-.1648605817185729473122082537e16,
12724597Szliu 	0.1025520859686394284509167421e14,
12824597Szliu 	-.3436371222979040378171030138e11,
12924597Szliu 	0.5915213465686889654273830069e8,
13024597Szliu 	-.4137035497933148554125235152e5,
13124597Szliu };
132*35679Sbostic static const double q4[] = {
13324597Szliu 	0.3726458838986165881989980e21,
13424597Szliu 	0.4192417043410839973904769661e19,
13524597Szliu 	0.2392883043499781857439356652e17,
13624597Szliu 	0.9162038034075185262489147968e14,
13724597Szliu 	0.2613065755041081249568482092e12,
13824597Szliu 	0.5795122640700729537480087915e9,
13924597Szliu 	0.1001702641288906265666651753e7,
14024597Szliu 	0.1282452772478993804176329391e4,
14124597Szliu 	1.0,
14224597Szliu };
14324597Szliu 
144*35679Sbostic static void asympt();
145*35679Sbostic 
14624597Szliu double
14724597Szliu j0(arg) double arg;{
14824597Szliu 	double argsq, n, d;
14924597Szliu 	int i;
15024597Szliu 
15124597Szliu 	if(arg < 0.) arg = -arg;
15224597Szliu 	if(arg > 8.){
15324597Szliu 		asympt(arg);
15424597Szliu 		n = arg - pio4;
15524597Szliu 		return(sqrt(tpi/arg)*(pzero*cos(n) - qzero*sin(n)));
15624597Szliu 	}
15724597Szliu 	argsq = arg*arg;
15824597Szliu 	for(n=0,d=0,i=8;i>=0;i--){
15924597Szliu 		n = n*argsq + p1[i];
16024597Szliu 		d = d*argsq + q1[i];
16124597Szliu 	}
16224597Szliu 	return(n/d);
16324597Szliu }
16424597Szliu 
16524597Szliu double
16624597Szliu y0(arg) double arg;{
16724597Szliu 	double argsq, n, d;
16824597Szliu 	int i;
16924597Szliu 
17024597Szliu 	if(arg <= 0.){
17131853Szliu #if defined(vax)||defined(tahoe)
17224597Szliu 		return(infnan(EDOM));		/* NaN */
17331853Szliu #else	/* defined(vax)||defined(tahoe) */
17424597Szliu 		return(zero/zero);	/* IEEE machines: invalid operation */
17531853Szliu #endif	/* defined(vax)||defined(tahoe) */
17624597Szliu 	}
17724597Szliu 	if(arg > 8.){
17824597Szliu 		asympt(arg);
17924597Szliu 		n = arg - pio4;
18024597Szliu 		return(sqrt(tpi/arg)*(pzero*sin(n) + qzero*cos(n)));
18124597Szliu 	}
18224597Szliu 	argsq = arg*arg;
18324597Szliu 	for(n=0,d=0,i=8;i>=0;i--){
18424597Szliu 		n = n*argsq + p4[i];
18524597Szliu 		d = d*argsq + q4[i];
18624597Szliu 	}
18724597Szliu 	return(n/d + tpi*j0(arg)*log(arg));
18824597Szliu }
18924597Szliu 
190*35679Sbostic static void
19124597Szliu asympt(arg) double arg;{
19224597Szliu 	double zsq, n, d;
19324597Szliu 	int i;
19424597Szliu 	zsq = 64./(arg*arg);
19524597Szliu 	for(n=0,d=0,i=6;i>=0;i--){
19624597Szliu 		n = n*zsq + p2[i];
19724597Szliu 		d = d*zsq + q2[i];
19824597Szliu 	}
19924597Szliu 	pzero = n/d;
20024597Szliu 	for(n=0,d=0,i=6;i>=0;i--){
20124597Szliu 		n = n*zsq + p3[i];
20224597Szliu 		d = d*zsq + q3[i];
20324597Szliu 	}
20424597Szliu 	qzero = (8./arg)*(n/d);
20524597Szliu }
206