129 SUBROUTINE sorgqr( 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, IINFO, IWS, J, KI, KK, L, LDWORK,
152 $ lwkopt, nb, nbmin, nx
169 nb = ilaenv( 1,
'SORGQR',
' ', m, n, k, -1 )
170 lwkopt = max( 1, n )*nb
172 lquery = ( lwork.EQ.-1 )
175 ELSE IF( n.LT.0 .OR. n.GT.m )
THEN
177 ELSE IF( k.LT.0 .OR. k.GT.n )
THEN
179 ELSE IF( lda.LT.max( 1, m ) )
THEN
181 ELSE IF( lwork.LT.max( 1, n ) .AND. .NOT.lquery )
THEN
185 CALL xerbla(
'SORGQR', -info )
187 ELSE IF( lquery )
THEN
201 IF( nb.GT.1 .AND. nb.LT.k )
THEN
205 nx = max( 0, ilaenv( 3,
'SORGQR',
' ', m, n, k, -1 ) )
212 IF( lwork.LT.iws )
THEN
218 nbmin = max( 2, ilaenv( 2,
'SORGQR',
' ', m, n, k, -1 ) )
223 IF( nb.GE.nbmin .AND. nb.LT.k .AND. nx.LT.k )
THEN
228 ki = ( ( k-nx-1 ) / nb )*nb
245 $
CALL sorg2r( m-kk, n-kk, k-kk, a( kk+1, kk+1 ), lda,
246 $ tau( kk+1 ), work, iinfo )
252 DO 50 i = ki + 1, 1, -nb
253 ib = min( nb, k-i+1 )
259 CALL slarft(
'Forward',
'Columnwise', m-i+1, ib,
260 $ a( i, i ), lda, tau( i ), work, ldwork )
264 CALL slarfb(
'Left',
'No transpose',
'Forward',
265 $
'Columnwise', m-i+1, n-i-ib+1, ib,
266 $ a( i, i ), lda, work, ldwork, a( i, i+ib ),
267 $ lda, work( ib+1 ), ldwork )
272 CALL sorg2r( m-i+1, ib, ib, a( i, i ), lda, tau( i ), work,
277 DO 40 j = i, i + ib - 1
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 sorg2r(M, N, K, A, LDA, TAU, WORK, INFO)
SORG2R generates all or part of the orthogonal matrix Q from a QR factorization determined by sgeqrf ...
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine sorgqr(M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
SORGQR
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.