137 SUBROUTINE sgeqrfp( M, N, A, LDA, TAU, WORK, LWORK, INFO )
145 INTEGER INFO, LDA, LWORK, M, N
148 REAL A( lda, * ), TAU( * ), WORK( * )
155 INTEGER I, IB, IINFO, IWS, K, LDWORK, LWKOPT, NB,
173 nb = ilaenv( 1,
'SGEQRF',
' ', m, n, -1, -1 )
176 lquery = ( lwork.EQ.-1 )
179 ELSE IF( n.LT.0 )
THEN
181 ELSE IF( lda.LT.max( 1, m ) )
THEN
183 ELSE IF( lwork.LT.max( 1, n ) .AND. .NOT.lquery )
THEN
187 CALL xerbla(
'SGEQRFP', -info )
189 ELSE IF( lquery )
THEN
204 IF( nb.GT.1 .AND. nb.LT.k )
THEN
208 nx = max( 0, ilaenv( 3,
'SGEQRF',
' ', m, n, -1, -1 ) )
215 IF( lwork.LT.iws )
THEN
221 nbmin = max( 2, ilaenv( 2,
'SGEQRF',
' ', m, n, -1,
227 IF( nb.GE.nbmin .AND. nb.LT.k .AND. nx.LT.k )
THEN
231 DO 10 i = 1, k - nx, nb
232 ib = min( k-i+1, nb )
237 CALL sgeqr2p( m-i+1, ib, a( i, i ), lda, tau( i ), work,
244 CALL slarft(
'Forward',
'Columnwise', m-i+1, ib,
245 $ a( i, i ), lda, tau( i ), work, ldwork )
249 CALL slarfb(
'Left',
'Transpose',
'Forward',
250 $
'Columnwise', m-i+1, n-i-ib+1, ib,
251 $ a( i, i ), lda, work, ldwork, a( i, i+ib ),
252 $ lda, work( ib+1 ), ldwork )
262 $
CALL sgeqr2p( m-i+1, n-i+1, a( i, i ), lda, tau( i ), work,
subroutine sgeqr2p(M, N, A, LDA, TAU, WORK, INFO)
SGEQR2P computes the QR factorization of a general rectangular matrix with non-negative diagonal elem...
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine sgeqrfp(M, N, A, LDA, TAU, WORK, LWORK, INFO)
SGEQRFP
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.
subroutine slarft(DIRECT, STOREV, N, K, V, LDV, TAU, T, LDT)
SLARFT forms the triangular factor T of a block reflector H = I - vtvH