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