491 SUBROUTINE zdrvvx( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH,
492 $ NIUNIT, NOUNIT, A, LDA, H, W, W1, VL, LDVL, VR,
493 $ LDVR, LRE, LDLRE, RCONDV, RCNDV1, RCDVIN,
494 $ RCONDE, RCNDE1, RCDEIN, SCALE, SCALE1, RESULT,
495 $ WORK, NWORK, RWORK, INFO )
502 INTEGER INFO, LDA, LDLRE, LDVL, LDVR, NIUNIT, NOUNIT,
503 $ NSIZES, NTYPES, NWORK
504 DOUBLE PRECISION THRESH
508 INTEGER ISEED( 4 ), NN( * )
509 DOUBLE PRECISION RCDEIN( * ), RCDVIN( * ), RCNDE1( * ),
510 $ RCNDV1( * ), RCONDE( * ), RCONDV( * ),
511 $ result( 11 ), rwork( * ), scale( * ),
513 COMPLEX*16 A( LDA, * ), H( LDA, * ), LRE( LDLRE, * ),
514 $ VL( LDVL, * ), VR( LDVR, * ), W( * ), W1( * ),
522 PARAMETER ( CZERO = ( 0.0d+0, 0.0d+0 ) )
524 PARAMETER ( CONE = ( 1.0d+0, 0.0d+0 ) )
525 DOUBLE PRECISION ZERO, ONE
526 parameter( zero = 0.0d+0, one = 1.0d+0 )
528 parameter( maxtyp = 21 )
534 INTEGER I, IBAL, IINFO, IMODE, ISRT, ITYPE, IWK, J,
535 $ jcol, jsize, jtype, mtypes, n, nerrs, nfail,
536 $ nmax, nnwork, ntest, ntestf, ntestt
537 DOUBLE PRECISION ANORM, COND, CONDS, OVFL, RTULP, RTULPI, ULP,
538 $ ulpinv, unfl, wi, wr
542 INTEGER IDUMMA( 1 ), IOLDSD( 4 ), KCONDS( MAXTYP ),
543 $ KMAGN( MAXTYP ), KMODE( MAXTYP ),
547 DOUBLE PRECISION DLAMCH
555 INTRINSIC abs, dcmplx,
max,
min, sqrt
558 DATA ktype / 1, 2, 3, 5*4, 4*6, 6*6, 3*9 /
559 DATA kmagn / 3*1, 1, 1, 1, 2, 3, 4*1, 1, 1, 1, 1, 2,
561 DATA kmode / 3*0, 4, 3, 1, 4, 4, 4, 3, 1, 5, 4, 3,
563 DATA kconds / 3*0, 5*0,
564 DATA bal /
'N',
'P',
'S',
'B' /
568 path( 1: 1 ) =
'Zomplex precision'
586 nmax =
max( nmax, nn( j ) )
593 IF( nsizes.LT.0 )
THEN
595 ELSE IF( badnn )
THEN
597 ELSE IF( ntypes.LT.0 )
THEN
599 ELSE IF( thresh.LT.zero )
THEN
601 ELSE IF( lda.LT.1 .OR. lda.LT.nmax )
THEN
603 ELSE IF( ldvl.LT.1 .OR. ldvl.LT.nmax )
THEN
605 ELSE IF( ldvr.LT.1 .OR. ldvr.LT.nmax )
THEN
607 ELSE IF( ldlre.LT.1 .OR. ldlre.LT.nmax )
THEN
609 ELSE IF( 6*nmax+2*nmax**2.GT.nwork )
THEN
614 CALL xerbla(
'ZDRVVX', -info )
620 IF( nsizes.EQ.0 .OR. ntypes.EQ.0 )
625 unfl = dlamch(
'Safe minimum' )
628 ulp = dlamch(
'Precision' )
637 DO 150 jsize = 1, nsizes
639 IF( nsizes.NE.1 )
THEN
640 mtypes =
min( maxtyp, ntypes )
642 mtypes =
min( maxtyp+1, ntypes )
645 DO 140 jtype = 1, mtypes
646 IF( .NOT.dotype( jtype ) )
652 ioldsd( j ) = iseed( j )
671 IF( mtypes.GT.maxtyp )
674 itype = ktype( jtype )
675 imode = kmode( jtype )
679 GO TO ( 30, 40, 50 )kmagn( jtype )
695 CALL zlaset(
'Full', lda, n, czero, czero, a, lda )
703 IF( itype.EQ.1 )
THEN
706 ELSE IF( itype.EQ.2 )
THEN
711 a( jcol, jcol ) = anorm
714 ELSE IF( itype.EQ.3 )
THEN
719 a( jcol, jcol ) = anorm
721 $ a( jcol, jcol-1 ) = one
724 ELSE IF( itype.EQ.4 )
THEN
728 CALL zlatms( n, n,
'S', iseed,
'H', rwork, imode, cond,
729 $ anorm, 0, 0,
'N', a, lda, work( n+1 ),
732 ELSE IF( itype.EQ.5 )
THEN
736 CALL zlatms( n, n,
'S', iseed,
'H', rwork, imode, cond,
737 $ anorm, n, n,
'N', a, lda, work( n+1 ),
740 ELSE IF( itype.EQ.6 )
THEN
744 IF( kconds( jtype ).EQ.1 )
THEN
746 ELSE IF( kconds( jtype ).EQ.2 )
THEN
752 CALL zlatme( n,
'D', iseed, work, imode, cond, cone,
753 $
'T',
'T',
'T', rwork, 4, conds, n, n, anorm,
754 $ a, lda, work( 2*n+1 ), iinfo )
756 ELSE IF( itype.EQ.7 )
THEN
760 CALL zlatmr( n, n,
'D', iseed,
'S', work, 6, one, cone,
761 $
'T',
'N', work( n+1 ), 1, one,
762 $ work( 2*n+1 ), 1, one,
'N', idumma, 0, 0,
763 $ zero, anorm,
'NO', a, lda, idumma, iinfo )
765 ELSE IF( itype.EQ.8 )
THEN
769 CALL zlatmr( n, n,
'D', iseed,
'H', work, 6, one, cone,
770 $
'T',
'N', work( n+1 ), 1, one,
771 $ work( 2*n+1 ), 1, one,
'N', idumma, n, n,
772 $ zero, anorm,
'NO', a, lda, idumma, iinfo )
774 ELSE IF( itype.EQ.9 )
THEN
778 CALL zlatmr( n, n,
'D', iseed,
'N', work, 6, one, cone,
779 $
'T',
'N', work( n+1 ), 1, one,
780 $ work( 2*n+1 ), 1, one,
'N', idumma, n, n,
781 $ zero, anorm,
'NO', a, lda, idumma, iinfo )
783 CALL zlaset(
'Full', 2, n, czero, czero, a, lda )
784 CALL zlaset(
'Full', n-3, 1, czero, czero, a( 3, 1 ),
786 CALL zlaset(
'Full', n-3, 2, czero, czero,
788 CALL zlaset(
'Full', 1, n, czero, czero, a( n, 1 ),
792 ELSE IF( itype.EQ.10 )
THEN
796 CALL zlatmr( n, n,
'D', iseed,
'N', work, 6, one, cone,
797 $
'T',
'N', work( n+1 ), 1, one,
798 $ work( 2*n+1 ), 1, one,
'N', idumma, n, 0,
799 $ zero, anorm,
'NO', a, lda, idumma, iinfo )
806 IF( iinfo.NE.0 )
THEN
807 WRITE( nounit, fmt = 9992 )
'Generator', iinfo, n, jtype,
820 ELSE IF( iwk.EQ.2 )
THEN
823 nnwork = 6*n + 2*n**2
825 nnwork =
max( nnwork, 1 )
834 CALL zget23( .false., 0, balanc, jtype, thresh,
835 $ ioldsd, nounit, n, a, lda, h, w, w1, vl,
836 $ ldvl, vr, ldvr, lre, ldlre, rcondv,
837 $ rcndv1, rcdvin, rconde, rcnde1, rcdein,
838 $ scale, scale1, result, work, nnwork,
846 IF( result( j ).GE.zero )
848 IF( result( j ).GE.thresh )
853 $ ntestf = ntestf + 1
854 IF( ntestf.EQ.1 )
THEN
855 WRITE( nounit, fmt = 9999 )path
856 WRITE( nounit, fmt = 9998 )
857 WRITE( nounit, fmt = 9997 )
858 WRITE( nounit, fmt = 9996 )
859 WRITE( nounit, fmt = 9995 )thresh
864 IF( result( j ).GE.thresh )
THEN
865 WRITE( nounit, fmt = 9994 )balanc, n, iwk,
866 $ ioldsd, jtype, j, result( j )
870 nerrs = nerrs + nfail
871 ntestt = ntestt + ntest
886 READ( niunit, fmt = *,
END = 220 )N, isrt
895 READ( niunit, fmt = * )( a( i, j ), j = 1, n )
898 READ( niunit, fmt = * )wr, wi, rcdein( i ), rcdvin( i )
899 w1( i ) = dcmplx( wr, wi )
901 CALL zget23( .true., isrt,
'N', 22, thresh, iseed, nounit, n, a,
902 $ lda, h, w, w1, vl, ldvl, vr, ldvr, lre, ldlre,
903 $ rcondv, rcndv1, rcdvin, rconde, rcnde1, rcdein,
904 $ scale, scale1, result, work, 6*n+2*n**2, rwork,
912 IF( result( j ).GE.zero )
914 IF( result( j ).GE.thresh )
919 $ ntestf = ntestf + 1
920 IF( ntestf.EQ.1 )
THEN
921 WRITE( nounit, fmt = 9999 )path
922 WRITE( nounit, fmt = 9998 )
923 WRITE( nounit, fmt = 9997 )
924 WRITE( nounit, fmt = 9996 )
925 WRITE( nounit, fmt = 9995 )thresh
930 IF( result( j ).GE.thresh )
THEN
931 WRITE( nounit, fmt = 9993 )n, jtype, j, result( j )
935 nerrs = nerrs + nfail
936 ntestt = ntestt + ntest
942 CALL dlasum( path, nounit, nerrs, ntestt )
944 9999
FORMAT( / 1x, a3,
' -- Complex Eigenvalue-Eigenvector ',
945 $
'Decomposition Expert Driver',
946 $ /
' Matrix types (see ZDRVVX for details): ' )
948 9998
FORMAT( /
' Special Matrices:', /
' 1=Zero matrix. ',
949 $
' ',
' 5=Diagonal: geometr. spaced entries.',
950 $ /
' 2=Identity matrix. ',
' 6=Diagona',
951 $
'l: clustered entries.', /
' 3=Transposed Jordan block. ',
952 $
' ',
' 7=Diagonal: large, evenly spaced.', /
' ',
953 $
'4=Diagonal: evenly spaced entries. ',
' 8=Diagonal: s',
954 $
'mall, evenly spaced.' )
955 9997
FORMAT(
' Dense, Non-Symmetric Matrices:', /
' 9=Well-cond., ev',
956 $
'enly spaced eigenvals.',
' 14=Ill-cond., geomet. spaced e',
957 $
'igenals.', /
' 10=Well-cond., geom. spaced eigenvals. ',
958 $
' 15=Ill-conditioned, clustered e.vals.', /
' 11=Well-cond',
959 $
'itioned, clustered e.vals. ',
' 16=Ill-cond., random comp',
960 $
'lex ', /
' 12=Well-cond., random complex ',
' ',
961 $
' 17=Ill-cond., large rand. complx ', /
' 13=Ill-condi',
962 $
'tioned, evenly spaced. ',
' 18=Ill-cond., small rand.',
964 9996
FORMAT(
' 19=Matrix with random O(1) entries. ',
' 21=Matrix ',
965 $
'with small random entries.', /
' 20=Matrix with large ran',
966 $ 'dom entries.
', ' 22=matrix
read from input file
', / )
967 9995 FORMAT( ' tests performed with test threshold =
', F8.2,
968 $ / / ' 1 = | a vr - vr
',
969 $ / ' 2 = | transpose(a) vl - vl
',
970 $ / ' 3 = | |vr(i)| - 1 | / ulp
',
971 $ / ' 4 = | |vl(i)| - 1 | / ulp
',
972 $ / ' 5 = 0
if w same no matter
if vr or vl computed,
',
974 $ ' 6 = 0
if vr same no matter what
else computed,
',
975 $ ' 1/ulp otherwise
', /
976 $ ' 7 = 0
if vl same no matter what
else computed,
',
977 $ ' 1/ulp otherwise
', /
978 $ ' 8 = 0
if rcondv same no matter what
else computed,
',
979 $ ' 1/ulp otherwise
', /
980 $ ' 9 = 0
if scale, ilo, ihi, abnrm same no matter what else
',
981 $ ' computed, 1/ulp otherwise
',
982 $ / ' 10 = | rcondv - rcondv(precomputed) | / cond(rcondv),
',
983 $ / ' 11 = | rconde - rconde(precomputed) | / cond(rconde),
' )
984 9994 FORMAT( ' balanc=
''', A1, ''',n=
', I4, ',iwk=
', I1, ',
seed=
',
985 $ 4( I4, ',
' ), ' type ', I2, ', test(
', I2, ')=
', G10.3 )
986 9993 FORMAT( ' n=
', I5, ', input example =
', I3, ', test(
', I2, ')=
',
988 9992 FORMAT( ' zdrvvx:
', A, ' returned info=
', I6, '.
', / 9X, 'n=
',
989 $ I6, ', jtype=
', I6, ', iseed=(
', 3( I5, ',
' ), I5, ')
' )