143 SUBROUTINE zlaqp2( M, N, OFFSET, A, LDA, JPVT, TAU, VN1, VN2,
151 INTEGER LDA, M, N, OFFSET
155 DOUBLE PRECISION VN1( * ), VN2( * )
156 COMPLEX*16 A( LDA, * ), TAU( * ), WORK( * )
162 DOUBLE PRECISION ZERO, ONE
164 parameter( zero = 0.0d+0, one = 1.0d+0,
165 $ cone = ( 1.0d+0, 0.0d+0 ) )
168 INTEGER I, ITEMP, J, MN, OFFPI, PVT
169 DOUBLE PRECISION TEMP, TEMP2, TOL3Z
175 INTRINSIC abs, dconjg, max, min, sqrt
179 DOUBLE PRECISION DLAMCH, DZNRM2
180 EXTERNAL idamax, dlamch, dznrm2
184 mn = min( m-offset, n )
185 tol3z = sqrt(dlamch(
'Epsilon'))
195 pvt = ( i-1 ) + idamax( n-i+1, vn1( i ), 1 )
198 CALL zswap( m, a( 1, pvt ), 1, a( 1, i ), 1 )
200 jpvt( pvt ) = jpvt( i )
202 vn1( pvt ) = vn1( i )
203 vn2( pvt ) = vn2( i )
208 IF( offpi.LT.m )
THEN
209 CALL zlarfg( m-offpi+1, a( offpi, i ), a( offpi+1, i ),
213 CALL zlarfg( 1, a( m, i ), a( m, i ), 1, tau( i ) )
220 CALL zlarf1f(
'Left', m-offpi+1, n-i, a( offpi, i ), 1,
221 $ conjg( tau( i ) ), a( offpi, i+1 ), lda,
228 IF( vn1( j ).NE.zero )
THEN
233 temp = one - ( abs( a( offpi, j ) ) / vn1( j ) )**2
234 temp = max( temp, zero )
235 temp2 = temp*( vn1( j ) / vn2( j ) )**2
236 IF( temp2 .LE. tol3z )
THEN
237 IF( offpi.LT.m )
THEN
238 vn1( j ) = dznrm2( m-offpi, a( offpi+1, j ), 1 )
245 vn1( j ) = vn1( j )*sqrt( temp )
subroutine zlaqp2(m, n, offset, a, lda, jpvt, tau, vn1, vn2, work)
ZLAQP2 computes a QR factorization with column pivoting of the matrix block.
subroutine zlarf1f(side, m, n, v, incv, tau, c, ldc, work)
ZLARF1F applies an elementary reflector to a general rectangular
subroutine zlarfg(n, alpha, x, incx, tau)
ZLARFG generates an elementary reflector (Householder matrix).