149 SUBROUTINE zlaqp2( M, N, OFFSET, A, LDA, JPVT, TAU, VN1, VN2,
158 INTEGER LDA, M, N, OFFSET
162 DOUBLE PRECISION VN1( * ), VN2( * )
163 COMPLEX*16 A( lda, * ), TAU( * ), WORK( * )
169 DOUBLE PRECISION ZERO, ONE
171 parameter ( zero = 0.0d+0, one = 1.0d+0,
172 $ cone = ( 1.0d+0, 0.0d+0 ) )
175 INTEGER I, ITEMP, J, MN, OFFPI, PVT
176 DOUBLE PRECISION TEMP, TEMP2, TOL3Z
183 INTRINSIC abs, dconjg, max, min, sqrt
187 DOUBLE PRECISION DLAMCH, DZNRM2
188 EXTERNAL idamax, dlamch, dznrm2
192 mn = min( m-offset, n )
193 tol3z = sqrt(dlamch(
'Epsilon'))
203 pvt = ( i-1 ) + idamax( n-i+1, vn1( i ), 1 )
206 CALL zswap( m, a( 1, pvt ), 1, a( 1, i ), 1 )
208 jpvt( pvt ) = jpvt( i )
210 vn1( pvt ) = vn1( i )
211 vn2( pvt ) = vn2( i )
216 IF( offpi.LT.m )
THEN
217 CALL zlarfg( m-offpi+1, a( offpi, i ), a( offpi+1, i ), 1,
220 CALL zlarfg( 1, a( m, i ), a( m, i ), 1, tau( i ) )
229 CALL zlarf(
'Left', m-offpi+1, n-i, a( offpi, i ), 1,
230 $ dconjg( tau( i ) ), a( offpi, i+1 ), lda,
238 IF( vn1( j ).NE.zero )
THEN
243 temp = one - ( abs( a( offpi, j ) ) / vn1( j ) )**2
244 temp = max( temp, zero )
245 temp2 = temp*( vn1( j ) / vn2( j ) )**2
246 IF( temp2 .LE. tol3z )
THEN
247 IF( offpi.LT.m )
THEN
248 vn1( j ) = dznrm2( m-offpi, a( offpi+1, j ), 1 )
255 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 zlarfg(N, ALPHA, X, INCX, TAU)
ZLARFG generates an elementary reflector (Householder matrix).
subroutine zswap(N, ZX, INCX, ZY, INCY)
ZSWAP
subroutine zlarf(SIDE, M, N, V, INCV, TAU, C, LDC, WORK)
ZLARF applies an elementary reflector to a general rectangular matrix.