129 SUBROUTINE dorgqr( M, N, K, A, LDA, TAU, WORK, LWORK, INFO )
137 INTEGER INFO, K, LDA, LWORK, M, N
140 DOUBLE PRECISION A( lda, * ), TAU( * ), WORK( * )
146 DOUBLE PRECISION ZERO
147 parameter ( zero = 0.0d+0 )
151 INTEGER I, IB, IINFO, IWS, J, KI, KK, L, LDWORK,
152 $ lwkopt, nb, nbmin, nx
169 nb = ilaenv( 1,
'DORGQR',
' ', 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(
'DORGQR', -info )
187 ELSE IF( lquery )
THEN
201 IF( nb.GT.1 .AND. nb.LT.k )
THEN
205 nx = max( 0, ilaenv( 3,
'DORGQR',
' ', m, n, k, -1 ) )
212 IF( lwork.LT.iws )
THEN
218 nbmin = max( 2, ilaenv( 2,
'DORGQR',
' ', 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 dorg2r( 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 dlarft(
'Forward',
'Columnwise', m-i+1, ib,
260 $ a( i, i ), lda, tau( i ), work, ldwork )
264 CALL dlarfb(
'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 dorg2r( m-i+1, ib, ib, a( i, i ), lda, tau( i ), work,
277 DO 40 j = i, i + ib - 1
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 dorg2r(M, N, K, A, LDA, TAU, WORK, INFO)
DORG2R generates all or part of the orthogonal matrix Q from a QR factorization determined by sgeqrf ...
subroutine dorgqr(M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
DORGQR
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 xerbla(SRNAME, INFO)
XERBLA