GNU Octave  6.2.0
A high-level interpreted language, primarily intended for numerical computations, mostly compatible with Matlab
advnst.f
Go to the documentation of this file.
1  SUBROUTINE advnst(k)
2 C**********************************************************************
3 C
4 C SUBROUTINE ADVNST(K)
5 C ADV-a-N-ce ST-ate
6 C
7 C Advances the state of the current generator by 2^K values and
8 C resets the initial seed to that value.
9 C
10 C This is a transcription from Pascal to Fortran of routine
11 C Advance_State from the paper
12 C
13 C L'Ecuyer, P. and Cote, S. "Implementing a Random Number Package
14 C with Splitting Facilities." ACM Transactions on Mathematical
15 C Software, 17:98-111 (1991)
16 C
17 C
18 C Arguments
19 C
20 C
21 C K -> The generator is advanced by2^K values
22 C INTEGER K
23 C
24 C**********************************************************************
25 C .. Parameters ..
26  INTEGER*4 numg
27  parameter(numg=32)
28 C ..
29 C .. Scalar Arguments ..
30  INTEGER*4 k
31 C ..
32 C .. Scalars in Common ..
33  INTEGER*4 a1,a1vw,a1w,a2,a2vw,a2w,m1,m2
34 C ..
35 C .. Arrays in Common ..
36  INTEGER*4 cg1(numg),cg2(numg),ig1(numg),ig2(numg),lg1(numg),
37  + lg2(numg)
38  LOGICAL qanti(numg)
39 C ..
40 C .. Local Scalars ..
41  INTEGER*4 g,i,ib1,ib2
42 C ..
43 C .. External Functions ..
44  INTEGER*4 mltmod
45  LOGICAL qrgnin
46  EXTERNAL mltmod,qrgnin
47 C ..
48 C .. External Subroutines ..
49  EXTERNAL getcgn,setsd
50 C ..
51 C .. Common blocks ..
52  COMMON /globe/m1,m2,a1,a2,a1w,a2w,a1vw,a2vw,ig1,ig2,lg1,lg2,cg1,
53  + cg2,qanti
54 C ..
55 C .. Save statement ..
56  SAVE /globe/
57 C ..
58 C .. Executable Statements ..
59 C Abort unless random number generator initialized
60  IF (qrgnin()) GO TO 10
61  WRITE (*,*) ' ADVNST called before random number generator ',
62  + ' initialized -- abort!'
63  CALL xstopx
64  + (' ADVNST called before random number generator initialized')
65 
66  10 CALL getcgn(g)
67 C
68  ib1 = a1
69  ib2 = a2
70  DO 20,i = 1,k
71  ib1 = mltmod(ib1,ib1,m1)
72  ib2 = mltmod(ib2,ib2,m2)
73  20 CONTINUE
74  CALL setsd(mltmod(ib1,cg1(g),m1),mltmod(ib2,cg2(g),m2))
75 C
76 C NOW, IB1 = A1**K AND IB2 = A2**K
77 C
78  RETURN
79 
80  END
subroutine advnst(k)
Definition: advnst.f:2
subroutine getcgn(g)
Definition: getcgn.f:2
subroutine setsd(iseed1, iseed2)
Definition: setsd.f:2