var/da/da_tools/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