161 SUBROUTINE cget52( LEFT, N, A, LDA, B, LDB, E, LDE, ALPHA, BETA,
162 $ work, rwork, result )
171 INTEGER lda, ldb,
lde, n
174 REAL result( 2 ), rwork( * )
175 COMPLEX a( lda, * ), alpha( * ),
b( ldb, * ),
176 $ beta( * ), e(
lde, * ), work( * )
183 parameter( zero = 0.0e+0, one = 1.0e+0 )
185 parameter( czero = ( 0.0e+0, 0.0e+0 ),
186 $ cone = ( 1.0e+0, 0.0e+0 ) )
189 CHARACTER normab, trans
191 REAL abmax, alfmax, anorm, betmax, bnorm, enorm,
192 $ enrmer, errnrm, safmax, safmin, scale, temp1,
194 COMPLEX acoeff, alphai, bcoeff, betai, x
204 INTRINSIC abs, aimag, conjg, max, real
210 abs1( x ) = abs(
REAL( X ) ) + abs( aimag( x ) )
219 safmin =
slamch(
'Safe minimum' )
220 safmax = one / safmin
233 anorm = max(
clange( normab, n, n, a, lda, rwork ), safmin )
234 bnorm = max(
clange( normab, n, n,
b, ldb, rwork ), safmin )
235 enorm = max(
clange(
'O', n, n, e,
lde, rwork ), ulp )
236 alfmax = safmax / max( one, bnorm )
237 betmax = safmax / max( one, anorm )
243 alphai = alpha( jvec )
245 abmax = max( abs1( alphai ), abs1( betai ) )
246 IF( abs1( alphai ).GT.alfmax .OR. abs1( betai ).GT.betmax .OR.
247 $ abmax.LT.one )
THEN
248 scale = one / max( abmax, safmin )
249 alphai = scale*alphai
252 scale = one / max( abs1( alphai )*bnorm, abs1( betai )*anorm,
255 bcoeff = scale*alphai
257 acoeff = conjg( acoeff )
258 bcoeff = conjg( bcoeff )
260 CALL
cgemv( trans, n, n, acoeff, a, lda, e( 1, jvec ), 1,
261 $ czero, work( n*( jvec-1 )+1 ), 1 )
262 CALL
cgemv( trans, n, n, -bcoeff,
b, lda, e( 1, jvec ), 1,
263 $ cone, work( n*( jvec-1 )+1 ), 1 )
266 errnrm =
clange(
'One', n, n, work, n, rwork ) / enorm
270 result( 1 ) = errnrm / ulp
278 temp1 = max( temp1, abs1( e(
j, jvec ) ) )
280 enrmer = max( enrmer, temp1-one )
285 result( 2 ) = enrmer / (
REAL( n )*ulp )
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 ...
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
real function slamch(CMACH)
SLAMCH
logical function lde(RI, RJ, LR)
subroutine cget52(LEFT, N, A, LDA, B, LDB, E, LDE, ALPHA, BETA, WORK, RWORK, RESULT)
CGET52
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j