139 SUBROUTINE dgerqf( M, N, A, LDA, TAU, WORK, LWORK, INFO )
147 INTEGER info, lda, lwork, m, n
150 DOUBLE PRECISION 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
189 nb =
ilaenv( 1,
'DGERQF',
' ', m, n, -1, -1 )
194 IF( lwork.LT.max( 1, m ) .AND. .NOT.lquery )
THEN
200 CALL
xerbla(
'DGERQF', -info )
202 ELSE IF( lquery )
THEN
215 IF( nb.GT.1 .AND. nb.LT.k )
THEN
219 nx = max( 0,
ilaenv( 3,
'DGERQF',
' ', m, n, -1, -1 ) )
226 IF( lwork.LT.iws )
THEN
232 nbmin = max( 2,
ilaenv( 2,
'DGERQF',
' ', m, n, -1,
238 IF( nb.GE.nbmin .AND. nb.LT.k .AND. nx.LT.k )
THEN
243 ki = ( ( k-nx-1 ) / nb )*nb
246 DO 10 i = k - kk + ki + 1, k - kk + 1, -nb
247 ib = min( k-i+1, nb )
252 CALL
dgerq2( ib, n-k+i+ib-1, a( m-k+i, 1 ), lda, tau( i ),
254 IF( m-k+i.GT.1 )
THEN
259 CALL
dlarft(
'Backward',
'Rowwise', n-k+i+ib-1, ib,
260 $ a( m-k+i, 1 ), lda, tau( i ), work, ldwork )
264 CALL
dlarfb(
'Right',
'No transpose',
'Backward',
265 $
'Rowwise', m-k+i-1, n-k+i+ib-1, ib,
266 $ a( m-k+i, 1 ), lda, work, ldwork, a, lda,
267 $ work( ib+1 ), ldwork )
270 mu = m - k + i + nb - 1
271 nu = n - k + i + nb - 1
279 IF( mu.GT.0 .AND. nu.GT.0 )
280 $ CALL
dgerq2( mu, nu, a, lda, tau, work, iinfo )
subroutine dlarft(DIRECT, STOREV, N, K, V, LDV, TAU, T, LDT)
DLARFT forms the triangular factor T of a block reflector H = I - vtvH
subroutine dlarfb(SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV, T, LDT, C, LDC, WORK, LDWORK)
DLARFB applies a block reflector or its transpose to a general rectangular matrix.
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine dgerqf(M, N, A, LDA, TAU, WORK, LWORK, INFO)
DGERQF
INTEGER function ilaenv(ISPEC, NAME, OPTS, N1, N2, N3, N4)
subroutine dgerq2(M, N, A, LDA, TAU, WORK, INFO)
DGERQ2 computes the RQ factorization of a general rectangular matrix using an unblocked algorithm...