1 SUBROUTINE ZLATTR( IMAT, UPLO, TRANS, DIAG, ISEED, N, A, LDA, B,
2 $ 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, LDA, N
11 * ..
12 * .. Array Arguments ..
13 INTEGER ISEED( 4 )
14 DOUBLE PRECISION RWORK( * )
15 COMPLEX*16 A( LDA, * ), B( * ), WORK( * )
16 * ..
17 *
18 * Purpose
19 * =======
20 *
21 * ZLATTR 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
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 * A (output) COMPLEX*16 array, dimension (LDA,N)
57 * The triangular matrix A. If UPLO = 'U', the leading N x N
58 * upper triangular part of the array A contains the upper
59 * triangular matrix, and the strictly lower triangular part of
60 * A is not referenced. If UPLO = 'L', the leading N x N lower
61 * triangular part of the array A contains the lower triangular
62 * matrix and the strictly upper triangular part of A is not
63 * referenced.
64 *
65 * LDA (input) INTEGER
66 * The leading dimension of the array A. LDA >= max(1,N).
67 *
68 * B (output) COMPLEX*16 array, dimension (N)
69 * The right hand side vector, if IMAT > 10.
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, TYPE
88 CHARACTER*3 PATH
89 INTEGER I, IY, J, JCOUNT, KL, KU, MODE
90 DOUBLE PRECISION ANORM, BIGNUM, BNORM, BSCAL, C, CNDNUM, REXP,
91 $ SFAC, SMLNUM, TEXP, TLEFT, TSCAL, ULP, UNFL, X,
92 $ Y, Z
93 COMPLEX*16 PLUS1, PLUS2, RA, RB, S, 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, ZROT, ZROTG, ZSWAP
105 * ..
106 * .. Intrinsic Functions ..
107 INTRINSIC ABS, DBLE, DCMPLX, DCONJG, MAX, SQRT
108 * ..
109 * .. Executable Statements ..
110 *
111 PATH( 1: 1 ) = 'Zomplex precision'
112 PATH( 2: 3 ) = 'TR'
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.7 .AND. IMAT.LE.10 ) .OR. IMAT.EQ.18 ) 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 ELSE
137 CALL ZLATB4( PATH, -IMAT, N, N, TYPE, KL, KU, ANORM, MODE,
138 $ CNDNUM, DIST )
139 END IF
140 *
141 * IMAT <= 6: Non-unit triangular matrix
142 *
143 IF( IMAT.LE.6 ) THEN
144 CALL ZLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE, CNDNUM,
145 $ ANORM, KL, KU, 'No packing', A, LDA, WORK, INFO )
146 *
147 * IMAT > 6: Unit triangular matrix
148 * The diagonal is deliberately set to something other than 1.
149 *
150 * IMAT = 7: Matrix is the identity
151 *
152 ELSE IF( IMAT.EQ.7 ) THEN
153 IF( UPPER ) THEN
154 DO 20 J = 1, N
155 DO 10 I = 1, J - 1
156 A( I, J ) = ZERO
157 10 CONTINUE
158 A( J, J ) = J
159 20 CONTINUE
160 ELSE
161 DO 40 J = 1, N
162 A( J, J ) = J
163 DO 30 I = J + 1, N
164 A( I, J ) = ZERO
165 30 CONTINUE
166 40 CONTINUE
167 END IF
168 *
169 * IMAT > 7: Non-trivial unit triangular matrix
170 *
171 * Generate a unit triangular matrix T with condition CNDNUM by
172 * forming a triangular matrix with known singular values and
173 * filling in the zero entries with Givens rotations.
174 *
175 ELSE IF( IMAT.LE.10 ) THEN
176 IF( UPPER ) THEN
177 DO 60 J = 1, N
178 DO 50 I = 1, J - 1
179 A( I, J ) = ZERO
180 50 CONTINUE
181 A( J, J ) = J
182 60 CONTINUE
183 ELSE
184 DO 80 J = 1, N
185 A( J, J ) = J
186 DO 70 I = J + 1, N
187 A( I, J ) = ZERO
188 70 CONTINUE
189 80 CONTINUE
190 END IF
191 *
192 * Since the trace of a unit triangular matrix is 1, the product
193 * of its singular values must be 1. Let s = sqrt(CNDNUM),
194 * x = sqrt(s) - 1/sqrt(s), y = sqrt(2/(n-2))*x, and z = x**2.
195 * The following triangular matrix has singular values s, 1, 1,
196 * ..., 1, 1/s:
197 *
198 * 1 y y y ... y y z
199 * 1 0 0 ... 0 0 y
200 * 1 0 ... 0 0 y
201 * . ... . . .
202 * . . . .
203 * 1 0 y
204 * 1 y
205 * 1
206 *
207 * To fill in the zeros, we first multiply by a matrix with small
208 * condition number of the form
209 *
210 * 1 0 0 0 0 ...
211 * 1 + * 0 0 ...
212 * 1 + 0 0 0
213 * 1 + * 0 0
214 * 1 + 0 0
215 * ...
216 * 1 + 0
217 * 1 0
218 * 1
219 *
220 * Each element marked with a '*' is formed by taking the product
221 * of the adjacent elements marked with '+'. The '*'s can be
222 * chosen freely, and the '+'s are chosen so that the inverse of
223 * T will have elements of the same magnitude as T. If the *'s in
224 * both T and inv(T) have small magnitude, T is well conditioned.
225 * The two offdiagonals of T are stored in WORK.
226 *
227 * The product of these two matrices has the form
228 *
229 * 1 y y y y y . y y z
230 * 1 + * 0 0 . 0 0 y
231 * 1 + 0 0 . 0 0 y
232 * 1 + * . . . .
233 * 1 + . . . .
234 * . . . . .
235 * . . . .
236 * 1 + y
237 * 1 y
238 * 1
239 *
240 * Now we multiply by Givens rotations, using the fact that
241 *
242 * [ c s ] [ 1 w ] [ -c -s ] = [ 1 -w ]
243 * [ -s c ] [ 0 1 ] [ s -c ] [ 0 1 ]
244 * and
245 * [ -c -s ] [ 1 0 ] [ c s ] = [ 1 0 ]
246 * [ s -c ] [ w 1 ] [ -s c ] [ -w 1 ]
247 *
248 * where c = w / sqrt(w**2+4) and s = 2 / sqrt(w**2+4).
249 *
250 STAR1 = 0.25D0*ZLARND( 5, ISEED )
251 SFAC = 0.5D0
252 PLUS1 = SFAC*ZLARND( 5, ISEED )
253 DO 90 J = 1, N, 2
254 PLUS2 = STAR1 / PLUS1
255 WORK( J ) = PLUS1
256 WORK( N+J ) = STAR1
257 IF( J+1.LE.N ) THEN
258 WORK( J+1 ) = PLUS2
259 WORK( N+J+1 ) = ZERO
260 PLUS1 = STAR1 / PLUS2
261 REXP = DLARND( 2, ISEED )
262 IF( REXP.LT.ZERO ) THEN
263 STAR1 = -SFAC**( ONE-REXP )*ZLARND( 5, ISEED )
264 ELSE
265 STAR1 = SFAC**( ONE+REXP )*ZLARND( 5, ISEED )
266 END IF
267 END IF
268 90 CONTINUE
269 *
270 X = SQRT( CNDNUM ) - 1 / SQRT( CNDNUM )
271 IF( N.GT.2 ) THEN
272 Y = SQRT( 2.D0 / ( N-2 ) )*X
273 ELSE
274 Y = ZERO
275 END IF
276 Z = X*X
277 *
278 IF( UPPER ) THEN
279 IF( N.GT.3 ) THEN
280 CALL ZCOPY( N-3, WORK, 1, A( 2, 3 ), LDA+1 )
281 IF( N.GT.4 )
282 $ CALL ZCOPY( N-4, WORK( N+1 ), 1, A( 2, 4 ), LDA+1 )
283 END IF
284 DO 100 J = 2, N - 1
285 A( 1, J ) = Y
286 A( J, N ) = Y
287 100 CONTINUE
288 A( 1, N ) = Z
289 ELSE
290 IF( N.GT.3 ) THEN
291 CALL ZCOPY( N-3, WORK, 1, A( 3, 2 ), LDA+1 )
292 IF( N.GT.4 )
293 $ CALL ZCOPY( N-4, WORK( N+1 ), 1, A( 4, 2 ), LDA+1 )
294 END IF
295 DO 110 J = 2, N - 1
296 A( J, 1 ) = Y
297 A( N, J ) = Y
298 110 CONTINUE
299 A( N, 1 ) = Z
300 END IF
301 *
302 * Fill in the zeros using Givens rotations.
303 *
304 IF( UPPER ) THEN
305 DO 120 J = 1, N - 1
306 RA = A( J, J+1 )
307 RB = 2.0D0
308 CALL ZROTG( RA, RB, C, S )
309 *
310 * Multiply by [ c s; -conjg(s) c] on the left.
311 *
312 IF( N.GT.J+1 )
313 $ CALL ZROT( N-J-1, A( J, J+2 ), LDA, A( J+1, J+2 ),
314 $ LDA, C, S )
315 *
316 * Multiply by [-c -s; conjg(s) -c] on the right.
317 *
318 IF( J.GT.1 )
319 $ CALL ZROT( J-1, A( 1, J+1 ), 1, A( 1, J ), 1, -C, -S )
320 *
321 * Negate A(J,J+1).
322 *
323 A( J, J+1 ) = -A( J, J+1 )
324 120 CONTINUE
325 ELSE
326 DO 130 J = 1, N - 1
327 RA = A( J+1, J )
328 RB = 2.0D0
329 CALL ZROTG( RA, RB, C, S )
330 S = DCONJG( S )
331 *
332 * Multiply by [ c -s; conjg(s) c] on the right.
333 *
334 IF( N.GT.J+1 )
335 $ CALL ZROT( N-J-1, A( J+2, J+1 ), 1, A( J+2, J ), 1, C,
336 $ -S )
337 *
338 * Multiply by [-c s; -conjg(s) -c] on the left.
339 *
340 IF( J.GT.1 )
341 $ CALL ZROT( J-1, A( J, 1 ), LDA, A( J+1, 1 ), LDA, -C,
342 $ S )
343 *
344 * Negate A(J+1,J).
345 *
346 A( J+1, J ) = -A( J+1, J )
347 130 CONTINUE
348 END IF
349 *
350 * IMAT > 10: Pathological test cases. These triangular matrices
351 * are badly scaled or badly conditioned, so when used in solving a
352 * triangular system they may cause overflow in the solution vector.
353 *
354 ELSE IF( IMAT.EQ.11 ) THEN
355 *
356 * Type 11: Generate a triangular matrix with elements between
357 * -1 and 1. Give the diagonal norm 2 to make it well-conditioned.
358 * Make the right hand side large so that it requires scaling.
359 *
360 IF( UPPER ) THEN
361 DO 140 J = 1, N
362 CALL ZLARNV( 4, ISEED, J-1, A( 1, J ) )
363 A( J, J ) = ZLARND( 5, ISEED )*TWO
364 140 CONTINUE
365 ELSE
366 DO 150 J = 1, N
367 IF( J.LT.N )
368 $ CALL ZLARNV( 4, ISEED, N-J, A( J+1, J ) )
369 A( J, J ) = ZLARND( 5, ISEED )*TWO
370 150 CONTINUE
371 END IF
372 *
373 * Set the right hand side so that the largest value is BIGNUM.
374 *
375 CALL ZLARNV( 2, ISEED, N, B )
376 IY = IZAMAX( N, B, 1 )
377 BNORM = ABS( B( IY ) )
378 BSCAL = BIGNUM / MAX( ONE, BNORM )
379 CALL ZDSCAL( N, BSCAL, B, 1 )
380 *
381 ELSE IF( IMAT.EQ.12 ) THEN
382 *
383 * Type 12: Make the first diagonal element in the solve small to
384 * cause immediate overflow when dividing by T(j,j).
385 * In type 12, the offdiagonal elements are small (CNORM(j) < 1).
386 *
387 CALL ZLARNV( 2, ISEED, N, B )
388 TSCAL = ONE / MAX( ONE, DBLE( N-1 ) )
389 IF( UPPER ) THEN
390 DO 160 J = 1, N
391 CALL ZLARNV( 4, ISEED, J-1, A( 1, J ) )
392 CALL ZDSCAL( J-1, TSCAL, A( 1, J ), 1 )
393 A( J, J ) = ZLARND( 5, ISEED )
394 160 CONTINUE
395 A( N, N ) = SMLNUM*A( N, N )
396 ELSE
397 DO 170 J = 1, N
398 IF( J.LT.N ) THEN
399 CALL ZLARNV( 4, ISEED, N-J, A( J+1, J ) )
400 CALL ZDSCAL( N-J, TSCAL, A( J+1, J ), 1 )
401 END IF
402 A( J, J ) = ZLARND( 5, ISEED )
403 170 CONTINUE
404 A( 1, 1 ) = SMLNUM*A( 1, 1 )
405 END IF
406 *
407 ELSE IF( IMAT.EQ.13 ) THEN
408 *
409 * Type 13: Make the first diagonal element in the solve small to
410 * cause immediate overflow when dividing by T(j,j).
411 * In type 13, the offdiagonal elements are O(1) (CNORM(j) > 1).
412 *
413 CALL ZLARNV( 2, ISEED, N, B )
414 IF( UPPER ) THEN
415 DO 180 J = 1, N
416 CALL ZLARNV( 4, ISEED, J-1, A( 1, J ) )
417 A( J, J ) = ZLARND( 5, ISEED )
418 180 CONTINUE
419 A( N, N ) = SMLNUM*A( N, N )
420 ELSE
421 DO 190 J = 1, N
422 IF( J.LT.N )
423 $ CALL ZLARNV( 4, ISEED, N-J, A( J+1, J ) )
424 A( J, J ) = ZLARND( 5, ISEED )
425 190 CONTINUE
426 A( 1, 1 ) = SMLNUM*A( 1, 1 )
427 END IF
428 *
429 ELSE IF( IMAT.EQ.14 ) THEN
430 *
431 * Type 14: T is diagonal with small numbers on the diagonal to
432 * make the growth factor underflow, but a small right hand side
433 * chosen so that the solution does not overflow.
434 *
435 IF( UPPER ) THEN
436 JCOUNT = 1
437 DO 210 J = N, 1, -1
438 DO 200 I = 1, J - 1
439 A( I, J ) = ZERO
440 200 CONTINUE
441 IF( JCOUNT.LE.2 ) THEN
442 A( J, J ) = SMLNUM*ZLARND( 5, ISEED )
443 ELSE
444 A( J, J ) = ZLARND( 5, ISEED )
445 END IF
446 JCOUNT = JCOUNT + 1
447 IF( JCOUNT.GT.4 )
448 $ JCOUNT = 1
449 210 CONTINUE
450 ELSE
451 JCOUNT = 1
452 DO 230 J = 1, N
453 DO 220 I = J + 1, N
454 A( I, J ) = ZERO
455 220 CONTINUE
456 IF( JCOUNT.LE.2 ) THEN
457 A( J, J ) = SMLNUM*ZLARND( 5, ISEED )
458 ELSE
459 A( J, J ) = ZLARND( 5, ISEED )
460 END IF
461 JCOUNT = JCOUNT + 1
462 IF( JCOUNT.GT.4 )
463 $ JCOUNT = 1
464 230 CONTINUE
465 END IF
466 *
467 * Set the right hand side alternately zero and small.
468 *
469 IF( UPPER ) THEN
470 B( 1 ) = ZERO
471 DO 240 I = N, 2, -2
472 B( I ) = ZERO
473 B( I-1 ) = SMLNUM*ZLARND( 5, ISEED )
474 240 CONTINUE
475 ELSE
476 B( N ) = ZERO
477 DO 250 I = 1, N - 1, 2
478 B( I ) = ZERO
479 B( I+1 ) = SMLNUM*ZLARND( 5, ISEED )
480 250 CONTINUE
481 END IF
482 *
483 ELSE IF( IMAT.EQ.15 ) THEN
484 *
485 * Type 15: Make the diagonal elements small to cause gradual
486 * overflow when dividing by T(j,j). To control the amount of
487 * scaling needed, the matrix is bidiagonal.
488 *
489 TEXP = ONE / MAX( ONE, DBLE( N-1 ) )
490 TSCAL = SMLNUM**TEXP
491 CALL ZLARNV( 4, ISEED, N, B )
492 IF( UPPER ) THEN
493 DO 270 J = 1, N
494 DO 260 I = 1, J - 2
495 A( I, J ) = 0.D0
496 260 CONTINUE
497 IF( J.GT.1 )
498 $ A( J-1, J ) = DCMPLX( -ONE, -ONE )
499 A( J, J ) = TSCAL*ZLARND( 5, ISEED )
500 270 CONTINUE
501 B( N ) = DCMPLX( ONE, ONE )
502 ELSE
503 DO 290 J = 1, N
504 DO 280 I = J + 2, N
505 A( I, J ) = 0.D0
506 280 CONTINUE
507 IF( J.LT.N )
508 $ A( J+1, J ) = DCMPLX( -ONE, -ONE )
509 A( J, J ) = TSCAL*ZLARND( 5, ISEED )
510 290 CONTINUE
511 B( 1 ) = DCMPLX( ONE, ONE )
512 END IF
513 *
514 ELSE IF( IMAT.EQ.16 ) THEN
515 *
516 * Type 16: One zero diagonal element.
517 *
518 IY = N / 2 + 1
519 IF( UPPER ) THEN
520 DO 300 J = 1, N
521 CALL ZLARNV( 4, ISEED, J-1, A( 1, J ) )
522 IF( J.NE.IY ) THEN
523 A( J, J ) = ZLARND( 5, ISEED )*TWO
524 ELSE
525 A( J, J ) = ZERO
526 END IF
527 300 CONTINUE
528 ELSE
529 DO 310 J = 1, N
530 IF( J.LT.N )
531 $ CALL ZLARNV( 4, ISEED, N-J, A( J+1, J ) )
532 IF( J.NE.IY ) THEN
533 A( J, J ) = ZLARND( 5, ISEED )*TWO
534 ELSE
535 A( J, J ) = ZERO
536 END IF
537 310 CONTINUE
538 END IF
539 CALL ZLARNV( 2, ISEED, N, B )
540 CALL ZDSCAL( N, TWO, B, 1 )
541 *
542 ELSE IF( IMAT.EQ.17 ) THEN
543 *
544 * Type 17: Make the offdiagonal elements large to cause overflow
545 * when adding a column of T. In the non-transposed case, the
546 * matrix is constructed to cause overflow when adding a column in
547 * every other step.
548 *
549 TSCAL = UNFL / ULP
550 TSCAL = ( ONE-ULP ) / TSCAL
551 DO 330 J = 1, N
552 DO 320 I = 1, N
553 A( I, J ) = 0.D0
554 320 CONTINUE
555 330 CONTINUE
556 TEXP = ONE
557 IF( UPPER ) THEN
558 DO 340 J = N, 2, -2
559 A( 1, J ) = -TSCAL / DBLE( N+1 )
560 A( J, J ) = ONE
561 B( J ) = TEXP*( ONE-ULP )
562 A( 1, J-1 ) = -( TSCAL / DBLE( N+1 ) ) / DBLE( N+2 )
563 A( J-1, J-1 ) = ONE
564 B( J-1 ) = TEXP*DBLE( N*N+N-1 )
565 TEXP = TEXP*2.D0
566 340 CONTINUE
567 B( 1 ) = ( DBLE( N+1 ) / DBLE( N+2 ) )*TSCAL
568 ELSE
569 DO 350 J = 1, N - 1, 2
570 A( N, J ) = -TSCAL / DBLE( N+1 )
571 A( J, J ) = ONE
572 B( J ) = TEXP*( ONE-ULP )
573 A( N, J+1 ) = -( TSCAL / DBLE( N+1 ) ) / DBLE( N+2 )
574 A( J+1, J+1 ) = ONE
575 B( J+1 ) = TEXP*DBLE( N*N+N-1 )
576 TEXP = TEXP*2.D0
577 350 CONTINUE
578 B( N ) = ( DBLE( N+1 ) / DBLE( N+2 ) )*TSCAL
579 END IF
580 *
581 ELSE IF( IMAT.EQ.18 ) THEN
582 *
583 * Type 18: Generate a unit triangular matrix with elements
584 * between -1 and 1, and make the right hand side large so that it
585 * requires scaling.
586 *
587 IF( UPPER ) THEN
588 DO 360 J = 1, N
589 CALL ZLARNV( 4, ISEED, J-1, A( 1, J ) )
590 A( J, J ) = ZERO
591 360 CONTINUE
592 ELSE
593 DO 370 J = 1, N
594 IF( J.LT.N )
595 $ CALL ZLARNV( 4, ISEED, N-J, A( J+1, J ) )
596 A( J, J ) = ZERO
597 370 CONTINUE
598 END IF
599 *
600 * Set the right hand side so that the largest value is BIGNUM.
601 *
602 CALL ZLARNV( 2, ISEED, N, B )
603 IY = IZAMAX( N, B, 1 )
604 BNORM = ABS( B( IY ) )
605 BSCAL = BIGNUM / MAX( ONE, BNORM )
606 CALL ZDSCAL( N, BSCAL, B, 1 )
607 *
608 ELSE IF( IMAT.EQ.19 ) THEN
609 *
610 * Type 19: Generate a triangular matrix with elements between
611 * BIGNUM/(n-1) and BIGNUM so that at least one of the column
612 * norms will exceed BIGNUM.
613 * 1/3/91: ZLATRS no longer can handle this case
614 *
615 TLEFT = BIGNUM / MAX( ONE, DBLE( N-1 ) )
616 TSCAL = BIGNUM*( DBLE( N-1 ) / MAX( ONE, DBLE( N ) ) )
617 IF( UPPER ) THEN
618 DO 390 J = 1, N
619 CALL ZLARNV( 5, ISEED, J, A( 1, J ) )
620 CALL DLARNV( 1, ISEED, J, RWORK )
621 DO 380 I = 1, J
622 A( I, J ) = A( I, J )*( TLEFT+RWORK( I )*TSCAL )
623 380 CONTINUE
624 390 CONTINUE
625 ELSE
626 DO 410 J = 1, N
627 CALL ZLARNV( 5, ISEED, N-J+1, A( J, J ) )
628 CALL DLARNV( 1, ISEED, N-J+1, RWORK )
629 DO 400 I = J, N
630 A( I, J ) = A( I, J )*( TLEFT+RWORK( I-J+1 )*TSCAL )
631 400 CONTINUE
632 410 CONTINUE
633 END IF
634 CALL ZLARNV( 2, ISEED, N, B )
635 CALL ZDSCAL( N, TWO, B, 1 )
636 END IF
637 *
638 * Flip the matrix if the transpose will be used.
639 *
640 IF( .NOT.LSAME( TRANS, 'N' ) ) THEN
641 IF( UPPER ) THEN
642 DO 420 J = 1, N / 2
643 CALL ZSWAP( N-2*J+1, A( J, J ), LDA, A( J+1, N-J+1 ),
644 $ -1 )
645 420 CONTINUE
646 ELSE
647 DO 430 J = 1, N / 2
648 CALL ZSWAP( N-2*J+1, A( J, J ), 1, A( N-J+1, J+1 ),
649 $ -LDA )
650 430 CONTINUE
651 END IF
652 END IF
653 *
654 RETURN
655 *
656 * End of ZLATTR
657 *
658 END
2 $ 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, LDA, N
11 * ..
12 * .. Array Arguments ..
13 INTEGER ISEED( 4 )
14 DOUBLE PRECISION RWORK( * )
15 COMPLEX*16 A( LDA, * ), B( * ), WORK( * )
16 * ..
17 *
18 * Purpose
19 * =======
20 *
21 * ZLATTR 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
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 * A (output) COMPLEX*16 array, dimension (LDA,N)
57 * The triangular matrix A. If UPLO = 'U', the leading N x N
58 * upper triangular part of the array A contains the upper
59 * triangular matrix, and the strictly lower triangular part of
60 * A is not referenced. If UPLO = 'L', the leading N x N lower
61 * triangular part of the array A contains the lower triangular
62 * matrix and the strictly upper triangular part of A is not
63 * referenced.
64 *
65 * LDA (input) INTEGER
66 * The leading dimension of the array A. LDA >= max(1,N).
67 *
68 * B (output) COMPLEX*16 array, dimension (N)
69 * The right hand side vector, if IMAT > 10.
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, TYPE
88 CHARACTER*3 PATH
89 INTEGER I, IY, J, JCOUNT, KL, KU, MODE
90 DOUBLE PRECISION ANORM, BIGNUM, BNORM, BSCAL, C, CNDNUM, REXP,
91 $ SFAC, SMLNUM, TEXP, TLEFT, TSCAL, ULP, UNFL, X,
92 $ Y, Z
93 COMPLEX*16 PLUS1, PLUS2, RA, RB, S, 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, ZROT, ZROTG, ZSWAP
105 * ..
106 * .. Intrinsic Functions ..
107 INTRINSIC ABS, DBLE, DCMPLX, DCONJG, MAX, SQRT
108 * ..
109 * .. Executable Statements ..
110 *
111 PATH( 1: 1 ) = 'Zomplex precision'
112 PATH( 2: 3 ) = 'TR'
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.7 .AND. IMAT.LE.10 ) .OR. IMAT.EQ.18 ) 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 ELSE
137 CALL ZLATB4( PATH, -IMAT, N, N, TYPE, KL, KU, ANORM, MODE,
138 $ CNDNUM, DIST )
139 END IF
140 *
141 * IMAT <= 6: Non-unit triangular matrix
142 *
143 IF( IMAT.LE.6 ) THEN
144 CALL ZLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE, CNDNUM,
145 $ ANORM, KL, KU, 'No packing', A, LDA, WORK, INFO )
146 *
147 * IMAT > 6: Unit triangular matrix
148 * The diagonal is deliberately set to something other than 1.
149 *
150 * IMAT = 7: Matrix is the identity
151 *
152 ELSE IF( IMAT.EQ.7 ) THEN
153 IF( UPPER ) THEN
154 DO 20 J = 1, N
155 DO 10 I = 1, J - 1
156 A( I, J ) = ZERO
157 10 CONTINUE
158 A( J, J ) = J
159 20 CONTINUE
160 ELSE
161 DO 40 J = 1, N
162 A( J, J ) = J
163 DO 30 I = J + 1, N
164 A( I, J ) = ZERO
165 30 CONTINUE
166 40 CONTINUE
167 END IF
168 *
169 * IMAT > 7: Non-trivial unit triangular matrix
170 *
171 * Generate a unit triangular matrix T with condition CNDNUM by
172 * forming a triangular matrix with known singular values and
173 * filling in the zero entries with Givens rotations.
174 *
175 ELSE IF( IMAT.LE.10 ) THEN
176 IF( UPPER ) THEN
177 DO 60 J = 1, N
178 DO 50 I = 1, J - 1
179 A( I, J ) = ZERO
180 50 CONTINUE
181 A( J, J ) = J
182 60 CONTINUE
183 ELSE
184 DO 80 J = 1, N
185 A( J, J ) = J
186 DO 70 I = J + 1, N
187 A( I, J ) = ZERO
188 70 CONTINUE
189 80 CONTINUE
190 END IF
191 *
192 * Since the trace of a unit triangular matrix is 1, the product
193 * of its singular values must be 1. Let s = sqrt(CNDNUM),
194 * x = sqrt(s) - 1/sqrt(s), y = sqrt(2/(n-2))*x, and z = x**2.
195 * The following triangular matrix has singular values s, 1, 1,
196 * ..., 1, 1/s:
197 *
198 * 1 y y y ... y y z
199 * 1 0 0 ... 0 0 y
200 * 1 0 ... 0 0 y
201 * . ... . . .
202 * . . . .
203 * 1 0 y
204 * 1 y
205 * 1
206 *
207 * To fill in the zeros, we first multiply by a matrix with small
208 * condition number of the form
209 *
210 * 1 0 0 0 0 ...
211 * 1 + * 0 0 ...
212 * 1 + 0 0 0
213 * 1 + * 0 0
214 * 1 + 0 0
215 * ...
216 * 1 + 0
217 * 1 0
218 * 1
219 *
220 * Each element marked with a '*' is formed by taking the product
221 * of the adjacent elements marked with '+'. The '*'s can be
222 * chosen freely, and the '+'s are chosen so that the inverse of
223 * T will have elements of the same magnitude as T. If the *'s in
224 * both T and inv(T) have small magnitude, T is well conditioned.
225 * The two offdiagonals of T are stored in WORK.
226 *
227 * The product of these two matrices has the form
228 *
229 * 1 y y y y y . y y z
230 * 1 + * 0 0 . 0 0 y
231 * 1 + 0 0 . 0 0 y
232 * 1 + * . . . .
233 * 1 + . . . .
234 * . . . . .
235 * . . . .
236 * 1 + y
237 * 1 y
238 * 1
239 *
240 * Now we multiply by Givens rotations, using the fact that
241 *
242 * [ c s ] [ 1 w ] [ -c -s ] = [ 1 -w ]
243 * [ -s c ] [ 0 1 ] [ s -c ] [ 0 1 ]
244 * and
245 * [ -c -s ] [ 1 0 ] [ c s ] = [ 1 0 ]
246 * [ s -c ] [ w 1 ] [ -s c ] [ -w 1 ]
247 *
248 * where c = w / sqrt(w**2+4) and s = 2 / sqrt(w**2+4).
249 *
250 STAR1 = 0.25D0*ZLARND( 5, ISEED )
251 SFAC = 0.5D0
252 PLUS1 = SFAC*ZLARND( 5, ISEED )
253 DO 90 J = 1, N, 2
254 PLUS2 = STAR1 / PLUS1
255 WORK( J ) = PLUS1
256 WORK( N+J ) = STAR1
257 IF( J+1.LE.N ) THEN
258 WORK( J+1 ) = PLUS2
259 WORK( N+J+1 ) = ZERO
260 PLUS1 = STAR1 / PLUS2
261 REXP = DLARND( 2, ISEED )
262 IF( REXP.LT.ZERO ) THEN
263 STAR1 = -SFAC**( ONE-REXP )*ZLARND( 5, ISEED )
264 ELSE
265 STAR1 = SFAC**( ONE+REXP )*ZLARND( 5, ISEED )
266 END IF
267 END IF
268 90 CONTINUE
269 *
270 X = SQRT( CNDNUM ) - 1 / SQRT( CNDNUM )
271 IF( N.GT.2 ) THEN
272 Y = SQRT( 2.D0 / ( N-2 ) )*X
273 ELSE
274 Y = ZERO
275 END IF
276 Z = X*X
277 *
278 IF( UPPER ) THEN
279 IF( N.GT.3 ) THEN
280 CALL ZCOPY( N-3, WORK, 1, A( 2, 3 ), LDA+1 )
281 IF( N.GT.4 )
282 $ CALL ZCOPY( N-4, WORK( N+1 ), 1, A( 2, 4 ), LDA+1 )
283 END IF
284 DO 100 J = 2, N - 1
285 A( 1, J ) = Y
286 A( J, N ) = Y
287 100 CONTINUE
288 A( 1, N ) = Z
289 ELSE
290 IF( N.GT.3 ) THEN
291 CALL ZCOPY( N-3, WORK, 1, A( 3, 2 ), LDA+1 )
292 IF( N.GT.4 )
293 $ CALL ZCOPY( N-4, WORK( N+1 ), 1, A( 4, 2 ), LDA+1 )
294 END IF
295 DO 110 J = 2, N - 1
296 A( J, 1 ) = Y
297 A( N, J ) = Y
298 110 CONTINUE
299 A( N, 1 ) = Z
300 END IF
301 *
302 * Fill in the zeros using Givens rotations.
303 *
304 IF( UPPER ) THEN
305 DO 120 J = 1, N - 1
306 RA = A( J, J+1 )
307 RB = 2.0D0
308 CALL ZROTG( RA, RB, C, S )
309 *
310 * Multiply by [ c s; -conjg(s) c] on the left.
311 *
312 IF( N.GT.J+1 )
313 $ CALL ZROT( N-J-1, A( J, J+2 ), LDA, A( J+1, J+2 ),
314 $ LDA, C, S )
315 *
316 * Multiply by [-c -s; conjg(s) -c] on the right.
317 *
318 IF( J.GT.1 )
319 $ CALL ZROT( J-1, A( 1, J+1 ), 1, A( 1, J ), 1, -C, -S )
320 *
321 * Negate A(J,J+1).
322 *
323 A( J, J+1 ) = -A( J, J+1 )
324 120 CONTINUE
325 ELSE
326 DO 130 J = 1, N - 1
327 RA = A( J+1, J )
328 RB = 2.0D0
329 CALL ZROTG( RA, RB, C, S )
330 S = DCONJG( S )
331 *
332 * Multiply by [ c -s; conjg(s) c] on the right.
333 *
334 IF( N.GT.J+1 )
335 $ CALL ZROT( N-J-1, A( J+2, J+1 ), 1, A( J+2, J ), 1, C,
336 $ -S )
337 *
338 * Multiply by [-c s; -conjg(s) -c] on the left.
339 *
340 IF( J.GT.1 )
341 $ CALL ZROT( J-1, A( J, 1 ), LDA, A( J+1, 1 ), LDA, -C,
342 $ S )
343 *
344 * Negate A(J+1,J).
345 *
346 A( J+1, J ) = -A( J+1, J )
347 130 CONTINUE
348 END IF
349 *
350 * IMAT > 10: Pathological test cases. These triangular matrices
351 * are badly scaled or badly conditioned, so when used in solving a
352 * triangular system they may cause overflow in the solution vector.
353 *
354 ELSE IF( IMAT.EQ.11 ) THEN
355 *
356 * Type 11: Generate a triangular matrix with elements between
357 * -1 and 1. Give the diagonal norm 2 to make it well-conditioned.
358 * Make the right hand side large so that it requires scaling.
359 *
360 IF( UPPER ) THEN
361 DO 140 J = 1, N
362 CALL ZLARNV( 4, ISEED, J-1, A( 1, J ) )
363 A( J, J ) = ZLARND( 5, ISEED )*TWO
364 140 CONTINUE
365 ELSE
366 DO 150 J = 1, N
367 IF( J.LT.N )
368 $ CALL ZLARNV( 4, ISEED, N-J, A( J+1, J ) )
369 A( J, J ) = ZLARND( 5, ISEED )*TWO
370 150 CONTINUE
371 END IF
372 *
373 * Set the right hand side so that the largest value is BIGNUM.
374 *
375 CALL ZLARNV( 2, ISEED, N, B )
376 IY = IZAMAX( N, B, 1 )
377 BNORM = ABS( B( IY ) )
378 BSCAL = BIGNUM / MAX( ONE, BNORM )
379 CALL ZDSCAL( N, BSCAL, B, 1 )
380 *
381 ELSE IF( IMAT.EQ.12 ) THEN
382 *
383 * Type 12: Make the first diagonal element in the solve small to
384 * cause immediate overflow when dividing by T(j,j).
385 * In type 12, the offdiagonal elements are small (CNORM(j) < 1).
386 *
387 CALL ZLARNV( 2, ISEED, N, B )
388 TSCAL = ONE / MAX( ONE, DBLE( N-1 ) )
389 IF( UPPER ) THEN
390 DO 160 J = 1, N
391 CALL ZLARNV( 4, ISEED, J-1, A( 1, J ) )
392 CALL ZDSCAL( J-1, TSCAL, A( 1, J ), 1 )
393 A( J, J ) = ZLARND( 5, ISEED )
394 160 CONTINUE
395 A( N, N ) = SMLNUM*A( N, N )
396 ELSE
397 DO 170 J = 1, N
398 IF( J.LT.N ) THEN
399 CALL ZLARNV( 4, ISEED, N-J, A( J+1, J ) )
400 CALL ZDSCAL( N-J, TSCAL, A( J+1, J ), 1 )
401 END IF
402 A( J, J ) = ZLARND( 5, ISEED )
403 170 CONTINUE
404 A( 1, 1 ) = SMLNUM*A( 1, 1 )
405 END IF
406 *
407 ELSE IF( IMAT.EQ.13 ) THEN
408 *
409 * Type 13: Make the first diagonal element in the solve small to
410 * cause immediate overflow when dividing by T(j,j).
411 * In type 13, the offdiagonal elements are O(1) (CNORM(j) > 1).
412 *
413 CALL ZLARNV( 2, ISEED, N, B )
414 IF( UPPER ) THEN
415 DO 180 J = 1, N
416 CALL ZLARNV( 4, ISEED, J-1, A( 1, J ) )
417 A( J, J ) = ZLARND( 5, ISEED )
418 180 CONTINUE
419 A( N, N ) = SMLNUM*A( N, N )
420 ELSE
421 DO 190 J = 1, N
422 IF( J.LT.N )
423 $ CALL ZLARNV( 4, ISEED, N-J, A( J+1, J ) )
424 A( J, J ) = ZLARND( 5, ISEED )
425 190 CONTINUE
426 A( 1, 1 ) = SMLNUM*A( 1, 1 )
427 END IF
428 *
429 ELSE IF( IMAT.EQ.14 ) THEN
430 *
431 * Type 14: T is diagonal with small numbers on the diagonal to
432 * make the growth factor underflow, but a small right hand side
433 * chosen so that the solution does not overflow.
434 *
435 IF( UPPER ) THEN
436 JCOUNT = 1
437 DO 210 J = N, 1, -1
438 DO 200 I = 1, J - 1
439 A( I, J ) = ZERO
440 200 CONTINUE
441 IF( JCOUNT.LE.2 ) THEN
442 A( J, J ) = SMLNUM*ZLARND( 5, ISEED )
443 ELSE
444 A( J, J ) = ZLARND( 5, ISEED )
445 END IF
446 JCOUNT = JCOUNT + 1
447 IF( JCOUNT.GT.4 )
448 $ JCOUNT = 1
449 210 CONTINUE
450 ELSE
451 JCOUNT = 1
452 DO 230 J = 1, N
453 DO 220 I = J + 1, N
454 A( I, J ) = ZERO
455 220 CONTINUE
456 IF( JCOUNT.LE.2 ) THEN
457 A( J, J ) = SMLNUM*ZLARND( 5, ISEED )
458 ELSE
459 A( J, J ) = ZLARND( 5, ISEED )
460 END IF
461 JCOUNT = JCOUNT + 1
462 IF( JCOUNT.GT.4 )
463 $ JCOUNT = 1
464 230 CONTINUE
465 END IF
466 *
467 * Set the right hand side alternately zero and small.
468 *
469 IF( UPPER ) THEN
470 B( 1 ) = ZERO
471 DO 240 I = N, 2, -2
472 B( I ) = ZERO
473 B( I-1 ) = SMLNUM*ZLARND( 5, ISEED )
474 240 CONTINUE
475 ELSE
476 B( N ) = ZERO
477 DO 250 I = 1, N - 1, 2
478 B( I ) = ZERO
479 B( I+1 ) = SMLNUM*ZLARND( 5, ISEED )
480 250 CONTINUE
481 END IF
482 *
483 ELSE IF( IMAT.EQ.15 ) THEN
484 *
485 * Type 15: Make the diagonal elements small to cause gradual
486 * overflow when dividing by T(j,j). To control the amount of
487 * scaling needed, the matrix is bidiagonal.
488 *
489 TEXP = ONE / MAX( ONE, DBLE( N-1 ) )
490 TSCAL = SMLNUM**TEXP
491 CALL ZLARNV( 4, ISEED, N, B )
492 IF( UPPER ) THEN
493 DO 270 J = 1, N
494 DO 260 I = 1, J - 2
495 A( I, J ) = 0.D0
496 260 CONTINUE
497 IF( J.GT.1 )
498 $ A( J-1, J ) = DCMPLX( -ONE, -ONE )
499 A( J, J ) = TSCAL*ZLARND( 5, ISEED )
500 270 CONTINUE
501 B( N ) = DCMPLX( ONE, ONE )
502 ELSE
503 DO 290 J = 1, N
504 DO 280 I = J + 2, N
505 A( I, J ) = 0.D0
506 280 CONTINUE
507 IF( J.LT.N )
508 $ A( J+1, J ) = DCMPLX( -ONE, -ONE )
509 A( J, J ) = TSCAL*ZLARND( 5, ISEED )
510 290 CONTINUE
511 B( 1 ) = DCMPLX( ONE, ONE )
512 END IF
513 *
514 ELSE IF( IMAT.EQ.16 ) THEN
515 *
516 * Type 16: One zero diagonal element.
517 *
518 IY = N / 2 + 1
519 IF( UPPER ) THEN
520 DO 300 J = 1, N
521 CALL ZLARNV( 4, ISEED, J-1, A( 1, J ) )
522 IF( J.NE.IY ) THEN
523 A( J, J ) = ZLARND( 5, ISEED )*TWO
524 ELSE
525 A( J, J ) = ZERO
526 END IF
527 300 CONTINUE
528 ELSE
529 DO 310 J = 1, N
530 IF( J.LT.N )
531 $ CALL ZLARNV( 4, ISEED, N-J, A( J+1, J ) )
532 IF( J.NE.IY ) THEN
533 A( J, J ) = ZLARND( 5, ISEED )*TWO
534 ELSE
535 A( J, J ) = ZERO
536 END IF
537 310 CONTINUE
538 END IF
539 CALL ZLARNV( 2, ISEED, N, B )
540 CALL ZDSCAL( N, TWO, B, 1 )
541 *
542 ELSE IF( IMAT.EQ.17 ) THEN
543 *
544 * Type 17: Make the offdiagonal elements large to cause overflow
545 * when adding a column of T. In the non-transposed case, the
546 * matrix is constructed to cause overflow when adding a column in
547 * every other step.
548 *
549 TSCAL = UNFL / ULP
550 TSCAL = ( ONE-ULP ) / TSCAL
551 DO 330 J = 1, N
552 DO 320 I = 1, N
553 A( I, J ) = 0.D0
554 320 CONTINUE
555 330 CONTINUE
556 TEXP = ONE
557 IF( UPPER ) THEN
558 DO 340 J = N, 2, -2
559 A( 1, J ) = -TSCAL / DBLE( N+1 )
560 A( J, J ) = ONE
561 B( J ) = TEXP*( ONE-ULP )
562 A( 1, J-1 ) = -( TSCAL / DBLE( N+1 ) ) / DBLE( N+2 )
563 A( J-1, J-1 ) = ONE
564 B( J-1 ) = TEXP*DBLE( N*N+N-1 )
565 TEXP = TEXP*2.D0
566 340 CONTINUE
567 B( 1 ) = ( DBLE( N+1 ) / DBLE( N+2 ) )*TSCAL
568 ELSE
569 DO 350 J = 1, N - 1, 2
570 A( N, J ) = -TSCAL / DBLE( N+1 )
571 A( J, J ) = ONE
572 B( J ) = TEXP*( ONE-ULP )
573 A( N, J+1 ) = -( TSCAL / DBLE( N+1 ) ) / DBLE( N+2 )
574 A( J+1, J+1 ) = ONE
575 B( J+1 ) = TEXP*DBLE( N*N+N-1 )
576 TEXP = TEXP*2.D0
577 350 CONTINUE
578 B( N ) = ( DBLE( N+1 ) / DBLE( N+2 ) )*TSCAL
579 END IF
580 *
581 ELSE IF( IMAT.EQ.18 ) THEN
582 *
583 * Type 18: Generate a unit triangular matrix with elements
584 * between -1 and 1, and make the right hand side large so that it
585 * requires scaling.
586 *
587 IF( UPPER ) THEN
588 DO 360 J = 1, N
589 CALL ZLARNV( 4, ISEED, J-1, A( 1, J ) )
590 A( J, J ) = ZERO
591 360 CONTINUE
592 ELSE
593 DO 370 J = 1, N
594 IF( J.LT.N )
595 $ CALL ZLARNV( 4, ISEED, N-J, A( J+1, J ) )
596 A( J, J ) = ZERO
597 370 CONTINUE
598 END IF
599 *
600 * Set the right hand side so that the largest value is BIGNUM.
601 *
602 CALL ZLARNV( 2, ISEED, N, B )
603 IY = IZAMAX( N, B, 1 )
604 BNORM = ABS( B( IY ) )
605 BSCAL = BIGNUM / MAX( ONE, BNORM )
606 CALL ZDSCAL( N, BSCAL, B, 1 )
607 *
608 ELSE IF( IMAT.EQ.19 ) THEN
609 *
610 * Type 19: Generate a triangular matrix with elements between
611 * BIGNUM/(n-1) and BIGNUM so that at least one of the column
612 * norms will exceed BIGNUM.
613 * 1/3/91: ZLATRS no longer can handle this case
614 *
615 TLEFT = BIGNUM / MAX( ONE, DBLE( N-1 ) )
616 TSCAL = BIGNUM*( DBLE( N-1 ) / MAX( ONE, DBLE( N ) ) )
617 IF( UPPER ) THEN
618 DO 390 J = 1, N
619 CALL ZLARNV( 5, ISEED, J, A( 1, J ) )
620 CALL DLARNV( 1, ISEED, J, RWORK )
621 DO 380 I = 1, J
622 A( I, J ) = A( I, J )*( TLEFT+RWORK( I )*TSCAL )
623 380 CONTINUE
624 390 CONTINUE
625 ELSE
626 DO 410 J = 1, N
627 CALL ZLARNV( 5, ISEED, N-J+1, A( J, J ) )
628 CALL DLARNV( 1, ISEED, N-J+1, RWORK )
629 DO 400 I = J, N
630 A( I, J ) = A( I, J )*( TLEFT+RWORK( I-J+1 )*TSCAL )
631 400 CONTINUE
632 410 CONTINUE
633 END IF
634 CALL ZLARNV( 2, ISEED, N, B )
635 CALL ZDSCAL( N, TWO, B, 1 )
636 END IF
637 *
638 * Flip the matrix if the transpose will be used.
639 *
640 IF( .NOT.LSAME( TRANS, 'N' ) ) THEN
641 IF( UPPER ) THEN
642 DO 420 J = 1, N / 2
643 CALL ZSWAP( N-2*J+1, A( J, J ), LDA, A( J+1, N-J+1 ),
644 $ -1 )
645 420 CONTINUE
646 ELSE
647 DO 430 J = 1, N / 2
648 CALL ZSWAP( N-2*J+1, A( J, J ), 1, A( N-J+1, J+1 ),
649 $ -LDA )
650 430 CONTINUE
651 END IF
652 END IF
653 *
654 RETURN
655 *
656 * End of ZLATTR
657 *
658 END