159 SUBROUTINE cgeqp3( M, N, A, LDA, JPVT, TAU, WORK, LWORK, RWORK,
168 INTEGER info, lda, lwork, m, n
173 COMPLEX a( lda, * ), tau( * ), work( * )
179 INTEGER inb, inbmin, ixover
180 parameter( inb = 1, inbmin = 2, ixover = 3 )
184 INTEGER fjb, iws,
j, jb, lwkopt, minmn, minws, na, nb,
185 $ nbmin, nfxd, nx, sm, sminmn, sn, topbmn
196 INTRINSIC int, max, min
204 lquery = ( lwork.EQ.-1 )
207 ELSE IF( n.LT.0 )
THEN
209 ELSE IF( lda.LT.max( 1, m ) )
THEN
215 IF( minmn.EQ.0 )
THEN
220 nb =
ilaenv( inb,
'CGEQRF',
' ', m, n, -1, -1 )
221 lwkopt = ( n + 1 )*nb
225 IF( ( lwork.LT.iws ) .AND. .NOT.lquery )
THEN
231 CALL
xerbla(
'CGEQP3', -info )
233 ELSE IF( lquery )
THEN
239 IF( minmn.EQ.0 )
THEN
247 IF( jpvt(
j ).NE.0 )
THEN
249 CALL
cswap( m, a( 1,
j ), 1, a( 1, nfxd ), 1 )
250 jpvt(
j ) = jpvt( nfxd )
271 CALL
cgeqrf( m, na, a, lda, tau, work, lwork, info )
272 iws = max( iws, int( work( 1 ) ) )
277 CALL
cunmqr(
'Left',
'Conjugate Transpose', m, n-na, na, a,
278 $ lda, tau, a( 1, na+1 ), lda, work, lwork,
280 iws = max( iws, int( work( 1 ) ) )
287 IF( nfxd.LT.minmn )
THEN
291 sminmn = minmn - nfxd
295 nb =
ilaenv( inb,
'CGEQRF',
' ', sm, sn, -1, -1 )
299 IF( ( nb.GT.1 ) .AND. ( nb.LT.sminmn ) )
THEN
303 nx = max( 0,
ilaenv( ixover,
'CGEQRF',
' ', sm, sn, -1,
307 IF( nx.LT.sminmn )
THEN
312 iws = max( iws, minws )
313 IF( lwork.LT.minws )
THEN
318 nb = lwork / ( sn+1 )
319 nbmin = max( 2,
ilaenv( inbmin,
'CGEQRF',
' ', sm, sn,
330 DO 20
j = nfxd + 1, n
331 rwork(
j ) =
scnrm2( sm, a( nfxd+1,
j ), 1 )
332 rwork( n+
j ) = rwork(
j )
335 IF( ( nb.GE.nbmin ) .AND. ( nb.LT.sminmn ) .AND.
336 $ ( nx.LT.sminmn ) )
THEN
347 IF(
j.LE.topbmn )
THEN
348 jb = min( nb, topbmn-
j+1 )
352 CALL
claqps( m, n-
j+1,
j-1, jb, fjb, a( 1,
j ), lda,
353 $ jpvt(
j ), tau(
j ), rwork(
j ),
354 $ rwork( n+
j ), work( 1 ), work( jb+1 ),
368 $ CALL
claqp2( m, n-
j+1,
j-1, a( 1,
j ), lda, jpvt(
j ),
369 $ tau(
j ), rwork(
j ), rwork( n+
j ), work( 1 ) )
subroutine cgeqp3(M, N, A, LDA, JPVT, TAU, WORK, LWORK, RWORK, INFO)
CGEQP3
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine claqp2(M, N, OFFSET, A, LDA, JPVT, TAU, VN1, VN2, WORK)
CLAQP2 computes a QR factorization with column pivoting of the matrix block.
subroutine cunmqr(SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
CUNMQR
subroutine cswap(N, CX, INCX, CY, INCY)
CSWAP
subroutine claqps(M, N, OFFSET, NB, KB, A, LDA, JPVT, TAU, VN1, VN2, AUXV, F, LDF)
CLAQPS computes a step of QR factorization with column pivoting of a real m-by-n matrix A by using BL...
INTEGER function ilaenv(ISPEC, NAME, OPTS, N1, N2, N3, N4)
subroutine cgeqrf(M, N, A, LDA, TAU, WORK, LWORK, INFO)
CGEQRF
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
REAL function scnrm2(N, X, INCX)
SCNRM2