xref: /original-bsd/lib/libm/common_source/j1.c (revision 4b8a1382)
1 /*-
2  * Copyright (c) 1985 The Regents of the University of California.
3  * All rights reserved.
4  *
5  * %sccs.include.proprietary.c%
6  */
7 
8 #ifndef lint
9 static char sccsid[] = "@(#)j1.c	5.4 (Berkeley) 04/20/91";
10 #endif /* not lint */
11 
12 /*
13 	floating point Bessel's function
14 	of the first and second kinds
15 	of order one
16 
17 	j1(x) returns the value of J1(x)
18 	for all real values of x.
19 
20 	There are no error returns.
21 	Calls sin, cos, sqrt.
22 
23 	There is a niggling bug in J1 which
24 	causes errors up to 2e-16 for x in the
25 	interval [-8,8].
26 	The bug is caused by an inappropriate order
27 	of summation of the series.  rhm will fix it
28 	someday.
29 
30 	Coefficients are from Hart & Cheney.
31 	#6050 (20.98D)
32 	#6750 (19.19D)
33 	#7150 (19.35D)
34 
35 	y1(x) returns the value of Y1(x)
36 	for positive real values of x.
37 	For x<=0, if on the VAX, error number EDOM is set and
38 	the reserved operand fault is generated;
39 	otherwise (an IEEE machine) an invalid operation is performed.
40 
41 	Calls sin, cos, sqrt, log, j1.
42 
43 	The values of Y1 have not been checked
44 	to more than ten places.
45 
46 	Coefficients are from Hart & Cheney.
47 	#6447 (22.18D)
48 	#6750 (19.19D)
49 	#7150 (19.35D)
50 */
51 
52 #include "mathimpl.h"
53 
54 #if defined(vax)||defined(tahoe)
55 #include <errno.h>
56 #else	/* defined(vax)||defined(tahoe) */
57 static const double zero = 0.e0;
58 #endif	/* defined(vax)||defined(tahoe) */
59 
60 static double pzero, qzero;
61 
62 static const double tpi	= .6366197723675813430755350535e0;
63 static const double pio4	= .7853981633974483096156608458e0;
64 static const double p1[] = {
65 	0.581199354001606143928050809e21,
66 	-.6672106568924916298020941484e20,
67 	0.2316433580634002297931815435e19,
68 	-.3588817569910106050743641413e17,
69 	0.2908795263834775409737601689e15,
70 	-.1322983480332126453125473247e13,
71 	0.3413234182301700539091292655e10,
72 	-.4695753530642995859767162166e7,
73 	0.2701122710892323414856790990e4,
74 };
75 static const double q1[] = {
76 	0.1162398708003212287858529400e22,
77 	0.1185770712190320999837113348e20,
78 	0.6092061398917521746105196863e17,
79 	0.2081661221307607351240184229e15,
80 	0.5243710262167649715406728642e12,
81 	0.1013863514358673989967045588e10,
82 	0.1501793594998585505921097578e7,
83 	0.1606931573481487801970916749e4,
84 	1.0,
85 };
86 static const double p2[] = {
87 	-.4435757816794127857114720794e7,
88 	-.9942246505077641195658377899e7,
89 	-.6603373248364939109255245434e7,
90 	-.1523529351181137383255105722e7,
91 	-.1098240554345934672737413139e6,
92 	-.1611616644324610116477412898e4,
93 	0.0,
94 };
95 static const double q2[] = {
96 	-.4435757816794127856828016962e7,
97 	-.9934124389934585658967556309e7,
98 	-.6585339479723087072826915069e7,
99 	-.1511809506634160881644546358e7,
100 	-.1072638599110382011903063867e6,
101 	-.1455009440190496182453565068e4,
102 	1.0,
103 };
104 static const double p3[] = {
105 	0.3322091340985722351859704442e5,
106 	0.8514516067533570196555001171e5,
107 	0.6617883658127083517939992166e5,
108 	0.1849426287322386679652009819e5,
109 	0.1706375429020768002061283546e4,
110 	0.3526513384663603218592175580e2,
111 	0.0,
112 };
113 static const double q3[] = {
114 	0.7087128194102874357377502472e6,
115 	0.1819458042243997298924553839e7,
116 	0.1419460669603720892855755253e7,
117 	0.4002944358226697511708610813e6,
118 	0.3789022974577220264142952256e5,
119 	0.8638367769604990967475517183e3,
120 	1.0,
121 };
122 static const double p4[] = {
123 	-.9963753424306922225996744354e23,
124 	0.2655473831434854326894248968e23,
125 	-.1212297555414509577913561535e22,
126 	0.2193107339917797592111427556e20,
127 	-.1965887462722140658820322248e18,
128 	0.9569930239921683481121552788e15,
129 	-.2580681702194450950541426399e13,
130 	0.3639488548124002058278999428e10,
131 	-.2108847540133123652824139923e7,
132 	0.0,
133 };
134 static const double q4[] = {
135 	0.5082067366941243245314424152e24,
136 	0.5435310377188854170800653097e22,
137 	0.2954987935897148674290758119e20,
138 	0.1082258259408819552553850180e18,
139 	0.2976632125647276729292742282e15,
140 	0.6465340881265275571961681500e12,
141 	0.1128686837169442121732366891e10,
142 	0.1563282754899580604737366452e7,
143 	0.1612361029677000859332072312e4,
144 	1.0,
145 };
146 
147 static void asympt();
148 
149 double
150 j1(arg) double arg;{
151 	double xsq, n, d, x;
152 	int i;
153 
154 	x = arg;
155 	if(x < 0.) x = -x;
156 	if(x > 8.){
157 		asympt(x);
158 		n = x - 3.*pio4;
159 		n = sqrt(tpi/x)*(pzero*cos(n) - qzero*sin(n));
160 		if(arg <0.) n = -n;
161 		return(n);
162 	}
163 	xsq = x*x;
164 	for(n=0,d=0,i=8;i>=0;i--){
165 		n = n*xsq + p1[i];
166 		d = d*xsq + q1[i];
167 	}
168 	return(arg*n/d);
169 }
170 
171 double
172 y1(arg) double arg;{
173 	double xsq, n, d, x;
174 	int i;
175 
176 	x = arg;
177 	if(x <= 0.){
178 #if defined(vax)||defined(tahoe)
179 		return(infnan(EDOM));		/* NaN */
180 #else	/* defined(vax)||defined(tahoe) */
181 		return(zero/zero);	/* IEEE machines: invalid operation */
182 #endif	/* defined(vax)||defined(tahoe) */
183 	}
184 	if(x > 8.){
185 		asympt(x);
186 		n = x - 3*pio4;
187 		return(sqrt(tpi/x)*(pzero*sin(n) + qzero*cos(n)));
188 	}
189 	xsq = x*x;
190 	for(n=0,d=0,i=9;i>=0;i--){
191 		n = n*xsq + p4[i];
192 		d = d*xsq + q4[i];
193 	}
194 	return(x*n/d + tpi*(j1(x)*log(x)-1./x));
195 }
196 
197 static void
198 asympt(arg) double arg;{
199 	double zsq, n, d;
200 	int i;
201 	zsq = 64./(arg*arg);
202 	for(n=0,d=0,i=6;i>=0;i--){
203 		n = n*zsq + p2[i];
204 		d = d*zsq + q2[i];
205 	}
206 	pzero = n/d;
207 	for(n=0,d=0,i=6;i>=0;i--){
208 		n = n*zsq + p3[i];
209 		d = d*zsq + q3[i];
210 	}
211 	qzero = (8./arg)*(n/d);
212 }
213