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

« back to all changes in this revision

Viewing changes to routines/randlib/setsd.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 setsd(iseed1,iseed2)
 
2
C**********************************************************************
 
3
C
 
4
C     SUBROUTINE SETSD(ISEED1,ISEED2)
 
5
C               SET S-ee-D of current generator
 
6
C
 
7
C     Resets the initial  seed of  the current  generator to  ISEED1 and
 
8
C     ISEED2. The seeds of the other generators remain unchanged.
 
9
C
 
10
C     This is a transcription from Pascal to Fortran of routine
 
11
C     Set_Seed 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     ISEED1 -> First integer seed
 
22
C                                   INTEGER ISEED1
 
23
C
 
24
C     ISEED2 -> Second integer seed
 
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,initgn
 
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
      call basout(io,wte,"SETSD called before random number generator")
 
64
      call basout(io,wte,"initialized")
 
65
      return
 
66
   10 CALL getcgn(g)
 
67
      ig1(g) = iseed1
 
68
      ig2(g) = iseed2
 
69
      CALL initgn(-1)
 
70
      RETURN
 
71
 
 
72
      END