LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ zget23()

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.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.

Definition at line 363 of file zget23.f.

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