143 SUBROUTINE zget22( TRANSA, TRANSE, TRANSW, N, A, LDA, E, LDE, W,
144 $ work, rwork, result )
152 CHARACTER transa, transe, transw
156 DOUBLE PRECISION result( 2 ), rwork( * )
157 COMPLEX*16 a( lda, * ), e(
lde, * ), w( * ), work( * )
163 DOUBLE PRECISION zero, one
164 parameter( zero = 0.0d+0, one = 1.0d+0 )
165 COMPLEX*16 czero, cone
166 parameter( czero = ( 0.0d+0, 0.0d+0 ),
167 $ cone = ( 1.0d+0, 0.0d+0 ) )
170 CHARACTER norma, norme
171 INTEGER itrnse, itrnsw, j, jcol, joff, jrow, jvec
172 DOUBLE PRECISION anorm, enorm, enrmax, enrmin, errnrm, temp1,
185 INTRINSIC abs, dble, dconjg, dimag, max, min
196 unfl =
dlamch(
'Safe minimum' )
197 ulp =
dlamch(
'Precision' )
204 IF(
lsame( transa,
'T' ) .OR.
lsame( transa,
'C' ) )
THEN
208 IF(
lsame( transe,
'T' ) )
THEN
211 ELSE IF(
lsame( transe,
'C' ) )
THEN
216 IF(
lsame( transw,
'C' ) )
THEN
224 IF( itrnse.EQ.0 )
THEN
228 temp1 = max( temp1, abs( dble( e( j, jvec ) ) )+
229 $ abs( dimag( e( j, jvec ) ) ) )
231 enrmin = min( enrmin, temp1 )
232 enrmax = max( enrmax, temp1 )
241 rwork( jvec ) = max( rwork( jvec ),
242 $ abs( dble( e( jvec, j ) ) )+
243 $ abs( dimag( e( jvec, j ) ) ) )
248 enrmin = min( enrmin, rwork( jvec ) )
249 enrmax = max( enrmax, rwork( jvec ) )
255 anorm = max(
zlange( norma, n, n, a, lda, rwork ), unfl )
259 enorm = max(
zlange( norme, n, n, e,
lde, rwork ), ulp )
265 CALL
zlaset(
'Full', n, n, czero, czero, work, n )
269 IF( itrnsw.EQ.0 )
THEN
272 wtemp = dconjg( w( jcol ) )
275 IF( itrnse.EQ.0 )
THEN
277 work( joff+jrow ) = e( jrow, jcol )*wtemp
279 ELSE IF( itrnse.EQ.1 )
THEN
281 work( joff+jrow ) = e( jcol, jrow )*wtemp
285 work( joff+jrow ) = dconjg( e( jcol, jrow ) )*wtemp
291 CALL
zgemm( transa, transe, n, n, n, cone, a, lda, e,
lde, -cone,
294 errnrm =
zlange(
'One', n, n, work, n, rwork ) / enorm
298 IF( anorm.GT.errnrm )
THEN
299 result( 1 ) = ( errnrm / anorm ) / ulp
301 IF( anorm.LT.one )
THEN
302 result( 1 ) = ( min( errnrm, anorm ) / anorm ) / ulp
304 result( 1 ) = min( errnrm / anorm, one ) / ulp
310 result( 2 ) = max( abs( enrmax-one ), abs( enrmin-one ) ) /