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