From ddd3e26e42b8d55989f9964c6ec6ee50b30b1802 Mon Sep 17 00:00:00 2001 From: "Steven G. Kargl" Date: Fri, 1 Jun 2018 17:05:02 +0000 Subject: re PR fortran/63570 ([F2018] Implement 13.7.137 RANDOM INIT (REPEATABLE, IMAGE DISTINCT)) 2018-06-01 Steven G. Kargl 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 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 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 --- gcc/fortran/ChangeLog | 19 ++++++++ gcc/fortran/check.c | 21 ++++++++ gcc/fortran/gfortran.h | 1 + gcc/fortran/intrinsic.c | 6 +++ gcc/fortran/intrinsic.h | 2 + gcc/fortran/intrinsic.texi | 59 ++++++++++++++++++++++- gcc/fortran/iresolve.c | 11 +++++ gcc/fortran/trans-decl.c | 7 +++ gcc/fortran/trans-intrinsic.c | 50 +++++++++++++++++++ gcc/fortran/trans.h | 2 + gcc/testsuite/ChangeLog | 10 ++++ gcc/testsuite/gfortran.dg/random_init_1.f90 | 11 +++++ gcc/testsuite/gfortran.dg/random_init_2.f90 | 30 ++++++++++++ gcc/testsuite/gfortran.dg/random_init_3.f90 | 74 +++++++++++++++++++++++++++++ gcc/testsuite/gfortran.dg/random_init_4.f90 | 43 +++++++++++++++++ gcc/testsuite/gfortran.dg/random_init_5.f90 | 43 +++++++++++++++++ gcc/testsuite/gfortran.dg/random_init_6.f90 | 43 +++++++++++++++++ 17 files changed, 430 insertions(+), 2 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/random_init_1.f90 create mode 100644 gcc/testsuite/gfortran.dg/random_init_2.f90 create mode 100644 gcc/testsuite/gfortran.dg/random_init_3.f90 create mode 100644 gcc/testsuite/gfortran.dg/random_init_4.f90 create mode 100644 gcc/testsuite/gfortran.dg/random_init_5.f90 create mode 100644 gcc/testsuite/gfortran.dg/random_init_6.f90 (limited to 'gcc') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 95914ae..272a94e 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,22 @@ +2018-06-01 Steven G. Kargl + + 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 * decl.c (match_data_constant): Fortran 2018 allows pointer diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c index 8d41fcd..30214fe 100644 --- a/gcc/fortran/check.c +++ b/gcc/fortran/check.c @@ -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) { diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 4c4e7af..b7eaa0e 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -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, diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c index 8dd135f..6096686 100644 --- a/gcc/fortran/intrinsic.c +++ b/gcc/fortran/intrinsic.c @@ -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, diff --git a/gcc/fortran/intrinsic.h b/gcc/fortran/intrinsic.h index a483bfa..7a957d3 100644 --- a/gcc/fortran/intrinsic.h +++ b/gcc/fortran/intrinsic.h @@ -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 *); diff --git a/gcc/fortran/intrinsic.texi b/gcc/fortran/intrinsic.texi index adea02a..ca006c9 100644 --- a/gcc/fortran/intrinsic.texi +++ b/gcc/fortran/intrinsic.texi @@ -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 diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c index f15b8f2..2eb8f7c 100644 --- a/gcc/fortran/iresolve.c +++ b/gcc/fortran/iresolve.c @@ -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) { diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 6c4a221..cd23c2d 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -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); diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index fa01971..d306e3a 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -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; diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h index c6b3625..049fcd6 100644 --- a/gcc/fortran/trans.h +++ b/gcc/fortran/trans.h @@ -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) diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 050e754..0ccd0ab 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,13 @@ +2018-06-01 Steven G. Kargl + + 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 PR tree-optimization/85989 diff --git a/gcc/testsuite/gfortran.dg/random_init_1.f90 b/gcc/testsuite/gfortran.dg/random_init_1.f90 new file mode 100644 index 0000000..1de2f6e --- /dev/null +++ b/gcc/testsuite/gfortran.dg/random_init_1.f90 @@ -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 diff --git a/gcc/testsuite/gfortran.dg/random_init_2.f90 b/gcc/testsuite/gfortran.dg/random_init_2.f90 new file mode 100644 index 0000000..dc70360 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/random_init_2.f90 @@ -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 diff --git a/gcc/testsuite/gfortran.dg/random_init_3.f90 b/gcc/testsuite/gfortran.dg/random_init_3.f90 new file mode 100644 index 0000000..2802dad --- /dev/null +++ b/gcc/testsuite/gfortran.dg/random_init_3.f90 @@ -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 diff --git a/gcc/testsuite/gfortran.dg/random_init_4.f90 b/gcc/testsuite/gfortran.dg/random_init_4.f90 new file mode 100644 index 0000000..b3a35f9 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/random_init_4.f90 @@ -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 diff --git a/gcc/testsuite/gfortran.dg/random_init_5.f90 b/gcc/testsuite/gfortran.dg/random_init_5.f90 new file mode 100644 index 0000000..e9a200b1 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/random_init_5.f90 @@ -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 diff --git a/gcc/testsuite/gfortran.dg/random_init_6.f90 b/gcc/testsuite/gfortran.dg/random_init_6.f90 new file mode 100644 index 0000000..e8d91d8 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/random_init_6.f90 @@ -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 -- cgit v1.1