149 SUBROUTINE dlaqp2( M, N, OFFSET, A, LDA, JPVT, TAU, VN1, VN2,
158 INTEGER LDA, M, N, OFFSET
162 DOUBLE PRECISION A( lda, * ), TAU( * ), VN1( * ), VN2( * ),
169 DOUBLE PRECISION ZERO, ONE
170 parameter ( zero = 0.0d+0, one = 1.0d+0 )
173 INTEGER I, ITEMP, J, MN, OFFPI, PVT
174 DOUBLE PRECISION AII, TEMP, TEMP2, TOL3Z
180 INTRINSIC abs, max, min, sqrt
184 DOUBLE PRECISION DLAMCH, DNRM2
185 EXTERNAL idamax, dlamch, dnrm2
189 mn = min( m-offset, n )
190 tol3z = sqrt(dlamch(
'Epsilon'))
200 pvt = ( i-1 ) + idamax( n-i+1, vn1( i ), 1 )
203 CALL dswap( m, a( 1, pvt ), 1, a( 1, i ), 1 )
205 jpvt( pvt ) = jpvt( i )
207 vn1( pvt ) = vn1( i )
208 vn2( pvt ) = vn2( i )
213 IF( offpi.LT.m )
THEN
214 CALL dlarfg( m-offpi+1, a( offpi, i ), a( offpi+1, i ), 1,
217 CALL dlarfg( 1, a( m, i ), a( m, i ), 1, tau( i ) )
226 CALL dlarf(
'Left', m-offpi+1, n-i, a( offpi, i ), 1,
227 $ tau( i ), a( offpi, i+1 ), lda, work( 1 ) )
234 IF( vn1( j ).NE.zero )
THEN
239 temp = one - ( abs( a( offpi, j ) ) / vn1( j ) )**2
240 temp = max( temp, zero )
241 temp2 = temp*( vn1( j ) / vn2( j ) )**2
242 IF( temp2 .LE. tol3z )
THEN
243 IF( offpi.LT.m )
THEN
244 vn1( j ) = dnrm2( m-offpi, a( offpi+1, j ), 1 )
251 vn1( j ) = vn1( j )*sqrt( temp )
subroutine dlarf(SIDE, M, N, V, INCV, TAU, C, LDC, WORK)
DLARF applies an elementary reflector to a general rectangular matrix.
subroutine dswap(N, DX, INCX, DY, INCY)
DSWAP
subroutine dlarfg(N, ALPHA, X, INCX, TAU)
DLARFG generates an elementary reflector (Householder matrix).
subroutine dlaqp2(M, N, OFFSET, A, LDA, JPVT, TAU, VN1, VN2, WORK)
DLAQP2 computes a QR factorization with column pivoting of the matrix block.