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