Mercurial > octave
comparison 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 |
comparison
equal
deleted
inserted
replaced
| 2328:b44c3b2a5fce | 2329:30c606bec7a8 |
|---|---|
| 1 SUBROUTINE getsd(iseed1,iseed2) | |
| 2 C********************************************************************** | |
| 3 C | |
| 4 C SUBROUTINE GETSD(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 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 | |
| 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 WRITE (*,*) ' GETSD called before random number generator ', | |
| 64 + ' initialized -- abort!' | |
| 65 CALL XSTOPX | |
| 66 + (' GETSD called before random number generator initialized') | |
| 67 | |
| 68 10 CALL getcgn(g) | |
| 69 iseed1 = cg1(g) | |
| 70 iseed2 = cg2(g) | |
| 71 RETURN | |
| 72 | |
| 73 END |