program main

!*****************************************************************************80
!
!! MAIN is the main program for ASA183_TEST.
!
!  Discussion:
!
!    ASA183_TEST tests the ASA183 library.
!
!  Licensing:
!
!    This code is distributed under the GNU LGPL license.
!
!  Modified:
!
!    08 July 2008
!
!  Author:
!
!    John Burkardt
!
  implicit none

  call timestamp ( )

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'ASA183_TEST'
  write ( *, '(a)' ) '  FORTRAN90 version'
  write ( *, '(a)' ) '  Test the ASA183 library.'
!
!  R4_RANDOM
!
  call test01 ( )
  call test02 ( )
  call test03 ( )
!
!  R4_UNI
!
  call test04 ( )
  call test05 ( )
  call test06 ( )
!
!  R8_RANDOM
!
  call test07 ( )
  call test08 ( )
  call test09 ( )
!
!  R8_UNI
!
  call test10 ( )
  call test11 ( )
  call test12 ( )
!
!  Terminate.
!
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'ASA183_TEST'
  write ( *, '(a)' ) '  Normal end of execution.'
  write ( *, '(a)' ) ' '
  call timestamp ( )

  stop 0
end
subroutine test01 ( )

!*****************************************************************************80
!
!! TEST01 tests R4_RANDOM.
!
!  Licensing:
!
!    This code is distributed under the GNU LGPL license.
!
!  Modified:
!
!    08 July 2008
!
!  Author:
!
!    John Burkardt
!
  implicit none

  integer ( kind = 4 ) i
  real ( kind = 4 ) r
  real ( kind = 4 ) r4_random
  integer ( kind = 4 ) s1
  integer ( kind = 4 ) s2
  integer ( kind = 4 ) s3

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST01'
  write ( *, '(a)' ) '  R4_RANDOM computes pseudorandom values.'
  write ( *, '(a)' ) '  Three seeds, S1, S2, and S3, are used.'

  s1 = 12345
  s2 = 34567
  s3 = 56789

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '      R                 S1        S2        S3'
  write ( *, '(a)' ) ' '
  write ( *, '(2x,14x,2x,i8,2x,i8,2x,i8)' ) s1, s2, s3

  do i = 1, 10
    r = r4_random ( s1, s2, s3 )
    write ( *, '(2x,g14.6,2x,i8,2x,i8,2x,i8)' ) r, s1, s2, s3
  end do

  return
end
subroutine test02 ( )

!*****************************************************************************80
!
!! TEST02 tests R4_RANDOM.
!
!  Licensing:
!
!    This code is distributed under the GNU LGPL license.
!
!  Modified:
!
!    08 July 2008
!
!  Author:
!
!    John Burkardt
!
  implicit none

  integer ( kind = 4 ) n
  parameter ( n = 100000 )

  integer ( kind = 4 ) i
  real ( kind = 4 ) r4_random
  integer ( kind = 4 ) s1
  integer ( kind = 4 ) s2
  integer ( kind = 4 ) s3
  real ( kind = 4 ) u(n)
  real ( kind = 4 ) u_avg
  real ( kind = 4 ) u_var

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST02'
  write ( *, '(a)' ) '  Examine the average and variance of a'
  write ( *, '(a)' ) '  sequence generated by R4_RANDOM.'
!
!  Start with known seeds.
!
  s1 = 12345
  s2 = 34567
  s3 = 56789

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

  u_avg = 0.0E+00
  do i = 1, n
    u(i) = r4_random ( s1, s2, s3 )
    u_avg = u_avg + u(i)
  end do

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

  u_var = 0.0E+00
  do i = 1, n
    u_var = u_var + ( u(i) - u_avg ) * ( u(i) - u_avg )
  end do

  u_var = u_var / real ( n - 1, kind = 4 )

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

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

  return
end
subroutine test03 ( )

!*****************************************************************************80
!
!! TEST03 tests R4_RANDOM.
!
!  Licensing:
!
!    This code is distributed under the GNU LGPL license.
!
!  Modified:
!
!    08 July 2008
!
!  Author:
!
!    John Burkardt
!
  implicit none

  integer ( kind = 4 ) i
  real ( kind = 4 ) r
  real ( kind = 4 ) r4_random
  integer ( kind = 4 ) s1
  integer ( kind = 4 ) s1_save
  integer ( kind = 4 ) s2
  integer ( kind = 4 ) s2_save
  integer ( kind = 4 ) s3
  integer ( kind = 4 ) s3_save

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST03'
  write ( *, '(a)' ) '  Show how the seeds used by R4_RANDOM,'
  write ( *, '(a)' ) '  which change on each step, can be reset to'
  write ( *, '(a)' ) '  restore any part of the sequence.'

  s1_save = 12345
  s2_save = 34567
  s3_save = 56789

  s1 = s1_save
  s2 = s2_save
  s3 = s3_save

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '  Begin sequence with following seeds:'
  write ( *, '(a)' ) ' '
  write ( *, '(a,i8)' ) '  S1 = ', s1
  write ( *, '(a,i8)' ) '  S2 = ', s2
  write ( *, '(a,i8)' ) '  S3 = ', s3
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '         I      R                 S1        S2        S3'
  write ( *, '(a)' ) ' '

  do i = 1, 10

    r = r4_random ( s1, s2, s3 )
    write ( *, '(2x,i8,2x,g14.6,2x,i8,2x,i8,2x,i8)' ) i, r, s1, s2, s3

    if ( i == 5 ) then
      s1_save = s1
      s2_save = s2
      s3_save = s3
    end if

  end do

  s1 = s1_save
  s2 = s2_save
  s3 = s3_save

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '  Restart the sequence, using the seeds'
  write ( *, '(a)' ) '  produced after step 5:'
  write ( *, '(a)' ) ' '
  write ( *, '(a,i8)' ) '  S1 = ', s1
  write ( *, '(a,i8)' ) '  S2 = ', s2
  write ( *, '(a,i8)' ) '  S3 = ', s3
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '         I      R                 S1        S2        S3'
  write ( *, '(a)' ) ' '

  do i = 1, 10

    r = r4_random ( s1, s2, s3 )
    write ( *, '(2x,i8,2x,g14.6,2x,i8,2x,i8,2x,i8)' ) i, r, s1, s2, s3

  end do

  return
end
subroutine test04 ( )

!*****************************************************************************80
!
!! TEST04 tests R4_UNI.
!
!  Licensing:
!
!    This code is distributed under the GNU LGPL license.
!
!  Modified:
!
!    08 July 2008
!
!  Author:
!
!    John Burkardt
!
  implicit none

  integer ( kind = 4 ) i
  real ( kind = 4 ) r
  real ( kind = 4 ) r4_uni
  integer ( kind = 4 ) s1
  integer ( kind = 4 ) s2

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST04'
  write ( *, '(a)' ) '  R4_UNI computes pseudorandom values.'
  write ( *, '(a)' ) '  Two seeds, S1 and S2, are used.'

  s1 = 12345
  s2 = 34567

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '      R                     S1            S2'
  write ( *, '(a)' ) ' '
  write ( *, '(2x,14x,2x,i12,2x,i12)' ) s1, s2

  do i = 1, 10
    r = r4_uni ( s1, s2 )
    write ( *, '(2x,g14.6,2x,i12,2x,i12)' ) r, s1, s2
  end do

  return
end
subroutine test05 ( )

!*****************************************************************************80
!
!! TEST05 tests R4_UNI.
!
!  Licensing:
!
!    This code is distributed under the GNU LGPL license.
!
!  Modified:
!
!    08 July 2008
!
!  Author:
!
!    John Burkardt
!
  implicit none

  integer ( kind = 4 ) n
  parameter ( n = 100000 )

  integer ( kind = 4 ) i
  real ( kind = 4 ) r4_uni
  integer ( kind = 4 ) s1
  integer ( kind = 4 ) s2
  real ( kind = 4 ) u(n)
  real ( kind = 4 ) u_avg
  real ( kind = 4 ) u_var

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST05'
  write ( *, '(a)' ) '  Examine the average and variance of a'
  write ( *, '(a)' ) '  sequence generated by R4_UNI.'
!
!  Start with known seeds.
!
  s1 = 12345
  s2 = 34567

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

  u_avg = 0.0E+00
  do i = 1, n
    u(i) = r4_uni ( s1, s2 )
    u_avg = u_avg + u(i)
  end do

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

  u_var = 0.0E+00
  do i = 1, n
    u_var = u_var + ( u(i) - u_avg ) * ( u(i) - u_avg )
  end do

  u_var = u_var / real ( n - 1, kind = 4 )

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

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

  return
end
subroutine test06 ( )

!*****************************************************************************80
!
!! TEST06 tests R4_UNI.
!
!  Licensing:
!
!    This code is distributed under the GNU LGPL license.
!
!  Modified:
!
!    08 July 2008
!
!  Author:
!
!    John Burkardt
!
  implicit none

  integer ( kind = 4 ) i
  real ( kind = 4 ) r
  real ( kind = 4 ) r4_uni
  integer ( kind = 4 ) s1
  integer ( kind = 4 ) s1_save
  integer ( kind = 4 ) s2
  integer ( kind = 4 ) s2_save

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST06'
  write ( *, '(a)' ) '  Show how the seeds used by R4_UNI,'
  write ( *, '(a)' ) '  which change on each step, can be reset to'
  write ( *, '(a)' ) '  restore any part of the sequence.'

  s1_save = 12345
  s2_save = 34567

  s1 = s1_save
  s2 = s2_save

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '  Begin sequence with following seeds:'
  write ( *, '(a)' ) ' '
  write ( *, '(a,i8)' ) '  S1 = ', s1
  write ( *, '(a,i8)' ) '  S2 = ', s2
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '         I      R                     S1            S2'
  write ( *, '(a)' ) ' '

  do i = 1, 10

    r = r4_uni ( s1, s2 )
    write ( *, '(2x,i8,2x,g14.6,2x,i12,2x,i12)' ) i, r, s1, s2

    if ( i == 5 ) then
      s1_save = s1
      s2_save = s2
    end if

  end do

  s1 = s1_save
  s2 = s2_save

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '  Restart the sequence, using the seeds'
  write ( *, '(a)' ) '  produced after step 5:'
  write ( *, '(a)' ) ' '
  write ( *, '(a,i12)' ) '  S1 = ', s1
  write ( *, '(a,i12)' ) '  S2 = ', s2
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '         I      R                     S1            S2'
  write ( *, '(a)' ) ' '

  do i = 1, 10

    r = r4_uni ( s1, s2 )
    write ( *, '(2x,i8,2x,g14.6,2x,i12,2x,i12)' ) i, r, s1, s2

  end do

  return
end
subroutine test07 ( )

!*****************************************************************************80
!
!! TEST07 tests R8_RANDOM.
!
!  Licensing:
!
!    This code is distributed under the GNU LGPL license.
!
!  Modified:
!
!    08 July 2008
!
!  Author:
!
!    John Burkardt
!
  implicit none

  integer ( kind = 4 ) i
  real ( kind = 8 ) r
  real ( kind = 8 ) r8_random
  integer ( kind = 4 ) s1
  integer ( kind = 4 ) s2
  integer ( kind = 4 ) s3

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST07'
  write ( *, '(a)' ) '  R8_RANDOM computes pseudorandom values.'
  write ( *, '(a)' ) '  Three seeds, S1, S2, and S3, are used.'

  s1 = 12345
  s2 = 34567
  s3 = 56789

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '      R                 S1        S2        S3'
  write ( *, '(a)' ) ' '
  write ( *, '(2x,14x,2x,i8,2x,i8,2x,i8)' ) s1, s2, s3

  do i = 1, 10
    r = r8_random ( s1, s2, s3 )
    write ( *, '(2x,g14.6,2x,i8,2x,i8,2x,i8)' ) r, s1, s2, s3
  end do

  return
end
subroutine test08 ( )

!*****************************************************************************80
!
!! TEST08 tests R8_RANDOM.
!
!  Licensing:
!
!    This code is distributed under the GNU LGPL license.
!
!  Modified:
!
!    08 July 2008
!
!  Author:
!
!    John Burkardt
!
  implicit none

  integer ( kind = 4 ) n
  parameter ( n = 100000 )

  integer ( kind = 4 ) i
  real ( kind = 8 ) r8_random
  integer ( kind = 4 ) s1
  integer ( kind = 4 ) s2
  integer ( kind = 4 ) s3
  real ( kind = 8 ) u(n)
  real ( kind = 8 ) u_avg
  real ( kind = 8 ) u_var

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST08'
  write ( *, '(a)' ) '  Examine the average and variance of a'
  write ( *, '(a)' ) '  sequence generated by R8_RANDOM.'
!
!  Start with known seeds.
!
  s1 = 12345
  s2 = 34567
  s3 = 56789

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

  u_avg = 0.0D+00
  do i = 1, n
    u(i) = r8_random ( s1, s2, s3 )
    u_avg = u_avg + u(i)
  end do

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

  u_var = 0.0D+00
  do i = 1, n
    u_var = u_var + ( u(i) - u_avg ) * ( u(i) - u_avg )
  end do

  u_var = u_var / 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 test09 ( )

!*****************************************************************************80
!
!! TEST09 tests R8_RANDOM.
!
!  Licensing:
!
!    This code is distributed under the GNU LGPL license.
!
!  Modified:
!
!    08 July 2008
!
!  Author:
!
!    John Burkardt
!
  implicit none

  integer ( kind = 4 ) i
  real ( kind = 8 ) r
  real ( kind = 8 ) r8_random
  integer ( kind = 4 ) s1
  integer ( kind = 4 ) s1_save
  integer ( kind = 4 ) s2
  integer ( kind = 4 ) s2_save
  integer ( kind = 4 ) s3
  integer ( kind = 4 ) s3_save

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST09'
  write ( *, '(a)' ) '  Show how the seeds used by R8_RANDOM,'
  write ( *, '(a)' ) '  which change on each step, can be reset to'
  write ( *, '(a)' ) '  restore any part of the sequence.'

  s1_save = 12345
  s2_save = 34567
  s3_save = 56789

  s1 = s1_save
  s2 = s2_save
  s3 = s3_save

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '  Begin sequence with following seeds:'
  write ( *, '(a)' ) ' '
  write ( *, '(a,i8)' ) '  S1 = ', s1
  write ( *, '(a,i8)' ) '  S2 = ', s2
  write ( *, '(a,i8)' ) '  S3 = ', s3
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '         I      R                 S1        S2        S3'
  write ( *, '(a)' ) ' '

  do i = 1, 10

    r = r8_random ( s1, s2, s3 )
    write ( *, '(2x,i8,2x,g14.6,2x,i8,2x,i8,2x,i8)' ) i, r, s1, s2, s3

    if ( i == 5 ) then
      s1_save = s1
      s2_save = s2
      s3_save = s3
    end if

  end do

  s1 = s1_save
  s2 = s2_save
  s3 = s3_save

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '  Restart the sequence, using the seeds'
  write ( *, '(a)' ) '  produced after step 5:'
  write ( *, '(a)' ) ' '
  write ( *, '(a,i8)' ) '  S1 = ', s1
  write ( *, '(a,i8)' ) '  S2 = ', s2
  write ( *, '(a,i8)' ) '  S3 = ', s3
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '         I      R                 S1        S2        S3'
  write ( *, '(a)' ) ' '

  do i = 1, 10

    r = r8_random ( s1, s2, s3 )
    write ( *, '(2x,i8,2x,g14.6,2x,i8,2x,i8,2x,i8)' ) i, r, s1, s2, s3

  end do

  return
end
subroutine test10 ( )

!*****************************************************************************80
!
!! TEST10 tests R8_UNI.
!
!  Licensing:
!
!    This code is distributed under the GNU LGPL license.
!
!  Modified:
!
!    08 July 2008
!
!  Author:
!
!    John Burkardt
!
  implicit none

  integer ( kind = 4 ) i
  real ( kind = 8 ) r
  real ( kind = 8 ) r8_uni
  integer ( kind = 4 ) s1
  integer ( kind = 4 ) s2

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST10'
  write ( *, '(a)' ) '  R8_UNI computes pseudorandom values.'
  write ( *, '(a)' ) '  Two seeds, S1 and S2, are used.'

  s1 = 12345
  s2 = 34567

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '      R                     S1            S2'
  write ( *, '(a)' ) ' '
  write ( *, '(2x,14x,2x,i12,2x,i12)' ) s1, s2

  do i = 1, 10
    r = r8_uni ( s1, s2 )
    write ( *, '(2x,g14.6,2x,i12,2x,i12)' ) r, s1, s2
  end do

  return
end
subroutine test11 ( )

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

  integer ( kind = 4 ) n
  parameter ( n = 100000 )

  integer ( kind = 4 ) i
  real ( kind = 8 ) r8_uni
  integer ( kind = 4 ) s1
  integer ( kind = 4 ) s2
  real ( kind = 8 ) u(n)
  real ( kind = 8 ) u_avg
  real ( kind = 8 ) u_var

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST11'
  write ( *, '(a)' ) '  Examine the average and variance of a'
  write ( *, '(a)' ) '  sequence generated by R8_UNI.'
!
!  Start with known seeds.
!
  s1 = 12345
  s2 = 34567

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

  u_avg = 0.0D+00
  do i = 1, n
    u(i) = r8_uni ( s1, s2 )
    u_avg = u_avg + u(i)
  end do

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

  u_var = 0.0D+00
  do i = 1, n
    u_var = u_var + ( u(i) - u_avg ) * ( u(i) - u_avg )
  end do

  u_var = u_var / 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 test12 ( )

!*****************************************************************************80
!
!! TEST12 tests R8_UNI.
!
!  Licensing:
!
!    This code is distributed under the GNU LGPL license.
!
!  Modified:
!
!    08 July 2008
!
!  Author:
!
!    John Burkardt
!
  implicit none

  integer ( kind = 4 ) i
  real ( kind = 8 ) r
  real ( kind = 8 ) r8_uni
  integer ( kind = 4 ) s1
  integer ( kind = 4 ) s1_save
  integer ( kind = 4 ) s2
  integer ( kind = 4 ) s2_save

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST12'
  write ( *, '(a)' ) '  Show how the seeds used by R8_UNI,'
  write ( *, '(a)' ) '  which change on each step, can be reset to'
  write ( *, '(a)' ) '  restore any part of the sequence.'

  s1_save = 12345
  s2_save = 34567

  s1 = s1_save
  s2 = s2_save

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '  Begin sequence with following seeds:'
  write ( *, '(a)' ) ' '
  write ( *, '(a,i8)' ) '  S1 = ', s1
  write ( *, '(a,i8)' ) '  S2 = ', s2
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '         I      R                     S1            S2'
  write ( *, '(a)' ) ' '

  do i = 1, 10

    r = r8_uni ( s1, s2 )
    write ( *, '(2x,i8,2x,g14.6,2x,i12,2x,i12)' ) i, r, s1, s2

    if ( i == 5 ) then
      s1_save = s1
      s2_save = s2
    end if

  end do

  s1 = s1_save
  s2 = s2_save

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '  Restart the sequence, using the seeds'
  write ( *, '(a)' ) '  produced after step 5:'
  write ( *, '(a)' ) ' '
  write ( *, '(a,i12)' ) '  S1 = ', s1
  write ( *, '(a,i12)' ) '  S2 = ', s2
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '         I      R                     S1            S2'
  write ( *, '(a)' ) ' '

  do i = 1, 10

    r = r8_uni ( s1, s2 )
    write ( *, '(2x,i8,2x,g14.6,2x,i12,2x,i12)' ) i, r, s1, s2

  end do

  return
end