!===============================================================================
!
! ran.F90 - random number related routines
!
!-------------------------------------------------------------------------------
!
! Copyright (C) 1998-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"

!-------------------------------------------------------------------------------
subroutine ran_gauss_volh(m, ran, var, eo)

! intitializes ran with Gaussian random numbers in a manner that makes
! results independent of the lattice decomposition

  use module_decomp
  use module_function_decl
  use module_vol
  implicit none
  integer, parameter  :: re = 0
  integer, parameter  :: im = 1

  integer, intent(in)  :: m
  REAL,    intent(out) :: ran(re:im, m, volh)
  REAL,    intent(in)  :: var
  integer, intent(in)  :: eo

  TIMING_START(timing_bin_ran_gauss_volh)

  call ran_field_gauss_volh(m, ran, var)

!  integer, dimension (DIM) :: i_pe, block
!  integer :: i, ii, x, y, z, t, j
!  integer :: nxh, nx, ny, nz, nt, lx, ly, lz, npe(DIM)
!  REAL    :: twovar, phi, r
!
!  twovar = TWO * var
!
!  i_pe = decomp%std%i_pe
!  npe  = decomp%std%NPE
!
!  nxh = decomp%std%NH(1)
!
!  nx = decomp%std%N(1)
!  ny = decomp%std%N(2)
!  nz = decomp%std%N(3)
!  nt = decomp%std%N(4)
!
!  lx  = decomp%std%L(1)
!  ly  = decomp%std%L(2)
!  lz  = decomp%std%L(3)
!
!  ! block() contains the number of random numbers to be skipped.
!  ! In the calculation of block() a factor 1/2 from "even/odd volume"
!  ! cancels with 2 from "two random numbers per site".
!
!  block(1) = m * nx
!  block(2) = m * lx * ny
!  block(3) = m * lx * ly * nz
!  block(4) = m * lx * ly * lz * nt
!
!  i = 0
!  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, nxh - 1
!              i = i + 1
!              ii = decomp%act%i(i, eo)
!              do j = 1, m
!                 r = sqrt(-twovar * log(ran_number()))
!                 phi = TWOPI * ran_number()
!                 ran(re, j, ii) = r * cos(phi)
!                 ran(im, j, ii) = r * sin(phi)
!              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)))

  TIMING_STOP(timing_bin_ran_gauss_volh)
end

!-------------------------------------------------------------------------------
subroutine ran_vector_volh(ran, eo)

! intitializes vector ran with random numbers in the interval [-1,1] 

  use module_decomp
  use module_function_decl
  use module_vol
  implicit none

  REAL,    intent(out) :: ran(volh)
  integer, intent(in)  :: eo

  call ran_field_vector_volh(1, ran)

!  integer, dimension (DIM) :: i_pe, block
!  integer :: i, ii, x, y, z, t
!  integer :: nxh, nx, ny, nz, nt, lx, ly, lz, npe(DIM)
!
!  i_pe = decomp%std%i_pe
!  npe  = decomp%std%NPE
!
!  nxh = decomp%std%NH(1)
!
!  nx = decomp%std%N(1)
!  ny = decomp%std%N(2)
!  nz = decomp%std%N(3)
!  nt = decomp%std%N(4)
!
!  lx  = decomp%std%L(1)
!  ly  = decomp%std%L(2)
!  lz  = decomp%std%L(3)
!
!  block(1) = nxh
!  block(2) = lx * ny / 2
!  block(3) = lx * ly * nz / 2
!  block(4) = lx * ly * lz * nt / 2
!
!  i = 0
!  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, nxh - 1
!              i = i + 1
!              ii = decomp%act%i(i, eo)
!              ran(ii) = ONE - TWO * ran_number()
!           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

!-------------------------------------------------------------------------------
subroutine random_sequence(r, n)  ! random permutation of [1..n]

  use module_function_decl
  implicit none
  integer, intent(in)  :: n
  integer, intent(out) :: r(n)
  integer              :: ran, seq(n), i, j, len_seq
  integer              :: ceiling

  len_seq = n

  do i = 1, len_seq
     seq(i) = i
  enddo

  do i = 1, n - 1
     ran = ceiling(len_seq * ran_number())
     if (ran <= 0 .or. ran > len_seq) stop "random_sequence(): ran out of range"
     r(i) = seq(ran)
     do j = ran, len_seq - 1
        seq(j) = seq(j + 1)
     enddo
     len_seq = len_seq - 1
  enddo
  r(n) = seq(1)

end

!-------------------------------------------------------------------------------
subroutine get_a_random_seed(seed)  ! (try to) generate a random seed

  use module_function_decl
  implicit none
  SEED    :: seed
  integer :: count, rate, rate_10sec
  integer :: pe, ierror

  if (my_pe() == 0) then
     call system_clock(count = count, count_rate = rate)

     if (rate <= 0) call die("get_a_random_seed(): failed")

     rate_10sec = rate * 10
     seed = mod(count, rate_10sec)
  endif

  call seed_broadcast(seed)
end

!-------------------------------------------------------------------------------
subroutine init_ran(para, flags)  ! initilize random number generator

  use typedef_para
  use typedef_flags
  use module_input
  implicit none

  type(type_para)  :: para
  type(type_flags) :: flags
  SEED             :: seed

  if (flags%convert_to_ildg) then
     return  ! initialisation will be handled in read_conf_info_header()
  endif

  if (flags%continuation_job) then
     call ran_restore(URAN)
  else
     if (para%seed < 0) then
        call get_a_random_seed(seed)
        call ran_init(seed)
     endif

     ! (in general) no action if (para%seed == 0)
     if (para%seed == 0) then
        if (input%tuning_ran_field_parallel /= 0) then
           call die("init_ran(): 'start_random' cannot be 'default' for 'tuning_ran_field_parallel'")
        endif
     endif

     if (para%seed > 0) then
        call ran_init(para%seed)
     endif
  endif
end


!-------------------------------------------------------------------------------
subroutine write_ran()  ! save state of random number generator

  use module_input

  if (input%io_restart_format == "ildg") return

  call ran_dump(URAN)
end


!-------------------------------------------------------------------------------
subroutine ran_field_gauss_volh(m, field, var)

  use module_lattice
  use module_vol
  implicit none
  integer, parameter  :: re = 0
  integer, parameter  :: im = 1

  integer, intent(in) :: m
  REAL, intent(out)   :: field(re:im, m, volh)
  REAL, intent(in)    :: var

  REAL    :: twovar, r, phi
  integer :: i, j

  call ran_field(SIZE_COMPLEX * m, nxh, field)

  twovar = -TWO * var

  !$omp parallel do default(none) &
  !$omp shared(volh, m, twovar, field) &
  !$omp private(i, j, r, phi)
  do i = 1, volh
     do j = 1, m
        r = sqrt(twovar * log(field(re, j, i)))
        phi = TWOPI * field(im, j, i)
        field(re, j, i) = r * cos(phi)
        field(im, j, i) = r * sin(phi)
     enddo
  enddo

end

!-------------------------------------------------------------------------------
subroutine ran_field_vector_volh(m, field)

  use module_lattice
  use module_vol
  implicit none
  integer, intent(in) :: m
  REAL, intent(out)   :: field(m, volh)

  integer :: i, j

  call ran_field(m, nxh, field)

  !$omp parallel do default(none) &
  !$omp shared(volh, m, field) &
  !$omp private(i, j)
  do i = 1, volh
     do j = 1, m
        field(j, i) = ONE - TWO * field(j, i) 
     enddo
  enddo

end

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