2329
|
1 SUBROUTINE setant(qvalue) |
|
2 C********************************************************************** |
|
3 C |
|
4 C SUBROUTINE SETANT(QVALUE) |
|
5 C SET ANTithetic |
|
6 C |
|
7 C Sets whether the current generator produces antithetic values. If |
|
8 C X is the value normally returned from a uniform [0,1] random |
|
9 C number generator then 1 - X is the antithetic value. If X is the |
|
10 C value normally returned from a uniform [0,N] random number |
|
11 C generator then N - 1 - X is the antithetic value. |
|
12 C |
|
13 C All generators are initialized to NOT generate antithetic values. |
|
14 C |
|
15 C This is a transcription from Pascal to Fortran of routine |
|
16 C Set_Antithetic from the paper |
|
17 C |
|
18 C L'Ecuyer, P. and Cote, S. "Implementing a Random Number Package |
|
19 C with Splitting Facilities." ACM Transactions on Mathematical |
|
20 C Software, 17:98-111 (1991) |
|
21 C |
|
22 C |
|
23 C Arguments |
|
24 C |
|
25 C |
|
26 C QVALUE -> .TRUE. if generator G is to generating antithetic |
|
27 C values, otherwise .FALSE. |
|
28 C LOGICAL QVALUE |
|
29 C |
|
30 C********************************************************************** |
|
31 C .. Parameters .. |
|
32 INTEGER numg |
|
33 PARAMETER (numg=32) |
|
34 C .. |
|
35 C .. Scalar Arguments .. |
|
36 LOGICAL qvalue |
|
37 C .. |
|
38 C .. Scalars in Common .. |
|
39 INTEGER a1,a1vw,a1w,a2,a2vw,a2w,m1,m2 |
|
40 C .. |
|
41 C .. Arrays in Common .. |
|
42 INTEGER cg1(numg),cg2(numg),ig1(numg),ig2(numg),lg1(numg), |
|
43 + lg2(numg) |
|
44 LOGICAL qanti(numg) |
|
45 C .. |
|
46 C .. Local Scalars .. |
|
47 INTEGER g |
|
48 C .. |
|
49 C .. External Functions .. |
|
50 LOGICAL qrgnin |
|
51 EXTERNAL qrgnin |
|
52 C .. |
|
53 C .. External Subroutines .. |
|
54 EXTERNAL getcgn |
|
55 C .. |
|
56 C .. Common blocks .. |
|
57 COMMON /globe/m1,m2,a1,a2,a1w,a2w,a1vw,a2vw,ig1,ig2,lg1,lg2,cg1, |
|
58 + cg2,qanti |
|
59 C .. |
|
60 C .. Save statement .. |
|
61 SAVE /globe/ |
|
62 C .. |
|
63 C .. Executable Statements .. |
|
64 C Abort unless random number generator initialized |
|
65 IF (qrgnin()) GO TO 10 |
|
66 WRITE (*,*) ' SETANT called before random number generator ', |
|
67 + ' initialized -- abort!' |
3188
|
68 STOP ' SETANT called before random number generator initialized' |
2329
|
69 |
|
70 10 CALL getcgn(g) |
|
71 qanti(g) = qvalue |
|
72 RETURN |
|
73 |
|
74 END |