363      SUBROUTINE zget23( COMP, ISRT, BALANC, JTYPE, THRESH, ISEED,
 
  364     $                   NOUNIT, N, A, LDA, H, W, W1, VL, LDVL, VR,
 
  365     $                   LDVR, LRE, LDLRE, RCONDV, RCNDV1, RCDVIN,
 
  366     $                   RCONDE, RCNDE1, RCDEIN, SCALE, SCALE1, RESULT,
 
  367     $                   WORK, LWORK, RWORK, INFO )
 
  376      INTEGER            INFO, ISRT, JTYPE, LDA, LDLRE, LDVL, LDVR,
 
  378      DOUBLE PRECISION   THRESH
 
  382      DOUBLE PRECISION   RCDEIN( * ), RCDVIN( * ), RCNDE1( * ),
 
  383     $                   RCNDV1( * ), RCONDE( * ), RCONDV( * ),
 
  384     $                   RESULT( 11 ), RWORK( * ), SCALE( * ),
 
  386      COMPLEX*16         A( LDA, * ), H( LDA, * ), LRE( LDLRE, * ),
 
  387     $                   VL( LDVL, * ), VR( LDVR, * ), W( * ), W1( * ),
 
  394      DOUBLE PRECISION   ZERO, ONE, TWO
 
  395      PARAMETER          ( ZERO = 0.0d0, one = 1.0d0, two = 2.0d0 )
 
  396      DOUBLE PRECISION   EPSIN
 
  397      PARAMETER          ( EPSIN = 5.9605d-8 )
 
  402      INTEGER            I, IHI, IHI1, IINFO, ILO, ILO1, ISENS, ISENSM,
 
  404      DOUBLE PRECISION   ABNRM, ABNRM1, EPS, SMLNUM, TNRM, TOL, TOLIN,
 
  405     $                   ulp, ulpinv, v, vmax, vmx, vricmp, vrimin,
 
  411      DOUBLE PRECISION   RES( 2 )
 
  416      DOUBLE PRECISION   DLAMCH, DZNRM2
 
  417      EXTERNAL           LSAME, DLAMCH, DZNRM2
 
  423      INTRINSIC          abs, dble, dimag, max, min
 
  426      DATA               sens / 
'N', 
'V' /
 
  432      nobal = lsame( balanc, 
'N' )
 
  433      balok = nobal .OR. lsame( balanc, 
'P' ) .OR.
 
  434     $        lsame( balanc, 
'S' ) .OR. lsame( balanc, 
'B' )
 
  436      IF( isrt.NE.0 .AND. isrt.NE.1 ) 
THEN 
  438      ELSE IF( .NOT.balok ) 
THEN 
  440      ELSE IF( thresh.LT.zero ) 
THEN 
  442      ELSE IF( nounit.LE.0 ) 
THEN 
  444      ELSE IF( n.LT.0 ) 
THEN 
  446      ELSE IF( lda.LT.1 .OR. lda.LT.n ) 
THEN 
  448      ELSE IF( ldvl.LT.1 .OR. ldvl.LT.n ) 
THEN 
  450      ELSE IF( ldvr.LT.1 .OR. ldvr.LT.n ) 
THEN 
  452      ELSE IF( ldlre.LT.1 .OR. ldlre.LT.n ) 
THEN 
  454      ELSE IF( lwork.LT.2*n .OR. ( comp .AND. lwork.LT.2*n+n*n ) ) 
THEN 
  459         CALL xerbla( 
'ZGET23', -info )
 
  474      ulp = dlamch( 
'Precision' )
 
  475      smlnum = dlamch( 
'S' )
 
  480      IF( lwork.GE.2*n+n*n ) 
THEN 
  487      CALL zlacpy( 
'F', n, n, a, lda, h, lda )
 
  488      CALL zgeevx( balanc, 
'V', 
'V', sense, n, h, lda, w, vl, ldvl, vr,
 
  489     $             ldvr, ilo, ihi, scale, abnrm, rconde, rcondv, work,
 
  490     $             lwork, rwork, iinfo )
 
  491      IF( iinfo.NE.0 ) 
THEN 
  493         IF( jtype.NE.22 ) 
THEN 
  494            WRITE( nounit, fmt = 9998 )
'ZGEEVX1', iinfo, n, jtype,
 
  497            WRITE( nounit, fmt = 9999 )
'ZGEEVX1', iinfo, n, iseed( 1 )
 
  505      CALL zget22( 
'N', 
'N', 
'N', n, a, lda, vr, ldvr, w, work, rwork,
 
  507      result( 1 ) = res( 1 )
 
  511      CALL zget22( 
'C', 
'N', 
'C', n, a, lda, vl, ldvl, w, work, rwork,
 
  513      result( 2 ) = res( 1 )
 
  518         tnrm = dznrm2( n, vr( 1, j ), 1 )
 
  519         result( 3 ) = max( result( 3 ),
 
  520     $                 min( ulpinv, abs( tnrm-one ) / ulp ) )
 
  524            vtst = abs( vr( jj, j ) )
 
  527            IF( dimag( vr( jj, j ) ).EQ.zero .AND.
 
  528     $          abs( dble( vr( jj, j ) ) ).GT.vrmx )
 
  529     $          vrmx = abs( dble( vr( jj, j ) ) )
 
  531         IF( vrmx / vmx.LT.one-two*ulp )
 
  532     $      result( 3 ) = ulpinv
 
  538         tnrm = dznrm2( n, vl( 1, j ), 1 )
 
  539         result( 4 ) = max( result( 4 ),
 
  540     $                 min( ulpinv, abs( tnrm-one ) / ulp ) )
 
  544            vtst = abs( vl( jj, j ) )
 
  547            IF( dimag( vl( jj, j ) ).EQ.zero .AND.
 
  548     $          abs( dble( vl( jj, j ) ) ).GT.vrmx )
 
  549     $          vrmx = abs( dble( vl( jj, j ) ) )
 
  551         IF( vrmx / vmx.LT.one-two*ulp )
 
  552     $      result( 4 ) = ulpinv
 
  557      DO 200 isens = 1, isensm
 
  559         sense = sens( isens )
 
  563         CALL zlacpy( 
'F', n, n, a, lda, h, lda )
 
  564         CALL zgeevx( balanc, 
'N', 
'N', sense, n, h, lda, w1, cdum, 1,
 
  565     $                cdum, 1, ilo1, ihi1, scale1, abnrm1, rcnde1,
 
  566     $                rcndv1, work, lwork, rwork, iinfo )
 
  567         IF( iinfo.NE.0 ) 
THEN 
  569            IF( jtype.NE.22 ) 
THEN 
  570               WRITE( nounit, fmt = 9998 )
'ZGEEVX2', iinfo, n, jtype,
 
  573               WRITE( nounit, fmt = 9999 )
'ZGEEVX2', iinfo, n,
 
  583            IF( w( j ).NE.w1( j ) )
 
  584     $         result( 5 ) = ulpinv
 
  589         IF( .NOT.nobal ) 
THEN 
  591               IF( scale( j ).NE.scale1( j ) )
 
  592     $            result( 8 ) = ulpinv
 
  595     $         result( 8 ) = ulpinv
 
  597     $         result( 8 ) = ulpinv
 
  598            IF( abnrm.NE.abnrm1 )
 
  599     $         result( 8 ) = ulpinv
 
  604         IF( isens.EQ.2 .AND. n.GT.1 ) 
THEN 
  606               IF( rcondv( j ).NE.rcndv1( j ) )
 
  607     $            result( 9 ) = ulpinv
 
  613         CALL zlacpy( 
'F', n, n, a, lda, h, lda )
 
  614         CALL zgeevx( balanc, 
'N', 
'V', sense, n, h, lda, w1, cdum, 1,
 
  615     $                lre, ldlre, ilo1, ihi1, scale1, abnrm1, rcnde1,
 
  616     $                rcndv1, work, lwork, rwork, iinfo )
 
  617         IF( iinfo.NE.0 ) 
THEN 
  619            IF( jtype.NE.22 ) 
THEN 
  620               WRITE( nounit, fmt = 9998 )
'ZGEEVX3', iinfo, n, jtype,
 
  623               WRITE( nounit, fmt = 9999 )
'ZGEEVX3', iinfo, n,
 
  633            IF( w( j ).NE.w1( j ) )
 
  634     $         result( 5 ) = ulpinv
 
  641               IF( vr( j, jj ).NE.lre( j, jj ) )
 
  642     $            result( 6 ) = ulpinv
 
  648         IF( .NOT.nobal ) 
THEN 
  650               IF( scale( j ).NE.scale1( j ) )
 
  651     $            result( 8 ) = ulpinv
 
  654     $         result( 8 ) = ulpinv
 
  656     $         result( 8 ) = ulpinv
 
  657            IF( abnrm.NE.abnrm1 )
 
  658     $         result( 8 ) = ulpinv
 
  663         IF( isens.EQ.2 .AND. n.GT.1 ) 
THEN 
  665               IF( rcondv( j ).NE.rcndv1( j ) )
 
  666     $            result( 9 ) = ulpinv
 
  672         CALL zlacpy( 
'F', n, n, a, lda, h, lda )
 
  673         CALL zgeevx( balanc, 
'V', 
'N', sense, n, h, lda, w1, lre,
 
  674     $                ldlre, cdum, 1, ilo1, ihi1, scale1, abnrm1,
 
  675     $                rcnde1, rcndv1, work, lwork, rwork, iinfo )
 
  676         IF( iinfo.NE.0 ) 
THEN 
  678            IF( jtype.NE.22 ) 
THEN 
  679               WRITE( nounit, fmt = 9998 )
'ZGEEVX4', iinfo, n, jtype,
 
  682               WRITE( nounit, fmt = 9999 )
'ZGEEVX4', iinfo, n,
 
  692            IF( w( j ).NE.w1( j ) )
 
  693     $         result( 5 ) = ulpinv
 
  700               IF( vl( j, jj ).NE.lre( j, jj ) )
 
  701     $            result( 7 ) = ulpinv
 
  707         IF( .NOT.nobal ) 
THEN 
  709               IF( scale( j ).NE.scale1( j ) )
 
  710     $            result( 8 ) = ulpinv
 
  713     $         result( 8 ) = ulpinv
 
  715     $         result( 8 ) = ulpinv
 
  716            IF( abnrm.NE.abnrm1 )
 
  717     $         result( 8 ) = ulpinv
 
  722         IF( isens.EQ.2 .AND. n.GT.1 ) 
THEN 
  724               IF( rcondv( j ).NE.rcndv1( j ) )
 
  725     $            result( 9 ) = ulpinv
 
  736         CALL zlacpy( 
'F', n, n, a, lda, h, lda )
 
  737         CALL zgeevx( 
'N', 
'V', 
'V', 
'B', n, h, lda, w, vl, ldvl, vr,
 
  738     $                ldvr, ilo, ihi, scale, abnrm, rconde, rcondv,
 
  739     $                work, lwork, rwork, iinfo )
 
  740         IF( iinfo.NE.0 ) 
THEN 
  742            WRITE( nounit, fmt = 9999 )
'ZGEEVX5', iinfo, n, iseed( 1 )
 
  753               vrimin = dble( w( i ) )
 
  755               vrimin = dimag( w( i ) )
 
  759                  vricmp = dble( w( j ) )
 
  761                  vricmp = dimag( w( j ) )
 
  763               IF( vricmp.LT.vrimin ) 
THEN 
  771            vrimin = rconde( kmin )
 
  772            rconde( kmin ) = rconde( i )
 
  774            vrimin = rcondv( kmin )
 
  775            rcondv( kmin ) = rcondv( i )
 
  783         eps = max( epsin, ulp )
 
  784         v = max( dble( n )*eps*abnrm, smlnum )
 
  788            IF( v.GT.rcondv( i )*rconde( i ) ) 
THEN 
  791               tol = v / rconde( i )
 
  793            IF( v.GT.rcdvin( i )*rcdein( i ) ) 
THEN 
  796               tolin = v / rcdein( i )
 
  798            tol = max( tol, smlnum / eps )
 
  799            tolin = max( tolin, smlnum / eps )
 
  800            IF( eps*( rcdvin( i )-tolin ).GT.rcondv( i )+tol ) 
THEN 
  802            ELSE IF( rcdvin( i )-tolin.GT.rcondv( i )+tol ) 
THEN 
  803               vmax = ( rcdvin( i )-tolin ) / ( rcondv( i )+tol )
 
  804            ELSE IF( rcdvin( i )+tolin.LT.eps*( rcondv( i )-tol ) ) 
THEN 
  806            ELSE IF( rcdvin( i )+tolin.LT.rcondv( i )-tol ) 
THEN 
  807               vmax = ( rcondv( i )-tol ) / ( rcdvin( i )+tolin )
 
  811            result( 10 ) = max( result( 10 ), vmax )
 
  819            IF( v.GT.rcondv( i ) ) 
THEN 
  822               tol = v / rcondv( i )
 
  824            IF( v.GT.rcdvin( i ) ) 
THEN 
  827               tolin = v / rcdvin( i )
 
  829            tol = max( tol, smlnum / eps )
 
  830            tolin = max( tolin, smlnum / eps )
 
  831            IF( eps*( rcdein( i )-tolin ).GT.rconde( i )+tol ) 
THEN 
  833            ELSE IF( rcdein( i )-tolin.GT.rconde( i )+tol ) 
THEN 
  834               vmax = ( rcdein( i )-tolin ) / ( rconde( i )+tol )
 
  835            ELSE IF( rcdein( i )+tolin.LT.eps*( rconde( i )-tol ) ) 
THEN 
  837            ELSE IF( rcdein( i )+tolin.LT.rconde( i )-tol ) 
THEN 
  838               vmax = ( rconde( i )-tol ) / ( rcdein( i )+tolin )
 
  842            result( 11 ) = max( result( 11 ), vmax )
 
  848 9999 
FORMAT( 
' ZGET23: ', a, 
' returned INFO=', i6, 
'.', / 9x, 
'N=',
 
  849     $      i6, 
', INPUT EXAMPLE NUMBER = ', i4 )
 
  850 9998 
FORMAT( 
' ZGET23: ', a, 
' returned INFO=', i6, 
'.', / 9x, 
'N=',
 
  851     $      i6, 
', JTYPE=', i6, 
', BALANC = ', a, 
', ISEED=(',
 
  852     $      3( i5, 
',' ), i5, 
')' )