3 * =========== DOCUMENTATION ===========
5 * Online html documentation available at
6 * http://www.netlib.org/lapack/explore-html/
9 *> Download ZTZRZF + dependencies
10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ztzrzf.f">
12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ztzrzf.f">
14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ztzrzf.f">
21 * SUBROUTINE ZTZRZF( M, N, A, LDA, TAU, WORK, LWORK, INFO )
23 * .. Scalar Arguments ..
24 * INTEGER INFO, LDA, LWORK, M, N
26 * .. Array Arguments ..
27 * COMPLEX*16 A( LDA, * ), TAU( * ), WORK( * )
36 *> ZTZRZF reduces the M-by-N ( M<=N ) complex upper trapezoidal matrix A
37 *> to upper triangular form by means of unitary transformations.
39 *> The upper trapezoidal matrix A is factored as
43 *> where Z is an N-by-N unitary matrix and R is an M-by-M upper
53 *> The number of rows of the matrix A. M >= 0.
59 *> The number of columns of the matrix A. N >= M.
64 *> A is COMPLEX*16 array, dimension (LDA,N)
65 *> On entry, the leading M-by-N upper trapezoidal part of the
66 *> array A must contain the matrix to be factorized.
67 *> On exit, the leading M-by-M upper triangular part of A
68 *> contains the upper triangular matrix R, and elements M+1 to
69 *> N of the first M rows of A, with the array TAU, represent the
70 *> unitary matrix Z as a product of M elementary reflectors.
76 *> The leading dimension of the array A. LDA >= max(1,M).
81 *> TAU is COMPLEX*16 array, dimension (M)
82 *> The scalar factors of the elementary reflectors.
87 *> WORK is COMPLEX*16 array, dimension (MAX(1,LWORK))
88 *> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
94 *> The dimension of the array WORK. LWORK >= max(1,M).
95 *> For optimum performance LWORK >= M*NB, where NB is
96 *> the optimal blocksize.
98 *> If LWORK = -1, then a workspace query is assumed; the routine
99 *> only calculates the optimal size of the WORK array, returns
100 *> this value as the first entry of the WORK array, and no error
101 *> message related to LWORK is issued by XERBLA.
107 *> = 0: successful exit
108 *> < 0: if INFO = -i, the i-th argument had an illegal value
114 *> \author Univ. of Tennessee
115 *> \author Univ. of California Berkeley
116 *> \author Univ. of Colorado Denver
121 *> \ingroup complex16OTHERcomputational
123 *> \par Contributors:
126 *> A. Petitet, Computer Science Dept., Univ. of Tenn., Knoxville, USA
128 *> \par Further Details:
129 * =====================
133 *> The N-by-N matrix Z can be computed by
135 *> Z = Z(1)*Z(2)* ... *Z(M)
137 *> where each N-by-N Z(k) is given by
139 *> Z(k) = I - tau(k)*v(k)*v(k)**H
141 *> with v(k) is the kth row vector of the M-by-N matrix
143 *> V = ( I A(:,M+1:N) )
145 *> I is the M-by-M identity matrix, A(:,M+1:N)
146 *> is the output stored in A on exit from DTZRZF,
147 *> and tau(k) is the kth element of the array TAU.
151 * =====================================================================
152 SUBROUTINE ZTZRZF( M, N, A, LDA, TAU, WORK, LWORK, INFO )
154 * -- LAPACK computational routine (version 3.4.1) --
155 * -- LAPACK is a software package provided by Univ. of Tennessee, --
156 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
159 * .. Scalar Arguments ..
160 INTEGER INFO, LDA, LWORK, M, N
162 * .. Array Arguments ..
163 COMPLEX*16 A( LDA, * ), TAU( * ), WORK( * )
166 * =====================================================================
170 PARAMETER ( ZERO = ( 0.0D+0, 0.0D+0 ) )
172 * .. Local Scalars ..
174 INTEGER I, IB, IWS, KI, KK, LDWORK, LWKMIN, LWKOPT,
175 $ M1, MU, NB, NBMIN, NX
177 * .. External Subroutines ..
178 EXTERNAL XERBLA, ZLARZB, ZLARZT, ZLATRZ
180 * .. Intrinsic Functions ..
183 * .. External Functions ..
187 * .. Executable Statements ..
189 * Test the input arguments
192 LQUERY = ( LWORK.EQ.-1 )
195 ELSE IF( N.LT.M ) THEN
197 ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
202 IF( M.EQ.0 .OR. M.EQ.N ) THEN
207 * Determine the block size.
209 NB = ILAENV( 1, 'ZGERQF', ' ', M, N, -1, -1 )
215 IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY ) THEN
221 CALL XERBLA( 'ZTZRZF', -INFO )
223 ELSE IF( LQUERY ) THEN
227 * Quick return if possible
231 ELSE IF( M.EQ.N ) THEN
241 IF( NB.GT.1 .AND. NB.LT.M ) THEN
243 * Determine when to cross over from blocked to unblocked code.
245 NX = MAX( 0, ILAENV( 3, 'ZGERQF', ' ', M, N, -1, -1 ) )
248 * Determine if workspace is large enough for blocked code.
252 IF( LWORK.LT.IWS ) THEN
254 * Not enough workspace to use optimal NB: reduce NB and
255 * determine the minimum value of NB.
258 NBMIN = MAX( 2, ILAENV( 2, 'ZGERQF', ' ', M, N, -1,
264 IF( NB.GE.NBMIN .AND. NB.LT.M .AND. NX.LT.M ) THEN
266 * Use blocked code initially.
267 * The last kk rows are handled by the block method.
270 KI = ( ( M-NX-1 ) / NB )*NB
273 DO 20 I = M - KK + KI + 1, M - KK + 1, -NB
274 IB = MIN( M-I+1, NB )
276 * Compute the TZ factorization of the current block
279 CALL ZLATRZ( IB, N-I+1, N-M, A( I, I ), LDA, TAU( I ),
283 * Form the triangular factor of the block reflector
284 * H = H(i+ib-1) . . . H(i+1) H(i)
286 CALL ZLARZT( 'Backward', 'Rowwise', N-M, IB, A( I, M1 ),
287 $ LDA, TAU( I ), WORK, LDWORK )
289 * Apply H to A(1:i-1,i:n) from the right
291 CALL ZLARZB( 'Right', 'No transpose', 'Backward',
292 $ 'Rowwise', I-1, N-I+1, IB, N-M, A( I, M1 ),
293 $ LDA, WORK, LDWORK, A( 1, I ), LDA,
294 $ WORK( IB+1 ), LDWORK )
302 * Use unblocked code to factor the last or only block
305 $ CALL ZLATRZ( MU, N, N-M, A, LDA, TAU, WORK )