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.

slaruv.f 19 kB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447
  1. *> \brief \b SLARUV returns a vector of n random real numbers from a uniform distribution.
  2. *
  3. * =========== DOCUMENTATION ===========
  4. *
  5. * Online html documentation available at
  6. * http://www.netlib.org/lapack/explore-html/
  7. *
  8. *> \htmlonly
  9. *> Download SLARUV + dependencies
  10. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slaruv.f">
  11. *> [TGZ]</a>
  12. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slaruv.f">
  13. *> [ZIP]</a>
  14. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slaruv.f">
  15. *> [TXT]</a>
  16. *> \endhtmlonly
  17. *
  18. * Definition:
  19. * ===========
  20. *
  21. * SUBROUTINE SLARUV( ISEED, N, X )
  22. *
  23. * .. Scalar Arguments ..
  24. * INTEGER N
  25. * ..
  26. * .. Array Arguments ..
  27. * INTEGER ISEED( 4 )
  28. * REAL X( N )
  29. * ..
  30. *
  31. *
  32. *> \par Purpose:
  33. * =============
  34. *>
  35. *> \verbatim
  36. *>
  37. *> SLARUV returns a vector of n random real numbers from a uniform (0,1)
  38. *> distribution (n <= 128).
  39. *>
  40. *> This is an auxiliary routine called by SLARNV and CLARNV.
  41. *> \endverbatim
  42. *
  43. * Arguments:
  44. * ==========
  45. *
  46. *> \param[in,out] ISEED
  47. *> \verbatim
  48. *> ISEED is INTEGER array, dimension (4)
  49. *> On entry, the seed of the random number generator; the array
  50. *> elements must be between 0 and 4095, and ISEED(4) must be
  51. *> odd.
  52. *> On exit, the seed is updated.
  53. *> \endverbatim
  54. *>
  55. *> \param[in] N
  56. *> \verbatim
  57. *> N is INTEGER
  58. *> The number of random numbers to be generated. N <= 128.
  59. *> \endverbatim
  60. *>
  61. *> \param[out] X
  62. *> \verbatim
  63. *> X is REAL array, dimension (N)
  64. *> The generated random numbers.
  65. *> \endverbatim
  66. *
  67. * Authors:
  68. * ========
  69. *
  70. *> \author Univ. of Tennessee
  71. *> \author Univ. of California Berkeley
  72. *> \author Univ. of Colorado Denver
  73. *> \author NAG Ltd.
  74. *
  75. *> \date December 2016
  76. *
  77. *> \ingroup OTHERauxiliary
  78. *
  79. *> \par Further Details:
  80. * =====================
  81. *>
  82. *> \verbatim
  83. *>
  84. *> This routine uses a multiplicative congruential method with modulus
  85. *> 2**48 and multiplier 33952834046453 (see G.S.Fishman,
  86. *> 'Multiplicative congruential random number generators with modulus
  87. *> 2**b: an exhaustive analysis for b = 32 and a partial analysis for
  88. *> b = 48', Math. Comp. 189, pp 331-344, 1990).
  89. *>
  90. *> 48-bit integers are stored in 4 integer array elements with 12 bits
  91. *> per element. Hence the routine is portable across machines with
  92. *> integers of 32 bits or more.
  93. *> \endverbatim
  94. *>
  95. * =====================================================================
  96. SUBROUTINE SLARUV( ISEED, N, X )
  97. *
  98. * -- LAPACK auxiliary routine (version 3.7.0) --
  99. * -- LAPACK is a software package provided by Univ. of Tennessee, --
  100. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  101. * December 2016
  102. *
  103. * .. Scalar Arguments ..
  104. INTEGER N
  105. * ..
  106. * .. Array Arguments ..
  107. INTEGER ISEED( 4 )
  108. REAL X( N )
  109. * ..
  110. *
  111. * =====================================================================
  112. *
  113. * .. Parameters ..
  114. REAL ONE
  115. PARAMETER ( ONE = 1.0E0 )
  116. INTEGER LV, IPW2
  117. REAL R
  118. PARAMETER ( LV = 128, IPW2 = 4096, R = ONE / IPW2 )
  119. * ..
  120. * .. Local Scalars ..
  121. INTEGER I, I1, I2, I3, I4, IT1, IT2, IT3, IT4, J
  122. * ..
  123. * .. Local Arrays ..
  124. INTEGER MM( LV, 4 )
  125. * ..
  126. * .. Intrinsic Functions ..
  127. INTRINSIC MIN, MOD, REAL
  128. * ..
  129. * .. Data statements ..
  130. DATA ( MM( 1, J ), J = 1, 4 ) / 494, 322, 2508,
  131. $ 2549 /
  132. DATA ( MM( 2, J ), J = 1, 4 ) / 2637, 789, 3754,
  133. $ 1145 /
  134. DATA ( MM( 3, J ), J = 1, 4 ) / 255, 1440, 1766,
  135. $ 2253 /
  136. DATA ( MM( 4, J ), J = 1, 4 ) / 2008, 752, 3572,
  137. $ 305 /
  138. DATA ( MM( 5, J ), J = 1, 4 ) / 1253, 2859, 2893,
  139. $ 3301 /
  140. DATA ( MM( 6, J ), J = 1, 4 ) / 3344, 123, 307,
  141. $ 1065 /
  142. DATA ( MM( 7, J ), J = 1, 4 ) / 4084, 1848, 1297,
  143. $ 3133 /
  144. DATA ( MM( 8, J ), J = 1, 4 ) / 1739, 643, 3966,
  145. $ 2913 /
  146. DATA ( MM( 9, J ), J = 1, 4 ) / 3143, 2405, 758,
  147. $ 3285 /
  148. DATA ( MM( 10, J ), J = 1, 4 ) / 3468, 2638, 2598,
  149. $ 1241 /
  150. DATA ( MM( 11, J ), J = 1, 4 ) / 688, 2344, 3406,
  151. $ 1197 /
  152. DATA ( MM( 12, J ), J = 1, 4 ) / 1657, 46, 2922,
  153. $ 3729 /
  154. DATA ( MM( 13, J ), J = 1, 4 ) / 1238, 3814, 1038,
  155. $ 2501 /
  156. DATA ( MM( 14, J ), J = 1, 4 ) / 3166, 913, 2934,
  157. $ 1673 /
  158. DATA ( MM( 15, J ), J = 1, 4 ) / 1292, 3649, 2091,
  159. $ 541 /
  160. DATA ( MM( 16, J ), J = 1, 4 ) / 3422, 339, 2451,
  161. $ 2753 /
  162. DATA ( MM( 17, J ), J = 1, 4 ) / 1270, 3808, 1580,
  163. $ 949 /
  164. DATA ( MM( 18, J ), J = 1, 4 ) / 2016, 822, 1958,
  165. $ 2361 /
  166. DATA ( MM( 19, J ), J = 1, 4 ) / 154, 2832, 2055,
  167. $ 1165 /
  168. DATA ( MM( 20, J ), J = 1, 4 ) / 2862, 3078, 1507,
  169. $ 4081 /
  170. DATA ( MM( 21, J ), J = 1, 4 ) / 697, 3633, 1078,
  171. $ 2725 /
  172. DATA ( MM( 22, J ), J = 1, 4 ) / 1706, 2970, 3273,
  173. $ 3305 /
  174. DATA ( MM( 23, J ), J = 1, 4 ) / 491, 637, 17,
  175. $ 3069 /
  176. DATA ( MM( 24, J ), J = 1, 4 ) / 931, 2249, 854,
  177. $ 3617 /
  178. DATA ( MM( 25, J ), J = 1, 4 ) / 1444, 2081, 2916,
  179. $ 3733 /
  180. DATA ( MM( 26, J ), J = 1, 4 ) / 444, 4019, 3971,
  181. $ 409 /
  182. DATA ( MM( 27, J ), J = 1, 4 ) / 3577, 1478, 2889,
  183. $ 2157 /
  184. DATA ( MM( 28, J ), J = 1, 4 ) / 3944, 242, 3831,
  185. $ 1361 /
  186. DATA ( MM( 29, J ), J = 1, 4 ) / 2184, 481, 2621,
  187. $ 3973 /
  188. DATA ( MM( 30, J ), J = 1, 4 ) / 1661, 2075, 1541,
  189. $ 1865 /
  190. DATA ( MM( 31, J ), J = 1, 4 ) / 3482, 4058, 893,
  191. $ 2525 /
  192. DATA ( MM( 32, J ), J = 1, 4 ) / 657, 622, 736,
  193. $ 1409 /
  194. DATA ( MM( 33, J ), J = 1, 4 ) / 3023, 3376, 3992,
  195. $ 3445 /
  196. DATA ( MM( 34, J ), J = 1, 4 ) / 3618, 812, 787,
  197. $ 3577 /
  198. DATA ( MM( 35, J ), J = 1, 4 ) / 1267, 234, 2125,
  199. $ 77 /
  200. DATA ( MM( 36, J ), J = 1, 4 ) / 1828, 641, 2364,
  201. $ 3761 /
  202. DATA ( MM( 37, J ), J = 1, 4 ) / 164, 4005, 2460,
  203. $ 2149 /
  204. DATA ( MM( 38, J ), J = 1, 4 ) / 3798, 1122, 257,
  205. $ 1449 /
  206. DATA ( MM( 39, J ), J = 1, 4 ) / 3087, 3135, 1574,
  207. $ 3005 /
  208. DATA ( MM( 40, J ), J = 1, 4 ) / 2400, 2640, 3912,
  209. $ 225 /
  210. DATA ( MM( 41, J ), J = 1, 4 ) / 2870, 2302, 1216,
  211. $ 85 /
  212. DATA ( MM( 42, J ), J = 1, 4 ) / 3876, 40, 3248,
  213. $ 3673 /
  214. DATA ( MM( 43, J ), J = 1, 4 ) / 1905, 1832, 3401,
  215. $ 3117 /
  216. DATA ( MM( 44, J ), J = 1, 4 ) / 1593, 2247, 2124,
  217. $ 3089 /
  218. DATA ( MM( 45, J ), J = 1, 4 ) / 1797, 2034, 2762,
  219. $ 1349 /
  220. DATA ( MM( 46, J ), J = 1, 4 ) / 1234, 2637, 149,
  221. $ 2057 /
  222. DATA ( MM( 47, J ), J = 1, 4 ) / 3460, 1287, 2245,
  223. $ 413 /
  224. DATA ( MM( 48, J ), J = 1, 4 ) / 328, 1691, 166,
  225. $ 65 /
  226. DATA ( MM( 49, J ), J = 1, 4 ) / 2861, 496, 466,
  227. $ 1845 /
  228. DATA ( MM( 50, J ), J = 1, 4 ) / 1950, 1597, 4018,
  229. $ 697 /
  230. DATA ( MM( 51, J ), J = 1, 4 ) / 617, 2394, 1399,
  231. $ 3085 /
  232. DATA ( MM( 52, J ), J = 1, 4 ) / 2070, 2584, 190,
  233. $ 3441 /
  234. DATA ( MM( 53, J ), J = 1, 4 ) / 3331, 1843, 2879,
  235. $ 1573 /
  236. DATA ( MM( 54, J ), J = 1, 4 ) / 769, 336, 153,
  237. $ 3689 /
  238. DATA ( MM( 55, J ), J = 1, 4 ) / 1558, 1472, 2320,
  239. $ 2941 /
  240. DATA ( MM( 56, J ), J = 1, 4 ) / 2412, 2407, 18,
  241. $ 929 /
  242. DATA ( MM( 57, J ), J = 1, 4 ) / 2800, 433, 712,
  243. $ 533 /
  244. DATA ( MM( 58, J ), J = 1, 4 ) / 189, 2096, 2159,
  245. $ 2841 /
  246. DATA ( MM( 59, J ), J = 1, 4 ) / 287, 1761, 2318,
  247. $ 4077 /
  248. DATA ( MM( 60, J ), J = 1, 4 ) / 2045, 2810, 2091,
  249. $ 721 /
  250. DATA ( MM( 61, J ), J = 1, 4 ) / 1227, 566, 3443,
  251. $ 2821 /
  252. DATA ( MM( 62, J ), J = 1, 4 ) / 2838, 442, 1510,
  253. $ 2249 /
  254. DATA ( MM( 63, J ), J = 1, 4 ) / 209, 41, 449,
  255. $ 2397 /
  256. DATA ( MM( 64, J ), J = 1, 4 ) / 2770, 1238, 1956,
  257. $ 2817 /
  258. DATA ( MM( 65, J ), J = 1, 4 ) / 3654, 1086, 2201,
  259. $ 245 /
  260. DATA ( MM( 66, J ), J = 1, 4 ) / 3993, 603, 3137,
  261. $ 1913 /
  262. DATA ( MM( 67, J ), J = 1, 4 ) / 192, 840, 3399,
  263. $ 1997 /
  264. DATA ( MM( 68, J ), J = 1, 4 ) / 2253, 3168, 1321,
  265. $ 3121 /
  266. DATA ( MM( 69, J ), J = 1, 4 ) / 3491, 1499, 2271,
  267. $ 997 /
  268. DATA ( MM( 70, J ), J = 1, 4 ) / 2889, 1084, 3667,
  269. $ 1833 /
  270. DATA ( MM( 71, J ), J = 1, 4 ) / 2857, 3438, 2703,
  271. $ 2877 /
  272. DATA ( MM( 72, J ), J = 1, 4 ) / 2094, 2408, 629,
  273. $ 1633 /
  274. DATA ( MM( 73, J ), J = 1, 4 ) / 1818, 1589, 2365,
  275. $ 981 /
  276. DATA ( MM( 74, J ), J = 1, 4 ) / 688, 2391, 2431,
  277. $ 2009 /
  278. DATA ( MM( 75, J ), J = 1, 4 ) / 1407, 288, 1113,
  279. $ 941 /
  280. DATA ( MM( 76, J ), J = 1, 4 ) / 634, 26, 3922,
  281. $ 2449 /
  282. DATA ( MM( 77, J ), J = 1, 4 ) / 3231, 512, 2554,
  283. $ 197 /
  284. DATA ( MM( 78, J ), J = 1, 4 ) / 815, 1456, 184,
  285. $ 2441 /
  286. DATA ( MM( 79, J ), J = 1, 4 ) / 3524, 171, 2099,
  287. $ 285 /
  288. DATA ( MM( 80, J ), J = 1, 4 ) / 1914, 1677, 3228,
  289. $ 1473 /
  290. DATA ( MM( 81, J ), J = 1, 4 ) / 516, 2657, 4012,
  291. $ 2741 /
  292. DATA ( MM( 82, J ), J = 1, 4 ) / 164, 2270, 1921,
  293. $ 3129 /
  294. DATA ( MM( 83, J ), J = 1, 4 ) / 303, 2587, 3452,
  295. $ 909 /
  296. DATA ( MM( 84, J ), J = 1, 4 ) / 2144, 2961, 3901,
  297. $ 2801 /
  298. DATA ( MM( 85, J ), J = 1, 4 ) / 3480, 1970, 572,
  299. $ 421 /
  300. DATA ( MM( 86, J ), J = 1, 4 ) / 119, 1817, 3309,
  301. $ 4073 /
  302. DATA ( MM( 87, J ), J = 1, 4 ) / 3357, 676, 3171,
  303. $ 2813 /
  304. DATA ( MM( 88, J ), J = 1, 4 ) / 837, 1410, 817,
  305. $ 2337 /
  306. DATA ( MM( 89, J ), J = 1, 4 ) / 2826, 3723, 3039,
  307. $ 1429 /
  308. DATA ( MM( 90, J ), J = 1, 4 ) / 2332, 2803, 1696,
  309. $ 1177 /
  310. DATA ( MM( 91, J ), J = 1, 4 ) / 2089, 3185, 1256,
  311. $ 1901 /
  312. DATA ( MM( 92, J ), J = 1, 4 ) / 3780, 184, 3715,
  313. $ 81 /
  314. DATA ( MM( 93, J ), J = 1, 4 ) / 1700, 663, 2077,
  315. $ 1669 /
  316. DATA ( MM( 94, J ), J = 1, 4 ) / 3712, 499, 3019,
  317. $ 2633 /
  318. DATA ( MM( 95, J ), J = 1, 4 ) / 150, 3784, 1497,
  319. $ 2269 /
  320. DATA ( MM( 96, J ), J = 1, 4 ) / 2000, 1631, 1101,
  321. $ 129 /
  322. DATA ( MM( 97, J ), J = 1, 4 ) / 3375, 1925, 717,
  323. $ 1141 /
  324. DATA ( MM( 98, J ), J = 1, 4 ) / 1621, 3912, 51,
  325. $ 249 /
  326. DATA ( MM( 99, J ), J = 1, 4 ) / 3090, 1398, 981,
  327. $ 3917 /
  328. DATA ( MM( 100, J ), J = 1, 4 ) / 3765, 1349, 1978,
  329. $ 2481 /
  330. DATA ( MM( 101, J ), J = 1, 4 ) / 1149, 1441, 1813,
  331. $ 3941 /
  332. DATA ( MM( 102, J ), J = 1, 4 ) / 3146, 2224, 3881,
  333. $ 2217 /
  334. DATA ( MM( 103, J ), J = 1, 4 ) / 33, 2411, 76,
  335. $ 2749 /
  336. DATA ( MM( 104, J ), J = 1, 4 ) / 3082, 1907, 3846,
  337. $ 3041 /
  338. DATA ( MM( 105, J ), J = 1, 4 ) / 2741, 3192, 3694,
  339. $ 1877 /
  340. DATA ( MM( 106, J ), J = 1, 4 ) / 359, 2786, 1682,
  341. $ 345 /
  342. DATA ( MM( 107, J ), J = 1, 4 ) / 3316, 382, 124,
  343. $ 2861 /
  344. DATA ( MM( 108, J ), J = 1, 4 ) / 1749, 37, 1660,
  345. $ 1809 /
  346. DATA ( MM( 109, J ), J = 1, 4 ) / 185, 759, 3997,
  347. $ 3141 /
  348. DATA ( MM( 110, J ), J = 1, 4 ) / 2784, 2948, 479,
  349. $ 2825 /
  350. DATA ( MM( 111, J ), J = 1, 4 ) / 2202, 1862, 1141,
  351. $ 157 /
  352. DATA ( MM( 112, J ), J = 1, 4 ) / 2199, 3802, 886,
  353. $ 2881 /
  354. DATA ( MM( 113, J ), J = 1, 4 ) / 1364, 2423, 3514,
  355. $ 3637 /
  356. DATA ( MM( 114, J ), J = 1, 4 ) / 1244, 2051, 1301,
  357. $ 1465 /
  358. DATA ( MM( 115, J ), J = 1, 4 ) / 2020, 2295, 3604,
  359. $ 2829 /
  360. DATA ( MM( 116, J ), J = 1, 4 ) / 3160, 1332, 1888,
  361. $ 2161 /
  362. DATA ( MM( 117, J ), J = 1, 4 ) / 2785, 1832, 1836,
  363. $ 3365 /
  364. DATA ( MM( 118, J ), J = 1, 4 ) / 2772, 2405, 1990,
  365. $ 361 /
  366. DATA ( MM( 119, J ), J = 1, 4 ) / 1217, 3638, 2058,
  367. $ 2685 /
  368. DATA ( MM( 120, J ), J = 1, 4 ) / 1822, 3661, 692,
  369. $ 3745 /
  370. DATA ( MM( 121, J ), J = 1, 4 ) / 1245, 327, 1194,
  371. $ 2325 /
  372. DATA ( MM( 122, J ), J = 1, 4 ) / 2252, 3660, 20,
  373. $ 3609 /
  374. DATA ( MM( 123, J ), J = 1, 4 ) / 3904, 716, 3285,
  375. $ 3821 /
  376. DATA ( MM( 124, J ), J = 1, 4 ) / 2774, 1842, 2046,
  377. $ 3537 /
  378. DATA ( MM( 125, J ), J = 1, 4 ) / 997, 3987, 2107,
  379. $ 517 /
  380. DATA ( MM( 126, J ), J = 1, 4 ) / 2573, 1368, 3508,
  381. $ 3017 /
  382. DATA ( MM( 127, J ), J = 1, 4 ) / 1148, 1848, 3525,
  383. $ 2141 /
  384. DATA ( MM( 128, J ), J = 1, 4 ) / 545, 2366, 3801,
  385. $ 1537 /
  386. * ..
  387. * .. Executable Statements ..
  388. *
  389. I1 = ISEED( 1 )
  390. I2 = ISEED( 2 )
  391. I3 = ISEED( 3 )
  392. I4 = ISEED( 4 )
  393. *
  394. DO 10 I = 1, MIN( N, LV )
  395. *
  396. 20 CONTINUE
  397. *
  398. * Multiply the seed by i-th power of the multiplier modulo 2**48
  399. *
  400. IT4 = I4*MM( I, 4 )
  401. IT3 = IT4 / IPW2
  402. IT4 = IT4 - IPW2*IT3
  403. IT3 = IT3 + I3*MM( I, 4 ) + I4*MM( I, 3 )
  404. IT2 = IT3 / IPW2
  405. IT3 = IT3 - IPW2*IT2
  406. IT2 = IT2 + I2*MM( I, 4 ) + I3*MM( I, 3 ) + I4*MM( I, 2 )
  407. IT1 = IT2 / IPW2
  408. IT2 = IT2 - IPW2*IT1
  409. IT1 = IT1 + I1*MM( I, 4 ) + I2*MM( I, 3 ) + I3*MM( I, 2 ) +
  410. $ I4*MM( I, 1 )
  411. IT1 = MOD( IT1, IPW2 )
  412. *
  413. * Convert 48-bit integer to a real number in the interval (0,1)
  414. *
  415. X( I ) = R*( REAL( IT1 )+R*( REAL( IT2 )+R*( REAL( IT3 )+R*
  416. $ REAL( IT4 ) ) ) )
  417. *
  418. IF (X( I ).EQ.1.0) THEN
  419. * If a real number has n bits of precision, and the first
  420. * n bits of the 48-bit integer above happen to be all 1 (which
  421. * will occur about once every 2**n calls), then X( I ) will
  422. * be rounded to exactly 1.0. In IEEE single precision arithmetic,
  423. * this will happen relatively often since n = 24.
  424. * Since X( I ) is not supposed to return exactly 0.0 or 1.0,
  425. * the statistically correct thing to do in this situation is
  426. * simply to iterate again.
  427. * N.B. the case X( I ) = 0.0 should not be possible.
  428. I1 = I1 + 2
  429. I2 = I2 + 2
  430. I3 = I3 + 2
  431. I4 = I4 + 2
  432. GOTO 20
  433. END IF
  434. *
  435. 10 CONTINUE
  436. *
  437. * Return final value of seed
  438. *
  439. ISEED( 1 ) = IT1
  440. ISEED( 2 ) = IT2
  441. ISEED( 3 ) = IT3
  442. ISEED( 4 ) = IT4
  443. RETURN
  444. *
  445. * End of SLARUV
  446. *
  447. END