162 SUBROUTINE zget52( LEFT, N, A, LDA, B, LDB, E, LDE, ALPHA, BETA,
163 $ work, rwork, result )
172 INTEGER lda, ldb,
lde, n
175 DOUBLE PRECISION result( 2 ), rwork( * )
176 COMPLEX*16 a( lda, * ), alpha( * ), b( ldb, * ),
177 $ beta( * ), e(
lde, * ), work( * )
183 DOUBLE PRECISION zero, one
184 parameter( zero = 0.0d+0, one = 1.0d+0 )
185 COMPLEX*16 czero, cone
186 parameter( czero = ( 0.0d+0, 0.0d+0 ),
187 $ cone = ( 1.0d+0, 0.0d+0 ) )
190 CHARACTER normab, trans
192 DOUBLE PRECISION abmax, alfmax, anorm, betmax, bnorm, enorm,
193 $ enrmer, errnrm, safmax, safmin, scale, temp1,
195 COMPLEX*16 acoeff, alphai, bcoeff, betai, x
205 INTRINSIC abs, dble, dconjg, dimag, max
208 DOUBLE PRECISION abs1
211 abs1( x ) = abs( dble( x ) ) + abs( dimag( x ) )
220 safmin =
dlamch(
'Safe minimum' )
221 safmax = one / safmin
234 anorm = max(
zlange( normab, n, n, a, lda, rwork ), safmin )
235 bnorm = max(
zlange( normab, n, n, b, ldb, rwork ), safmin )
236 enorm = max(
zlange(
'O', n, n, e,
lde, rwork ), ulp )
237 alfmax = safmax / max( one, bnorm )
238 betmax = safmax / max( one, anorm )
244 alphai = alpha( jvec )
246 abmax = max( abs1( alphai ), abs1( betai ) )
247 IF( abs1( alphai ).GT.alfmax .OR. abs1( betai ).GT.betmax .OR.
248 $ abmax.LT.one )
THEN
249 scale = one / max( abmax, safmin )
250 alphai = scale*alphai
253 scale = one / max( abs1( alphai )*bnorm, abs1( betai )*anorm,
256 bcoeff = scale*alphai
258 acoeff = dconjg( acoeff )
259 bcoeff = dconjg( bcoeff )
261 CALL
zgemv( trans, n, n, acoeff, a, lda, e( 1, jvec ), 1,
262 $ czero, work( n*( jvec-1 )+1 ), 1 )
263 CALL
zgemv( trans, n, n, -bcoeff, b, lda, e( 1, jvec ), 1,
264 $ cone, work( n*( jvec-1 )+1 ), 1 )
267 errnrm =
zlange(
'One', n, n, work, n, rwork ) / enorm
271 result( 1 ) = errnrm / ulp
279 temp1 = max( temp1, abs1( e( j, jvec ) ) )
281 enrmer = max( enrmer, temp1-one )
286 result( 2 ) = enrmer / ( dble( n )*ulp )