module rng_container

  !  Simple interface to random number generator RNG
  !  This is just an example of an RNG interface, for ps_nbline_driver.f90
  !  DMC May 2008

  use rng   ! Charles Karney RNG module (cf NTCC module -- under 
            ! "numerical tools" in the catalog at http://w3.pppl.gov/ntcc

  implicit NONE

  private

  !  Public routines:  seed/state initialization -- must be called first...
  !                    real*8 random numbers evenly distributed over [0:1]
  !                    real*8 random numbers for gaussian distributions

  public :: rngcon_init,rngcon_frandm,rngcon_fgauss

  SAVE

  !  For performance reasons, RNG numbers are fetched through buffers
  !  with this batch size
  
  integer, parameter :: batch_size = 10

  !---------------------------------------
  !  private internal state

  type(rng_state) :: state
  integer, dimension(rng_s) :: seed
  !---------------------------------------
  !  buffer indexing (-1 flags "un-initialized" value)

  integer :: indx_frandm = -1
  integer :: indx_fgauss = -1

  !  buffers

  real*8 :: frandm_buffer(batch_size)
  real*8 :: fgauss_buffer(batch_size)

  !---------------------------------------
  !  LUN for message
  integer, parameter :: lun_dbg = 6
  !---------------------------------------

CONTAINS

  !-----------------------------------
  ! initialization routine -- sets RNG from a seed string
  ! called once by driver

  ! in MPI implementation it could be called once per processing element (PE),
  ! but a distinct string (e.g. imbedding the encoded PE number) should be 
  ! provided for each PE.  <run_seed_string>_<PE_number> perhaps.

  subroutine rngcon_init(str)
    character*(*), intent(in) :: str

    call rng_set_seed(seed,str)
    call rng_init(seed,state)

    indx_frandm = 1
    indx_fgauss = 1

    call rng_number(state,frandm_buffer)  ! fetch initial batch -- Normal
    call rng_gauss(state,fgauss_buffer)   ! fetch initial batch -- Gaussian

  end subroutine rngcon_init

  !-----------------------------------
  !  RNG function (sample flat distribution btw 0 and 1; endpts excluded)

  real*8 function rngcon_frandm(istream)

    integer :: istream        ! RNG stream identifier
    ! (NOT USED in this sample code but may be desirable in parallel apps)

    if(indx_frandm.le.0) then
       write(lun_dbg,*) &
            ' ?rng_container:rngcon_frandm -- module never initialized!'
       rngcon_frandm = 0.0

    else
       rngcon_frandm = frandm_buffer(indx_frandm)

       indx_frandm = indx_frandm + 1
       if(indx_frandm.gt.batch_size) then
          call rng_number(state,frandm_buffer)
          indx_frandm = 1
       endif
    endif

  end function rngcon_frandm

  !-----------------------------------
  !  RNG function: sample Guassian exp(-(x-xcen)**2/(2*xwid**2))

  real*8 function rngcon_fgauss(istream,xcen,xwid)

    integer :: istream        ! RNG stream identifier
    ! (NOT USED in this sample code but may be desirable in parallel apps)

    real*8, intent(in) :: xcen    ! Gaussian center
    real*8, intent(in) :: xwid    ! Gaussian half-width (as defined above)

    if(indx_fgauss.le.0) then
       write(lun_dbg,*) &
            ' ?rng_container:rngcon_fgauss -- module never initialized!'
       rngcon_fgauss = 0.0

    else
       rngcon_fgauss = xwid * fgauss_buffer(indx_fgauss) + xcen

       indx_fgauss = indx_fgauss + 1
       if(indx_fgauss.gt.batch_size) then
          call rng_gauss(state,fgauss_buffer)
          indx_fgauss = 1
       endif
    endif

  end function rngcon_fgauss

end module rng_container
