150 SUBROUTINE cglmts( N, M, P, A, AF, LDA, B, BF, LDB, D, DF,
151 $ x, u, work, lwork, rwork, result )
159 INTEGER LDA, LDB, LWORK, M, P, N
164 COMPLEX A( lda, * ), AF( lda, * ), B( ldb, * ),
165 $ bf( ldb, * ), d( * ), df( * ), u( * ),
166 $ work( lwork ), x( * )
172 parameter( zero = 0.0e+0 )
174 parameter( cone = 1.0e+0 )
178 REAL ANORM, BNORM, EPS, XNORM, YNORM, DNORM, UNFL
181 REAL SCASUM, SLAMCH, CLANGE
182 EXTERNAL scasum, slamch, clange
192 eps = slamch(
'Epsilon' )
193 unfl = slamch(
'Safe minimum' )
194 anorm = max( clange(
'1', n, m, a, lda, rwork ), unfl )
195 bnorm = max( clange(
'1', n, p, b, ldb, rwork ), unfl )
200 CALL
clacpy(
'Full', n, m, a, lda, af, lda )
201 CALL
clacpy(
'Full', n, p, b, ldb, bf, ldb )
202 CALL
ccopy( n, d, 1, df, 1 )
206 CALL
cggglm( n, m, p, af, lda, bf, ldb, df, x, u, work, lwork,
215 CALL
ccopy( n, d, 1, df, 1 )
216 CALL
cgemv(
'No transpose', n, m, -cone, a, lda, x, 1, cone,
219 CALL
cgemv(
'No transpose', n, p, -cone, b, ldb, u, 1, cone,
222 dnorm = scasum( n, df, 1 )
223 xnorm = scasum( m, x, 1 ) + scasum( p, u, 1 )
224 ynorm = anorm + bnorm
226 IF( xnorm.LE.zero )
THEN
229 result = ( ( dnorm / ynorm ) / xnorm ) /eps
subroutine cggglm(N, M, P, A, LDA, B, LDB, D, X, Y, WORK, LWORK, INFO)
CGGEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices ...
subroutine cgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
CGEMV
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
subroutine ccopy(N, CX, INCX, CY, INCY)
CCOPY
subroutine cglmts(N, M, P, A, AF, LDA, B, BF, LDB, D, DF, X, U, WORK, LWORK, RWORK, RESULT)
CGLMTS