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