493 SUBROUTINE zdrvvx( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH,
494 $ niunit, nounit, a, lda, h, w, w1, vl, ldvl, vr,
495 $ ldvr, lre, ldlre, rcondv, rcndv1, rcdvin,
496 $ rconde, rcnde1, rcdein, scale, scale1, result,
497 $ work, nwork, rwork, info )
505 INTEGER info, lda, ldlre, ldvl, ldvr, niunit, nounit,
506 $ nsizes, ntypes, nwork
507 DOUBLE PRECISION thresh
511 INTEGER iseed( 4 ), nn( * )
512 DOUBLE PRECISION rcdein( * ), rcdvin( * ), rcnde1( * ),
513 $ rcndv1( * ), rconde( * ), rcondv( * ),
514 $ result( 11 ), rwork( * ), scale( * ),
516 COMPLEX*16 a( lda, * ), h( lda, * ), lre( ldlre, * ),
517 $ vl( ldvl, * ), vr( ldvr, * ), w( * ), w1( * ),
525 parameter( czero = ( 0.0d+0, 0.0d+0 ) )
527 parameter( cone = ( 1.0d+0, 0.0d+0 ) )
528 DOUBLE PRECISION zero, one
529 parameter( zero = 0.0d+0, one = 1.0d+0 )
531 parameter( maxtyp = 21 )
537 INTEGER i, ibal, iinfo, imode, isrt, itype, iwk, j,
538 $ jcol, jsize, jtype, mtypes, n, nerrs, nfail,
539 $ nmax, nnwork, ntest, ntestf, ntestt
540 DOUBLE PRECISION anorm, cond, conds, ovfl, rtulp, rtulpi, ulp,
541 $ ulpinv, unfl, wi, wr
545 INTEGER idumma( 1 ), ioldsd( 4 ), kconds( maxtyp ),
546 $ kmagn( maxtyp ), kmode( maxtyp ),
558 INTRINSIC abs, dcmplx, max, min, sqrt
561 DATA ktype / 1, 2, 3, 5*4, 4*6, 6*6, 3*9 /
562 DATA kmagn / 3*1, 1, 1, 1, 2, 3, 4*1, 1, 1, 1, 1, 2,
564 DATA kmode / 3*0, 4, 3, 1, 4, 4, 4, 3, 1, 5, 4, 3,
565 $ 1, 5, 5, 5, 4, 3, 1 /
566 DATA kconds / 3*0, 5*0, 4*1, 6*2, 3*0 /
567 DATA bal /
'N',
'P',
'S',
'B' /
571 path( 1: 1 ) =
'Zomplex precision'
589 nmax = max( nmax, nn( j ) )
596 IF( nsizes.LT.0 )
THEN
598 ELSE IF( badnn )
THEN
600 ELSE IF( ntypes.LT.0 )
THEN
602 ELSE IF( thresh.LT.zero )
THEN
604 ELSE IF( lda.LT.1 .OR. lda.LT.nmax )
THEN
606 ELSE IF( ldvl.LT.1 .OR. ldvl.LT.nmax )
THEN
608 ELSE IF( ldvr.LT.1 .OR. ldvr.LT.nmax )
THEN
610 ELSE IF( ldlre.LT.1 .OR. ldlre.LT.nmax )
THEN
612 ELSE IF( 6*nmax+2*nmax**2.GT.nwork )
THEN
617 CALL
xerbla(
'ZDRVVX', -info )
623 IF( nsizes.EQ.0 .OR. ntypes.EQ.0 )
628 unfl =
dlamch(
'Safe minimum' )
631 ulp =
dlamch(
'Precision' )
640 DO 150 jsize = 1, nsizes
642 IF( nsizes.NE.1 )
THEN
643 mtypes = min( maxtyp, ntypes )
645 mtypes = min( maxtyp+1, ntypes )
648 DO 140 jtype = 1, mtypes
649 IF( .NOT.dotype( jtype ) )
655 ioldsd( j ) = iseed( j )
674 IF( mtypes.GT.maxtyp )
677 itype = ktype( jtype )
678 imode = kmode( jtype )
682 go to( 30, 40, 50 )kmagn( jtype )
698 CALL
zlaset(
'Full', lda, n, czero, czero, a, lda )
706 IF( itype.EQ.1 )
THEN
709 ELSE IF( itype.EQ.2 )
THEN
714 a( jcol, jcol ) = anorm
717 ELSE IF( itype.EQ.3 )
THEN
722 a( jcol, jcol ) = anorm
724 $ a( jcol, jcol-1 ) = one
727 ELSE IF( itype.EQ.4 )
THEN
731 CALL
zlatms( n, n,
'S', iseed,
'H', rwork, imode, cond,
732 $ anorm, 0, 0,
'N', a, lda, work( n+1 ),
735 ELSE IF( itype.EQ.5 )
THEN
739 CALL
zlatms( n, n,
'S', iseed,
'H', rwork, imode, cond,
740 $ anorm, n, n,
'N', a, lda, work( n+1 ),
743 ELSE IF( itype.EQ.6 )
THEN
747 IF( kconds( jtype ).EQ.1 )
THEN
749 ELSE IF( kconds( jtype ).EQ.2 )
THEN
755 CALL
zlatme( n,
'D', iseed, work, imode, cond, cone,
756 $
'T',
'T',
'T', rwork, 4, conds, n, n, anorm,
757 $ a, lda, work( 2*n+1 ), iinfo )
759 ELSE IF( itype.EQ.7 )
THEN
763 CALL
zlatmr( n, n,
'D', iseed,
'S', work, 6, one, cone,
764 $
'T',
'N', work( n+1 ), 1, one,
765 $ work( 2*n+1 ), 1, one,
'N', idumma, 0, 0,
766 $ zero, anorm,
'NO', a, lda, idumma, iinfo )
768 ELSE IF( itype.EQ.8 )
THEN
772 CALL
zlatmr( n, n,
'D', iseed,
'H', work, 6, one, cone,
773 $
'T',
'N', work( n+1 ), 1, one,
774 $ work( 2*n+1 ), 1, one,
'N', idumma, n, n,
775 $ zero, anorm,
'NO', a, lda, idumma, iinfo )
777 ELSE IF( itype.EQ.9 )
THEN
781 CALL
zlatmr( n, n,
'D', iseed,
'N', work, 6, one, cone,
782 $
'T',
'N', work( n+1 ), 1, one,
783 $ work( 2*n+1 ), 1, one,
'N', idumma, n, n,
784 $ zero, anorm,
'NO', a, lda, idumma, iinfo )
786 CALL
zlaset(
'Full', 2, n, czero, czero, a, lda )
787 CALL
zlaset(
'Full', n-3, 1, czero, czero, a( 3, 1 ),
789 CALL
zlaset(
'Full', n-3, 2, czero, czero,
791 CALL
zlaset(
'Full', 1, n, czero, czero, a( n, 1 ),
795 ELSE IF( itype.EQ.10 )
THEN
799 CALL
zlatmr( n, n,
'D', iseed,
'N', work, 6, one, cone,
800 $
'T',
'N', work( n+1 ), 1, one,
801 $ work( 2*n+1 ), 1, one,
'N', idumma, n, 0,
802 $ zero, anorm,
'NO', a, lda, idumma, iinfo )
809 IF( iinfo.NE.0 )
THEN
810 WRITE( nounit, fmt = 9992 )
'Generator', iinfo, n, jtype,
823 ELSE IF( iwk.EQ.2 )
THEN
826 nnwork = 6*n + 2*n**2
828 nnwork = max( nnwork, 1 )
837 CALL
zget23( .false., 0, balanc, jtype, thresh,
838 $ ioldsd, nounit, n, a, lda, h, w, w1, vl,
839 $ ldvl, vr, ldvr, lre, ldlre, rcondv,
840 $ rcndv1, rcdvin, rconde, rcnde1, rcdein,
841 $ scale, scale1, result, work, nnwork,
849 IF( result( j ).GE.zero )
851 IF( result( j ).GE.thresh )
856 $ ntestf = ntestf + 1
857 IF( ntestf.EQ.1 )
THEN
858 WRITE( nounit, fmt = 9999 )path
859 WRITE( nounit, fmt = 9998 )
860 WRITE( nounit, fmt = 9997 )
861 WRITE( nounit, fmt = 9996 )
862 WRITE( nounit, fmt = 9995 )thresh
867 IF( result( j ).GE.thresh )
THEN
868 WRITE( nounit, fmt = 9994 )balanc, n, iwk,
869 $ ioldsd, jtype, j, result( j )
873 nerrs = nerrs + nfail
874 ntestt = ntestt + ntest
889 READ( niunit, fmt = *,
END = 220 )n, isrt
898 READ( niunit, fmt = * )( a( i, j ), j = 1, n )
901 READ( niunit, fmt = * )wr, wi, rcdein( i ), rcdvin( i )
902 w1( i ) = dcmplx( wr, wi )
904 CALL
zget23( .true., isrt,
'N', 22, thresh, iseed, nounit, n, a,
905 $ lda, h, w, w1, vl, ldvl, vr, ldvr, lre, ldlre,
906 $ rcondv, rcndv1, rcdvin, rconde, rcnde1, rcdein,
907 $ scale, scale1, result, work, 6*n+2*n**2, rwork,
915 IF( result( j ).GE.zero )
917 IF( result( j ).GE.thresh )
922 $ ntestf = ntestf + 1
923 IF( ntestf.EQ.1 )
THEN
924 WRITE( nounit, fmt = 9999 )path
925 WRITE( nounit, fmt = 9998 )
926 WRITE( nounit, fmt = 9997 )
927 WRITE( nounit, fmt = 9996 )
928 WRITE( nounit, fmt = 9995 )thresh
933 IF( result( j ).GE.thresh )
THEN
934 WRITE( nounit, fmt = 9993 )n, jtype, j, result( j )
938 nerrs = nerrs + nfail
939 ntestt = ntestt + ntest
945 CALL
dlasum( path, nounit, nerrs, ntestt )
947 9999 format( / 1x, a3,
' -- Complex Eigenvalue-Eigenvector ',
948 $
'Decomposition Expert Driver',
949 $ /
' Matrix types (see ZDRVVX for details): ' )
951 9998 format( /
' Special Matrices:', /
' 1=Zero matrix. ',
952 $
' ',
' 5=Diagonal: geometr. spaced entries.',
953 $ /
' 2=Identity matrix. ',
' 6=Diagona',
954 $
'l: clustered entries.', /
' 3=Transposed Jordan block. ',
955 $
' ',
' 7=Diagonal: large, evenly spaced.', /
' ',
956 $
'4=Diagonal: evenly spaced entries. ',
' 8=Diagonal: s',
957 $
'mall, evenly spaced.' )
958 9997 format(
' Dense, Non-Symmetric Matrices:', /
' 9=Well-cond., ev',
959 $
'enly spaced eigenvals.',
' 14=Ill-cond., geomet. spaced e',
960 $
'igenals.', /
' 10=Well-cond., geom. spaced eigenvals. ',
961 $
' 15=Ill-conditioned, clustered e.vals.', /
' 11=Well-cond',
962 $
'itioned, clustered e.vals. ',
' 16=Ill-cond., random comp',
963 $
'lex ', /
' 12=Well-cond., random complex ',
' ',
964 $
' 17=Ill-cond., large rand. complx ', /
' 13=Ill-condi',
965 $
'tioned, evenly spaced. ',
' 18=Ill-cond., small rand.',
967 9996 format(
' 19=Matrix with random O(1) entries. ',
' 21=Matrix ',
968 $
'with small random entries.', /
' 20=Matrix with large ran',
969 $
'dom entries. ',
' 22=Matrix read from input file', / )
970 9995 format(
' Tests performed with test threshold =', f8.2,
971 $ / /
' 1 = | A VR - VR W | / ( n |A| ulp ) ',
972 $ /
' 2 = | transpose(A) VL - VL W | / ( n |A| ulp ) ',
973 $ /
' 3 = | |VR(i)| - 1 | / ulp ',
974 $ /
' 4 = | |VL(i)| - 1 | / ulp ',
975 $ /
' 5 = 0 if W same no matter if VR or VL computed,',
976 $
' 1/ulp otherwise', /
977 $
' 6 = 0 if VR same no matter what else computed,',
978 $
' 1/ulp otherwise', /
979 $
' 7 = 0 if VL same no matter what else computed,',
980 $
' 1/ulp otherwise', /
981 $
' 8 = 0 if RCONDV same no matter what else computed,',
982 $
' 1/ulp otherwise', /
983 $
' 9 = 0 if SCALE, ILO, IHI, ABNRM same no matter what else',
984 $
' computed, 1/ulp otherwise',
985 $ /
' 10 = | RCONDV - RCONDV(precomputed) | / cond(RCONDV),',
986 $ /
' 11 = | RCONDE - RCONDE(precomputed) | / cond(RCONDE),' )
987 9994 format(
' BALANC=''', a1,
''',N=', i4,
',IWK=', i1,
', seed=',
988 $ 4( i4,
',' ),
' type ', i2,
', test(', i2,
')=', g10.3 )
989 9993 format(
' N=', i5,
', input example =', i3,
', test(', i2,
')=',
991 9992 format(
' ZDRVVX: ', a,
' returned INFO=', i6,
'.', / 9x,
'N=',
992 $ i6,
', JTYPE=', i6,
', ISEED=(', 3( i5,
',' ), i5,
')' )