//                                               -*- C++ -*-
/**
 *  @file  dcdflib.cxx
 *  @brief
 *
 *  Copyright (C) 2005-2013 EDF-EADS-Phimeca
 *
 *  This library is free software: you can redistribute it and/or modify
 *  it under the terms of the GNU Lesser General Public License as published by
 *  the Free Software Foundation, either version 3 of the License, or
 *  (at your option) any later version.
 *
 *  This library is distributed in the hope that it will be useful,
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 *  GNU Lesser General Public License for more details.
 *
 *  You should have received a copy of the GNU Lesser General Public
 *  along with this library.  If not, see <http://www.gnu.org/licenses/>.
 *
 *  @author schueller
 *  @date   2012-02-17 19:35:43 +0100 (Fri, 17 Feb 2012)
 */
# include <iostream>
# include <iomanip>
# include <cmath>
# include <ctime>
# include <cstdio>
# include <cstdlib>

# include "Dcdflib.hxx"

namespace DCDFLIB
{

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

  double algdiv ( double *a, double *b )

  //****************************************************************************
  //
  //  Purpose:
  //
  //    ALGDIV computes ln ( Gamma ( B ) / Gamma ( A + B ) ) when 8 <= B.
  //
  //  Discussion:
  //
  //    In this algorithm, DEL(X) is the function defined by
  //
  //      ln ( Gamma(X) ) = ( X - 0.5 ) * ln ( X ) - X + 0.5 * ln ( 2 * PI )
  //                      + DEL(X).
  //
  //  Parameters:
  //
  //    Input, double *A, *B, define the arguments.
  //
  //    Output, double ALGDIV, the value of ln(Gamma(B)/Gamma(A+B)).
  //
  {
    static double algdiv;
    static double c;
    static double c0 =  0.833333333333333e-01;
    static double c1 = -0.277777777760991e-02;
    static double c2 =  0.793650666825390e-03;
    static double c3 = -0.595202931351870e-03;
    static double c4 =  0.837308034031215e-03;
    static double c5 = -0.165322962780713e-02;
    static double d;
    static double h;
    static double s11;
    static double s3;
    static double s5;
    static double s7;
    static double s9;
    static double t;
    static double T1;
    static double u;
    static double v;
    static double w;
    static double x;
    static double x2;

    if ( *b <= *a )
      {
        h = *b / *a;
        c = 1.0e0 / ( 1.0e0 + h );
        x = h / ( 1.0e0 + h );
        d = *a + ( *b - 0.5e0 );
      }
    else
      {
        h = *a / *b;
        c = h / ( 1.0e0 + h );
        x = 1.0e0 / ( 1.0e0 + h );
        d = *b + ( *a - 0.5e0 );
      }
    //
    //  SET SN = (1 - X**N)/(1 - X)
    //
    x2 = x * x;
    s3 = 1.0e0 + ( x + x2 );
    s5 = 1.0e0 + ( x + x2 * s3 );
    s7 = 1.0e0 + ( x + x2 * s5 );
    s9 = 1.0e0 + ( x + x2 * s7 );
    s11 = 1.0e0 + ( x + x2 * s9 );
    //
    //  SET W = DEL(B) - DEL(A + B)
    //
    t = pow ( 1.0e0 / *b, 2.0 );

    w = (((( c5 * s11  * t
             + c4 * s9 ) * t
           + c3 * s7 ) * t
          + c2 * s5 ) * t
         + c1 * s3 ) * t
      + c0;

    w *= ( c / *b );
    //
    //  COMBINE THE RESULTS
    //
    T1 = *a / *b;
    u = d * alnrel ( &T1 );
    v = *a * ( log ( *b ) - 1.0e0 );

    if ( v < u )
      {
        algdiv = w - v - u;
      }
    else
      {
        algdiv = w - u - v;
      }
    return algdiv;
  }
  //****************************************************************************

  double alnrel ( double *a )

  //****************************************************************************
  //
  //  Purpose:
  //
  //    ALNREL evaluates the function ln ( 1 + A ).
  //
  //  Modified:
  //
  //    17 November 2006
  //
  //  Reference:
  //
  //    Armido DiDinato, Alfred Morris,
  //    Algorithm 708:
  //    Significant Digit Computation of the Incomplete Beta Function Ratios,
  //    ACM Transactions on Mathematical Software,
  //    Volume 18, 1993, pages 360-373.
  //
  //  Parameters:
  //
  //    Input, double *A, the argument.
  //
  //    Output, double ALNREL, the value of ln ( 1 + A ).
  //
  {
    double alnrel;
    static double p1 = -0.129418923021993e+01;
    static double p2 =  0.405303492862024e+00;
    static double p3 = -0.178874546012214e-01;
    static double q1 = -0.162752256355323e+01;
    static double q2 =  0.747811014037616e+00;
    static double q3 = -0.845104217945565e-01;
    double t;
    double t2;
    double w;
    double x;

    if ( fabs ( *a ) <= 0.375e0 )
      {
        t = *a / ( *a + 2.0e0 );
        t2 = t * t;
        w = (((p3 * t2 + p2) * t2 + p1) * t2 + 1.0e0) / (((q3 * t2 + q2) * t2 + q1) * t2 + 1.0e0);
        alnrel = 2.0e0 * t * w;
      }
    else
      {
        x = 1.0e0 + *a;
        alnrel = log ( x );
      }
    return alnrel;
  }
  //****************************************************************************

  double apser ( double *a, double *b, double *x, double *eps )

  //****************************************************************************
  //
  //  Purpose:
  //
  //    APSER computes the incomplete beta ratio I(SUB(1-X))(B,A).
  //
  //  Discussion:
  //
  //    APSER is used only for cases where
  //
  //      A <= min ( EPS, EPS * B ),
  //      B * X <= 1, and
  //      X <= 0.5.
  //
  //  Parameters:
  //
  //    Input, double *A, *B, *X, the parameters of teh
  //    incomplete beta ratio.
  //
  //    Input, double *EPS, a tolerance.
  //
  //    Output, double APSER, the computed value of the
  //    incomplete beta ratio.
  //
  {
    static double g = 0.577215664901533e0;
    static double apser, aj, bx, c, j, s, t, tol;

    bx = *b**x;
    t = *x - bx;
    if(*b**eps > 2.e-2) goto S10;
    c = log(*x) + psi(b) + g + t;
    goto S20;
  S10:
    c = log(bx) + g + t;
  S20:
    tol = 5.0e0 * *eps * fabs(c);
    j = 1.0e0;
    s = 0.0e0;
  S30:
    j = j + 1.0e0;
    t = t * (*x - bx / j);
    aj = t / j;
    s = s + aj;
    if(fabs(aj) > tol) goto S30;
    apser = -(*a * (c + s));
    return apser;
  }
  //****************************************************************************

  double bcorr ( double *a0, double *b0 )

  //****************************************************************************
  //
  //  Purpose:
  //
  //    BCORR evaluates DEL(A0) + DEL(B0) - DEL(A0 + B0).
  //
  //  Discussion:
  //
  //    The function DEL(A) is a remainder term that is used in the expression:
  //
  //      ln ( Gamma ( A ) ) = ( A - 0.5 ) * ln ( A )
  //        - A + 0.5 * ln ( 2 * PI ) + DEL ( A ),
  //
  //    or, in other words, DEL ( A ) is defined as:
  //
  //      DEL ( A ) = ln ( Gamma ( A ) ) - ( A - 0.5 ) * ln ( A )
  //        + A + 0.5 * ln ( 2 * PI ).
  //
  //  Parameters:
  //
  //    Input, double *A0, *B0, the arguments.
  //    It is assumed that 8 <= A0 and 8 <= B0.
  //
  //    Output, double *BCORR, the value of the function.
  //
  {
    static double c0 =  0.833333333333333e-01;
    static double c1 = -0.277777777760991e-02;
    static double c2 =  0.793650666825390e-03;
    static double c3 = -0.595202931351870e-03;
    static double c4 =  0.837308034031215e-03;
    static double c5 = -0.165322962780713e-02;
    static double bcorr, a, b, c, h, s11, s3, s5, s7, s9, t, w, x, x2;

    a = fifdmin1 ( *a0, *b0 );
    b = fifdmax1 ( *a0, *b0 );
    h = a / b;
    c = h / ( 1.0e0 + h );
    x = 1.0e0 / ( 1.0e0 + h );
    x2 = x * x;
    //
    //  SET SN = (1 - X**N)/(1 - X)
    //
    s3 = 1.0e0 + ( x + x2 );
    s5 = 1.0e0 + ( x + x2 * s3 );
    s7 = 1.0e0 + ( x + x2 * s5 );
    s9 = 1.0e0 + ( x + x2 * s7 );
    s11 = 1.0e0 + ( x + x2 * s9 );
    //
    //  SET W = DEL(B) - DEL(A + B)
    //
    t = pow ( 1.0e0 / b, 2.0 );

    w = (((( c5 * s11  * t + c4
             * s9 ) * t + c3
           * s7 ) * t + c2
          * s5 ) * t + c1
         * s3 ) * t + c0;
    w *= ( c / b );
    //
    //  COMPUTE  DEL(A) + W
    //
    t = pow ( 1.0e0 / a, 2.0 );

    bcorr = ((((( c5 * t + c4 )
                * t + c3 )
               * t + c2 )
              * t + c1 )
             * t + c0 ) / a + w;
    return bcorr;
  }
  //******************************************************************************

  double beta ( double a, double b )

  //******************************************************************************
  //
  //  Purpose:
  //
  //    BETA evaluates the beta function.
  //
  //  Modified:
  //
  //    03 December 1999
  //
  //  @author:
  //
  //    John Burkardt
  //
  //  Parameters:
  //
  //    Input, double A, B, the arguments of the beta function.
  //
  //    Output, double BETA, the value of the beta function.
  //
  {
    return ( exp ( beta_log ( &a, &b ) ) );
  }
  //****************************************************************************

  double beta_asym ( double *a, double *b, double *lambda, double *eps )

  //****************************************************************************
  //
  //  Purpose:
  //
  //    BETA_ASYM computes an asymptotic expansion for IX(A,B), for large A and B.
  //
  //  Parameters:
  //
  //    Input, double *A, *B, the parameters of the function.
  //    A and B should be nonnegative.  It is assumed that both A and B
  //    are greater than or equal to 15.
  //
  //    Input, double *LAMBDA, the value of ( A + B ) * Y - B.
  //    It is assumed that 0 <= LAMBDA.
  //
  //    Input, double *EPS, the tolerance.
  //
  {
    static double e0 = 1.12837916709551e0;
    static double e1 = .353553390593274e0;
    static int num = 20;
    //
    //  NUM IS THE MAXIMUM VALUE THAT N CAN TAKE IN THE DO LOOP
    //            ENDING AT STATEMENT 50. IT IS REQUIRED THAT NUM BE EVEN.
    //            THE ARRAYS A0, B0, C, D HAVE DIMENSION NUM + 1.
    //     E0 = 2/SQRT(PI)
    //     E1 = 2**(-3/2)
    //
    static int K3 = 1;
    static double value;
    static double bsum, dsum, f, h, h2, hn, j0, j1, r, r0, r1, s, sum, t, t0, t1, u, w, w0, z, z0,
      z2, zn, znm1;
    static int i, im1, imj, j, m, mm1, mmj, n, np1;
    static double a0[21], b0[21], c[21], d[21], T1, T2;

    value = 0.0e0;
    if(*a >= *b) goto S10;
    h = *a / *b;
    r0 = 1.0e0 / (1.0e0 + h);
    r1 = (*b - *a) / *b;
    w0 = 1.0e0 / sqrt(*a * (1.0e0 + h));
    goto S20;
  S10:
    h = *b / *a;
    r0 = 1.0e0 / (1.0e0 + h);
    r1 = (*b - *a) / *a;
    w0 = 1.0e0 / sqrt(*b * (1.0e0 + h));
  S20:
    T1 = -(*lambda / *a);
    T2 = *lambda / *b;
    f = *a * rlog1(&T1) + *b * rlog1(&T2);
    t = exp(-f);
    if(t == 0.0e0) return value;
    z0 = sqrt(f);
    z = 0.5e0 * (z0 / e1);
    z2 = f + f;
    a0[0] = 2.0e0 / 3.0e0 * r1;
    c[0] = -(0.5e0 * a0[0]);
    d[0] = -c[0];
    j0 = 0.5e0 / e0 * error_fc ( &K3, &z0 );
    j1 = e1;
    sum = j0 + d[0] * w0 * j1;
    s = 1.0e0;
    h2 = h * h;
    hn = 1.0e0;
    w = w0;
    znm1 = z;
    zn = z2;
    for ( n = 2; n <= num; n += 2 )
      {
        hn = h2 * hn;
        a0[n - 1] = 2.0e0 * r0 * (1.0e0 + h * hn) / ((double)n + 2.0e0);
        np1 = n + 1;
        s += hn;
        a0[np1 - 1] = 2.0e0 * r1 * s / ((double)n + 3.0e0);
        for ( i = n; i <= np1; i++ )
          {
            r = -(0.5e0 * ((double)i + 1.0e0));
            b0[0] = r * a0[0];
            for ( m = 2; m <= i; m++ )
              {
                bsum = 0.0e0;
                mm1 = m - 1;
                for ( j = 1; j <= mm1; j++ )
                  {
                    mmj = m - j;
                    bsum += (((double)j * r - (double)mmj) * a0[j - 1] * b0[mmj - 1]);
                  }
                b0[m - 1] = r * a0[m - 1] + bsum / (double)m;
              }
            c[i - 1] = b0[i - 1] / ((double)i + 1.0e0);
            dsum = 0.0e0;
            im1 = i - 1;
            for ( j = 1; j <= im1; j++ )
              {
                imj = i - j;
                dsum += (d[imj - 1] * c[j - 1]);
              }
            d[i - 1] = -(dsum + c[i - 1]);
          }
        j0 = e1 * znm1 + ((double)n - 1.0e0) * j0;
        j1 = e1 * zn + (double)n * j1;
        znm1 = z2 * znm1;
        zn = z2 * zn;
        w = w0 * w;
        t0 = d[n - 1] * w * j0;
        w = w0 * w;
        t1 = d[np1 - 1] * w * j1;
        sum += (t0 + t1);
        if(fabs(t0) + fabs(t1) <= *eps * sum) goto S80;
      }
  S80:
    u = exp(-bcorr(a, b));
    value = e0 * t * u * sum;
    return value;
  }
  //****************************************************************************

  double beta_frac ( double *a, double *b, double *x, double *y, double *lambda,
                     double *eps )

  //****************************************************************************
  //
  //  Purpose:
  //
  //    BETA_FRAC evaluates a continued fraction expansion for IX(A,B).
  //
  //  Parameters:
  //
  //    Input, double *A, *B, the parameters of the function.
  //    A and B should be nonnegative.  It is assumed that both A and
  //    B are greater than 1.
  //
  //    Input, double *X, *Y.  X is the argument of the
  //    function, and should satisy 0 <= X <= 1.  Y should equal 1 - X.
  //
  //    Input, double *LAMBDA, the value of ( A + B ) * Y - B.
  //
  //    Input, double *EPS, a tolerance.
  //
  //    Output, double BETA_FRAC, the value of the continued
  //    fraction approximation for IX(A,B).
  //
  {
    static double bfrac, alpha, an, anp1, beta, bn, bnp1, c, c0, c1, e, n, p, r, r0, s, t, w, yp1;

    bfrac = beta_rcomp ( a, b, x, y );

    if ( bfrac == 0.0e0 )
      {
        return bfrac;
      }

    c = 1.0e0 + *lambda;
    c0 = *b / *a;
    c1 = 1.0e0 + 1.0e0 / *a;
    yp1 = *y + 1.0e0;
    n = 0.0e0;
    p = 1.0e0;
    s = *a + 1.0e0;
    an = 0.0e0;
    bn = anp1 = 1.0e0;
    bnp1 = c / c1;
    r = c1 / c;
    //
    //  CONTINUED FRACTION CALCULATION
    //
  S10:
    n += 1.0e0;
    t = n / *a;
    w = n * (*b - n)**x;
    e = *a / s;
    alpha = p * (p + c0) * e * e * (w**x);
    e = (1.0e0 + t) / (c1 + t + t);
    beta = n + w / s + e * (c + n * yp1);
    p = 1.0e0 + t;
    s += 2.0e0;
    //
    //  UPDATE AN, BN, ANP1, AND BNP1
    //
    t = alpha * an + beta * anp1;
    an = anp1;
    anp1 = t;
    t = alpha * bn + beta * bnp1;
    bn = bnp1;
    bnp1 = t;
    r0 = r;
    r = anp1 / bnp1;

    if ( fabs(r - r0) <= (*eps) * r )
      {
        goto S20;
      }
    //
    //  RESCALE AN, BN, ANP1, AND BNP1
    //
    an /= bnp1;
    bn /= bnp1;
    anp1 = r;
    bnp1 = 1.0e0;
    goto S10;
    //
    //  TERMINATION
    //
  S20:
    bfrac *= r;
    return bfrac;
  }
  //****************************************************************************

  void beta_grat ( double *a, double *b, double *x, double *y, double *w,
                   double *eps, int *ierr )

  //****************************************************************************
  //
  //  Purpose:
  //
  //    BETA_GRAT evaluates an asymptotic expansion for IX(A,B).
  //
  //  Parameters:
  //
  //    Input, double *A, *B, the parameters of the function.
  //    A and B should be nonnegative.  It is assumed that 15 <= A
  //    and B <= 1, and that B is less than A.
  //
  //    Input, double *X, *Y.  X is the argument of the
  //    function, and should satisy 0 <= X <= 1.  Y should equal 1 - X.
  //
  //    Input/output, double *W, a quantity to which the
  //    result of the computation is to be added on output.
  //
  //    Input, double *EPS, a tolerance.
  //
  //    Output, int *IERR, an error flag, which is 0 if no error
  //    was detected.
  //
  {
    static double bm1, bp2n, cn, coef, dj, j, l, lnx, n2, nu, p, q, r, s, sum, t, t2, u, v, z;
    static int i, n, nm1;
    static double c[30], d[30], T1;

    bm1 = *b - 0.5e0 - 0.5e0;
    nu = *a + 0.5e0 * bm1;
    if(*y > 0.375e0) goto S10;
    T1 = -*y;
    lnx = alnrel(&T1);
    goto S20;
  S10:
    lnx = log(*x);
  S20:
    z = -(nu * lnx);
    if(*b*z == 0.0e0) goto S70;
    //
    //  COMPUTATION OF THE EXPANSION
    //  SET R = EXP(-Z)*Z**B/GAMMA(B)
    //
    r = *b * (1.0e0 + gam1(b)) * exp(*b * log(z));
    r *= (exp(*a * lnx) * exp(0.5e0 * bm1 * lnx));
    u = algdiv(b, a) + *b * log(nu);
    u = r * exp(-u);
    if(u == 0.0e0) goto S70;
    gamma_rat1 ( b, &z, &r, &p, &q, eps );
    v = 0.25e0 * pow(1.0e0 / nu, 2.0);
    t2 = 0.25e0 * lnx * lnx;
    l = *w / u;
    j = q / r;
    sum = j;
    t = cn = 1.0e0;
    n2 = 0.0e0;
    for ( n = 1; n <= 30; n++ )
      {
        bp2n = *b + n2;
        j = (bp2n * (bp2n + 1.0e0) * j + (z + bp2n + 1.0e0) * t) * v;
        n2 += 2.0e0;
        t *= t2;
        cn /= (n2 * (n2 + 1.0e0));
        c[n - 1] = cn;
        s = 0.0e0;
        if(n == 1) goto S40;
        nm1 = n - 1;
        coef = *b - (double)n;
        for ( i = 1; i <= nm1; i++ )
          {
            s += (coef * c[i - 1] * d[n - i - 1]);
            coef += *b;
          }
      S40:
        d[n - 1] = bm1 * cn + s / (double)n;
        dj = d[n - 1] * j;
        sum += dj;
        if(sum <= 0.0e0) goto S70;
        if(fabs(dj) <= *eps * (sum + l)) goto S60;
      }
  S60:
    //
    //  ADD THE RESULTS TO W
    //
    *ierr = 0;
    *w += (u * sum);
    return;
  S70:
    //
    //  THE EXPANSION CANNOT BE COMPUTED
    //
    *ierr = 1;
    return;
  }
  //****************************************************************************

  void beta_inc ( double *a, double *b, double *x, double *y, double *w,
                  double *w1, int *ierr )

  //****************************************************************************
  //
  //  Purpose:
  //
  //    BETA_INC evaluates the incomplete beta function IX(A,B).
  //
  //  @author:
  //
  //    Alfred H Morris, Jr,
  //    Naval Surface Weapons Center,
  //    Dahlgren, Virginia.
  //
  //  Parameters:
  //
  //    Input, double *A, *B, the parameters of the function.
  //    A and B should be nonnegative.
  //
  //    Input, double *X, *Y.  X is the argument of the
  //    function, and should satisy 0 <= X <= 1.  Y should equal 1 - X.
  //
  //    Output, double *W, *W1, the values of IX(A,B) and
  //    1-IX(A,B).
  //
  //    Output, int *IERR, the error flag.
  //    0, no error was detected.
  //    1, A or B is negative;
  //    2, A = B = 0;
  //    3, X < 0 or 1 < X;
  //    4, Y < 0 or 1 < Y;
  //    5, X + Y /= 1;
  //    6, X = A = 0;
  //    7, Y = B = 0.
  //
  {
    static int K1 = 1;
    static double a0, b0, eps, lambda, t, x0, y0, z;
    static int ierr1, ind, n;
    static double T2, T3, T4, T5;
    //
    //  EPS IS A MACHINE DEPENDENT CONSTANT. EPS IS THE SMALLEST
    //  NUMBER FOR WHICH 1.0 + EPS .GT. 1.0
    //
    eps = dpmpar ( &K1 );
    *w = *w1 = 0.0e0;
    if(*a < 0.0e0 || *b < 0.0e0) goto S270;
    if(*a == 0.0e0 && *b == 0.0e0) goto S280;
    if(*x < 0.0e0 || *x > 1.0e0) goto S290;
    if(*y < 0.0e0 || *y > 1.0e0) goto S300;
    z = *x + *y - 0.5e0 - 0.5e0;
    if(fabs(z) > 3.0e0 * eps) goto S310;
    *ierr = 0;
    if(*x == 0.0e0) goto S210;
    if(*y == 0.0e0) goto S230;
    if(*a == 0.0e0) goto S240;
    if(*b == 0.0e0) goto S220;
    eps = fifdmax1(eps, 1.e-15);
    if(fifdmax1(*a, *b) < 1.e-3 * eps) goto S260;
    ind = 0;
    a0 = *a;
    b0 = *b;
    x0 = *x;
    y0 = *y;
    if(fifdmin1(a0, b0) > 1.0e0) goto S40;
    //
    //  PROCEDURE FOR A0 .LE. 1 OR B0 .LE. 1
    //
    if(*x <= 0.5e0) goto S10;
    ind = 1;
    a0 = *b;
    b0 = *a;
    x0 = *y;
    y0 = *x;
  S10:
    if(b0 < fifdmin1(eps, eps * a0)) goto S90;
    if(a0 < fifdmin1(eps, eps * b0) && b0*x0 <= 1.0e0) goto S100;
    if(fifdmax1(a0, b0) > 1.0e0) goto S20;
    if(a0 >= fifdmin1(0.2e0, b0)) goto S110;
    if(pow(x0, a0) <= 0.9e0) goto S110;
    if(x0 >= 0.3e0) goto S120;
    n = 20;
    goto S140;
  S20:
    if(b0 <= 1.0e0) goto S110;
    if(x0 >= 0.3e0) goto S120;
    if(x0 >= 0.1e0) goto S30;
    if(pow(x0 * b0, a0) <= 0.7e0) goto S110;
  S30:
    if(b0 > 15.0e0) goto S150;
    n = 20;
    goto S140;
  S40:
    //
    //  PROCEDURE FOR A0 .GT. 1 AND B0 .GT. 1
    //
    if(*a > *b) goto S50;
    lambda = *a - (*a + *b)**x;
    goto S60;
  S50:
    lambda = (*a + *b)**y - *b;
  S60:
    if(lambda >= 0.0e0) goto S70;
    ind = 1;
    a0 = *b;
    b0 = *a;
    x0 = *y;
    y0 = *x;
    lambda = fabs(lambda);
  S70:
    if(b0 < 40.0e0 && b0*x0 <= 0.7e0) goto S110;
    if(b0 < 40.0e0) goto S160;
    if(a0 > b0) goto S80;
    if(a0 <= 100.0e0) goto S130;
    if(lambda > 0.03e0 * a0) goto S130;
    goto S200;
  S80:
    if(b0 <= 100.0e0) goto S130;
    if(lambda > 0.03e0 * b0) goto S130;
    goto S200;
  S90:
    //
    //  EVALUATION OF THE APPROPRIATE ALGORITHM
    //
    *w = fpser(&a0, &b0, &x0, &eps);
    *w1 = 0.5e0 + (0.5e0 - *w);
    goto S250;
  S100:
    *w1 = apser(&a0, &b0, &x0, &eps);
    *w = 0.5e0 + (0.5e0 - *w1);
    goto S250;
  S110:
    *w = beta_pser(&a0, &b0, &x0, &eps);
    *w1 = 0.5e0 + (0.5e0 - *w);
    goto S250;
  S120:
    *w1 = beta_pser(&b0, &a0, &y0, &eps);
    *w = 0.5e0 + (0.5e0 - *w1);
    goto S250;
  S130:
    T2 = 15.0e0 * eps;
    *w = beta_frac ( &a0, &b0, &x0, &y0, &lambda, &T2 );
    *w1 = 0.5e0 + (0.5e0 - *w);
    goto S250;
  S140:
    *w1 = beta_up ( &b0, &a0, &y0, &x0, &n, &eps );
    b0 += (double)n;
  S150:
    T3 = 15.0e0 * eps;
    beta_grat (&b0, &a0, &y0, &x0, w1, &T3, &ierr1);
    *w = 0.5e0 + (0.5e0 - *w1);
    goto S250;
  S160:
    n = ( int ) b0;
    b0 -= (double)n;
    if(b0 != 0.0e0) goto S170;
    n -= 1;
    b0 = 1.0e0;
  S170:
    *w = beta_up ( &b0, &a0, &y0, &x0, &n, &eps );
    if(x0 > 0.7e0) goto S180;
    *w += beta_pser(&a0, &b0, &x0, &eps);
    *w1 = 0.5e0 + (0.5e0 - *w);
    goto S250;
  S180:
    if(a0 > 15.0e0) goto S190;
    n = 20;
    *w += beta_up ( &a0, &b0, &x0, &y0, &n, &eps );
    a0 += (double)n;
  S190:
    T4 = 15.0e0 * eps;
    beta_grat ( &a0, &b0, &x0, &y0, w, &T4, &ierr1 );
    *w1 = 0.5e0 + (0.5e0 - *w);
    goto S250;
  S200:
    T5 = 100.0e0 * eps;
    *w = beta_asym ( &a0, &b0, &lambda, &T5 );
    *w1 = 0.5e0 + (0.5e0 - *w);
    goto S250;
  S210:
    //
    //  TERMINATION OF THE PROCEDURE
    //
    if(*a == 0.0e0) goto S320;
  S220:
    *w = 0.0e0;
    *w1 = 1.0e0;
    return;
  S230:
    if(*b == 0.0e0) goto S330;
  S240:
    *w = 1.0e0;
    *w1 = 0.0e0;
    return;
  S250:
    if(ind == 0) return;
    t = *w;
    *w = *w1;
    *w1 = t;
    return;
  S260:
    //
    //  PROCEDURE FOR A AND B .LT. 1.E-3*EPS
    //
    *w = *b / (*a + *b);
    *w1 = *a / (*a + *b);
    return;
  S270:
    //
    //  ERROR RETURN
    //
    *ierr = 1;
    return;
  S280:
    *ierr = 2;
    return;
  S290:
    *ierr = 3;
    return;
  S300:
    *ierr = 4;
    return;
  S310:
    *ierr = 5;
    return;
  S320:
    *ierr = 6;
    return;
  S330:
    *ierr = 7;
    return;
  }
  //*******************************************************************************

  void beta_inc_values ( int *n_data, double *a, double *b, double *x, double *fx )

  //*******************************************************************************
  //
  //  Purpose:
  //
  //    BETA_INC_VALUES returns some values of the incomplete Beta function.
  //
  //  Discussion:
  //
  //    The incomplete Beta function may be written
  //
  //      BETA_INC(A,B,X) = Integral (0 to X) T**(A-1) * (1-T)**(B-1) dT
  //                      / Integral (0 to 1) T**(A-1) * (1-T)**(B-1) dT
  //
  //    Thus,
  //
  //      BETA_INC(A,B,0.0) = 0.0
  //      BETA_INC(A,B,1.0) = 1.0
  //
  //    Note that in Mathematica, the expressions:
  //
  //      BETA[A,B]   = Integral (0 to 1) T**(A-1) * (1-T)**(B-1) dT
  //      BETA[X,A,B] = Integral (0 to X) T**(A-1) * (1-T)**(B-1) dT
  //
  //    and thus, to evaluate the incomplete Beta function requires:
  //
  //      BETA_INC(A,B,X) = BETA[X,A,B] / BETA[A,B]
  //
  //  Modified:
  //
  //    09 June 2004
  //
  //  @author:
  //
  //    John Burkardt
  //
  //  Reference:
  //
  //    Milton Abramowitz and Irene Stegun,
  //    Handbook of Mathematical Functions,
  //    US Department of Commerce, 1964.
  //
  //    Karl Pearson,
  //    Tables of the Incomplete Beta Function,
  //    Cambridge University Press, 1968.
  //
  //  Parameters:
  //
  //    Input/output, int *N_DATA.  The user sets N_DATA to 0 before the
  //    first call.  On each call, the routine increments N_DATA by 1, and
  //    returns the corresponding data; when there is no more data, the
  //    output value of N_DATA will be 0 again.
  //
  //    Output, double *A, *B, the parameters of the function.
  //
  //    Output, double *X, the argument of the function.
  //
  //    Output, double *FX, the value of the function.
  //
  {
# define N_MAX 30

    double a_vec[N_MAX] =
      {
        0.5E+00,  0.5E+00,  0.5E+00,  1.0E+00,
        1.0E+00,  1.0E+00,  1.0E+00,  1.0E+00,
        2.0E+00,  2.0E+00,  2.0E+00,  2.0E+00,
        2.0E+00,  2.0E+00,  2.0E+00,  2.0E+00,
        2.0E+00,  5.5E+00, 10.0E+00, 10.0E+00,
        10.0E+00, 10.0E+00, 20.0E+00, 20.0E+00,
        20.0E+00, 20.0E+00, 20.0E+00, 30.0E+00,
        30.0E+00, 40.0E+00
      };
    double b_vec[N_MAX] =
      {
        0.5E+00,  0.5E+00,  0.5E+00,  0.5E+00,
        0.5E+00,  0.5E+00,  0.5E+00,  1.0E+00,
        2.0E+00,  2.0E+00,  2.0E+00,  2.0E+00,
        2.0E+00,  2.0E+00,  2.0E+00,  2.0E+00,
        2.0E+00,  5.0E+00,  0.5E+00,  5.0E+00,
        5.0E+00, 10.0E+00,  5.0E+00, 10.0E+00,
        10.0E+00, 20.0E+00, 20.0E+00, 10.0E+00,
        10.0E+00, 20.0E+00
      };
    double fx_vec[N_MAX] =
      {
        0.0637686E+00, 0.2048328E+00, 1.0000000E+00, 0.0E+00,
        0.0050126E+00, 0.0513167E+00, 0.2928932E+00, 0.5000000E+00,
        0.028E+00,     0.104E+00,     0.216E+00,     0.352E+00,
        0.500E+00,     0.648E+00,     0.784E+00,     0.896E+00,
        0.972E+00,     0.4361909E+00, 0.1516409E+00, 0.0897827E+00,
        1.0000000E+00, 0.5000000E+00, 0.4598773E+00, 0.2146816E+00,
        0.9507365E+00, 0.5000000E+00, 0.8979414E+00, 0.2241297E+00,
        0.7586405E+00, 0.7001783E+00
      };
    double x_vec[N_MAX] =
      {
        0.01E+00, 0.10E+00, 1.00E+00, 0.0E+00,
        0.01E+00, 0.10E+00, 0.50E+00, 0.50E+00,
        0.1E+00,  0.2E+00,  0.3E+00,  0.4E+00,
        0.5E+00,  0.6E+00,  0.7E+00,  0.8E+00,
        0.9E+00,  0.50E+00, 0.90E+00, 0.50E+00,
        1.00E+00, 0.50E+00, 0.80E+00, 0.60E+00,
        0.80E+00, 0.50E+00, 0.60E+00, 0.70E+00,
        0.80E+00, 0.70E+00
      };

    if ( *n_data < 0 )
      {
        *n_data = 0;
      }

    *n_data = *n_data + 1;

    if ( N_MAX < *n_data )
      {
        *n_data = 0;
        *a = 0.0E+00;
        *b = 0.0E+00;
        *x = 0.0E+00;
        *fx = 0.0E+00;
      }
    else
      {
        *a = a_vec[*n_data - 1];
        *b = b_vec[*n_data - 1];
        *x = x_vec[*n_data - 1];
        *fx = fx_vec[*n_data - 1];
      }
    return;
# undef N_MAX
  }
  //****************************************************************************

  double beta_log ( double *a0, double *b0 )

  //****************************************************************************
  //
  //  Purpose:
  //
  //    BETA_LOG evaluates the logarithm of the beta function.
  //
  //  Reference:
  //
  //    Armido DiDinato and Alfred Morris,
  //    Algorithm 708:
  //    Significant Digit Computation of the Incomplete Beta Function Ratios,
  //    ACM Transactions on Mathematical Software,
  //    Volume 18, 1993, pages 360-373.
  //
  //  Parameters:
  //
  //    Input, double *A0, *B0, the parameters of the function.
  //    A0 and B0 should be nonnegative.
  //
  //    Output, double *BETA_LOG, the value of the logarithm
  //    of the Beta function.
  //
  {
    static double e = .918938533204673e0;
    static double value, a, b, c, h, u, v, w, z;
    static int i, n;
    static double T1;

    a = fifdmin1(*a0, *b0);
    b = fifdmax1(*a0, *b0);
    if(a >= 8.0e0) goto S100;
    if(a >= 1.0e0) goto S20;
    //
    //  PROCEDURE WHEN A .LT. 1
    //
    if(b >= 8.0e0) goto S10;
    T1 = a + b;
    value = gamma_log ( &a ) + ( gamma_log ( &b ) - gamma_log ( &T1 ));
    return value;
  S10:
    value = gamma_log ( &a ) + algdiv(&a, &b);
    return value;
  S20:
    //
    //  PROCEDURE WHEN 1 .LE. A .LT. 8
    //
    if(a > 2.0e0) goto S40;
    if(b > 2.0e0) goto S30;
    value = gamma_log ( &a ) + gamma_log ( &b ) - gsumln(&a, &b);
    return value;
  S30:
    w = 0.0e0;
    if(b < 8.0e0) goto S60;
    value = gamma_log ( &a ) + algdiv(&a, &b);
    return value;
  S40:
    //
    //  REDUCTION OF A WHEN B .LE. 1000
    //
    if(b > 1000.0e0) goto S80;
    n = ( int ) ( a - 1.0e0 );
    w = 1.0e0;
    for ( i = 1; i <= n; i++ )
      {
        a -= 1.0e0;
        h = a / b;
        w *= (h / (1.0e0 + h));
      }
    w = log(w);
    if(b < 8.0e0) goto S60;
    value = w + gamma_log ( &a ) + algdiv(&a, &b);
    return value;
  S60:
    //
    //  REDUCTION OF B WHEN B .LT. 8
    //
    n = ( int ) ( b - 1.0e0 );
    z = 1.0e0;
    for ( i = 1; i <= n; i++ )
      {
        b -= 1.0e0;
        z *= (b / (a + b));
      }
    value = w + log(z) + ( gamma_log ( &a ) + ( gamma_log ( &b ) - gsumln(&a, &b)));
    return value;
  S80:
    //
    //  REDUCTION OF A WHEN B .GT. 1000
    //
    n = ( int ) ( a - 1.0e0 );
    w = 1.0e0;
    for ( i = 1; i <= n; i++ )
      {
        a -= 1.0e0;
        w *= (a / (1.0e0 + a / b));
      }
    value = log(w) - (double)n * log(b) + ( gamma_log ( &a ) + algdiv(&a, &b));
    return value;
  S100:
    //
    //  PROCEDURE WHEN A .GE. 8
    //
    w = bcorr(&a, &b);
    h = a / b;
    c = h / (1.0e0 + h);
    u = -((a - 0.5e0) * log(c));
    v = b * alnrel(&h);
    if(u <= v) goto S110;
    value = -(0.5e0 * log(b)) + e + w - v - u;
    return value;
  S110:
    value = -(0.5e0 * log(b)) + e + w - u - v;
    return value;
  }
  //****************************************************************************

  double beta_pser ( double *a, double *b, double *x, double *eps )

  //****************************************************************************
  //
  //  Purpose:
  //
  //    BETA_PSER uses a power series expansion to evaluate IX(A,B)(X).
  //
  //  Discussion:
  //
  //    BETA_PSER is used when B <= 1 or B*X <= 0.7.
  //
  //  Parameters:
  //
  //    Input, double *A, *B, the parameters.
  //
  //    Input, double *X, the point where the function
  //    is to be evaluated.
  //
  //    Input, double *EPS, the tolerance.
  //
  //    Output, double BETA_PSER, the approximate value of IX(A,B)(X).
  //
  {
    static double bpser, a0, apb, b0, c, n, sum, t, tol, u, w, z;
    static int i, m;

    bpser = 0.0e0;
    if(*x == 0.0e0) return bpser;
    //
    //  COMPUTE THE FACTOR X**A/(A*BETA(A,B))
    //
    a0 = fifdmin1(*a, *b);
    if(a0 < 1.0e0) goto S10;
    z = *a * log(*x) - beta_log(a, b);
    bpser = exp(z) / *a;
    goto S100;
  S10:
    b0 = fifdmax1(*a, *b);
    if(b0 >= 8.0e0) goto S90;
    if(b0 > 1.0e0) goto S40;
    //
    //  PROCEDURE FOR A0 .LT. 1 AND B0 .LE. 1
    //
    bpser = pow(*x, *a);
    if(bpser == 0.0e0) return bpser;
    apb = *a + *b;
    if(apb > 1.0e0) goto S20;
    z = 1.0e0 + gam1(&apb);
    goto S30;
  S20:
    u = *a + *b - 1.e0;
    z = (1.0e0 + gam1(&u)) / apb;
  S30:
    c = (1.0e0 + gam1(a)) * (1.0e0 + gam1(b)) / z;
    bpser *= (c * (*b / apb));
    goto S100;
  S40:
    //
    //  PROCEDURE FOR A0 .LT. 1 AND 1 .LT. B0 .LT. 8
    //
    u = gamma_ln1 ( &a0 );
    m = ( int ) ( b0 - 1.0e0 );
    if(m < 1) goto S60;
    c = 1.0e0;
    for ( i = 1; i <= m; i++ )
      {
        b0 -= 1.0e0;
        c *= (b0 / (a0 + b0));
      }
    u = log(c) + u;
  S60:
    z = *a * log(*x) - u;
    b0 -= 1.0e0;
    apb = a0 + b0;
    if(apb > 1.0e0) goto S70;
    t = 1.0e0 + gam1(&apb);
    goto S80;
  S70:
    u = a0 + b0 - 1.e0;
    t = (1.0e0 + gam1(&u)) / apb;
  S80:
    bpser = exp(z) * (a0 / *a) * (1.0e0 + gam1(&b0)) / t;
    goto S100;
  S90:
    //
    //  PROCEDURE FOR A0 .LT. 1 AND B0 .GE. 8
    //
    u = gamma_ln1 ( &a0 ) + algdiv ( &a0, &b0 );
    z = *a * log(*x) - u;
    bpser = a0 / *a * exp(z);
  S100:
    if(bpser == 0.0e0 || *a <= 0.1e0 * *eps) return bpser;
    //
    //  COMPUTE THE SERIES
    //
    sum = n = 0.0e0;
    c = 1.0e0;
    tol = *eps / *a;
  S110:
    n += 1.0e0;
    c *= ((0.5e0 + (0.5e0 - *b / n))**x);
    w = c / (*a + n);
    sum += w;
    if(fabs(w) > tol) goto S110;
    bpser *= (1.0e0 + *a * sum);
    return bpser;
  }
  //****************************************************************************

  double beta_rcomp ( double *a, double *b, double *x, double *y )

  //****************************************************************************
  //
  //  Purpose:
  //
  //    BETA_RCOMP evaluates X**A * Y**B / Beta(A,B).
  //
  //  Parameters:
  //
  //    Input, double *A, *B, the parameters of the Beta function.
  //    A and B should be nonnegative.
  //
  //    Input, double *X, *Y, define the numerator of the fraction.
  //
  //    Output, double BETA_RCOMP, the value of X**A * Y**B / Beta(A,B).
  //
  {
    static double Const = .398942280401433e0;
    static double brcomp, a0, apb, b0, c, e, h, lambda, lnx, lny, t, u, v, x0, y0, z;
    static int i, n;
    //
    //  CONST = 1/SQRT(2*PI)
    //
    static double T1, T2;

    brcomp = 0.0e0;
    if(*x == 0.0e0 || *y == 0.0e0) return brcomp;
    a0 = fifdmin1(*a, *b);
    if(a0 >= 8.0e0) goto S130;
    if(*x > 0.375e0) goto S10;
    lnx = log(*x);
    T1 = -*x;
    lny = alnrel(&T1);
    goto S30;
  S10:
    if(*y > 0.375e0) goto S20;
    T2 = -*y;
    lnx = alnrel(&T2);
    lny = log(*y);
    goto S30;
  S20:
    lnx = log(*x);
    lny = log(*y);
  S30:
    z = *a * lnx + *b * lny;
    if(a0 < 1.0e0) goto S40;
    z -= beta_log(a, b);
    brcomp = exp(z);
    return brcomp;
  S40:
    //
    //  PROCEDURE FOR A .LT. 1 OR B .LT. 1
    //
    b0 = fifdmax1(*a, *b);
    if(b0 >= 8.0e0) goto S120;
    if(b0 > 1.0e0) goto S70;
    //
    //  ALGORITHM FOR B0 .LE. 1
    //
    brcomp = exp(z);
    if(brcomp == 0.0e0) return brcomp;
    apb = *a + *b;
    if(apb > 1.0e0) goto S50;
    z = 1.0e0 + gam1(&apb);
    goto S60;
  S50:
    u = *a + *b - 1.e0;
    z = (1.0e0 + gam1(&u)) / apb;
  S60:
    c = (1.0e0 + gam1(a)) * (1.0e0 + gam1(b)) / z;
    brcomp = brcomp * (a0 * c) / (1.0e0 + a0 / b0);
    return brcomp;
  S70:
    //
    //  ALGORITHM FOR 1 .LT. B0 .LT. 8
    //
    u = gamma_ln1 ( &a0 );
    n = ( int ) ( b0 - 1.0e0 );
    if(n < 1) goto S90;
    c = 1.0e0;
    for ( i = 1; i <= n; i++ )
      {
        b0 -= 1.0e0;
        c *= (b0 / (a0 + b0));
      }
    u = log(c) + u;
  S90:
    z -= u;
    b0 -= 1.0e0;
    apb = a0 + b0;
    if(apb > 1.0e0) goto S100;
    t = 1.0e0 + gam1(&apb);
    goto S110;
  S100:
    u = a0 + b0 - 1.e0;
    t = (1.0e0 + gam1(&u)) / apb;
  S110:
    brcomp = a0 * exp(z) * (1.0e0 + gam1(&b0)) / t;
    return brcomp;
  S120:
    //
    //  ALGORITHM FOR B0 .GE. 8
    //
    u = gamma_ln1 ( &a0 ) + algdiv ( &a0, &b0 );
    brcomp = a0 * exp(z - u);
    return brcomp;
  S130:
    //
    //  PROCEDURE FOR A .GE. 8 AND B .GE. 8
    //
    if(*a > *b) goto S140;
    h = *a / *b;
    x0 = h / (1.0e0 + h);
    y0 = 1.0e0 / (1.0e0 + h);
    lambda = *a - (*a + *b)**x;
    goto S150;
  S140:
    h = *b / *a;
    x0 = 1.0e0 / (1.0e0 + h);
    y0 = h / (1.0e0 + h);
    lambda = (*a + *b)**y - *b;
  S150:
    e = -(lambda / *a);
    if(fabs(e) > 0.6e0) goto S160;
    u = rlog1(&e);
    goto S170;
  S160:
    u = e - log(*x / x0);
  S170:
    e = lambda / *b;
    if(fabs(e) > 0.6e0) goto S180;
    v = rlog1(&e);
    goto S190;
  S180:
    v = e - log(*y / y0);
  S190:
    z = exp(-(*a * u + *b * v));
    brcomp = Const * sqrt(*b * x0) * z * exp(-bcorr(a, b));
    return brcomp;
  }
  //****************************************************************************

  double beta_rcomp1 ( int *mu, double *a, double *b, double *x, double *y )

  //****************************************************************************
  //
  //  Purpose:
  //
  //    BETA_RCOMP1 evaluates exp(MU) * X**A * Y**B / Beta(A,B).
  //
  //  Parameters:
  //
  //    Input, int MU, ?
  //
  //    Input, double A, B, the parameters of the Beta function.
  //    A and B should be nonnegative.
  //
  //    Input, double X, Y, ?
  //
  //    Output, double BETA_RCOMP1, the value of
  //    exp(MU) * X**A * Y**B / Beta(A,B).
  //
  {
    static double Const = .398942280401433e0;
    static double brcmp1, a0, apb, b0, c, e, h, lambda, lnx, lny, t, u, v, x0, y0, z;
    static int i, n;
    //
    //     CONST = 1/SQRT(2*PI)
    //
    static double T1, T2, T3, T4;

    a0 = fifdmin1(*a, *b);
    if(a0 >= 8.0e0) goto S130;
    if(*x > 0.375e0) goto S10;
    lnx = log(*x);
    T1 = -*x;
    lny = alnrel(&T1);
    goto S30;
  S10:
    if(*y > 0.375e0) goto S20;
    T2 = -*y;
    lnx = alnrel(&T2);
    lny = log(*y);
    goto S30;
  S20:
    lnx = log(*x);
    lny = log(*y);
  S30:
    z = *a * lnx + *b * lny;
    if(a0 < 1.0e0) goto S40;
    z -= beta_log(a, b);
    brcmp1 = esum(mu, &z);
    return brcmp1;
  S40:
    //
    //   PROCEDURE FOR A .LT. 1 OR B .LT. 1
    //
    b0 = fifdmax1(*a, *b);
    if(b0 >= 8.0e0) goto S120;
    if(b0 > 1.0e0) goto S70;
    //
    //  ALGORITHM FOR B0 .LE. 1
    //
    brcmp1 = esum(mu, &z);
    if(brcmp1 == 0.0e0) return brcmp1;
    apb = *a + *b;
    if(apb > 1.0e0) goto S50;
    z = 1.0e0 + gam1(&apb);
    goto S60;
  S50:
    u = *a + *b - 1.e0;
    z = (1.0e0 + gam1(&u)) / apb;
  S60:
    c = (1.0e0 + gam1(a)) * (1.0e0 + gam1(b)) / z;
    brcmp1 = brcmp1 * (a0 * c) / (1.0e0 + a0 / b0);
    return brcmp1;
  S70:
    //
    //  ALGORITHM FOR 1 .LT. B0 .LT. 8
    //
    u = gamma_ln1 ( &a0 );
    n = ( int ) ( b0 - 1.0e0 );
    if(n < 1) goto S90;
    c = 1.0e0;
    for ( i = 1; i <= n; i++ )
      {
        b0 -= 1.0e0;
        c *= (b0 / (a0 + b0));
      }
    u = log(c) + u;
  S90:
    z -= u;
    b0 -= 1.0e0;
    apb = a0 + b0;
    if(apb > 1.0e0) goto S100;
    t = 1.0e0 + gam1(&apb);
    goto S110;
  S100:
    u = a0 + b0 - 1.e0;
    t = (1.0e0 + gam1(&u)) / apb;
  S110:
    brcmp1 = a0 * esum(mu, &z) * (1.0e0 + gam1(&b0)) / t;
    return brcmp1;
  S120:
    //
    //  ALGORITHM FOR B0 .GE. 8
    //
    u = gamma_ln1 ( &a0 ) + algdiv ( &a0, &b0 );
    T3 = z - u;
    brcmp1 = a0 * esum(mu, &T3);
    return brcmp1;
  S130:
    //
    //    PROCEDURE FOR A .GE. 8 AND B .GE. 8
    //
    if(*a > *b) goto S140;
    h = *a / *b;
    x0 = h / (1.0e0 + h);
    y0 = 1.0e0 / (1.0e0 + h);
    lambda = *a - (*a + *b)**x;
    goto S150;
  S140:
    h = *b / *a;
    x0 = 1.0e0 / (1.0e0 + h);
    y0 = h / (1.0e0 + h);
    lambda = (*a + *b)**y - *b;
  S150:
    e = -(lambda / *a);
    if(fabs(e) > 0.6e0) goto S160;
    u = rlog1(&e);
    goto S170;
  S160:
    u = e - log(*x / x0);
  S170:
    e = lambda / *b;
    if(fabs(e) > 0.6e0) goto S180;
    v = rlog1(&e);
    goto S190;
  S180:
    v = e - log(*y / y0);
  S190:
    T4 = -(*a * u + *b * v);
    z = esum(mu, &T4);
    brcmp1 = Const * sqrt(*b * x0) * z * exp(-bcorr(a, b));
    return brcmp1;
  }
  //****************************************************************************

  double beta_up ( double *a, double *b, double *x, double *y, int *n, double *eps )

  //****************************************************************************
  //
  //  Purpose:
  //
  //    BETA_UP evaluates IX(A,B) - IX(A+N,B) where N is a positive integer.
  //
  //  Parameters:
  //
  //    Input, double *A, *B, the parameters of the function.
  //    A and B should be nonnegative.
  //
  //    Input, double *X, *Y, ?
  //
  //    Input, int *N, ?
  //
  //    Input, double *EPS, the tolerance.
  //
  //    Output, double BETA_UP, the value of IX(A,B) - IX(A+N,B).
  //
  {
    static int K1 = 1;
    static int K2 = 0;
    static double bup, ap1, apb, d, l, r, t, w;
    static int i, k, kp1, mu, nm1;
    //
    //  OBTAIN THE SCALING FACTOR EXP(-MU) AND
    //  EXP(MU)*(X**A*Y**B/BETA(A,B))/A
    //
    apb = *a + *b;
    ap1 = *a + 1.0e0;
    mu = 0;
    d = 1.0e0;
    if(*n == 1 || *a < 1.0e0) goto S10;
    if(apb < 1.1e0 * ap1) goto S10;
    mu = ( int ) fabs ( exparg(&K1) );
    k = ( int ) exparg ( &K2 );
    if(k < mu) mu = k;
    t = mu;
    d = exp(-t);
  S10:
    bup = beta_rcomp1 ( &mu, a, b, x, y ) / *a;
    if(*n == 1 || bup == 0.0e0) return bup;
    nm1 = *n - 1;
    w = d;
    //
    //  LET K BE THE INDEX OF THE MAXIMUM TERM
    //
    k = 0;
    if(*b <= 1.0e0) goto S50;
    if(*y > 1.e-4) goto S20;
    k = nm1;
    goto S30;
  S20:
    r = (*b - 1.0e0)**x / *y - *a;
    if(r < 1.0e0) goto S50;
    t = ( double ) nm1;
    k = nm1;
    if ( r < t ) k = ( int ) r;
  S30:
    //
    //          ADD THE INCREASING TERMS OF THE SERIES
    //
    for ( i = 1; i <= k; i++ )
      {
        l = i - 1;
        d = (apb + l) / (ap1 + l)**x * d;
        w += d;
      }
    if(k == nm1) goto S70;
  S50:
    //
    //          ADD THE REMAINING TERMS OF THE SERIES
    //
    kp1 = k + 1;
    for ( i = kp1; i <= nm1; i++ )
      {
        l = i - 1;
        d = (apb + l) / (ap1 + l)**x * d;
        w += d;
        if(d <= *eps * w) goto S70;
      }
  S70:
    //
    //  TERMINATE THE PROCEDURE
    //
    bup *= w;
    return bup;
  }
  //*******************************************************************************

  void binomial_cdf_values ( int *n_data, int *a, double *b, int *x, double *fx )

  //*******************************************************************************
  //
  //  Purpose:
  //
  //    BINOMIAL_CDF_VALUES returns some values of the binomial CDF.
  //
  //  Discussion:
  //
  //    CDF(X)(A,B) is the probability of at most X successes in A trials,
  //    given that the probability of success on a single trial is B.
  //
  //  Modified:
  //
  //    31 May 2004
  //
  //  @author:
  //
  //    John Burkardt
  //
  //  Reference:
  //
  //    Milton Abramowitz and Irene Stegun,
  //    Handbook of Mathematical Functions,
  //    US Department of Commerce, 1964.
  //
  //    Daniel Zwillinger,
  //    CRC Standard Mathematical Tables and Formulae,
  //    30th Edition, CRC Press, 1996, pages 651-652.
  //
  //  Parameters:
  //
  //    Input/output, int *N_DATA.  The user sets N_DATA to 0 before the
  //    first call.  On each call, the routine increments N_DATA by 1, and
  //    returns the corresponding data; when there is no more data, the
  //    output value of N_DATA will be 0 again.
  //
  //    Output, int *A, double *B, the parameters of the function.
  //
  //    Output, int *X, the argument of the function.
  //
  //    Output, double *FX, the value of the function.
  //
  {
# define N_MAX 17

    int a_vec[N_MAX] =
      {
        2,  2,  2,  2,
        2,  4,  4,  4,
        4, 10, 10, 10,
        10, 10, 10, 10,
        10
      };
    double b_vec[N_MAX] =
      {
        0.05E+00, 0.05E+00, 0.05E+00, 0.50E+00,
        0.50E+00, 0.25E+00, 0.25E+00, 0.25E+00,
        0.25E+00, 0.05E+00, 0.10E+00, 0.15E+00,
        0.20E+00, 0.25E+00, 0.30E+00, 0.40E+00,
        0.50E+00
      };
    double fx_vec[N_MAX] =
      {
        0.9025E+00, 0.9975E+00, 1.0000E+00, 0.2500E+00,
        0.7500E+00, 0.3164E+00, 0.7383E+00, 0.9492E+00,
        0.9961E+00, 0.9999E+00, 0.9984E+00, 0.9901E+00,
        0.9672E+00, 0.9219E+00, 0.8497E+00, 0.6331E+00,
        0.3770E+00
      };
    int x_vec[N_MAX] =
      {
        0, 1, 2, 0,
        1, 0, 1, 2,
        3, 4, 4, 4,
        4, 4, 4, 4,
        4
      };

    if ( *n_data < 0 )
      {
        *n_data = 0;
      }

    *n_data = *n_data + 1;

    if ( N_MAX < *n_data )
      {
        *n_data = 0;
        *a = 0;
        *b = 0.0E+00;
        *x = 0;
        *fx = 0.0E+00;
      }
    else
      {
        *a = a_vec[*n_data - 1];
        *b = b_vec[*n_data - 1];
        *x = x_vec[*n_data - 1];
        *fx = fx_vec[*n_data - 1];
      }
    return;
# undef N_MAX
  }
  //****************************************************************************

  void cdfbet ( int *which, double *p, double *q, double *x, double *y,
                double *a, double *b, int *status, double *bound )

  //****************************************************************************
  //
  //  Purpose:
  //
  //    CDFBET evaluates the CDF of the Beta Distribution.
  //
  //  Discussion:
  //
  //    This routine calculates any one parameter of the beta distribution
  //    given the others.
  //
  //    The value P of the cumulative distribution function is calculated
  //    directly by code associated with the reference.
  //
  //    Computation of the other parameters involves a seach for a value that
  //    produces the desired value of P.  The search relies on the
  //    monotonicity of P with respect to the other parameters.
  //
  //    The beta density is proportional to t^(A-1) * (1-t)^(B-1).
  //
  //  Modified:
  //
  //    09 June 2004
  //
  //  Reference:
  //
  //    Armido DiDinato and Alfred Morris,
  //    Algorithm 708:
  //    Significant Digit Computation of the Incomplete Beta Function Ratios,
  //    ACM Transactions on Mathematical Software,
  //    Volume 18, 1993, pages 360-373.
  //
  //  Parameters:
  //
  //    Input, int *WHICH, indicates which of the next four argument
  //    values is to be calculated from the others.
  //    1: Calculate P and Q from X, Y, A and B;
  //    2: Calculate X and Y from P, Q, A and B;
  //    3: Calculate A from P, Q, X, Y and B;
  //    4: Calculate B from P, Q, X, Y and A.
  //
  //    Input/output, double *P, the integral from 0 to X of the
  //    chi-square distribution.  Input range: [0, 1].
  //
  //    Input/output, double *Q, equals 1-P.  Input range: [0, 1].
  //
  //    Input/output, double *X, the upper limit of integration
  //    of the beta density.  If it is an input value, it should lie in
  //    the range [0,1].  If it is an output value, it will be searched for
  //    in the range [0,1].
  //
  //    Input/output, double *Y, equal to 1-X.  If it is an input
  //    value, it should lie in the range [0,1].  If it is an output value,
  //    it will be searched for in the range [0,1].
  //
  //    Input/output, double *A, the first parameter of the beta
  //    density.  If it is an input value, it should lie in the range
  //    (0, +infinity).  If it is an output value, it will be searched
  //    for in the range [1D-300,1D300].
  //
  //    Input/output, double *B, the second parameter of the beta
  //    density.  If it is an input value, it should lie in the range
  //    (0, +infinity).  If it is an output value, it will be searched
  //    for in the range [1D-300,1D300].
  //
  //    Output, int *STATUS, reports the status of the computation.
  //     0, if the calculation completed correctly;
  //    -I, if the input parameter number I is out of range;
  //    +1, if the answer appears to be lower than lowest search bound;
  //    +2, if the answer appears to be higher than greatest search bound;
  //    +3, if P + Q /= 1;
  //    +4, if X + Y /= 1.
  //
  //    Output, double *BOUND, is only defined if STATUS is nonzero.
  //    If STATUS is negative, then this is the value exceeded by parameter I.
  //    if STATUS is 1 or 2, this is the search bound that was exceeded.
  //
  {
# define tol (1.0e-8)
# define atol (1.0e-50)
# define zero (1.0e-300)
# define inf 1.0e300
# define one 1.0e0

    static int K1 = 1;
    static double K2 = 0.0e0;
    static double K3 = 1.0e0;
    static double K8 = 0.5e0;
    static double K9 = 5.0e0;
    static double fx, xhi, xlo, cum, ccum, xy, pq;
    static unsigned long qhi, qleft, qporq;
    static double T4, T5, T6, T7, T10, T11, T12, T13, T14, T15;
    //
    //     Check arguments
    //
    if(!(*which < 1 || *which > 4)) goto S30;
    if(!(*which < 1)) goto S10;
    *bound = 1.0e0;
    goto S20;
  S10:
    *bound = 4.0e0;
  S20:
    *status = -1;
    return;
  S30:
    if(*which == 1) goto S70;
    //
    //     P
    //
    if(!(*p < 0.0e0 || *p > 1.0e0)) goto S60;
    if(!(*p < 0.0e0)) goto S40;
    *bound = 0.0e0;
    goto S50;
  S40:
    *bound = 1.0e0;
  S50:
    *status = -2;
    return;
  S70:
  S60:
    if(*which == 1) goto S110;
    //
    //     Q
    //
    if(!(*q < 0.0e0 || *q > 1.0e0)) goto S100;
    if(!(*q < 0.0e0)) goto S80;
    *bound = 0.0e0;
    goto S90;
  S80:
    *bound = 1.0e0;
  S90:
    *status = -3;
    return;
  S110:
  S100:
    if(*which == 2) goto S150;
    //
    //     X
    //
    if(!(*x < 0.0e0 || *x > 1.0e0)) goto S140;
    if(!(*x < 0.0e0)) goto S120;
    *bound = 0.0e0;
    goto S130;
  S120:
    *bound = 1.0e0;
  S130:
    *status = -4;
    return;
  S150:
  S140:
    if(*which == 2) goto S190;
    //
    //     Y
    //
    if(!(*y < 0.0e0 || *y > 1.0e0)) goto S180;
    if(!(*y < 0.0e0)) goto S160;
    *bound = 0.0e0;
    goto S170;
  S160:
    *bound = 1.0e0;
  S170:
    *status = -5;
    return;
  S190:
  S180:
    if(*which == 3) goto S210;
    //
    //     A
    //
    if(!(*a <= 0.0e0)) goto S200;
    *bound = 0.0e0;
    *status = -6;
    return;
  S210:
  S200:
    if(*which == 4) goto S230;
    //
    //     B
    //
    if(!(*b <= 0.0e0)) goto S220;
    *bound = 0.0e0;
    *status = -7;
    return;
  S230:
  S220:
    if(*which == 1) goto S270;
    //
    //     P + Q
    //
    pq = *p + *q;
    if(!(fabs(pq - 0.5e0 - 0.5e0) > 3.0e0 * dpmpar ( &K1 ) ) ) goto S260;
    if(!(pq < 0.0e0)) goto S240;
    *bound = 0.0e0;
    goto S250;
  S240:
    *bound = 1.0e0;
  S250:
    *status = 3;
    return;
  S270:
  S260:
    if(*which == 2) goto S310;
    //
    //     X + Y
    //
    xy = *x + *y;
    if(!(fabs(xy - 0.5e0 - 0.5e0) > 3.0e0 * dpmpar ( &K1 ) ) ) goto S300;
    if(!(xy < 0.0e0)) goto S280;
    *bound = 0.0e0;
    goto S290;
  S280:
    *bound = 1.0e0;
  S290:
    *status = 4;
    return;
  S310:
  S300:
    if(!(*which == 1)) qporq = *p <= *q;
    //
    //     Select the minimum of P or Q
    //     Calculate ANSWERS
    //
    if(1 == *which)
      {
        //
        //     Calculating P and Q
        //
        cumbet(x, y, a, b, p, q);
        *status = 0;
      }
    else if(2 == *which)
      {
        //
        //     Calculating X and Y
        //
        T4 = atol;
        T5 = tol;
        dstzr(&K2, &K3, &T4, &T5);
        if(!qporq) goto S340;
        *status = 0;
        dzror(status, x, &fx, &xlo, &xhi, &qleft, &qhi);
        *y = one - *x;
      S320:
        if(!(*status == 1)) goto S330;
        cumbet(x, y, a, b, &cum, &ccum);
        fx = cum - *p;
        dzror(status, x, &fx, &xlo, &xhi, &qleft, &qhi);
        *y = one - *x;
        goto S320;
      S330:
        goto S370;
      S340:
        *status = 0;
        dzror(status, y, &fx, &xlo, &xhi, &qleft, &qhi);
        *x = one - *y;
      S350:
        if(!(*status == 1)) goto S360;
        cumbet(x, y, a, b, &cum, &ccum);
        fx = ccum - *q;
        dzror(status, y, &fx, &xlo, &xhi, &qleft, &qhi);
        *x = one - *y;
        goto S350;
      S370:
      S360:
        if(!(*status == -1)) goto S400;
        if(!qleft) goto S380;
        *status = 1;
        *bound = 0.0e0;
        goto S390;
      S380:
        *status = 2;
        *bound = 1.0e0;
      S400:
      S390:
        ;
      }
    else if(3 == *which)
      {
        //
        //     Computing A
        //
        *a = 5.0e0;
        T6 = zero;
        T7 = inf;
        T10 = atol;
        T11 = tol;
        dstinv(&T6, &T7, &K8, &K8, &K9, &T10, &T11);
        *status = 0;
        dinvr(status, a, &fx, &qleft, &qhi);
      S410:
        if(!(*status == 1)) goto S440;
        cumbet(x, y, a, b, &cum, &ccum);
        if(!qporq) goto S420;
        fx = cum - *p;
        goto S430;
      S420:
        fx = ccum - *q;
      S430:
        dinvr(status, a, &fx, &qleft, &qhi);
        goto S410;
      S440:
        if(!(*status == -1)) goto S470;
        if(!qleft) goto S450;
        *status = 1;
        *bound = zero;
        goto S460;
      S450:
        *status = 2;
        *bound = inf;
      S470:
      S460:
        ;
      }
    else if(4 == *which)
      {
        //
        //     Computing B
        //
        *b = 5.0e0;
        T12 = zero;
        T13 = inf;
        T14 = atol;
        T15 = tol;
        dstinv(&T12, &T13, &K8, &K8, &K9, &T14, &T15);
        *status = 0;
        dinvr(status, b, &fx, &qleft, &qhi);
      S480:
        if(!(*status == 1)) goto S510;
        cumbet(x, y, a, b, &cum, &ccum);
        if(!qporq) goto S490;
        fx = cum - *p;
        goto S500;
      S490:
        fx = ccum - *q;
      S500:
        dinvr(status, b, &fx, &qleft, &qhi);
        goto S480;
      S510:
        if(!(*status == -1)) goto S540;
        if(!qleft) goto S520;
        *status = 1;
        *bound = zero;
        goto S530;
      S520:
        *status = 2;
        *bound = inf;
      S530:
        ;
      }
  S540:
    return;
# undef tol
# undef atol
# undef zero
# undef inf
# undef one
  }
  //****************************************************************************

  void cdfbin ( int *which, double *p, double *q, double *s, double *xn,
                double *pr, double *ompr, int *status, double *bound )

  //****************************************************************************
  //
  //  Purpose:
  //
  //    CDFBIN evaluates the CDF of the Binomial distribution.
  //
  //  Discussion:
  //
  //    This routine calculates any one parameter of the binomial distribution
  //    given the others.
  //
  //    The value P of the cumulative distribution function is calculated
  //    directly.
  //
  //    Computation of the other parameters involves a seach for a value that
  //    produces the desired value of P.  The search relies on the
  //    monotonicity of P with respect to the other parameters.
  //
  //    P is the probablility of S or fewer successes in XN binomial trials,
  //    each trial having an individual probability of success of PR.
  //
  //  Modified:
  //
  //    09 June 2004
  //
  //  Reference:
  //
  //    Milton Abramowitz and Irene Stegun,
  //    Handbook of Mathematical Functions
  //    1966, Formula 26.5.24.
  //
  //  Parameters:
  //
  //    Input, int *WHICH, indicates which of argument values is to
  //    be calculated from the others.
  //    1: Calculate P and Q from S, XN, PR and OMPR;
  //    2: Calculate S from P, Q, XN, PR and OMPR;
  //    3: Calculate XN from P, Q, S, PR and OMPR;
  //    4: Calculate PR and OMPR from P, Q, S and XN.
  //
  //    Input/output, double *P, the cumulation, from 0 to S,
  //    of the binomial distribution.  If P is an input value, it should
  //    lie in the range [0,1].
  //
  //    Input/output, double *Q, equal to 1-P.  If Q is an input
  //    value, it should lie in the range [0,1].  If Q is an output value,
  //    it will lie in the range [0,1].
  //
  //    Input/output, double *S, the number of successes observed.
  //    Whether this is an input or output value, it should lie in the
  //    range [0,XN].
  //
  //    Input/output, double *XN, the number of binomial trials.
  //    If this is an input value it should lie in the range: (0, +infinity).
  //    If it is an output value it will be searched for in the
  //    range [1.0D-300, 1.0D+300].
  //
  //    Input/output, double *PR, the probability of success in each
  //    binomial trial.  Whether this is an input or output value, it should
  //    lie in the range: [0,1].
  //
  //    Input/output, double *OMPR, equal to 1-PR.  Whether this is an
  //    input or output value, it should lie in the range [0,1].  Also, it should
  //    be the case that PR + OMPR = 1.
  //
  //    Output, int *STATUS, reports the status of the computation.
  //     0, if the calculation completed correctly;
  //    -I, if the input parameter number I is out of range;
  //    +1, if the answer appears to be lower than lowest search bound;
  //    +2, if the answer appears to be higher than greatest search bound;
  //    +3, if P + Q /= 1;
  //    +4, if PR + OMPR /= 1.
  //
  //    Output, double *BOUND, is only defined if STATUS is nonzero.
  //    If STATUS is negative, then this is the value exceeded by parameter I.
  //    if STATUS is 1 or 2, this is the search bound that was exceeded.
  //
  {
# define atol (1.0e-50)
# define tol (1.0e-8)
# define zero (1.0e-300)
# define inf 1.0e300
# define one 1.0e0

    static int K1 = 1;
    static double K2 = 0.0e0;
    static double K3 = 0.5e0;
    static double K4 = 5.0e0;
    static double K11 = 1.0e0;
    static double fx, xhi, xlo, cum, ccum, pq, prompr;
    static unsigned long qhi, qleft, qporq;
    static double T5, T6, T7, T8, T9, T10, T12, T13;

    //
    //     Check arguments
    //
    if(!(*which < 1 && *which > 4)) goto S30;
    if(!(*which < 1)) goto S10;
    *bound = 1.0e0;
    goto S20;
  S10:
    *bound = 4.0e0;
  S20:
    *status = -1;
    return;
  S30:
    if(*which == 1) goto S70;
    //
    //     P
    //
    if(!(*p < 0.0e0 || *p > 1.0e0)) goto S60;
    if(!(*p < 0.0e0)) goto S40;
    *bound = 0.0e0;
    goto S50;
  S40:
    *bound = 1.0e0;
  S50:
    *status = -2;
    return;
  S70:
  S60:
    if(*which == 1) goto S110;
    //
    //     Q
    //
    if(!(*q < 0.0e0 || *q > 1.0e0)) goto S100;
    if(!(*q < 0.0e0)) goto S80;
    *bound = 0.0e0;
    goto S90;
  S80:
    *bound = 1.0e0;
  S90:
    *status = -3;
    return;
  S110:
  S100:
    if(*which == 3) goto S130;
    //
    //     XN
    //
    if(!(*xn <= 0.0e0)) goto S120;
    *bound = 0.0e0;
    *status = -5;
    return;
  S130:
  S120:
    if(*which == 2) goto S170;
    //
    //     S
    //
    if(!((*s < 0.0e0 || *which != 3) && (*s > *xn))) goto S160;
    if(!(*s < 0.0e0)) goto S140;
    *bound = 0.0e0;
    goto S150;
  S140:
    *bound = *xn;
  S150:
    *status = -4;
    return;
  S170:
  S160:
    if(*which == 4) goto S210;
    //
    //     PR
    //
    if(!(*pr < 0.0e0 || *pr > 1.0e0)) goto S200;
    if(!(*pr < 0.0e0)) goto S180;
    *bound = 0.0e0;
    goto S190;
  S180:
    *bound = 1.0e0;
  S190:
    *status = -6;
    return;
  S210:
  S200:
    if(*which == 4) goto S250;
    //
    //     OMPR
    //
    if(!(*ompr < 0.0e0 || *ompr > 1.0e0)) goto S240;
    if(!(*ompr < 0.0e0)) goto S220;
    *bound = 0.0e0;
    goto S230;
  S220:
    *bound = 1.0e0;
  S230:
    *status = -7;
    return;
  S250:
  S240:
    if(*which == 1) goto S290;
    //
    //     P + Q
    //
    pq = *p + *q;
    if(!(fabs(pq - 0.5e0 - 0.5e0) > 3.0e0 * dpmpar ( &K1 ) ) ) goto S280;
    if(!(pq < 0.0e0)) goto S260;
    *bound = 0.0e0;
    goto S270;
  S260:
    *bound = 1.0e0;
  S270:
    *status = 3;
    return;
  S290:
  S280:
    if(*which == 4) goto S330;
    //
    //     PR + OMPR
    //
    prompr = *pr + *ompr;
    if(!(fabs(prompr - 0.5e0 - 0.5e0) > 3.0e0 * dpmpar ( &K1 ) ) ) goto S320;
    if(!(prompr < 0.0e0)) goto S300;
    *bound = 0.0e0;
    goto S310;
  S300:
    *bound = 1.0e0;
  S310:
    *status = 4;
    return;
  S330:
  S320:
    if(!(*which == 1)) qporq = *p <= *q;
    //
    //     Select the minimum of P or Q
    //     Calculate ANSWERS
    //
    if(1 == *which)
      {
        //
        //     Calculating P
        //
        cumbin(s, xn, pr, ompr, p, q);
        *status = 0;
      }
    else if(2 == *which)
      {
        //
        //     Calculating S
        //
        *s = 5.0e0;
        T5 = atol;
        T6 = tol;
        dstinv(&K2, xn, &K3, &K3, &K4, &T5, &T6);
        *status = 0;
        dinvr(status, s, &fx, &qleft, &qhi);
      S340:
        if(!(*status == 1)) goto S370;
        cumbin(s, xn, pr, ompr, &cum, &ccum);
        if(!qporq) goto S350;
        fx = cum - *p;
        goto S360;
      S350:
        fx = ccum - *q;
      S360:
        dinvr(status, s, &fx, &qleft, &qhi);
        goto S340;
      S370:
        if(!(*status == -1)) goto S400;
        if(!qleft) goto S380;
        *status = 1;
        *bound = 0.0e0;
        goto S390;
      S380:
        *status = 2;
        *bound = *xn;
      S400:
      S390:
        ;
      }
    else if(3 == *which)
      {
        //
        //     Calculating XN
        //
        *xn = 5.0e0;
        T7 = zero;
        T8 = inf;
        T9 = atol;
        T10 = tol;
        dstinv(&T7, &T8, &K3, &K3, &K4, &T9, &T10);
        *status = 0;
        dinvr(status, xn, &fx, &qleft, &qhi);
      S410:
        if(!(*status == 1)) goto S440;
        cumbin(s, xn, pr, ompr, &cum, &ccum);
        if(!qporq) goto S420;
        fx = cum - *p;
        goto S430;
      S420:
        fx = ccum - *q;
      S430:
        dinvr(status, xn, &fx, &qleft, &qhi);
        goto S410;
      S440:
        if(!(*status == -1)) goto S470;
        if(!qleft) goto S450;
        *status = 1;
        *bound = zero;
        goto S460;
      S450:
        *status = 2;
        *bound = inf;
      S470:
      S460:
        ;
      }
    else if(4 == *which)
      {
        //
        //     Calculating PR and OMPR
        //
        T12 = atol;
        T13 = tol;
        dstzr(&K2, &K11, &T12, &T13);
        if(!qporq) goto S500;
        *status = 0;
        dzror(status, pr, &fx, &xlo, &xhi, &qleft, &qhi);
        *ompr = one - *pr;
      S480:
        if(!(*status == 1)) goto S490;
        cumbin(s, xn, pr, ompr, &cum, &ccum);
        fx = cum - *p;
        dzror(status, pr, &fx, &xlo, &xhi, &qleft, &qhi);
        *ompr = one - *pr;
        goto S480;
      S490:
        goto S530;
      S500:
        *status = 0;
        dzror(status, ompr, &fx, &xlo, &xhi, &qleft, &qhi);
        *pr = one - *ompr;
      S510:
        if(!(*status == 1)) goto S520;
        cumbin(s, xn, pr, ompr, &cum, &ccum);
        fx = ccum - *q;
        dzror(status, ompr, &fx, &xlo, &xhi, &qleft, &qhi);
        *pr = one - *ompr;
        goto S510;
      S530:
      S520:
        if(!(*status == -1)) goto S560;
        if(!qleft) goto S540;
        *status = 1;
        *bound = 0.0e0;
        goto S550;
      S540:
        *status = 2;
        *bound = 1.0e0;
      S550:
        ;
      }
  S560:
    return;
# undef atol
# undef tol
# undef zero
# undef inf
# undef one
  }
  //****************************************************************************

  void cdfchi ( int *which, double *p, double *q, double *x, double *df,
                int *status, double *bound )

  //****************************************************************************
  //
  //  Purpose:
  //
  //    CDFCHI evaluates the CDF of the chi square distribution.
  //
  //  Discussion:
  //
  //    This routine calculates any one parameter of the chi square distribution
  //    given the others.
  //
  //    The value P of the cumulative distribution function is calculated
  //    directly.
  //
  //    Computation of the other parameters involves a seach for a value that
  //    produces the desired value of P.  The search relies on the
  //    monotonicity of P with respect to the other parameters.
  //
  //    The CDF of the chi square distribution can be evaluated
  //    within Mathematica by commands such as:
  //
  //      Needs["Statistics`ContinuousDistributions`"]
  //      CDF [ ChiSquareDistribution [ DF ], X ]
  //
  //  Reference:
  //
  //    Milton Abramowitz and Irene Stegun,
  //    Handbook of Mathematical Functions
  //    1966, Formula 26.4.19.
  //
  //    Stephen Wolfram,
  //    The Mathematica Book,
  //    Fourth Edition,
  //    Wolfram Media / Cambridge University Press, 1999.
  //
  //  Parameters:
  //
  //    Input, int *WHICH, indicates which argument is to be calculated
  //    from the others.
  //    1: Calculate P and Q from X and DF;
  //    2: Calculate X from P, Q and DF;
  //    3: Calculate DF from P, Q and X.
  //
  //    Input/output, double *P, the integral from 0 to X of
  //    the chi-square distribution.  If this is an input value, it should
  //    lie in the range [0,1].
  //
  //    Input/output, double *Q, equal to 1-P.  If Q is an input
  //    value, it should lie in the range [0,1].  If Q is an output value,
  //    it will lie in the range [0,1].
  //
  //    Input/output, double *X, the upper limit of integration
  //    of the chi-square distribution.  If this is an input
  //    value, it should lie in the range: [0, +infinity).  If it is an output
  //    value, it will be searched for in the range: [0,1.0D+300].
  //
  //    Input/output, double *DF, the degrees of freedom of the
  //    chi-square distribution.  If this is an input value, it should lie
  //    in the range: (0, +infinity).  If it is an output value, it will be
  //    searched for in the range: [ 1.0D-300, 1.0D+300].
  //
  //    Output, int *STATUS, reports the status of the computation.
  //     0, if the calculation completed correctly;
  //    -I, if the input parameter number I is out of range;
  //    +1, if the answer appears to be lower than lowest search bound;
  //    +2, if the answer appears to be higher than greatest search bound;
  //    +3, if P + Q /= 1;
  //    +10, an error was returned from CUMGAM.
  //
  //    Output, double *BOUND, is only defined if STATUS is nonzero.
  //    If STATUS is negative, then this is the value exceeded by parameter I.
  //    if STATUS is 1 or 2, this is the search bound that was exceeded.
  //
  {
# define tol (1.0e-8)
# define atol (1.0e-50)
# define zero (1.0e-300)
# define inf 1.0e300

    static int K1 = 1;
    static double K2 = 0.0e0;
    static double K4 = 0.5e0;
    static double K5 = 5.0e0;
    static double fx, cum, ccum, pq, porq;
    static unsigned long qhi, qleft, qporq;
    static double T3, T6, T7, T8, T9, T10, T11;

    //
    //     Check arguments
    //
    if(!(*which < 1 || *which > 3)) goto S30;
    if(!(*which < 1)) goto S10;
    *bound = 1.0e0;
    goto S20;
  S10:
    *bound = 3.0e0;
  S20:
    *status = -1;
    return;
  S30:
    if(*which == 1) goto S70;
    //
    //     P
    //
    if(!(*p < 0.0e0 || *p > 1.0e0)) goto S60;
    if(!(*p < 0.0e0)) goto S40;
    *bound = 0.0e0;
    goto S50;
  S40:
    *bound = 1.0e0;
  S50:
    *status = -2;
    return;
  S70:
  S60:
    if(*which == 1) goto S110;
    //
    //     Q
    //
    if(!(*q <= 0.0e0 || *q > 1.0e0)) goto S100;
    if(!(*q <= 0.0e0)) goto S80;
    *bound = 0.0e0;
    goto S90;
  S80:
    *bound = 1.0e0;
  S90:
    *status = -3;
    return;
  S110:
  S100:
    if(*which == 2) goto S130;
    //
    //     X
    //
    if(!(*x < 0.0e0)) goto S120;
    *bound = 0.0e0;
    *status = -4;
    return;
  S130:
  S120:
    if(*which == 3) goto S150;
    //
    //     DF
    //
    if(!(*df <= 0.0e0)) goto S140;
    *bound = 0.0e0;
    *status = -5;
    return;
  S150:
  S140:
    if(*which == 1) goto S190;
    //
    //     P + Q
    //
    pq = *p + *q;
    if(!(fabs(pq - 0.5e0 - 0.5e0) > 3.0e0 * dpmpar ( &K1 ) ) ) goto S180;
    if(!(pq < 0.0e0)) goto S160;
    *bound = 0.0e0;
    goto S170;
  S160:
    *bound = 1.0e0;
  S170:
    *status = 3;
    return;
  S190:
  S180:
    if(*which == 1) goto S220;
    //
    //     Select the minimum of P or Q
    //
    qporq = *p <= *q;
    if(!qporq) goto S200;
    porq = *p;
    goto S210;
  S200:
    porq = *q;
  S220:
  S210:
    //
    //     Calculate ANSWERS
    //
    if(1 == *which)
      {
        //
        //     Calculating P and Q
        //
        *status = 0;
        cumchi(x, df, p, q);
        if(porq > 1.5e0)
          {
            *status = 10;
            return;
          }
      }
    else if(2 == *which)
      {
        //
        //     Calculating X
        //
        *x = 5.0e0;
        T3 = inf;
        T6 = atol;
        T7 = tol;
        dstinv(&K2, &T3, &K4, &K4, &K5, &T6, &T7);
        *status = 0;
        dinvr(status, x, &fx, &qleft, &qhi);
      S230:
        if(!(*status == 1)) goto S270;
        cumchi(x, df, &cum, &ccum);
        if(!qporq) goto S240;
        fx = cum - *p;
        goto S250;
      S240:
        fx = ccum - *q;
      S250:
        if(!(fx + porq > 1.5e0)) goto S260;
        *status = 10;
        return;
      S260:
        dinvr(status, x, &fx, &qleft, &qhi);
        goto S230;
      S270:
        if(!(*status == -1)) goto S300;
        if(!qleft) goto S280;
        *status = 1;
        *bound = 0.0e0;
        goto S290;
      S280:
        *status = 2;
        *bound = inf;
      S300:
      S290:
        ;
      }
    else if(3 == *which)
      {
        //
        //  Calculating DF
        //
        *df = 5.0e0;
        T8 = zero;
        T9 = inf;
        T10 = atol;
        T11 = tol;
        dstinv(&T8, &T9, &K4, &K4, &K5, &T10, &T11);
        *status = 0;
        dinvr(status, df, &fx, &qleft, &qhi);
      S310:
        if(!(*status == 1)) goto S350;
        cumchi(x, df, &cum, &ccum);
        if(!qporq) goto S320;
        fx = cum - *p;
        goto S330;
      S320:
        fx = ccum - *q;
      S330:
        if(!(fx + porq > 1.5e0)) goto S340;
        *status = 10;
        return;
      S340:
        dinvr(status, df, &fx, &qleft, &qhi);
        goto S310;
      S350:
        if(!(*status == -1)) goto S380;
        if(!qleft) goto S360;
        *status = 1;
        *bound = zero;
        goto S370;
      S360:
        *status = 2;
        *bound = inf;
      S370:
        ;
      }
  S380:
    return;
# undef tol
# undef atol
# undef zero
# undef inf
  }
  //****************************************************************************

  void cdfchn ( int *which, double *p, double *q, double *x, double *df,
                double *pnonc, int *status, double *bound )

  //****************************************************************************
  //
  //  Purpose:
  //
  //    CDFCHN evaluates the CDF of the Noncentral Chi-Square.
  //
  //  Discussion:
  //
  //    This routine calculates any one parameter of the noncentral chi-square
  //    distribution given values for the others.
  //
  //    The value P of the cumulative distribution function is calculated
  //    directly.
  //
  //    Computation of the other parameters involves a seach for a value that
  //    produces the desired value of P.  The search relies on the
  //    monotonicity of P with respect to the other parameters.
  //
  //    The computation time required for this routine is proportional
  //    to the noncentrality parameter (PNONC).  Very large values of
  //    this parameter can consume immense computer resources.  This is
  //    why the search range is bounded by 10,000.
  //
  //    The CDF of the noncentral chi square distribution can be evaluated
  //    within Mathematica by commands such as:
  //
  //      Needs["Statistics`ContinuousDistributions`"]
  //      CDF[ NoncentralChiSquareDistribution [ DF, LAMBDA ], X ]
  //
  //  Reference:
  //
  //    Milton Abramowitz and Irene Stegun,
  //    Handbook of Mathematical Functions
  //    1966, Formula 26.5.25.
  //
  //    Stephen Wolfram,
  //    The Mathematica Book,
  //    Fourth Edition,
  //    Wolfram Media / Cambridge University Press, 1999.
  //
  //  Parameters:
  //
  //    Input, int *WHICH, indicates which argument is to be calculated
  //    from the others.
  //    1: Calculate P and Q from X, DF and PNONC;
  //    2: Calculate X from P, DF and PNONC;
  //    3: Calculate DF from P, X and PNONC;
  //    4: Calculate PNONC from P, X and DF.
  //
  //    Input/output, double *P, the integral from 0 to X of
  //    the noncentral chi-square distribution.  If this is an input
  //    value, it should lie in the range: [0, 1.0-1.0D-16).
  //
  //    Input/output, double *Q, is generally not used by this
  //    subroutine and is only included for similarity with other routines.
  //    However, if P is to be computed, then a value will also be computed
  //    for Q.
  //
  //    Input, double *X, the upper limit of integration of the
  //    noncentral chi-square distribution.  If this is an input value, it
  //    should lie in the range: [0, +infinity).  If it is an output value,
  //    it will be sought in the range: [0,1.0D+300].
  //
  //    Input/output, double *DF, the number of degrees of freedom
  //    of the noncentral chi-square distribution.  If this is an input value,
  //    it should lie in the range: (0, +infinity).  If it is an output value,
  //    it will be searched for in the range: [ 1.0D-300, 1.0D+300].
  //
  //    Input/output, double *PNONC, the noncentrality parameter of
  //    the noncentral chi-square distribution.  If this is an input value, it
  //    should lie in the range: [0, +infinity).  If it is an output value,
  //    it will be searched for in the range: [0,1.0D+4]
  //
  //    Output, int *STATUS, reports on the calculation.
  //    0, if calculation completed correctly;
  //    -I, if input parameter number I is out of range;
  //    1, if the answer appears to be lower than the lowest search bound;
  //    2, if the answer appears to be higher than the greatest search bound.
  //
  //    Output, double *BOUND, is only defined if STATUS is nonzero.
  //    If STATUS is negative, then this is the value exceeded by parameter I.
  //    if STATUS is 1 or 2, this is the search bound that was exceeded.
  //
  {
# define tent4 1.0e4
# define tol (1.0e-8)
# define atol (1.0e-50)
# define zero (1.0e-300)
# define one (1.0e0-1.0e-16)
# define inf 1.0e300

    static double K1 = 0.0e0;
    static double K3 = 0.5e0;
    static double K4 = 5.0e0;
    static double fx, cum, ccum;
    static unsigned long qhi, qleft;
    static double T2, T5, T6, T7, T8, T9, T10, T11, T12, T13;

    //
    //     Check arguments
    //
    if(!(*which < 1 || *which > 4)) goto S30;
    if(!(*which < 1)) goto S10;
    *bound = 1.0e0;
    goto S20;
  S10:
    *bound = 4.0e0;
  S20:
    *status = -1;
    return;
  S30:
    if(*which == 1) goto S70;
    //
    //     P
    //
    if(!(*p < 0.0e0 || *p > one)) goto S60;
    if(!(*p < 0.0e0)) goto S40;
    *bound = 0.0e0;
    goto S50;
  S40:
    *bound = one;
  S50:
    *status = -2;
    return;
  S70:
  S60:
    if(*which == 2) goto S90;
    //
    //     X
    //
    if(!(*x < 0.0e0)) goto S80;
    *bound = 0.0e0;
    *status = -4;
    return;
  S90:
  S80:
    if(*which == 3) goto S110;
    //
    //     DF
    //
    if(!(*df <= 0.0e0)) goto S100;
    *bound = 0.0e0;
    *status = -5;
    return;
  S110:
  S100:
    if(*which == 4) goto S130;
    //
    //     PNONC
    //
    if(!(*pnonc < 0.0e0)) goto S120;
    *bound = 0.0e0;
    *status = -6;
    return;
  S130:
  S120:
    //
    //     Calculate ANSWERS
    //
    if(1 == *which)
      {
        //
        //     Calculating P and Q
        //
        cumchn(x, df, pnonc, p, q);
        *status = 0;
      }
    else if(2 == *which)
      {
        //
        //     Calculating X
        //
        *x = 5.0e0;
        T2 = inf;
        T5 = atol;
        T6 = tol;
        dstinv(&K1, &T2, &K3, &K3, &K4, &T5, &T6);
        *status = 0;
        dinvr(status, x, &fx, &qleft, &qhi);
      S140:
        if(!(*status == 1)) goto S150;
        cumchn(x, df, pnonc, &cum, &ccum);
        fx = cum - *p;
        dinvr(status, x, &fx, &qleft, &qhi);
        goto S140;
      S150:
        if(!(*status == -1)) goto S180;
        if(!qleft) goto S160;
        *status = 1;
        *bound = 0.0e0;
        goto S170;
      S160:
        *status = 2;
        *bound = inf;
      S180:
      S170:
        ;
      }
    else if(3 == *which)
      {
        //
        //     Calculating DF
        //
        *df = 5.0e0;
        T7 = zero;
        T8 = inf;
        T9 = atol;
        T10 = tol;
        dstinv(&T7, &T8, &K3, &K3, &K4, &T9, &T10);
        *status = 0;
        dinvr(status, df, &fx, &qleft, &qhi);
      S190:
        if(!(*status == 1)) goto S200;
        cumchn(x, df, pnonc, &cum, &ccum);
        fx = cum - *p;
        dinvr(status, df, &fx, &qleft, &qhi);
        goto S190;
      S200:
        if(!(*status == -1)) goto S230;
        if(!qleft) goto S210;
        *status = 1;
        *bound = zero;
        goto S220;
      S210:
        *status = 2;
        *bound = inf;
      S230:
      S220:
        ;
      }
    else if(4 == *which)
      {
        //
        //     Calculating PNONC
        //
        *pnonc = 5.0e0;
        T11 = tent4;
        T12 = atol;
        T13 = tol;
        dstinv(&K1, &T11, &K3, &K3, &K4, &T12, &T13);
        *status = 0;
        dinvr(status, pnonc, &fx, &qleft, &qhi);
      S240:
        if(!(*status == 1)) goto S250;
        cumchn(x, df, pnonc, &cum, &ccum);
        fx = cum - *p;
        dinvr(status, pnonc, &fx, &qleft, &qhi);
        goto S240;
      S250:
        if(!(*status == -1)) goto S280;
        if(!qleft) goto S260;
        *status = 1;
        *bound = zero;
        goto S270;
      S260:
        *status = 2;
        *bound = tent4;
      S270:
        ;
      }
  S280:
    return;
# undef tent4
# undef tol
# undef atol
# undef zero
# undef one
# undef inf
  }
  //****************************************************************************

  void cdff ( int *which, double *p, double *q, double *f, double *dfn,
              double *dfd, int *status, double *bound )

  //****************************************************************************
  //
  //  Purpose:
  //
  //    CDFF evaluates the CDF of the F distribution.
  //
  //  Discussion:
  //
  //    This routine calculates any one parameter of the F distribution
  //    given the others.
  //
  //    The value P of the cumulative distribution function is calculated
  //    directly.
  //
  //    Computation of the other parameters involves a seach for a value that
  //    produces the desired value of P.  The search relies on the
  //    monotonicity of P with respect to the other parameters.
  //
  //    The value of the cumulative F distribution is not necessarily
  //    monotone in either degrees of freedom.  There thus may be two
  //    values that provide a given CDF value.  This routine assumes
  //    monotonicity and will find an arbitrary one of the two values.
  //
  //  Reference:
  //
  //    Milton Abramowitz and Irene Stegun,
  //    Handbook of Mathematical Functions
  //    1966, Formula 26.6.2.
  //
  //  Parameters:
  //
  //    Input, int *WHICH, indicates which argument is to be calculated
  //    from the others.
  //    1: Calculate P and Q from F, DFN and DFD;
  //    2: Calculate F from P, Q, DFN and DFD;
  //    3: Calculate DFN from P, Q, F and DFD;
  //    4: Calculate DFD from P, Q, F and DFN.
  //
  //    Input/output, double *P, the integral from 0 to F of
  //    the F-density.  If it is an input value, it should lie in the
  //    range [0,1].
  //
  //    Input/output, double *Q, equal to 1-P.  If Q is an input
  //    value, it should lie in the range [0,1].  If Q is an output value,
  //    it will lie in the range [0,1].
  //
  //    Input/output, double *F, the upper limit of integration
  //    of the F-density.  If this is an input value, it should lie in the
  //    range [0, +infinity).  If it is an output value, it will be searched
  //    for in the range [0,1.0D+300].
  //
  //    Input/output, double *DFN, the number of degrees of
  //    freedom of the numerator sum of squares.  If this is an input value,
  //    it should lie in the range: (0, +infinity).  If it is an output value,
  //    it will be searched for in the range: [ 1.0D-300, 1.0D+300].
  //
  //    Input/output, double *DFD, the number of degrees of freedom
  //    of the denominator sum of squares.  If this is an input value, it should
  //    lie in the range: (0, +infinity).  If it is an output value, it will
  //    be searched for in the  range: [ 1.0D-300, 1.0D+300].
  //
  //    Output, int *STATUS, reports the status of the computation.
  //     0, if the calculation completed correctly;
  //    -I, if the input parameter number I is out of range;
  //    +1, if the answer appears to be lower than lowest search bound;
  //    +2, if the answer appears to be higher than greatest search bound;
  //    +3, if P + Q /= 1.
  //
  //    Output, double *BOUND, is only defined if STATUS is nonzero.
  //    If STATUS is negative, then this is the value exceeded by parameter I.
  //    if STATUS is 1 or 2, this is the search bound that was exceeded.
  //
  {
# define tol (1.0e-8)
# define atol (1.0e-50)
# define zero (1.0e-300)
# define inf 1.0e300

    static int K1 = 1;
    static double K2 = 0.0e0;
    static double K4 = 0.5e0;
    static double K5 = 5.0e0;
    static double pq, fx, cum, ccum;
    static unsigned long qhi, qleft, qporq;
    static double T3, T6, T7, T8, T9, T10, T11, T12, T13, T14, T15;

    //
    //     Check arguments
    //
    if(!(*which < 1 || *which > 4)) goto S30;
    if(!(*which < 1)) goto S10;
    *bound = 1.0e0;
    goto S20;
  S10:
    *bound = 4.0e0;
  S20:
    *status = -1;
    return;
  S30:
    if(*which == 1) goto S70;
    //
    //     P
    //
    if(!(*p < 0.0e0 || *p > 1.0e0)) goto S60;
    if(!(*p < 0.0e0)) goto S40;
    *bound = 0.0e0;
    goto S50;
  S40:
    *bound = 1.0e0;
  S50:
    *status = -2;
    return;
  S70:
  S60:
    if(*which == 1) goto S110;
    //
    //     Q
    //
    if(!(*q <= 0.0e0 || *q > 1.0e0)) goto S100;
    if(!(*q <= 0.0e0)) goto S80;
    *bound = 0.0e0;
    goto S90;
  S80:
    *bound = 1.0e0;
  S90:
    *status = -3;
    return;
  S110:
  S100:
    if(*which == 2) goto S130;
    //
    //     F
    //
    if(!(*f < 0.0e0)) goto S120;
    *bound = 0.0e0;
    *status = -4;
    return;
  S130:
  S120:
    if(*which == 3) goto S150;
    //
    //     DFN
    //
    if(!(*dfn <= 0.0e0)) goto S140;
    *bound = 0.0e0;
    *status = -5;
    return;
  S150:
  S140:
    if(*which == 4) goto S170;
    //
    //     DFD
    //
    if(!(*dfd <= 0.0e0)) goto S160;
    *bound = 0.0e0;
    *status = -6;
    return;
  S170:
  S160:
    if(*which == 1) goto S210;
    //
    //     P + Q
    //
    pq = *p + *q;
    if(!(fabs(pq - 0.5e0 - 0.5e0) > 3.0e0 * dpmpar ( &K1 ) ) ) goto S200;
    if(!(pq < 0.0e0)) goto S180;
    *bound = 0.0e0;
    goto S190;
  S180:
    *bound = 1.0e0;
  S190:
    *status = 3;
    return;
  S210:
  S200:
    if(!(*which == 1)) qporq = *p <= *q;
    //
    //     Select the minimum of P or Q
    //     Calculate ANSWERS
    //
    if(1 == *which)
      {
        //
        //     Calculating P
        //
        cumf(f, dfn, dfd, p, q);
        *status = 0;
      }
    else if(2 == *which)
      {
        //
        //     Calculating F
        //
        *f = 5.0e0;
        T3 = inf;
        T6 = atol;
        T7 = tol;
        dstinv(&K2, &T3, &K4, &K4, &K5, &T6, &T7);
        *status = 0;
        dinvr(status, f, &fx, &qleft, &qhi);
      S220:
        if(!(*status == 1)) goto S250;
        cumf(f, dfn, dfd, &cum, &ccum);
        if(!qporq) goto S230;
        fx = cum - *p;
        goto S240;
      S230:
        fx = ccum - *q;
      S240:
        dinvr(status, f, &fx, &qleft, &qhi);
        goto S220;
      S250:
        if(!(*status == -1)) goto S280;
        if(!qleft) goto S260;
        *status = 1;
        *bound = 0.0e0;
        goto S270;
      S260:
        *status = 2;
        *bound = inf;
      S280:
      S270:
        ;
      }
    else if(3 == *which)
      {
        //
        //     Calculating DFN
        //
        *dfn = 5.0e0;
        T8 = zero;
        T9 = inf;
        T10 = atol;
        T11 = tol;
        dstinv(&T8, &T9, &K4, &K4, &K5, &T10, &T11);
        *status = 0;
        dinvr(status, dfn, &fx, &qleft, &qhi);
      S290:
        if(!(*status == 1)) goto S320;
        cumf(f, dfn, dfd, &cum, &ccum);
        if(!qporq) goto S300;
        fx = cum - *p;
        goto S310;
      S300:
        fx = ccum - *q;
      S310:
        dinvr(status, dfn, &fx, &qleft, &qhi);
        goto S290;
      S320:
        if(!(*status == -1)) goto S350;
        if(!qleft) goto S330;
        *status = 1;
        *bound = zero;
        goto S340;
      S330:
        *status = 2;
        *bound = inf;
      S350:
      S340:
        ;
      }
    else if(4 == *which)
      {
        //
        //     Calculating DFD
        //
        *dfd = 5.0e0;
        T12 = zero;
        T13 = inf;
        T14 = atol;
        T15 = tol;
        dstinv(&T12, &T13, &K4, &K4, &K5, &T14, &T15);
        *status = 0;
        dinvr(status, dfd, &fx, &qleft, &qhi);
      S360:
        if(!(*status == 1)) goto S390;
        cumf(f, dfn, dfd, &cum, &ccum);
        if(!qporq) goto S370;
        fx = cum - *p;
        goto S380;
      S370:
        fx = ccum - *q;
      S380:
        dinvr(status, dfd, &fx, &qleft, &qhi);
        goto S360;
      S390:
        if(!(*status == -1)) goto S420;
        if(!qleft) goto S400;
        *status = 1;
        *bound = zero;
        goto S410;
      S400:
        *status = 2;
        *bound = inf;
      S410:
        ;
      }
  S420:
    return;
# undef tol
# undef atol
# undef zero
# undef inf
  }
  //****************************************************************************

  void cdffnc ( int *which, double *p, double *q, double *f, double *dfn,
                double *dfd, double *phonc, int *status, double *bound )

  //****************************************************************************
  //
  //  Purpose:
  //
  //    CDFFNC evaluates the CDF of the Noncentral F distribution.
  //
  //  Discussion:
  //
  //    This routine originally used 1.0E+300 as the upper bound for the
  //    interval in which many of the missing parameters are to be sought.
  //    Since the underlying rootfinder routine needs to evaluate the
  //    function at this point, it is no surprise that the program was
  //    experiencing overflows.  A less extravagant upper bound
  //    is being tried for now!
  //
  //
  //    This routine calculates any one parameter of the Noncentral F distribution
  //    given the others.
  //
  //    The value P of the cumulative distribution function is calculated
  //    directly.
  //
  //    Computation of the other parameters involves a seach for a value that
  //    produces the desired value of P.  The search relies on the
  //    monotonicity of P with respect to the other parameters.
  //
  //    The computation time required for this routine is proportional
  //    to the noncentrality parameter PNONC.  Very large values of
  //    this parameter can consume immense computer resources.  This is
  //    why the search range is bounded by 10,000.
  //
  //    The value of the cumulative noncentral F distribution is not
  //    necessarily monotone in either degree of freedom.  There thus
  //    may be two values that provide a given CDF value.  This routine
  //    assumes monotonicity and will find an arbitrary one of the two
  //    values.
  //
  //    The CDF of the noncentral F distribution can be evaluated
  //    within Mathematica by commands such as:
  //
  //      Needs["Statistics`ContinuousDistributions`"]
  //      CDF [ NoncentralFRatioDistribution [ DFN, DFD, PNONC ], X ]
  //
  //  Modified:
  //
  //    15 June 2004
  //
  //  Reference:
  //
  //    Milton Abramowitz and Irene Stegun,
  //    Handbook of Mathematical Functions
  //    1966, Formula 26.6.20.
  //
  //    Stephen Wolfram,
  //    The Mathematica Book,
  //    Fourth Edition,
  //    Wolfram Media / Cambridge University Press, 1999.
  //
  //  Parameters:
  //
  //    Input, int *WHICH, indicates which argument is to be calculated
  //    from the others.
  //    1: Calculate P and Q from F, DFN, DFD and PNONC;
  //    2: Calculate F from P, Q, DFN, DFD and PNONC;
  //    3: Calculate DFN from P, Q, F, DFD and PNONC;
  //    4: Calculate DFD from P, Q, F, DFN and PNONC;
  //    5: Calculate PNONC from P, Q, F, DFN and DFD.
  //
  //    Input/output, double *P, the integral from 0 to F of
  //    the noncentral F-density.  If P is an input value it should
  //    lie in the range [0,1) (Not including 1!).
  //
  //    Dummy, double *Q, is not used by this subroutine,
  //    and is only included for similarity with the other routines.
  //    Its input value is not checked.  If P is to be computed, the
  //    Q is set to 1 - P.
  //
  //    Input/output, double *F, the upper limit of integration
  //    of the noncentral F-density.  If this is an input value, it should
  //    lie in the range: [0, +infinity).  If it is an output value, it
  //    will be searched for in the range: [0,1.0D+30].
  //
  //    Input/output, double *DFN, the number of degrees of freedom
  //    of the numerator sum of squares.  If this is an input value, it should
  //    lie in the range: (0, +infinity).  If it is an output value, it will
  //    be searched for in the range: [ 1.0, 1.0D+30].
  //
  //    Input/output, double *DFD, the number of degrees of freedom
  //    of the denominator sum of squares.  If this is an input value, it should
  //    be in range: (0, +infinity).  If it is an output value, it will be
  //    searched for in the range [1.0, 1.0D+30].
  //
  //    Input/output, double *PNONC, the noncentrality parameter
  //    If this is an input value, it should be nonnegative.
  //    If it is an output value, it will be searched for in the range: [0,1.0D+4].
  //
  //    Output, int *STATUS, reports the status of the computation.
  //     0, if the calculation completed correctly;
  //    -I, if the input parameter number I is out of range;
  //    +1, if the answer appears to be lower than lowest search bound;
  //    +2, if the answer appears to be higher than greatest search bound;
  //    +3, if P + Q /= 1.
  //
  //    Output, double *BOUND, is only defined if STATUS is nonzero.
  //    If STATUS is negative, then this is the value exceeded by parameter I.
  //    if STATUS is 1 or 2, this is the search bound that was exceeded.
  //
  {
# define tent4 1.0e4
# define tol (1.0e-8)
# define atol (1.0e-50)
# define zero (1.0e-300)
# define one (1.0e0-1.0e-16)
# define inf 1.0e300

    static double K1 = 0.0e0;
    static double K3 = 0.5e0;
    static double K4 = 5.0e0;
    static double fx, cum, ccum;
    static unsigned long qhi, qleft;
    static double T2, T5, T6, T7, T8, T9, T10, T11, T12, T13, T14, T15, T16, T17;

    //
    //     Check arguments
    //
    if(!(*which < 1 || *which > 5)) goto S30;
    if(!(*which < 1)) goto S10;
    *bound = 1.0e0;
    goto S20;
  S10:
    *bound = 5.0e0;
  S20:
    *status = -1;
    return;
  S30:
    if(*which == 1) goto S70;
    //
    //     P
    //
    if(!(*p < 0.0e0 || *p > one)) goto S60;
    if(!(*p < 0.0e0)) goto S40;
    *bound = 0.0e0;
    goto S50;
  S40:
    *bound = one;
  S50:
    *status = -2;
    return;
  S70:
  S60:
    if(*which == 2) goto S90;
    //
    //     F
    //
    if(!(*f < 0.0e0)) goto S80;
    *bound = 0.0e0;
    *status = -4;
    return;
  S90:
  S80:
    if(*which == 3) goto S110;
    //
    //     DFN
    //
    if(!(*dfn <= 0.0e0)) goto S100;
    *bound = 0.0e0;
    *status = -5;
    return;
  S110:
  S100:
    if(*which == 4) goto S130;
    //
    //     DFD
    //
    if(!(*dfd <= 0.0e0)) goto S120;
    *bound = 0.0e0;
    *status = -6;
    return;
  S130:
  S120:
    if(*which == 5) goto S150;
    //
    //     PHONC
    //
    if(!(*phonc < 0.0e0)) goto S140;
    *bound = 0.0e0;
    *status = -7;
    return;
  S150:
  S140:
    //
    //     Calculate ANSWERS
    //
    if(1 == *which)
      {
        //
        //     Calculating P
        //
        cumfnc(f, dfn, dfd, phonc, p, q);
        *status = 0;
      }
    else if(2 == *which)
      {
        //
        //     Calculating F
        //
        *f = 5.0e0;
        T2 = inf;
        T5 = atol;
        T6 = tol;
        dstinv(&K1, &T2, &K3, &K3, &K4, &T5, &T6);
        *status = 0;
        dinvr(status, f, &fx, &qleft, &qhi);
      S160:
        if(!(*status == 1)) goto S170;
        cumfnc(f, dfn, dfd, phonc, &cum, &ccum);
        fx = cum - *p;
        dinvr(status, f, &fx, &qleft, &qhi);
        goto S160;
      S170:
        if(!(*status == -1)) goto S200;
        if(!qleft) goto S180;
        *status = 1;
        *bound = 0.0e0;
        goto S190;
      S180:
        *status = 2;
        *bound = inf;
      S200:
      S190:
        ;
      }
    else if(3 == *which)
      {
        //
        //     Calculating DFN
        //
        *dfn = 5.0e0;
        T7 = zero;
        T8 = inf;
        T9 = atol;
        T10 = tol;
        dstinv(&T7, &T8, &K3, &K3, &K4, &T9, &T10);
        *status = 0;
        dinvr(status, dfn, &fx, &qleft, &qhi);
      S210:
        if(!(*status == 1)) goto S220;
        cumfnc(f, dfn, dfd, phonc, &cum, &ccum);
        fx = cum - *p;
        dinvr(status, dfn, &fx, &qleft, &qhi);
        goto S210;
      S220:
        if(!(*status == -1)) goto S250;
        if(!qleft) goto S230;
        *status = 1;
        *bound = zero;
        goto S240;
      S230:
        *status = 2;
        *bound = inf;
      S250:
      S240:
        ;
      }
    else if(4 == *which)
      {
        //
        //     Calculating DFD
        //
        *dfd = 5.0e0;
        T11 = zero;
        T12 = inf;
        T13 = atol;
        T14 = tol;
        dstinv(&T11, &T12, &K3, &K3, &K4, &T13, &T14);
        *status = 0;
        dinvr(status, dfd, &fx, &qleft, &qhi);
      S260:
        if(!(*status == 1)) goto S270;
        cumfnc(f, dfn, dfd, phonc, &cum, &ccum);
        fx = cum - *p;
        dinvr(status, dfd, &fx, &qleft, &qhi);
        goto S260;
      S270:
        if(!(*status == -1)) goto S300;
        if(!qleft) goto S280;
        *status = 1;
        *bound = zero;
        goto S290;
      S280:
        *status = 2;
        *bound = inf;
      S300:
      S290:
        ;
      }
    else if(5 == *which)
      {
        //
        //     Calculating PHONC
        //
        *phonc = 5.0e0;
        T15 = tent4;
        T16 = atol;
        T17 = tol;
        dstinv(&K1, &T15, &K3, &K3, &K4, &T16, &T17);
        *status = 0;
        dinvr(status, phonc, &fx, &qleft, &qhi);
      S310:
        if(!(*status == 1)) goto S320;
        cumfnc(f, dfn, dfd, phonc, &cum, &ccum);
        fx = cum - *p;
        dinvr(status, phonc, &fx, &qleft, &qhi);
        goto S310;
      S320:
        if(!(*status == -1)) goto S350;
        if(!qleft) goto S330;
        *status = 1;
        *bound = 0.0e0;
        goto S340;
      S330:
        *status = 2;
        *bound = tent4;
      S340:
        ;
      }
  S350:
    return;
# undef tent4
# undef tol
# undef atol
# undef zero
# undef one
# undef inf
  }
  //****************************************************************************

  void cdfgam ( int *which, double *p, double *q, double *x, double *shape,
                double *scale, int *status, double *bound )

  //****************************************************************************
  //
  //  Purpose:
  //
  //    CDFGAM evaluates the CDF of the Gamma Distribution.
  //
  //  Discussion:
  //
  //    This routine calculates any one parameter of the Gamma distribution
  //    given the others.
  //
  //    The cumulative distribution function P is calculated directly.
  //
  //    Computation of the other parameters involves a seach for a value that
  //    produces the desired value of P.  The search relies on the
  //    monotonicity of P with respect to the other parameters.
  //
  //    The gamma density is proportional to T**(SHAPE - 1) * EXP(- SCALE * T)
  //
  //  Reference:
  //
  //    Armido DiDinato and Alfred Morris,
  //    Computation of the incomplete gamma function ratios and their inverse,
  //    ACM Transactions on Mathematical Software,
  //    Volume 12, 1986, pages 377-393.
  //
  //  Parameters:
  //
  //    Input, int *WHICH, indicates which argument is to be calculated
  //    from the others.
  //    1: Calculate P and Q from X, SHAPE and SCALE;
  //    2: Calculate X from P, Q, SHAPE and SCALE;
  //    3: Calculate SHAPE from P, Q, X and SCALE;
  //    4: Calculate SCALE from P, Q, X and SHAPE.
  //
  //    Input/output, double *P, the integral from 0 to X of the
  //    Gamma density.  If this is an input value, it should lie in the
  //    range: [0,1].
  //
  //    Input/output, double *Q, equal to 1-P.  If Q is an input
  //    value, it should lie in the range [0,1].  If Q is an output value,
  //    it will lie in the range [0,1].
  //
  //    Input/output, double *X, the upper limit of integration of
  //    the Gamma density.  If this is an input value, it should lie in the
  //    range: [0, +infinity).  If it is an output value, it will lie in
  //    the range: [0,1E300].
  //
  //    Input/output, double *SHAPE, the shape parameter of the
  //    Gamma density.  If this is an input value, it should lie in the range:
  //    (0, +infinity).  If it is an output value, it will be searched for
  //    in the range: [1.0D-300,1.0D+300].
  //
  //    Input/output, double *SCALE, the scale parameter of the
  //    Gamma density.  If this is an input value, it should lie in the range
  //    (0, +infinity).  If it is an output value, it will be searched for
  //    in the range: (1.0D-300,1.0D+300].
  //
  //    Output, int *STATUS, reports the status of the computation.
  //     0, if the calculation completed correctly;
  //    -I, if the input parameter number I is out of range;
  //    +1, if the answer appears to be lower than lowest search bound;
  //    +2, if the answer appears to be higher than greatest search bound;
  //    +3, if P + Q /= 1;
  //    +10, if the Gamma or inverse Gamma routine cannot compute the answer.
  //    This usually happens only for X and SHAPE very large (more than 1.0D+10.
  //
  //    Output, double *BOUND, is only defined if STATUS is nonzero.
  //    If STATUS is negative, then this is the value exceeded by parameter I.
  //    if STATUS is 1 or 2, this is the search bound that was exceeded.
  //
  {
# define tol (1.0e-8)
# define atol (1.0e-50)
# define zero (1.0e-300)
# define inf 1.0e300

    static int K1 = 1;
    static double K5 = 0.5e0;
    static double K6 = 5.0e0;
    static double xx, fx, xscale, cum, ccum, pq, porq;
    static int ierr;
    static unsigned long qhi, qleft, qporq;
    static double T2, T3, T4, T7, T8, T9;

    //
    //     Check arguments
    //
    if(!(*which < 1 || *which > 4)) goto S30;
    if(!(*which < 1)) goto S10;
    *bound = 1.0e0;
    goto S20;
  S10:
    *bound = 4.0e0;
  S20:
    *status = -1;
    return;
  S30:
    if(*which == 1) goto S70;
    //
    //     P
    //
    if(!(*p < 0.0e0 || *p > 1.0e0)) goto S60;
    if(!(*p < 0.0e0)) goto S40;
    *bound = 0.0e0;
    goto S50;
  S40:
    *bound = 1.0e0;
  S50:
    *status = -2;
    return;
  S70:
  S60:
    if(*which == 1) goto S110;
    //
    //     Q
    //
    if(!(*q <= 0.0e0 || *q > 1.0e0)) goto S100;
    if(!(*q <= 0.0e0)) goto S80;
    *bound = 0.0e0;
    goto S90;
  S80:
    *bound = 1.0e0;
  S90:
    *status = -3;
    return;
  S110:
  S100:
    if(*which == 2) goto S130;
    //
    //     X
    //
    if(!(*x < 0.0e0)) goto S120;
    *bound = 0.0e0;
    *status = -4;
    return;
  S130:
  S120:
    if(*which == 3) goto S150;
    //
    //     SHAPE
    //
    if(!(*shape <= 0.0e0)) goto S140;
    *bound = 0.0e0;
    *status = -5;
    return;
  S150:
  S140:
    if(*which == 4) goto S170;
    //
    //     SCALE
    //
    if(!(*scale <= 0.0e0)) goto S160;
    *bound = 0.0e0;
    *status = -6;
    return;
  S170:
  S160:
    if(*which == 1) goto S210;
    //
    //     P + Q
    //
    pq = *p + *q;
    if(!(fabs(pq - 0.5e0 - 0.5e0) > 3.0e0 * dpmpar(&K1))) goto S200;
    if(!(pq < 0.0e0)) goto S180;
    *bound = 0.0e0;
    goto S190;
  S180:
    *bound = 1.0e0;
  S190:
    *status = 3;
    return;
  S210:
  S200:
    if(*which == 1) goto S240;
    //
    //     Select the minimum of P or Q
    //
    qporq = *p <= *q;
    if(!qporq) goto S220;
    porq = *p;
    goto S230;
  S220:
    porq = *q;
  S240:
  S230:
    //
    //     Calculate ANSWERS
    //
    if(1 == *which)
      {
        //
        //     Calculating P
        //
        *status = 0;
        xscale = *x**scale;
        cumgam(&xscale, shape, p, q);
        if(porq > 1.5e0) *status = 10;
      }
    else if(2 == *which)
      {
        //
        //     Computing X
        //
        T2 = -1.0e0;
        gamma_inc_inv ( shape, &xx, &T2, p, q, &ierr );
        if(ierr < 0.0e0)
          {
            *status = 10;
            return;
          }
        else
          {
            *x = xx / *scale;
            *status = 0;
          }
      }
    else if(3 == *which)
      {
        //
        //     Computing SHAPE
        //
        *shape = 5.0e0;
        xscale = *x**scale;
        T3 = zero;
        T4 = inf;
        T7 = atol;
        T8 = tol;
        dstinv(&T3, &T4, &K5, &K5, &K6, &T7, &T8);
        *status = 0;
        dinvr(status, shape, &fx, &qleft, &qhi);
      S250:
        if(!(*status == 1)) goto S290;
        cumgam(&xscale, shape, &cum, &ccum);
        if(!qporq) goto S260;
        fx = cum - *p;
        goto S270;
      S260:
        fx = ccum - *q;
      S270:
        if(!((qporq && cum > 1.5e0) || (!qporq && ccum > 1.5e0))) goto S280;
        *status = 10;
        return;
      S280:
        dinvr(status, shape, &fx, &qleft, &qhi);
        goto S250;
      S290:
        if(!(*status == -1)) goto S320;
        if(!qleft) goto S300;
        *status = 1;
        *bound = zero;
        goto S310;
      S300:
        *status = 2;
        *bound = inf;
      S320:
      S310:
        ;
      }
    else if(4 == *which)
      {
        //
        //     Computing SCALE
        //
        T9 = -1.0e0;
        gamma_inc_inv ( shape, &xx, &T9, p, q, &ierr );
        if(ierr < 0.0e0)
          {
            *status = 10;
            return;
          }
        else
          {
            *scale = xx / *x;
            *status = 0;
          }
      }
    return;
# undef tol
# undef atol
# undef zero
# undef inf
  }
  //****************************************************************************

  void cdfnbn ( int *which, double *p, double *q, double *s, double *xn,
                double *pr, double *ompr, int *status, double *bound )

  //****************************************************************************
  //
  //  Purpose:
  //
  //    CDFNBN evaluates the CDF of the Negative Binomial distribution
  //
  //  Discussion:
  //
  //    This routine calculates any one parameter of the negative binomial
  //    distribution given values for the others.
  //
  //    The cumulative negative binomial distribution returns the
  //    probability that there will be F or fewer failures before the
  //    S-th success in binomial trials each of which has probability of
  //    success PR.
  //
  //    The individual term of the negative binomial is the probability of
  //    F failures before S successes and is
  //    Choose( F, S+F-1 ) * PR^(S) * (1-PR)^F
  //
  //    Computation of other parameters involve a seach for a value that
  //    produces the desired value of P.  The search relies on the
  //    monotonicity of P with respect to the other parameters.
  //
  //  Reference:
  //
  //    Milton Abramowitz and Irene Stegun,
  //    Handbook of Mathematical Functions
  //    1966, Formula 26.5.26.
  //
  //  Parameters:
  //
  //    Input, int WHICH, indicates which argument is to be calculated
  //    from the others.
  //    1: Calculate P and Q from F, S, PR and OMPR;
  //    2: Calculate F from P, Q, S, PR and OMPR;
  //    3: Calculate S from P, Q, F, PR and OMPR;
  //    4: Calculate PR and OMPR from P, Q, F and S.
  //
  //    Input/output, double P, the cumulation from 0 to F of
  //    the negative binomial distribution.  If P is an input value, it
  //    should lie in the range [0,1].
  //
  //    Input/output, double Q, equal to 1-P.  If Q is an input
  //    value, it should lie in the range [0,1].  If Q is an output value,
  //    it will lie in the range [0,1].
  //
  //    Input/output, double F, the upper limit of cumulation of
  //    the binomial distribution.  There are F or fewer failures before
  //    the S-th success.  If this is an input value, it may lie in the
  //    range [0,+infinity), and if it is an output value, it will be searched
  //    for in the range [0,1.0D+300].
  //
  //    Input/output, double S, the number of successes.
  //    If this is an input value, it should lie in the range: [0, +infinity).
  //    If it is an output value, it will be searched for in the range:
  //    [0, 1.0D+300].
  //
  //    Input/output, double PR, the probability of success in each
  //    binomial trial.  Whether an input or output value, it should lie in the
  //    range [0,1].
  //
  //    Input/output, double OMPR, the value of (1-PR).  Whether an
  //    input or output value, it should lie in the range [0,1].
  //
  //    Output, int STATUS, reports the status of the computation.
  //     0, if the calculation completed correctly;
  //    -I, if the input parameter number I is out of range;
  //    +1, if the answer appears to be lower than lowest search bound;
  //    +2, if the answer appears to be higher than greatest search bound;
  //    +3, if P + Q /= 1;
  //    +4, if PR + OMPR /= 1.
  //
  //    Output, double BOUND, is only defined if STATUS is nonzero.
  //    If STATUS is negative, then this is the value exceeded by parameter I.
  //    if STATUS is 1 or 2, this is the search bound that was exceeded.
  //
  {
# define tol (1.0e-8)
# define atol (1.0e-50)
# define inf 1.0e300
# define one 1.0e0

    static int K1 = 1;
    static double K2 = 0.0e0;
    static double K4 = 0.5e0;
    static double K5 = 5.0e0;
    static double K11 = 1.0e0;
    static double fx, xhi, xlo, pq, prompr, cum, ccum;
    static unsigned long qhi, qleft, qporq;
    static double T3, T6, T7, T8, T9, T10, T12, T13;

    //
    //     Check arguments
    //
    if(!(*which < 1 || *which > 4)) goto S30;
    if(!(*which < 1)) goto S10;
    *bound = 1.0e0;
    goto S20;
  S10:
    *bound = 4.0e0;
  S20:
    *status = -1;
    return;
  S30:
    if(*which == 1) goto S70;
    //
    //     P
    //
    if(!(*p < 0.0e0 || *p > 1.0e0)) goto S60;
    if(!(*p < 0.0e0)) goto S40;
    *bound = 0.0e0;
    goto S50;
  S40:
    *bound = 1.0e0;
  S50:
    *status = -2;
    return;
  S70:
  S60:
    if(*which == 1) goto S110;
    //
    //     Q
    //
    if(!(*q <= 0.0e0 || *q > 1.0e0)) goto S100;
    if(!(*q <= 0.0e0)) goto S80;
    *bound = 0.0e0;
    goto S90;
  S80:
    *bound = 1.0e0;
  S90:
    *status = -3;
    return;
  S110:
  S100:
    if(*which == 2) goto S130;
    //
    //     S
    //
    if(!(*s < 0.0e0)) goto S120;
    *bound = 0.0e0;
    *status = -4;
    return;
  S130:
  S120:
    if(*which == 3) goto S150;
    //
    //     XN
    //
    if(!(*xn < 0.0e0)) goto S140;
    *bound = 0.0e0;
    *status = -5;
    return;
  S150:
  S140:
    if(*which == 4) goto S190;
    //
    //     PR
    //
    if(!(*pr < 0.0e0 || *pr > 1.0e0)) goto S180;
    if(!(*pr < 0.0e0)) goto S160;
    *bound = 0.0e0;
    goto S170;
  S160:
    *bound = 1.0e0;
  S170:
    *status = -6;
    return;
  S190:
  S180:
    if(*which == 4) goto S230;
    //
    //     OMPR
    //
    if(!(*ompr < 0.0e0 || *ompr > 1.0e0)) goto S220;
    if(!(*ompr < 0.0e0)) goto S200;
    *bound = 0.0e0;
    goto S210;
  S200:
    *bound = 1.0e0;
  S210:
    *status = -7;
    return;
  S230:
  S220:
    if(*which == 1) goto S270;
    //
    //     P + Q
    //
    pq = *p + *q;
    if(!(fabs(pq - 0.5e0 - 0.5e0) > 3.0e0 * dpmpar(&K1))) goto S260;
    if(!(pq < 0.0e0)) goto S240;
    *bound = 0.0e0;
    goto S250;
  S240:
    *bound = 1.0e0;
  S250:
    *status = 3;
    return;
  S270:
  S260:
    if(*which == 4) goto S310;
    //
    //     PR + OMPR
    //
    prompr = *pr + *ompr;
    if(!(fabs(prompr - 0.5e0 - 0.5e0) > 3.0e0 * dpmpar(&K1))) goto S300;
    if(!(prompr < 0.0e0)) goto S280;
    *bound = 0.0e0;
    goto S290;
  S280:
    *bound = 1.0e0;
  S290:
    *status = 4;
    return;
  S310:
  S300:
    if(!(*which == 1)) qporq = *p <= *q;
    //
    //     Select the minimum of P or Q
    //     Calculate ANSWERS
    //
    if(1 == *which)
      {
        //
        //     Calculating P
        //
        cumnbn(s, xn, pr, ompr, p, q);
        *status = 0;
      }
    else if(2 == *which)
      {
        //
        //     Calculating S
        //
        *s = 5.0e0;
        T3 = inf;
        T6 = atol;
        T7 = tol;
        dstinv(&K2, &T3, &K4, &K4, &K5, &T6, &T7);
        *status = 0;
        dinvr(status, s, &fx, &qleft, &qhi);
      S320:
        if(!(*status == 1)) goto S350;
        cumnbn(s, xn, pr, ompr, &cum, &ccum);
        if(!qporq) goto S330;
        fx = cum - *p;
        goto S340;
      S330:
        fx = ccum - *q;
      S340:
        dinvr(status, s, &fx, &qleft, &qhi);
        goto S320;
      S350:
        if(!(*status == -1)) goto S380;
        if(!qleft) goto S360;
        *status = 1;
        *bound = 0.0e0;
        goto S370;
      S360:
        *status = 2;
        *bound = inf;
      S380:
      S370:
        ;
      }
    else if(3 == *which)
      {
        //
        //     Calculating XN
        //
        *xn = 5.0e0;
        T8 = inf;
        T9 = atol;
        T10 = tol;
        dstinv(&K2, &T8, &K4, &K4, &K5, &T9, &T10);
        *status = 0;
        dinvr(status, xn, &fx, &qleft, &qhi);
      S390:
        if(!(*status == 1)) goto S420;
        cumnbn(s, xn, pr, ompr, &cum, &ccum);
        if(!qporq) goto S400;
        fx = cum - *p;
        goto S410;
      S400:
        fx = ccum - *q;
      S410:
        dinvr(status, xn, &fx, &qleft, &qhi);
        goto S390;
      S420:
        if(!(*status == -1)) goto S450;
        if(!qleft) goto S430;
        *status = 1;
        *bound = 0.0e0;
        goto S440;
      S430:
        *status = 2;
        *bound = inf;
      S450:
      S440:
        ;
      }
    else if(4 == *which)
      {
        //
        //     Calculating PR and OMPR
        //
        T12 = atol;
        T13 = tol;
        dstzr(&K2, &K11, &T12, &T13);
        if(!qporq) goto S480;
        *status = 0;
        dzror(status, pr, &fx, &xlo, &xhi, &qleft, &qhi);
        *ompr = one - *pr;
      S460:
        if(!(*status == 1)) goto S470;
        cumnbn(s, xn, pr, ompr, &cum, &ccum);
        fx = cum - *p;
        dzror(status, pr, &fx, &xlo, &xhi, &qleft, &qhi);
        *ompr = one - *pr;
        goto S460;
      S470:
        goto S510;
      S480:
        *status = 0;
        dzror(status, ompr, &fx, &xlo, &xhi, &qleft, &qhi);
        *pr = one - *ompr;
      S490:
        if(!(*status == 1)) goto S500;
        cumnbn(s, xn, pr, ompr, &cum, &ccum);
        fx = ccum - *q;
        dzror(status, ompr, &fx, &xlo, &xhi, &qleft, &qhi);
        *pr = one - *ompr;
        goto S490;
      S510:
      S500:
        if(!(*status == -1)) goto S540;
        if(!qleft) goto S520;
        *status = 1;
        *bound = 0.0e0;
        goto S530;
      S520:
        *status = 2;
        *bound = 1.0e0;
      S530:
        ;
      }
  S540:
    return;
# undef tol
# undef atol
# undef inf
# undef one
  }
  //****************************************************************************

  void cdfnor ( int *which, double *p, double *q, double *x, double *mean,
                double *sd, int *status, double *bound )

  //****************************************************************************
  //
  //  Purpose:
  //
  //    CDFNOR evaluates the CDF of the Normal distribution.
  //
  //  Discussion:
  //
  //    A slightly modified version of ANORM from SPECFUN
  //    is used to calculate the cumulative standard normal distribution.
  //
  //    The rational functions from pages 90-95 of Kennedy and Gentle
  //    are used as starting values to Newton's Iterations which
  //    compute the inverse standard normal.  Therefore no searches are
  //    necessary for any parameter.
  //
  //    For X < -15, the asymptotic expansion for the normal is used  as
  //    the starting value in finding the inverse standard normal.
  //
  //    The normal density is proportional to
  //    exp( - 0.5D+00 * (( X - MEAN)/SD)**2)
  //
  //  Reference:
  //
  //    Milton Abramowitz and Irene Stegun,
  //    Handbook of Mathematical Functions
  //    1966, Formula 26.2.12.
  //
  //    William Cody,
  //    Algorithm 715: SPECFUN - A Portable FORTRAN Package of
  //      Special Function Routines and Test Drivers,
  //    ACM Transactions on Mathematical Software,
  //    Volume 19, pages 22-32, 1993.
  //
  //    Kennedy and Gentle,
  //    Statistical Computing,
  //    Marcel Dekker, NY, 1980,
  //    QA276.4  K46
  //
  //  Parameters:
  //
  //    Input, int *WHICH, indicates which argument is to be calculated
  //    from the others.
  //    1: Calculate P and Q from X, MEAN and SD;
  //    2: Calculate X from P, Q, MEAN and SD;
  //    3: Calculate MEAN from P, Q, X and SD;
  //    4: Calculate SD from P, Q, X and MEAN.
  //
  //    Input/output, double *P, the integral from -infinity to X
  //    of the Normal density.  If this is an input or output value, it will
  //    lie in the range [0,1].
  //
  //    Input/output, double *Q, equal to 1-P.  If Q is an input
  //    value, it should lie in the range [0,1].  If Q is an output value,
  //    it will lie in the range [0,1].
  //
  //    Input/output, double *X, the upper limit of integration of
  //    the Normal density.
  //
  //    Input/output, double *MEAN, the mean of the Normal density.
  //
  //    Input/output, double *SD, the standard deviation of the
  //    Normal density.  If this is an input value, it should lie in the
  //    range (0,+infinity).
  //
  //    Output, int *STATUS, the status of the calculation.
  //    0, if calculation completed correctly;
  //    -I, if input parameter number I is out of range;
  //    1, if answer appears to be lower than lowest search bound;
  //    2, if answer appears to be higher than greatest search bound;
  //    3, if P + Q /= 1.
  //
  //    Output, double *BOUND, is only defined if STATUS is nonzero.
  //    If STATUS is negative, then this is the value exceeded by parameter I.
  //    if STATUS is 1 or 2, this is the search bound that was exceeded.
  //
  {
    static int K1 = 1;
    static double z, pq;

    //
    //     Check arguments
    //
    *status = 0;
    if(!(*which < 1 || *which > 4)) goto S30;
    if(!(*which < 1)) goto S10;
    *bound = 1.0e0;
    goto S20;
  S10:
    *bound = 4.0e0;
  S20:
    *status = -1;
    return;
  S30:
    if(*which == 1) goto S70;
    //
    //     P
    //
    if(!(*p <= 0.0e0 || *p > 1.0e0)) goto S60;
    if(!(*p <= 0.0e0)) goto S40;
    *bound = 0.0e0;
    goto S50;
  S40:
    *bound = 1.0e0;
  S50:
    *status = -2;
    return;
  S70:
  S60:
    if(*which == 1) goto S110;
    //
    //     Q
    //
    if(!(*q <= 0.0e0 || *q > 1.0e0)) goto S100;
    if(!(*q <= 0.0e0)) goto S80;
    *bound = 0.0e0;
    goto S90;
  S80:
    *bound = 1.0e0;
  S90:
    *status = -3;
    return;
  S110:
  S100:
    if(*which == 1) goto S150;
    //
    //     P + Q
    //
    pq = *p + *q;
    if(!(fabs(pq - 0.5e0 - 0.5e0) > 3.0e0 * dpmpar(&K1))) goto S140;
    if(!(pq < 0.0e0)) goto S120;
    *bound = 0.0e0;
    goto S130;
  S120:
    *bound = 1.0e0;
  S130:
    *status = 3;
    return;
  S150:
  S140:
    if(*which == 4) goto S170;
    //
    //     SD
    //
    if(!(*sd <= 0.0e0)) goto S160;
    *bound = 0.0e0;
    *status = -6;
    return;
  S170:
  S160:
    //
    //     Calculate ANSWERS
    //
    if(1 == *which)
      {
        //
        //     Computing P
        //
        z = (*x - *mean) / *sd;
        cumnor(&z, p, q);
      }
    else if(2 == *which)
      {
        //
        //     Computing X
        //
        z = dinvnr(p, q);
        *x = *sd * z + *mean;
      }
    else if(3 == *which)
      {
        //
        //     Computing the MEAN
        //
        z = dinvnr(p, q);
        *mean = *x - *sd * z;
      }
    else if(4 == *which)
      {
        //
        //     Computing SD
        //
        z = dinvnr(p, q);
        *sd = (*x - *mean) / z;
      }
    return;
  }
  //****************************************************************************

  void cdfpoi ( int *which, double *p, double *q, double *s, double *xlam,
                int *status, double *bound )

  //****************************************************************************
  //
  //  Purpose:
  //
  //    CDFPOI evaluates the CDF of the Poisson distribution.
  //
  //  Discussion:
  //
  //    This routine calculates any one parameter of the Poisson distribution
  //    given the others.
  //
  //    The value P of the cumulative distribution function is calculated
  //    directly.
  //
  //    Computation of other parameters involve a seach for a value that
  //    produces the desired value of P.  The search relies on the
  //    monotonicity of P with respect to the other parameters.
  //
  //  Reference:
  //
  //    Milton Abramowitz and Irene Stegun,
  //    Handbook of Mathematical Functions
  //    1966, Formula 26.4.21.
  //
  //  Parameters:
  //
  //    Input, int *WHICH, indicates which argument is to be calculated
  //    from the others.
  //    1: Calculate P and Q from S and XLAM;
  //    2: Calculate A from P, Q and XLAM;
  //    3: Calculate XLAM from P, Q and S.
  //
  //    Input/output, double *P, the cumulation from 0 to S of the
  //    Poisson density.  Whether this is an input or output value, it will
  //    lie in the range [0,1].
  //
  //    Input/output, double *Q, equal to 1-P.  If Q is an input
  //    value, it should lie in the range [0,1].  If Q is an output value,
  //    it will lie in the range [0,1].
  //
  //    Input/output, double *S, the upper limit of cumulation of
  //    the Poisson CDF.  If this is an input value, it should lie in
  //    the range: [0, +infinity).  If it is an output value, it will be
  //    searched for in the range: [0,1.0D+300].
  //
  //    Input/output, double *XLAM, the mean of the Poisson
  //    distribution.  If this is an input value, it should lie in the range
  //    [0, +infinity).  If it is an output value, it will be searched for
  //    in the range: [0,1E300].
  //
  //    Output, int *STATUS, reports the status of the computation.
  //     0, if the calculation completed correctly;
  //    -I, if the input parameter number I is out of range;
  //    +1, if the answer appears to be lower than lowest search bound;
  //    +2, if the answer appears to be higher than greatest search bound;
  //    +3, if P + Q /= 1.
  //
  //    Output, double *BOUND, is only defined if STATUS is nonzero.
  //    If STATUS is negative, then this is the value exceeded by parameter I.
  //    if STATUS is 1 or 2, this is the search bound that was exceeded.
  //
  {
# define tol (1.0e-8)
# define atol (1.0e-50)
# define inf 1.0e300

    static int K1 = 1;
    static double K2 = 0.0e0;
    static double K4 = 0.5e0;
    static double K5 = 5.0e0;
    static double fx, cum, ccum, pq;
    static unsigned long qhi, qleft, qporq;
    static double T3, T6, T7, T8, T9, T10;

    //
    //     Check arguments
    //
    if(!(*which < 1 || *which > 3)) goto S30;
    if(!(*which < 1)) goto S10;
    *bound = 1.0e0;
    goto S20;
  S10:
    *bound = 3.0e0;
  S20:
    *status = -1;
    return;
  S30:
    if(*which == 1) goto S70;
    //
    //     P
    //
    if(!(*p < 0.0e0 || *p > 1.0e0)) goto S60;
    if(!(*p < 0.0e0)) goto S40;
    *bound = 0.0e0;
    goto S50;
  S40:
    *bound = 1.0e0;
  S50:
    *status = -2;
    return;
  S70:
  S60:
    if(*which == 1) goto S110;
    //
    //     Q
    //
    if(!(*q <= 0.0e0 || *q > 1.0e0)) goto S100;
    if(!(*q <= 0.0e0)) goto S80;
    *bound = 0.0e0;
    goto S90;
  S80:
    *bound = 1.0e0;
  S90:
    *status = -3;
    return;
  S110:
  S100:
    if(*which == 2) goto S130;
    //
    //     S
    //
    if(!(*s < 0.0e0)) goto S120;
    *bound = 0.0e0;
    *status = -4;
    return;
  S130:
  S120:
    if(*which == 3) goto S150;
    //
    //     XLAM
    //
    if(!(*xlam < 0.0e0)) goto S140;
    *bound = 0.0e0;
    *status = -5;
    return;
  S150:
  S140:
    if(*which == 1) goto S190;
    //
    //     P + Q
    //
    pq = *p + *q;
    if(!(fabs(pq - 0.5e0 - 0.5e0) > 3.0e0 * dpmpar(&K1))) goto S180;
    if(!(pq < 0.0e0)) goto S160;
    *bound = 0.0e0;
    goto S170;
  S160:
    *bound = 1.0e0;
  S170:
    *status = 3;
    return;
  S190:
  S180:
    if(!(*which == 1)) qporq = *p <= *q;
    //
    //     Select the minimum of P or Q
    //     Calculate ANSWERS
    //
    if(1 == *which)
      {
        //
        //     Calculating P
        //
        cumpoi(s, xlam, p, q);
        *status = 0;
      }
    else if(2 == *which)
      {
        //
        //     Calculating S
        //
        *s = 5.0e0;
        T3 = inf;
        T6 = atol;
        T7 = tol;
        dstinv(&K2, &T3, &K4, &K4, &K5, &T6, &T7);
        *status = 0;
        dinvr(status, s, &fx, &qleft, &qhi);
      S200:
        if(!(*status == 1)) goto S230;
        cumpoi(s, xlam, &cum, &ccum);
        if(!qporq) goto S210;
        fx = cum - *p;
        goto S220;
      S210:
        fx = ccum - *q;
      S220:
        dinvr(status, s, &fx, &qleft, &qhi);
        goto S200;
      S230:
        if(!(*status == -1)) goto S260;
        if(!qleft) goto S240;
        *status = 1;
        *bound = 0.0e0;
        goto S250;
      S240:
        *status = 2;
        *bound = inf;
      S260:
      S250:
        ;
      }
    else if(3 == *which)
      {
        //
        //     Calculating XLAM
        //
        *xlam = 5.0e0;
        T8 = inf;
        T9 = atol;
        T10 = tol;
        dstinv(&K2, &T8, &K4, &K4, &K5, &T9, &T10);
        *status = 0;
        dinvr(status, xlam, &fx, &qleft, &qhi);
      S270:
        if(!(*status == 1)) goto S300;
        cumpoi(s, xlam, &cum, &ccum);
        if(!qporq) goto S280;
        fx = cum - *p;
        goto S290;
      S280:
        fx = ccum - *q;
      S290:
        dinvr(status, xlam, &fx, &qleft, &qhi);
        goto S270;
      S300:
        if(!(*status == -1)) goto S330;
        if(!qleft) goto S310;
        *status = 1;
        *bound = 0.0e0;
        goto S320;
      S310:
        *status = 2;
        *bound = inf;
      S320:
        ;
      }
  S330:
    return;
# undef tol
# undef atol
# undef inf
  }
  //****************************************************************************

  void cdft ( int *which, double *p, double *q, double *t, double *df,
              int *status, double *bound )

  //****************************************************************************
  //
  //  Purpose:
  //
  //    CDFT evaluates the CDF of the T distribution.
  //
  //  Discussion:
  //
  //    This routine calculates any one parameter of the T distribution
  //    given the others.
  //
  //    The value P of the cumulative distribution function is calculated
  //    directly.
  //
  //    Computation of other parameters involve a seach for a value that
  //    produces the desired value of P.   The search relies on the
  //    monotonicity of P with respect to the other parameters.
  //
  //    The original version of this routine allowed the search interval
  //    to extend from -1.0E+300 to +1.0E+300, which is fine until you
  //    try to evaluate a function at such a point!
  //
  //  Reference:
  //
  //    Milton Abramowitz and Irene Stegun,
  //    Handbook of Mathematical Functions
  //    1966, Formula 26.5.27.
  //
  //  Parameters:
  //
  //    Input, int *WHICH, indicates which argument is to be calculated
  //    from the others.
  //    1 : Calculate P and Q from T and DF;
  //    2 : Calculate T from P, Q and DF;
  //    3 : Calculate DF from P, Q and T.
  //
  //    Input/output, double *P, the integral from -infinity to T of
  //    the T-density.  Whether an input or output value, this will lie in the
  //    range [0,1].
  //
  //    Input/output, double *Q, equal to 1-P.  If Q is an input
  //    value, it should lie in the range [0,1].  If Q is an output value,
  //    it will lie in the range [0,1].
  //
  //    Input/output, double *T, the upper limit of integration of
  //    the T-density.  If this is an input value, it may have any value.
  //    It it is an output value, it will be searched for in the range
  //    [ -1.0D+30, 1.0D+30 ].
  //
  //    Input/output, double *DF, the number of degrees of freedom
  //    of the T distribution.  If this is an input value, it should lie
  //    in the range: (0 , +infinity).  If it is an output value, it will be
  //    searched for in the range: [1, 1.0D+10].
  //
  //    Output, int *STATUS, reports the status of the computation.
  //     0, if the calculation completed correctly;
  //    -I, if the input parameter number I is out of range;
  //    +1, if the answer appears to be lower than lowest search bound;
  //    +2, if the answer appears to be higher than greatest search bound;
  //    +3, if P + Q /= 1.
  //
  //    Output, double *BOUND, is only defined if STATUS is nonzero.
  //    If STATUS is negative, then this is the value exceeded by parameter I.
  //    if STATUS is 1 or 2, this is the search bound that was exceeded.
  //
  {
# define tol (1.0e-8)
# define atol (1.0e-50)
# define zero (1.0e-300)
# define inf 1.0e30
# define maxdf 1.0e10

    static int K1 = 1;
    static double K4 = 0.5e0;
    static double K5 = 5.0e0;
    static double fx, cum, ccum, pq;
    static unsigned long qhi, qleft, qporq;
    static double T2, T3, T6, T7, T8, T9, T10, T11;
    //
    //     Check arguments
    //
    if(!(*which < 1 || *which > 3)) goto S30;
    if(!(*which < 1)) goto S10;
    *bound = 1.0e0;
    goto S20;
  S10:
    *bound = 3.0e0;
  S20:
    *status = -1;
    return;
  S30:
    if(*which == 1) goto S70;
    //
    //     P
    //
    if(!(*p <= 0.0e0 || *p > 1.0e0)) goto S60;
    if(!(*p <= 0.0e0)) goto S40;
    *bound = 0.0e0;
    goto S50;
  S40:
    *bound = 1.0e0;
  S50:
    *status = -2;
    return;
  S70:
  S60:
    if(*which == 1) goto S110;
    //
    //     Q
    //
    if(!(*q <= 0.0e0 || *q > 1.0e0)) goto S100;
    if(!(*q <= 0.0e0)) goto S80;
    *bound = 0.0e0;
    goto S90;
  S80:
    *bound = 1.0e0;
  S90:
    *status = -3;
    return;
  S110:
  S100:
    if(*which == 3) goto S130;
    //
    //     DF
    //
    if(!(*df <= 0.0e0)) goto S120;
    *bound = 0.0e0;
    *status = -5;
    return;
  S130:
  S120:
    if(*which == 1) goto S170;
    //
    //     P + Q
    //
    pq = *p + *q;
    if(!(fabs(pq - 0.5e0 - 0.5e0) > 3.0e0 * dpmpar(&K1))) goto S160;
    if(!(pq < 0.0e0)) goto S140;
    *bound = 0.0e0;
    goto S150;
  S140:
    *bound = 1.0e0;
  S150:
    *status = 3;
    return;
  S170:
  S160:
    if(!(*which == 1)) qporq = *p <= *q;
    //
    //     Select the minimum of P or Q
    //     Calculate ANSWERS
    //
    if(1 == *which)
      {
        //
        //     Computing P and Q
        //
        cumt(t, df, p, q);
        *status = 0;
      }
    else if(2 == *which)
      {
        //
        //     Computing T
        //     .. Get initial approximation for T
        //
        *t = dt1(p, q, df);
        T2 = -inf;
        T3 = inf;
        T6 = atol;
        T7 = tol;
        dstinv(&T2, &T3, &K4, &K4, &K5, &T6, &T7);
        *status = 0;
        dinvr(status, t, &fx, &qleft, &qhi);
      S180:
        if(!(*status == 1)) goto S210;
        cumt(t, df, &cum, &ccum);
        if(!qporq) goto S190;
        fx = cum - *p;
        goto S200;
      S190:
        fx = ccum - *q;
      S200:
        dinvr(status, t, &fx, &qleft, &qhi);
        goto S180;
      S210:
        if(!(*status == -1)) goto S240;
        if(!qleft) goto S220;
        *status = 1;
        *bound = -inf;
        goto S230;
      S220:
        *status = 2;
        *bound = inf;
      S240:
      S230:
        ;
      }
    else if(3 == *which)
      {
        //
        //     Computing DF
        //
        *df = 5.0e0;
        T8 = zero;
        T9 = maxdf;
        T10 = atol;
        T11 = tol;
        dstinv(&T8, &T9, &K4, &K4, &K5, &T10, &T11);
        *status = 0;
        dinvr(status, df, &fx, &qleft, &qhi);
      S250:
        if(!(*status == 1)) goto S280;
        cumt(t, df, &cum, &ccum);
        if(!qporq) goto S260;
        fx = cum - *p;
        goto S270;
      S260:
        fx = ccum - *q;
      S270:
        dinvr(status, df, &fx, &qleft, &qhi);
        goto S250;
      S280:
        if(!(*status == -1)) goto S310;
        if(!qleft) goto S290;
        *status = 1;
        *bound = zero;
        goto S300;
      S290:
        *status = 2;
        *bound = maxdf;
      S300:
        ;
      }
  S310:
    return;
# undef tol
# undef atol
# undef zero
# undef inf
# undef maxdf
  }
  //******************************************************************************

  void chi_noncentral_cdf_values ( int *n_data, double *x, double *lambda,
                                   int *df, double *cdf )

  //******************************************************************************
  //
  //  Purpose:
  //
  //    CHI_NONCENTRAL_CDF_VALUES returns values of the noncentral chi CDF.
  //
  //  Discussion:
  //
  //    The CDF of the noncentral chi square distribution can be evaluated
  //    within Mathematica by commands such as:
  //
  //      Needs["Statistics`ContinuousDistributions`"]
  //      CDF [ NoncentralChiSquareDistribution [ DF, LAMBDA ], X ]
  //
  //  Modified:
  //
  //    12 June 2004
  //
  //  @author:
  //
  //    John Burkardt
  //
  //  Reference:
  //
  //    Stephen Wolfram,
  //    The Mathematica Book,
  //    Fourth Edition,
  //    Wolfram Media / Cambridge University Press, 1999.
  //
  //  Parameters:
  //
  //    Input/output, int *N_DATA.  The user sets N_DATA to 0 before the
  //    first call.  On each call, the routine increments N_DATA by 1, and
  //    returns the corresponding data; when there is no more data, the
  //    output value of N_DATA will be 0 again.
  //
  //    Output, double *X, the argument of the function.
  //
  //    Output, double *LAMBDA, the noncentrality parameter.
  //
  //    Output, int *DF, the number of degrees of freedom.
  //
  //    Output, double *CDF, the noncentral chi CDF.
  //
  {
# define N_MAX 27

    double cdf_vec[N_MAX] =
      {
        0.839944E+00, 0.695906E+00, 0.535088E+00,
        0.764784E+00, 0.620644E+00, 0.469167E+00,
        0.307088E+00, 0.220382E+00, 0.150025E+00,
        0.307116E-02, 0.176398E-02, 0.981679E-03,
        0.165175E-01, 0.202342E-03, 0.498448E-06,
        0.151325E-01, 0.209041E-02, 0.246502E-03,
        0.263684E-01, 0.185798E-01, 0.130574E-01,
        0.583804E-01, 0.424978E-01, 0.308214E-01,
        0.105788E+00, 0.794084E-01, 0.593201E-01
      };
    int df_vec[N_MAX] =
      {
        1,   2,   3,
        1,   2,   3,
        1,   2,   3,
        1,   2,   3,
        60,  80, 100,
        1,   2,   3,
        10,  10,  10,
        10,  10,  10,
        10,  10,  10
      };
    double lambda_vec[N_MAX] =
      {
        0.5E+00,  0.5E+00,  0.5E+00,
        1.0E+00,  1.0E+00,  1.0E+00,
        5.0E+00,  5.0E+00,  5.0E+00,
        20.0E+00, 20.0E+00, 20.0E+00,
        30.0E+00, 30.0E+00, 30.0E+00,
        5.0E+00,  5.0E+00,  5.0E+00,
        2.0E+00,  3.0E+00,  4.0E+00,
        2.0E+00,  3.0E+00,  4.0E+00,
        2.0E+00,  3.0E+00,  4.0E+00
      };
    double x_vec[N_MAX] =
      {
        3.000E+00,  3.000E+00,  3.000E+00,
        3.000E+00,  3.000E+00,  3.000E+00,
        3.000E+00,  3.000E+00,  3.000E+00,
        3.000E+00,  3.000E+00,  3.000E+00,
        60.000E+00, 60.000E+00, 60.000E+00,
        0.050E+00,  0.050E+00,  0.050E+00,
        4.000E+00,  4.000E+00,  4.000E+00,
        5.000E+00,  5.000E+00,  5.000E+00,
        6.000E+00,  6.000E+00,  6.000E+00
      };

    if ( *n_data < 0 )
      {
        *n_data = 0;
      }

    *n_data = *n_data + 1;

    if ( N_MAX < *n_data )
      {
        *n_data = 0;
        *x = 0.0E+00;
        *lambda = 0.0E+00;
        *df = 0;
        *cdf = 0.0E+00;
      }
    else
      {
        *x = x_vec[*n_data - 1];
        *lambda = lambda_vec[*n_data - 1];
        *df = df_vec[*n_data - 1];
        *cdf = cdf_vec[*n_data - 1];
      }

    return;
# undef N_MAX
  }
  //*******************************************************************************

  void chi_square_cdf_values ( int *n_data, int *a, double *x, double *fx )

  //*******************************************************************************
  //
  //  Purpose:
  //
  //    CHI_SQUARE_CDF_VALUES returns some values of the Chi-Square CDF.
  //
  //  Discussion:
  //
  //    The value of CHI_CDF ( DF, X ) can be evaluated in Mathematica by
  //    commands like:
  //
  //      Needs["Statistics`ContinuousDistributions`"]
  //      CDF[ChiSquareDistribution[DF], X ]
  //
  //  Modified:
  //
  //    11 June 2004
  //
  //  @author:
  //
  //    John Burkardt
  //
  //  Reference:
  //
  //    Milton Abramowitz and Irene Stegun,
  //    Handbook of Mathematical Functions,
  //    US Department of Commerce, 1964.
  //
  //    Stephen Wolfram,
  //    The Mathematica Book,
  //    Fourth Edition,
  //    Wolfram Media / Cambridge University Press, 1999.
  //
  //  Parameters:
  //
  //    Input/output, int *N_DATA.  The user sets N_DATA to 0 before the
  //    first call.  On each call, the routine increments N_DATA by 1, and
  //    returns the corresponding data; when there is no more data, the
  //    output value of N_DATA will be 0 again.
  //
  //    Output, int *A, the parameter of the function.
  //
  //    Output, double *X, the argument of the function.
  //
  //    Output, double *FX, the value of the function.
  //
  {
# define N_MAX 21

    int a_vec[N_MAX] =
      {
        1,  2,  1,  2,
        1,  2,  3,  4,
        1,  2,  3,  4,
        5,  3,  3,  3,
        3,  3, 10, 10,
        10
      };
    double fx_vec[N_MAX] =
      {
        0.0796557E+00, 0.00498752E+00, 0.112463E+00,    0.00995017E+00,
        0.472911E+00,  0.181269E+00,   0.0597575E+00,   0.0175231E+00,
        0.682689E+00,  0.393469E+00,   0.198748E+00,    0.090204E+00,
        0.0374342E+00, 0.427593E+00,   0.608375E+00,    0.738536E+00,
        0.828203E+00,  0.88839E+00,    0.000172116E+00, 0.00365985E+00,
        0.0185759E+00
      };
    double x_vec[N_MAX] =
      {
        0.01E+00, 0.01E+00, 0.02E+00, 0.02E+00,
        0.40E+00, 0.40E+00, 0.40E+00, 0.40E+00,
        1.00E+00, 1.00E+00, 1.00E+00, 1.00E+00,
        1.00E+00, 2.00E+00, 3.00E+00, 4.00E+00,
        5.00E+00, 6.00E+00, 1.00E+00, 2.00E+00,
        3.00E+00
      };

    if ( *n_data < 0 )
      {
        *n_data = 0;
      }

    *n_data = *n_data + 1;

    if ( N_MAX < *n_data )
      {
        *n_data = 0;
        *a = 0;
        *x = 0.0E+00;
        *fx = 0.0E+00;
      }
    else
      {
        *a = a_vec[*n_data - 1];
        *x = x_vec[*n_data - 1];
        *fx = fx_vec[*n_data - 1];
      }
    return;
# undef N_MAX
  }
  //****************************************************************************

  void cumbet ( double *x, double *y, double *a, double *b, double *cum,
                double *ccum )

  //****************************************************************************
  //
  //  Purpose:
  //
  //    CUMBET evaluates the cumulative incomplete beta distribution.
  //
  //  Discussion:
  //
  //    This routine calculates the CDF to X of the incomplete beta distribution
  //    with parameters A and B.  This is the integral from 0 to x
  //    of (1/B(a,b))*f(t)) where f(t) = t**(a-1) * (1-t)**(b-1)
  //
  //  Modified:
  //
  //    14 March 2006
  //
  //  Reference:
  //
  //    A R Didonato and Alfred Morris,
  //    Algorithm 708:
  //    Significant Digit Computation of the Incomplete Beta Function Ratios.
  //    ACM Transactions on Mathematical Software,
  //    Volume 18, Number 3, September 1992, pages 360-373.
  //
  //  Parameters:
  //
  //    Input, double *X, the upper limit of integration.
  //
  //    Input, double *Y, the value of 1-X.
  //
  //    Input, double *A, *B, the parameters of the distribution.
  //
  //    Output, double *CUM, *CCUM, the values of the cumulative
  //    density function and tail cumulative density function.
  //
  {
    static int ierr;

    if ( *x <= 0.0 )
      {
        *cum = 0.0;
        *ccum = 1.0;
      }
    else if ( *y <= 0.0 )
      {
        *cum = 1.0;
        *ccum = 0.0;
      }
    else
      {
        beta_inc ( a, b, x, y, cum, ccum, &ierr );
      }
    return;
  }
  //****************************************************************************

  void cumbin ( double *s, double *xn, double *pr, double *ompr,
                double *cum, double *ccum )

  //****************************************************************************
  //
  //  Purpose:
  //
  //    CUMBIN evaluates the cumulative binomial distribution.
  //
  //  Discussion:
  //
  //    This routine returns the probability of 0 to S successes in XN binomial
  //    trials, each of which has a probability of success, PR.
  //
  //  Modified:
  //
  //    14 March 2006
  //
  //  Reference:
  //
  //    Milton Abramowitz and Irene Stegun,
  //    Handbook of Mathematical Functions
  //    1966, Formula 26.5.24.
  //
  //  Parameters:
  //
  //    Input, double *S, the upper limit of summation.
  //
  //    Input, double *XN, the number of trials.
  //
  //    Input, double *PR, the probability of success in one trial.
  //
  //    Input, double *OMPR, equals ( 1 - PR ).
  //
  //    Output, double *CUM, the cumulative binomial distribution.
  //
  //    Output, double *CCUM, the complement of the cumulative
  //    binomial distribution.
  //
  {
    static double T1, T2;

    if ( *s < *xn )
      {
        T1 = *s + 1.0;
        T2 = *xn - *s;
        cumbet ( pr, ompr, &T1, &T2, ccum, cum );
      }
    else
      {
        *cum = 1.0;
        *ccum = 0.0;
      }
    return;
  }
  //****************************************************************************

  void cumchi ( double *x, double *df, double *cum, double *ccum )

  //****************************************************************************
  //
  //  Purpose:
  //
  //    CUMCHI evaluates the cumulative chi-square distribution.
  //
  //  Parameters:
  //
  //    Input, double *X, the upper limit of integration.
  //
  //    Input, double *DF, the egrees of freedom of the
  //    chi-square distribution.
  //
  //    Output, double *CUM, the cumulative chi-square distribution.
  //
  //    Output, double *CCUM, the complement of the cumulative
  //    chi-square distribution.
  //
  {
    static double a;
    static double xx;

    a = *df * 0.5;
    xx = *x * 0.5;
    cumgam ( &xx, &a, cum, ccum );
    return;
  }
  //****************************************************************************

  void cumchn ( double *x, double *df, double *pnonc, double *cum,
                double *ccum )

  //****************************************************************************
  //
  //  Purpose:
  //
  //    CUMCHN evaluates the cumulative noncentral chi-square distribution.
  //
  //  Discussion:
  //
  //    Calculates the cumulative noncentral chi-square
  //    distribution, i.e., the probability that a random variable
  //    which follows the noncentral chi-square distribution, with
  //    noncentrality parameter PNONC and continuous degrees of
  //    freedom DF, is less than or equal to X.
  //
  //  Reference:
  //
  //    Milton Abramowitz and Irene Stegun,
  //    Handbook of Mathematical Functions
  //    1966, Formula 26.4.25.
  //
  //  Parameters:
  //
  //    Input, double *X, the upper limit of integration.
  //
  //    Input, double *DF, the number of degrees of freedom.
  //
  //    Input, double *PNONC, the noncentrality parameter of
  //    the noncentral chi-square distribution.
  //
  //    Output, double *CUM, *CCUM, the CDF and tail
  //    CDF of the noncentral chi-square distribution.
  //
  //  Local Parameters:
  //
  //    Local, double EPS, the convergence criterion.  The sum
  //    stops when a term is less than EPS*SUM.
  //
  //    Local, int NTIRED, the maximum number of terms to be evaluated
  //    in each sum.
  //
  //    Local, bool QCONV, is TRUE if convergence was achieved, that is,
  //    the program did not stop on NTIRED criterion.
  //
  {
# define dg(i) (*df+2.0e0*(double)(i))
# define qsmall(xx) (int)(sum < 1.0e-20 || (xx) < eps*sum)
# define qtired(i) (int)((i) > ntired)

    static double eps = 1.0e-5;
    static int ntired = 1000;
    static double adj, centaj, centwt, chid2, dfd2, lcntaj, lcntwt, lfact, pcent, pterm, sum,
      sumadj, term, wt, xnonc;
    static int i, icent, iterb, iterf;
    static double T1, T2, T3;

    if(!(*x <= 0.0e0)) goto S10;
    *cum = 0.0e0;
    *ccum = 1.0e0;
    return;
  S10:
    if(!(*pnonc <= 1.0e-10)) goto S20;
    //
    //     When non-centrality parameter is (essentially) zero,
    //     use cumulative chi-square distribution
    //
    cumchi(x, df, cum, ccum);
    return;
  S20:
    xnonc = *pnonc / 2.0e0;
    //
    //     The following code calculates the weight, chi-square, and
    //     adjustment term for the central term in the infinite series.
    //     The central term is the one in which the poisson weight is
    //     greatest.  The adjustment term is the amount that must
    //     be subtracted from the chi-square to move up two degrees
    //     of freedom.
    //
    icent = fifidint(xnonc);
    if(icent == 0) icent = 1;
    chid2 = *x / 2.0e0;
    //
    //     Calculate central weight term
    //
    T1 = (double)(icent + 1);
    lfact = gamma_log ( &T1 );
    lcntwt = -xnonc + (double)icent * log(xnonc) - lfact;
    centwt = exp(lcntwt);
    //
    //     Calculate central chi-square
    //
    T2 = dg(icent);
    cumchi(x, &T2, &pcent, ccum);
    //
    //     Calculate central adjustment term
    //
    dfd2 = dg(icent) / 2.0e0;
    T3 = 1.0e0 + dfd2;
    lfact = gamma_log ( &T3 );
    lcntaj = dfd2 * log(chid2) - chid2 - lfact;
    centaj = exp(lcntaj);
    sum = centwt * pcent;
    //
    //     Sum backwards from the central term towards zero.
    //     Quit whenever either
    //     (1) the zero term is reached, or
    //     (2) the term gets small relative to the sum, or
    //     (3) More than NTIRED terms are totaled.
    //
    iterb = 0;
    sumadj = 0.0e0;
    adj = centaj;
    wt = centwt;
    i = icent;
    goto S40;
  S30:
    if(qtired(iterb) || qsmall(term) || i == 0) goto S50;
  S40:
    dfd2 = dg(i) / 2.0e0;
    //
    //     Adjust chi-square for two fewer degrees of freedom.
    //     The adjusted value ends up in PTERM.
    //
    adj = adj * dfd2 / chid2;
    sumadj += adj;
    pterm = pcent + sumadj;
    //
    //     Adjust poisson weight for J decreased by one
    //
    wt *= ((double)i / xnonc);
    term = wt * pterm;
    sum += term;
    i -= 1;
    iterb += 1;
    goto S30;
  S50:
    iterf = 0;
    //
    //     Now sum forward from the central term towards infinity.
    //     Quit when either
    //     (1) the term gets small relative to the sum, or
    //     (2) More than NTIRED terms are totaled.
    //
    sumadj = adj = centaj;
    wt = centwt;
    i = icent;
    goto S70;
  S60:
    if(qtired(iterf) || qsmall(term)) goto S80;
  S70:
    //
    //     Update weights for next higher J
    //
    wt *= (xnonc / (double)(i + 1));
    //
    //     Calculate PTERM and add term to sum
    //
    pterm = pcent - sumadj;
    term = wt * pterm;
    sum += term;
    //
    //     Update adjustment term for DF for next iteration
    //
    i += 1;
    dfd2 = dg(i) / 2.0e0;
    adj = adj * chid2 / dfd2;
    sumadj += adj;
    iterf += 1;
    goto S60;
  S80:
    *cum = sum;
    *ccum = 0.5e0 + (0.5e0 - *cum);
    return;
# undef dg
# undef qsmall
# undef qtired
  }
  //****************************************************************************

  void cumf ( double *f, double *dfn, double *dfd, double *cum, double *ccum )

  //****************************************************************************
  //
  //  Purpose:
  //
  //    CUMF evaluates the cumulative F distribution.
  //
  //  Discussion:
  //
  //    CUMF computes the integral from 0 to F of the F density with DFN
  //    numerator and DFD denominator degrees of freedom.
  //
  //  Reference:
  //
  //    Milton Abramowitz and Irene Stegun,
  //    Handbook of Mathematical Functions
  //    1966, Formula 26.5.28.
  //
  //  Parameters:
  //
  //    Input, double *F, the upper limit of integration.
  //
  //    Input, double *DFN, *DFD, the number of degrees of
  //    freedom for the numerator and denominator.
  //
  //    Output, double *CUM, *CCUM, the value of the F CDF and
  //    the tail F CDF.
  //
  {
# define half 0.5e0
# define done 1.0e0

    static double dsum, prod, xx, yy;
    static int ierr;
    static double T1, T2;

    if(!(*f <= 0.0e0)) goto S10;
    *cum = 0.0e0;
    *ccum = 1.0e0;
    return;
  S10:
    prod = *dfn**f;
    //
    //     XX is such that the incomplete beta with parameters
    //     DFD/2 and DFN/2 evaluated at XX is 1 - CUM or CCUM
    //     YY is 1 - XX
    //     Calculate the smaller of XX and YY accurately
    //
    dsum = *dfd + prod;
    xx = *dfd / dsum;

    if ( xx > half )
      {
        yy = prod / dsum;
        xx = done - yy;
      }
    else
      {
        yy = done - xx;
      }

    T1 = *dfd * half;
    T2 = *dfn * half;
    beta_inc ( &T1, &T2, &xx, &yy, ccum, cum, &ierr );
    return;
# undef half
# undef done
  }
  //****************************************************************************

  void cumfnc ( double *f, double *dfn, double *dfd, double *pnonc,
                double *cum, double *ccum )

  //****************************************************************************
  //
  //  Purpose:
  //
  //    CUMFNC evaluates the cumulative noncentral F distribution.
  //
  //  Discussion:
  //
  //    This routine computes the noncentral F distribution with DFN and DFD
  //    degrees of freedom and noncentrality parameter PNONC.
  //
  //    The series is calculated backward and forward from J = LAMBDA/2
  //    (this is the term with the largest Poisson weight) until
  //    the convergence criterion is met.
  //
  //    The sum continues until a succeeding term is less than EPS
  //    times the sum (or the sum is less than 1.0e-20).  EPS is
  //    set to 1.0e-4 in a data statement which can be changed.
  //
  //
  //    The original version of this routine allowed the input values
  //    of DFN and DFD to be negative (nonsensical) or zero (which
  //    caused numerical overflow.)  I have forced both these values
  //    to be at least 1.
  //
  //  Modified:
  //
  //    15 June 2004
  //
  //  Reference:
  //
  //    Milton Abramowitz and Irene Stegun,
  //    Handbook of Mathematical Functions
  //    1966, Formula 26.5.16, 26.6.17, 26.6.18, 26.6.20.
  //
  //  Parameters:
  //
  //    Input, double *F, the upper limit of integration.
  //
  //    Input, double *DFN, *DFD, the number of degrees of freedom
  //    in the numerator and denominator.  Both DFN and DFD must be positive,
  //    and normally would be integers.  This routine requires that they
  //    be no less than 1.
  //
  //    Input, double *PNONC, the noncentrality parameter.
  //
  //    Output, double *CUM, *CCUM, the noncentral F CDF and
  //    tail CDF.
  //
  {
# define qsmall(x) (int)(sum < 1.0e-20 || (x) < eps*sum)
# define half 0.5e0
# define done 1.0e0

    static double eps = 1.0e-4;
    static double dsum, dummy, prod, xx, yy, adn, aup, b, betdn, betup, centwt, dnterm, sum,
      upterm, xmult, xnonc;
    static int i, icent, ierr;
    static double T1, T2, T3, T4, T5, T6;

    if(!(*f <= 0.0e0)) goto S10;
    *cum = 0.0e0;
    *ccum = 1.0e0;
    return;
  S10:
    if(!(*pnonc < 1.0e-10)) goto S20;
    //
    //  Handle case in which the non-centrality parameter is
    //  (essentially) zero.
    //
    cumf(f, dfn, dfd, cum, ccum);
    return;
  S20:
    xnonc = *pnonc / 2.0e0;
    //
    //  Calculate the central term of the poisson weighting factor.
    //
    icent = ( int ) xnonc;
    if(icent == 0) icent = 1;
    //
    //  Compute central weight term
    //
    T1 = (double)(icent + 1);
    centwt = exp(-xnonc + (double)icent * log(xnonc) - gamma_log ( &T1 ) );
    //
    //  Compute central incomplete beta term
    //  Assure that minimum of arg to beta and 1 - arg is computed
    //  accurately.
    //
    prod = *dfn**f;
    dsum = *dfd + prod;
    yy = *dfd / dsum;
    if(yy > half)
      {
        xx = prod / dsum;
        yy = done - xx;
      }
    else  xx = done - yy;
    T2 = *dfn * half + (double)icent;
    T3 = *dfd * half;
    beta_inc ( &T2, &T3, &xx, &yy, &betdn, &dummy, &ierr );
    adn = *dfn / 2.0e0 + (double)icent;
    aup = adn;
    b = *dfd / 2.0e0;
    betup = betdn;
    sum = centwt * betdn;
    //
    //     Now sum terms backward from icent until convergence or all done
    //
    xmult = centwt;
    i = icent;
    T4 = adn + b;
    T5 = adn + 1.0e0;
    dnterm = exp( gamma_log ( &T4 ) - gamma_log ( &T5 )
                  - gamma_log ( &b ) + adn * log ( xx ) + b * log(yy));
  S30:
    if(qsmall(xmult * betdn) || i <= 0) goto S40;
    xmult *= ((double)i / xnonc);
    i -= 1;
    adn -= 1.0;
    dnterm = (adn + 1.0) / ((adn + b) * xx) * dnterm;
    betdn += dnterm;
    sum += (xmult * betdn);
    goto S30;
  S40:
    i = icent + 1;
    //
    //     Now sum forwards until convergence
    //
    xmult = centwt;
    if(aup - 1.0 + b == 0) upterm = exp(-gamma_log ( &aup )
                                        - gamma_log ( &b ) + (aup - 1.0) * log(xx) +
                                        b * log(yy));
    else
      {
        T6 = aup - 1.0 + b;
        upterm = exp( gamma_log ( &T6 ) - gamma_log ( &aup )
                      - gamma_log ( &b ) + (aup - 1.0) * log(xx) + b *
                      log(yy));
      }
    goto S60;
  S50:
    if(qsmall(xmult * betup)) goto S70;
  S60:
    xmult *= (xnonc / (double)i);
    i += 1;
    aup += 1.0;
    upterm = (aup + b - 2.0e0) * xx / (aup - 1.0) * upterm;
    betup -= upterm;
    sum += (xmult * betup);
    goto S50;
  S70:
    *cum = sum;
    *ccum = 0.5e0 + (0.5e0 - *cum);
    return;
# undef qsmall
# undef half
# undef done
  }
  //****************************************************************************

  void cumgam ( double *x, double *a, double *cum, double *ccum )

  //****************************************************************************
  //
  //  Purpose:
  //
  //    CUMGAM evaluates the cumulative incomplete gamma distribution.
  //
  //  Discussion:
  //
  //    This routine computes the cumulative distribution function of the
  //    incomplete gamma distribution, i.e., the integral from 0 to X of
  //
  //      (1/GAM(A))*EXP(-T)*T**(A-1) DT
  //
  //    where GAM(A) is the complete gamma function of A, i.e.,
  //
  //      GAM(A) = integral from 0 to infinity of EXP(-T)*T**(A-1) DT
  //
  //  Parameters:
  //
  //    Input, double *X, the upper limit of integration.
  //
  //    Input, double *A, the shape parameter of the incomplete
  //    Gamma distribution.
  //
  //    Output, double *CUM, *CCUM, the incomplete Gamma CDF and
  //    tail CDF.
  //
  {
    static int K1 = 0;

    if(!(*x <= 0.0e0)) goto S10;
    *cum = 0.0e0;
    *ccum = 1.0e0;
    return;
  S10:
    gamma_inc ( a, x, cum, ccum, &K1 );
    //
    //     Call gratio routine
    //
    return;
  }
  //****************************************************************************

  void cumnbn ( double *s, double *xn, double *pr, double *ompr,
                double *cum, double *ccum )

  //****************************************************************************
  //
  //  Purpose:
  //
  //    CUMNBN evaluates the cumulative negative binomial distribution.
  //
  //  Discussion:
  //
  //    This routine returns the probability that there will be F or
  //    fewer failures before there are S successes, with each binomial
  //    trial having a probability of success PR.
  //
  //    Prob(# failures = F | S successes, PR)  =
  //                        ( S + F - 1 )
  //                        (            ) * PR^S * (1-PR)^F
  //                        (      F     )
  //
  //  Reference:
  //
  //    Milton Abramowitz and Irene Stegun,
  //    Handbook of Mathematical Functions
  //    1966, Formula 26.5.26.
  //
  //  Parameters:
  //
  //    Input, double *F, the number of failures.
  //
  //    Input, double *S, the number of successes.
  //
  //    Input, double *PR, *OMPR, the probability of success on
  //    each binomial trial, and the value of (1-PR).
  //
  //    Output, double *CUM, *CCUM, the negative binomial CDF,
  //    and the tail CDF.
  //
  {
    static double T1;

    T1 = *s + 1.e0;
    cumbet(pr, ompr, xn, &T1, cum, ccum);
    return;
  }
  //****************************************************************************

  void cumnor ( double *arg, double *result, double *ccum )

  //****************************************************************************
  //
  //  Purpose:
  //
  //    CUMNOR computes the cumulative normal distribution.
  //
  //  Discussion:
  //
  //    This function evaluates the normal distribution function:
  //
  //                              / x
  //                     1       |       -t*t/2
  //          P(x) = ----------- |      e       dt
  //                 sqrt(2 pi)  |
  //                             /-oo
  //
  //    This transportable program uses rational functions that
  //    theoretically approximate the normal distribution function to
  //    at least 18 significant decimal digits.  The accuracy achieved
  //    depends on the arithmetic system, the compiler, the intrinsic
  //    functions, and proper selection of the machine-dependent
  //    constants.
  //
  //  @author:
  //
  //    William Cody
  //    Mathematics and Computer Science Division
  //    Argonne National Laboratory
  //    Argonne, IL 60439
  //
  //  Reference:
  //
  //    William Cody,
  //    Rational Chebyshev approximations for the error function,
  //    Mathematics of Computation,
  //    1969, pages 631-637.
  //
  //    William Cody,
  //    Algorithm 715:
  //    SPECFUN - A Portable FORTRAN Package of Special Function Routines
  //      and Test Drivers,
  //    ACM Transactions on Mathematical Software,
  //    Volume 19, 1993, pages 22-32.
  //
  //  Parameters:
  //
  //    Input, double *ARG, the upper limit of integration.
  //
  //    Output, double *CUM, *CCUM, the Normal density CDF and
  //    tail CDF.
  //
  //  Local Parameters:
  //
  //    Local, double EPS, the argument below which anorm(x)
  //    may be represented by 0.5D+00 and above which  x*x  will not underflow.
  //    A conservative value is the largest machine number X
  //    such that   1.0D+00 + X = 1.0D+00   to machine precision.
  //
  {
    static double a[5] =
      {
        2.2352520354606839287e00, 1.6102823106855587881e02, 1.0676894854603709582e03,
        1.8154981253343561249e04, 6.5682337918207449113e-2
      };
    static double b[4] =
      {
        4.7202581904688241870e01, 9.7609855173777669322e02, 1.0260932208618978205e04,
        4.5507789335026729956e04
      };
    static double c[9] =
      {
        3.9894151208813466764e-1, 8.8831497943883759412e00, 9.3506656132177855979e01,
        5.9727027639480026226e02, 2.4945375852903726711e03, 6.8481904505362823326e03,
        1.1602651437647350124e04, 9.8427148383839780218e03, 1.0765576773720192317e-8
      };
    static double d[8] =
      {
        2.2266688044328115691e01, 2.3538790178262499861e02, 1.5193775994075548050e03,
        6.4855582982667607550e03, 1.8615571640885098091e04, 3.4900952721145977266e04,
        3.8912003286093271411e04, 1.9685429676859990727e04
      };
    static double half = 0.5e0;
    static double p[6] =
      {
        2.1589853405795699e-1, 1.274011611602473639e-1, 2.2235277870649807e-2,
        1.421619193227893466e-3, 2.9112874951168792e-5, 2.307344176494017303e-2
      };
    static double one = 1.0e0;
    static double q[5] =
      {
        1.28426009614491121e00, 4.68238212480865118e-1, 6.59881378689285515e-2,
        3.78239633202758244e-3, 7.29751555083966205e-5
      };
    static double sixten = 1.60e0;
    static double sqrpi = 3.9894228040143267794e-1;
    static double thrsh = 0.66291e0;
    static double root32 = 5.656854248e0;
    static double zero = 0.0e0;
    static int K1 = 1;
    static int K2 = 2;
    static int i;
    static double del, eps, temp, x, xden, xnum, y, xsq, min;
    //
    //  Machine dependent constants
    //
    eps = dpmpar(&K1) * 0.5e0;
    min = dpmpar(&K2);
    x = *arg;
    y = fabs(x);
    if(y <= thrsh)
      {
        //
        //  Evaluate  anorm  for  |X| <= 0.66291
        //
        xsq = zero;
        if(y > eps) xsq = x * x;
        xnum = a[4] * xsq;
        xden = xsq;
        for ( i = 0; i < 3; i++ )
          {
            xnum = (xnum + a[i]) * xsq;
            xden = (xden + b[i]) * xsq;
          }
        *result = x * (xnum + a[3]) / (xden + b[3]);
        temp = *result;
        *result = half + temp;
        *ccum = half - temp;
      }
    //
    //  Evaluate  anorm  for 0.66291 <= |X| <= sqrt(32)
    //
    else if(y <= root32)
      {
        xnum = c[8] * y;
        xden = y;
        for ( i = 0; i < 7; i++ )
          {
            xnum = (xnum + c[i]) * y;
            xden = (xden + d[i]) * y;
          }
        *result = (xnum + c[7]) / (xden + d[7]);
        xsq = fifdint(y * sixten) / sixten;
        del = (y - xsq) * (y + xsq);
        *result = exp(-(xsq * xsq * half)) * exp(-(del * half))**result;
        *ccum = one - *result;
        if(x > zero)
          {
            temp = *result;
            *result = *ccum;
            *ccum = temp;
          }
      }
    //
    //  Evaluate  anorm  for |X| > sqrt(32)
    //
    else
      {
        *result = zero;
        xsq = one / (x * x);
        xnum = p[5] * xsq;
        xden = xsq;
        for ( i = 0; i < 4; i++ )
          {
            xnum = (xnum + p[i]) * xsq;
            xden = (xden + q[i]) * xsq;
          }
        *result = xsq * (xnum + p[4]) / (xden + q[4]);
        *result = (sqrpi - *result) / y;
        xsq = fifdint(x * sixten) / sixten;
        del = (x - xsq) * (x + xsq);
        *result = exp(-(xsq * xsq * half)) * exp(-(del * half))**result;
        *ccum = one - *result;
        if(x > zero)
          {
            temp = *result;
            *result = *ccum;
            *ccum = temp;
          }
      }
    if(*result < min) *result = 0.0e0;
    //
    //  Fix up for negative argument, erf, etc.
    //
    if(*ccum < min) *ccum = 0.0e0;
  }
  //****************************************************************************

  void cumpoi ( double *s, double *xlam, double *cum, double *ccum )

  //****************************************************************************
  //
  //  Purpose:
  //
  //    CUMPOI evaluates the cumulative Poisson distribution.
  //
  //  Discussion:
  //
  //    CUMPOI returns the probability of S or fewer events in a Poisson
  //    distribution with mean XLAM.
  //
  //  Reference:
  //
  //    Milton Abramowitz and Irene Stegun,
  //    Handbook of Mathematical Functions,
  //    Formula 26.4.21.
  //
  //  Parameters:
  //
  //    Input, double *S, the upper limit of cumulation of the
  //    Poisson density function.
  //
  //    Input, double *XLAM, the mean of the Poisson distribution.
  //
  //    Output, double *CUM, *CCUM, the Poisson density CDF and
  //    tail CDF.
  //
  {
    static double chi, df;

    df = 2.0e0 * (*s + 1.0e0);
    chi = 2.0e0 * *xlam;
    cumchi(&chi, &df, ccum, cum);
    return;
  }
  //****************************************************************************

  void cumt ( double *t, double *df, double *cum, double *ccum )

  //****************************************************************************
  //
  //  Purpose:
  //
  //    CUMT evaluates the cumulative T distribution.
  //
  //  Reference:
  //
  //    Milton Abramowitz and Irene Stegun,
  //    Handbook of Mathematical Functions,
  //    Formula 26.5.27.
  //
  //  Parameters:
  //
  //    Input, double *T, the upper limit of integration.
  //
  //    Input, double *DF, the number of degrees of freedom of
  //    the T distribution.
  //
  //    Output, double *CUM, *CCUM, the T distribution CDF and
  //    tail CDF.
  //
  {
    static double a;
    static double dfptt;
    static double K2 = 0.5e0;
    static double oma;
    static double T1;
    static double tt;
    static double xx;
    static double yy;

    tt = (*t) * (*t);
    dfptt = ( *df ) + tt;
    xx = *df / dfptt;
    yy = tt / dfptt;
    T1 = 0.5e0 * ( *df );
    cumbet ( &xx, &yy, &T1, &K2, &a, &oma );

    if ( *t <= 0.0e0 )
      {
        *cum = 0.5e0 * a;
        *ccum = oma + ( *cum );
      }
    else
      {
        *ccum = 0.5e0 * a;
        *cum = oma + ( *ccum );
      }
    return;
  }
  //****************************************************************************

  double dbetrm ( double *a, double *b )

  //****************************************************************************
  //
  //  Purpose:
  //
  //    DBETRM computes the Sterling remainder for the complete beta function.
  //
  //  Discussion:
  //
  //    Log(Beta(A,B)) = Lgamma(A) + Lgamma(B) - Lgamma(A+B)
  //    where Lgamma is the log of the (complete) gamma function
  //
  //    Let ZZ be approximation obtained if each log gamma is approximated
  //    by Sterling's formula, i.e.,
  //    Sterling(Z) = LOG( SQRT( 2*PI ) ) + ( Z-0.5D+00 ) * LOG( Z ) - Z
  //
  //    The Sterling remainder is Log(Beta(A,B)) - ZZ.
  //
  //  Parameters:
  //
  //    Input, double *A, *B, the parameters of the Beta function.
  //
  //    Output, double DBETRM, the Sterling remainder.
  //
  {
    static double dbetrm, T1, T2, T3;
    //
    //     Try to sum from smallest to largest
    //
    T1 = *a + *b;
    dbetrm = -dstrem(&T1);
    T2 = fifdmax1(*a, *b);
    dbetrm += dstrem(&T2);
    T3 = fifdmin1(*a, *b);
    dbetrm += dstrem(&T3);
    return dbetrm;
  }
  //****************************************************************************

  double dexpm1 ( double *x )

  //****************************************************************************
  //
  //  Purpose:
  //
  //    DEXPM1 evaluates the function EXP(X) - 1.
  //
  //  Reference:
  //
  //    Armido DiDinato and Alfred Morris,
  //    Algorithm 708:
  //    Significant Digit Computation of the Incomplete Beta Function Ratios,
  //    ACM Transactions on Mathematical Software,
  //    Volume 18, 1993, pages 360-373.
  //
  //  Parameters:
  //
  //    Input, double *X, the value at which exp(X)-1 is desired.
  //
  //    Output, double DEXPM1, the value of exp(X)-1.
  //
  {
    static double p1 = .914041914819518e-09;
    static double p2 = .238082361044469e-01;
    static double q1 = -.499999999085958e+00;
    static double q2 = .107141568980644e+00;
    static double q3 = -.119041179760821e-01;
    static double q4 = .595130811860248e-03;
    static double dexpm1, w;

    if(fabs(*x) > 0.15e0) goto S10;
    dexpm1 = *x * (((p2**x + p1)**x + 1.0e0) / ((((q4**x + q3)**x + q2)**x + q1)**x + 1.0e0));
    return dexpm1;
  S10:
    w = exp(*x);
    if(*x > 0.0e0) goto S20;
    dexpm1 = w - 0.5e0 - 0.5e0;
    return dexpm1;
  S20:
    dexpm1 = w * (0.5e0 + (0.5e0 - 1.0e0 / w));
    return dexpm1;
  }
  //****************************************************************************

  double dinvnr ( double *p, double *q )

  //****************************************************************************
  //
  //  Purpose:
  //
  //    DINVNR computes the inverse of the normal distribution.
  //
  //  Discussion:
  //
  //    Returns X such that CUMNOR(X)  =   P,  i.e., the  integral from -
  //    infinity to X of (1/SQRT(2*PI)) EXP(-U*U/2) dU is P
  //
  //    The rational function on page 95 of Kennedy and Gentle is used as a start
  //    value for the Newton method of finding roots.
  //
  //  Reference:
  //
  //    Kennedy and Gentle,
  //    Statistical Computing,
  //    Marcel Dekker, NY, 1980,
  //    QA276.4  K46
  //
  //  Parameters:
  //
  //    Input, double *P, *Q, the probability, and the tail
  //    probability.
  //
  //    Output, double DINVNR, the argument X for which the
  //    Normal CDF has the value P.
  //
  {
# define maxit 100
# define eps (1.0e-13)
# define r2pi 0.3989422804014326e0
# define nhalf (-0.5e0)
# define dennor(x) (r2pi*exp(nhalf*(x)*(x)))

    static double dinvnr, strtx, xcur, cum, ccum, pp, dx;
    static int i;
    static unsigned long qporq;

    //
    //     FIND MINIMUM OF P AND Q
    //
    qporq = *p <= *q;
    if(!qporq) goto S10;
    pp = *p;
    goto S20;
  S10:
    pp = *q;
  S20:
    //
    //     INITIALIZATION STEP
    //
    strtx = stvaln(&pp);
    xcur = strtx;
    //
    //     NEWTON INTERATIONS
    //
    for ( i = 1; i <= maxit; i++ )
      {
        cumnor(&xcur, &cum, &ccum);
        dx = (cum - pp) / dennor(xcur);
        xcur -= dx;
        if(fabs(dx / xcur) < eps) goto S40;
      }
    dinvnr = strtx;
    //
    //     IF WE GET HERE, NEWTON HAS FAILED
    //
    if(!qporq) dinvnr = -dinvnr;
    return dinvnr;
  S40:
    //
    //     IF WE GET HERE, NEWTON HAS SUCCEDED
    //
    dinvnr = xcur;
    if(!qporq) dinvnr = -dinvnr;
    return dinvnr;
# undef maxit
# undef eps
# undef r2pi
# undef nhalf
# undef dennor
  }
  //****************************************************************************

  void dinvr ( int *status, double *x, double *fx,
               unsigned long *qleft, unsigned long *qhi )

  //****************************************************************************
  //
  //  Purpose:
  //
  //    DINVR bounds the zero of the function and invokes DZROR.
  //
  //  Discussion:
  //
  //    This routine seeks to find bounds on a root of the function and
  //    invokes ZROR to perform the zero finding.  STINVR must have been
  //    called before this routine in order to set its parameters.
  //
  //  Reference:
  //
  //    J C P Bus and T J Dekker,
  //    Two Efficient Algorithms with Guaranteed Convergence for
  //      Finding a Zero of a Function,
  //    ACM Transactions on Mathematical Software,
  //    Volume 1, Number 4, pages 330-345, 1975.
  //
  //  Parameters:
  //
  //    Input/output, integer STATUS.  At the beginning of a zero finding
  //    problem, STATUS should be set to 0 and INVR invoked.  The value
  //    of parameters other than X will be ignored on this call.
  //    If INVR needs the function to be evaluated, it will set STATUS to 1
  //    and return.  The value of the function should be set in FX and INVR
  //    again called without changing any of its other parameters.
  //    If INVR finishes without error, it returns with STATUS 0, and X an
  //    approximate root of F(X).
  //    If INVR cannot bound the function, it returns a negative STATUS and
  //    sets QLEFT and QHI.
  //
  //    Output, double precision X, the value at which F(X) is to be evaluated.
  //
  //    Input, double precision FX, the value of F(X) calculated by the user
  //    on the previous call, when INVR returned with STATUS = 1.
  //
  //    Output, logical QLEFT, is defined only if QMFINV returns FALSE.  In that
  //    case, QLEFT is TRUE if the stepping search terminated unsucessfully
  //    at SMALL, and FALSE if the search terminated unsucessfully at BIG.
  //
  //    Output, logical QHI, is defined only if QMFINV returns FALSE.  In that
  //    case, it is TRUE if Y < F(X) at the termination of the search and FALSE
  //    if F(X) < Y.
  //
  {
    E0000(0, status, x, fx, qleft, qhi, NULL, NULL, NULL, NULL, NULL, NULL, NULL);
  }
  //****************************************************************************

  double dlanor ( double *x )

  //****************************************************************************
  //
  //  Purpose:
  //
  //    DLANOR evaluates the logarithm of the asymptotic Normal CDF.
  //
  //  Discussion:
  //
  //    This routine computes the logarithm of the cumulative normal distribution
  //    from abs ( x ) to infinity for  5 <= abs ( X ).
  //
  //    The relative error at X = 5 is about 0.5D-5.
  //
  //  Reference:
  //
  //    Milton Abramowitz and Irene Stegun,
  //    Handbook of Mathematical Functions
  //    1966, Formula 26.2.12.
  //
  //  Parameters:
  //
  //    Input, double *X, the value at which the Normal CDF is to be
  //    evaluated.  It is assumed that 5 <= abs ( X ).
  //
  //    Output, double DLANOR, the logarithm of the asymptotic
  //    Normal CDF.
  //
  {
# define dlsqpi 0.91893853320467274177e0

    static double coef[12] =
      {
        -1.0e0, 3.0e0, -15.0e0, 105.0e0, -945.0e0, 10395.0e0, -135135.0e0, 2027025.0e0,
        -34459425.0e0, 654729075.0e0, -13749310575.e0, 316234143225.0e0
      };
    static int K1 = 12;
    static double dlanor, approx, correc, xx, xx2, T2;

    xx = fabs(*x);
    if ( xx < 5.0e0 ) ftnstop((char *)" Argument too small in DLANOR");
    approx = -dlsqpi - 0.5e0 * xx * xx - log(xx);
    xx2 = xx * xx;
    T2 = 1.0e0 / xx2;
    correc = eval_pol ( coef, &K1, &T2 ) / xx2;
    correc = alnrel ( &correc );
    dlanor = approx + correc;
    return dlanor;
# undef dlsqpi
  }
  //****************************************************************************

  double dpmpar ( int *i )

  //****************************************************************************
  //
  //  Purpose:
  //
  //    DPMPAR provides machine constants for double precision arithmetic.
  //
  //  Discussion:
  //
  //     DPMPAR PROVIDES THE double Precision MACHINE CONSTANTS FOR
  //     THE COMPUTER BEING USED. IT IS ASSUMED THAT THE ARGUMENT
  //     I IS AN INTEGER HAVING ONE OF THE VALUES 1, 2, OR 3. IF THE
  //     double Precision ARITHMETIC BEING USED HAS M BASE B DIGITS AND
  //     ITS SMALLEST AND LARGEST EXPONENTS ARE EMIN AND EMAX, THEN
  //
  //        DPMPAR(1) = B**(1 - M), THE MACHINE Precision,
  //
  //        DPMPAR(2) = B**(EMIN - 1), THE SMALLEST MAGNITUDE,
  //
  //        DPMPAR(3) = B**EMAX*(1 - B**(-M)), THE LARGEST MAGNITUDE.
  //
  //     WRITTEN BY
  //        ALFRED H. MORRIS, JR.
  //        NAVAL SURFACE WARFARE CENTER
  //        DAHLGREN VIRGINIA
  //
  //     MODIFIED BY BARRY W. BROWN TO RETURN DOUBLE Precision MACHINE
  //     CONSTANTS FOR THE COMPUTER BEING USED.  THIS MODIFICATION WAS
  //     MADE AS PART OF CONVERTING BRATIO TO DOUBLE Precision
  //
  {
    static int K1 = 4;
    static int K2 = 8;
    static int K3 = 9;
    static int K4 = 10;
    static double value, b, binv, bm1, one, w, z;
    static int emax, emin, ibeta, m;

    if(*i > 1) goto S10;
    b = ipmpar(&K1);
    m = ipmpar(&K2);
    value = pow(b, (double)(1 - m));
    return value;
  S10:
    if(*i > 2) goto S20;
    b = ipmpar(&K1);
    emin = ipmpar(&K3);
    one = 1.0;
    binv = one / b;
    w = pow(b, (double)(emin + 2));
    value = w * binv * binv * binv;
    return value;
  S20:
    ibeta = ipmpar(&K1);
    m = ipmpar(&K2);
    emax = ipmpar(&K4);
    b = ibeta;
    bm1 = ibeta - 1;
    one = 1.0;
    z = pow(b, (double)(m - 1));
    w = ((z - one) * b + bm1) / (b * z);
    z = pow(b, (double)(emax - 2));
    value = w * z * b * b;
    return value;
  }
  //****************************************************************************

  void dstinv ( double *zsmall, double *zbig, double *zabsst,
                double *zrelst, double *zstpmu, double *zabsto, double *zrelto )

  //****************************************************************************
  //
  //  Purpose:
  //
  //    DSTINV seeks a value X such that F(X) = Y.
  //
  //  Discussion:
  //
  //      Double Precision - SeT INverse finder - Reverse Communication
  //                              Function
  //     Concise Description - Given a monotone function F finds X
  //     such that F(X) = Y.  Uses Reverse communication -- see invr.
  //     This routine sets quantities needed by INVR.
  //          More Precise Description of INVR -
  //     F must be a monotone function, the results of QMFINV are
  //     otherwise undefined.  QINCR must be .TRUE. if F is non-
  //     decreasing and .FALSE. if F is non-increasing.
  //     QMFINV will return .TRUE. if and only if F(SMALL) and
  //     F(BIG) bracket Y, i. e.,
  //          QINCR is .TRUE. and F(SMALL).LE.Y.LE.F(BIG) or
  //          QINCR is .FALSE. and F(BIG).LE.Y.LE.F(SMALL)
  //     if QMFINV returns .TRUE., then the X returned satisfies
  //     the following condition.  let
  //               TOL(X) = MAX(ABSTOL,RELTOL*ABS(X))
  //     then if QINCR is .TRUE.,
  //          F(X-TOL(X)) .LE. Y .LE. F(X+TOL(X))
  //     and if QINCR is .FALSE.
  //          F(X-TOL(X)) .GE. Y .GE. F(X+TOL(X))
  //                              Arguments
  //     SMALL --> The left endpoint of the interval to be
  //          searched for a solution.
  //                    SMALL is DOUBLE Precision
  //     BIG --> The right endpoint of the interval to be
  //          searched for a solution.
  //                    BIG is DOUBLE Precision
  //     ABSSTP, RELSTP --> The initial step size in the search
  //          is MAX(ABSSTP,RELSTP*ABS(X)). See algorithm.
  //                    ABSSTP is DOUBLE Precision
  //                    RELSTP is DOUBLE Precision
  //     STPMUL --> When a step doesn't bound the zero, the step
  //                size is multiplied by STPMUL and another step
  //                taken.  A popular value is 2.0
  //                    DOUBLE Precision STPMUL
  //     ABSTOL, RELTOL --> Two numbers that determine the accuracy
  //          of the solution.  See function for a precise definition.
  //                    ABSTOL is DOUBLE Precision
  //                    RELTOL is DOUBLE Precision
  //                              Method
  //     Compares F(X) with Y for the input value of X then uses QINCR
  //     to determine whether to step left or right to bound the
  //     desired x.  the initial step size is
  //          MAX(ABSSTP,RELSTP*ABS(S)) for the input value of X.
  //     Iteratively steps right or left until it bounds X.
  //     At each step which doesn't bound X, the step size is doubled.
  //     The routine is careful never to step beyond SMALL or BIG.  If
  //     it hasn't bounded X at SMALL or BIG, QMFINV returns .FALSE.
  //     after setting QLEFT and QHI.
  //     If X is successfully bounded then Algorithm R of the paper
  //     'Two Efficient Algorithms with Guaranteed Convergence for
  //     Finding a Zero of a Function' by J. C. P. Bus and
  //     T. J. Dekker in ACM Transactions on Mathematical
  //     Software, Volume 1, No. 4 page 330 (DEC. '75) is employed
  //     to find the zero of the function F(X)-Y. This is routine
  //     QRZERO.
  //
  {
    E0000(1, NULL, NULL, NULL, NULL, NULL, zabsst, zabsto, zbig, zrelst, zrelto, zsmall,
          zstpmu);
  }
  //****************************************************************************

  double dstrem ( double *z )

  //****************************************************************************
  //
  //  Purpose:
  //
  //    DSTREM computes the Sterling remainder ln ( Gamma ( Z ) ) - Sterling ( Z ).
  //
  //  Discussion:
  //
  //    This routine returns
  //
  //      ln ( Gamma ( Z ) ) - Sterling ( Z )
  //
  //    where Sterling(Z) is Sterling's approximation to ln ( Gamma ( Z ) ).
  //
  //    Sterling(Z) = ln ( sqrt ( 2 * PI ) ) + ( Z - 0.5 ) * ln ( Z ) - Z
  //
  //    If 6 <= Z, the routine uses 9 terms of a series in Bernoulli numbers,
  //    with values calculated using Maple.
  //
  //    Otherwise, the difference is computed explicitly.
  //
  //  Modified:
  //
  //    14 June 2004
  //
  //  Parameters:
  //
  //    Input, double *Z, the value at which the Sterling
  //    remainder is to be calculated.  Z must be positive.
  //
  //    Output, double DSTREM, the Sterling remainder.
  //
  {
# define hln2pi 0.91893853320467274178e0
# define ncoef 10

    static double coef[ncoef] =
      {
        0.0e0, 0.0833333333333333333333333333333e0,
        -0.00277777777777777777777777777778e0, 0.000793650793650793650793650793651e0,
        -0.000595238095238095238095238095238e0,
        0.000841750841750841750841750841751e0, -0.00191752691752691752691752691753e0,
        0.00641025641025641025641025641026e0, -0.0295506535947712418300653594771e0,
        0.179644372368830573164938490016e0
      };
    static int K1 = 10;
    static double dstrem, sterl, T2;
    //
    //    For information, here are the next 11 coefficients of the
    //    remainder term in Sterling's formula
    //            -1.39243221690590111642743221691
    //            13.4028640441683919944789510007
    //            -156.848284626002017306365132452
    //            2193.10333333333333333333333333
    //            -36108.7712537249893571732652192
    //            691472.268851313067108395250776
    //            -0.152382215394074161922833649589D8
    //            0.382900751391414141414141414141D9
    //            -0.108822660357843910890151491655D11
    //            0.347320283765002252252252252252D12
    //            -0.123696021422692744542517103493D14
    //
    if(*z <= 0.0e0) ftnstop((char*)"Zero or negative argument in DSTREM");
    if(!(*z > 6.0e0)) goto S10;
    T2 = 1.0e0 / pow(*z, 2.0);
    dstrem = eval_pol ( coef, &K1, &T2 )**z;
    goto S20;
  S10:
    sterl = hln2pi + (*z - 0.5e0) * log(*z) - *z;
    dstrem = gamma_log ( z ) - sterl;
  S20:
    return dstrem;
# undef hln2pi
# undef ncoef
  }
  //****************************************************************************

  void dstzr ( double *zxlo, double *zxhi, double *zabstl, double *zreltl )

  //****************************************************************************
  //
  //  Purpose:
  //
  //    DSTXR sets quantities needed by the zero finder.
  //
  //  Discussion:
  //
  //     Double precision SeT ZeRo finder - Reverse communication version
  //                              Function
  //     Sets quantities needed by ZROR.  The function of ZROR
  //     and the quantities set is given here.
  //     Concise Description - Given a function F
  //     find XLO such that F(XLO) = 0.
  //          More Precise Description -
  //     Input condition. F is a double function of a single
  //     double argument and XLO and XHI are such that
  //          F(XLO)*F(XHI)  .LE.  0.0
  //     If the input condition is met, QRZERO returns .TRUE.
  //     and output values of XLO and XHI satisfy the following
  //          F(XLO)*F(XHI)  .LE. 0.
  //          ABS(F(XLO)  .LE. ABS(F(XHI)
  //          ABS(XLO-XHI)  .LE. TOL(X)
  //     where
  //          TOL(X) = MAX(ABSTOL,RELTOL*ABS(X))
  //     If this algorithm does not find XLO and XHI satisfying
  //     these conditions then QRZERO returns .FALSE.  This
  //     implies that the input condition was not met.
  //                              Arguments
  //     XLO --> The left endpoint of the interval to be
  //           searched for a solution.
  //                    XLO is DOUBLE Precision
  //     XHI --> The right endpoint of the interval to be
  //           for a solution.
  //                    XHI is DOUBLE Precision
  //     ABSTOL, RELTOL --> Two numbers that determine the accuracy
  //                      of the solution.  See function for a
  //                      precise definition.
  //                    ABSTOL is DOUBLE Precision
  //                    RELTOL is DOUBLE Precision
  //                              Method
  //     Algorithm R of the paper 'Two Efficient Algorithms with
  //     Guaranteed Convergence for Finding a Zero of a Function'
  //     by J. C. P. Bus and T. J. Dekker in ACM Transactions on
  //     Mathematical Software, Volume 1, no. 4 page 330
  //     (Dec. '75) is employed to find the zero of F(X)-Y.
  //
  {
    E0001(1, NULL, NULL, NULL, NULL, NULL, NULL, NULL, zabstl, zreltl, zxhi, zxlo);
  }
  //****************************************************************************

  double dt1 ( double *p, double *q, double *df )

  //****************************************************************************
  //
  //  Purpose:
  //
  //    DT1 computes an approximate inverse of the cumulative T distribution.
  //
  //  Discussion:
  //
  //    Returns the inverse of the T distribution function, i.e.,
  //    the integral from 0 to INVT of the T density is P. This is an
  //    initial approximation.
  //
  //  Parameters:
  //
  //    Input, double *P, *Q, the value whose inverse from the
  //    T distribution CDF is desired, and the value (1-P).
  //
  //    Input, double *DF, the number of degrees of freedom of the
  //    T distribution.
  //
  //    Output, double DT1, the approximate value of X for which
  //    the T density CDF with DF degrees of freedom has value P.
  //
  {
    static double coef[4][5] =
      {
        {1.0, 1.0, 0.0, 0.0, 0.0},
        {3.0, 16.0, 5.0, 0.0, 0.0},
        { -15.0, 17.0, 19.0, 3.0, 0.0},
        { -945.0, -1920.0, 1482.0, 776.0, 79.0}
      };
    static double denom[4] = { 4.0e0, 96.0e0, 384.0e0, 92160.0e0 };
    static int ideg[4] = { 2, 3, 4, 5 };
    static double dt1, denpow, sum, term, x, xp, xx;
    static int i;

    x = fabs(dinvnr(p, q));
    xx = x * x;
    sum = x;
    denpow = 1.0e0;
    for ( i = 0; i < 4; i++ )
      {
        term = eval_pol ( &coef[i][0], &ideg[i], &xx ) * x;
        denpow *= *df;
        sum += (term / (denpow * denom[i]));
      }
    if(!(*p >= 0.5e0)) goto S20;
    xp = sum;
    goto S30;
  S20:
    xp = -sum;
  S30:
    dt1 = xp;
    return dt1;
  }
  //****************************************************************************

  void dzror ( int *status, double *x, double *fx, double *xlo,
               double *xhi, unsigned long *qleft, unsigned long *qhi )

  //****************************************************************************
  //
  //  Purpose:
  //
  //    DZROR seeks the zero of a function using reverse communication.
  //
  //  Discussion:
  //
  //     Performs the zero finding.  STZROR must have been called before
  //     this routine in order to set its parameters.
  //
  //
  //                              Arguments
  //
  //
  //     STATUS <--> At the beginning of a zero finding problem, STATUS
  //                 should be set to 0 and ZROR invoked.  (The value
  //                 of other parameters will be ignored on this call.)
  //
  //                 When ZROR needs the function evaluated, it will set
  //                 STATUS to 1 and return.  The value of the function
  //                 should be set in FX and ZROR again called without
  //                 changing any of its other parameters.
  //
  //                 When ZROR has finished without error, it will return
  //                 with STATUS 0.  In that case (XLO,XHI) bound the answe
  //
  //                 If ZROR finds an error (which implies that F(XLO)-Y an
  //                 F(XHI)-Y have the same sign, it returns STATUS -1.  In
  //                 this case, XLO and XHI are undefined.
  //                         INTEGER STATUS
  //
  //     X <-- The value of X at which F(X) is to be evaluated.
  //                         DOUBLE Precision X
  //
  //     FX --> The value of F(X) calculated when ZROR returns with
  //            STATUS = 1.
  //                         DOUBLE Precision FX
  //
  //     XLO <-- When ZROR returns with STATUS = 0, XLO bounds the
  //             inverval in X containing the solution below.
  //                         DOUBLE Precision XLO
  //
  //     XHI <-- When ZROR returns with STATUS = 0, XHI bounds the
  //             inverval in X containing the solution above.
  //                         DOUBLE Precision XHI
  //
  //     QLEFT <-- .TRUE. if the stepping search terminated unsucessfully
  //                at XLO.  If it is .FALSE. the search terminated
  //                unsucessfully at XHI.
  //                    QLEFT is LOGICAL
  //
  //     QHI <-- .TRUE. if F(X) .GT. Y at the termination of the
  //              search and .FALSE. if F(X) .LT. Y at the
  //              termination of the search.
  //                    QHI is LOGICAL
  //
  //
  {
    E0001(0, status, x, fx, xlo, xhi, qleft, qhi, NULL, NULL, NULL, NULL);
  }
  //****************************************************************************

  void E0000 ( int IENTRY, int *status, double *x, double *fx,
               unsigned long *qleft, unsigned long *qhi, double *zabsst,
               double *zabsto, double *zbig, double *zrelst,
               double *zrelto, double *zsmall, double *zstpmu )

  //****************************************************************************
  //
  //  Purpose:
  //
  //    E0000 is a reverse-communication zero bounder.
  //
  {
# define qxmon(zx,zy,zz) (int)((zx) <= (zy) && (zy) <= (zz))

    static double absstp;
    static double abstol;
    static double big, fbig, fsmall, relstp, reltol, small, step, stpmul, xhi,
      xlb, xlo, xsave, xub, yy;
    static int i99999;
    static unsigned long qbdd, qcond, qdum1, qdum2, qincr, qlim, qok, qup;
    switch(IENTRY)
      {
      case 0:
        goto DINVR;
      case 1:
        goto DSTINV;
      }
  DINVR:
    if(*status > 0) goto S310;
    qcond = !qxmon(small, *x, big);
    if(qcond) ftnstop((char *)" SMALL, X, BIG not monotone in INVR");
    xsave = *x;
    //
    //     See that SMALL and BIG bound the zero and set QINCR
    //
    *x = small;
    //
    //     GET-FUNCTION-VALUE
    //
    i99999 = 1;
    goto S300;
  S10:
    fsmall = *fx;
    *x = big;
    //
    //     GET-FUNCTION-VALUE
    //
    i99999 = 2;
    goto S300;
  S20:
    fbig = *fx;
    qincr = fbig > fsmall;
    if(!qincr) goto S50;
    if(fsmall <= 0.0e0) goto S30;
    *status = -1;
    *qleft = *qhi = 1;
    return;
  S30:
    if(fbig >= 0.0e0) goto S40;
    *status = -1;
    *qleft = *qhi = 0;
    return;
  S40:
    goto S80;
  S50:
    if(fsmall >= 0.0e0) goto S60;
    *status = -1;
    *qleft = 1;
    *qhi = 0;
    return;
  S60:
    if(fbig <= 0.0e0) goto S70;
    *status = -1;
    *qleft = 0;
    *qhi = 1;
    return;
  S80:
  S70:
    *x = xsave;
    step = fifdmax1(absstp, relstp * fabs(*x));
    //
    //      YY = F(X) - Y
    //     GET-FUNCTION-VALUE
    //
    i99999 = 3;
    goto S300;
  S90:
    yy = *fx;
    if(!(yy == 0.0e0)) goto S100;
    *status = 0;
    qok = 1;
    return;
  S100:
    qup = (qincr && yy < 0.0e0) || (!qincr && yy > 0.0e0);
    //
    //     HANDLE CASE IN WHICH WE MUST STEP HIGHER
    //
    if(!qup) goto S170;
    xlb = xsave;
    xub = fifdmin1(xlb + step, big);
    goto S120;
  S110:
    if(qcond) goto S150;
  S120:
    //
    //      YY = F(XUB) - Y
    //
    *x = xub;
    //
    //     GET-FUNCTION-VALUE
    //
    i99999 = 4;
    goto S300;
  S130:
    yy = *fx;
    qbdd = (qincr && yy >= 0.0e0) || (!qincr && yy <= 0.0e0);
    qlim = xub >= big;
    qcond = qbdd || qlim;
    if(qcond) goto S140;
    step = stpmul * step;
    xlb = xub;
    xub = fifdmin1(xlb + step, big);
  S140:
    goto S110;
  S150:
    if(!(qlim && !qbdd)) goto S160;
    *status = -1;
    *qleft = 0;
    *qhi = !qincr;
    *x = big;
    return;
  S160:
    goto S240;
  S170:
    //
    //     HANDLE CASE IN WHICH WE MUST STEP LOWER
    //
    xub = xsave;
    xlb = fifdmax1(xub - step, small);
    goto S190;
  S180:
    if(qcond) goto S220;
  S190:
    //
    //      YY = F(XLB) - Y
    //
    *x = xlb;
    //
    //     GET-FUNCTION-VALUE
    //
    i99999 = 5;
    goto S300;
  S200:
    yy = *fx;
    qbdd = (qincr && yy <= 0.0e0) || (!qincr && yy >= 0.0e0);
    qlim = xlb <= small;
    qcond = qbdd || qlim;
    if(qcond) goto S210;
    step = stpmul * step;
    xub = xlb;
    xlb = fifdmax1(xub - step, small);
  S210:
    goto S180;
  S220:
    if(!(qlim && !qbdd)) goto S230;
    *status = -1;
    *qleft = 1;
    *qhi = qincr;
    *x = small;
    return;
  S240:
  S230:
    dstzr(&xlb, &xub, &abstol, &reltol);
    //
    //  IF WE REACH HERE, XLB AND XUB BOUND THE ZERO OF F.
    //
    *status = 0;
    goto S260;
  S250:
    if(!(*status == 1)) goto S290;
  S260:
    dzror ( status, x, fx, &xlo, &xhi, &qdum1, &qdum2 );
    if(!(*status == 1)) goto S280;
    //
    //     GET-FUNCTION-VALUE
    //
    i99999 = 6;
    goto S300;
  S280:
  S270:
    goto S250;
  S290:
    *x = xlo;
    *status = 0;
    return;
  DSTINV:
    small = *zsmall;
    big = *zbig;
    absstp = *zabsst;
    relstp = *zrelst;
    stpmul = *zstpmu;
    abstol = *zabsto;
    reltol = *zrelto;
    return;
  S300:
    //
    //     TO GET-FUNCTION-VALUE
    //
    *status = 1;
    return;
  S310:
    switch((int)i99999)
      {
      case 1:
        goto S10;
      case 2:
        goto S20;
      case 3:
        goto S90;
      case
        4:
        goto S130;
      case 5:
        goto S200;
      case 6:
        goto S270;
      default:
        break;
      }
# undef qxmon
  }

  void cdftnc(int *which, double *p, double *q, double *t, double *df,
              double *pnonc, int *status, double *bound)
  /**********************************************************************

 void cdftnc(int *which,double *p,double *q,double *t,double *df,
             double *pnonc,int *status,double *bound)

              Cumulative Distribution Function
                 Non-Central T distribution

                              Function

    Calculates any one parameter of the noncentral t distribution give
    values for the others.

                              Arguments

    WHICH --> Integer indicating which  argument
              values is to be calculated from the others.
              Legal range: 1..3
              iwhich = 1 : Calculate P and Q from T,DF,PNONC
              iwhich = 2 : Calculate T from P,Q,DF,PNONC
              iwhich = 3 : Calculate DF from P,Q,T
              iwhich = 4 : Calculate PNONC from P,Q,DF,T

       P <--> The integral from -infinity to t of the noncentral t-den
             Input range: (0,1].

       Q <--> 1-P.
             Input range: (0, 1].
              P + Q = 1.0.

       T <--> Upper limit of integration of the noncentral t-density.
              Input range: ( -infinity, +infinity).
              Search range: [ -1E100, 1E100 ]

       DF <--> Degrees of freedom of the noncentral t-distribution.
               Input range: (0 , +infinity).
               Search range: [1e-100, 1E10]

    PNONC <--> Noncentrality parameter of the noncentral t-distributio
               Input range: [-infinity , +infinity).
               Search range: [-1e4, 1E4]

    STATUS <-- 0 if calculation completed correctly
              -I if input parameter number I is out of range
               1 if answer appears to be lower than lowest
                 search bound
               2 if answer appears to be higher than greatest
                 search bound
               3 if P + Q .ne. 1

    BOUND <-- Undefined if STATUS is 0

              Bound exceeded by parameter number I if STATUS
              is negative.

              Lower search bound if STATUS is 1.

              Upper search bound if STATUS is 2.

                               Method

    Upper tail    of  the  cumulative  noncentral t is calculated usin
    formulae  from page 532  of Johnson, Kotz,  Balakrishnan, Coninuou
    Univariate Distributions, Vol 2, 2nd Edition.  Wiley (1995)

    Computation of other parameters involve a seach for a value that
    produces  the desired  value  of P.   The search relies  on  the
    monotinicity of P with the other parameter.

  **********************************************************************/
  {
#define tent4 1.0e4
#define tol 1.0e-8
#define atol 1.0e-50
#define zero 1.0e-100
#define one ( 1.0e0 - 1.0e-16 )
#define inf 1.0e100
    static double K3 = 0.5e0;
    static double K4 = 5.0e0;
    static double ccum, cum, fx;
    static unsigned long qhi, qleft;
    static double T1, T2, T5, T6, T7, T8, T9, T10, T11, T12, T13, T14;
    /*
      ..
      .. Executable Statements ..
    */
    if(!(*which < 1 || *which > 4)) goto S30;
    if(!(*which < 1)) goto S10;
    *bound = 1.0e0;
    goto S20;
  S10:
    *bound = 5.0e0;
  S20:
    *status = -1;
    return;
  S30:
    if(*which == 1) goto S70;
    if(!(*p < 0.0e0 || *p > one)) goto S60;
    if(!(*p < 0.0e0)) goto S40;
    *bound = 0.0e0;
    goto S50;
  S40:
    *bound = one;
  S50:
    *status = -2;
    return;
  S70:
  S60:
    if(*which == 3) goto S90;
    if(!(*df <= 0.0e0)) goto S80;
    *bound = 0.0e0;
    *status = -5;
    return;
  S90:
  S80:
    if(*which == 4) goto S100;
  S100:
    if(1 == *which)
      {
        cumtnc(t, df, pnonc, p, q);
        *status = 0;
      }
    else if(2 == *which)
      {
        *t = 5.0e0;
        T1 = -inf;
        T2 = inf;
        T5 = atol;
        T6 = tol;
        dstinv(&T1, &T2, &K3, &K3, &K4, &T5, &T6);
        *status = 0;
        dinvr(status, t, &fx, &qleft, &qhi);
      S110:
        if(!(*status == 1)) goto S120;
        cumtnc(t, df, pnonc, &cum, &ccum);
        fx = cum - *p;
        dinvr(status, t, &fx, &qleft, &qhi);
        goto S110;
      S120:
        if(!(*status == -1)) goto S150;
        if(!qleft) goto S130;
        *status = 1;
        *bound = -inf;
        goto S140;
      S130:
        *status = 2;
        *bound = inf;
      S150:
      S140:
        ;
      }
    else if(3 == *which)
      {
        *df = 5.0e0;
        T7 = zero;
        T8 = tent4;
        T9 = atol;
        T10 = tol;
        dstinv(&T7, &T8, &K3, &K3, &K4, &T9, &T10);
        *status = 0;
        dinvr(status, df, &fx, &qleft, &qhi);
      S160:
        if(!(*status == 1)) goto S170;
        cumtnc(t, df, pnonc, &cum, &ccum);
        fx = cum - *p;
        dinvr(status, df, &fx, &qleft, &qhi);
        goto S160;
      S170:
        if(!(*status == -1)) goto S200;
        if(!qleft) goto S180;
        *status = 1;
        *bound = zero;
        goto S190;
      S180:
        *status = 2;
        *bound = inf;
      S200:
      S190:
        ;
      }
    else if(4 == *which)
      {
        *pnonc = 5.0e0;
        T11 = -tent4;
        T12 = tent4;
        T13 = atol;
        T14 = tol;
        dstinv(&T11, &T12, &K3, &K3, &K4, &T13, &T14);
        *status = 0;
        dinvr(status, pnonc, &fx, &qleft, &qhi);
      S210:
        if(!(*status == 1)) goto S220;
        cumtnc(t, df, pnonc, &cum, &ccum);
        fx = cum - *p;
        dinvr(status, pnonc, &fx, &qleft, &qhi);
        goto S210;
      S220:
        if(!(*status == -1)) goto S250;
        if(!qleft) goto S230;
        *status = 1;
        *bound = 0.0e0;
        goto S240;
      S230:
        *status = 2;
        *bound = tent4;
      S240:
        ;
      }
  S250:
    return;
#undef tent4
#undef tol
#undef atol
#undef zero
#undef one
#undef inf
  }
  void cumtnc(double *t, double *df, double *pnonc, double *cum,
              double *ccum)
  /**********************************************************************

   void cumtnc(double *t,double *df,double *pnonc,double *cum,
               double *ccum)

                CUMulative Non-Central T-distribution


                             Function


    Computes the integral from -infinity to T of the non-central
    t-density.


                             Arguments


    T --> Upper limit of integration of the non-central t-density.

    DF --> Degrees of freedom of the non-central t-distribution.

    PNONC --> Non-centrality parameter of the non-central t distibutio

    CUM <-- Cumulative t-distribution.

    CCUM <-- Compliment of Cumulative t-distribution.


                             Method

    Upper tail    of  the  cumulative  noncentral t   using
    formulae from page 532  of Johnson, Kotz,  Balakrishnan, Coninuous
    Univariate Distributions, Vol 2, 2nd Edition.  Wiley (1995)

    This implementation starts the calculation at i = lambda,
    which is near the largest Di.  It then sums forward and backward.
  **********************************************************************/
  {
#define one 1.0e0
#define zero 0.0e0
#define half 0.5e0
#define two 2.0e0
#define onep5 1.5e0
#define conv 1.0e-7
#define tiny 1.0e-10
    static double alghdf, b, bb, bbcent, bcent, cent, d, dcent, dpnonc, dum1, dum2, e, ecent,
      halfdf, lambda, lnomx, lnx, omx, pnonc2, s, scent, ss, sscent, t2, term, tt, twoi, x, xi,
      xlnd, xlne;
    static int ierr;
    static unsigned long qrevs;
    static double T1, T2, T3, T4, T5, T6, T7, T8, T9, T10;
    /*
      ..
      .. Executable Statements ..
    */
    /*
      Case pnonc essentially zero
    */
    if(fabs(*pnonc) <= tiny)
      {
        cumt(t, df, cum, ccum);
        return;
      }
    qrevs = *t < zero;
    if(qrevs)
      {
        tt = -*t;
        dpnonc = -*pnonc;
      }
    else
      {
        tt = *t;
        dpnonc = *pnonc;
      }
    pnonc2 = dpnonc * dpnonc;
    t2 = tt * tt;
    if(fabs(tt) <= tiny)
      {
        T1 = -*pnonc;
        cumnor(&T1, cum, ccum);
        return;
      }
    lambda = half * pnonc2;
    x = *df / (*df + t2);
    omx = one - x;
    lnx = log(x);
    lnomx = log(omx);
    halfdf = half * *df;
    alghdf = gamma_log(&halfdf);
    /********************* Case i = lambda */
    cent = fifidint(lambda);
    if(cent < one) cent = one;
    /* Compute d=T(2i) in log space and offset by exp(-lambda) */
    T2 = cent + one;
    xlnd = cent * log(lambda) - gamma_log(&T2) - lambda;
    dcent = exp(xlnd);
    /* Compute e=t(2i+1) in log space offset by exp(-lambda) */
    T3 = cent + onep5;
    xlne = (cent + half) * log(lambda) - gamma_log(&T3) - lambda;
    ecent = exp(xlne);
    if(dpnonc < zero) ecent = -ecent;
    /* Compute bcent=B(2*cent) */
    T4 = cent + half;
    beta_inc(&halfdf, &T4, &x, &omx, &bcent, &dum1, &ierr);
    /* compute bbcent=B(2*cent+1) */
    T5 = cent + one;
    beta_inc(&halfdf, &T5, &x, &omx, &bbcent, &dum2, &ierr);
    /* Case bcent and bbcent are essentially zero Thus t is effectively infinite */
    if(bcent + bbcent < tiny)
      {
        if(qrevs)
          {
            *cum = zero;
            *ccum = one;
          }
        else
          {
            *cum = one;
            *ccum = zero;
          }
        return;
      }
    /* Case bcent and bbcent are essentially one Thus t is effectively zero */
    if(dum1 + dum2 < tiny)
      {
        T6 = -*pnonc;
        cumnor(&T6, cum, ccum);
        return;
      }
    /* First term in ccum is D*B + E*BB */
    *ccum = dcent * bcent + ecent * bbcent;
    /* compute s(cent) = B(2*(cent+1)) - B(2*cent)) */
    T7 = halfdf + cent + half;
    T8 = cent + onep5;
    scent = gamma_log(&T7) - gamma_log(&T8) - alghdf + halfdf * lnx + (cent + half) *
      lnomx;
    scent = exp(scent);
    /* compute ss(cent) = B(2*cent+3) - B(2*cent+1) */
    T9 = halfdf + cent + one;
    T10 = cent + two;
    sscent = gamma_log(&T9) - gamma_log(&T10) - alghdf + halfdf * lnx + (cent + one) *
      lnomx;
    sscent = exp(sscent);
    /********************* Sum Forward */
    xi = cent + one;
    twoi = two * xi;
    d = dcent;
    e = ecent;
    b = bcent;
    bb = bbcent;
    s = scent;
    ss = sscent;
  S10:
    b += s;
    bb += ss;
    d = lambda / xi * d;
    e = lambda / (xi + half) * e;
    term = d * b + e * bb;
    *ccum += term;
    s = s * omx * (*df + twoi - one) / (twoi + one);
    ss = ss * omx * (*df + twoi) / (twoi + two);
    xi += one;
    twoi = two * xi;
    if(fabs(term) > conv * *ccum) goto S10;
    /********************* Sum Backward */
    xi = cent;
    twoi = two * xi;
    d = dcent;
    e = ecent;
    b = bcent;
    bb = bbcent;
    s = scent * (one + twoi) / ((*df + twoi - one) * omx);
    ss = sscent * (two + twoi) / ((*df + twoi) * omx);
  S20:
    b -= s;
    bb -= ss;
    d *= (xi / lambda);
    e *= ((xi + half) / lambda);
    term = d * b + e * bb;
    *ccum += term;
    xi -= one;
    if(xi < half) goto S30;
    twoi = two * xi;
    s = s * (one + twoi) / ((*df + twoi - one) * omx);
    ss = ss * (two + twoi) / ((*df + twoi) * omx);
    if(fabs(term) > conv * *ccum) goto S20;
  S30:
    if(qrevs)
      {
        *cum = half * *ccum;
        *ccum = one - *cum;
      }
    else
      {
        *ccum = half * *ccum;
        *cum = one - *ccum;
      }
    /*
      Due to roundoff error the answer may not lie between zero and one
      Force it to do so
    */
    *cum = fifdmax1(fifdmin1(*cum, one), zero);
    *ccum = fifdmax1(fifdmin1(*ccum, one), zero);
    return;
#undef one
#undef zero
#undef half
#undef two
#undef onep5
#undef conv
#undef tiny
  }

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

  void E0001 ( int IENTRY, int *status, double *x, double *fx,
               double *xlo, double *xhi, unsigned long *qleft,
               unsigned long *qhi, double *zabstl, double *zreltl,
               double *zxhi, double *zxlo )

  //****************************************************************************
  //
  //  Purpose:
  //
  //    E00001 is a reverse-communication zero finder.
  //
  {
# define ftol(zx) (0.5e0*fifdmax1(abstol,reltol*fabs((zx))))

    static double a, abstol, b, c, d, fa, fb, fc, fd, fda;
    static double fdb, m, mb, p, q, reltol, tol, w, xxhi, xxlo;
    static int ext, i99999;
    static unsigned long first, qrzero;
    switch(IENTRY)
      {
      case 0:
        goto DZROR;
      case 1:
        goto DSTZR;
      }
  DZROR:
    if(*status > 0) goto S280;
    *xlo = xxlo;
    *xhi = xxhi;
    b = *x = *xlo;
    //
    //     GET-FUNCTION-VALUE
    //
    i99999 = 1;
    goto S270;
  S10:
    fb = *fx;
    *xlo = *xhi;
    a = *x = *xlo;
    //
    //     GET-FUNCTION-VALUE
    //
    i99999 = 2;
    goto S270;
  S20:
    //
    //     Check that F(ZXLO) < 0 < F(ZXHI)  or
    //                F(ZXLO) > 0 > F(ZXHI)
    //
    if(!(fb < 0.0e0)) goto S40;
    if(!(*fx < 0.0e0)) goto S30;
    *status = -1;
    *qleft = *fx < fb;
    *qhi = 0;
    return;
  S40:
  S30:
    if(!(fb > 0.0e0)) goto S60;
    if(!(*fx > 0.0e0)) goto S50;
    *status = -1;
    *qleft = *fx > fb;
    *qhi = 1;
    return;
  S60:
  S50:
    fa = *fx;
    first = 1;
  S70:
    c = a;
    fc = fa;
    ext = 0;
  S80:
    if(!(fabs(fc) < fabs(fb))) goto S100;
    if(!(c != a)) goto S90;
    d = a;
    fd = fa;
  S90:
    a = b;
    fa = fb;
    *xlo = c;
    b = *xlo;
    fb = fc;
    c = a;
    fc = fa;
  S100:
    tol = ftol(*xlo);
    m = (c + b) * .5e0;
    mb = m - b;
    if(!(fabs(mb) > tol)) goto S240;
    if(!(ext > 3)) goto S110;
    w = mb;
    goto S190;
  S110:
    tol = fifdsign(tol, mb);
    p = (b - a) * fb;
    if(!first) goto S120;
    q = fa - fb;
    first = 0;
    goto S130;
  S120:
    fdb = (fd - fb) / (d - b);
    fda = (fd - fa) / (d - a);
    p = fda * p;
    q = fdb * fa - fda * fb;
  S130:
    if(!(p < 0.0e0)) goto S140;
    p = -p;
    q = -q;
  S140:
    if(ext == 3) p *= 2.0e0;
    if(!(p * 1.0e0 == 0.0e0 || p <= q * tol)) goto S150;
    w = tol;
    goto S180;
  S150:
    if(!(p < mb * q)) goto S160;
    w = p / q;
    goto S170;
  S160:
    w = mb;
  S190:
  S180:
  S170:
    d = a;
    fd = fa;
    a = b;
    fa = fb;
    b += w;
    *xlo = b;
    *x = *xlo;
    //
    //     GET-FUNCTION-VALUE
    //
    i99999 = 3;
    goto S270;
  S200:
    fb = *fx;
    if(!(fc*fb >= 0.0e0)) goto S210;
    goto S70;
  S210:
    if(!(w == mb)) goto S220;
    ext = 0;
    goto S230;
  S220:
    ext += 1;
  S230:
    goto S80;
  S240:
    *xhi = c;
    qrzero = (fc >= 0.0e0 && fb <= 0.0e0) || (fc < 0.0e0 && fb >= 0.0e0);
    if(!qrzero) goto S250;
    *status = 0;
    goto S260;
  S250:
    *status = -1;
  S260:
    return;
  DSTZR:
    xxlo = *zxlo;
    xxhi = *zxhi;
    abstol = *zabstl;
    reltol = *zreltl;
    return;
  S270:
    //
    //     TO GET-FUNCTION-VALUE
    //
    *status = 1;
    return;
  S280:
    switch((int)i99999)
      {
      case 1:
        goto S10;
      case 2:
        goto S20;
      case 3:
        goto S200;
      default:
        break;
      }
# undef ftol
  }
  //*******************************************************************************

  void erf_values ( int *n_data, double *x, double *fx )

  //*******************************************************************************
  //
  //  Purpose:
  //
  //    ERF_VALUES returns some values of the ERF or "error" function.
  //
  //  Definition:
  //
  //    ERF(X) = ( 2 / sqrt ( PI ) * integral ( 0 <= T <= X ) exp ( - T^2 ) dT
  //
  //  Modified:
  //
  //    31 May 2004
  //
  //  @author:
  //
  //    John Burkardt
  //
  //  Reference:
  //
  //    Milton Abramowitz and Irene Stegun,
  //    Handbook of Mathematical Functions,
  //    US Department of Commerce, 1964.
  //
  //  Parameters:
  //
  //    Input/output, int *N_DATA.  The user sets N_DATA to 0 before the
  //    first call.  On each call, the routine increments N_DATA by 1, and
  //    returns the corresponding data; when there is no more data, the
  //    output value of N_DATA will be 0 again.
  //
  //    Output, double *X, the argument of the function.
  //
  //    Output, double *FX, the value of the function.
  //
  {
# define N_MAX 21

    double fx_vec[N_MAX] =
      {
        0.0000000000E+00, 0.1124629160E+00, 0.2227025892E+00, 0.3286267595E+00,
        0.4283923550E+00, 0.5204998778E+00, 0.6038560908E+00, 0.6778011938E+00,
        0.7421009647E+00, 0.7969082124E+00, 0.8427007929E+00, 0.8802050696E+00,
        0.9103139782E+00, 0.9340079449E+00, 0.9522851198E+00, 0.9661051465E+00,
        0.9763483833E+00, 0.9837904586E+00, 0.9890905016E+00, 0.9927904292E+00,
        0.9953222650E+00
      };
    double x_vec[N_MAX] =
      {
        0.0E+00, 0.1E+00, 0.2E+00, 0.3E+00,
        0.4E+00, 0.5E+00, 0.6E+00, 0.7E+00,
        0.8E+00, 0.9E+00, 1.0E+00, 1.1E+00,
        1.2E+00, 1.3E+00, 1.4E+00, 1.5E+00,
        1.6E+00, 1.7E+00, 1.8E+00, 1.9E+00,
        2.0E+00
      };

    if ( *n_data < 0 )
      {
        *n_data = 0;
      }

    *n_data = *n_data + 1;

    if ( N_MAX < *n_data )
      {
        *n_data = 0;
        *x = 0.0E+00;
        *fx = 0.0E+00;
      }
    else
      {
        *x = x_vec[*n_data - 1];
        *fx = fx_vec[*n_data - 1];
      }
    return;
# undef N_MAX
  }
  //****************************************************************************

  double error_f ( double *x )

  //****************************************************************************
  //
  //  Purpose:
  //
  //    ERROR_F evaluates the error function ERF.
  //
  //  Parameters:
  //
  //    Input, double *X, the argument.
  //
  //    Output, double ERROR_F, the value of the error function at X.
  //
  {
    static double c = .564189583547756e0;
    static double a[5] =
      {
        .771058495001320e-04, -.133733772997339e-02, .323076579225834e-01,
        .479137145607681e-01, .128379167095513e+00
      };
    static double b[3] =
      {
        .301048631703895e-02, .538971687740286e-01, .375795757275549e+00
      };
    static double p[8] =
      {
        -1.36864857382717e-07, 5.64195517478974e-01, 7.21175825088309e+00,
        4.31622272220567e+01, 1.52989285046940e+02, 3.39320816734344e+02,
        4.51918953711873e+02, 3.00459261020162e+02
      };
    static double q[8] =
      {
        1.00000000000000e+00, 1.27827273196294e+01, 7.70001529352295e+01,
        2.77585444743988e+02, 6.38980264465631e+02, 9.31354094850610e+02,
        7.90950925327898e+02, 3.00459260956983e+02
      };
    static double r[5] =
      {
        2.10144126479064e+00, 2.62370141675169e+01, 2.13688200555087e+01,
        4.65807828718470e+00, 2.82094791773523e-01
      };
    static double s[4] =
      {
        9.41537750555460e+01, 1.87114811799590e+02, 9.90191814623914e+01,
        1.80124575948747e+01
      };
    static double erf1, ax, bot, t, top, x2;

    ax = fabs(*x);
    if(ax > 0.5e0) goto S10;
    t = *x**x;
    top = (((a[0] * t + a[1]) * t + a[2]) * t + a[3]) * t + a[4] + 1.0e0;
    bot = ((b[0] * t + b[1]) * t + b[2]) * t + 1.0e0;
    erf1 = *x * (top / bot);
    return erf1;
  S10:
    if(ax > 4.0e0) goto S20;
    top = ((((((p[0] * ax + p[1]) * ax + p[2]) * ax + p[3]) * ax + p[4]) * ax + p[5]) * ax + p[6]) * ax + p[
                                                                                                            7];
    bot = ((((((q[0] * ax + q[1]) * ax + q[2]) * ax + q[3]) * ax + q[4]) * ax + q[5]) * ax + q[6]) * ax + q[
                                                                                                            7];
    erf1 = 0.5e0 + (0.5e0 - exp(-(*x**x)) * top / bot);
    if(*x < 0.0e0) erf1 = -erf1;
    return erf1;
  S20:
    if(ax >= 5.8e0) goto S30;
    x2 = *x**x;
    t = 1.0e0 / x2;
    top = (((r[0] * t + r[1]) * t + r[2]) * t + r[3]) * t + r[4];
    bot = (((s[0] * t + s[1]) * t + s[2]) * t + s[3]) * t + 1.0e0;
    erf1 = (c - top / (x2 * bot)) / ax;
    erf1 = 0.5e0 + (0.5e0 - exp(-x2) * erf1);
    if(*x < 0.0e0) erf1 = -erf1;
    return erf1;
  S30:
    erf1 = fifdsign(1.0e0, *x);
    return erf1;
  }
  //****************************************************************************

  double error_fc ( int *ind, double *x )

  //****************************************************************************
  //
  //  Purpose:
  //
  //    ERROR_FC evaluates the tail error function ERFC.
  //
  //  Modified:
  //
  //    09 December 1999
  //
  //  Parameters:
  //
  //    Input, int *IND, chooses the scaling.
  //    If IND is nonzero, then the value returned has been multiplied by
  //    EXP(X*X).
  //
  //    Input, double *X, the argument of the function.
  //
  //    Output, double ERROR_FC, the value of the tail
  //    error function.
  //
  {
    static double c = .564189583547756e0;
    static double a[5] =
      {
        .771058495001320e-04, -.133733772997339e-02, .323076579225834e-01,
        .479137145607681e-01, .128379167095513e+00
      };
    static double b[3] =
      {
        .301048631703895e-02, .538971687740286e-01, .375795757275549e+00
      };
    static double p[8] =
      {
        -1.36864857382717e-07, 5.64195517478974e-01, 7.21175825088309e+00,
        4.31622272220567e+01, 1.52989285046940e+02, 3.39320816734344e+02,
        4.51918953711873e+02, 3.00459261020162e+02
      };
    static double q[8] =
      {
        1.00000000000000e+00, 1.27827273196294e+01, 7.70001529352295e+01,
        2.77585444743988e+02, 6.38980264465631e+02, 9.31354094850610e+02,
        7.90950925327898e+02, 3.00459260956983e+02
      };
    static double r[5] =
      {
        2.10144126479064e+00, 2.62370141675169e+01, 2.13688200555087e+01,
        4.65807828718470e+00, 2.82094791773523e-01
      };
    static double s[4] =
      {
        9.41537750555460e+01, 1.87114811799590e+02, 9.90191814623914e+01,
        1.80124575948747e+01
      };
    static int K1 = 1;
    static double erfc1, ax, bot, e, t, top, w;

    //
    //                     ABS(X) .LE. 0.5
    //
    ax = fabs(*x);
    if(ax > 0.5e0) goto S10;
    t = *x**x;
    top = (((a[0] * t + a[1]) * t + a[2]) * t + a[3]) * t + a[4] + 1.0e0;
    bot = ((b[0] * t + b[1]) * t + b[2]) * t + 1.0e0;
    erfc1 = 0.5e0 + (0.5e0 - *x * (top / bot));
    if(*ind != 0) erfc1 = exp(t) * erfc1;
    return erfc1;
  S10:
    //
    //                  0.5 .LT. ABS(X) .LE. 4
    //
    if(ax > 4.0e0) goto S20;
    top = ((((((p[0] * ax + p[1]) * ax + p[2]) * ax + p[3]) * ax + p[4]) * ax + p[5]) * ax + p[6]) * ax + p[
                                                                                                            7];
    bot = ((((((q[0] * ax + q[1]) * ax + q[2]) * ax + q[3]) * ax + q[4]) * ax + q[5]) * ax + q[6]) * ax + q[
                                                                                                            7];
    erfc1 = top / bot;
    goto S40;
  S20:
    //
    //                      ABS(X) .GT. 4
    //
    if(*x <= -5.6e0) goto S60;
    if(*ind != 0) goto S30;
    if(*x > 100.0e0) goto S70;
    if(*x**x > -exparg(&K1)) goto S70;
  S30:
    t = pow(1.0e0 / *x, 2.0);
    top = (((r[0] * t + r[1]) * t + r[2]) * t + r[3]) * t + r[4];
    bot = (((s[0] * t + s[1]) * t + s[2]) * t + s[3]) * t + 1.0e0;
    erfc1 = (c - t * top / bot) / ax;
  S40:
    //
    //                      FINAL ASSEMBLY
    //
    if(*ind == 0) goto S50;
    if(*x < 0.0e0) erfc1 = 2.0e0 * exp(*x**x) - erfc1;
    return erfc1;
  S50:
    w = *x**x;
    t = w;
    e = w - t;
    erfc1 = (0.5e0 + (0.5e0 - e)) * exp(-t) * erfc1;
    if(*x < 0.0e0) erfc1 = 2.0e0 - erfc1;
    return erfc1;
  S60:
    //
    //             LIMIT VALUE FOR LARGE NEGATIVE X
    //
    erfc1 = 2.0e0;
    if(*ind != 0) erfc1 = 2.0e0 * exp(*x**x);
    return erfc1;
  S70:
    //
    //             LIMIT VALUE FOR LARGE POSITIVE X
    //                       WHEN IND = 0
    //
    erfc1 = 0.0e0;
    return erfc1;
  }
  //****************************************************************************

  double esum ( int *mu, double *x )

  //****************************************************************************
  //
  //  Purpose:
  //
  //    ESUM evaluates exp ( MU + X ).
  //
  //  Parameters:
  //
  //    Input, int *MU, part of the argument.
  //
  //    Input, double *X, part of the argument.
  //
  //    Output, double ESUM, the value of exp ( MU + X ).
  //
  {
    static double esum, w;

    if(*x > 0.0e0) goto S10;
    if(*mu < 0) goto S20;
    w = (double) * mu + *x;
    if(w > 0.0e0) goto S20;
    esum = exp(w);
    return esum;
  S10:
    if(*mu > 0) goto S20;
    w = (double) * mu + *x;
    if(w < 0.0e0) goto S20;
    esum = exp(w);
    return esum;
  S20:
    w = *mu;
    esum = exp(w) * exp(*x);
    return esum;
  }
  //****************************************************************************

  double eval_pol ( double a[], int *n, double *x )

  //****************************************************************************
  //
  //  Purpose:
  //
  //    EVAL_POL evaluates a polynomial at X.
  //
  //  Discussion:
  //
  //    EVAL_POL = A(0) + A(1)*X + ... + A(N)*X**N
  //
  //  Modified:
  //
  //    15 December 1999
  //
  //  Parameters:
  //
  //    Input, double precision A(0:N), coefficients of the polynomial.
  //
  //    Input, int *N, length of A.
  //
  //    Input, double *X, the point at which the polynomial
  //    is to be evaluated.
  //
  //    Output, double EVAL_POL, the value of the polynomial at X.
  //
  {
    static double devlpl, term;
    static int i;

    term = a[*n - 1];
    for ( i = *n - 1 - 1; i >= 0; i-- )
      {
        term = a[i] + term**x;
      }

    devlpl = term;
    return devlpl;
  }
  //****************************************************************************

  double exparg ( int *l )

  //****************************************************************************
  //
  //  Purpose:
  //
  //    EXPARG returns the largest or smallest legal argument for EXP.
  //
  //  Discussion:
  //
  //    Only an approximate limit for the argument of EXP is desired.
  //
  //  Modified:
  //
  //    09 December 1999
  //
  //  Parameters:
  //
  //    Input, int *L, indicates which limit is desired.
  //    If L = 0, then the largest positive argument for EXP is desired.
  //    Otherwise, the largest negative argument for EXP for which the
  //    result is nonzero is desired.
  //
  //    Output, double EXPARG, the desired value.
  //
  {
    static int K1 = 4;
    static int K2 = 9;
    static int K3 = 10;
    static double exparg, lnb;
    static int b, m;

    b = ipmpar(&K1);
    if(b != 2) goto S10;
    lnb = .69314718055995e0;
    goto S40;
  S10:
    if(b != 8) goto S20;
    lnb = 2.0794415416798e0;
    goto S40;
  S20:
    if(b != 16) goto S30;
    lnb = 2.7725887222398e0;
    goto S40;
  S30:
    lnb = log((double)b);
  S40:
    if(*l == 0) goto S50;
    m = ipmpar(&K2) - 1;
    exparg = 0.99999e0 * ((double)m * lnb);
    return exparg;
  S50:
    m = ipmpar(&K3);
    exparg = 0.99999e0 * ((double)m * lnb);
    return exparg;
  }
  //*******************************************************************************

  void f_cdf_values ( int *n_data, int *a, int *b, double *x, double *fx )

  //*******************************************************************************
  //
  //  Purpose:
  //
  //    F_CDF_VALUES returns some values of the F CDF test function.
  //
  //  Discussion:
  //
  //    The value of F_CDF ( DFN, DFD, X ) can be evaluated in Mathematica by
  //    commands like:
  //
  //      Needs["Statistics`ContinuousDistributions`"]
  //      CDF[FRatioDistribution[ DFN, DFD ], X ]
  //
  //  Modified:
  //
  //    11 June 2004
  //
  //  @author:
  //
  //    John Burkardt
  //
  //  Reference:
  //
  //    Milton Abramowitz and Irene Stegun,
  //    Handbook of Mathematical Functions,
  //    US Department of Commerce, 1964.
  //
  //    Stephen Wolfram,
  //    The Mathematica Book,
  //    Fourth Edition,
  //    Wolfram Media / Cambridge University Press, 1999.
  //
  //  Parameters:
  //
  //    Input/output, int *N_DATA.  The user sets N_DATA to 0 before the
  //    first call.  On each call, the routine increments N_DATA by 1, and
  //    returns the corresponding data; when there is no more data, the
  //    output value of N_DATA will be 0 again.
  //
  //    Output, int *A, int *B, the parameters of the function.
  //
  //    Output, double *X, the argument of the function.
  //
  //    Output, double *FX, the value of the function.
  //
  {
# define N_MAX 20

    int a_vec[N_MAX] =
      {
        1, 1, 5, 1,
        2, 4, 1, 6,
        8, 1, 3, 6,
        1, 1, 1, 1,
        2, 3, 4, 5
      };
    int b_vec[N_MAX] =
      {
        1,  5,  1,  5,
        10, 20,  5,  6,
        16,  5, 10, 12,
        5,  5,  5,  5,
        5,  5,  5,  5
      };
    double fx_vec[N_MAX] =
      {
        0.500000E+00, 0.499971E+00, 0.499603E+00, 0.749699E+00,
        0.750466E+00, 0.751416E+00, 0.899987E+00, 0.899713E+00,
        0.900285E+00, 0.950025E+00, 0.950057E+00, 0.950193E+00,
        0.975013E+00, 0.990002E+00, 0.994998E+00, 0.999000E+00,
        0.568799E+00, 0.535145E+00, 0.514343E+00, 0.500000E+00
      };
    double x_vec[N_MAX] =
      {
        1.00E+00,  0.528E+00, 1.89E+00,  1.69E+00,
        1.60E+00,  1.47E+00,  4.06E+00,  3.05E+00,
        2.09E+00,  6.61E+00,  3.71E+00,  3.00E+00,
        10.01E+00, 16.26E+00, 22.78E+00, 47.18E+00,
        1.00E+00,  1.00E+00,  1.00E+00,  1.00E+00
      };

    if ( *n_data < 0 )
      {
        *n_data = 0;
      }

    *n_data = *n_data + 1;

    if ( N_MAX < *n_data )
      {
        *n_data = 0;
        *a = 0;
        *b = 0;
        *x = 0.0E+00;
        *fx = 0.0E+00;
      }
    else
      {
        *a = a_vec[*n_data - 1];
        *b = b_vec[*n_data - 1];
        *x = x_vec[*n_data - 1];
        *fx = fx_vec[*n_data - 1];
      }
    return;
# undef N_MAX
  }
  //******************************************************************************

  void f_noncentral_cdf_values ( int *n_data, int *a, int *b, double *lambda,
                                 double *x, double *fx )

  //******************************************************************************
  //
  //  Purpose:
  //
  //    F_NONCENTRAL_CDF_VALUES returns some values of the F CDF test function.
  //
  //  Discussion:
  //
  //    The value of NONCENTRAL_F_CDF ( DFN, DFD, LAMDA, X ) can be evaluated
  //    in Mathematica by commands like:
  //
  //      Needs["Statistics`ContinuousDistributions`"]
  //      CDF[NoncentralFRatioDistribution[ DFN, DFD, LAMBDA ], X ]
  //
  //  Modified:
  //
  //    12 June 2004
  //
  //  @author:
  //
  //    John Burkardt
  //
  //  Reference:
  //
  //    Milton Abramowitz and Irene Stegun,
  //    Handbook of Mathematical Functions,
  //    US Department of Commerce, 1964.
  //
  //    Stephen Wolfram,
  //    The Mathematica Book,
  //    Fourth Edition,
  //    Wolfram Media / Cambridge University Press, 1999.
  //
  //  Parameters:
  //
  //    Input/output, int *N_DATA.  The user sets N_DATA to 0 before the
  //    first call.  On each call, the routine increments N_DATA by 1, and
  //    returns the corresponding data; when there is no more data, the
  //    output value of N_DATA will be 0 again.
  //
  //    Output, int *A, int *B, double *LAMBDA, the
  //    parameters of the function.
  //
  //    Output, double *X, the argument of the function.
  //
  //    Output, double *FX, the value of the function.
  //
  {
# define N_MAX 22

    int a_vec[N_MAX] =
      {
        1,  1,  1,  1,
        1,  1,  1,  1,
        1,  1,  2,  2,
        3,  3,  4,  4,
        5,  5,  6,  6,
        8, 16
      };
    int b_vec[N_MAX] =
      {
        1,  5,  5,  5,
        5,  5,  5,  5,
        5,  5,  5, 10,
        5,  5,  5,  5,
        1,  5,  6, 12,
        16,  8
      };
    double fx_vec[N_MAX] =
      {
        0.500000E+00, 0.636783E+00, 0.584092E+00, 0.323443E+00,
        0.450119E+00, 0.607888E+00, 0.705928E+00, 0.772178E+00,
        0.819105E+00, 0.317035E+00, 0.432722E+00, 0.450270E+00,
        0.426188E+00, 0.337744E+00, 0.422911E+00, 0.692767E+00,
        0.363217E+00, 0.421005E+00, 0.426667E+00, 0.446402E+00,
        0.844589E+00, 0.816368E+00
      };
    double lambda_vec[N_MAX] =
      {
        0.00E+00,  0.000E+00, 0.25E+00,  1.00E+00,
        1.00E+00,  1.00E+00,  1.00E+00,  1.00E+00,
        1.00E+00,  2.00E+00,  1.00E+00,  1.00E+00,
        1.00E+00,  2.00E+00,  1.00E+00,  1.00E+00,
        0.00E+00,  1.00E+00,  1.00E+00,  1.00E+00,
        1.00E+00,  1.00E+00
      };
    double x_vec[N_MAX] =
      {
        1.00E+00,  1.00E+00, 1.00E+00,  0.50E+00,
        1.00E+00,  2.00E+00, 3.00E+00,  4.00E+00,
        5.00E+00,  1.00E+00, 1.00E+00,  1.00E+00,
        1.00E+00,  1.00E+00, 1.00E+00,  2.00E+00,
        1.00E+00,  1.00E+00, 1.00E+00,  1.00E+00,
        2.00E+00,  2.00E+00
      };

    if ( *n_data < 0 )
      {
        *n_data = 0;
      }

    *n_data = *n_data + 1;

    if ( N_MAX < *n_data )
      {
        *n_data = 0;
        *a = 0;
        *b = 0;
        *lambda = 0.0E+00;
        *x = 0.0E+00;
        *fx = 0.0E+00;
      }
    else
      {
        *a = a_vec[*n_data - 1];
        *b = b_vec[*n_data - 1];
        *lambda = lambda_vec[*n_data - 1];
        *x = x_vec[*n_data - 1];
        *fx = fx_vec[*n_data - 1];
      }

    return;
# undef N_MAX
  }
  //****************************************************************************

  double fifdint ( double a )

  //****************************************************************************
  //
  //  Purpose:
  //
  //    FIFDINT truncates a double number to an integer.
  //
  //  Parameters:
  //
  // a     -     number to be truncated
  {
    return (double) ((int) a);
  }
  //****************************************************************************

  double fifdmax1 ( double a, double b )

  //****************************************************************************
  //
  //  Purpose:
  //
  //    FIFDMAX1 returns the maximum of two numbers a and b
  //
  //  Parameters:
  //
  //  a     -      first number
  //  b     -      second number
  //
  {
    if ( a < b )
      {
        return b;
      }
    else
      {
        return a;
      }
  }
  //****************************************************************************

  double fifdmin1 ( double a, double b )

  //****************************************************************************
  //
  //  Purpose:
  //
  //    FIFDMIN1 returns the minimum of two numbers.
  //
  //  Parameters:
  //
  //  a     -     first number
  //  b     -     second number
  //
  {
    if (a < b) return a;
    else return b;
  }
  //****************************************************************************

  double fifdsign ( double mag, double sign )

  //****************************************************************************
  //
  //  Purpose:
  //
  //    FIFDSIGN transfers the sign of the variable "sign" to the variable "mag"
  //
  //  Parameters:
  //
  //  mag     -     magnitude
  //  sign    -     sign to be transfered
  //
  {
    if (mag < 0) mag = -mag;
    if (sign < 0) mag = -mag;
    return mag;

  }
  //****************************************************************************

  long fifidint ( double a )

  //****************************************************************************
  //
  //  Purpose:
  //
  //    FIFIDINT truncates a double number to a long integer
  //
  //  Parameters:
  //
  //  a - number to be truncated
  //
  {
    if ( a < 1.0 )
      {
        return (long) 0;
      }
    else
      {
        return ( long ) a;
      }
  }
  //****************************************************************************

  long fifmod ( long a, long b )

  //****************************************************************************
  //
  //  Purpose:
  //
  //    FIFMOD returns the modulo of a and b
  //
  //  Parameters:
  //
  //  a - numerator
  //  b - denominator
  //
  {
    return ( a % b );
  }
  //****************************************************************************

  double fpser ( double *a, double *b, double *x, double *eps )

  //****************************************************************************
  //
  //  Purpose:
  //
  //    FPSER evaluates IX(A,B)(X) for very small B.
  //
  //  Discussion:
  //
  //    This routine is appropriate for use when
  //
  //      B < min ( EPS, EPS * A )
  //
  //    and
  //
  //      X <= 0.5.
  //
  //  Parameters:
  //
  //    Input, double *A, *B, parameters of the function.
  //
  //    Input, double *X, the point at which the function is to
  //    be evaluated.
  //
  //    Input, double *EPS, a tolerance.
  //
  //    Output, double FPSER, the value of IX(A,B)(X).
  //
  {
    static int K1 = 1;
    static double fpser, an, c, s, t, tol;

    fpser = 1.0e0;
    if(*a <= 1.e-3 * *eps) goto S10;
    fpser = 0.0e0;
    t = *a * log(*x);
    if(t < exparg(&K1)) return fpser;
    fpser = exp(t);
  S10:
    //
    //                NOTE THAT 1/B(A,B) = B
    //
    fpser = *b / *a * fpser;
    tol = *eps / *a;
    an = *a + 1.0e0;
    t = *x;
    s = t / an;
  S20:
    an += 1.0e0;
    t = *x * t;
    c = t / an;
    s += c;
    if(fabs(c) > tol) goto S20;
    fpser *= (1.0e0 + *a * s);
    return fpser;
  }
  //****************************************************************************

  void ftnstop ( char * msg)

  //****************************************************************************
  //
  //  Purpose:
  //
  //    FTNSTOP prints a message to standard error and then exits.
  //
  //  Parameters:
  //
  //    Input, char *MSG, the message to be printed.
  //
  {
    if ( msg != NULL )
      {
        fprintf ( stderr, "%s\n", msg );
      }
    exit ( 0 );
  }
  //****************************************************************************

  double gam1 ( double *a )

  //****************************************************************************
  //
  //  Purpose:
  //
  //    GAM1 computes 1 / GAMMA(A+1) - 1 for -0.5D+00 <= A <= 1.5
  //
  //  Parameters:
  //
  //    Input, double *A, forms the argument of the Gamma function.
  //
  //    Output, double GAM1, the value of 1 / GAMMA ( A + 1 ) - 1.
  //
  {
    static double s1 = .273076135303957e+00;
    static double s2 = .559398236957378e-01;
    static double p[7] =
      {
        .577215664901533e+00, -.409078193005776e+00, -.230975380857675e+00,
        .597275330452234e-01, .766968181649490e-02, -.514889771323592e-02,
        .589597428611429e-03
      };
    static double q[5] =
      {
        .100000000000000e+01, .427569613095214e+00, .158451672430138e+00,
        .261132021441447e-01, .423244297896961e-02
      };
    static double r[9] =
      {
        -.422784335098468e+00, -.771330383816272e+00, -.244757765222226e+00,
        .118378989872749e+00, .930357293360349e-03, -.118290993445146e-01,
        .223047661158249e-02, .266505979058923e-03, -.132674909766242e-03
      };
    static double gam1, bot, d, t, top, w, T1;

    t = *a;
    d = *a - 0.5e0;
    if(d > 0.0e0) t = d - 0.5e0;
    T1 = t;
    if(T1 < 0) goto S40;
    else if(T1 == 0) goto S10;
    else  goto S20;
  S10:
    gam1 = 0.0e0;
    return gam1;
  S20:
    top = (((((p[6] * t + p[5]) * t + p[4]) * t + p[3]) * t + p[2]) * t + p[1]) * t + p[0];
    bot = (((q[4] * t + q[3]) * t + q[2]) * t + q[1]) * t + 1.0e0;
    w = top / bot;
    if(d > 0.0e0) goto S30;
    gam1 = *a * w;
    return gam1;
  S30:
    gam1 = t / *a * (w - 0.5e0 - 0.5e0);
    return gam1;
  S40:
    top = (((((((r[8] * t + r[7]) * t + r[6]) * t + r[5]) * t + r[4]) * t + r[3]) * t + r[2]) * t + r[1]) * t +
      r[0];
    bot = (s2 * t + s1) * t + 1.0e0;
    w = top / bot;
    if(d > 0.0e0) goto S50;
    gam1 = *a * (w + 0.5e0 + 0.5e0);
    return gam1;
  S50:
    gam1 = t * w / *a;
    return gam1;
  }
  //****************************************************************************

  void gamma_inc ( double *a, double *x, double *ans, double *qans, int *ind )

  //****************************************************************************
  //
  //  Purpose:
  //
  //    GAMMA_INC evaluates the incomplete gamma ratio functions P(A,X) and Q(A,X).
  //
  //  Discussion:
  //
  //    This is certified spaghetti code.
  //
  //  @author:
  //
  //    Alfred H Morris, Jr,
  //    Naval Surface Weapons Center,
  //    Dahlgren, Virginia.
  //
  //  Parameters:
  //
  //    Input, double *A, *X, the arguments of the incomplete
  //    gamma ratio.  A and X must be nonnegative.  A and X cannot
  //    both be zero.
  //
  //    Output, double *ANS, *QANS.  On normal output,
  //    ANS = P(A,X) and QANS = Q(A,X).  However, ANS is set to 2 if
  //    A or X is negative, or both are 0, or when the answer is
  //    computationally indeterminate because A is extremely large
  //    and X is very close to A.
  //
  //    Input, int *IND, indicates the accuracy request:
  //    0, as much accuracy as possible.
  //    1, to within 1 unit of the 6-th significant digit,
  //    otherwise, to within 1 unit of the 3rd significant digit.
  //
  {
    static double alog10 = 2.30258509299405e0;
    static double d10 = -.185185185185185e-02;
    static double d20 = .413359788359788e-02;
    static double d30 = .649434156378601e-03;
    static double d40 = -.861888290916712e-03;
    static double d50 = -.336798553366358e-03;
    static double d60 = .531307936463992e-03;
    static double d70 = .344367606892378e-03;
    static double rt2pin = .398942280401433e0;
    static double rtpi = 1.77245385090552e0;
    static double third = .333333333333333e0;
    static double acc0[3] =
      {
        5.e-15, 5.e-7, 5.e-4
      };
    static double big[3] =
      {
        20.0e0, 14.0e0, 10.0e0
      };
    static double d0[13] =
      {
        .833333333333333e-01, -.148148148148148e-01, .115740740740741e-02,
        .352733686067019e-03, -.178755144032922e-03, .391926317852244e-04,
        -.218544851067999e-05, -.185406221071516e-05, .829671134095309e-06,
        -.176659527368261e-06, .670785354340150e-08, .102618097842403e-07,
        -.438203601845335e-08
      };
    static double d1[12] =
      {
        -.347222222222222e-02, .264550264550265e-02, -.990226337448560e-03,
        .205761316872428e-03, -.401877572016461e-06, -.180985503344900e-04,
        .764916091608111e-05, -.161209008945634e-05, .464712780280743e-08,
        .137863344691572e-06, -.575254560351770e-07, .119516285997781e-07
      };
    static double d2[10] =
      {
        -.268132716049383e-02, .771604938271605e-03, .200938786008230e-05,
        -.107366532263652e-03, .529234488291201e-04, -.127606351886187e-04,
        .342357873409614e-07, .137219573090629e-05, -.629899213838006e-06,
        .142806142060642e-06
      };
    static double d3[8] =
      {
        .229472093621399e-03, -.469189494395256e-03, .267720632062839e-03,
        -.756180167188398e-04, -.239650511386730e-06, .110826541153473e-04,
        -.567495282699160e-05, .142309007324359e-05
      };
    static double d4[6] =
      {
        .784039221720067e-03, -.299072480303190e-03, -.146384525788434e-05,
        .664149821546512e-04, -.396836504717943e-04, .113757269706784e-04
      };
    static double d5[4] =
      {
        -.697281375836586e-04, .277275324495939e-03, -.199325705161888e-03,
        .679778047793721e-04
      };
    static double d6[2] =
      {
        -.592166437353694e-03, .270878209671804e-03
      };
    static double e00[3] =
      {
        .25e-3, .25e-1, .14e0
      };
    static double x00[3] =
      {
        31.0e0, 17.0e0, 9.7e0
      };
    static int K1 = 1;
    static int K2 = 0;
    static double a2n, a2nm1, acc, am0, amn, an, an0, apn, b2n, b2nm1, c, c0, c1, c2, c3, c4, c5, c6,
      cma, e, e0, g, h, j, l, r, rta, rtx, s, sum, t, t1, tol, twoa, u, w, x0, y, z;
    static int i, iop, m, max, n;
    static double wk[20], T3;
    static int T4, T5;
    static double T6, T7;

    //
    //  E IS A MACHINE DEPENDENT CONSTANT. E IS THE SMALLEST
    //  NUMBER FOR WHICH 1.0 + E .GT. 1.0 .
    //
    e = dpmpar(&K1);
    if(*a < 0.0e0 || *x < 0.0e0) goto S430;
    if(*a == 0.0e0 && *x == 0.0e0) goto S430;
    if(*a**x == 0.0e0) goto S420;
    iop = *ind + 1;
    if(iop != 1 && iop != 2) iop = 3;
    acc = fifdmax1(acc0[iop - 1], e);
    e0 = e00[iop - 1];
    x0 = x00[iop - 1];
    //
    //  SELECT THE APPROPRIATE ALGORITHM
    //
    if(*a >= 1.0e0) goto S10;
    if(*a == 0.5e0) goto S390;
    if(*x < 1.1e0) goto S160;
    t1 = *a * log(*x) - *x;
    u = *a * exp(t1);
    if(u == 0.0e0) goto S380;
    r = u * (1.0e0 + gam1(a));
    goto S250;
  S10:
    if(*a >= big[iop - 1]) goto S30;
    if(*a > *x || *x >= x0) goto S20;
    twoa = *a + *a;
    m = fifidint(twoa);
    if(twoa != (double)m) goto S20;
    i = m / 2;
    if(*a == (double)i) goto S210;
    goto S220;
  S20:
    t1 = *a * log(*x) - *x;
    r = exp(t1) / gamma_x(a);
    goto S40;
  S30:
    l = *x / *a;
    if(l == 0.0e0) goto S370;
    s = 0.5e0 + (0.5e0 - l);
    z = rlog(&l);
    if(z >= 700.0e0 / *a) goto S410;
    y = *a * z;
    rta = sqrt(*a);
    if(fabs(s) <= e0 / rta) goto S330;
    if(fabs(s) <= 0.4e0) goto S270;
    t = pow(1.0e0 / *a, 2.0);
    t1 = (((0.75e0 * t - 1.0e0) * t + 3.5e0) * t - 105.0e0) / (*a * 1260.0e0);
    t1 -= y;
    r = rt2pin * rta * exp(t1);
  S40:
    if(r == 0.0e0) goto S420;
    if(*x <= fifdmax1(*a, alog10)) goto S50;
    if(*x < x0) goto S250;
    goto S100;
  S50:
    //
    //  TAYLOR SERIES FOR P/R
    //
    apn = *a + 1.0e0;
    t = *x / apn;
    wk[0] = t;
    for ( n = 2; n <= 20; n++ )
      {
        apn += 1.0e0;
        t *= (*x / apn);
        if(t <= 1.e-3) goto S70;
        wk[n - 1] = t;
      }
    n = 20;
  S70:
    sum = t;
    tol = 0.5e0 * acc;
  S80:
    apn += 1.0e0;
    t *= (*x / apn);
    sum += t;
    if(t > tol) goto S80;
    max = n - 1;
    for ( m = 1; m <= max; m++ )
      {
        n -= 1;
        sum += wk[n - 1];
      }
    *ans = r / *a * (1.0e0 + sum);
    *qans = 0.5e0 + (0.5e0 - *ans);
    return;
  S100:
    //
    //  ASYMPTOTIC EXPANSION
    //
    amn = *a - 1.0e0;
    t = amn / *x;
    wk[0] = t;
    for ( n = 2; n <= 20; n++ )
      {
        amn -= 1.0e0;
        t *= (amn / *x);
        if(fabs(t) <= 1.e-3) goto S120;
        wk[n - 1] = t;
      }
    n = 20;
  S120:
    sum = t;
  S130:
    if(fabs(t) <= acc) goto S140;
    amn -= 1.0e0;
    t *= (amn / *x);
    sum += t;
    goto S130;
  S140:
    max = n - 1;
    for ( m = 1; m <= max; m++ )
      {
        n -= 1;
        sum += wk[n - 1];
      }
    *qans = r / *x * (1.0e0 + sum);
    *ans = 0.5e0 + (0.5e0 - *qans);
    return;
  S160:
    //
    //  TAYLOR SERIES FOR P(A,X)/X**A
    //
    an = 3.0e0;
    c = *x;
    sum = *x / (*a + 3.0e0);
    tol = 3.0e0 * acc / (*a + 1.0e0);
  S170:
    an += 1.0e0;
    c = -(c * (*x / an));
    t = c / (*a + an);
    sum += t;
    if(fabs(t) > tol) goto S170;
    j = *a**x * ((sum / 6.0e0 - 0.5e0 / (*a + 2.0e0))**x + 1.0e0 / (*a + 1.0e0));
    z = *a * log(*x);
    h = gam1(a);
    g = 1.0e0 + h;
    if(*x < 0.25e0) goto S180;
    if(*a < *x / 2.59e0) goto S200;
    goto S190;
  S180:
    if(z > -.13394e0) goto S200;
  S190:
    w = exp(z);
    *ans = w * g * (0.5e0 + (0.5e0 - j));
    *qans = 0.5e0 + (0.5e0 - *ans);
    return;
  S200:
    l = rexp(&z);
    w = 0.5e0 + (0.5e0 + l);
    *qans = (w * j - l) * g - h;
    if(*qans < 0.0e0) goto S380;
    *ans = 0.5e0 + (0.5e0 - *qans);
    return;
  S210:
    //
    //  FINITE SUMS FOR Q WHEN A .GE. 1 AND 2*A IS AN INTEGER
    //
    sum = exp(-*x);
    t = sum;
    n = 1;
    c = 0.0e0;
    goto S230;
  S220:
    rtx = sqrt(*x);
    sum = error_fc ( &K2, &rtx );
    t = exp(-*x) / (rtpi * rtx);
    n = 0;
    c = -0.5e0;
  S230:
    if(n == i) goto S240;
    n += 1;
    c += 1.0e0;
    t = *x * t / c;
    sum += t;
    goto S230;
  S240:
    *qans = sum;
    *ans = 0.5e0 + (0.5e0 - *qans);
    return;
  S250:
    //
    //  CONTINUED FRACTION EXPANSION
    //
    tol = fifdmax1(5.0e0 * e, acc);
    a2nm1 = a2n = 1.0e0;
    b2nm1 = *x;
    b2n = *x + (1.0e0 - *a);
    c = 1.0e0;
  S260:
    a2nm1 = *x * a2n + c * a2nm1;
    b2nm1 = *x * b2n + c * b2nm1;
    am0 = a2nm1 / b2nm1;
    c += 1.0e0;
    cma = c - *a;
    a2n = a2nm1 + cma * a2n;
    b2n = b2nm1 + cma * b2n;
    an0 = a2n / b2n;
    if(fabs(an0 - am0) >= tol * an0) goto S260;
    *qans = r * an0;
    *ans = 0.5e0 + (0.5e0 - *qans);
    return;
  S270:
    //
    //  GENERAL TEMME EXPANSION
    //
    if(fabs(s) <= 2.0e0 * e && *a * e * e > 3.28e-3) goto S430;
    c = exp(-y);
    T3 = sqrt(y);
    w = 0.5e0 * error_fc ( &K1, &T3 );
    u = 1.0e0 / *a;
    z = sqrt(z + z);
    if(l < 1.0e0) z = -z;
    T4 = iop - 2;
    if(T4 < 0) goto S280;
    else if(T4 == 0) goto S290;
    else  goto S300;
  S280:
    if(fabs(s) <= 1.e-3) goto S340;
    c0 = ((((((((((((d0[12] * z + d0[11]) * z + d0[10]) * z + d0[9]) * z + d0[8]) * z + d0[7]) * z + d0[
                                                                                                        6]) * z + d0[5]) * z + d0[4]) * z + d0[3]) * z + d0[2]) * z + d0[1]) * z + d0[0]) * z - third;
    c1 = (((((((((((d1[11] * z + d1[10]) * z + d1[9]) * z + d1[8]) * z + d1[7]) * z + d1[6]) * z + d1[5]
               ) * z + d1[4]) * z + d1[3]) * z + d1[2]) * z + d1[1]) * z + d1[0]) * z + d10;
    c2 = (((((((((d2[9] * z + d2[8]) * z + d2[7]) * z + d2[6]) * z + d2[5]) * z + d2[4]) * z + d2[3]) * z +
            d2[2]) * z + d2[1]) * z + d2[0]) * z + d20;
    c3 = (((((((d3[7] * z + d3[6]) * z + d3[5]) * z + d3[4]) * z + d3[3]) * z + d3[2]) * z + d3[1]) * z +
          d3[0]) * z + d30;
    c4 = (((((d4[5] * z + d4[4]) * z + d4[3]) * z + d4[2]) * z + d4[1]) * z + d4[0]) * z + d40;
    c5 = (((d5[3] * z + d5[2]) * z + d5[1]) * z + d5[0]) * z + d50;
    c6 = (d6[1] * z + d6[0]) * z + d60;
    t = ((((((d70 * u + c6) * u + c5) * u + c4) * u + c3) * u + c2) * u + c1) * u + c0;
    goto S310;
  S290:
    c0 = (((((d0[5] * z + d0[4]) * z + d0[3]) * z + d0[2]) * z + d0[1]) * z + d0[0]) * z - third;
    c1 = (((d1[3] * z + d1[2]) * z + d1[1]) * z + d1[0]) * z + d10;
    c2 = d2[0] * z + d20;
    t = (c2 * u + c1) * u + c0;
    goto S310;
  S300:
    t = ((d0[2] * z + d0[1]) * z + d0[0]) * z - third;
  S310:
    if(l < 1.0e0) goto S320;
    *qans = c * (w + rt2pin * t / rta);
    *ans = 0.5e0 + (0.5e0 - *qans);
    return;
  S320:
    *ans = c * (w - rt2pin * t / rta);
    *qans = 0.5e0 + (0.5e0 - *ans);
    return;
  S330:
    //
    //  TEMME EXPANSION FOR L = 1
    //
    if(*a * e * e > 3.28e-3) goto S430;
    c = 0.5e0 + (0.5e0 - y);
    w = (0.5e0 - sqrt(y) * (0.5e0 + (0.5e0 - y / 3.0e0)) / rtpi) / c;
    u = 1.0e0 / *a;
    z = sqrt(z + z);
    if(l < 1.0e0) z = -z;
    T5 = iop - 2;
    if(T5 < 0) goto S340;
    else if(T5 == 0) goto S350;
    else  goto S360;
  S340:
    c0 = ((((((d0[6] * z + d0[5]) * z + d0[4]) * z + d0[3]) * z + d0[2]) * z + d0[1]) * z + d0[0]) * z -
      third;
    c1 = (((((d1[5] * z + d1[4]) * z + d1[3]) * z + d1[2]) * z + d1[1]) * z + d1[0]) * z + d10;
    c2 = ((((d2[4] * z + d2[3]) * z + d2[2]) * z + d2[1]) * z + d2[0]) * z + d20;
    c3 = (((d3[3] * z + d3[2]) * z + d3[1]) * z + d3[0]) * z + d30;
    c4 = (d4[1] * z + d4[0]) * z + d40;
    c5 = (d5[1] * z + d5[0]) * z + d50;
    c6 = d6[0] * z + d60;
    t = ((((((d70 * u + c6) * u + c5) * u + c4) * u + c3) * u + c2) * u + c1) * u + c0;
    goto S310;
  S350:
    c0 = (d0[1] * z + d0[0]) * z - third;
    c1 = d1[0] * z + d10;
    t = (d20 * u + c1) * u + c0;
    goto S310;
  S360:
    t = d0[0] * z - third;
    goto S310;
  S370:
    //
    //  SPECIAL CASES
    //
    *ans = 0.0e0;
    *qans = 1.0e0;
    return;
  S380:
    *ans = 1.0e0;
    *qans = 0.0e0;
    return;
  S390:
    if(*x >= 0.25e0) goto S400;
    T6 = sqrt(*x);
    *ans = error_f ( &T6 );
    *qans = 0.5e0 + (0.5e0 - *ans);
    return;
  S400:
    T7 = sqrt(*x);
    *qans = error_fc ( &K2, &T7 );
    *ans = 0.5e0 + (0.5e0 - *qans);
    return;
  S410:
    if(fabs(s) <= 2.0e0 * e) goto S430;
  S420:
    if(*x <= *a) goto S370;
    goto S380;
  S430:
    //
    //  ERROR RETURN
    //
    *ans = 2.0e0;
    return;
  }
  //****************************************************************************

  void gamma_inc_inv ( double *a, double *x, double *x0, double *p, double *q,
                       int *ierr )

  //****************************************************************************
  //
  //  Purpose:
  //
  //    GAMMA_INC_INV computes the inverse incomplete gamma ratio function.
  //
  //  Discussion:
  //
  //    The routine is given positive A, and nonnegative P and Q where P + Q = 1.
  //    The value X is computed with the property that P(A,X) = P and Q(A,X) = Q.
  //    Schroder iteration is employed.  The routine attempts to compute X
  //    to 10 significant digits if this is possible for the particular computer
  //    arithmetic being used.
  //
  //  @author:
  //
  //    Alfred H Morris, Jr,
  //    Naval Surface Weapons Center,
  //    Dahlgren, Virginia.
  //
  //  Parameters:
  //
  //    Input, double *A, the parameter in the incomplete gamma
  //    ratio.  A must be positive.
  //
  //    Output, double *X, the computed point for which the
  //    incomplete gamma functions have the values P and Q.
  //
  //    Input, double *X0, an optional initial approximation
  //    for the solution X.  If the user does not want to supply an
  //    initial approximation, then X0 should be set to 0, or a negative
  //    value.
  //
  //    Input, double *P, *Q, the values of the incomplete gamma
  //    functions, for which the corresponding argument is desired.
  //
  //    Output, int *IERR, error flag.
  //    0, the solution was obtained. Iteration was not used.
  //    0 < K, The solution was obtained. IERR iterations were performed.
  //    -2, A <= 0
  //    -3, No solution was obtained. The ratio Q/A is too large.
  //    -4, P + Q /= 1
  //    -6, 20 iterations were performed. The most recent value obtained
  //        for X is given.  This cannot occur if X0 <= 0.
  //    -7, Iteration failed. No value is given for X.
  //        This may occur when X is approximately 0.
  //    -8, A value for X has been obtained, but the routine is not certain
  //        of its accuracy.  Iteration cannot be performed in this
  //        case. If X0 <= 0, this can occur only when P or Q is
  //        approximately 0. If X0 is positive then this can occur when A is
  //        exceedingly close to X and A is extremely large (say A .GE. 1.E20).
  //
  {
    static double a0 = 3.31125922108741e0;
    static double a1 = 11.6616720288968e0;
    static double a2 = 4.28342155967104e0;
    static double a3 = .213623493715853e0;
    static double b1 = 6.61053765625462e0;
    static double b2 = 6.40691597760039e0;
    static double b3 = 1.27364489782223e0;
    static double b4 = .036117081018842e0;
    static double c = .577215664901533e0;
    static double ln10 = 2.302585e0;
    static double tol = 1.e-5;
    static double amin[2] =
      {
        500.0e0, 100.0e0
      };
    static double bmin[2] =
      {
        1.e-28, 1.e-13
      };
    static double dmin[2] =
      {
        1.e-06, 1.e-04
      };
    static double emin[2] =
      {
        2.e-03, 6.e-03
      };
    static double eps0[2] =
      {
        1.e-10, 1.e-08
      };
    static int K1 = 1;
    static int K2 = 2;
    static int K3 = 3;
    static int K8 = 0;
    static double am1, amax, ap1, ap2, ap3, apn, b, c1, c2, c3, c4, c5, d, e, e2, eps, g, h, pn, qg, qn,
      r, rta, s, s2, sum, t, u, w, xmax, xmin, xn, y, z;
    static int iop;
    static double T4, T5, T6, T7, T9;

    //
    //  E, XMIN, AND XMAX ARE MACHINE DEPENDENT CONSTANTS.
    //            E IS THE SMALLEST NUMBER FOR WHICH 1.0 + E .GT. 1.0.
    //            XMIN IS THE SMALLEST POSITIVE NUMBER AND XMAX IS THE
    //            LARGEST POSITIVE NUMBER.
    //
    e = dpmpar(&K1);
    xmin = dpmpar(&K2);
    xmax = dpmpar(&K3);
    *x = 0.0e0;
    if(*a <= 0.0e0) goto S300;
    t = *p + *q - 1.e0;
    if(fabs(t) > e) goto S320;
    *ierr = 0;
    if(*p == 0.0e0) return;
    if(*q == 0.0e0) goto S270;
    if(*a == 1.0e0) goto S280;
    e2 = 2.0e0 * e;
    amax = 0.4e-10 / (e * e);
    iop = 1;
    if(e > 1.e-10) iop = 2;
    eps = eps0[iop - 1];
    xn = *x0;
    if(*x0 > 0.0e0) goto S160;
    //
    //        SELECTION OF THE INITIAL APPROXIMATION XN OF X
    //                       WHEN A .LT. 1
    //
    if(*a > 1.0e0) goto S80;
    T4 = *a + 1.0e0;
    g = gamma_x(&T4);
    qg = *q * g;
    if(qg == 0.0e0) goto S360;
    b = qg / *a;
    if(qg > 0.6e0 * *a) goto S40;
    if(*a >= 0.30e0 || b < 0.35e0) goto S10;
    t = exp(-(b + c));
    u = t * exp(t);
    xn = t * exp(u);
    goto S160;
  S10:
    if(b >= 0.45e0) goto S40;
    if(b == 0.0e0) goto S360;
    y = -log(b);
    s = 0.5e0 + (0.5e0 - *a);
    z = log(y);
    t = y - s * z;
    if(b < 0.15e0) goto S20;
    xn = y - s * log(t) - log(1.0e0 + s / (t + 1.0e0));
    goto S220;
  S20:
    if(b <= 0.01e0) goto S30;
    u = ((t + 2.0e0 * (3.0e0 - *a)) * t + (2.0e0 - *a) * (3.0e0 - *a)) / ((t + (5.0e0 - *a)) * t + 2.0e0);
    xn = y - s * log(t) - log(u);
    goto S220;
  S30:
    c1 = -(s * z);
    c2 = -(s * (1.0e0 + c1));
    c3 = s * ((0.5e0 * c1 + (2.0e0 - *a)) * c1 + (2.5e0 - 1.5e0 * *a));
    c4 = -(s * (((c1 / 3.0e0 + (2.5e0 - 1.5e0 * *a)) * c1 + ((*a - 6.0e0)**a + 7.0e0)) * c1 + (
                                                                                               (11.0e0 * *a - 46.0)**a + 47.0e0) / 6.0e0));
    c5 = -(s * ((((-(c1 / 4.0e0) + (11.0e0 * *a - 17.0e0) / 6.0e0) * c1 + ((-(3.0e0 * *a) + 13.0e0) *
                                                                           *a - 13.0e0)) * c1 + 0.5e0 * (((2.0e0 * *a - 25.0e0)**a + 72.0e0)**a - 61.0e0)) * c1 + ((
                                                                                                                                                                    (25.0e0 * *a - 195.0e0)**a + 477.0e0)**a - 379.0e0) / 12.0e0));
    xn = (((c5 / y + c4) / y + c3) / y + c2) / y + c1 + y;
    if(*a > 1.0e0) goto S220;
    if(b > bmin[iop - 1]) goto S220;
    *x = xn;
    return;
  S40:
    if(b**q > 1.e-8) goto S50;
    xn = exp(-(*q / *a + c));
    goto S70;
  S50:
    if(*p <= 0.9e0) goto S60;
    T5 = -*q;
    xn = exp((alnrel(&T5) + gamma_ln1 ( a ) ) / *a );
    goto S70;
  S60:
    xn = exp(log(*p * g) / *a);
  S70:
    if(xn == 0.0e0) goto S310;
    t = 0.5e0 + (0.5e0 - xn / (*a + 1.0e0));
    xn /= t;
    goto S160;
  S80:
    //
    //        SELECTION OF THE INITIAL APPROXIMATION XN OF X
    //                       WHEN A .GT. 1
    //
    if(*q <= 0.5e0) goto S90;
    w = log(*p);
    goto S100;
  S90:
    w = log(*q);
  S100:
    t = sqrt(-(2.0e0 * w));
    s = t - (((a3 * t + a2) * t + a1) * t + a0) / ((((b4 * t + b3) * t + b2) * t + b1) * t + 1.0e0);
    if(*q > 0.5e0) s = -s;
    rta = sqrt(*a);
    s2 = s * s;
    xn = *a + s * rta + (s2 - 1.0e0) / 3.0e0 + s * (s2 - 7.0e0) / (36.0e0 * rta) - ((3.0e0 * s2 + 7.0e0) *
                                                                                    s2 - 16.0e0) / (810.0e0 * *a) + s * ((9.0e0 * s2 + 256.0e0) * s2 - 433.0e0) / (38880.0e0 * *a *
                                                                                                                                                                   rta);
    xn = fifdmax1(xn, 0.0e0);
    if(*a < amin[iop - 1]) goto S110;
    *x = xn;
    d = 0.5e0 + (0.5e0 - *x / *a);
    if(fabs(d) <= dmin[iop - 1]) return;
  S110:
    if(*p <= 0.5e0) goto S130;
    if(xn < 3.0e0 * *a) goto S220;
    y = -(w + gamma_log ( a ) );
    d = fifdmax1(2.0e0, *a * (*a - 1.0e0));
    if(y < ln10 * d) goto S120;
    s = 1.0e0 - *a;
    z = log(y);
    goto S30;
  S120:
    t = *a - 1.0e0;
    T6 = -(t / (xn + 1.0e0));
    xn = y + t * log(xn) - alnrel(&T6);
    T7 = -(t / (xn + 1.0e0));
    xn = y + t * log(xn) - alnrel(&T7);
    goto S220;
  S130:
    ap1 = *a + 1.0e0;
    if(xn > 0.70e0 * ap1) goto S170;
    w += gamma_log ( &ap1 );
    if(xn > 0.15e0 * ap1) goto S140;
    ap2 = *a + 2.0e0;
    ap3 = *a + 3.0e0;
    *x = exp((w + *x) / *a);
    *x = exp((w + *x - log(1.0e0 + *x / ap1 * (1.0e0 + *x / ap2))) / *a);
    *x = exp((w + *x - log(1.0e0 + *x / ap1 * (1.0e0 + *x / ap2))) / *a);
    *x = exp((w + *x - log(1.0e0 + *x / ap1 * (1.0e0 + *x / ap2 * (1.0e0 + *x / ap3)))) / *a);
    xn = *x;
    if(xn > 1.e-2 * ap1) goto S140;
    if(xn <= emin[iop - 1]*ap1) return;
    goto S170;
  S140:
    apn = ap1;
    t = xn / apn;
    sum = 1.0e0 + t;
  S150:
    apn += 1.0e0;
    t *= (xn / apn);
    sum += t;
    if(t > 1.e-4) goto S150;
    t = w - log(sum);
    xn = exp((xn + t) / *a);
    xn *= (1.0e0 - (*a * log(xn) - xn - t) / (*a - xn));
    goto S170;
  S160:
    //
    //                 SCHRODER ITERATION USING P
    //
    if(*p > 0.5e0) goto S220;
  S170:
    if(*p <= 1.e10 * xmin) goto S350;
    am1 = *a - 0.5e0 - 0.5e0;
  S180:
    if(*a <= amax) goto S190;
    d = 0.5e0 + (0.5e0 - xn / *a);
    if(fabs(d) <= e2) goto S350;
  S190:
    if(*ierr >= 20) goto S330;
    *ierr += 1;
    gamma_inc ( a, &xn, &pn, &qn, &K8 );
    if(pn == 0.0e0 || qn == 0.0e0) goto S350;
    r = rcomp(a, &xn);
    if(r == 0.0e0) goto S350;
    t = (pn - *p) / r;
    w = 0.5e0 * (am1 - xn);
    if(fabs(t) <= 0.1e0 && fabs(w * t) <= 0.1e0) goto S200;
    *x = xn * (1.0e0 - t);
    if(*x <= 0.0e0) goto S340;
    d = fabs(t);
    goto S210;
  S200:
    h = t * (1.0e0 + w * t);
    *x = xn * (1.0e0 - h);
    if(*x <= 0.0e0) goto S340;
    if(fabs(w) >= 1.0e0 && fabs(w)*t*t <= eps) return;
    d = fabs(h);
  S210:
    xn = *x;
    if(d > tol) goto S180;
    if(d <= eps) return;
    if(fabs(*p - pn) <= tol**p) return;
    goto S180;
  S220:
    //
    //                 SCHRODER ITERATION USING Q
    //
    if(*q <= 1.e10 * xmin) goto S350;
    am1 = *a - 0.5e0 - 0.5e0;
  S230:
    if(*a <= amax) goto S240;
    d = 0.5e0 + (0.5e0 - xn / *a);
    if(fabs(d) <= e2) goto S350;
  S240:
    if(*ierr >= 20) goto S330;
    *ierr += 1;
    gamma_inc ( a, &xn, &pn, &qn, &K8 );
    if(pn == 0.0e0 || qn == 0.0e0) goto S350;
    r = rcomp(a, &xn);
    if(r == 0.0e0) goto S350;
    t = (*q - qn) / r;
    w = 0.5e0 * (am1 - xn);
    if(fabs(t) <= 0.1e0 && fabs(w * t) <= 0.1e0) goto S250;
    *x = xn * (1.0e0 - t);
    if(*x <= 0.0e0) goto S340;
    d = fabs(t);
    goto S260;
  S250:
    h = t * (1.0e0 + w * t);
    *x = xn * (1.0e0 - h);
    if(*x <= 0.0e0) goto S340;
    if(fabs(w) >= 1.0e0 && fabs(w)*t*t <= eps) return;
    d = fabs(h);
  S260:
    xn = *x;
    if(d > tol) goto S230;
    if(d <= eps) return;
    if(fabs(*q - qn) <= tol**q) return;
    goto S230;
  S270:
    //
    //                       SPECIAL CASES
    //
    *x = xmax;
    return;
  S280:
    if(*q < 0.9e0) goto S290;
    T9 = -*p;
    *x = -alnrel(&T9);
    return;
  S290:
    *x = -log(*q);
    return;
  S300:
    //
    //                       ERROR RETURN
    //
    *ierr = -2;
    return;
  S310:
    *ierr = -3;
    return;
  S320:
    *ierr = -4;
    return;
  S330:
    *ierr = -6;
    return;
  S340:
    *ierr = -7;
    return;
  S350:
    *x = xn;
    *ierr = -8;
    return;
  S360:
    *x = xmax;
    *ierr = -8;
    return;
  }
  //*******************************************************************************

  void gamma_inc_values ( int *n_data, double *a, double *x, double *fx )

  //*******************************************************************************
  //
  //  Purpose:
  //
  //    GAMMA_INC_VALUES returns some values of the incomplete Gamma function.
  //
  //  Discussion:
  //
  //    The (normalized) incomplete Gamma function P(A,X) is defined as:
  //
  //      PN(A,X) = 1/GAMMA(A) * Integral ( 0 <= T <= X ) T**(A-1) * exp(-T) dT.
  //
  //    With this definition, for all A and X,
  //
  //      0 <= PN(A,X) <= 1
  //
  //    and
  //
  //      PN(A,INFINITY) = 1.0
  //
  //    Mathematica can compute this value as
  //
  //      1 - GammaRegularized[A,X]
  //
  //  Modified:
  //
  //    31 May 2004
  //
  //  @author:
  //
  //    John Burkardt
  //
  //  Reference:
  //
  //    Milton Abramowitz and Irene Stegun,
  //    Handbook of Mathematical Functions,
  //    US Department of Commerce, 1964.
  //
  //  Parameters:
  //
  //    Input/output, int *N_DATA.  The user sets N_DATA to 0 before the
  //    first call.  On each call, the routine increments N_DATA by 1, and
  //    returns the corresponding data; when there is no more data, the
  //    output value of N_DATA will be 0 again.
  //
  //    Output, double *A, the parameter of the function.
  //
  //    Output, double *X, the argument of the function.
  //
  //    Output, double *FX, the value of the function.
  //
  {
# define N_MAX 20

    double a_vec[N_MAX] =
      {
        0.1E+00,  0.1E+00,  0.1E+00,  0.5E+00,
        0.5E+00,  0.5E+00,  1.0E+00,  1.0E+00,
        1.0E+00,  1.1E+00,  1.1E+00,  1.1E+00,
        2.0E+00,  2.0E+00,  2.0E+00,  6.0E+00,
        6.0E+00, 11.0E+00, 26.0E+00, 41.0E+00
      };
    double fx_vec[N_MAX] =
      {
        0.7420263E+00, 0.9119753E+00, 0.9898955E+00, 0.2931279E+00,
        0.7656418E+00, 0.9921661E+00, 0.0951626E+00, 0.6321206E+00,
        0.9932621E+00, 0.0757471E+00, 0.6076457E+00, 0.9933425E+00,
        0.0091054E+00, 0.4130643E+00, 0.9931450E+00, 0.0387318E+00,
        0.9825937E+00, 0.9404267E+00, 0.4863866E+00, 0.7359709E+00
      };
    double x_vec[N_MAX] =
      {
        3.1622777E-02, 3.1622777E-01, 1.5811388E+00, 7.0710678E-02,
        7.0710678E-01, 3.5355339E+00, 0.1000000E+00, 1.0000000E+00,
        5.0000000E+00, 1.0488088E-01, 1.0488088E+00, 5.2440442E+00,
        1.4142136E-01, 1.4142136E+00, 7.0710678E+00, 2.4494897E+00,
        1.2247449E+01, 1.6583124E+01, 2.5495098E+01, 4.4821870E+01
      };

    if ( *n_data < 0 )
      {
        *n_data = 0;
      }

    *n_data = *n_data + 1;

    if ( N_MAX < *n_data )
      {
        *n_data = 0;
        *a = 0.0E+00;
        *x = 0.0E+00;
        *fx = 0.0E+00;
      }
    else
      {
        *a = a_vec[*n_data - 1];
        *x = x_vec[*n_data - 1];
        *fx = fx_vec[*n_data - 1];
      }
    return;
# undef N_MAX
  }
  //****************************************************************************

  double gamma_ln1 ( double *a )

  //****************************************************************************
  //
  //  Purpose:
  //
  //    GAMMA_LN1 evaluates ln ( Gamma ( 1 + A ) ), for -0.2 <= A <= 1.25.
  //
  //  Parameters:
  //
  //    Input, double *A, defines the argument of the function.
  //
  //    Output, double GAMMA_LN1, the value of ln ( Gamma ( 1 + A ) ).
  //
  {
    static double p0 = .577215664901533e+00;
    static double p1 = .844203922187225e+00;
    static double p2 = -.168860593646662e+00;
    static double p3 = -.780427615533591e+00;
    static double p4 = -.402055799310489e+00;
    static double p5 = -.673562214325671e-01;
    static double p6 = -.271935708322958e-02;
    static double q1 = .288743195473681e+01;
    static double q2 = .312755088914843e+01;
    static double q3 = .156875193295039e+01;
    static double q4 = .361951990101499e+00;
    static double q5 = .325038868253937e-01;
    static double q6 = .667465618796164e-03;
    static double r0 = .422784335098467e+00;
    static double r1 = .848044614534529e+00;
    static double r2 = .565221050691933e+00;
    static double r3 = .156513060486551e+00;
    static double r4 = .170502484022650e-01;
    static double r5 = .497958207639485e-03;
    static double s1 = .124313399877507e+01;
    static double s2 = .548042109832463e+00;
    static double s3 = .101552187439830e+00;
    static double s4 = .713309612391000e-02;
    static double s5 = .116165475989616e-03;
    static double gamln1, w, x;

    if(*a >= 0.6e0) goto S10;
    w = ((((((p6**a + p5)**a + p4)**a + p3)**a + p2)**a + p1)**a + p0) / ((((((q6**a + q5)**a +
                                                                              q4)**a + q3)**a + q2)**a + q1)**a + 1.0e0);
    gamln1 = -(*a * w);
    return gamln1;
  S10:
    x = *a - 0.5e0 - 0.5e0;
    w = (((((r5 * x + r4) * x + r3) * x + r2) * x + r1) * x + r0) / (((((s5 * x + s4) * x + s3) * x + s2) * x + s1) * x
                                                                     + 1.0e0);
    gamln1 = x * w;
    return gamln1;
  }
  //****************************************************************************

  double gamma_log ( double *a )

  //****************************************************************************
  //
  //  Purpose:
  //
  //    GAMMA_LOG evaluates ln ( Gamma ( A ) ) for positive A.
  //
  //  @author:
  //
  //    Alfred H Morris, Jr,
  //    Naval Surface Weapons Center,
  //    Dahlgren, Virginia.
  //
  //  Reference:
  //
  //    Armido DiDinato and Alfred Morris,
  //    Algorithm 708:
  //    Significant Digit Computation of the Incomplete Beta Function Ratios,
  //    ACM Transactions on Mathematical Software,
  //    Volume 18, 1993, pages 360-373.
  //
  //  Parameters:
  //
  //    Input, double *A, the argument of the function.
  //    A should be positive.
  //
  //    Output, double GAMMA_LOG, the value of ln ( Gamma ( A ) ).
  //
  {
    static double c0 = .833333333333333e-01;
    static double c1 = -.277777777760991e-02;
    static double c2 = .793650666825390e-03;
    static double c3 = -.595202931351870e-03;
    static double c4 = .837308034031215e-03;
    static double c5 = -.165322962780713e-02;
    static double d = .418938533204673e0;
    static double gamln, t, w;
    static int i, n;
    static double T1;

    if(*a > 0.8e0) goto S10;
    gamln = gamma_ln1 ( a ) - log ( *a );
    return gamln;
  S10:
    if(*a > 2.25e0) goto S20;
    t = *a - 0.5e0 - 0.5e0;
    gamln = gamma_ln1 ( &t );
    return gamln;
  S20:
    if(*a >= 10.0e0) goto S40;
    n = ( int ) ( *a - 1.25e0 );
    t = *a;
    w = 1.0e0;
    for ( i = 1; i <= n; i++ )
      {
        t -= 1.0e0;
        w = t * w;
      }
    T1 = t - 1.0e0;
    gamln = gamma_ln1 ( &T1 ) + log ( w );
    return gamln;
  S40:
    t = pow(1.0e0 / *a, 2.0);
    w = (((((c5 * t + c4) * t + c3) * t + c2) * t + c1) * t + c0) / *a;
    gamln = d + w + (*a - 0.5e0) * (log(*a) - 1.0e0);
    return gamln;
  }
  //****************************************************************************

  void gamma_rat1 ( double *a, double *x, double *r, double *p, double *q,
                    double *eps )

  //****************************************************************************
  //
  //  Purpose:
  //
  //    GAMMA_RAT1 evaluates the incomplete gamma ratio functions P(A,X) and Q(A,X).
  //
  //  Parameters:
  //
  //    Input, double *A, *X, the parameters of the functions.
  //    It is assumed that A <= 1.
  //
  //    Input, double *R, the value exp(-X) * X**A / Gamma(A).
  //
  //    Output, double *P, *Q, the values of P(A,X) and Q(A,X).
  //
  //    Input, double *EPS, the tolerance.
  //
  {
    static int K2 = 0;
    static double a2n, a2nm1, am0, an, an0, b2n, b2nm1, c, cma, g, h, j, l, sum, t, tol, w, z, T1, T3;

    if(*a**x == 0.0e0) goto S120;
    if(*a == 0.5e0) goto S100;
    if(*x < 1.1e0) goto S10;
    goto S60;
  S10:
    //
    //             TAYLOR SERIES FOR P(A,X)/X**A
    //
    an = 3.0e0;
    c = *x;
    sum = *x / (*a + 3.0e0);
    tol = 0.1e0 * *eps / (*a + 1.0e0);
  S20:
    an += 1.0e0;
    c = -(c * (*x / an));
    t = c / (*a + an);
    sum += t;
    if(fabs(t) > tol) goto S20;
    j = *a**x * ((sum / 6.0e0 - 0.5e0 / (*a + 2.0e0))**x + 1.0e0 / (*a + 1.0e0));
    z = *a * log(*x);
    h = gam1(a);
    g = 1.0e0 + h;
    if(*x < 0.25e0) goto S30;
    if(*a < *x / 2.59e0) goto S50;
    goto S40;
  S30:
    if(z > -.13394e0) goto S50;
  S40:
    w = exp(z);
    *p = w * g * (0.5e0 + (0.5e0 - j));
    *q = 0.5e0 + (0.5e0 - *p);
    return;
  S50:
    l = rexp(&z);
    w = 0.5e0 + (0.5e0 + l);
    *q = (w * j - l) * g - h;
    if(*q < 0.0e0) goto S90;
    *p = 0.5e0 + (0.5e0 - *q);
    return;
  S60:
    //
    //              CONTINUED FRACTION EXPANSION
    //
    a2nm1 = a2n = 1.0e0;
    b2nm1 = *x;
    b2n = *x + (1.0e0 - *a);
    c = 1.0e0;
  S70:
    a2nm1 = *x * a2n + c * a2nm1;
    b2nm1 = *x * b2n + c * b2nm1;
    am0 = a2nm1 / b2nm1;
    c += 1.0e0;
    cma = c - *a;
    a2n = a2nm1 + cma * a2n;
    b2n = b2nm1 + cma * b2n;
    an0 = a2n / b2n;
    if(fabs(an0 - am0) >= *eps * an0) goto S70;
    *q = *r * an0;
    *p = 0.5e0 + (0.5e0 - *q);
    return;
  S80:
    //
    //                SPECIAL CASES
    //
    *p = 0.0e0;
    *q = 1.0e0;
    return;
  S90:
    *p = 1.0e0;
    *q = 0.0e0;
    return;
  S100:
    if(*x >= 0.25e0) goto S110;
    T1 = sqrt(*x);
    *p = error_f ( &T1 );
    *q = 0.5e0 + (0.5e0 - *p);
    return;
  S110:
    T3 = sqrt(*x);
    *q = error_fc ( &K2, &T3 );
    *p = 0.5e0 + (0.5e0 - *q);
    return;
  S120:
    if(*x <= *a) goto S80;
    goto S90;
  }
  //*******************************************************************************

  void gamma_values ( int *n_data, double *x, double *fx )

  //*******************************************************************************
  //
  //  Purpose:
  //
  //    GAMMA_VALUES returns some values of the Gamma function.
  //
  //  Definition:
  //
  //    GAMMA(Z) = Integral ( 0 <= T < Infinity) T**(Z-1) EXP(-T) dT
  //
  //  Recursion:
  //
  //    GAMMA(X+1) = X*GAMMA(X)
  //
  //  Restrictions:
  //
  //    0 < X ( a software restriction).
  //
  //  Special values:
  //
  //    GAMMA(0.5) = sqrt(PI)
  //
  //    For N a positive integer, GAMMA(N+1) = N!, the standard factorial.
  //
  //  Modified:
  //
  //    31 May 2004
  //
  //  @author:
  //
  //    John Burkardt
  //
  //  Reference:
  //
  //    Milton Abramowitz and Irene Stegun,
  //    Handbook of Mathematical Functions,
  //    US Department of Commerce, 1964.
  //
  //  Parameters:
  //
  //    Input/output, int *N_DATA.  The user sets N_DATA to 0 before the
  //    first call.  On each call, the routine increments N_DATA by 1, and
  //    returns the corresponding data; when there is no more data, the
  //    output value of N_DATA will be 0 again.
  //
  //    Output, double *X, the argument of the function.
  //
  //    Output, double *FX, the value of the function.
  //
  {
# define N_MAX 18

    double fx_vec[N_MAX] =
      {
        4.590845E+00,     2.218160E+00,     1.489192E+00,     1.164230E+00,
        1.0000000000E+00, 0.9513507699E+00, 0.9181687424E+00, 0.8974706963E+00,
        0.8872638175E+00, 0.8862269255E+00, 0.8935153493E+00, 0.9086387329E+00,
        0.9313837710E+00, 0.9617658319E+00, 1.0000000000E+00, 3.6288000E+05,
        1.2164510E+17,    8.8417620E+30
      };
    double x_vec[N_MAX] =
      {
        0.2E+00,  0.4E+00,  0.6E+00,  0.8E+00,
        1.0E+00,  1.1E+00,  1.2E+00,  1.3E+00,
        1.4E+00,  1.5E+00,  1.6E+00,  1.7E+00,
        1.8E+00,  1.9E+00,  2.0E+00, 10.0E+00,
        20.0E+00, 30.0E+00
      };

    if ( *n_data < 0 )
      {
        *n_data = 0;
      }

    *n_data = *n_data + 1;

    if ( N_MAX < *n_data )
      {
        *n_data = 0;
        *x = 0.0E+00;
        *fx = 0.0E+00;
      }
    else
      {
        *x = x_vec[*n_data - 1];
        *fx = fx_vec[*n_data - 1];
      }
    return;
# undef N_MAX
  }
  //****************************************************************************

  double gamma_x ( double *a )

  //****************************************************************************
  //
  //  Purpose:
  //
  //    GAMMA_X evaluates the gamma function.
  //
  //  Discussion:
  //
  //    This routine was renamed from "GAMMA" to avoid a conflict with the
  //    C/C++ math library routine.
  //
  //  @author:
  //
  //    Alfred H Morris, Jr,
  //    Naval Surface Weapons Center,
  //    Dahlgren, Virginia.
  //
  //  Parameters:
  //
  //    Input, double *A, the argument of the Gamma function.
  //
  //    Output, double GAMMA_X, the value of the Gamma function.
  //
  {
    static double d = .41893853320467274178e0;
    static double pi = 3.1415926535898e0;
    static double r1 = .820756370353826e-03;
    static double r2 = -.595156336428591e-03;
    static double r3 = .793650663183693e-03;
    static double r4 = -.277777777770481e-02;
    static double r5 = .833333333333333e-01;
    static double p[7] =
      {
        .539637273585445e-03, .261939260042690e-02, .204493667594920e-01,
        .730981088720487e-01, .279648642639792e+00, .553413866010467e+00, 1.0e0
      };
    static double q[7] =
      {
        -.832979206704073e-03, .470059485860584e-02, .225211131035340e-01,
        -.170458969313360e+00, -.567902761974940e-01, .113062953091122e+01, 1.0e0
      };
    static int K2 = 3;
    static int K3 = 0;
    static double Xgamm, bot, g, lnx, s, t, top, w, x, z;
    static int i, j, m, n, T1;

    Xgamm = 0.0e0;
    x = *a;
    if(fabs(*a) >= 15.0e0) goto S110;
    //
    //            EVALUATION OF GAMMA(A) FOR ABS(A) .LT. 15
    //
    t = 1.0e0;
    m = fifidint(*a) - 1;
    //
    //     LET T BE THE PRODUCT OF A-J WHEN A .GE. 2
    //
    T1 = m;
    if(T1 < 0) goto S40;
    else if(T1 == 0) goto S30;
    else  goto S10;
  S10:
    for ( j = 1; j <= m; j++ )
      {
        x -= 1.0e0;
        t = x * t;
      }
  S30:
    x -= 1.0e0;
    goto S80;
  S40:
    //
    //     LET T BE THE PRODUCT OF A+J WHEN A .LT. 1
    //
    t = *a;
    if(*a > 0.0e0) goto S70;
    m = -m - 1;
    if(m == 0) goto S60;
    for ( j = 1; j <= m; j++ )
      {
        x += 1.0e0;
        t = x * t;
      }
  S60:
    x += (0.5e0 + 0.5e0);
    t = x * t;
    if(t == 0.0e0) return Xgamm;
  S70:
    //
    //     THE FOLLOWING CODE CHECKS IF 1/T CAN OVERFLOW. THIS
    //     CODE MAY BE OMITTED IF DESIRED.
    //
    if(fabs(t) >= 1.e-30) goto S80;
    if(fabs(t)*dpmpar(&K2) <= 1.0001e0) return Xgamm;
    Xgamm = 1.0e0 / t;
    return Xgamm;
  S80:
    //
    //     COMPUTE GAMMA(1 + X) FOR  0 .LE. X .LT. 1
    //
    top = p[0];
    bot = q[0];
    for ( i = 1; i < 7; i++ )
      {
        top = p[i] + x * top;
        bot = q[i] + x * bot;
      }
    Xgamm = top / bot;
    //
    //     TERMINATION
    //
    if(*a < 1.0e0) goto S100;
    Xgamm *= t;
    return Xgamm;
  S100:
    Xgamm /= t;
    return Xgamm;
  S110:
    //
    //  EVALUATION OF GAMMA(A) FOR ABS(A) .GE. 15
    //
    if(fabs(*a) >= 1.e3) return Xgamm;
    if(*a > 0.0e0) goto S120;
    x = -*a;
    n = ( int ) x;
    t = x - (double)n;
    if(t > 0.9e0) t = 1.0e0 - t;
    s = sin(pi * t) / pi;
    if(fifmod(n, 2) == 0) s = -s;
    if(s == 0.0e0) return Xgamm;
  S120:
    //
    //     COMPUTE THE MODIFIED ASYMPTOTIC SUM
    //
    t = 1.0e0 / (x * x);
    g = ((((r1 * t + r2) * t + r3) * t + r4) * t + r5) / x;
    //
    //     ONE MAY REPLACE THE NEXT STATEMENT WITH  LNX = ALOG(X)
    //     BUT LESS ACCURACY WILL NORMALLY BE OBTAINED.
    //
    lnx = log(x);
    //
    //  FINAL ASSEMBLY
    //
    z = x;
    g = d + g + (z - 0.5e0) * (lnx - 1.e0);
    w = g;
    t = g - w;
    if(w > 0.99999e0 * exparg(&K3)) return Xgamm;
    Xgamm = exp(w) * (1.0e0 + t);
    if(*a < 0.0e0) Xgamm = 1.0e0 / (Xgamm * s) / x;
    return Xgamm;
  }
  //****************************************************************************

  double gsumln ( double *a, double *b )

  //****************************************************************************
  //
  //  Purpose:
  //
  //    GSUMLN evaluates the function ln(Gamma(A + B)).
  //
  //  Discussion:
  //
  //    GSUMLN is used for 1 <= A <= 2 and 1 <= B <= 2
  //
  //  Parameters:
  //
  //    Input, double *A, *B, values whose sum is the argument of
  //    the Gamma function.
  //
  //    Output, double GSUMLN, the value of ln(Gamma(A+B)).
  //
  {
    static double gsumln, x, T1, T2;

    x = *a + *b - 2.e0;
    if(x > 0.25e0) goto S10;
    T1 = 1.0e0 + x;
    gsumln = gamma_ln1 ( &T1 );
    return gsumln;
  S10:
    if(x > 1.25e0) goto S20;
    gsumln = gamma_ln1 ( &x ) + alnrel ( &x );
    return gsumln;
  S20:
    T2 = x - 1.0e0;
    gsumln = gamma_ln1 ( &T2 ) + log ( x * ( 1.0e0 + x ) );
    return gsumln;
  }
  //****************************************************************************

  int ipmpar ( int *i )

  //****************************************************************************
  //
  //  Purpose:
  //
  //    IPMPAR returns integer machine constants.
  //
  //  Discussion:
  //
  //    Input arguments 1 through 3 are queries about integer arithmetic.
  //    We assume integers are represented in the N-digit, base-A form
  //
  //      sign * ( X(N-1)*A**(N-1) + ... + X(1)*A + X(0) )
  //
  //    where 0 <= X(0:N-1) < A.
  //
  //    Then:
  //
  //      IPMPAR(1) = A, the base of integer arithmetic;
  //      IPMPAR(2) = N, the number of base A digits;
  //      IPMPAR(3) = A**N - 1, the largest magnitude.
  //
  //    It is assumed that the single and double precision floating
  //    point arithmetics have the same base, say B, and that the
  //    nonzero numbers are represented in the form
  //
  //      sign * (B**E) * (X(1)/B + ... + X(M)/B**M)
  //
  //    where X(1:M) is one of { 0, 1,..., B-1 }, and 1 <= X(1) and
  //    EMIN <= E <= EMAX.
  //
  //    Input argument 4 is a query about the base of real arithmetic:
  //
  //      IPMPAR(4) = B, the base of single and double precision arithmetic.
  //
  //    Input arguments 5 through 7 are queries about single precision
  //    floating point arithmetic:
  //
  //     IPMPAR(5) = M, the number of base B digits for single precision.
  //     IPMPAR(6) = EMIN, the smallest exponent E for single precision.
  //     IPMPAR(7) = EMAX, the largest exponent E for single precision.
  //
  //    Input arguments 8 through 10 are queries about double precision
  //    floating point arithmetic:
  //
  //     IPMPAR(8) = M, the number of base B digits for double precision.
  //     IPMPAR(9) = EMIN, the smallest exponent E for double precision.
  //     IPMPAR(10) = EMAX, the largest exponent E for double precision.
  //
  //  Reference:
  //
  //    Phyllis Fox, Andrew Hall, and Norman Schryer,
  //    Algorithm 528,
  //    Framework for a Portable FORTRAN Subroutine Library,
  //    ACM Transactions on Mathematical Software,
  //    Volume 4, 1978, pages 176-188.
  //
  //  Parameters:
  //
  //    Input, int *I, the index of the desired constant.
  //
  //    Output, int IPMPAR, the value of the desired constant.
  //
  {
    static int imach[11];
    static int ipmpar;
    //     MACHINE CONSTANTS FOR AMDAHL MACHINES.
    //
    //   imach[1] = 2;
    //   imach[2] = 31;
    //   imach[3] = 2147483647;
    //   imach[4] = 16;
    //   imach[5] = 6;
    //   imach[6] = -64;
    //   imach[7] = 63;
    //   imach[8] = 14;
    //   imach[9] = -64;
    //   imach[10] = 63;
    //
    //     MACHINE CONSTANTS FOR THE AT&T 3B SERIES, AT&T
    //       PC 7300, AND AT&T 6300.
    //
    //   imach[1] = 2;
    //   imach[2] = 31;
    //   imach[3] = 2147483647;
    //   imach[4] = 2;
    //   imach[5] = 24;
    //   imach[6] = -125;
    //   imach[7] = 128;
    //   imach[8] = 53;
    //   imach[9] = -1021;
    //   imach[10] = 1024;
    //
    //     MACHINE CONSTANTS FOR THE BURROUGHS 1700 SYSTEM.
    //
    //   imach[1] = 2;
    //   imach[2] = 33;
    //   imach[3] = 8589934591;
    //   imach[4] = 2;
    //   imach[5] = 24;
    //   imach[6] = -256;
    //   imach[7] = 255;
    //   imach[8] = 60;
    //   imach[9] = -256;
    //   imach[10] = 255;
    //
    //     MACHINE CONSTANTS FOR THE BURROUGHS 5700 SYSTEM.
    //
    //   imach[1] = 2;
    //   imach[2] = 39;
    //   imach[3] = 549755813887;
    //   imach[4] = 8;
    //   imach[5] = 13;
    //   imach[6] = -50;
    //   imach[7] = 76;
    //   imach[8] = 26;
    //   imach[9] = -50;
    //   imach[10] = 76;
    //
    //     MACHINE CONSTANTS FOR THE BURROUGHS 6700/7700 SYSTEMS.
    //
    //   imach[1] = 2;
    //   imach[2] = 39;
    //   imach[3] = 549755813887;
    //   imach[4] = 8;
    //   imach[5] = 13;
    //   imach[6] = -50;
    //   imach[7] = 76;
    //   imach[8] = 26;
    //   imach[9] = -32754;
    //   imach[10] = 32780;
    //
    //     MACHINE CONSTANTS FOR THE CDC 6000/7000 SERIES
    //       60 BIT ARITHMETIC, AND THE CDC CYBER 995 64 BIT
    //       ARITHMETIC (NOS OPERATING SYSTEM).
    //
    //   imach[1] = 2;
    //   imach[2] = 48;
    //   imach[3] = 281474976710655;
    //   imach[4] = 2;
    //   imach[5] = 48;
    //   imach[6] = -974;
    //   imach[7] = 1070;
    //   imach[8] = 95;
    //   imach[9] = -926;
    //   imach[10] = 1070;
    //
    //     MACHINE CONSTANTS FOR THE CDC CYBER 995 64 BIT
    //       ARITHMETIC (NOS/VE OPERATING SYSTEM).
    //
    //   imach[1] = 2;
    //   imach[2] = 63;
    //   imach[3] = 9223372036854775807;
    //   imach[4] = 2;
    //   imach[5] = 48;
    //   imach[6] = -4096;
    //   imach[7] = 4095;
    //   imach[8] = 96;
    //   imach[9] = -4096;
    //   imach[10] = 4095;
    //
    //     MACHINE CONSTANTS FOR THE CRAY 1, XMP, 2, AND 3.
    //
    //   imach[1] = 2;
    //   imach[2] = 63;
    //   imach[3] = 9223372036854775807;
    //   imach[4] = 2;
    //   imach[5] = 47;
    //   imach[6] = -8189;
    //   imach[7] = 8190;
    //   imach[8] = 94;
    //   imach[9] = -8099;
    //   imach[10] = 8190;
    //
    //     MACHINE CONSTANTS FOR THE DATA GENERAL ECLIPSE S/200.
    //
    //   imach[1] = 2;
    //   imach[2] = 15;
    //   imach[3] = 32767;
    //   imach[4] = 16;
    //   imach[5] = 6;
    //   imach[6] = -64;
    //   imach[7] = 63;
    //   imach[8] = 14;
    //   imach[9] = -64;
    //   imach[10] = 63;
    //
    //     MACHINE CONSTANTS FOR THE HARRIS 220.
    //
    //   imach[1] = 2;
    //   imach[2] = 23;
    //   imach[3] = 8388607;
    //   imach[4] = 2;
    //   imach[5] = 23;
    //   imach[6] = -127;
    //   imach[7] = 127;
    //   imach[8] = 38;
    //   imach[9] = -127;
    //   imach[10] = 127;
    //
    //     MACHINE CONSTANTS FOR THE HONEYWELL 600/6000
    //       AND DPS 8/70 SERIES.
    //
    //   imach[1] = 2;
    //   imach[2] = 35;
    //   imach[3] = 34359738367;
    //   imach[4] = 2;
    //   imach[5] = 27;
    //   imach[6] = -127;
    //   imach[7] = 127;
    //   imach[8] = 63;
    //   imach[9] = -127;
    //   imach[10] = 127;
    //
    //     MACHINE CONSTANTS FOR THE HP 2100
    //       3 WORD DOUBLE Precision OPTION WITH FTN4
    //
    //   imach[1] = 2;
    //   imach[2] = 15;
    //   imach[3] = 32767;
    //   imach[4] = 2;
    //   imach[5] = 23;
    //   imach[6] = -128;
    //   imach[7] = 127;
    //   imach[8] = 39;
    //   imach[9] = -128;
    //   imach[10] = 127;
    //
    //     MACHINE CONSTANTS FOR THE HP 2100
    //       4 WORD DOUBLE Precision OPTION WITH FTN4
    //
    //   imach[1] = 2;
    //   imach[2] = 15;
    //   imach[3] = 32767;
    //   imach[4] = 2;
    //   imach[5] = 23;
    //   imach[6] = -128;
    //   imach[7] = 127;
    //   imach[8] = 55;
    //   imach[9] = -128;
    //   imach[10] = 127;
    //
    //     MACHINE CONSTANTS FOR THE HP 9000.
    //
    //   imach[1] = 2;
    //   imach[2] = 31;
    //   imach[3] = 2147483647;
    //   imach[4] = 2;
    //   imach[5] = 24;
    //   imach[6] = -126;
    //   imach[7] = 128;
    //   imach[8] = 53;
    //   imach[9] = -1021;
    //   imach[10] = 1024;
    //
    //     MACHINE CONSTANTS FOR THE IBM 360/370 SERIES,
    //       THE ICL 2900, THE ITEL AS/6, THE XEROX SIGMA
    //       5/7/9 AND THE SEL SYSTEMS 85/86.
    //
    //   imach[1] = 2;
    //   imach[2] = 31;
    //   imach[3] = 2147483647;
    //   imach[4] = 16;
    //   imach[5] = 6;
    //   imach[6] = -64;
    //   imach[7] = 63;
    //   imach[8] = 14;
    //   imach[9] = -64;
    //   imach[10] = 63;
    //
    //     MACHINE CONSTANTS FOR THE IBM PC.

    imach[1] = 2;
    imach[2] = 31;
    imach[3] = 2147483647;
    imach[4] = 2;
    imach[5] = 24;
    imach[6] = -125;
    imach[7] = 128;
    imach[8] = 53;
    imach[9] = -1021;
    imach[10] = 1024;

    //     MACHINE CONSTANTS FOR THE MACINTOSH II - ABSOFT
    //       MACFORTRAN II.
    //
    //   imach[1] = 2;
    //   imach[2] = 31;
    //   imach[3] = 2147483647;
    //   imach[4] = 2;
    //   imach[5] = 24;
    //   imach[6] = -125;
    //   imach[7] = 128;
    //   imach[8] = 53;
    //   imach[9] = -1021;
    //   imach[10] = 1024;
    //
    //     MACHINE CONSTANTS FOR THE MICROVAX - VMS FORTRAN.
    //
    //   imach[1] = 2;
    //   imach[2] = 31;
    //   imach[3] = 2147483647;
    //   imach[4] = 2;
    //   imach[5] = 24;
    //   imach[6] = -127;
    //   imach[7] = 127;
    //   imach[8] = 56;
    //   imach[9] = -127;
    //   imach[10] = 127;
    //
    //     MACHINE CONSTANTS FOR THE PDP-10 (KA PROCESSOR).
    //
    //   imach[1] = 2;
    //   imach[2] = 35;
    //   imach[3] = 34359738367;
    //   imach[4] = 2;
    //   imach[5] = 27;
    //   imach[6] = -128;
    //   imach[7] = 127;
    //   imach[8] = 54;
    //   imach[9] = -101;
    //   imach[10] = 127;
    //
    //     MACHINE CONSTANTS FOR THE PDP-10 (KI PROCESSOR).
    //
    //   imach[1] = 2;
    //   imach[2] = 35;
    //   imach[3] = 34359738367;
    //   imach[4] = 2;
    //   imach[5] = 27;
    //   imach[6] = -128;
    //   imach[7] = 127;
    //   imach[8] = 62;
    //   imach[9] = -128;
    //   imach[10] = 127;
    //
    //     MACHINE CONSTANTS FOR THE PDP-11 FORTRAN SUPPORTING
    //       32-BIT INTEGER ARITHMETIC.
    //
    //   imach[1] = 2;
    //   imach[2] = 31;
    //   imach[3] = 2147483647;
    //   imach[4] = 2;
    //   imach[5] = 24;
    //   imach[6] = -127;
    //   imach[7] = 127;
    //   imach[8] = 56;
    //   imach[9] = -127;
    //   imach[10] = 127;
    //
    //     MACHINE CONSTANTS FOR THE SEQUENT BALANCE 8000.
    //
    //   imach[1] = 2;
    //   imach[2] = 31;
    //   imach[3] = 2147483647;
    //   imach[4] = 2;
    //   imach[5] = 24;
    //   imach[6] = -125;
    //   imach[7] = 128;
    //   imach[8] = 53;
    //   imach[9] = -1021;
    //   imach[10] = 1024;
    //
    //     MACHINE CONSTANTS FOR THE SILICON GRAPHICS IRIS-4D
    //       SERIES (MIPS R3000 PROCESSOR).
    //
    //   imach[1] = 2;
    //   imach[2] = 31;
    //   imach[3] = 2147483647;
    //   imach[4] = 2;
    //   imach[5] = 24;
    //   imach[6] = -125;
    //   imach[7] = 128;
    //   imach[8] = 53;
    //   imach[9] = -1021;
    //   imach[10] = 1024;
    //
    //     MACHINE CONSTANTS FOR IEEE ARITHMETIC MACHINES, SUCH AS THE AT&T
    //       3B SERIES, MOTOROLA 68000 BASED MACHINES (E.G. SUN 3 AND AT&T
    //       PC 7300), AND 8087 BASED MICROS (E.G. IBM PC AND AT&T 6300).
    //
    //    imach[1] = 2;
    //    imach[2] = 31;
    //    imach[3] = 2147483647;
    //    imach[4] = 2;
    //    imach[5] = 24;
    //    imach[6] = -125;
    //    imach[7] = 128;
    //    imach[8] = 53;
    //    imach[9] = -1021;
    //    imach[10] = 1024;
    //
    //     MACHINE CONSTANTS FOR THE UNIVAC 1100 SERIES.
    //
    //   imach[1] = 2;
    //   imach[2] = 35;
    //   imach[3] = 34359738367;
    //   imach[4] = 2;
    //   imach[5] = 27;
    //   imach[6] = -128;
    //   imach[7] = 127;
    //   imach[8] = 60;
    //   imach[9] = -1024;
    //   imach[10] = 1023;
    //
    //     MACHINE CONSTANTS FOR THE VAX 11/780.
    //
    //   imach[1] = 2;
    //   imach[2] = 31;
    //   imach[3] = 2147483647;
    //   imach[4] = 2;
    //   imach[5] = 24;
    //   imach[6] = -127;
    //   imach[7] = 127;
    //   imach[8] = 56;
    //   imach[9] = -127;
    //   imach[10] = 127;
    //
    ipmpar = imach[*i];
    return ipmpar;
  }
  //******************************************************************************

  void negative_binomial_cdf_values ( int *n_data, int *f, int *s, double *p,
                                      double *cdf )

  //******************************************************************************
  //
  //  Purpose:
  //
  //    NEGATIVE_BINOMIAL_CDF_VALUES returns values of the negative binomial CDF.
  //
  //  Discussion:
  //
  //    Assume that a coin has a probability P of coming up heads on
  //    any one trial.  Suppose that we plan to flip the coin until we
  //    achieve a total of S heads.  If we let F represent the number of
  //    tails that occur in this process, then the value of F satisfies
  //    a negative binomial PDF:
  //
  //      PDF(F,S,P) = Choose ( F from F+S-1 ) * P**S * (1-P)**F
  //
  //    The negative binomial CDF is the probability that there are F or
  //    fewer failures upon the attainment of the S-th success.  Thus,
  //
  //      CDF(F,S,P) = sum ( 0 <= G <= F ) PDF(G,S,P)
  //
  //  Modified:
  //
  //    07 June 2004
  //
  //  @author:
  //
  //    John Burkardt
  //
  //  Reference:
  //
  //    F C Powell,
  //    Statistical Tables for Sociology, Biology and Physical Sciences,
  //    Cambridge University Press, 1982.
  //
  //  Parameters:
  //
  //    Input/output, int *N_DATA.  The user sets N_DATA to 0 before the
  //    first call.  On each call, the routine increments N_DATA by 1, and
  //    returns the corresponding data; when there is no more data, the
  //    output value of N_DATA will be 0 again.
  //
  //    Output, int *F, the maximum number of failures.
  //
  //    Output, int *S, the number of successes.
  //
  //    Output, double *P, the probability of a success on one trial.
  //
  //    Output, double *CDF, the probability of at most F failures before the
  //    S-th success.
  //
  {
# define N_MAX 27

    double cdf_vec[N_MAX] =
      {
        0.6367, 0.3633, 0.1445,
        0.5000, 0.2266, 0.0625,
        0.3438, 0.1094, 0.0156,
        0.1792, 0.0410, 0.0041,
        0.0705, 0.0109, 0.0007,
        0.9862, 0.9150, 0.7472,
        0.8499, 0.5497, 0.2662,
        0.6513, 0.2639, 0.0702,
        1.0000, 0.0199, 0.0001
      };
    int f_vec[N_MAX] =
      {
        4,  3,  2,
        3,  2,  1,
        2,  1,  0,
        2,  1,  0,
        2,  1,  0,
        11, 10,  9,
        17, 16, 15,
        9,  8,  7,
        2,  1,  0
      };
    double p_vec[N_MAX] =
      {
        0.50, 0.50, 0.50,
        0.50, 0.50, 0.50,
        0.50, 0.50, 0.50,
        0.40, 0.40, 0.40,
        0.30, 0.30, 0.30,
        0.30, 0.30, 0.30,
        0.10, 0.10, 0.10,
        0.10, 0.10, 0.10,
        0.01, 0.01, 0.01
      };
    int s_vec[N_MAX] =
      {
        4, 5, 6,
        4, 5, 6,
        4, 5, 6,
        4, 5, 6,
        4, 5, 6,
        1, 2, 3,
        1, 2, 3,
        1, 2, 3,
        0, 1, 2
      };

    if ( n_data < 0 )
      {
        *n_data = 0;
      }

    *n_data = *n_data + 1;

    if ( N_MAX < *n_data )
      {
        *n_data = 0;
        *f = 0;
        *s = 0;
        *p = 0.0E+00;
        *cdf = 0.0E+00;
      }
    else
      {
        *f = f_vec[*n_data - 1];
        *s = s_vec[*n_data - 1];
        *p = p_vec[*n_data - 1];
        *cdf = cdf_vec[*n_data - 1];
      }

    return;
# undef N_MAX
  }
  //*******************************************************************************

  void normal_cdf_values ( int *n_data, double *x, double *fx )

  //*******************************************************************************
  //
  //  Purpose:
  //
  //    NORMAL_CDF_VALUES returns some values of the Normal CDF.
  //
  //  Modified:
  //
  //    31 May 2004
  //
  //  @author:
  //
  //    John Burkardt
  //
  //  Reference:
  //
  //    Milton Abramowitz and Irene Stegun,
  //    Handbook of Mathematical Functions,
  //    US Department of Commerce, 1964.
  //
  //  Parameters:
  //
  //    Input/output, int *N_DATA.  The user sets N_DATA to 0 before the
  //    first call.  On each call, the routine increments N_DATA by 1, and
  //    returns the corresponding data; when there is no more data, the
  //    output value of N_DATA will be 0 again.
  //
  //    Output, double *X, the argument of the function.
  //
  //    Output double *FX, the value of the function.
  //
  {
# define N_MAX 13

    double fx_vec[N_MAX] =
      {
        0.500000000000000E+00, 0.539827837277029E+00, 0.579259709439103E+00,
        0.617911422188953E+00, 0.655421741610324E+00, 0.691462461274013E+00,
        0.725746882249927E+00, 0.758036347776927E+00, 0.788144601416604E+00,
        0.815939874653241E+00, 0.841344746068543E+00, 0.933192798731142E+00,
        0.977249868051821E+00
      };
    double x_vec[N_MAX] =
      {
        0.00E+00, 0.10E+00, 0.20E+00,
        0.30E+00, 0.40E+00, 0.50E+00,
        0.60E+00, 0.70E+00, 0.80E+00,
        0.90E+00, 1.00E+00, 1.50E+00,
        2.00E+00
      };

    if ( *n_data < 0 )
      {
        *n_data = 0;
      }

    *n_data = *n_data + 1;

    if ( N_MAX < *n_data )
      {
        *n_data = 0;
        *x = 0.0E+00;
        *fx = 0.0E+00;
      }
    else
      {
        *x = x_vec[*n_data - 1];
        *fx = fx_vec[*n_data - 1];
      }

    return;
# undef N_MAX
  }
  //*******************************************************************************

  void poisson_cdf_values ( int *n_data, double *a, int *x, double *fx )

  //*******************************************************************************
  //
  //  Purpose:
  //
  //    POISSON_CDF_VALUES returns some values of the Poisson CDF.
  //
  //  Discussion:
  //
  //    CDF(X)(A) is the probability of at most X successes in unit time,
  //    given that the expected mean number of successes is A.
  //
  //  Modified:
  //
  //    31 May 2004
  //
  //  @author:
  //
  //    John Burkardt
  //
  //  Reference:
  //
  //    Milton Abramowitz and Irene Stegun,
  //    Handbook of Mathematical Functions,
  //    US Department of Commerce, 1964.
  //
  //    Daniel Zwillinger,
  //    CRC Standard Mathematical Tables and Formulae,
  //    30th Edition, CRC Press, 1996, pages 653-658.
  //
  //  Parameters:
  //
  //    Input/output, int *N_DATA.  The user sets N_DATA to 0 before the
  //    first call.  On each call, the routine increments N_DATA by 1, and
  //    returns the corresponding data; when there is no more data, the
  //    output value of N_DATA will be 0 again.
  //
  //    Output, double *A, the parameter of the function.
  //
  //    Output, int *X, the argument of the function.
  //
  //    Output, double *FX, the value of the function.
  //
  {
# define N_MAX 21

    double a_vec[N_MAX] =
      {
        0.02E+00, 0.10E+00, 0.10E+00, 0.50E+00,
        0.50E+00, 0.50E+00, 1.00E+00, 1.00E+00,
        1.00E+00, 1.00E+00, 2.00E+00, 2.00E+00,
        2.00E+00, 2.00E+00, 5.00E+00, 5.00E+00,
        5.00E+00, 5.00E+00, 5.00E+00, 5.00E+00,
        5.00E+00
      };
    double fx_vec[N_MAX] =
      {
        0.980E+00, 0.905E+00, 0.995E+00, 0.607E+00,
        0.910E+00, 0.986E+00, 0.368E+00, 0.736E+00,
        0.920E+00, 0.981E+00, 0.135E+00, 0.406E+00,
        0.677E+00, 0.857E+00, 0.007E+00, 0.040E+00,
        0.125E+00, 0.265E+00, 0.441E+00, 0.616E+00,
        0.762E+00
      };
    int x_vec[N_MAX] =
      {
        0, 0, 1, 0,
        1, 2, 0, 1,
        2, 3, 0, 1,
        2, 3, 0, 1,
        2, 3, 4, 5,
        6
      };

    if ( *n_data < 0 )
      {
        *n_data = 0;
      }

    *n_data = *n_data + 1;

    if ( N_MAX < *n_data )
      {
        *n_data = 0;
        *a = 0.0E+00;
        *x = 0;
        *fx = 0.0E+00;
      }
    else
      {
        *a = a_vec[*n_data - 1];
        *x = x_vec[*n_data - 1];
        *fx = fx_vec[*n_data - 1];
      }
    return;
# undef N_MAX
  }
  //****************************************************************************

  double psi ( double *xx )

  //****************************************************************************
  //
  //  Purpose:
  //
  //    PSI evaluates the psi or digamma function, d/dx ln(gamma(x)).
  //
  //  Discussion:
  //
  //    The main computation involves evaluation of rational Chebyshev
  //    approximations.  PSI was written at Argonne National Laboratory
  //    for FUNPACK, and subsequently modified by A. H. Morris of NSWC.
  //
  //  Reference:
  //
  //    William Cody, Strecok and Thacher,
  //    Chebyshev Approximations for the Psi Function,
  //    Mathematics of Computation,
  //    Volume 27, 1973, pages 123-127.
  //
  //  Parameters:
  //
  //    Input, double *XX, the argument of the psi function.
  //
  //    Output, double PSI, the value of the psi function.  PSI
  //    is assigned the value 0 when the psi function is undefined.
  //
  {
    static double dx0 = 1.461632144968362341262659542325721325e0;
    static double piov4 = .785398163397448e0;
    static double p1[7] =
      {
        .895385022981970e-02, .477762828042627e+01, .142441585084029e+03,
        .118645200713425e+04, .363351846806499e+04, .413810161269013e+04,
        .130560269827897e+04
      };
    static double p2[4] =
      {
        -.212940445131011e+01, -.701677227766759e+01, -.448616543918019e+01,
        -.648157123766197e+00
      };
    static double q1[6] =
      {
        .448452573429826e+02, .520752771467162e+03, .221000799247830e+04,
        .364127349079381e+04, .190831076596300e+04, .691091682714533e-05
      };
    static double q2[4] =
      {
        .322703493791143e+02, .892920700481861e+02, .546117738103215e+02,
        .777788548522962e+01
      };
    static int K1 = 3;
    static int K2 = 1;
    static double psi, aug, den, sgn, upper, w, x, xmax1, xmx0, xsmall, z;
    static int i, m, n, nq;
    //
    //     MACHINE DEPENDENT CONSTANTS ...
    //        XMAX1  = THE SMALLEST POSITIVE FLOATING POINT CONSTANT
    //                 WITH ENTIRELY INTEGER REPRESENTATION.  ALSO USED
    //                 AS NEGATIVE OF LOWER BOUND ON ACCEPTABLE NEGATIVE
    //                 ARGUMENTS AND AS THE POSITIVE ARGUMENT BEYOND WHICH
    //                 PSI MAY BE REPRESENTED AS ALOG(X).
    //        XSMALL = ABSOLUTE ARGUMENT BELOW WHICH PI*COTAN(PI*X)
    //                 MAY BE REPRESENTED BY 1/X.
    //
    xmax1 = ipmpar(&K1);
    xmax1 = fifdmin1(xmax1, 1.0e0 / dpmpar(&K2));
    xsmall = 1.e-9;
    x = *xx;
    aug = 0.0e0;
    if(x >= 0.5e0) goto S50;
    //
    //     X .LT. 0.5,  USE REFLECTION FORMULA
    //     PSI(1-X) = PSI(X) + PI * COTAN(PI*X)
    //
    if(fabs(x) > xsmall) goto S10;
    if(x == 0.0e0) goto S100;
    //
    //     0 .LT. ABS(X) .LE. XSMALL.  USE 1/X AS A SUBSTITUTE
    //     FOR  PI*COTAN(PI*X)
    //
    aug = -(1.0e0 / x);
    goto S40;
  S10:
    //
    //     REDUCTION OF ARGUMENT FOR COTAN
    //
    w = -x;
    sgn = piov4;
    if(w > 0.0e0) goto S20;
    w = -w;
    sgn = -sgn;
  S20:
    //
    //     MAKE AN ERROR EXIT IF X .LE. -XMAX1
    //
    if(w >= xmax1) goto S100;
    nq = fifidint(w);
    w -= (double)nq;
    nq = fifidint(w * 4.0e0);
    w = 4.0e0 * (w - (double)nq * .25e0);
    //
    //     W IS NOW RELATED TO THE FRACTIONAL PART OF  4.0 * X.
    //     ADJUST ARGUMENT TO CORRESPOND TO VALUES IN FIRST
    //     QUADRANT AND DETERMINE SIGN
    //
    n = nq / 2;
    if(n + n != nq) w = 1.0e0 - w;
    z = piov4 * w;
    m = n / 2;
    if(m + m != n) sgn = -sgn;
    //
    //     DETERMINE FINAL VALUE FOR  -PI*COTAN(PI*X)
    //
    n = (nq + 1) / 2;
    m = n / 2;
    m += m;
    if(m != n) goto S30;
    //
    //     CHECK FOR SINGULARITY
    //
    if(z == 0.0e0) goto S100;
    //
    //     USE COS/SIN AS A SUBSTITUTE FOR COTAN, AND
    //     SIN/COS AS A SUBSTITUTE FOR TAN
    //
    aug = sgn * (cos(z) / sin(z) * 4.0e0);
    goto S40;
  S30:
    aug = sgn * (sin(z) / cos(z) * 4.0e0);
  S40:
    x = 1.0e0 - x;
  S50:
    if(x > 3.0e0) goto S70;
    //
    //     0.5 .LE. X .LE. 3.0
    //
    den = x;
    upper = p1[0] * x;
    for ( i = 1; i <= 5; i++ )
      {
        den = (den + q1[i - 1]) * x;
        upper = (upper + p1[i + 1 - 1]) * x;
      }
    den = (upper + p1[6]) / (den + q1[5]);
    xmx0 = x - dx0;
    psi = den * xmx0 + aug;
    return psi;
  S70:
    //
    //     IF X .GE. XMAX1, PSI = LN(X)
    //
    if(x >= xmax1) goto S90;
    //
    //     3.0 .LT. X .LT. XMAX1
    //
    w = 1.0e0 / (x * x);
    den = w;
    upper = p2[0] * w;
    for ( i = 1; i <= 3; i++ )
      {
        den = (den + q2[i - 1]) * w;
        upper = (upper + p2[i + 1 - 1]) * w;
      }
    aug = upper / (den + q2[3]) - 0.5e0 / x + aug;
  S90:
    psi = aug + log(x);
    return psi;
  S100:
    //
    //     ERROR RETURN
    //
    psi = 0.0e0;
    return psi;
  }
  //*******************************************************************************

  void psi_values ( int *n_data, double *x, double *fx )

  //*******************************************************************************
  //
  //  Purpose:
  //
  //    PSI_VALUES returns some values of the Psi or Digamma function.
  //
  //  Discussion:
  //
  //    PSI(X) = d LN ( Gamma ( X ) ) / d X = Gamma'(X) / Gamma(X)
  //
  //    PSI(1) = - Euler's constant.
  //
  //    PSI(X+1) = PSI(X) + 1 / X.
  //
  //  Modified:
  //
  //    31 May 2004
  //
  //  @author:
  //
  //    John Burkardt
  //
  //  Reference:
  //
  //    Milton Abramowitz and Irene Stegun,
  //    Handbook of Mathematical Functions,
  //    US Department of Commerce, 1964.
  //
  //  Parameters:
  //
  //    Input/output, int *N_DATA.  The user sets N_DATA to 0 before the
  //    first call.  On each call, the routine increments N_DATA by 1, and
  //    returns the corresponding data; when there is no more data, the
  //    output value of N_DATA will be 0 again.
  //
  //    Output, double *X, the argument of the function.
  //
  //    Output, double *FX, the value of the function.
  //
  {
# define N_MAX 11

    double fx_vec[N_MAX] =
      {
        -0.5772156649E+00, -0.4237549404E+00, -0.2890398966E+00,
        -0.1691908889E+00, -0.0613845446E+00, -0.0364899740E+00,
        0.1260474528E+00,  0.2085478749E+00,  0.2849914333E+00,
        0.3561841612E+00,  0.4227843351E+00
      };
    double x_vec[N_MAX] =
      {
        1.0E+00,  1.1E+00,  1.2E+00,
        1.3E+00,  1.4E+00,  1.5E+00,
        1.6E+00,  1.7E+00,  1.8E+00,
        1.9E+00,  2.0E+00
      };

    if ( *n_data < 0 )
      {
        *n_data = 0;
      }

    *n_data = *n_data + 1;

    if ( N_MAX < *n_data )
      {
        *n_data = 0;
        *x = 0.0E+00;
        *fx = 0.0E+00;
      }
    else
      {
        *x = x_vec[*n_data - 1];
        *fx = fx_vec[*n_data - 1];
      }
    return;
# undef N_MAX
  }
  //****************************************************************************

  double rcomp ( double *a, double *x )

  //****************************************************************************
  //
  //  Purpose:
  //
  //    RCOMP evaluates exp(-X) * X**A / Gamma(A).
  //
  //  Parameters:
  //
  //    Input, double *A, *X, arguments of the quantity to be computed.
  //
  //    Output, double RCOMP, the value of exp(-X) * X**A / Gamma(A).
  //
  //  Local parameters:
  //
  //    RT2PIN = 1/SQRT(2*PI)
  //
  {
    static double rt2pin = .398942280401433e0;
    static double rcomp, t, t1, u;
    rcomp = 0.0e0;
    if(*a >= 20.0e0) goto S20;
    t = *a * log(*x) - *x;
    if(*a >= 1.0e0) goto S10;
    rcomp = *a * exp(t) * (1.0e0 + gam1(a));
    return rcomp;
  S10:
    rcomp = exp(t) / gamma_x(a);
    return rcomp;
  S20:
    u = *x / *a;
    if(u == 0.0e0) return rcomp;
    t = pow(1.0e0 / *a, 2.0);
    t1 = (((0.75e0 * t - 1.0e0) * t + 3.5e0) * t - 105.0e0) / (*a * 1260.0e0);
    t1 -= (*a * rlog(&u));
    rcomp = rt2pin * sqrt(*a) * exp(t1);
    return rcomp;
  }
  //****************************************************************************

  double rexp ( double *x )

  //****************************************************************************
  //
  //  Purpose:
  //
  //    REXP evaluates the function EXP(X) - 1.
  //
  //  Modified:
  //
  //    09 December 1999
  //
  //  Parameters:
  //
  //    Input, double *X, the argument of the function.
  //
  //    Output, double REXP, the value of EXP(X)-1.
  //
  {
    static double p1 = .914041914819518e-09;
    static double p2 = .238082361044469e-01;
    static double q1 = -.499999999085958e+00;
    static double q2 = .107141568980644e+00;
    static double q3 = -.119041179760821e-01;
    static double q4 = .595130811860248e-03;
    static double rexp, w;

    if(fabs(*x) > 0.15e0) goto S10;
    rexp = *x * (((p2**x + p1)**x + 1.0e0) / ((((q4**x + q3)**x + q2)**x + q1)**x + 1.0e0));
    return rexp;
  S10:
    w = exp(*x);
    if(*x > 0.0e0) goto S20;
    rexp = w - 0.5e0 - 0.5e0;
    return rexp;
  S20:
    rexp = w * (0.5e0 + (0.5e0 - 1.0e0 / w));
    return rexp;
  }
  //****************************************************************************

  double rlog ( double *x )

  //****************************************************************************
  //
  //  Purpose:
  //
  //    RLOG computes  X - 1 - LN(X).
  //
  //  Modified:
  //
  //    09 December 1999
  //
  //  Parameters:
  //
  //    Input, double *X, the argument of the function.
  //
  //    Output, double RLOG, the value of the function.
  //
  {
    static double a = .566749439387324e-01;
    static double b = .456512608815524e-01;
    static double p0 = .333333333333333e+00;
    static double p1 = -.224696413112536e+00;
    static double p2 = .620886815375787e-02;
    static double q1 = -.127408923933623e+01;
    static double q2 = .354508718369557e+00;
    static double rlog, r, t, u, w, w1;

    if(*x < 0.61e0 || *x > 1.57e0) goto S40;
    if(*x < 0.82e0) goto S10;
    if(*x > 1.18e0) goto S20;
    //
    //              ARGUMENT REDUCTION
    //
    u = *x - 0.5e0 - 0.5e0;
    w1 = 0.0e0;
    goto S30;
  S10:
    u = *x - 0.7e0;
    u /= 0.7e0;
    w1 = a - u * 0.3e0;
    goto S30;
  S20:
    u = 0.75e0 * *x - 1.e0;
    w1 = b + u / 3.0e0;
  S30:
    //
    //               SERIES EXPANSION
    //
    r = u / (u + 2.0e0);
    t = r * r;
    w = ((p2 * t + p1) * t + p0) / ((q2 * t + q1) * t + 1.0e0);
    rlog = 2.0e0 * t * (1.0e0 / (1.0e0 - r) - r * w) + w1;
    return rlog;
  S40:
    r = *x - 0.5e0 - 0.5e0;
    rlog = r - log(*x);
    return rlog;
  }
  //****************************************************************************

  double rlog1 ( double *x )

  //****************************************************************************
  //
  //  Purpose:
  //
  //    RLOG1 evaluates the function X - ln ( 1 + X ).
  //
  //  Parameters:
  //
  //    Input, double *X, the argument.
  //
  //    Output, double RLOG1, the value of X - ln ( 1 + X ).
  //
  {
    static double a = .566749439387324e-01;
    static double b = .456512608815524e-01;
    static double p0 = .333333333333333e+00;
    static double p1 = -.224696413112536e+00;
    static double p2 = .620886815375787e-02;
    static double q1 = -.127408923933623e+01;
    static double q2 = .354508718369557e+00;
    static double rlog1, h, r, t, w, w1;

    if(*x < -0.39e0 || *x > 0.57e0) goto S40;
    if(*x < -0.18e0) goto S10;
    if(*x > 0.18e0) goto S20;
    //
    //              ARGUMENT REDUCTION
    //
    h = *x;
    w1 = 0.0e0;
    goto S30;
  S10:
    h = *x + 0.3e0;
    h /= 0.7e0;
    w1 = a - h * 0.3e0;
    goto S30;
  S20:
    h = 0.75e0 * *x - 0.25e0;
    w1 = b + h / 3.0e0;
  S30:
    //
    //               SERIES EXPANSION
    //
    r = h / (h + 2.0e0);
    t = r * r;
    w = ((p2 * t + p1) * t + p0) / ((q2 * t + q1) * t + 1.0e0);
    rlog1 = 2.0e0 * t * (1.0e0 / (1.0e0 - r) - r * w) + w1;
    return rlog1;
  S40:
    w = *x + 0.5e0 + 0.5e0;
    rlog1 = *x - log(w);
    return rlog1;
  }
  //*******************************************************************************

  void student_cdf_values ( int *n_data, int *a, double *x, double *fx )

  //*******************************************************************************
  //
  //  Purpose:
  //
  //    STUDENT_CDF_VALUES returns some values of the Student CDF.
  //
  //  Modified:
  //
  //    31 May 2004
  //
  //  @author:
  //
  //    John Burkardt
  //
  //  Reference:
  //
  //    Milton Abramowitz and Irene Stegun,
  //    Handbook of Mathematical Functions,
  //    US Department of Commerce, 1964.
  //
  //  Parameters:
  //
  //    Input/output, int *N_DATA.  The user sets N_DATA to 0 before the
  //    first call.  On each call, the routine increments N_DATA by 1, and
  //    returns the corresponding data; when there is no more data, the
  //    output value of N_DATA will be 0 again.
  //
  //    Output, int *A, the parameter of the function.
  //
  //    Output, double *X, the argument of the function.
  //
  //    Output, double *FX, the value of the function.
  //
  {
# define N_MAX 13

    int a_vec[N_MAX] =
      {
        1, 2, 3, 4,
        5, 2, 5, 2,
        5, 2, 3, 4,
        5
      };
    double fx_vec[N_MAX] =
      {
        0.60E+00, 0.60E+00, 0.60E+00, 0.60E+00,
        0.60E+00, 0.75E+00, 0.75E+00, 0.95E+00,
        0.95E+00, 0.99E+00, 0.99E+00, 0.99E+00,
        0.99E+00
      };
    double x_vec[N_MAX] =
      {
        0.325E+00, 0.289E+00, 0.277E+00, 0.271E+00,
        0.267E+00, 0.816E+00, 0.727E+00, 2.920E+00,
        2.015E+00, 6.965E+00, 4.541E+00, 3.747E+00,
        3.365E+00
      };

    if ( *n_data < 0 )
      {
        *n_data = 0;
      }

    *n_data = *n_data + 1;

    if ( N_MAX < *n_data )
      {
        *n_data = 0;
        *a = 0;
        *x = 0.0E+00;
        *fx = 0.0E+00;
      }
    else
      {
        *a = a_vec[*n_data - 1];
        *x = x_vec[*n_data - 1];
        *fx = fx_vec[*n_data - 1];
      }

    return;
# undef N_MAX
  }
  //****************************************************************************

  double stvaln ( double *p )

  //****************************************************************************
  //
  //  Purpose:
  //
  //    STVALN provides starting values for the inverse of the normal distribution.
  //
  //  Discussion:
  //
  //    The routine returns X such that
  //      P = CUMNOR(X),
  //    that is,
  //      P = Integral from -infinity to X of (1/SQRT(2*PI)) EXP(-U*U/2) dU.
  //
  //  Reference:
  //
  //    Kennedy and Gentle,
  //    Statistical Computing,
  //    Marcel Dekker, NY, 1980, page 95,
  //    QA276.4  K46
  //
  //  Parameters:
  //
  //    Input, double *P, the probability whose normal deviate
  //    is sought.
  //
  //    Output, double STVALN, the normal deviate whose probability
  //    is P.
  //
  {
    static double xden[5] =
      {
        0.993484626060e-1, 0.588581570495e0, 0.531103462366e0, 0.103537752850e0,
        0.38560700634e-2
      };
    static double xnum[5] =
      {
        -0.322232431088e0, -1.000000000000e0, -0.342242088547e0, -0.204231210245e-1,
        -0.453642210148e-4
      };
    static int K1 = 5;
    static double stvaln, sign, y, z;

    if(!(*p <= 0.5e0)) goto S10;
    sign = -1.0e0;
    z = *p;
    goto S20;
  S10:
    sign = 1.0e0;
    z = 1.0e0 - *p;
  S20:
    y = sqrt(-(2.0e0 * log(z)));
    stvaln = y + eval_pol ( xnum, &K1, &y ) / eval_pol ( xden, &K1, &y );
    stvaln = sign * stvaln;
    return stvaln;
  }

} // Namespace DCDFLIB
