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, LDA, LDLRE, LDVL, LDVR, NOUNIT, NSIZES,
403 INTEGER ISEED( 4 ), IWORK( * ), NN( * )
404 REAL RESULT( 7 ), RWORK( * )
405 COMPLEX A( LDA, * ), H( 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, RTULP, 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
449 INTRINSIC abs, aimag, cmplx, max, min, real, 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,
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 ELSE IF( itype.EQ.10 )
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 IF( iinfo.NE.0 )
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 IF( iinfo.NE.0 )
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 IF( aimag( vr( jj, j ) ).EQ.zero .AND.
760 $ abs( real( vr( jj, j ) ) ).GT.vrmx )
761 $ vrmx = abs( real( vr( jj, j ) ) )
763 IF( vrmx / vmx.LT.one-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 IF( aimag( vl( jj, j ) ).EQ.zero .AND.
780 $ abs( real( vl( jj, j ) ) ).GT.vrmx )
781 $ vrmx = abs( real( vl( jj, j ) ) )
783 IF( vrmx / vmx.LT.one-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 IF( iinfo.NE.0 )
THEN
794 WRITE( nounit, fmt = 9993 )
'CGEEV2', iinfo, n, jtype,
803 IF( w( j ).NE.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 IF( iinfo.NE.0 )
THEN
814 WRITE( nounit, fmt = 9993 )
'CGEEV3', 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 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 IF( iinfo.NE.0 )
THEN
843 WRITE( nounit, fmt = 9993 )
'CGEEV4', 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 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 slabad(SMALL, LARGE)
SLABAD
subroutine xerbla(SRNAME, INFO)
XERBLA
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 cget22(TRANSA, TRANSE, TRANSW, N, A, LDA, E, LDE, W, WORK, RWORK, RESULT)
CGET22
subroutine clatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
CLATMS
subroutine clatme(N, DIST, ISEED, D, MODE, COND, DMAX, RSIGN, UPPER, SIM, DS, MODES, CONDS, KL, KU, ANORM, A, LDA, WORK, INFO)
CLATME
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
subroutine cgeev(JOBVL, JOBVR, N, A, LDA, W, VL, LDVL, VR, LDVR, WORK, LWORK, RWORK, INFO)
CGEEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices
subroutine claset(UPLO, M, N, ALPHA, BETA, A, LDA)
CLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values.
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
subroutine slasum(TYPE, IOUNIT, IE, NRUN)
SLASUM