You can not select more than 25 topics Topics must start with a chinese character,a letter or number, can include dashes ('-') and can be up to 35 characters long.

slattb.f 22 kB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685
  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 December 2016
  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.7.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. * December 2016
  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