LAPACK  3.6.1 LAPACK: Linear Algebra PACKage
 subroutine cdrvev ( integer NSIZES, integer, dimension( * ) NN, integer NTYPES, logical, dimension( * ) DOTYPE, integer, dimension( 4 ) ISEED, real THRESH, integer NOUNIT, complex, dimension( lda, * ) A, integer LDA, complex, dimension( lda, * ) H, complex, dimension( * ) W, complex, dimension( * ) W1, complex, dimension( ldvl, * ) VL, integer LDVL, complex, dimension( ldvr, * ) VR, integer LDVR, complex, dimension( ldlre, * ) LRE, integer LDLRE, real, dimension( 7 ) RESULT, complex, dimension( * ) WORK, integer NWORK, real, dimension( * ) RWORK, integer, dimension( * ) IWORK, integer INFO )

CDRVEV

Purpose:
CDRVEV  checks the nonsymmetric eigenvalue problem driver CGEEV.

When CDRVEV is called, a number of matrix "sizes" ("n's") and a
number of matrix "types" are specified.  For each size ("n")
and each type of matrix, one matrix will be generated and used
to test the nonsymmetric eigenroutines.  For each matrix, 7
tests will be performed:

(1)     | A * VR - VR * W | / ( n |A| ulp )

Here VR is the matrix of unit right eigenvectors.
W is a diagonal matrix with diagonal entries W(j).

(2)     | A**H * VL - VL * W**H | / ( n |A| ulp )

Here VL is the matrix of unit left eigenvectors, A**H is the
conjugate-transpose of A, and W is as above.

(3)     | |VR(i)| - 1 | / ulp and whether largest component real

VR(i) denotes the i-th column of VR.

(4)     | |VL(i)| - 1 | / ulp and whether largest component real

VL(i) denotes the i-th column of VL.

(5)     W(full) = W(partial)

W(full) denotes the eigenvalues computed when both VR and VL
are also computed, and W(partial) denotes the eigenvalues
computed when only W, only W and VR, or only W and VL are
computed.

(6)     VR(full) = VR(partial)

VR(full) denotes the right eigenvectors computed when both VR
and VL are computed, and VR(partial) denotes the result
when only VR is computed.

(7)     VL(full) = VL(partial)

VL(full) denotes the left eigenvectors computed when both VR
and VL are also computed, and VL(partial) denotes the result
when only VL is computed.

The "sizes" are specified by an array NN(1:NSIZES); the value of
each element NN(j) specifies one size.
The "types" are specified by a logical array DOTYPE( 1:NTYPES );
if DOTYPE(j) is .TRUE., then matrix type "j" will be generated.
Currently, the list of possible types is:

(1)  The zero matrix.
(2)  The identity matrix.
(3)  A (transposed) Jordan block, with 1's on the diagonal.

(4)  A diagonal matrix with evenly spaced entries
1, ..., ULP  and random complex angles.
(ULP = (first number larger than 1) - 1 )
(5)  A diagonal matrix with geometrically spaced entries
1, ..., ULP  and random complex angles.
(6)  A diagonal matrix with "clustered" entries 1, ULP, ..., ULP
and random complex angles.

(7)  Same as (4), but multiplied by a constant near
the overflow threshold
(8)  Same as (4), but multiplied by a constant near
the underflow threshold

(9)  A matrix of the form  U' T U, where U is unitary and
T has evenly spaced entries 1, ..., ULP with random complex
angles on the diagonal and random O(1) entries in the upper
triangle.

(10) A matrix of the form  U' T U, where U is unitary and
T has geometrically spaced entries 1, ..., ULP with random
complex angles on the diagonal and random O(1) entries in
the upper triangle.

(11) A matrix of the form  U' T U, where U is unitary and
T has "clustered" entries 1, ULP,..., ULP with random
complex angles on the diagonal and random O(1) entries in
the upper triangle.

(12) A matrix of the form  U' T U, where U is unitary and
T has complex eigenvalues randomly chosen from
ULP < |z| < 1   and random O(1) entries in the upper
triangle.

(13) A matrix of the form  X' T X, where X has condition
SQRT( ULP ) and T has evenly spaced entries 1, ..., ULP
with random complex angles on the diagonal and random O(1)
entries in the upper triangle.

(14) A matrix of the form  X' T X, where X has condition
SQRT( ULP ) and T has geometrically spaced entries
1, ..., ULP with random complex angles on the diagonal
and random O(1) entries in the upper triangle.

(15) A matrix of the form  X' T X, where X has condition
SQRT( ULP ) and T has "clustered" entries 1, ULP,..., ULP
with random complex angles on the diagonal and random O(1)
entries in the upper triangle.

(16) A matrix of the form  X' T X, where X has condition
SQRT( ULP ) and T has complex eigenvalues randomly chosen
from ULP < |z| < 1 and random O(1) entries in the upper
triangle.

(17) Same as (16), but multiplied by a constant
near the overflow threshold
(18) Same as (16), but multiplied by a constant
near the underflow threshold

(19) Nonsymmetric matrix with random entries chosen from |z| < 1
If N is at least 4, all entries in first two rows and last
row, and first column and last two columns are zero.
(20) Same as (19), but multiplied by a constant
near the overflow threshold
(21) Same as (19), but multiplied by a constant
near the underflow threshold
Parameters
 [in] NSIZES NSIZES is INTEGER The number of sizes of matrices to use. If it is zero, CDRVEV does nothing. It must be at least zero. [in] NN NN is INTEGER array, dimension (NSIZES) An array containing the sizes to be used for the matrices. Zero values will be skipped. The values must be at least zero. [in] NTYPES NTYPES is INTEGER The number of elements in DOTYPE. If it is zero, CDRVEV does nothing. It must be at least zero. If it is MAXTYP+1 and NSIZES is 1, then an additional type, MAXTYP+1 is defined, which is to use whatever matrix is in A. This is only useful if DOTYPE(1:MAXTYP) is .FALSE. and DOTYPE(MAXTYP+1) is .TRUE. . [in] DOTYPE DOTYPE is LOGICAL array, dimension (NTYPES) If DOTYPE(j) is .TRUE., then for each size in NN a matrix of that size and of type j will be generated. If NTYPES is smaller than the maximum number of types defined (PARAMETER MAXTYP), then types NTYPES+1 through MAXTYP will not be generated. If NTYPES is larger than MAXTYP, DOTYPE(MAXTYP+1) through DOTYPE(NTYPES) will be ignored. [in,out] ISEED ISEED is INTEGER array, dimension (4) On entry ISEED specifies the seed of the random number generator. The array elements should be between 0 and 4095; if not they will be reduced mod 4096. Also, ISEED(4) must be odd. The random number generator uses a linear congruential sequence limited to small integers, and so should produce machine independent random numbers. The values of ISEED are changed on exit, and can be used in the next call to CDRVEV to continue the same random number sequence. [in] THRESH THRESH is REAL A test will count as "failed" if the "error", computed as described above, exceeds THRESH. Note that the error is scaled to be O(1), so THRESH should be a reasonably small multiple of 1, e.g., 10 or 100. In particular, it should not depend on the precision (single vs. double) or the size of the matrix. It must be at least zero. [in] NOUNIT NOUNIT is INTEGER The FORTRAN unit number for printing out error messages (e.g., if a routine returns INFO not equal to 0.) [out] A A is COMPLEX array, dimension (LDA, max(NN)) Used to hold the matrix whose eigenvalues are to be computed. On exit, A contains the last matrix actually used. [in] LDA LDA is INTEGER The leading dimension of A, and H. LDA must be at least 1 and at least max(NN). [out] H H is COMPLEX array, dimension (LDA, max(NN)) Another copy of the test matrix A, modified by CGEEV. [out] W W is COMPLEX array, dimension (max(NN)) The eigenvalues of A. On exit, W are the eigenvalues of the matrix in A. [out] W1 W1 is COMPLEX array, dimension (max(NN)) Like W, this array contains the eigenvalues of A, but those computed when CGEEV only computes a partial eigendecomposition, i.e. not the eigenvalues and left and right eigenvectors. [out] VL VL is COMPLEX array, dimension (LDVL, max(NN)) VL holds the computed left eigenvectors. [in] LDVL LDVL is INTEGER Leading dimension of VL. Must be at least max(1,max(NN)). [out] VR VR is COMPLEX array, dimension (LDVR, max(NN)) VR holds the computed right eigenvectors. [in] LDVR LDVR is INTEGER Leading dimension of VR. Must be at least max(1,max(NN)). [out] LRE LRE is COMPLEX array, dimension (LDLRE, max(NN)) LRE holds the computed right or left eigenvectors. [in] LDLRE LDLRE is INTEGER Leading dimension of LRE. Must be at least max(1,max(NN)). [out] RESULT RESULT is REAL array, dimension (7) The values computed by the seven tests described above. The values are currently limited to 1/ulp, to avoid overflow. [out] WORK WORK is COMPLEX array, dimension (NWORK) [in] NWORK NWORK is INTEGER The number of entries in WORK. This must be at least 5*NN(j)+2*NN(j)**2 for all j. [out] RWORK RWORK is REAL array, dimension (2*max(NN)) [out] IWORK IWORK is INTEGER array, dimension (max(NN)) [out] INFO INFO is INTEGER If 0, then everything ran OK. -1: NSIZES < 0 -2: Some NN(j) < 0 -3: NTYPES < 0 -6: THRESH < 0 -9: LDA < 1 or LDA < NMAX, where NMAX is max( NN(j) ). -14: LDVL < 1 or LDVL < NMAX, where NMAX is max( NN(j) ). -16: LDVR < 1 or LDVR < NMAX, where NMAX is max( NN(j) ). -18: LDLRE < 1 or LDLRE < NMAX, where NMAX is max( NN(j) ). -21: NWORK too small. If CLATMR, CLATMS, CLATME or CGEEV returns an error code, the absolute value of it is returned. ----------------------------------------------------------------------- Some Local Variables and Parameters: ---- ----- --------- --- ---------- ZERO, ONE Real 0 and 1. MAXTYP The number of types defined. NMAX Largest value in NN. NERRS The number of tests which have exceeded THRESH COND, CONDS, IMODE Values to be passed to the matrix generators. ANORM Norm of A; passed to matrix generators. OVFL, UNFL Overflow and underflow thresholds. ULP, ULPINV Finest relative precision and its inverse. RTULP, RTULPI Square roots of the previous 4 values. The following four arrays decode JTYPE: KTYPE(j) The general type (1-10) for type "j". KMODE(j) The MODE value to be passed to the matrix generator for type "j". KMAGN(j) The order of magnitude ( O(1), O(overflow^(1/2) ), O(underflow^(1/2) ) KCONDS(j) Selectw whether CONDS is to be 1 or 1/sqrt(ulp). (0 means irrelevant.)
Date
November 2011

Definition at line 393 of file cdrvev.f.

393 *
394 * -- LAPACK test routine (version 3.4.0) --
395 * -- LAPACK is a software package provided by Univ. of Tennessee, --
396 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
397 * November 2011
398 *
399 * .. Scalar Arguments ..
400  INTEGER info, lda, ldlre, ldvl, ldvr, nounit, nsizes,
401  \$ ntypes, nwork
402  REAL thresh
403 * ..
404 * .. Array Arguments ..
405  LOGICAL dotype( * )
406  INTEGER iseed( 4 ), iwork( * ), nn( * )
407  REAL result( 7 ), rwork( * )
408  COMPLEX a( lda, * ), h( lda, * ), lre( ldlre, * ),
409  \$ vl( ldvl, * ), vr( ldvr, * ), w( * ), w1( * ),
410  \$ work( * )
411 * ..
412 *
413 * =====================================================================
414 *
415 * .. Parameters ..
416  COMPLEX czero
417  parameter ( czero = ( 0.0e+0, 0.0e+0 ) )
418  COMPLEX cone
419  parameter ( cone = ( 1.0e+0, 0.0e+0 ) )
420  REAL zero, one
421  parameter ( zero = 0.0e+0, one = 1.0e+0 )
422  REAL two
423  parameter ( two = 2.0e+0 )
424  INTEGER maxtyp
425  parameter ( maxtyp = 21 )
426 * ..
427 * .. Local Scalars ..
429  CHARACTER*3 path
430  INTEGER iinfo, imode, itype, iwk, j, jcol, jj, jsize,
431  \$ jtype, mtypes, n, nerrs, nfail, nmax,
432  \$ nnwork, ntest, ntestf, ntestt
433  REAL anorm, cond, conds, ovfl, rtulp, rtulpi, tnrm,
434  \$ ulp, ulpinv, unfl, vmx, vrmx, vtst
435 * ..
436 * .. Local Arrays ..
437  INTEGER idumma( 1 ), ioldsd( 4 ), kconds( maxtyp ),
438  \$ kmagn( maxtyp ), kmode( maxtyp ),
439  \$ ktype( maxtyp )
440  REAL res( 2 )
441  COMPLEX dum( 1 )
442 * ..
443 * .. External Functions ..
444  REAL scnrm2, slamch
445  EXTERNAL scnrm2, slamch
446 * ..
447 * .. External Subroutines ..
448  EXTERNAL cgeev, cget22, clacpy, clatme, clatmr, clatms,
450 * ..
451 * .. Intrinsic Functions ..
452  INTRINSIC abs, aimag, cmplx, max, min, REAL, sqrt
453 * ..
454 * .. Data statements ..
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,
457  \$ 3, 1, 2, 3 /
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 /
461 * ..
462 * .. Executable Statements ..
463 *
464  path( 1: 1 ) = 'Complex precision'
465  path( 2: 3 ) = 'EV'
466 *
467 * Check for errors
468 *
469  ntestt = 0
470  ntestf = 0
471  info = 0
472 *
473 * Important constants
474 *
476  nmax = 0
477  DO 10 j = 1, nsizes
478  nmax = max( nmax, nn( j ) )
479  IF( nn( j ).LT.0 )
481  10 CONTINUE
482 *
483 * Check for errors
484 *
485  IF( nsizes.LT.0 ) THEN
486  info = -1
487  ELSE IF( badnn ) THEN
488  info = -2
489  ELSE IF( ntypes.LT.0 ) THEN
490  info = -3
491  ELSE IF( thresh.LT.zero ) THEN
492  info = -6
493  ELSE IF( nounit.LE.0 ) THEN
494  info = -7
495  ELSE IF( lda.LT.1 .OR. lda.LT.nmax ) THEN
496  info = -9
497  ELSE IF( ldvl.LT.1 .OR. ldvl.LT.nmax ) THEN
498  info = -14
499  ELSE IF( ldvr.LT.1 .OR. ldvr.LT.nmax ) THEN
500  info = -16
501  ELSE IF( ldlre.LT.1 .OR. ldlre.LT.nmax ) THEN
502  info = -28
503  ELSE IF( 5*nmax+2*nmax**2.GT.nwork ) THEN
504  info = -21
505  END IF
506 *
507  IF( info.NE.0 ) THEN
508  CALL xerbla( 'CDRVEV', -info )
509  RETURN
510  END IF
511 *
512 * Quick return if nothing to do
513 *
514  IF( nsizes.EQ.0 .OR. ntypes.EQ.0 )
515  \$ RETURN
516 *
517 * More Important constants
518 *
519  unfl = slamch( 'Safe minimum' )
520  ovfl = one / unfl
521  CALL slabad( unfl, ovfl )
522  ulp = slamch( 'Precision' )
523  ulpinv = one / ulp
524  rtulp = sqrt( ulp )
525  rtulpi = one / rtulp
526 *
527 * Loop over sizes, types
528 *
529  nerrs = 0
530 *
531  DO 270 jsize = 1, nsizes
532  n = nn( jsize )
533  IF( nsizes.NE.1 ) THEN
534  mtypes = min( maxtyp, ntypes )
535  ELSE
536  mtypes = min( maxtyp+1, ntypes )
537  END IF
538 *
539  DO 260 jtype = 1, mtypes
540  IF( .NOT.dotype( jtype ) )
541  \$ GO TO 260
542 *
543 * Save ISEED in case of an error.
544 *
545  DO 20 j = 1, 4
546  ioldsd( j ) = iseed( j )
547  20 CONTINUE
548 *
549 * Compute "A"
550 *
551 * Control parameters:
552 *
553 * KMAGN KCONDS KMODE KTYPE
554 * =1 O(1) 1 clustered 1 zero
555 * =2 large large clustered 2 identity
556 * =3 small exponential Jordan
557 * =4 arithmetic diagonal, (w/ eigenvalues)
558 * =5 random log symmetric, w/ eigenvalues
559 * =6 random general, w/ eigenvalues
560 * =7 random diagonal
561 * =8 random symmetric
562 * =9 random general
563 * =10 random triangular
564 *
565  IF( mtypes.GT.maxtyp )
566  \$ GO TO 90
567 *
568  itype = ktype( jtype )
569  imode = kmode( jtype )
570 *
571 * Compute norm
572 *
573  GO TO ( 30, 40, 50 )kmagn( jtype )
574 *
575  30 CONTINUE
576  anorm = one
577  GO TO 60
578 *
579  40 CONTINUE
580  anorm = ovfl*ulp
581  GO TO 60
582 *
583  50 CONTINUE
584  anorm = unfl*ulpinv
585  GO TO 60
586 *
587  60 CONTINUE
588 *
589  CALL claset( 'Full', lda, n, czero, czero, a, lda )
590  iinfo = 0
591  cond = ulpinv
592 *
593 * Special Matrices -- Identity & Jordan block
594 *
595 * Zero
596 *
597  IF( itype.EQ.1 ) THEN
598  iinfo = 0
599 *
600  ELSE IF( itype.EQ.2 ) THEN
601 *
602 * Identity
603 *
604  DO 70 jcol = 1, n
605  a( jcol, jcol ) = cmplx( anorm )
606  70 CONTINUE
607 *
608  ELSE IF( itype.EQ.3 ) THEN
609 *
610 * Jordan Block
611 *
612  DO 80 jcol = 1, n
613  a( jcol, jcol ) = cmplx( anorm )
614  IF( jcol.GT.1 )
615  \$ a( jcol, jcol-1 ) = cone
616  80 CONTINUE
617 *
618  ELSE IF( itype.EQ.4 ) THEN
619 *
620 * Diagonal Matrix, [Eigen]values Specified
621 *
622  CALL clatms( n, n, 'S', iseed, 'H', rwork, imode, cond,
623  \$ anorm, 0, 0, 'N', a, lda, work( n+1 ),
624  \$ iinfo )
625 *
626  ELSE IF( itype.EQ.5 ) THEN
627 *
628 * Hermitian, eigenvalues specified
629 *
630  CALL clatms( n, n, 'S', iseed, 'H', rwork, imode, cond,
631  \$ anorm, n, n, 'N', a, lda, work( n+1 ),
632  \$ iinfo )
633 *
634  ELSE IF( itype.EQ.6 ) THEN
635 *
636 * General, eigenvalues specified
637 *
638  IF( kconds( jtype ).EQ.1 ) THEN
639  conds = one
640  ELSE IF( kconds( jtype ).EQ.2 ) THEN
641  conds = rtulpi
642  ELSE
643  conds = zero
644  END IF
645 *
646  CALL clatme( n, 'D', iseed, work, imode, cond, cone,
647  \$ 'T', 'T', 'T', rwork, 4, conds, n, n,
648  \$ anorm, a, lda, work( 2*n+1 ), iinfo )
649 *
650  ELSE IF( itype.EQ.7 ) THEN
651 *
652 * Diagonal, random eigenvalues
653 *
654  CALL clatmr( 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 )
658 *
659  ELSE IF( itype.EQ.8 ) THEN
660 *
661 * Symmetric, random eigenvalues
662 *
663  CALL clatmr( 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 )
667 *
668  ELSE IF( itype.EQ.9 ) THEN
669 *
670 * General, random eigenvalues
671 *
672  CALL clatmr( 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 )
676  IF( n.GE.4 ) THEN
677  CALL claset( 'Full', 2, n, czero, czero, a, lda )
678  CALL claset( 'Full', n-3, 1, czero, czero, a( 3, 1 ),
679  \$ lda )
680  CALL claset( 'Full', n-3, 2, czero, czero,
681  \$ a( 3, n-1 ), lda )
682  CALL claset( 'Full', 1, n, czero, czero, a( n, 1 ),
683  \$ lda )
684  END IF
685 *
686  ELSE IF( itype.EQ.10 ) THEN
687 *
688 * Triangular, random eigenvalues
689 *
690  CALL clatmr( 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 )
694 *
695  ELSE
696 *
697  iinfo = 1
698  END IF
699 *
700  IF( iinfo.NE.0 ) THEN
701  WRITE( nounit, fmt = 9993 )'Generator', iinfo, n, jtype,
702  \$ ioldsd
703  info = abs( iinfo )
704  RETURN
705  END IF
706 *
707  90 CONTINUE
708 *
709 * Test for minimal and generous workspace
710 *
711  DO 250 iwk = 1, 2
712  IF( iwk.EQ.1 ) THEN
713  nnwork = 2*n
714  ELSE
715  nnwork = 5*n + 2*n**2
716  END IF
717  nnwork = max( nnwork, 1 )
718 *
719 * Initialize RESULT
720 *
721  DO 100 j = 1, 7
722  result( j ) = -one
723  100 CONTINUE
724 *
725 * Compute eigenvalues and eigenvectors, and test them
726 *
727  CALL clacpy( 'F', n, n, a, lda, h, lda )
728  CALL cgeev( 'V', 'V', n, h, lda, w, vl, ldvl, vr, ldvr,
729  \$ work, nnwork, rwork, iinfo )
730  IF( iinfo.NE.0 ) THEN
731  result( 1 ) = ulpinv
732  WRITE( nounit, fmt = 9993 )'CGEEV1', iinfo, n, jtype,
733  \$ ioldsd
734  info = abs( iinfo )
735  GO TO 220
736  END IF
737 *
738 * Do Test (1)
739 *
740  CALL cget22( 'N', 'N', 'N', n, a, lda, vr, ldvr, w, work,
741  \$ rwork, res )
742  result( 1 ) = res( 1 )
743 *
744 * Do Test (2)
745 *
746  CALL cget22( 'C', 'N', 'C', n, a, lda, vl, ldvl, w, work,
747  \$ rwork, res )
748  result( 2 ) = res( 1 )
749 *
750 * Do Test (3)
751 *
752  DO 120 j = 1, n
753  tnrm = scnrm2( n, vr( 1, j ), 1 )
754  result( 3 ) = max( result( 3 ),
755  \$ min( ulpinv, abs( tnrm-one ) / ulp ) )
756  vmx = zero
757  vrmx = zero
758  DO 110 jj = 1, n
759  vtst = abs( vr( jj, j ) )
760  IF( vtst.GT.vmx )
761  \$ vmx = vtst
762  IF( aimag( vr( jj, j ) ).EQ.zero .AND.
763  \$ abs( REAL( VR( JJ, J ) ) ).GT.vrmx )
764  \$ vrmx = abs( REAL( VR( JJ, J ) ) )
765  110 CONTINUE
766  IF( vrmx / vmx.LT.one-two*ulp )
767  \$ result( 3 ) = ulpinv
768  120 CONTINUE
769 *
770 * Do Test (4)
771 *
772  DO 140 j = 1, n
773  tnrm = scnrm2( n, vl( 1, j ), 1 )
774  result( 4 ) = max( result( 4 ),
775  \$ min( ulpinv, abs( tnrm-one ) / ulp ) )
776  vmx = zero
777  vrmx = zero
778  DO 130 jj = 1, n
779  vtst = abs( vl( jj, j ) )
780  IF( vtst.GT.vmx )
781  \$ vmx = vtst
782  IF( aimag( vl( jj, j ) ).EQ.zero .AND.
783  \$ abs( REAL( VL( JJ, J ) ) ).GT.vrmx )
784  \$ vrmx = abs( REAL( VL( JJ, J ) ) )
785  130 CONTINUE
786  IF( vrmx / vmx.LT.one-two*ulp )
787  \$ result( 4 ) = ulpinv
788  140 CONTINUE
789 *
790 * Compute eigenvalues only, and test them
791 *
792  CALL clacpy( 'F', n, n, a, lda, h, lda )
793  CALL cgeev( 'N', 'N', n, h, lda, w1, dum, 1, dum, 1,
794  \$ work, nnwork, rwork, iinfo )
795  IF( iinfo.NE.0 ) THEN
796  result( 1 ) = ulpinv
797  WRITE( nounit, fmt = 9993 )'CGEEV2', iinfo, n, jtype,
798  \$ ioldsd
799  info = abs( iinfo )
800  GO TO 220
801  END IF
802 *
803 * Do Test (5)
804 *
805  DO 150 j = 1, n
806  IF( w( j ).NE.w1( j ) )
807  \$ result( 5 ) = ulpinv
808  150 CONTINUE
809 *
810 * Compute eigenvalues and right eigenvectors, and test them
811 *
812  CALL clacpy( 'F', n, n, a, lda, h, lda )
813  CALL cgeev( 'N', 'V', n, h, lda, w1, dum, 1, lre, ldlre,
814  \$ work, nnwork, rwork, iinfo )
815  IF( iinfo.NE.0 ) THEN
816  result( 1 ) = ulpinv
817  WRITE( nounit, fmt = 9993 )'CGEEV3', iinfo, n, jtype,
818  \$ ioldsd
819  info = abs( iinfo )
820  GO TO 220
821  END IF
822 *
823 * Do Test (5) again
824 *
825  DO 160 j = 1, n
826  IF( w( j ).NE.w1( j ) )
827  \$ result( 5 ) = ulpinv
828  160 CONTINUE
829 *
830 * Do Test (6)
831 *
832  DO 180 j = 1, n
833  DO 170 jj = 1, n
834  IF( vr( j, jj ).NE.lre( j, jj ) )
835  \$ result( 6 ) = ulpinv
836  170 CONTINUE
837  180 CONTINUE
838 *
839 * Compute eigenvalues and left eigenvectors, and test them
840 *
841  CALL clacpy( 'F', n, n, a, lda, h, lda )
842  CALL cgeev( 'V', 'N', n, h, lda, w1, lre, ldlre, dum, 1,
843  \$ work, nnwork, rwork, iinfo )
844  IF( iinfo.NE.0 ) THEN
845  result( 1 ) = ulpinv
846  WRITE( nounit, fmt = 9993 )'CGEEV4', iinfo, n, jtype,
847  \$ ioldsd
848  info = abs( iinfo )
849  GO TO 220
850  END IF
851 *
852 * Do Test (5) again
853 *
854  DO 190 j = 1, n
855  IF( w( j ).NE.w1( j ) )
856  \$ result( 5 ) = ulpinv
857  190 CONTINUE
858 *
859 * Do Test (7)
860 *
861  DO 210 j = 1, n
862  DO 200 jj = 1, n
863  IF( vl( j, jj ).NE.lre( j, jj ) )
864  \$ result( 7 ) = ulpinv
865  200 CONTINUE
866  210 CONTINUE
867 *
868 * End of Loop -- Check for RESULT(j) > THRESH
869 *
870  220 CONTINUE
871 *
872  ntest = 0
873  nfail = 0
874  DO 230 j = 1, 7
875  IF( result( j ).GE.zero )
876  \$ ntest = ntest + 1
877  IF( result( j ).GE.thresh )
878  \$ nfail = nfail + 1
879  230 CONTINUE
880 *
881  IF( nfail.GT.0 )
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
889  ntestf = 2
890  END IF
891 *
892  DO 240 j = 1, 7
893  IF( result( j ).GE.thresh ) THEN
894  WRITE( nounit, fmt = 9994 )n, iwk, ioldsd, jtype,
895  \$ j, result( j )
896  END IF
897  240 CONTINUE
898 *
899  nerrs = nerrs + nfail
900  ntestt = ntestt + ntest
901 *
902  250 CONTINUE
903  260 CONTINUE
904  270 CONTINUE
905 *
906 * Summary
907 *
908  CALL slasum( path, nounit, nerrs, ntestt )
909 *
910  9999 FORMAT( / 1x, a3, ' -- Complex Eigenvalue-Eigenvector ',
911  \$ 'Decomposition Driver', /
912  \$ ' Matrix types (see CDRVEV for details): ' )
913 *
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.',
929  \$ ' complx ', a4 )
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( ' CDRVEV: ', a, ' returned INFO=', i6, '.', / 9x, 'N=',
947  \$ i6, ', JTYPE=', i6, ', ISEED=(', 3( i5, ',' ), i5, ')' )
948 *
949  RETURN
950 *
951 * End of CDRVEV
952 *
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
Definition: clatmr.f:492
real function scnrm2(N, X, INCX)
SCNRM2
Definition: scnrm2.f:56
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 ...
Definition: cgeev.f:181
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
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...
Definition: claset.f:108
subroutine clatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
CLATMS
Definition: clatms.f:334
subroutine cget22(TRANSA, TRANSE, TRANSW, N, A, LDA, E, LDE, W, WORK, RWORK, RESULT)
CGET22
Definition: cget22.f:145
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
Definition: clacpy.f:105
real function slamch(CMACH)
SLAMCH
Definition: slamch.f:69
subroutine slasum(TYPE, IOUNIT, IE, NRUN)
SLASUM
Definition: slasum.f:42
subroutine clatme(N, DIST, ISEED, D, MODE, COND, DMAX, RSIGN, UPPER, SIM, DS, MODES, CONDS, KL, KU, ANORM, A, LDA, WORK, INFO)
CLATME
Definition: clatme.f:303

Here is the call graph for this function:

Here is the caller graph for this function: