1 SUBROUTINE ZLATTB( IMAT, UPLO, TRANS, DIAG, ISEED, N, KD, AB,
2 $ LDAB, B, WORK, RWORK, INFO )
3 *
4 * -- LAPACK test routine (version 3.1) --
5 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
6 * November 2006
7 *
8 * .. Scalar Arguments ..
9 CHARACTER DIAG, TRANS, UPLO
10 INTEGER IMAT, INFO, KD, LDAB, N
11 * ..
12 * .. Array Arguments ..
13 INTEGER ISEED( 4 )
14 DOUBLE PRECISION RWORK( * )
15 COMPLEX*16 AB( LDAB, * ), B( * ), WORK( * )
16 * ..
17 *
18 * Purpose
19 * =======
20 *
21 * ZLATTB generates a triangular test matrix in 2-dimensional storage.
22 * IMAT and UPLO uniquely specify the properties of the test matrix,
23 * which is returned in the array A.
24 *
25 * Arguments
26 * =========
27 *
28 * IMAT (input) INTEGER
29 * An integer key describing which matrix to generate for this
30 * path.
31 *
32 * UPLO (input) CHARACTER*1
33 * Specifies whether the matrix A will be upper or lower
34 * triangular.
35 * = 'U': Upper triangular
36 * = 'L': Lower triangular
37 *
38 * TRANS (input) CHARACTER*1
39 * Specifies whether the matrix or its transpose will be used.
40 * = 'N': No transpose
41 * = 'T': Transpose
42 * = 'C': Conjugate transpose (= transpose)
43 *
44 * DIAG (output) CHARACTER*1
45 * Specifies whether or not the matrix A is unit triangular.
46 * = 'N': Non-unit triangular
47 * = 'U': Unit triangular
48 *
49 * ISEED (input/output) INTEGER array, dimension (4)
50 * The seed vector for the random number generator (used in
51 * ZLATMS). Modified on exit.
52 *
53 * N (input) INTEGER
54 * The order of the matrix to be generated.
55 *
56 * KD (input) INTEGER
57 * The number of superdiagonals or subdiagonals of the banded
58 * triangular matrix A. KD >= 0.
59 *
60 * AB (output) COMPLEX*16 array, dimension (LDAB,N)
61 * The upper or lower triangular banded matrix A, stored in the
62 * first KD+1 rows of AB. Let j be a column of A, 1<=j<=n.
63 * If UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j.
64 * If UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd).
65 *
66 * LDAB (input) INTEGER
67 * The leading dimension of the array AB. LDAB >= KD+1.
68 *
69 * B (workspace) COMPLEX*16 array, dimension (N)
70 *
71 * WORK (workspace) COMPLEX*16 array, dimension (2*N)
72 *
73 * RWORK (workspace) DOUBLE PRECISION array, dimension (N)
74 *
75 * INFO (output) INTEGER
76 * = 0: successful exit
77 * < 0: if INFO = -i, the i-th argument had an illegal value
78 *
79 * =====================================================================
80 *
81 * .. Parameters ..
82 DOUBLE PRECISION ONE, TWO, ZERO
83 PARAMETER ( ONE = 1.0D+0, TWO = 2.0D+0, ZERO = 0.0D+0 )
84 * ..
85 * .. Local Scalars ..
86 LOGICAL UPPER
87 CHARACTER DIST, PACKIT, TYPE
88 CHARACTER*3 PATH
89 INTEGER I, IOFF, IY, J, JCOUNT, KL, KU, LENJ, MODE
90 DOUBLE PRECISION ANORM, BIGNUM, BNORM, BSCAL, CNDNUM, REXP,
91 $ SFAC, SMLNUM, TEXP, TLEFT, TNORM, TSCAL, ULP,
92 $ UNFL
93 COMPLEX*16 PLUS1, PLUS2, STAR1
94 * ..
95 * .. External Functions ..
96 LOGICAL LSAME
97 INTEGER IZAMAX
98 DOUBLE PRECISION DLAMCH, DLARND
99 COMPLEX*16 ZLARND
100 EXTERNAL LSAME, IZAMAX, DLAMCH, DLARND, ZLARND
101 * ..
102 * .. External Subroutines ..
103 EXTERNAL DLABAD, DLARNV, ZCOPY, ZDSCAL, ZLARNV, ZLATB4,
104 $ ZLATMS, ZSWAP
105 * ..
106 * .. Intrinsic Functions ..
107 INTRINSIC ABS, DBLE, DCMPLX, MAX, MIN, SQRT
108 * ..
109 * .. Executable Statements ..
110 *
111 PATH( 1: 1 ) = 'Zomplex precision'
112 PATH( 2: 3 ) = 'TB'
113 UNFL = DLAMCH( 'Safe minimum' )
114 ULP = DLAMCH( 'Epsilon' )*DLAMCH( 'Base' )
115 SMLNUM = UNFL
116 BIGNUM = ( ONE-ULP ) / SMLNUM
117 CALL DLABAD( SMLNUM, BIGNUM )
118 IF( ( IMAT.GE.6 .AND. IMAT.LE.9 ) .OR. IMAT.EQ.17 ) THEN
119 DIAG = 'U'
120 ELSE
121 DIAG = 'N'
122 END IF
123 INFO = 0
124 *
125 * Quick return if N.LE.0.
126 *
127 IF( N.LE.0 )
128 $ RETURN
129 *
130 * Call ZLATB4 to set parameters for CLATMS.
131 *
132 UPPER = LSAME( UPLO, 'U' )
133 IF( UPPER ) THEN
134 CALL ZLATB4( PATH, IMAT, N, N, TYPE, KL, KU, ANORM, MODE,
135 $ CNDNUM, DIST )
136 KU = KD
137 IOFF = 1 + MAX( 0, KD-N+1 )
138 KL = 0
139 PACKIT = 'Q'
140 ELSE
141 CALL ZLATB4( PATH, -IMAT, N, N, TYPE, KL, KU, ANORM, MODE,
142 $ CNDNUM, DIST )
143 KL = KD
144 IOFF = 1
145 KU = 0
146 PACKIT = 'B'
147 END IF
148 *
149 * IMAT <= 5: Non-unit triangular matrix
150 *
151 IF( IMAT.LE.5 ) THEN
152 CALL ZLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE, CNDNUM,
153 $ ANORM, KL, KU, PACKIT, AB( IOFF, 1 ), LDAB, WORK,
154 $ INFO )
155 *
156 * IMAT > 5: Unit triangular matrix
157 * The diagonal is deliberately set to something other than 1.
158 *
159 * IMAT = 6: Matrix is the identity
160 *
161 ELSE IF( IMAT.EQ.6 ) THEN
162 IF( UPPER ) THEN
163 DO 20 J = 1, N
164 DO 10 I = MAX( 1, KD+2-J ), KD
165 AB( I, J ) = ZERO
166 10 CONTINUE
167 AB( KD+1, J ) = J
168 20 CONTINUE
169 ELSE
170 DO 40 J = 1, N
171 AB( 1, J ) = J
172 DO 30 I = 2, MIN( KD+1, N-J+1 )
173 AB( I, J ) = ZERO
174 30 CONTINUE
175 40 CONTINUE
176 END IF
177 *
178 * IMAT > 6: Non-trivial unit triangular matrix
179 *
180 * A unit triangular matrix T with condition CNDNUM is formed.
181 * In this version, T only has bandwidth 2, the rest of it is zero.
182 *
183 ELSE IF( IMAT.LE.9 ) THEN
184 TNORM = SQRT( CNDNUM )
185 *
186 * Initialize AB to zero.
187 *
188 IF( UPPER ) THEN
189 DO 60 J = 1, N
190 DO 50 I = MAX( 1, KD+2-J ), KD
191 AB( I, J ) = ZERO
192 50 CONTINUE
193 AB( KD+1, J ) = DBLE( J )
194 60 CONTINUE
195 ELSE
196 DO 80 J = 1, N
197 DO 70 I = 2, MIN( KD+1, N-J+1 )
198 AB( I, J ) = ZERO
199 70 CONTINUE
200 AB( 1, J ) = DBLE( J )
201 80 CONTINUE
202 END IF
203 *
204 * Special case: T is tridiagonal. Set every other offdiagonal
205 * so that the matrix has norm TNORM+1.
206 *
207 IF( KD.EQ.1 ) THEN
208 IF( UPPER ) THEN
209 AB( 1, 2 ) = TNORM*ZLARND( 5, ISEED )
210 LENJ = ( N-3 ) / 2
211 CALL ZLARNV( 2, ISEED, LENJ, WORK )
212 DO 90 J = 1, LENJ
213 AB( 1, 2*( J+1 ) ) = TNORM*WORK( J )
214 90 CONTINUE
215 ELSE
216 AB( 2, 1 ) = TNORM*ZLARND( 5, ISEED )
217 LENJ = ( N-3 ) / 2
218 CALL ZLARNV( 2, ISEED, LENJ, WORK )
219 DO 100 J = 1, LENJ
220 AB( 2, 2*J+1 ) = TNORM*WORK( J )
221 100 CONTINUE
222 END IF
223 ELSE IF( KD.GT.1 ) THEN
224 *
225 * Form a unit triangular matrix T with condition CNDNUM. T is
226 * given by
227 * | 1 + * |
228 * | 1 + |
229 * T = | 1 + * |
230 * | 1 + |
231 * | 1 + * |
232 * | 1 + |
233 * | . . . |
234 * Each element marked with a '*' is formed by taking the product
235 * of the adjacent elements marked with '+'. The '*'s can be
236 * chosen freely, and the '+'s are chosen so that the inverse of
237 * T will have elements of the same magnitude as T.
238 *
239 * The two offdiagonals of T are stored in WORK.
240 *
241 STAR1 = TNORM*ZLARND( 5, ISEED )
242 SFAC = SQRT( TNORM )
243 PLUS1 = SFAC*ZLARND( 5, ISEED )
244 DO 110 J = 1, N, 2
245 PLUS2 = STAR1 / PLUS1
246 WORK( J ) = PLUS1
247 WORK( N+J ) = STAR1
248 IF( J+1.LE.N ) THEN
249 WORK( J+1 ) = PLUS2
250 WORK( N+J+1 ) = ZERO
251 PLUS1 = STAR1 / PLUS2
252 *
253 * Generate a new *-value with norm between sqrt(TNORM)
254 * and TNORM.
255 *
256 REXP = DLARND( 2, ISEED )
257 IF( REXP.LT.ZERO ) THEN
258 STAR1 = -SFAC**( ONE-REXP )*ZLARND( 5, ISEED )
259 ELSE
260 STAR1 = SFAC**( ONE+REXP )*ZLARND( 5, ISEED )
261 END IF
262 END IF
263 110 CONTINUE
264 *
265 * Copy the tridiagonal T to AB.
266 *
267 IF( UPPER ) THEN
268 CALL ZCOPY( N-1, WORK, 1, AB( KD, 2 ), LDAB )
269 CALL ZCOPY( N-2, WORK( N+1 ), 1, AB( KD-1, 3 ), LDAB )
270 ELSE
271 CALL ZCOPY( N-1, WORK, 1, AB( 2, 1 ), LDAB )
272 CALL ZCOPY( N-2, WORK( N+1 ), 1, AB( 3, 1 ), LDAB )
273 END IF
274 END IF
275 *
276 * IMAT > 9: Pathological test cases. These triangular matrices
277 * are badly scaled or badly conditioned, so when used in solving a
278 * triangular system they may cause overflow in the solution vector.
279 *
280 ELSE IF( IMAT.EQ.10 ) THEN
281 *
282 * Type 10: Generate a triangular matrix with elements between
283 * -1 and 1. Give the diagonal norm 2 to make it well-conditioned.
284 * Make the right hand side large so that it requires scaling.
285 *
286 IF( UPPER ) THEN
287 DO 120 J = 1, N
288 LENJ = MIN( J-1, KD )
289 CALL ZLARNV( 4, ISEED, LENJ, AB( KD+1-LENJ, J ) )
290 AB( KD+1, J ) = ZLARND( 5, ISEED )*TWO
291 120 CONTINUE
292 ELSE
293 DO 130 J = 1, N
294 LENJ = MIN( N-J, KD )
295 IF( LENJ.GT.0 )
296 $ CALL ZLARNV( 4, ISEED, LENJ, AB( 2, J ) )
297 AB( 1, J ) = ZLARND( 5, ISEED )*TWO
298 130 CONTINUE
299 END IF
300 *
301 * Set the right hand side so that the largest value is BIGNUM.
302 *
303 CALL ZLARNV( 2, ISEED, N, B )
304 IY = IZAMAX( N, B, 1 )
305 BNORM = ABS( B( IY ) )
306 BSCAL = BIGNUM / MAX( ONE, BNORM )
307 CALL ZDSCAL( N, BSCAL, B, 1 )
308 *
309 ELSE IF( IMAT.EQ.11 ) THEN
310 *
311 * Type 11: Make the first diagonal element in the solve small to
312 * cause immediate overflow when dividing by T(j,j).
313 * In type 11, the offdiagonal elements are small (CNORM(j) < 1).
314 *
315 CALL ZLARNV( 2, ISEED, N, B )
316 TSCAL = ONE / DBLE( KD+1 )
317 IF( UPPER ) THEN
318 DO 140 J = 1, N
319 LENJ = MIN( J-1, KD )
320 IF( LENJ.GT.0 ) THEN
321 CALL ZLARNV( 4, ISEED, LENJ, AB( KD+2-LENJ, J ) )
322 CALL ZDSCAL( LENJ, TSCAL, AB( KD+2-LENJ, J ), 1 )
323 END IF
324 AB( KD+1, J ) = ZLARND( 5, ISEED )
325 140 CONTINUE
326 AB( KD+1, N ) = SMLNUM*AB( KD+1, N )
327 ELSE
328 DO 150 J = 1, N
329 LENJ = MIN( N-J, KD )
330 IF( LENJ.GT.0 ) THEN
331 CALL ZLARNV( 4, ISEED, LENJ, AB( 2, J ) )
332 CALL ZDSCAL( LENJ, TSCAL, AB( 2, J ), 1 )
333 END IF
334 AB( 1, J ) = ZLARND( 5, ISEED )
335 150 CONTINUE
336 AB( 1, 1 ) = SMLNUM*AB( 1, 1 )
337 END IF
338 *
339 ELSE IF( IMAT.EQ.12 ) THEN
340 *
341 * Type 12: Make the first diagonal element in the solve small to
342 * cause immediate overflow when dividing by T(j,j).
343 * In type 12, the offdiagonal elements are O(1) (CNORM(j) > 1).
344 *
345 CALL ZLARNV( 2, ISEED, N, B )
346 IF( UPPER ) THEN
347 DO 160 J = 1, N
348 LENJ = MIN( J-1, KD )
349 IF( LENJ.GT.0 )
350 $ CALL ZLARNV( 4, ISEED, LENJ, AB( KD+2-LENJ, J ) )
351 AB( KD+1, J ) = ZLARND( 5, ISEED )
352 160 CONTINUE
353 AB( KD+1, N ) = SMLNUM*AB( KD+1, N )
354 ELSE
355 DO 170 J = 1, N
356 LENJ = MIN( N-J, KD )
357 IF( LENJ.GT.0 )
358 $ CALL ZLARNV( 4, ISEED, LENJ, AB( 2, J ) )
359 AB( 1, J ) = ZLARND( 5, ISEED )
360 170 CONTINUE
361 AB( 1, 1 ) = SMLNUM*AB( 1, 1 )
362 END IF
363 *
364 ELSE IF( IMAT.EQ.13 ) THEN
365 *
366 * Type 13: T is diagonal with small numbers on the diagonal to
367 * make the growth factor underflow, but a small right hand side
368 * chosen so that the solution does not overflow.
369 *
370 IF( UPPER ) THEN
371 JCOUNT = 1
372 DO 190 J = N, 1, -1
373 DO 180 I = MAX( 1, KD+1-( J-1 ) ), KD
374 AB( I, J ) = ZERO
375 180 CONTINUE
376 IF( JCOUNT.LE.2 ) THEN
377 AB( KD+1, J ) = SMLNUM*ZLARND( 5, ISEED )
378 ELSE
379 AB( KD+1, J ) = ZLARND( 5, ISEED )
380 END IF
381 JCOUNT = JCOUNT + 1
382 IF( JCOUNT.GT.4 )
383 $ JCOUNT = 1
384 190 CONTINUE
385 ELSE
386 JCOUNT = 1
387 DO 210 J = 1, N
388 DO 200 I = 2, MIN( N-J+1, KD+1 )
389 AB( I, J ) = ZERO
390 200 CONTINUE
391 IF( JCOUNT.LE.2 ) THEN
392 AB( 1, J ) = SMLNUM*ZLARND( 5, ISEED )
393 ELSE
394 AB( 1, J ) = ZLARND( 5, ISEED )
395 END IF
396 JCOUNT = JCOUNT + 1
397 IF( JCOUNT.GT.4 )
398 $ JCOUNT = 1
399 210 CONTINUE
400 END IF
401 *
402 * Set the right hand side alternately zero and small.
403 *
404 IF( UPPER ) THEN
405 B( 1 ) = ZERO
406 DO 220 I = N, 2, -2
407 B( I ) = ZERO
408 B( I-1 ) = SMLNUM*ZLARND( 5, ISEED )
409 220 CONTINUE
410 ELSE
411 B( N ) = ZERO
412 DO 230 I = 1, N - 1, 2
413 B( I ) = ZERO
414 B( I+1 ) = SMLNUM*ZLARND( 5, ISEED )
415 230 CONTINUE
416 END IF
417 *
418 ELSE IF( IMAT.EQ.14 ) THEN
419 *
420 * Type 14: Make the diagonal elements small to cause gradual
421 * overflow when dividing by T(j,j). To control the amount of
422 * scaling needed, the matrix is bidiagonal.
423 *
424 TEXP = ONE / DBLE( KD+1 )
425 TSCAL = SMLNUM**TEXP
426 CALL ZLARNV( 4, ISEED, N, B )
427 IF( UPPER ) THEN
428 DO 250 J = 1, N
429 DO 240 I = MAX( 1, KD+2-J ), KD
430 AB( I, J ) = ZERO
431 240 CONTINUE
432 IF( J.GT.1 .AND. KD.GT.0 )
433 $ AB( KD, J ) = DCMPLX( -ONE, -ONE )
434 AB( KD+1, J ) = TSCAL*ZLARND( 5, ISEED )
435 250 CONTINUE
436 B( N ) = DCMPLX( ONE, ONE )
437 ELSE
438 DO 270 J = 1, N
439 DO 260 I = 3, MIN( N-J+1, KD+1 )
440 AB( I, J ) = ZERO
441 260 CONTINUE
442 IF( J.LT.N .AND. KD.GT.0 )
443 $ AB( 2, J ) = DCMPLX( -ONE, -ONE )
444 AB( 1, J ) = TSCAL*ZLARND( 5, ISEED )
445 270 CONTINUE
446 B( 1 ) = DCMPLX( ONE, ONE )
447 END IF
448 *
449 ELSE IF( IMAT.EQ.15 ) THEN
450 *
451 * Type 15: One zero diagonal element.
452 *
453 IY = N / 2 + 1
454 IF( UPPER ) THEN
455 DO 280 J = 1, N
456 LENJ = MIN( J, KD+1 )
457 CALL ZLARNV( 4, ISEED, LENJ, AB( KD+2-LENJ, J ) )
458 IF( J.NE.IY ) THEN
459 AB( KD+1, J ) = ZLARND( 5, ISEED )*TWO
460 ELSE
461 AB( KD+1, J ) = ZERO
462 END IF
463 280 CONTINUE
464 ELSE
465 DO 290 J = 1, N
466 LENJ = MIN( N-J+1, KD+1 )
467 CALL ZLARNV( 4, ISEED, LENJ, AB( 1, J ) )
468 IF( J.NE.IY ) THEN
469 AB( 1, J ) = ZLARND( 5, ISEED )*TWO
470 ELSE
471 AB( 1, J ) = ZERO
472 END IF
473 290 CONTINUE
474 END IF
475 CALL ZLARNV( 2, ISEED, N, B )
476 CALL ZDSCAL( N, TWO, B, 1 )
477 *
478 ELSE IF( IMAT.EQ.16 ) THEN
479 *
480 * Type 16: Make the offdiagonal elements large to cause overflow
481 * when adding a column of T. In the non-transposed case, the
482 * matrix is constructed to cause overflow when adding a column in
483 * every other step.
484 *
485 TSCAL = UNFL / ULP
486 TSCAL = ( ONE-ULP ) / TSCAL
487 DO 310 J = 1, N
488 DO 300 I = 1, KD + 1
489 AB( I, J ) = ZERO
490 300 CONTINUE
491 310 CONTINUE
492 TEXP = ONE
493 IF( KD.GT.0 ) THEN
494 IF( UPPER ) THEN
495 DO 330 J = N, 1, -KD
496 DO 320 I = J, MAX( 1, J-KD+1 ), -2
497 AB( 1+( J-I ), I ) = -TSCAL / DBLE( KD+2 )
498 AB( KD+1, I ) = ONE
499 B( I ) = TEXP*( ONE-ULP )
500 IF( I.GT.MAX( 1, J-KD+1 ) ) THEN
501 AB( 2+( J-I ), I-1 ) = -( TSCAL / DBLE( KD+2 ) )
502 $ / DBLE( KD+3 )
503 AB( KD+1, I-1 ) = ONE
504 B( I-1 ) = TEXP*DBLE( ( KD+1 )*( KD+1 )+KD )
505 END IF
506 TEXP = TEXP*TWO
507 320 CONTINUE
508 B( MAX( 1, J-KD+1 ) ) = ( DBLE( KD+2 ) /
509 $ DBLE( KD+3 ) )*TSCAL
510 330 CONTINUE
511 ELSE
512 DO 350 J = 1, N, KD
513 TEXP = ONE
514 LENJ = MIN( KD+1, N-J+1 )
515 DO 340 I = J, MIN( N, J+KD-1 ), 2
516 AB( LENJ-( I-J ), J ) = -TSCAL / DBLE( KD+2 )
517 AB( 1, J ) = ONE
518 B( J ) = TEXP*( ONE-ULP )
519 IF( I.LT.MIN( N, J+KD-1 ) ) THEN
520 AB( LENJ-( I-J+1 ), I+1 ) = -( TSCAL /
521 $ DBLE( KD+2 ) ) / DBLE( KD+3 )
522 AB( 1, I+1 ) = ONE
523 B( I+1 ) = TEXP*DBLE( ( KD+1 )*( KD+1 )+KD )
524 END IF
525 TEXP = TEXP*TWO
526 340 CONTINUE
527 B( MIN( N, J+KD-1 ) ) = ( DBLE( KD+2 ) /
528 $ DBLE( KD+3 ) )*TSCAL
529 350 CONTINUE
530 END IF
531 END IF
532 *
533 ELSE IF( IMAT.EQ.17 ) THEN
534 *
535 * Type 17: Generate a unit triangular matrix with elements
536 * between -1 and 1, and make the right hand side large so that it
537 * requires scaling.
538 *
539 IF( UPPER ) THEN
540 DO 360 J = 1, N
541 LENJ = MIN( J-1, KD )
542 CALL ZLARNV( 4, ISEED, LENJ, AB( KD+1-LENJ, J ) )
543 AB( KD+1, J ) = DBLE( J )
544 360 CONTINUE
545 ELSE
546 DO 370 J = 1, N
547 LENJ = MIN( N-J, KD )
548 IF( LENJ.GT.0 )
549 $ CALL ZLARNV( 4, ISEED, LENJ, AB( 2, J ) )
550 AB( 1, J ) = DBLE( J )
551 370 CONTINUE
552 END IF
553 *
554 * Set the right hand side so that the largest value is BIGNUM.
555 *
556 CALL ZLARNV( 2, ISEED, N, B )
557 IY = IZAMAX( N, B, 1 )
558 BNORM = ABS( B( IY ) )
559 BSCAL = BIGNUM / MAX( ONE, BNORM )
560 CALL ZDSCAL( N, BSCAL, B, 1 )
561 *
562 ELSE IF( IMAT.EQ.18 ) THEN
563 *
564 * Type 18: Generate a triangular matrix with elements between
565 * BIGNUM/(KD+1) and BIGNUM so that at least one of the column
566 * norms will exceed BIGNUM.
567 * 1/3/91: ZLATBS no longer can handle this case
568 *
569 TLEFT = BIGNUM / DBLE( KD+1 )
570 TSCAL = BIGNUM*( DBLE( KD+1 ) / DBLE( KD+2 ) )
571 IF( UPPER ) THEN
572 DO 390 J = 1, N
573 LENJ = MIN( J, KD+1 )
574 CALL ZLARNV( 5, ISEED, LENJ, AB( KD+2-LENJ, J ) )
575 CALL DLARNV( 1, ISEED, LENJ, RWORK( KD+2-LENJ ) )
576 DO 380 I = KD + 2 - LENJ, KD + 1
577 AB( I, J ) = AB( I, J )*( TLEFT+RWORK( I )*TSCAL )
578 380 CONTINUE
579 390 CONTINUE
580 ELSE
581 DO 410 J = 1, N
582 LENJ = MIN( N-J+1, KD+1 )
583 CALL ZLARNV( 5, ISEED, LENJ, AB( 1, J ) )
584 CALL DLARNV( 1, ISEED, LENJ, RWORK )
585 DO 400 I = 1, LENJ
586 AB( I, J ) = AB( I, J )*( TLEFT+RWORK( I )*TSCAL )
587 400 CONTINUE
588 410 CONTINUE
589 END IF
590 CALL ZLARNV( 2, ISEED, N, B )
591 CALL ZDSCAL( N, TWO, B, 1 )
592 END IF
593 *
594 * Flip the matrix if the transpose will be used.
595 *
596 IF( .NOT.LSAME( TRANS, 'N' ) ) THEN
597 IF( UPPER ) THEN
598 DO 420 J = 1, N / 2
599 LENJ = MIN( N-2*J+1, KD+1 )
600 CALL ZSWAP( LENJ, AB( KD+1, J ), LDAB-1,
601 $ AB( KD+2-LENJ, N-J+1 ), -1 )
602 420 CONTINUE
603 ELSE
604 DO 430 J = 1, N / 2
605 LENJ = MIN( N-2*J+1, KD+1 )
606 CALL ZSWAP( LENJ, AB( 1, J ), 1, AB( LENJ, N-J+2-LENJ ),
607 $ -LDAB+1 )
608 430 CONTINUE
609 END IF
610 END IF
611 *
612 RETURN
613 *
614 * End of ZLATTB
615 *
616 END
2 $ LDAB, B, WORK, RWORK, INFO )
3 *
4 * -- LAPACK test routine (version 3.1) --
5 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
6 * November 2006
7 *
8 * .. Scalar Arguments ..
9 CHARACTER DIAG, TRANS, UPLO
10 INTEGER IMAT, INFO, KD, LDAB, N
11 * ..
12 * .. Array Arguments ..
13 INTEGER ISEED( 4 )
14 DOUBLE PRECISION RWORK( * )
15 COMPLEX*16 AB( LDAB, * ), B( * ), WORK( * )
16 * ..
17 *
18 * Purpose
19 * =======
20 *
21 * ZLATTB generates a triangular test matrix in 2-dimensional storage.
22 * IMAT and UPLO uniquely specify the properties of the test matrix,
23 * which is returned in the array A.
24 *
25 * Arguments
26 * =========
27 *
28 * IMAT (input) INTEGER
29 * An integer key describing which matrix to generate for this
30 * path.
31 *
32 * UPLO (input) CHARACTER*1
33 * Specifies whether the matrix A will be upper or lower
34 * triangular.
35 * = 'U': Upper triangular
36 * = 'L': Lower triangular
37 *
38 * TRANS (input) CHARACTER*1
39 * Specifies whether the matrix or its transpose will be used.
40 * = 'N': No transpose
41 * = 'T': Transpose
42 * = 'C': Conjugate transpose (= transpose)
43 *
44 * DIAG (output) CHARACTER*1
45 * Specifies whether or not the matrix A is unit triangular.
46 * = 'N': Non-unit triangular
47 * = 'U': Unit triangular
48 *
49 * ISEED (input/output) INTEGER array, dimension (4)
50 * The seed vector for the random number generator (used in
51 * ZLATMS). Modified on exit.
52 *
53 * N (input) INTEGER
54 * The order of the matrix to be generated.
55 *
56 * KD (input) INTEGER
57 * The number of superdiagonals or subdiagonals of the banded
58 * triangular matrix A. KD >= 0.
59 *
60 * AB (output) COMPLEX*16 array, dimension (LDAB,N)
61 * The upper or lower triangular banded matrix A, stored in the
62 * first KD+1 rows of AB. Let j be a column of A, 1<=j<=n.
63 * If UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j.
64 * If UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd).
65 *
66 * LDAB (input) INTEGER
67 * The leading dimension of the array AB. LDAB >= KD+1.
68 *
69 * B (workspace) COMPLEX*16 array, dimension (N)
70 *
71 * WORK (workspace) COMPLEX*16 array, dimension (2*N)
72 *
73 * RWORK (workspace) DOUBLE PRECISION array, dimension (N)
74 *
75 * INFO (output) INTEGER
76 * = 0: successful exit
77 * < 0: if INFO = -i, the i-th argument had an illegal value
78 *
79 * =====================================================================
80 *
81 * .. Parameters ..
82 DOUBLE PRECISION ONE, TWO, ZERO
83 PARAMETER ( ONE = 1.0D+0, TWO = 2.0D+0, ZERO = 0.0D+0 )
84 * ..
85 * .. Local Scalars ..
86 LOGICAL UPPER
87 CHARACTER DIST, PACKIT, TYPE
88 CHARACTER*3 PATH
89 INTEGER I, IOFF, IY, J, JCOUNT, KL, KU, LENJ, MODE
90 DOUBLE PRECISION ANORM, BIGNUM, BNORM, BSCAL, CNDNUM, REXP,
91 $ SFAC, SMLNUM, TEXP, TLEFT, TNORM, TSCAL, ULP,
92 $ UNFL
93 COMPLEX*16 PLUS1, PLUS2, STAR1
94 * ..
95 * .. External Functions ..
96 LOGICAL LSAME
97 INTEGER IZAMAX
98 DOUBLE PRECISION DLAMCH, DLARND
99 COMPLEX*16 ZLARND
100 EXTERNAL LSAME, IZAMAX, DLAMCH, DLARND, ZLARND
101 * ..
102 * .. External Subroutines ..
103 EXTERNAL DLABAD, DLARNV, ZCOPY, ZDSCAL, ZLARNV, ZLATB4,
104 $ ZLATMS, ZSWAP
105 * ..
106 * .. Intrinsic Functions ..
107 INTRINSIC ABS, DBLE, DCMPLX, MAX, MIN, SQRT
108 * ..
109 * .. Executable Statements ..
110 *
111 PATH( 1: 1 ) = 'Zomplex precision'
112 PATH( 2: 3 ) = 'TB'
113 UNFL = DLAMCH( 'Safe minimum' )
114 ULP = DLAMCH( 'Epsilon' )*DLAMCH( 'Base' )
115 SMLNUM = UNFL
116 BIGNUM = ( ONE-ULP ) / SMLNUM
117 CALL DLABAD( SMLNUM, BIGNUM )
118 IF( ( IMAT.GE.6 .AND. IMAT.LE.9 ) .OR. IMAT.EQ.17 ) THEN
119 DIAG = 'U'
120 ELSE
121 DIAG = 'N'
122 END IF
123 INFO = 0
124 *
125 * Quick return if N.LE.0.
126 *
127 IF( N.LE.0 )
128 $ RETURN
129 *
130 * Call ZLATB4 to set parameters for CLATMS.
131 *
132 UPPER = LSAME( UPLO, 'U' )
133 IF( UPPER ) THEN
134 CALL ZLATB4( PATH, IMAT, N, N, TYPE, KL, KU, ANORM, MODE,
135 $ CNDNUM, DIST )
136 KU = KD
137 IOFF = 1 + MAX( 0, KD-N+1 )
138 KL = 0
139 PACKIT = 'Q'
140 ELSE
141 CALL ZLATB4( PATH, -IMAT, N, N, TYPE, KL, KU, ANORM, MODE,
142 $ CNDNUM, DIST )
143 KL = KD
144 IOFF = 1
145 KU = 0
146 PACKIT = 'B'
147 END IF
148 *
149 * IMAT <= 5: Non-unit triangular matrix
150 *
151 IF( IMAT.LE.5 ) THEN
152 CALL ZLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE, CNDNUM,
153 $ ANORM, KL, KU, PACKIT, AB( IOFF, 1 ), LDAB, WORK,
154 $ INFO )
155 *
156 * IMAT > 5: Unit triangular matrix
157 * The diagonal is deliberately set to something other than 1.
158 *
159 * IMAT = 6: Matrix is the identity
160 *
161 ELSE IF( IMAT.EQ.6 ) THEN
162 IF( UPPER ) THEN
163 DO 20 J = 1, N
164 DO 10 I = MAX( 1, KD+2-J ), KD
165 AB( I, J ) = ZERO
166 10 CONTINUE
167 AB( KD+1, J ) = J
168 20 CONTINUE
169 ELSE
170 DO 40 J = 1, N
171 AB( 1, J ) = J
172 DO 30 I = 2, MIN( KD+1, N-J+1 )
173 AB( I, J ) = ZERO
174 30 CONTINUE
175 40 CONTINUE
176 END IF
177 *
178 * IMAT > 6: Non-trivial unit triangular matrix
179 *
180 * A unit triangular matrix T with condition CNDNUM is formed.
181 * In this version, T only has bandwidth 2, the rest of it is zero.
182 *
183 ELSE IF( IMAT.LE.9 ) THEN
184 TNORM = SQRT( CNDNUM )
185 *
186 * Initialize AB to zero.
187 *
188 IF( UPPER ) THEN
189 DO 60 J = 1, N
190 DO 50 I = MAX( 1, KD+2-J ), KD
191 AB( I, J ) = ZERO
192 50 CONTINUE
193 AB( KD+1, J ) = DBLE( J )
194 60 CONTINUE
195 ELSE
196 DO 80 J = 1, N
197 DO 70 I = 2, MIN( KD+1, N-J+1 )
198 AB( I, J ) = ZERO
199 70 CONTINUE
200 AB( 1, J ) = DBLE( J )
201 80 CONTINUE
202 END IF
203 *
204 * Special case: T is tridiagonal. Set every other offdiagonal
205 * so that the matrix has norm TNORM+1.
206 *
207 IF( KD.EQ.1 ) THEN
208 IF( UPPER ) THEN
209 AB( 1, 2 ) = TNORM*ZLARND( 5, ISEED )
210 LENJ = ( N-3 ) / 2
211 CALL ZLARNV( 2, ISEED, LENJ, WORK )
212 DO 90 J = 1, LENJ
213 AB( 1, 2*( J+1 ) ) = TNORM*WORK( J )
214 90 CONTINUE
215 ELSE
216 AB( 2, 1 ) = TNORM*ZLARND( 5, ISEED )
217 LENJ = ( N-3 ) / 2
218 CALL ZLARNV( 2, ISEED, LENJ, WORK )
219 DO 100 J = 1, LENJ
220 AB( 2, 2*J+1 ) = TNORM*WORK( J )
221 100 CONTINUE
222 END IF
223 ELSE IF( KD.GT.1 ) THEN
224 *
225 * Form a unit triangular matrix T with condition CNDNUM. T is
226 * given by
227 * | 1 + * |
228 * | 1 + |
229 * T = | 1 + * |
230 * | 1 + |
231 * | 1 + * |
232 * | 1 + |
233 * | . . . |
234 * Each element marked with a '*' is formed by taking the product
235 * of the adjacent elements marked with '+'. The '*'s can be
236 * chosen freely, and the '+'s are chosen so that the inverse of
237 * T will have elements of the same magnitude as T.
238 *
239 * The two offdiagonals of T are stored in WORK.
240 *
241 STAR1 = TNORM*ZLARND( 5, ISEED )
242 SFAC = SQRT( TNORM )
243 PLUS1 = SFAC*ZLARND( 5, ISEED )
244 DO 110 J = 1, N, 2
245 PLUS2 = STAR1 / PLUS1
246 WORK( J ) = PLUS1
247 WORK( N+J ) = STAR1
248 IF( J+1.LE.N ) THEN
249 WORK( J+1 ) = PLUS2
250 WORK( N+J+1 ) = ZERO
251 PLUS1 = STAR1 / PLUS2
252 *
253 * Generate a new *-value with norm between sqrt(TNORM)
254 * and TNORM.
255 *
256 REXP = DLARND( 2, ISEED )
257 IF( REXP.LT.ZERO ) THEN
258 STAR1 = -SFAC**( ONE-REXP )*ZLARND( 5, ISEED )
259 ELSE
260 STAR1 = SFAC**( ONE+REXP )*ZLARND( 5, ISEED )
261 END IF
262 END IF
263 110 CONTINUE
264 *
265 * Copy the tridiagonal T to AB.
266 *
267 IF( UPPER ) THEN
268 CALL ZCOPY( N-1, WORK, 1, AB( KD, 2 ), LDAB )
269 CALL ZCOPY( N-2, WORK( N+1 ), 1, AB( KD-1, 3 ), LDAB )
270 ELSE
271 CALL ZCOPY( N-1, WORK, 1, AB( 2, 1 ), LDAB )
272 CALL ZCOPY( N-2, WORK( N+1 ), 1, AB( 3, 1 ), LDAB )
273 END IF
274 END IF
275 *
276 * IMAT > 9: Pathological test cases. These triangular matrices
277 * are badly scaled or badly conditioned, so when used in solving a
278 * triangular system they may cause overflow in the solution vector.
279 *
280 ELSE IF( IMAT.EQ.10 ) THEN
281 *
282 * Type 10: Generate a triangular matrix with elements between
283 * -1 and 1. Give the diagonal norm 2 to make it well-conditioned.
284 * Make the right hand side large so that it requires scaling.
285 *
286 IF( UPPER ) THEN
287 DO 120 J = 1, N
288 LENJ = MIN( J-1, KD )
289 CALL ZLARNV( 4, ISEED, LENJ, AB( KD+1-LENJ, J ) )
290 AB( KD+1, J ) = ZLARND( 5, ISEED )*TWO
291 120 CONTINUE
292 ELSE
293 DO 130 J = 1, N
294 LENJ = MIN( N-J, KD )
295 IF( LENJ.GT.0 )
296 $ CALL ZLARNV( 4, ISEED, LENJ, AB( 2, J ) )
297 AB( 1, J ) = ZLARND( 5, ISEED )*TWO
298 130 CONTINUE
299 END IF
300 *
301 * Set the right hand side so that the largest value is BIGNUM.
302 *
303 CALL ZLARNV( 2, ISEED, N, B )
304 IY = IZAMAX( N, B, 1 )
305 BNORM = ABS( B( IY ) )
306 BSCAL = BIGNUM / MAX( ONE, BNORM )
307 CALL ZDSCAL( N, BSCAL, B, 1 )
308 *
309 ELSE IF( IMAT.EQ.11 ) THEN
310 *
311 * Type 11: Make the first diagonal element in the solve small to
312 * cause immediate overflow when dividing by T(j,j).
313 * In type 11, the offdiagonal elements are small (CNORM(j) < 1).
314 *
315 CALL ZLARNV( 2, ISEED, N, B )
316 TSCAL = ONE / DBLE( KD+1 )
317 IF( UPPER ) THEN
318 DO 140 J = 1, N
319 LENJ = MIN( J-1, KD )
320 IF( LENJ.GT.0 ) THEN
321 CALL ZLARNV( 4, ISEED, LENJ, AB( KD+2-LENJ, J ) )
322 CALL ZDSCAL( LENJ, TSCAL, AB( KD+2-LENJ, J ), 1 )
323 END IF
324 AB( KD+1, J ) = ZLARND( 5, ISEED )
325 140 CONTINUE
326 AB( KD+1, N ) = SMLNUM*AB( KD+1, N )
327 ELSE
328 DO 150 J = 1, N
329 LENJ = MIN( N-J, KD )
330 IF( LENJ.GT.0 ) THEN
331 CALL ZLARNV( 4, ISEED, LENJ, AB( 2, J ) )
332 CALL ZDSCAL( LENJ, TSCAL, AB( 2, J ), 1 )
333 END IF
334 AB( 1, J ) = ZLARND( 5, ISEED )
335 150 CONTINUE
336 AB( 1, 1 ) = SMLNUM*AB( 1, 1 )
337 END IF
338 *
339 ELSE IF( IMAT.EQ.12 ) THEN
340 *
341 * Type 12: Make the first diagonal element in the solve small to
342 * cause immediate overflow when dividing by T(j,j).
343 * In type 12, the offdiagonal elements are O(1) (CNORM(j) > 1).
344 *
345 CALL ZLARNV( 2, ISEED, N, B )
346 IF( UPPER ) THEN
347 DO 160 J = 1, N
348 LENJ = MIN( J-1, KD )
349 IF( LENJ.GT.0 )
350 $ CALL ZLARNV( 4, ISEED, LENJ, AB( KD+2-LENJ, J ) )
351 AB( KD+1, J ) = ZLARND( 5, ISEED )
352 160 CONTINUE
353 AB( KD+1, N ) = SMLNUM*AB( KD+1, N )
354 ELSE
355 DO 170 J = 1, N
356 LENJ = MIN( N-J, KD )
357 IF( LENJ.GT.0 )
358 $ CALL ZLARNV( 4, ISEED, LENJ, AB( 2, J ) )
359 AB( 1, J ) = ZLARND( 5, ISEED )
360 170 CONTINUE
361 AB( 1, 1 ) = SMLNUM*AB( 1, 1 )
362 END IF
363 *
364 ELSE IF( IMAT.EQ.13 ) THEN
365 *
366 * Type 13: T is diagonal with small numbers on the diagonal to
367 * make the growth factor underflow, but a small right hand side
368 * chosen so that the solution does not overflow.
369 *
370 IF( UPPER ) THEN
371 JCOUNT = 1
372 DO 190 J = N, 1, -1
373 DO 180 I = MAX( 1, KD+1-( J-1 ) ), KD
374 AB( I, J ) = ZERO
375 180 CONTINUE
376 IF( JCOUNT.LE.2 ) THEN
377 AB( KD+1, J ) = SMLNUM*ZLARND( 5, ISEED )
378 ELSE
379 AB( KD+1, J ) = ZLARND( 5, ISEED )
380 END IF
381 JCOUNT = JCOUNT + 1
382 IF( JCOUNT.GT.4 )
383 $ JCOUNT = 1
384 190 CONTINUE
385 ELSE
386 JCOUNT = 1
387 DO 210 J = 1, N
388 DO 200 I = 2, MIN( N-J+1, KD+1 )
389 AB( I, J ) = ZERO
390 200 CONTINUE
391 IF( JCOUNT.LE.2 ) THEN
392 AB( 1, J ) = SMLNUM*ZLARND( 5, ISEED )
393 ELSE
394 AB( 1, J ) = ZLARND( 5, ISEED )
395 END IF
396 JCOUNT = JCOUNT + 1
397 IF( JCOUNT.GT.4 )
398 $ JCOUNT = 1
399 210 CONTINUE
400 END IF
401 *
402 * Set the right hand side alternately zero and small.
403 *
404 IF( UPPER ) THEN
405 B( 1 ) = ZERO
406 DO 220 I = N, 2, -2
407 B( I ) = ZERO
408 B( I-1 ) = SMLNUM*ZLARND( 5, ISEED )
409 220 CONTINUE
410 ELSE
411 B( N ) = ZERO
412 DO 230 I = 1, N - 1, 2
413 B( I ) = ZERO
414 B( I+1 ) = SMLNUM*ZLARND( 5, ISEED )
415 230 CONTINUE
416 END IF
417 *
418 ELSE IF( IMAT.EQ.14 ) THEN
419 *
420 * Type 14: Make the diagonal elements small to cause gradual
421 * overflow when dividing by T(j,j). To control the amount of
422 * scaling needed, the matrix is bidiagonal.
423 *
424 TEXP = ONE / DBLE( KD+1 )
425 TSCAL = SMLNUM**TEXP
426 CALL ZLARNV( 4, ISEED, N, B )
427 IF( UPPER ) THEN
428 DO 250 J = 1, N
429 DO 240 I = MAX( 1, KD+2-J ), KD
430 AB( I, J ) = ZERO
431 240 CONTINUE
432 IF( J.GT.1 .AND. KD.GT.0 )
433 $ AB( KD, J ) = DCMPLX( -ONE, -ONE )
434 AB( KD+1, J ) = TSCAL*ZLARND( 5, ISEED )
435 250 CONTINUE
436 B( N ) = DCMPLX( ONE, ONE )
437 ELSE
438 DO 270 J = 1, N
439 DO 260 I = 3, MIN( N-J+1, KD+1 )
440 AB( I, J ) = ZERO
441 260 CONTINUE
442 IF( J.LT.N .AND. KD.GT.0 )
443 $ AB( 2, J ) = DCMPLX( -ONE, -ONE )
444 AB( 1, J ) = TSCAL*ZLARND( 5, ISEED )
445 270 CONTINUE
446 B( 1 ) = DCMPLX( ONE, ONE )
447 END IF
448 *
449 ELSE IF( IMAT.EQ.15 ) THEN
450 *
451 * Type 15: One zero diagonal element.
452 *
453 IY = N / 2 + 1
454 IF( UPPER ) THEN
455 DO 280 J = 1, N
456 LENJ = MIN( J, KD+1 )
457 CALL ZLARNV( 4, ISEED, LENJ, AB( KD+2-LENJ, J ) )
458 IF( J.NE.IY ) THEN
459 AB( KD+1, J ) = ZLARND( 5, ISEED )*TWO
460 ELSE
461 AB( KD+1, J ) = ZERO
462 END IF
463 280 CONTINUE
464 ELSE
465 DO 290 J = 1, N
466 LENJ = MIN( N-J+1, KD+1 )
467 CALL ZLARNV( 4, ISEED, LENJ, AB( 1, J ) )
468 IF( J.NE.IY ) THEN
469 AB( 1, J ) = ZLARND( 5, ISEED )*TWO
470 ELSE
471 AB( 1, J ) = ZERO
472 END IF
473 290 CONTINUE
474 END IF
475 CALL ZLARNV( 2, ISEED, N, B )
476 CALL ZDSCAL( N, TWO, B, 1 )
477 *
478 ELSE IF( IMAT.EQ.16 ) THEN
479 *
480 * Type 16: Make the offdiagonal elements large to cause overflow
481 * when adding a column of T. In the non-transposed case, the
482 * matrix is constructed to cause overflow when adding a column in
483 * every other step.
484 *
485 TSCAL = UNFL / ULP
486 TSCAL = ( ONE-ULP ) / TSCAL
487 DO 310 J = 1, N
488 DO 300 I = 1, KD + 1
489 AB( I, J ) = ZERO
490 300 CONTINUE
491 310 CONTINUE
492 TEXP = ONE
493 IF( KD.GT.0 ) THEN
494 IF( UPPER ) THEN
495 DO 330 J = N, 1, -KD
496 DO 320 I = J, MAX( 1, J-KD+1 ), -2
497 AB( 1+( J-I ), I ) = -TSCAL / DBLE( KD+2 )
498 AB( KD+1, I ) = ONE
499 B( I ) = TEXP*( ONE-ULP )
500 IF( I.GT.MAX( 1, J-KD+1 ) ) THEN
501 AB( 2+( J-I ), I-1 ) = -( TSCAL / DBLE( KD+2 ) )
502 $ / DBLE( KD+3 )
503 AB( KD+1, I-1 ) = ONE
504 B( I-1 ) = TEXP*DBLE( ( KD+1 )*( KD+1 )+KD )
505 END IF
506 TEXP = TEXP*TWO
507 320 CONTINUE
508 B( MAX( 1, J-KD+1 ) ) = ( DBLE( KD+2 ) /
509 $ DBLE( KD+3 ) )*TSCAL
510 330 CONTINUE
511 ELSE
512 DO 350 J = 1, N, KD
513 TEXP = ONE
514 LENJ = MIN( KD+1, N-J+1 )
515 DO 340 I = J, MIN( N, J+KD-1 ), 2
516 AB( LENJ-( I-J ), J ) = -TSCAL / DBLE( KD+2 )
517 AB( 1, J ) = ONE
518 B( J ) = TEXP*( ONE-ULP )
519 IF( I.LT.MIN( N, J+KD-1 ) ) THEN
520 AB( LENJ-( I-J+1 ), I+1 ) = -( TSCAL /
521 $ DBLE( KD+2 ) ) / DBLE( KD+3 )
522 AB( 1, I+1 ) = ONE
523 B( I+1 ) = TEXP*DBLE( ( KD+1 )*( KD+1 )+KD )
524 END IF
525 TEXP = TEXP*TWO
526 340 CONTINUE
527 B( MIN( N, J+KD-1 ) ) = ( DBLE( KD+2 ) /
528 $ DBLE( KD+3 ) )*TSCAL
529 350 CONTINUE
530 END IF
531 END IF
532 *
533 ELSE IF( IMAT.EQ.17 ) THEN
534 *
535 * Type 17: Generate a unit triangular matrix with elements
536 * between -1 and 1, and make the right hand side large so that it
537 * requires scaling.
538 *
539 IF( UPPER ) THEN
540 DO 360 J = 1, N
541 LENJ = MIN( J-1, KD )
542 CALL ZLARNV( 4, ISEED, LENJ, AB( KD+1-LENJ, J ) )
543 AB( KD+1, J ) = DBLE( J )
544 360 CONTINUE
545 ELSE
546 DO 370 J = 1, N
547 LENJ = MIN( N-J, KD )
548 IF( LENJ.GT.0 )
549 $ CALL ZLARNV( 4, ISEED, LENJ, AB( 2, J ) )
550 AB( 1, J ) = DBLE( J )
551 370 CONTINUE
552 END IF
553 *
554 * Set the right hand side so that the largest value is BIGNUM.
555 *
556 CALL ZLARNV( 2, ISEED, N, B )
557 IY = IZAMAX( N, B, 1 )
558 BNORM = ABS( B( IY ) )
559 BSCAL = BIGNUM / MAX( ONE, BNORM )
560 CALL ZDSCAL( N, BSCAL, B, 1 )
561 *
562 ELSE IF( IMAT.EQ.18 ) THEN
563 *
564 * Type 18: Generate a triangular matrix with elements between
565 * BIGNUM/(KD+1) and BIGNUM so that at least one of the column
566 * norms will exceed BIGNUM.
567 * 1/3/91: ZLATBS no longer can handle this case
568 *
569 TLEFT = BIGNUM / DBLE( KD+1 )
570 TSCAL = BIGNUM*( DBLE( KD+1 ) / DBLE( KD+2 ) )
571 IF( UPPER ) THEN
572 DO 390 J = 1, N
573 LENJ = MIN( J, KD+1 )
574 CALL ZLARNV( 5, ISEED, LENJ, AB( KD+2-LENJ, J ) )
575 CALL DLARNV( 1, ISEED, LENJ, RWORK( KD+2-LENJ ) )
576 DO 380 I = KD + 2 - LENJ, KD + 1
577 AB( I, J ) = AB( I, J )*( TLEFT+RWORK( I )*TSCAL )
578 380 CONTINUE
579 390 CONTINUE
580 ELSE
581 DO 410 J = 1, N
582 LENJ = MIN( N-J+1, KD+1 )
583 CALL ZLARNV( 5, ISEED, LENJ, AB( 1, J ) )
584 CALL DLARNV( 1, ISEED, LENJ, RWORK )
585 DO 400 I = 1, LENJ
586 AB( I, J ) = AB( I, J )*( TLEFT+RWORK( I )*TSCAL )
587 400 CONTINUE
588 410 CONTINUE
589 END IF
590 CALL ZLARNV( 2, ISEED, N, B )
591 CALL ZDSCAL( N, TWO, B, 1 )
592 END IF
593 *
594 * Flip the matrix if the transpose will be used.
595 *
596 IF( .NOT.LSAME( TRANS, 'N' ) ) THEN
597 IF( UPPER ) THEN
598 DO 420 J = 1, N / 2
599 LENJ = MIN( N-2*J+1, KD+1 )
600 CALL ZSWAP( LENJ, AB( KD+1, J ), LDAB-1,
601 $ AB( KD+2-LENJ, N-J+1 ), -1 )
602 420 CONTINUE
603 ELSE
604 DO 430 J = 1, N / 2
605 LENJ = MIN( N-2*J+1, KD+1 )
606 CALL ZSWAP( LENJ, AB( 1, J ), 1, AB( LENJ, N-J+2-LENJ ),
607 $ -LDAB+1 )
608 430 CONTINUE
609 END IF
610 END IF
611 *
612 RETURN
613 *
614 * End of ZLATTB
615 *
616 END