Qucs-core
0.0.19
|
00001 /* 00002 * cbesselj.cpp - Bessel function of first kind 00003 * 00004 * Copyright (C) 2007 Bastien Roucaries <roucaries.bastien@gmail.com> 00005 * 00006 * This is free software; you can redistribute it and/or modify 00007 * it under the terms of the GNU General Public License as published by 00008 * the Free Software Foundation; either version 2, or (at your option) 00009 * any later version. 00010 * 00011 * This software is distributed in the hope that it will be useful, 00012 * but WITHOUT ANY WARRANTY; without even the implied warranty of 00013 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 00014 * GNU General Public License for more details. 00015 * 00016 * You should have received a copy of the GNU General Public License 00017 * along with this package; see the file COPYING. If not, write to 00018 * the Free Software Foundation, Inc., 51 Franklin Street - Fifth Floor, 00019 * Boston, MA 02110-1301, USA. 00020 * 00021 * $Id$ 00022 * 00023 */ 00024 00061 //#if HAVE_CONFIG_H 00062 //# include <config.h> 00063 //#endif 00064 // 00065 //#include <cmath> 00066 //#include <assert.h> 00067 //#include <errno.h> 00068 //#include <stdio.h> 00069 //#include <stdlib.h> 00070 // 00071 //#include "real.h" 00072 //#include "complex.h" 00073 //#include "constants.h" 00074 //#include "precision.h" 00075 //#include <limits> 00076 00077 #define SMALL_J0_BOUND 1e6 00078 00080 #define SMALL_JN_BOUND 5.0 00081 00083 #define BIG_JN_BOUND 25.0 00084 00086 #define MAX_SMALL_ITERATION 2048 00087 00088 00106 static nr_complex_t 00107 cbesselj_smallarg (unsigned int n, nr_complex_t z) 00108 { 00109 nr_complex_t ak, Rk; 00110 nr_complex_t R; 00111 nr_complex_t R0; 00112 unsigned int k; 00113 00114 /* a_0 */ 00115 errno = 0; 00116 ak = pow (0.5 * z, n); 00117 /* underflow */ 00118 if (errno == ERANGE) 00119 { 00120 return n > 0 ? 0.0 : 1; 00121 } 00122 00123 ak = ak / (nr_double_t) qucs::factorial (n); 00124 00125 /* R_0 */ 00126 R0 = ak * 1.0; 00127 Rk = R0; 00128 R = R0; 00129 00130 for (k = 1; k < MAX_SMALL_ITERATION; k++) 00131 { 00132 ak = -(z * z) / (4.0 * k * (n + k)); 00133 Rk = ak * Rk; 00134 if (fabs (real (Rk)) < fabs (real (R) * std::numeric_limits<nr_double_t>::epsilon()) && 00135 fabs (imag (Rk)) < fabs (imag (R) * std::numeric_limits<nr_double_t>::epsilon())) 00136 return R; 00137 00138 R += Rk; 00139 } 00140 /* impossible */ 00141 assert (k < MAX_SMALL_ITERATION); 00142 abort (); 00143 } 00144 00145 00146 static nr_complex_t 00147 cbesselj_mediumarg_odd (unsigned int n, nr_complex_t z) 00148 { 00149 nr_complex_t first, second; 00150 nr_complex_t ak; 00151 00152 unsigned int m; 00153 unsigned int k; 00154 nr_double_t t; 00155 nr_double_t m1pna2; 00156 00157 m = (2 * std::abs (z) + 0.25 * (n + std::abs (imag (z)))); 00158 00159 /* -1^(n/2) */ 00160 m1pna2 = (n / 2) % 2 == 0 ? 1.0 : -1.0; 00161 first = (1.0 + m1pna2 * cos (z)) / (2.0 * m); 00162 00163 second = 0.0; 00164 for (k = 1; k <= m - 1; k++) 00165 { 00166 t = (k * M_PI) / (2 * m); 00167 ak = cos (z * std::sin (t)) * std::cos (n * t); 00168 second += ak; 00169 } 00170 return first + second / (nr_double_t) m; 00171 } 00172 00173 static nr_complex_t 00174 cbesselj_mediumarg_even (unsigned int n, nr_complex_t z) 00175 { 00176 nr_complex_t first, second; 00177 nr_complex_t ak; 00178 00179 unsigned int m; 00180 unsigned int k; 00181 nr_double_t t; 00182 nr_double_t m1pn1a2; 00183 00184 m = (2 * std::abs (z) + 0.25 * (n + std::abs (imag (z)))); 00185 00186 /* -1^(n/2) */ 00187 m1pn1a2 = ((n - 1) / 2) % 2 == 0 ? 1.0 : -1.0; 00188 first = (m1pn1a2 * sin (z)) / (2.0 * m); 00189 00190 second = 0.0; 00191 for (k = 1; k <= m - 1; k++) 00192 { 00193 t = (k * M_PI) / (2 * m); 00194 ak = std::sin (z * std::sin (t)) * std::sin (n * t); 00195 second += ak; 00196 } 00197 return first + second / (nr_double_t) m; 00198 } 00199 00200 00201 static nr_complex_t 00202 cbesselj_mediumarg (unsigned int n, nr_complex_t z) 00203 { 00204 if (n % 2 == 0) 00205 return cbesselj_mediumarg_odd (n, z); 00206 else 00207 return cbesselj_mediumarg_even (n, z); 00208 } 00209 00210 00211 00213 #define MAX_LARGE_ITERATION 430 00214 00219 static nr_complex_t 00220 cbesselj_largearg (unsigned int n, nr_complex_t z) 00221 { 00222 nr_complex_t Pk, P0, P, Qk, Q0, Q_; 00223 nr_complex_t tmp; 00224 unsigned long num, denum; 00225 nr_complex_t m1a8z2; 00226 unsigned int k; 00227 nr_double_t l, m; 00228 00229 /* P0 & Q0 */ 00230 P0 = 1; 00231 P = P0; 00232 Pk = P0; 00233 00234 Q0 = (4.0 * n * n - 1) / (8.0 * z); 00235 Q_ = Q0; 00236 Qk = Q0; 00237 00238 m1a8z2 = (-1.0) / (8.0 * sqr (z)); 00239 00240 /* P */ 00241 for (k = 1;; k++) 00242 { 00243 /* Usually converge before overflow */ 00244 assert (k <= MAX_LARGE_ITERATION); 00245 00246 num = (4 * sqr (n) - sqr (4 * k - 3)) * (4 * sqr (n) - (4 * k - 1)); 00247 denum = 2 * k * (2 * k - 1); 00248 Pk = Pk * ((nr_double_t) num * m1a8z2) / ((nr_double_t) denum); 00249 00250 if (real (Pk) < real (P0) * std::numeric_limits<nr_double_t>::epsilon() && 00251 imag (Pk) < imag (P0) * std::numeric_limits<nr_double_t>::epsilon()) 00252 break; 00253 00254 P += Pk; 00255 } 00256 00257 /* P */ 00258 for (k = 1;; k++) 00259 { 00260 /* Usually converge before overflow */ 00261 assert (k <= MAX_LARGE_ITERATION); 00262 00263 num = (4 * sqr (n) - sqr (4 * k - 1)) * (4 * sqr (n) - (4 * k - 1)); 00264 denum = 2 * k * (2 * k - 1); 00265 Qk = Qk * ((nr_double_t) num * m1a8z2) / ((nr_double_t) denum); 00266 00267 if (real (Qk) < real (Q0) * std::numeric_limits<nr_double_t>::epsilon() || 00268 imag (Qk) < imag (Q0) * std::numeric_limits<nr_double_t>::epsilon()) 00269 break; 00270 00271 Q_ += Qk; 00272 } 00273 00274 /* l, m cf [5] eq (5) */ 00275 l = (n % 4 == 0) || (n % 4 == 3) ? 1.0 : -1.0; 00276 m = (n % 4 == 0) || (n % 4 == 1) ? 1.0 : -1.0; 00277 00278 00279 tmp = (l * P + m * Q_) * cos (z); 00280 tmp += (m * P - l * Q_) * sin (z); 00281 return tmp / sqrt (M_PI * z); 00282 } 00283 00287 nr_complex_t 00288 cbesselj (unsigned int n, nr_complex_t z) 00289 { 00290 nr_double_t mul = 1.0; 00291 nr_complex_t ret; 00292 00293 /* J_n(-z)=(-1)^n J_n(z) */ 00294 /* 00295 if(real(z) < 0.0) 00296 { 00297 z = -z; 00298 mul = (n % 2) == 0 ? 1.0 : -1.0 ; 00299 } 00300 */ 00301 if (abs (z) < SMALL_JN_BOUND) 00302 ret = cbesselj_smallarg (n, z); 00303 else if (abs (z) > BIG_JN_BOUND) 00304 ret = cbesselj_largearg (n, z); 00305 else 00306 ret = cbesselj_mediumarg (n, z); 00307 00308 return mul * ret; 00309 }