xref: /csrg-svn/lib/libm/common_source/j0.c (revision 34117)
1*34117Sbostic /*
2*34117Sbostic  * Copyright (c) 1985 Regents of the University of California.
3*34117Sbostic  * All rights reserved.  The Berkeley software License Agreement
4*34117Sbostic  * specifies the terms and conditions for redistribution.
5*34117Sbostic  */
6*34117Sbostic 
724597Szliu #ifndef lint
8*34117Sbostic static char sccsid[] = "@(#)j0.c	5.2 (Berkeley) 04/29/88";
9*34117Sbostic #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 
5124597Szliu #include <math.h>
5231853Szliu #if defined(vax)||defined(tahoe)
5324597Szliu #include <errno.h>
5431853Szliu #else	/* defined(vax)||defined(tahoe) */
5524597Szliu static double zero = 0.e0;
5631853Szliu #endif	/* defined(vax)||defined(tahoe) */
5724597Szliu static double pzero, qzero;
5824597Szliu static double tpi	= .6366197723675813430755350535e0;
5924597Szliu static double pio4	= .7853981633974483096156608458e0;
6024597Szliu static double p1[] = {
6124597Szliu 	0.4933787251794133561816813446e21,
6224597Szliu 	-.1179157629107610536038440800e21,
6324597Szliu 	0.6382059341072356562289432465e19,
6424597Szliu 	-.1367620353088171386865416609e18,
6524597Szliu 	0.1434354939140344111664316553e16,
6624597Szliu 	-.8085222034853793871199468171e13,
6724597Szliu 	0.2507158285536881945555156435e11,
6824597Szliu 	-.4050412371833132706360663322e8,
6924597Szliu 	0.2685786856980014981415848441e5,
7024597Szliu };
7124597Szliu static double q1[] = {
7224597Szliu 	0.4933787251794133562113278438e21,
7324597Szliu 	0.5428918384092285160200195092e19,
7424597Szliu 	0.3024635616709462698627330784e17,
7524597Szliu 	0.1127756739679798507056031594e15,
7624597Szliu 	0.3123043114941213172572469442e12,
7724597Szliu 	0.6699987672982239671814028660e9,
7824597Szliu 	0.1114636098462985378182402543e7,
7924597Szliu 	0.1363063652328970604442810507e4,
8024597Szliu 	1.0
8124597Szliu };
8224597Szliu static double p2[] = {
8324597Szliu 	0.5393485083869438325262122897e7,
8424597Szliu 	0.1233238476817638145232406055e8,
8524597Szliu 	0.8413041456550439208464315611e7,
8624597Szliu 	0.2016135283049983642487182349e7,
8724597Szliu 	0.1539826532623911470917825993e6,
8824597Szliu 	0.2485271928957404011288128951e4,
8924597Szliu 	0.0,
9024597Szliu };
9124597Szliu static double q2[] = {
9224597Szliu 	0.5393485083869438325560444960e7,
9324597Szliu 	0.1233831022786324960844856182e8,
9424597Szliu 	0.8426449050629797331554404810e7,
9524597Szliu 	0.2025066801570134013891035236e7,
9624597Szliu 	0.1560017276940030940592769933e6,
9724597Szliu 	0.2615700736920839685159081813e4,
9824597Szliu 	1.0,
9924597Szliu };
10024597Szliu static double p3[] = {
10124597Szliu 	-.3984617357595222463506790588e4,
10224597Szliu 	-.1038141698748464093880530341e5,
10324597Szliu 	-.8239066313485606568803548860e4,
10424597Szliu 	-.2365956170779108192723612816e4,
10524597Szliu 	-.2262630641933704113967255053e3,
10624597Szliu 	-.4887199395841261531199129300e1,
10724597Szliu 	0.0,
10824597Szliu };
10924597Szliu static double q3[] = {
11024597Szliu 	0.2550155108860942382983170882e6,
11124597Szliu 	0.6667454239319826986004038103e6,
11224597Szliu 	0.5332913634216897168722255057e6,
11324597Szliu 	0.1560213206679291652539287109e6,
11424597Szliu 	0.1570489191515395519392882766e5,
11524597Szliu 	0.4087714673983499223402830260e3,
11624597Szliu 	1.0,
11724597Szliu };
11824597Szliu static double p4[] = {
11924597Szliu 	-.2750286678629109583701933175e20,
12024597Szliu 	0.6587473275719554925999402049e20,
12124597Szliu 	-.5247065581112764941297350814e19,
12224597Szliu 	0.1375624316399344078571335453e18,
12324597Szliu 	-.1648605817185729473122082537e16,
12424597Szliu 	0.1025520859686394284509167421e14,
12524597Szliu 	-.3436371222979040378171030138e11,
12624597Szliu 	0.5915213465686889654273830069e8,
12724597Szliu 	-.4137035497933148554125235152e5,
12824597Szliu };
12924597Szliu static double q4[] = {
13024597Szliu 	0.3726458838986165881989980e21,
13124597Szliu 	0.4192417043410839973904769661e19,
13224597Szliu 	0.2392883043499781857439356652e17,
13324597Szliu 	0.9162038034075185262489147968e14,
13424597Szliu 	0.2613065755041081249568482092e12,
13524597Szliu 	0.5795122640700729537480087915e9,
13624597Szliu 	0.1001702641288906265666651753e7,
13724597Szliu 	0.1282452772478993804176329391e4,
13824597Szliu 	1.0,
13924597Szliu };
14024597Szliu 
14124597Szliu double
14224597Szliu j0(arg) double arg;{
14324597Szliu 	double argsq, n, d;
14424597Szliu 	double sin(), cos(), sqrt();
14524597Szliu 	int i;
14624597Szliu 
14724597Szliu 	if(arg < 0.) arg = -arg;
14824597Szliu 	if(arg > 8.){
14924597Szliu 		asympt(arg);
15024597Szliu 		n = arg - pio4;
15124597Szliu 		return(sqrt(tpi/arg)*(pzero*cos(n) - qzero*sin(n)));
15224597Szliu 	}
15324597Szliu 	argsq = arg*arg;
15424597Szliu 	for(n=0,d=0,i=8;i>=0;i--){
15524597Szliu 		n = n*argsq + p1[i];
15624597Szliu 		d = d*argsq + q1[i];
15724597Szliu 	}
15824597Szliu 	return(n/d);
15924597Szliu }
16024597Szliu 
16124597Szliu double
16224597Szliu y0(arg) double arg;{
16324597Szliu 	double argsq, n, d;
16424597Szliu 	double sin(), cos(), sqrt(), log(), j0();
16524597Szliu 	int i;
16624597Szliu 
16724597Szliu 	if(arg <= 0.){
16831853Szliu #if defined(vax)||defined(tahoe)
16924597Szliu 		extern double infnan();
17024597Szliu 		return(infnan(EDOM));		/* NaN */
17131853Szliu #else	/* defined(vax)||defined(tahoe) */
17224597Szliu 		return(zero/zero);	/* IEEE machines: invalid operation */
17331853Szliu #endif	/* defined(vax)||defined(tahoe) */
17424597Szliu 	}
17524597Szliu 	if(arg > 8.){
17624597Szliu 		asympt(arg);
17724597Szliu 		n = arg - pio4;
17824597Szliu 		return(sqrt(tpi/arg)*(pzero*sin(n) + qzero*cos(n)));
17924597Szliu 	}
18024597Szliu 	argsq = arg*arg;
18124597Szliu 	for(n=0,d=0,i=8;i>=0;i--){
18224597Szliu 		n = n*argsq + p4[i];
18324597Szliu 		d = d*argsq + q4[i];
18424597Szliu 	}
18524597Szliu 	return(n/d + tpi*j0(arg)*log(arg));
18624597Szliu }
18724597Szliu 
18824597Szliu static
18924597Szliu asympt(arg) double arg;{
19024597Szliu 	double zsq, n, d;
19124597Szliu 	int i;
19224597Szliu 	zsq = 64./(arg*arg);
19324597Szliu 	for(n=0,d=0,i=6;i>=0;i--){
19424597Szliu 		n = n*zsq + p2[i];
19524597Szliu 		d = d*zsq + q2[i];
19624597Szliu 	}
19724597Szliu 	pzero = n/d;
19824597Szliu 	for(n=0,d=0,i=6;i>=0;i--){
19924597Szliu 		n = n*zsq + p3[i];
20024597Szliu 		d = d*zsq + q3[i];
20124597Szliu 	}
20224597Szliu 	qzero = (8./arg)*(n/d);
20324597Szliu }
204