387 SUBROUTINE zdrvev( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH,
388 $ NOUNIT, A, LDA, H, W, W1, VL, LDVL, VR, LDVR,
389 $ LRE, LDLRE, RESULT, WORK, NWORK, RWORK, IWORK,
397 INTEGER INFO, LDA, LDLRE, LDVL, LDVR, NOUNIT, NSIZES,
399 DOUBLE PRECISION THRESH
403 INTEGER ISEED( 4 ), IWORK( * ), NN( * )
404 DOUBLE PRECISION RESULT( 7 ), RWORK( * )
405 COMPLEX*16 A( LDA, * ), H( LDA, * ), LRE( LDLRE, * ),
406 $ vl( ldvl, * ), vr( ldvr, * ), w( * ), w1( * ),
414 PARAMETER ( CZERO = ( 0.0d+0, 0.0d+0 ) )
416 parameter( cone = ( 1.0d+0, 0.0d+0 ) )
417 DOUBLE PRECISION ZERO, ONE
418 parameter( zero = 0.0d+0, one = 1.0d+0 )
420 parameter( two = 2.0d+0 )
422 parameter( maxtyp = 21 )
427 INTEGER IINFO, IMODE, ITYPE, IWK, J, JCOL, JJ, JSIZE,
428 $ jtype, mtypes, n, nerrs, nfail, nmax, nnwork,
429 $ ntest, ntestf, ntestt
430 DOUBLE PRECISION ANORM, COND, CONDS, OVFL, RTULP, RTULPI, TNRM,
431 $ ULP, ULPINV, UNFL, VMX, VRMX, VTST
434 INTEGER IDUMMA( 1 ), IOLDSD( 4 ), KCONDS( MAXTYP ),
435 $ KMAGN( MAXTYP ), KMODE( MAXTYP ),
437 DOUBLE PRECISION RES( 2 )
441 DOUBLE PRECISION DLAMCH, DZNRM2
442 EXTERNAL DLAMCH, DZNRM2
449 INTRINSIC abs, dble, dcmplx, dimag,
max,
min, sqrt
452 DATA ktype / 1, 2, 3, 5*4, 4*6, 6*6, 3*9 /
453 DATA kmagn / 3*1, 1, 1, 1, 2, 3, 4*1, 1, 1, 1, 1, 2,
456 $ 1, 5, 5, 5, 4, 3, 1 /
457 DATA kconds / 3*0, 5*0, 4*1, 6*2, 3*0 /
461 path( 1: 1 ) =
'Zomplex precision'
475 nmax =
max( nmax, nn( j ) )
482 IF( nsizes.LT.0 )
THEN
484 ELSE IF( badnn )
THEN
486 ELSE IF( ntypes.LT.0 )
THEN
488 ELSE IF( thresh.LT.zero )
THEN
490 ELSE IF( nounit.LE.0 )
THEN
492 ELSE IF( lda.LT.1 .OR. lda.LT.nmax )
THEN
494 ELSE IF( ldvl.LT.1 .OR. ldvl.LT.nmax )
THEN
496 ELSE IF( ldvr.LT.1 .OR. ldvr.LT.nmax )
THEN
498 ELSE IF( ldlre.LT.1 .OR. ldlre.LT.nmax )
THEN
500 ELSE IF( 5*nmax+2*nmax**2.GT.nwork )
THEN
505 CALL xerbla(
'ZDRVEV', -info )
511 IF( nsizes.EQ.0 .OR. ntypes.EQ.0 )
516 unfl = dlamch(
'Safe minimum' )
519 ulp = dlamch( 'precision
' )
528 DO 270 JSIZE = 1, NSIZES
530.NE.
IF( NSIZES1 ) THEN
531 MTYPES = MIN( MAXTYP, NTYPES )
533 MTYPES = MIN( MAXTYP+1, NTYPES )
536 DO 260 JTYPE = 1, MTYPES
537.NOT.
IF( DOTYPE( JTYPE ) )
543 IOLDSD( J ) = ISEED( J )
562.GT.
IF( MTYPESMAXTYP )
565 ITYPE = KTYPE( JTYPE )
566 IMODE = KMODE( JTYPE )
570 GO TO ( 30, 40, 50 )KMAGN( JTYPE )
586 CALL ZLASET( 'full
', LDA, N, CZERO, CZERO, A, LDA )
594.EQ.
IF( ITYPE1 ) THEN
597.EQ.
ELSE IF( ITYPE2 ) THEN
602 A( JCOL, JCOL ) = DCMPLX( ANORM )
605.EQ.
ELSE IF( ITYPE3 ) THEN
610 A( JCOL, JCOL ) = DCMPLX( ANORM )
612 $ A( JCOL, JCOL-1 ) = CONE
615.EQ.
ELSE IF( ITYPE4 ) THEN
619 CALL ZLATMS( N, N, 's', iseed,
'H', rwork, imode, cond,
620 $ anorm, 0, 0,
'N', a, lda, work( n+1 ),
623 ELSE IF( itype.EQ.5 )
THEN
627 CALL zlatms( n, n,
'S', iseed,
'H', rwork, imode, cond,
628 $ anorm, n, n,
'N', a, lda, work( n+1 ),
631 ELSE IF( itype.EQ.6 )
THEN
635 IF( kconds( jtype ).EQ.1 )
THEN
637 ELSE IF( kconds( jtype ).EQ.2 )
THEN
643 CALL zlatme( n,
'D', iseed, work, imode, cond, cone,
644 $
'T',
'T',
'T', rwork, 4, conds, n, n, anorm,
645 $ a, lda, work( 2*n+1 ), iinfo )
647 ELSE IF( itype.EQ.7 )
THEN
651 CALL zlatmr( n, n,
'D', iseed,
'N', work, 6, one, cone,
652 $
'T',
'N', work( n+1 ), 1, one,
653 $ work( 2*n+1 ), 1, one,
'N', idumma, 0, 0,
654 $ zero, anorm,
'NO', a, lda, iwork, iinfo )
656 ELSE IF( itype.EQ.8 )
THEN
660 CALL zlatmr( n, n,
'D', iseed,
'H', work, 6, one, cone,
661 $
'T',
'N', work( n+1 ), 1, one,
662 $ work( 2*n+1 ), 1, one,
'N', idumma, n, n,
663 $ zero, anorm,
'NO', a, lda, iwork, iinfo )
665 ELSE IF( itype.EQ.9 )
THEN
669 CALL zlatmr( n, n,
'D', iseed,
'N', work, 6, one, cone,
670 $
'T',
'N', work( n+1 ), 1, one,
671 $ work( 2*n+1 ), 1, one,
'N', idumma, n, n,
672 $ zero, anorm, 'no
', A, LDA, IWORK, IINFO )
674 CALL ZLASET( 'full
', 2, N, CZERO, CZERO, A, LDA )
675 CALL ZLASET( 'full
', N-3, 1, CZERO, CZERO, A( 3, 1 ),
677 CALL ZLASET( 'full
', N-3, 2, CZERO, CZERO,
679 CALL ZLASET( 'full
', 1, N, CZERO, CZERO, A( N, 1 ),
683.EQ.
ELSE IF( ITYPE10 ) THEN
687 CALL ZLATMR( N, N, 'd
', ISEED, 'n
', WORK, 6, ONE, CONE,
688 $ 't
', 'n
', WORK( N+1 ), 1, ONE,
689 $ WORK( 2*N+1 ), 1, ONE, 'n
', IDUMMA, N, 0,
690 $ ZERO, ANORM, 'no
', A, LDA, IWORK, IINFO )
697.NE.
IF( IINFO0 ) THEN
698 WRITE( NOUNIT, FMT = 9993 )'generator
', IINFO, N, JTYPE,
712 NNWORK = 5*N + 2*N**2
714 NNWORK = MAX( NNWORK, 1 )
724 CALL ZLACPY( 'f
', N, N, A, LDA, H, LDA )
725 CALL ZGEEV( 'v
', 'v
', N, H, LDA, W, VL, LDVL, VR, LDVR,
726 $ WORK, NNWORK, RWORK, IINFO )
727.NE.
IF( IINFO0 ) THEN
729 WRITE( NOUNIT, FMT = 9993 )'zgeev1
', IINFO, N, JTYPE,
737 CALL ZGET22( 'n
', 'n
', 'n
', N, A, LDA, VR, LDVR, W, WORK,
739 RESULT( 1 ) = RES( 1 )
743 CALL ZGET22( 'c
', 'n',
'C', n, a, lda, vl, ldvl, w, work,
745 result( 2 ) = res( 1 )
750 tnrm = dznrm2( n, vr( 1, j ), 1 )
751 result( 3 ) =
max( result( 3 ),
752 $
min( ulpinv, abs( tnrm-one ) / ulp ) )
756 vtst = abs( vr( jj, j ) )
759 IF( dimag( vr( jj, j ) ).EQ.zero .AND.
760 $ abs( dble( vr( jj, j ) ) ).GT.vrmx )
761 $ vrmx = abs( dble( vr( jj, j ) ) )
763 IF( vrmx / vmx.LT.one-two*ulp )
764 $ result( 3 ) = ulpinv
770 tnrm = dznrm2( n, vl( 1, j ), 1 )
771 result( 4 ) =
max( result( 4 ),
772 $
min( ulpinv, abs( tnrm-one ) / ulp ) )
776 vtst = abs( vl( jj, j ) )
779 IF( dimag( vl( jj, j ) ).EQ.zero .AND.
780 $ abs( dble( vl( jj, j ) ) ).GT.vrmx )
781 $ vrmx = abs( dble( vl( jj, j ) ) )
783 IF( vrmx / vmx.LT.one-two*ulp )
784 $ result( 4 ) = ulpinv
789 CALL zlacpy(
'F', n, n, a, lda, h, lda )
790 CALL zgeev(
'N',
'N', n, h, lda, w1, dum, 1, dum, 1,
791 $ work, nnwork, rwork, iinfo )
792 IF( iinfo.NE.0 )
THEN
794 WRITE( nounit, fmt = 9993 )
'ZGEEV2', iinfo, n, jtype,
803 IF( w( j ).NE.w1( j ) )
804 $ result( 5 ) = ulpinv
809 CALL zlacpy(
'F', n, n, a, lda, h, lda )
810 CALL zgeev(
'N',
'V', n, h, lda, w1, dum, 1, lre, ldlre,
811 $ work, nnwork, rwork, iinfo )
812 IF( iinfo.NE.0 )
THEN
814 WRITE( nounit, fmt = 9993 )
'ZGEEV3', iinfo, n, jtype,
823 IF( w( j ).NE.w1( j ) )
824 $ result( 5 ) = ulpinv
831 IF( vr( j, jj ).NE.lre( j, jj ) )
832 $ result( 6 ) = ulpinv
838 CALL zlacpy(
'F', n, n, a, lda, h, lda )
839 CALL zgeev(
'V',
'N', n, h, lda, w1, lre, ldlre, dum, 1,
840 $ work, nnwork, rwork, iinfo )
841 IF( iinfo.NE.0 )
THEN
843 WRITE( nounit, fmt = 9993 )
'ZGEEV4', iinfo, n, jtype,
852 IF( w( j ).NE.w1( j ) )
853 $ result( 5 ) = ulpinv
860 IF( vl( j, jj ).NE.lre( j, jj ) )
861 $ result( 7 ) = ulpinv
872 IF( result( j ).GE.zero )
874 IF( result( j ).GE.thresh )
879 $ ntestf = ntestf + 1
880 IF( ntestf.EQ.1 )
THEN
881 WRITE( nounit, fmt = 9999 )path
882 WRITE( nounit, fmt = 9998 )
883 WRITE( nounit, fmt = 9997 )
884 WRITE( nounit, fmt = 9996 )
885 WRITE( nounit, fmt = 9995 )thresh
890 IF( result( j ).GE.thresh )
THEN
891 WRITE( nounit, fmt = 9994 )n, iwk, ioldsd, jtype,
896 nerrs = nerrs + nfail
897 ntestt = ntestt + ntest
905 CALL dlasum( path, nounit, nerrs, ntestt )
907 9999
FORMAT( / 1x, a3,
' -- Complex Eigenvalue-Eigenvector ',
908 $
'Decomposition Driver', /
909 $
' Matrix types (see ZDRVEV for details): ' )
911 9998
FORMAT( /
' Special Matrices:', /
' 1=Zero matrix. ',
912 $
' ',
' 5=Diagonal: geometr. spaced entries.',
913 $ /
' 2=Identity matrix. ',
' 6=Diagona',
914 $
'l: clustered entries.', /
' 3=Transposed Jordan block. ',
915 $
' ',
' 7=Diagonal: large, evenly spaced.', /
' ',
916 $
'4=Diagonal: evenly spaced entries. ',
' 8=Diagonal: s',
917 $
'mall, evenly spaced.' )
918 9997
FORMAT(
' Dense, Non-Symmetric Matrices:', /
' 9=Well-cond., ev',
919 $
'enly spaced eigenvals.',
' 14=Ill-cond., geomet. spaced e',
920 $
'igenals.', /
' 10=Well-cond., geom. spaced eigenvals. ',
921 $
' 15=Ill-conditioned, clustered e.vals.', / ' 11=well-cond
',
922 $ 'itioned, clustered e.vals.
', ' 16=ill-cond., random
comp',
923 $ 'lex ', a6, /
' 12=Well-cond., random complex ', a6,
' ',
924 $
' 17=Ill-cond., large rand. complx ', a4, /
' 13=Ill-condi',
925 $
'tioned, evenly spaced. ',
' 18=Ill-cond., small rand.',
927 9996
FORMAT(
' 19=Matrix with random O(1) entries. ',
' 21=Matrix ',
928 $
'with small random entries.', /
' 20=Matrix with large ran',
929 $
'dom entries. ', / )
930 9995
FORMAT(
' Tests performed with test threshold =', f8.2,
931 $ / /
' 1 = | A VR - VR W | / ( n |A| ulp ) ',
932 $ /
' 2 = | conj-trans(A) VL - VL conj-trans(W) | /',
933 $
' ( n |A| ulp ) ', /
' 3 = | |VR(i)| - 1 | / ulp ',
934 $ /
' 4 = | |VL(i)| - 1 | / ulp ',
935 $ /
' 5 = 0 if W same no matter if VR or VL computed,',
936 $
' 1/ulp otherwise', /
937 $
' 6 = 0 if VR same no matter if VL computed,',
938 $
' 1/ulp otherwise', /
939 $
' 7 = 0 if VL same no matter if VR computed,',
940 $
' 1/ulp otherwise', / )
941 9994
FORMAT(
' N=', i5,
', IWK=', i2,
', seed=', 4( i4,
',' ),
942 $
' type ', i2,
', test(', i2,
')=', g10.3 )
943 9993
FORMAT(
' ZDRVEV: ', a,
' returned INFO=', i6,
'.', / 9x,
'N=',
944 $ i6,
', JTYPE=', i6,
', ISEED=(', 3( i5, ',
' ), I5, ')
' )