GNU Octave: libcruft/ranlib/setsd.f Source File

Go to the documentation of this file.
00001       SUBROUTINE setsd(iseed1,iseed2)
00002 C**********************************************************************
00003 C
00004 C     SUBROUTINE SETSD(ISEED1,ISEED2)
00005 C               SET S-ee-D of current generator
00006 C
00007 C     Resets the initial  seed of  the current  generator to  ISEED1 and
00008 C     ISEED2. The seeds of the other generators remain unchanged.
00009 C
00010 C     This is a transcription from Pascal to Fortran of routine
00011 C     Set_Seed from the paper
00012 C
00013 C     L'Ecuyer, P. and Cote, S. "Implementing a Random Number Package
00014 C     with Splitting Facilities." ACM Transactions on Mathematical
00015 C     Software, 17:98-111 (1991)
00016 C
00017 C
00018 C                              Arguments
00019 C
00020 C
00021 C     ISEED1 -> First integer seed
00022 C                                   INTEGER ISEED1
00023 C
00024 C     ISEED2 -> Second integer seed
00025 C                                   INTEGER ISEED1
00026 C
00027 C**********************************************************************
00028 C     .. Parameters ..
00029       INTEGER numg
00030       PARAMETER (numg=32)
00031 C     ..
00032 C     .. Scalar Arguments ..
00033       INTEGER iseed1,iseed2
00034 C     ..
00035 C     .. Scalars in Common ..
00036       INTEGER a1,a1vw,a1w,a2,a2vw,a2w,m1,m2
00037 C     ..
00038 C     .. Arrays in Common ..
00039       INTEGER cg1(numg),cg2(numg),ig1(numg),ig2(numg),lg1(numg),
00040      +        lg2(numg)
00041       LOGICAL qanti(numg)
00042 C     ..
00043 C     .. Local Scalars ..
00044       INTEGER g
00045 C     ..
00046 C     .. External Functions ..
00047       LOGICAL qrgnin
00048       EXTERNAL qrgnin
00049 C     ..
00050 C     .. External Subroutines ..
00051       EXTERNAL getcgn,initgn
00052 C     ..
00053 C     .. Common blocks ..
00054       COMMON /globe/m1,m2,a1,a2,a1w,a2w,a1vw,a2vw,ig1,ig2,lg1,lg2,cg1,
00055      +       cg2,qanti
00056 C     ..
00057 C     .. Save statement ..
00058       SAVE /globe/
00059 C     ..
00060 C     .. Executable Statements ..
00061 C     Abort unless random number generator initialized
00062       IF (qrgnin()) GO TO 10
00063       WRITE (*,*) ' SETSD called before random number generator ',
00064      +  ' initialized -- abort!'
00065       CALL XSTOPX 
00066      + (' SETSD called before random number generator initialized')
00067 
00068    10 CALL getcgn(g)
00069       ig1(g) = iseed1
00070       ig2(g) = iseed2
00071       CALL initgn(-1)
00072       RETURN
00073 
00074       END