You can not select more than 25 topics Topics must start with a chinese character,a letter or number, can include dashes ('-') and can be up to 35 characters long.

slarnv.f 4.7 kB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175
  1. *> \brief \b SLARNV returns a vector of random numbers from a uniform or normal distribution.
  2. *
  3. * =========== DOCUMENTATION ===========
  4. *
  5. * Online html documentation available at
  6. * http://www.netlib.org/lapack/explore-html/
  7. *
  8. *> \htmlonly
  9. *> Download SLARNV + dependencies
  10. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slarnv.f">
  11. *> [TGZ]</a>
  12. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slarnv.f">
  13. *> [ZIP]</a>
  14. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slarnv.f">
  15. *> [TXT]</a>
  16. *> \endhtmlonly
  17. *
  18. * Definition:
  19. * ===========
  20. *
  21. * SUBROUTINE SLARNV( IDIST, ISEED, N, X )
  22. *
  23. * .. Scalar Arguments ..
  24. * INTEGER IDIST, N
  25. * ..
  26. * .. Array Arguments ..
  27. * INTEGER ISEED( 4 )
  28. * REAL X( * )
  29. * ..
  30. *
  31. *
  32. *> \par Purpose:
  33. * =============
  34. *>
  35. *> \verbatim
  36. *>
  37. *> SLARNV returns a vector of n random real numbers from a uniform or
  38. *> normal distribution.
  39. *> \endverbatim
  40. *
  41. * Arguments:
  42. * ==========
  43. *
  44. *> \param[in] IDIST
  45. *> \verbatim
  46. *> IDIST is INTEGER
  47. *> Specifies the distribution of the random numbers:
  48. *> = 1: uniform (0,1)
  49. *> = 2: uniform (-1,1)
  50. *> = 3: normal (0,1)
  51. *> \endverbatim
  52. *>
  53. *> \param[in,out] ISEED
  54. *> \verbatim
  55. *> ISEED is INTEGER array, dimension (4)
  56. *> On entry, the seed of the random number generator; the array
  57. *> elements must be between 0 and 4095, and ISEED(4) must be
  58. *> odd.
  59. *> On exit, the seed is updated.
  60. *> \endverbatim
  61. *>
  62. *> \param[in] N
  63. *> \verbatim
  64. *> N is INTEGER
  65. *> The number of random numbers to be generated.
  66. *> \endverbatim
  67. *>
  68. *> \param[out] X
  69. *> \verbatim
  70. *> X is REAL array, dimension (N)
  71. *> The generated random numbers.
  72. *> \endverbatim
  73. *
  74. * Authors:
  75. * ========
  76. *
  77. *> \author Univ. of Tennessee
  78. *> \author Univ. of California Berkeley
  79. *> \author Univ. of Colorado Denver
  80. *> \author NAG Ltd.
  81. *
  82. *> \ingroup OTHERauxiliary
  83. *
  84. *> \par Further Details:
  85. * =====================
  86. *>
  87. *> \verbatim
  88. *>
  89. *> This routine calls the auxiliary routine SLARUV to generate random
  90. *> real numbers from a uniform (0,1) distribution, in batches of up to
  91. *> 128 using vectorisable code. The Box-Muller method is used to
  92. *> transform numbers from a uniform to a normal distribution.
  93. *> \endverbatim
  94. *>
  95. * =====================================================================
  96. SUBROUTINE SLARNV( IDIST, ISEED, N, X )
  97. *
  98. * -- LAPACK auxiliary routine --
  99. * -- LAPACK is a software package provided by Univ. of Tennessee, --
  100. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  101. *
  102. * .. Scalar Arguments ..
  103. INTEGER IDIST, N
  104. * ..
  105. * .. Array Arguments ..
  106. INTEGER ISEED( 4 )
  107. REAL X( * )
  108. * ..
  109. *
  110. * =====================================================================
  111. *
  112. * .. Parameters ..
  113. REAL ONE, TWO
  114. PARAMETER ( ONE = 1.0E+0, TWO = 2.0E+0 )
  115. INTEGER LV
  116. PARAMETER ( LV = 128 )
  117. REAL TWOPI
  118. PARAMETER ( TWOPI = 6.28318530717958647692528676655900576839E+0 )
  119. * ..
  120. * .. Local Scalars ..
  121. INTEGER I, IL, IL2, IV
  122. * ..
  123. * .. Local Arrays ..
  124. REAL U( LV )
  125. * ..
  126. * .. Intrinsic Functions ..
  127. INTRINSIC COS, LOG, MIN, SQRT
  128. * ..
  129. * .. External Subroutines ..
  130. EXTERNAL SLARUV
  131. * ..
  132. * .. Executable Statements ..
  133. *
  134. DO 40 IV = 1, N, LV / 2
  135. IL = MIN( LV / 2, N-IV+1 )
  136. IF( IDIST.EQ.3 ) THEN
  137. IL2 = 2*IL
  138. ELSE
  139. IL2 = IL
  140. END IF
  141. *
  142. * Call SLARUV to generate IL2 numbers from a uniform (0,1)
  143. * distribution (IL2 <= LV)
  144. *
  145. CALL SLARUV( ISEED, IL2, U )
  146. *
  147. IF( IDIST.EQ.1 ) THEN
  148. *
  149. * Copy generated numbers
  150. *
  151. DO 10 I = 1, IL
  152. X( IV+I-1 ) = U( I )
  153. 10 CONTINUE
  154. ELSE IF( IDIST.EQ.2 ) THEN
  155. *
  156. * Convert generated numbers to uniform (-1,1) distribution
  157. *
  158. DO 20 I = 1, IL
  159. X( IV+I-1 ) = TWO*U( I ) - ONE
  160. 20 CONTINUE
  161. ELSE IF( IDIST.EQ.3 ) THEN
  162. *
  163. * Convert generated numbers to normal (0,1) distribution
  164. *
  165. DO 30 I = 1, IL
  166. X( IV+I-1 ) = SQRT( -TWO*LOG( U( 2*I-1 ) ) )*
  167. $ COS( TWOPI*U( 2*I ) )
  168. 30 CONTINUE
  169. END IF
  170. 40 CONTINUE
  171. RETURN
  172. *
  173. * End of SLARNV
  174. *
  175. END