#pragma -z
      program main

c*********************************************************************72
c
cc fftpack5.1_test() tests fftpack5.1().
c
c  Licensing:
c
c    This code is distributed under the MIT license. 
c
c  Modified:
c
c    29 March 2011
c
c  Author:
c
c    John Burkardt
c
      implicit none

      write ( *, '(a)' ) ' '
      write ( *, '(a)' ) 'fftpack5.1_test():'
      write ( *, '(a)' ) '  FORTRAN77 version'
      write ( *, '(a)' ) '  Test fftpack5.1().'

      call test01 ( )
      call test02 ( )
      call test03 ( )
      call test04 ( )
      call test05 ( )
      call test06 ( )
      call test07 ( )
      call test08 ( )
      call test09 ( )
      call test10 ( )
      call test11 ( )
      call test12 ( )
      call test13 ( )
      call test14 ( )
c
c  Terminate.
c
      write ( *, '(a)' ) ' '
      write ( *, '(a)' ) 'fftpack5.1_test():'
      write ( *, '(a)' ) '  Normal end of execution.'
      write ( *, '(a)' ) ' '

      stop
      end
      subroutine test01 ( )

c*********************************************************************72
c
cc TEST01 tests CFFT1B, CFFT1F and CFFT1I.
c
c  Licensing:
c
c    This code is distributed under the MIT license. 
c
c  Modified:
c
c    29 March 2011
c
c  Author:
c
c    John Burkardt
c
      implicit none

      integer n
      parameter ( n = 4096 )

      integer lenwrk
      parameter ( lenwrk = 2 * n )

      integer lensav
      parameter ( lensav = 
     &  2 * n + int ( log ( real ( n ) ) / log ( 2.0E+00 ) ) + 4 )

      complex c(n)
      integer ier
      integer inc
      integer lenc
      integer seed
      real work(lenwrk)
      real wsave(lensav)

      write ( *, '(a)' ) ' '
      write ( *, '(a)' ) 'TEST01'
      write ( *, '(a)' ) '  For complex fast Fourier transforms, 1D,'
      write ( *, '(a)' ) '  CFFT1I initializes the transform,'
      write ( *, '(a)' ) '  CFFT1F does a forward transform;'
      write ( *, '(a)' ) '  CFFT1B does a backward transform.'
      write ( *, '(a)' ) ' '
      write ( *, '(a,i4)' ) '  The number of data items is N = ', n
      write ( *, '(a,i8)' ) '  Workspace size LENSAV = ', lensav
c
c  Set the data values.
c
      seed = 1973

      call c4vec_uniform_01 ( n, seed, c )

      call c4vec_print_part ( n, c, 10, '  The original data:' )
c
c  Initialize the WSAVE array.
c
      call dcfft1i ( n, wsave, lensav, ier )
c
c  Compute the FFT coefficients.
c
      inc = 1
      lenc = n

      call dcfft1f ( n, inc, c, lenc, wsave, lensav, work, lenwrk, ier )

      call c4vec_print_part ( n, c, 10, '  The FFT coefficients:' )
c
c  Compute inverse FFT of coefficients.  Should get back the
c  original data.
c
      call dcfft1b ( n, inc, c, lenc, wsave, lensav, work, lenwrk, ier )

      call c4vec_print_part ( n, c, 10, '  The retrieved data:' )

      return
      end
      subroutine test02 ( )

c*********************************************************************72
c
cc TEST02 tests CFFT2B, CFFT2F and CFFT2I.
c
c  Licensing:
c
c    This code is distributed under the MIT license. 
c
c  Modified:
c
c    29 March 2011
c
c  Author:
c
c    John Burkardt
c
      implicit none

      integer l
      integer m

      parameter ( l = 32 )
      parameter ( m = 64 )

      integer lenwrk
      parameter ( lenwrk = 2 * l * m )

      integer lensav
      parameter ( lensav = 
     &    2 * l + int ( log ( real ( l ) ) / log ( 2.0E+00 ) ) 
     &  + 2 * m + int ( log ( real ( m ) ) / log ( 2.0E+00 ) ) 
     &  + 8 )

      complex c(l,m)
      integer ier
      integer ldim
      integer seed
      real work(lenwrk)
      real wsave(lensav)

      write ( *, '(a)' ) ' '
      write ( *, '(a)' ) 'TEST02'
      write ( *, '(a)' ) '  For complex fast Fourier transforms, 2D,'
      write ( *, '(a)' ) '  CFFT2I initializes the transform,'
      write ( *, '(a)' ) '  CFFT2F does a forward transform;'
      write ( *, '(a)' ) '  CFFT2B does a backward transform.'
      write ( *, '(a)' ) ' '
      write ( *, '(a)' ) '  The data is stored in an L by M array, with'
      write ( *, '(a,i4)' ) '  L = ', l
      write ( *, '(a,i4)' ) '  M = ', m
      write ( *, '(a,i8)' ) '  Workspace size LENSAV = ', lensav
c
c  Set the data values.
c
      seed = 1973

      call c4mat_uniform_01 ( l, m, seed, c )

      call c4mat_print_some ( l, m, c, 1, 1, 5, 5, 
     &  '  Part of the original data:' )
c
c  Initialize the WSAVE array.
c
      call dcfft2i ( l, m, wsave, lensav, ier )
c
c  Compute the FFT coefficients.
c
      ldim = l

      call dcfft2f ( ldim, l, m, c, wsave, lensav, work, lenwrk, ier )

      call c4mat_print_some ( l, m, c, 1, 1, 5, 5, 
     &  '  Part of the FFT coefficients:' )
c
c  Compute inverse FFT of coefficients.  Should get back the
c  original data.
c
      call dcfft2b ( ldim, l, m, c, wsave, lensav, work, lenwrk, ier )

      call c4mat_print_some ( l, m, c, 1, 1, 5, 5, 
     &  '  Part of the retrieved data:' )

      return
      end
      subroutine test03 ( )

c*********************************************************************72
c
cc TEST03 tests CFFTMB, CFFTMF and CFFTMI.
c
c  Licensing:
c
c    This code is distributed under the MIT license. 
c
c  Modified:
c
c    29 March 2011
c
c  Author:
c
c    John Burkardt
c
      implicit none

      integer n
      integer lot

      parameter ( n = 32 )
      parameter ( lot = 6 )

      integer lenc
      integer lenwrk

      parameter ( lenc = n * lot )
      parameter ( lenwrk = 2 * lot * n )

      integer lensav
      parameter ( lensav = 
     &  2 * n + int ( log ( real ( n ) ) / log ( 2.0E+00 ) ) + 4 )

      complex c(lenc)
      integer ier
      integer inc
      integer jump
      integer seed
      real work(lenwrk)
      real wsave(lensav)

      write ( *, '(a)' ) ' '
      write ( *, '(a)' ) 'TEST03'
      write ( *, '(a)' ) '  For complex fast Fourier transforms,'
      write ( *, '(a)' ) '  1D, multiple'
      write ( *, '(a)' ) '  CFFTMI initializes the transform,'
      write ( *, '(a)' ) '  CFFTMF does a forward transform;'
      write ( *, '(a)' ) '  CFFTMB does a backward transform.'
      write ( *, '(a)' ) ' '
      write ( *, '(a,i4)' ) '  The number of sequences is LOT = ', lot
      write ( *, '(a,i4)' ) '  The length of each sequence is N = ', n
      write ( *, '(a,i8)' ) '  Workspace size LENSAV = ', lensav
c
c  Set the data values.
c
      seed = 1973

      call c4mat_uniform_01 ( n, lot, seed, c )

      call c4mat_print_some ( n, lot, c, 1, 1, 5, 5, 
     &  '  Part of the original data:' )
c
c  Initialize the WSAVE array.
c
      call dcfftmi ( n, wsave, lensav, ier )
c
c  Compute the FFT coefficients.
c
      jump = n
      inc = 1

      call dcfftmf ( lot, jump, n, inc, c, lenc, wsave, lensav, 
     &  work, lenwrk, ier )

      call c4mat_print_some ( n, lot, c, 1, 1, 5, 5, 
     &  '  Part of the FFT coefficients:' )
c
c  Compute inverse FFT of coefficients.  Should get back the
c  original data.
c
      call dcfftmb ( lot, jump, n, inc, c, lenc, wsave, lensav, 
     &  work, lenwrk, ier )

      call c4mat_print_some ( n, lot, c, 1, 1, 5, 5, 
     &  '  Part of the retrieved data:' )

      return
      end
      subroutine test04 ( )

c*********************************************************************72
c
cc TEST04 tests COSQ1B, COSQ1F and COSQ1I.
c
c  Licensing:
c
c    This code is distributed under the MIT license. 
c
c  Modified:
c
c    29 March 2011
c
c  Author:
c
c    John Burkardt
c
      implicit none

      integer n
      parameter ( n = 4096 )

      integer lenwrk
      parameter ( lenwrk = n )

      integer lensav
      parameter ( lensav = 
     &  2 * n + int ( log ( real ( n ) ) / log ( 2.0E+00 ) ) + 4 )

      integer ier
      integer inc
      integer lenr
      real r(n)
      integer seed
      real work(lenwrk)
      real wsave(lensav)

      write ( *, '(a)' ) ' '
      write ( *, '(a)' ) 'TEST04'
      write ( *, '(a)' ) '  For real fast cosine transforms, 1D,'
      write ( *, '(a)' ) '  COSQ1I initializes the transform,'
      write ( *, '(a)' ) '  COSQ1F does a forward transform;'
      write ( *, '(a)' ) '  COSQ1B does a backward transform.'
      write ( *, '(a)' ) ' '
      write ( *, '(a,i4)' ) '  The number of data items is N = ', n
      write ( *, '(a,i8)' ) '  Workspace size LENSAV = ', lensav
c
c  Set the data values.
c
      seed = 1973

      call r4vec_uniform_01 ( n, seed, r )

      call r4vec_print_part ( n, r, 10, '  The original data:' )
c
c  Initialize the WSAVE array.
c
      call dcosq1i ( n, wsave, lensav, ier )
c
c  Compute the FFT coefficients.
c
      inc = 1
      lenr = n

      call dcosq1f ( n, inc, r, lenr, wsave, lensav, work, 
     &  lenwrk, ier )

      call r4vec_print_part ( n, r, 10, '  The FFT coefficients:' )
c
c  Compute inverse FFT of coefficients.  Should get back the
c  original data.
c
      call dcosq1b ( n, inc, r, lenr, wsave, lensav, work, lenwrk, ier )

      call r4vec_print_part ( n, r, 10, '  The retrieved data:' )

      return
      end
      subroutine test05 ( )

c*********************************************************************72
c
cc TEST05 tests COSQMB, COSQMF and COSQMI.
c
c  Licensing:
c
c    This code is distributed under the MIT license. 
c
c  Modified:
c
c    29 March 2011
c
c  Author:
c
c    John Burkardt
c
      implicit none

      integer n
      integer lot

      parameter ( n = 32 )
      parameter ( lot = 6 )

      integer lenr
      parameter ( lenr = n * lot )

      integer lenwrk
      parameter ( lenwrk = lot * n )

      integer lensav
      parameter ( lensav = 
     &  2 * n + int ( log ( real ( n ) ) / log ( 2.0E+00 ) ) + 4 )

      integer ier
      integer inc
      integer jump
      real r(lenr)
      integer seed
      real work(lenwrk)
      real wsave(lensav)

      write ( *, '(a)' ) ' '
      write ( *, '(a)' ) 'TEST05'
      write ( *, '(a)' ) '  For real fast cosine transforms, '
      write ( *, '(a)' ) '  1D, multiple'
      write ( *, '(a)' ) '  COSQMI initializes the transform,'
      write ( *, '(a)' ) '  COSQMF does a forward transform;'
      write ( *, '(a)' ) '  COSQMB does a backward transform.'
      write ( *, '(a)' ) ' '
      write ( *, '(a,i4)' ) '  The number of sequences is LOT = ', lot
      write ( *, '(a,i4)' ) '  The length of each sequence is N = ', n
      write ( *, '(a,i8)' ) '  Workspace size LENSAV = ', lensav
c
c  Set the data values.
c
      seed = 1973

      call r4mat_uniform_01 ( n, lot, seed, r )

      call r4mat_print_some ( n, lot, r, 1, 1, 5, 5, 
     &  '  Part of the original data:' )
c
c  Initialize the WSAVE array.
c
      call dcosqmi ( n, wsave, lensav, ier )
c
c  Compute the FFT coefficients.
c
      jump = n
      inc = 1

      call dcosqmf ( lot, jump, n, inc, r, lenr, wsave, lensav, 
     &  work, lenwrk, ier )

      call r4mat_print_some ( n, lot, r, 1, 1, 5, 5, 
     &  '  Part of the FFT coefficients:' )
c
c  Compute inverse FFT of coefficients.  Should get back the
c  original data.
c
      call dcosqmb ( lot, jump, n, inc, r, lenr, wsave, lensav, 
     &  work, lenwrk, ier )

      call r4mat_print_some ( n, lot, r, 1, 1, 5, 5, 
     &  '  Part of the retrieved data:' )

      return
      end
      subroutine test06 ( )

c*********************************************************************72
c
cc TEST06 tests COST1B, COST1F and COST1I.
c
c  Licensing:
c
c    This code is distributed under the MIT license. 
c
c  Modified:
c
c    29 March 2011
c
c  Author:
c
c    John Burkardt
c
      implicit none

      integer n
      parameter ( n = 4096 )

      integer lenwrk
      parameter ( lenwrk = n - 1 )

      integer lensav
      parameter ( lensav = 
     &  2 * n + int ( log ( real ( n ) ) / log ( 2.0E+00 ) ) + 4 )

      integer ier
      integer inc
      integer lenr
      real r(n)
      integer seed
      real work(lenwrk)
      real wsave(lensav)

      write ( *, '(a)' ) ' '
      write ( *, '(a)' ) 'TEST06'
      write ( *, '(a)' ) '  For real fast cosine transforms, 1D,'
      write ( *, '(a)' ) '  COST1I initializes the transform,'
      write ( *, '(a)' ) '  COST1F does a forward transform;'
      write ( *, '(a)' ) '  COST1B does a backward transform.'
      write ( *, '(a)' ) ' '
      write ( *, '(a,i4)' ) '  The number of data items is N = ', n
      write ( *, '(a,i8)' ) '  Workspace size LENSAV = ', lensav
c
c  Set the data values.
c
      seed = 1973

      call r4vec_uniform_01 ( n, seed, r )

      call r4vec_print_part ( n, r, 10, '  The original data:' )
c
c  Initialize the WSAVE array.
c
      call dcost1i ( n, wsave, lensav, ier )
c
c  Compute the FFT coefficients.
c
      inc = 1
      lenr = n

      call dcost1f ( n, inc, r, lenr, wsave, lensav, work, lenwrk, ier )

      call r4vec_print_part ( n, r, 10, '  The FFT coefficients:' )
c
c  Compute inverse FFT of coefficients.  Should get back the
c  original data.
c
      call dcost1b ( n, inc, r, lenr, wsave, lensav, work, lenwrk, ier )

      call r4vec_print_part ( n, r, 10, '  The retrieved data:' )

      return
      end
      subroutine test07 ( )

c*********************************************************************72
c
cc TEST07 tests COSTMB, COSTMF and COSTMI.
c
c  Licensing:
c
c    This code is distributed under the MIT license. 
c
c  Modified:
c
c    29 March 2011
c
c  Author:
c
c    John Burkardt
c
      implicit none

      integer n
      integer lot

      parameter ( n = 32 )
      parameter ( lot = 6 )

      integer lenr
      parameter ( lenr = n * lot )

      integer lenwrk
      parameter ( lenwrk = lot * ( n + 1 ) )

      integer lensav
      parameter ( lensav = 
     &  2 * n + int ( log ( real ( n ) ) / log ( 2.0E+00 ) ) + 4 )

      integer ier
      integer inc
      integer jump
      real r(lenr)
      integer seed
      real work(lenwrk)
      real wsave(lensav)

      write ( *, '(a)' ) ' '
      write ( *, '(a)' ) 'TEST07'
      write ( *, '(a)' ) '  For real fast cosine transforms, '
      write ( *, '(a)' ) '  1D, multiple'
      write ( *, '(a)' ) '  COSTMI initializes the transform,'
      write ( *, '(a)' ) '  COSTMF does a forward transform;'
      write ( *, '(a)' ) '  COSTMB does a backward transform.'
      write ( *, '(a)' ) ' '
      write ( *, '(a,i4)' ) '  The number of sequences is LOT = ', lot
      write ( *, '(a,i4)' ) '  The length of each sequence is N = ', n
      write ( *, '(a,i8)' ) '  Workspace size LENSAV = ', lensav
c
c  Set the data values.
c
      seed = 1973

      call r4mat_uniform_01 ( n, lot, seed, r )

      call r4mat_print_some ( n, lot, r, 1, 1, 5, 5, 
     &  '  Part of the original data:' )
c
c  Initialize the WSAVE array.
c
      call dcostmi ( n, wsave, lensav, ier )
c
c  Compute the FFT coefficients.
c
      jump = n
      inc = 1

      call dcostmf ( lot, jump, n, inc, r, lenr, wsave, lensav, 
     &  work, lenwrk, ier )

      call r4mat_print_some ( n, lot, r, 1, 1, 5, 5, 
     &  '  Part of the FFT coefficients:' )
c
c  Compute inverse FFT of coefficients.  Should get back the
c  original data.
c
      call dcostmb ( lot, jump, n, inc, r, lenr, wsave, lensav, 
     &  work, lenwrk, ier )

      call r4mat_print_some ( n, lot, r, 1, 1, 5, 5, 
     &  '  Part of the retrieved data:' )

      return
      end
      subroutine test08 ( )

c*********************************************************************72
c
cc TEST08 tests RFFT1B, RFFT1F and RFFT1I.
c
c  Licensing:
c
c    This code is distributed under the MIT license. 
c
c  Modified:
c
c    29 March 2011
c
c  Author:
c
c    John Burkardt
c
      implicit none

      integer n
      parameter ( n = 4096 )

      integer lenwrk
      parameter ( lenwrk = 2 * n )

      integer lensav
      parameter ( lensav = 
     &  n + int ( log ( real ( n ) ) / log ( 2.0E+00 ) ) + 4 )

      integer ier
      integer inc
      integer lenr
      real r(n)
      integer seed
      real work(lenwrk)
      real wsave(lensav)

      write ( *, '(a)' ) ' '
      write ( *, '(a)' ) 'TEST08'
      write ( *, '(a)' ) '  For real fast Fourier transforms, 1D,'
      write ( *, '(a)' ) '  RFFT1I initializes the transform,'
      write ( *, '(a)' ) '  RFFT1F does a forward transform;'
      write ( *, '(a)' ) '  RFFT1B does a backward transform.'
      write ( *, '(a)' ) ' '
      write ( *, '(a,i4)' ) '  The number of data items is N = ', n
      write ( *, '(a,i8)' ) '  Workspace size LENSAV = ', lensav
c
c  Set the data values.
c
      seed = 1973

      call r4vec_uniform_01 ( n, seed, r )

      call r4vec_print_part ( n, r, 10, '  The original data:' )
c
c  Initialize the WSAVE array.
c
      call drfft1i ( n, wsave, lensav, ier )
c
c  Compute the FFT coefficients.
c
      inc = 1
      lenr = n

      call drfft1f ( n, inc, r, lenr, wsave, lensav, work, lenwrk, ier )

      call r4vec_print_part ( n, r, 10, '  The FFT coefficients:' )
c
c  Compute inverse FFT of coefficients.  Should get back the
c  original data.
c
      call drfft1b ( n, inc, r, lenr, wsave, lensav, work, lenwrk, ier )

      call r4vec_print_part ( n, r, 10, '  The retrieved data:' )

      return
      end
      subroutine test09 ( )

c*********************************************************************72
c
cc TEST09 tests RFFT2B, RFFT2F and RFFT2I.
c
c  Licensing:
c
c    This code is distributed under the MIT license. 
c
c  Modified:
c
c    29 March 2011
c
c  Author:
c
c    John Burkardt
c
      implicit none

      integer l
      integer m
      parameter ( l = 32 )
      parameter ( m = 64 )

      integer ldim
      parameter ( ldim = 2 * ( l / 2 + 1 ) )

      integer lenwrk
      parameter ( lenwrk = 2 * ldim * m )

      integer lensav
      parameter ( lensav = 
     &        l + int ( log ( real ( l ) ) / log ( 2.0E+00 ) ) + 4
     &  + 2 * m + int ( log ( real ( m ) ) / log ( 2.0E+00 ) ) + 4
     &  +     m + int ( log ( real ( m ) ) / log ( 2.0E+00 ) ) + 4 )


      integer ier
      real r(ldim,m)
      integer seed
      real work(lenwrk)
      real wsave(lensav)

      write ( *, '(a)' ) ' '
      write ( *, '(a)' ) 'TEST09'
      write ( *, '(a)' ) '  For real fast Fourier transforms, 2D,'
      write ( *, '(a)' ) '  RFFT2I initializes the transform,'
      write ( *, '(a)' ) '  RFFT2F does a forward transform;'
      write ( *, '(a)' ) '  RFFT2B does a backward transform.'
      write ( *, '(a)' ) ' '
      write ( *, '(a)' ) '  The L by M data is stored in an '
      write ( *, '(a)' ) '  LDIM by M array, with'
      write ( *, '(a,i4)' ) '  L = ', l
      write ( *, '(a,i4)' ) '  LDIM = ', ldim
      write ( *, '(a,i4)' ) '  M = ', m
      write ( *, '(a,i8)' ) '  Workspace size LENSAV = ', lensav
c
c  Set the data values.
c
      seed = 1973

      call r4mat_uniform_01 ( ldim, m, seed, r )

      call r4mat_print_some ( ldim, m, r, 1, 1, 5, 5, 
     &  '  Part of the original data:' )
c
c  Initialize the WSAVE array.
c
      call drfft2i ( l, m, wsave, lensav, ier )
c
c  Compute the FFT coefficients.
c
      call drfft2f ( ldim, l, m, r, wsave, lensav, work, lenwrk, ier )

      call r4mat_print_some ( ldim, m, r, 1, 1, 5, 5, 
     &  '  Part of the FFT coefficients:' )
c
c  Compute inverse FFT of coefficients.  Should get back the
c  original data.
c
      call drfft2b ( ldim, l, m, r, wsave, lensav, work, lenwrk, ier )

      call r4mat_print_some ( ldim, m, r, 1, 1, 5, 5, 
     &  '  Part of the retrieved data:' )

      return
      end
      subroutine test10 ( )

c*********************************************************************72
c
cc TEST10 tests RFFTMB, RFFTMF and RFFTMI.
c
c  Licensing:
c
c    This code is distributed under the MIT license. 
c
c  Modified:
c
c    29 March 2011
c
c  Author:
c
c    John Burkardt
c
      implicit none

      integer n
      integer lot

      parameter ( n = 32 )
      parameter ( lot = 6 )

      integer lenr
      parameter ( lenr = n * lot )

      integer lenwrk
      parameter ( lenwrk = lot * n )

      integer lensav
      parameter ( lensav =
     &  n + int ( log ( real ( n ) ) / log ( 2.0E+00 ) ) + 4 )

      integer ier
      integer inc
      integer jump
      real r(lenr)
      integer seed
      real work(lenwrk)
      real wsave(lensav)

      write ( *, '(a)' ) ' '
      write ( *, '(a)' ) 'TEST10'
      write ( *, '(a)' ) '  For real fast Fourier transforms, '
      write ( *, '(a)' ) '  1D, multiple'
      write ( *, '(a)' ) '  RFFTMI initializes the transform,'
      write ( *, '(a)' ) '  RFFTMF does a forward transform;'
      write ( *, '(a)' ) '  RFFTMB does a backward transform.'
      write ( *, '(a)' ) ' '
      write ( *, '(a,i4)' ) '  The number of sequences is LOT = ', lot
      write ( *, '(a,i4)' ) '  The length of each sequence is N = ', n
      write ( *, '(a,i8)' ) '  Workspace size LENSAV = ', lensav
c
c  Set the data values.
c
      seed = 1973

      call r4mat_uniform_01 ( n, lot, seed, r )

      call r4mat_print_some ( n, lot, r, 1, 1, 5, 5, 
     &  '  Part of the original data:' )
c
c  Initialize the WSAVE array.
c
      call drfftmi ( n, wsave, lensav, ier )
c
c  Compute the FFT coefficients.
c
      jump = n
      inc = 1

      call drfftmf ( lot, jump, n, inc, r, lenr, wsave, lensav, 
     &  work, lenwrk, ier )

      call r4mat_print_some ( n, lot, r, 1, 1, 5, 5, 
     &  '  Part of the FFT coefficients:' )
c
c  Compute inverse FFT of coefficients.  Should get back the
c  original data.
c
      call drfftmb ( lot, jump, n, inc, r, lenr, wsave, lensav, 
     &  work, lenwrk, ier )

      call r4mat_print_some ( n, lot, r, 1, 1, 5, 5, 
     &  '  Part of the retrieved data:' )

      return
      end
      subroutine test11 ( )

c*********************************************************************72
c
cc TEST11 tests SINQ1B, SINQ1F and SINQ1I.
c
c  Licensing:
c
c    This code is distributed under the MIT license. 
c
c  Modified:
c
c    29 March 2011
c
c  Author:
c
c    John Burkardt
c
      implicit none

      integer n
      parameter ( n = 4096 )

      integer lenwrk
      parameter ( lenwrk = n )

      integer lensav
      parameter ( lensav = 
     &  2 * n + int ( log ( real ( n ) ) / log ( 2.0E+00 ) ) + 4 )

      integer ier
      integer inc
      integer lenr
      real r(n)
      integer seed
      real work(lenwrk)
      real wsave(lensav)

      write ( *, '(a)' ) ' '
      write ( *, '(a)' ) 'TEST11'
      write ( *, '(a)' ) '  For real fast sine transforms, 1D,'
      write ( *, '(a)' ) '  SINQ1I initializes the transform,'
      write ( *, '(a)' ) '  SINQ1F does a forward transform;'
      write ( *, '(a)' ) '  SINQ1B does a backward transform.'
      write ( *, '(a)' ) ' '
      write ( *, '(a,i4)' ) '  The number of data items is N = ', n
      write ( *, '(a,i8)' ) '  Workspace size LENSAV = ', lensav
c
c  Set the data values.
c
      seed = 1973

      call r4vec_uniform_01 ( n, seed, r )

      call r4vec_print_part ( n, r, 10, '  The original data:' )
c
c  Initialize the WSAVE array.
c
      call dsinq1i ( n, wsave, lensav, ier )
c
c  Compute the FFT coefficients.
c
      inc = 1
      lenr = n

      call dsinq1f ( n, inc, r, lenr, wsave, lensav, work, 
     &  lenwrk, ier )

      call r4vec_print_part ( n, r, 10, '  The FFT coefficients:' )
c
c  Compute inverse FFT of coefficients.  Should get back the
c  original data.
c
      call dsinq1b ( n, inc, r, lenr, wsave, lensav, work, lenwrk, ier )

      call r4vec_print_part ( n, r, 10, '  The retrieved data:' )

      return
      end
      subroutine test12 ( )

c*********************************************************************72
c
cc TEST12 tests SINQMB, SINQMF and SINQMI.
c
c  Licensing:
c
c    This code is distributed under the MIT license. 
c
c  Modified:
c
c    29 March 2011
c
c  Author:
c
c    John Burkardt
c
      implicit none

      integer n
      integer lot

      parameter ( n = 32 )
      parameter ( lot = 6 )

      integer lenr
      parameter ( lenr = n * lot )

      integer lenwrk
      parameter ( lenwrk = lot * n )

      integer lensav
      parameter ( lensav = 
     &  2 * n + int ( log ( real ( n ) ) / log ( 2.0E+00 ) ) + 4 )

      integer ier
      integer inc
      integer jump
      real r(lenr)
      integer seed
      real work(lenwrk)
      real wsave(lensav)

      write ( *, '(a)' ) ' '
      write ( *, '(a)' ) 'TEST12'
      write ( *, '(a)' ) '  For real fast sine transforms, 1D, multiple'
      write ( *, '(a)' ) '  SINQMI initializes the transform,'
      write ( *, '(a)' ) '  SINQMF does a forward transform;'
      write ( *, '(a)' ) '  SINQMB does a backward transform.'
      write ( *, '(a)' ) ' '
      write ( *, '(a,i4)' ) '  The number of sequences is LOT = ', lot
      write ( *, '(a,i4)' ) '  The length of each sequence is N = ', n
      write ( *, '(a,i8)' ) '  Workspace size LENSAV = ', lensav
c
c  Set the data values.
c
      seed = 1973

      call r4mat_uniform_01 ( n, lot, seed, r )

      call r4mat_print_some ( n, lot, r, 1, 1, 5, 5, 
     &  '  Part of the original data:' )
c
c  Initialize the WSAVE array.
c
      call dsinqmi ( n, wsave, lensav, ier )
c
c  Compute the FFT coefficients.
c
      jump = n
      inc = 1

      call dsinqmf ( lot, jump, n, inc, r, lenr, wsave, lensav, 
     &  work, lenwrk, ier )

      call r4mat_print_some ( n, lot, r, 1, 1, 5, 5, 
     &  '  Part of the FFT coefficients:' )
c
c  Compute inverse FFT of coefficients.  Should get back the
c  original data.
c
      call dsinqmb ( lot, jump, n, inc, r, lenr, wsave, lensav, 
     &  work, lenwrk, ier )

      call r4mat_print_some ( n, lot, r, 1, 1, 5, 5, 
     &  '  Part of the retrieved data:' )

      return
      end
      subroutine test13 ( )

c*********************************************************************72
c
cc TEST13 tests SINT1B, SINT1F and SINT1I.
c
c  Licensing:
c
c    This code is distributed under the MIT license. 
c
c  Modified:
c
c    29 March 2011
c
c  Author:
c
c    John Burkardt
c
      implicit none

      integer n
      parameter ( n = 4096 )

      integer lenwrk
      parameter ( lenwrk = 2 * ( n + 1 ) )

      integer lensav
      parameter ( lensav = 
     &  n / 2 + n + int ( log ( real ( n ) ) / log ( 2.0E+00 ) ) + 4 )

      integer ier
      integer inc
      integer lenr
      real r(n)
      integer seed
      real work(lenwrk)
      real wsave(lensav)

      write ( *, '(a)' ) ' '
      write ( *, '(a)' ) 'TEST13'
      write ( *, '(a)' ) '  For real fast sine transforms, 1D,'
      write ( *, '(a)' ) '  SINT1I initializes the transform,'
      write ( *, '(a)' ) '  SINT1F does a forward transform;'
      write ( *, '(a)' ) '  SINT1B does a backward transform.'
      write ( *, '(a)' ) ' '
      write ( *, '(a,i4)' ) '  The number of data items is N = ', n
      write ( *, '(a,i8)' ) '  Workspace size LENSAV = ', lensav
c
c  Set the data values.
c
      seed = 1973

      call r4vec_uniform_01 ( n, seed, r )

      call r4vec_print_part ( n, r, 10, '  The original data:' )
c
c  Initialize the WSAVE array.
c
      call dsint1i ( n, wsave, lensav, ier )
c
c  Compute the FFT coefficients.
c
      inc = 1
      lenr = n

      call dsint1f ( n, inc, r, lenr, wsave, lensav, work, 
     &  lenwrk, ier )

      call r4vec_print_part ( n, r, 10, '  The FFT coefficients:' )
c
c  Compute inverse FFT of coefficients.  Should get back the
c  original data.
c
      call dsint1b ( n, inc, r, lenr, wsave, lensav, work, lenwrk, ier )

      call r4vec_print_part ( n, r, 10, '  The retrieved data:' )

      return
      end
      subroutine test14 ( )

c*********************************************************************72
c
cc TEST14 tests SINTMB, SINTMF and SINTMI.
c
c  Licensing:
c
c    This code is distributed under the MIT license. 
c
c  Modified:
c
c    29 March 2011
c
c  Author:
c
c    John Burkardt
c
      implicit none

      integer n
      integer lot

      parameter ( n = 32 )
      parameter ( lot = 6 )

      integer lenr
      parameter ( lenr = n * lot )

      integer lenwrk
      parameter ( lenwrk = lot * 2 * ( n + 2 ) )

      integer lensav
      parameter ( lensav = 
     &  n / 2 + n + int ( log ( real ( n ) ) / log( 2.0 ) ) + 4 )

      integer ier
      integer inc
      integer jump
      real r(lenr)
      integer seed
      real work(lenwrk)
      real wsave(lensav)

      write ( *, '(a)' ) ' '
      write ( *, '(a)' ) 'TEST14'
      write ( *, '(a)' ) '  For real fast sine transforms, 1D, multiple'
      write ( *, '(a)' ) '  SINTMI initializes the transform,'
      write ( *, '(a)' ) '  SINTMF does a forward transform;'
      write ( *, '(a)' ) '  SINTMB does a backward transform.'
      write ( *, '(a)' ) ' '
      write ( *, '(a,i4)' ) '  The number of sequences is LOT = ', lot
      write ( *, '(a,i4)' ) '  The length of each sequence is N = ', n
      write ( *, '(a,i8)' ) '  Workspace size LENSAV = ', lensav
c
c  Set the data values.
c
      seed = 1973

      call r4mat_uniform_01 ( n, lot, seed, r )

      call r4mat_print_some ( n, lot, r, 1, 1, 5, 5, 
     &  '  Part of the original data:' )
c
c  Initialize the WSAVE array.
c
      call dsintmi ( n, wsave, lensav, ier )
c
c  Compute the FFT coefficients.
c
      jump = n
      inc = 1

      call dsintmf ( lot, jump, n, inc, r, lenr, wsave, lensav, 
     &  work, lenwrk, ier )

      call r4mat_print_some ( n, lot, r, 1, 1, 5, 5, 
     &  '  Part of the FFT coefficients:' )
c 
c  Compute inverse FFT of coefficients.  Should get back the
c  original data.
c
      call dsintmb ( lot, jump, n, inc, r, lenr, wsave, lensav, 
     &  work, lenwrk, ier )

      call r4mat_print_some ( n, lot, r, 1, 1, 5, 5, 
     &  '  Part of the retrieved data:' )

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

c*********************************************************************72
c
cc C4MAT_PRINT prints a C4MAT.
c
c  Licensing:
c
c    This code is distributed under the MIT license. 
c
c  Modified:
c
c    23 March 2005
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer M, N, the number of rows and columns in the matrix.
c
c    Input, complex A(M,N), the matrix.
c
c    Input, character*(*) TITLE, a title.
c
      implicit none

      integer m
      integer n

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

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

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

c*********************************************************************72
c
cc C4MAT_PRINT_SOME prints some of a C4MAT.
c
c  Licensing:
c
c    This code is distributed under the MIT license. 
c
c  Modified:
c
c    23 March 2005
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer M, N, the number of rows and columns in the matrix.
c
c    Input, complex A(M,N), the matrix.
c
c    Input, integer ILO, JLO, IHI, JHI, the first row and
c    column, and the last row and column to be printed.
c
c    Input, character*(*) TITLE, a title.
c
      implicit none

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

      complex a(m,n)
      character*20 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
      complex zero

      zero = cmplx ( 0.0E+00, 0.0E+00 )

      write ( *, '(a)' ) ' '
      write ( *, '(a)' ) title
c
c  Print the columns of the matrix, in strips of INCX.
c
      do j2lo = jlo, jhi, 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), '(i10,10x)' ) j
        end do

        write ( *, '(a,4a20)' ) '  Col: ', ( ctemp(j2), j2 = 1, inc )
        write ( *, '(a)' ) '  Row'
        write ( *, '(a)' ) '  ---'
c
c  Determine the range of the rows in this strip.
c
        i2lo = max ( ilo, 1 )
        i2hi = min ( ihi, m )

        do i = i2lo, i2hi
c
c  Print out (up to) INCX entries in row I, that lie in the current strip.
c
          do j2 = 1, inc

            j = j2lo - 1 + j2

            if ( a(i,j) == zero ) then
              ctemp(j2) = '    0.0'
            else if ( imag ( a(i,j) ) == 0.0E+00 ) then
              write ( ctemp(j2), '(g10.3,10x)' ) real ( a(i,j) )
            else
              write ( ctemp(j2), '(2g10.3)' ) a(i,j)
            end if

          end do

          write ( *, '(i5,1x,4a20)' ) i, ( ctemp(j2), j2 = 1, inc )

        end do

      end do

      return
      end
      subroutine c4mat_uniform_01 ( m, n, seed, c )

c*********************************************************************72
c
cc C4MAT_UNIFORM_01 returns a unit pseudorandom C4MAT.
c
c  Discussion:
c
c    The angles should be uniformly distributed between 0 and 2 * PI,
c    the square roots of the radius uniformly distributed between 0 and 1.
c
c    This results in a uniform distribution of values in the unit circle.
c
c  Licensing:
c
c    This code is distributed under the MIT license. 
c
c  Modified:
c
c    15 March 2005
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer M, N, the number of rows and columns in the matrix.
c
c    Input/output, integer SEED, the "seed" value, which should NOT be 0.
c    On output, SEED has been updated.
c
c    Output, complex C(M,N), the pseudorandom complex matrix.
c
      implicit none

      integer m
      integer n

      complex c(m,n)
      integer i
      integer j
      real r
      integer k
      real pi
      parameter ( pi = 3.1415926E+00 )
      integer seed
      real theta

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

          k = seed / 127773

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

          if ( seed < 0 ) then
            seed = seed + 2147483647
          end if

          r = sqrt ( real ( dble ( seed ) * 4.656612875D-10 ) )

          k = seed / 127773

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

          if ( seed < 0 ) then
            seed = seed + 2147483647
          end if

          theta = 2.0E+00 * pi * real ( dble ( seed ) 
     &      * 4.656612875D-10 )

          c(i,j) = r * cmplx ( cos ( theta ), sin ( theta ) )

        end do

      end do

      return
      end
      subroutine c4vec_print_part ( n, a, max_print, title )

c*********************************************************************72
c
cc C4VEC_PRINT_PART prints "part" of a C4VEC.
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 MIT license.
c
c  Modified:
c
c    22 June 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, complex A(N), the vector to be printed.
c
c    Input, integer MAX_PRINT, the maximum number of lines
c    to print.
c
c    Input, character * ( * ) TITLE, a title.
c
      implicit none

      integer n

      complex 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 ( *, '(2x,i8,a,1x,g14.6,2x,g14.6)' ) i, ':', a(i)
        end do

      else if ( 3 .le. max_print ) then

        do i = 1, max_print - 2
          write ( *, '(2x,i8,a,1x,g14.6,2x,g14.6)' ) i, ':', a(i)
        end do
        write ( *, '(a)' ) '  ........  ..............  ..............'
        i = n
        write ( *, '(2x,i8,a,1x,g14.6,2x,g14.6)' ) i, ':', a(i)

      else

        do i = 1, max_print - 1
          write ( *, '(2x,i8,a,1x,g14.6,2x,g14.6)' ) i, ':', a(i)
        end do
        i = max_print
        write ( *, '(2x,i8,a,1x,g14.6,2x,g14.6,2x,a)' ) i, ':', a(i), 
     &    '...more entries...'

      end if

      return
      end
      subroutine c4vec_uniform_01 ( n, seed, c )

c*********************************************************************72
c
cc C4VEC_UNIFORM_01 returns a unit pseudorandom C4VEC.
c
c  Discussion:
c
c    The angles should be uniformly distributed between 0 and 2 * PI,
c    the square roots of the radius uniformly distributed between 0 and 1.
c
c    This results in a uniform distribution of values in the unit circle.
c
c  Licensing:
c
c    This code is distributed under the MIT license. 
c
c  Modified:
c
c    15 March 2005
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input, integer N, the number of values to compute.
c
c    Input/output, integer SEED, the "seed" value, which should NOT be 0.
c    On output, SEED has been updated.
c
c    Output, complex C(N), the pseudorandom complex vector.
c
      implicit none

      integer n

      complex c(n)
      integer i
      real r
      integer k
      real pi
      parameter ( pi = 3.1415926E+00 )
      integer seed
      real theta

      do i = 1, n

        k = seed / 127773

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

        if ( seed < 0 ) then
          seed = seed + 2147483647
        end if

        r = sqrt ( real ( dble ( seed ) * 4.656612875D-10 ) )

        k = seed / 127773

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

        if ( seed < 0 ) then
          seed = seed + 2147483647
        end if

        theta = 2.0E+00 * pi * real ( dble ( seed ) * 4.656612875D-10 )

        c(i) = r * cmplx ( cos ( theta ), sin ( theta ) )

      end do

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

c*********************************************************************72
c
cc R4MAT_PRINT_SOME prints some of an R4MAT.
c
c  Licensing:
c
c    This code is distributed under the MIT license. 
c
c  Modified:
c
c    12 September 2004
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, real 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 = 5 )

      integer m
      integer n

      real a(m,n)
      character*14 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 )

      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), '(i7,7x)') j
        end do

        write ( *, '(''  Col   '',5a14)' ) ( 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

            if ( a(i,j) == real ( int ( a(i,j) ) ) ) then
              write ( ctemp(j2), '(f8.0,6x)' ) a(i,j)
            else
              write ( ctemp(j2), '(g14.6)' ) a(i,j)
            end if

          end do

          write ( *, '(i5,1x,5a14)' ) i, ( ctemp(j), j = 1, inc )

        end do

      end do

      return
      end
      subroutine r4mat_uniform_01 ( m, n, seed, r )

c*********************************************************************72
c
cc R4MAT_UNIFORM_01 returns a unit pseudorandom R4MAT.
c
c  Licensing:
c
c    This code is distributed under the MIT license. 
c
c  Modified:
c
c    26 March 2005
c
c  Author:
c
c    John Burkardt
c
c  Reference:
c
c    Paul Bratley, Bennett Fox, L E Schrage,
c    A Guide to Simulation,
c    Springer Verlag, pages 201-202, 1983.
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, pages 362-376, 1986.
c
c    P A Lewis, A S Goodman, J M Miller,
c    A Pseudo-Random Number Generator for the System/360,
c    IBM Systems Journal,
c    Volume 8, pages 136-143, 1969.
c
c  Parameters:
c
c    Input, integer M, N, the number of rows and columns in the array.
c
c    Input/output, integer SEED, the "seed" value, which should NOT be 0.
c    On output, SEED has been updated.
c
c    Output, real R(M,N), the array of pseudorandom values.
c
      implicit none

      integer m
      integer n

      integer i
      integer j
      integer k
      integer seed
      real r(m,n)

      do j = 1, n

        do i = 1, m

          k = seed / 127773

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

          if ( seed < 0 ) then
            seed = seed + 2147483647
          end if

          r(i,j) = real ( seed ) * 4.656612875E-10

        end do
      end do

      return
      end
      subroutine r4vec_print_part ( n, a, max_print, title )

c*********************************************************************72
c
cc R4VEC_PRINT_PART prints "part" of an R4VEC.
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 MIT license.
c
c  Modified:
c
c    22 June 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, real 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

      real 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 ( *, '(2x,i8,a,1x,g14.6)' ) i, ':', a(i)
        end do

      else if ( 3 .le. max_print ) then

        do i = 1, max_print - 2
          write ( *, '(2x,i8,a,1x,g14.6)' ) i, ':', a(i)
        end do

        write ( *, '(a)' ) '  ........  ..............'
        i = n

        write ( *, '(2x,i8,a,1x,g14.6)' ) i, ':', a(i)

      else

        do i = 1, max_print - 1
          write ( *, '(2x,i8,a,1x,g14.6)' ) i, ':', a(i)
        end do

        i = max_print

        write ( *, '(2x,i8,a,1x,g14.6,a)' )
     &    i, ':', a(i), '...more entries...'

      end if

      return
      end
      subroutine r4vec_uniform_01 ( n, seed, r )

c*********************************************************************72
c
cc R4VEC_UNIFORM_01 returns a unit pseudorandom R4VEC.
c
c  Licensing:
c
c    This code is distributed under the MIT license. 
c
c  Modified:
c
c    22 March 2005
c
c  Author:
c
c    John Burkardt
c
c  Reference:
c
c    Paul Bratley, Bennett Fox, L E Schrage,
c    A Guide to Simulation,
c    Springer Verlag, pages 201-202, 1983.
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, pages 362-376, 1986.
c
c    P A Lewis, A S Goodman, J M Miller,
c    A Pseudo-Random Number Generator for the System/360,
c    IBM Systems Journal,
c    Volume 8, pages 136-143, 1969.
c
c  Parameters:
c
c    Input, integer N, the number of entries in the vector.
c
c    Input/output, integer SEED, the "seed" value, which should NOT be 0.
c    On output, SEED has been updated.
c
c    Output, real R(N), the vector of pseudorandom values.
c
      implicit none

      integer n

      integer i
      integer k
      integer seed
      real r(n)

      do i = 1, n

        k = seed / 127773

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

        if ( seed < 0 ) then
          seed = seed + 2147483647
        end if

        r(i) = real ( seed ) * 4.656612875E-10

      end do

      return
      end
