129 SUBROUTINE cungqr( M, N, K, A, LDA, TAU, WORK, LWORK, INFO )
137 INTEGER INFO, K, LDA, LWORK, M, N
140 COMPLEX A( lda, * ), TAU( * ), WORK( * )
147 parameter ( zero = ( 0.0e+0, 0.0e+0 ) )
151 INTEGER I, IB, IINFO, IWS, J, KI, KK, L, LDWORK,
152 $ lwkopt, nb, nbmin, nx
169 nb = ilaenv( 1,
'CUNGQR',
' ', m, n, k, -1 )
170 lwkopt = max( 1, n )*nb
172 lquery = ( lwork.EQ.-1 )
175 ELSE IF( n.LT.0 .OR. n.GT.m )
THEN
177 ELSE IF( k.LT.0 .OR. k.GT.n )
THEN
179 ELSE IF( lda.LT.max( 1, m ) )
THEN
181 ELSE IF( lwork.LT.max( 1, n ) .AND. .NOT.lquery )
THEN
185 CALL xerbla(
'CUNGQR', -info )
187 ELSE IF( lquery )
THEN
201 IF( nb.GT.1 .AND. nb.LT.k )
THEN
205 nx = max( 0, ilaenv( 3,
'CUNGQR',
' ', m, n, k, -1 ) )
212 IF( lwork.LT.iws )
THEN
218 nbmin = max( 2, ilaenv( 2,
'CUNGQR',
' ', m, n, k, -1 ) )
223 IF( nb.GE.nbmin .AND. nb.LT.k .AND. nx.LT.k )
THEN
228 ki = ( ( k-nx-1 ) / nb )*nb
245 $
CALL cung2r( m-kk, n-kk, k-kk, a( kk+1, kk+1 ), lda,
246 $ tau( kk+1 ), work, iinfo )
252 DO 50 i = ki + 1, 1, -nb
253 ib = min( nb, k-i+1 )
259 CALL clarft(
'Forward',
'Columnwise', m-i+1, ib,
260 $ a( i, i ), lda, tau( i ), work, ldwork )
264 CALL clarfb(
'Left',
'No transpose',
'Forward',
265 $
'Columnwise', m-i+1, n-i-ib+1, ib,
266 $ a( i, i ), lda, work, ldwork, a( i, i+ib ),
267 $ lda, work( ib+1 ), ldwork )
272 CALL cung2r( m-i+1, ib, ib, a( i, i ), lda, tau( i ), work,
277 DO 40 j = i, i + ib - 1
subroutine clarft(DIRECT, STOREV, N, K, V, LDV, TAU, T, LDT)
CLARFT forms the triangular factor T of a block reflector H = I - vtvH
subroutine cung2r(M, N, K, A, LDA, TAU, WORK, INFO)
CUNG2R
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine cungqr(M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
CUNGQR
subroutine clarfb(SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV, T, LDT, C, LDC, WORK, LDWORK)
CLARFB applies a block reflector or its conjugate-transpose to a general rectangular matrix...