!-----------------------------------------------------------------------
! RANDOM SEED functions
!
subroutine gmath_random_seed_init(error)
  use gmath_dependencies_interfaces
  use gmath_interfaces, except_this=>gmath_random_seed_init
  !---------------------------------------------------------------------
  ! @ public
  !  Initialize the Fortran random seed. Should be called by interactive
  ! programs or tasks
  !  NB: the Fortran standard does not promise that calling
  ! RANDOM_SEED() without argument will reuse again and again the same
  ! seed. We use our own default, which is a random seed based on date
  ! and time
  !---------------------------------------------------------------------
  logical, intent(inout) :: error
  ! Local
  character(len=40) :: argum
  integer(kind=4) :: ier
  !
  argum = 'DATETIME'  ! Default
  ier = sic_getlog('GILDAS_RANDOM_SEED',argum)
  !
  call gmath_random_seed_set(argum,error)
  if (error)  return
  !
end subroutine gmath_random_seed_init
!
subroutine gmath_random_seed_set(argum,error)
  use gmath_dependencies_interfaces
  use gmath_interfaces, except_this=>gmath_random_seed_set
  !---------------------------------------------------------------------
  ! @ public
  ! (Re)set the Fortran random seed, based on the input argument:
  !  - "DATETIME": based on current date and time
  !  - "URANDOM":  based on the OS /dev/urandom, if any
  !  - "Value":    caller choice
  !---------------------------------------------------------------------
  character(len=*), intent(in)    :: argum  !
  logical,          intent(inout) :: error  !
  ! Local
  integer(kind=4), parameter :: mkey=2
  character(len=8), parameter :: keys(mkey) = (/ 'DATETIME','URANDOM ' /)
  integer(kind=4) :: nkey
  character(len=8) :: key
  !
  call sic_ambigs_sub('RANDOM_SEED',argum,key,nkey,keys,mkey,error)
  if (error)  return
  !
  select case (nkey)
  case (1)
    call gmath_random_seed_datetime(error)
    if (error)  return
  case (2)
    call gmath_random_seed_urandom(error)
    if (error)  return
  case default
    ! Argument not understood, try to parse the value
    call gmath_random_seed_value(argum,error)
    if (error)  return
  end select
  !
end subroutine gmath_random_seed_set
!
subroutine gmath_random_seed_datetime(error)
  !---------------------------------------------------------------------
  ! @ private
  !  (Re)set the Fortran random seed, based on current date and time
  !  Based on Gfortran online help
  !---------------------------------------------------------------------
  logical, intent(inout) :: error  !
  ! Local
  integer, allocatable :: seed(:)
  integer(kind=4) :: i,n,dt(8),t(2),s,pid
  integer(kind=8) :: count, tms
  !
  ! Get the minimum size of the seed array
  call random_seed(size=n)
  allocate(seed(n))
  !
  call system_clock(count)
  if (count.ne.0) then
    t = transfer(count, t)
  else
    call date_and_time(values=dt)
    tms = (dt(1) - 1970) * 365_8 * 24 * 60 * 60 * 1000 +  &
          dt(2) * 31_8 * 24 * 60 * 60 * 1000  +           &
          dt(3) * 24 * 60 * 60 * 60 * 1000 +              &
          dt(5) * 60 * 60 * 1000 +                        &
          dt(6) * 60 * 1000 +                             &
          dt(7) * 1000 +                                  &
          dt(8)
    t = transfer(tms,t)
  end if
  s = ieor(t(1), t(2))
  pid = 1099279 ! Add a prime
  s = ieor(s, pid)
  if (n.ge.3) then
    seed(1) = t(1) + 36269
    seed(2) = t(2) + 72551
    seed(3) = pid
    if (n.gt.3) then
      seed(4:) = s + 37 * (/ (i,i=0,n-4) /)
    endif
  else
    seed(:) = s + 37 * (/ (i,i=0,n-1 ) /)
  end if
  !
  call random_seed(put=seed)
  !
  deallocate(seed)
  !
end subroutine gmath_random_seed_datetime
!
subroutine gmath_random_seed_urandom(error)
  use gbl_message
  use gmath_dependencies_interfaces
  use gmath_interfaces, except_this=>gmath_random_seed_urandom
  !---------------------------------------------------------------------
  ! @ private
  !  (Re)set the Fortran random seed, based on the OS random generator
  ! (if any)
  !---------------------------------------------------------------------
  logical, intent(inout) :: error  !
  ! Local
  integer, allocatable :: seed(:)
  integer(kind=4) :: n,ier,un
  !
  ! Get the minimum size of the seed array
  call random_seed(size=n)
  allocate(seed(n))
  !
  ! Try if the OS provides a random number generator
  ier = sic_getlun(un)
#if defined(IFORT) && IFORT_VERSION>=110
  open(unit=un,file="/dev/urandom",access="stream", &
       form="unformatted",action="read",status="old",iostat=ier)
#else
  ! access="stream" is not supported by ifort 9
  ier = 1
#endif
  if (ier.ne.0) then
    call gmath_message(seve%e,'RANDOM_SEED',  &
      'Your OS does not provide the /dev/urandom generator')
    error = .true.
    goto 100
  endif
  !
  read(un) seed
  close(un)
  !
  call random_seed(put=seed)
  !
100 continue
  deallocate(seed)
  call sic_frelun(un)
  !
end subroutine gmath_random_seed_urandom
!
subroutine gmath_random_seed_value(argum,error)
  use gbl_message
  use gmath_interfaces, except_this=>gmath_random_seed_value
  !---------------------------------------------------------------------
  ! @ private
  !  (Re)set the Fortran random seed by using the caller input value,
  ! so that the seed and the random number sequence will be the same
  ! for an identical value.
  !---------------------------------------------------------------------
  character(len=*), intent(in)    :: argum  !
  logical,          intent(inout) :: error  !
  ! Local
  integer, allocatable :: seed(:)
  integer(kind=4) :: ier,n
  integer(kind=8) :: value
  !
  read(argum,*,iostat=ier)  value
  if (ier.ne.0) then
    call gmath_message(seve%e,'RANDOM_SEED',  &
      'Argument '//trim(argum)//' not understood')
    error = .true.
    return
  endif
  !
  ! Get the minimum size of the seed array
  call random_seed(size=n)
  allocate(seed(n))
  !
  seed(:) = value
  call random_seed(put=seed)
  !
  deallocate(seed)
  !
end subroutine gmath_random_seed_value
!
subroutine gmath_random_seed_print(error)
  use gbl_message
  use gmath_interfaces, except_this=>gmath_random_seed_print
  !---------------------------------------------------------------------
  ! @ private
  ! Print the current Fortran random seed
  !---------------------------------------------------------------------
  logical, intent(inout) :: error  !
  ! Local
  integer, allocatable :: seed(:)
  integer(kind=4) :: n,i
  character(len=message_length) :: mess
  !
  ! Get the size of the seed array
  call random_seed(size=n)
  allocate(seed(n))
  call random_seed(get=seed)
  !
  write(mess,*) 'Current random seed is ',(/ (seed(i),i=1,n) /)
  call gmath_message(seve%i,'RANDOM_SEED',mess)
  !
  deallocate(seed)
  !
end subroutine gmath_random_seed_print
!
!-----------------------------------------------------------------------
! RANDOM related functions
!
function rangau(sigma)
  use gmath_interfaces, except_this=>rangau
  !---------------------------------------------------------------------
  ! @ public
  ! Normal gaussian distribution with R.M.S. equal to sigma
  ! Version 1.1 8-jun-83
  ! Algorithm from Handbook of mathematical functions
  ! Ed. Abramowitz M. and Stegun I. A. , 26.2.23 (page 933)
  !---------------------------------------------------------------------
  real(kind=4) :: rangau  !
  real(kind=4), intent(in) :: sigma  !
  ! Local
  real(kind=4) :: x0,x,s,t
  real(kind=4), parameter :: c0=2.515517, c1=0.802853, c2=0.010328
  real(kind=4), parameter :: d1=1.432788, d2=0.189269, d3=0.001308
  !
  x0 = gag_random()
  if (x0.le.0.0) then
    x=1.23456e-37
    s=1.0
  elseif (x0.ge.1.0) then
    x=1.23456e-37
    s=-1.0
  elseif (x0.gt.0.5) then
    x=1.0-x0
    s=-1.0
  else
    x=x0
    s=1.0
  endif
  t = sqrt(-2.0*alog(x))
  rangau = s*sigma * (t - (c0+t*(c1+c2*t)) / (1.0+t*(d1+t*(d2+d3*t))) )
end function rangau
!
function gag_random()
  use gmath_interfaces, except_this=>gag_random
  !---------------------------------------------------------------------
  ! @ public
  !---------------------------------------------------------------------
  real(kind=4) :: gag_random              !
  ! Local
  logical :: first,error
  save first
  data first/.true./
  !
  if (first) then
    error = .false.
    call gmath_random_seed_init(error)
    first = .false.
  endif
  call random_number(gag_random)
end function gag_random
!
function d_noise(a)
  use gmath_interfaces, except_this=>d_noise
  !---------------------------------------------------------------------
  ! @ public
  ! Double precision version
  !---------------------------------------------------------------------
  real(kind=8) :: d_noise                 !
  real(kind=8), intent(in) :: a           !
  ! Local
  real(kind=4) :: b
  b = a
  d_noise = rangau(b)
end function d_noise
!
function d_random(a)
  use gmath_interfaces, except_this=>d_random
  !---------------------------------------------------------------------
  ! @ public
  ! Double precision version
  !---------------------------------------------------------------------
  real(kind=8) :: d_random                !
  real(kind=8), intent(in) :: a           !
  !
  d_random = a*gag_random()
end function d_random
!
function s_noise(a)
  use gmath_interfaces, except_this=>s_noise
  !---------------------------------------------------------------------
  ! @ public
  ! Single precision version
  !---------------------------------------------------------------------
  real(kind=4) :: s_noise                 !
  real(kind=4), intent(in) :: a           !
  !
  s_noise = rangau(a)
end function s_noise
!
function s_random(a)
  use gmath_interfaces, except_this=>s_random
  !---------------------------------------------------------------------
  ! @ public
  ! Single precision version
  !---------------------------------------------------------------------
  real(kind=4) :: s_random                !
  real(kind=4), intent(in) :: a           !
  !
  s_random = a*gag_random()
end function s_random
