Exemple #1
0
int gsl_sf_mathieu_b(int order, double qq, gsl_sf_result *result)
{
  int even_odd, nterms = 50, ii, counter = 0, maxcount = 1000;
  int dir = 0;  /* step direction for new search */
  double a1, a2, fa, fa1, dela, aa_orig, da = 0.025, aa;
  double aa_approx;  /* current approximation for solution */


  even_odd = 0;
  if (order % 2 != 0)
      even_odd = 1;

  /* The order cannot be 0. */
  if (order == 0)
  {
      GSL_ERROR("Characteristic value undefined for order 0", GSL_EFAILED);
  }

  /* If the argument is 0, then the coefficient is simply the square of
     the order. */
  if (qq == 0)
  {
      result->val = order*order;
      result->err = 0.0;
      return GSL_SUCCESS;
  }

  /* Use symmetry characteristics of the functions to handle cases with
     negative order and/or argument q.  See Abramowitz & Stegun, 20.8.3. */
  if (order < 0)
      order *= -1;
  if (qq < 0.0)
  {
      if (even_odd == 0)
          return gsl_sf_mathieu_b(order, -qq, result);
      else
          return gsl_sf_mathieu_a(order, -qq, result);
  }
  
  /* Compute an initial approximation for the characteristic value. */
  aa_approx = approx_s(order, qq);
  
  /* Save the original approximation for later comparison. */
  aa_orig = aa = aa_approx;
  
  /* Loop as long as the final value is not near the approximate value
     (with a max limit to avoid potential infinite loop). */
  while (counter < maxcount)
  {
      a1 = aa + 0.001;
      ii = 0;
      if (even_odd == 0)
          fa1 = seer(order, qq, a1, nterms);
      else
          fa1 = seor(order, qq, a1, nterms);

      for (;;)
      {
          if (even_odd == 0)
              fa = seer(order, qq, aa, nterms);
          else
              fa = seor(order, qq, aa, nterms);
      
          a2 = a1;
          a1 = aa;

          if (fa == fa1)
          {
              result->err = GSL_DBL_EPSILON;
              break;
          }
          aa -= (aa - a2)/(fa - fa1)*fa;
          dela = fabs(aa - a2);
          if (dela < 1e-18)
          {
              result->err = GSL_DBL_EPSILON;
              break;
          }
          if (ii > 40)
          {
              result->err = dela;
              break;
          }
          fa1 = fa;
          ii++;
      }
      
      /* If the solution found is not near the original approximation,
         tweak the approximate value, and try again. */
      if (fabs(aa - aa_orig) > (3 + 0.01*order*fabs(aa_orig)) ||
          (order > 10 && fabs(aa - aa_orig) > 1.5*order))
      {
          counter++;
          if (counter == maxcount)
          {
              result->err = fabs(aa - aa_orig);
              break;
          }
          if (aa > aa_orig)
          {
              if (dir == 1)
                  da /= 2;
              dir = -1;
          }
          else
          {
              if (dir == -1)
                  da /= 2;
              dir = 1;
          }
          aa_approx += dir*da*counter;
          aa = aa_approx;
          
          continue;
      }
      else
          break;
  }
  
  result->val = aa;
      
  /* If we went through the maximum number of retries and still didn't
     find the solution, let us know. */
  if (counter == maxcount)
  {
      GSL_ERROR("Wrong characteristic Mathieu value", GSL_EFAILED);
  }
  
  return GSL_SUCCESS;
}
int gsl_sf_mathieu_se(int order, double qq, double zz, gsl_sf_result *result)
{
  int even_odd, ii, status;
  double coeff[GSL_SF_MATHIEU_COEFF], norm, fn, factor;
  gsl_sf_result aa;


  norm = 0.0;
  even_odd = 0;
  if (order % 2 != 0)
      even_odd = 1;
  
  /* Handle the trivial cases where order = 0 and/or q = 0. */
  if (order == 0)
  {
      result->val = 0.0;
      result->err = 0.0;
      return GSL_SUCCESS;
  }
  
  if (qq == 0.0)
  {
      norm = 1.0;
      fn = sin(order*zz);
      
      result->val = fn;
      result->err = 2.0*GSL_DBL_EPSILON;
      factor = fabs(fn);
      if (factor > 1.0)
          result->err *= factor;
      
      return GSL_SUCCESS;
  }
  
  /* Use symmetry characteristics of the functions to handle cases with
     negative order. */
  if (order < 0)
      order *= -1;

  /* Compute the characteristic value. */
  status = gsl_sf_mathieu_b(order, qq, &aa);
  if (status != GSL_SUCCESS)
  {
      return status;
  }
  
  /* Compute the series coefficients. */
  status = gsl_sf_mathieu_b_coeff(order, qq, aa.val, coeff);
  if (status != GSL_SUCCESS)
  {
      return status;
  }
  
  if (even_odd == 0)
  {
      fn = 0.0;
      for (ii=0; ii<GSL_SF_MATHIEU_COEFF; ii++)
      {
          norm += coeff[ii]*coeff[ii];
          fn += coeff[ii]*sin(2.0*(ii + 1)*zz);
      }
  }
  else
  {
      fn = 0.0;
      for (ii=0; ii<GSL_SF_MATHIEU_COEFF; ii++)
      {
          norm += coeff[ii]*coeff[ii];
          fn += coeff[ii]*sin((2.0*ii + 1)*zz);
      }
  }
  norm = sqrt(norm);
  fn /= norm;

  result->val = fn;
  result->err = 2.0*GSL_DBL_EPSILON;
  factor = fabs(fn);
  if (factor > 1.0)
      result->err *= factor;
  
  return GSL_SUCCESS;
}
int gsl_sf_mathieu_Ms(int kind, int order, double qq, double zz,
                      gsl_sf_result *result)
{
  int even_odd, kk, mm, status;
  double maxerr = 1e-14, amax, pi = M_PI, fn, factor;
  double coeff[GSL_SF_MATHIEU_COEFF], fc;
  double j1c, z2c, j1mc, z2mc, j1pc, z2pc;
  double u1, u2;
  gsl_sf_result aa;


  /* Check for out of bounds parameters. */
  if (qq <= 0.0)
  {
      GSL_ERROR("q must be greater than zero", GSL_EINVAL);
  }
  if (kind < 1 || kind > 2)
  {
      GSL_ERROR("kind must be 1 or 2", GSL_EINVAL);
  }

  mm = 0;
  amax = 0.0;
  fn = 0.0;
  u1 = sqrt(qq)*exp(-1.0*zz);
  u2 = sqrt(qq)*exp(zz);
  
  even_odd = 0;
  if (order % 2 != 0)
      even_odd = 1;
  
  /* Compute the characteristic value. */
  status = gsl_sf_mathieu_b(order, qq, &aa);
  if (status != GSL_SUCCESS)
  {
      return status;
  }
  
  /* Compute the series coefficients. */
  status = gsl_sf_mathieu_b_coeff(order, qq, aa.val, coeff);
  if (status != GSL_SUCCESS)
  {
      return status;
  }

  if (even_odd == 0)
  {
      for (kk=0; kk<GSL_SF_MATHIEU_COEFF; kk++)
      {
          amax = GSL_MAX(amax, fabs(coeff[kk]));
          if (fabs(coeff[kk])/amax < maxerr)
              break;

          j1mc = gsl_sf_bessel_Jn(kk, u1);
          j1pc = gsl_sf_bessel_Jn(kk+2, u1);
          if (kind == 1)
          {
              z2mc = gsl_sf_bessel_Jn(kk, u2);
              z2pc = gsl_sf_bessel_Jn(kk+2, u2);
          }
          else /* kind = 2 */
          {
              z2mc = gsl_sf_bessel_Yn(kk, u2);
              z2pc = gsl_sf_bessel_Yn(kk+2, u2);
          }
          
          fc = pow(-1.0, 0.5*order+kk+1)*coeff[kk];
          fn += fc*(j1mc*z2pc - j1pc*z2mc);
      }

      fn *= sqrt(pi/2.0)/coeff[0];
  }
  else
  {
      for (kk=0; kk<GSL_SF_MATHIEU_COEFF; kk++)
      {
          amax = GSL_MAX(amax, fabs(coeff[kk]));
          if (fabs(coeff[kk])/amax < maxerr)
              break;

          j1c = gsl_sf_bessel_Jn(kk, u1);
          j1pc = gsl_sf_bessel_Jn(kk+1, u1);
          if (kind == 1)
          {
              z2c = gsl_sf_bessel_Jn(kk, u2);
              z2pc = gsl_sf_bessel_Jn(kk+1, u2);
          }
          else /* kind = 2 */
          {
              z2c = gsl_sf_bessel_Yn(kk, u2);
              z2pc = gsl_sf_bessel_Yn(kk+1, u2);
          }
          
          fc = pow(-1.0, 0.5*(order-1)+kk)*coeff[kk];
          fn += fc*(j1c*z2pc - j1pc*z2c);
      }

      fn *= sqrt(pi/2.0)/coeff[0];
  }

  result->val = fn;
  result->err = 2.0*GSL_DBL_EPSILON;
  factor = fabs(fn);
  if (factor > 1.0)
      result->err *= factor;
  
  return GSL_SUCCESS;
}