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.OR.
BALOK = NOBAL LSAME( BALANC, 'p.OR.
' )
434 $ LSAME( BALANC, 's.OR.
' ) LSAME( BALANC, 'b
' )
436.NE..AND..NE.
IF( ISRT0 ISRT1 ) THEN
438.NOT.
ELSE IF( BALOK ) THEN
440.LT.
ELSE IF( THRESHZERO ) THEN
442.LE.
ELSE IF( NOUNIT0 ) THEN
444.LT.
ELSE IF( N0 ) THEN
446.LT..OR..LT.
ELSE IF( LDA1 LDAN ) THEN
448.LT..OR..LT.
ELSE IF( LDVL1 LDVLN ) THEN
450.LT..OR..LT.
ELSE IF( LDVR1 LDVRN ) THEN
452.LT..OR..LT.
ELSE IF( LDLRE1 LDLREN ) THEN
454.LT..OR..AND..LT.
ELSE IF( LWORK2*N ( COMP LWORK2*N+N*N ) ) THEN
459 CALL XERBLA( 'zget23', -INFO )
474 ULP = DLAMCH( 'precision
' )
475 SMLNUM = DLAMCH( 's
' )
480.GE.
IF( LWORK2*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.NE.
IF( IINFO0 ) THEN
493.NE.
IF( JTYPE22 ) 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.EQ..AND.
IF( DIMAG( VR( JJ, J ) )ZERO
528.GT.
$ ABS( DBLE( VR( JJ, J ) ) )VRMX )
529 $ VRMX = ABS( DBLE( VR( JJ, J ) ) )
531.LT.
IF( VRMX / VMXONE-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.EQ..AND.
IF( DIMAG( VL( JJ, J ) )ZERO
548.GT.
$ ABS( DBLE( VL( JJ, J ) ) )VRMX )
549 $ VRMX = ABS( DBLE( 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 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.NE.
IF( IINFO0 ) THEN
569.NE.
IF( JTYPE22 ) THEN
570 WRITE( NOUNIT, FMT = 9998 )'zgeevx2
', IINFO, N, JTYPE,
573 WRITE( NOUNIT, FMT = 9999 )'zgeevx2
', 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 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.NE.
IF( IINFO0 ) THEN
619.NE.
IF( JTYPE22 ) THEN
620 WRITE( NOUNIT, FMT = 9998 )'zgeevx3
', IINFO, N, JTYPE,
623 WRITE( NOUNIT, FMT = 9999 )'zgeevx3
', 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 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.NE.
IF( IINFO0 ) THEN
678.NE.
IF( JTYPE22 ) THEN
679 WRITE( NOUNIT, FMT = 9998 )'zgeevx4
', IINFO, N, JTYPE,
682 WRITE( NOUNIT, FMT = 9999 )'zgeevx4
', 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 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.NE.
IF( IINFO0 ) 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.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( DBLE( 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( ' 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,
')' )
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
subroutine zlacpy(uplo, m, n, a, lda, b, ldb)
ZLACPY copies all or part of one two-dimensional array to another.
subroutine zget22(transa, transe, transw, n, a, lda, e, lde, w, work, rwork, result)
ZGET22
subroutine zget23(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)
ZGET23