120 REAL FUNCTION sqpt01( M, N, K, A, AF, LDA, TAU, JPVT,
129 INTEGER k, lda, lwork, m, n
133 REAL a( lda, * ), af( lda, * ), tau( * ),
141 parameter( zero = 0.0e0, one = 1.0e0 )
158 INTRINSIC max, min, real
166 IF( lwork.LT.m*n+n )
THEN
167 CALL
xerbla(
'SQPT01', 10 )
173 IF( m.LE.0 .OR. n.LE.0 )
176 norma =
slange(
'One-norm', m, n, a, lda, rwork )
179 DO 10 i = 1, min(
j, m )
180 work( (
j-1 )*m+i ) = af( i,
j )
183 work( (
j-1 )*m+i ) = zero
187 CALL
scopy( m, af( 1,
j ), 1, work( (
j-1 )*m+1 ), 1 )
190 CALL
sormqr(
'Left',
'No transpose', m, n, k, af, lda, tau, work,
191 $ m, work( m*n+1 ), lwork-m*n, info )
197 CALL
saxpy( m, -one, a( 1, jpvt(
j ) ), 1, work( (
j-1 )*m+1 ),
202 $ (
REAL( MAX( M, N ) )*
slamch(
'Epsilon' ) )
REAL function sqpt01(M, N, K, A, AF, LDA, TAU, JPVT, WORK, LWORK)
SQPT01
subroutine sormqr(SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
SORMQR
REAL function slamch(CMACH)
SLAMCH
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine scopy(N, SX, INCX, SY, INCY)
SCOPY
subroutine saxpy(N, SA, SX, INCX, SY, INCY)
SAXPY
REAL function slange(NORM, M, N, A, LDA, WORK)
SLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j