OpenRadioss 2025.1.11
OpenRadioss project
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, dlabad, dlarnv, dlatb4, dlatms, dscal,
172 $ dswap
173* ..
174* .. Intrinsic Functions ..
175 INTRINSIC abs, dble, max, min, sign, sqrt
176* ..
177* .. Executable Statements ..
178*
179 path( 1: 1 ) = 'Double precision'
180 path( 2: 3 ) = 'TB'
181 unfl = dlamch( 'Safe minimum' )
182 ulp = dlamch( 'Epsilon' )*dlamch( 'Base' )
183 smlnum = unfl
184 bignum = ( one-ulp ) / smlnum
185 CALL dlabad( smlnum, bignum )
186 IF( ( imat.GE.6 .AND. imat.LE.9 ) .OR. imat.EQ.17 ) THEN
187 diag = 'U'
188 ELSE
189 diag = 'N'
190 END IF
191 info = 0
192*
193* Quick return if N.LE.0.
194*
195 IF( n.LE.0 )
196 $ RETURN
197*
198* Call DLATB4 to set parameters for SLATMS.
199*
200 upper = lsame( uplo, 'U' )
201 IF( upper ) THEN
202 CALL dlatb4( path, imat, n, n, TYPE, kl, ku, anorm, mode,
203 $ cndnum, dist )
204 ku = kd
205 ioff = 1 + max( 0, kd-n+1 )
206 kl = 0
207 packit = 'Q'
208 ELSE
209 CALL dlatb4( path, -imat, n, n, TYPE, kl, ku, ANORM, mode,
210 $ cndnum, dist )
211 kl = kd
212 ioff = 1
213 ku = 0
214 packit = 'B'
215 END IF
216*
217* IMAT <= 5: Non-unit triangular matrix
218*
219 IF( imat.LE.5 ) THEN
220 CALL dlatms( n, n, dist, iseed, TYPE, b, MODE, cndnum, anorm,
221 $ kl, ku, packit, ab( ioff, 1 ), ldab, work, info )
222*
223* IMAT > 5: Unit triangular matrix
224* The diagonal is deliberately set to something other than 1.
225*
226* IMAT = 6: Matrix is the identity
227*
228 ELSE IF( imat.EQ.6 ) THEN
229 IF( upper ) THEN
230 DO 20 j = 1, n
231 DO 10 i = max( 1, kd+2-j ), kd
232 ab( i, j ) = zero
233 10 CONTINUE
234 ab( kd+1, j ) = j
235 20 CONTINUE
236 ELSE
237 DO 40 j = 1, n
238 ab( 1, j ) = j
239 DO 30 i = 2, min( kd+1, n-j+1 )
240 ab( i, j ) = zero
241 30 CONTINUE
242 40 CONTINUE
243 END IF
244*
245* IMAT > 6: Non-trivial unit triangular matrix
246*
247* A unit triangular matrix T with condition CNDNUM is formed.
248* In this version, T only has bandwidth 2, the rest of it is zero.
249*
250 ELSE IF( imat.LE.9 ) THEN
251 tnorm = sqrt( cndnum )
252*
253* Initialize AB to zero.
254*
255 IF( upper ) THEN
256 DO 60 j = 1, n
257 DO 50 i = max( 1, kd+2-j ), kd
258 ab( i, j ) = zero
259 50 CONTINUE
260 ab( kd+1, j ) = dble( j )
261 60 CONTINUE
262 ELSE
263 DO 80 j = 1, n
264 DO 70 i = 2, min( kd+1, n-j+1 )
265 ab( i, j ) = zero
266 70 CONTINUE
267 ab( 1, j ) = dble( j )
268 80 CONTINUE
269 END IF
270*
271* Special case: T is tridiagonal. Set every other offdiagonal
272* so that the matrix has norm TNORM+1.
273*
274 IF( kd.EQ.1 ) THEN
275 IF( upper ) THEN
276 ab( 1, 2 ) = sign( tnorm, dlarnd( 2, iseed ) )
277 lenj = ( n-3 ) / 2
278 CALL dlarnv( 2, iseed, lenj, work )
279 DO 90 j = 1, lenj
280 ab( 1, 2*( j+1 ) ) = tnorm*work( j )
281 90 CONTINUE
282 ELSE
283 ab( 2, 1 ) = sign( tnorm, dlarnd( 2, iseed ) )
284 lenj = ( n-3 ) / 2
285 CALL dlarnv( 2, iseed, lenj, work )
286 DO 100 j = 1, lenj
287 ab( 2, 2*j+1 ) = tnorm*work( j )
288 100 CONTINUE
289 END IF
290 ELSE IF( kd.GT.1 ) THEN
291*
292* Form a unit triangular matrix T with condition CNDNUM. T is
293* given by
294* | 1 + * |
295* | 1 + |
296* T = | 1 + * |
297* | 1 + |
298* | 1 + * |
299* | 1 + |
300* | . . . |
301* Each element marked with a '*' is formed by taking the product
302* of the adjacent elements marked with '+'. The '*'s can be
303* chosen freely, and the '+'s are chosen so that the inverse of
304* T will have elements of the same magnitude as T.
305*
306* The two offdiagonals of T are stored in WORK.
307*
308 star1 = sign( tnorm, dlarnd( 2, iseed ) )
309 sfac = sqrt( tnorm )
310 plus1 = sign( sfac, dlarnd( 2, iseed ) )
311 DO 110 j = 1, n, 2
312 plus2 = star1 / plus1
313 work( j ) = plus1
314 work( n+j ) = star1
315 IF( j+1.LE.n ) THEN
316 work( j+1 ) = plus2
317 work( n+j+1 ) = zero
318 plus1 = star1 / plus2
319*
320* Generate a new *-value with norm between sqrt(TNORM)
321* and TNORM.
322*
323 rexp = dlarnd( 2, iseed )
324 IF( rexp.LT.zero ) THEN
325 star1 = -sfac**( one-rexp )
326 ELSE
327 star1 = sfac**( one+rexp )
328 END IF
329 END IF
330 110 CONTINUE
331*
332* Copy the tridiagonal T to AB.
333*
334 IF( upper ) THEN
335 CALL dcopy( n-1, work, 1, ab( kd, 2 ), ldab )
336 CALL dcopy( n-2, work( n+1 ), 1, ab( kd-1, 3 ), ldab )
337 ELSE
338 CALL dcopy( n-1, work, 1, ab( 2, 1 ), ldab )
339 CALL dcopy( n-2, work( n+1 ), 1, ab( 3, 1 ), ldab )
340 END IF
341 END IF
342*
343* IMAT > 9: Pathological test cases. These triangular matrices
344* are badly scaled or badly conditioned, so when used in solving a
345* triangular system they may cause overflow in the solution vector.
346*
347 ELSE IF( imat.EQ.10 ) THEN
348*
349* Type 10: Generate a triangular matrix with elements between
350* -1 and 1. Give the diagonal norm 2 to make it well-conditioned.
351* Make the right hand side large so that it requires scaling.
352*
353 IF( upper ) THEN
354 DO 120 j = 1, n
355 lenj = min( j, kd+1 )
356 CALL dlarnv( 2, iseed, lenj, ab( kd+2-lenj, j ) )
357 ab( kd+1, j ) = sign( two, ab( kd+1, j ) )
358 120 CONTINUE
359 ELSE
360 DO 130 j = 1, n
361 lenj = min( n-j+1, kd+1 )
362 IF( lenj.GT.0 )
363 $ CALL dlarnv( 2, iseed, lenj, ab( 1, j ) )
364 ab( 1, j ) = sign( two, ab( 1, j ) )
365 130 CONTINUE
366 END IF
367*
368* Set the right hand side so that the largest value is BIGNUM.
369*
370 CALL dlarnv( 2, iseed, n, b )
371 iy = idamax( n, b, 1 )
372 bnorm = abs( b( iy ) )
373 bscal = bignum / max( one, bnorm )
374 CALL dscal( n, bscal, b, 1 )
375*
376 ELSE IF( imat.EQ.11 ) THEN
377*
378* Type 11: Make the first diagonal element in the solve small to
379* cause immediate overflow when dividing by T(j,j).
380* In type 11, the offdiagonal elements are small (CNORM(j) < 1).
381*
382 CALL dlarnv( 2, iseed, n, b )
383 tscal = one / dble( kd+1 )
384 IF( upper ) THEN
385 DO 140 j = 1, n
386 lenj = min( j, kd+1 )
387 CALL dlarnv( 2, iseed, lenj, ab( kd+2-lenj, j ) )
388 CALL dscal( lenj-1, tscal, ab( kd+2-lenj, j ), 1 )
389 ab( kd+1, j ) = sign( one, ab( kd+1, j ) )
390 140 CONTINUE
391 ab( kd+1, n ) = smlnum*ab( kd+1, n )
392 ELSE
393 DO 150 j = 1, n
394 lenj = min( n-j+1, kd+1 )
395 CALL dlarnv( 2, iseed, lenj, ab( 1, j ) )
396 IF( lenj.GT.1 )
397 $ CALL dscal( lenj-1, tscal, ab( 2, j ), 1 )
398 ab( 1, j ) = sign( one, ab( 1, j ) )
399 150 CONTINUE
400 ab( 1, 1 ) = smlnum*ab( 1, 1 )
401 END IF
402*
403 ELSE IF( imat.EQ.12 ) THEN
404*
405* Type 12: Make the first diagonal element in the solve small to
406* cause immediate overflow when dividing by T(j,j).
407* In type 12, the offdiagonal elements are O(1) (CNORM(j) > 1).
408*
409 CALL dlarnv( 2, iseed, n, b )
410 IF( upper ) THEN
411 DO 160 j = 1, n
412 lenj = min( j, kd+1 )
413 CALL dlarnv( 2, iseed, lenj, ab( kd+2-lenj, j ) )
414 ab( kd+1, j ) = sign( one, ab( kd+1, j ) )
415 160 CONTINUE
416 ab( kd+1, n ) = smlnum*ab( kd+1, n )
417 ELSE
418 DO 170 j = 1, n
419 lenj = min( n-j+1, kd+1 )
420 CALL dlarnv( 2, iseed, lenj, ab( 1, j ) )
421 ab( 1, j ) = sign( one, ab( 1, j ) )
422 170 CONTINUE
423 ab( 1, 1 ) = smlnum*ab( 1, 1 )
424 END IF
425*
426 ELSE IF( imat.EQ.13 ) THEN
427*
428* Type 13: T is diagonal with small numbers on the diagonal to
429* make the growth factor underflow, but a small right hand side
430* chosen so that the solution does not overflow.
431*
432 IF( upper ) THEN
433 jcount = 1
434 DO 190 j = n, 1, -1
435 DO 180 i = max( 1, kd+1-( j-1 ) ), kd
436 ab( i, j ) = zero
437 180 CONTINUE
438 IF( jcount.LE.2 ) THEN
439 ab( kd+1, j ) = smlnum
440 ELSE
441 ab( kd+1, j ) = one
442 END IF
443 jcount = jcount + 1
444 IF( jcount.GT.4 )
445 $ jcount = 1
446 190 CONTINUE
447 ELSE
448 jcount = 1
449 DO 210 j = 1, n
450 DO 200 i = 2, min( n-j+1, kd+1 )
451 ab( i, j ) = zero
452 200 CONTINUE
453 IF( jcount.LE.2 ) THEN
454 ab( 1, j ) = smlnum
455 ELSE
456 ab( 1, j ) = one
457 END IF
458 jcount = jcount + 1
459 IF( jcount.GT.4 )
460 $ jcount = 1
461 210 CONTINUE
462 END IF
463*
464* Set the right hand side alternately zero and small.
465*
466 IF( upper ) THEN
467 b( 1 ) = zero
468 DO 220 i = n, 2, -2
469 b( i ) = zero
470 b( i-1 ) = smlnum
471 220 CONTINUE
472 ELSE
473 b( n ) = zero
474 DO 230 i = 1, n - 1, 2
475 b( i ) = zero
476 b( i+1 ) = smlnum
477 230 CONTINUE
478 END IF
479*
480 ELSE IF( imat.EQ.14 ) THEN
481*
482* Type 14: Make the diagonal elements small to cause gradual
483* overflow when dividing by T(j,j). To control the amount of
484* scaling needed, the matrix is bidiagonal.
485*
486 texp = one / dble( kd+1 )
487 tscal = smlnum**texp
488 CALL dlarnv( 2, iseed, n, b )
489 IF( upper ) THEN
490 DO 250 j = 1, n
491 DO 240 i = max( 1, kd+2-j ), kd
492 ab( i, j ) = zero
493 240 CONTINUE
494 IF( j.GT.1 .AND. kd.GT.0 )
495 $ ab( kd, j ) = -one
496 ab( kd+1, j ) = tscal
497 250 CONTINUE
498 b( n ) = one
499 ELSE
500 DO 270 j = 1, n
501 DO 260 i = 3, min( n-j+1, kd+1 )
502 ab( i, j ) = zero
503 260 CONTINUE
504 IF( j.LT.n .AND. kd.GT.0 )
505 $ ab( 2, j ) = -one
506 ab( 1, j ) = tscal
507 270 CONTINUE
508 b( 1 ) = one
509 END IF
510*
511 ELSE IF( imat.EQ.15 ) THEN
512*
513* Type 15: One zero diagonal element.
514*
515 iy = n / 2 + 1
516 IF( upper ) THEN
517 DO 280 j = 1, n
518 lenj = min( j, kd+1 )
519 CALL dlarnv( 2, iseed, lenj, ab( kd+2-lenj, j ) )
520 IF( j.NE.iy ) THEN
521 ab( kd+1, j ) = sign( two, ab( kd+1, j ) )
522 ELSE
523 ab( kd+1, j ) = zero
524 END IF
525 280 CONTINUE
526 ELSE
527 DO 290 j = 1, n
528 lenj = min( n-j+1, kd+1 )
529 CALL dlarnv( 2, iseed, lenj, ab( 1, j ) )
530 IF( j.NE.iy ) THEN
531 ab( 1, j ) = sign( two, ab( 1, j ) )
532 ELSE
533 ab( 1, j ) = zero
534 END IF
535 290 CONTINUE
536 END IF
537 CALL dlarnv( 2, iseed, n, b )
538 CALL dscal( n, two, b, 1 )
539*
540 ELSE IF( imat.EQ.16 ) THEN
541*
542* Type 16: Make the offdiagonal elements large to cause overflow
543* when adding a column of T. In the non-transposed case, the
544* matrix is constructed to cause overflow when adding a column in
545* every other step.
546*
547 tscal = unfl / ulp
548 tscal = ( one-ulp ) / tscal
549 DO 310 j = 1, n
550 DO 300 i = 1, kd + 1
551 ab( i, j ) = zero
552 300 CONTINUE
553 310 CONTINUE
554 texp = one
555 IF( kd.GT.0 ) THEN
556 IF( upper ) THEN
557 DO 330 j = n, 1, -kd
558 DO 320 i = j, max( 1, j-kd+1 ), -2
559 ab( 1+( j-i ), i ) = -tscal / dble( kd+2 )
560 ab( kd+1, i ) = one
561 b( i ) = texp*( one-ulp )
562 IF( i.GT.max( 1, j-kd+1 ) ) THEN
563 ab( 2+( j-i ), i-1 ) = -( tscal / dble( kd+2 ) )
564 $ / dble( kd+3 )
565 ab( kd+1, i-1 ) = one
566 b( i-1 ) = texp*dble( ( kd+1 )*( kd+1 )+kd )
567 END IF
568 texp = texp*two
569 320 CONTINUE
570 b( max( 1, j-kd+1 ) ) = ( dble( kd+2 ) /
571 $ dble( kd+3 ) )*tscal
572 330 CONTINUE
573 ELSE
574 DO 350 j = 1, n, kd
575 texp = one
576 lenj = min( kd+1, n-j+1 )
577 DO 340 i = j, min( n, j+kd-1 ), 2
578 ab( lenj-( i-j ), j ) = -tscal / dble( kd+2 )
579 ab( 1, j ) = one
580 b( j ) = texp*( one-ulp )
581 IF( i.LT.min( n, j+kd-1 ) ) THEN
582 ab( lenj-( i-j+1 ), i+1 ) = -( tscal /
583 $ dble( kd+2 ) ) / dble( kd+3 )
584 ab( 1, i+1 ) = one
585 b( i+1 ) = texp*dble( ( kd+1 )*( kd+1 )+kd )
586 END IF
587 texp = texp*two
588 340 CONTINUE
589 b( min( n, j+kd-1 ) ) = ( dble( kd+2 ) /
590 $ dble( kd+3 ) )*tscal
591 350 CONTINUE
592 END IF
593 ELSE
594 DO 360 j = 1, n
595 ab( 1, j ) = one
596 b( j ) = dble( j )
597 360 CONTINUE
598 END IF
599*
600 ELSE IF( imat.EQ.17 ) THEN
601*
602* Type 17: Generate a unit triangular matrix with elements
603* between -1 and 1, and make the right hand side large so that it
604* requires scaling.
605*
606 IF( upper ) THEN
607 DO 370 j = 1, n
608 lenj = min( j-1, kd )
609 CALL dlarnv( 2, iseed, lenj, ab( kd+1-lenj, j ) )
610 ab( kd+1, j ) = dble( j )
611 370 CONTINUE
612 ELSE
613 DO 380 j = 1, n
614 lenj = min( n-j, kd )
615 IF( lenj.GT.0 )
616 $ CALL dlarnv( 2, iseed, lenj, ab( 2, j ) )
617 ab( 1, j ) = dble( j )
618 380 CONTINUE
619 END IF
620*
621* Set the right hand side so that the largest value is BIGNUM.
622*
623 CALL dlarnv( 2, iseed, n, b )
624 iy = idamax( n, b, 1 )
625 bnorm = abs( b( iy ) )
626 bscal = bignum / max( one, bnorm )
627 CALL dscal( n, bscal, b, 1 )
628*
629 ELSE IF( imat.EQ.18 ) THEN
630*
631* Type 18: Generate a triangular matrix with elements between
632* BIGNUM/KD and BIGNUM so that at least one of the column
633* norms will exceed BIGNUM.
634*
635 tleft = bignum / max( one, dble( kd ) )
636 tscal = bignum*( dble( kd ) / dble( kd+1 ) )
637 IF( upper ) THEN
638 DO 400 j = 1, n
639 lenj = min( j, kd+1 )
640 CALL dlarnv( 2, iseed, lenj, ab( kd+2-lenj, j ) )
641 DO 390 i = kd + 2 - lenj, kd + 1
642 ab( i, j ) = sign( tleft, ab( i, j ) ) +
643 $ tscal*ab( i, j )
644 390 CONTINUE
645 400 CONTINUE
646 ELSE
647 DO 420 j = 1, n
648 lenj = min( n-j+1, kd+1 )
649 CALL dlarnv( 2, iseed, lenj, ab( 1, j ) )
650 DO 410 i = 1, lenj
651 ab( i, j ) = sign( tleft, ab( i, j ) ) +
652 $ tscal*ab( i, j )
653 410 CONTINUE
654 420 CONTINUE
655 END IF
656 CALL dlarnv( 2, iseed, n, b )
657 CALL dscal( n, two, b, 1 )
658 END IF
659*
660* Flip the matrix if the transpose will be used.
661*
662 IF( .NOT.lsame( trans, 'N' ) ) THEN
663 IF( upper ) THEN
664 DO 430 j = 1, n / 2
665 lenj = min( n-2*j+1, kd+1 )
666 CALL dswap( lenj, ab( kd+1, j ), ldab-1,
667 $ ab( kd+2-lenj, n-j+1 ), -1 )
668 430 CONTINUE
669 ELSE
670 DO 440 j = 1, n / 2
671 lenj = min( n-2*j+1, kd+1 )
672 CALL dswap( lenj, ab( 1, j ), 1, ab( lenj, n-j+2-lenj ),
673 $ -ldab+1 )
674 440 CONTINUE
675 END IF
676 END IF
677*
678 RETURN
679*
680* End of DLATTB
681*
682 END
dlabad
subroutine dlabad(small, large)
DLABAD
Definition dlabad.f:74
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
dcopy
subroutine dcopy(n, dx, incx, dy, incy)
DCOPY
Definition dcopy.f:82
dlatb4
subroutine dlatb4(path, imat, m, n, type, kl, ku, anorm, mode, cndnum, dist)
DLATB4
Definition dlatb4.f:120
dlattb
subroutine dlattb(imat, uplo, trans, diag, iseed, n, kd, ab, ldab, b, work, info)
DLATTB
Definition dlattb.f:135
dlatms
subroutine dlatms(m, n, dist, iseed, sym, d, mode, cond, dmax, kl, ku, pack, a, lda, work, info)
DLATMS
Definition dlatms.f:321
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21