1 SUBROUTINE DLARNV( IDIST, ISEED, N, X )
2 *
3 * -- LAPACK auxiliary routine (version 3.2) --
4 * -- LAPACK is a software package provided by Univ. of Tennessee, --
5 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
6 * November 2006
7 *
8 * .. Scalar Arguments ..
9 INTEGER IDIST, N
10 * ..
11 * .. Array Arguments ..
12 INTEGER ISEED( 4 )
13 DOUBLE PRECISION X( * )
14 * ..
15 *
16 * Purpose
17 * =======
18 *
19 * DLARNV returns a vector of n random real numbers from a uniform or
20 * normal distribution.
21 *
22 * Arguments
23 * =========
24 *
25 * IDIST (input) INTEGER
26 * Specifies the distribution of the random numbers:
27 * = 1: uniform (0,1)
28 * = 2: uniform (-1,1)
29 * = 3: normal (0,1)
30 *
31 * ISEED (input/output) INTEGER array, dimension (4)
32 * On entry, the seed of the random number generator; the array
33 * elements must be between 0 and 4095, and ISEED(4) must be
34 * odd.
35 * On exit, the seed is updated.
36 *
37 * N (input) INTEGER
38 * The number of random numbers to be generated.
39 *
40 * X (output) DOUBLE PRECISION array, dimension (N)
41 * The generated random numbers.
42 *
43 * Further Details
44 * ===============
45 *
46 * This routine calls the auxiliary routine DLARUV to generate random
47 * real numbers from a uniform (0,1) distribution, in batches of up to
48 * 128 using vectorisable code. The Box-Muller method is used to
49 * transform numbers from a uniform to a normal distribution.
50 *
51 * =====================================================================
52 *
53 * .. Parameters ..
54 DOUBLE PRECISION ONE, TWO
55 PARAMETER ( ONE = 1.0D+0, TWO = 2.0D+0 )
56 INTEGER LV
57 PARAMETER ( LV = 128 )
58 DOUBLE PRECISION TWOPI
59 PARAMETER ( TWOPI = 6.2831853071795864769252867663D+0 )
60 * ..
61 * .. Local Scalars ..
62 INTEGER I, IL, IL2, IV
63 * ..
64 * .. Local Arrays ..
65 DOUBLE PRECISION U( LV )
66 * ..
67 * .. Intrinsic Functions ..
68 INTRINSIC COS, LOG, MIN, SQRT
69 * ..
70 * .. External Subroutines ..
71 EXTERNAL DLARUV
72 * ..
73 * .. Executable Statements ..
74 *
75 DO 40 IV = 1, N, LV / 2
76 IL = MIN( LV / 2, N-IV+1 )
77 IF( IDIST.EQ.3 ) THEN
78 IL2 = 2*IL
79 ELSE
80 IL2 = IL
81 END IF
82 *
83 * Call DLARUV to generate IL2 numbers from a uniform (0,1)
84 * distribution (IL2 <= LV)
85 *
86 CALL DLARUV( ISEED, IL2, U )
87 *
88 IF( IDIST.EQ.1 ) THEN
89 *
90 * Copy generated numbers
91 *
92 DO 10 I = 1, IL
93 X( IV+I-1 ) = U( I )
94 10 CONTINUE
95 ELSE IF( IDIST.EQ.2 ) THEN
96 *
97 * Convert generated numbers to uniform (-1,1) distribution
98 *
99 DO 20 I = 1, IL
100 X( IV+I-1 ) = TWO*U( I ) - ONE
101 20 CONTINUE
102 ELSE IF( IDIST.EQ.3 ) THEN
103 *
104 * Convert generated numbers to normal (0,1) distribution
105 *
106 DO 30 I = 1, IL
107 X( IV+I-1 ) = SQRT( -TWO*LOG( U( 2*I-1 ) ) )*
108 $ COS( TWOPI*U( 2*I ) )
109 30 CONTINUE
110 END IF
111 40 CONTINUE
112 RETURN
113 *
114 * End of DLARNV
115 *
116 END
2 *
3 * -- LAPACK auxiliary routine (version 3.2) --
4 * -- LAPACK is a software package provided by Univ. of Tennessee, --
5 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
6 * November 2006
7 *
8 * .. Scalar Arguments ..
9 INTEGER IDIST, N
10 * ..
11 * .. Array Arguments ..
12 INTEGER ISEED( 4 )
13 DOUBLE PRECISION X( * )
14 * ..
15 *
16 * Purpose
17 * =======
18 *
19 * DLARNV returns a vector of n random real numbers from a uniform or
20 * normal distribution.
21 *
22 * Arguments
23 * =========
24 *
25 * IDIST (input) INTEGER
26 * Specifies the distribution of the random numbers:
27 * = 1: uniform (0,1)
28 * = 2: uniform (-1,1)
29 * = 3: normal (0,1)
30 *
31 * ISEED (input/output) INTEGER array, dimension (4)
32 * On entry, the seed of the random number generator; the array
33 * elements must be between 0 and 4095, and ISEED(4) must be
34 * odd.
35 * On exit, the seed is updated.
36 *
37 * N (input) INTEGER
38 * The number of random numbers to be generated.
39 *
40 * X (output) DOUBLE PRECISION array, dimension (N)
41 * The generated random numbers.
42 *
43 * Further Details
44 * ===============
45 *
46 * This routine calls the auxiliary routine DLARUV to generate random
47 * real numbers from a uniform (0,1) distribution, in batches of up to
48 * 128 using vectorisable code. The Box-Muller method is used to
49 * transform numbers from a uniform to a normal distribution.
50 *
51 * =====================================================================
52 *
53 * .. Parameters ..
54 DOUBLE PRECISION ONE, TWO
55 PARAMETER ( ONE = 1.0D+0, TWO = 2.0D+0 )
56 INTEGER LV
57 PARAMETER ( LV = 128 )
58 DOUBLE PRECISION TWOPI
59 PARAMETER ( TWOPI = 6.2831853071795864769252867663D+0 )
60 * ..
61 * .. Local Scalars ..
62 INTEGER I, IL, IL2, IV
63 * ..
64 * .. Local Arrays ..
65 DOUBLE PRECISION U( LV )
66 * ..
67 * .. Intrinsic Functions ..
68 INTRINSIC COS, LOG, MIN, SQRT
69 * ..
70 * .. External Subroutines ..
71 EXTERNAL DLARUV
72 * ..
73 * .. Executable Statements ..
74 *
75 DO 40 IV = 1, N, LV / 2
76 IL = MIN( LV / 2, N-IV+1 )
77 IF( IDIST.EQ.3 ) THEN
78 IL2 = 2*IL
79 ELSE
80 IL2 = IL
81 END IF
82 *
83 * Call DLARUV to generate IL2 numbers from a uniform (0,1)
84 * distribution (IL2 <= LV)
85 *
86 CALL DLARUV( ISEED, IL2, U )
87 *
88 IF( IDIST.EQ.1 ) THEN
89 *
90 * Copy generated numbers
91 *
92 DO 10 I = 1, IL
93 X( IV+I-1 ) = U( I )
94 10 CONTINUE
95 ELSE IF( IDIST.EQ.2 ) THEN
96 *
97 * Convert generated numbers to uniform (-1,1) distribution
98 *
99 DO 20 I = 1, IL
100 X( IV+I-1 ) = TWO*U( I ) - ONE
101 20 CONTINUE
102 ELSE IF( IDIST.EQ.3 ) THEN
103 *
104 * Convert generated numbers to normal (0,1) distribution
105 *
106 DO 30 I = 1, IL
107 X( IV+I-1 ) = SQRT( -TWO*LOG( U( 2*I-1 ) ) )*
108 $ COS( TWOPI*U( 2*I ) )
109 30 CONTINUE
110 END IF
111 40 CONTINUE
112 RETURN
113 *
114 * End of DLARNV
115 *
116 END