149 SUBROUTINE slaqp2( M, N, OFFSET, A, LDA, JPVT, TAU, VN1, VN2,
158 INTEGER lda, m, n, offset
162 REAL a( lda, * ), tau( * ), vn1( * ), vn2( * ),
170 parameter( zero = 0.0e+0, one = 1.0e+0 )
173 INTEGER i, itemp,
j, mn, offpi, pvt
174 REAL aii, temp, temp2, tol3z
180 INTRINSIC abs, max, min, sqrt
189 mn = min( m-offset, n )
190 tol3z = sqrt(
slamch(
'Epsilon'))
200 pvt = ( i-1 ) +
isamax( n-i+1, vn1( i ), 1 )
203 CALL
sswap( 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
slarfg( m-offpi+1, a( offpi, i ), a( offpi+1, i ), 1,
217 CALL
slarfg( 1, a( m, i ), a( m, i ), 1, tau( i ) )
226 CALL
slarf(
'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 ) =
snrm2( m-offpi, a( offpi+1,
j ), 1 )
251 vn1(
j ) = vn1(
j )*sqrt( temp )
INTEGER function isamax(N, SX, INCX)
ISAMAX
subroutine sswap(N, SX, INCX, SY, INCY)
SSWAP
REAL function slamch(CMACH)
SLAMCH
subroutine slarf(SIDE, M, N, V, INCV, TAU, C, LDC, WORK)
SLARF applies an elementary reflector to a general rectangular matrix.
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).
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
REAL function snrm2(N, X, INCX)
SNRM2