Improve RANDOM_SEED documentation example.

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

	* intrinsic.texi (RANDOM_SEED): Improve example.


git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@209301 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 28 insertions, 24 deletions

diff --git a/gcc/fortran/intrinsic.texi b/gcc/fortran/intrinsic.texi
index 792518d468c..926ffe954ed 100644
--- 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