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.8 kB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178
  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. *> \date December 2016
  83. *
  84. *> \ingroup OTHERauxiliary
  85. *
  86. *> \par Further Details:
  87. * =====================
  88. *>
  89. *> \verbatim
  90. *>
  91. *> This routine calls the auxiliary routine SLARUV to generate random
  92. *> real numbers from a uniform (0,1) distribution, in batches of up to
  93. *> 128 using vectorisable code. The Box-Muller method is used to
  94. *> transform numbers from a uniform to a normal distribution.
  95. *> \endverbatim
  96. *>
  97. * =====================================================================
  98. SUBROUTINE SLARNV( IDIST, ISEED, N, X )
  99. *
  100. * -- LAPACK auxiliary routine (version 3.7.0) --
  101. * -- LAPACK is a software package provided by Univ. of Tennessee, --
  102. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  103. * December 2016
  104. *
  105. * .. Scalar Arguments ..
  106. INTEGER IDIST, N
  107. * ..
  108. * .. Array Arguments ..
  109. INTEGER ISEED( 4 )
  110. REAL X( * )
  111. * ..
  112. *
  113. * =====================================================================
  114. *
  115. * .. Parameters ..
  116. REAL ONE, TWO
  117. PARAMETER ( ONE = 1.0E+0, TWO = 2.0E+0 )
  118. INTEGER LV
  119. PARAMETER ( LV = 128 )
  120. REAL TWOPI
  121. PARAMETER ( TWOPI = 6.2831853071795864769252867663E+0 )
  122. * ..
  123. * .. Local Scalars ..
  124. INTEGER I, IL, IL2, IV
  125. * ..
  126. * .. Local Arrays ..
  127. REAL U( LV )
  128. * ..
  129. * .. Intrinsic Functions ..
  130. INTRINSIC COS, LOG, MIN, SQRT
  131. * ..
  132. * .. External Subroutines ..
  133. EXTERNAL SLARUV
  134. * ..
  135. * .. Executable Statements ..
  136. *
  137. DO 40 IV = 1, N, LV / 2
  138. IL = MIN( LV / 2, N-IV+1 )
  139. IF( IDIST.EQ.3 ) THEN
  140. IL2 = 2*IL
  141. ELSE
  142. IL2 = IL
  143. END IF
  144. *
  145. * Call SLARUV to generate IL2 numbers from a uniform (0,1)
  146. * distribution (IL2 <= LV)
  147. *
  148. CALL SLARUV( ISEED, IL2, U )
  149. *
  150. IF( IDIST.EQ.1 ) THEN
  151. *
  152. * Copy generated numbers
  153. *
  154. DO 10 I = 1, IL
  155. X( IV+I-1 ) = U( I )
  156. 10 CONTINUE
  157. ELSE IF( IDIST.EQ.2 ) THEN
  158. *
  159. * Convert generated numbers to uniform (-1,1) distribution
  160. *
  161. DO 20 I = 1, IL
  162. X( IV+I-1 ) = TWO*U( I ) - ONE
  163. 20 CONTINUE
  164. ELSE IF( IDIST.EQ.3 ) THEN
  165. *
  166. * Convert generated numbers to normal (0,1) distribution
  167. *
  168. DO 30 I = 1, IL
  169. X( IV+I-1 ) = SQRT( -TWO*LOG( U( 2*I-1 ) ) )*
  170. $ COS( TWOPI*U( 2*I ) )
  171. 30 CONTINUE
  172. END IF
  173. 40 CONTINUE
  174. RETURN
  175. *
  176. * End of SLARNV
  177. *
  178. END