Mercurial > octave
diff libcruft/ranlib/getsd.f @ 2329:30c606bec7a8
[project @ 1996-07-19 01:29:05 by jwe]
Initial revision
author | jwe |
---|---|
date | Fri, 19 Jul 1996 01:29:55 +0000 |
parents | |
children | df7c57a6639d |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libcruft/ranlib/getsd.f Fri Jul 19 01:29:55 1996 +0000 @@ -0,0 +1,73 @@ + SUBROUTINE getsd(iseed1,iseed2) +C********************************************************************** +C +C SUBROUTINE GETSD(ISEED1,ISEED2) +C GET SeeD +C +C Returns the value of two integer seeds of the current generator +C +C This is a transcription from Pascal to Fortran of routine +C Get_State from the paper +C +C L'Ecuyer, P. and Cote, S. "Implementing a Random Number Package +C with Splitting Facilities." ACM Transactions on Mathematical +C Software, 17:98-111 (1991) +C +C +C Arguments +C +C +C +C ISEED1 <- First integer seed of generator G +C INTEGER ISEED1 +C +C ISEED2 <- Second integer seed of generator G +C INTEGER ISEED1 +C +C********************************************************************** +C .. Parameters .. + INTEGER numg + PARAMETER (numg=32) +C .. +C .. Scalar Arguments .. + INTEGER iseed1,iseed2 +C .. +C .. Scalars in Common .. + INTEGER a1,a1vw,a1w,a2,a2vw,a2w,m1,m2 +C .. +C .. Arrays in Common .. + INTEGER cg1(numg),cg2(numg),ig1(numg),ig2(numg),lg1(numg), + + lg2(numg) + LOGICAL qanti(numg) +C .. +C .. Local Scalars .. + INTEGER g +C .. +C .. External Functions .. + LOGICAL qrgnin + EXTERNAL qrgnin +C .. +C .. External Subroutines .. + EXTERNAL getcgn +C .. +C .. Common blocks .. + COMMON /globe/m1,m2,a1,a2,a1w,a2w,a1vw,a2vw,ig1,ig2,lg1,lg2,cg1, + + cg2,qanti +C .. +C .. Save statement .. + SAVE /globe/ +C .. +C .. Executable Statements .. +C Abort unless random number generator initialized + IF (qrgnin()) GO TO 10 + WRITE (*,*) ' GETSD called before random number generator ', + + ' initialized -- abort!' + CALL XSTOPX + + (' GETSD called before random number generator initialized') + + 10 CALL getcgn(g) + iseed1 = cg1(g) + iseed2 = cg2(g) + RETURN + + END