LAPACK  3.8.0
LAPACK: Linear Algebra PACKage

◆ cget23()

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

CGET23

Purpose:
    CGET23  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 CGEEVX 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 CGEEVX 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 REAL
          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 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 array, dimension (LDA,N)
          Another copy of the test matrix A, modified by CGEEVX.
[out]W
          W is COMPLEX array, dimension (N)
          Contains the eigenvalues of A.
[out]W1
          W1 is COMPLEX array, dimension (N)
          Like W, this array contains the eigenvalues of A,
          but those computed when CGEEVX only computes a partial
          eigendecomposition, i.e. not the eigenvalues and left
          and right eigenvectors.
[out]VL
          VL is COMPLEX 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 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 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 REAL array, dimension (N)
          RCONDV holds the computed reciprocal condition numbers
          for eigenvectors.
[out]RCNDV1
          RCNDV1 is REAL array, dimension (N)
          RCNDV1 holds more computed reciprocal condition numbers
          for eigenvectors.
[in]RCDVIN
          RCDVIN is REAL array, dimension (N)
          When COMP = .TRUE. RCDVIN holds the precomputed reciprocal
          condition numbers for eigenvectors to be compared with
          RCONDV.
[out]RCONDE
          RCONDE is REAL array, dimension (N)
          RCONDE holds the computed reciprocal condition numbers
          for eigenvalues.
[out]RCNDE1
          RCNDE1 is REAL array, dimension (N)
          RCNDE1 holds more computed reciprocal condition numbers
          for eigenvalues.
[in]RCDEIN
          RCDEIN is REAL array, dimension (N)
          When COMP = .TRUE. RCDEIN holds the precomputed reciprocal
          condition numbers for eigenvalues to be compared with
          RCONDE.
[out]SCALE
          SCALE is REAL array, dimension (N)
          Holds information describing balancing of matrix.
[out]SCALE1
          SCALE1 is REAL array, dimension (N)
          Holds information describing balancing of matrix.
[out]RESULT
          RESULT is REAL 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 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 REAL array, dimension (2*N)
[out]INFO
          INFO is INTEGER
          If 0,  successful exit.
          If <0, input parameter -INFO had an incorrect value.
          If >0, CGEEVX 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.
Date
December 2016

Definition at line 370 of file cget23.f.

370 *
371 * -- LAPACK test routine (version 3.7.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 * December 2016
375 *
376 * .. Scalar Arguments ..
377  LOGICAL comp
378  CHARACTER balanc
379  INTEGER info, isrt, jtype, lda, ldlre, ldvl, ldvr,
380  $ lwork, n, nounit
381  REAL thresh
382 * ..
383 * .. Array Arguments ..
384  INTEGER iseed( 4 )
385  REAL rcdein( * ), rcdvin( * ), rcnde1( * ),
386  $ rcndv1( * ), rconde( * ), rcondv( * ),
387  $ result( 11 ), rwork( * ), scale( * ),
388  $ scale1( * )
389  COMPLEX a( lda, * ), h( lda, * ), lre( ldlre, * ),
390  $ vl( ldvl, * ), vr( ldvr, * ), w( * ), w1( * ),
391  $ work( * )
392 * ..
393 *
394 * =====================================================================
395 *
396 * .. Parameters ..
397  REAL zero, one, two
398  parameter( zero = 0.0e0, one = 1.0e0, two = 2.0e0 )
399  REAL epsin
400  parameter( epsin = 5.9605e-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  REAL abnrm, abnrm1, eps, smlnum, tnrm, tol, tolin,
408  $ ulp, ulpinv, v, vmax, vmx, vricmp, vrimin,
409  $ vrmx, vtst
410  COMPLEX ctmp
411 * ..
412 * .. Local Arrays ..
413  CHARACTER sens( 2 )
414  REAL res( 2 )
415  COMPLEX cdum( 1 )
416 * ..
417 * .. External Functions ..
418  LOGICAL lsame
419  REAL scnrm2, slamch
420  EXTERNAL lsame, scnrm2, slamch
421 * ..
422 * .. External Subroutines ..
423  EXTERNAL cgeevx, cget22, clacpy, xerbla
424 * ..
425 * .. Intrinsic Functions ..
426  INTRINSIC abs, aimag, max, min, real
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( 'CGET23', -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 = slamch( 'Precision' )
478  smlnum = slamch( '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 clacpy( 'F', n, n, a, lda, h, lda )
491  CALL cgeevx( 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 )'CGEEVX1', iinfo, n, jtype,
498  $ balanc, iseed
499  ELSE
500  WRITE( nounit, fmt = 9999 )'CGEEVX1', iinfo, n, iseed( 1 )
501  END IF
502  info = abs( iinfo )
503  RETURN
504  END IF
505 *
506 * Do Test (1)
507 *
508  CALL cget22( '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 cget22( '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 = scnrm2( 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( aimag( vr( jj, j ) ).EQ.zero .AND.
531  $ abs( REAL( VR( JJ, J ) ) ).GT.vrmx )
532  $ vrmx = abs( REAL( 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 = scnrm2( 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( aimag( vl( jj, j ) ).EQ.zero .AND.
551  $ abs( REAL( VL( JJ, J ) ) ).GT.vrmx )
552  $ vrmx = abs( REAL( 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 clacpy( 'F', n, n, a, lda, h, lda )
567  CALL cgeevx( 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 )'CGEEVX2', iinfo, n, jtype,
574  $ balanc, iseed
575  ELSE
576  WRITE( nounit, fmt = 9999 )'CGEEVX2', 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 clacpy( 'F', n, n, a, lda, h, lda )
617  CALL cgeevx( 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 )'CGEEVX3', iinfo, n, jtype,
624  $ balanc, iseed
625  ELSE
626  WRITE( nounit, fmt = 9999 )'CGEEVX3', 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 clacpy( 'F', n, n, a, lda, h, lda )
676  CALL cgeevx( 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 )'CGEEVX4', iinfo, n, jtype,
683  $ balanc, iseed
684  ELSE
685  WRITE( nounit, fmt = 9999 )'CGEEVX4', 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 clacpy( 'F', n, n, a, lda, h, lda )
740  CALL cgeevx( '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 )'CGEEVX5', 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 = REAL( W( I ) )
757  ELSE
758  vrimin = aimag( w( i ) )
759  END IF
760  DO 210 j = i + 1, n
761  IF( isrt.EQ.0 ) THEN
762  vricmp = REAL( W( J ) )
763  ELSE
764  vricmp = aimag( 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( REAL( 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( ' CGET23: ', a, ' returned INFO=', i6, '.', / 9x, 'N=',
852  $ i6, ', INPUT EXAMPLE NUMBER = ', i4 )
853  9998 FORMAT( ' CGET23: ', a, ' returned INFO=', i6, '.', / 9x, 'N=',
854  $ i6, ', JTYPE=', i6, ', BALANC = ', a, ', ISEED=(',
855  $ 3( i5, ',' ), i5, ')' )
856 *
857  RETURN
858 *
859 * End of CGET23
860 *
real function scnrm2(N, X, INCX)
SCNRM2
Definition: scnrm2.f:77
subroutine cgeevx(BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, W, VL, LDVL, VR, LDVR, ILO, IHI, SCALE, ABNRM, RCONDE, RCONDV, WORK, LWORK, RWORK, INFO)
CGEEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices ...
Definition: cgeevx.f:289
subroutine cget22(TRANSA, TRANSE, TRANSW, N, A, LDA, E, LDE, W, WORK, RWORK, RESULT)
CGET22
Definition: cget22.f:145
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:55
real function slamch(CMACH)
SLAMCH
Definition: slamch.f:69
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
Definition: clacpy.f:105
Here is the call graph for this function:
Here is the caller graph for this function: