Steve Kargl <kargl@gcc.gnu.org>

PR fortran/98301 - random_init() is broken

Correct implementation of random_init() when -fcoarray=lib is given.

gcc/fortran/ChangeLog:

	PR fortran/98301
	* trans-decl.c (gfc_build_builtin_function_decls): Move decl.
	* trans-intrinsic.c (conv_intrinsic_random_init): Use bool for
	lib-call of caf_random_init instead of logical (4-byte).
	* trans.h: Add tree var for random_init.

libgfortran/ChangeLog:

	PR fortran/98301
	* caf/libcaf.h (_gfortran_caf_random_init): New function.
	* caf/single.c (_gfortran_caf_random_init): New function.
	* gfortran.map: Added fndecl.
	* intrinsics/random_init.f90: Implement random_init.

1 files changed, 60 insertions, 54 deletions

diff --git a/libgfortran/intrinsics/random_init.f90 b/libgfortran/intrinsics/random_init.f90
index e5b4087..1200225 100644
--- a/libgfortran/intrinsics/random_init.f90
+++ b/libgfortran/intrinsics/random_init.f90
@@ -1,94 +1,100 @@
 ! Copyright (C) 2018-2021 Free Software Foundation, Inc.
 ! Contributed by Steven G. Kargl <kargl@gcc.gnu.org>
-! 
+!
 ! This file is part of the GNU Fortran runtime library (libgfortran).
-! 
+!
 ! Libgfortran is free software; you can redistribute it and/or
 ! modify it under the terms of the GNU General Public
 ! License as published by the Free Software Foundation; either
 ! version 3 of the License, or (at your option) any later version.
-! 
+!
 ! Libgfortran is distributed in the hope that it will be useful,
 ! but WITHOUT ANY WARRANTY; without even the implied warranty of
 ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 ! GNU General Public License for more details.
-! 
+!
 ! Under Section 7 of GPL version 3, you are granted additional
 ! permissions described in the GCC Runtime Library Exception, version
 ! 3.1, as published by the Free Software Foundation.
-! 
+!
 ! You should have received a copy of the GNU General Public License and
 ! a copy of the GCC Runtime Library Exception along with this program;
 ! see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
 ! <http://www.gnu.org/licenses/>.
 !
-!
 ! WARNING:  This file should never be compiled with an option that changes
 ! default logical kind from 4 to some other value or changes default integer
-! kind from from 4 to some other value.
-!
-!
-! There are four combinations of repeatable and image_distinct.  If a program
-! is compiled without the -fcoarray= option or with -fcoarray=single, then
-! execution of the compiled executable does not use image_distinct as it is
-! irrelevant (although required).  The behavior is as follows:
-!
-! call random_init(.true., .true.)
+! kind from 4 to some other value.
 !
-! The sequence of random numbers is repeatable within an instance of program
-! execution.  That is, calls to random_init(.true., .true.) during the
-! execution will reset the sequence of RN to the same sequence.  If the
-! program is compiled with -fcoarray=lib and multiple images are instantiated,
-! then each image accesses a repeatable distinct sequence of random numbers.
-! There are no guarantees that multiple execution of the program will access
-! the same sequence.
+! There are four combinations of repeatable and image_distinct.  The
+! language below is from the F2018 standard (actually, J3/18-007r1).
 !
-! call random_init(.false., .false.)
-! call random_init(.false., .true.)
+! This routine is only used for non-coarray programs or with programs
+! compiled with -fcoarray=single.  Use of -fcoarray=lib or -fcoarray=shared
+! requires different routines due to the need for communication between
+! images under case(iv).
 !
-! The sequence of random numbers is determined from process-dependent seeds.
-! On each execution of the executable, different seeds will be used.  For
-! -fcoarray=lib and multiple instantiated images, each image will use
-! process-dependent seeds.  In other words, the two calls have identical
-! behavior.
+! Technically, neither image_distinct nor image_num are now needed.  The
+! interface to _gfortran_random_init() is maintained for libgfortran ABI.
+! Note, the Fortran standard requires the image_distinct argument, so
+! it will always have a valid value, and the frontend generates an value
+! of 0 for image_num.
 !
-! call random_init(.true., .false.)
-! 
-! For a program compiled without the -fcoarray= option or with
-! -fcoarray=single, a single image is instantiated when the executable is
-! run.  If the executable causes multiple images to be instantiated, then
-! image_distinct=.false. in one image cannot affect the sequence of random
-! numbers in another image.  As gfortran gives each image its own independent
-! PRNG, this condition is automatically satisfied.
-!
-impure subroutine _gfortran_random_init(repeatable, image_distinct, hidden) 
+impure subroutine _gfortran_random_init(repeatable, image_distinct, image_num) 
 
    implicit none
 
    logical, value, intent(in) :: repeatable
    logical, value, intent(in) :: image_distinct
-   integer, value, intent(in) :: hidden
+   integer, value, intent(in) :: image_num
 
    logical, save :: once = .true.
-   integer :: nseed
+   integer :: nseed, lcg_seed
    integer, save, allocatable :: seed(:)
 
-   if (once) then
-      once = .false.
-      call random_seed(size=nseed)
-      allocate(seed(nseed))
-      call random_seed(get=seed)
+   if (repeatable) then
+      if (once) then
+         once = .false.
+         call random_seed(size=nseed)
+         allocate(seed(nseed))
+         lcg_seed = 57911963
+         call _gfortran_lcg(seed)
+      end if
+      call random_seed(put=seed)
+   else
+      call random_seed()
       !
-      ! To guarantee that seed is distinct on multiple images, add the hidden
-      ! argument (which is the image index).
+      ! This cannot happen; but, prevent gfortran complaining about
+      ! unused variables.
       !
-      if (image_distinct) seed = seed + hidden
+      if (image_num > 2) then
+         block
+            use iso_fortran_env, only : error_unit
+            write(error_unit, '(A)') 'whoops: random_init(.false., .false.)'
+            if (image_distinct) error stop image_num + 1
+            error stop image_num
+         end block
+      end if
    end if
 
-   if (repeatable) then
-      call random_seed(put=seed);
-   else
-      call random_seed();
-   end if
+   contains
+      !
+      ! SK Park and KW Miller, ``Random number generators: good ones are hard
+      ! to find,'' Comm. ACM, 31(10), 1192--1201, (1988).
+      !
+      ! Implementation of a prime modulus multiplicative linear congruential
+      ! generator, which avoids overflow and provides the full period.
+      !
+      impure elemental subroutine _gfortran_lcg(i)
+         implicit none
+         integer, intent(out) :: i
+         integer, parameter :: a = 16807     ! Multiplier
+         integer, parameter :: m = huge(a)   ! Modulus
+         integer, parameter :: q = 127773    ! Quotient to avoid overflow
+         integer, parameter :: r = 2836      ! Remainder to avoid overflow
+         lcg_seed = a * mod(lcg_seed, q) - r * (lcg_seed / q)
+         if (lcg_seed <= 0) lcg_seed = lcg_seed + m
+         i = lcg_seed
+      end subroutine _gfortran_lcg
 
 end subroutine _gfortran_random_init