Source module last modified on Wed, 13 Jul 2005, 16:20;
HTML image of Fortran source automatically generated by
for2html on Mon, 29 May 2006, 15:06.
# Mersenne Twister
# A C-program for MT19937: Real number version
# genrand() generates one pseudorandom real number (double)
# which is uniformly distributed on [0,1]-interval, for each
# call. sgenrand(seed) set initial values to the working area
# of 624 words. Before genrand(), sgenrand(seed) must be
# called once. (seed is any 32-bit integer except for 0).
# Integer generator is obtained by modifying two lines.
# Coded by Takuji Nishimura, considering the suggestions by
# Topher Cooper and Marc Rieffel in July-Aug. 1997.
#
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Library General Public
# License as published by the Free Software Foundation; either
# version 2 of the License, or (at your option) any later
# version.
# This library 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 Library General Public License for more details.
# You should have received a copy of the GNU Library General
# Public License along with this library; if not, write to the
# Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
# 02111-1307 USA
#
# Copyright (C) 1997 Makoto Matsumoto and Takuji Nishimura.
# When you use this, send an email to: matumoto@math.keio.ac.jp
# with an appropriate reference to your work.
#
# M. Matsumoto and T. Nishimura, "Mersenne Twister: A 623-dimensionally
# equidistributed uniform pseudorandom number generator", ACM Trans. on Modeling and
# Computer Simulation Vol. 8, No. 1, Januray pp.3-30 1998
#***********************************************************************
# Fortran translation by Hiroshi Takano. Jan. 13, 1999.
#
# genrand() -> double precision function grnd()
# sgenrand(seed) -> subroutine sgrnd(seed)
# integer seed
#
# This program uses the following non-standard intrinsics.
# ishft(i,n): If n>0, shifts bits in i by n positions to left.
# If n<0, shifts bits in i by n positions to right.
# iand (i,j): Performs logical AND on corresponding bits of i and j.
# ior (i,j): Performs inclusive OR on corresponding bits of i and j.
# ieor (i,j): Performs exclusive OR on corresponding bits of i and j.
#
#***********************************************************************
# this main() outputs first 1000 generated numbers
# program main
#
# implicit integer(i-n)
# implicit double precision(a-h,o-z)
#
# parameter(no=1000)
# dimension r(0:7)
#
# call sgrnd(4357)
# any nonzero integer can be used as a seed
# do 1000 j=0,no-1
# r(mod(j,8))=grnd()
# if(mod(j,8).eq.7) then
# write(*,'(8(f8.6,'' ''))') (r(k),k=0,7)
# else if(j.eq.no-1) then
# write(*,'(8(f8.6,'' ''))') (r(k),k=0,mod(no-1,8))
# endif
# 1000 continue
#
# end
#***********************************************************************
SUBROUTINE sgrnd(seed)
#
implicit integer(a-z)
#
# Period parameters
parameter(n = 624)
#
dimension mt(0:n-1)
# the array for the state vector
common /blck/mti,mt
save /blck/
#
# setting initial seeds to mt[N] using
# the generator Line 25 of Table 1 in
# [KNUTH 1981, The Art of Computer Programming
# Vol. 2 (2nd Ed.), pp102]
#
mt(0)= iand(seed,-1)
do 1000 mti=1,n-1
mt(mti) = iand(69069 * mt(mti-1),-1)
1000 continue
#
return
end
#***********************************************************************
double precision FUNCTION grnd()
#
implicit integer(a-z)
#
# Period parameters
parameter(n = 624)
parameter(n1 = n+1)
parameter(m = 397)
parameter(mata = -1727483681)
# constant vector a
parameter(umask = -2147483648)
# most significant w-r bits
parameter(lmask = 2147483647)
# least significant r bits
# Tempering parameters
parameter(tmaskb= -1658038656)
parameter(tmaskc= -272236544)
#
dimension mt(0:n-1)
dimension mag01(0:1)
# the array for the state vector
common /blck/mti,mt
save /blck/
data mti/n1/
# mti==N+1 means mt[N] is not initialized
#
data mag01/0, mata/
save mag01
# mag01(x) = x * MATA for x=0,1
#
tshftu(y)=ishft(y,-11)
tshfts(y)=ishft(y,7)
tshftt(y)=ishft(y,15)
tshftl(y)=ishft(y,-18)
#
if(mti.ge.n) then
# generate N words at one time
if(mti.eq.n+1) then
# if sgrnd() has not been called,
call sgrnd(4357)
# a default initial seed is used
endif
#
do 1000 kk=0,n-m-1
y=ior(iand(mt(kk),umask),iand(mt(kk+1),lmask))
mt(kk)=ieor(ieor(mt(kk+m),ishft(y,-1)),mag01(iand(y,1)))
1000 continue
do 1100 kk=n-m,n-2
y=ior(iand(mt(kk),umask),iand(mt(kk+1),lmask))
mt(kk)=ieor(ieor(mt(kk+(m-n)),ishft(y,-1)),mag01(iand(y,1)))
1100 continue
y=ior(iand(mt(n-1),umask),iand(mt(0),lmask))
mt(n-1)=ieor(ieor(mt(m-1),ishft(y,-1)),mag01(iand(y,1)))
mti = 0
endif
#
y=mt(mti)
mti=mti+1
y=ieor(y,tshftu(y))
y=ieor(y,iand(tshfts(y),tmaskb))
y=ieor(y,iand(tshftt(y),tmaskc))
y=ieor(y,tshftl(y))
#
if(y.lt.0) then
grnd=(dble(y)+2.0d0**32)/(2.0d0**32-1.0d0)
else
grnd=dble(y)/(2.0d0**32-1.0d0)
endif
#
return
end