Qucs-core  0.0.19
cbesselj.cpp
Go to the documentation of this file.
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 }