GNU Octave  3.8.0
A high-level interpreted language, primarily intended for numerical computations, mostly compatible with Matlab
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Properties Friends Macros Pages
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 numg
27  parameter(numg=32)
28 C ..
29 C .. Scalar Arguments ..
30  INTEGER k
31 C ..
32 C .. Scalars in Common ..
33  INTEGER a1,a1vw,a1w,a2,a2vw,a2w,m1,m2
34 C ..
35 C .. Arrays in Common ..
36  INTEGER 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 g,i,ib1,ib2
42 C ..
43 C .. External Functions ..
44  INTEGER 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