387 SUBROUTINE cdrvev( 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, , LDLRE, LDVL, LDVR, NOUNIT, NSIZES,
403 INTEGER ISEED( 4 ), IWORK( * ), NN( * )
404 REAL RESULT( 7 ), RWORK( * )
405 COMPLEX A( LDA, * ), ( LDA, * ), LRE( LDLRE, * ),
406 $ vl( ldvl, * ), vr( ldvr, * ), w( * ), w1( * ),
414 PARAMETER ( CZERO = ( 0.0e+0, 0.0e+0 ) )
416 parameter( cone = ( 1.0e+0, 0.0e+0 ) )
418 parameter( zero = 0.0e+0, one = 1.0e+0 )
420 parameter( two = 2.0e+0 )
422 parameter( maxtyp = 21 )
427 INTEGER IINFO, IMODE, ITYPE, IWK, J, JCOL, JJ, JSIZE,
428 $ jtype, mtypes, n, nerrs, nfail, nmax,
429 $ nnwork, ntest, ntestf, ntestt
430 REAL ANORM, COND, CONDS, OVFL, , RTULPI, TNRM,
431 $ ULP, ULPINV, UNFL, VMX, VRMX, VTST
434 INTEGER IDUMMA( 1 ), IOLDSD( 4 ), KCONDS( MAXTYP ),
435 $ KMAGN( MAXTYP ), KMODE( MAXTYP ),
442 EXTERNAL SCNRM2, SLAMCH
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,
455 DATA kmode / 3*0, 4, 3, 1, 4, 4, 4, 3, 1, 5, 4, 3,
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 ) =
'Complex 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(
'CDRVEV', -info )
511 IF( nsizes.EQ.0 .OR. ntypes.EQ.0 )
516 unfl = slamch(
'Safe minimum' )
519 ulp = slamch(
'Precision' )
528 DO 270 jsize = 1, nsizes
530 IF( nsizes.NE.1 )
THEN
531 mtypes =
min( maxtyp, ntypes )
533 mtypes =
min( maxtyp+1, ntypes )
536 DO 260 jtype = 1, mtypes
537 IF( .NOT.dotype( jtype ) )
543 ioldsd( j ) = iseed( j )
562 IF( mtypes.GT.maxtyp )
565 itype = ktype( jtype )
566 imode = kmode( jtype )
570 GO TO ( 30, 40, 50 )kmagn( jtype )
586 CALL claset(
'Full', lda, n, czero, czero, a, lda )
594 IF( itype.EQ.1 )
THEN
597 ELSE IF( itype.EQ.2 )
THEN
602 a( jcol, jcol ) =
cmplx( anorm )
605 ELSE IF( itype.EQ.3 )
THEN
610 a( jcol, jcol ) =
cmplx( anorm )
612 $ a( jcol, jcol-1 ) = cone
615 ELSE IF( itype.EQ.4 )
THEN
619 CALL clatms( 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 clatms( 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 clatme( n,
'D', iseed, work, imode, cond, cone,
644 $
'T',
'T',
'T', rwork, 4, conds, n, n,
645 $ anorm, a, lda, work( 2*n+1 ), iinfo )
647 ELSE IF( itype.EQ.7 )
THEN
651 CALL clatmr( 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 clatmr( 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 clatmr( 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 CLASET( 'full
', 2, N, CZERO, CZERO, A, LDA )
675 CALL CLASET( 'full
', N-3, 1, CZERO, CZERO, A( 3, 1 ),
677 CALL CLASET( 'full
', N-3, 2, CZERO, CZERO,
679 CALL CLASET( 'full
', 1, N, CZERO, CZERO, A( N, 1 ),
683.EQ.
ELSE IF( ITYPE10 ) THEN
687 CALL CLATMR( 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 CLACPY( 'f
', N, N, A, LDA, H, LDA )
725 CALL CGEEV( '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 )'cgeev1
', IINFO, N, JTYPE,
737 CALL CGET22( 'n
', 'n
', 'n
', N, A, LDA, VR, LDVR, W, WORK,
739 RESULT( 1 ) = RES( 1 )
743 CALL CGET22( 'c
', 'n
', 'c
', N, A, LDA, VL, LDVL, W, WORK,
745 RESULT( 2 ) = RES( 1 )
750 TNRM = SCNRM2( 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.EQ..AND.
IF( AIMAG( VR( JJ, J ) )ZERO
760.GT.
$ ABS( REAL( VR( JJ, J ) ) )VRMX )
761 $ VRMX = ABS( REAL( VR( JJ, J ) ) )
763.LT.
IF( VRMX / VMXONE-TWO*ULP )
764 $ RESULT( 3 ) = ULPINV
770 TNRM = SCNRM2( 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.EQ..AND.
IF( AIMAG( VL( JJ, J ) )ZERO
780.GT.
$ ABS( REAL( VL( JJ, J ) ) )VRMX )
781 $ VRMX = ABS( REAL( VL( JJ, J ) ) )
783.LT.
IF( VRMX / VMXONE-TWO*ULP )
784 $ RESULT( 4 ) = ULPINV
789 CALL CLACPY( 'f
', N, N, A, LDA, H, LDA )
790 CALL CGEEV( 'n
', 'n
', N, H, LDA, W1, DUM, 1, DUM, 1,
791 $ WORK, NNWORK, RWORK, IINFO )
792.NE.
IF( IINFO0 ) THEN
794 WRITE( NOUNIT, FMT = 9993 )'cgeev2
', IINFO, N, JTYPE,
803.NE.
IF( W( J )W1( J ) )
804 $ RESULT( 5 ) = ULPINV
809 CALL CLACPY( 'f
', N, N, A, LDA, H, LDA )
810 CALL CGEEV( 'n
', 'v
', N, H, LDA, W1, DUM, 1, LRE, LDLRE,
811 $ WORK, NNWORK, RWORK, IINFO )
812.NE.
IF( IINFO0 ) THEN
814 WRITE( NOUNIT, FMT = 9993 )'cgeev3
', IINFO, N, JTYPE,
823.NE.
IF( W( J )W1( J ) )
824 $ RESULT( 5 ) = ULPINV
831.NE.
IF( VR( J, JJ )LRE( J, JJ ) )
832 $ RESULT( 6 ) = ULPINV
838 CALL CLACPY( 'f
', N, N, A, LDA, H, LDA )
839 CALL CGEEV( 'v
', 'n
', N, H, LDA, W1, LRE, LDLRE, DUM, 1,
840 $ WORK, NNWORK, RWORK, IINFO )
841.NE.
IF( IINFO0 ) THEN
843 WRITE( NOUNIT, FMT = 9993 )'cgeev4
', IINFO, N, JTYPE,
852.NE.
IF( W( J )W1( J ) )
853 $ RESULT( 5 ) = ULPINV
860.NE.
IF( VL( J, JJ )LRE( J, JJ ) )
861 $ RESULT( 7 ) = ULPINV
872.GE.
IF( RESULT( J )ZERO )
874.GE.
IF( RESULT( J )THRESH )
879 $ NTESTF = NTESTF + 1
880.EQ.
IF( NTESTF1 ) 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.GE.
IF( RESULT( J )THRESH ) THEN
891 WRITE( NOUNIT, FMT = 9994 )N, IWK, IOLDSD, JTYPE,
896 NERRS = NERRS + NFAIL
897 NTESTT = NTESTT + NTEST
905 CALL SLASUM( PATH, NOUNIT, NERRS, NTESTT )
907 9999 FORMAT( / 1X, A3, ' --
Complex Eigenvalue-Eigenvector
',
908 $ 'Decomposition Driver
', /
909 $ ' Matrix types (see CDRVEV 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(
' CDRVEV: ', a,
' returned INFO=', i6,
'.', / 9x,
'N=',
944 $ i6,
', JTYPE=', i6,
', ISEED=(', 3( i5,
',' ), i5,
')' )
subroutine cdrvev(nsizes, nn, ntypes, dotype, iseed, thresh, nounit, a, lda, h, w, w1, vl, ldvl, vr, ldvr, lre, ldlre, result, work, nwork, rwork, iwork, info)
CDRVEV
subroutine clatmr(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)
CLATMR