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 zcopy(N, ZX, INCX, ZY, INCY)
ZCOPY
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)
ZGGGLM
subroutine zglmts(N, M, P, A, AF, LDA, B, BF, LDB, D, DF, X, U, WORK, LWORK, RWORK, RESULT)
ZGLMTS