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
getsd.f
Go to the documentation of this file.
1  SUBROUTINE getsd(iseed1,iseed2)
2 C**********************************************************************
3 C
4 C SUBROUTINE GETSD(G,ISEED1,ISEED2)
5 C GET SeeD
6 C
7 C Returns the value of two integer seeds of the current generator
8 C
9 C This is a transcription from Pascal to Fortran of routine
10 C Get_State 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
21 C ISEED1 <- First integer seed of generator G
22 C INTEGER ISEED1
23 C
24 C ISEED2 <- Second integer seed of generator G
25 C INTEGER ISEED1
26 C
27 C**********************************************************************
28 C .. Parameters ..
29  INTEGER numg
30  parameter(numg=32)
31 C ..
32 C .. Scalar Arguments ..
33  INTEGER iseed1,iseed2
34 C ..
35 C .. Scalars in Common ..
36  INTEGER a1,a1vw,a1w,a2,a2vw,a2w,m1,m2
37 C ..
38 C .. Arrays in Common ..
39  INTEGER cg1(numg),cg2(numg),ig1(numg),ig2(numg),lg1(numg),
40  + lg2(numg)
41  LOGICAL qanti(numg)
42 C ..
43 C .. Local Scalars ..
44  INTEGER g
45 C ..
46 C .. External Functions ..
47  LOGICAL qrgnin
48  EXTERNAL qrgnin
49 C ..
50 C .. External Subroutines ..
51  EXTERNAL getcgn
52 C ..
53 C .. Common blocks ..
54  COMMON /globe/m1,m2,a1,a2,a1w,a2w,a1vw,a2vw,ig1,ig2,lg1,lg2,cg1,
55  + cg2,qanti
56 C ..
57 C .. Save statement ..
58  SAVE /globe/
59 C ..
60 C .. Executable Statements ..
61 C Abort unless random number generator initialized
62  IF (qrgnin()) go to 10
63  WRITE (*,*) ' GETSD called before random number generator ',
64  + ' initialized -- abort!'
65  CALL xstopx
66  + (' GETSD called before random number generator initialized')
67 
68  10 CALL getcgn(g)
69  iseed1 = cg1(g)
70  iseed2 = cg2(g)
71  RETURN
72 
73  END