LAPACK  3.6.1 LAPACK: Linear Algebra PACKage
 subroutine zget23 ( logical COMP, integer ISRT, character BALANC, integer JTYPE, double precision THRESH, integer, dimension( 4 ) ISEED, integer NOUNIT, integer N, complex*16, dimension( lda, * ) A, integer LDA, complex*16, dimension( lda, * ) H, complex*16, dimension( * ) W, complex*16, dimension( * ) W1, complex*16, dimension( ldvl, * ) VL, integer LDVL, complex*16, dimension( ldvr, * ) VR, integer LDVR, complex*16, dimension( ldlre, * ) LRE, integer LDLRE, double precision, dimension( * ) RCONDV, double precision, dimension( * ) RCNDV1, double precision, dimension( * ) RCDVIN, double precision, dimension( * ) RCONDE, double precision, dimension( * ) RCNDE1, double precision, dimension( * ) RCDEIN, double precision, dimension( * ) SCALE, double precision, dimension( * ) SCALE1, double precision, dimension( 11 ) RESULT, complex*16, dimension( * ) WORK, integer LWORK, double precision, dimension( * ) RWORK, integer INFO )

ZGET23

Purpose:
```    ZGET23  checks the nonsymmetric eigenvalue problem driver CGEEVX.
If COMP = .FALSE., the first 8 of the following tests will be
performed on the input matrix A, and also test 9 if LWORK is
sufficiently large.
if COMP is .TRUE. all 11 tests will be performed.

(1)     | A * VR - VR * W | / ( n |A| ulp )

Here VR is the matrix of unit right eigenvectors.
W is a diagonal matrix with diagonal entries W(j).

(2)     | A**H * VL - VL * W**H | / ( n |A| ulp )

Here VL is the matrix of unit left eigenvectors, A**H is the
conjugate transpose of A, and W is as above.

(3)     | |VR(i)| - 1 | / ulp and largest component real

VR(i) denotes the i-th column of VR.

(4)     | |VL(i)| - 1 | / ulp and largest component real

VL(i) denotes the i-th column of VL.

(5)     0 if W(full) = W(partial), 1/ulp otherwise

W(full) denotes the eigenvalues computed when VR, VL, RCONDV
and RCONDE are also computed, and W(partial) denotes the
eigenvalues computed when only some of VR, VL, RCONDV, and
RCONDE are computed.

(6)     0 if VR(full) = VR(partial), 1/ulp otherwise

VR(full) denotes the right eigenvectors computed when VL, RCONDV
and RCONDE are computed, and VR(partial) denotes the result
when only some of VL and RCONDV are computed.

(7)     0 if VL(full) = VL(partial), 1/ulp otherwise

VL(full) denotes the left eigenvectors computed when VR, RCONDV
and RCONDE are computed, and VL(partial) denotes the result
when only some of VR and RCONDV are computed.

(8)     0 if SCALE, ILO, IHI, ABNRM (full) =
SCALE, ILO, IHI, ABNRM (partial)
1/ulp otherwise

SCALE, ILO, IHI and ABNRM describe how the matrix is balanced.
(full) is when VR, VL, RCONDE and RCONDV are also computed, and
(partial) is when some are not computed.

(9)     0 if RCONDV(full) = RCONDV(partial), 1/ulp otherwise

RCONDV(full) denotes the reciprocal condition numbers of the
right eigenvectors computed when VR, VL and RCONDE are also
computed. RCONDV(partial) denotes the reciprocal condition
numbers when only some of VR, VL and RCONDE are computed.

(10)     |RCONDV - RCDVIN| / cond(RCONDV)

RCONDV is the reciprocal right eigenvector condition number
computed by ZGEEVX and RCDVIN (the precomputed true value)
is supplied as input. cond(RCONDV) is the condition number of
RCONDV, and takes errors in computing RCONDV into account, so
that the resulting quantity should be O(ULP). cond(RCONDV) is
essentially given by norm(A)/RCONDE.

(11)     |RCONDE - RCDEIN| / cond(RCONDE)

RCONDE is the reciprocal eigenvalue condition number
computed by ZGEEVX and RCDEIN (the precomputed true value)
is supplied as input.  cond(RCONDE) is the condition number
of RCONDE, and takes errors in computing RCONDE into account,
so that the resulting quantity should be O(ULP). cond(RCONDE)
is essentially given by norm(A)/RCONDV.```
Parameters
 [in] COMP ``` COMP is LOGICAL COMP describes which input tests to perform: = .FALSE. if the computed condition numbers are not to be tested against RCDVIN and RCDEIN = .TRUE. if they are to be compared``` [in] ISRT ``` ISRT is INTEGER If COMP = .TRUE., ISRT indicates in how the eigenvalues corresponding to values in RCDVIN and RCDEIN are ordered: = 0 means the eigenvalues are sorted by increasing real part = 1 means the eigenvalues are sorted by increasing imaginary part If COMP = .FALSE., ISRT is not referenced.``` [in] BALANC ``` BALANC is CHARACTER Describes the balancing option to be tested. = 'N' for no permuting or diagonal scaling = 'P' for permuting but no diagonal scaling = 'S' for no permuting but diagonal scaling = 'B' for permuting and diagonal scaling``` [in] JTYPE ``` JTYPE is INTEGER Type of input matrix. Used to label output if error occurs.``` [in] THRESH ``` THRESH is DOUBLE PRECISION A test will count as "failed" if the "error", computed as described above, exceeds THRESH. Note that the error is scaled to be O(1), so THRESH should be a reasonably small multiple of 1, e.g., 10 or 100. In particular, it should not depend on the precision (single vs. double) or the size of the matrix. It must be at least zero.``` [in] ISEED ``` ISEED is INTEGER array, dimension (4) If COMP = .FALSE., the random number generator seed used to produce matrix. If COMP = .TRUE., ISEED(1) = the number of the example. Used to label output if error occurs.``` [in] NOUNIT ``` NOUNIT is INTEGER The FORTRAN unit number for printing out error messages (e.g., if a routine returns INFO not equal to 0.)``` [in] N ``` N is INTEGER The dimension of A. N must be at least 0.``` [in,out] A ``` A is COMPLEX*16 array, dimension (LDA,N) Used to hold the matrix whose eigenvalues are to be computed.``` [in] LDA ``` LDA is INTEGER The leading dimension of A, and H. LDA must be at least 1 and at least N.``` [out] H ``` H is COMPLEX*16 array, dimension (LDA,N) Another copy of the test matrix A, modified by ZGEEVX.``` [out] W ``` W is COMPLEX*16 array, dimension (N) Contains the eigenvalues of A.``` [out] W1 ``` W1 is COMPLEX*16 array, dimension (N) Like W, this array contains the eigenvalues of A, but those computed when ZGEEVX only computes a partial eigendecomposition, i.e. not the eigenvalues and left and right eigenvectors.``` [out] VL ``` VL is COMPLEX*16 array, dimension (LDVL,N) VL holds the computed left eigenvectors.``` [in] LDVL ``` LDVL is INTEGER Leading dimension of VL. Must be at least max(1,N).``` [out] VR ``` VR is COMPLEX*16 array, dimension (LDVR,N) VR holds the computed right eigenvectors.``` [in] LDVR ``` LDVR is INTEGER Leading dimension of VR. Must be at least max(1,N).``` [out] LRE ``` LRE is COMPLEX*16 array, dimension (LDLRE,N) LRE holds the computed right or left eigenvectors.``` [in] LDLRE ``` LDLRE is INTEGER Leading dimension of LRE. Must be at least max(1,N).``` [out] RCONDV ``` RCONDV is DOUBLE PRECISION array, dimension (N) RCONDV holds the computed reciprocal condition numbers for eigenvectors.``` [out] RCNDV1 ``` RCNDV1 is DOUBLE PRECISION array, dimension (N) RCNDV1 holds more computed reciprocal condition numbers for eigenvectors.``` [in] RCDVIN ``` RCDVIN is DOUBLE PRECISION array, dimension (N) When COMP = .TRUE. RCDVIN holds the precomputed reciprocal condition numbers for eigenvectors to be compared with RCONDV.``` [out] RCONDE ``` RCONDE is DOUBLE PRECISION array, dimension (N) RCONDE holds the computed reciprocal condition numbers for eigenvalues.``` [out] RCNDE1 ``` RCNDE1 is DOUBLE PRECISION array, dimension (N) RCNDE1 holds more computed reciprocal condition numbers for eigenvalues.``` [in] RCDEIN ``` RCDEIN is DOUBLE PRECISION array, dimension (N) When COMP = .TRUE. RCDEIN holds the precomputed reciprocal condition numbers for eigenvalues to be compared with RCONDE.``` [out] SCALE ``` SCALE is DOUBLE PRECISION array, dimension (N) Holds information describing balancing of matrix.``` [out] SCALE1 ``` SCALE1 is DOUBLE PRECISION array, dimension (N) Holds information describing balancing of matrix.``` [out] RESULT ``` RESULT is DOUBLE PRECISION array, dimension (11) The values computed by the 11 tests described above. The values are currently limited to 1/ulp, to avoid overflow.``` [out] WORK ` WORK is COMPLEX*16 array, dimension (LWORK)` [in] LWORK ``` LWORK is INTEGER The number of entries in WORK. This must be at least 2*N, and 2*N+N**2 if tests 9, 10 or 11 are to be performed.``` [out] RWORK ` RWORK is DOUBLE PRECISION array, dimension (2*N)` [out] INFO ``` INFO is INTEGER If 0, successful exit. If <0, input parameter -INFO had an incorrect value. If >0, ZGEEVX returned an error code, the absolute value of which is returned.```
Date
November 2011

Definition at line 370 of file zget23.f.

370 *
371 * -- LAPACK test routine (version 3.4.0) --
372 * -- LAPACK is a software package provided by Univ. of Tennessee, --
373 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
374 * November 2011
375 *
376 * .. Scalar Arguments ..
377  LOGICAL comp
378  CHARACTER balanc
379  INTEGER info, isrt, jtype, lda, ldlre, ldvl, ldvr,
380  \$ lwork, n, nounit
381  DOUBLE PRECISION thresh
382 * ..
383 * .. Array Arguments ..
384  INTEGER iseed( 4 )
385  DOUBLE PRECISION rcdein( * ), rcdvin( * ), rcnde1( * ),
386  \$ rcndv1( * ), rconde( * ), rcondv( * ),
387  \$ result( 11 ), rwork( * ), scale( * ),
388  \$ scale1( * )
389  COMPLEX*16 a( lda, * ), h( lda, * ), lre( ldlre, * ),
390  \$ vl( ldvl, * ), vr( ldvr, * ), w( * ), w1( * ),
391  \$ work( * )
392 * ..
393 *
394 * =====================================================================
395 *
396 * .. Parameters ..
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 )
401 * ..
402 * .. Local Scalars ..
403  LOGICAL balok, nobal
404  CHARACTER sense
405  INTEGER i, ihi, ihi1, iinfo, ilo, ilo1, isens, isensm,
406  \$ j, jj, kmin
407  DOUBLE PRECISION abnrm, abnrm1, eps, smlnum, tnrm, tol, tolin,
408  \$ ulp, ulpinv, v, vmax, vmx, vricmp, vrimin,
409  \$ vrmx, vtst
410  COMPLEX*16 ctmp
411 * ..
412 * .. Local Arrays ..
413  CHARACTER sens( 2 )
414  DOUBLE PRECISION res( 2 )
415  COMPLEX*16 cdum( 1 )
416 * ..
417 * .. External Functions ..
418  LOGICAL lsame
419  DOUBLE PRECISION dlamch, dznrm2
420  EXTERNAL lsame, dlamch, dznrm2
421 * ..
422 * .. External Subroutines ..
423  EXTERNAL xerbla, zgeevx, zget22, zlacpy
424 * ..
425 * .. Intrinsic Functions ..
426  INTRINSIC abs, dble, dimag, max, min
427 * ..
428 * .. Data statements ..
429  DATA sens / 'N', 'V' /
430 * ..
431 * .. Executable Statements ..
432 *
433 * Check for errors
434 *
435  nobal = lsame( balanc, 'N' )
436  balok = nobal .OR. lsame( balanc, 'P' ) .OR.
437  \$ lsame( balanc, 'S' ) .OR. lsame( balanc, 'B' )
438  info = 0
439  IF( isrt.NE.0 .AND. isrt.NE.1 ) THEN
440  info = -2
441  ELSE IF( .NOT.balok ) THEN
442  info = -3
443  ELSE IF( thresh.LT.zero ) THEN
444  info = -5
445  ELSE IF( nounit.LE.0 ) THEN
446  info = -7
447  ELSE IF( n.LT.0 ) THEN
448  info = -8
449  ELSE IF( lda.LT.1 .OR. lda.LT.n ) THEN
450  info = -10
451  ELSE IF( ldvl.LT.1 .OR. ldvl.LT.n ) THEN
452  info = -15
453  ELSE IF( ldvr.LT.1 .OR. ldvr.LT.n ) THEN
454  info = -17
455  ELSE IF( ldlre.LT.1 .OR. ldlre.LT.n ) THEN
456  info = -19
457  ELSE IF( lwork.LT.2*n .OR. ( comp .AND. lwork.LT.2*n+n*n ) ) THEN
458  info = -30
459  END IF
460 *
461  IF( info.NE.0 ) THEN
462  CALL xerbla( 'ZGET23', -info )
463  RETURN
464  END IF
465 *
466 * Quick return if nothing to do
467 *
468  DO 10 i = 1, 11
469  result( i ) = -one
470  10 CONTINUE
471 *
472  IF( n.EQ.0 )
473  \$ RETURN
474 *
475 * More Important constants
476 *
477  ulp = dlamch( 'Precision' )
478  smlnum = dlamch( 'S' )
479  ulpinv = one / ulp
480 *
481 * Compute eigenvalues and eigenvectors, and test them
482 *
483  IF( lwork.GE.2*n+n*n ) THEN
484  sense = 'B'
485  isensm = 2
486  ELSE
487  sense = 'E'
488  isensm = 1
489  END IF
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
495  result( 1 ) = ulpinv
496  IF( jtype.NE.22 ) THEN
497  WRITE( nounit, fmt = 9998 )'ZGEEVX1', iinfo, n, jtype,
498  \$ balanc, iseed
499  ELSE
500  WRITE( nounit, fmt = 9999 )'ZGEEVX1', iinfo, n, iseed( 1 )
501  END IF
502  info = abs( iinfo )
503  RETURN
504  END IF
505 *
506 * Do Test (1)
507 *
508  CALL zget22( 'N', 'N', 'N', n, a, lda, vr, ldvr, w, work, rwork,
509  \$ res )
510  result( 1 ) = res( 1 )
511 *
512 * Do Test (2)
513 *
514  CALL zget22( 'C', 'N', 'C', n, a, lda, vl, ldvl, w, work, rwork,
515  \$ res )
516  result( 2 ) = res( 1 )
517 *
518 * Do Test (3)
519 *
520  DO 30 j = 1, n
521  tnrm = dznrm2( n, vr( 1, j ), 1 )
522  result( 3 ) = max( result( 3 ),
523  \$ min( ulpinv, abs( tnrm-one ) / ulp ) )
524  vmx = zero
525  vrmx = zero
526  DO 20 jj = 1, n
527  vtst = abs( vr( jj, j ) )
528  IF( vtst.GT.vmx )
529  \$ vmx = vtst
530  IF( dimag( vr( jj, j ) ).EQ.zero .AND.
531  \$ abs( dble( vr( jj, j ) ) ).GT.vrmx )
532  \$ vrmx = abs( dble( vr( jj, j ) ) )
533  20 CONTINUE
534  IF( vrmx / vmx.LT.one-two*ulp )
535  \$ result( 3 ) = ulpinv
536  30 CONTINUE
537 *
538 * Do Test (4)
539 *
540  DO 50 j = 1, n
541  tnrm = dznrm2( n, vl( 1, j ), 1 )
542  result( 4 ) = max( result( 4 ),
543  \$ min( ulpinv, abs( tnrm-one ) / ulp ) )
544  vmx = zero
545  vrmx = zero
546  DO 40 jj = 1, n
547  vtst = abs( vl( jj, j ) )
548  IF( vtst.GT.vmx )
549  \$ vmx = vtst
550  IF( dimag( vl( jj, j ) ).EQ.zero .AND.
551  \$ abs( dble( vl( jj, j ) ) ).GT.vrmx )
552  \$ vrmx = abs( dble( vl( jj, j ) ) )
553  40 CONTINUE
554  IF( vrmx / vmx.LT.one-two*ulp )
555  \$ result( 4 ) = ulpinv
556  50 CONTINUE
557 *
558 * Test for all options of computing condition numbers
559 *
560  DO 200 isens = 1, isensm
561 *
562  sense = sens( isens )
563 *
564 * Compute eigenvalues only, and test them
565 *
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
571  result( 1 ) = ulpinv
572  IF( jtype.NE.22 ) THEN
573  WRITE( nounit, fmt = 9998 )'ZGEEVX2', iinfo, n, jtype,
574  \$ balanc, iseed
575  ELSE
576  WRITE( nounit, fmt = 9999 )'ZGEEVX2', iinfo, n,
577  \$ iseed( 1 )
578  END IF
579  info = abs( iinfo )
580  GO TO 190
581  END IF
582 *
583 * Do Test (5)
584 *
585  DO 60 j = 1, n
586  IF( w( j ).NE.w1( j ) )
587  \$ result( 5 ) = ulpinv
588  60 CONTINUE
589 *
590 * Do Test (8)
591 *
592  IF( .NOT.nobal ) THEN
593  DO 70 j = 1, n
594  IF( scale( j ).NE.scale1( j ) )
595  \$ result( 8 ) = ulpinv
596  70 CONTINUE
597  IF( ilo.NE.ilo1 )
598  \$ result( 8 ) = ulpinv
599  IF( ihi.NE.ihi1 )
600  \$ result( 8 ) = ulpinv
601  IF( abnrm.NE.abnrm1 )
602  \$ result( 8 ) = ulpinv
603  END IF
604 *
605 * Do Test (9)
606 *
607  IF( isens.EQ.2 .AND. n.GT.1 ) THEN
608  DO 80 j = 1, n
609  IF( rcondv( j ).NE.rcndv1( j ) )
610  \$ result( 9 ) = ulpinv
611  80 CONTINUE
612  END IF
613 *
614 * Compute eigenvalues and right eigenvectors, and test them
615 *
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
621  result( 1 ) = ulpinv
622  IF( jtype.NE.22 ) THEN
623  WRITE( nounit, fmt = 9998 )'ZGEEVX3', iinfo, n, jtype,
624  \$ balanc, iseed
625  ELSE
626  WRITE( nounit, fmt = 9999 )'ZGEEVX3', iinfo, n,
627  \$ iseed( 1 )
628  END IF
629  info = abs( iinfo )
630  GO TO 190
631  END IF
632 *
633 * Do Test (5) again
634 *
635  DO 90 j = 1, n
636  IF( w( j ).NE.w1( j ) )
637  \$ result( 5 ) = ulpinv
638  90 CONTINUE
639 *
640 * Do Test (6)
641 *
642  DO 110 j = 1, n
643  DO 100 jj = 1, n
644  IF( vr( j, jj ).NE.lre( j, jj ) )
645  \$ result( 6 ) = ulpinv
646  100 CONTINUE
647  110 CONTINUE
648 *
649 * Do Test (8) again
650 *
651  IF( .NOT.nobal ) THEN
652  DO 120 j = 1, n
653  IF( scale( j ).NE.scale1( j ) )
654  \$ result( 8 ) = ulpinv
655  120 CONTINUE
656  IF( ilo.NE.ilo1 )
657  \$ result( 8 ) = ulpinv
658  IF( ihi.NE.ihi1 )
659  \$ result( 8 ) = ulpinv
660  IF( abnrm.NE.abnrm1 )
661  \$ result( 8 ) = ulpinv
662  END IF
663 *
664 * Do Test (9) again
665 *
666  IF( isens.EQ.2 .AND. n.GT.1 ) THEN
667  DO 130 j = 1, n
668  IF( rcondv( j ).NE.rcndv1( j ) )
669  \$ result( 9 ) = ulpinv
670  130 CONTINUE
671  END IF
672 *
673 * Compute eigenvalues and left eigenvectors, and test them
674 *
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
680  result( 1 ) = ulpinv
681  IF( jtype.NE.22 ) THEN
682  WRITE( nounit, fmt = 9998 )'ZGEEVX4', iinfo, n, jtype,
683  \$ balanc, iseed
684  ELSE
685  WRITE( nounit, fmt = 9999 )'ZGEEVX4', iinfo, n,
686  \$ iseed( 1 )
687  END IF
688  info = abs( iinfo )
689  GO TO 190
690  END IF
691 *
692 * Do Test (5) again
693 *
694  DO 140 j = 1, n
695  IF( w( j ).NE.w1( j ) )
696  \$ result( 5 ) = ulpinv
697  140 CONTINUE
698 *
699 * Do Test (7)
700 *
701  DO 160 j = 1, n
702  DO 150 jj = 1, n
703  IF( vl( j, jj ).NE.lre( j, jj ) )
704  \$ result( 7 ) = ulpinv
705  150 CONTINUE
706  160 CONTINUE
707 *
708 * Do Test (8) again
709 *
710  IF( .NOT.nobal ) THEN
711  DO 170 j = 1, n
712  IF( scale( j ).NE.scale1( j ) )
713  \$ result( 8 ) = ulpinv
714  170 CONTINUE
715  IF( ilo.NE.ilo1 )
716  \$ result( 8 ) = ulpinv
717  IF( ihi.NE.ihi1 )
718  \$ result( 8 ) = ulpinv
719  IF( abnrm.NE.abnrm1 )
720  \$ result( 8 ) = ulpinv
721  END IF
722 *
723 * Do Test (9) again
724 *
725  IF( isens.EQ.2 .AND. n.GT.1 ) THEN
726  DO 180 j = 1, n
727  IF( rcondv( j ).NE.rcndv1( j ) )
728  \$ result( 9 ) = ulpinv
729  180 CONTINUE
730  END IF
731 *
732  190 CONTINUE
733 *
734  200 CONTINUE
735 *
736 * If COMP, compare condition numbers to precomputed ones
737 *
738  IF( comp ) THEN
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
744  result( 1 ) = ulpinv
745  WRITE( nounit, fmt = 9999 )'ZGEEVX5', iinfo, n, iseed( 1 )
746  info = abs( iinfo )
747  GO TO 250
748  END IF
749 *
750 * Sort eigenvalues and condition numbers lexicographically
751 * to compare with inputs
752 *
753  DO 220 i = 1, n - 1
754  kmin = i
755  IF( isrt.EQ.0 ) THEN
756  vrimin = dble( w( i ) )
757  ELSE
758  vrimin = dimag( w( i ) )
759  END IF
760  DO 210 j = i + 1, n
761  IF( isrt.EQ.0 ) THEN
762  vricmp = dble( w( j ) )
763  ELSE
764  vricmp = dimag( w( j ) )
765  END IF
766  IF( vricmp.LT.vrimin ) THEN
767  kmin = j
768  vrimin = vricmp
769  END IF
770  210 CONTINUE
771  ctmp = w( kmin )
772  w( kmin ) = w( i )
773  w( i ) = ctmp
774  vrimin = rconde( kmin )
775  rconde( kmin ) = rconde( i )
776  rconde( i ) = vrimin
777  vrimin = rcondv( kmin )
778  rcondv( kmin ) = rcondv( i )
779  rcondv( i ) = vrimin
780  220 CONTINUE
781 *
782 * Compare condition numbers for eigenvectors
783 * taking their condition numbers into account
784 *
785  result( 10 ) = zero
786  eps = max( epsin, ulp )
787  v = max( dble( n )*eps*abnrm, smlnum )
788  IF( abnrm.EQ.zero )
789  \$ v = one
790  DO 230 i = 1, n
791  IF( v.GT.rcondv( i )*rconde( i ) ) THEN
792  tol = rcondv( i )
793  ELSE
794  tol = v / rconde( i )
795  END IF
796  IF( v.GT.rcdvin( i )*rcdein( i ) ) THEN
797  tolin = rcdvin( i )
798  ELSE
799  tolin = v / rcdein( i )
800  END IF
801  tol = max( tol, smlnum / eps )
802  tolin = max( tolin, smlnum / eps )
803  IF( eps*( rcdvin( i )-tolin ).GT.rcondv( i )+tol ) THEN
804  vmax = one / eps
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
808  vmax = one / eps
809  ELSE IF( rcdvin( i )+tolin.LT.rcondv( i )-tol ) THEN
810  vmax = ( rcondv( i )-tol ) / ( rcdvin( i )+tolin )
811  ELSE
812  vmax = one
813  END IF
814  result( 10 ) = max( result( 10 ), vmax )
815  230 CONTINUE
816 *
817 * Compare condition numbers for eigenvalues
818 * taking their condition numbers into account
819 *
820  result( 11 ) = zero
821  DO 240 i = 1, n
822  IF( v.GT.rcondv( i ) ) THEN
823  tol = one
824  ELSE
825  tol = v / rcondv( i )
826  END IF
827  IF( v.GT.rcdvin( i ) ) THEN
828  tolin = one
829  ELSE
830  tolin = v / rcdvin( i )
831  END IF
832  tol = max( tol, smlnum / eps )
833  tolin = max( tolin, smlnum / eps )
834  IF( eps*( rcdein( i )-tolin ).GT.rconde( i )+tol ) THEN
835  vmax = one / eps
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
839  vmax = one / eps
840  ELSE IF( rcdein( i )+tolin.LT.rconde( i )-tol ) THEN
841  vmax = ( rconde( i )-tol ) / ( rcdein( i )+tolin )
842  ELSE
843  vmax = one
844  END IF
845  result( 11 ) = max( result( 11 ), vmax )
846  240 CONTINUE
847  250 CONTINUE
848 *
849  END IF
850 *
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, ')' )
856 *
857  RETURN
858 *
859 * End of ZGET23
860 *
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
Definition: zlacpy.f:105
double precision function dlamch(CMACH)
DLAMCH
Definition: dlamch.f:65
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
double precision function dznrm2(N, X, INCX)
DZNRM2
Definition: dznrm2.f:56
subroutine zgeevx(BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, W, VL, LDVL, VR, LDVR, ILO, IHI, SCALE, ABNRM, RCONDE, RCONDV, WORK, LWORK, RWORK, INFO)
ZGEEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices ...
Definition: zgeevx.f:289
subroutine zget22(TRANSA, TRANSE, TRANSW, N, A, LDA, E, LDE, W, WORK, RWORK, RESULT)
ZGET22
Definition: zget22.f:145
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:55

Here is the call graph for this function:

Here is the caller graph for this function: