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.

slatb4.f 15 kB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641
  1. *> \brief \b SLATB4
  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 SLATB4( PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE,
  12. * CNDNUM, DIST )
  13. *
  14. * .. Scalar Arguments ..
  15. * CHARACTER DIST, TYPE
  16. * CHARACTER*3 PATH
  17. * INTEGER IMAT, KL, KU, M, MODE, N
  18. * REAL ANORM, CNDNUM
  19. * ..
  20. *
  21. *
  22. *> \par Purpose:
  23. * =============
  24. *>
  25. *> \verbatim
  26. *>
  27. *> SLATB4 sets parameters for the matrix generator based on the type of
  28. *> matrix to be generated.
  29. *> \endverbatim
  30. *
  31. * Arguments:
  32. * ==========
  33. *
  34. *> \param[in] PATH
  35. *> \verbatim
  36. *> PATH is CHARACTER*3
  37. *> The LAPACK path name.
  38. *> \endverbatim
  39. *>
  40. *> \param[in] IMAT
  41. *> \verbatim
  42. *> IMAT is INTEGER
  43. *> An integer key describing which matrix to generate for this
  44. *> path.
  45. *> \endverbatim
  46. *>
  47. *> \param[in] M
  48. *> \verbatim
  49. *> M is INTEGER
  50. *> The number of rows in the matrix to be generated.
  51. *> \endverbatim
  52. *>
  53. *> \param[in] N
  54. *> \verbatim
  55. *> N is INTEGER
  56. *> The number of columns in the matrix to be generated.
  57. *> \endverbatim
  58. *>
  59. *> \param[out] TYPE
  60. *> \verbatim
  61. *> TYPE is CHARACTER*1
  62. *> The type of the matrix to be generated:
  63. *> = 'S': symmetric matrix
  64. *> = 'P': symmetric positive (semi)definite matrix
  65. *> = 'N': nonsymmetric matrix
  66. *> \endverbatim
  67. *>
  68. *> \param[out] KL
  69. *> \verbatim
  70. *> KL is INTEGER
  71. *> The lower band width of the matrix to be generated.
  72. *> \endverbatim
  73. *>
  74. *> \param[out] KU
  75. *> \verbatim
  76. *> KU is INTEGER
  77. *> The upper band width of the matrix to be generated.
  78. *> \endverbatim
  79. *>
  80. *> \param[out] ANORM
  81. *> \verbatim
  82. *> ANORM is REAL
  83. *> The desired norm of the matrix to be generated. The diagonal
  84. *> matrix of singular values or eigenvalues is scaled by this
  85. *> value.
  86. *> \endverbatim
  87. *>
  88. *> \param[out] MODE
  89. *> \verbatim
  90. *> MODE is INTEGER
  91. *> A key indicating how to choose the vector of eigenvalues.
  92. *> \endverbatim
  93. *>
  94. *> \param[out] CNDNUM
  95. *> \verbatim
  96. *> CNDNUM is REAL
  97. *> The desired condition number.
  98. *> \endverbatim
  99. *>
  100. *> \param[out] DIST
  101. *> \verbatim
  102. *> DIST is CHARACTER*1
  103. *> The type of distribution to be used by the random number
  104. *> generator.
  105. *> \endverbatim
  106. *
  107. * Authors:
  108. * ========
  109. *
  110. *> \author Univ. of Tennessee
  111. *> \author Univ. of California Berkeley
  112. *> \author Univ. of Colorado Denver
  113. *> \author NAG Ltd.
  114. *
  115. *> \ingroup single_lin
  116. *
  117. * =====================================================================
  118. SUBROUTINE SLATB4( PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE,
  119. $ CNDNUM, DIST )
  120. *
  121. * -- LAPACK test routine --
  122. * -- LAPACK is a software package provided by Univ. of Tennessee, --
  123. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  124. *
  125. * .. Scalar Arguments ..
  126. CHARACTER DIST, TYPE
  127. CHARACTER*3 PATH
  128. INTEGER IMAT, KL, KU, M, MODE, N
  129. REAL ANORM, CNDNUM
  130. * ..
  131. *
  132. * =====================================================================
  133. *
  134. * .. Parameters ..
  135. REAL SHRINK, TENTH
  136. PARAMETER ( SHRINK = 0.25E0, TENTH = 0.1E+0 )
  137. REAL ONE
  138. PARAMETER ( ONE = 1.0E+0 )
  139. REAL TWO
  140. PARAMETER ( TWO = 2.0E+0 )
  141. * ..
  142. * .. Local Scalars ..
  143. LOGICAL FIRST
  144. CHARACTER*2 C2
  145. INTEGER MAT
  146. REAL BADC1, BADC2, EPS, LARGE, SMALL
  147. * ..
  148. * .. External Functions ..
  149. LOGICAL LSAMEN
  150. REAL SLAMCH
  151. EXTERNAL LSAMEN, SLAMCH
  152. * ..
  153. * .. Intrinsic Functions ..
  154. INTRINSIC ABS, MAX, SQRT
  155. * ..
  156. * .. Save statement ..
  157. SAVE EPS, SMALL, LARGE, BADC1, BADC2, FIRST
  158. * ..
  159. * .. Data statements ..
  160. DATA FIRST / .TRUE. /
  161. * ..
  162. * .. Executable Statements ..
  163. *
  164. * Set some constants for use in the subroutine.
  165. *
  166. IF( FIRST ) THEN
  167. FIRST = .FALSE.
  168. EPS = SLAMCH( 'Precision' )
  169. BADC2 = TENTH / EPS
  170. BADC1 = SQRT( BADC2 )
  171. SMALL = SLAMCH( 'Safe minimum' )
  172. LARGE = ONE / SMALL
  173. SMALL = SHRINK*( SMALL / EPS )
  174. LARGE = ONE / SMALL
  175. END IF
  176. *
  177. C2 = PATH( 2: 3 )
  178. *
  179. * Set some parameters we don't plan to change.
  180. *
  181. DIST = 'S'
  182. MODE = 3
  183. *
  184. IF( LSAMEN( 2, C2, 'QR' ) .OR. LSAMEN( 2, C2, 'LQ' ) .OR.
  185. $ LSAMEN( 2, C2, 'QL' ) .OR. LSAMEN( 2, C2, 'RQ' ) ) THEN
  186. *
  187. * xQR, xLQ, xQL, xRQ: Set parameters to generate a general
  188. * M x N matrix.
  189. *
  190. * Set TYPE, the type of matrix to be generated.
  191. *
  192. TYPE = 'N'
  193. *
  194. * Set the lower and upper bandwidths.
  195. *
  196. IF( IMAT.EQ.1 ) THEN
  197. KL = 0
  198. KU = 0
  199. ELSE IF( IMAT.EQ.2 ) THEN
  200. KL = 0
  201. KU = MAX( N-1, 0 )
  202. ELSE IF( IMAT.EQ.3 ) THEN
  203. KL = MAX( M-1, 0 )
  204. KU = 0
  205. ELSE
  206. KL = MAX( M-1, 0 )
  207. KU = MAX( N-1, 0 )
  208. END IF
  209. *
  210. * Set the condition number and norm.
  211. *
  212. IF( IMAT.EQ.5 ) THEN
  213. CNDNUM = BADC1
  214. ELSE IF( IMAT.EQ.6 ) THEN
  215. CNDNUM = BADC2
  216. ELSE
  217. CNDNUM = TWO
  218. END IF
  219. *
  220. IF( IMAT.EQ.7 ) THEN
  221. ANORM = SMALL
  222. ELSE IF( IMAT.EQ.8 ) THEN
  223. ANORM = LARGE
  224. ELSE
  225. ANORM = ONE
  226. END IF
  227. *
  228. ELSE IF( LSAMEN( 2, C2, 'QK' ) ) THEN
  229. *
  230. * xQK: truncated QR with pivoting.
  231. * Set parameters to generate a general
  232. * M x N matrix.
  233. *
  234. * Set TYPE, the type of matrix to be generated. 'N' is nonsymmetric.
  235. *
  236. TYPE = 'N'
  237. *
  238. * Set DIST, the type of distribution for the random
  239. * number generator. 'S' is
  240. *
  241. DIST = 'S'
  242. *
  243. * Set the lower and upper bandwidths.
  244. *
  245. IF( IMAT.EQ.2 ) THEN
  246. *
  247. * 2. Random, Diagonal, CNDNUM = 2
  248. *
  249. KL = 0
  250. KU = 0
  251. CNDNUM = TWO
  252. ANORM = ONE
  253. MODE = 3
  254. ELSE IF( IMAT.EQ.3 ) THEN
  255. *
  256. * 3. Random, Upper triangular, CNDNUM = 2
  257. *
  258. KL = 0
  259. KU = MAX( N-1, 0 )
  260. CNDNUM = TWO
  261. ANORM = ONE
  262. MODE = 3
  263. ELSE IF( IMAT.EQ.4 ) THEN
  264. *
  265. * 4. Random, Lower triangular, CNDNUM = 2
  266. *
  267. KL = MAX( M-1, 0 )
  268. KU = 0
  269. CNDNUM = TWO
  270. ANORM = ONE
  271. MODE = 3
  272. ELSE
  273. *
  274. * 5.-19. Rectangular matrix
  275. *
  276. KL = MAX( M-1, 0 )
  277. KU = MAX( N-1, 0 )
  278. *
  279. IF( IMAT.GE.5 .AND. IMAT.LE.14 ) THEN
  280. *
  281. * 5.-14. Random, CNDNUM = 2.
  282. *
  283. CNDNUM = TWO
  284. ANORM = ONE
  285. MODE = 3
  286. *
  287. ELSE IF( IMAT.EQ.15 ) THEN
  288. *
  289. * 15. Random, CNDNUM = sqrt(0.1/EPS)
  290. *
  291. CNDNUM = BADC1
  292. ANORM = ONE
  293. MODE = 3
  294. *
  295. ELSE IF( IMAT.EQ.16 ) THEN
  296. *
  297. * 16. Random, CNDNUM = 0.1/EPS
  298. *
  299. CNDNUM = BADC2
  300. ANORM = ONE
  301. MODE = 3
  302. *
  303. ELSE IF( IMAT.EQ.17 ) THEN
  304. *
  305. * 17. Random, CNDNUM = 0.1/EPS,
  306. * one small singular value S(N)=1/CNDNUM
  307. *
  308. CNDNUM = BADC2
  309. ANORM = ONE
  310. MODE = 2
  311. *
  312. ELSE IF( IMAT.EQ.18 ) THEN
  313. *
  314. * 18. Random, scaled near underflow
  315. *
  316. CNDNUM = TWO
  317. ANORM = SMALL
  318. MODE = 3
  319. *
  320. ELSE IF( IMAT.EQ.19 ) THEN
  321. *
  322. * 19. Random, scaled near overflow
  323. *
  324. CNDNUM = TWO
  325. ANORM = LARGE
  326. MODE = 3
  327. *
  328. END IF
  329. *
  330. END IF
  331. *
  332. ELSE IF( LSAMEN( 2, C2, 'GE' ) ) THEN
  333. *
  334. * xGE: Set parameters to generate a general M x N matrix.
  335. *
  336. * Set TYPE, the type of matrix to be generated.
  337. *
  338. TYPE = 'N'
  339. *
  340. * Set the lower and upper bandwidths.
  341. *
  342. IF( IMAT.EQ.1 ) THEN
  343. KL = 0
  344. KU = 0
  345. ELSE IF( IMAT.EQ.2 ) THEN
  346. KL = 0
  347. KU = MAX( N-1, 0 )
  348. ELSE IF( IMAT.EQ.3 ) THEN
  349. KL = MAX( M-1, 0 )
  350. KU = 0
  351. ELSE
  352. KL = MAX( M-1, 0 )
  353. KU = MAX( N-1, 0 )
  354. END IF
  355. *
  356. * Set the condition number and norm.
  357. *
  358. IF( IMAT.EQ.8 ) THEN
  359. CNDNUM = BADC1
  360. ELSE IF( IMAT.EQ.9 ) THEN
  361. CNDNUM = BADC2
  362. ELSE
  363. CNDNUM = TWO
  364. END IF
  365. *
  366. IF( IMAT.EQ.10 ) THEN
  367. ANORM = SMALL
  368. ELSE IF( IMAT.EQ.11 ) THEN
  369. ANORM = LARGE
  370. ELSE
  371. ANORM = ONE
  372. END IF
  373. *
  374. ELSE IF( LSAMEN( 2, C2, 'GB' ) ) THEN
  375. *
  376. * xGB: Set parameters to generate a general banded matrix.
  377. *
  378. * Set TYPE, the type of matrix to be generated.
  379. *
  380. TYPE = 'N'
  381. *
  382. * Set the condition number and norm.
  383. *
  384. IF( IMAT.EQ.5 ) THEN
  385. CNDNUM = BADC1
  386. ELSE IF( IMAT.EQ.6 ) THEN
  387. CNDNUM = TENTH*BADC2
  388. ELSE
  389. CNDNUM = TWO
  390. END IF
  391. *
  392. IF( IMAT.EQ.7 ) THEN
  393. ANORM = SMALL
  394. ELSE IF( IMAT.EQ.8 ) THEN
  395. ANORM = LARGE
  396. ELSE
  397. ANORM = ONE
  398. END IF
  399. *
  400. ELSE IF( LSAMEN( 2, C2, 'GT' ) ) THEN
  401. *
  402. * xGT: Set parameters to generate a general tridiagonal matrix.
  403. *
  404. * Set TYPE, the type of matrix to be generated.
  405. *
  406. TYPE = 'N'
  407. *
  408. * Set the lower and upper bandwidths.
  409. *
  410. IF( IMAT.EQ.1 ) THEN
  411. KL = 0
  412. ELSE
  413. KL = 1
  414. END IF
  415. KU = KL
  416. *
  417. * Set the condition number and norm.
  418. *
  419. IF( IMAT.EQ.3 ) THEN
  420. CNDNUM = BADC1
  421. ELSE IF( IMAT.EQ.4 ) THEN
  422. CNDNUM = BADC2
  423. ELSE
  424. CNDNUM = TWO
  425. END IF
  426. *
  427. IF( IMAT.EQ.5 .OR. IMAT.EQ.11 ) THEN
  428. ANORM = SMALL
  429. ELSE IF( IMAT.EQ.6 .OR. IMAT.EQ.12 ) THEN
  430. ANORM = LARGE
  431. ELSE
  432. ANORM = ONE
  433. END IF
  434. *
  435. ELSE IF( LSAMEN( 2, C2, 'PO' ) .OR. LSAMEN( 2, C2, 'PP' ) ) THEN
  436. *
  437. * xPO, xPP, xSY, xSP: Set parameters to generate a
  438. * symmetric positive definite matrix.
  439. *
  440. * Set TYPE, the type of matrix to be generated.
  441. *
  442. TYPE = C2( 1: 1 )
  443. *
  444. * Set the lower and upper bandwidths.
  445. *
  446. IF( IMAT.EQ.1 ) THEN
  447. KL = 0
  448. ELSE
  449. KL = MAX( N-1, 0 )
  450. END IF
  451. KU = KL
  452. *
  453. * Set the condition number and norm.
  454. *
  455. IF( IMAT.EQ.6 ) THEN
  456. CNDNUM = BADC1
  457. ELSE IF( IMAT.EQ.7 ) THEN
  458. CNDNUM = BADC2
  459. ELSE
  460. CNDNUM = TWO
  461. END IF
  462. *
  463. IF( IMAT.EQ.8 ) THEN
  464. ANORM = SMALL
  465. ELSE IF( IMAT.EQ.9 ) THEN
  466. ANORM = LARGE
  467. ELSE
  468. ANORM = ONE
  469. END IF
  470. *
  471. *
  472. ELSE IF( LSAMEN( 2, C2, 'SY' ) .OR. LSAMEN( 2, C2, 'SP' ) ) THEN
  473. *
  474. * xSY, xSP: Set parameters to generate a
  475. * symmetric matrix.
  476. *
  477. * Set TYPE, the type of matrix to be generated.
  478. *
  479. TYPE = C2( 1: 1 )
  480. *
  481. * Set the lower and upper bandwidths.
  482. *
  483. IF( IMAT.EQ.1 ) THEN
  484. KL = 0
  485. ELSE
  486. KL = MAX( N-1, 0 )
  487. END IF
  488. KU = KL
  489. *
  490. * Set the condition number and norm.
  491. *
  492. IF( IMAT.EQ.7 ) THEN
  493. CNDNUM = BADC1
  494. ELSE IF( IMAT.EQ.8 ) THEN
  495. CNDNUM = BADC2
  496. ELSE
  497. CNDNUM = TWO
  498. END IF
  499. *
  500. IF( IMAT.EQ.9 ) THEN
  501. ANORM = SMALL
  502. ELSE IF( IMAT.EQ.10 ) THEN
  503. ANORM = LARGE
  504. ELSE
  505. ANORM = ONE
  506. END IF
  507. *
  508. ELSE IF( LSAMEN( 2, C2, 'PB' ) ) THEN
  509. *
  510. * xPB: Set parameters to generate a symmetric band matrix.
  511. *
  512. * Set TYPE, the type of matrix to be generated.
  513. *
  514. TYPE = 'P'
  515. *
  516. * Set the norm and condition number.
  517. *
  518. IF( IMAT.EQ.5 ) THEN
  519. CNDNUM = BADC1
  520. ELSE IF( IMAT.EQ.6 ) THEN
  521. CNDNUM = BADC2
  522. ELSE
  523. CNDNUM = TWO
  524. END IF
  525. *
  526. IF( IMAT.EQ.7 ) THEN
  527. ANORM = SMALL
  528. ELSE IF( IMAT.EQ.8 ) THEN
  529. ANORM = LARGE
  530. ELSE
  531. ANORM = ONE
  532. END IF
  533. *
  534. ELSE IF( LSAMEN( 2, C2, 'PT' ) ) THEN
  535. *
  536. * xPT: Set parameters to generate a symmetric positive definite
  537. * tridiagonal matrix.
  538. *
  539. TYPE = 'P'
  540. IF( IMAT.EQ.1 ) THEN
  541. KL = 0
  542. ELSE
  543. KL = 1
  544. END IF
  545. KU = KL
  546. *
  547. * Set the condition number and norm.
  548. *
  549. IF( IMAT.EQ.3 ) THEN
  550. CNDNUM = BADC1
  551. ELSE IF( IMAT.EQ.4 ) THEN
  552. CNDNUM = BADC2
  553. ELSE
  554. CNDNUM = TWO
  555. END IF
  556. *
  557. IF( IMAT.EQ.5 .OR. IMAT.EQ.11 ) THEN
  558. ANORM = SMALL
  559. ELSE IF( IMAT.EQ.6 .OR. IMAT.EQ.12 ) THEN
  560. ANORM = LARGE
  561. ELSE
  562. ANORM = ONE
  563. END IF
  564. *
  565. ELSE IF( LSAMEN( 2, C2, 'TR' ) .OR. LSAMEN( 2, C2, 'TP' ) ) THEN
  566. *
  567. * xTR, xTP: Set parameters to generate a triangular matrix
  568. *
  569. * Set TYPE, the type of matrix to be generated.
  570. *
  571. TYPE = 'N'
  572. *
  573. * Set the lower and upper bandwidths.
  574. *
  575. MAT = ABS( IMAT )
  576. IF( MAT.EQ.1 .OR. MAT.EQ.7 ) THEN
  577. KL = 0
  578. KU = 0
  579. ELSE IF( IMAT.LT.0 ) THEN
  580. KL = MAX( N-1, 0 )
  581. KU = 0
  582. ELSE
  583. KL = 0
  584. KU = MAX( N-1, 0 )
  585. END IF
  586. *
  587. * Set the condition number and norm.
  588. *
  589. IF( MAT.EQ.3 .OR. MAT.EQ.9 ) THEN
  590. CNDNUM = BADC1
  591. ELSE IF( MAT.EQ.4 ) THEN
  592. CNDNUM = BADC2
  593. ELSE IF( MAT.EQ.10 ) THEN
  594. CNDNUM = BADC2
  595. ELSE
  596. CNDNUM = TWO
  597. END IF
  598. *
  599. IF( MAT.EQ.5 ) THEN
  600. ANORM = SMALL
  601. ELSE IF( MAT.EQ.6 ) THEN
  602. ANORM = LARGE
  603. ELSE
  604. ANORM = ONE
  605. END IF
  606. *
  607. ELSE IF( LSAMEN( 2, C2, 'TB' ) ) THEN
  608. *
  609. * xTB: Set parameters to generate a triangular band matrix.
  610. *
  611. * Set TYPE, the type of matrix to be generated.
  612. *
  613. TYPE = 'N'
  614. *
  615. * Set the norm and condition number.
  616. *
  617. MAT = ABS( IMAT )
  618. IF( MAT.EQ.2 .OR. MAT.EQ.8 ) THEN
  619. CNDNUM = BADC1
  620. ELSE IF( MAT.EQ.3 .OR. MAT.EQ.9 ) THEN
  621. CNDNUM = BADC2
  622. ELSE
  623. CNDNUM = TWO
  624. END IF
  625. *
  626. IF( MAT.EQ.4 ) THEN
  627. ANORM = SMALL
  628. ELSE IF( MAT.EQ.5 ) THEN
  629. ANORM = LARGE
  630. ELSE
  631. ANORM = ONE
  632. END IF
  633. END IF
  634. IF( N.LE.1 )
  635. $ CNDNUM = ONE
  636. *
  637. RETURN
  638. *
  639. * End of SLATB4
  640. *
  641. END