LAPACK  3.5.0
LAPACK: Linear Algebra PACKage
zdrvgg.f File Reference

Go to the source code of this file.

Functions/Subroutines

subroutine zdrvgg (NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, THRSHN, NOUNIT, A, LDA, B, S, T, S2, T2, Q, LDQ, Z, ALPHA1, BETA1, ALPHA2, BETA2, VL, VR, WORK, LWORK, RWORK, RESULT, INFO)
 ZDRVGG More...
 

Function/Subroutine Documentation

subroutine zdrvgg ( integer  NSIZES,
integer, dimension( * )  NN,
integer  NTYPES,
logical, dimension( * )  DOTYPE,
integer, dimension( 4 )  ISEED,
double precision  THRESH,
double precision  THRSHN,
integer  NOUNIT,
complex*16, dimension( lda, * )  A,
integer  LDA,
complex*16, dimension( lda, * )  B,
complex*16, dimension( lda, * )  S,
complex*16, dimension( lda, * )  T,
complex*16, dimension( lda, * )  S2,
complex*16, dimension( lda, * )  T2,
complex*16, dimension( ldq, * )  Q,
integer  LDQ,
complex*16, dimension( ldq, * )  Z,
complex*16, dimension( * )  ALPHA1,
complex*16, dimension( * )  BETA1,
complex*16, dimension( * )  ALPHA2,
complex*16, dimension( * )  BETA2,
complex*16, dimension( ldq, * )  VL,
complex*16, dimension( ldq, * )  VR,
complex*16, dimension( * )  WORK,
integer  LWORK,
double precision, dimension( * )  RWORK,
double precision, dimension( * )  RESULT,
integer  INFO 
)

ZDRVGG

Purpose:
 ZDRVGG  checks the nonsymmetric generalized eigenvalue driver
 routines.
                               T          T        T
 ZGEGS factors A and B as Q S Z  and Q T Z , where   means
 transpose, T is upper triangular, S is in generalized Schur form
 (upper triangular), and Q and Z are unitary.  It also
 computes the generalized eigenvalues (alpha(1),beta(1)), ...,
 (alpha(n),beta(n)), where alpha(j)=S(j,j) and beta(j)=T(j,j) --
 thus, w(j) = alpha(j)/beta(j) is a root of the generalized
 eigenvalue problem

     det( A - w(j) B ) = 0

 and m(j) = beta(j)/alpha(j) is a root of the essentially equivalent
 problem

     det( m(j) A - B ) = 0

 ZGEGV computes the generalized eigenvalues (alpha(1),beta(1)), ...,
 (alpha(n),beta(n)), the matrix L whose columns contain the
 generalized left eigenvectors l, and the matrix R whose columns
 contain the generalized right eigenvectors r for the pair (A,B).

 When ZDRVGG 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 and compared with the threshhold THRESH:

 Results from ZGEGS:

                  H
 (1)   | A - Q S Z  | / ( |A| n ulp )

                  H
 (2)   | B - Q T Z  | / ( |B| n ulp )

               H
 (3)   | I - QQ  | / ( n ulp )

               H
 (4)   | I - ZZ  | / ( n ulp )

 (5)   maximum over j of D(j)  where:

                     |alpha(j) - S(j,j)|        |beta(j) - T(j,j)|
           D(j) = ------------------------ + -----------------------
                  max(|alpha(j)|,|S(j,j)|)   max(|beta(j)|,|T(j,j)|)

 Results from ZGEGV:

 (6)   max over all left eigenvalue/-vector pairs (beta/alpha,l) of

    | l**H * (beta A - alpha B) | / ( ulp max( |beta A|, |alpha B| ) )

       where l**H is the conjugate tranpose of l.

 (7)   max over all right eigenvalue/-vector pairs (beta/alpha,r) of

       | (beta A - alpha B) r | / ( ulp max( |beta A|, |alpha B| ) )

 Test Matrices
 ---- --------

 The sizes of the test matrices 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)  ( 0, 0 )         (a pair of zero matrices)

 (2)  ( I, 0 )         (an identity and a zero matrix)

 (3)  ( 0, I )         (an identity and a zero matrix)

 (4)  ( I, I )         (a pair of identity matrices)

         t   t
 (5)  ( J , J  )       (a pair of transposed Jordan blocks)

                                     t                ( I   0  )
 (6)  ( X, Y )         where  X = ( J   0  )  and Y = (      t )
                                  ( 0   I  )          ( 0   J  )
                       and I is a k x k identity and J a (k+1)x(k+1)
                       Jordan block; k=(N-1)/2

 (7)  ( D, I )         where D is diag( 0, 1,..., N-1 ) (a diagonal
                       matrix with those diagonal entries.)
 (8)  ( I, D )

 (9)  ( big*D, small*I ) where "big" is near overflow and small=1/big

 (10) ( small*D, big*I )

 (11) ( big*I, small*D )

 (12) ( small*I, big*D )

 (13) ( big*D, big*I )

 (14) ( small*D, small*I )

 (15) ( D1, D2 )        where D1 is diag( 0, 0, 1, ..., N-3, 0 ) and
                        D2 is diag( 0, N-3, N-4,..., 1, 0, 0 )
           t   t
 (16) Q ( J , J ) Z     where Q and Z are random unitary matrices.

 (17) Q ( T1, T2 ) Z    where T1 and T2 are upper triangular matrices
                        with random O(1) entries above the diagonal
                        and diagonal entries diag(T1) =
                        ( 0, 0, 1, ..., N-3, 0 ) and diag(T2) =
                        ( 0, N-3, N-4,..., 1, 0, 0 )

 (18) Q ( T1, T2 ) Z    diag(T1) = ( 0, 0, 1, 1, s, ..., s, 0 )
                        diag(T2) = ( 0, 1, 0, 1,..., 1, 0 )
                        s = machine precision.

 (19) Q ( T1, T2 ) Z    diag(T1)=( 0,0,1,1, 1-d, ..., 1-(N-5)*d=s, 0 )
                        diag(T2) = ( 0, 1, 0, 1, ..., 1, 0 )

                                                        N-5
 (20) Q ( T1, T2 ) Z    diag(T1)=( 0, 0, 1, 1, a, ..., a   =s, 0 )
                        diag(T2) = ( 0, 1, 0, 1, ..., 1, 0, 0 )

 (21) Q ( T1, T2 ) Z    diag(T1)=( 0, 0, 1, r1, r2, ..., r(N-4), 0 )
                        diag(T2) = ( 0, 1, 0, 1, ..., 1, 0, 0 )
                        where r1,..., r(N-4) are random.

 (22) Q ( big*T1, small*T2 ) Z    diag(T1) = ( 0, 0, 1, ..., N-3, 0 )
                                  diag(T2) = ( 0, 1, ..., 1, 0, 0 )

 (23) Q ( small*T1, big*T2 ) Z    diag(T1) = ( 0, 0, 1, ..., N-3, 0 )
                                  diag(T2) = ( 0, 1, ..., 1, 0, 0 )

 (24) Q ( small*T1, small*T2 ) Z  diag(T1) = ( 0, 0, 1, ..., N-3, 0 )
                                  diag(T2) = ( 0, 1, ..., 1, 0, 0 )

 (25) Q ( big*T1, big*T2 ) Z      diag(T1) = ( 0, 0, 1, ..., N-3, 0 )
                                  diag(T2) = ( 0, 1, ..., 1, 0, 0 )

 (26) Q ( T1, T2 ) Z     where T1 and T2 are random upper-triangular
                         matrices.
Parameters
[in]NSIZES
          NSIZES is INTEGER
          The number of sizes of matrices to use.  If it is zero,
          ZDRVGG 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, ZDRVGG
          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 ZDRVGG to continue the same random number
          sequence.
[in]THRESH
          THRESH is DOUBLE PRECISION
          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]THRSHN
          THRSHN is DOUBLE PRECISION
          Threshhold for reporting eigenvector normalization error.
          If the normalization of any eigenvector differs from 1 by
          more than THRSHN*ulp, then a special error message will be
          printed.  (This is handled separately from the other tests,
          since only a compiler or programming error should cause an
          error message, at least if THRSHN is at least 5--10.)
[in]NOUNIT
          NOUNIT is INTEGER
          The FORTRAN unit number for printing out error messages
          (e.g., if a routine returns IINFO not equal to 0.)
[in,out]A
          A is COMPLEX*16 array, dimension (LDA, max(NN))
          Used to hold the original A matrix.  Used as input only
          if NTYPES=MAXTYP+1, DOTYPE(1:MAXTYP)=.FALSE., and
          DOTYPE(MAXTYP+1)=.TRUE.
[in]LDA
          LDA is INTEGER
          The leading dimension of A, B, S, T, S2, and T2.
          It must be at least 1 and at least max( NN ).
[in,out]B
          B is COMPLEX*16 array, dimension (LDA, max(NN))
          Used to hold the original B matrix.  Used as input only
          if NTYPES=MAXTYP+1, DOTYPE(1:MAXTYP)=.FALSE., and
          DOTYPE(MAXTYP+1)=.TRUE.
[out]S
          S is COMPLEX*16 array, dimension (LDA, max(NN))
          The upper triangular matrix computed from A by ZGEGS.
[out]T
          T is COMPLEX*16 array, dimension (LDA, max(NN))
          The upper triangular matrix computed from B by ZGEGS.
[out]S2
          S2 is COMPLEX*16 array, dimension (LDA, max(NN))
          The matrix computed from A by ZGEGV.  This will be the
          Schur (upper triangular) form of some matrix related to A,
          but will not, in general, be the same as S.
[out]T2
          T2 is COMPLEX*16 array, dimension (LDA, max(NN))
          The matrix computed from B by ZGEGV.  This will be the
          Schur form of some matrix related to B, but will not, in
          general, be the same as T.
[out]Q
          Q is COMPLEX*16 array, dimension (LDQ, max(NN))
          The (left) unitary matrix computed by ZGEGS.
[in]LDQ
          LDQ is INTEGER
          The leading dimension of Q, Z, VL, and VR.  It must
          be at least 1 and at least max( NN ).
[out]Z
          Z is COMPLEX*16 array, dimension (LDQ, max(NN))
          The (right) unitary matrix computed by ZGEGS.
[out]ALPHA1
          ALPHA1 is COMPLEX*16 array, dimension (max(NN))
[out]BETA1
          BETA1 is COMPLEX*16 array, dimension (max(NN))

          The generalized eigenvalues of (A,B) computed by ZGEGS.
          ALPHA1(k) / BETA1(k)  is the k-th generalized eigenvalue of
          the matrices in A and B.
[out]ALPHA2
          ALPHA2 is COMPLEX*16 array, dimension (max(NN))
[out]BETA2
          BETA2 is COMPLEX*16 array, dimension (max(NN))

          The generalized eigenvalues of (A,B) computed by ZGEGV.
          ALPHA2(k) / BETA2(k)  is the k-th generalized eigenvalue of
          the matrices in A and B.
[out]VL
          VL is COMPLEX*16 array, dimension (LDQ, max(NN))
          The (lower triangular) left eigenvector matrix for the
          matrices in A and B.
[out]VR
          VR is COMPLEX*16 array, dimension (LDQ, max(NN))
          The (upper triangular) right eigenvector matrix for the
          matrices in A and B.
[out]WORK
          WORK is COMPLEX*16 array, dimension (LWORK)
[in]LWORK
          LWORK is INTEGER
          The number of entries in WORK.  This must be at least
          MAX( 2*N, N*(NB+1), (k+1)*(2*k+N+1) ), where "k" is the
          sum of the blocksize and number-of-shifts for ZHGEQZ, and
          NB is the greatest of the blocksizes for ZGEQRF, ZUNMQR,
          and ZUNGQR.  (The blocksizes and the number-of-shifts are
          retrieved through calls to ILAENV.)
[out]RWORK
          RWORK is DOUBLE PRECISION array, dimension (8*N)
[out]RESULT
          RESULT is DOUBLE PRECISION array, dimension (7)
          The values computed by the tests described above.
          The values are currently limited to 1/ulp, to avoid
          overflow.
[out]INFO
          INFO is INTEGER
          = 0:  successful exit
          < 0:  if INFO = -i, the i-th argument had an illegal value.
          > 0:  A routine returned an error code.  INFO is the
                absolute value of the INFO value returned.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
November 2011

Definition at line 424 of file zdrvgg.f.

424 *
425 * -- LAPACK test routine (version 3.4.0) --
426 * -- LAPACK is a software package provided by Univ. of Tennessee, --
427 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
428 * November 2011
429 *
430 * .. Scalar Arguments ..
431  INTEGER info, lda, ldq, lwork, nounit, nsizes, ntypes
432  DOUBLE PRECISION thresh, thrshn
433 * ..
434 * .. Array Arguments ..
435 *
436 * =====================================================================
437 *
438  LOGICAL dotype( * )
439  INTEGER iseed( 4 ), nn( * )
440  DOUBLE PRECISION result( * ), rwork( * )
441  COMPLEX*16 a( lda, * ), alpha1( * ), alpha2( * ),
442  $ b( lda, * ), beta1( * ), beta2( * ),
443  $ q( ldq, * ), s( lda, * ), s2( lda, * ),
444  $ t( lda, * ), t2( lda, * ), vl( ldq, * ),
445  $ vr( ldq, * ), work( * ), z( ldq, * )
446 * ..
447 * .. Parameters ..
448  DOUBLE PRECISION zero, one
449  parameter( zero = 0.0d+0, one = 1.0d+0 )
450  COMPLEX*16 czero, cone
451  parameter( czero = ( 0.0d+0, 0.0d+0 ),
452  $ cone = ( 1.0d+0, 0.0d+0 ) )
453  INTEGER maxtyp
454  parameter( maxtyp = 26 )
455 * ..
456 * .. Local Scalars ..
457  LOGICAL badnn
458  INTEGER i1, iadd, iinfo, in, j, jc, jr, jsize, jtype,
459  $ lwkopt, mtypes, n, n1, nb, nbz, nerrs, nmats,
460  $ nmax, ns, ntest, ntestt
461  DOUBLE PRECISION safmax, safmin, temp1, temp2, ulp, ulpinv
462  COMPLEX*16 ctemp, x
463 * ..
464 * .. Local Arrays ..
465  LOGICAL lasign( maxtyp ), lbsign( maxtyp )
466  INTEGER ioldsd( 4 ), kadd( 6 ), kamagn( maxtyp ),
467  $ katype( maxtyp ), kazero( maxtyp ),
468  $ kbmagn( maxtyp ), kbtype( maxtyp ),
469  $ kbzero( maxtyp ), kclass( maxtyp ),
470  $ ktrian( maxtyp ), kz1( 6 ), kz2( 6 )
471  DOUBLE PRECISION dumma( 4 ), rmagn( 0: 3 )
472 * ..
473 * .. External Functions ..
474  INTEGER ilaenv
475  DOUBLE PRECISION dlamch
476  COMPLEX*16 zlarnd
477  EXTERNAL ilaenv, dlamch, zlarnd
478 * ..
479 * .. External Subroutines ..
480  EXTERNAL alasvm, dlabad, xerbla, zgegs, zgegv, zget51,
482 * ..
483 * .. Intrinsic Functions ..
484  INTRINSIC abs, dble, dconjg, dimag, max, min, sign
485 * ..
486 * .. Statement Functions ..
487  DOUBLE PRECISION abs1
488 * ..
489 * .. Statement Function definitions ..
490  abs1( x ) = abs( dble( x ) ) + abs( dimag( x ) )
491 * ..
492 * .. Data statements ..
493  DATA kclass / 15*1, 10*2, 1*3 /
494  DATA kz1 / 0, 1, 2, 1, 3, 3 /
495  DATA kz2 / 0, 0, 1, 2, 1, 1 /
496  DATA kadd / 0, 0, 0, 0, 3, 2 /
497  DATA katype / 0, 1, 0, 1, 2, 3, 4, 1, 4, 4, 1, 1, 4,
498  $ 4, 4, 2, 4, 5, 8, 7, 9, 4*4, 0 /
499  DATA kbtype / 0, 0, 1, 1, 2, -3, 1, 4, 1, 1, 4, 4,
500  $ 1, 1, -4, 2, -4, 8*8, 0 /
501  DATA kazero / 6*1, 2, 1, 2*2, 2*1, 2*2, 3, 1, 3,
502  $ 4*5, 4*3, 1 /
503  DATA kbzero / 6*1, 1, 2, 2*1, 2*2, 2*1, 4, 1, 4,
504  $ 4*6, 4*4, 1 /
505  DATA kamagn / 8*1, 2, 3, 2, 3, 2, 3, 7*1, 2, 3, 3,
506  $ 2, 1 /
507  DATA kbmagn / 8*1, 3, 2, 3, 2, 2, 3, 7*1, 3, 2, 3,
508  $ 2, 1 /
509  DATA ktrian / 16*0, 10*1 /
510  DATA lasign / 6*.false., .true., .false., 2*.true.,
511  $ 2*.false., 3*.true., .false., .true.,
512  $ 3*.false., 5*.true., .false. /
513  DATA lbsign / 7*.false., .true., 2*.false.,
514  $ 2*.true., 2*.false., .true., .false., .true.,
515  $ 9*.false. /
516 * ..
517 * .. Executable Statements ..
518 *
519 * Check for errors
520 *
521  info = 0
522 *
523  badnn = .false.
524  nmax = 1
525  DO 10 j = 1, nsizes
526  nmax = max( nmax, nn( j ) )
527  IF( nn( j ).LT.0 )
528  $ badnn = .true.
529  10 CONTINUE
530 *
531 * Maximum blocksize and shift -- we assume that blocksize and number
532 * of shifts are monotone increasing functions of N.
533 *
534  nb = max( 1, ilaenv( 1, 'ZGEQRF', ' ', nmax, nmax, -1, -1 ),
535  $ ilaenv( 1, 'ZUNMQR', 'LC', nmax, nmax, nmax, -1 ),
536  $ ilaenv( 1, 'ZUNGQR', ' ', nmax, nmax, nmax, -1 ) )
537  nbz = ilaenv( 1, 'ZHGEQZ', 'SII', nmax, 1, nmax, 0 )
538  ns = ilaenv( 4, 'ZHGEQZ', 'SII', nmax, 1, nmax, 0 )
539  i1 = nbz + ns
540  lwkopt = max( 2*nmax, nmax*( nb+1 ), ( 2*i1+nmax+1 )*( i1+1 ) )
541 *
542 * Check for errors
543 *
544  IF( nsizes.LT.0 ) THEN
545  info = -1
546  ELSE IF( badnn ) THEN
547  info = -2
548  ELSE IF( ntypes.LT.0 ) THEN
549  info = -3
550  ELSE IF( thresh.LT.zero ) THEN
551  info = -6
552  ELSE IF( lda.LE.1 .OR. lda.LT.nmax ) THEN
553  info = -10
554  ELSE IF( ldq.LE.1 .OR. ldq.LT.nmax ) THEN
555  info = -19
556  ELSE IF( lwkopt.GT.lwork ) THEN
557  info = -30
558  END IF
559 *
560  IF( info.NE.0 ) THEN
561  CALL xerbla( 'ZDRVGG', -info )
562  RETURN
563  END IF
564 *
565 * Quick return if possible
566 *
567  IF( nsizes.EQ.0 .OR. ntypes.EQ.0 )
568  $ RETURN
569 *
570  ulp = dlamch( 'Precision' )
571  safmin = dlamch( 'Safe minimum' )
572  safmin = safmin / ulp
573  safmax = one / safmin
574  CALL dlabad( safmin, safmax )
575  ulpinv = one / ulp
576 *
577 * The values RMAGN(2:3) depend on N, see below.
578 *
579  rmagn( 0 ) = zero
580  rmagn( 1 ) = one
581 *
582 * Loop over sizes, types
583 *
584  ntestt = 0
585  nerrs = 0
586  nmats = 0
587 *
588  DO 160 jsize = 1, nsizes
589  n = nn( jsize )
590  n1 = max( 1, n )
591  rmagn( 2 ) = safmax*ulp / dble( n1 )
592  rmagn( 3 ) = safmin*ulpinv*n1
593 *
594  IF( nsizes.NE.1 ) THEN
595  mtypes = min( maxtyp, ntypes )
596  ELSE
597  mtypes = min( maxtyp+1, ntypes )
598  END IF
599 *
600  DO 150 jtype = 1, mtypes
601  IF( .NOT.dotype( jtype ) )
602  $ GO TO 150
603  nmats = nmats + 1
604  ntest = 0
605 *
606 * Save ISEED in case of an error.
607 *
608  DO 20 j = 1, 4
609  ioldsd( j ) = iseed( j )
610  20 CONTINUE
611 *
612 * Initialize RESULT
613 *
614  DO 30 j = 1, 7
615  result( j ) = zero
616  30 CONTINUE
617 *
618 * Compute A and B
619 *
620 * Description of control parameters:
621 *
622 * KZLASS: =1 means w/o rotation, =2 means w/ rotation,
623 * =3 means random.
624 * KATYPE: the "type" to be passed to ZLATM4 for computing A.
625 * KAZERO: the pattern of zeros on the diagonal for A:
626 * =1: ( xxx ), =2: (0, xxx ) =3: ( 0, 0, xxx, 0 ),
627 * =4: ( 0, xxx, 0, 0 ), =5: ( 0, 0, 1, xxx, 0 ),
628 * =6: ( 0, 1, 0, xxx, 0 ). (xxx means a string of
629 * non-zero entries.)
630 * KAMAGN: the magnitude of the matrix: =0: zero, =1: O(1),
631 * =2: large, =3: small.
632 * LASIGN: .TRUE. if the diagonal elements of A are to be
633 * multiplied by a random magnitude 1 number.
634 * KBTYPE, KBZERO, KBMAGN, IBSIGN: the same, but for B.
635 * KTRIAN: =0: don't fill in the upper triangle, =1: do.
636 * KZ1, KZ2, KADD: used to implement KAZERO and KBZERO.
637 * RMAGN: used to implement KAMAGN and KBMAGN.
638 *
639  IF( mtypes.GT.maxtyp )
640  $ GO TO 110
641  iinfo = 0
642  IF( kclass( jtype ).LT.3 ) THEN
643 *
644 * Generate A (w/o rotation)
645 *
646  IF( abs( katype( jtype ) ).EQ.3 ) THEN
647  in = 2*( ( n-1 ) / 2 ) + 1
648  IF( in.NE.n )
649  $ CALL zlaset( 'Full', n, n, czero, czero, a, lda )
650  ELSE
651  in = n
652  END IF
653  CALL zlatm4( katype( jtype ), in, kz1( kazero( jtype ) ),
654  $ kz2( kazero( jtype ) ), lasign( jtype ),
655  $ rmagn( kamagn( jtype ) ), ulp,
656  $ rmagn( ktrian( jtype )*kamagn( jtype ) ), 2,
657  $ iseed, a, lda )
658  iadd = kadd( kazero( jtype ) )
659  IF( iadd.GT.0 .AND. iadd.LE.n )
660  $ a( iadd, iadd ) = rmagn( kamagn( jtype ) )
661 *
662 * Generate B (w/o rotation)
663 *
664  IF( abs( kbtype( jtype ) ).EQ.3 ) THEN
665  in = 2*( ( n-1 ) / 2 ) + 1
666  IF( in.NE.n )
667  $ CALL zlaset( 'Full', n, n, czero, czero, b, lda )
668  ELSE
669  in = n
670  END IF
671  CALL zlatm4( kbtype( jtype ), in, kz1( kbzero( jtype ) ),
672  $ kz2( kbzero( jtype ) ), lbsign( jtype ),
673  $ rmagn( kbmagn( jtype ) ), one,
674  $ rmagn( ktrian( jtype )*kbmagn( jtype ) ), 2,
675  $ iseed, b, lda )
676  iadd = kadd( kbzero( jtype ) )
677  IF( iadd.NE.0 .AND. iadd.LE.n )
678  $ b( iadd, iadd ) = rmagn( kbmagn( jtype ) )
679 *
680  IF( kclass( jtype ).EQ.2 .AND. n.GT.0 ) THEN
681 *
682 * Include rotations
683 *
684 * Generate Q, Z as Householder transformations times
685 * a diagonal matrix.
686 *
687  DO 50 jc = 1, n - 1
688  DO 40 jr = jc, n
689  q( jr, jc ) = zlarnd( 3, iseed )
690  z( jr, jc ) = zlarnd( 3, iseed )
691  40 CONTINUE
692  CALL zlarfg( n+1-jc, q( jc, jc ), q( jc+1, jc ), 1,
693  $ work( jc ) )
694  work( 2*n+jc ) = sign( one, dble( q( jc, jc ) ) )
695  q( jc, jc ) = cone
696  CALL zlarfg( n+1-jc, z( jc, jc ), z( jc+1, jc ), 1,
697  $ work( n+jc ) )
698  work( 3*n+jc ) = sign( one, dble( z( jc, jc ) ) )
699  z( jc, jc ) = cone
700  50 CONTINUE
701  ctemp = zlarnd( 3, iseed )
702  q( n, n ) = cone
703  work( n ) = czero
704  work( 3*n ) = ctemp / abs( ctemp )
705  ctemp = zlarnd( 3, iseed )
706  z( n, n ) = cone
707  work( 2*n ) = czero
708  work( 4*n ) = ctemp / abs( ctemp )
709 *
710 * Apply the diagonal matrices
711 *
712  DO 70 jc = 1, n
713  DO 60 jr = 1, n
714  a( jr, jc ) = work( 2*n+jr )*
715  $ dconjg( work( 3*n+jc ) )*
716  $ a( jr, jc )
717  b( jr, jc ) = work( 2*n+jr )*
718  $ dconjg( work( 3*n+jc ) )*
719  $ b( jr, jc )
720  60 CONTINUE
721  70 CONTINUE
722  CALL zunm2r( 'L', 'N', n, n, n-1, q, ldq, work, a,
723  $ lda, work( 2*n+1 ), iinfo )
724  IF( iinfo.NE.0 )
725  $ GO TO 100
726  CALL zunm2r( 'R', 'C', n, n, n-1, z, ldq, work( n+1 ),
727  $ a, lda, work( 2*n+1 ), iinfo )
728  IF( iinfo.NE.0 )
729  $ GO TO 100
730  CALL zunm2r( 'L', 'N', n, n, n-1, q, ldq, work, b,
731  $ lda, work( 2*n+1 ), iinfo )
732  IF( iinfo.NE.0 )
733  $ GO TO 100
734  CALL zunm2r( 'R', 'C', n, n, n-1, z, ldq, work( n+1 ),
735  $ b, lda, work( 2*n+1 ), iinfo )
736  IF( iinfo.NE.0 )
737  $ GO TO 100
738  END IF
739  ELSE
740 *
741 * Random matrices
742 *
743  DO 90 jc = 1, n
744  DO 80 jr = 1, n
745  a( jr, jc ) = rmagn( kamagn( jtype ) )*
746  $ zlarnd( 4, iseed )
747  b( jr, jc ) = rmagn( kbmagn( jtype ) )*
748  $ zlarnd( 4, iseed )
749  80 CONTINUE
750  90 CONTINUE
751  END IF
752 *
753  100 CONTINUE
754 *
755  IF( iinfo.NE.0 ) THEN
756  WRITE( nounit, fmt = 9999 )'Generator', iinfo, n, jtype,
757  $ ioldsd
758  info = abs( iinfo )
759  RETURN
760  END IF
761 *
762  110 CONTINUE
763 *
764 * Call ZGEGS to compute H, T, Q, Z, alpha, and beta.
765 *
766  CALL zlacpy( ' ', n, n, a, lda, s, lda )
767  CALL zlacpy( ' ', n, n, b, lda, t, lda )
768  ntest = 1
769  result( 1 ) = ulpinv
770 *
771  CALL zgegs( 'V', 'V', n, s, lda, t, lda, alpha1, beta1, q,
772  $ ldq, z, ldq, work, lwork, rwork, iinfo )
773  IF( iinfo.NE.0 ) THEN
774  WRITE( nounit, fmt = 9999 )'ZGEGS', iinfo, n, jtype,
775  $ ioldsd
776  info = abs( iinfo )
777  GO TO 130
778  END IF
779 *
780  ntest = 4
781 *
782 * Do tests 1--4
783 *
784  CALL zget51( 1, n, a, lda, s, lda, q, ldq, z, ldq, work,
785  $ rwork, result( 1 ) )
786  CALL zget51( 1, n, b, lda, t, lda, q, ldq, z, ldq, work,
787  $ rwork, result( 2 ) )
788  CALL zget51( 3, n, b, lda, t, lda, q, ldq, q, ldq, work,
789  $ rwork, result( 3 ) )
790  CALL zget51( 3, n, b, lda, t, lda, z, ldq, z, ldq, work,
791  $ rwork, result( 4 ) )
792 *
793 * Do test 5: compare eigenvalues with diagonals.
794 *
795  temp1 = zero
796 *
797  DO 120 j = 1, n
798  temp2 = ( abs1( alpha1( j )-s( j, j ) ) /
799  $ max( safmin, abs1( alpha1( j ) ), abs1( s( j,
800  $ j ) ) )+abs1( beta1( j )-t( j, j ) ) /
801  $ max( safmin, abs1( beta1( j ) ), abs1( t( j,
802  $ j ) ) ) ) / ulp
803  temp1 = max( temp1, temp2 )
804  120 CONTINUE
805  result( 5 ) = temp1
806 *
807 * Call ZGEGV to compute S2, T2, VL, and VR, do tests.
808 *
809 * Eigenvalues and Eigenvectors
810 *
811  CALL zlacpy( ' ', n, n, a, lda, s2, lda )
812  CALL zlacpy( ' ', n, n, b, lda, t2, lda )
813  ntest = 6
814  result( 6 ) = ulpinv
815 *
816  CALL zgegv( 'V', 'V', n, s2, lda, t2, lda, alpha2, beta2,
817  $ vl, ldq, vr, ldq, work, lwork, rwork, iinfo )
818  IF( iinfo.NE.0 ) THEN
819  WRITE( nounit, fmt = 9999 )'ZGEGV', iinfo, n, jtype,
820  $ ioldsd
821  info = abs( iinfo )
822  GO TO 130
823  END IF
824 *
825  ntest = 7
826 *
827 * Do Tests 6 and 7
828 *
829  CALL zget52( .true., n, a, lda, b, lda, vl, ldq, alpha2,
830  $ beta2, work, rwork, dumma( 1 ) )
831  result( 6 ) = dumma( 1 )
832  IF( dumma( 2 ).GT.thrshn ) THEN
833  WRITE( nounit, fmt = 9998 )'Left', 'ZGEGV', dumma( 2 ),
834  $ n, jtype, ioldsd
835  END IF
836 *
837  CALL zget52( .false., n, a, lda, b, lda, vr, ldq, alpha2,
838  $ beta2, work, rwork, dumma( 1 ) )
839  result( 7 ) = dumma( 1 )
840  IF( dumma( 2 ).GT.thresh ) THEN
841  WRITE( nounit, fmt = 9998 )'Right', 'ZGEGV', dumma( 2 ),
842  $ n, jtype, ioldsd
843  END IF
844 *
845 * End of Loop -- Check for RESULT(j) > THRESH
846 *
847  130 CONTINUE
848 *
849  ntestt = ntestt + ntest
850 *
851 * Print out tests which fail.
852 *
853  DO 140 jr = 1, ntest
854  IF( result( jr ).GE.thresh ) THEN
855 *
856 * If this is the first test to fail,
857 * print a header to the data file.
858 *
859  IF( nerrs.EQ.0 ) THEN
860  WRITE( nounit, fmt = 9997 )'ZGG'
861 *
862 * Matrix types
863 *
864  WRITE( nounit, fmt = 9996 )
865  WRITE( nounit, fmt = 9995 )
866  WRITE( nounit, fmt = 9994 )'Unitary'
867 *
868 * Tests performed
869 *
870  WRITE( nounit, fmt = 9993 )'unitary', '*',
871  $ 'conjugate transpose', ( '*', j = 1, 5 )
872 *
873  END IF
874  nerrs = nerrs + 1
875  IF( result( jr ).LT.10000.0d0 ) THEN
876  WRITE( nounit, fmt = 9992 )n, jtype, ioldsd, jr,
877  $ result( jr )
878  ELSE
879  WRITE( nounit, fmt = 9991 )n, jtype, ioldsd, jr,
880  $ result( jr )
881  END IF
882  END IF
883  140 CONTINUE
884 *
885  150 CONTINUE
886  160 CONTINUE
887 *
888 * Summary
889 *
890  CALL alasvm( 'ZGG', nounit, nerrs, ntestt, 0 )
891  RETURN
892 *
893  9999 FORMAT( ' ZDRVGG: ', a, ' returned INFO=', i6, '.', / 9x, 'N=',
894  $ i6, ', JTYPE=', i6, ', ISEED=(', 3( i5, ',' ), i5, ')' )
895 *
896  9998 FORMAT( ' ZDRVGG: ', a, ' Eigenvectors from ', a, ' incorrectly ',
897  $ 'normalized.', / ' Bits of error=', 0p, g10.3, ',', 9x,
898  $ 'N=', i6, ', JTYPE=', i6, ', ISEED=(', 3( i5, ',' ), i5,
899  $ ')' )
900 *
901  9997 FORMAT( / 1x, a3,
902  $ ' -- Complex Generalized eigenvalue problem driver' )
903 *
904  9996 FORMAT( ' Matrix types (see ZDRVGG for details): ' )
905 *
906  9995 FORMAT( ' Special Matrices:', 23x,
907  $ '(J''=transposed Jordan block)',
908  $ / ' 1=(0,0) 2=(I,0) 3=(0,I) 4=(I,I) 5=(J'',J'') ',
909  $ '6=(diag(J'',I), diag(I,J''))', / ' Diagonal Matrices: ( ',
910  $ 'D=diag(0,1,2,...) )', / ' 7=(D,I) 9=(large*D, small*I',
911  $ ') 11=(large*I, small*D) 13=(large*D, large*I)', /
912  $ ' 8=(I,D) 10=(small*D, large*I) 12=(small*I, large*D) ',
913  $ ' 14=(small*D, small*I)', / ' 15=(D, reversed D)' )
914  9994 FORMAT( ' Matrices Rotated by Random ', a, ' Matrices U, V:',
915  $ / ' 16=Transposed Jordan Blocks 19=geometric ',
916  $ 'alpha, beta=0,1', / ' 17=arithm. alpha&beta ',
917  $ ' 20=arithmetic alpha, beta=0,1', / ' 18=clustered ',
918  $ 'alpha, beta=0,1 21=random alpha, beta=0,1',
919  $ / ' Large & Small Matrices:', / ' 22=(large, small) ',
920  $ '23=(small,large) 24=(small,small) 25=(large,large)',
921  $ / ' 26=random O(1) matrices.' )
922 *
923  9993 FORMAT( / ' Tests performed: (S is Schur, T is triangular, ',
924  $ 'Q and Z are ', a, ',', / 20x,
925  $ 'l and r are the appropriate left and right', / 19x,
926  $ 'eigenvectors, resp., a is alpha, b is beta, and', / 19x, a,
927  $ ' means ', a, '.)', / ' 1 = | A - Q S Z', a,
928  $ ' | / ( |A| n ulp ) 2 = | B - Q T Z', a,
929  $ ' | / ( |B| n ulp )', / ' 3 = | I - QQ', a,
930  $ ' | / ( n ulp ) 4 = | I - ZZ', a,
931  $ ' | / ( n ulp )', /
932  $ ' 5 = difference between (alpha,beta) and diagonals of',
933  $ ' (S,T)', / ' 6 = max | ( b A - a B )', a,
934  $ ' l | / const. 7 = max | ( b A - a B ) r | / const.',
935  $ / 1x )
936  9992 FORMAT( ' Matrix order=', i5, ', type=', i2, ', seed=',
937  $ 4( i4, ',' ), ' result ', i3, ' is', 0p, f8.2 )
938  9991 FORMAT( ' Matrix order=', i5, ', type=', i2, ', seed=',
939  $ 4( i4, ',' ), ' result ', i3, ' is', 1p, d10.3 )
940 *
941 * End of ZDRVGG
942 *
subroutine zget52(LEFT, N, A, LDA, B, LDB, E, LDE, ALPHA, BETA, WORK, RWORK, RESULT)
ZGET52
Definition: zget52.f:164
subroutine zgegv(JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHA, BETA, VL, LDVL, VR, LDVR, WORK, LWORK, RWORK, INFO)
ZGEEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices ...
Definition: zgegv.f:284
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
Definition: zlacpy.f:105
subroutine alasvm(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASVM
Definition: alasvm.f:75
subroutine zunm2r(SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, INFO)
ZUNM2R multiplies a general matrix by the unitary matrix from a QR factorization determined by cgeqrf...
Definition: zunm2r.f:161
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
subroutine dlabad(SMALL, LARGE)
DLABAD
Definition: dlabad.f:76
complex *16 function zlarnd(IDIST, ISEED)
ZLARND
Definition: zlarnd.f:77
subroutine zget51(ITYPE, N, A, LDA, B, LDB, U, LDU, V, LDV, WORK, RWORK, RESULT)
ZGET51
Definition: zget51.f:156
subroutine zlaset(UPLO, M, N, ALPHA, BETA, A, LDA)
ZLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
Definition: zlaset.f:108
subroutine zgegs(JOBVSL, JOBVSR, N, A, LDA, B, LDB, ALPHA, BETA, VSL, LDVSL, VSR, LDVSR, WORK, LWORK, RWORK, INFO)
ZGEEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices ...
Definition: zgegs.f:227
double precision function dlamch(CMACH)
DLAMCH
Definition: dlamch.f:65
subroutine zlatm4(ITYPE, N, NZ1, NZ2, RSIGN, AMAGN, RCOND, TRIANG, IDIST, ISEED, A, LDA)
ZLATM4
Definition: zlatm4.f:173
integer function ilaenv(ISPEC, NAME, OPTS, N1, N2, N3, N4)
Definition: tstiee.f:83
subroutine zlarfg(N, ALPHA, X, INCX, TAU)
ZLARFG generates an elementary reflector (Householder matrix).
Definition: zlarfg.f:108

Here is the call graph for this function:

Here is the caller graph for this function: