src/m19937.f

Fortran project SIMRES, source module src/m19937.f.

Source module last modified on Tue, 22 Jan 2002, 16:39;
HTML image of Fortran source automatically generated by for2html on Mon, 23 May 2005, 21:29.


# 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 /block/mti,mt
      save   /block/
#
#      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 /block/mti,mt
      save   /block/
      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