125 SUBROUTINE sorgrq( M, N, K, A, LDA, TAU, WORK, LWORK, INFO )
132 INTEGER INFO, K, LDA, LWORK, M, N
135 REAL A( LDA, * ), TAU( * ), WORK( * )
142 parameter( zero = 0.0e+0 )
146 INTEGER I, IB, II, IINFO, IWS, J, KK, L, LDWORK,
147 $ LWKOPT, NB, NBMIN, NX
158 EXTERNAL ilaenv, sroundup_lwork
165 lquery = ( lwork.EQ.-1 )
168 ELSE IF( n.LT.m )
THEN
170 ELSE IF( k.LT.0 .OR. k.GT.m )
THEN
172 ELSE IF( lda.LT.max( 1, m ) )
THEN
180 nb = ilaenv( 1,
'SORGRQ',
' ', m, n, k, -1 )
183 work( 1 ) = sroundup_lwork(lwkopt)
185 IF( lwork.LT.max( 1, m ) .AND. .NOT.lquery )
THEN
191 CALL xerbla(
'SORGRQ', -info )
193 ELSE IF( lquery )
THEN
206 IF( nb.GT.1 .AND. nb.LT.k )
THEN
210 nx = max( 0, ilaenv( 3,
'SORGRQ',
' ', m, n, k, -1 ) )
217 IF( lwork.LT.iws )
THEN
223 nbmin = max( 2, ilaenv( 2,
'SORGRQ',
' ', m, n, k,
229 IF( nb.GE.nbmin .AND. nb.LT.k .AND. nx.LT.k )
THEN
234 kk = min( k, ( ( k-nx+nb-1 ) / nb )*nb )
238 DO 20 j = n - kk + 1, n
249 CALL sorgr2( m-kk, n-kk, k-kk, a, lda, tau, work, iinfo )
255 DO 50 i = k - kk + 1, k, nb
256 ib = min( nb, k-i+1 )
263 CALL slarft(
'Backward',
'Rowwise', n-k+i+ib-1, ib,
264 $ a( ii, 1 ), lda, tau( i ), work, ldwork )
268 CALL slarfb(
'Right',
'Transpose',
'Backward',
270 $ ii-1, n-k+i+ib-1, ib, a( ii, 1 ), lda, work,
271 $ ldwork, a, lda, work( ib+1 ), ldwork )
276 CALL sorgr2( ib, n-k+i+ib-1, ib, a( ii, 1 ), lda,
282 DO 40 l = n - k + i + ib, n
283 DO 30 j = ii, ii + ib - 1
290 work( 1 ) = sroundup_lwork(iws)
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
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