349 lines
8.6 KiB
Fortran
349 lines
8.6 KiB
Fortran
!!******************************************************************************
|
|
!!
|
|
!! module: RANDOM - handles random number generators by Marsaglia & Tsang
|
|
!!
|
|
!! references:
|
|
!! Marsaglia, G. & Tsang, W.W. (2000) `The ziggurat method for generating
|
|
!! random variables', J. Statist. Software, v5(8).
|
|
!!
|
|
!! Copyright (C) 2000 George Marsaglia, Wai Wan Tsang
|
|
!! Copyright (C) 2008 John Burkardt
|
|
!! Copyright (C) 2010,2011 Grzegorz Kowal <grzegorz@amuncode.org>
|
|
!!
|
|
!!******************************************************************************
|
|
!!
|
|
!! This file is part of the AMUN code.
|
|
!!
|
|
!! This program 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 2
|
|
!! of the License, or (at your option) any later version.
|
|
!!
|
|
!! This program 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 this program; if not, write to the Free Software Foundation,
|
|
!! Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
|
!!
|
|
!!******************************************************************************
|
|
!!
|
|
module random
|
|
|
|
implicit none
|
|
|
|
private
|
|
|
|
integer , save :: nseeds
|
|
integer(kind=4), dimension(:), allocatable, save :: seeds
|
|
integer(kind=4), dimension(128) , save :: kn
|
|
real (kind=4), dimension(128) , save :: fn, wn
|
|
|
|
public :: init_generator, nseeds, get_seeds, set_seeds &
|
|
, randomu, randomz, randomn
|
|
|
|
contains
|
|
!
|
|
!===============================================================================
|
|
!
|
|
! init_generator: subroutine initializes the random number generator
|
|
!
|
|
!===============================================================================
|
|
!
|
|
subroutine init_generator()
|
|
|
|
#ifdef MPI
|
|
use mpitools, only : is_master, mbcasti
|
|
#endif /* MPI */
|
|
|
|
implicit none
|
|
|
|
! local variables
|
|
!
|
|
integer(kind=4) :: i
|
|
real(kind=8) :: dn, tn, q
|
|
|
|
! parameters
|
|
!
|
|
real(kind=8), parameter :: m1 = 2.14748364800000d+09
|
|
real(kind=8), parameter :: vn = 9.91256303526217d-03
|
|
|
|
! OpenMP functions
|
|
!
|
|
!$ integer :: omp_get_num_threads, omp_get_thread_num
|
|
!
|
|
!-------------------------------------------------------------------------------
|
|
!
|
|
! initialize the seeds required by all subroutines
|
|
!
|
|
nseeds = 1
|
|
!$omp parallel
|
|
!$ nseeds = omp_get_num_threads()
|
|
!$omp end parallel
|
|
|
|
! allocate array for seeds
|
|
!
|
|
allocate(seeds(0:nseeds-1))
|
|
|
|
! fill seeds with random numbers
|
|
!
|
|
#ifdef MPI
|
|
if (is_master()) then
|
|
#endif /* MPI */
|
|
do i = 0, nseeds - 1
|
|
call random_number(q)
|
|
seeds(i) = 123456789 * q
|
|
end do
|
|
#ifdef MPI
|
|
end if
|
|
#endif /* MPI */
|
|
|
|
#ifdef MPI
|
|
! redistribute seeds
|
|
!
|
|
call mbcasti(nseeds, seeds)
|
|
#endif /* MPI */
|
|
|
|
! prepare the arrays used by nonunifor distribution generators
|
|
!
|
|
dn = 3.442619855899d+00
|
|
tn = 3.442619855899d+00
|
|
|
|
q = vn / exp(-0.5d+00 * dn * dn)
|
|
|
|
kn(1) = int((dn / q) * m1)
|
|
kn(2) = 0
|
|
|
|
wn(1) = real(q / m1, kind=4)
|
|
wn(128) = real(dn / m1, kind=4)
|
|
|
|
fn(1) = 1.0e+00
|
|
fn(128) = real(exp(-0.5d+00 * dn * dn), kind=4)
|
|
|
|
do i = 127, 2, -1
|
|
dn = sqrt(-2.0d+00 * log(vn / dn + exp(-0.5d+00 * dn * dn)))
|
|
kn(i+1) = int((dn / tn) * m1)
|
|
tn = dn
|
|
fn(i) = real(exp(-0.5d+00*dn*dn), kind=4)
|
|
wn(i) = real(dn / m1, kind=4)
|
|
end do
|
|
!
|
|
!-------------------------------------------------------------------------------
|
|
!
|
|
end subroutine init_generator
|
|
!
|
|
!===============================================================================
|
|
!
|
|
! get_seeds: subroutine returns the generator seeds
|
|
!
|
|
!===============================================================================
|
|
!
|
|
subroutine get_seeds(seed)
|
|
|
|
implicit none
|
|
|
|
! subroutine arguments
|
|
!
|
|
integer(kind=4), dimension(0:nseeds-1), intent(out) :: seed
|
|
!
|
|
!-------------------------------------------------------------------------------
|
|
!
|
|
seed(:) = seeds(:)
|
|
!
|
|
!-------------------------------------------------------------------------------
|
|
!
|
|
end subroutine get_seeds
|
|
!
|
|
!===============================================================================
|
|
!
|
|
! set_seeds: subroutine sets the generator seeds
|
|
!
|
|
!===============================================================================
|
|
!
|
|
subroutine set_seeds(seed)
|
|
|
|
implicit none
|
|
|
|
! subroutine arguments
|
|
!
|
|
integer(kind=4), dimension(0:nseeds-1), intent(in) :: seed
|
|
!
|
|
!-------------------------------------------------------------------------------
|
|
!
|
|
seeds(:) = seed(:)
|
|
!
|
|
!-------------------------------------------------------------------------------
|
|
!
|
|
end subroutine set_seeds
|
|
!
|
|
!===============================================================================
|
|
!
|
|
! shr3: subroutine evaluates the SHR3 generator for integers
|
|
!
|
|
! input arguments:
|
|
!
|
|
! np - the process number (for parallel operations)
|
|
!
|
|
!===============================================================================
|
|
!
|
|
function shr3(np) result(jr)
|
|
|
|
implicit none
|
|
|
|
integer(kind=4) :: np, jp, jt, jr
|
|
!
|
|
!-------------------------------------------------------------------------------
|
|
!
|
|
jp = seeds(np)
|
|
jt = jp
|
|
|
|
jt = ieor(jt, ishft(jt, 13))
|
|
jt = ieor(jt, ishft(jt, -17))
|
|
jt = ieor(jt, ishft(jt, 5))
|
|
|
|
seeds(np) = jt
|
|
|
|
jr = jp + jt
|
|
|
|
return
|
|
!
|
|
!-------------------------------------------------------------------------------
|
|
!
|
|
end function shr3
|
|
!
|
|
!===============================================================================
|
|
!
|
|
! randomu: function generates uniformly distributed random numbers from the
|
|
! range 0.0...1.0
|
|
!
|
|
! input arguments:
|
|
!
|
|
! np - the process number (for parallel operations)
|
|
!
|
|
!===============================================================================
|
|
!
|
|
function randomu(np) result(val)
|
|
|
|
integer(kind=4) :: np
|
|
real :: val
|
|
!
|
|
!-------------------------------------------------------------------------------
|
|
!
|
|
val = 0.5 + 0.23283064365e-9 * shr3(np)
|
|
|
|
return
|
|
!
|
|
!-------------------------------------------------------------------------------
|
|
!
|
|
end function randomu
|
|
!
|
|
!===============================================================================
|
|
!
|
|
! randomz: function generates uniformly distributed random numbers from the
|
|
! range -1.0...1.0
|
|
!
|
|
! input arguments:
|
|
!
|
|
! np - the process number (for parallel operations)
|
|
!
|
|
!===============================================================================
|
|
!
|
|
function randomz(np) result(val)
|
|
|
|
integer(kind=4) :: np
|
|
real :: val
|
|
!
|
|
!-------------------------------------------------------------------------------
|
|
!
|
|
val = 0.46566128730e-9 * shr3(np)
|
|
|
|
return
|
|
!
|
|
!-------------------------------------------------------------------------------
|
|
!
|
|
end function randomz
|
|
!
|
|
!===============================================================================
|
|
!
|
|
! randomn: function generates normally distributed random numbers
|
|
!
|
|
! input arguments:
|
|
!
|
|
! np - the process number (for parallel operations)
|
|
!
|
|
!===============================================================================
|
|
!
|
|
function randomn(np) result(val)
|
|
|
|
implicit none
|
|
|
|
! input/output arguments
|
|
!
|
|
integer(kind=4) :: np
|
|
real :: val
|
|
|
|
! local variables
|
|
!
|
|
integer(kind=4) :: hz, iz
|
|
real(kind=4) :: x, y, z, t
|
|
|
|
! parameters
|
|
!
|
|
real(kind=4), parameter :: r = 3.442620e+00
|
|
!
|
|
!-------------------------------------------------------------------------------
|
|
!
|
|
hz = shr3(np)
|
|
iz = iand(hz, 127)
|
|
|
|
if (abs(hz) .lt. kn(iz+1)) then
|
|
val = real(hz, kind=4) * wn(iz+1)
|
|
else
|
|
do
|
|
if (iz .eq. 0) then
|
|
do
|
|
x = - 0.2904764e+00 * log(randomu(np))
|
|
y = - log(randomu(np))
|
|
if ((x * x) .le. (y + y)) then
|
|
exit
|
|
end if
|
|
end do
|
|
|
|
if (hz .le. 0) then
|
|
val = - r - x
|
|
else
|
|
val = + r + x
|
|
end if
|
|
|
|
exit
|
|
end if
|
|
|
|
x = real(hz, kind=4) * wn(iz+1)
|
|
z = fn(iz+1) + randomu(np) * (fn(iz) - fn(iz+1))
|
|
t = exp(-0.5e+00 * x * x)
|
|
|
|
if (z .lt. t) then
|
|
val = x
|
|
exit
|
|
end if
|
|
|
|
hz = shr3(np)
|
|
iz = iand(hz, 127)
|
|
|
|
if (abs(hz) .lt. kn(iz+1)) then
|
|
val = real(hz, kind=4) * wn(iz+1)
|
|
exit
|
|
end if
|
|
end do
|
|
end if
|
|
|
|
return
|
|
!
|
|
!-------------------------------------------------------------------------------
|
|
!
|
|
end function randomn
|
|
!
|
|
end module random
|