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
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 )
220 ynorm = anorm + bnorm
222 IF( xnorm.LE.zero )
THEN
225 result = ( ( dnorm / ynorm ) / xnorm ) /eps
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 ...
real function sasum(N, SX, INCX)
SASUM
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
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.
real function slamch(CMACH)
SLAMCH
subroutine sglmts(N, M, P, A, AF, LDA, B, BF, LDB, D, DF, X, U, WORK, LWORK, RWORK, RESULT)
SGLMTS