1 SUBROUTINE CCHKHB( NSIZES, NN, NWDTHS, KK, NTYPES, DOTYPE, ISEED,
2 $ THRESH, NOUNIT, A, LDA, SD, SE, U, LDU, WORK,
3 $ LWORK, RWORK, RESULT, INFO )
4 *
5 * -- LAPACK test routine (version 3.1) --
6 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
7 * November 2006
8 *
9 * .. Scalar Arguments ..
10 INTEGER INFO, LDA, LDU, LWORK, NOUNIT, NSIZES, NTYPES,
11 $ NWDTHS
12 REAL THRESH
13 * ..
14 * .. Array Arguments ..
15 LOGICAL DOTYPE( * )
16 INTEGER ISEED( 4 ), KK( * ), NN( * )
17 REAL RESULT( * ), RWORK( * ), SD( * ), SE( * )
18 COMPLEX A( LDA, * ), U( LDU, * ), WORK( * )
19 * ..
20 *
21 * Purpose
22 * =======
23 *
24 * CCHKHB tests the reduction of a Hermitian band matrix to tridiagonal
25 * from, used with the Hermitian eigenvalue problem.
26 *
27 * CHBTRD factors a Hermitian band matrix A as U S U* , where * means
28 * conjugate transpose, S is symmetric tridiagonal, and U is unitary.
29 * CHBTRD can use either just the lower or just the upper triangle
30 * of A; CCHKHB checks both cases.
31 *
32 * When CCHKHB is called, a number of matrix "sizes" ("n's"), a number
33 * of bandwidths ("k's"), and a number of matrix "types" are
34 * specified. For each size ("n"), each bandwidth ("k") less than or
35 * equal to "n", and each type of matrix, one matrix will be generated
36 * and used to test the hermitian banded reduction routine. For each
37 * matrix, a number of tests will be performed:
38 *
39 * (1) | A - V S V* | / ( |A| n ulp ) computed by CHBTRD with
40 * UPLO='U'
41 *
42 * (2) | I - UU* | / ( n ulp )
43 *
44 * (3) | A - V S V* | / ( |A| n ulp ) computed by CHBTRD with
45 * UPLO='L'
46 *
47 * (4) | I - UU* | / ( n ulp )
48 *
49 * The "sizes" are specified by an array NN(1:NSIZES); the value of
50 * each element NN(j) specifies one size.
51 * The "types" are specified by a logical array DOTYPE( 1:NTYPES );
52 * if DOTYPE(j) is .TRUE., then matrix type "j" will be generated.
53 * Currently, the list of possible types is:
54 *
55 * (1) The zero matrix.
56 * (2) The identity matrix.
57 *
58 * (3) A diagonal matrix with evenly spaced entries
59 * 1, ..., ULP and random signs.
60 * (ULP = (first number larger than 1) - 1 )
61 * (4) A diagonal matrix with geometrically spaced entries
62 * 1, ..., ULP and random signs.
63 * (5) A diagonal matrix with "clustered" entries 1, ULP, ..., ULP
64 * and random signs.
65 *
66 * (6) Same as (4), but multiplied by SQRT( overflow threshold )
67 * (7) Same as (4), but multiplied by SQRT( underflow threshold )
68 *
69 * (8) A matrix of the form U* D U, where U is unitary and
70 * D has evenly spaced entries 1, ..., ULP with random signs
71 * on the diagonal.
72 *
73 * (9) A matrix of the form U* D U, where U is unitary and
74 * D has geometrically spaced entries 1, ..., ULP with random
75 * signs on the diagonal.
76 *
77 * (10) A matrix of the form U* D U, where U is unitary and
78 * D has "clustered" entries 1, ULP,..., ULP with random
79 * signs on the diagonal.
80 *
81 * (11) Same as (8), but multiplied by SQRT( overflow threshold )
82 * (12) Same as (8), but multiplied by SQRT( underflow threshold )
83 *
84 * (13) Hermitian matrix with random entries chosen from (-1,1).
85 * (14) Same as (13), but multiplied by SQRT( overflow threshold )
86 * (15) Same as (13), but multiplied by SQRT( underflow threshold )
87 *
88 * Arguments
89 * =========
90 *
91 * NSIZES (input) INTEGER
92 * The number of sizes of matrices to use. If it is zero,
93 * CCHKHB does nothing. It must be at least zero.
94 *
95 * NN (input) INTEGER array, dimension (NSIZES)
96 * An array containing the sizes to be used for the matrices.
97 * Zero values will be skipped. The values must be at least
98 * zero.
99 *
100 * NWDTHS (input) INTEGER
101 * The number of bandwidths to use. If it is zero,
102 * CCHKHB does nothing. It must be at least zero.
103 *
104 * KK (input) INTEGER array, dimension (NWDTHS)
105 * An array containing the bandwidths to be used for the band
106 * matrices. The values must be at least zero.
107 *
108 * NTYPES (input) INTEGER
109 * The number of elements in DOTYPE. If it is zero, CCHKHB
110 * does nothing. It must be at least zero. If it is MAXTYP+1
111 * and NSIZES is 1, then an additional type, MAXTYP+1 is
112 * defined, which is to use whatever matrix is in A. This
113 * is only useful if DOTYPE(1:MAXTYP) is .FALSE. and
114 * DOTYPE(MAXTYP+1) is .TRUE. .
115 *
116 * DOTYPE (input) LOGICAL array, dimension (NTYPES)
117 * If DOTYPE(j) is .TRUE., then for each size in NN a
118 * matrix of that size and of type j will be generated.
119 * If NTYPES is smaller than the maximum number of types
120 * defined (PARAMETER MAXTYP), then types NTYPES+1 through
121 * MAXTYP will not be generated. If NTYPES is larger
122 * than MAXTYP, DOTYPE(MAXTYP+1) through DOTYPE(NTYPES)
123 * will be ignored.
124 *
125 * ISEED (input/output) INTEGER array, dimension (4)
126 * On entry ISEED specifies the seed of the random number
127 * generator. The array elements should be between 0 and 4095;
128 * if not they will be reduced mod 4096. Also, ISEED(4) must
129 * be odd. The random number generator uses a linear
130 * congruential sequence limited to small integers, and so
131 * should produce machine independent random numbers. The
132 * values of ISEED are changed on exit, and can be used in the
133 * next call to CCHKHB to continue the same random number
134 * sequence.
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 * NOUNIT (input) INTEGER
145 * The FORTRAN unit number for printing out error messages
146 * (e.g., if a routine returns IINFO not equal to 0.)
147 *
148 * A (input/workspace) REAL array, dimension
149 * (LDA, max(NN))
150 * Used to hold the matrix whose eigenvalues are to be
151 * computed.
152 *
153 * LDA (input) INTEGER
154 * The leading dimension of A. It must be at least 2 (not 1!)
155 * and at least max( KK )+1.
156 *
157 * SD (workspace) REAL array, dimension (max(NN))
158 * Used to hold the diagonal of the tridiagonal matrix computed
159 * by CHBTRD.
160 *
161 * SE (workspace) REAL array, dimension (max(NN))
162 * Used to hold the off-diagonal of the tridiagonal matrix
163 * computed by CHBTRD.
164 *
165 * U (workspace) REAL array, dimension (LDU, max(NN))
166 * Used to hold the unitary matrix computed by CHBTRD.
167 *
168 * LDU (input) INTEGER
169 * The leading dimension of U. It must be at least 1
170 * and at least max( NN ).
171 *
172 * WORK (workspace) REAL array, dimension (LWORK)
173 *
174 * LWORK (input) INTEGER
175 * The number of entries in WORK. This must be at least
176 * max( LDA+1, max(NN)+1 )*max(NN).
177 *
178 * RESULT (output) REAL array, dimension (4)
179 * The values computed by the tests described above.
180 * The values are currently limited to 1/ulp, to avoid
181 * overflow.
182 *
183 * INFO (output) INTEGER
184 * If 0, then everything ran OK.
185 *
186 *-----------------------------------------------------------------------
187 *
188 * Some Local Variables and Parameters:
189 * ---- ----- --------- --- ----------
190 * ZERO, ONE Real 0 and 1.
191 * MAXTYP The number of types defined.
192 * NTEST The number of tests performed, or which can
193 * be performed so far, for the current matrix.
194 * NTESTT The total number of tests performed so far.
195 * NMAX Largest value in NN.
196 * NMATS The number of matrices generated so far.
197 * NERRS The number of tests which have exceeded THRESH
198 * so far.
199 * COND, IMODE Values to be passed to the matrix generators.
200 * ANORM Norm of A; passed to matrix generators.
201 *
202 * OVFL, UNFL Overflow and underflow thresholds.
203 * ULP, ULPINV Finest relative precision and its inverse.
204 * RTOVFL, RTUNFL Square roots of the previous 2 values.
205 * The following four arrays decode JTYPE:
206 * KTYPE(j) The general type (1-10) for type "j".
207 * KMODE(j) The MODE value to be passed to the matrix
208 * generator for type "j".
209 * KMAGN(j) The order of magnitude ( O(1),
210 * O(overflow^(1/2) ), O(underflow^(1/2) )
211 *
212 * =====================================================================
213 *
214 * .. Parameters ..
215 COMPLEX CZERO, CONE
216 PARAMETER ( CZERO = ( 0.0E+0, 0.0E+0 ),
217 $ CONE = ( 1.0E+0, 0.0E+0 ) )
218 REAL ZERO, ONE, TWO, TEN
219 PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0, TWO = 2.0E+0,
220 $ TEN = 10.0E+0 )
221 REAL HALF
222 PARAMETER ( HALF = ONE / TWO )
223 INTEGER MAXTYP
224 PARAMETER ( MAXTYP = 15 )
225 * ..
226 * .. Local Scalars ..
227 LOGICAL BADNN, BADNNB
228 INTEGER I, IINFO, IMODE, ITYPE, J, JC, JCOL, JR, JSIZE,
229 $ JTYPE, JWIDTH, K, KMAX, MTYPES, N, NERRS,
230 $ NMATS, NMAX, NTEST, NTESTT
231 REAL ANINV, ANORM, COND, OVFL, RTOVFL, RTUNFL,
232 $ TEMP1, ULP, ULPINV, UNFL
233 * ..
234 * .. Local Arrays ..
235 INTEGER IDUMMA( 1 ), IOLDSD( 4 ), KMAGN( MAXTYP ),
236 $ KMODE( MAXTYP ), KTYPE( MAXTYP )
237 * ..
238 * .. External Functions ..
239 REAL SLAMCH
240 EXTERNAL SLAMCH
241 * ..
242 * .. External Subroutines ..
243 EXTERNAL CHBT21, CHBTRD, CLACPY, CLATMR, CLATMS, CLASET,
244 $ SLASUM, XERBLA
245 * ..
246 * .. Intrinsic Functions ..
247 INTRINSIC ABS, CONJG, MAX, MIN, REAL, SQRT
248 * ..
249 * .. Data statements ..
250 DATA KTYPE / 1, 2, 5*4, 5*5, 3*8 /
251 DATA KMAGN / 2*1, 1, 1, 1, 2, 3, 1, 1, 1, 2, 3, 1,
252 $ 2, 3 /
253 DATA KMODE / 2*0, 4, 3, 1, 4, 4, 4, 3, 1, 4, 4, 0,
254 $ 0, 0 /
255 * ..
256 * .. Executable Statements ..
257 *
258 * Check for errors
259 *
260 NTESTT = 0
261 INFO = 0
262 *
263 * Important constants
264 *
265 BADNN = .FALSE.
266 NMAX = 1
267 DO 10 J = 1, NSIZES
268 NMAX = MAX( NMAX, NN( J ) )
269 IF( NN( J ).LT.0 )
270 $ BADNN = .TRUE.
271 10 CONTINUE
272 *
273 BADNNB = .FALSE.
274 KMAX = 0
275 DO 20 J = 1, NSIZES
276 KMAX = MAX( KMAX, KK( J ) )
277 IF( KK( J ).LT.0 )
278 $ BADNNB = .TRUE.
279 20 CONTINUE
280 KMAX = MIN( NMAX-1, KMAX )
281 *
282 * Check for errors
283 *
284 IF( NSIZES.LT.0 ) THEN
285 INFO = -1
286 ELSE IF( BADNN ) THEN
287 INFO = -2
288 ELSE IF( NWDTHS.LT.0 ) THEN
289 INFO = -3
290 ELSE IF( BADNNB ) THEN
291 INFO = -4
292 ELSE IF( NTYPES.LT.0 ) THEN
293 INFO = -5
294 ELSE IF( LDA.LT.KMAX+1 ) THEN
295 INFO = -11
296 ELSE IF( LDU.LT.NMAX ) THEN
297 INFO = -15
298 ELSE IF( ( MAX( LDA, NMAX )+1 )*NMAX.GT.LWORK ) THEN
299 INFO = -17
300 END IF
301 *
302 IF( INFO.NE.0 ) THEN
303 CALL XERBLA( 'CCHKHB', -INFO )
304 RETURN
305 END IF
306 *
307 * Quick return if possible
308 *
309 IF( NSIZES.EQ.0 .OR. NTYPES.EQ.0 .OR. NWDTHS.EQ.0 )
310 $ RETURN
311 *
312 * More Important constants
313 *
314 UNFL = SLAMCH( 'Safe minimum' )
315 OVFL = ONE / UNFL
316 ULP = SLAMCH( 'Epsilon' )*SLAMCH( 'Base' )
317 ULPINV = ONE / ULP
318 RTUNFL = SQRT( UNFL )
319 RTOVFL = SQRT( OVFL )
320 *
321 * Loop over sizes, types
322 *
323 NERRS = 0
324 NMATS = 0
325 *
326 DO 190 JSIZE = 1, NSIZES
327 N = NN( JSIZE )
328 ANINV = ONE / REAL( MAX( 1, N ) )
329 *
330 DO 180 JWIDTH = 1, NWDTHS
331 K = KK( JWIDTH )
332 IF( K.GT.N )
333 $ GO TO 180
334 K = MAX( 0, MIN( N-1, K ) )
335 *
336 IF( NSIZES.NE.1 ) THEN
337 MTYPES = MIN( MAXTYP, NTYPES )
338 ELSE
339 MTYPES = MIN( MAXTYP+1, NTYPES )
340 END IF
341 *
342 DO 170 JTYPE = 1, MTYPES
343 IF( .NOT.DOTYPE( JTYPE ) )
344 $ GO TO 170
345 NMATS = NMATS + 1
346 NTEST = 0
347 *
348 DO 30 J = 1, 4
349 IOLDSD( J ) = ISEED( J )
350 30 CONTINUE
351 *
352 * Compute "A".
353 * Store as "Upper"; later, we will copy to other format.
354 *
355 * Control parameters:
356 *
357 * KMAGN KMODE KTYPE
358 * =1 O(1) clustered 1 zero
359 * =2 large clustered 2 identity
360 * =3 small exponential (none)
361 * =4 arithmetic diagonal, (w/ eigenvalues)
362 * =5 random log hermitian, w/ eigenvalues
363 * =6 random (none)
364 * =7 random diagonal
365 * =8 random hermitian
366 * =9 positive definite
367 * =10 diagonally dominant tridiagonal
368 *
369 IF( MTYPES.GT.MAXTYP )
370 $ GO TO 100
371 *
372 ITYPE = KTYPE( JTYPE )
373 IMODE = KMODE( JTYPE )
374 *
375 * Compute norm
376 *
377 GO TO ( 40, 50, 60 )KMAGN( JTYPE )
378 *
379 40 CONTINUE
380 ANORM = ONE
381 GO TO 70
382 *
383 50 CONTINUE
384 ANORM = ( RTOVFL*ULP )*ANINV
385 GO TO 70
386 *
387 60 CONTINUE
388 ANORM = RTUNFL*N*ULPINV
389 GO TO 70
390 *
391 70 CONTINUE
392 *
393 CALL CLASET( 'Full', LDA, N, CZERO, CZERO, A, LDA )
394 IINFO = 0
395 IF( JTYPE.LE.15 ) THEN
396 COND = ULPINV
397 ELSE
398 COND = ULPINV*ANINV / TEN
399 END IF
400 *
401 * Special Matrices -- Identity & Jordan block
402 *
403 * Zero
404 *
405 IF( ITYPE.EQ.1 ) THEN
406 IINFO = 0
407 *
408 ELSE IF( ITYPE.EQ.2 ) THEN
409 *
410 * Identity
411 *
412 DO 80 JCOL = 1, N
413 A( K+1, JCOL ) = ANORM
414 80 CONTINUE
415 *
416 ELSE IF( ITYPE.EQ.4 ) THEN
417 *
418 * Diagonal Matrix, [Eigen]values Specified
419 *
420 CALL CLATMS( N, N, 'S', ISEED, 'H', RWORK, IMODE,
421 $ COND, ANORM, 0, 0, 'Q', A( K+1, 1 ), LDA,
422 $ WORK, IINFO )
423 *
424 ELSE IF( ITYPE.EQ.5 ) THEN
425 *
426 * Hermitian, eigenvalues specified
427 *
428 CALL CLATMS( N, N, 'S', ISEED, 'H', RWORK, IMODE,
429 $ COND, ANORM, K, K, 'Q', A, LDA, WORK,
430 $ IINFO )
431 *
432 ELSE IF( ITYPE.EQ.7 ) THEN
433 *
434 * Diagonal, random eigenvalues
435 *
436 CALL CLATMR( N, N, 'S', ISEED, 'H', WORK, 6, ONE,
437 $ CONE, 'T', 'N', WORK( N+1 ), 1, ONE,
438 $ WORK( 2*N+1 ), 1, ONE, 'N', IDUMMA, 0, 0,
439 $ ZERO, ANORM, 'Q', A( K+1, 1 ), LDA,
440 $ IDUMMA, IINFO )
441 *
442 ELSE IF( ITYPE.EQ.8 ) THEN
443 *
444 * Hermitian, random eigenvalues
445 *
446 CALL CLATMR( N, N, 'S', ISEED, 'H', WORK, 6, ONE,
447 $ CONE, 'T', 'N', WORK( N+1 ), 1, ONE,
448 $ WORK( 2*N+1 ), 1, ONE, 'N', IDUMMA, K, K,
449 $ ZERO, ANORM, 'Q', A, LDA, IDUMMA, IINFO )
450 *
451 ELSE IF( ITYPE.EQ.9 ) THEN
452 *
453 * Positive definite, eigenvalues specified.
454 *
455 CALL CLATMS( N, N, 'S', ISEED, 'P', RWORK, IMODE,
456 $ COND, ANORM, K, K, 'Q', A, LDA,
457 $ WORK( N+1 ), IINFO )
458 *
459 ELSE IF( ITYPE.EQ.10 ) THEN
460 *
461 * Positive definite tridiagonal, eigenvalues specified.
462 *
463 IF( N.GT.1 )
464 $ K = MAX( 1, K )
465 CALL CLATMS( N, N, 'S', ISEED, 'P', RWORK, IMODE,
466 $ COND, ANORM, 1, 1, 'Q', A( K, 1 ), LDA,
467 $ WORK, IINFO )
468 DO 90 I = 2, N
469 TEMP1 = ABS( A( K, I ) ) /
470 $ SQRT( ABS( A( K+1, I-1 )*A( K+1, I ) ) )
471 IF( TEMP1.GT.HALF ) THEN
472 A( K, I ) = HALF*SQRT( ABS( A( K+1,
473 $ I-1 )*A( K+1, I ) ) )
474 END IF
475 90 CONTINUE
476 *
477 ELSE
478 *
479 IINFO = 1
480 END IF
481 *
482 IF( IINFO.NE.0 ) THEN
483 WRITE( NOUNIT, FMT = 9999 )'Generator', IINFO, N,
484 $ JTYPE, IOLDSD
485 INFO = ABS( IINFO )
486 RETURN
487 END IF
488 *
489 100 CONTINUE
490 *
491 * Call CHBTRD to compute S and U from upper triangle.
492 *
493 CALL CLACPY( ' ', K+1, N, A, LDA, WORK, LDA )
494 *
495 NTEST = 1
496 CALL CHBTRD( 'V', 'U', N, K, WORK, LDA, SD, SE, U, LDU,
497 $ WORK( LDA*N+1 ), IINFO )
498 *
499 IF( IINFO.NE.0 ) THEN
500 WRITE( NOUNIT, FMT = 9999 )'CHBTRD(U)', IINFO, N,
501 $ JTYPE, IOLDSD
502 INFO = ABS( IINFO )
503 IF( IINFO.LT.0 ) THEN
504 RETURN
505 ELSE
506 RESULT( 1 ) = ULPINV
507 GO TO 150
508 END IF
509 END IF
510 *
511 * Do tests 1 and 2
512 *
513 CALL CHBT21( 'Upper', N, K, 1, A, LDA, SD, SE, U, LDU,
514 $ WORK, RWORK, RESULT( 1 ) )
515 *
516 * Convert A from Upper-Triangle-Only storage to
517 * Lower-Triangle-Only storage.
518 *
519 DO 120 JC = 1, N
520 DO 110 JR = 0, MIN( K, N-JC )
521 A( JR+1, JC ) = CONJG( A( K+1-JR, JC+JR ) )
522 110 CONTINUE
523 120 CONTINUE
524 DO 140 JC = N + 1 - K, N
525 DO 130 JR = MIN( K, N-JC ) + 1, K
526 A( JR+1, JC ) = ZERO
527 130 CONTINUE
528 140 CONTINUE
529 *
530 * Call CHBTRD to compute S and U from lower triangle
531 *
532 CALL CLACPY( ' ', K+1, N, A, LDA, WORK, LDA )
533 *
534 NTEST = 3
535 CALL CHBTRD( 'V', 'L', N, K, WORK, LDA, SD, SE, U, LDU,
536 $ WORK( LDA*N+1 ), IINFO )
537 *
538 IF( IINFO.NE.0 ) THEN
539 WRITE( NOUNIT, FMT = 9999 )'CHBTRD(L)', IINFO, N,
540 $ JTYPE, IOLDSD
541 INFO = ABS( IINFO )
542 IF( IINFO.LT.0 ) THEN
543 RETURN
544 ELSE
545 RESULT( 3 ) = ULPINV
546 GO TO 150
547 END IF
548 END IF
549 NTEST = 4
550 *
551 * Do tests 3 and 4
552 *
553 CALL CHBT21( 'Lower', N, K, 1, A, LDA, SD, SE, U, LDU,
554 $ WORK, RWORK, RESULT( 3 ) )
555 *
556 * End of Loop -- Check for RESULT(j) > THRESH
557 *
558 150 CONTINUE
559 NTESTT = NTESTT + NTEST
560 *
561 * Print out tests which fail.
562 *
563 DO 160 JR = 1, NTEST
564 IF( RESULT( JR ).GE.THRESH ) THEN
565 *
566 * If this is the first test to fail,
567 * print a header to the data file.
568 *
569 IF( NERRS.EQ.0 ) THEN
570 WRITE( NOUNIT, FMT = 9998 )'CHB'
571 WRITE( NOUNIT, FMT = 9997 )
572 WRITE( NOUNIT, FMT = 9996 )
573 WRITE( NOUNIT, FMT = 9995 )'Hermitian'
574 WRITE( NOUNIT, FMT = 9994 )'unitary', '*',
575 $ 'conjugate transpose', ( '*', J = 1, 4 )
576 END IF
577 NERRS = NERRS + 1
578 WRITE( NOUNIT, FMT = 9993 )N, K, IOLDSD, JTYPE,
579 $ JR, RESULT( JR )
580 END IF
581 160 CONTINUE
582 *
583 170 CONTINUE
584 180 CONTINUE
585 190 CONTINUE
586 *
587 * Summary
588 *
589 CALL SLASUM( 'CHB', NOUNIT, NERRS, NTESTT )
590 RETURN
591 *
592 9999 FORMAT( ' CCHKHB: ', A, ' returned INFO=', I6, '.', / 9X, 'N=',
593 $ I6, ', JTYPE=', I6, ', ISEED=(', 3( I5, ',' ), I5, ')' )
594 9998 FORMAT( / 1X, A3,
595 $ ' -- Complex Hermitian Banded Tridiagonal Reduction Routines'
596 $ )
597 9997 FORMAT( ' Matrix types (see SCHK23 for details): ' )
598 *
599 9996 FORMAT( / ' Special Matrices:',
600 $ / ' 1=Zero matrix. ',
601 $ ' 5=Diagonal: clustered entries.',
602 $ / ' 2=Identity matrix. ',
603 $ ' 6=Diagonal: large, evenly spaced.',
604 $ / ' 3=Diagonal: evenly spaced entries. ',
605 $ ' 7=Diagonal: small, evenly spaced.',
606 $ / ' 4=Diagonal: geometr. spaced entries.' )
607 9995 FORMAT( ' Dense ', A, ' Banded Matrices:',
608 $ / ' 8=Evenly spaced eigenvals. ',
609 $ ' 12=Small, evenly spaced eigenvals.',
610 $ / ' 9=Geometrically spaced eigenvals. ',
611 $ ' 13=Matrix with random O(1) entries.',
612 $ / ' 10=Clustered eigenvalues. ',
613 $ ' 14=Matrix with large random entries.',
614 $ / ' 11=Large, evenly spaced eigenvals. ',
615 $ ' 15=Matrix with small random entries.' )
616 *
617 9994 FORMAT( / ' Tests performed: (S is Tridiag, U is ', A, ',',
618 $ / 20X, A, ' means ', A, '.', / ' UPLO=''U'':',
619 $ / ' 1= | A - U S U', A1, ' | / ( |A| n ulp ) ',
620 $ ' 2= | I - U U', A1, ' | / ( n ulp )', / ' UPLO=''L'':',
621 $ / ' 3= | A - U S U', A1, ' | / ( |A| n ulp ) ',
622 $ ' 4= | I - U U', A1, ' | / ( n ulp )' )
623 9993 FORMAT( ' N=', I5, ', K=', I4, ', seed=', 4( I4, ',' ), ' type ',
624 $ I2, ', test(', I2, ')=', G10.3 )
625 *
626 * End of CCHKHB
627 *
628 END
2 $ THRESH, NOUNIT, A, LDA, SD, SE, U, LDU, WORK,
3 $ LWORK, RWORK, RESULT, INFO )
4 *
5 * -- LAPACK test routine (version 3.1) --
6 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
7 * November 2006
8 *
9 * .. Scalar Arguments ..
10 INTEGER INFO, LDA, LDU, LWORK, NOUNIT, NSIZES, NTYPES,
11 $ NWDTHS
12 REAL THRESH
13 * ..
14 * .. Array Arguments ..
15 LOGICAL DOTYPE( * )
16 INTEGER ISEED( 4 ), KK( * ), NN( * )
17 REAL RESULT( * ), RWORK( * ), SD( * ), SE( * )
18 COMPLEX A( LDA, * ), U( LDU, * ), WORK( * )
19 * ..
20 *
21 * Purpose
22 * =======
23 *
24 * CCHKHB tests the reduction of a Hermitian band matrix to tridiagonal
25 * from, used with the Hermitian eigenvalue problem.
26 *
27 * CHBTRD factors a Hermitian band matrix A as U S U* , where * means
28 * conjugate transpose, S is symmetric tridiagonal, and U is unitary.
29 * CHBTRD can use either just the lower or just the upper triangle
30 * of A; CCHKHB checks both cases.
31 *
32 * When CCHKHB is called, a number of matrix "sizes" ("n's"), a number
33 * of bandwidths ("k's"), and a number of matrix "types" are
34 * specified. For each size ("n"), each bandwidth ("k") less than or
35 * equal to "n", and each type of matrix, one matrix will be generated
36 * and used to test the hermitian banded reduction routine. For each
37 * matrix, a number of tests will be performed:
38 *
39 * (1) | A - V S V* | / ( |A| n ulp ) computed by CHBTRD with
40 * UPLO='U'
41 *
42 * (2) | I - UU* | / ( n ulp )
43 *
44 * (3) | A - V S V* | / ( |A| n ulp ) computed by CHBTRD with
45 * UPLO='L'
46 *
47 * (4) | I - UU* | / ( n ulp )
48 *
49 * The "sizes" are specified by an array NN(1:NSIZES); the value of
50 * each element NN(j) specifies one size.
51 * The "types" are specified by a logical array DOTYPE( 1:NTYPES );
52 * if DOTYPE(j) is .TRUE., then matrix type "j" will be generated.
53 * Currently, the list of possible types is:
54 *
55 * (1) The zero matrix.
56 * (2) The identity matrix.
57 *
58 * (3) A diagonal matrix with evenly spaced entries
59 * 1, ..., ULP and random signs.
60 * (ULP = (first number larger than 1) - 1 )
61 * (4) A diagonal matrix with geometrically spaced entries
62 * 1, ..., ULP and random signs.
63 * (5) A diagonal matrix with "clustered" entries 1, ULP, ..., ULP
64 * and random signs.
65 *
66 * (6) Same as (4), but multiplied by SQRT( overflow threshold )
67 * (7) Same as (4), but multiplied by SQRT( underflow threshold )
68 *
69 * (8) A matrix of the form U* D U, where U is unitary and
70 * D has evenly spaced entries 1, ..., ULP with random signs
71 * on the diagonal.
72 *
73 * (9) A matrix of the form U* D U, where U is unitary and
74 * D has geometrically spaced entries 1, ..., ULP with random
75 * signs on the diagonal.
76 *
77 * (10) A matrix of the form U* D U, where U is unitary and
78 * D has "clustered" entries 1, ULP,..., ULP with random
79 * signs on the diagonal.
80 *
81 * (11) Same as (8), but multiplied by SQRT( overflow threshold )
82 * (12) Same as (8), but multiplied by SQRT( underflow threshold )
83 *
84 * (13) Hermitian matrix with random entries chosen from (-1,1).
85 * (14) Same as (13), but multiplied by SQRT( overflow threshold )
86 * (15) Same as (13), but multiplied by SQRT( underflow threshold )
87 *
88 * Arguments
89 * =========
90 *
91 * NSIZES (input) INTEGER
92 * The number of sizes of matrices to use. If it is zero,
93 * CCHKHB does nothing. It must be at least zero.
94 *
95 * NN (input) INTEGER array, dimension (NSIZES)
96 * An array containing the sizes to be used for the matrices.
97 * Zero values will be skipped. The values must be at least
98 * zero.
99 *
100 * NWDTHS (input) INTEGER
101 * The number of bandwidths to use. If it is zero,
102 * CCHKHB does nothing. It must be at least zero.
103 *
104 * KK (input) INTEGER array, dimension (NWDTHS)
105 * An array containing the bandwidths to be used for the band
106 * matrices. The values must be at least zero.
107 *
108 * NTYPES (input) INTEGER
109 * The number of elements in DOTYPE. If it is zero, CCHKHB
110 * does nothing. It must be at least zero. If it is MAXTYP+1
111 * and NSIZES is 1, then an additional type, MAXTYP+1 is
112 * defined, which is to use whatever matrix is in A. This
113 * is only useful if DOTYPE(1:MAXTYP) is .FALSE. and
114 * DOTYPE(MAXTYP+1) is .TRUE. .
115 *
116 * DOTYPE (input) LOGICAL array, dimension (NTYPES)
117 * If DOTYPE(j) is .TRUE., then for each size in NN a
118 * matrix of that size and of type j will be generated.
119 * If NTYPES is smaller than the maximum number of types
120 * defined (PARAMETER MAXTYP), then types NTYPES+1 through
121 * MAXTYP will not be generated. If NTYPES is larger
122 * than MAXTYP, DOTYPE(MAXTYP+1) through DOTYPE(NTYPES)
123 * will be ignored.
124 *
125 * ISEED (input/output) INTEGER array, dimension (4)
126 * On entry ISEED specifies the seed of the random number
127 * generator. The array elements should be between 0 and 4095;
128 * if not they will be reduced mod 4096. Also, ISEED(4) must
129 * be odd. The random number generator uses a linear
130 * congruential sequence limited to small integers, and so
131 * should produce machine independent random numbers. The
132 * values of ISEED are changed on exit, and can be used in the
133 * next call to CCHKHB to continue the same random number
134 * sequence.
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 * NOUNIT (input) INTEGER
145 * The FORTRAN unit number for printing out error messages
146 * (e.g., if a routine returns IINFO not equal to 0.)
147 *
148 * A (input/workspace) REAL array, dimension
149 * (LDA, max(NN))
150 * Used to hold the matrix whose eigenvalues are to be
151 * computed.
152 *
153 * LDA (input) INTEGER
154 * The leading dimension of A. It must be at least 2 (not 1!)
155 * and at least max( KK )+1.
156 *
157 * SD (workspace) REAL array, dimension (max(NN))
158 * Used to hold the diagonal of the tridiagonal matrix computed
159 * by CHBTRD.
160 *
161 * SE (workspace) REAL array, dimension (max(NN))
162 * Used to hold the off-diagonal of the tridiagonal matrix
163 * computed by CHBTRD.
164 *
165 * U (workspace) REAL array, dimension (LDU, max(NN))
166 * Used to hold the unitary matrix computed by CHBTRD.
167 *
168 * LDU (input) INTEGER
169 * The leading dimension of U. It must be at least 1
170 * and at least max( NN ).
171 *
172 * WORK (workspace) REAL array, dimension (LWORK)
173 *
174 * LWORK (input) INTEGER
175 * The number of entries in WORK. This must be at least
176 * max( LDA+1, max(NN)+1 )*max(NN).
177 *
178 * RESULT (output) REAL array, dimension (4)
179 * The values computed by the tests described above.
180 * The values are currently limited to 1/ulp, to avoid
181 * overflow.
182 *
183 * INFO (output) INTEGER
184 * If 0, then everything ran OK.
185 *
186 *-----------------------------------------------------------------------
187 *
188 * Some Local Variables and Parameters:
189 * ---- ----- --------- --- ----------
190 * ZERO, ONE Real 0 and 1.
191 * MAXTYP The number of types defined.
192 * NTEST The number of tests performed, or which can
193 * be performed so far, for the current matrix.
194 * NTESTT The total number of tests performed so far.
195 * NMAX Largest value in NN.
196 * NMATS The number of matrices generated so far.
197 * NERRS The number of tests which have exceeded THRESH
198 * so far.
199 * COND, IMODE Values to be passed to the matrix generators.
200 * ANORM Norm of A; passed to matrix generators.
201 *
202 * OVFL, UNFL Overflow and underflow thresholds.
203 * ULP, ULPINV Finest relative precision and its inverse.
204 * RTOVFL, RTUNFL Square roots of the previous 2 values.
205 * The following four arrays decode JTYPE:
206 * KTYPE(j) The general type (1-10) for type "j".
207 * KMODE(j) The MODE value to be passed to the matrix
208 * generator for type "j".
209 * KMAGN(j) The order of magnitude ( O(1),
210 * O(overflow^(1/2) ), O(underflow^(1/2) )
211 *
212 * =====================================================================
213 *
214 * .. Parameters ..
215 COMPLEX CZERO, CONE
216 PARAMETER ( CZERO = ( 0.0E+0, 0.0E+0 ),
217 $ CONE = ( 1.0E+0, 0.0E+0 ) )
218 REAL ZERO, ONE, TWO, TEN
219 PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0, TWO = 2.0E+0,
220 $ TEN = 10.0E+0 )
221 REAL HALF
222 PARAMETER ( HALF = ONE / TWO )
223 INTEGER MAXTYP
224 PARAMETER ( MAXTYP = 15 )
225 * ..
226 * .. Local Scalars ..
227 LOGICAL BADNN, BADNNB
228 INTEGER I, IINFO, IMODE, ITYPE, J, JC, JCOL, JR, JSIZE,
229 $ JTYPE, JWIDTH, K, KMAX, MTYPES, N, NERRS,
230 $ NMATS, NMAX, NTEST, NTESTT
231 REAL ANINV, ANORM, COND, OVFL, RTOVFL, RTUNFL,
232 $ TEMP1, ULP, ULPINV, UNFL
233 * ..
234 * .. Local Arrays ..
235 INTEGER IDUMMA( 1 ), IOLDSD( 4 ), KMAGN( MAXTYP ),
236 $ KMODE( MAXTYP ), KTYPE( MAXTYP )
237 * ..
238 * .. External Functions ..
239 REAL SLAMCH
240 EXTERNAL SLAMCH
241 * ..
242 * .. External Subroutines ..
243 EXTERNAL CHBT21, CHBTRD, CLACPY, CLATMR, CLATMS, CLASET,
244 $ SLASUM, XERBLA
245 * ..
246 * .. Intrinsic Functions ..
247 INTRINSIC ABS, CONJG, MAX, MIN, REAL, SQRT
248 * ..
249 * .. Data statements ..
250 DATA KTYPE / 1, 2, 5*4, 5*5, 3*8 /
251 DATA KMAGN / 2*1, 1, 1, 1, 2, 3, 1, 1, 1, 2, 3, 1,
252 $ 2, 3 /
253 DATA KMODE / 2*0, 4, 3, 1, 4, 4, 4, 3, 1, 4, 4, 0,
254 $ 0, 0 /
255 * ..
256 * .. Executable Statements ..
257 *
258 * Check for errors
259 *
260 NTESTT = 0
261 INFO = 0
262 *
263 * Important constants
264 *
265 BADNN = .FALSE.
266 NMAX = 1
267 DO 10 J = 1, NSIZES
268 NMAX = MAX( NMAX, NN( J ) )
269 IF( NN( J ).LT.0 )
270 $ BADNN = .TRUE.
271 10 CONTINUE
272 *
273 BADNNB = .FALSE.
274 KMAX = 0
275 DO 20 J = 1, NSIZES
276 KMAX = MAX( KMAX, KK( J ) )
277 IF( KK( J ).LT.0 )
278 $ BADNNB = .TRUE.
279 20 CONTINUE
280 KMAX = MIN( NMAX-1, KMAX )
281 *
282 * Check for errors
283 *
284 IF( NSIZES.LT.0 ) THEN
285 INFO = -1
286 ELSE IF( BADNN ) THEN
287 INFO = -2
288 ELSE IF( NWDTHS.LT.0 ) THEN
289 INFO = -3
290 ELSE IF( BADNNB ) THEN
291 INFO = -4
292 ELSE IF( NTYPES.LT.0 ) THEN
293 INFO = -5
294 ELSE IF( LDA.LT.KMAX+1 ) THEN
295 INFO = -11
296 ELSE IF( LDU.LT.NMAX ) THEN
297 INFO = -15
298 ELSE IF( ( MAX( LDA, NMAX )+1 )*NMAX.GT.LWORK ) THEN
299 INFO = -17
300 END IF
301 *
302 IF( INFO.NE.0 ) THEN
303 CALL XERBLA( 'CCHKHB', -INFO )
304 RETURN
305 END IF
306 *
307 * Quick return if possible
308 *
309 IF( NSIZES.EQ.0 .OR. NTYPES.EQ.0 .OR. NWDTHS.EQ.0 )
310 $ RETURN
311 *
312 * More Important constants
313 *
314 UNFL = SLAMCH( 'Safe minimum' )
315 OVFL = ONE / UNFL
316 ULP = SLAMCH( 'Epsilon' )*SLAMCH( 'Base' )
317 ULPINV = ONE / ULP
318 RTUNFL = SQRT( UNFL )
319 RTOVFL = SQRT( OVFL )
320 *
321 * Loop over sizes, types
322 *
323 NERRS = 0
324 NMATS = 0
325 *
326 DO 190 JSIZE = 1, NSIZES
327 N = NN( JSIZE )
328 ANINV = ONE / REAL( MAX( 1, N ) )
329 *
330 DO 180 JWIDTH = 1, NWDTHS
331 K = KK( JWIDTH )
332 IF( K.GT.N )
333 $ GO TO 180
334 K = MAX( 0, MIN( N-1, K ) )
335 *
336 IF( NSIZES.NE.1 ) THEN
337 MTYPES = MIN( MAXTYP, NTYPES )
338 ELSE
339 MTYPES = MIN( MAXTYP+1, NTYPES )
340 END IF
341 *
342 DO 170 JTYPE = 1, MTYPES
343 IF( .NOT.DOTYPE( JTYPE ) )
344 $ GO TO 170
345 NMATS = NMATS + 1
346 NTEST = 0
347 *
348 DO 30 J = 1, 4
349 IOLDSD( J ) = ISEED( J )
350 30 CONTINUE
351 *
352 * Compute "A".
353 * Store as "Upper"; later, we will copy to other format.
354 *
355 * Control parameters:
356 *
357 * KMAGN KMODE KTYPE
358 * =1 O(1) clustered 1 zero
359 * =2 large clustered 2 identity
360 * =3 small exponential (none)
361 * =4 arithmetic diagonal, (w/ eigenvalues)
362 * =5 random log hermitian, w/ eigenvalues
363 * =6 random (none)
364 * =7 random diagonal
365 * =8 random hermitian
366 * =9 positive definite
367 * =10 diagonally dominant tridiagonal
368 *
369 IF( MTYPES.GT.MAXTYP )
370 $ GO TO 100
371 *
372 ITYPE = KTYPE( JTYPE )
373 IMODE = KMODE( JTYPE )
374 *
375 * Compute norm
376 *
377 GO TO ( 40, 50, 60 )KMAGN( JTYPE )
378 *
379 40 CONTINUE
380 ANORM = ONE
381 GO TO 70
382 *
383 50 CONTINUE
384 ANORM = ( RTOVFL*ULP )*ANINV
385 GO TO 70
386 *
387 60 CONTINUE
388 ANORM = RTUNFL*N*ULPINV
389 GO TO 70
390 *
391 70 CONTINUE
392 *
393 CALL CLASET( 'Full', LDA, N, CZERO, CZERO, A, LDA )
394 IINFO = 0
395 IF( JTYPE.LE.15 ) THEN
396 COND = ULPINV
397 ELSE
398 COND = ULPINV*ANINV / TEN
399 END IF
400 *
401 * Special Matrices -- Identity & Jordan block
402 *
403 * Zero
404 *
405 IF( ITYPE.EQ.1 ) THEN
406 IINFO = 0
407 *
408 ELSE IF( ITYPE.EQ.2 ) THEN
409 *
410 * Identity
411 *
412 DO 80 JCOL = 1, N
413 A( K+1, JCOL ) = ANORM
414 80 CONTINUE
415 *
416 ELSE IF( ITYPE.EQ.4 ) THEN
417 *
418 * Diagonal Matrix, [Eigen]values Specified
419 *
420 CALL CLATMS( N, N, 'S', ISEED, 'H', RWORK, IMODE,
421 $ COND, ANORM, 0, 0, 'Q', A( K+1, 1 ), LDA,
422 $ WORK, IINFO )
423 *
424 ELSE IF( ITYPE.EQ.5 ) THEN
425 *
426 * Hermitian, eigenvalues specified
427 *
428 CALL CLATMS( N, N, 'S', ISEED, 'H', RWORK, IMODE,
429 $ COND, ANORM, K, K, 'Q', A, LDA, WORK,
430 $ IINFO )
431 *
432 ELSE IF( ITYPE.EQ.7 ) THEN
433 *
434 * Diagonal, random eigenvalues
435 *
436 CALL CLATMR( N, N, 'S', ISEED, 'H', WORK, 6, ONE,
437 $ CONE, 'T', 'N', WORK( N+1 ), 1, ONE,
438 $ WORK( 2*N+1 ), 1, ONE, 'N', IDUMMA, 0, 0,
439 $ ZERO, ANORM, 'Q', A( K+1, 1 ), LDA,
440 $ IDUMMA, IINFO )
441 *
442 ELSE IF( ITYPE.EQ.8 ) THEN
443 *
444 * Hermitian, random eigenvalues
445 *
446 CALL CLATMR( N, N, 'S', ISEED, 'H', WORK, 6, ONE,
447 $ CONE, 'T', 'N', WORK( N+1 ), 1, ONE,
448 $ WORK( 2*N+1 ), 1, ONE, 'N', IDUMMA, K, K,
449 $ ZERO, ANORM, 'Q', A, LDA, IDUMMA, IINFO )
450 *
451 ELSE IF( ITYPE.EQ.9 ) THEN
452 *
453 * Positive definite, eigenvalues specified.
454 *
455 CALL CLATMS( N, N, 'S', ISEED, 'P', RWORK, IMODE,
456 $ COND, ANORM, K, K, 'Q', A, LDA,
457 $ WORK( N+1 ), IINFO )
458 *
459 ELSE IF( ITYPE.EQ.10 ) THEN
460 *
461 * Positive definite tridiagonal, eigenvalues specified.
462 *
463 IF( N.GT.1 )
464 $ K = MAX( 1, K )
465 CALL CLATMS( N, N, 'S', ISEED, 'P', RWORK, IMODE,
466 $ COND, ANORM, 1, 1, 'Q', A( K, 1 ), LDA,
467 $ WORK, IINFO )
468 DO 90 I = 2, N
469 TEMP1 = ABS( A( K, I ) ) /
470 $ SQRT( ABS( A( K+1, I-1 )*A( K+1, I ) ) )
471 IF( TEMP1.GT.HALF ) THEN
472 A( K, I ) = HALF*SQRT( ABS( A( K+1,
473 $ I-1 )*A( K+1, I ) ) )
474 END IF
475 90 CONTINUE
476 *
477 ELSE
478 *
479 IINFO = 1
480 END IF
481 *
482 IF( IINFO.NE.0 ) THEN
483 WRITE( NOUNIT, FMT = 9999 )'Generator', IINFO, N,
484 $ JTYPE, IOLDSD
485 INFO = ABS( IINFO )
486 RETURN
487 END IF
488 *
489 100 CONTINUE
490 *
491 * Call CHBTRD to compute S and U from upper triangle.
492 *
493 CALL CLACPY( ' ', K+1, N, A, LDA, WORK, LDA )
494 *
495 NTEST = 1
496 CALL CHBTRD( 'V', 'U', N, K, WORK, LDA, SD, SE, U, LDU,
497 $ WORK( LDA*N+1 ), IINFO )
498 *
499 IF( IINFO.NE.0 ) THEN
500 WRITE( NOUNIT, FMT = 9999 )'CHBTRD(U)', IINFO, N,
501 $ JTYPE, IOLDSD
502 INFO = ABS( IINFO )
503 IF( IINFO.LT.0 ) THEN
504 RETURN
505 ELSE
506 RESULT( 1 ) = ULPINV
507 GO TO 150
508 END IF
509 END IF
510 *
511 * Do tests 1 and 2
512 *
513 CALL CHBT21( 'Upper', N, K, 1, A, LDA, SD, SE, U, LDU,
514 $ WORK, RWORK, RESULT( 1 ) )
515 *
516 * Convert A from Upper-Triangle-Only storage to
517 * Lower-Triangle-Only storage.
518 *
519 DO 120 JC = 1, N
520 DO 110 JR = 0, MIN( K, N-JC )
521 A( JR+1, JC ) = CONJG( A( K+1-JR, JC+JR ) )
522 110 CONTINUE
523 120 CONTINUE
524 DO 140 JC = N + 1 - K, N
525 DO 130 JR = MIN( K, N-JC ) + 1, K
526 A( JR+1, JC ) = ZERO
527 130 CONTINUE
528 140 CONTINUE
529 *
530 * Call CHBTRD to compute S and U from lower triangle
531 *
532 CALL CLACPY( ' ', K+1, N, A, LDA, WORK, LDA )
533 *
534 NTEST = 3
535 CALL CHBTRD( 'V', 'L', N, K, WORK, LDA, SD, SE, U, LDU,
536 $ WORK( LDA*N+1 ), IINFO )
537 *
538 IF( IINFO.NE.0 ) THEN
539 WRITE( NOUNIT, FMT = 9999 )'CHBTRD(L)', IINFO, N,
540 $ JTYPE, IOLDSD
541 INFO = ABS( IINFO )
542 IF( IINFO.LT.0 ) THEN
543 RETURN
544 ELSE
545 RESULT( 3 ) = ULPINV
546 GO TO 150
547 END IF
548 END IF
549 NTEST = 4
550 *
551 * Do tests 3 and 4
552 *
553 CALL CHBT21( 'Lower', N, K, 1, A, LDA, SD, SE, U, LDU,
554 $ WORK, RWORK, RESULT( 3 ) )
555 *
556 * End of Loop -- Check for RESULT(j) > THRESH
557 *
558 150 CONTINUE
559 NTESTT = NTESTT + NTEST
560 *
561 * Print out tests which fail.
562 *
563 DO 160 JR = 1, NTEST
564 IF( RESULT( JR ).GE.THRESH ) THEN
565 *
566 * If this is the first test to fail,
567 * print a header to the data file.
568 *
569 IF( NERRS.EQ.0 ) THEN
570 WRITE( NOUNIT, FMT = 9998 )'CHB'
571 WRITE( NOUNIT, FMT = 9997 )
572 WRITE( NOUNIT, FMT = 9996 )
573 WRITE( NOUNIT, FMT = 9995 )'Hermitian'
574 WRITE( NOUNIT, FMT = 9994 )'unitary', '*',
575 $ 'conjugate transpose', ( '*', J = 1, 4 )
576 END IF
577 NERRS = NERRS + 1
578 WRITE( NOUNIT, FMT = 9993 )N, K, IOLDSD, JTYPE,
579 $ JR, RESULT( JR )
580 END IF
581 160 CONTINUE
582 *
583 170 CONTINUE
584 180 CONTINUE
585 190 CONTINUE
586 *
587 * Summary
588 *
589 CALL SLASUM( 'CHB', NOUNIT, NERRS, NTESTT )
590 RETURN
591 *
592 9999 FORMAT( ' CCHKHB: ', A, ' returned INFO=', I6, '.', / 9X, 'N=',
593 $ I6, ', JTYPE=', I6, ', ISEED=(', 3( I5, ',' ), I5, ')' )
594 9998 FORMAT( / 1X, A3,
595 $ ' -- Complex Hermitian Banded Tridiagonal Reduction Routines'
596 $ )
597 9997 FORMAT( ' Matrix types (see SCHK23 for details): ' )
598 *
599 9996 FORMAT( / ' Special Matrices:',
600 $ / ' 1=Zero matrix. ',
601 $ ' 5=Diagonal: clustered entries.',
602 $ / ' 2=Identity matrix. ',
603 $ ' 6=Diagonal: large, evenly spaced.',
604 $ / ' 3=Diagonal: evenly spaced entries. ',
605 $ ' 7=Diagonal: small, evenly spaced.',
606 $ / ' 4=Diagonal: geometr. spaced entries.' )
607 9995 FORMAT( ' Dense ', A, ' Banded Matrices:',
608 $ / ' 8=Evenly spaced eigenvals. ',
609 $ ' 12=Small, evenly spaced eigenvals.',
610 $ / ' 9=Geometrically spaced eigenvals. ',
611 $ ' 13=Matrix with random O(1) entries.',
612 $ / ' 10=Clustered eigenvalues. ',
613 $ ' 14=Matrix with large random entries.',
614 $ / ' 11=Large, evenly spaced eigenvals. ',
615 $ ' 15=Matrix with small random entries.' )
616 *
617 9994 FORMAT( / ' Tests performed: (S is Tridiag, U is ', A, ',',
618 $ / 20X, A, ' means ', A, '.', / ' UPLO=''U'':',
619 $ / ' 1= | A - U S U', A1, ' | / ( |A| n ulp ) ',
620 $ ' 2= | I - U U', A1, ' | / ( n ulp )', / ' UPLO=''L'':',
621 $ / ' 3= | A - U S U', A1, ' | / ( |A| n ulp ) ',
622 $ ' 4= | I - U U', A1, ' | / ( n ulp )' )
623 9993 FORMAT( ' N=', I5, ', K=', I4, ', seed=', 4( I4, ',' ), ' type ',
624 $ I2, ', test(', I2, ')=', G10.3 )
625 *
626 * End of CCHKHB
627 *
628 END