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
initgn.f
Go to the documentation of this file.
1  SUBROUTINE initgn(isdtyp)
2 C**********************************************************************
3 C
4 C SUBROUTINE INITGN(ISDTYP)
5 C INIT-ialize current G-e-N-erator
6 C
7 C Reinitializes the state of the current generator
8 C
9 C This is a transcription from Pascal to Fortran of routine
10 C Init_Generator from the paper
11 C
12 C L'Ecuyer, P. and Cote, S. "Implementing a Random Number Package
13 C with Splitting Facilities." ACM Transactions on Mathematical
14 C Software, 17:98-111 (1991)
15 C
16 C
17 C Arguments
18 C
19 C
20 C ISDTYP -> The state to which the generator is to be set
21 C
22 C ISDTYP = -1 => sets the seeds to their initial value
23 C ISDTYP = 0 => sets the seeds to the first value of
24 C the current block
25 C ISDTYP = 1 => sets the seeds to the first value of
26 C the next block
27 C
28 C INTEGER ISDTYP
29 C
30 C**********************************************************************
31 C .. Parameters ..
32  INTEGER numg
33  parameter(numg=32)
34 C ..
35 C .. Scalar Arguments ..
36  INTEGER isdtyp
37 C ..
38 C .. Scalars in Common ..
39  INTEGER a1,a1vw,a1w,a2,a2vw,a2w,m1,m2
40 C ..
41 C .. Arrays in Common ..
42  INTEGER cg1(numg),cg2(numg),ig1(numg),ig2(numg),lg1(numg),
43  + lg2(numg)
44  LOGICAL qanti(numg)
45 C ..
46 C .. Local Scalars ..
47  INTEGER g
48 C ..
49 C .. External Functions ..
50  LOGICAL qrgnin
51  INTEGER mltmod
52  EXTERNAL qrgnin,mltmod
53 C ..
54 C .. External Subroutines ..
55  EXTERNAL getcgn
56 C ..
57 C .. Common blocks ..
58  COMMON /globe/m1,m2,a1,a2,a1w,a2w,a1vw,a2vw,ig1,ig2,lg1,lg2,cg1,
59  + cg2,qanti
60 C ..
61 C .. Save statement ..
62  SAVE /globe/
63 C ..
64 C .. Executable Statements ..
65 C Abort unless random number generator initialized
66  IF (qrgnin()) go to 10
67  WRITE (*,*) ' INITGN called before random number generator ',
68  + ' initialized -- abort!'
69  CALL xstopx
70  + (' INITGN called before random number generator initialized')
71 
72  10 CALL getcgn(g)
73  IF ((-1).NE. (isdtyp)) go to 20
74  lg1(g) = ig1(g)
75  lg2(g) = ig2(g)
76  go to 50
77 
78  20 IF ((0).NE. (isdtyp)) go to 30
79  CONTINUE
80  go to 50
81 C do nothing
82  30 IF ((1).NE. (isdtyp)) go to 40
83  lg1(g) = mltmod(a1w,lg1(g),m1)
84  lg2(g) = mltmod(a2w,lg2(g),m2)
85  go to 50
86 
87  40 CALL xstopx('ISDTYP NOT IN RANGE')
88 
89  50 cg1(g) = lg1(g)
90  cg2(g) = lg2(g)
91  RETURN
92 
93  END