LAPACK  3.10.0
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 *> \ingroup complex_lin
137 *
138 * =====================================================================
139  SUBROUTINE clattb( 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  REAL RWORK( * )
153  COMPLEX AB( LDAB, * ), B( * ), WORK( * )
154 * ..
155 *
156 * =====================================================================
157 *
158 * .. Parameters ..
159  REAL ONE, TWO, ZERO
160  parameter( one = 1.0e+0, two = 2.0e+0, zero = 0.0e+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  REAL ANORM, BIGNUM, BNORM, BSCAL, CNDNUM, REXP,
168  $ sfac, smlnum, texp, tleft, tnorm, tscal, ulp,
169  $ unfl
170  COMPLEX PLUS1, PLUS2, STAR1
171 * ..
172 * .. External Functions ..
173  LOGICAL LSAME
174  INTEGER ICAMAX
175  REAL SLAMCH, SLARND
176  COMPLEX CLARND
177  EXTERNAL lsame, icamax, slamch, slarnd, clarnd
178 * ..
179 * .. External Subroutines ..
180  EXTERNAL ccopy, clarnv, clatb4, clatms, csscal, cswap,
181  $ slabad, slarnv
182 * ..
183 * .. Intrinsic Functions ..
184  INTRINSIC abs, cmplx, max, min, real, sqrt
185 * ..
186 * .. Executable Statements ..
187 *
188  path( 1: 1 ) = 'Complex precision'
189  path( 2: 3 ) = 'TB'
190  unfl = slamch( 'Safe minimum' )
191  ulp = slamch( 'Epsilon' )*slamch( 'Base' )
192  smlnum = unfl
193  bignum = ( one-ulp ) / smlnum
194  CALL slabad( 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 CLATB4 to set parameters for CLATMS.
208 *
209  upper = lsame( uplo, 'U' )
210  IF( upper ) THEN
211  CALL clatb4( 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 clatb4( 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 clatms( 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 ) = real( 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 ) = real( 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*clarnd( 5, iseed )
287  lenj = ( n-3 ) / 2
288  CALL clarnv( 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*clarnd( 5, iseed )
294  lenj = ( n-3 ) / 2
295  CALL clarnv( 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*clarnd( 5, iseed )
319  sfac = sqrt( tnorm )
320  plus1 = sfac*clarnd( 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 = slarnd( 2, iseed )
334  IF( rexp.LT.zero ) THEN
335  star1 = -sfac**( one-rexp )*clarnd( 5, iseed )
336  ELSE
337  star1 = sfac**( one+rexp )*clarnd( 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 ccopy( n-1, work, 1, ab( kd, 2 ), ldab )
346  CALL ccopy( n-2, work( n+1 ), 1, ab( kd-1, 3 ), ldab )
347  ELSE
348  CALL ccopy( n-1, work, 1, ab( 2, 1 ), ldab )
349  CALL ccopy( 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 clarnv( 4, iseed, lenj, ab( kd+1-lenj, j ) )
367  ab( kd+1, j ) = clarnd( 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 clarnv( 4, iseed, lenj, ab( 2, j ) )
374  ab( 1, j ) = clarnd( 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 clarnv( 2, iseed, n, b )
381  iy = icamax( n, b, 1 )
382  bnorm = abs( b( iy ) )
383  bscal = bignum / max( one, bnorm )
384  CALL csscal( 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 clarnv( 2, iseed, n, b )
393  tscal = one / real( 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 clarnv( 4, iseed, lenj, ab( kd+2-lenj, j ) )
399  CALL csscal( lenj, tscal, ab( kd+2-lenj, j ), 1 )
400  END IF
401  ab( kd+1, j ) = clarnd( 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 clarnv( 4, iseed, lenj, ab( 2, j ) )
409  CALL csscal( lenj, tscal, ab( 2, j ), 1 )
410  END IF
411  ab( 1, j ) = clarnd( 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 clarnv( 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 clarnv( 4, iseed, lenj, ab( kd+2-lenj, j ) )
428  ab( kd+1, j ) = clarnd( 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 clarnv( 4, iseed, lenj, ab( 2, j ) )
436  ab( 1, j ) = clarnd( 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*clarnd( 5, iseed )
455  ELSE
456  ab( kd+1, j ) = clarnd( 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*clarnd( 5, iseed )
470  ELSE
471  ab( 1, j ) = clarnd( 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*clarnd( 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*clarnd( 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 / real( kd+1 )
502  tscal = smlnum**texp
503  CALL clarnv( 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 ) = cmplx( -one, -one )
511  ab( kd+1, j ) = tscal*clarnd( 5, iseed )
512  250 CONTINUE
513  b( n ) = cmplx( 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 ) = cmplx( -one, -one )
521  ab( 1, j ) = tscal*clarnd( 5, iseed )
522  270 CONTINUE
523  b( 1 ) = cmplx( 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 clarnv( 4, iseed, lenj, ab( kd+2-lenj, j ) )
535  IF( j.NE.iy ) THEN
536  ab( kd+1, j ) = clarnd( 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 clarnv( 4, iseed, lenj, ab( 1, j ) )
545  IF( j.NE.iy ) THEN
546  ab( 1, j ) = clarnd( 5, iseed )*two
547  ELSE
548  ab( 1, j ) = zero
549  END IF
550  290 CONTINUE
551  END IF
552  CALL clarnv( 2, iseed, n, b )
553  CALL csscal( 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 / real( 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 / real( kd+2 ) )
579  $ / real( kd+3 )
580  ab( kd+1, i-1 ) = one
581  b( i-1 ) = texp*real( ( kd+1 )*( kd+1 )+kd )
582  END IF
583  texp = texp*two
584  320 CONTINUE
585  b( max( 1, j-kd+1 ) ) = ( real( kd+2 ) /
586  $ real( 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 / real( 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  $ real( kd+2 ) ) / real( kd+3 )
599  ab( 1, i+1 ) = one
600  b( i+1 ) = texp*real( ( kd+1 )*( kd+1 )+kd )
601  END IF
602  texp = texp*two
603  340 CONTINUE
604  b( min( n, j+kd-1 ) ) = ( real( kd+2 ) /
605  $ real( 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 clarnv( 4, iseed, lenj, ab( kd+1-lenj, j ) )
620  ab( kd+1, j ) = real( 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 clarnv( 4, iseed, lenj, ab( 2, j ) )
627  ab( 1, j ) = real( j )
628  370 CONTINUE
629  END IF
630 *
631 * Set the right hand side so that the largest value is BIGNUM.
632 *
633  CALL clarnv( 2, iseed, n, b )
634  iy = icamax( n, b, 1 )
635  bnorm = abs( b( iy ) )
636  bscal = bignum / max( one, bnorm )
637  CALL csscal( 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: CLATBS no longer can handle this case
645 *
646  tleft = bignum / real( kd+1 )
647  tscal = bignum*( real( kd+1 ) / real( kd+2 ) )
648  IF( upper ) THEN
649  DO 390 j = 1, n
650  lenj = min( j, kd+1 )
651  CALL clarnv( 5, iseed, lenj, ab( kd+2-lenj, j ) )
652  CALL slarnv( 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 clarnv( 5, iseed, lenj, ab( 1, j ) )
661  CALL slarnv( 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 clarnv( 2, iseed, n, b )
668  CALL csscal( 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 cswap( 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 cswap( 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 CLATTB
692 *
693  END
subroutine slabad(SMALL, LARGE)
SLABAD
Definition: slabad.f:74
subroutine slarnv(IDIST, ISEED, N, X)
SLARNV returns a vector of random numbers from a uniform or normal distribution.
Definition: slarnv.f:97
subroutine ccopy(N, CX, INCX, CY, INCY)
CCOPY
Definition: ccopy.f:81
subroutine csscal(N, SA, CX, INCX)
CSSCAL
Definition: csscal.f:78
subroutine cswap(N, CX, INCX, CY, INCY)
CSWAP
Definition: cswap.f:81
subroutine clatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
CLATB4
Definition: clatb4.f:121
subroutine clattb(IMAT, UPLO, TRANS, DIAG, ISEED, N, KD, AB, LDAB, B, WORK, RWORK, INFO)
CLATTB
Definition: clattb.f:141
subroutine clatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
CLATMS
Definition: clatms.f:332
subroutine clarnv(IDIST, ISEED, N, X)
CLARNV returns a vector of random numbers from a uniform or normal distribution.
Definition: clarnv.f:99