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,
562 $ 1, 5, 5, 5, 4, 3, 1 /
563 DATA kconds / 3*0, 5*0, 4*1, 6*2, 3*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' )
627 ulp = dlamch(
'Precision' )
636 DO 150 jsize = 1, nsizes
638 IF( nsizes.NE.1 )
THEN
639 mtypes = min( maxtyp, ntypes )
641 mtypes = min( maxtyp+1, ntypes )
644 DO 140 jtype = 1, mtypes
645 IF( .NOT.dotype( jtype ) )
651 ioldsd( j ) = iseed( j )
670 IF( mtypes.GT.maxtyp )
673 itype = ktype( jtype )
674 imode = kmode( jtype )
678 GO TO ( 30, 40, 50 )kmagn( jtype )
694 CALL zlaset(
'Full', lda, n, czero, czero, a, lda )
702 IF( itype.EQ.1 )
THEN
705 ELSE IF( itype.EQ.2 )
THEN
710 a( jcol, jcol ) = anorm
713 ELSE IF( itype.EQ.3 )
THEN
718 a( jcol, jcol ) = anorm
720 $ a( jcol, jcol-1 ) = one
723 ELSE IF( itype.EQ.4 )
THEN
727 CALL zlatms( n, n,
'S', iseed,
'H', rwork, imode, cond,
728 $ anorm, 0, 0,
'N', a, lda, work( n+1 ),
731 ELSE IF( itype.EQ.5 )
THEN
735 CALL zlatms( n, n,
'S', iseed,
'H', rwork, imode, cond,
736 $ anorm, n, n,
'N', a, lda, work( n+1 ),
739 ELSE IF( itype.EQ.6 )
THEN
743 IF( kconds( jtype ).EQ.1 )
THEN
745 ELSE IF( kconds( jtype ).EQ.2 )
THEN
751 CALL zlatme( n,
'D', iseed, work, imode, cond, cone,
752 $
'T',
'T',
'T', rwork, 4, conds, n, n, anorm,
753 $ a, lda, work( 2*n+1 ), iinfo )
755 ELSE IF( itype.EQ.7 )
THEN
759 CALL zlatmr( n, n,
'D', iseed,
'S', work, 6, one, cone,
760 $
'T',
'N', work( n+1 ), 1, one,
761 $ work( 2*n+1 ), 1, one,
'N', idumma, 0, 0,
762 $ zero, anorm,
'NO', a, lda, idumma, iinfo )
764 ELSE IF( itype.EQ.8 )
THEN
768 CALL zlatmr( n, n,
'D', iseed,
'H', work, 6, one, cone,
769 $
'T',
'N', work( n+1 ), 1, one,
770 $ work( 2*n+1 ), 1, one,
'N', idumma, n, n,
771 $ zero, anorm,
'NO', a, lda, idumma, iinfo )
773 ELSE IF( itype.EQ.9 )
THEN
777 CALL zlatmr( n, n,
'D', iseed,
'N', work, 6, one, cone,
778 $
'T',
'N', work( n+1 ), 1, one,
779 $ work( 2*n+1 ), 1, one,
'N', idumma, n, n,
780 $ zero, anorm,
'NO', a, lda, idumma, iinfo )
782 CALL zlaset(
'Full', 2, n, czero, czero, a, lda )
783 CALL zlaset(
'Full', n-3, 1, czero, czero, a( 3, 1 ),
785 CALL zlaset(
'Full', n-3, 2, czero, czero,
787 CALL zlaset(
'Full', 1, n, czero, czero, a( n, 1 ),
791 ELSE IF( itype.EQ.10 )
THEN
795 CALL zlatmr( n, n,
'D', iseed,
'N', work, 6, one, cone,
796 $
'T',
'N', work( n+1 ), 1, one,
797 $ work( 2*n+1 ), 1, one,
'N', idumma, n, 0,
798 $ zero, anorm,
'NO', a, lda, idumma, iinfo )
805 IF( iinfo.NE.0 )
THEN
806 WRITE( nounit, fmt = 9992 )
'Generator', iinfo, n, jtype,
819 ELSE IF( iwk.EQ.2 )
THEN
822 nnwork = 6*n + 2*n**2
824 nnwork = max( nnwork, 1 )
833 CALL zget23( .false., 0, balanc, jtype, thresh,
834 $ ioldsd, nounit, n, a, lda, h, w, w1, vl,
835 $ ldvl, vr, ldvr, lre, ldlre, rcondv,
836 $ rcndv1, rcdvin, rconde, rcnde1, rcdein,
837 $ scale, scale1, result, work, nnwork,
845 IF( result( j ).GE.zero )
847 IF( result( j ).GE.thresh )
852 $ ntestf = ntestf + 1
853 IF( ntestf.EQ.1 )
THEN
854 WRITE( nounit, fmt = 9999 )path
855 WRITE( nounit, fmt = 9998 )
856 WRITE( nounit, fmt = 9997 )
857 WRITE( nounit, fmt = 9996 )
858 WRITE( nounit, fmt = 9995 )thresh
863 IF( result( j ).GE.thresh )
THEN
864 WRITE( nounit, fmt = 9994 )balanc, n, iwk,
865 $ ioldsd, jtype, j, result( j )
869 nerrs = nerrs + nfail
870 ntestt = ntestt + ntest
885 READ( niunit, fmt = *,
END = 220 )N, isrt
894 READ( niunit, fmt = * )( a( i, j ), j = 1, n )
897 READ( niunit, fmt = * )wr, wi, rcdein( i ), rcdvin( i )
898 w1( i ) = dcmplx( wr, wi )
900 CALL zget23( .true., isrt,
'N', 22, thresh, iseed, nounit, n, a,
901 $ lda, h, w, w1, vl, ldvl, vr, ldvr, lre, ldlre,
902 $ rcondv, rcndv1, rcdvin, rconde, rcnde1, rcdein,
903 $ scale, scale1, result, work, 6*n+2*n**2, rwork,
911 IF( result( j ).GE.zero )
913 IF( result( j ).GE.thresh )
918 $ ntestf = ntestf + 1
919 IF( ntestf.EQ.1 )
THEN
920 WRITE( nounit, fmt = 9999 )path
921 WRITE( nounit, fmt = 9998 )
922 WRITE( nounit, fmt = 9997 )
923 WRITE( nounit, fmt = 9996 )
924 WRITE( nounit, fmt = 9995 )thresh
929 IF( result( j ).GE.thresh )
THEN
930 WRITE( nounit, fmt = 9993 )n, jtype, j, result( j )
934 nerrs = nerrs + nfail
935 ntestt = ntestt + ntest
941 CALL dlasum( path, nounit, nerrs, ntestt )
943 9999
FORMAT( / 1x, a3,
' -- Complex Eigenvalue-Eigenvector ',
944 $
'Decomposition Expert Driver',
945 $ /
' Matrix types (see ZDRVVX for details): ' )
947 9998
FORMAT( /
' Special Matrices:', /
' 1=Zero matrix. ',
948 $
' ',
' 5=Diagonal: geometr. spaced entries.',
949 $ /
' 2=Identity matrix. ',
' 6=Diagona',
950 $
'l: clustered entries.', /
' 3=Transposed Jordan block. ',
951 $
' ',
' 7=Diagonal: large, evenly spaced.', /
' ',
952 $
'4=Diagonal: evenly spaced entries. ',
' 8=Diagonal: s',
953 $
'mall, evenly spaced.' )
954 9997
FORMAT(
' Dense, Non-Symmetric Matrices:', /
' 9=Well-cond., ev',
955 $
'enly spaced eigenvals.',
' 14=Ill-cond., geomet. spaced e',
956 $
'igenals.', /
' 10=Well-cond., geom. spaced eigenvals. ',
957 $
' 15=Ill-conditioned, clustered e.vals.', /
' 11=Well-cond',
958 $
'itioned, clustered e.vals. ',
' 16=Ill-cond., random comp',
959 $
'lex ', /
' 12=Well-cond., random complex ',
' ',
960 $
' 17=Ill-cond., large rand. complx ', /
' 13=Ill-condi',
961 $
'tioned, evenly spaced. ',
' 18=Ill-cond., small rand.',
963 9996
FORMAT(
' 19=Matrix with random O(1) entries. ',
' 21=Matrix ',
964 $
'with small random entries.', /
' 20=Matrix with large ran',
965 $
'dom entries. ',
' 22=Matrix read from input file', / )
966 9995
FORMAT(
' Tests performed with test threshold =', f8.2,
967 $ / /
' 1 = | A VR - VR W | / ( n |A| ulp ) ',
968 $ /
' 2 = | transpose(A) VL - VL W | / ( n |A| ulp ) ',
969 $ /
' 3 = | |VR(i)| - 1 | / ulp ',
970 $ /
' 4 = | |VL(i)| - 1 | / ulp ',
971 $ /
' 5 = 0 if W same no matter if VR or VL computed,',
972 $
' 1/ulp otherwise', /
973 $
' 6 = 0 if VR same no matter what else computed,',
974 $
' 1/ulp otherwise', /
975 $
' 7 = 0 if VL same no matter what else computed,',
976 $
' 1/ulp otherwise', /
977 $
' 8 = 0 if RCONDV same no matter what else computed,',
978 $
' 1/ulp otherwise', /
979 $
' 9 = 0 if SCALE, ILO, IHI, ABNRM same no matter what else',
980 $
' computed, 1/ulp otherwise',
981 $ /
' 10 = | RCONDV - RCONDV(precomputed) | / cond(RCONDV),',
982 $ /
' 11 = | RCONDE - RCONDE(precomputed) | / cond(RCONDE),' )
983 9994
FORMAT(
' BALANC=''', a1,
''',N=', i4,
',IWK=', i1,
', seed=',
984 $ 4( i4,
',' ),
' type ', i2,
', test(', i2,
')=', g10.3 )
985 9993
FORMAT(
' N=', i5,
', input example =', i3,
', test(', i2,
')=',
987 9992
FORMAT(
' ZDRVVX: ', a,
' returned INFO=', i6,
'.', / 9x,
'N=',
988 $ i6,
', JTYPE=', i6,
', ISEED=(', 3( i5,
',' ), i5,
')' )
subroutine xerbla(srname, info)
subroutine dlasum(type, iounit, ie, nrun)
DLASUM
subroutine zlaset(uplo, m, n, alpha, beta, a, lda)
ZLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values.
subroutine zdrvvx(nsizes, nn, ntypes, dotype, iseed, thresh, niunit, nounit, a, lda, h, w, w1, vl, ldvl, vr, ldvr, lre, ldlre, rcondv, rcndv1, rcdvin, rconde, rcnde1, rcdein, scale, scale1, result, work, nwork, rwork, info)
ZDRVVX
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
subroutine zlatme(n, dist, iseed, d, mode, cond, dmax, rsign, upper, sim, ds, modes, conds, kl, ku, anorm, a, lda, work, info)
ZLATME
subroutine zlatmr(m, n, dist, iseed, sym, d, mode, cond, dmax, rsign, grade, dl, model, condl, dr, moder, condr, pivtng, ipivot, kl, ku, sparse, anorm, pack, a, lda, iwork, info)
ZLATMR
subroutine zlatms(m, n, dist, iseed, sym, d, mode, cond, dmax, kl, ku, pack, a, lda, work, info)
ZLATMS