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
178 DOUBLE PRECISION DLAMCH, DZASUM, ZLANGE
179 EXTERNAL dlamch, dzasum, zlange
190 eps = dlamch(
'Epsilon' )
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 )
221 xnorm = dzasum( m, x, 1 ) + dzasum( p, u, 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 ...
subroutine zcopy(N, ZX, INCX, ZY, INCY)
ZCOPY