LAPACK  3.4.2
LAPACK: Linear Algebra PACKage
 All Files Functions Groups
slattb.f
Go to the documentation of this file.
1 *> \brief \b SLATTB
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 SLATTB( IMAT, UPLO, TRANS, DIAG, ISEED, N, KD, AB,
12 * LDAB, B, WORK, 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 AB( LDAB, * ), B( * ), WORK( * )
21 * ..
22 *
23 *
24 *> \par Purpose:
25 * =============
26 *>
27 *> \verbatim
28 *>
29 *> SLATTB generates a triangular test matrix in 2-dimensional storage.
30 *> IMAT and UPLO uniquely specify the properties of the test matrix,
31 *> which is returned in the array A.
32 *> \endverbatim
33 *
34 * Arguments:
35 * ==========
36 *
37 *> \param[in] IMAT
38 *> \verbatim
39 *> IMAT is INTEGER
40 *> An integer key describing which matrix to generate for this
41 *> path.
42 *> \endverbatim
43 *>
44 *> \param[in] UPLO
45 *> \verbatim
46 *> UPLO is CHARACTER*1
47 *> Specifies whether the matrix A will be upper or lower
48 *> triangular.
49 *> = 'U': Upper triangular
50 *> = 'L': Lower triangular
51 *> \endverbatim
52 *>
53 *> \param[in] TRANS
54 *> \verbatim
55 *> TRANS is CHARACTER*1
56 *> Specifies whether the matrix or its transpose will be used.
57 *> = 'N': No transpose
58 *> = 'T': Transpose
59 *> = 'C': Conjugate transpose (= transpose)
60 *> \endverbatim
61 *>
62 *> \param[out] DIAG
63 *> \verbatim
64 *> DIAG is CHARACTER*1
65 *> Specifies whether or not the matrix A is unit triangular.
66 *> = 'N': Non-unit triangular
67 *> = 'U': Unit triangular
68 *> \endverbatim
69 *>
70 *> \param[in,out] ISEED
71 *> \verbatim
72 *> ISEED is INTEGER array, dimension (4)
73 *> The seed vector for the random number generator (used in
74 *> SLATMS). Modified on exit.
75 *> \endverbatim
76 *>
77 *> \param[in] N
78 *> \verbatim
79 *> N is INTEGER
80 *> The order of the matrix to be generated.
81 *> \endverbatim
82 *>
83 *> \param[in] KD
84 *> \verbatim
85 *> KD is INTEGER
86 *> The number of superdiagonals or subdiagonals of the banded
87 *> triangular matrix A. KD >= 0.
88 *> \endverbatim
89 *>
90 *> \param[out] AB
91 *> \verbatim
92 *> AB is REAL array, dimension (LDAB,N)
93 *> The upper or lower triangular banded matrix A, stored in the
94 *> first KD+1 rows of AB. Let j be a column of A, 1<=j<=n.
95 *> If UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j.
96 *> If UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd).
97 *> \endverbatim
98 *>
99 *> \param[in] LDAB
100 *> \verbatim
101 *> LDAB is INTEGER
102 *> The leading dimension of the array AB. LDAB >= KD+1.
103 *> \endverbatim
104 *>
105 *> \param[out] B
106 *> \verbatim
107 *> B is REAL array, dimension (N)
108 *> \endverbatim
109 *>
110 *> \param[out] WORK
111 *> \verbatim
112 *> WORK is REAL array, dimension (2*N)
113 *> \endverbatim
114 *>
115 *> \param[out] INFO
116 *> \verbatim
117 *> INFO is INTEGER
118 *> = 0: successful exit
119 *> < 0: if INFO = -k, the k-th argument had an illegal value
120 *> \endverbatim
121 *
122 * Authors:
123 * ========
124 *
125 *> \author Univ. of Tennessee
126 *> \author Univ. of California Berkeley
127 *> \author Univ. of Colorado Denver
128 *> \author NAG Ltd.
129 *
130 *> \date November 2011
131 *
132 *> \ingroup single_lin
133 *
134 * =====================================================================
135  SUBROUTINE slattb( IMAT, UPLO, TRANS, DIAG, ISEED, N, KD, AB,
136  $ ldab, b, work, info )
137 *
138 * -- LAPACK test routine (version 3.4.0) --
139 * -- LAPACK is a software package provided by Univ. of Tennessee, --
140 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
141 * November 2011
142 *
143 * .. Scalar Arguments ..
144  CHARACTER diag, trans, uplo
145  INTEGER imat, info, kd, ldab, n
146 * ..
147 * .. Array Arguments ..
148  INTEGER iseed( 4 )
149  REAL ab( ldab, * ), b( * ), work( * )
150 * ..
151 *
152 * =====================================================================
153 *
154 * .. Parameters ..
155  REAL one, two, zero
156  parameter( one = 1.0e+0, two = 2.0e+0, zero = 0.0e+0 )
157 * ..
158 * .. Local Scalars ..
159  LOGICAL upper
160  CHARACTER dist, packit, type
161  CHARACTER*3 path
162  INTEGER i, ioff, iy, j, jcount, kl, ku, lenj, mode
163  REAL anorm, bignum, bnorm, bscal, cndnum, plus1,
164  $ plus2, rexp, sfac, smlnum, star1, texp, tleft,
165  $ tnorm, tscal, ulp, unfl
166 * ..
167 * .. External Functions ..
168  LOGICAL lsame
169  INTEGER isamax
170  REAL slamch, slarnd
171  EXTERNAL lsame, isamax, slamch, slarnd
172 * ..
173 * .. External Subroutines ..
174  EXTERNAL scopy, slabad, slarnv, slatb4, slatms, sscal,
175  $ sswap
176 * ..
177 * .. Intrinsic Functions ..
178  INTRINSIC abs, max, min, REAL, sign, sqrt
179 * ..
180 * .. Executable Statements ..
181 *
182  path( 1: 1 ) = 'Single precision'
183  path( 2: 3 ) = 'TB'
184  unfl = slamch( 'Safe minimum' )
185  ulp = slamch( 'Epsilon' )*slamch( 'Base' )
186  smlnum = unfl
187  bignum = ( one-ulp ) / smlnum
188  CALL slabad( smlnum, bignum )
189  IF( ( imat.GE.6 .AND. imat.LE.9 ) .OR. imat.EQ.17 ) THEN
190  diag = 'U'
191  ELSE
192  diag = 'N'
193  END IF
194  info = 0
195 *
196 * Quick return if N.LE.0.
197 *
198  IF( n.LE.0 )
199  $ return
200 *
201 * Call SLATB4 to set parameters for SLATMS.
202 *
203  upper = lsame( uplo, 'U' )
204  IF( upper ) THEN
205  CALL slatb4( path, imat, n, n, type, kl, ku, anorm, mode,
206  $ cndnum, dist )
207  ku = kd
208  ioff = 1 + max( 0, kd-n+1 )
209  kl = 0
210  packit = 'Q'
211  ELSE
212  CALL slatb4( path, -imat, n, n, type, kl, ku, anorm, mode,
213  $ cndnum, dist )
214  kl = kd
215  ioff = 1
216  ku = 0
217  packit = 'B'
218  END IF
219 *
220 * IMAT <= 5: Non-unit triangular matrix
221 *
222  IF( imat.LE.5 ) THEN
223  CALL slatms( n, n, dist, iseed, type, b, mode, cndnum, anorm,
224  $ kl, ku, packit, ab( ioff, 1 ), ldab, work, info )
225 *
226 * IMAT > 5: Unit triangular matrix
227 * The diagonal is deliberately set to something other than 1.
228 *
229 * IMAT = 6: Matrix is the identity
230 *
231  ELSE IF( imat.EQ.6 ) THEN
232  IF( upper ) THEN
233  DO 20 j = 1, n
234  DO 10 i = max( 1, kd+2-j ), kd
235  ab( i, j ) = zero
236  10 continue
237  ab( kd+1, j ) = j
238  20 continue
239  ELSE
240  DO 40 j = 1, n
241  ab( 1, j ) = j
242  DO 30 i = 2, min( kd+1, n-j+1 )
243  ab( i, j ) = zero
244  30 continue
245  40 continue
246  END IF
247 *
248 * IMAT > 6: Non-trivial unit triangular matrix
249 *
250 * A unit triangular matrix T with condition CNDNUM is formed.
251 * In this version, T only has bandwidth 2, the rest of it is zero.
252 *
253  ELSE IF( imat.LE.9 ) THEN
254  tnorm = sqrt( cndnum )
255 *
256 * Initialize AB to zero.
257 *
258  IF( upper ) THEN
259  DO 60 j = 1, n
260  DO 50 i = max( 1, kd+2-j ), kd
261  ab( i, j ) = zero
262  50 continue
263  ab( kd+1, j ) = REAL( j )
264  60 continue
265  ELSE
266  DO 80 j = 1, n
267  DO 70 i = 2, min( kd+1, n-j+1 )
268  ab( i, j ) = zero
269  70 continue
270  ab( 1, j ) = REAL( j )
271  80 continue
272  END IF
273 *
274 * Special case: T is tridiagonal. Set every other offdiagonal
275 * so that the matrix has norm TNORM+1.
276 *
277  IF( kd.EQ.1 ) THEN
278  IF( upper ) THEN
279  ab( 1, 2 ) = sign( tnorm, slarnd( 2, iseed ) )
280  lenj = ( n-3 ) / 2
281  CALL slarnv( 2, iseed, lenj, work )
282  DO 90 j = 1, lenj
283  ab( 1, 2*( j+1 ) ) = tnorm*work( j )
284  90 continue
285  ELSE
286  ab( 2, 1 ) = sign( tnorm, slarnd( 2, iseed ) )
287  lenj = ( n-3 ) / 2
288  CALL slarnv( 2, iseed, lenj, work )
289  DO 100 j = 1, lenj
290  ab( 2, 2*j+1 ) = tnorm*work( j )
291  100 continue
292  END IF
293  ELSE IF( kd.GT.1 ) THEN
294 *
295 * Form a unit triangular matrix T with condition CNDNUM. T is
296 * given by
297 * | 1 + * |
298 * | 1 + |
299 * T = | 1 + * |
300 * | 1 + |
301 * | 1 + * |
302 * | 1 + |
303 * | . . . |
304 * Each element marked with a '*' is formed by taking the product
305 * of the adjacent elements marked with '+'. The '*'s can be
306 * chosen freely, and the '+'s are chosen so that the inverse of
307 * T will have elements of the same magnitude as T.
308 *
309 * The two offdiagonals of T are stored in WORK.
310 *
311  star1 = sign( tnorm, slarnd( 2, iseed ) )
312  sfac = sqrt( tnorm )
313  plus1 = sign( sfac, slarnd( 2, iseed ) )
314  DO 110 j = 1, n, 2
315  plus2 = star1 / plus1
316  work( j ) = plus1
317  work( n+j ) = star1
318  IF( j+1.LE.n ) THEN
319  work( j+1 ) = plus2
320  work( n+j+1 ) = zero
321  plus1 = star1 / plus2
322 *
323 * Generate a new *-value with norm between sqrt(TNORM)
324 * and TNORM.
325 *
326  rexp = slarnd( 2, iseed )
327  IF( rexp.LT.zero ) THEN
328  star1 = -sfac**( one-rexp )
329  ELSE
330  star1 = sfac**( one+rexp )
331  END IF
332  END IF
333  110 continue
334 *
335 * Copy the tridiagonal T to AB.
336 *
337  IF( upper ) THEN
338  CALL scopy( n-1, work, 1, ab( kd, 2 ), ldab )
339  CALL scopy( n-2, work( n+1 ), 1, ab( kd-1, 3 ), ldab )
340  ELSE
341  CALL scopy( n-1, work, 1, ab( 2, 1 ), ldab )
342  CALL scopy( n-2, work( n+1 ), 1, ab( 3, 1 ), ldab )
343  END IF
344  END IF
345 *
346 * IMAT > 9: Pathological test cases. These triangular matrices
347 * are badly scaled or badly conditioned, so when used in solving a
348 * triangular system they may cause overflow in the solution vector.
349 *
350  ELSE IF( imat.EQ.10 ) THEN
351 *
352 * Type 10: Generate a triangular matrix with elements between
353 * -1 and 1. Give the diagonal norm 2 to make it well-conditioned.
354 * Make the right hand side large so that it requires scaling.
355 *
356  IF( upper ) THEN
357  DO 120 j = 1, n
358  lenj = min( j, kd+1 )
359  CALL slarnv( 2, iseed, lenj, ab( kd+2-lenj, j ) )
360  ab( kd+1, j ) = sign( two, ab( kd+1, j ) )
361  120 continue
362  ELSE
363  DO 130 j = 1, n
364  lenj = min( n-j+1, kd+1 )
365  IF( lenj.GT.0 )
366  $ CALL slarnv( 2, iseed, lenj, ab( 1, j ) )
367  ab( 1, j ) = sign( two, ab( 1, j ) )
368  130 continue
369  END IF
370 *
371 * Set the right hand side so that the largest value is BIGNUM.
372 *
373  CALL slarnv( 2, iseed, n, b )
374  iy = isamax( n, b, 1 )
375  bnorm = abs( b( iy ) )
376  bscal = bignum / max( one, bnorm )
377  CALL sscal( n, bscal, b, 1 )
378 *
379  ELSE IF( imat.EQ.11 ) THEN
380 *
381 * Type 11: Make the first diagonal element in the solve small to
382 * cause immediate overflow when dividing by T(j,j).
383 * In type 11, the offdiagonal elements are small (CNORM(j) < 1).
384 *
385  CALL slarnv( 2, iseed, n, b )
386  tscal = one / REAL( kd+1 )
387  IF( upper ) THEN
388  DO 140 j = 1, n
389  lenj = min( j, kd+1 )
390  CALL slarnv( 2, iseed, lenj, ab( kd+2-lenj, j ) )
391  CALL sscal( lenj-1, tscal, ab( kd+2-lenj, j ), 1 )
392  ab( kd+1, j ) = sign( one, ab( kd+1, j ) )
393  140 continue
394  ab( kd+1, n ) = smlnum*ab( kd+1, n )
395  ELSE
396  DO 150 j = 1, n
397  lenj = min( n-j+1, kd+1 )
398  CALL slarnv( 2, iseed, lenj, ab( 1, j ) )
399  IF( lenj.GT.1 )
400  $ CALL sscal( lenj-1, tscal, ab( 2, j ), 1 )
401  ab( 1, j ) = sign( one, ab( 1, j ) )
402  150 continue
403  ab( 1, 1 ) = smlnum*ab( 1, 1 )
404  END IF
405 *
406  ELSE IF( imat.EQ.12 ) THEN
407 *
408 * Type 12: Make the first diagonal element in the solve small to
409 * cause immediate overflow when dividing by T(j,j).
410 * In type 12, the offdiagonal elements are O(1) (CNORM(j) > 1).
411 *
412  CALL slarnv( 2, iseed, n, b )
413  IF( upper ) THEN
414  DO 160 j = 1, n
415  lenj = min( j, kd+1 )
416  CALL slarnv( 2, iseed, lenj, ab( kd+2-lenj, j ) )
417  ab( kd+1, j ) = sign( one, ab( kd+1, j ) )
418  160 continue
419  ab( kd+1, n ) = smlnum*ab( kd+1, n )
420  ELSE
421  DO 170 j = 1, n
422  lenj = min( n-j+1, kd+1 )
423  CALL slarnv( 2, iseed, lenj, ab( 1, j ) )
424  ab( 1, j ) = sign( one, ab( 1, j ) )
425  170 continue
426  ab( 1, 1 ) = smlnum*ab( 1, 1 )
427  END IF
428 *
429  ELSE IF( imat.EQ.13 ) THEN
430 *
431 * Type 13: T is diagonal with small numbers on the diagonal to
432 * make the growth factor underflow, but a small right hand side
433 * chosen so that the solution does not overflow.
434 *
435  IF( upper ) THEN
436  jcount = 1
437  DO 190 j = n, 1, -1
438  DO 180 i = max( 1, kd+1-( j-1 ) ), kd
439  ab( i, j ) = zero
440  180 continue
441  IF( jcount.LE.2 ) THEN
442  ab( kd+1, j ) = smlnum
443  ELSE
444  ab( kd+1, j ) = one
445  END IF
446  jcount = jcount + 1
447  IF( jcount.GT.4 )
448  $ jcount = 1
449  190 continue
450  ELSE
451  jcount = 1
452  DO 210 j = 1, n
453  DO 200 i = 2, min( n-j+1, kd+1 )
454  ab( i, j ) = zero
455  200 continue
456  IF( jcount.LE.2 ) THEN
457  ab( 1, j ) = smlnum
458  ELSE
459  ab( 1, j ) = one
460  END IF
461  jcount = jcount + 1
462  IF( jcount.GT.4 )
463  $ jcount = 1
464  210 continue
465  END IF
466 *
467 * Set the right hand side alternately zero and small.
468 *
469  IF( upper ) THEN
470  b( 1 ) = zero
471  DO 220 i = n, 2, -2
472  b( i ) = zero
473  b( i-1 ) = smlnum
474  220 continue
475  ELSE
476  b( n ) = zero
477  DO 230 i = 1, n - 1, 2
478  b( i ) = zero
479  b( i+1 ) = smlnum
480  230 continue
481  END IF
482 *
483  ELSE IF( imat.EQ.14 ) THEN
484 *
485 * Type 14: Make the diagonal elements small to cause gradual
486 * overflow when dividing by T(j,j). To control the amount of
487 * scaling needed, the matrix is bidiagonal.
488 *
489  texp = one / REAL( kd+1 )
490  tscal = smlnum**texp
491  CALL slarnv( 2, iseed, n, b )
492  IF( upper ) THEN
493  DO 250 j = 1, n
494  DO 240 i = max( 1, kd+2-j ), kd
495  ab( i, j ) = zero
496  240 continue
497  IF( j.GT.1 .AND. kd.GT.0 )
498  $ ab( kd, j ) = -one
499  ab( kd+1, j ) = tscal
500  250 continue
501  b( n ) = one
502  ELSE
503  DO 270 j = 1, n
504  DO 260 i = 3, min( n-j+1, kd+1 )
505  ab( i, j ) = zero
506  260 continue
507  IF( j.LT.n .AND. kd.GT.0 )
508  $ ab( 2, j ) = -one
509  ab( 1, j ) = tscal
510  270 continue
511  b( 1 ) = one
512  END IF
513 *
514  ELSE IF( imat.EQ.15 ) THEN
515 *
516 * Type 15: One zero diagonal element.
517 *
518  iy = n / 2 + 1
519  IF( upper ) THEN
520  DO 280 j = 1, n
521  lenj = min( j, kd+1 )
522  CALL slarnv( 2, iseed, lenj, ab( kd+2-lenj, j ) )
523  IF( j.NE.iy ) THEN
524  ab( kd+1, j ) = sign( two, ab( kd+1, j ) )
525  ELSE
526  ab( kd+1, j ) = zero
527  END IF
528  280 continue
529  ELSE
530  DO 290 j = 1, n
531  lenj = min( n-j+1, kd+1 )
532  CALL slarnv( 2, iseed, lenj, ab( 1, j ) )
533  IF( j.NE.iy ) THEN
534  ab( 1, j ) = sign( two, ab( 1, j ) )
535  ELSE
536  ab( 1, j ) = zero
537  END IF
538  290 continue
539  END IF
540  CALL slarnv( 2, iseed, n, b )
541  CALL sscal( n, two, b, 1 )
542 *
543  ELSE IF( imat.EQ.16 ) THEN
544 *
545 * Type 16: Make the offdiagonal elements large to cause overflow
546 * when adding a column of T. In the non-transposed case, the
547 * matrix is constructed to cause overflow when adding a column in
548 * every other step.
549 *
550  tscal = unfl / ulp
551  tscal = ( one-ulp ) / tscal
552  DO 310 j = 1, n
553  DO 300 i = 1, kd + 1
554  ab( i, j ) = zero
555  300 continue
556  310 continue
557  texp = one
558  IF( kd.GT.0 ) THEN
559  IF( upper ) THEN
560  DO 330 j = n, 1, -kd
561  DO 320 i = j, max( 1, j-kd+1 ), -2
562  ab( 1+( j-i ), i ) = -tscal / REAL( kd+2 )
563  ab( kd+1, i ) = one
564  b( i ) = texp*( one-ulp )
565  IF( i.GT.max( 1, j-kd+1 ) ) THEN
566  ab( 2+( j-i ), i-1 ) = -( tscal / REAL( KD+2 ) )
567  $ / REAL( kd+3 )
568  ab( kd+1, i-1 ) = one
569  b( i-1 ) = texp*REAL( ( kd+1 )*( kd+1 )+kd )
570  END IF
571  texp = texp*two
572  320 continue
573  b( max( 1, j-kd+1 ) ) = ( REAL( KD+2 ) /
574  $ REAL( KD+3 ) )*tscal
575  330 continue
576  ELSE
577  DO 350 j = 1, n, kd
578  texp = one
579  lenj = min( kd+1, n-j+1 )
580  DO 340 i = j, min( n, j+kd-1 ), 2
581  ab( lenj-( i-j ), j ) = -tscal / REAL( kd+2 )
582  ab( 1, j ) = one
583  b( j ) = texp*( one-ulp )
584  IF( i.LT.min( n, j+kd-1 ) ) THEN
585  ab( lenj-( i-j+1 ), i+1 ) = -( tscal /
586  $ REAL( KD+2 ) ) / REAL( kd+3 )
587  ab( 1, i+1 ) = one
588  b( i+1 ) = texp*REAL( ( kd+1 )*( kd+1 )+kd )
589  END IF
590  texp = texp*two
591  340 continue
592  b( min( n, j+kd-1 ) ) = ( REAL( KD+2 ) /
593  $ REAL( KD+3 ) )*tscal
594  350 continue
595  END IF
596  ELSE
597  DO 360 j = 1, n
598  ab( 1, j ) = one
599  b( j ) = REAL( j )
600  360 continue
601  END IF
602 *
603  ELSE IF( imat.EQ.17 ) THEN
604 *
605 * Type 17: Generate a unit triangular matrix with elements
606 * between -1 and 1, and make the right hand side large so that it
607 * requires scaling.
608 *
609  IF( upper ) THEN
610  DO 370 j = 1, n
611  lenj = min( j-1, kd )
612  CALL slarnv( 2, iseed, lenj, ab( kd+1-lenj, j ) )
613  ab( kd+1, j ) = REAL( j )
614  370 continue
615  ELSE
616  DO 380 j = 1, n
617  lenj = min( n-j, kd )
618  IF( lenj.GT.0 )
619  $ CALL slarnv( 2, iseed, lenj, ab( 2, j ) )
620  ab( 1, j ) = REAL( j )
621  380 continue
622  END IF
623 *
624 * Set the right hand side so that the largest value is BIGNUM.
625 *
626  CALL slarnv( 2, iseed, n, b )
627  iy = isamax( n, b, 1 )
628  bnorm = abs( b( iy ) )
629  bscal = bignum / max( one, bnorm )
630  CALL sscal( n, bscal, b, 1 )
631 *
632  ELSE IF( imat.EQ.18 ) THEN
633 *
634 * Type 18: Generate a triangular matrix with elements between
635 * BIGNUM/KD and BIGNUM so that at least one of the column
636 * norms will exceed BIGNUM.
637 *
638  tleft = bignum / max( one, REAL( KD ) )
639  tscal = bignum*( REAL( KD ) / REAL( KD+1 ) )
640  IF( upper ) THEN
641  DO 400 j = 1, n
642  lenj = min( j, kd+1 )
643  CALL slarnv( 2, iseed, lenj, ab( kd+2-lenj, j ) )
644  DO 390 i = kd + 2 - lenj, kd + 1
645  ab( i, j ) = sign( tleft, ab( i, j ) ) +
646  $ tscal*ab( i, j )
647  390 continue
648  400 continue
649  ELSE
650  DO 420 j = 1, n
651  lenj = min( n-j+1, kd+1 )
652  CALL slarnv( 2, iseed, lenj, ab( 1, j ) )
653  DO 410 i = 1, lenj
654  ab( i, j ) = sign( tleft, ab( i, j ) ) +
655  $ tscal*ab( i, j )
656  410 continue
657  420 continue
658  END IF
659  CALL slarnv( 2, iseed, n, b )
660  CALL sscal( n, two, b, 1 )
661  END IF
662 *
663 * Flip the matrix if the transpose will be used.
664 *
665  IF( .NOT.lsame( trans, 'N' ) ) THEN
666  IF( upper ) THEN
667  DO 430 j = 1, n / 2
668  lenj = min( n-2*j+1, kd+1 )
669  CALL sswap( lenj, ab( kd+1, j ), ldab-1,
670  $ ab( kd+2-lenj, n-j+1 ), -1 )
671  430 continue
672  ELSE
673  DO 440 j = 1, n / 2
674  lenj = min( n-2*j+1, kd+1 )
675  CALL sswap( lenj, ab( 1, j ), 1, ab( lenj, n-j+2-lenj ),
676  $ -ldab+1 )
677  440 continue
678  END IF
679  END IF
680 *
681  return
682 *
683 * End of SLATTB
684 *
685  END