home *** CD-ROM | disk | FTP | other *** search
/ Geek Gadgets 1 / ADE-1.bin / ade-dist / octave-1.1.1p1-src.tgz / tar.out / fsf / octave / libcruft / ranlib / setant.f < prev    next >
Text File  |  1996-09-28  |  2KB  |  76 lines
  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!'
  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.