[Dart-dev] [5621] DART/branches/development/random_nr: remove code.
nancy at ucar.edu
nancy at ucar.edu
Mon Mar 26 15:38:39 MDT 2012
Revision: 5621
Author: nancy
Date: 2012-03-26 15:38:39 -0600 (Mon, 26 Mar 2012)
Log Message:
-----------
remove code. all random number routines are now part of
the random_seq mod (which has always had the public entry points,
so no one should be calling directly into these routines.)
Modified Paths:
--------------
DART/branches/development/random_nr/random_nr_mod.f90
Removed Paths:
-------------
DART/branches/development/random_nr/random_nr_mod.html
DART/branches/development/random_nr/test/
DART/branches/development/random_nr/test_random_nr.f90
DART/branches/development/random_nr/test_reseed.f90
-------------- next part --------------
Modified: DART/branches/development/random_nr/random_nr_mod.f90
===================================================================
--- DART/branches/development/random_nr/random_nr_mod.f90 2012-03-26 21:37:31 UTC (rev 5620)
+++ DART/branches/development/random_nr/random_nr_mod.f90 2012-03-26 21:38:39 UTC (rev 5621)
@@ -10,143 +10,7 @@
! $Revision$
! $Date$
-use types_mod, only : r8, digits12
-use utilities_mod, only : register_module, error_handler, E_ERR
-implicit none
-private
+! THIS MODULE IS DEPRECATED. USE THE ROUTINES IN random_seq_mod INSTEAD
-public :: random_seq_type, init_ran1, ran1, gasdev
-
-! version controlled file description for error handling, do not edit
-character(len=128), parameter :: &
- source = "$URL$", &
- revision = "$Revision$", &
- revdate = "$Date$"
-
-integer, parameter :: m1 = 259200, ia1 = 7141, ic1 = 54773
-integer, parameter :: m2 = 134456, ia2 = 8121, ic2 = 28411
-integer, parameter :: m3 = 243000, ia3 = 4561, ic3 = 51349
-real(digits12), parameter :: rm1 = 1.0_digits12/m1, rm2 = 1.0_digits12/m2
-
-type random_seq_type
- private
- integer :: ix1, ix2, ix3, iset
- real(digits12) :: r(97), gset
-end type random_seq_type
-
-logical, save :: module_initialized = .false.
-
-
-contains
-
-
-
-subroutine initialize_module
-
- call register_module(source,revision,revdate)
- module_initialized = .true.
-
-end subroutine initialize_module
-
-
-
-
-!-------------------------------------------------------------------
-
-! A random congruential random number generator (see Knuth)
-subroutine init_ran1(s, temp)
-
-implicit none
-
-integer, intent(in) :: temp
-type(random_seq_type), intent(out) :: s
-integer j
-
-if ( .not. module_initialized ) call initialize_module
-
-if (temp >= ic1) then
- call error_handler(E_ERR,' ran1', 'Use negative seed or seed smaller than 54000', source, revision, revdate)
-endif
-
-! Initialize the generator for use with
-! repeatable sequences
-
-s%ix1 = mod(ic1 - temp, m1)
-s%ix1 = mod(ia1*s%ix1 + ic1, m1)
-s%ix2 = mod(s%ix1, m2)
-s%ix1 = mod(ia1*s%ix1 + ic1, m1)
-s%ix3 = mod(s%ix1, m3)
-do j = 1, 97
- s%ix1 = mod(ia1*s%ix1 + ic1, m1)
- s%ix2 = mod(ia2*s%ix2 + ic2, m2)
- s%r(j) = (s%ix1 + s%ix2*rm2)*rm1
-end do
-
-! Initialize the value needed for Gaussian efficiency
-s%iset = 0
-
-end subroutine init_ran1
-
-!-----------------------------------------------------------------
-
-! A random congruential random number generator (see Knuth)
-function ran1(s)
-
-implicit none
-
-type(random_seq_type), intent(inout) :: s
-real(r8) :: ran1
-
-integer :: j
-
-if ( .not. module_initialized ) call initialize_module
-
-! Gives a U(0,1) random number
-
-s%ix1 = mod(ia1*s%ix1 + ic1, m1)
-s%ix2 = mod(ia2*s%ix2 + ic2, m2)
-s%ix3 = mod(ia3*s%ix3 + ic3, m3)
-j = 1 + (97*s%ix3) / m3
-if(j > 97 .or. j < 1) then
- call error_handler(E_ERR,' ran1', 'Fatal error in random_nr_mod', source, revision, revdate)
-endif
-ran1 = s%r(j)
-s%r(j) = (s%ix1 + s%ix2*rm2)*rm1
-return
-end function ran1
-
-!---------------------------------------------------------------------
-
-function gasdev(s)
-
-! Returns a N(-1, 1) random number draw from a gaussian distribution
-
-implicit none
-
-type(random_seq_type), intent(inout) :: s
-real(r8) :: gasdev
-
-real(digits12) :: v1, v2, r, fac
-
-if ( .not. module_initialized ) call initialize_module
-
-if(s%iset == 0) then
-10 v1 = 2.0_digits12 * ran1(s) - 1.0_digits12
- v2 = 2.0_digits12 * ran1(s) - 1.0_digits12
- r = v1**2 + v2**2
- if(r >= 1.0_digits12) goto 10
- fac = sqrt(-2.0_digits12 * log(r) / r)
- s%gset = v1 * fac
- gasdev = v2 * fac
- s%iset = 1
-else
- gasdev = s%gset
- s%iset = 0
-endif
-
-end function gasdev
-
-!------------------------------------------------------------------------
-
end module random_nr_mod
Deleted: DART/branches/development/random_nr/random_nr_mod.html
===================================================================
--- DART/branches/development/random_nr/random_nr_mod.html 2012-03-26 21:37:31 UTC (rev 5620)
+++ DART/branches/development/random_nr/random_nr_mod.html 2012-03-26 21:38:39 UTC (rev 5621)
@@ -1,292 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN"
- "http://www.w3.org/TR/html4/strict.dtd">
-<HTML>
-<HEAD>
-<TITLE>module random_nr_mod</TITLE>
-<link rel="stylesheet" type="text/css" href="../doc/html/doc.css">
-<link href="../doc/html/dart.ico" rel="shortcut icon" />
-</HEAD>
-<BODY>
-<A NAME="TOP"></A>
-
-<H1>MODULE random_nr_mod</H1>
-
-<table border=0 summary="" cellpadding=5>
-<tr>
- <td valign=middle>
- <img src="../doc/html/Dartboard7.png" alt="DART project logo" height=70 />
- </td>
- <td>
- <P>Jump to <a href="../index.html">DART Documentation Main Index</a><br />
- <small><small>version information for this file: <br />
- <!-- version tag follows, do not edit -->
- $Id$</small></small>
- </P></td>
-</tr>
-</table>
-
-<A HREF="#Interface">INTERFACES</A> /
-<A HREF="#Namelist">NAMELIST</A> /
-<A HREF="#FilesUsed">FILES</A> /
-<A HREF="#References">REFERENCES</A> /
-<A HREF="#Errors">ERRORS</A> /
-<A HREF="#FuturePlans">PLANS</A> /
-<A HREF="#PrivateComponents">PRIVATE COMPONENTS</A> /
-<A HREF="#Legalese">TERMS OF USE</A>
-
-<H2>Overview</H2>
-
-<P>
-A linear congruential random number generator (see Knuth). The values for
-the parameters are the same as those used in numerical recipes.
-</P>
-
-<!--==================================================================-->
-
-<A NAME="OtherModulesUsed"></A>
-<HR>
-<H2>OTHER MODULES USED</H2>
-<PRE>
-types_mod
-utilities_mod
-</PRE>
-
-<!--==================================================================-->
-<!-- Declare all public entities ... -->
-<!-- duplicate public routines template as many times as necessary -->
-<!-- make sure you replace all yyyroutine?? strings -->
-<!--==================================================================-->
-<!--Note to authors. The first row of the table is different. -->
-<!--==================================================================-->
-
-<A NAME="Interface"></A>
-<HR>
-<H2>PUBLIC INTERFACES</H2>
-
-<TABLE>
-<TR><TD><em class=call>use random_nr_mod, only : </em></TD>
- <TD><A HREF="#random_seq_type">random_seq_type</A></TD></TR>
-<TR><TD> </TD><TD><A HREF="#init_ran1">init_ran1</A></TD></TR>
-<TR><TD> </TD><TD><A HREF="#ran1">ran1</A></TD></TR>
-<TR><TD> </TD><TD><A HREF="#gasdev">gasdev</A></TD></TR>
-</TABLE>
-
-<!--=================== DESCRIPTION OF A LOCAL TYPE ==================-->
-
-<A NAME="random_seq_type"></A>
-<BR>
-<div class=type>
-<pre>
-<em class=call>type random_seq_type</em>
- private
- integer :: ix1, ix2, ix3, iset
- real(r8) :: r(97), gset
-end type random_seq_type
-</pre>
-</div>
-
-<div class=indent1>
-<!-- Description -->
-
-<P>
-Keeps the state history of the linear congruential number generator.
-See Knuth for details.
-</P>
-
-</div>
-<br>
-
-<!--===================== DESCRIPTION OF A ROUTINE =====================-->
-
-<A NAME="init_ran1"></A>
-<br>
-<div class=routine>
-<em class=call> call init_ran1(s,temp) </em>
-<pre>
-type(random_seq_type), intent(out) :: <em class=code>s</em>
-integer, intent(in) :: <em class=code>temp</em>
-</pre>
-</div>
-
-<div class=indent1>
-<!-- Description -->
-
-<P>
-Initializes a random sequence with an integer. Any sequence
-initialized with the same integer will produce the same sequence
-of 'random' numbers.
-</P>
-
-<TABLE width=100% border=0 summary="" cellpadding=3>
-<TR><TD valign=top><em class=code>s </em></TD>
- <TD>A random sequence to be initialized</TD></TR>
-<TR><TD valign=top><em class=code>temp </em></TD>
- <TD>An integer seed to start the sequence.</TD></TR>
-</TABLE>
-
-</div>
-<br>
-
-<!--===================== DESCRIPTION OF A ROUTINE =====================-->
-
-<A NAME="ran1"></A>
-<br>
-<div class=routine>
-<em class=call> var = ran1(s) </em>
-<pre>
-real(r8) :: <em class=code>ran1</em>
-type(random_seq_type), intent(inout) :: <em class=code>s</em>
-</pre>
-</div>
-
-<div class=indent1>
-<!-- Description -->
-
-<P>
-Generate the next uniform [0, 1] random number in the sequence.
-</P>
-
-<TABLE width=100% border=0 summary="" cellpadding=3>
-<TR><TD valign=top><em class=code>ran1 </em></TD>
- <TD>Next uniformly distributed [0, 1] number in sequence.</TD></TR>
-<TR><TD valign=top><em class=code>s </em></TD>
- <TD>A random sequence.</TD></TR>
-</TABLE>
-
-</div>
-<br>
-
-<!--===================== DESCRIPTION OF A ROUTINE =====================-->
-
-<A NAME="gasdev"></A>
-<br>
-<div class=routine>
-<em class=call> var = gasdev(s) </em>
-<pre>
-real(r8) :: <em class=code>gasdev</em>
-type(random_seq_type), intent(inout) :: <em class=code>s</em>
-</pre>
-</div>
-
-<div class=indent1>
-<!-- Description -->
-
-<P>
-Generates a random draw from a standard gaussian.
-</P>
-
-<TABLE width=100% border=0 summary="" cellpadding=3>
-<TR><TD valign=top><em class=code>gasdev </em></TD>
- <TD>A random draw from a standard gaussian.</TD></TR>
-<TR><TD valign=top><em class=code>s </em></TD>
- <TD>A random sequence.</TD></TR>
-</TABLE>
-
-</div>
-<br>
-
-<!--==================================================================-->
-<!--=================== DESCRIPTION OF A NAMELIST ===================-->
-<!--==================================================================-->
-
-<A NAME="Namelist"></A>
-<HR>
-<H2>NAMELIST</H2>
-
-<P>
-This module has no namelists.
-</P>
-
-<!--==================================================================-->
-<!-- Describe the Files Used by this module. -->
-<!--==================================================================-->
-
-<A NAME="FilesUsed"></A>
-<HR>
-<H2>FILES</H2>
-<UL>
- <LI>None</LI>
-</UL>
-
-<!--==================================================================-->
-<!-- Cite references, if need be. -->
-<!--==================================================================-->
-
-<A NAME="References"></A>
-<HR>
-<H2>REFERENCES</H2>
-<ol>
-<li> Knuth </li>
-</ol>
-
-<!--==================================================================-->
-<!-- Describe all the error conditions and codes. -->
-<!--==================================================================-->
-
-<A NAME="Errors"></A>
-<HR>
-<H2>ERROR CODES and CONDITIONS</H2>
-<div class=errors>
-<TABLE border=1 cellspacing=1 cellpadding=10 width=100%>
-<TR><TH>Routine</TH><TH>Message</TH><TH>Comment</TH></TR>
-
-<TR><!-- routine --><TD VALIGN=top>ran1</TD>
- <!-- message --><TD VALIGN=top>Fatal error in random number</TD>
- <!-- comment --><TD VALIGN=top>This should probably be removed; should never happen.</TD>
-</TR>
-
-</TABLE>
-</div>
-
-<H2>KNOWN BUGS</H2>
-<P>
-none at this time
-</P>
-
-<!--==================================================================-->
-<!-- Describe Future Plans. -->
-<!--==================================================================-->
-
-<A NAME="FuturePlans"></A>
-<HR>
-<H2>FUTURE PLANS</H2>
-<P>
-none at this time
-</P>
-
-<!--==================================================================-->
-<!-- PrivateComponents -->
-<!--==================================================================-->
-
-<A NAME="PrivateComponents"></A>
-<HR>
-<H2>PRIVATE COMPONENTS</H2>
-<P>
-N/A
-</P>
-<!--==================================================================-->
-
-<A NAME="Legalese"></A>
-<HR>
-<H2>Terms of Use</H2>
-
-<P>
-DART software - Copyright 2004 - 2011 UCAR.<br>
-This open source software is provided by UCAR, "as is",<br>
-without charge, subject to all terms of use at<br>
-<a href="http://www.image.ucar.edu/DAReS/DART/DART_download">
-http://www.image.ucar.edu/DAReS/DART/DART_download</a>
-</P>
-
-<TABLE border=0 cellpadding=0 width=100% summary="">
-<TR><TD valign=top>Contact: </TD><TD> DART core group </TD></TR>
-<TR><TD valign=top>Revision: </TD><TD> $Revision$ </TD></TR>
-<TR><TD valign=top>Source: </TD><TD> $URL$ </TD></TR>
-<TR><TD valign=top>Change Date: </TD><TD> $Date$ </TD></TR>
-<TR><TD valign=top>Change history: </TD><TD> try "svn log" or "svn diff" </TD></TR>
-</TABLE>
-
-<!--==================================================================-->
-
-</BODY>
-</HTML>
Deleted: DART/branches/development/random_nr/test_random_nr.f90
===================================================================
--- DART/branches/development/random_nr/test_random_nr.f90 2012-03-26 21:37:31 UTC (rev 5620)
+++ DART/branches/development/random_nr/test_random_nr.f90 2012-03-26 21:38:39 UTC (rev 5621)
@@ -1,86 +0,0 @@
-! DART software - Copyright 2004 - 2011 UCAR. This open source software is
-! provided by UCAR, "as is", without charge, subject to all terms of use at
-! http://www.image.ucar.edu/DAReS/DART/DART_download
-
-program test_random_nr
-
-! <next few lines under version control, do not edit>
-! $URL$
-! $Id$
-! $Revision$
-! $Date$
-
-use types_mod, only : r4, r8, digits12
-use utilities_mod, only : register_module, error_handler, E_ERR, &
- initialize_utilities, timestamp
-use random_nr_mod, only : random_seq_type, init_ran1, ran1, gasdev
-
-implicit none
-
-! version controlled file description for error handling, do not edit
-character(len=128), parameter :: &
- source = "$URL$", &
- revision = "$Revision$", &
- revdate = "$Date$"
-
-type (random_seq_type) :: r
-integer :: i, n
-
-double precision :: dpr1, dpdist, dpmean_dist
-real(r8) :: r8r1, r8dist, r8mean_dist
-real(r4) :: r4r1, r4dist, r4mean_dist
-real(digits12) :: d12r1, d12dist, d12mean_dist
-
-call initialize_utilities('test_random_nr')
-call register_module(source,revision,revdate)
-
-write(*, *) 'double precision is ', kind(dpr1)
-write(*, *) 'digits12 is defined to be ', digits12
-write(*, *) 'r8 is defined to be ', r8
-write(*, *) 'r4 is defined to be ', r4
-
-n = 10000000
-
-
-call init_ran1(r, -5)
-d12mean_dist = 0.0
-do i = 1, n
- d12r1 = gasdev(r)
- d12dist = abs(d12r1)
- d12mean_dist = d12mean_dist + d12dist
-end do
-write(*, *) 'digits12 sd is ', d12mean_dist / n
-
-
-call init_ran1(r, -5)
-dpmean_dist = 0.0
-do i = 1, n
- dpr1 = gasdev(r)
- dpdist = dabs(dpr1)
- dpmean_dist = dpmean_dist + dpdist
-end do
-write(*, *) 'double precision sd is ', dpmean_dist / n
-
-
-call init_ran1(r, -5)
-r8mean_dist = 0.0_r8
-do i = 1, n
- r8r1 = gasdev(r)
- r8dist = abs(r8r1)
- r8mean_dist = r8mean_dist + r8dist
-end do
-write(*, *) 'r8 sd is ', r8mean_dist / n
-
-
-call init_ran1(r, -5)
-r4mean_dist = 0.0_r4
-do i = 1, n
- r4r1 = gasdev(r)
- r4dist = abs(r4r1)
- r4mean_dist = r4mean_dist + r4dist
-end do
-write(*, *) 'r4 sd is ', r4mean_dist / n
-
-call timestamp(source,revision,revdate,'end')
-
-end program test_random_nr
Deleted: DART/branches/development/random_nr/test_reseed.f90
===================================================================
--- DART/branches/development/random_nr/test_reseed.f90 2012-03-26 21:37:31 UTC (rev 5620)
+++ DART/branches/development/random_nr/test_reseed.f90 2012-03-26 21:38:39 UTC (rev 5621)
@@ -1,224 +0,0 @@
-! DART software - Copyright 2004 - 2011 UCAR. This open source software is
-! provided by UCAR, "as is", without charge, subject to all terms of use at
-! http://www.image.ucar.edu/DAReS/DART/DART_download
-
-program test_reseed
-
-! <next few lines under version control, do not edit>
-! $URL$
-! $Id$
-! $Revision$
-! $Date$
-
-use types_mod, only : r4, r8, i8
-use utilities_mod, only : register_module, error_handler, E_ERR, &
- initialize_utilities, finalize_utilities, &
- open_file, close_file, find_namelist_in_file, &
- check_namelist_read
-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
-
-implicit none
-
-! version controlled file description for error handling, do not edit
-character(len=128), parameter :: &
- source = "$URL$", &
- revision = "$Revision$", &
- revdate = "$Date$"
-
-type (random_seq_type) :: seq
-type (time_type) :: state_time, delta_time
-
-integer :: i, l, rep, nextseed
-integer :: maxreps = 1000
-integer, parameter :: ntests = 5
-integer :: nloops(ntests) = (/ 1, 10, 100, 1000, 1000000 /)
-
-real(r8), allocatable, dimension(:) :: ranarray
-real(r8) :: mean, var
-
-integer :: iunit1,iunit2,iunit3, io
-character(len=32) :: filename1,filename2,filename3
-
-! Namelist with default values
-
-integer :: time_days = 148000
-integer :: time_seconds = 0
-integer :: time_step_seconds = 3600
-
-namelist /test_reseed_nml/ time_days, time_seconds, time_step_seconds
-
-!---------------------------------------------------------------
-
-call initialize_utilities('test_reseed')
-call register_module(source,revision,revdate)
-call set_calendar_type('GREGORIAN')
-
-! Read the namelist entry
-call find_namelist_in_file("input.nml", "test_reseed_nml", iunit1)
-read(iunit1, nml = test_reseed_nml, iostat = io)
-call check_namelist_read(iunit1, io, "test_reseed_nml")
-
-state_time = set_time(time_seconds, time_days)
-delta_time = set_time(time_step_seconds)
-
-print *, ' '
-call print_date(state_time, 'setting start time')
-call print_time(delta_time, 'delta time')
-
-print *, ' '
-print *, 'defining r4 to be ',r4
-print *, 'defining r8 to be ',r8
-print *, 'doing ', maxreps, ' repeats of ', ntests, ' counts:'
-do i=1, ntests
- print *, 'mean[,std] for ', nloops(i), ' uniform distribution'
-enddo
-do i=1, ntests
- print *, 'mean[,std] for ', nloops(i), ' gaussian distribution'
-enddo
-print *, ' '
-
-write(filename1,'(''ran_test_r'',I1,''_'',I5.5,''_compact.out'')') r8, time_step_seconds
-write(filename2,'(''ran_test_r'',I1,''_'',I5.5,''_full.out'' )') r8, time_step_seconds
-write(filename3,'(''ran_test_r'',I1,''_'',I5.5,''_numbers.out'')') r8, time_step_seconds
-
-iunit1 = open_file(filename1, form='formatted', action='write')
-iunit2 = open_file(filename2, form='formatted', action='write')
-iunit3 = open_file(filename3, form='formatted', action='write')
-
-write(*,*)'creating compact output file ',trim(filename1)
-write(*,*)'creating output file ',trim(filename2)
-write(*,*)'creating output file ',trim(filename3)
-
-do rep=1, maxreps
-
- nextseed = generate_seed(state_time)
-
- write( * ,'('' trial '',i5,'' new seed: '', i14)')rep, nextseed
- write(iunit1,'('' trial '',i5,'' new seed: '', i14)')rep, nextseed
- write(iunit2,'('' trial '',i5,'' new seed: '', i14)')rep, nextseed
-
-! ---------
-
- do l=1, ntests
-
- call init_random_seq(seq, nextseed)
-
- allocate(ranarray(nloops(l)))
-
- mean = 0.0_r8
- var = 0.0_r8
- do i=1, nloops(l)
- ranarray(i) = random_uniform(seq)
- mean = mean + ranarray(i)
- enddo
-
- mean = mean/real(nloops(l),r8)
-
- do i=1, nloops(l)
- var = var + (mean - ranarray(i))**2
- enddo
-
- if (l /= 1) then
- write(iunit1,'(''uniform '',i7,1x,f9.6, 1x,f9.6 )') nloops(l), mean, sqrt(var/(nloops(l)-1))
- write(iunit2,'(''uniform '',i7,1x,f19.16,1x,f19.16)') nloops(l), mean, sqrt(var/(nloops(l)-1))
- else
- write(iunit1,'(''uniform '',i7,1x,f9.6 )') nloops(l), mean
- write(iunit2,'(''uniform '',i7,1x,f19.16 )') nloops(l), mean
- endif
-
- deallocate(ranarray)
-
- enddo
-
-! ---------
-
- write( * ,*)
- write(iunit1,*)
- write(iunit2,*)
-
-! ---------
-
- do l=1, ntests
-
- call init_random_seq(seq, nextseed)
-
- allocate(ranarray(nloops(l)))
-
- mean = 0.0_r8
- var = 0.0_r8
- do i=1, nloops(l)
- ranarray(i) = random_gaussian(seq, 0.0_r8, 1.0_r8)
- mean = mean + ranarray(i)
- enddo
-
- mean = mean/real(nloops(l),r8)
-
- do i=1, nloops(l)
- var = var + (mean - ranarray(i))**2
- enddo
-
- if (l /= 1) then
- write(iunit1,'(''gaussian '',i7,1x,f9.6, 1x,f9.6 )') nloops(l), mean, sqrt(var/(nloops(l)-1))
- write(iunit2,'(''gaussian '',i7,1x,f19.16,1x,f19.16)') nloops(l), mean, sqrt(var/(nloops(l)-1))
- else
- write(iunit1,'(''gaussian '',i7,1x,f9.6 )') nloops(l), mean
- write(iunit2,'(''gaussian '',i7,1x,f19.16 )') nloops(l), mean
- endif
-
- if ( nloops(l) == 100 ) then
- do i=1, nloops(l)
- write(iunit3,*) ranarray(i)
- enddo
- endif
-
- deallocate(ranarray)
-
- enddo
-
-! ---------
-
- write( * ,*)
- write(iunit1,*)
- write(iunit2,*)
-
-! ---------
-
- state_time = state_time + delta_time
-
-enddo
-
-call close_file(iunit1)
-call close_file(iunit2)
-call close_file(iunit3)
-
-call finalize_utilities()
-
-contains
-
-!-------------------------------------------------------------------------
-
-function generate_seed(state_time)
-! use the state time to set the seed for the (repeatable) random sequence
-
-type(time_type), intent(in) :: state_time
-integer :: generate_seed
-
-integer :: days,seconds,bigint
-integer(kind=i8) :: bigtime,bigone,bigtwo
-
-call get_time(state_time, seconds, days)
-
-bigtime = int(days,i8)*100000_i8 + int(seconds,i8)
-bigint = huge(seconds) ! biggest 32bit integer
-bigone = int(bigint,i8) ! coerce to 64bit integer
-bigtwo = mod(bigtime,bigone) ! modulo arith on 64bit integers
-generate_seed = -1 * int(bigtwo) ! coerce back to 32bit integer
-
-!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