Line data Source code
1 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3 : !!!!
4 : !!!! MIT License
5 : !!!!
6 : !!!! ParaMonte: plain powerful parallel Monte Carlo library.
7 : !!!!
8 : !!!! Copyright (C) 2012-present, The Computational Data Science Lab
9 : !!!!
10 : !!!! This file is part of the ParaMonte library.
11 : !!!!
12 : !!!! Permission is hereby granted, free of charge, to any person obtaining a
13 : !!!! copy of this software and associated documentation files (the "Software"),
14 : !!!! to deal in the Software without restriction, including without limitation
15 : !!!! the rights to use, copy, modify, merge, publish, distribute, sublicense,
16 : !!!! and/or sell copies of the Software, and to permit persons to whom the
17 : !!!! Software is furnished to do so, subject to the following conditions:
18 : !!!!
19 : !!!! The above copyright notice and this permission notice shall be
20 : !!!! included in all copies or substantial portions of the Software.
21 : !!!!
22 : !!!! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
23 : !!!! EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
24 : !!!! MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
25 : !!!! IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM,
26 : !!!! DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR
27 : !!!! OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE
28 : !!!! OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
29 : !!!!
30 : !!!! ACKNOWLEDGMENT
31 : !!!!
32 : !!!! ParaMonte is an honor-ware and its currency is acknowledgment and citations.
33 : !!!! As per the ParaMonte library license agreement terms, if you use any parts of
34 : !!!! this library for any purposes, kindly acknowledge the use of ParaMonte in your
35 : !!!! work (education/research/industry/development/...) by citing the ParaMonte
36 : !!!! library as described on this page:
37 : !!!!
38 : !!!! https://github.com/cdslaborg/paramonte/blob/main/ACKNOWLEDGMENT.md
39 : !!!!
40 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
41 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
42 :
43 : !> \brief This module contains the class and procedures for setting or resetting the random seed of the processor(s).
44 : !> \author Amir Shahmoradi
45 :
46 : module RandomSeed_mod
47 :
48 : use Constants_mod, only: IK, RK
49 : use Err_mod, only: Err_type
50 : implicit none
51 :
52 : character(*), parameter :: MODULE_NAME = "@RandomSeed_mod"
53 :
54 : public
55 : private :: setRandomSeed, getRandomSeed
56 :
57 : !> The `RandomSeed_type` class.
58 : type :: RandomSeed_type
59 : integer(IK) :: size = -huge(1_IK) !< The size of the random seed vector.
60 : integer(IK) :: imageID = -huge(1_IK) !< The ID of the current image/processor.
61 : integer(IK), allocatable :: Value(:) !< The random seed vector.
62 : logical :: isRepeatable = .false. !< The logical flag indicating whether the random number sequence must be repeatable upon each restart.
63 : logical :: isImageDistinct = .true. !< The logical flag indicating whether the random seed must be distinct on each processor from others.
64 : type(Err_type) :: Err !< An object of class [Err_type](@ref err_mod::err_type) containing the error handling tools.
65 : character(:), allocatable :: info
66 : contains
67 : procedure, public :: set => setRandomSeed
68 : procedure, public :: get => getRandomSeed
69 : end type RandomSeed_type
70 :
71 : interface RandomSeed_type
72 : module procedure :: constructRandomSeed
73 : end interface RandomSeed_type
74 :
75 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
76 :
77 : contains
78 :
79 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
80 :
81 : !> This is the constructor of the [RandomSeed_type](@ref randomseed_type) class.
82 : !> Initialize the seed of the random number generator and return an object of class [RandomSeed_type](@ref randomseed_type)
83 : !> containing the information and methods for setting and resetting the random seed.
84 : !>
85 : !> @param[in] imageID : The ID of the current process.
86 : !> @param[in] inputSeed : The optional scalar integer based upon which the seed of the random number generator will be set (**optional**).
87 : !> @param[in] isRepeatable : The logical flag indicating whether the random number sequence must be repeatable upon each restart (**optional**).
88 : !> @param[in] isImageDistinct : The logical flag indicating whether the random seed must be distinct on each processor from others (**optional**).
89 : !>
90 : !> \return
91 : !> `RandomSeed` : An object of class [RandomSeed_type](@ref randomseed_type) containing the information and methods for
92 : !> setting and resetting the random seed.
93 1221 : function constructRandomSeed(imageID, inputSeed, isRepeatable, isImageDistinct) result(RandomSeed)
94 : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
95 : !DEC$ ATTRIBUTES DLLEXPORT :: constructRandomSeed
96 : #endif
97 : implicit none
98 : integer(IK) , intent(in) :: imageID
99 : integer(IK) , intent(in), optional :: inputSeed
100 : logical , intent(in), optional :: isRepeatable, isImageDistinct
101 : type(RandomSeed_type) :: RandomSeed
102 :
103 : character(*), parameter :: PROCEDURE_NAME = MODULE_NAME // "@constructRandomSeed()"
104 :
105 1221 : RandomSeed%Err%occurred = .false.
106 1221 : RandomSeed%Err%msg = ""
107 : !RandomSeed%info = ""
108 :
109 1221 : RandomSeed%imageID = imageID
110 1221 : if (RandomSeed%imageID<1_IK) then
111 : ! LCOV_EXCL_START
112 : RandomSeed%Err%occurred = .true.
113 : RandomSeed%Err%msg = PROCEDURE_NAME // ": Internal error occurred. imageID cannot be less than 1."
114 : return
115 : end if
116 : ! LCOV_EXCL_STOP
117 :
118 1221 : RandomSeed%isRepeatable = .false.
119 1221 : if (present(isRepeatable)) RandomSeed%isRepeatable = isRepeatable
120 :
121 1221 : RandomSeed%isImageDistinct = .true.
122 1221 : if (present(isImageDistinct)) RandomSeed%isImageDistinct = isImageDistinct
123 :
124 1221 : call RandomSeed%set(inputSeed)
125 1221 : if (RandomSeed%Err%occurred) then
126 : ! LCOV_EXCL_START
127 : RandomSeed%Err%msg = PROCEDURE_NAME // RandomSeed%Err%msg
128 : return
129 : end if
130 : ! LCOV_EXCL_STOP
131 :
132 1221 : call RandomSeed%get()
133 :
134 1221 : end function constructRandomSeed
135 :
136 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
137 :
138 : !> This procedure is a method of the [RandomSeed_type](@ref randomseed_type) class.
139 : !> Get the size and value of the current random seed.
140 : !>
141 : !> @param[inout] RandomSeed : An object of class [RandomSeed_type](@ref randomseed_type).
142 2418 : subroutine getRandomSeed(RandomSeed)
143 : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
144 : !DEC$ ATTRIBUTES DLLEXPORT :: getRandomSeed
145 : #endif
146 : implicit none
147 : class(RandomSeed_type), intent(inout) :: RandomSeed
148 2418 : RandomSeed%Err%occurred = .false.
149 2418 : RandomSeed%Err%msg = ""
150 : !if (allocated(RandomSeed%Value)) deallocate(RandomSeed%Value)
151 2418 : if (.not. allocated(RandomSeed%Value)) then
152 0 : call random_seed(size = RandomSeed%size)
153 0 : allocate(RandomSeed%Value(RandomSeed%size))
154 : end if
155 2418 : call random_seed(get = RandomSeed%Value)
156 1221 : end subroutine getRandomSeed
157 :
158 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
159 :
160 : !> This procedure is a method of the [RandomSeed_type](@ref randomseed_type) class.
161 : !> Get the size and value of the current random seed.
162 : !>
163 : !> @param[inout] RandomSeed : An object of class [RandomSeed_type](@ref randomseed_type).
164 : !> @param[in] inputSeed : The optional scalar integer based upon which the seed of the random number generator will be set (**optional**).
165 : !>
166 : !> \warning
167 : !> Upon return from this procedure, the value of `RandomSeed%Err%occurred` must be checked for the occurrence of any potential errors.
168 1221 : subroutine setRandomSeed(RandomSeed,inputSeed)
169 : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
170 : !DEC$ ATTRIBUTES DLLEXPORT :: setRandomSeed
171 : #endif
172 2418 : use Constants_mod, only: IK, RK, HUGE_IK
173 : use iso_fortran_env, only: int64
174 : implicit none
175 : class(RandomSeed_type), intent(inout) :: RandomSeed
176 : integer(IK), intent(in), optional :: inputSeed
177 : integer(IK) :: offsetImageRandomSeed, i, scalarSeed
178 : integer(IK) :: values(8)
179 :
180 : character(*), parameter :: PROCEDURE_NAME = MODULE_NAME // "@setRandomSeed()"
181 :
182 1221 : RandomSeed%Err%occurred = .false.
183 1221 : RandomSeed%Err%msg = ""
184 :
185 1221 : call random_seed(size = RandomSeed%size)
186 1221 : if ( allocated(RandomSeed%Value) ) deallocate(RandomSeed%Value)
187 1221 : allocate( RandomSeed%Value(RandomSeed%size) )
188 :
189 1221 : if (present(inputSeed)) then
190 180 : scalarSeed = abs(inputSeed)
191 1041 : elseif (RandomSeed%isRepeatable) then
192 12 : scalarSeed = 12357913_IK ! set the seed to something fixed so that all random number sequences can be regenerated
193 : else ! simulation is not repeatable, initialize the seed to something random, different on each images
194 1029 : call date_and_time(values=values)
195 9261 : scalarSeed = abs(sum(values))
196 : do
197 1029 : if (scalarSeed<=huge(scalarSeed) ) exit
198 : scalarSeed = scalarSeed - huge(scalarSeed)
199 : end do
200 1029 : if (scalarSeed==0_IK) then
201 : ! LCOV_EXCL_START
202 : RandomSeed%Err%occurred = .true.
203 : RandomSeed%Err%msg = PROCEDURE_NAME // ": Random seed cannot be zero."
204 : return
205 : end if
206 : ! LCOV_EXCL_STOP
207 : end if
208 :
209 : ! now use scalarSeed to construct the random seed on all images
210 :
211 1221 : if (RandomSeed%isImageDistinct) then
212 1209 : offsetImageRandomSeed = 127_IK * RandomSeed%size * (RandomSeed%imageID-1)
213 : else
214 12 : offsetImageRandomSeed = 0
215 : end if
216 10989 : do i = 1, RandomSeed%size
217 9768 : RandomSeed%Value(i) = HUGE_IK - scalarSeed - offsetImageRandomSeed - 127_IK * (i-1)
218 10989 : if (RandomSeed%Value(i)<0_IK) then
219 0 : RandomSeed%Value(i) = -RandomSeed%Value(i)
220 : else
221 9768 : RandomSeed%Value(i) = HUGE_IK - RandomSeed%Value(i)
222 : end if
223 : end do
224 1221 : call random_seed(put=RandomSeed%Value)
225 :
226 : !block
227 : !write(*,"(*(g0,:,' '))")
228 : !write(*,"(*(g0,:,' '))") "RandomSeed%Value", RandomSeed%Value
229 : !write(*,"(*(g0,:,' '))")
230 : !end block
231 :
232 :
233 : ! ATTN: xxx Intel compilers - for some unknown reason, the first generated random number seems to be garbage
234 : ! so here, the random number generator is iterated a couple of times before further usage.
235 : ! This needs to be taken care of, in the future. This problem showed itself when StartPoint in ParaDRAM sampler were to be set randomly.
236 : ! This is where the first instance of random number usage occurs in ParaDRAM sampler.
237 : ! write(*,*) "RandomSeedObj%imageID, co_RandomSeed(1)%Value(:): ", RandomSeedObj%imageID, co_RandomSeed(1)%Value(:)
238 :
239 : ! ATTN: A follow-up on the above issue with the Intel compiler which seems to be a compiler bug: In a truly bizarre behavior,
240 : ! the Intel compiler random numbers as generated by call random_number() in the Statistics_mod module, for example when called from
241 : ! ParaDRAMProposal_mod.inc.f90, are not repeatable even after reseting the random_seed. Even more bizarre is the observation that the
242 : ! repeatability of the random numbers depends on the loop length (for example as implemented in the debugging of getRandGaus().
243 : ! The same behavior is also observed below, where any loop length less than ~30 yields non-repeatable random number sequences.
244 : ! This needs an in-depth investigation. Update: Such behavior was also observed with the GNU compiler.
245 : ! 101 is the number that fixes this issue for both compilers.
246 :
247 :
248 : block
249 : real(RK) :: unifrnd(101)
250 1221 : call random_number(unifrnd)
251 : !block
252 : !integer(IK), allocatable :: RandomSeedValue(:)
253 : !allocate(RandomSeedValue(RandomSeed%size))
254 : !call random_seed(get=RandomSeedValue)
255 : !write(*,"(*(g0,:,' '))") "unifrnd", unifrnd, RandomSeedValue
256 : !end block
257 : !if (this_image()==1) then
258 : ! write(*,*) "RandomSeedObj%imageID, unifrnd: ", unifrnd
259 : ! sync images(*)
260 : !else
261 : ! sync images(1)
262 : ! write(*,*) "RandomSeedObj%imageID, unifrnd: ", unifrnd
263 : !end if
264 : !if (this_image()==1) read(*,*)
265 : !sync all
266 : end block
267 :
268 : !else
269 : !call random_init( repeatable = RandomSeed%isRepeatable &
270 : ! , image_distinct = RandomSeed%isImageDistinct &
271 : ! , info = RandomSeed%info &
272 : ! , Err = RandomSeed%Err &
273 : ! , ProcessID = RandomSeed%ProcessID &
274 : ! )
275 : !end if
276 :
277 2442 : end subroutine setRandomSeed
278 :
279 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
280 :
281 : ! ! This subroutine is not used anymore
282 : ! ! This subroutine must be called by all images of a team
283 : ! subroutine random_init(repeatable, image_distinct, info, Err, ProcessID)
284 : !
285 : ! use iso_fortran_env, only: int64
286 : !#if defined INTEL_COMPILER_ENABLED
287 : ! use ifport
288 : !#endif
289 : ! use Err_mod, only: Err_type
290 : ! use Constants_mod, only: IK
291 : !
292 : ! implicit none
293 : !
294 : ! logical, intent(in), optional :: repeatable, image_distinct
295 : ! character(:), allocatable, intent(out), optional :: info
296 : ! type(Err_type), intent(out), optional :: Err
297 : ! integer(IK) , intent(out), optional :: ProcessID
298 : !
299 : ! character(*), parameter :: PROCEDURE_NAME = "@random_init()"
300 : !
301 : ! logical :: isRepeatable, isImageDistinct, errIsPresent
302 : ! integer(IK), allocatable :: SeedValue(:)
303 : ! integer(IK) :: i, seedSize, DateTimeValues(8) ! , iostat, fileUnit
304 : ! integer(IK) :: pid = -huge(0)
305 : !#if defined CAF_ENABLED
306 : ! integer(IK) , save :: co_pid[*]
307 : ! integer(int64), save :: co_time[*] = -huge(0)
308 : !#else
309 : ! integer(IK) , save :: co_pid
310 : ! integer(int64), save :: co_time = -huge(0)
311 : !#endif
312 : ! integer(int64) :: lcgInput
313 : !
314 : ! errIsPresent = present(Err)
315 : ! if (errIsPresent) then
316 : ! Err%occurred = .false.
317 : ! Err%msg = ""
318 : ! end if
319 : !
320 : ! isRepeatable = .true.
321 : ! if (present(repeatable)) isRepeatable = repeatable
322 : !
323 : ! isImageDistinct = .false.
324 : ! if (present(image_distinct)) isImageDistinct = image_distinct
325 : !
326 : ! call random_seed(size = seedSize)
327 : ! allocate(SeedValue(seedSize))
328 : !
329 : ! if (isRepeatable) then
330 : ! if (pid==-huge(0)) pid = getpid()
331 : ! else
332 : ! pid = getpid()
333 : ! end if
334 : !
335 : ! if (present(ProcessID)) ProcessID = pid
336 : !
337 : ! ! First try if the OS provides a random number generator
338 : ! !open( newunit = fileUnit &
339 : ! ! , file = "/dev/urandom" &
340 : ! ! , access = "stream" &
341 : ! ! , form = "unformatted" &
342 : ! ! , action = "read" &
343 : ! ! , status = "old" &
344 : ! ! , iostat = iostat &
345 : ! ! )
346 : ! !
347 : ! !if (iostat == 0) then
348 : ! !
349 : ! ! if (present(info)) info = "OS provides random number generator."
350 : ! !
351 : ! ! if (errIsPresent) then
352 : ! ! read(fileUnit,iostat=Err%stat) SeedValue
353 : ! ! if (Err%stat/=0) then
354 : ! ! Err%occurred = .true.
355 : ! ! Err%msg = PROCEDURE_NAME // "Error occurred while reading array SeedValue from file='/dev/urandom'."
356 : ! ! return
357 : ! ! end if
358 : ! ! close(fileUnit,iostat=Err%stat)
359 : ! ! if (Err%stat/=0) then
360 : ! ! Err%occurred = .true.
361 : ! ! Err%msg = PROCEDURE_NAME // "Error occurred while attempting to close file='/dev/urandom'."
362 : ! ! return
363 : ! ! end if
364 : ! ! else
365 : ! ! read(fileUnit) SeedValue
366 : ! ! close(fileUnit)
367 : ! ! end if
368 : ! !
369 : ! !else
370 : !
371 : ! if (present(info)) info = "Ignoring the OS random number generator."
372 : !
373 : ! ! Fallback to XOR:ing the current time and co_pid. The co_pid is
374 : ! ! useful in case one launches multiple instances of the same program in parallel.
375 : ! if ( isImageDistinct ) then
376 : ! if (isRepeatable) then
377 : ! if (co_time==-huge(0)) call getTime()
378 : ! else
379 : ! call getTime()
380 : ! end if
381 : ! else
382 : !#if defined CAF_ENABLED
383 : ! if (this_image()==1) then
384 : !#endif
385 : ! if (isRepeatable) then
386 : ! if (co_time==-huge(0)) call getTime()
387 : ! else
388 : ! call getTime()
389 : ! end if
390 : !#if defined CAF_ENABLED
391 : ! sync images(*)
392 : ! else
393 : ! sync images(1)
394 : ! co_time = co_time[1]
395 : ! end if
396 : !#endif
397 : ! end if
398 : !
399 : ! if ( isImageDistinct ) then
400 : ! co_pid = pid
401 : ! else
402 : !#if defined CAF_ENABLED
403 : ! if (this_image()==1) then
404 : ! co_pid = pid
405 : ! sync images(*)
406 : ! else
407 : ! sync images(1)
408 : ! co_pid = co_pid[1]
409 : ! end if
410 : !#else
411 : ! co_pid = pid
412 : !#endif
413 : ! end if
414 : !
415 : ! lcgInput = ieor(co_time, int(co_pid, kind(co_time)))
416 : ! do i = 1, seedSize
417 : ! SeedValue(i) = lcg(lcgInput)
418 : ! end do
419 : !
420 : ! !end if
421 : !
422 : ! call random_seed(put=SeedValue)
423 : !
424 : ! contains
425 : !
426 : ! ! This simple PRNG might not be good enough for real work, but is
427 : ! ! sufficient for seeding a better PRNG.
428 : ! function lcg(s)
429 : ! integer :: lcg
430 : ! integer(int64) :: s
431 : ! if (s == 0) then
432 : ! s = 104729
433 : ! else
434 : ! s = mod(s, 4294967296_int64)
435 : ! end if
436 : ! s = mod(s * 279470273_int64, 4294967291_int64)
437 : ! lcg = int(mod(s, int(huge(0), int64)), kind(0))
438 : ! end function lcg
439 : !
440 : ! subroutine getTime()
441 : ! implicit none
442 : ! call system_clock( count=co_time )
443 : ! if (co_time <= 0) then
444 : ! call date_and_time(values=DateTimeValues)
445 : ! co_time = (DateTimeValues(1) - 1970) * 365_int64 * 24 * 60 * 60 * 1000 &
446 : ! + DateTimeValues(2) * 31_int64 * 24 * 60 * 60 * 1000 &
447 : ! + DateTimeValues(3) * 24_int64 * 60 * 60 * 1000 &
448 : ! + DateTimeValues(5) * 60 * 60 * 1000 &
449 : ! + DateTimeValues(6) * 60 * 1000 &
450 : ! + DateTimeValues(7) * 1000 &
451 : ! + DateTimeValues(8)
452 : ! end if
453 : ! end subroutine getTime
454 : !
455 : ! end subroutine random_init
456 :
457 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
458 :
459 : end module RandomSeed_mod ! LCOV_EXCL_LINE
|
