389 SUBROUTINE zdrvev( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH,
390 $ nounit, a, lda, h, w, w1, vl, ldvl, vr, ldvr,
391 $ lre, ldlre, result, work, nwork, rwork, iwork,
400 INTEGER info, lda, ldlre, ldvl, ldvr, nounit, nsizes,
402 DOUBLE PRECISION thresh
406 INTEGER iseed( 4 ), iwork( * ), nn( * )
407 DOUBLE PRECISION result( 7 ), rwork( * )
408 COMPLEX*16 a( lda, * ), h( lda, * ), lre( ldlre, * ),
409 $ vl( ldvl, * ), vr( ldvr, * ), w( * ), w1( * ),
417 parameter( czero = ( 0.0d+0, 0.0d+0 ) )
419 parameter( cone = ( 1.0d+0, 0.0d+0 ) )
420 DOUBLE PRECISION zero, one
421 parameter( zero = 0.0d+0, one = 1.0d+0 )
423 parameter( two = 2.0d+0 )
425 parameter( maxtyp = 21 )
430 INTEGER iinfo, imode, itype, iwk, j, jcol, jj, jsize,
431 $ jtype, mtypes, n, nerrs, nfail, nmax, nnwork,
432 $ ntest, ntestf, ntestt
433 DOUBLE PRECISION anorm, cond, conds, ovfl, rtulp, rtulpi, tnrm,
434 $ ulp, ulpinv, unfl, vmx, vrmx, vtst
437 INTEGER idumma( 1 ), ioldsd( 4 ), kconds( maxtyp ),
438 $ kmagn( maxtyp ), kmode( maxtyp ),
440 DOUBLE PRECISION res( 2 )
452 INTRINSIC abs, dble, dcmplx, dimag, max, min, sqrt
455 DATA ktype / 1, 2, 3, 5*4, 4*6, 6*6, 3*9 /
456 DATA kmagn / 3*1, 1, 1, 1, 2, 3, 4*1, 1, 1, 1, 1, 2,
458 DATA kmode / 3*0, 4, 3, 1, 4, 4, 4, 3, 1, 5, 4, 3,
459 $ 1, 5, 5, 5, 4, 3, 1 /
460 DATA kconds / 3*0, 5*0, 4*1, 6*2, 3*0 /
464 path( 1: 1 ) =
'Zomplex precision'
478 nmax = max( nmax, nn( j ) )
485 IF( nsizes.LT.0 )
THEN
487 ELSE IF( badnn )
THEN
489 ELSE IF( ntypes.LT.0 )
THEN
491 ELSE IF( thresh.LT.zero )
THEN
493 ELSE IF( nounit.LE.0 )
THEN
495 ELSE IF( lda.LT.1 .OR. lda.LT.nmax )
THEN
497 ELSE IF( ldvl.LT.1 .OR. ldvl.LT.nmax )
THEN
499 ELSE IF( ldvr.LT.1 .OR. ldvr.LT.nmax )
THEN
501 ELSE IF( ldlre.LT.1 .OR. ldlre.LT.nmax )
THEN
503 ELSE IF( 5*nmax+2*nmax**2.GT.nwork )
THEN
508 CALL
xerbla(
'ZDRVEV', -info )
514 IF( nsizes.EQ.0 .OR. ntypes.EQ.0 )
519 unfl =
dlamch(
'Safe minimum' )
522 ulp =
dlamch(
'Precision' )
531 DO 270 jsize = 1, nsizes
533 IF( nsizes.NE.1 )
THEN
534 mtypes = min( maxtyp, ntypes )
536 mtypes = min( maxtyp+1, ntypes )
539 DO 260 jtype = 1, mtypes
540 IF( .NOT.dotype( jtype ) )
546 ioldsd( j ) = iseed( j )
565 IF( mtypes.GT.maxtyp )
568 itype = ktype( jtype )
569 imode = kmode( jtype )
573 go to( 30, 40, 50 )kmagn( jtype )
589 CALL
zlaset(
'Full', lda, n, czero, czero, a, lda )
597 IF( itype.EQ.1 )
THEN
600 ELSE IF( itype.EQ.2 )
THEN
605 a( jcol, jcol ) = dcmplx( anorm )
608 ELSE IF( itype.EQ.3 )
THEN
613 a( jcol, jcol ) = dcmplx( anorm )
615 $ a( jcol, jcol-1 ) = cone
618 ELSE IF( itype.EQ.4 )
THEN
622 CALL
zlatms( n, n,
'S', iseed,
'H', rwork, imode, cond,
623 $ anorm, 0, 0,
'N', a, lda, work( n+1 ),
626 ELSE IF( itype.EQ.5 )
THEN
630 CALL
zlatms( n, n,
'S', iseed,
'H', rwork, imode, cond,
631 $ anorm, n, n,
'N', a, lda, work( n+1 ),
634 ELSE IF( itype.EQ.6 )
THEN
638 IF( kconds( jtype ).EQ.1 )
THEN
640 ELSE IF( kconds( jtype ).EQ.2 )
THEN
646 CALL
zlatme( n,
'D', iseed, work, imode, cond, cone,
647 $
'T',
'T',
'T', rwork, 4, conds, n, n, anorm,
648 $ a, lda, work( 2*n+1 ), iinfo )
650 ELSE IF( itype.EQ.7 )
THEN
654 CALL
zlatmr( n, n,
'D', iseed,
'N', work, 6, one, cone,
655 $
'T',
'N', work( n+1 ), 1, one,
656 $ work( 2*n+1 ), 1, one,
'N', idumma, 0, 0,
657 $ zero, anorm,
'NO', a, lda, iwork, iinfo )
659 ELSE IF( itype.EQ.8 )
THEN
663 CALL
zlatmr( n, n,
'D', iseed,
'H', work, 6, one, cone,
664 $
'T',
'N', work( n+1 ), 1, one,
665 $ work( 2*n+1 ), 1, one,
'N', idumma, n, n,
666 $ zero, anorm,
'NO', a, lda, iwork, iinfo )
668 ELSE IF( itype.EQ.9 )
THEN
672 CALL
zlatmr( n, n,
'D', iseed,
'N', work, 6, one, cone,
673 $
'T',
'N', work( n+1 ), 1, one,
674 $ work( 2*n+1 ), 1, one,
'N', idumma, n, n,
675 $ zero, anorm,
'NO', a, lda, iwork, iinfo )
677 CALL
zlaset(
'Full', 2, n, czero, czero, a, lda )
678 CALL
zlaset(
'Full', n-3, 1, czero, czero, a( 3, 1 ),
680 CALL
zlaset(
'Full', n-3, 2, czero, czero,
682 CALL
zlaset(
'Full', 1, n, czero, czero, a( n, 1 ),
686 ELSE IF( itype.EQ.10 )
THEN
690 CALL
zlatmr( n, n,
'D', iseed,
'N', work, 6, one, cone,
691 $
'T',
'N', work( n+1 ), 1, one,
692 $ work( 2*n+1 ), 1, one,
'N', idumma, n, 0,
693 $ zero, anorm,
'NO', a, lda, iwork, iinfo )
700 IF( iinfo.NE.0 )
THEN
701 WRITE( nounit, fmt = 9993 )
'Generator', iinfo, n, jtype,
715 nnwork = 5*n + 2*n**2
717 nnwork = max( nnwork, 1 )
727 CALL
zlacpy(
'F', n, n, a, lda, h, lda )
728 CALL
zgeev(
'V',
'V', n, h, lda, w, vl, ldvl, vr, ldvr,
729 $ work, nnwork, rwork, iinfo )
730 IF( iinfo.NE.0 )
THEN
732 WRITE( nounit, fmt = 9993 )
'ZGEEV1', iinfo, n, jtype,
740 CALL
zget22(
'N',
'N',
'N', n, a, lda, vr, ldvr, w, work,
742 result( 1 ) = res( 1 )
746 CALL
zget22(
'C',
'N',
'C', n, a, lda, vl, ldvl, w, work,
748 result( 2 ) = res( 1 )
753 tnrm =
dznrm2( n, vr( 1, j ), 1 )
754 result( 3 ) = max( result( 3 ),
755 $ min( ulpinv, abs( tnrm-one ) / ulp ) )
759 vtst = abs( vr( jj, j ) )
762 IF( dimag( vr( jj, j ) ).EQ.zero .AND.
763 $ abs( dble( vr( jj, j ) ) ).GT.vrmx )
764 $ vrmx = abs( dble( vr( jj, j ) ) )
766 IF( vrmx / vmx.LT.one-two*ulp )
767 $ result( 3 ) = ulpinv
773 tnrm =
dznrm2( n, vl( 1, j ), 1 )
774 result( 4 ) = max( result( 4 ),
775 $ min( ulpinv, abs( tnrm-one ) / ulp ) )
779 vtst = abs( vl( jj, j ) )
782 IF( dimag( vl( jj, j ) ).EQ.zero .AND.
783 $ abs( dble( vl( jj, j ) ) ).GT.vrmx )
784 $ vrmx = abs( dble( vl( jj, j ) ) )
786 IF( vrmx / vmx.LT.one-two*ulp )
787 $ result( 4 ) = ulpinv
792 CALL
zlacpy(
'F', n, n, a, lda, h, lda )
793 CALL
zgeev(
'N',
'N', n, h, lda, w1, dum, 1, dum, 1,
794 $ work, nnwork, rwork, iinfo )
795 IF( iinfo.NE.0 )
THEN
797 WRITE( nounit, fmt = 9993 )
'ZGEEV2', iinfo, n, jtype,
806 IF( w( j ).NE.w1( j ) )
807 $ result( 5 ) = ulpinv
812 CALL
zlacpy(
'F', n, n, a, lda, h, lda )
813 CALL
zgeev(
'N',
'V', n, h, lda, w1, dum, 1, lre, ldlre,
814 $ work, nnwork, rwork, iinfo )
815 IF( iinfo.NE.0 )
THEN
817 WRITE( nounit, fmt = 9993 )
'ZGEEV3', iinfo, n, jtype,
826 IF( w( j ).NE.w1( j ) )
827 $ result( 5 ) = ulpinv
834 IF( vr( j, jj ).NE.lre( j, jj ) )
835 $ result( 6 ) = ulpinv
841 CALL
zlacpy(
'F', n, n, a, lda, h, lda )
842 CALL
zgeev(
'V',
'N', n, h, lda, w1, lre, ldlre, dum, 1,
843 $ work, nnwork, rwork, iinfo )
844 IF( iinfo.NE.0 )
THEN
846 WRITE( nounit, fmt = 9993 )
'ZGEEV4', iinfo, n, jtype,
855 IF( w( j ).NE.w1( j ) )
856 $ result( 5 ) = ulpinv
863 IF( vl( j, jj ).NE.lre( j, jj ) )
864 $ result( 7 ) = ulpinv
875 IF( result( j ).GE.zero )
877 IF( result( j ).GE.thresh )
882 $ ntestf = ntestf + 1
883 IF( ntestf.EQ.1 )
THEN
884 WRITE( nounit, fmt = 9999 )path
885 WRITE( nounit, fmt = 9998 )
886 WRITE( nounit, fmt = 9997 )
887 WRITE( nounit, fmt = 9996 )
888 WRITE( nounit, fmt = 9995 )thresh
893 IF( result( j ).GE.thresh )
THEN
894 WRITE( nounit, fmt = 9994 )n, iwk, ioldsd, jtype,
899 nerrs = nerrs + nfail
900 ntestt = ntestt + ntest
908 CALL
dlasum( path, nounit, nerrs, ntestt )
910 9999 format( / 1x, a3,
' -- Complex Eigenvalue-Eigenvector ',
911 $
'Decomposition Driver', /
912 $
' Matrix types (see ZDRVEV for details): ' )
914 9998 format( /
' Special Matrices:', /
' 1=Zero matrix. ',
915 $
' ',
' 5=Diagonal: geometr. spaced entries.',
916 $ /
' 2=Identity matrix. ',
' 6=Diagona',
917 $
'l: clustered entries.', /
' 3=Transposed Jordan block. ',
918 $
' ',
' 7=Diagonal: large, evenly spaced.', /
' ',
919 $
'4=Diagonal: evenly spaced entries. ',
' 8=Diagonal: s',
920 $
'mall, evenly spaced.' )
921 9997 format(
' Dense, Non-Symmetric Matrices:', /
' 9=Well-cond., ev',
922 $
'enly spaced eigenvals.',
' 14=Ill-cond., geomet. spaced e',
923 $
'igenals.', /
' 10=Well-cond., geom. spaced eigenvals. ',
924 $
' 15=Ill-conditioned, clustered e.vals.', /
' 11=Well-cond',
925 $
'itioned, clustered e.vals. ',
' 16=Ill-cond., random comp',
926 $
'lex ', a6, /
' 12=Well-cond., random complex ', a6,
' ',
927 $
' 17=Ill-cond., large rand. complx ', a4, /
' 13=Ill-condi',
928 $
'tioned, evenly spaced. ',
' 18=Ill-cond., small rand.',
930 9996 format(
' 19=Matrix with random O(1) entries. ',
' 21=Matrix ',
931 $
'with small random entries.', /
' 20=Matrix with large ran',
932 $
'dom entries. ', / )
933 9995 format(
' Tests performed with test threshold =', f8.2,
934 $ / /
' 1 = | A VR - VR W | / ( n |A| ulp ) ',
935 $ /
' 2 = | conj-trans(A) VL - VL conj-trans(W) | /',
936 $
' ( n |A| ulp ) ', /
' 3 = | |VR(i)| - 1 | / ulp ',
937 $ /
' 4 = | |VL(i)| - 1 | / ulp ',
938 $ /
' 5 = 0 if W same no matter if VR or VL computed,',
939 $
' 1/ulp otherwise', /
940 $
' 6 = 0 if VR same no matter if VL computed,',
941 $
' 1/ulp otherwise', /
942 $
' 7 = 0 if VL same no matter if VR computed,',
943 $
' 1/ulp otherwise', / )
944 9994 format(
' N=', i5,
', IWK=', i2,
', seed=', 4( i4,
',' ),
945 $
' type ', i2,
', test(', i2,
')=', g10.3 )
946 9993 format(
' ZDRVEV: ', a,
' returned INFO=', i6,
'.', / 9x,
'N=',
947 $ i6,
', JTYPE=', i6,
', ISEED=(', 3( i5,
',' ), i5,
')' )