2413445047

Committed 27 Mar 2026 12:30PM UTC coverage: 6.984% (+7.0%) from 0.0%

Build Type

push

gitlab-ci

Committed by David Dickinson

Commit Message

Add missing side and trans arguments

Coverage Stats

743 of 10639 relevant lines covered (6.98%)

16175.3 hits per line

Source File
Press 'n' to go to next uncovered line, 'b' for previous

0.0

/ran.fpp

# include "define.inc"

!>  A wrapper module for random number generator.
!>  This module provides real function ranf
!>  using intrinsic random_number/random_seed or
!>  Mersenne Twister 19937 (see [[mt19937.f90]]).
module ran

  implicit none

  private

  public :: ranf, set_seed_from_single_integer
  public :: get_rnd_seed_length,get_rnd_seed,init_ranf

contains

  !> Returns a pseudorandom number range in [0., 1.), (i.e. 0<= ranf < 1).
  !> The generator is initialized with the given seed if passed,
  !> otherwise uses the seed already set (default or otherwise).
  real function ranf (seed)
# if RANDOM == _RANMT_
    use mt19937, only: sgrnd, grnd
# endif
    implicit none
    integer, intent(in), optional :: seed
# if RANDOM != _RANMT_
    integer :: l
    integer, allocatable :: seed_in(:)
# endif

# if RANDOM == _RANMT_
    if (present(seed)) call sgrnd(seed)
    ranf = grnd()
# else
    if (present(seed)) then
       call random_seed(size=l)
       allocate(seed_in(l))
       ! @note This is probably not ideal, instead we could use
       ! [[set_seed_from_single_integer]] instead
       seed_in(:)=seed
       call random_seed(put=seed_in)
    endif
    call random_number(ranf)
# endif
  end function ranf

  !> Gets the length of the integer vector for the random number
  !> generator seed. This is always 1 for the Mersenne case but
  !> otherwise depends on the compiler version.
  function get_rnd_seed_length () result (l)
    implicit none
    integer :: l
# if RANDOM == _RANMT_
    l=1
# else
    call random_seed(size=l)
# endif
  end function get_rnd_seed_length

  !> Returns the current value of the generator seed.
  !> This is not currently supported by the Mersenne
  !> generator so in this case we return 0.
  subroutine get_rnd_seed(seed)
    implicit none
    integer, dimension(:), intent(out) :: seed
# if RANDOM == _RANMT_
    !NOTE: If MT is generator, more coding needs to be done to
    !      extract seed, so this should be run using only randomize
    seed=0
# else
    call random_seed(get=seed)
# endif
  end subroutine get_rnd_seed

  !> Seed the choosen random number generator.
  !> If randomize=T, a random seed based on date and time is used.
  !> (this randomizing procedure is proposed in GNU gfortran manual.)
  !> Otherwise, it sets the seed using init_seed
  !> In either case, it sets `init_seed` to the initial seed used on return.
  subroutine init_ranf(randomize, init_seed)
    use constants, only: kind_id
# if RANDOM == _RANMT_
    use mt19937, only: sgrnd
# endif
    implicit none
    logical, intent(in) :: randomize
    integer, intent(in out), dimension(:) :: init_seed
# if RANDOM != _RANMT_
    integer :: i, nseed
# endif
    integer, dimension(8) :: dt
    integer (kind=kind_id) :: t

    if (randomize) then
       call system_clock(t)
       if (t == 0) then
          call date_and_time(values=dt)
          t = (dt(1) - 1970) * 365_kind_id * 24 * 60 * 60 * 1000 &
               + dt(2) * 31_kind_id * 24 * 60 * 60 * 1000 &
               + dt(3) * 24_kind_id * 60 * 60 * 1000 &
               + dt(5) * 60 * 60 * 1000 &
               + dt(6) * 60 * 1000 + dt(7) * 1000 &
               + dt(8)
       end if
    else
       t = 0
    end if

# if RANDOM == _RANMT_
    if (randomize) then
       init_seed(1) = lcg(t)
    endif
    call sgrnd(init_seed(1))

# else
    if (randomize) then
       ! We should probably check that size(init_seed) >= nseed
       call random_seed(size=nseed)

       do i = 1, nseed
          init_seed(i) = lcg(t)
       end do
    endif

    call random_seed(put=init_seed)

# endif

  end subroutine init_ranf

# if RANDOM != _RANMT_
  !> Returns an array of integers to use as a seed to the
  !> random number generator given a single integer as input.
  !>
  !> Currently we just use the [[lcg]] generator to generate
  !> a series of values to use for the seed. We could also
  !> set the actual random seed from this and then use this
  !> to generate a final series of seeds. This is probably not
  !> really necessary.
  !>
  !> For our mt19937 implementation we just set the seed
  !> equal to initial_seed
  function create_seed_from_single_integer(initial_seed) result(seed)
    use constants, only: kind_id
    implicit none
    integer, intent(in) :: initial_seed
    integer, dimension(:), allocatable :: seed
    integer :: seed_size, i
    integer(kind = kind_id) :: current

    ! Get the required state size for the seed
    call random_seed(size = seed_size)

    allocate(seed(seed_size))

    ! Use lcg to generate a series of random numbers given
    ! the initial seed
    current = initial_seed
    do i = 1, seed_size
       seed(i) = lcg(current)
       current = seed(i)
    end do
  end function create_seed_from_single_integer
# endif

  !> Sets the seed for the random number generator provided by the
  !> standard based on a single integer. We use
  !> [[create_seed_from_single_integer]] to ensure we have enough values
  !> in the series rather than just duplicating this number.
  subroutine set_seed_from_single_integer(initial_seed)
# if RANDOM == _RANMT_
    use mt19937, only: sgrnd
# endif
    implicit none
    integer, intent(in) :: initial_seed
# if RANDOM == _RANMT_
    call sgrnd(initial_seed)
# else
    call random_seed(put = create_seed_from_single_integer(initial_seed))
# endif
  end subroutine set_seed_from_single_integer

  !> Simple PRNG derived from [gfortran
  !> documentation](https://gcc.gnu.org/onlinedocs/gcc-6.4.0/gfortran/RANDOM_005fSEED.html)
  !> Intended to be used to seed a better PRNG. Probably shouldn't be used
  !> directly (hence why this is not public).
  !>
  !> @warning (?) the sign of the output will be the same as the input
  !> and hence has a restricted range, perhaps we should consider
  !> subtracting sign(s)*huge(s)/2 ?
  function lcg(s)
    use constants, only: kind_id, kind_is
    implicit none
    integer :: lcg
    integer (kind=kind_id), intent(in out) :: s

    if (kind_id > 0) then
       if (s == 0) then
          s = 104729
       else
          s = mod(s, 4294967296_kind_id)
       end if
       s = mod(s * 279470273_kind_id, 4294967291_kind_id)
       lcg = int(mod(s, int(huge(0), kind_id)), kind(0))
    else
       lcg = mod(16807*int(s,kind_is), 2147483647)
    end if

  end function lcg

end module ran

1	# include "define.inc"
2
3	!> A wrapper module for random number generator.
4	!> This module provides real function ranf
5	!> using intrinsic random_number/random_seed or
6	!> Mersenne Twister 19937 (see [[mt19937.f90]]).
7	module ran
8
9	implicit none
10
11	private
12
13	public :: ranf, set_seed_from_single_integer
14	public :: get_rnd_seed_length,get_rnd_seed,init_ranf
15
16	contains
17
18	!> Returns a pseudorandom number range in [0., 1.), (i.e. 0<= ranf < 1).
19	!> The generator is initialized with the given seed if passed,
20	!> otherwise uses the seed already set (default or otherwise).
21	real function ranf (seed)	×
22	# if RANDOM == _RANMT_
23	use mt19937, only: sgrnd, grnd
24	# endif
25	implicit none
26	integer, intent(in), optional :: seed
27	# if RANDOM != _RANMT_
28	integer :: l
29	integer, allocatable :: seed_in(:)	×
30	# endif
31
32	# if RANDOM == _RANMT_
33	if (present(seed)) call sgrnd(seed)
34	ranf = grnd()
35	# else
36	if (present(seed)) then	×
37	call random_seed(size=l)	×
38	allocate(seed_in(l))	×
39	! @note This is probably not ideal, instead we could use
40	! [[set_seed_from_single_integer]] instead
41	seed_in(:)=seed	×
42	call random_seed(put=seed_in)	×
43	endif
44	call random_number(ranf)	×
45	# endif
46	end function ranf	×
47
48	!> Gets the length of the integer vector for the random number
49	!> generator seed. This is always 1 for the Mersenne case but
50	!> otherwise depends on the compiler version.
51	function get_rnd_seed_length () result (l)	×
52	implicit none
53	integer :: l
54	# if RANDOM == _RANMT_
55	l=1
56	# else
57	call random_seed(size=l)	×
58	# endif
59	end function get_rnd_seed_length	×
60
61	!> Returns the current value of the generator seed.
62	!> This is not currently supported by the Mersenne
63	!> generator so in this case we return 0.
64	subroutine get_rnd_seed(seed)	×
65	implicit none
66	integer, dimension(:), intent(out) :: seed
67	# if RANDOM == _RANMT_
68	!NOTE: If MT is generator, more coding needs to be done to
69	! extract seed, so this should be run using only randomize
70	seed=0
71	# else
72	call random_seed(get=seed)	×
73	# endif
74	end subroutine get_rnd_seed	×
75
76	!> Seed the choosen random number generator.
77	!> If randomize=T, a random seed based on date and time is used.
78	!> (this randomizing procedure is proposed in GNU gfortran manual.)
79	!> Otherwise, it sets the seed using init_seed
80	!> In either case, it sets `init_seed` to the initial seed used on return.
81	subroutine init_ranf(randomize, init_seed)	×
82	use constants, only: kind_id
83	# if RANDOM == _RANMT_
84	use mt19937, only: sgrnd
85	# endif
86	implicit none
87	logical, intent(in) :: randomize
88	integer, intent(in out), dimension(:) :: init_seed
89	# if RANDOM != _RANMT_
90	integer :: i, nseed
91	# endif
92	integer, dimension(8) :: dt
93	integer (kind=kind_id) :: t
94
95	if (randomize) then	×
96	call system_clock(t)	×
97	if (t == 0) then	×
98	call date_and_time(values=dt)	×
99	t = (dt(1) - 1970) * 365_kind_id * 24 * 60 * 60 * 1000 &
100	+ dt(2) * 31_kind_id * 24 * 60 * 60 * 1000 &
101	+ dt(3) * 24_kind_id * 60 * 60 * 1000 &
102	+ dt(5) * 60 * 60 * 1000 &
103	+ dt(6) * 60 * 1000 + dt(7) * 1000 &
104	+ dt(8)	×
105	end if
106	else
107	t = 0	×
108	end if
109
110	# if RANDOM == _RANMT_
111	if (randomize) then
112	init_seed(1) = lcg(t)
113	endif
114	call sgrnd(init_seed(1))
115
116	# else
117	if (randomize) then	×
118	! We should probably check that size(init_seed) >= nseed
119	call random_seed(size=nseed)	×
120
121	do i = 1, nseed	×
122	init_seed(i) = lcg(t)	×
123	end do
124	endif
125
126	call random_seed(put=init_seed)	×
127
128	# endif
129
130	end subroutine init_ranf	×
131
132	# if RANDOM != _RANMT_
133	!> Returns an array of integers to use as a seed to the
134	!> random number generator given a single integer as input.
135	!>
136	!> Currently we just use the [[lcg]] generator to generate
137	!> a series of values to use for the seed. We could also
138	!> set the actual random seed from this and then use this
139	!> to generate a final series of seeds. This is probably not
140	!> really necessary.
141	!>
142	!> For our mt19937 implementation we just set the seed
143	!> equal to initial_seed
144	function create_seed_from_single_integer(initial_seed) result(seed)	×
145	use constants, only: kind_id
146	implicit none
147	integer, intent(in) :: initial_seed
148	integer, dimension(:), allocatable :: seed
149	integer :: seed_size, i
150	integer(kind = kind_id) :: current
151
152	! Get the required state size for the seed
153	call random_seed(size = seed_size)	×
154
155	allocate(seed(seed_size))	×
156
157	! Use lcg to generate a series of random numbers given
158	! the initial seed
159	current = initial_seed	×
160	do i = 1, seed_size	×
161	seed(i) = lcg(current)	×
162	current = seed(i)	×
163	end do
164	end function create_seed_from_single_integer	×
165	# endif
166
167	!> Sets the seed for the random number generator provided by the
168	!> standard based on a single integer. We use
169	!> [[create_seed_from_single_integer]] to ensure we have enough values
170	!> in the series rather than just duplicating this number.
171	subroutine set_seed_from_single_integer(initial_seed)	×
172	# if RANDOM == _RANMT_
173	use mt19937, only: sgrnd
174	# endif
175	implicit none
176	integer, intent(in) :: initial_seed
177	# if RANDOM == _RANMT_
178	call sgrnd(initial_seed)
179	# else
180	call random_seed(put = create_seed_from_single_integer(initial_seed))	×
181	# endif
182	end subroutine set_seed_from_single_integer	×
183
184	!> Simple PRNG derived from [gfortran
185	!> documentation](https://gcc.gnu.org/onlinedocs/gcc-6.4.0/gfortran/RANDOM_005fSEED.html)
186	!> Intended to be used to seed a better PRNG. Probably shouldn't be used
187	!> directly (hence why this is not public).
188	!>
189	!> @warning (?) the sign of the output will be the same as the input
190	!> and hence has a restricted range, perhaps we should consider
191	!> subtracting sign(s)*huge(s)/2 ?
192	function lcg(s)	×
193	use constants, only: kind_id, kind_is
194	implicit none
195	integer :: lcg
196	integer (kind=kind_id), intent(in out) :: s
197
198	if (kind_id > 0) then
199	if (s == 0) then	×
200	s = 104729	×
201	else
202	s = mod(s, 4294967296_kind_id)	×
203	end if
204	s = mod(s * 279470273_kind_id, 4294967291_kind_id)	×
205	lcg = int(mod(s, int(huge(0), kind_id)), kind(0))	×
206	else
207	lcg = mod(16807*int(s,kind_is), 2147483647)
208	end if
209
210	end function lcg	×
211
212	end module ran

gyrokinetics / utils / 2413445047

Source File Press 'n' to go to next uncovered line, 'b' for previous

Source File
Press 'n' to go to next uncovered line, 'b' for previous