Class | random_class |
In: |
RandomClass/random_class.F90
|
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)
$Id: random_class.F90,v 1.9 2010/07/29 11:08:16 ishikawa Exp $
Subroutine : | |
this : | type(rand_gfsr_obj), intent(inout) |
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
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
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
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
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
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
Derived Type : | |||
rr(:) : | real(8), pointer
| ||
seed(:) : | integer(prc), pointer
| ||
irhere : | integer(INT)
| ||
irseed : | integer(INT)
| ||
myid : | integer(INT)
| ||
NPU : | integer(INT)
|
Subroutine : | |
this : | type(rand_gfsr_obj), intent(inout) |
iout : | integer, intent(in) |
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) |
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