Mercurial > octave-nkf
annotate liboctave/cruft/ranlib/setsd.f @ 20654:b65888ec820e draft default tip gccjit
dmalcom gcc jit import
author | Stefan Mahr <dac922@gmx.de> |
---|---|
date | Fri, 27 Feb 2015 16:59:36 +0100 |
parents | 446c46af4b42 |
children |
rev | line source |
---|---|
2329 | 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 WRITE (*,*) ' SETSD called before random number generator ', | |
64 + ' initialized -- abort!' | |
19627
446c46af4b42
strip trailing whitespace from most source files
John W. Eaton <jwe@octave.org>
parents:
15271
diff
changeset
|
65 CALL XSTOPX |
10103
0e71ead7359d
Use CALL XSTOPX instead of STOP in Fortran ranlib routines
Rik <rdrider0-list@yahoo.com>
parents:
3188
diff
changeset
|
66 + (' SETSD called before random number generator initialized') |
2329 | 67 |
68 10 CALL getcgn(g) | |
69 ig1(g) = iseed1 | |
70 ig2(g) = iseed2 | |
71 CALL initgn(-1) | |
72 RETURN | |
73 | |
74 END |