141 SUBROUTINE sgelqf( M, N, A, LDA, TAU, WORK, LWORK, INFO )
148 INTEGER INFO, LDA, LWORK, M, N
151 REAL A( LDA, * ), TAU( * ), WORK( * )
158 INTEGER I, IB, IINFO, IWS, K, LDWORK, LWKOPT, NB,
170 EXTERNAL ilaenv, sroundup_lwork
178 nb = ilaenv( 1,
'SGELQF',
' ', m, n, -1, -1 )
179 lquery = ( lwork.EQ.-1 )
182 ELSE IF( n.LT.0 )
THEN
184 ELSE IF( lda.LT.max( 1, m ) )
THEN
186 ELSE IF( .NOT.lquery )
THEN
187 IF( lwork.LE.0 .OR. ( n.GT.0 .AND. lwork.LT.max( 1, m ) ) )
191 CALL xerbla(
'SGELQF', -info )
193 ELSE IF( lquery )
THEN
199 work( 1 ) = sroundup_lwork( lwkopt )
213 IF( nb.GT.1 .AND. nb.LT.k )
THEN
217 nx = max( 0, ilaenv( 3,
'SGELQF',
' ', m, n, -1, -1 ) )
224 IF( lwork.LT.iws )
THEN
230 nbmin = max( 2, ilaenv( 2,
'SGELQF',
' ', m, n, -1,
236 IF( nb.GE.nbmin .AND. nb.LT.k .AND. nx.LT.k )
THEN
240 DO 10 i = 1, k - nx, nb
241 ib = min( k-i+1, nb )
246 CALL sgelq2( ib, n-i+1, a( i, i ), lda, tau( i ), work,
253 CALL slarft(
'Forward',
'Rowwise', n-i+1, ib, a( i,
255 $ lda, tau( i ), work, ldwork )
259 CALL slarfb(
'Right',
'No transpose',
'Forward',
260 $
'Rowwise', m-i-ib+1, n-i+1, ib, a( i, i ),
261 $ lda, work, ldwork, a( i+ib, i ), lda,
262 $ work( ib+1 ), ldwork )
272 $
CALL sgelq2( m-i+1, n-i+1, a( i, i ), lda, tau( i ), work,
275 work( 1 ) = sroundup_lwork( iws )
subroutine sgelq2(m, n, a, lda, tau, work, info)
SGELQ2 computes the LQ factorization of a general rectangular matrix using an unblocked algorithm.
subroutine sgelqf(m, n, a, lda, tau, work, lwork, info)
SGELQF
subroutine slarfb(side, trans, direct, storev, m, n, k, v, ldv, t, ldt, c, ldc, work, ldwork)
SLARFB applies a block reflector or its transpose to a general rectangular matrix.
recursive subroutine slarft(direct, storev, n, k, v, ldv, tau, t, ldt)
SLARFT forms the triangular factor T of a block reflector H = I - vtvH