program main

!*****************************************************************************80
!
!! MAIN is the main program for UNIFORM_PRB.
!
!  Discussion:
!
!    UNIFORM_PRB calls sample problems for the UNIFORM library.
!
!  Licensing:
!
!    This code is distributed under the GNU LGPL license. 
!
!  Modified:
!
!    22 April 2008
!
!  Author:
!
!    John Burkardt
!
  implicit none

  call timestamp ( )

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'UNIFORM_PRB'
  write ( *, '(a)' ) '  FORTRAN90 version'
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '  Test the routines in the UNIFORM library.'

  call test01 ( )
  call test02 ( )
  call test03 ( )
  call test04 ( )
  call test05 ( )
  call test06 ( )
  call test065 ( )
  call test07 ( )
  call test08 ( )
  call test09 ( )

  call test10 ( )
  call test11 ( )
  call test111 ( )
  call test112 ( )
  call test118 ( )
  call test119 ( )
  call test12 ( )
  call test13 ( )
  call test14 ( )
  call test15 ( )
  call test16 ( )
  call test17 ( )
  call test18 ( )
  call test19 ( )

  call test20 ( )
  call test21 ( )
  call test22 ( )

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'UNIFORM_PRB'
  write ( *, '(a)' ) '  Normal end of execution.'

  write ( *, '(a)' ) ' '
  call timestamp ( )

  stop
end
subroutine test01 ( )

!*****************************************************************************80
!
!! TEST01 tests C4_UNIFORM_01.
!
!  Licensing:
!
!    This code is distributed under the GNU LGPL license. 
!
!  Modified:
!
!    31 May 2007
!
!  Author:
!
!    John Burkardt
!
  implicit none

  complex ( kind = 4 ) c4_uniform_01
  integer ( kind = 4 ) i
  integer ( kind = 4 ) seed
  integer ( kind = 4 ), parameter :: seed_init = 123456789

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST01'
  write ( *, '(a)' ) '  C4_UNIFORM_01 computes pseudorandom complex values '
  write ( *, '(a)' ) '  uniformly distributed in the unit circle.'

  seed = seed_init

  write ( *, '(a)' ) ' '
  write ( *, '(a,i12)' ) '  The initial seed is ', seed_init
  write ( *, '(a)' ) ' '

  do i = 1, 10
    write ( *, '(2x,i8,2x,f14.8,2x,f14.8)' ) i, c4_uniform_01 ( seed )
  end do

  return
end
subroutine test02 ( )

!*****************************************************************************80
!
!! TEST02 tests C4VEC_UNIFORM_01.
!
!  Licensing:
!
!    This code is distributed under the GNU LGPL license. 
!
!  Modified:
!
!    31 May 2007
!
!  Author:
!
!    John Burkardt
!
  implicit none

  integer ( kind = 4 ), parameter :: n = 10

  complex ( kind = 4 ) c(n)
  integer ( kind = 4 ) i
  integer ( kind = 4 ) seed
  integer ( kind = 4 ), parameter :: seed_init = 123456789

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST02'
  write ( *, '(a)' ) '  C4VEC_UNIFORM_01 computes pseudorandom complex values '
  write ( *, '(a)' ) '  uniformly distributed in the unit circle.'

  seed = seed_init

  write ( *, '(a)' ) ' '
  write ( *, '(a,i12)' ) '  The initial seed is ', seed_init

  call c4vec_uniform_01 ( n, seed, c )

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

  do i = 1, 10
    write ( *, '(2x,i8,2x,f14.8,2x,f14.8)' ) i, c(i)
  end do

  return
end
subroutine test03 ( )

!*****************************************************************************80
!
!! TEST03 tests C8_UNIFORM_01.
!
!  Licensing:
!
!    This code is distributed under the GNU LGPL license. 
!
!  Modified:
!
!    31 May 2007
!
!  Author:
!
!    John Burkardt
!
  implicit none

  complex ( kind = 8 ) c8_uniform_01
  integer ( kind = 4 ) i
  integer ( kind = 4 ) seed
  integer ( kind = 4 ), parameter :: seed_init = 123456789

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST03'
  write ( *, '(a)' ) '  C8_UNIFORM_01 computes pseudorandom double precision'
  write ( *, '(a)' ) '  complex values uniformly distributed in the unit'
  write ( *, '(a)' ) '  circle.'

  seed = seed_init

  write ( *, '(a)' ) ' '
  write ( *, '(a,i12)' ) '  The initial seed is ', seed_init
  write ( *, '(a)' ) ' '

  do i = 1, 10
    write ( *, '(2x,i8,2x,f14.8,2x,f14.8)' ) i, c8_uniform_01 ( seed )
  end do

  return
end
subroutine test04 ( )

!*****************************************************************************80
!
!! TEST04 tests C8VEC_UNIFORM_01.
!
!  Licensing:
!
!    This code is distributed under the GNU LGPL license. 
!
!  Modified:
!
!    31 May 2007
!
!  Author:
!
!    John Burkardt
!
  implicit none

  integer, parameter :: n = 10

  complex ( kind = 8 ) c(n)
  integer ( kind = 4 ) i
  integer ( kind = 4 ) seed
  integer ( kind = 4 ), parameter :: seed_init = 123456789

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST04'
  write ( *, '(a)' ) '  C8VEC_UNIFORM_01 computes pseudorandom '
  write ( *, '(a)' ) '  double precision complex values uniformly distributed '
  write ( *, '(a)' ) '  in the unit circle.'

  seed = seed_init

  write ( *, '(a)' ) ' '
  write ( *, '(a,i12)' ) '  The initial seed is ', seed_init

  call c8vec_uniform_01 ( n, seed, c )

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

  do i = 1, 10
    write ( *, '(2x,i8,2x,f14.8,2x,f14.8)' ) i, c(i)
  end do

  return
end
subroutine test05 ( )

!*****************************************************************************80
!
!! TEST05 tests CH_UNIFORM.
!
!  Licensing:
!
!    This code is distributed under the GNU LGPL license. 
!
!  Modified:
!
!    31 May 2007
!
!  Author:
!
!    John Burkardt
!
  implicit none

  character ch_uniform
  character chi
  character clo
  integer ( kind = 4 ) i
  integer ( kind = 4 ) seed
  integer ( kind = 4 ), parameter :: seed_init = 123456789

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST05'
  write ( *, '(a)' ) '  CH_UNIFORM computes pseudorandom characters '
  write ( *, '(a)' ) '  in an interval [CLO,CHI].'

  clo = 'A'
  chi = 'J'
  seed = seed_init

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '  The lower endpoint CLO = "' // clo // '".'
  write ( *, '(a)' ) '  The upper endpoint CHI = "' // chi // '".'
  write ( *, '(a,i12)' ) '  The initial seed is ', seed_init
  write ( *, '(a)' ) ' '

  do i = 1, 10
    write ( *, '(2x,i8,2x,a1)' ) i, ch_uniform ( clo, chi, seed )
  end do

  return
end
subroutine test06 ( )

!*****************************************************************************80
!
!! TEST06 tests GET_SEED.
!
!  Licensing:
!
!    This code is distributed under the GNU LGPL license. 
!
!  Modified:
!
!    31 May 2007
!
!  Author:
!
!    John Burkardt
!
  implicit none

  real ( kind = 8 ) r8_uniform_01
  integer ( kind = 4 ) i
  integer ( kind = 4 ) j
  integer ( kind = 4 ) seed
  integer ( kind = 4 ) seed_old

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST06'
  write ( *, '(a)' ) '  GET_SEED picks an initial seed value for UNIFORM.'
  write ( *, '(a)' ) '  The value chosen should vary over time, because'
  write ( *, '(a)' ) '  the seed is based on reading the clock.'
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '  This is just the "calendar" clock, which does'
  write ( *, '(a)' ) '  not change very fast, so calling GET_SEED several'
  write ( *, '(a)' ) '  times in a row may result in the same value.'

  seed = 12345678
  seed_old = seed

  write ( *, '(a)' ) ' '
  write ( *, '(a,i12)' ) '  Initial SEED is ', seed
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '  Next 3 values of R8_UNIFORM:'
  write ( *, '(a)' ) ' '

  do j = 1, 3
    write ( *, '(2x,f14.8)' ) r8_uniform_01 ( seed )
  end do

  do i = 1, 4

    do 

      call get_seed ( seed )

      if ( seed /= seed_old ) then
        seed_old = seed
        exit
      end if

    end do

    write ( *, '(a)' ) ' '
    write ( *, '(a,i12)' ) '  New seed from GET_SEED is ', seed
    write ( *, '(a)' ) ' '
    write ( *, '(a)' ) '  Next 3 values of R8_UNIFORM_01:'
    write ( *, '(a)' ) ' '

    do j = 1, 3
      write ( *, '(2x,f14.8)' ) r8_uniform_01 ( seed )
    end do

  end do

  return
end
subroutine test065 ( )

!*****************************************************************************80
!
!! TEST065 tests I4_SEED_ADVANCE.
!
!  Licensing:
!
!    This code is distributed under the GNU LGPL license. 
!
!  Modified:
!
!    14 December 2007
!
!  Author:
!
!    John Burkardt
!
  implicit none

  integer ( kind = 4 ) i4_seed_advance
  integer ( kind = 4 ) seed
  integer ( kind = 4 ) seed_new
  integer ( kind = 4 ) step

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST065'
  write ( *, '(a)' ) '  I4_SEED_ADVANCE advances the seed.'
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '  Step        SEED input       SEED output'
  write ( *, '(a)' ) ' '

  seed_new = 12345

  do step = 1, 10

    seed = seed_new
    seed_new = i4_seed_advance ( seed )

    write ( *, '(2x,i4,2x,i16,2x,i16)' ) step, seed, seed_new

  end do

  return
end
subroutine test07 ( )

!*****************************************************************************80
!
!! TEST07 tests I4_UNIFORM.
!
!  Licensing:
!
!    This code is distributed under the GNU LGPL license. 
!
!  Modified:
!
!    31 May 2007
!
!  Author:
!
!    John Burkardt
!
  implicit none

  integer ( kind = 4 ), parameter :: a = 6
  integer ( kind = 4 ), parameter :: b = 10

  integer ( kind = 4 ) freq(a:b)
  integer ( kind = 4 ) i
  integer ( kind = 4 ) i4_uniform
  integer ( kind = 4 ) j
  integer ( kind = 4 ) seed
  integer ( kind = 4 ), parameter :: seed_init = 123456789
  integer ( kind = 4 ) test
  integer ( kind = 4 ), parameter :: test_num = 10000

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST07'
  write ( *, '(a)' ) '  I4_UNIFORM computes pseudorandom values '
  write ( *, '(a)' ) '  in an interval [A,B].'

  seed = seed_init

  write ( *, '(a)' ) ' '
  write ( *, '(a,i12)' ) '  The lower endpoint A = ', a
  write ( *, '(a,i12)' ) '  The upper endpoint B = ', b
  write ( *, '(a,i12)' ) '  The initial seed is ', seed_init
  write ( *, '(a)' ) ' '

  freq(a:b) = 0

  do test = 1, test_num

    j = i4_uniform ( a, b, seed )

    if ( j < a ) then
      write ( *, '(a,i8)' ) '  Illegal value J = ', j
    else if ( j <= b ) then
      freq(j) = freq(j) + 1
    else
      write ( *, '(a,i8)' ) '  Illegal value J = ', j
    end if

  end do

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '         I    Frequency'
  write ( *, '(a)' ) ' '
  do i = a, b
    write ( *, '(2x,i8,2x,i8)' ) i, freq(i)
  end do

  return
end
subroutine test08 ( )

!*****************************************************************************80
!
!! TEST08 tests I4_UNIFORM.
!
!  Licensing:
!
!    This code is distributed under the GNU LGPL license. 
!
!  Modified:
!
!    31 May 2007
!
!  Author:
!
!    John Burkardt
!
  implicit none

  integer ( kind = 4 ), parameter :: a = -100
  integer ( kind = 4 ), parameter :: b = 200
  integer ( kind = 4 ) i
  integer ( kind = 4 ) i4_uniform
  integer ( kind = 4 ) j
  integer ( kind = 4 ) seed
  integer ( kind = 4 ), parameter :: seed_init = 123456789

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST08'
  write ( *, '(a)' ) '  I4_UNIFORM computes pseudorandom values '
  write ( *, '(a)' ) '  in an interval [A,B].'

  seed = seed_init

  write ( *, '(a)' ) ' '
  write ( *, '(a,i12)' ) '  The lower endpoint A = ', a
  write ( *, '(a,i12)' ) '  The upper endpoint B = ', b
  write ( *, '(a,i12)' ) '  The initial seed is ', seed_init
  write ( *, '(a)' ) ' '

  do i = 1, 20

    j = i4_uniform ( a, b, seed )

    write ( *, '(2x,i8,2x,i8)' ) i, j

  end do

  return
end
subroutine test09 ( )

!*****************************************************************************80
!
!! TEST09 tests I4_UNIFORM_0I
!
!  Licensing:
!
!    This code is distributed under the GNU LGPL license. 
!
!  Modified:
!
!    31 May 2007
!
!  Author:
!
!    John Burkardt
!
  implicit none

  integer ( kind = 4 ) i
  integer ( kind = 4 ) i4_uniform_0i
  real    ( kind = 4 ) mean
  integer ( kind = 4 ), parameter :: n = 1000
  integer ( kind = 4 ) seed
  real    ( kind = 4 ) variance
  integer ( kind = 4 ) x(n)

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST09'
  write ( *, '(a)' ) '  I4_UNIFORM_0I samples a uniform random'
  write ( *, '(a)' ) '  integer distribution in [0,2**31-1].'

  seed = 123456789

  write ( *, '(a)' ) ' '
  write ( *, '(a,i12)' ) '  Starting with seed = ', seed

  do i = 1, n
    x(i) = i4_uniform_0i ( seed )
  end do

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '  First few values:'
  write ( *, '(a)' ) ' '
  do i = 1, 5
    write ( *, '(2x,i8,2x,i12)' ) i, x(i)
  end do

  mean = sum ( real ( x(1:n), kind = 4 ) / real ( n, kind = 4 ) )

  variance = sum ( ( real ( x(1:n), kind = 4 ) - mean )**2 ) &
                / real ( n - 1, kind = 4 )

  write ( *, '(a)' ) ' '
  write ( *, '(a,i8)' ) '  Number of values computed was N = ', n
  write ( *, '(a,g14.6)' ) '  Average value was ', mean
  write ( *, '(a,i12)' ) '  Minimum value was ', minval ( x(1:n) )
  write ( *, '(a,i12)' ) '  Maximum value was ', maxval ( x(1:n) )
  write ( *, '(a,g14.6)' ) '  Variance was ', variance

  return
end
subroutine test10 ( )

!*****************************************************************************80
!
!! TEST10 tests I4VEC_UNIFORM.
!
!  Licensing:
!
!    This code is distributed under the GNU LGPL license. 
!
!  Modified:
!
!    31 May 2007
!
!  Author:
!
!    John Burkardt
!
  implicit none

  integer ( kind = 4 ), parameter :: n = 10000
  integer ( kind = 4 ), parameter :: a = 6
  integer ( kind = 4 ), parameter :: b = 10

  integer ( kind = 4 ) freq(a:b)
  integer ( kind = 4 ) i
  integer ( kind = 4 ) i4vec(n)
  integer ( kind = 4 ) j
  integer ( kind = 4 ) seed
  integer ( kind = 4 ), parameter :: seed_init = 123456789

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST10'
  write ( *, '(a)' ) '  I4VEC_UNIFORM computes a vector of pseudorandom values '
  write ( *, '(a)' ) '  in an interval [A,B].'

  seed = seed_init

  write ( *, '(a)' ) ' '
  write ( *, '(a,i12)' ) '  The lower endpoint A = ', a
  write ( *, '(a,i12)' ) '  The upper endpoint B = ', b
  write ( *, '(a,i12)' ) '  The initial seed is ', seed_init
  write ( *, '(a)' ) ' '

  freq(a:b) = 0

  call i4vec_uniform ( n, a, b, seed, i4vec )

  do i = 1, n

    if ( i4vec(i) < a ) then
      write ( *, '(a,i8)' ) '  Illegal value J = ', i4vec(i)
    else if ( i4vec(i) <= b ) then
      freq(i4vec(i)) = freq(i4vec(i)) + 1
    else
      write ( *, '(a,i8)' ) '  Illegal value J = ', i4vec(i)
    end if

  end do

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '         I    Frequency'
  write ( *, '(a)' ) ' '
  do i = a, b
    write ( *, '(2x,i8,2x,i8)' ) i, freq(i)
  end do

  return
end
subroutine test11 ( )

!*****************************************************************************80
!
!! TEST11 tests I8_UNIFORM.
!
!  Licensing:
!
!    This code is distributed under the GNU LGPL license. 
!
!  Modified:
!
!    22 May 2008
!
!  Author:
!
!    John Burkardt
!
  implicit none

  integer ( kind = 8 ) a
  integer ( kind = 8 ) b
  integer ( kind = 8 ) i
  integer ( kind = 8 ) i8_uniform
  integer ( kind = 8 ) seed
! integer ( kind = 8 ), parameter :: seed_init = 123456789
  integer ( kind = 8 ), parameter :: seed_init = 123456789987654321_8

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST11'
  write ( *, '(a)' ) '  I8_UNIFORM computes pseudorandom values '
  write ( *, '(a)' ) '  in an interval [A,B].'

! a = 100000
  a = 1000000000_8
! b = 800000
  b = 8000000000_8

  seed = seed_init

  write ( *, '(a)' ) ' '
  write ( *, '(a,i24)' ) '  The lower endpoint A = ', a
  write ( *, '(a,i24)' ) '  The upper endpoint B = ', b
  write ( *, '(a,i24)' ) '  The initial seed is    ', seed_init
  write ( *, '(a)' ) ' '

  do i = 1, 10
    write ( *, '(2x,i8,2x,i24)' ) i, i8_uniform ( a, b, seed )
  end do

  return
end
subroutine test111 ( )

!*****************************************************************************80
!
!! TEST111 tests L_UNIFORM.
!
!  Licensing:
!
!    This code is distributed under the GNU LGPL license. 
!
!  Modified:
!
!    01 December 2007
!
!  Author:
!
!    John Burkardt
!
  implicit none

  integer ( kind = 4 ) i
  logical              l_uniform
  integer ( kind = 4 ) seed
  integer ( kind = 4 ), parameter :: seed_init = 123456789

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST111'
  write ( *, '(a)' ) '  L_UNIFORM computes pseudorandom logical values.'

  seed = seed_init

  write ( *, '(a)' ) ' '
  write ( *, '(a,i12)' ) '  The initial seed is ', seed_init
  write ( *, '(a)' ) ' '

  do i = 1, 10
    write ( *, '(2x,i8,2x,l1)' ) i, l_uniform ( seed )
  end do

  return
end
subroutine test112 ( )

!*****************************************************************************80
!
!! TEST112 tests LVEC_UNIFORM.
!
!  Licensing:
!
!    This code is distributed under the GNU LGPL license. 
!
!  Modified:
!
!    01 December 2007
!
!  Author:
!
!    John Burkardt
!
  implicit none

  integer ( kind = 4 ), parameter :: n = 10

  integer ( kind = 4 ) i
  logical              lvec(n)
  integer ( kind = 4 ) seed
  integer ( kind = 4 ), parameter :: seed_init = 123456789

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST112'
  write ( *, '(a)' ) '  LVEC_UNIFORM_01 computes a vector of'
  write ( *, '(a)' ) '  pseudorandom logical values.'

  seed = seed_init

  write ( *, '(a)' ) ' '
  write ( *, '(a,i12)' ) '  The initial seed is ', seed_init

  call lvec_uniform ( n, seed, lvec )

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

  do i = 1, 10
    write ( *, '(2x,i8,2x,l1)' ) i, lvec(i)
  end do

  return
end
subroutine test118 ( )

!*****************************************************************************80
!
!! TEST118 tests LCRG_ANBN.
!
!  Licensing:
!
!    This code is distributed under the GNU LGPL license. 
!
!  Modified:
!
!    22 April 2008
!
!  Author:
!
!    John Burkardt
!
  implicit none

  integer ( kind = 4 ) a
  integer ( kind = 4 ) an
  integer ( kind = 4 ) b
  integer ( kind = 4 ) bn
  integer ( kind = 4 ) c
  integer ( kind = 4 ) n

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST118'
  write ( *, '(a)' ) '  LCRG_ANBN determines a linear congruential random'
  write ( *, '(a)' ) '  number generator equivalent to N steps of a given one.'
!
!  These parameters define the old (1969) IBM 360 random number generator:
!
  a = 16807
  b = 0
  c = 2147483647

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '  LCRG parameters:'
  write ( *, '(a)' ) ' '
  write ( *, '(a,i12)' ) '  A = ', a
  write ( *, '(a,i12)' ) '  B = ', b
  write ( *, '(a,i12)' ) '  C = ', c
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '             N             A             B'
  write ( *, '(a)' ) ' '

  do n = 0, 10
    call lcrg_anbn ( a, b, c, n, an, bn )
    write ( *, '(2x,i12,2x,i12,2x,i12)' ) n, an, bn
  end do

  return
end
subroutine test119 ( )

!*****************************************************************************80
!
!! TEST119 tests LCRG_ANBN.
!
!  Licensing:
!
!    This code is distributed under the GNU LGPL license. 
!
!  Modified:
!
!    22 April 2008
!
!  Author:
!
!    John Burkardt
!
  implicit none

  integer ( kind = 4 ) a
  integer ( kind = 4 ) an
  integer ( kind = 4 ) b
  integer ( kind = 4 ) bn
  integer ( kind = 4 ) c
  integer ( kind = 4 ) j
  integer ( kind = 4 ) k
  integer ( kind = 4 ) n
  integer ( kind = 4 ) u
  integer ( kind = 4 ) v
  integer ( kind = 4 ), allocatable, dimension ( : ) :: x
  integer ( kind = 4 ), allocatable, dimension ( : ) :: y

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST119'
  write ( *, '(a)' ) '  LCRG_ANBN determines a linear congruential random'
  write ( *, '(a)' ) '  number generator equivalent to N steps of a given one.'
!
!  These parameters define the old (1969) IBM 360 random number generator:
!
  a = 16807
  b = 0
  c = 2147483647

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '  LCRG parameters:'
  write ( *, '(a)' ) ' '
  write ( *, '(a,i12)' ) '  A  = ', a
  write ( *, '(a,i12)' ) '  B  = ', b
  write ( *, '(a,i12)' ) '  C  = ', c
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '                           N            In           Out'
  write ( *, '(a)' ) ' '

  k = 0
  u = 12345
  write ( *, '(2x,12x,2x,i12,2x,12x,2x,i12)' ) k, u
  do k = 1, 11
    call lcrg_evaluate ( a, b, c, u, v )
    write ( *, '(2x,12x,2x,i12,2x,i12,2x,i12)' ) k, u, v
    u = v
  end do
!
!  Now try to replicate these results using N procesors.
!
  n = 4
  allocate ( x(1:n) )
  allocate ( y(1:n) )

  call lcrg_anbn ( a, b, c, n, an, bn )

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '  LCRG parameters:'
  write ( *, '(a)' ) ' '
  write ( *, '(a,i12)' ) '  AN = ', an
  write ( *, '(a,i12)' ) '  BN = ', bn
  write ( *, '(a,i12)' ) '  C  = ', c
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '             J             N            In           Out'
  write ( *, '(a)' ) ' '

  x(1) = 12345
  do j = 2, n
    call lcrg_evaluate ( a, b, c, x(j-1), x(j) )
  end do

  do j = 1, n
    write ( *, '(2x,i12,2x,i12,2x,12x,2x,i12)' ) j, j-1, x(j)
  end do

  do k = n + 1, 12, n
    do j = 1, n
      call lcrg_evaluate ( an, bn, c, x(j), y(j) )
      write ( *, '(2x,i12,2x,i12,2x,i12,2x,i12)' ) j, k+j-2, x(j), y(j)
      x(j) = y(j)
    end do
  end do

  deallocate ( x )
  deallocate ( y )

  return
end
subroutine test12 ( )

!*****************************************************************************80
!
!! TEST12 tests LCRG_SEED.
!
!  Licensing:
!
!    This code is distributed under the GNU LGPL license. 
!
!  Modified:
!
!    31 May 2007
!
!  Author:
!
!    John Burkardt
!
  implicit none

  integer ( kind = 4 ) a
  integer ( kind = 4 ) b
  integer ( kind = 4 ) c
  integer ( kind = 4 ) i
  real    ( kind = 4 ) r4_uniform_01
  integer ( kind = 4 ) seed
  integer ( kind = 4 ) seed_in
  integer ( kind = 4 ) seed_lcrg
  integer ( kind = 4 ) seed_out
  integer ( kind = 4 ) seed_start
  real    ( kind = 4 ) u

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST12'
  write ( *, '(a)' ) '  LCRG_SEED directly computes the updated value of a'
  write ( *, '(a)' ) '  seed used by an linear congruential random number'
  write ( *, '(a)' ) '  generator.'
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '       I          SEED          SEED          SEED    U'
  write ( *, '(a)' ) '                 Input        Output          LCRG'
  write ( *, '(a)' ) ' '
!
!  These parameters define the old (1969) IBM 360 random number generator:
!
  a = 16807
  b = 0
  c = 2147483647
!
!  This seed value was used in Pierre L'Ecuyer's article.
!
  seed_start = 12345

  seed = seed_start
!
!  Compute 1000 random numbers "the hard way", that is, sequentially.
!  Every now and then, call LCRG_SEED to compute SEED directly.
!
  do i = 1, 1000

    seed_in = seed
    u = r4_uniform_01 ( seed )
    seed_out = seed

    if ( i <= 10 .or. i == 100 .or. i == 1000 ) then

      call lcrg_seed ( a, b, c, i, seed_start, seed_lcrg )

      write ( *, '(2x,i8,2x,i12,2x,i12,2x,i12,2x,g14.6)' ) &
        i, seed_in, seed_out, seed_lcrg, u

    end if

  end do

  return
end
subroutine test13 ( )

!*****************************************************************************80
!
!! TEST13 tests R4_UNIFORM.
!
!  Licensing:
!
!    This code is distributed under the GNU LGPL license. 
!
!  Modified:
!
!    31 May 2007
!
!  Author:
!
!    John Burkardt
!
  implicit none

  real    ( kind = 4 ) a
  real    ( kind = 4 ) b
  integer ( kind = 4 ) i
  real    ( kind = 4 ) r4_uniform
  integer ( kind = 4 ) seed
  integer ( kind = 4 ), parameter :: seed_init = 123456789

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST13'
  write ( *, '(a)' ) '  R4_UNIFORM computes pseudorandom values '
  write ( *, '(a)' ) '  in an interval [A,B].'

  a = 5.0E+00
  b = 10.0E+00
  seed = seed_init

  write ( *, '(a)' ) ' '
  write ( *, '(a,g14.6)' ) '  The lower endpoint A = ', a
  write ( *, '(a,g14.6)' ) '  The upper endpoint B = ', b
  write ( *, '(a,i12)' ) '  The initial seed is ', seed_init
  write ( *, '(a)' ) ' '

  do i = 1, 10
    write ( *, '(2x,i8,2x,g14.6)' ) i, r4_uniform ( a, b, seed )
  end do

  return
end
subroutine test14 ( )

!*****************************************************************************80
!
!! TEST14 tests R4_UNIFORM_01.
!
!  Licensing:
!
!    This code is distributed under the GNU LGPL license. 
!
!  Modified:
!
!    31 May 2007
!
!  Author:
!
!    John Burkardt
!
  implicit none

  integer ( kind = 4 ) i
  real    ( kind = 4 ) r4_uniform_01
  integer ( kind = 4 ) seed
  integer ( kind = 4 ), parameter :: seed_init = 123456789

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST14'
  write ( *, '(a)' ) '  R4_UNIFORM_01 computes pseudorandom values '
  write ( *, '(a)' ) '  in the interval [0,1].'

  seed = seed_init

  write ( *, '(a)' ) ' '
  write ( *, '(a,i12)' ) '  The initial seed is ', seed_init
  write ( *, '(a)' ) ' '

  do i = 1, 10
    write ( *, '(2x,i8,2x,g14.6)' ) i, r4_uniform_01 ( seed )
  end do

  return
end
subroutine test15 ( )

!*****************************************************************************80
!
!! TEST15 tests R8_UNIFORM.
!
!  Licensing:
!
!    This code is distributed under the GNU LGPL license. 
!
!  Modified:
!
!    31 May 2007
!
!  Author:
!
!    John Burkardt
!
  implicit none

  real    ( kind = 8 ) a
  real    ( kind = 8 ) b
  real    ( kind = 8 ) r8_uniform
  integer ( kind = 4 ) i
  integer ( kind = 4 ) seed
  integer ( kind = 4 ), parameter :: seed_init = 123456789

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST15'
  write ( *, '(a)' ) '  R8_UNIFORM computes pseudorandom values '
  write ( *, '(a)' ) '  in an interval [A,B].'

  a = 5.0D+00
  b = 10.0D+00
  seed = seed_init

  write ( *, '(a)' ) ' '
  write ( *, '(a,g14.6)' ) '  The lower endpoint A = ', a
  write ( *, '(a,g14.6)' ) '  The upper endpoint B = ', b
  write ( *, '(a,i12)' ) '  The initial seed is ', seed_init
  write ( *, '(a)' ) ' '

  do i = 1, 10
    write ( *, '(2x,i8,2x,g14.6)' ) i, r8_uniform ( a, b, seed )
  end do

  return
end
subroutine test16 ( )

!*****************************************************************************80
!
!! TEST16 tests R8_UNIFORM_01.
!
!  Licensing:
!
!    This code is distributed under the GNU LGPL license. 
!
!  Modified:
!
!    31 May 2007
!
!  Author:
!
!    John Burkardt
!
  implicit none

  real    ( kind = 8 ) r8_uniform_01
  integer ( kind = 4 ) i
  integer ( kind = 4 ) seed
  integer ( kind = 4 ), parameter :: seed_init = 123456789

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST16'
  write ( *, '(a)' ) '  R8_UNIFORM_01 computes pseudorandom values '
  write ( *, '(a)' ) '  in the interval [0,1].'

  seed = seed_init

  write ( *, '(a)' ) ' '
  write ( *, '(a,i12)' ) '  The initial seed is ', seed_init
  write ( *, '(a)' ) ' '

  do i = 1, 10
    write ( *, '(2x,i8,2x,g14.6)' ) i, r8_uniform_01 ( seed )
  end do

  return
end
subroutine test17 ( )

!*****************************************************************************80
!
!! TEST17 tests R8_UNIFORM_01.
!
!  Licensing:
!
!    This code is distributed under the GNU LGPL license. 
!
!  Modified:
!
!    31 May 2007
!
!  Author:
!
!    John Burkardt
!
  implicit none

  integer, parameter :: n = 1000

  integer ( kind = 4 ) i
  real    ( kind = 8 ) r8_uniform_01
  integer ( kind = 4 ) seed
  integer ( kind = 4 ) seed_in
  integer ( kind = 4 ) seed_out
  real    ( kind = 8 ) u(n)
  real    ( kind = 8 ) u_avg
  real    ( kind = 8 ) u_var

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST17'
  write ( *, '(a)' ) '  R8_UNIFORM_01 computes a sequence of '
  write ( *, '(a)' ) '  uniformly distributed pseudorandom numbers.'
!
!  Start with a known seed.
!
  seed = 12345

  write ( *, '(a)' ) ' '
  write ( *, '(a,i12)' ) '  Initial SEED = ', seed

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '  First 10 values:'
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '     I         Input        Output   R8_UNIFORM_01'
  write ( *, '(a)' ) '                SEED          SEED'
  write ( *, '(a)' ) ' '

  do i = 1, 10

    seed_in = seed
    u(i) = r8_uniform_01 ( seed )
    seed_out = seed

    write ( *, '(i8,2x,i12,2x,i12,2x,g14.6)' ) i, seed_in, seed_out, u(i)

  end do

  write ( *, '(a)' ) ' '
  write ( *, '(a,i10,a)' ) '  Now compute ', n, ' elements.'
  write ( *, '(a)' ) ' '

  u_avg = 0.0D+00
  do i = 1, n
    u(i) = r8_uniform_01 ( seed )
    u_avg = u_avg + u(i)
  end do

  u_avg = u_avg / real ( n, kind = 8 )

  u_var = sum ( ( u(1:n) - u_avg )**2 ) / real ( n - 1, kind = 8 )

  write ( *, '(a)' ) ' '
  write ( *, '(a,f10.6)' ) '  Average value = ', u_avg
  write ( *, '(a,f10.6)' ) '  Expecting       ', 0.5D+00

  write ( *, '(a)' ) ' '
  write ( *, '(a,f10.6)' ) '  Variance =      ', u_var
  write ( *, '(a,f10.6)' ) '  Expecting       ', 1.0D+00 / 12.0D+00

  return
end
subroutine test18 ( )

!*****************************************************************************80
!
!! TEST18 tests R8_UNIFORM_01.
!
!  Licensing:
!
!    This code is distributed under the GNU LGPL license. 
!
!  Modified:
!
!    31 May 2007
!
!  Author:
!
!    John Burkardt
!
  implicit none

  integer ( kind = 4 ) i
  real    ( kind = 8 ) r8_uniform_01
  integer ( kind = 4 ) seed
  integer ( kind = 4 ) seed_in
  integer ( kind = 4 ) seed_out
  integer ( kind = 4 ) seed_save
  real    ( kind = 8 ) x

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST18'
  write ( *, '(a)' ) '  R8_UNIFORM_01 computes a sequence of pseudorandom'
  write ( *, '(a)' ) '  numbers but all computations depend on the seed value.'
  write ( *, '(a)' ) '  In this test, we show how a sequence of "random"'
  write ( *, '(a)' ) '  values can be manipulated by accessing the seed.'

  seed = 1066

  write ( *, '(a)' ) ' '
  write ( *, '(a,i12)' ) '  Initial SEED is ', seed
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '  Call R8_UNIFORM_01 10 times, and watch SEED.'
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '     I         Input        Output   R8_UNIFORM_01'
  write ( *, '(a)' ) '                SEED          SEED'
  write ( *, '(a)' ) ' '

  do i = 1, 10

    seed_in = seed

    if ( i == 5 ) then
      seed_save = seed
    end if

    x = r8_uniform_01 ( seed )
    seed_out = seed
    write ( *, '(i8,2x,i12,2x,i12,2x,g14.6)' ) i, seed_in, seed_out,x

  end do

  seed = seed_save

  write ( *, '(a)' ) ' '
  write ( *, '(a,i12)' ) '  Reset SEED to its value at step 5, = ', seed
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '  Now call R8_UNIFORM_01 10 times, and watch how SEED'
  write ( *, '(a)' ) '  and R8_UNIFORM_01 restart themselves.'
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '     I         Input        Output    R8_UNIFORM_01'
  write ( *, '(a)' ) '                SEED          SEED'
  write ( *, '(a)' ) ' '

  do i = 1, 10
    seed_in = seed
    x = r8_uniform_01 ( seed )
    seed_out = seed
    write ( *, '(i8,2x,i12,2x,i12,2x,g14.6)' ) i, seed_in, seed_out,x
  end do

  seed = -12345678

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '  What happens with a negative SEED?'
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '     I         Input        Output   R8_UNIFORM_01'
  write ( *, '(a)' ) '                SEED          SEED'
  write ( *, '(a)' ) ' '

  do i = 1, 10
    seed_in = seed
    x = r8_uniform_01 ( seed )
    seed_out = seed
    write ( *, '(i8,2x,i12,2x,i12,2x,g14.6)' ) i, seed_in, seed_out,x
  end do

  return
end
subroutine test19 ( )

!*****************************************************************************80
!
!! TEST19 tests R8_UNIFORM_01 and R8MAT_UNIFORM_01.
!
!  Licensing:
!
!    This code is distributed under the GNU LGPL license. 
!
!  Modified:
!
!    31 May 2007
!
!  Author:
!
!    John Burkardt
!
  implicit none

  integer ( kind = 4 ), parameter :: m = 100
  integer ( kind = 4 ), parameter :: n = 10

  real    ( kind = 8 ) a(m,n)
  real    ( kind = 8 ) b(m,n)
  integer ( kind = 4 ) i
  integer ( kind = 4 ) j
  integer ( kind = 4 ) k
  real    ( kind = 8 ) r8_uniform_01
  integer ( kind = 4 ) seed
  integer ( kind = 4 ), parameter :: seed_init = 123456789

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST19'
  write ( *, '(a)' ) '  R8_UNIFORM_01 computes pseudorandom values '
  write ( *, '(a)' ) '    one at a time.'
  write ( *, '(a)' ) '  R8MAT_UNIFORM_01 computes a matrix of values.'
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '  For the same initial seed, the results should '
  write ( *, '(a)' ) '  be identical, but R8MAT_UNIFORM_01 might be faster.'
  write ( *, '(a)' ) ' '
  write ( *, '(a,i12)' ) '  The initial seed is ', seed_init

  seed = seed_init

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

  seed = seed_init;
  call r8mat_uniform_01 ( m, n, seed, b )

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '       I       J      A(I,J)        B(I,J)'
  write ( *, '(a)' ) '                  (R8_UNIFORM_01)  (R8MAT_UNIFORM_01)'
  write ( *, '(a)' ) ' '

  do k = 0, 10
    i = ( k * m + ( 10 - k ) * 1 ) / 10
    j = ( k * n + ( 10 - k ) * 1 ) / 10
    write ( *, '(2x,i8,2x,i8,2x,g14.6,2x,g14.6)' ) i, j, a(i,j), b(i,j)
  end do
  
  return
end
subroutine test20 ( )

!*****************************************************************************80
!
!! TEST20 tests R8_UNIFORM_01 and R8VEC_UNIFORM_01.
!
!  Licensing:
!
!    This code is distributed under the GNU LGPL license. 
!
!  Modified:
!
!    31 May 2007
!
!  Author:
!
!    John Burkardt
!
  implicit none

  integer ( kind = 4 ), parameter :: n = 10

  real    ( kind = 8 ) a(n)
  real    ( kind = 8 ) b(n)
  real    ( kind = 8 ) r8_uniform_01
  integer ( kind = 4 ) i
  integer ( kind = 4 ) seed
  integer ( kind = 4 ), parameter :: seed_init = 123456789

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST20'
  write ( *, '(a)' ) '  R8_UNIFORM_01 computes pseudorandom values '
  write ( *, '(a)' ) '  one at a time.'
  write ( *, '(a)' ) '  R8VEC_UNIFORM_01 computes a vector of values.'
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '  For the same initial seed, the results should '
  write ( *, '(a)' ) '  be identical, but R8VEC_UNIFORM_01 might be faster.'
  write ( *, '(a)' ) ' '
  write ( *, '(a,i12)' ) '  The initial seed is ', seed_init

  seed = seed_init

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

  seed = seed_init;
  call r8vec_uniform_01 ( n, seed, b )

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '       I      A(I)            B(I)'
  write ( *, '(a)' ) '          (R8_UNIFORM_01)  (R8VEC_UNIFORM_01)'
  write ( *, '(a)' ) ' '

  do i = 1, 10
    write ( *, '(2x,i8,2x,g14.6,2x,g14.6)' ) i, a(i), b(i)
  end do
  
  return
end
subroutine test21 ( )

!*****************************************************************************80
!
!! TEST21 tests R8I8_UNIFORM.
!
!  Licensing:
!
!    This code is distributed under the GNU LGPL license. 
!
!  Modified:
!
!    31 May 2007
!
!  Author:
!
!    John Burkardt
!
  implicit none

  real    ( kind = 8 ) a
  real    ( kind = 8 ) b
  real    ( kind = 8 ) r8i8_uniform
  integer ( kind = 8 ) i
  integer ( kind = 8 ) seed
  integer ( kind = 8 ), parameter :: seed_init = 123456789

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST21'
  write ( *, '(a)' ) '  R8I8_UNIFORM computes pseudorandom values '
  write ( *, '(a)' ) '  in an interval [A,B] using an I8 seed.'

  a = 5.0D+00
  b = 10.0D+00
  seed = seed_init

  write ( *, '(a)' ) ' '
  write ( *, '(a,g14.6)' ) '  The lower endpoint A = ', a
  write ( *, '(a,g14.6)' ) '  The upper endpoint B = ', b
  write ( *, '(a,i12)' ) '  The initial seed is ', seed_init
  write ( *, '(a)' ) ' '

  do i = 1, 10
    write ( *, '(2x,i8,2x,g14.6)' ) i, r8i8_uniform ( a, b, seed )
  end do

  return
end
subroutine test22 ( )

!*****************************************************************************80
!
!! TEST22 tests R8I8_UNIFORM_01.
!
!  Licensing:
!
!    This code is distributed under the GNU LGPL license. 
!
!  Modified:
!
!    31 May 2007
!
!  Author:
!
!    John Burkardt
!
  implicit none

  real    ( kind = 8 ) r8i8_uniform_01
  integer ( kind = 8 ) i
  integer ( kind = 8 ) seed
  integer ( kind = 8 ), parameter :: seed_init = 123456789

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST22'
  write ( *, '(a)' ) '  R8I8_UNIFORM_01 computes pseudorandom values '
  write ( *, '(a)' ) '  in the interval [0,1] using an I8 seed.'

  seed = seed_init

  write ( *, '(a)' ) ' '
  write ( *, '(a,i12)' ) '  The initial seed is ', seed_init
  write ( *, '(a)' ) ' '

  do i = 1, 10
    write ( *, '(2x,i8,2x,g14.6)' ) i, r8i8_uniform_01 ( seed )
  end do

  return
end