OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

re PR fortran/63570 ([F2018] Implement 13.7.137 RANDOM INIT (REPEATABLE, IMAGE DISTINCT))

Browse Source 
2018-06-01  Steven G. Kargl  <kargl@gcc.gnu.org>

	PR fortran/63570
	* check.c (gfc_check_random_init): New function. Check arguments of
	RANDOM_INIT.
	* gfortran.h (GFC_ISYM_RANDOM_INIT): New enum token.
	* intrinsic.c (add_subroutines): Add RANDOM_INIT to list of 
	subroutines.
	(gfc_check_intrinsic_standard): Introduce Fortran 2018 check.
	* intrinsic.h: Add prototypes for gfc_check_random_init and
	gfc_resolve_random_init
	* intrinsic.texi: Document new intrinsic subprogram.
	* iresolve.c (gfc_resolve_random_init): Resolve routine name.
	* trans-decl.c: Declare gfor_fndecl_random_init
	* trans-intrinsic.c (conv_intrinsic_random_init): New function.
	Translate call to RANDOM_INIT.
	(gfc_conv_intrinsic_subroutine): Call it.
 	* trans.h: Declare gfor_fndecl_random_init
 
2018-06-01  Steven G. Kargl  <kargl@gcc.gnu.org>
 
	PR fortran/63570
	* gfortran.dg/random_init_1.f90: New test.
	* gfortran.dg/random_init_2.f90: New test.
	* gfortran.dg/random_init_3.f90: New test.
	* gfortran.dg/random_init_4.f90: New test.
	* gfortran.dg/random_init_5.f90: New test.
	* gfortran.dg/random_init_6.f90: New test.

2018-06-01  Steven G. Kargl  <kargl@gcc.gnu.org>

	PR fortran/63570
	* libgfortran/Makefile.am: Add random_init.f90 to build.
	* libgfortran/Makefile.in: Regenerated.
	* libgfortran/gfortran.map: Expose symbol for _gfortran_random_init.
	* libgfortran/intrinsics/random_init.f90: Implementation.

From-SVN: r261075
This commit is contained in:
Steven G. Kargl 2018-06-01 17:05:02 +00:00
parent 77b8fb05b3
commit ddd3e26e42
22 changed files with 541 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
gcc/fortran/ChangeLog
View File

@ -1,3 +1,22 @@
2018-06-01 Steven G. Kargl <kargl@gcc.gnu.org>
PR fortran/63570
* check.c (gfc_check_random_init): New function. Check arguments of
RANDOM_INIT.
* gfortran.h (GFC_ISYM_RANDOM_INIT): New enum token.
* intrinsic.c (add_subroutines): Add RANDOM_INIT to list of
subroutines.
(gfc_check_intrinsic_standard): Introduce Fortran 2018 check.
* intrinsic.h: Add prototypes for gfc_check_random_init and
gfc_resolve_random_init
* intrinsic.texi: Document new intrinsic subprogram.
* iresolve.c (gfc_resolve_random_init): Resolve routine name.
* trans-decl.c: Declare gfor_fndecl_random_init
* trans-intrinsic.c (conv_intrinsic_random_init): New function.
Translate call to RANDOM_INIT.
(gfc_conv_intrinsic_subroutine): Call it.
* trans.h: Declare gfor_fndecl_random_init
2018-05-27 Steven G. Kargl <kargl@gcc.gnu.org>
* decl.c (match_data_constant): Fortran 2018 allows pointer

21
gcc/fortran/check.c
View File

@ -5786,6 +5786,27 @@ gfc_check_mvbits (gfc_expr *from, gfc_expr *frompos, gfc_expr *len,
}
/* Check the arguments for RANDOM_INIT. */
bool
gfc_check_random_init (gfc_expr *repeatable, gfc_expr *image_distinct)
{
if (!type_check (repeatable, 0, BT_LOGICAL))
return false;
if (!scalar_check (repeatable, 0))
return false;
if (!type_check (image_distinct, 1, BT_LOGICAL))
return false;
if (!scalar_check (image_distinct, 1))
return false;
return true;
}
bool
gfc_check_random_number (gfc_expr *harvest)
{

1
gcc/fortran/gfortran.h
View File

@ -553,6 +553,7 @@ enum gfc_isym_id
GFC_ISYM_PRODUCT,
GFC_ISYM_RADIX,
GFC_ISYM_RAND,
GFC_ISYM_RANDOM_INIT,
GFC_ISYM_RANDOM_NUMBER,
GFC_ISYM_RANDOM_SEED,
GFC_ISYM_RANGE,

6
gcc/fortran/intrinsic.c
View File

@ -3568,6 +3568,12 @@ add_subroutines (void)
make_alias ("kmvbits", GFC_STD_GNU);
}
add_sym_2s ("random_init", GFC_ISYM_RANDOM_INIT, CLASS_IMPURE,
BT_UNKNOWN, 0, GFC_STD_F2018,
gfc_check_random_init, NULL, gfc_resolve_random_init,
"repeatable", BT_LOGICAL, dl, REQUIRED, INTENT_IN,
"image_distinct", BT_LOGICAL, dl, REQUIRED, INTENT_IN);
add_sym_1s ("random_number", GFC_ISYM_RANDOM_NUMBER, CLASS_IMPURE,
BT_UNKNOWN, 0, GFC_STD_F95,
gfc_check_random_number, NULL, gfc_resolve_random_number,

2
gcc/fortran/intrinsic.h
View File

@ -205,6 +205,7 @@ bool gfc_check_getlog (gfc_expr *);
bool gfc_check_move_alloc (gfc_expr *, gfc_expr *);
bool gfc_check_mvbits (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *,
gfc_expr *);
bool gfc_check_random_init (gfc_expr *, gfc_expr *);
bool gfc_check_random_number (gfc_expr *);
bool gfc_check_random_seed (gfc_expr *, gfc_expr *, gfc_expr *);
bool gfc_check_dtime_etime_sub (gfc_expr *, gfc_expr *);
@ -653,6 +654,7 @@ void gfc_resolve_lstat_sub (gfc_code *);
void gfc_resolve_ltime (gfc_code *);
void gfc_resolve_mvbits (gfc_code *);
void gfc_resolve_perror (gfc_code *);
void gfc_resolve_random_init (gfc_code *);
void gfc_resolve_random_number (gfc_code *);
void gfc_resolve_random_seed (gfc_code *);
void gfc_resolve_rename_sub (gfc_code *);

59
gcc/fortran/intrinsic.texi
View File

@ -262,6 +262,7 @@ Some basic guidelines for editing this document:
* @code{RADIX}: RADIX, Base of a data model
* @code{RAN}: RAN, Real pseudo-random number
* @code{RAND}: RAND, Real pseudo-random number
* @code{RANDOM_INIT}: RANDOM_INIT, Initialize pseudo-random number generator
* @code{RANDOM_NUMBER}: RANDOM_NUMBER, Pseudo-random number
* @code{RANDOM_SEED}: RANDOM_SEED, Initialize a pseudo-random number sequence
* @code{RANGE}: RANGE, Decimal exponent range
@ -11598,6 +11599,60 @@ end program test_rand
@end table
@node RANDOM_INIT
@section @code{RANDOM_INIT} --- Initialize a pseudo-random number generator
@fnindex RANDOM_INIT
@cindex random number generation, initialization
@table @asis
@item @emph{Description}:
Initializes the state of the pseudorandom number generator used by
@code{RANDOM_NUMBER}.
@item @emph{Standard}:
Fortran 2018
@item @emph{Class}:
Subroutine
@item @emph{Syntax}:
@code{CALL RANDOM_INIT(REPEATABLE, IMAGE_DISTINCT)}
@item @emph{Arguments}:
@multitable @columnfractions .20 .75
@item @var{REPEATABLE} @tab Shall be a scalar with a @code{LOGICAL} type,
and it is @code{INTENT(IN)}. If it is @code{.true.}, the seed is set to
a processor-dependent value that is the same each time @code{RANDOM_INIT}
is called from the same image. The term ``same image'' means a single
instance of program execution. The sequence of random numbers is different
for repeated execution of the program. If it is @code{.false.}, the seed
is set to a processor-dependent value.
@item @var{IMAGE_DISTINCT} @tab Shall be a scalar with a
@code{LOGICAL} type, and it is @code{INTENT(IN)}. If it is @code{.true.},
the seed is set to a processor-dependent value that is distinct from th
seed set by a call to @code{RANDOM_INIT} in another image. If it is
@code{.false.}, the seed is set value that does depend which image called
@code{RANDOM_INIT}.
@end multitable
@item @emph{Example}:
@smallexample
program test_random_seed
implicit none
real x(3), y(3)
call random_init(.true., .true.)
call random_number(x)
call random_init(.true., .true.)
call random_number(y)
! x and y are the same sequence
if (any(x /= y)) call abort
end program test_random_seed
@end smallexample
@item @emph{See also}:
@ref{RANDOM_NUMBER}, @ref{RANDOM_SEED}
@end table
@node RANDOM_NUMBER
@section @code{RANDOM_NUMBER} --- Pseudo-random number
@ -11643,7 +11698,7 @@ end program
@end smallexample
@item @emph{See also}:
@ref{RANDOM_SEED}
@ref{RANDOM_SEED}, @ref{RANDOM_INIT}
@end table
@ -11713,7 +11768,7 @@ end program test_random_seed
@end smallexample
@item @emph{See also}:
@ref{RANDOM_NUMBER}
@ref{RANDOM_NUMBER}, @ref{RANDOM_INIT}
@end table

11
gcc/fortran/iresolve.c
View File

@ -3404,6 +3404,17 @@ gfc_resolve_mvbits (gfc_code *c)
}
/* Set up the call to RANDOM_INIT. */
void
gfc_resolve_random_init (gfc_code *c)
{
const char *name;
name = gfc_get_string (PREFIX ("random_init"));
c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
}
void
gfc_resolve_random_number (gfc_code *c)
{

7
gcc/fortran/trans-decl.c
View File

@ -229,6 +229,8 @@ tree gfor_fndecl_dgemm;
tree gfor_fndecl_cgemm;
tree gfor_fndecl_zgemm;
/* RANDOM_INIT function. */
tree gfor_fndecl_random_init;
static void
gfc_add_decl_to_parent_function (tree decl)
@ -3328,6 +3330,11 @@ gfc_build_intrinsic_function_decls (void)
void_type_node, 3, pchar_type_node, gfc_charlen_type_node,
gfc_int8_type_node);
gfor_fndecl_random_init = gfc_build_library_function_decl (
get_identifier (PREFIX("random_init")),
void_type_node, 3, gfc_logical4_type_node, gfc_logical4_type_node,
gfc_int4_type_node);
gfor_fndecl_sc_kind = gfc_build_library_function_decl_with_spec (
get_identifier (PREFIX("selected_char_kind")), "..R",
gfc_int4_type_node, 2, gfc_charlen_type_node, pchar_type_node);

50
gcc/fortran/trans-intrinsic.c
View File

@ -3635,6 +3635,52 @@ conv_intrinsic_free (gfc_code *code)
}
/* Call the RANDOM_INIT library subroutine with a hidden argument for
handling seeding on coarray images. */
static tree
conv_intrinsic_random_init (gfc_code *code)
{
stmtblock_t block;
gfc_se se;
tree arg1, arg2, arg3, tmp;
tree logical4_type_node = gfc_get_logical_type (4);
/* Make the function call. */
gfc_init_block (&block);
gfc_init_se (&se, NULL);
/* Convert REPEATABLE to a LOGICAL(4) entity. */
gfc_conv_expr (&se, code->ext.actual->expr);
gfc_add_block_to_block (&block, &se.pre);
arg1 = fold_convert (logical4_type_node, gfc_evaluate_now (se.expr, &block));
gfc_add_block_to_block (&block, &se.post);
/* Convert IMAGE_DISTINCT to a LOGICAL(4) entity. */
gfc_conv_expr (&se, code->ext.actual->next->expr);
gfc_add_block_to_block (&block, &se.pre);
arg2 = fold_convert (logical4_type_node, gfc_evaluate_now (se.expr, &block));
gfc_add_block_to_block (&block, &se.post);
/* Create the hidden argument. For non-coarray codes and -fcoarray=single,
simply set this to 0. For -fcoarray=lib, generate a call to
THIS_IMAGE() without arguments. */
arg3 = build_int_cst (gfc_get_int_type (4), 0);
if (flag_coarray == GFC_FCOARRAY_LIB)
{
arg3 = build_call_expr_loc (input_location, gfor_fndecl_caf_this_image,
1, arg3);
se.expr = fold_convert (gfc_get_int_type (4), arg3);
}
tmp = build_call_expr_loc (input_location, gfor_fndecl_random_init, 3,
arg1, arg2, arg3);
gfc_add_expr_to_block (&block, tmp);
return gfc_finish_block (&block);
}
/* Call the SYSTEM_CLOCK library functions, handling the type and kind
conversions. */
@ -11064,6 +11110,10 @@ gfc_conv_intrinsic_subroutine (gfc_code *code)
res = conv_intrinsic_free (code);
break;
case GFC_ISYM_RANDOM_INIT:
res = conv_intrinsic_random_init (code);
break;
case GFC_ISYM_KILL:
res = conv_intrinsic_kill_sub (code);
break;

2
gcc/fortran/trans.h
View File

@ -915,6 +915,8 @@ extern GTY(()) tree gfor_fndecl_sr_kind;
extern GTY(()) tree gfor_fndecl_ieee_procedure_entry;
extern GTY(()) tree gfor_fndecl_ieee_procedure_exit;
/* RANDOM_INIT. */
extern GTY(()) tree gfor_fndecl_random_init;
/* True if node is an integer constant. */
#define INTEGER_CST_P(node) (TREE_CODE(node) == INTEGER_CST)

10
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,13 @@
2018-06-01 Steven G. Kargl <kargl@gcc.gnu.org>
PR fortran/63570
* gfortran.dg/random_init_1.f90: New test.
* gfortran.dg/random_init_2.f90: New test.
* gfortran.dg/random_init_3.f90: New test.
* gfortran.dg/random_init_4.f90: New test.
* gfortran.dg/random_init_5.f90: New test.
* gfortran.dg/random_init_6.f90: New test.
2018-06-01 Richard Sandiford <richard.sandiford@linaro.org>
PR tree-optimization/85989

11
gcc/testsuite/gfortran.dg/random_init_1.f90 Normal file
View File

@ -0,0 +1,11 @@
! { dg-do compile }
program foo
logical a(2)
real x
call random_init(1., .false.) ! { dg-error "must be LOGICAL" }
call random_init(.true., 1) ! { dg-error "must be LOGICAL" }
call random_number(x)
a = .true.
call random_init(a, .false.) ! { dg-error "must be a scalar" }
call random_init(.false., a) ! { dg-error "must be a scalar" }
end program foo

30
gcc/testsuite/gfortran.dg/random_init_2.f90 Normal file
View File

@ -0,0 +1,30 @@
! { dg-do run }
program foo
real x(2), y(2)
call random_init(.false., .false.)
call random_number(x)
! print *, x
x = int(1e6*x)
call random_init(.false., .false.)
call random_number(y)
! print *, y
y = int(1e6*y)
if (any(x == y)) call abort
call random_init(.true., .false.)
call random_number(x)
! print *, x
x = int(1e6*x)
call random_init(.true., .false.)
call random_number(y)
! print *, y
y = int(1e6*y)
if (any(x /= y)) call abort
end program foo

74
gcc/testsuite/gfortran.dg/random_init_3.f90 Normal file
View File

@ -0,0 +1,74 @@
! { dg-do run }
! { dg-options "-fcoarray=single" }
program rantest
implicit none
logical, parameter :: debug = .false.
character(len=20) name
integer fd, i, n
integer, allocatable :: n1(:), n2(:), n3(:)
real x(4), y(4), z(4)
if (debug) then
write(name,'(A,I0)') 'dat', this_image()
open(newunit=fd, file=name)
end if
call random_seed(size=n)
allocate(n1(n), n2(n), n3(n))
!
! Setup repeatable sequences (if co-arrays the seeds should be distinct
! are different). Get the seeds.
!
call random_init(.true., .true.)
call random_seed(get=n1)
call random_number(x) ! This changes internal state.
if (debug) then
write(fd,'(A,4F12.6)') 'x = ', x
end if
call random_seed(get=n2) ! Grab current state.
!
! Use the gotten seed to reseed PRNG and grab sequence.
! It should be the same sequence.
!
call random_seed(put=n1)
call random_number(y)
if (debug) then
write(fd,'(A,4F12.6)') 'y = ', y
end if
!
! Setup repeatable sequences (if co-arrays the seeds should be distinct
! are different). Get the seeds. It should be the same sequence.
!
call random_init(.true., .true.)
call random_seed(get=n3)
call random_number(z)
if (debug) then
write(fd,'(A,4F12.6)') 'z = ', z
end if
x = int(1e6*x) ! Convert to integer with at most 6 digits.
y = int(1e6*y) ! Convert to integer with at most 6 digits.
z = int(1e6*z) ! Convert to integer with at most 6 digits.
if (any(x /= y)) call abort
if (any(x /= z)) call abort
if (debug) then
write(fd,*)
do i = 1, n
if (n1(i) - n2(i) /= 0) then
write(fd,*) 'n1 /= n2', i, n1(i), n2(i)
end if
end do
write(fd,*)
do i = 1, n
if (n1(i) - n3(i) /= 0) then
write(fd,*) 'n1 /= n3', i, n1(i), n3(i)
end if
end do
end if
end program rantest

43
gcc/testsuite/gfortran.dg/random_init_4.f90 Normal file
View File

@ -0,0 +1,43 @@
! { dg-do run }
! { dg-options "-fcoarray=single" }
program rantest
implicit none
logical, parameter :: debug = .false.
character(len=20) name
integer fd, i, n
integer, allocatable :: n1(:), n2(:), n3(:)
real x(4), y(4), z(4)
if (debug) then
write(name,'(A,I0)') 'dat', this_image()
open(newunit=fd, file=name)
end if
call random_seed(size=n)
allocate(n1(n), n2(n), n3(n))
call random_init(.true., .false.)
call random_seed(get=n1)
call random_number(x)
call random_init(.true., .false.)
call random_seed(get=n2)
call random_number(y)
call random_init(.true., .false.)
call random_seed(get=n3)
call random_number(z)
if (debug) then
write(fd,'(A,4F12.6)') 'x = ', x
write(fd,'(A,4F12.6)') 'y = ', y
write(fd,'(A,4F12.6)') 'z = ', z
write(fd,*)
do i = 1, 5
write(fd,'(I2,4I13)') i, n1(i), n2(i), n3(i)
end do
end if
end program rantest

43
gcc/testsuite/gfortran.dg/random_init_5.f90 Normal file
View File

@ -0,0 +1,43 @@
! { dg-do run }
! { dg-options "-fcoarray=single" }
program rantest
implicit none
logical, parameter :: debug = .false.
character(len=20) name
integer fd, i, n
integer, allocatable :: n1(:), n2(:), n3(:)
real x(4), y(4), z(4)
if (debug) then
write(name,'(A,I0)') 'dat', this_image()
open(newunit=fd, file=name)
end if
call random_seed(size=n)
allocate(n1(n), n2(n), n3(n))
call random_init(.false., .false.)
call random_seed(get=n1)
call random_number(x)
call random_init(.false., .false.)
call random_seed(get=n2)
call random_number(y)
call random_init(.false., .false.)
call random_seed(get=n3)
call random_number(z)
if (debug) then
write(fd,'(A,4F12.6)') 'x = ', x
write(fd,'(A,4F12.6)') 'y = ', y
write(fd,'(A,4F12.6)') 'z = ', z
write(fd,*)
do i = 1, 5
write(fd,'(I2,4I13)') i, n1(i), n2(i), n3(i)
end do
end if
end program rantest

43
gcc/testsuite/gfortran.dg/random_init_6.f90 Normal file
View File

@ -0,0 +1,43 @@
! { dg-do run }
! { dg-options "-fcoarray=single" }
program rantest
implicit none
logical, parameter :: debug = .false.
character(len=20) name
integer fd, i, n
integer, allocatable :: n1(:), n2(:), n3(:)
real x(4), y(4), z(4)
if (debug) then
write(name,'(A,I0)') 'dat', this_image()
open(newunit=fd, file=name)
end if
call random_seed(size=n)
allocate(n1(n), n2(n), n3(n))
call random_init(.false., .true.)
call random_seed(get=n1)
call random_number(x)
call random_init(.false., .true.)
call random_seed(get=n2)
call random_number(y)
call random_init(.false., .true.)
call random_seed(get=n3)
call random_number(z)
if (debug) then
write(fd,'(A,4F12.6)') 'x = ', x
write(fd,'(A,4F12.6)') 'y = ', y
write(fd,'(A,4F12.6)') 'z = ', z
write(fd,*)
do i = 1, 5
write(fd,'(I2,4I13)') i, n1(i), n2(i), n3(i)
end do
end if
end program rantest

8
libgfortran/ChangeLog
View File

@ -1,3 +1,11 @@
2018-06-01 Steven G. Kargl <kargl@gcc.gnu.org>
PR fortran/63570
* libgfortran/Makefile.am: Add random_init.f90 to build.
* libgfortran/Makefile.in: Regenerated.
* libgfortran/gfortran.map: Expose symbol for _gfortran_random_init.
* libgfortran/intrinsics/random_init.f90: Implementation.
2018-05-28 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR libgfortran/85840

3
libgfortran/Makefile.am
View File

@ -915,7 +915,8 @@ $(gfor_built_specific_src) \
$(gfor_built_specific2_src) \
$(gfor_misc_specifics) \
intrinsics/dprod_r8.f90 \
intrinsics/f2c_specifics.F90
intrinsics/f2c_specifics.F90 \
intrinsics/random_init.f90
# Turn on vectorization and loop unrolling for matmul.
$(patsubst %.c,%.lo,$(notdir $(i_matmul_c))): AM_CFLAGS += -ffast-math -ftree-vectorize -funroll-loops --param max-unroll-times=4

8
libgfortran/Makefile.in
View File

@ -408,7 +408,7 @@ am__objects_56 = _sign_i4.lo _sign_i8.lo _sign_i16.lo _sign_r4.lo \
_mod_r10.lo _mod_r16.lo
am__objects_57 = misc_specifics.lo
am__objects_58 = $(am__objects_55) $(am__objects_56) $(am__objects_57) \
dprod_r8.lo f2c_specifics.lo
dprod_r8.lo f2c_specifics.lo random_init.lo
am__objects_59 = $(am__objects_3) $(am__objects_47) $(am__objects_49) \
$(am__objects_52) $(am__objects_53) $(am__objects_54) \
$(am__objects_58)
@ -1374,7 +1374,8 @@ $(gfor_built_specific_src) \
$(gfor_built_specific2_src) \
$(gfor_misc_specifics) \
intrinsics/dprod_r8.f90 \
intrinsics/f2c_specifics.F90
intrinsics/f2c_specifics.F90 \
intrinsics/random_init.f90
BUILT_SOURCES = $(gfor_built_src) $(gfor_built_specific_src) \
$(gfor_built_specific2_src) $(gfor_misc_specifics) \
@ -6230,6 +6231,9 @@ selected_real_kind.lo: intrinsics/selected_real_kind.f90
dprod_r8.lo: intrinsics/dprod_r8.f90
$(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o dprod_r8.lo `test -f 'intrinsics/dprod_r8.f90' || echo '$(srcdir)/'`intrinsics/dprod_r8.f90
random_init.lo: intrinsics/random_init.f90
$(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o random_init.lo `test -f 'intrinsics/random_init.f90' || echo '$(srcdir)/'`intrinsics/random_init.f90
mostlyclean-libtool:
-rm -f *.lo

1
libgfortran/gfortran.map
View File

@ -799,6 +799,7 @@ GFORTRAN_8 {
_gfortran_product_r4;
_gfortran_product_r8;
_gfortran_rand;
_gfortran_random_init;
_gfortran_random_r10;
_gfortran_random_r16;
_gfortran_random_r4;

94
libgfortran/intrinsics/random_init.f90 Normal file
View File

@ -0,0 +1,94 @@
! Copyright (C) 2018 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.)
!
! 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.
!
! call random_init(.false., .false.)
! call random_init(.false., .true.)
!
! 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.
!
! 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)
implicit none
logical, value, intent(in) :: repeatable
logical, value, intent(in) :: image_distinct
integer, value, intent(in) :: hidden
logical, save :: once = .true.
integer :: nseed
integer, save, allocatable :: seed(:)
if (once) then
once = .false.
call random_seed(size=nseed)
allocate(seed(nseed))
call random_seed(get=seed)
!
! To guarantee that seed is distinct on multiple images, add the hidden
! argument (which is the image index).
!
if (image_distinct) seed = seed + hidden
end if
if (repeatable) then
call random_seed(put=seed);
else
call random_seed();
end if
end subroutine _gfortran_random_init