Improve RANDOM_SEED documentation example.

2014-04-11  Janne Blomqvist  <jb@gcc.gnu.org>

	* intrinsic.texi (RANDOM_SEED): Improve example.

From-SVN: r209301

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index b5cb1140db134fe4570d631c3b2d1ce19ba49e22..572a7ff5249c9776d11960dc262316ccf2068fe9 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,7 @@
+2014-04-11  Janne Blomqvist  <jb@gcc.gnu.org>
+
+       * intrinsic.texi (RANDOM_SEED): Improve example.
+
 2014-04-10  Bernd Edlinger  <bernd.edlinger@hotmail.de>
 
        * class.c (gfc_build_class_symbol): Append "_t" to target class

diff --git a/gcc/fortran/intrinsic.texi b/gcc/fortran/intrinsic.texi
index 792518d468cbbb5363e4638719ef31303e0a2ced..926ffe954ed6d347d0dffc71f5d31c6d7cf9b02e 100644 (file)
--- a/gcc/fortran/intrinsic.texi
+++ b/gcc/fortran/intrinsic.texi
@@ -10207,11 +10207,12 @@ the @var{SIZE} argument.
 @item @emph{Example}:
 @smallexample
 subroutine init_random_seed()
+  use iso_fortran_env, only: int64
   implicit none
   integer, allocatable :: seed(:)
-  integer :: i, n, un, istat, dt(8), pid, t(2), s
-  integer(8) :: count, tms
-  
+  integer :: i, n, un, istat, dt(8), pid
+  integer(int64) :: t
+
   call random_seed(size = n)
   allocate(seed(n))
   ! First try if the OS provides a random number generator
@@ -10224,34 +10225,37 @@ subroutine init_random_seed()
      ! Fallback to XOR:ing the current time and pid. The PID is
      ! useful in case one launches multiple instances of the same
      ! program in parallel.
-     call system_clock(count)
-     if (count /= 0) then
-        t = transfer(count, t)
-     else
+     call system_clock(t)
+     if (t == 0) then
         call date_and_time(values=dt)
-        tms = (dt(1) - 1970) * 365_8 * 24 * 60 * 60 * 1000 &
-             + dt(2) * 31_8 * 24 * 60 * 60 * 1000 &
-             + dt(3) * 24 * 60 * 60 * 60 * 1000 &
+        t = (dt(1) - 1970) * 365_int64 * 24 * 60 * 60 * 1000 &
+             + dt(2) * 31_int64 * 24 * 60 * 60 * 1000 &
+             + dt(3) * 24_int64 * 60 * 60 * 1000 &
              + dt(5) * 60 * 60 * 1000 &
              + dt(6) * 60 * 1000 + dt(7) * 1000 &
              + dt(8)
-        t = transfer(tms, t)
-     end if
-     s = ieor(t(1), t(2))
-     pid = getpid() + 1099279 ! Add a prime
-     s = ieor(s, pid)
-     if (n >= 3) then
-        seed(1) = t(1) + 36269
-        seed(2) = t(2) + 72551
-        seed(3) = pid
-        if (n > 3) then
-           seed(4:) = s + 37 * (/ (i, i = 0, n - 4) /)
-        end if
-     else 
-        seed = s + 37 * (/ (i, i = 0, n - 1 ) /)
      end if
+     pid = getpid()
+     t = ieor(t, int(pid, kind(t)))
+     do i = 1, n
+        seed(i) = lcg(t)
+     end do
   end if
   call random_seed(put=seed)
+contains
+  ! This simple PRNG might not be good enough for real work, but is
+  ! sufficient for seeding a better PRNG.
+  function lcg(s)
+    integer :: lcg
+    integer(int64) :: s
+    if (s == 0) then
+       s = 104729
+    else
+       s = mod(s, 4294967296_int64)
+    end if
+    s = mod(s * 279470273_int64, 4294967291_int64)
+    lcg = int(mod(s, int(huge(0), int64)), kind(0))
+  end function lcg
 end subroutine init_random_seed
 @end smallexample