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

Go to the documentation of this file.
00001       SUBROUTINE advnst(k)
00002 C**********************************************************************
00003 C
00004 C     SUBROUTINE ADVNST(K)
00005 C               ADV-a-N-ce ST-ate
00006 C
00007 C     Advances the state  of  the current  generator  by 2^K values  and
00008 C     resets the initial seed to that value.
00009 C
00010 C     This is  a  transcription from   Pascal to  Fortran    of  routine
00011 C     Advance_State 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     K -> The generator is advanced by2^K values
00022 C                                   INTEGER K
00023 C
00024 C**********************************************************************
00025 C     .. Parameters ..
00026       INTEGER numg
00027       PARAMETER (numg=32)
00028 C     ..
00029 C     .. Scalar Arguments ..
00030       INTEGER k
00031 C     ..
00032 C     .. Scalars in Common ..
00033       INTEGER a1,a1vw,a1w,a2,a2vw,a2w,m1,m2
00034 C     ..
00035 C     .. Arrays in Common ..
00036       INTEGER cg1(numg),cg2(numg),ig1(numg),ig2(numg),lg1(numg),
00037      +        lg2(numg)
00038       LOGICAL qanti(numg)
00039 C     ..
00040 C     .. Local Scalars ..
00041       INTEGER g,i,ib1,ib2
00042 C     ..
00043 C     .. External Functions ..
00044       INTEGER mltmod
00045       LOGICAL qrgnin
00046       EXTERNAL mltmod,qrgnin
00047 C     ..
00048 C     .. External Subroutines ..
00049       EXTERNAL getcgn,setsd
00050 C     ..
00051 C     .. Common blocks ..
00052       COMMON /globe/m1,m2,a1,a2,a1w,a2w,a1vw,a2vw,ig1,ig2,lg1,lg2,cg1,
00053      +       cg2,qanti
00054 C     ..
00055 C     .. Save statement ..
00056       SAVE /globe/
00057 C     ..
00058 C     .. Executable Statements ..
00059 C     Abort unless random number generator initialized
00060       IF (qrgnin()) GO TO 10
00061       WRITE (*,*) ' ADVNST called before random number generator ',
00062      +  ' initialized -- abort!'
00063       CALL XSTOPX
00064      + (' ADVNST called before random number generator initialized')
00065 
00066    10 CALL getcgn(g)
00067 C
00068       ib1 = a1
00069       ib2 = a2
00070       DO 20,i = 1,k
00071           ib1 = mltmod(ib1,ib1,m1)
00072           ib2 = mltmod(ib2,ib2,m2)
00073    20 CONTINUE
00074       CALL setsd(mltmod(ib1,cg1(g),m1),mltmod(ib2,cg2(g),m2))
00075 C
00076 C     NOW, IB1 = A1**K AND IB2 = A2**K
00077 C
00078       RETURN
00079 
00080       END