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 ) )