1 SUBROUTINE CGET23( COMP, ISRT, BALANC, JTYPE, THRESH, ISEED,
2 $ NOUNIT, N, A, LDA, H, W, W1, VL, LDVL, VR,
3 $ LDVR, LRE, LDLRE, RCONDV, RCNDV1, RCDVIN,
4 $ RCONDE, RCNDE1, RCDEIN, SCALE, SCALE1, RESULT,
5 $ WORK, LWORK, RWORK, INFO )
6 *
7 * -- LAPACK test routine (version 3.1) --
8 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
9 * November 2006
10 *
11 * .. Scalar Arguments ..
12 LOGICAL COMP
13 CHARACTER BALANC
14 INTEGER INFO, ISRT, JTYPE, LDA, LDLRE, LDVL, LDVR,
15 $ LWORK, N, NOUNIT
16 REAL THRESH
17 * ..
18 * .. Array Arguments ..
19 INTEGER ISEED( 4 )
20 REAL RCDEIN( * ), RCDVIN( * ), RCNDE1( * ),
21 $ RCNDV1( * ), RCONDE( * ), RCONDV( * ),
22 $ RESULT( 11 ), RWORK( * ), SCALE( * ),
23 $ SCALE1( * )
24 COMPLEX A( LDA, * ), H( LDA, * ), LRE( LDLRE, * ),
25 $ VL( LDVL, * ), VR( LDVR, * ), W( * ), W1( * ),
26 $ WORK( * )
27 * ..
28 *
29 * Purpose
30 * =======
31 *
32 * CGET23 checks the nonsymmetric eigenvalue problem driver CGEEVX.
33 * If COMP = .FALSE., the first 8 of the following tests will be
34 * performed on the input matrix A, and also test 9 if LWORK is
35 * sufficiently large.
36 * if COMP is .TRUE. all 11 tests will be performed.
37 *
38 * (1) | A * VR - VR * W | / ( n |A| ulp )
39 *
40 * Here VR is the matrix of unit right eigenvectors.
41 * W is a diagonal matrix with diagonal entries W(j).
42 *
43 * (2) | A**H * VL - VL * W**H | / ( n |A| ulp )
44 *
45 * Here VL is the matrix of unit left eigenvectors, A**H is the
46 * conjugate transpose of A, and W is as above.
47 *
48 * (3) | |VR(i)| - 1 | / ulp and largest component real
49 *
50 * VR(i) denotes the i-th column of VR.
51 *
52 * (4) | |VL(i)| - 1 | / ulp and largest component real
53 *
54 * VL(i) denotes the i-th column of VL.
55 *
56 * (5) 0 if W(full) = W(partial), 1/ulp otherwise
57 *
58 * W(full) denotes the eigenvalues computed when VR, VL, RCONDV
59 * and RCONDE are also computed, and W(partial) denotes the
60 * eigenvalues computed when only some of VR, VL, RCONDV, and
61 * RCONDE are computed.
62 *
63 * (6) 0 if VR(full) = VR(partial), 1/ulp otherwise
64 *
65 * VR(full) denotes the right eigenvectors computed when VL, RCONDV
66 * and RCONDE are computed, and VR(partial) denotes the result
67 * when only some of VL and RCONDV are computed.
68 *
69 * (7) 0 if VL(full) = VL(partial), 1/ulp otherwise
70 *
71 * VL(full) denotes the left eigenvectors computed when VR, RCONDV
72 * and RCONDE are computed, and VL(partial) denotes the result
73 * when only some of VR and RCONDV are computed.
74 *
75 * (8) 0 if SCALE, ILO, IHI, ABNRM (full) =
76 * SCALE, ILO, IHI, ABNRM (partial)
77 * 1/ulp otherwise
78 *
79 * SCALE, ILO, IHI and ABNRM describe how the matrix is balanced.
80 * (full) is when VR, VL, RCONDE and RCONDV are also computed, and
81 * (partial) is when some are not computed.
82 *
83 * (9) 0 if RCONDV(full) = RCONDV(partial), 1/ulp otherwise
84 *
85 * RCONDV(full) denotes the reciprocal condition numbers of the
86 * right eigenvectors computed when VR, VL and RCONDE are also
87 * computed. RCONDV(partial) denotes the reciprocal condition
88 * numbers when only some of VR, VL and RCONDE are computed.
89 *
90 * (10) |RCONDV - RCDVIN| / cond(RCONDV)
91 *
92 * RCONDV is the reciprocal right eigenvector condition number
93 * computed by CGEEVX and RCDVIN (the precomputed true value)
94 * is supplied as input. cond(RCONDV) is the condition number of
95 * RCONDV, and takes errors in computing RCONDV into account, so
96 * that the resulting quantity should be O(ULP). cond(RCONDV) is
97 * essentially given by norm(A)/RCONDE.
98 *
99 * (11) |RCONDE - RCDEIN| / cond(RCONDE)
100 *
101 * RCONDE is the reciprocal eigenvalue condition number
102 * computed by CGEEVX and RCDEIN (the precomputed true value)
103 * is supplied as input. cond(RCONDE) is the condition number
104 * of RCONDE, and takes errors in computing RCONDE into account,
105 * so that the resulting quantity should be O(ULP). cond(RCONDE)
106 * is essentially given by norm(A)/RCONDV.
107 *
108 * Arguments
109 * =========
110 *
111 * COMP (input) LOGICAL
112 * COMP describes which input tests to perform:
113 * = .FALSE. if the computed condition numbers are not to
114 * be tested against RCDVIN and RCDEIN
115 * = .TRUE. if they are to be compared
116 *
117 * ISRT (input) INTEGER
118 * If COMP = .TRUE., ISRT indicates in how the eigenvalues
119 * corresponding to values in RCDVIN and RCDEIN are ordered:
120 * = 0 means the eigenvalues are sorted by
121 * increasing real part
122 * = 1 means the eigenvalues are sorted by
123 * increasing imaginary part
124 * If COMP = .FALSE., ISRT is not referenced.
125 *
126 * BALANC (input) CHARACTER
127 * Describes the balancing option to be tested.
128 * = 'N' for no permuting or diagonal scaling
129 * = 'P' for permuting but no diagonal scaling
130 * = 'S' for no permuting but diagonal scaling
131 * = 'B' for permuting and diagonal scaling
132 *
133 * JTYPE (input) INTEGER
134 * Type of input matrix. Used to label output if error occurs.
135 *
136 * THRESH (input) REAL
137 * A test will count as "failed" if the "error", computed as
138 * described above, exceeds THRESH. Note that the error
139 * is scaled to be O(1), so THRESH should be a reasonably
140 * small multiple of 1, e.g., 10 or 100. In particular,
141 * it should not depend on the precision (single vs. double)
142 * or the size of the matrix. It must be at least zero.
143 *
144 * ISEED (input) INTEGER array, dimension (4)
145 * If COMP = .FALSE., the random number generator seed
146 * used to produce matrix.
147 * If COMP = .TRUE., ISEED(1) = the number of the example.
148 * Used to label output if error occurs.
149 *
150 * NOUNIT (input) INTEGER
151 * The FORTRAN unit number for printing out error messages
152 * (e.g., if a routine returns INFO not equal to 0.)
153 *
154 * N (input) INTEGER
155 * The dimension of A. N must be at least 0.
156 *
157 * A (input/output) COMPLEX array, dimension (LDA,N)
158 * Used to hold the matrix whose eigenvalues are to be
159 * computed.
160 *
161 * LDA (input) INTEGER
162 * The leading dimension of A, and H. LDA must be at
163 * least 1 and at least N.
164 *
165 * H (workspace) COMPLEX array, dimension (LDA,N)
166 * Another copy of the test matrix A, modified by CGEEVX.
167 *
168 * W (workspace) COMPLEX array, dimension (N)
169 * Contains the eigenvalues of A.
170 *
171 * W1 (workspace) COMPLEX array, dimension (N)
172 * Like W, this array contains the eigenvalues of A,
173 * but those computed when CGEEVX only computes a partial
174 * eigendecomposition, i.e. not the eigenvalues and left
175 * and right eigenvectors.
176 *
177 * VL (workspace) COMPLEX array, dimension (LDVL,N)
178 * VL holds the computed left eigenvectors.
179 *
180 * LDVL (input) INTEGER
181 * Leading dimension of VL. Must be at least max(1,N).
182 *
183 * VR (workspace) COMPLEX array, dimension (LDVR,N)
184 * VR holds the computed right eigenvectors.
185 *
186 * LDVR (input) INTEGER
187 * Leading dimension of VR. Must be at least max(1,N).
188 *
189 * LRE (workspace) COMPLEX array, dimension (LDLRE,N)
190 * LRE holds the computed right or left eigenvectors.
191 *
192 * LDLRE (input) INTEGER
193 * Leading dimension of LRE. Must be at least max(1,N).
194 *
195 * RCONDV (workspace) REAL array, dimension (N)
196 * RCONDV holds the computed reciprocal condition numbers
197 * for eigenvectors.
198 *
199 * RCNDV1 (workspace) REAL array, dimension (N)
200 * RCNDV1 holds more computed reciprocal condition numbers
201 * for eigenvectors.
202 *
203 * RCDVIN (input) REAL array, dimension (N)
204 * When COMP = .TRUE. RCDVIN holds the precomputed reciprocal
205 * condition numbers for eigenvectors to be compared with
206 * RCONDV.
207 *
208 * RCONDE (workspace) REAL array, dimension (N)
209 * RCONDE holds the computed reciprocal condition numbers
210 * for eigenvalues.
211 *
212 * RCNDE1 (workspace) REAL array, dimension (N)
213 * RCNDE1 holds more computed reciprocal condition numbers
214 * for eigenvalues.
215 *
216 * RCDEIN (input) REAL array, dimension (N)
217 * When COMP = .TRUE. RCDEIN holds the precomputed reciprocal
218 * condition numbers for eigenvalues to be compared with
219 * RCONDE.
220 *
221 * SCALE (workspace) REAL array, dimension (N)
222 * Holds information describing balancing of matrix.
223 *
224 * SCALE1 (workspace) REAL array, dimension (N)
225 * Holds information describing balancing of matrix.
226 *
227 * RESULT (output) REAL array, dimension (11)
228 * The values computed by the 11 tests described above.
229 * The values are currently limited to 1/ulp, to avoid
230 * overflow.
231 *
232 * WORK (workspace) COMPLEX array, dimension (LWORK)
233 *
234 * LWORK (input) INTEGER
235 * The number of entries in WORK. This must be at least
236 * 2*N, and 2*N+N**2 if tests 9, 10 or 11 are to be performed.
237 *
238 * RWORK (workspace) REAL array, dimension (2*N)
239 *
240 * INFO (output) INTEGER
241 * If 0, successful exit.
242 * If <0, input parameter -INFO had an incorrect value.
243 * If >0, CGEEVX returned an error code, the absolute
244 * value of which is returned.
245 *
246 * =====================================================================
247 *
248 * .. Parameters ..
249 REAL ZERO, ONE, TWO
250 PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0, TWO = 2.0E0 )
251 REAL EPSIN
252 PARAMETER ( EPSIN = 5.9605E-8 )
253 * ..
254 * .. Local Scalars ..
255 LOGICAL BALOK, NOBAL
256 CHARACTER SENSE
257 INTEGER I, IHI, IHI1, IINFO, ILO, ILO1, ISENS, ISENSM,
258 $ J, JJ, KMIN
259 REAL ABNRM, ABNRM1, EPS, SMLNUM, TNRM, TOL, TOLIN,
260 $ ULP, ULPINV, V, VMAX, VMX, VRICMP, VRIMIN,
261 $ VRMX, VTST
262 COMPLEX CTMP
263 * ..
264 * .. Local Arrays ..
265 CHARACTER SENS( 2 )
266 REAL RES( 2 )
267 COMPLEX CDUM( 1 )
268 * ..
269 * .. External Functions ..
270 LOGICAL LSAME
271 REAL SCNRM2, SLAMCH
272 EXTERNAL LSAME, SCNRM2, SLAMCH
273 * ..
274 * .. External Subroutines ..
275 EXTERNAL CGEEVX, CGET22, CLACPY, XERBLA
276 * ..
277 * .. Intrinsic Functions ..
278 INTRINSIC ABS, AIMAG, MAX, MIN, REAL
279 * ..
280 * .. Data statements ..
281 DATA SENS / 'N', 'V' /
282 * ..
283 * .. Executable Statements ..
284 *
285 * Check for errors
286 *
287 NOBAL = LSAME( BALANC, 'N' )
288 BALOK = NOBAL .OR. LSAME( BALANC, 'P' ) .OR.
289 $ LSAME( BALANC, 'S' ) .OR. LSAME( BALANC, 'B' )
290 INFO = 0
291 IF( ISRT.NE.0 .AND. ISRT.NE.1 ) THEN
292 INFO = -2
293 ELSE IF( .NOT.BALOK ) THEN
294 INFO = -3
295 ELSE IF( THRESH.LT.ZERO ) THEN
296 INFO = -5
297 ELSE IF( NOUNIT.LE.0 ) THEN
298 INFO = -7
299 ELSE IF( N.LT.0 ) THEN
300 INFO = -8
301 ELSE IF( LDA.LT.1 .OR. LDA.LT.N ) THEN
302 INFO = -10
303 ELSE IF( LDVL.LT.1 .OR. LDVL.LT.N ) THEN
304 INFO = -15
305 ELSE IF( LDVR.LT.1 .OR. LDVR.LT.N ) THEN
306 INFO = -17
307 ELSE IF( LDLRE.LT.1 .OR. LDLRE.LT.N ) THEN
308 INFO = -19
309 ELSE IF( LWORK.LT.2*N .OR. ( COMP .AND. LWORK.LT.2*N+N*N ) ) THEN
310 INFO = -30
311 END IF
312 *
313 IF( INFO.NE.0 ) THEN
314 CALL XERBLA( 'CGET23', -INFO )
315 RETURN
316 END IF
317 *
318 * Quick return if nothing to do
319 *
320 DO 10 I = 1, 11
321 RESULT( I ) = -ONE
322 10 CONTINUE
323 *
324 IF( N.EQ.0 )
325 $ RETURN
326 *
327 * More Important constants
328 *
329 ULP = SLAMCH( 'Precision' )
330 SMLNUM = SLAMCH( 'S' )
331 ULPINV = ONE / ULP
332 *
333 * Compute eigenvalues and eigenvectors, and test them
334 *
335 IF( LWORK.GE.2*N+N*N ) THEN
336 SENSE = 'B'
337 ISENSM = 2
338 ELSE
339 SENSE = 'E'
340 ISENSM = 1
341 END IF
342 CALL CLACPY( 'F', N, N, A, LDA, H, LDA )
343 CALL CGEEVX( BALANC, 'V', 'V', SENSE, N, H, LDA, W, VL, LDVL, VR,
344 $ LDVR, ILO, IHI, SCALE, ABNRM, RCONDE, RCONDV, WORK,
345 $ LWORK, RWORK, IINFO )
346 IF( IINFO.NE.0 ) THEN
347 RESULT( 1 ) = ULPINV
348 IF( JTYPE.NE.22 ) THEN
349 WRITE( NOUNIT, FMT = 9998 )'CGEEVX1', IINFO, N, JTYPE,
350 $ BALANC, ISEED
351 ELSE
352 WRITE( NOUNIT, FMT = 9999 )'CGEEVX1', IINFO, N, ISEED( 1 )
353 END IF
354 INFO = ABS( IINFO )
355 RETURN
356 END IF
357 *
358 * Do Test (1)
359 *
360 CALL CGET22( 'N', 'N', 'N', N, A, LDA, VR, LDVR, W, WORK, RWORK,
361 $ RES )
362 RESULT( 1 ) = RES( 1 )
363 *
364 * Do Test (2)
365 *
366 CALL CGET22( 'C', 'N', 'C', N, A, LDA, VL, LDVL, W, WORK, RWORK,
367 $ RES )
368 RESULT( 2 ) = RES( 1 )
369 *
370 * Do Test (3)
371 *
372 DO 30 J = 1, N
373 TNRM = SCNRM2( N, VR( 1, J ), 1 )
374 RESULT( 3 ) = MAX( RESULT( 3 ),
375 $ MIN( ULPINV, ABS( TNRM-ONE ) / ULP ) )
376 VMX = ZERO
377 VRMX = ZERO
378 DO 20 JJ = 1, N
379 VTST = ABS( VR( JJ, J ) )
380 IF( VTST.GT.VMX )
381 $ VMX = VTST
382 IF( AIMAG( VR( JJ, J ) ).EQ.ZERO .AND.
383 $ ABS( REAL( VR( JJ, J ) ) ).GT.VRMX )
384 $ VRMX = ABS( REAL( VR( JJ, J ) ) )
385 20 CONTINUE
386 IF( VRMX / VMX.LT.ONE-TWO*ULP )
387 $ RESULT( 3 ) = ULPINV
388 30 CONTINUE
389 *
390 * Do Test (4)
391 *
392 DO 50 J = 1, N
393 TNRM = SCNRM2( N, VL( 1, J ), 1 )
394 RESULT( 4 ) = MAX( RESULT( 4 ),
395 $ MIN( ULPINV, ABS( TNRM-ONE ) / ULP ) )
396 VMX = ZERO
397 VRMX = ZERO
398 DO 40 JJ = 1, N
399 VTST = ABS( VL( JJ, J ) )
400 IF( VTST.GT.VMX )
401 $ VMX = VTST
402 IF( AIMAG( VL( JJ, J ) ).EQ.ZERO .AND.
403 $ ABS( REAL( VL( JJ, J ) ) ).GT.VRMX )
404 $ VRMX = ABS( REAL( VL( JJ, J ) ) )
405 40 CONTINUE
406 IF( VRMX / VMX.LT.ONE-TWO*ULP )
407 $ RESULT( 4 ) = ULPINV
408 50 CONTINUE
409 *
410 * Test for all options of computing condition numbers
411 *
412 DO 200 ISENS = 1, ISENSM
413 *
414 SENSE = SENS( ISENS )
415 *
416 * Compute eigenvalues only, and test them
417 *
418 CALL CLACPY( 'F', N, N, A, LDA, H, LDA )
419 CALL CGEEVX( BALANC, 'N', 'N', SENSE, N, H, LDA, W1, CDUM, 1,
420 $ CDUM, 1, ILO1, IHI1, SCALE1, ABNRM1, RCNDE1,
421 $ RCNDV1, WORK, LWORK, RWORK, IINFO )
422 IF( IINFO.NE.0 ) THEN
423 RESULT( 1 ) = ULPINV
424 IF( JTYPE.NE.22 ) THEN
425 WRITE( NOUNIT, FMT = 9998 )'CGEEVX2', IINFO, N, JTYPE,
426 $ BALANC, ISEED
427 ELSE
428 WRITE( NOUNIT, FMT = 9999 )'CGEEVX2', IINFO, N,
429 $ ISEED( 1 )
430 END IF
431 INFO = ABS( IINFO )
432 GO TO 190
433 END IF
434 *
435 * Do Test (5)
436 *
437 DO 60 J = 1, N
438 IF( W( J ).NE.W1( J ) )
439 $ RESULT( 5 ) = ULPINV
440 60 CONTINUE
441 *
442 * Do Test (8)
443 *
444 IF( .NOT.NOBAL ) THEN
445 DO 70 J = 1, N
446 IF( SCALE( J ).NE.SCALE1( J ) )
447 $ RESULT( 8 ) = ULPINV
448 70 CONTINUE
449 IF( ILO.NE.ILO1 )
450 $ RESULT( 8 ) = ULPINV
451 IF( IHI.NE.IHI1 )
452 $ RESULT( 8 ) = ULPINV
453 IF( ABNRM.NE.ABNRM1 )
454 $ RESULT( 8 ) = ULPINV
455 END IF
456 *
457 * Do Test (9)
458 *
459 IF( ISENS.EQ.2 .AND. N.GT.1 ) THEN
460 DO 80 J = 1, N
461 IF( RCONDV( J ).NE.RCNDV1( J ) )
462 $ RESULT( 9 ) = ULPINV
463 80 CONTINUE
464 END IF
465 *
466 * Compute eigenvalues and right eigenvectors, and test them
467 *
468 CALL CLACPY( 'F', N, N, A, LDA, H, LDA )
469 CALL CGEEVX( BALANC, 'N', 'V', SENSE, N, H, LDA, W1, CDUM, 1,
470 $ LRE, LDLRE, ILO1, IHI1, SCALE1, ABNRM1, RCNDE1,
471 $ RCNDV1, WORK, LWORK, RWORK, IINFO )
472 IF( IINFO.NE.0 ) THEN
473 RESULT( 1 ) = ULPINV
474 IF( JTYPE.NE.22 ) THEN
475 WRITE( NOUNIT, FMT = 9998 )'CGEEVX3', IINFO, N, JTYPE,
476 $ BALANC, ISEED
477 ELSE
478 WRITE( NOUNIT, FMT = 9999 )'CGEEVX3', IINFO, N,
479 $ ISEED( 1 )
480 END IF
481 INFO = ABS( IINFO )
482 GO TO 190
483 END IF
484 *
485 * Do Test (5) again
486 *
487 DO 90 J = 1, N
488 IF( W( J ).NE.W1( J ) )
489 $ RESULT( 5 ) = ULPINV
490 90 CONTINUE
491 *
492 * Do Test (6)
493 *
494 DO 110 J = 1, N
495 DO 100 JJ = 1, N
496 IF( VR( J, JJ ).NE.LRE( J, JJ ) )
497 $ RESULT( 6 ) = ULPINV
498 100 CONTINUE
499 110 CONTINUE
500 *
501 * Do Test (8) again
502 *
503 IF( .NOT.NOBAL ) THEN
504 DO 120 J = 1, N
505 IF( SCALE( J ).NE.SCALE1( J ) )
506 $ RESULT( 8 ) = ULPINV
507 120 CONTINUE
508 IF( ILO.NE.ILO1 )
509 $ RESULT( 8 ) = ULPINV
510 IF( IHI.NE.IHI1 )
511 $ RESULT( 8 ) = ULPINV
512 IF( ABNRM.NE.ABNRM1 )
513 $ RESULT( 8 ) = ULPINV
514 END IF
515 *
516 * Do Test (9) again
517 *
518 IF( ISENS.EQ.2 .AND. N.GT.1 ) THEN
519 DO 130 J = 1, N
520 IF( RCONDV( J ).NE.RCNDV1( J ) )
521 $ RESULT( 9 ) = ULPINV
522 130 CONTINUE
523 END IF
524 *
525 * Compute eigenvalues and left eigenvectors, and test them
526 *
527 CALL CLACPY( 'F', N, N, A, LDA, H, LDA )
528 CALL CGEEVX( BALANC, 'V', 'N', SENSE, N, H, LDA, W1, LRE,
529 $ LDLRE, CDUM, 1, ILO1, IHI1, SCALE1, ABNRM1,
530 $ RCNDE1, RCNDV1, WORK, LWORK, RWORK, IINFO )
531 IF( IINFO.NE.0 ) THEN
532 RESULT( 1 ) = ULPINV
533 IF( JTYPE.NE.22 ) THEN
534 WRITE( NOUNIT, FMT = 9998 )'CGEEVX4', IINFO, N, JTYPE,
535 $ BALANC, ISEED
536 ELSE
537 WRITE( NOUNIT, FMT = 9999 )'CGEEVX4', IINFO, N,
538 $ ISEED( 1 )
539 END IF
540 INFO = ABS( IINFO )
541 GO TO 190
542 END IF
543 *
544 * Do Test (5) again
545 *
546 DO 140 J = 1, N
547 IF( W( J ).NE.W1( J ) )
548 $ RESULT( 5 ) = ULPINV
549 140 CONTINUE
550 *
551 * Do Test (7)
552 *
553 DO 160 J = 1, N
554 DO 150 JJ = 1, N
555 IF( VL( J, JJ ).NE.LRE( J, JJ ) )
556 $ RESULT( 7 ) = ULPINV
557 150 CONTINUE
558 160 CONTINUE
559 *
560 * Do Test (8) again
561 *
562 IF( .NOT.NOBAL ) THEN
563 DO 170 J = 1, N
564 IF( SCALE( J ).NE.SCALE1( J ) )
565 $ RESULT( 8 ) = ULPINV
566 170 CONTINUE
567 IF( ILO.NE.ILO1 )
568 $ RESULT( 8 ) = ULPINV
569 IF( IHI.NE.IHI1 )
570 $ RESULT( 8 ) = ULPINV
571 IF( ABNRM.NE.ABNRM1 )
572 $ RESULT( 8 ) = ULPINV
573 END IF
574 *
575 * Do Test (9) again
576 *
577 IF( ISENS.EQ.2 .AND. N.GT.1 ) THEN
578 DO 180 J = 1, N
579 IF( RCONDV( J ).NE.RCNDV1( J ) )
580 $ RESULT( 9 ) = ULPINV
581 180 CONTINUE
582 END IF
583 *
584 190 CONTINUE
585 *
586 200 CONTINUE
587 *
588 * If COMP, compare condition numbers to precomputed ones
589 *
590 IF( COMP ) THEN
591 CALL CLACPY( 'F', N, N, A, LDA, H, LDA )
592 CALL CGEEVX( 'N', 'V', 'V', 'B', N, H, LDA, W, VL, LDVL, VR,
593 $ LDVR, ILO, IHI, SCALE, ABNRM, RCONDE, RCONDV,
594 $ WORK, LWORK, RWORK, IINFO )
595 IF( IINFO.NE.0 ) THEN
596 RESULT( 1 ) = ULPINV
597 WRITE( NOUNIT, FMT = 9999 )'CGEEVX5', IINFO, N, ISEED( 1 )
598 INFO = ABS( IINFO )
599 GO TO 250
600 END IF
601 *
602 * Sort eigenvalues and condition numbers lexicographically
603 * to compare with inputs
604 *
605 DO 220 I = 1, N - 1
606 KMIN = I
607 IF( ISRT.EQ.0 ) THEN
608 VRIMIN = REAL( W( I ) )
609 ELSE
610 VRIMIN = AIMAG( W( I ) )
611 END IF
612 DO 210 J = I + 1, N
613 IF( ISRT.EQ.0 ) THEN
614 VRICMP = REAL( W( J ) )
615 ELSE
616 VRICMP = AIMAG( W( J ) )
617 END IF
618 IF( VRICMP.LT.VRIMIN ) THEN
619 KMIN = J
620 VRIMIN = VRICMP
621 END IF
622 210 CONTINUE
623 CTMP = W( KMIN )
624 W( KMIN ) = W( I )
625 W( I ) = CTMP
626 VRIMIN = RCONDE( KMIN )
627 RCONDE( KMIN ) = RCONDE( I )
628 RCONDE( I ) = VRIMIN
629 VRIMIN = RCONDV( KMIN )
630 RCONDV( KMIN ) = RCONDV( I )
631 RCONDV( I ) = VRIMIN
632 220 CONTINUE
633 *
634 * Compare condition numbers for eigenvectors
635 * taking their condition numbers into account
636 *
637 RESULT( 10 ) = ZERO
638 EPS = MAX( EPSIN, ULP )
639 V = MAX( REAL( N )*EPS*ABNRM, SMLNUM )
640 IF( ABNRM.EQ.ZERO )
641 $ V = ONE
642 DO 230 I = 1, N
643 IF( V.GT.RCONDV( I )*RCONDE( I ) ) THEN
644 TOL = RCONDV( I )
645 ELSE
646 TOL = V / RCONDE( I )
647 END IF
648 IF( V.GT.RCDVIN( I )*RCDEIN( I ) ) THEN
649 TOLIN = RCDVIN( I )
650 ELSE
651 TOLIN = V / RCDEIN( I )
652 END IF
653 TOL = MAX( TOL, SMLNUM / EPS )
654 TOLIN = MAX( TOLIN, SMLNUM / EPS )
655 IF( EPS*( RCDVIN( I )-TOLIN ).GT.RCONDV( I )+TOL ) THEN
656 VMAX = ONE / EPS
657 ELSE IF( RCDVIN( I )-TOLIN.GT.RCONDV( I )+TOL ) THEN
658 VMAX = ( RCDVIN( I )-TOLIN ) / ( RCONDV( I )+TOL )
659 ELSE IF( RCDVIN( I )+TOLIN.LT.EPS*( RCONDV( I )-TOL ) ) THEN
660 VMAX = ONE / EPS
661 ELSE IF( RCDVIN( I )+TOLIN.LT.RCONDV( I )-TOL ) THEN
662 VMAX = ( RCONDV( I )-TOL ) / ( RCDVIN( I )+TOLIN )
663 ELSE
664 VMAX = ONE
665 END IF
666 RESULT( 10 ) = MAX( RESULT( 10 ), VMAX )
667 230 CONTINUE
668 *
669 * Compare condition numbers for eigenvalues
670 * taking their condition numbers into account
671 *
672 RESULT( 11 ) = ZERO
673 DO 240 I = 1, N
674 IF( V.GT.RCONDV( I ) ) THEN
675 TOL = ONE
676 ELSE
677 TOL = V / RCONDV( I )
678 END IF
679 IF( V.GT.RCDVIN( I ) ) THEN
680 TOLIN = ONE
681 ELSE
682 TOLIN = V / RCDVIN( I )
683 END IF
684 TOL = MAX( TOL, SMLNUM / EPS )
685 TOLIN = MAX( TOLIN, SMLNUM / EPS )
686 IF( EPS*( RCDEIN( I )-TOLIN ).GT.RCONDE( I )+TOL ) THEN
687 VMAX = ONE / EPS
688 ELSE IF( RCDEIN( I )-TOLIN.GT.RCONDE( I )+TOL ) THEN
689 VMAX = ( RCDEIN( I )-TOLIN ) / ( RCONDE( I )+TOL )
690 ELSE IF( RCDEIN( I )+TOLIN.LT.EPS*( RCONDE( I )-TOL ) ) THEN
691 VMAX = ONE / EPS
692 ELSE IF( RCDEIN( I )+TOLIN.LT.RCONDE( I )-TOL ) THEN
693 VMAX = ( RCONDE( I )-TOL ) / ( RCDEIN( I )+TOLIN )
694 ELSE
695 VMAX = ONE
696 END IF
697 RESULT( 11 ) = MAX( RESULT( 11 ), VMAX )
698 240 CONTINUE
699 250 CONTINUE
700 *
701 END IF
702 *
703 9999 FORMAT( ' CGET23: ', A, ' returned INFO=', I6, '.', / 9X, 'N=',
704 $ I6, ', INPUT EXAMPLE NUMBER = ', I4 )
705 9998 FORMAT( ' CGET23: ', A, ' returned INFO=', I6, '.', / 9X, 'N=',
706 $ I6, ', JTYPE=', I6, ', BALANC = ', A, ', ISEED=(',
707 $ 3( I5, ',' ), I5, ')' )
708 *
709 RETURN
710 *
711 * End of CGET23
712 *
713 END
2 $ NOUNIT, N, A, LDA, H, W, W1, VL, LDVL, VR,
3 $ LDVR, LRE, LDLRE, RCONDV, RCNDV1, RCDVIN,
4 $ RCONDE, RCNDE1, RCDEIN, SCALE, SCALE1, RESULT,
5 $ WORK, LWORK, RWORK, INFO )
6 *
7 * -- LAPACK test routine (version 3.1) --
8 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
9 * November 2006
10 *
11 * .. Scalar Arguments ..
12 LOGICAL COMP
13 CHARACTER BALANC
14 INTEGER INFO, ISRT, JTYPE, LDA, LDLRE, LDVL, LDVR,
15 $ LWORK, N, NOUNIT
16 REAL THRESH
17 * ..
18 * .. Array Arguments ..
19 INTEGER ISEED( 4 )
20 REAL RCDEIN( * ), RCDVIN( * ), RCNDE1( * ),
21 $ RCNDV1( * ), RCONDE( * ), RCONDV( * ),
22 $ RESULT( 11 ), RWORK( * ), SCALE( * ),
23 $ SCALE1( * )
24 COMPLEX A( LDA, * ), H( LDA, * ), LRE( LDLRE, * ),
25 $ VL( LDVL, * ), VR( LDVR, * ), W( * ), W1( * ),
26 $ WORK( * )
27 * ..
28 *
29 * Purpose
30 * =======
31 *
32 * CGET23 checks the nonsymmetric eigenvalue problem driver CGEEVX.
33 * If COMP = .FALSE., the first 8 of the following tests will be
34 * performed on the input matrix A, and also test 9 if LWORK is
35 * sufficiently large.
36 * if COMP is .TRUE. all 11 tests will be performed.
37 *
38 * (1) | A * VR - VR * W | / ( n |A| ulp )
39 *
40 * Here VR is the matrix of unit right eigenvectors.
41 * W is a diagonal matrix with diagonal entries W(j).
42 *
43 * (2) | A**H * VL - VL * W**H | / ( n |A| ulp )
44 *
45 * Here VL is the matrix of unit left eigenvectors, A**H is the
46 * conjugate transpose of A, and W is as above.
47 *
48 * (3) | |VR(i)| - 1 | / ulp and largest component real
49 *
50 * VR(i) denotes the i-th column of VR.
51 *
52 * (4) | |VL(i)| - 1 | / ulp and largest component real
53 *
54 * VL(i) denotes the i-th column of VL.
55 *
56 * (5) 0 if W(full) = W(partial), 1/ulp otherwise
57 *
58 * W(full) denotes the eigenvalues computed when VR, VL, RCONDV
59 * and RCONDE are also computed, and W(partial) denotes the
60 * eigenvalues computed when only some of VR, VL, RCONDV, and
61 * RCONDE are computed.
62 *
63 * (6) 0 if VR(full) = VR(partial), 1/ulp otherwise
64 *
65 * VR(full) denotes the right eigenvectors computed when VL, RCONDV
66 * and RCONDE are computed, and VR(partial) denotes the result
67 * when only some of VL and RCONDV are computed.
68 *
69 * (7) 0 if VL(full) = VL(partial), 1/ulp otherwise
70 *
71 * VL(full) denotes the left eigenvectors computed when VR, RCONDV
72 * and RCONDE are computed, and VL(partial) denotes the result
73 * when only some of VR and RCONDV are computed.
74 *
75 * (8) 0 if SCALE, ILO, IHI, ABNRM (full) =
76 * SCALE, ILO, IHI, ABNRM (partial)
77 * 1/ulp otherwise
78 *
79 * SCALE, ILO, IHI and ABNRM describe how the matrix is balanced.
80 * (full) is when VR, VL, RCONDE and RCONDV are also computed, and
81 * (partial) is when some are not computed.
82 *
83 * (9) 0 if RCONDV(full) = RCONDV(partial), 1/ulp otherwise
84 *
85 * RCONDV(full) denotes the reciprocal condition numbers of the
86 * right eigenvectors computed when VR, VL and RCONDE are also
87 * computed. RCONDV(partial) denotes the reciprocal condition
88 * numbers when only some of VR, VL and RCONDE are computed.
89 *
90 * (10) |RCONDV - RCDVIN| / cond(RCONDV)
91 *
92 * RCONDV is the reciprocal right eigenvector condition number
93 * computed by CGEEVX and RCDVIN (the precomputed true value)
94 * is supplied as input. cond(RCONDV) is the condition number of
95 * RCONDV, and takes errors in computing RCONDV into account, so
96 * that the resulting quantity should be O(ULP). cond(RCONDV) is
97 * essentially given by norm(A)/RCONDE.
98 *
99 * (11) |RCONDE - RCDEIN| / cond(RCONDE)
100 *
101 * RCONDE is the reciprocal eigenvalue condition number
102 * computed by CGEEVX and RCDEIN (the precomputed true value)
103 * is supplied as input. cond(RCONDE) is the condition number
104 * of RCONDE, and takes errors in computing RCONDE into account,
105 * so that the resulting quantity should be O(ULP). cond(RCONDE)
106 * is essentially given by norm(A)/RCONDV.
107 *
108 * Arguments
109 * =========
110 *
111 * COMP (input) LOGICAL
112 * COMP describes which input tests to perform:
113 * = .FALSE. if the computed condition numbers are not to
114 * be tested against RCDVIN and RCDEIN
115 * = .TRUE. if they are to be compared
116 *
117 * ISRT (input) INTEGER
118 * If COMP = .TRUE., ISRT indicates in how the eigenvalues
119 * corresponding to values in RCDVIN and RCDEIN are ordered:
120 * = 0 means the eigenvalues are sorted by
121 * increasing real part
122 * = 1 means the eigenvalues are sorted by
123 * increasing imaginary part
124 * If COMP = .FALSE., ISRT is not referenced.
125 *
126 * BALANC (input) CHARACTER
127 * Describes the balancing option to be tested.
128 * = 'N' for no permuting or diagonal scaling
129 * = 'P' for permuting but no diagonal scaling
130 * = 'S' for no permuting but diagonal scaling
131 * = 'B' for permuting and diagonal scaling
132 *
133 * JTYPE (input) INTEGER
134 * Type of input matrix. Used to label output if error occurs.
135 *
136 * THRESH (input) REAL
137 * A test will count as "failed" if the "error", computed as
138 * described above, exceeds THRESH. Note that the error
139 * is scaled to be O(1), so THRESH should be a reasonably
140 * small multiple of 1, e.g., 10 or 100. In particular,
141 * it should not depend on the precision (single vs. double)
142 * or the size of the matrix. It must be at least zero.
143 *
144 * ISEED (input) INTEGER array, dimension (4)
145 * If COMP = .FALSE., the random number generator seed
146 * used to produce matrix.
147 * If COMP = .TRUE., ISEED(1) = the number of the example.
148 * Used to label output if error occurs.
149 *
150 * NOUNIT (input) INTEGER
151 * The FORTRAN unit number for printing out error messages
152 * (e.g., if a routine returns INFO not equal to 0.)
153 *
154 * N (input) INTEGER
155 * The dimension of A. N must be at least 0.
156 *
157 * A (input/output) COMPLEX array, dimension (LDA,N)
158 * Used to hold the matrix whose eigenvalues are to be
159 * computed.
160 *
161 * LDA (input) INTEGER
162 * The leading dimension of A, and H. LDA must be at
163 * least 1 and at least N.
164 *
165 * H (workspace) COMPLEX array, dimension (LDA,N)
166 * Another copy of the test matrix A, modified by CGEEVX.
167 *
168 * W (workspace) COMPLEX array, dimension (N)
169 * Contains the eigenvalues of A.
170 *
171 * W1 (workspace) COMPLEX array, dimension (N)
172 * Like W, this array contains the eigenvalues of A,
173 * but those computed when CGEEVX only computes a partial
174 * eigendecomposition, i.e. not the eigenvalues and left
175 * and right eigenvectors.
176 *
177 * VL (workspace) COMPLEX array, dimension (LDVL,N)
178 * VL holds the computed left eigenvectors.
179 *
180 * LDVL (input) INTEGER
181 * Leading dimension of VL. Must be at least max(1,N).
182 *
183 * VR (workspace) COMPLEX array, dimension (LDVR,N)
184 * VR holds the computed right eigenvectors.
185 *
186 * LDVR (input) INTEGER
187 * Leading dimension of VR. Must be at least max(1,N).
188 *
189 * LRE (workspace) COMPLEX array, dimension (LDLRE,N)
190 * LRE holds the computed right or left eigenvectors.
191 *
192 * LDLRE (input) INTEGER
193 * Leading dimension of LRE. Must be at least max(1,N).
194 *
195 * RCONDV (workspace) REAL array, dimension (N)
196 * RCONDV holds the computed reciprocal condition numbers
197 * for eigenvectors.
198 *
199 * RCNDV1 (workspace) REAL array, dimension (N)
200 * RCNDV1 holds more computed reciprocal condition numbers
201 * for eigenvectors.
202 *
203 * RCDVIN (input) REAL array, dimension (N)
204 * When COMP = .TRUE. RCDVIN holds the precomputed reciprocal
205 * condition numbers for eigenvectors to be compared with
206 * RCONDV.
207 *
208 * RCONDE (workspace) REAL array, dimension (N)
209 * RCONDE holds the computed reciprocal condition numbers
210 * for eigenvalues.
211 *
212 * RCNDE1 (workspace) REAL array, dimension (N)
213 * RCNDE1 holds more computed reciprocal condition numbers
214 * for eigenvalues.
215 *
216 * RCDEIN (input) REAL array, dimension (N)
217 * When COMP = .TRUE. RCDEIN holds the precomputed reciprocal
218 * condition numbers for eigenvalues to be compared with
219 * RCONDE.
220 *
221 * SCALE (workspace) REAL array, dimension (N)
222 * Holds information describing balancing of matrix.
223 *
224 * SCALE1 (workspace) REAL array, dimension (N)
225 * Holds information describing balancing of matrix.
226 *
227 * RESULT (output) REAL array, dimension (11)
228 * The values computed by the 11 tests described above.
229 * The values are currently limited to 1/ulp, to avoid
230 * overflow.
231 *
232 * WORK (workspace) COMPLEX array, dimension (LWORK)
233 *
234 * LWORK (input) INTEGER
235 * The number of entries in WORK. This must be at least
236 * 2*N, and 2*N+N**2 if tests 9, 10 or 11 are to be performed.
237 *
238 * RWORK (workspace) REAL array, dimension (2*N)
239 *
240 * INFO (output) INTEGER
241 * If 0, successful exit.
242 * If <0, input parameter -INFO had an incorrect value.
243 * If >0, CGEEVX returned an error code, the absolute
244 * value of which is returned.
245 *
246 * =====================================================================
247 *
248 * .. Parameters ..
249 REAL ZERO, ONE, TWO
250 PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0, TWO = 2.0E0 )
251 REAL EPSIN
252 PARAMETER ( EPSIN = 5.9605E-8 )
253 * ..
254 * .. Local Scalars ..
255 LOGICAL BALOK, NOBAL
256 CHARACTER SENSE
257 INTEGER I, IHI, IHI1, IINFO, ILO, ILO1, ISENS, ISENSM,
258 $ J, JJ, KMIN
259 REAL ABNRM, ABNRM1, EPS, SMLNUM, TNRM, TOL, TOLIN,
260 $ ULP, ULPINV, V, VMAX, VMX, VRICMP, VRIMIN,
261 $ VRMX, VTST
262 COMPLEX CTMP
263 * ..
264 * .. Local Arrays ..
265 CHARACTER SENS( 2 )
266 REAL RES( 2 )
267 COMPLEX CDUM( 1 )
268 * ..
269 * .. External Functions ..
270 LOGICAL LSAME
271 REAL SCNRM2, SLAMCH
272 EXTERNAL LSAME, SCNRM2, SLAMCH
273 * ..
274 * .. External Subroutines ..
275 EXTERNAL CGEEVX, CGET22, CLACPY, XERBLA
276 * ..
277 * .. Intrinsic Functions ..
278 INTRINSIC ABS, AIMAG, MAX, MIN, REAL
279 * ..
280 * .. Data statements ..
281 DATA SENS / 'N', 'V' /
282 * ..
283 * .. Executable Statements ..
284 *
285 * Check for errors
286 *
287 NOBAL = LSAME( BALANC, 'N' )
288 BALOK = NOBAL .OR. LSAME( BALANC, 'P' ) .OR.
289 $ LSAME( BALANC, 'S' ) .OR. LSAME( BALANC, 'B' )
290 INFO = 0
291 IF( ISRT.NE.0 .AND. ISRT.NE.1 ) THEN
292 INFO = -2
293 ELSE IF( .NOT.BALOK ) THEN
294 INFO = -3
295 ELSE IF( THRESH.LT.ZERO ) THEN
296 INFO = -5
297 ELSE IF( NOUNIT.LE.0 ) THEN
298 INFO = -7
299 ELSE IF( N.LT.0 ) THEN
300 INFO = -8
301 ELSE IF( LDA.LT.1 .OR. LDA.LT.N ) THEN
302 INFO = -10
303 ELSE IF( LDVL.LT.1 .OR. LDVL.LT.N ) THEN
304 INFO = -15
305 ELSE IF( LDVR.LT.1 .OR. LDVR.LT.N ) THEN
306 INFO = -17
307 ELSE IF( LDLRE.LT.1 .OR. LDLRE.LT.N ) THEN
308 INFO = -19
309 ELSE IF( LWORK.LT.2*N .OR. ( COMP .AND. LWORK.LT.2*N+N*N ) ) THEN
310 INFO = -30
311 END IF
312 *
313 IF( INFO.NE.0 ) THEN
314 CALL XERBLA( 'CGET23', -INFO )
315 RETURN
316 END IF
317 *
318 * Quick return if nothing to do
319 *
320 DO 10 I = 1, 11
321 RESULT( I ) = -ONE
322 10 CONTINUE
323 *
324 IF( N.EQ.0 )
325 $ RETURN
326 *
327 * More Important constants
328 *
329 ULP = SLAMCH( 'Precision' )
330 SMLNUM = SLAMCH( 'S' )
331 ULPINV = ONE / ULP
332 *
333 * Compute eigenvalues and eigenvectors, and test them
334 *
335 IF( LWORK.GE.2*N+N*N ) THEN
336 SENSE = 'B'
337 ISENSM = 2
338 ELSE
339 SENSE = 'E'
340 ISENSM = 1
341 END IF
342 CALL CLACPY( 'F', N, N, A, LDA, H, LDA )
343 CALL CGEEVX( BALANC, 'V', 'V', SENSE, N, H, LDA, W, VL, LDVL, VR,
344 $ LDVR, ILO, IHI, SCALE, ABNRM, RCONDE, RCONDV, WORK,
345 $ LWORK, RWORK, IINFO )
346 IF( IINFO.NE.0 ) THEN
347 RESULT( 1 ) = ULPINV
348 IF( JTYPE.NE.22 ) THEN
349 WRITE( NOUNIT, FMT = 9998 )'CGEEVX1', IINFO, N, JTYPE,
350 $ BALANC, ISEED
351 ELSE
352 WRITE( NOUNIT, FMT = 9999 )'CGEEVX1', IINFO, N, ISEED( 1 )
353 END IF
354 INFO = ABS( IINFO )
355 RETURN
356 END IF
357 *
358 * Do Test (1)
359 *
360 CALL CGET22( 'N', 'N', 'N', N, A, LDA, VR, LDVR, W, WORK, RWORK,
361 $ RES )
362 RESULT( 1 ) = RES( 1 )
363 *
364 * Do Test (2)
365 *
366 CALL CGET22( 'C', 'N', 'C', N, A, LDA, VL, LDVL, W, WORK, RWORK,
367 $ RES )
368 RESULT( 2 ) = RES( 1 )
369 *
370 * Do Test (3)
371 *
372 DO 30 J = 1, N
373 TNRM = SCNRM2( N, VR( 1, J ), 1 )
374 RESULT( 3 ) = MAX( RESULT( 3 ),
375 $ MIN( ULPINV, ABS( TNRM-ONE ) / ULP ) )
376 VMX = ZERO
377 VRMX = ZERO
378 DO 20 JJ = 1, N
379 VTST = ABS( VR( JJ, J ) )
380 IF( VTST.GT.VMX )
381 $ VMX = VTST
382 IF( AIMAG( VR( JJ, J ) ).EQ.ZERO .AND.
383 $ ABS( REAL( VR( JJ, J ) ) ).GT.VRMX )
384 $ VRMX = ABS( REAL( VR( JJ, J ) ) )
385 20 CONTINUE
386 IF( VRMX / VMX.LT.ONE-TWO*ULP )
387 $ RESULT( 3 ) = ULPINV
388 30 CONTINUE
389 *
390 * Do Test (4)
391 *
392 DO 50 J = 1, N
393 TNRM = SCNRM2( N, VL( 1, J ), 1 )
394 RESULT( 4 ) = MAX( RESULT( 4 ),
395 $ MIN( ULPINV, ABS( TNRM-ONE ) / ULP ) )
396 VMX = ZERO
397 VRMX = ZERO
398 DO 40 JJ = 1, N
399 VTST = ABS( VL( JJ, J ) )
400 IF( VTST.GT.VMX )
401 $ VMX = VTST
402 IF( AIMAG( VL( JJ, J ) ).EQ.ZERO .AND.
403 $ ABS( REAL( VL( JJ, J ) ) ).GT.VRMX )
404 $ VRMX = ABS( REAL( VL( JJ, J ) ) )
405 40 CONTINUE
406 IF( VRMX / VMX.LT.ONE-TWO*ULP )
407 $ RESULT( 4 ) = ULPINV
408 50 CONTINUE
409 *
410 * Test for all options of computing condition numbers
411 *
412 DO 200 ISENS = 1, ISENSM
413 *
414 SENSE = SENS( ISENS )
415 *
416 * Compute eigenvalues only, and test them
417 *
418 CALL CLACPY( 'F', N, N, A, LDA, H, LDA )
419 CALL CGEEVX( BALANC, 'N', 'N', SENSE, N, H, LDA, W1, CDUM, 1,
420 $ CDUM, 1, ILO1, IHI1, SCALE1, ABNRM1, RCNDE1,
421 $ RCNDV1, WORK, LWORK, RWORK, IINFO )
422 IF( IINFO.NE.0 ) THEN
423 RESULT( 1 ) = ULPINV
424 IF( JTYPE.NE.22 ) THEN
425 WRITE( NOUNIT, FMT = 9998 )'CGEEVX2', IINFO, N, JTYPE,
426 $ BALANC, ISEED
427 ELSE
428 WRITE( NOUNIT, FMT = 9999 )'CGEEVX2', IINFO, N,
429 $ ISEED( 1 )
430 END IF
431 INFO = ABS( IINFO )
432 GO TO 190
433 END IF
434 *
435 * Do Test (5)
436 *
437 DO 60 J = 1, N
438 IF( W( J ).NE.W1( J ) )
439 $ RESULT( 5 ) = ULPINV
440 60 CONTINUE
441 *
442 * Do Test (8)
443 *
444 IF( .NOT.NOBAL ) THEN
445 DO 70 J = 1, N
446 IF( SCALE( J ).NE.SCALE1( J ) )
447 $ RESULT( 8 ) = ULPINV
448 70 CONTINUE
449 IF( ILO.NE.ILO1 )
450 $ RESULT( 8 ) = ULPINV
451 IF( IHI.NE.IHI1 )
452 $ RESULT( 8 ) = ULPINV
453 IF( ABNRM.NE.ABNRM1 )
454 $ RESULT( 8 ) = ULPINV
455 END IF
456 *
457 * Do Test (9)
458 *
459 IF( ISENS.EQ.2 .AND. N.GT.1 ) THEN
460 DO 80 J = 1, N
461 IF( RCONDV( J ).NE.RCNDV1( J ) )
462 $ RESULT( 9 ) = ULPINV
463 80 CONTINUE
464 END IF
465 *
466 * Compute eigenvalues and right eigenvectors, and test them
467 *
468 CALL CLACPY( 'F', N, N, A, LDA, H, LDA )
469 CALL CGEEVX( BALANC, 'N', 'V', SENSE, N, H, LDA, W1, CDUM, 1,
470 $ LRE, LDLRE, ILO1, IHI1, SCALE1, ABNRM1, RCNDE1,
471 $ RCNDV1, WORK, LWORK, RWORK, IINFO )
472 IF( IINFO.NE.0 ) THEN
473 RESULT( 1 ) = ULPINV
474 IF( JTYPE.NE.22 ) THEN
475 WRITE( NOUNIT, FMT = 9998 )'CGEEVX3', IINFO, N, JTYPE,
476 $ BALANC, ISEED
477 ELSE
478 WRITE( NOUNIT, FMT = 9999 )'CGEEVX3', IINFO, N,
479 $ ISEED( 1 )
480 END IF
481 INFO = ABS( IINFO )
482 GO TO 190
483 END IF
484 *
485 * Do Test (5) again
486 *
487 DO 90 J = 1, N
488 IF( W( J ).NE.W1( J ) )
489 $ RESULT( 5 ) = ULPINV
490 90 CONTINUE
491 *
492 * Do Test (6)
493 *
494 DO 110 J = 1, N
495 DO 100 JJ = 1, N
496 IF( VR( J, JJ ).NE.LRE( J, JJ ) )
497 $ RESULT( 6 ) = ULPINV
498 100 CONTINUE
499 110 CONTINUE
500 *
501 * Do Test (8) again
502 *
503 IF( .NOT.NOBAL ) THEN
504 DO 120 J = 1, N
505 IF( SCALE( J ).NE.SCALE1( J ) )
506 $ RESULT( 8 ) = ULPINV
507 120 CONTINUE
508 IF( ILO.NE.ILO1 )
509 $ RESULT( 8 ) = ULPINV
510 IF( IHI.NE.IHI1 )
511 $ RESULT( 8 ) = ULPINV
512 IF( ABNRM.NE.ABNRM1 )
513 $ RESULT( 8 ) = ULPINV
514 END IF
515 *
516 * Do Test (9) again
517 *
518 IF( ISENS.EQ.2 .AND. N.GT.1 ) THEN
519 DO 130 J = 1, N
520 IF( RCONDV( J ).NE.RCNDV1( J ) )
521 $ RESULT( 9 ) = ULPINV
522 130 CONTINUE
523 END IF
524 *
525 * Compute eigenvalues and left eigenvectors, and test them
526 *
527 CALL CLACPY( 'F', N, N, A, LDA, H, LDA )
528 CALL CGEEVX( BALANC, 'V', 'N', SENSE, N, H, LDA, W1, LRE,
529 $ LDLRE, CDUM, 1, ILO1, IHI1, SCALE1, ABNRM1,
530 $ RCNDE1, RCNDV1, WORK, LWORK, RWORK, IINFO )
531 IF( IINFO.NE.0 ) THEN
532 RESULT( 1 ) = ULPINV
533 IF( JTYPE.NE.22 ) THEN
534 WRITE( NOUNIT, FMT = 9998 )'CGEEVX4', IINFO, N, JTYPE,
535 $ BALANC, ISEED
536 ELSE
537 WRITE( NOUNIT, FMT = 9999 )'CGEEVX4', IINFO, N,
538 $ ISEED( 1 )
539 END IF
540 INFO = ABS( IINFO )
541 GO TO 190
542 END IF
543 *
544 * Do Test (5) again
545 *
546 DO 140 J = 1, N
547 IF( W( J ).NE.W1( J ) )
548 $ RESULT( 5 ) = ULPINV
549 140 CONTINUE
550 *
551 * Do Test (7)
552 *
553 DO 160 J = 1, N
554 DO 150 JJ = 1, N
555 IF( VL( J, JJ ).NE.LRE( J, JJ ) )
556 $ RESULT( 7 ) = ULPINV
557 150 CONTINUE
558 160 CONTINUE
559 *
560 * Do Test (8) again
561 *
562 IF( .NOT.NOBAL ) THEN
563 DO 170 J = 1, N
564 IF( SCALE( J ).NE.SCALE1( J ) )
565 $ RESULT( 8 ) = ULPINV
566 170 CONTINUE
567 IF( ILO.NE.ILO1 )
568 $ RESULT( 8 ) = ULPINV
569 IF( IHI.NE.IHI1 )
570 $ RESULT( 8 ) = ULPINV
571 IF( ABNRM.NE.ABNRM1 )
572 $ RESULT( 8 ) = ULPINV
573 END IF
574 *
575 * Do Test (9) again
576 *
577 IF( ISENS.EQ.2 .AND. N.GT.1 ) THEN
578 DO 180 J = 1, N
579 IF( RCONDV( J ).NE.RCNDV1( J ) )
580 $ RESULT( 9 ) = ULPINV
581 180 CONTINUE
582 END IF
583 *
584 190 CONTINUE
585 *
586 200 CONTINUE
587 *
588 * If COMP, compare condition numbers to precomputed ones
589 *
590 IF( COMP ) THEN
591 CALL CLACPY( 'F', N, N, A, LDA, H, LDA )
592 CALL CGEEVX( 'N', 'V', 'V', 'B', N, H, LDA, W, VL, LDVL, VR,
593 $ LDVR, ILO, IHI, SCALE, ABNRM, RCONDE, RCONDV,
594 $ WORK, LWORK, RWORK, IINFO )
595 IF( IINFO.NE.0 ) THEN
596 RESULT( 1 ) = ULPINV
597 WRITE( NOUNIT, FMT = 9999 )'CGEEVX5', IINFO, N, ISEED( 1 )
598 INFO = ABS( IINFO )
599 GO TO 250
600 END IF
601 *
602 * Sort eigenvalues and condition numbers lexicographically
603 * to compare with inputs
604 *
605 DO 220 I = 1, N - 1
606 KMIN = I
607 IF( ISRT.EQ.0 ) THEN
608 VRIMIN = REAL( W( I ) )
609 ELSE
610 VRIMIN = AIMAG( W( I ) )
611 END IF
612 DO 210 J = I + 1, N
613 IF( ISRT.EQ.0 ) THEN
614 VRICMP = REAL( W( J ) )
615 ELSE
616 VRICMP = AIMAG( W( J ) )
617 END IF
618 IF( VRICMP.LT.VRIMIN ) THEN
619 KMIN = J
620 VRIMIN = VRICMP
621 END IF
622 210 CONTINUE
623 CTMP = W( KMIN )
624 W( KMIN ) = W( I )
625 W( I ) = CTMP
626 VRIMIN = RCONDE( KMIN )
627 RCONDE( KMIN ) = RCONDE( I )
628 RCONDE( I ) = VRIMIN
629 VRIMIN = RCONDV( KMIN )
630 RCONDV( KMIN ) = RCONDV( I )
631 RCONDV( I ) = VRIMIN
632 220 CONTINUE
633 *
634 * Compare condition numbers for eigenvectors
635 * taking their condition numbers into account
636 *
637 RESULT( 10 ) = ZERO
638 EPS = MAX( EPSIN, ULP )
639 V = MAX( REAL( N )*EPS*ABNRM, SMLNUM )
640 IF( ABNRM.EQ.ZERO )
641 $ V = ONE
642 DO 230 I = 1, N
643 IF( V.GT.RCONDV( I )*RCONDE( I ) ) THEN
644 TOL = RCONDV( I )
645 ELSE
646 TOL = V / RCONDE( I )
647 END IF
648 IF( V.GT.RCDVIN( I )*RCDEIN( I ) ) THEN
649 TOLIN = RCDVIN( I )
650 ELSE
651 TOLIN = V / RCDEIN( I )
652 END IF
653 TOL = MAX( TOL, SMLNUM / EPS )
654 TOLIN = MAX( TOLIN, SMLNUM / EPS )
655 IF( EPS*( RCDVIN( I )-TOLIN ).GT.RCONDV( I )+TOL ) THEN
656 VMAX = ONE / EPS
657 ELSE IF( RCDVIN( I )-TOLIN.GT.RCONDV( I )+TOL ) THEN
658 VMAX = ( RCDVIN( I )-TOLIN ) / ( RCONDV( I )+TOL )
659 ELSE IF( RCDVIN( I )+TOLIN.LT.EPS*( RCONDV( I )-TOL ) ) THEN
660 VMAX = ONE / EPS
661 ELSE IF( RCDVIN( I )+TOLIN.LT.RCONDV( I )-TOL ) THEN
662 VMAX = ( RCONDV( I )-TOL ) / ( RCDVIN( I )+TOLIN )
663 ELSE
664 VMAX = ONE
665 END IF
666 RESULT( 10 ) = MAX( RESULT( 10 ), VMAX )
667 230 CONTINUE
668 *
669 * Compare condition numbers for eigenvalues
670 * taking their condition numbers into account
671 *
672 RESULT( 11 ) = ZERO
673 DO 240 I = 1, N
674 IF( V.GT.RCONDV( I ) ) THEN
675 TOL = ONE
676 ELSE
677 TOL = V / RCONDV( I )
678 END IF
679 IF( V.GT.RCDVIN( I ) ) THEN
680 TOLIN = ONE
681 ELSE
682 TOLIN = V / RCDVIN( I )
683 END IF
684 TOL = MAX( TOL, SMLNUM / EPS )
685 TOLIN = MAX( TOLIN, SMLNUM / EPS )
686 IF( EPS*( RCDEIN( I )-TOLIN ).GT.RCONDE( I )+TOL ) THEN
687 VMAX = ONE / EPS
688 ELSE IF( RCDEIN( I )-TOLIN.GT.RCONDE( I )+TOL ) THEN
689 VMAX = ( RCDEIN( I )-TOLIN ) / ( RCONDE( I )+TOL )
690 ELSE IF( RCDEIN( I )+TOLIN.LT.EPS*( RCONDE( I )-TOL ) ) THEN
691 VMAX = ONE / EPS
692 ELSE IF( RCDEIN( I )+TOLIN.LT.RCONDE( I )-TOL ) THEN
693 VMAX = ( RCONDE( I )-TOL ) / ( RCDEIN( I )+TOLIN )
694 ELSE
695 VMAX = ONE
696 END IF
697 RESULT( 11 ) = MAX( RESULT( 11 ), VMAX )
698 240 CONTINUE
699 250 CONTINUE
700 *
701 END IF
702 *
703 9999 FORMAT( ' CGET23: ', A, ' returned INFO=', I6, '.', / 9X, 'N=',
704 $ I6, ', INPUT EXAMPLE NUMBER = ', I4 )
705 9998 FORMAT( ' CGET23: ', A, ' returned INFO=', I6, '.', / 9X, 'N=',
706 $ I6, ', JTYPE=', I6, ', BALANC = ', A, ', ISEED=(',
707 $ 3( I5, ',' ), I5, ')' )
708 *
709 RETURN
710 *
711 * End of CGET23
712 *
713 END