| Line | Branch | Exec | Source |
|---|---|---|---|
| 1 | module athena__random | ||
| 2 | !! Module containing functions to initialise the random number generator | ||
| 3 | use coreutils, only: stop_program | ||
| 4 | implicit none | ||
| 5 | logical :: l_random_initialised=.false. | ||
| 6 | |||
| 7 | |||
| 8 | private | ||
| 9 | |||
| 10 | public :: random_setup | ||
| 11 | |||
| 12 | |||
| 13 | |||
| 14 | contains | ||
| 15 | |||
| 16 | !############################################################################### | ||
| 17 | − | subroutine random_setup(seed, num_seed, restart, already_initialised) | |
| 18 | !! Initialise the random number generator | ||
| 19 | implicit none | ||
| 20 | |||
| 21 | ! Arguments | ||
| 22 | integer, dimension(..), optional, intent(in) :: seed | ||
| 23 | !! Seed for the random number generator | ||
| 24 | integer, optional, intent(out) :: num_seed | ||
| 25 | !! Number of seeds | ||
| 26 | logical, optional, intent(in) :: restart | ||
| 27 | !! Restart the random number generator | ||
| 28 | logical, optional, intent(out) :: already_initialised | ||
| 29 | !! Check if the random number generator is already initialised | ||
| 30 | |||
| 31 | ! Local variables | ||
| 32 | integer :: l | ||
| 33 | !! Loop index | ||
| 34 | integer :: itmp1 | ||
| 35 | !! Temporary integer | ||
| 36 | integer :: num_seed_ | ||
| 37 | !! Number of seeds | ||
| 38 | logical :: restart_ | ||
| 39 | !! Restart the random number generator | ||
| 40 | − | integer, allocatable, dimension(:) :: seed_arr | |
| 41 | !! Seed array | ||
| 42 | character(256) :: err_msg | ||
| 43 | !! Error message | ||
| 44 | |||
| 45 | |||
| 46 | !--------------------------------------------------------------------------- | ||
| 47 | ! Check if restart is defined | ||
| 48 | !--------------------------------------------------------------------------- | ||
| 49 | − | if(present(restart))then | |
| 50 | − | restart_ = restart | |
| 51 | else | ||
| 52 | − | restart_ = .false. | |
| 53 | end if | ||
| 54 | − | if(present(already_initialised)) already_initialised = .false. | |
| 55 | |||
| 56 | !--------------------------------------------------------------------------- | ||
| 57 | ! Check if already initialised | ||
| 58 | !--------------------------------------------------------------------------- | ||
| 59 | − | if(l_random_initialised.and..not.restart_)then | |
| 60 | − | if(present(already_initialised)) already_initialised = .true. | |
| 61 | − | return !! no need to initialise if already initialised | |
| 62 | else | ||
| 63 | − | call random_seed(size=num_seed_) | |
| 64 | − | allocate(seed_arr(num_seed_)) | |
| 65 | − | if(present(seed))then | |
| 66 | − | select rank(seed) | |
| 67 | rank(0) | ||
| 68 | − | seed_arr = seed | |
| 69 | rank(1) | ||
| 70 | − | if(size(seed,dim=1).ne.1)then | |
| 71 | − | if(size(seed,dim=1).eq.num_seed_)then | |
| 72 | − | seed_arr = seed | |
| 73 | else | ||
| 74 | write(err_msg,'(A)') & | ||
| 75 | "seed size not consistent with & | ||
| 76 | &seed size returned by implementation" // & | ||
| 77 | achar(13) // achar(10) // & | ||
| 78 | − | "Cannot resolve" | |
| 79 | − | call stop_program(err_msg) | |
| 80 | − | return | |
| 81 | end if | ||
| 82 | else | ||
| 83 | − | seed_arr = seed(1) | |
| 84 | end if | ||
| 85 | end select | ||
| 86 | else | ||
| 87 | − | call system_clock(count=itmp1) | |
| 88 | − | seed_arr = itmp1 + 37* (/ (l-1,l=1,num_seed_) /) | |
| 89 | end if | ||
| 90 | − | call random_seed(put=seed_arr) | |
| 91 | − | l_random_initialised = .true. | |
| 92 | end if | ||
| 93 | |||
| 94 | − | if(present(num_seed)) num_seed = num_seed_ | |
| 95 | |||
| 96 | − | end subroutine random_setup | |
| 97 | !############################################################################### | ||
| 98 | |||
| 99 |
4/8✓ Branch 0 (31→32) taken 2 times.
✗ Branch 1 (31→33) not taken.
✓ Branch 2 (32→33) taken 2 times.
✗ Branch 3 (32→34) not taken.
✗ Branch 4 (35→36) not taken.
✓ Branch 5 (35→40) taken 2 times.
✓ Branch 6 (40→41) taken 2 times.
✗ Branch 7 (40→81) not taken.
|
2 | end module athena__random |
| 100 |