Class random_class
In: RandomClass/random_class.F90
constants_module random_class dot/f_50.png

Random number class

Abstract

Generalized Feedback Shift Register method (M-Series/GFSR) pseudo random number generator.

Usage:

 generate 10 uniformly (0:1) distributed random nubmers

   use random_class
   integer(INT) :: is,i,npu,id,iout
   real(8) :: R(10)
   type(rand_gfsr_obj) :: rand
   character(100) :: fname

 ...Setup id, npu  (parallelization)

! open file to hold random number state vector ! file name should contain node id

   write(fname,'(I3.3)')id
   fname='randstate.'//TRIM(fname)
   open(iout,file=TRIM(fname),form='unformatted')

   is=12345

! initialize parallel random number generator ! is : seed ! npu : total parallelization depth ! id : node id

   call new(rand,0,is,npu,id)

! get 10 uniform randum numbers in R(10)

   call get(rand,R)

   call save(rand,iout)  ! save state vector/file name should conatin node id/
   call delete(rand)     ! delete state vector

! restart parallel random number generator

   call new(rand,1,is,npu,nodeid)

! read state vector

   call read(rand,iout)

   call get(rand,R)
   call delete(rand)

   close(iout)

Version

$Id: random_class.F90,v 1.9 2010/07/29 11:08:16 ishikawa Exp $

Methods

delete   get   get   get_rand2   get_rand3   new   rand_gfsr_obj   read   save  

Included Modules

constants_module

Public Instance methods

Subroutine :
this :type(rand_gfsr_obj), intent(inout)

[Source]

subroutine delete_rand(this)
  implicit none
  type(rand_gfsr_obj), intent(inout) :: this

  deallocate(this%seed)
  deallocate(this%rr)

  return
end subroutine
Subroutine :
this :type(rand_gfsr_obj), intent(inout)
scl :real(8), intent(inout)

Get random number scalar

generate normalized random numbers: 0 < scl < 1

 - this : rand_gfsr_obj
 -  scl : uniform random number scalar

[Source]

subroutine get_rand_rs(this,scl)
!
! Get random number scalar
!
! generate normalized random numbers: 0 < scl < 1
!
!  - this : rand_gfsr_obj
!  -  scl : uniform random number scalar
!
  implicit none
  type(rand_gfsr_obj), intent(inout) :: this
  real(8), intent(inout) :: scl
  real(8) :: vec(1)

  call get_rand_rv(this,vec)
  scl=vec(1)

  return
end subroutine
Subroutine :
this :type(rand_gfsr_obj), intent(inout)
vec(:) :real(8), intent(inout)

Get real random number vector

generate normalized random numbers: 0 < vec(:) < 1

 - this : rand_gfsr_obj
 -  vec : uniform random number vector

[Source]

subroutine get_rand_rv(this,vec)
!
! Get real random number vector
!
! generate normalized random numbers: 0 < vec(:) < 1
!
!  - this : rand_gfsr_obj
!  -  vec : uniform random number vector
!
  implicit none
  type(rand_gfsr_obj), intent(inout) :: this
  real(8), intent(inout) :: vec(:)

  integer(INT) imore,isft,k,iruse

  iruse=SIZE(vec)
  if (iruse > NRSIZE) then
    if (this%myid == 0) then
      write(*,'(" Maximum vector length exceeds ! (get_rand(this,vec))")')
      write(*,'(" Maximum vector length : ",I14)')NRSIZE
      write(*,'("   Input vector length : ",I14)')iruse
      stop
    endif
  endif

  if ((this%irhere+iruse) > NRSIZE) then
    do imore=0,NRMORE-1
      isft = imore*Pw - 1
      do k=1,Qw
        this%seed(k) = IEOR(this%seed(k),this%seed(k+Pw-Qw))
        this%rr(k+isft) = (dble(this%seed(k))+0.5_DP)
      enddo
      do k=Qw+1,Pw
        this%seed(k) = IEOR(this%seed(k),this%seed(k-Qw))
        this%rr(k+isft) = (dble(this%seed(k))+0.5_DP)
      enddo
    enddo
    this%irhere = 0
  endif

  do k=1,iruse
    vec(k)=this%rr(this%irhere+(k-1)) * mul
  enddo
  this%irhere=this%irhere+iruse

  return
end subroutine
Subroutine :
this :type(rand_gfsr_obj), intent(inout)
vec(:) :real(8), intent(inout)

Get real random number vector

generate normalized random numbers: 0 <= vec(:) <= 1

 - this : rand_gfsr_obj
 -  vec : uniform random number vector

[Source]

subroutine get_rand_rv2(this,vec)
!
! Get real random number vector
!
! generate normalized random numbers: 0 <= vec(:) <= 1
!
!  - this : rand_gfsr_obj
!  -  vec : uniform random number vector
!
  implicit none
  type(rand_gfsr_obj), intent(inout) :: this
  real(8), intent(inout) :: vec(:)

  integer(INT) imore,isft,k,iruse

  iruse=SIZE(vec)
  if (iruse > NRSIZE) then
    if (this%myid == 0) then
      write(*,'(" Maximum vector length exceeds ! (get_rand(this,vec))")')
      write(*,'(" Maximum vector length : ",I14)')NRSIZE
      write(*,'("   Input vector length : ",I14)')iruse
      stop
    endif
  endif

  if ((this%irhere+iruse) > NRSIZE) then
    do imore=0,NRMORE-1
      isft = imore*Pw - 1
      do k=1,Qw
        this%seed(k) = IEOR(this%seed(k),this%seed(k+Pw-Qw))
        this%rr(k+isft) =  dble(this%seed(k))
      enddo
      do k=Qw+1,Pw
        this%seed(k) = IEOR(this%seed(k),this%seed(k-Qw))
        this%rr(k+isft) =  dble(this%seed(k))
      enddo
    enddo
    this%irhere = 0
  endif

  do k=1,iruse
    vec(k)=this%rr(this%irhere+(k-1)) * mul2
  enddo
  this%irhere=this%irhere+iruse

  return
end subroutine
Subroutine :
this :type(rand_gfsr_obj), intent(inout)
vec(:) :real(8), intent(inout)

Get real random number vector

generate normalized random numbers: 0 <= vec(:) < 1

 - this : rand_gfsr_obj
 -  vec : uniform random number vector

[Source]

subroutine get_rand_rv3(this,vec)
!
! Get real random number vector
!
! generate normalized random numbers: 0 <= vec(:) < 1
!
!  - this : rand_gfsr_obj
!  -  vec : uniform random number vector
!
  implicit none
  type(rand_gfsr_obj), intent(inout) :: this
  real(8), intent(inout) :: vec(:)

  integer(INT) imore,isft,k,iruse

  iruse=SIZE(vec)
  if (iruse > NRSIZE) then
    if (this%myid == 0) then
      write(*,'(" Maximum vector length exceeds ! (get_rand(this,vec))")')
      write(*,'(" Maximum vector length : ",I14)')NRSIZE
      write(*,'("   Input vector length : ",I14)')iruse
      stop
    endif
  endif

  if ((this%irhere+iruse) > NRSIZE) then
    do imore=0,NRMORE-1
      isft = imore*Pw - 1
      do k=1,Qw
        this%seed(k) = IEOR(this%seed(k),this%seed(k+Pw-Qw))
        this%rr(k+isft) =  dble(this%seed(k))
      enddo
      do k=Qw+1,Pw
        this%seed(k) = IEOR(this%seed(k),this%seed(k-Qw))
        this%rr(k+isft) =  dble(this%seed(k))
      enddo
    enddo
    this%irhere = 0
  endif

  do k=1,iruse
    vec(k)=this%rr(this%irhere+(k-1)) * mul
  enddo
  this%irhere=this%irhere+iruse

  return
end subroutine
Subroutine :
this :type(rand_gfsr_obj), intent(inout)
ircont :integer(INT), intent(in)
irseed :integer(INT), intent(in)
NPU :integer(INT), intent(in)
nodeid :integer(INT), intent(in)

Initialization of random number

  • this : rand_gfsr_obj
  • ircont : 0 reset with irseed, 1 : restart
  • irseed : random number seed
  • NPU : parallel total node number
  • nodeid : node number

[Source]

subroutine new_rand(this, ircont, irseed, NPU, nodeid)
!
! Initialization of random number
! 
! -   this : rand_gfsr_obj
! - ircont : 0 reset with irseed,  1 : restart 
! - irseed : random number seed
! -    NPU : parallel total node number
! - nodeid : node number
!
  implicit none
  type(rand_gfsr_obj), intent(inout) :: this
  integer(INT), intent(in) :: ircont,irseed
  integer(INT), intent(in) :: nodeid,NPU

  integer(INT), parameter :: NXT=48828125
  integer(prc) :: m
  integer(prc), pointer :: seed_g(:,:)
  integer(prc), pointer :: bit(:)
  integer(INT) :: ir
  integer(INT) :: i,j,k,ip,ishift

!  mul = 1._DP/2147483648._DP        ! 31 bit precision
  mul  = 1._DP/(2.0_DP**STATE_BIT_SIZE)
  mul2 = 1._DP/(2.0_DP**STATE_BIT_SIZE-1.0_DP)

  this%NPU=NPU
  this%myid=nodeid
  allocate(this%seed(Pw))
  allocate(this%rr(0:NRSIZE-1))

  if (nodeid == 0) then
    write(*,'(80("-"))')
    write(*,'(" M-rand.number (p/q=",I8,"/",I8,")")')Pw,Qw
    write(*,'("       INT SIZE(bit) :",I4)')INT_BIT_SIZE
    write(*,'("      PRECISION(bit) :",I4)')STATE_BIT_SIZE
    write(*,'(" NODE PARALELL DEPTH :",I4)')NPU
    write(*,'("  MAX PARALELL DEPTH :",I4)')MNPU
    write(*,'("       VECTOR LENGTH :",I4," *",I4," =",I9)')Pw,NRMORE,NRSIZE
  endif
  
  if (ircont == 0) then
    allocate(bit(TOTAL_BIT_SIZE))
    allocate(seed_g(Pw,0:NPU-1))

    if(nodeid == 0) write(*,'("  Reset M-rand.number:   seed =",I14)')irseed

    if (irseed <= 0) then
      write(*,'("  Initial seed should not be ZERO/Negative !: seed =",I14)')irseed
      write(*,'("  Stop!")')
      stop
    endif

!******************************************************************************
! Generate Initial Random bit series (length:Pw) from the random number with 
! Linear Congruential Method.
!******************************************************************************
    ir = irseed
    do i=1,Pw
      ir = ir*NXT
      bit(i) = IAND(ISHFT(ir,-16),1)
    enddo

!****************************************************
! Generate Remaining (Required) bit series with GFSR.
!****************************************************
    do i=Pw+1,TOTAL_BIT_SIZE
      bit(i) = IEOR(bit(i-Qw),bit(i-Pw))
    enddo
!*************************
! Initialization is done
!*************************

!******************************************************************************
! Distribute and Convert bit array to Integer array. (Take Precision bits)
!******************************************************************************
    do k=1,Pw
      if (k >= 2) then ! update state vector
        do i=1,Qw
          bit(i) = IEOR(bit(i+TOTAL_BIT_SIZE-Qw),bit(i+TOTAL_BIT_SIZE-Pw))
        enddo
        do i=Qw+1,Pw
          bit(i) = IEOR(bit(i-Qw),bit(i+TOTAL_BIT_SIZE-Pw))
        enddo
        do i=Pw+1,TOTAL_BIT_SIZE
          bit(i) = IEOR(bit(i-Qw),bit(i-Pw))
        enddo
      endif

      do ip=0,NPU-1
        ishift = ip*INT_BIT_SIZE
        m = 0_prc
        do j=STATE_BIT_SIZE,1,-1
          m = IOR((m*2_prc),bit(ishift+j))
        enddo
        seed_g(k,ip) = m
      enddo
    enddo

! Pick up GFSR state vector for each node.
! seed takes the valuses: 0 <= seed <= (2^STATE_BIT_SIZE - 1)
    do k=1,Pw
      this%seed(k) = seed_g(k,nodeid)
    enddo
    this%irhere = NRSIZE ! points the last component of rr(:) so that 1st call of get generates rr(:).

    deallocate(bit,seed_g)

    if (nodeid == 0) then
      write(*,'(" M-rand.number: seed(1) =",I20)') this%seed( 1)
      write(*,'("                seed(P) =",I20)') this%seed(Pw)
      write(*,'("                 irhere =",I14)') this%irhere
    endif
  endif

  return
end subroutine
rand_gfsr_obj
Derived Type :
rr(:) :real(8), pointer
: Container array of uniform random number
seed(:) :integer(prc), pointer
: State vector for GFSR
irhere :integer(INT)
: Pointer to random number rr(:)
irseed :integer(INT)
: Inital random number seed
myid :integer(INT)
: MPI Rank, Total Rank
NPU :integer(INT)
: MPI Rank, Total Rank
Subroutine :
this :type(rand_gfsr_obj), intent(inout)
iout :integer, intent(in)

[Source]

subroutine read_rand(this,iout)
  implicit none
  type(rand_gfsr_obj), intent(inout) :: this
  integer, intent(in) :: iout

  read(iout) this%irseed
  read(iout) this%irhere
  read(iout) this%seed
  read(iout) this%rr
  read(iout) this%myid
  read(iout) this%NPU

  if (this%myid == 0) then
    write(*,'(80("-"))')
    write(*,'(" M-rand.number states are restored")')
    write(*,'(" Node # ",I14)') this%myid
    write(*,'(" M-rand.number: seed(1) =",I20)') this%seed( 1)
    write(*,'("                seed(P) =",I20)') this%seed(Pw)
    write(*,'("                 irhere =",I14)') this%irhere
  endif

  return
end subroutine
Subroutine :
this :type(rand_gfsr_obj), intent(inout)
iout :integer, intent(in)

[Source]

subroutine save_rand(this,iout)
  implicit none
  type(rand_gfsr_obj), intent(inout) :: this
  integer, intent(in) :: iout

  write(iout) this%irseed
  write(iout) this%irhere
  write(iout) this%seed
  write(iout) this%rr
  write(iout) this%myid
  write(iout) this%NPU

  if (this%myid == 0) then
    write(*,'(80("-"))')
    write(*,'(" M-rand.number states are saved")')
    write(*,'(" Node # ",I14)') this%myid
    write(*,'(" M-rand.number: seed(1) =",I20)') this%seed( 1)
    write(*,'("                seed(P) =",I20)') this%seed(Pw)
    write(*,'("                 irhere =",I14)') this%irhere
  endif

  return
end subroutine