OLD | NEW |
1 /* origin: FreeBSD /usr/src/lib/msun/src/e_jn.c */ | 1 /* origin: FreeBSD /usr/src/lib/msun/src/e_jn.c */ |
2 /* | 2 /* |
3 * ==================================================== | 3 * ==================================================== |
4 * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. | 4 * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. |
5 * | 5 * |
6 * Developed at SunSoft, a Sun Microsystems, Inc. business. | 6 * Developed at SunSoft, a Sun Microsystems, Inc. business. |
7 * Permission to use, copy, modify, and distribute this | 7 * Permission to use, copy, modify, and distribute this |
8 * software is freely granted, provided that this notice | 8 * software is freely granted, provided that this notice |
9 * is preserved. | 9 * is preserved. |
10 * ==================================================== | 10 * ==================================================== |
(...skipping 18 matching lines...) Expand all Loading... |
29 * compared with the actual value to correct the | 29 * compared with the actual value to correct the |
30 * supposed value of j(n,x). | 30 * supposed value of j(n,x). |
31 * | 31 * |
32 * yn(n,x) is similar in all respects, except | 32 * yn(n,x) is similar in all respects, except |
33 * that forward recursion is used for all | 33 * that forward recursion is used for all |
34 * values of n>1. | 34 * values of n>1. |
35 */ | 35 */ |
36 | 36 |
37 #include "libm.h" | 37 #include "libm.h" |
38 | 38 |
39 static const double invsqrtpi = 5.64189583547756279280e-01; /* 0x3FE20DD7, 0x504
29B6D */ | 39 static const double invsqrtpi = |
40 | 40 5.64189583547756279280e-01; /* 0x3FE20DD7, 0x50429B6D */ |
41 double jn(int n, double x) | 41 |
42 { | 42 double jn(int n, double x) { |
43 » uint32_t ix, lx; | 43 uint32_t ix, lx; |
44 » int nm1, i, sign; | 44 int nm1, i, sign; |
45 » double a, b, temp; | 45 double a, b, temp; |
46 | 46 |
47 » EXTRACT_WORDS(ix, lx, x); | 47 EXTRACT_WORDS(ix, lx, x); |
48 » sign = ix>>31; | 48 sign = ix >> 31; |
49 » ix &= 0x7fffffff; | 49 ix &= 0x7fffffff; |
50 | 50 |
51 » if ((ix | (lx|-lx)>>31) > 0x7ff00000) /* nan */ | 51 if ((ix | (lx | -lx) >> 31) > 0x7ff00000) /* nan */ |
52 » » return x; | 52 return x; |
53 | 53 |
54 » /* J(-n,x) = (-1)^n * J(n, x), J(n, -x) = (-1)^n * J(n, x) | 54 /* J(-n,x) = (-1)^n * J(n, x), J(n, -x) = (-1)^n * J(n, x) |
55 » * Thus, J(-n,x) = J(n,-x) | 55 * Thus, J(-n,x) = J(n,-x) |
56 » */ | 56 */ |
57 » /* nm1 = |n|-1 is used instead of |n| to handle n==INT_MIN */ | 57 /* nm1 = |n|-1 is used instead of |n| to handle n==INT_MIN */ |
58 » if (n == 0) | 58 if (n == 0) |
59 » » return j0(x); | 59 return j0(x); |
60 » if (n < 0) { | 60 if (n < 0) { |
61 » » nm1 = -(n+1); | 61 nm1 = -(n + 1); |
62 » » x = -x; | 62 x = -x; |
63 » » sign ^= 1; | 63 sign ^= 1; |
64 » } else | 64 } else |
65 » » nm1 = n-1; | 65 nm1 = n - 1; |
66 » if (nm1 == 0) | 66 if (nm1 == 0) |
67 » » return j1(x); | 67 return j1(x); |
68 | 68 |
69 » sign &= n; /* even n: 0, odd n: signbit(x) */ | 69 sign &= n; /* even n: 0, odd n: signbit(x) */ |
70 » x = fabs(x); | 70 x = fabs(x); |
71 » if ((ix|lx) == 0 || ix == 0x7ff00000) /* if x is 0 or inf */ | 71 if ((ix | lx) == 0 || ix == 0x7ff00000) /* if x is 0 or inf */ |
72 » » b = 0.0; | 72 b = 0.0; |
73 » else if (nm1 < x) { | 73 else if (nm1 < x) { |
74 » » /* Safe to use J(n+1,x)=2n/x *J(n,x)-J(n-1,x) */ | 74 /* Safe to use J(n+1,x)=2n/x *J(n,x)-J(n-1,x) */ |
75 » » if (ix >= 0x52d00000) { /* x > 2**302 */ | 75 if (ix >= 0x52d00000) { /* x > 2**302 */ |
76 » » » /* (x >> n**2) | 76 /* (x >> n**2) |
77 » » » * Jn(x) = cos(x-(2n+1)*pi/4)*sqrt(2/x*pi) | 77 * Jn(x) = cos(x-(2n+1)*pi/4)*sqrt(2/x*pi) |
78 » » » * Yn(x) = sin(x-(2n+1)*pi/4)*sqrt(2/x*pi) | 78 * Yn(x) = sin(x-(2n+1)*pi/4)*sqrt(2/x*pi) |
79 » » » * Let s=sin(x), c=cos(x), | 79 * Let s=sin(x), c=cos(x), |
80 » » » * xn=x-(2n+1)*pi/4, sqt2 = sqrt(2),then | 80 * xn=x-(2n+1)*pi/4, sqt2 = sqrt(2),then |
81 » » » * | 81 * |
82 » » » * n sin(xn)*sqt2 cos(xn)*sqt2 | 82 * n sin(xn)*sqt2 cos(xn)*sqt2 |
83 » » » * ---------------------------------- | 83 * ---------------------------------- |
84 » » » * 0 s-c c+s | 84 * 0 s-c c+s |
85 » » » * 1 -s-c -c+s | 85 * 1 -s-c -c+s |
86 » » » * 2 -s+c -c-s | 86 * 2 -s+c -c-s |
87 » » » * 3 s+c c-s | 87 * 3 s+c c-s |
88 » » » */ | 88 */ |
89 » » » switch(nm1&3) { | 89 switch (nm1 & 3) { |
90 » » » case 0: temp = -cos(x)+sin(x); break; | 90 case 0: |
91 » » » case 1: temp = -cos(x)-sin(x); break; | 91 temp = -cos(x) + sin(x); |
92 » » » case 2: temp = cos(x)-sin(x); break; | 92 break; |
93 » » » default: | 93 case 1: |
94 » » » case 3: temp = cos(x)+sin(x); break; | 94 temp = -cos(x) - sin(x); |
95 » » » } | 95 break; |
96 » » » b = invsqrtpi*temp/sqrt(x); | 96 case 2: |
97 » » } else { | 97 temp = cos(x) - sin(x); |
98 » » » a = j0(x); | 98 break; |
99 » » » b = j1(x); | 99 default: |
100 » » » for (i=0; i<nm1; ) { | 100 case 3: |
101 » » » » i++; | 101 temp = cos(x) + sin(x); |
102 » » » » temp = b; | 102 break; |
103 » » » » b = b*(2.0*i/x) - a; /* avoid underflow */ | 103 } |
104 » » » » a = temp; | 104 b = invsqrtpi * temp / sqrt(x); |
105 » » » } | 105 } else { |
106 » » } | 106 a = j0(x); |
107 » } else { | 107 b = j1(x); |
108 » » if (ix < 0x3e100000) { /* x < 2**-29 */ | 108 for (i = 0; i < nm1;) { |
109 » » » /* x is tiny, return the first Taylor expansion of J(n,x
) | 109 i++; |
110 » » » * J(n,x) = 1/n!*(x/2)^n - ... | 110 temp = b; |
111 » » » */ | 111 b = b * (2.0 * i / x) - a; /* avoid underflow */ |
112 » » » if (nm1 > 32) /* underflow */ | 112 a = temp; |
113 » » » » b = 0.0; | 113 } |
114 » » » else { | 114 } |
115 » » » » temp = x*0.5; | 115 } else { |
116 » » » » b = temp; | 116 if (ix < 0x3e100000) { /* x < 2**-29 */ |
117 » » » » a = 1.0; | 117 /* x is tiny, return the first Taylor expansion of J(n,x) |
118 » » » » for (i=2; i<=nm1+1; i++) { | 118 * J(n,x) = 1/n!*(x/2)^n - ... |
119 » » » » » a *= (double)i; /* a = n! */ | 119 */ |
120 » » » » » b *= temp; /* b = (x/2)^n */ | 120 if (nm1 > 32) /* underflow */ |
121 » » » » } | 121 b = 0.0; |
122 » » » » b = b/a; | 122 else { |
123 » » » } | 123 temp = x * 0.5; |
124 » » } else { | 124 b = temp; |
125 » » » /* use backward recurrence */ | 125 a = 1.0; |
126 » » » /* x x^2 x^2 | 126 for (i = 2; i <= nm1 + 1; i++) { |
127 » » » * J(n,x)/J(n-1,x) = ---- ------ ------ ..... | 127 a *= (double)i; /* a = n! */ |
128 » » » * 2n - 2(n+1) - 2(n+2) | 128 b *= temp; /* b = (x/2)^n */ |
129 » » » * | 129 } |
130 » » » * 1 1 1 | 130 b = b / a; |
131 » » » * (for large x) = ---- ------ ------ ..... | 131 } |
132 » » » * 2n 2(n+1) 2(n+2) | 132 } else { |
133 » » » * -- - ------ - ------ - | 133 /* use backward recurrence */ |
134 » » » * x x x | 134 /* x x^2 x^2 |
135 » » » * | 135 * J(n,x)/J(n-1,x) = ---- ------ ------ ..... |
136 » » » * Let w = 2n/x and h=2/x, then the above quotient | 136 * 2n - 2(n+1) - 2(n+2) |
137 » » » * is equal to the continued fraction: | 137 * |
138 » » » * 1 | 138 * 1 1 1 |
139 » » » * = ----------------------- | 139 * (for large x) = ---- ------ ------ ..... |
140 » » » * 1 | 140 * 2n 2(n+1) 2(n+2) |
141 » » » * w - ----------------- | 141 * -- - ------ - ------ - |
142 » » » * 1 | 142 * x x x |
143 » » » * w+h - --------- | 143 * |
144 » » » * w+2h - ... | 144 * Let w = 2n/x and h=2/x, then the above quotient |
145 » » » * | 145 * is equal to the continued fraction: |
146 » » » * To determine how many terms needed, let | 146 * 1 |
147 » » » * Q(0) = w, Q(1) = w(w+h) - 1, | 147 * = ----------------------- |
148 » » » * Q(k) = (w+k*h)*Q(k-1) - Q(k-2), | 148 * 1 |
149 » » » * When Q(k) > 1e4 good for single | 149 * w - ----------------- |
150 » » » * When Q(k) > 1e9 good for double | 150 * 1 |
151 » » » * When Q(k) > 1e17 good for quadruple | 151 * w+h - --------- |
152 » » » */ | 152 * w+2h - ... |
153 » » » /* determine k */ | 153 * |
154 » » » double t,q0,q1,w,h,z,tmp,nf; | 154 * To determine how many terms needed, let |
155 » » » int k; | 155 * Q(0) = w, Q(1) = w(w+h) - 1, |
156 | 156 * Q(k) = (w+k*h)*Q(k-1) - Q(k-2), |
157 » » » nf = nm1 + 1.0; | 157 * When Q(k) > 1e4 good for single |
158 » » » w = 2*nf/x; | 158 * When Q(k) > 1e9 good for double |
159 » » » h = 2/x; | 159 * When Q(k) > 1e17 good for quadruple |
160 » » » z = w+h; | 160 */ |
161 » » » q0 = w; | 161 /* determine k */ |
162 » » » q1 = w*z - 1.0; | 162 double t, q0, q1, w, h, z, tmp, nf; |
163 » » » k = 1; | 163 int k; |
164 » » » while (q1 < 1.0e9) { | 164 |
165 » » » » k += 1; | 165 nf = nm1 + 1.0; |
166 » » » » z += h; | 166 w = 2 * nf / x; |
167 » » » » tmp = z*q1 - q0; | 167 h = 2 / x; |
168 » » » » q0 = q1; | 168 z = w + h; |
169 » » » » q1 = tmp; | 169 q0 = w; |
170 » » » } | 170 q1 = w * z - 1.0; |
171 » » » for (t=0.0, i=k; i>=0; i--) | 171 k = 1; |
172 » » » » t = 1/(2*(i+nf)/x - t); | 172 while (q1 < 1.0e9) { |
173 » » » a = t; | 173 k += 1; |
174 » » » b = 1.0; | 174 z += h; |
175 » » » /* estimate log((2/x)^n*n!) = n*log(2/x)+n*ln(n) | 175 tmp = z * q1 - q0; |
176 » » » * Hence, if n*(log(2n/x)) > ... | 176 q0 = q1; |
177 » » » * single 8.8722839355e+01 | 177 q1 = tmp; |
178 » » » * double 7.09782712893383973096e+02 | 178 } |
179 » » » * long double 1.13565234062941439494919310779707650061
70e+04 | 179 for (t = 0.0, i = k; i >= 0; i--) |
180 » » » * then recurrent value may overflow and the result is | 180 t = 1 / (2 * (i + nf) / x - t); |
181 » » » * likely underflow to zero | 181 a = t; |
182 » » » */ | 182 b = 1.0; |
183 » » » tmp = nf*log(fabs(w)); | 183 /* estimate log((2/x)^n*n!) = n*log(2/x)+n*ln(n) |
184 » » » if (tmp < 7.09782712893383973096e+02) { | 184 * Hence, if n*(log(2n/x)) > ... |
185 » » » » for (i=nm1; i>0; i--) { | 185 * single 8.8722839355e+01 |
186 » » » » » temp = b; | 186 * double 7.09782712893383973096e+02 |
187 » » » » » b = b*(2.0*i)/x - a; | 187 * long double 1.1356523406294143949491931077970765006170e+04 |
188 » » » » » a = temp; | 188 * then recurrent value may overflow and the result is |
189 » » » » } | 189 * likely underflow to zero |
190 » » » } else { | 190 */ |
191 » » » » for (i=nm1; i>0; i--) { | 191 tmp = nf * log(fabs(w)); |
192 » » » » » temp = b; | 192 if (tmp < 7.09782712893383973096e+02) { |
193 » » » » » b = b*(2.0*i)/x - a; | 193 for (i = nm1; i > 0; i--) { |
194 » » » » » a = temp; | 194 temp = b; |
195 » » » » » /* scale b to avoid spurious overflow */ | 195 b = b * (2.0 * i) / x - a; |
196 » » » » » if (b > 0x1p500) { | 196 a = temp; |
197 » » » » » » a /= b; | 197 } |
198 » » » » » » t /= b; | 198 } else { |
199 » » » » » » b = 1.0; | 199 for (i = nm1; i > 0; i--) { |
200 » » » » » } | 200 temp = b; |
201 » » » » } | 201 b = b * (2.0 * i) / x - a; |
202 » » » } | 202 a = temp; |
203 » » » z = j0(x); | 203 /* scale b to avoid spurious overflow */ |
204 » » » w = j1(x); | 204 if (b > 0x1p500) { |
205 » » » if (fabs(z) >= fabs(w)) | 205 a /= b; |
206 » » » » b = t*z/b; | 206 t /= b; |
207 » » » else | 207 b = 1.0; |
208 » » » » b = t*w/a; | 208 } |
209 » » } | 209 } |
210 » } | 210 } |
211 » return sign ? -b : b; | 211 z = j0(x); |
| 212 w = j1(x); |
| 213 if (fabs(z) >= fabs(w)) |
| 214 b = t * z / b; |
| 215 else |
| 216 b = t * w / a; |
| 217 } |
| 218 } |
| 219 return sign ? -b : b; |
212 } | 220 } |
213 | 221 |
214 | 222 double yn(int n, double x) { |
215 double yn(int n, double x) | 223 uint32_t ix, lx, ib; |
216 { | 224 int nm1, sign, i; |
217 » uint32_t ix, lx, ib; | 225 double a, b, temp; |
218 » int nm1, sign, i; | 226 |
219 » double a, b, temp; | 227 EXTRACT_WORDS(ix, lx, x); |
220 | 228 sign = ix >> 31; |
221 » EXTRACT_WORDS(ix, lx, x); | 229 ix &= 0x7fffffff; |
222 » sign = ix>>31; | 230 |
223 » ix &= 0x7fffffff; | 231 if ((ix | (lx | -lx) >> 31) > 0x7ff00000) /* nan */ |
224 | 232 return x; |
225 » if ((ix | (lx|-lx)>>31) > 0x7ff00000) /* nan */ | 233 if (sign && (ix | lx) != 0) /* x < 0 */ |
226 » » return x; | 234 return 0 / 0.0; |
227 » if (sign && (ix|lx)!=0) /* x < 0 */ | 235 if (ix == 0x7ff00000) |
228 » » return 0/0.0; | 236 return 0.0; |
229 » if (ix == 0x7ff00000) | 237 |
230 » » return 0.0; | 238 if (n == 0) |
231 | 239 return y0(x); |
232 » if (n == 0) | 240 if (n < 0) { |
233 » » return y0(x); | 241 nm1 = -(n + 1); |
234 » if (n < 0) { | 242 sign = n & 1; |
235 » » nm1 = -(n+1); | 243 } else { |
236 » » sign = n&1; | 244 nm1 = n - 1; |
237 » } else { | 245 sign = 0; |
238 » » nm1 = n-1; | 246 } |
239 » » sign = 0; | 247 if (nm1 == 0) |
240 » } | 248 return sign ? -y1(x) : y1(x); |
241 » if (nm1 == 0) | 249 |
242 » » return sign ? -y1(x) : y1(x); | 250 if (ix >= 0x52d00000) { /* x > 2**302 */ |
243 | 251 /* (x >> n**2) |
244 » if (ix >= 0x52d00000) { /* x > 2**302 */ | 252 * Jn(x) = cos(x-(2n+1)*pi/4)*sqrt(2/x*pi) |
245 » » /* (x >> n**2) | 253 * Yn(x) = sin(x-(2n+1)*pi/4)*sqrt(2/x*pi) |
246 » » * Jn(x) = cos(x-(2n+1)*pi/4)*sqrt(2/x*pi) | 254 * Let s=sin(x), c=cos(x), |
247 » » * Yn(x) = sin(x-(2n+1)*pi/4)*sqrt(2/x*pi) | 255 * xn=x-(2n+1)*pi/4, sqt2 = sqrt(2),then |
248 » » * Let s=sin(x), c=cos(x), | 256 * |
249 » » * xn=x-(2n+1)*pi/4, sqt2 = sqrt(2),then | 257 * n sin(xn)*sqt2 cos(xn)*sqt2 |
250 » » * | 258 * ---------------------------------- |
251 » » * n sin(xn)*sqt2 cos(xn)*sqt2 | 259 * 0 s-c c+s |
252 » » * ---------------------------------- | 260 * 1 -s-c -c+s |
253 » » * 0 s-c c+s | 261 * 2 -s+c -c-s |
254 » » * 1 -s-c -c+s | 262 * 3 s+c c-s |
255 » » * 2 -s+c -c-s | 263 */ |
256 » » * 3 s+c c-s | 264 switch (nm1 & 3) { |
257 » » */ | 265 case 0: |
258 » » switch(nm1&3) { | 266 temp = -sin(x) - cos(x); |
259 » » case 0: temp = -sin(x)-cos(x); break; | 267 break; |
260 » » case 1: temp = -sin(x)+cos(x); break; | 268 case 1: |
261 » » case 2: temp = sin(x)+cos(x); break; | 269 temp = -sin(x) + cos(x); |
262 » » default: | 270 break; |
263 » » case 3: temp = sin(x)-cos(x); break; | 271 case 2: |
264 » » } | 272 temp = sin(x) + cos(x); |
265 » » b = invsqrtpi*temp/sqrt(x); | 273 break; |
266 » } else { | 274 default: |
267 » » a = y0(x); | 275 case 3: |
268 » » b = y1(x); | 276 temp = sin(x) - cos(x); |
269 » » /* quit if b is -inf */ | 277 break; |
270 » » GET_HIGH_WORD(ib, b); | 278 } |
271 » » for (i=0; i<nm1 && ib!=0xfff00000; ){ | 279 b = invsqrtpi * temp / sqrt(x); |
272 » » » i++; | 280 } else { |
273 » » » temp = b; | 281 a = y0(x); |
274 » » » b = (2.0*i/x)*b - a; | 282 b = y1(x); |
275 » » » GET_HIGH_WORD(ib, b); | 283 /* quit if b is -inf */ |
276 » » » a = temp; | 284 GET_HIGH_WORD(ib, b); |
277 » » } | 285 for (i = 0; i < nm1 && ib != 0xfff00000;) { |
278 » } | 286 i++; |
279 » return sign ? -b : b; | 287 temp = b; |
| 288 b = (2.0 * i / x) * b - a; |
| 289 GET_HIGH_WORD(ib, b); |
| 290 a = temp; |
| 291 } |
| 292 } |
| 293 return sign ? -b : b; |
280 } | 294 } |
OLD | NEW |