]>
Commit | Line | Data |
---|---|---|
83ffe9cd | 1 | ! Copyright (C) 2018-2023 Free Software Foundation, Inc. |
ddd3e26e | 2 | ! Contributed by Steven G. Kargl <kargl@gcc.gnu.org> |
26ca6dbd | 3 | ! |
ddd3e26e | 4 | ! This file is part of the GNU Fortran runtime library (libgfortran). |
26ca6dbd | 5 | ! |
ddd3e26e SK |
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. | |
26ca6dbd | 10 | ! |
ddd3e26e SK |
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. | |
26ca6dbd | 15 | ! |
ddd3e26e SK |
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. | |
26ca6dbd | 19 | ! |
ddd3e26e SK |
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 | ! | |
ddd3e26e SK |
25 | ! WARNING: This file should never be compiled with an option that changes |
26 | ! default logical kind from 4 to some other value or changes default integer | |
26ca6dbd | 27 | ! kind from 4 to some other value. |
ddd3e26e | 28 | ! |
26ca6dbd AV |
29 | ! There are four combinations of repeatable and image_distinct. The |
30 | ! language below is from the F2018 standard (actually, J3/18-007r1). | |
ddd3e26e | 31 | ! |
26ca6dbd AV |
32 | ! This routine is only used for non-coarray programs or with programs |
33 | ! compiled with -fcoarray=single. Use of -fcoarray=lib or -fcoarray=shared | |
34 | ! requires different routines due to the need for communication between | |
35 | ! images under case(iv). | |
ddd3e26e | 36 | ! |
26ca6dbd AV |
37 | ! Technically, neither image_distinct nor image_num are now needed. The |
38 | ! interface to _gfortran_random_init() is maintained for libgfortran ABI. | |
39 | ! Note, the Fortran standard requires the image_distinct argument, so | |
40 | ! it will always have a valid value, and the frontend generates an value | |
41 | ! of 0 for image_num. | |
ddd3e26e | 42 | ! |
26ca6dbd | 43 | impure subroutine _gfortran_random_init(repeatable, image_distinct, image_num) |
ddd3e26e SK |
44 | |
45 | implicit none | |
46 | ||
47 | logical, value, intent(in) :: repeatable | |
48 | logical, value, intent(in) :: image_distinct | |
26ca6dbd | 49 | integer, value, intent(in) :: image_num |
ddd3e26e SK |
50 | |
51 | logical, save :: once = .true. | |
26ca6dbd | 52 | integer :: nseed, lcg_seed |
ddd3e26e SK |
53 | integer, save, allocatable :: seed(:) |
54 | ||
26ca6dbd AV |
55 | if (repeatable) then |
56 | if (once) then | |
57 | once = .false. | |
58 | call random_seed(size=nseed) | |
59 | allocate(seed(nseed)) | |
60 | lcg_seed = 57911963 | |
61 | call _gfortran_lcg(seed) | |
62 | end if | |
63 | call random_seed(put=seed) | |
64 | else | |
65 | call random_seed() | |
ddd3e26e | 66 | ! |
26ca6dbd AV |
67 | ! This cannot happen; but, prevent gfortran complaining about |
68 | ! unused variables. | |
ddd3e26e | 69 | ! |
26ca6dbd AV |
70 | if (image_num > 2) then |
71 | block | |
72 | use iso_fortran_env, only : error_unit | |
73 | write(error_unit, '(A)') 'whoops: random_init(.false., .false.)' | |
74 | if (image_distinct) error stop image_num + 1 | |
75 | error stop image_num | |
76 | end block | |
77 | end if | |
ddd3e26e SK |
78 | end if |
79 | ||
26ca6dbd AV |
80 | contains |
81 | ! | |
82 | ! SK Park and KW Miller, ``Random number generators: good ones are hard | |
83 | ! to find,'' Comm. ACM, 31(10), 1192--1201, (1988). | |
84 | ! | |
85 | ! Implementation of a prime modulus multiplicative linear congruential | |
86 | ! generator, which avoids overflow and provides the full period. | |
87 | ! | |
88 | impure elemental subroutine _gfortran_lcg(i) | |
89 | implicit none | |
90 | integer, intent(out) :: i | |
91 | integer, parameter :: a = 16807 ! Multiplier | |
92 | integer, parameter :: m = huge(a) ! Modulus | |
93 | integer, parameter :: q = 127773 ! Quotient to avoid overflow | |
94 | integer, parameter :: r = 2836 ! Remainder to avoid overflow | |
95 | lcg_seed = a * mod(lcg_seed, q) - r * (lcg_seed / q) | |
96 | if (lcg_seed <= 0) lcg_seed = lcg_seed + m | |
97 | i = lcg_seed | |
98 | end subroutine _gfortran_lcg | |
ddd3e26e SK |
99 | |
100 | end subroutine _gfortran_random_init |