!===============================================================================
!
! ranf/ran.F90 - random numbers
!
!-------------------------------------------------------------------------------
!
! Copyright (C) 2008-2016 Hinnerk Stueben
!
! This file is part of BQCD -- Berlin Quantum ChromoDynamics program
!
! BQCD is free software: you can redistribute it and/or modify
! it under the terms of the GNU General Public License as published by
! the Free Software Foundation, either version 3 of the License, or
! (at your option) any later version.
!
! BQCD is distributed in the hope that it will be useful,
! but WITHOUT ANY WARRANTY; without even the implied warranty of
! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
! GNU General Public License for more details.
!
! You should have received a copy of the GNU General Public License
! along with BQCD.  If not, see <http://www.gnu.org/licenses/>.
!
!-------------------------------------------------------------------------------
# include "defs.h"

!-------------------------------------------------------------------------------
RAN_NAME function ran_name()

  implicit none

  ran_name = "ranf"
end

!-------------------------------------------------------------------------------
subroutine ran_init(seed)

  implicit none
  SEED, intent(in)  :: seed
  SEED              :: null = 0

  call ranset(seed, null)
end

!-------------------------------------------------------------------------------
REAL function ran_number()

   implicit none

#ifdef CRAY
  real(8), intrinsic :: ranf
#else
  real(8), external :: ranf
#endif

   ran_number = ranf()
end

!-------------------------------------------------------------------------------
subroutine ran_vector(n, x)

   implicit none
   integer, intent(in) :: n
   REAL, intent(out)   :: x(n)
   integer             :: i

#ifdef CRAY
  real(8), intrinsic :: ranf
#else
  real(8), external :: ranf
#endif

   do i = 1, n
      x(i) = ranf()
   enddo
end

!-------------------------------------------------------------------------------
subroutine ran_skip(n)

  implicit none
  integer, intent(in) :: n
  SEED                :: seed, n_skip

  n_skip = n
  call ranget(seed)
  call ranset(seed, n_skip)
end

!-------------------------------------------------------------------------------
subroutine ran_dump(unit)

  use module_function_decl
  implicit none
  integer, intent(in) :: unit
  FILENAME, external :: ran_file
  SEED               :: seed

  call ran_check()
  call ranget(seed)

  if (my_pe() == 0) then
     if (unit == URAN) open(unit, file = trim(ran_file()), action = "write")
                       write(unit, *) seed
     if (unit == URAN) close(unit)
  endif

end

!-------------------------------------------------------------------------------
subroutine ran_restore(unit)

  use module_ildg_restart_info
  implicit none
  integer, intent(in) :: unit
  FILENAME, external :: ran_file
  SEED               :: seed
  SEED               :: null = 0
  character(ildg_restart_info%len_ran_state) :: state
  integer            :: i

  state = ""
  if (ildg_restart_info%ran_state_is_initialised) then
     do i = 1, ildg_restart_info%len_ran_state
        state(i:i) = ildg_restart_info%ran_state(i)
     enddo
     read(state, "(i20)") seed
  else
     if (unit == URAN) open(unit, file = trim(ran_file()), action = "read", status = "old")
                       read(unit, *) seed
     if (unit == URAN) close(unit)
  endif

  call ranset(seed, null)
end

!-------------------------------------------------------------------------------
SEED function ran_get_seed()

  implicit none

  call ranget(ran_get_seed)
end

!-------------------------------------------------------------------------------
subroutine ran_check()

  use module_function_decl
  implicit none
  SEED :: my_seed, seed

  call ranget(my_seed)

  if (my_pe() == 0) then
     seed = my_seed
  else 
     seed = -1
  endif

  call comm_broadcast_i8(seed, 1)

  ASSERT(seed == my_seed)
end

!-------------------------------------------------------------------------------
integer function ran_state_strlen()

  implicit none
  ran_state_strlen = 20
end

!-------------------------------------------------------------------------------
subroutine ran_state_to_string(s)

  implicit none
  character(*), intent(out) :: s
  SEED :: seed

  call ranget(seed)
  write(s, "(i20)") seed
end

!-------------------------------------------------------------------------------
subroutine ran_field(m, mx, field)

  use module_input
  use module_lattice
  implicit none
  integer, intent(in) :: m
  integer, intent(in) :: mx  ! typically: mx = nxh (or: mx = nx)
  REAL, intent(out)   :: field(m, 0:mx-1, 0:ny-1, 0:nz-1, 0:nt-1)

  integer :: kx
  integer :: i_pe(DIM)
  integer :: block(DIM)
  integer :: j, x, y, z, t
  REAL, external :: ran_number

  kx = mx * npe(1)

  call my_coord(i_pe)

  block(1) = m * mx
  block(2) = m * kx * ny
  block(3) = m * kx * ly * nz
  block(4) = m * kx * ly * lz * nt

  call ran_skip(block(4) * i_pe(4));  do t = 0, nt - 1
  call ran_skip(block(3) * i_pe(3));  do z = 0, nz - 1
  call ran_skip(block(2) * i_pe(2));  do y = 0, ny - 1
  call ran_skip(block(1) * i_pe(1));  do x = 0, mx - 1

  do j = 1, m
     field(j, x, y, z, t) = ran_number()
  enddo

  enddo;  call ran_skip(block(1) * (npe(1) - 1 - i_pe(1)))
  enddo;  call ran_skip(block(2) * (npe(2) - 1 - i_pe(2)))
  enddo;  call ran_skip(block(3) * (npe(3) - 1 - i_pe(3)))
  enddo;  call ran_skip(block(4) * (npe(4) - 1 - i_pe(4)))

end

!===============================================================================
