ROMS
Loading...
Searching...
No Matches
ran_state Module Reference

Data Types

interface  ran_hash
 

Functions/Subroutines

subroutine ran_init (length)
 
subroutine ran_deallocate
 
subroutine ran_seed (sequence, size, put, get)
 
subroutine ran_hash_s (il, ir)
 
subroutine ran_hash_v (il, ir)
 

Variables

integer(i8b), parameter hg = HUGE(1_i8b)
 
integer(i8b), parameter hgm = -hg
 
integer(i8b), parameter hgng = hgm - 1
 
integer(i8b), save lenran = 0
 
integer(i8b), save seq = 0
 
integer(i8b), save iran0
 
integer(i8b), save jran0
 
integer(i8b), save kran0
 
integer(i8b), save nran0
 
integer(i8b), save mran0
 
integer(i8b), save rans
 
integer(i8b), dimension(:), pointer, save iran
 
integer(i8b), dimension(:), pointer, save jran
 
integer(i8b), dimension(:), pointer, save kran
 
integer(i8b), dimension(:), pointer, save nran
 
integer(i8b), dimension(:), pointer, save mran
 
integer(i8b), dimension(:), pointer, save ranv
 
integer(i8b), dimension(:,:), pointer, save ranseeds
 
real(r8), save amm
 

Function/Subroutine Documentation

◆ ran_deallocate()

subroutine ran_state::ran_deallocate

Definition at line 179 of file ran_state.F.

180!
181!=======================================================================
182! !
183! User interface to release the workspace used by random number !
184! routines. !
185! !
186!=======================================================================
187!
188 IF (lenran.gt.0) THEN
189 DEALLOCATE (ranseeds, ranv)
190 NULLIFY (ranseeds, ranv, iran, jran, kran, mran, nran)
191 lenran=0
192 END IF

References iran, jran, kran, lenran, mran, nran, ranseeds, and ranv.

Referenced by ran_seed().

Here is the caller graph for this function:

◆ ran_hash_s()

subroutine ran_state::ran_hash_s ( integer(i8b), intent(inout) il,
integer(i8b), intent(inout) ir )

Definition at line 244 of file ran_state.F.

245!
246!=======================================================================
247! !
248! DES-like hashing of 32-bit integer, using shifts, xor, and adds to !
249! make the interval nonlinear function. Scalar version. !
250! !
251!=======================================================================
252!
253! Imported variable declarations.
254!
255 integer(i8b), intent(inout) :: il, ir
256!
257! Local variable declarations.
258!
259 integer(i8b) :: is, j
260!
261!-----------------------------------------------------------------------
262! Bit mixing. The various constants should not be changed.
263!-----------------------------------------------------------------------
264!
265 DO j=1,4
266 is=ir
267 ir=ieor(ir,ishft(ir,5))+1422217823
268 ir=ieor(ir,ishft(ir,-16))+1842055030
269 ir=ieor(ir,ishft(ir,9))+80567781
270 ir=ieor(il,ir)
271 il=is
272 END DO
273
274 RETURN

◆ ran_hash_v()

subroutine ran_state::ran_hash_v ( integer(i8b), dimension(:), intent(inout) il,
integer(i8b), dimension(:), intent(inout) ir )

Definition at line 277 of file ran_state.F.

278!
279!=======================================================================
280! !
281! DES-like hashing of 32-bit integer, using shifts, xor, and adds to !
282! make the interval nonlinear function. Vector version. !
283! !
284!=======================================================================
285!
286! Imported variable declarations.
287!
288 integer(i8b), intent(inout) :: il(:)
289 integer(i8b), intent(inout) :: ir(:)
290!
291! Local variable declarations.
292!
293 integer(i8b) :: j
294 integer(i8b), dimension(SIZE(il)) :: is
295!
296!-----------------------------------------------------------------------
297! Bit mixing. The various constants should not be changed.
298!-----------------------------------------------------------------------
299!
300 DO j=1,4
301 is=ir
302 ir=ieor(ir,ishft(ir,5))+1422217823
303 ir=ieor(ir,ishft(ir,-16))+1842055030
304 ir=ieor(ir,ishft(ir,9))+80567781
305 ir=ieor(il,ir)
306 il=is
307 END DO
308
309 RETURN

◆ ran_init()

subroutine ran_state::ran_init ( integer(i8b), intent(in) length)

Definition at line 64 of file ran_state.F.

65!
66!=======================================================================
67! !
68! This routine initializes or reinitializes the random generator !
69! state space to vectors of size LENGTH. The saved variable SEQ !
70! is hashed (via a call to RAN_HASH) to create unique starting !
71! seeds, different for each vector component. !
72! !
73!=======================================================================
74!
75 USE nrutil, ONLY : arth, nrerror, reallocate
76!
77! Imported variable declarations.
78!
79 integer(i8b), intent(in) :: length
80!
81! Local variable declarations.
82!
83 integer(i8b) :: hgt, j, new, sz
84!
85!-----------------------------------------------------------------------
86! Initialize randon number generator vectors.
87!-----------------------------------------------------------------------
88!
89 IF (length.lt.lenran) RETURN
90 hgt=hg
91!
92! Check that kind value I8B is in fact a 32-bit integer with the usual
93! properties that we expect it to have (under negation and wrap-around
94! addition). If all these test are satisfied, then the routines that
95! use this module are portable, even though they go beyond F90 integer
96! model.
97!
98 IF (hg.ne.2147483647) &
99 & CALL nrerror ('RAN_INIT: arith assump 1 fails')
100 IF (hgng.ge.0) &
101 & CALL nrerror ('RAN_INIT: arith assump 2 fails')
102 IF ((hgt+1).ne.hgng) &
103 & CALL nrerror ('RAN_INIT: arith assump 3 fails')
104 IF (not(hg).ge.0) &
105 & CALL nrerror ('RAN_INIT: arith assump 4 fails')
106 IF (not(hgng).lt.0) &
107 & CALL nrerror ('RAN_INIT: arith assump 5 fails')
108 IF ((hg+hgng).ge.0) &
109 & CALL nrerror ('RAN_INIT: arith assump 6 fails')
110 IF (not(-1_i8b).lt.0) &
111 & CALL nrerror ('RAN_INIT: arith assump 7 fails')
112 IF (not(0_i8b).ge.0) &
113 & CALL nrerror ('RAN_INIT: arith assump 8 fails')
114 IF (not(1_i8b).ge.0) &
115 & CALL nrerror ('RAN_INIT: arith assump 9 fails')
116!
117! Reallocate or allocate state space.
118!
119 IF (lenran.gt.0) THEN
120 ranseeds => reallocate(ranseeds, length, 5_i8b)
121 ranv => reallocate(ranv, length-1_i8b)
122 new=lenran+1
123 ELSE
124 ALLOCATE (ranseeds(length,5))
125 ALLOCATE (ranv(length-1))
126 new=1
127 amm=nearest(1.0_r8,-1.0_r8)/hgng
128 IF ((amm*hgng.ge.1.0_r8).or.(amm*hgng.le.0.0_r8)) &
129 & CALL nrerror ('RAN_INIT: arth assump 10 fails')
130 END IF
131!
132! Set starting values, unique by SEQ and vector component.
133!
134 ranseeds(new:,1)=seq
135 sz=SIZE(ranseeds(new:,1))
136 ranseeds(new:,2:5)=spread(arth(new,1_i8b,sz),2,4)
137!
138! Hash them.
139!
140 DO j=1,4
141 CALL ran_hash (ranseeds(new:,j), ranseeds(new:,j+1))
142 END DO
143!
144! Enforce nonnegativity.
145!
146 WHERE (ranseeds(new:,1:3).lt.0) &
147 & ranseeds(new:,1:3)=not(ranseeds(new:,1:3))
148!
149! Enforce nonzero.
150!
151 WHERE (ranseeds(new:,4:5).eq.0) &
152 & ranseeds(new:,4:5)=1
153!
154! Set scalar seeds.
155!
156 IF (new.eq.1) THEN
157 iran0=ranseeds(1,1)
158 jran0=ranseeds(1,2)
159 kran0=ranseeds(1,3)
160 mran0=ranseeds(1,4)
161 nran0=ranseeds(1,5)
162 rans=nran0
163 END IF
164!
165! Point to vector seeds.
166!
167 IF (length.gt.1) THEN
168 iran => ranseeds(2:,1)
169 jran => ranseeds(2:,2)
170 kran => ranseeds(2:,3)
171 mran => ranseeds(2:,4)
172 nran => ranseeds(2:,5)
173 ranv = nran
174 END IF
175 lenran=length
176
Definition nrutil.F:1
subroutine nrerror(string)
Definition nrutil.F:292

References amm, hg, hgng, iran, iran0, jran, jran0, kran, kran0, lenran, mran, mran0, nran, nran0, nrutil::nrerror(), rans, ranseeds, ranv, and seq.

Referenced by ran1_s(), and ran1_v().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ ran_seed()

subroutine ran_state::ran_seed ( integer, intent(in), optional sequence,
integer, intent(out), optional size,
integer, dimension(:), intent(in), optional put,
integer, dimension(:), intent(out), optional get )

Definition at line 195 of file ran_state.F.

196!
197!=======================================================================
198! !
199! User interface for seeding the random number routines. Syntax is !
200! exactly like Fortran 90 RANDOM_SEED, with one additional argument !
201! keyword: SEQUENCE, set to any integer value, causes an immediate !
202! new initialization, seeded by that integer. !
203! !
204!=======================================================================
205!
206! Imported variable declarations.
207!
208 integer, optional, intent(in) :: sequence
209 integer, optional, intent(out) :: size
210
211 integer, optional, intent(in) :: put(:)
212 integer, optional, intent(out) :: get(:)
213!
214!-----------------------------------------------------------------------
215! Set random number seeds.
216!-----------------------------------------------------------------------
217!
218 IF (PRESENT(size)) THEN
219 size=5*lenran
220 ELSE IF (PRESENT(put)) THEN
221 IF (lenran.eq.0) RETURN
222 ranseeds=reshape(put,shape(ranseeds))
223 WHERE (ranseeds(:,1:3).lt.0) &
224 & ranseeds(:,1:3)=not(ranseeds(:,1:3))
225 WHERE (ranseeds(:,4:5).eq.0) &
226 & ranseeds(:,4:5)=1
227 iran0=ranseeds(1,1)
228 jran0=ranseeds(1,2)
229 kran0=ranseeds(1,3)
230 mran0=ranseeds(1,4)
231 nran0=ranseeds(1,5)
232 ELSE IF (present(get)) THEN
233 IF (lenran.eq.0) RETURN
234 ranseeds(1,1:5)=(/ iran0,jran0,kran0,mran0,nran0 /)
235 get=reshape(ranseeds,shape(get))
236 ELSE IF (PRESENT(sequence)) THEN
237 CALL ran_deallocate
238 seq=sequence
239 END IF
240
241 RETURN

References iran0, jran0, kran0, lenran, mran0, nran0, ran_deallocate(), ranseeds, and seq.

Referenced by inp_par_mod::inp_par().

Here is the call graph for this function:
Here is the caller graph for this function:

Variable Documentation

◆ amm

real(r8), save ran_state::amm

Definition at line 56 of file ran_state.F.

56 real(r8), save :: amm

Referenced by ran1_s(), ran1_v(), and ran_init().

◆ hg

integer(i8b), parameter ran_state::hg = HUGE(1_i8b)

Definition at line 34 of file ran_state.F.

34 integer(i8b), parameter :: hg = huge(1_i8b)

Referenced by ran_init().

◆ hgm

integer(i8b), parameter ran_state::hgm = -hg

Definition at line 35 of file ran_state.F.

35 integer(i8b), parameter :: hgm = -hg

◆ hgng

integer(i8b), parameter ran_state::hgng = hgm - 1

Definition at line 36 of file ran_state.F.

36 integer(i8b), parameter :: hgng = hgm - 1

Referenced by ran_init().

◆ iran

integer(i8b), dimension(:), pointer, save ran_state::iran

Definition at line 47 of file ran_state.F.

47 integer(i8b), pointer, save :: iran(:)

Referenced by ran1_v(), ran_deallocate(), and ran_init().

◆ iran0

integer(i8b), save ran_state::iran0

Definition at line 40 of file ran_state.F.

40 integer(i8b), save :: iran0

Referenced by ran1_s(), ran_init(), and ran_seed().

◆ jran

integer(i8b), dimension(:), pointer, save ran_state::jran

Definition at line 48 of file ran_state.F.

48 integer(i8b), pointer, save :: jran(:)

Referenced by ran1_v(), ran_deallocate(), and ran_init().

◆ jran0

integer(i8b), save ran_state::jran0

Definition at line 41 of file ran_state.F.

41 integer(i8b), save :: jran0

Referenced by ran1_s(), ran_init(), and ran_seed().

◆ kran

integer(i8b), dimension(:), pointer, save ran_state::kran

Definition at line 49 of file ran_state.F.

49 integer(i8b), pointer, save :: kran(:)

Referenced by ran1_v(), ran_deallocate(), and ran_init().

◆ kran0

integer(i8b), save ran_state::kran0

Definition at line 42 of file ran_state.F.

42 integer(i8b), save :: kran0

Referenced by ran1_s(), ran_init(), and ran_seed().

◆ lenran

integer(i8b), save ran_state::lenran = 0

Definition at line 38 of file ran_state.F.

38 integer(i8b), save :: lenran = 0

Referenced by ran1_s(), ran1_v(), ran_deallocate(), ran_init(), and ran_seed().

◆ mran

integer(i8b), dimension(:), pointer, save ran_state::mran

Definition at line 51 of file ran_state.F.

51 integer(i8b), pointer, save :: mran(:)

Referenced by ran1_v(), ran_deallocate(), and ran_init().

◆ mran0

integer(i8b), save ran_state::mran0

Definition at line 44 of file ran_state.F.

44 integer(i8b), save :: mran0

Referenced by ran1_s(), ran_init(), and ran_seed().

◆ nran

integer(i8b), dimension(:), pointer, save ran_state::nran

Definition at line 50 of file ran_state.F.

50 integer(i8b), pointer, save :: nran(:)

Referenced by ran1_v(), ran_deallocate(), and ran_init().

◆ nran0

integer(i8b), save ran_state::nran0

Definition at line 43 of file ran_state.F.

43 integer(i8b), save :: nran0

Referenced by ran1_s(), ran_init(), and ran_seed().

◆ rans

integer(i8b), save ran_state::rans

Definition at line 45 of file ran_state.F.

45 integer(i8b), save :: rans

Referenced by ran1_s(), and ran_init().

◆ ranseeds

integer(i8b), dimension(:,:), pointer, save ran_state::ranseeds

Definition at line 54 of file ran_state.F.

54 integer(i8b), pointer, save :: ranseeds(:,:)

Referenced by ran_deallocate(), ran_init(), and ran_seed().

◆ ranv

integer(i8b), dimension(:), pointer, save ran_state::ranv

Definition at line 52 of file ran_state.F.

52 integer(i8b), pointer, save :: ranv(:)

Referenced by ran1_v(), ran_deallocate(), and ran_init().

◆ seq

integer(i8b), save ran_state::seq = 0

Definition at line 39 of file ran_state.F.

39 integer(i8b), save :: seq = 0

Referenced by ran_init(), and ran_seed().