!===============================================================================
!
! univ.F90 - universal portable random number generator by Marsaglia and Zaman
!
!-------------------------------------------------------------------------------
!
! 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"

!-----------------------------------------------------------------------
      module module_univ
         real(8)       :: u(97), c, cd, cm
         integer(8)    :: state(102)
         integer(4)    :: iu = 97
         integer(4)    :: ju = 33
         integer(4)    :: initialized = 0
         integer(4)    :: state_dummy
         integer, save :: default_seed(4) = (/12, 34, 56, 78/)

         common /univ_state/ u, c, cd, cm, iu, ju, initialized, state_dummy
         equivalence(state, u)
      end

!-----------------------------------------------------------------------
      subroutine univ_init(seed)
 
      use module_univ
      implicit none
      integer  seed(4), ii, jj, i, j, k, l, m
      real(8)  s, t

  if (seed(1) < 1 .or. seed(1) > 178) call die("univ_init(): seed(1) out of range")
  if (seed(2) < 1 .or. seed(2) > 178) call die("univ_init(): seed(2) out of range")
  if (seed(3) < 1 .or. seed(3) > 178) call die("univ_init(): seed(3) out of range")
  if (seed(4) < 0 .or. seed(4) > 168) call die("univ_init(): seed(4) out of range")

  if (seed(1) == 1 .and. seed(2) == 1 .and. seed(3) == 1) then
     call die("univ_init(): seeds 1..3 are all 1")
  endif

      i = seed(1)
      j = seed(2)
      k = seed(3)
      l = seed(4)

      do ii = 1, 97
         s = 0.0
         t = 0.5
         do jj = 1, 24
            m = mod(mod(i * j, 179) * k, 179)
            i = j
            j = k
            k = m
            l = mod(53 * l + 1, 169)
            if (mod(l * m, 64) .ge. 32) s = s + t
            t = 0.5 * t
         enddo
         u(ii) = s
      enddo

      c  =   362436.0 / 16777216.0
      cd =  7654321.0 / 16777216.0
      cm = 16777213.0 / 16777216.0

      initialized = 1

      end

!-----------------------------------------------------------------------
      subroutine ranget(s)

      implicit none
      integer :: s(4)

      s = 0
      end

!-----------------------------------------------------------------------
      real(8) function univ()

      use module_univ
      implicit none
      real(8) uni

      if (initialized .eq. 0) call univ_init(default_seed)

      uni = u(iu) - u(ju)
      if (uni .lt. 0.0) uni = uni + 1.0
      u(iu) = uni
      iu = iu - 1
      if (iu .eq. 0) iu = 97
      ju = ju - 1
      if (ju .eq. 0) ju = 97
      c = c - cd
      if (c .lt. 0.0) c = c + cm
      uni = uni - c

      ! original code:
      !
      ! if (uni .lt. 0.0) uni = uni + 1.0
      ! if (uni >= 1.0) call die("univ(): obtained a number >= 1 !")
      !
      ! (uni == 0) would blow up the log in HMC:
      
      if (uni .le. 0.0) uni = uni + 1.0
      if (uni > 1.0) call die("univ(): obtained a number > 1 !")

      univ = uni
      end

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

      implicit none
      integer  n, i
      real(8)  x(n), univ
      external univ

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

!-----------------------------------------------------------------------
      subroutine univ_dump(unit, file)

      use module_univ
      implicit  none
      integer   unit
      character file*(*)

      if (unit == URAN) open(unit, file = trim(file), form = 'formatted', status = 'unknown')
                        write(unit,*) state
      if (unit == URAN) close(unit)

      end

!-----------------------------------------------------------------------
      subroutine univ_restore(unit, file)

      use module_univ
      implicit  none
      integer   unit
      character file*(*)

      if (unit == URAN) open(unit, file = trim(file), form = 'formatted', status = 'old')
                        read(unit,*) state
      if (unit == URAN) close(unit)

      end

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