152 SUBROUTINE sgeqp3( M, N, A, LDA, JPVT, TAU, WORK, LWORK, INFO )
160 INTEGER info, lda, lwork, m, n
164 REAL a( lda, * ), tau( * ), work( * )
170 INTEGER inb, inbmin, ixover
171 parameter( inb = 1, inbmin = 2, ixover = 3 )
175 INTEGER fjb, iws,
j, jb, lwkopt, minmn, minws, na, nb,
176 $ nbmin, nfxd, nx, sm, sminmn, sn, topbmn
187 INTRINSIC int, max, min
192 lquery = ( lwork.EQ.-1 )
195 ELSE IF( n.LT.0 )
THEN
197 ELSE IF( lda.LT.max( 1, m ) )
THEN
203 IF( minmn.EQ.0 )
THEN
208 nb =
ilaenv( inb,
'SGEQRF',
' ', m, n, -1, -1 )
209 lwkopt = 2*n + ( n + 1 )*nb
213 IF( ( lwork.LT.iws ) .AND. .NOT.lquery )
THEN
219 CALL
xerbla(
'SGEQP3', -info )
221 ELSE IF( lquery )
THEN
227 IF( minmn.EQ.0 )
THEN
235 IF( jpvt(
j ).NE.0 )
THEN
237 CALL
sswap( m, a( 1,
j ), 1, a( 1, nfxd ), 1 )
238 jpvt(
j ) = jpvt( nfxd )
259 CALL
sgeqrf( m, na, a, lda, tau, work, lwork, info )
260 iws = max( iws, int( work( 1 ) ) )
264 CALL
sormqr(
'Left',
'Transpose', m, n-na, na, a, lda, tau,
265 $ a( 1, na+1 ), lda, work, lwork, info )
266 iws = max( iws, int( work( 1 ) ) )
273 IF( nfxd.LT.minmn )
THEN
277 sminmn = minmn - nfxd
281 nb =
ilaenv( inb,
'SGEQRF',
' ', sm, sn, -1, -1 )
285 IF( ( nb.GT.1 ) .AND. ( nb.LT.sminmn ) )
THEN
289 nx = max( 0,
ilaenv( ixover,
'SGEQRF',
' ', sm, sn, -1,
293 IF( nx.LT.sminmn )
THEN
297 minws = 2*sn + ( sn+1 )*nb
298 iws = max( iws, minws )
299 IF( lwork.LT.minws )
THEN
304 nb = ( lwork-2*sn ) / ( sn+1 )
305 nbmin = max( 2,
ilaenv( inbmin,
'SGEQRF',
' ', sm, sn,
316 DO 20
j = nfxd + 1, n
317 work(
j ) =
snrm2( sm, a( nfxd+1,
j ), 1 )
318 work( n+
j ) = work(
j )
321 IF( ( nb.GE.nbmin ) .AND. ( nb.LT.sminmn ) .AND.
322 $ ( nx.LT.sminmn ) )
THEN
333 IF(
j.LE.topbmn )
THEN
334 jb = min( nb, topbmn-
j+1 )
338 CALL
slaqps( m, n-
j+1,
j-1, jb, fjb, a( 1,
j ), lda,
339 $ jpvt(
j ), tau(
j ), work(
j ), work( n+
j ),
340 $ work( 2*n+1 ), work( 2*n+jb+1 ), n-
j+1 )
353 $ CALL
slaqp2( m, n-
j+1,
j-1, a( 1,
j ), lda, jpvt(
j ),
354 $ tau(
j ), work(
j ), work( n+
j ),