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