da_unifva.inc

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    ! begin main
34    ! ----------
35 
36    if ((KDUM.LE.0).OR.(NIY.EQ.0)) then
37       KDUM = MAX(-KDUM , 1)
38 
39        do JJ = JPNTAB+8,1,-1
40           IK   = KDUM/JPIQ
41           KDUM = JPIA*(KDUM - IK*JPIQ) - JPIR*IK
42  
43           if (KDUM.lt.0) KDUM = KDUM + JPIM
44           if (JJ.LE.JPNTAB) NIV(JJ) = KDUM
45  
46        end do
47 
48        NIY = NIV(1)
49    end if
50   
51    IK   = KDUM/JPIQ
52    KDUM = JPIA*(KDUM - IK*JPIQ) - JPIR*IK
53      
54    if (KDUM.LT.0) KDUM = KDUM + JPIM
55 
56    IJJ      = 1 + NIY/JPNDIV
57    NIY      = NIV(IJJ)
58    NIV(IJJ) = KDUM
59    DA_UNifVA   = Min(PPAM*NIY , PPRNMX)
60 
61 end function da_unifva
62 
63