363 SUBROUTINE cget23( 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,
382 REAL RCDEIN( * ), RCDVIN( * ), RCNDE1( * ),
383 $ RCNDV1( * ), RCONDE( * ), RCONDV( * ),
384 $ RESULT( 11 ), RWORK( * ), SCALE( * ),
386 COMPLEX A( LDA, * ), H( LDA, * ), LRE( LDLRE, * ),
387 $ VL( LDVL, * ), VR( LDVR, * ), W( * ), W1( * ),
395 PARAMETER ( ZERO = 0.0e0, one = 1.0e0, two = 2.0e0 )
397 PARAMETER ( EPSIN = 5.9
402 INTEGER I, IHI, IHI1, IINFO, ILO, ILO1, , ISENSM,
404 REAL ABNRM, ABNRM1, EPS, SMLNUM, TNRM, TOL, TOLIN,
405 $ ulp, ulpinv, v, vmax, vmx, vricmp, vrimin,
417 EXTERNAL LSAME, SCNRM2, SLAMCH
423 INTRINSIC abs, aimag,
max,
min, real
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(
'CGET23', -info )
474 ulp = slamch(
'Precision' )
475 smlnum = slamch(
'S' )
480 IF( lwork.GE.2*n+n*n )
THEN
487 CALL clacpy(
'F', n, n, a, lda, h, lda )
488 CALL cgeevx( 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 )
'CGEEVX1', iinfo, n, jtype,
497 WRITE( nounit, fmt = 9999 )
'CGEEVX1', iinfo, n, iseed( 1 )
505 CALL cget22(
'N',
'N', 'n
', N, A, LDA, VR, LDVR, W, WORK, RWORK,
507 RESULT( 1 ) = RES( 1 )
511 CALL CGET22( 'c
', 'n
', 'c
', N, A, LDA, VL, LDVL, W, WORK, RWORK,
513 RESULT( 2 ) = RES( 1 )
518 TNRM = SCNRM2( 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.EQ..AND.
IF( AIMAG( VR( JJ, J ) )ZERO
528.GT.
$ ABS( REAL( VR( JJ, J ) ) )VRMX )
529 $ VRMX = ABS( REAL( VR( JJ, J ) ) )
531.LT.
IF( VRMX / VMXONE-TWO*ULP )
532 $ RESULT( 3 ) = ULPINV
538 TNRM = SCNRM2( 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.EQ..AND.
IF( AIMAG( VL( JJ, J ) )ZERO
548.GT.
$ ABS( REAL( VL( JJ, J ) ) )VRMX )
549 $ VRMX = ABS( REAL( VL( JJ, J ) ) )
551.LT.
IF( VRMX / VMXONE-TWO*ULP )
552 $ RESULT( 4 ) = ULPINV
557 DO 200 ISENS = 1, ISENSM
559 SENSE = SENS( ISENS )
563 CALL CLACPY( 'f
', N, N, A, LDA, H, LDA )
564 CALL CGEEVX( 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.NE.
IF( IINFO0 ) THEN
569.NE.
IF( JTYPE22 ) THEN
570 WRITE( NOUNIT, FMT = 9998 )'cgeevx2
', IINFO, N, JTYPE,
573 WRITE( NOUNIT, FMT = 9999 )'cgeevx2
', IINFO, N,
583.NE.
IF( W( J )W1( J ) )
584 $ RESULT( 5 ) = ULPINV
589.NOT.
IF( NOBAL ) THEN
591.NE.
IF( SCALE( J )SCALE1( J ) )
592 $ RESULT( 8 ) = ULPINV
595 $ RESULT( 8 ) = ULPINV
597 $ RESULT( 8 ) = ULPINV
598.NE.
IF( ABNRMABNRM1 )
599 $ RESULT( 8 ) = ULPINV
604.EQ..AND..GT.
IF( ISENS2 N1 ) THEN
606.NE.
IF( RCONDV( J )RCNDV1( J ) )
607 $ RESULT( 9 ) = ULPINV
613 CALL CLACPY( 'f
', N, N, A, LDA, H, LDA )
614 CALL CGEEVX( 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.NE.
IF( IINFO0 ) THEN
619.NE.
IF( JTYPE22 ) THEN
620 WRITE( NOUNIT, FMT = 9998 )'cgeevx3
', IINFO, N, JTYPE,
623 WRITE( NOUNIT, FMT = 9999 )'cgeevx3
', IINFO, N,
633.NE.
IF( W( J )W1( J ) )
634 $ RESULT( 5 ) = ULPINV
641.NE.
IF( VR( J, JJ )LRE( J, JJ ) )
642 $ RESULT( 6 ) = ULPINV
648.NOT.
IF( NOBAL ) THEN
650.NE.
IF( SCALE( J )SCALE1( J ) )
651 $ RESULT( 8 ) = ULPINV
654 $ RESULT( 8 ) = ULPINV
656 $ RESULT( 8 ) = ULPINV
657.NE.
IF( ABNRMABNRM1 )
658 $ RESULT( 8 ) = ULPINV
663.EQ..AND..GT.
IF( ISENS2 N1 ) THEN
665.NE.
IF( RCONDV( J )RCNDV1( J ) )
666 $ RESULT( 9 ) = ULPINV
672 CALL CLACPY( 'f
', N, N, A, LDA, H, LDA )
673 CALL CGEEVX( 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.NE.
IF( IINFO0 ) THEN
678.NE.
IF( JTYPE22 ) THEN
679 WRITE( NOUNIT, FMT = 9998 )'cgeevx4
', IINFO, N, JTYPE,
682 WRITE( NOUNIT, FMT = 9999 )'cgeevx4
', IINFO, N,
692.NE.
IF( W( J )W1( J ) )
693 $ RESULT( 5 ) = ULPINV
700.NE.
IF( VL( J, JJ )LRE( J, JJ ) )
701 $ RESULT( 7 ) = ULPINV
707.NOT.
IF( NOBAL ) THEN
709.NE.
IF( SCALE( J )SCALE1( J ) )
710 $ RESULT( 8 ) = ULPINV
713 $ RESULT( 8 ) = ULPINV
715 $ RESULT( 8 ) = ULPINV
716.NE.
IF( ABNRMABNRM1 )
717 $ RESULT( 8 ) = ULPINV
722.EQ..AND..GT.
IF( ISENS2 N1 ) THEN
724.NE.
IF( RCONDV( J )RCNDV1( J ) )
725 $ RESULT( 9 ) = ULPINV
736 CALL CLACPY( 'f
', N, N, A, LDA, H, LDA )
737 CALL CGEEVX( '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.NE.
IF( IINFO0 ) THEN
742 WRITE( NOUNIT, FMT = 9999 )'cgeevx5
', IINFO, N, ISEED( 1 )
753 VRIMIN = REAL( W( I ) )
755 VRIMIN = AIMAG( W( I ) )
759 VRICMP = REAL( W( J ) )
761 VRICMP = AIMAG( W( J ) )
763.LT.
IF( VRICMPVRIMIN ) 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( REAL( N )*EPS*ABNRM, SMLNUM )
788.GT.
IF( VRCONDV( I )*RCONDE( I ) ) THEN
791 TOL = V / RCONDE( I )
793.GT.
IF( VRCDVIN( I )*RCDEIN( I ) ) THEN
796 TOLIN = V / RCDEIN( I )
798 TOL = MAX( TOL, SMLNUM / EPS )
799 TOLIN = MAX( TOLIN, SMLNUM / EPS )
800.GT.
IF( EPS*( RCDVIN( I )-TOLIN )RCONDV( I )+TOL ) THEN
802.GT.
ELSE IF( RCDVIN( I )-TOLINRCONDV( I )+TOL ) THEN
803 VMAX = ( RCDVIN( I )-TOLIN ) / ( RCONDV( I )+TOL )
804.LT.
ELSE IF( RCDVIN( I )+TOLINEPS*( RCONDV( I )-TOL ) ) THEN
806.LT.
ELSE IF( RCDVIN( I )+TOLINRCONDV( I )-TOL ) THEN
807 VMAX = ( RCONDV( I )-TOL ) / ( RCDVIN( I )+TOLIN )
811 RESULT( 10 ) = MAX( RESULT( 10 ), VMAX )
819.GT.
IF( VRCONDV( I ) ) THEN
822 TOL = V / RCONDV( I )
824.GT.
IF( VRCDVIN( I ) ) THEN
827 TOLIN = V / RCDVIN( I )
829 TOL = MAX( TOL, SMLNUM / EPS )
830 TOLIN = MAX( TOLIN, SMLNUM / EPS )
831.GT.
IF( EPS*( RCDEIN( I )-TOLIN )RCONDE( I )+TOL ) THEN
833.GT.
ELSE IF( RCDEIN( I )-TOLINRCONDE( I )+TOL ) THEN
834 VMAX = ( RCDEIN( I )-TOLIN ) / ( RCONDE( I )+TOL )
835.LT.
ELSE IF( RCDEIN( I )+TOLINEPS*( RCONDE( I )-TOL ) ) THEN
837.LT.
ELSE IF( RCDEIN( I )+TOLINRCONDE( I )-TOL ) THEN
838 VMAX = ( RCONDE( I )-TOL ) / ( RCDEIN( I )+TOLIN )
842 RESULT( 11 ) = MAX( RESULT( 11 ), VMAX )
848 9999 FORMAT( ' cget23:
', A, ' returned info=
', I6, '.
', / 9X, 'n=
',
849 $ I6, ', input example number =
', I4 )
850 9998 FORMAT( ' cget23:
', A, ' returned info=
', I6, '.
', / 9X, 'n=
',
851 $ I6, ', jtype=
', I6, ', balanc =
', A, ', iseed=(
',
852 $ 3( I5, ',
' ), I5, ')
' )
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
subroutine cget23(comp, isrt, balanc, jtype, thresh, iseed, nounit, n, a, lda, h, w, w1, vl, ldvl, vr, ldvr, lre, ldlre, rcondv, rcndv1, rcdvin, rconde, rcnde1, rcdein, scale, scale1, result, work, lwork, rwork, info)
CGET23