function i4_abs ( x )

c*********************************************************************72
c
cc I4_ABS returns the absolute value of an I4.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    10 March 2015
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer X, the value to consider.
c
c    Output, integer I4_ABS, the absolute value.
c
      implicit none

      integer i4_abs
      integer x

      if ( x .lt. 0 ) then
        i4_abs = - x
      else
        i4_abs = x
      end if

      return
      end
      function i4_bit_hi1 ( n )

c*********************************************************************72
c
cc I4_BIT_HI1 returns the position of the high 1 bit base 2 in an I4.
c
c  Discussion:
c
c    An I4 is an integer value.
c
c  Example:
c
c       N    Binary    Hi 1
c    ----    --------  ----
c       0           0     0
c       1           1     1
c       2          10     2
c       3          11     2
c       4         100     3
c       5         101     3
c       6         110     3
c       7         111     3
c       8        1000     4
c       9        1001     4
c      10        1010     4
c      11        1011     4
c      12        1100     4
c      13        1101     4
c      14        1110     4
c      15        1111     4
c      16       10000     5
c      17       10001     5
c    1023  1111111111    10
c    1024 10000000000    11
c    1025 10000000001    11
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    22 October 2007
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the integer to be measured.
c    N should be nonnegative.  If N is nonpositive, the function
c    will always be 0.
c
c    Output, integer I4_BIT_HI1, the position of the highest bit.
c
      implicit none

      integer bit
      integer i
      integer i4_bit_hi1
      integer n

      i = n
      bit = 0

10    continue

        if ( i .le. 0 ) then
          go to 20
        end if

        bit = bit + 1
        i = i / 2

      go to 10

20    continue

      i4_bit_hi1 = bit

      return
      end
      function i4_bit_lo0 ( n )

c*********************************************************************72
c
cc I4_BIT_LO0 returns the position of the low 0 bit base 2 in an I4.
c
c  Discussion:
c
c    An I4 is an integer value.
c
c  Example:
c
c       N    Binary    Lo 0
c    ----    --------  ----
c       0           0     1
c       1           1     2
c       2          10     1
c       3          11     3
c       4         100     1
c       5         101     2
c       6         110     1
c       7         111     4
c       8        1000     1
c       9        1001     2
c      10        1010     1
c      11        1011     3
c      12        1100     1
c      13        1101     2
c      14        1110     1
c      15        1111     5
c      16       10000     1
c      17       10001     2
c    1023  1111111111    11
c    1024 10000000000     1
c    1025 10000000001     2
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    08 February 2018
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the integer to be measured.
c    N should be nonnegative.
c
c    Output, integer I4_BIT_LO0, the position of the low 1 bit.
c
      implicit none

      integer bit
      integer i
      integer i2
      integer i4_bit_lo0
      integer n

      bit = 0
      i = n

10    continue

        bit = bit + 1
        i2 = i / 2

        if ( i .eq. 2 * i2 ) then
          go to 20
        end if

        i = i2

      go to 10

20    continue

      i4_bit_lo0 = bit

      return
      end
      function i4_bit_lo1 ( n )

c*********************************************************************72
c
cc I4_BIT_LO1 returns the position of the low 1 bit base 2 in an I4.
c
c  Discussion:
c
c    An I4 is an integer value.
c
c  Example:
c
c       N    Binary    Lo 1
c    ----    --------  ----
c       0           0     0
c       1           1     1
c       2          10     2
c       3          11     1
c       4         100     3
c       5         101     1
c       6         110     2
c       7         111     1
c       8        1000     4
c       9        1001     1
c      10        1010     2
c      11        1011     1
c      12        1100     3
c      13        1101     1
c      14        1110     2
c      15        1111     1
c      16       10000     5
c      17       10001     1
c    1023  1111111111     1
c    1024 10000000000    11
c    1025 10000000001     1
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    16 February 2005
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the integer to be measured.
c    N should be nonnegative.
c
c    Output, integer I4_BIT_LO1, the position of the low 1 bit.
c
      implicit none

      integer bit
      integer i
      integer i2
      integer i4_bit_lo1
      integer n

      bit = 0
      i = n

10    continue

        bit = bit + 1
        i2 = i / 2

        if ( i /= 2 * i2 ) then
          go to 20
        end if

        i = i2

      go to 10

20    continue

      i4_bit_lo1 = bit

      return
      end
      function i4_bit_reverse ( i, n )

c*********************************************************************72
c
cc I4_BIT_REVERSE reverses the bits in an I4.
c
c  Discussion:
c
c    An I4 is an integer value.
c
c  Example:
c
c       I      N  2^N     I4_BIT_REVERSE ( I, N )
c    ----    --------  -----------------------
c       0      0    1     0
c       1      0    1     1
c
c       0      3    8     0
c       1      3    8     4
c       2      3    8     2
c       3      3    8     6
c       4      3    8     1
c       5      3    8     5
c       6      3    8     3
c       7      3    8     7
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    22 March 2008
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer I, the integer to be bit reversed.
c    I should be nonnegative.  Normally I < 2^N.
c
c    Input, integer N, indicates the number of bits to
c    be reverse (N+1) or the base with respect to which the integer is to
c    be reversed (2^N).  N should be nonnegative.
c
c    Output, integer I4_BIT_REVERSE, the bit reversed value.
c
      implicit none

      integer b
      integer i
      integer i4_bit_reverse
      integer j
      integer n
      integer value

      if ( i .lt. 0 ) then

        value = -1

      else if ( n .lt. 0 ) then

        value = -1

      else

        b = 2 ** n
        j = mod ( i, b )

        value = 0

10      continue

          if ( b .eq. 1 ) then

            value = value + j
            j = 0
            go to 20

          else

            if ( mod ( j, 2 ) .eq. 1 ) then
              value = value + b / 2
              j = j - 1
            end if

            j = j / 2
            b = b / 2

          end if

        go to 10

20      continue

      end if

      i4_bit_reverse = value

      return
      end
      function i4_ceiling ( r )

c*********************************************************************72
c
cc I4_CEILING rounds an R8 "up" to the nearest I4.
c
c  Example:
c
c     R     Value
c
c    -1.1  -1
c    -1.0  -1
c    -0.9   0
c     0.0   0
c     5.0   5
c     5.1   6
c     5.9   6
c     6.0   6
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    10 November 2011
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, double precision R, the value to be rounded up.
c
c    Output, integer I4_CEILING, the rounded value.
c
      implicit none

      double precision r
      integer i4_ceiling
      integer value

      value = int ( r )
      if ( dble ( value ) .lt. r ) then
        value = value + 1
      end if

      i4_ceiling = value

      return
      end
      function i4_characteristic ( q )

c*********************************************************************72
c
cc I4_CHARACTERISTIC gives the characteristic for an I4.
c
c  Discussion:
c
c    For any positive integer Q, the characteristic is:
c
c    Q, if Q is a prime;
c    P, if Q = P^N for some prime P and some integer N;
c    0, otherwise, that is, if Q is negative, 0, 1, or the product
c       of more than one distinct prime.
c
c    An I4 is an integer value.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    05 December 2004
c
c  Reference:
c
c    Paul Bratley, Bennett Fox, Harald Niederreiter,
c    Algorithm 738:
c    Programs to Generate Niederreiter's Low-Discrepancy Sequences,
c    ACM Transactions on Mathematical Software,
c    Volume 20, Number 4, 1994, pages 494-495.
c
c  Parameters:
c
c    Input, integer Q, the value to be tested.
c
c    Output, integer I4_CHARACTERISTIC, the characteristic of Q.
c
      implicit none

      integer i
      integer i4_characteristic
      integer i_max
      integer q
      integer q_copy

      if ( q .le. 1 ) then
        i4_characteristic = 0
        return
      end if
c
c  If Q is not prime, then there is at least one prime factor
c  of Q no greater than SQRT(Q)+1.
c
c  A faster code would only consider prime values of I,
c  but that entails storing a table of primes and limiting the
c  size of Q.  Simplicity and flexibility for nowc
c
      i_max = int ( sqrt ( real ( q ) ) ) + 1
      q_copy = q

      do i = 2, i_max

        if ( mod ( q_copy, i ) .eq. 0 ) then

10        continue

          if ( mod ( q_copy, i ) .eq. 0 ) then
            q_copy = q_copy / i
            go to 10
          end if

          if ( q_copy .eq. 1 ) then
            i4_characteristic = i
          else
            i4_characteristic = 0
          end if

          return

        end if

      end do
c
c  If no factor was found, then Q is prime.
c
      i4_characteristic = q

      return
      end
      function i4_choose ( n, k )

c*********************************************************************72
c
cc I4_CHOOSE computes the binomial coefficient C(N,K).
c
c  Discussion:
c
c    The value is calculated in such a way as to avoid overflow and
c    roundoff.  The calculation is done in integer arithmetic.
c
c    The formula used is:
c
c      C(N,K) = N! / ( K! * (N-K)! )
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    30 October 2014
c
c  Author:
c
c    John Burkardt
c
c  Reference:
c
c    ML Wolfson, HV Wright,
c    Algorithm 160:
c    Combinatorial of M Things Taken N at a Time,
c    Communications of the ACM,
c    Volume 6, Number 4, April 1963, page 161.
c
c  Parameters:
c
c    Input, integer N, K, are the values of N and K.
c
c    Output, integer I4_CHOOSE, the number of combinations of N
c    things taken K at a time.
c
      implicit none

      integer i
      integer i4_choose
      integer k
      integer mn
      integer mx
      integer n
      integer value

      mn = min ( k, n - k )
      mx = max ( k, n - k )

      if ( mn .lt. 0 ) then

        value = 0

      else if ( mn .eq. 0 ) then

        value = 1

      else

        value = mx + 1

        do i = 2, mn
          value = ( value * ( mx + i ) ) / i
        end do

      end if

      i4_choose = value

      return
      end
      function i4_choose_check ( n, k )

c*********************************************************************72
c
cc I4_CHOOSE_CHECK reports whether the binomial coefficient can be computed.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license. 
c
c  Modified:
c
c    27 March 2016
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, K, the parameters in the binomial coefficient.
c
c    Output, logical I4_CHOOSE_CHECK is:
c    TRUE, if C(N,K) < maximum integer.
c    FALSE, otherwise.
c
      implicit none

      logical i4_choose_check
      double precision choose_nk_log
      integer i4_huge
      parameter ( i4_huge = 2147483647 )
      double precision i4_huge_log
      integer n
      integer k
      double precision r8_gamma_log

      i4_huge_log = log ( dble ( i4_huge ) )

      choose_nk_log = 
     &    r8_gamma_log ( dble ( n + 1 ) )
     &  - r8_gamma_log ( dble ( k + 1 ) )
     &  - r8_gamma_log ( dble ( n - k + 1 ) )

      i4_choose_check = ( choose_nk_log < i4_huge_log )
        
      return
      end
      function i4_div_rounded ( a, b )

c*********************************************************************72
c
cc I4_DIV_ROUNDED computes the rounded result of I4 division.
c
c  Discussion:
c
c    This routine computes C = A / B, where A, B and C are integers
c    and C is the closest integer value to the exact real result.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    23 October 2011
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer A, B, the number to be divided,
c    and the divisor.
c
c    Output, integer I4_DIV_ROUNDED, the rounded result
c    of the division.
c
      implicit none

      integer a
      integer a_abs
      integer b
      integer b_abs
      integer i4_div_rounded
      integer i4_huge
      parameter ( i4_huge = 2147483647 )
      integer value

      if ( a .eq. 0 .and. b .eq. 0 ) then

        value = i4_huge
 
      else if ( a .eq. 0 ) then

        value = 0

      else if ( b .eq. 0 ) then

        if ( a .lt. 0 ) then
          value = - i4_huge
        else
          value = + i4_huge
        end if

      else

        a_abs = abs ( a )
        b_abs = abs ( b )

        value = a_abs / b_abs
c
c  Round the value.
c
        if ( ( 2 * value + 1 ) * b_abs .lt. 2 * a_abs ) then
          value = value + 1
        end if
c
c  Set the sign.
c
        if ( ( a .lt. 0 .and. 0 .lt. b ) .or. 
     &       ( 0 .lt. a .and. b .lt. 0 ) ) then
          value = - value
        end if

      end if

      i4_div_rounded = value

      return
      end
      function i4_division ( a, b )

c*********************************************************************72
c
cc I4_DIVISION returns the result of integer division.
c
c  Discussion:
c
c    This routine computes C = A / B, where the result is rounded to the
c    integer value nearest 0.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    27 March 2013
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c   Input, integer A, the number to be divided.
c
c    Input, integer B, the divisor.
c
c    Output, integer I4_DIVISION, the result.
c
      implicit none

      integer a
      integer a_abs
      integer b
      integer b_abs
      integer i4_division
      integer s

      if ( a * b .lt. 0 ) then
        s = -1
      else
        s = +1
      end if

      a_abs = abs ( a )
      b_abs = abs ( b )
      i4_division = s * ( a_abs / b_abs )

      return
      end
      function i4_divp ( i, j )

c*********************************************************************72
c
cc I4_DIVP returns the smallest multiple of J greater than or equal to I.
c
c  Discussion:
c
c    An I4 is an integer value.
c
c  Example:
c
c    I  J  I4_DIVP(I,J)
c
c    0  4    0
c    1  4    1
c    2  4    1
c    3  4    1
c    4  4    1
c    5  4    2
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    03 March 1999
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer I, the number to be analyzed.
c
c    Input, integer J, the number, multiples of which will
c    be compared against I.  J may not be zero.
c
c    Output, integer I4_DIVP, the smallest multiple of J that
c    is greater than or equal to I.
c
      implicit none

      integer i
      integer i4_divp
      integer j

      if ( j .ne. 0 ) then
        i4_divp = 1 + ( i - 1 ) / j
      else
        i4_divp = 0
        write ( *, '(a)' ) ' '
        write ( *, '(a)' ) 'I4_DIVP - Fatal error!'
        write ( *, '(a)' ) '  The input value of J was zero.'
        stop 1
      end if

      return
      end
      function i4_factorial ( n )

c*********************************************************************72
c
cc I4_FACTORIAL computes the factorial of N.
c
c  Discussion:
c
c    factorial ( N ) = product ( 1 <= I <= N ) I
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    26 June 2008
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the argument of the factorial function.
c    If N is less than 1, the function value is returned as 1.
c    0 <= N <= 13 is required.
c
c    Output, integer I4_FACTORIAL, the factorial of N.
c
      implicit none

      integer i
      integer i4_factorial
      integer n

      i4_factorial = 1

      if ( 13 .lt. n ) then
        i4_factorial = - 1
        write ( *, '(a)' ) ' '
        write ( *, '(a)' ) 'I4_FACTORIAL - Fatal error!'
        write ( *, '(a)' )
     &  '  I4_FACTORIAL(N) cannot be computed as an integer'
        write ( *, '(a)' ) '  for 13 < N.'
        write ( *, '(a,i8)' ) '  Input value N = ', n
        stop 1
      end if

      do i = 1, n
        i4_factorial = i4_factorial * i
      end do

      return
      end
      subroutine i4_factorial_values ( n_data, n, fn )

c*********************************************************************72
c
cc I4_FACTORIAL_VALUES returns values of the factorial function.
c
c  Discussion:
c
c    0! = 1
c    I! = Product ( 1 <= J <= I ) I
c
c    In Mathematica, the function can be evaluated by:
c
c      n!
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    24 March 2007
c
c  Author:
c
c    John Burkardt
c
c  Reference:
c
c    Milton Abramowitz, Irene Stegun,
c    Handbook of Mathematical Functions,
c    National Bureau of Standards, 1964,
c    ISBN: 0-486-61272-4,
c    LC: QA47.A34.
c
c    Stephen Wolfram,
c    The Mathematica Book,
c    Fourth Edition,
c    Cambridge University Press, 1999,
c    ISBN: 0-521-64314-7,
c    LC: QA76.95.W65.
c
c  Parameters:
c
c    Input/output, integer N_DATA.  The user sets N_DATA to 0 before the
c    first call.  On each call, the routine increments N_DATA by 1, and
c    returns the corresponding data; when there is no more data, the
c    output value of N_DATA will be 0 again.
c
c    Output, integer N, the argument of the function.
c
c    Output, integer FN, the value of the function.
c
      implicit none

      integer n_max
      parameter ( n_max = 13 )

      integer fn_vec(n_max)
      integer fn
      integer n
      integer n_data
      integer n_vec(n_max)

      save fn_vec
      save n_vec

      data fn_vec /
     &          1,
     &          1,
     &          2,
     &          6,
     &         24,
     &        120,
     &        720,
     &       5040,
     &      40320,
     &     362880,
     &    3628800,
     &   39916800,
     &  479001600 /
      data n_vec /
     &   0,  1,  2,  3,
     &   4,  5,  6,  7,
     &   8,  9, 10, 11,
     &  12 /

      if ( n_data .lt. 0 ) then
        n_data = 0
      end if

      n_data = n_data + 1

      if ( n_max .lt. n_data ) then
        n_data = 0
        n = 0
        fn = 0
      else
        n = n_vec(n_data)
        fn = fn_vec(n_data)
      end if

      return
      end
      function i4_factorial2 ( n )

c*********************************************************************72
c
cc I4_FACTORIAL2 computes the double factorial function.
c
c  Discussion:
c
c    FACTORIAL2( N ) = Product ( N * (N-2) * (N-4) * ... * 2 )  (N even)
c                    = Product ( N * (N-2) * (N-4) * ... * 1 )  (N odd)
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license. 
c
c  Modified:
c
c    01 June 2012
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the argument of the double factorial 
c    function.  If N is less than 1, I4_FACTORIAL2 is returned as 1.
c
c    Output, integer I4_FACTORIAL2, the value of N!!.
c
      implicit none

      integer i4_factorial2
      integer n
      integer n_copy

      if ( n .lt. 1 ) then
        i4_factorial2 = 1
        return
      end if

      n_copy = n
      i4_factorial2 = 1

10    continue

      if ( 1 .lt. n_copy ) then
        i4_factorial2 = i4_factorial2 * n_copy
        n_copy = n_copy - 2
        go to 10
      end if

      return
      end
      subroutine i4_factorial2_values ( n_data, n, fn )

c*********************************************************************72
c
cc I4_FACTORIAL2_VALUES returns values of the double factorial function.
c
c  Discussion:
c
c    FACTORIAL2( N ) = Product ( N * (N-2) * (N-4) * ... * 2 )  (N even)
c                    = Product ( N * (N-2) * (N-4) * ... * 1 )  (N odd)
c
c    In Mathematica, the function can be evaluated by:
c
c      n!!
c
c  Example:
c
c     N    N!!
c
c     0     1
c     1     1
c     2     2
c     3     3
c     4     8
c     5    15
c     6    48
c     7   105
c     8   384
c     9   945
c    10  3840
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    24 March 2007
c
c  Author:
c
c    John Burkardt
c
c  Reference:
c
c    Milton Abramowitz, Irene Stegun,
c    Handbook of Mathematical Functions,
c    National Bureau of Standards, 1964,
c    ISBN: 0-486-61272-4,
c    LC: QA47.A34.
c
c    Stephen Wolfram,
c    The Mathematica Book,
c    Fourth Edition,
c    Cambridge University Press, 1999,
c    ISBN: 0-521-64314-7,
c    LC: QA76.95.W65.
c
c    Daniel Zwillinger, editor,
c    CRC Standard Mathematical Tables and Formulae,
c    30th Edition,
c    CRC Press, 1996,
c    ISBN: 0-8493-2479-3,
c    LC: QA47.M315.
c
c  Parameters:
c
c    Input/output, integer N_DATA.  The user sets N_DATA to 0 before the
c    first call.  On each call, the routine increments N_DATA by 1, and
c    returns the corresponding data; when there is no more data, the
c    output value of N_DATA will be 0 again.
c
c    Output, integer N, the argument of the function.
c
c    Output, integer FN, the value of the function.
c
      implicit none

      integer n_max
      parameter ( n_max = 16 )

      integer fn_vec(n_max)
      integer fn
      integer n_data
      integer n
      integer n_vec(n_max)

      save fn_vec
      save n_vec

      data fn_vec /
     &        1,
     &        1,
     &        2,
     &        3,
     &        8,
     &       15,
     &       48,
     &      105,
     &      384,
     &      945,
     &     3840,
     &    10395,
     &    46080,
     &   135135,
     &   645120,
     &  2027025 /
      data n_vec /
     &   0,
     &   1,  2,  3,  4,  5,
     &   6,  7,  8,  9, 10,
     &  11, 12, 13, 14, 15 /

      if ( n_data .lt. 0 ) then
        n_data = 0
      end if

      n_data = n_data + 1

      if ( n_max .lt. n_data ) then
        n_data = 0
        n = 0
        fn = 0
      else
        n = n_vec(n_data)
        fn = fn_vec(n_data)
      end if

      return
      end
      function i4_fall ( x, n )

c*********************************************************************72
c
cc I4_FALL computes the falling factorial function [X]_N.
c
c  Discussion:
c
c    Note that the number of "injections" or 1-to-1 mappings from
c    a set of N elements to a set of M elements is [M]_N.
c
c    The number of permutations of N objects out of M is [M]_N.
c
c    Moreover, the Stirling numbers of the first kind can be used
c    to convert a falling factorial into a polynomial, as follows:
c
c      [X]_N = S^0_N + S^1_N * X + S^2_N * X^2 + ... + S^N_N X^N.
c
c    The formula used is:
c
c      [X]_N = X * ( X - 1 ) * ( X - 2 ) * ... * ( X - N + 1 ).
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    21 November 2013
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer X, the argument of the falling factorial function.
c
c    Input, integer N, the order of the falling factorial function.
c    If N = 0, FALL = 1, if N = 1, FALL = X.  Note that if N is
c    negative, a "rising" factorial will be computed.
c
c    Output, integer I4_FALL, the value of the falling 
c    factorial function.
c
      implicit none

      integer arg
      integer i
      integer i4_fall
      integer n
      integer value
      integer x

      value = 1

      arg = x

      if ( 0 .lt. n ) then

        do i = 1, n
          value = value * arg
          arg = arg - 1
        end do

      else if ( n .lt. 0 ) then

        do i = -1, n, -1
          value = value * arg
          arg = arg + 1
        end do

      end if

      i4_fall = value

      return
      end
      subroutine i4_fall_values ( n_data, m, n, fmn )

c*********************************************************************72
c
cc I4_FALL_VALUES returns values of the integer falling factorial function.
c
c  Discussion:
c
c    The definition of the falling factorial function is
c
c      (m)_n = (m)! / (m-n)!
c            = ( m ) * ( m - 1 ) * ( m - 2 ) ... * ( m - n + 1 )
c            = Gamma ( m + 1 ) / Gamma ( m - n + 1 )
c
c    We assume 0 <= N <= M.
c
c    In Mathematica, the function can be evaluated by:
c
c      FactorialPower[m,n]
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    14 December 2014
c
c  Author:
c
c    John Burkardt
c
c  Reference:
c
c    Milton Abramowitz, Irene Stegun,
c    Handbook of Mathematical Functions,
c    National Bureau of Standards, 1964,
c    ISBN: 0-486-61272-4,
c    LC: QA47.A34.
c
c    Stephen Wolfram,
c    The Mathematica Book,
c    Fourth Edition,
c    Cambridge University Press, 1999,
c    ISBN: 0-521-64314-7,
c    LC: QA76.95.W65.
c
c  Parameters:
c
c    Input/output, integer N_DATA.  The user sets N_DATA to 0
c    before the first call.  On each call, the routine increments N_DATA by 1,
c    and returns the corresponding data; when there is no more data, the
c    output value of N_DATA will be 0 again.
c
c    Output, integer M, N, the arguments of the function.
c
c    Output, integer FMN, the value of the function.
c
      implicit none

      integer n_max
      parameter ( n_max = 15 )

      integer fmn
      integer fmn_vec(n_max)
      integer m
      integer m_vec(n_max)
      integer n
      integer n_data
      integer n_vec(n_max)

      save fmn_vec
      save m_vec
      save n_vec

      data fmn_vec /
     &   1, 5, 20, 60, 120, 
     &   120, 0, 1, 10, 4000, 
     &   90, 4896, 24, 912576, 0 /
      data m_vec /
     &  5, 5, 5, 5, 5, 
     &  5, 5, 50, 10, 4000, 
     &  10, 18, 4, 98, 1 /
      data n_vec /
     &  0, 1, 2, 3, 4, 
     &  5, 6, 0, 1, 1, 
     &  2, 3, 4, 3, 7 /

      if ( n_data .lt. 0 ) then
        n_data = 0
      end if

      n_data = n_data + 1

      if ( n_max .lt. n_data ) then
        n_data = 0
        m = 0
        n = 0
        fmn = 0
      else
        m = m_vec(n_data)
        n = n_vec(n_data)
        fmn = fmn_vec(n_data)
      end if

      return
      end
      function i4_floor ( r )

c*********************************************************************72
c
cc I4_FLOOR rounds an R8 "down" (towards -infinity) to the nearest I4.
c
c  Example:
c
c    R     Value
c
c   -1.1  -2
c   -1.0  -1
c   -0.9  -1
c    0.0   0
c    5.0   5
c    5.1   5
c    5.9   5
c    6.0   6
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    10 November 2011
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, double precision R, the value to be rounded down.
c
c    Output, integer I4_FLOOR, the rounded value.
c
      implicit none

      integer i4_floor
      double precision r
      integer value

      value = int ( r )
      if ( r .lt. dble ( value ) ) then
        value = value - 1
      end if

      i4_floor = value

      return
      end
      subroutine i4_fraction ( i, j, k )

c*********************************************************************72
c
cc I4_FRACTION computes a ratio and returns an integer result.
c
c  Discussion:
c
c    Given integer variables I and J, FORTRAN will evaluate the expression
c    "I/J" using integer arithmetic.  This routine, which carries out the
c    same operation, is thus not needed in FORTRAN.  It is provided simply
c    to match the corresponding function in MATLAB, where the default
c    result of "I/J" is a real number.
c
c  Example:
c
c       I     J     Real     K = I4_FRACTION ( I, J)
c
c       1     2     0.5      0
c       8     4     2.00     2
c       9     4     2.25     2
c       7     4     1.75     1
c      -7     4    -1.75    -1
c       7    -4    -1.75    -1
c      -7    -4     1.75     1
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    11 October 2010
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer I, J, the arguments.
c
c    Output, integer K, the value of the ratio.
c
      implicit none

      integer i
      integer j
      integer k

      k = i / j

      return
      end
      function i4_gcd ( i, j )

c*********************************************************************72
c
cc I4_GCD finds the greatest common divisor of I and J.
c
c  Discussion:
c
c    Only the absolute values of I and J are
c    considered, so that the result is always nonnegative.
c
c    If I or J is 0, I4_GCD is returned as max ( 1, abs ( I ), abs ( J ) ).
c
c    If I and J have no common factor, I4_GCD is returned as 1.
c
c    Otherwise, using the Euclidean algorithm, I4_GCD is the
c    largest common factor of I and J.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    03 March 1999
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer I, J, two numbers whose greatest common divisor
c    is desired.
c
c    Output, integer I4_GCD, the greatest common divisor of I and J.
c
      implicit none

      integer i
      integer i4_gcd
      integer ip
      integer iq
      integer ir
      integer j

      i4_gcd = 1
c
c  Return immediately if either I or J is zero.
c
      if ( i .eq. 0 ) then
        i4_gcd = max ( 1, abs ( j ) )
        return
      else if ( j .eq. 0 ) then
        i4_gcd = max ( 1, abs ( i ) )
        return
      end if
c
c  Set IP to the larger of I and J, IQ to the smaller.
c  This way, we can alter IP and IQ as we go.
c
      ip = max ( abs ( i ), abs ( j ) )
      iq = min ( abs ( i ), abs ( j ) )
c
c  Carry out the Euclidean algorithm.
c
10    continue

        ir = mod ( ip, iq )

        if ( ir .eq. 0 ) then
          go to 20
        end if

        ip = iq
        iq = ir

      go to 10

20    continue

      i4_gcd = iq

      return
      end
      function i4_gcdb ( i, j, k )

c*********************************************************************72
c
cc I4_GCDB finds the greatest common divisor of the form K^N of two I4's.
c
c  Discussion:
c
c    Note that if J is negative, I4_GCDB will also be negative.
c    This is because it is likely that the caller is forming
c    the fraction I/J, and so any minus sign should be
c    factored out of J.
c
c    If I and J are both zero, I4_GCDB is returned as 1.
c
c    If I is zero and J is not, I4_GCDB is returned as J,
c    and vice versa.
c
c    If I and J are nonzero, and have no common divisor of the
c    form K^N, I4_GCDB is returned as 1.
c
c    Otherwise, I4_GCDB is returned as the largest common divisor
c    of the form K^N shared by I and J.
c
c    An I4 is an integer value.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    24 October 2007
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer I, J, two numbers whose greatest common
c    divisor K^N is desired.
c
c    Input, integer K, the possible divisor of I and J.
c
c    Output, integer I4_GCDB, the greatest common divisor of
c    the form K^N shared by I and J.
c
      implicit none

      integer i
      integer icopy
      integer i4_gcdb
      integer j
      integer jcopy
      integer k

      i4_gcdb = 1
c
c  If both I and J are zero, I4_GCDB is 1.
c
      if ( i .eq. 0 .and. j .eq. 0 ) then
        i4_gcdb = 1
        return
      end if
c
c  If just one of I and J is zero, I4_GCDB is the other one.
c
      if ( i .eq. 0 ) then
        i4_gcdb = j
        return
      else if ( j .eq. 0 ) then
        i4_gcdb = i
        return
      end if
c
c  Divide out K as long as you can.
c
      if ( 0 .lt. j ) then
        i4_gcdb = 1
      else
        i4_gcdb = -1
      end if

      icopy = i
      jcopy = j

10    continue

        if ( mod ( icopy, k ) .ne. 0 .or.
     &       mod ( jcopy, k ) .ne. 0 ) then
          go to 20
        end if

        i4_gcdb = i4_gcdb * k
        icopy = icopy / k
        jcopy = jcopy / k

      go to 10

20    continue

      return
      end
      function i4_huge ( )

c*********************************************************************72
c
cc I4_HUGE returns a "huge" I4.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    13 November 2006
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Output, integer I4_HUGE, a huge number.
c
      implicit none

      integer i4_huge

      i4_huge = 2147483647

      return
      end
      function i4_huge_normalizer ( )

c*********************************************************************72
c
cc I4_HUGE_NORMALIZER returns the "normalizer" for I4_HUGE.
c
c  Discussion:
c
c    The value returned is 1 / ( I4_HUGE + 1 ).
c
c    For any I4, it should be the case that
c
c     -1 < I4 * I4_HUGE_NORMALIZER < 1.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    26 January 2007
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Output, double precision I4_HUGE_NORMALIZER, the "normalizer"
c    for I4_HUGE.
c
      implicit none

      double precision i4_huge_normalizer

      i4_huge_normalizer = 4.656612873077392578125D-10

      return
      end
      function i4_is_even ( i )

c*********************************************************************72
c
cc I4_IS_EVEN returns TRUE if an I4 is even.
c
c  Discussion:
c
c    An I4 is an integer value.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    27 May 2002
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer I, the integer to be tested.
c
c    Output, logical I4_IS_EVEN, is TRUE if I is even.
c
      implicit none

      integer i
      logical i4_is_even

      i4_is_even = ( mod ( i, 2 ) .eq. 0 )

      return
      end
      function i4_is_odd ( i )

c*********************************************************************72
c
cc I4_IS_ODD returns TRUE if an I4 is odd.
c
c  Discussion:
c
c    An I4 is an integer value.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    28 October 2007
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer I, the integer to be tested.
c
c    Output, logical I4_IS_ODD, is TRUE if I is odd.
c
      implicit none

      integer i
      logical i4_is_odd

      i4_is_odd = ( mod ( i + 1, 2 ) .eq. 0 )

      return
      end
      function i4_is_power_of_2 ( n )

c*********************************************************************72
c
cc I4_IS_POWER_OF_2 reports whether an I4 is a power of 2.
c
c  Discussion:
c
c    The powers of 2 are 1, 2, 4, 8, 16, and so on.
c
c    An I4 is an integer value.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    24 October 2007
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the integer to be tested.
c
c    Output, logical I4_IS_POWER_OF_2, is TRUE if N is a power of 2.
c
      implicit none

      logical i4_is_power_of_2
      integer n
      integer n_copy

      n_copy = n
      i4_is_power_of_2 = .false.

      if ( n_copy .le. 0 ) then
        return
      end if

10    continue

      if ( n_copy .ne. 1 ) then

        if ( mod ( n_copy, 2 ) .eq. 1 ) then
          return
        end if

        n_copy = n_copy / 2

        go to 10

      end if

      i4_is_power_of_2 = .true.

      return
      end
      function i4_is_prime ( n )

c*********************************************************************72
c
cc I4_IS_PRIME reports whether an I4 is prime.
c
c  Discussion:
c
c    A simple, unoptimized sieve of Erasthosthenes is used to
c    check whether N can be divided by any integer between 2
c    and SQRT(N).
c
c    Note that negative numbers, 0 and 1 are not considered prime.
c
c    An I4 is an integer value.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    26 October 2007
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the integer to be tested.
c
c    Output, logical I4_IS_PRIME, is TRUE if N is prime, and FALSE
c    otherwise.
c
      implicit none

      integer i
      logical i4_is_prime
      integer n
      integer nhi

      if ( n .le. 0 ) then
        i4_is_prime = .false.
        return
      end if

      if ( n .eq. 1 ) then
        i4_is_prime = .false.
        return
      end if

      if ( n .le. 3 ) then
        i4_is_prime = .true.
        return
      end if

      nhi = int ( sqrt ( real ( n ) ) )

      do i = 2, nhi
        if ( mod ( n, i ) .eq. 0 ) then
          i4_is_prime = .false.
          return
        end if
      end do

      i4_is_prime = .true.

      return
      end
      function i4_lcm ( i, j )

c*********************************************************************72
c
cc I4_LCM computes the least common multiple of two I4's.
c
c  Discussion:
c
c    The least common multiple may be defined as
c
c      LCM(I,J) = ABS( I * J ) / GCD(I,J)
c
c    where GCD(I,J) is the greatest common divisor of I and J.
c
c    An I4 is an integer value.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    26 October 2007
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer I, J, the integers whose I4_LCM is desired.
c
c    Output, integer I4_LCM, the least common multiple of I and J.
c    I4_LCM is never negative.  I4_LCM is 0 if either I or J is zero.
c
      implicit none

      integer i
      integer i4_gcd
      integer j
      integer i4_lcm

      i4_lcm = abs ( i * ( j / i4_gcd ( i, j ) ) )

      return
      end
      function i4_log_10 ( i )

c*********************************************************************72
c
cc I4_LOG_10 returns the integer part of the logarithm base 10 of ABS(X).
c
c  Discussion:
c
c    I4_LOG_10 ( I ) + 1 is the number of decimal digits in I.
c
c  Example:
c
c        I  I4_LOG_10
c    -----  --------
c        0    0
c        1    0
c        2    0
c        9    0
c       10    1
c       11    1
c       99    1
c      100    2
c      101    2
c      999    2
c     1000    3
c     1001    3
c     9999    3
c    10000    4
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    03 January 2007
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer I, the number whose logarithm base 10 is desired.
c
c    Output, integer I4_LOG_10, the integer part of the logarithm base 10 of
c    the absolute value of X.
c
      implicit none

      integer i
      integer i_abs
      integer i4_log_10
      integer ten_pow

      if ( i .eq. 0 ) then

        i4_log_10 = 0

      else

        i4_log_10 = 0
        ten_pow = 10

        i_abs = abs ( i )

10      continue

        if ( ten_pow .le. i_abs ) then
          i4_log_10 = i4_log_10 + 1
          ten_pow = ten_pow * 10
          go to 10
        end if

      end if

      return
      end
      function i4_log_2 ( i )

c*********************************************************************72
c
cc I4_LOG_2 returns the integer part of the logarithm base 2 of an I4.
c
c  Discussion:
c
c    For positive I4_LOG_2(I), it should be true that
c      2^I4_LOG_2(X) .le. |I| < 2^(I4_LOG_2(I)+1).
c    The special case of I4_LOG_2(0) returns -HUGE().
c
c    An I4 is an integer value.
c
c  Example:
c
c     I  I4_LOG_2
c
c     0  -1
c     1,  0
c     2,  1
c     3,  1
c     4,  2
c     5,  2
c     6,  2
c     7,  2
c     8,  3
c     9,  3
c    10,  3
c   127,  6
c   128,  7
c   129,  7
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    28 October 2007
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer I, the number whose logarithm base 2
c    is desired.
c
c    Output, integer I4_LOG_2, the integer part of the
c    logarithm base 2 of the absolute value of I.
c
      implicit none

      integer i
      integer i_abs
      integer i4_log_2
      integer i4_huge
      parameter ( i4_huge = 2147483647 )

      if ( i .eq. 0 ) then

        i4_log_2 = - i4_huge

      else

        i4_log_2 = 0

        i_abs = abs ( i )

10      continue

        if ( 2 .le. i_abs ) then
          i_abs = i_abs / 2
          i4_log_2 = i4_log_2 + 1
          go to 10
        end if

      end if

      return
      end
      function i4_log_i4 ( i4, j4 )

c*********************************************************************72
c
cc I4_LOG_I4 returns the logarithm of an I4 to an I4 base.
c
c  Discussion:
c
c    Only the integer part of the logarithm is returned.
c
c    If
c
c      K4 = I4_LOG_J4 ( I4, J4 ),
c
c    then we ordinarily have
c
c      J4^(K4-1) < I4 .le. J4^K4.
c
c    The base J4 should be positive, and at least 2.  If J4 is negative,
c    a computation is made using the absolute value of J4.  If J4 is
c    -1, 0, or 1, the logarithm is returned as 0.
c
c    The number I4 should be positive and at least 2.  If I4 is negative,
c    a computation is made using the absolute value of I4.  If I4 is
c    -1, 0, or 1, then the logarithm is returned as 0.
c
c    An I4 is an integer value.
c
c  Example:
c
c    I4  J4  K4
c
c     0   3   0
c     1   3   0
c     2   3   0
c     3   3   1
c     4   3   1
c     8   3   1
c     9   3   2
c    10   3   2
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    28 October 2007
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer I4, the number whose logarithm is desired.
c
c    Input, integer J4, the base of the logarithms.
c
c    Output, integer I4_LOG_I4, the integer part of the logarithm
c    base abs(J4) of abs(I4).
c
      implicit none

      integer i4
      integer i4_abs
      integer i4_log_i4
      integer j4
      integer j4_abs
      integer value

      value = 0

      i4_abs = abs ( i4 )

      if ( 2 .le. i4_abs ) then

        j4_abs = abs ( j4 )

        if ( 2 .le. j4_abs ) then

10        continue

          if ( j4_abs .le. i4_abs ) then
            i4_abs = i4_abs / j4_abs
            value = value + 1
            go to 10
          end if

        end if

      end if

      i4_log_i4 = value

      return
      end
      function i4_log_r8 ( x, b )

c*********************************************************************72
c
cc I4_LOG_R8 returns the logarithm of an I4 to an R8 base.
c
c  Discussion:
c
c    The base B should be positive, but in any case only the absolute
c    value of B is considered.
c
c    The number X whose logarithm is desired should be positive, but
c    in any case only the absolute value of X is considered.
c
c    An I4 is an integer value.
c
c    An R8 is a double precision value.
c
c  Example:
c
c    If B is greater than 1, and X is positive:
c
c    if 1/B^2  <  X .le. 1/B   I4_LOG_R8(X) = -1,
c    if 1/B    <  X .le. 1     I4_LOG_R8(X) = 0,
c    if 1      .le. X <  B,    I4_LOG_R8(X) = 0,
c    if B      .le. X <  B^2   I4_LOG_R8(X) = 1,
c    if B^2    .le. X <  B^3   I4_LOG_R8(X) = 2.
c
c    For positive I4_LOG_R8(X), it should be true that
c
c      ABS(B)^I4_LOG_R8(X) .le. ABS(X) < ABS(B)^(I4_LOG_R8(X)+1).
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    28 October 2007
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer X, the number whose logarithm base B is
c    desired.  If X is 0, then I4_LOG_B is returned as -I4_HUGE().
c
c    Input, double precision B, the absolute value of the base of the
c    logarithms.  B must not be -1, 0, or 1.
c
c    Output, integer I4_LOG_R8, the integer part of the logarithm
c    base abs(B) of abs(X).
c
      implicit none

      double precision b
      double precision b_abs
      integer i4_huge
      parameter ( i4_huge = 2147483647 )
      integer i4_log_r8
      integer value_sign
      integer x
      double precision x_abs

      if ( x .eq. 0 ) then
        i4_log_r8 = - i4_huge
        return
      end if

      b_abs = abs ( b )
      i4_log_r8 = 0

      if ( b_abs .eq. 1.0D+00 ) then
        return
      end if

      if ( b .eq. 0.0D+00 ) then
        return
      end if

      x_abs = abs ( dble ( x ) )

      if ( b_abs .lt. 1.0D+00 ) then
        value_sign = -1
        b_abs = 1.0D+00 / b_abs
      else
        value_sign = +1
      end if

      if ( 1.0D+00 .le. x_abs .and. x_abs .lt. b_abs ) then
        i4_log_r8 = value_sign * i4_log_r8
        return
      end if

10    continue

      if ( b_abs .lt. x_abs ) then
        x_abs = x_abs / b_abs
        i4_log_r8 = i4_log_r8 + 1
        go to 10
      end if

20    continue

      if ( x_abs * b_abs .le. 1.0D+00 ) then
        x_abs = x_abs * b_abs
        i4_log_r8 = i4_log_r8 - 1
        go to 20
      end if
c
c  If the absolute value of the base was less than 1, we inverted
c  earlier.  Now negate the logarithm to account for that.
c
      i4_log_r8 = value_sign * i4_log_r8

      return
      end
      subroutine i4_mant ( x, s, j, k, l )

c*********************************************************************72
c
cc I4_MANT computes the "mantissa" of a double precision number.
c
c  Discussion:
c
c    I4_MANT computes the "mantissa" or "fraction part" of a real
c    number X, which it stores as a pair of integers, (J/K).
c
c    It also computes the sign, and the integer part of the logarithm
c    (base 2) of X.
c
c    On return:
c
c      X = S * (J/K) * 2^L
c
c    where
c
c      S is +1 or -1,
c      K is a power of 2,
c      1 .le. (J/K) .lt. 2,
c      L is an integer.
c
c    An I4 is an integer value.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    28 October 2007
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, double precision X, the number to be decomposed.
c
c    Output, integer S, the "sign" of the number.
c    S will be -1 if X is less than 0, and +1 if X is greater
c    than or equal to zero.
c
c    Output, integer J, the top part of the mantissa fraction.
c
c    Output, integer K, the bottom part of the mantissa
c    fraction.  K is a power of 2.
c
c    Output, integer L, the integer part of the logarithm
c    (base 2) of X.
c
      implicit none

      integer j
      integer k
      integer l
      integer s
      double precision x
      double precision xtemp
c
c  1: Handle the special case of 0.
c
      if ( x .eq. 0.0D+00 ) then
        s = 1
        j = 0
        k = 1
        l = 0
        return
      end if
c
c  2: Determine the sign S.
c
      if ( 0.0D+00 .lt. x ) then
        s = 1
        xtemp = x
      else
        s = -1
        xtemp = -x
      end if
c
c  3: Force XTEMP to lie between 1 and 2, and compute the logarithm L.
c
      l = 0

10    continue

      if ( 2.0D+00 .le. xtemp ) then
        xtemp = xtemp / 2.0D+00
        l = l + 1
        go to 10
      end if

20    continue

      if ( xtemp .lt. 1.0D+00 ) then
        xtemp = xtemp * 2.0D+00
        l = l - 1
        go to 20
      end if
c
c  4: Now strip out the mantissa as J/K.
c
      j = 0
      k = 1

30    continue

        j = 2 * j

        if ( 1.0D+00 .le. xtemp ) then
          j = j + 1
          xtemp = xtemp - 1.0D+00
        end if

        if ( xtemp .eq. 0.0D+00 ) then
          go to 40
        end if

        k = 2 * k
        xtemp = xtemp * 2.0D+00

      go to 30

40    continue

      return
      end
      function i4_max ( x, y )

c*********************************************************************72
c
cc I4_MAX returns the maximum of two I4's.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    10 March 2015
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer X, Y, the numbers to compare.
c
c    Output, integer I4_MAX, the maximum of X and Y.
c
      implicit none

      integer i4_max
      integer x
      integer y

      if ( x .lt. y ) then
        i4_max = y
      else
        i4_max = x
      end if

      return
      end
      function i4_min ( x, y )

c*********************************************************************72
c
cc I4_MIN returns the minimum of two I4's.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    10 March 2015
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer X, Y, the numbers to compare.
c
c    Output, integer I4_MIN, the minimum of X and Y.
c
      implicit none

      integer i4_min
      integer x
      integer y

      if ( x .lt. y ) then
        i4_min = x
      else
        i4_min = y
      end if

      return
      end
      subroutine i4_mod_inv ( b, n, y )

c*********************************************************************72
c
cc I4_MOD_INV calculates the inverse of B mod N.
c
c  Discussion:
c
c    This function uses the extended Euclidean algorithm.
c
c    Unless the algorithm fails, the output value Y will satisfy
c
c      ( B * Y ) mod N = 1
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    22 August 2011
c
c  Author:
c
c    Original MATLAB version by Wade Trappe, Lawrence Washington.
c    FORTRAN77 version by John Burkardt.
c
c  Reference:
c
c    Wade Trappe, Lawrence Washington,
c    Introduction to Cryptography with Coding Theory,
c    Prentice Hall, 2005,
c    ISBN13: 978-0131862395,
c    LC: QA268.T73.
c
c  Parameters:
c
c    Input, integer B, the value whose inverse is desired.
c    B must not be 0, or a multiple of N.  However, B can be negative.
c
c    Input, integer N, the value with respect to which the inverse
c    is desired.  N must be 2 or greater.
c
c    Output, integer Y, the inverse of B mod N.  However, if the
c    inverse does not exist, Y is returned as 0.
c
      implicit none

      integer b
      integer b0
      integer n
      integer n0
      integer q
      integer r
      integer t
      integer t0
      integer temp
      integer y

      n0 = n
      b0 = abs ( b )
      t0 = 0
      t = 1

      q = ( n0 / b0 )
      r = n0 - q * b0

10    continue

      if ( 0 .lt. r ) then

        temp = t0 - q * t

        if ( 0 .le. temp ) then
          temp =     mod (   temp, n )
        else
          temp = n - mod ( - temp, n )
        end if

        n0 = b0
        b0 = r
        t0 = t
        t = temp

        q = ( n0 / b0 )
        r = n0 - q * b0

        go to 10

      end if

      if ( b0 .ne. 1 ) then
        y = 0
      else
        y = mod ( t, n )
        if ( b .lt. 0 ) then
          y = - y
        end if
      end if

      return
      end
      subroutine i4_moddiv ( n, d, m, r )

c*********************************************************************72
c
cc I4_MODDIV breaks an I4 into a multiple of a divisor and remainder.
c
c  Discussion:
c
c    The formula used is:
c
c      N = M * D + R
c
c      0 <= || R || < || D ||
c
c    and R has the sign of N.
c
c    An I4 is an integer value.
c
c  Example:
c
c      N         D       M      R
c
c     107       50      2      7
c     107      -50     -2      7
c    -107       50     -2     -7
c    -107      -50      2     -7
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    28 October 2007
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the number to be decomposed.
c
c    Input, integer D, the divisor.  D may not be zero.
c
c    Output, integer M, the number of times N
c    is evenly divided by D.
c
c    Output, integer R, a remainder.
c
      implicit none

      integer d
      integer m
      integer n
      integer r

      if ( d .eq. 0 ) then
        write ( *, '(a)' ) ' '
        write ( *, '(a)' ) 'I4_MODDIV - Fatal error!'
        write ( *, '(a)' ) '  Input divisor D = 0'
        stop 1
      end if

      m = n / d
      r = n - d * m

      return
      end
      function i4_modp ( i, j )

c*********************************************************************72
c
cc I4_MODP returns the nonnegative remainder of integer division.
c
c  Discussion:
c
c    If
c      NREM = I4_MODP ( I, J )
c      NMULT = ( I - NREM ) / J
c    then
c      I = J * NMULT + NREM
c    where NREM is always nonnegative.
c
c    The MOD function computes a result with the same sign as the
c    quantity being divided.  Thus, suppose you had an angle A,
c    and you wanted to ensure that it was between 0 and 360.
c    Then mod(A,360) would do, if A was positive, but if A
c    was negative, your result would be between -360 and 0.
c
c    On the other hand, I4_MODP(A,360) is between 0 and 360, always.
c
c  Example:
c
c        I     J     MOD I4_MODP    Factorization
c
c      107    50       7       7    107 =  2 *  50 + 7
c      107   -50       7       7    107 = -2 * -50 + 7
c     -107    50      -7      43   -107 = -3 *  50 + 43
c     -107   -50      -7      43   -107 =  3 * -50 + 43
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    30 December 2006
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer I, the number to be divided.
c
c    Input, integer J, the number that divides I.
c
c    Output, integer I4_MODP, the nonnegative remainder when I is
c    divided by J.
c
      implicit none

      integer i
      integer i4_modp
      integer j
      integer value

      if ( j .eq. 0 ) then
        write ( *, '(a)' ) ' '
        write ( *, '(a)' ) 'I4_MODP - Fatal error!'
        write ( *, '(a,i8)' ) '  Illegal divisor J = ', j
        stop 1
      end if

      value = mod ( i, j )

      if ( value .lt. 0 ) then
        value = value + abs ( j )
      end if

      i4_modp = value

      return
      end
      function i4_mop ( i )

c*********************************************************************72
c
cc I4_MOP returns the I-th power of -1 as an I4 value.
c
c  Discussion:
c
c    An I4 is an integer value.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    29 August 2008
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer I, the power of -1.
c
c    Output, integer I4_MOP, the I-th power of -1.
c
      implicit none

      integer i
      integer i4_mop

      if ( mod ( i, 2 ) .eq. 0 ) then
        i4_mop = 1
      else
        i4_mop = -1
      end if

      return
      end
      function i4_power ( i, j )

c*********************************************************************72
c
cc I4_POWER returns the integer power of an I4.
c
c  Discussion:
c
c    An I4 is an integer value.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    22 October 2007
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer I, J, the base and the power.
c    J should be nonnegative.
c
c    Output, integer I4_POWER, the value of I^J.
c
      implicit none

      integer i
      integer i4_power
      integer j
      integer k

      if ( j .lt. 0 ) then

        if ( i .eq. 1 ) then
          i4_power = 1
        else if ( i .eq. 0 ) then
          write ( *, '(a)' ) ' '
          write ( *, '(a)' ) 'I4_POWER - Fatal error!'
          write ( *, '(a)' ) '  I^J requested, with I = 0, J negative.'
          stop 1
        else
          i4_power = 0
        end if

      else if ( j .eq. 0 ) then

        if ( i .eq. 0 ) then
          write ( *, '(a)' ) ' '
          write ( *, '(a)' ) 'I4_POWER - Fatal error!'
          write ( *, '(a)' ) '  I^J requested, with I = 0 and J = 0.'
          stop 1
        else
          i4_power = 1
        end if

      else if ( j .eq. 1 ) then

        i4_power = i

      else

        i4_power = 1
        do k = 1, j
          i4_power = i4_power * i
        end do

      end if

      return
      end
      function i4_rise ( x, n )

c*********************************************************************72
c
cc I4_RISE computes the rising factorial function [X]^N.
c
c  Discussion:
c
c    [X]^N = X * ( X + 1 ) * ( X + 2 ) * ... * ( X + N - 1 ).
c
c    Note that the number of ways of arranging N objects in M ordered
c    boxes is [M]^N.  (Here, the ordering of the objects in each box matters).  
c    Thus, 2 objects in 2 boxes have the following 6 possible arrangements:
c
c      -|12, 1|2, 12|-, -|21, 2|1, 21|-.
c
c    Moreover, the number of non-decreasing maps from a set of
c    N to a set of M ordered elements is [M]^N / N!.  Thus the set of
c    nondecreasing maps from (1,2,3) to (a,b,c,d) is the 20 elements:
c
c      aaa, abb, acc, add, aab, abc, acd, aac, abd, aad
c      bbb, bcc, bdd, bbc, bcd, bbd, ccc, cdd, ccd, ddd.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    20 January 2007
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer X, the argument of the rising factorial function.
c
c    Input, integer N, the order of the rising factorial function.
c    If N = 0, RISE = 1, if N = 1, RISE = X.  Note that if N is
c    negative, a "falling" factorial will be computed.
c
c    Output, integer I4_RISE, the value of the rising factorial 
c    function.
c
      implicit none

      integer arg
      integer i
      integer i4_rise
      integer n
      integer value
      integer x

      value = 1

      arg = x

      if ( 0 .lt. n ) then

        do i = 1, n
          value = value * arg
          arg = arg + 1
        end do

      else if ( n .lt. 0 ) then

        do i = -1, n, -1
          value = value * arg
          arg = arg - 1
        end do

      end if

      i4_rise = value

      return
      end
      subroutine i4_rise_values ( n_data, m, n, fmn )

c*********************************************************************72
c
cc I4_RISE_VALUES returns values of the integer rising factorial function.
c
c  Discussion:
c
c    The rising factorial function is sometimes symbolized by (m)_n.
c
c    The definition is
c
c      (m)_n = (m-1+n)! / (m-1)!
c            = ( m ) * ( m + 1 ) * ( m + 2 ) ... * ( m - 1 + n )
c            = Gamma ( m + n ) / Gamma ( m )
c
c    We assume 0 <= N <= M.
c
c    In Mathematica, the function can be evaluated by:
c
c      Pochhammer[m,n]
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    24 March 2007
c
c  Author:
c
c    John Burkardt
c
c  Reference:
c
c    Milton Abramowitz, Irene Stegun,
c    Handbook of Mathematical Functions,
c    National Bureau of Standards, 1964,
c    ISBN: 0-486-61272-4,
c    LC: QA47.A34.
c
c    Stephen Wolfram,
c    The Mathematica Book,
c    Fourth Edition,
c    Cambridge University Press, 1999,
c    ISBN: 0-521-64314-7,
c    LC: QA76.95.W65.
c
c  Parameters:
c
c    Input/output, integer N_DATA.  The user sets N_DATA to 0 before the
c    first call.  On each call, the routine increments N_DATA by 1, and
c    returns the corresponding data; when there is no more data, the
c    output value of N_DATA will be 0 again.
c
c    Output, integer M, N, the arguments of the function.
c
c    Output, integer FMN, the value of the function.
c
      implicit none

      integer n_max
      parameter ( n_max = 15 )

      integer fmn
      integer fmn_vec(n_max)
      integer m
      integer m_vec(n_max)
      integer n
      integer n_data
      integer n_vec(n_max)

      save fmn_vec
      save m_vec
      save n_vec

      data fmn_vec /
     &  1, 5, 30, 210, 1680, 
     &  15120, 151200, 1, 10, 4000, 
     &  110, 6840, 840, 970200, 5040 /
      data m_vec /
     &  5, 5, 5, 5, 5, 
     &  5, 5, 50, 10, 4000, 
     & 10, 18, 4, 98, 1 /
      data n_vec /
     &  0, 1, 2, 3, 4, 
     &  5, 6, 0, 1, 1, 
     &  2, 3, 4, 3, 7 /

      if ( n_data .lt. 0 ) then
        n_data = 0
      end if

      n_data = n_data + 1

      if ( n_max .lt. n_data ) then
        n_data = 0
        m = 0
        n = 0
        fmn = 0
      else
        m = m_vec(n_data)
        n = n_vec(n_data)
        fmn = fmn_vec(n_data)
      end if

      return
      end
      function i4_sign ( x )

c*********************************************************************72
c
cc I4_SIGN evaluates the sign of an I4.
c
c  Discussion:
c
c    This is the "two-way" sign of an I4.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    28 September 2014
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer X, the number whose sign is desired.
c
c    Output, integer I4_SIGN, the sign of the number.
c
      implicit none

      integer i4_sign
      integer value
      integer x

      if ( x .lt. 0 ) then
        value = -1
      else
        value = +1
      end if

      i4_sign = value

      return
      end
      function i4_sign3 ( x )

c*********************************************************************72
c
cc I4_SIGN3 evaluates the three-way sign of an I4.
c
c  Discussion:
c
c    The value 0 has a sign of 0.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    28 September 2014
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer X, the number whose sign is desired.
c
c    Output, integer I4_SIGN3, the sign.
c
      implicit none

      integer i4_sign3
      integer value
      integer x

      if ( x .lt. 0 ) then
        value = -1
      else if ( x .eq. 0 ) then
        value = 0
      else
        value = +1
      end if

      i4_sign3 = value

      return
      end
      subroutine i4_swap ( i, j )

c*********************************************************************72
c
cc I4_SWAP switches two I4's.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    06 January 2006
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input/output, integer I, J.  On output, the values of I and
c    J have been interchanged.
c
      implicit none

      integer i
      integer j
      integer k

      k = i
      i = j
      j = k

      return
      end
      subroutine i4_swap3 ( i, j, k )

c*********************************************************************72
c
cc I4_SWAP3 swaps three I4's.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    31 December 2006
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input/output, integer I, J, K.  On output, the values of I, J, and K
c    have been interchanged.
c
      implicit none

      integer i
      integer j
      integer k
      integer l

      l = i
      i = j
      j = k
      k = l

      return
      end
      subroutine i4_to_angle ( i, angle )

c*********************************************************************72
c
cc I4_TO_ANGLE maps I4's to points on a circle.
c
c  Discussion:
c
c    The angles are intended to be used to select colors on a color
c    hexagon whose 6 vertices are red, yellow, green, cyan, blue,
c    magenta.
c
c    An I4 is an integer value.
c
c  Example:
c
c     I   X      ANGLE
c
c     0   0/3      0
c     1   1/3    120
c     2   2/3    240
c
c     3   1/6     60
c     4   3/6    180
c     5   5/6    300
c
c     6   1/12    30
c     7   3/12    90
c     8   5/12   150
c     9   7/12   210
c    10   9/12   270
c    11  11/12   330
c
c    12   1/24    15
c    13   3/24    45
c    14   5/24    75
c    etc
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    30 October 2007
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer I, the index of the desired color.
c
c    Output, double precision ANGLE, an angle, measured in degrees,
c    between 0 and 360.
c
      implicit none

      double precision angle
      integer i
      integer i4_log_2
      integer i1
      integer i2
      integer i3
      integer i4

      if ( 0 .le. abs ( i ) .and. abs ( i ) .le. 2 ) then

        angle = 120.0D+00 * dble ( abs ( i ) )

      else

        i1 = i4_log_2 ( abs ( i ) / 3 )
        i2 = abs ( i ) + 1 - 3 * ( 2 ** i1 )
        i3 = 2 * ( i2 - 1 ) + 1
        i4 = 3 * 2 ** ( i1 + 1 )

        angle = 360.0D+00 * dble ( i3 ) / dble ( i4 )

      end if

      return
      end
      subroutine i4_to_digits_binary ( i, n, c )

c*********************************************************************72
c
cc I4_TO_DIGITS_BINARY produces the binary digits of an I4.
c
c  Discussion:
c
c    An I4 is an integer.
c
c  Example:
c
c     I    N     C               Binary
c    --  ---   ---         ------------
c     0    1   0                      0
c     0    2   0, 0                  00
c     1    3   1, 0, 0              100
c     2    3   0, 1, 0              010
c     3    3   1, 1, 0              011
c     4    3   0, 0, 1              100
c     8    3   0, 0, 0           (1)000
c     8    5   0, 0, 0, 1, 0      01000
c    -8    5   0, 0, 0, 1, 0  (-) 01000
c
c     0    3   0, 0, 0
c     1    3   1, 0, 0
c     2    3   0, 1, 0
c     3    3   1, 1, 0
c     4    3   0, 0, 1
c     5    3   1, 0, 1
c     6    3   0, 1, 1
c     7    3   1, 1, 1
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    19 December 2011
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer I, an integer to be represented.
c
c    Input, integer N, the number of binary digits to produce.
c
c    Output, integer C(N), the first N binary digits of I,
c    with C(1) being the units digit.
c
      implicit none

      integer n

      integer c(n)
      integer i
      integer i_copy
      integer j

      i_copy = abs ( i )

      do j = 1, n

        c(j) = mod ( i_copy, 2 )
        i_copy = i_copy / 2

      end do

      return
      end
      subroutine i4_to_digits_decimal ( i, n, digit )

c*********************************************************************72
c
cc I4_TO_DIGITS_DECIMAL determines the last N decimal digits of an I4.
c
c  Discussion:
c
c    An I4 is an integer value.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    30 October 2007
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer I, the integer to be analyzed.
c
c    Input, integer N, the number of digits to determine.
c
c    Output, integer DIGIT(N), the last N decimal digits of I.
c    DIGIT(I) is the "coefficient" of 10**(I-1).
c
      implicit none

      integer n

      integer digit(n)
      integer i
      integer i_copy
      integer i4_ten
      parameter ( i4_ten = 10 )
      integer j

      i_copy = i

      do j = 1, n
        digit(j) = mod ( i_copy, i4_ten )
        i_copy = ( i_copy - digit(j) ) / 10
      end do

      return
      end
      subroutine i4_to_fac ( intval, prime_num, npower )

c*********************************************************************72
c
cc I4_TO_FAC converts an I4 into a product of prime factors.
c
c  Discussion:
c
c    This routine will fail if the input integer is not positive,
c    or if PRIME_NUM is too small to account for the factors of the integer.
c
c    An I4 is an integer value.
c
c    The formula is:
c
c      INTVAL = Product ( 1 <= I <= PRIME_NUM ) PRIME(I)**NPOWER(I).
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    30 October 2007
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer INTVAL, the integer to be factored.
c
c    Input, integer PRIME_NUM, the number of prime factors for
c    which storage has been allocated.
c
c    Output, integer NPOWER(PRIME_NUM), the powers of the primes.
c
      implicit none

      integer prime_num

      integer i
      integer intcopy
      integer intval
      integer npower(prime_num)
      integer p
      integer prime

      if ( intval .le. 0 ) then
        write ( *, '(a)' ) ' '
        write ( *, '(a)' ) 'I4_TO_FAC - Fatal error!'
        write ( *, '(a)' ) '  Input integer is not positive.'
        stop 1
      end if
c
c  Try dividing the remainder by each prime.
c
      intcopy = intval

      do i = 1, prime_num

        npower(i) = 0

        p = prime ( i )

10      continue

        if ( mod ( intcopy, p ) .eq. 0 ) then
          npower(i) = npower(i) + 1
          intcopy = intcopy / p
          go to 10
        end if

      end do

      return
      end
      subroutine i4_to_halton ( dim_num, step, seed, leap, base, r )

c*********************************************************************72
c
cc I4_TO_HALTON computes one element of a leaped Halton subsequence.
c
c  Discussion:
c
c    The DIM_NUM-dimensional Halton sequence is really DIM_NUM separate
c    sequences, each generated by a particular base.
c
c    This routine selects elements of a "leaped" subsequence of the
c    Halton sequence.  The subsequence elements are indexed by a
c    quantity called STEP, which starts at 0.  The STEP-th subsequence
c    element is simply element
c
c      SEED(1:DIM_NUM) + STEP * LEAP(1:DIM_NUM)
c
c    of the original Halton sequence.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    03 January 2007
c
c  Author:
c
c    John Burkardt
c
c  Reference:
c
c    John Halton,
c    On the efficiency of certain quasi-random sequences of points
c    in evaluating multi-dimensional integrals,
c    Numerische Mathematik,
c    Volume 2, 1960, pages 84-90.
c
c    John Halton, GB Smith,
c    Algorithm 247: Radical-Inverse Quasi-Random Point Sequence,
c    Communications of the ACM,
c    Volume 7, 1964, pages 701-702.
c
c    Ladislav Kocis, William Whiten,
c    Computational Investigations of Low-Discrepancy Sequences,
c    ACM Transactions on Mathematical Software,
c    Volume 23, Number 2, 1997, pages 266-294.
c
c  Parameters:
c
c    Input, integer DIM_NUM, the spatial dimension.
c    1 <= DIM_NUM is required.
c
c    Input, integer STEP, the index of the subsequence element.
c    0 <= STEP is required.
c
c    Input, integer SEED(DIM_NUM), the Halton sequence index corresponding
c    to STEP = 0.
c    0 <= SEED(1:DIM_NUM) is required.
c
c    Input, integer LEAP(DIM_NUM), the successive jumps in the Halton sequence.
c    1 <= LEAP(1:DIM_NUM) is required.
c
c    Input, integer BASE(DIM_NUM), the Halton bases.
c    1 < BASE(1:DIM_NUM) is required.
c
c    Output, double precision R(DIM_NUM), the STEP-th element of the leaped
c    Halton subsequence.
c
      implicit none

      integer dim_num

      integer base(dim_num)
      double precision base_inv
      integer digit
      integer i
      integer leap(dim_num)
      double precision r(dim_num)
      integer seed(dim_num)
      integer seed2
      integer step
c
c  Check the input.
c
      if ( dim_num .lt. 1 ) then
        write ( *, '(a)' ) ' '
        write ( *, '(a)' ) 'I4_TO_HALTON - Fatal error!'
        write ( *, '(a)' ) '  DIM_NUM < 1.'
        stop 1
      end if

      if ( step .lt. 0 ) then
        write ( *, '(a)' ) ' '
        write ( *, '(a)' ) 'I4_TO_HALTON - Fatal error!'
        write ( *, '(a)' ) ' STEP < 0.'
        stop 1
      end if

      do i = 1, dim_num

        if ( seed(i) .lt. 0 ) then
          write ( *, '(a)' ) ' '
          write ( *, '(a)' ) 'I4_TO_HALTON - Fatal error!'
          write ( *, '(a)' ) '  Some SEED(*) < 0.'
          stop 1
        end if

      end do

      do i = 1, dim_num

        if ( leap(i) .lt. 1 ) then
          write ( *, '(a)' ) ' '
          write ( *, '(a)' ) 'I4_TO_HALTON - Fatal error!'
          write ( *, '(a)' ) '  Some LEAP < 1.'
          stop 1
        end if

      end do

      do i = 1, dim_num

        if ( base(i) .le. 1 ) then
          write ( *, '(a)' ) ' '
          write ( *, '(a)' ) 'I4_TO_HALTON - Fatal error!'
          write ( *, '(a)' ) '  Some BASE <= 1.'
          stop 1
        end if

      end do
c
c  Calculate the data.
c
      do i = 1, dim_num

        seed2 = seed(i) + step * leap(i)

        r(i) = 0.0D+00

        base_inv = 1.0D+00 / dble ( base(i) )

10      continue

        if ( seed2 .ne. 0 ) then
          digit = mod ( seed2, base(i) )
          r(i) = r(i) + dble ( digit ) * base_inv
          base_inv = base_inv / dble ( base(i) )
          seed2 = seed2 / base(i)
          go to 10
        end if

      end do

      return
      end
      function i4_to_isbn ( i )

c*********************************************************************72
c
cc I4_TO_ISBN converts an I4 to an ISBN digit.
c
c  Discussion:
c
c    Only the integers 0 through 10 can be input.  The representation
c    of 10 is 'X'.
c
c    An I4 is an integer value.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    30 October 2007
c
c  Author:
c
c    John Burkardt
c
c  Reference:
c
c    Book Industry Study Group,
c    The Evolution in Product Identification:
c    Sunrise 2005 and the ISBN-13,
c    http://www.bisg.org/docs/The_Evolution_in_Product_ID.pdf
c
c  Parameters:
c
c    Input, integer I, an integer between 0 and 10.
c
c    Output, character I4_TO_ISBN, the ISBN character code of the integer.
c    If I is illegal, then I4_TO_ISBN is set to '?'.
c
      implicit none

      integer i
      character i4_to_isbn

           if ( i .eq. 0 ) then
        i4_to_isbn = '0'
      else if ( i .eq. 1 ) then
        i4_to_isbn = '1'
      else if ( i .eq. 2 ) then
        i4_to_isbn = '2'
      else if ( i .eq. 3 ) then
        i4_to_isbn = '3'
      else if ( i .eq. 4 ) then
        i4_to_isbn = '4'
      else if ( i .eq. 5 ) then
        i4_to_isbn = '5'
      else if ( i .eq. 6 ) then
        i4_to_isbn = '6'
      else if ( i .eq. 7 ) then
        i4_to_isbn = '7'
      else if ( i .eq. 8 ) then
        i4_to_isbn = '8'
      else if ( i .eq. 9 ) then
        i4_to_isbn = '9'
      else if ( i .eq. 10 ) then
        i4_to_isbn = 'X'
      else
        i4_to_isbn = '?'
      end if

      return
      end
      function i4_to_l4 ( i4 )

c*********************************************************************72
c
cc I4_TO_L4 converts an I4 to an L4.
c
c  Discussion:
c
c    0 is FALSE, and anything else if TRUE.
c
c    An I4 is an integer value.
c    An L4 is a logical value.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    10 January 2012
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer I4, an integer.
c
c    Output, logical I4_TO_L4, the logical value of I4.
c
      implicit none

      integer i4
      logical i4_to_l4
      logical value

      value = ( i4 .ne. 0 )

      i4_to_l4 = value

      return
      end
      subroutine i4_to_pascal ( k, i, j )

c*********************************************************************72
c
cc I4_TO_PASCAL converts a linear index to Pascal triangle coordinates.
c
c  Discussion:
c
c    We describe the grid points in Pascal's triangle in two ways:
c
c    As a linear index K:
c
c                     1
c                   2   3
c                 4   5   6
c               7   8   9   10
c
c    As elements (I,J) of Pascal's triangle:
c
c                     0,0
c                  1,0   0,1
c               2,0   1,1    0,2
c            3,0   2,1   1,2    0,3
c
c  Example:
c
c     K  I  J
c
c     1  0  0
c     2  1  0
c     3  0  1
c     4  2  0
c     5  1  1
c     6  0  2
c     7  3  0
c     8  2  1
c     9  1  2
c    10  0  3
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    14 April 2015
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer K, the linear index of the (I,J) element.
c    1 <= K.
c
c    Output, integer I, J, the Pascal indices.
c
      implicit none

      integer d
      integer i
      integer j
      integer k

      if ( k .le. 0 ) then
        write ( *, '(a)' ) ''
        write ( *, '(a)' ) 'I4_TO_PASCAL - Fatal error!'
        write ( *, '(a)' ) '  K must be positive.'
        stop 1
      end if

      call i4_to_pascal_degree ( k, d )

      j = k - ( d * ( d + 1 ) ) / 2 - 1
      i = d - j

      return
      end
      subroutine i4_to_pascal_degree ( k, d )

c*********************************************************************72
c
cc I4_TO_PASCAL_DEGREE converts a linear index to a Pascal triangle degree.
c
c  Discussion:
c
c    We describe the grid points in Pascal's triangle in two ways:
c
c    As a linear index K:
c
c                     1
c                   2   3
c                 4   5   6
c               7   8   9   10
c
c    As elements (I,J) of Pascal's triangle:
c
c                     0,0
c                  1,0   0,1
c               2,0   1,1    0,2
c            3,0   2,1   1,2    0,3
c
c    The quantity D represents the "degree" of the corresponding monomial,
c    that is, D = I + J.
c
c    We can compute D directly from K using the quadratic formula.
c
c  Example:
c
c     K  I  J  D
c
c     1  0  0  0
c
c     2  1  0  1
c     3  0  1  1
c
c     4  2  0  2
c     5  1  1  2
c     6  0  2  2
c
c     7  3  0  3
c     8  2  1  3
c     9  1  2  3
c    10  0  3  3
c
c    11  4  0  4
c    12  3  1  4
c    13  2  2  4
c    14  1  3  4
c    15  0  4  4
c
c    16  5  0  5
c    17  4  1  5
c    18  3  2  5
c    19  2  3  5
c    20  1  4  5
c    21  0  5  5
c
c    22  6  0  6
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    14 April 2015
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer K, the linear index of the (I,J) element.
c    1 <= K.
c
c    Output, integer D, the degree (sum) of the corresponding Pascal indices.
c
      implicit none

      double precision arg
      integer d
      integer k

      if ( k .le. 0 ) then
        write ( *, '(a)' ) ''
        write ( *, '(a)' ) 'I4_TO_PASCAL_DEGREE - Fatal error!'
        write ( *, '(a)' ) '  K must be positive.'
        stop 1
      end if

      arg = dble ( 1 + 8 * ( k - 1 ) )

      d = int ( 0.5D+00 * ( -1.0D+00 + sqrt ( arg ) ) )

      return
      end
      subroutine i4_to_triangle_lower ( k, i, j )

c*********************************************************************72
c
cc I4_TO_TRIANGLE_LOWER converts an integer to lower triangular coordinates.
c
c  Discussion:
c
c    Triangular coordinates are handy when storing a naturally triangular
c    array (such as the lower half of a matrix) in a linear array.
c
c    Thus, for example, we might consider storing 
c
c    (1,1)
c    (2,1) (2,2)
c    (3,1) (3,2) (3,3)
c    (4,1) (4,2) (4,3) (4,4)
c
c    as the linear array
c
c    (1,1) (2,1) (2,2) (3,1) (3,2) (3,3) (4,1) (4,2) (4,3) (4,4)    
c
c    Here, the quantities in parenthesis represent the natural row and
c    column indices of a single number when stored in a rectangular array.
c
c    In this routine, we are given the location K of an item in the 
c    linear array, and wish to determine the row I and column J
c    of the item when stored in the triangular array.
c 
c  First Values:
c
c     K  I  J
c
c     0  0  0
c     1  1  1
c     2  2  1
c     3  2  2
c     4  3  1
c     5  3  2
c     6  3  3
c     7  4  1
c     8  4  2
c     9  4  3
c    10  4  4
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license. 
c
c  Modified:
c
c    03 July 2008
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer K, the linear index of the (I,J) element, 
c    which must be nonnegative.
c
c    Output, integer I, J, the row and column indices.
c
      implicit none

      integer i
      integer j
      integer k

      if ( k .lt. 0 ) then

        write ( *, '(a)' ) ' '
        write ( *, '(a)' ) 'I4_TO_TRIANGLE_LOWER - Fatal error!'
        write ( *, '(a)' ) '  K < 0.'
        write ( *, '(a,i8)' ) '  K = ', k
        stop 1
  
      else if ( k .eq. 0 ) then

        i = 0
        j = 0
        return

      end if

      i = int ( sqrt ( dble ( 2 * k ) ) )

      if ( i * i + i .lt. 2 * k ) then
        i = i + 1
      end if

      j = k - ( i * ( i - 1 ) ) / 2

      return
      end
      subroutine i4_to_triangle_upper ( k, i, j )

c*********************************************************************72
c
cc I4_TO_TRIANGLE_UPPER converts an integer to upper triangular coordinates.
c
c  Discussion:
c
c    Triangular coordinates are handy when storing a naturally triangular
c    array (such as the upper half of a matrix) in a linear array.
c
c    Thus, for example, we might consider storing 
c
c    (1,1) (1,2) (1,3) (1,4)
c          (2,2) (2,3) (2,4)
c                (3,3) (3,4)
c                      (4,4)
c
c    as the linear array
c
c    (1,1) (1,2) (2,2) (1,3) (2,3) (3,3) (1,4) (2,4) (3,4) (4,4)    
c
c    Here, the quantities in parenthesis represent the natural row and
c    column indices of a single number when stored in a rectangular array.
c
c    In this routine, we are given the location K of an item in the 
c    linear array, and wish to determine the row I and column J
c    of the item when stored in the triangular array.
c 
c  First Values:
c
c     K  I  J
c
c     0  0  0
c     1  1  1
c     2  1  2
c     3  2  2
c     4  1  3
c     5  2  3
c     6  3  3
c     7  1  4
c     8  2  4
c     9  3  4
c    10  4  4
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license. 
c
c  Modified:
c
c    22 March 2017
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer K, the linear index of the (I,J) element, 
c    which must be nonnegative.
c
c    Output, integer I, J, the row and column indices.
c
      implicit none

      integer i
      integer j
      integer k

      if ( k .lt. 0 ) then

        write ( *, '(a)' ) ' '
        write ( *, '(a)' ) 'I4_TO_TRIANGLE_UPPER - Fatal error!'
        write ( *, '(a)' ) '  K < 0.'
        write ( *, '(a,i8)' ) '  K = ', k
        stop 1
  
      else if ( k .eq. 0 ) then

        i = 0
        j = 0
        return

      end if

      j = int ( sqrt ( dble ( 2 * k ) ) )

      if ( j * j + j .lt. 2 * k ) then
        j = j + 1
      end if

      i = k - ( j * ( j - 1 ) ) / 2

      return
      end
      function i4_uniform_ab ( a, b, seed )

c*********************************************************************72
c
cc I4_UNIFORM_AB returns a scaled pseudorandom I4 between A and B.
c
c  Discussion:
c
c    An I4 is an integer value.
c
c    The pseudorandom number should be uniformly distributed
c    between A and B.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license. 
c
c  Modified:
c
c    12 November 2006
c
c  Author:
c
c    John Burkardt
c
c  Reference:
c
c    Paul Bratley, Bennett Fox, Linus Schrage,
c    A Guide to Simulation,
c    Second Edition,
c    Springer, 1987,
c    ISBN: 0387964673,
c    LC: QA76.9.C65.B73.
c
c    Bennett Fox,
c    Algorithm 647:
c    Implementation and Relative Efficiency of Quasirandom
c    Sequence Generators,
c    ACM Transactions on Mathematical Software,
c    Volume 12, Number 4, December 1986, pages 362-376.
c
c    Pierre L'Ecuyer,
c    Random Number Generation,
c    in Handbook of Simulation,
c    edited by Jerry Banks,
c    Wiley, 1998,
c    ISBN: 0471134031,
c    LC: T57.62.H37.
c
c    Peter Lewis, Allen Goodman, James Miller,
c    A Pseudo-Random Number Generator for the System/360,
c    IBM Systems Journal,
c    Volume 8, Number 2, 1969, pages 136-143.
c
c  Parameters:
c
c    Input, integer A, B, the limits of the interval.
c
c    Input/output, integer SEED, the "seed" value, which should NOT be 0.
c    On output, SEED has been updated.
c
c    Output, integer I4_UNIFORM_AB, a number between A and B.
c
      implicit none

      integer a
      integer b
      integer i4_huge
      parameter ( i4_huge = 2147483647 )
      integer i4_uniform_ab
      integer k
      real r
      integer seed
      integer value

      if ( seed .eq. 0 ) then
        write ( *, '(a)' ) ' '
        write ( *, '(a)' ) 'I4_UNIFORM_AB - Fatal error!'
        write ( *, '(a)' ) '  Input value of SEED = 0.'
        stop 1
      end if

      k = seed / 127773

      seed = 16807 * ( seed - k * 127773 ) - k * 2836

      if ( seed .lt. 0 ) then
        seed = seed + i4_huge
      end if

      r = real ( seed ) * 4.656612875E-10
c
c  Scale R to lie between A-0.5 and B+0.5.
c
      r = ( 1.0E+00 - r ) * ( real ( min ( a, b ) ) - 0.5E+00 )
     &  +             r   * ( real ( max ( a, b ) ) + 0.5E+00 )
c
c  Use rounding to convert R to an integer between A and B.
c
      value = nint ( r )

      value = max ( value, min ( a, b ) )
      value = min ( value, max ( a, b ) )

      i4_uniform_ab = value

      return
      end
      subroutine i4_unswap3 ( i, j, k )

c*********************************************************************72
c
cc I4_UNSWAP3 unswaps three I4's.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    31 December 2006
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input/output, integer I, J, K.  On output, the values of I, J, and K
c    have been interchanged.
c
      implicit none

      integer i
      integer j
      integer k
      integer l

      l = k
      k = j
      j = i
      i = l

      return
      end
      function i4_walsh_1d ( x, digit )

c*********************************************************************72
c
cc I4_WALSH_1D evaluates the Walsh function.
c
c  Discussion:
c
c    Consider the binary representation of X, and number the digits
c    in descending order, from leading to lowest, with the units digit
c    being numbered 0.
c
c    The Walsh function W(J)(X) is equal to the J-th binary digit of X.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    31 December 2006
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, double precision X, the argument of the Walsh function.
c
c    Input, integer DIGIT, the index of the Walsh function.
c
c    Output, integer I4_WALSH_1D, the value of the Walsh function.
c
      implicit none

      integer digit
      integer i4_walsh_1d
      integer n
      double precision x
      double precision x_copy
c
c  Hide the effect of the sign of X.
c
      x_copy = abs ( x )
c
c  If DIGIT is positive, divide by 2 DIGIT times.
c  If DIGIT is negative, multiply by 2 (-DIGIT) times.
c
      x_copy = x_copy / ( 2.0D+00 ** digit )
c
c  Make it an integer.
c  Because it's positive, and we're using INT, we don't change the
c  units digit.
c
      n = int ( x_copy )
c
c  Is the units digit odd or even?
c
      if ( mod ( n, 2 ) .eq. 0 ) then
        i4_walsh_1d = 0
      else
        i4_walsh_1d = 1
      end if

      return
      end
      function i4_width ( i )

c*********************************************************************72
c
cc I4_WIDTH returns the "width" of an I4.
c
c  Discussion:
c
c    The width of an integer is the number of characters necessary to print it.
c
c    The width of an integer can be useful when setting the appropriate output
c    format for a vector or array of values.
c
c    An I4 is an integer value.
c
c  Example:
c
c        I  I4_WIDTH
c    -----  -------
c    -1234    5
c     -123    4
c      -12    3
c       -1    2
c        0    1
c        1    1
c       12    2
c      123    3
c     1234    4
c    12345    5
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    26 October 2007
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer I, the number whose width is desired.
c
c    Output, integer I4_WIDTH, the number of characters
c    necessary to represent the integer in base 10, including a negative
c    sign if necessary.
c
      implicit none

      integer i
      integer i4_log_10
      integer i4_width

      if ( 0 .le. i ) then
        i4_width = i4_log_10 ( i ) + 1
      else
        i4_width = i4_log_10 ( i ) + 2
      end if

      return
      end
      function i4_wrap ( ival, ilo, ihi )

c*********************************************************************72
c
cc I4_WRAP forces an I4 to lie between given limits by wrapping.
c
c  Example:
c
c    ILO = 4, IHI = 8
c
c    I  Value
c
c    -2     8
c    -1     4
c     0     5
c     1     6
c     2     7
c     3     8
c     4     4
c     5     5
c     6     6
c     7     7
c     8     8
c     9     4
c    10     5
c    11     6
c    12     7
c    13     8
c    14     4
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    31 December 2006
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer IVAL, an integer value.
c
c    Input, integer ILO, IHI, the desired bounds for the integer value.
c
c    Output, integer I4_WRAP, a "wrapped" version of IVAL.
c
      implicit none

      integer i4_modp
      integer i4_wrap
      integer ihi
      integer ilo
      integer ival
      integer jhi
      integer jlo
      integer value
      integer wide

      jlo = min ( ilo, ihi )
      jhi = max ( ilo, ihi )

      wide = jhi - jlo + 1

      if ( wide .eq. 1 ) then
        value = jlo
      else
        value = jlo + i4_modp ( ival - jlo, wide )
      end if

      i4_wrap = value

      return
      end
      function i4_xor ( i, j )

c*********************************************************************72
c
cc I4_XOR calculates the exclusive OR of two I4's.
c
c  Discussion:
c
c    An I4 is an integer value.
c
c    The FORTRAN intrinsinc IEOR should be used instead.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    30 October 2007
c
c  Author:
c
c   John Burkardt
c
c  Parameters:
c
c    Input, integer I, J, two values whose exclusive OR is needed.
c
c    Output, integer I4_XOR, the exclusive OR of I and J.
c
      implicit none

      integer i
      integer i1
      integer i2
      integer i4_xor
      integer j
      integer j1
      integer j2
      integer k
      integer l

      i1 = i
      j1 = j
      k = 0
      l = 1

10    continue

      if ( i1 .ne. 0 .or. j1 .ne. 0 ) then

        i2 = i1 / 2
        j2 = j1 / 2

        if (
     &    ( ( i1 .eq. 2 * i2 ) .and. ( j1 .ne. 2 * j2 ) ) .or.
     &    ( ( i1 .ne. 2 * i2 ) .and. ( j1 .eq. 2 * j2 ) ) ) then
          k = k + l
        end if

        i1 = i2
        j1 = j2
        l = 2 * l

        go to 10

      end if

      i4_xor = k

      return
      end
      subroutine i43mat_flip_cols ( m, n, a )

c*********************************************************************72
c
cc I43MAT_FLIP_COLS swaps the columns of an I43MAT.
c
c  Discussion:
c
c    An I43MAT is a matrix, each of whose entries is an I43,
c    a triple of I4's.
c
c    An I43MAT can be stored as a 3 x M x N array, where M counts the "columns"
c    and N counts the "rows".
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    06 December 2008
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer M, N, the number of rows and columns.
c
c    Input/output, integer A(3,M,N), the matrix whose columns
c    are to be flipped.
c
      implicit none

      integer m
      integer n

      integer a(3,m,n)
      integer b
      integer i
      integer j
      integer k

      do k = 1, n / 2
        do j = 1, m
          do i = 1, 3
            b            = a(i,j,    k)
            a(i,j,    k) = a(i,j,n+1-k)
            a(i,j,n+1-k) = b
          end do
        end do
      end do

      return
      end
      subroutine i43mat_flip_rows ( m, n, a )

c*********************************************************************72
c
cc I43MAT_FLIP_ROWS swaps the rows of an I43MAT.
c
c  Discussion:
c
c    An I43MAT is a matrix, each of whose entries is an I43,
c    a triple of I4's.
c
c    An I43MAT can be stored as a 3 x M x N array, where M counts the "columns"
c    and N counts the "rows".
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    06 December 2008
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer M, N, the number of rows and columns.
c
c    Input/output, integer A(3,M,N), the matrix whose rows
c    are to be flipped.
c
      implicit none

      integer m
      integer n

      integer a(3,m,n)
      integer b
      integer i
      integer j
      integer k

      do k = 1, n
        do j = 1, m / 2
          do i = 1, 3
            b            = a(i,    j,k)
            a(i,    j,k) = a(i,m+1-j,k)
            a(i,m+1-j,k) = b
          end do
        end do
      end do

      return
      end
      subroutine i4block_print ( l, m, n, a, title )

c*********************************************************************72
c
cc I4BLOCK_PRINT prints an I4BLOCK.
c
c  Discussion:
c
c    An I4BLOCK is a 3D array of I4 values.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    25 June 2012
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer L, M, N, the dimensions of the block.
c
c    Input, integer A(L,M,N), the matrix to be printed.
c
c    Input, character * ( * ) TITLE, a title.
c
      implicit none

      integer l
      integer m
      integer n

      integer a(l,m,n)
      integer i
      integer j
      integer jhi
      integer jlo
      integer k
      character * ( * ) title

      write ( *, '(a)' ) ' '
      write ( *, '(a)' ) trim ( title )

      do k = 1, n

        write ( *, '(a)' ) ' '
        write ( *, '(a,i8)' ) '  K = ', k

        do jlo = 1, m, 10
          jhi = min ( jlo + 10 - 1, m )
          write ( *, '(a)' ) ' '
          write ( *, '(8x,a2,10(2x,i6))' ) 'J:', ( j, j = jlo, jhi )
          write ( *, '(7x,a2)' ) 'I:'
          do i = 1, l
            write ( *, '(2x,i6,a1,1x,10(2x,i6))' ) 
     &        i, ':', a(i,jlo:jhi,k)
          end do
        end do

      end do

      return
      end
      subroutine i4block_zero ( l, m, n, a )

c*********************************************************************72
c
cc I4BLOCK_ZERO zeroes an I4BLOCK.
c
c  Discussion:
c
c    An I4BLOCK is a triple dimensioned array of I4 values.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    13 April 2013
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer L, M, N, the dimensions.
c
c    Output, integer A(L,M,N), the block of zeroes.
c
      implicit none

      integer l
      integer m
      integer n

      integer a(l,m,n)
      integer i
      integer j
      integer k

      do k = 1, n
        do j = 1, m
          do i = 1, l
            a(i,j,k) = 0
          end do
        end do
      end do

      return
      end
      subroutine i4col_compare ( m, n, a, i, j, isgn )

c*********************************************************************72
c
cc I4COL_COMPARE compares columns I and J of an I4COL.
c
c  Discussion:
c
c    An I4COL is an M by N array of I4 values, regarded
c    as an array of N columns of length M.
c
c  Example:
c
c    Input:
c
c      M = 3, N = 4, I = 2, J = 4
c
c      A = (
c        1  2  3  4
c        5  6  7  8
c        9 10 11 12 )
c
c    Output:
c
c      ISGN = -1
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    01 September 2008
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer M, N, the number of rows and columns.
c
c    Input, integer A(M,N), an array of N columns of
c    vectors of length M.
c
c    Input, integer I, J, the columns to be compared.
c    I and J must be between 1 and N.
c
c    Output, integer ISGN, the results of the comparison:
c    -1, column I < column J,
c     0, column I = column J,
c    +1, column J < column I.
c
      implicit none

      integer m
      integer n

      integer a(m,n)
      integer i
      integer isgn
      integer j
      integer k
c
c  Check.
c
      if ( i .lt. 1 ) then
        write ( *, '(a)' ) ' '
        write ( *, '(a)' ) 'I4COL_COMPARE - Fatal error!'
        write ( *, '(a,i8,a)' )
     &    '  Column index I = ', i, ' is less than 1.'
        stop 1
      end if

      if ( n .lt. i ) then
        write ( *, '(a)' ) ' '
        write ( *, '(a)' ) 'I4COL_COMPARE - Fatal error!'
        write ( *, '(a,i8,a)' )
     &    '  N = ', n, ' is less than column index I = ', i
        stop 1
      end if

      if ( j .lt. 1 ) then
        write ( *, '(a)' ) ' '
        write ( *, '(a)' ) 'I4COL_COMPARE - Fatal error!'
        write ( *, '(a,i8,a)' )
     &    '  Column index J = ', j, ' is less than 1.'
        stop 1
      end if

      if ( n .lt. j ) then
        write ( *, '(a)' ) ' '
        write ( *, '(a)' ) 'I4COL_COMPARE - Fatal error!'
        write ( *, '(a,i8,a)' )
     &    '  N = ', n, ' is less than column index J = ', j
        stop 1
      end if

      isgn = 0

      if ( i .eq. j ) then
        return
      end if

      k = 1

10    continue

      if ( k .le. m ) then

        if ( a(k,i) .lt. a(k,j) ) then
          isgn = -1
          return
        else if ( a(k,j) .lt. a(k,i) ) then
          isgn = +1
          return
        end if

        k = k + 1

        go to 10

      end if

      return
      end
      subroutine i4col_find ( m, n, a, ivec, col )

c*********************************************************************72
c
cc I4COL_FIND searches an I4COL for a particular column value.
c
c  Discussion:
c
c    An I4COL is an M by N array of I4 values, regarded
c    as an array of N columns of length M.
c
c  Example:
c
c    M = 3, N = 4,
c
c    A = (
c      1  2  3  4
c      5  6  7  8
c      9 10 11 12 )
c
c    IVEC = ( 3, 7, 11 )
c
c    COL = 3
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    29 August 2008
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer M, N, the number of rows and columns in
c    the table.  M is also the length of IVEC.
c
c    Input, integer A(M,N), an array of N columns of vectors
c    of length M.
c
c    Input, integer IVEC(M), a vector to be matched with the data
c    in the array.
c
c    Output, integer COL, the index of the first column of
c    the table which exactly matches every entry of IVEC, or -1 if no match
c    could be found.
c
      implicit none

      integer m
      integer n

      integer a(m,n)
      integer i
      integer col
      integer ivec(m)
      integer j

      if ( m .le. 0 ) then
        col = -1
        return
      end if

      do j = 1, n

        i = 1

10      continue

        if ( ivec(i) .eq. a(i,j) ) then

          if ( i .eq. m ) then
            col = j
            return
          end if

          i = i + 1
          go to 10

        end if

      end do

      col = -1

      return
      end
      subroutine i4col_find_item ( m, n, a, item, row, col )

c*********************************************************************72
c
cc I4COL_FIND_ITEM searches an I4COL for a given scalar value.
c
c  Discussion:
c
c    An I4COL is an M by N array of I4 values, regarded
c    as an array of N columns of length M.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    01 September 2008
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer M, N, the number of rows and columns in
c    the table.
c
c    Input, integer A(M,N), an array of N columns of vectors
c    of length M.
c
c    Input, integer ITEM, the value to search for.
c
c    Output, integer ROW, COL, the row and column indices
c    of the first occurrence of the value ITEM.  The search
c    is conducted by columns.  If the item is not found, then
c    ROW = COL = -1.
c
      implicit none

      integer m
      integer n

      integer a(m,n)
      integer col
      integer i
      integer item
      integer j
      integer row

      do j = 1, n
        do i = 1, m
          if ( a(i,j) .eq. item ) then
            row = i
            col = j
            return
          end if
        end do
      end do

      row = -1
      col = -1

      return
      end
      subroutine i4col_find_pair_wrap ( m, n, a, item1, item2, row,
     &  col )

c*********************************************************************72
c
cc I4COL_FIND_PAIR_WRAP searches an I4COL for a pair of items.
c
c  Discussion:
c
c    An I4COL is an M by N array of I4 values, regarded
c    as an array of N columns of length M.
c
c    The items (ITEM1, ITEM2) must occur consecutively.
c    However, wrapping is allowed, that is, if ITEM1 occurs
c    in the last row, and ITEM2 "follows" it in the first row
c    of the same column, a match is declared.
c
c    If the pair of items is not found, then ROW = COL = -1.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    01 September 2008
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer M, N, the number of rows and columns
c    in the array.
c
c    Input, integer A(M,N), the array to search.
c
c    Input, integer ITEM1, ITEM2, the values to search for.
c
c    Output, integer ROW, COL, the row and column indices
c    of the first occurrence of the value ITEM1 followed immediately
c    by ITEM2.
c
      implicit none

      integer m
      integer n

      integer a(m,n)
      integer col
      integer i
      integer i2
      integer item1
      integer item2
      integer j
      integer row

      do j = 1, n
        do i = 1, m

          if ( a(i,j) .eq. item1 ) then

            i2 = i + 1

            if ( m .lt. i2 ) then
              i2 = 1
            end if

            if ( a(i2,j) .eq. item2 ) then
              row = i
              col = j
              return
            end if

          end if

        end do
      end do

      row = -1
      col = -1

      return
      end
      subroutine i4col_first_index ( m, n, a, first_index )

c*********************************************************************72
c
cc I4COL_FIRST_INDEX indexes the first occurrence of values in an I4COL.
c
c  Discussion:
c
c    An I4COL is an M by N array of I4 values.
c    It is regarded as an array of N columns of length M.
c
c    For element A(1:M,J) of the matrix, FIRST_INDEX(J) is the index in A of
c    the first column whose entries are equal to A(1:M,J).
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    28 August 2008
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer M, N, the number of rows and columns of A.
c    The length of an "element" of A, and the number of "elements".
c
c    Input, integer A(M,N), the array.
c
c    Output, integer FIRST_INDEX(N), the first occurrence index.
c
      implicit none

      integer m
      integer n

      integer a(m,n)
      logical all_equal
      integer first_index(n)
      integer i
      integer j1
      integer j2

      do i = 1, n
        first_index(i) = -1
      end do

      do j1 = 1, n

        if ( first_index(j1) .eq. -1 ) then

          first_index(j1) = j1

          do j2 = j1 + 1, n
            all_equal = .true.
            do i = 1, m
              if ( a(i,j1) .ne. a(i,j2) ) then
                all_equal = .false.
              end if
            end do
            if ( all_equal ) then
              first_index(j2) = j1
            end if
          end do

        end if

      end do

      return
      end
      subroutine i4col_sort_a ( m, n, a )

c*********************************************************************72
c
cc I4COL_SORT_A ascending sorts an I4COL.
c
c  Discussion:
c
c    An I4COL is an M by N array of I4 values, regarded
c    as an array of N columns of length M.
c
c    In lexicographic order, the statement "X < Y", applied to two real
c    vectors X and Y of length M, means that there is some index I, with
c    1 <= I <= M, with the property that
c
c      X(J) = Y(J) for J < I,
c    and
c      X(I) < Y(I).
c
c    In other words, the first time they differ, X is smaller.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    06 December 2008
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer M, the number of rows of A, and the length of
c    a vector of data.
c
c    Input, integer N, the number of columns of A.
c
c    Input/output, integer A(M,N).
c    On input, the array of N columns of M-vectors.
c    On output, the columns of A have been sorted in ascending
c    lexicographic order.
c
      implicit none

      integer m
      integer n

      integer a(m,n)
      integer i
      integer indx
      integer isgn
      integer j

      if ( m .le. 0 ) then
        return
      end if

      if ( n .le. 1 ) then
        return
      end if
c
c  Initialize.
c
      i = 0
      indx = 0
      isgn = 0
      j = 0
c
c  Call the external heap sorter.
c
10    continue

        call sort_heap_external ( n, indx, i, j, isgn )
c
c  Interchange the I and J objects.
c
        if ( 0 .lt. indx ) then

          call i4col_swap ( m, n, a, i, j )
c
c  Compare the I and J objects.
c
        else if ( indx .lt. 0 ) then

          call i4col_compare ( m, n, a, i, j, isgn )

        else if ( indx .eq. 0 ) then

          go to 20

        end if

      go to 10

20    continue

      return
      end
      subroutine i4col_sort_d ( m, n, a )

c*********************************************************************72
c
cc I4COL_SORT_D descending sorts an I4COL.
c
c  Discussion:
c
c    An I4COL is an M by N array of I4 values, regarded
c    as an array of N columns of length M.
c
c    In lexicographic order, the statement "X < Y", applied to two real
c    vectors X and Y of length M, means that there is some index I, with
c    1 <= I <= M, with the property that
c
c      X(J) = Y(J) for J < I,
c    and
c      X(I) < Y(I).
c
c    In other words, the first time they differ, X is smaller.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    04 June 2010
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer M, the number of rows of A, and the length of
c    a vector of data.
c
c    Input, integer N, the number of columns of A.
c
c    Input/output, integer A(M,N).
c    On input, the array of N columns of M-vectors.
c    On output, the columns of A have been sorted in descending
c    lexicographic order.
c
      implicit none

      integer m
      integer n

      integer a(m,n)
      integer i
      integer indx
      integer isgn
      integer j

      if ( m .le. 0 ) then
        return
      end if

      if ( n .le. 1 ) then
        return
      end if
c
c  Initialize.
c
      i = 0
      indx = 0
      isgn = 0
      j = 0
c
c  Call the external heap sorter.
c
10    continue

        call sort_heap_external ( n, indx, i, j, isgn )
c
c  Interchange the I and J objects.
c
        if ( 0 .lt. indx ) then

          call i4col_swap ( m, n, a, i, j )
c
c  Compare the I and J objects.
c
        else if ( indx .lt. 0 ) then

          call i4col_compare ( m, n, a, i, j, isgn )
          isgn = -isgn

        else if ( indx .eq. 0 ) then

          go to 20

        end if

      go to 10

20    continue

      return
      end
      subroutine i4col_sort2_a ( m, n, a )

c*********************************************************************72
c
cc I4COL_SORT2_A ascending sorts the elements of each column of an I4COL.
c
c  Discussion:
c
c    An I4COL is an M by N array of I4 values, regarded
c    as an array of N columns of length M.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    27 December 2010
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer M, the number of rows of A.
c
c    Input, integer N, the number of columns of A, and the length
c    of a vector of data.
c
c    Input/output, integer A(M,N).
c    On input, the array of N columns of M vectors.
c    On output, the elements of each column of A have been sorted in ascending
c    order.
c
      implicit none

      integer m
      integer n

      integer a(m,n)
      integer col
      integer i
      integer indx
      integer isgn
      integer j
      integer t

      if ( m .le. 1 ) then
        return
      end if

      if ( n .le. 0 ) then
        return
      end if
c
c  Initialize.
c
      do col = 1, n

        i = 0
        indx = 0
        isgn = 0
        j = 0
c
c  Call the external heap sorter.
c
10      continue

          call sort_heap_external ( m, indx, i, j, isgn )
c
c  Interchange the I and J objects.
c
          if ( 0 .lt. indx ) then

            t        = a(i,col)
            a(i,col) = a(j,col)
            a(j,col) = t
c
c  Compare the I and J objects.
c
          else if ( indx .lt. 0 ) then

            if ( a(j,col) .lt. a(i,col) ) then
              isgn = +1
            else
              isgn = -1
            end if

          else if ( indx .eq. 0 ) then

            go to 20

          end if

        go to 10

20    continue

      end do

      return
      end
      subroutine i4col_sort2_d ( m, n, a )

c*********************************************************************72
c
cc I4COL_SORT2_D descending sorts elements of each column of an I4COL.
c
c  Discussion:
c
c    An I4COL is an M by N array of I4 values, regarded
c    as an array of N columns of length M.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    27 December 2010
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer M, the number of rows of A.
c
c    Input, integer N, the number of columns of A, and the length
c    of a vector of data.
c
c    Input/output, integer A(M,N).
c    On input, the array of N columns of M vectors.
c    On output, the elements of each column of A have been sorted in descending
c    order.
c
      implicit none

      integer m
      integer n

      integer a(m,n)
      integer col
      integer i
      integer indx
      integer isgn
      integer  j
      integer t

      if ( m .le. 1 ) then
        return
      end if

      if ( n .le. 0 ) then
        return
      end if
c
c  Initialize.
c
      do col = 1, n

        i = 0
        indx = 0
        isgn = 0
        j = 0
c
c  Call the external heap sorter.
c
10      continue

          call sort_heap_external ( m, indx, i, j, isgn )
c
c  Interchange the I and J objects.
c
          if ( 0 .lt. indx ) then

            t        = a(i,col)
            a(i,col) = a(j,col)
            a(j,col) = t
c
c  Compare the I and J objects.
c
          else if ( indx .lt. 0 ) then

            if ( a(i,col) .lt. a(j,col) ) then
              isgn = +1
            else
              isgn = -1
            end if

          else if ( indx .eq. 0 ) then

            go to 20

          end if

        go to 10

20      continue

      end do

      return
      end
      subroutine i4col_sorted_singleton_count ( m, n, a, singleton_num )

c*********************************************************************72
c
cc I4COL_SORTED_SINGLETON_COUNT counts singletons in an I4COL.
c
c  Discussion:
c
c    An I4COL is an M by N array of I4 values, regarded
c    as an array of N columns of length M.
c
c    The columns of the array may be ascending or descending sorted.
c
c    A "singleton" is an item that occurs exactly once.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    27 December 2010
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer M, N, the number of rows and columns.
c
c    Input, integer A(M,N), a sorted array, containing
c    N columns of data.
c
c    Output, integer SINGLETON_NUM, the number of singletons.
c
      implicit none

      integer m
      integer n

      integer a(m,n)
      logical differ_from_next
      logical differ_from_previous
      integer i
      integer j
      integer singleton_num

      singleton_num = 0

      if ( n .le. 0 ) then
        return
      end if

      differ_from_next = .true.

      do j = 1, n

        differ_from_previous = differ_from_next

        if ( j .lt. n ) then

          differ_from_next = .false.

          do i = 1, m
            if ( a(i,j) .ne. a(i,j+1) ) then
              differ_from_next = .true.
              go to 10
            end if
          end do

10        continue

        else

          differ_from_next = .true.

        end if

        if ( differ_from_previous .and. differ_from_next ) then
          singleton_num = singleton_num + 1
        end if

      end do

      return
      end
      subroutine i4col_sorted_unique ( m, n, a, unique_num )

c*********************************************************************72
c
cc I4COL_SORTED_UNIQUE keeps unique elements in a sorted I4COL.
c
c  Discussion:
c
c    An I4COL is an M by N array of I4 values, regarded
c    as an array of N columns of length M.
c
c    The array can be sorted into ascending or descending order.
c    The important point is that identical elements must be stored
c    in adjacent positions.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    27 December 2010
c
c  Author:
c
c   John Burkardt
c
c  Parameters:
c
c    Input, integer M, the number of rows of A, and the length of
c    a vector of data.
c
c    Input, integer N, the number of columns of A.
c
c    Input/output, integer A(M,N).
c    On input, the sorted array of N columns of M-vectors.
c    On output, a sorted array of columns of M-vectors.
c
c    Output, integer UNIQUE_NUM, the number of unique columns of A.
c
      implicit none

      integer m
      integer n

      integer a(m,n)
      integer i
      integer i1
      integer i2
      integer j1
      integer j2
      integer unique_num

      if ( n .le. 0 ) then
        unique_num = 0
        return
      end if

      j1 = 1

      do j2 = 2, n

        do i = 1, m

          if ( a(i,j1) .ne. a(i,j2) ) then
            j1 = j1 + 1
            do i2 = 1, m
              a(i2,j1) = a(i2,j2)
            end do
            go to 10
          end if

        end do

10      continue

      end do

      unique_num = j1

      return
      end
      subroutine i4col_sorted_unique_count ( m, n, a, unique_num )

c*********************************************************************72
c
cc I4COL_SORTED_UNIQUE_COUNT counts unique elements in an I4COL.
c
c  Discussion:
c
c    The columns of the array may be ascending or descending sorted.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    03 June 2009
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer M, N, the number of rows and columns.
c
c    Input, integer A(M,N), a sorted array, containing
c    N columns of data.
c
c    Output, integer UNIQUE_NUM, the number of unique columns.
c
      implicit none

      integer m
      integer n

      integer a(m,n)
      integer i
      integer j1
      integer j2
      integer unique_num

      if ( n .le. 0 ) then
        unique_num = 0
        return
      end if

      unique_num = 1
      j1 = 1

      do j2 = 2, n

        do i = 1, m
          if ( a(i,j1) .ne. a(i,j2) ) then
            unique_num = unique_num + 1
            j1 = j2
            go to 10
          end if
        end do

10      continue

      end do

      return
      end
      subroutine i4col_swap ( m, n, a, j1, j2 )

c*********************************************************************72
c
cc I4COL_SWAP swaps columns J1 and J2 of an I4COL.
c
c  Discussion:
c
c    An I4COL is an M by N array of I4 values, regarded
c    as an array of N columns of length M.
c
c  Example:
c
c    Input:
c
c      M = 3, N = 4, J1 = 2, J2 = 4
c
c      A = (
c        1  2  3  4
c        5  6  7  8
c        9 10 11 12 )
c
c    Output:
c
c      A = (
c        1  4  3  2
c        5  8  7  6
c        9 12 11 10 )
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    29 August 2008
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer M, N, the number of rows and columns
c    in the array.
c
c    Input/output, integer A(M,N), an array of N columns
c    of length M.
c
c    Input, integer J1, J2, the columns to be swapped.
c
      implicit none

      integer m
      integer n

      integer a(m,n)
      integer i
      integer j1
      integer j2
      integer t

      if ( j1 .lt. 1 .or. n .lt. j1 .or.
     &     j2 .lt. 1 .or. n .lt. j2 ) then

        write ( *, '(a)' ) ' '
        write ( *, '(a)' ) 'I4COL_SWAP - Fatal error!'
        write ( *, '(a)' ) '  J1 or J2 is out of bounds.'
        write ( *, '(a,i8)' ) '  J1 =    ', j1
        write ( *, '(a,i8)' ) '  J2 =    ', j2
        write ( *, '(a,i8)' ) '  N =     ', n
        stop 1

      end if

      if ( j1 .eq. j2 ) then
        return
      end if

      do i = 1, m
        t       = a(i,j1)
        a(i,j1) = a(i,j2)
        a(i,j2) = t
      end do

      return
      end
      subroutine i4col_unique_index ( m, n, a, unique_index )

c*********************************************************************72
c
cc I4COL_UNIQUE_INDEX indexes the first occurrence of values in an I4COL.
c
c  Discussion:
c
c    An I4COL is an M by N array of I4 values.
c    It is regarded as an array of N columns of length M.
c
c    For element A(1:M,J) of the matrix, UNIQUE_INDEX(J) is the uniqueness index
c    of A(1:M,J).  That is, if A_UNIQUE contains the unique elements of A,
c    gathered in order, then
c
c      A_UNIQUE ( 1:M, UNIQUE_INDEX(J) ) = A(1:M,J)
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    28 August 2008
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer M, N, the number of rows and columns of A.
c    The length of an "element" of A, and the number of "elements".
c
c    Input, integer A(M,N), the array.
c
c    Output, integer UNIQUE_INDEX(N), the unique index.
c
      implicit none

      integer m
      integer n

      integer a(m,n)
      logical all_equal
      integer i
      integer j1
      integer j2
      integer unique_index(n)
      integer unique_num

      do i = 1, n
        unique_index(i) = -1
      end do
      unique_num = 0

      do j1 = 1, n

        if ( unique_index(j1) .eq. -1 ) then

          unique_num = unique_num + 1
          unique_index(j1) = unique_num

          do j2 = j1 + 1, n
            all_equal = .true.
            do i = 1, m
              if ( a(i,j1) .ne. a(i,j2) ) then
                all_equal = .false.
              end if
            end do
            if ( all_equal ) then
              unique_index(j2) = unique_num
            end if
          end do

        end if

      end do

      return
      end
      subroutine i4i4_sort_a ( i1, i2, j1, j2 )

c*********************************************************************72
c
cc I4I4_SORT_A ascending sorts a pair of integers.
c
c  Discussion:
c
c    An I4I4 is a pair of integers, regarded as a single data item.
c
c    The program allows the reasonable call:
c
c      call i4i4_sort_a ( i1, i2, i1, i2 )
c
c    and this will return the reasonable result.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    03 June 2009
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer I1, I2, the values to sort.
c
c    Output, integer J1, J2, the sorted values.
c
      implicit none

      integer i1
      integer i2
      integer j1
      integer j2
      integer k1
      integer k2
c
c  Copy arguments, so that the user can make "reasonable" calls like:
c
c    call i4i4_sort_a ( i1, i2, i1, i2 )
c
      k1 = i1
      k2 = i2

      j1 = min ( k1, k2 )
      j2 = max ( k1, k2 )

      return
      end
      subroutine i4i4i4_sort_a ( i1, i2, i3, j1, j2, j3 )

c*********************************************************************72
c
cc I4I4I4_SORT_A ascending sorts a triple of integers.
c
c  Discussion:
c
c    An I4I4I4 is a triple of integers, regarded as a single data item.
c
c    The program allows the reasonable call:
c
c      call i4i4i4_sort_a ( i1, i2, i3, i1, i2, i3 )
c
c    and this will return the reasonable result.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    27 July 2010
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer I1, I2, I3, the values to sort.
c
c    Output, integer J1, J2, J3, the sorted values.
c
      implicit none

      integer i1
      integer i2
      integer i3
      integer j1
      integer j2
      integer j3
      integer k1
      integer k2
      integer k3
!
!  Copy arguments, so that the user can make "reasonable" calls like:
!
!    call i4i4i4_sort_a ( i1, i2, i3, i1, i2, i3 )
!
      k1 = i1
      k2 = i2
      k3 = i3

      j1 = min ( min ( k1, k2 ), min ( k2, k3 ) )
      j2 = min ( max ( k1, k2 ),
     &    min ( max ( k2, k3 ), max ( k3, k1 ) ) )
      j3 = max ( max ( k1, k2 ), max ( k2, k3 ) )

      return
      end
      subroutine i4list_print ( n, first, list_num, list, title )

c*********************************************************************72
c
cc I4LIST_PRINT prints an I4LIST.
c
c  Discussion:
c
c    An I4LIST is a list of integers grouped into N segments.
c    An index vector locates the first entry of each segment.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    01 May 2010
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the number of segments.
c
c    Input, integer FIRST(N+1), indexes the first entry
c    of each segment.
c
c    Input, integer LIST_NUM, the number of entries.
c
c    Input, integer LIST(LIST_NUM), the data.
c
c    Input, character * ( * ) TITLE, a title.
c
      implicit none

      integer list_num
      integer n

      integer first(n+1)
      integer i
      integer j
      integer jhi
      integer jlo
      integer list(list_num)
      character * ( * ) title

      write ( *, '(a)' ) ' '
      write ( *, '(a)' ) trim ( title )
      write ( *, '(a)' ) ' '

      do i = 1, n

        do jlo = first(i), first(i+1) - 1, 5
          jhi = min ( jlo + 4, first(i+1) - 1 )
          if ( jlo .eq. first(i) ) then
            write ( *, '(i5,a,5(2x,i8))' )
     &        i, ':', ( list(j), j = jlo, jhi )
          else
            write ( *, '(6x,5(2x,i8))' )
     &                ( list(j), j = jlo, jhi )
          end if
        end do

      end do

      return
      end
      subroutine i4mat_border_add ( m, n, table, table2 )

c*********************************************************************72
c
cc I4MAT_BORDER_ADD adds a "border" to an I4MAT.
c
c  Discussion:
c
c    An I4MAT is an array of I4's.
c
c    We suppose the input data gives values of a quantity on nodes
c    in the interior of a 2D grid, and we wish to create a new table
c    with additional positions for the nodes that would be on the
c    border of the 2D grid.
c
c                  0 0 0 0 0 0
c      * * * *     0 * * * * 0
c      * * * * --> 0 * * * * 0
c      * * * *     0 * * * * 0
c                  0 0 0 0 0 0
c
c    The illustration suggests the situation in which a 3 by 4 array
c    is input, and a 5 by 6 array is to be output.
c
c    The old data is shifted to its correct positions in the new array.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    28 April 2008
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer M, the spatial dimension.
c
c    Input, integer N, the number of points.
c
c    Input,integer TABLE(M,N), the table data.
c
c    Output, integer TABLE2(M+2,N+2), the augmented table data.
c
      implicit none

      integer m
      integer n

      integer i
      integer j
      integer table(m,n)
      integer table2(m+2,n+2)

      do j = 1, n + 2
        table2(1,j) = 0
      end do

      do j = 1, n + 2
        table2(m+2,j) = 0
      end do

      do i = 2, m + 1
        table2(i,1) = 0
      end do

      do i = 2, m + 1
        table2(i,n+2) = 0
      end do

      do j = 2, n + 1
        do i = 2, m + 1
          table2(i,j) = table(i-1,j-1)
        end do
      end do

      return
      end
      subroutine i4mat_border_cut ( m, n, table, table2 )

c*********************************************************************72
c
cc I4MAT_BORDER_CUT cuts the "border" of an I4MAT.
c
c  Discussion:
c
c    An I4MAT is an array of I4's.
c
c    We suppose the input data gives values of a quantity on nodes
c    on a 2D grid, and we wish to create a new table corresponding only
c    to those nodes in the interior of the 2D grid.
c
c      0 0 0 0 0 0
c      0 * * * * 0    * * * *
c      0 * * * * 0 -> * * * *
c      0 * * * * 0    * * * *
c      0 0 0 0 0 0
c
c    The illustration suggests the situation in which a 5 by 6 array
c    is input, and a 3 by 4 array is to be output.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    28 April 2008
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer M, the spatial dimension.
c
c    Input, integer N, the number of points.
c
c    Input, integer TABLE(M,N), the table data.
c
c    Output, integer TABLE2(M-2,N-2), the new table data.
c
      implicit none

      integer m
      integer n

      integer i
      integer j
      integer table(m,n)
      integer table2(m-2,n-2)

      if ( m .le. 2 .or. n .le. 2 ) then
        return
      end if

      do j = 1, n - 2
        do i = 1, m - 2
          table2(i,j) = table(i+1,j+1)
        end do
      end do

      return
      end
      subroutine i4mat_copy ( m, n, a1, a2 )

c*********************************************************************72
c
cc I4MAT_COPY copies an I4MAT.
c
c  Discussion:
c
c    An I4MAT is an array of I4's.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    04 June 2009
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer M, the number of rows.
c
c    Input, integer N, the number of columns.
c
c    Input, integer A1(M,N), the matrix to copy.
c
c    Output, integer A2(M,N), the copy.
c
      implicit none

      integer m
      integer n

      integer a1(m,n)
      integer a2(m,n)
      integer i
      integer j

      do j = 1, n
        do i = 1, m
          a2(i,j) = a1(i,j)
        end do
      end do

      return
      end
      subroutine i4mat_elim ( m, n, a )

c*********************************************************************72
c
cc I4MAT_ELIM carries out exact Gauss elimination on an I4MAT.
c
c  Discussion:
c
c    An I4MAT is an array of I4's.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    31 August 2008
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer M, the number of rows in A.
c
c    Input, integer N, the number of columns in A.
c
c    Input/output, integer A(M,N).  On input, the M by N matrix to
c    be Gauss eliminated.  On output, the Gauss-eliminated matrix.
c
      implicit none

      integer m
      integer n

      integer a(m,n)
      integer amax
      integer i
      integer icol(n)
      integer ifact
      integer i4_gcd
      integer imax
      integer imult
      integer irow(m)
      integer iswap
      integer j
      integer jcol
      integer jmult
      integer temp
c
c  Initialize the swap parity counter.
c
      iswap = 1
c
c  For each column JCOL...
c
      do jcol = 1, min ( m, n )
c
c  Find the maximum element in rows JCOL through M.
c
        amax = abs ( a(jcol,jcol) )
        imax = jcol

        do i = jcol + 1, m
          if ( amax .lt. abs ( a(i,jcol) ) ) then
            amax = abs ( a(i,jcol) )
            imax = i
          end if
        end do
c
c  If the maximum entry is nonzero, then...
c
        if ( amax .ne. 0 ) then
c
c  If the maximum entry does not occur in row JCOL, then swap rows.
c
          if ( imax .ne. jcol ) then
            iswap = - iswap
            do j = 1, n
              temp      = a(jcol,j)
              a(jcol,j) = a(imax,j)
              a(imax,j) = temp
            end do
          end if
c
c  Eliminate all nonzero entries in column JCOL, below the diagonal entry.
c
          do i = jcol + 1, m

            if ( a(i,jcol) .ne. 0 ) then

              jmult = a(i,jcol)
              imult = a(jcol,jcol)
              ifact = i4_gcd ( imult, jmult )
              imult = imult / ifact
              jmult = jmult / ifact

              do j = jcol, n
                a(i,j) = jmult * a(jcol,j) - imult * a(i,j)
              end do

            end if

          end do
c
c  Remove any row or column factors.
c
          call i4mat_red ( m, n, a, irow, icol )

        end if

      end do

      return
      end
      subroutine i4mat_flip_cols ( m, n, a )

c*********************************************************************72
c
cc I4MAT_FLIP_COLS swaps the columns of an I4MAT.
c
c  Discussion:
c
c    An I4MAT is an integer matrix.
c
c    To "flip" the columns of an I4MAT is to start with something like
c
c      11 12 13 14 15
c      21 22 23 24 25
c      31 32 33 34 35
c      41 42 43 44 45
c      51 52 53 54 55
c
c    and return
c
c      15 14 13 12 11
c      25 24 23 22 21
c      35 34 33 32 31
c      45 44 43 42 41
c      55 54 53 52 51
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    28 July 2010
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer M, N, the number of rows and columns.
c
c    Input/output, integer A(M,N), the matrix whose columns
c    are to be flipped.
c
      implicit none

      integer m
      integer n

      integer a(m,n)
      integer b
      integer i
      integer j

      do j = 1, n / 2
        do i = 1, m
          b          = a(i,    j)
          a(i,    j) = a(i,n+1-j)
          a(i,n+1-j) = b
        end do
      end do

      return
      end
      subroutine i4mat_flip_rows ( m, n, a )

c*********************************************************************72
c
cc I4MAT_FLIP_ROWS swaps the rows of an I4MAT.
c
c  Discussion:
c
c    An I4MAT is an integer matrix.
c
c    To "flip" the rows of an I4MAT is to start with something like
c
c      11 12 13 14 15
c      21 22 23 24 25
c      31 32 33 34 35
c      41 42 43 44 45
c      51 52 53 54 55
c
c    and return
c
c      51 52 53 54 55
c      41 42 43 44 45
c      31 32 33 34 35
c      21 22 23 24 25
c      11 12 13 14 15
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    28 July 2010
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer M, N, the number of rows and columns.
c
c    Input/output, integer A(M,N), the matrix whose rows
c    are to be flipped.
c
      implicit none

      integer m
      integer n

      integer a(m,n)
      integer b
      integer i
      integer j

      do i = 1, m / 2
        do j = 1, n
          b          = a(    i,j)
          a(    i,j) = a(m+1-i,j)
          a(m+1-i,j) = b
        end do
      end do

      return
      end
      subroutine i4mat_histogram ( m, n, a, histo_num, histo_gram )

c*********************************************************************72
c
cc I4MAT_HISTOGRAM computes a histogram of the elements of an I4MAT.
c
c  Discussion:
c
c    An I4MAT is an array of I4's.
c
c    It is assumed that the entries in the vector A are nonnegative.
c    Only values between 0 and HISTO_NUM will be histogrammed.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    04 June 2010
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer M, N, the order of A.
c
c    Input, integer A(M,N), the array to examine.
c
c    Input, integer HISTO_NUM, the maximum value for which a
c    histogram entry will be computed.
c
c    Output, integer HISTO_GRAM(0:HISTO_NUM), contains the
c    number of entries of A with the values of 0 through HISTO_NUM.
c
      implicit none

      integer histo_num
      integer m
      integer n

      integer a(m,n)
      integer histo_gram(0:histo_num)
      integer i
      integer j

      do i = 0, histo_num
        histo_gram(i) = 0
      end do

      do j = 1, n
        do i = 1, m

          if ( 0 .le. a(i,j) .and. a(i,j) .le. histo_num ) then
            histo_gram(a(i,j)) = histo_gram(a(i,j)) + 1
          end if

        end do
      end do

      return
      end
      subroutine i4mat_indicator ( m, n, table )

c*********************************************************************72
c
cc I4MAT_INDICATOR sets up an "indicator" I4MAT.
c
c  Discussion:
c
c    An I4MAT is an array of I4's.
c
c    The value of each entry suggests its location, as in:
c
c      11  12  13  14
c      21  22  23  24
c      31  32  33  34
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    28 April 2008
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer M, the number of rows of the matrix.
c    M must be positive.
c
c    Input, integer N, the number of columns of the matrix.
c    N must be positive.
c
c    Output, integer TABLE(M,N), the table.
c
      implicit none

      integer m
      integer n

      integer fac
      integer i
      integer i4_log_10
      integer j
      integer table(m,n)

      fac = 10 ** ( i4_log_10 ( n ) + 1 )

      do i = 1, m
        do j = 1, n
          table(i,j) = fac * i + j
        end do
      end do

      return
      end
      subroutine i4mat_l1_inverse ( n, a, b )

c*********************************************************************72
c
cc I4MAT_L1_INVERSE inverts a unit lower triangular I4MAT.
c
c  Discussion:
c
c    An I4MAT is a rectangular array of I4 values.
c
c    A unit lower triangular matrix is a matrix with only 1's on the main
c    diagonal, and only 0's above the main diagonal.
c
c    The inverse of an integer unit lower triangular matrix is also
c    an integer unit lower triangular matrix.
c
c    This routine can invert a matrix in place, that is, with no extra
c    storage.  If the matrix is stored in A, then the call
c
c      call i4mat_l1_inverse ( n, a, a )
c
c    will result in A being overwritten by its inverse.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    05 June 2010
c
c  Author:
c
c    John Burkardt
c
c  Reference:
c
c    Albert Nijenhuis, Herbert Wilf,
c    Combinatorial Algorithms for Computers and Calculators,
c    Academic Press, 1978,
c    ISBN: 0-12-519260-6,
c    LC: QA164.N54.
c
c  Parameters:
c
c    Input, integer N, number of rows and columns in the matrix.
c
c    Input, integer  A(N,N), the unit lower triangular matrix.
c
c    Output, integer B(N,N), the inverse matrix.
c
      implicit none

      integer n

      integer a(n,n)
      integer b(n,n)
      integer i
      integer j
      integer k

      do i = 1, n

        do j = 1, i - 1
          b(i,j) = 0
          do k = 1, i - 1
            b(i,j) = b(i,j) - a(i,k) * b(k,j)
          end do
        end do

        b(i,i) = 1
        do j = i + 1, n
          b(i,j) = 0
        end do

      end do

      return
      end
      function i4mat_max ( m, n, a )

c*********************************************************************72
c
cc I4MAT_MAX returns the maximum of an I4MAT.
c
c  Discussion:
c
c    An I4MAT is a rectangular array of I4 values.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    05 June 2010
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer M, the number of rows in A.
c
c    Input, integer N, the number of columns in A.
c
c    Input, integer A(M,N), the M by N matrix.
c
c    Output, integer I4MAT_MAX, the maximum entry of A.
c
      implicit none

      integer m
      integer n

      integer a(m,n)
      integer i
      integer i4_huge
      parameter ( i4_huge = 2147483647 )
      integer i4mat_max
      integer j

      i4mat_max = - i4_huge

      do j = 1, n
        do i = 1, m
          i4mat_max = max ( i4mat_max, a(i,j) )
        end do
      end do

      return
      end
      subroutine i4mat_max_index ( m, n, a, i_max, j_max )

c*********************************************************************72
c
cc I4MAT_MAX_INDEX returns the location of the maximum of an I4MAT.
c
c  Discussion:
c
c    An I4MAT is a rectangular array of I4 values.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    06 June 2010
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer M, the number of rows in A.
c
c    Input, integer N, the number of columns in A.
c
c    Input, integer A(M,N), the M by N matrix.
c
c    Output, integer I_MAX, J_MAX, the indices of the
c    maximum entry of A.
c
      implicit none

      integer m
      integer n

      integer a(m,n)
      integer i
      integer i_max
      integer j
      integer j_max

      i_max = -1;
      j_max = -1;

      do j = 1, n
        do i = 1, m
          if ( i .eq. 1 .and. j .eq. 1 ) then
            i_max = i
            j_max = j
          else if ( a(i_max,j_max) .lt. a(i,j) ) then
            i_max = i
            j_max = j
          end if
        end do
      end do

      return
      end
      function i4mat_min ( m, n, a )

c*********************************************************************72
c
cc I4MAT_MIN returns the minimum of an I4MAT.
c
c  Discussion:
c
c    An I4MAT is a rectangular array of I4 values.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    05 June 2010
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer M, the number of rows in A.
c
c    Input, integer N, the number of columns in A.
c
c    Input, integer A(M,N), the M by N matrix.
c
c    Output, integer I4MAT_MIN, the minimum entry of A.
c
      implicit none

      integer m
      integer n

      integer a(m,n)
      integer i
      integer i4_huge
      parameter ( i4_huge = 2147483647 )
      integer i4mat_min
      integer j

      i4mat_min = i4_huge

      do j = 1, n
        do i = 1, m
          i4mat_min = min ( i4mat_min, a(i,j) )
        end do
      end do

      return
      end
      subroutine i4mat_min_index ( m, n, a, i_min, j_min )

c*********************************************************************72
c
cc I4MAT_MIN_INDEX returns the location of the minimum of an I4MAT.
c
c  Discussion:
c
c    An I4MAT is a rectangular array of I4 values.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    06 June 2010
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer M, the number of rows in A.
c
c    Input, integer N, the number of columns in A.
c
c    Input, integer A(M,N), the M by N matrix.
c
c    Output, integer I_MIN, J_MIN, the indices of the
c    minimum entry of A.
c
      implicit none

      integer m
      integer n

      integer a(m,n)
      integer i
      integer i_min
      integer j
      integer j_min

      i_min = -1
      j_min = -1

      do j = 1, n
        do i = 1, m
          if ( i .eq. 1 .and. j .eq. 1 ) then
            i_min = i
            j_min = j
          else if ( a(i,j) .lt. a(i_min,j_min) ) then
            i_min = i
            j_min = j
          end if
        end do
      end do

      return
      end
      subroutine i4mat_mm ( n1, n2, n3, a, b, c )

c*********************************************************************72
c
cc I4MAT_MM multiplies two I4MAT's.
c
c  Discussion:
c
c    An I4MAT is a rectangular array of I4 values.
c
c    In FORTRAN90, this operation is more efficiently done by the
c    command:
c
c      C(1:N1,1:N3) = MATMUL ( A(1:N1,1;N2), B(1:N2,1:N3) )
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    06 June 2010
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N1, N2, N3, the order of the matrices.
c
c    Input, integer A(N1,N2), B(N2,N3), the matrices to multiply.
c
c    Output, integer C(N1,N3), the product matrix C = A * B.
c
      implicit none

      integer n1
      integer n2
      integer n3

      integer a(n1,n2)
      integer b(n2,n3)
      integer c(n1,n3)
      integer i
      integer j
      integer k

      do i = 1, n1
        do j = 1, n3
          c(i,j) = 0
          do k = 1, n2
            c(i,j) = c(i,j) + a(i,k) * b(k,j)
          end do
        end do
      end do

      return
      end
      subroutine i4mat_perm ( n, a, p )

c*********************************************************************72
c
cc I4MAT_PERM permutes the rows and columns of a square I4MAT.
c
c  Discussion:
c
c    An I4MAT is a rectangular array of I4 values.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c   07 June 2010
c
c  Author:
c
c    Original FORTRAN77 version by Albert Nijenhuis, Herbert Wilf.
c    This FORTRAN77 version by John Burkardt.
c
c  Reference:
c
c    Albert Nijenhuis, Herbert Wilf,
c    Combinatorial Algorithms for Computers and Calculators,
c    Academic Press, 1978,
c    ISBN: 0-12-519260-6,
c    LC: QA164.N54.
c
c  Parameters:
c
c    Input, integer N, the order of the matrix.
c
c    Input/output, integer A(N,N).
c    On input, the matrix to be permuted.
c    On output, the permuted matrix.
c
c    Input, integer P(N), the permutation.  P(I) is the new
c    number of row and column I.
c
      implicit none

      integer n

      integer a(n,n)
      integer i
      integer i1
      integer ierror
      integer is
      integer it
      integer j
      integer j1
      integer j2
      integer k
      integer lc
      integer nc
      integer p(n)
      integer t

      call perm_check1 ( n, p )

      call perm_cycle ( n, p, is, nc, 1 )

      do i = 1, n

        i1 = - p(i)

        if ( 0 .lt. i1 ) then

          lc = 0

10        continue

            i1 = p(i1)
            lc = lc + 1

            if ( i1 .le. 0 ) then
              go to 20
            end if

          go to 10

20        continue

          i1 = i

          do j = 1, n

            if ( p(j) .le. 0 ) then

              j2 = j
              k = lc

30            continue

                j1 = j2
                it = a(i1,j1)

40              continue

                  i1 = abs ( p(i1) )
                  j1 = abs ( p(j1) )

                  t        = a(i1,j1)
                  a(i1,j1) = it
                  it       = t

                  if ( j1 .ne. j2 ) then
                    go to 40
                  end if

                  k = k - 1

                  if ( i1 .eq. i ) then
                    go to 50
                  end if

                go to 40

50              continue

                j2 = abs ( p(j2) )

                if ( k .eq. 0 ) then
                  go to 60
                end if

              go to 30

60            continue

            end if

          end do

        end if

      end do
c
c  Restore the positive signs of the data.
c
      do i = 1, n
        p(i) = abs ( p(i) )
      end do

      return
      end
      subroutine i4mat_perm_uniform ( n, a, seed )

c*********************************************************************72
c
cc I4MAT_PERM_UNIFORM selects a random permutation of an I4MAT.
c
c  Discussion:
c
c    An I4MAT is a rectangular array of I4 values.
c
c    The matrix is assumed to be square.  A single permutation is
c    applied to both rows and columns.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    12 November 2014
c
c  Author:
c
c    John Burkardt
c
c  Reference:
c
c    Albert Nijenhuis, Herbert Wilf,
c    Combinatorial Algorithms for Computers and Calculators,
c    Academic Press, 1978,
c    ISBN: 0-12-519260-6,
c    LC: QA164.N54.
c
c  Parameters:
c
c    Input, integer N, the number of rows and columns
c    in the array.
c
c    Input/output, integer A(N,N), the array to be permuted.
c
c    Input/output, integer SEED, a seed for the random
c    number generator.
c
      implicit none

      integer n

      integer a(n,n)
      integer i
      integer i4_uniform_ab
      integer j
      integer k1
      integer k2
      integer seed
      integer t
c
c  Permute the rows and columns together.
c
      do k1 = 1, n - 1

        k2 = i4_uniform_ab ( k1, n, seed )

        do j = 1, n
          t       = a(k2,j)
          a(k2,j) = a(k1,j)
          a(k1,j) = t
        end do

        do i = 1, n
          t       = a(i,k2)
          a(i,k2) = a(i,k1)
          a(i,k1) = t
        end do

      end do

      return
      end
      subroutine i4mat_perm2_uniform ( m, n, a, seed )

c*********************************************************************72
c
cc I4MAT_PERM2_UNIFORM selects a random permutation of an I4MAT.
c
c  Discussion:
c
c    An I4MAT is a rectangular array of I4 values.
c
c    The matrix may be rectangular.  Separate permutations are
c    applied to the rows and columns.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    06 June 2010
c
c  Author:
c
c    John Burkardt
c
c  Reference:
c
c    Albert Nijenhuis, Herbert Wilf,
c    Combinatorial Algorithms for Computers and Calculators,
c    Academic Press, 1978,
c    ISBN: 0-12-519260-6,
c    LC: QA164.N54.
c
c  Parameters:
c
c    Input, integer M, N, the number of rows and columns.
c
c    Input/output, integer A(M,N), the array to be permuted.
c
c    Input/output, integer SEED, a seed for the random
c    number generator.
c
      implicit none

      integer m
      integer n

      integer a(m,n)
      integer i
      integer i4_uniform_ab
      integer i2
      integer j
      integer j2
      integer seed
      integer t
c
c  Permute the rows.
c
      do i = 1, m
        i2 = i4_uniform_ab ( i, m, seed )
        do j = 1, n
          t       = a(i2,j)
          a(i2,j) = a(i,j)
          a(i,j)  = t
        end do
      end do
c
c  Permute the columns.
c
      do j = 1, n
        j2 = i4_uniform_ab ( j, n, seed )
        do i = 1, m
          t = a(i,j2)
          a(i,j2) = a(i,j)
          a(i,j)  = t
        end do
      end do

      return
      end
      subroutine i4mat_print ( m, n, a, title )

c*********************************************************************72
c
cc I4MAT_PRINT prints an I4MAT.
c
c  Discussion:
c
c    An I4MAT is an array of I4's.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    30 June 2003
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer M, the number of rows in A.
c
c    Input, integer N, the number of columns in A.
c
c    Input, integer A(M,N), the matrix to be printed.
c
c    Input, character*(*) TITLE, a title.
c
      implicit none

      integer m
      integer n

      integer a(m,n)
      integer ihi
      integer ilo
      integer jhi
      integer jlo
      character*(*) title

      ilo = 1
      ihi = m
      jlo = 1
      jhi = n

      call i4mat_print_some ( m, n, a, ilo, jlo, ihi, jhi, title )

      return
      end
      subroutine i4mat_print_some ( m, n, a, ilo, jlo, ihi, jhi, title )

c*********************************************************************72
c
cc I4MAT_PRINT_SOME prints some of an I4MAT.
c
c  Discussion:
c
c    An I4MAT is an array of I4's.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    04 November 2003
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer M, N, the number of rows and columns.
c
c    Input, integer A(M,N), an M by N matrix to be printed.
c
c    Input, integer ILO, JLO, the first row and column to print.
c
c    Input, integer IHI, JHI, the last row and column to print.
c
c    Input, character*(*) TITLE, a title.
c
      implicit none

      integer incx
      parameter ( incx = 10 )
      integer m
      integer n

      integer a(m,n)
      character*(8) ctemp(incx)
      integer i
      integer i2hi
      integer i2lo
      integer ihi
      integer ilo
      integer inc
      integer j
      integer j2
      integer j2hi
      integer j2lo
      integer jhi
      integer jlo
      character*(*) title

      write ( *, '(a)' ) ' '
      write ( *, '(a)' ) trim ( title )

      if ( m .le. 0 .or. n .le. 0 ) then
        write ( *, '(a)' ) ' '
        write ( *, '(a)' ) '  (None)'
        return
      end if

      do j2lo = max ( jlo, 1 ), min ( jhi, n ), incx

        j2hi = j2lo + incx - 1
        j2hi = min ( j2hi, n )
        j2hi = min ( j2hi, jhi )

        inc = j2hi + 1 - j2lo

        write ( *, '(a)' ) ' '

        do j = j2lo, j2hi
          j2 = j + 1 - j2lo
          write ( ctemp(j2), '(i8)' ) j
        end do

        write ( *, '(''  Col '',10a8)' ) ( ctemp(j), j = 1, inc )
        write ( *, '(a)' ) '  Row'
        write ( *, '(a)' ) ' '

        i2lo = max ( ilo, 1 )
        i2hi = min ( ihi, m )

        do i = i2lo, i2hi

          do j2 = 1, inc

            j = j2lo - 1 + j2

            write ( ctemp(j2), '(i8)' ) a(i,j)

          end do

          write ( *, '(i5,a,10a8)' ) i, ':', ( ctemp(j), j = 1, inc )

        end do

      end do

      return
      end
      subroutine i4mat_red ( m, n, a, row, col )

c*********************************************************************72
c
cc I4MAT_RED divides out common factors in a row or column of an I4MAT.
c
c  Discussion:
c
c    An I4MAT is a rectangular array of I4 values.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    18 July 2010
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer M, the number of rows in the matrix.
c
c    Input, integer N, the number of columns in the matrix.
c
c    Input/output, integer A(M,N), on input, the M by N matrix
c    to be reduced.  On output, A has been reduced.  The greatest common
c    factor in any row or column is 1.
c
!    Output, integer ROW(M), the row factors that were divided out.
!
!    Output, integer COL(N), the column factors that were divided
!    out.
!
      implicit none

      integer m
      integer n

      integer a(m,n)
      integer arow(n)
      integer col(n)
      integer factor
      integer i
      integer j
      integer row(m)

      if ( m .le. 0 ) then
        write ( *, '(a)' ) ' '
        write ( *, '(a)' ) 'IMAT_RED - Fatal error!'
        write ( *, '(a)' ) '  M must be greater than 0.'
        write ( *, '(a,i8)' ) '  Input M = ', m
        stop 1
      end if

      if ( n .le. 0 ) then
        write ( *, '(a)' ) ' '
        write ( *, '(a)' ) 'IMAT_RED - Fatal error!'
        write ( *, '(a)' ) '  N must be greater than 0.'
        write ( *, '(a,i8)' ) '  Input N = ', n
        stop 1
      end if
c
c  Remove factors common to a column.
c
      do j = 1, n
        call i4vec_red ( m, a(1,j), factor )
        col(j) = factor
      end do
c
c  Remove factors common to a row.
c
      do i = 1, m
        do j = 1, n
          arow(j) = a(i,j)
        end do
        call i4vec_red ( n, arow, factor )
        row(i) = factor
      end do

      return
      end
      subroutine i4mat_transpose_print ( m, n, a, title )

c*********************************************************************72
c
cc I4MAT_TRANSPOSE_PRINT prints an I4MAT, transposed.
c
c  Discussion:
c
c    An I4MAT is an array of I4's.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    39 October 2007
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer M, N, the number of rows and columns.
c
c    Input, integer A(M,N), an M by N matrix to be printed.
c
c    Input, character * ( * ) TITLE, a title.
c
      implicit none

      integer m
      integer n

      integer a(m,n)
      character * ( * ) title

      call i4mat_transpose_print_some ( m, n, a, 1, 1, m, n, title )

      return
      end
      subroutine i4mat_transpose_print_some ( m, n, a, ilo, jlo, ihi,
     &   jhi, title )

c*********************************************************************72
c
cc I4MAT_TRANSPOSE_PRINT_SOME prints some of the transpose of an I4MAT.
c
c  Discussion:
c
c    An I4MAT is an array of I4's.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    30 October 2007
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer M, N, the number of rows and columns.
c
c    Input, integer A(M,N), an M by N matrix to be printed.
c
c    Input, integer ILO, JLO, the first row and column to print.
c
c    Input, integer IHI, JHI, the last row and column to print.
c
c    Input, character * ( * ) TITLE, a title.
c
      implicit none

      integer incx
      parameter ( incx = 10 )
      integer m
      integer n

      integer a(m,n)
      character*8 ctemp(incx)
      integer i
      integer i2
      integer i2hi
      integer i2lo
      integer ihi
      integer ilo
      integer inc
      integer j
      integer j2hi
      integer  j2lo
      integer jhi
      integer jlo
      character * ( * ) title

      write ( *, '(a)' ) ' '
      write ( *, '(a)' )  title

      if ( m .le. 0 .or. n .le. 0 ) then
        write ( *, '(a)' ) ' '
        write ( *, '(a)' ) '  (None)'
        return
      end if

      do i2lo = max ( ilo, 1 ), min ( ihi, m ), incx

        i2hi = i2lo + incx - 1
        i2hi = min ( i2hi, m )
        i2hi = min ( i2hi, ihi )

        inc = i2hi + 1 - i2lo

        write ( *, '(a)' ) ' '

        do i = i2lo, i2hi
          i2 = i + 1 - i2lo
          write ( ctemp(i2), '(i8)' ) i
        end do

        write ( *, '(''  Row '',10a8)' ) ctemp(1:inc)
        write ( *, '(a)' ) '  Col'
        write ( *, '(a)' ) ' '

        j2lo = max ( jlo, 1 )
        j2hi = min ( jhi, n )

        do j = j2lo, j2hi

          do i2 = 1, inc

            i = i2lo - 1 + i2

            write ( ctemp(i2), '(i8)' ) a(i,j)

          end do

          write ( *, '(i5,a,10a8)' ) j, ':', ( ctemp(i), i = 1, inc )

        end do

      end do

      return
      end
      subroutine i4mat_u1_inverse ( n, a, b )

c*********************************************************************72
c
cc I4MAT_U1_INVERSE inverts a unit upper triangular I4MAT.
c
c  Discussion:
c
c    An I4MAT is an array of I4's.
c
c    A unit upper triangular matrix is a matrix with only 1's on the main
c    diagonal, and only 0's below the main diagonal.
c
c    The inverse of an integer unit upper triangular matrix is also
c    an integer unit upper triangular matrix.
c
c    This routine can invert a matrix in place, that is, with no extra
c    storage.  If the matrix is stored in A, then the call
c
c      call i4mat_u1_inverse ( n, a, a )
c
c    will result in A being overwritten by its inverse.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    01 August 2008
c
c  Author:
c
c    John Burkardt
c
c  Reference:
c
c    Albert Nijenhuis, Herbert Wilf,
c    Combinatorial Algorithms for Computers and Calculators,
c    Academic Press, 1978,
c    ISBN: 0-12-519260-6,
c    LC: QA164.N54.
c
c  Parameters:
c
c    Input, integer N, number of rows and columns in the matrix.
c
c    Input, integer A(N,N), the unit upper triangular matrix.
c
c    Output, integer B(N,N), the inverse matrix.
c
      implicit none

      integer n

      integer a(n,n)
      integer b(n,n)
      integer dot
      integer i
      integer j
      integer k

      do j = n, 1, -1

        b(j,j) = 1
        do i = j + 1, n
          b(i,j) = 0
        end do

        do i = j - 1, 1, -1
          dot = 0
          do k = i + 1, j
            dot = dot + a(i,k) * b(k,j)
          end do
          b(i,j) = - dot
        end do

      end do

      return
      end
      subroutine i4mat_uniform_ab ( m, n, a, b, seed, x )

c*********************************************************************72
c
cc I4MAT_UNIFORM_AB returns a scaled pseudorandom I4MAT.
c
c  Discussion:
c
c    An I4MAT is an array of I4's.
c
c    The pseudorandom numbers should be uniformly distributed
c    between A and B.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    27 November 2006
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer M, N, the row and column dimensions of the matrix.
c
c    Input, integer A, B, the limits of the interval.
c
c    Input/output, integer SEED, the "seed" value, which should NOT be 0.
c    On output, SEED has been updated.
c
c    Output, integer X(M,N), a matrix of values between A and B.
c
      implicit none

      integer m
      integer n

      integer a
      integer b
      integer i
      integer i4_huge
      parameter ( i4_huge = 2147483647 )
      integer j
      integer k
      real r
      integer seed
      integer value
      integer x(m,n)

      if ( seed .eq. 0 ) then
        write ( *, '(a)' ) ' '
        write ( *, '(a)' ) 'I4MAT_UNIFORM_AB - Fatal error!'
        write ( *, '(a)' ) '  Input value of SEED = 0.'
        stop 1
      end if

      do j = 1, n

        do i = 1, m

          k = seed / 127773

          seed = 16807 * ( seed - k * 127773 ) - k * 2836

          if ( seed .lt. 0 ) then
            seed = seed + i4_huge
          end if

          r = real ( seed ) * 4.656612875E-10
c
c  Scale R to lie between A-0.5 and B+0.5.
c
          r = ( 1.0E+00 - r ) * ( real ( min ( a, b ) ) - 0.5E+00 )
     &      +             r   * ( real ( max ( a, b ) ) + 0.5E+00 )
c
c  Use rounding to convert R to an integer between A and B.
c
          value = nint ( r )

          value = max ( value, min ( a, b ) )
          value = min ( value, max ( a, b ) )

          x(i,j) = value

        end do
      end do

      return
      end
      subroutine i4mat_zero ( m, n, a )

c*********************************************************************72
c
cc I4MAT_ZERO zeroes out an I4MAT.
c
c  Discussion:
c
c    An I4MAT is an array of I4's.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    22 November 2010
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer M, N, the row and column dimensions of the matrix.
c
c    Output, integer A(M,N), a matrix of zeroes.
c
      implicit none

      integer m
      integer n

      integer a(m,n)
      integer i
      integer j

      do j = 1, n
        do i = 1, m
          a(i,j) = 0
        end do
      end do

      return
      end
      subroutine i4row_compare ( m, n, a, i, j, isgn )

c*********************************************************************72
c
cc I4ROW_COMPARE compares two rows of an I4ROW.
c
c  Discussion:
c
c    An I4ROW is an M by N array of integer values, regarded
c    as an array of M rows of length N.
c
c  Example:
c
c    Input:
c
c    M = 3, N = 4, I = 2, J = 3
c
c    A = (
c      1  2  3  4
c      5  6  7  8
c      9 10 11 12 )
c
c    Output:
c
c      ISGN = -1
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    01 June 2009
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer M, N, the number of rows and columns.
c
c    Input, integer A(M,N), an array of M rows of vectors
c    of length N.
c
c    Input, integer I, J, the rows to be compared.
c    I and J must be between 1 and M.
c
c    Output, integer ISGN, the results of the comparison:
c    -1, row I .lt. row J,
c     0, row I = row J,
c    +1, row J .lt. row I.
c
      implicit none

      integer m
      integer n

      integer a(m,n)
      integer i
      integer isgn
      integer j
      integer k
c
c  Check that I and J are legal.
c
      if ( i .lt. 1 ) then
        write ( *, '(a)' ) ' '
        write ( *, '(a)' ) 'IROW_COMPARE - Fatal error!'
        write ( *, '(a)' ) '  Row index I is less than 1.'
        write ( *, '(a,i8)' ) '  I = ', i
        stop 1
      else if ( m .lt. i ) then
        write ( *, '(a)' ) ' '
        write ( *, '(a)' ) 'IROW_COMPARE - Fatal error!'
        write ( *, '(a)' ) '  Row index I is out of bounds.'
        write ( *, '(a,i8)' ) '  I = ', i
        write ( *, '(a,i8)' ) '  Maximum legal value is M = ', m
        stop 1
      end if

      if ( j .lt. 1 ) then
        write ( *, '(a)' ) ' '
        write ( *, '(a)' ) 'IROW_COMPARE - Fatal error!'
        write ( *, '(a)' ) '  Row index J is less than 1.'
        write ( *, '(a,i8)' ) '  J = ', j
        stop 1
      else if ( m .lt. j ) then
        write ( *, '(a)' ) ' '
        write ( *, '(a)' ) 'IROW_COMPARE - Fatal error!'
        write ( *, '(a)' ) '  Row index J is out of bounds.'
        write ( *, '(a,i8)' ) '  J = ', j
        write ( *, '(a,i8)' ) '  Maximum legal value is M = ', m
        stop 1
      end if

      isgn = 0

      if ( i .eq. j ) then
        return
      end if

      k = 1

10    continue

      if ( k .le. n ) then

        if ( a(i,k) .lt. a(j,k) ) then
          isgn = -1
          return
        else if ( a(j,k) .lt. a(i,k) ) then
          isgn = +1
          return
        end if

        k = k + 1

        go to 10

      end if

      return
      end
      subroutine i4row_find_item ( m, n, a, item, row, col )

c*********************************************************************72
c
cc I4ROW_FIND_ITEM searches the rows of an I4ROW for a given value.
c
c  Discussion:
c
c    An I4ROW is an M by N array of I4 values, regarded
c    as an array of M rows of length N.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    06 June 2010
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer M, N, the number of rows and columns.
c
c    Input, integer A(M,N), the table to search.
c
c    Input, integer ITEM, the value to search for.
c
c    Output, integer ROW, COL, the row and column indices
c    of the first occurrence of the value ITEM.  The search
c    is conducted by rows.  If the item is not found, then
c    ROW = COL = -1.
c
      implicit none

      integer m
      integer n

      integer a(m,n)
      integer col
      integer i
      integer item
      integer j
      integer row

      row = -1
      col = -1

      do i = 1, m
        do j = 1, n
          if ( a(i,j) .eq. item ) then
            row = i
            col = j
            return
          end if
        end do
      end do

      return
      end
      subroutine i4row_find_pair_wrap ( m, n, a, item1, item2, row,
     &  col )

c*********************************************************************72
c
cc I4ROW_FIND_PAIR_WRAP searches rows of an I4ROW for a pair of items.
c
c  Discussion:
c
c    An I4ROW is an M by N array of I4 values, regarded
c    as an array of M rows of length N.
c
c    The items must occur consecutively, with ITEM1 occurring
c    first.  However, wrapping is allowed.  That is, if ITEM1
c    occurs in the last column, and ITEM2 in the first, this
c    is also regarded as a match.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    07 June 2010
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer M, N, the number of rows and columns.
c
c    Input, integer A(M,N), the table to search.
c
c    Input, integer ITEM1, ITEM2, the values to search for.
c
c    Output, integer ROW, COL, the row and column indices
c    of the first occurrence of the value ITEM1 followed immediately
c    by ITEM2.  The search is conducted by rows.  If the pair of
c    items is not found, then ROW = COL = -1.  If COL = N,
c    the ITEM1 occurs in column N and ITEM2 occurs in column 1.
c
      implicit none

      integer m
      integer n

      integer a(m,n)
      integer col
      integer i
      integer item1
      integer item2
      integer j
      integer jp1
      integer row

      row = -1
      col = -1

      do i = 1, m
        do j = 1, n

          if ( a(i,j) .eq. item1 ) then

            if ( j .lt. n ) then
              jp1 = j + 1
            else
              jp1 = 1
            end if

            if ( a(i,jp1) .eq. item2 ) then
              row = i
              col = j
              return
            end if

          end if

        end do
      end do

      return
      end
      subroutine i4row_max ( m, n, a, amax )

c*********************************************************************72
c
cc I4ROW_MAX returns the maximums of the rows of an I4ROW.
c
c  Discussion:
c
c    An I4ROW is an M by N array of I4 values, regarded
c    as an array of M rows of length N.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    28 July 2010
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer M, N, the number of rows and columns.
c
c    Input, integer A(M,N), the array to be examined.
c
c    Output, integer AMAX(M), the maximums of the rows
c    of the array.
c
      implicit none

      integer m
      integer n

      integer a(m,n)
      integer amax(m)
      integer i
      integer j

      do i = 1, m

        amax(i) = a(i,1)
        do j = 2, n
          if ( amax(i) .lt. a(i,j) ) then
            amax(i) = a(i,j)
          end if
        end do

      end do

      return
      end
      subroutine i4row_mean ( m, n, a, mean )

c*********************************************************************72
c
cc I4ROW_MEAN returns the means of the rows of an I4ROW.
c
c  Discussion:
c
c    An I4ROW is an M by N array of I4 values, regarded
c    as an array of M rows of length N.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    28 July 2010
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer M, N, the number of rows and columns.
c
c    Input, integer A(M,N), an array of data.
c
c    Output, double precision MEAN(M), the mean of each row.
c
      implicit none

      integer m
      integer n

      integer a(m,n)
      integer i
      integer j
      double precision mean(m)

      do i = 1, m
        mean(i) = 0.0D+00
        do j = 1, n
          mean(i) = mean(i) + dble ( a(i,j) )
        end do
        mean(i) = mean(i) / dble ( n )
      end do

      return
      end
      subroutine i4row_min ( m, n, a, amin )

c*********************************************************************72
c
cc I4ROW_MIN returns the minimums of the rows of an I4ROW.
c
c  Discussion:
c
c    An I4ROW is an M by N array of I4 values, regarded
c    as an array of M rows of length N.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    28 July 2010
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer M, N, the number of rows and columns.
c
c    Input, integer A(M,N), the array to be examined.
c
c    Output, integer AMIN(M), the minimums of the rows.
c
      implicit none

      integer m
      integer n

      integer a(m,n)
      integer amin(m)
      integer i
      integer j

      do i = 1, m

        amin(i) = a(i,1)
        do j = 2, n
          if ( a(i,j) .lt. amin(i) ) then
            amin(i) = a(i,j)
          end if
        end do

      end do

      return
      end
      subroutine i4row_sort_a ( m, n, a )

c*********************************************************************72
c
cc I4ROW_SORT_A ascending sorts the rows of an I4ROW.
c
c  Discussion:
c
c    An I4ROW is an M by N array of integer values, regarded
c    as an array of M rows of length N.
c
c    In lexicographic order, the statement "X .lt. Y", applied to two
c    vectors X and Y of length M, means that there is some index I, with
c    1 .le. I .le. M, with the property that
c
c      X(J) = Y(J) for J .lt. I,
c    and
c      X(I) .lt. Y(I).
c
c    In other words, X is less than Y if, at the first index where they
c    differ, the X value is less than the Y value.
c
c  Example:
c
c    Input:
c
c      M = 5, N = 3
c
c      A =
c        3  2  1
c        2  4  3
c        3  1  8
c        2  4  2
c        1  9  9
c
c    Output:
c
c      A =
c        1  9  9
c        2  4  2
c        2  4  3
c        3  1  8
c        3  2  1
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    01 June 2009
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer M, the number of rows of A.
c
c    Input, integer N, the number of columns of A.
c
c    Input/output, integer A(M,N).
c    On input, the array of M rows of N-vectors.
c    On output, the rows of A have been sorted in ascending
c    lexicographic order.
c
      implicit none

      integer m
      integer n

      integer a(m,n)
      integer i
      integer indx
      integer isgn
      integer j

      if ( m .le. 1 ) then
        return
      end if

      if ( n .le. 0 ) then
        return
      end if
c
c  Initialize.
c
      i = 0
      indx = 0
      isgn = 0
      j = 0
c
c  Call the external heap sorter.
c
10    continue

        call sort_heap_external ( m, indx, i, j, isgn )
c
c  Interchange the I and J objects.
c
        if ( 0 .lt. indx ) then

          call i4row_swap ( m, n, a, i, j )
c
c  Compare the I and J objects.
c
        else if ( indx .lt. 0 ) then

          call i4row_compare ( m, n, a, i, j, isgn )

        else if ( indx .eq. 0 ) then

          go to 20

        end if

      go to 10

20    continue

      return
      end
      subroutine i4row_sort_d ( m, n, a )

c*********************************************************************72
c
cc I4ROW_SORT_D descending sorts the rows of an I4ROW.
c
c  Discussion:
c
c    An I4ROW is an M by N array of I4's, regarded
c    as an array of M rows of length N.
c
c    In lexicographic order, the statement "X < Y", applied to two real
c    vectors X and Y of length M, means that there is some index I, with
c    1 <= I <= M, with the property that
c
c      X(J) = Y(J) for J < I,
c    and
c      X(I) < Y(I).
c
c    In other words, the first time they differ, X is smaller.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    26 October 2014
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer M, the number of rows and columns of A.
c
c    Input/output, integer A(M,N).
c    On input, the array of M rows of N-vectors.
c    On output, the rows of A have been sorted in descending
c    lexicographic order.
c
      implicit none

      integer m
      integer n

      integer a(m,n)
      integer i
      integer indx
      integer isgn
      integer j

      if ( m .le. 1 ) then
        return
      end if

      if ( n .le. 0 ) then
        return
      end if
c
c  Initialize.
c
      i = 0
      indx = 0
      isgn = 0
      j = 0
c
c  Call the external heap sorter.
c
10    continue

        call sort_heap_external ( m, indx, i, j, isgn )
c
c  Interchange the I and J objects.
c
        if ( 0 .lt. indx ) then

          call i4row_swap ( m, n, a, i, j )
c
c  Compare the I and J objects.
c
        else if ( indx .lt. 0 ) then

          call i4row_compare ( m, n, a, i, j, isgn )
          isgn = -isgn

        else if ( indx .eq. 0 ) then

          go to 20

        end if

      go to 10

20    continue

      return
      end
      subroutine i4row_sort2_d ( m, n, a )

c*********************************************************************72
c
cc I4ROW_SORT2_D descending sorts the elements of each row of an I4ROW.
c
c  Discussion:
c
c    An I4ROW is an M by N array of I4's, regarded
c    as an array of M rows of length N.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    26 October 2014
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer M, the number of rows of A.
c
c    Input, integer N, the number of columns of A, and the length
c    of a vector of data.
c
c    Input/output, integer A(M,N).
c    On input, the array of M rows of N-vectors.
c    On output, the elements of each row of A have been sorted in descending
c    order.
c
      implicit none

      integer m
      integer n

      integer a(m,n)
      integer i
      integer indx
      integer isgn
      integer j
      integer row
      integer t

      if ( m .le. 1 ) then
        return
      end if

      if ( n .le. 0 ) then
        return
      end if
c
c  Initialize.
c
      do row = 1, m

        i = 0
        indx = 0
        isgn = 0
        j = 0
c
c  Call the external heap sorter.
c
10      continue

          call sort_heap_external ( n, indx, i, j, isgn )
c
c  Interchange the I and J objects.
c
          if ( 0 .lt. indx ) then

            t        = a(row,i)
            a(row,i) = a(row,j)
            a(row,j) = t
c
c  Compare the I and J objects.
c
          else if ( indx .lt. 0 ) then

            if ( a(row,i) .lt. a(row,j) ) then
              isgn = +1
            else
              isgn = -1
            end if

          else if ( indx .eq. 0 ) then

            go to 20

          end if

        go to 10

20      continue

      end do

      return
      end
      subroutine i4row_sorted_unique ( m, n, a, unique_num )

c*********************************************************************72
c
cc I4ROW_SORTED_UNIQUE keeps unique elements in an I4ROW.
c
c  Discussion:
c
c    An I4ROW is an M by N array of I4 values, regarded
c    as an array of M rows of length N.
c
c    The rows of the array may be ascending or descending sorted.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    27 May 2011
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer M, N, the number of rows and columns.
c
c    Input/output, integer A(M,N), a sorted array, containing
c    M rows of data.  On output, the first UNIQUE_NUM rows
c    contain the unique rows.
c
c    Output, integer UNIQUE_NUM, the number of unique rows.
c
      implicit none

      integer m
      integer n

      integer a(m,n)
      logical equal
      integer i1
      integer i2
      integer j
      integer unique_num

      if ( n .le. 0 ) then
        unique_num = 0
        return
      end if

      i1 = 1

      do i2 = 2, m

        equal = .true.

        do j = 1, n
          if ( a(i1,j) .ne. a(i2,j) ) then
            equal = .false.
            go to 10
          end if
        end do

10      continue

        if ( .not. equal ) then
          i1 = i1 + 1
          do j = 1, n
            a(i1,j) = a(i2,j)
          end do
        end if

      end do

      unique_num = i1

      return
      end
      subroutine i4row_sorted_unique_count ( m, n, a, unique_num )

c*********************************************************************72
c
cc I4ROW_SORTED_UNIQUE_COUNT counts unique elements in an I4ROW.
c
c  Discussion:
c
c    An I4ROW is an M by N array of I4 values, regarded
c    as an array of M rows of length N.
c
c    The rows of the array may be ascending or descending sorted.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    27 May 2011
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer M, N, the number of rows and columns.
c
c    Input, integer A(M,N), a sorted array, containing
c    M rows of data.
c
c    Output, integer UNIQUE_NUM, the number of unique rows.
c
      implicit none

      integer m
      integer n

      integer a(m,n)
      logical equal
      integer i1
      integer i2
      integer j
      integer unique_num

      if ( n .le. 0 ) then
        unique_num = 0
        return
      end if

      unique_num = 1
      i1 = 1

      do i2 = 2, m

        equal = .true.

        do j = 1, n
          if ( a(i1,j) .ne. a(i2,j) ) then
            equal = .false.
            go to 10
          end if
        end do

10      continue

        if ( .not. equal ) then
          unique_num = unique_num + 1
          i1 = i2
        end if

      end do

      return
      end
      subroutine i4row_sum ( m, n, a, rsum )

c*********************************************************************72
c
cc I4ROW_SUM returns the sums of the rows of an I4ROW.
c
c  Discussion:
c
c    An I4ROW is an M by N array of I4's, regarded
c    as an array of M rows of length N.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    26 October 2014
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer M, N, the number of rows and columns.
c
c    Input, integer A(M,N), an array of data.
c
c    Output, integer RSUM(M), the sum of the entries of each row.
c
      implicit none

      integer m
      integer n

      integer a(m,n)
      integer i
      integer j
      integer rsum(m)

      do i = 1, m
        rsum(i) = 0
        do j = 1, n
          rsum(i) = rsum(i) + a(i,j)
        end do
      end do

      return
      end
      subroutine i4row_swap ( m, n, a, i1, i2 )

c*********************************************************************72
c
cc I4ROW_SWAP swaps two rows of an I4ROW.
c
c  Discussion:
c
c    An I4ROW is an M by N array of integer values, regarded
c    as an array of M rows of length N.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    01 June 2009
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer M, N, the number of rows and columns.
c
c    Input/output, integer A(M,N), an array of data.
c
c    Input, integer I1, I2, the two rows to swap.
c
      implicit none

      integer m
      integer n

      integer a(m,n)
      integer i1
      integer i2
      integer row(n)
c
c  Check.
c
      if ( i1 .lt. 1 .or. m .lt. i1 ) then
        write ( *, '(a)' ) ' '
        write ( *, '(a)' ) 'IROW_SWAP - Fatal error!'
        write ( *, '(a)' ) '  I1 is out of range.'
        stop 1
      end if

      if ( i2 .lt. 1 .or. m .lt. i2 ) then
        write ( *, '(a)' ) ' '
        write ( *, '(a)' ) 'IROW_SWAP - Fatal error!'
        write ( *, '(a)' ) '  I2 is out of range.'
        stop 1
      end if

      if ( i1 .eq. i2 ) then
        return
      end if

      row(1:n)  = a(i1,1:n)
      a(i1,1:n) = a(i2,1:n)
      a(i2,1:n) = row(1:n)

      return
      end
      subroutine i4row_variance ( m, n, a, variance )

c*********************************************************************72
c
cc I4ROW_VARIANCE returns the variances of an I4ROW.
c
c  Discussion:
c
c    An I4ROW is an M by N array of I4 values, regarded
c    as an array of M rows of length N.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    12 January 2010
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer M, N, the number of rows and columns.
c
c    Input, integer A(M,N), the array of data.
c
c    Output, double precision VARIANCE(M), the variance of each row.
c
      implicit none

      integer m
      integer n

      integer a(m,n)
      integer i
      integer j
      double precision mean
      double precision variance(m)

      if ( n .lt. 2 ) then

        do i = 1, m
          variance(i) = 0.0D+00
        end do

      else

        do i = 1, m

          mean = 0.0D+00
          do j = 1, n
            mean = mean + dble ( a(i,j) )
          end do
          mean = mean / dble ( n )

          variance(i) = 0.0D+00
          do j = 1, n
            variance(i) = variance(i) + ( dble ( a(i,j) ) - mean ) ** 2
          end do

          variance(i) = variance(i) / dble ( n - 1 )

        end do

      end if

      return
      end
      subroutine i4vec_add ( n, a, b, c )

c*********************************************************************72
c
cc I4VEC_ADD computes C = A + B for I4VEC's.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    28 April 2010
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the number of entries.
c
c    Input, integer A(N), the first vector.
c
c    Input, integer B(N), the second vector.
c
c    Output, integer C(N), the sum of the vectors.
c
      implicit none

      integer n

      integer a(n)
      integer b(n)
      integer c(n)
      integer i

      do i = 1, n
        c(i) = a(i) + b(i)
      end do

      return
      end
      function i4vec_all_nonpositive ( n, a )

c*********************************************************************72
c
cc I4VEC_ALL_NONPOSITIVE: ( all ( A <= 0 ) ) for I4VEC's.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    08 October 2011
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the number of entries.
c
c    Input, integer A(N), the vector.
c
c    Output, logical I4VEC_ALL_NONPOSITIVE is TRUE if all entries
c    of A are less than or equal to 0.
c
      implicit none

      integer n

      integer a(n)
      integer i
      logical i4vec_all_nonpositive

      do i = 1, n
        if ( 0 .lt. a(i) ) then
          i4vec_all_nonpositive = .false.
          return
        end if
      end do

      i4vec_all_nonpositive = .true.

      return
      end
      subroutine i4vec_amax ( n, a, aamax )

c*********************************************************************72
c
cc I4VEC_AMAX returns the largest magnitude in an I4VEC.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    01 August 2008
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the number of entries in the vector.
c
c    Input, integer A(N), the vector to be searched.
c
c    Output, integer AAMAX, the value of the entry of
c    largest magnitude.
c
      implicit none

      integer n

      integer a(n)
      integer aamax
      integer i

      if ( n .le. 0 ) then

        aamax = 0

      else

        aamax = abs ( a(1) )

        do i = 2, n
          aamax = max ( aamax, abs ( a(i) ) )
        end do

      end if

      return
      end
      subroutine i4vec_amax_index ( n, a, amax_index )

c*********************************************************************72
c
cc I4VEC_AMAX_INDEX returns the index of the largest magnitude in an I4VEC.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    28 August 2008
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the number of entries in the vector.
c
c    Input, integer A(N), the vector to be searched.
c
c    Output, integer AMAX_INDEX, the index of the entry
c    of largest magnitude.
c
      implicit none

      integer n

      integer a(n)
      integer aamax
      integer i
      integer amax_index

      if ( n .le. 0 ) then

        amax_index = 0

      else

        aamax = abs ( a(1) )
        amax_index = 1

        do i = 2, n

          if ( aamax .lt. abs ( a(i) ) ) then
            aamax = abs ( a(i) )
            amax_index = i
          end if

        end do

      end if

      return
      end
      subroutine i4vec_amin ( n, a, aamin )

c*********************************************************************72
c
cc I4VEC_AMIN returns the smallest magnitude in an I4VEC.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    28 August 2008
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the number of entries to be checked.
c
c    Input, integer A(N), the vector to be checked.
c
c    Output, integer AAMIN, the value of the smallest magnitude.
c
      implicit none

      integer n

      integer a(n)
      integer aamin
      integer i

      if ( n .le. 0 ) then

        aamin = 0

      else

        aamin = abs ( a(1) )

        do i = 2, n
          aamin = min ( aamin, abs ( a(i) ) )
        end do

      end if

      return
      end
      subroutine i4vec_amin_index ( n, a, amin_index )

c*********************************************************************72
c
cc I4VEC_AMIN_INDEX returns the index of the smallest magnitude in an I4VEC.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    28 August 2008
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the number of entries to be checked.
c
c    Input, integer A(N), the vector to be checked.
c
c    Output, integer AMIN_INDEX, the entry of the smallest
c    magnitude.
c
      implicit none

      integer n

      integer a(n)
      integer aamin
      integer i
      integer amin_index

      if ( n .le. 0 ) then

        amin_index = 0

      else

        aamin = a(1)
        amin_index = 1

        do i = 2, n

          if ( abs ( a(i) ) .lt. aamin ) then
            aamin = abs ( a(i) )
            amin_index = i
          end if

        end do

      end if

      return
      end
      subroutine i4vec_aminz ( n, a, aminz )

c*********************************************************************72
c
cc I4VEC_AMINZ returns the smallest nonzero magnitude in an I4VEC.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    28 August 2008
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the number of entries to be checked.
c
c    Input, integer A(N), the vector to be checked.
c
c    Output, integer AMINZ, the value of the smallest nonzero
c    magnitude.  If all entries are zero, AMINZ is 0.
c
      implicit none

      integer n

      integer a(n)
      integer aminz
      integer i
      integer iset

      aminz = 0
      iset = 0

      do i = 1, n

        if ( a(i) .ne. 0 ) then

          if ( iset .eq. 0 ) then
            aminz = abs ( a(i) )
            iset = 1
          else
            aminz = min ( aminz, abs ( a(i) ) )
          end if

        end if

      end do

      return
      end
      subroutine i4vec_aminz_index ( n, a, aminz_index )

c*********************************************************************72
c
cc I4VEC_AMINZ_INDEX returns the smallest nonzero magnitude in an I4VEC.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    28 August 2008
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the number of entries to be checked.
c
c    Input, integer A(N), the vector to be checked.
c
c    Output, integer AMINZ_INDEX, the entry of the smallest
c    nonzero magnitude.  If all entries are zero, AMINZ_INDEX is 0.
c
      implicit none

      integer n

      integer a(n)
      integer aminz
      integer i
      integer aminz_index

      aminz = 0
      aminz_index = 0

      do i = 1, n

        if ( a(i) .ne. 0 ) then

          if ( aminz_index .eq. 0 .or. abs ( a(i) ) .lt. aminz ) then
            aminz = abs ( a(i) )
            aminz_index = i
          end if

        end if

      end do

      return
      end
      function i4vec_any_lt ( n, a, b )

c*********************************************************************72
c
cc I4VEC_ANY_LT: ( any ( A < B ) ) for I4VEC's.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    28 April 2010
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the number of entries.
c
c    Input, integer A(N), the first vector.
c
c    Input, integer B(N), the second vector.
c
c    Output, logical I4VEC_ANY_LT is TRUE if any entry
c    of A is less than the corresponding entry of B.
c
      implicit none

      integer n

      integer a(n)
      integer b(n)
      integer i
      logical i4vec_any_lt

      do i = 1, n
        if ( a(i) .lt. b(i) ) then
          i4vec_any_lt = .true.
          return
        end if
      end do

      i4vec_any_lt = .false.

      return
      end
      function i4vec_any_negative ( n, a )

c*********************************************************************72
c
cc I4VEC_ANY_NEGATIVE: ( any A < 0 ) for I4VEC's.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    08 October 2011
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the number of entries.
c
c    Input, integer A(N), the vector.
c
c    Output, logical I4VEC_ANY_NEGATIVE is TRUE if any entry is negative.
c
      implicit none

      integer n

      integer a(n)
      integer i
      logical i4vec_any_negative

      do i = 1, n
        if ( a(i) .lt. 0 ) then
          i4vec_any_negative = .true.
          return
        end if
      end do

      i4vec_any_negative = .false.

      return
      end
      function i4vec_any_nonzero ( n, a )

c*********************************************************************72
c
cc I4VEC_ANY_NONZERO: ( any A nonzero ) for I4VEC's.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    25 December 2011
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the number of entries.
c
c    Input, integer A(N), the vector.
c
c    Output, logical I4VEC_ANY_NONZERO is TRUE if any entry is nonzero.
c
      implicit none

      integer n

      integer a(n)
      integer i
      logical i4vec_any_nonzero

      do i = 1, n
        if ( a(i) .ne. 0 ) then
          i4vec_any_nonzero = .true.
          return
        end if
      end do

      i4vec_any_nonzero = .false.

      return
      end
      subroutine i4vec_ascend_sub ( n, a, length, sub )

c*********************************************************************72
c
cc I4VEC_ASCEND_SUB computes the longest ascending subsequence of an I4VEC.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c    The subsequence is required to be strictly increasing.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    04 July 2009
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the length of the vector.
c
c    Input, integer A(N), the vector to be examined.
c
c    Output, integer LENGTH, the length of the longest
c    increasing subsequence.
c
c    Output, integer SUB(N), contains in entries 1 through LENGTH
c    a longest increasing subsequence of A.
c
      implicit none

      integer n

      integer a(n)
      integer i
      integer j
      integer k
      integer length
      integer sub(n)
      integer top(n)
      integer top_prev(n)

      do i = 1, n
        top(i) = 0
        top_prev(i) = 0
        sub(i) = 0
      end do

      if ( n .le. 0 ) then
        length = 0
        return
      end if

      length = 0

      do i = 1, n

        k = -1

        do j = 1, length
          if ( a(i) .le. a(top(j)) ) then
            k = j
            go to 10
          end if
        end do

10      continue

        if ( k .eq. -1 ) then
          length = length + 1
          k = length
        end if

        top(k) = i

        if ( 1 .lt. k ) then
          top_prev(i) = top(k-1)
        else
          top_prev(i) = 0
        end if

      end do
c
c  Extract the subsequence.
c
      j = top(length)
      sub(length) = a(j)

      do i = length - 1, 1, -1
        j = top_prev(j)
        sub(i) = a(j)
      end do

      return
      end
      function i4vec_ascends ( n, x )

c*********************************************************************72
c
cc I4VEC_ASCENDS determines if an I4VEC is (weakly) ascending.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c  Example:
c
c    X = ( -8, 1, 2, 3, 7, 7, 9 )
c
c    I4VEC_ASCENDS = TRUE
c
c    The sequence is not required to be strictly ascending.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    07 January 2007
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the size of the array.
c
c    Input, integer X(N), the array to be examined.
c
c    Output, logical I4VEC_ASCENDS, is TRUE if the entries of X ascend.
c
      implicit none

      integer n

      integer i
      logical i4vec_ascends
      integer x(n)

      i4vec_ascends = .false.

      do i = 1, n - 1
        if ( x(i+1) .lt. x(i) ) then
          return
        end if
      end do

      i4vec_ascends = .true.

      return
      end
      subroutine i4vec_axpy ( n, ia, x, incx, y, incy )

c*********************************************************************72
c
cc I4VEC_AXPY:  Y(I) := Y(I) + A * X(I).
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c    If X and Y are simple vectors, then IAXPY is equivalent to:
c
c      DO I = 1, N
c        Y(I) = Y(I) + IA * X(I)
c      END DO
c
c    However, by using the increments correctly, IAXPY can also be used
c    to manipulate rows or columns of matrices.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    05 July 2009
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the number of entries of X and Y.
c
c    Input, integer IA, the scalar value by which each entry
c    of X is multiplied before being added to Y.
c
c    Input, integer X(*), the vector, a multiple of which is to be
c    added to Y.
c
c    Input, integer INCX, the increment between successive
c    entries of X.
c
c    Input/output, integer Y(*).
c    On output, each entry of Y has been increased by
c    IA times the corresponding entry of X.
c
c    Input, integer INCY, the increment between successive
c    entries of Y.
c
      implicit none

      integer i
      integer ia
      integer incx
      integer incy
      integer indx
      integer indy
      integer n
      integer x(*)
      integer y(*)

      indx = 1
      indy = 1

      do i = 1, n

        y(indy) = y(indy) + ia * x(indx)

        indx = indx + incx
        indy = indy + incy

      end do

      return
      end
      subroutine i4vec_bracket ( n, a, xval, left, right )

c*********************************************************************72
c
cc I4VEC_BRACKET searches a sorted I4VEC for successive brackets of a value.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c    If the values in the vector are thought of as defining intervals
c    on the number line, then this routine searches for the interval
c    containing the given value.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    05 July 2009
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, length of input array.
c
c    Input, integer A(N), an array that has been sorted
c    into ascending order.
c
c    Input, integer XVAL, a value to be bracketed.
c
c    Output, integer LEFT, RIGHT, the results of the search.
c    In the most common case, 1 <= LEFT .lt. LEFT + 1 = RIGHT <= N,
c    and A(LEFT) <= XVAL <= A(RIGHT).
c
c    Special cases:
c      Value is less than all data values:
c        LEFT = -1, RIGHT = 1, and XVAL .lt. A(RIGHT).
c      Value is greater than all data values:
c        LEFT = N, RIGHT = -1, and A(LEFT) .lt. XVAL.
c      Value is equal to a data value:
c        LEFT = RIGHT, and A(LEFT) = A(RIGHT) = XVAL.
c
      implicit none

      integer n

      integer a(n)
      integer high
      integer left
      integer low
      integer mid
      integer right
      integer xval
c
c  XVAL .lt. A(1).
c
      if ( xval .lt. a(1) ) then
        left = -1
        right = 1
c
c  A(N) .lt. XVAL.
c
      else if ( a(n) .lt. xval ) then
        left = n
        right = -1
c
c  N = 1
c
      else if ( n .eq. 1 ) then
        left = 1
        right = 1
c
c  A(1) <= XVAL <= A(N).
c
      else

        low = 1
        high = n - 1

10      continue

          mid = ( low + high ) / 2

          if ( high .lt. low ) then
            write ( *, '(a)' ) ' '
            write ( *, '(a)' ) 'I4VEC_BRACKET - Fatal error!'
            write ( *, '(a)' ) '  Algorithm or data failure.'
            stop 1
          end if

          if ( a(mid) .eq. xval ) then
            left = mid
            right = mid
            go to 20
          else if ( a(mid+1) .eq. xval ) then
            left = mid + 1
            right = mid + 1
            go to 20
          else if ( a(mid) .lt. xval .and. xval .lt. a(mid+1) ) then
            left = mid
            right = mid + 1
            go to 20
          else if ( a(mid+1) .lt. xval ) then
            low = mid + 1
          else if ( xval .lt. a(mid) ) then
            high = mid - 1
          end if

        go to 10

20      continue

      end if

      return
      end
      subroutine i4vec_compare ( n, a1, a2, isgn )

c*********************************************************************72
c
cc I4VEC_COMPARE compares two I4VEC's.
c
c  Discussion:
c
c    An I4VEC is a vector of I4 values.
c
c    The lexicographic ordering is used.
c
c  Example:
c
c    Input:
c
c      A1 = ( 2, 6, 2 )
c      A2 = ( 2, 8, 12 )
c
c    Output:
c
c      ISGN = -1
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    01 August 2008
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the number of entries in the vectors.
c
c    Input, integer A1(N), A2(N), the vectors to be compared.
c
c    Output, integer ISGN, the results of the comparison:
c    -1, A1 < A2,
c     0, A1 = A2,
c    +1, A2 < A1.
c
      implicit none

      integer n

      integer a1(n)
      integer a2(n)
      integer isgn
      integer k

      isgn = 0

      k = 1

10    continue

      if ( k .le. n ) then

        if ( a1(k) .lt. a2(k) ) then
          isgn = -1
          return
        else if ( a2(k) .lt. a1(k) ) then
          isgn = + 1
          return
        end if

        k = k + 1

        go to 10

      end if

      return
      end
      subroutine i4vec_concatenate ( n1, a, n2, b, c )

c*********************************************************************72
c
cc I4VEC_CONCATENATE concatenates two I4VEC's.
c
c  Discussion:
c
c    An I4VEC is a vector of I4 values.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    22 November 2013
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N1, the number of entries in the first vector.
c
c    Input, integer A(N1), the first vector.
c
c    Input, integer N2, the number of entries in the second vector.
c
c    Input, integer B(N2), the second vector.
c
c    Output, integer C(N1+N2), the concatenation of A and B.
c
      implicit none

      integer n1
      integer n2

      integer a(n1)
      integer b(n2)
      integer c(n1+n2)
      integer i

      do i = 1, n1
        c(i) = a(i)
      end do

      do i = 1, n2
        c(n1+i) = b(i)
      end do

      return
      end
      subroutine i4vec_copy ( n, a1, a2 )

c*********************************************************************72
c
cc I4VEC_COPY copies an I4VEC.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    02 January 2007
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the length of the vectors.
c
c    Input, integer A1(N), the vector to be copied.
c
c    Output, integer A2(N), a copy of A1.
c
      implicit none

      integer n

      integer a1(n)
      integer a2(n)
      integer i

      do i = 1, n
        a2(i) = a1(i)
      end do

      return
      end
      subroutine i4vec_cum ( n, a, a_cum )

c*********************************************************************72
c
cc I4VEC_CUM computes the cumulative sum of the entries of an I4VEC.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c  Example:
c
c    Input:
c
c      A = (/ 1, 2, 3, 4 /)
c
c    Output:
c
c      A_CUM = (/ 1, 3, 6, 10 /)
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    25 June 2011
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the number of entries in the vector.
c
c    Input, integer A(N), the vector to be summed.
c
c    Output, integer A_CUM(N), the cumulative sum of the
c    entries of A.
c
      implicit none

      integer n

      integer a(n)
      integer a_cum(n)
      integer i

      a_cum(1) = a(1)

      do i = 2, n
        a_cum(i) = a_cum(i-1) + a(i)
      end do

      return
      end
      subroutine i4vec_cum0 ( n, a, a_cum )

c*********************************************************************72
c
cc I4VEC_CUM0 computes the cumulative sum of the entries of an I4VEC.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c    This routine returns a vector of length N+1, with the first value
c    being 0.
c
c  Example:
c
c    Input:
c
c      A = (/ 1, 2, 3, 4 /)
c
c    Output:
c
c      A_CUM = (/ 0, 1, 3, 6, 10 /)
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    22 December 2010
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the number of entries in the vector.
c
c    Input, integer A(N), the vector to be summed.
c
c    Output, integer A_CUM(0:N), the cumulative sum of the
c    entries of A.
c
      implicit none

      integer n

      integer a(n)
      integer a_cum(0:n)
      integer i

      a_cum(0) = 0

      do i = 1, n
        a_cum(i) = a_cum(i-1) + a(i)
      end do

      return
      end
      subroutine i4vec_decrement ( n, x )

c*********************************************************************72
c
cc I4VEC_DECREMENT decrements an I4VEC.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    18 July 2014
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the size of the array.
c
c    Input/output, integer X(N), the array to be decremented.
c
      implicit none

      integer n

      integer i
      integer x(n)

      do i = 1, n
        x(i) = x(i) - 1
      end do

      return
      end
      function i4vec_descends ( n, x )

c*********************************************************************72
c
cc I4VEC_DESCENDS determines if an I4VEC is decreasing.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c  Example:
c
c    X = ( 9, 7, 7, 3, 2, 1, -8 )
c
c    I4VEC_DESCENDS = TRUE
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    05 July 2009
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the size of the array.
c
c    Input, integer X(N), the array to be examined.
c
c    Output, logical I4VEC_DESCENDS, is TRUE if the entries of X descend.
c
      implicit none

      integer n

      integer i
      logical i4vec_descends
      integer x(n)

      i4vec_descends = .false.

      do i = 1, n - 1
        if ( x(i) .lt. x(i+1) ) then
          return
        end if
      end do

      i4vec_descends = .true.

      return
      end
      subroutine i4vec_direct_product ( factor_index, factor_order,
     &  factor_value, factor_num, point_num, x )

c*********************************************************************72
c
cc I4VEC_DIRECT_PRODUCT creates a direct product of I4VEC's.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c    To explain what is going on here, suppose we had to construct
c    a multidimensional quadrature rule as the product of K rules
c    for 1D quadrature.
c
c    The product rule will be represented as a list of points and weights.
c
c    The J-th item in the product rule will be associated with
c      item J1 of 1D rule 1,
c      item J2 of 1D rule 2,
c      ...,
c      item JK of 1D rule K.
c
c    In particular,
c      X(J) = ( X(1,J1), X(2,J2), ..., X(K,JK))
c    and
c      W(J) = W(1,J1) * W(2,J2) * ... * W(K,JK)
c
c    So we can construct the quadrature rule if we can properly
c    distribute the information in the 1D quadrature rules.
c
c    This routine carries out that task for the abscissas X.
c
c    Another way to do this would be to compute, one by one, the
c    set of all possible indices (J1,J2,...,JK), and then index
c    the appropriate information.  An advantage of the method shown
c    here is that you can process the K-th set of information and
c    then discard it.
c
c  Example:
c
c    Rule 1:
c      Order = 4
c      X(1:4) = ( 1, 2, 3, 4 )
c
c    Rule 2:
c      Order = 3
c      X(1:3) = ( 10, 20, 30 )
c
c    Rule 3:
c      Order = 2
c      X(1:2) = ( 100, 200 )
c
c    Product Rule:
c      Order = 24
c      X(1:24) =
c        ( 1, 10, 100 )
c        ( 2, 10, 100 )
c        ( 3, 10, 100 )
c        ( 4, 10, 100 )
c        ( 1, 20, 100 )
c        ( 2, 20, 100 )
c        ( 3, 20, 100 )
c        ( 4, 20, 100 )
c        ( 1, 30, 100 )
c        ( 2, 30, 100 )
c        ( 3, 30, 100 )
c        ( 4, 30, 100 )
c        ( 1, 10, 200 )
c        ( 2, 10, 200 )
c        ( 3, 10, 200 )
c        ( 4, 10, 200 )
c        ( 1, 20, 200 )
c        ( 2, 20, 200 )
c        ( 3, 20, 200 )
c        ( 4, 20, 200 )
c        ( 1, 30, 200 )
c        ( 2, 30, 200 )
c        ( 3, 30, 200 )
c        ( 4, 30, 200 )
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    02 June 2010
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer FACTOR_INDEX, the index of the factor being
c    processed.  The first factor processed must be factor 1c
c
c    Input, integer FACTOR_ORDER, the order of the factor.
c
c    Input, integer FACTOR_VALUE(FACTOR_ORDER), the factor values
c    for factor FACTOR_INDEX.
c
c    Input, integer FACTOR_NUM, the number of factors.
c
c    Input, integer POINT_NUM, the number of elements in the
c    direct product.
c
c    Input/output, integer X(FACTOR_NUM,POINT_NUM), the elements of the
c    direct product, which are built up gradually.
c
c  Local Parameters:
c
c    Local, integer START, the first location of a block of
c    values to set.
c
c    Local, integer CONTIG, the number of consecutive values
c    to set.
c
c    Local, integer SKIP, the distance from the current value
c    of START to the next location of a block of values to set.
c
c    Local, integer REP, the number of blocks of values to set.
c
      implicit none

      integer factor_num
      integer factor_order
      integer point_num

      integer contig
      integer factor_index
      integer factor_value(factor_order)
      integer i
      integer j
      integer k
      integer rep
      integer skip
      integer start
      integer x(factor_num,point_num)

      save contig
      save rep
      save skip

      data contig / -1 /
      data rep / -1 /
      data skip / -1 /

      if ( factor_index .eq. 1 ) then
        contig = 1
        skip = 1
        rep = point_num
        do j = 1, point_num
          do i = 1, factor_num
            x(i,j) = 0
          end do
        end do
      end if

      rep = rep / factor_order
      skip = skip * factor_order

      do j = 1, factor_order

        start = 1 + ( j - 1 ) * contig

        do k = 1, rep
          do i = start, start + contig - 1
            x(factor_index,i) = factor_value(j)
          end do
          start = start + skip
        end do

      end do

      contig = contig * factor_order

      return
      end
      subroutine i4vec_direct_product2 ( factor_index, factor_order,
     &  factor_value, factor_num, point_num, w )

c*********************************************************************72
c
cc I4VEC_DIRECT_PRODUCT2 creates a direct product of I4VEC's.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c    To explain what is going on here, suppose we had to construct
c    a multidimensional quadrature rule as the product of K rules
c    for 1D quadrature.
c
c    The product rule will be represented as a list of points and weights.
c
c    The J-th item in the product rule will be associated with
c      item J1 of 1D rule 1,
c      item J2 of 1D rule 2,
c      ...,
c      item JK of 1D rule K.
c
c    In particular,
c      X(J) = ( X(1,J1), X(2,J2), ..., X(K,JK))
c    and
c      W(J) = W(1,J1) * W(2,J2) * ... * W(K,JK)
c
c    So we can construct the quadrature rule if we can properly
c    distribute the information in the 1D quadrature rules.
c
c    This routine carries out the task involving the weights W.
c
c    Another way to do this would be to compute, one by one, the
c    set of all possible indices (J1,J2,...,JK), and then index
c    the appropriate information.  An advantage of the method shown
c    here is that you can process the K-th set of information and
c    then discard it.
c
c  Example:
c
c    Rule 1:
c      Order = 4
c      W(1:4) = ( 2, 3, 5, 7 )
c
c    Rule 2:
c      Order = 3
c      W(1:3) = ( 11, 13, 17 )
c
c    Rule 3:
c      Order = 2
c      W(1:2) = ( 19, 23 )
c
c    Product Rule:
c      Order = 24
c      W(1:24) =
c        ( 2 * 11 * 19 )
c        ( 3 * 11 * 19 )
c        ( 4 * 11 * 19 )
c        ( 7 * 11 * 19 )
c        ( 2 * 13 * 19 )
c        ( 3 * 13 * 19 )
c        ( 5 * 13 * 19 )
c        ( 7 * 13 * 19 )
c        ( 2 * 17 * 19 )
c        ( 3 * 17 * 19 )
c        ( 5 * 17 * 19 )
c        ( 7 * 17 * 19 )
c        ( 2 * 11 * 23 )
c        ( 3 * 11 * 23 )
c        ( 5 * 11 * 23 )
c        ( 7 * 11 * 23 )
c        ( 2 * 13 * 23 )
c        ( 3 * 13 * 23 )
c        ( 5 * 13 * 23 )
c        ( 7 * 13 * 23 )
c        ( 2 * 17 * 23 )
c        ( 3 * 17 * 23 )
c        ( 5 * 17 * 23 )
c        ( 7 * 17 * 23 )
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    02 June 2010
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer FACTOR_INDEX, the index of the factor being
c    processed.  The first factor processed must be factor 1c
c
c    Input, integer FACTOR_ORDER, the order of the factor.
c
c    Input, integer FACTOR_VALUE(FACTOR_ORDER), the factor values
c    for factor FACTOR_INDEX.
c
c    Input, integer FACTOR_NUM, the number of factors.
c
c    Input, integer POINT_NUM, the number of elements in the
c    direct product.
c
c    Input/output, integer W(POINT_NUM), the elements of the
c    direct product, which are built up gradually.
c
c  Local Parameters:
c
c    Local, integer START, the first location of a block of
c    values to set.
c
c    Local, integer CONTIG, the number of consecutive values to
c    set.
c
c    Local, integer SKIP, the distance from the current value
c    of START to the next location of a block of values to set.
c
c    Local, integer REP, the number of blocks of values to set.
c
      implicit none

      integer factor_num
      integer factor_order
      integer point_num

      integer contig
      integer factor_index
      integer factor_value(factor_order)
      integer i
      integer j
      integer k
      integer rep
      integer skip
      integer start
      integer w(point_num)

      save contig
      save rep
      save skip

      data contig / -1 /
      data rep / -1 /
      data skip / -1 /

      if ( factor_index .eq. 1 ) then
        contig = 1
        skip = 1
        rep = point_num
        do i = 1, point_num
          w(i) = 1
        end do
      end if

      rep = rep / factor_order
      skip = skip * factor_order

      do j = 1, factor_order

        start = 1 + ( j - 1 ) * contig

        do k = 1, rep
          do i = start, start + contig - 1
            w(i) = w(i) * factor_value(j)
          end do
          start = start + skip
        end do

      end do

      contig = contig * factor_order

      return
      end
      function i4vec_dot_product ( n, x, y )

c*********************************************************************72
c
cc I4VEC_DOT_PRODUCT computes the dot product of two I4VEC's.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    19 December 2011
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the size of the array.
c
c    Input, integer X(N), Y(N), the arrays.
c
c    Output, integer I4VEC_DOT_PRODUCT, the dot product of X and Y.
c
      implicit none

      integer n

      integer i
      integer i4vec_dot_product
      integer value
      integer x(n)
      integer y(n)

      value = 0
      do i = 1, n
        value = value + x(i) * y(i)
      end do

      i4vec_dot_product = value

      return
      end
      function i4vec_eq ( n, a1, a2 )

c*********************************************************************72
c
cc I4VEC_EQ is true if every pair of entries in two I4VECs is equal.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    13 May 2012
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the number of entries in the vectors.
c
c    Input, integer A1(N), A2(N), two vectors to compare.
c
c    Output, logical I4VEC_EQ.
c    I4VEC_EQ is TRUE if every pair of elements A1(I) and A2(I) are equal,
c    and FALSE otherwise.
c
      implicit none

      integer n

      integer a1(n)
      integer a2(n)
      integer i
      logical i4vec_eq

      i4vec_eq = .false.

      do i = 1, n
        if ( a1(i) .ne. a2(i) ) then
          return
        end if
      end do

      i4vec_eq = .true.

      return
      end
      function i4vec_even_all ( n, a )

c*********************************************************************72
c
cc I4VEC_EVEN_ALL is TRUE if all entries of an I4VEC are even.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    05 July 2009
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the number of entries in the vector.
c
c    Input, integer A(N), the vector.
c
c    Output, logical I4VEC_EVEN_ALL, TRUE if all entries are even.
c
      implicit none

      integer n

      integer a(n)
      integer i
      logical i4vec_even_all

      do i = 1, n
        if ( mod ( a(i), 2 ) .ne. 0 ) then
          i4vec_even_all = .false.
          return
        end if
      end do

      i4vec_even_all = .true.

      return
      end
      function i4vec_even_any ( n, a )

c*********************************************************************72
c
cc I4VEC_EVEN_ANY is TRUE if any entry of an I4VEC is even.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    05 July 2009
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the number of entries in the vector.
c
c    Input, integer A(N), the vector.
c
c    Output, logical I4VEC_EVEN_ANY, TRUE if any entry is even.
c
      implicit none

      integer n

      integer a(n)
      integer i
      logical i4vec_even_any

      do i = 1, n
        if ( mod ( a(i), 2 ) .eq. 0 ) then
          i4vec_even_any = .true.
          return
        end if
      end do

      i4vec_even_any = .false.

      return
      end
      subroutine i4vec_find ( n, a, value, location )

!*********************************************************************72
!
!! I4VEC_FIND finds the first occurrence of a value in an I4VEC.
!
!  Discussion:
!
!    An I4VEC is a vector of I4's.
!
!  Licensing:
!
!    This code is distributed under the GNU LGPL license.
!
!  Modified:
!
!    30 August 2011
!
!  Author:
!
!    John Burkardt
!
!  Parameters:
!
!    Input, integer N, the number of elements of A.
!
!    Input, integer A(N), the array.
!
!    Input, integer VALUE, the value being sought.
!
!    Output, integer LOCATION, the first location in A where VALUE occurs,
!    or -1 if VALUE never occurs.
!
      implicit none

      integer n

      integer a(n)
      integer i
      integer location
      integer value

      location = -1

      do i = 1, n

        if ( a(i) .eq. value ) then
          location = i
          return
        end if

      end do

      return
      end
      subroutine i4vec_first_index ( n, a, first_index )

c*********************************************************************72
c
cc I4VEC_FIRST_INDEX indexes the first occurrence of values in an I4VEC.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c    For element A(I) of the vector, FIRST_INDEX(I) is the index in A of
c    the first occurrence of the value A(I).
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    28 August 2008
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the number of elements of A.
c
c    Input, integer A(N), the array.
c
c    Output, integer FIRST_INDEX(N), the first occurrence index.
c
      implicit none

      integer n

      integer a(n)
      integer first_index(n)
      integer i
      integer j

      do i = 1, n
        first_index(i) = -1
      end do

      do i = 1, n

        if ( first_index(i) .eq. -1 ) then

          first_index(i) = i

          do j = i + 1, n
            if ( a(i) .eq. a(j) ) then
             first_index(j) = i
            end if
          end do

        end if

      end do

      return
      end
      subroutine i4vec_frac ( n, a, k, frac )

c*********************************************************************72
c
cc I4VEC_FRAC searches for the K-th smallest element in an I4VEC.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c    Hoare's algorithm is used.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    18 July 2010
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the number of elements of A.
c
c    Input/output, integer A(N), array to search.  On output,
c    the elements of A have been somewhat rearranged.
c
c    Input, integer K, the fractile to be sought.  If K = 1, the
c    minimum entry is sought.  If K = N, the maximum is sought.
c    Other values of K search for the entry which is K-th in size.
c    K must be at least 1, and no greater than N.
c
c    Output, integer FRAC, the value of the K-th fractile of A.
c
      implicit none

      integer n

      integer a(n)
      integer frac
      integer i
      integer iryt
      integer ix
      integer j
      integer k
      integer left
      integer t

      if ( n .le. 0 ) then
        write ( *, '(a)' ) ' '
        write ( *, '(a)' ) 'I4VEC_FRAC  - Fatal error!'
        write ( *, '(a,i8)' ) '  Illegal nonpositive value of N = ', n
        stop 1
      end if

      if ( k .le. 0 ) then
        write ( *, '(a)' ) ' '
        write ( *, '(a)' ) 'I4VEC_FRAC  - Fatal error!'
        write ( *, '(a,i8)' ) '  Illegal nonpositive value of K = ', k
        stop 1
      end if

      if ( n .lt. k ) then
        write ( *, '(a)' ) ' '
        write ( *, '(a)' ) 'I4VEC_FRAC  - Fatal error!'
        write ( *, '(a,i8)' ) '  Illegal N < K, K = ', k
        stop 1
      end if

      left = 1
      iryt = n

10    continue

        if ( iryt .le. left ) then
          frac = a(k)
          go to 60
        end if

        ix = a(k)
        i = left
        j = iryt

20      continue

          if ( j .lt. i ) then

            if ( j .lt. k ) then
              left = i
            end if

            if ( k .lt. i ) then
              iryt = j
            end if

            go to 50

          end if
c
c  Find I so that IX <= A(I).
c
30        continue

          if ( a(i) .lt. ix ) then
            i = i + 1
            go to 30
          end if
c
c  Find J so that A(J) <= IX.
c
40        continue

          if ( ix .lt. a(j) ) then
            j = j - 1
            go to 40
          end if

          if ( i .le. j ) then

            t    = a(i)
            a(i) = a(j)
            a(j) = t

            i = i + 1
            j = j - 1

          end if

        go to 20

50      continue

      go to 10

60    continue

      return
      end
      subroutine i4vec_gcd ( n, v, gcd )

c*********************************************************************72
c
cc I4VEC_GCD returns the greatest common divisor of an I4VEC.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c    The value GCD returned has the property that it is the greatest integer
c    which evenly divides every entry of V.
c
c    The entries in V may be negative.
c
c    Any zero entries in V are ignored.  If all entries of V are zero,
c    GCD is returned as 1.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    02 July 2009
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the order of V.
c
c    Input, integer V(N), the vector.
c
c    Output, integer GCD, the greatest common divisor of V.
c
      implicit none

      integer n

      integer gcd
      integer i
      integer i4_gcd
      integer v(n)

      gcd = 0

      do i = 1, n

        if ( v(i) .ne. 0 ) then
          if ( gcd .eq. 0 ) then
            gcd = abs ( v(i) )
          else
            gcd = i4_gcd ( gcd, v(i) )
          end if
        end if

      end do
c
c  If GCD is 0, that can only happen because all entries of V are zero.
c
      if ( gcd .eq. 0 ) then
        gcd = 1
      end if

      return
      end
      subroutine i4vec_heap_a ( n, a )

c*********************************************************************72
c
cc I4VEC_HEAP_A reorders an I4VEC into an ascending heap.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c    An ascending heap is an array A with the property that, for every index J,
c    A(J) <= A(2*J) and A(J) <= A(2*J+1), (as long as the indices
c    2*J and 2*J+1 are legal).
c
c                  A(1)
c                /      \
c            A(2)         A(3)
c          /     \        /  \
c      A(4)       A(5)  A(6) A(7)
c      /  \       /   \
c    A(8) A(9) A(10) A(11)
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    18 July 2010
c
c  Author:
c
c    John Burkardt
c
c  Reference:
c
c    Albert Nijenhuis, Herbert Wilf,
c    Combinatorial Algorithms for Computers and Calculators,
c    Academic Press, 1978,
c    ISBN: 0-12-519260-6,
c    LC: QA164.N54.
c
c  Parameters:
c
c    Input, integer N, the size of the input array.
c
c    Input/output, integer A(N).
c    On input, an unsorted array.
c    On output, the array has been reordered into a heap.
c
      implicit none

      integer n

      integer a(n)
      integer i
      integer ifree
      integer key
      integer m
c
c  Only nodes N/2 down to 1 can be "parent" nodes.
c
      do i = n / 2, 1, -1
c
c  Copy the value out of the parent node.
c  Position IFREE is now "open".
c
        key = a(i)
        ifree = i

10      continue
c
c  Positions 2*IFREE and 2*IFREE + 1 are the descendants of position
c  IFREE.  (One or both may not exist because they exceed N.)
c
          m = 2 * ifree
c
c  Does the first position exist?
c
          if ( n .lt. m ) then
            go to 20
          end if
c
c  Does the second position exist?
c
          if ( m + 1 .le. n ) then
c
c  If both positions exist, take the smaller of the two values,
c  and update M if necessary.
c
            if ( a(m+1) .lt. a(m) ) then
              m = m + 1
            end if

          end if
c
c  If the small descendant is smaller than KEY, move it up,
c  and update IFREE, the location of the free position, and
c  consider the descendants of THIS position.
c
          if ( key .le. a(m) ) then
            go to 20
          end if

          a(ifree) = a(m)
          ifree = m

        go to 10
c
c  Once there is no more shifting to do, KEY moves into the free spot.
c
20      continue

        a(ifree) = key

      end do

      return
      end
      subroutine i4vec_heap_d ( n, a )

c*********************************************************************72
c
cc I4VEC_HEAP_D reorders an I4VEC into an descending heap.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c    A descending heap is an array A with the property that, for every index J,
c    A(J) >= A(2*J) and A(J) >= A(2*J+1), (as long as the indices
c    2*J and 2*J+1 are legal).
c
c                  A(1)
c                /      \
c            A(2)         A(3)
c          /     \        /  \
c      A(4)       A(5)  A(6) A(7)
c      /  \       /   \
c    A(8) A(9) A(10) A(11)
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    23 July 2008
c
c  Author:
c
c    John Burkardt
c
c  Reference:
c
c    Albert Nijenhuis, Herbert Wilf,
c    Combinatorial Algorithms for Computers and Calculators,
c    Academic Press, 1978,
c    ISBN: 0-12-519260-6,
c    LC: QA164.N54.
c
c  Parameters:
c
c    Input, integer N, the size of the input array.
c
c    Input/output, integer A(N).
c    On input, an unsorted array.
c    On output, the array has been reordered into a heap.
c
      implicit none

      integer n

      integer a(n)
      integer i
      integer ifree
      integer key
      integer m
c
c  Only nodes N/2 down to 1 can be "parent" nodes.
c
      do i = n/2, 1, -1
c
c  Copy the value out of the parent node.
c  Position IFREE is now "open".
c
        key = a(i)
        ifree = i

10      continue
c
c  Positions 2*IFREE and 2*IFREE + 1 are the descendants of position
c  IFREE.  (One or both may not exist because they exceed N.)
c
          m = 2 * ifree
c
c  Does the first position exist?
c
          if ( n .lt. m ) then
            go to 20
          end if
c
c  Does the second position exist?
c
          if ( m + 1 .le. n ) then
c
c  If both positions exist, take the larger of the two values,
c  and update M if necessary.
c
            if ( a(m) .lt. a(m+1) ) then
              m = m + 1
            end if

          end if
c
c  If the large descendant is larger than KEY, move it up,
c  and update IFREE, the location of the free position, and
c  consider the descendants of THIS position.
c
          if ( a(m) .le. key ) then
            go to 20
          end if

          a(ifree) = a(m)
          ifree = m

        go to 10
c
c  Once there is no more shifting to do, KEY moves into the free spot IFREE.
c
20      continue

        a(ifree) = key

      end do

      return
      end
      subroutine i4vec_heap_d_extract ( n, a, value )

c*********************************************************************72
c
cc I4VEC_HEAP_D_EXTRACT extracts the maximum value from a descending heap.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c    In other words, the routine finds the maximum value in the
c    heap, returns that value to the user, deletes that value from
c    the heap, and restores the heap to its proper form.
c
c    This is one of three functions needed to model a priority queue.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    27 July 2010
c
c  Author:
c
c    John Burkardt
c
c  Reference:
c
c    Thomas Cormen, Charles Leiserson, Ronald Rivest,
c    Introduction to Algorithms,
c    MIT Press, 2001,
c    ISBN: 0262032937.
c
c  Parameters:
c
c    Input/output, integer N, the number of items in the heap.
c
c    Input/output, integer A(N), the heap.
c
c    Output, integer VALUE, the item of maximum value, which has
c    been removed from the heap.
c
      implicit none

      integer a(*)
      integer n
      integer value

      if ( n .lt. 1 ) then
        write ( *, '(a)' ) ' '
        write ( *, '(a)' ) 'I4VEC_HEAP_D_EXTRACT - Fatal error!'
        write ( *, '(a)' ) '  The heap is empty.'
        stop 1
      end if
c
c  Get the maximum value.
c
      value = a(1)

      if ( n .eq. 1 ) then
        n = 0
        return
      end if
c
c  Shift the last value down.
c
      a(1) = a(n)
c
c  Restore the heap structure.
c
      n = n - 1
      call i4vec_sort_heap_d ( n, a )

      return
      end
      subroutine i4vec_heap_d_insert ( n, a, value )

c*********************************************************************72
c
cc I4VEC_HEAP_D_INSERT inserts a new I4 into a descending heap.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c    This is one of three functions needed to model a priority queue.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    28 July 2010
c
c  Author:
c
c    John Burkardt
c
c  Reference:
c
c    Thomas Cormen, Charles Leiserson, Ronald Rivest,
c    Introduction to Algorithms,
c    MIT Press, page 150.
c
c  Parameters:
c
c    Input/output, integer N, the number of items in the heap.
c
c    Input/output, integer A(N), the heap.
c
c    Input, integer VALUE, the value to be inserted.
c
      implicit none

      integer a(*)
      integer i
      integer n
      integer parent
      integer value

      n = n + 1
      i = n

10    continue

      if ( 1 .lt. i ) then

        parent = i / 2

        if ( value .le. a(parent) ) then
          go to 20
        end if

        a(i) = a(parent)
        i = parent

        go to 10

      end if

20    continue

      a(i) = value

      return
      end
      subroutine i4vec_heap_d_max ( n, a, val_max )

c*********************************************************************72
c
cc I4VEC_HEAP_D_MAX returns the maximum value in a descending heap of integers.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c    This is one of three functions needed to model a priority queue.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    28 July 2010
c
c  Author:
c
c    John Burkardt
c
c  Reference:
c
c    Thomas Cormen, Charles Leiserson, Ronald Rivest,
c    Introduction to Algorithms,
c    MIT Press, page 150.
c
c  Parameters:
c
c    Input, integer N, the number of items in the heap.
c
c    Input, integer A(N), the heap.
c
c    Output, integer VAL_MAX, the maximum value in the heap.
c
      implicit none

      integer n

      integer a(n)
      integer val_max

      val_max = a(1)

      return
      end
      subroutine i4vec_histogram ( n, a, histo_num, histo_gram )

c*********************************************************************72
c
cc I4VEC_HISTOGRAM computes a histogram of the elements of an I4VEC.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c    It is assumed that the entries in the vector A are nonnegative.
c    Only values between 0 and HISTO_NUM will be histogrammed.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    26 October 2013
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the number of elements of A.
c
c    Input, integer A(N), the array to examine.
c
c    Input, integer HISTO_NUM, the maximum value for which a
c    histogram entry will be computed.
c
c    Output, integer HISTO_GRAM(0:HISTO_NUM), contains the
c    number of entries of A with the values of 0 through HISTO_NUM.
c
      implicit none

      integer histo_num
      integer n

      integer a(n)
      integer histo_gram(0:histo_num)
      integer i

      do i = 0, histo_num
        histo_gram(i) = 0
      end do

      do i = 1, n

        if ( 0 .le. a(i) .and. a(i) .le. histo_num ) then
          histo_gram(a(i)) = histo_gram(a(i)) + 1
        end if

      end do

      return
      end
      subroutine i4vec_histogram_masked ( n, a, histo_num, mask, 
     &  histo_gram )

c*********************************************************************72
c
cc I4VEC_HISTOGRAM_MASKED computes a histogram of a masked I4VEC.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c    Only values with a MASK of 1 will be histogrammed.
c    Only values between 0 and HISTO_NUM will be histogrammed.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    26 October 2013
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the number of elements of A.
c
c    Input, integer A(N), the array to examine.
c
c    Input, integer HISTO_NUM, the maximum value for which a
c    histogram entry will be computed.
c
c    Input, integer MASK(N), the mask.
c
c    Output, integer HISTO_GRAM(0:HISTO_NUM), contains the
c    number of entries of A with the values of 0 through HISTO_NUM.
c
      implicit none

      integer histo_num
      integer n

      integer a(n)
      integer histo_gram(0:histo_num)
      integer i
      integer mask(n)

      do i = 0, histo_num
        histo_gram(i) = 0
      end do

      do i = 1, n

        if ( mask(i) .eq. 1 ) then
          if ( 0 .le. a(i) .and. a(i) .le. histo_num ) then
            histo_gram(a(i)) = histo_gram(a(i)) + 1
          end if
        end if

      end do

      return
      end
      subroutine i4vec_increment ( n, x )

c*********************************************************************72
c
cc I4VEC_INCREMENT increments an I4VEC.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    18 July 2014
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the size of the array.
c
c    Input/output, integer X(N), the array to be incremented.
c
      implicit none

      integer n

      integer i
      integer x(n)

      do i = 1, n
        x(i) = x(i) + 1
      end do

      return
      end
      function i4vec_index ( n, a, aval )

c*********************************************************************72
c
cc I4VEC_INDEX returns the location of the first occurrence of a given value.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    18 July 2008
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the number of entries in the vector.
c
c    Input, integer A(N), the vector to be searched.
c
c    Input, integer AVAL, the value to be indexed.
c
c    Output, integer I4VEC_INDEX, the first location in A which
c    has the value AVAL, or 0 if no such index exists.
c
      implicit none

      integer n

      integer a(n)
      integer aval
      integer i
      integer i4vec_index

      do i = 1, n
        if ( a(i) .eq. aval ) then
          i4vec_index = i
          return
        end if
      end do

      i4vec_index = 0

      return
      end
      subroutine i4vec_index_delete_all ( n, x, indx, xval )

c*********************************************************************72
c
cc I4VEC_INDEX_DELETE_ALL deletes a value in an indexed sorted I4VEC.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    28 July 2010
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input/output, integer N, the size of the current list.
c
c    Input/output, integer X(N), the list.
c
c    Input/output, integer INDX(N), the sort index of the list.
c
c    Input, integer XVAL, the value to be sought.
c
      implicit none

      integer n

      integer equal
      integer equal1
      integer equal2
      integer get
      integer i
      integer indx(*)
      integer less
      integer more
      integer put
      integer x(*)
      integer xval

      if ( n .lt. 1 ) then
        n = 0
        return
      end if

      call i4vec_index_search ( n, x, indx, xval, less, equal, more )

      if ( equal .eq. 0 ) then
        return
      end if

      equal1 = equal

10    continue

        if ( equal1 .le. 1 ) then
          go to 20
        end if

        if ( x(indx(equal1-1)) .ne. xval ) then
          go to 20
        end if

        equal1 = equal1 - 1

      go to 10

20    continue

      equal2 = equal

30    continue

        if ( n .le. equal2 ) then
          go to 40
        end if

        if ( x(indx(equal2+1)) .ne. xval ) then
          go to 40
        end if

        equal2 = equal2 + 1

      go to 30

40    continue
c
c  Discard certain X values.
c
      put = 0

      do get = 1, n

        if ( x(get) .ne. xval ) then
          put = put + 1
          x(put) = x(get)
        end if

      end do

      do i = put + 1, n
        x(i) = 0
      end do
c
c  Adjust the INDX values.
c
      do equal = equal1, equal2
        do i = 1, n
          if ( indx(equal) .lt. indx(i) ) then
            indx(i) = indx(i) - 1
          end if
        end do
      end do
c
c  Discard certain INDX values.
c
      do i = equal1, equal1 + n - equal2 - 1
        indx(i) = indx(i-equal1+equal2+1)
      end do

      do i = equal1 + n - equal2, n
        indx(i) = 0
      end do
c
c  Adjust N.
c
      n = put

      return
      end
      subroutine i4vec_index_delete_dupes ( n, x, indx, n2, x2, indx2 )

c*********************************************************************72
c
cc I4VEC_INDEX_DELETE_DUPES deletes duplicates from an indexed sorted I4VEC.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c    The output quantities N2, X2, and INDX2 are computed from the
c    input quantities by sorting, and eliminating duplicates.
c
c    The output arrays should be dimensioned of size N, unless the user
c    knows in advance what the value of N2 will be.
c
c    The output arrays may be identified with the input arrays.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    29 July 2010
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the size of the input list.
c
c    Input, integer X(N), the list.
c
c    Input, integer INDX(N), the sort index of the list.
c
c    Output, integer N2, the number of unique entries in X.
c
c    Output, integer X2(N2), a copy of the list which has
c    been sorted, and made unique.
c
c    Output, integer INDX2(N2), the sort index of the new list.
c
      implicit none

      integer n

      integer i
      integer indx(n)
      integer indx2(n)
      integer n2
      integer n3
      integer x(n)
      integer x2(n)
      integer x3(n)

      i = 0
      n3 = 0

10    continue

        i = i + 1

        if ( n .lt. i ) then
          go to 20
        end if

        if ( 1 .lt. i ) then
          if ( x(indx(i)) .eq. x3(n3) ) then
            go to 10
          end if
        end if

        n3 = n3 + 1
        x3(n3) = x(indx(i))

      go to 10

20    continue
!
!  Copy data into output arrays.
!
      n2 = n3
      do i = 1, n2
        x2(i) = x3(i)
      end do

      call i4vec_indicator1 ( n2, indx2 )

      return
      end
      subroutine i4vec_index_insert_unique ( n, x, indx, xval )

c*********************************************************************72
c
cc I4VEC_INDEX_INSERT_UNIQUE inserts a unique I4 into an indexed sorted I4VEC.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    25 June 2011
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input/output, integer N, the size of the current list.
c    If the input value XVAL does not already occur in X, then N is increased.
c
c    Input/output, integer X(N), the list.
c    If the input value XVAL does not already occur in X, then it is added
c    to X.
c
c    Input/output, integer INDX(N), the sort index of the list.
c    If the input value XVAL does not already occur in X, then INDX is updated.
c
c    Input, integer XVAL, the value which will be inserted into
c    the X vector if it is not there already.
c
      implicit none

      integer n

      integer equal
      integer i
      integer indx(*)
      integer less
      integer more
      integer x(*)
      integer xval

      if ( n .le. 0 ) then
        n = 1
        x(1) = xval
        indx(1) = 1
        return
      end if
c
c  Does XVAL already occur in X?
c
      call i4vec_index_search ( n, x, indx, xval, less, equal, more )

      if ( equal .eq. 0 ) then
        x(n+1) = xval
        do i = n, more, - 1
          indx(i+1) = indx(i)
        end do
        indx(more) = n + 1
        n = n + 1
      end if

      return
      end
      subroutine i4vec_index_order ( n, x, indx )

c*********************************************************************72
c
cc I4VEC_INDEX_ORDER sorts an I4VEC using an index vector.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c    The index vector itself is not modified.  Therefore, the pair
c    (X,INDX) no longer represents an index sorted vector.  If this
c    relationship is to be preserved, then simply set INDX(1:N)=(1:N).
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    26 October 2014
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer  N, the size of the current list.
c
c    Input/output, integer X(N), the list.  On output, the list
c    has been sorted.
c
c    Input, integer INDX(N), the sort index of the list.
c
      implicit none

      integer n

      integer i
      integer indx(n)
      integer x(n)
      integer y(n)

      do i = 1, n
        y(i) = x(indx(i))
      end do

      do i = 1, n
        x(i) = y(i)
      end do

      return
      end
      subroutine i4vec_index_search ( n, x, indx, xval, less, equal, 
     &  more )

c*********************************************************************72
c
cc I4VEC_INDEX_SEARCH searches for an I4 in an indexed sorted I4VEC.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    25 June 2011
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the size of the current list.
c
c    Input, integer X(N), the list.
c
c    Input, integer INDX(N), the sort index of the list.
c
c    Input, integer XVAL, the value to be sought.
c
c    Output, integer LESS, EQUAL, MORE, the indexes in INDX of the
c    entries of X that are just less than, equal to, and just greater
c    than XVAL.  If XVAL does not occur in X, then EQUAL is zero.
c    If XVAL is the minimum entry of X, then LESS is 0.  If XVAL
c    is the greatest entry of X, then MORE is N+1.
c
      implicit none

      integer n

      integer equal
      integer hi
      integer indx(n)
      integer less
      integer lo
      integer mid
      integer more
      integer x(n)
      integer xhi
      integer xlo
      integer xmid
      integer xval

      if ( n .le. 0 ) then
        less = 0
        equal = 0
        more = 0
        return
      end if

      lo = 1
      hi = n
      xlo = x(indx(lo))
      xhi = x(indx(hi))

      if ( xval .lt. xlo ) then
        less = 0
        equal = 0
        more = 1
        return
      else if ( xval .eq. xlo ) then
        less = 0
        equal = 1
        more = 2
        return
      end if

      if ( xhi .lt. xval ) then
        less = n
        equal = 0
        more = n + 1
        return
      else if ( xval .eq. xhi ) then
        less = n - 1
        equal = n
        more = n + 1
        return
      end if

10    continue

        if ( lo + 1 .eq. hi ) then
          less = lo
          equal = 0
          more = hi
          go to 20
        end if

        mid = ( lo + hi ) / 2
        xmid = x(indx(mid))

        if ( xval .eq. xmid ) then
          equal = mid
          less = mid - 1
          more = mid + 1
          go to 20
        else if ( xval .lt. xmid ) then
          hi = mid
        else if ( xmid .lt. xval ) then
          lo = mid
        end if

      go to 10

20    continue

      return
      end
      subroutine i4vec_index_sort_unique ( n, x, n2, x2, indx2 )

c*********************************************************************72
c
cc I4VEC_INDEX_SORT_UNIQUE creates a sorted unique index for an I4VEC.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    17 August 2010
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the size of the current list.
c
c    Input, integer X(N), the list.
c
c    Output, integer N2, the number of unique elements in X.
c
c    Output, integer X2(N2), a list of the unique elements of X.
c
c    Output, integer INDX2(N2), the sort index of the list.
c
      implicit none

      integer n

      integer i
      integer indx2(n)
      integer n2
      integer x(n)
      integer x2(n)

      n2 = 0

      do i = 1, n
        call i4vec_index_insert_unique ( n2, x2, indx2, x(i) )
      end do

      do i = n2 + 1, n
        x2(i) = -1
        indx2(i) = -1
      end do

      return
      end
      subroutine i4vec_indexed_heap_d ( n, a, indx )

c*********************************************************************72
c
cc I4VEC_INDEXED_HEAP_D creates a descending heap from an indexed I4VEC.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c    An indexed I4VEC is an I4VEC of data values, and an I4VEC of N indices,
c    each referencing an entry of the data vector.
c
c    The function adjusts the index vector INDX so that, for 1 <= J <= N/2,
c    we have:
c      A(INDX(2*J))   <= A(INDX(J))
c    and
c      A(INDX(2*J+1)) <= A(INDX(J))
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    22 December 2010
c
c  Author:
c
c    John Burkardt
c
c  Reference:
c
c    Albert Nijenhuis, Herbert Wilf,
c    Combinatorial Algorithms for Computers and Calculators,
c    Academic Press, 1978,
c    ISBN: 0-12-519260-6,
c    LC: QA164.N54.
c
c  Parameters:
c
c    Input, integer N, the size of the index array.
c
c    Input, integer A(*), the array that is indexed.
c
c    Input/output, integer INDX(N), the index array.
c    Each entry of INDX must be a valid index for the array A.
c    On output, the indices have been reordered into a descending heap.
c
      implicit none

      integer n

      integer a(*)
      integer i
      integer ifree
      integer indx(n)
      integer key
      integer m
c
c  Only nodes N/2 down to 1 can be "parent" nodes.
c
      do i = n / 2, 1, -1
c
c  Copy the value out of the parent node.
c  Position IFREE is now "open".
c
        key = indx(i)
        ifree = i

10      continue
c
c  Positions 2*IFREE and 2*IFREE + 1 are the descendants of position
c  IFREE.  (One or both may not exist because they exceed N.)
c
          m = 2 * ifree
c
c  Does the first position exist?
c
          if ( n .lt. m ) then
            go to 20
          end if
c
c  Does the second position exist?
c
          if ( m + 1 .le. n ) then
c
c  If both positions exist, take the larger of the two values,
c  and update M if necessary.
c
            if ( a(indx(m)) .lt. a(indx(m+1)) ) then
              m = m + 1
            end if

          end if
c
c  If the large descendant is larger than KEY, move it up,
c  and update IFREE, the location of the free position, and
c  consider the descendants of THIS position.
c
          if ( a(indx(m)) .le. a(key) ) then
            go to 20
          end if

          indx(ifree) = indx(m)
          ifree = m

        go to 10
c
c  Once there is no more shifting to do, KEY moves into the free spot IFREE.
c
        indx(ifree) = key

      end do

20    continue

      return
      end
      subroutine i4vec_indexed_heap_d_extract ( n, a, indx,
     &  indx_extract )

c*********************************************************************72
c
cc I4VEC_INDEXED_HEAP_D_EXTRACT: extract from heap descending indexed I4VEC.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c    An indexed I4VEC is an I4VEC of data values, and an I4VEC of N indices,
c    each referencing an entry of the data vector.
c
c    The routine finds the maximum value in the heap, returns that value to the
c    user, deletes that value from the heap, and restores the heap to its
c    proper form.
c
c    Note that the argument N must be a variable, which will be decremented
c    before return, and that INDX will hold one less value on output than it
c    held on input.
c
c    This is one of three functions needed to model a priority queue.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    17 August 2010
c
c  Author:
c
c    John Burkardt
c
c  Reference:
c
c    Thomas Cormen, Charles Leiserson, Ronald Rivest,
c    Introduction to Algorithms,
c    MIT Press, 2001,
c    ISBN: 0262032937,
c    LC: QA76.C662.
c
c  Parameters:
c
c    Input/output, integer N, the number of items in the
c    index vector.
c
c    Input, integer A(*), the data vector.
c
c    Input/output, integer INDX(N), the index vector.
c
c    Output, integer INDX_EXTRACT, the index in A of the item of
c    maximum value, which has now been removed from the heap.
c
      implicit none

      integer a(*)
      integer indx(*)
      integer indx_extract
      integer n

      if ( n .lt. 1 ) then
        write ( *, '(a)' ) ' '
        write ( *, '(a)' ) 'I4VEC_INDEXED_HEAP_D_EXTRACT - Fatal error!'
        write ( *, '(a)' ) '  The heap is empty.'
        stop 1
      end if
c
c  Get the index of the maximum value.
c
      indx_extract = indx(1)

      if ( n .eq. 1 ) then
        n = 0
        return
      end if
c
c  Shift the last index down.
c
      indx(1) = indx(n)
c
c  Restore the heap structure.
c
      n = n - 1
      call i4vec_indexed_heap_d ( n, a, indx )

      return
      end
      subroutine i4vec_indexed_heap_d_insert ( n, a, indx, indx_insert )

c*********************************************************************72
c
cc I4VEC_INDEXED_HEAP_D_INSERT: insert value into heap descending indexed I4VEC.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c    An indexed I4VEC is an I4VEC of data values, and an I4VEC of N indices,
c    each referencing an entry of the data vector.
c
c    Note that the argument N must be a variable, and will be incremented before
c    return, and that INDX must be able to hold one more entry on output than
c    it held on input.
c
c    This is one of three functions needed to model a priority queue.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    17 August 2010
c
c  Author:
c
c    John Burkardt
c
c  Reference:
c
c    Thomas Cormen, Charles Leiserson, Ronald Rivest,
c    Introduction to Algorithms,
c    MIT Press, 2001,
c    ISBN: 0262032937,
c    LC: QA76.C662.
c
c  Parameters:
c
c    Input/output, integer N, the number of items in the
c    index vector.
c
c    Input, integer A(*), the data vector.
c
c    Input/output, integer INDX(N), the index vector.
c
c    Input, integer INDX_INSERT, the index in A of the value
c    to be inserted into the heap.
c
      implicit none

      integer a(*)
      integer i
      integer indx(*)
      integer indx_insert
      integer n
      integer parent

      n = n + 1
      i = n

10    continue

      if ( 1 .lt. i ) then

        parent = i / 2

        if ( a(indx_insert) .le. a(indx(parent)) ) then
          go to 20
        end if

        indx(i) = indx(parent)
        i = parent

        go to 10

      end if

20    continue

      indx(i) = indx_insert

      return
      end
      subroutine i4vec_indexed_heap_d_max ( n, a, indx, indx_max )

c*********************************************************************72
c
cc I4VEC_INDEXED_HEAP_D_MAX: maximum value in heap descending indexed I4VEC.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c    An indexed I4VEC is an I4VEC of data values, and an I4VEC of N indices,
c    each referencing an entry of the data vector.
c
c    This is one of three functions needed to model a priority queue.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    17 August 2010
c
c  Author:
c
c    John Burkardt
c
c  Reference:
c
c    Thomas Cormen, Charles Leiserson, Ronald Rivest,
c    Introduction to Algorithms,
c    MIT Press, 2001,
c    ISBN: 0262032937,
c    LC: QA76.C662.
c
c  Parameters:
c
c    Input, integer N, the number of items in the index vector.
c
c    Input, integer A(*), the data vector.
c
c    Input, integer INDX(N), the index vector.
c
c    Output, integer INDX_MAX, the index in A of the maximum value
c    in the heap.
c
      implicit none

      integer n

      integer a(*)
      integer indx(n)
      integer indx_max

      indx_max = indx(1)

      return
      end
      subroutine i4vec_indicator0 ( n, a )

c*********************************************************************72
c
cc I4VEC_INDICATOR0 sets an I4VEC to the indicator vector (0,1,2,...).
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    27 September 2014
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the number of elements of A.
c
c    Output, integer A(N), the array.
c
      implicit none

      integer n

      integer a(n)
      integer i

      do i = 1, n
        a(i) = i - 1
      end do

      return
      end
      subroutine i4vec_indicator1 ( n, a )

c*********************************************************************72
c
cc I4VEC_INDICATOR1 sets an I4VEC to the indicator vector (1,2,3,...).
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    27 September 2014
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the number of elements of A.
c
c    Output, integer A(N), the array.
c
      implicit none

      integer n

      integer a(n)
      integer i

      do i = 1, n
        a(i) = i
      end do

      return
      end
      subroutine i4vec_insert ( n, a, pos, value )

c*********************************************************************72
c
cc I4VEC_INSERT inserts a value into an I4VEC.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    05 July 2009
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the dimension of the array on input.
c
c    Input/output, integer A(N+1), the array.  On input, A is
c    assumed to contain N entries.  On output, A actually contains N+1 entries.
c
c    Input, integer POS, the position to be assigned the new entry.
c    1 <= POS <= N+1.
c
c    Input, integer VALUE, the value to be inserted at the given
c    position.
c
      implicit none

      integer n

      integer a(n+1)
      integer i
      integer pos
      integer value

      if ( pos .lt. 1 .or. n + 1 .lt. pos ) then

        write ( *, '(a)' ) ' '
        write ( *, '(a)' ) 'I4VEC_INSERT - Fatal error!'
        write ( *, '(a,i8)' ) '  Illegal insertion position = ', pos
        stop 1

      else

        do i = n + 1, pos + 1, -1
          a(i) = a(i-1)
        end do

        a(pos) = value

      end if

      return
      end
      subroutine i4vec_lcm ( n, v, lcm )

c*********************************************************************72
c
cc I4VEC_LCM returns the least common multiple of an I4VEC.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c    The value LCM returned has the property that it is the smallest integer
c    which is evenly divisible by every element of V.
c
c    The entries in V may be negative.
c
c    If any entry of V is 0, then LCM is 0.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    02 July 2009
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the order of V.
c
c    Input, integer V(N), the vector.
c
c    Output, integer LCM, the least common multiple of V.
c
      implicit none

      integer n

      integer i
      integer i4_lcm
      integer lcm
      integer v(n)

      lcm = 1

      do i = 1, n

        if ( v(i) .eq. 0 ) then
          lcm = 0
          return
        end if

        lcm = i4_lcm ( lcm, v(i) )

      end do

      return
      end
      subroutine i4vec_mask_print ( n, a, mask_num, mask, title )

c*********************************************************************72
c
cc I4VEC_MASK_PRINT prints a masked I4VEC.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    05 July 2009
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the number of components of the vector.
c
c    Input, integer A(N), the vector to be printed.
c
c    Input, integer MASK_NUM, the number of masked elements.
c
c    Input, integer MASK(MASK_NUM), the indices of the vector
c    to be printed.
c
c    Input, character * ( * ) TITLE, a title.
c
      implicit none

      integer mask_num
      integer n

      integer a(n)
      integer i
      integer mask(mask_num)
      character * ( * )  title

      write ( *, '(a)' ) ' '
      write ( *, '(a)' ) '  Masked vector printout:'
      write ( *, '(a)' ) ' '
      write ( *, '(a)' ) trim ( title )
      write ( *, '(a)' ) ' '

      do i = 1, mask_num
        write ( *, '(2x,i8,a,1x,i8,2x,i10)' )
     &    i, ':', mask(i), a(mask(i))
      end do

      return
      end
      function i4vec_max ( n, a )

c*********************************************************************72
c
cc I4VEC_MAX computes the maximum element of an I4VEC.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    21 July 2014
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the number of entries in the array.
c
c    Input, integer A(N), the array.
c
c    Output, integer I4VEC_MAX, the value of the largest entry.
c
      implicit none

      integer n

      integer a(n)
      integer i
      integer i4vec_max
      integer value

      value = a(1)

      do i = 2, n
        value = max ( value, a(i) )
      end do

      i4vec_max = value

      return
      end
      subroutine i4vec_max_index ( n, a, max_index )

c*********************************************************************72
c
cc I4VEC_MAX_INDEX computes the index of a maximum element of an I4VEC.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c    If more than one element has the maximum value, this routine returns
c    the index of the first such element.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    05 July 2009
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the number of entries in the array.
c
c    Input, integer A(N), the array.
c
c    Output, integer MAX_INDEX, the index of the largest entry.
c
      implicit none

      integer n

      integer a(n)
      integer amax
      integer i
      integer max_index

      if ( n .le. 0 ) then

        max_index = 0

      else

        amax = a(1)
        max_index = 1

        do i = 2, n

          if ( amax .lt. a(i) ) then
            amax = a(i)
            max_index = i
          end if

        end do

      end if

      return
      end
      function i4vec_max_index_last ( n, x )

c*********************************************************************72
c
cc I4VEC_MAX_INDEX_LAST returns the last maximal element location in an I4VEC
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c  Example:
c
c    X = ( 5, 1, 2, 5, 0, 5, 3 )
c
c    I4VEC_MAX_INDEX_LAST = 6
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    06 July 2009
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the size of the array.
c
c    Input, integer X(N), the array to be examined.
c
c    Output, integer I4VEC_MAX_INDEX_LAST, the index of the
c    last element of X of maximal value.
c
      implicit none

      integer n

      integer i
      integer i4vec_max_index_last
      integer max_last
      integer x(n)

      i4vec_max_index_last = 0

      do i = 1, n
        if ( i .eq. 1 ) then
          i4vec_max_index_last = 1
          max_last = x(1)
        else if ( max_last .le. x(i) ) then
          i4vec_max_index_last = i
          max_last = x(i)
        end if
      end do

      return
      end
      subroutine i4vec_mean ( n, a, mean )

c*********************************************************************72
c
cc I4VEC_MEAN returns the mean of an I4VEC.
c
c  Discussion:
c
c    An I4VEC is a vector of I4 values.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    28 August 2008
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the number of entries in the vector.
c
c    Input, integer A(N), the vector whose mean is desired.
c
c    Output, double precision MEAN, the mean of the vector entries.
c
      implicit none

      integer n

      integer a(n)
      integer i
      double precision mean

      mean = 0.0D+00
      do i = 1, n
        mean = mean + dble ( a(i) )
      end do
      mean = mean / dble ( n )

      return
      end
      subroutine i4vec_median ( n, a, median )

c*********************************************************************72
c
cc I4VEC_MEDIAN returns the median of an unsorted I4VEC.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c    Hoare's algorithm is used.  The values of the vector are
c    rearranged by this routine.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    06 July 2009
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the number of elements of A.
c
c    Input/output, integer A(N), the array to search.  On output,
c    the order of the elements of A has been somewhat changed.
c
c    Output, integer MEDIAN, the value of the median of A.
c
      implicit none

      integer n

      integer a(n)
      integer k
      integer median

      k = ( n + 1 ) / 2

      call i4vec_frac ( n, a, k, median )

      return
      end
      subroutine i4vec_merge_a ( na, a, nb, b, nc, c )

c*********************************************************************72
c
cc I4VEC_MERGE_A merges two ascending sorted I4VEC.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c    The elements of A and B should be sorted in ascending order.
c
c    The elements in the output array C will also be in ascending order,
c    and unique.
c
c    The output vector C may share storage with A or B.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    27 July 2010
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer NA, the dimension of A.
c
c    Input, integer A(NA), the first sorted array.
c
c    Input, integer NB, the dimension of B.
c
c    Input, integer B(NB), the second sorted array.
c
c    Output, integer NC, the number of elements in the output
c    array.  Note that C should usually be dimensioned at least NA+NB in the
c    calling routine.
c
c    Output, integer C(NC), the merged unique sorted array.
c
      implicit none

      integer na
      integer nb

      integer a(na)
      integer b(nb)
      integer c(na+nb)
      integer d(na+nb)
      integer j
      integer ja
      integer jb
      integer na2
      integer nb2
      integer nc
      integer order

      na2 = na
      nb2 = nb

      ja = 0
      jb = 0
      nc = 0

      call i4vec_order_type ( na2, a, order )

      if ( order .lt. 0 .or. 2 .lt. order ) then
        write ( *, '(a)' ) ' '
        write ( *, '(a)' ) 'I4VEC_MERGE - Fatal error!'
        write ( *, '(a)') '  Input array A is not ascending sorted.'
        stop 1
      end if

      call i4vec_order_type ( nb2, b, order )

      if ( order .lt. 0 .or. 2 .lt. order ) then
        write ( *, '(a)' ) ' '
        write ( *, '(a)' ) 'I4VEC_MERGE - Fatal error!'
        write ( *, '(a)' ) '  Input array B is not ascending sorted.'
        stop 1
      end if

10    continue
c
c  If we've used up all the entries of A, stick the rest of B on the end.
c
        if ( na2 .le. ja ) then

          do j = 1, nb2 - jb
            jb = jb + 1
            if ( nc .eq. 0 .or. d(nc) .lt. b(jb) ) then
              nc = nc + 1
              d(nc) = b(jb)
            end if
          end do

          do j = 1, nc
            c(j) = d(j)
          end do

          go to 20
c
c  If we've used up all the entries of B, stick the rest of A on the end.
c
        else if ( nb2 .le. jb ) then

          do j = 1, na2 - ja
            ja = ja + 1
            if ( nc .eq. 0 .or. d(nc) .lt. a(ja) ) then
              nc = nc + 1
              d(nc) = a(ja)
            end if
          end do

          do j = 1, nc
            c(j) = d(j)
          end do

          go to 20
c
c  Otherwise, if the next entry of A is smaller, that's our candidate.
c
        else if ( a(ja+1) .le. b(jb+1) ) then

          ja = ja + 1
          if ( nc .eq. 0 .or. d(nc) .lt. a(ja) ) then
            nc = nc + 1
            d(nc) = a(ja)
          end if
c
c  ...or if the next entry of B is the smaller, consider that.
c
        else

          jb = jb + 1
          if ( nc .eq. 0 .or. d(nc) .lt. b(jb) ) then
            nc = nc + 1
            d(nc) = b(jb)
          end if

        end if

      go to 10

20    continue

      return
      end
      function i4vec_min ( n, a )

c*********************************************************************72
c
cc I4VEC_MIN computes the minimum element of an I4VEC.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    22 July 2014
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the number of entries in the array.
c
c    Input, integer A(N), the array.
c
c    Output, integer I4VEC_MIN, the value of the smallest entry.
c
      implicit none

      integer n

      integer a(n)
      integer i
      integer i4vec_min
      integer value

      value = a(1)

      do i = 2, n
        value = min ( value, a(i) )
      end do

      i4vec_min = value

      return
      end
      subroutine i4vec_min_index ( n, a, imin )

c*********************************************************************72
c
cc I4VEC_MIN_INDEX computes the index of the minimum element of an I4VEC.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    06 July 2009
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the number of entries in the array.
c
c    Input, integer A(N), the array.
c
c    Output, integer IMIN, the index of the smallest entry.
c
      implicit none

      integer n

      integer a(n)
      integer amin
      integer i
      integer imin

      if ( n .le. 0 ) then

        imin = 0

      else

        amin = a(1)
        imin = 1

        do i = 2, n

          if ( a(i) .lt. amin ) then
            amin = a(i)
            imin = i
          end if

        end do

      end if

      return
      end
      subroutine i4vec_min_mv ( m, n, u, v, w )

c*********************************************************************72
c
cc I4VEC_MIN_MV determines U(1:N) /\ V for vectors U and a single vector V.
c
c  Discussion:
c
c    For two vectors U and V, each of length M, we define
c
c      ( U /\ V ) (I) = min ( U(I), V(I) ).
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    12 January 2011
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer M, the dimension of the vectors.
c
c    Input, integer N, the number of vectors in U.
c
c    Input, integer U(M,N), N vectors, each of length M.
c
c    Input, integer V(M), a vector of length M.
c
c    Output, integer W(M,N), the value of U /\ W.
c
      implicit none

      integer m
      integer n

      integer i
      integer j
      integer u(m,n)
      integer v(m)
      integer w(m,n)

      do j = 1, n
        do i = 1, m
          w(i,j) = min ( u(i,j), v(i) )
        end do
      end do

      return
      end
      subroutine i4vec_negone ( n, a )

c*********************************************************************72
c
cc I4VEC_NEGONE returns an I4VEC of -1's.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    26 October 2013
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the size of the input array.
c
c    Output, integer A(N), an array of -1's.
c
      implicit none

      integer n

      integer a(n)
      integer i

      do i = 1, n
        a(i) = -1
      end do

      return
      end
      function i4vec_nonzero_count ( n, a )

c*********************************************************************72
c
cc I4VEC_NONZERO_COUNT counts the nonzero entries in an I4VEC.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    06 July 2009
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the size of the input array.
c
c    Input, integer A(N), an array.
c
c    Output, integer I4VEC_NONZERO_COUNT, the number of
c    nonzero entries.
c
      implicit none

      integer n

      integer a(n)
      integer i
      integer i4vec_nonzero_count

      i4vec_nonzero_count = 0

      do i = 1, n
        if ( a(i) .ne. 0 ) then
          i4vec_nonzero_count = i4vec_nonzero_count + 1
        end if
      end do

      return
      end
      subroutine i4vec_nonzero_first ( n, x, nz, indx )

c*********************************************************************72
c
cc I4VEC_NONZERO_FIRST left-shifts all nonzeros in an I4VEC.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c    The routine preserves the ordering of the nonzero entries.  It counts
c    the nonzeros, and returns an index vector.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    06 July 2009
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the number of entries in the vector.
c
c    Input/output, integer X(N), the vector to be shifted.
c
c    Output, integer NZ, the number of nonzero entries in
c    the vector.
c
c    Output, integer INDX(N), contains the original location
c    of each entry.
c
      implicit none

      integer n

      integer indx(n)
      integer j
      integer k
      integer nz
      integer x(n)

      nz = 0

      do j = 1, n
        indx(j) = j
      end do

      j = 0

10    continue

      if ( j .lt. n ) then

        j = j + 1

        if ( x(j) .ne. 0 ) then

          nz = nz + 1

          if ( nz .ne. j ) then

            x(nz) = x(j)
            x(j) = 0

            k = indx(nz)
            indx(nz) = j
            indx(j) = k

          end if
        end if

        go to 10

      end if

      return
      end
      function i4vec_norm_l0 ( n, a )

c*********************************************************************72
c
cc I4VEC_NORM_L0 returns the l0 "norm" of an I4VEC.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c    The l0 "norm" simply counts the number of nonzero entries in the vector.
c    It is not a true norm, but has some similarities to one.  It is useful
c    in the study of compressive sensing.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    01 June 2012
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the number of entries in the vector.
c
c    Input, integer A(N), the vector.
c
c    Output, integer I4VEC_NORM_L0, the value of the norm.
c
      implicit none

      integer n

      integer a(n)
      integer i
      integer i4vec_norm_l0
      integer value

      value = 0
      do i = 1, n
        if ( a(i) .ne. 0 ) then
          value = value + 1
        end if
      end do

      i4vec_norm_l0 = value

      return
      end
      function i4vec_odd_all ( n, a )

c*********************************************************************72
c
cc I4VEC_ODD_ALL is TRUE if all entries of an I4VEC are odd.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    18 July 2010
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the number of entries in the vector.
c
c    Input, integer A(N), the vector.
c
c    Output, logical I4VEC_ODD_ALL, TRUE if all entries are odd.
c
      implicit none

      integer n

      integer a(n)
      integer i
      logical i4vec_odd_all

      do i = 1, n
        if ( mod ( a(i), 2 ) .ne. 1 ) then
          i4vec_odd_all = .false.
          return
        end if
      end do

      i4vec_odd_all = .true.

      return
      end
      function i4vec_odd_any ( n, a )

c*********************************************************************72
c
cc I4VEC_ODD_ANY is TRUE if any entry of an I4VEC is odd.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    18 July 2010
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the number of entries in the vector.
c
c    Input, integer A(N), the vector.
c
c    Output, logical I4VEC_ODD_ANY, TRUE if any entry is odd.
c
      implicit none

      integer n

      integer a(n)
      integer i
      logical i4vec_odd_any

      do i = 1, n
        if ( mod ( a(i), 2 ) .eq. 1 ) then
          i4vec_odd_any = .true.
          return
        end if
      end do

      i4vec_odd_any = .false.

      return
      end
      subroutine i4vec_one ( n, a )

c*********************************************************************72
c
cc I4VEC_ONE returns an I4VEC of 1's.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    26 October 2013
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the size of the input array.
c
c    Output, integer A(N), an array of 1's.
c
      implicit none

      integer n

      integer a(n)
      integer i

      do i = 1, n
        a(i) = 1
      end do

      return
      end
      subroutine i4vec_order_type ( n, a, order )

c*********************************************************************72
c
cc I4VEC_ORDER_TYPE determines if I4VEC is (non)strictly ascending/descending.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    27 July 2010
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the number of entries of the array.
c
c    Input, integer A(N), the array to be checked.
c
c    Output, integer ORDER, order indicator:
c    -1, no discernable order;
c    0, all entries are equal;
c    1, ascending order;
c    2, strictly ascending order;
c    3, descending order;
c    4, strictly descending order.
c
      implicit none

      integer n

      integer a(n)
      integer i
      integer order
c
c  Search for the first value not equal to A(1).
c
      i = 1

10    continue

        i = i + 1

        if ( n .lt. i ) then
          order = 0
          return
        end if

        if ( a(1) .lt. a(i) ) then

          if ( i .eq. 2 ) then
            order = 2
          else
            order = 1
          end if

          go to 20

        else if ( a(i) .lt. a(1) ) then

          if ( i .eq. 2 ) then
            order = 4
          else
            order = 3
          end if

          go to 20

        end if

      go to 10
c
c  Now we have a "direction".  Examine subsequent entries.
c
20    continue

      if ( i .lt. n ) then

        i = i + 1

        if ( order .eq. 1 ) then

          if ( a(i) .lt. a(i-1) ) then
            order = -1
            go to 30
          end if

        else if ( order .eq. 2 ) then

          if ( a(i) .lt. a(i-1) ) then
            order = -1
            go to 30
          else if ( a(i) .eq. a(i-1) ) then
            order = 1
          end if

        else if ( order .eq. 3 ) then

          if ( a(i-1) .lt. a(i) ) then
            order = -1
            go to 30
          end if

        else if ( order .eq. 4 ) then

          if ( a(i-1) .lt. a(i) ) then
            order = -1
            go to 30
          else if ( a(i) .eq. a(i-1) ) then
            order = 3
          end if

        end if

        go to 20

      end if

30    continue

      return
      end
      function i4vec_pairwise_prime ( n, a )

c*********************************************************************72
c
cc I4VEC_PAIRWISE_PRIME checks whether an I4VEC's entries are pairwise prime.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c    Two positive integers I and J are pairwise prime if they have no common
c    factor greater than 1.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    07 January 2007
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the number of values to check.
c
c    Input, integer A(N), the vector of integers.
c
c    Output, logical I4VEC_PAIRWISE_PRIME, is TRUE if the vector of integers
c    is pairwise prime.
c
      implicit none

      integer n

      integer a(n)
      integer i
      integer i4_gcd
      logical i4vec_pairwise_prime
      integer j

      i4vec_pairwise_prime = .false.

      do i = 1, n
        do j = i + 1, n
          if ( i4_gcd ( a(i), a(j) ) /= 1 ) then
            return
          end if
        end do
      end do

      i4vec_pairwise_prime = .true.

      return
      end
      subroutine i4vec_part ( n, nval, a )

c*********************************************************************72
c
cc I4VEC_PART partitions an integer NVAL into N nearly equal parts.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c  Example:
c
c    Input:
c
c      N = 5, NVAL = 17
c
c    Output:
c
c      A = ( 4, 4, 3, 3, 3 ).
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    05 July 2009
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the number of entries in the array.
c
c    Input, integer NVAL, the integer to be partitioned.
c    NVAL may be positive, zero, or negative.
c
c    Output, integer A(N), the partition of NVAL.  The entries of
c    A add up to NVAL.  The entries of A are either all equal, or
c    differ by at most 1.  The entries of A all have the same sign
c    as NVAL, and the "largest" entries occur first.
c
      implicit none

      integer n

      integer a(n)
      integer i
      integer j
      integer nval

      do i = 1, n
        a(i) = 0
      end do

      if ( 0 .lt. nval ) then

        j = 1
        do i = 1, nval
          a(j) = a(j) + 1
          j = j + 1
          if ( n .lt. j ) then
            j = 1
          end if
        end do

      else if ( nval .lt. 0 ) then

        j = 1
        do i = nval, -1
          a(j) = a(j) - 1
          j = j + 1
          if ( n .lt. j ) then
            j = 1
          end if
        end do

      end if

      return
      end
      subroutine i4vec_part_quick_a ( n, a, l, r )

c*********************************************************************72
c
cc I4VEC_PART_QUICK_A reorders an I4VEC as part of a quick sort.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c    The routine reorders the entries of A.  Using A(1) as a key,
c    all entries of A that are less than or equal to the key will
c    precede the key which precedes all entries that are greater than the key.
c
c  Example:
c
c    Input:
c
c      N = 8
c
c      A = ( 6, 7, 3, 1, 6, 8, 2, 9 )
c
c    Output:
c
c      L = 3, R = 6
c
c      A = ( 3, 1, 2, 6, 6, 8, 9, 7 )
c            -------        -------
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    27 July 2010
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the number of entries of A.
c
c    Input/output, integer A(N).  On input, the array to be
c    checked.  On output, A has been reordered as described above.
c
c    Output, integer L, R, the indices of A that define the
c    three segments.
c    Let KEY = the input value of A(1).  Then
c    I <= L                 A(I) < KEY;
c         L < I < R         A(I) = KEY;
c                 R <= I    KEY < A(I).
c
      implicit none

      integer n

      integer a(n)
      integer i
      integer key
      integer l
      integer m
      integer r
      integer t

      if ( n .lt. 1 ) then
        write ( *, '(a)' ) ' '
        write ( *, '(a)' ) 'I4VEC_PART_QUICK_A - Fatal error!'
        write ( *, '(a)' ) '  N < 1.'
        stop 1
      else if ( n .eq. 1 ) then
        l = 0
        r = 2
        return
      end if

      key = a(1)
      m = 1
c
c  The elements of unknown size have indices between L+1 and R-1.
c
      l = 1
      r = n + 1

      do i = 2, n

        if ( key .lt. a(l+1) ) then
          r = r - 1
          t      = a(r)
          a(r)   = a(l+1)
          a(l+2) = t
        else if ( a(l+1) .eq. key ) then
          m = m + 1
          t      = a(m)
          a(m)   = a(l+1)
          a(l+1) = t
          l = l + 1
        else if ( a(l+1) .lt. key ) then
          l = l + 1
        end if

      end do
!
!  Now shift small elements to the left, and KEY elements to center.
!
      do i = 1, l - m
        a(i) = a(i+m)
      end do
!
!  Out of bounds here, occasionally.
!
      l = l - m

      do i = 1, m
        a(l+i) = key
      end do

      return
      end
      subroutine i4vec_permute ( n, p, a )

c*********************************************************************72
c
cc I4VEC_PERMUTE permutes an I4VEC in place.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c    This routine permutes an array of integer "objects", but the same
c    logic can be used to permute an array of objects of any arithmetic
c    type, or an array of objects of any complexity.  The only temporary
c    storage required is enough to store a single object.  The number
c    of data movements made is N + the number of cycles of order 2 or more,
c    which is never more than N + N/2.
c
c  Example:
c
c    Input:
c
c      N = 5
c      P = (   2,   4,   5,   1,   3 )
c      A = (   1,   2,   3,   4,   5 )
c
c    Output:
c
c      A    = (   2,   4,   5,   1,   3 ).
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    01 December 2013
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the number of objects.
c
c    Input, integer P(N), the permutation.  P(I) = J means
c    that the I-th element of the output array should be the J-th
c    element of the input array.
c
c    Input/output, integer A(N), the array to be permuted.
c
      implicit none

      integer n

      integer a(n)
      integer a_temp
      integer i
      integer ierror
      integer iget
      integer iput
      integer istart
      integer p(n)

      call perm_check1 ( n, p )
c
c  Search for the next element of the permutation that has not been used.
c
      do istart = 1, n

        if ( p(istart) .lt. 0 ) then

          go to 20

        else if ( p(istart) .eq. istart ) then

          p(istart) = - p(istart)
          go to 20

        else

          a_temp = a(istart)
          iget = istart
c
c  Copy the new value into the vacated entry.
c
10        continue

            iput = iget
            iget = p(iget)

            p(iput) = - p(iput)

            if ( iget .lt. 1 .or. n .lt. iget ) then
              write ( *, '(a)' ) ' '
              write ( *, '(a)' ) 'I4VEC_PERMUTE - Fatal error!'
              write ( *, '(a)' ) '  An index is out of range.'
              write ( *, '(a,i8,a,i8)' ) '  P(', iput, ') = ', iget
              stop 1
            end if

            if ( iget .eq. istart ) then
              a(iput) = a_temp
              go to 20
            end if

            a(iput) = a(iget)

          go to 10

        end if

20      continue

      end do
c
c  Restore the signs of the entries.
c
      do i = 1, n
        p(i) = - p(i)
      end do

      return
      end
      subroutine i4vec_permute_uniform ( n, a, seed )

c*********************************************************************72
c
cc I4VEC_PERMUTE_UNIFORM randomly permutes an I4VEC.
c
c  Discussion:
c
c    An I4VEC is a vector of I4 values.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    01 September 2008
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the number of objects.
c
c    Input/output, integer A(N), the array to be permuted.
c
c    Input/output, integer SEED, a seed for the random number
c    generator.
c
      implicit none

      integer n

      integer a(n)
      integer p(n)
      integer seed

      call perm_uniform ( n, seed, p )

      call i4vec_permute ( n, a, p )

      return
      end
      subroutine i4vec_print ( n, a, title )

c*********************************************************************72
c
cc I4VEC_PRINT prints an I4VEC.
c
c  Discussion:
c
c    An I4VEC is a vector of integer values.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    27 November 2006
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the number of components of the vector.
c
c    Input, integer A(N), the vector to be printed.
c
c    Input, character*(*) TITLE, a title.
c
      implicit none

      integer n

      integer a(n)
      integer i
      character*(*) title

      write ( *, '(a)' ) ' '
      write ( *, '(a)' ) trim ( title )
      write ( *, '(a)' ) ' '
      do i = 1, n
        write ( *, '(2x,i8,a,1x,i12)' ) i, ':', a(i)
      end do

      return
      end
      subroutine i4vec_print_part ( n, a, max_print, title )

c*********************************************************************72
c
cc I4VEC_PRINT_PART prints "part" of an I4VEC.
c
c  Discussion:
c
c    The user specifies MAX_PRINT, the maximum number of lines to print.
c
c    If N, the size of the vector, is no more than MAX_PRINT, then
c    the entire vector is printed, one entry per line.
c
c    Otherwise, if possible, the first MAX_PRINT-2 entries are printed,
c    followed by a line of periods suggesting an omission,
c    and the last entry.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    27 October 2010
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the number of entries of the vector.
c
c    Input, integer A(N), the vector to be printed.
c
c    Input, integer MAX_PRINT, the maximum number of lines to print.
c
c    Input, character*(*) TITLE, a title.
c
      implicit none

      integer n

      integer a(n)
      integer i
      integer max_print
      character*(*) title

      if ( max_print .le. 0 ) then
        return
      end if

      if ( n .le. 0 ) then
        return
      end if

      write ( *, '(a)' ) ' '
      write ( *, '(a)' ) title
      write ( *, '(a)' ) ' '

      if ( n .le. max_print ) then

        do i = 1, n
          write ( *, '(2x,i8,a1,1x,i8)' ) i, ':', a(i)
        end do

      else if ( 3 .le. max_print ) then

        do i = 1, max_print - 2
          write ( *, '(2x,i8,a1,1x,i8)' ) i, ':', a(i)
        end do

        write ( *, '(a)' ) '  ........  ........'
        i = n

        write ( *, '(2x,i8,a1,1x,i8)' ) i, ':', a(i)

      else

        do i = 1, max_print - 1
          write ( *, '(2x,i8,a1,1x,i8)' ) i, ':', a(i)
        end do

        i = max_print

        write ( *, '(2x,i8,a1,1x,i8,a)' )
     &    i, ':', a(i), '...more entries...'

      end if

      return
      end
      subroutine i4vec_print_some ( n, a, max_print, title )

c*********************************************************************72
c
cc I4VEC_PRINT_SOME prints "some" of an I4VEC.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c    The user specifies MAX_PRINT, the maximum number of lines to print.
c
c    If N, the size of the vector, is no more than MAX_PRINT, then
c    the entire vector is printed, one entry per line.
c
c    Otherwise, if possible, the first MAX_PRINT-2 entries are printed,
c    followed by a line of periods suggesting an omission,
c    and the last entry.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    17 December 2001
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the number of entries of the vector.
c
c    Input, integer A(N), the vector to be printed.
c
c    Input, integer MAX_PRINT, the maximum number of lines to print.
c
c    Input, character*(*) TITLE, a title.
c
      implicit none

      integer n

      integer a(n)
      integer i
      integer max_print
      character*(*) title

      if ( max_print .le. 0 ) then
        return
      end if

      if ( n .le. 0 ) then
        return
      end if

      write ( *, '(a)' ) ' '
      write ( *, '(a)' ) trim ( title )
      write ( *, '(a)' ) ' '

      if ( n .le. max_print ) then

        do i = 1, n
          write ( *, '(i6,a,1x,2x,i10)' ) i, ':', a(i)
        end do

      else if ( 3 .le. max_print ) then

        do i = 1, max_print - 2
          write ( *, '(i6,a,1x,2x,i10)' ) i, ':', a(i)
        end do
        write ( *, '(a)' ) '......  ..............'
        i = n
        write ( *, '(i6,a,1x,2x,i10)' ) i, ':', a(i)

      else

        do i = 1, max_print - 1
          write ( *, '(i6,a,1x,2x,i10)' ) i, ':', a(i)
        end do
        i = max_print
        write ( *, '(i6,a,1x,i10,2x,a)' )
     &    i, ':', a(i), '...more entries...'

      end if

      return
      end
      function i4vec_product ( n, a )

c*********************************************************************72
c
cc I4VEC_PRODUCT returns the product of the entries of an I4VEC.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c    In FORTRAN90, this facility is offered by the built in
c    PRODUCT function:
c
c      I4VEC_PRODUCT ( N, A ) = PRODUCT ( A(1:N) )
c
c    In MATLAB, this facility is offered by the built in
c    PROD function:
c
c      I4VEC_PRODUCT ( N, A ) = PROD ( A(1:N) )
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    29 January 2007
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the number of entries in the array.
c
c    Input, integer A(N), the array.
c
c    Output, integer I4VEC_PRODUCT, the product of the entries.
c
      implicit none

      integer n

      integer a(n)
      integer i
      integer i4vec_product

      i4vec_product = 1
      do i = 1, n
        i4vec_product = i4vec_product * a(i)
      end do

      return
      end
      subroutine i4vec_red ( n, a, factor )

c*********************************************************************72
c
cc I4VEC_RED divides out common factors in an I4VEC.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c    On output, the entries of A have no common factor
c    greater than 1.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    31 August 2008
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the number of entries in the vector.
c
c    Input/output, integer A(N), the vector to be reduced.
c
c    Output, integer FACTOR, the common factor that was divided
c    out.
c
      implicit none

      integer n

      integer a(n)
      integer factor
      integer i
      integer i4_gcd
c
c  Find the smallest nonzero value.
c
      factor = 0

      do i = 1, n

        if ( a(i) .ne. 0 ) then

          if ( factor .eq. 0 ) then
            factor = abs ( a(i) )
          else
            factor = min ( factor, abs ( a(i) ) )
          end if

        end if

      end do

      if ( factor .eq. 0 ) then
        return
      end if
c
c  Find the greatest common factor of the entire vector.
c
      do i = 1, n
        factor = i4_gcd ( a(i), factor )
      end do

      if ( factor .eq. 1 ) then
        return
      end if
c
c  Divide out the common factor.
c
      do i = 1, n
        a(i) = a(i) / factor
      end do

      return
      end
      subroutine i4vec_reverse ( n, a )

c*********************************************************************72
c
cc I4VEC_REVERSE reverses the elements of an I4VEC.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c    In FORTRAN90, call I4VEC_REVERSE is equivalent to:
c
c      A(1:N) = A(N:1:-1)
c
c  Example:
c
c    Input:
c
c      N = 5,
c      A = ( 11, 12, 13, 14, 15 ).
c
c    Output:
c
c      A = ( 15, 14, 13, 12, 11 ).
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    25 June 2009
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the number of entries in the array.
c
c    Input/output, integer A(N), the array to be reversed.
c
      implicit none

      integer n

      integer a(n)
      integer i
      integer t

      do i = 1, n / 2
        t        = a(i)
        a(i)     = a(n+1-i)
        a(n+1-i) = t
      end do

      return
      end
      subroutine i4vec_rotate ( n, m, a )

c*********************************************************************72
c
cc I4VEC_ROTATE rotates an I4VEC in place.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c  Example:
c
c    Input:
c
c      N = 5, M = 2
c      A = ( 1, 2, 3, 4, 5 )
c
c    Output:
c
c      A = ( 4, 5, 1, 2, 3 ).
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    31 August 2008
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the number of objects.
c
c    Input, integer M, the number of positions to the right that
c    each element should be moved.  Elements that shift pass position
c    N "wrap around" to the beginning of the array.
c
c    Input/output, integer A(N), the array to be rotated.
c
      implicit none

      integer n

      integer a(n)
      integer i4_modp
      integer iget
      integer iput
      integer istart
      integer m
      integer mcopy
      integer nset
      integer temp
c
c  Force M to be positive, between 0 and N-1.
c
      mcopy = i4_modp ( m, n )

      if ( mcopy .eq. 0 ) then
        return
      end if

      istart = 0
      nset = 0

10    continue

        istart = istart + 1

        if ( n .lt. istart ) then
          go to 40
        end if

        temp = a(istart)
        iget = istart
c
c  Copy the new value into the vacated entry.
c
20      continue

          iput = iget

          iget = iget - mcopy

          if ( iget .lt. 1 ) then
            iget = iget + n
          end if

          if ( iget .eq. istart ) then
            go to 30
          end if

          a(iput) = a(iget)
          nset = nset + 1

        go to 20

30      continue

        a(iput) = temp
        nset = nset + 1

        if ( n .le. nset ) then
          go to 40
        end if

      go to 10

40    continue

      return
      end
      subroutine i4vec_run_count ( n, a, run_count )

c*********************************************************************72
c
cc I4VEC_RUN_COUNT counts runs of equal values in an I4VEC.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c    A run is a sequence of equal values.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    26 January 2007
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the number of entries in the vector.
c
c    Input, integer A(N), the vector to be examined.
c
c    Output, integer RUN_COUNT, the number of runs.
c
      implicit none

      integer n

      integer a(n)
      integer i
      integer run_count
      integer test

      run_count = 0

      if ( n .lt. 1 ) then
        return
      end if

      test = 0

      do i = 1, n

        if ( i .eq. 1 .or. a(i) .ne. test ) then
          run_count = run_count + 1
          test = a(i)
        end if

      end do

      return
      end
      subroutine i4vec_search_binary_a ( n, a, b, indx )

c*********************************************************************72
c
cc I4VEC_SEARCH_BINARY_A searches an ascending sorted I4VEC for a value.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c    Binary search is used.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    31 August 2008
c
c  Author:
c
c    John Burkardt
c
c  Reference:
c
c    Donald Kreher, Douglas Simpson,
c    Algorithm 1.9,
c    Combinatorial Algorithms,
c    CRC Press, 1998, page 26.
c
c  Parameters:
c
c    Input, integer N, the number of elements in the vector.
c
c    Input, integer A(N), the array to be searched.  A must
c    be sorted in ascending order.
c
c    Input, integer B, the value to be searched for.
c
c    Output, integer INDX, the result of the search.
c    -1, B does not occur in A.
c    I, A(I) = B.
c
      implicit none

      integer n

      integer a(n)
      integer b
      integer high
      integer indx
      integer low
      integer mid

      indx = - 1

      low = 1
      high = n

10    continue

      if ( low .le. high ) then

        mid = ( low + high ) / 2

        if ( a(mid) .eq. b ) then
          indx = mid
          go to 20
        else if ( a(mid) .lt. b ) then
          low = mid + 1
        else if ( b .lt. a(mid) ) then
          high = mid - 1
        end if

        go to 10

      end if

20    continue

      return
      end
      subroutine i4vec_search_binary_d ( n, a, b, indx )

c*********************************************************************72
c
cc I4VEC_SEARCH_BINARY_D searches a descending sorted I4VEC for a value.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c    Binary search is used.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    31 August 2008
c
c  Author:
c
c    John Burkardt
c
c  Reference:
c
c    Donald Kreher, Douglas Simpson,
c    Algorithm 1.9,
c    Combinatorial Algorithms,
c    CRC Press, 1998, page 26.
c
c  Parameters:
c
c    Input, integer N, the number of elements in the vector.
c
c    Input, integer A(N), the array to be searched.  A must
c    be sorted in descending order.
c
c    Input, integer B, the value to be searched for.
c
c    Output, integer INDX, the result of the search.
c    -1, B does not occur in A.
c    I, A(I) = B.
c
      implicit none

      integer n

      integer a(n)
      integer b
      integer high
      integer indx
      integer low
      integer mid

      indx = - 1

      low = 1
      high = n

10    continue

      if ( low .le. high ) then

        mid = ( low + high ) / 2

        if ( a(mid) .eq. b ) then
          indx = mid
          go to 20
        else if ( b .lt. a(mid) ) then
          low = mid + 1
        else if ( a(mid) .lt. b ) then
          high = mid - 1
        end if

        go to 10

      end if

20    continue

      return
      end
      subroutine i4vec_sort_bubble_a ( n, a )

c*********************************************************************72
c
cc I4VEC_SORT_BUBBLE_A ascending sorts an I4VEC using bubble sort.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    02 January 2006
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the number of entries in the array.
c
c    Input/output, integer A(N).
c    On input, the array to be sorted;
c    On output, the array has been sorted.
c
      implicit none

      integer n

      integer a(n)
      integer i
      integer j

      do i = 1, n - 1
        do j = i + 1, n
          if ( a(j) .lt. a(i) ) then
            call i4_swap ( a(i), a(j) )
          end if
        end do
      end do

      return
      end
      subroutine i4vec_sort_bubble_d ( n, a )

c*********************************************************************72
c
cc I4VEC_SORT_BUBBLE_D descending sorts an I4VEC using bubble sort.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    31 August 2008
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the number of entries in the array.
c
c    Input/output, integer A(N).
c    On input, the array to be sorted;
c    On output, the array has been sorted.
c
      implicit none

      integer n

      integer a(n)
      integer i
      integer j
      integer k

      do i = 1, n - 1
        do j = i + 1, n
          if ( a(i) .lt. a(j) ) then
            k    = a(i)
            a(i) = a(j)
            a(j) = k
          end if
        end do
      end do

      return
      end
      subroutine i4vec_sort_heap_a ( n, a )

c*********************************************************************72
c
cc I4VEC_SORT_HEAP_A ascending sorts an I4VEC using heap sort.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    23 July 2008
c
c  Author:
c
c    John Burkardt
c
c  Reference:
c
c    Albert Nijenhuis, Herbert Wilf,
c    Combinatorial Algorithms for Computers and Calculators,
c    Academic Press, 1978,
c    ISBN: 0-12-519260-6,
c    LC: QA164.N54.
c
c  Parameters:
c
c    Input, integer N, the number of entries in the array.
c
c    Input/output, integer A(N).
c    On input, the array to be sorted;
c    On output, the array has been sorted.
c
      implicit none

      integer n

      integer a(n)
      integer n1

      if ( n .le. 1 ) then
        return
      end if
c
c  1: Put A into descending heap form.
c
      call i4vec_heap_d ( n, a )
c
c  2: Sort A.
c
c  The largest object in the heap is in A(1).
c  Move it to position A(N).
c
      call i4_swap ( a(1), a(n) )
c
c  Consider the diminished heap of size N1.
c
      do n1 = n - 1, 2, -1
c
c  Restore the heap structure of A(1) through A(N1).
c
        call i4vec_heap_d ( n1, a )
c
c  Take the largest object from A(1) and move it to A(N1).
c
        call i4_swap ( a(1), a(n1) )

      end do

      return
      end
      subroutine i4vec_sort_heap_d ( n, a )

c*********************************************************************72
c
cc I4VEC_SORT_HEAP_D descending sorts an I4VEC using heap sort.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    31 August 2008
c
c  Author:
c
c    John Burkardt
c
c  Reference:
c
c    Albert Nijenhuis, Herbert Wilf,
c    Combinatorial Algorithms for Computers and Calculators,
c    Academic Press, 1978,
c    ISBN: 0-12-519260-6,
c    LC: QA164.N54.
c
c  Parameters:
c
c    Input, integer N, the number of entries in the array.
c
c    Input/output, integer A(N).
c    On input, the array to be sorted;
c    On output, the array has been sorted.
c
      implicit none

      integer n

      integer a(n)
      integer n1

      if ( n .le. 1 ) then
        return
      end if
c
c  1: Put A into ascending heap form.
c
      call i4vec_heap_a ( n, a )
c
c  2: Sort A.
c
c  The smallest object in the heap is in A(1).
c  Move it to position A(N).
c
      call i4_swap ( a(1), a(n) )
c
c  Consider the diminished heap of size N1.
c
      do n1 = n - 1, 2, -1
c
c  Restore the heap structure of A(1) through A(N1).
c
        call i4vec_heap_a ( n1, a )
c
c  Take the smallest object from A(1) and move it to A(N1).
c
        call i4_swap ( a(1), a(n1) )

      end do

      return
      end
      subroutine i4vec_sort_heap_index_a ( n, a, indx )

c*********************************************************************72
c
cc I4VEC_SORT_HEAP_INDEX_A does an indexed heap ascending sort of an I4VEC.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c    The sorting is not actually carried out.  Rather an index array is
c    created which defines the sorting.  This array may be used to sort
c    or index the array, or to sort or index related arrays keyed on the
c    original array.
c
c    Once the index array is computed, the sorting can be carried out
c    "implicitly:
c
c      A(INDX(1:N)) is sorted,
c
c    or explicitly, by the call
c
c      call i4vec_permute ( n, indx, a )
c
c    after which A(1:N) is sorted.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    05 July 2009
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the number of entries in the array.
c
c    Input, integer A(N), an array to be index-sorted.
c
c    Output, integer INDX(N), the sort index.  The
c    I-th element of the sorted array is A(INDX(I)).
c
      implicit none

      integer n

      integer a(n)
      integer aval
      integer i
      integer indx(n)
      integer indxt
      integer ir
      integer j
      integer l

      if ( n .lt. 1 ) then
        return
      end if

      do i = 1, n
        indx(i) = i
      end do

      if ( n .eq. 1 ) then
        return
      end if

      l = n / 2 + 1
      ir = n

10    continue

        if ( 1 .lt. l ) then

          l = l - 1
          indxt = indx(l)
          aval = a(indxt)

        else

          indxt = indx(ir)
          aval = a(indxt)
          indx(ir) = indx(1)
          ir = ir - 1

          if ( ir .eq. 1 ) then
            indx(1) = indxt
            go to 30
          end if

        end if

        i = l
        j = l + l

20      continue

        if ( j .le. ir ) then

          if ( j .lt. ir ) then
            if ( a(indx(j)) .lt. a(indx(j+1)) ) then
              j = j + 1
            end if
          end if

          if ( aval .lt. a(indx(j)) ) then
            indx(i) = indx(j)
            i = j
            j = j + j
          else
            j = ir + 1
          end if

          go to 20

        end if

        indx(i) = indxt

      go to 10

30    continue

      return
      end
      subroutine i4vec_sort_heap_index_d ( n, a, indx )

c*********************************************************************72
c
cc I4VEC_SORT_HEAP_INDEX_D does an indexed heap descending sort of an I4VEC.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c    The sorting is not actually carried out.  Rather an index array is
c    created which defines the sorting.  This array may be used to sort
c    or index the array, or to sort or index related arrays keyed on the
c    original array.
c
c    Once the index array is computed, the sorting can be carried out
c    "implicitly:
c
c      A(INDX(1:N)) is sorted,
c
c    or explicitly, by the call
c
c      call i4vec_permute ( n, indx, a )
c
c    after which A(1:N) is sorted.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    25 July 2010
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the number of entries in the array.
c
c    Input, integer A(N), an array to be index-sorted.
c
c    Output, integer INDX(N), the sort index.  The
c    I-th element of the sorted array is A(INDX(I)).
c
      implicit none

      integer n

      integer a(n)
      integer aval
      integer i
      integer indx(n)
      integer indxt
      integer ir
      integer j
      integer l

      if ( n .lt. 1 ) then
        return
      end if

      do i = 1, n
        indx(i) = i
      end do

      if ( n .eq. 1 ) then
        return
      end if

      l = n / 2 + 1
      ir = n

10    continue

        if ( 1 .lt. l ) then

          l = l - 1
          indxt = indx(l)
          aval = a(indxt)

        else

          indxt = indx(ir)
          aval = a(indxt)
          indx(ir) = indx(1)
          ir = ir - 1

          if ( ir .eq. 1 ) then
            indx(1) = indxt
            go to 30
          end if

        end if

        i = l
        j = l + l

20      continue

        if ( j .le. ir ) then

          if ( j .lt. ir ) then
            if ( a(indx(j+1)) .lt. a(indx(j)) ) then
              j = j + 1
            end if
          end if

          if ( a(indx(j)) .lt. aval ) then
            indx(i) = indx(j)
            i = j
            j = j + j
          else
            j = ir + 1
          end if

          go to 20

        end if

        indx(i) = indxt

      go to 10

30    continue

      return
      end
      subroutine i4vec_sort_insert_a ( n, a )

c*********************************************************************72
c
cc I4VEC_SORT_INSERT_A uses an ascending insertion sort on an I4VEC.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    25 July 2010
c
c  Author:
c
c    John Burkardt
c
c  Reference:
c
c    Donald Kreher, Douglas Simpson,
c    Algorithm 1.1,
c    Combinatorial Algorithms,
c    CRC Press, 1998, page 11.
c
c  Parameters:
c
c    Input, integer N, the number of items in the vector.
c    N must be positive.
c
c    Input/output, integer A(N).
c    On input, A contains data to be sorted.
c    On output, the entries of A have been sorted in ascending order.
c
      implicit none

      integer n

      integer a(n)
      integer i
      integer j
      integer x

      do i = 2, n

        x = a(i)

        j = i - 1

10      continue

        if ( 1 .le. j ) then

          if ( a(j) .le. x ) then
            go to 20
          end if

          a(j+1) = a(j)
          j = j - 1

          go to 10

        end if

20      continue

        a(j+1) = x

      end do

      return
      end
      subroutine i4vec_sort_insert_d ( n, a )

c*********************************************************************72
c
cc I4VEC_SORT_INSERT_D uses a descending insertion sort on an I4VEC.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    01 September 2008
c
c  Author:
c
c    John Burkardt
c
c  Reference:
c
c    Donald Kreher, Douglas Simpson,
c    Algorithm 1.1,
c    Combinatorial Algorithms,
c    CRC Press, 1998, page 11.
c
c  Parameters:
c
c    Input, integer N, the number of items in the vector.
c    N must be positive.
c
c    Input/output, integer A(N).
c    On input, A contains data to be sorted.
c    On output, the entries of A have been sorted in descending order.
c
      implicit none

      integer n

      integer a(n)
      integer i
      integer j
      integer x

      do i = 2, n

        x = a(i)

        j = i - 1

10      continue

        if ( 1 .le. j ) then

          if ( x .le. a(j) ) then
            go to 20
          end if

          a(j+1) = a(j)
          j = j - 1
          go to 10

        end if

20      continue

        a(j+1) = x

      end do

      return
      end
      subroutine i4vec_sort_quick_a ( n, a )

c*********************************************************************72
c
cc I4VEC_SORT_QUICK_A ascending sorts an I4VEC using quick sort.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c  Example:
c
c    Input:
c
c      N = 7
c
c      A = (/ 6, 7, 3, 2, 9, 1, 8 /)
c
c    Output:
c
c      A = (/ 1, 2, 3, 6, 7, 8, 9 /)
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    27 July 2010
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the number of entries in the array.
c
c    Input/output, integer A(N).
c    On input, the array to be sorted.
c    On output, the array has been sorted.
c
      implicit none

      integer level_max
      parameter ( level_max = 30 )
      integer n

      integer a(n)
      integer base
      integer l_segment
      integer level
      integer n_segment
      integer rsave(level_max)
      integer r_segment

      if ( n .le. 1 ) then
        return
      end if

      level = 1
      rsave(level) = n + 1
      base = 1
      n_segment = n

10    continue
c
c  Partition the segment.
c
        call i4vec_part_quick_a ( n_segment, a(base), l_segment,
     &    r_segment )
c
c  If the left segment has more than one element, we need to partition it.
c
        if ( 1 .lt. l_segment ) then

          if ( level_max .lt. level ) then
            write ( *, '(a)' ) ' '
            write ( *, '(a)' ) 'I4VEC_SORT_QUICK_A - Fatal error!'
            write ( *, '(a,i8)' )
     &        '  Exceeding recursion maximum of ', level_max
            stop 1
          end if

          level = level + 1
          n_segment = l_segment
          rsave(level) = r_segment + base - 1
c
c  The left segment and the middle segment are sorted.
c  Must the right segment be partitioned?
c
        else if ( r_segment .lt. n_segment ) then

          n_segment = n_segment + 1 - r_segment
          base = base + r_segment - 1
c
c  Otherwise, we back up a level if there is an earlier one.
c
        else

20        continue

            if ( level .le. 1 ) then
              return
            end if

            base = rsave(level)
            n_segment = rsave(level-1) - rsave(level)
            level = level - 1

            if ( 0 .lt. n_segment ) then
              go to 10
            end if

          go to 20

        end if

      go to 10

      return
      end
      subroutine i4vec_sort_shell_a ( n, a )

c*********************************************************************72
c
cc I4VEC_SORT_SHELL_A ascending sorts an I4VEC using Shell's sort.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    25 July 2010
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the number of entries in the array.
c
c    Input/output, integer A(N).
c    On input, an array to be sorted.
c    On output, the sorted array.
c
      implicit none

      integer n

      integer a(n)
      integer asave
      integer i
      integer ifree
      integer inc
      integer ipow
      integer j
      integer k
      integer maxpow

      if ( n .le. 1 ) then
        return
      end if
c
c  Determine the smallest MAXPOW so that
c    N <= ( 3**MAXPOW - 1 ) / 2
c
      maxpow = 1

10    continue

      if ( 3**maxpow .lt. 2 * n + 1 ) then
        maxpow = maxpow + 1
        go to 10
      end if

      if ( 1 .lt. maxpow ) then
        maxpow = maxpow - 1
      end if
c
c  Now sort groups of size ( 3**IPOW - 1 ) / 2.
c
      do ipow = maxpow, 1, -1

        inc = ( 3**ipow - 1 ) / 2
c
c  Sort the values with indices equal to K mod INC.
c
        do k = 1, inc
c
c  Insertion sort of the items with index
c  INC+K, 2*INC+K, 3*INC+K, ...
c
          do i = inc + k, n, inc

            asave = a(i)
            ifree = i
            j = i - inc

20          continue

              if ( j .lt. 1 ) then
                go to 30
              end if

              if ( a(j) .le. asave ) then
                go to 30
              end if

              ifree = j
              a(j+inc) = a(j)
              j = j - inc

            go to 20

30          continue

            a(ifree) = asave

          end do

        end do

      end do

      return
      end
      subroutine i4vec_sorted_undex ( x_num, x_val, x_unique_num,
     &  undx, xdnu )

c*********************************************************************72
c
cc I4VEC_SORTED_UNDEX returns unique sorted indexes for a sorted I4VEC.
c
c  Discussion:
c
c    An I4VEC is a vector of I4 values.
c
c    The goal of this routine is to determine a vector UNDX,
c    which points, to the unique elements of X, in sorted order,
c    and a vector XDNU, which identifies, for each entry of X, the index of
c    the unique sorted element of X.
c
c    This is all done with index vectors, so that the elements of
c    X are never moved.
c
c    Assuming X is already sorted, we examine the entries of X in order,
c    noting the unique entries, creating the entries of XDNU and
c    UNDX as we go.
c
c    Once this process has been completed, the vector X could be
c    replaced by a compressed vector XU, containing the unique entries
c    of X in sorted order, using the formula
c
c      XU(I) = X(UNDX(I)).
c
c    We could then, if we wished, reconstruct the entire vector X, or
c    any element of it, by index, as follows:
c
c      X(I) = XU(XDNU(I)).
c
c    We could then replace X by the combination of XU and XDNU.
c
c    Later, when we need the I-th entry of X, we can locate it as
c    the XDNU(I)-th entry of XU.
c
c    Here is an example of a vector X, the unique sort and
c    inverse unique sort vectors and the compressed unique sorted vector.
c
c      I    X    XU  Undx  Xdnu
c    ----+----+----+-----+-----+
c      1 | 11 |  11    1     1
c      2 | 11 |  22    5     1
c      3 | 11 |  33    8     1
c      4 | 11 |  55    9     1
c      5 | 22 |              2
c      6 | 22 |              2
c      7 | 22 |              2
c      8 | 33 |              3
c      9 | 55 |              4
c
c    UNDX(3) = 8 means that unique sorted item(3) is at X(8).
c    XDNU(6) = 2 means that X(6) is at unique sorted item(2).
c
c    XU(XDNU(I))) = X(I).
c    XU(I)        = X(UNDX(I)).
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    25 July 2010
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer X_NUM, the number of data values.
c
c    Input, integer X_VAL(X_NUM), the data values.
c
c    Input, integer X_UNIQUE_NUM, the number of unique values i
c    n X_VAL.  This value is only required for languages in which the size of
c    UNDX must be known in advance.
c
c    Output, integer UNDX(X_UNIQUE_NUM), the UNDX vector.
c
c    Output, integer XDNU(X_NUM), the XDNU vector.
c
      implicit none

      integer x_num
      integer x_unique_num

      integer i
      integer j
      integer undx(x_unique_num)
      integer x_val(x_num)
      integer xdnu(x_num)
!
!  Walk through the sorted array.
!
      i = 1

      j = 1
      undx(j) = i

      xdnu(i) = j

      do i = 2, x_num

        if ( x_val(i) .ne. x_val(undx(j)) ) then
          j = j + 1
          undx(j) = i
        end if

        xdnu(i) = j

      end do

      return
      end
      subroutine i4vec_sorted_unique ( n, a, unique_num )

c*********************************************************************72
c
cc I4VEC_SORTED_UNIQUE finds the unique elements in a sorted I4VEC.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    23 July 2008
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the number of elements in A.
c
c    Input/output, integer A(N).  On input, the sorted
c    integer array.  On output, the unique elements in A.
c
c    Output, integer UNIQUE_NUM, the number of unique elements in A.
c
      implicit none

      integer n

      integer a(n)
      integer itest
      integer unique_num

      if ( n .le. 0 ) then
        unique_num = 0
        return
      end if

      unique_num = 1

      do itest = 2, n

        if ( a(itest) .ne. a(unique_num) ) then
          unique_num = unique_num + 1
          a(unique_num) = a(itest)
        end if

      end do

      return
      end
      subroutine i4vec_sorted_unique_count ( n, a, unique_num )

c*********************************************************************72
c
cc I4VEC_SORTED_UNIQUE_COUNT counts the unique elements in a sorted I4VEC.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c    Because the array is sorted, this algorithm is O(N).
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    01 September 2008
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the number of elements of A.
c
c    Input, integer A(N), the sorted array to examine.
c
c    Output, integer UNIQUE_NUM, the number of unique elements of A.
c
      implicit none

      integer n

      integer a(n)
      integer i
      integer unique_num

      if ( n .lt. 1 ) then
        unique_num = 0
        return
      end if

      unique_num = 1

      do i = 2, n

        if ( a(i-1) .ne. a(i) ) then
          unique_num = unique_num + 1
        end if

      end do

      return
      end
      subroutine i4vec_sorted_unique_hist ( n, a, maxuniq, unique_num,
     &  auniq, acount )

c*********************************************************************72
c
cc I4VEC_SORTED_UNIQUE_HIST histograms the unique elements of a sorted I4VEC.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    25 July 2010
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the number of elements of A.
c
c    Input, integer A(N), the array to examine.  The elements of A
c    should have been sorted.
c
c    Input, integer MAXUNIQ, the maximum number of unique elements
c    that can be handled.  If there are more than MAXUNIQ unique
c    elements in A, the excess will be ignored.
c
c    Output, integer UNIQUE_NUM, the number of unique elements.
c
c    Output, integer AUNIQ(UNIQUE_NUM), the unique elements of A.
c
c    Output, integer ACOUNT(UNIQUE_NUM), the number of times
c    each element of AUNIQ occurs in A.
c
      implicit none

      integer maxuniq
      integer n

      integer a(n)
      integer acount(maxuniq)
      integer auniq(maxuniq)
      integer i
      integer unique_num
!
!  Start taking statistics.
!
      unique_num = 0

      do i = 1, n

        if ( i .eq. 1 ) then

          unique_num = 1
          auniq(unique_num) = a(1)
          acount(unique_num) = 1

        else if ( a(i) .eq. auniq(unique_num) ) then

          acount(unique_num) = acount(unique_num) + 1

        else if ( unique_num .lt. maxuniq ) then

          unique_num = unique_num + 1
          auniq(unique_num) = a(i)
          acount(unique_num) = 1

        end if

      end do

      return
      end
      subroutine i4vec_split ( n, a, split, split_index )

c*********************************************************************72
c
cc I4VEC_SPLIT "splits" an unsorted I4VEC based on a splitting value.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c    If the vector is already sorted, it is simpler to do a binary search
c    on the data than to call this routine.
c
c    The vector is not assumed to be sorted before input, and is not
c    sorted during processing.  If sorting is not needed, then it is
c    more efficient to use this routine.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    01 September 2008
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the number of elements of A.
c
c    Input/output, integer A(N), the array to split.  On output,
c    all the entries of A that are less than or equal to SPLIT
c    are in A(1:SPLIT_INDEX).
c
c    Input, integer SPLIT, the value used to split the vector.
c    It is not necessary that any value of A actually equal SPLIT.
c
c    Output, integer SPLIT_INDEX, indicates the position of the
c    last entry of the split vector that is less than or equal to SPLIT.
c
      implicit none

      integer n

      integer a(n)
      integer i
      integer i1
      integer i2
      integer i3
      integer j1
      integer j2
      integer j3
      integer split
      integer split_index
c
c  Partition the vector into A1, A2, A3, where
c    A1 = A(I1:J1) holds values <= SPLIT,
c    A2 = A(I2:J2) holds untested values,
c    A3 = A(I3:J3) holds values > SPLIT.
c
      i1 = 1
      j1 = 0

      i2 = 1
      j2 = n

      i3 = n + 1
      j3 = n
c
c  Pick the next item from A2, and move it into A1 or A3.
c  Adjust indices appropriately.
c
      do i = 1, n

        if ( a(i2) .le. split ) then
          i2 = i2 + 1
          j1 = j1 + 1
        else
          call i4_swap ( a(i2), a(i3-1) )
          i3 = i3 - 1
          j2 = j2 - 1
        end if

      end do

      split_index = j1

      return
      end
      subroutine i4vec_std ( n, a, std )

c*********************************************************************72
c
cc I4VEC_STD returns the standard deviation of an I4VEC.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    14 August 2009
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the number of entries in the vector.
c
c    Input, integer A(N), the vector whose variance is desired.
c
c    Output, double precision STD, the standard deviation of the vector entries.
c
      implicit none

      integer n

      integer a(n)
      integer i
      double precision mean
      double precision std

      if ( n .lt. 2 ) then

        std = 0.0D+00

      else

        mean = 0.0D+00
        do i = 1, n
          mean = mean + dble ( a(i) )
        end do
        mean = mean / dble ( n )

        std = 0.0D+00
        do i = 1, n
          std = std + ( dble ( a(i) ) - mean )**2
        end do

        std = sqrt ( std / dble ( n - 1 ) )

      end if

      return
      end
      function i4vec_sum ( n, a )

c*********************************************************************72
c
cc I4VEC_SUM returns the sum of the entries of an I4VEC.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c    In FORTRAN90, this facility is offered by the built in
c    SUM function:
c
c      I4VEC_SUM ( N, A ) = SUM ( A(1:N) )
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    03 January 2007
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the number of entries in the array.
c
c    Input, integer A(N), the array.
c
c    Output, integer I4VEC_SUM, the sum of the entries.
c
      implicit none

      integer n

      integer a(n)
      integer i
      integer i4vec_sum

      i4vec_sum = 0

      do i = 1, n
        i4vec_sum = i4vec_sum + a(i)
      end do

      return
      end
      subroutine i4vec_swap ( n, a1, a2 )

c*********************************************************************72
c
cc I4VEC_SWAP swaps the entries of two I4VEC's.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    31 August 2008
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the number of entries in the arrays.
c
c    Input/output, integer A1(N), A2(N), the vectors to swap.
c
      implicit none

      integer n

      integer a1(n)
      integer a2(n)
      integer a3
      integer i

      do i = 1, n
        a3    = a1(i)
        a1(i) = a2(i)
        a2(i) = a3
      end do

      return
      end
      subroutine i4vec_transpose_print ( n, a, title )

c*********************************************************************72
c
cc I4VEC_TRANSPOSE_PRINT prints an I4VEC "transposed".
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c  Example:
c
c    A = (/ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11 /)
c    TITLE = 'My vector:  '
c
c    My vector:
c
c        1    2    3    4    5
c        6    7    8    9   10
c       11
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    31 August 2008
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the number of components of the vector.
c
c    Input, integer A(N), the vector to be printed.
c
c    Input, character ( len = * ) TITLE, a title.
c
      implicit none

      integer n

      integer a(n)
      integer i
      integer ihi
      integer ilo
      character ( len = 11 ) string
      character ( len = * ) title

      write ( *, '(a)' ) ' '
      write ( *, '(a)' ) trim ( title )
      write ( *, '(a)' ) ' '
      do ilo = 1, n, 5
        ihi = min ( ilo + 5 - 1, n )
        write ( *, '(5i12)' ) ( a(i), i = ilo, ihi)
      end do

      return
      end
      subroutine i4vec_undex ( x_num, x_val, x_unique_num, undx, xdnu )

c*********************************************************************72
c
cc I4VEC_UNDEX returns unique sorted indexes for an I4VEC.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c    The goal of this routine is to determine a vector UNDX,
c    which points, to the unique elements of X, in sorted order,
c    and a vector XDNU, which identifies, for each entry of X, the index of
c    the unique sorted element of X.
c
c    This is all done with index vectors, so that the elements of
c    X are never moved.
c
c    The first step of the algorithm requires the indexed sorting
c    of X, which creates arrays INDX and XDNI.  (If all the entries
c    of X are unique, then these arrays are the same as UNDX and XDNU.)
c
c    We then use INDX to examine the entries of X in sorted order,
c    noting the unique entries, creating the entries of XDNU and
c    UNDX as we go.
c
c    Once this process has been completed, the vector X could be
c    replaced by a compressed vector XU, containing the unique entries
c    of X in sorted order, using the formula
c
c      XU(1:X_UNIQUE_NUM) = X(UNDX(1:X_UNIQUE_NUM)).
c
c    We could then, if we wished, reconstruct the entire vector X, or
c    any element of it, by index, as follows:
c
c      X(I) = XU(XDNU(I)).
c
c    We could then replace X by the combination of XU and XDNU.
c
c    Later, when we need the I-th entry of X, we can locate it as
c    the XDNU(I)-th entry of XU.
c
c    Here is an example of a vector X, the sort and inverse sort
c    index vectors, and the unique sort and inverse unique sort vectors
c    and the compressed unique sorted vector.
c
c      I    X  Indx  Xdni      XU  Undx  Xdnu
c    ----+----+-----+-----+-------+-----+-----+
c      1 | 11     1     1 |    11     1     1
c      2 | 22     3     5 |    22     2     2
c      3 | 11     6     2 |    33     4     1
c      4 | 33     9     8 |    55     5     3
c      5 | 55     2     9 |                 4
c      6 | 11     7     3 |                 1
c      7 | 22     8     6 |                 2
c      8 | 22     4     7 |                 2
c      9 | 11     5     4 |                 1
c
c    INDX(2) = 3 means that sorted item(2) is X(3).
c    XDNI(2) = 5 means that X(2) is sorted item(5).
c
c    UNDX(3) = 4 means that unique sorted item(3) is at X(4).
c    XDNU(8) = 2 means that X(8) is at unique sorted item(2).
c
c    XU(XDNU(I))) = X(I).
c    XU(I)        = X(UNDX(I)).
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    25 July 2010
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer X_NUM, the number of data values.
c
c    Input, integer X_VAL(X_NUM), the data values.
c
c    Input, integer X_UNIQUE_NUM, the number of unique values
c    in X_VAL.  This value is only required for languages in which the size of
c    UNDX must be known in advance.
c
c    Output, integer UNDX(X_UNIQUE_NUM), the UNDX vector.
c
c    Output, integer XDNU(X_NUM), the XDNU vector.
c
      implicit none

      integer x_num
      integer x_unique_num

      integer i
      integer indx(x_num)
      integer j
      integer undx(x_unique_num)
      integer x_val(x_num)
      integer xdnu(x_num)
c
c  Implicitly sort the array.
c
      call i4vec_sort_heap_index_a ( x_num, x_val, indx )
c
c  Walk through the implicitly sorted array.
c
      i = 1

      j = 1
      undx(j) = indx(i)

      xdnu(indx(i)) = j

      do i = 2, x_num

        if ( x_val(indx(i)) .ne. x_val(undx(j)) ) then
          j = j + 1
          undx(j) = indx(i)
        end if

        xdnu(indx(i)) = j

      end do

      return
      end
      subroutine i4vec_uniform_ab ( n, a, b, seed, x )

c*********************************************************************72
c
cc I4VEC_UNIFORM_AB returns a scaled pseudorandom I4VEC.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c    The pseudorandom numbers should be uniformly distributed
c    between A and B.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    12 November 2006
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the dimension of the vector.
c
c    Input, integer A, B, the limits of the interval.
c
c    Input/output, integer SEED, the "seed" value, which should NOT be 0.
c    On output, SEED has been updated.
c
c    Output, integer X(N), a vector of numbers between A and B.
c
      implicit none

      integer n

      integer a
      integer b
      integer i
      integer i4_huge
      parameter ( i4_huge = 2147483647 )
      integer k
      real r
      integer seed
      integer value
      integer x(n)

      if ( seed .eq. 0 ) then
        write ( *, '(a)' ) ' '
        write ( *, '(a)' ) 'I4VEC_UNIFORM_AB - Fatal error!'
        write ( *, '(a)' ) '  Input value of SEED = 0.'
        stop 1
      end if

      do i = 1, n

        k = seed / 127773

        seed = 16807 * ( seed - k * 127773 ) - k * 2836

        if ( seed .lt. 0 ) then
          seed = seed + i4_huge
        end if

        r = real ( seed ) * 4.656612875E-10
c
c  Scale R to lie between A-0.5 and B+0.5.
c
        r = ( 1.0E+00 - r ) * ( real ( min ( a, b ) ) - 0.5E+00 )
     &    +             r   * ( real ( max ( a, b ) ) + 0.5E+00 )
c
c  Use rounding to convert R to an integer between A and B.
c
        value = nint ( r )

        value = max ( value, min ( a, b ) )
        value = min ( value, max ( a, b ) )

        x(i) = value

      end do

      return
      end
      subroutine i4vec_unique_count ( n, a, unique_num )

c*********************************************************************72
c
cc I4VEC_UNIQUE_COUNT counts the unique elements in an unsorted I4VEC.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c    Because the array is unsorted, this algorithm is O(N^2).
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    28 August 2008
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the number of elements of A.
c
c    Input, integer A(N), the unsorted array to examine.
c
c    Output, integer UNIQUE_NUM, the number of unique elements
c    of A.
c
      implicit none

      integer n

      integer a(n)
      integer i
      integer j
      integer unique_num

      unique_num = 0

      do i = 1, n

        unique_num = unique_num + 1

        do j = 1, i - 1

          if ( a(i) .eq. a(j) ) then
            unique_num = unique_num - 1
            go to 10
          end if

        end do

10      continue

      end do

      return
      end
      subroutine i4vec_unique_index ( n, a, unique_index )

c*********************************************************************72
c
cc I4VEC_UNIQUE_INDEX indexes the first occurrence of values in an I4VEC.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c    For element A(I) of the vector, FIRST_UNIQUE(I) is the uniqueness index
c    of A(I).  That is, if A_UNIQUE contains the unique elements of A,
c    gathered in order, then
c
c      A_UNIQUE ( UNIQUE_INDEX(I) ) = A(I)
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    28 August 2008
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the number of elements of A.
c
c    Input, integer A(N), the array.
c
c    Output, integer UNIQUE_INDEX(N), the unique index.
c
      implicit none

      integer  n

      integer a(n)
      integer i
      integer j
      integer unique_index(n)
      integer unique_num

      do i = 1, n
        unique_index(i) = -1
      end do
      unique_num = 0

      do i = 1, n

        if ( unique_index(i) .eq. -1 ) then

          unique_num = unique_num + 1
          unique_index(i) = unique_num

          do j = i + 1, n
            if ( a(i) .eq. a(j) ) then
              unique_index(j) = unique_num
            end if
          end do

        end if

      end do

      return
      end
      subroutine i4vec_value_index ( n, a, value, max_index, n_index,
     &  value_index )

c*********************************************************************72
c
cc I4VEC_VALUE_INDEX indexes entries equal to a given value in an I4VEC.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c  Example:
c
c    Input:
c
c      N = 10
c      A = (  2, 3, 1, 3, 2, 4, 2, 3, 5, 3 )
c      X_VALUE = 3
c
c    Output:
c
c      N_INDEX = 4
c      VALUE_INDEX = ( 2, 4, 8, 10 ).
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    31 August 2008
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the number of objects.
c
c    Input, integer A(N), the array to be indexed.
c
c    Input, integer VALUE, a value to be searched for.
c
c    Input, integer MAX_INDEX, the maximum number of indices
c    to find.
c
c    Output, integer N_INDEX, the number of entries equal to VALUE.
c
c    Output, integer VALUE_INDEX(MAX_INDEX), the indices of entries
c    equal to VALUE.
c
      implicit none

      integer max_index
      integer n

      integer a(n)
      integer i
      integer n_index
      integer value
      integer value_index(max_index)

      n_index = 0

      do i = 1, n

        if ( a(i) .eq. value ) then

          if ( max_index .le. n_index ) then
            return
          end if

          n_index = n_index + 1
          value_index(n_index) = i

        end if

      end do

      return
      end
      subroutine i4vec_value_num ( n, a, value, value_num )

c*********************************************************************72
c
cc I4VEC_VALUE_NUM counts entries equal to a given value in an I4VEC.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    31 August 2008
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the number of objects.
c
c    Input, integer A(N), the array to be indexed.
c
c    Input, integer VALUE, a value to be searched for.
c
c    Input, integer VALUE_NUM, the number of times the
c    value occurs.
c
      implicit none

      integer n

      integer a(n)
      integer i
      integer value
      integer value_num

      value_num = 0

      do i = 1, n

        if ( a(i) .eq. value ) then
          value_num = value_num + 1
        end if

      end do

      return
      end
      subroutine i4vec_variance ( n, a, variance )

c*********************************************************************72
c
cc I4VEC_VARIANCE returns the variance of an I4VEC.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    14 August 2009
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the number of entries in the vector.
c
c    Input, integer A(N), the vector whose variance is desired.
c
c    Output, double precision VARIANCE, the variance of the vector entries.
c
      implicit none

      integer n

      integer a(n)
      integer i
      double precision mean
      double precision variance

      if ( n .lt. 2 ) then

        variance = 0.0D+00

      else

        mean = 0.0D+00
        do i = 1, n
          mean = mean + dble ( a(i) )
        end do
        mean = mean / dble ( n )

        variance = 0.0D+00
        do i = 1, n
          variance = variance + ( dble ( a(i) ) - mean )**2
        end do

        variance = variance / dble ( n - 1 )

      end if

      return
      end
      function i4vec_width ( n, a )

c*********************************************************************72
c
cc I4VEC_WIDTH returns the "width" of an I4VEC.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c    The width of an integer vector is simply the maximum of the widths of
c    its entries.
c
c    The width of a single integer is the number of characters
c    necessary to print it.
c
c    The width of an integer vector can be useful when the vector is
c    to be printed.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    31 August 2008
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the number of entries in the vector.
c
c    Input, integer A(N), the vector.
c
c    Output, integer I4VEC_WIDTH, the width of the vector.
c
      implicit none

      integer n

      integer a(n)
      integer i
      integer i4_width
      integer i4vec_width

      i4vec_width = -1

      do i = 1, n
        i4vec_width = max ( i4vec_width, i4_width ( a(i) ) )
      end do

      return
      end
      subroutine i4vec_zero ( n, a )

c*********************************************************************72
c
cc I4VEC_ZERO sets the entries of an I4VEC to 0.
c
c  Discussion:
c
c    An I4VEC is a vector of I4's.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    18 January 2007
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the number of entries in the vector.
c
c    Output, integer A(N), the vector, which has been set to zero.
c
      implicit none

      integer n

      integer a(n)
      integer i

      do i = 1, n
        a(i) = 0
      end do

      return
      end
      subroutine i4vec2_compare ( n, a1, a2, i, j, isgn )

c*********************************************************************72
c
cc I4VEC2_COMPARE compares pairs of integers stored in two vectors.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    03 June 2009
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the number of data items.
c
c    Input, integer A1(N), A2(N), contain the two components
c    of each item.
c
c    Input, integer I, J, the items to be compared.
c
c    Output, integer ISGN, the results of the comparison:
c    -1, item I .lt. item J,
c     0, item I = item J,
c    +1, item J .lt. item I.
c
      implicit none

      integer n

      integer a1(n)
      integer a2(n)
      integer i
      integer isgn
      integer j

      isgn = 0

           if ( a1(i) .lt. a1(j) ) then

        isgn = -1

      else if ( a1(i) .eq. a1(j) ) then

             if ( a2(i) .lt. a2(j) ) then
          isgn = -1
        else if ( a2(i) .lt. a2(j) ) then
          isgn = 0
        else if ( a2(j) .lt. a2(i) ) then
          isgn = +1
        end if

      else if ( a1(j) .lt. a1(i) ) then

        isgn = +1

      end if

      return
      end
      subroutine i4vec2_print ( n, a, b, title )

c*********************************************************************72
c
cc I4VEC2_PRINT prints a pair of integer vectors.
c
c  Discussion:
c
c    An I4VEC2 is a pair of I4VEC's.
c
c    An I4VEC is a vector of I4's.
c
c    Entry K of an I4VEC2 is the pair of values located
c    at the K-th entries of the two I4VEC's.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    27 July 2010
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the number of components of the vector.
c
c    Input, integer A(N), B(N), the vectors to be printed.
c
c    Input, character * ( * ) TITLE, a title.
c
      implicit none

      integer n

      integer a(n)
      integer b(n)
      integer i
      character * ( * )  title

      write ( *, '(a)' ) ' '
      write ( *, '(a)' ) trim ( title )
      write ( *, '(a)' ) ' '
      do i = 1, n
        write ( *, '(2x,i8,a,1x,i10,2x,i10)' ) i, ':', a(i), b(i)
      end do

      return
      end
      subroutine i4vec2_sort_a ( n, a1, a2 )

c*********************************************************************72
c
cc I4VEC2_SORT_A ascending sorts a vector of pairs of integers.
c
c  Discussion:
c
c    Each item to be sorted is a pair of integers (I,J), with the I
c    and J values stored in separate vectors A1 and A2.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    03 June 2009
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the number of items of data.
c
c    Input/output, integer A1(N), A2(N), the data to be sorted.
c
      implicit none

      integer n

      integer a1(n)
      integer a2(n)
      integer i
      integer indx
      integer isgn
      integer j
      integer temp

      if ( n .le. 1 ) then
        return
      end if
c
c  Initialize.
c
      i = 0
      indx = 0
      isgn = 0
      j = 0
c
c  Call the external heap sorter.
c
10    continue

        call sort_heap_external ( n, indx, i, j, isgn )
c
c  Interchange the I and J objects.
c
        if ( 0 .lt. indx ) then

          temp  = a1(i)
          a1(i) = a1(j)
          a1(j) = temp

          temp  = a2(i)
          a2(i) = a2(j)
          a2(j) = temp
c
c  Compare the I and J objects.
c
        else if ( indx .lt. 0 ) then

          call i4vec2_compare ( n, a1, a2, i, j, isgn )

        else if ( indx .eq. 0 ) then

          go to 20

        end if

      go to 10

20    continue

      return
      end
      subroutine i4vec2_sort_d ( n, a1, a2 )

c*********************************************************************72
c
cc I4VEC2_SORT_D descending sorts a vector of pairs of integers.
c
c  Discussion:
c
c    An I4VEC2 is a pair of I4VEC's.
c
c    An I4VEC is a vector of I4's.
c
c    Entry K of an I4VEC2 is the pair of values located
c    at the K-th entries of the two I4VEC's.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    27 July 2010
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the number of items of data.
c
c    Input/output, integer A1(N), A2(N), the data to be sorted.
c
      implicit none

      integer n

      integer a1(n)
      integer a2(n)
      integer i
      integer indx
      integer isgn
      integer j
      integer t

      if ( n .le. 1 ) then
       return
      end if
c
c  Initialize.
c
      i = 0
      indx = 0
      isgn = 0
      j = 0
c
c  Call the external heap sorter.
c
10    continue

        call sort_heap_external ( n, indx, i, j, isgn )
c
c  Interchange the I and J objects.
c
        if ( 0 .lt. indx ) then

          t     = a1(i)
          a1(i) = a1(j)
          a1(j) = t

          t     = a2(i)
          a2(i) = a2(j)
          a2(j) = t
c
c  Compare the I and J objects.
c
        else if ( indx .lt. 0 ) then

          call i4vec2_compare ( n, a1, a2, i, j, isgn )
          isgn = -isgn

        else if ( indx .eq. 0 ) then

          go to 20

        end if

      go to 10

20    continue

      return
      end
      subroutine i4vec2_sorted_unique ( n, a1, a2, unique_num )

c*********************************************************************72
c
cc I4VEC2_SORTED_UNIQUE gets the unique elements in a sorted I4VEC2.
c
c  Discussion:
c
c    Item I is stored as the pair A1(I), A2(I).
c
c    The items must have been sorted, or at least it must be the
c    case that equal items are stored in adjacent vector locations.
c
c    If the items were not sorted, then this routine will only
c    replace a string of equal values by a single representative.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    03 June 2009
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the number of items.
c
c    Input/output, integer A1(N), A2(N).
c    On input, the array of N items.
c    On output, an array of unique items.
c
c    Output, integer UNIQUE_NUM, the number of unique items.
c
      implicit none

      integer n

      integer a1(n)
      integer a2(n)
      integer itest
      integer unique_num

      unique_num = 0

      if ( n .le. 0 ) then
        return
      end if

      unique_num = 1

      do itest = 2, n

        if ( a1(itest) .ne. a1(unique_num) .or.
     &       a2(itest) .ne. a2(unique_num) ) then

          unique_num = unique_num + 1

          a1(unique_num) = a1(itest)
          a2(unique_num) = a2(itest)

        end if

      end do

      return
      end
      subroutine i4vec2_sorted_unique_count ( n, a1, a2, unique_num )

c*********************************************************************72
c
cc I4VEC2_SORTED_UNIQUE_COUNT counts unique elements in a sorted I4VEC2.
c
c  Discussion:
c
c    Item I is stored as the pair A1(I), A2(I).
c
c    The items must have been sorted, or at least it must be the
c    case that equal items are stored in adjacent vector locations.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    14 July 2014
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the number of items.
c
c    Input, integer A1(N), A2(N), the items.
c
c    Output, integer UNIQUE_NUM, the number of unique items.
c
      implicit none

      integer n

      integer a1(n)
      integer a2(n)
      integer i
      integer iu
      integer unique_num

      unique_num = 0

      if ( n .le. 0 ) then
        return
      end if

      iu = 1
      unique_num = 1

      do i = 2, n

        if ( a1(i) .ne. a1(iu) .or.
     &       a2(i) .ne. a2(iu) ) then
          iu = i
          unique_num = unique_num + 1
        end if

      end do

      return
      end
      function l4_to_i4 ( l )

c*********************************************************************72
c
cc L4_TO_I4 converts an L4 to an I4.
c
c  Discussion:
c
c    0 is FALSE, and anything else if TRUE.
c
c    An L4 is a logical value.
c    An I4 is an integer value.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    10 January 2012
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, logical L, a logical value.
c
c    Output, integer L4_TO_I4, the integer value of L.
c
      implicit none

      logical l
      integer l4_to_i4
      integer value

      if ( l ) then
        value = 1
      else
        value = 0
      end if

      l4_to_i4 = value

      return
      end
      function l4_xor ( l1, l2 )

c*********************************************************************72
c
cc L4_XOR returns the exclusive OR of two L4's.
c
c  Discussion:
c
c    An L4 is a logical value.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    04 May 2014
c
c  Author:
c
c   John Burkardt
c
c  Parameters:
c
c    Input, logical L1, L2, two values whose exclusive OR is needed.
c
c    Output, logical L4_XOR, the exclusive OR of L1 and L2.
c
      implicit none

      logical l1
      logical l2
      logical l4_xor
      logical value1
      logical value2

      value1 = (         l1   .and. ( .not. l2 ) )
      value2 = ( ( .not. l1 ) .and.         l2   )

      l4_xor = ( value1 .or. value2 )

      return
      end
      subroutine pascal_to_i4 ( i, j, k )

c*********************************************************************72
c
cc PASCAL_TO_I4 converts Pacal triangle coordinates to a linear index.
c
c  Discussion:
c
c    We describe the grid points in a Pascal triangle in two ways:
c
c    As a linear index K:
c
c                     1
c                   2   3
c                 4   5   6
c               7   8   9   10
c
c    As elements (I,J) of Pascal's triangle:
c
c                     0,0
c                  1,0   0,1
c               2,0   1,1    0,2
c            3,0   2,1   1,2    0,3
c
c  Example:
c
c     K  I  J
c
c     1  0  0
c     2  1  0
c     3  0  1
c     4  2  0
c     5  1  1
c     6  0  2
c     7  3  0
c     8  2  1
c     9  1  2
c    10  0  3
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    14 April 2015
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer I, J, the row and column indices.  I and J 
c    must be nonnegative.
c
c    Output, integer K, the linear index of the (I,J) element.
c
      implicit none

      integer d
      integer i
      integer j
      integer k

      if ( i .lt. 0 ) then
        write ( *, '(a)' ) ' '
        write ( *, '(a)' ) 'PASCAL_TO_I4 - Fatal error!'
        write ( *, '(a)' ) '  I < 0.'
        write ( *, '(a,i8)' ) '  I = ', i
        stop 1
      else if ( j .lt. 0 ) then
        write ( *, '(a)' ) ' '
        write ( *, '(a)' ) 'PASCAL_TO_I4 - Fatal error!'
        write ( *, '(a)' ) '  J < 0.'
        write ( *, '(a,i8)' ) '  J = ', j
        stop 1
      end if

      d = i + j

      k = ( d * ( d + 1 ) ) / 2 + j + 1

      return
      end
      subroutine perm_check0 ( n, p )

c*********************************************************************72
c
cc PERM_CHECK0 checks a 0-based permutation.
c
c  Discussion:
c
c    The routine verifies that each of the integers from 0 to
c    to N-1 occurs among the N entries of the permutation.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    24 October 2014
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the number of entries.
c
c    Input, integer P(N), the array to check.
c
      implicit none

      integer n

      integer ierror
      integer location
      integer p(n)
      integer value

      do value = 0, n - 1

        ierror = 1

        do location = 1, n
          if ( p(location) .eq. value ) then
            ierror = 0
            go to 10
          end if
        end do

10      continue

        if ( ierror .ne. 0 ) then
          write ( *, '(a)' ) ' '
          write ( *, '(a)' ) 'PERM_CHECK0 - Fatal error!'
          write ( *, '(a,i4)' ) '  Permutation is missing value ', value
          stop 1
        end if

      end do

      return
      end
      subroutine perm_check1 ( n, p )

c*********************************************************************72
c
cc PERM_CHECK1 checks a 1-based permutation.
c
c  Discussion:
c
c    The routine verifies that each of the integers from 1 to
c    to N occurs among the N entries of the permutation.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    24 October 2014
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the number of entries.
c
c    Input, integer P(N), the array to check.
c
      implicit none

      integer n

      integer ierror
      integer location
      integer p(n)
      integer value

      do value = 1, n

        ierror = 1

        do location = 1, n
          if ( p(location) .eq. value ) then
            ierror = 0
            go to 10
          end if
        end do

10      continue

        if ( ierror .ne. 0 ) then
          write ( *, '(a)' ) ' '
          write ( *, '(a)' ) 'PERM_CHECK1 - Fatal error!'
          write ( *, '(a,i4)' ) '  Permutation is missing value ', value
          stop 1
        end if

      end do

      return
      end
      subroutine perm_cycle ( n, iopt, p, isgn, ncycle )

c*********************************************************************72
c
cc PERM_CYCLE analyzes a permutation.
c
c  Discussion:
c
c    The routine will count cycles, find the sign of a permutation,
c    and tag a permutation.
c
c  Example:
c
c    Input:
c
c      N = 9
c      IOPT = 1
c      P = 2, 3, 9, 6, 7, 8, 5, 4, 1
c
c    Output:
c
c      NCYCLE = 3
c      ISGN = +1
c      P = -2, 3, 9, -6, -7, 8, 5, 4, 1
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    25 January 2007
c
c  Author:
c
c    Original FORTRAN77 version by Albert Nijenhuis, Herbert Wilf.
c    This FORTRAN77 version by John Burkardt.
c
c  Reference:
c
c    Albert Nijenhuis, Herbert Wilf,
c    Combinatorial Algorithms for Computers and Calculators,
c    Academic Press, 1978,
c    ISBN: 0-12-519260-6,
c    LC: QA164.N54.
c
c  Parameters:
c
c    Input, integer N, the number of objects being permuted.
c
c    Input, integer IOPT, requests tagging.
c    0, the permutation will not be tagged.
c    1, the permutation will be tagged.
c
c    Input/output, integer P(N).  On input, P describes a
c    permutation, in the sense that entry I is to be moved to P(I).
c    If IOPT = 0, then P will not be changed by this routine.
c    If IOPT = 1, then on output, P will be "tagged".  That is,
c    one element of every cycle in P will be negated.  In this way,
c    a user can traverse a cycle by starting at any entry I1 of P
c    which is negative, moving to I2 = ABS(P(I1)), then to
c    P(I2), and so on, until returning to I1.
c
c    Output, integer ISGN, the "sign" of the permutation, which is
c    +1 if the permutation is even, -1 if odd.  Every permutation
c    may be produced by a certain number of pairwise switches.
c    If the number of switches is even, the permutation itself is
c    called even.
c
c    Output, integer NCYCLE, the number of cycles in the permutation.
c
      implicit none

      integer n

      integer i
      integer i1
      integer i2
      integer ierror
      integer iopt
      integer is
      integer isgn
      integer ncycle
      integer p(n)

      call perm_check1 ( n, p )

      is = 1
      ncycle = n

      do i = 1, n

        i1 = p(i)

10      continue

        if ( i .lt. i1 ) then
          ncycle = ncycle - 1
          i2 = p(i1)
          p(i1) = -i2
          i1 = i2
          go to 10
        end if

        if ( iopt .ne. 0 ) then
          is = -sign ( 1, p(i) )
        end if

        p(i) = sign ( p(i), is )

      end do

      isgn = 1 - 2 * mod ( n - ncycle, 2 )

      return
      end
      subroutine perm_uniform ( n, seed, p )

c*********************************************************************72
c
cc PERM_UNIFORM selects a random permutation of N objects.
c
c  Discussion:
c
c    The routine assumes the objects are labeled 1, 2, ... N.
c
c    The algorithm is known as the Fisher-Yates or Knuth shuffle.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    12 November 2014
c
c  Author:
c
c    John Burkardt
c
c  Reference:
c
c    Albert Nijenhuis, Herbert Wilf,
c    Combinatorial Algorithms for Computers and Calculators,
c    Academic Press, 1978,
c    ISBN: 0-12-519260-6,
c    LC: QA164.N54.
c
c  Parameters:
c
c    Input, integer N, the number of objects to be permuted.
c
c    Input/output, integer SEED, a seed for the random number generator.
c
c    Output, integer P(N), a permutation of ( 1, 2, ..., N ), in standard
c    index form.
c
      implicit none

      integer n

      integer i
      integer i4_uniform_ab
      integer j
      integer p(n)
      integer pk
      integer seed

      do i = 1, n
        p(i) = i
      end do

      do i = 1, n - 1
        j = i4_uniform_ab ( i, n, seed )
        pk = p(i)
        p(i) = p(j)
        p(j) = pk
      end do

      return
      end
      function prime ( n )

c*********************************************************************72
c
cc PRIME returns any of the first PRIME_MAX prime numbers.
c
c  Discussion:
c
c    PRIME_MAX is 1600, and the largest prime stored is 13499.
c
c    Thanks to Bart Vandewoestyne for pointing out a typo, 18 February 2005.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    21 January 2007
c
c  Author:
c
c    John Burkardt
c
c  Reference:
c
c    Milton Abramowitz, Irene Stegun,
c    Handbook of Mathematical Functions,
c    National Bureau of Standards, 1964,
c    ISBN: 0-486-61272-4,
c    LC: QA47.A34.
c
c    Daniel Zwillinger,
c    CRC Standard Mathematical Tables and Formulae,
c    30th Edition,
c    CRC Press, 1996, pages 95-98.
c
c  Parameters:
c
c    Input, integer N, the index of the desired prime number.
c    In general, is should be true that 0 <= N <= PRIME_MAX.
c    N = -1 returns PRIME_MAX, the index of the largest prime available.
c    N = 0 is legal, returning PRIME = 1.
c
c    Output, integer PRIME, the N-th prime.  If N is out of range,
c    PRIME is returned as -1.
c
      implicit none

      integer prime_max
      parameter ( prime_max = 1600 )

      integer i
      integer n
      integer npvec(prime_max)
      integer prime

      save npvec

      data ( npvec(i), i = 1, 100 ) /
     &      2,    3,    5,    7,   11,   13,   17,   19,   23,   29,
     &     31,   37,   41,   43,   47,   53,   59,   61,   67,   71,
     &     73,   79,   83,   89,   97,  101,  103,  107,  109,  113,
     &    127,  131,  137,  139,  149,  151,  157,  163,  167,  173,
     &    179,  181,  191,  193,  197,  199,  211,  223,  227,  229,
     &    233,  239,  241,  251,  257,  263,  269,  271,  277,  281,
     &    283,  293,  307,  311,  313,  317,  331,  337,  347,  349,
     &    353,  359,  367,  373,  379,  383,  389,  397,  401,  409,
     &    419,  421,  431,  433,  439,  443,  449,  457,  461,  463,
     &    467,  479,  487,  491,  499,  503,  509,  521,  523,  541 /

      data ( npvec(i), i = 101, 200 ) /
     &    547,  557,  563,  569,  571,  577,  587,  593,  599,  601,
     &    607,  613,  617,  619,  631,  641,  643,  647,  653,  659,
     &    661,  673,  677,  683,  691,  701,  709,  719,  727,  733,
     &    739,  743,  751,  757,  761,  769,  773,  787,  797,  809,
     &    811,  821,  823,  827,  829,  839,  853,  857,  859,  863,
     &    877,  881,  883,  887,  907,  911,  919,  929,  937,  941,
     &    947,  953,  967,  971,  977,  983,  991,  997, 1009, 1013,
     &   1019, 1021, 1031, 1033, 1039, 1049, 1051, 1061, 1063, 1069,
     &   1087, 1091, 1093, 1097, 1103, 1109, 1117, 1123, 1129, 1151,
     &   1153, 1163, 1171, 1181, 1187, 1193, 1201, 1213, 1217, 1223 /

      data ( npvec(i), i = 201, 300 ) /
     &   1229, 1231, 1237, 1249, 1259, 1277, 1279, 1283, 1289, 1291,
     &   1297, 1301, 1303, 1307, 1319, 1321, 1327, 1361, 1367, 1373,
     &   1381, 1399, 1409, 1423, 1427, 1429, 1433, 1439, 1447, 1451,
     &   1453, 1459, 1471, 1481, 1483, 1487, 1489, 1493, 1499, 1511,
     &   1523, 1531, 1543, 1549, 1553, 1559, 1567, 1571, 1579, 1583,
     &   1597, 1601, 1607, 1609, 1613, 1619, 1621, 1627, 1637, 1657,
     &   1663, 1667, 1669, 1693, 1697, 1699, 1709, 1721, 1723, 1733,
     &   1741, 1747, 1753, 1759, 1777, 1783, 1787, 1789, 1801, 1811,
     &   1823, 1831, 1847, 1861, 1867, 1871, 1873, 1877, 1879, 1889,
     &   1901, 1907, 1913, 1931, 1933, 1949, 1951, 1973, 1979, 1987 /

      data ( npvec(i), i = 301, 400 ) /
     &   1993, 1997, 1999, 2003, 2011, 2017, 2027, 2029, 2039, 2053,
     &   2063, 2069, 2081, 2083, 2087, 2089, 2099, 2111, 2113, 2129,
     &   2131, 2137, 2141, 2143, 2153, 2161, 2179, 2203, 2207, 2213,
     &   2221, 2237, 2239, 2243, 2251, 2267, 2269, 2273, 2281, 2287,
     &   2293, 2297, 2309, 2311, 2333, 2339, 2341, 2347, 2351, 2357,
     &   2371, 2377, 2381, 2383, 2389, 2393, 2399, 2411, 2417, 2423,
     &   2437, 2441, 2447, 2459, 2467, 2473, 2477, 2503, 2521, 2531,
     &   2539, 2543, 2549, 2551, 2557, 2579, 2591, 2593, 2609, 2617,
     &   2621, 2633, 2647, 2657, 2659, 2663, 2671, 2677, 2683, 2687,
     &   2689, 2693, 2699, 2707, 2711, 2713, 2719, 2729, 2731, 2741 /

      data ( npvec(i), i = 401, 500 ) /
     &   2749, 2753, 2767, 2777, 2789, 2791, 2797, 2801, 2803, 2819,
     &   2833, 2837, 2843, 2851, 2857, 2861, 2879, 2887, 2897, 2903,
     &   2909, 2917, 2927, 2939, 2953, 2957, 2963, 2969, 2971, 2999,
     &   3001, 3011, 3019, 3023, 3037, 3041, 3049, 3061, 3067, 3079,
     &   3083, 3089, 3109, 3119, 3121, 3137, 3163, 3167, 3169, 3181,
     &   3187, 3191, 3203, 3209, 3217, 3221, 3229, 3251, 3253, 3257,
     &   3259, 3271, 3299, 3301, 3307, 3313, 3319, 3323, 3329, 3331,
     &   3343, 3347, 3359, 3361, 3371, 3373, 3389, 3391, 3407, 3413,
     &   3433, 3449, 3457, 3461, 3463, 3467, 3469, 3491, 3499, 3511,
     &   3517, 3527, 3529, 3533, 3539, 3541, 3547, 3557, 3559, 3571 /

      data ( npvec(i), i = 501, 600 ) /
     &   3581, 3583, 3593, 3607, 3613, 3617, 3623, 3631, 3637, 3643,
     &   3659, 3671, 3673, 3677, 3691, 3697, 3701, 3709, 3719, 3727,
     &   3733, 3739, 3761, 3767, 3769, 3779, 3793, 3797, 3803, 3821,
     &   3823, 3833, 3847, 3851, 3853, 3863, 3877, 3881, 3889, 3907,
     &   3911, 3917, 3919, 3923, 3929, 3931, 3943, 3947, 3967, 3989,
     &   4001, 4003, 4007, 4013, 4019, 4021, 4027, 4049, 4051, 4057,
     &   4073, 4079, 4091, 4093, 4099, 4111, 4127, 4129, 4133, 4139,
     &   4153, 4157, 4159, 4177, 4201, 4211, 4217, 4219, 4229, 4231,
     &   4241, 4243, 4253, 4259, 4261, 4271, 4273, 4283, 4289, 4297,
     &   4327, 4337, 4339, 4349, 4357, 4363, 4373, 4391, 4397, 4409 /

      data ( npvec(i), i = 601, 700 ) /
     &   4421, 4423, 4441, 4447, 4451, 4457, 4463, 4481, 4483, 4493,
     &   4507, 4513, 4517, 4519, 4523, 4547, 4549, 4561, 4567, 4583,
     &   4591, 4597, 4603, 4621, 4637, 4639, 4643, 4649, 4651, 4657,
     &   4663, 4673, 4679, 4691, 4703, 4721, 4723, 4729, 4733, 4751,
     &   4759, 4783, 4787, 4789, 4793, 4799, 4801, 4813, 4817, 4831,
     &   4861, 4871, 4877, 4889, 4903, 4909, 4919, 4931, 4933, 4937,
     &   4943, 4951, 4957, 4967, 4969, 4973, 4987, 4993, 4999, 5003,
     &   5009, 5011, 5021, 5023, 5039, 5051, 5059, 5077, 5081, 5087,
     &   5099, 5101, 5107, 5113, 5119, 5147, 5153, 5167, 5171, 5179,
     &   5189, 5197, 5209, 5227, 5231, 5233, 5237, 5261, 5273, 5279 /

      data ( npvec(i), i = 701, 800 ) /
     &   5281, 5297, 5303, 5309, 5323, 5333, 5347, 5351, 5381, 5387,
     &   5393, 5399, 5407, 5413, 5417, 5419, 5431, 5437, 5441, 5443,
     &   5449, 5471, 5477, 5479, 5483, 5501, 5503, 5507, 5519, 5521,
     &   5527, 5531, 5557, 5563, 5569, 5573, 5581, 5591, 5623, 5639,
     &   5641, 5647, 5651, 5653, 5657, 5659, 5669, 5683, 5689, 5693,
     &   5701, 5711, 5717, 5737, 5741, 5743, 5749, 5779, 5783, 5791,
     &   5801, 5807, 5813, 5821, 5827, 5839, 5843, 5849, 5851, 5857,
     &   5861, 5867, 5869, 5879, 5881, 5897, 5903, 5923, 5927, 5939,
     &   5953, 5981, 5987, 6007, 6011, 6029, 6037, 6043, 6047, 6053,
     &   6067, 6073, 6079, 6089, 6091, 6101, 6113, 6121, 6131, 6133 /

      data ( npvec(i), i = 801, 900 ) /
     &   6143, 6151, 6163, 6173, 6197, 6199, 6203, 6211, 6217, 6221,
     &   6229, 6247, 6257, 6263, 6269, 6271, 6277, 6287, 6299, 6301,
     &   6311, 6317, 6323, 6329, 6337, 6343, 6353, 6359, 6361, 6367,
     &   6373, 6379, 6389, 6397, 6421, 6427, 6449, 6451, 6469, 6473,
     &   6481, 6491, 6521, 6529, 6547, 6551, 6553, 6563, 6569, 6571,
     &   6577, 6581, 6599, 6607, 6619, 6637, 6653, 6659, 6661, 6673,
     &   6679, 6689, 6691, 6701, 6703, 6709, 6719, 6733, 6737, 6761,
     &   6763, 6779, 6781, 6791, 6793, 6803, 6823, 6827, 6829, 6833,
     &   6841, 6857, 6863, 6869, 6871, 6883, 6899, 6907, 6911, 6917,
     &   6947, 6949, 6959, 6961, 6967, 6971, 6977, 6983, 6991, 6997 /

      data ( npvec(i), i = 901, 1000 ) /
     &   7001, 7013, 7019, 7027, 7039, 7043, 7057, 7069, 7079, 7103,
     &   7109, 7121, 7127, 7129, 7151, 7159, 7177, 7187, 7193, 7207,
     &   7211, 7213, 7219, 7229, 7237, 7243, 7247, 7253, 7283, 7297,
     &   7307, 7309, 7321, 7331, 7333, 7349, 7351, 7369, 7393, 7411,
     &   7417, 7433, 7451, 7457, 7459, 7477, 7481, 7487, 7489, 7499,
     &   7507, 7517, 7523, 7529, 7537, 7541, 7547, 7549, 7559, 7561,
     &   7573, 7577, 7583, 7589, 7591, 7603, 7607, 7621, 7639, 7643,
     &   7649, 7669, 7673, 7681, 7687, 7691, 7699, 7703, 7717, 7723,
     &   7727, 7741, 7753, 7757, 7759, 7789, 7793, 7817, 7823, 7829,
     &   7841, 7853, 7867, 7873, 7877, 7879, 7883, 7901, 7907, 7919 /

      data ( npvec(i), i = 1001, 1100 ) /
     &   7927, 7933, 7937, 7949, 7951, 7963, 7993, 8009, 8011, 8017,
     &   8039, 8053, 8059, 8069, 8081, 8087, 8089, 8093, 8101, 8111,
     &   8117, 8123, 8147, 8161, 8167, 8171, 8179, 8191, 8209, 8219,
     &   8221, 8231, 8233, 8237, 8243, 8263, 8269, 8273, 8287, 8291,
     &   8293, 8297, 8311, 8317, 8329, 8353, 8363, 8369, 8377, 8387,
     &   8389, 8419, 8423, 8429, 8431, 8443, 8447, 8461, 8467, 8501,
     &   8513, 8521, 8527, 8537, 8539, 8543, 8563, 8573, 8581, 8597,
     &   8599, 8609, 8623, 8627, 8629, 8641, 8647, 8663, 8669, 8677,
     &   8681, 8689, 8693, 8699, 8707, 8713, 8719, 8731, 8737, 8741,
     &   8747, 8753, 8761, 8779, 8783, 8803, 8807, 8819, 8821, 8831 /

      data ( npvec(i), i = 1101, 1200 ) /
     &   8837, 8839, 8849, 8861, 8863, 8867, 8887, 8893, 8923, 8929,
     &   8933, 8941, 8951, 8963, 8969, 8971, 8999, 9001, 9007, 9011,
     &   9013, 9029, 9041, 9043, 9049, 9059, 9067, 9091, 9103, 9109,
     &   9127, 9133, 9137, 9151, 9157, 9161, 9173, 9181, 9187, 9199,
     &   9203, 9209, 9221, 9227, 9239, 9241, 9257, 9277, 9281, 9283,
     &   9293, 9311, 9319, 9323, 9337, 9341, 9343, 9349, 9371, 9377,
     &   9391, 9397, 9403, 9413, 9419, 9421, 9431, 9433, 9437, 9439,
     &   9461, 9463, 9467, 9473, 9479, 9491, 9497, 9511, 9521, 9533,
     &   9539, 9547, 9551, 9587, 9601, 9613, 9619, 9623, 9629, 9631,
     &   9643, 9649, 9661, 9677, 9679, 9689, 9697, 9719, 9721, 9733 /

      data ( npvec(i), i = 1201, 1300 ) /
     &   9739, 9743, 9749, 9767, 9769, 9781, 9787, 9791, 9803, 9811,
     &   9817, 9829, 9833, 9839, 9851, 9857, 9859, 9871, 9883, 9887,
     &   9901, 9907, 9923, 9929, 9931, 9941, 9949, 9967, 9973,10007,
     &  10009,10037,10039,10061,10067,10069,10079,10091,10093,10099,
     &  10103,10111,10133,10139,10141,10151,10159,10163,10169,10177,
     &  10181,10193,10211,10223,10243,10247,10253,10259,10267,10271,
     &  10273,10289,10301,10303,10313,10321,10331,10333,10337,10343,
     &  10357,10369,10391,10399,10427,10429,10433,10453,10457,10459,
     &  10463,10477,10487,10499,10501,10513,10529,10531,10559,10567,
     &  10589,10597,10601,10607,10613,10627,10631,10639,10651,10657 /

      data ( npvec(i), i = 1301, 1400 ) /
     &  10663,10667,10687,10691,10709,10711,10723,10729,10733,10739,
     &  10753,10771,10781,10789,10799,10831,10837,10847,10853,10859,
     &  10861,10867,10883,10889,10891,10903,10909,10937,10939,10949,
     &  10957,10973,10979,10987,10993,11003,11027,11047,11057,11059,
     &  11069,11071,11083,11087,11093,11113,11117,11119,11131,11149,
     &  11159,11161,11171,11173,11177,11197,11213,11239,11243,11251,
     &  11257,11261,11273,11279,11287,11299,11311,11317,11321,11329,
     &  11351,11353,11369,11383,11393,11399,11411,11423,11437,11443,
     &  11447,11467,11471,11483,11489,11491,11497,11503,11519,11527,
     &  11549,11551,11579,11587,11593,11597,11617,11621,11633,11657 /

      data ( npvec(i), i = 1401, 1500 ) /
     &  11677,11681,11689,11699,11701,11717,11719,11731,11743,11777,
     &  11779,11783,11789,11801,11807,11813,11821,11827,11831,11833,
     &  11839,11863,11867,11887,11897,11903,11909,11923,11927,11933,
     &  11939,11941,11953,11959,11969,11971,11981,11987,12007,12011,
     &  12037,12041,12043,12049,12071,12073,12097,12101,12107,12109,
     &  12113,12119,12143,12149,12157,12161,12163,12197,12203,12211,
     &  12227,12239,12241,12251,12253,12263,12269,12277,12281,12289,
     &  12301,12323,12329,12343,12347,12373,12377,12379,12391,12401,
     &  12409,12413,12421,12433,12437,12451,12457,12473,12479,12487,
     &  12491,12497,12503,12511,12517,12527,12539,12541,12547,12553 /

      data ( npvec(i), i = 1501, 1600 ) /
     &  12569,12577,12583,12589,12601,12611,12613,12619,12637,12641,
     &  12647,12653,12659,12671,12689,12697,12703,12713,12721,12739,
     &  12743,12757,12763,12781,12791,12799,12809,12821,12823,12829,
     &  12841,12853,12889,12893,12899,12907,12911,12917,12919,12923,
     &  12941,12953,12959,12967,12973,12979,12983,13001,13003,13007,
     &  13009,13033,13037,13043,13049,13063,13093,13099,13103,13109,
     &  13121,13127,13147,13151,13159,13163,13171,13177,13183,13187,
     &  13217,13219,13229,13241,13249,13259,13267,13291,13297,13309,
     &  13313,13327,13331,13337,13339,13367,13381,13397,13399,13411,
     &  13417,13421,13441,13451,13457,13463,13469,13477,13487,13499 /

      if ( n .eq. -1 ) then
        prime = prime_max
      else if ( n .eq. 0 ) then
        prime = 1
      else if ( n .le. prime_max ) then
        prime = npvec(n)
      else
        prime = -1
        write ( *, '(a)' ) ' '
        write ( *, '(a)' ) 'PRIME - Fatal error!'
        write ( *, '(a,i8)' ) '  Illegal prime index N = ', n
        write ( *, '(a,i8)' )
     &    '  N should be between 1 and PRIME_MAX =', prime_max
        stop 1
      end if

      return
      end
      function r8_gamma_log ( x )

c*********************************************************************72
c
cc R8_GAMMA_LOG evaluates the logarithm of the gamma function.
c
c  Discussion:
c
c    This routine calculates the LOG(GAMMA) function for a positive real
c    argument X.  Computation is based on an algorithm outlined in
c    references 1 and 2.  The program uses rational functions that
c    theoretically approximate LOG(GAMMA) to at least 18 significant
c    decimal digits.  The approximation for X > 12 is from reference
c    3, while approximations for X < 12.0 are similar to those in
c    reference 1, but are unpublished.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    18 April 2013
c
c  Author:
c
c    Original FORTRAN77 version by William Cody, Laura Stoltz.
c    This FORTRAN77 version by John Burkardt.
c
c  Reference:
c
c    William Cody, Kenneth Hillstrom,
c    Chebyshev Approximations for the Natural Logarithm of the
c    Gamma Function,
c    Mathematics of Computation,
c    Volume 21, Number 98, April 1967, pages 198-203.
c
c    Kenneth Hillstrom,
c    ANL/AMD Program ANLC366S, DGAMMA/DLGAMA,
c    May 1969.
c
c    John Hart, Ward Cheney, Charles Lawson, Hans Maehly,
c    Charles Mesztenyi, John Rice, Henry Thatcher,
c    Christoph Witzgall,
c    Computer Approximations,
c    Wiley, 1968,
c    LC: QA297.C64.
c
c  Parameters:
c
c    Input, double precision X, the argument of the function.
c
c    Output, double precision R8_GAMMA_LOG, the value of the function.
c
      implicit none

      double precision c(7)
      double precision corr
      double precision d1 
      parameter ( d1 = -5.772156649015328605195174D-01 )
      double precision d2
      parameter ( d2 = 4.227843350984671393993777D-01 )
      double precision d4
      parameter ( d4 = 1.791759469228055000094023D+00 )
      double precision frtbig
      parameter ( frtbig = 2.25D+76 )
      integer i
      double precision p1(8)
      double precision p2(8)
      double precision p4(8)
      double precision q1(8)
      double precision q2(8)
      double precision q4(8)
      double precision r8_epsilon
      parameter ( r8_epsilon = 2.220446049250313D-016 )
      double precision r8_gamma_log
      double precision res
      double precision sqrtpi 
      parameter ( sqrtpi = 0.9189385332046727417803297D+00 )
      double precision x
      double precision xbig
      parameter ( xbig = 2.55D+305 )
      double precision xden
      double precision xinf
      parameter ( xinf = 1.79D+308 )
      double precision xm1
      double precision xm2
      double precision xm4
      double precision xnum
      double precision y
      double precision ysq

      save c
      save p1
      save p2
      save p4
      save q1
      save q2
      save q4

      data c /
     &  -1.910444077728D-03, 
     &   8.4171387781295D-04, 
     &  -5.952379913043012D-04, 
     &   7.93650793500350248D-04, 
     &  -2.777777777777681622553D-03, 
     &   8.333333333333333331554247D-02, 
     &   5.7083835261D-03 /
      data p1 /
     &  4.945235359296727046734888D+00, 
     &  2.018112620856775083915565D+02, 
     &  2.290838373831346393026739D+03, 
     &  1.131967205903380828685045D+04, 
     &  2.855724635671635335736389D+04, 
     &  3.848496228443793359990269D+04, 
     &  2.637748787624195437963534D+04, 
     &  7.225813979700288197698961D+03 /
      data p2 /
     &  4.974607845568932035012064D+00, 
     &  5.424138599891070494101986D+02, 
     &  1.550693864978364947665077D+04, 
     &  1.847932904445632425417223D+05, 
     &  1.088204769468828767498470D+06, 
     &  3.338152967987029735917223D+06, 
     &  5.106661678927352456275255D+06, 
     &  3.074109054850539556250927D+06 /
      data p4 /
     &  1.474502166059939948905062D+04, 
     &  2.426813369486704502836312D+06, 
     &  1.214755574045093227939592D+08, 
     &  2.663432449630976949898078D+09, 
     &  2.940378956634553899906876D+10, 
     &  1.702665737765398868392998D+11, 
     &  4.926125793377430887588120D+11, 
     &  5.606251856223951465078242D+11 /
      data q1 /
     &  6.748212550303777196073036D+01, 
     &  1.113332393857199323513008D+03, 
     &  7.738757056935398733233834D+03, 
     &  2.763987074403340708898585D+04, 
     &  5.499310206226157329794414D+04, 
     &  6.161122180066002127833352D+04, 
     &  3.635127591501940507276287D+04, 
     &  8.785536302431013170870835D+03 /
      data q2 /
     &  1.830328399370592604055942D+02, 
     &  7.765049321445005871323047D+03, 
     &  1.331903827966074194402448D+05, 
     &  1.136705821321969608938755D+06, 
     &  5.267964117437946917577538D+06, 
     &  1.346701454311101692290052D+07, 
     &  1.782736530353274213975932D+07, 
     &  9.533095591844353613395747D+06 /
      data q4 /
     &  2.690530175870899333379843D+03, 
     &  6.393885654300092398984238D+05, 
     &  4.135599930241388052042842D+07, 
     &  1.120872109616147941376570D+09, 
     &  1.488613728678813811542398D+10, 
     &  1.016803586272438228077304D+11, 
     &  3.417476345507377132798597D+11, 
     &  4.463158187419713286462081D+11 /

      y = x

      if ( 0.0D+00 .lt. y .and. y .le. xbig ) then

        if ( y .le. r8_epsilon ) then

          res = - log ( y )
c
c  EPS < X <= 1.5.
c
        else if ( y .le. 1.5D+00 ) then

          if ( y .lt. 0.6796875D+00 ) then
            corr = -log ( y )
            xm1 = y
          else
            corr = 0.0D+00
            xm1 = ( y - 0.5D+00 ) - 0.5D+00
          end if

          if ( y .le. 0.5D+00 .or. 0.6796875D+00 .le. y ) then

            xden = 1.0D+00
            xnum = 0.0D+00
            do i = 1, 8
              xnum = xnum * xm1 + p1(i)
              xden = xden * xm1 + q1(i)
            end do

            res = corr + ( xm1 * ( d1 + xm1 * ( xnum / xden ) ) )

          else

            xm2 = ( y - 0.5D+00 ) - 0.5D+00
            xden = 1.0D+00
            xnum = 0.0D+00
            do i = 1, 8
              xnum = xnum * xm2 + p2(i)
              xden = xden * xm2 + q2(i)
            end do

            res = corr + xm2 * ( d2 + xm2 * ( xnum / xden ) )

          end if
c
c  1.5 < X <= 4.0.
c
        else if ( y .le. 4.0D+00 ) then

          xm2 = y - 2.0D+00
          xden = 1.0D+00
          xnum = 0.0D+00
          do i = 1, 8
            xnum = xnum * xm2 + p2(i)
            xden = xden * xm2 + q2(i)
          end do

          res = xm2 * ( d2 + xm2 * ( xnum / xden ) )
c
c  4.0 < X <= 12.0.
c
        else if ( y .le. 12.0D+00 ) then

          xm4 = y - 4.0D+00
          xden = -1.0D+00
          xnum = 0.0D+00
          do i = 1, 8
            xnum = xnum * xm4 + p4(i)
            xden = xden * xm4 + q4(i)
          end do

          res = d4 + xm4 * ( xnum / xden )
c
c  Evaluate for 12 <= argument.
c
        else

          res = 0.0D+00

          if ( y .le. frtbig ) then

            res = c(7)
            ysq = y * y

            do i = 1, 6
              res = res / ysq + c(i)
            end do

          end if

          res = res / y
          corr = log ( y )
          res = res + sqrtpi - 0.5D+00 * corr
          res = res + y * ( corr - 1.0D+00 )

        end if
c
c  Return for bad arguments.
c
      else

        res = xinf

      end if
c
c  Final adjustments and return.
c
      r8_gamma_log = res

      return
      end
      function r8_uniform_ab ( a, b, seed )

c*********************************************************************72
c
cc R8_UNIFORM_AB returns a pseudorandom R8 scaled to [A,B].
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    06 January 2006
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, double precision A, B, the limits of the interval.
c
c    Input/output, integer SEED, the "seed" value, which should NOT be 0.
c    On output, SEED has been updated.
c
c    Output, double precision R8_UNIFORM_AB, a number strictly between A and B.
c
      implicit none

      double precision a
      double precision b
      integer i4_huge
      parameter ( i4_huge = 2147483647 )
      integer k
      double precision r8_uniform_ab
      integer seed

      if ( seed .eq. 0 ) then
        write ( *, '(a)' ) ' '
        write ( *, '(a)' ) 'R8_UNIFORM_AB - Fatal error!'
        write ( *, '(a)' ) '  Input value of SEED = 0.'
        stop 1
      end if

      k = seed / 127773

      seed = 16807 * ( seed - k * 127773 ) - k * 2836

      if ( seed .lt. 0 ) then
        seed = seed + i4_huge
      end if

      r8_uniform_ab = a + ( b - a ) * dble ( seed ) * 4.656612875D-10

      return
      end
      subroutine r8vec_print ( n, a, title )

c*********************************************************************72
c
cc R8VEC_PRINT prints an R8VEC.
c
c  Discussion:
c
c    An R8VEC is a vector of R8's.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    12 January 2007
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the number of components of the vector.
c
c    Input, double precision A(N), the vector to be printed.
c
c    Input, character * ( * ) TITLE, a title.
c
      implicit none

      integer n

      double precision a(n)
      integer i
      character * ( * ) title

      write ( *, '(a)' ) ' '
      write ( *, '(a)' ) trim ( title )
      write ( *, '(a)' ) ' '
      do i = 1, n
        write ( *, '(2x,i8,a,1x,g16.8)' ) i, ':', a(i)
      end do

      return
      end
      subroutine sort_heap_external ( n, indx, i, j, isgn )

c*********************************************************************72
c
cc SORT_HEAP_EXTERNAL externally sorts a list of items into ascending order.
c
c  Discussion:
c
c    The actual list of data is not passed to the routine.  Hence this
c    routine may be used to sort integers, reals, numbers, names,
c    dates, shoe sizes, and so on.  After each call, the routine asks
c    the user to compare or interchange two items, until a special
c    return value signals that the sorting is completed.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    25 January 2007
c
c  Author:
c
c    Original FORTRAN77 version by Albert Nijenhuis, Herbert Wilf.
c    This FORTRAN77 version by John Burkardt.
c
c  Reference:
c
c    Albert Nijenhuis, Herbert Wilf,
c    Combinatorial Algorithms for Computers and Calculators,
c    Academic Press, 1978,
c    ISBN: 0-12-519260-6,
c    LC: QA164.N54.
c
c  Parameters:
c
c    Input, integer N, the number of items to be sorted.
c
c    Input/output, integer INDX, the main communication signal.
c
c    The user must set INDX to 0 before the first call.
c    Thereafter, the user should not change the value of INDX until
c    the sorting is done.
c
c    On return, if INDX is
c
c      greater than 0,
c      * interchange items I and J;
c      * call again.
c
c      less than 0,
c      * compare items I and J;
c      * set ISGN = -1 if I .lt. J, ISGN = +1 if J .lt. I;
c      * call again.
c
c      equal to 0, the sorting is done.
c
c    Output, integer I, J, the indices of two items.
c    On return with INDX positive, elements I and J should be interchanged.
c    On return with INDX negative, elements I and J should be compared, and
c    the result reported in ISGN on the next call.
c
c    Input, integer ISGN, results of comparison of elements I and J.
c    (Used only when the previous call returned INDX less than 0).
c    ISGN .le. 0 means I is less than or equal to J;
c    0 .le. ISGN means I is greater than or equal to J.
c
      implicit none

      integer i
      integer i_save
      integer indx
      integer isgn
      integer j
      integer j_save
      integer k
      integer k1
      integer n
      integer n1

      save i_save
      save j_save
      save k
      save k1
      save n1

      data i_save / 0 /
      data j_save / 0 /
      data k / 0 /
      data k1 / 0 /
      data n1 / 0 /
c
c  INDX = 0: This is the first call.
c
      if ( indx .eq. 0 ) then

        i_save = 0
        j_save = 0
        k = n / 2
        k1 = k
        n1 = n
c
c  INDX .lt. 0: The user is returning the results of a comparison.
c
      else if ( indx .lt. 0 ) then

        if ( indx .eq. -2 ) then

          if ( isgn .lt. 0 ) then
            i_save = i_save + 1
          end if

          j_save = k1
          k1 = i_save
          indx = -1
          i = i_save
          j = j_save
          return

        end if

        if ( 0 .lt. isgn ) then
          indx = 2
          i = i_save
          j = j_save
          return
        end if

        if ( k .le. 1 ) then

          if ( n1 .eq. 1 ) then
            i_save = 0
            j_save = 0
            indx = 0
          else
            i_save = n1
            n1 = n1 - 1
            j_save = 1
            indx = 1
          end if

          i = i_save
          j = j_save
          return

        end if

        k = k - 1
        k1 = k
c
c  0 .lt. INDX, the user was asked to make an interchange.
c
      else if ( indx .eq. 1 ) then

        k1 = k

      end if

10    continue

        i_save = 2 * k1

        if ( i_save .eq. n1 ) then
          j_save = k1
          k1 = i_save
          indx = -1
          i = i_save
          j = j_save
          return
        else if ( i_save .le. n1 ) then
          j_save = i_save + 1
          indx = -2
          i = i_save
          j = j_save
          return
        end if

        if ( k .le. 1 ) then
          go to 20
        end if

        k = k - 1
        k1 = k

      go to 10

20    continue

      if ( n1 .eq. 1 ) then
        i_save = 0
        j_save = 0
        indx = 0
        i = i_save
        j = j_save
      else
        i_save = n1
        n1 = n1 - 1
        j_save = 1
        indx = 1
        i = i_save
        j = j_save
      end if

      return
      end
      subroutine timestamp ( )

c*********************************************************************72
c
cc TIMESTAMP prints out the current YMDHMS date as a timestamp.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    12 January 2007
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    None
c
      implicit none

      character * ( 8 ) ampm
      integer d
      character * ( 8 ) date
      integer h
      integer m
      integer mm
      character * ( 9 ) month(12)
      integer n
      integer s
      character * ( 10 ) time
      integer y

      save month

      data month /
     &  'January  ', 'February ', 'March    ', 'April    ',
     &  'May      ', 'June     ', 'July     ', 'August   ',
     &  'September', 'October  ', 'November ', 'December ' /

      call date_and_time ( date, time )

      read ( date, '(i4,i2,i2)' ) y, m, d
      read ( time, '(i2,i2,i2,1x,i3)' ) h, n, s, mm

      if ( h .lt. 12 ) then
        ampm = 'AM'
      else if ( h .eq. 12 ) then
        if ( n .eq. 0 .and. s .eq. 0 ) then
          ampm = 'Noon'
        else
          ampm = 'PM'
        end if
      else
        h = h - 12
        if ( h .lt. 12 ) then
          ampm = 'PM'
        else if ( h .eq. 12 ) then
          if ( n .eq. 0 .and. s .eq. 0 ) then
            ampm = 'Midnight'
          else
            ampm = 'AM'
          end if
        end if
      end if

      write ( *,
     &  '(i2,1x,a,1x,i4,2x,i2,a1,i2.2,a1,i2.2,a1,i3.3,1x,a)' )
     &  d, month(m), y, h, ':', n, ':', s, '.', mm, ampm

      return
      end
      subroutine triangle_lower_to_i4 ( i, j, k )

c*********************************************************************72
c
cc TRIANGLE_LOWER_TO_I4 converts a lower triangular coordinate to an integer.
c
c  Discussion:
c
c    Triangular coordinates are handy when storing a naturally triangular
c    array (such as the lower half of a matrix) in a linear array.
c
c    Thus, for example, we might consider storing 
c
c    (1,1)
c    (2,1) (2,2)
c    (3,1) (3,2) (3,3)
c    (4,1) (4,2) (4,3) (4,4)
c
c    as the linear array
c
c    (1,1) (2,1) (2,2) (3,1) (3,2) (3,3) (4,1) (4,2) (4,3) (4,4)    
c
c    Here, the quantities in parenthesis represent the natural row and
c    column indices of a single number when stored in a rectangular array.
c
c    Thus, our goal is, given the row I and column J of the data,
c    to produce the value K which indicates its position in the linear
c    array.
c
c    The triangular numbers are the indices associated with the
c    diagonal elements of the original array, T(1,1), T(2,2), T(3,3)
c    and so on.
c
c    The formula is:
c
c      K = J + ( (I-1) * I ) / 2
c
c  First Values:
c
c     I  J  K
c
c     0  0  0
c     1  1  1
c     2  1  2
c     2  2  3
c     3  1  4
c     3  2  5
c     3  3  6
c     4  1  7
c     4  2  8
c     4  3  9
c     4  4 10
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license. 
c
c  Modified:
c
c    04 July 2008
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer I, J, the row and column indices.  I and J must
c    be nonnegative, and J must not be greater than I.
c
c    Output, integer K, the linear index of the (I,J) element.
c
      implicit none

      integer i
      integer j
      integer k

      if ( i .lt. 0 ) then
        write ( *, '(a)' ) ' '
        write ( *, '(a)' ) 'TRIANGLE_LOWER_TO_I4 - Fatal error!'
        write ( *, '(a)' ) '  I < 0.'
        write ( *, '(a,i8)' ) '  I = ', i
        stop 1
      else if ( j .lt. 0 ) then
        write ( *, '(a)' ) ' '
        write ( *, '(a)' ) 'TRIANGLE_LOWER_TO_I4 - Fatal error!'
        write ( *, '(a)' ) '  J < 0.'
        write ( *, '(a,i8)' ) '  J = ', j
        stop 1
      else if ( i .lt. j ) then
        write ( *, '(a)' ) ' '
        write ( *, '(a)' ) 'TRIANGLE_LOWER_TO_I4 - Fatal error!'
        write ( *, '(a)' ) '  I < J.'
        write ( *, '(a,i8)' ) '  I = ', i
        write ( *, '(a,i8)' ) '  J = ', j
        stop 1
      end if

      k = j + ( ( i - 1 ) * i ) / 2

      return
      end
      subroutine triangle_upper_to_i4 ( i, j, k )

c*********************************************************************72
c
cc TRIANGLE_UPPER_TO_I4 converts an upper triangular coordinate to an integer.
c
c  Discussion:
c
c    Triangular coordinates are handy when storing a naturally triangular
c    array (such as the upper half of a matrix) in a linear array.
c
c    Thus, for example, we might consider storing 
c
c    (1,1) (1,2) (1,3) (1,4)
c          (2,2) (2,3) (2,4)
c                (3,3) (3,4)
c                      (4,4)
c
c    as the linear array
c
c    (1,1) (1,2) (2,2) (1,3) (2,3) (3,3) (1,4) (2,4) (3,4) (4,4)    
c
c    Here, the quantities in parenthesis represent the natural row and
c    column indices of a single number when stored in a rectangular array.
c
c    Thus, our goal is, given the row I and column J of the data,
c    to produce the value K which indicates its position in the linear
c    array.
c
c    The triangular numbers are the indices associated with the
c    diagonal elements of the original array, T(1,1), T(2,2), T(3,3)
c    and so on.
c
c    The formula is:
c
c      K = I + ( (J-1) * J ) / 2
c
c  First Values:
c
c     I  J  K
c
c     0  0  0
c     1  1  1
c     1  2  2
c     2  2  3
c     1  3  4
c     2  3  5
c     3  3  6
c     1  4  7
c     2  4  8
c     3  4  9
c     4  4 10
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license. 
c
c  Modified:
c
c    22 March 2017
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer I, J, the row and column indices.  I and J must
c    be nonnegative, and I must not be greater than J.
c
c    Output, integer K, the linear index of the (I,J) element.
c
      implicit none

      integer i
      integer j
      integer k

      if ( i .lt. 0 ) then
        write ( *, '(a)' ) ' '
        write ( *, '(a)' ) 'TRIANGLE_UPPER_TO_I4 - Fatal error!'
        write ( *, '(a)' ) '  I < 0.'
        write ( *, '(a,i8)' ) '  I = ', i
        stop 1
      else if ( j .lt. 0 ) then
        write ( *, '(a)' ) ' '
        write ( *, '(a)' ) 'TRIANGLE_UPPER_TO_I4 - Fatal error!'
        write ( *, '(a)' ) '  J < 0.'
        write ( *, '(a,i8)' ) '  J = ', j
        stop 1
      else if ( j .lt. i ) then
        write ( *, '(a)' ) ' '
        write ( *, '(a)' ) 'TRIANGLE_UPPER_TO_I4 - Fatal error!'
        write ( *, '(a)' ) '  J < I.'
        write ( *, '(a,i8)' ) '  I = ', i
        write ( *, '(a,i8)' ) '  J = ', j
        stop 1
      end if

      k = i + ( ( j - 1 ) * j ) / 2

      return
      end