1 SUBROUTINE ZLARGE( N, A, LDA, ISEED, WORK, INFO )
2 *
3 * -- LAPACK auxiliary test routine (version 3.1) --
4 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
5 * November 2006
6 *
7 * .. Scalar Arguments ..
8 INTEGER INFO, LDA, N
9 * ..
10 * .. Array Arguments ..
11 INTEGER ISEED( 4 )
12 COMPLEX*16 A( LDA, * ), WORK( * )
13 * ..
14 *
15 * Purpose
16 * =======
17 *
18 * ZLARGE pre- and post-multiplies a complex general n by n matrix A
19 * with a random unitary matrix: A = U*D*U'.
20 *
21 * Arguments
22 * =========
23 *
24 * N (input) INTEGER
25 * The order of the matrix A. N >= 0.
26 *
27 * A (input/output) COMPLEX*16 array, dimension (LDA,N)
28 * On entry, the original n by n matrix A.
29 * On exit, A is overwritten by U*A*U' for some random
30 * unitary matrix U.
31 *
32 * LDA (input) INTEGER
33 * The leading dimension of the array A. LDA >= N.
34 *
35 * ISEED (input/output) INTEGER array, dimension (4)
36 * On entry, the seed of the random number generator; the array
37 * elements must be between 0 and 4095, and ISEED(4) must be
38 * odd.
39 * On exit, the seed is updated.
40 *
41 * WORK (workspace) COMPLEX*16 array, dimension (2*N)
42 *
43 * INFO (output) INTEGER
44 * = 0: successful exit
45 * < 0: if INFO = -i, the i-th argument had an illegal value
46 *
47 * =====================================================================
48 *
49 * .. Parameters ..
50 COMPLEX*16 ZERO, ONE
51 PARAMETER ( ZERO = ( 0.0D+0, 0.0D+0 ),
52 $ ONE = ( 1.0D+0, 0.0D+0 ) )
53 * ..
54 * .. Local Scalars ..
55 INTEGER I
56 DOUBLE PRECISION WN
57 COMPLEX*16 TAU, WA, WB
58 * ..
59 * .. External Subroutines ..
60 EXTERNAL XERBLA, ZGEMV, ZGERC, ZLARNV, ZSCAL
61 * ..
62 * .. Intrinsic Functions ..
63 INTRINSIC ABS, DBLE, MAX
64 * ..
65 * .. External Functions ..
66 DOUBLE PRECISION DZNRM2
67 EXTERNAL DZNRM2
68 * ..
69 * .. Executable Statements ..
70 *
71 * Test the input arguments
72 *
73 INFO = 0
74 IF( N.LT.0 ) THEN
75 INFO = -1
76 ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
77 INFO = -3
78 END IF
79 IF( INFO.LT.0 ) THEN
80 CALL XERBLA( 'ZLARGE', -INFO )
81 RETURN
82 END IF
83 *
84 * pre- and post-multiply A by random unitary matrix
85 *
86 DO 10 I = N, 1, -1
87 *
88 * generate random reflection
89 *
90 CALL ZLARNV( 3, ISEED, N-I+1, WORK )
91 WN = DZNRM2( N-I+1, WORK, 1 )
92 WA = ( WN / ABS( WORK( 1 ) ) )*WORK( 1 )
93 IF( WN.EQ.ZERO ) THEN
94 TAU = ZERO
95 ELSE
96 WB = WORK( 1 ) + WA
97 CALL ZSCAL( N-I, ONE / WB, WORK( 2 ), 1 )
98 WORK( 1 ) = ONE
99 TAU = DBLE( WB / WA )
100 END IF
101 *
102 * multiply A(i:n,1:n) by random reflection from the left
103 *
104 CALL ZGEMV( 'Conjugate transpose', N-I+1, N, ONE, A( I, 1 ),
105 $ LDA, WORK, 1, ZERO, WORK( N+1 ), 1 )
106 CALL ZGERC( N-I+1, N, -TAU, WORK, 1, WORK( N+1 ), 1, A( I, 1 ),
107 $ LDA )
108 *
109 * multiply A(1:n,i:n) by random reflection from the right
110 *
111 CALL ZGEMV( 'No transpose', N, N-I+1, ONE, A( 1, I ), LDA,
112 $ WORK, 1, ZERO, WORK( N+1 ), 1 )
113 CALL ZGERC( N, N-I+1, -TAU, WORK( N+1 ), 1, WORK, 1, A( 1, I ),
114 $ LDA )
115 10 CONTINUE
116 RETURN
117 *
118 * End of ZLARGE
119 *
120 END
2 *
3 * -- LAPACK auxiliary test routine (version 3.1) --
4 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
5 * November 2006
6 *
7 * .. Scalar Arguments ..
8 INTEGER INFO, LDA, N
9 * ..
10 * .. Array Arguments ..
11 INTEGER ISEED( 4 )
12 COMPLEX*16 A( LDA, * ), WORK( * )
13 * ..
14 *
15 * Purpose
16 * =======
17 *
18 * ZLARGE pre- and post-multiplies a complex general n by n matrix A
19 * with a random unitary matrix: A = U*D*U'.
20 *
21 * Arguments
22 * =========
23 *
24 * N (input) INTEGER
25 * The order of the matrix A. N >= 0.
26 *
27 * A (input/output) COMPLEX*16 array, dimension (LDA,N)
28 * On entry, the original n by n matrix A.
29 * On exit, A is overwritten by U*A*U' for some random
30 * unitary matrix U.
31 *
32 * LDA (input) INTEGER
33 * The leading dimension of the array A. LDA >= N.
34 *
35 * ISEED (input/output) INTEGER array, dimension (4)
36 * On entry, the seed of the random number generator; the array
37 * elements must be between 0 and 4095, and ISEED(4) must be
38 * odd.
39 * On exit, the seed is updated.
40 *
41 * WORK (workspace) COMPLEX*16 array, dimension (2*N)
42 *
43 * INFO (output) INTEGER
44 * = 0: successful exit
45 * < 0: if INFO = -i, the i-th argument had an illegal value
46 *
47 * =====================================================================
48 *
49 * .. Parameters ..
50 COMPLEX*16 ZERO, ONE
51 PARAMETER ( ZERO = ( 0.0D+0, 0.0D+0 ),
52 $ ONE = ( 1.0D+0, 0.0D+0 ) )
53 * ..
54 * .. Local Scalars ..
55 INTEGER I
56 DOUBLE PRECISION WN
57 COMPLEX*16 TAU, WA, WB
58 * ..
59 * .. External Subroutines ..
60 EXTERNAL XERBLA, ZGEMV, ZGERC, ZLARNV, ZSCAL
61 * ..
62 * .. Intrinsic Functions ..
63 INTRINSIC ABS, DBLE, MAX
64 * ..
65 * .. External Functions ..
66 DOUBLE PRECISION DZNRM2
67 EXTERNAL DZNRM2
68 * ..
69 * .. Executable Statements ..
70 *
71 * Test the input arguments
72 *
73 INFO = 0
74 IF( N.LT.0 ) THEN
75 INFO = -1
76 ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
77 INFO = -3
78 END IF
79 IF( INFO.LT.0 ) THEN
80 CALL XERBLA( 'ZLARGE', -INFO )
81 RETURN
82 END IF
83 *
84 * pre- and post-multiply A by random unitary matrix
85 *
86 DO 10 I = N, 1, -1
87 *
88 * generate random reflection
89 *
90 CALL ZLARNV( 3, ISEED, N-I+1, WORK )
91 WN = DZNRM2( N-I+1, WORK, 1 )
92 WA = ( WN / ABS( WORK( 1 ) ) )*WORK( 1 )
93 IF( WN.EQ.ZERO ) THEN
94 TAU = ZERO
95 ELSE
96 WB = WORK( 1 ) + WA
97 CALL ZSCAL( N-I, ONE / WB, WORK( 2 ), 1 )
98 WORK( 1 ) = ONE
99 TAU = DBLE( WB / WA )
100 END IF
101 *
102 * multiply A(i:n,1:n) by random reflection from the left
103 *
104 CALL ZGEMV( 'Conjugate transpose', N-I+1, N, ONE, A( I, 1 ),
105 $ LDA, WORK, 1, ZERO, WORK( N+1 ), 1 )
106 CALL ZGERC( N-I+1, N, -TAU, WORK, 1, WORK( N+1 ), 1, A( I, 1 ),
107 $ LDA )
108 *
109 * multiply A(1:n,i:n) by random reflection from the right
110 *
111 CALL ZGEMV( 'No transpose', N, N-I+1, ONE, A( 1, I ), LDA,
112 $ WORK, 1, ZERO, WORK( N+1 ), 1 )
113 CALL ZGERC( N, N-I+1, -TAU, WORK( N+1 ), 1, WORK, 1, A( 1, I ),
114 $ LDA )
115 10 CONTINUE
116 RETURN
117 *
118 * End of ZLARGE
119 *
120 END