129 SUBROUTINE zungrq( M, N, K, A, LDA, TAU, WORK, LWORK, INFO )
137 INTEGER INFO, K, LDA, LWORK, M, N
140 COMPLEX*16 A( lda, * ), TAU( * ), WORK( * )
147 parameter ( zero = ( 0.0d+0, 0.0d+0 ) )
151 INTEGER I, IB, II, IINFO, IWS, J, KK, L, LDWORK,
152 $ lwkopt, nb, nbmin, nx
169 lquery = ( lwork.EQ.-1 )
172 ELSE IF( n.LT.m )
THEN
174 ELSE IF( k.LT.0 .OR. k.GT.m )
THEN
176 ELSE IF( lda.LT.max( 1, m ) )
THEN
184 nb = ilaenv( 1,
'ZUNGRQ',
' ', m, n, k, -1 )
189 IF( lwork.LT.max( 1, m ) .AND. .NOT.lquery )
THEN
195 CALL xerbla(
'ZUNGRQ', -info )
197 ELSE IF( lquery )
THEN
210 IF( nb.GT.1 .AND. nb.LT.k )
THEN
214 nx = max( 0, ilaenv( 3,
'ZUNGRQ',
' ', m, n, k, -1 ) )
221 IF( lwork.LT.iws )
THEN
227 nbmin = max( 2, ilaenv( 2,
'ZUNGRQ',
' ', m, n, k, -1 ) )
232 IF( nb.GE.nbmin .AND. nb.LT.k .AND. nx.LT.k )
THEN
237 kk = min( k, ( ( k-nx+nb-1 ) / nb )*nb )
241 DO 20 j = n - kk + 1, n
252 CALL zungr2( m-kk, n-kk, k-kk, a, lda, tau, work, iinfo )
258 DO 50 i = k - kk + 1, k, nb
259 ib = min( nb, k-i+1 )
266 CALL zlarft(
'Backward',
'Rowwise', n-k+i+ib-1, ib,
267 $ a( ii, 1 ), lda, tau( i ), work, ldwork )
271 CALL zlarfb(
'Right',
'Conjugate transpose',
'Backward',
272 $
'Rowwise', ii-1, n-k+i+ib-1, ib, a( ii, 1 ),
273 $ lda, work, ldwork, a, lda, work( ib+1 ),
279 CALL zungr2( ib, n-k+i+ib-1, ib, a( ii, 1 ), lda, tau( i ),
284 DO 40 l = n - k + i + ib, n
285 DO 30 j = ii, ii + ib - 1
subroutine zungrq(M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
ZUNGRQ
subroutine zlarft(DIRECT, STOREV, N, K, V, LDV, TAU, T, LDT)
ZLARFT forms the triangular factor T of a block reflector H = I - vtvH
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine zungr2(M, N, K, A, LDA, TAU, WORK, INFO)
ZUNGR2 generates all or part of the unitary matrix Q from an RQ factorization determined by cgerqf (u...
subroutine zlarfb(SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV, T, LDT, C, LDC, WORK, LDWORK)
ZLARFB applies a block reflector or its conjugate-transpose to a general rectangular matrix...