This is the article in c.l.f. (without the Fortran 77 code) which prompted two `translations' into Fortran 90. Alan Miller's F90 code follows. Article 24316 of comp.lang.fortran: From: Phillip Helbig Newsgroups: comp.lang.fortran Subject: Re: random number generator Date: 21 Aug 1995 06:36:55 GMT Organization: Hamburger Sternwarte, Germany Lines: 617 Reply-To: Phillip Helbig In <40to9s$15r@mother.usf.edu> blair@unixbox31.coph.usf.edu () writes: >I know this must be a frequently made request but I didn't locate it as a FAQ >so I'll give it a try. >(1) I need a good uniform (0,1) random number generator which is implemented > in F90 or can easily be implemented as such. While I would like it to > have as many of the good qualities of random number generators as possible, > I am paritcularly interested in one that has a long cycle length. I will > have to generate many millions of numbers and don't want it to cycle if > possible. >(2) Does anyone knowledgeable about such matters have any comments on the > quality of the intrinsic function random_number? I know that older > functions of this sort were often pretty bad (e.g. failed many of the > common tests for randomness, short cycles etc.) >(3) Has anyone implemented the types of uniform random number generators used > in IMSL into F90? >If it makes any difference, I will use it on an RS/6000 (320h) under AIX 3.2.5. > Thank you for your help. > cliff blair >blair@unixbox31.coph.usf.edu After my .sig is something I've been posting every few months. The period is something like 10**171, so you have no need to worry. Quite simply, the best RNG there is. After a posting a while back, one satisfied user noticed a "bug", which, however, didn't affect normal use and had nothing to do with the mathematical perfection of the generator. The fix was obvious. I corresponded with the author, who mentioned that the "bug" had been fixed in a published addendum after he had sent me the code for my private use. That fix is included here, look for the comments beginning with "*". The generator has been used by many people, including myself and in numerical QFT calculations, and doesn't have any flaws (which can even be proven analytically---check out the references). It's standard F77, so it's standard F90. Have fun!!! Phillip Helbig Tel. .............. +49 40 7252 4110 Hamburger Sternwarte Email .... phelbig@hs.uni-hamburg.de Gojenbergsweg 112 Fax ............... +49 40 7252 4198 D-21029 Hamburg Telex ............... 217884 hamst d Hello everyone! Well, here's what you've all been waiting for. I am including, separated by a row of 72 stars, my response from Fred James from CERN, who wrote the code, and my original email from James from about a year [2 now] ago. What you should cut out and compile starts right after the row of plus signs in this original email. This consists of the SUBROUTINE RANLUX, up until the END statement, and then the PROGRAM RLXTST, which you can use to make sure everything is working correctly on your computer, which includes the output which should be produced in the comment lines at the end. All I did was delete James's opening remarks, separate the subroutine and the program, and compile them separately. Except for the C's at the beginning of the lines, of course, the test output on my computer (VAX 3100) was identical to the test output in the RLXTST comments. All in all, less than 2 minutes work. Which speaks a lot for coding in absolutely standard FORTRAN, as well as for the VAX compiler. (While most compilers, if not all, which offer extensions of course support `only' standard FORTRAN, some, such as IBM AIX on a RISC 6000, have to be given options in order _NOT_ to support extensions which are INCOMPATIBLE with the standard (like folding to lower case). If you start a compiler with the defaults, then my view is that it is OK to support extensions, but it should at least compile standard FORTRAN without having to be explicitly told that this is standard FORTRAN or otherwise produce results incompatible with the standard.) The Martin Luescher mentioned is a professor at DESY/University of Hamburg who does theoretical elementary particle physics and who wrote an article (DESY 93--133, September 1993, ISSN 0418-9833) entitled `A Portable High-Quality Random Number Generator for Lattice Field Theory Simulations' which I accidentally ran into in the Hamburg Observatory library. Luescher directed me to Fred James, and since then we've used the generator quite a bit, tested it extensively just to be safe and have noticed no problems. For most purposes, one could probably use the highest level with no problems as far as CPU time goes. Have fun!! Phillip Helbig Tel. .............. +49 40 7252 4110 Hamburger Sternwarte Email .... phelbig@hs.uni-hamburg.de Gojenbergsweg 112 Fax ............... +49 40 7252 4198 D-21029 Hamburg Telex ............... 217884 hamst d ************************************************************************ Hello, Thank you for your message about RANLUX. I am happy to hear of satisfied users. Yes, I know a little about some of the various rng's that are being proposed these days, in particular by the Numerical Recipes people. I have told Bill Press about RANLUX and he has the references. The area of rng's was always one of the weakest points in Num. Recip., and I guess that will continue to be true, although their algorithms will improve of course. They do a very good job in so many areas, but you can't really expect them to be best in everything. Press seems to be working closely with Marsaglia, which I also did at one time, until I discovered Martin Luescher and Pierre L'Ecuyer who have a more rigorous and more convincing approach to the problem. You may know that Marsaglia once said: "Random numbers are like sex: ... Even when they are bad they are still pretty good." However, we must remember that the actual RANLUX algorithm owes much to several people including Marsaglia: 1. Marsaglia invented the "subtract-with-borrow" algorithm which has many practical advantages (fast and portable because all computations are done in portable floating-point, very long period, and reasonably easy to initialize, restart, etc.), but is not sufficiently random. 2. L'Ecuyer and Tuzaka (and perhaps others) recognized and proved that Marsaglia's algorithm is in fact equivalent to a linear congruential generator (which is bad) with a very big multiplier (which is good). This gave a first basis for understanding the randomness properties and in particular the flaws. 3. Luescher, using Kolmogorov's chaos theory, showed rigorously how to improve the algorithm by skipping, and how much you have to skip to make it lose all memory of its past. He also can calculate the period exactly, with or without skipping. 4. I wrote the Fortran version of the generator. Feel free to propagate RANLUX, but make sure to give proper credit always to Luescher and the two articles in Computer Physics Communications where it all is published. Thanks again, Fred. ************************************************************************ I guess that theoretical cosmology is easier than experimental cosmology (less time-consuming) but this random number generator should be good enough for both. The references are Luescher, Computer Physics Communications 79 (1994) 100, and James, CPC 79 (1994) 111. ************************************************************************ MODULE luxury ! Subtract-and-borrow random number generator proposed by ! Marsaglia and Zaman, implemented by F. James with the name ! RCARRY in 1991, and later improved by Martin Luescher ! in 1993 to produce "Luxury Pseudorandom Numbers". ! Fortran 77 coded by F. James, 1993 ! References: ! M. Luscher, Computer Physics Communications 79 (1994) 100 ! F. James, Computer Physics Communications 79 (1994) 111 ! This Fortran 90 version is by Alan Miller (alan @ mel.dms.csiro.au) ! Latest revision - 11 September 1995 ! LUXURY LEVELS. ! ------ ------ The available luxury levels are: ! level 0 (p=24): equivalent to the original RCARRY of Marsaglia ! and Zaman, very long period, but fails many tests. ! level 1 (p=48): considerable improvement in quality over level 0, ! now passes the gap test, but still fails spectral test. ! level 2 (p=97): passes all known tests, but theoretically still ! defective. ! level 3 (p=223): DEFAULT VALUE. Any theoretically possible ! correlations have very small chance of being observed. ! level 4 (p=389): highest possible luxury, all 24 bits chaotic. !!!! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ !!!! Calling sequences for RANLUX: ++ !!!! CALL RANLUX (RVEC, LEN) returns a vector RVEC of LEN ++ !!!! 32-bit random floating point numbers between ++ !!!! zero (not included) and one (also not incl.). ++ !!!! CALL RLUXGO(LUX,INT,K1,K2) initializes the generator from ++ !!!! one 32-bit integer INT and sets Luxury Level LUX ++ !!!! which is integer between zero and MAXLEV, or if ++ !!!! LUX .GT. 24, it sets p=LUX directly. K1 and K2 ++ !!!! should be set to zero unless restarting at a break++ !!!! point given by output of RLUXAT (see RLUXAT). ++ !!!! CALL RLUXAT(LUX,INT,K1,K2) gets the values of four integers++ !!!! which can be used to restart the RANLUX generator ++ !!!! at the current point by calling RLUXGO. K1 and K2++ !!!! specify how many numbers were generated since the ++ !!!! initialization with LUX and INT. The restarting ++ !!!! skips over K1+K2*E9 numbers, so it can be long.++ !!!! A more efficient but less convenient way of restarting is by: ++ !!!! CALL RLUXIN(ISVEC) restarts the generator from vector ++ !!!! ISVEC of 25 32-bit integers (see RLUXUT) ++ !!!! CALL RLUXUT(ISVEC) outputs the current values of the 25 ++ !!!! 32-bit integer seeds, to be used for restarting ++ !!!! ISVEC must be dimensioned 25 in the calling program ++ !!!! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ IMPLICIT NONE INTEGER :: isdext(25) INTEGER, PARAMETER :: maxlev = 4, lxdflt = 3, jsdflt = 314159265 INTEGER :: ndskip(0:maxlev) = (/ 0, 24, 73, 199, 365 /) INTEGER :: igiga = 1000000000, i24 = 24, j24 = 10 REAL, PARAMETER :: twop12 = 4096. INTEGER, PARAMETER :: itwo24 = 2**24, icons = 2147483563 INTEGER, SAVE :: next(24), luxlev = lxdflt, nskip, inseed, jseed LOGICAL, SAVE :: notyet = .true. INTEGER :: in24 = 0, kount = 0, mkount = 0 REAL, SAVE :: seeds(24), carry = 0., twom24, twom12 ! default ! Luxury Level 0 1 2 *3* 4 ! ndskip /0, 24, 73, 199, 365/ ! Corresponds to p=24 48 97 223 389 ! time factor 1 2 3 6 10 on slow workstation ! 1 1.5 2 3 5 on fast mainframe ! 1 1.5 2.5 5 8.5 on PC using LF90 PUBLIC notyet, i24, j24, carry, seeds, twom24, twom12, luxlev PUBLIC nskip, ndskip, in24, next, kount, mkount, inseed CONTAINS SUBROUTINE ranlux(rvec, lenv) IMPLICIT NONE INTEGER, INTENT(IN) :: lenv REAL, INTENT(OUT) :: rvec(lenv) ! Local variables INTEGER :: i, k, lp, ivec, iseeds(24), isk REAL :: uni ! NOTYET is .TRUE. if no initialization has been performed yet. ! Default Initialization by Multiplicative Congruential IF (notyet) THEN notyet = .false. jseed = jsdflt inseed = jseed WRITE (6,'(A,I12)') ' RANLUX DEFAULT INITIALIZATION: ', jseed luxlev = lxdflt nskip = ndskip(luxlev) lp = nskip + 24 in24 = 0 kount = 0 mkount = 0 WRITE (6,'(A,I2,A,I4)') ' RANLUX DEFAULT LUXURY LEVEL = ', luxlev, & ' p =', lp twom24 = 1. DO i = 1, 24 twom24 = twom24 * 0.5 k = jseed / 53668 jseed = 40014 * (jseed-k*53668) - k * 12211 IF (jseed.LT.0) jseed = jseed + icons iseeds(i) = MOD(jseed,itwo24) END DO twom12 = twom24 * 4096. DO i = 1, 24 seeds(i) = REAL(iseeds(i)) * twom24 next(i) = i - 1 END DO next(1) = 24 i24 = 24 j24 = 10 carry = 0. IF (seeds(24).EQ.0.) carry = twom24 END IF ! The Generator proper: "Subtract-with-borrow", ! as proposed by Marsaglia and Zaman, ! Florida State University, March, 1989 DO ivec = 1, lenv uni = seeds(j24) - seeds(i24) - carry IF (uni.LT.0.) THEN uni = uni + 1.0 carry = twom24 ELSE carry = 0. END IF seeds(i24) = uni i24 = next(i24) j24 = next(j24) rvec(ivec) = uni ! small numbers (with less than 12 "significant" bits) are "padded". IF (uni.LT.twom12) THEN rvec(ivec) = rvec(ivec) + twom24 * seeds(j24) ! and zero is forbidden in case someone takes a logarithm IF (rvec(ivec).EQ.0.) rvec(ivec) = twom24 * twom24 END IF ! Skipping to luxury. As proposed by Martin Luscher. in24 = in24 + 1 IF (in24.EQ.24) THEN in24 = 0 kount = kount + nskip DO isk = 1, nskip uni = seeds(j24) - seeds(i24) - carry IF (uni.LT.0.) THEN uni = uni + 1.0 carry = twom24 ELSE carry = 0. END IF seeds(i24) = uni i24 = next(i24) j24 = next(j24) END DO END IF END DO kount = kount + lenv IF (kount.GE.igiga) THEN mkount = mkount + 1 kount = kount - igiga END IF RETURN END SUBROUTINE ranlux ! Subroutine to input and float integer seeds from previous run SUBROUTINE rluxin ! the following IF BLOCK added by Phillip Helbig, based on conversation ! with Fred James; an equivalent correction has been published by James. IMPLICIT NONE ! Local variables INTEGER :: i, isd IF (notyet) THEN WRITE (6,'(A)') ' Proper results ONLY with initialisation from 25 ', & 'integers obtained with RLUXUT' notyet = .false. END IF twom24 = 1. DO i = 1, 24 next(i) = i - 1 twom24 = twom24 * 0.5 END DO next(1) = 24 twom12 = twom24 * 4096. WRITE (6,'(A)') ' FULL INITIALIZATION OF RANLUX WITH 25 INTEGERS:' WRITE (6,'(5X,5I12)') isdext DO i = 1, 24 seeds(i) = REAL(isdext(i)) * twom24 END DO carry = 0. IF (isdext(25).LT.0) carry = twom24 isd = ABS(isdext(25)) i24 = MOD(isd,100) isd = isd / 100 j24 = MOD(isd,100) isd = isd / 100 in24 = MOD(isd,100) isd = isd / 100 luxlev = isd IF (luxlev.LE.maxlev) THEN nskip = ndskip(luxlev) WRITE (6,'(A,I2)') ' RANLUX LUXURY LEVEL SET BY RLUXIN TO: ', luxlev ELSE IF (luxlev.GE.24) THEN nskip = luxlev - 24 WRITE (6,'(A,I5)') ' RANLUX P-VALUE SET BY RLUXIN TO:', luxlev ELSE nskip = ndskip(maxlev) WRITE (6,'(A,I5)') ' RANLUX ILLEGAL LUXURY RLUXIN: ', luxlev luxlev = maxlev END IF inseed = -1 RETURN END SUBROUTINE rluxin ! Subroutine to ouput seeds as integers SUBROUTINE rluxut IMPLICIT NONE ! Local variables INTEGER :: i DO i = 1, 24 isdext(i) = INT(seeds(i)*twop12*twop12) END DO isdext(25) = i24 + 100 * j24 + 10000 * in24 + 1000000 * luxlev IF (carry.GT.0.) isdext(25) = -isdext(25) RETURN END SUBROUTINE rluxut ! Subroutine to output the "convenient" restart point SUBROUTINE rluxat(lout, inout, k1, k2) IMPLICIT NONE INTEGER, INTENT(OUT) :: lout, inout, k1, k2 lout = luxlev inout = inseed k1 = kount k2 = mkount RETURN END SUBROUTINE rluxat ! Subroutine to initialize from one or three integers SUBROUTINE rluxgo(lux, ins, k1, k2) IMPLICIT NONE INTEGER, INTENT(IN) :: lux, ins, k1, k2 ! Local variables INTEGER :: ilx, i, iouter, iseeds(24), isk, k, inner, izip, izip2 REAL :: uni IF (lux.LT.0) THEN luxlev = lxdflt ELSE IF (lux.LE.maxlev) THEN luxlev = lux ELSE IF (lux.LT.24.OR.lux.GT.2000) THEN luxlev = maxlev WRITE (6,'(A,I7)') ' RANLUX ILLEGAL LUXURY RLUXGO: ', lux ELSE luxlev = lux DO ilx = 0, maxlev IF (lux.EQ.ndskip(ilx)+24) luxlev = ilx END DO END IF IF (luxlev.LE.maxlev) THEN nskip = ndskip(luxlev) WRITE (6,'(A,I2,A,I4)') ' RANLUX LUXURY LEVEL SET BY RLUXGO :', luxlev, & ' P=', nskip + 24 ELSE nskip = luxlev - 24 WRITE (6,'(A,I5)') ' RANLUX P-VALUE SET BY RLUXGO TO:', luxlev END IF in24 = 0 IF (ins.LT.0) WRITE (6,'(A)') & ' Illegal initialization by RLUXGO, negative input seed' IF (ins.GT.0) THEN jseed = ins WRITE (6,'(A,3I12)') ' RANLUX INITIALIZED BY RLUXGO FROM SEEDS', jseed, k1, k2 ELSE jseed = jsdflt WRITE (6,'(A)') ' RANLUX INITIALIZED BY RLUXGO FROM DEFAULT SEED' END IF inseed = jseed notyet = .false. twom24 = 1. DO i = 1, 24 twom24 = twom24 * 0.5 k = jseed / 53668 jseed = 40014 * (jseed-k*53668) - k * 12211 IF (jseed.LT.0) jseed = jseed + icons iseeds(i) = MOD(jseed,itwo24) END DO twom12 = twom24 * 4096. DO i = 1, 24 seeds(i) = REAL(iseeds(i)) * twom24 next(i) = i - 1 END DO next(1) = 24 i24 = 24 j24 = 10 carry = 0. IF (seeds(24).EQ.0.) carry = twom24 ! If restarting at a break point, skip K1 + IGIGA*K2 ! Note that this is the number of numbers delivered to ! the user PLUS the number skipped (if luxury .GT. 0). kount = k1 mkount = k2 IF (k1+k2.NE.0) THEN DO iouter = 1, k2 + 1 inner = igiga IF (iouter.EQ.k2+1) inner = k1 DO isk = 1, inner uni = seeds(j24) - seeds(i24) - carry IF (uni.LT.0.) THEN uni = uni + 1.0 carry = twom24 ELSE carry = 0. END IF seeds(i24) = uni i24 = next(i24) j24 = next(j24) END DO END DO ! Get the right value of IN24 by direct calculation in24 = MOD(kount,nskip+24) IF (mkount.GT.0) THEN izip = MOD(igiga, nskip+24) izip2 = mkount * izip + in24 in24 = MOD(izip2, nskip+24) END IF ! Now IN24 had better be between zero and 23 inclusive IF (in24.GT.23) THEN WRITE (6,'(A/A,3I11,A,I5)') & ' Error in RESTARTING with RLUXGO:', ' The values', ins, & k1, k2, ' cannot occur at luxury level', luxlev in24 = 0 END IF END IF RETURN END SUBROUTINE rluxgo END MODULE luxury ************************************************************************ PROGRAM luxtst ! Exercise for the RANLUX Pseudorandom number generator. USE luxury IMPLICIT NONE REAL :: rvec(1000) INTEGER :: i1, i2, i3, i4, li ! check that we get the right numbers (machine-indep.) WRITE (6,'(/A)') ' CALL RANLUX(RVEC,100)' CALL ranlux(rvec,100) WRITE (6,'(A/9X,5F12.8)') ' RANLUX default numbers 1- 5:', rvec(1:5) CALL ranlux(rvec,100) WRITE (6,'(A/9X,5F12.8)') ' RANLUX default numbers 101-105:', rvec(1:5) WRITE (6,'(/A)') ' CALL RLUXGO(0,0,0,0)' CALL rluxgo(0,0,0,0) CALL ranlux(rvec,100) WRITE (6,'(A/9X,5F12.8)') ' RANLUX luxury level 0, 1- 5:', rvec(1:5) CALL ranlux(rvec,100) WRITE (6,'(A/9X,5F12.8)') ' RANLUX luxury level 0, 101-105:', rvec(1:5) WRITE (6,'(/A)') ' CALL RLUXGO(389,1,0,0)' CALL rluxgo(389,1,0,0) CALL ranlux(rvec,100) WRITE (6,'(A/9X,5F12.8)') ' RANLUX luxury p=389, 1- 5:', rvec(1:5) CALL ranlux(rvec,100) WRITE (6,'(A/9X,5F12.8)') ' RANLUX luxury p=389, 101-105:', rvec(1:5) WRITE (6,'(/A)') ' CALL RLUXGO(75,0,0,0)' CALL rluxgo(75,0,0,0) CALL ranlux(rvec,100) WRITE (6,'(A/9X,5F12.8)') ' RANLUX luxury p= 75, 1- 5:', rvec(1:5) CALL ranlux(rvec,100) WRITE (6,'(A/9X,5F12.8)') ' RANLUX luxury p= 75, 101-105:', rvec(1:5) WRITE (6,'(/A)') ' test restarting from the full vector' CALL rluxut WRITE (6,'(/A/(1X,5I14))') ' current RANLUX status saved:', isdext CALL ranlux(rvec,100) WRITE (6,'(A/9X,5F12.8)') ' RANLUX numbers 1- 5:', rvec(1:5) CALL ranlux(rvec,100) WRITE (6,'(A/9X,5F12.8)') ' RANLUX numbers 101-105:', rvec(1:5) WRITE (6,'(/A)') ' previous RANLUX status will be restored' CALL rluxin CALL ranlux(rvec,100) WRITE (6,'(A/9X,5F12.8)') ' RANLUX numbers 1- 5:', rvec(1:5) CALL ranlux(rvec,100) WRITE (6,'(A/9X,5F12.8)') ' RANLUX numbers 101-105:', rvec(1:5) WRITE (6,'(/A)') ' test the restarting by skipping' CALL rluxgo(4,7674985,0,0) CALL rluxat(i1,i2,i3,i4) WRITE (6,'(A,4I10)') ' RLUXAT values =', i1, i2, i3, i4 DO li = 1, 10 CALL ranlux(rvec,1000) END DO CALL rluxat(i1,i2,i3,i4) WRITE (6,'(A,4I10)') ' RLUXAT values =', i1, i2, i3, i4 CALL ranlux(rvec,200) WRITE (6,'(A,2F10.6)') ' Next and 200th numbers are:', rvec(1), rvec(200) CALL rluxgo(i1,i2,i3,i4) CALL ranlux(rvec,200) WRITE (6,'(A,2F10.6)') ' Next and 200th numbers are:', rvec(1), rvec(200) WRITE (6,'(/A)') ' The following should provoke an error message' CALL rluxgo(4,11111,31,0) STOP ! OUTPUT FROM THE ABOVE TEST PROGRAM SHOULD BE: ! -------------------------------------------- ! CALL RANLUX(RVEC,100) ! RANLUX DEFAULT INITIALIZATION: 314159265 ! RANLUX DEFAULT LUXURY LEVEL = 3 p = 223 ! RANLUX default numbers 1- 5: ! 0.53981817 0.76155043 0.06029940 0.79600263 0.30631220 ! RANLUX default numbers 101-105: ! 0.43156743 0.03774416 0.24897110 0.00147784 0.90274453 ! CALL RLUXGO(0,0,0,0) ! RANLUX LUXURY LEVEL SET BY RLUXGO : 0 P= 24 ! RANLUX INITIALIZED BY RLUXGO FROM DEFAULT SEED ! RANLUX luxury level 0, 1- 5: ! 0.53981817 0.76155043 0.06029940 0.79600263 0.30631220 ! RANLUX luxury level 0, 101-105: ! 0.41538775 0.05330932 0.58195311 0.91397446 0.67034441 ! CALL RLUXGO(389,1,0,0) ! RANLUX LUXURY LEVEL SET BY RLUXGO : 4 P= 389 ! RANLUX INITIALIZED BY RLUXGO FROM SEEDS 1 0 0 ! RANLUX luxury p=389, 1- 5: ! 0.94589490 0.47347850 0.95152789 0.42971975 0.09127384 ! RANLUX luxury p=389, 101-105: ! 0.02618265 0.03775346 0.97274780 0.13302165 0.43126065 ! CALL RLUXGO(75,0,0,0) ! RANLUX P-VALUE SET BY RLUXGO TO: 75 ! RANLUX INITIALIZED BY RLUXGO FROM DEFAULT SEED ! RANLUX luxury p= 75, 1- 5: ! 0.53981817 0.76155043 0.06029940 0.79600263 0.30631220 ! RANLUX luxury p= 75, 101-105: ! 0.25600731 0.23443210 0.59164381 0.59035838 0.07011414 ! test restarting from the full vector ! current RANLUX status saved: ! 16156027 16534309 15243811 2751687 6002207 ! 7979506 1301976 4567313 4305996 5872599 ! 12003090 2146823 12606367 4111505 5979640 ! 12739666 10489318 14036909 11729352 8061448 ! 7832659 6069758 3197719 1832730 75080216 ! RANLUX numbers 1- 5: ! 0.22617835 0.60655993 0.86417443 0.43920082 0.23382509 ! RANLUX numbers 101-105: ! 0.08107197 0.21466845 0.84856731 0.94078046 0.85626233 ! previous RANLUX status will be restored ! FULL INITIALIZATION OF RANLUX WITH 25 INTEGERS: ! 16156027 16534309 15243811 2751687 6002207 ! 7979506 1301976 4567313 4305996 5872599 ! 12003090 2146823 12606367 4111505 5979640 ! 12739666 10489318 14036909 11729352 8061448 ! 7832659 6069758 3197719 1832730 75080216 ! RANLUX P-VALUE SET BY RLUXIN TO: 75 ! RANLUX numbers 1- 5: ! 0.22617835 0.60655993 0.86417443 0.43920082 0.23382509 ! RANLUX numbers 101-105: ! 0.08107197 0.21466845 0.84856731 0.94078046 0.85626233 ! test the restarting by skipping ! RANLUX LUXURY LEVEL SET BY RLUXGO : 4 P= 389 ! RANLUX INITIALIZED BY RLUXGO FROM SEEDS 7674985 0 0 ! RLUXAT values = 4 7674985 0 0 ! RLUXAT values = 4 7674985 161840 0 ! Next and 200th numbers are: 0.019648 0.590586 ! RANLUX LUXURY LEVEL SET BY RLUXGO : 4 P= 389 ! RANLUX INITIALIZED BY RLUXGO FROM SEEDS 7674985 161840 0 ! Next and 200th numbers are: 0.019648 0.590586 ! The following should provoke an error message ! RANLUX LUXURY LEVEL SET BY RLUXGO : 4 P= 389 ! RANLUX INITIALIZED BY RLUXGO FROM SEEDS 11111 31 0 ! Error in RESTARTING with RLUXGO: ! The values 11111 31 0 cannot occur at luxury level 4 END PROGRAM luxtst