149 SUBROUTINE claqp2( M, N, OFFSET, A, LDA, JPVT, TAU, VN1, VN2,
158 INTEGER LDA, M, N, OFFSET
162 REAL VN1( * ), VN2( * )
163 COMPLEX A( lda, * ), TAU( * ), WORK( * )
171 parameter ( zero = 0.0e+0, one = 1.0e+0,
172 $ cone = ( 1.0e+0, 0.0e+0 ) )
175 INTEGER I, ITEMP, J, MN, OFFPI, PVT
176 REAL TEMP, TEMP2, TOL3Z
183 INTRINSIC abs, conjg, max, min, sqrt
188 EXTERNAL isamax, scnrm2, slamch
192 mn = min( m-offset, n )
193 tol3z = sqrt(slamch(
'Epsilon'))
203 pvt = ( i-1 ) + isamax( n-i+1, vn1( i ), 1 )
206 CALL cswap( 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 clarfg( m-offpi+1, a( offpi, i ), a( offpi+1, i ), 1,
220 CALL clarfg( 1, a( m, i ), a( m, i ), 1, tau( i ) )
229 CALL clarf(
'Left', m-offpi+1, n-i, a( offpi, i ), 1,
230 $ conjg( 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 ) = scnrm2( m-offpi, a( offpi+1, j ), 1 )
255 vn1( j ) = vn1( j )*sqrt( temp )
subroutine clarfg(N, ALPHA, X, INCX, TAU)
CLARFG generates an elementary reflector (Householder matrix).
subroutine cswap(N, CX, INCX, CY, INCY)
CSWAP
subroutine clarf(SIDE, M, N, V, INCV, TAU, C, LDC, WORK)
CLARF applies an elementary reflector to a general rectangular matrix.
subroutine claqp2(M, N, OFFSET, A, LDA, JPVT, TAU, VN1, VN2, WORK)
CLAQP2 computes a QR factorization with column pivoting of the matrix block.