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' ) )
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
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine scopy(N, SX, INCX, SY, INCY)
SCOPY
subroutine saxpy(N, SA, SX, INCX, SY, INCY)
SAXPY