1! Copyright (C) 2018-2022 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! 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 27! kind from 4 to some other value. 28! 29! There are four combinations of repeatable and image_distinct. The 30! language below is from the F2018 standard (actually, J3/18-007r1). 31! 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). 36! 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. 42! 43impure subroutine _gfortran_random_init(repeatable, image_distinct, image_num) 44 45 implicit none 46 47 logical, value, intent(in) :: repeatable 48 logical, value, intent(in) :: image_distinct 49 integer, value, intent(in) :: image_num 50 51 logical, save :: once = .true. 52 integer :: nseed, lcg_seed 53 integer, save, allocatable :: seed(:) 54 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() 66 ! 67 ! This cannot happen; but, prevent gfortran complaining about 68 ! unused variables. 69 ! 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 78 end if 79 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 99 100end subroutine _gfortran_random_init 101