libgfortran/intrinsics/random_init.f90

   1 ! Copyright (C) 2018 Free Software Foundation, Inc.
   2 ! Contributed by Steven G. Kargl <kargl@gcc.gnu.org>
   3 !
   4 ! This file is part of the GNU Fortran runtime library (libgfortran).
   5 !
   6 ! Libgfortran is free software; you can redistribute it and/or
   7 ! modify it under the terms of the GNU General Public
   8 ! License as published by the Free Software Foundation; either
   9 ! version 3 of the License, or (at your option) any later version.
  10 !
  11 ! Libgfortran is distributed in the hope that it will be useful,
  12 ! but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 ! GNU General Public License for more details.
  15 !
  16 ! Under Section 7 of GPL version 3, you are granted additional
  17 ! permissions described in the GCC Runtime Library Exception, version
  18 ! 3.1, as published by the Free Software Foundation.
  19 !
  20 ! You should have received a copy of the GNU General Public License and
  21 ! a copy of the GCC Runtime Library Exception along with this program;
  22 ! see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
  23 ! <http://www.gnu.org/licenses/>.
  24 !
  25 !
  26 ! WARNING:  This file should never be compiled with an option that changes
  27 ! default logical kind from 4 to some other value or changes default integer
  28 ! kind from from 4 to some other value.
  29 !
  30 !
  31 ! There are four combinations of repeatable and image_distinct.  If a program
  32 ! is compiled without the -fcoarray= option or with -fcoarray=single, then
  33 ! execution of the compiled executable does not use image_distinct as it is
  34 ! irrelevant (although required).  The behavior is as follows:
  35 !
  36 ! call random_init(.true., .true.)
  37 !
  38 ! The sequence of random numbers is repeatable within an instance of program
  39 ! execution.  That is, calls to random_init(.true., .true.) during the
  40 ! execution will reset the sequence of RN to the same sequence.  If the
  41 ! program is compiled with -fcoarray=lib and multiple images are instantiated,
  42 ! then each image accesses a repeatable distinct sequence of random numbers.
  43 ! There are no guarantees that multiple execution of the program will access
  44 ! the same sequence.
  45 !
  46 ! call random_init(.false., .false.)
  47 ! call random_init(.false., .true.)
  48 !
  49 ! The sequence of random numbers is determined from process-dependent seeds.
  50 ! On each execution of the executable, different seeds will be used.  For
  51 ! -fcoarray=lib and multiple instantiated images, each image will use
  52 ! process-dependent seeds.  In other words, the two calls have identical
  53 ! behavior.
  54 !
  55 ! call random_init(.true., .false.)
  56 !
  57 ! For a program compiled without the -fcoarray= option or with
  58 ! -fcoarray=single, a single image is instantiated when the executable is
  59 ! run.  If the executable causes multiple images to be instantiated, then
  60 ! image_distinct=.false. in one image cannot affect the sequence of random
  61 ! numbers in another image.  As gfortran gives each image its own independent
  62 ! PRNG, this condition is automatically satisfied.
  63 !
  64 impure subroutine _gfortran_random_init(repeatable, image_distinct, hidden)
  65
  66    implicit none
  67
  68    logical, value, intent(in) :: repeatable
  69    logical, value, intent(in) :: image_distinct
  70    integer, value, intent(in) :: hidden
  71
  72    logical, save :: once = .true.
  73    integer :: nseed
  74    integer, save, allocatable :: seed(:)
  75
  76    if (once) then
  77       once = .false.
  78       call random_seed(size=nseed)
  79       allocate(seed(nseed))
  80       call random_seed(get=seed)
  81       !
  82       ! To guarantee that seed is distinct on multiple images, add the hidden
  83       ! argument (which is the image index).
  84       !
  85       if (image_distinct) seed = seed + hidden
  86    end if
  87
  88    if (repeatable) then
  89       call random_seed(put=seed);
  90    else
  91       call random_seed();
  92    end if
  93
  94 end subroutine _gfortran_random_init