139 SUBROUTINE sgerqf( M, N, A, LDA, TAU, WORK, LWORK, INFO )
147 INTEGER INFO, LDA, LWORK, M, N
150 REAL A( lda, * ), TAU( * ), WORK( * )
157 INTEGER I, IB, IINFO, IWS, K, KI, KK, LDWORK, LWKOPT,
158 $ mu, nb, nbmin, nu, nx
175 lquery = ( lwork.EQ.-1 )
178 ELSE IF( n.LT.0 )
THEN
180 ELSE IF( lda.LT.max( 1, m ) )
THEN
182 ELSE IF( lwork.LT.max( 1, m ) .AND. .NOT.lquery )
THEN
191 nb = ilaenv( 1,
'SGERQF',
' ', m, n, -1, -1 )
197 IF( lwork.LT.max( 1, m ) .AND. .NOT.lquery )
THEN
203 CALL xerbla(
'SGERQF', -info )
205 ELSE IF( lquery )
THEN
218 IF( nb.GT.1 .AND. nb.LT.k )
THEN
222 nx = max( 0, ilaenv( 3,
'SGERQF',
' ', m, n, -1, -1 ) )
229 IF( lwork.LT.iws )
THEN
235 nbmin = max( 2, ilaenv( 2,
'SGERQF',
' ', m, n, -1,
241 IF( nb.GE.nbmin .AND. nb.LT.k .AND. nx.LT.k )
THEN
246 ki = ( ( k-nx-1 ) / nb )*nb
249 DO 10 i = k - kk + ki + 1, k - kk + 1, -nb
250 ib = min( k-i+1, nb )
255 CALL sgerq2( ib, n-k+i+ib-1, a( m-k+i, 1 ), lda, tau( i ),
257 IF( m-k+i.GT.1 )
THEN
262 CALL slarft(
'Backward',
'Rowwise', n-k+i+ib-1, ib,
263 $ a( m-k+i, 1 ), lda, tau( i ), work, ldwork )
267 CALL slarfb(
'Right',
'No transpose',
'Backward',
268 $
'Rowwise', m-k+i-1, n-k+i+ib-1, ib,
269 $ a( m-k+i, 1 ), lda, work, ldwork, a, lda,
270 $ work( ib+1 ), ldwork )
273 mu = m - k + i + nb - 1
274 nu = n - k + i + nb - 1
282 IF( mu.GT.0 .AND. nu.GT.0 )
283 $
CALL sgerq2( mu, nu, a, lda, tau, work, iinfo )
subroutine slarft(DIRECT, STOREV, N, K, V, LDV, TAU, T, LDT)
SLARFT forms the triangular factor T of a block reflector H = I - vtvH
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine sgerq2(M, N, A, LDA, TAU, WORK, INFO)
SGERQ2 computes the RQ factorization of a general rectangular matrix using an unblocked algorithm...
subroutine sgerqf(M, N, A, LDA, TAU, WORK, LWORK, INFO)
SGERQF
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.