129 SUBROUTINE sorgrq( M, N, K, A, LDA, TAU, WORK, LWORK, INFO )
137 INTEGER INFO, K, LDA, LWORK, M, N
140 REAL A( lda, * ), TAU( * ), WORK( * )
147 parameter( zero = 0.0e+0 )
151 INTEGER I, IB, II, IINFO, IWS, J, KK, L, LDWORK,
152 $ lwkopt, nb, nbmin, nx
169 lquery = ( lwork.EQ.-1 )
172 ELSE IF( n.LT.m )
THEN
174 ELSE IF( k.LT.0 .OR. k.GT.m )
THEN
176 ELSE IF( lda.LT.max( 1, m ) )
THEN
184 nb = ilaenv( 1,
'SORGRQ',
' ', m, n, k, -1 )
189 IF( lwork.LT.max( 1, m ) .AND. .NOT.lquery )
THEN
195 CALL xerbla(
'SORGRQ', -info )
197 ELSE IF( lquery )
THEN
210 IF( nb.GT.1 .AND. nb.LT.k )
THEN
214 nx = max( 0, ilaenv( 3,
'SORGRQ',
' ', m, n, k, -1 ) )
221 IF( lwork.LT.iws )
THEN
227 nbmin = max( 2, ilaenv( 2,
'SORGRQ',
' ', m, n, k, -1 ) )
232 IF( nb.GE.nbmin .AND. nb.LT.k .AND. nx.LT.k )
THEN
237 kk = min( k, ( ( k-nx+nb-1 ) / nb )*nb )
241 DO 20 j = n - kk + 1, n
252 CALL sorgr2( m-kk, n-kk, k-kk, a, lda, tau, work, iinfo )
258 DO 50 i = k - kk + 1, k, nb
259 ib = min( nb, k-i+1 )
266 CALL slarft(
'Backward',
'Rowwise', n-k+i+ib-1, ib,
267 $ a( ii, 1 ), lda, tau( i ), work, ldwork )
271 CALL slarfb(
'Right',
'Transpose',
'Backward',
'Rowwise',
272 $ ii-1, n-k+i+ib-1, ib, a( ii, 1 ), lda, work,
273 $ ldwork, a, lda, work( ib+1 ), ldwork )
278 CALL sorgr2( ib, n-k+i+ib-1, ib, a( ii, 1 ), lda, tau( i ),
283 DO 40 l = n - k + i + ib, n
284 DO 30 j = ii, ii + ib - 1
subroutine sorgr2(M, N, K, A, LDA, TAU, WORK, INFO)
SORGR2 generates all or part of the orthogonal matrix Q from an RQ factorization determined by sgerqf...
subroutine sorgrq(M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
SORGRQ
subroutine xerbla(SRNAME, INFO)
XERBLA
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