xref: /csrg-svn/lib/libm/common_source/j0.c (revision 48402)
1*48402Sbostic /*-
2*48402Sbostic  * Copyright (c) 1985 The Regents of the University of California.
3*48402Sbostic  * All rights reserved.
4*48402Sbostic  *
5*48402Sbostic  * %sccs.include.proprietary.c%
634117Sbostic  */
734117Sbostic 
824597Szliu #ifndef lint
9*48402Sbostic static char sccsid[] = "@(#)j0.c	5.4 (Berkeley) 04/20/91";
1034117Sbostic #endif /* not lint */
1124597Szliu 
1224597Szliu /*
1324597Szliu 	floating point Bessel's function
1424597Szliu 	of the first and second kinds
1524597Szliu 	of order zero
1624597Szliu 
1724597Szliu 	j0(x) returns the value of J0(x)
1824597Szliu 	for all real values of x.
1924597Szliu 
2024597Szliu 	There are no error returns.
2124597Szliu 	Calls sin, cos, sqrt.
2224597Szliu 
2324597Szliu 	There is a niggling bug in J0 which
2424597Szliu 	causes errors up to 2e-16 for x in the
2524597Szliu 	interval [-8,8].
2624597Szliu 	The bug is caused by an inappropriate order
2724597Szliu 	of summation of the series.  rhm will fix it
2824597Szliu 	someday.
2924597Szliu 
3024597Szliu 	Coefficients are from Hart & Cheney.
3124597Szliu 	#5849 (19.22D)
3224597Szliu 	#6549 (19.25D)
3324597Szliu 	#6949 (19.41D)
3424597Szliu 
3524597Szliu 	y0(x) returns the value of Y0(x)
3624597Szliu 	for positive real values of x.
3724597Szliu 	For x<=0, if on the VAX, error number EDOM is set and
3824597Szliu 	the reserved operand fault is generated;
3924597Szliu 	otherwise (an IEEE machine) an invalid operation is performed.
4024597Szliu 
4124597Szliu 	Calls sin, cos, sqrt, log, j0.
4224597Szliu 
4324597Szliu 	The values of Y0 have not been checked
4424597Szliu 	to more than ten places.
4524597Szliu 
4624597Szliu 	Coefficients are from Hart & Cheney.
4724597Szliu 	#6245 (18.78D)
4824597Szliu 	#6549 (19.25D)
4924597Szliu 	#6949 (19.41D)
5024597Szliu */
5124597Szliu 
5235679Sbostic #include "mathimpl.h"
5335679Sbostic 
5431853Szliu #if defined(vax)||defined(tahoe)
5524597Szliu #include <errno.h>
5631853Szliu #else	/* defined(vax)||defined(tahoe) */
5735679Sbostic static const double zero = 0.e0;
5831853Szliu #endif	/* defined(vax)||defined(tahoe) */
5935679Sbostic 
6024597Szliu static double pzero, qzero;
6135679Sbostic 
6235679Sbostic static const double tpi	= .6366197723675813430755350535e0;
6335679Sbostic static const double pio4	= .7853981633974483096156608458e0;
6435679Sbostic static const double p1[] = {
6524597Szliu 	0.4933787251794133561816813446e21,
6624597Szliu 	-.1179157629107610536038440800e21,
6724597Szliu 	0.6382059341072356562289432465e19,
6824597Szliu 	-.1367620353088171386865416609e18,
6924597Szliu 	0.1434354939140344111664316553e16,
7024597Szliu 	-.8085222034853793871199468171e13,
7124597Szliu 	0.2507158285536881945555156435e11,
7224597Szliu 	-.4050412371833132706360663322e8,
7324597Szliu 	0.2685786856980014981415848441e5,
7424597Szliu };
7535679Sbostic static const double q1[] = {
7624597Szliu 	0.4933787251794133562113278438e21,
7724597Szliu 	0.5428918384092285160200195092e19,
7824597Szliu 	0.3024635616709462698627330784e17,
7924597Szliu 	0.1127756739679798507056031594e15,
8024597Szliu 	0.3123043114941213172572469442e12,
8124597Szliu 	0.6699987672982239671814028660e9,
8224597Szliu 	0.1114636098462985378182402543e7,
8324597Szliu 	0.1363063652328970604442810507e4,
8424597Szliu 	1.0
8524597Szliu };
8635679Sbostic static const double p2[] = {
8724597Szliu 	0.5393485083869438325262122897e7,
8824597Szliu 	0.1233238476817638145232406055e8,
8924597Szliu 	0.8413041456550439208464315611e7,
9024597Szliu 	0.2016135283049983642487182349e7,
9124597Szliu 	0.1539826532623911470917825993e6,
9224597Szliu 	0.2485271928957404011288128951e4,
9324597Szliu 	0.0,
9424597Szliu };
9535679Sbostic static const double q2[] = {
9624597Szliu 	0.5393485083869438325560444960e7,
9724597Szliu 	0.1233831022786324960844856182e8,
9824597Szliu 	0.8426449050629797331554404810e7,
9924597Szliu 	0.2025066801570134013891035236e7,
10024597Szliu 	0.1560017276940030940592769933e6,
10124597Szliu 	0.2615700736920839685159081813e4,
10224597Szliu 	1.0,
10324597Szliu };
10435679Sbostic static const double p3[] = {
10524597Szliu 	-.3984617357595222463506790588e4,
10624597Szliu 	-.1038141698748464093880530341e5,
10724597Szliu 	-.8239066313485606568803548860e4,
10824597Szliu 	-.2365956170779108192723612816e4,
10924597Szliu 	-.2262630641933704113967255053e3,
11024597Szliu 	-.4887199395841261531199129300e1,
11124597Szliu 	0.0,
11224597Szliu };
11335679Sbostic static const double q3[] = {
11424597Szliu 	0.2550155108860942382983170882e6,
11524597Szliu 	0.6667454239319826986004038103e6,
11624597Szliu 	0.5332913634216897168722255057e6,
11724597Szliu 	0.1560213206679291652539287109e6,
11824597Szliu 	0.1570489191515395519392882766e5,
11924597Szliu 	0.4087714673983499223402830260e3,
12024597Szliu 	1.0,
12124597Szliu };
12235679Sbostic static const double p4[] = {
12324597Szliu 	-.2750286678629109583701933175e20,
12424597Szliu 	0.6587473275719554925999402049e20,
12524597Szliu 	-.5247065581112764941297350814e19,
12624597Szliu 	0.1375624316399344078571335453e18,
12724597Szliu 	-.1648605817185729473122082537e16,
12824597Szliu 	0.1025520859686394284509167421e14,
12924597Szliu 	-.3436371222979040378171030138e11,
13024597Szliu 	0.5915213465686889654273830069e8,
13124597Szliu 	-.4137035497933148554125235152e5,
13224597Szliu };
13335679Sbostic static const double q4[] = {
13424597Szliu 	0.3726458838986165881989980e21,
13524597Szliu 	0.4192417043410839973904769661e19,
13624597Szliu 	0.2392883043499781857439356652e17,
13724597Szliu 	0.9162038034075185262489147968e14,
13824597Szliu 	0.2613065755041081249568482092e12,
13924597Szliu 	0.5795122640700729537480087915e9,
14024597Szliu 	0.1001702641288906265666651753e7,
14124597Szliu 	0.1282452772478993804176329391e4,
14224597Szliu 	1.0,
14324597Szliu };
14424597Szliu 
14535679Sbostic static void asympt();
14635679Sbostic 
14724597Szliu double
14824597Szliu j0(arg) double arg;{
14924597Szliu 	double argsq, n, d;
15024597Szliu 	int i;
15124597Szliu 
15224597Szliu 	if(arg < 0.) arg = -arg;
15324597Szliu 	if(arg > 8.){
15424597Szliu 		asympt(arg);
15524597Szliu 		n = arg - pio4;
15624597Szliu 		return(sqrt(tpi/arg)*(pzero*cos(n) - qzero*sin(n)));
15724597Szliu 	}
15824597Szliu 	argsq = arg*arg;
15924597Szliu 	for(n=0,d=0,i=8;i>=0;i--){
16024597Szliu 		n = n*argsq + p1[i];
16124597Szliu 		d = d*argsq + q1[i];
16224597Szliu 	}
16324597Szliu 	return(n/d);
16424597Szliu }
16524597Szliu 
16624597Szliu double
16724597Szliu y0(arg) double arg;{
16824597Szliu 	double argsq, n, d;
16924597Szliu 	int i;
17024597Szliu 
17124597Szliu 	if(arg <= 0.){
17231853Szliu #if defined(vax)||defined(tahoe)
17324597Szliu 		return(infnan(EDOM));		/* NaN */
17431853Szliu #else	/* defined(vax)||defined(tahoe) */
17524597Szliu 		return(zero/zero);	/* IEEE machines: invalid operation */
17631853Szliu #endif	/* defined(vax)||defined(tahoe) */
17724597Szliu 	}
17824597Szliu 	if(arg > 8.){
17924597Szliu 		asympt(arg);
18024597Szliu 		n = arg - pio4;
18124597Szliu 		return(sqrt(tpi/arg)*(pzero*sin(n) + qzero*cos(n)));
18224597Szliu 	}
18324597Szliu 	argsq = arg*arg;
18424597Szliu 	for(n=0,d=0,i=8;i>=0;i--){
18524597Szliu 		n = n*argsq + p4[i];
18624597Szliu 		d = d*argsq + q4[i];
18724597Szliu 	}
18824597Szliu 	return(n/d + tpi*j0(arg)*log(arg));
18924597Szliu }
19024597Szliu 
19135679Sbostic static void
19224597Szliu asympt(arg) double arg;{
19324597Szliu 	double zsq, n, d;
19424597Szliu 	int i;
19524597Szliu 	zsq = 64./(arg*arg);
19624597Szliu 	for(n=0,d=0,i=6;i>=0;i--){
19724597Szliu 		n = n*zsq + p2[i];
19824597Szliu 		d = d*zsq + q2[i];
19924597Szliu 	}
20024597Szliu 	pzero = n/d;
20124597Szliu 	for(n=0,d=0,i=6;i>=0;i--){
20224597Szliu 		n = n*zsq + p3[i];
20324597Szliu 		d = d*zsq + q3[i];
20424597Szliu 	}
20524597Szliu 	qzero = (8./arg)*(n/d);
20624597Szliu }
207