147 SUBROUTINE slaqp2( M, N, OFFSET, A, LDA, JPVT, TAU, VN1, VN2,
155 INTEGER LDA, M, N, OFFSET
159 REAL A( LDA, * ), TAU( * ), VN1( * ), VN2( * ),
167 parameter( zero = 0.0e+0, one = 1.0e+0 )
170 INTEGER I, ITEMP, J, MN, OFFPI, PVT
171 REAL AII, TEMP, TEMP2, TOL3Z
177 INTRINSIC abs, max, min, sqrt
182 EXTERNAL isamax, slamch, snrm2
186 mn = min( m-offset, n )
187 tol3z = sqrt(slamch(
'Epsilon'))
197 pvt = ( i-1 ) + isamax( n-i+1, vn1( i ), 1 )
200 CALL sswap( m, a( 1, pvt ), 1, a( 1, i ), 1 )
202 jpvt( pvt ) = jpvt( i )
204 vn1( pvt ) = vn1( i )
205 vn2( pvt ) = vn2( i )
210 IF( offpi.LT.m )
THEN
211 CALL slarfg( m-offpi+1, a( offpi, i ), a( offpi+1, i ), 1,
214 CALL slarfg( 1, a( m, i ), a( m, i ), 1, tau( i ) )
223 CALL slarf(
'Left', m-offpi+1, n-i, a( offpi, i ), 1,
224 $ tau( i ), a( offpi, i+1 ), lda, work( 1 ) )
231 IF( vn1( j ).NE.zero )
THEN
236 temp = one - ( abs( a( offpi, j ) ) / vn1( j ) )**2
237 temp = max( temp, zero )
238 temp2 = temp*( vn1( j ) / vn2( j ) )**2
239 IF( temp2 .LE. tol3z )
THEN
240 IF( offpi.LT.m )
THEN
241 vn1( j ) = snrm2( m-offpi, a( offpi+1, j ), 1 )
248 vn1( j ) = vn1( j )*sqrt( temp )
subroutine slaqp2(M, N, OFFSET, A, LDA, JPVT, TAU, VN1, VN2, WORK)
SLAQP2 computes a QR factorization with column pivoting of the matrix block.
subroutine slarfg(N, ALPHA, X, INCX, TAU)
SLARFG generates an elementary reflector (Householder matrix).
subroutine slarf(SIDE, M, N, V, INCV, TAU, C, LDC, WORK)
SLARF applies an elementary reflector to a general rectangular matrix.
subroutine sswap(N, SX, INCX, SY, INCY)
SSWAP