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 ),
subroutine sswap(N, SX, INCX, SY, INCY)
SSWAP
subroutine sormqr(SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
SORMQR
subroutine sgeqp3(M, N, A, LDA, JPVT, TAU, WORK, LWORK, INFO)
SGEQP3
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine slaqp2(M, N, OFFSET, A, LDA, JPVT, TAU, VN1, VN2, WORK)
SLAQP2 computes a QR factorization with column pivoting of the matrix block.
INTEGER function ilaenv(ISPEC, NAME, OPTS, N1, N2, N3, N4)
subroutine slaqps(M, N, OFFSET, NB, KB, A, LDA, JPVT, TAU, VN1, VN2, AUXV, F, LDF)
SLAQPS computes a step of QR factorization with column pivoting of a real m-by-n matrix A by using BL...
subroutine sgeqrf(M, N, A, LDA, TAU, WORK, LWORK, INFO)
SGEQRF
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
REAL function snrm2(N, X, INCX)
SNRM2