LAPACK  3.9.0
LAPACK: Linear Algebra PACKage

◆ ddrgvx()

subroutine ddrgvx ( integer  NSIZE,
double precision  THRESH,
integer  NIN,
integer  NOUT,
double precision, dimension( lda, * )  A,
integer  LDA,
double precision, dimension( lda, * )  B,
double precision, dimension( lda, * )  AI,
double precision, dimension( lda, * )  BI,
double precision, dimension( * )  ALPHAR,
double precision, dimension( * )  ALPHAI,
double precision, dimension( * )  BETA,
double precision, dimension( lda, * )  VL,
double precision, dimension( lda, * )  VR,
integer  ILO,
integer  IHI,
double precision, dimension( * )  LSCALE,
double precision, dimension( * )  RSCALE,
double precision, dimension( * )  S,
double precision, dimension( * )  DTRU,
double precision, dimension( * )  DIF,
double precision, dimension( * )  DIFTRU,
double precision, dimension( * )  WORK,
integer  LWORK,
integer, dimension( * )  IWORK,
integer  LIWORK,
double precision, dimension( 4 )  RESULT,
logical, dimension( * )  BWORK,
integer  INFO 
)

DDRGVX

Purpose:
 DDRGVX checks the nonsymmetric generalized eigenvalue problem
 expert driver DGGEVX.

 DGGEVX computes the generalized eigenvalues, (optionally) the left
 and/or right eigenvectors, (optionally) computes a balancing
 transformation to improve the conditioning, and (optionally)
 reciprocal condition numbers for the eigenvalues and eigenvectors.

 When DDRGVX is called with NSIZE > 0, two types of test matrix pairs
 are generated by the subroutine DLATM6 and test the driver DGGEVX.
 The test matrices have the known exact condition numbers for
 eigenvalues. For the condition numbers of the eigenvectors
 corresponding the first and last eigenvalues are also know
 ``exactly'' (see DLATM6).

 For each matrix pair, the following tests will be performed and
 compared with the threshold THRESH.

 (1) 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.

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

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

 (3) The condition number S(i) of eigenvalues computed by DGGEVX
     differs less than a factor THRESH from the exact S(i) (see
     DLATM6).

 (4) DIF(i) computed by DTGSNA differs less than a factor 10*THRESH
     from the exact value (for the 1st and 5th vectors only).

 Test Matrices
 =============

 Two kinds of test matrix pairs

          (A, B) = inverse(YH) * (Da, Db) * inverse(X)

 are used in the tests:

 1: Da = 1+a   0    0    0    0    Db = 1   0   0   0   0
          0   2+a   0    0    0         0   1   0   0   0
          0    0   3+a   0    0         0   0   1   0   0
          0    0    0   4+a   0         0   0   0   1   0
          0    0    0    0   5+a ,      0   0   0   0   1 , and

 2: Da =  1   -1    0    0    0    Db = 1   0   0   0   0
          1    1    0    0    0         0   1   0   0   0
          0    0    1    0    0         0   0   1   0   0
          0    0    0   1+a  1+b        0   0   0   1   0
          0    0    0  -1-b  1+a ,      0   0   0   0   1 .

 In both cases the same inverse(YH) and inverse(X) are used to compute
 (A, B), giving the exact eigenvectors to (A,B) as (YH, X):

 YH:  =  1    0   -y    y   -y    X =  1   0  -x  -x   x
         0    1   -y    y   -y         0   1   x  -x  -x
         0    0    1    0    0         0   0   1   0   0
         0    0    0    1    0         0   0   0   1   0
         0    0    0    0    1,        0   0   0   0   1 , where

 a, b, x and y will have all values independently of each other from
 { sqrt(sqrt(ULP)),  0.1,  1,  10,  1/sqrt(sqrt(ULP)) }.
Parameters
[in]NSIZE
          NSIZE is INTEGER
          The number of sizes of matrices to use.  NSIZE must be at
          least zero. If it is zero, no randomly generated matrices
          are tested, but any test matrices read from NIN will be
          tested.
[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]NIN
          NIN is INTEGER
          The FORTRAN unit number for reading in the data file of
          problems to solve.
[in]NOUT
          NOUT is INTEGER
          The FORTRAN unit number for printing out error messages
          (e.g., if a routine returns IINFO not equal to 0.)
[out]A
          A is DOUBLE PRECISION array, dimension (LDA, NSIZE)
          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, B, AI, BI, Ao, and Bo.
          It must be at least 1 and at least NSIZE.
[out]B
          B is DOUBLE PRECISION array, dimension (LDA, NSIZE)
          Used to hold the matrix whose eigenvalues are to be
          computed.  On exit, B contains the last matrix actually used.
[out]AI
          AI is DOUBLE PRECISION array, dimension (LDA, NSIZE)
          Copy of A, modified by DGGEVX.
[out]BI
          BI is DOUBLE PRECISION array, dimension (LDA, NSIZE)
          Copy of B, modified by DGGEVX.
[out]ALPHAR
          ALPHAR is DOUBLE PRECISION array, dimension (NSIZE)
[out]ALPHAI
          ALPHAI is DOUBLE PRECISION array, dimension (NSIZE)
[out]BETA
          BETA is DOUBLE PRECISION array, dimension (NSIZE)

          On exit, (ALPHAR + ALPHAI*i)/BETA are the eigenvalues.
[out]VL
          VL is DOUBLE PRECISION array, dimension (LDA, NSIZE)
          VL holds the left eigenvectors computed by DGGEVX.
[out]VR
          VR is DOUBLE PRECISION array, dimension (LDA, NSIZE)
          VR holds the right eigenvectors computed by DGGEVX.
[out]ILO
                ILO is INTEGER
[out]IHI
                IHI is INTEGER
[out]LSCALE
                LSCALE is DOUBLE PRECISION array, dimension (N)
[out]RSCALE
                RSCALE is DOUBLE PRECISION array, dimension (N)
[out]S
                S is DOUBLE PRECISION array, dimension (N)
[out]DTRU
                DTRU is DOUBLE PRECISION array, dimension (N)
[out]DIF
                DIF is DOUBLE PRECISION array, dimension (N)
[out]DIFTRU
                DIFTRU is DOUBLE PRECISION array, dimension (N)
[out]WORK
          WORK is DOUBLE PRECISION array, dimension (LWORK)
[in]LWORK
          LWORK is INTEGER
          Leading dimension of WORK.  LWORK >= 2*N*N+12*N+16.
[out]IWORK
          IWORK is INTEGER array, dimension (LIWORK)
[in]LIWORK
          LIWORK is INTEGER
          Leading dimension of IWORK.  Must be at least N+6.
[out]RESULT
                RESULT is DOUBLE PRECISION array, dimension (4)
[out]BWORK
          BWORK is LOGICAL array, dimension (N)
[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.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
April 2012

Definition at line 302 of file ddrgvx.f.

302 *
303 * -- LAPACK test routine (version 3.7.0) --
304 * -- LAPACK is a software package provided by Univ. of Tennessee, --
305 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
306 * April 2012
307 *
308 * .. Scalar Arguments ..
309  INTEGER IHI, ILO, INFO, LDA, LIWORK, LWORK, NIN, NOUT,
310  $ NSIZE
311  DOUBLE PRECISION THRESH
312 * ..
313 * .. Array Arguments ..
314  LOGICAL BWORK( * )
315  INTEGER IWORK( * )
316  DOUBLE PRECISION A( LDA, * ), AI( LDA, * ), ALPHAI( * ),
317  $ ALPHAR( * ), B( LDA, * ), BETA( * ),
318  $ BI( LDA, * ), DIF( * ), DIFTRU( * ), DTRU( * ),
319  $ LSCALE( * ), RESULT( 4 ), RSCALE( * ), S( * ),
320  $ VL( LDA, * ), VR( LDA, * ), WORK( * )
321 * ..
322 *
323 * =====================================================================
324 *
325 * .. Parameters ..
326  DOUBLE PRECISION ZERO, ONE, TEN, TNTH, HALF
327  parameter( zero = 0.0d+0, one = 1.0d+0, ten = 1.0d+1,
328  $ tnth = 1.0d-1, half = 0.5d+0 )
329 * ..
330 * .. Local Scalars ..
331  INTEGER I, IPTYPE, IWA, IWB, IWX, IWY, J, LINFO,
332  $ MAXWRK, MINWRK, N, NERRS, NMAX, NPTKNT, NTESTT
333  DOUBLE PRECISION ABNORM, ANORM, BNORM, RATIO1, RATIO2, THRSH2,
334  $ ULP, ULPINV
335 * ..
336 * .. Local Arrays ..
337  DOUBLE PRECISION WEIGHT( 5 )
338 * ..
339 * .. External Functions ..
340  INTEGER ILAENV
341  DOUBLE PRECISION DLAMCH, DLANGE
342  EXTERNAL ilaenv, dlamch, dlange
343 * ..
344 * .. External Subroutines ..
345  EXTERNAL alasvm, dget52, dggevx, dlacpy, dlatm6, xerbla
346 * ..
347 * .. Intrinsic Functions ..
348  INTRINSIC abs, max, sqrt
349 * ..
350 * .. Executable Statements ..
351 *
352 * Check for errors
353 *
354  info = 0
355 *
356  nmax = 5
357 *
358  IF( nsize.LT.0 ) THEN
359  info = -1
360  ELSE IF( thresh.LT.zero ) THEN
361  info = -2
362  ELSE IF( nin.LE.0 ) THEN
363  info = -3
364  ELSE IF( nout.LE.0 ) THEN
365  info = -4
366  ELSE IF( lda.LT.1 .OR. lda.LT.nmax ) THEN
367  info = -6
368  ELSE IF( liwork.LT.nmax+6 ) THEN
369  info = -26
370  END IF
371 *
372 * Compute workspace
373 * (Note: Comments in the code beginning "Workspace:" describe the
374 * minimal amount of workspace needed at that point in the code,
375 * as well as the preferred amount for good performance.
376 * NB refers to the optimal block size for the immediately
377 * following subroutine, as returned by ILAENV.)
378 *
379  minwrk = 1
380  IF( info.EQ.0 .AND. lwork.GE.1 ) THEN
381  minwrk = 2*nmax*nmax + 12*nmax + 16
382  maxwrk = 6*nmax + nmax*ilaenv( 1, 'DGEQRF', ' ', nmax, 1, nmax,
383  $ 0 )
384  maxwrk = max( maxwrk, 2*nmax*nmax+12*nmax+16 )
385  work( 1 ) = maxwrk
386  END IF
387 *
388  IF( lwork.LT.minwrk )
389  $ info = -24
390 *
391  IF( info.NE.0 ) THEN
392  CALL xerbla( 'DDRGVX', -info )
393  RETURN
394  END IF
395 *
396  n = 5
397  ulp = dlamch( 'P' )
398  ulpinv = one / ulp
399  thrsh2 = ten*thresh
400  nerrs = 0
401  nptknt = 0
402  ntestt = 0
403 *
404  IF( nsize.EQ.0 )
405  $ GO TO 90
406 *
407 * Parameters used for generating test matrices.
408 *
409  weight( 1 ) = tnth
410  weight( 2 ) = half
411  weight( 3 ) = one
412  weight( 4 ) = one / weight( 2 )
413  weight( 5 ) = one / weight( 1 )
414 *
415  DO 80 iptype = 1, 2
416  DO 70 iwa = 1, 5
417  DO 60 iwb = 1, 5
418  DO 50 iwx = 1, 5
419  DO 40 iwy = 1, 5
420 *
421 * generated a test matrix pair
422 *
423  CALL dlatm6( iptype, 5, a, lda, b, vr, lda, vl,
424  $ lda, weight( iwa ), weight( iwb ),
425  $ weight( iwx ), weight( iwy ), dtru,
426  $ diftru )
427 *
428 * Compute eigenvalues/eigenvectors of (A, B).
429 * Compute eigenvalue/eigenvector condition numbers
430 * using computed eigenvectors.
431 *
432  CALL dlacpy( 'F', n, n, a, lda, ai, lda )
433  CALL dlacpy( 'F', n, n, b, lda, bi, lda )
434 *
435  CALL dggevx( 'N', 'V', 'V', 'B', n, ai, lda, bi,
436  $ lda, alphar, alphai, beta, vl, lda,
437  $ vr, lda, ilo, ihi, lscale, rscale,
438  $ anorm, bnorm, s, dif, work, lwork,
439  $ iwork, bwork, linfo )
440  IF( linfo.NE.0 ) THEN
441  result( 1 ) = ulpinv
442  WRITE( nout, fmt = 9999 )'DGGEVX', linfo, n,
443  $ iptype
444  GO TO 30
445  END IF
446 *
447 * Compute the norm(A, B)
448 *
449  CALL dlacpy( 'Full', n, n, ai, lda, work, n )
450  CALL dlacpy( 'Full', n, n, bi, lda, work( n*n+1 ),
451  $ n )
452  abnorm = dlange( 'Fro', n, 2*n, work, n, work )
453 *
454 * Tests (1) and (2)
455 *
456  result( 1 ) = zero
457  CALL dget52( .true., n, a, lda, b, lda, vl, lda,
458  $ alphar, alphai, beta, work,
459  $ result( 1 ) )
460  IF( result( 2 ).GT.thresh ) THEN
461  WRITE( nout, fmt = 9998 )'Left', 'DGGEVX',
462  $ result( 2 ), n, iptype, iwa, iwb, iwx, iwy
463  END IF
464 *
465  result( 2 ) = zero
466  CALL dget52( .false., n, a, lda, b, lda, vr, lda,
467  $ alphar, alphai, beta, work,
468  $ result( 2 ) )
469  IF( result( 3 ).GT.thresh ) THEN
470  WRITE( nout, fmt = 9998 )'Right', 'DGGEVX',
471  $ result( 3 ), n, iptype, iwa, iwb, iwx, iwy
472  END IF
473 *
474 * Test (3)
475 *
476  result( 3 ) = zero
477  DO 10 i = 1, n
478  IF( s( i ).EQ.zero ) THEN
479  IF( dtru( i ).GT.abnorm*ulp )
480  $ result( 3 ) = ulpinv
481  ELSE IF( dtru( i ).EQ.zero ) THEN
482  IF( s( i ).GT.abnorm*ulp )
483  $ result( 3 ) = ulpinv
484  ELSE
485  work( i ) = max( abs( dtru( i ) / s( i ) ),
486  $ abs( s( i ) / dtru( i ) ) )
487  result( 3 ) = max( result( 3 ), work( i ) )
488  END IF
489  10 CONTINUE
490 *
491 * Test (4)
492 *
493  result( 4 ) = zero
494  IF( dif( 1 ).EQ.zero ) THEN
495  IF( diftru( 1 ).GT.abnorm*ulp )
496  $ result( 4 ) = ulpinv
497  ELSE IF( diftru( 1 ).EQ.zero ) THEN
498  IF( dif( 1 ).GT.abnorm*ulp )
499  $ result( 4 ) = ulpinv
500  ELSE IF( dif( 5 ).EQ.zero ) THEN
501  IF( diftru( 5 ).GT.abnorm*ulp )
502  $ result( 4 ) = ulpinv
503  ELSE IF( diftru( 5 ).EQ.zero ) THEN
504  IF( dif( 5 ).GT.abnorm*ulp )
505  $ result( 4 ) = ulpinv
506  ELSE
507  ratio1 = max( abs( diftru( 1 ) / dif( 1 ) ),
508  $ abs( dif( 1 ) / diftru( 1 ) ) )
509  ratio2 = max( abs( diftru( 5 ) / dif( 5 ) ),
510  $ abs( dif( 5 ) / diftru( 5 ) ) )
511  result( 4 ) = max( ratio1, ratio2 )
512  END IF
513 *
514  ntestt = ntestt + 4
515 *
516 * Print out tests which fail.
517 *
518  DO 20 j = 1, 4
519  IF( ( result( j ).GE.thrsh2 .AND. j.GE.4 ) .OR.
520  $ ( result( j ).GE.thresh .AND. j.LE.3 ) )
521  $ THEN
522 *
523 * If this is the first test to fail,
524 * print a header to the data file.
525 *
526  IF( nerrs.EQ.0 ) THEN
527  WRITE( nout, fmt = 9997 )'DXV'
528 *
529 * Print out messages for built-in examples
530 *
531 * Matrix types
532 *
533  WRITE( nout, fmt = 9995 )
534  WRITE( nout, fmt = 9994 )
535  WRITE( nout, fmt = 9993 )
536 *
537 * Tests performed
538 *
539  WRITE( nout, fmt = 9992 )'''',
540  $ 'transpose', ''''
541 *
542  END IF
543  nerrs = nerrs + 1
544  IF( result( j ).LT.10000.0d0 ) THEN
545  WRITE( nout, fmt = 9991 )iptype, iwa,
546  $ iwb, iwx, iwy, j, result( j )
547  ELSE
548  WRITE( nout, fmt = 9990 )iptype, iwa,
549  $ iwb, iwx, iwy, j, result( j )
550  END IF
551  END IF
552  20 CONTINUE
553 *
554  30 CONTINUE
555 *
556  40 CONTINUE
557  50 CONTINUE
558  60 CONTINUE
559  70 CONTINUE
560  80 CONTINUE
561 *
562  GO TO 150
563 *
564  90 CONTINUE
565 *
566 * Read in data from file to check accuracy of condition estimation
567 * Read input data until N=0
568 *
569  READ( nin, fmt = *, END = 150 )n
570  IF( n.EQ.0 )
571  $ GO TO 150
572  DO 100 i = 1, n
573  READ( nin, fmt = * )( a( i, j ), j = 1, n )
574  100 CONTINUE
575  DO 110 i = 1, n
576  READ( nin, fmt = * )( b( i, j ), j = 1, n )
577  110 CONTINUE
578  READ( nin, fmt = * )( dtru( i ), i = 1, n )
579  READ( nin, fmt = * )( diftru( i ), i = 1, n )
580 *
581  nptknt = nptknt + 1
582 *
583 * Compute eigenvalues/eigenvectors of (A, B).
584 * Compute eigenvalue/eigenvector condition numbers
585 * using computed eigenvectors.
586 *
587  CALL dlacpy( 'F', n, n, a, lda, ai, lda )
588  CALL dlacpy( 'F', n, n, b, lda, bi, lda )
589 *
590  CALL dggevx( 'N', 'V', 'V', 'B', n, ai, lda, bi, lda, alphar,
591  $ alphai, beta, vl, lda, vr, lda, ilo, ihi, lscale,
592  $ rscale, anorm, bnorm, s, dif, work, lwork, iwork,
593  $ bwork, linfo )
594 *
595  IF( linfo.NE.0 ) THEN
596  result( 1 ) = ulpinv
597  WRITE( nout, fmt = 9987 )'DGGEVX', linfo, n, nptknt
598  GO TO 140
599  END IF
600 *
601 * Compute the norm(A, B)
602 *
603  CALL dlacpy( 'Full', n, n, ai, lda, work, n )
604  CALL dlacpy( 'Full', n, n, bi, lda, work( n*n+1 ), n )
605  abnorm = dlange( 'Fro', n, 2*n, work, n, work )
606 *
607 * Tests (1) and (2)
608 *
609  result( 1 ) = zero
610  CALL dget52( .true., n, a, lda, b, lda, vl, lda, alphar, alphai,
611  $ beta, work, result( 1 ) )
612  IF( result( 2 ).GT.thresh ) THEN
613  WRITE( nout, fmt = 9986 )'Left', 'DGGEVX', result( 2 ), n,
614  $ nptknt
615  END IF
616 *
617  result( 2 ) = zero
618  CALL dget52( .false., n, a, lda, b, lda, vr, lda, alphar, alphai,
619  $ beta, work, result( 2 ) )
620  IF( result( 3 ).GT.thresh ) THEN
621  WRITE( nout, fmt = 9986 )'Right', 'DGGEVX', result( 3 ), n,
622  $ nptknt
623  END IF
624 *
625 * Test (3)
626 *
627  result( 3 ) = zero
628  DO 120 i = 1, n
629  IF( s( i ).EQ.zero ) THEN
630  IF( dtru( i ).GT.abnorm*ulp )
631  $ result( 3 ) = ulpinv
632  ELSE IF( dtru( i ).EQ.zero ) THEN
633  IF( s( i ).GT.abnorm*ulp )
634  $ result( 3 ) = ulpinv
635  ELSE
636  work( i ) = max( abs( dtru( i ) / s( i ) ),
637  $ abs( s( i ) / dtru( i ) ) )
638  result( 3 ) = max( result( 3 ), work( i ) )
639  END IF
640  120 CONTINUE
641 *
642 * Test (4)
643 *
644  result( 4 ) = zero
645  IF( dif( 1 ).EQ.zero ) THEN
646  IF( diftru( 1 ).GT.abnorm*ulp )
647  $ result( 4 ) = ulpinv
648  ELSE IF( diftru( 1 ).EQ.zero ) THEN
649  IF( dif( 1 ).GT.abnorm*ulp )
650  $ result( 4 ) = ulpinv
651  ELSE IF( dif( 5 ).EQ.zero ) THEN
652  IF( diftru( 5 ).GT.abnorm*ulp )
653  $ result( 4 ) = ulpinv
654  ELSE IF( diftru( 5 ).EQ.zero ) THEN
655  IF( dif( 5 ).GT.abnorm*ulp )
656  $ result( 4 ) = ulpinv
657  ELSE
658  ratio1 = max( abs( diftru( 1 ) / dif( 1 ) ),
659  $ abs( dif( 1 ) / diftru( 1 ) ) )
660  ratio2 = max( abs( diftru( 5 ) / dif( 5 ) ),
661  $ abs( dif( 5 ) / diftru( 5 ) ) )
662  result( 4 ) = max( ratio1, ratio2 )
663  END IF
664 *
665  ntestt = ntestt + 4
666 *
667 * Print out tests which fail.
668 *
669  DO 130 j = 1, 4
670  IF( result( j ).GE.thrsh2 ) THEN
671 *
672 * If this is the first test to fail,
673 * print a header to the data file.
674 *
675  IF( nerrs.EQ.0 ) THEN
676  WRITE( nout, fmt = 9997 )'DXV'
677 *
678 * Print out messages for built-in examples
679 *
680 * Matrix types
681 *
682  WRITE( nout, fmt = 9996 )
683 *
684 * Tests performed
685 *
686  WRITE( nout, fmt = 9992 )'''', 'transpose', ''''
687 *
688  END IF
689  nerrs = nerrs + 1
690  IF( result( j ).LT.10000.0d0 ) THEN
691  WRITE( nout, fmt = 9989 )nptknt, n, j, result( j )
692  ELSE
693  WRITE( nout, fmt = 9988 )nptknt, n, j, result( j )
694  END IF
695  END IF
696  130 CONTINUE
697 *
698  140 CONTINUE
699 *
700  GO TO 90
701  150 CONTINUE
702 *
703 * Summary
704 *
705  CALL alasvm( 'DXV', nout, nerrs, ntestt, 0 )
706 *
707  work( 1 ) = maxwrk
708 *
709  RETURN
710 *
711  9999 FORMAT( ' DDRGVX: ', a, ' returned INFO=', i6, '.', / 9x, 'N=',
712  $ i6, ', JTYPE=', i6, ')' )
713 *
714  9998 FORMAT( ' DDRGVX: ', a, ' Eigenvectors from ', a, ' incorrectly ',
715  $ 'normalized.', / ' Bits of error=', 0p, g10.3, ',', 9x,
716  $ 'N=', i6, ', JTYPE=', i6, ', IWA=', i5, ', IWB=', i5,
717  $ ', IWX=', i5, ', IWY=', i5 )
718 *
719  9997 FORMAT( / 1x, a3, ' -- Real Expert Eigenvalue/vector',
720  $ ' problem driver' )
721 *
722  9996 FORMAT( ' Input Example' )
723 *
724  9995 FORMAT( ' Matrix types: ', / )
725 *
726  9994 FORMAT( ' TYPE 1: Da is diagonal, Db is identity, ',
727  $ / ' A = Y^(-H) Da X^(-1), B = Y^(-H) Db X^(-1) ',
728  $ / ' YH and X are left and right eigenvectors. ', / )
729 *
730  9993 FORMAT( ' TYPE 2: Da is quasi-diagonal, Db is identity, ',
731  $ / ' A = Y^(-H) Da X^(-1), B = Y^(-H) Db X^(-1) ',
732  $ / ' YH and X are left and right eigenvectors. ', / )
733 *
734  9992 FORMAT( / ' Tests performed: ', / 4x,
735  $ ' a is alpha, b is beta, l is a left eigenvector, ', / 4x,
736  $ ' r is a right eigenvector and ', a, ' means ', a, '.',
737  $ / ' 1 = max | ( b A - a B )', a, ' l | / const.',
738  $ / ' 2 = max | ( b A - a B ) r | / const.',
739  $ / ' 3 = max ( Sest/Stru, Stru/Sest ) ',
740  $ ' over all eigenvalues', /
741  $ ' 4 = max( DIFest/DIFtru, DIFtru/DIFest ) ',
742  $ ' over the 1st and 5th eigenvectors', / )
743 *
744  9991 FORMAT( ' Type=', i2, ',', ' IWA=', i2, ', IWB=', i2, ', IWX=',
745  $ i2, ', IWY=', i2, ', result ', i2, ' is', 0p, f8.2 )
746  9990 FORMAT( ' Type=', i2, ',', ' IWA=', i2, ', IWB=', i2, ', IWX=',
747  $ i2, ', IWY=', i2, ', result ', i2, ' is', 1p, d10.3 )
748  9989 FORMAT( ' Input example #', i2, ', matrix order=', i4, ',',
749  $ ' result ', i2, ' is', 0p, f8.2 )
750  9988 FORMAT( ' Input example #', i2, ', matrix order=', i4, ',',
751  $ ' result ', i2, ' is', 1p, d10.3 )
752  9987 FORMAT( ' DDRGVX: ', a, ' returned INFO=', i6, '.', / 9x, 'N=',
753  $ i6, ', Input example #', i2, ')' )
754 *
755  9986 FORMAT( ' DDRGVX: ', a, ' Eigenvectors from ', a, ' incorrectly ',
756  $ 'normalized.', / ' Bits of error=', 0p, g10.3, ',', 9x,
757  $ 'N=', i6, ', Input Example #', i2, ')' )
758 *
759 *
760 * End of DDRGVX
761 *
Here is the call graph for this function:
Here is the caller graph for this function:
alasvm
subroutine alasvm(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASVM
Definition: alasvm.f:75
dlatm6
subroutine dlatm6(TYPE, N, A, LDA, B, X, LDX, Y, LDY, ALPHA, BETA, WX, WY, S, DIF)
DLATM6
Definition: dlatm6.f:178
dlange
double precision function dlange(NORM, M, N, A, LDA, WORK)
DLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
Definition: dlange.f:116
xerbla
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
ilaenv
integer function ilaenv(ISPEC, NAME, OPTS, N1, N2, N3, N4)
ILAENV
Definition: tstiee.f:83
dggevx
subroutine dggevx(BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, B, LDB, ALPHAR, ALPHAI, BETA, VL, LDVL, VR, LDVR, ILO, IHI, LSCALE, RSCALE, ABNRM, BBNRM, RCONDE, RCONDV, WORK, LWORK, IWORK, BWORK, INFO)
DGGEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices
Definition: dggevx.f:393
dlamch
double precision function dlamch(CMACH)
DLAMCH
Definition: dlamch.f:70
dlacpy
subroutine dlacpy(UPLO, M, N, A, LDA, B, LDB)
DLACPY copies all or part of one two-dimensional array to another.
Definition: dlacpy.f:105
dget52
subroutine dget52(LEFT, N, A, LDA, B, LDB, E, LDE, ALPHAR, ALPHAI, BETA, WORK, RESULT)
DGET52
Definition: dget52.f:201