~ubuntu-branches/ubuntu/karmic/scilab/karmic

« back to all changes in this revision

Viewing changes to routines/randlib/getsd.f

  • Committer: Bazaar Package Importer
  • Author(s): Torsten Werner
  • Date: 2002-03-21 16:57:43 UTC
  • Revision ID: james.westby@ubuntu.com-20020321165743-e9mv12c1tb1plztg
Tags: upstream-2.6
ImportĀ upstreamĀ versionĀ 2.6

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
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
      include '../stack.h'
 
29
C     .. Parameters ..
 
30
      INTEGER numg
 
31
      PARAMETER (numg=32)
 
32
C     ..
 
33
C     .. Scalar Arguments ..
 
34
      INTEGER iseed1,iseed2
 
35
C     ..
 
36
C     .. Scalars in Common ..
 
37
      INTEGER a1,a1vw,a1w,a2,a2vw,a2w,m1,m2
 
38
C     ..
 
39
C     .. Arrays in Common ..
 
40
      INTEGER cg1(numg),cg2(numg),ig1(numg),ig2(numg),lg1(numg),
 
41
     +        lg2(numg)
 
42
      LOGICAL qanti(numg)
 
43
C     ..
 
44
C     .. Local Scalars ..
 
45
      INTEGER g
 
46
C     ..
 
47
C     .. External Functions ..
 
48
      LOGICAL qrgnin
 
49
      EXTERNAL qrgnin
 
50
C     ..
 
51
C     .. External Subroutines ..
 
52
      EXTERNAL getcgn
 
53
C     ..
 
54
C     .. Common blocks ..
 
55
      COMMON /globe/m1,m2,a1,a2,a1w,a2w,a1vw,a2vw,ig1,ig2,lg1,lg2,cg1,
 
56
     +       cg2,qanti
 
57
C     ..
 
58
C     .. Save statement ..
 
59
      SAVE /globe/
 
60
C     ..
 
61
C     .. Executable Statements ..
 
62
C     Abort unless random number generator initialized
 
63
      IF (qrgnin()) GO TO 10
 
64
      call basout(io,wte,'GETSD called before random number generator ')
 
65
      return
 
66
   10 CALL getcgn(g)
 
67
      iseed1 = cg1(g)
 
68
      iseed2 = cg2(g)
 
69
      RETURN
 
70
 
 
71
      END