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.

clattb.f 23 kB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696
  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