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