| 1 | SUBROUTINE GRNDM(RVEC,LENV)
|
|---|
| 2 |
|
|---|
| 3 | C-----------------------------------------------------------------------
|
|---|
| 4 | C G(ENERATOR OF) R(A)ND(O)M (NUMBERS)
|
|---|
| 5 | C
|
|---|
| 6 | C THIS ROUTINE IS IDENTICAL TO RMMAR
|
|---|
| 7 | C DESCRIPTION OF ALGORITHM SEE SUBROUTINE RMMAR
|
|---|
| 8 | C THIS SUBROUTINE IS CALLED FROM GHEISHA ROUTINES
|
|---|
| 9 | C ARGUMENTS:
|
|---|
| 10 | C RVEC = VECTOR FIELD TO BE FILLED WITH RANDOM NUMBERS
|
|---|
| 11 | C LENV = LENGTH OF VECTOR (# OF RANDNUMBERS TO BE GENERATED)
|
|---|
| 12 | C
|
|---|
| 13 | C CERN PROGLIB# V113 RMMAR .VERSION KERNFOR 1.0
|
|---|
| 14 | C ORIG. 01/03/89 FCA + FJ
|
|---|
| 15 | C-----------------------------------------------------------------------
|
|---|
| 16 |
|
|---|
| 17 | REAL RVEC(*)
|
|---|
| 18 | COMMON /RANMA2/ IU(1030),JSEQ
|
|---|
| 19 | COMMON /RANMA3/ TWOM24,TWOM48,CD,CM,CINT,MODCNS
|
|---|
| 20 | INTEGER I97(0:1030),J97(0:1030),NTOT(0:1030),NTOT2(0:1030),
|
|---|
| 21 | * IJKL(0:1030)
|
|---|
| 22 | REAL U(1030),C(0:1030)
|
|---|
| 23 | EQUIVALENCE (IJKL(0),IU(1)),(NTOT(0),IU(2)),(NTOT2(0),IU(3))
|
|---|
| 24 | EQUIVALENCE (U(1),IU(4)),(C(0),IU(101)),(I97(0),IU(102))
|
|---|
| 25 | EQUIVALENCE (J97(0),IU(103))
|
|---|
| 26 | C-----------------------------------------------------------------------
|
|---|
| 27 |
|
|---|
| 28 | ISEQ = 1
|
|---|
| 29 | IF ( ISEQ .GT. 0 ) JSEQ = ISEQ
|
|---|
| 30 | IBASE = (JSEQ-1)*103
|
|---|
| 31 |
|
|---|
| 32 | DO 100 IVEC = 1,LENV
|
|---|
| 33 | UNI = U(IBASE+I97(IBASE))-U(IBASE+J97(IBASE))
|
|---|
| 34 | IF ( UNI .LT. 0. ) UNI = UNI+1.
|
|---|
| 35 | U(IBASE+I97(IBASE)) = UNI
|
|---|
| 36 | I97(IBASE) = I97(IBASE)-1
|
|---|
| 37 | IF ( I97(IBASE) .EQ. 0 ) I97(IBASE) = 97
|
|---|
| 38 | J97(IBASE) = J97(IBASE)-1
|
|---|
| 39 | IF ( J97(IBASE) .EQ. 0 ) J97(IBASE) = 97
|
|---|
| 40 | C(IBASE) = C(IBASE) - CD
|
|---|
| 41 | IF ( C(IBASE) .LT. 0. ) C(IBASE) = C(IBASE)+CM
|
|---|
| 42 | UNI = UNI-C(IBASE)
|
|---|
| 43 | IF ( UNI .LT. 0. ) UNI = UNI+1.
|
|---|
| 44 | C REPLACE EXACT ZEROES BY UNIFORM DISTR. *2**-24
|
|---|
| 45 | IF ( UNI .EQ. 0. ) THEN
|
|---|
| 46 | UNI = TWOM24*U(2)
|
|---|
| 47 | C AN EXACT ZERO HERE IS VERY UNLIKELY, BUT LET'S BE SAFE.
|
|---|
| 48 | IF ( UNI .EQ. 0. ) UNI = TWOM48
|
|---|
| 49 | ENDIF
|
|---|
| 50 | RVEC(IVEC) = UNI
|
|---|
| 51 | 100 CONTINUE
|
|---|
| 52 |
|
|---|
| 53 | NTOT(IBASE) = NTOT(IBASE) + LENV
|
|---|
| 54 | IF ( NTOT(IBASE) .GE. MODCNS ) THEN
|
|---|
| 55 | NTOT2(IBASE) = NTOT2(IBASE) + 1
|
|---|
| 56 | NTOT(IBASE) = NTOT(IBASE) - MODCNS
|
|---|
| 57 | ENDIF
|
|---|
| 58 |
|
|---|
| 59 | RETURN
|
|---|
| 60 | END
|
|---|
