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 scopy(N, SX, INCX, SY, INCY)
SCOPY
subroutine sggglm(N, M, P, A, LDA, B, LDB, D, X, Y, WORK, LWORK, INFO)
SGGEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices ...
subroutine sgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
SGEMV
subroutine slacpy(UPLO, M, N, A, LDA, B, LDB)
SLACPY copies all or part of one two-dimensional array to another.
subroutine sglmts(N, M, P, A, AF, LDA, B, BF, LDB, D, DF, X, U, WORK, LWORK, RWORK, RESULT)
SGLMTS