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    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