1*> \brief \b SDRGVX
2*
3*  =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6*            http://www.netlib.org/lapack/explore-html/
7*
8*  Definition:
9*  ===========
10*
11*       SUBROUTINE SDRGVX( NSIZE, THRESH, NIN, NOUT, A, LDA, B, AI, BI,
12*                          ALPHAR, ALPHAI, BETA, VL, VR, ILO, IHI, LSCALE,
13*                          RSCALE, S, STRU, DIF, DIFTRU, WORK, LWORK,
14*                          IWORK, LIWORK, RESULT, BWORK, INFO )
15*
16*       .. Scalar Arguments ..
17*       INTEGER            IHI, ILO, INFO, LDA, LIWORK, LWORK, NIN, NOUT,
18*      $                   NSIZE
19*       REAL               THRESH
20*       ..
21*       .. Array Arguments ..
22*       LOGICAL            BWORK( * )
23*       INTEGER            IWORK( * )
24*       REAL               A( LDA, * ), AI( LDA, * ), ALPHAI( * ),
25*      $                   ALPHAR( * ), B( LDA, * ), BETA( * ),
26*      $                   BI( LDA, * ), DIF( * ), DIFTRU( * ),
27*      $                   LSCALE( * ), RESULT( 4 ), RSCALE( * ), S( * ),
28*      $                   STRU( * ), VL( LDA, * ), VR( LDA, * ),
29*      $                   WORK( * )
30*       ..
31*
32*
33*> \par Purpose:
34*  =============
35*>
36*> \verbatim
37*>
38*> SDRGVX checks the nonsymmetric generalized eigenvalue problem
39*> expert driver SGGEVX.
40*>
41*> SGGEVX computes the generalized eigenvalues, (optionally) the left
42*> and/or right eigenvectors, (optionally) computes a balancing
43*> transformation to improve the conditioning, and (optionally)
44*> reciprocal condition numbers for the eigenvalues and eigenvectors.
45*>
46*> When SDRGVX is called with NSIZE > 0, two types of test matrix pairs
47*> are generated by the subroutine SLATM6 and test the driver SGGEVX.
48*> The test matrices have the known exact condition numbers for
49*> eigenvalues. For the condition numbers of the eigenvectors
50*> corresponding the first and last eigenvalues are also know
51*> ``exactly'' (see SLATM6).
52*>
53*> For each matrix pair, the following tests will be performed and
54*> compared with the threshold THRESH.
55*>
56*> (1) max over all left eigenvalue/-vector pairs (beta/alpha,l) of
57*>
58*>    | l**H * (beta A - alpha B) | / ( ulp max( |beta A|, |alpha B| ) )
59*>
60*>     where l**H is the conjugate tranpose of l.
61*>
62*> (2) max over all right eigenvalue/-vector pairs (beta/alpha,r) of
63*>
64*>       | (beta A - alpha B) r | / ( ulp max( |beta A|, |alpha B| ) )
65*>
66*> (3) The condition number S(i) of eigenvalues computed by SGGEVX
67*>     differs less than a factor THRESH from the exact S(i) (see
68*>     SLATM6).
69*>
70*> (4) DIF(i) computed by STGSNA differs less than a factor 10*THRESH
71*>     from the exact value (for the 1st and 5th vectors only).
72*>
73*> Test Matrices
74*> =============
75*>
76*> Two kinds of test matrix pairs
77*>
78*>          (A, B) = inverse(YH) * (Da, Db) * inverse(X)
79*>
80*> are used in the tests:
81*>
82*> 1: Da = 1+a   0    0    0    0    Db = 1   0   0   0   0
83*>          0   2+a   0    0    0         0   1   0   0   0
84*>          0    0   3+a   0    0         0   0   1   0   0
85*>          0    0    0   4+a   0         0   0   0   1   0
86*>          0    0    0    0   5+a ,      0   0   0   0   1 , and
87*>
88*> 2: Da =  1   -1    0    0    0    Db = 1   0   0   0   0
89*>          1    1    0    0    0         0   1   0   0   0
90*>          0    0    1    0    0         0   0   1   0   0
91*>          0    0    0   1+a  1+b        0   0   0   1   0
92*>          0    0    0  -1-b  1+a ,      0   0   0   0   1 .
93*>
94*> In both cases the same inverse(YH) and inverse(X) are used to compute
95*> (A, B), giving the exact eigenvectors to (A,B) as (YH, X):
96*>
97*> YH:  =  1    0   -y    y   -y    X =  1   0  -x  -x   x
98*>         0    1   -y    y   -y         0   1   x  -x  -x
99*>         0    0    1    0    0         0   0   1   0   0
100*>         0    0    0    1    0         0   0   0   1   0
101*>         0    0    0    0    1,        0   0   0   0   1 , where
102*>
103*> a, b, x and y will have all values independently of each other from
104*> { sqrt(sqrt(ULP)),  0.1,  1,  10,  1/sqrt(sqrt(ULP)) }.
105*> \endverbatim
106*
107*  Arguments:
108*  ==========
109*
110*> \param[in] NSIZE
111*> \verbatim
112*>          NSIZE is INTEGER
113*>          The number of sizes of matrices to use.  NSIZE must be at
114*>          least zero. If it is zero, no randomly generated matrices
115*>          are tested, but any test matrices read from NIN will be
116*>          tested.
117*> \endverbatim
118*>
119*> \param[in] THRESH
120*> \verbatim
121*>          THRESH is REAL
122*>          A test will count as "failed" if the "error", computed as
123*>          described above, exceeds THRESH.  Note that the error
124*>          is scaled to be O(1), so THRESH should be a reasonably
125*>          small multiple of 1, e.g., 10 or 100.  In particular,
126*>          it should not depend on the precision (single vs. double)
127*>          or the size of the matrix.  It must be at least zero.
128*> \endverbatim
129*>
130*> \param[in] NIN
131*> \verbatim
132*>          NIN is INTEGER
133*>          The FORTRAN unit number for reading in the data file of
134*>          problems to solve.
135*> \endverbatim
136*>
137*> \param[in] NOUT
138*> \verbatim
139*>          NOUT is INTEGER
140*>          The FORTRAN unit number for printing out error messages
141*>          (e.g., if a routine returns IINFO not equal to 0.)
142*> \endverbatim
143*>
144*> \param[out] A
145*> \verbatim
146*>          A is REAL array, dimension (LDA, NSIZE)
147*>          Used to hold the matrix whose eigenvalues are to be
148*>          computed.  On exit, A contains the last matrix actually used.
149*> \endverbatim
150*>
151*> \param[in] LDA
152*> \verbatim
153*>          LDA is INTEGER
154*>          The leading dimension of A, B, AI, BI, Ao, and Bo.
155*>          It must be at least 1 and at least NSIZE.
156*> \endverbatim
157*>
158*> \param[out] B
159*> \verbatim
160*>          B is REAL array, dimension (LDA, NSIZE)
161*>          Used to hold the matrix whose eigenvalues are to be
162*>          computed.  On exit, B contains the last matrix actually used.
163*> \endverbatim
164*>
165*> \param[out] AI
166*> \verbatim
167*>          AI is REAL array, dimension (LDA, NSIZE)
168*>          Copy of A, modified by SGGEVX.
169*> \endverbatim
170*>
171*> \param[out] BI
172*> \verbatim
173*>          BI is REAL array, dimension (LDA, NSIZE)
174*>          Copy of B, modified by SGGEVX.
175*> \endverbatim
176*>
177*> \param[out] ALPHAR
178*> \verbatim
179*>          ALPHAR is REAL array, dimension (NSIZE)
180*> \endverbatim
181*>
182*> \param[out] ALPHAI
183*> \verbatim
184*>          ALPHAI is REAL array, dimension (NSIZE)
185*> \endverbatim
186*>
187*> \param[out] BETA
188*> \verbatim
189*>          BETA is REAL array, dimension (NSIZE)
190*>
191*>          On exit, (ALPHAR + ALPHAI*i)/BETA are the eigenvalues.
192*> \endverbatim
193*>
194*> \param[out] VL
195*> \verbatim
196*>          VL is REAL array, dimension (LDA, NSIZE)
197*>          VL holds the left eigenvectors computed by SGGEVX.
198*> \endverbatim
199*>
200*> \param[out] VR
201*> \verbatim
202*>          VR is REAL array, dimension (LDA, NSIZE)
203*>          VR holds the right eigenvectors computed by SGGEVX.
204*> \endverbatim
205*>
206*> \param[out] ILO
207*> \verbatim
208*>  		ILO is INTEGER
209*> \endverbatim
210*>
211*> \param[out] IHI
212*> \verbatim
213*>  		IHI is INTEGER
214*> \endverbatim
215*>
216*> \param[out] LSCALE
217*> \verbatim
218*>  		LSCALE is REAL array, dimension (N)
219*> \endverbatim
220*>
221*> \param[out] RSCALE
222*> \verbatim
223*>  		RSCALE is REAL array, dimension (N)
224*> \endverbatim
225*>
226*> \param[out] S
227*> \verbatim
228*>  		S is REAL array, dimension (N)
229*> \endverbatim
230*>
231*> \param[out] STRU
232*> \verbatim
233*>  		STRU is REAL array, dimension (N)
234*> \endverbatim
235*>
236*> \param[out] DIF
237*> \verbatim
238*>  		DIF is REAL array, dimension (N)
239*> \endverbatim
240*>
241*> \param[out] DIFTRU
242*> \verbatim
243*>  		DIFTRU is REAL array, dimension (N)
244*> \endverbatim
245*>
246*> \param[out] WORK
247*> \verbatim
248*>          WORK is REAL array, dimension (LWORK)
249*> \endverbatim
250*>
251*> \param[in] LWORK
252*> \verbatim
253*>          LWORK is INTEGER
254*>          Leading dimension of WORK.  LWORK >= 2*N*N+12*N+16.
255*> \endverbatim
256*>
257*> \param[out] IWORK
258*> \verbatim
259*>          IWORK is INTEGER array, dimension (LIWORK)
260*> \endverbatim
261*>
262*> \param[in] LIWORK
263*> \verbatim
264*>          LIWORK is INTEGER
265*>          Leading dimension of IWORK.  Must be at least N+6.
266*> \endverbatim
267*>
268*> \param[out] RESULT
269*> \verbatim
270*>  		RESULT is REAL array, dimension (4)
271*> \endverbatim
272*>
273*> \param[out] BWORK
274*> \verbatim
275*>          BWORK is LOGICAL array, dimension (N)
276*> \endverbatim
277*>
278*> \param[out] INFO
279*> \verbatim
280*>          INFO is INTEGER
281*>          = 0:  successful exit
282*>          < 0:  if INFO = -i, the i-th argument had an illegal value.
283*>          > 0:  A routine returned an error code.
284*> \endverbatim
285*
286*  Authors:
287*  ========
288*
289*> \author Univ. of Tennessee
290*> \author Univ. of California Berkeley
291*> \author Univ. of Colorado Denver
292*> \author NAG Ltd.
293*
294*> \ingroup single_eig
295*
296*  =====================================================================
297      SUBROUTINE SDRGVX( NSIZE, THRESH, NIN, NOUT, A, LDA, B, AI, BI,
298     $                   ALPHAR, ALPHAI, BETA, VL, VR, ILO, IHI, LSCALE,
299     $                   RSCALE, S, STRU, DIF, DIFTRU, WORK, LWORK,
300     $                   IWORK, LIWORK, RESULT, BWORK, INFO )
301*
302*  -- LAPACK test routine --
303*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
304*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
305*
306*     .. Scalar Arguments ..
307      INTEGER            IHI, ILO, INFO, LDA, LIWORK, LWORK, NIN, NOUT,
308     $                   NSIZE
309      REAL               THRESH
310*     ..
311*     .. Array Arguments ..
312      LOGICAL            BWORK( * )
313      INTEGER            IWORK( * )
314      REAL               A( LDA, * ), AI( LDA, * ), ALPHAI( * ),
315     $                   ALPHAR( * ), B( LDA, * ), BETA( * ),
316     $                   BI( LDA, * ), DIF( * ), DIFTRU( * ),
317     $                   LSCALE( * ), RESULT( 4 ), RSCALE( * ), S( * ),
318     $                   STRU( * ), VL( LDA, * ), VR( LDA, * ),
319     $                   WORK( * )
320*     ..
321*
322*  =====================================================================
323*
324*     .. Parameters ..
325      REAL               ZERO, ONE, TEN, TNTH, HALF
326      PARAMETER          ( ZERO = 0.0E+0, ONE = 1.0E+0, TEN = 1.0E+1,
327     $                   TNTH = 1.0E-1, HALF = 0.5D+0 )
328*     ..
329*     .. Local Scalars ..
330      INTEGER            I, IPTYPE, IWA, IWB, IWX, IWY, J, LINFO,
331     $                   MAXWRK, MINWRK, N, NERRS, NMAX, NPTKNT, NTESTT
332      REAL               ABNORM, ANORM, BNORM, RATIO1, RATIO2, THRSH2,
333     $                   ULP, ULPINV
334*     ..
335*     .. Local Arrays ..
336      REAL               WEIGHT( 5 )
337*     ..
338*     .. External Functions ..
339      INTEGER            ILAENV
340      REAL               SLAMCH, SLANGE
341      EXTERNAL           ILAENV, SLAMCH, SLANGE
342*     ..
343*     .. External Subroutines ..
344      EXTERNAL           ALASVM, SGET52, SGGEVX, SLACPY, SLATM6, XERBLA
345*     ..
346*     .. Intrinsic Functions ..
347      INTRINSIC          ABS, MAX, SQRT
348*     ..
349*     .. Executable Statements ..
350*
351*     Check for errors
352*
353      INFO = 0
354*
355      NMAX = 5
356*
357      IF( NSIZE.LT.0 ) THEN
358         INFO = -1
359      ELSE IF( THRESH.LT.ZERO ) THEN
360         INFO = -2
361      ELSE IF( NIN.LE.0 ) THEN
362         INFO = -3
363      ELSE IF( NOUT.LE.0 ) THEN
364         INFO = -4
365      ELSE IF( LDA.LT.1 .OR. LDA.LT.NMAX ) THEN
366         INFO = -6
367      ELSE IF( LIWORK.LT.NMAX+6 ) THEN
368         INFO = -26
369      END IF
370*
371*     Compute workspace
372*      (Note: Comments in the code beginning "Workspace:" describe the
373*       minimal amount of workspace needed at that point in the code,
374*       as well as the preferred amount for good performance.
375*       NB refers to the optimal block size for the immediately
376*       following subroutine, as returned by ILAENV.)
377*
378      MINWRK = 1
379      IF( INFO.EQ.0 .AND. LWORK.GE.1 ) THEN
380         MINWRK = 2*NMAX*NMAX + 12*NMAX + 16
381         MAXWRK = 6*NMAX + NMAX*ILAENV( 1, 'SGEQRF', ' ', NMAX, 1, NMAX,
382     $            0 )
383         MAXWRK = MAX( MAXWRK, 2*NMAX*NMAX+12*NMAX+16 )
384         WORK( 1 ) = MAXWRK
385      END IF
386*
387      IF( LWORK.LT.MINWRK )
388     $   INFO = -24
389*
390      IF( INFO.NE.0 ) THEN
391         CALL XERBLA( 'SDRGVX', -INFO )
392         RETURN
393      END IF
394*
395      N = 5
396      ULP = SLAMCH( 'P' )
397      ULPINV = ONE / ULP
398      THRSH2 = TEN*THRESH
399      NERRS = 0
400      NPTKNT = 0
401      NTESTT = 0
402*
403      IF( NSIZE.EQ.0 )
404     $   GO TO 90
405*
406*     Parameters used for generating test matrices.
407*
408      WEIGHT( 1 ) = TNTH
409      WEIGHT( 2 ) = HALF
410      WEIGHT( 3 ) = ONE
411      WEIGHT( 4 ) = ONE / WEIGHT( 2 )
412      WEIGHT( 5 ) = ONE / WEIGHT( 1 )
413*
414      DO 80 IPTYPE = 1, 2
415         DO 70 IWA = 1, 5
416            DO 60 IWB = 1, 5
417               DO 50 IWX = 1, 5
418                  DO 40 IWY = 1, 5
419*
420*                    generated a test matrix pair
421*
422                     CALL SLATM6( IPTYPE, 5, A, LDA, B, VR, LDA, VL,
423     $                            LDA, WEIGHT( IWA ), WEIGHT( IWB ),
424     $                            WEIGHT( IWX ), WEIGHT( IWY ), STRU,
425     $                            DIFTRU )
426*
427*                    Compute eigenvalues/eigenvectors of (A, B).
428*                    Compute eigenvalue/eigenvector condition numbers
429*                    using computed eigenvectors.
430*
431                     CALL SLACPY( 'F', N, N, A, LDA, AI, LDA )
432                     CALL SLACPY( 'F', N, N, B, LDA, BI, LDA )
433*
434                     CALL SGGEVX( 'N', 'V', 'V', 'B', N, AI, LDA, BI,
435     $                            LDA, ALPHAR, ALPHAI, BETA, VL, LDA,
436     $                            VR, LDA, ILO, IHI, LSCALE, RSCALE,
437     $                            ANORM, BNORM, S, DIF, WORK, LWORK,
438     $                            IWORK, BWORK, LINFO )
439                     IF( LINFO.NE.0 ) THEN
440                        RESULT( 1 ) = ULPINV
441                        WRITE( NOUT, FMT = 9999 )'SGGEVX', LINFO, N,
442     $                     IPTYPE
443                        GO TO 30
444                     END IF
445*
446*                    Compute the norm(A, B)
447*
448                     CALL SLACPY( 'Full', N, N, AI, LDA, WORK, N )
449                     CALL SLACPY( 'Full', N, N, BI, LDA, WORK( N*N+1 ),
450     $                            N )
451                     ABNORM = SLANGE( 'Fro', N, 2*N, WORK, N, WORK )
452*
453*                    Tests (1) and (2)
454*
455                     RESULT( 1 ) = ZERO
456                     CALL SGET52( .TRUE., N, A, LDA, B, LDA, VL, LDA,
457     $                            ALPHAR, ALPHAI, BETA, WORK,
458     $                            RESULT( 1 ) )
459                     IF( RESULT( 2 ).GT.THRESH ) THEN
460                        WRITE( NOUT, FMT = 9998 )'Left', 'SGGEVX',
461     $                     RESULT( 2 ), N, IPTYPE, IWA, IWB, IWX, IWY
462                     END IF
463*
464                     RESULT( 2 ) = ZERO
465                     CALL SGET52( .FALSE., N, A, LDA, B, LDA, VR, LDA,
466     $                            ALPHAR, ALPHAI, BETA, WORK,
467     $                            RESULT( 2 ) )
468                     IF( RESULT( 3 ).GT.THRESH ) THEN
469                        WRITE( NOUT, FMT = 9998 )'Right', 'SGGEVX',
470     $                     RESULT( 3 ), N, IPTYPE, IWA, IWB, IWX, IWY
471                     END IF
472*
473*                    Test (3)
474*
475                     RESULT( 3 ) = ZERO
476                     DO 10 I = 1, N
477                        IF( S( I ).EQ.ZERO ) THEN
478                           IF( STRU( I ).GT.ABNORM*ULP )
479     $                        RESULT( 3 ) = ULPINV
480                        ELSE IF( STRU( I ).EQ.ZERO ) THEN
481                           IF( S( I ).GT.ABNORM*ULP )
482     $                        RESULT( 3 ) = ULPINV
483                        ELSE
484                           WORK( I ) = MAX( ABS( STRU( I ) / S( I ) ),
485     $                                 ABS( S( I ) / STRU( I ) ) )
486                           RESULT( 3 ) = MAX( RESULT( 3 ), WORK( I ) )
487                        END IF
488   10                CONTINUE
489*
490*                    Test (4)
491*
492                     RESULT( 4 ) = ZERO
493                     IF( DIF( 1 ).EQ.ZERO ) THEN
494                        IF( DIFTRU( 1 ).GT.ABNORM*ULP )
495     $                     RESULT( 4 ) = ULPINV
496                     ELSE IF( DIFTRU( 1 ).EQ.ZERO ) THEN
497                        IF( DIF( 1 ).GT.ABNORM*ULP )
498     $                     RESULT( 4 ) = ULPINV
499                     ELSE IF( DIF( 5 ).EQ.ZERO ) THEN
500                        IF( DIFTRU( 5 ).GT.ABNORM*ULP )
501     $                     RESULT( 4 ) = ULPINV
502                     ELSE IF( DIFTRU( 5 ).EQ.ZERO ) THEN
503                        IF( DIF( 5 ).GT.ABNORM*ULP )
504     $                     RESULT( 4 ) = ULPINV
505                     ELSE
506                        RATIO1 = MAX( ABS( DIFTRU( 1 ) / DIF( 1 ) ),
507     $                           ABS( DIF( 1 ) / DIFTRU( 1 ) ) )
508                        RATIO2 = MAX( ABS( DIFTRU( 5 ) / DIF( 5 ) ),
509     $                           ABS( DIF( 5 ) / DIFTRU( 5 ) ) )
510                        RESULT( 4 ) = MAX( RATIO1, RATIO2 )
511                     END IF
512*
513                     NTESTT = NTESTT + 4
514*
515*                    Print out tests which fail.
516*
517                     DO 20 J = 1, 4
518                        IF( ( RESULT( J ).GE.THRSH2 .AND. J.GE.4 ) .OR.
519     $                      ( RESULT( J ).GE.THRESH .AND. J.LE.3 ) )
520     $                       THEN
521*
522*                       If this is the first test to fail,
523*                       print a header to the data file.
524*
525                           IF( NERRS.EQ.0 ) THEN
526                              WRITE( NOUT, FMT = 9997 )'SXV'
527*
528*                          Print out messages for built-in examples
529*
530*                          Matrix types
531*
532                              WRITE( NOUT, FMT = 9995 )
533                              WRITE( NOUT, FMT = 9994 )
534                              WRITE( NOUT, FMT = 9993 )
535*
536*                          Tests performed
537*
538                              WRITE( NOUT, FMT = 9992 )'''',
539     $                           'transpose', ''''
540*
541                           END IF
542                           NERRS = NERRS + 1
543                           IF( RESULT( J ).LT.10000.0 ) THEN
544                              WRITE( NOUT, FMT = 9991 )IPTYPE, IWA,
545     $                           IWB, IWX, IWY, J, RESULT( J )
546                           ELSE
547                              WRITE( NOUT, FMT = 9990 )IPTYPE, IWA,
548     $                           IWB, IWX, IWY, J, RESULT( J )
549                           END IF
550                        END IF
551   20                CONTINUE
552*
553   30                CONTINUE
554*
555   40             CONTINUE
556   50          CONTINUE
557   60       CONTINUE
558   70    CONTINUE
559   80 CONTINUE
560*
561      GO TO 150
562*
563   90 CONTINUE
564*
565*     Read in data from file to check accuracy of condition estimation
566*     Read input data until N=0
567*
568      READ( NIN, FMT = *, END = 150 )N
569      IF( N.EQ.0 )
570     $   GO TO 150
571      DO 100 I = 1, N
572         READ( NIN, FMT = * )( A( I, J ), J = 1, N )
573  100 CONTINUE
574      DO 110 I = 1, N
575         READ( NIN, FMT = * )( B( I, J ), J = 1, N )
576  110 CONTINUE
577      READ( NIN, FMT = * )( STRU( I ), I = 1, N )
578      READ( NIN, FMT = * )( DIFTRU( I ), I = 1, N )
579*
580      NPTKNT = NPTKNT + 1
581*
582*     Compute eigenvalues/eigenvectors of (A, B).
583*     Compute eigenvalue/eigenvector condition numbers
584*     using computed eigenvectors.
585*
586      CALL SLACPY( 'F', N, N, A, LDA, AI, LDA )
587      CALL SLACPY( 'F', N, N, B, LDA, BI, LDA )
588*
589      CALL SGGEVX( 'N', 'V', 'V', 'B', N, AI, LDA, BI, LDA, ALPHAR,
590     $             ALPHAI, BETA, VL, LDA, VR, LDA, ILO, IHI, LSCALE,
591     $             RSCALE, ANORM, BNORM, S, DIF, WORK, LWORK, IWORK,
592     $             BWORK, LINFO )
593*
594      IF( LINFO.NE.0 ) THEN
595         RESULT( 1 ) = ULPINV
596         WRITE( NOUT, FMT = 9987 )'SGGEVX', LINFO, N, NPTKNT
597         GO TO 140
598      END IF
599*
600*     Compute the norm(A, B)
601*
602      CALL SLACPY( 'Full', N, N, AI, LDA, WORK, N )
603      CALL SLACPY( 'Full', N, N, BI, LDA, WORK( N*N+1 ), N )
604      ABNORM = SLANGE( 'Fro', N, 2*N, WORK, N, WORK )
605*
606*     Tests (1) and (2)
607*
608      RESULT( 1 ) = ZERO
609      CALL SGET52( .TRUE., N, A, LDA, B, LDA, VL, LDA, ALPHAR, ALPHAI,
610     $             BETA, WORK, RESULT( 1 ) )
611      IF( RESULT( 2 ).GT.THRESH ) THEN
612         WRITE( NOUT, FMT = 9986 )'Left', 'SGGEVX', RESULT( 2 ), N,
613     $      NPTKNT
614      END IF
615*
616      RESULT( 2 ) = ZERO
617      CALL SGET52( .FALSE., N, A, LDA, B, LDA, VR, LDA, ALPHAR, ALPHAI,
618     $             BETA, WORK, RESULT( 2 ) )
619      IF( RESULT( 3 ).GT.THRESH ) THEN
620         WRITE( NOUT, FMT = 9986 )'Right', 'SGGEVX', RESULT( 3 ), N,
621     $      NPTKNT
622      END IF
623*
624*     Test (3)
625*
626      RESULT( 3 ) = ZERO
627      DO 120 I = 1, N
628         IF( S( I ).EQ.ZERO ) THEN
629            IF( STRU( I ).GT.ABNORM*ULP )
630     $         RESULT( 3 ) = ULPINV
631         ELSE IF( STRU( I ).EQ.ZERO ) THEN
632            IF( S( I ).GT.ABNORM*ULP )
633     $         RESULT( 3 ) = ULPINV
634         ELSE
635            WORK( I ) = MAX( ABS( STRU( I ) / S( I ) ),
636     $                  ABS( S( I ) / STRU( I ) ) )
637            RESULT( 3 ) = MAX( RESULT( 3 ), WORK( I ) )
638         END IF
639  120 CONTINUE
640*
641*     Test (4)
642*
643      RESULT( 4 ) = ZERO
644      IF( DIF( 1 ).EQ.ZERO ) THEN
645         IF( DIFTRU( 1 ).GT.ABNORM*ULP )
646     $      RESULT( 4 ) = ULPINV
647      ELSE IF( DIFTRU( 1 ).EQ.ZERO ) THEN
648         IF( DIF( 1 ).GT.ABNORM*ULP )
649     $      RESULT( 4 ) = ULPINV
650      ELSE IF( DIF( 5 ).EQ.ZERO ) THEN
651         IF( DIFTRU( 5 ).GT.ABNORM*ULP )
652     $      RESULT( 4 ) = ULPINV
653      ELSE IF( DIFTRU( 5 ).EQ.ZERO ) THEN
654         IF( DIF( 5 ).GT.ABNORM*ULP )
655     $      RESULT( 4 ) = ULPINV
656      ELSE
657         RATIO1 = MAX( ABS( DIFTRU( 1 ) / DIF( 1 ) ),
658     $            ABS( DIF( 1 ) / DIFTRU( 1 ) ) )
659         RATIO2 = MAX( ABS( DIFTRU( 5 ) / DIF( 5 ) ),
660     $            ABS( DIF( 5 ) / DIFTRU( 5 ) ) )
661         RESULT( 4 ) = MAX( RATIO1, RATIO2 )
662      END IF
663*
664      NTESTT = NTESTT + 4
665*
666*     Print out tests which fail.
667*
668      DO 130 J = 1, 4
669         IF( RESULT( J ).GE.THRSH2 ) THEN
670*
671*           If this is the first test to fail,
672*           print a header to the data file.
673*
674            IF( NERRS.EQ.0 ) THEN
675               WRITE( NOUT, FMT = 9997 )'SXV'
676*
677*              Print out messages for built-in examples
678*
679*              Matrix types
680*
681               WRITE( NOUT, FMT = 9996 )
682*
683*              Tests performed
684*
685               WRITE( NOUT, FMT = 9992 )'''', 'transpose', ''''
686*
687            END IF
688            NERRS = NERRS + 1
689            IF( RESULT( J ).LT.10000.0 ) THEN
690               WRITE( NOUT, FMT = 9989 )NPTKNT, N, J, RESULT( J )
691            ELSE
692               WRITE( NOUT, FMT = 9988 )NPTKNT, N, J, RESULT( J )
693            END IF
694         END IF
695  130 CONTINUE
696*
697  140 CONTINUE
698*
699      GO TO 90
700  150 CONTINUE
701*
702*     Summary
703*
704      CALL ALASVM( 'SXV', NOUT, NERRS, NTESTT, 0 )
705*
706      WORK( 1 ) = MAXWRK
707*
708      RETURN
709*
710 9999 FORMAT( ' SDRGVX: ', A, ' returned INFO=', I6, '.', / 9X, 'N=',
711     $      I6, ', JTYPE=', I6, ')' )
712*
713 9998 FORMAT( ' SDRGVX: ', A, ' Eigenvectors from ', A, ' incorrectly ',
714     $      'normalized.', / ' Bits of error=', 0P, G10.3, ',', 9X,
715     $      'N=', I6, ', JTYPE=', I6, ', IWA=', I5, ', IWB=', I5,
716     $      ', IWX=', I5, ', IWY=', I5 )
717*
718 9997 FORMAT( / 1X, A3, ' -- Real Expert Eigenvalue/vector',
719     $      ' problem driver' )
720*
721 9996 FORMAT( ' Input Example' )
722*
723 9995 FORMAT( ' Matrix types: ', / )
724*
725 9994 FORMAT( ' TYPE 1: Da is diagonal, Db is identity, ',
726     $      / '     A = Y^(-H) Da X^(-1), B = Y^(-H) Db X^(-1) ',
727     $      / '     YH and X are left and right eigenvectors. ', / )
728*
729 9993 FORMAT( ' TYPE 2: Da is quasi-diagonal, Db is identity, ',
730     $      / '     A = Y^(-H) Da X^(-1), B = Y^(-H) Db X^(-1) ',
731     $      / '     YH and X are left and right eigenvectors. ', / )
732*
733 9992 FORMAT( / ' Tests performed:  ', / 4X,
734     $      ' a is alpha, b is beta, l is a left eigenvector, ', / 4X,
735     $      ' r is a right eigenvector and ', A, ' means ', A, '.',
736     $      / ' 1 = max | ( b A - a B )', A, ' l | / const.',
737     $      / ' 2 = max | ( b A - a B ) r | / const.',
738     $      / ' 3 = max ( Sest/Stru, Stru/Sest ) ',
739     $      ' over all eigenvalues', /
740     $      ' 4 = max( DIFest/DIFtru, DIFtru/DIFest ) ',
741     $      ' over the 1st and 5th eigenvectors', / )
742*
743 9991 FORMAT( ' Type=', I2, ',', ' IWA=', I2, ', IWB=', I2, ', IWX=',
744     $      I2, ', IWY=', I2, ', result ', I2, ' is', 0P, F8.2 )
745 9990 FORMAT( ' Type=', I2, ',', ' IWA=', I2, ', IWB=', I2, ', IWX=',
746     $      I2, ', IWY=', I2, ', result ', I2, ' is', 1P, E10.3 )
747 9989 FORMAT( ' Input example #', I2, ', matrix order=', I4, ',',
748     $      ' result ', I2, ' is', 0P, F8.2 )
749 9988 FORMAT( ' Input example #', I2, ', matrix order=', I4, ',',
750     $      ' result ', I2, ' is', 1P, E10.3 )
751 9987 FORMAT( ' SDRGVX: ', A, ' returned INFO=', I6, '.', / 9X, 'N=',
752     $      I6, ', Input example #', I2, ')' )
753*
754 9986 FORMAT( ' SDRGVX: ', A, ' Eigenvectors from ', A, ' incorrectly ',
755     $      'normalized.', / ' Bits of error=', 0P, G10.3, ',', 9X,
756     $      'N=', I6, ', Input Example #', I2, ')' )
757*
758*
759*     End of SDRGVX
760*
761      END
762