program main c*********************************************************************72 c cc MAIN is the main program for TOMS359_PRB. c c Discussion: c c TOMS359_PRB tests the TOMS359 library. c c Modified: c c 11 January 2006 c c Author: c c John Burkardt c implicit none call timestamp ( ) write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TOMS359_PRB' write ( *, '(a)' ) ' FORTRAN77 version' write ( *, '(a)' ) ' Test the TOMS359 library.' call test01 ( ) c c Terminate. c write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TOMS359_PRB' write ( *, '(a)' ) ' Normal end of execution.' write ( *, '(a)' ) ' ' call timestamp ( ) stop end subroutine test01 ( ) c*********************************************************************72 c cc TEST01 tests DLGAMA. c c Modified: c c 19 January 2006 c c Author: c c John Burkardt c implicit none integer ncls integer nfctr parameter ( ncls = 12 ) parameter ( nfctr = 3 ) integer i integer msize(nfctr) real r4_uniform_01 real row(3) integer seed real y(ncls) real z(ncls) data msize / 2, 2, 3 / seed = 123456789 write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST01' write ( *, '(a)' ) ' Test FNOVA' write ( *, '(a)' ) ' ' write ( *, '(a)' ) ' Y:' write ( *, '(a)' ) ' ' do i = 1, ncls y(i) = int ( 10.0E+00 * r4_uniform_01 ( seed ) ) write ( *, '(2x,i2,2x,f10.6)' ) i, y(i) end do call fnova ( y, z, row, msize, ncls, nfctr ) write ( *, '(a)' ) ' ' write ( *, '(a)' ) ' Z:' write ( *, '(a)' ) ' ' do i = 1, ncls write ( *, '(2x,i2,2x,f10.6)' ) i, z(i) end do return end subroutine timestamp ( ) c*********************************************************************72 c cc TIMESTAMP prints out the current YMDHMS date as a timestamp. c c Discussion: c c This FORTRAN77 version is made available for cases where the c FORTRAN90 version cannot be used. c c Modified: c c 16 September 2005 c c Author: c c John Burkardt c c Parameters: c c None c implicit none character ( len = 8 ) date character ( len = 10 ) time call date_and_time ( date, time ) write ( *, '(a8,2x,a10)' ) date, time return end function r4_uniform_01 ( seed ) c*********************************************************************72 c cc R4_UNIFORM_01 returns a unit single precision pseudorandom number. c c Discussion: c c This routine implements the recursion c c seed = 16807 * seed mod ( 2**31 - 1 ) c r4_uniform_01 = seed / ( 2**31 - 1 ) c c The integer arithmetic never requires more than 32 bits, c including a sign bit. c c If the initial seed is 12345, then the first three computations are c c Input Output R4_UNIFORM_01 c SEED SEED c c 12345 207482415 0.096616 c 207482415 1790989824 0.833995 c 1790989824 2035175616 0.947702 c c Modified: c c 11 August 2004 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 Pierre L'Ecuyer, c Random Number Generation, c in Handbook of Simulation, c edited by Jerry Banks, c Wiley Interscience, page 95, 1998. 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/output, integer SEED, the "seed" value, which should NOT be 0. c On output, SEED has been updated. c c Output, real R4_UNIFORM_01, a new pseudorandom variate, c strictly between 0 and 1. c implicit none integer k integer seed real r4_uniform_01 k = seed / 127773 seed = 16807 * ( seed - k * 127773 ) - k * 2836 if ( seed < 0 ) then seed = seed + 2147483647 end if c c Although SEED can be represented exactly as a 32 bit integer, c it generally cannot be represented exactly as a 32 bit real number! c r4_uniform_01 = real ( dble ( seed ) * 4.656612875D-10 ) return end