GNU Octave  4.2.1 A high-level interpreted language, primarily intended for numerical computations, mostly compatible with Matlab
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
subroutine getcgn(g)
Definition: getcgn.f:1
may be zero for pure relative error test tem the relative tolerance must be greater than or equal to