199 SUBROUTINE sget52( LEFT, N, A, LDA, B, LDB, E, LDE, ALPHAR,
200 $ alphai, beta, work, result )
209 INTEGER lda, ldb,
lde, n
212 REAL a( lda, * ), alphai( * ), alphar( * ),
213 $ b( ldb, * ), beta( * ), e(
lde, * ),
214 $ result( 2 ), work( * )
221 parameter( zero = 0.0, one = 1.0, ten = 10.0 )
225 CHARACTER normab, trans
227 REAL abmax, acoef, alfmax, anorm, bcoefi, bcoefr,
228 $ betmax, bnorm, enorm, enrmer, errnrm, safmax,
229 $ safmin, salfi, salfr, sbeta, scale, temp1, ulp
239 INTRINSIC abs, max, real
248 safmin =
slamch(
'Safe minimum' )
249 safmax = one / safmin
262 anorm = max(
slange( normab, n, n, a, lda, work ), safmin )
263 bnorm = max(
slange( normab, n, n, b, ldb, work ), safmin )
264 enorm = max(
slange(
'O', n, n, e,
lde, work ), ulp )
265 alfmax = safmax / max( one, bnorm )
266 betmax = safmax / max( one, anorm )
279 salfr = alphar( jvec )
280 salfi = alphai( jvec )
282 IF( salfi.EQ.zero )
THEN
286 abmax = max( abs( salfr ), abs( sbeta ) )
287 IF( abs( salfr ).GT.alfmax .OR. abs( sbeta ).GT.
288 $ betmax .OR. abmax.LT.one )
THEN
289 scale = one / max( abmax, safmin )
293 scale = one / max( abs( salfr )*bnorm,
294 $ abs( sbeta )*anorm, safmin )
297 CALL
sgemv( trans, n, n, acoef, a, lda, e( 1, jvec ), 1,
298 $ zero, work( n*( jvec-1 )+1 ), 1 )
299 CALL
sgemv( trans, n, n, -bcoefr, b, lda, e( 1, jvec ),
300 $ 1, one, work( n*( jvec-1 )+1 ), 1 )
307 result( 1 ) = ten / ulp
310 abmax = max( abs( salfr )+abs( salfi ), abs( sbeta ) )
311 IF( abs( salfr )+abs( salfi ).GT.alfmax .OR.
312 $ abs( sbeta ).GT.betmax .OR. abmax.LT.one )
THEN
313 scale = one / max( abmax, safmin )
318 scale = one / max( ( abs( salfr )+abs( salfi ) )*bnorm,
319 $ abs( sbeta )*anorm, safmin )
327 CALL
sgemv( trans, n, n, acoef, a, lda, e( 1, jvec ), 1,
328 $ zero, work( n*( jvec-1 )+1 ), 1 )
329 CALL
sgemv( trans, n, n, -bcoefr, b, lda, e( 1, jvec ),
330 $ 1, one, work( n*( jvec-1 )+1 ), 1 )
331 CALL
sgemv( trans, n, n, bcoefi, b, lda, e( 1, jvec+1 ),
332 $ 1, one, work( n*( jvec-1 )+1 ), 1 )
334 CALL
sgemv( trans, n, n, acoef, a, lda, e( 1, jvec+1 ),
335 $ 1, zero, work( n*jvec+1 ), 1 )
336 CALL
sgemv( trans, n, n, -bcoefi, b, lda, e( 1, jvec ),
337 $ 1, one, work( n*jvec+1 ), 1 )
338 CALL
sgemv( trans, n, n, -bcoefr, b, lda, e( 1, jvec+1 ),
339 $ 1, one, work( n*jvec+1 ), 1 )
344 errnrm =
slange(
'One', n, n, work, n, work( n**2+1 ) ) / enorm
348 result( 1 ) = errnrm / ulp
359 IF( alphai( jvec ).EQ.zero )
THEN
361 temp1 = max( temp1, abs( e( j, jvec ) ) )
363 enrmer = max( enrmer, temp1-one )
367 temp1 = max( temp1, abs( e( j, jvec ) )+
368 $ abs( e( j, jvec+1 ) ) )
370 enrmer = max( enrmer, temp1-one )
377 result( 2 ) = enrmer / (
REAL( n )*ulp )