128 SUBROUTINE sorglq( M, N, K, A, LDA, TAU, WORK, LWORK, INFO )
136 INTEGER INFO, K, LDA, LWORK, M, N
139 REAL A( lda, * ), TAU( * ), WORK( * )
146 parameter ( zero = 0.0e+0 )
150 INTEGER I, IB, IINFO, IWS, J, KI, KK, L, LDWORK,
151 $ lwkopt, nb, nbmin, nx
168 nb = ilaenv( 1,
'SORGLQ',
' ', m, n, k, -1 )
169 lwkopt = max( 1, m )*nb
171 lquery = ( lwork.EQ.-1 )
174 ELSE IF( n.LT.m )
THEN
176 ELSE IF( k.LT.0 .OR. k.GT.m )
THEN
178 ELSE IF( lda.LT.max( 1, m ) )
THEN
180 ELSE IF( lwork.LT.max( 1, m ) .AND. .NOT.lquery )
THEN
184 CALL xerbla(
'SORGLQ', -info )
186 ELSE IF( lquery )
THEN
200 IF( nb.GT.1 .AND. nb.LT.k )
THEN
204 nx = max( 0, ilaenv( 3,
'SORGLQ',
' ', m, n, k, -1 ) )
211 IF( lwork.LT.iws )
THEN
217 nbmin = max( 2, ilaenv( 2,
'SORGLQ',
' ', m, n, k, -1 ) )
222 IF( nb.GE.nbmin .AND. nb.LT.k .AND. nx.LT.k )
THEN
227 ki = ( ( k-nx-1 ) / nb )*nb
244 $
CALL sorgl2( m-kk, n-kk, k-kk, a( kk+1, kk+1 ), lda,
245 $ tau( kk+1 ), work, iinfo )
251 DO 50 i = ki + 1, 1, -nb
252 ib = min( nb, k-i+1 )
258 CALL slarft(
'Forward',
'Rowwise', n-i+1, ib, a( i, i ),
259 $ lda, tau( i ), work, ldwork )
263 CALL slarfb(
'Right',
'Transpose',
'Forward',
'Rowwise',
264 $ m-i-ib+1, n-i+1, ib, a( i, i ), lda, work,
265 $ ldwork, a( i+ib, i ), lda, work( ib+1 ),
271 CALL sorgl2( ib, n-i+1, ib, a( i, i ), lda, tau( i ), work,
277 DO 30 l = i, i + ib - 1
subroutine sorglq(M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
SORGLQ
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 sorgl2(M, N, K, A, LDA, TAU, WORK, INFO)
SORGL2
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.