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
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 )
224 ynorm = anorm + bnorm
226 IF( xnorm.LE.zero )
THEN
229 result = ( ( dnorm / ynorm ) / xnorm ) /eps
real function clange(NORM, M, N, A, LDA, WORK)
CLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
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 ...
real function scasum(N, CX, INCX)
SCASUM
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
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.
real function slamch(CMACH)
SLAMCH
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