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