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