# include <complex.h>
# include <math.h>
# include <stdio.h>
# include <stdlib.h>
# include <time.h>

# include "fn.h"

/******************************************************************************/

int i4_mach ( int i )

/******************************************************************************/
/*
  Purpose:

    I4_MACH returns integer machine constants.

  Discussion:

    Input/output unit numbers.

      I4_MACH(1) = the standard input unit.
      I4_MACH(2) = the standard output unit.
      I4_MACH(3) = the standard punch unit.
      I4_MACH(4) = the standard error message unit.

    Words.

      I4_MACH(5) = the number of bits per integer storage unit.
      I4_MACH(6) = the number of characters per integer storage unit.

    Integers.

    Assume integers are represented in the S digit base A form:

      Sign * (X(S-1)*A^(S-1) + ... + X(1)*A + X(0))

    where 0 <= X(1:S-1) < A.

      I4_MACH(7) = A, the base.
      I4_MACH(8) = S, the number of base A digits.
      I4_MACH(9) = A^S-1, the largest integer.

    Floating point numbers

    Assume floating point numbers are represented in the T digit 
    base B form:

      Sign * (B^E) * ((X(1)/B) + ... + (X(T)/B^T) )

    where 0 <= X(I) < B for I=1 to T, 0 < X(1) and EMIN <= E <= EMAX.

      I4_MACH(10) = B, the base.

    Single precision

      I4_MACH(11) = T, the number of base B digits.
      I4_MACH(12) = EMIN, the smallest exponent E.
      I4_MACH(13) = EMAX, the largest exponent E.

    Double precision

      I4_MACH(14) = T, the number of base B digits.
      I4_MACH(15) = EMIN, the smallest exponent E.
      I4_MACH(16) = EMAX, the largest exponent E.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    24 April 2007

  Author:

    Original FORTRAN77 version by Phyllis Fox, Andrew Hall, Norman Schryer.
    C version by John Burkardt.

  Reference:

    Phyllis Fox, Andrew Hall, Norman Schryer,
    Algorithm 528,
    Framework for a Portable Library,
    ACM Transactions on Mathematical Software,
    Volume 4, Number 2, June 1978, page 176-188.

  Parameters:

    Input, int I, chooses the parameter to be returned.
    1 <= I <= 16.

    Output, int I4_MACH, the value of the chosen parameter.
*/
{
  int value;

  if ( i < 1 )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "I4_MACH - Fatal error!\n" );
    fprintf ( stderr, "  The input argument I is out of bounds.\n" );
    fprintf ( stderr, "  Legal values satisfy 1 <= I <= 16.\n" );
    fprintf ( stderr, "  I = %d\n", i );
    value = 0;
    exit ( 1 );
  }
  else if ( i == 1 )
  {
    value = 5;
  }
  else if ( i == 2 )
  {
    value = 6;
  }
  else if ( i == 3 )
  {
    value = 7;
  }
  else if ( i == 4 )
  {
    value = 6;
  }
  else if ( i == 5 )
  {
    value = 32;
  }
  else if ( i == 6 )
  {
    value = 4;
  }
  else if ( i == 7 )
  {
    value = 2;
  }
  else if ( i == 8 )
  {
    value = 31;
  }
  else if ( i == 9 )
  {
    value = 2147483647;
  }
  else if ( i == 10 )
  {
    value = 2;
  }
  else if ( i == 11 )
  {
    value = 24;
  }
  else if ( i == 12 )
  {
    value = -125;
  }
  else if ( i == 13 )
  {
    value = 128;
  }
  else if ( i == 14 )
  {
    value = 53;
  }
  else if ( i == 15 )
  {
    value = -1021;
  }
  else if ( i == 16 )
  {
    value = 1024;
  }
  else if ( 16 < i )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "I4_MACH - Fatal error!\n" );
    fprintf ( stderr, "  The input argument I is out of bounds.\n" );
    fprintf ( stderr, "  Legal values satisfy 1 <= I <= 16.\n" );
    fprintf ( stderr, "  I = %d\n", i );
    value = 0;
    exit ( 1 );
  }

  return value;
}
/******************************************************************************/

int i4_max ( int i1, int i2 )

/******************************************************************************/
/*
  Purpose:

    I4_MAX returns the maximum of two I4's.

  Licensing:

    This code is distributed under the MIT license.

  Modified:

    13 October 1998

  Author:

    John Burkardt

  Parameters:

    Input, int I1, I2, are two integers to be compared.

    Output, int I4_MAX, the larger of I1 and I2.
*/
{
  int value;

  if ( i2 < i1 )
  {
    value = i1;
  }
  else
  {
    value = i2;
  }
  return value;
}
/******************************************************************************/

int i4_min ( int i1, int i2 )

/******************************************************************************/
/*
  Purpose:

    I4_MIN returns the minimum of two I4's.

  Licensing:

    This code is distributed under the MIT license.

  Modified:

    13 October 1998

  Author:

    John Burkardt

  Parameters:

    Input, int I1, I2, two integers to be compared.

    Output, int I4_MIN, the smaller of I1 and I2.
*/
{
  int value;

  if ( i1 < i2 )
  {
    value = i1;
  }
  else
  {
    value = i2;
  }
  return value;
}
/******************************************************************************/

int i4_pow ( int i, int j )

/******************************************************************************/
/*
  Purpose:

    I4_POW returns the value of I^J.

  Licensing:

    This code is distributed under the MIT license.

  Modified:

    01 April 2004

  Author:

    John Burkardt

  Parameters:

    Input, int I, J, the base and the power.  J should be nonnegative.

    Output, int I4_POW, the value of I^J.
*/
{
  int k;
  int value;

  if ( j < 0 )
  {
    if ( i == 1 )
    {
      value = 1;
    }
    else if ( i == 0 )
    {
      fprintf ( stderr, "\n" );
      fprintf ( stderr, "I4_POW - Fatal error!\n" );
      fprintf ( stderr, "  I^J requested, with I = 0 and J negative.\n" );
      exit ( 1 );
    }
    else
    {
      value = 0;
    }
  }
  else if ( j == 0 )
  {
    if ( i == 0 )
    {
      fprintf ( stderr, "\n" );
      fprintf ( stderr, "I4_POW - Fatal error!\n" );
      fprintf ( stderr, "  I^J requested, with I = 0 and J = 0.\n" );
      exit ( 1 );
    }
    else
    {
      value = 1;
    }
  }
  else if ( j == 1 )
  {
    value = i;
  }
  else
  {
    value = 1;
    for ( k = 1; k <= j; k++ )
    {
      value = value * i;
    }
  }
  return value;
}
/******************************************************************************/

float r4_acos ( float x )

/******************************************************************************/
/*
  Purpose:

    R4_ACOS evaluates the arc-cosine of an R4 argument.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, float X, the argument.

    Output, float R4_ACOS, the arc-cosine of X.
*/
{
  const float pi2 = 1.57079632679489661923;
  float value;

  value = pi2 - r4_asin ( x );

  return value;
}
/******************************************************************************/

float r4_acosh ( float x )

/******************************************************************************/
/*
  Purpose:

    R4_ACOSH evaluates the arc-hyperbolic cosine of an R4 argument.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, float X, the argument.

    Output, float R4_ACOSH, the arc-hyperbolic cosine of X.
*/
{
  const float aln2 = 0.69314718055994530942E+00;
  float value;
  static float xmax = 0.0;

  if ( xmax == 0.0E+00 )
  {
    xmax = 1.0E+00 / sqrt ( r4_mach ( 3 ) );
  }

  if ( x < 1.0E+00 )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R4_ACOSH - Fatal error!\n" );
    fprintf ( stderr, "  X < 1.\n" );
    exit ( 1 );
  }

  if ( x < xmax )
  {
    value = log ( x + sqrt ( x * x - 1.0E+00 ) );
  }
  else
  {
    value = aln2 + log ( x );
  }

  return value;
}
/******************************************************************************/

void r4_admp ( float x, float *ampl, float *phi )

/******************************************************************************/
/*
  Purpose:

    R4_ADMP: modulus and phase of the derivative of the Airy function.

  Description:

    This function must only be called when X <= -1.0.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, float X, the argument.

    Output, float *AMPL, *PHI, the modulus and phase of the 
    derivative of the Airy function.
*/
{
  static float an20cs[16] = {
     0.0126732217145738027E+00,
    -0.0005212847072615621E+00,
    -0.0000052672111140370E+00,
    -0.0000001628202185026E+00,
    -0.0000000090991442687E+00,
    -0.0000000007438647126E+00,
    -0.0000000000795494752E+00,
    -0.0000000000104050944E+00,
    -0.0000000000015932426E+00,
    -0.0000000000002770648E+00,
    -0.0000000000000535343E+00,
    -0.0000000000000113062E+00,
    -0.0000000000000025772E+00,
    -0.0000000000000006278E+00,
    -0.0000000000000001621E+00,
    -0.0000000000000000441E+00 };
  static float an21cs[24] = {
     0.0198313155263169394E+00,
    -0.0029376249067087533E+00,
    -0.0001136260695958196E+00,
    -0.0000100554451087156E+00,
    -0.0000013048787116563E+00,
    -0.0000002123881993151E+00,
    -0.0000000402270833384E+00,
    -0.0000000084996745953E+00,
    -0.0000000019514839426E+00,
    -0.0000000004783865344E+00,
    -0.0000000001236733992E+00,
    -0.0000000000334137486E+00,
    -0.0000000000093702824E+00,
    -0.0000000000027130128E+00,
    -0.0000000000008075954E+00,
    -0.0000000000002463214E+00,
    -0.0000000000000767656E+00,
    -0.0000000000000243883E+00,
    -0.0000000000000078831E+00,
    -0.0000000000000025882E+00,
    -0.0000000000000008619E+00,
    -0.0000000000000002908E+00,
    -0.0000000000000000993E+00,
    -0.0000000000000000343E+00 };
  static float an22cs[33] = {
     0.0537418629629794329E+00,
    -0.0126661435859883193E+00,
    -0.0011924334106593007E+00,
    -0.0002032327627275655E+00,
    -0.0000446468963075164E+00,
    -0.0000113359036053123E+00,
    -0.0000031641352378546E+00,
    -0.0000009446708886149E+00,
    -0.0000002966562236472E+00,
    -0.0000000969118892024E+00,
    -0.0000000326822538653E+00,
    -0.0000000113144618964E+00,
    -0.0000000040042691002E+00,
    -0.0000000014440333684E+00,
    -0.0000000005292853746E+00,
    -0.0000000001967763374E+00,
    -0.0000000000740800096E+00,
    -0.0000000000282016314E+00,
    -0.0000000000108440066E+00,
    -0.0000000000042074801E+00,
    -0.0000000000016459150E+00,
    -0.0000000000006486827E+00,
    -0.0000000000002574095E+00,
    -0.0000000000001027889E+00,
    -0.0000000000000412846E+00,
    -0.0000000000000166711E+00,
    -0.0000000000000067657E+00,
    -0.0000000000000027585E+00,
    -0.0000000000000011296E+00,
    -0.0000000000000004645E+00,
    -0.0000000000000001917E+00,
    -0.0000000000000000794E+00,
    -0.0000000000000000330E+00 };
  static float aph0cs[15] = {
    -0.0855849241130933257E+00,
     0.0011214378867065261E+00,
     0.0000042721029353664E+00,
     0.0000000817607381483E+00,
     0.0000000033907645000E+00,
     0.0000000002253264423E+00,
     0.0000000000206284209E+00,
     0.0000000000023858763E+00,
     0.0000000000003301618E+00,
     0.0000000000000527010E+00,
     0.0000000000000094555E+00,
     0.0000000000000018709E+00,
     0.0000000000000004024E+00,
     0.0000000000000000930E+00,
     0.0000000000000000229E+00 };
  static float aph1cs[22] = {
    -0.1024172908077571694E+00,
     0.0071697275146591248E+00,
     0.0001209959363122329E+00,
     0.0000073361512841220E+00,
     0.0000007535382954272E+00,
     0.0000001041478171741E+00,
     0.0000000174358728519E+00,
     0.0000000033399795033E+00,
     0.0000000007073075174E+00,
     0.0000000001619187515E+00,
     0.0000000000394539982E+00,
     0.0000000000101192282E+00,
     0.0000000000027092778E+00,
     0.0000000000007523806E+00,
     0.0000000000002156369E+00,
     0.0000000000000635283E+00,
     0.0000000000000191757E+00,
     0.0000000000000059143E+00,
     0.0000000000000018597E+00,
     0.0000000000000005950E+00,
     0.0000000000000001934E+00,
     0.0000000000000000638E+00 };
  static float aph2cs[32] = {
    -0.2057088719781465107E+00,
     0.0422196961357771922E+00,
     0.0020482560511207275E+00,
     0.0002607800735165006E+00,
     0.0000474824268004729E+00,
     0.0000105102756431612E+00,
     0.0000026353534014668E+00,
     0.0000007208824863499E+00,
     0.0000002103236664473E+00,
     0.0000000644975634555E+00,
     0.0000000205802377264E+00,
     0.0000000067836273921E+00,
     0.0000000022974015284E+00,
     0.0000000007961306765E+00,
     0.0000000002813860610E+00,
     0.0000000001011749057E+00,
     0.0000000000369306738E+00,
     0.0000000000136615066E+00,
     0.0000000000051142751E+00,
     0.0000000000019351689E+00,
     0.0000000000007393607E+00,
     0.0000000000002849792E+00,
     0.0000000000001107281E+00,
     0.0000000000000433412E+00,
     0.0000000000000170801E+00,
     0.0000000000000067733E+00,
     0.0000000000000027017E+00,
     0.0000000000000010835E+00,
     0.0000000000000004367E+00,
     0.0000000000000001769E+00,
     0.0000000000000000719E+00,
     0.0000000000000000294E+00 };
  float eta;
  static int nan20 = 0;
  static int nan21 = 0;
  static int nan22 = 0;
  static int naph0 = 0;
  static int naph1 = 0;
  static int naph2 = 0;
  const float pi34 = 2.3561944901923449E+00;
  float sqrtx;
  static float xsml = 0.0;
  float z;

  if ( nan20 == 0 )
  {
    eta = 0.1E+00 * r4_mach ( 3 );
    nan20 = r4_inits ( an20cs, 16, eta );
    nan21 = r4_inits ( an21cs, 24, eta );
    nan22 = r4_inits ( an22cs, 33, eta );
    naph0 = r4_inits ( aph0cs, 15, eta );
    naph1 = r4_inits ( aph1cs, 22, eta );
    naph2 = r4_inits ( aph2cs, 32, eta );
    xsml = - pow ( 128.0E+00 / r4_mach ( 3 ), 0.3333E+00 );
  }

  if ( x <= xsml )
  {
    z = 1.0E+00;
    *ampl = 0.3125E+00 + r4_csevl ( z, an20cs, nan20 );
    *phi = - 0.625E+00 + r4_csevl ( z, aph0cs, naph0 );
  }
  else if ( x < - 4.0E+00 )
  {
    z = 128.0E+00 / x / x / x + 1.0E+00;
    *ampl = 0.3125E+00 + r4_csevl ( z, an20cs, nan20 );
    *phi = - 0.625E+00 + r4_csevl ( z, aph0cs, naph0 );
  }
  else if ( x < - 2.0E+00 )
  {
    z = ( 128.0E+00 / x / x / x + 9.0E+00 ) / 7.0E+00;
    *ampl = 0.3125E+00 + r4_csevl ( z, an21cs, nan21 );
    *phi = - 0.625E+00 + r4_csevl ( z, aph1cs, naph1 );
  }
  else if ( x <= - 1.0E+00 )
  {
    z = ( 16.0E+00 / x / x / x + 9.0E+00 ) / 7.0E+00;
    *ampl = 0.3125E+00 + r4_csevl ( z, an22cs, nan22 );
    *phi = - 0.625E+00 + r4_csevl ( z, aph2cs, naph2 );
  }
  else
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R4_ADMP - Fatal error!\n" );
    fprintf ( stderr, "  - 1.0 < x.\n" );
    exit ( 1 );
  }

  sqrtx = sqrt ( - x );
  *ampl = sqrt ( *ampl * sqrtx );
  *phi = pi34 - x * sqrtx * *phi;

  return;
}
/******************************************************************************/

float r4_ai ( float x )

/******************************************************************************/
/*
  Purpose:

    R4_AI evaluates the Airy function Ai of an R4 argument.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, float X, the argument.

    Output, float R4_AI, the Airy function Ai of X.
*/
{
  static float aifcs[9] = {
   -0.03797135849666999750E+00,
    0.05919188853726363857E+00,
    0.00098629280577279975E+00,
    0.00000684884381907656E+00,
    0.00000002594202596219E+00,
    0.00000000006176612774E+00,
    0.00000000000010092454E+00,
    0.00000000000000012014E+00,
    0.00000000000000000010E+00 };
  static float aigcs[8] = {
    0.01815236558116127E+00,
    0.02157256316601076E+00,
    0.00025678356987483E+00,
    0.00000142652141197E+00,
    0.00000000457211492E+00,
    0.00000000000952517E+00,
    0.00000000000001392E+00,
    0.00000000000000001E+00 };
  static int naif = 0;
  static int naig = 0;
  float theta;
  float value;
  static float x3sml = 0.0;
  float xm;
  static float xmax = 0.0;
  float z;

  if ( naif == 0 )
  {
    naif = r4_inits ( aifcs, 9, 0.1E+00 * r4_mach ( 3 ) );
    naig = r4_inits ( aigcs, 8, 0.1E+00 * r4_mach ( 3 ) );
    x3sml = r4_power ( r4_mach ( 3 ), 0.3334E+00 );
    xmax = r4_power ( - 1.5E+00 * log ( r4_mach ( 1 ) ), 0.6667E+00 );
    xmax = xmax - xmax * log ( xmax ) 
      / ( 4.0E+00 * xmax * sqrt ( xmax ) + 1.0E+00 ) - 0.01E+00;
  }

  if ( x < - 1.0E+00 )
  {
    r4_aimp ( x, &xm, &theta );
    value = xm * cos ( theta );
  }
  else if ( fabs ( x ) <= x3sml )
  {
    z = 0.0E+00;
    value = 0.375E+00 + ( r4_csevl ( z, aifcs, naif ) 
      - x * ( 0.25E+00 + r4_csevl ( z, aigcs, naig ) ) );
  }
  else if ( x <= 1.0E+00 )
  {
    z = x * x * x;
    value = 0.375E+00 + ( r4_csevl ( z, aifcs, naif ) 
      - x * ( 0.25E+00 + r4_csevl ( z, aigcs, naig ) ) );
  }
  else if ( x <= xmax )
  {
    value = r4_aie ( x )
      * exp ( - 2.0E+00 * x * sqrt ( x ) / 3.0E+00 );
  }
  else
  {
    value = 0.0E+00;
  }
  return value;
}
/******************************************************************************/

float r4_aid ( float x )

/******************************************************************************/
/*
  Purpose:

    R4_AID evaluates the derivative of the Airy function Ai of an R4 argument.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, float X, the argument.

    Output, float R4_AID, the derivative of the Airy function Ai of X.
*/
{
  static float aifcs[8] = {
     0.10527461226531408809E+00,
     0.01183613628152997844E+00,
     0.00012328104173225664E+00,
     0.00000062261225638140E+00,
     0.00000000185298887844E+00,
     0.00000000000363328873E+00,
     0.00000000000000504622E+00,
     0.00000000000000000522E+00 };
  static float aigcs[9] = {
     0.021233878150918666852E+00,
     0.086315930335214406752E+00,
     0.001797594720383231358E+00,
     0.000014265499875550693E+00,
     0.000000059437995283683E+00,
     0.000000000152403366479E+00,
     0.000000000000264587660E+00,
     0.000000000000000331562E+00,
     0.000000000000000000314E+00 };
  static int naif = 0;
  static int naig = 0;
  float phi;
  float value;
  float x2;
  static float x2sml = 0.0;
  float x3;
  static float x3sml = 0.0;
  float xn;

  if ( naif == 0 )
  {
    naif = r4_inits ( aifcs, 8, 0.1E+00 * r4_mach ( 3 ) );
    naig = r4_inits ( aigcs, 9, 0.1E+00 * r4_mach ( 3 ) );
    x3sml = r4_power ( r4_mach ( 3 ), 0.3334E+00 );
    x2sml = sqrt ( r4_mach ( 3 ) );
  }

  if ( x < - 1.0E+00 )
  {
    r4_admp ( x, &xn, &phi );
    value = xn * cos ( phi );
  }
  else if ( fabs ( x ) <= x2sml )
  {
    x2 = 0.0E+00;
    x3 = 0.0E+00;
    value = ( x2 * ( 0.125E+00 + r4_csevl ( x3, aifcs, naif ) ) -
      r4_csevl ( x3, aigcs, naig ) ) - 0.25E+00;
  }
  else if ( fabs ( x ) <= x3sml )
  {
    x2 = x * x;
    x3 = 0.0E+00;
    value = ( x2 * ( 0.125E+00 + r4_csevl ( x3, aifcs, naif ) ) -
      r4_csevl ( x3, aigcs, naig ) ) - 0.25E+00;
  }
  else if ( x <= 1.0E+00 )
  {
    x2 = x * x;
    x3 = x * x * x;
    value = ( x2 * ( 0.125E+00 + r4_csevl ( x3, aifcs, naif ) ) -
      r4_csevl ( x3, aigcs, naig ) ) - 0.25E+00;
  }
  else
  {
    value = r4_aide ( x ) 
      * exp ( - 2.0E+00 * x * sqrt ( x ) / 3.0E+00 );
  }
  return value;
}
/******************************************************************************/

float r4_aide ( float x )

/******************************************************************************/
/*
  Purpose:

    R4_AIDE: exponentially scaled derivative, Airy function Ai of an R4 argument.

  Discussion:

    if X <= 0,
      R4_AIDE ( X ) = R4_AID ( X )
    else
      R4_AIDE ( X ) = R4_AID ( X ) * exp ( 2/3 * X^(3/2) )

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, float X, the argument.

    Output, float R4_AIDE, the exponentially scaled derivative of 
    the Airy function Ai of X.
*/
{
  static float aifcs[8] = {
     0.10527461226531408809E+00,
     0.01183613628152997844E+00,
     0.00012328104173225664E+00,
     0.00000062261225638140E+00,
     0.00000000185298887844E+00,
     0.00000000000363328873E+00,
     0.00000000000000504622E+00,
     0.00000000000000000522E+00 };
  static float aigcs[9] = {
     0.021233878150918666852E+00,
     0.086315930335214406752E+00,
     0.001797594720383231358E+00,
     0.000014265499875550693E+00,
     0.000000059437995283683E+00,
     0.000000000152403366479E+00,
     0.000000000000264587660E+00,
     0.000000000000000331562E+00,
     0.000000000000000000314E+00 };
  static float aip1cs[25] = {
     0.0358865097808301538E+00,
     0.0114668575627764899E+00,
    -0.0007592073583861400E+00,
     0.0000869517610893841E+00,
    -0.0000128237294298592E+00,
     0.0000022062695681038E+00,
    -0.0000004222295185921E+00,
     0.0000000874686415726E+00,
    -0.0000000192773588418E+00,
     0.0000000044668460054E+00,
    -0.0000000010790108052E+00,
     0.0000000002700029447E+00,
    -0.0000000000696480108E+00,
     0.0000000000184489907E+00,
    -0.0000000000050027817E+00,
     0.0000000000013852243E+00,
    -0.0000000000003908218E+00,
     0.0000000000001121536E+00,
    -0.0000000000000326862E+00,
     0.0000000000000096619E+00,
    -0.0000000000000028935E+00,
     0.0000000000000008770E+00,
    -0.0000000000000002688E+00,
     0.0000000000000000832E+00,
    -0.0000000000000000260E+00 };
  static float aip2cs[15] = {
     0.0065457691989713757E+00,
     0.0023833724120774592E+00,
    -0.0000430700770220586E+00,
     0.0000015629125858629E+00,
    -0.0000000815417186163E+00,
     0.0000000054103738057E+00,
    -0.0000000004284130883E+00,
     0.0000000000389497963E+00,
    -0.0000000000039623161E+00,
     0.0000000000004428184E+00,
    -0.0000000000000536297E+00,
     0.0000000000000069650E+00,
    -0.0000000000000009620E+00,
     0.0000000000000001403E+00,
    -0.0000000000000000215E+00 };
  float eta;
  static int naif = 0;
  static int naig = 0;
  static int naip1 = 0;
  static int naip2 = 0;
  float phi;
  float sqrtx;
  float value;
  float x2;
  static float x2sml = 0.0;
  float x3;
  static float x32sml = 0.0;
  static float x3sml = 0.0;
  float xn;
  static float xbig = 0.0;
  float z;

  if ( naif == 0 )
  {
    eta = 0.1E+00 * r4_mach ( 3 );
    naif = r4_inits ( aifcs, 8, eta);
    naig = r4_inits ( aigcs, 9, eta);
    naip1 = r4_inits ( aip1cs, 25, eta );
    naip2 = r4_inits ( aip2cs, 15, eta );
    x2sml = sqrt ( eta );
    x3sml = r4_power ( eta, 0.3333E+00 );
    x32sml = 1.3104E+00 * x3sml * x3sml;
    xbig = r4_power ( r4_mach ( 2 ), 0.6666E+00 );
  }

  if ( x < - 1.0E+00 )
  {
    r4_admp ( x, &xn, &phi );
    value = xn * cos ( phi );
  }
  else if ( fabs ( x ) <= x2sml )
  {
    x2 = 0.0E+00;
    x3 = 0.0E+00;
    value = ( x2 * ( 0.125E+00 
      + r4_csevl ( x3, aifcs, naif ) ) 
      - r4_csevl ( x3, aigcs, naig ) ) - 0.25E+00;
  }
  else if ( fabs ( x ) <= x3sml )
  {
    x2 = x * x;
    x3 = 0.0E+00;
    value = ( x2 * ( 0.125E+00 
      + r4_csevl ( x3, aifcs, naif ) ) 
      - r4_csevl ( x3, aigcs, naig ) ) - 0.25E+00;
  }
  else if ( fabs ( x ) <= x32sml )
  {
    x2 = x * x;
    x3 = x * x * x;
    value = ( x2 * ( 0.125E+00 
      + r4_csevl ( x3, aifcs, naif ) ) 
      - r4_csevl ( x3, aigcs, naig ) ) - 0.25E+00;
  }
  else if ( x <= 1.0E+00 )
  {
    x2 = x * x;
    x3 = x * x * x;
    value = ( x2 * ( 0.125E+00 
      + r4_csevl ( x3, aifcs, naif ) ) 
      - r4_csevl ( x3, aigcs, naig ) ) - 0.25E+00;
    value = value * exp ( 2.0E+00 * x * sqrt ( x ) / 3.0E+00 );
  }
  else if ( x <= 4.0E+00 )
  {
    sqrtx = sqrt ( x );
    z = ( 16.0E+00 / ( x * sqrtx ) - 9.0E+00 ) / 7.0E+00;
    value = ( - 0.28125E+00 
      - r4_csevl ( z, aip1cs, naip1 ) ) * sqrt ( sqrtx );
  }
  else if ( x < xbig )
  {
    sqrtx = sqrt ( x );
    z = 16.0E+00 / ( x * sqrtx ) - 1.0E+00;
    value = ( - 0.28125E+00 
      - r4_csevl ( z, aip2cs, naip2 ) ) * sqrt ( sqrtx );
  }
  else
  {
    sqrtx = sqrt ( x );
    z = - 1.0E+00;
    value = ( - 0.28125E+00 
      - r4_csevl ( z, aip2cs, naip2 ) ) * sqrt ( sqrtx );
  }

  return value;
}
/******************************************************************************/

float r4_aie ( float x )

/******************************************************************************/
/*
  Purpose:

    R4_AIE evaluates the exponential scaled Airy function Ai of an R4 argument.

  Discussion:

    If X <= 0
      R4_AIE ( X ) = R4_AI ( X )
    else
      R4_AIE ( X ) = R4_AI ( X ) * exp ( 2/3 X^(3/2) )

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, float X, the argument.

    Output, float R4_AIE, the Airy function Ai of X.
*/
{
  static float aifcs[9] = {
   -0.03797135849666999750E+00,
    0.05919188853726363857E+00,
    0.00098629280577279975E+00,
    0.00000684884381907656E+00,
    0.00000002594202596219E+00,
    0.00000000006176612774E+00,
    0.00000000000010092454E+00,
    0.00000000000000012014E+00,
    0.00000000000000000010E+00 };
  static float aigcs[8] = {
    0.01815236558116127E+00,
    0.02157256316601076E+00,
    0.00025678356987483E+00,
    0.00000142652141197E+00,
    0.00000000457211492E+00,
    0.00000000000952517E+00,
    0.00000000000001392E+00,
    0.00000000000000001E+00 };
  static float aipcs[34] = {
   -0.0187519297793868E+00,
   -0.0091443848250055E+00,
    0.0009010457337825E+00,
   -0.0001394184127221E+00,
    0.0000273815815785E+00,
   -0.0000062750421119E+00,
    0.0000016064844184E+00,
   -0.0000004476392158E+00,
    0.0000001334635874E+00,
   -0.0000000420735334E+00,
    0.0000000139021990E+00,
   -0.0000000047831848E+00,
    0.0000000017047897E+00,
   -0.0000000006268389E+00,
    0.0000000002369824E+00,
   -0.0000000000918641E+00,
    0.0000000000364278E+00,
   -0.0000000000147475E+00,
    0.0000000000060851E+00,
   -0.0000000000025552E+00,
    0.0000000000010906E+00,
   -0.0000000000004725E+00,
    0.0000000000002076E+00,
   -0.0000000000000924E+00,
    0.0000000000000417E+00,
   -0.0000000000000190E+00,
    0.0000000000000087E+00,
   -0.0000000000000040E+00,
    0.0000000000000019E+00,
   -0.0000000000000009E+00,
    0.0000000000000004E+00,
   -0.0000000000000002E+00,
    0.0000000000000001E+00,
   -0.0000000000000000E+00 };
  float eta;
  static int naif = 0;
  static int naig = 0;
  static int naip = 0;
  float sqrtx;
  float theta;
  float value;
  static float x32sml = 0.0;
  static float x3sml = 0.0;
  static float xbig = 0.0;
  float xm;
  float z;

  if ( naif == 0 )
  {
    eta = 0.1E+00 * r4_mach ( 3 );
    naif = r4_inits ( aifcs, 9, eta );
    naig = r4_inits ( aigcs, 8, eta );
    naip = r4_inits ( aipcs, 34, eta );
    x3sml = r4_power ( eta, 0.3333E+00 );
    x32sml = 1.3104E+00 * x3sml * x3sml;
    xbig = r4_power ( r4_mach ( 2 ), 0.6666E+00 );
  }

  if ( x < - 1.0E+00 )
  {
    r4_aimp ( x, &xm, &theta );
    value = xm * cos ( theta );
  }
  else if ( fabs ( x ) <= x32sml )
  {
    z = 0.0E+00;
    value = 0.375E+00 + ( r4_csevl ( z, aifcs, naif ) 
      - x * ( 0.25E+00 + r4_csevl ( z, aigcs, naig ) ) );
  }
  else if ( fabs ( x ) <= x3sml )
  {
    z = 0.0E+00;
    value = 0.375E+00 + ( r4_csevl ( z, aifcs, naif ) 
      - x * ( 0.25E+00 + r4_csevl ( z, aigcs, naig ) ) );
    value = value * exp ( 2.0E+00 * x * sqrt ( x ) / 3.0E+00 );
  }
  else if ( x <= 1.0E+00 )
  {
    z = x * x * x;
    value = 0.375E+00 + ( r4_csevl (z, aifcs, naif ) 
      - x * ( 0.25E+00 + r4_csevl ( z, aigcs, naig ) ) );
    value = value * exp ( 2.0E+00 * x * sqrt ( x ) / 3.0E+00 );
  }
  else if ( x < xbig )
  {
    sqrtx = sqrt ( x );
    z = 2.0E+00 / ( x * sqrtx ) - 1.0E+00;
    value = ( 0.28125E+00 
      + r4_csevl ( z, aipcs, naip ) ) / sqrt ( sqrtx );
  }
  else
  {
    sqrtx = sqrt ( x );
    z = - 1.0E+00;
    value = ( 0.28125E+00 
      + r4_csevl ( z, aipcs, naip ) ) / sqrt ( sqrtx );
  }

  return value;
}
/******************************************************************************/

void r4_aimp ( float x, float *ampl, float *theta )

/******************************************************************************/
/*
  Purpose:

    R4_AIMP evaluates the modulus and phase of the Airy function.

  Description:

    This function must only be called when X <= -1.0.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, float X, the argument.

    Output, float *AMPL, *PHI, the modulus and phase of the 
    Airy function.
*/
{
  static float am21cs[40] = {
   +0.0065809191761485E+00,
   +0.0023675984685722E+00,
   +0.0001324741670371E+00,
   +0.0000157600904043E+00,
   +0.0000027529702663E+00,
   +0.0000006102679017E+00,
   +0.0000001595088468E+00,
   +0.0000000471033947E+00,
   +0.0000000152933871E+00,
   +0.0000000053590722E+00,
   +0.0000000020000910E+00,
   +0.0000000007872292E+00,
   +0.0000000003243103E+00,
   +0.0000000001390106E+00,
   +0.0000000000617011E+00,
   +0.0000000000282491E+00,
   +0.0000000000132979E+00,
   +0.0000000000064188E+00,
   +0.0000000000031697E+00,
   +0.0000000000015981E+00,
   +0.0000000000008213E+00,
   +0.0000000000004296E+00,
   +0.0000000000002284E+00,
   +0.0000000000001232E+00,
   +0.0000000000000675E+00,
   +0.0000000000000374E+00,
   +0.0000000000000210E+00,
   +0.0000000000000119E+00,
   +0.0000000000000068E+00,
   +0.0000000000000039E+00,
   +0.0000000000000023E+00,
   +0.0000000000000013E+00,
   +0.0000000000000008E+00,
   +0.0000000000000005E+00,
   +0.0000000000000003E+00,
   +0.0000000000000001E+00,
   +0.0000000000000001E+00,
   +0.0000000000000000E+00,
   +0.0000000000000000E+00,
   +0.0000000000000000E+00 };
  static float am22cs[33] = {
   -0.01562844480625341E+00,
   +0.00778336445239681E+00,
   +0.00086705777047718E+00,
   +0.00015696627315611E+00,
   +0.00003563962571432E+00,
   +0.00000924598335425E+00,
   +0.00000262110161850E+00,
   +0.00000079188221651E+00,
   +0.00000025104152792E+00,
   +0.00000008265223206E+00,
   +0.00000002805711662E+00,
   +0.00000000976821090E+00,
   +0.00000000347407923E+00,
   +0.00000000125828132E+00,
   +0.00000000046298826E+00,
   +0.00000000017272825E+00,
   +0.00000000006523192E+00,
   +0.00000000002490471E+00,
   +0.00000000000960156E+00,
   +0.00000000000373448E+00,
   +0.00000000000146417E+00,
   +0.00000000000057826E+00,
   +0.00000000000022991E+00,
   +0.00000000000009197E+00,
   +0.00000000000003700E+00,
   +0.00000000000001496E+00,
   +0.00000000000000608E+00,
   +0.00000000000000248E+00,
   +0.00000000000000101E+00,
   +0.00000000000000041E+00,
   +0.00000000000000017E+00,
   +0.00000000000000007E+00,
   +0.00000000000000002E+00 };
  static float ath1cs[36] = {
   -0.07125837815669365E+00,
   -0.00590471979831451E+00,
   -0.00012114544069499E+00,
   -0.00000988608542270E+00,
   -0.00000138084097352E+00,
   -0.00000026142640172E+00,
   -0.00000006050432589E+00,
   -0.00000001618436223E+00,
   -0.00000000483464911E+00,
   -0.00000000157655272E+00,
   -0.00000000055231518E+00,
   -0.00000000020545441E+00,
   -0.00000000008043412E+00,
   -0.00000000003291252E+00,
   -0.00000000001399875E+00,
   -0.00000000000616151E+00,
   -0.00000000000279614E+00,
   -0.00000000000130428E+00,
   -0.00000000000062373E+00,
   -0.00000000000030512E+00,
   -0.00000000000015239E+00,
   -0.00000000000007758E+00,
   -0.00000000000004020E+00,
   -0.00000000000002117E+00,
   -0.00000000000001132E+00,
   -0.00000000000000614E+00,
   -0.00000000000000337E+00,
   -0.00000000000000188E+00,
   -0.00000000000000105E+00,
   -0.00000000000000060E+00,
   -0.00000000000000034E+00,
   -0.00000000000000020E+00,
   -0.00000000000000011E+00,
   -0.00000000000000007E+00,
   -0.00000000000000004E+00,
   -0.00000000000000002E+00 };
  static float ath2cs[32] = {
   +0.00440527345871877E+00,
   -0.03042919452318455E+00,
   -0.00138565328377179E+00,
   -0.00018044439089549E+00,
   -0.00003380847108327E+00,
   -0.00000767818353522E+00,
   -0.00000196783944371E+00,
   -0.00000054837271158E+00,
   -0.00000016254615505E+00,
   -0.00000005053049981E+00,
   -0.00000001631580701E+00,
   -0.00000000543420411E+00,
   -0.00000000185739855E+00,
   -0.00000000064895120E+00,
   -0.00000000023105948E+00,
   -0.00000000008363282E+00,
   -0.00000000003071196E+00,
   -0.00000000001142367E+00,
   -0.00000000000429811E+00,
   -0.00000000000163389E+00,
   -0.00000000000062693E+00,
   -0.00000000000024260E+00,
   -0.00000000000009461E+00,
   -0.00000000000003716E+00,
   -0.00000000000001469E+00,
   -0.00000000000000584E+00,
   -0.00000000000000233E+00,
   -0.00000000000000093E+00,
   -0.00000000000000037E+00,
   -0.00000000000000015E+00,
   -0.00000000000000006E+00,
   -0.00000000000000002E+00 };
  float eta;
  static int nam21 = 0;
  static int nam22 = 0;
  static int nath1 = 0;
  static int nath2 = 0;
  const float pi4 = 0.78539816339744831E+00;
  float sqrtx;
  static float xsml = 0.0;
  float z;

  if ( nam21 == 0 )
  {
    eta = 0.1E+00 * r4_mach ( 3 );
    nam21 = r4_inits ( am21cs, 40, eta );
    nath1 = r4_inits ( ath1cs, 36, eta );
    nam22 = r4_inits ( am22cs, 33, eta );
    nath2 = r4_inits ( ath2cs, 32, eta );
    xsml = - r4_power ( 16.0E+00 / r4_mach ( 3 ), 0.3333E+00 );
  }

  if ( x <= xsml )
  {
    z = 1.0E+00;
    *ampl = 0.3125E+00 + r4_csevl ( z, am21cs, nam21 );
    *theta = - 0.625E+00 + r4_csevl ( z, ath1cs, nath1 );
  }
  else if ( x < - 2.0E+00 )
  {
    z = 16.0 / x / x / x + 1.0;
    *ampl = 0.3125E+00 + r4_csevl ( z, am21cs, nam21 );
    *theta = - 0.625E+00 + r4_csevl ( z, ath1cs, nath1 );
  }
  else if ( x <= - 1.0E+00 )
  {
    z = ( 16.0E+00 / x / x / x + 9.0E+00 ) / 7.0E+00;
    *ampl = 0.3125E+00 + r4_csevl ( z, am22cs, nam22 );
    *theta = - 0.625E+00 + r4_csevl ( z, ath2cs, nath2 );
  }
  else
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R4_AIMP - Fatal error!\n" );
    fprintf ( stderr, "  - 1.0 < X.\n" );
    exit ( 1 );
  }

  sqrtx = sqrt ( - x );
  *ampl = sqrt ( *ampl / sqrtx );
  *theta = pi4 - x * sqrtx * *theta;

  return;
}
/******************************************************************************/

float r4_aint ( float x )

/******************************************************************************/
/*
  Purpose:

    R4_AINT truncates an R4 argument to an integer.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    John Burkardt.

  Parameters:

    Input, float X, the argument.

    Output, float R4_AINT, the truncated version of X.
*/
{
  float value;

  if ( x < 0.0E+00 )
  {
    value = - ( float ) ( ( int ) ( fabs ( x ) ) );
  }
  else
  {
    value =   ( float ) ( ( int ) ( fabs ( x ) ) );
  }

  return value;
}
/******************************************************************************/

float r4_asin ( float x )

/******************************************************************************/
/*
  Purpose:

    R4_ASIN evaluates the arc-sine of an R4 argument.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, float X, the argument.

    Output, float R4_ASIN, the arc-sine of X.
*/
{
  static float asincs[20] = {
    0.10246391753227159E+00,
    0.054946487221245833E+00,
    0.004080630392544969E+00,
    0.000407890068546044E+00,
    0.000046985367432203E+00,
    0.000005880975813970E+00,
    0.000000777323124627E+00,
    0.000000106774233400E+00,
    0.000000015092399536E+00,
    0.000000002180972408E+00,
    0.000000000320759842E+00,
    0.000000000047855369E+00,
    0.000000000007225128E+00,
    0.000000000001101833E+00,
    0.000000000000169476E+00,
    0.000000000000026261E+00,
    0.000000000000004095E+00,
    0.000000000000000642E+00,
    0.000000000000000101E+00,
    0.000000000000000016E+00 };
  static int nterms = 0;
  const float pi2 = 1.57079632679489661923E+00;
  static float sqeps = 0.0;
  float value;
  float y;
  float z;

  if ( nterms == 0 )
  {
    nterms = r4_inits ( asincs, 20, 0.1 * r4_mach ( 3 ) );
    sqeps = sqrt ( 6.0 * r4_mach ( 3 ) );
  }

  y = fabs ( x );

  if ( x < - 1.0 - sqeps )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R4_ASIN - Fatal error!\n" );
    fprintf ( stderr, "  X < - 1.0\n" );
    exit ( 1 );
  }
  else if ( x < - 1.0 )
  {
    value = - pi2;
  }
  else if ( x < 1.0 )
  {
    z = 0.0;
    if ( sqeps < y )
    {
      z = y * y;
    }

    if ( z <= 0.5 )
    {
      value = x * ( 1.0 + r4_csevl ( 4.0 * z - 1.0, asincs, nterms ) );
    }
    else
    {
      value = pi2 - sqrt ( 1.0 - z ) * ( 1.0 + 
        r4_csevl ( 3.0 - 4.0 * z, asincs, nterms ) );
    }

    if ( x < 0.0 )
    {
      value = - fabs ( value );
    }
    else if ( 0.0 < x )
    {
      value = + fabs ( value );
    }
  }
  else if ( x < 1.0 + sqeps )
  {
    value = pi2;
  }
  else
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R4_ASIN - Fatal error!\n" );
    fprintf ( stderr, "  1.0 < X\n" );
    exit ( 1 );
  }
  return value;
}
/******************************************************************************/

float r4_asinh ( float x )

/******************************************************************************/
/*
  Purpose:

    R4_ASINH evaluates the arc-sine of an R4 argument.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, float X, the argument.

    Output, float R4_ASINH, the arc-hyperbolic sine of X.
*/
{
  const float aln2 = 0.69314718055994530942E+00;
  static float asnhcs[20] = {
   -0.12820039911738186E+00,
   -0.058811761189951768E+00,
    0.004727465432212481E+00,
   -0.000493836316265361E+00,
    0.000058506207058557E+00,
   -0.000007466998328931E+00,
    0.000001001169358355E+00,
   -0.000000139035438587E+00,
    0.000000019823169483E+00,
   -0.000000002884746841E+00,
    0.000000000426729654E+00,
   -0.000000000063976084E+00,
    0.000000000009699168E+00,
   -0.000000000001484427E+00,
    0.000000000000229037E+00,
   -0.000000000000035588E+00,
    0.000000000000005563E+00,
   -0.000000000000000874E+00,
    0.000000000000000138E+00,
   -0.000000000000000021E+00 };
  static int nterms = 0;
  static float sqeps = 0.0;
  float value;
  static float xmax = 0.0;
  float y;

  if ( nterms == 0 )
  {
    nterms = r4_inits ( asnhcs, 20, 0.1E+00 * r4_mach ( 3 ) );
    sqeps = sqrt ( r4_mach ( 3 ) );
    xmax = 1.0E+00 / sqeps;
  }

  y = fabs ( x );

  if ( y <= 1.0E+00 )
  {
    value = x;
    if ( sqeps < y )
    {
      value = x * ( 1.0E+00 
        + r4_csevl ( 2.0E+00 * x * x - 1.0E+00, asnhcs, nterms ) );
    }
  }
  else
  {
    if ( y < xmax )
    {
      value = log ( y + sqrt ( y * y + 1.0E+00 ) );
    }
    else
    {
      value = aln2 + log ( y );
    }

    if ( x < 0.0E+00 )
    {
      value = - value;
    }
  }
  return value;
}
/******************************************************************************/

float r4_atan ( float x )

/******************************************************************************/
/*
  Purpose:

    R4_ATAN evaluates the arc-tangent of an R4 argument.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    11 May 2016

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, float X, the argument.

    Output, float R4_ATAN, the arc-tangent of X.
*/
{
  static float atancs[9] = {
     0.48690110349241406E+00,
    -0.006510831636717464E+00,
     0.000038345828265245E+00,
    -0.000000268722128762E+00,
     0.000000002050093098E+00,
    -0.000000000016450717E+00,
     0.000000000000136509E+00,
    -0.000000000000001160E+00,
     0.000000000000000010E+00 };
  static float conpi8[4] = {
    0.375E+00,
    0.75E+00,
    1.125E+00,
    1.5E+00 };
  int n;
  static int nterms = 0;
  static float pi8[4] = {
    0.176990816987241548E-01,
    0.353981633974483096E-01,
    0.530972450961724644E-01,
    0.0707963267948966192E+00 };
  static float sqeps = 0.0;
  float t;
  static float tanp8[3] = {
    0.414213562373095048E+00,
    1.0E+00,
    2.41421356237309504E+00 };
  float value;
  static float xbig = 0.0;
  const float xbnd1 = +0.198912367379658006E+00;
  const float xbnd2 = +0.668178637919298919E+00;
  const float xbnd3 = +1.49660576266548901E+00;
  const float xbnd4 = +5.02733949212584810E+00;
  float y;

  if ( nterms == 0 )
  {
    nterms = r4_inits ( atancs, 9, 0.1E+00 * r4_mach ( 3 ) );
    sqeps = sqrt ( 6.0E+00 * r4_mach ( 3 ) );
    xbig = 1.0E+00 / r4_mach ( 3 );
  }

  y = fabs ( x );

  if ( y <= xbnd1 )
  {
    value = x;
    if ( sqeps < y )
    {
      value = x * ( 0.75E+00 + r4_csevl ( 
        50.0E+00 * y * y - 1.0E+00, atancs, nterms ) );
    }
  }
  else if ( y <= xbnd4 )
  {
    if ( xbnd3 < y )
    {
      n = 3;
    }
    else if ( xbnd2 < y )
    {
      n = 2;
    }
    else
    {
      n = 1;
    }

    t = ( y - tanp8[n-1] ) / ( 1.0E+00 + y * tanp8[n-1] );

    value = conpi8[n-1] + ( pi8[n-1] + t * ( 0.75E+00 +
      r4_csevl ( 50.0E+00 * t * t - 1.0E+00, atancs, nterms ) ) );
  }
  else
  {
    value = conpi8[3] + pi8[3];

    if ( y < xbig )
    {
      value = conpi8[3] + ( pi8[3] - ( 0.75E+00 +
        r4_csevl ( 50.0E+00 / y / y - 1.0E+00, atancs, 
        nterms ) ) / y );
    }
  }

  if ( x < 0.0E+00 )
  {
    value = - fabs ( value );
  }
  else
  {
    value = + fabs ( value );
  }
  return value;
}
/******************************************************************************/

float r4_atan2 ( float sn, float cs )

/******************************************************************************/
/*
  Purpose:

    R4_ATAN2 evaluates the arc-tangent of two R4 arguments.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, double SN, CS, the Y and X coordinates of a point on the angle.

    Output, double R4_ATAN2, the arc-tangent of the angle.
*/
{
  float abscs;
  float abssn;
  static float big = 0.0;
  const float pi = 3.14159265358979323846E+00;
  static float sml = 0.0;
  float value;

  if ( sml == 0.0E+00 )
  {
    sml = r4_mach ( 1 );
    big = r4_mach ( 2 );
  }
/*
  We now make sure SN can be divided by CS.  It is painful.
*/
  abssn = fabs ( sn );
  abscs = fabs ( cs );

  if ( abscs <= abssn )
  {
    if ( abscs < 1.0E+00 && abscs * big <= abssn )
    {
      if ( sn < 0.0E+00 )
      {
        value = - 0.5E+00 * pi;
      }
      else if ( sn == 0.0E+00 )
      {
        fprintf ( stderr, "\n" );
        fprintf ( stderr, "R4_ATAN2 - Fatal error!\n" );
        fprintf ( stderr, "  Both arguments are 0.\n" );
        exit ( 1 );
      }
      else
      {
        value = 0.5E+00 * pi;
      }
      return value;
    }
  }
  else
  {
    if ( 1.0E+00 < abscs && abssn <= abscs * sml )
    {
      if ( 0.0E+00 <= cs )
      {
        value = 0.0E+00;
      }
      else
      {
        value = pi;
      }
      return value;
    }
  }

  value = atan ( sn / cs );

  if ( cs < 0.0E+00 )
  {
    value = value + pi;
  }

  if ( pi < value )
  {
    value = value - 2.0E+00 * pi;
  }
  return value;
}
/******************************************************************************/

float r4_atanh ( float x )

/******************************************************************************/
/*
  Purpose:

    R4_ATANH evaluates the arc-hyperbolic tangent of an R4 argument.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, float X, the argument.

    Output, float R4_ATANH, the arc-hyperbolic tangent of X.
*/
{
  static float atnhcs[15] = {
    0.094395102393195492E+00,
    0.049198437055786159E+00,
    0.002102593522455432E+00,
    0.000107355444977611E+00,
    0.000005978267249293E+00,
    0.000000350506203088E+00,
    0.000000021263743437E+00,
    0.000000001321694535E+00,
    0.000000000083658755E+00,
    0.000000000005370503E+00,
    0.000000000000348665E+00,
    0.000000000000022845E+00,
    0.000000000000001508E+00,
    0.000000000000000100E+00,
    0.000000000000000006E+00 };
  static int nterms = 0;
  static float sqeps = 0.0;
  float value;
  float y;

  if ( nterms == 0 )
  {
    nterms = r4_inits ( atnhcs, 15, 0.1E+00 * r4_mach ( 3 ) );
    sqeps = sqrt ( 3.0E+00 * r4_mach ( 3 ) );
  }

  y = fabs ( x );

  if ( y <= sqeps )
  {
    value = x;
  }
  else if ( y <= 0.5E+00 )
  {
    value = x * ( 1.0E+00 
      + r4_csevl ( 8.0E+00 * x * x - 1.0E+00, atnhcs, nterms ) );
  }
  else if ( y < 1.0E+00 )
  {
    value = 0.5E+00 * log ( ( 1.0E+00 + x ) / ( 1.0E+00 - x ) );
  }
  else
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R4_ATANH - Fatal error!\n" );
    fprintf ( stderr, "  1 <= |X|.\n" );
    exit ( 1 );
  }
  return value;
}
/******************************************************************************/

float r4_besi0 ( float x )

/******************************************************************************/
/*
  Purpose:

    R4_BESI0 evaluates the Bessel function I of order 0 of an R4 argument.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, float X, the argument.

    Output, float R4_BESI0, the Bessel function I of order 0 of X.
*/
{
  static float bi0cs[12] = {
   -0.07660547252839144951E+00,
    1.927337953993808270E+00,
    0.2282644586920301339E+00,
    0.01304891466707290428E+00,
    0.00043442709008164874E+00,
    0.00000942265768600193E+00,
    0.00000014340062895106E+00,
    0.00000000161384906966E+00,
    0.00000000001396650044E+00,
    0.00000000000009579451E+00,
    0.00000000000000053339E+00,
    0.00000000000000000245E+00 };
  static int nti0 = 0;
  float value;
  static float xmax = 0.0;
  static float xsml = 0.0;
  float y;

  if ( nti0 == 0 )
  {
    nti0 = r4_inits ( bi0cs, 12, 0.1E+00 * r4_mach ( 3 ) );
    xsml = sqrt ( 4.0E+00 * r4_mach ( 3 ) );
    xmax = log ( r4_mach ( 2 ) );
  }

  y = fabs ( x );

  if ( y <= xsml )
  {
    value = 1.0E+00;
  }
  else if ( y <= 3.0E+00 )
  {
    value = 2.75E+00 + r4_csevl ( y * y / 4.5E+00 - 1.0E+00, 
      bi0cs, nti0 );
  }
  else if ( y <= xmax )
  {
    value = exp ( y ) * r4_besi0e ( x );
  }
  else
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R4_BESI0 - Fatal error!\n" );
    fprintf ( stderr, "  Result overflows.\n" );
    fprintf ( stderr, "  |X| too large.\n" );
    exit ( 1 );
  }
  return value;
}
/******************************************************************************/

float r4_besi0e ( float x )

/******************************************************************************/
/*
  Purpose:

    R4_BESI0E evaluates the exponentially scaled Bessel function I0(X).

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, float X, the argument.

    Output, float R4_BESI0E, the exponentially scaled Bessel 
    function I0(X).
*/
{
  static float ai02cs[22] = {
    0.05449041101410882E+00,
    0.00336911647825569E+00,
    0.00006889758346918E+00,
    0.00000289137052082E+00,
    0.00000020489185893E+00,
    0.00000002266668991E+00,
    0.00000000339623203E+00,
    0.00000000049406022E+00,
    0.00000000001188914E+00,
   -0.00000000003149915E+00,
   -0.00000000001321580E+00,
   -0.00000000000179419E+00,
    0.00000000000071801E+00,
    0.00000000000038529E+00,
    0.00000000000001539E+00,
   -0.00000000000004151E+00,
   -0.00000000000000954E+00,
    0.00000000000000382E+00,
    0.00000000000000176E+00,
   -0.00000000000000034E+00,
   -0.00000000000000027E+00,
    0.00000000000000003E+00 };
  static float ai0cs[21] = {
    0.07575994494023796E+00,
    0.00759138081082334E+00,
    0.00041531313389237E+00,
    0.00001070076463439E+00,
   -0.00000790117997921E+00,
   -0.00000078261435014E+00,
    0.00000027838499429E+00,
    0.00000000825247260E+00,
   -0.00000001204463945E+00,
    0.00000000155964859E+00,
    0.00000000022925563E+00,
   -0.00000000011916228E+00,
    0.00000000001757854E+00,
    0.00000000000112822E+00,
   -0.00000000000114684E+00,
    0.00000000000027155E+00,
   -0.00000000000002415E+00,
   -0.00000000000000608E+00,
    0.00000000000000314E+00,
   -0.00000000000000071E+00,
    0.00000000000000007E+00 };
  static float bi0cs[12] = {
   -0.07660547252839144951E+00,
    1.927337953993808270E+00,
    0.2282644586920301339E+00,
    0.01304891466707290428E+00,
    0.00043442709008164874E+00,
    0.00000942265768600193E+00,
    0.00000014340062895106E+00,
    0.00000000161384906966E+00,
    0.00000000001396650044E+00,
    0.00000000000009579451E+00,
    0.00000000000000053339E+00,
    0.00000000000000000245E+00 };
  static int ntai0 = 0;
  static int ntai02 = 0;
  static int nti0 = 0;
  float value;
  static float xsml = 0.0;
  float y;

  if ( nti0 == 0 )
  {
    nti0 = r4_inits ( bi0cs, 12, 0.1E+00 * r4_mach ( 3 ) );
    ntai0 = r4_inits ( ai0cs, 21, 0.1E+00 * r4_mach ( 3 ) );
    ntai02 = r4_inits ( ai02cs, 22, 0.1E+00 * r4_mach ( 3 ) );
    xsml = sqrt ( 4.0E+00 * r4_mach ( 3 ) );
  }

  y = fabs ( x );

  if ( y <= xsml )
  {
    value = 1.0E+00;
  }
  else if ( y <= 3.0E+00 )
  {
    value = exp ( - y ) * ( 2.75E+00 +
      r4_csevl ( y * y / 4.5E+00 - 1.0E+00, bi0cs, nti0 ) );
  }
  else if ( y <= 8.0E+00 )
  {
    value = ( 0.375E+00 + r4_csevl 
      ( ( 48.0E+00 / y - 11.0E+00 ) / 5.0E+00, ai0cs, ntai0 ) ) 
      / sqrt ( y );
  }
  else
  {
    value = ( 0.375E+00 + r4_csevl 
      ( 16.0E+00 / y - 1.0E+00, ai02cs, ntai02 ) ) / sqrt ( y );
  }
  return value;
}
/******************************************************************************/

float r4_besi1 ( float x )

/******************************************************************************/
/*
  Purpose:

    R4_BESI1 evaluates the Bessel function I of order 1 of an R4 argument.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, float X, the argument.

    Output, float R4_BESI1, the Bessel function I of order 1 of X.
*/
{
  static float bi1cs[11] = {
   -0.001971713261099859E+00,
    0.40734887667546481E+00,
    0.034838994299959456E+00,
    0.001545394556300123E+00,
    0.000041888521098377E+00,
    0.000000764902676483E+00,
    0.000000010042493924E+00,
    0.000000000099322077E+00,
    0.000000000000766380E+00,
    0.000000000000004741E+00,
    0.000000000000000024E+00 };
  static int nti1 = 0;
  float value;
  static float xmax = 0.0;
  static float xmin = 0.0;
  static float xsml = 0.0;
  float y;

  if ( nti1 == 0 )
  {
    nti1 = r4_inits ( bi1cs, 11, 0.1E+00 * r4_mach ( 3 ) );
    xmin = 2.0E+00 * r4_mach ( 1 );
    xsml = sqrt ( 8.0E+00 * r4_mach ( 3 ) );
    xmax = log ( r4_mach ( 2 ) );
  }

  y = fabs ( x );

  if ( y <= xmin )
  {
    value = 0.0E+00;
  }
  else if ( y <= xsml )
  {
    value = 0.5E+00 * x;
  }
  else if ( y <= 3.0E+00 )
  {
    value = x * ( 0.875E+00 + r4_csevl 
      ( y * y / 4.5E+00 - 1.0E+00, bi1cs, nti1 ) );
  }
  else if ( y <= xmax )
  {
    value = exp ( y ) * r4_besi1e ( x );
  }
  else
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R4_BESI1 - Fatal error!\n" );
    fprintf ( stderr, "  Result overflows.\n" );
    exit ( 1 );
  }
  return value;
}
/******************************************************************************/

float r4_besi1e ( float x )

/******************************************************************************/
/*
  Purpose:

    R4_BESI1E: exponentially scaled Bessel function I of order 1 of an R4 argument.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, float X, the argument.

    Output, float R4_BESI1E, the exponentially scaled Bessel function I 
    of order 1 of X.
*/
{
  static float ai1cs[21] = {
   -0.02846744181881479E+00,
   -0.01922953231443221E+00,
   -0.00061151858579437E+00,
   -0.00002069971253350E+00,
    0.00000858561914581E+00,
    0.00000104949824671E+00,
   -0.00000029183389184E+00,
   -0.00000001559378146E+00,
    0.00000001318012367E+00,
   -0.00000000144842341E+00,
   -0.00000000029085122E+00,
    0.00000000012663889E+00,
   -0.00000000001664947E+00,
   -0.00000000000166665E+00,
    0.00000000000124260E+00,
   -0.00000000000027315E+00,
    0.00000000000002023E+00,
    0.00000000000000730E+00,
   -0.00000000000000333E+00,
    0.00000000000000071E+00,
   -0.00000000000000006E+00 };
  static float ai12cs[22] = {
    0.02857623501828014E+00,
   -0.00976109749136147E+00,
   -0.00011058893876263E+00,
   -0.00000388256480887E+00,
   -0.00000025122362377E+00,
   -0.00000002631468847E+00,
   -0.00000000383538039E+00,
   -0.00000000055897433E+00,
   -0.00000000001897495E+00,
    0.00000000003252602E+00,
    0.00000000001412580E+00,
    0.00000000000203564E+00,
   -0.00000000000071985E+00,
   -0.00000000000040836E+00,
   -0.00000000000002101E+00,
    0.00000000000004273E+00,
    0.00000000000001041E+00,
   -0.00000000000000382E+00,
   -0.00000000000000186E+00,
    0.00000000000000033E+00,
    0.00000000000000028E+00,
   -0.00000000000000003E+00 };
  static float bi1cs[11] = {
   -0.001971713261099859E+00,
    0.40734887667546481E+00,
    0.034838994299959456E+00,
    0.001545394556300123E+00,
    0.000041888521098377E+00,
    0.000000764902676483E+00,
    0.000000010042493924E+00,
    0.000000000099322077E+00,
    0.000000000000766380E+00,
    0.000000000000004741E+00,
    0.000000000000000024E+00 };
  static int ntai1 = 0;
  static int ntai12 = 0;
  static int nti1 = 0;
  float value;
  static float xmin = 0.0;
  static float xsml = 0.0;
  float y;

  if ( nti1 == 0 )
  {
    nti1 = r4_inits ( bi1cs, 11, 0.1E+00 * r4_mach ( 3 ) );
    ntai1 = r4_inits ( ai1cs, 21, 0.1E+00 * r4_mach ( 3 ) );
    ntai12 = r4_inits ( ai12cs, 22, 0.1E+00 * r4_mach ( 3 ) );
    xmin = 2.0E+00 * r4_mach ( 1 );
    xsml = sqrt ( 8.0E+00 * r4_mach ( 3 ) );
  }

  y = fabs ( x );

  if ( x == 0.0E+00 )
  {
    value = 0.0E+00;
  }
  else if ( y <= xmin )
  {
    value = 0.0E+00;
  }
  else if ( y <= xsml )
  {
    value = 0.5E+00 * x;
    value = exp ( - y ) * value;
  }
  else if ( y <= 3.0E+00 )
  {
    value = x * ( 0.875E+00 
      + r4_csevl ( y * y / 4.5E+00 - 1.0E+00, bi1cs, nti1 ) );
    value = exp ( - y ) * value;
  }
  else if ( y <= 8.0E+00 )
  {
    value = ( 0.375E+00 + r4_csevl ( ( 48.0E+00 / y - 11.0E+00 ) / 5.0E+00, 
      ai1cs, ntai1) ) / sqrt ( y );
    if ( x < 0.0E+00 )
    {
      value = - value;
    }
  }
  else
  {
    value = ( 0.375E+00 
      + r4_csevl ( 16.0E+00 / y - 1.0E+00, ai12cs, ntai12 ) ) / sqrt ( y );
    if ( x < 0.0E+00 )
    {
      value = - value;
    }
  }

  return value;
}
/******************************************************************************/

float r4_besj0 ( float x )

/******************************************************************************/
/*
  Purpose:

    R4_BESJ0 evaluates the Bessel function J of order 0 of an R4 argument.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, float X, the argument.

    Output, float R4_BESJ0, the Bessel function J of order 0 of X.
*/
{
  float ampl;
  static float bj0cs[13] = {
    0.100254161968939137E+00,
   -0.665223007764405132E+00,
    0.248983703498281314E+00,
   -0.0332527231700357697E+00,
    0.0023114179304694015E+00,
   -0.0000991127741995080E+00,
    0.0000028916708643998E+00,
   -0.0000000612108586630E+00,
    0.0000000009838650793E+00,
   -0.0000000000124235515E+00,
    0.0000000000001265433E+00,
   -0.0000000000000010619E+00,
    0.0000000000000000074E+00 };
  static float bm0cs[21] = {
    0.09284961637381644E+00,
   -0.00142987707403484E+00,
    0.00002830579271257E+00,
   -0.00000143300611424E+00,
    0.00000012028628046E+00,
   -0.00000001397113013E+00,
    0.00000000204076188E+00,
   -0.00000000035399669E+00,
    0.00000000007024759E+00,
   -0.00000000001554107E+00,
    0.00000000000376226E+00,
   -0.00000000000098282E+00,
    0.00000000000027408E+00,
   -0.00000000000008091E+00,
    0.00000000000002511E+00,
   -0.00000000000000814E+00,
    0.00000000000000275E+00,
   -0.00000000000000096E+00,
    0.00000000000000034E+00,
   -0.00000000000000012E+00,
    0.00000000000000004E+00 };
  static float bth0cs[24] = {
   -0.24639163774300119E+00,
    0.001737098307508963E+00,
   -0.000062183633402968E+00,
    0.000004368050165742E+00,
   -0.000000456093019869E+00,
    0.000000062197400101E+00,
   -0.000000010300442889E+00,
    0.000000001979526776E+00,
   -0.000000000428198396E+00,
    0.000000000102035840E+00,
   -0.000000000026363898E+00,
    0.000000000007297935E+00,
   -0.000000000002144188E+00,
    0.000000000000663693E+00,
   -0.000000000000215126E+00,
    0.000000000000072659E+00,
   -0.000000000000025465E+00,
    0.000000000000009229E+00,
   -0.000000000000003448E+00,
    0.000000000000001325E+00,
   -0.000000000000000522E+00,
    0.000000000000000210E+00,
   -0.000000000000000087E+00,
    0.000000000000000036E+00 };
  static int ntj0 = 0;
  static int ntm0 = 0;
  static int ntth0 = 0;
  static float pi4 = 0.78539816339744831E+00;
  float theta;
  float value;
  static float xsml = 0.0;
  float y;
  float z;

  if ( ntj0 == 0 )
  {
    ntj0 = r4_inits ( bj0cs, 13, 0.1E+00 * r4_mach ( 3 ) );
    ntm0 = r4_inits ( bm0cs, 21, 0.1E+00 * r4_mach ( 3 ) );
    ntth0 = r4_inits ( bth0cs, 24, 0.1E+00 * r4_mach ( 3 ) );
    xsml = sqrt ( 4.0E+00 * r4_mach ( 3 ) );
  }

  y = fabs ( x );
 
  if ( y <= xsml )
  {
    value = 1.0E+00;
  }
  else if ( y <= 4.0E+00 )
  {
    value = r4_csevl ( 0.125E+00 * y * y - 1.0E+00, bj0cs, ntj0 );
  }
  else
  {
    z = 32.0E+00 / y / y - 1.0E+00;
    ampl = ( 0.75E+00 + r4_csevl ( z, bm0cs, ntm0 ) ) / sqrt ( y );
    theta = y - pi4 + r4_csevl ( z, bth0cs, ntth0 ) / y;
    value = ampl * cos ( theta );
  }

  return value;
}
/******************************************************************************/

float r4_besj1 ( float x )

/******************************************************************************/
/*
  Purpose:

    R4_BESJ1 evaluates the Bessel function J of order 1 of an R4 argument.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, float X, the argument.

    Output, float R4_BESJ1, the Bessel function J of order 1 of X.
*/
{
  float ampl;
  static float bj1cs[12] = {
   -0.11726141513332787E+00,
   -0.25361521830790640E+00,
   +0.050127080984469569E+00,
   -0.004631514809625081E+00,
   +0.000247996229415914E+00,
   -0.000008678948686278E+00,
   +0.000000214293917143E+00,
   -0.000000003936093079E+00,
   +0.000000000055911823E+00,
   -0.000000000000632761E+00,
   +0.000000000000005840E+00,
   -0.000000000000000044E+00 };
  static float bm1cs[21] = {
   +0.1047362510931285E+00,
   +0.00442443893702345E+00,
   -0.00005661639504035E+00,
   +0.00000231349417339E+00,
   -0.00000017377182007E+00,
   +0.00000001893209930E+00,
   -0.00000000265416023E+00,
   +0.00000000044740209E+00,
   -0.00000000008691795E+00,
   +0.00000000001891492E+00,
   -0.00000000000451884E+00,
   +0.00000000000116765E+00,
   -0.00000000000032265E+00,
   +0.00000000000009450E+00,
   -0.00000000000002913E+00,
   +0.00000000000000939E+00,
   -0.00000000000000315E+00,
   +0.00000000000000109E+00,
   -0.00000000000000039E+00,
   +0.00000000000000014E+00,
   -0.00000000000000005E+00 };
  static float bth1cs[24] = {
   +0.74060141026313850E+00,
   -0.004571755659637690E+00,
   +0.000119818510964326E+00,
   -0.000006964561891648E+00,
   +0.000000655495621447E+00,
   -0.000000084066228945E+00,
   +0.000000013376886564E+00,
   -0.000000002499565654E+00,
   +0.000000000529495100E+00,
   -0.000000000124135944E+00,
   +0.000000000031656485E+00,
   -0.000000000008668640E+00,
   +0.000000000002523758E+00,
   -0.000000000000775085E+00,
   +0.000000000000249527E+00,
   -0.000000000000083773E+00,
   +0.000000000000029205E+00,
   -0.000000000000010534E+00,
   +0.000000000000003919E+00,
   -0.000000000000001500E+00,
   +0.000000000000000589E+00,
   -0.000000000000000237E+00,
   +0.000000000000000097E+00,
   -0.000000000000000040E+00 };
  static int ntj1 = 0;
  static int ntm1 = 0;
  static int ntth1 = 0;
  static float pi4 = 0.78539816339744831E+00;
  float theta;
  float value;
  static float xmin = 0.0;
  static float xsml = 0.0;
  float y;
  float z;

  if ( ntj1 == 0 )
  {
    ntj1 = r4_inits ( bj1cs, 12, 0.1E+00 * r4_mach ( 3 ) );
    ntm1 = r4_inits ( bm1cs, 21, 0.1E+00 * r4_mach ( 3 ) );
    ntth1 = r4_inits ( bth1cs, 24, 0.1E+00 * r4_mach ( 3 ) );
    xsml = sqrt ( 8.0E+00 * r4_mach ( 3 ) );
    xmin = 2.0E+00 * r4_mach ( 1 );
  }

  y = fabs ( x );

  if ( y <= xmin )
  {
    value = 0.0E+00;
  }
  else if ( y <= xsml )
  {
    value = 0.5E+00 * x;
  }
  else if ( y <= 4.0E+00 )
  {
    value = x * ( 0.25E+00 
      + r4_csevl ( 0.125E+00 * y * y - 1.0E+00, bj1cs, ntj1 ) );
  }
  else
  {
    z = 32.0E+00 / y / y - 1.0E+00;
    ampl = ( 0.75E+00 + r4_csevl ( z, bm1cs, ntm1 ) ) / sqrt ( y );
    theta = y - 3.0E+00 * pi4 + r4_csevl ( z, bth1cs, ntth1 ) / y;
    if ( x < 0.0E+00 )
    {
      value = - ampl * cos ( theta );
    }
    else
    {
      value = + ampl * cos ( theta );
    }
  }
  return value;
}
/******************************************************************************/

float r4_besk ( float nu, float x )

/******************************************************************************/
/*
  Purpose:

    R4_BESK evaluates the Bessel function K of order NU of an R4 argument.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    03 November 2012

  Author:

    John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, float NU, the order.

    Input, float X, the argument.

    Output, float R4_BESK, the Bessel function K of order NU at X.
*/
{
  float *bke;
  int nin;
  float value;
  float xnu;

  xnu = nu - ( int ) ( nu );
  nin = ( int ) ( nu ) + 1;
  bke = r4_besks ( xnu, x, nin );

  value = bke[nin-1];

  free ( bke );

  return value;
}
/******************************************************************************/

float r4_besk0 ( float x )

/******************************************************************************/
/*
  Purpose:

    R4_BESK0 evaluates the Bessel function K of order 0 of an R4 argument.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, float X, the argument.

    Output, float R4_BESK0, the Bessel function K of order 0 of X.
*/
{
  static float bk0cs[11] = {
   -0.03532739323390276872E+00,
    0.3442898999246284869E+00,
    0.03597993651536150163E+00,
    0.00126461541144692592E+00,
    0.00002286212103119451E+00,
    0.00000025347910790261E+00,
    0.00000000190451637722E+00,
    0.00000000001034969525E+00,
    0.00000000000004259816E+00,
    0.00000000000000013744E+00,
    0.00000000000000000035E+00 };
  static int ntk0 = 0;
  float value;
  static float xmax = 0.0;
  static float xsml = 0.0;
  float y;

  if ( ntk0 == 0 )
  {
    ntk0 = r4_inits ( bk0cs, 11, 0.1E+00 * r4_mach ( 3 ) );
    xsml = sqrt ( 4.0E+00 * r4_mach ( 3 ) );
    xmax = - log ( r4_mach ( 1 ) );
    xmax = xmax - 0.5E+00 * xmax * log ( xmax ) / ( xmax + 0.5E+00 ) - 0.01E+00;
  }

  if ( x <= 0.0E+00 )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R4_BESK0 = Fatal error!\n" );
    fprintf ( stderr, "  X <= 0.\n" );
    exit ( 1 );
  }
  else if ( x <= xsml )
  {
    y = 0.0E+00;
    value = - log ( 0.5E+00 * x ) * r4_besi0 ( x ) 
      - 0.25E+00 + r4_csevl ( 0.5E+00 * y - 1.0E+00, bk0cs, ntk0 );
  }
  else if ( x <= 2.0E+00 )
  {
    y = x * x;
    value = - log ( 0.5E+00 * x ) * r4_besi0 ( x ) 
      - 0.25E+00 + r4_csevl ( 0.5E+00 * y - 1.0E+00, bk0cs, ntk0 );
  }
  else if ( x <= xmax )
  {
    value = exp ( - x ) * r4_besk0e ( x );
  }
  else
  {
    value = 0.0E+00;
  }

  return value;
}
/******************************************************************************/

float r4_besk0e ( float x )

/******************************************************************************/
/*
  Purpose:

    R4_BESK0E evaluates the exponentially scaled Bessel function K0(X).

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, float X, the argument.

    Output, float R4_BESK0E, the exponentially scaled Bessel 
    function K0(X).
*/
{
  static float ak02cs[14] = {
   -0.01201869826307592E+00,
   -0.00917485269102569E+00,
   +0.00014445509317750E+00,
   -0.00000401361417543E+00,
   +0.00000015678318108E+00,
   -0.00000000777011043E+00,
   +0.00000000046111825E+00,
   -0.00000000003158592E+00,
   +0.00000000000243501E+00,
   -0.00000000000020743E+00,
   +0.00000000000001925E+00,
   -0.00000000000000192E+00,
   +0.00000000000000020E+00,
   -0.00000000000000002E+00 };
  static float ak0cs[17] = {
   -0.07643947903327941E+00,
   -0.02235652605699819E+00,
   +0.00077341811546938E+00,
   -0.00004281006688886E+00,
   +0.00000308170017386E+00,
   -0.00000026393672220E+00,
   +0.00000002563713036E+00,
   -0.00000000274270554E+00,
   +0.00000000031694296E+00,
   -0.00000000003902353E+00,
   +0.00000000000506804E+00,
   -0.00000000000068895E+00,
   +0.00000000000009744E+00,
   -0.00000000000001427E+00,
   +0.00000000000000215E+00,
   -0.00000000000000033E+00,
   +0.00000000000000005E+00 };
  static float bk0cs[11] = {
   -0.03532739323390276872E+00,
   +0.3442898999246284869E+00,
   +0.03597993651536150163E+00,
   +0.00126461541144692592E+00,
   +0.00002286212103119451E+00,
   +0.00000025347910790261E+00,
   +0.00000000190451637722E+00,
   +0.00000000001034969525E+00,
   +0.00000000000004259816E+00,
   +0.00000000000000013744E+00,
   +0.00000000000000000035E+00 };
  static int ntak0 = 0;
  static int ntak02 = 0;
  static int ntk0 = 0;
  float value;
  static float xsml = 0.0;
  float y;

  if ( ntk0 == 0 )
  {
    ntk0 = r4_inits ( bk0cs, 11, 0.1E+00 * r4_mach ( 3 ) );
    ntak0 = r4_inits ( ak0cs, 17, 0.1E+00 * r4_mach ( 3 ) );
    ntak02 = r4_inits ( ak02cs, 14, 0.1E+00 * r4_mach ( 3 ) );
    xsml = sqrt ( 4.0E+00 * r4_mach ( 3 ) );
  }

  if ( x <= 0.0E+00 )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R4_BESK0E - Fatal error!\n" );
    fprintf ( stderr, "  X <= 0.\n" );
    exit ( 1 );
  }
  else if ( x <= xsml )
  {
    y = 0.0E+00;
    value = exp ( x ) * ( - log ( 0.5E+00 * x ) * r4_besi0 ( x ) - 0.25E+00 
      + r4_csevl ( 0.5E+00 * y - 1.0E+00, bk0cs, ntk0 ) );
  }
  else if ( x <= 2.0E+00 )
  {
    y = x * x;
    value = exp ( x ) * ( - log ( 0.5E+00 * x ) * r4_besi0 ( x ) - 0.25E+00 
      + r4_csevl ( 0.5E+00 * y - 1.0E+00, bk0cs, ntk0 ) );
  }
  else if ( x <= 8.0E+00 )
  {
    value = ( 1.25E+00 + r4_csevl ( ( 16.0E+00 / x - 5.0E+00 ) / 3.0E+00, 
      ak0cs, ntak0 ) ) / sqrt ( x );
  }
  else
  {
    value = ( 1.25E+00 
      + r4_csevl ( 16.0E+00 / x - 1.0E+00, ak02cs, ntak02 ) ) / sqrt ( x );
  }
  return value;
}
/******************************************************************************/

float r4_besk1 ( float x )

/******************************************************************************/
/*
  Purpose:

    R4_BESK1 evaluates the Bessel function K of order 1 of an R4 argument.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, float X, the argument.

    Output, float R4_BESK1, the Bessel function K of order 1 of X.
*/
{
  static float bk1cs[11] = {
    0.0253002273389477705E+00,
   -0.353155960776544876E+00,
   -0.122611180822657148E+00,
   -0.0069757238596398643E+00,
   -0.0001730288957513052E+00,
   -0.0000024334061415659E+00,
   -0.0000000221338763073E+00,
   -0.0000000001411488392E+00,
   -0.0000000000006666901E+00,
   -0.0000000000000024274E+00,
   -0.0000000000000000070E+00 };
  static int ntk1 = 0;
  float value;
  static float xmax = 0.0;
  static float xsml = 0.0;
  float y;

  if ( ntk1 == 0 )
  {
    ntk1 = r4_inits ( bk1cs, 11, 0.1E+00 * r4_mach ( 3 ) );
    xsml = sqrt ( 4.0E+00 * r4_mach ( 3 ) );
    xmax = - log ( r4_mach ( 1 ) );
    xmax = xmax - 0.5E+00 * xmax * log ( xmax )
      / ( xmax + 0.5E+00 ) - 0.01E+00;
  }

  if ( x <= 0.0E+00 )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R4_BESK1 = Fatal error!\n" );
    fprintf ( stderr, "  X <= 0.\n" );
    exit ( 1 );
  }
  else if ( x <= xsml )
  {
    y = 0.0E+00;
    value = log ( 0.5E+00 * x ) * r4_besi1 ( x ) + ( 0.75E+00 
      + r4_csevl ( 0.5E+00 * y - 1.0E+00, bk1cs, ntk1 ) ) / x;
  }
  else if ( x <= 2.0E+00 )
  {
    y = x * x;
    value = log ( 0.5E+00 * x ) * r4_besi1 ( x ) + ( 0.75E+00 
      + r4_csevl ( 0.5E+00 * y - 1.0E+00, bk1cs, ntk1 ) ) / x;
  }
  else if ( x <= xmax )
  {
    value = exp ( - x ) * r4_besk1e ( x );
  }
  else
  {
    value = 0.0E+00;
  }
  return value;
}
/******************************************************************************/

float r4_besk1e ( float x )

/******************************************************************************/
/*
  Purpose:

    R4_BESK1E evaluates the exponentially scaled Bessel function K1(X).

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, float X, the argument.

    Output, float R4_BESK1E, the exponentially scaled Bessel 
    function K1(X).
*/
{
  static float ak12cs[14] = {
   +0.06379308343739001E+00,
   +0.02832887813049721E+00,
   -0.00024753706739052E+00,
   +0.00000577197245160E+00,
   -0.00000020689392195E+00,
   +0.00000000973998344E+00,
   -0.00000000055853361E+00,
   +0.00000000003732996E+00,
   -0.00000000000282505E+00,
   +0.00000000000023720E+00,
   -0.00000000000002176E+00,
   +0.00000000000000215E+00,
   -0.00000000000000022E+00,
   +0.00000000000000002E+00 };
  static float ak1cs[17] = {
   +0.2744313406973883E+00,
   +0.07571989953199368E+00,
   -0.00144105155647540E+00,
   +0.00006650116955125E+00,
   -0.00000436998470952E+00,
   +0.00000035402774997E+00,
   -0.00000003311163779E+00,
   +0.00000000344597758E+00,
   -0.00000000038989323E+00,
   +0.00000000004720819E+00,
   -0.00000000000604783E+00,
   +0.00000000000081284E+00,
   -0.00000000000011386E+00,
   +0.00000000000001654E+00,
   -0.00000000000000248E+00,
   +0.00000000000000038E+00,
   -0.00000000000000006E+00 };
  static float bk1cs[11] = {
   +0.0253002273389477705E+00,
   -0.353155960776544876E+00,
   -0.122611180822657148E+00,
   -0.0069757238596398643E+00,
   -0.0001730288957513052E+00,
   -0.0000024334061415659E+00,
   -0.0000000221338763073E+00,
   -0.0000000001411488392E+00,
   -0.0000000000006666901E+00,
   -0.0000000000000024274E+00,
   -0.0000000000000000070E+00 };
  static int ntak1 = 0;
  static int ntak12 = 0;
  static int ntk1 = 0;
  float value;
  static float xsml = 0.0;
  float y;

  if ( ntk1 == 0 )
  {
    ntk1 = r4_inits ( bk1cs, 11, 0.1E+00 * r4_mach ( 3 ) );
    ntak1 = r4_inits ( ak1cs, 17, 0.1E+00 * r4_mach ( 3 ) );
    ntak12 = r4_inits ( ak12cs, 14, 0.1E+00 * r4_mach ( 3 ) );
    xsml = sqrt ( 4.0E+00 * r4_mach ( 3 ) );
  }

  if ( x <= 0.0E+00 )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R4_BESK1E = Fatal error!\n" );
    fprintf ( stderr, "  X <= 0.\n" );
    exit ( 1 );
  }
  else if ( x <= xsml )
  {
    y = 0.0E+00;
    value = exp ( x ) * ( log ( 0.5E+00 * x ) * r4_besi1 ( x ) 
      + ( 0.75E+00 
      + r4_csevl ( 0.5E+00 * y - 1.0E+00, bk1cs, ntk1 ) ) / x );
  }
  else if ( x <= 2.0E+00 )
  {
    y = x * x;
    value = exp ( x ) * ( log ( 0.5E+00 * x ) * r4_besi1 ( x ) + ( 0.75E+00 
      + r4_csevl ( 0.5E+00 * y - 1.0E+00, bk1cs, ntk1 ) ) / x );
  }
  else if ( x <= 8.0E+00 )
  {
    value = ( 1.25E+00 + r4_csevl ( ( 16.0E+00 / x - 5.0E+00 ) / 3.0E+00, 
      ak1cs, ntak1 ) ) / sqrt ( x );
  }
  else
  {
    value = ( 1.25E+00 
      + r4_csevl ( 16.E+00 / x - 1.0E+00, ak12cs, ntak12 ) ) / sqrt ( x );
  }
  return value;
}
/******************************************************************************/

float *r4_beskes ( float xnu, float x, int nin )

/******************************************************************************/
/*
  Purpose:

    R4_BESKES evaluates a sequence of exponentially scaled K Bessel functions at X.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, float XNU, the order of the first function.
    |XNU| < 1.

    Input, float X, the argument.

    Input, int NIN, the absolute value of NIN indicates the number of terms to compute.
    If NIN < 0, successive values of NU count DOWN from XNU.
    If NIN > 0, successive values of NU count UP from XNU.

    Output, float R4_BESKES[abs(NIN)], the exponentially scaled K Bessel functions.
*/
{
  float *bke;
  float bknu1;
  float direct;
  int i;
  int iswtch;
  int n;
  float v;
  float vincr;

  v = fabs ( xnu );
  n = abs ( nin );

  if ( 1.0E+00 <= v )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R4_BESKES - Fatal error!\n" );
    fprintf ( stderr, "  |XNU| must be less than 1.\n" );
    exit ( 1 );
  }

  if ( x <= 0.0E+00 )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R4_BESKES - Fatal error!\n" );
    fprintf ( stderr, "  X <= 0.\n" );
    exit ( 1 );
  }

  if ( n == 0 )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R4_BESKES - Fatal error!\n" );
    fprintf ( stderr, "  N = 0.\n" );
    exit ( 1 );
  }

  bke = ( float * ) malloc ( abs ( nin ) * sizeof ( float ) );

  r4_knus ( v, x, &bke[0], &bknu1, &iswtch );

  if ( n == 1 )
  {
    return bke;
  }

  if ( nin < 0 )
  {
    vincr = - 1.0E+00;
  }
  else
  {
    vincr = + 1.0E+00;
  }

  if ( xnu < 0.0E+00 )
  {
    direct = - vincr;
  }
  else
  {
    direct = vincr;
  }

  bke[1] = bknu1;

  if ( direct < 0.0E+00 )
  {
    r4_knus ( fabs ( xnu + vincr ), x, &bke[1], &bknu1, &iswtch );
  }

  if ( n == 2 )
  {
    return bke;
  }

  v = xnu;
  for ( i = 2; i < n; i++ )
  {
    v = v + vincr;
    bke[i] = 2.0E+00 * v * bke[i-1] / x + bke[i-2];
  }
  return bke;
}
/******************************************************************************/

float *r4_besks ( float xnu, float x, int nin )

/******************************************************************************/
/*
  Purpose:

    R4_BESKS evaluates a sequence of K Bessel functions at X.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, float XNU, the order of the first function.
    |XNU| < 1.

    Input, float X, the argument.

    Input, int NIN, the absolute value of NIN indicates the number of terms to compute.
    If NIN < 0, successive values of NU count DOWN from XNU.
    If NIN > 0, successive values of NU count UP from XNU.

    Output, float R4_BESKS[abs(NIN)], the K Bessel functions.
*/
{
  float *bk;
  float expxi;
  int i;
  int n;
  static float xmax = 0.0;

  if ( xmax == 0.0E+00 )
  {
    xmax = - log ( r4_mach ( 1 ) );
    xmax = xmax + 0.5E+00 * log ( 3.14E+00 * 0.5E+00 / xmax );
  }

  bk = r4_beskes ( xnu, x, nin );

  expxi = exp ( - x );
  n = abs ( nin );

  for ( i = 0; i < n; i++ )
  {
    bk[i] = expxi * bk[i];
  }

  return bk;
}
/******************************************************************************/

float r4_besy0 ( float x )

/******************************************************************************/
/*
  Purpose:

    R4_BESY0 evaluates the Bessel function Y of order 0 of an R4 argument.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, float X, the argument.

    Output, float R4_BESY0, the Bessel function Y of order 0 of X.
*/
{
  static float alnhaf = -0.693147180559945309E+00;
  float ampl;
  static float bm0cs[21] = {
   +0.09284961637381644E+00,
   -0.00142987707403484E+00,
   +0.00002830579271257E+00,
   -0.00000143300611424E+00,
   +0.00000012028628046E+00,
   -0.00000001397113013E+00,
   +0.00000000204076188E+00,
   -0.00000000035399669E+00,
   +0.00000000007024759E+00,
   -0.00000000001554107E+00,
   +0.00000000000376226E+00,
   -0.00000000000098282E+00,
   +0.00000000000027408E+00,
   -0.00000000000008091E+00,
   +0.00000000000002511E+00,
   -0.00000000000000814E+00,
   +0.00000000000000275E+00,
   -0.00000000000000096E+00,
   +0.00000000000000034E+00,
   -0.00000000000000012E+00,
   +0.00000000000000004E+00 };
  static float bth0cs[24] = {
   -0.24639163774300119E+00,
   +0.001737098307508963E+00,
   -0.000062183633402968E+00,
   +0.000004368050165742E+00,
   -0.000000456093019869E+00,
   +0.000000062197400101E+00,
   -0.000000010300442889E+00,
   +0.000000001979526776E+00,
   -0.000000000428198396E+00,
   +0.000000000102035840E+00,
   -0.000000000026363898E+00,
   +0.000000000007297935E+00,
   -0.000000000002144188E+00,
   +0.000000000000663693E+00,
   -0.000000000000215126E+00,
   +0.000000000000072659E+00,
   -0.000000000000025465E+00,
   +0.000000000000009229E+00,
   -0.000000000000003448E+00,
   +0.000000000000001325E+00,
   -0.000000000000000522E+00,
   +0.000000000000000210E+00,
   -0.000000000000000087E+00,
   +0.000000000000000036E+00 };
  static float by0cs[13] = {
   -0.011277839392865573E+00,
   -0.12834523756042035E+00,
   -0.10437884799794249E+00,
   +0.023662749183969695E+00,
   -0.002090391647700486E+00,
   +0.000103975453939057E+00,
   -0.000003369747162423E+00,
   +0.000000077293842676E+00,
   -0.000000001324976772E+00,
   +0.000000000017648232E+00,
   -0.000000000000188105E+00,
   +0.000000000000001641E+00,
   -0.000000000000000011E+00 };
  static int ntm0 = 0;
  static int ntth0 = 0;
  static int nty0 = 0;
  static float pi4 = 0.78539816339744831E+00;
  float theta;
  static float twodpi = 0.63661977236758134E+00;
  float value;
  static float xsml = 0.0;
  float y;
  float z;

  if ( nty0 == 0 )
  {
    nty0 = r4_inits ( by0cs, 13, 0.1E+00 * r4_mach ( 3 ) );
    ntm0 = r4_inits ( bm0cs, 21, 0.1E+00 * r4_mach ( 3 ) );
    ntth0 = r4_inits ( bth0cs, 24, 0.1E+00 * r4_mach ( 3 ) );
    xsml = sqrt ( 4.0E+00 * r4_mach ( 3 ) );
  }

  if ( x <= 0.0E+00 )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R4_BESY0 - Fatal error!\n" );
    fprintf ( stderr, "  X <= 0.\n" );
    exit ( 1 );
  }
  else if ( x <= xsml )
  {
    y = 0.0E+00;
    value = twodpi * ( alnhaf + log ( x ) ) 
      * r4_besj0 ( x ) + 0.375E+00 
      + r4_csevl ( 0.125E+00 * y - 1.0E+00, by0cs, nty0 );
  }
  else if ( x <= 4.0E+00 )
  {
    y = x * x;
    value = twodpi * ( alnhaf + log ( x ) ) 
      * r4_besj0 ( x ) + 0.375E+00 
      + r4_csevl ( 0.125E+00 * y - 1.0E+00, by0cs, nty0 );
  }
  else 
  {
    z = 32.0E+00 / x / x - 1.0E+00;
    ampl = ( 0.75E+00 + r4_csevl ( z, bm0cs, ntm0 ) ) / sqrt ( x );
    theta = x - pi4 + r4_csevl (z, bth0cs, ntth0 ) / x;
    value = ampl * sin ( theta );
  }
  return value;
}
/******************************************************************************/

float r4_besy1 ( float x )

/******************************************************************************/
/*
  Purpose:

    R4_BESY1 evaluates the Bessel function Y of order 1 of an R4 argument.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, float X, the argument.

    Output, float R4_BESY1, the Bessel function Y of order 1 of X.
*/
{
  static float ampl;
  static float bm1cs[21] = {
   +0.1047362510931285E+00,
   +0.00442443893702345E+00,
   -0.00005661639504035E+00,
   +0.00000231349417339E+00,
   -0.00000017377182007E+00,
   +0.00000001893209930E+00,
   -0.00000000265416023E+00,
   +0.00000000044740209E+00,
   -0.00000000008691795E+00,
   +0.00000000001891492E+00,
   -0.00000000000451884E+00,
   +0.00000000000116765E+00,
   -0.00000000000032265E+00,
   +0.00000000000009450E+00,
   -0.00000000000002913E+00,
   +0.00000000000000939E+00,
   -0.00000000000000315E+00,
   +0.00000000000000109E+00,
   -0.00000000000000039E+00,
   +0.00000000000000014E+00,
   -0.00000000000000005E+00 };
  static float bth1cs[24] = {
   +0.74060141026313850E+00,
   -0.004571755659637690E+00,
   +0.000119818510964326E+00,
   -0.000006964561891648E+00,
   +0.000000655495621447E+00,
   -0.000000084066228945E+00,
   +0.000000013376886564E+00,
   -0.000000002499565654E+00,
   +0.000000000529495100E+00,
   -0.000000000124135944E+00,
   +0.000000000031656485E+00,
   -0.000000000008668640E+00,
   +0.000000000002523758E+00,
   -0.000000000000775085E+00,
   +0.000000000000249527E+00,
   -0.000000000000083773E+00,
   +0.000000000000029205E+00,
   -0.000000000000010534E+00,
   +0.000000000000003919E+00,
   -0.000000000000001500E+00,
   +0.000000000000000589E+00,
   -0.000000000000000237E+00,
   +0.000000000000000097E+00,
   -0.000000000000000040E+00 };
  static float by1cs[14] = {
   +0.03208047100611908629E+00,
   +1.262707897433500450E+00,
   +0.00649996189992317500E+00,
   -0.08936164528860504117E+00,
   +0.01325088122175709545E+00,
   -0.00089790591196483523E+00,
   +0.00003647361487958306E+00,
   -0.00000100137438166600E+00,
   +0.00000001994539657390E+00,
   -0.00000000030230656018E+00,
   +0.00000000000360987815E+00,
   -0.00000000000003487488E+00,
   +0.00000000000000027838E+00,
   -0.00000000000000000186E+00 };
  static int ntm1 = 0;
  static int ntth1 = 0;
  static int nty1 = 0;
  static float pi4 = 0.78539816339744831E+00;
  float theta;
  static float twodpi = 0.63661977236758134E+00;
  float value;
  static float xsml = 0.0;
  float y;
  float z;

  if ( nty1 == 0 )
  {
    nty1 = r4_inits ( by1cs, 14, 0.1E+00 * r4_mach ( 3 ) );
    ntm1 = r4_inits ( bm1cs, 21, 0.1E+00 * r4_mach ( 3 ) );
    ntth1 = r4_inits ( bth1cs, 24, 0.1E+00 * r4_mach ( 3 ) );
    xsml = sqrt ( 4.0E+00 * r4_mach ( 3 ) );
  }

  if ( x <= 0.0E+00 )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R4_BESY1 - Fatal error!\n" );
    fprintf ( stderr, "  X <= 0.\n" );
    exit ( 1 );
  }
  else if ( x <= xsml )
  {
    y = 0.0E+00;
    value = twodpi * log ( 0.5E+00 * x ) * r4_besj1 ( x ) 
      + ( 0.5E+00 + r4_csevl ( 0.125E+00 * y - 1.0E+00, by1cs, 
      nty1 ) ) / x;
  }
  else if ( x <= 4.0E+00 )
  {
    y = x * x;
    value = twodpi * log ( 0.5E+00 * x ) * r4_besj1 ( x ) 
      + ( 0.5E+00 + r4_csevl ( 0.125E+00 * y - 1.0E+00, by1cs, 
      nty1 ) ) / x;
  }
  else
  {
    z = 32.0E+00 / x / x - 1.0E+00;
    ampl = ( 0.75E+00 + r4_csevl ( z, bm1cs, ntm1 ) ) / sqrt ( x );
    theta = x - 3.0E+00 * pi4 + r4_csevl ( z, bth1cs, ntth1 ) / x;
    value = ampl * sin ( theta );
  }
  return value;
}
/******************************************************************************/

float r4_beta ( float a, float b )

/******************************************************************************/
/*
  Purpose:

    R4_BETA evaluates the beta function of R4 arguments.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, float A, B, the arguments.

    Output, float R4_BETA, the beta function of A and B.
*/
{
  float value;
  float xmax = 0.0;
  float xmin;

  if ( xmax == 0.0E+00 )
  {
    r4_gaml ( &xmin, &xmax );
  }

  if ( a <= 0.0E+00 || b <= 0.0E+00 )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R4_BETA - Fatal error!\n" );
    fprintf ( stderr, "  A and B must be greater than 0.\n" );
    exit ( 1 );
  }

  if ( a + b < xmax )
  {
    value = r4_gamma ( a ) * r4_gamma ( b ) / r4_gamma ( a + b );
    return value;
  }

  value = r4_lbeta ( a, b );

  value = exp ( value );

  return value;
}
/******************************************************************************/

float r4_betai ( float x, float pin, float qin )

/******************************************************************************/
/*
  Purpose:

    R4_BETAI evaluates the incomplete beta ratio of R4 arguments.

  Discussion:

    The incomplete Beta function ratio is the probability that a
    random variable from a beta distribution having parameters
    P and Q will be less than or equal to X.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Nancy Bosten, EL Battiste,
    Remark on Algorithm 179: 
    Incomplete Beta Ratio,
    Communications of the ACM,
    Volume 17, Number 3, March 1974, pages 156-157.

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, float X, the upper limit of integration.
    0.0 <= X <= 1.0.

    Input, float PIN, the first distribution parameter.
    0.0 < PIN.

    Input, float QIN, the second distribution parameter.
    0.0 < QIN.

    Output, float R4_BETAI, the incomplete beta function ratio.
*/
{
  static float alneps = 0.0;
  static float alnsml = 0.0;
  float c;
  static float eps = 0.0;
  float finsum;
  int i;
  int ib;
  int n;
  float p;
  float p1;
  float ps;
  float q;
  static float sml = 0.0;
  float term;
  float value;
  float xb;
  float y;

  if ( eps == 0.0E+00 )
  {
    eps = r4_mach ( 3 );
    alneps = log ( eps );
    sml = r4_mach ( 1 );
    alnsml = log ( sml );
  }

  if ( x < 0.0E+00 || 1.0E+00 < x )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R4_BETAI - Fatal error!\n" );
    fprintf ( stderr, "  0 <= X <= 1 is required.\n" );
    exit ( 1 );
  }

  if ( pin <= 0.0E+00 || qin <= 0.0E+00 )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R4_BETAI - Fatal error!\n" );
    fprintf ( stderr, "  P or Q <= 0.0.\n" );
    exit ( 1 );
  }

  y = x;
  p = pin;
  q = qin;

  if ( p < q || 0.8E+00 <= x )
  {
    if ( 0.2E+00 <= x )
    {
      y = 1.0E+00 - y;
      p = qin;
      q = pin;
    }
  }

  if ( ( p + q ) * y / ( p + 1.0E+00 ) < eps )
  {
    value = 0.0E+00;

    xb = p * log ( fmax ( y, sml ) ) - log ( p ) - r4_lbeta ( p, q );

    if ( alnsml < xb && y != 0.0E+00 )
    {
      value = exp ( xb );
    }

    if ( y != x || p != pin )
    {
      value = 1.0E+00 - value;
    }
    return value;
  }
/*
  Evaluate the infinite sum first.
  TERM will equal y^p/beta(ps,p) * (1.-ps)i * y**i / fac(i)
*/
  ps = q - r4_aint ( q );
  if ( ps == 0.0E+00 ) 
  {
    ps = 1.0E+00;
  }

  xb = p * log ( y ) - r4_lbeta ( ps, p ) - log ( p );

  if ( xb < alnsml )
  {
    value = 0.0E+00;
  }
  else
  {
    value = exp ( xb );
    term = value * p;

    if ( ps != 1.0E+00 )
    {
      n = ( int ) ( fmax ( alneps / log ( y ), 4.0E+00 ) );
      for ( i = 1; i <= n; i++ )
      {
        term = term * ( ( float ) ( i ) - ps ) * y / ( float ) ( i );
        value = value + term / ( p + ( float ) ( i ) );
      }
    }
  }
/*
  Now evaluate the finite sum.
*/
  if  ( 1.0E+00 < q )
  {
    xb = p * log ( y ) + q * log ( 1.0E+00 - y ) 
      - r4_lbeta ( p, q ) - log ( q );
    ib = ( int ) ( fmax ( xb / alnsml, 0.0E+00 ) );
    term = exp ( xb - ( float ) ( ib ) * alnsml );
    c = 1.0E+00 / ( 1.0E+00 - y );
    p1 = q * c / ( p + q - 1.0E+00 );

    finsum = 0.0E+00;
    n = ( int ) ( q );
    if ( q == ( float ) ( n ) )
    {
      n = n - 1;
    }

    for ( i = 1; i <= n; i++ )
    {
      if ( p1 <= 1.0E+00 && term / eps <= finsum )
      {
        break;
      }

      term = ( q - ( float ) ( i - 1 ) ) * c * term 
        / ( p + q - ( float ) ( i ) );

      if ( 1.0E+00 < term )
      {
        ib = ib - 1;
        term = term * sml;
      }

      if ( ib == 0 )
      {
        finsum = finsum + term;
      }
    }
    value = value + finsum;
  }

  if ( y != x || p != pin )
  {
    value = 1.0E+00 - value;
  }

  if ( value < 0.0E+00 )
  {
    value = 0.0E+00;
  }

  if ( 1.0E+00 < value )
  {
    value = 1.0E+00;
  }

  return value;
}
/******************************************************************************/

float r4_bi ( float x )

/******************************************************************************/
/*
  Purpose:

    R4_BI evaluates the Airy function Bi of an R4 argument.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, float X, the argument.

    Output, float R4_BI, the Airy function Bi of X.
*/
{
  static float bif2cs[10] = {
    0.09984572693816041E+00,
    0.478624977863005538E+00,
    0.0251552119604330118E+00,
    0.0005820693885232645E+00,
    0.0000074997659644377E+00,
    0.0000000613460287034E+00,
    0.0000000003462753885E+00,
    0.0000000000014288910E+00,
    0.0000000000000044962E+00,
    0.0000000000000000111E+00 };
  static float bifcs[9] = {
   -0.01673021647198664948E+00,
    0.1025233583424944561E+00,
    0.00170830925073815165E+00,
    0.00001186254546774468E+00,
    0.00000004493290701779E+00,
    0.00000000010698207143E+00,
    0.00000000000017480643E+00,
    0.00000000000000020810E+00,
    0.00000000000000000018E+00 };
  static float big2cs[10] = {
    0.033305662145514340E+00,
    0.161309215123197068E+00,
    0.0063190073096134286E+00,
    0.0001187904568162517E+00,
    0.0000013045345886200E+00,
    0.0000000093741259955E+00,
    0.0000000000474580188E+00,
    0.0000000000001783107E+00,
    0.0000000000000005167E+00,
    0.0000000000000000011E+00 };
  static float bigcs[8] = {
    0.02246622324857452E+00,
    0.03736477545301955E+00,
    0.00044476218957212E+00,
    0.00000247080756363E+00,
    0.00000000791913533E+00,
    0.00000000001649807E+00,
    0.00000000000002411E+00,
    0.00000000000000002E+00 };
  float eta;
  static int nbif = 0;
  static int nbif2 = 0;
  static int nbig = 0;
  static int nbig2 = 0;
  float theta;
  float value;
  static float x3sml = 0.0;
  float xm;
  float z;

  if ( nbif == 0 )
  {
    eta = 0.1E+00 * r4_mach ( 3 );
    nbif = r4_inits ( bifcs, 9, eta );
    nbig = r4_inits ( bigcs, 8, eta );
    nbif2 = r4_inits ( bif2cs, 10, eta );
    nbig2 = r4_inits ( big2cs, 10, eta );
    x3sml = r4_power ( eta, 0.3333E+00 );
  }

  if ( x <= - 1.0E+00 )
  {
    r4_aimp ( x, &xm, &theta );
    value = xm * sin ( theta );
  }
  else if ( fabs ( x ) <= x3sml )
  {
    z = 0.0E+00;

    value = 0.625E+00 + r4_csevl ( z, bifcs, nbif ) 
      + x * ( 0.4375E+00 + r4_csevl ( z, bigcs, nbig ) );
  }
  else if ( x <= 1.0E+00 )
  {
    z = x * x * x;
    value = 0.625E+00 + r4_csevl ( z, bifcs, nbif ) 
      + x * ( 0.4375E+00 + r4_csevl ( z, bigcs, nbig ) );
  }
  else if ( x <= 2.0E+00 )
  {
    z = ( 2.0E+00 * x * x * x - 9.0E+00 ) / 7.0E+00;
    value = 1.125E+00 + r4_csevl ( z, bif2cs, nbif2 ) 
      + x * ( 0.625E+00 + r4_csevl ( z, big2cs, nbig2 ) );
  }
  else
  {
    value = r4_bie ( x ) * exp ( 2.0E+00 * x * sqrt ( x ) / 3.0E+00 );
  }
  return value;
}
/******************************************************************************/

float r4_bid ( float x )

/******************************************************************************/
/*
  Purpose:

    R4_BID evaluates the derivative of the Airy function Bi of an R4 argument.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, float X, the argument.

    Output, float R4_BID, the derivative of the Airy function Bi of X.
*/
{
  static float bif2cs[10] = {
     0.323493987603522033521E+00,
     0.086297871535563559139E+00,
     0.002994025552655397426E+00,
     0.000051430528364661637E+00,
     0.000000525840250036811E+00,
     0.000000003561751373958E+00,
     0.000000000017146864007E+00,
     0.000000000000061663520E+00,
     0.000000000000000171911E+00,
     0.000000000000000000382E+00 };
  static float bifcs[8] = {
     0.1153536790828570243E+00,
     0.0205007894049192875E+00,
     0.0002135290278902876E+00,
     0.0000010783960614677E+00,
     0.0000000032094708833E+00,
     0.0000000000062930407E+00,
     0.0000000000000087403E+00,
     0.0000000000000000090E+00 };
  static float big2cs[10] = {
     1.6062999463621294578E+00,
     0.7449088819876088652E+00,
     0.0470138738610277380E+00,
     0.0012284422062548239E+00,
     0.0000173222412256624E+00,
     0.0000001521901652368E+00,
     0.0000000009113560249E+00,
     0.0000000000039547918E+00,
     0.0000000000000130017E+00,
     0.0000000000000000335E+00 };
  static float bigcs[9] = {
    -0.097196440416443537390E+00,
     0.149503576843167066571E+00,
     0.003113525387121326042E+00,
     0.000024708570579821297E+00,
     0.000000102949627731379E+00,
     0.000000000263970373987E+00,
     0.000000000000458279271E+00,
     0.000000000000000574283E+00,
     0.000000000000000000544E+00 };
  float eta;
  static int nbif = 0;
  static int nbif2 = 0;
  static int nbig = 0;
  static int nbig2 = 0;
  float phi;
  float value;
  float x2;
  static float x2sml = 0.0;
  float x3;
  static float x3sml = 0.0;
  float xn;
  float z;

  if ( nbif == 0 )
  {
    eta = 0.1E+00 * r4_mach ( 3 );
    nbif = r4_inits ( bifcs, 8, eta );
    nbig = r4_inits ( bigcs, 9, eta );
    nbif2 = r4_inits ( bif2cs, 10, eta );
    nbig2 = r4_inits ( big2cs, 10, eta );
    x2sml = sqrt ( eta );
    x3sml = r4_power ( eta, 0.3333E+00 );
  }

  if ( x < - 1.0E+00 )
  {
    r4_admp ( x, &xn, &phi );
    value = xn * sin ( phi );
  }
  else if ( fabs ( x ) <= x2sml )
  {
    x2 = 0.0E+00;
    x3 = 0.0E+00;
    value = x2 * ( r4_csevl ( x3, bifcs, nbif ) + 0.25E+00 ) 
      + r4_csevl ( x3, bigcs, nbig ) + 0.5E+00;
  }
  else if ( fabs ( x ) <= x3sml )
  {
    x2 = x * x;
    x3 = 0.0E+00;
    value = x2 * ( r4_csevl ( x3, bifcs, nbif ) + 0.25E+00 ) 
      + r4_csevl ( x3, bigcs, nbig ) + 0.5E+00;
  }
  else if ( x <= 1.0E+00 )
  {
    x2 = x * x;
    x3 = x * x * x;
    value = x2 * ( r4_csevl ( x3, bifcs, nbif ) + 0.25E+00 ) 
      + r4_csevl ( x3, bigcs, nbig ) + 0.5E+00;
  }
  else if ( x <= 2.0E+00 )
  {
    z = ( 2.0E+00 * x * x * x - 9.0E+00 ) / 7.0E+00;
    value = x * x * ( r4_csevl ( z, bif2cs, nbif2 ) + 0.25E+00 ) 
      + r4_csevl ( z, big2cs, nbig2 ) + 0.5E+00;
  }
  else
  {
    value = r4_bide ( x )
      * exp ( 2.0E+00 * x * sqrt ( x ) / 3.0E+00 );
  }
  return value;
}
/******************************************************************************/

float r4_bide ( float x )

/******************************************************************************/
/*
  Purpose:

    R4_BIDE: exponentially scaled derivative, Airy function Bi of an R4 argument.

  Discussion:

    if X < 0,
      R4_BIDE ( X ) = R4_BID ( X )
    else
      R4_BIDE ( X ) = R4_BID ( X ) * exp ( - 2/3 * X**(3/2) )

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, float X, the argument.

    Output, float R4_BIDE, the exponentially scaled derivative of 
    the Airy function Bi of X.
*/
{
  static float atr = 8.7506905708484345E+00;
  static float bif2cs[10] = {
     0.323493987603522033521E+00,
     0.086297871535563559139E+00,
     0.002994025552655397426E+00,
     0.000051430528364661637E+00,
     0.000000525840250036811E+00,
     0.000000003561751373958E+00,
     0.000000000017146864007E+00,
     0.000000000000061663520E+00,
     0.000000000000000171911E+00,
     0.000000000000000000382E+00 };
  static float bifcs[8] = {
     0.1153536790828570243E+00,
     0.0205007894049192875E+00,
     0.0002135290278902876E+00,
     0.0000010783960614677E+00,
     0.0000000032094708833E+00,
     0.0000000000062930407E+00,
     0.0000000000000087403E+00,
     0.0000000000000000090E+00 };
  static float big2cs[10] = {
     1.6062999463621294578E+00,
     0.7449088819876088652E+00,
     0.0470138738610277380E+00,
     0.0012284422062548239E+00,
     0.0000173222412256624E+00,
     0.0000001521901652368E+00,
     0.0000000009113560249E+00,
     0.0000000000039547918E+00,
     0.0000000000000130017E+00,
     0.0000000000000000335E+00 };
  static float bigcs[9] = {
    -0.097196440416443537390E+00,
     0.149503576843167066571E+00,
     0.003113525387121326042E+00,
     0.000024708570579821297E+00,
     0.000000102949627731379E+00,
     0.000000000263970373987E+00,
     0.000000000000458279271E+00,
     0.000000000000000574283E+00,
     0.000000000000000000544E+00 };
  static float bip1cs[24] = {
    -0.1729187351079553719E+00,
    -0.0149358492984694364E+00,
    -0.0005471104951678566E+00,
     0.0001537966292958408E+00,
     0.0000154353476192179E+00,
    -0.0000065434113851906E+00,
     0.0000003728082407879E+00,
     0.0000002072078388189E+00,
    -0.0000000658173336470E+00,
     0.0000000074926746354E+00,
     0.0000000011101336884E+00,
    -0.0000000007265140553E+00,
     0.0000000001782723560E+00,
    -0.0000000000217346352E+00,
    -0.0000000000020302035E+00,
     0.0000000000019311827E+00,
    -0.0000000000006044953E+00,
     0.0000000000001209450E+00,
    -0.0000000000000125109E+00,
    -0.0000000000000019917E+00,
     0.0000000000000015154E+00,
    -0.0000000000000004977E+00,
     0.0000000000000001155E+00,
    -0.0000000000000000186E+00 };
  static float bip2cs[29] = {
    -0.13269705443526630495E+00,
    -0.00568443626045977481E+00,
    -0.00015643601119611610E+00,
    -0.00001136737203679562E+00,
    -0.00000143464350991284E+00,
    -0.00000018098531185164E+00,
     0.00000000926177343611E+00,
     0.00000001710005490721E+00,
     0.00000000476698163504E+00,
    -0.00000000035195022023E+00,
    -0.00000000058890614316E+00,
    -0.00000000006678499608E+00,
     0.00000000006395565102E+00,
     0.00000000001554529427E+00,
    -0.00000000000792397000E+00,
    -0.00000000000258326243E+00,
     0.00000000000121655048E+00,
     0.00000000000038707207E+00,
    -0.00000000000022487045E+00,
    -0.00000000000004953477E+00,
     0.00000000000004563782E+00,
     0.00000000000000332998E+00,
    -0.00000000000000921750E+00,
     0.00000000000000094157E+00,
     0.00000000000000167154E+00,
    -0.00000000000000055134E+00,
    -0.00000000000000022369E+00,
     0.00000000000000017487E+00,
     0.00000000000000000207E+00 };
  static float btr = -2.0938363213560543E+00;
  float eta;
  static int nbif = 0;
  static int nbif2 = 0;
  static int nbig = 0;
  static int nbig2 = 0;
  static int nbip1 = 0;
  static int nbip2 = 0;
  float phi;
  float sqrtx;
  float value;
  float x2;
  static float x2sml = 0.0;
  float x3;
  static float x3sml = 0.0;
  static float x32sml = 0.0;
  static float xbig = 0.0;
  float xn;
  float z;

  if ( nbif == 0 )
  {
    eta = 0.1E+00 * r4_mach ( 3 );
    nbif = r4_inits ( bifcs, 8, eta );
    nbig = r4_inits ( bigcs, 9, eta );
    nbif2 = r4_inits ( bif2cs, 10, eta );
    nbig2 = r4_inits ( big2cs, 10, eta );
    nbip1 = r4_inits ( bip1cs, 24, eta );
    nbip2 = r4_inits ( bip2cs, 29, eta );
    x2sml = sqrt ( eta );
    x3sml = r4_power ( eta, 0.3333E+00 );
    x32sml = 1.3104 * x3sml * x3sml;
    xbig = r4_power ( r4_mach ( 2 ), 0.6666E+00 );
  }

  if ( x <= - 1.0E+00 )
  {
    r4_admp ( x, &xn, &phi );
    value = xn * sin ( phi );
  }
  else if ( 0.0E+00 <= x && x <= x32sml )
  {
    x2 = 0.0E+00;
    x3 = 0.0E+00;
    value = x2 * ( r4_csevl ( x3, bifcs, nbif ) + 0.25E+00 ) 
      + r4_csevl ( x3, bigcs, nbig ) + 0.5E+00;
  }
  else if ( fabs ( x ) <= x2sml )
  {
    x2 = 0.0E+00;
    x3 = 0.0E+00;
    value = x2 * ( r4_csevl ( x3, bifcs, nbif ) + 0.25E+00 ) 
      + r4_csevl ( x3, bigcs, nbig ) + 0.5E+00;
    value = value * exp ( - 2.0E+00 * x * sqrt ( x ) / 3.0E+00 );
  }
  else if ( x <= x3sml )
  {
    x2 = x * x;
    x3 = 0.0E+00;
    value = x2 * ( r4_csevl ( x3, bifcs, nbif ) + 0.25E+00 ) 
      + r4_csevl ( x3, bigcs, nbig ) + 0.5E+00;
    value = value * exp ( - 2.0E+00 * x * sqrt ( x ) / 3.0E+00 );
  }
  else if ( x <= 1.0E+00 )
  {
    x2 = x * x;
    x3 = x * x * x;
    value = x2 * ( r4_csevl ( x3, bifcs, nbif ) + 0.25E+00 ) 
      + r4_csevl ( x3, bigcs, nbig ) + 0.5E+00;
    value = value * exp ( - 2.0E+00 * x * sqrt ( x ) / 3.0E+00 );
  }
  else if ( x <= 2.0E+00 )
  {
    z = ( 2.0E+00 * x * x * x - 9.0E+00 ) / 7.0E+00;
    value = exp ( - 2.0E+00 * x * sqrt ( x ) / 3.0E+00 ) 
      * ( x * x * ( 0.25E+00 + r4_csevl ( z, bif2cs, nbif2 ) ) 
      + 0.5E+00 + r4_csevl ( z, big2cs, nbig2 ) );
  }
  else if ( x <= 4.0E+00 )
  {
    sqrtx = sqrt ( x );
    z = atr / ( x * sqrtx ) + btr;
    value = ( 0.625E+00 + r4_csevl ( z, bip1cs, nbip1 ) ) * sqrt ( sqrtx );
  }
  else if ( x < xbig )
  {
    sqrtx = sqrt ( x );
    z = 16.0E+00 / ( x * sqrtx ) - 1.0E+00;
    value = ( 0.625E+00 + r4_csevl ( z, bip2cs, nbip2 ) ) * sqrt ( sqrtx );
  }
  else
  {
    sqrtx = sqrt ( x );
    z = - 1.0E+00;
    value = ( 0.625E+00 + r4_csevl ( z, bip2cs, nbip2 ) ) * sqrt ( sqrtx );
  }
  return value;
}
/******************************************************************************/

float r4_bie ( float x )

/******************************************************************************/
/*
  Purpose:

    R4_BIE evaluates the exponentially scaled Airy function Bi of an R4 argument.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, float X, the argument.

    Output, float R4_BIE, the exponentially scaled Airy function Bi of X.
*/
{
  static float atr = 8.7506905708484345E+00;
  static float bif2cs[10] = {
    0.09984572693816041E+00,
    0.478624977863005538E+00,
    0.0251552119604330118E+00,
    0.0005820693885232645E+00,
    0.0000074997659644377E+00,
    0.0000000613460287034E+00,
    0.0000000003462753885E+00,
    0.0000000000014288910E+00,
    0.0000000000000044962E+00,
    0.0000000000000000111E+00 };
  static float bifcs[9] = {
   -0.01673021647198664948E+00,
    0.1025233583424944561E+00,
    0.00170830925073815165E+00,
    0.00001186254546774468E+00,
    0.00000004493290701779E+00,
    0.00000000010698207143E+00,
    0.00000000000017480643E+00,
    0.00000000000000020810E+00,
    0.00000000000000000018E+00 };
  static float big2cs[10] = {
    0.033305662145514340E+00,
    0.161309215123197068E+00,
    0.0063190073096134286E+00,
    0.0001187904568162517E+00,
    0.0000013045345886200E+00,
    0.0000000093741259955E+00,
    0.0000000000474580188E+00,
    0.0000000000001783107E+00,
    0.0000000000000005167E+00,
    0.0000000000000000011E+00 };
  static float bigcs[8] = {
    0.02246622324857452E+00,
    0.03736477545301955E+00,
    0.00044476218957212E+00,
    0.00000247080756363E+00,
    0.00000000791913533E+00,
    0.00000000001649807E+00,
    0.00000000000002411E+00,
    0.00000000000000002E+00 };
  static float bip2cs[29] = {
   -0.113596737585988679E+00,
    0.0041381473947881595E+00,
    0.0001353470622119332E+00,
    0.0000104273166530153E+00,
    0.0000013474954767849E+00,
    0.0000001696537405438E+00,
   -0.0000000100965008656E+00,
   -0.0000000167291194937E+00,
   -0.0000000045815364485E+00,
    0.0000000003736681366E+00,
    0.0000000005766930320E+00,
    0.0000000000621812650E+00,
   -0.0000000000632941202E+00,
   -0.0000000000149150479E+00,
    0.0000000000078896213E+00,
    0.0000000000024960513E+00,
   -0.0000000000012130075E+00,
   -0.0000000000003740493E+00,
    0.0000000000002237727E+00,
    0.0000000000000474902E+00,
   -0.0000000000000452616E+00,
   -0.0000000000000030172E+00,
    0.0000000000000091058E+00,
   -0.0000000000000009814E+00,
   -0.0000000000000016429E+00,
    0.0000000000000005533E+00,
    0.0000000000000002175E+00,
   -0.0000000000000001737E+00,
   -0.0000000000000000010E+00 };
  static float bipcs[24] = {
   -0.08322047477943447E+00,
    0.01146118927371174E+00,
    0.00042896440718911E+00,
   -0.00014906639379950E+00,
   -0.00001307659726787E+00,
    0.00000632759839610E+00,
   -0.00000042226696982E+00,
   -0.00000019147186298E+00,
    0.00000006453106284E+00,
   -0.00000000784485467E+00,
   -0.00000000096077216E+00,
    0.00000000070004713E+00,
   -0.00000000017731789E+00,
    0.00000000002272089E+00,
    0.00000000000165404E+00,
   -0.00000000000185171E+00,
    0.00000000000059576E+00,
   -0.00000000000012194E+00,
    0.00000000000001334E+00,
    0.00000000000000172E+00,
   -0.00000000000000145E+00,
    0.00000000000000049E+00,
   -0.00000000000000011E+00,
    0.00000000000000001E+00 };
  static float btr = -2.093836321356054E+00;
  float eta;
  static int nbif;
  static int nbif2;
  static int nbig;
  static int nbig2;
  static int nbip;
  static int nbip2;
  float sqrtx;
  float theta;
  float value;
  static float x32sml = 0.0;
  static float x3sml = 0.0;
  static float xbig = 0.0;
  float xm;
  float z;

  if ( nbif == 0 )
  {
    eta = 0.1E+00 * r4_mach ( 3 );
    nbif = r4_inits ( bifcs, 9, eta );
    nbig = r4_inits ( bigcs, 8, eta );
    nbif2 = r4_inits ( bif2cs, 10, eta );
    nbig2 = r4_inits ( big2cs, 10, eta );
    nbip  = r4_inits ( bipcs, 24, eta );
    nbip2 = r4_inits ( bip2cs, 29, eta );
    x3sml = r4_power ( eta, 0.3333E+00 );
    x32sml = 1.3104E+00 * x3sml * x3sml;
    xbig = r4_power ( r4_mach ( 2 ), 0.6666E+00 );
  }

  if ( x < -1.0E+00 )
  {
    r4_aimp ( x, &xm, &theta );
    value = xm * sin ( theta );
  }
  else if ( fabs ( x ) <= x32sml )
  {
    z = 0.0E+00;
    value = 0.625E+00 + r4_csevl ( z, bifcs, nbif ) 
      + x * ( 0.4375E+00 + r4_csevl ( z, bigcs, nbig ) );
  }
  else if ( fabs ( x ) <= x3sml )
  {
    z = 0.0E+00;
    value = 0.625E+00 + r4_csevl ( z, bifcs, nbif ) 
      + x * ( 0.4375E+00 + r4_csevl ( z, bigcs, nbig ) );
    value = value * exp ( - 2.0E+00 * x * sqrt ( x ) / 3.0E+00 );
  }
  else if ( x <= 1.0E+00 )
  {
    z = x * x * x;
    value = 0.625E+00 + r4_csevl ( z, bifcs, nbif ) 
      + x * ( 0.4375E+00 + r4_csevl ( z, bigcs, nbig ) );
    value = value * exp ( - 2.0E+00 * x * sqrt ( x ) / 3.0E+00 );
  }
  else if ( x <= 2.0E+00 )
  {
    z = ( 2.0E+00 * x * x * x - 9.0E+00 ) / 7.0E+00;
    value = exp ( - 2.0E+00 * x * sqrt ( x ) / 3.0E+00 ) 
      * ( 1.125E+00 + r4_csevl ( z, bif2cs, nbif2 )
      + x * ( 0.625E+00 + r4_csevl ( z, big2cs, nbig2 ) ) );
  }
  else if ( x <= 4.0E+00 )
  {
    sqrtx = sqrt ( x );
    z = atr / ( x * sqrtx ) + btr;
    value = ( 0.625E+00 + r4_csevl ( z, bipcs, nbip ) ) / sqrt ( sqrtx );
  }
  else if ( x <= xbig )
  {
    sqrtx = sqrt ( x );
    z = 16.0E+00 / ( x * sqrtx ) - 1.0E+00;
    value = ( 0.625E+00 + r4_csevl ( z, bip2cs, nbip2 ) ) / sqrt ( sqrtx );
  }
  else
  {
    sqrtx = sqrt ( x );
    z = - 1.0E+00;
    value = ( 0.625E+00 + r4_csevl ( z, bip2cs, nbip2 ) ) / sqrt ( sqrtx );
  }
  return value;
}
/******************************************************************************/

float r4_binom ( int n, int m )

/******************************************************************************/
/*
  Purpose:

    R4_BINOM evaluates the binomial coefficient using R4 arithmetic.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, int N, M, the arguments.

    Output, float R4_BINOM, the binomial coefficient.
*/
{
  static float bilnmx = 0.0;
  float corr;
  static float fintmx = 0.0;
  int i;
  int k;
  static float sq2pil = 0.91893853320467274E+00;
  float value;
  float xk;
  float xn;
  float xnk;

  if ( bilnmx == 0.0E+00 )
  {
    bilnmx = log ( r4_mach ( 2 ) );
    fintmx = 0.9E+00 / r4_mach ( 3 );
  }

  if ( n < 0 )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R4_BINOM - Fatal error!\n" );
    fprintf ( stderr, "  N < 0.\n" );
    exit ( 1 );
  }

  if ( m < 0 )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R4_BINOM - Fatal error!\n" );
    fprintf ( stderr, "  M < 0.\n" );
    exit ( 1 );
  }

  if ( n < m )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R4_BINOM - Fatal error!\n" );
    fprintf ( stderr, "  N < M.\n" );
    exit ( 1 );
  }

  k = i4_min ( m, n - m );

  if ( k <= 20 &&  ( float ) ( k ) * log ( ( float ) ( i4_max ( n, 1 ) ) ) <= bilnmx )
  {
    value = 1.0E+00;
    for ( i = 1; i <= k; i++ )
    {
      value = value * ( float ) ( n - i + 1 ) / ( float ) ( i );
    }
  }
  else
  {
    if ( k < 9 )
    {
      fprintf ( stderr, "\n" );
      fprintf ( stderr, "R4_BINOM - Fatal error!\n" );
      fprintf ( stderr, "  Result overflows.\n" );
      fprintf ( stderr, "  N or M is too big.\n" );
      exit ( 1 );
    }

    xn = ( float ) ( n + 1 );
    xk = ( float ) ( k + 1 );
    xnk = ( float ) ( n - k + 1 );

    corr = r4_lgmc ( xn ) - r4_lgmc ( xk ) - r4_lgmc ( xnk );

    value = xk * log ( xnk / xk ) 
      - xn * r4_lnrel ( - ( xk - 1.0E+00 ) / xn )
      - 0.5E+00 * log ( xn * xnk / xk ) + 1.0E+00 - sq2pil + corr;

    if ( bilnmx < value )
    {
      fprintf ( stderr, "\n" );
      fprintf ( stderr, "R4_BINOM - Fatal error!\n" );
      fprintf ( stderr, "  Result overflows.\n" );
      fprintf ( stderr, "  N or M is too big.\n" );
      exit ( 1 );
    }
    value = exp ( value );
  }

  if ( value < fintmx )
  {
    value = r4_aint ( value + 0.5E+00 );
  }

  return value;
}
/******************************************************************************/

float r4_cbrt ( float x )

/******************************************************************************/
/*
  Purpose:

    R4_CBRT computes the cube root of an R4.

  Discussion:

    The approximation is a generalized Chebyshev series converted
    to polynomial form.  The approximation is nearly best in the 
    sense of relative error with 4.085 digits accuracy.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, float X, the number whose square root is desired.

    Output, float R4_CBRT, the cube root of X.
*/
{
  static float cbrt2[5] = {
     0.62996052494743658E+00,
     0.79370052598409974E+00,
     1.0E+00,
     1.25992104989487316E+00,
     1.58740105196819947E+00 };
  int irem;
  int iter;
  int ixpnt;
  int n;
  static int niter = 0;
  float value;
  float vsq;
  float y;

  if ( niter == 0 )
  {
    niter = ( int ) ( 1.443E+00 * log ( -0.106E+00 
      * log ( 0.1E+00 * r4_mach ( 3 ) ) ) + 1.0E+00 );
  }

  value = 0.0E+00;

  if ( x != 0.0E+00 )
  {
    r4_upak ( fabs ( x ), &y, &n );
    ixpnt = n / 3;
    irem = n - 3 * ixpnt + 3;

    value = 0.439581E+00 + y * ( 
            0.928549E+00 + y * (
          - 0.512653E+00 + y *
            0.144586E+00 ) );

    for ( iter = 1; iter <= niter; iter++ )
    {
      vsq = value * value;
      value = value + ( y - value * vsq ) / ( 3.0E+00 * vsq );
    }

    if ( x < 0.0E+00 )
    {
      value = - fabs ( value );
    }
    else
    {
      value = + fabs ( value );
    }
    value = r4_pak ( cbrt2[irem-1] * value, ixpnt );
  }
  return value;
}
/******************************************************************************/

float r4_chi ( float x )

/******************************************************************************/
/*
  Purpose:

    R4_CHI evaluates the hyperbolic cosine integral of an R4 argument.

  Discussion:

    The hyperbolic cosine integral is defined by

      CHI(X) = gamma + log ( x ) 
        + integral ( 0 <= T < X ) ( cosh ( T ) - 1 ) / T  dT

    where gamma is Euler's constant.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, float X, the argument.

    Output, float R4_CHI, the hyperbolic cosine integral
    evaluated at X.
*/
{
  float value;

  value = 0.5E+00 * ( r4_ei ( x ) - r4_e1 ( x ) );

  return value;
}
/******************************************************************************/

float r4_chu ( float a, float b, float x )

/******************************************************************************/
/*
  Purpose:

    R4_CHU evaluates the confluent hypergeometric function of R4 arguments.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, float A, B, the parameters.

    Input, float X, the argument.

    Output, float R4_CHU, the function value.
*/
{
  float a0;
  float aintb;
  float alnx;
  float b0;
  float beps;
  float c0;
  static float eps = 0.0;
  float factor;
  float gamri1;
  float gamrni;
  int i;
  int istrt;
  int m;
  int n;
  static float pi = 3.14159265358979324E+00;
  float pch1ai;
  float pch1i;
  float pochai;
  float sum;
  float t;
  float value;
  float xeps1;
  float xi;
  float xi1;
  float xn;
  float xtoeps;

  if ( eps == 0.0E+00 )
  {
    eps = r4_mach ( 3 );
  }

  if ( x < 0.0E+00 )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R4_CHU - Fatal error!\n" );
    fprintf ( stderr, "  X < 0.\n" );
    exit ( 1 );
  }

  if ( x == 0.0E+00 )
  {
    if ( 1.0E+00 <= b )
    {
      fprintf ( stderr, "\n" );
      fprintf ( stderr, "R4_CHU - Fatal error!\n" );
      fprintf ( stderr, "  X = 0 and 1 <= B.\n" );
      exit ( 1 );
    }
    value = r4_gamma ( 1.0E+00 - b ) / r4_gamma ( 1.0E+00 + a - b );
    return value;
  }

  if ( fmax ( fabs ( a ), 1.0E+00 ) 
    * fmax ( fabs ( 1.0E+00 + a - b ), 1.0E+00 ) 
    < 0.99E+00 * fabs ( x ) )
  {
    value = r4_power ( x, - a ) * r4_chu_scaled ( a, b, x );
    return value;
  }
/*
  The ascending series will be used, because the descending rational
  approximation (which is based on the asymptotic series) is unstable.
*/
  if ( b < 0.0E+00 )
  {
    aintb = r4_aint ( b - 0.5E+00 );
  }
  else
  {
    aintb = r4_aint ( b + 0.5E+00 );
  }
  beps = b - aintb;
  n = aintb;

  alnx = log ( x );
  xtoeps = exp ( - beps * alnx );
/*
  Evaluate the finite sum.

  Consider the case b < 1.0 first.
*/
  if ( n < 1 )
  {
    sum = 1.0E+00;
    t = 1.0E+00;
    m = - n;
    for ( i = 1; i <= m; i++ )
    {
      xi1 = ( float ) ( i - 1 );
      t = t * ( a + xi1 ) * x / ( ( b + xi1 ) * ( xi1 + 1.0E+00 ) );
      sum = sum + t;
    }
    sum = r4_poch ( 1.0E+00 + a - b, - a ) * sum;
  }
/*
  Now consider the case 1.-0 <= b
*/
  else
  {
    sum = 0.0E+00;
    m = n - 2;

    if ( 0 <= m )
    {
      t = 1.0E+00;
      sum = 1.0E+00;

      for ( i = 1; i <= m; i++ )
      {
        xi = ( float ) ( i );
        t = t * ( a - b + xi ) * x / ( ( 1.0E+00 - b + xi ) * xi );
        sum = sum + t;
      }

      sum = r4_gamma ( b - 1.0E+00 ) * r4_gamr ( a ) 
        * r4_power ( x, ( 1.0 - ( float ) n ) ) * xtoeps * sum;
    }
  }
/*
  Now evaluate the infinite sum.
*/
  if ( n < 1 )
  {
    istrt = 1 - n;
  }
  else
  {
    istrt = 0;
  }

  xi = ( float ) ( istrt );

  factor = ( float ) i4_pow ( - 1, n ) * r4_gamr ( 1.0E+00 + a - b ) 
    * r4_power ( x, ( float ) istrt );

  if ( beps != 0.0E+00 )
  {
    factor = factor * beps * pi / sin ( beps * pi );
  }

  pochai = r4_poch ( a, xi );
  gamri1 = r4_gamr ( xi + 1.0E+00 );
  gamrni = r4_gamr ( aintb + xi );
  b0 = factor * r4_poch ( a, xi - beps ) * gamrni 
    * r4_gamr ( xi + 1.0E+00 - beps );
/*
  x^(-beps) is close to 1.0, so we must be careful in evaluating
  the differences.
*/
  if ( fabs ( xtoeps - 1.0E+00 ) <= 0.5E+00 )
  {
    pch1ai = r4_poch1 ( a + xi, - beps );
    pch1i = r4_poch1 ( xi + 1.0E+00 - beps, beps );
    c0 = factor * pochai * gamrni * gamri1 * (
      - r4_poch1 ( b + xi, -beps ) + pch1ai 
      - pch1i + beps * pch1ai * pch1i );
/*
  xeps1 = (1.0 - x^(-beps)) / beps
*/
    xeps1 = alnx * r4_exprel ( - beps * alnx );

    value = sum + c0 + xeps1 * b0;
    xn = ( float ) ( n );

    for ( i = 1; i <= 1000; i++ )
    {
      xi = ( float ) ( istrt + i );
      xi1 = ( float ) ( istrt + i - 1 );
      b0 = ( a + xi1 - beps ) * b0 * x 
        / ( ( xn + xi1 ) * ( xi - beps ) );
      c0 = ( a + xi1 ) * c0 * x / ( ( b + xi1 ) * xi ) 
        - ( ( a - 1.0E+00 ) * ( xn + 2.0E+00 * xi - 1.0E+00 )
        + xi * ( xi - beps ) ) * b0 
        / ( xi * ( b + xi1 ) * ( a + xi1 - beps ) );
      t = c0 + xeps1 * b0;
      value = value + t;
      if ( fabs ( t ) < eps * fabs ( value ) )
      {
        return value;
      }
    }
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R4_CHU - Fatal error!\n" );
    fprintf ( stderr, "  No convergence in 1000 terms.\n" );
    exit ( 1 );
  }
/*
  x^(-beps) is very different from 1.0, so the straightforward
  formulation is stable.
*/
  a0 = factor * pochai * r4_gamr ( b + xi ) * gamri1 / beps;
  b0 = xtoeps * b0 / beps;

  value = sum + a0 - b0;

  for ( i = 1; i <= 1000; i++ )
  {
    xi = ( float ) ( istrt + i );
    xi1 = ( float ) ( istrt + i - 1 );
    a0 = ( a + xi1 ) * a0 * x / ( ( b + xi1 ) * xi );
    b0 = ( a + xi1 - beps ) * b0 * x 
      / ( ( aintb + xi1 ) * ( xi - beps ) );
    t = a0 - b0;
    value = value + t;
    if ( fabs ( t ) < eps * fabs ( value ) )
    {
      return value;
    }
  }

  fprintf ( stderr, "\n" );
  fprintf ( stderr, "R4_CHU - Fatal error!\n" );
  fprintf ( stderr, "  No convergence in 1000 terms.\n" );
  exit ( 1 );
}
/******************************************************************************/

float r4_chu_scaled ( float a, float b, float z )

/******************************************************************************/
/*
  Purpose:

    R4_CHU_SCALED: scaled confluent hypergeometric function of R4 arguments.

  Discussion:

    Evaluate, for large z, z**a * u(a,b,z)  where U is the logarithmic
    confluent hypergeometric function.  A rational approximation due to
    Y L Luke is used.  When U is not in the asymptotic region, that is, when A
    or B is large compared with Z, considerable significance loss occurs.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, float A, B, the parameters.

    Input, float Z, the argument.

    Output, float R4_CHU_SCALED, the function value.
*/
{
  float aa[4];
  float ab;
  float anbn;
  float bb[4];
  float bp;
  float c2;
  float ct1;
  float ct2;
  float ct3;
  float d1z;
  static float eps = 0.0;
  float g1;
  float g2;
  float g3;
  int i;
  int j;
  float sab;
  float value;
  float x2i1;

  if ( eps == 0.0E+00 )
  {
    eps = 4.0E+00 * r4_mach ( 4 );
  }

  bp = 1.0E+00 + a - b;
  ab = a * bp;
  ct2 = 2.0E+00 * ( z - ab );
  sab = a + bp;

  bb[0] = 1.0E+00;
  aa[0] = 1.0E+00;

  ct3 = sab + 1.0E+00 + ab;
  bb[1] = 1.0E+00 + 2.0E+00 * z / ct3;
  aa[1] = 1.0E+00 + ct2 / ct3;

  anbn = ct3 + sab + 3.0E+00;
  ct1 = 1.0E+00 + 2.0E+00 * z / anbn;
  bb[2] = 1.0E+00 + 6.0E+00 * ct1 * z / ct3;
  aa[2] = 1.0E+00 + 6.0E+00 * ab / anbn + 3.0E+00 * ct1 * ct2 / ct3;

  for ( i = 4; i <= 300; i++ )
  {
    x2i1 = ( float ) ( 2 * i - 3 );
    ct1 = x2i1 / ( x2i1 - 2.0 );
    anbn = anbn + x2i1 + sab;
    ct2 = ( x2i1 - 1.0E+00 ) / anbn;
    c2 = x2i1 * ct2 - 1.0E+00;
    d1z = x2i1 * 2.0E+00 * z / anbn;

    ct3 = sab * ct2;
    g1 = d1z + ct1 * ( c2 + ct3 );
    g2 = d1z - c2;
    g3 = ct1 * ( 1.0E+00 - ct3 - 2.0E+00 * ct2 );

    bb[3] = g1 * bb[2] + g2 * bb[1] + g3 * bb[0];
    aa[3] = g1 * aa[2] + g2 * aa[1] + g3 * aa[0];

    value = aa[3] / bb[3];

    if ( fabs ( value - aa[0] / bb[0] ) < eps * fabs ( value ) )
    {
      return value;
    }
/*
  If overflows or underflows prove to be a problem, the statements
  below could be altered to incorporate a dynamically adjusted scale
  factor.
*/
    for ( j = 0; j < 3; j++ )
    {
      bb[j] = bb[j+1];
      aa[j] = aa[j+1];
    }
  }

  fprintf ( stderr, "\n" );
  fprintf ( stderr, "R4_CHU_SCALED - Fatal error!\n" );
  fprintf ( stderr, "  No convergence in 300 terms.\n" );

  exit ( 1 );
}
/******************************************************************************/

float r4_ci ( float x )

/******************************************************************************/
/*
  Purpose:

    R4_CI evaluates the cosine integral Ci of an R4 argument.

  Discussion:

    The cosine integral is defined by

      CI(X) = - integral ( X <= T < oo ) ( cos ( T ) ) / T  dT

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, float X, the argument.

    Output, float R4_CI, the cosine integral Ci evaluated at X.
*/
{
  static float cics[13] = {
    -0.34004281856055363156E+00,
    -1.03302166401177456807E+00,
     0.19388222659917082877E+00,
    -0.01918260436019865894E+00,
     0.00110789252584784967E+00,
    -0.00004157234558247209E+00,
     0.00000109278524300229E+00,
    -0.00000002123285954183E+00,
     0.00000000031733482164E+00,
    -0.00000000000376141548E+00,
     0.00000000000003622653E+00,
    -0.00000000000000028912E+00,
     0.00000000000000000194E+00 };
  float f;
  float g;
  static int nci = 0;
  float sinx;
  float value;
  static float xsml = 0.0;
  float y;

  if ( nci == 0 )
  {
    nci = r4_inits ( cics, 13, 0.1E+00 * r4_mach ( 3 ) );
    xsml = sqrt ( r4_mach ( 3 ) );
  }

  if ( x <= 0.0E+00 )
  { 
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R4_CI - Fatal error!\n" );
    fprintf ( stderr, "  X <= 0.0.\n" );
    exit ( 1 );
  }
  else if ( x <= xsml )
  {
    y = - 1.0E+00;
    value = log ( x ) - 0.5E+00 + r4_csevl ( y, cics, nci );
  }
  else if ( x <= 4.0E+00 )
  {
    y = ( x * x - 8.0E+00 ) * 0.125E+00;
    value = log ( x ) - 0.5E+00 + r4_csevl ( y, cics, nci );
  }
  else
  {
    r4_sifg ( x, &f, &g );
    sinx = sin ( x );
    value = f * sinx - g * cos ( x );
  }

  return value;
}
/******************************************************************************/

float r4_cin ( float x )

/******************************************************************************/
/*
  Purpose:

    R4_CIN evaluates the alternate cosine integral Cin of an R4 argument.

  Discussion:

    CIN(X) = gamma + log(X) 
      + integral ( 0 <= T <= X ) ( cos ( T ) - 1 ) / T  dT

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, float X, the argument.

    Output, float R4_CIN, the cosine integral Cin evaluated at X.
*/
{
  float absx;
  static float cincs[11] = {
     0.3707450175090968874E+00,
    -0.0589357489636444683E+00,
     0.0053818964211356912E+00,
    -0.0002986005284196214E+00,
     0.0000109557257532162E+00,
    -0.0000002840545487735E+00,
     0.0000000054697399488E+00,
    -0.0000000000812418746E+00,
     0.0000000000009586859E+00,
    -0.0000000000000092027E+00,
     0.0000000000000000733E+00 };
  static float eul = 0.57721566490153286E+00;
  float f;
  float g;
  static int ncin = 0;
  float sinx;
  float value;
  static float xmin = 0.0;

  if ( ncin == 0 )
  {
    ncin = r4_inits ( cincs, 11, 0.1E+00 * r4_mach ( 3 ) );
    xmin = sqrt ( r4_mach ( 1 ) );
  }

  absx = fabs ( x );

  if ( absx <= xmin )
  {
    value = 0.0E+00;
  }
  else if ( x <= 4.0E+00 )
  {
    value = x * x * r4_csevl ( ( x * x - 8.0E+00 ) * 0.125E+00, cincs, ncin );
  }
  else
  {
    r4_sifg ( x, &f, &g );
    sinx = sin ( absx );
    value = - f * sinx + g * cos ( absx ) + log ( absx ) + eul;
  }
  return value;
}
/******************************************************************************/

float r4_cinh ( float x )

/******************************************************************************/
/*
  Purpose:

    R4_CINH evaluates the alternate hyperbolic cosine integral Cinh of an R4 argument.

  Discussion:

    Cinh ( x ) = Integral ( 0 <= t <= x ) ( cosh ( t ) - 1 ) dt / t

    The original text of this program had a mistake:
      y = x * x / 9.0E+00 - 1.0E+00
    has been corrected to
      y = x * x / 4.5E+00 - 1.0E+00
    JVB, 27 March 2010

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, float X, the argument.

    Output, float R4_CINH, the hyperbolic cosine integral Cinh
    evaluated at X.
*/
{
  float absx;
  static float cinhcs[10] = {
     0.1093291636520734431E+00,
     0.0573928847550379676E+00,
     0.0028095756978830353E+00,
     0.0000828780840721357E+00,
     0.0000016278596173914E+00,
     0.0000000227809519256E+00,
     0.0000000002384484842E+00,
     0.0000000000019360830E+00,
     0.0000000000000125454E+00,
     0.0000000000000000664E+00 };
  static float eul = 0.57721566490153286E+00;
  static int ncinh = 0;
  float value;
  static float xmin = 0.0;
  static float xsml = 0.0;
  float y;

  if ( ncinh == 0 )
  {
    ncinh = r4_inits ( cinhcs, 10, 0.1E+00 * r4_mach ( 3 ) );
    xsml = sqrt ( r4_mach ( 3 ) );
    xmin = 2.0E+00 * sqrt ( r4_mach ( 1 ) );
  }

  absx = fabs ( x );

  if ( x == 0.0E+00 )
  {
    value = 0.0E+00;
  }
  else if ( absx <= xmin )
  {
    value = 0.0E+00;
  }
  else if ( x <= xsml )
  {
    y = - 1.0E+00;
    value = x * x * ( 0.25E+00 + r4_csevl ( y, cinhcs, ncinh ) );
  }
  else if ( x <= 3.0E+00 )
  {
    y = x * x / 4.5E+00 - 1.0E+00;
    value = x * x * ( 0.25E+00 + r4_csevl ( y, cinhcs, ncinh ) );
  }
  else
  {
    value = r4_chi ( absx ) - eul - log ( absx );
  }
  return value;
}
/******************************************************************************/

float r4_cos ( float x )

/******************************************************************************/
/*
  Purpose:

    R4_COS evaluates the cosine of an R4 argument.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, float X, the argument.

    Output, float R4_COS, the cosine of X.
*/
{
  float absx;
  float f;
  int n2;
  static int ntsn = 0;
  static float pi2 = 1.570796326794896619E+00;
  static float pi2rec = 0.636619772367581343E+00;
  static float pihi = 3.140625E+00;
  static float pilo = 9.6765358979323846E-04;
  static float pirec = 0.31830988618379067E+00;
  static float sincs[10] = {
     -0.374991154955873175840E+00,
     -0.181603155237250201864E+00,
     +0.005804709274598633559E+00,
     -0.000086954311779340757E+00,
     +0.000000754370148088851E+00,
     -0.000000004267129665056E+00,
     +0.000000000016980422945E+00,
     -0.000000000000050120579E+00,
     +0.000000000000000114101E+00,
     -0.000000000000000000206E+00 };
  float value;
  static float xmax = 0.0;
  float xn;
  static float xsml = 0.0;
  static float xwarn = 0.0;
  float y;

  if ( ntsn == 0 )
  {
    ntsn = r4_inits ( sincs, 10, 0.1E+00 * r4_mach ( 3 ) );
    xsml = sqrt ( 2.0E+00 * r4_mach ( 3 ) );
    xmax = 1.0E+00 / r4_mach ( 4 );
    xwarn = sqrt ( xmax );
  }
  
  absx = fabs ( x );
  y = absx + pi2;

  if ( xmax < y )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R4_COS - Warning!\n" );
    fprintf ( stderr, "  No precision because |X| is big.\n" );
    value = 0.0E+00;
    return value;
  }

  if ( xwarn < y )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R4_COS - Warning!\n" );
    fprintf ( stderr, "  Answer < half precision because |X| is big.\n" );
  }

  value = 1.0E+00;

  if ( absx < xsml )
  {
    return value;
  }

  xn = r4_aint ( y * pirec + 0.5E+00 );
  n2 = ( int ) ( r4_mod ( xn, 2.0E+00 ) + 0.5E+00 );
  xn = xn - 0.5E+00;
  f = ( absx - xn * pihi ) - xn * pilo;

  xn = 2.0E+00 * ( f * pi2rec ) * ( f * pi2rec ) - 1.0E+00;
  value = f + f * r4_csevl ( xn, sincs, ntsn );

  if ( n2 != 0 )
  {
    value = - value;
  }

  if ( value < - 1.0E+00 )
  {
    value = - 1.0E+00;
  }
  else if ( 1.0E+00 < value )
  {
    value = + 1.0E+00;
  }
  return value;
}
/******************************************************************************/

float r4_cos_deg ( float x )

/******************************************************************************/
/*
  Purpose:

    R4_COS_DEG evaluates the cosine of an R4 argument in degrees.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, float X, the argument in degrees.

    Output, float R4_COS_DEG, the cosine of X.
*/
{
  int n;
  static float raddeg = 0.017453292519943296E+00;
  float value;

  value = cos ( raddeg * x );

  if ( r4_mod ( x, 90.0E+00 ) == 0.0E+00 )
  {
    n = ( int ) ( fabs ( x ) / 90.0E+00 + 0.5E+00 );
    n = ( n % 2 );

    if ( n == 1 )
    {
      value = 0.0E+00;
    }
    else if ( value < 0.0E+00 )
    {
      value = - 1.0E+00;;
    }
    else
    {
      value = + 1.0E+00;
    }
  }
  return value;
}
/******************************************************************************/

float r4_cosh ( float x )

/******************************************************************************/
/*
  Purpose:

    R4_COSH evaluates the hyperbolic cosine of an R4 argument.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, float X, the argument.

    Output, float R4_COSH, the hyperbolic cosine of X.
*/
{
  float value;
  float y;
  static float ymax = 0.0;

  if ( ymax == 0.0E+00 )
  {
    ymax = 1.0E+00 / sqrt ( r4_mach ( 3 ) );
  }

  y = exp ( fabs ( x ) );

  value = 0.5E+00 * y;

  if ( y < ymax )
  {
    value = 0.5E+00 * ( y + 1.0E+00 / y );
  }

  return value;
}
/******************************************************************************/

float r4_cot ( float x )

/******************************************************************************/
/*
  Purpose:

    R4_COT evaluates the cotangent of an R4 argument.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, float X, the argument.

    Output, float R4_COT, the cotangent of X.
*/
{
  float ainty;
  float ainty2;
  static float cotcs[8] = {
    0.24025916098295630E+00,
   -0.016533031601500228E+00,
   -0.000042998391931724E+00,
   -0.000000159283223327E+00,
   -0.000000000619109313E+00,
   -0.000000000002430197E+00,
   -0.000000000000009560E+00,
   -0.000000000000000037E+00 };
  int ifn;
  static int nterms = 0;
  static float pi2rec = 0.0116197723675813430E+00;
  float prodbg;
  static float sqeps = 0.0;
  float value;
  static float xmax = 0.0;
  static float xmin = 0.0;
  static float xsml = 0.0;
  float y;
  float yrem;

  if ( nterms == 0 )
  {
    nterms = r4_inits ( cotcs, 8, 0.1E+00 * r4_mach ( 3 ) );
    xmax = 1.0E+00 / r4_mach ( 4 );
    xsml = sqrt ( 3.0E+00 * r4_mach ( 3 ) );
    xmin = exp ( fmax ( log ( r4_mach ( 1 ) ), 
      - log ( r4_mach ( 2 ) ) ) + 0.01E+00 );
    sqeps = sqrt ( r4_mach ( 4 ) );
  }

  y = fabs ( x );

  if ( y < xmin )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R4_COT - Fatal error!\n" );
    fprintf ( stderr, "  |X| is too small.\n" );
    exit ( 1 );
  }

  if ( xmax < y )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R4_COT - Fatal error!\n" );
    fprintf ( stderr, "  |X| is too big.\n" );
    exit ( 1 );
  }
/*
  Carefully compute y * (2/pi) = (aint(y) + rem(y)) * (.625 + pi2rec)
  = aint(.625*y) + rem(.625*y) + y*pi2rec  =  aint(.625*y) + z
  = aint(.625*y) + aint(z) + rem(z)
*/
  ainty = r4_aint ( y );
  yrem = y - ainty;
  prodbg = 0.625E+00 * ainty;
  ainty = r4_aint ( prodbg );
  y = ( prodbg - ainty ) + 0.625E+00 * yrem + y * pi2rec;
  ainty2 = r4_aint ( y );
  ainty = ainty + ainty2;
  y = y - ainty2;

  ifn = ( int ) r4_mod ( ainty, 2.0E+00 );

  if ( ifn == 1 )
  {
    y = 1.0E+00 - y;
  }

  if ( 0.5E+00 < fabs ( x ) && y < fabs ( x ) * sqeps )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R4_COT - Warning!\n" );
    fprintf ( stderr, "  Answer less than half precision.\n" );
    fprintf ( stderr, "  |X| too big, or X nearly a nonzero multiple of pi.\n" );
  }

  if ( y == 0.0E+00 )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R4_COT - Fatal error!\n" );
    fprintf ( stderr, "  X is a multiple of pi.\n" );
    exit ( 1 );
  }
  else if ( y <= xsml )
  {
    value = 1.0E+00 / y;
  }
  else if ( y <= 0.25E+00 )
  {
    value = ( 0.5E+00 
      + r4_csevl ( 32.0E+00 * y * y - 1.0E+00, cotcs, nterms ) ) / y;
  }
  else if ( y <= 0.5E+00 )
  {
    value = ( 0.5E+00 + r4_csevl ( 8.0E+00 * y * y - 1.0E+00, 
      cotcs, nterms ) ) / ( 0.5E+00 * y );

    value = ( value * value - 1.0E+00 ) * 0.5E+00 / value;
  }
  else
  {
    value = ( 0.5E+00 + r4_csevl ( 2.0E+00 * y * y - 1.0E+00, 
      cotcs, nterms ) ) / ( 0.25E+00 * y );
    value = ( value * value - 1.0E+00 ) * 0.5E+00 / value;
    value = ( value * value - 1.0E+00 ) * 0.5E+00 / value;
  }

  if ( x < 0.0E+00 )
  {
    value = - fabs ( value );
  }
  else
  {
    value = + fabs ( value );
  }

  if ( ifn == 1 )
  {
    value = - value;
  }

  return value;
}
/******************************************************************************/

 float r4_csevl ( float x, float a[], int n )

/******************************************************************************/
/*
  Purpose:

    R4_CSEVL evaluates a Chebyshev series.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    C version by John Burkardt.

  Reference:

    Roger Broucke,
    Algorithm 446:
    Ten Subroutines for the Manipulation of Chebyshev Series,
    Communications of the ACM,
    Volume 16, Number 4, April 1973, pages 254-256.

  Parameters:

    Input, float X, the evaluation point.

    Input, float CS[N], the Chebyshev coefficients.

    Input, int N, the number of Chebyshev coefficients.

    Output, float R4_CSEVL, the Chebyshev series evaluated at X.
*/
{
  float b0;
  float b1;
  float b2;
  int i;
  float twox;
  float value;

  if ( n < 1 )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R4_CSEVL - Fatal error!\n" );
    fprintf ( stderr, "  Number of terms <= 0.\n" );
    exit ( 1 );
  }

  if ( 1000 < n )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R4_CSEVL - Fatal error!\n" );
    fprintf ( stderr, "  Number of terms greater than 1000.\n" );
    exit ( 1 );
 }

  if ( x < -1.1 || 1.1 < x )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R4_CSEVL - Fatal error!\n" );
    fprintf ( stderr, "  X outside (-1,+1).\n" );
    exit ( 1 );
  }

  twox = 2.0 * x;
  b1 = 0.0;
  b0 = 0.0;

  for ( i = n - 1; 0 <= i; i-- )
  {
    b2 = b1;
    b1 = b0;
    b0 = twox * b1 - b2 + a[i];
  }

  value = 0.5 * ( b0 - b2 );

  return value;
}
/******************************************************************************/

float r4_dawson ( float x )

/******************************************************************************/
/*
  Purpose:

    R4_DAWSON evaluates Dawson's integral of an R4 argument.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, float X, the argument.

    Output, float R4_DAWSON, the value of Dawson's integral at X.
*/
{
  static float daw2cs[29] = {
   -0.056886544105215527E+00,
   -0.31811346996168131E+00,
    0.20873845413642237E+00,
   -0.12475409913779131E+00,
    0.067869305186676777E+00,
   -0.033659144895270940E+00,
    0.015260781271987972E+00,
   -0.006348370962596214E+00,
    0.002432674092074852E+00,
   -0.000862195414910650E+00,
    0.000283765733363216E+00,
   -0.000087057549874170E+00,
    0.000024986849985481E+00,
   -0.000006731928676416E+00,
    0.000001707857878557E+00,
   -0.000000409175512264E+00,
    0.000000092828292216E+00,
   -0.000000019991403610E+00,
    0.000000004096349064E+00,
   -0.000000000800324095E+00,
    0.000000000149385031E+00,
   -0.000000000026687999E+00,
    0.000000000004571221E+00,
   -0.000000000000751873E+00,
    0.000000000000118931E+00,
   -0.000000000000018116E+00,
    0.000000000000002661E+00,
   -0.000000000000000377E+00,
    0.000000000000000051E+00 };
  static float dawacs[26] = {
    0.01690485637765704E+00,
    0.00868325227840695E+00,
    0.00024248640424177E+00,
    0.00001261182399572E+00,
    0.00000106645331463E+00,
    0.00000013581597947E+00,
    0.00000002171042356E+00,
    0.00000000286701050E+00,
   -0.00000000019013363E+00,
   -0.00000000030977804E+00,
   -0.00000000010294148E+00,
   -0.00000000000626035E+00,
    0.00000000000856313E+00,
    0.00000000000303304E+00,
   -0.00000000000025236E+00,
   -0.00000000000042106E+00,
   -0.00000000000004431E+00,
    0.00000000000004911E+00,
    0.00000000000001235E+00,
   -0.00000000000000578E+00,
   -0.00000000000000228E+00,
    0.00000000000000076E+00,
    0.00000000000000038E+00,
   -0.00000000000000011E+00,
   -0.00000000000000006E+00,
    0.00000000000000002E+00 };
  static float dawcs[13] = {
   -0.006351734375145949E+00,
   -0.22940714796773869E+00,
    0.022130500939084764E+00,
   -0.001549265453892985E+00,
    0.000084973277156849E+00,
   -0.000003828266270972E+00,
    0.000000146285480625E+00,
   -0.000000004851982381E+00,
    0.000000000142146357E+00,
   -0.000000000003728836E+00,
    0.000000000000088549E+00,
   -0.000000000000001920E+00,
    0.000000000000000038E+00 };
  float eps;
  static int ntdaw = 0;
  static int ntdaw2 = 0;
  static int ntdawa = 0;
  float value;
  static float xbig = 0.0;
  static float xmax = 0.0;
  static float xsml = 0.0;
  float y;

  if ( ntdaw == 0 )
  {
    eps = r4_mach ( 3 );
    ntdaw  = r4_inits ( dawcs,  13, 0.1E+00 * eps );
    ntdaw2 = r4_inits ( daw2cs, 29, 0.1E+00 * eps );
    ntdawa = r4_inits ( dawacs, 26, 0.1E+00 * eps );

    xsml = sqrt ( 1.5E+00 * eps );
    xbig = sqrt ( 0.5E+00 / eps );
    xmax = exp ( fmin ( - log ( 2.0E+00 * r4_mach ( 1 ) ), 
      log ( r4_mach ( 2 ) ) ) - 0.01E+00 );
  }

  y = fabs ( x );

  if ( y <= xsml )
  {
    value = x;
  }
  else if ( y <= 1.0E+00 )
  {
    value = x * ( 0.75E+00 
      + r4_csevl ( 2.0E+00 * y * y - 1.0E+00, dawcs, ntdaw ) );
  }
  else if ( y <= 4.0E+00 )
  {
    value = x * ( 0.25E+00 
      + r4_csevl ( 0.125E+00 * y * y - 1.0E+00, daw2cs, ntdaw2 ) );
  }
  else if ( y < xbig )
  {
    value = ( 0.5E+00 
      + r4_csevl ( 32.0E+00 / y / y - 1.0E+00, dawacs, ntdawa ) ) / x;
  }
  else if ( y <= xmax )
  {
    value = 0.5E+00 / x;
  }
  else
  {
    value = 0.0E+00;
  }
  return value;
}
/******************************************************************************/

float r4_e1 ( float x )

/******************************************************************************/
/*
  Purpose:

    R4_E1 evaluates the exponential integral E1 for an R4 argument.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, float X, the argument.

    Output, float R4_E1, the exponential integral E1 evaluated at X.
*/
{
  static float ae11cs[39] = {
    0.12150323971606579E+00,
   -0.065088778513550150E+00,
    0.004897651357459670E+00,
   -0.000649237843027216E+00,
    0.000093840434587471E+00,
    0.000000420236380882E+00,
   -0.000008113374735904E+00,
    0.000002804247688663E+00,
    0.000000056487164441E+00,
   -0.000000344809174450E+00,
    0.000000058209273578E+00,
    0.000000038711426349E+00,
   -0.000000012453235014E+00,
   -0.000000005118504888E+00,
    0.000000002148771527E+00,
    0.000000000868459898E+00,
   -0.000000000343650105E+00,
   -0.000000000179796603E+00,
    0.000000000047442060E+00,
    0.000000000040423282E+00,
   -0.000000000003543928E+00,
   -0.000000000008853444E+00,
   -0.000000000000960151E+00,
    0.000000000001692921E+00,
    0.000000000000607990E+00,
   -0.000000000000224338E+00,
   -0.000000000000200327E+00,
   -0.000000000000006246E+00,
    0.000000000000045571E+00,
    0.000000000000016383E+00,
   -0.000000000000005561E+00,
   -0.000000000000006074E+00,
   -0.000000000000000862E+00,
    0.000000000000001223E+00,
    0.000000000000000716E+00,
   -0.000000000000000024E+00,
   -0.000000000000000201E+00,
   -0.000000000000000082E+00,
    0.000000000000000017E+00 };
  static float ae12cs[25] = {
    0.58241749513472674E+00,
   -0.15834885090578275E+00,
   -0.006764275590323141E+00,
    0.005125843950185725E+00,
    0.000435232492169391E+00,
   -0.000143613366305483E+00,
   -0.000041801320556301E+00,
   -0.000002713395758640E+00,
    0.000001151381913647E+00,
    0.000000420650022012E+00,
    0.000000066581901391E+00,
    0.000000000662143777E+00,
   -0.000000002844104870E+00,
   -0.000000000940724197E+00,
   -0.000000000177476602E+00,
   -0.000000000015830222E+00,
    0.000000000002905732E+00,
    0.000000000001769356E+00,
    0.000000000000492735E+00,
    0.000000000000093709E+00,
    0.000000000000010707E+00,
   -0.000000000000000537E+00,
   -0.000000000000000716E+00,
   -0.000000000000000244E+00,
   -0.000000000000000058E+00 };
  static float ae13cs[25] = {
   -0.60577324664060346E+00,
   -0.11253524348366090E+00,
    0.013432266247902779E+00,
   -0.001926845187381145E+00,
    0.000309118337720603E+00,
   -0.000053564132129618E+00,
    0.000009827812880247E+00,
   -0.000001885368984916E+00,
    0.000000374943193568E+00,
   -0.000000076823455870E+00,
    0.000000016143270567E+00,
   -0.000000003466802211E+00,
    0.000000000758754209E+00,
   -0.000000000168864333E+00,
    0.000000000038145706E+00,
   -0.000000000008733026E+00,
    0.000000000002023672E+00,
   -0.000000000000474132E+00,
    0.000000000000112211E+00,
   -0.000000000000026804E+00,
    0.000000000000006457E+00,
   -0.000000000000001568E+00,
    0.000000000000000383E+00,
   -0.000000000000000094E+00,
    0.000000000000000023E+00 };
  static float ae14cs[26] = {
   -0.1892918000753017E+00,
   -0.08648117855259871E+00,
    0.00722410154374659E+00,
   -0.00080975594575573E+00,
    0.00010999134432661E+00,
   -0.00001717332998937E+00,
    0.00000298562751447E+00,
   -0.00000056596491457E+00,
    0.00000011526808397E+00,
   -0.00000002495030440E+00,
    0.00000000569232420E+00,
   -0.00000000135995766E+00,
    0.00000000033846628E+00,
   -0.00000000008737853E+00,
    0.00000000002331588E+00,
   -0.00000000000641148E+00,
    0.00000000000181224E+00,
   -0.00000000000052538E+00,
    0.00000000000015592E+00,
   -0.00000000000004729E+00,
    0.00000000000001463E+00,
   -0.00000000000000461E+00,
    0.00000000000000148E+00,
   -0.00000000000000048E+00,
    0.00000000000000016E+00,
   -0.00000000000000005E+00 };
  static float e11cs[19] = {
  -16.113461655571494026E+00,
    7.7940727787426802769E+00,
   -1.9554058188631419507E+00,
    0.37337293866277945612E+00,
   -0.05692503191092901938E+00,
    0.00721107776966009185E+00,
   -0.00078104901449841593E+00,
    0.00007388093356262168E+00,
   -0.00000620286187580820E+00,
    0.00000046816002303176E+00,
   -0.00000003209288853329E+00,
    0.00000000201519974874E+00,
   -0.00000000011673686816E+00,
    0.00000000000627627066E+00,
   -0.00000000000031481541E+00,
    0.00000000000001479904E+00,
   -0.00000000000000065457E+00,
    0.00000000000000002733E+00,
   -0.00000000000000000108E+00 };
  static float e12cs[16] = {
    -0.037390214792202795E+00,
    0.042723986062209577E+00,
   -0.1303182079849700544E+00,
    0.01441912402469889073E+00,
   -0.00134617078051068022E+00,
    0.00010731029253063780E+00,
   -0.00000742999951611943E+00,
    0.00000045377325690753E+00,
   -0.00000002476417211390E+00,
    0.00000000122076581374E+00,
   -0.00000000005485141480E+00,
    0.00000000000226362142E+00,
   -0.00000000000008635897E+00,
    0.00000000000000306291E+00,
   -0.00000000000000010148E+00,
    0.00000000000000000315E+00 };
  float eta;
  static int ntae11 = 0;
  static int ntae12 = 0;
  static int ntae13 = 0;
  static int ntae14 = 0;
  static int nte11 = 0;
  static int nte12 = 0;
  float value;
  static float xmax = 0.0;

  if ( ntae11 == 0 )
  {
    eta = 0.1E+00 * r4_mach ( 3 );
    ntae11 = r4_inits ( ae11cs, 39, eta );
    ntae12 = r4_inits ( ae12cs, 25, eta );
    nte11 = r4_inits ( e11cs, 19, eta );
    nte12 = r4_inits ( e12cs, 16, eta );
    ntae13 = r4_inits ( ae13cs, 25, eta );
    ntae14 = r4_inits ( ae14cs, 26, eta );
    xmax = - log ( r4_mach ( 1 ) );
    xmax = xmax - log ( xmax );
  }

  if ( x <= - 10.0E+00 )
  {
    value = exp ( - x ) / x * ( 1.0E+00 
      + r4_csevl ( 20.0E+00 / x + 1.0E+00, ae11cs, ntae11 ) );
  }
  else if ( x <= - 4.0E+00 )
  {
    value = exp ( - x ) / x * ( 1.0E+00 + r4_csevl ( 
      ( 40.0E+00 / x + 7.0E+00 ) / 3.0E+00, ae12cs, ntae12 ) );
  }
  else if ( x <= - 1.0E+00 )
  {
    value = - log ( fabs ( x ) ) + r4_csevl ( 
      ( 2.0E+00 * x + 5.0E+00 ) / 3.0E+00, e11cs, nte11 );
  }
  else if ( x == 0.0E+00 )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R4_E1 - Fatal error!\n" );
    fprintf ( stderr, "  X is zero.\n" );
    exit ( 1 );
  }
  else if ( x <= 1.0E+00 )
  {
    value = ( - log ( fabs ( x ) ) - 0.6875E+00 + x ) 
      + r4_csevl ( x, e12cs, nte12 );
  }
  else if ( x <= 4.0E+00 )
  {
    value = exp ( - x ) / x * ( 1.0E+00 + r4_csevl ( 
      ( 8.0E+00 / x - 5.0E+00 ) / 3.0E+00, ae13cs, ntae13 ) );
  }
  else if ( x <= xmax )
  {
    value = exp ( - x ) / x * ( 1.0E+00 + r4_csevl (
      8.0E+00 / x - 1.0E+00, ae14cs, ntae14 ) );
  }
  else
  {
    value = 0.0E+00;
  }
  return value;
}
/******************************************************************************/

float r4_ei ( float x )

/******************************************************************************/
/*
  Purpose:

    R4_EI evaluates the exponential integral Ei for an R4 argument.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, float X, the argument.

    Output, float R4_EI, the exponential integral Ei evaluated at X.
*/
{
  float value;

  value = - r4_e1 ( - x );

  return value;
}
/******************************************************************************/

float r4_erf ( float x )

/******************************************************************************/
/*
  Purpose:

    R4_ERF evaluates the error function of an R4 argument.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, float X, the argument.

    Output, float R4_ERF, the error function of X.
*/
{
  static float erfcs[13] = {
   -0.049046121234691808E+00,
   -0.14226120510371364E+00,
    0.010035582187599796E+00,
   -0.000576876469976748E+00,
    0.000027419931252196E+00,
   -0.000001104317550734E+00,
    0.000000038488755420E+00,
   -0.000000001180858253E+00,
    0.000000000032334215E+00,
   -0.000000000000799101E+00,
    0.000000000000017990E+00,
   -0.000000000000000371E+00,
    0.000000000000000007E+00 };
  static float nterf = 0;
  static float sqeps = 0.0;
  static float sqrtpi = 1.7724538509055160E+00;
  float value;
  static float xbig = 0.0;
  float y;

  if ( nterf == 0 )
  {
    nterf = r4_inits ( erfcs, 13, 0.1E+00 * r4_mach ( 3 ) );
    xbig = sqrt ( - log ( sqrtpi * r4_mach ( 3 ) ) );
    sqeps = sqrt ( 2.0E+00 * r4_mach ( 3 ) );
  }

  y = fabs ( x );

  if ( y <= sqeps )
  {
    value = 2.0E+00 * x / sqrtpi;
  }
  else if ( y <= 1.0E+00 )
  {
    value = x * ( 1.0E+00 
      + r4_csevl ( 2.0E+00 * x * x - 1.0E+00, erfcs, nterf ) );
  }
  else if ( y <= xbig )
  {
    value = 1.0E+00 - r4_erfc ( y );
    if ( x < 0.0E+00 )
    {
      value = - value;
    }
  }
  else
  {
    value = 1.0E+00;
    if ( x < 0.0E+00 )
    {
      value = - value;
    }
  }
  return value;
}
/******************************************************************************/

float r4_erfc ( float x )

/******************************************************************************/
/*
  Purpose:

    R4_ERFC evaluates the co-error function of an R4 argument.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, float X, the argument.

    Output, float R4_ERFC, the co-error function of X.
*/
{
  static float erc2cs[23] = {
   -0.069601346602309501E+00,
   -0.041101339362620893E+00,
    0.003914495866689626E+00,
   -0.000490639565054897E+00,
    0.000071574790013770E+00,
   -0.000011530716341312E+00,
    0.000001994670590201E+00,
   -0.000000364266647159E+00,
    0.000000069443726100E+00,
   -0.000000013712209021E+00,
    0.000000002788389661E+00,
   -0.000000000581416472E+00,
    0.000000000123892049E+00,
   -0.000000000026906391E+00,
    0.000000000005942614E+00,
   -0.000000000001332386E+00,
    0.000000000000302804E+00,
   -0.000000000000069666E+00,
    0.000000000000016208E+00,
   -0.000000000000003809E+00,
    0.000000000000000904E+00,
   -0.000000000000000216E+00,
    0.000000000000000052E+00 };
  static float erfccs[24] = {
    0.0715179310202925E+00,
   -0.026532434337606719E+00,
    0.001711153977920853E+00,
   -0.000163751663458512E+00,
    0.000019871293500549E+00,
   -0.000002843712412769E+00,
    0.000000460616130901E+00,
   -0.000000082277530261E+00,
    0.000000015921418724E+00,
   -0.000000003295071356E+00,
    0.000000000722343973E+00,
   -0.000000000166485584E+00,
    0.000000000040103931E+00,
   -0.000000000010048164E+00,
    0.000000000002608272E+00,
   -0.000000000000699105E+00,
    0.000000000000192946E+00,
   -0.000000000000054704E+00,
    0.000000000000015901E+00,
   -0.000000000000004729E+00,
    0.000000000000001432E+00,
   -0.000000000000000439E+00,
    0.000000000000000138E+00,
   -0.000000000000000048E+00 };
  static float erfcs[13] = {
   -0.049046121234691808E+00,
   -0.14226120510371364E+00,
    0.010035582187599796E+00,
   -0.000576876469976748E+00,
    0.000027419931252196E+00,
   -0.000001104317550734E+00,
    0.000000038488755420E+00,
   -0.000000001180858253E+00,
    0.000000000032334215E+00,
   -0.000000000000799101E+00,
    0.000000000000017990E+00,
   -0.000000000000000371E+00,
    0.000000000000000007E+00 };
  float eta;
  static int nterc2 = 0;
  static int nterf = 0;
  static int nterfc = 0;
  static float sqeps;
  static float sqrtpi = 1.7724538509055160E+00;
  float value;
  static float xmax = 0.0;
  static float xsml = 0.0;
  float y;

  if ( nterf == 0 )
  {
    eta = 0.1E+00 * r4_mach ( 3 );
    nterf = r4_inits ( erfcs, 13, eta );
    nterfc = r4_inits ( erfccs, 24, eta );
    nterc2 = r4_inits ( erc2cs, 23, eta );

    xsml = - sqrt ( - log ( sqrtpi * r4_mach ( 3 ) ) );
    xmax = sqrt ( - log ( sqrtpi * r4_mach ( 1 ) ) );
    xmax = xmax - 0.5E+00 * log ( xmax ) / xmax - 0.01E+00;
    sqeps = sqrt ( 2.0E+00 * r4_mach ( 3 ) );
  }

  if ( x <= xsml )
  {
    value = 2.0E+00;
    return value;
  }

  if ( xmax < x )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R4_ERFC - Warning!\n" );
    fprintf ( stderr, "  X so big that ERFC underflows.\n" );
    value = 0.0E+00;
    return value;
  }

  y = fabs ( x );

  if ( y < sqeps )
  {
    value = 1.0E+00 - 2.0E+00 * x / sqrtpi;
    return value;
  }
  else if ( y <= 1.0E+00 )
  {
    value = 1.0E+00 - x * ( 1.0E+00 
      + r4_csevl ( 2.0E+00 * x * x - 1.0E+00, erfcs, nterf ) );
    return value;
  }

  y = y * y;

  if ( y <= 4.0E+00 )
  {
    value = exp ( - y ) / fabs ( x ) * ( 0.5E+00 
      + r4_csevl ( ( 8.0E+00 / y - 5.0E+00 ) / 3.0E+00, erc2cs, 
      nterc2 ) );
  }
  else
  {
    value = exp ( - y ) / fabs ( x ) * ( 0.5E+00 
      + r4_csevl ( 8.0E+00 / y - 1.0E+00, erfccs, nterfc ) );
  }

  if ( x < 0.0E+00 )
  {
    value = 2.0E+00 - value;
  }

  return value;
}
/******************************************************************************/

float r4_exp ( float x )

/******************************************************************************/
/*
  Purpose:

    R4_EXP evaluates the exponential of an R4 argument.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, float X, the argument.

    Output, float R4_EXP, the exponential of X.
*/
{
  static float aln216 = 0.083120654223414518;
  static float expcs[8] = {
      0.086656949331498571,
      0.000938494869299839,
      0.000006776039709981,
      0.000000036693120039,
      0.000000000158959053,
      0.000000000000573859,
      0.000000000000001775,
      0.000000000000000004 };
  float f;
  int n;
  int n16;
  int ndx;
  static int nterms = 0;
  static float twon16[17] = {
     0.0E+00,
     0.44273782427413840E-01,
     0.90507732665257659E-01,
     0.13878863475669165E+00,
     0.18920711500272107E+00,
     0.24185781207348405E+00,
     0.29683955465100967E+00,
     0.35425554693689273E+00,
     0.41421356237309505E+00,
     0.47682614593949931E+00,
     0.54221082540794082E+00,
     0.61049033194925431E+00,
     0.68179283050742909E+00,
     0.75625216037329948E+00,
     0.83400808640934246E+00,
     0.91520656139714729E+00,
     1.0E+00 };
  float value;
  float xint;
  static float xmax = 0.0;
  static float xmin = 0.0;
  float y;

  if ( nterms == 0 )
  {
    nterms = r4_inits ( expcs, 8, 0.1E+00 * r4_mach ( 3 ) );
    xmin = log ( r4_mach ( 1 ) ) + 0.01E+00;
    xmax = log ( r4_mach ( 2 ) ) - 0.001E+00;
  }

  if ( x < xmin )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R4_EXP - Warning!\n" );
    fprintf ( stderr, "  X so small that exp(X) underflows.\n" );
    value = 0.0E+00;
  }
  else if ( x <= xmax )
  {
    xint = r4_aint ( x );
    y = x - xint;

    y = 23.0E+00 * y + x * aln216;
    n = ( int ) ( y );
    f = y - ( float ) ( n );
    n = ( int ) ( 23.0E+00 * xint + ( float ) ( n ) );
    n16 = n / 16;
    if ( n < 0 )
    {
      n16 = n16 - 1;
    }
    ndx = n - 16 * n16 + 1;

    value = 1.0E+00 + ( twon16[ndx-1] + f * ( 1.0E+00 + twon16[ndx-1] ) 
      * r4_csevl ( f, expcs, nterms ) );

    value = r4_pak ( value, n16 );
  }
  else
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R4_EXP - Fatal error!\n" );
    fprintf ( stderr, "  X so large that exp(X) overflows.\n" );
    exit ( 1 );
  }
  return value;
}
/******************************************************************************/

float r4_exprel ( float x )

/******************************************************************************/
/*
  Purpose:

    R4_EXPREL evaluates the exponential relative error term of an R4 argument.

  Discussion:

    The relative error term is ( exp ( x ) - 1 ) / x.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, float X, the argument.

    Output, float R4_EXPREL, the exponential relative error term
    at X.
*/
{
  float absx;
  float alneps;
  int i;
  static int nterms = 0;
  float value;
  static float xbnd = 0.0;
  float xln;
  float xn;

  if ( nterms == 0 )
  {
    alneps = log ( r4_mach ( 3 ) );
    xn = 3.72E+00 - 0.3E+00 * alneps;
    xln = log ( ( xn + 1.0E+00 ) / 1.36E+00 );
    nterms = ( int ) ( xn - ( xn * xln + alneps ) / ( xln + 1.36E+00 ) 
      + 1.5E+00 );
    xbnd = r4_mach ( 3 );
  }

  absx = fabs ( x );

  if ( absx < xbnd )
  {
    value = 1.0E+00;
  }
  else if ( absx <= 0.5E+00 )
  {
    value = 0.0E+00;
    for ( i = 1; i <= nterms; i++ )
    {
      value = 1.0E+00 + value * x / ( float ) ( nterms + 2 - i );
    }
  }
  else
  {
    value = ( exp ( x ) - 1.0E+00 ) / x;
  }
  return value;
}
/******************************************************************************/

float r4_fac ( int n )

/******************************************************************************/
/*
  Purpose:

    R4_FAC evaluates the factorial of an I4 argument.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, int N, the argument.

    Output, float R4_FAC, the factorial of N.
*/
{
  static float facn[26] = {
    1.0E+00,
    1.0E+00,
    2.0E+00,
    6.0E+00,
    24.0E+00,
    120.0E+00,
    720.0E+00,
    5040.0E+00,
    40320.0E+00,
    362880.0E+00,
    3628800.0E+00,
    39916800.0E+00,
    479001600.0E+00,
    6227020800.0E+00,
    87178291200.0E+00,
    1307674368000.0E+00,
    20922789888000.0E+00,
    355687428096000.0E+00,
    6402373705728000.0E+00,
    0.12164510040883200E+18,
    0.24329020081766400E+19,
    0.51090942171709440E+20,
    0.11240007277776077E+22,
    0.25852016738884977E+23,
    0.62044840173323944E+24,
    0.15511210043330986E+26 };
  static int nmax = 0;
  static float sq2pil = 0.91893853320467274E+00;
  float value;
  float x;
  float xmax;
  float xmin;

  if ( nmax == 0 )
  {
    r4_gaml ( &xmin, &xmax );
    nmax = ( int ) ( xmax - 1.0E+00 );
  }

  if ( n < 0 )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R4_FAC - Fatal error!\n" );
    fprintf ( stderr, "  Input argument is negative.\n" );
    exit ( 1 );
  }
  else if ( n <= 25 )
  {
    value = facn[n];
  }
  else if ( n <= nmax )
  {
    x = ( float ) ( n + 1 );
    value = exp ( ( x - 0.5E+00 ) * log ( x ) - x + sq2pil 
      + r4_lgmc ( x ) );
  }
  else
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R4_FAC - Fatal error!\n" );
    fprintf ( stderr, "  Factorial overflows.\n" );
    exit ( 1 );
  }

  return value;
}
/******************************************************************************/

float r4_gami ( float a, float x )

/******************************************************************************/
/*
  Purpose:

    R4_GAMI evaluates the incomplete gamma function for an R4 argument.

  Discussion:

    GAMI = Integral ( 0 <= T <= X ) exp ( - t ) * t^( a - 1 )  dt

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, float A, the parameter.

    Input, float X, the argument.

    Output, float R4_GAMI, the value of the incomplete gamma function.
*/
{
  float factor;
  float value;

  if ( a <= 0.0E+00 )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R4_GAMI - Fatal error!\n" );
    fprintf ( stderr, "  A <= 0.\n" );
    exit ( 1 );
  }

  if ( x < 0.0E+00 )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R4_GAMI - Fatal error!\n" );
    fprintf ( stderr, "  X < 0.\n" );
    exit ( 1 );
  }
  else if ( x == 0.0E+00 )
  {
    value = 0.0E+00;
  }
  else
  {
    factor = exp ( r4_lngam ( a ) + a * log ( x ) );

    value = factor * r4_gamit ( a, x );
  }
  return value;
}
/******************************************************************************/

float r4_gamic ( float a, float x )

/******************************************************************************/
/*
  Purpose:

    R4_GAMIC evaluates the complementary incomplete gamma function.

  Discussion:

    GAMIC = integral ( x <= t < oo ) exp(-t) * t^(a-1) dt

    GAMIC is evaluated for arbitrary float values of A and non-negative
    values X (even though GAMIC is defined for X < 0.0), except that
    for X = 0 and A <= 0.0, GAMIC is undefined.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

    Walter Gautschi,
    A Computational Procedure for Incomplete Gamma Functions,
    ACM Transactions on Mathematical Software,
    Volume 5, Number 4, December 1979, pages 466-481.

  Parameters:

    Input, float A, the parameter.

    Input, float X, the evaluation point.

    Output, float R4_GAMIC, the value of the incomplete gamma function.
*/
{
  float aeps;
  float algap1;
  static float alneps = 0.0;
  float alngs;
  float alx;
  float e;
  static float eps = 0.0;
  float fm;
  float gstar;
  float h;
  int izero;
  int ma;
  float sga;
  float sgng;
  float sgngam;
  float sgngs;
  float t;
  float value;

  if ( eps == 0.0E+00 )
  {
    eps = 0.5E+00 * r4_mach ( 3 );
    alneps = - log ( r4_mach ( 3 ) );
  }

  if ( x < 0.0E+00 )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R4_GAMIC - Fatal error!\n" );
    fprintf ( stderr, "  X < 0.\n" );
    exit ( 1 );
  }

  if ( x == 0.0E+00 )
  {
    if ( a <= 0.0E+00 )
    {
      fprintf ( stderr, "\n" );
      fprintf ( stderr, "R4_GAMIC - Fatal error!\n" );
      fprintf ( stderr, "  X = 0 and A <= 0.\n" );
      exit ( 1 );
    }

    value = exp ( r4_lngam ( a + 1.0E+00 ) - log ( a ) );
    return value;
  }

  alx = log ( x );
  if ( a < 0.0E+00 )
  {
    sga = - 1.0E+00;
  }
  else
  {
    sga = + 1.0E+00;
  }

  ma = ( int ) ( a + 0.5E+00 * sga );
  aeps = a - ( float ) ( ma );

  izero = 0;

  if ( x < 1.0E+00 )
  {
    if ( a <= 0.5E+00 && fabs ( aeps ) <= 0.001E+00 )
    {
      fm = - ( float ) ( ma );

      if ( fm <= 1.0E+00 )
      {
        e = 2.0E+00;
      }
      else
      {
        e = 2.0E+00 * ( fm + 2.0E+00 ) / ( fm * fm - 1.0E+00 );
      }

      e = e - alx * r4_power ( x, - 0.001E+00 );

      if ( e * fabs ( aeps ) <= eps )
      {
        value = r4_gmic ( a, x, alx );
        return value;
      }
    }

    r4_lgams ( a + 1.0E+00, &algap1, &sgngam );
    gstar = r4_gmit ( a, x, algap1, sgngam, alx );

    if ( gstar == 0.0E+00 )
    {
      izero = 1;
    }
    else
    {
      alngs = log ( fabs ( gstar ) );
      sgngs = r4_sign ( gstar );
    }
  }
  else
  {
    if ( a < x )
    {
      value = exp ( r4_lgic ( a, x, alx ) );
      return value;
    }
    sgngam = 1.0E+00;
    algap1 = r4_lngam ( a + 1.0E+00 );
    sgngs = 1.0E+00;
    alngs = r4_lgit ( a, x, algap1 );
  }

  h = 1.0E+00;

  if ( izero != 1 )
  {
    t = a * alx + alngs;

    if ( alneps < t )
    {
      sgng = - sgngs * sga * sgngam;
      t = t + algap1 - log ( fabs ( a ) );
      value = sgng * exp ( t );
      return value;
    }

    if ( - alneps < t )
    {
      h = 1.0E+00 - sgngs * exp ( t );
    }
  }
  sgng = r4_sign ( h ) * sga * sgngam;
  t = log ( fabs ( h ) ) + algap1 - log ( fabs ( a ) );
  value = sgng * exp ( t );
  return value;
}
/******************************************************************************/

float r4_gamit ( float a, float x )

/******************************************************************************/
/*
  Purpose:

    R4_GAMIT evaluates Tricomi's incomplete gamma function for an R4 argument.

  Discussion:

      GAMIT = x^(-a) / gamma(a) 
        * Integral ( 0 <= t <= x ) exp(-t) * t^(a-1) dt

    with analytic continuation for a <= 0.0.  Gamma(x) is the complete
    gamma function of X.  GAMIT is evaluated for arbitrary float values of
    A and for non-negative values of X (even though GAMIT is defined for
    X < 0.0).

    A slight deterioration of 2 or 3 digits accuracy will occur when
    gamit is very large or very small in absolute value, because log-
    arithmic variables are used.  Also, if the parameter A is very close
    to a negative integer (but not a negative integer), there is a loss
    of accuracy.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

    Walter Gautschi,
    A Computational Procedure for Incomplete Gamma Functions,
    ACM Transactions on Mathematical Software,
    Volume 5, Number 4, December 1979, pages 466-481.

  Parameters:

    Input, float A, the parameter.

    Input, float X, the argument.

    Output, float R4_GAMIT, the function value.
*/
{
  float aeps;
  float ainta;
  float algap1;
  static float alneps = 0.0;
  float alng;
  float alx;
  float h;
  float sga;
  float sgngam;
  float t;
  float value;

  if ( alneps == 0.0E+00 )
  {
    alneps = - log ( r4_mach ( 3 ) );
  }

  if ( x < 0.0E+00 )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R4_GAMIT - Fatal error!\n" );
    fprintf ( stderr, "  X is negative.\n" );
    exit ( 1 );
  }
  else if ( x == 0.0E+00 )
  {
    alx = 0.0E+00;
  }
  else
  {
    alx = log ( x );
  }

  if ( a < 0.0E+00 )
  {
    sga = - 1.0E+00;
  }
  else
  {
    sga = + 1.0E+00;
  }

  ainta = r4_aint ( a + 0.5E+00 * sga );
  aeps = a - ainta;

  if ( x == 0.0E+00 )
  {
    if ( 0.0E+00 < ainta || aeps != 0.0E+00 )
    {
      value = r4_gamr ( a + 1.0E+00 );
    }
    else
    {
      value = 0.0E+00;
    }
    return value;
  }

  if ( x <= 1.0E+00 )
  {
    if ( - 0.5E+00 <= a || aeps != 0.0E+00 )
    {
      r4_lgams ( a + 1.0E+00, &algap1, &sgngam );
    }
    value = r4_gmit ( a, x, algap1, sgngam, alx );
    return value;
  }

  if ( x <= a )
  {
    t = r4_lgit ( a, x, r4_lngam ( a + 1.0E+00 ) );
    value = exp ( t );
    return value;
  }

  alng = r4_lgic ( a, x, alx );
/*
  Evaluate in terms of log(value(a,x))
*/
  h = 1.0E+00;

  if ( aeps != 0.0E+00 || 0.0E+00 < ainta )
  {
    r4_lgams ( a + 1.0E+00, &algap1, &sgngam );
    t = log ( fabs ( a ) ) + alng - algap1;

    if ( alneps < t )
    {
      t = t - a * alx;
      value = - sga * sgngam * exp ( t );
      return value;
    }

    if ( - alneps < t )
    {
      h = 1.0E+00 - sga * sgngam * exp ( t );
    }

  }

  t = - a * alx + log ( fabs ( h ) );

  if ( h < 0.0E+00 )
  {
    value = - exp ( t );
  }
  else
  {
    value = + exp ( t );
  }
  return value;
}
/******************************************************************************/

void r4_gaml ( float *xmin, float *xmax )

/******************************************************************************/
/*
  Purpose:

    R4_GAML evaluates bounds for an R4 argument of the gamma function.

  Discussion:

    This function calculates the minimum and maximum legal bounds 
    for X in the evaluation of GAMMA ( X ).

    XMIN and XMAX are not the only bounds, but they are the only 
    non-trivial ones to calculate.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Output, float *XMIN, *XMAX, the bounds.
*/
{
  float alnbig;
  float alnsml;
  int i;
  int j;
  float xln;
  float xold;

  alnsml = log ( r4_mach ( 1 ) );
  *xmin = - alnsml;

  for ( i = 1; i <= 10; i++ )
  {
    xold = *xmin;
    xln = log ( *xmin );
    *xmin = *xmin - *xmin * ( ( *xmin + 0.5E+00 ) * xln - *xmin 
      - 0.2258E+00 + alnsml ) / ( *xmin * xln + 0.5E+00 );

    if ( fabs ( *xmin - xold ) < 0.005E+00 )
    {
      *xmin = - *xmin + 0.01E+00;

      alnbig = log ( r4_mach ( 2 ) );
      *xmax = alnbig;

      for ( j = 1; j <= 10; j++ )
      {
        xold = *xmax;
        xln = log ( *xmax );
        *xmax = *xmax - *xmax * ( ( *xmax - 0.5E+00 ) * xln - *xmax 
          + 0.9189E+00 - alnbig ) / ( *xmax * xln - 0.5E+00 );

        if ( fabs ( *xmax - xold ) < 0.005E+00 )
        {
          *xmax = *xmax - 0.01E+00;
          *xmin = fmax ( *xmin, - *xmax + 1.0E+00 );
          return;
        }
      }
      fprintf ( stderr, "\n" );
      fprintf ( stderr, "R4_GAML - Fatal error!\n" );
      fprintf ( stderr, "  Unable to find XMAX.\n" );
      exit ( 1 );
    }
  }
  fprintf ( stderr, "\n" );
  fprintf ( stderr, "R4_GAML - Fatal error!\n" );
  fprintf ( stderr, "  Unable to find XMIN.\n" );
  exit ( 1 );
}
/******************************************************************************/

float r4_gamma ( float x )

/******************************************************************************/
/*
  Purpose:

    R4_GAMMA evaluates the gamma function of an R4 argument.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, float X, the argument.

    Output, float R4_GAMMA, the gamma function of X.
*/
{
  static float dxrel = 0.0;
  static float gcs[23] = {
     0.008571195590989331E+00,
     0.004415381324841007E+00,
     0.05685043681599363E+00,
    -0.004219835396418561E+00,
     0.001326808181212460E+00,
    -0.0001893024529798880E+00,
     0.0000360692532744124E+00,
    -0.0000060567619044608E+00,
     0.0000010558295463022E+00,
    -0.0000001811967365542E+00,
     0.0000000311772496471E+00,
    -0.0000000053542196390E+00,
     0.0000000009193275519E+00,
    -0.0000000001577941280E+00,
     0.0000000000270798062E+00,
    -0.0000000000046468186E+00,
     0.0000000000007973350E+00,
    -0.0000000000001368078E+00,
     0.0000000000000234731E+00,
    -0.0000000000000040274E+00,
     0.0000000000000006910E+00,
    -0.0000000000000001185E+00,
     0.0000000000000000203E+00 };
  int i;
  int n;
  static int ngcs = 0;
  static float pi = 3.14159265358979324E+00;
  float sinpiy;
  static float sq2pil = 0.91893853320467274E+00;
  float value;
  static float xmax = 0.0;
  static float xmin = 0.0;
  static float xsml = 0.0;
  float y;

  if ( ngcs == 0 )
  {
    ngcs = r4_inits ( gcs, 23, 0.1E+00 * r4_mach ( 3 ) );
    r4_gaml ( &xmin, &xmax );
    xsml = exp ( fmax ( log ( r4_mach ( 1 ) ),
      - log ( r4_mach ( 2 ) ) ) + 0.01E+00 );
    dxrel = sqrt ( r4_mach ( 4 ) );
  }

  y = fabs ( x );

  if ( y <= 10.0E+00 )
  {
    n = ( int ) ( x );
    if ( x < 0.0E+00 )
    {
      n = n - 1;
    }
    y = x - ( float ) ( n );
    n = n - 1;
    value = 0.9375E+00 + r4_csevl ( 2.0E+00 * y - 1.0E+00, gcs, ngcs );

    if ( n == 0 )
    {
      return value;
    }
    else if ( n < 0 )
    {
      n = - n;

      if ( x == 0.0E+00 )
      {
        fprintf ( stderr, "\n" );
        fprintf ( stderr, "R4_GAMMA - Fatal error!\n" );
        fprintf ( stderr, "  X is 0.\n" );
        exit ( 1 );
      }

      if ( x < 0.0E+00 && x + ( float ) ( n - 2 ) == 0.0E+00 )
      {
        fprintf ( stderr, "\n" );
        fprintf ( stderr, "R4_GAMMA - Fatal error!\n" );
        fprintf ( stderr, "  X is a negative integer.\n" );
        exit ( 1 );
      }

      if ( x < - 0.5E+00 && fabs ( ( x - r4_aint ( x - 0.5E+00 ) ) / x ) < dxrel )
      {
        fprintf ( stderr, "\n" );
        fprintf ( stderr, "R4_GAMMA - Warning!\n" );
        fprintf ( stderr, "  X too near a negative integer,\n" );
        fprintf ( stderr, "  answer is half precision.\n" );
      }

      if ( y < xsml )
      {
        fprintf ( stderr, "\n" );
        fprintf ( stderr, "R4_GAMMA - Fatal error!\n" );
        fprintf ( stderr, "  X is so close to zero that Gamma overflows.\n" );
        fprintf ( stderr, "  X = %g\n", x );
        exit ( 1 );
      }

      for ( i = 1; i <= n; i++ )
      {
        value = value / ( x + ( float ) ( i - 1 ) );
      }
    }
    else if ( n == 0 )
    {
    }
    else
    {
      for ( i = 1; i <= n; i++ )
      {
        value = ( y + ( float ) ( i ) ) * value;
      }
    }
  }
  else
  {
    if ( xmax < x )
    {
      fprintf ( stderr, "\n" );
      fprintf ( stderr, "R4_GAMMA - Fatal error!\n" );
      fprintf ( stderr, "  X so big that Gamma overflows.\n" );
      exit ( 1 );
    }
/*
  Underflow.
*/
    if ( x < xmin )
    {
      value = 0.0E+00;
      return value;
    }

    value = exp ( ( y - 0.5E+00 ) * log ( y ) - y + sq2pil + r4_lgmc ( y ) );

    if ( 0.0E+00 < x )
    {
      return value;
    }

    if ( fabs ( ( x - r4_aint ( x - 0.5E+00 ) ) / x ) < dxrel )
    {
      fprintf ( stderr, "\n" );
      fprintf ( stderr, "R4_GAMMA - Warning!\n" );
      fprintf ( stderr, "  X too near a negative integer,\n" );
      fprintf ( stderr, "  answer is half precision.\n" );
    }

    sinpiy = sin ( pi * y );

    if ( sinpiy == 0.0E+00 )
    {
      fprintf ( stderr, "\n" );
      fprintf ( stderr, "R4_GAMMA - Fatal error!\n" );
      fprintf ( stderr, "  X is a negative integer.\n" );
      exit ( 1 );
    }
    value = - pi / ( y * sinpiy * value );
  }
  return value;
}
/******************************************************************************/

float r4_gamr ( float x )

/******************************************************************************/
/*
  Purpose:

    R4_GAMR evaluates the reciprocal gamma function of an R4 argument.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, float X, the argument.

    Output, float R4_GAMR, the value of the reciprocal gamma
    function at X.
*/
{
  float alngx;
  float sgngx;
  float value;

  if ( x <= 0.0E+00 && r4_aint ( x ) == x )
  {
    value = 0.0E+00;
  }
  else if ( fabs ( x ) <= 10.0E+00 )
  {
    value = 1.0E+00 / r4_gamma ( x );
  }
  else
  {
    r4_lgams ( x, &alngx, &sgngx );
    value = sgngx * exp ( - alngx );
  }

  return value;
 }
/******************************************************************************/

float r4_gmic ( float a, float x, float alx )

/******************************************************************************/
/*
  Purpose:

    R4_GMIC: complementary incomplete gamma, small X, A near negative integer.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, float A, the parameter.

    Input, float X, the argument.

    Input, float ALX, the logarithm of X.

    Output, float R4_GMIC, the complementary incomplete 
    gamma function.
*/
{
  float alng;
  static float bot = 0.0;
  int converged;
  static float eps = 0.0;
  static float euler = 0.5772156649015329E+00;
  float fk;
  float fkp1;
  float fm;
  int k;
  int m;
  int ma;
  int mm1;
  float s;
  float sgng;
  float t;
  float te;
  float value;

  if ( eps == 0.0E+00 )
  {
    eps = 0.5E+00 * r4_mach ( 3 );
    bot = log ( r4_mach ( 1 ) );
  }

  if ( 0.0E+00 < a )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R4_GMIC - Fatal error!\n" );
    fprintf ( stderr, "  A must be near a negative integer.\n" );
    exit ( 1 );
  }

  if ( x <= 0.0E+00 )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R4_GMIC - Fatal error!\n" );
    fprintf ( stderr, "  X <= 0.\n" );
    exit ( 1 );
  }

  ma = ( int ) ( a - 0.5E+00 );
  fm = - ( float ) ( ma );
  m = - ma;

  te = 1.0E+00;
  t = 1.0E+00;
  s = t;
  converged = 0;

  for ( k = 1; k <= 200; k++ )
  {
    fkp1 = ( float ) ( k + 1 );
    te = - x * te / ( fm + fkp1 );
    t = te / fkp1;
    s = s + t;
    if ( fabs ( t ) < eps * s )
    {
      converged = 1;
      break;
    }
  }

  if ( !converged )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R4_GMIC - Fatal error!\n" );
    fprintf ( stderr, "  No convergence after 200 iterations.\n" );
    exit ( 1 );
  }

  value = - alx - euler + x * s / ( fm + 1.0E+00 );

  if ( m == 0 )
  {
    return value;
  }
  else if ( m == 1 )
  {
    value = - value - 1.0E+00 + 1.0E+00 / x;
    return value;
  }

  te = fm;
  t = 1.0E+00;
  s = t;
  mm1 = m - 1;
  for ( k = 1; k <= mm1; k++ )
  {
    fk = ( float ) ( k );
    te = - x * te / fk;
    t = te / ( fm - fk );
    s = s + t;
    if ( fabs ( t ) < eps * fabs ( s ) )
    {
      break;
    }
  }

  for ( k = 1; k <= m; k++ )
  {
    value = value + 1.0E+00 / ( float ) ( k );
  }

  if ( ( m % 2 ) == 1 )
  {
    sgng = - 1.0E+00;
  }
  else
  {
    sgng = + 1.0E+00;
  }

  alng = log ( value ) - r4_lngam ( fm + 1.0E+00 );

  if ( bot < alng )
  {
    value = sgng * exp ( alng );
  }
  else
  {
    value = 0.0E+00;
  }

  if ( s != 0.0E+00 )
  {
    value = value + r4_sign ( s ) 
      * exp ( - fm * alx + log ( fabs ( s ) / fm ) );
  }

  return value;
}
/******************************************************************************/

float r4_gmit ( float a, float x, float algap1, float sgngam, float alx )

/******************************************************************************/
/*
  Purpose:

    R4_GMIT: Tricomi's incomplete gamma function for small X.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, float A, the parameter.

    Input, float X, the argument.

    Input, float ALGAP1, the logarithm of Gamma ( A + 1 ).

    Input, float SGNGAM, the sign of Gamma ( A + 1 ).

    Input, float ALX, the logarithm of X.

    Output, float R4_GMIT, the Tricomi incomplete gamma function.
*/
{
  float ae;
  float aeps;
  float alg2;
  float algs;
  static float bot = 0.0;
  int converged;
  static float eps = 0.0;
  float fk;
  int k;
  int m;
  int ma;
  float s;
  float sgng2;
  float t;
  float te;
  float value;

  if ( eps == 0.0E+00 )
  {
    eps = 0.5E+00 * r4_mach ( 3 );
    bot = log ( r4_mach ( 1 ) );
  }

  if ( x <= 0.0E+00 )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R4_GMIT - Fatal error!\n" );
    fprintf ( stderr, "  X <= 0.\n" );
    exit ( 1 );
  }

  if ( a < 0.0E+00 )
  {
    ma = ( int ) ( a - 0.5E+00 );
  }
  else
  {
    ma = ( int ) ( a + 0.5E+00 );
  }

  aeps = a - ( float ) ( ma );

  if ( a < - 0.5E+00 )
  {
    ae = aeps;
  }
  else
  {
    ae = a;
  }

  t = 1.0E+00;
  te = ae;
  s = t;
  converged = 0;
  for ( k = 1; k <= 200; k++ )
  {
    fk = ( float ) ( k );
    te = - x * te / fk;
    t = te / ( ae + fk );
    s = s + t;
    if ( fabs ( t ) < eps * fabs ( s ) )
    {
      converged = 1;
      break;
    }
  }

  if ( !converged )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R4_GMIT - Fatal error!\n" );
    fprintf ( stderr, "  No convergence in 200 iterations.\n" );
    exit ( 1 );
  }

  if ( - 0.5E+00 <= a )
  {
    algs = - algap1 + log ( s );
    value = exp ( algs );
    return value;
  }

  algs = - r4_lngam ( 1.0E+00 + aeps ) + log ( s );
  s = 1.0E+00;
  m = - ma - 1;
  t = 1.0E+00;

  for ( k = 1; k <= m; k++ )
  {
    t = x * t / ( aeps - ( float ) ( m + 1 - k ) );
    s = s + t;
    if ( fabs ( t ) < eps * fabs ( s ) )
    {
      break;
    }
  }

  value = 0.0E+00;
  algs = - ( float ) ( ma ) * log ( x ) + algs;

  if ( s == 0.0E+00 || aeps == 0.0E+00 )
  {
    value = exp ( algs );
    return value;
  }

  sgng2 = sgngam * r4_sign ( s );
  alg2 = - x - algap1 + log ( fabs ( s ) );

  if ( bot < alg2 )
  {
    value = sgng2 * exp ( alg2 );
  }

  if ( bot < algs )
  {
    value = value + exp ( algs );
  }

  return value;
}
/******************************************************************************/

int r4_inits ( float dos[], int nos, float eta )

/******************************************************************************/
/*
  Purpose:

    R4_INITS initializes a Chebyshev series.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    C version by John Burkardt.

  Reference:

    Roger Broucke,
    Algorithm 446:
    Ten Subroutines for the Manipulation of Chebyshev Series,
    Communications of the ACM,
    Volume 16, Number 4, April 1973, pages 254-256.

  Parameters:

    Input, float DOS[NOS], the Chebyshev coefficients.

    Input, int NOS, the number of coefficients.

    Input, float ETA, the desired accuracy.

    Output, int R4_INITS, the number of terms of the series needed
    to ensure the requested accuracy.
*/
{
  float err;
  int i;
  int value;

  if ( nos < 1 )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R4_INITS - Fatal error!\n" );
    fprintf ( stderr, "  Number of coefficients < 1.\n" );
    exit ( 1 );
  }

  err = 0.0;

  for ( i = nos - 1; 0 <= i; i-- )
  {
    err = err + fabs ( dos[i] );
    if ( eta < err )
    {
      value = i + 1;
      return value;
    }
  }

  value = i;
  fprintf ( stderr, "\n" );
  fprintf ( stderr, "R4_INITS - Warning!\n" );
  fprintf ( stderr, "  ETA may be too small.\n" );

  return value;
}
/******************************************************************************/

float r4_int ( float x )

/******************************************************************************/
/*
  Purpose:

    R4_INT returns the integer part of an R4 argument.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, float X, the argument.

    Output, float R4_INT, the integer part of X.
*/
{
  int i;
  int ibase;
  int ipart;
  int iscale;
  static int npart = 0;
  float part;
  static float scale = 0.0;
  float value;
  static float xbig = 0.0;
  static float xmax = 0.0;
  float xscl;

  if ( npart == 0 )
  {
    ibase = i4_mach ( 10 );
    xmax = 1.0E+00 / r4_mach ( 4 );
    xbig = fmin ( ( float ) ( i4_mach ( 9 ) ), xmax );
    iscale = i4_pow ( ibase, ( int ) ( log ( xbig ) 
      / log ( ( float ) ( ibase ) ) - 0.5E+00 ) );
    scale = ( float ) iscale;
    npart = log ( xmax ) / log ( scale ) + 1.0E+00;
  }

  if ( x < - xmax )
  {
    value = x;
  }
  else if ( x < - xbig )
  {
    xscl = - x;

    for ( i = 1; i <= npart; i++ )
    {
      xscl = xscl / scale;
    }

    value = 0.0E+00;
    for ( i = 1; i <= npart; i++ )
    {
      xscl = xscl * scale;
      ipart = ( int ) ( xscl );
      part = ( float ) ( ipart );
      xscl = xscl - part;
      value = value * scale + part;
    }
    value = - value;
  }
  else if ( x < + xbig )
  {
    value = ( int ) ( x );
  }
  else if ( x < + xmax )
  {
    xscl = x;

    for ( i = 1; i <= npart; i++ )
    {
      xscl = xscl / scale;
    }

    value = 0.0E+00;
    for ( i = 1; i <= npart; i++ )
    {
      xscl = xscl * scale;
      ipart = ( int ) ( xscl );
      part = ( float ) ( ipart );
      xscl = xscl - part;
      value = value * scale + part;
    }
  }
  else
  {
    value = x;
  }
  return value;
}
/******************************************************************************/

void r4_knus ( float xnu, float x, float *bknu, float *bknu1, int *iswtch )

/******************************************************************************/
/*
  Purpose:

    R4_KNUS computes a sequence of K Bessel functions.

  Discussion:

    This routine computes Bessel functions 
      exp(x) * k-sub-xnu (x)  
    and
      exp(x) * k-sub-xnu+1 (x) 
    for 0.0 <= xnu < 1.0.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, float XNU, the order parameter.

    Input, float X, the argument.

    Output, float *BKNU, *BKNU1, the two K Bessel functions.

    Output, integer *ISWTCH, ?
*/
{
  float a[15];
  float a0;
  static float aln2 = 0.69314718055994531E+00;
  static float alnbig = 0.0;
  static float alneps = 0.0;
  static float alnsml = 0.0;
  float alnz;
  float alpha[15];
  float an;
  float b0;
  float beta[15];
  float bknu0;
  float bknud;
  float bn;
  float c0;
  static float c0kcs[16] = {
    0.060183057242626108E+00,
   -0.15364871433017286E+00,
   -0.011751176008210492E+00,
   -0.000852487888919795E+00,
   -0.000061329838767496E+00,
   -0.000004405228124551E+00,
   -0.000000316312467283E+00,
   -0.000000022710719382E+00,
   -0.000000001630564460E+00,
   -0.000000000117069392E+00,
   -0.000000000008405206E+00,
   -0.000000000000603466E+00,
   -0.000000000000043326E+00,
   -0.000000000000003110E+00,
   -0.000000000000000223E+00,
   -0.000000000000000016E+00 };
  static float euler = 0.57721566490153286E+00;
  float expx;
  int i;
  int ii;
  int inu;
  int n;
  static int ntc0k = 0;
  int nterms;
  static int ntznu1 = 0;
  float p1;
  float p2;
  float p3;
  float qq;
  float result;
  static float sqpi2 = 1.2533141373155003E+00;
  float sqrtx;
  float v;
  float vlnz;
  float x2n;
  float x2tov;
  float xi;
  float xmu;
  static float xnusml = 0.0;
  static float xsml = 0.0;
  float z;
  static float znu1cs[12] = {
    0.20330675699419173E+00,
    0.14007793341321977E+00,
    0.007916796961001613E+00,
    0.000339801182532104E+00,
    0.000011741975688989E+00,
    0.000000339357570612E+00,
    0.000000008425941769E+00,
    0.000000000183336677E+00,
    0.000000000003549698E+00,
    0.000000000000061903E+00,
    0.000000000000000981E+00,
    0.000000000000000014E+00 };
  float ztov;

  if ( ntc0k == 0 )
  {
    ntc0k = r4_inits ( c0kcs, 16, 0.1E+00 * r4_mach ( 3 ) );
    ntznu1 = r4_inits ( znu1cs, 12, 0.1E+00 * r4_mach ( 3 ) );
    xnusml = sqrt ( r4_mach ( 3 ) / 8.0E+00 );
    xsml = 0.1E+00 * r4_mach ( 3 );
    alnsml = log ( r4_mach ( 1 ) );
    alnbig = log ( r4_mach ( 2 ) );
    alneps = log ( 0.1E+00 * r4_mach ( 3 ) );
  }

  if ( xnu < 0.0E+00 || 1.0E+00 <= xnu )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R4_KNUS - Fatal error!\n" );
    fprintf ( stderr, "  XNU < 0 or. 1 <= XNU.\n" );
    exit ( 1 );
  }

  if ( x <= 0.0E+00 )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R4_KNUS - Fatal error!\n" );
    fprintf ( stderr, "  X <= 0.\n" );
    exit ( 1 );
  }

  *iswtch = 0;
/*
  X is small.  Compute k-sub-xnu (x) and the derivative of k-sub-xnu (x)
  then find k-sub-xnu+1 (x).  xnu is reduced to the interval (-.5,+.5)
  then to (0., .5), because k of negative order (-nu) = k of positive
  order (+nu).
*/
  if ( x <= 2.0E+00 )
  {
    if ( 0.5E+00 < xnu )
    {
      v = 1.0E+00 - xnu;
    }
    else
    {
      v = xnu;
    }
/*
  Carefully find (x/2)^xnu and z^xnu where z = x*x/4.
*/
    alnz = 2.0E+00 * ( log ( x ) - aln2 );

    if ( x <= xnu )
    {
      if ( alnbig < - 0.5E+00 * xnu * alnz - aln2 - log ( xnu ) )
      {
        fprintf ( stderr, "\n" );
        fprintf ( stderr, "R4_KNUS - Fatal error!\n" );
        fprintf ( stderr, "  Small X causing overflow.\n" );
        exit ( 1 );
      }
    }
    vlnz = v * alnz;
    x2tov = exp ( 0.5E+00 * vlnz );

    if ( alnsml < vlnz )
    {
      ztov = x2tov * x2tov;
    }
    else
    {
      ztov = 0.0E+00;
    }

    a0 = 0.5E+00 * r4_gamma ( 1.0E+00 + v );
    b0 = 0.5E+00 * r4_gamma ( 1.0E+00 - v );
    c0 = - euler;

    if ( 0.5E+00 < ztov && xnusml < v )
    {
      c0 = - 0.75E+00 + r4_csevl ( ( 8.0E+00 * v ) * v - 1.0E+00, c0kcs, ntc0k );
    }

    if ( ztov <= 0.5E+00 )
    {
      alpha[0] = ( a0 - ztov * b0 ) / v;
    }
    else
    {
      alpha[0] = c0 - alnz * ( 0.75E+00 +
        r4_csevl ( vlnz / 0.35E+00 + 1.0E+00, znu1cs, ntznu1 ) ) * b0;
    }

    beta[0] = - 0.5E+00 * ( a0 + ztov * b0 );

    if ( xsml < x )
    {
      z = 0.25E+00 * x * x;
    }
    else
    {
      z = 0.0E+00;
    }

    nterms = ( int ) fmax ( 2.0E+00, 11.0E+00 
      + ( 8.0E+00 * alnz - 25.19E+00 - alneps ) / ( 4.28E+00 - alnz ) );

    for ( i = 2; i <= nterms; i++ )
    {
      xi = ( float ) ( i - 1 );
      a0 = a0 / ( xi * ( xi - v) );
      b0 = b0 / ( xi * ( xi + v) );
      alpha[i-1] = ( alpha[i-2] + 2.0E+00 * xi * a0 ) 
        / ( xi * ( xi + v ) );
      beta[i-1] = ( xi - 0.5E+00 * v ) * alpha[i-1] - ztov * b0;
    }

    *bknu = alpha[nterms-1];
    bknud = beta[nterms-1];
    for ( ii = 2; ii <= nterms; ii++ )
    {
      i = nterms + 1 - ii;
      *bknu = alpha[i-1] + *bknu * z;
      bknud = beta[i-1] + bknud * z;
    }

    expx = exp ( x );
    *bknu = expx * *bknu / x2tov;

    if ( alnbig < - 0.5E+00 * ( xnu + 1.0E+00 ) * alnz - 2.0E+00 * aln2 )
    {
      *iswtch = 1;
      return;
    }

    bknud = expx * bknud * 2.0E+00 / ( x2tov * x );

    if ( xnu <= 0.5E+00 )
    {
      *bknu1 = v * *bknu / x - bknud;
      return;
    }

    bknu0 = *bknu;
    *bknu = - v * *bknu / x - bknud;
    *bknu1 = 2.0E+00 * xnu * *bknu / x + bknu0;
  }
/*
  X is large.  Find k-sub-xnu (x) and k-sub-xnu+1 (x) with y. l. luke's
  rational expansion.
*/
  else
  {
    sqrtx = sqrt ( x );

    if ( 1.0E+00 / xsml < x )
    {
      *bknu = sqpi2 / sqrtx;
      *bknu1 = *bknu;
      return;
    }

    an = - 1.56E+00 + 4.0E+00 / x;
    bn = - 0.29E+00 - 0.22E+00 / x;
    nterms = i4_min ( 15, ( int ) fmax ( 3.0E+00, an + bn * alneps ) );

    for ( inu = 1; inu <= 2; inu++ )
    {
      if ( inu == 1 )
      {
        if ( xnusml < xnu )
        {
          xmu = ( 4.0E+00 * xnu ) * xnu;
        }
        else
        {
          xmu = 0.0E+00;
        }
      }
      else
      {
        xmu = 4.0E+00 * pow ( fabs ( xnu ) + 1.0E+00, 2 );
      }

      a[0] = 1.0E+00 - xmu;
      a[1] = 9.0E+00 - xmu;
      a[2] = 25.0E+00 - xmu;

      if ( a[1] == 0.0E+00 )
      {
        result = sqpi2 * ( 16.0E+00 * x + xmu + 7.0E+00 )
          / ( 16.0E+00 * x * sqrtx );
      }
      else
      {
        alpha[0] = 1.0E+00;
        alpha[1] = ( 16.0E+00 * x + a[1] ) / a[1];
        alpha[2] = ( ( 768.0E+00 * x + 48.0E+00 * a[2] ) * x 
          + a[1] * a[2] ) / ( a[1] * a[2] );

        beta[0] = 1.0E+00;
        beta[1] = ( 16.0E+00 * x + ( xmu + 7.0E+00 ) ) / a[1];
        beta[2] = ( ( 768.0E+00 * x + 48.0E+00 * ( xmu + 23.0E+00 ) ) * x 
          + ( ( xmu + 62.0E+00 ) * xmu + 129.0E+00 ) ) / ( a[1] * a[2] );

        for ( i = 4; i <= nterms; i++ )
        {
          n = i - 1;
          x2n = ( float ) ( 2 * n - 1 );

          a[i-1] = pow ( x2n + 2.0E+00, 2 ) - xmu;
          qq = 16.0E+00 * x2n / a[i-1];
          p1 = - x2n * ( ( float ) ( 12 * n * n - 20 * n ) 
            - a[0] ) / ( ( x2n - 2.0E+00 ) * a[i-1] ) - qq * x;
          p2 = ( ( float ) ( 12 * n * n - 28 * n + 8 ) - a[0] ) 
            / a[i-1] - qq * x;
          p3 = - x2n * a[i-4] / ( ( x2n - 2.0E+00 ) * a[i-1] );

          alpha[i-1] = - p1 * alpha[i-2] 
                       - p2 * alpha[i-3] 
                       - p3 * alpha[i-4];

          beta[i-1] =  - p1 * beta[i-2] 
                       - p2 * beta[i-3]  
                       - p3 * beta[i-4];

        }
        result = sqpi2 * beta[nterms-1] / ( sqrtx * alpha[nterms-1] );
      }

      if ( inu == 1 )
      {
        *bknu = result;
      }
      else
      {
        *bknu1 = result;
      }
    }
  }
  return;
}
/******************************************************************************/

float r4_lbeta ( float a, float b )

/******************************************************************************/
/*
  Purpose:

    R4_LBETA evaluates the logarithm of the beta function of R4 arguments.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, float A, B, the arguments.

    Output, float R4_LBETA, the logarithm of the beta function of A
    and B.
*/
{
  float corr;
  float p;
  float q;
  static float sq2pil = 0.91893853320467274E+00;
  float value;

  p = fmin ( a, b );
  q = fmax ( a, b );

  if ( p <=  0.0E+00 )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R4_LBETA - Fatal error!\n" );
    fprintf ( stderr, "  Both arguments must be greater than 0.\n" );
    exit ( 1 );
  }
  else if ( p < 10.0E+00 && q <= 10.0E+00 )
  {
    value = log ( r4_gamma ( p ) * ( r4_gamma ( q ) / r4_gamma ( p + q ) ) );
  }
  else if ( p < 10.0E+00 )
  {
    corr = r4_lgmc ( q ) - r4_lgmc ( p + q );

    value = r4_lngam ( p ) + corr + p - p * log ( p + q ) +
      ( q - 0.5E+00 ) * r4_lnrel ( - p / ( p + q ) );
  }
  else
  {
    corr = r4_lgmc ( p ) + r4_lgmc ( q ) - r4_lgmc ( p + q );

    value = - 0.5E+00 * log ( q ) + sq2pil + corr 
      + ( p - 0.5E+00 ) * log ( p / ( p + q ) ) 
      + q * r4_lnrel ( - p / ( p + q ) );
  }
  return value;
}
/******************************************************************************/

void r4_lgams ( float x, float *algam, float *sgngam )

/******************************************************************************/
/*
  Purpose:

    R4_LGAMS evaluates the log of |gamma(x)| and sign, for an R4 argument.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, float X, the argument.

    Output, float *ALGAM, the logarithm of the absolute value of
    gamma ( X ).

    Output, float *SGNGAM, the sign (+1 or -1 ) of gamma ( X ).
*/
{
  int k;

  *algam = r4_lngam ( x );
  *sgngam = 1.0E+00;

  if ( x <= 0.0E+00 )
  {
    k = ( int ) ( r4_mod ( - r4_aint ( x ), 2.0E+00 ) + 0.1E+00 );

    if ( k == 0 )
    {
      *sgngam = - 1.0E+00;
    }
  }
  return;
}
/******************************************************************************/

float r4_lgic ( float a, float x, float alx )

/******************************************************************************/
/*
  Purpose:

    R4_LGIC evaluates the log complementary incomplete gamma function for large X.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, float A, the parameter.

    Input, float X, the argument.

    Input, float ALX, the logarithm of X.

    Output, float R4_LGIC, the log complementary incomplete gamma function.
*/
{
  static float eps = 0.0;
  float fk;
  int k;
  float p;
  float r;
  float s;
  float t;
  float value;
  float xma;
  float xpa;

  if ( eps == 0.0E+00 )
  {
    eps = 0.5E+00 * r4_mach ( 3 );
  }

  xpa = x + 1.0E+00 - a;
  xma = x - 1.0E+00 - a;

  r = 0.0E+00;
  p = 1.0E+00;
  s = p;
  for ( k = 1; k <= 200; k++ )
  {
    fk = ( float ) ( k );
    t = fk * ( a - fk ) * ( 1.0E+00 + r );
    r = - t / ( ( xma + 2.0E+00 * fk ) * ( xpa + 2.0E+00 * fk ) + t );
    p = r * p;
    s = s + p;
    if ( fabs ( p ) < eps * s )
    {
      value = a * alx - x + log ( s / xpa );
      return value;
    }
  }
  fprintf ( stderr, "\n" );
  fprintf ( stderr, "R4_LGIC - Fatal error!\n" );
  fprintf ( stderr, "  No convergence in 200 iterations.\n" );

  exit ( 1 );
}
/******************************************************************************/

float r4_lgit ( float a, float x, float algap1 )

/******************************************************************************/
/*
  Purpose:

    R4_LGIT evaluates the log of Tricomi's incomplete gamma function.

  Discussion:

    Perron's continued fraction is used for large X and X <= A.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, float A, the parameter.

    Input, float X, the argument.

    Input, float ALGAP1, the logarithm of the gamma function of A+1.

    Output, float R4_LGIT, the log of Tricomi's incomplete
    gamma function.
*/
{
  float a1x;
  float ax;
  static float eps = 0.0;
  float fk;
  float hstar;
  int k;
  float p;
  float r;
  float s;
  float t;
  float value;

  if ( eps == 0.0E+00 )
  {
    eps = 0.5E+00 * r4_mach ( 3 );
  }

  if ( x <= 0.0E+00 )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R4_LGIT - Fatal error!\n" );
    fprintf ( stderr, "  X <= 0.\n" );
    exit ( 1 );
  }

  if ( a < x )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R4_LGIT - Fatal error!\n" );
    fprintf ( stderr, "  A < X.\n" );
    exit ( 1 );
  }

  ax = a + x;
  a1x = ax + 1.0E+00;
  r = 0.0E+00;
  p = 1.0E+00;
  s = p;

  for ( k = 1; k <= 200; k++ )
  {
    fk = ( float ) k;
    t = ( a + fk ) * x * ( 1.0E+00 + r );
    r = t / ( ( ax + fk ) * ( a1x + fk ) - t );
    p = r * p;
    s = s + p;
    if ( fabs ( p ) < eps * s )
    {
      hstar = 1.0E+00 - x * s / a1x;
      value = - x - algap1 - log ( hstar );
      return value;
    }
  }

  fprintf ( stderr, "\n" );
  fprintf ( stderr, "R4_LGIT - Fatal error!\n" );
  fprintf ( stderr, "  No convergence after 200 iterations.\n" );
  exit ( 1 );
}
/******************************************************************************/

float r4_lgmc ( float x )

/******************************************************************************/
/*
  Purpose:

    R4_LGMC evaluates the log gamma correction factor for an R4 argument.

  Discussion:

    For 10 <= X, compute the log gamma correction factor so that

      log ( gamma ( x ) ) = log ( sqrt ( 2 * pi ) ) 
                          + ( x - 0.5 ) * log ( x ) - x 
                          + value ( x )

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, float X, the argument.

    Output, float R4_LGMC, the correction factor.
*/
{
  static float algmcs[6] = {
    0.166638948045186E+00,
   -0.0000138494817606E+00,
    0.0000000098108256E+00,
   -0.0000000000180912E+00,
    0.0000000000000622E+00,
   -0.0000000000000003E+00 };
  static int nalgm = 0;
  float value;
  static float xbig = 0.0;
  static float xmax = 0.0;

  if ( nalgm == 0 )
  {
    nalgm = r4_inits ( algmcs, 6, r4_mach ( 3 ) );
    xbig = 1.0E+00 / sqrt ( r4_mach ( 3 ) );
    xmax = exp ( fmin ( log ( r4_mach ( 2 ) / 12.0E+00 ), 
      - log ( 12.0E+00 * r4_mach ( 1 ) ) ) );
  }

  if ( x < 10.0E+00 )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R4_LGMC - Fatal error!\n" );
    fprintf ( stderr, "  X must be at least 10.\n" );
    exit ( 1 );
  }
  else if ( x < xbig )
  {
    value = r4_csevl ( 2.0E+00 * ( 10.0E+00 / x ) 
      * ( 10.0E+00 / x ) - 1.0E+00, algmcs, nalgm ) / x;
  }
  else if ( x < xmax )
  {
    value = 1.0E+00 / ( 12.0E+00 * x );
  }
  else
  {
    value = 0.0E+00;
  }
  return value;
}
/******************************************************************************/

float r4_li ( float x )

/******************************************************************************/
/*
  Purpose:

    R4_LI evaluates the logarithmic integral for an R4 argument.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, float X, the argument.

    Output, float R4_LI, the logarithmic integral evaluated at X.
*/
{
  static float sqeps = 0.0;
  float value;

  if ( sqeps == 0.0E+00 )
  {
    sqeps = sqrt ( r4_mach ( 3 ) );
  }

  if ( x < 0.0E+00 )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R4_LI - Fatal error!\n" );
    fprintf ( stderr, "  Function undefined for X <= 0.\n" );
    exit ( 1 );
  }

  if ( x == 0.0E+00 )
  {
    value = 0.0E+00;
    return value;
  }

  if ( x == 1.0E+00 )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R4_LI - Fatal error!\n" );
    fprintf ( stderr, "  Function undefined for X = 1.\n" );
    exit ( 1 );
  }

  if ( fabs ( 1.0E+00 - x ) < sqeps )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R4_LI - Warning!\n" );
    fprintf ( stderr, "  Answer less than half precision.\n" );
    fprintf ( stderr, "  X is too close to 1.\n" );
  }

  value = r4_ei ( log ( x ) );

  return value;
}
/******************************************************************************/

float r4_lngam ( float x )

/******************************************************************************/
/*
  Purpose:

    R4_LNGAM evaluates the log of the absolute value of gamma of an R4 argument.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, float X, the argument.

    Output, float R4_LNGAM, the logarithm of the absolute value of
    the gamma function of X.
*/
{
  static float dxrel = 0.0;
  static float pi = 3.14159265358979324E+00;
  float sinpiy;
  static float sq2pil = 0.91893853320467274E+00;
  static float sqpi2l = 0.22579135264472743E+00;
  float value;
  static float xmax = 0.0;
  float y;

  if ( xmax == 0.0E+00 )
  {
    xmax = r4_mach ( 2 ) / log ( r4_mach ( 2 ) );
    dxrel = sqrt ( r4_mach ( 4 ) );
  }

  y = fabs ( x );

  if ( y <= 10.0E+00 )
  {
    value = log ( fabs ( r4_gamma ( x ) ) );
    return value;
  }

  if ( xmax < y )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R4_LNGAM - Fatal error!\n" );
    fprintf ( stderr, "  Result overflows, |X| too big.\n" );
    exit ( 1 );
  }

  if ( 0.0E+00 < x )
  {
    value = sq2pil + ( x - 0.5E+00 ) * log ( x ) - x + r4_lgmc ( y );
    return value;
  }

  sinpiy = fabs ( sin ( pi * y ) );

  if ( sinpiy == 0.0E+00 )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R4_LNGAM - Fatal error!\n" );
    fprintf ( stderr, "  X is a negative integer.\n" );
    exit ( 1 );
  }

  value = sqpi2l + ( x - 0.5E+00 ) * log ( y ) - x 
    - log ( sinpiy ) - r4_lgmc ( y );

  if ( fabs ( ( x - r4_aint ( x - 0.5E+00 ) ) * value / x ) < dxrel )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R4_LNGAM - Warning!\n" );
    fprintf ( stderr, "  Result is half precision because\n" );
    fprintf ( stderr, "  X is too near a negative integer.\n" );
  }

  return value;
}
/******************************************************************************/

float r4_lnrel ( float x )

/******************************************************************************/
/*
  Purpose:

    R4_LNREL evaluates log ( 1 + X ) for an R4 argument.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, float X, the argument.

    Output, float R4_LNREL, the value of log ( 1 + X ).
*/
{
  static float alnrcs[23] = {
    1.0378693562743770E+00,
   -0.13364301504908918E+00,
    0.019408249135520563E+00,
   -0.003010755112753577E+00,
    0.000486946147971548E+00,
   -0.000081054881893175E+00,
    0.000013778847799559E+00,
   -0.000002380221089435E+00,
    0.000000416404162138E+00,
   -0.000000073595828378E+00,
    0.000000013117611876E+00,
   -0.000000002354670931E+00,
    0.000000000425227732E+00,
   -0.000000000077190894E+00,
    0.000000000014075746E+00,
   -0.000000000002576907E+00,
    0.000000000000473424E+00,
   -0.000000000000087249E+00,
    0.000000000000016124E+00,
   -0.000000000000002987E+00,
    0.000000000000000554E+00,
   -0.000000000000000103E+00,
    0.000000000000000019E+00 };
  static int nlnrel = 0;
  float value;
  static float xmin = 0.0;

  if ( nlnrel == 0 )
  {
    nlnrel = r4_inits ( alnrcs, 23, 0.1E+00 * r4_mach ( 3 ) );
    xmin = - 1.0E+00 + sqrt ( r4_mach ( 4 ) );
  }

  if ( x <= - 1.0E+00 )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R4_LNREL - Fatal error!\n" );
    fprintf ( stderr, "  X <= -1.\n" );
    exit ( 1 );
  }
  else if ( x < xmin )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R4_LNREL - Warning!\n" );
    fprintf ( stderr, "  Result is less than half precision.\n" );
    fprintf ( stderr, "  X is too close to - 1.\n" );
  }

  if ( fabs ( x ) <= 0.375E+00 )
  {
    value = x * ( 1.0E+00 - x * r4_csevl ( x / 0.375E+00, alnrcs, nlnrel ) );
  }
  else
  {
    value = log ( 1.0E+00 + x );
  }

  return value;
}
/******************************************************************************/

float r4_log ( float x )

/******************************************************************************/
/*
  Purpose:

    R4_LOG evaluates the logarithm of an R4.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, float X, the evaluation point.

    Output, float R4_LOG, the logarithm of X.
*/
{
  static float aln2 = 0.068147180559945309E+00;
  static float alncen[5] = {
    0.0E+00,
    +0.223143551314209755E+00,
    +0.405465108108164381E+00,
    +0.559615787935422686E+00,
    +0.693147180559945309E+00 };
  static float alncs[6] = {
    1.3347199877973882E+00,
    0.000693756283284112E+00,
    0.000000429340390204E+00,
    0.000000000289338477E+00,
    0.000000000000205125E+00,
    0.000000000000000150E+00 };
  static float center[4] = {
    1.0E+00,
    1.25E+00,
    1.50E+00,
    1.75E+00 };
  int n;
  static int nterms = 0;
  int ntrval;
  float t;
  float t2;
  float value;
  float xn;
  float y;

  if ( nterms == 0 )
  {
    nterms = r4_inits ( alncs, 6, 28.9E+00 * r4_mach ( 3 ) );
  }

  if ( x <= 0.0E+00 )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R4_LOG - Fatal error!\n" );
    fprintf ( stderr, "  X <= 0.0\n" );
    exit ( 1 );
  }

  r4_upak ( x, &y, &n );

  xn = ( float ) ( n - 1 );
  y = 2.0E+00 * y;
  ntrval = ( int ) ( 4.0E+00 * y - 2.5E+00 );

  if ( ntrval == 5 )
  {
    t = ( ( y - 1.0E+00 ) - 1.0E+00 ) / ( y + 2.0E+00 );
  }
  else if ( ntrval < 5 )
  {
    t = ( y - center[ntrval-1] ) / ( y + center[ntrval-1] );
  }

  t2 = t * t;

  value = 0.625E+00 * xn + ( aln2 * xn + alncen[ntrval-1] 
    + 2.0E+00 * t 
    + t * t2 * r4_csevl ( 578.0E+00 * t2 - 1.0, alncs, nterms ) );

  return value;
}
/******************************************************************************/

float r4_log10 ( float x )

/******************************************************************************/
/*
  Purpose:

    R4_LOG10 evaluates the logarithm, base 10, of an R4.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, float X, the evaluation point.

    Output, float R4_LOG10, the logarithm, base 10, of X.
*/
{
  static float aloge = 0.43429448190325182765E+00;
  float value;

  value = aloge * log ( x );

  return value;
}
/******************************************************************************/

float r4_mach ( int i )

/******************************************************************************/
/*
  Purpose:

    R4_MACH returns single precision real machine constants.

  Discussion:

    Assume that single precision real numbers are stored with a mantissa 
    of T digits in base B, with an exponent whose value must lie 
    between EMIN and EMAX.  Then for values of I between 1 and 5, 
    R4_MACH will return the following values:

      R4_MACH(1) = B^(EMIN-1), the smallest positive magnitude.
      R4_MACH(2) = B^EMAX*(1-B^(-T)), the largest magnitude.
      R4_MACH(3) = B^(-T), the smallest relative spacing.
      R4_MACH(4) = B^(1-T), the largest relative spacing.
      R4_MACH(5) = log10(B)

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    24 April 2007

  Author:

    Original FORTRAN77 version by Phyllis Fox, Andrew Hall, Norman Schryer.
    C version by John Burkardt.

  Reference:

    Phyllis Fox, Andrew Hall, Norman Schryer,
    Algorithm 528,
    Framework for a Portable Library,
    ACM Transactions on Mathematical Software,
    Volume 4, Number 2, June 1978, page 176-188.

  Parameters:

    Input, int I, chooses the parameter to be returned.
    1 <= I <= 5.

    Output, float R4_MACH, the value of the chosen parameter.
*/
{
  float value;

  if ( i < 1 )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R4_MACH - Fatal error!\n" );
    fprintf ( stderr, "  The input argument I is out of bounds.\n" );
    fprintf ( stderr, "  Legal values satisfy 1 <= I <= 5.\n" );
    fprintf ( stderr, "  I = %d\n", i );
    value = 0.0;
    exit ( 1 );
  }
  else if ( i == 1 )
  {
    value = 1.1754944E-38;
  }
  else if ( i == 2 )
  {
    value = 3.4028235E+38;
  }
  else if ( i == 3 )
  {
    value = 5.9604645E-08;
  }
  else if ( i == 4 )
  {
    value = 1.1920929E-07;
  }
  else if ( i == 5 )
  {
    value = 0.3010300E+00;
  }
  else if ( 5 < i )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R4_MACH - Fatal error!\n" );
    fprintf ( stderr, "  The input argument I is out of bounds.\n" );
    fprintf ( stderr, "  Legal values satisfy 1 <= I <= 5.\n" );
    fprintf ( stderr, "  I = %d\n", i );
    value = 0.0;
    exit ( 1 );
  }
 
  return value;
}
/******************************************************************************/

void r4_machar ( long int *ibeta, long int *it, long int *irnd, long int *ngrd,
  long int *machep, long int *negep, long int *iexp, long int *minexp,
  long int *maxexp, float *eps, float *epsneg, float *xmin, float *xmax )

/******************************************************************************/
/*
  Purpose:

    R4_MACHAR computes machine constants for R4 arithmetic.

  Discussion:

    This routine determines the parameters of the floating-point 
    arithmetic system specified below.  The determination of the first 
    three uses an extension of an algorithm due to Malcolm, 
    incorporating some of the improvements suggested by Gentleman and 
    Marovich.  

    A FORTRAN version of this routine appeared as ACM algorithm 665.

    This routine is a C translation of the FORTRAN code, and appeared
    as part of ACM algorithm 722.

    An earlier version of this program was published in Cody and Waite.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    26 April 2006

  Author:

    Original FORTRAN77 version by William Cody.
    C version by John Burkardt.

  Reference:

    William Cody,
    ACM Algorithm 665, MACHAR, a subroutine to dynamically determine 
    machine parameters,
    ACM Transactions on Mathematical Software,
    Volume 14, Number 4, pages 303-311, 1988.

    William Cody and W Waite,
    Software Manual for the Elementary Functions,
    Prentice Hall, 1980.

    M Gentleman and S Marovich,
    Communications of the ACM,
    Volume 17, pages 276-277, 1974.

    M. Malcolm,
    Communications of the ACM,
    Volume 15, pages 949-951, 1972.

  Parameters:

    Output, long int* IBETA, the radix for the floating-point representation.

    Output, long int* IT, the number of base IBETA digits in the floating-point
    significand.

    Output, long int* IRND:
    0, if floating-point addition chops.
    1, if floating-point addition rounds, but not in the IEEE style.
    2, if floating-point addition rounds in the IEEE style.
    3, if floating-point addition chops, and there is partial underflow.
    4, if floating-point addition rounds, but not in the IEEE style, and 
      there is partial underflow.
    5, if floating-point addition rounds in the IEEE style, and there is 
      partial underflow.

    Output, long int* NGRD, the number of guard digits for multiplication with
    truncating arithmetic.  It is
    0, if floating-point arithmetic rounds, or if it truncates and only 
      IT base IBETA digits participate in the post-normalization shift of the
      floating-point significand in multiplication;
    1, if floating-point arithmetic truncates and more than IT base IBETA
      digits participate in the post-normalization shift of the floating-point
      significand in multiplication.

    Output, long int* MACHEP, the largest negative integer such that
      1.0 + ( float ) IBETA ^ MACHEP != 1.0, 
    except that MACHEP is bounded below by - ( IT + 3 ).

    Output, long int* NEGEPS, the largest negative integer such that
      1.0 - ( float ) IBETA ) ^ NEGEPS != 1.0, 
    except that NEGEPS is bounded below by - ( IT + 3 ).

    Output, long int* IEXP, the number of bits (decimal places if IBETA = 10)
    reserved for the representation of the exponent (including the bias or
    sign) of a floating-point number.

    Output, long int* MINEXP, the largest in magnitude negative integer such 
    that
      ( float ) IBETA ^ MINEXP 
    is positive and normalized.

    Output, long int* MAXEXP, the smallest positive power of BETA that overflows.
 
    Output, float* EPS, the smallest positive floating-point number such
    that  
      1.0 + EPS != 1.0. 
    in particular, if either IBETA = 2  or IRND = 0, 
      EPS = ( float ) IBETA ^ MACHEP.
    Otherwise,  
      EPS = ( ( float ) IBETA ^ MACHEP ) / 2.

    Output, float* EPSNEG, a small positive floating-point number such that
      1.0 - EPSNEG != 1.0. 
    In particular, if IBETA = 2 or IRND = 0, 
    EPSNEG = ( float ) IBETA ^ NEGEPS.
    Otherwise,  
      EPSNEG = ( float ) IBETA ^ NEGEPS ) / 2.  
    Because NEGEPS is bounded below by - ( IT + 3 ), EPSNEG might not be the
    smallest number that can alter 1.0 by subtraction.

    Output, float* XMIN, the smallest non-vanishing normalized floating-point
    power of the radix:
      XMIN = ( float ) IBETA ^ MINEXP

    Output, float* XMAX, the largest finite floating-point number.  In
    particular,
      XMAX = ( 1.0 - EPSNEG ) * ( float ) IBETA ^ MAXEXP
    On some machines, the computed value of XMAX will be only the second, 
    or perhaps third, largest number, being too small by 1 or 2 units in 
    the last digit of the significand.
*/
{
  float a;
  float b;
  float beta;
  float betah;
  float betain;
  int i;
  int itmp;
  int iz;
  int j;
  int k;
  int mx;
  int nxres;
  float one;
  float t;
  float tmp;
  float tmp1;
  float tmpa;
  float two;
  float y;
  float z;
  float zero;

  (*irnd) = 1;
  one = (float) (*irnd);
  two = one + one;
  a = two;
  b = a;
  zero = 0.0e0;
/*
  Determine IBETA and BETA ala Malcolm.
*/
  tmp = ( ( a + one ) - a ) - one;

  while ( tmp == zero )
  {
    a = a + a;
    tmp = a + one;
    tmp1 = tmp - a;
    tmp = tmp1 - one;
  }

  tmp = a + b;
  itmp = ( int ) ( tmp - a );

  while ( itmp == 0 )
  {
    b = b + b;
    tmp = a + b;
    itmp = ( int ) ( tmp - a );
  }

  *ibeta = itmp;
  beta = ( float ) ( *ibeta );
/*
  Determine IRND, IT.
*/
  ( *it ) = 0;
  b = one;
  tmp = ( ( b + one ) - b ) - one;

  while ( tmp == zero )
  {
    *it = *it + 1;
    b = b * beta;
    tmp = b + one;
    tmp1 = tmp - b;
    tmp = tmp1 - one;
  }

  *irnd = 0;
  betah = beta / two;
  tmp = a + betah;
  tmp1 = tmp - a;

  if ( tmp1 != zero )
  {
    *irnd = 1;
  }

  tmpa = a + beta;
  tmp = tmpa + betah;

  if ( ( *irnd == 0 ) && ( tmp - tmpa != zero ) )
  {
    *irnd = 2;
  }
/*
  Determine NEGEP, EPSNEG.
*/
  (*negep) = (*it) + 3;
  betain = one / beta;
  a = one;
 
  for ( i = 1; i <= (*negep); i++ )
  {
    a = a * betain;
  }
 
  b = a;
  tmp = ( one - a );
  tmp = tmp - one;

  while ( tmp == zero )
  {
    a = a * beta;
    *negep = *negep - 1;
    tmp1 = one - a;
    tmp = tmp1 - one;
  }

  (*negep) = -(*negep);
  (*epsneg) = a;
/*
  Determine MACHEP, EPS.
*/

  (*machep) = -(*it) - 3;
  a = b;
  tmp = one + a;

  while ( tmp - one == zero)
  {
    a = a * beta;
    *machep = *machep + 1;
    tmp = one + a;
  }

  *eps = a;
/*
  Determine NGRD.
*/
  (*ngrd) = 0;
  tmp = one + *eps;
  tmp = tmp * one;

  if ( ( (*irnd) == 0 ) && ( tmp - one ) != zero )
  {
    (*ngrd) = 1;
  }
/*
  Determine IEXP, MINEXP and XMIN.

  Loop to determine largest I such that (1/BETA)^(2^I)
  does not underflow.  Exit from loop is signaled by an underflow.
*/
  i = 0;
  k = 1;
  z = betain;
  t = one + *eps;
  nxres = 0;

  for ( ; ; )
  {
    y = z;
    z = y * y;
/*
  Check for underflow
*/
    a = z * one;
    tmp = z * t;

    if ( ( a + a == zero ) || ( fabs ( z ) > y ) )
    {
      break;
    }

    tmp1 = tmp * betain;

    if ( tmp1 * beta == z )
    {
      break;
    }

    i = i + 1;
    k = k + k;
  }
/*
  Determine K such that (1/BETA)^K does not underflow.
  First set  K = 2^I.
*/
  (*iexp) = i + 1;
  mx = k + k;

  if ( *ibeta == 10 )
  {
/*
  For decimal machines only
*/
    (*iexp) = 2;
    iz = *ibeta;
    while ( k >= iz )
    {
      iz = iz * ( *ibeta );
      (*iexp) = (*iexp) + 1;
    }
    mx = iz + iz - 1;
  }
/*
  Loop to determine MINEXP, XMIN.
  Exit from loop is signaled by an underflow.
*/
  for ( ; ; )
  {
    (*xmin) = y;
    y = y * betain;
    a = y * one;
    tmp = y * t;
    tmp1 = a + a;

    if ( ( tmp1 == zero ) || ( fabs ( y ) >= ( *xmin ) ) )
    {
      break;
    }

    k = k + 1;
    tmp1 = tmp * betain;
    tmp1 = tmp1 * beta;

    if ( ( tmp1 == y ) && ( tmp != y ) )
    {
      nxres = 3;
      *xmin = y;
      break;
    }

  }

  (*minexp) = -k;
/*
  Determine MAXEXP, XMAX.
*/
  if ( ( mx <= k + k - 3 ) && ( ( *ibeta ) != 10 ) )
  {
    mx = mx + mx;
    (*iexp) = (*iexp) + 1;
  }

  (*maxexp) = mx + (*minexp);
/*
  Adjust IRND to reflect partial underflow.
*/
  (*irnd) = (*irnd) + nxres;
/*
  Adjust for IEEE style machines.
*/
  if ( ( *irnd) >= 2 )
  {
    (*maxexp) = (*maxexp) - 2;
  }
/*
  Adjust for machines with implicit leading bit in binary
  significand and machines with radix point at extreme
  right of significand.
*/
  i = (*maxexp) + (*minexp);

  if ( ( ( *ibeta ) == 2 ) && ( i == 0 ) )
  {
    (*maxexp) = (*maxexp) - 1;
  }

  if ( i > 20 )
  {
    (*maxexp) = (*maxexp) - 1;
  }

  if ( a != y )
  {
    (*maxexp) = (*maxexp) - 2;
  }

  (*xmax) = one - (*epsneg);
  tmp = (*xmax) * one;

  if ( tmp != (*xmax) )
  {
    (*xmax) = one - beta * (*epsneg);
  }

  (*xmax) = (*xmax) / ( beta * beta * beta * (*xmin) );
  i = (*maxexp) + (*minexp) + 3;

  if ( i > 0 )
  {
 
    for ( j = 1; j <= i; j++ )
    {
      if ( (*ibeta) == 2 )
      {
        (*xmax) = (*xmax) + (*xmax);
      }
      if ( (*ibeta) != 2 )
      {
        (*xmax) = (*xmax) * beta;
      }
    }

  }
  return;
}
/******************************************************************************/

float r4_max ( float x, float y )

/******************************************************************************/
/*
  Purpose:

    R4_MAX returns the maximum of two R4's.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    14 November 2006

  Author:

    John Burkardt

  Parameters:

    Input, float X, Y, the quantities to compare.

    Output, float R4_MAX, the maximum of X and Y.
*/
{
  float value;

  if ( y < x )
  {
    value = x;
  } 
  else
  {
    value = y;
  }
  return value;
}
/******************************************************************************/

float r4_min ( float x, float y )

/******************************************************************************/
/*
  Purpose:

    R4_MIN returns the minimum of two R4's..

  Licensing:

    This code is distributed under the MIT license.

  Modified:

    14 November 2006

  Author:

    John Burkardt

  Parameters:

    Input, float X, Y, the quantities to compare.

    Output, float R_MIN, the minimum of X and Y.
*/
{
  float value;

  if ( y < x )
  {
    value = y;
  }
  else
  {
    value = x;
  }
  return value;
}
/******************************************************************************/

float r4_mod ( float x, float y )

/******************************************************************************/
/*
  Purpose:

    R4_MOD returns the remainder of R4 division.

  Discussion:

    If
      REM = R8_MOD ( X, Y )
      RMULT = ( X - REM ) / Y
    then
      X = Y * RMULT + REM
    where REM has the same sign as X, and abs ( REM ) < Y.

  Example:

        X         Y     R4_MOD   R4_MOD  Factorization

      107        50       7     107 =  2 *  50 + 7
      107       -50       7     107 = -2 * -50 + 7
     -107        50      -7    -107 = -2 *  50 - 7
     -107       -50      -7    -107 =  2 * -50 - 7

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    14 June 2007

  Author:

    John Burkardt

  Parameters:

    Input, float X, the number to be divided.

    Input, float Y, the number that divides X.

    Output, float R4_MOD, the remainder when X is divided by Y.
*/
{
  float value;

  if ( y == 0.0 )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R4_MOD - Fatal error!\n" );
    fprintf ( stderr, "  R4_MOD ( X, Y ) called with Y = %g\n", y );
    exit ( 1 );
  }

  value = x - ( ( float ) ( ( int ) ( x / y ) ) ) * y;

  if ( x < 0.0 && 0.0 < value )
  {
    value = value - fabs ( y );
  }
  else if ( 0.0 < x && value < 0.0 )
  {
    value = value + fabs ( y );
  }

  return value;
}
/******************************************************************************/

float r4_mop ( int i )

/******************************************************************************/
/*
  Purpose:

    R4_MOP returns the I-th power of -1 as an R4 value.

  Discussion:

    An R4 is a float value.

  Licensing:

    This code is distributed under the MIT license.

  Modified:

    16 November 2007

  Author:

    John Burkardt

  Parameters:

    Input, int I, the power of -1.

    Output, float R4_MOP, the I-th power of -1.
*/
{
  float value;

  if ( ( i % 2 ) == 0 )
  {
    value = 1.0;
  }
  else
  {
    value = -1.0;
  }

  return value;
}
/******************************************************************************/

float r4_pak ( float y, int n )

/******************************************************************************/
/*
  Purpose:

    R4_PAK packs a base 2 exponent into an R4.

  Discussion:

    This routine is almost the inverse of R4_UPAK.  It is not exactly 
    the inverse, because abs(x) need not be between 0.5 and 1.0.  
    If both R4_PAK and 2.0^n were known to be in range, we could compute
    R4_PAK = x * 2.0^n .

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    C version by John Burkardt.

  Parameters:

    Input, float Y, the mantissa.

    Input, integer N, the exponent.

    Output, float R4_PAK, the packed value.
*/
{
  static float aln210 = 3.321928094887362E+00;
  float aln2b;
  static int nmax = 0;
  static int nmin = 0;
  int nsum;
  int ny;
  float value;

  if ( nmin == 0 )
  {
    aln2b = 1.0E+00;
    if ( i4_mach ( 10 ) != 2 )
    {
      aln2b = r4_mach ( 5 ) * aln210;
    }
    nmin = aln2b * ( float ) ( i4_mach ( 12 ) );
    nmax = aln2b * ( float ) ( i4_mach ( 13 ) );
  }

  r4_upak ( y, &value, &ny );

  nsum = n + ny;

  if ( nsum < nmin )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R4_PAK - Warning!\n" );
    fprintf ( stderr, "  Packed number underflows.\n" );
    value = 0.0E+00;
    return value;
  }

  if ( nmax < nsum )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R4_PAK - Fatal error!\n" );
    fprintf ( stderr, "  Packed number overflows.\n" );
    exit ( 1 );
  }

  while ( nsum < 0 )
  {
    value = 0.5E+00 * value;
    nsum = nsum + 1;
  }

  while ( 0 < nsum )
  {
    value = 2.0E+00 * value;
    nsum = nsum - 1;
  }

  return value;
}
/******************************************************************************/

float r4_poch ( float a, float x )

/******************************************************************************/
/*
  Purpose:

    R4_POCH evaluates Pochhammer's function of R4 arguments.

  Discussion:

    POCH ( A, X ) = Gamma ( A + X ) / Gamma ( A ).

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, float A, X, the arguments.

    Output, float R4_POCH, the Pochhammer function of A and X.
*/
{
  float absa;
  float absax;
  float alnga;
  float alngax;
  float ax;
  float b;
  float cospia;
  float cospix;
  float den;
  static float eps = 0.0;
  float err;
  float errpch;
  int i;
  int n;
  static float pi = 3.141592653589793238E+00;
  float value;
  float sgnga;
  float sgngax;
  float sinpia;
  float sinpix;

  if ( eps == 0.0E+00 )
  {
    eps = r4_mach ( 4 );
  }

  ax = a + x;

  if ( ax <= 0.0E+00 && r4_aint ( ax ) == ax )
  {
    if ( 0.0E+00 < a || r4_aint ( a ) != a )
    {
      fprintf ( stderr, "\n" );
      fprintf ( stderr, "R4_POCH - Fatal error!\n" );
      fprintf ( stderr, "  A + X is nonpositive integer,\n" );
      fprintf ( stderr, "  but A is not.\n" );
      exit ( 1 );
    }
/*
  We know here that both A+X and A are non-positive integers.
*/
    if ( x == 0.0E+00 )
    {
      value = 1.0E+00;
    }
    else if ( - 20.0E+00 <= fmin ( a + x, a ) )
    {
      n = ( int ) ( x );
      value = r4_mop ( n ) * r4_fac ( - ( int ) ( a ) ) 
        / r4_fac ( - ( int ) ( a ) - n );
    }
    else
    {
      n = ( int ) ( x );
      value = r4_mop ( n ) * exp ( ( a - 0.5E+00 ) 
        * r4_lnrel ( x / ( a - 1.0E+00 ) ) 
        + x * log ( - a + 1.0E+00 - x ) - x 
        + r4_lgmc ( - a + 1.0E+00 ) 
        - r4_lgmc ( - a - x + 1.0E+00 ) );
    }

    return value;
  }
/*
  Here we know A+X is not zero or a negative integer.
*/
  if ( a <= 0.0E+00 && r4_aint ( a ) == a )
  {
    value = 0.0E+00;
    return value;
  }

  n = ( int ) fabs ( x );
/*
  X is a small non-positive integer, presummably a common case.
*/
  if ( ( float ) ( n ) == x && n <= 20 )
  {
    value = 1.0E+00;
    for ( i = 1; i <= n; i++ )
    {
      value = value * ( a + ( float ) ( i - 1 ) );
    }
    return value;
  }

  absax = fabs ( a + x );
  absa = fabs ( a );

  if ( fmax ( absax, absa ) <= 20.0E+00 )
  {
    value = r4_gamma ( a + x ) * r4_gamr ( a );
    return value;
  }

  if ( 0.5E+00 * absa < fabs ( x ) )
  {
    r4_lgams ( a + x, &alngax, &sgngax );
    r4_lgams ( a, &alnga, &sgnga );
    value = sgngax * sgnga * exp ( alngax - alnga );
    return value;
  }
/*
  Here abs(x) is small and both abs(a+x) and abs(a) are large.  Thus,
  a+x and a must have the same sign.  For negative a, we use
  gamma(a+x)/gamma(a) = gamma(-a+1)/gamma(-a-x+1) *
  sin(pi*a)/sin(pi*(a+x))
*/
  if ( a < 0.0E+00 )
  {
    b = - a - x + 1.0E+00;
  }
  else
  {
    b = a;
  }

  value = exp ( ( b - 0.5E+00 ) * r4_lnrel ( x / b ) 
    + x * log ( b + x ) - x + r4_lgmc ( b + x ) - r4_lgmc ( b ) );

  if ( 0.0E+00 <= a || value == 0.0E+00 )
  {
    return value;
  }

  cospix = cos ( pi * x );
  sinpix = sin ( pi * x );
  cospia = cos ( pi * a );
  sinpia = sin ( pi * a );

  errpch = fabs ( x ) * ( 1.0E+00 + log ( b ) );
  den = cospix + cospia * sinpix / sinpia;
  err = ( fabs ( x ) * ( fabs ( sinpix ) 
    + fabs ( cospia * cospix / sinpia ) )
    + fabs ( a * sinpix ) / ( sinpia * sinpia ) ) * pi;
  err = errpch + err / fabs ( den );

  value = value / den;

  return value;
}
/******************************************************************************/

float r4_poch1 ( float a, float x )

/******************************************************************************/
/*
  Purpose:

    R4_POCH1 evaluates a quantity related to Pochhammer's symbol.

  Discussion:

    Evaluate a generalization of Pochhammer's symbol for special
    situations that require especially accurate values when x is small in
      poch1(a,x) = (poch(a,x)-1)/x
                 = (gamma(a+x)/gamma(a) - 1.0)/x .
    This specification is particularly suited for stably computing
    expressions such as
      (gamma(a+x)/gamma(a) - gamma(b+x)/gamma(b))/x
           = poch1(a,x) - poch1(b,x)
    Note that poch1(a,0.0) = psi(a)

    When abs(x) is so small that substantial cancellation will occur if
    the straightforward formula is used, we  use an expansion due
    to fields and discussed by y. l. luke, the special functions and their
    approximations, vol. 1, academic press, 1969, page 34.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, float A, the parameter.

    Input, float X, the evaluation point.

    Output, float R4_POCH1, the value of the function.
*/
{
  float absa;
  float absx;
  static float alneps = 0.0;
  float alnvar;
  float b;
  static float bern[9] = {
   0.83333333333333333E-01,
  -0.13888888888888889E-02,
   0.33068783068783069E-04,
  -0.82671957671957672E-06,
   0.20876756987868099E-07,
  -0.52841901386874932E-09,
   0.13382536530684679E-10,
  -0.33896802963225829E-12,
   0.85860620562778446E-14 };
  float binv;
  float bp;
  float gbern[10];
  float gbk;
  int i;
  int ii;
  int incr;
  int j;
  int k;
  int ndx;
  int nterms;
  static float pi = 3.14159265358979324E+00;
  float poly1;
  float q;
  float rho;
  float sinpx2;
  float sinpxx;
  static float sqtbig = 0.0;
  float term;
  float trig;
  float value;
  float var;
  float var2;

  if ( sqtbig == 0.0E+00 )
  {
    sqtbig = 1.0E+00 / sqrt ( 24.0E+00 * r4_mach ( 1 ) );
    alneps = log ( r4_mach ( 3 ) );
  }

  if ( x == 0.0E+00 )
  {
    value = r4_psi ( a );
    return value;
  }

  absx = fabs ( x );
  absa = fabs ( a );

  if ( 0.1E+00 * absa < absx || 0.1E+00 < absx * log ( fmax ( absa, 2.0E+00 ) ) )
  {
    value = r4_poch ( a, x );
    value = ( value - 1.0E+00 ) / x;
    return value;
  }

  if ( a < - 0.5E+00 )
  {
    bp = 1.0E+00 - a - x;
  }
  else
  {
    bp = a;
  }

  if ( bp < 10.0E+00 )
  {
    incr = r4_aint ( 11.0E+00 - bp );
  }
  else
  {
    incr = 0;
  }

  b = bp + ( float ) ( incr );

  var = b + 0.5E+00 * ( x - 1.0E+00 );
  alnvar = log ( var );
  q = x * alnvar;
  poly1 = 0.0E+00;

  if ( var < sqtbig )
  {
    var2 = 1.0E+00 / var / var;

    rho = 0.5E+00 * ( x + 1.0E+00 );
    gbern[0] = 1.0E+00;
    gbern[1] = - rho / 12.0E+00;
    term = var2;
    poly1 = gbern[1] * term;

    nterms = ( int ) ( - 0.5E+00 * alneps / alnvar + 1.0E+00 );

    if ( 9 < nterms )
    {
      fprintf ( stderr, "\n" );
      fprintf ( stderr, "R4_POCH1 - Fatal error!\n" );
      fprintf ( stderr, "  9 < NTERMS.\n" );
      exit ( 1 );
    } 

    for ( k = 2; k <= nterms; k++ )
    {
      gbk = 0.0E+00;
      for ( j = 1; j <= k; j++ )
      {
        ndx = k - j + 1;
        gbk = gbk + bern[ndx-1] * gbern[j-1];
      }
      gbern[k] = - rho * gbk / ( float ) ( k );
      term = term * ( ( float ) ( 2 * k - 2 ) - x ) 
        * ( ( float ) ( 2 * k - 1 ) - x ) * var2;
      poly1 = poly1 + gbern[k] * term;
    }
  }

  poly1 = ( x - 1.0E+00 ) * poly1;
  value = r4_exprel ( q ) * ( alnvar + q * poly1 ) + poly1;
/*
  We have poch1(b,x), but bp is small, so we use backwards recursion
  to obtain poch1(bp,x).
*/
  for ( ii = 1; ii <= incr; ii++ )
  {
    i = incr - ii;
    binv = 1.0E+00 / ( bp + ( float ) ( i ) );
    value = ( value - binv ) / ( 1.0E+00 + x * binv );
  }

  if ( bp == a )
  {
    return value;
  }
/*
  We have poch1(bp,x), but a is lt -0.5.  We therefore use a reflection
  formula to obtain poch1(a,x).
*/
  sinpxx = sin ( pi * x ) / x;
  sinpx2 = sin ( 0.5E+00 * pi * x );
  trig = sinpxx * r4_cot ( pi * b ) - 2.0E+00 * sinpx2 * ( sinpx2 / x );

  value = trig + ( 1.0E+00 + x * trig ) * value;

  return value;
}
/******************************************************************************/

float r4_power ( float a, float b )

/******************************************************************************/
/*
  Purpose:

    R4_POWER evaluates A^B.

  Discussion:

    Defining this function obviates the idiotic compiler complaints
    that arise when the arguments of POW are not both simple floats.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    John Burkardt

  Parameters:

    Input, float A, the base.

    Input, float B, the exponent.

    Output, float R4_POWER, the value of A^B.
*/
{
  float value;

  value = pow ( a, b );

  return value;
}
/******************************************************************************/

float r4_psi ( float x )

/******************************************************************************/
/*
  Purpose:

    R4_PSI evaluates the psi function of an R4 argument.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, float X, the argument.

    Output, float R4_PSI, the psi function of X.
*/
 {
  static float apsics[16] = {
   -0.0204749044678185E+00,
   -0.0101801271534859E+00,
    0.0000559718725387E+00,
   -0.0000012917176570E+00,
    0.0000000572858606E+00,
   -0.0000000038213539E+00,
    0.0000000003397434E+00,
   -0.0000000000374838E+00,
    0.0000000000048990E+00,
   -0.0000000000007344E+00,
    0.0000000000001233E+00,
   -0.0000000000000228E+00,
    0.0000000000000045E+00,
   -0.0000000000000009E+00,
    0.0000000000000002E+00,
   -0.0000000000000000E+00 };
  float aux;
  static float dxrel = 0.0;
  int i;
  int n;
  static int ntapsi = 0;
  static int ntpsi = 0;
  static float pi = 3.14159265358979324E+00;
  static float psics[23] = {
   -0.038057080835217922E+00,
    0.49141539302938713E+00,
   -0.056815747821244730E+00,
    0.008357821225914313E+00,
   -0.001333232857994342E+00,
    0.000220313287069308E+00,
   -0.000037040238178456E+00,
    0.000006283793654854E+00,
   -0.000001071263908506E+00,
    0.000000183128394654E+00,
   -0.000000031353509361E+00,
    0.000000005372808776E+00,
   -0.000000000921168141E+00,
    0.000000000157981265E+00,
   -0.000000000027098646E+00,
    0.000000000004648722E+00,
   -0.000000000000797527E+00,
    0.000000000000136827E+00,
   -0.000000000000023475E+00,
    0.000000000000004027E+00,
   -0.000000000000000691E+00,
    0.000000000000000118E+00,
   -0.000000000000000020E+00 };
  float value;
  static float xbig = 0.0;
  float y;

  if ( ntpsi == 0 )
  {
    ntpsi = r4_inits ( psics, 23, 0.1E+00 * r4_mach ( 3 ) );
    ntapsi = r4_inits ( apsics, 16, 0.1E+00 * r4_mach ( 3 ) );
    xbig = 1.0E+00 / sqrt ( r4_mach ( 3 ) );
    dxrel = sqrt ( r4_mach ( 4 ) );
  }

  y = fabs ( x );

  if ( y < 2.0E+00 )
  {
    n = ( int ) ( x );
    if ( x < 0.0E+00 ) 
    {
      n = n - 1;
    }
    y = x - ( float ) ( n );
    n = n - 1;
    value = r4_csevl ( 2.0E+00 * y - 1.0E+00, psics, ntpsi );

    if ( n == 0 )
    {
      return value;
    }

    n = - n;

    if ( x == 0.0E+00 )
    {
      fprintf ( stderr, "\n" );
      fprintf ( stderr, "R4_PSI - Fatal error!\n" );
      fprintf ( stderr, "  X is zero.\n" );
      exit ( 1 );
    }

    if ( x < 0.0E+00 && x + ( float ) ( n - 2 ) == 0.0E+00 )
    {
      fprintf ( stderr, "\n" );
      fprintf ( stderr, "R4_PSI - Fatal error!\n" );
      fprintf ( stderr, "  X is a negative integer.\n" );
      exit ( 1 );
    }

    if ( x < - 0.5E+00 &&
      fabs ( ( x - r4_aint ( x - 0.5E+00 ) ) / x ) < dxrel )
    {
      fprintf ( stderr, "\n" );
      fprintf ( stderr, "R4_PSI - Warning!\n" );
      fprintf ( stderr, "  Answer is less than half precision\n" );
      fprintf ( stderr, "  because X is near a negative integer.\n" );
    }

    for ( i = 1; i <= n; i++ )
    {
      value = value - 1.0E+00 / ( x + ( float ) ( i - 1 ) );
    }
  }
  else
  {
    if ( y < xbig )
    {
      aux = r4_csevl ( 8.0E+00 / y / y - 1.0E+00, apsics, ntapsi );
    }
    else
    {
      aux = 0.0E+00;
    }

    if ( x < 0.0E+00 )
    {
      value = log ( fabs ( x ) ) - 0.5E+00 / x + aux 
        - pi * r4_cot ( pi * x );
    }
    else if ( 0.0E+00 < x )
    {
      value = log ( x ) - 0.5E+00 / x + aux;
    }
  }
  return value;
}
/******************************************************************************/

float r4_rand ( float r )

/******************************************************************************/
/*
  Purpose:

    R4_RAND is a portable pseudorandom number generator.

  Discussion:

    This pseudo-random number generator is portable amoung a wide
    variety of computers.  It is undoubtedly not as good as many
    readily available installation dependent versions, and so this
    routine is not recommended for widespread usage.  Its redeeming
    feature is that the exact same random numbers (to within final round-
    off error) can be generated from machine to machine.  Thus, programs
    that make use of random numbers can be easily transported to and
    checked in a new environment.

    The random numbers are generated by the linear congruential
    method described by Knuth in seminumerical methods (p.9),
    addison-wesley, 1969.  Given the i-th number of a pseudo-random
    sequence, the i+1 -st number is generated from
      x(i+1) = (a*x(i) + c) mod m,
    where here m = 2^22 = 4194304, c = 1731 and several suitable values
    of the multiplier a are discussed below.  Both the multiplier a and
    random number x are represented in double precision as two 11-bit
    words.  The constants are chosen so that the period is the maximum
    possible, 4194304.

    In order that the same numbers be generated from machine to
    machine, it is necessary that 23-bit ints be reducible modulo
    2^11 exactly, that 23-bit ints be added exactly, and that 11-bit
    ints be multiplied exactly.  Furthermore, if the restart option
    is used (where r is between 0 and 1), then the product r*2^22 =
    r*4194304 must be correct to the nearest int.

    The first four random numbers should be 

      0.0004127026,
      0.6750836372, 
      0.1614754200, 
      0.9086198807.

    The tenth random number is 

      0.5527787209.

    The hundredth random number is 

      0.3600893021.  

    The thousandth number should be 

      0.2176990509.

    In order to generate several effectively independent sequences
    with the same generator, it is necessary to know the random number
    for several widely spaced calls.  The I-th random number times 2^22,
    where I=K*P/8 and P is the period of the sequence (P = 2^22), is
    still of the form L*P/8.  In particular we find the I-th random
    number multiplied by 2^22 is given by
      I   =  0  1*p/8  2*p/8  3*p/8  4*p/8  5*p/8  6*p/8  7*p/8  8*p/8
      RAND=  0  5*p/8  2*p/8  7*p/8  4*p/8  1*p/8  6*p/8  3*p/8  0
    thus the 4*P/8 = 2097152 random number is 2097152/2^22.

    Several multipliers have been subjected to the spectral test
    (see Knuth, p. 82).  Four suitable multipliers roughly in order of
    goodness according to the spectral test are
      3146757 = 1536*2048 + 1029 = 2^21 + 2^20 + 2^10 + 5
      2098181 = 1024*2048 + 1029 = 2^21 + 2^10 + 5
      3146245 = 1536*2048 +  517 = 2^21 + 2^20 + 2^9 + 5
      2776669 = 1355*2048 + 1629 = 5^9 + 7^7 + 1

    In the table below log10(NU(I)) gives roughly the number of
    random decimal digits in the random numbers considered I at a time.
    C is the primary measure of goodness.  In both cases bigger is better.

                     log10 nu(i)              c(i)
         a       i=2  i=3  i=4  i=5    i=2  i=3  i=4  i=5

      3146757    3.3  2.0  1.6  1.3    3.1  1.3  4.6  2.6
      2098181    3.3  2.0  1.6  1.2    3.2  1.3  4.6  1.7
      3146245    3.3  2.2  1.5  1.1    3.2  4.2  1.1  0.4
      2776669    3.3  2.1  1.6  1.3    2.5  2.0  1.9  2.6
     best
      possible   3.3  2.3  1.7  1.4    3.6  5.9  9.7  14.9

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    C version by John Burkardt.

  Parameters:

    Input, real R, determines the action.
    * R = 0.0, the next random number of the sequence is generated.
    * R < 0.0, the last generated number will be returned for
    possible use in a restart procedure.
    * R > 0.0, the sequence of random numbers will start with the
    seed ( R mod 1 ).  This seed is also returned as the value of
    R4_RAND provided the arithmetic is done exactly.

    Output, real R4_RAND, a pseudo-random number between 0.0 and 1.0.
*/
{
  static int ia0 = 1029;
  static int ia1 = 1536;
  static int ia1ma0 = 507;
  static int ic = 1731;
  static int ix0 = 0;
  static int ix1 = 0;
  int iy0;
  int iy1;
  float value;

  if ( r == 0.0E+00 )
  {
    iy0 = ia0 * ix0;
    iy1 = ia1 * ix1 + ia1ma0 * ( ix0 - ix1 ) + iy0;
    iy0 = iy0 + ic;
    ix0 = ( iy0 % 2048 );
    iy1 = iy1 + ( iy0 - ix0 ) / 2048;
    ix1 = ( iy1 % 2048 );
  }

  if ( 0.0 < r )
  {
    ix1 = ( int ) ( r4_mod ( r, 1.0E+00 ) * 4194304.0 + 0.5E+00 );
    ix0 = ( ix1 % 2048 );
    ix1 = ( ix1 - ix0 ) / 2048;
  }

  value = ( float ) ( ix1 * 2048 + ix0 );
  value = value / 4194304.0E+00;
 
  return value;
}
/******************************************************************************/

float r4_randgs ( float xmean, float sd, int *seed )

/******************************************************************************/
/*
  Purpose:

    R4_RANDGS generates a normally distributed random number.

  Discussion:

    This function generate a normally distributed random number, that is, 
    it generates random numbers with a Gaussian distribution.  These 
    random numbers are not exceptionally good, especially in the tails 
    of the distribution, but this implementation is simple and suitable 
    for most applications.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    24 April 2016

  Author:

    C version by John Burkardt.

  Reference:

    Richard Hamming,
    Numerical Methods for Scientists and Engineers,
    Dover, 1986,
    ISBN: 0486652416,
    LC: QA297.H28.

  Parameters:

    Input, float XMEAN, the mean of the Gaussian distribution.

    Input, float SD, the standard deviation of the Gaussian function.

    Input/output, int *SEED, a seed for the random number generator.

    Output, float R4_RANDGS, a normally distributed random number.
*/
{
  int i;
  float value;

  value = - 6.0E+00;
  for ( i = 1; i <= 12; i++ )
  {
    value = value + r4_ren ( seed );
  }
  value = xmean + sd * value;
  return value;
}
/******************************************************************************/

float r4_random ( int n, float t[] )

/******************************************************************************/
/*
  Purpose:

    R4_RANDOM is a portable pseudorandom number generator.

  Discussion:

    This random number generator is portable amoung a wide variety of
    computers.  It generates a random number between 0.0 and 1.0 
    according to the algorithm presented by Bays and Durham.

    The motivation for using this scheme, which resembles the
    Maclaren-Marsaglia method, is to greatly increase the period of the
    random sequence.  If the period of the basic generator is P,
    then the expected mean period of the sequence generated by this
    generator is given by

      new mean P = sqrt ( pi * factorial ( N ) / ( 8 * P ) ),

    where factorial ( N ) must be much greater than P in this 
    asymptotic formula.  Generally, N should be 16 to maybe 32.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    C version by John Burkardt.

  Reference:

    Carter Bays, Stephen Durham,
    Improving a Poor Random Number Generator,
    ACM Transactions on Mathematical Software,
    Volume 2, Number 1, March 1976, pages 59-64.

  Parameters:

    Input/output, float T[abs(N)+1], an array of random numbers from 
    a previous invocation of this function.  Whenever N is positive 
    and differs from the old N, the table is initialized.  The first 
    iabs(N) numbers are the table discussed in the reference, and the 
    last value is Y.  This array may be saved in order to restart a sequence.

    Input, int N.  The absolute value of N is the number of random 
    numbers in an auxiliary table.  Note though that iabs(N)+1 is the 
    number of items in array T.  If N is positive and differs from its 
    value in the previous invocation, then the table is initialized for 
    the new value of N.  If N is negative, abs(N) is the number of items 
    in an auxiliary table, but the tables are now assumed already to
    be initialized.  This option enables the user to save the table T at 
    the end of a long computer run and to restart with the same sequence.  
    Normally, this function would be called at most once with negative N.  
    Subsequent invocations would have N positive and of the correct magnitude.

    Output, float R4_RANDOM, a random number between 0.0 and 1.0.
*/
{
  static float floatn = -1.0;
  int i;
  int j;
  static int nold = -1;
  float value;

  if ( n != nold )
  {
    nold = abs ( n );
    floatn = ( float ) nold;
 
    if ( n < 0 )
    {
      r4_rand ( t[nold] );
    }
    else
    {
      for ( i = 1; i <= nold; i++ )
      {
        t[i-1] = r4_rand ( 0.0E+00 );
      }
      t[nold] = r4_rand ( 0.0E+00 );
    }
  }

  j = ( int ) ( t[nold] * floatn + 1.0E+00 );
  t[nold] = t[j-1];
  value = t[j-1];
  t[j-1] = r4_rand ( 0.0E+00 );

  return value;
}
/******************************************************************************/

float r4_ren ( int *seed )

/******************************************************************************/
/*
  Purpose:

    R4_REN is a simple random number generator.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    24 April 2016

  Author:

    C version by John Burkardt.

  Reference:

    Malcolm Pike, David Hill,
    Algorithm 266:
    Pseudo-Random Numbers,
    Communications of the ACM,
    Volume 8, Number 10, October 1965, page 605.

  Parameters:

    Input/output, integer *SEED, a seed for the random number generator.

    Output, float R4_REN, the random value.
*/
{
  const int i4_huge = 2147483647;
  double value;

  *seed = ( *seed % ( i4_huge / 125 ) );
  *seed = *seed * 125;
  *seed = *seed - ( *seed / 2796203 ) * 2796203;
  value = ( float ) ( *seed ) / 2796203.0;

  return value;
}
/******************************************************************************/

float r4_shi ( float x )

/******************************************************************************/
/*
  Purpose:

    R4_SHI evaluates the hyperbolic sine integral Shi of an R4 argument.

  Discussion:

    Shi ( x ) = Integral ( 0 <= t <= x ) sinh ( t ) dt / t

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, float X, the argument.

    Output, float R4_SHI, the hyperbolic sine integral Shi evaluated at X.
*/
{
  float absx;
  static int nshi = 0;
  static float shics[7] = {
     0.0078372685688900950695E+00,
     0.0039227664934234563973E+00,
     0.0000041346787887617267E+00,
     0.0000000024707480372883E+00,
     0.0000000000009379295591E+00,
     0.0000000000000002451817E+00,
     0.0000000000000000000467E+00 };
  float value;
  static float xsml = 0.0;

  if ( nshi == 0 )
  {
    nshi = r4_inits ( shics, 7, 0.1E+00 * r4_mach ( 3 ) );
    xsml = sqrt ( r4_mach ( 3 ) );
  }

  absx = fabs ( x );

  if ( absx <= xsml )
  {
    value = x;
  }
  else if ( absx <= 0.375E+00 )
  {
    value = x * ( 1.0E+00 
      + r4_csevl ( 128.0E+00 * x * x / 9.0E+00 - 1.0E+00, 
      shics, nshi ) );
  }
  else
  {
    value = 0.5E+00 * ( r4_ei ( x ) + r4_e1 ( x ) );
  }
  return value;
}
/******************************************************************************/

float r4_si ( float x )

/******************************************************************************/
/*
  Purpose:

    R4_SI evaluates the sine integral Si of an R4 argument.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, float X, the argument.

    Output, float R4_SI, the sine integral Si evaluated at X.
*/
{
  float absx;
  float cosx;
  static float eps;
  float f;
  float g;
  static int nsi = 0;
  static float pi2 = 1.5707963267948966E+00;
  static float sics[12] = {
    -0.1315646598184841929E+00,
    -0.2776578526973601892E+00,
     0.0354414054866659180E+00,
    -0.0025631631447933978E+00,
     0.0001162365390497009E+00,
    -0.0000035904327241606E+00,
     0.0000000802342123706E+00,
    -0.0000000013562997693E+00,
     0.0000000000179440722E+00,
    -0.0000000000001908387E+00,
     0.0000000000000016670E+00,
    -0.0000000000000000122E+00 };
  float value;
  static float xsml = 0.0;

  if ( nsi == 0 )
  {
    nsi = r4_inits ( sics, 12, 0.1E+00 * r4_mach ( 3 ) );
    eps = r4_mach ( 3 );
    xsml = sqrt ( eps );
  }

  absx = fabs ( x );

  if ( absx < xsml )
  {
    value = x;
  }
  else if ( absx <= 4.0E+00 )
  {
    value = x * ( 0.75E+00 
      + r4_csevl ( ( x * x - 8.0E+00 ) * 0.125E+00, sics, nsi ) );
  }
  else
  {
    r4_sifg ( absx, &f, &g );
    cosx = cos ( absx );

    if ( x < 0.0E+00 )
    {
      value = - pi2 + f * cosx + g * sin ( x );
    }
    else
    {
      value = pi2 - f * cosx - g * sin ( x );
    }
  }

  return value;
}
/******************************************************************************/

void r4_sifg ( float x, float *f, float *g )

/******************************************************************************/
/*
  Purpose:

    R4_SIFG is a utility routine.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, float X, the argument.

    Output, float *F, *G.
*/
{
  static float f1cs[20] = {
    -0.1191081969051363610E+00,
    -0.0247823144996236248E+00,
     0.0011910281453357821E+00,
    -0.0000927027714388562E+00,
     0.0000093373141568271E+00,
    -0.0000011058287820557E+00,
     0.0000001464772071460E+00,
    -0.0000000210694496288E+00,
     0.0000000032293492367E+00,
    -0.0000000005206529618E+00,
     0.0000000000874878885E+00,
    -0.0000000000152176187E+00,
     0.0000000000027257192E+00,
    -0.0000000000005007053E+00,
     0.0000000000000940241E+00,
    -0.0000000000000180014E+00,
     0.0000000000000035063E+00,
    -0.0000000000000006935E+00,
     0.0000000000000001391E+00,
    -0.0000000000000000282E+00 };
  static float f2cs[29] = {
    -0.0348409253897013234E+00,
    -0.0166842205677959686E+00,
     0.0006752901241237738E+00,
    -0.0000535066622544701E+00,
     0.0000062693421779007E+00,
    -0.0000009526638801991E+00,
     0.0000001745629224251E+00,
    -0.0000000368795403065E+00,
     0.0000000087202677705E+00,
    -0.0000000022601970392E+00,
     0.0000000006324624977E+00,
    -0.0000000001888911889E+00,
     0.0000000000596774674E+00,
    -0.0000000000198044313E+00,
     0.0000000000068641396E+00,
    -0.0000000000024731020E+00,
     0.0000000000009226360E+00,
    -0.0000000000003552364E+00,
     0.0000000000001407606E+00,
    -0.0000000000000572623E+00,
     0.0000000000000238654E+00,
    -0.0000000000000101714E+00,
     0.0000000000000044259E+00,
    -0.0000000000000019634E+00,
     0.0000000000000008868E+00,
    -0.0000000000000004074E+00,
     0.0000000000000001901E+00,
    -0.0000000000000000900E+00,
     0.0000000000000000432E+00 };
  static float g1cs[21] = {
    -0.3040578798253495954E+00,
    -0.0566890984597120588E+00,
     0.0039046158173275644E+00,
    -0.0003746075959202261E+00,
     0.0000435431556559844E+00,
    -0.0000057417294453025E+00,
     0.0000008282552104503E+00,
    -0.0000001278245892595E+00,
     0.0000000207978352949E+00,
    -0.0000000035313205922E+00,
     0.0000000006210824236E+00,
    -0.0000000001125215474E+00,
     0.0000000000209088918E+00,
    -0.0000000000039715832E+00,
     0.0000000000007690431E+00,
    -0.0000000000001514697E+00,
     0.0000000000000302892E+00,
    -0.0000000000000061400E+00,
     0.0000000000000012601E+00,
    -0.0000000000000002615E+00,
     0.0000000000000000548E+00 };
  static float g2cs[34] = {
    -0.0967329367532432218E+00,
    -0.0452077907957459871E+00,
     0.0028190005352706523E+00,
    -0.0002899167740759160E+00,
     0.0000407444664601121E+00,
    -0.0000071056382192354E+00,
     0.0000014534723163019E+00,
    -0.0000003364116512503E+00,
     0.0000000859774367886E+00,
    -0.0000000238437656302E+00,
     0.0000000070831906340E+00,
    -0.0000000022318068154E+00,
     0.0000000007401087359E+00,
    -0.0000000002567171162E+00,
     0.0000000000926707021E+00,
    -0.0000000000346693311E+00,
     0.0000000000133950573E+00,
    -0.0000000000053290754E+00,
     0.0000000000021775312E+00,
    -0.0000000000009118621E+00,
     0.0000000000003905864E+00,
    -0.0000000000001708459E+00,
     0.0000000000000762015E+00,
    -0.0000000000000346151E+00,
     0.0000000000000159996E+00,
    -0.0000000000000075213E+00,
     0.0000000000000035970E+00,
    -0.0000000000000017530E+00,
     0.0000000000000008738E+00,
    -0.0000000000000004487E+00,
     0.0000000000000002397E+00,
    -0.0000000000000001347E+00,
     0.0000000000000000801E+00,
    -0.0000000000000000501E+00 };
  static int nf1 = 0;
  static int nf2 = 0;
  static int ng1 = 0;
  static int ng2 = 0;
  float tol;
  static float xbig = 0.0;
  static float xbnd = 0.0;
  static float xmaxf = 0.0;
  static float xmaxg = 0.0;

  if ( nf1 == 0 )
  {
    tol = 0.1E+00 * r4_mach ( 3 );
    nf1 = r4_inits ( f1cs, 20, tol );
    nf2 = r4_inits ( f2cs, 29, tol );
    ng1 = r4_inits ( g1cs, 21, tol );
    ng2 = r4_inits ( g2cs, 34, tol );
    xbig = sqrt ( 1.0E+00 / r4_mach ( 3 ) );
    xmaxf = exp ( fmin ( - log ( r4_mach ( 1 ) ), 
      log ( r4_mach ( 2 ) ) ) - 0.01E+00 );
    xmaxg = 1.0E+00 / sqrt ( r4_mach ( 1 ) );
    xbnd = sqrt ( 50.0E+00 );
  }

  if ( x < 4.0E+00 )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R4_SIFG - Fatal error!\n" );
    fprintf ( stderr, "  Approximation invalid for X < 4.\n" );
    exit ( 1 );
  }

  if ( x <= xbnd )
  {
    *f = ( 1.0E+00 + r4_csevl ( ( 1.0E+00 / x / x - 0.04125E+00 )
      / 0.02125E+00, f1cs, nf1 ) ) / x;
    *g = ( 1.0E+00 + r4_csevl ( ( 1.0E+00 / x / x - 0.04125E+00 )
      / 0.02125E+00, g1cs, ng1 ) ) / x / x;
  }
  else if ( x <= xbig )
  {
    *f = ( 1.0E+00 + r4_csevl ( 100.0E+00 / x / x - 1.0E+00, 
      f2cs, nf2 ) ) / x;
    *g = ( 1.0E+00 + r4_csevl ( 100.0E+00 / x / x - 1.0E+00, 
      g2cs, ng2) ) / x / x;
  }
  else
  {
    if ( x < xmaxf )
    {
      *f = 1.0E+00 / x;
    }
    else
    {
      *f = 0.0E+00;
    }

    if ( x < xmaxg )
    {
      *g = 1.0E+00 / x / x;
    }
    else
    {
      *g = 0.0E+00;
    }
  }
  return;
}
/******************************************************************************/

float r4_sign ( float x )

/******************************************************************************/
/*
  Purpose:

    R4_SIGN returns the sign of an R4.

  Licensing:

    This code is distributed under the MIT license.

  Modified:

    18 October 2004

  Author:

    John Burkardt

  Parameters:

    Input, float X, the number whose sign is desired.

    Output, float R4_SIGN, the sign of X.
*/
{
  float value;

  if ( x < 0.0 )
  {
    value = -1.0;
  }
  else
  {
    value = 1.0;
  }
  return value;
}
/******************************************************************************/

float r4_sin ( float x )

/******************************************************************************/
/*
  Purpose:

    R4_SIN evaluates the sine of an R4 argument.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, float X, the argument.

    Output, float R4_SIN, the sine of X.
*/
{
  float f;
  int n2;
  static int ntsn = 0;
  static float pi2rec = 0.636619772367581343E+00;
  static float pihi = 3.140625E+00;
  static float pilo = 9.6765358979323846E-04;
  static float pirec = 0.31830988618379067E+00;
  static float sincs[10] = {
     -0.374991154955873175840E+00,
     -0.181603155237250201864E+00,
     +0.005804709274598633559E+00,
     -0.000086954311779340757E+00,
     +0.000000754370148088851E+00,
     -0.000000004267129665056E+00,
     +0.000000000016980422945E+00,
     -0.000000000000050120579E+00,
     +0.000000000000000114101E+00,
     -0.000000000000000000206E+00 };
  float sgn;
  float value;
  static float xmax = 0.0;
  float xn;
  static float xsml = 0.0;
  static float xwarn = 0.0;
  float y;
/*
  pihi + pilo = pi.  pihi is exactly representable on all machines
  with at least 8 bits of precision.  whether it is exactly
  represented depends on the compiler.  this routine is more
  accurate if it is exactly represented.
*/
  if ( ntsn == 0 )
  {
    ntsn = r4_inits ( sincs, 10, 0.1E+00 * r4_mach ( 3 ) );
    xsml = sqrt ( 6.0E+00 * r4_mach ( 3 ) );
    xmax = 1.0E+00 / r4_mach ( 4 );
    xwarn = sqrt ( xmax );
  }

  y = fabs ( x );

  if ( xmax < y )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R4_SIN - Warning!\n" );
    fprintf ( stderr, "  No precision because |X| is big.\n" );
    value = 0.0E+00;
    return value;
  }

  if ( xwarn < y )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R4_SIN - Warning!\n" );
    fprintf ( stderr, "  Answer < half precision because |X| is big.\n" );
  }

  value = x;

  if ( y < xsml )
  {
    return value;
  }

  xn = r4_aint ( y * pirec + 0.5E+00 );
  n2 = ( int ) ( r4_mod ( xn, 2.0E+00 ) + 0.5E+00 );
  sgn = x;
  if ( n2 != 0 )
  {
    sgn = - sgn;
  }

  f = ( y - xn * pihi ) - xn * pilo;
  xn = 2.0E+00 * ( f * pi2rec ) * ( f * pi2rec ) - 1.0E+00;

  value = f + f * r4_csevl ( xn, sincs, ntsn );

  if ( sgn < 0.0E+00 )
  {
    value = - value;
  }

  if ( value < - 1.0E+00 )
  {
    value = - 1.0E+00;
  }
  else if ( 1.0E+00 < value )
  {
    value = 1.0E+00;
  }
  return value;
}
/******************************************************************************/

float r4_sin_deg ( float x )

/******************************************************************************/
/*
  Purpose:

    R4_SIN_DEG evaluates the sine of an R4 argument in degrees.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, float X, the argument in degrees.

    Output, float R4_SIN_DEG, the sine of X.
*/
{
  int n;
  static float raddeg = 0.017453292519943296E+00;
  float value;

  value = sin ( raddeg * x );

  if ( r4_mod ( x, 90.0E+00 ) == 0.0E+00 )
  {
    n = ( int ) ( fabs ( x ) / 90.0E+00 + 0.5E+00 );
    n = ( n % 2 );

    if ( n == 0 )
    {
      value = 0.0E+00;
    }
    else if ( value < 0.0E+00 )
    {
      value = - 1.0E+00;
    }
    else
    {
      value = + 1.0E+00;
    }
  }
  return value;
}
/******************************************************************************/

float r4_sinh ( float x )

/******************************************************************************/
/*
  Purpose:

    R4_SINH evaluates the hyperbolic sine of an R4 argument.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, float X, the argument.

    Output, float R4_SINH, the hyperbolic sine of X.
*/
{
  int nterms = 0;
  static float sinhcs[8] = {
    0.1730421940471796E+00,
    0.08759422192276048E+00,
    0.00107947777456713E+00,
    0.00000637484926075E+00,
    0.00000002202366404E+00,
    0.00000000004987940E+00,
    0.00000000000007973E+00,
    0.00000000000000009E+00 };
  static float sqeps = 0.0;
  float value;
  float y;
  static float ymax = 0.0;

  if ( nterms == 0 )
  {
    nterms = r4_inits ( sinhcs, 8, 0.1E+00 * r4_mach ( 3 ) );
    sqeps = sqrt ( 6.0E+00 * r4_mach ( 3 ) );
    ymax = 1.0E+00 / sqrt ( r4_mach ( 3 ) );
  }

  y = fabs ( x );

  if ( y <= sqeps )
  {
    value = x;
  }
  else if ( y <= 1.0E+00 )
  {
    value = x * ( 1.0E+00 
      + r4_csevl ( 2.0E+00 * x * x - 1.0E+00, sinhcs, nterms ) );
  }
  else
  {
    y = exp ( y );

    if ( ymax <= y )
    {
      value = 0.5E+00 * y;
    }
    else
    {
      value = 0.5E+00 * ( y - 1.0E+00 / y );
    }

    if ( x < 0.0E+00 )
    {
      value = - value;
    }
  }
  return value;
}
/******************************************************************************/

float r4_spence ( float x )

/******************************************************************************/
/*
  Purpose:

    R4_SPENCE evaluates a form of Spence's function for an R4 argument.

  Discussion:

    This function evaluates a form of Spence's function defined by

      f(x) = Integral ( 0 <= y <= x ) - log ( abs ( 1 - y ) ) / y dy

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Milton Abramowitz, Irene Stegun,
    Handbook of Mathematical Functions, page 1004,
    National Bureau of Standards, 1964,
    ISBN: 0-486-61272-4,
    LC: QA47.A34.

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

    K Mitchell,
    Tables of the function Integral ( 0 < y < x ) - log | 1 - y | dy / y
    with an account of some properties of this and related functions,
    Philosophical Magazine,
    Volume 40, pages 351-368, 1949.

  Parameters:

    Input, float X, the argument.

    Output, float R4_SPENCE, Spence's function evaluated at X.
*/
{
  float aln;
  static int nspenc = 0;
  const float pi26 = 1.644934066848226E+00;
  static float spencs[19] = {
    0.1527365598892406E+00,
    0.08169658058051014E+00,
    0.00581415714077873E+00,
    0.00053716198145415E+00,
    0.00005724704675185E+00,
    0.00000667454612164E+00,
    0.00000082764673397E+00,
    0.00000010733156730E+00,
    0.00000001440077294E+00,
    0.00000000198444202E+00,
    0.00000000027940058E+00,
    0.00000000004003991E+00,
    0.00000000000582346E+00,
    0.00000000000085767E+00,
    0.00000000000012768E+00,
    0.00000000000001918E+00,
    0.00000000000000290E+00,
    0.00000000000000044E+00,
    0.00000000000000006E+00 };
  float value;
  static float xbig = 0.0;

  if ( nspenc == 0 )
  {
    nspenc = r4_inits ( spencs, 19, 0.1E+00 * r4_mach ( 3 ) );
    xbig = 1.0E+00 / r4_mach ( 3 );
  }

  if ( x <= - xbig )
  {
    aln = log ( 1.0E+00 - x );
    value = - pi26 - 0.5E+00 * aln * ( 2.0E+00 * log ( - x ) - aln );
  }
  else if ( x <= - 1.0E+00 )
  {
    aln = log ( 1.0E+00 - x );

    value = - pi26 - 0.5E+00 * aln * ( 2.0E+00 
      * log ( - x ) - aln ) + ( 1.0E+00 + r4_csevl (
      4.0E+00 / ( 1.0E+00 - x ) - 1.0E+00, spencs, nspenc ) ) 
      / ( 1.0E+00 - x );
  }
  else if ( x <= 0.0E+00 )
  {
    value = - 0.5E+00 * log ( 1.0E+00 - x ) 
      * log ( 1.0E+00 - x ) - x * ( 1.0E+00 + r4_csevl ( 
      4.0E+00 * x / ( x - 1.0E+00 ) - 1.0E+00, spencs, nspenc ) ) 
      / ( x - 1.0E+00 );
  }
  else if ( x <= 0.5E+00 )
  {
    value = x * ( 1.0E+00 + r4_csevl ( 4.0E+00 * x - 1.0E+00, 
      spencs, nspenc ) );
  }
  else if ( x < 1.0E+00 )
  {
    value = pi26 - log ( x ) * log ( 1.0E+00 - x )
      - ( 1.0E+00 - x ) * ( 1.0E+00 + r4_csevl ( 4.0E+00 
      * ( 1.0E+00 - x ) - 1.0E+00, spencs, nspenc ) );
  }
  else if ( x == 1.0E+00 )
  {
    value = pi26;
  }
  else if ( x <= 2.0E+00 )
  {
    value = pi26 - 0.5E+00 * log ( x ) 
      * log ( ( x - 1.0E+00 ) * ( x - 1.0E+00 ) / x )
      + ( x - 1.0E+00 ) * ( 1.0E+00 + r4_csevl ( 4.0E+00 
      * ( x - 1.0E+00 ) / x - 1.0E+00, spencs, nspenc ) ) / x;
  }
  else if ( x < xbig )
  {
    value = 2.0E+00 * pi26 - 0.5E+00 * log ( x ) * log ( x )
      - ( 1.0E+00 + r4_csevl ( 4.0E+00 / x - 1.0E+00, spencs, 
      nspenc ) ) / x;
  }
  else
  {
    value = 2.0E+00 * pi26 - 0.5E+00 * log ( x ) * log ( x );
  }
  return value;
}
/******************************************************************************/

float r4_sqrt ( float x )

/******************************************************************************/
/*
  Purpose:

    R4_SQRT computes the square root of an R4.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, float X, the number whose square root is desired.

    Output, float R4_SQRT, the square root of X.
*/
{
  int irem;
  int iter;
  int ixpnt;
  int n;
  static int niter = 0;
  static float sqrt2[3] = {
     0.70710678118654752E+00,
     1.0E+00,
     1.41421356237309505E+00 };
  float value;
  float y;

  if ( niter == 0 )
  {
    niter = 1.443E+00 * r4_log ( - 0.104E+00 
      * r4_log ( 0.1E+00 * r4_mach ( 3 ) ) ) + 1.0E+00;
  }

  if ( x < 0.0E+00 )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R4_SQRT - Fatal error!\n" );
    fprintf ( stderr, "  X < 0.0\n" );
    exit ( 1 );
  }
  else if ( x == 0.0E+00 )
  {
    value = 0.0E+00;
  }
  else
  {
    r4_upak ( x, &y, &n );
    ixpnt = n / 2;
    irem = n - 2 * ixpnt + 2;
    value = 0.261599E+00 + y * ( 1.114292E+00 
      + y * ( -0.516888E+00 + y * 0.141067E+00 ) );

    for ( iter = 1; iter <= niter; iter++ )
    {
      value = value + 0.5E+00 * ( y - value * value ) / value;
    }
    value = r4_pak ( sqrt2[irem-1] * value, ixpnt );
  }
  return value;
}
/******************************************************************************/

float r4_tan ( float x )

/******************************************************************************/
/*
  Purpose:

    R4_TAN evaluates the tangent of an R4 argument.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, float X, the argument.

    Output, float R4_TAN, the tangent of X.
*/
{
  float ainty;
  float ainty2;
  int ifn;
  static int nterms = 0;
  const float pi2rec = 0.0116197723675813430E+00;
  float prodbg;
  static float sqeps = 0.0;
  static float tancs[11] = {
     0.226279327631293578E+00,
     0.0430179131465489618E+00,
     0.0006854461068256508E+00,
     0.0000110453269475970E+00,
     0.0000001781747790392E+00,
     0.0000000028744968582E+00,
     0.0000000000463748541E+00,
     0.0000000000007481760E+00,
     0.0000000000000120704E+00,
     0.0000000000000001947E+00,
     0.0000000000000000031E+00 };
  float value;
  static float xmax = 0.0;
  static float xsml = 0.0;
  float y;
  float yrem;

  if ( nterms == 0 )
  {
    nterms = r4_inits ( tancs, 11, 0.1E+00 * r4_mach ( 3 ) );
    xmax = 1.0E+00 / r4_mach ( 4 );
    xsml = sqrt ( 3.0E+00 * r4_mach ( 3 ) );
    sqeps = sqrt ( r4_mach ( 4 ) );
  }

  y = fabs ( x );

  if ( xmax < y )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R4_TAN - Warning\n" );
    fprintf ( stderr, "  No precision because |X| is big.\n" );
    value = 0.0E+00;
    return value;
  }
/*
  Carefully compute y * (2/pi) = (aint(y) + rem(y)) * (.625 + pi2rec)
  = aint(.625*y) + rem(.625*y) + y*pi2rec  =  aint(.625*y) + z
  = aint(.625*y) + aint(z) + rem(z)
*/
  ainty = r4_aint ( y );
  yrem = y - ainty;
  prodbg = 0.625E+00 * ainty;
  ainty = r4_aint ( prodbg );
  y = ( prodbg - ainty ) + 0.625E+00 * yrem + y * pi2rec;
  ainty2 = r4_aint ( y );
  ainty = ainty + ainty2;
  y = y - ainty2;

  ifn = ( int ) r4_mod ( ainty, 2.0E+00 );
  if ( ifn == 1 )
  {
    y = 1.0E+00 - y;
  }

  if ( 1.0E+00 - y < fabs ( x ) * sqeps )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R4_TAN - Warning!\n" );
    fprintf ( stderr, "  Answer < half precision.\n" );
    fprintf ( stderr, "  |X| big or X near pi/2 or 3*pi/2.\n" );
  }

  if ( y == 1.0E+00 )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R4_TAN - Fatal error!\n" );
    fprintf ( stderr, "  X is pi/2 or 3*pi/2.\n" );
    exit ( 1 );
  }

  if ( y <= 0.25E+00 )
  {
    value = y;
    if ( xsml < y )
    {
      value = y * ( 1.5E+00 
        + r4_csevl ( 32.0E+00 * y * y - 1.0E+00, tancs, nterms ) );
    }
  }
  else if ( y <= 0.5E+00 )
  {
    value = 0.5E+00 * y * ( 1.5E+00 
      + r4_csevl ( 8.0E+00 * y * y - 1.0E+00, tancs, nterms ) );

    value = 2.0E+00 * value / ( 1.0E+00 - value * value );
  }
  else
  {
    value = 0.25E+00 * y * ( 1.5E+00 
      + r4_csevl ( 2.0E+00 * y * y - 1.0E+00, tancs, nterms ) );
    value = 2.0E+00 * value / ( 1.0E+00 - value * value );
    value = 2.0E+00 * value / ( 1.0E+00 - value * value );
  }

  if ( x < 0.0E+00 )
  {
    value = - fabs ( value );
 }
  else if ( 0.0E+00 < x )
  {
    value = + fabs ( value );
  }

  if ( ifn == 1 )
  {
    value = - value;
  }

  return value;
}
/******************************************************************************/

float r4_tanh ( float x )

/******************************************************************************/
/*
  Purpose:

    R4_TANH evaluates the hyperbolic tangent of an R4 argument.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, float X, the argument.

    Output, float R4_TANH, the hyperbolic tangent of X.
*/
{
  static int nterms = 0;
  static float sqeps = 0.0;
  static float tanhcs[17] = {
   -0.25828756643634710E+00,
   -0.11836106330053497E+00,
   +0.009869442648006398E+00,
   -0.000835798662344582E+00,
   +0.000070904321198943E+00,
   -0.000006016424318120E+00,
   +0.000000510524190800E+00,
   -0.000000043320729077E+00,
   +0.000000003675999055E+00,
   -0.000000000311928496E+00,
   +0.000000000026468828E+00,
   -0.000000000002246023E+00,
   +0.000000000000190587E+00,
   -0.000000000000016172E+00,
   +0.000000000000001372E+00,
   -0.000000000000000116E+00,
   +0.000000000000000009E+00 };
  float value;
  static float xmax = 0.0;
  float y;

  if ( nterms == 0 )
  {
    nterms = r4_inits ( tanhcs, 17, 0.1E+00 * r4_mach ( 3 ) );
    sqeps = sqrt ( 3.0E+00 * r4_mach ( 3 ) );
    xmax = - 0.5E+00 * log ( r4_mach ( 3 ) );
  }

  y = fabs ( x );

  if ( y <= sqeps )
  {
    value = x;
  }
  else if ( y <= 1.0E+00 )
  {
    value = x * ( 1.0E+00 
      + r4_csevl ( 2.0E+00 * x * x - 1.0E+00, tanhcs, nterms ) );
  }
  else if ( y <= xmax )
  {
    y = exp ( y );
    value = ( y - 1.0E+00 / y ) / ( y + 1.0E+00 / y );
    if ( x < 0.0E+00 )
    {
      value = - value;
    }
  }
  else
  {
    if ( x < 0.0E+00 )
    {
      value = - 1.0E+00;
    }
    else
    {
      value = + 1.0E+00;
    }
  }
  return value;
}
/******************************************************************************/

void r4_upak ( float x, float *y, int *n )

/******************************************************************************/
/*
  Purpose:

    R4_UPAK unpacks an R4 into a mantissa and exponent.

  Discussion:

    This function unpacks a floating point number x so that

      x = y * 2.0^n

    where

      0.5 <= abs ( y ) < 1.0 .

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    C version by John Burkardt.

  Parameters:

    Input, float X, the number to be unpacked.

    Output, float *Y, the mantissa.

    Output, int *N, the exponent.
*/
{
  float absx;

  absx = fabs ( x );
  *n = 0;
  *y = 0.0;

  if ( x == 0.0 )
  {
    return;
  }

  while ( absx < 0.5 )
  {
    *n = *n - 1;
    absx = absx * 2.0;
  }

  while ( 1.0 <= absx )
  {
    *n = *n + 1;
    absx = absx * 0.5;
  }

  if ( x < 0.0 )
  {
    *y = - absx;
  }
  else
  {
    *y = + absx;
  }

  return;
}
/******************************************************************************/

double r8_abs ( double x )

/******************************************************************************/
/*
  Purpose:

    R8_ABS returns the absolute value of an R8.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    14 November 2006

  Author:

    John Burkardt

  Parameters:

    Input, double X, the quantity whose absolute value is desired.

    Output, double R8_ABS, the absolute value of X.
*/
{
  double value;

  if ( 0.0 <= x )
  {
    value = x;
  } 
  else
  {
    value = - x;
  }
  return value;
}
/******************************************************************************/

double r8_acos ( double x )

/******************************************************************************/
/*
  Purpose:

    R8_ACOS evaluates the arc-cosine of an R8 argument.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, double X, the argument.

    Output, double R8_ACOS, the arc-cosine of X.
*/
{
  const double pi2 = 1.57079632679489661923132169163975;
  double value;

  value = pi2 - r8_asin ( x );

  return value;
}
/******************************************************************************/

double r8_acosh ( double x )

/******************************************************************************/
/*
  Purpose:

    R8_ACOSH evaluates the arc-hyperbolic cosine of an R8 argument.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, double X, the argument.

    Output, double R8_ACOSH, the arc-hyperbolic cosine of X.
*/
{
  const double dln2 = 0.69314718055994530941723212145818;
  double value;
  static double xmax = 0.0;

  if ( xmax == 0.0 )
  {
    xmax = 1.0 / sqrt ( r8_mach ( 3 ) );
  }

  if ( x < 1.0 )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R8_ACOSH - Fatal error!\n" );
    fprintf ( stderr, "  X < 1.0\n" );
    exit ( 1 );
  }
  else if ( x < xmax )
  {
    value = log ( x + sqrt ( x * x - 1.0 ) );
  }
  else
  {
    value = dln2 + log ( x );
  }
  return value;
}
/******************************************************************************/

void r8_admp ( double x, double *ampl, double *phi )

/******************************************************************************/
/*
  Purpose:

    R8_ADMP: modulus and phase of the derivative of the Airy function.

  Description:

    This function must only be called when X <= -1.0.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, double X, the argument.

    Output, double *AMPL, *PHI, the modulus and phase of the 
    derivative of the Airy function.
*/
{
  static double an20cs[57] = {
      0.0126732217145738027154610751034240,
     -0.0005212847072615621184780942309478,
     -0.0000052672111140370429809074052969,
     -0.0000001628202185026483752632460680,
     -0.0000000090991442687371386325973075,
     -0.0000000007438647126242192890685403,
     -0.0000000000795494751591469486122822,
     -0.0000000000104050944288303742803960,
     -0.0000000000015932425598414551523990,
     -0.0000000000002770648272341913946674,
     -0.0000000000000535342629237606295104,
     -0.0000000000000113061541781728314051,
     -0.0000000000000025772190078943167788,
     -0.0000000000000006278033116032485076,
     -0.0000000000000001621295400189939757,
     -0.0000000000000000440992985240675353,
     -0.0000000000000000125655516553258972,
     -0.0000000000000000037336906988015204,
     -0.0000000000000000011524626926724671,
     -0.0000000000000000003683081499099144,
     -0.0000000000000000001215206965331797,
     -0.0000000000000000000412916177724016,
     -0.0000000000000000000144177364239347,
     -0.0000000000000000000051631842875864,
     -0.0000000000000000000018931242668250,
     -0.0000000000000000000007096054668569,
     -0.0000000000000000000002715406646904,
     -0.0000000000000000000001059486979400,
     -0.0000000000000000000000421030035685,
     -0.0000000000000000000000170233781664,
     -0.0000000000000000000000069966677028,
     -0.0000000000000000000000029206643813,
     -0.0000000000000000000000012373128203,
     -0.0000000000000000000000005315871095,
     -0.0000000000000000000000002314622618,
     -0.0000000000000000000000001020779922,
     -0.0000000000000000000000000455706227,
     -0.0000000000000000000000000205831071,
     -0.0000000000000000000000000094015189,
     -0.0000000000000000000000000043405874,
     -0.0000000000000000000000000020247792,
     -0.0000000000000000000000000009539214,
     -0.0000000000000000000000000004537234,
     -0.0000000000000000000000000002178016,
     -0.0000000000000000000000000001054823,
     -0.0000000000000000000000000000515242,
     -0.0000000000000000000000000000253763,
     -0.0000000000000000000000000000125983,
     -0.0000000000000000000000000000063030,
     -0.0000000000000000000000000000031771,
     -0.0000000000000000000000000000016131,
     -0.0000000000000000000000000000008248,
     -0.0000000000000000000000000000004246,
     -0.0000000000000000000000000000002200,
     -0.0000000000000000000000000000001147,
     -0.0000000000000000000000000000000602,
     -0.0000000000000000000000000000000318 };
  static double an21cs[60] = {
      0.0198313155263169394420342483165643,
     -0.0029376249067087533460593745594484,
     -0.0001136260695958195549872611137182,
     -0.0000100554451087156009750981645918,
     -0.0000013048787116563250421785598252,
     -0.0000002123881993150664830666079609,
     -0.0000000402270833384269040347850109,
     -0.0000000084996745953161799142201792,
     -0.0000000019514839426178614099532934,
     -0.0000000004783865343840384282992480,
     -0.0000000001236733992099450501137105,
     -0.0000000000334137486398754232219789,
     -0.0000000000093702823540766329897780,
     -0.0000000000027130128156139564687240,
     -0.0000000000008075953800583479535949,
     -0.0000000000002463214304700125252160,
     -0.0000000000000767655689109321564410,
     -0.0000000000000243882598807354919791,
     -0.0000000000000078831466358760308462,
     -0.0000000000000025882400995585864077,
     -0.0000000000000008619457862945690828,
     -0.0000000000000002907994739663128534,
     -0.0000000000000000992846796122890484,
     -0.0000000000000000342720229187774480,
     -0.0000000000000000119511048205515026,
     -0.0000000000000000042069729043678359,
     -0.0000000000000000014939697762818400,
     -0.0000000000000000005348981161589517,
     -0.0000000000000000001929877577826238,
     -0.0000000000000000000701313701018203,
     -0.0000000000000000000256585738509682,
     -0.0000000000000000000094475894562734,
     -0.0000000000000000000034996401941465,
     -0.0000000000000000000013037622466397,
     -0.0000000000000000000004883334163346,
     -0.0000000000000000000001838477586152,
     -0.0000000000000000000000695527324058,
     -0.0000000000000000000000264351910209,
     -0.0000000000000000000000100918094655,
     -0.0000000000000000000000038688924289,
     -0.0000000000000000000000014892036525,
     -0.0000000000000000000000005754342426,
     -0.0000000000000000000000002231725971,
     -0.0000000000000000000000000868607480,
     -0.0000000000000000000000000339220403,
     -0.0000000000000000000000000132910128,
     -0.0000000000000000000000000052239309,
     -0.0000000000000000000000000020594383,
     -0.0000000000000000000000000008142614,
     -0.0000000000000000000000000003228473,
     -0.0000000000000000000000000001283529,
     -0.0000000000000000000000000000511622,
     -0.0000000000000000000000000000204451,
     -0.0000000000000000000000000000081901,
     -0.0000000000000000000000000000032886,
     -0.0000000000000000000000000000013235,
     -0.0000000000000000000000000000005338,
     -0.0000000000000000000000000000002158,
     -0.0000000000000000000000000000000874,
     -0.0000000000000000000000000000000355 };
  static double an22cs[74] = {
      0.0537418629629794329091103360917783,
     -0.0126661435859883193466312085036450,
     -0.0011924334106593006840848916913681,
     -0.0002032327627275654552687155176363,
     -0.0000446468963075163979516164905945,
     -0.0000113359036053123490416997893086,
     -0.0000031641352378546107356671355827,
     -0.0000009446708886148939120888532442,
     -0.0000002966562236471765527900905456,
     -0.0000000969118892024367799908661433,
     -0.0000000326822538653274091533072559,
     -0.0000000113144618963583865900447294,
     -0.0000000040042691001741501738278050,
     -0.0000000014440333683907423778522199,
     -0.0000000005292853746152611585663541,
     -0.0000000001967763373707889528245726,
     -0.0000000000740800095755849858816731,
     -0.0000000000282016314294661982842740,
     -0.0000000000108440066463128331337590,
     -0.0000000000042074800682644236920617,
     -0.0000000000016459149670634819724739,
     -0.0000000000006486826705121018896077,
     -0.0000000000002574095003354105832300,
     -0.0000000000001027889029407822132143,
     -0.0000000000000412845827195222720128,
     -0.0000000000000166711029332862509726,
     -0.0000000000000067656696165608023403,
     -0.0000000000000027585448232693576823,
     -0.0000000000000011296397915297168938,
     -0.0000000000000004644848225457314333,
     -0.0000000000000001917198035033912928,
     -0.0000000000000000794197570111893530,
     -0.0000000000000000330116492300368930,
     -0.0000000000000000137658057726549714,
     -0.0000000000000000057578093720012791,
     -0.0000000000000000024152700858632017,
     -0.0000000000000000010159301700933666,
     -0.0000000000000000004284434955330055,
     -0.0000000000000000001811344052168016,
     -0.0000000000000000000767602045619422,
     -0.0000000000000000000326026346758614,
     -0.0000000000000000000138773806682627,
     -0.0000000000000000000059191627103729,
     -0.0000000000000000000025297256431944,
     -0.0000000000000000000010832077293819,
     -0.0000000000000000000004646674880404,
     -0.0000000000000000000001996797783865,
     -0.0000000000000000000000859524108705,
     -0.0000000000000000000000370584152073,
     -0.0000000000000000000000160027503479,
     -0.0000000000000000000000069208124999,
     -0.0000000000000000000000029974448994,
     -0.0000000000000000000000013000356362,
     -0.0000000000000000000000005646100942,
     -0.0000000000000000000000002455341103,
     -0.0000000000000000000000001069119686,
     -0.0000000000000000000000000466095090,
     -0.0000000000000000000000000203441579,
     -0.0000000000000000000000000088900866,
     -0.0000000000000000000000000038891813,
     -0.0000000000000000000000000017032637,
     -0.0000000000000000000000000007467295,
     -0.0000000000000000000000000003277097,
     -0.0000000000000000000000000001439618,
     -0.0000000000000000000000000000633031,
     -0.0000000000000000000000000000278620,
     -0.0000000000000000000000000000122743,
     -0.0000000000000000000000000000054121,
     -0.0000000000000000000000000000023884,
     -0.0000000000000000000000000000010549,
     -0.0000000000000000000000000000004663,
     -0.0000000000000000000000000000002063,
     -0.0000000000000000000000000000000913,
     -0.0000000000000000000000000000000405 };
  static double aph0cs[53] = {
     -0.0855849241130933256920124260179491,
      0.0011214378867065260735786722471124,
      0.0000042721029353664113951573742015,
      0.0000000817607381483243644018062323,
      0.0000000033907645000492724207816418,
      0.0000000002253264422619113939845276,
      0.0000000000206284209229015251256990,
      0.0000000000023858762828130887627258,
      0.0000000000003301618105886705480628,
      0.0000000000000527009648508328581123,
      0.0000000000000094555482203813492868,
      0.0000000000000018709426951344836908,
      0.0000000000000004023980041825392741,
      0.0000000000000000930192879258983167,
      0.0000000000000000229038635402379945,
      0.0000000000000000059634359822083386,
      0.0000000000000000016320279659403399,
      0.0000000000000000004671145658861339,
      0.0000000000000000001392334415363502,
      0.0000000000000000000430642670285155,
      0.0000000000000000000137781416318755,
      0.0000000000000000000045476710480396,
      0.0000000000000000000015448420203026,
      0.0000000000000000000005389770551212,
      0.0000000000000000000001927726737155,
      0.0000000000000000000000705659320166,
      0.0000000000000000000000263985084827,
      0.0000000000000000000000100791301805,
      0.0000000000000000000000039228928481,
      0.0000000000000000000000015547422955,
      0.0000000000000000000000006268306372,
      0.0000000000000000000000002568563962,
      0.0000000000000000000000001068858883,
      0.0000000000000000000000000451347253,
      0.0000000000000000000000000193267262,
      0.0000000000000000000000000083865369,
      0.0000000000000000000000000036857386,
      0.0000000000000000000000000016396202,
      0.0000000000000000000000000007379298,
      0.0000000000000000000000000003358392,
      0.0000000000000000000000000001544891,
      0.0000000000000000000000000000718013,
      0.0000000000000000000000000000337026,
      0.0000000000000000000000000000159710,
      0.0000000000000000000000000000076382,
      0.0000000000000000000000000000036855,
      0.0000000000000000000000000000017935,
      0.0000000000000000000000000000008800,
      0.0000000000000000000000000000004353,
      0.0000000000000000000000000000002170,
      0.0000000000000000000000000000001090,
      0.0000000000000000000000000000000551,
      0.0000000000000000000000000000000281 };
  static double aph1cs[58] = {
     -0.1024172908077571694021123321813917,
      0.0071697275146591248047211649144704,
      0.0001209959363122328589813856491397,
      0.0000073361512841219912080297845684,
      0.0000007535382954271607069982903869,
      0.0000001041478171741301926885109155,
      0.0000000174358728518545691858907606,
      0.0000000033399795033346451660184961,
      0.0000000007073075174363527083399508,
      0.0000000001619187515189773266792272,
      0.0000000000394539981881954889879668,
      0.0000000000101192281734227133292631,
      0.0000000000027092778259520332198030,
      0.0000000000007523806418422548885854,
      0.0000000000002156368733008966357328,
      0.0000000000000635282777126068410174,
      0.0000000000000191756972641501729345,
      0.0000000000000059143072446464891558,
      0.0000000000000018597128517275028357,
      0.0000000000000005950444923946103668,
      0.0000000000000001934229956430180252,
      0.0000000000000000637843021489504324,
      0.0000000000000000213127290087312393,
      0.0000000000000000072081380656728500,
      0.0000000000000000024652494144769247,
      0.0000000000000000008519110570266154,
      0.0000000000000000002972384468491170,
      0.0000000000000000001046426648811446,
      0.0000000000000000000371493036347327,
      0.0000000000000000000132923247793472,
      0.0000000000000000000047912837925909,
      0.0000000000000000000017390619859336,
      0.0000000000000000000006353585173501,
      0.0000000000000000000002335643614263,
      0.0000000000000000000000863643881606,
      0.0000000000000000000000321123006944,
      0.0000000000000000000000120031540983,
      0.0000000000000000000000045091488699,
      0.0000000000000000000000017020228580,
      0.0000000000000000000000006453744630,
      0.0000000000000000000000002457788564,
      0.0000000000000000000000000939897684,
      0.0000000000000000000000000360863150,
      0.0000000000000000000000000139077884,
      0.0000000000000000000000000053797184,
      0.0000000000000000000000000020882551,
      0.0000000000000000000000000008133371,
      0.0000000000000000000000000003178080,
      0.0000000000000000000000000001245700,
      0.0000000000000000000000000000489742,
      0.0000000000000000000000000000193099,
      0.0000000000000000000000000000076349,
      0.0000000000000000000000000000030269,
      0.0000000000000000000000000000012032,
      0.0000000000000000000000000000004795,
      0.0000000000000000000000000000001915,
      0.0000000000000000000000000000000767,
      0.0000000000000000000000000000000308 };
  static double aph2cs[72] = {
     -0.2057088719781465106973648665602125,
      0.0422196961357771921673114980369460,
      0.0020482560511207275042660577813334,
      0.0002607800735165005631187879922652,
      0.0000474824268004728875381750519293,
      0.0000105102756431611743473630026955,
      0.0000026353534014667945109314041983,
      0.0000007208824863499147299790783731,
      0.0000002103236664473352859749477082,
      0.0000000644975634555295598437362273,
      0.0000000205802377264368507978116888,
      0.0000000067836273920906428963513918,
      0.0000000022974015284009400168343792,
      0.0000000007961306765491187534883226,
      0.0000000002813860609741591719003632,
      0.0000000001011749056931973922841793,
      0.0000000000369306737952476559097060,
      0.0000000000136615066127098031778842,
      0.0000000000051142751416045045119388,
      0.0000000000019351688931706516247975,
      0.0000000000007393606916493224217271,
      0.0000000000002849792219222743597555,
      0.0000000000001107280782459648335733,
      0.0000000000000433412199370134633169,
      0.0000000000000170800825265670367471,
      0.0000000000000067733080195631114673,
      0.0000000000000027016904789262414108,
      0.0000000000000010834720751810782141,
      0.0000000000000004367060312970286167,
      0.0000000000000001768511738053366608,
      0.0000000000000000719359213093645717,
      0.0000000000000000293823610002933154,
      0.0000000000000000120482811525848357,
      0.0000000000000000049586659491091389,
      0.0000000000000000020479438315847217,
      0.0000000000000000008486019944410629,
      0.0000000000000000003527351765384506,
      0.0000000000000000001470563996804903,
      0.0000000000000000000614817826902188,
      0.0000000000000000000257737706565077,
      0.0000000000000000000108323903590042,
      0.0000000000000000000045638898024998,
      0.0000000000000000000019273635403662,
      0.0000000000000000000008157668569775,
      0.0000000000000000000003460202828346,
      0.0000000000000000000001470726482427,
      0.0000000000000000000000626356074088,
      0.0000000000000000000000267261292780,
      0.0000000000000000000000114246948763,
      0.0000000000000000000000048923460516,
      0.0000000000000000000000020985807810,
      0.0000000000000000000000009016618807,
      0.0000000000000000000000003880129464,
      0.0000000000000000000000001672282170,
      0.0000000000000000000000000721790800,
      0.0000000000000000000000000311982573,
      0.0000000000000000000000000135035015,
      0.0000000000000000000000000058524861,
      0.0000000000000000000000000025397686,
      0.0000000000000000000000000011035457,
      0.0000000000000000000000000004800788,
      0.0000000000000000000000000002090956,
      0.0000000000000000000000000000911743,
      0.0000000000000000000000000000397998,
      0.0000000000000000000000000000173923,
      0.0000000000000000000000000000076083,
      0.0000000000000000000000000000033316,
      0.0000000000000000000000000000014604,
      0.0000000000000000000000000000006407,
      0.0000000000000000000000000000002814,
      0.0000000000000000000000000000001237,
      0.0000000000000000000000000000000544 };
  double eta;
  static int nan20 = 0;
  static int nan21 = 0;
  static int nan22 = 0;
  static int naph0 = 0;
  static int naph1 = 0;
  static int naph2 = 0;
  const double pi34 = 2.35619449019234492884698253745962716313;
  double sqrtx;
  static double xsml = 0.0;
  double z;

  if ( nan20 == 0 )
  {
    eta = 0.1 * r8_mach ( 3 );
    nan20 = r8_inits ( an20cs, 57, eta );
    nan21 = r8_inits ( an21cs, 60, eta );
    nan22 = r8_inits ( an22cs, 74, eta );
    naph0 = r8_inits ( aph0cs, 53, eta );
    naph1 = r8_inits ( aph1cs, 58, eta );
    naph2 = r8_inits ( aph2cs, 72, eta );
    xsml = - r8_power ( 128.0 / r8_mach ( 3 ), 0.3333 );
  }

  if ( x < xsml )
  {
    z = 1.0;
    *ampl = 0.3125 + r8_csevl ( z, an20cs, nan20 );
    *phi = - 0.625 + r8_csevl ( z, aph0cs, naph0 );
  }
  else if ( x < - 4.0 )
  {
    z = 128.0 / x / x / x + 1.0;
    *ampl = 0.3125 + r8_csevl ( z, an20cs, nan20 );
    *phi = - 0.625 + r8_csevl ( z, aph0cs, naph0 );
  }
  else if ( x < - 2.0 )
  {
    z = ( 128. / x / x / x + 9.0 ) / 7.0;
    *ampl = 0.3125 + r8_csevl ( z, an21cs, nan21 );
    *phi = - 0.625 + r8_csevl ( z, aph1cs, naph1 );
  }
  else if ( x <= - 1.0 )
  {
    z = ( 16.0 / x / x / x + 9.0 ) / 7.0;
    *ampl = 0.3125 + r8_csevl ( z, an22cs, nan22 );
    *phi = - 0.625 + r8_csevl ( z, aph2cs, naph2 );
  }
  else
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R8_ADMP - Fatal error!\n" );
    fprintf ( stderr, "  - 1.0 < X.\n" );
    exit ( 1 );
  }

  sqrtx = sqrt ( - x );
  *ampl = sqrt ( *ampl * sqrtx );
  *phi = pi34 - x * sqrtx * *phi;

  return;
}
/******************************************************************************/

double r8_ai ( double x )

/******************************************************************************/
/*
  Purpose:

    R8_AI evaluates the Airy function Ai of an R8 argument.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, double X, the argument.

    Output, double R8_AI, the Airy function Ai of X.
*/
{
  static double aifcs[13] = {
    -0.37971358496669997496197089469414E-01,
    +0.59191888537263638574319728013777E-01,
    +0.98629280577279975365603891044060E-03,
    +0.68488438190765667554854830182412E-05,
    +0.25942025962194713019489279081403E-07,
    +0.61766127740813750329445749697236E-10,
    +0.10092454172466117901429556224601E-12,
    +0.12014792511179938141288033225333E-15,
    +0.10882945588716991878525295466666E-18,
    +0.77513772196684887039238400000000E-22,
    +0.44548112037175638391466666666666E-25,
    +0.21092845231692343466666666666666E-28,
    +0.83701735910741333333333333333333E-32 };
  static double aigcs[13] = {
    +0.18152365581161273011556209957864E-01,
    +0.21572563166010755534030638819968E-01,
    +0.25678356987483249659052428090133E-03,
    +0.14265214119792403898829496921721E-05,
    +0.45721149200180426070434097558191E-08,
    +0.95251708435647098607392278840592E-11,
    +0.13925634605771399051150420686190E-13,
    +0.15070999142762379592306991138666E-16,
    +0.12559148312567778822703205333333E-19,
    +0.83063073770821340343829333333333E-23,
    +0.44657538493718567445333333333333E-26,
    +0.19900855034518869333333333333333E-29,
    +0.74702885256533333333333333333333E-33 };
  static int naif = 0;
  static int naig = 0;
  double theta;
  double value;
  static double x3sml = 0.0;
  double xm;
  static double xmax = 0.0;
  double z;

  if ( naif == 0 )
  {
    naif = r8_inits ( aifcs, 13, 0.1 * r8_mach ( 3 ) );
    naig = r8_inits ( aigcs, 13, 0.1 * r8_mach ( 3 ) );
    x3sml = r8_power ( r8_mach ( 3 ), 0.3334 );
    xmax = r8_power ( - 1.5 * log ( r8_mach ( 1 ) ), 0.6667 );
    xmax = xmax - xmax * log ( xmax ) / 
      ( 4.0 * xmax * sqrt ( xmax ) + 1.0 ) - 0.01;
  }

  if ( x < - 1.0 )
  {
    r8_aimp ( x, &xm, &theta );
    value = xm * cos ( theta );
  }
  else if ( fabs ( x ) <= x3sml )
  {
    z = 0.0;
    value = 0.375 + ( r8_csevl ( z, aifcs, naif ) 
      - x * ( 0.25 + r8_csevl ( z, aigcs, naig ) ) );
  }
  else if ( x <= 1.0 )
  {
    z = x * x * x;
    value = 0.375 + ( r8_csevl ( z, aifcs, naif ) 
      - x * ( 0.25 + r8_csevl ( z, aigcs, naig ) ) );
  }
  else if ( x <= xmax )
  {
    value = r8_aie ( x ) * exp ( - 2.0 * x * sqrt ( x ) / 3.0 );
  }
  else
  {
    value = 0.0;
  }
  return value;
}
/******************************************************************************/

double r8_aid ( double x )

/******************************************************************************/
/*
  Purpose:

    R8_AID evaluates the derivative of the Airy function Ai of an R8 argument.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, double X, the argument.

    Output, double R8_AID, the derivative of the Airy function 
    Ai of X.
*/
{
  static double aifcs[13] = {
     0.105274612265314088088970057325134114,
     0.011836136281529978442889292583980840,
     0.000123281041732256643051689242469164,
     0.000000622612256381399016825658693579,
     0.000000001852988878441452950548140821,
     0.000000000003633288725904357915995625,
     0.000000000000005046217040440664768330,
     0.000000000000000005223816555471480985,
     0.000000000000000000004185745090748989,
     0.000000000000000000000002672887324883,
     0.000000000000000000000000001392128006,
     0.000000000000000000000000000000602653,
     0.000000000000000000000000000000000220 };
  static double aigcs[13] = {
     0.0212338781509186668523122276848937,
     0.0863159303352144067524942809461604,
     0.0017975947203832313578033963225230,
     0.0000142654998755506932526620687495,
     0.0000000594379952836832010488787064,
     0.0000000001524033664794478945214786,
     0.0000000000002645876603490435305100,
     0.0000000000000003315624296815020591,
     0.0000000000000000003139789757594792,
     0.0000000000000000000002325767379040,
     0.0000000000000000000000001384384231,
     0.0000000000000000000000000000676629,
     0.0000000000000000000000000000000276 };
  double eta;
  static int naif = 0;
  static int naig = 0;
  double phi;
  double value;
  double x2;
  static double x2sml = 0.0;
  double x3;
  static double x3sml = 0.0;
  double xn;

  if ( naif == 0 )
  {
    eta = 0.1 * r8_mach ( 3 );
    naif = r8_inits ( aifcs, 13, eta );
    naig = r8_inits ( aigcs, 13, eta );
    x3sml = r8_power ( r8_mach ( 3 ), 0.3334 );
    x2sml = sqrt ( r8_mach ( 3 ) );
  }

  if ( x < - 1.0 )
  {
    r8_admp ( x, &xn, &phi );
    value = xn * cos ( phi );
  }
  else if ( fabs ( x ) <= x2sml )
  {
    x2 = 0.0;
    x3 = 0.0;
    value = ( x2 * ( 0.125 + r8_csevl ( x3, aifcs, naif ) ) 
      - r8_csevl ( x3, aigcs, naig ) ) - 0.25;
  }
  else if ( fabs ( x ) <= x3sml )
  {
    x2 = x * x;
    x3 = 0.0;
    value = ( x2 * ( 0.125 + r8_csevl ( x3, aifcs, naif ) ) 
      - r8_csevl ( x3, aigcs, naig ) ) - 0.25;
  }
  else if ( x <= 1.0 )
  {
    x2 = x * x;
    x3 = x * x * x;
    value = ( x2 * ( 0.125 + r8_csevl ( x3, aifcs, naif ) ) 
      - r8_csevl ( x3, aigcs, naig ) ) - 0.25;
  }
  else
  {
    value = r8_aide ( x ) * exp ( - 2.0 * x * sqrt ( x ) / 3.0 );
  }
  return value;
}
/******************************************************************************/

double r8_aide ( double x )

/******************************************************************************/
/*
  Purpose:

    R8_AIDE: exponentially scaled derivative, Airy function Ai of an R8 argument.

  Discussion:

    if X <= 0,
      R8_AIDE ( X ) = R8_AID ( X )
    else
      R8_AIDE ( X ) = R8_AID ( X ) * exp ( 2/3 * X^(3/2) )

    Thanks to Aleksandra Piper for pointing out a correction involving 
    the computation of Z in the last two cases, 02 February 2012.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    02 February 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, double X, the argument.

    Output, double R8_AIDE, the exponentially scaled derivative of 
    the Airy function Ai of X.
*/
{
  static double aifcs[13] = {
     0.105274612265314088088970057325134114,
      0.011836136281529978442889292583980840,
      0.000123281041732256643051689242469164,
      0.000000622612256381399016825658693579,
      0.000000001852988878441452950548140821,
      0.000000000003633288725904357915995625,
      0.000000000000005046217040440664768330,
      0.000000000000000005223816555471480985,
      0.000000000000000000004185745090748989,
      0.000000000000000000000002672887324883,
      0.000000000000000000000000001392128006,
      0.000000000000000000000000000000602653,
      0.000000000000000000000000000000000220 };
  static double aigcs[13] = {
      0.0212338781509186668523122276848937,
      0.0863159303352144067524942809461604,
      0.0017975947203832313578033963225230,
      0.0000142654998755506932526620687495,
      0.0000000594379952836832010488787064,
      0.0000000001524033664794478945214786,
      0.0000000000002645876603490435305100,
      0.0000000000000003315624296815020591,
      0.0000000000000000003139789757594792,
      0.0000000000000000000002325767379040,
      0.0000000000000000000000001384384231,
      0.0000000000000000000000000000676629,
      0.0000000000000000000000000000000276 };
  static double aip1cs[57] = {
     0.0358865097808301537956710489261688,
     0.0114668575627764898572700883121766,
    -0.0007592073583861400301335647601603,
     0.0000869517610893841271948619434021,
    -0.0000128237294298591691789607600486,
     0.0000022062695681038336934376250420,
    -0.0000004222295185920749486945988432,
     0.0000000874686415726348479356130376,
    -0.0000000192773588418365388625693417,
     0.0000000044668460054492719699777137,
    -0.0000000010790108051948168015747466,
     0.0000000002700029446696248083071434,
    -0.0000000000696480108007915257318929,
     0.0000000000184489907003246687076806,
    -0.0000000000050027817358071698301149,
     0.0000000000013852243366012168297298,
    -0.0000000000003908218466657048253473,
     0.0000000000001121536072524563451273,
    -0.0000000000000326861522579502522443,
     0.0000000000000096619179010090805752,
    -0.0000000000000028934767442698434271,
     0.0000000000000008770086661150897069,
    -0.0000000000000002688046261195853754,
     0.0000000000000000832498823872342992,
    -0.0000000000000000260343254786947057,
     0.0000000000000000082159528142686287,
    -0.0000000000000000026150406704984940,
     0.0000000000000000008390563463261051,
    -0.0000000000000000002712685618629660,
     0.0000000000000000000883333375271942,
    -0.0000000000000000000289603206822333,
     0.0000000000000000000095562185928676,
    -0.0000000000000000000031727463569051,
     0.0000000000000000000010595576960768,
    -0.0000000000000000000003558253765402,
     0.0000000000000000000001201334680517,
    -0.0000000000000000000000407666883800,
     0.0000000000000000000000139016944446,
    -0.0000000000000000000000047628165730,
     0.0000000000000000000000016391265551,
    -0.0000000000000000000000005665491354,
     0.0000000000000000000000001966381969,
    -0.0000000000000000000000000685230229,
     0.0000000000000000000000000239706939,
    -0.0000000000000000000000000084166831,
     0.0000000000000000000000000029659364,
    -0.0000000000000000000000000010487947,
     0.0000000000000000000000000003721150,
    -0.0000000000000000000000000001324570,
     0.0000000000000000000000000000472976,
    -0.0000000000000000000000000000169405,
     0.0000000000000000000000000000060855,
    -0.0000000000000000000000000000021924,
     0.0000000000000000000000000000007920,
    -0.0000000000000000000000000000002869,
     0.0000000000000000000000000000001042,
    -0.0000000000000000000000000000000379 };
  static double aip2cs[37] = {
     0.0065457691989713756794276979067064,
     0.0023833724120774591992772552886923,
    -0.0000430700770220585862775012110584,
     0.0000015629125858629202330785369063,
    -0.0000000815417186162706965112501015,
     0.0000000054103738056935918208008783,
    -0.0000000004284130882614696528766222,
     0.0000000000389497962832286424862198,
    -0.0000000000039623161264979257658071,
     0.0000000000004428184214405989602353,
    -0.0000000000000536296527150689675318,
     0.0000000000000069649872139936028200,
    -0.0000000000000009619636286095319210,
     0.0000000000000001403454967784808032,
    -0.0000000000000000215097136525875715,
     0.0000000000000000034471230632678283,
    -0.0000000000000000005753907621819442,
     0.0000000000000000000997001165824168,
    -0.0000000000000000000178811436021458,
     0.0000000000000000000033110307923551,
    -0.0000000000000000000006315885529506,
     0.0000000000000000000001238666952364,
    -0.0000000000000000000000249324053394,
     0.0000000000000000000000051426030999,
    -0.0000000000000000000000010854236402,
     0.0000000000000000000000002341316852,
    -0.0000000000000000000000000515542099,
     0.0000000000000000000000000115758841,
    -0.0000000000000000000000000026479669,
     0.0000000000000000000000000006165328,
    -0.0000000000000000000000000001459931,
     0.0000000000000000000000000000351331,
    -0.0000000000000000000000000000085863,
     0.0000000000000000000000000000021297,
    -0.0000000000000000000000000000005358,
     0.0000000000000000000000000000001367,
    -0.0000000000000000000000000000000353 };
  double eta;
  static int naif = 0;
  static int naig = 0;
  static int naip1 = 0;
  static int naip2 = 0;
  double phi;
  double sqrtx;
  double value;
  double x2;
  static double x2sml = 0.0;
  double x3;
  static double x32sml = 0.0;
  static double x3sml = 0.0;
  static double xbig = 0.0;
  double xn;
  double z;

  if ( naif == 0 )
  {
    eta = 0.1 * r8_mach ( 3 );
    naif = r8_inits ( aifcs, 13, eta );
    naig = r8_inits ( aigcs, 13, eta );
    naip1 = r8_inits ( aip1cs, 57, eta );
    naip2 = r8_inits ( aip2cs, 37, eta );
    x2sml = sqrt ( eta );
    x3sml = r8_power ( eta, 0.3333 );
    x32sml = 1.3104 * x3sml * x3sml;
    xbig = r8_power ( r8_mach ( 2 ), 0.6666 );
  }

  if ( x < - 1.0 )
  {
    r8_admp ( x, &xn, &phi );
    value = xn * cos ( phi );
  }
  else if ( fabs ( x ) < x2sml )
  {
    x2 = 0.0;
    x3 = 0.0;
    value = ( x2 * ( 0.125 + r8_csevl ( x3, aifcs, naif ) ) 
      - r8_csevl ( x3, aigcs, naig ) ) - 0.25;
    if ( x32sml < x )
    {
      value = value * exp ( 2.0 * x * sqrt ( x ) / 3.0 );
    }
  }
  else if ( fabs ( x ) < x3sml )
  {
    x2 = x * x;
    x3 = 0.0;
    value = ( x2 * ( 0.125 + r8_csevl ( x3, aifcs, naif ) ) 
      - r8_csevl ( x3, aigcs, naig ) ) - 0.25;
    if ( x32sml < x )
    {
      value = value * exp ( 2.0 * x * sqrt ( x ) / 3.0 );
    }
  }
  else if ( x <= 1.0 )
  {
    x2 = x * x;
    x3 = x * x;
    value = ( x2 * ( 0.125 + r8_csevl ( x3, aifcs, naif ) ) 
      - r8_csevl ( x3, aigcs, naig ) ) - 0.25;
    if ( x32sml < x )
    {
      value = value * exp ( 2.0 * x * sqrt ( x ) / 3.0 );
    }
  }
  else if ( x <= 4.0 )
  {
    sqrtx = sqrt ( x );
    z = ( 16.0  / ( x * sqrtx ) - 9.0 ) / 7.0;
    value = ( - 0.28125 - r8_csevl ( z, aip1cs, naip1 ) ) * sqrt ( sqrtx );
  }
  else if ( x < xbig )
  {
    sqrtx = sqrt ( x );
    z = 16.0  / ( x * sqrtx ) - 1.0;
    value = ( - 0.28125 - r8_csevl ( z, aip2cs, naip2 ) ) * sqrt ( sqrtx );
  }
  else
  {
    sqrtx = sqrt ( x );
    z = - 1.0;
    value = ( - 0.28125 - r8_csevl ( z, aip2cs, naip2 ) ) * sqrt ( sqrtx );
  }
  return value;
}
/******************************************************************************/

double r8_aie ( double x )

/******************************************************************************/
/*
  Purpose:

    R8_AIE evaluates the exponentially scaled Airy function Ai of an R8 argument.

  Discussion:

    if X <= 0,
      R8_AIE ( X ) = R8_AI ( X )
    else
      R8_AIE ( X ) = R8_AI ( X ) * exp ( 2/3 * X^(3/2) )

    Thanks to Aleksandra Piper for pointing out a correction involving a
    missing assignment to SQRTX, 27 January 2012.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    27 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, double X, the argument.

    Output, double R8_AIE, the exponentially scaled Airy function Ai of X.
*/
{
  static double aifcs[13] = {
    -0.37971358496669997496197089469414E-01,
    +0.59191888537263638574319728013777E-01,
    +0.98629280577279975365603891044060E-03,
    +0.68488438190765667554854830182412E-05,
    +0.25942025962194713019489279081403E-07,
    +0.61766127740813750329445749697236E-10,
    +0.10092454172466117901429556224601E-12,
    +0.12014792511179938141288033225333E-15,
    +0.10882945588716991878525295466666E-18,
    +0.77513772196684887039238400000000E-22,
    +0.44548112037175638391466666666666E-25,
    +0.21092845231692343466666666666666E-28,
    +0.83701735910741333333333333333333E-32 };
  static double aigcs[13] = {
    +0.18152365581161273011556209957864E-01,
    +0.21572563166010755534030638819968E-01,
    +0.25678356987483249659052428090133E-03,
    +0.14265214119792403898829496921721E-05,
    +0.45721149200180426070434097558191E-08,
    +0.95251708435647098607392278840592E-11,
    +0.13925634605771399051150420686190E-13,
    +0.15070999142762379592306991138666E-16,
    +0.12559148312567778822703205333333E-19,
    +0.83063073770821340343829333333333E-23,
    +0.44657538493718567445333333333333E-26,
    +0.19900855034518869333333333333333E-29,
    +0.74702885256533333333333333333333E-33 };
  static double aip1cs[57] = {
    -0.2146951858910538455460863467778E-01,
    -0.7535382535043301166219720865565E-02,
    +0.5971527949026380852035388881994E-03,
    -0.7283251254207610648502368291548E-04,
    +0.1110297130739299666517381821140E-04,
    -0.1950386152284405710346930314033E-05,
    +0.3786973885159515193885319670057E-06,
    -0.7929675297350978279039072879154E-07,
    +0.1762247638674256075568420122202E-07,
    -0.4110767539667195045029896593893E-08,
    +0.9984770057857892247183414107544E-09,
    -0.2510093251387122211349867730034E-09,
    +0.6500501929860695409272038601725E-10,
    -0.1727818405393616515478877107366E-10,
    +0.4699378842824512578362292872307E-11,
    -0.1304675656297743914491241246272E-11,
    +0.3689698478462678810473948382282E-12,
    -0.1061087206646806173650359679035E-12,
    +0.3098414384878187438660210070110E-13,
    -0.9174908079824139307833423547851E-14,
    +0.2752049140347210895693579062271E-14,
    -0.8353750115922046558091393301880E-15,
    +0.2563931129357934947568636168612E-15,
    -0.7950633762598854983273747289822E-16,
    +0.2489283634603069977437281175644E-16,
    -0.7864326933928735569664626221296E-17,
    +0.2505687311439975672324470645019E-17,
    -0.8047420364163909524537958682241E-18,
    +0.2604097118952053964443401104392E-18,
    -0.8486954164056412259482488834184E-19,
    +0.2784706882142337843359429186027E-19,
    -0.9195858953498612913687224151354E-20,
    +0.3055304318374238742247668225583E-20,
    -0.1021035455479477875902177048439E-20,
    +0.3431118190743757844000555680836E-21,
    -0.1159129341797749513376922463109E-21,
    +0.3935772844200255610836268229154E-22,
    -0.1342880980296717611956718989038E-22,
    +0.4603287883520002741659190305314E-23,
    -0.1585043927004064227810772499387E-23,
    +0.5481275667729675908925523755008E-24,
    -0.1903349371855047259064017948945E-24,
    +0.6635682302374008716777612115968E-25,
    -0.2322311650026314307975200986453E-25,
    +0.8157640113429179313142743695359E-26,
    -0.2875824240632900490057489929557E-26,
    +0.1017329450942901435079714319018E-26,
    -0.3610879108742216446575703490559E-27,
    +0.1285788540363993421256640342698E-27,
    -0.4592901037378547425160693022719E-28,
    +0.1645597033820713725812102485333E-28,
    -0.5913421299843501842087920271360E-29,
    +0.2131057006604993303479369509546E-29,
    -0.7701158157787598216982761745066E-30,
    +0.2790533307968930417581783777280E-30,
    -0.1013807715111284006452241367039E-30,
    +0.3692580158719624093658286216533E-31 };
  static double aip2cs[37] = {
    -0.174314496929375513390355844011E-02,
    -0.167893854325541671632190613480E-02,
    +0.359653403352166035885983858114E-04,
    -0.138081860273922835457399383100E-05,
    +0.741122807731505298848699095233E-07,
    -0.500238203900133013130422866325E-08,
    +0.400693917417184240675446866355E-09,
    -0.367331242795905044199318496207E-10,
    +0.376034439592373852439592002918E-11,
    -0.422321332718747538026564938968E-12,
    +0.513509454033657070919618754120E-13,
    -0.669095850390477595651681356676E-14,
    +0.926667545641290648239550724382E-15,
    -0.135514382416070576333397356591E-15,
    +0.208115496312830995299006549335E-16,
    -0.334116499159176856871277570256E-17,
    +0.558578584585924316868032946585E-18,
    -0.969219040152365247518658209109E-19,
    +0.174045700128893206465696557738E-19,
    -0.322640979731130400247846333098E-20,
    +0.616074471106625258533259618986E-21,
    -0.120936347982490059076420676266E-21,
    +0.243632763310138108261570095786E-22,
    -0.502914221497457468943403144533E-23,
    +0.106224175543635689495470626133E-23,
    -0.229284284895989241509856324266E-24,
    +0.505181733929503744986884778666E-25,
    -0.113498123714412404979793920000E-25,
    +0.259765565985606980698374144000E-26,
    -0.605124621542939506172231679999E-27,
    +0.143359777966772800720295253333E-27,
    -0.345147757060899986280721066666E-28,
    +0.843875190213646740427025066666E-29,
    -0.209396142298188169434453333333E-29,
    +0.527008873478945503182848000000E-30,
    -0.134457433014553385789030399999E-30,
    +0.347570964526601147340117333333E-31 };
  double eta;
  static int naif = 0;
  static int naig =  0;
  static int naip1 = 0;
  static int naip2 = 0;
  double sqrtx;
  double theta;
  double value;
  static double x32sml = 0.0;
  static double x3sml = 0.0;
  static double xbig = 0.0;
  double xm;
  double z;

  if ( naif == 0 )
  {
    eta = 0.1 * r8_mach ( 3 );
    naif = r8_inits ( aifcs, 13, eta );
    naig = r8_inits ( aigcs, 13, eta );
    naip1 = r8_inits ( aip1cs, 57, eta );
    naip2 = r8_inits ( aip2cs, 37, eta );
    x3sml = r8_power ( eta, 0.3333 );
    x32sml = 1.3104 * x3sml * x3sml;
    xbig = r8_power ( r8_mach ( 2 ), 0.6666 );
  }

  if ( x < - 1.0 )
  {
    r8_aimp ( x, &xm, &theta );
    value = xm * cos ( theta );
  }
  else if ( 0.0 <= x && x <= x32sml )
  {
    z = 0.0;
    value = 0.3750 + ( r8_csevl ( z, aifcs, naif ) 
      - x * ( 0.25 + r8_csevl ( z, aigcs, naig ) ) );
  }
  else if ( fabs ( x ) <= x3sml )
  {
    z = 0.0;
    value = 0.3750 + ( r8_csevl ( z, aifcs, naif ) 
      - x * ( 0.25 + r8_csevl ( z, aigcs, naig ) ) );
    value = value * exp ( 2.0 * x * sqrt ( x ) / 3.0 );
  }
  else if ( x <= 1.0 )
  {
    z = x * x * x;
    value = 0.3750 + ( r8_csevl ( z, aifcs, naif ) 
      - x * ( 0.25 + r8_csevl ( z, aigcs, naig ) ) );
    value = value * exp ( 2.0 * x * sqrt ( x ) / 3.0 );
  }
  else if ( x <= 4.0 )
  {
    sqrtx = sqrt ( x );
    z = ( 16.0 / ( x * sqrtx ) - 9.0 ) / 7.0;
    value = ( 0.28125 + r8_csevl ( z, aip1cs, naip1 ) ) / sqrt ( sqrtx );
  }
  else if ( x < xbig )
  {
    sqrtx = sqrt ( x );
    z = 16.0 / ( x * sqrtx ) - 1.0;
    value = ( 0.28125 + r8_csevl ( z, aip2cs, naip2 ) ) / sqrt ( sqrtx );
  }
  else
  {
    sqrtx = sqrt ( x );
    z = - 1.0;
    value = ( 0.28125 + r8_csevl ( z, aip2cs, naip2 ) ) / sqrt ( sqrtx );
  }
  return value;
}
/******************************************************************************/

void r8_aimp ( double x, double *ampl, double *theta )

/******************************************************************************/
/*
  Purpose:

    R8_AIMP evaluates the modulus and phase of the Airy function.

  Description:

    This function must only be called when X <= -1.0.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, double X, the argument.

    Output, double *AMPL, *PHI, the modulus and phase of the 
    Airy function.
*/
{
  static double am20cs[57] = {
    +0.108716749086561856615730588125E-01,
    +0.369489228982663555091728665146E-03,
    +0.440680100484689563667507001327E-05,
    +0.143686762361911153929183952833E-06,
    +0.824275552390078308670628855353E-08,
    +0.684426758893661606173927278180E-09,
    +0.739566697282739287731004740213E-10,
    +0.974595633696825017638702600847E-11,
    +0.150076885829405775650973119497E-11,
    +0.262147910221527634206252854802E-12,
    +0.508354111376487180357278966914E-13,
    +0.107684753358811440492985997070E-13,
    +0.246091286618433429335914062617E-14,
    +0.600786380358656418436110373550E-15,
    +0.155449156102388071150651388384E-15,
    +0.423535125035576604426382780182E-16,
    +0.120862166289299840154401109189E-16,
    +0.359609651214658240861499706423E-17,
    +0.111134218386395638261774604677E-17,
    +0.355559532432366609893680289225E-18,
    +0.117433021600139309998766947387E-18,
    +0.399397454661077561389162200966E-19,
    +0.139576671528916310425606325640E-19,
    +0.500240055309236041393459280716E-20,
    +0.183552760958132679184834866457E-20,
    +0.688490998179202743197790112404E-21,
    +0.263631035611417012359996885105E-21,
    +0.102924890237338360287153563785E-21,
    +0.409246966671594885489762960571E-22,
    +0.165558573406734651039727903828E-22,
    +0.680797467063033356116599685727E-23,
    +0.284326559934079832419751134476E-23,
    +0.120507398348965255097287818819E-23,
    +0.517961243287505217976613610424E-24,
    +0.225622613427562816303268640887E-24,
    +0.995418801147745168832117078246E-25,
    +0.444551696397342424308280582053E-25,
    +0.200865195461501101425916097338E-25,
    +0.917786344151775165973885645402E-26,
    +0.423872958105589240661672197948E-26,
    +0.197789272007846092370846251490E-26,
    +0.932116351284620665680435253373E-27,
    +0.443482133249918099955611379722E-27,
    +0.212945672365573895594589552837E-27,
    +0.103158569651075977552209344907E-27,
    +0.504023773022591199157904590029E-28,
    +0.248301304570155945304046541005E-28,
    +0.123301783128562196054198238560E-28,
    +0.617033449920521746121976730507E-29,
    +0.311092617415918897233869792213E-29,
    +0.157983085201706173015269071503E-29,
    +0.807931987538283607678121339092E-30,
    +0.415997394138667562722951360052E-30,
    +0.215610934097716900471935862504E-30,
    +0.112468857265869178296752823613E-30,
    +0.590331560632838091123040811797E-31,
    +0.311735667692928562046280505333E-31 };
  static double am21cs[60] = {
    +0.592790266721309588375717482814E-02,
    +0.200569405393165186428695217690E-02,
    +0.911081850262275893553072526291E-04,
    +0.849894306372047155633172107475E-05,
    +0.113297908976913076637929215494E-05,
    +0.187517946100666496180950627804E-06,
    +0.359306519018245832699035211192E-07,
    +0.765757714071683864039093517470E-08,
    +0.176999967168039173925953460744E-08,
    +0.436259555654598932720546585535E-09,
    +0.113291641337853230035520085219E-09,
    +0.307257690982419244137868398126E-10,
    +0.864482416482201075541200465766E-11,
    +0.251015250060924402115104562212E-11,
    +0.749102496764440371601802227751E-12,
    +0.228996928487994073089565214432E-12,
    +0.715113658927987694949327491175E-13,
    +0.227607924959566841946395165061E-13,
    +0.736942142760886513969953227782E-14,
    +0.242328675267827490463991742006E-14,
    +0.808153774548239869283406558403E-15,
    +0.273008079804356086659174563386E-15,
    +0.933236070891385318473519474326E-16,
    +0.322508099681084622213867546973E-16,
    +0.112581932346444541217757573416E-16,
    +0.396699463986938821660259459530E-17,
    +0.141006567944319504660865034527E-17,
    +0.505302086537851213375537393032E-18,
    +0.182461523215945141197999102789E-18,
    +0.663584568262130466928029121642E-19,
    +0.242963731631276179741747455826E-19,
    +0.895238915123687802013669922963E-20,
    +0.331845289350050791260229250755E-20,
    +0.123706196188658315384437905922E-20,
    +0.463636677012390840306767734243E-21,
    +0.174653135947764475469758765989E-21,
    +0.661116810234991176307910643111E-22,
    +0.251409918994072486176125666459E-22,
    +0.960274995571732568694034386998E-23,
    +0.368324952289296395686436898078E-23,
    +0.141843138269159136145535939553E-23,
    +0.548342674276935830106345800990E-24,
    +0.212761054623118806650372562616E-24,
    +0.828443700849418591487734760953E-25,
    +0.323670563926127001421028600927E-25,
    +0.126868882963286057355055062493E-25,
    +0.498843818992121626935068934362E-26,
    +0.196734584467649390967119381790E-26,
    +0.778135971020326957713212064836E-27,
    +0.308633941498911152919192968451E-27,
    +0.122744647045453119789338037234E-27,
    +0.489431279134292205885241216204E-28,
    +0.195646879802909821175925099724E-28,
    +0.783988952922426171166311492266E-29,
    +0.314896914002484223748298978099E-29,
    +0.126769763137250681307067842559E-29,
    +0.511470691906900141641632107724E-30,
    +0.206801709795538770250900316706E-30,
    +0.837891344768519001325996867583E-31,
    +0.340168991971489802052339079577E-31 };
  static double am22cs[74] = {
    -0.156284448062534112753545828583E-01,
    +0.778336445239681307018943100334E-02,
    +0.867057770477189528406072812110E-03,
    +0.156966273156113719469953482266E-03,
    +0.356396257143286511324100666302E-04,
    +0.924598335425043154495080090994E-05,
    +0.262110161850422389523194982066E-05,
    +0.791882216516012561489469982263E-06,
    +0.251041527921011847803162690862E-06,
    +0.826522320665407734472997712940E-07,
    +0.280571166281305264396384290014E-07,
    +0.976821090484680786674631273890E-08,
    +0.347407923227710343287279035573E-08,
    +0.125828132169836914219092738164E-08,
    +0.462988260641895264497330784625E-09,
    +0.172728258813604072468143128696E-09,
    +0.652319200131154135148574124970E-10,
    +0.249047168520982056019881087112E-10,
    +0.960156820553765948078189890126E-11,
    +0.373448002067726856974776596757E-11,
    +0.146417565032053391722216189678E-11,
    +0.578265471168512825475827881553E-12,
    +0.229915407244706118560254184494E-12,
    +0.919780711231997257150883662365E-13,
    +0.370060068813090065807504045556E-13,
    +0.149675761698672987823326345205E-13,
    +0.608361194938461148720451399443E-14,
    +0.248404087115121397635425326873E-14,
    +0.101862476526769080727914465339E-14,
    +0.419383856352753989429640310957E-15,
    +0.173318901762930756149702493501E-15,
    +0.718821902388508517820445406811E-16,
    +0.299123633598403607712470896113E-16,
    +0.124868990433238627855713110880E-16,
    +0.522829344609483661928651193632E-17,
    +0.219532961724713396595998454359E-17,
    +0.924298325229777281154410024332E-18,
    +0.390157708236091407825543197309E-18,
    +0.165093892693863707213759030367E-18,
    +0.700221815715994367565716554487E-19,
    +0.297651833616786915573214963506E-19,
    +0.126796539086902072571134261229E-19,
    +0.541243400697077628687581725061E-20,
    +0.231487350218155252296382133283E-20,
    +0.991920288386566563462623851167E-21,
    +0.425803015323732357158897608174E-21,
    +0.183101842973024501678402003088E-21,
    +0.788678712311075375564526811022E-22,
    +0.340254607386229874956582997235E-22,
    +0.147020881405712530791860892535E-22,
    +0.636211018324916957733348071767E-23,
    +0.275707050680980721919395987768E-23,
    +0.119645858090104071356261780457E-23,
    +0.519912545729242147981768210567E-24,
    +0.226217674847104475260575286850E-24,
    +0.985526113754431819448565068283E-25,
    +0.429870630332508717223681286187E-25,
    +0.187723641661580639829657670189E-25,
    +0.820721941772842137268801052115E-26,
    +0.359214665604615507812767944463E-26,
    +0.157390594612773315611458940587E-26,
    +0.690329781039333834965319153586E-27,
    +0.303092079078968534607859331415E-27,
    +0.133204934160481219185689121944E-27,
    +0.585978836851523490117937981442E-28,
    +0.258016868489487806338425080457E-28,
    +0.113712433637283667223632182863E-28,
    +0.501592557226068509236430548549E-29,
    +0.221445829395509373322569708484E-29,
    +0.978470283886507289984691416411E-30,
    +0.432695414934180170112000952983E-30,
    +0.191497288193994570612929860440E-30,
    +0.848164622402392354171298331562E-31,
    +0.375947065173955919947455052934E-31 };
  static double ath0cs[53] = {
    -0.8172601764161634499840208700543E-01,
    -0.8004012824788273287596481113068E-03,
    -0.3186525268782113203795553628242E-05,
    -0.6688388266477509330741698865033E-07,
    -0.2931759284994564516506822463184E-08,
    -0.2011263760883621669049030307186E-09,
    -0.1877522678055973426074008166652E-10,
    -0.2199637137704601251899002199848E-11,
    -0.3071616682592272449025746605586E-12,
    -0.4936140553673418361025600985389E-13,
    -0.8902833722583660416935236969866E-14,
    -0.1768987764615272613656814199467E-14,
    -0.3817868689032277014678199609600E-15,
    -0.8851159014819947594156286509984E-16,
    -0.2184818181414365953149677679568E-16,
    -0.5700849046986452380599442295119E-17,
    -0.1563121122177875392516031795495E-17,
    -0.4481437996768995067906688776353E-18,
    -0.1337794883736188022044566044098E-18,
    -0.4143340036874114453776852445442E-19,
    -0.1327263385718805025080481164652E-19,
    -0.4385728589128440522215756835955E-20,
    -0.1491360695952818067686201743956E-20,
    -0.5208104738630711377154238188773E-21,
    -0.1864382222390498923872526604979E-21,
    -0.6830263751167969012975435381881E-22,
    -0.2557117058029329629296207591347E-22,
    -0.9770158640254300218246907254046E-23,
    -0.3805161433416679084068428254886E-23,
    -0.1509022750737054063493926482995E-23,
    -0.6087551341242424929005568014525E-24,
    -0.2495879513809711495425982124058E-24,
    -0.1039157654581920948909588084274E-24,
    -0.4390235913976846536974594969051E-25,
    -0.1880790678447990211675826820582E-25,
    -0.8165070764199462948863022205753E-26,
    -0.3589944503749750514266435585041E-26,
    -0.1597658126632132872981291608708E-26,
    -0.7193250175703823969113802835305E-27,
    -0.3274943012727856506209351132721E-27,
    -0.1507042445783690665816975047272E-27,
    -0.7006624198319904717843967949140E-28,
    -0.3289907402983718226528815678356E-28,
    -0.1559518084365146526445322711496E-28,
    -0.7460690508208254582833851119721E-29,
    -0.3600877034824662020563277249431E-29,
    -0.1752851437473772257350402219197E-29,
    -0.8603275775188512909623778628724E-30,
    -0.4256432603226946534668039480105E-30,
    -0.2122161865044262927723650698206E-30,
    -0.1065996156704879052472060798561E-30,
    -0.5393568608816949116410688086892E-31,
    -0.2748174851043954822278496517870E-31 };
  static double ath1cs[58] = {
    -0.6972849916208883845888148415037E-01,
    -0.5108722790650044987073448077961E-02,
    -0.8644335996989755094525334749512E-04,
    -0.5604720044235263542188698916125E-05,
    -0.6045735125623897409156376640077E-06,
    -0.8639802632488334393219721138499E-07,
    -0.1480809484309927157147782480780E-07,
    -0.2885809334577236039999449908712E-08,
    -0.6191631975665699609309191231800E-09,
    -0.1431992808860957830931365259879E-09,
    -0.3518141102137214721504616874321E-10,
    -0.9084761919955078290070339808051E-11,
    -0.2446171672688598449343283664767E-11,
    -0.6826083203213446240828996710264E-12,
    -0.1964579931194940171278546257802E-12,
    -0.5808933227139693164009191265856E-13,
    -0.1759042249527441992795400959024E-13,
    -0.5440902932714896613632538945319E-14,
    -0.1715247407486806802622358519451E-14,
    -0.5500929233576991546871101847161E-15,
    -0.1791878287739317259495152638754E-15,
    -0.5920372520086694197778411062231E-16,
    -0.1981713027876483962470972206590E-16,
    -0.6713232347016352262049984343790E-17,
    -0.2299450243658281116122358619832E-17,
    -0.7957300928236376595304637145634E-18,
    -0.2779994027291784157172290233739E-18,
    -0.9798924361326985224406795480814E-19,
    -0.3482717006061574386702645565849E-19,
    -0.1247489122558599057173300058084E-19,
    -0.4501210041478228113487751824452E-20,
    -0.1635346244013352135596114164667E-20,
    -0.5980102897780336268098762265941E-21,
    -0.2200246286286123454028196295475E-21,
    -0.8142463073515085897408205291519E-22,
    -0.3029924773660042537432330709674E-22,
    -0.1133390098574623537722943969689E-22,
    -0.4260766024749295719283049889791E-23,
    -0.1609363396278189718797500634453E-23,
    -0.6106377190825026293045330444287E-24,
    -0.2326954318021694061836577887573E-24,
    -0.8903987877472252604474129558186E-25,
    -0.3420558530005675024117914752341E-25,
    -0.1319026715257272659017212100607E-25,
    -0.5104899493612043091316191177386E-26,
    -0.1982599478474547451242444663466E-26,
    -0.7725702356880830535636111851519E-27,
    -0.3020234733664680100815776863573E-27,
    -0.1184379739074169993712946380800E-27,
    -0.4658430227922308520573252840106E-28,
    -0.1837554188100384647157502006613E-28,
    -0.7268566894427990953321876684800E-29,
    -0.2882863120391468135527089875626E-29,
    -0.1146374629459906350417591664639E-29,
    -0.4570031437748533058179991688533E-30,
    -0.1826276602045346104809934028799E-30,
    -0.7315349993385250469111066350933E-31,
    -0.2936925599971429781637815773866E-31 };
  static double ath2cs[72] = {
    +0.4405273458718778997061127057775E-02,
    -0.3042919452318454608483844239873E-01,
    -0.1385653283771793791602692842653E-02,
    -0.1804443908954952302670486910952E-03,
    -0.3380847108327308671057465323618E-04,
    -0.7678183535229023055257676817765E-05,
    -0.1967839443716035324690935417077E-05,
    -0.5483727115877700361586143659281E-06,
    -0.1625461550532612452712696212258E-06,
    -0.5053049981268895015277637842078E-07,
    -0.1631580701124066881183851715617E-07,
    -0.5434204112348517507963436694817E-08,
    -0.1857398556409900325763850109630E-08,
    -0.6489512033326108816213513640676E-09,
    -0.2310594885800944720482995987079E-09,
    -0.8363282183204411682819329546745E-10,
    -0.3071196844890191462660661303891E-10,
    -0.1142367142432716819409514579892E-10,
    -0.4298116066345803065822470108971E-11,
    -0.1633898699596715440601646086632E-11,
    -0.6269328620016619432123443754076E-12,
    -0.2426052694816257357356159203991E-12,
    -0.9461198321624039090742527765052E-13,
    -0.3716060313411504806847798281269E-13,
    -0.1469155684097526763170138810309E-13,
    -0.5843694726140911944556401363094E-14,
    -0.2337502595591951298832675034934E-14,
    -0.9399231371171435401160167358411E-15,
    -0.3798014669372894500076335263715E-15,
    -0.1541731043984972524883443681775E-15,
    -0.6285287079535307162925662365202E-16,
    -0.2572731812811455424755383992774E-16,
    -0.1057098119354017809340974866555E-16,
    -0.4359080267402696966695992699964E-17,
    -0.1803634315959978013953176945540E-17,
    -0.7486838064380536821719431676914E-18,
    -0.3117261367347604656799597209985E-18,
    -0.1301687980927700734792871620696E-18,
    -0.5450527587519522468973883909909E-19,
    -0.2288293490114231872268635931903E-19,
    -0.9631059503829538655655060440088E-20,
    -0.4063281001524614089092195416434E-20,
    -0.1718203980908026763900413858510E-20,
    -0.7281574619892536367415322473328E-21,
    -0.3092352652680643127960680345790E-21,
    -0.1315917855965440490383417023254E-21,
    -0.5610606786087055512664907412668E-22,
    -0.2396621894086355206020304337895E-22,
    -0.1025574332390581200832954423924E-22,
    -0.4396264138143656476403607323663E-23,
    -0.1887652998372577373342508719450E-23,
    -0.8118140359576807603579433230445E-24,
    -0.3496734274366286856375952089214E-24,
    -0.1508402925156873215171751475867E-24,
    -0.6516268284778671059787773834341E-25,
    -0.2818945797529207424505942114583E-25,
    -0.1221127596512262744598094464505E-25,
    -0.5296674341169867168620011705073E-26,
    -0.2300359270773673431358870971744E-26,
    -0.1000279482355367494781220348930E-26,
    -0.4354760404180879394806893162179E-27,
    -0.1898056134741477522515482827030E-27,
    -0.8282111868712974697554009309315E-28,
    -0.3617815493066569006586213484374E-28,
    -0.1582018896178003654858941843636E-28,
    -0.6925068597802270011772820383247E-29,
    -0.3034390239778629128908629727335E-29,
    -0.1330889568166725224761977446509E-29,
    -0.5842848522173090120487606971706E-30,
    -0.2567488423238302631121274357678E-30,
    -0.1129232322268882185791505819151E-30,
    -0.4970947029753336916550570105023E-31 };
  double eta;
  static int nam20 = 0;
  static int nam21 = 0;
  static int nam22 = 0;
  static int nath0 = 0;
  static int nath1 = 0;
  static int nath2 = 0;
  const double pi4 = 0.78539816339744830961566084581988;
  double sqrtx;
  static double xsml = 0.0;
  double z;

  if ( nam20 == 0 )
  {
    eta = 0.1 * r8_mach ( 3 );
    nam20 = r8_inits ( am20cs, 57, eta );
    nath0 = r8_inits ( ath0cs, 53, eta );
    nam21 = r8_inits ( am21cs, 60, eta );
    nath1 = r8_inits ( ath1cs, 58, eta );
    nam22 = r8_inits ( am22cs, 74, eta );
    nath2 = r8_inits ( ath2cs, 72, eta );
    xsml = - r8_power ( 128.0 / r8_mach ( 3 ), 0.3333 );
  }

  if ( x <= xsml )
  {
    z = 1.0;
    *ampl = 0.3125 + r8_csevl ( z, am20cs, nam20 );
    *theta = - 0.625 + r8_csevl ( z, ath0cs, nath0 );
  }
  else if ( x < - 4.0 )
  {
    z = 128.0 / x / x / x + 1.0;
    *ampl = 0.3125 + r8_csevl ( z, am20cs, nam20 );
    *theta = - 0.625 + r8_csevl ( z, ath0cs, nath0 );
  }
  else if ( x < - 2.0 )
  {
    z = ( 128.0 / x / x / x + 9.0 ) / 7.0;
    *ampl = 0.3125 + r8_csevl ( z, am21cs, nam21 );
    *theta = - 0.625 + r8_csevl ( z, ath1cs, nath1 );
  }
  else if ( x <= - 1.0 )
  {
    z = ( 16.0 / x / x / x + 9.0 ) / 7.0;
    *ampl = 0.3125 + r8_csevl ( z, am22cs, nam22 );
    *theta = - 0.625 + r8_csevl ( z, ath2cs, nath2 );
  }
  else
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R8_AIMP - Fatal error!\n" );
    fprintf ( stderr, "  -1.0 < X.\n" );
    exit ( 1 );
  }

  sqrtx = sqrt ( - x );
  *ampl = sqrt ( *ampl / sqrtx );
  *theta = pi4 - x * sqrtx * *theta;

  return;
}
/******************************************************************************/

double r8_aint ( double x )

/******************************************************************************/
/*
  Purpose:

    R8_AINT truncates an R8 argument to an integer.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    John Burkardt.

  Parameters:

    Input, double X, the argument.

    Output, double R8_AINT, the truncated version of X.
*/
{
  double value;

  if ( x < 0.0E+00 )
  {
    value = - ( double ) ( ( int ) ( fabs ( x ) ) );
  }
  else
  {
    value =   ( double ) ( ( int ) ( fabs ( x ) ) );
  }

  return value;
}
/******************************************************************************/

double r8_asin ( double x )

/******************************************************************************/
/*
  Purpose:

    R8_ASIN evaluates the arc-sine of an R8 argument.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, double X, the argument.

    Output, double R8_ASIN, the arc-sine of X.
*/
{
  static double asincs[39] = {
    +0.10246391753227159336573148305785E+00,
    +0.54946487221245833306011195902924E-01,
    +0.40806303925449692851307056149246E-02,
    +0.40789006854604435455598823905612E-03,
    +0.46985367432203691616048530136218E-04,
    +0.58809758139708058986454385552074E-05,
    +0.77732312462777632750557528163795E-06,
    +0.10677423340082039235047504956587E-06,
    +0.15092399536022808262386434401064E-07,
    +0.21809724080055385496609614713930E-08,
    +0.32075984262789614433261959667376E-09,
    +0.47855369646781034461493133918953E-10,
    +0.72251287362910432263848754537112E-11,
    +0.11018334742255783705372701334987E-11,
    +0.16947632539203354877423745651078E-12,
    +0.26261558667348224162283241502416E-13,
    +0.40958299813281178408828069291110E-14,
    +0.64244793108803655891727944887091E-15,
    +0.10128142198228221693973361222041E-15,
    +0.16039221897380787560050597464746E-16,
    +0.25503501355807141715298789676373E-17,
    +0.40701403797862382855487165672106E-18,
    +0.65172671712881144437889267575466E-19,
    +0.10467453037096796954244891716266E-19,
    +0.16858725563380328094989095185066E-20,
    +0.27221936305040227625164341247999E-21,
    +0.44059293900347550617126830079999E-22,
    +0.71466685243375937853063168000000E-23,
    +0.11615793343859516051798971733333E-23,
    +0.18915234552354685801184187733333E-24,
    +0.30855772044244342399827968000000E-25,
    +0.50416366022162453412970495999999E-26,
    +0.82502725502400865081753600000000E-27,
    +0.13520032631020947208055466666666E-27,
    +0.22184326876541720216644266666666E-28,
    +0.36442494054085079212578133333333E-29,
    +0.59920218558643813307733333333333E-30,
    +0.98584812059573785810261333333333E-31,
    +0.16222501166399014393173333333333E-31 };
  static int nterms = 0;
  const double pi2 = 1.57079632679489661923132169163975;
  static double sqeps = 0.0;
  double value;
  double y;
  double z;

  if ( nterms == 0 )
  {
    nterms = r8_inits ( asincs, 39, 0.1 * r8_mach ( 3 ) );
    sqeps = sqrt ( 6.0 * r8_mach ( 3 ) );
  }

  y = fabs ( x );

  if ( x < - 1.0 - sqeps )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R8_ASIN - Fatal error!\n" );
    fprintf ( stderr, "  X < - 1.0\n" );
    exit ( 1 );
  }
  else if ( x < - 1.0 )
  {
    value = - pi2;
  }
  else if ( x < 1.0 )
  {
    z = 0.0;
    if ( sqeps < y )
    {
      z = y * y;
    }

    if ( z <= 0.5 )
    {
      value = x * ( 1.0 + r8_csevl ( 4.0 * z - 1.0, asincs, nterms ) );
    }
    else
    {
      value = pi2 - sqrt ( 1.0 - z ) * ( 1.0 + 
        r8_csevl ( 3.0 - 4.0 * z, asincs, nterms ) );
    }

    if ( x < 0.0 )
    {
      value = - fabs ( value );
    }
    else if ( 0.0 < x )
    {
      value = + fabs ( value );
    }
  }
  else if ( x < 1.0 + sqeps )
  {
    value = pi2;
  }
  else
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R8_ASIN - Fatal error!\n" );
    fprintf ( stderr, "  1.0 < X\n" );
    exit ( 1 );
  }

  return value;
}
/******************************************************************************/

double r8_asinh ( double x )

/******************************************************************************/
/*
  Purpose:

    R8_ASINH evaluates the arc-sine of an R8 argument.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, double X, the argument.

    Output, double R8_ASINH, the arc-hyperbolic sine of X.
*/
{
  const double aln2 = 0.69314718055994530941723212145818;
  static double asnhcs[39] = {
    -0.12820039911738186343372127359268E+00,
    -0.58811761189951767565211757138362E-01,
    +0.47274654322124815640725249756029E-02,
    -0.49383631626536172101360174790273E-03,
    +0.58506207058557412287494835259321E-04,
    -0.74669983289313681354755069217188E-05,
    +0.10011693583558199265966192015812E-05,
    -0.13903543858708333608616472258886E-06,
    +0.19823169483172793547317360237148E-07,
    -0.28847468417848843612747272800317E-08,
    +0.42672965467159937953457514995907E-09,
    -0.63976084654366357868752632309681E-10,
    +0.96991686089064704147878293131179E-11,
    -0.14844276972043770830246658365696E-11,
    +0.22903737939027447988040184378983E-12,
    -0.35588395132732645159978942651310E-13,
    +0.55639694080056789953374539088554E-14,
    -0.87462509599624678045666593520162E-15,
    +0.13815248844526692155868802298129E-15,
    -0.21916688282900363984955142264149E-16,
    +0.34904658524827565638313923706880E-17,
    -0.55785788400895742439630157032106E-18,
    +0.89445146617134012551050882798933E-19,
    -0.14383426346571317305551845239466E-19,
    +0.23191811872169963036326144682666E-20,
    -0.37487007953314343674570604543999E-21,
    +0.60732109822064279404549242880000E-22,
    -0.98599402764633583177370173440000E-23,
    +0.16039217452788496315232638293333E-23,
    -0.26138847350287686596716134399999E-24,
    +0.42670849606857390833358165333333E-25,
    -0.69770217039185243299730773333333E-26,
    +0.11425088336806858659812693333333E-26,
    -0.18735292078860968933021013333333E-27,
    +0.30763584414464922794065920000000E-28,
    -0.50577364031639824787046399999999E-29,
    +0.83250754712689142224213333333333E-30,
    -0.13718457282501044163925333333333E-30,
    +0.22629868426552784104106666666666E-31 };
  static int nterms = 0;
  static double sqeps = 0.0;
  double value;
  static double xmax = 0.0;
  double y;

  if ( nterms == 0 )
  {
    nterms = r8_inits ( asnhcs, 39, 0.1 * r8_mach ( 3 ) );
    sqeps = sqrt ( r8_mach ( 3 ) );
    xmax = 1.0 / sqeps;
  }

  y = fabs ( x );

  if ( y <= sqeps )
  {
    value = x;
  }
  else if ( y <= 1.0 )
  {
    value = x * ( 1.0 + r8_csevl ( 2.0 * x * x - 1.0, asnhcs, nterms ) );
  }
  else if ( y < xmax )
  {
    value = log ( y + sqrt ( y * y + 1.0 ) );
    if ( x < 0.0 )
    {
      value = - value;
    }
  }
  else
  {
    value = aln2 + log ( y );
    if ( x < 0.0 )
    {
      value = - value;
    }
  }
  return value;
}
/******************************************************************************/

double r8_atan ( double x )

/******************************************************************************/
/*
  Purpose:

    R8_ATAN evaluates the arc-tangent of an R8 argument.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, double X, the argument.

    Output, double R8_ATAN, the arc-tangent of X.
*/
{
  static double atancs[16] = {
    +0.48690110349241406474636915902891E+00,
    -0.65108316367174641818869794945974E-02,
    +0.38345828265245177653569992430456E-04,
    -0.26872212876223146539595410518788E-06,
    +0.20500930985824269846636514686688E-08,
    -0.16450717395484269455734135285348E-10,
    +0.13650975274390773423813528484428E-12,
    -0.11601779591998246322891309834666E-14,
    +0.10038333943866273835797657402666E-16,
    -0.88072747152163859327073696000000E-19,
    +0.78136321005661722180580266666666E-21,
    -0.69954535148267456086613333333333E-23,
    +0.63105905713702136004266666666666E-25,
    -0.57296075370213874346666666666666E-27,
    +0.52274796280602282666666666666666E-29,
    -0.48327903911608320000000000000000E-31 };
  static double conpi8[4] = {
    0.375,
    0.75,
    1.125,
    1.5 };
  int n;
  static int nterms = 0;
  static double pi8[4] = {
    +0.17699081698724154807830422909937E-01,
    +0.35398163397448309615660845819875E-01,
    +0.53097245096172464423491268729813E-01,
    +0.70796326794896619231321691639751E-01 };
  static double sqeps = 0.0;
  double t;
  static double tanp8[3] = {
    +0.41421356237309504880168872420969,
    +1.0,
    +2.4142135623730950488016887242096 };
  double value;
  static double xbig = 0.0;
  const double xbnd1 = +0.19891236737965800691159762264467;
  const double xbnd2 = +0.66817863791929891999775768652308;
  const double xbnd3 = +1.4966057626654890176011351349424;
  const double xbnd4 = +5.0273394921258481045149750710640;
  double y;

  if ( nterms == 0 )
  {
    nterms = r8_inits ( atancs, 16, 0.1 * r8_mach ( 3 ) );
    sqeps = sqrt ( 6.0 * r8_mach ( 3 ) );
    xbig = 1.0 / r8_mach ( 3 );
  }

  y = fabs ( x );

  if ( y <= xbnd1 )
  {
    value = x;
    if ( sqeps < y )
    {
      value = x * ( 0.75 + r8_csevl ( 50.0 * y * y - 1.0, atancs, nterms ) );
    }
  }
  else if ( y <= xbnd4 )
  {
    if ( xbnd3 < y )
    {
      n = 3;
    }
    else if ( xbnd2 < y )
    {
      n = 2;
    }
    else
    {
      n = 1;
    }

    t = ( y - tanp8[n-1] ) / ( 1.0 + y * tanp8[n-1] );

    value = conpi8[n-1] + ( pi8[n-1] + t * ( 0.75 +
      r8_csevl ( 50.0 * t * t - 1.0, atancs, nterms ) ) );
  }
  else
  {
    value = conpi8[3] + pi8[3];

    if ( y < xbig )
    {
      value = conpi8[3] + ( pi8[3] - ( 0.75 +
        r8_csevl ( 50.0 / y / y - 1.0, atancs, nterms ) ) / y );
    }
  }

  if ( x < 0.0 )
  {
    value = - fabs ( value );
  }
  else
  {
    value = + fabs ( value );
  }

  return value;
}
/******************************************************************************/

double r8_atan2 ( double sn, double cs )

/******************************************************************************/
/*
  Purpose:

    R8_ATAN2 evaluates the arc-tangent of two R8 arguments.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, double SN, CS, the Y and X coordinates of a 
    point on the angle.

    Output, double R8_ATAN2, the arc-tangent of the angle.
*/
{
  double abscs;
  double abssn;
  static double big = 0.0;
  const double pi = 3.14159265358979323846264338327950;
  static double sml = 0.0;
  double value;

  if ( sml == 0.0 )
  {
    sml = r8_mach ( 1 );
    big = r8_mach ( 2 );
  }
/*
  We now make sure SN can be divided by CS.  It is painful.
*/
  abssn = fabs ( sn );
  abscs = fabs ( cs );

  if ( abscs <= abssn )
  {
    if ( abscs < 1.0 && abscs * big <= abssn )
    {
      if ( sn < 0.0 )
      {
        value = - 0.5 * pi;
      }
      else if ( sn == 0.0 )
      {
        fprintf ( stderr, "\n" );
        fprintf ( stderr, "R8_ATAN2 - Fatal error!\n" );
        fprintf ( stderr, "  Both arguments are 0.\n" );
        exit ( 1 );
      }
      else
      {
        value = 0.5 * pi;
      }
      return value;
    }
  }
  else
  {
    if ( 1.0 < abscs && abssn <= abscs * sml )
    {
      if ( 0.0 <= cs )
      {
        value = 0.0;
      }
      else
      {
        value = pi;
      }
      return value;
    }
  }
  value = atan ( sn / cs );

  if ( cs < 0.0 )
  {
    value = value + pi;
  }

  if ( pi < value )
  {
    value = value - 2.0 * pi;
  }
  return value;
}
/******************************************************************************/

double r8_atanh ( double x )

/******************************************************************************/
/*
  Purpose:

    R8_ATANH evaluates the arc-hyperbolic tangent of an R8 argument.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, double X, the argument.

    Output, double R8_ATANH, the arc-hyperbolic tangent of X.
*/
{
  static double atnhcs[27] = {
    +0.9439510239319549230842892218633E-01,
    +0.4919843705578615947200034576668E-01,
    +0.2102593522455432763479327331752E-02,
    +0.1073554449776116584640731045276E-03,
    +0.5978267249293031478642787517872E-05,
    +0.3505062030889134845966834886200E-06,
    +0.2126374343765340350896219314431E-07,
    +0.1321694535715527192129801723055E-08,
    +0.8365875501178070364623604052959E-10,
    +0.5370503749311002163881434587772E-11,
    +0.3486659470157107922971245784290E-12,
    +0.2284549509603433015524024119722E-13,
    +0.1508407105944793044874229067558E-14,
    +0.1002418816804109126136995722837E-15,
    +0.6698674738165069539715526882986E-17,
    +0.4497954546494931083083327624533E-18,
    +0.3032954474279453541682367146666E-19,
    +0.2052702064190936826463861418666E-20,
    +0.1393848977053837713193014613333E-21,
    +0.9492580637224576971958954666666E-23,
    +0.6481915448242307604982442666666E-24,
    +0.4436730205723615272632320000000E-25,
    +0.3043465618543161638912000000000E-26,
    +0.2091881298792393474047999999999E-27,
    +0.1440445411234050561365333333333E-28,
    +0.9935374683141640465066666666666E-30,
    +0.6863462444358260053333333333333E-31 };
  static double dxrel = 0.0;
  static int nterms = 0;
  static double sqeps = 0.0;
  double value;
  double y;

  if ( nterms == 0 )
  {
    nterms = r8_inits ( atnhcs, 27, 0.1 * r8_mach ( 3 ) );
    dxrel = sqrt ( r8_mach ( 4 ) );
    sqeps = sqrt ( 3.0 * r8_mach ( 3 ) );
  }

  y = fabs ( x );

  if ( y <= sqeps )
  {
    value = x;
  }
  else if ( y <= 0.5 )
  {
    value = x * ( 1.0 + r8_csevl ( 8.0 * x * x - 1.0, atnhcs, nterms ) );
  }
  else if ( y < 1.0 )
  {
    value = 0.5 * log ( ( 1.0 + x ) / ( 1.0 - x ) );
    if ( 1.0 - y < dxrel )
    {
      fprintf ( stderr, "\n" );
      fprintf ( stderr, "R8_ATANH - Warning:\n" );
      fprintf ( stderr, "  Answer lt half precision because |X| too near 1.\n" );
    }
  }
  else
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R8_ATANH - Fatal error!\n" );
    fprintf ( stderr, "  1 <= |X|.\n" );
    exit ( 1 );
  }
  return value;
}
/******************************************************************************/

void r8_b0mp ( double x, double *ampl, double *theta )

/******************************************************************************/
/*
  Purpose:

    R8_B0MP evaluates the modulus and phase for the Bessel J0 and Y0 functions.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, double X, the argument.

    Output, double *AMPL, *THETA, the modulus and phase.
*/
{
  static double bm0cs[37] = {
    +0.9211656246827742712573767730182E-01,
    -0.1050590997271905102480716371755E-02,
    +0.1470159840768759754056392850952E-04,
    -0.5058557606038554223347929327702E-06,
    +0.2787254538632444176630356137881E-07,
    -0.2062363611780914802618841018973E-08,
    +0.1870214313138879675138172596261E-09,
    -0.1969330971135636200241730777825E-10,
    +0.2325973793999275444012508818052E-11,
    -0.3009520344938250272851224734482E-12,
    +0.4194521333850669181471206768646E-13,
    -0.6219449312188445825973267429564E-14,
    +0.9718260411336068469601765885269E-15,
    -0.1588478585701075207366635966937E-15,
    +0.2700072193671308890086217324458E-16,
    -0.4750092365234008992477504786773E-17,
    +0.8615128162604370873191703746560E-18,
    -0.1605608686956144815745602703359E-18,
    +0.3066513987314482975188539801599E-19,
    -0.5987764223193956430696505617066E-20,
    +0.1192971253748248306489069841066E-20,
    -0.2420969142044805489484682581333E-21,
    +0.4996751760510616453371002879999E-22,
    -0.1047493639351158510095040511999E-22,
    +0.2227786843797468101048183466666E-23,
    -0.4801813239398162862370542933333E-24,
    +0.1047962723470959956476996266666E-24,
    -0.2313858165678615325101260800000E-25,
    +0.5164823088462674211635199999999E-26,
    -0.1164691191850065389525401599999E-26,
    +0.2651788486043319282958336000000E-27,
    -0.6092559503825728497691306666666E-28,
    +0.1411804686144259308038826666666E-28,
    -0.3298094961231737245750613333333E-29,
    +0.7763931143074065031714133333333E-30,
    -0.1841031343661458478421333333333E-30,
    +0.4395880138594310737100799999999E-31 };
  static double bm02cs[40] = {
    +0.9500415145228381369330861335560E-01,
    -0.3801864682365670991748081566851E-03,
    +0.2258339301031481192951829927224E-05,
    -0.3895725802372228764730621412605E-07,
    +0.1246886416512081697930990529725E-08,
    -0.6065949022102503779803835058387E-10,
    +0.4008461651421746991015275971045E-11,
    -0.3350998183398094218467298794574E-12,
    +0.3377119716517417367063264341996E-13,
    -0.3964585901635012700569356295823E-14,
    +0.5286111503883857217387939744735E-15,
    -0.7852519083450852313654640243493E-16,
    +0.1280300573386682201011634073449E-16,
    -0.2263996296391429776287099244884E-17,
    +0.4300496929656790388646410290477E-18,
    -0.8705749805132587079747535451455E-19,
    +0.1865862713962095141181442772050E-19,
    -0.4210482486093065457345086972301E-20,
    +0.9956676964228400991581627417842E-21,
    -0.2457357442805313359605921478547E-21,
    +0.6307692160762031568087353707059E-22,
    -0.1678773691440740142693331172388E-22,
    +0.4620259064673904433770878136087E-23,
    -0.1311782266860308732237693402496E-23,
    +0.3834087564116302827747922440276E-24,
    -0.1151459324077741271072613293576E-24,
    +0.3547210007523338523076971345213E-25,
    -0.1119218385815004646264355942176E-25,
    +0.3611879427629837831698404994257E-26,
    -0.1190687765913333150092641762463E-26,
    +0.4005094059403968131802476449536E-27,
    -0.1373169422452212390595193916017E-27,
    +0.4794199088742531585996491526437E-28,
    -0.1702965627624109584006994476452E-28,
    +0.6149512428936330071503575161324E-29,
    -0.2255766896581828349944300237242E-29,
    +0.8399707509294299486061658353200E-30,
    -0.3172997595562602355567423936152E-30,
    +0.1215205298881298554583333026514E-30,
    -0.4715852749754438693013210568045E-31 };
  static double bt02cs[39] = {
    -0.24548295213424597462050467249324,
    +0.12544121039084615780785331778299E-02,
    -0.31253950414871522854973446709571E-04,
    +0.14709778249940831164453426969314E-05,
    -0.99543488937950033643468850351158E-07,
    +0.85493166733203041247578711397751E-08,
    -0.86989759526554334557985512179192E-09,
    +0.10052099533559791084540101082153E-09,
    -0.12828230601708892903483623685544E-10,
    +0.17731700781805131705655750451023E-11,
    -0.26174574569485577488636284180925E-12,
    +0.40828351389972059621966481221103E-13,
    -0.66751668239742720054606749554261E-14,
    +0.11365761393071629448392469549951E-14,
    -0.20051189620647160250559266412117E-15,
    +0.36497978794766269635720591464106E-16,
    -0.68309637564582303169355843788800E-17,
    +0.13107583145670756620057104267946E-17,
    -0.25723363101850607778757130649599E-18,
    +0.51521657441863959925267780949333E-19,
    -0.10513017563758802637940741461333E-19,
    +0.21820381991194813847301084501333E-20,
    -0.46004701210362160577225905493333E-21,
    +0.98407006925466818520953651199999E-22,
    -0.21334038035728375844735986346666E-22,
    +0.46831036423973365296066286933333E-23,
    -0.10400213691985747236513382399999E-23,
    +0.23349105677301510051777740800000E-24,
    -0.52956825323318615788049749333333E-25,
    +0.12126341952959756829196287999999E-25,
    -0.28018897082289428760275626666666E-26,
    +0.65292678987012873342593706666666E-27,
    -0.15337980061873346427835733333333E-27,
    +0.36305884306364536682359466666666E-28,
    -0.86560755713629122479172266666666E-29,
    +0.20779909972536284571238399999999E-29,
    -0.50211170221417221674325333333333E-30,
    +0.12208360279441714184191999999999E-30,
    -0.29860056267039913454250666666666E-31 };
  static double bth0cs[44] = {
    -0.24901780862128936717709793789967,
    +0.48550299609623749241048615535485E-03,
    -0.54511837345017204950656273563505E-05,
    +0.13558673059405964054377445929903E-06,
    -0.55691398902227626227583218414920E-08,
    +0.32609031824994335304004205719468E-09,
    -0.24918807862461341125237903877993E-10,
    +0.23449377420882520554352413564891E-11,
    -0.26096534444310387762177574766136E-12,
    +0.33353140420097395105869955014923E-13,
    -0.47890000440572684646750770557409E-14,
    +0.75956178436192215972642568545248E-15,
    -0.13131556016891440382773397487633E-15,
    +0.24483618345240857495426820738355E-16,
    -0.48805729810618777683256761918331E-17,
    +0.10327285029786316149223756361204E-17,
    -0.23057633815057217157004744527025E-18,
    +0.54044443001892693993017108483765E-19,
    -0.13240695194366572724155032882385E-19,
    +0.33780795621371970203424792124722E-20,
    -0.89457629157111779003026926292299E-21,
    +0.24519906889219317090899908651405E-21,
    -0.69388422876866318680139933157657E-22,
    +0.20228278714890138392946303337791E-22,
    -0.60628500002335483105794195371764E-23,
    +0.18649748964037635381823788396270E-23,
    -0.58783732384849894560245036530867E-24,
    +0.18958591447999563485531179503513E-24,
    -0.62481979372258858959291620728565E-25,
    +0.21017901684551024686638633529074E-25,
    -0.72084300935209253690813933992446E-26,
    +0.25181363892474240867156405976746E-26,
    -0.89518042258785778806143945953643E-27,
    +0.32357237479762298533256235868587E-27,
    -0.11883010519855353657047144113796E-27,
    +0.44306286907358104820579231941731E-28,
    -0.16761009648834829495792010135681E-28,
    +0.64292946921207466972532393966088E-29,
    -0.24992261166978652421207213682763E-29,
    +0.98399794299521955672828260355318E-30,
    -0.39220375242408016397989131626158E-30,
    +0.15818107030056522138590618845692E-30,
    -0.64525506144890715944344098365426E-31,
    +0.26611111369199356137177018346367E-31 };
  double eta;
  static int nbm0 = 0;
  static int nbm02 = 0;
  static int nbt02 = 0;
  static int nbth0 = 0;
  const double pi4 = 0.785398163397448309615660845819876;
  double z;

  if ( nbm0 == 0 )
  {
    eta = 0.1 * r8_mach ( 3 );
    nbm0 = r8_inits ( bm0cs, 37, eta );
    nbt02 = r8_inits ( bt02cs, 39, eta );
    nbm02 = r8_inits ( bm02cs, 40, eta );
    nbth0 = r8_inits ( bth0cs, 44, eta );
  }

  if ( x < 4.0 )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R8_B0MP - Fatal error!\n" );
    fprintf ( stderr, "  X < 4.\n" );
    exit ( 1 );
  }
  else if ( x <= 8.0 )
  {
    z = ( 128.0 / x / x - 5.0 ) / 3.0;
    *ampl = ( 0.75 + r8_csevl ( z, bm0cs, nbm0 ) ) / sqrt ( x );
    *theta = x - pi4 + r8_csevl ( z, bt02cs, nbt02 ) / x;
  }
  else
  {
    z = 128.0 / x / x - 1.0;
    *ampl = ( 0.75 + r8_csevl ( z, bm02cs, nbm02) ) / sqrt ( x );
    *theta = x - pi4 + r8_csevl ( z, bth0cs, nbth0 ) / x;
  }
  return;
}
/******************************************************************************/

void r8_b1mp ( double x, double *ampl, double *theta )

/******************************************************************************/
/*
  Purpose:

    R8_B1MP evaluates the modulus and phase for the Bessel J1 and Y1 functions.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, double X, the argument.

    Output, double *AMPL, *THETA, the modulus and phase.
*/
{
  static double bm12cs[40] = {
    +0.9807979156233050027272093546937E-01,
    +0.1150961189504685306175483484602E-02,
    -0.4312482164338205409889358097732E-05,
    +0.5951839610088816307813029801832E-07,
    -0.1704844019826909857400701586478E-08,
    +0.7798265413611109508658173827401E-10,
    -0.4958986126766415809491754951865E-11,
    +0.4038432416421141516838202265144E-12,
    -0.3993046163725175445765483846645E-13,
    +0.4619886183118966494313342432775E-14,
    -0.6089208019095383301345472619333E-15,
    +0.8960930916433876482157048041249E-16,
    -0.1449629423942023122916518918925E-16,
    +0.2546463158537776056165149648068E-17,
    -0.4809472874647836444259263718620E-18,
    +0.9687684668292599049087275839124E-19,
    -0.2067213372277966023245038117551E-19,
    +0.4646651559150384731802767809590E-20,
    -0.1094966128848334138241351328339E-20,
    +0.2693892797288682860905707612785E-21,
    -0.6894992910930374477818970026857E-22,
    +0.1830268262752062909890668554740E-22,
    -0.5025064246351916428156113553224E-23,
    +0.1423545194454806039631693634194E-23,
    -0.4152191203616450388068886769801E-24,
    +0.1244609201503979325882330076547E-24,
    -0.3827336370569304299431918661286E-25,
    +0.1205591357815617535374723981835E-25,
    -0.3884536246376488076431859361124E-26,
    +0.1278689528720409721904895283461E-26,
    -0.4295146689447946272061936915912E-27,
    +0.1470689117829070886456802707983E-27,
    -0.5128315665106073128180374017796E-28,
    +0.1819509585471169385481437373286E-28,
    -0.6563031314841980867618635050373E-29,
    +0.2404898976919960653198914875834E-29,
    -0.8945966744690612473234958242979E-30,
    +0.3376085160657231026637148978240E-30,
    -0.1291791454620656360913099916966E-30,
    +0.5008634462958810520684951501254E-31 };
  static double bm1cs[37] = {
    +0.1069845452618063014969985308538,
    +0.3274915039715964900729055143445E-02,
    -0.2987783266831698592030445777938E-04,
    +0.8331237177991974531393222669023E-06,
    -0.4112665690302007304896381725498E-07,
    +0.2855344228789215220719757663161E-08,
    -0.2485408305415623878060026596055E-09,
    +0.2543393338072582442742484397174E-10,
    -0.2941045772822967523489750827909E-11,
    +0.3743392025493903309265056153626E-12,
    -0.5149118293821167218720548243527E-13,
    +0.7552535949865143908034040764199E-14,
    -0.1169409706828846444166290622464E-14,
    +0.1896562449434791571721824605060E-15,
    -0.3201955368693286420664775316394E-16,
    +0.5599548399316204114484169905493E-17,
    -0.1010215894730432443119390444544E-17,
    +0.1873844985727562983302042719573E-18,
    -0.3563537470328580219274301439999E-19,
    +0.6931283819971238330422763519999E-20,
    -0.1376059453406500152251408930133E-20,
    +0.2783430784107080220599779327999E-21,
    -0.5727595364320561689348669439999E-22,
    +0.1197361445918892672535756799999E-22,
    -0.2539928509891871976641440426666E-23,
    +0.5461378289657295973069619199999E-24,
    -0.1189211341773320288986289493333E-24,
    +0.2620150977340081594957824000000E-25,
    -0.5836810774255685901920938666666E-26,
    +0.1313743500080595773423615999999E-26,
    -0.2985814622510380355332778666666E-27,
    +0.6848390471334604937625599999999E-28,
    -0.1584401568222476721192960000000E-28,
    +0.3695641006570938054301013333333E-29,
    -0.8687115921144668243012266666666E-30,
    +0.2057080846158763462929066666666E-30,
    -0.4905225761116225518523733333333E-31 };
  static double bt12cs[39] = {
    +0.73823860128742974662620839792764,
    -0.33361113174483906384470147681189E-02,
    +0.61463454888046964698514899420186E-04,
    -0.24024585161602374264977635469568E-05,
    +0.14663555577509746153210591997204E-06,
    -0.11841917305589180567005147504983E-07,
    +0.11574198963919197052125466303055E-08,
    -0.13001161129439187449366007794571E-09,
    +0.16245391141361731937742166273667E-10,
    -0.22089636821403188752155441770128E-11,
    +0.32180304258553177090474358653778E-12,
    -0.49653147932768480785552021135381E-13,
    +0.80438900432847825985558882639317E-14,
    -0.13589121310161291384694712682282E-14,
    +0.23810504397147214869676529605973E-15,
    -0.43081466363849106724471241420799E-16,
    +0.80202544032771002434993512550400E-17,
    -0.15316310642462311864230027468799E-17,
    +0.29928606352715568924073040554666E-18,
    -0.59709964658085443393815636650666E-19,
    +0.12140289669415185024160852650666E-19,
    -0.25115114696612948901006977706666E-20,
    +0.52790567170328744850738380799999E-21,
    -0.11260509227550498324361161386666E-21,
    +0.24348277359576326659663462400000E-22,
    -0.53317261236931800130038442666666E-23,
    +0.11813615059707121039205990399999E-23,
    -0.26465368283353523514856789333333E-24,
    +0.59903394041361503945577813333333E-25,
    -0.13690854630829503109136383999999E-25,
    +0.31576790154380228326413653333333E-26,
    -0.73457915082084356491400533333333E-27,
    +0.17228081480722747930705920000000E-27,
    -0.40716907961286507941068800000000E-28,
    +0.96934745136779622700373333333333E-29,
    -0.23237636337765716765354666666666E-29,
    +0.56074510673522029406890666666666E-30,
    -0.13616465391539005860522666666666E-30,
    +0.33263109233894654388906666666666E-31 };
  static double bth1cs[44] = {
    +0.74749957203587276055443483969695,
    -0.12400777144651711252545777541384E-02,
    +0.99252442404424527376641497689592E-05,
    -0.20303690737159711052419375375608E-06,
    +0.75359617705690885712184017583629E-08,
    -0.41661612715343550107630023856228E-09,
    +0.30701618070834890481245102091216E-10,
    -0.28178499637605213992324008883924E-11,
    +0.30790696739040295476028146821647E-12,
    -0.38803300262803434112787347554781E-13,
    +0.55096039608630904934561726208562E-14,
    -0.86590060768383779940103398953994E-15,
    +0.14856049141536749003423689060683E-15,
    -0.27519529815904085805371212125009E-16,
    +0.54550796090481089625036223640923E-17,
    -0.11486534501983642749543631027177E-17,
    +0.25535213377973900223199052533522E-18,
    -0.59621490197413450395768287907849E-19,
    +0.14556622902372718620288302005833E-19,
    -0.37022185422450538201579776019593E-20,
    +0.97763074125345357664168434517924E-21,
    -0.26726821639668488468723775393052E-21,
    +0.75453300384983271794038190655764E-22,
    -0.21947899919802744897892383371647E-22,
    +0.65648394623955262178906999817493E-23,
    -0.20155604298370207570784076869519E-23,
    +0.63417768556776143492144667185670E-24,
    -0.20419277885337895634813769955591E-24,
    +0.67191464220720567486658980018551E-25,
    -0.22569079110207573595709003687336E-25,
    +0.77297719892989706370926959871929E-26,
    -0.26967444512294640913211424080920E-26,
    +0.95749344518502698072295521933627E-27,
    -0.34569168448890113000175680827627E-27,
    +0.12681234817398436504211986238374E-27,
    -0.47232536630722639860464993713445E-28,
    +0.17850008478186376177858619796417E-28,
    -0.68404361004510395406215223566746E-29,
    +0.26566028671720419358293422672212E-29,
    -0.10450402527914452917714161484670E-29,
    +0.41618290825377144306861917197064E-30,
    -0.16771639203643714856501347882887E-30,
    +0.68361997776664389173535928028528E-31,
    -0.28172247861233641166739574622810E-31 };
  double eta;
  static int nbm1 = 0;
  static int nbm12 = 0;
  static int nbt12 = 0;
  static int nbth1 = 0;
  const double pi4 = 0.785398163397448309615660845819876;
  double z;

  if ( nbm1 == 0 )
  {
    eta = 0.1 * r8_mach ( 3 );
    nbm1 = r8_inits ( bm1cs, 37, eta );
    nbt12 = r8_inits ( bt12cs, 39, eta );
    nbm12 = r8_inits ( bm12cs, 40, eta );
    nbth1 = r8_inits ( bth1cs, 44, eta );
  }

  if ( x < 4.0 )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R8_B1MP - Fatal error!\n" );
    fprintf ( stderr, "  X < 4.\n" );
    exit ( 1 );
  }
  else if ( x <= 8.0 )
  {
    z = ( 128.0 / x / x - 5.0 ) / 3.0;
    *ampl = ( 0.75 + r8_csevl ( z, bm1cs, nbm1 ) ) / sqrt ( x );
    *theta = x - 3.0 * pi4 + r8_csevl ( z, bt12cs, nbt12 ) / x;
  }
  else
  {
    z = 128.0 / x / x - 1.0;
    *ampl = ( 0.75 + r8_csevl ( z, bm12cs, nbm12 ) ) / sqrt ( x );
    *theta = x - 3.0 * pi4 + r8_csevl ( z, bth1cs, nbth1 ) / x;
  }
  return;
}
/******************************************************************************/

double r8_besi0 ( double x )

/******************************************************************************/
/*
  Purpose:

    R8_BESI0 evaluates the Bessel function I of order 0 of an R8 argument.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, double X, the argument.

    Output, double R8_BESI0, the Bessel function I of order 0 of X.
*/
{
  static double bi0cs[18] = {
    -0.7660547252839144951081894976243285E-01,
    +0.1927337953993808269952408750881196E+01,
    +0.2282644586920301338937029292330415,
    +0.1304891466707290428079334210691888E-01,
    +0.4344270900816487451378682681026107E-03,
    +0.9422657686001934663923171744118766E-05,
    +0.1434006289510691079962091878179957E-06,
    +0.1613849069661749069915419719994611E-08,
    +0.1396650044535669699495092708142522E-10,
    +0.9579451725505445344627523171893333E-13,
    +0.5333981859862502131015107744000000E-15,
    +0.2458716088437470774696785919999999E-17,
    +0.9535680890248770026944341333333333E-20,
    +0.3154382039721427336789333333333333E-22,
    +0.9004564101094637431466666666666666E-25,
    +0.2240647369123670016000000000000000E-27,
    +0.4903034603242837333333333333333333E-30,
    +0.9508172606122666666666666666666666E-33 };
  static int nti0 = 0;
  double value;
  static double xmax = 0.0;
  static double xsml = 0.0;
  double y;

  if ( nti0 == 0 )
  {
    nti0 = r8_inits ( bi0cs, 18, 0.1 * r8_mach ( 3 ) );
    xsml = sqrt ( 8.0 * r8_mach ( 3 ) );
    xmax = log ( r8_mach ( 2 ) );
  }

  y = fabs ( x );

  if ( y <= xsml )
  {
    value = 1.0;
  }
  else if ( y <= 3.0 )
  {
    value = 2.75 + r8_csevl ( y * y / 4.5 - 1.0, bi0cs, nti0 );
  }
  else if ( y <= xmax )
  {
    value = exp ( y ) * r8_besi0e ( x );
  }
  else
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R8_BESI0 - Fatal error!\n" );
    fprintf ( stderr, "  |X| too large.\n" );
    exit ( 1 );
  }
  return value;
}
/******************************************************************************/

double r8_besi0e ( double x )

/******************************************************************************/
/*
  Purpose:

    R8_BESI0E evaluates the exponentially scaled Bessel function I0(X).

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, double X, the argument.

    Output, double R8_BESI0E, the exponentially scaled Bessel 
    function I0(X).
*/
{
  static double ai02cs[69] = {
    +0.5449041101410883160789609622680E-01,
    +0.3369116478255694089897856629799E-02,
    +0.6889758346916823984262639143011E-04,
    +0.2891370520834756482966924023232E-05,
    +0.2048918589469063741827605340931E-06,
    +0.2266668990498178064593277431361E-07,
    +0.3396232025708386345150843969523E-08,
    +0.4940602388224969589104824497835E-09,
    +0.1188914710784643834240845251963E-10,
    -0.3149916527963241364538648629619E-10,
    -0.1321581184044771311875407399267E-10,
    -0.1794178531506806117779435740269E-11,
    +0.7180124451383666233671064293469E-12,
    +0.3852778382742142701140898017776E-12,
    +0.1540086217521409826913258233397E-13,
    -0.4150569347287222086626899720156E-13,
    -0.9554846698828307648702144943125E-14,
    +0.3811680669352622420746055355118E-14,
    +0.1772560133056526383604932666758E-14,
    -0.3425485619677219134619247903282E-15,
    -0.2827623980516583484942055937594E-15,
    +0.3461222867697461093097062508134E-16,
    +0.4465621420296759999010420542843E-16,
    -0.4830504485944182071255254037954E-17,
    -0.7233180487874753954562272409245E-17,
    +0.9921475412173698598880460939810E-18,
    +0.1193650890845982085504399499242E-17,
    -0.2488709837150807235720544916602E-18,
    -0.1938426454160905928984697811326E-18,
    +0.6444656697373443868783019493949E-19,
    +0.2886051596289224326481713830734E-19,
    -0.1601954907174971807061671562007E-19,
    -0.3270815010592314720891935674859E-20,
    +0.3686932283826409181146007239393E-20,
    +0.1268297648030950153013595297109E-22,
    -0.7549825019377273907696366644101E-21,
    +0.1502133571377835349637127890534E-21,
    +0.1265195883509648534932087992483E-21,
    -0.6100998370083680708629408916002E-22,
    -0.1268809629260128264368720959242E-22,
    +0.1661016099890741457840384874905E-22,
    -0.1585194335765885579379705048814E-23,
    -0.3302645405968217800953817667556E-23,
    +0.1313580902839239781740396231174E-23,
    +0.3689040246671156793314256372804E-24,
    -0.4210141910461689149219782472499E-24,
    +0.4791954591082865780631714013730E-25,
    +0.8459470390221821795299717074124E-25,
    -0.4039800940872832493146079371810E-25,
    -0.6434714653650431347301008504695E-26,
    +0.1225743398875665990344647369905E-25,
    -0.2934391316025708923198798211754E-26,
    -0.1961311309194982926203712057289E-26,
    +0.1503520374822193424162299003098E-26,
    -0.9588720515744826552033863882069E-28,
    -0.3483339380817045486394411085114E-27,
    +0.1690903610263043673062449607256E-27,
    +0.1982866538735603043894001157188E-28,
    -0.5317498081491816214575830025284E-28,
    +0.1803306629888392946235014503901E-28,
    +0.6213093341454893175884053112422E-29,
    -0.7692189292772161863200728066730E-29,
    +0.1858252826111702542625560165963E-29,
    +0.1237585142281395724899271545541E-29,
    -0.1102259120409223803217794787792E-29,
    +0.1886287118039704490077874479431E-30,
    +0.2160196872243658913149031414060E-30,
    -0.1605454124919743200584465949655E-30,
    +0.1965352984594290603938848073318E-31 };
  static double ai0cs[46] = {
    +0.7575994494023795942729872037438E-01,
    +0.7591380810823345507292978733204E-02,
    +0.4153131338923750501863197491382E-03,
    +0.1070076463439073073582429702170E-04,
    -0.7901179979212894660750319485730E-05,
    -0.7826143501438752269788989806909E-06,
    +0.2783849942948870806381185389857E-06,
    +0.8252472600612027191966829133198E-08,
    -0.1204463945520199179054960891103E-07,
    +0.1559648598506076443612287527928E-08,
    +0.2292556367103316543477254802857E-09,
    -0.1191622884279064603677774234478E-09,
    +0.1757854916032409830218331247743E-10,
    +0.1128224463218900517144411356824E-11,
    -0.1146848625927298877729633876982E-11,
    +0.2715592054803662872643651921606E-12,
    -0.2415874666562687838442475720281E-13,
    -0.6084469888255125064606099639224E-14,
    +0.3145705077175477293708360267303E-14,
    -0.7172212924871187717962175059176E-15,
    +0.7874493403454103396083909603327E-16,
    +0.1004802753009462402345244571839E-16,
    -0.7566895365350534853428435888810E-17,
    +0.2150380106876119887812051287845E-17,
    -0.3754858341830874429151584452608E-18,
    +0.2354065842226992576900757105322E-19,
    +0.1114667612047928530226373355110E-19,
    -0.5398891884396990378696779322709E-20,
    +0.1439598792240752677042858404522E-20,
    -0.2591916360111093406460818401962E-21,
    +0.2238133183998583907434092298240E-22,
    +0.5250672575364771172772216831999E-23,
    -0.3249904138533230784173432285866E-23,
    +0.9924214103205037927857284710400E-24,
    -0.2164992254244669523146554299733E-24,
    +0.3233609471943594083973332991999E-25,
    -0.1184620207396742489824733866666E-26,
    -0.1281671853950498650548338687999E-26,
    +0.5827015182279390511605568853333E-27,
    -0.1668222326026109719364501503999E-27,
    +0.3625309510541569975700684800000E-28,
    -0.5733627999055713589945958399999E-29,
    +0.3736796722063098229642581333333E-30,
    +0.1602073983156851963365512533333E-30,
    -0.8700424864057229884522495999999E-31,
    +0.2741320937937481145603413333333E-31 };
  static double bi0cs[18] = {
    -0.7660547252839144951081894976243285E-01,
    +0.1927337953993808269952408750881196E+01,
    +0.2282644586920301338937029292330415,
    +0.1304891466707290428079334210691888E-01,
    +0.4344270900816487451378682681026107E-03,
    +0.9422657686001934663923171744118766E-05,
    +0.1434006289510691079962091878179957E-06,
    +0.1613849069661749069915419719994611E-08,
    +0.1396650044535669699495092708142522E-10,
    +0.9579451725505445344627523171893333E-13,
    +0.5333981859862502131015107744000000E-15,
    +0.2458716088437470774696785919999999E-17,
    +0.9535680890248770026944341333333333E-20,
    +0.3154382039721427336789333333333333E-22,
    +0.9004564101094637431466666666666666E-25,
    +0.2240647369123670016000000000000000E-27,
    +0.4903034603242837333333333333333333E-30,
    +0.9508172606122666666666666666666666E-33 };
  double eta;
  static int ntai02 = 0;
  static int ntai0 = 0;
  static int nti0 = 0;
  double value;
  static double xsml = 0.0;
  double y;

  if ( nti0 == 0 )
  {
    eta = 0.1 * r8_mach ( 3 );
    nti0 = r8_inits ( bi0cs, 18, eta );
    ntai0 = r8_inits ( ai0cs, 46, eta );
    ntai02 = r8_inits ( ai02cs, 69, eta );
    xsml = sqrt ( 8.0 * r8_mach ( 3 ) );
  }

  y = fabs ( x );

  if ( y <= xsml )
  {
    value = 1.0;
  }
  else if ( y <= 3.0 )
  {
    value = exp ( - y ) * ( 2.75 
      + r8_csevl ( y * y / 4.5 - 1.0, bi0cs, nti0 ) );
  }
  else if ( y <= 8.0 )
  {
    value = ( 0.375
      + r8_csevl ( ( 48.0 / y - 11.0 ) / 5.0, ai0cs, ntai0 ) ) / sqrt ( y );
  }
  else
  {
    value = ( 0.375 
      + r8_csevl ( 16.0 / y - 1.0, ai02cs, ntai02 ) )  / sqrt ( y );
  }
  return value;
}
/******************************************************************************/

double r8_besi1 ( double x )

/******************************************************************************/
/*
  Purpose:

    R8_BESI1 evaluates the Bessel function I of order 1 of an R8 argument.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, double X, the argument.

    Output, double R8_BESI1, the Bessel function I of order 1 of X.
*/
{
  static double bi1cs[17] = {
    -0.19717132610998597316138503218149E-02,
    +0.40734887667546480608155393652014,
    +0.34838994299959455866245037783787E-01,
    +0.15453945563001236038598401058489E-02,
    +0.41888521098377784129458832004120E-04,
    +0.76490267648362114741959703966069E-06,
    +0.10042493924741178689179808037238E-07,
    +0.99322077919238106481371298054863E-10,
    +0.76638017918447637275200171681349E-12,
    +0.47414189238167394980388091948160E-14,
    +0.24041144040745181799863172032000E-16,
    +0.10171505007093713649121100799999E-18,
    +0.36450935657866949458491733333333E-21,
    +0.11205749502562039344810666666666E-23,
    +0.29875441934468088832000000000000E-26,
    +0.69732310939194709333333333333333E-29,
    +0.14367948220620800000000000000000E-31 };
  static int nti1 = 0;
  double  value;
  static double xmax = 0.0;
  static double xmin = 0.0;
  static double xsml = 0.0;
  double y;

  if ( nti1 == 0 )
  {
    nti1 = r8_inits ( bi1cs, 17, 0.1 * r8_mach ( 3 ) );
    xmin = 2.0 * r8_mach ( 1 );
    xsml = sqrt ( 8.0 * r8_mach ( 3 ) );
    xmax = log ( r8_mach ( 2 ) );
  }

  y = fabs ( x );

  if ( y <= xmin )
  {
    value = 0.0;
  }
  else if ( y <= xsml )
  {
    value = 0.5 * x;
  }
  else if ( y <= 3.0 )
  {
    value = x * ( 0.875 + r8_csevl ( y * y / 4.5 - 1.0, bi1cs, nti1 ) );
  }
  else if ( y <= xmax )
  {
    value = exp ( y ) * r8_besi1e ( x );
  }
  else
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R8_BESI1 - Fatal error!\n" );
    fprintf ( stderr, "  Result overflows.\n" );
    exit ( 1 );
  }
  return value;
}
/******************************************************************************/

double r8_besi1e ( double x )

/******************************************************************************/
/*
  Purpose:

    R8_BESI1E evaluates the exponentially scaled Bessel function I1(X).

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, double X, the argument.

    Output, double R8_BESI1E, the exponentially scaled Bessel 
    function I1(X).
*/
{
  static double ai12cs[69] = {
    +0.2857623501828012047449845948469E-01,
    -0.9761097491361468407765164457302E-02,
    -0.1105889387626237162912569212775E-03,
    -0.3882564808877690393456544776274E-05,
    -0.2512236237870208925294520022121E-06,
    -0.2631468846889519506837052365232E-07,
    -0.3835380385964237022045006787968E-08,
    -0.5589743462196583806868112522229E-09,
    -0.1897495812350541234498925033238E-10,
    +0.3252603583015488238555080679949E-10,
    +0.1412580743661378133163366332846E-10,
    +0.2035628544147089507224526136840E-11,
    -0.7198551776245908512092589890446E-12,
    -0.4083551111092197318228499639691E-12,
    -0.2101541842772664313019845727462E-13,
    +0.4272440016711951354297788336997E-13,
    +0.1042027698412880276417414499948E-13,
    -0.3814403072437007804767072535396E-14,
    -0.1880354775510782448512734533963E-14,
    +0.3308202310920928282731903352405E-15,
    +0.2962628997645950139068546542052E-15,
    -0.3209525921993423958778373532887E-16,
    -0.4650305368489358325571282818979E-16,
    +0.4414348323071707949946113759641E-17,
    +0.7517296310842104805425458080295E-17,
    -0.9314178867326883375684847845157E-18,
    -0.1242193275194890956116784488697E-17,
    +0.2414276719454848469005153902176E-18,
    +0.2026944384053285178971922860692E-18,
    -0.6394267188269097787043919886811E-19,
    -0.3049812452373095896084884503571E-19,
    +0.1612841851651480225134622307691E-19,
    +0.3560913964309925054510270904620E-20,
    -0.3752017947936439079666828003246E-20,
    -0.5787037427074799345951982310741E-22,
    +0.7759997511648161961982369632092E-21,
    -0.1452790897202233394064459874085E-21,
    -0.1318225286739036702121922753374E-21,
    +0.6116654862903070701879991331717E-22,
    +0.1376279762427126427730243383634E-22,
    -0.1690837689959347884919839382306E-22,
    +0.1430596088595433153987201085385E-23,
    +0.3409557828090594020405367729902E-23,
    -0.1309457666270760227845738726424E-23,
    -0.3940706411240257436093521417557E-24,
    +0.4277137426980876580806166797352E-24,
    -0.4424634830982606881900283123029E-25,
    -0.8734113196230714972115309788747E-25,
    +0.4045401335683533392143404142428E-25,
    +0.7067100658094689465651607717806E-26,
    -0.1249463344565105223002864518605E-25,
    +0.2867392244403437032979483391426E-26,
    +0.2044292892504292670281779574210E-26,
    -0.1518636633820462568371346802911E-26,
    +0.8110181098187575886132279107037E-28,
    +0.3580379354773586091127173703270E-27,
    -0.1692929018927902509593057175448E-27,
    -0.2222902499702427639067758527774E-28,
    +0.5424535127145969655048600401128E-28,
    -0.1787068401578018688764912993304E-28,
    -0.6565479068722814938823929437880E-29,
    +0.7807013165061145280922067706839E-29,
    -0.1816595260668979717379333152221E-29,
    -0.1287704952660084820376875598959E-29,
    +0.1114548172988164547413709273694E-29,
    -0.1808343145039336939159368876687E-30,
    -0.2231677718203771952232448228939E-30,
    +0.1619029596080341510617909803614E-30,
    -0.1834079908804941413901308439210E-31 };
  static double ai1cs[46] = {
    -0.2846744181881478674100372468307E-01,
    -0.1922953231443220651044448774979E-01,
    -0.6115185857943788982256249917785E-03,
    -0.2069971253350227708882823777979E-04,
    +0.8585619145810725565536944673138E-05,
    +0.1049498246711590862517453997860E-05,
    -0.2918338918447902202093432326697E-06,
    -0.1559378146631739000160680969077E-07,
    +0.1318012367144944705525302873909E-07,
    -0.1448423418183078317639134467815E-08,
    -0.2908512243993142094825040993010E-09,
    +0.1266388917875382387311159690403E-09,
    -0.1664947772919220670624178398580E-10,
    -0.1666653644609432976095937154999E-11,
    +0.1242602414290768265232168472017E-11,
    -0.2731549379672432397251461428633E-12,
    +0.2023947881645803780700262688981E-13,
    +0.7307950018116883636198698126123E-14,
    -0.3332905634404674943813778617133E-14,
    +0.7175346558512953743542254665670E-15,
    -0.6982530324796256355850629223656E-16,
    -0.1299944201562760760060446080587E-16,
    +0.8120942864242798892054678342860E-17,
    -0.2194016207410736898156266643783E-17,
    +0.3630516170029654848279860932334E-18,
    -0.1695139772439104166306866790399E-19,
    -0.1288184829897907807116882538222E-19,
    +0.5694428604967052780109991073109E-20,
    -0.1459597009090480056545509900287E-20,
    +0.2514546010675717314084691334485E-21,
    -0.1844758883139124818160400029013E-22,
    -0.6339760596227948641928609791999E-23,
    +0.3461441102031011111108146626560E-23,
    -0.1017062335371393547596541023573E-23,
    +0.2149877147090431445962500778666E-24,
    -0.3045252425238676401746206173866E-25,
    +0.5238082144721285982177634986666E-27,
    +0.1443583107089382446416789503999E-26,
    -0.6121302074890042733200670719999E-27,
    +0.1700011117467818418349189802666E-27,
    -0.3596589107984244158535215786666E-28,
    +0.5448178578948418576650513066666E-29,
    -0.2731831789689084989162564266666E-30,
    -0.1858905021708600715771903999999E-30,
    +0.9212682974513933441127765333333E-31,
    -0.2813835155653561106370833066666E-31 };
  static double bi1cs[17] = {
    -0.19717132610998597316138503218149E-02,
    +0.40734887667546480608155393652014,
    +0.34838994299959455866245037783787E-01,
    +0.15453945563001236038598401058489E-02,
    +0.41888521098377784129458832004120E-04,
    +0.76490267648362114741959703966069E-06,
    +0.10042493924741178689179808037238E-07,
    +0.99322077919238106481371298054863E-10,
    +0.76638017918447637275200171681349E-12,
    +0.47414189238167394980388091948160E-14,
    +0.24041144040745181799863172032000E-16,
    +0.10171505007093713649121100799999E-18,
    +0.36450935657866949458491733333333E-21,
    +0.11205749502562039344810666666666E-23,
    +0.29875441934468088832000000000000E-26,
    +0.69732310939194709333333333333333E-29,
    +0.14367948220620800000000000000000E-31 };
  double eta;
  static int ntai1 = 0;
  static int ntai12 = 0;
  static int nti1 = 0;
  double value;
  static double xmin = 0.0;
  static double xsml = 0.0;
  double y;

  if ( nti1 == 0 )
  {
    eta = 0.1 * r8_mach ( 3 );
    nti1 = r8_inits ( bi1cs, 17, eta );
    ntai1 = r8_inits ( ai1cs, 46, eta );
    ntai12 = r8_inits ( ai12cs, 69, eta );
    xmin = 2.0 * r8_mach ( 1 );
    xsml = sqrt ( 8.0 * r8_mach ( 3 ) );
  }

  y = fabs ( x );

  if ( y <= xmin )
  {
    value = 0.0;
  }
  else if ( y <= xsml )
  {
    value = 0.5 * x * exp ( - y );
  }
  else if ( y <= 3.0 )
  {
    value = x * ( 0.875 + r8_csevl ( y * y / 4.5 - 1.0, bi1cs, nti1 ) )
      * exp ( - y );
  }
  else if ( y <= 8.0 )
  {
    value = ( 0.375 + r8_csevl ( ( 48.0 / y - 11.0) / 5.0, 
      ai1cs, ntai1 ) ) / sqrt ( y );
    if ( x < 0.0 )
    {
      value = - value;
    }
  }
  else
  {
    value = ( 0.375 + r8_csevl ( 16.0 / y - 1.0, ai12cs, ntai12 ) ) / sqrt ( y );
    if ( x < 0.0 )
    {
      value = - value;
    }
  }
  return value;
}
/******************************************************************************/

double r8_besj0 ( double x )

/******************************************************************************/
/*
  Purpose:

    R8_BESJ0 evaluates the Bessel function J of order 0 of an R8 argument.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, double X, the argument.

    Output, double R8_BESJ0, the Bessel function J of order 0 of X.
*/
{
  double ampl;
  static double bj0cs[19] = {
    +0.10025416196893913701073127264074,
    -0.66522300776440513177678757831124,
    +0.24898370349828131370460468726680,
    -0.33252723170035769653884341503854E-01,
    +0.23114179304694015462904924117729E-02,
    -0.99112774199508092339048519336549E-04,
    +0.28916708643998808884733903747078E-05,
    -0.61210858663032635057818407481516E-07,
    +0.98386507938567841324768748636415E-09,
    -0.12423551597301765145515897006836E-10,
    +0.12654336302559045797915827210363E-12,
    -0.10619456495287244546914817512959E-14,
    +0.74706210758024567437098915584000E-17,
    -0.44697032274412780547627007999999E-19,
    +0.23024281584337436200523093333333E-21,
    -0.10319144794166698148522666666666E-23,
    +0.40608178274873322700800000000000E-26,
    -0.14143836005240913919999999999999E-28,
    +0.43910905496698880000000000000000E-31 };
  static int ntj0 = 0;
  double theta;
  double value;
  static double xsml = 0.0;
  double y;

  if ( ntj0 == 0 )
  {
    ntj0 = r8_inits ( bj0cs, 19, 0.1 * r8_mach ( 3 ) );
    xsml = sqrt ( 4.0 * r8_mach ( 3 ) );
  }

  y = fabs ( x );

  if ( y <= xsml )
  {
    value = 1.0;
  }
  else if ( y <= 4.0 )
  {
    value = r8_csevl ( 0.125 * y * y - 1.0, bj0cs, ntj0 );
  }
  else
  {
    r8_b0mp ( y, &ampl, &theta );
    value = ampl * cos ( theta );
  }
  return value;
}
/******************************************************************************/

double r8_besj1 ( double x )

/******************************************************************************/
/*
  Purpose:

    R8_BESJ1 evaluates the Bessel function J of order 1 of an R8 argument.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, double X, the argument.

    Output, double R8_BESJ1, the Bessel function J of order 1 of X.
*/
{
  double ampl;
  static double bj1cs[19] = {
    -0.117261415133327865606240574524003,
    -0.253615218307906395623030884554698,
    +0.501270809844695685053656363203743E-01,
    -0.463151480962508191842619728789772E-02,
    +0.247996229415914024539124064592364E-03,
    -0.867894868627882584521246435176416E-05,
    +0.214293917143793691502766250991292E-06,
    -0.393609307918317979229322764073061E-08,
    +0.559118231794688004018248059864032E-10,
    -0.632761640466139302477695274014880E-12,
    +0.584099161085724700326945563268266E-14,
    -0.448253381870125819039135059199999E-16,
    +0.290538449262502466306018688000000E-18,
    -0.161173219784144165412118186666666E-20,
    +0.773947881939274637298346666666666E-23,
    -0.324869378211199841143466666666666E-25,
    +0.120223767722741022720000000000000E-27,
    -0.395201221265134933333333333333333E-30,
    +0.116167808226645333333333333333333E-32 };
  static int ntj1 = 0;
  double theta;
  double value;
  static double xmin = 0.0;
  static double xsml = 0.0;
  double y;

  if ( ntj1 == 0 )
  {
    ntj1 = r8_inits ( bj1cs, 19, 0.1 * r8_mach ( 3 ) );
    xsml = sqrt ( 4.0 * r8_mach ( 3 ) );
    xmin = 2.0 * r8_mach ( 1 );
  }

  y = fabs ( x );

  if ( y <= xmin )
  {
    value = 0.0;
  }
  else if ( y <= xsml )
  {
    value = 0.5 * x;
  }
  else if ( y <= 4.0 )
  {
    value = x * ( 0.25 + r8_csevl ( 0.125 * y * y - 1.0, bj1cs, ntj1 ) );
  }
  else
  {
    r8_b1mp ( y, &ampl, &theta );
    if ( x < 0.0 )
    {
      value = - ampl * cos ( theta );
    }
    else
    {
      value = + ampl * cos ( theta );
    }
  }
  return value;
}
/******************************************************************************/

double r8_besk ( double nu, double x )

/******************************************************************************/
/*
  Purpose:

    R8_BESK evaluates the Bessel function K of order NU of an R8 argument.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    03 November 2012

  Author:

    John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, double NU, the order.

    Input, double X, the argument.

    Output, double R8_BESK, the Bessel function K of order NU at X.
*/
{
  double *bke;
  int nin;
  double value;
  double xnu;

  xnu = nu - ( int ) ( nu );
  nin = ( int ) ( nu ) + 1;
  bke = r8_besks ( xnu, x, nin );

  value = bke[nin-1];

  free ( bke );

  return value;
}
/******************************************************************************/

double r8_besk0 ( double x )

/******************************************************************************/
/*
  Purpose:

    R8_BESK0 evaluates the Bessel function K of order 0 of an R8 argument.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, double X, the argument.

    Output, double R8_BESK0, the Bessel function K of order 0 of X.
*/
{
  static double bk0cs[16] = {
    -0.353273932339027687201140060063153E-01,
    +0.344289899924628486886344927529213,
    +0.359799365153615016265721303687231E-01,
    +0.126461541144692592338479508673447E-02,
    +0.228621210311945178608269830297585E-04,
    +0.253479107902614945730790013428354E-06,
    +0.190451637722020885897214059381366E-08,
    +0.103496952576336245851008317853089E-10,
    +0.425981614279108257652445327170133E-13,
    +0.137446543588075089694238325440000E-15,
    +0.357089652850837359099688597333333E-18,
    +0.763164366011643737667498666666666E-21,
    +0.136542498844078185908053333333333E-23,
    +0.207527526690666808319999999999999E-26,
    +0.271281421807298560000000000000000E-29,
    +0.308259388791466666666666666666666E-32 };
  static int ntk0 = 0;
  double value;
  static double xmax = 0.0;
  static double xsml = 0.0;
  double y;

  if ( ntk0 == 0 )
  {
    ntk0 = r8_inits (bk0cs, 16, 0.1 * r8_mach ( 3 ) );
    xsml = sqrt ( 4.0 * r8_mach ( 3 ) );
    xmax = - log ( r8_mach ( 1 ) );
    xmax = xmax - 0.5 * xmax * log ( xmax ) / ( xmax + 0.5 );
  }

  if ( x <= 0.0 )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R8_BESK0 = Fatal error!\n" );
    fprintf ( stderr, "  X <= 0.\n" );
    exit ( 1 );
  }
  else if ( x <= xsml )
  {
    y = 0.0;
    value = - log ( 0.5 * x ) * r8_besi0 ( x )  
      - 0.25 + r8_csevl ( 0.5 * y - 1.0, bk0cs, ntk0 );
  }
  else if ( x <= 2.0 )
  {
    y = x * x;
    value = - log ( 0.5 * x ) * r8_besi0 ( x )  
      - 0.25 + r8_csevl ( 0.5 * y - 1.0, bk0cs, ntk0 );
  }
  else if ( x <= xmax )
  {
    value = exp ( - x ) * r8_besk0e ( x );
  }
  else
  {
    value = 0.0;
  }
  return value;
}
/******************************************************************************/

double r8_besk0e ( double x )

/******************************************************************************/
/*
  Purpose:

    R8_BESK0E evaluates the exponentially scaled Bessel function K0(X).

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, double X, the argument.

    Output, double R8_BESK0E, the exponentially scaled Bessel 
    function K0(X).
*/
{
  static double ak02cs[33] = {
    -0.1201869826307592239839346212452E-01,
    -0.9174852691025695310652561075713E-02,
    +0.1444550931775005821048843878057E-03,
    -0.4013614175435709728671021077879E-05,
    +0.1567831810852310672590348990333E-06,
    -0.7770110438521737710315799754460E-08,
    +0.4611182576179717882533130529586E-09,
    -0.3158592997860565770526665803309E-10,
    +0.2435018039365041127835887814329E-11,
    -0.2074331387398347897709853373506E-12,
    +0.1925787280589917084742736504693E-13,
    -0.1927554805838956103600347182218E-14,
    +0.2062198029197818278285237869644E-15,
    -0.2341685117579242402603640195071E-16,
    +0.2805902810643042246815178828458E-17,
    -0.3530507631161807945815482463573E-18,
    +0.4645295422935108267424216337066E-19,
    -0.6368625941344266473922053461333E-20,
    +0.9069521310986515567622348800000E-21,
    -0.1337974785423690739845005311999E-21,
    +0.2039836021859952315522088960000E-22,
    -0.3207027481367840500060869973333E-23,
    +0.5189744413662309963626359466666E-24,
    -0.8629501497540572192964607999999E-25,
    +0.1472161183102559855208038400000E-25,
    -0.2573069023867011283812351999999E-26,
    +0.4601774086643516587376640000000E-27,
    -0.8411555324201093737130666666666E-28,
    +0.1569806306635368939301546666666E-28,
    -0.2988226453005757788979199999999E-29,
    +0.5796831375216836520618666666666E-30,
    -0.1145035994347681332155733333333E-30,
    +0.2301266594249682802005333333333E-31 };
  static double ak0cs[38] = {
    -0.7643947903327941424082978270088E-01,
    -0.2235652605699819052023095550791E-01,
    +0.7734181154693858235300618174047E-03,
    -0.4281006688886099464452146435416E-04,
    +0.3081700173862974743650014826660E-05,
    -0.2639367222009664974067448892723E-06,
    +0.2563713036403469206294088265742E-07,
    -0.2742705549900201263857211915244E-08,
    +0.3169429658097499592080832873403E-09,
    -0.3902353286962184141601065717962E-10,
    +0.5068040698188575402050092127286E-11,
    -0.6889574741007870679541713557984E-12,
    +0.9744978497825917691388201336831E-13,
    -0.1427332841884548505389855340122E-13,
    +0.2156412571021463039558062976527E-14,
    -0.3349654255149562772188782058530E-15,
    +0.5335260216952911692145280392601E-16,
    -0.8693669980890753807639622378837E-17,
    +0.1446404347862212227887763442346E-17,
    -0.2452889825500129682404678751573E-18,
    +0.4233754526232171572821706342400E-19,
    -0.7427946526454464195695341294933E-20,
    +0.1323150529392666866277967462400E-20,
    -0.2390587164739649451335981465599E-21,
    +0.4376827585923226140165712554666E-22,
    -0.8113700607345118059339011413333E-23,
    +0.1521819913832172958310378154666E-23,
    -0.2886041941483397770235958613333E-24,
    +0.5530620667054717979992610133333E-25,
    -0.1070377329249898728591633066666E-25,
    +0.2091086893142384300296328533333E-26,
    -0.4121713723646203827410261333333E-27,
    +0.8193483971121307640135680000000E-28,
    -0.1642000275459297726780757333333E-28,
    +0.3316143281480227195890346666666E-29,
    -0.6746863644145295941085866666666E-30,
    +0.1382429146318424677635413333333E-30,
    -0.2851874167359832570811733333333E-31 };
  static double bk0cs[16] = {
    -0.353273932339027687201140060063153E-01,
    +0.344289899924628486886344927529213,
    +0.359799365153615016265721303687231E-01,
    +0.126461541144692592338479508673447E-02,
    +0.228621210311945178608269830297585E-04,
    +0.253479107902614945730790013428354E-06,
    +0.190451637722020885897214059381366E-08,
    +0.103496952576336245851008317853089E-10,
    +0.425981614279108257652445327170133E-13,
    +0.137446543588075089694238325440000E-15,
    +0.357089652850837359099688597333333E-18,
    +0.763164366011643737667498666666666E-21,
    +0.136542498844078185908053333333333E-23,
    +0.207527526690666808319999999999999E-26,
    +0.271281421807298560000000000000000E-29,
    +0.308259388791466666666666666666666E-32 };
  double eta;
  static int ntak0 = 0;
  static int ntak02 = 0;
  static int ntk0 = 0;
  double value;
  static double xsml = 0.0;
  double y;

  if ( ntk0 == 0 )
  {
    eta = 0.1 * r8_mach ( 3 );
    ntk0 = r8_inits ( bk0cs, 16, eta );
    ntak0 = r8_inits ( ak0cs, 38, eta );
    ntak02 = r8_inits ( ak02cs, 33, eta );
    xsml = sqrt ( 4.0 * r8_mach ( 3 ) );
  }

  if ( x <= 0.0 )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R8_BESK0E = Fatal error!\n" );
    fprintf ( stderr, "  X <= 0.\n" );
    exit ( 1 );
  }
  else if ( x <= xsml )
  {
    y = 0.0;
    value = exp ( x ) * ( - log ( 0.5 * x ) * r8_besi0 ( x ) - 0.25 
      + r8_csevl ( 0.5 * y - 1.0, bk0cs, ntk0 ) );
  }
  else if ( x <= 2.0 )
  {
    y = x * x;
    value = exp ( x ) * ( - log ( 0.5 * x ) * r8_besi0 ( x ) - 0.25 
      + r8_csevl ( 0.5 * y - 1.0, bk0cs, ntk0 ) );
  }
  else if ( x <= 8.0 )
  {
    value = ( 1.25 + r8_csevl ( ( 16.0 / x - 5.0 ) / 3.0, ak0cs, 
      ntak0 ) ) / sqrt ( x );
  }
  else
  {
    value = ( 1.25 + r8_csevl ( 16.0 / x - 1.0, ak02cs, ntak02 ) ) / sqrt ( x );
  } 
  return value;
}
/******************************************************************************/

double r8_besk1 ( double x )

/******************************************************************************/
/*
  Purpose:

    R8_BESK1 evaluates the Bessel function K of order 1 of an R8 argument.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, double X, the argument.

    Output, double R8_BESK1, the Bessel function K of order 1 of X.
*/
{
  static double bk1cs[16] = {
    +0.25300227338947770532531120868533E-01,
    -0.35315596077654487566723831691801,
    -0.12261118082265714823479067930042,
    -0.69757238596398643501812920296083E-02,
    -0.17302889575130520630176507368979E-03,
    -0.24334061415659682349600735030164E-05,
    -0.22133876307347258558315252545126E-07,
    -0.14114883926335277610958330212608E-09,
    -0.66669016941993290060853751264373E-12,
    -0.24274498505193659339263196864853E-14,
    -0.70238634793862875971783797120000E-17,
    -0.16543275155100994675491029333333E-19,
    -0.32338347459944491991893333333333E-22,
    -0.53312750529265274999466666666666E-25,
    -0.75130407162157226666666666666666E-28,
    -0.91550857176541866666666666666666E-31 };
  static int ntk1 = 0;
  double value;
  static double xmax = 0.0;
  static double xsml = 0.0;
  double y;

  if ( ntk1 == 0 )
  {
    ntk1 = r8_inits ( bk1cs, 16, 0.1 * r8_mach ( 3 ) );
    xsml = sqrt ( 4.0 * r8_mach ( 3 ) );
    xmax = - log ( r8_mach ( 1 ) );
    xmax = xmax - 0.5 * xmax * log ( xmax ) 
      / ( xmax + 0.5 ) - 0.01;
  }

  if ( x <= 0.0 )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R8_BESK1 = Fatal error!\n" );
    fprintf ( stderr, "  X <= 0.\n" );
    exit ( 1 );
  }
  else if ( x <= xsml )
  {
    y = 0.0;
    value = log ( 0.5 * x ) * r8_besi1 ( x ) + ( 0.75 
      + r8_csevl ( 0.5 * y - 1.0, bk1cs, ntk1 ) ) / x;
  }
  else if ( x <= 2.0 )
  {
    y = x * x;
    value = log ( 0.5 * x ) * r8_besi1 ( x ) + ( 0.75 
      + r8_csevl ( 0.5 * y - 1.0, bk1cs, ntk1 ) ) / x;
  }
  else if ( x <= xmax )
  {
    value = exp ( - x ) * r8_besk1e ( x );
  }
  else
  {
    value = 0.0;
  }
  return value;
}
/******************************************************************************/

double r8_besk1e ( double x )

/******************************************************************************/
/*
  Purpose:

    R8_BESK1E evaluates the exponentially scaled Bessel function K1(X).

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, double X, the argument.

    Output, double R8_BESK1E, the exponentially scaled Bessel 
    function K1(X).
*/
{
  static double ak12cs[33] = {
    +0.6379308343739001036600488534102E-01,
    +0.2832887813049720935835030284708E-01,
    -0.2475370673905250345414545566732E-03,
    +0.5771972451607248820470976625763E-05,
    -0.2068939219536548302745533196552E-06,
    +0.9739983441381804180309213097887E-08,
    -0.5585336140380624984688895511129E-09,
    +0.3732996634046185240221212854731E-10,
    -0.2825051961023225445135065754928E-11,
    +0.2372019002484144173643496955486E-12,
    -0.2176677387991753979268301667938E-13,
    +0.2157914161616032453939562689706E-14,
    -0.2290196930718269275991551338154E-15,
    +0.2582885729823274961919939565226E-16,
    -0.3076752641268463187621098173440E-17,
    +0.3851487721280491597094896844799E-18,
    -0.5044794897641528977117282508800E-19,
    +0.6888673850418544237018292223999E-20,
    -0.9775041541950118303002132480000E-21,
    +0.1437416218523836461001659733333E-21,
    -0.2185059497344347373499733333333E-22,
    +0.3426245621809220631645388800000E-23,
    -0.5531064394246408232501248000000E-24,
    +0.9176601505685995403782826666666E-25,
    -0.1562287203618024911448746666666E-25,
    +0.2725419375484333132349439999999E-26,
    -0.4865674910074827992378026666666E-27,
    +0.8879388552723502587357866666666E-28,
    -0.1654585918039257548936533333333E-28,
    +0.3145111321357848674303999999999E-29,
    -0.6092998312193127612416000000000E-30,
    +0.1202021939369815834623999999999E-30,
    -0.2412930801459408841386666666666E-31 };
  static double ak1cs[38] = {
    +0.27443134069738829695257666227266,
    +0.75719899531993678170892378149290E-01,
    -0.14410515564754061229853116175625E-02,
    +0.66501169551257479394251385477036E-04,
    -0.43699847095201407660580845089167E-05,
    +0.35402774997630526799417139008534E-06,
    -0.33111637792932920208982688245704E-07,
    +0.34459775819010534532311499770992E-08,
    -0.38989323474754271048981937492758E-09,
    +0.47208197504658356400947449339005E-10,
    -0.60478356628753562345373591562890E-11,
    +0.81284948748658747888193837985663E-12,
    -0.11386945747147891428923915951042E-12,
    +0.16540358408462282325972948205090E-13,
    -0.24809025677068848221516010440533E-14,
    +0.38292378907024096948429227299157E-15,
    -0.60647341040012418187768210377386E-16,
    +0.98324256232648616038194004650666E-17,
    -0.16284168738284380035666620115626E-17,
    +0.27501536496752623718284120337066E-18,
    -0.47289666463953250924281069568000E-19,
    +0.82681500028109932722392050346666E-20,
    -0.14681405136624956337193964885333E-20,
    +0.26447639269208245978085894826666E-21,
    -0.48290157564856387897969868800000E-22,
    +0.89293020743610130180656332799999E-23,
    -0.16708397168972517176997751466666E-23,
    +0.31616456034040694931368618666666E-24,
    -0.60462055312274989106506410666666E-25,
    +0.11678798942042732700718421333333E-25,
    -0.22773741582653996232867840000000E-26,
    +0.44811097300773675795305813333333E-27,
    -0.88932884769020194062336000000000E-28,
    +0.17794680018850275131392000000000E-28,
    -0.35884555967329095821994666666666E-29,
    +0.72906290492694257991679999999999E-30,
    -0.14918449845546227073024000000000E-30,
    +0.30736573872934276300799999999999E-31 };
  static double bk1cs[16] = {
    +0.25300227338947770532531120868533E-01,
    -0.35315596077654487566723831691801,
    -0.12261118082265714823479067930042,
    -0.69757238596398643501812920296083E-02,
    -0.17302889575130520630176507368979E-03,
    -0.24334061415659682349600735030164E-05,
    -0.22133876307347258558315252545126E-07,
    -0.14114883926335277610958330212608E-09,
    -0.66669016941993290060853751264373E-12,
    -0.24274498505193659339263196864853E-14,
    -0.70238634793862875971783797120000E-17,
    -0.16543275155100994675491029333333E-19,
    -0.32338347459944491991893333333333E-22,
    -0.53312750529265274999466666666666E-25,
    -0.75130407162157226666666666666666E-28,
    -0.91550857176541866666666666666666E-31 };
  double eta;
  static int ntak1 = 0;
  static int ntak12 = 0;
  static int ntk1 = 0;
  double value;
  static double xsml = 0.0;
  double y;

  if ( ntk1 == 0 )
  {
    eta = 0.1 * r8_mach ( 3 );
    ntk1 = r8_inits ( bk1cs, 16, eta );
    ntak1 = r8_inits ( ak1cs, 38, eta );
    ntak12 = r8_inits ( ak12cs, 33, eta );
    xsml = sqrt ( 4.0 * r8_mach ( 3 ) );
  }

  if ( x <= 0.0 )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R8_BESK1E = Fatal error!\n" );
    fprintf ( stderr, "  X <= 0.\n" );
    exit ( 1 );
  }
  else if ( x <= xsml )
  {
    y = 0.0;
    value = exp ( x ) * ( log ( 0.5 * x ) * r8_besi1 ( x )
      + ( 0.75 + r8_csevl ( 0.5 * y - 1.0, bk1cs, ntk1 ) ) / x );
  }
  else if ( x <= 2.0 )
  {
    y = x * x;
    value = exp ( x ) * ( log ( 0.5 * x ) * r8_besi1 ( x )
      + ( 0.75 + r8_csevl ( 0.5 * y - 1.0, bk1cs, ntk1 ) ) / x );
  }
  else if ( x <= 8.0 )
  {
    value = ( 1.25 
      + r8_csevl ( ( 16.0 / x - 5.0 ) / 3.0, ak1cs, ntak1 ) ) / sqrt ( x );
  }
  else
  {
    value = ( 1.25 +
      r8_csevl ( 16.0 / x - 1.0, ak12cs, ntak12 ) ) / sqrt ( x );
  }
  return value;
}
/******************************************************************************/

double *r8_beskes ( double xnu, double x, int nin )

/******************************************************************************/
/*
  Purpose:

    R8_BESKES: a sequence of exponentially scaled K Bessel functions at X.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    04 November 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, double XNU, ?
    |XNU| < 1.

    Input, double X, the argument.

    Input, int NIN, indicates the number of terms to compute.

    Output, double R8_BESKES(abs(NIN)), the exponentially scaled 
    K Bessel functions.
*/
{
  double *bke;
  double bknu1;
  double direct;
  int i;
  int iswtch;
  int n;
  double v;
  double vincr;

  v = fabs ( xnu );
  n = abs ( nin );

  if ( 1.0 <= v )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R8_BESKES - Fatal error!\n" );
    fprintf ( stderr, "  |XNU| must be less than 1.\n" );
    exit ( 1 );
  }

  if ( x <= 0.0 )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R8_BESKES - Fatal error!\n" );
    fprintf ( stderr, "  X <= 0.\n" );
    exit ( 1 );
  }

  if ( n == 0 )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R8_BESKES - Fatal error!\n" );
    fprintf ( stderr, "  N = 0.\n" );
    exit ( 1 );
  }

  bke = ( double * ) malloc ( abs ( nin ) * sizeof ( double ) );

  r8_knus ( v, x, &bke[0], &bknu1, &iswtch );

  if ( n == 1 )
  {
    return bke;
  }

  if ( nin < 0 )
  {
    vincr = - 1.0;
  }
  else
  {
    vincr = + 1.0;
  }

  if ( xnu < 0.0 )
  {
    direct = - vincr;
  }
  else
  {
    direct = vincr;
  }

  bke[1] = bknu1;

  if ( direct < 0.0 )
  {
    r8_knus ( fabs ( xnu + vincr ), x, &bke[1], &bknu1, &iswtch );
  }

  if ( n == 2 )
  {
    return bke;
  }

  v = xnu;
  for ( i = 3; i <= n; i++ )
  {
    v = v + vincr;
    bke[i-1] = 2.0 * v * bke[i-2] / x + bke[i-3];
  }
  return bke;
}
/******************************************************************************/

double *r8_besks ( double xnu, double x, int nin )

/******************************************************************************/
/*
  Purpose:

    R8_BESKS evaluates a sequence of K Bessel functions at X.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    04 November 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, double XNU, ?
    |XNU| < 1.

    Input, double X, the argument.

    Input, int NIN, indicates the number of terms to compute.

    Output, double R8_BESKS(abs(NIN)), the K Bessel functions.
*/
{
  double *bk;
  double expxi;
  int i;
  int n;
  static double xmax = 0.0;

  if ( xmax == 0.0 )
  {
    xmax = - log ( r8_mach ( 1 ) );
    xmax = xmax + 0.5 * log ( 3.14 * 0.5 / xmax );
  }

  bk = r8_beskes ( xnu, x, nin );

  expxi = exp ( - x );
  n = abs ( nin );

  for ( i = 0; i < n; i++ )
  {
    bk[i] = expxi * bk[i];
  }
  return bk;
}
/******************************************************************************/

double r8_besy0 ( double x )

/******************************************************************************/
/*
  Purpose:

    R8_BESY0 evaluates the Bessel function Y of order 0 of an R8 argument.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, double X, the argument.

    Output, double R8_BESY0, the Bessel function Y of order 0 of X.
*/
{
  const double alnhaf = -0.69314718055994530941723212145818;
  double ampl;
  static double by0cs[19] = {
    -0.1127783939286557321793980546028E-01,
    -0.1283452375604203460480884531838,
    -0.1043788479979424936581762276618,
    +0.2366274918396969540924159264613E-01,
    -0.2090391647700486239196223950342E-02,
    +0.1039754539390572520999246576381E-03,
    -0.3369747162423972096718775345037E-05,
    +0.7729384267670667158521367216371E-07,
    -0.1324976772664259591443476068964E-08,
    +0.1764823261540452792100389363158E-10,
    -0.1881055071580196200602823012069E-12,
    +0.1641865485366149502792237185749E-14,
    -0.1195659438604606085745991006720E-16,
    +0.7377296297440185842494112426666E-19,
    -0.3906843476710437330740906666666E-21,
    +0.1795503664436157949829120000000E-23,
    -0.7229627125448010478933333333333E-26,
    +0.2571727931635168597333333333333E-28,
    -0.8141268814163694933333333333333E-31 };
  static int nty0 = 0;
  double theta;
  const double twodpi = 0.636619772367581343075535053490057;
  double value;
  static double xsml = 0.0;
  double y;

  if ( nty0 == 0 )
  {
    nty0 = r8_inits ( by0cs, 19, 0.1 * r8_mach ( 3 ) );
    xsml = sqrt ( 4.0 * r8_mach ( 3 ) );
  }

  if ( x <= 0.0 )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R8_BESY0 - Fatal error!\n" );
    fprintf ( stderr, "  X <= 0.\n" );
    exit ( 1 );
  }
  else if ( x <= xsml )
  {
    y = 0.0;
    value = twodpi * ( alnhaf + log ( x ) ) * r8_besj0 ( x ) 
      + 0.375 + r8_csevl ( 0.125 * y - 1.0, by0cs, nty0 );
  }
  else if ( x <= 4.0 )
  {
    y = x * x;
    value = twodpi * ( alnhaf + log ( x ) ) * r8_besj0 ( x ) + 0.375 
      + r8_csevl ( 0.125 * y - 1.0, by0cs, nty0 );
  }
  else
  {
    r8_b0mp ( x, &ampl, &theta );
    value = ampl * sin ( theta );
  }
  return value;
}
/******************************************************************************/

double r8_besy1 ( double x )

/******************************************************************************/
/*
  Purpose:

    R8_BESY1 evaluates the Bessel function Y of order 1 of an R8 argument.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, double X, the argument.

    Output, double R8_BESY1, the Bessel function Y of order 1 of X.
*/
{
  double ampl;
  static double by1cs[20] = {
    +0.320804710061190862932352018628015E-01,
    +0.126270789743350044953431725999727E+01,
    +0.649996189992317500097490637314144E-02,
    -0.893616452886050411653144160009712E-01,
    +0.132508812217570954512375510370043E-01,
    -0.897905911964835237753039508298105E-03,
    +0.364736148795830678242287368165349E-04,
    -0.100137438166600055549075523845295E-05,
    +0.199453965739017397031159372421243E-07,
    -0.302306560180338167284799332520743E-09,
    +0.360987815694781196116252914242474E-11,
    -0.348748829728758242414552947409066E-13,
    +0.278387897155917665813507698517333E-15,
    -0.186787096861948768766825352533333E-17,
    +0.106853153391168259757070336000000E-19,
    -0.527472195668448228943872000000000E-22,
    +0.227019940315566414370133333333333E-24,
    -0.859539035394523108693333333333333E-27,
    +0.288540437983379456000000000000000E-29,
    -0.864754113893717333333333333333333E-32 };
  static int nty1 = 0;
  double theta;
  const double twodpi = 0.636619772367581343075535053490057;
  double value;
  static double xmin = 0.0;
  double y;

  if ( nty1 == 0 )
  {
    nty1 = r8_inits ( by1cs, 20, 0.1 * r8_mach ( 3 ) );
    xmin = 1.571 * exp ( fmax ( log ( r8_mach ( 1 ) ), 
      - log ( r8_mach ( 2 ) ) ) + 0.01 );
  }

  if ( x <= 0.0 )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R8_BESY1 - Fatal error!\n" );
    fprintf ( stderr, "  X <= 0.\n" );
    exit ( 1 );
  }
  else if ( x <= xmin )
  {
    y = 0.0;
    value = twodpi * log ( 0.5 * x ) * r8_besj1 ( x ) 
      + ( 0.5 + r8_csevl ( 0.125 * y - 1.0, by1cs, nty1 ) ) / x;
  }
  else if ( x <= 4.0 )
  {
    y = x * x;
    value = twodpi * log ( 0.5 * x ) * r8_besj1 ( x ) 
      + ( 0.5 + r8_csevl ( 0.125 * y - 1.0, by1cs, nty1 ) ) / x;
  }
  else
  {
    r8_b1mp ( x, &ampl, &theta );
    value = ampl * sin ( theta );
  }
  return value;
}
/******************************************************************************/

double r8_beta ( double a, double b )

/******************************************************************************/
/*
  Purpose:

    R8_BETA evaluates the beta function of R8 arguments.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, double A, B, the arguments.

    Output, double R8_BETA, the beta function of A and B.
*/
{
  double value;
  static double xmax = 0.0;
  double xmin;

  if ( xmax == 0.0 )
  {
    r8_gaml ( &xmin, &xmax );
  }

  if ( a <= 0.0 || b <= 0.0 )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R8_BETA - Fatal error!\n" );
    fprintf ( stderr, "  A and B must be greater than 0.\n" );
    exit ( 1 );
  }

  if ( a + b < xmax )
  {
    value = r8_gamma ( a ) * r8_gamma ( b ) / r8_gamma ( a + b );
    return value;
  }

  value = r8_lbeta ( a, b );

  value = exp ( value );

  return value;
}
/******************************************************************************/

double r8_betai ( double x, double pin, double qin )

/******************************************************************************/
/*
  Purpose:

    R8_BETAI evaluates the incomplete beta ratio of R8 arguments.

  Discussion:

    The incomplete Beta function ratio is the probability that a
    random variable from a beta distribution having parameters
    P and Q will be less than or equal to X.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Nancy Bosten, EL Battiste,
    Remark on Algorithm 179: 
    Incomplete Beta Ratio,
    Communications of the ACM,
    Volume 17, Number 3, March 1974, pages 156-157.

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, double X, the upper limit of integration.
    0.0 <= X <= 1.0.

    Input, double PIN, the first distribution parameter.
    0.0 < PIN.

    Input, double QIN, the second distribution parameter.
    0.0 < QIN.

    Output, double R8_BETAI, the incomplete beta function ratio.
*/
{
  static double alneps = 0.0;
  static double alnsml = 0.0;
  double c;
  static double eps = 0.0;
  double finsum;
  int i;
  int ib;
  int n;
  double p;
  double p1;
  double ps;
  double q;
  static double sml = 0.0;
  double term;
  double value;
  double xb;
  double xi;
  double y;

  if ( eps == 0.0 )
  {
    eps = r8_mach ( 3 );
    alneps = log ( eps );
    sml = r8_mach ( 1 );
    alnsml = log ( sml );
  }

  if ( x < 0.0 || 1.0 < x )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R8_BETAI - Fatal error!\n" );
    fprintf ( stderr, "  0 <= X <= 1 is required.\n" );
    exit ( 1 );
  }

  if ( pin <= 0.0 || qin <= 0.0 )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R8_BETAI - Fatal error!\n" );
    fprintf ( stderr, "  P or Q <= 0.0.\n" );
    exit ( 1 );
  }

  y = x;
  p = pin;
  q = qin;

  if ( p < q || 0.8 <= x )
  {
    if ( 0.2 <= x )
    {
      y = 1.0 - y;
      p = qin;
      q = pin;
    }
  }

  if ( ( p + q ) * y / ( p + 1.0 ) < eps )
  {
    value = 0.0;
    xb = p * log ( fmax ( y, sml ) ) - log ( p ) - r8_lbeta ( p, q );
    if ( alnsml < xb && y != 0.0 )
    {
      value = exp ( xb );
    }
    if ( y != x || p != pin )
    {
      value = 1.0 - value;
    }
    return value;
  }

  ps = q - r8_aint ( q );
  if ( ps == 0.0 )
  {
    ps = 1.0;
  }

  xb = p * log ( y ) - r8_lbeta ( ps, p ) - log ( p );

  if ( xb < alnsml )
  {
    value = 0.0;
  }
  else
  {
    value = exp ( xb );
    term = value * p;
    if ( ps != 1.0 )
    {
      n = ( int ) ( fmax ( alneps / log ( y ), 4.0 ) );
      for ( i = 1; i <= n; i++ )
      {
        xi = ( double ) ( i );
        term = term * ( xi - ps ) * y / xi;
        value = value + term / ( p + xi );
      }
    }
  }

  if ( 1.0 < q )
  {
    xb = p * log ( y ) + q * log ( 1.0 - y ) 
      - r8_lbeta ( p, q ) - log ( q );
    ib = ( int ) ( fmax ( xb / alnsml, 0.0 ) );
    term = exp ( xb - ( double ) ( ib ) * alnsml );
    c = 1.0 / ( 1.0 - y );
    p1 = q * c / ( p + q - 1.0 );

    finsum = 0.0;
    n = ( int ) ( q );
    if ( q == ( double ) ( n ) )
    {
      n = n - 1;
    }

    for ( i = 1; i <= n; i++ )
    {
      if ( p1 <= 1.0 && term / eps <= finsum )
      {
        break;
      }

      xi = ( double ) ( i );
      term = ( q - xi + 1.0 ) * c * term / ( p + q - xi );

      if ( 1.0 < term )
      {
        ib = ib - 1;
        term = term * sml;
      }

      if ( ib == 0 )
      {
        finsum = finsum + term;
      }
    }
    value = value + finsum;
  }

  if ( y != x || p != pin )
  {
    value = 1.0 - value;
  }

  if ( value < 0.0 )
  {
    value =  0.0;
  }

  if ( 1.0 < value )
  {
    value = 1.0;
  }
  return value;
}
/******************************************************************************/

double r8_bi ( double x )

/******************************************************************************/
/*
  Purpose:

    R8_BI evaluates the Airy function Bi of an R8 argument.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, double X, the argument.

    Output, double R8_BI, the Airy function Bi of X.
*/
{
  static double bifcs[13] = {
    -0.16730216471986649483537423928176E-01,
    +0.10252335834249445611426362777757,
    +0.17083092507381516539429650242013E-02,
    +0.11862545467744681179216459210040E-04,
    +0.44932907017792133694531887927242E-07,
    +0.10698207143387889067567767663628E-09,
    +0.17480643399771824706010517628573E-12,
    +0.20810231071761711025881891834399E-15,
    +0.18849814695665416509927971733333E-18,
    +0.13425779173097804625882666666666E-21,
    +0.77159593429658887893333333333333E-25,
    +0.36533879617478566399999999999999E-28,
    +0.14497565927953066666666666666666E-31 };
  static double bif2cs[15] = {
    +0.0998457269381604104468284257993,
    +0.47862497786300553772211467318231,
    +0.25155211960433011771324415436675E-01,
    +0.58206938852326456396515697872216E-03,
    +0.74997659644377865943861457378217E-05,
    +0.61346028703493836681403010356474E-07,
    +0.34627538851480632900434268733359E-09,
    +0.14288910080270254287770846748931E-11,
    +0.44962704298334641895056472179200E-14,
    +0.11142323065833011708428300106666E-16,
    +0.22304791066175002081517866666666E-19,
    +0.36815778736393142842922666666666E-22,
    +0.50960868449338261333333333333333E-25,
    +0.60003386926288554666666666666666E-28,
    +0.60827497446570666666666666666666E-31 };
  static double bigcs[13] = {
    +0.22466223248574522283468220139024E-01,
    +0.37364775453019545441727561666752E-01,
    +0.44476218957212285696215294326639E-03,
    +0.24708075636329384245494591948882E-05,
    +0.79191353395149635134862426285596E-08,
    +0.16498079851827779880887872402706E-10,
    +0.24119906664835455909247501122841E-13,
    +0.26103736236091436985184781269333E-16,
    +0.21753082977160323853123792000000E-19,
    +0.14386946400390433219483733333333E-22,
    +0.77349125612083468629333333333333E-26,
    +0.34469292033849002666666666666666E-29,
    +0.12938919273216000000000000000000E-32 };
  static double big2cs[15] = {
    +0.033305662145514340465176188111647,
    +0.161309215123197067613287532084943,
    +0.631900730961342869121615634921173E-02,
    +0.118790456816251736389780192304567E-03,
    +0.130453458862002656147116485012843E-05,
    +0.937412599553521729546809615508936E-08,
    +0.474580188674725153788510169834595E-10,
    +0.178310726509481399800065667560946E-12,
    +0.516759192784958180374276356640000E-15,
    +0.119004508386827125129496251733333E-17,
    +0.222982880666403517277063466666666E-20,
    +0.346551923027689419722666666666666E-23,
    +0.453926336320504514133333333333333E-26,
    +0.507884996513522346666666666666666E-29,
    +0.491020674696533333333333333333333E-32 };
  double eta;
  static int nbif = 0;
  static int nbif2 = 0;
  static int nbig = 0;
  static int nbig2 = 0;
  double theta;
  double value;
  static double x3sml = 0.0;
  double xm;
  double z;

  if ( nbif == 0 )
  {
    eta = 0.1 * r8_mach ( 3 );
    nbif = r8_inits ( bifcs, 13, eta );
    nbig = r8_inits ( bigcs, 13, eta );
    nbif2 = r8_inits ( bif2cs, 15, eta );
    nbig2 = r8_inits ( big2cs, 15, eta );
    x3sml = r8_power ( eta, 0.3333 );
  }

  if ( x < - 1.0 )
  {
    r8_aimp ( x, &xm, &theta );
    value = xm * sin ( theta );
  }
  else if ( fabs ( x ) <= x3sml )
  {
    z = 0.0;
    value = 0.625 + r8_csevl ( z, bifcs, nbif ) 
      + x * ( 0.4375 + r8_csevl ( z, bigcs, nbig ) );
  }
  else if ( x <= 1.0 )
  {
    z = x * x * x;
    value = 0.625 + r8_csevl ( z, bifcs, nbif ) 
      + x * ( 0.4375 + r8_csevl ( z, bigcs, nbig ) );
  }
  else if ( x <= 2.0 )
  {
    z = ( 2.0 * x * x * x - 9.0 ) / 7.0;
    value = 1.125 + r8_csevl ( z, bif2cs, nbif2 ) 
      + x * ( 0.625 + r8_csevl ( z, big2cs, nbig2 ) );
  }
  else
  {
    value = r8_bie ( x ) * exp ( 2.0 * x * sqrt ( x ) / 3.0 );
  }
  return value;
}
/******************************************************************************/

double r8_bid ( double x )

/******************************************************************************/
/*
  Purpose:

    R8_BID evaluates the derivative of the Airy function Bi of an R8 argument.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, double X, the argument.

    Output, double R8_BID, the derivative of the Airy function Bi of X.
*/
{
  static double bif2cs[15] = {
     0.32349398760352203352119193596266015,
     0.08629787153556355913888835323811100,
     0.00299402555265539742613821050727155,
     0.00005143052836466163720464316950821,
     0.00000052584025003681146026033098613,
     0.00000000356175137395770028102730600,
     0.00000000001714686400714584830518308,
     0.00000000000006166351969232555406693,
     0.00000000000000017191082154315985806,
     0.00000000000000000038236889518803943,
     0.00000000000000000000069424173624884,
     0.00000000000000000000000104833932510,
     0.00000000000000000000000000133721972,
     0.00000000000000000000000000000145986,
      0.00000000000000000000000000000000138 };
  static double bifcs[13] = {
     0.115353679082857024267474446284908879,
     0.020500789404919287530357789445940252,
     0.000213529027890287581892679619451158,
     0.000001078396061467683042209155523569,
     0.000000003209470883320666783353670420,
     0.000000000006293040671833540390213316,
     0.000000000000008740304300063083340121,
     0.000000000000000009047915683496049529,
     0.000000000000000000007249923164709251,
     0.000000000000000000000004629576649604,
     0.000000000000000000000000002411236436,
     0.000000000000000000000000000001043825,
     0.000000000000000000000000000000000382 };
  static double big2cs[16] = {
     1.606299946362129457759284537862622883,
     0.744908881987608865201476685194753972,
     0.047013873861027737964095177635353019,
     0.001228442206254823907016188785848091,
     0.000017322241225662362670987355613727,
     0.000000152190165236801893711508366563,
     0.000000000911356024911957704145528786,
     0.000000000003954791842356644201722554,
     0.000000000000013001737033862320007309,
     0.000000000000000033493506858269079763,
     0.000000000000000000069419094403694057,
     0.000000000000000000000118248256604581,
     0.000000000000000000000000168462493472,
     0.000000000000000000000000000203684674,
     0.000000000000000000000000000000211619,
     0.000000000000000000000000000000000191 };
  static double bigcs[13] = {
    -0.0971964404164435373897790974606802,
     0.1495035768431670665710843445326264,
     0.0031135253871213260419419176839631,
     0.0000247085705798212967777021920569,
     0.0000001029496277313786081987324295,
     0.0000000002639703739869432892676778,
     0.0000000000004582792707803206608181,
     0.0000000000000005742829740893447321,
     0.0000000000000000005438275385238549,
     0.0000000000000000000004028347267083,
     0.0000000000000000000000002397823826,
     0.0000000000000000000000000001171956,
     0.0000000000000000000000000000000479 };
  double eta;
  static int nbif = 0;
  static int nbif2 = 0;
  static int nbig = 0;
  static int nbig2 = 0;
  double phi;
  double value;
  double x2;
  static double x2sml = 0.0;
  double x3;
  static double x3sml = 0.0;
  double xn;
  double z;

  if ( nbif == 0 )
  {
    eta = 0.1 * r8_mach ( 3 );
    nbif = r8_inits ( bifcs, 13, eta );
    nbig = r8_inits ( bigcs, 13, eta );
    nbif2 = r8_inits ( bif2cs, 15, eta );
    nbig2 = r8_inits ( big2cs, 16, eta );
    x2sml = sqrt ( eta );
    x3sml = r8_power ( eta, 0.3333 );
  }

  if ( x < - 1.0 )
  {
    r8_admp ( x, &xn, &phi );
    value = xn * sin ( phi );
  }
  else if ( fabs ( x ) <= x2sml )
  {
    x2 = 0.0;
    x3 = 0.0;
    value = x2 * ( r8_csevl ( x3, bifcs, nbif ) + 0.25 ) 
      + r8_csevl ( x3, bigcs, nbig ) + 0.5;
  }
  else if ( fabs ( x ) <= x3sml )
  {
    x2 = x * x;
    x3 = 0.0;
    value = x2 * ( r8_csevl ( x3, bifcs, nbif ) + 0.25 ) 
      + r8_csevl ( x3, bigcs, nbig ) + 0.5;
  }
  else if ( x <= 1.0 )
  {
    x2 = x * x;
    x3 = x * x * x;
    value = x2 * ( r8_csevl ( x3, bifcs, nbif ) + 0.25 ) 
      + r8_csevl ( x3, bigcs, nbig ) + 0.5;
  }
  else if ( x <= 2.0 )
  {
    z = ( 2.0 * x * x * x - 9.0 ) / 7.0;
    value = x * x * ( r8_csevl ( z, bif2cs, nbif2 ) + 0.25 ) 
      + r8_csevl ( z, big2cs, nbig2 ) + 0.5;
  }
  else
  {
    value = r8_bide ( x ) * exp ( 2.0 * x * sqrt ( x ) / 3.0 );
  }
  return value;
}
/******************************************************************************/

double r8_bide ( double x )

/******************************************************************************/
/*
  Purpose:

    R8_BIDE: exponentially scaled derivative, Airy function Bi of an R8 argument.

  Discussion:

    if X < 0,
      R8_BIDE ( X ) = R8_BID ( X )
    else
      R8_BIDE ( X ) = R8_BID ( X ) * exp ( - 2/3 * X^(3/2) )

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, double X, the argument.

    Output, double R8_BIDE, the exponentially scaled derivative of 
    the Airy function Bi of X.
*/
{
  const double atr = 8.75069057084843450880771988210148;
  static double bif2cs[15] = {
     0.32349398760352203352119193596266015,
     0.08629787153556355913888835323811100,
     0.00299402555265539742613821050727155,
     0.00005143052836466163720464316950821,
     0.00000052584025003681146026033098613,
     0.00000000356175137395770028102730600,
     0.00000000001714686400714584830518308,
     0.00000000000006166351969232555406693,
     0.00000000000000017191082154315985806,
     0.00000000000000000038236889518803943,
     0.00000000000000000000069424173624884,
     0.00000000000000000000000104833932510,
     0.00000000000000000000000000133721972,
     0.00000000000000000000000000000145986,
     0.00000000000000000000000000000000138 };
  static double bifcs[13] = {
     0.115353679082857024267474446284908879,
     0.020500789404919287530357789445940252,
     0.000213529027890287581892679619451158,
     0.000001078396061467683042209155523569,
     0.000000003209470883320666783353670420,
     0.000000000006293040671833540390213316,
     0.000000000000008740304300063083340121,
     0.000000000000000009047915683496049529,
     0.000000000000000000007249923164709251,
     0.000000000000000000000004629576649604,
     0.000000000000000000000000002411236436,
     0.000000000000000000000000000001043825,
     0.000000000000000000000000000000000382 };
  static double big2cs[16] = {
     1.606299946362129457759284537862622883,
     0.744908881987608865201476685194753972,
     0.047013873861027737964095177635353019,
     0.001228442206254823907016188785848091,
     0.000017322241225662362670987355613727,
     0.000000152190165236801893711508366563,
     0.000000000911356024911957704145528786,
     0.000000000003954791842356644201722554,
     0.000000000000013001737033862320007309,
     0.000000000000000033493506858269079763,
     0.000000000000000000069419094403694057,
     0.000000000000000000000118248256604581,
     0.000000000000000000000000168462493472,
     0.000000000000000000000000000203684674,
     0.000000000000000000000000000000211619,
     0.000000000000000000000000000000000191 };
  static double bigcs[13] = {
    -0.0971964404164435373897790974606802,
     0.1495035768431670665710843445326264,
     0.0031135253871213260419419176839631,
     0.0000247085705798212967777021920569,
     0.0000001029496277313786081987324295,
     0.0000000002639703739869432892676778,
     0.0000000000004582792707803206608181,
     0.0000000000000005742829740893447321,
     0.0000000000000000005438275385238549,
     0.0000000000000000000004028347267083,
     0.0000000000000000000000002397823826,
     0.0000000000000000000000000001171956,
     0.0000000000000000000000000000000479 };
  static double bip1cs[47] = {
    -0.17291873510795537186124679823741003,
    -0.01493584929846943639486231021818675,
    -0.00054711049516785663990658697874460,
     0.00015379662929584083449573727856666,
     0.00001543534761921794131028948022869,
    -0.00000654341138519060129226087106765,
     0.00000037280824078787032232152275240,
     0.00000020720783881887480080810710514,
    -0.00000006581733364696191689495883922,
     0.00000000749267463539288212986048985,
     0.00000000111013368840707147698890101,
    -0.00000000072651405529159512323880794,
     0.00000000017827235598470153962165668,
    -0.00000000002173463524809506269656807,
    -0.00000000000203020349653882594017049,
     0.00000000000193118272294077519319859,
    -0.00000000000060449525048290296023117,
     0.00000000000012094496248933664277802,
    -0.00000000000001251088360074479784619,
    -0.00000000000000199173832424881344036,
     0.00000000000000151540816342864303038,
    -0.00000000000000049768927059816240250,
     0.00000000000000011545959731810501403,
    -0.00000000000000001863286862907983871,
     0.00000000000000000099330392344759104,
     0.00000000000000000068182083667412417,
    -0.00000000000000000034854456479650551,
     0.00000000000000000010860382134235961,
    -0.00000000000000000002599290185240166,
     0.00000000000000000000476895370459000,
    -0.00000000000000000000051946940777177,
    -0.00000000000000000000005925575044912,
     0.00000000000000000000005746008970972,
    -0.00000000000000000000002186119806494,
     0.00000000000000000000000624124294738,
    -0.00000000000000000000000146003421785,
     0.00000000000000000000000027493893904,
    -0.00000000000000000000000003474678018,
    -0.00000000000000000000000000109303694,
     0.00000000000000000000000000261972744,
    -0.00000000000000000000000000112365018,
     0.00000000000000000000000000035152059,
    -0.00000000000000000000000000009167601,
     0.00000000000000000000000000002040203,
    -0.00000000000000000000000000000373038,
     0.00000000000000000000000000000046070,
     0.00000000000000000000000000000001748 };
  static double bip2cs[88] = {
    -0.13269705443526630494937031210217135,
    -0.00568443626045977481306046339037428,
    -0.00015643601119611609623698471216660,
    -0.00001136737203679562267336053207940,
    -0.00000143464350991283669643136951338,
    -0.00000018098531185164131868746481700,
     0.00000000926177343610865546229511422,
     0.00000001710005490720592181887296162,
     0.00000000476698163503781708252686849,
    -0.00000000035195022023163141945397159,
    -0.00000000058890614315886871574147635,
    -0.00000000006678499607795537597612089,
     0.00000000006395565101720391190697713,
     0.00000000001554529427064394106403245,
    -0.00000000000792396999744612971684001,
    -0.00000000000258326242689717798947525,
     0.00000000000121655047787849117978773,
     0.00000000000038707207172899985942258,
    -0.00000000000022487045479618229130656,
    -0.00000000000004953476515684046293493,
     0.00000000000004563781601526912756017,
     0.00000000000000332998314345014118494,
    -0.00000000000000921750185832874202719,
     0.00000000000000094156670658958205765,
     0.00000000000000167153952640716157721,
    -0.00000000000000055134268782182410852,
    -0.00000000000000022368651572006617795,
     0.00000000000000017486948976520089209,
     0.00000000000000000206518666352329750,
    -0.00000000000000003973060018130712479,
     0.00000000000000001154836935724892335,
     0.00000000000000000553906053678276421,
    -0.00000000000000000457174427396478267,
     0.00000000000000000026567111858284432,
     0.00000000000000000101599148154167823,
    -0.00000000000000000044821231272196246,
    -0.00000000000000000007959149661617295,
     0.00000000000000000014583615616165794,
    -0.00000000000000000004015127893061405,
    -0.00000000000000000002079152963743616,
     0.00000000000000000001972630449634388,
    -0.00000000000000000000336033404001683,
    -0.00000000000000000000376504832685507,
     0.00000000000000000000269935508825595,
    -0.00000000000000000000026985946069808,
    -0.00000000000000000000061794011788222,
     0.00000000000000000000038782693311711,
    -0.00000000000000000000002420094005071,
    -0.00000000000000000000009844051058925,
     0.00000000000000000000005954353358494,
    -0.00000000000000000000000361274446366,
    -0.00000000000000000000001552634578088,
     0.00000000000000000000000977819380304,
    -0.00000000000000000000000092239447509,
    -0.00000000000000000000000241545903934,
     0.00000000000000000000000169558652255,
    -0.00000000000000000000000026762408641,
    -0.00000000000000000000000036188116265,
     0.00000000000000000000000030372404951,
    -0.00000000000000000000000007422876903,
    -0.00000000000000000000000004930678544,
     0.00000000000000000000000005468790028,
    -0.00000000000000000000000001920315188,
    -0.00000000000000000000000000516335154,
     0.00000000000000000000000000957723167,
    -0.00000000000000000000000000463659079,
    -0.00000000000000000000000000004509226,
     0.00000000000000000000000000155617519,
    -0.00000000000000000000000000104156509,
     0.00000000000000000000000000019565323,
     0.00000000000000000000000000021335380,
    -0.00000000000000000000000000021461958,
     0.00000000000000000000000000007875791,
     0.00000000000000000000000000001713768,
    -0.00000000000000000000000000003917137,
     0.00000000000000000000000000002233559,
    -0.00000000000000000000000000000269383,
    -0.00000000000000000000000000000577764,
     0.00000000000000000000000000000519650,
    -0.00000000000000000000000000000183361,
    -0.00000000000000000000000000000045763,
     0.00000000000000000000000000000099235,
    -0.00000000000000000000000000000058938,
     0.00000000000000000000000000000009568,
     0.00000000000000000000000000000013758,
    -0.00000000000000000000000000000014066,
     0.00000000000000000000000000000005964,
     0.00000000000000000000000000000000437 };
  const double btr = -2.09383632135605431360096498526268;
  double eta;
  static int nbif = 0;
  static int nbif2 = 0;
  static int nbig = 0;
  static int nbig2 = 0;
  static int nbip1 = 0;
  static int nbip2 = 0;
  double phi;
  double sqrtx;
  double value;
  double x2;
  static double x2sml = 0.0;
  double x3;
  static double x3sml = 0.0;
  static double x32sml = 0.0;
  static double xbig = 0.0;
  double xn;
  double z;

  if ( nbif == 0 )
  {
    eta = 0.1 * r8_mach ( 3 );
    nbif = r8_inits ( bifcs, 13, eta );
    nbig = r8_inits ( bigcs, 13, eta );
    nbif2 = r8_inits ( bif2cs, 15, eta );
    nbig2 = r8_inits ( big2cs, 16, eta );
    nbip1 = r8_inits ( bip1cs, 47, eta );
    nbip2 = r8_inits ( bip2cs, 88, eta );
    x2sml = sqrt ( eta );
    x3sml = r8_power ( eta, 0.3333 );
    x32sml = 1.3104 * x3sml * x3sml;
    xbig = r8_power ( r8_mach ( 2 ), 0.6666 );
  }

  if ( x < -1.0 )
  {
    r8_admp ( x, &xn, &phi );
    value = xn * sin ( phi );
  }
  else if ( fabs ( x ) <= x2sml )
  {
    x2 = 0.0;
    x3 = 0.0;
    value = x2 * ( r8_csevl ( x3, bifcs, nbif ) 
      + 0.25 ) + r8_csevl ( x3, bigcs, nbig ) + 0.5;
    if ( x32sml < x )
    {
      value = value * exp ( - 2.0 * x * sqrt ( x ) / 3.0 );
    }
  }
  else if ( fabs ( x ) <= x3sml )
  {
    x2 = x * x;
    x3 = 0.0;
    value = x2 * ( r8_csevl ( x3, bifcs, nbif ) 
      + 0.25 ) + r8_csevl ( x3, bigcs, nbig ) + 0.5;
    if ( x32sml < x )
    {
      value = value * exp ( - 2.0 * x * sqrt ( x ) / 3.0 );
    }
  }
  else if ( x <= 1.0 )
  {
    x2 = x * x;
    x3 = x * x * x;
    value = x2 * ( r8_csevl ( x3, bifcs, nbif ) 
      + 0.25 ) + r8_csevl ( x3, bigcs, nbig ) + 0.5;
    if ( x32sml < x )
    {
      value = value * exp ( - 2.0 * x * sqrt ( x ) / 3.0 );
    }
  }
  else if ( x <= 2.0 )
  {
    z = ( 2.0 * x * x * x - 9.0 ) / 7.0;
    value = exp ( - 2.0 * x * sqrt ( x ) / 3.0 ) 
      * ( x * x * ( 0.25 + r8_csevl ( z, bif2cs, nbif2 ) ) 
      + 0.5 + r8_csevl ( z, big2cs, nbig2 ) );
  }
  else if ( x <= 4.0 )
  {
    sqrtx = sqrt ( x );
    z = atr / x / sqrtx + btr;
    value = ( 0.625 + r8_csevl ( z, bip1cs, nbip1 ) ) * sqrt ( sqrtx );
  }
  else if ( x <= xbig )
  {
    sqrtx = sqrt ( x );
    z = 16.0 / x / sqrtx - 1.0;
    value = ( 0.625 + r8_csevl ( z, bip2cs, nbip2 ) ) * sqrt ( sqrtx );
  }
  else
  {
    sqrtx = sqrt ( x );
    z = -1.0;
    value = ( 0.625 + r8_csevl ( z, bip2cs, nbip2 ) ) * sqrt ( sqrtx );
  }
  return value;
}
/******************************************************************************/

double r8_bie ( double x )

/******************************************************************************/
/*
  Purpose:

    R8_BIE evaluates the exponentially scaled Airy function Bi of an R8 argument.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, double X, the argument.

    Output, double R8_BIE, the exponentially scaled Airy function Bi of X.
*/
{
  const double atr = 8.75069057084843450880771988210148;
  static double bif2cs[15] = {
    +0.0998457269381604104468284257993,
    +0.47862497786300553772211467318231,
    +0.25155211960433011771324415436675E-01,
    +0.58206938852326456396515697872216E-03,
    +0.74997659644377865943861457378217E-05,
    +0.61346028703493836681403010356474E-07,
    +0.34627538851480632900434268733359E-09,
    +0.14288910080270254287770846748931E-11,
    +0.44962704298334641895056472179200E-14,
    +0.11142323065833011708428300106666E-16,
    +0.22304791066175002081517866666666E-19,
    +0.36815778736393142842922666666666E-22,
    +0.50960868449338261333333333333333E-25,
    +0.60003386926288554666666666666666E-28,
    +0.60827497446570666666666666666666E-31 };
  static double bifcs[13] = {
    -0.16730216471986649483537423928176E-01,
    +0.10252335834249445611426362777757,
    +0.17083092507381516539429650242013E-02,
    +0.11862545467744681179216459210040E-04,
    +0.44932907017792133694531887927242E-07,
    +0.10698207143387889067567767663628E-09,
    +0.17480643399771824706010517628573E-12,
    +0.20810231071761711025881891834399E-15,
    +0.18849814695665416509927971733333E-18,
    +0.13425779173097804625882666666666E-21,
    +0.77159593429658887893333333333333E-25,
    +0.36533879617478566399999999999999E-28,
    +0.14497565927953066666666666666666E-31 };
  static double big2cs[15] = {
    +0.033305662145514340465176188111647,
    +0.161309215123197067613287532084943,
    +0.631900730961342869121615634921173E-02,
    +0.118790456816251736389780192304567E-03,
    +0.130453458862002656147116485012843E-05,
    +0.937412599553521729546809615508936E-08,
    +0.474580188674725153788510169834595E-10,
    +0.178310726509481399800065667560946E-12,
    +0.516759192784958180374276356640000E-15,
    +0.119004508386827125129496251733333E-17,
    +0.222982880666403517277063466666666E-20,
    +0.346551923027689419722666666666666E-23,
    +0.453926336320504514133333333333333E-26,
    +0.507884996513522346666666666666666E-29,
    +0.491020674696533333333333333333333E-32 };
  static double bigcs[13] = {
    +0.22466223248574522283468220139024E-01,
    +0.37364775453019545441727561666752E-01,
    +0.44476218957212285696215294326639E-03,
    +0.24708075636329384245494591948882E-05,
    +0.79191353395149635134862426285596E-08,
    +0.16498079851827779880887872402706E-10,
    +0.24119906664835455909247501122841E-13,
    +0.26103736236091436985184781269333E-16,
    +0.21753082977160323853123792000000E-19,
    +0.14386946400390433219483733333333E-22,
    +0.77349125612083468629333333333333E-26,
    +0.34469292033849002666666666666666E-29,
    +0.12938919273216000000000000000000E-32 };
  static double bip1cs[47] = {
    -0.83220474779434474687471864707973E-01,
    +0.11461189273711742889920226128031E-01,
    +0.42896440718911509494134472566635E-03,
    -0.14906639379950514017847677732954E-03,
    -0.13076597267876290663136340998881E-04,
    +0.63275983961030344754535716032494E-05,
    -0.42226696982681924884778515889433E-06,
    -0.19147186298654689632835494181277E-06,
    +0.64531062845583173611038157880934E-07,
    -0.78448546771397719289748310448628E-08,
    -0.96077216623785085879198533565432E-09,
    +0.70004713316443966339006074402068E-09,
    -0.17731789132814932022083128056698E-09,
    +0.22720894783465236347282126389311E-10,
    +0.16540456313972049847032860681891E-11,
    -0.18517125559292316390755369896693E-11,
    +0.59576312477117290165680715534277E-12,
    -0.12194348147346564781055769498986E-12,
    +0.13347869253513048815386347813597E-13,
    +0.17278311524339746664384792889731E-14,
    -0.14590732013016720735268871713166E-14,
    +0.49010319927115819978994989520104E-15,
    -0.11556545519261548129262972762521E-15,
    +0.19098807367072411430671732441524E-16,
    -0.11768966854492179886913995957862E-17,
    -0.63271925149530064474537459677047E-18,
    +0.33861838880715361614130191322316E-18,
    -0.10725825321758625254992162219622E-18,
    +0.25995709605617169284786933115562E-19,
    -0.48477583571081193660962309494101E-20,
    +0.55298913982121625361505513198933E-21,
    +0.49421660826069471371748197444266E-22,
    -0.55162121924145707458069720814933E-22,
    +0.21437560417632550086631884499626E-22,
    -0.61910313387655605798785061137066E-23,
    +0.14629362707391245659830967336959E-23,
    -0.27918484471059005576177866069333E-24,
    +0.36455703168570246150906795349333E-25,
    +0.58511821906188711839382459733333E-27,
    -0.24946950487566510969745047551999E-26,
    +0.10979323980338380977919579477333E-26,
    -0.34743388345961115015034088106666E-27,
    +0.91373402635349697363171082240000E-28,
    -0.20510352728210629186247720959999E-28,
    +0.37976985698546461748651622399999E-29,
    -0.48479458497755565887848448000000E-30,
    -0.10558306941230714314205866666666E-31 };
  static double bip2cs[88] = {
    -0.11359673758598867913797310895527,
    +0.41381473947881595760052081171444E-02,
    +0.13534706221193329857696921727508E-03,
    +0.10427316653015353405887183456780E-04,
    +0.13474954767849907889589911958925E-05,
    +0.16965374054383983356062511163756E-06,
    -0.10096500865641624301366228396373E-07,
    -0.16729119493778475127836973095943E-07,
    -0.45815364485068383217152795613391E-08,
    +0.37366813665655477274064749384284E-09,
    +0.57669303201452448119584643502111E-09,
    +0.62181265087850324095393408792371E-10,
    -0.63294120282743068241589177281354E-10,
    -0.14915047908598767633999091989487E-10,
    +0.78896213942486771938172394294891E-11,
    +0.24960513721857797984888064000127E-11,
    -0.12130075287291659477746664734814E-11,
    -0.37404939108727277887343460402716E-12,
    +0.22377278140321476798783446931091E-12,
    +0.47490296312192466341986077472514E-13,
    -0.45261607991821224810605655831294E-13,
    -0.30172271841986072645112245876020E-14,
    +0.91058603558754058327592683478908E-14,
    -0.98149238033807062926643864207709E-15,
    -0.16429400647889465253601245251589E-14,
    +0.55334834214274215451182114635164E-15,
    +0.21750479864482655984374381998156E-15,
    -0.17379236200220656971287029558087E-15,
    -0.10470023471443714959283909313604E-17,
    +0.39219145986056386925441403311462E-16,
    -0.11621293686345196925824005665910E-16,
    -0.54027474491754245533735411307773E-17,
    +0.45441582123884610882675428553304E-17,
    -0.28775599625221075729427585480086E-18,
    -0.10017340927225341243596162960440E-17,
    +0.44823931215068369856332561906313E-18,
    +0.76135968654908942328948982366775E-19,
    -0.14448324094881347238956060145422E-18,
    +0.40460859449205362251624847392112E-19,
    +0.20321085700338446891325190707277E-19,
    -0.19602795471446798718272758041962E-19,
    +0.34273038443944824263518958211738E-20,
    +0.37023705853905135480024651593154E-20,
    -0.26879595172041591131400332966712E-20,
    +0.28121678463531712209714454683364E-21,
    +0.60933963636177797173271119680329E-21,
    -0.38666621897150844994172977893413E-21,
    +0.25989331253566943450895651927228E-22,
    +0.97194393622938503767281175216084E-22,
    -0.59392817834375098415630478204591E-22,
    +0.38864949977113015409591960439444E-23,
    +0.15334307393617272869721512868769E-22,
    -0.97513555209762624036336521409724E-23,
    +0.96340644440489471424741339383726E-24,
    +0.23841999400208880109946748792454E-23,
    -0.16896986315019706184848044205207E-23,
    +0.27352715888928361222578444801478E-24,
    +0.35660016185409578960111685025730E-24,
    -0.30234026608258827249534280666954E-24,
    +0.75002041605973930653144204823232E-25,
    +0.48403287575851388827455319838748E-25,
    -0.54364137654447888432698010297766E-25,
    +0.19281214470820962653345978809756E-25,
    +0.50116355020532656659611814172172E-26,
    -0.95040744582693253786034620869972E-26,
    +0.46372646157101975948696332245611E-26,
    +0.21177170704466954163768170577046E-28,
    -0.15404850268168594303692204548726E-26,
    +0.10387944293201213662047889194441E-26,
    -0.19890078156915416751316728235153E-27,
    -0.21022173878658495471177044522532E-27,
    +0.21353099724525793150633356670491E-27,
    -0.79040810747961342319023537632627E-28,
    -0.16575359960435585049973741763592E-28,
    +0.38868342850124112587625586496537E-28,
    -0.22309237330896866182621562424717E-28,
    +0.27777244420176260265625977404382E-29,
    +0.57078543472657725368712433782772E-29,
    -0.51743084445303852800173371555280E-29,
    +0.18413280751095837198450927071569E-29,
    +0.44422562390957094598544071068647E-30,
    -0.98504142639629801547464958226943E-30,
    +0.58857201353585104884754198881995E-30,
    -0.97636075440429787961402312628595E-31,
    -0.13581011996074695047063597884122E-30,
    +0.13999743518492413270568048380345E-30,
    -0.59754904545248477620884562981118E-31,
    -0.40391653875428313641045327529856E-32 };
  const double btr = -2.09383632135605431360096498526268;
  double eta;
  static int nbif = 0;
  static int nbif2 = 0;
  static int nbig = 0;
  static int nbig2 = 0;
  static int nbip1 = 0;
  static int nbip2 = 0;
  double sqrtx;
  double theta;
  double value;
  static double x32sml;
  static double x3sml;
  static double xbig;
  double xm;
  double z;

  if ( nbif == 0 )
  {
    eta = 0.1 * r8_mach ( 3 );
    nbif = r8_inits ( bifcs, 13, eta );
    nbig = r8_inits ( bigcs, 13, eta );
    nbif2 = r8_inits ( bif2cs, 15, eta );
    nbig2 = r8_inits ( big2cs, 15, eta );
    nbip1 = r8_inits ( bip1cs, 47, eta );
    nbip2 = r8_inits ( bip2cs, 88, eta );
    x3sml = r8_power ( eta, 0.3333 );
    x32sml = 1.3104 * x3sml * x3sml;
    xbig = r8_power ( r8_mach ( 2 ), 0.6666 );
  }

  if ( x < - 1.0 )
  {
    r8_aimp ( x, &xm, &theta );
    value = xm * sin ( theta );
  }
  else if ( fabs ( x ) <= x3sml )
  {
    z = 0.0;
    value = 0.625 + r8_csevl ( z, bifcs, nbif ) 
      + x * ( 0.4375 + r8_csevl ( z, bigcs, nbig ) );
    if (  x32sml <= x )
    {
      value = value * exp ( - 2.0 * x * sqrt ( x ) / 3.0 );
    }
  }
  else if ( x <= 1.0 )
  {
    z = x * x * x;
    value = 0.625 + r8_csevl ( z, bifcs, nbif ) 
      + x * ( 0.4375 + r8_csevl ( z, bigcs, nbig ) );
    if (  x32sml <= x )
    {
      value = value * exp ( - 2.0 * x * sqrt ( x ) / 3.0 );
    }
  }
  else if ( x <= 2.0 )
  {
    z = ( 2.0 * x * x * x - 9.0 ) / 7.0;
    value = exp ( - 2.0 * x * sqrt ( x ) / 3.0 ) 
      * ( 1.125 + r8_csevl ( z, bif2cs, nbif2 ) 
      + x * ( 0.625 + r8_csevl ( z, big2cs, nbig2 ) ) );
  }
  else if ( x <= 4.0 )
  {
    sqrtx = sqrt ( x );
    z = atr / x / sqrtx + btr;
    value = ( 0.625 + r8_csevl ( z, bip1cs, nbip1 ) ) / sqrt ( sqrtx );
  }
  else if ( x < xbig )
  {
    sqrtx = sqrt ( x );
    z = 16.0 / ( x * sqrtx ) - 1.0;
    value = ( 0.625 + r8_csevl ( z, bip2cs, nbip2 ) ) / sqrt ( sqrtx );
  }
  else
  {
    sqrtx = sqrt ( x );
    z = - 1.0;
    value = ( 0.625 + r8_csevl ( z, bip2cs, nbip2 ) ) / sqrt ( sqrtx );
  }
  return value;
}
/******************************************************************************/

double r8_binom ( int n, int m )

/******************************************************************************/
/*
  Purpose:

    R8_BINOM evaluates the binomial coefficient using R8 arithmetic.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, int N, M, the arguments.

    Output, double R8_BINOM, the binomial coefficient.
*/
{
  static double bilnmx = 0.0;
  double corr;
  static double fintmx = 0.0;
  int i;
  int k;
  const double sq2pil = 0.91893853320467274178032973640562;
  double value;
  double xk;
  double xn;
  double xnk;

  if ( bilnmx == 0.0 )
  {
    bilnmx = log ( r8_mach ( 2 ) ) - 0.0001;
    fintmx = 0.9 / r8_mach ( 3 );
  }

  if ( n < 0 )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R8_BINOM - Fatal error!\n" );
    fprintf ( stderr, "  N < 0.\n" );
    exit ( 1 );
  }

  if ( m < 0 )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R8_BINOM - Fatal error!\n" );
    fprintf ( stderr, "  M < 0.\n" );
    exit ( 1 );
  }

  if ( n < m )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R8_BINOM - Fatal error!\n" );
    fprintf ( stderr, "  N < M.\n" );
    exit ( 1 );
  }

  k = i4_min ( m, n - m );

  if ( k <= 20 && 
    ( double ) ( k ) * log ( ( double ) ( i4_max ( n, 1 ) ) ) <= bilnmx )
  {
    value = 1.0;
    for ( i = 1; i <= k; i++ )
    {
      value = value * ( double ) ( n - i + 1 ) / ( double ) ( i );
    }
  }
  else
  {
    if ( k < 9 )
    {
      fprintf ( stderr, "\n" );
      fprintf ( stderr, "R8_BINOM - Fatal error!\n" );
      fprintf ( stderr, "  Result overflows.\n" );
      fprintf ( stderr, "  N or M is too big.\n" );
      exit ( 1 );
    }

    xn = ( double ) ( n + 1 );
    xk = ( double ) ( k + 1 );
    xnk = ( double ) ( n - k + 1 );

    corr = r8_lgmc ( xn ) - r8_lgmc ( xk ) - r8_lgmc ( xnk );

    value = xk * log ( xnk / xk ) 
      - xn * r8_lnrel ( - ( xk - 1.0 ) / xn )
      - 0.5 * log ( xn * xnk / xk ) + 1.0 - sq2pil + corr;

    if ( bilnmx < value )
    {
      fprintf ( stderr, "\n" );
      fprintf ( stderr, "R8_BINOM - Fatal error!\n" );
      fprintf ( stderr, "  Result overflows.\n" );
      fprintf ( stderr, "  N or M is too big.\n" );
      exit ( 1 );
    }
    value = exp ( value );
  }

  if ( value < fintmx )
  {
    value = r8_aint ( value + 0.5 );
  }
  return value;
}
/******************************************************************************/

double r8_cbrt ( double x )

/******************************************************************************/
/*
  Purpose:

    R8_CBRT computes the cube root of an R8.

  Discussion:

    The approximation is a generalized Chebyshev series converted
    to polynomial form.  The approximation is nearly best in the 
    sense of relative error with 4.085 digits accuracy.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, double X, the number whose square root is desired.

    Output, double R8_CBRT, the cube root of X.
*/
{
  static double cbrt2[5] = {
    0.62996052494743658238360530363911,
    0.79370052598409973737585281963615,
    1.0,
    1.25992104989487316476721060727823,
    1.58740105196819947475170563927231 };
  int irem;
  int iter;
  int ixpnt;
  int n;
  static int niter = 0;
  double value;
  double vsq;
  double y;

  if ( niter == 0 )
  {
    niter = ( int ) ( 1.443 * log ( - 0.106 * log ( 0.1 * r8_mach ( 3 ) ) ) + 1.0 );
  }

  value = 0.0;

  if ( x != 0.0 )
  {
    r8_upak ( fabs ( x ), &y, &n );
    ixpnt = n / 3;
    irem = n - 3 * ixpnt + 3;

    value = 0.439581 + y * ( 
            0.928549 + y * (
          - 0.512653 + y *
            0.144586 ) );

    for ( iter = 1; iter <= niter; iter++ )
    {
      vsq = value * value;
      value = value + ( y - value * vsq ) / ( 3.0 * vsq );
    }

    if ( x < 0.0 )
    {
      value = - fabs ( value );
    }
    else
    {
      value = + fabs ( value );
    }
    value = r8_pak ( cbrt2[irem-1] * value, ixpnt );
  }
  return value;
}
/******************************************************************************/

double r8_chi ( double x )

/******************************************************************************/
/*
  Purpose:

    R8_CHI evaluates the hyperbolic cosine integral of an R8 argument.

  Discussion:

    The hyperbolic cosine integral is defined by

      CHI(X) = gamma + log ( x ) 
        + integral ( 0 <= T < X ) ( cosh ( T ) - 1 ) / T  dT

    where gamma is Euler's constant.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, double X, the argument.

    Output, double R8_CHI, the hyperbolic cosine integral
    evaluated at X.
*/
{
  double value;

  value = 0.5 * ( r8_ei ( x ) - r8_e1 ( x ) );

  return value;
}
/******************************************************************************/

double r8_chu ( double a, double b, double x )

/******************************************************************************/
/*
  Purpose:

    R8_CHU evaluates the confluent hypergeometric function of R8 arguments.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, double A, B, the parameters.

    Input, double X, the argument.

    Output, double R8_CHU, the function value.
*/
{
  double a0;
  double aintb;
  double alnx;
  double b0;
  double beps;
  double c0;
  static double eps = 0.0;
  double factor;
  double gamri1;
  double gamrni;
  int i;
  int istrt;
  int m;
  int n;
  double pch1ai;
  double pch1i;
  const double pi = 3.141592653589793238462643383279503;
  double pochai;
  double sum;
  double t;
  double value;
  double xeps1;
  double xi;
  double xi1;
  double xn;
  double xtoeps;

  if ( eps == 0.0 )
  {
    eps = r8_mach ( 3 );
  }

  if ( x < 0.0 )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R8_CHU - Fatal error!\n" );
    fprintf ( stderr, "  X < 0.\n" );
    exit ( 1 );
  }

  if ( x == 0.0 )
  {
    if ( 1.0 <= b )
    {
      fprintf ( stderr, "\n" );
      fprintf ( stderr, "R8_CHU - Fatal error!\n" );
      fprintf ( stderr, "  X = 0 and 1 <= B.\n" );
      exit ( 1 );
    }
    value = r8_gamma ( 1.0 - b ) / r8_gamma ( 1.0 + a - b );
    return value;
  }

  if ( fmax ( fabs ( a ), 1.0 ) 
    * fmax ( fabs ( 1.0 + a - b ), 1.0 ) < 0.99 * fabs ( x ) )
  {
    value = r8_power ( x, - a ) * r8_chu_scaled ( a, b, x );
    return value;
  }
/*
  The ascending series will be used, because the descending rational
  approximation (which is based on the asymptotic series) is unstable.
*/
  if ( 0.0 <= b )
  {
    aintb = r8_aint ( b + 0.5 );
  }
  else
  {
    aintb = r8_aint ( b - 0.5 );
  }
  beps = b - aintb;
  n = ( int ) aintb;
  alnx = log ( x );
  xtoeps = exp ( - beps * alnx );
/*
  Evaluate the finite sum.

  Consider the case b < 1.0 first.
*/
  if ( n < 1 )
  {
    sum = 1.0; 
    t = 1.0;
    m = - n;
    for ( i = 1; i <= m; i++ )
    {
      xi1 = ( double ) ( i - 1 );
      t = t * ( a + xi1 ) * x / ( ( b + xi1 ) * ( xi1 + 1.0 ) );
      sum = sum + t;
    }
    sum = r8_poch ( 1.0 + a - b, - a ) * sum;
  }
/*
  Now consider the case 1 <= b.
*/
  else
  {
    sum = 0.0;
    m = n - 2;

    if ( 0 <= m )
    {
      t = 1.0;
      sum = 1.0;

      for ( i = 1; i <= m; i++ )
      {
        xi = ( double ) ( i );
        t = t * ( a - b + xi ) * x / ( ( 1.0 - b + xi ) * xi );
        sum = sum + t;
      }

      sum = r8_gamma ( b - 1.0 ) * r8_gamr ( a )
        * r8_power ( x, ( double ) ( 1 - n ) ) * xtoeps * sum;
    }
  }
/*
  Next evaluate the infinite sum.
*/
  if ( n < 1 )
  {
    istrt = 1 - n;
  }
  else
  {
    istrt = 0;
  }

  xi = ( double ) ( istrt );

  factor = r8_mop ( n ) * r8_gamr ( 1.0 + a - b ) * r8_power ( x, xi );

  if ( beps != 0.0 )
  {
    factor = factor * beps * pi / sin ( beps * pi );
  }

  pochai = r8_poch ( a, xi );
  gamri1 = r8_gamr ( xi + 1.0 );
  gamrni = r8_gamr ( aintb + xi );
  b0 = factor * r8_poch ( a, xi - beps ) 
    * gamrni * r8_gamr ( xi + 1.0 - beps );
/*
  x^(-beps) is close to 1.0, so we must be careful in evaluating the
  differences.
*/
  if ( fabs ( xtoeps - 1.0 ) <= 0.5 )
  {
    pch1ai = r8_poch1 ( a + xi, -beps );
    pch1i = r8_poch1 ( xi + 1.0 - beps, beps );
    c0 = factor * pochai * gamrni * gamri1 * (
      - r8_poch1 ( b + xi,- beps ) + pch1ai 
      - pch1i + beps * pch1ai * pch1i );
/*
  xeps1 = (1.0 - x^(-beps))/beps = (x^(-beps) - 1.0)/(-beps)
*/
    xeps1 = alnx* r8_exprel ( - beps * alnx );

    value = sum + c0 + xeps1 * b0;
    xn = ( double ) ( n );

    for ( i = 1; i <= 1000; i++ )
    {
      xi = ( double ) ( istrt + i );
      xi1 = ( double ) ( istrt + i - 1 );
      b0 = ( a + xi1 - beps ) * b0 * x 
        / ( ( xn + xi1 ) * ( xi - beps ) );
      c0 = ( a + xi1 ) * c0 * x / ( ( b + xi1) * xi )
        - ( ( a - 1.0 ) * ( xn + 2.0 * xi - 1.0 ) 
        + xi * ( xi - beps ) ) * b0 
        / ( xi * ( b + xi1 ) * ( a + xi1 - beps ) );
      t = c0 + xeps1 * b0;
      value = value + t;
      if ( fabs ( t ) < eps * fabs ( value ) )
      {
        return value;
      }
    }

    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R8_CHU - Fatal error!\n" );
    fprintf ( stderr, "  No convergence in 1000 terms.\n" );
    exit ( 1 );
  }
/*
  x^(-beps) is very different from 1.0, so the straightforward
  formulation is stable.
*/
  a0 = factor * pochai * r8_gamr ( b + xi ) * gamri1 / beps;
  b0 = xtoeps * b0 / beps;

  value = sum + a0 - b0;

  for ( i = 1; i <= 1000; i++ )
  {
    xi = ( double ) ( istrt + i );
    xi1 = ( double ) ( istrt + i - 1 );
    a0 = ( a + xi1 ) * a0 * x / ( ( b + xi1 ) * xi );
    b0 = ( a + xi1 - beps ) * b0 * x
      / ( ( aintb + xi1 ) * ( xi - beps ) );
    t = a0 - b0;
    value = value + t;
    if ( fabs ( t ) < eps * fabs ( value ) )
    {
      return value;
    }
  }

  fprintf ( stderr, "\n" );
  fprintf ( stderr, "R8_CHU - Fatal error!\n" );
  fprintf ( stderr, "  No convergence in 1000 terms.\n" );
  exit ( 1 );
}
/******************************************************************************/

double r8_chu_scaled ( double a, double b, double z )

/******************************************************************************/
/*
  Purpose:

    R8_CHU_SCALED: scaled confluent hypergeometric function of R8 arguments.

  Discussion:

    Evaluate, for large z, z^a * u(a,b,z)  where U is the logarithmic
    confluent hypergeometric function.  A rational approximation due to
    Y L Luke is used.  When U is not in the asymptotic region, that is, when A
    or B is large compared with Z, considerable significance loss occurs.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, double A, B, the parameters.

    Input, double Z, the argument.

    Output, double R8_CHU_SCALED, the function value.
*/
{
  double aa[4];
  double ab;
  double anbn;
  double bb[4];
  double bp;
  double c2;
  double ct1;
  double ct2;
  double ct3;
  double d1z;
  static double eps = 0.0;
  double g1;
  double g2;
  double g3;
  int i;
  int j;
  double sab;
  double value;
  double x2i1;

  if ( eps == 0.0 )
  {
    eps = 4.0 * r8_mach ( 4 );
  }

  bp = 1.0 + a - b;
  ab = a * bp;
  ct2 = 2.0 * ( z - ab );
  sab = a + bp;

  bb[0] = 1.0;
  aa[0] = 1.0;

  ct3 = sab + 1.0 + ab;
  bb[1] = 1.0 + 2.0 * z / ct3;
  aa[1] = 1.0 + ct2 / ct3;

  anbn = ct3 + sab + 3.0;
  ct1 = 1.0 + 2.0 * z / anbn;
  bb[2] = 1.0 + 6.0 * ct1 * z / ct3;
  aa[2] = 1.0 + 6.0 * ab / anbn + 3.0 * ct1 * ct2 / ct3;

  for ( i = 4; i <= 300; i++ )
  {
    x2i1 = ( double ) ( 2 * i - 3 );
    ct1 = x2i1 / ( x2i1 - 2.0 );
    anbn = anbn + x2i1 + sab;
    ct2 = ( x2i1 - 1.0 ) /anbn;
    c2 = x2i1 * ct2 - 1.0;
    d1z = x2i1 * 2.0 * z / anbn;

    ct3 = sab * ct2;
    g1 = d1z + ct1 * ( c2 + ct3 );
    g2 = d1z - c2;
    g3 = ct1 * ( 1.0 - ct3 - 2.0 * ct2 );

    bb[3] = g1 * bb[2] + g2 * bb[1] + g3 * bb[0];
    aa[3] = g1 * aa[2] + g2 * aa[1] + g3 * aa[0];

    value = aa[3] / bb[3];

    if ( fabs ( value - aa[0] / bb[0] ) < eps * fabs ( value ) )
    {
      return value;
    }

    for ( j = 0; j < 3; j++ )
    {
      aa[j] = aa[j+1];
      bb[j] = bb[j+1];
    }
  }

  fprintf ( stderr, "\n" );
  fprintf ( stderr, "R8_CHU_SCALED - Fatal error!\n" );
  fprintf ( stderr, "  No convergence after 300 terms.\n" );
  exit ( 1 );
}
/******************************************************************************/

double r8_ci ( double x )

/******************************************************************************/
/*
  Purpose:

    R8_CI evaluates the cosine integral Ci of an R8 argument.

  Discussion:

    The cosine integral is defined by

      CI(X) = - integral ( X <= T < Infinity ) ( cos ( T ) ) / T  dT

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, double X, the argument.

    Output, double R8_CI, the cosine integral Ci evaluated at X.
*/
{
  static double cics[19] = {
    -0.34004281856055363156281076633129873,
    -1.03302166401177456807159271040163751,
     0.19388222659917082876715874606081709,
    -0.01918260436019865893946346270175301,
     0.00110789252584784967184098099266118,
    -0.00004157234558247208803840231814601,
     0.00000109278524300228715295578966285,
    -0.00000002123285954183465219601280329,
     0.00000000031733482164348544865129873,
    -0.00000000000376141547987683699381798,
     0.00000000000003622653488483964336956,
    -0.00000000000000028911528493651852433,
     0.00000000000000000194327860676494420,
    -0.00000000000000000001115183182650184,
     0.00000000000000000000005527858887706,
    -0.00000000000000000000000023907013943,
     0.00000000000000000000000000091001612,
    -0.00000000000000000000000000000307233,
     0.00000000000000000000000000000000926 };
  double f;
  double g;
  static int nci = 0;
  double sinx;
  double value;
  static double xsml = 0.0;
  double y;

  if ( nci == 0 )
  {
    nci = r8_inits ( cics, 19, 0.1 * r8_mach ( 3 ) );
    xsml = sqrt ( r8_mach ( 3 ) );
  }

  if ( x <= 0.0 )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R8_CI - Fatal error!\n" );
    fprintf ( stderr, "  X <= 0.0.\n" );
    exit ( 1 );
  }
  else if ( x <= xsml )
  {
    y = - 1.0;
    value = log ( x ) - 0.5 + r8_csevl ( y, cics, nci );
  }
  else if ( x <= 4.0 )
  {
    y = ( x * x - 8.0 ) * 0.125;
    value = log ( x ) - 0.5 + r8_csevl ( y, cics, nci );
  }
  else
  {
    r8_sifg ( x, &f, &g );
    sinx = sin ( x );
    value = f * sinx - g * cos ( x );
  }
  return value;
}
/******************************************************************************/

double r8_cin ( double x )

/******************************************************************************/
/*
  Purpose:

    R8_CIN evaluates the alternate cosine integral Cin of an R8 argument.

  Discussion:

    CIN(X) = gamma + log(X) 
      + integral ( 0 <= T <= X ) ( cos ( T ) - 1 ) / T  dT

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, double X, the argument.

    Output, double R8_CIN, the cosine integral Cin evaluated at X.
*/
{
  double absx;
  static double cincs[18] = {
     0.37074501750909688741654801228564992,
    -0.05893574896364446831956864397363697,
     0.00538189642113569124048745326203340,
    -0.00029860052841962135319594906563410,
     0.00001095572575321620077031054467306,
    -0.00000028405454877346630491727187731,
     0.00000000546973994875384912457861806,
    -0.00000000008124187461318157083277452,
     0.00000000000095868593117706609013181,
    -0.00000000000000920266004392351031377,
     0.00000000000000007325887999017895024,
    -0.00000000000000000049143726675842909,
     0.00000000000000000000281577746753902,
    -0.00000000000000000000001393986788501,
     0.00000000000000000000000006022485646,
    -0.00000000000000000000000000022904717,
     0.00000000000000000000000000000077273,
    -0.00000000000000000000000000000000233 };
  const double eul = 0.57721566490153286060651209008240;
  double f;
  double g;
  static int ncin = 0;
  double sinx;
  double value;
  static double xmin = 0.0;

  if ( ncin == 0 )
  {
    ncin = r8_inits ( cincs, 18, 0.1 * r8_mach ( 3 ) );
    xmin = sqrt ( r8_mach ( 1 ) );
  }

  absx = fabs ( x );

  if ( absx <= xmin )
  {
    value = 0.0;
  }
  else if ( absx <= 4.0 )
  {
    value = r8_csevl ( ( x * x - 8.0 ) * 0.125, cincs, ncin ) * x * x;
  }
  else
  {
    r8_sifg ( absx, &f, &g );
    sinx = sin ( absx );
    value = - f * sinx + g * cos ( absx ) + log ( absx ) + eul;
  }
  return value;
}
/******************************************************************************/

double r8_cinh ( double x )

/******************************************************************************/
/*
  Purpose:

    R8_CINH: alternate hyperbolic cosine integral Cinh of an R8 argument.

  Discussion:

    Cinh ( x ) = Integral ( 0 <= t <= x ) ( cosh ( t ) - 1 ) dt / t

    The original text of this program had a mistake:
      y = x * x / 9.0 - 1.0
    has been corrected to
      y = x * x / 4.5 - 1.0
    JVB, 27 March 2010

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, double X, the argument.

    Output, double R8_CINH, the hyperbolic cosine integral Cinh
    evaluated at X.
*/
{
  double absx;
  static double cinhcs[16] = {
     0.1093291636520734431407425199795917,
     0.0573928847550379676445323429825108,
     0.0028095756978830353416404208940774,
     0.0000828780840721356655731765069792,
     0.0000016278596173914185577726018815,
     0.0000000227809519255856619859083591,
     0.0000000002384484842463059257284002,
     0.0000000000019360829780781957471028,
     0.0000000000000125453698328172559683,
     0.0000000000000000663637449497262300,
     0.0000000000000000002919639263594744,
     0.0000000000000000000010849123956107,
     0.0000000000000000000000034499080805,
     0.0000000000000000000000000094936664,
     0.0000000000000000000000000000228291,
     0.0000000000000000000000000000000484 };
  const double eul = 0.57721566490153286060651209008240;
  static int ncinh = 0;
  double value;
  static double xmin = 0.0;
  static double xsml = 0.0;
  double y;

  if ( ncinh == 0 )
  {
    ncinh = r8_inits ( cinhcs, 16, 0.1 * r8_mach ( 3 ) );
    xsml = sqrt ( r8_mach ( 3 ) );
    xmin = 2.0 * sqrt ( r8_mach ( 1 ) );
  }

  absx = fabs ( x );

  if ( x == 0.0 )
  {
    value = 0.0;
  }
  else if ( absx <= xmin )
  {
    value = 0.0;
  }
  else if ( x <= xsml )
  {
    y = - 1.0;
    value = x * x * ( 0.25 + r8_csevl ( y, cinhcs, ncinh ) );
  }
  else if ( x <= 3.0 )
  {
    y = x * x / 4.5 - 1.0;
    value = x * x * ( 0.25 + r8_csevl ( y, cinhcs, ncinh ) );
  }
  else
  {
    value = r8_chi ( absx ) - eul - log ( absx );
  }
  return value;
}
/******************************************************************************/

double r8_cos ( double x )

/******************************************************************************/
/*
  Purpose:

    R8_COS evaluates the cosine of an R8 argument.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, double X, the argument.

    Output, double R8_COS, the cosine of X.
*/
{
  double absx;
  double f;
  int n2;
  static int ntsn = 0;
  const double pi2 = 1.57079632679489661923132169163975;
  const double pi2rec = 0.63661977236758134307553505349006;
  const double pihi = 3.140625;
  const double pilo = 9.6765358979323846264338327950288E-04;
  const double pirec = 0.31830988618379067153776752674503;
  static double sincs[15] = {
   -0.374991154955873175839919279977323464,
   -0.181603155237250201863830316158004754,
    0.005804709274598633559427341722857921,
   -0.000086954311779340757113212316353178,
    0.000000754370148088851481006839927030,
   -0.000000004267129665055961107126829906,
    0.000000000016980422945488168181824792,
   -0.000000000000050120578889961870929524,
    0.000000000000000114101026680010675628,
   -0.000000000000000000206437504424783134,
    0.000000000000000000000303969595918706,
   -0.000000000000000000000000371357734157,
    0.000000000000000000000000000382486123,
   -0.000000000000000000000000000000336623,
    0.000000000000000000000000000000000256 };
  double value;
  static double xmax = 0.0;
  double xn;
  static double xsml = 0.0;
  static double xwarn = 0.0;
  double y;

  if ( ntsn == 0 )
  {
    ntsn = r8_inits ( sincs, 15, 0.1 * r8_mach ( 3 ) );
    xsml = r8_sqrt ( 2.0 * r8_mach ( 3 ) );
    xmax = 1.0 / r8_mach ( 4 );
    xwarn = r8_sqrt ( xmax );
  }

  absx = fabs ( x );
  y = absx + pi2;

  if ( xmax < y )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R8_COS - Warning!\n" );
    fprintf ( stderr, "  No precision because |X| is big.\n" );
    value = 0.0;
    return value;
  }

  if ( xwarn < y )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R8_COS - Warning!\n" );
    fprintf ( stderr, "  Answer < half precision because |X| is big.\n" );
  }

  value = 1.0;

  if ( absx < xsml )
  {
    return value;
  }

  xn = ( double ) ( ( int ) ( y * pirec + 0.5 ) );
  n2 = ( int ) ( r8_mod ( xn, 2.0 ) + 0.5 );
  xn = xn - 0.5;
  f = ( absx - xn * pihi ) - xn * pilo;

  xn = 2.0 * ( f * pi2rec ) * ( f * pi2rec ) - 1.0;
  value = f + f * r8_csevl ( xn, sincs, ntsn );

  if ( n2 != 0 )
  {
    value = - value;
  }

  if ( value < -1.0 )
  {
    value = -1.0;
  }
  else if ( 1.0 < value )
  {
    value = 1.0;
  }
  return value;
}
/******************************************************************************/

double r8_cos_deg ( double x )

/******************************************************************************/
/*
  Purpose:

    R8_COS_DEG evaluates the cosine of an R8 argument in degrees.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, double X, the argument in degrees.

    Output, double R8_COS_DEG, the cosine of X.
*/
{
  int n;
  const double raddeg = 0.017453292519943295769236907684886;
  double value;

  value = cos ( raddeg * x );

  if ( fmod ( x, 90.0 ) == 0.0 )
  {
    n = ( int ) ( fabs ( x ) / 90.0 + 0.5 );
    n = ( n % 2 );

    if ( n == 1 )
    {
      value = 0.0;
    }
    else if ( value < 0.0 )
    {
      value = - 1.0;
    }
    else
    {
      value = + 1.0;
    }
  }
  return value;
}
/******************************************************************************/

double r8_cosh ( double x )

/******************************************************************************/
/*
  Purpose:

    R8_COSH evaluates the hyperbolic cosine of an R8 argument.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, double X, the argument.

    Output, double R8_COSH, the hyperbolic cosine of X.
*/
{
  double value;
  double y;
  static double ymax = 0.0;

  if ( ymax == 0.0 )
  {
    ymax = 1.0 / sqrt ( r8_mach ( 3 ) );
  }

  y = exp ( fabs ( x ) );

  if ( y < ymax )
  {
    value = 0.5 * ( y + 1.0 / y );
  }
  else
  {
    value = 0.5 * y;
  }
  return value;
}
/******************************************************************************/

double r8_cot ( double x )

/******************************************************************************/
/*
  Purpose:

    R8_COT evaluates the cotangent of an R8 argument.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, double X, the argument.

    Output, double R8_COT, the cotangent of X.
*/
{
  double ainty;
  double ainty2;
  static double cotcs[15] = {
    +0.240259160982956302509553617744970,
    -0.165330316015002278454746025255758E-01,
    -0.429983919317240189356476228239895E-04,
    -0.159283223327541046023490851122445E-06,
    -0.619109313512934872588620579343187E-09,
    -0.243019741507264604331702590579575E-11,
    -0.956093675880008098427062083100000E-14,
    -0.376353798194580580416291539706666E-16,
    -0.148166574646746578852176794666666E-18,
    -0.583335658903666579477984000000000E-21,
    -0.229662646964645773928533333333333E-23,
    -0.904197057307483326719999999999999E-26,
    -0.355988551920600064000000000000000E-28,
    -0.140155139824298666666666666666666E-30,
    -0.551800436872533333333333333333333E-33 };
  int ifn;
  static int nterms = 0;
  const double pi2rec = 0.011619772367581343075535053490057;
  double prodbg;
  static double sqeps = 0.0;
  double value;
  static double xmax = 0.0;
  static double xmin = 0.0;
  static double xsml = 0.0;
  double y;
  double yrem;

  if ( nterms == 0 )
  {
    nterms = r8_inits ( cotcs, 15, 0.1 * r8_mach ( 3 ) );
    xmax = 1.0 / r8_mach ( 4 );
    xsml = sqrt ( 3.0 * r8_mach ( 3 ) );
    xmin = exp ( fmax ( log ( r8_mach ( 1 ) ), 
      - log ( r8_mach ( 2 ) ) )  + 0.01 );
    sqeps = sqrt ( r8_mach ( 4 ) );
  }

  y = fabs ( x );

  if ( y < xmin )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R8_COT - Fatal error!\n" );
    fprintf ( stderr, "  |X| is too small.\n" );
    exit ( 1 );
  }

  if ( xmax < y )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R8_COT - Fatal error!\n" );
    fprintf ( stderr, "  |X| is too big.\n" );
    exit ( 1 );
  }
/*
  Carefully compute y * (2/pi) = (aint(y) + rem(y)) * (.625 + pi2rec)
  = aint(.625*y) + rem(.625*y) + y*pi2rec  =  aint(.625*y) + z
  = aint(.625*y) + aint(z) + rem(z)
*/
  ainty = r8_aint ( y );
  yrem = y - ainty;
  prodbg = 0.625 * ainty;
  ainty = r8_aint ( prodbg );
  y = ( prodbg - ainty ) + 0.625 * yrem + y * pi2rec;
  ainty2 = r8_aint ( y );
  ainty = ainty + ainty2;
  y = y - ainty2;

  ifn = ( int ) fmod ( ainty, 2.0 );
  if ( ifn == 1 )
  {
    y = 1.0 - y;
  }

  if ( 0.5 < fabs ( x ) && y < fabs ( x ) * sqeps )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R8_COT - Warning!\n" );
    fprintf ( stderr, "  Answer less than half precision.\n" );
    fprintf ( stderr, "  |X| too big, or X nearly a nonzero multiple of pi.\n" );
    exit ( 1 );
  }

  if ( y == 0.0 )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R8_COT - Fatal error!\n" );
    fprintf ( stderr, "  X is a multiple of pi.\n" );
    exit ( 1 );
  }
  else if ( y <= xsml )
  {
    value = 1.0 / y;
  }
  else if ( y <= 0.25 )
  {
    value = ( 0.5 + r8_csevl ( 32.0 * y * y - 1.0, cotcs, nterms ) ) / y;
  }
  else if ( y <= 0.5 )
  {
    value = ( 0.5 + r8_csevl ( 8.0 * y * y - 1.0, 
      cotcs, nterms ) ) / ( 0.5 * y );

    value = ( value * value - 1.0 ) * 0.5 / value;
  }
  else
  {
    value = ( 0.5 + r8_csevl ( 2.0 * y * y - 1.0, 
      cotcs, nterms ) ) / ( 0.25 * y );
    value = ( value * value - 1.0 ) * 0.5 / value;
    value = ( value * value - 1.0 ) * 0.5 / value;
  }

  if ( x < 0.0 )
  {
    value = - fabs ( value );
  }
  else
  {
    value = + fabs ( value );
  }

  if ( ifn == 1 )
  {
    value = - value;
  }
  return value;
}
/******************************************************************************/

double r8_csevl ( double x, double a[], int n )

/******************************************************************************/
/*
  Purpose:

    R8_CSEVL evaluates a Chebyshev series.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    C version by John Burkardt.

  Reference:

    Roger Broucke,
    Algorithm 446:
    Ten Subroutines for the Manipulation of Chebyshev Series,
    Communications of the ACM,
    Volume 16, Number 4, April 1973, pages 254-256.

  Parameters:

    Input, double X, the evaluation point.

    Input, double CS[N], the Chebyshev coefficients.

    Input, int N, the number of Chebyshev coefficients.

    Output, double R8_CSEVL, the Chebyshev series evaluated at X.
*/
{
  double b0;
  double b1;
  double b2;
  int i;
  double twox;
  double value;

  if ( n < 1 )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R8_CSEVL - Fatal error!\n" );
    fprintf ( stderr, "  Number of terms <= 0.\n" );
    exit ( 1 );
  }

  if ( 1000 < n )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R8_CSEVL - Fatal error!\n" );
    fprintf ( stderr, "  Number of terms greater than 1000.\n" );
    exit ( 1 );
 }

  if ( x < -1.1 || 1.1 < x )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R8_CSEVL - Fatal error!\n" );
    fprintf ( stderr, "  X outside (-1,+1).\n" );
    exit ( 1 );
  }

  twox = 2.0 * x;
  b1 = 0.0;
  b0 = 0.0;

  for ( i = n - 1; 0 <= i; i-- )
  {
    b2 = b1;
    b1 = b0;
    b0 = twox * b1 - b2 + a[i];
  }

  value = 0.5 * ( b0 - b2 );

  return value;
}
/******************************************************************************/

double r8_dawson ( double x )

/******************************************************************************/
/*
  Purpose:

    R8_DAWSON evaluates Dawson's integral of an R8 argument.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, double X, the argument.

    Output, double R8_DAWSON, the value of Dawson's integral at X.
*/
{
  static double daw2cs[45] = {
    -0.56886544105215527114160533733674E-01,
    -0.31811346996168131279322878048822,
    +0.20873845413642236789741580198858,
    -0.12475409913779131214073498314784,
    +0.67869305186676777092847516423676E-01,
    -0.33659144895270939503068230966587E-01,
    +0.15260781271987971743682460381640E-01,
    -0.63483709625962148230586094788535E-02,
    +0.24326740920748520596865966109343E-02,
    -0.86219541491065032038526983549637E-03,
    +0.28376573336321625302857636538295E-03,
    -0.87057549874170423699396581464335E-04,
    +0.24986849985481658331800044137276E-04,
    -0.67319286764160294344603050339520E-05,
    +0.17078578785573543710504524047844E-05,
    -0.40917551226475381271896592490038E-06,
    +0.92828292216755773260751785312273E-07,
    -0.19991403610147617829845096332198E-07,
    +0.40963490644082195241210487868917E-08,
    -0.80032409540993168075706781753561E-09,
    +0.14938503128761465059143225550110E-09,
    -0.26687999885622329284924651063339E-10,
    +0.45712216985159458151405617724103E-11,
    -0.75187305222043565872243727326771E-12,
    +0.11893100052629681879029828987302E-12,
    -0.18116907933852346973490318263084E-13,
    +0.26611733684358969193001612199626E-14,
    -0.37738863052129419795444109905930E-15,
    +0.51727953789087172679680082229329E-16,
    -0.68603684084077500979419564670102E-17,
    +0.88123751354161071806469337321745E-18,
    -0.10974248249996606292106299624652E-18,
    +0.13261199326367178513595545891635E-19,
    -0.15562732768137380785488776571562E-20,
    +0.17751425583655720607833415570773E-21,
    -0.19695006967006578384953608765439E-22,
    +0.21270074896998699661924010120533E-23,
    -0.22375398124627973794182113962666E-24,
    +0.22942768578582348946971383125333E-25,
    -0.22943788846552928693329592319999E-26,
    +0.22391702100592453618342297600000E-27,
    -0.21338230616608897703678225066666E-28,
    +0.19866196585123531518028458666666E-29,
    -0.18079295866694391771955199999999E-30,
    +0.16090686015283030305450666666666E-31 };
  static double dawacs[75] = {
    +0.1690485637765703755422637438849E-01,
    +0.8683252278406957990536107850768E-02,
    +0.2424864042417715453277703459889E-03,
    +0.1261182399572690001651949240377E-04,
    +0.1066453314636176955705691125906E-05,
    +0.1358159794790727611348424505728E-06,
    +0.2171042356577298398904312744743E-07,
    +0.2867010501805295270343676804813E-08,
    -0.1901336393035820112282492378024E-09,
    -0.3097780484395201125532065774268E-09,
    -0.1029414876057509247398132286413E-09,
    -0.6260356459459576150417587283121E-11,
    +0.8563132497446451216262303166276E-11,
    +0.3033045148075659292976266276257E-11,
    -0.2523618306809291372630886938826E-12,
    -0.4210604795440664513175461934510E-12,
    -0.4431140826646238312143429452036E-13,
    +0.4911210272841205205940037065117E-13,
    +0.1235856242283903407076477954739E-13,
    -0.5788733199016569246955765071069E-14,
    -0.2282723294807358620978183957030E-14,
    +0.7637149411014126476312362917590E-15,
    +0.3851546883566811728777594002095E-15,
    -0.1199932056928290592803237283045E-15,
    -0.6313439150094572347334270285250E-16,
    +0.2239559965972975375254912790237E-16,
    +0.9987925830076495995132891200749E-17,
    -0.4681068274322495334536246507252E-17,
    -0.1436303644349721337241628751534E-17,
    +0.1020822731410541112977908032130E-17,
    +0.1538908873136092072837389822372E-18,
    -0.2189157877645793888894790926056E-18,
    +0.2156879197938651750392359152517E-20,
    +0.4370219827442449851134792557395E-19,
    -0.8234581460977207241098927905177E-20,
    -0.7498648721256466222903202835420E-20,
    +0.3282536720735671610957612930039E-20,
    +0.8858064309503921116076561515151E-21,
    -0.9185087111727002988094460531485E-21,
    +0.2978962223788748988314166045791E-22,
    +0.1972132136618471883159505468041E-21,
    -0.5974775596362906638089584995117E-22,
    -0.2834410031503850965443825182441E-22,
    +0.2209560791131554514777150489012E-22,
    -0.5439955741897144300079480307711E-25,
    -0.5213549243294848668017136696470E-23,
    +0.1702350556813114199065671499076E-23,
    +0.6917400860836148343022185660197E-24,
    -0.6540941793002752512239445125802E-24,
    +0.6093576580439328960371824654636E-25,
    +0.1408070432905187461501945080272E-24,
    -0.6785886121054846331167674943755E-25,
    -0.9799732036214295711741583102225E-26,
    +0.2121244903099041332598960939160E-25,
    -0.5954455022548790938238802154487E-26,
    -0.3093088861875470177838847232049E-26,
    +0.2854389216344524682400691986104E-26,
    -0.3951289447379305566023477271811E-27,
    -0.5906000648607628478116840894453E-27,
    +0.3670236964668687003647889980609E-27,
    -0.4839958238042276256598303038941E-29,
    -0.9799265984210443869597404017022E-28,
    +0.4684773732612130606158908804300E-28,
    +0.5030877696993461051647667603155E-29,
    -0.1547395051706028239247552068295E-28,
    +0.6112180185086419243976005662714E-29,
    +0.1357913399124811650343602736158E-29,
    -0.2417687752768673088385304299044E-29,
    +0.8369074582074298945292887587291E-30,
    +0.2665413042788979165838319401566E-30,
    -0.3811653692354890336935691003712E-30,
    +0.1230054721884951464371706872585E-30,
    +0.4622506399041493508805536929983E-31,
    -0.6120087296881677722911435593001E-31,
    +0.1966024640193164686956230217896E-31 };
  static double dawcs[21] = {
    -0.6351734375145949201065127736293E-02,
    -0.2294071479677386939899824125866,
    +0.2213050093908476441683979161786E-01,
    -0.1549265453892985046743057753375E-02,
    +0.8497327715684917456777542948066E-04,
    -0.3828266270972014924994099521309E-05,
    +0.1462854806250163197757148949539E-06,
    -0.4851982381825991798846715425114E-08,
    +0.1421463577759139790347568183304E-09,
    -0.3728836087920596525335493054088E-11,
    +0.8854942961778203370194565231369E-13,
    -0.1920757131350206355421648417493E-14,
    +0.3834325867246327588241074439253E-16,
    -0.7089154168175881633584099327999E-18,
    +0.1220552135889457674416901120000E-19,
    -0.1966204826605348760299451733333E-21,
    +0.2975845541376597189113173333333E-23,
    -0.4247069514800596951039999999999E-25,
    +0.5734270767391742798506666666666E-27,
    -0.7345836823178450261333333333333E-29,
    +0.8951937667516552533333333333333E-31 };
  double eps;
  static int ntdaw = 0;
  static int ntdaw2 = 0;
  static int ntdawa = 0;
  double value;
  static double xbig = 0.0;
  static double xmax = 0.0;
  static double xsml = 0.0;
  double y;

  if ( ntdaw == 0 )
  {
    eps = r8_mach ( 3 );
    ntdaw  = r8_inits ( dawcs,  21, 0.1 * eps );
    ntdaw2 = r8_inits ( daw2cs, 45, 0.1 * eps );
    ntdawa = r8_inits ( dawacs, 75, 0.1 * eps );
    xsml = sqrt ( 1.5 * eps );
    xbig = sqrt ( 0.5 / eps );
    xmax = exp ( fmin ( - log ( 2.0 * r8_mach ( 1 ) ), 
      log ( r8_mach ( 2 ) ) ) - 0.01 );
  }

  y = fabs ( x );

  if ( y <= xsml )
  {
    value = x;
  }
  else if ( y <= 1.0 )
  {
    value = x * ( 0.75 + r8_csevl ( 2.0 * y * y - 1.0, dawcs, ntdaw ) );
  }
  else if ( y <= 4.0 )
  {
    value = x * ( 0.25 + r8_csevl ( 0.125 * y * y - 1.0, daw2cs, ntdaw2 ) );
  }
  else if ( y < xbig )
  {
    value = ( 0.5 + r8_csevl ( 32.0 / y / y - 1.0, dawacs, ntdawa ) ) / x;
  }
  else if ( y <= xmax )
  {
    value = 0.5 / x;
  }
  else
  {
    value = 0.0;
  }
  return value;
}
/******************************************************************************/

double r8_e1 ( double x )

/******************************************************************************/
/*
  Purpose:

    R8_E1 evaluates the exponential integral E1 for an R8 argument.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, double X, the argument.

    Output, double R8_E1, the exponential integral E1 evaluated at X.
*/
{
  static double ae10cs[50] = {
    +0.3284394579616699087873844201881E-01,
    -0.1669920452031362851476184343387E-01,
    +0.2845284724361346807424899853252E-03,
    -0.7563944358516206489487866938533E-05,
    +0.2798971289450859157504843180879E-06,
    -0.1357901828534531069525563926255E-07,
    +0.8343596202040469255856102904906E-09,
    -0.6370971727640248438275242988532E-10,
    +0.6007247608811861235760831561584E-11,
    -0.7022876174679773590750626150088E-12,
    +0.1018302673703687693096652346883E-12,
    -0.1761812903430880040406309966422E-13,
    +0.3250828614235360694244030353877E-14,
    -0.5071770025505818678824872259044E-15,
    +0.1665177387043294298172486084156E-16,
    +0.3166753890797514400677003536555E-16,
    -0.1588403763664141515133118343538E-16,
    +0.4175513256138018833003034618484E-17,
    -0.2892347749707141906710714478852E-18,
    -0.2800625903396608103506340589669E-18,
    +0.1322938639539270903707580023781E-18,
    -0.1804447444177301627283887833557E-19,
    -0.7905384086522616076291644817604E-20,
    +0.4435711366369570103946235838027E-20,
    -0.4264103994978120868865309206555E-21,
    -0.3920101766937117541553713162048E-21,
    +0.1527378051343994266343752326971E-21,
    +0.1024849527049372339310308783117E-22,
    -0.2134907874771433576262711405882E-22,
    +0.3239139475160028267061694700366E-23,
    +0.2142183762299889954762643168296E-23,
    -0.8234609419601018414700348082312E-24,
    -0.1524652829645809479613694401140E-24,
    +0.1378208282460639134668480364325E-24,
    +0.2131311202833947879523224999253E-26,
    -0.2012649651526484121817466763127E-25,
    +0.1995535662263358016106311782673E-26,
    +0.2798995808984003464948686520319E-26,
    -0.5534511845389626637640819277823E-27,
    -0.3884995396159968861682544026146E-27,
    +0.1121304434507359382850680354679E-27,
    +0.5566568152423740948256563833514E-28,
    -0.2045482929810499700448533938176E-28,
    -0.8453813992712336233411457493674E-29,
    +0.3565758433431291562816111116287E-29,
    +0.1383653872125634705539949098871E-29,
    -0.6062167864451372436584533764778E-30,
    -0.2447198043989313267437655119189E-30,
    +0.1006850640933998348011548180480E-30,
    +0.4623685555014869015664341461674E-31 };
  static double ae11cs[60] = {
    +0.20263150647078889499401236517381,
    -0.73655140991203130439536898728034E-01,
    +0.63909349118361915862753283840020E-02,
    -0.60797252705247911780653153363999E-03,
    -0.73706498620176629330681411493484E-04,
    +0.48732857449450183453464992488076E-04,
    -0.23837064840448290766588489460235E-05,
    -0.30518612628561521027027332246121E-05,
    +0.17050331572564559009688032992907E-06,
    +0.23834204527487747258601598136403E-06,
    +0.10781772556163166562596872364020E-07,
    -0.17955692847399102653642691446599E-07,
    -0.41284072341950457727912394640436E-08,
    +0.68622148588631968618346844526664E-09,
    +0.53130183120506356147602009675961E-09,
    +0.78796880261490694831305022893515E-10,
    -0.26261762329356522290341675271232E-10,
    -0.15483687636308261963125756294100E-10,
    -0.25818962377261390492802405122591E-11,
    +0.59542879191591072658903529959352E-12,
    +0.46451400387681525833784919321405E-12,
    +0.11557855023255861496288006203731E-12,
    -0.10475236870835799012317547189670E-14,
    -0.11896653502709004368104489260929E-13,
    -0.47749077490261778752643019349950E-14,
    -0.81077649615772777976249734754135E-15,
    +0.13435569250031554199376987998178E-15,
    +0.14134530022913106260248873881287E-15,
    +0.49451592573953173115520663232883E-16,
    +0.79884048480080665648858587399367E-17,
    -0.14008632188089809829248711935393E-17,
    -0.14814246958417372107722804001680E-17,
    -0.55826173646025601904010693937113E-18,
    -0.11442074542191647264783072544598E-18,
    +0.25371823879566853500524018479923E-20,
    +0.13205328154805359813278863389097E-19,
    +0.62930261081586809166287426789485E-20,
    +0.17688270424882713734999261332548E-20,
    +0.23266187985146045209674296887432E-21,
    -0.67803060811125233043773831844113E-22,
    -0.59440876959676373802874150531891E-22,
    -0.23618214531184415968532592503466E-22,
    -0.60214499724601478214168478744576E-23,
    -0.65517906474348299071370444144639E-24,
    +0.29388755297497724587042038699349E-24,
    +0.22601606200642115173215728758510E-24,
    +0.89534369245958628745091206873087E-25,
    +0.24015923471098457555772067457706E-25,
    +0.34118376888907172955666423043413E-26,
    -0.71617071694630342052355013345279E-27,
    -0.75620390659281725157928651980799E-27,
    -0.33774612157467324637952920780800E-27,
    -0.10479325703300941711526430332245E-27,
    -0.21654550252170342240854880201386E-28,
    -0.75297125745288269994689298432000E-30,
    +0.19103179392798935768638084000426E-29,
    +0.11492104966530338547790728833706E-29,
    +0.43896970582661751514410359193600E-30,
    +0.12320883239205686471647157725866E-30,
    +0.22220174457553175317538581162666E-31 };
  static double ae12cs[41] = {
    +0.63629589796747038767129887806803,
    -0.13081168675067634385812671121135,
    -0.84367410213053930014487662129752E-02,
    +0.26568491531006685413029428068906E-02,
    +0.32822721781658133778792170142517E-03,
    -0.23783447771430248269579807851050E-04,
    -0.11439804308100055514447076797047E-04,
    -0.14405943433238338455239717699323E-05,
    +0.52415956651148829963772818061664E-08,
    +0.38407306407844323480979203059716E-07,
    +0.85880244860267195879660515759344E-08,
    +0.10219226625855003286339969553911E-08,
    +0.21749132323289724542821339805992E-10,
    -0.22090238142623144809523503811741E-10,
    -0.63457533544928753294383622208801E-11,
    -0.10837746566857661115340539732919E-11,
    -0.11909822872222586730262200440277E-12,
    -0.28438682389265590299508766008661E-14,
    +0.25080327026686769668587195487546E-14,
    +0.78729641528559842431597726421265E-15,
    +0.15475066347785217148484334637329E-15,
    +0.22575322831665075055272608197290E-16,
    +0.22233352867266608760281380836693E-17,
    +0.16967819563544153513464194662399E-19,
    -0.57608316255947682105310087304533E-19,
    -0.17591235774646878055625369408853E-19,
    -0.36286056375103174394755328682666E-20,
    -0.59235569797328991652558143488000E-21,
    -0.76030380926310191114429136895999E-22,
    -0.62547843521711763842641428479999E-23,
    +0.25483360759307648606037606400000E-24,
    +0.25598615731739857020168874666666E-24,
    +0.71376239357899318800207052800000E-25,
    +0.14703759939567568181578956800000E-25,
    +0.25105524765386733555198634666666E-26,
    +0.35886666387790890886583637333333E-27,
    +0.39886035156771301763317759999999E-28,
    +0.21763676947356220478805333333333E-29,
    -0.46146998487618942367607466666666E-30,
    -0.20713517877481987707153066666666E-30,
    -0.51890378563534371596970666666666E-31 };
  static double ae13cs[50] = {
    -0.60577324664060345999319382737747,
    -0.11253524348366090030649768852718,
    +0.13432266247902779492487859329414E-01,
    -0.19268451873811457249246838991303E-02,
    +0.30911833772060318335586737475368E-03,
    -0.53564132129618418776393559795147E-04,
    +0.98278128802474923952491882717237E-05,
    -0.18853689849165182826902891938910E-05,
    +0.37494319356894735406964042190531E-06,
    -0.76823455870552639273733465680556E-07,
    +0.16143270567198777552956300060868E-07,
    -0.34668022114907354566309060226027E-08,
    +0.75875420919036277572889747054114E-09,
    -0.16886433329881412573514526636703E-09,
    +0.38145706749552265682804250927272E-10,
    -0.87330266324446292706851718272334E-11,
    +0.20236728645867960961794311064330E-11,
    -0.47413283039555834655210340820160E-12,
    +0.11221172048389864324731799928920E-12,
    -0.26804225434840309912826809093395E-13,
    +0.64578514417716530343580369067212E-14,
    -0.15682760501666478830305702849194E-14,
    +0.38367865399315404861821516441408E-15,
    -0.94517173027579130478871048932556E-16,
    +0.23434812288949573293896666439133E-16,
    -0.58458661580214714576123194419882E-17,
    +0.14666229867947778605873617419195E-17,
    -0.36993923476444472706592538274474E-18,
    +0.93790159936721242136014291817813E-19,
    -0.23893673221937873136308224087381E-19,
    +0.61150624629497608051934223837866E-20,
    -0.15718585327554025507719853288106E-20,
    +0.40572387285585397769519294491306E-21,
    -0.10514026554738034990566367122773E-21,
    +0.27349664930638667785806003131733E-22,
    -0.71401604080205796099355574271999E-23,
    +0.18705552432235079986756924211199E-23,
    -0.49167468166870480520478020949333E-24,
    +0.12964988119684031730916087125333E-24,
    -0.34292515688362864461623940437333E-25,
    +0.90972241643887034329104820906666E-26,
    -0.24202112314316856489934847999999E-26,
    +0.64563612934639510757670475093333E-27,
    -0.17269132735340541122315987626666E-27,
    +0.46308611659151500715194231466666E-28,
    -0.12448703637214131241755170133333E-28,
    +0.33544574090520678532907007999999E-29,
    -0.90598868521070774437543935999999E-30,
    +0.24524147051474238587273216000000E-30,
    -0.66528178733552062817107967999999E-31 };
  static double ae14cs[64] = {
    -0.1892918000753016825495679942820,
    -0.8648117855259871489968817056824E-01,
    +0.7224101543746594747021514839184E-02,
    -0.8097559457557386197159655610181E-03,
    +0.1099913443266138867179251157002E-03,
    -0.1717332998937767371495358814487E-04,
    +0.2985627514479283322825342495003E-05,
    -0.5659649145771930056560167267155E-06,
    +0.1152680839714140019226583501663E-06,
    -0.2495030440269338228842128765065E-07,
    +0.5692324201833754367039370368140E-08,
    -0.1359957664805600338490030939176E-08,
    +0.3384662888760884590184512925859E-09,
    -0.8737853904474681952350849316580E-10,
    +0.2331588663222659718612613400470E-10,
    -0.6411481049213785969753165196326E-11,
    +0.1812246980204816433384359484682E-11,
    -0.5253831761558460688819403840466E-12,
    +0.1559218272591925698855028609825E-12,
    -0.4729168297080398718476429369466E-13,
    +0.1463761864393243502076199493808E-13,
    -0.4617388988712924102232173623604E-14,
    +0.1482710348289369323789239660371E-14,
    -0.4841672496239229146973165734417E-15,
    +0.1606215575700290408116571966188E-15,
    -0.5408917538957170947895023784252E-16,
    +0.1847470159346897881370231402310E-16,
    -0.6395830792759094470500610425050E-17,
    +0.2242780721699759457250233276170E-17,
    -0.7961369173983947552744555308646E-18,
    +0.2859308111540197459808619929272E-18,
    -0.1038450244701137145900697137446E-18,
    +0.3812040607097975780866841008319E-19,
    -0.1413795417717200768717562723696E-19,
    +0.5295367865182740958305442594815E-20,
    -0.2002264245026825902137211131439E-20,
    +0.7640262751275196014736848610918E-21,
    -0.2941119006868787883311263523362E-21,
    +0.1141823539078927193037691483586E-21,
    -0.4469308475955298425247020718489E-22,
    +0.1763262410571750770630491408520E-22,
    -0.7009968187925902356351518262340E-23,
    +0.2807573556558378922287757507515E-23,
    -0.1132560944981086432141888891562E-23,
    +0.4600574684375017946156764233727E-24,
    -0.1881448598976133459864609148108E-24,
    +0.7744916111507730845444328478037E-25,
    -0.3208512760585368926702703826261E-25,
    +0.1337445542910839760619930421384E-25,
    -0.5608671881802217048894771735210E-26,
    +0.2365839716528537483710069473279E-26,
    -0.1003656195025305334065834526856E-26,
    +0.4281490878094161131286642556927E-27,
    -0.1836345261815318199691326958250E-27,
    +0.7917798231349540000097468678144E-28,
    -0.3431542358742220361025015775231E-28,
    +0.1494705493897103237475066008917E-28,
    -0.6542620279865705439739042420053E-29,
    +0.2877581395199171114340487353685E-29,
    -0.1271557211796024711027981200042E-29,
    +0.5644615555648722522388044622506E-30,
    -0.2516994994284095106080616830293E-30,
    +0.1127259818927510206370368804181E-30,
    -0.5069814875800460855562584719360E-31 };
  static double e11cs[29] = {
    -0.16113461655571494025720663927566180E+02,
    +0.77940727787426802769272245891741497E+01,
    -0.19554058188631419507127283812814491E+01,
    +0.37337293866277945611517190865690209,
    -0.56925031910929019385263892220051166E-01,
    +0.72110777696600918537847724812635813E-02,
    -0.78104901449841593997715184089064148E-03,
    +0.73880933562621681878974881366177858E-04,
    -0.62028618758082045134358133607909712E-05,
    +0.46816002303176735524405823868362657E-06,
    -0.32092888533298649524072553027228719E-07,
    +0.20151997487404533394826262213019548E-08,
    -0.11673686816697793105356271695015419E-09,
    +0.62762706672039943397788748379615573E-11,
    -0.31481541672275441045246781802393600E-12,
    +0.14799041744493474210894472251733333E-13,
    -0.65457091583979673774263401588053333E-15,
    +0.27336872223137291142508012748799999E-16,
    -0.10813524349754406876721727624533333E-17,
    +0.40628328040434303295300348586666666E-19,
    -0.14535539358960455858914372266666666E-20,
    +0.49632746181648636830198442666666666E-22,
    -0.16208612696636044604866560000000000E-23,
    +0.50721448038607422226431999999999999E-25,
    -0.15235811133372207813973333333333333E-26,
    +0.44001511256103618696533333333333333E-28,
    -0.12236141945416231594666666666666666E-29,
    +0.32809216661066001066666666666666666E-31,
    -0.84933452268306432000000000000000000E-33 };
  static double e12cs[25] = {
    -0.3739021479220279511668698204827E-01,
    +0.4272398606220957726049179176528E-01,
    -0.130318207984970054415392055219726,
    +0.144191240246988907341095893982137E-01,
    -0.134617078051068022116121527983553E-02,
    +0.107310292530637799976115850970073E-03,
    -0.742999951611943649610283062223163E-05,
    +0.453773256907537139386383211511827E-06,
    -0.247641721139060131846547423802912E-07,
    +0.122076581374590953700228167846102E-08,
    -0.548514148064092393821357398028261E-10,
    +0.226362142130078799293688162377002E-11,
    -0.863589727169800979404172916282240E-13,
    +0.306291553669332997581032894881279E-14,
    -0.101485718855944147557128906734933E-15,
    +0.315482174034069877546855328426666E-17,
    -0.923604240769240954484015923200000E-19,
    +0.255504267970814002440435029333333E-20,
    -0.669912805684566847217882453333333E-22,
    +0.166925405435387319431987199999999E-23,
    -0.396254925184379641856000000000000E-25,
    +0.898135896598511332010666666666666E-27,
    -0.194763366993016433322666666666666E-28,
    +0.404836019024630033066666666666666E-30,
    -0.807981567699845120000000000000000E-32 };
  double eta;
  static int ntae10 = 0;
  static int ntae11 = 0;
  static int ntae12 = 0;
  static int ntae13 = 0;
  static int ntae14 = 0;
  static int nte11 = 0;
  static int nte12 = 0;
  double value;
  static double xmax = 0.0;

  if ( ntae10 == 0 )
  {
    eta = 0.1 * r8_mach ( 3 );
    ntae10 = r8_inits ( ae10cs, 50, eta );
    ntae11 = r8_inits ( ae11cs, 60, eta );
    ntae12 = r8_inits ( ae12cs, 41, eta );
    nte11 = r8_inits ( e11cs, 29, eta );
    nte12 = r8_inits ( e12cs, 25, eta );
    ntae13 = r8_inits ( ae13cs, 50, eta );
    ntae14 = r8_inits ( ae14cs, 64, eta );
    xmax = - log ( r8_mach ( 1 ) );
    xmax = xmax - log ( xmax );
  }

  if ( x <= - 32.0 )
  {
    value = exp ( - x ) / x * ( 1.0 
      + r8_csevl ( 64.0 / x + 1.0, ae10cs, ntae10 ) );
  }
  else if ( x <= - 8.0 )
  {
    value = exp ( - x ) / x * ( 1.0 
      + r8_csevl ( ( 64.0 / x + 5.0 ) / 3.0, ae11cs, ntae11 ) );
  }
  else if ( x <= - 4.0 )
  {
    value = exp ( - x ) / x * (1.0 
      + r8_csevl ( 16.0 / x + 3.0, ae12cs, ntae12 ) );
  }
  else if ( x <= - 1.0 )
  {
    value = - log ( - x ) 
      + r8_csevl ( ( 2.0 * x + 5.0 ) / 3.0, e11cs, nte11 );
  }
  else if ( x == 0.0 )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R8_E1 - Fatal error!\n" );
    fprintf ( stderr, "  X is zero.\n" );
    exit ( 1 );
  }
  else if ( x <= 1.0 )
  {
    value = ( - log ( fabs ( x ) ) - 0.6875 + x ) 
      + r8_csevl ( x, e12cs, nte12 );
  }
  else if ( x <= 4.0 )
  {
    value = exp ( - x ) / x * ( 1.0 
      + r8_csevl ( ( 8.0 / x - 5.0 ) / 3.0, ae13cs, ntae13 ) );
  }
  else if ( x <= xmax )
  {
    value = exp ( - x ) / x * ( 1.0 
      + r8_csevl ( 8.0 / x - 1.0, ae14cs, ntae14 ) );
  }
  else
  {
    value = 0.0;
  }
  return value;
}
/******************************************************************************/

double r8_ei ( double x )

/******************************************************************************/
/*
  Purpose:

    R8_EI evaluates the exponential integral Ei for an R8 argument.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, double X, the argument.

    Output, double R8_EI, the exponential integral Ei evaluated at X.
*/
{
  double value;

  value = - r8_e1 ( - x );

  return value;
}
/******************************************************************************/

double r8_erf ( double x )

/******************************************************************************/
/*
  Purpose:

    R8_ERF evaluates the error function of an R8 argument.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, double X, the argument.

    Output, double R8_ERF, the error function of X.
*/
{
  static double erfcs[21] = {
    -0.49046121234691808039984544033376E-01,
    -0.14226120510371364237824741899631,
    +0.10035582187599795575754676712933E-01,
    -0.57687646997674847650827025509167E-03,
    +0.27419931252196061034422160791471E-04,
    -0.11043175507344507604135381295905E-05,
    +0.38488755420345036949961311498174E-07,
    -0.11808582533875466969631751801581E-08,
    +0.32334215826050909646402930953354E-10,
    -0.79910159470045487581607374708595E-12,
    +0.17990725113961455611967245486634E-13,
    -0.37186354878186926382316828209493E-15,
    +0.71035990037142529711689908394666E-17,
    -0.12612455119155225832495424853333E-18,
    +0.20916406941769294369170500266666E-20,
    -0.32539731029314072982364160000000E-22,
    +0.47668672097976748332373333333333E-24,
    -0.65980120782851343155199999999999E-26,
    +0.86550114699637626197333333333333E-28,
    -0.10788925177498064213333333333333E-29,
    +0.12811883993017002666666666666666E-31 };
  static int nterf = 0;
  static double sqeps = 0.0;
  const double sqrtpi = 1.77245385090551602729816748334115;
  double value;
  static double xbig = 0.0;
  double y;

  if ( nterf == 0 )
  {
    nterf = r8_inits ( erfcs, 21, 0.1 * r8_mach ( 3 ) );
    xbig = sqrt ( - log ( sqrtpi * r8_mach ( 3 ) ) );
    sqeps = sqrt ( 2.0 * r8_mach ( 3 ) );
  }

  y = fabs ( x );

  if ( y <= sqeps )
  {
    value = 2.0 * x / sqrtpi;
  }
  else if ( y <= 1.0 )
  {
    value = x * ( 1.0 + r8_csevl ( 2.0 * x * x - 1.0, erfcs, nterf ) );
  }
  else if ( y <= xbig )
  {
    value = 1.0 - r8_erfc ( y );
    if ( x < 0.0 )
    {
      value = - value;
    }
  }
  else
  {
    value = 1.0;
    if ( x < 0.0 )
    {
      value = - value;
    }
  }
  return value;
}
/******************************************************************************/

double r8_erfc ( double x )

/******************************************************************************/
/*
  Purpose:

    R8_ERFC evaluates the co-error function of an R8 argument.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, double X, the argument.

    Output, double R8_ERFC, the co-error function of X.
*/
{
  static double erc2cs[49] = {
    -0.6960134660230950112739150826197E-01,
    -0.4110133936262089348982212084666E-01,
    +0.3914495866689626881561143705244E-02,
    -0.4906395650548979161280935450774E-03,
    +0.7157479001377036380760894141825E-04,
    -0.1153071634131232833808232847912E-04,
    +0.1994670590201997635052314867709E-05,
    -0.3642666471599222873936118430711E-06,
    +0.6944372610005012589931277214633E-07,
    -0.1371220902104366019534605141210E-07,
    +0.2788389661007137131963860348087E-08,
    -0.5814164724331161551864791050316E-09,
    +0.1238920491752753181180168817950E-09,
    -0.2690639145306743432390424937889E-10,
    +0.5942614350847910982444709683840E-11,
    -0.1332386735758119579287754420570E-11,
    +0.3028046806177132017173697243304E-12,
    -0.6966648814941032588795867588954E-13,
    +0.1620854541053922969812893227628E-13,
    -0.3809934465250491999876913057729E-14,
    +0.9040487815978831149368971012975E-15,
    -0.2164006195089607347809812047003E-15,
    +0.5222102233995854984607980244172E-16,
    -0.1269729602364555336372415527780E-16,
    +0.3109145504276197583836227412951E-17,
    -0.7663762920320385524009566714811E-18,
    +0.1900819251362745202536929733290E-18,
    -0.4742207279069039545225655999965E-19,
    +0.1189649200076528382880683078451E-19,
    -0.3000035590325780256845271313066E-20,
    +0.7602993453043246173019385277098E-21,
    -0.1935909447606872881569811049130E-21,
    +0.4951399124773337881000042386773E-22,
    -0.1271807481336371879608621989888E-22,
    +0.3280049600469513043315841652053E-23,
    -0.8492320176822896568924792422399E-24,
    +0.2206917892807560223519879987199E-24,
    -0.5755617245696528498312819507199E-25,
    +0.1506191533639234250354144051199E-25,
    -0.3954502959018796953104285695999E-26,
    +0.1041529704151500979984645051733E-26,
    -0.2751487795278765079450178901333E-27,
    +0.7290058205497557408997703680000E-28,
    -0.1936939645915947804077501098666E-28,
    +0.5160357112051487298370054826666E-29,
    -0.1378419322193094099389644800000E-29,
    +0.3691326793107069042251093333333E-30,
    -0.9909389590624365420653226666666E-31,
    +0.2666491705195388413323946666666E-31 };
  static double erfccs[59] = {
    +0.715179310202924774503697709496E-01,
    -0.265324343376067157558893386681E-01,
    +0.171115397792085588332699194606E-02,
    -0.163751663458517884163746404749E-03,
    +0.198712935005520364995974806758E-04,
    -0.284371241276655508750175183152E-05,
    +0.460616130896313036969379968464E-06,
    -0.822775302587920842057766536366E-07,
    +0.159214187277090112989358340826E-07,
    -0.329507136225284321486631665072E-08,
    +0.722343976040055546581261153890E-09,
    -0.166485581339872959344695966886E-09,
    +0.401039258823766482077671768814E-10,
    -0.100481621442573113272170176283E-10,
    +0.260827591330033380859341009439E-11,
    -0.699111056040402486557697812476E-12,
    +0.192949233326170708624205749803E-12,
    -0.547013118875433106490125085271E-13,
    +0.158966330976269744839084032762E-13,
    -0.472689398019755483920369584290E-14,
    +0.143587337678498478672873997840E-14,
    -0.444951056181735839417250062829E-15,
    +0.140481088476823343737305537466E-15,
    -0.451381838776421089625963281623E-16,
    +0.147452154104513307787018713262E-16,
    -0.489262140694577615436841552532E-17,
    +0.164761214141064673895301522827E-17,
    -0.562681717632940809299928521323E-18,
    +0.194744338223207851429197867821E-18,
    -0.682630564294842072956664144723E-19,
    +0.242198888729864924018301125438E-19,
    -0.869341413350307042563800861857E-20,
    +0.315518034622808557122363401262E-20,
    -0.115737232404960874261239486742E-20,
    +0.428894716160565394623737097442E-21,
    -0.160503074205761685005737770964E-21,
    +0.606329875745380264495069923027E-22,
    -0.231140425169795849098840801367E-22,
    +0.888877854066188552554702955697E-23,
    -0.344726057665137652230718495566E-23,
    +0.134786546020696506827582774181E-23,
    -0.531179407112502173645873201807E-24,
    +0.210934105861978316828954734537E-24,
    -0.843836558792378911598133256738E-25,
    +0.339998252494520890627359576337E-25,
    -0.137945238807324209002238377110E-25,
    +0.563449031183325261513392634811E-26,
    -0.231649043447706544823427752700E-26,
    +0.958446284460181015263158381226E-27,
    -0.399072288033010972624224850193E-27,
    +0.167212922594447736017228709669E-27,
    -0.704599152276601385638803782587E-28,
    +0.297976840286420635412357989444E-28,
    -0.126252246646061929722422632994E-28,
    +0.539543870454248793985299653154E-29,
    -0.238099288253145918675346190062E-29,
    +0.109905283010276157359726683750E-29,
    -0.486771374164496572732518677435E-30,
    +0.152587726411035756763200828211E-30 };
  static double erfcs[21] = {
    -0.49046121234691808039984544033376E-01,
    -0.14226120510371364237824741899631,
    +0.10035582187599795575754676712933E-01,
    -0.57687646997674847650827025509167E-03,
    +0.27419931252196061034422160791471E-04,
    -0.11043175507344507604135381295905E-05,
    +0.38488755420345036949961311498174E-07,
    -0.11808582533875466969631751801581E-08,
    +0.32334215826050909646402930953354E-10,
    -0.79910159470045487581607374708595E-12,
    +0.17990725113961455611967245486634E-13,
    -0.37186354878186926382316828209493E-15,
    +0.71035990037142529711689908394666E-17,
    -0.12612455119155225832495424853333E-18,
    +0.20916406941769294369170500266666E-20,
    -0.32539731029314072982364160000000E-22,
    +0.47668672097976748332373333333333E-24,
    -0.65980120782851343155199999999999E-26,
    +0.86550114699637626197333333333333E-28,
    -0.10788925177498064213333333333333E-29,
    +0.12811883993017002666666666666666E-31 };
  double eta;
  static int nterc2 = 0;
  static int nterf = 0;
  static int nterfc = 0;
  static double sqeps = 0.0;
  const double sqrtpi = 1.77245385090551602729816748334115;
  double value;
  static double xmax = 0.0;
  static double xsml = 0.0;
  double y;

  if ( nterf == 0 )
  {
    eta = 0.1 * r8_mach ( 3 );
    nterf = r8_inits ( erfcs, 21, eta );
    nterfc = r8_inits ( erfccs, 59, eta );
    nterc2 = r8_inits ( erc2cs, 49, eta );

    xsml = - sqrt ( - log ( sqrtpi * r8_mach ( 3 ) ) );
    xmax = sqrt (- log ( sqrtpi * r8_mach ( 1 ) ) );
    xmax = xmax - 0.5 * log ( xmax ) / xmax - 0.01;
    sqeps = sqrt ( 2.0 * r8_mach ( 3 ) );
  }

  if ( x <= xsml )
  {
    value = 2.0;
    return value;
  }

  if ( xmax < x )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R8_ERFC - Warning!\n" );
    fprintf ( stderr, "  X so big that ERFC underflows.\n" );
    value = 0.0;
    return value;
  }

  y = fabs ( x );

  if ( y < sqeps )
  {
    value = 1.0 - 2.0 * x / sqrtpi;
    return value;
  }
  else if ( y <= 1.0 )
  {
    value = 1.0 - x * ( 1.0 
      + r8_csevl ( 2.0 * x * x - 1.0, erfcs, nterf ) );
    return value;
  }

  y = y * y;

  if ( y <= 4.0 )
  {
    value = exp ( - y ) / fabs ( x ) * ( 0.5 
      + r8_csevl ( ( 8.0 / y - 5.0 ) / 3.0, erc2cs, nterc2 ) );
  }
  else 
  {
    value = exp ( - y ) / fabs ( x ) * ( 0.5 
      + r8_csevl ( 8.0 / y - 1.0, erfccs, nterfc ) );
  }

  if ( x < 0.0 )
  {
    value = 2.0 - value;
  }

  return value;
}
/******************************************************************************/

double r8_exp ( double x )

/******************************************************************************/
/*
  Purpose:

    R8_EXP evaluates the exponential of an R8 argument.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, double X, the argument.

    Output, double R8_EXP, the exponential of X.
*/
{
  const double aln216 = +0.83120654223414517758794896030274E-01;
  static double expcs[14] = {
    +0.866569493314985712733404647266231E-01,
    +0.938494869299839561896336579701203E-03,
    +0.677603970998168264074353014653601E-05,
    +0.366931200393805927801891250687610E-07,
    +0.158959053617461844641928517821508E-09,
    +0.573859878630206601252990815262106E-12,
    +0.177574448591421511802306980226000E-14,
    +0.480799166842372422675950244533333E-17,
    +0.115716376881828572809260000000000E-19,
    +0.250650610255497719932458666666666E-22,
    +0.493571708140495828480000000000000E-25,
    +0.890929572740634240000000000000000E-28,
    +0.148448062907997866666666666666666E-30,
    +0.229678916630186666666666666666666E-33 };
  double f;
  int n;
  int n16;
  int ndx;
  static int nterms = 0;
  static double twon16[17] = {
    +0.0,
    +0.44273782427413840321966478739929E-01,
    +0.90507732665257659207010655760707E-01,
    +0.13878863475669165370383028384151,
    +0.18920711500272106671749997056047,
    +0.24185781207348404859367746872659,
    +0.29683955465100966593375411779245,
    +0.35425554693689272829801474014070,
    +0.41421356237309504880168872420969,
    +0.47682614593949931138690748037404,
    +0.54221082540794082361229186209073,
    +0.61049033194925430817952066735740,
    +0.68179283050742908606225095246642,
    +0.75625216037329948311216061937531,
    +0.83400808640934246348708318958828,
    +0.91520656139714729387261127029583,
    +1.0 };
  double value;
  double xint;
  static double xmax;
  static double xmin;
  double y;

  if ( nterms == 0 )
  {
    nterms = r8_inits ( expcs, 14, 0.1 * r8_mach ( 3 ) );
    xmin = log ( r8_mach ( 1 ) ) + 0.01;
    xmax = log ( r8_mach ( 2 ) ) - 0.001;
  }

  if ( x < xmin )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R8_EXP - Warning!\n" );
    fprintf ( stderr, "  X so small that exp(X) underflows.\n" );
    value = 0.0;
  }
  else if ( x <= xmax )
  {
    xint = r8_aint ( x );
    y = x - xint;

    y = 23.0 * y + x * aln216;
    n = ( int ) ( y );
    f = y - ( double ) ( n );
    n = 23.0 * xint + ( double ) ( n );
    n16 = n / 16;
    if ( n < 0 )
    {
      n16 = n16 - 1;
    }
    ndx = n - 16 * n16 + 1;

    value = 1.0 + ( twon16[ndx-1] + f * ( 1.0 + twon16[ndx-1] ) 
      * r8_csevl ( f, expcs, nterms ) );

    value = r8_pak ( value, n16 );
  }
  else
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R8_EXP - Fatal error!\n" );
    fprintf ( stderr, "  X so large that exp(X) overflows.\n" );
    exit ( 1 );
  }
  return value;
}
/******************************************************************************/

double r8_exprel ( double x )

/******************************************************************************/
/*
  Purpose:

    R8_EXPREL evaluates the exponential relative error term of an R8 argument.

  Discussion:

    The relative error term is ( exp ( x ) - 1 ) / x.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, double X, the argument.

    Output, double R8_EXPREL, the exponential relative error term
    at X.
*/
{
  double absx;
  double alneps;
  int i;
  static int nterms = 0;
  double value;
  static double xbnd = 0.0;
  double xln;
  double xn;

  if ( nterms == 0 )
  {
    alneps = log ( r8_mach ( 3 ) );
    xn = 3.72 - 0.3 * alneps;
    xln = log ( ( xn + 1.0 ) / 1.36 );
    nterms = ( int ) ( xn - ( xn * xln + alneps ) / ( xln + 1.36 ) + 1.5 );
    xbnd = r8_mach ( 3 );
  }

  absx = fabs ( x );

  if ( absx < xbnd )
  {
    value = 1.0;
  }
  else if ( absx <= 0.5 )
  {
    value = 0.0;
    for ( i = 1; i <= nterms; i++ )
    {
      value = 1.0 + value * x / ( double ) ( nterms + 2 - i );
    }
  }
  else
  {
    value = ( exp ( x ) - 1.0 ) / x;
  }
  return value;
}
/******************************************************************************/

double r8_fac ( int n )

/******************************************************************************/
/*
  Purpose:

    R8_FAC evaluates the factorial of an I4 argument.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, int N, the argument.

    Output, double R8_FAC, the factorial of N.
*/
{
  static double facn[31] = {
    +0.100000000000000000000000000000000E+01,
    +0.100000000000000000000000000000000E+01,
    +0.200000000000000000000000000000000E+01,
    +0.600000000000000000000000000000000E+01,
    +0.240000000000000000000000000000000E+02,
    +0.120000000000000000000000000000000E+03,
    +0.720000000000000000000000000000000E+03,
    +0.504000000000000000000000000000000E+04,
    +0.403200000000000000000000000000000E+05,
    +0.362880000000000000000000000000000E+06,
    +0.362880000000000000000000000000000E+07,
    +0.399168000000000000000000000000000E+08,
    +0.479001600000000000000000000000000E+09,
    +0.622702080000000000000000000000000E+10,
    +0.871782912000000000000000000000000E+11,
    +0.130767436800000000000000000000000E+13,
    +0.209227898880000000000000000000000E+14,
    +0.355687428096000000000000000000000E+15,
    +0.640237370572800000000000000000000E+16,
    +0.121645100408832000000000000000000E+18,
    +0.243290200817664000000000000000000E+19,
    +0.510909421717094400000000000000000E+20,
    +0.112400072777760768000000000000000E+22,
    +0.258520167388849766400000000000000E+23,
    +0.620448401733239439360000000000000E+24,
    +0.155112100433309859840000000000000E+26,
    +0.403291461126605635584000000000000E+27,
    +0.108888694504183521607680000000000E+29,
    +0.304888344611713860501504000000000E+30,
    +0.884176199373970195454361600000000E+31,
    +0.265252859812191058636308480000000E+33 };
  static int nmax = 0;
  const double sq2pil = 0.91893853320467274178032973640562;
  double value;
  double x;
  double xmax;
  double xmin;

  if ( nmax == 0 )
  {
    r8_gaml ( &xmin, &xmax );
    nmax = ( int ) ( xmax - 1.0 );
  }

  if ( n < 0 )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R8_FAC - Fatal error!\n" );
    fprintf ( stderr, "  Input argument is negative.\n" );
    exit ( 1 );
  }
  else if ( n <= 30 )
  {
    value = facn[n];
  }
  else if ( n <= nmax )
  {
    x = ( double ) ( n + 1 );
    value = exp ( ( x - 0.5 ) * log ( x ) - x + sq2pil + r8_lgmc ( x ) );
  }
  else
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R8_FAC - Fatal error!\n" );
    fprintf ( stderr, "  Factorial overflows.\n" );
    exit ( 1 );
  }
  return value;
}
/******************************************************************************/

double r8_gami ( double a, double x )

/******************************************************************************/
/*
  Purpose:

    R8_GAMI evaluates the incomplete gamma function for an R8 argument.

  Discussion:

    GAMI = Integral ( 0 <= T <= X ) exp ( - t ) * t^( a - 1 )  dt

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, double A, the parameter.

    Input, double X, the argument.

    Output, double R8_GAMI, the value of the incomplete gamma function.
*/
{
  double factor;
  double value;

  if ( a <= 0.0 )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R8_GAMI - Fatal error!\n" );
    fprintf ( stderr, "  A <= 0.\n" );
    exit ( 1 );
  }

  if ( x < 0.0 )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R8_GAMI - Fatal error!\n" );
    fprintf ( stderr, "  X < 0.\n" );
    exit ( 1 );
  }
  else if ( x == 0.0 )
  {
    value = 0.0;
  }
  else
  {
    factor = exp ( r8_lngam ( a ) + a * log ( x ) );
    value = factor * r8_gamit ( a, x );
  }
  return value;
}
/******************************************************************************/

double r8_gamic ( double a, double x )

/******************************************************************************/
/*
  Purpose:

    R8_GAMIC evaluates the complementary incomplete gamma function.

  Discussion:

    GAMIC = integral ( x <= t < oo ) exp(-t) * t^(a-1) dt

    GAMIC is evaluated for arbitrary real values of A and non-negative
    values X (even though GAMIC is defined for X < 0.0), except that
    for X = 0 and A <= 0.0, GAMIC is undefined.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

    Walter Gautschi,
    A Computational Procedure for Incomplete Gamma Functions,
    ACM Transactions on Mathematical Software,
    Volume 5, Number 4, December 1979, pages 466-481.

  Parameters:

    Input, double A, the parameter.

    Input, double X, the evaluation point.

    Output, double R8_GAMIC, the value of the incomplete 
    gamma function.
*/
{
  double aeps;
  double ainta;
  double algap1;
  static double alneps = 0.0;
  double alngs;
  double alx;
  double e;
  static double eps = 0.0;
  double gstar;
  double h;
  int izero;
  double sga;
  double sgng;
  double sgngam;
  double sgngs;
  double t;
  double value;

  if ( eps == 0.0 )
  {
    eps = 0.5 * r8_mach ( 3 );
    alneps = - log ( r8_mach ( 3 ) );
  }

  if ( x < 0.0 )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R8_GAMIC - Fatal error!\n" );
    fprintf ( stderr, "  X < 0.\n" );
    exit ( 1 );
  }

  if ( x == 0.0 )
  {
    if ( a <= 0.0 )
    {
      fprintf ( stderr, "\n" );
      fprintf ( stderr, "R8_GAMIC - Fatal error!\n" );
      fprintf ( stderr, "  X = 0 and A <= 0.\n" );
      exit ( 1 );
    }
    value = exp ( r8_lngam ( a + 1.0 ) - log ( a ) );

    return value;
  }

  alx = log ( x );
  if ( a < 0.0 )
  {
    sga = - 1.0;
  }
  else
  {
    sga = + 1.0;
  }

  ainta = r8_aint ( a + 0.5 * sga );
  aeps = a - ainta;

  izero = 0;

  if ( x < 1.0 )
  {
    if ( a <= 0.5 && fabs ( aeps ) <= 0.001 )
    {
      if ( - ainta <= 1.0 )
      {
        e = 2.0;
      }
      else
      {
        e = 2.0 * ( - ainta + 2.0 ) / ( ainta * ainta - 1.0 );
      }
      e = e - alx * r8_power ( x, - 0.001 );

      if ( e * fabs ( aeps ) <= eps )
      {
        value = r8_gmic ( a, x, alx );
        return value;
      }
    }

    r8_lgams ( a + 1.0, &algap1, &sgngam );
    gstar = r8_gmit ( a, x, algap1, sgngam, alx );

    if ( gstar == 0.0 )
    {
      izero = 1;
    }
    else
    {
      alngs = log ( fabs ( gstar ) );
      sgngs = r8_sign ( gstar );
    }
  }
  else
  {
    if ( a < x )
    {
      value = exp ( r8_lgic ( a, x, alx ) );
      return value;
    }

    sgngam = 1.0;
    algap1 = r8_lngam ( a + 1.0 );
    sgngs = 1.0;
    alngs = r8_lgit ( a, x, algap1 );
  }

  h = 1.0;

  if ( izero != 1 )
  {
    t = a * alx + alngs;

    if ( alneps < t )
    {
      sgng = - sgngs * sga * sgngam;
      t = t + algap1 - log ( fabs ( a ) );
      value = sgng * exp ( t );
      return value;
    }

    if ( - alneps < t )
    {
      h = 1.0 - sgngs * exp ( t );
    }
  }
  sgng = r8_sign ( h ) * sga * sgngam;
  t = log ( fabs ( h ) ) + algap1 - log ( fabs ( a ) );
  value = sgng * exp ( t );

  return value;
}
/******************************************************************************/

double r8_gamit ( double a, double x )

/******************************************************************************/
/*
  Purpose:

    R8_GAMIT evaluates Tricomi's incomplete gamma function for an R8 argument.

  Discussion:

      GAMIT = x^(-a) / gamma(a) 
        * Integral ( 0 <= t <= x ) exp(-t) * t^(a-1) dt

    with analytic continuation for a <= 0.0.  Gamma(x) is the complete
    gamma function of X.  GAMIT is evaluated for arbitrary real values of
    A and for non-negative values of X (even though GAMIT is defined for
    X < 0.0).

    A slight deterioration of 2 or 3 digits accuracy will occur when
    gamit is very large or very small in absolute value, because log-
    arithmic variables are used.  Also, if the parameter A is very close
    to a negative integer (but not a negative integer), there is a loss
    of accuracy.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

    Walter Gautschi,
    A Computational Procedure for Incomplete Gamma Functions,
    ACM Transactions on Mathematical Software,
    Volume 5, Number 4, December 1979, pages 466-481.

  Parameters:

    Input, double A, the parameter.

    Input, double X, the argument.

    Output, double R8_GAMIT, the function value.
*/
{
  double aeps;
  double ainta;
  double algap1;
  static double alneps = 0.0;
  double alng;
  double alx;
  double h;
  double sga;
  double sgngam;
  double t;
  double value;
 
  if ( alneps == 0.0 )
  {
    alneps = - log ( r8_mach ( 3 ) );
  }

  if ( x < 0.0 )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R8_GAMIT - Fatal error!\n" );
    fprintf ( stderr, "  X is negative.\n" );
    exit ( 1 );
  }
  else if ( x == 0.0 )
  {
    alx = 0.0;
  }
  else
  {
    alx = log ( x );
  }

  if ( a < 0.0 )
  {
    sga = - 1.0;
  }
  else
  {
    sga = + 1.0;
  }

  ainta = r8_aint ( a + 0.5 * sga );
  aeps = a - ainta;

  if ( x == 0.0 )
  {
    if ( 0.0 < ainta || aeps != 0.0 )
    {
      value = r8_gamr ( a + 1.0 );
    }
    else
    {
      value = 0.0;
    }
    return value;
  }

  if ( x <= 1.0 )
  {
    if ( - 0.5 <= a || aeps != 0.0 )
    {
      r8_lgams ( a + 1.0, &algap1, &sgngam );
    }
    value = r8_gmit ( a, x, algap1, sgngam, alx );
    return value;
  }

  if ( x <= a )
  {
    t = r8_lgit (a, x, r8_lngam ( a + 1.0 ) );
    value = exp ( t );
    return value;
  }

  alng = r8_lgic ( a, x, alx );
/*
  Evaluate in terms of log (r8_gamic (a, x))
*/
  h = 1.0;

  if ( aeps != 0.0 || 0.0 < ainta )
  {
    r8_lgams ( a + 1.0, &algap1, &sgngam );
    t = log ( fabs ( a ) ) + alng - algap1;

    if ( alneps < t )
    {
      t = t - a * alx;
      value = - sga * sgngam * exp ( t );
      return value;
    }

    if ( - alneps < t )
    {
      h = 1.0 - sga * sgngam * exp ( t );
    }
  }
  t = - a * alx + log ( fabs ( h ) );

  if ( h < 0.0 )
  {
    value = - exp ( t );
  }
  else
  {
    value = + exp ( t );
  }
  return value;
}
/******************************************************************************/

void r8_gaml ( double *xmin, double *xmax )

/******************************************************************************/
/*
  Purpose:

    R8_GAML evaluates bounds for an R8 argument of the gamma function.

  Discussion:

    This function calculates the minimum and maximum legal bounds 
    for X in the evaluation of GAMMA ( X ).

    XMIN and XMAX are not the only bounds, but they are the only 
    non-trivial ones to calculate.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Output, double *XMIN, *XMAX, the bounds.
*/
{
  double alnbig;
  double alnsml;
  int i;
  int j;
  double xln;
  double xold;

  alnsml = log ( r8_mach ( 1 ) );
  *xmin = - alnsml;

  for ( i = 1; i <= 10; i++ )
  {
    xold = *xmin;
    xln = log ( *xmin );
    *xmin = *xmin - *xmin * ( ( *xmin + 0.5 ) * xln - *xmin 
      - 0.2258 + alnsml ) / ( *xmin * xln + 0.5 );

    if ( fabs ( *xmin - xold ) < 0.005 )
    {
      *xmin = - *xmin + 0.01;

      alnbig = log ( r8_mach ( 2 ) );
      *xmax = alnbig;

      for ( j = 1; j <= 10; j++ )
      {
        xold = *xmax;
        xln = log ( *xmax );
        *xmax = *xmax - *xmax * ( ( *xmax - 0.5 ) * xln - *xmax 
          + 0.9189 - alnbig ) / ( *xmax * xln - 0.5 );

        if ( fabs ( *xmax - xold ) < 0.005 )
        {
          *xmax = *xmax - 0.01;
          *xmin = fmax ( *xmin, - *xmax + 1.0 );
          return;
        }
      }
      fprintf ( stderr, "\n" );
      fprintf ( stderr, "R8_GAML - Fatal error!\n" );
      fprintf ( stderr, "  Unable to find XMAX.\n" );
      exit ( 1 );
    }
  }
  fprintf ( stderr, "\n" );
  fprintf ( stderr, "R8_GAML - Fatal error!\n" );
  fprintf ( stderr, "  Unable to find XMIN.\n" );
  exit ( 1 );
}
/******************************************************************************/

double r8_gamma ( double x )

/******************************************************************************/
/*
  Purpose:

    R8_GAMMA evaluates the gamma function of an R8 argument.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, double X, the argument.

    Output, double R8_GAMMA, the gamma function of X.
*/
{
  static double dxrel = 0.0;
  static double gcs[42] = {
    +0.8571195590989331421920062399942E-02,
    +0.4415381324841006757191315771652E-02,
    +0.5685043681599363378632664588789E-01,
    -0.4219835396418560501012500186624E-02,
    +0.1326808181212460220584006796352E-02,
    -0.1893024529798880432523947023886E-03,
    +0.3606925327441245256578082217225E-04,
    -0.6056761904460864218485548290365E-05,
    +0.1055829546302283344731823509093E-05,
    -0.1811967365542384048291855891166E-06,
    +0.3117724964715322277790254593169E-07,
    -0.5354219639019687140874081024347E-08,
    +0.9193275519859588946887786825940E-09,
    -0.1577941280288339761767423273953E-09,
    +0.2707980622934954543266540433089E-10,
    -0.4646818653825730144081661058933E-11,
    +0.7973350192007419656460767175359E-12,
    -0.1368078209830916025799499172309E-12,
    +0.2347319486563800657233471771688E-13,
    -0.4027432614949066932766570534699E-14,
    +0.6910051747372100912138336975257E-15,
    -0.1185584500221992907052387126192E-15,
    +0.2034148542496373955201026051932E-16,
    -0.3490054341717405849274012949108E-17,
    +0.5987993856485305567135051066026E-18,
    -0.1027378057872228074490069778431E-18,
    +0.1762702816060529824942759660748E-19,
    -0.3024320653735306260958772112042E-20,
    +0.5188914660218397839717833550506E-21,
    -0.8902770842456576692449251601066E-22,
    +0.1527474068493342602274596891306E-22,
    -0.2620731256187362900257328332799E-23,
    +0.4496464047830538670331046570666E-24,
    -0.7714712731336877911703901525333E-25,
    +0.1323635453126044036486572714666E-25,
    -0.2270999412942928816702313813333E-26,
    +0.3896418998003991449320816639999E-27,
    -0.6685198115125953327792127999999E-28,
    +0.1146998663140024384347613866666E-28,
    -0.1967938586345134677295103999999E-29,
    +0.3376448816585338090334890666666E-30,
    -0.5793070335782135784625493333333E-31 };
  int i;
  int n;
  static int ngcs = 0;
  const double pi = 3.14159265358979323846264338327950;
  double sinpiy;
  const double sq2pil = 0.91893853320467274178032973640562;
  double value;
  static double xmax = 0.0;
  static double xmin = 0.0;
  static double xsml = 0.0;
  double y;

  if ( ngcs == 0 )
  {
    ngcs = r8_inits ( gcs, 42, 0.1 * r8_mach ( 3 ) );
    r8_gaml ( &xmin, &xmax );
    xsml = exp ( fmax ( log ( r8_mach ( 1 ) ),
      - log ( r8_mach ( 2 ) ) ) + 0.01 );
    dxrel = sqrt ( r8_mach ( 4 ) );
  }

  y = fabs ( x );

  if ( y <= 10.0 )
  {
    n = ( int ) ( x );
    if ( x < 0.0 )
    {
      n = n - 1;
    }
    y = x - ( double ) ( n );
    n = n - 1;
    value = 0.9375 + r8_csevl ( 2.0 * y - 1.0, gcs, ngcs );

    if ( n == 0 )
    {
      return value;
    }
    else if ( n < 0 )
    {
      n = - n;

      if ( x == 0.0 )
      {
        fprintf ( stderr, "\n" );
        fprintf ( stderr, "R8_GAMMA - Fatal error!\n" );
        fprintf ( stderr, "  X is 0.\n" );
        exit ( 1 );
      }

      if ( x < 0.0 && x + ( double ) ( n - 2 ) == 0.0 )
      {
        fprintf ( stderr, "\n" );
        fprintf ( stderr, "R8_GAMMA - Fatal error!\n" );
        fprintf ( stderr, "  X is a negative int.\n" );
        exit ( 1 );
      }

      if ( x < - 0.5 && fabs ( ( x - r8_aint ( x - 0.5 ) ) / x ) < dxrel )
      {
        fprintf ( stderr, "\n" );
        fprintf ( stderr, "R8_GAMMA - Warning!\n" );
        fprintf ( stderr, "  X too near a negative int,\n" );
        fprintf ( stderr, "  answer is half precision.\n" );
      }

      if ( y < xsml )
      {
        fprintf ( stderr, "\n" );
        fprintf ( stderr, "R8_GAMMA - Fatal error!\n" );
        fprintf ( stderr, "  X is so close to zero that Gamma overflows.\n" );
        exit ( 1 );
      }

      for ( i = 1; i <= n; i++ )
      {
        value = value / ( x + ( double ) ( i - 1 ) );
      }

    }
    else if ( n == 0 )
    {
    }
    else
    {
      for ( i = 1; i <= n; i++ )
      {
        value = ( y + ( double ) ( i ) ) * value;
      }
    }
  }
  else
  {
    if ( xmax < x )
    {
      fprintf ( stderr, "\n" );
      fprintf ( stderr, "R8_GAMMA - Fatal error!\n" );
      fprintf ( stderr, "  X so big that Gamma overflows.\n" );
      exit ( 1 );
    }
/*
  Underflow.
*/
    if ( x < xmin )
    {
      value = 0.0;
      return value;
    }

    value = exp ( ( y - 0.5 ) * log ( y ) - y + sq2pil + r8_lgmc ( y ) );

    if ( 0.0 < x )
    {
      return value;
    }

    if ( fabs ( ( x - r8_aint ( x - 0.5 ) ) / x ) < dxrel )
    {
      fprintf ( stderr, "\n" );
      fprintf ( stderr, "R8_GAMMA - Warning!\n" );
      fprintf ( stderr, "  X too near a negative int,\n" );
      fprintf ( stderr, "  answer is half precision.\n" );
    }

    sinpiy = sin ( pi * y );

    if ( sinpiy == 0.0 )
    {
      fprintf ( stderr, "\n" );
      fprintf ( stderr, "R8_GAMMA - Fatal error!\n" );
      fprintf ( stderr, "  X is a negative int.\n" );
      exit ( 1 );
    }
    value = - pi / ( y * sinpiy * value );
  }
  return value;
}
/******************************************************************************/

double r8_gamr ( double x )

/******************************************************************************/
/*
  Purpose:

    R8_GAMR evaluates the reciprocal gamma function of an R8 argument.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, double X, the argument.

    Output, double R8_GAMR, the value of the reciprocal gamma
    function at X.
*/
{
  double alngx;
  double value;
  double sgngx;

  if ( x <= 0.0 && r8_aint ( x ) == x )
  {
    value = 0.0;
  } 
  else if ( fabs ( x ) <= 10.0 )
  {
    value = 1.0 / r8_gamma ( x );
  }
  else
  {
    r8_lgams ( x, &alngx, &sgngx );
    value = sgngx * exp ( - alngx );
  }
  return value;
}
/******************************************************************************/

double r8_gmic ( double a, double x, double alx )

/******************************************************************************/
/*
  Purpose:

    R8_GMIC: complementary incomplete gamma, small X, A near negative int.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, double A, the parameter.

    Input, double X, the argument.

    Input, double ALX, the logarithm of X.

    Output, double R8_GMIC, the complementary incomplete 
    gamma function.
*/
{
  double alng;
  static double bot = 0.0;
  int converged;
  static double eps = 0.0;
  const double euler = 0.57721566490153286060651209008240;
  double fk;
  double fkp1;
  double fm;
  int k;
  int m;
  int mm1;
  double s;
  double sgng;
  double t;
  double te;
  double value;

  if ( eps == 0.0 )
  {
    eps = 0.5 * r8_mach ( 3 );
    bot = log ( r8_mach ( 1 ) );
  }

  if ( 0.0 < a )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R8_GMIC - Fatal error!\n" );
    fprintf ( stderr, "  A must be near a negative int.\n" );
    exit ( 1 );
  }

  if ( x <= 0.0 )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R8_GMIC - Fatal error!\n" );
    fprintf ( stderr, "  X <= 0.\n" );
    exit ( 1 );
  }

  m = - ( int ) ( a - 0.5 );
  fm = ( double ) ( m );

  te = 1.0;
  t = 1.0;
  s = t;
  converged = 0;

  for ( k = 1; k <= 200; k++ )
  {
    fkp1 = ( double ) ( k + 1 );
    te = - x * te / ( fm + fkp1 );
    t = te / fkp1;
    s = s + t;
    if ( fabs ( t ) < eps * s )
    {
      converged = 1;
      break;
    }
  }

  if ( !converged )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R8_GMIC - Fatal error!\n" );
    fprintf ( stderr, "  No convergence after 200 iterations.\n" );
    exit ( 1 );
  }

  value = - alx - euler + x * s / ( fm + 1.0 );

  if ( m == 0 )
  {
    return value;
  }
  else if ( m == 1 )
  {
    value = - value - 1.0 + 1.0 / x;
    return value;
  }

  te = fm;
  t = 1.0;
  s = t;
  mm1 = m - 1;

  for ( k = 1; k <= mm1; k++ )
  {
    fk = ( double ) ( k );
    te = - x * te / fk;
    t = te / ( fm - fk );
    s = s + t;
    if ( fabs ( t ) < eps * fabs ( s ) )
    {
      break;
    }
  }

  for ( k = 1; k <= m; k++ )
  {
    value = value + 1.0 / ( double ) ( k );
  }

  if ( ( m % 2 ) == 1 )
  {
    sgng = - 1.0;
  }
  else
  {
    sgng = + 1.0;
  }

  alng = log ( value ) - r8_lngam ( fm + 1.0 );

  if ( bot < alng )
  {
    value = sgng * exp ( alng );
  }
  else
  {
    value = 0.0;
  }

  if ( s != 0.0 )
  {
    value = value
      + r8_sign ( s ) * exp ( - fm * alx + log ( fabs ( s ) / fm ) );
  }

  return value;
}
/******************************************************************************/

double r8_gmit ( double a, double x, double algap1, double sgngam, double alx )

/******************************************************************************/
/*
  Purpose:

    R8_GMIT: Tricomi's incomplete gamma function for small X.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, double A, the parameter.

    Input, double X, the argument.

    Input, double ALGAP1, the logarithm of Gamma ( A + 1 ).

    Input, double SGNGAM, the sign of Gamma ( A + 1 ).

    Input, double ALX, the logarithm of X.

    Output, double R8_GMIT, the Tricomi incomplete gamma function.
*/
{
  double ae;
  double aeps;
  double alg2;
  double algs;
  static double bot = 0.0;
  int converged;
  static double eps = 0.0;
  double fk;
  int k;
  int m;
  int ma;
  double s;
  double sgng2;
  double t;
  double te;
  double value;

  if ( eps == 0.0 )
  {
    eps = 0.5 * r8_mach ( 3 );
    bot = log ( r8_mach ( 1 ) );
  }

  if ( x <= 0.0 )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R8_GMIT - Fatal error!\n" );
    fprintf ( stderr, "  X <= 0.\n" );
    exit ( 1 );
  }

  if ( a < 0.0 )
  {
    ma = ( int ) ( a - 0.5 );
  }
  else
  {
    ma = ( int ) ( a + 0.5 );
  }

  aeps = a - ( double ) ( ma );

  if ( a < - 0.5 )
  {
    ae = aeps;
  }
  else
  {
    ae = a;
  }

  t = 1.0;
  te = ae;
  s = t;
  converged = 0;

  for ( k = 1; k <= 200; k++ )
  {
    fk = ( double ) ( k );
    te = - x * te / fk;
    t = te / ( ae + fk );
    s = s + t;
    if ( fabs ( t ) < eps * fabs ( s ) )
    {
      converged = 1;
      break;
    }
  }

  if ( !converged )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R8_GMIT - Fatal error!\n" );
    fprintf ( stderr, "  No convergence in 200 iterations.\n" );
    exit ( 1 );
  }

  if ( - 0.5 <= a )
  {
    algs = - algap1 + log ( s );
    value = exp ( algs );
    return value;
  }

  algs = - r8_lngam ( 1.0 + aeps ) + log ( s );
  s = 1.0;
  m = - ma - 1;
  t = 1.0;

  for ( k = 1; k <= m; k++ )
  {
    t = x * t / ( aeps - ( double ) ( m + 1 - k ) );
    s = s + t;
    if ( fabs ( t ) < eps * fabs ( s ) )
    {
      break;
    }
  }

  value = 0.0;
  algs = - ( double ) ( ma ) * log ( x ) + algs;

  if ( s == 0.0 || aeps == 0.0 )
  {
    value = exp ( algs );
    return value;
  }

  sgng2 = sgngam * r8_sign ( s );
  alg2 = - x - algap1 + log ( fabs ( s ) );

  if ( bot < alg2 )
  {
    value = sgng2 * exp ( alg2 );
  }

  if ( bot < algs )
  {
    value = value + exp ( algs );
  }

  return value;
}
/******************************************************************************/

int r8_inits ( double dos[], int nos, double eta )

/******************************************************************************/
/*
  Purpose:

    R8_INITS initializes a Chebyshev series.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    22 April 2016

  Author:

    C version by John Burkardt.

  Reference:

    Roger Broucke,
    Algorithm 446:
    Ten Subroutines for the Manipulation of Chebyshev Series,
    Communications of the ACM,
    Volume 16, Number 4, April 1973, pages 254-256.

  Parameters:

    Input, double DOS[NOS], the Chebyshev coefficients.

    Input, int NOS, the number of coefficients.

    Input, double ETA, the desired accuracy.

    Output, int R8_INITS, the number of terms of the series needed
    to ensure the requested accuracy.
*/
{
  double err;
  int i;
  int value;

  if ( nos < 1 )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R8_INITS - Fatal error!\n" );
    fprintf ( stderr, "  Number of coefficients < 1.\n" );
    exit ( 1 );
  }

  if ( eta < dos[nos-1] )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R8_INITS - Warning!\n" );
    fprintf ( stderr, "  ETA may be too small.\n" );
    fprintf ( stderr, "  The requested accuracy cannot be guaranteed.\n" );
    fprintf ( stderr, "  even if all available coefficients are used.\n" );
    value = nos;
  }
  else
  {
    err = 0.0;
 
    for ( i = nos - 1; 0 <= i; i-- )
    {
      value = i + 1;
      err = err + fabs ( dos[i] );
      if ( eta < err )
      {
        break;
      }
    }
  }

  return value;
}
/******************************************************************************/

double r8_int ( double x )

/******************************************************************************/
/*
  Purpose:

    R8_INT returns the integer part of an R8 argument.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, double X, the argument.

    Output, double R8_INT, the integer part of X.
*/
{
  int i;
  int ibase;
  int ipart;
  static int npart = 0;
  double part;
  static double scale = 0.0;
  double value;
  static double xbig = 0.0;
  static double xmax = 0.0;
  double xscl;

  if ( npart == 0 )
  {
    ibase = i4_mach ( 10 );
    xmax = 1.0 / r8_mach ( 4 );
    xbig = fmin ( ( double ) ( i4_mach ( 9 ) ), 1.0 / r8_mach ( 4 ) );
    scale = ( double ) i4_pow ( ibase,
      ( int ) ( log ( xbig ) / log ( ( double ) ( ibase ) ) - 0.5 ) );
    npart = log ( xmax ) / log ( scale ) + 1.0;
  }
/*
  X may be too small.
*/
  if ( x < - xmax )
  {
    value = x;
  }
  else if ( x < - xbig )
  {
    xscl = - x;

    for ( i = 1; i <= npart; i++ )
    {
      xscl = xscl / scale;
    }

    value = 0.0;
    for ( i = 1; i <= npart; i++ )
    {
      xscl = xscl * scale;
      ipart = ( int ) ( xscl );
      part = ( double ) ( ipart );
      xscl = xscl - part;
      value = value * scale + part;
    }
    value = - value;
  }
  else if ( x <= xbig )
  {
    value = ( int ) ( x );
  }
  else if ( x <= xmax )
  {
    xscl = x;

    for ( i = 1; i <= npart; i++ )
    {
      xscl = xscl / scale;
    }

    value = 0.0;
    for ( i = 1; i <= npart; i++ )
    {
      xscl = xscl * scale;
      ipart = ( int ) ( xscl );
      part = ( double ) ( ipart );
      xscl = xscl - part;
      value = value * scale + part;
    }
  }
/*
  X may be too large.
*/
  else
  {
    value = x;
  }
  return value;
}
/******************************************************************************/

void r8_knus ( double xnu, double x, double *bknu, double *bknu1, int *iswtch )

/******************************************************************************/
/*
  Purpose:

    R8_KNUS computes a sequence of K Bessel functions.

  Discussion:

    This routine computes Bessel functions 
      exp(x) * k-sub-xnu (x)  
    and
      exp(x) * k-sub-xnu+1 (x) 
    for 0.0 <= xnu < 1.0.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, double XNU, the order parameter.

    Input, double X, the argument.

    Output, double *BKNU, *BKNU1, the two K Bessel functions.

    Output, int *ISWTCH, ?
*/
{
  double a[32];
  double a0;
  const double aln2 = 0.69314718055994530941723212145818;
  static double alnbig = 0;
  static double alneps = 0;
  static double alnsml = 0;
  double alnz;
  double alpha[32];
  double an;
  double b0;
  double beta[32];
  double bknu0;
  double bknud;
  double bn;
  double c0;
  static double c0kcs[29] = {
    +0.60183057242626108387577445180329E-01,
    -0.15364871433017286092959755943124,
    -0.11751176008210492040068229226213E-01,
    -0.85248788891979509827048401550987E-03,
    -0.61329838767496791874098176922111E-04,
    -0.44052281245510444562679889548505E-05,
    -0.31631246728384488192915445892199E-06,
    -0.22710719382899588330673771793396E-07,
    -0.16305644608077609552274620515360E-08,
    -0.11706939299414776568756044043130E-09,
    -0.84052063786464437174546593413792E-11,
    -0.60346670118979991487096050737198E-12,
    -0.43326960335681371952045997366903E-13,
    -0.31107358030203546214634697772237E-14,
    -0.22334078226736982254486133409840E-15,
    -0.16035146716864226300635791528610E-16,
    -0.11512717363666556196035697705305E-17,
    -0.82657591746836959105169479089258E-19,
    -0.59345480806383948172333436695984E-20,
    -0.42608138196467143926499613023976E-21,
    -0.30591266864812876299263698370542E-22,
    -0.21963541426734575224975501815516E-23,
    -0.15769113261495836071105750684760E-24,
    -0.11321713935950320948757731048056E-25,
    -0.81286248834598404082792349714433E-27,
    -0.58360900893453226552829349315949E-28,
    -0.41901241623610922519452337780905E-29,
    -0.30083737960206435069530504212862E-30,
    -0.21599152067808647728342168089832E-31 };
  double eta;
  const double euler = 0.57721566490153286060651209008240;
  double expx;
  int i;
  int ii;
  int inu;
  int n;
  static int ntc0k = 0;
  int nterms;
  static int ntznu1 = 0;
  double p1;
  double p2;
  double p3;
  double qq;
  double result;
  const double sqpi2 = +1.2533141373155002512078826424055;
  double sqrtx;
  double v;
  double vlnz;
  double x2n;
  double x2tov;
  double xi;
  double xmu;
  static double xnusml = 0.0;
  static double xsml = 0.0;
  double z;
  static double znu1cs[20] = {
    +0.203306756994191729674444001216911,
    +0.140077933413219771062943670790563,
    +0.791679696100161352840972241972320E-02,
    +0.339801182532104045352930092205750E-03,
    +0.117419756889893366664507228352690E-04,
    +0.339357570612261680333825865475121E-06,
    +0.842594176976219910194629891264803E-08,
    +0.183336677024850089184748150900090E-09,
    +0.354969844704416310863007064469557E-11,
    +0.619032496469887332205244342078407E-13,
    +0.981964535680439424960346115456527E-15,
    +0.142851314396490474211473563005985E-16,
    +0.191894921887825298966162467488436E-18,
    +0.239430979739498914162313140597128E-20,
    +0.278890246815347354835870465474995E-22,
    +0.304606650633033442582845214092865E-24,
    +0.313173237042191815771564260932089E-26,
    +0.304133098987854951645174908005034E-28,
    +0.279840384636833084343185097659733E-30,
    +0.244637186274497596485238794922666E-32 };
  double ztov;

  if ( ntc0k == 0 )
  {
    eta = 0.1 * r8_mach ( 3 );
    ntc0k = r8_inits ( c0kcs, 29, eta );
    ntznu1 = r8_inits ( znu1cs, 20, eta );
    xnusml = sqrt ( r8_mach ( 3 ) / 8.0 );
    xsml = 0.1 * r8_mach ( 3 );
    alnsml = log ( r8_mach ( 1 ) );
    alnbig = log ( r8_mach ( 2 ) );
    alneps = log ( 0.1 * r8_mach ( 3 ) );
  }

  if ( xnu < 0.0 || 1.0 <= xnu )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R8_KNUS - Fatal error!\n" );
    fprintf ( stderr, "  XNU < 0 or 1 <= XNU.\n" );
    exit ( 1 );
  }

  if ( x <= 0.0 )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R8_KNUS - Fatal error!\n" );
    fprintf ( stderr, "  X <= 0.\n" );
    exit ( 1 );
  }

  *iswtch = 0;
/*
  X is small.  Compute k-sub-xnu (x) and the derivative of k-sub-xnu (x)
  then find k-sub-xnu+1 (x).  xnu is reduced to the interval (-0.5,+0.5)
  then to (0., .5), because k of negative order (-nu) = k of positive
  order (+nu).
*/
  if ( x <= 2.0 )
  {
    if ( xnu <= 0.5 )
    {
      v = xnu;
    }
    else
    {
      v = 1.0 - xnu;
    }
/*
  Carefully find (x/2)^xnu and z^xnu where z = x*x/4.
*/
    alnz = 2.0 * ( log ( x ) - aln2 );

    if ( x <= xnu )
    {
      if ( alnbig < - 0.5 * xnu * alnz - aln2 - log ( xnu ) )
      {
        fprintf ( stderr, "\n" );
        fprintf ( stderr, "R8_KNUS - Fatal error!\n" );
        fprintf ( stderr, "  Small X causing overflow.\n" );
        exit ( 1 );
      }
    }

    vlnz = v * alnz;
    x2tov = exp ( 0.5 * vlnz );

    if ( vlnz <= alnsml )
    {
      ztov = 0.0;
    }
    else
    {
      ztov = x2tov * x2tov;
    }

    a0 = 0.5 * r8_gamma ( 1.0 + v );
    b0 = 0.5 * r8_gamma ( 1.0 - v );
    c0 = - euler;

    if ( 0.5 <= ztov && xnusml < v )
    {
      c0 = - 0.75 + r8_csevl ( ( 8.0 * v ) * v - 1.0, c0kcs, ntc0k );
    }

    if ( ztov <= 0.5 )
    {
      alpha[0] = ( a0 - ztov * b0 ) / v;
    }
    else
    {
      alpha[0] = c0 - alnz * ( 0.75 +
        r8_csevl ( vlnz / 0.35 + 1.0, znu1cs, ntznu1 ) ) * b0;
    }

    beta[0] = - 0.5 * ( a0 + ztov * b0 );

    if ( x <= xsml )
    {
      z = 0.0;
    }
    else
    {
      z = 0.25 * x * x;
    }

    nterms = i4_max ( 2, ( int ) ( 11.0 
      + ( 8.0 * alnz - 25.19 - alneps ) / ( 4.28 - alnz ) ) );

    for ( i = 2; i <= nterms; i++ )
    {
      xi = ( double ) ( i - 1 );
      a0 = a0 / ( xi * ( xi - v ) );
      b0 = b0 / ( xi * ( xi + v ) );
      alpha[i-1] = ( alpha[i-2] + 2.0 * xi * a0 ) 
        / ( xi * ( xi + v ) );
      beta[i-1] = ( xi - 0.5 * v ) * alpha[i-1] - ztov * b0;
    }

    *bknu = alpha[nterms-1];
    bknud = beta[nterms-1];
    for ( ii = 2; ii <= nterms; ii++ )
    {
      i = nterms + 1 - ii;
      *bknu = alpha[i-1] + *bknu * z;
      bknud = beta[i-1] + bknud * z;
    }

    expx = exp ( x );
    *bknu = expx * *bknu / x2tov;

    if ( alnbig < - 0.5 * ( xnu + 1.0 ) * alnz - 2.0 * aln2 )
    {
      *iswtch = 1;
      return;
    }

    bknud = expx * bknud * 2.0 / ( x2tov * x );

    if ( xnu <= 0.5 )
    {
      *bknu1 = v * *bknu / x - bknud;
      return;
    }
    bknu0 = *bknu;
    *bknu = - v * *bknu / x - bknud;
    *bknu1 = 2.0 * xnu * *bknu / x + bknu0;
  }
/*
  X is large.  find k-sub-xnu (x) and k-sub-xnu+1 (x) with y. l. luke-s
  rational expansion.
*/
  else
  {
    sqrtx = sqrt ( x );

    if ( 1.0 / xsml < x )
    {
      *bknu = sqpi2 / sqrtx;
      *bknu1 = *bknu;
      return;
    }

    an = - 0.60 - 1.02 / x;
    bn = - 0.27 - 0.53 / x;
    nterms = i4_min ( 32, i4_max ( 3, ( int ) ( an + bn * alneps ) ) );

    for ( inu = 1; inu <= 2; inu++ )
    {
      if ( inu == 1 )
      {
        if ( xnu <= xnusml )
        {
          xmu = 0.0;
        }
        else
        {
          xmu = ( 4.0 * xnu ) * xnu;
        }
      }
      else
      {
        xmu = 4.0 * ( fabs ( xnu ) + 1.0 ) * ( fabs ( xnu ) + 1.0 );
      }

      a[0] = 1.0 - xmu;
      a[1] = 9.0 - xmu;
      a[2] = 25.0 - xmu;

      if ( a[1] == 0.0 )
      {
        result = sqpi2 * ( 16.0 * x + xmu + 7.0 ) / ( 16.0 * x * sqrtx );
      }
      else
      {
        alpha[0] = 1.0;
        alpha[1] = ( 16.0 * x + a[1] ) / a[1];
        alpha[2] = ( ( 768.0 * x + 48.0 * a[2] ) * x 
          + a[1] * a[2] ) / ( a[1] * a[2] );

        beta[0] = 1.0;
        beta[1] = ( 16.0 * x + ( xmu + 7.0 ) ) / a[1];
        beta[2] = ( ( 768.0 * x + 48.0 * ( xmu + 23.0 ) ) * x +
          ( ( xmu + 62.0 ) * xmu + 129.0 ) ) / ( a[1] * a[2] );

        for ( i = 4; i <= nterms; i++ )
        {
          n = i - 1;
          x2n = ( double ) ( 2 * n - 1 );

          a[i-1] = ( x2n + 2.0 ) * ( x2n + 2.0 ) - xmu;
          qq = 16.0 * x2n / a[i-1];
          p1 = - x2n * ( ( double ) ( 12 * n * n - 20 * n ) - a[0] ) 
            / ( ( x2n - 2.0 ) * a[i-1] ) - qq * x;
          p2 = ( ( double ) ( 12 * n * n - 28 * n + 8 ) - a[0] ) 
            / a[i-1] - qq * x;
          p3 = - x2n * a[i-4] / ( ( x2n - 2.0 ) * a[i-1] );

          alpha[i-1] = - p1 * alpha[i-2]
                       - p2 * alpha[i-3] 
                       - p3 * alpha[i-4];

          beta[i-1] =  - p1 * beta[i-2]
                       - p2 * beta[i-3] 
                       - p3 * beta[i-4];

        }
        result = sqpi2 * beta[nterms-1] / ( sqrtx * alpha[nterms-1] );
      }

      if ( inu == 1 )
      {
        *bknu = result;
      }
      else
      {
        *bknu1 = result;
      }
    }
  }
  return;
}
/******************************************************************************/

double r8_lbeta ( double a, double b )

/******************************************************************************/
/*
  Purpose:

    R8_LBETA evaluates the logarithm of the beta function of R8 arguments.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, double A, B, the arguments.

    Output, double R8_LBETA, the logarithm of the beta function of A
    and B.
*/
{
  double corr;
  double p;
  double q;
  const double sq2pil = 0.91893853320467274178032973640562;
  double value;

  p = fmin ( a, b );
  q = fmax ( a, b );

  if ( p <= 0.0 )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R8_LBETA - Fatal error!\n" );
    fprintf ( stderr, "  Both arguments must be greater than 0.\n" );
    exit ( 1 );
  }
  else if ( p < 10.0 && q <= 10.0 )
  {
    value = log ( r8_gamma ( p ) * ( r8_gamma ( q ) / r8_gamma ( p + q ) ) );
  }
  else if ( p < 10.0 )
  {
    corr = r8_lgmc ( q ) - r8_lgmc ( p + q );

    value = r8_lngam ( p ) + corr + p - p * log ( p + q ) +
      ( q - 0.5 ) * r8_lnrel ( - p / ( p + q ) );
  }
  else
  {
    corr = r8_lgmc ( p ) + r8_lgmc ( q ) - r8_lgmc ( p + q );

    value = - 0.5 * log ( q ) + sq2pil + corr 
      + ( p - 0.5 ) * log ( p / ( p + q ) ) 
      + q * r8_lnrel ( - p / ( p + q ) );
  }
  return value;
}

/******************************************************************************/

void r8_lgams ( double x, double *algam, double *sgngam )

/******************************************************************************/
/*
  Purpose:

    R8_LGAMS evaluates the log of |gamma(x)| and sign, for an R8 argument.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, double X, the argument.

    Output, double *ALGAM, the logarithm of the absolute value of
    gamma ( X ).

    Output, double *SGNGAM, the sign (+1 or -1) of gamma ( X ).
*/
{
  int k;

  *algam = r8_lngam ( x );
  *sgngam = 1.0;

  if ( x <= 0.0 )
  {
    k = ( int ) ( fmod ( - r8_aint ( x ), 2.0 ) + 0.1 );

    if ( k == 0 )
    {
      *sgngam = - 1.0;
    }
  }
  return;
}
/******************************************************************************/

double r8_lgic ( double a, double x, double alx )

/******************************************************************************/
/*
  Purpose:

    R8_LGIC evaluates the log complementary incomplete gamma function for large X.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, double A, the parameter.

    Input, double X, the argument.

    Input, double ALX, the logarithm of X.

    Output, double R8_LGIC, the log complementary incomplete 
    gamma function.
*/
{
  static double eps = 0.0;
  double fk;
  int k;
  double p;
  double r;
  double s;
  double t;
  double value;
  double xma;
  double xpa;

  if ( eps == 0.0 )
  {
    eps = 0.5 * r8_mach ( 3 );
  }

  xpa = x + 1.0 - a;
  xma = x - 1.0 - a;

  r = 0.0;
  p = 1.0;
  s = p;
  for ( k = 1; k <= 300; k++ )
  {
    fk = ( double ) ( k );
    t = fk * ( a - fk ) * ( 1.0 + r );
    r = - t / ( ( xma + 2.0 * fk ) * ( xpa + 2.0 * fk ) + t );
    p = r * p;
    s = s + p;
    if ( fabs ( p ) < eps * s )
    {
      value = a * alx - x + log ( s / xpa );
      return value;
    }
  }

  fprintf ( stderr, "\n" );
  fprintf ( stderr, "R8_LGIC - Fatal error!\n" );
  fprintf ( stderr, "  No convergence in 300 iterations.\n" );

  exit ( 1 );
}
/******************************************************************************/

double r8_lgit ( double a, double x, double algap1 )

/******************************************************************************/
/*
  Purpose:

    R8_LGIT evaluates the log of Tricomi's incomplete gamma function.

  Discussion:

    Perron's continued fraction is used for large X and X <= A.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, double A, the parameter.

    Input, double X, the argument.

    Input, double ALGAP1, the logarithm of the gamma function of A+1.

    Output, double R8_LGIT, the log of Tricomi's incomplete
    gamma function.
*/
{
  double a1x;
  double ax;
  static double eps = 0.0;
  double fk;
  double hstar;
  int k;
  double p;
  double r;
  double s;
  double t;
  double value;

  if ( eps == 0.0 )
  {
    eps = 0.5 * r8_mach ( 3 );
  }

  if ( x <= 0.0 )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R8_LGIT - Fatal error!\n" );
    fprintf ( stderr, "  X <= 0.\n" );
    exit ( 1 );
  }

  if ( a < x )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R8_LGIT - Fatal error!\n" );
    fprintf ( stderr, "  A < X.\n" );
    exit ( 1 );
  }

  ax = a + x;
  a1x = ax + 1.0;
  r = 0.0;
  p = 1.0;
  s = p;

  for ( k = 1; k <= 200; k++ )
  {
    fk = ( double ) ( k );
    t = ( a + fk ) * x * ( 1.0 + r );
    r = t / ( ( ax + fk ) * ( a1x + fk ) - t );
    p = r * p;
    s = s + p;
    if ( fabs ( p ) < eps * s )
    {
      hstar = 1.0 - x * s / a1x;
      value = - x - algap1 - log ( hstar );
      return value;
    }
  }

  fprintf ( stderr, "\n" );
  fprintf ( stderr, "R8_LGIT - Fatal error!\n" );
  fprintf ( stderr, "  No convergence after 200 iterations.\n" );
  exit ( 1 );
}
/******************************************************************************/

double r8_lgmc ( double x )

/******************************************************************************/
/*
  Purpose:

    R8_LGMC evaluates the log gamma correction factor for an R8 argument.

  Discussion:

    For 10 <= X, compute the log gamma correction factor so that

      log ( gamma ( x ) ) = log ( sqrt ( 2 * pi ) ) 
                          + ( x - 0.5 ) * log ( x ) - x 
                          + r8_lgmc ( x )

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, double X, the argument.

    Output, double R8_LGMC, the correction factor.
*/
{
  static double algmcs[15] = {
    +0.1666389480451863247205729650822,
    -0.1384948176067563840732986059135E-04,
    +0.9810825646924729426157171547487E-08,
    -0.1809129475572494194263306266719E-10,
    +0.6221098041892605227126015543416E-13,
    -0.3399615005417721944303330599666E-15,
    +0.2683181998482698748957538846666E-17,
    -0.2868042435334643284144622399999E-19,
    +0.3962837061046434803679306666666E-21,
    -0.6831888753985766870111999999999E-23,
    +0.1429227355942498147573333333333E-24,
    -0.3547598158101070547199999999999E-26,
    +0.1025680058010470912000000000000E-27,
    -0.3401102254316748799999999999999E-29,
    +0.1276642195630062933333333333333E-30 };
  static int nalgm = 0;
  double value;
  static double xbig = 0.0;
  static double xmax = 0.0;

  if ( nalgm == 0 )
  {
    nalgm = r8_inits ( algmcs, 15, r8_mach ( 3 ) );
    xbig = 1.0 / sqrt ( r8_mach ( 3 ) );
    xmax = exp ( fmin ( log ( r8_mach ( 2 ) / 12.0 ), 
      - log ( 12.0 * r8_mach ( 1 ) ) ) );
  }

  if ( x < 10.0 )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R8_LGMC - Fatal error!\n" );
    fprintf ( stderr, "  X must be at least 10.\n" );
    exit ( 1 );
  }
  else if ( x < xbig )
  {
    value = r8_csevl ( 2.0 * ( 10.0 / x ) 
      * ( 10.0 / x ) - 1.0, algmcs, nalgm ) / x;
  }
  else if ( x < xmax )
  {
    value = 1.0 / ( 12.0 * x );
  }
  else
  {
    value = 0.0;
  }
  return value;
}
/******************************************************************************/

double r8_li ( double x )

/******************************************************************************/
/*
  Purpose:

    R8_LI evaluates the logarithmic integral for an R8 argument.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, double X, the argument.

    Output, double R8_LI, the logarithmic integral evaluated at X.
*/
{
  static double sqeps = 0.0;
  double value;

  if ( sqeps == 0.0 )
  {
    sqeps = sqrt ( r8_mach ( 3 ) );
  }

  if ( x < 0.0 )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R8_LI - Fatal error!\n" );
    fprintf ( stderr, "  Function undefined for X <= 0.\n" );
    exit ( 1 );
  }

  if ( x == 0.0 )
  {
    value = 0.0;
    return value;
  }

  if ( x == 1.0 )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R8_LI - Fatal error!\n" );
    fprintf ( stderr, "  Function undefined for X = 1.\n" );
    exit ( 1 );
  }

  if ( fabs ( 1.0 - x ) < sqeps )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R8_LI - Warning!\n" );
    fprintf ( stderr, "  Answer less than half precision.\n" );
    fprintf ( stderr, "  X is too close to 1.\n" );
  }

  value = r8_ei ( log ( x ) );

  return value;
}
/******************************************************************************/

double r8_lngam ( double x )

/******************************************************************************/
/*
  Purpose:

    R8_LNGAM: log of the absolute value of gamma of an R8 argument.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, double X, the argument.

    Output, double R8_LNGAM, the logarithm of the absolute value of
    the gamma function of X.
*/
{
  static double dxrel = 0.0;
  const double pi = 3.14159265358979323846264338327950;
  double sinpiy;
  const double sq2pil = 0.91893853320467274178032973640562;
  const double sqpi2l = +0.225791352644727432363097614947441;
  double value;
  static double xmax = 0.0;
  double y;

  if ( xmax == 0.0 )
  {
    xmax = r8_mach ( 2 ) / log ( r8_mach ( 2 ) );
    dxrel = sqrt ( r8_mach ( 4 ) );
  }

  y = fabs ( x );

  if ( y <= 10.0 )
  {
    value = log ( fabs ( r8_gamma ( x ) ) );
    return value;
  }

  if ( xmax < y )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R8_LNGAM - Fatal error!\n" );
    fprintf ( stderr, "  Result overflows, |X| too big.\n" );
    exit ( 1 );
  }

  if ( 0.0 < x )
  {
    value = sq2pil + ( x - 0.5 ) * log ( x ) - x + r8_lgmc ( y );
    return value;
  }

  sinpiy = fabs ( sin ( pi * y ) );

  if ( sinpiy == 0.0 )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R8_LNGAM - Fatal error!\n" );
    fprintf ( stderr, "  X is a negative int.\n" );
    exit ( 1 );
  }

  value = sqpi2l + ( x - 0.5 ) * log ( y ) - x - log ( sinpiy ) - r8_lgmc ( y );

  if ( fabs ( ( x - r8_aint ( x - 0.5 ) ) * value / x ) < dxrel )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R8_LNGAM - Warning!\n" );
    fprintf ( stderr, "  Result is half precision because\n" );
    fprintf ( stderr, "  X is too near a negative int.\n" );
  }

  return value;
}
/******************************************************************************/

double r8_lnrel ( double x )

/******************************************************************************/
/*
  Purpose:

    R8_LNREL evaluates log ( 1 + X ) for an R8 argument.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, double X, the argument.

    Output, double R8_LNREL, the value of LOG ( 1 + X ).
*/
{
  static double alnrcs[43] = {
    +0.10378693562743769800686267719098E+01,
    -0.13364301504908918098766041553133,
    +0.19408249135520563357926199374750E-01,
    -0.30107551127535777690376537776592E-02,
    +0.48694614797154850090456366509137E-03,
    -0.81054881893175356066809943008622E-04,
    +0.13778847799559524782938251496059E-04,
    -0.23802210894358970251369992914935E-05,
    +0.41640416213865183476391859901989E-06,
    -0.73595828378075994984266837031998E-07,
    +0.13117611876241674949152294345011E-07,
    -0.23546709317742425136696092330175E-08,
    +0.42522773276034997775638052962567E-09,
    -0.77190894134840796826108107493300E-10,
    +0.14075746481359069909215356472191E-10,
    -0.25769072058024680627537078627584E-11,
    +0.47342406666294421849154395005938E-12,
    -0.87249012674742641745301263292675E-13,
    +0.16124614902740551465739833119115E-13,
    -0.29875652015665773006710792416815E-14,
    +0.55480701209082887983041321697279E-15,
    -0.10324619158271569595141333961932E-15,
    +0.19250239203049851177878503244868E-16,
    -0.35955073465265150011189707844266E-17,
    +0.67264542537876857892194574226773E-18,
    -0.12602624168735219252082425637546E-18,
    +0.23644884408606210044916158955519E-19,
    -0.44419377050807936898878389179733E-20,
    +0.83546594464034259016241293994666E-21,
    -0.15731559416479562574899253521066E-21,
    +0.29653128740247422686154369706666E-22,
    -0.55949583481815947292156013226666E-23,
    +0.10566354268835681048187284138666E-23,
    -0.19972483680670204548314999466666E-24,
    +0.37782977818839361421049855999999E-25,
    -0.71531586889081740345038165333333E-26,
    +0.13552488463674213646502024533333E-26,
    -0.25694673048487567430079829333333E-27,
    +0.48747756066216949076459519999999E-28,
    -0.92542112530849715321132373333333E-29,
    +0.17578597841760239233269760000000E-29,
    -0.33410026677731010351377066666666E-30,
    +0.63533936180236187354180266666666E-31 };
  static int nlnrel = 0;
  double value;
  static double xmin = 0.0;

  if ( nlnrel == 0 )
  {
    nlnrel = r8_inits ( alnrcs, 43, 0.1 * r8_mach ( 3 ) );
    xmin = - 1.0 + sqrt ( r8_mach ( 4 ) );
  }

  if ( x <= - 1.0 )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R8_LNREL - Fatal error!\n" );
    fprintf ( stderr, "  X <= -1.\n" );
    exit ( 1 );
  }
  else if ( x < xmin )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R8_LNREL - Warning!\n" );
    fprintf ( stderr, "  Result is less than half precision.\n" );
    fprintf ( stderr, "  X is too close to - 1.\n" );
  }

  if ( fabs ( x ) <= 0.375 )
  {
    value = x * ( 1.0 - x * r8_csevl ( x / 0.375, alnrcs, nlnrel ) );
  }
  else
  {
    value = log ( 1.0 + x );
  }

  return value;
}
/******************************************************************************/

double r8_log ( double x )

/******************************************************************************/
/*
  Purpose:

    R8_LOG evaluates the logarithm of an R8.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, double X, the evaluation point.

    Output, double R8_LOG, the logarithm of X.
*/
{
  const double aln2 = 0.06814718055994530941723212145818;
  static double alncen[5] = {
     0.0,
    +0.22314355131420975576629509030983,
    +0.40546510810816438197801311546434,
    +0.55961578793542268627088850052682,
    +0.69314718055994530941723212145817 };
  static double alncs[11] = {
    +0.13347199877973881561689386047187E+01,
    +0.69375628328411286281372438354225E-03,
    +0.42934039020450834506559210803662E-06,
    +0.28933847795432594580466440387587E-09,
    +0.20512517530340580901741813447726E-12,
    +0.15039717055497386574615153319999E-15,
    +0.11294540695636464284521613333333E-18,
    +0.86355788671171868881946666666666E-22,
    +0.66952990534350370613333333333333E-25,
    +0.52491557448151466666666666666666E-28,
    +0.41530540680362666666666666666666E-31 };
  static double center[4] = {
    1.0,
    1.25,
    1.50,
    1.75 };
  int n;
  static int nterms = 0;
  int ntrval;
  double t;
  double t2;
  double value;
  double xn;
  double y;

  if ( nterms == 0 )
  {
    nterms = r8_inits ( alncs, 11, 28.9 * r8_mach ( 3 ) );
  }

  if ( x <= 0.0 )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R8_LOG - Fatal error!\n" );
    fprintf ( stderr, "  X <= 0.\n" );
    exit ( 1 );
  }

  r8_upak ( x, &y, &n );

  xn = ( double ) ( n - 1 );
  y = 2.0 * y;
  ntrval = ( int ) ( 4.0 * y - 2.5 );

  if ( ntrval == 5 )
  {
    t = ( ( y - 1.0 ) - 1.0 ) / ( y + 2.0 );
  }
  else if ( ntrval < 5 )
  {
    t = ( y - center[ntrval-1] ) / ( y + center[ntrval-1] );
  }

  t2 = t * t;
  value = 0.625 * xn + ( aln2 * xn + alncen[ntrval-1] + 2.0 * t 
    + t * t2 * r8_csevl ( 578.0 * t2 - 1.0, alncs, nterms) );

  return value;
}
/******************************************************************************/

double r8_log10 ( double x )

/******************************************************************************/
/*
  Purpose:

    R8_LOG10 evaluates the logarithm, base 10, of an R8.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, double X, the evaluation point.

    Output, double R8_LOG10, the logarithm, base 10, of X.
*/
{
  const double aloge = 0.43429448190325182765112891891661;
  double value;

  value = aloge * log ( x );

  return value;
}
/******************************************************************************/

double r8_mach ( int i )

/******************************************************************************/
/*
  Purpose:

    R8_MACH returns double precision real machine constants.

  Discussion:

    Assuming that the internal representation of a double precision real
    number is in base B, with T the number of base-B digits in the mantissa,
    and EMIN the smallest possible exponent and EMAX the largest possible 
    exponent, then

      R8_MACH(1) = B^(EMIN-1), the smallest positive magnitude.
      R8_MACH(2) = B^EMAX*(1-B^(-T)), the largest magnitude.
      R8_MACH(3) = B^(-T), the smallest relative spacing.
      R8_MACH(4) = B^(1-T), the largest relative spacing.
      R8_MACH(5) = log10(B).

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    24 April 2007

  Author:

    Original FORTRAN77 version by Phyllis Fox, Andrew Hall, Norman Schryer.
    C version by John Burkardt.

  Reference:

    Phyllis Fox, Andrew Hall, Norman Schryer,
    Algorithm 528:
    Framework for a Portable Library,
    ACM Transactions on Mathematical Software,
    Volume 4, Number 2, June 1978, page 176-188.

  Parameters:

    Input, int I, chooses the parameter to be returned.
    1 <= I <= 5.

    Output, double R8_MACH, the value of the chosen parameter.
*/
{
  double value;

  if ( i < 1 )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R8_MACH - Fatal error!\n" );
    fprintf ( stderr, "  The input argument I is out of bounds.\n" );
    fprintf ( stderr, "  Legal values satisfy 1 <= I <= 5.\n" );
    fprintf ( stderr, "  I = %d\n", i );
    value = 0.0;
    exit ( 1 );
  }
  else if ( i == 1 )
  {
    value = 4.450147717014403E-308;
  }
  else if ( i == 2 )
  {
    value = 8.988465674311579E+307;
  }
  else if ( i == 3 )
  {
    value = 1.110223024625157E-016;
  }
  else if ( i == 4 )
  {
    value = 2.220446049250313E-016;
  }
  else if ( i == 5 )
  {
    value = 0.301029995663981E+000;
  }
  else if ( 5 < i )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R8_MACH - Fatal error!\n" );
    fprintf ( stderr, "  The input argument I is out of bounds.\n" );
    fprintf ( stderr, "  Legal values satisfy 1 <= I <= 5.\n" );
    fprintf ( stderr, "  I = %d\n", i );
    value = 0.0;
    exit ( 1 );
  }

  return value;
}
/******************************************************************************/

void r8_machar ( long int *ibeta, long int *it, long int *irnd, long int *ngrd,
  long int *machep, long int *negep, long int *iexp, long int *minexp,
  long int *maxexp, double *eps, double *epsneg, double *xmin, double *xmax )

/******************************************************************************/
/*
  Purpose:

    R8_MACHAR computes machine constants for R8 arithmetic.

  Discussion:

    This routine determines the parameters of the floating-point 
    arithmetic system specified below.  The determination of the first 
    three uses an extension of an algorithm due to Malcolm, 
    incorporating some of the improvements suggested by Gentleman and 
    Marovich.  

    A FORTRAN version of this routine appeared as ACM algorithm 665.

    This routine is a C translation of the FORTRAN code, and appeared
    as part of ACM algorithm 722.

    An earlier version of this program was published in Cody and Waite.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    26 April 2006

  Author:

    Original FORTRAN77 version by William Cody.
    C version by John Burkardt.

  Reference:

    William Cody,
    ACM Algorithm 665, MACHAR, a subroutine to dynamically determine 
      machine parameters,
    ACM Transactions on Mathematical Software,
    Volume 14, Number 4, pages 303-311, 1988.

    William Cody and W Waite,
    Software Manual for the Elementary Functions,
    Prentice Hall, 1980.

    M Gentleman and S Marovich,
    Communications of the ACM,
    Volume 17, pages 276-277, 1974.

    M. Malcolm,
    Communications of the ACM,
    Volume 15, pages 949-951, 1972.

  Parameters:

    Output, long int *IBETA, the radix for the floating-point representation.

    Output, long int *IT, the number of base IBETA digits in the floating-point
    significand.

    Output, long int *IRND:
    0, if floating-point addition chops.
    1, if floating-point addition rounds, but not in the IEEE style.
    2, if floating-point addition rounds in the IEEE style.
    3, if floating-point addition chops, and there is partial underflow.
    4, if floating-point addition rounds, but not in the IEEE style, and 
      there is partial underflow.
    5, if floating-point addition rounds in the IEEE style, and there is 
      partial underflow.

    Output, long int *NGRD, the number of guard digits for multiplication with
    truncating arithmetic.  It is
    0, if floating-point arithmetic rounds, or if it truncates and only 
      IT base IBETA digits participate in the post-normalization shift of the
      floating-point significand in multiplication;
   1, if floating-point arithmetic truncates and more than IT base IBETA
      digits participate in the post-normalization shift of the floating-point
      significand in multiplication.

    Output, long int *MACHEP, the largest negative integer such that
      1.0 + ( double ) IBETA ^ MACHEP != 1.0, 
    except that MACHEP is bounded below by - ( IT + 3 ).

    Output, long int *NEGEPS, the largest negative integer such that
      1.0 - ( double ) IBETA ) ^ NEGEPS != 1.0, 
    except that NEGEPS is bounded below by - ( IT + 3 ).

    Output, long int *IEXP, the number of bits (decimal places if IBETA = 10)
    reserved for the representation of the exponent (including the bias or
    sign) of a floating-point number.

    Output, long int *MINEXP, the largest in magnitude negative integer such 
    that
      ( double ) IBETA ^ MINEXP 
    is positive and normalized.

    Output, long int *MAXEXP, the smallest positive power of BETA that overflows.
 
    Output, double *EPS, the smallest positive floating-point number such
    that  
      1.0 + EPS != 1.0. 
    in particular, if either IBETA = 2  or IRND = 0, 
      EPS = ( double ) IBETA ^ MACHEP.
    Otherwise,  
      EPS = ( ( double ) IBETA ^ MACHEP ) / 2.

    Output, double *EPSNEG, a small positive floating-point number such that
      1.0 - EPSNEG != 1.0. 
    In particular, if IBETA = 2 or IRND = 0, 
      EPSNEG = ( double ) IBETA ^ NEGEPS.
    Otherwise,  
      EPSNEG = ( double ) IBETA ^ NEGEPS ) / 2.  
    Because NEGEPS is bounded below by - ( IT + 3 ), EPSNEG might not be the
    smallest number that can alter 1.0 by subtraction.

    Output, double *XMIN, the smallest non-vanishing normalized floating-point
    power of the radix:
      XMIN = ( double ) IBETA ^ MINEXP

    Output, float *XMAX, the largest finite floating-point number.  In
    particular,
      XMAX = ( 1.0 - EPSNEG ) * ( double ) IBETA ^ MAXEXP
    On some machines, the computed value of XMAX will be only the second, 
    or perhaps third, largest number, being too small by 1 or 2 units in 
    the last digit of the significand.
*/
{
  double a;
  double b;
  double beta;
  double betah;
  double betain;
  int i;
  int itmp;
  int iz;
  int j;
  int k;
  int mx;
  int nxres;
  double one;
  double t;
  double tmp;
  double tmp1;
  double tmpa;
  double two;
  double y;
  double z;
  double zero;

  (*irnd) = 1;
  one = (double) (*irnd);
  two = one + one;
  a = two;
  b = a;
  zero = 0.0e0;
/*
  Determine IBETA and BETA ala Malcolm.
*/
  tmp = ( ( a + one ) - a ) - one;

  while ( tmp == zero )
  {
    a = a + a;
    tmp = a + one;
    tmp1 = tmp - a;
    tmp = tmp1 - one;
  }

  tmp = a + b;
  itmp = ( int ) ( tmp - a );

  while ( itmp == 0 )
  {
    b = b + b;
    tmp = a + b;
    itmp = ( int ) ( tmp - a );
  }

  *ibeta = itmp;
  beta = ( double ) ( *ibeta );
/*
  Determine IRND, IT.
*/
  ( *it ) = 0;
  b = one;
  tmp = ( ( b + one ) - b ) - one;

  while ( tmp == zero )
  {
    *it = *it + 1;
    b = b * beta;
    tmp = b + one;
    tmp1 = tmp - b;
    tmp = tmp1 - one;
  }

  *irnd = 0;
  betah = beta / two;
  tmp = a + betah;
  tmp1 = tmp - a;

  if ( tmp1 != zero )
  {
    *irnd = 1;
  }

  tmpa = a + beta;
  tmp = tmpa + betah;

  if ( ( *irnd == 0 ) && ( tmp - tmpa != zero ) )
  {
    *irnd = 2;
  }
/*
  Determine NEGEP, EPSNEG.
*/
  (*negep) = (*it) + 3;
  betain = one / beta;
  a = one;
 
  for ( i = 1; i <= (*negep); i++ )
  {
    a = a * betain;
  }
 
  b = a;
  tmp = ( one - a );
  tmp = tmp - one;

  while ( tmp == zero )
  {
    a = a * beta;
    *negep = *negep - 1;
    tmp1 = one - a;
    tmp = tmp1 - one;
  }

  (*negep) = -(*negep);
  (*epsneg) = a;
/*
  Determine MACHEP, EPS.
*/
  (*machep) = -(*it) - 3;
  a = b;
  tmp = one + a;

  while ( tmp - one == zero)
  {
    a = a * beta;
    *machep = *machep + 1;
    tmp = one + a;
  }

  *eps = a;
/*
  Determine NGRD.
*/
  (*ngrd) = 0;
  tmp = one + *eps;
  tmp = tmp * one;

  if ( ( (*irnd) == 0 ) && ( tmp - one ) != zero )
  {
    (*ngrd) = 1;
  }
/*
  Determine IEXP, MINEXP and XMIN.

  Loop to determine largest I such that (1/BETA) ** (2**(I))
  does not underflow.  Exit from loop is signaled by an underflow.
*/
  i = 0;
  k = 1;
  z = betain;
  t = one + *eps;
  nxres = 0;

  for ( ; ; )
  {
    y = z;
    z = y * y;
/*
  Check for underflow
*/
    a = z * one;
    tmp = z * t;

    if ( ( a + a == zero ) || ( fabs ( z ) > y ) )
    {
      break;
    }

    tmp1 = tmp * betain;

    if ( tmp1 * beta == z )
    {
      break;
    }

    i = i + 1;
    k = k + k;
  }
/*
  Determine K such that (1/BETA)^K does not underflow.
  First set  K = 2 ^ I.
*/
  (*iexp) = i + 1;
  mx = k + k;
/*
  For decimal machines only
*/
  if ( *ibeta == 10 )
  {
    (*iexp) = 2;
    iz = *ibeta;
    while ( iz <= k )
    {
      iz = iz * ( *ibeta );
      (*iexp) = (*iexp) + 1;
    }
    mx = iz + iz - 1;
  } 
/*
  Loop to determine MINEXP, XMIN.
  Exit from loop is signaled by an underflow.
*/
  for ( ; ; )
  {
    (*xmin) = y;
    y = y * betain;
    a = y * one;
    tmp = y * t;
    tmp1 = a + a;

    if ( ( tmp1 == zero ) || ( fabs ( y ) >= ( *xmin ) ) )
    {
      break;
    }

    k = k + 1;
    tmp1 = tmp * betain;
    tmp1 = tmp1 * beta;

    if ( ( tmp1 == y ) && ( tmp != y ) )
    {
      nxres = 3;
      *xmin = y;
      break;
    }

  }

  (*minexp) = -k;
/*
  Determine MAXEXP, XMAX.
*/
  if ( ( mx <= k + k - 3 ) && ( ( *ibeta ) != 10 ) )
  {
    mx = mx + mx;
    (*iexp) = (*iexp) + 1;
  }

  (*maxexp) = mx + (*minexp);
/*
  Adjust IRND to reflect partial underflow.
*/
  (*irnd) = (*irnd) + nxres;
/*
  Adjust for IEEE style machines.
*/
  if ( ( *irnd) >= 2 )
  {
    (*maxexp) = (*maxexp) - 2;
  }
/*
  Adjust for machines with implicit leading bit in binary
  significand and machines with radix point at extreme
  right of significand.
*/
  i = (*maxexp) + (*minexp);

  if ( ( ( *ibeta ) == 2 ) && ( i == 0 ) )
  {
    (*maxexp) = (*maxexp) - 1;
  }

  if ( i > 20 )
  {
    (*maxexp) = (*maxexp) - 1;
  }

  if ( a != y )
  {
    (*maxexp) = (*maxexp) - 2;
  }

  (*xmax) = one - (*epsneg);
  tmp = (*xmax) * one;

  if ( tmp != (*xmax) )
  {
    (*xmax) = one - beta * (*epsneg);
  }

  (*xmax) = (*xmax) / ( beta * beta * beta * (*xmin) );
  i = (*maxexp) + (*minexp) + 3;

  if ( i > 0 )
  {
 
    for ( j = 1; j <= i; j++ )
    {
      if ( (*ibeta) == 2 )
      {
        (*xmax) = (*xmax) + (*xmax);
      }
      if ( (*ibeta) != 2 )
      {
        (*xmax) = (*xmax) * beta;
      }
    }

  }
  return;
}
/******************************************************************************/

double r8_max ( double x, double y )

/******************************************************************************/
/*
  Purpose:

    R8_MAX returns the maximum of two R8's.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    18 August 2004

  Author:

    John Burkardt

  Parameters:

    Input, double X, Y, the quantities to compare.

    Output, double R8_MAX, the maximum of X and Y.
*/
{
  double value;

  if ( y < x )
  {
    value = x;
  } 
  else
  {
    value = y;
  }
  return value;
}
/******************************************************************************/

double r8_min ( double x, double y )

/******************************************************************************/
/*
  Purpose:

    R8_MIN returns the minimum of two R8's.

  Licensing:

    This code is distributed under the MIT license.

  Modified:

    31 August 2004

  Author:

    John Burkardt

  Parameters:

    Input, double X, Y, the quantities to compare.

    Output, double R8_MIN, the minimum of X and Y.
*/
{
  double value;

  if ( y < x )
  {
    value = y;
  }
  else
  {
    value = x;
  }
  return value;
}
/******************************************************************************/

double r8_mod ( double x, double y )

/******************************************************************************/
/*
  Purpose:

    R8_MOD returns the remainder of R8 division.

  Discussion:

    If
      REM = R8_MOD ( X, Y )
      RMULT = ( X - REM ) / Y
    then
      X = Y * RMULT + REM
    where REM has the same sign as X, and abs ( REM ) < Y.

  Example:

        X         Y     R8_MOD   R8_MOD  Factorization

      107        50       7     107 =  2 *  50 + 7
      107       -50       7     107 = -2 * -50 + 7
     -107        50      -7    -107 = -2 *  50 - 7
     -107       -50      -7    -107 =  2 * -50 - 7

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    14 June 2007

  Author:

    John Burkardt

  Parameters:

    Input, double X, the number to be divided.

    Input, double Y, the number that divides X.

    Output, double R8_MOD, the remainder when X is divided by Y.
*/
{
  double value;

  if ( y == 0.0 )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R8_MOD - Fatal error!\n" );
    fprintf ( stderr, "  R8_MOD ( X, Y ) called with Y = %g\n", y );
    exit ( 1 );
  }

  value = x - ( ( double ) ( ( int ) ( x / y ) ) ) * y;

  if ( x < 0.0 && 0.0 < value )
  {
    value = value - fabs ( y );
  }
  else if ( 0.0 < x && value < 0.0 )
  {
    value = value + fabs ( y );
  }

  return value;
}
/******************************************************************************/

double r8_mop ( int i )

/******************************************************************************/
/*
  Purpose:

    R8_MOP returns the I-th power of -1 as an R8 value.

  Discussion:

    An R8 is an double value.

  Licensing:

    This code is distributed under the MIT license.

  Modified:

    16 November 2007

  Author:

    John Burkardt

  Parameters:

    Input, int I, the power of -1.

    Output, double R8_MOP, the I-th power of -1.
*/
{
  double value;

  if ( ( i % 2 ) == 0 )
  {
    value = 1.0;
  }
  else
  {
    value = -1.0;
  }

  return value;
}
/******************************************************************************/

double r8_pak ( double y, int n )

/******************************************************************************/
/*
  Purpose:

    R8_PAK packs a base 2 exponent into an R8.

  Discussion:

    This routine is almost the inverse of R8_UPAK.  It is not exactly 
    the inverse, because abs(x) need not be between 0.5 and 1.0.  
    If both R8_PAK and 2.0^n were known to be in range, we could compute
    R8_PAK = x * 2.0^n .

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    C version by John Burkardt.

  Parameters:

    Input, double Y, the mantissa.

    Input, int N, the exponent.

    Output, double R8_PAK, the packed value.
*/
{
  const double aln210 = 3.321928094887362347870319429489;
  double aln2b;
  static int nmax = 0;
  static int nmin = 0;
  int nsum;
  int ny;
  double value;

  if ( nmin == 0 )
  {
    aln2b = 1.0;
    if ( i4_mach ( 10 ) != 2 )
    {
      aln2b = r8_mach ( 5 ) * aln210;
    }
    nmin = aln2b * ( double ) ( i4_mach ( 15 ) );
    nmax = aln2b * ( double ) ( i4_mach ( 16 ) );
  }

  r8_upak ( y, &value, &ny );

  nsum = n + ny;

  if ( nsum < nmin )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R8_PAK - Warning!\n" );
    fprintf ( stderr, "  Packed number underflows.\n" );
    value = 0.0;
    return value;
  }

  if ( nmax < nsum )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R8_PAK - Fatal error!\n" );
    fprintf ( stderr, "  Packed number overflows.\n" );
    exit ( 1 );
  }

  while ( nsum < 0 )
  {
    value = 0.5 * value;
    nsum = nsum + 1;
  }

  while ( 0 < nsum )
  {
    value = 2.0 * value;
    nsum = nsum - 1;
  }
  return value;
}
/******************************************************************************/

double r8_poch ( double a, double x )

/******************************************************************************/
/*
  Purpose:

    R8_POCH evaluates Pochhammer's function of R8 arguments.

  Discussion:

    POCH ( A, X ) = Gamma ( A + X ) / Gamma ( A ).

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, double A, X, the arguments.

    Output, double R8_POCH, the Pochhammer function of A and X.
*/
{
  double absa;
  double absax;
  double alnga;
  double alngax;
  double ax;
  double b;
  double cospia;
  double cospix;
  double den;
  static double eps = 0.0;
  double err;
  double errpch;
  int i;
  int ia;
  int n;
  const double pi = 3.141592653589793238462643383279503;
  double sgnga;
  double sgngax;
  double sinpia;
  double sinpix;
  double value;

  if ( eps == 0.0 )
  {
    eps = r8_mach ( 4 );
  }

  ax = a + x;

  if ( ax <= 0.0 && r8_aint ( ax ) == ax )
  {
    if ( 0.0 < a || r8_aint ( a ) != a )
    {
      fprintf ( stderr, "\n" );
      fprintf ( stderr, "R8_POCH - Fatal error!\n" );
      fprintf ( stderr, "  A + X is nonpositive int,\n" );
      fprintf ( stderr, "  but A is not.\n" );
      exit ( 1 );
    }
/*
  We know here that both A+X and A are non-positive integers.
*/
    if ( x == 0.0 )
    {
      value = 1.0;
    }
    else if ( - 20.0 < fmin ( a + x, a ) )
    {
      n = ( int ) ( x );
      ia = ( int ) ( a );
      value = r8_mop ( n ) * r8_fac ( - ia ) / r8_fac ( - ia - n );
    }
    else
    {
      n = ( int ) ( x );
      value = r8_mop ( n ) * exp ( ( a - 0.5 ) 
        * r8_lnrel ( x / ( a - 1.0 ) ) 
        + x * log ( - a + 1.0 - x ) - x 
        + r8_lgmc ( - a + 1.0 ) 
        - r8_lgmc ( - a - x + 1.0 ) );
    }
    return value;
  }
/*
  A + X is not zero or a negative integer.
*/
  if ( a <= 0.0 && r8_aint ( a ) == a )
  {
    value = 0.0;
    return value;
  }

  n = fabs ( x );
/*
  X is a small non-positive integer, presummably a common case.
*/
  if ( ( double ) ( n ) == x && n <= 20 )
  {
    value = 1.0;
    for ( i = 1; i <= n; i++ )
    {
      value = value * ( a + ( double ) ( i - 1 ) );
    }
    return value;
  }

  absax = fabs ( a + x );
  absa = fabs ( a );

  if ( fmax ( absax, absa ) <= 20.0 )
  {
    value = r8_gamma ( a + x ) * r8_gamr ( a );
    return value;
  }

  if ( 0.5 * absa < fabs ( x ) )
  {
    r8_lgams ( a + x, &alngax, &sgngax );
    r8_lgams ( a, &alnga, &sgnga );
    value = sgngax * sgnga * exp ( alngax - alnga );
    return value;
  }
/*
  abs(x) is small and both abs(a+x) and abs(a) are large.  thus,
  a+x and a must have the same sign.  for negative a, we use
  gamma(a+x)/gamma(a) = gamma(-a+1)/gamma(-a-x+1) *
  sin(pi*a)/sin(pi*(a+x))
*/
  if ( a < 0.0 )
  {
    b = - a - x + 1.0;
  }
  else
  {
    b = a;
  }

  value = exp ( ( b - 0.5 ) * r8_lnrel ( x / b ) 
    + x * log ( b + x ) - x + r8_lgmc ( b + x ) - r8_lgmc ( b ) );

  if ( 0.0 <= a || value == 0.0 )
  {
    return value;
  }

  cospix = cos ( pi * x );
  sinpix = sin ( pi * x );
  cospia = cos ( pi * a );
  sinpia = sin ( pi * a );

  errpch = fabs ( x ) * ( 1.0 + log ( b ) );
  den = cospix + cospia * sinpix / sinpia;
  err = ( fabs ( x ) * ( fabs ( sinpix ) 
    + fabs ( cospia * cospix / sinpia ) )
    + fabs ( a * sinpix ) / sinpia / sinpia ) * pi;
  err = errpch + err / fabs ( den );

  value = value / den;

  return value;
}
/******************************************************************************/

double r8_poch1 ( double a, double x )

/******************************************************************************/
/*
  Purpose:

    R8_POCH1 evaluates a quantity related to Pochhammer's symbol.

  Discussion:

    Evaluate a generalization of Pochhammer's symbol for special
    situations that require especially accurate values when x is small in
      poch1(a,x) = (poch(a,x)-1)/x
                 = (gamma(a+x)/gamma(a) - 1.0)/x .
    This specification is particularly suited for stably computing
    expressions such as
      (gamma(a+x)/gamma(a) - gamma(b+x)/gamma(b))/x
           = poch1(a,x) - poch1(b,x)
    Note that poch1(a,0.0) = psi(a)

    When abs(x) is so small that substantial cancellation will occur if
    the straightforward formula is used, we  use an expansion due
    to fields and discussed by y. l. luke, the special functions and their
    approximations, vol. 1, academic press, 1969, page 34.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, double A, the parameter.

    Input, double X, the evaluation point.

    Output, double R8_POCH1, the value of the function.
*/
{
  double absa;
  double absx;
  static double alneps = 0.0;
  double alnvar;
  double b;
  static double bern[20] = {
    +0.833333333333333333333333333333333E-01,
    -0.138888888888888888888888888888888E-02,
    +0.330687830687830687830687830687830E-04,
    -0.826719576719576719576719576719576E-06,
    +0.208767569878680989792100903212014E-07,
    -0.528419013868749318484768220217955E-09,
    +0.133825365306846788328269809751291E-10,
    -0.338968029632258286683019539124944E-12,
    +0.858606205627784456413590545042562E-14,
    -0.217486869855806187304151642386591E-15,
    +0.550900282836022951520265260890225E-17,
    -0.139544646858125233407076862640635E-18,
    +0.353470703962946747169322997780379E-20,
    -0.895351742703754685040261131811274E-22,
    +0.226795245233768306031095073886816E-23,
    -0.574472439520264523834847971943400E-24,
    +0.145517247561486490186626486727132E-26,
    -0.368599494066531017818178247990866E-28,
    +0.933673425709504467203255515278562E-30,
    -0.236502241570062993455963519636983E-31 };
  double binv;
  double bp;
  double gbern[21];
  double gbk;
  int i;
  int ii;
  int incr;
  int j;
  int k;
  int ndx;
  int nterms;
  const double pi = 3.141592653589793238462643383279503;
  double poly1;
  double q;
  double rho;
  double sinpxx;
  double sinpx2;
  static double sqtbig = 0.0;
  double term;
  double trig;
  double value;
  double var;
  double var2;

  if ( sqtbig == 0.0 )
  {
    sqtbig = 1.0 / sqrt ( 24.0 * r8_mach ( 1 ) );
    alneps = log ( r8_mach ( 3 ) );
  }

  if ( x == 0.0 )
  {
    value = r8_psi ( a );
    return value;
  }

  absx = fabs ( x );
  absa = fabs ( a );

  if ( 0.1 * absa < absx || 0.1 < absx * log ( fmax ( absa, 2.0 ) ) )
  {
    value = r8_poch ( a, x );
    value = ( value - 1.0 ) / x;
    return value;
  }

  if ( a < - 0.5 )
  {
    bp = 1.0 - a - x;
  }
  else
  {
    bp = a;
  }

  if ( bp < 10.0 )
  {
    incr = r8_aint ( 11.0 - bp );
  }
  else
  {
    incr = 0;
  }

  b = bp + ( double ) ( incr );

  var = b + 0.5 * ( x - 1.0 );
  alnvar = log ( var );
  q = x * alnvar;
  poly1 = 0.0;

  if ( var < sqtbig )
  {
    var2 = 1.0 / var / var;

    rho = 0.5 * ( x + 1.0 );
    gbern[0] = 1.0;
    gbern[1] = - rho / 12.0;
    term = var2;
    poly1 = gbern[1] * term;

    nterms = ( int ) ( - 0.5 * alneps / alnvar + 1.0 );

    if ( 20 < nterms )
    {
      fprintf ( stderr, "\n" );
      fprintf ( stderr, "R8_POCH1 - Fatal error!\n" );
      fprintf ( stderr, " 20 < NTERMS.\n" );
      exit ( 1 );
    } 

    for ( k = 2; k <= nterms; k++ )
    {
      gbk = 0.0;
      for ( j = 1; j <= k; j++ )
      {
        ndx = k - j + 1;
        gbk = gbk + bern[ndx-1] * gbern[j-1];
      }
      gbern[k] = - rho * gbk / ( double ) ( k );
      term = term * ( ( double ) ( 2 * k - 2 ) - x )
        * ( ( double ) ( 2 * k - 1 ) - x ) * var2;
      poly1 = poly1 + gbern[k] * term;
    }
  }
  poly1 = ( x - 1.0 ) * poly1;
  value = r8_exprel ( q ) * ( alnvar + q * poly1 ) + poly1;
/*
  We have r8_poch1(b,x), but bp is small, so we use backwards recursion
  to obtain r8_poch1(bp,x).
*/
  for ( ii = 1; ii <= incr; ii++ )
  {
    i = incr - ii;
    binv = 1.0 / ( bp + ( double ) ( i ) );
    value = ( value - binv ) / ( 1.0 + x * binv );
  }

  if ( bp == a )
  {
    return value;
  }
/*
  We have r8_poch1(bp,x), but a is lt -0.5.  we therefore use a reflection
  formula to obtain r8_poch1(a,x).
*/
  sinpxx = sin ( pi * x ) / x;
  sinpx2 = sin ( 0.5 * pi * x );
  trig = sinpxx * r8_cot ( pi * b ) - 2.0 * sinpx2 * ( sinpx2 / x );

  value = trig + ( 1.0 + x * trig ) * value;

  return value;
}
/******************************************************************************/

double r8_power ( double a, double b )

/******************************************************************************/
/*
  Purpose:

    R8_POWER evaluates A^B.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    John Burkardt

  Parameters:

    Input, double A, the base.

    Input, double B, the exponent.

    Output, double R8_POWER, the value of A^B.
*/
{
  double value;

  value = pow ( a, b );

  return value;
}
/******************************************************************************/

double r8_psi ( double x )

/******************************************************************************/
/*
  Purpose:

    R8_PSI evaluates the psi function of an R8 argument.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, double X, the argument.

    Output, double R8_PSI, the psi function of X.
*/
{
  static double apsics[16] = {
    -0.832710791069290760174456932269E-03,
    -0.416251842192739352821627121990E-03,
    +0.103431560978741291174463193961E-06,
    -0.121468184135904152987299556365E-09,
    +0.311369431998356155521240278178E-12,
    -0.136461337193177041776516100945E-14,
    +0.902051751315416565130837974000E-17,
    -0.831542997421591464829933635466E-19,
    +0.101224257073907254188479482666E-20,
    -0.156270249435622507620478933333E-22,
    +0.296542716808903896133226666666E-24,
    -0.674686886765702163741866666666E-26,
    +0.180345311697189904213333333333E-27,
    -0.556901618245983607466666666666E-29,
    +0.195867922607736251733333333333E-30,
    -0.775195892523335680000000000000E-32 };
  double aux;
  static double dxrel = 0.0;
  int i;
  int n;
  static int ntapsi = 0;
  static int ntpsi = 0;
  const double pi = 3.14159265358979323846264338327950;
  static double psics[42] = {
    -0.38057080835217921520437677667039E-01,
    +0.49141539302938712748204699654277,
    -0.56815747821244730242892064734081E-01,
    +0.83578212259143131362775650747862E-02,
    -0.13332328579943425998079274172393E-02,
    +0.22031328706930824892872397979521E-03,
    -0.37040238178456883592889086949229E-04,
    +0.62837936548549898933651418717690E-05,
    -0.10712639085061849855283541747074E-05,
    +0.18312839465484165805731589810378E-06,
    -0.31353509361808509869005779796885E-07,
    +0.53728087762007766260471919143615E-08,
    -0.92116814159784275717880632624730E-09,
    +0.15798126521481822782252884032823E-09,
    -0.27098646132380443065440589409707E-10,
    +0.46487228599096834872947319529549E-11,
    -0.79752725638303689726504797772737E-12,
    +0.13682723857476992249251053892838E-12,
    -0.23475156060658972717320677980719E-13,
    +0.40276307155603541107907925006281E-14,
    -0.69102518531179037846547422974771E-15,
    +0.11856047138863349552929139525768E-15,
    -0.20341689616261559308154210484223E-16,
    +0.34900749686463043850374232932351E-17,
    -0.59880146934976711003011081393493E-18,
    +0.10273801628080588258398005712213E-18,
    -0.17627049424561071368359260105386E-19,
    +0.30243228018156920457454035490133E-20,
    -0.51889168302092313774286088874666E-21,
    +0.89027730345845713905005887487999E-22,
    -0.15274742899426728392894971904000E-22,
    +0.26207314798962083136358318079999E-23,
    -0.44964642738220696772598388053333E-24,
    +0.77147129596345107028919364266666E-25,
    -0.13236354761887702968102638933333E-25,
    +0.22709994362408300091277311999999E-26,
    -0.38964190215374115954491391999999E-27,
    +0.66851981388855302310679893333333E-28,
    -0.11469986654920864872529919999999E-28,
    +0.19679385886541405920515413333333E-29,
    -0.33764488189750979801907200000000E-30,
    +0.57930703193214159246677333333333E-31 };
  double value;
  static double xbig = 0.0;
  double y;

  if ( ntpsi == 0 )
  {
    ntpsi = r8_inits ( psics, 42, 0.1 * r8_mach ( 3 ) );
    ntapsi = r8_inits ( apsics, 16, 0.1 * r8_mach ( 3 ) );
    xbig = 1.0 / sqrt ( r8_mach ( 3 ) );
    dxrel = sqrt ( r8_mach ( 4 ) );
  }

  y = fabs ( x );

  if ( y < 10.0 )
  {
    n = ( int ) ( x );
    if ( x < 0.0 )
    {
      n = n - 1;
    }
    y = x - ( double ) ( n );
    n = n - 1;
    value = r8_csevl ( 2.0 * y - 1.0, psics, ntpsi );

    if ( n == 0 )
    {
      return value;
    }
    else if ( n < 0 )
    {
      n = - n;

      if ( x == 0.0 )
      {
        fprintf ( stderr, "\n" );
        fprintf ( stderr, "R8_PSI - Fatal error!\n" );
        fprintf ( stderr, "  X is zero.\n" );
        exit ( 1 );
      }

      if ( x < 0.0 && x + ( double ) ( n - 2 ) == 0.0 )
      {
        fprintf ( stderr, "\n" );
        fprintf ( stderr, "R8_PSI - Fatal error!\n" );
        fprintf ( stderr, "  X is a negative int.\n" );
        exit ( 1 );
      }

      if ( x < - 0.5 && fabs ( ( x - r8_aint ( x - 0.5 ) ) / x ) < dxrel )
      {
        fprintf ( stderr, "\n" );
        fprintf ( stderr, "R8_PSI - Warning!\n" );
        fprintf ( stderr, "  Answer is less than half precision\n" );
        fprintf ( stderr, "  because X is near a negative int.\n" );
      }

      for ( i = 1; i <= n; i++ )
      {
        value = value - 1.0 / ( x + ( double ) ( i - 1 ) );
      }
    }
    else if ( 0 < n )
    {
      for ( i = 1; i <= n; i++ )
      {
        value = value + 1.0 / ( y + ( double ) ( i ) );
      }

    }
  }
  else
  {
    if ( y < xbig )
    {
      aux = r8_csevl ( 8.0 / y / y - 1.0, apsics, ntapsi );
    }
    else
    {
      aux = 0.0;
    }

    if ( x < 0.0 )
    {
      value = log ( fabs ( x ) ) - 0.5 / x + aux 
        - pi * r8_cot ( pi * x );
    }
    else if ( 0.0 < x )
    {
      value = log ( x ) - 0.5 / x + aux;
    }
  }
  return value;
}
/******************************************************************************/

double r8_rand ( double r, int *ix0, int *ix1 )

/******************************************************************************/
/*
  Purpose:

    R8_RAND is a portable pseudorandom number generator.

  Discussion:

    This pseudo-random number generator is portable amoung a wide
    variety of computers.  It is undoubtedly not as good as many
    readily available installation dependent versions, and so this
    routine is not recommended for widespread usage.  Its redeeming
    feature is that the exact same random numbers (to within final round-
    off error) can be generated from machine to machine.  Thus, programs
    that make use of random numbers can be easily transported to and
    checked in a new environment.

    The random numbers are generated by the linear congruential
    method described by Knuth in seminumerical methods (p.9),
    addison-wesley, 1969.  Given the i-th number of a pseudo-random
    sequence, the i+1 -st number is generated from
      x(i+1) = (a*x(i) + c) mod m,
    where here m = 2^22 = 4194304, c = 1731 and several suitable values
    of the multiplier a are discussed below.  Both the multiplier a and
    random number x are represented in double precision as two 11-bit
    words.  The constants are chosen so that the period is the maximum
    possible, 4194304.

    In order that the same numbers be generated from machine to
    machine, it is necessary that 23-bit ints be reducible modulo
    2^11 exactly, that 23-bit ints be added exactly, and that 11-bit
    ints be multiplied exactly.  Furthermore, if the restart option
    is used (where r is between 0 and 1), then the product r*2^22 =
    r*4194304 must be correct to the nearest int.

    The first four random numbers should be 

      0.0004127026,
      0.6750836372, 
      0.1614754200, 
      0.9086198807.

    The tenth random number is 

      0.5527787209.

    The hundredth random number is 

      0.3600893021.  

    The thousandth number should be 

      0.2176990509.

    In order to generate several effectively independent sequences
    with the same generator, it is necessary to know the random number
    for several widely spaced calls.  The I-th random number times 2^22,
    where I=K*P/8 and P is the period of the sequence (P = 2^22), is
    still of the form L*P/8.  In particular we find the I-th random
    number multiplied by 2^22 is given by
      I   =  0  1*p/8  2*p/8  3*p/8  4*p/8  5*p/8  6*p/8  7*p/8  8*p/8
      RAND=  0  5*p/8  2*p/8  7*p/8  4*p/8  1*p/8  6*p/8  3*p/8  0
    thus the 4*P/8 = 2097152 random number is 2097152/2^22.

    Several multipliers have been subjected to the spectral test
    (see Knuth, p. 82).  Four suitable multipliers roughly in order of
    goodness according to the spectral test are
      3146757 = 1536*2048 + 1029 = 2^21 + 2^20 + 2^10 + 5
      2098181 = 1024*2048 + 1029 = 2^21 + 2^10 + 5
      3146245 = 1536*2048 +  517 = 2^21 + 2^20 + 2^9 + 5
      2776669 = 1355*2048 + 1629 = 5^9 + 7^7 + 1

    In the table below log10(NU(I)) gives roughly the number of
    random decimal digits in the random numbers considered I at a time.
    C is the primary measure of goodness.  In both cases bigger is better.

                     log10 nu(i)              c(i)
         a       i=2  i=3  i=4  i=5    i=2  i=3  i=4  i=5

      3146757    3.3  2.0  1.6  1.3    3.1  1.3  4.6  2.6
      2098181    3.3  2.0  1.6  1.2    3.2  1.3  4.6  1.7
      3146245    3.3  2.2  1.5  1.1    3.2  4.2  1.1  0.4
      2776669    3.3  2.1  1.6  1.3    2.5  2.0  1.9  2.6
     best
      possible   3.3  2.3  1.7  1.4    3.6  5.9  9.7  14.9

    Note that the original version of this routine used local static
    variables IX0 and IX1.  In this revised version, IX0 and IX1 are
    routine arguments.  To duplicate the behavior of the original code,
    IX0 and IX1 should be set to zero before the first call.  
    JVB, 04 May 2016.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    05 May 2016

  Author:

    C version by John Burkardt.

  Parameters:

    Input, real R, determines the action.
    * R = 0.0, the next random number of the sequence is generated.
    * R < 0.0, the last generated number will be returned for
    possible use in a restart procedure.
    * R > 0.0, the sequence of random numbers will start with the
    seed ( R mod 1 ).  This seed is also returned as the value of
    R8_RAND provided the arithmetic is done exactly.

    Input/output, int *IX0, *IX1, two parameters used
    as seeds for the random number generator.  On first call, these
    might both be set to 0.

    Output, real R8_RAND, a pseudo-random number between 0.0 and 1.0.
*/
{
  const int ia0 = 1029;
  const int ia1 = 1536;
  const int ia1ma0 = 507;
  const int ic = 1731;
  int iy0;
  int iy1;
  double value;

  if ( r == 0.0E+00 )
  {
    iy0 = ia0 * ( *ix0 );
    iy1 = ia1 * ( *ix1 ) + ia1ma0 * ( ( *ix0 ) - ( *ix1 ) ) + iy0;
    iy0 = iy0 + ic;
    *ix0 = ( iy0 % 2048 );
    iy1 = iy1 + ( iy0 - ( *ix0 ) ) / 2048;
    *ix1 = ( iy1 % 2048 );
  }

  if ( 0.0 < r )
  {
    *ix1 = ( int ) ( r8_mod ( r, 1.0E+00 ) * 4194304.0 + 0.5E+00 );
    *ix0 = ( ( *ix1 ) % 2048 );
    *ix1 = ( ( *ix1 ) - ( *ix0 ) ) / 2048;
  }

  value = ( double ) ( ( *ix1 ) * 2048 + ( *ix0 ) );
  value = value / 4194304.0E+00;
 
  return value;
}
/******************************************************************************/

double r8_randgs ( double xmean, double sd, int *seed )

/******************************************************************************/
/*
  Purpose:

    R8_RANDGS generates a normally distributed random number.

  Discussion:

    This function generate a normally distributed random number, that is, 
    it generates random numbers with a Gaussian distribution.  These 
    random numbers are not exceptionally good, especially in the tails 
    of the distribution, but this implementation is simple and suitable 
    for most applications.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    24 April 2016

  Author:

    C version by John Burkardt.

  Reference:

    Richard Hamming,
    Numerical Methods for Scientists and Engineers,
    Dover, 1986,
    ISBN: 0486652416,
    LC: QA297.H28.

  Parameters:

    Input, double XMEAN, the mean of the Gaussian distribution.

    Input, double SD, the standard deviation of the Gaussian function.

    Input/output, int *SEED, a seed for the random number generator.

    Output, double R8_RANDGS, a normally distributed random number.
*/
{
  int i;
  double value;

  value = - 6.0E+00;
  for ( i = 1; i <= 12; i++ )
  {
    value = value + r8_ren ( seed );
  }
  value = xmean + sd * value;

  return value;
}
/******************************************************************************/

double r8_random ( int n, double t[], int *ix0, int *ix1 )

/******************************************************************************/
/*
  Purpose:

    R8_RANDOM is a portable pseudorandom number generator.

  Discussion:

    This random number generator is portable amoung a wide variety of
    computers.  It generates a random number between 0.0 and 1.0 
    according to the algorithm presented by Bays and Durham.

    The motivation for using this scheme, which resembles the
    Maclaren-Marsaglia method, is to greatly increase the period of the
    random sequence.  If the period of the basic generator is P,
    then the expected mean period of the sequence generated by this
    generator is given by

      new mean P = sqrt ( pi * factorial ( N ) / ( 8 * P ) ),

    where factorial ( N ) must be much greater than P in this 
    asymptotic formula.  Generally, N should be 16 to maybe 32.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    09 May 2016

  Author:

    C version by John Burkardt.

  Reference:

    Carter Bays, Stephen Durham,
    Improving a Poor Random Number Generator,
    ACM Transactions on Mathematical Software,
    Volume 2, Number 1, March 1976, pages 59-64.

  Parameters:

    Input, int N, the number of random numbers in an auxiliary table.

    Input/output, double T[N+1], an array of random numbers, initialized
    before first call by R8_RANDOM_INIT.

    Input/output, int *IX0, *IX1, two parameters used
    as seeds for the random number generator.

    Output, double R8_RANDOM, a random number between 0.0 and 1.0.
*/
{
  int j;
  double r;
  double value;
/*
  Pick J, a random index between 1 and N, and return T(J).
*/
  j = ( int ) ( t[n] * ( double ) ( abs ( n ) ) );
  t[n] = t[j];
  value = t[j];
/*
  Put a new value into T(J).
*/
  r = 0.0;
  t[j] = r8_rand ( r, ix0, ix1 );

  return value;
}
/******************************************************************************/

void r8_random_init ( int n, double t[], int *ix0, int *ix1 )

/******************************************************************************/
/*
  Purpose:

    R8_RANDOM_INIT initializes data for R8_RANDOM.

  Discussion:

    Before calling R8_RANDOM the first time, call R8_RANDOM_INIT
    in order to initialize the T array.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    09 May 2016

  Author:

    C version by John Burkardt.

  Reference:

    Carter Bays, Stephen Durham,
    Improving a Poor Random Number Generator,
    ACM Transactions on Mathematical Software,
    Volume 2, Number 1, March 1976, pages 59-64.

  Parameters:

    Input, int N, the number of random numbers in an 
    auxiliary table.

    Output, double T[N+1], an array of random numbers. 

    Input/output, int *IX0, *IX1, two parameters used
    as seeds for the random number generator.  These might both be set to 0.
*/
{
  int i;
  double r;

  r = 0.0;
  for ( i = 0; i < n + 1; i++ )
  {
    t[i] = r8_rand ( r, ix0, ix1 );
  }

  return;
}
/******************************************************************************/

double r8_ren ( int *seed )

/******************************************************************************/
/*
  Purpose:

    R8_REN is a simple random number generator.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    24 April 2016

  Author:

    C version by John Burkardt.

  Reference:

    Malcolm Pike, David Hill,
    Algorithm 266:
    Pseudo-Random Numbers,
    Communications of the ACM,
    Volume 8, Number 10, October 1965, page 605.

  Parameters:

    Input/output, int *SEED, a seed for the random number generator.

    Output, double R8_REN, the random value.
*/
{
  const int i4_huge = 2147483647;
  double value;

  *seed = ( *seed % ( i4_huge / 125 ) );
  *seed = ( *seed ) * 125;
  *seed = ( *seed ) - ( ( *seed ) / 2796203 ) * 2796203;
  value = ( double ) ( *seed ) / 2796203.0;

  return value;
}
/******************************************************************************/

double r8_shi ( double x )

/******************************************************************************/
/*
  Purpose:

    R8_SHI evaluates the hyperbolic sine integral Shi of an R8 argument.

  Discussion:

    Shi ( x ) = Integral ( 0 <= t <= x ) sinh ( t ) dt / t

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, double X, the argument.

    Output, double R8_SHI, the hyperbolic sine integral 
    Shi evaluated at X.
*/
{
  double absx;
  static int nshi = 0;
  static double shics[10] = {
     0.0078372685688900950695200984317332E+00,
     0.0039227664934234563972697574427225E+00,
     0.0000041346787887617266746747908275E+00,
     0.0000000024707480372882742135145302E+00,
     0.0000000000009379295590763630457157E+00,
     0.0000000000000002451817019520867353E+00,
     0.0000000000000000000467416155257592E+00,
     0.0000000000000000000000067803072389E+00,
     0.0000000000000000000000000007731289E+00,
     0.0000000000000000000000000000000711E+00 };
  double value;
  static double xsml = 0.0;

  if ( nshi == 0 )
  {
    nshi = r8_inits ( shics, 10, 0.1 * r8_mach ( 3 ) );
    xsml = sqrt ( r8_mach ( 3 ) );
  }

  absx = fabs ( x );

  if ( absx <= xsml )
  {
    value = x;
  }
  else if ( absx <= 0.375 )
  {
    value = x * ( 1.0 
      + r8_csevl ( 128.0 * x * x / 9.0 - 1.0, shics, nshi ) );
  }
  else
  {
    value = 0.5 * ( r8_ei ( x ) + r8_e1 ( x ) );
  }
  return value;
}
/******************************************************************************/

double r8_si ( double x )

/******************************************************************************/
/*
  Purpose:

    R8_SI evaluates the sine integral Si of an R8 argument.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, double X, the argument.

    Output, double R8_SI, the sine integral Si evaluated at X.
*/
{
  double absx;
  double cosx;
  double f;
  double g;
  static int nsi = 0;
  const double pi2 = 1.57079632679489661923132169163975;
  static double sics[18] = {
    -0.1315646598184841928904275173000457,
    -0.2776578526973601892048287660157299,
     0.0354414054866659179749135464710086,
    -0.0025631631447933977658752788361530,
     0.0001162365390497009281264921482985,
    -0.0000035904327241606042670004347148,
     0.0000000802342123705710162308652976,
    -0.0000000013562997692540250649931846,
     0.0000000000179440721599736775567759,
    -0.0000000000001908387343087145490737,
     0.0000000000000016669989586824330853,
    -0.0000000000000000121730988368503042,
     0.0000000000000000000754181866993865,
    -0.0000000000000000000004014178842446,
     0.0000000000000000000000018553690716,
    -0.0000000000000000000000000075166966,
     0.0000000000000000000000000000269113,
    -0.0000000000000000000000000000000858 };
  double value;
  static double xsml = 0.0;

  if ( nsi == 0 )
  {
    nsi = r8_inits ( sics, 18, 0.1 * r8_mach ( 3 ) );
    xsml = sqrt ( r8_mach ( 3 ) );
  }

  absx = fabs ( x );

  if ( absx < xsml )
  {
    value = x;
  }
  else if ( absx <= 4.0 )
  {
    value = x * ( 0.75 + r8_csevl ( ( x * x - 8.0 ) * 0.125, sics, nsi ) );
  }
  else
  {
    r8_sifg ( absx, &f, &g );
    cosx = cos ( absx );
    value = pi2 - f * cosx - g * sin ( x );
    if ( x < 0.0 )
    {
      value = - value;
    }
  }
  return value;
}
/******************************************************************************/

void r8_sifg ( double x, double *f, double *g )

/******************************************************************************/
/*
  Purpose:

    R8_SIFG is a utility routine.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, double X, the argument.

    Output, double *F, *G.
*/
{
  static double f1cs[43] = {
-0.1191081969051363610348201965828918,
-0.0247823144996236247590074150823133,
 0.0011910281453357821268120363054457,
-0.0000927027714388561748308600360706,
 0.0000093373141568270996868204582766,
-0.0000011058287820557143938979426306,
 0.0000001464772071460162169336550799,
-0.0000000210694496287689532601227548,
 0.0000000032293492366848236382857374,
-0.0000000005206529617529375828014986,
 0.0000000000874878884570278750268316,
-0.0000000000152176187056123668294574,
 0.0000000000027257192405419573900583,
-0.0000000000005007053075968556290255,
 0.0000000000000940240902726068511779,
-0.0000000000000180014444791803678336,
 0.0000000000000035062621432741785826,
-0.0000000000000006935282926769149709,
 0.0000000000000001390925136454216568,
-0.0000000000000000282486885074170585,
 0.0000000000000000058031305693579081,
-0.0000000000000000012046901573375820,
 0.0000000000000000002525052443655940,
-0.0000000000000000000533980268805594,
 0.0000000000000000000113855786274122,
-0.0000000000000000000024462861505259,
 0.0000000000000000000005293659320439,
-0.0000000000000000000001153184940277,
 0.0000000000000000000000252786568318,
-0.0000000000000000000000055738645378,
 0.0000000000000000000000012358245621,
-0.0000000000000000000000002754350842,
 0.0000000000000000000000000616906808,
-0.0000000000000000000000000138817443,
 0.0000000000000000000000000031375329,
-0.0000000000000000000000000007121249,
 0.0000000000000000000000000001622778,
-0.0000000000000000000000000000371206,
 0.0000000000000000000000000000085221,
-0.0000000000000000000000000000019633,
 0.0000000000000000000000000000004538,
-0.0000000000000000000000000000001052,
 0.0000000000000000000000000000000245 };
  static double f2cs[99] = {
-0.03484092538970132330836049733745577,
-0.01668422056779596873246786312278676,
 0.00067529012412377385045207859239727,
-0.00005350666225447013628785577557429,
 0.00000626934217790075267050759431626,
-0.00000095266388019916680677790414293,
 0.00000017456292242509880425504427666,
-0.00000003687954030653093307097646628,
 0.00000000872026777051395264075816938,
-0.00000000226019703919738748530423167,
 0.00000000063246249765250612520444877,
-0.00000000018889118884717869240911480,
 0.00000000005967746729997813372620472,
-0.00000000001980443117372239011196007,
 0.00000000000686413954772103383713264,
-0.00000000000247310193070199106074890,
 0.00000000000092263594549941404196042,
-0.00000000000035523634999261784497297,
 0.00000000000014076049625351591461820,
-0.00000000000005726228499747652794311,
 0.00000000000002386537545413171810106,
-0.00000000000001017141890764597142232,
 0.00000000000000442594531078364424968,
-0.00000000000000196344933049189761979,
 0.00000000000000088688748314810461024,
-0.00000000000000040743345027311546948,
 0.00000000000000019016837215675339859,
-0.00000000000000009009707297478042442,
 0.00000000000000004329211274095668667,
-0.00000000000000002108144465322479526,
 0.00000000000000001039637907026452274,
-0.00000000000000000518891007948931936,
 0.00000000000000000261955324869899371,
-0.00000000000000000133690399951301570,
 0.00000000000000000068941057702931664,
-0.00000000000000000035905362610437250,
 0.00000000000000000018878077255791706,
-0.00000000000000000010016125265594380,
 0.00000000000000000005360725691578228,
-0.00000000000000000002893198974944827,
 0.00000000000000000001574065100202625,
-0.00000000000000000000863027106431206,
 0.00000000000000000000476715602862288,
-0.00000000000000000000265222739998504,
 0.00000000000000000000148582865063866,
-0.00000000000000000000083797235923135,
 0.00000000000000000000047565916422711,
-0.00000000000000000000027169073353112,
 0.00000000000000000000015612738881686,
-0.00000000000000000000009024555078347,
 0.00000000000000000000005246097049119,
-0.00000000000000000000003066450818697,
 0.00000000000000000000001801996250957,
-0.00000000000000000000001064443050752,
 0.00000000000000000000000631942158881,
-0.00000000000000000000000377013812246,
 0.00000000000000000000000225997542918,
-0.00000000000000000000000136100844814,
 0.00000000000000000000000082333232003,
-0.00000000000000000000000050025986091,
 0.00000000000000000000000030526245684,
-0.00000000000000000000000018705164021,
 0.00000000000000000000000011508404393,
-0.00000000000000000000000007108714611,
 0.00000000000000000000000004408065533,
-0.00000000000000000000000002743760867,
 0.00000000000000000000000001714144851,
-0.00000000000000000000000001074768860,
 0.00000000000000000000000000676259777,
-0.00000000000000000000000000426981348,
 0.00000000000000000000000000270500637,
-0.00000000000000000000000000171933331,
 0.00000000000000000000000000109636138,
-0.00000000000000000000000000070132573,
 0.00000000000000000000000000045001784,
-0.00000000000000000000000000028963835,
 0.00000000000000000000000000018697009,
-0.00000000000000000000000000012104646,
 0.00000000000000000000000000007859065,
-0.00000000000000000000000000005116867,
 0.00000000000000000000000000003340627,
-0.00000000000000000000000000002186851,
 0.00000000000000000000000000001435340,
-0.00000000000000000000000000000944523,
 0.00000000000000000000000000000623117,
-0.00000000000000000000000000000412101,
 0.00000000000000000000000000000273208,
-0.00000000000000000000000000000181558,
 0.00000000000000000000000000000120934,
-0.00000000000000000000000000000080737,
 0.00000000000000000000000000000054022,
-0.00000000000000000000000000000036227,
 0.00000000000000000000000000000024348,
-0.00000000000000000000000000000016401,
 0.00000000000000000000000000000011074,
-0.00000000000000000000000000000007497,
 0.00000000000000000000000000000005091,
-0.00000000000000000000000000000003470,
 0.00000000000000000000000000000002377 };
  static double g1cs[44] = {
-0.3040578798253495954499726682091083,
-0.0566890984597120587731339156118269,
 0.0039046158173275643919984071554082,
-0.0003746075959202260618619339867489,
 0.0000435431556559843679552220840065,
-0.0000057417294453025046561970723475,
 0.0000008282552104502629741937616492,
-0.0000001278245892594642727883913223,
 0.0000000207978352948687884439257529,
-0.0000000035313205921990798042032682,
 0.0000000006210824236308951068631449,
-0.0000000001125215474446292649336987,
 0.0000000000209088917684421605267019,
-0.0000000000039715831737681727689158,
 0.0000000000007690431314272089939005,
-0.0000000000001514696742731613519826,
 0.0000000000000302892146552359684119,
-0.0000000000000061399703834708825400,
 0.0000000000000012600605829510933553,
-0.0000000000000002615029250939483683,
 0.0000000000000000548278844891796821,
-0.0000000000000000116038182129526571,
 0.0000000000000000024771654107129795,
-0.0000000000000000005330672753223389,
 0.0000000000000000001155666075598465,
-0.0000000000000000000252280547744957,
 0.0000000000000000000055429038550786,
-0.0000000000000000000012252208421297,
 0.0000000000000000000002723664318684,
-0.0000000000000000000000608707831422,
 0.0000000000000000000000136724874476,
-0.0000000000000000000000030856626806,
 0.0000000000000000000000006995212319,
-0.0000000000000000000000001592587569,
 0.0000000000000000000000000364051056,
-0.0000000000000000000000000083539465,
 0.0000000000000000000000000019240303,
-0.0000000000000000000000000004446816,
 0.0000000000000000000000000001031182,
-0.0000000000000000000000000000239887,
 0.0000000000000000000000000000055976,
-0.0000000000000000000000000000013100,
 0.0000000000000000000000000000003074,
-0.0000000000000000000000000000000723 };
  static double g2cs[44] = {
-0.1211802894731646263541834046858267,
-0.0316761386394950286701407923505610,
 0.0013383199778862680163819429492182,
-0.0000895511011392252425531905069518,
 0.0000079155562961718213115249467924,
-0.0000008438793322241520181418982080,
 0.0000001029980425677530146647227274,
-0.0000000139295750605183835795834444,
 0.0000000020422703959875980400677594,
-0.0000000003196534694206427035434752,
 0.0000000000528147832657267698615312,
-0.0000000000091339554672671033735289,
 0.0000000000016426251238967760444819,
-0.0000000000003055897039322660002410,
 0.0000000000000585655825785779717892,
-0.0000000000000115229197730940120563,
 0.0000000000000023209469119988537310,
-0.0000000000000004774355834177535025,
 0.0000000000000001000996765800180573,
-0.0000000000000000213533778082256704,
 0.0000000000000000046277190777367671,
-0.0000000000000000010175807410227657,
 0.0000000000000000002267657399884672,
-0.0000000000000000000511630776076426,
 0.0000000000000000000116767014913108,
-0.0000000000000000000026935427672470,
 0.0000000000000000000006275665841146,
-0.0000000000000000000001475880557531,
 0.0000000000000000000000350145314739,
-0.0000000000000000000000083757732152,
 0.0000000000000000000000020191815152,
-0.0000000000000000000000004903567705,
 0.0000000000000000000000001199123348,
-0.0000000000000000000000000295170610,
 0.0000000000000000000000000073113112,
-0.0000000000000000000000000018217843,
 0.0000000000000000000000000004565148,
-0.0000000000000000000000000001150151,
 0.0000000000000000000000000000291267,
-0.0000000000000000000000000000074125,
 0.0000000000000000000000000000018953,
-0.0000000000000000000000000000004868,
 0.0000000000000000000000000000001256,
-0.0000000000000000000000000000000325 };
  static double g3cs[56] = {
-0.0280574367809472928402815264335299,
-0.0137271597162236975409100508089556,
 0.0002894032638760296027448941273751,
-0.0000114129239391197145908743622517,
 0.0000006813965590726242997720207302,
-0.0000000547952289604652363669058052,
 0.0000000055207429918212529109406521,
-0.0000000006641464199322920022491428,
 0.0000000000922373663487041108564960,
-0.0000000000144299088886682862611718,
 0.0000000000024963904892030710248705,
-0.0000000000004708240675875244722971,
 0.0000000000000957217659216759988140,
-0.0000000000000207889966095809030537,
 0.0000000000000047875099970877431627,
-0.0000000000000011619070583377173759,
 0.0000000000000002956508969267836974,
-0.0000000000000000785294988256492025,
 0.0000000000000000216922264368256612,
-0.0000000000000000062113515831676342,
 0.0000000000000000018384568838450977,
-0.0000000000000000005610887482137276,
 0.0000000000000000001761862805280062,
-0.0000000000000000000568111050541451,
 0.0000000000000000000187786279582313,
-0.0000000000000000000063531694151124,
 0.0000000000000000000021968802368238,
-0.0000000000000000000007754666550395,
 0.0000000000000000000002791018356581,
-0.0000000000000000000001023178525247,
 0.0000000000000000000000381693403919,
-0.0000000000000000000000144767895606,
 0.0000000000000000000000055779512634,
-0.0000000000000000000000021817239071,
 0.0000000000000000000000008656646309,
-0.0000000000000000000000003482157895,
 0.0000000000000000000000001419188130,
-0.0000000000000000000000000585714314,
 0.0000000000000000000000000244660482,
-0.0000000000000000000000000103387099,
 0.0000000000000000000000000044177299,
-0.0000000000000000000000000019080079,
 0.0000000000000000000000000008326038,
-0.0000000000000000000000000003669553,
 0.0000000000000000000000000001632875,
-0.0000000000000000000000000000733357,
 0.0000000000000000000000000000332327,
-0.0000000000000000000000000000151906,
 0.0000000000000000000000000000070020,
-0.0000000000000000000000000000032539,
 0.0000000000000000000000000000015240,
-0.0000000000000000000000000000007193,
 0.0000000000000000000000000000003420,
-0.0000000000000000000000000000001638,
 0.0000000000000000000000000000000790,
-0.0000000000000000000000000000000383 };
  static int nf1 = 0;
  static int nf2 = 0;
  static int ng1 = 0;
  static int ng2 = 0;
  static int ng3 = 0;
  double tol;
  static double xbig = 0.0;
  static double xbnd = 0.0;
  static double xbndg = 0.0;
  static double xmaxf = 0.0;
  static double xmaxg = 0.0;

  if ( nf1 == 0 )
  {
    tol = 0.1 * r8_mach ( 3 );
    nf1 = r8_inits ( f1cs, 43, tol );
    nf2 = r8_inits ( f2cs, 99, tol );
    ng1 = r8_inits ( g1cs, 44, tol );
    ng2 = r8_inits ( g2cs, 44, tol );
    ng3 = r8_inits ( g3cs, 56, tol );
    xbig = sqrt ( 1.0 / r8_mach ( 3 ) );
    xmaxf = exp ( fmin ( - log ( r8_mach ( 1 ) ), 
      log ( r8_mach ( 2 ) ) ) - 0.01 );
    xmaxg = 1.0 / sqrt ( r8_mach ( 1 ) );
    xbnd = sqrt ( 50.0 );
    xbndg = sqrt ( 200.0 );
  }

  if ( x < 4.0 )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R8_SIFG - Fatal error!\n" );
    fprintf ( stderr, "  Approximation invalid for X < 4.\n" );
    exit ( 1 );
  }
  else if ( x <= xbnd )
  {
    *f = ( 1.0 + r8_csevl ( ( 1.0 / x / x - 0.04125 )
      / 0.02125, f1cs, nf1 ) ) / x;
    *g = ( 1.0 + r8_csevl ( ( 1.0 / x / x - 0.04125 )
      / 0.02125, g1cs, ng1 ) ) / x / x;
  }
  else if ( x <= xbig )
  {
    *f = ( 1.0 + r8_csevl ( 100. / x / x - 1.0, f2cs, nf2 ) ) / x;
    if ( x <= xbndg )
    {
      *g = ( 1.0 + r8_csevl ( ( 10000.0 / x / x - 125.0 ) 
        / 75.0, g2cs, ng2 ) ) / x / x;
    }
    else
    {
      *g = ( 1.0 + r8_csevl ( 400.0 / x / x - 1.0, g3cs, ng3 ) ) / x / x;
    }
  }
  else
  {
    if ( x < xmaxf )
    {
      *f = 1.0 / x;
    }
    else
    {
      *f = 0.0;
    }
    if ( x < xmaxg )
    {
      *g = 1.0 / x / x;
    }
    else
    {
      *g = 0.0;
    }
  }
  return;
}
/******************************************************************************/

double r8_sign ( double x )

/******************************************************************************/
/*
  Purpose:

    R8_SIGN returns the sign of an R8.

  Licensing:

    This code is distributed under the MIT license.

  Modified:

    18 October 2004

  Author:

    John Burkardt

  Parameters:

    Input, double X, the number whose sign is desired.

    Output, double R8_SIGN, the sign of X.
*/
{
  double value;

  if ( x < 0.0 )
  {
    value = -1.0;
  }
  else
  {
    value = 1.0;
  }
  return value;
}
/******************************************************************************/

double r8_sin ( double x )

/******************************************************************************/
/*
  Purpose:

    R8_SIN evaluates the sine of an R8 argument.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, double X, the argument.

    Output, double R8_SIN, the sine of X.
*/
{
  double f;
  int n2;
  static int ntsn = 0;
  const double pi2rec = 0.63661977236758134307553505349006;
  const double pihi = 3.140625;
  const double pilo = 9.6765358979323846264338327950288E-04;
  const double pirec = 0.31830988618379067153776752674503;
  double sgn;
  static double sincs[15] = {
    -0.374991154955873175839919279977323464,
    -0.181603155237250201863830316158004754,
     0.005804709274598633559427341722857921,
    -0.000086954311779340757113212316353178,
     0.000000754370148088851481006839927030,
    -0.000000004267129665055961107126829906,
     0.000000000016980422945488168181824792,
    -0.000000000000050120578889961870929524,
     0.000000000000000114101026680010675628,
    -0.000000000000000000206437504424783134,
     0.000000000000000000000303969595918706,
    -0.000000000000000000000000371357734157,
     0.000000000000000000000000000382486123,
    -0.000000000000000000000000000000336623,
     0.000000000000000000000000000000000256 };
  double value;
  static double xmax = 0.0;
  double xn;
  static double xsml = 0.0;
  static double xwarn = 0.0;
  double y;

  if ( ntsn == 0 )
  {
    ntsn = r8_inits ( sincs, 15, 0.1 * r8_mach ( 3 ) );
    xsml = r8_sqrt ( 2.0 * r8_mach ( 3 ) );
    xmax = 1.0 / r8_mach( 4 );
    xwarn = r8_sqrt ( xmax );
  }

  y = fabs ( x );

  if ( xmax < y )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R8_SIN - Warning!\n" );
    fprintf ( stderr, "  No precision because |X| is big.\n" );
    value = 0.0;
    return value;
  }

  if ( xwarn < y )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R8_SIN - Warning!\n" );
    fprintf ( stderr, "  Answer < half precision because |X| is big.\n" );
  }

  value = x;
  if ( y < xsml )
  {
    return value;
  }

  xn = ( double ) ( ( int ) ( y * pirec + 0.5 ) );
  n2 = ( int ) ( r8_mod ( xn, 2.0 ) + 0.5 );

  sgn = x;
  if ( n2 != 0 )
  {
    sgn = - sgn;
  }

  f = ( y - xn * pihi ) - xn * pilo;
  xn = 2.0 * ( f * pi2rec ) * ( f * pi2rec ) - 1.0;
  value = f + f * r8_csevl ( xn, sincs, ntsn );

  if ( sgn < 0.0 )
  {
    value = - value;
  }

  if ( value < - 1.0 )
  {
    value = - 1.0;
  }
  else if ( 1.0 < value )
  {
    value = + 1.0;
  }

  return value;
}
/******************************************************************************/

double r8_sin_deg ( double x )

/******************************************************************************/
/*
  Purpose:

    R8_SIN_DEG evaluates the sine of an R8 argument in degrees.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, double X, the argument in degrees.

    Output, double R8_SIN_DEG, the sine of X.
*/
{
  int n;
  const double raddeg = 0.017453292519943295769236907684886E+00;
  double value;

  value = sin ( raddeg * x );

  if ( r8_mod ( x, 90.0E+00 ) == 0.0E+00 )
  {
    n = ( int ) ( fabs ( x ) / 90.0E+00 + 0.5E+00 );
    n = ( n % 2 );

    if ( n == 0 )
    {
      value = 0.0E+00;
    }
    else if ( value < 0.0E+00 )
    {
      value = - 1.0E+00;
    }
    else
    {
      value = + 1.0E+00;
    }
  }
  return value;
}
/******************************************************************************/

double r8_sinh ( double x )

/******************************************************************************/
/*
  Purpose:

    R8_SINH evaluates the hyperbolic sine of an R8 argument.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, double X, the argument.

    Output, double R8_SINH, the hyperbolic sine of X.
*/
{
  static int nterms = 0;
  static double sinhcs[13] = {
    +0.17304219404717963167588384698501E+00,
    +0.87594221922760477154900263454440E-01,
    +0.10794777745671327502427270651579E-02,
    +0.63748492607547504815685554571850E-05,
    +0.22023664049230530159190496019502E-07,
    +0.49879401804158493149425807203661E-10,
    +0.79730535541157304814411480441186E-13,
    +0.94731587130725443342927317226666E-16,
    +0.86934920504480078871023098666666E-19,
    +0.63469394403318040457397333333333E-22,
    +0.37740337870858485738666666666666E-25,
    +0.18630213719570056533333333333333E-28,
    +0.77568437166506666666666666666666E-32 };
  static double sqeps = 0.0;
  double value;
  double y;
  static double ymax = 0.0;

  if ( nterms == 0 )
  {
    nterms = r8_inits ( sinhcs, 13, 0.1 * r8_mach ( 3 ) );
    sqeps = sqrt ( 6.0 * r8_mach ( 3 ) );
    ymax = 1.0 / sqrt ( r8_mach ( 3 ) );
  }

  y = fabs ( x );

  if ( y <= sqeps )
  {
    value = x;
  }
  else if ( y <= 1.0 )
  {
    value = x * ( 1.0 + r8_csevl ( 2.0 * x * x - 1.0, sinhcs, nterms ) );
  }
  else
  {
    y = exp ( y );

    if ( ymax <= y )
    {
      value = 0.5 * y;
    }
    else
    {
      value = 0.5 * ( y - 1.0 / y );
    }

    if ( x < 0.0 )
    {
      value = - value;
    }
  }
  return value;
}
/******************************************************************************/

double r8_spence ( double x )

/******************************************************************************/
/*
  Purpose:

    R8_SPENCE evaluates a form of Spence's function for an R8 argument.

  Discussion:

    This function evaluates a form of Spence's function defined by

      f(x) = Integral ( 0 <= y <= x ) - log ( abs ( 1 - y ) ) / y dy

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Milton Abramowitz, Irene Stegun,
    Handbook of Mathematical Functions, page 1004,
    National Bureau of Standards, 1964,
    ISBN: 0-486-61272-4,
    LC: QA47.A34.

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

    K Mitchell,
    Tables of the function Integral ( 0 < y < x ) - log | 1 - y | dy / y
    with an account of some properties of this and related functions,
    Philosophical Magazine,
    Volume 40, pages 351-368, 1949.

  Parameters:

    Input, double X, the argument.

    Output, double R8_SPENCE, Spence's function evaluated at X.
*/
{
  double aln;
  static int nspenc = 0;
  const double pi26 = +1.644934066848226436472415166646025189219;
  static double spencs[38] = {
    +0.1527365598892405872946684910028,
    +0.8169658058051014403501838185271E-01,
    +0.5814157140778730872977350641182E-02,
    +0.5371619814541527542247889005319E-03,
    +0.5724704675185826233210603054782E-04,
    +0.6674546121649336343607835438589E-05,
    +0.8276467339715676981584391689011E-06,
    +0.1073315673030678951270005873354E-06,
    +0.1440077294303239402334590331513E-07,
    +0.1984442029965906367898877139608E-08,
    +0.2794005822163638720201994821615E-09,
    +0.4003991310883311823072580445908E-10,
    +0.5823462892044638471368135835757E-11,
    +0.8576708692638689278097914771224E-12,
    +0.1276862586280193045989483033433E-12,
    +0.1918826209042517081162380416062E-13,
    +0.2907319206977138177795799719673E-14,
    +0.4437112685276780462557473641745E-15,
    +0.6815727787414599527867359135607E-16,
    +0.1053017386015574429547019416644E-16,
    +0.1635389806752377100051821734570E-17,
    +0.2551852874940463932310901642581E-18,
    +0.3999020621999360112770470379519E-19,
    +0.6291501645216811876514149171199E-20,
    +0.9933827435675677643803887752533E-21,
    +0.1573679570749964816721763805866E-21,
    +0.2500595316849476129369270954666E-22,
    +0.3984740918383811139210663253333E-23,
    +0.6366473210082843892691326293333E-24,
    +0.1019674287239678367077061973333E-24,
    +0.1636881058913518841111074133333E-25,
    +0.2633310439417650117345279999999E-26,
    +0.4244811560123976817224362666666E-27,
    +0.6855411983680052916824746666666E-28,
    +0.1109122433438056434018986666666E-28,
    +0.1797431304999891457365333333333E-29,
    +0.2917505845976095173290666666666E-30,
    +0.4742646808928671061333333333333E-31 };
  double value;
  static double xbig = 0.0;

  if ( nspenc == 0 )
  {
    nspenc = r8_inits ( spencs, 38, 0.1 * r8_mach ( 3 ) );
    xbig = 1.0 / r8_mach ( 3 );
  }

  if ( x <= - xbig )
  {
    aln = log ( 1.0 - x );
    value = - pi26  - 0.5 * aln * ( 2.0 * log ( - x ) - aln );
  }
  else if ( x <= - 1.0 )
  {
    aln = log ( 1.0 - x );

    value = - pi26 - 0.5 * aln * ( 2.0 
      * log ( - x ) - aln ) + ( 1.0 + r8_csevl (
      4.0 / ( 1.0 - x ) - 1.0, spencs, nspenc ) ) / ( 1.0 - x );
  }
  else if ( x <= 0.0 )
  {
    value = - 0.5 * log ( 1.0 - x ) 
      * log ( 1.0 - x ) - x * ( 1.0 + r8_csevl ( 
      4.0 * x / ( x - 1.0 ) - 1.0, spencs, nspenc ) ) / ( x - 1.0 );
  }
  else if ( x <= 0.5 )
  {
    value = x * ( 1.0 + r8_csevl ( 4.0 * x - 1.0, spencs, nspenc ) );
  }
  else if ( x < 1.0 )
  {
    value = pi26 - log ( x ) * log ( 1.0 - x )
      - ( 1.0 - x ) * ( 1.0 + r8_csevl ( 4.0 
      * ( 1.0 - x ) - 1.0, spencs, nspenc ) );
  }
  else if ( x == 1.0 )
  {
    value = pi26;
  }
  else if ( x <= 2.0 )
  {
    value = pi26 - 0.5 * log ( x ) 
      * log ( ( x - 1.0 ) * ( x - 1.0 ) / x )
      + ( x - 1.0 ) * ( 1.0 + r8_csevl ( 4.0 
      * ( x - 1.0 ) / x - 1.0, spencs, nspenc ) ) / x;
  }
  else if ( x < xbig )
  {
    value = 2.0 * pi26 - 0.5 * log ( x ) * log ( x )
      - ( 1.0 + r8_csevl ( 4.0 / x - 1.0, spencs, nspenc ) ) / x;
  }
  else
  {
    value = 2.0 * pi26 - 0.5 * log ( x ) * log ( x );
  }
  return value;
}
/******************************************************************************/

double r8_sqrt ( double x )

/******************************************************************************/
/*
  Purpose:

    R8_SQRT computes the square root of an R8.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, double X, the number whose square root is desired.

    Output, double R8_SQRT, the square root of X.
*/
{
  int irem;
  int iter;
  int ixpnt;
  int n;
  static int niter = 0;
  static double sqrt2[3] = {
    0.70710678118654752440084436210485,
    1.0,
    1.41421356237309504880168872420970 };
  double value;
  double y;

  if ( niter == 0 )
  {
    niter = 1.443 * r8_log ( - 0.104 * r8_log ( 0.1 * r8_mach ( 3 ) ) ) + 1.0;
  }

  if ( x < 0.0 )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R8_SQRT - Fatal error!\n" );
    fprintf ( stderr, "  X is negative.\n" );
    exit ( 1 );
  }
  else if ( x == 0.0 )
  {
    value = 0.0;
  }
  else
  {
    r8_upak ( x, &y, &n );
    ixpnt = n / 2;
    irem = n - 2 * ixpnt + 2;
    value = 0.261599 + y * ( 1.114292 + y * ( -0.516888 + y * 0.141067 ) );

    for ( iter = 1; iter <= niter; iter++ )
    {
      value = value + 0.5 * ( y - value * value ) / value;
    }
    value = r8_pak ( sqrt2[irem-1] * value, ixpnt );
  }
  return value;
}
/******************************************************************************/

double r8_tan ( double x )

/******************************************************************************/
/*
  Purpose:

    R8_TAN evaluates the tangent of an R8 argument.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, double X, the argument.

    Output, double R8_TAN, the tangent of X.
*/
{
  double ainty;
  double ainty2;
  int ifn;
  static int nterms = 0;
  const double pi2rec = 0.011619772367581343075535053490057;
  double prodbg;
  static double sqeps = 0.0;
  static double tancs[19] = {
    +0.22627932763129357846578636531752,
    +0.43017913146548961775583410748067E-01,
    +0.68544610682565088756929473623461E-03,
    +0.11045326947597098383578849369696E-04,
    +0.17817477903926312943238512588940E-06,
    +0.28744968582365265947529646832471E-08,
    +0.46374854195902995494137478234363E-10,
    +0.74817609041556138502341633308215E-12,
    +0.12070497002957544801644516947824E-13,
    +0.19473610812823019305513858584533E-15,
    +0.31417224874732446504614586026666E-17,
    +0.50686132555800153941904891733333E-19,
    +0.81773105159836540043979946666666E-21,
    +0.13192643412147384408951466666666E-22,
    +0.21283995497042377309866666666666E-24,
    +0.34337960192345945292800000000000E-26,
    +0.55398222121173811200000000000000E-28,
    +0.89375227794352810666666666666666E-30,
    +0.14419111371369130666666666666666E-31 };
  double value;
  static double xmax = 0.0;
  static double xsml = 0.0;
  double y;
  double yrem;

  if ( nterms == 0 )
  {
    nterms = r8_inits ( tancs, 19, 0.1 * r8_mach ( 3 ) );
    xmax = 1.0 / r8_mach ( 4 );
    xsml = sqrt ( 3.0 * r8_mach ( 3 ) );
    sqeps = sqrt ( r8_mach ( 4 ) );
  }

  y = fabs ( x );

  if ( xmax < y )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R8_TAN - Warning\n" );
    fprintf ( stderr, "  No precision because |X| is big.\n" );
    value = 0.0;
    return value;
  }
/*
  Carefully compute y * (2/pi) = (aint(y) + rem(y)) * (.625 + pi2rec)
  = aint(.625*y) + rem(.625*y) + y*pi2rec  =  aint(.625*y) + z
  = aint(.625*y) + aint(z) + rem(z)
*/
  ainty = r8_aint ( y );
  yrem = y - ainty;
  prodbg = 0.625 * ainty;
  ainty = r8_aint ( prodbg );
  y = ( prodbg - ainty ) + 0.625 * yrem + pi2rec * y;
  ainty2 = r8_aint ( y );
  ainty = ainty + ainty2;
  y = y - ainty2;

  ifn = ( int ) fmod ( ainty, 2.0 );

  if ( ifn == 1 )
  {
    y = 1.0 - y;
  }

  if ( 1.0 - y < fabs ( x ) * sqeps )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R8_TAN - Warning!\n" );
    fprintf ( stderr, "  Answer < half precision.\n" );
    fprintf ( stderr, "  |X| big or X near pi/2 or 3*pi/2.\n" );
  }

  if ( y == 1.0 )
  {
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "R8_TAN - Fatal error!\n" );
    fprintf ( stderr, "  X is pi/2 or 3*pi/2.\n" );
    exit ( 1 );
  }

  if ( y <= 0.25 )
  {
    value = y;
    if ( xsml < y )
    {
      value = y * ( 1.5 + r8_csevl ( 32.0 * y * y - 1.0, tancs, nterms ) );
    }
  }
  else if ( y <= 0.5 )
  {
    value = 0.5 * y * ( 1.5 + r8_csevl ( 
      8.0 * y * y - 1.0, tancs, nterms ) );
    value = 2.0 * value / ( 1.0 - value * value );
  }
  else
  {
    value = 0.25 * y * ( 1.5 + r8_csevl ( 
      2.0 * y * y - 1.0, tancs, nterms ) );
    value = 2.0 * value / ( 1.0 - value * value );
    value = 2.0 * value / ( 1.0 - value * value );
  }

  if ( x < 0.0 )
  {
    value = - fabs ( value );
  }
  else if ( 0.0 < x )
  {
    value = + fabs ( value );
  }

  if ( ifn == 1 )
  {
    value = - value;
  }
  return value;
}
/******************************************************************************/

double r8_tanh ( double x )

/******************************************************************************/
/*
  Purpose:

    R8_TANH evaluates the hyperbolic tangent of an R8 argument.

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    Original FORTRAN77 version by Wayne Fullerton.
    C version by John Burkardt.

  Reference:

    Wayne Fullerton,
    Portable Special Function Routines,
    in Portability of Numerical Software,
    edited by Wayne Cowell,
    Lecture Notes in Computer Science, Volume 57,
    Springer 1977,
    ISBN: 978-3-540-08446-4,
    LC: QA297.W65.

  Parameters:

    Input, double X, the argument.

    Output, double R8_TANH, the hyperbolic tangent of X.
*/
{
  static int nterms = 0;
  static double sqeps = 0.0;
  static double tanhcs[31] = {
    -0.25828756643634710438338151450605,
    -0.11836106330053496535383671940204,
    +0.98694426480063988762827307999681E-02,
    -0.83579866234458257836163690398638E-03,
    +0.70904321198943582626778034363413E-04,
    -0.60164243181207040390743479001010E-05,
    +0.51052419080064402965136297723411E-06,
    -0.43320729077584087216545467387192E-07,
    +0.36759990553445306144930076233714E-08,
    -0.31192849612492011117215651480953E-09,
    +0.26468828199718962579377758445381E-10,
    -0.22460239307504140621870997006196E-11,
    +0.19058733768288196054319468396139E-12,
    -0.16172371446432292391330769279701E-13,
    +0.13723136142294289632897761289386E-14,
    -0.11644826870554194634439647293781E-15,
    +0.98812684971669738285540514338133E-17,
    -0.83847933677744865122269229055999E-18,
    +0.71149528869124351310723506176000E-19,
    -0.60374242229442045413288837119999E-20,
    +0.51230825877768084883404663466666E-21,
    -0.43472140157782110106047829333333E-22,
    +0.36888473639031328479423146666666E-23,
    -0.31301874774939399883325439999999E-24,
    +0.26561342006551994468488533333333E-25,
    -0.22538742304145029883494399999999E-26,
    +0.19125347827973995102208000000000E-27,
    -0.16228897096543663117653333333333E-28,
    +0.13771101229854738786986666666666E-29,
    -0.11685527840188950118399999999999E-30,
    +0.99158055384640389120000000000000E-32 };
  double value;
  static double xmax = 0.0;
  double y;
  double yrec;

  if ( nterms == 0 )
  {
    nterms = r8_inits ( tanhcs, 31, 0.1 * r8_mach ( 3 ) );
    sqeps = sqrt ( 3.0 * r8_mach ( 3 ) );
    xmax = - 0.5 * log ( r8_mach ( 3 ) );
  }

  y = fabs ( x );

  if ( y <= sqeps )
  {
    value = x;
  }
  else if ( y <= 1.0 )
  {
    value = x * ( 1.0 + r8_csevl ( 2.0 * x * x - 1.0, tanhcs, nterms ) );
  }
  else if ( y <= xmax )
  {
    y = exp ( y );
    yrec = 1.0 / y;
    value = ( y - yrec ) / ( y + yrec );

    if ( x < 0.0 )
    {
      value = - value;
    }
  }
  else
  {
    if ( x < 0.0 )
    {
      value = - 1.0;
    }
    else
    {
      value = + 1.0;
    }
  }
  return value;
}
/******************************************************************************/

void r8_upak ( double x, double *y, int *n )

/******************************************************************************/
/*
  Purpose:

    R8_UPAK unpacks an R8 into a mantissa and exponent.

  Discussion:

    This function unpacks a floating point number x so that

      x = y * 2.0^n

    where

      0.5 <= abs ( y ) < 1.0 .

  Licensing:

    This code is distributed under the MIT license. 

  Modified:

    17 January 2012

  Author:

    C version by John Burkardt.

  Parameters:

    Input, double X, the number to be unpacked.

    Output, double *Y, the mantissa.

    Output, int *N, the exponent.
*/
{
  double absx;

  absx = fabs ( x );
  *n = 0;
  *y = 0.0;

  if ( x == 0.0 )
  {
    return;
  }

  while ( absx < 0.5 )
  {
    *n = *n - 1;
    absx = absx * 2.0;
  }

  while ( 1.0 <= absx )
  {
    *n = *n + 1;
    absx = absx * 0.5;
  }

  if ( x < 0.0 )
  {
    *y = - absx;
  }
  else
  {
    *y = + absx;
  }

  return;
}