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 )