1 SUBROUTINE ZTZRQF( M, N, A, LDA, TAU, INFO )
2 *
3 * -- LAPACK routine (version 3.3.1) --
4 * -- LAPACK is a software package provided by Univ. of Tennessee, --
5 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
6 * -- April 2011 --
7 *
8 * .. Scalar Arguments ..
9 INTEGER INFO, LDA, M, N
10 * ..
11 * .. Array Arguments ..
12 COMPLEX*16 A( LDA, * ), TAU( * )
13 * ..
14 *
15 * Purpose
16 * =======
17 *
18 * This routine is deprecated and has been replaced by routine ZTZRZF.
19 *
20 * ZTZRQF reduces the M-by-N ( M<=N ) complex upper trapezoidal matrix A
21 * to upper triangular form by means of unitary transformations.
22 *
23 * The upper trapezoidal matrix A is factored as
24 *
25 * A = ( R 0 ) * Z,
26 *
27 * where Z is an N-by-N unitary matrix and R is an M-by-M upper
28 * triangular matrix.
29 *
30 * Arguments
31 * =========
32 *
33 * M (input) INTEGER
34 * The number of rows of the matrix A. M >= 0.
35 *
36 * N (input) INTEGER
37 * The number of columns of the matrix A. N >= M.
38 *
39 * A (input/output) COMPLEX*16 array, dimension (LDA,N)
40 * On entry, the leading M-by-N upper trapezoidal part of the
41 * array A must contain the matrix to be factorized.
42 * On exit, the leading M-by-M upper triangular part of A
43 * contains the upper triangular matrix R, and elements M+1 to
44 * N of the first M rows of A, with the array TAU, represent the
45 * unitary matrix Z as a product of M elementary reflectors.
46 *
47 * LDA (input) INTEGER
48 * The leading dimension of the array A. LDA >= max(1,M).
49 *
50 * TAU (output) COMPLEX*16 array, dimension (M)
51 * The scalar factors of the elementary reflectors.
52 *
53 * INFO (output) INTEGER
54 * = 0: successful exit
55 * < 0: if INFO = -i, the i-th argument had an illegal value
56 *
57 * Further Details
58 * ===============
59 *
60 * The factorization is obtained by Householder's method. The kth
61 * transformation matrix, Z( k ), whose conjugate transpose is used to
62 * introduce zeros into the (m - k + 1)th row of A, is given in the form
63 *
64 * Z( k ) = ( I 0 ),
65 * ( 0 T( k ) )
66 *
67 * where
68 *
69 * T( k ) = I - tau*u( k )*u( k )**H, u( k ) = ( 1 ),
70 * ( 0 )
71 * ( z( k ) )
72 *
73 * tau is a scalar and z( k ) is an ( n - m ) element vector.
74 * tau and z( k ) are chosen to annihilate the elements of the kth row
75 * of X.
76 *
77 * The scalar tau is returned in the kth element of TAU and the vector
78 * u( k ) in the kth row of A, such that the elements of z( k ) are
79 * in a( k, m + 1 ), ..., a( k, n ). The elements of R are returned in
80 * the upper triangular part of A.
81 *
82 * Z is given by
83 *
84 * Z = Z( 1 ) * Z( 2 ) * ... * Z( m ).
85 *
86 * =====================================================================
87 *
88 * .. Parameters ..
89 COMPLEX*16 CONE, CZERO
90 PARAMETER ( CONE = ( 1.0D+0, 0.0D+0 ),
91 $ CZERO = ( 0.0D+0, 0.0D+0 ) )
92 * ..
93 * .. Local Scalars ..
94 INTEGER I, K, M1
95 COMPLEX*16 ALPHA
96 * ..
97 * .. Intrinsic Functions ..
98 INTRINSIC DCONJG, MAX, MIN
99 * ..
100 * .. External Subroutines ..
101 EXTERNAL XERBLA, ZAXPY, ZCOPY, ZGEMV, ZGERC, ZLACGV,
102 $ ZLARFG
103 * ..
104 * .. Executable Statements ..
105 *
106 * Test the input parameters.
107 *
108 INFO = 0
109 IF( M.LT.0 ) THEN
110 INFO = -1
111 ELSE IF( N.LT.M ) THEN
112 INFO = -2
113 ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
114 INFO = -4
115 END IF
116 IF( INFO.NE.0 ) THEN
117 CALL XERBLA( 'ZTZRQF', -INFO )
118 RETURN
119 END IF
120 *
121 * Perform the factorization.
122 *
123 IF( M.EQ.0 )
124 $ RETURN
125 IF( M.EQ.N ) THEN
126 DO 10 I = 1, N
127 TAU( I ) = CZERO
128 10 CONTINUE
129 ELSE
130 M1 = MIN( M+1, N )
131 DO 20 K = M, 1, -1
132 *
133 * Use a Householder reflection to zero the kth row of A.
134 * First set up the reflection.
135 *
136 A( K, K ) = DCONJG( A( K, K ) )
137 CALL ZLACGV( N-M, A( K, M1 ), LDA )
138 ALPHA = A( K, K )
139 CALL ZLARFG( N-M+1, ALPHA, A( K, M1 ), LDA, TAU( K ) )
140 A( K, K ) = ALPHA
141 TAU( K ) = DCONJG( TAU( K ) )
142 *
143 IF( TAU( K ).NE.CZERO .AND. K.GT.1 ) THEN
144 *
145 * We now perform the operation A := A*P( k )**H.
146 *
147 * Use the first ( k - 1 ) elements of TAU to store a( k ),
148 * where a( k ) consists of the first ( k - 1 ) elements of
149 * the kth column of A. Also let B denote the first
150 * ( k - 1 ) rows of the last ( n - m ) columns of A.
151 *
152 CALL ZCOPY( K-1, A( 1, K ), 1, TAU, 1 )
153 *
154 * Form w = a( k ) + B*z( k ) in TAU.
155 *
156 CALL ZGEMV( 'No transpose', K-1, N-M, CONE, A( 1, M1 ),
157 $ LDA, A( K, M1 ), LDA, CONE, TAU, 1 )
158 *
159 * Now form a( k ) := a( k ) - conjg(tau)*w
160 * and B := B - conjg(tau)*w*z( k )**H.
161 *
162 CALL ZAXPY( K-1, -DCONJG( TAU( K ) ), TAU, 1, A( 1, K ),
163 $ 1 )
164 CALL ZGERC( K-1, N-M, -DCONJG( TAU( K ) ), TAU, 1,
165 $ A( K, M1 ), LDA, A( 1, M1 ), LDA )
166 END IF
167 20 CONTINUE
168 END IF
169 *
170 RETURN
171 *
172 * End of ZTZRQF
173 *
174 END
2 *
3 * -- LAPACK routine (version 3.3.1) --
4 * -- LAPACK is a software package provided by Univ. of Tennessee, --
5 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
6 * -- April 2011 --
7 *
8 * .. Scalar Arguments ..
9 INTEGER INFO, LDA, M, N
10 * ..
11 * .. Array Arguments ..
12 COMPLEX*16 A( LDA, * ), TAU( * )
13 * ..
14 *
15 * Purpose
16 * =======
17 *
18 * This routine is deprecated and has been replaced by routine ZTZRZF.
19 *
20 * ZTZRQF reduces the M-by-N ( M<=N ) complex upper trapezoidal matrix A
21 * to upper triangular form by means of unitary transformations.
22 *
23 * The upper trapezoidal matrix A is factored as
24 *
25 * A = ( R 0 ) * Z,
26 *
27 * where Z is an N-by-N unitary matrix and R is an M-by-M upper
28 * triangular matrix.
29 *
30 * Arguments
31 * =========
32 *
33 * M (input) INTEGER
34 * The number of rows of the matrix A. M >= 0.
35 *
36 * N (input) INTEGER
37 * The number of columns of the matrix A. N >= M.
38 *
39 * A (input/output) COMPLEX*16 array, dimension (LDA,N)
40 * On entry, the leading M-by-N upper trapezoidal part of the
41 * array A must contain the matrix to be factorized.
42 * On exit, the leading M-by-M upper triangular part of A
43 * contains the upper triangular matrix R, and elements M+1 to
44 * N of the first M rows of A, with the array TAU, represent the
45 * unitary matrix Z as a product of M elementary reflectors.
46 *
47 * LDA (input) INTEGER
48 * The leading dimension of the array A. LDA >= max(1,M).
49 *
50 * TAU (output) COMPLEX*16 array, dimension (M)
51 * The scalar factors of the elementary reflectors.
52 *
53 * INFO (output) INTEGER
54 * = 0: successful exit
55 * < 0: if INFO = -i, the i-th argument had an illegal value
56 *
57 * Further Details
58 * ===============
59 *
60 * The factorization is obtained by Householder's method. The kth
61 * transformation matrix, Z( k ), whose conjugate transpose is used to
62 * introduce zeros into the (m - k + 1)th row of A, is given in the form
63 *
64 * Z( k ) = ( I 0 ),
65 * ( 0 T( k ) )
66 *
67 * where
68 *
69 * T( k ) = I - tau*u( k )*u( k )**H, u( k ) = ( 1 ),
70 * ( 0 )
71 * ( z( k ) )
72 *
73 * tau is a scalar and z( k ) is an ( n - m ) element vector.
74 * tau and z( k ) are chosen to annihilate the elements of the kth row
75 * of X.
76 *
77 * The scalar tau is returned in the kth element of TAU and the vector
78 * u( k ) in the kth row of A, such that the elements of z( k ) are
79 * in a( k, m + 1 ), ..., a( k, n ). The elements of R are returned in
80 * the upper triangular part of A.
81 *
82 * Z is given by
83 *
84 * Z = Z( 1 ) * Z( 2 ) * ... * Z( m ).
85 *
86 * =====================================================================
87 *
88 * .. Parameters ..
89 COMPLEX*16 CONE, CZERO
90 PARAMETER ( CONE = ( 1.0D+0, 0.0D+0 ),
91 $ CZERO = ( 0.0D+0, 0.0D+0 ) )
92 * ..
93 * .. Local Scalars ..
94 INTEGER I, K, M1
95 COMPLEX*16 ALPHA
96 * ..
97 * .. Intrinsic Functions ..
98 INTRINSIC DCONJG, MAX, MIN
99 * ..
100 * .. External Subroutines ..
101 EXTERNAL XERBLA, ZAXPY, ZCOPY, ZGEMV, ZGERC, ZLACGV,
102 $ ZLARFG
103 * ..
104 * .. Executable Statements ..
105 *
106 * Test the input parameters.
107 *
108 INFO = 0
109 IF( M.LT.0 ) THEN
110 INFO = -1
111 ELSE IF( N.LT.M ) THEN
112 INFO = -2
113 ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
114 INFO = -4
115 END IF
116 IF( INFO.NE.0 ) THEN
117 CALL XERBLA( 'ZTZRQF', -INFO )
118 RETURN
119 END IF
120 *
121 * Perform the factorization.
122 *
123 IF( M.EQ.0 )
124 $ RETURN
125 IF( M.EQ.N ) THEN
126 DO 10 I = 1, N
127 TAU( I ) = CZERO
128 10 CONTINUE
129 ELSE
130 M1 = MIN( M+1, N )
131 DO 20 K = M, 1, -1
132 *
133 * Use a Householder reflection to zero the kth row of A.
134 * First set up the reflection.
135 *
136 A( K, K ) = DCONJG( A( K, K ) )
137 CALL ZLACGV( N-M, A( K, M1 ), LDA )
138 ALPHA = A( K, K )
139 CALL ZLARFG( N-M+1, ALPHA, A( K, M1 ), LDA, TAU( K ) )
140 A( K, K ) = ALPHA
141 TAU( K ) = DCONJG( TAU( K ) )
142 *
143 IF( TAU( K ).NE.CZERO .AND. K.GT.1 ) THEN
144 *
145 * We now perform the operation A := A*P( k )**H.
146 *
147 * Use the first ( k - 1 ) elements of TAU to store a( k ),
148 * where a( k ) consists of the first ( k - 1 ) elements of
149 * the kth column of A. Also let B denote the first
150 * ( k - 1 ) rows of the last ( n - m ) columns of A.
151 *
152 CALL ZCOPY( K-1, A( 1, K ), 1, TAU, 1 )
153 *
154 * Form w = a( k ) + B*z( k ) in TAU.
155 *
156 CALL ZGEMV( 'No transpose', K-1, N-M, CONE, A( 1, M1 ),
157 $ LDA, A( K, M1 ), LDA, CONE, TAU, 1 )
158 *
159 * Now form a( k ) := a( k ) - conjg(tau)*w
160 * and B := B - conjg(tau)*w*z( k )**H.
161 *
162 CALL ZAXPY( K-1, -DCONJG( TAU( K ) ), TAU, 1, A( 1, K ),
163 $ 1 )
164 CALL ZGERC( K-1, N-M, -DCONJG( TAU( K ) ), TAU, 1,
165 $ A( K, M1 ), LDA, A( 1, M1 ), LDA )
166 END IF
167 20 CONTINUE
168 END IF
169 *
170 RETURN
171 *
172 * End of ZTZRQF
173 *
174 END