da_unifva.inc
References to this file elsewhere.
1 real function da_unifva (kdum)
2
3 !--------------------------------------------------------------------
4 ! Purpose: Minimal random number generator of Park and Miller with
5 ! Bays-Durham shuffle and added safeguards.
6 ! Returns a uniform random deviate between 0.0. and 1.0 (exclusive
7 ! of the endpoint values). Call with kdum a negative integer to
8 ! initialize; thereafter, do not alter kdum between successive
9 ! deviates in sequence. rnmx should approximate the largest
10 ! floating value less than 1.
11 !
12 ! See descripiton of function 'ran1', pg. 271.
13 !--------------------------------------------------------------------
14
15 implicit none
16
17 integer, intent(inout) :: KDUM
18
19 integer JPIA,JPIM,JPIQ,JPIR,JPNTAB,JPNDIV
20 real PPAM,PPEPS,PPRNMX
21
22 parameter(JPIA=16807,JPIM=2147483647,JPIQ=127773,JPIR=2836, &
23 JPNTAB=32,JPNDIV=1+(JPIM-1)/JPNTAB, &
24 PPAM=1./JPIM,PPEPS=1.2E-07,PPRNMX=1.-PPEPS)
25
26 integer JJ
27 integer IJJ,IK
28
29 integer NIV(JPNTAB),NIY
30 save NIV,NIY
31 DATA NIV /JPNTAB*0/, NIY /0/
32
33 if (trace_use_frequent) call da_trace_entry("da_unifva")
34
35 ! begin main
36 ! ----------
37
38 if ((KDUM.LE.0).OR.(NIY.EQ.0)) then
39 KDUM = MAX(-KDUM , 1)
40
41 do JJ = JPNTAB+8,1,-1
42 IK = KDUM/JPIQ
43 KDUM = JPIA*(KDUM - IK*JPIQ) - JPIR*IK
44
45 if (KDUM.lt.0) KDUM = KDUM + JPIM
46 if (JJ.LE.JPNTAB) NIV(JJ) = KDUM
47
48 end do
49
50 NIY = NIV(1)
51 end if
52
53 IK = KDUM/JPIQ
54 KDUM = JPIA*(KDUM - IK*JPIQ) - JPIR*IK
55
56 if (KDUM.LT.0) KDUM = KDUM + JPIM
57
58 IJJ = 1 + NIY/JPNDIV
59 NIY = NIV(IJJ)
60 NIV(IJJ) = KDUM
61 DA_UNifVA = Min(PPAM*NIY , PPRNMX)
62
63 if (trace_use_frequent) call da_trace_exit("da_unifva")
64
65 end function da_unifva
66
67