| 1 | FUNCTION RANGEN()
|
|---|
| 2 |
|
|---|
| 3 | C-----------------------------------------------------------------------
|
|---|
| 4 | C RAN(DOM NUMBER) GEN(ERATOR)
|
|---|
| 5 | C
|
|---|
| 6 | C SEE SUBROUTINE RMMAR
|
|---|
| 7 | C THIS FUNCTION IS CALLED FROM MANY VENUS ROUTINES
|
|---|
| 8 | C
|
|---|
| 9 | C CERN PROGLIB# V113 RMMAR .VERSION KERNFOR 1.0
|
|---|
| 10 | C ORIG. 01/03/89 FCA + FJ
|
|---|
| 11 | C
|
|---|
| 12 | C CHANGES : D. HECK IK3 FZK KARLSRUHE
|
|---|
| 13 | C DATE : FEB 02, 1994
|
|---|
| 14 | C-----------------------------------------------------------------------
|
|---|
| 15 |
|
|---|
| 16 | C REAL RVEC(1)
|
|---|
| 17 | COMMON /RANMA2/ IU(1030),JSEQ
|
|---|
| 18 | COMMON /RANMA3/ TWOM24,TWOM48,CD,CM,CINT,MODCNS
|
|---|
| 19 | INTEGER I97(0:1030),J97(0:1030),NTOT(0:1030)
|
|---|
| 20 | INTEGER NTOT2(0:1030),IJKL(0:1030)
|
|---|
| 21 | REAL U(97),C(0:1030)
|
|---|
| 22 | EQUIVALENCE (IJKL(0),IU(1)),(NTOT(0),IU(2)),(NTOT2(0),IU(3))
|
|---|
| 23 | EQUIVALENCE (U(1),IU(4)),(C(0),IU(101)),(I97(0),IU(102))
|
|---|
| 24 | EQUIVALENCE (J97(0),IU(103))
|
|---|
| 25 | C-----------------------------------------------------------------------
|
|---|
| 26 |
|
|---|
| 27 | C ISEQ = 1
|
|---|
| 28 | LENV = 1
|
|---|
| 29 | C IF ( ISEQ .GT. 0 ) JSEQ = ISEQ
|
|---|
| 30 | C IBASE = (JSEQ-1)*103
|
|---|
| 31 | IBASE = 0
|
|---|
| 32 |
|
|---|
| 33 | IVEC = 1
|
|---|
| 34 | C DO 100 IVEC = 1,LENV
|
|---|
| 35 | UNI = U( +I97(IBASE))-U( +J97(IBASE))
|
|---|
| 36 | IF ( UNI .LT. 0. ) UNI = UNI+1.
|
|---|
| 37 | U( +I97(IBASE)) = UNI
|
|---|
| 38 | I97(IBASE) = I97(IBASE)-1
|
|---|
| 39 | IF ( I97(IBASE) .EQ. 0 ) I97(IBASE) = 97
|
|---|
| 40 | J97(IBASE) = J97(IBASE)-1
|
|---|
| 41 | IF ( J97(IBASE) .EQ. 0 ) J97(IBASE) = 97
|
|---|
| 42 | C(IBASE) = C(IBASE) - CD
|
|---|
| 43 | IF ( C(IBASE) .LT. 0. ) C(IBASE) = C(IBASE)+CM
|
|---|
| 44 | UNI = UNI-C(IBASE)
|
|---|
| 45 | IF ( UNI .LT. 0. ) UNI = UNI+1.
|
|---|
| 46 | C REPLACE EXACT ZEROES BY UNIFORM DISTR. *2**-24
|
|---|
| 47 | IF ( UNI .EQ. 0. ) THEN
|
|---|
| 48 | UNI = TWOM24*U(2)
|
|---|
| 49 | C AN EXACT ZERO HERE IS VERY UNLIKELY, BUT LET'S BE SAFE.
|
|---|
| 50 | IF ( UNI .EQ. 0. ) UNI = TWOM48
|
|---|
| 51 | ENDIF
|
|---|
| 52 | RANGEN = UNI
|
|---|
| 53 | 100 CONTINUE
|
|---|
| 54 |
|
|---|
| 55 | NTOT(IBASE) = NTOT(IBASE) + LENV
|
|---|
| 56 | IF ( NTOT(IBASE) .GE. MODCNS ) THEN
|
|---|
| 57 | NTOT2(IBASE) = NTOT2(IBASE) + 1
|
|---|
| 58 | NTOT(IBASE) = NTOT(IBASE) - MODCNS
|
|---|
| 59 | ENDIF
|
|---|
| 60 |
|
|---|
| 61 | RETURN
|
|---|
| 62 | END
|
|---|
