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

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693
  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