9 integer,
parameter :: dp = kind(0.0d0)
12 integer,
parameter :: i4 = selected_int_kind(9)
15 integer,
parameter :: i8 = selected_int_kind(18)
20 integer(i8),
private :: s(2) = [123456789_i8, 987654321_i8]
22 procedure, non_overridable :: set_seed
23 procedure, non_overridable :: jump
24 procedure, non_overridable :: int_4
25 procedure, non_overridable :: int_8
26 procedure, non_overridable :: unif_01
27 procedure, non_overridable :: unif_01_vec
28 procedure, non_overridable :: normal
29 procedure, non_overridable :: two_normals
30 procedure, non_overridable :: poisson
31 procedure, non_overridable :: circle
32 procedure, non_overridable :: sphere
33 procedure, non_overridable :: next
38 type(rng_t),
allocatable :: rngs(:)
40 procedure, non_overridable :: init_parallel
49 subroutine init_parallel(self, n_proc, rng)
50 class(prng_t),
intent(inout) :: self
51 type(rng_t),
intent(inout) :: rng
52 integer,
intent(in) :: n_proc
55 allocate(self%rngs(n_proc))
59 self%rngs(n) = self%rngs(n-1)
60 call self%rngs(n)%jump()
62 end subroutine init_parallel
65 subroutine set_seed(self, the_seed)
66 class(rng_t),
intent(inout) :: self
67 integer(i8),
intent(in) :: the_seed(2)
73 end subroutine set_seed
79 class(rng_t),
intent(inout) :: self
81 integer(i8) :: global_time(2), dummy
84 integer(i8),
parameter :: jmp_c(2) = &
85 (/-4707382666127344949_i8, -2852180941702784734_i8/)
90 if (iand(jmp_c(i), shiftl(1_i8, b)) /= 0)
then
91 global_time = ieor(global_time, self%s)
101 integer(i4) function int_4(self)
102 class(rng_t),
intent(inout) :: self
103 int_4 = int(self%next(), i4)
107 integer(i8) function int_8(self)
108 class(rng_t),
intent(inout) :: self
113 real(dp) function unif_01(self)
114 class(rng_t),
intent(inout) :: self
119 x = ior(shiftl(1023_i8, 52), shiftr(x, 12))
120 unif_01 = transfer(x, tmp) - 1.0_dp
124 subroutine unif_01_vec(self, rr)
125 class(rng_t),
intent(inout) :: self
126 real(dp),
intent(out) :: rr(:)
130 rr(i) = self%unif_01()
132 end subroutine unif_01_vec
136 function two_normals(self)
result(rands)
137 class(rng_t),
intent(inout) :: self
138 real(dp) :: rands(2), sum_sq
141 rands(1) = 2 * self%unif_01() - 1
142 rands(2) = 2 * self%unif_01() - 1
143 sum_sq = sum(rands**2)
144 if (sum_sq < 1.0_dp .and. sum_sq > 0.0_dp)
exit
146 rands = rands * sqrt(-2 * log(sum_sq) / sum_sq)
147 end function two_normals
150 real(dp) function normal(self)
151 class(rng_t),
intent(inout) :: self
154 rands = self%two_normals()
160 function poisson(self, lambda)
result(rr)
161 class(rng_t),
intent(inout) :: self
162 real(dp),
intent(in) :: lambda
172 p = p * self%unif_01()
177 function circle(self, radius)
result(xy)
178 class(rng_t),
intent(inout) :: self
179 real(dp),
intent(in) :: radius
180 real(dp) :: rands(2), xy(2)
185 rands(1) = 2 * self%unif_01() - 1
186 rands(2) = 2 * self%unif_01() - 1
187 sum_sq = sum(rands**2)
188 if (sum_sq <= 1)
exit
191 xy(1) = (rands(1)**2 - rands(2)**2) / sum_sq
192 xy(2) = 2 * rands(1) * rands(2) / sum_sq
197 function sphere(self, radius)
result(xyz)
198 class(rng_t),
intent(inout) :: self
199 real(dp),
intent(in) :: radius
200 real(dp) :: rands(2), xyz(3)
201 real(dp) :: sum_sq, tmp_sqrt
205 rands(1) = 2 * self%unif_01() - 1
206 rands(2) = 2 * self%unif_01() - 1
207 sum_sq = sum(rands**2)
208 if (sum_sq <= 1)
exit
211 tmp_sqrt = sqrt(1 - sum_sq)
212 xyz(1:2) = 2 * rands(1:2) * tmp_sqrt
213 xyz(3) = 1 - 2 * sum_sq
218 function next(self)
result(res)
219 class(rng_t),
intent(inout) :: self
221 integer(i8) :: global_time(2)
224 res = global_time(1) + global_time(2)
225 global_time(2) = ieor(global_time(1), global_time(2))
226 self%s(1) = ieor(ieor(rotl(global_time(1), 55), global_time(2)), shiftl(global_time(2), 14))
227 self%s(2) = rotl(global_time(2), 36)
231 pure function rotl(x, k)
result(res)
232 integer(i8),
intent(in) :: x
233 integer,
intent(in) :: k
236 res = ior(shiftl(x, k), shiftr(x, 64 - k))
Module for pseudo random number generation. The internal pseudo random generator is the xoroshiro128p...