00001 SUBROUTINE setant(qvalue) 00002 C********************************************************************** 00003 C 00004 C SUBROUTINE SETANT(QVALUE) 00005 C SET ANTithetic 00006 C 00007 C Sets whether the current generator produces antithetic values. If 00008 C X is the value normally returned from a uniform [0,1] random 00009 C number generator then 1 - X is the antithetic value. If X is the 00010 C value normally returned from a uniform [0,N] random number 00011 C generator then N - 1 - X is the antithetic value. 00012 C 00013 C All generators are initialized to NOT generate antithetic values. 00014 C 00015 C This is a transcription from Pascal to Fortran of routine 00016 C Set_Antithetic from the paper 00017 C 00018 C L'Ecuyer, P. and Cote, S. "Implementing a Random Number Package 00019 C with Splitting Facilities." ACM Transactions on Mathematical 00020 C Software, 17:98-111 (1991) 00021 C 00022 C 00023 C Arguments 00024 C 00025 C 00026 C QVALUE -> .TRUE. if generator G is to generating antithetic 00027 C values, otherwise .FALSE. 00028 C LOGICAL QVALUE 00029 C 00030 C********************************************************************** 00031 C .. Parameters .. 00032 INTEGER numg 00033 PARAMETER (numg=32) 00034 C .. 00035 C .. Scalar Arguments .. 00036 LOGICAL qvalue 00037 C .. 00038 C .. Scalars in Common .. 00039 INTEGER a1,a1vw,a1w,a2,a2vw,a2w,m1,m2 00040 C .. 00041 C .. Arrays in Common .. 00042 INTEGER cg1(numg),cg2(numg),ig1(numg),ig2(numg),lg1(numg), 00043 + lg2(numg) 00044 LOGICAL qanti(numg) 00045 C .. 00046 C .. Local Scalars .. 00047 INTEGER g 00048 C .. 00049 C .. External Functions .. 00050 LOGICAL qrgnin 00051 EXTERNAL qrgnin 00052 C .. 00053 C .. External Subroutines .. 00054 EXTERNAL getcgn 00055 C .. 00056 C .. Common blocks .. 00057 COMMON /globe/m1,m2,a1,a2,a1w,a2w,a1vw,a2vw,ig1,ig2,lg1,lg2,cg1, 00058 + cg2,qanti 00059 C .. 00060 C .. Save statement .. 00061 SAVE /globe/ 00062 C .. 00063 C .. Executable Statements .. 00064 C Abort unless random number generator initialized 00065 IF (qrgnin()) GO TO 10 00066 WRITE (*,*) ' SETANT called before random number generator ', 00067 + ' initialized -- abort!' 00068 CALL XSTOPX 00069 + (' SETANT called before random number generator initialized') 00070 00071 10 CALL getcgn(g) 00072 qanti(g) = qvalue 00073 RETURN 00074 00075 END
1.7.1
