149 SUBROUTINE sglmts( N, M, P, A, AF, LDA, B, BF, LDB, D, DF,
150 $ x, u, work, lwork, rwork, result )
158 INTEGER LDA, LDB, LWORK, M, P, N
162 REAL A( lda, * ), AF( lda, * ), B( ldb, * ),
163 $ bf( ldb, * ), rwork( * ), d( * ), df( * ),
164 $ u( * ), work( lwork ), x( * )
170 parameter ( zero = 0.0e+0, one = 1.0e+0 )
174 REAL ANORM, BNORM, EPS, XNORM, YNORM, DNORM, UNFL
177 REAL SASUM, SLAMCH, SLANGE
178 EXTERNAL sasum, slamch, slange
188 eps = slamch(
'Epsilon' )
189 unfl = slamch(
'Safe minimum' )
190 anorm = max( slange(
'1', n, m, a, lda, rwork ), unfl )
191 bnorm = max( slange(
'1', n, p, b, ldb, rwork ), unfl )
196 CALL slacpy(
'Full', n, m, a, lda, af, lda )
197 CALL slacpy(
'Full', n, p, b, ldb, bf, ldb )
198 CALL scopy( n, d, 1, df, 1 )
202 CALL sggglm( n, m, p, af, lda, bf, ldb, df, x, u, work, lwork,
211 CALL scopy( n, d, 1, df, 1 )
212 CALL sgemv(
'No transpose', n, m, -one, a, lda, x, 1,
215 CALL sgemv(
'No transpose', n, p, -one, b, ldb, u, 1,
218 dnorm = sasum( n, df, 1 )
219 xnorm = sasum( m, x, 1 ) + sasum( p, u, 1 )
220 ynorm = anorm + bnorm
222 IF( xnorm.LE.zero )
THEN
225 result = ( ( dnorm / ynorm ) / xnorm ) /eps
subroutine sggglm(N, M, P, A, LDA, B, LDB, D, X, Y, WORK, LWORK, INFO)
SGGGLM
subroutine sgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
SGEMV
subroutine sglmts(N, M, P, A, AF, LDA, B, BF, LDB, D, DF, X, U, WORK, LWORK, RWORK, RESULT)
SGLMTS
subroutine slacpy(UPLO, M, N, A, LDA, B, LDB)
SLACPY copies all or part of one two-dimensional array to another.
subroutine scopy(N, SX, INCX, SY, INCY)
SCOPY