The ParaMonte Documentation Website
Current view: top level - kernel - RandomSeed_mod.f90 (source / functions) Hit Total Coverage
Test: ParaMonte 1.5.1 :: MPI Parallel Kernel - Code Coverage Report Lines: 44 47 93.6 %
Date: 2021-01-08 13:07:16 Functions: 3 3 100.0 %
Legend: Lines: hit not hit

          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

ParaMonte: Plain Powerful Parallel Monte Carlo Library 
The Computational Data Science Lab
© Copyright 2012 - 2021