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