126 SUBROUTINE sorglq( M, N, K, A, LDA, TAU, WORK, LWORK, INFO )
133 INTEGER INFO, K, LDA, LWORK, M, N
136 REAL A( LDA, * ), TAU( * ), WORK( * )
143 parameter( zero = 0.0e+0 )
147 INTEGER I, IB, IINFO, IWS, J, KI, KK, L, LDWORK,
148 $ LWKOPT, NB, NBMIN, NX
159 EXTERNAL ilaenv, sroundup_lwork
166 nb = ilaenv( 1,
'SORGLQ',
' ', m, n, k, -1 )
167 lwkopt = max( 1, m )*nb
168 work( 1 ) = sroundup_lwork(lwkopt)
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
178 ELSE IF( lwork.LT.max( 1, m ) .AND. .NOT.lquery )
THEN
182 CALL xerbla(
'SORGLQ', -info )
184 ELSE IF( lquery )
THEN
198 IF( nb.GT.1 .AND. nb.LT.k )
THEN
202 nx = max( 0, ilaenv( 3,
'SORGLQ',
' ', m, n, k, -1 ) )
209 IF( lwork.LT.iws )
THEN
215 nbmin = max( 2, ilaenv( 2,
'SORGLQ',
' ', m, n, k, -1 ) )
220 IF( nb.GE.nbmin .AND. nb.LT.k .AND. nx.LT.k )
THEN
225 ki = ( ( k-nx-1 ) / nb )*nb
242 $
CALL sorgl2( m-kk, n-kk, k-kk, a( kk+1, kk+1 ), lda,
243 $ tau( kk+1 ), work, iinfo )
249 DO 50 i = ki + 1, 1, -nb
250 ib = min( nb, k-i+1 )
256 CALL slarft(
'Forward',
'Rowwise', n-i+1, ib, a( i, i ),
257 $ lda, tau( i ), work, ldwork )
261 CALL slarfb(
'Right',
'Transpose',
'Forward',
'Rowwise',
262 $ m-i-ib+1, n-i+1, ib, a( i, i ), lda, work,
263 $ ldwork, a( i+ib, i ), lda, work( ib+1 ),
269 CALL sorgl2( ib, n-i+1, ib, a( i, i ), lda, tau( i ), work,
275 DO 30 l = i, i + ib - 1
282 work( 1 ) = sroundup_lwork(iws)
subroutine xerbla(srname, info)
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
subroutine sorgl2(m, n, k, a, lda, tau, work, info)
SORGL2
subroutine sorglq(m, n, k, a, lda, tau, work, lwork, info)
SORGLQ