146 SUBROUTINE zglmts( N, M, P, A, AF, LDA, B, BF, LDB, D, DF, X, U,
147 $ work, lwork, rwork, result )
155 INTEGER lda, ldb, lwork, m, n, p
156 DOUBLE PRECISION result
162 DOUBLE PRECISION rwork( * )
163 COMPLEX*16 a( lda, * ), af( lda, * ),
b( ldb, * ),
164 $ bf( ldb, * ), d( * ), df( * ), u( * ),
165 $ work( lwork ), x( * )
168 DOUBLE PRECISION zero
169 parameter( zero = 0.0d+0 )
171 parameter( cone = 1.0d+0 )
175 DOUBLE PRECISION anorm, bnorm, dnorm, eps, unfl, xnorm, ynorm
191 unfl =
dlamch(
'Safe minimum' )
192 anorm = max(
zlange(
'1', n, m, a, lda, rwork ), unfl )
193 bnorm = max(
zlange(
'1', n, p,
b, ldb, rwork ), unfl )
198 CALL
zlacpy(
'Full', n, m, a, lda, af, lda )
199 CALL
zlacpy(
'Full', n, p,
b, ldb, bf, ldb )
200 CALL
zcopy( n, d, 1, df, 1 )
204 CALL
zggglm( n, m, p, af, lda, bf, ldb, df, x, u, work, lwork,
213 CALL
zcopy( n, d, 1, df, 1 )
214 CALL
zgemv(
'No transpose', n, m, -cone, a, lda, x, 1, cone, df,
217 CALL
zgemv(
'No transpose', n, p, -cone,
b, ldb, u, 1, cone, df,
220 dnorm =
dzasum( n, df, 1 )
222 ynorm = anorm + bnorm
224 IF( xnorm.LE.zero )
THEN
227 result = ( ( dnorm / ynorm ) / xnorm ) / eps
subroutine zglmts(N, M, P, A, AF, LDA, B, BF, LDB, D, DF, X, U, WORK, LWORK, RWORK, RESULT)
ZGLMTS
subroutine zgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
ZGEMV
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
subroutine zggglm(N, M, P, A, LDA, B, LDB, D, X, Y, WORK, LWORK, INFO)
ZGGEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices ...
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
subroutine zcopy(N, ZX, INCX, ZY, INCY)
ZCOPY
double precision function dzasum(N, ZX, INCX)
DZASUM
double precision function zlange(NORM, M, N, A, LDA, WORK)
ZLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
double precision function dlamch(CMACH)
DLAMCH