zgeqp3()

subroutine zgeqp3	(	integer	m,
		integer	n,
		complex*16, dimension( lda, * )	a,
		integer	lda,
		integer, dimension( * )	jpvt,
		complex*16, dimension( * )	tau,
		complex*16, dimension( * )	work,
		integer	lwork,
		double precision, dimension( * )	rwork,
		integer	info )

ZGEQP3

Download ZGEQP3 + dependencies [TGZ] [ZIP] [TXT]

Purpose:

!>
!> ZGEQP3 computes a QR factorization with column pivoting of a
!> matrix A:  A*P = Q*R  using Level 3 BLAS.
!> 

Parameters

[in]	M	!> M is INTEGER !> The number of rows of the matrix A. M >= 0. !>
[in]	N	!> N is INTEGER !> The number of columns of the matrix A. N >= 0. !>
[in,out]	A	!> A is COMPLEX*16 array, dimension (LDA,N) !> On entry, the M-by-N matrix A. !> On exit, the upper triangle of the array contains the !> min(M,N)-by-N upper trapezoidal matrix R; the elements below !> the diagonal, together with the array TAU, represent the !> unitary matrix Q as a product of min(M,N) elementary !> reflectors. !>
[in]	LDA	!> LDA is INTEGER !> The leading dimension of the array A. LDA >= max(1,M). !>
[in,out]	JPVT	!> JPVT is INTEGER array, dimension (N) !> On entry, if JPVT(J).ne.0, the J-th column of A is permuted !> to the front of A*P (a leading column); if JPVT(J)=0, !> the J-th column of A is a free column. !> On exit, if JPVT(J)=K, then the J-th column of A*P was the !> the K-th column of A. !>
[out]	TAU	!> TAU is COMPLEX*16 array, dimension (min(M,N)) !> The scalar factors of the elementary reflectors. !>
[out]	WORK	!> WORK is COMPLEX*16 array, dimension (MAX(1,LWORK)) !> On exit, if INFO=0, WORK(1) returns the optimal LWORK. !>
[in]	LWORK	!> LWORK is INTEGER !> The dimension of the array WORK. LWORK >= N+1. !> For optimal performance LWORK >= ( N+1 )*NB, where NB !> is the optimal blocksize. !> !> If LWORK = -1, then a workspace query is assumed; the routine !> only calculates the optimal size of the WORK array, returns !> this value as the first entry of the WORK array, and no error !> message related to LWORK is issued by XERBLA. !>
[out]	RWORK	!> RWORK is DOUBLE PRECISION array, dimension (2*N) !>
[out]	INFO	!> INFO is INTEGER !> = 0: successful exit. !> < 0: if INFO = -i, the i-th argument had an illegal value. !>

Author

Univ. of Tennessee

Univ. of California Berkeley

Univ. of Colorado Denver

NAG Ltd.

Further Details:

!>
!>  The matrix Q is represented as a product of elementary reflectors
!>
!>     Q = H(1) H(2) . . . H(k), where k = min(m,n).
!>
!>  Each H(i) has the form
!>
!>     H(i) = I - tau * v * v**H
!>
!>  where tau is a complex scalar, and v is a real/complex vector
!>  with v(1:i-1) = 0 and v(i) = 1; v(i+1:m) is stored on exit in
!>  A(i+1:m,i), and tau in TAU(i).
!> 

Contributors:

G. Quintana-Orti, Depto. de Informatica, Universidad Jaime I, Spain X. Sun, Computer Science Dept., Duke University, USA

Definition at line 155 of file zgeqp3.f.

*
*  -- LAPACK computational routine --
*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
*
*     .. Scalar Arguments ..
      INTEGER            INFO, LDA, LWORK, M, N
*     ..
*     .. Array Arguments ..
      INTEGER            JPVT( * )
      DOUBLE PRECISION   RWORK( * )
      COMPLEX*16         A( LDA, * ), TAU( * ), WORK( * )
*     ..
*
*  =====================================================================
*
*     .. Parameters ..
      INTEGER            INB, INBMIN, IXOVER
      parameter( inb = 1, inbmin = 2, ixover = 3 )
*     ..
*     .. Local Scalars ..
      LOGICAL            LQUERY
      INTEGER            FJB, IWS, J, JB, LWKOPT, MINMN, MINWS, NA, NB,
     $                   NBMIN, NFXD, NX, SM, SMINMN, SN, TOPBMN
*     ..
*     .. External Subroutines ..
      EXTERNAL           xerbla, zgeqrf, zlaqp2, zlaqps, zswap,
     $                   zunmqr
*     ..
*     .. External Functions ..
      INTEGER            ILAENV
      DOUBLE PRECISION   DZNRM2
      EXTERNAL           ilaenv, dznrm2
*     ..
*     .. Intrinsic Functions ..
      INTRINSIC          int, max, min
*     ..
*     .. Executable Statements ..
*
*     Test input arguments
*  ====================
*
      info = 0
      lquery = ( lwork.EQ.-1 )
      IF( m.LT.0 ) THEN
         info = -1
      ELSE IF( n.LT.0 ) THEN
         info = -2
      ELSE IF( lda.LT.max( 1, m ) ) THEN
         info = -4
      END IF
*
      IF( info.EQ.0 ) THEN
         minmn = min( m, n )
         IF( minmn.EQ.0 ) THEN
            iws = 1
            lwkopt = 1
         ELSE
            iws = n + 1
            nb = ilaenv( inb, 'ZGEQRF', ' ', m, n, -1, -1 )
            lwkopt = ( n + 1 )*nb
         END IF
         work( 1 ) = dcmplx( lwkopt )
*
         IF( ( lwork.LT.iws ) .AND. .NOT.lquery ) THEN
            info = -8
         END IF
      END IF
*
      IF( info.NE.0 ) THEN
         CALL xerbla( 'ZGEQP3', -info )
         RETURN
      ELSE IF( lquery ) THEN
         RETURN
      END IF
*
*     Move initial columns up front.
*
      nfxd = 1
      DO 10 j = 1, n
         IF( jpvt( j ).NE.0 ) THEN
            IF( j.NE.nfxd ) THEN
               CALL zswap( m, a( 1, j ), 1, a( 1, nfxd ), 1 )
               jpvt( j ) = jpvt( nfxd )
               jpvt( nfxd ) = j
            ELSE
               jpvt( j ) = j
            END IF
            nfxd = nfxd + 1
         ELSE
            jpvt( j ) = j
         END IF
   10 CONTINUE
      nfxd = nfxd - 1
*
*     Factorize fixed columns
*  =======================
*
*     Compute the QR factorization of fixed columns and update
*     remaining columns.
*
      IF( nfxd.GT.0 ) THEN
         na = min( m, nfxd )
*CC      CALL ZGEQR2( M, NA, A, LDA, TAU, WORK, INFO )
         CALL zgeqrf( m, na, a, lda, tau, work, lwork, info )
         iws = max( iws, int( work( 1 ) ) )
         IF( na.LT.n ) THEN
*CC         CALL ZUNM2R( 'Left', 'Conjugate Transpose', M, N-NA,
*CC  $                   NA, A, LDA, TAU, A( 1, NA+1 ), LDA, WORK,
*CC  $                   INFO )
            CALL zunmqr( 'Left', 'Conjugate Transpose', m, n-na, na,
     $                   a,
     $                   lda, tau, a( 1, na+1 ), lda, work, lwork,
     $                   info )
            iws = max( iws, int( work( 1 ) ) )
         END IF
      END IF
*
*     Factorize free columns
*  ======================
*
      IF( nfxd.LT.minmn ) THEN
*
         sm = m - nfxd
         sn = n - nfxd
         sminmn = minmn - nfxd
*
*        Determine the block size.
*
         nb = ilaenv( inb, 'ZGEQRF', ' ', sm, sn, -1, -1 )
         nbmin = 2
         nx = 0
*
         IF( ( nb.GT.1 ) .AND. ( nb.LT.sminmn ) ) THEN
*
*           Determine when to cross over from blocked to unblocked code.
*
            nx = max( 0, ilaenv( ixover, 'ZGEQRF', ' ', sm, sn, -1,
     $           -1 ) )
*
*
            IF( nx.LT.sminmn ) THEN
*
*              Determine if workspace is large enough for blocked code.
*
               minws = ( sn+1 )*nb
               iws = max( iws, minws )
               IF( lwork.LT.minws ) THEN
*
*                 Not enough workspace to use optimal NB: Reduce NB and
*                 determine the minimum value of NB.
*
                  nb = lwork / ( sn+1 )
                  nbmin = max( 2, ilaenv( inbmin, 'ZGEQRF', ' ', sm,
     $                         sn,
     $                    -1, -1 ) )
*
*
               END IF
            END IF
         END IF
*
*        Initialize partial column norms. The first N elements of work
*        store the exact column norms.
*
         DO 20 j = nfxd + 1, n
            rwork( j ) = dznrm2( sm, a( nfxd+1, j ), 1 )
            rwork( n+j ) = rwork( j )
   20    CONTINUE
*
         IF( ( nb.GE.nbmin ) .AND. ( nb.LT.sminmn ) .AND.
     $       ( nx.LT.sminmn ) ) THEN
*
*           Use blocked code initially.
*
            j = nfxd + 1
*
*           Compute factorization: while loop.
*
*
            topbmn = minmn - nx
   30       CONTINUE
            IF( j.LE.topbmn ) THEN
               jb = min( nb, topbmn-j+1 )
*
*              Factorize JB columns among columns J:N.
*
               CALL zlaqps( m, n-j+1, j-1, jb, fjb, a( 1, j ), lda,
     $                      jpvt( j ), tau( j ), rwork( j ),
     $                      rwork( n+j ), work( 1 ), work( jb+1 ),
     $                      n-j+1 )
*
               j = j + fjb
               GO TO 30
            END IF
         ELSE
            j = nfxd + 1
         END IF
*
*        Use unblocked code to factor the last or only block.
*
*
         IF( j.LE.minmn )
     $      CALL zlaqp2( m, n-j+1, j-1, a( 1, j ), lda, jpvt( j ),
     $                   tau( j ), rwork( j ), rwork( n+j ), work( 1 ) )
*
      END IF
*
      work( 1 ) = dcmplx( lwkopt )
      RETURN
*
*     End of ZGEQP3
*

Here is the call graph for this function:

Here is the caller graph for this function: