* * $Id$ * * $Log$ * Revision 1.2 1996/12/12 16:32:06 cernlib * Variables ONE and ZERO added to SAVE statement, courtesy R.Veenhof * * Revision 1.1.1.1 1996/04/01 15:02:55 mclareni * Mathlib gen * * #include "gen/pilot.h" SUBROUTINE RM48(RVEC,LENV) C Double-precision version of C Universal random number generator proposed by Marsaglia and Zaman C in report FSU-SCRI-87-50 C based on RANMAR, modified by F. James, to generate vectors C of pseudorandom numbers RVEC of length LENV, where the numbers C in RVEC are numbers with at least 48-bit mantissas. C Input and output entry points: RM48IN, RM48UT. C!!! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ C!!! Calling sequences for RM48: ++ C!!! CALL RM48 (RVEC, LEN) returns a vector RVEC of LEN ++ C!!! 64-bit random floating point numbers between ++ C!!! zero and one. ++ C!!! CALL RM48IN(I1,N1,N2) initializes the generator from one ++ C!!! 64-bit integer I1, and number counts N1,N2 ++ C!!! (for initializing, set N1=N2=0, but to restart ++ C!!! a previously generated sequence, use values ++ C!!! output by RM48UT) ++ C!!! CALL RM48UT(I1,N1,N2) outputs the value of the original ++ C!!! seed and the two number counts, to be used ++ C!!! for restarting by initializing to I1 and ++ C!!! skipping N2*100000000+N1 numbers. ++ C!!! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ C for 32-bit machines, use IMPLICIT DOUBLE PRECISION IMPLICIT DOUBLE PRECISION (A-H,O-Z) DIMENSION RVEC(*) COMMON/R48ST1/U(97),C,I97,J97 PARAMETER (MODCNS=1000000000) SAVE CD, CM, TWOM24, NTOT, NTOT2, IJKL,TWOM49, ONE, ZERO DATA NTOT,NTOT2,IJKL/-1,0,0/ C IF (NTOT .GE. 0) GO TO 50 C C Default initialization. User has called RM48 without RM48IN. IJKL = 54217137 NTOT = 0 NTOT2 = 0 KALLED = 0 GO TO 1 C ENTRY RM48IN(IJKLIN, NTOTIN,NTOT2N) C Initializing routine for RM48, may be called before C generating pseudorandom numbers with RM48. The input C values should be in the ranges: 0<=IJKLIN<=900 OOO OOO C 0<=NTOTIN<=999 999 999 C 0<=NTOT2N<<999 999 999! C To get the standard values in Marsaglia's paper, IJKLIN=54217137 C NTOTIN,NTOT2N=0 IJKL = IJKLIN NTOT = MAX(NTOTIN,0) NTOT2= MAX(NTOT2N,0) KALLED = 1 C always come here to initialize 1 CONTINUE IJ = IJKL/30082 KL = IJKL - 30082*IJ I = MOD(IJ/177, 177) + 2 J = MOD(IJ, 177) + 2 K = MOD(KL/169, 178) + 1 L = MOD(KL, 169) WRITE(6,'(A,I10,2X,2I10)') ' RM48 INITIALIZED:',IJKL,NTOT,NTOT2 CCC PRINT '(A,4I10)', ' I,J,K,L= ',I,J,K,L ONE = 1. HALF = 0.5 ZERO = 0. DO 2 II= 1, 97 S = 0. T = HALF DO 3 JJ= 1, 48 M = MOD(MOD(I*J,179)*K, 179) I = J J = K K = M L = MOD(53*L+1, 169) IF (MOD(L*M,64) .GE. 32) S = S+T 3 T = HALF*T 2 U(II) = S TWOM49 = T TWOM24 = ONE DO 4 I24= 1, 24 4 TWOM24 = HALF*TWOM24 C = 362436.*TWOM24 CD = 7654321.*TWOM24 CM = 16777213.*TWOM24 I97 = 97 J97 = 33 C Complete initialization by skipping C (NTOT2*MODCNS + NTOT) random numbers DO 45 LOOP2= 1, NTOT2+1 NOW = MODCNS IF (LOOP2 .EQ. NTOT2+1) NOW=NTOT IF (NOW .GT. 0) THEN WRITE(6,'(A,I15)') ' RM48IN SKIPPING OVER ',NOW DO 40 IDUM = 1, NTOT UNI = U(I97)-U(J97) IF (UNI .LT. ZERO) UNI=UNI+ONE U(I97) = UNI I97 = I97-1 IF (I97 .EQ. 0) I97=97 J97 = J97-1 IF (J97 .EQ. 0) J97=97 C = C - CD IF (C .LT. ZERO) C=C+CM 40 CONTINUE ENDIF 45 CONTINUE IF (KALLED .EQ. 1) RETURN C C Normal entry to generate LENV random numbers 50 CONTINUE DO 100 IVEC= 1, LENV UNI = U(I97)-U(J97) IF (UNI .LT. ZERO) UNI=UNI+ONE U(I97) = UNI I97 = I97-1 IF (I97 .EQ. 0) I97=97 J97 = J97-1 IF (J97 .EQ. 0) J97=97 C = C - CD IF (C .LT. ZERO) C=C+CM UNI = UNI-C IF (UNI .LT. ZERO) UNI=UNI+ONE RVEC(IVEC) = UNI C Replace exact zeros by 2**-49 IF (UNI .EQ. ZERO) THEN RVEC(IVEC) = TWOM49 ENDIF 100 CONTINUE NTOT = NTOT + LENV IF (NTOT .GE. MODCNS) THEN NTOT2 = NTOT2 + 1 NTOT = NTOT - MODCNS ENDIF RETURN C Entry to output current status ENTRY RM48UT(IJKLUT,NTOTUT,NTOT2T) IJKLUT = IJKL NTOTUT = NTOT NTOT2T = NTOT2 RETURN END