365 SUBROUTINE zget23( COMP, ISRT, BALANC, JTYPE, THRESH, ISEED,
366 $ nounit, n, a, lda, h, w, w1, vl, ldvl, vr,
367 $ ldvr, lre, ldlre, rcondv, rcndv1, rcdvin,
368 $ rconde, rcnde1, rcdein, scale, scale1, result,
369 $ work, lwork, rwork, info )
379 INTEGER info, isrt, jtype, lda, ldlre, ldvl, ldvr,
381 DOUBLE PRECISION thresh
385 DOUBLE PRECISION rcdein( * ), rcdvin( * ), rcnde1( * ),
386 $ rcndv1( * ), rconde( * ), rcondv( * ),
387 $ result( 11 ), rwork( * ), scale( * ),
389 COMPLEX*16 a( lda, * ), h( lda, * ), lre( ldlre, * ),
390 $ vl( ldvl, * ), vr( ldvr, * ), w( * ), w1( * ),
397 DOUBLE PRECISION zero, one, two
398 parameter( zero = 0.0d0, one = 1.0d0, two = 2.0d0 )
399 DOUBLE PRECISION epsin
400 parameter( epsin = 5.9605d-8 )
405 INTEGER i, ihi, ihi1, iinfo, ilo, ilo1, isens, isensm,
407 DOUBLE PRECISION abnrm, abnrm1, eps, smlnum, tnrm, tol, tolin,
408 $ ulp, ulpinv, v, vmax, vmx, vricmp, vrimin,
414 DOUBLE PRECISION res( 2 )
426 INTRINSIC abs, dble, dimag, max, min
429 DATA sens /
'N',
'V' /
435 nobal =
lsame( balanc,
'N' )
436 balok = nobal .OR.
lsame( balanc,
'P' ) .OR.
437 $
lsame( balanc,
'S' ) .OR.
lsame( balanc,
'B' )
439 IF( isrt.NE.0 .AND. isrt.NE.1 )
THEN
441 ELSE IF( .NOT.balok )
THEN
443 ELSE IF( thresh.LT.zero )
THEN
445 ELSE IF( nounit.LE.0 )
THEN
447 ELSE IF( n.LT.0 )
THEN
449 ELSE IF( lda.LT.1 .OR. lda.LT.n )
THEN
451 ELSE IF( ldvl.LT.1 .OR. ldvl.LT.n )
THEN
453 ELSE IF( ldvr.LT.1 .OR. ldvr.LT.n )
THEN
455 ELSE IF( ldlre.LT.1 .OR. ldlre.LT.n )
THEN
457 ELSE IF( lwork.LT.2*n .OR. ( comp .AND. lwork.LT.2*n+n*n ) )
THEN
462 CALL
xerbla(
'ZGET23', -info )
477 ulp =
dlamch(
'Precision' )
483 IF( lwork.GE.2*n+n*n )
THEN
490 CALL
zlacpy(
'F', n, n, a, lda, h, lda )
491 CALL
zgeevx( balanc,
'V',
'V', sense, n, h, lda, w, vl, ldvl, vr,
492 $ ldvr, ilo, ihi, scale, abnrm, rconde, rcondv, work,
493 $ lwork, rwork, iinfo )
494 IF( iinfo.NE.0 )
THEN
496 IF( jtype.NE.22 )
THEN
497 WRITE( nounit, fmt = 9998 )
'ZGEEVX1', iinfo, n, jtype,
500 WRITE( nounit, fmt = 9999 )
'ZGEEVX1', iinfo, n, iseed( 1 )
508 CALL
zget22(
'N',
'N',
'N', n, a, lda, vr, ldvr, w, work, rwork,
510 result( 1 ) = res( 1 )
514 CALL
zget22(
'C',
'N',
'C', n, a, lda, vl, ldvl, w, work, rwork,
516 result( 2 ) = res( 1 )
521 tnrm =
dznrm2( n, vr( 1, j ), 1 )
522 result( 3 ) = max( result( 3 ),
523 $ min( ulpinv, abs( tnrm-one ) / ulp ) )
527 vtst = abs( vr( jj, j ) )
530 IF( dimag( vr( jj, j ) ).EQ.zero .AND.
531 $ abs( dble( vr( jj, j ) ) ).GT.vrmx )
532 $ vrmx = abs( dble( vr( jj, j ) ) )
534 IF( vrmx / vmx.LT.one-two*ulp )
535 $ result( 3 ) = ulpinv
541 tnrm =
dznrm2( n, vl( 1, j ), 1 )
542 result( 4 ) = max( result( 4 ),
543 $ min( ulpinv, abs( tnrm-one ) / ulp ) )
547 vtst = abs( vl( jj, j ) )
550 IF( dimag( vl( jj, j ) ).EQ.zero .AND.
551 $ abs( dble( vl( jj, j ) ) ).GT.vrmx )
552 $ vrmx = abs( dble( vl( jj, j ) ) )
554 IF( vrmx / vmx.LT.one-two*ulp )
555 $ result( 4 ) = ulpinv
560 DO 200 isens = 1, isensm
562 sense = sens( isens )
566 CALL
zlacpy(
'F', n, n, a, lda, h, lda )
567 CALL
zgeevx( balanc,
'N',
'N', sense, n, h, lda, w1, cdum, 1,
568 $ cdum, 1, ilo1, ihi1, scale1, abnrm1, rcnde1,
569 $ rcndv1, work, lwork, rwork, iinfo )
570 IF( iinfo.NE.0 )
THEN
572 IF( jtype.NE.22 )
THEN
573 WRITE( nounit, fmt = 9998 )
'ZGEEVX2', iinfo, n, jtype,
576 WRITE( nounit, fmt = 9999 )
'ZGEEVX2', iinfo, n,
586 IF( w( j ).NE.w1( j ) )
587 $ result( 5 ) = ulpinv
592 IF( .NOT.nobal )
THEN
594 IF( scale( j ).NE.scale1( j ) )
595 $ result( 8 ) = ulpinv
598 $ result( 8 ) = ulpinv
600 $ result( 8 ) = ulpinv
601 IF( abnrm.NE.abnrm1 )
602 $ result( 8 ) = ulpinv
607 IF( isens.EQ.2 .AND. n.GT.1 )
THEN
609 IF( rcondv( j ).NE.rcndv1( j ) )
610 $ result( 9 ) = ulpinv
616 CALL
zlacpy(
'F', n, n, a, lda, h, lda )
617 CALL
zgeevx( balanc,
'N',
'V', sense, n, h, lda, w1, cdum, 1,
618 $ lre, ldlre, ilo1, ihi1, scale1, abnrm1, rcnde1,
619 $ rcndv1, work, lwork, rwork, iinfo )
620 IF( iinfo.NE.0 )
THEN
622 IF( jtype.NE.22 )
THEN
623 WRITE( nounit, fmt = 9998 )
'ZGEEVX3', iinfo, n, jtype,
626 WRITE( nounit, fmt = 9999 )
'ZGEEVX3', iinfo, n,
636 IF( w( j ).NE.w1( j ) )
637 $ result( 5 ) = ulpinv
644 IF( vr( j, jj ).NE.lre( j, jj ) )
645 $ result( 6 ) = ulpinv
651 IF( .NOT.nobal )
THEN
653 IF( scale( j ).NE.scale1( j ) )
654 $ result( 8 ) = ulpinv
657 $ result( 8 ) = ulpinv
659 $ result( 8 ) = ulpinv
660 IF( abnrm.NE.abnrm1 )
661 $ result( 8 ) = ulpinv
666 IF( isens.EQ.2 .AND. n.GT.1 )
THEN
668 IF( rcondv( j ).NE.rcndv1( j ) )
669 $ result( 9 ) = ulpinv
675 CALL
zlacpy(
'F', n, n, a, lda, h, lda )
676 CALL
zgeevx( balanc,
'V',
'N', sense, n, h, lda, w1, lre,
677 $ ldlre, cdum, 1, ilo1, ihi1, scale1, abnrm1,
678 $ rcnde1, rcndv1, work, lwork, rwork, iinfo )
679 IF( iinfo.NE.0 )
THEN
681 IF( jtype.NE.22 )
THEN
682 WRITE( nounit, fmt = 9998 )
'ZGEEVX4', iinfo, n, jtype,
685 WRITE( nounit, fmt = 9999 )
'ZGEEVX4', iinfo, n,
695 IF( w( j ).NE.w1( j ) )
696 $ result( 5 ) = ulpinv
703 IF( vl( j, jj ).NE.lre( j, jj ) )
704 $ result( 7 ) = ulpinv
710 IF( .NOT.nobal )
THEN
712 IF( scale( j ).NE.scale1( j ) )
713 $ result( 8 ) = ulpinv
716 $ result( 8 ) = ulpinv
718 $ result( 8 ) = ulpinv
719 IF( abnrm.NE.abnrm1 )
720 $ result( 8 ) = ulpinv
725 IF( isens.EQ.2 .AND. n.GT.1 )
THEN
727 IF( rcondv( j ).NE.rcndv1( j ) )
728 $ result( 9 ) = ulpinv
739 CALL
zlacpy(
'F', n, n, a, lda, h, lda )
740 CALL
zgeevx(
'N',
'V',
'V',
'B', n, h, lda, w, vl, ldvl, vr,
741 $ ldvr, ilo, ihi, scale, abnrm, rconde, rcondv,
742 $ work, lwork, rwork, iinfo )
743 IF( iinfo.NE.0 )
THEN
745 WRITE( nounit, fmt = 9999 )
'ZGEEVX5', iinfo, n, iseed( 1 )
756 vrimin = dble( w( i ) )
758 vrimin = dimag( w( i ) )
762 vricmp = dble( w( j ) )
764 vricmp = dimag( w( j ) )
766 IF( vricmp.LT.vrimin )
THEN
774 vrimin = rconde( kmin )
775 rconde( kmin ) = rconde( i )
777 vrimin = rcondv( kmin )
778 rcondv( kmin ) = rcondv( i )
786 eps = max( epsin, ulp )
787 v = max( dble( n )*eps*abnrm, smlnum )
791 IF( v.GT.rcondv( i )*rconde( i ) )
THEN
794 tol = v / rconde( i )
796 IF( v.GT.rcdvin( i )*rcdein( i ) )
THEN
799 tolin = v / rcdein( i )
801 tol = max( tol, smlnum / eps )
802 tolin = max( tolin, smlnum / eps )
803 IF( eps*( rcdvin( i )-tolin ).GT.rcondv( i )+tol )
THEN
805 ELSE IF( rcdvin( i )-tolin.GT.rcondv( i )+tol )
THEN
806 vmax = ( rcdvin( i )-tolin ) / ( rcondv( i )+tol )
807 ELSE IF( rcdvin( i )+tolin.LT.eps*( rcondv( i )-tol ) )
THEN
809 ELSE IF( rcdvin( i )+tolin.LT.rcondv( i )-tol )
THEN
810 vmax = ( rcondv( i )-tol ) / ( rcdvin( i )+tolin )
814 result( 10 ) = max( result( 10 ), vmax )
822 IF( v.GT.rcondv( i ) )
THEN
825 tol = v / rcondv( i )
827 IF( v.GT.rcdvin( i ) )
THEN
830 tolin = v / rcdvin( i )
832 tol = max( tol, smlnum / eps )
833 tolin = max( tolin, smlnum / eps )
834 IF( eps*( rcdein( i )-tolin ).GT.rconde( i )+tol )
THEN
836 ELSE IF( rcdein( i )-tolin.GT.rconde( i )+tol )
THEN
837 vmax = ( rcdein( i )-tolin ) / ( rconde( i )+tol )
838 ELSE IF( rcdein( i )+tolin.LT.eps*( rconde( i )-tol ) )
THEN
840 ELSE IF( rcdein( i )+tolin.LT.rconde( i )-tol )
THEN
841 vmax = ( rconde( i )-tol ) / ( rcdein( i )+tolin )
845 result( 11 ) = max( result( 11 ), vmax )
851 9999 format(
' ZGET23: ', a,
' returned INFO=', i6,
'.', / 9x,
'N=',
852 $ i6,
', INPUT EXAMPLE NUMBER = ', i4 )
853 9998 format(
' ZGET23: ', a,
' returned INFO=', i6,
'.', / 9x,
'N=',
854 $ i6,
', JTYPE=', i6,
', BALANC = ', a,
', ISEED=(',
855 $ 3( i5,
',' ), i5,
')' )