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 )
152 EXTERNAL slamch, slange
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 ),
201 sqpt01 = slange(
'One-norm', m, n, work, m, rwork ) /
202 $ (
REAL( MAX( M, N ) )*slamch(
'Epsilon' ) )
204 $ sqpt01 = sqpt01 / norma
subroutine sormqr(SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
SORMQR
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine scopy(N, SX, INCX, SY, INCY)
SCOPY
subroutine saxpy(N, SA, SX, INCX, SY, INCY)
SAXPY