| 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 |