[Dart-dev] [6179] DART/branches/development/random_seq/test_reseed.f90: have the test program call the time_manager seed generator
nancy at ucar.edu
nancy at ucar.edu
Wed May 29 10:04:08 MDT 2013
Revision: 6179
Author: nancy
Date: 2013-05-29 10:04:07 -0600 (Wed, 29 May 2013)
Log Message:
-----------
have the test program call the time_manager seed generator
instead of a version that was directly in this test program.
Modified Paths:
--------------
DART/branches/development/random_seq/test_reseed.f90
-------------- next part --------------
Modified: DART/branches/development/random_seq/test_reseed.f90
===================================================================
--- DART/branches/development/random_seq/test_reseed.f90 2013-05-29 16:03:20 UTC (rev 6178)
+++ DART/branches/development/random_seq/test_reseed.f90 2013-05-29 16:04:07 UTC (rev 6179)
@@ -4,16 +4,17 @@
program test_reseed
-use types_mod, only : r4, r8, digits12, i8
-use utilities_mod, only : register_module, error_handler, E_ERR, &
- initialize_utilities, finalize_utilities, &
- logfileunit, nmlfileunit, &
- find_namelist_in_file, check_namelist_read, &
- open_file, close_file, do_nml_file, do_nml_term
+use types_mod, only : r8, digits12
+use utilities_mod, only : register_module, error_handler, E_ERR, &
+ initialize_utilities, finalize_utilities, &
+ logfileunit, nmlfileunit, &
+ find_namelist_in_file, check_namelist_read, &
+ open_file, close_file, do_nml_file, do_nml_term
use time_manager_mod, only : time_type, operator(+), set_time, get_time, &
- set_calendar_type, print_time, print_date
-use random_seq_mod, only : random_seq_type, init_random_seq, &
- random_uniform, random_gaussian
+ set_calendar_type, print_time, print_date, &
+ generate_seed
+use random_seq_mod, only : random_seq_type, init_random_seq, &
+ random_uniform, random_gaussian
implicit none
@@ -28,7 +29,7 @@
integer :: io
integer :: unitnum = 66, iunit
character(len=128) :: fname
-integer :: reseed, hours
+integer :: reseed, hours, years
character(len=64) :: calendar_name = 'GREGORIAN'
integer :: nsamples = 1000000
@@ -60,7 +61,7 @@
print *, ' '
call print_time(state_time, 'setting start time')
-if (calendar_name == 'GREGORIAN') call print_date(state_time, 'is start date')
+if (calendar_name /= 'NO_CALENDAR') call print_date(state_time, 'is start date')
! -----
@@ -133,6 +134,26 @@
! -----
+years = 1
+reseed = 1
+
+call doyearstest(reseed, years)
+
+! -----
+
+years = 10
+reseed = 100
+
+call doyearstest(reseed, years)
+
+
+! -----
+
+call test3
+
+! -----
+
+
call error_handler(E_MSG, 'test_reseed', 'Finished successfully.',&
source,revision,revdate)
call finalize_utilities()
@@ -153,6 +174,14 @@
seed = generate_seed(start_time)
call init_random_seq(seq1, seed)
+print *, ' '
+if (calendar_name /= 'NO_CALENDAR') then
+ call print_date(start_time, 'start time for long seq')
+else
+ call print_time(start_time, 'start time for long seq')
+endif
+print *, ' '
+
do i=1, nreps
if (unif) then
write(unit, *) random_uniform(seq1)
@@ -180,6 +209,15 @@
nextseed = generate_seed(t)
call init_random_seq(seq1, nextseed)
+print *, ' '
+if (calendar_name /= 'NO_CALENDAR') then
+ call print_date(t, 'start time for reseed loop')
+else
+ call print_time(t, 'start time for reseed loop')
+endif
+call print_time(delta_time, 'delta time for reseed loop')
+print *, 'reseeding every ', per, ' times through the loop'
+
j = 1
do i=1, nreps
if (unif) then
@@ -197,6 +235,13 @@
endif
end do
+if (calendar_name /= 'NO_CALENDAR') then
+ call print_date(t, 'end time for reseed loop')
+else
+ call print_time(t, 'end time for reseed loop')
+endif
+print *, ' '
+
end subroutine test2
!-------------------------------------------------------------------------
@@ -205,7 +250,7 @@
real(r8), allocatable :: history(:)
real(r8) :: next_val
-integer :: i, j, nextseed
+integer :: i, j, k, nextseed, seedhist(:)
type(time_type) :: t, base_time, state_time, delta_time, delta_time2
type(random_seq_type) :: seq1
@@ -216,40 +261,48 @@
delta_time2 = set_time(0, 1)
print *, ' '
-call print_time(state_time, 'setting start time')
-call print_time(delta_time, 'delta time')
-call print_time(delta_time2, 'delta time2')
+if (calendar_name /= 'NO_CALENDAR') then
+ call print_date(state_time, 'start time for history loop')
+else
+ call print_time(state_time, 'start time for history loop')
+endif
+call print_time(delta_time, 'delta time for history loop')
+call print_time(delta_time2, 'delta2 time for history loop')
print *, ' '
-! generate the first number from 100 consecutive seeds
-allocate(history(10000))
+! generate 10000 consecutive rand nums
+allocate(history(10000), seedhist(10000))
+
+state_time = base_time
+nextseed = generate_seed(state_time)
+call init_random_seq(seq1, nextseed)
+
do i=1, 10000
- nextseed = generate_seed(state_time)
-
- call init_random_seq(seq1, nextseed)
history(i) = random_uniform(seq1)
-
- state_time = state_time + delta_time
enddo
-! now generate 100 values from each seed and see if
+! now generate 100 values from various seeds and see if
! they overlap in any of the previously generated vals.
-state_time = base_time + delta_time2
-do i=1, 1000
+state_time = base_time + delta_time
+do i=1, 10000
nextseed = generate_seed(state_time)
-
call init_random_seq(seq1, nextseed)
- next_val = random_uniform(seq1)
- do j=1, 10000-1
- if (history(j) == next_val) then
- print *, 'found match, ', i, j, history(j), next_val
- next_val = random_uniform(seq1)
- print *, 'next val from ran ', next_val, ' next in seq is ', history(j+1)
- endif
+ do j=1, 100
+ next_val = random_uniform(seq1)
+ do k=1, 10000-1
+ if (history(k) == next_val) then
+ print *, 'found match, ', next_val, i, j, k
+ next_val = random_uniform(seq1)
+ print *, 'next val from ran ', next_val, ' next in seq is ', history(k+1)
+ if (history(k+1) == next_val) then
+ print *, 'found 2 matching values in a row: ', history(k), history(k+1), i, j, k
+ endif
+ endif
+ enddo
enddo
- state_time = state_time + delta_time2
+ state_time = state_time + delta_time
enddo
@@ -280,58 +333,81 @@
!-------------------------------------------------------------------------
-function generate_seed(state_time)
-! use the state time to set the seed for the (repeatable) random sequence
+subroutine doyearstest(reseed, years)
+ integer, intent(in) :: reseed, years
-type(time_type), intent(in) :: state_time
-integer :: generate_seed
+type(time_type) :: delta_time
-integer :: days,seconds,bigint,bigtwo
-integer(i8) :: bigtime,bigone
-integer(i8), parameter :: secs_day = 86400_i8
+write(fname, '(A,I4.4,A,I4.4,A)') 'uniform_', reseed, 'dt_', years, 'y'
+open(unit=unitnum, file=fname, action='write')
+delta_time = set_time(21600, nint(years*365.25))
+call test2(nsamples, reseed, state_time, delta_time, .true., unitnum)
+close(unitnum)
-call get_time(state_time, seconds, days)
+write(fname, '(A,I4.4,A,I4.4,A)') 'gaussian_', reseed, 'dt_', years, 'y'
+open(unit=unitnum, file=fname, action='write')
+delta_time = set_time(21600, nint(years*265.25))
+call test2(nsamples, reseed, state_time, delta_time, .false., unitnum)
+close(unitnum)
-! option 1: add days & secs, old gen needs negative seed,
-! new one doesn't care.
-!generate_seed = days + seconds
-!return
+end subroutine doyearstest
-! option 2: compute total seconds in an i8 then use the lower
-! 32 bits (which is all the init routine will take to stay
-! portable across different platforms).
-
-! if generate_seed was i8, or if this routine was combined with
-! the real init routine, we could avoid the bitwise and below.
-! it's going to get repeated in the set seed routine.
-generate_seed = iand((secs_day * days) + seconds, z'FFFFFFFF')
-return
-
-! option 3: works with old generator but maybe overkill?
-! for the old generator, it has to be < 0 and apparently > something
-! like 50,000 more than the largest negative int.
-
-!bigtime = int(days,i8)*100000_i8 + int(seconds,i8)
-!bigint = huge(seconds) ! biggest 32bit integer
-!bigone = int(bigint,i8) ! coerce to 64bit integer
-!bigtwo = int(mod(bigtime,bigone)) ! modulo arith on 64bit integers, then 32bit
-!generate_seed = -1 * int(bigtwo) ! coerce back to 32bit integer
-
-! arb choices if the seed is going to cause an error
-!if (generate_seed >= 0) generate_seed = -1234
-!if (generate_seed < -2147432706) generate_seed = -4376
-!return
-
-! option 4: positive number instead of negative
-!generate_seed = bigtwo
-!return
-
-! not reached anymore:
-!write(*,*)'TJH DEBUG generate_seed ',bigtime,bigint,generate_seed
-
-end function generate_seed
-
!-------------------------------------------------------------------------
+!%!
+!%! function generate_seed(state_time, ensembleid, taskid)
+!%! ! use the state time to set the seed for the (repeatable) random sequence
+!%!
+!%! type(time_type), intent(in) :: state_time
+!%! integer, optional, intent(in) :: ensembleid, taskid
+!%! integer :: generate_seed
+!%!
+!%! integer :: days,seconds,bigint,bigtwo
+!%! integer(i8) :: bigtime,bigone
+!%! integer(i8), parameter :: secs_day = 86400_i8
+!%!
+!%! call get_time(state_time, seconds, days)
+!%!
+!%! ! option 1: add days & secs, old gen needs negative seed,
+!%! ! new one doesn't care.
+!%! !generate_seed = days + seconds
+!%! !return
+!%!
+!%! ! option 2: compute total seconds in an i8 then use the lower
+!%! ! 32 bits (which is all the init routine will take to stay
+!%! ! portable across different platforms).
+!%!
+!%! ! if generate_seed was i8, or if this routine was combined with
+!%! ! the real init routine, we could avoid the bitwise and below.
+!%! ! it's going to get repeated in the set seed routine.
+!%! generate_seed = iand((secs_day * days) + seconds, z'FFFFFFFF')
+!%! !write(*,*)'TJH DEBUG generate_seed ',days,seconds,(secs_day*days)+seconds,generate_seed
+!%! return
+!%!
+!%! ! option 3: works with old generator but maybe overkill?
+!%! ! for the old generator, it has to be < 0 and apparently > something
+!%! ! like 50,000 more than the largest negative int.
+!%!
+!%! !bigtime = int(days,i8)*100000_i8 + int(seconds,i8)
+!%! !bigint = huge(seconds) ! biggest 32bit integer
+!%! !bigone = int(bigint,i8) ! coerce to 64bit integer
+!%! !bigtwo = int(mod(bigtime,bigone)) ! modulo arith on 64bit integers, then 32bit
+!%! !generate_seed = -1 * int(bigtwo) ! coerce back to 32bit integer
+!%!
+!%! ! arb choices if the seed is going to cause an error
+!%! !if (generate_seed >= 0) generate_seed = -1234
+!%! !if (generate_seed < -2147432706) generate_seed = -4376
+!%! !return
+!%!
+!%! ! option 4: positive number instead of negative
+!%! !generate_seed = bigtwo
+!%! !return
+!%!
+!%! ! not reached anymore:
+!%! !write(*,*)'TJH DEBUG generate_seed ',bigtime,bigint,generate_seed
+!%!
+!%! end function generate_seed
+!%!
+!-------------------------------------------------------------------------
end program test_reseed
More information about the Dart-dev
mailing list