152 SUBROUTINE dgeqp3( M, N, A, LDA, JPVT, TAU, WORK, LWORK, INFO )
160 INTEGER info, lda, lwork, m, n
164 DOUBLE PRECISION 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
183 DOUBLE PRECISION dnrm2
187 INTRINSIC int, max, min
195 lquery = ( lwork.EQ.-1 )
198 ELSE IF( n.LT.0 )
THEN
200 ELSE IF( lda.LT.max( 1, m ) )
THEN
206 IF( minmn.EQ.0 )
THEN
211 nb =
ilaenv( inb,
'DGEQRF',
' ', m, n, -1, -1 )
212 lwkopt = 2*n + ( n + 1 )*nb
216 IF( ( lwork.LT.iws ) .AND. .NOT.lquery )
THEN
222 CALL
xerbla(
'DGEQP3', -info )
224 ELSE IF( lquery )
THEN
230 IF( minmn.EQ.0 )
THEN
238 IF( jpvt(
j ).NE.0 )
THEN
240 CALL
dswap( m, a( 1,
j ), 1, a( 1, nfxd ), 1 )
241 jpvt(
j ) = jpvt( nfxd )
262 CALL
dgeqrf( m, na, a, lda, tau, work, lwork, info )
263 iws = max( iws, int( work( 1 ) ) )
267 CALL
dormqr(
'Left',
'Transpose', m, n-na, na, a, lda, tau,
268 $ a( 1, na+1 ), lda, work, lwork, info )
269 iws = max( iws, int( work( 1 ) ) )
276 IF( nfxd.LT.minmn )
THEN
280 sminmn = minmn - nfxd
284 nb =
ilaenv( inb,
'DGEQRF',
' ', sm, sn, -1, -1 )
288 IF( ( nb.GT.1 ) .AND. ( nb.LT.sminmn ) )
THEN
292 nx = max( 0,
ilaenv( ixover,
'DGEQRF',
' ', sm, sn, -1,
296 IF( nx.LT.sminmn )
THEN
300 minws = 2*sn + ( sn+1 )*nb
301 iws = max( iws, minws )
302 IF( lwork.LT.minws )
THEN
307 nb = ( lwork-2*sn ) / ( sn+1 )
308 nbmin = max( 2,
ilaenv( inbmin,
'DGEQRF',
' ', sm, sn,
319 DO 20
j = nfxd + 1, n
320 work(
j ) =
dnrm2( sm, a( nfxd+1,
j ), 1 )
321 work( n+
j ) = work(
j )
324 IF( ( nb.GE.nbmin ) .AND. ( nb.LT.sminmn ) .AND.
325 $ ( nx.LT.sminmn ) )
THEN
336 IF(
j.LE.topbmn )
THEN
337 jb = min( nb, topbmn-
j+1 )
341 CALL
dlaqps( m, n-
j+1,
j-1, jb, fjb, a( 1,
j ), lda,
342 $ jpvt(
j ), tau(
j ), work(
j ), work( n+
j ),
343 $ work( 2*n+1 ), work( 2*n+jb+1 ), n-
j+1 )
356 $ CALL
dlaqp2( m, n-
j+1,
j-1, a( 1,
j ), lda, jpvt(
j ),
357 $ tau(
j ), work(
j ), work( n+
j ),
subroutine dlaqp2(M, N, OFFSET, A, LDA, JPVT, TAU, VN1, VN2, WORK)
DLAQP2 computes a QR factorization with column pivoting of the matrix block.
subroutine dgeqrf(M, N, A, LDA, TAU, WORK, LWORK, INFO)
DGEQRF
subroutine dormqr(SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
DORMQR
subroutine xerbla(SRNAME, INFO)
XERBLA
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
double precision function dnrm2(N, X, INCX)
DNRM2
subroutine dswap(N, DX, INCX, DY, INCY)
DSWAP
integer function ilaenv(ISPEC, NAME, OPTS, N1, N2, N3, N4)
subroutine dgeqp3(M, N, A, LDA, JPVT, TAU, WORK, LWORK, INFO)
DGEQP3
subroutine dlaqps(M, N, OFFSET, NB, KB, A, LDA, JPVT, TAU, VN1, VN2, AUXV, F, LDF)
DLAQPS computes a step of QR factorization with column pivoting of a real m-by-n matrix A by using BL...