150 SUBROUTINE zgeqrf ( M, N, A, LDA, TAU, WORK, LWORK, INFO )
157 INTEGER INFO, LDA, LWORK, M, N
160 COMPLEX*16 A( LDA, * ), TAU( * ), WORK( * )
167 INTEGER I, IB, IINFO, IWS, J, K, LWKOPT, NB,
168 $ NBMIN, NX, LBWORK, NT, LLWORK
179 EXTERNAL ilaenv, sceil
188 nb = ilaenv( 1,
'ZGEQRF',
' ', m, n, -1, -1 )
190 IF( nb.GT.1 .AND. nb.LT.k )
THEN
194 nx = max( 0, ilaenv( 3,
'ZGEQRF',
' ', m, n, -1, -1 ) )
207 nt = k-sceil(real(k-nx)/real(nb))*nb
212 llwork = max(max((n-m)*k, (n-m)*nb), max(k*nb, nb*nb))
213 llwork = sceil(real(llwork)/real(nb))
221 lwkopt = (lbwork+llwork)*nb
222 work( 1 ) = (lwkopt+nt*nt)
226 lbwork = sceil(real(k)/real(nb))*nb
227 lwkopt = (lbwork+llwork-nb)*nb
235 lquery = ( lwork.EQ.-1 )
238 ELSE IF( n.LT.0 )
THEN
240 ELSE IF( lda.LT.max( 1, m ) )
THEN
242 ELSE IF( lwork.LT.max( 1, n ) .AND. .NOT.lquery )
THEN
246 CALL xerbla(
'ZGEQRF', -info )
248 ELSE IF( lquery )
THEN
259 IF( nb.GT.1 .AND. nb.LT.k )
THEN
266 iws = (lbwork+llwork-nb)*nb
268 iws = (lbwork+llwork)*nb+nt*nt
271 IF( lwork.LT.iws )
THEN
277 nb = lwork / (llwork+(lbwork-nb))
279 nb = (lwork-nt*nt)/(lbwork+llwork)
282 nbmin = max( 2, ilaenv( 2,
'ZGEQRF',
' ', m, n, -1,
288 IF( nb.GE.nbmin .AND. nb.LT.k .AND. nx.LT.k )
THEN
292 DO 10 i = 1, k - nx, nb
293 ib = min( k-i+1, nb )
297 DO 20 j = 1, i - nb, nb
301 CALL zlarfb(
'Left',
'Transpose',
'Forward',
302 $
'Columnwise', m-j+1, ib, nb,
303 $ a( j, j ), lda, work(j), lbwork,
304 $ a( j, i ), lda, work(lbwork*nb+nt*nt+1),
312 CALL zgeqr2( m-i+1, ib, a( i, i ), lda, tau( i ),
313 $ work(lbwork*nb+nt*nt+1), iinfo )
320 CALL zlarft(
'Forward',
'Columnwise', m-i+1, ib,
321 $ a( i, i ), lda, tau( i ),
336 DO 30 j = 1, i - nb, nb
340 CALL zlarfb(
'Left',
'Transpose',
'Forward',
341 $
'Columnwise', m-j+1, k-i+1, nb,
342 $ a( j, j ), lda, work(j), lbwork,
343 $ a( j, i ), lda, work(lbwork*nb+nt*nt+1),
347 CALL zgeqr2( m-i+1, k-i+1, a( i, i ), lda, tau( i ),
348 $ work(lbwork*nb+nt*nt+1),iinfo )
354 CALL zgeqr2( m-i+1, n-i+1, a( i, i ), lda, tau( i ),
364 IF ( m.LT.n .AND. i.NE.1)
THEN
369 IF ( nt .LE. nb )
THEN
370 CALL zlarft(
'Forward',
'Columnwise', m-i+1, k-i+1,
371 $ a( i, i ), lda, tau( i ), work(i), lbwork )
373 CALL zlarft(
'Forward',
'Columnwise', m-i+1, k-i+1,
374 $ a( i, i ), lda, tau( i ),
375 $ work(lbwork*nb+1), nt )
381 DO 40 j = 1, k-nx, nb
383 ib = min( k-j+1, nb )
385 CALL zlarfb(
'Left',
'Transpose',
'Forward',
386 $
'Columnwise', m-j+1, n-m, ib,
387 $ a( j, j ), lda, work(j), lbwork,
388 $ a( j, m+1 ), lda, work(lbwork*nb+nt*nt+1),
394 CALL zlarfb(
'Left',
'Transpose',
'Forward',
395 $
'Columnwise', m-j+1, n-m, k-j+1,
396 $ a( j, j ), lda, work(j), lbwork,
397 $ a( j, m+1 ), lda, work(lbwork*nb+nt*nt+1),
400 CALL zlarfb(
'Left',
'Transpose',
'Forward',
401 $
'Columnwise', m-j+1, n-m, k-j+1,
404 $ nt, a( j, m+1 ), lda, work(lbwork*nb+nt*nt+1),
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine zgeqr2(M, N, A, LDA, TAU, WORK, INFO)
ZGEQR2 computes the QR factorization of a general rectangular matrix using an unblocked algorithm.
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.
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 zgeqrf(M, N, A, LDA, TAU, WORK, LWORK, INFO)
ZGEQRF VARIANT: left-looking Level 3 BLAS of the algorithm.