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