1 SUBROUTINE ZLARNV( 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 COMPLEX*16 X( * )
14 * ..
15 *
16 * Purpose
17 * =======
18 *
19 * ZLARNV returns a vector of n random complex 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: real and imaginary parts each uniform (0,1)
28 * = 2: real and imaginary parts each uniform (-1,1)
29 * = 3: real and imaginary parts each normal (0,1)
30 * = 4: uniformly distributed on the disc abs(z) < 1
31 * = 5: uniformly distributed on the circle abs(z) = 1
32 *
33 * ISEED (input/output) INTEGER array, dimension (4)
34 * On entry, the seed of the random number generator; the array
35 * elements must be between 0 and 4095, and ISEED(4) must be
36 * odd.
37 * On exit, the seed is updated.
38 *
39 * N (input) INTEGER
40 * The number of random numbers to be generated.
41 *
42 * X (output) COMPLEX*16 array, dimension (N)
43 * The generated random numbers.
44 *
45 * Further Details
46 * ===============
47 *
48 * This routine calls the auxiliary routine DLARUV to generate random
49 * real numbers from a uniform (0,1) distribution, in batches of up to
50 * 128 using vectorisable code. The Box-Muller method is used to
51 * transform numbers from a uniform to a normal distribution.
52 *
53 * =====================================================================
54 *
55 * .. Parameters ..
56 DOUBLE PRECISION ZERO, ONE, TWO
57 PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0, TWO = 2.0D+0 )
58 INTEGER LV
59 PARAMETER ( LV = 128 )
60 DOUBLE PRECISION TWOPI
61 PARAMETER ( TWOPI = 6.2831853071795864769252867663D+0 )
62 * ..
63 * .. Local Scalars ..
64 INTEGER I, IL, IV
65 * ..
66 * .. Local Arrays ..
67 DOUBLE PRECISION U( LV )
68 * ..
69 * .. Intrinsic Functions ..
70 INTRINSIC DCMPLX, EXP, LOG, MIN, SQRT
71 * ..
72 * .. External Subroutines ..
73 EXTERNAL DLARUV
74 * ..
75 * .. Executable Statements ..
76 *
77 DO 60 IV = 1, N, LV / 2
78 IL = MIN( LV / 2, N-IV+1 )
79 *
80 * Call DLARUV to generate 2*IL real numbers from a uniform (0,1)
81 * distribution (2*IL <= LV)
82 *
83 CALL DLARUV( ISEED, 2*IL, U )
84 *
85 IF( IDIST.EQ.1 ) THEN
86 *
87 * Copy generated numbers
88 *
89 DO 10 I = 1, IL
90 X( IV+I-1 ) = DCMPLX( U( 2*I-1 ), U( 2*I ) )
91 10 CONTINUE
92 ELSE IF( IDIST.EQ.2 ) THEN
93 *
94 * Convert generated numbers to uniform (-1,1) distribution
95 *
96 DO 20 I = 1, IL
97 X( IV+I-1 ) = DCMPLX( TWO*U( 2*I-1 )-ONE,
98 $ TWO*U( 2*I )-ONE )
99 20 CONTINUE
100 ELSE IF( IDIST.EQ.3 ) THEN
101 *
102 * Convert generated numbers to normal (0,1) distribution
103 *
104 DO 30 I = 1, IL
105 X( IV+I-1 ) = SQRT( -TWO*LOG( U( 2*I-1 ) ) )*
106 $ EXP( DCMPLX( ZERO, TWOPI*U( 2*I ) ) )
107 30 CONTINUE
108 ELSE IF( IDIST.EQ.4 ) THEN
109 *
110 * Convert generated numbers to complex numbers uniformly
111 * distributed on the unit disk
112 *
113 DO 40 I = 1, IL
114 X( IV+I-1 ) = SQRT( U( 2*I-1 ) )*
115 $ EXP( DCMPLX( ZERO, TWOPI*U( 2*I ) ) )
116 40 CONTINUE
117 ELSE IF( IDIST.EQ.5 ) THEN
118 *
119 * Convert generated numbers to complex numbers uniformly
120 * distributed on the unit circle
121 *
122 DO 50 I = 1, IL
123 X( IV+I-1 ) = EXP( DCMPLX( ZERO, TWOPI*U( 2*I ) ) )
124 50 CONTINUE
125 END IF
126 60 CONTINUE
127 RETURN
128 *
129 * End of ZLARNV
130 *
131 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 COMPLEX*16 X( * )
14 * ..
15 *
16 * Purpose
17 * =======
18 *
19 * ZLARNV returns a vector of n random complex 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: real and imaginary parts each uniform (0,1)
28 * = 2: real and imaginary parts each uniform (-1,1)
29 * = 3: real and imaginary parts each normal (0,1)
30 * = 4: uniformly distributed on the disc abs(z) < 1
31 * = 5: uniformly distributed on the circle abs(z) = 1
32 *
33 * ISEED (input/output) INTEGER array, dimension (4)
34 * On entry, the seed of the random number generator; the array
35 * elements must be between 0 and 4095, and ISEED(4) must be
36 * odd.
37 * On exit, the seed is updated.
38 *
39 * N (input) INTEGER
40 * The number of random numbers to be generated.
41 *
42 * X (output) COMPLEX*16 array, dimension (N)
43 * The generated random numbers.
44 *
45 * Further Details
46 * ===============
47 *
48 * This routine calls the auxiliary routine DLARUV to generate random
49 * real numbers from a uniform (0,1) distribution, in batches of up to
50 * 128 using vectorisable code. The Box-Muller method is used to
51 * transform numbers from a uniform to a normal distribution.
52 *
53 * =====================================================================
54 *
55 * .. Parameters ..
56 DOUBLE PRECISION ZERO, ONE, TWO
57 PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0, TWO = 2.0D+0 )
58 INTEGER LV
59 PARAMETER ( LV = 128 )
60 DOUBLE PRECISION TWOPI
61 PARAMETER ( TWOPI = 6.2831853071795864769252867663D+0 )
62 * ..
63 * .. Local Scalars ..
64 INTEGER I, IL, IV
65 * ..
66 * .. Local Arrays ..
67 DOUBLE PRECISION U( LV )
68 * ..
69 * .. Intrinsic Functions ..
70 INTRINSIC DCMPLX, EXP, LOG, MIN, SQRT
71 * ..
72 * .. External Subroutines ..
73 EXTERNAL DLARUV
74 * ..
75 * .. Executable Statements ..
76 *
77 DO 60 IV = 1, N, LV / 2
78 IL = MIN( LV / 2, N-IV+1 )
79 *
80 * Call DLARUV to generate 2*IL real numbers from a uniform (0,1)
81 * distribution (2*IL <= LV)
82 *
83 CALL DLARUV( ISEED, 2*IL, U )
84 *
85 IF( IDIST.EQ.1 ) THEN
86 *
87 * Copy generated numbers
88 *
89 DO 10 I = 1, IL
90 X( IV+I-1 ) = DCMPLX( U( 2*I-1 ), U( 2*I ) )
91 10 CONTINUE
92 ELSE IF( IDIST.EQ.2 ) THEN
93 *
94 * Convert generated numbers to uniform (-1,1) distribution
95 *
96 DO 20 I = 1, IL
97 X( IV+I-1 ) = DCMPLX( TWO*U( 2*I-1 )-ONE,
98 $ TWO*U( 2*I )-ONE )
99 20 CONTINUE
100 ELSE IF( IDIST.EQ.3 ) THEN
101 *
102 * Convert generated numbers to normal (0,1) distribution
103 *
104 DO 30 I = 1, IL
105 X( IV+I-1 ) = SQRT( -TWO*LOG( U( 2*I-1 ) ) )*
106 $ EXP( DCMPLX( ZERO, TWOPI*U( 2*I ) ) )
107 30 CONTINUE
108 ELSE IF( IDIST.EQ.4 ) THEN
109 *
110 * Convert generated numbers to complex numbers uniformly
111 * distributed on the unit disk
112 *
113 DO 40 I = 1, IL
114 X( IV+I-1 ) = SQRT( U( 2*I-1 ) )*
115 $ EXP( DCMPLX( ZERO, TWOPI*U( 2*I ) ) )
116 40 CONTINUE
117 ELSE IF( IDIST.EQ.5 ) THEN
118 *
119 * Convert generated numbers to complex numbers uniformly
120 * distributed on the unit circle
121 *
122 DO 50 I = 1, IL
123 X( IV+I-1 ) = EXP( DCMPLX( ZERO, TWOPI*U( 2*I ) ) )
124 50 CONTINUE
125 END IF
126 60 CONTINUE
127 RETURN
128 *
129 * End of ZLARNV
130 *
131 END