zlaqp2()

subroutine zlaqp2	(	integer	m,
		integer	n,
		integer	offset,
		complex*16, dimension( lda, * )	a,
		integer	lda,
		integer, dimension( * )	jpvt,
		complex*16, dimension( * )	tau,
		double precision, dimension( * )	vn1,
		double precision, dimension( * )	vn2,
		complex*16, dimension( * )	work
	)

ZLAQP2 computes a QR factorization with column pivoting of the matrix block.

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

Purpose:

 ZLAQP2 computes a QR factorization with column pivoting of
 the block A(OFFSET+1:M,1:N).
 The block A(1:OFFSET,1:N) is accordingly pivoted, but not factorized.

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]	OFFSET	OFFSET is INTEGER The number of rows of the matrix A that must be pivoted but no factorized. OFFSET >= 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 block A(OFFSET+1:M,1:N) is the triangular factor obtained; the elements in block A(OFFSET+1:M,1:N) below the diagonal, together with the array TAU, represent the orthogonal matrix Q as a product of elementary reflectors. Block A(1:OFFSET,1:N) has been accordingly pivoted, but no factorized.
[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(i) .ne. 0, the i-th column of A is permuted to the front of A*P (a leading column); if JPVT(i) = 0, the i-th column of A is a free column. On exit, if JPVT(i) = k, then the i-th column of A*P was the k-th column of A.
[out]	TAU	TAU is COMPLEX*16 array, dimension (min(M,N)) The scalar factors of the elementary reflectors.
[in,out]	VN1	VN1 is DOUBLE PRECISION array, dimension (N) The vector with the partial column norms.
[in,out]	VN2	VN2 is DOUBLE PRECISION array, dimension (N) The vector with the exact column norms.
[out]	WORK	WORK is COMPLEX*16 array, dimension (N)

Author

Univ. of Tennessee

Univ. of California Berkeley

Univ. of Colorado Denver

NAG Ltd.

Contributors:

G. Quintana-Orti, Depto. de Informatica, Universidad Jaime I, Spain X. Sun, Computer Science Dept., Duke University, USA
Partial column norm updating strategy modified on April 2011 Z. Drmac and Z. Bujanovic, Dept. of Mathematics, University of Zagreb, Croatia.

References:

LAPACK Working Note 176 [PDF]

Definition at line 147 of file zlaqp2.f.

*
*  -- LAPACK auxiliary 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            LDA, M, N, OFFSET
*     ..
*     .. Array Arguments ..
      INTEGER            JPVT( * )
      DOUBLE PRECISION   VN1( * ), VN2( * )
      COMPLEX*16         A( LDA, * ), TAU( * ), WORK( * )
*     ..
*
*  =====================================================================
*
*     .. Parameters ..
      DOUBLE PRECISION   ZERO, ONE
      COMPLEX*16         CONE
      parameter( zero = 0.0d+0, one = 1.0d+0,
     $                   cone = ( 1.0d+0, 0.0d+0 ) )
*     ..
*     .. Local Scalars ..
      INTEGER            I, ITEMP, J, MN, OFFPI, PVT
      DOUBLE PRECISION   TEMP, TEMP2, TOL3Z
      COMPLEX*16         AII
*     ..
*     .. External Subroutines ..
      EXTERNAL           zlarf, zlarfg, zswap
*     ..
*     .. Intrinsic Functions ..
      INTRINSIC          abs, dconjg, max, min, sqrt
*     ..
*     .. External Functions ..
      INTEGER            IDAMAX
      DOUBLE PRECISION   DLAMCH, DZNRM2
      EXTERNAL           idamax, dlamch, dznrm2
*     ..
*     .. Executable Statements ..
*
      mn = min( m-offset, n )
      tol3z = sqrt(dlamch('Epsilon'))
*
*     Compute factorization.
*
      DO 20 i = 1, mn
*
         offpi = offset + i
*
*        Determine ith pivot column and swap if necessary.
*
         pvt = ( i-1 ) + idamax( n-i+1, vn1( i ), 1 )
*
         IF( pvt.NE.i ) THEN
            CALL zswap( m, a( 1, pvt ), 1, a( 1, i ), 1 )
            itemp = jpvt( pvt )
            jpvt( pvt ) = jpvt( i )
            jpvt( i ) = itemp
            vn1( pvt ) = vn1( i )
            vn2( pvt ) = vn2( i )
         END IF
*
*        Generate elementary reflector H(i).
*
         IF( offpi.LT.m ) THEN
            CALL zlarfg( m-offpi+1, a( offpi, i ), a( offpi+1, i ), 1,
     $                   tau( i ) )
         ELSE
            CALL zlarfg( 1, a( m, i ), a( m, i ), 1, tau( i ) )
         END IF
*
         IF( i.LT.n ) THEN
*
*           Apply H(i)**H to A(offset+i:m,i+1:n) from the left.
*
            aii = a( offpi, i )
            a( offpi, i ) = cone
            CALL zlarf( 'Left', m-offpi+1, n-i, a( offpi, i ), 1,
     $                  dconjg( tau( i ) ), a( offpi, i+1 ), lda,
     $                  work( 1 ) )
            a( offpi, i ) = aii
         END IF
*
*        Update partial column norms.
*
         DO 10 j = i + 1, n
            IF( vn1( j ).NE.zero ) THEN
*
*              NOTE: The following 4 lines follow from the analysis in
*              Lapack Working Note 176.
*
               temp = one - ( abs( a( offpi, j ) ) / vn1( j ) )**2
               temp = max( temp, zero )
               temp2 = temp*( vn1( j ) / vn2( j ) )**2
               IF( temp2 .LE. tol3z ) THEN
                  IF( offpi.LT.m ) THEN
                     vn1( j ) = dznrm2( m-offpi, a( offpi+1, j ), 1 )
                     vn2( j ) = vn1( j )
                  ELSE
                     vn1( j ) = zero
                     vn2( j ) = zero
                  END IF
               ELSE
                  vn1( j ) = vn1( j )*sqrt( temp )
               END IF
            END IF
   10    CONTINUE
*
   20 CONTINUE
*
      RETURN
*
*     End of ZLAQP2
*

Here is the call graph for this function:

Here is the caller graph for this function: