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.

serrsy.f 24 kB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669
  1. *> \brief \b SERRSY
  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 SERRSY( PATH, NUNIT )
  12. *
  13. * .. Scalar Arguments ..
  14. * CHARACTER*3 PATH
  15. * INTEGER NUNIT
  16. * ..
  17. *
  18. *
  19. *> \par Purpose:
  20. * =============
  21. *>
  22. *> \verbatim
  23. *>
  24. *> SERRSY tests the error exits for the REAL routines
  25. *> for symmetric indefinite matrices.
  26. *> \endverbatim
  27. *
  28. * Arguments:
  29. * ==========
  30. *
  31. *> \param[in] PATH
  32. *> \verbatim
  33. *> PATH is CHARACTER*3
  34. *> The LAPACK path name for the routines to be tested.
  35. *> \endverbatim
  36. *>
  37. *> \param[in] NUNIT
  38. *> \verbatim
  39. *> NUNIT is INTEGER
  40. *> The unit number for output.
  41. *> \endverbatim
  42. *
  43. * Authors:
  44. * ========
  45. *
  46. *> \author Univ. of Tennessee
  47. *> \author Univ. of California Berkeley
  48. *> \author Univ. of Colorado Denver
  49. *> \author NAG Ltd.
  50. *
  51. *> \ingroup single_lin
  52. *
  53. * =====================================================================
  54. SUBROUTINE SERRSY( PATH, NUNIT )
  55. *
  56. * -- LAPACK test routine --
  57. * -- LAPACK is a software package provided by Univ. of Tennessee, --
  58. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  59. *
  60. * .. Scalar Arguments ..
  61. CHARACTER*3 PATH
  62. INTEGER NUNIT
  63. * ..
  64. *
  65. * =====================================================================
  66. *
  67. * .. Parameters ..
  68. INTEGER NMAX
  69. PARAMETER ( NMAX = 4 )
  70. * ..
  71. * .. Local Scalars ..
  72. CHARACTER*2 C2
  73. INTEGER I, INFO, J
  74. REAL ANRM, RCOND
  75. * ..
  76. * .. Local Arrays ..
  77. INTEGER IP( NMAX ), IW( NMAX )
  78. REAL A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
  79. $ E( NMAX ), R1( NMAX ), R2( NMAX ), W( 3*NMAX ),
  80. $ X( NMAX )
  81. * ..
  82. * .. External Functions ..
  83. LOGICAL LSAMEN
  84. EXTERNAL LSAMEN
  85. * ..
  86. * .. External Subroutines ..
  87. EXTERNAL ALAESM, CHKXER, SSPCON, SSPRFS, SSPTRF, SSPTRI,
  88. $ SSPTRS, SSYCON, SSYCON_3, SSYCON_ROOK, SSYRFS,
  89. $ SSYTF2_RK, SSYTF2_ROOK, SSYTRF, SSYTRF_RK,
  90. $ SSYTRF_ROOK, SSYTRI, SSYTF2, SSYTRI_3,
  91. $ SSYTRI_3X, SSYTRI_ROOK, SSYTRF_AA, SSYTRI2,
  92. $ SSYTRI2X, SSYTRS, SSYTRS_3, SSYTRS_ROOK,
  93. $ SSYTRS_AA, SSYTRF_AA_2STAGE, SSYTRS_AA_2STAGE
  94. * ..
  95. * .. Scalars in Common ..
  96. LOGICAL LERR, OK
  97. CHARACTER*32 SRNAMT
  98. INTEGER INFOT, NOUT
  99. * ..
  100. * .. Common blocks ..
  101. COMMON / INFOC / INFOT, NOUT, OK, LERR
  102. COMMON / SRNAMC / SRNAMT
  103. * ..
  104. * .. Intrinsic Functions ..
  105. INTRINSIC REAL
  106. * ..
  107. * .. Executable Statements ..
  108. *
  109. NOUT = NUNIT
  110. WRITE( NOUT, FMT = * )
  111. C2 = PATH( 2: 3 )
  112. *
  113. * Set the variables to innocuous values.
  114. *
  115. DO 20 J = 1, NMAX
  116. DO 10 I = 1, NMAX
  117. A( I, J ) = 1. / REAL( I+J )
  118. AF( I, J ) = 1. / REAL( I+J )
  119. 10 CONTINUE
  120. B( J ) = 0.E+0
  121. E( J ) = 0.E+0
  122. R1( J ) = 0.E+0
  123. R2( J ) = 0.E+0
  124. W( J ) = 0.E+0
  125. X( J ) = 0.E+0
  126. IP( J ) = J
  127. IW( J ) = J
  128. 20 CONTINUE
  129. ANRM = 1.0
  130. RCOND = 1.0
  131. OK = .TRUE.
  132. *
  133. IF( LSAMEN( 2, C2, 'SY' ) ) THEN
  134. *
  135. * Test error exits of the routines that use factorization
  136. * of a symmetric indefinite matrix with patrial
  137. * (Bunch-Kaufman) pivoting.
  138. *
  139. * SSYTRF
  140. *
  141. SRNAMT = 'SSYTRF'
  142. INFOT = 1
  143. CALL SSYTRF( '/', 0, A, 1, IP, W, 1, INFO )
  144. CALL CHKXER( 'SSYTRF', INFOT, NOUT, LERR, OK )
  145. INFOT = 2
  146. CALL SSYTRF( 'U', -1, A, 1, IP, W, 1, INFO )
  147. CALL CHKXER( 'SSYTRF', INFOT, NOUT, LERR, OK )
  148. INFOT = 4
  149. CALL SSYTRF( 'U', 2, A, 1, IP, W, 4, INFO )
  150. CALL CHKXER( 'SSYTRF', INFOT, NOUT, LERR, OK )
  151. INFOT = 7
  152. CALL SSYTRF( 'U', 0, A, 1, IP, W, 0, INFO )
  153. CALL CHKXER( 'SSYTRF', INFOT, NOUT, LERR, OK )
  154. INFOT = 7
  155. CALL SSYTRF( 'U', 0, A, 1, IP, W, -2, INFO )
  156. CALL CHKXER( 'SSYTRF', INFOT, NOUT, LERR, OK )
  157. *
  158. * SSYTF2
  159. *
  160. SRNAMT = 'SSYTF2'
  161. INFOT = 1
  162. CALL SSYTF2( '/', 0, A, 1, IP, INFO )
  163. CALL CHKXER( 'SSYTF2', INFOT, NOUT, LERR, OK )
  164. INFOT = 2
  165. CALL SSYTF2( 'U', -1, A, 1, IP, INFO )
  166. CALL CHKXER( 'SSYTF2', INFOT, NOUT, LERR, OK )
  167. INFOT = 4
  168. CALL SSYTF2( 'U', 2, A, 1, IP, INFO )
  169. CALL CHKXER( 'SSYTF2', INFOT, NOUT, LERR, OK )
  170. *
  171. * SSYTRI
  172. *
  173. SRNAMT = 'SSYTRI'
  174. INFOT = 1
  175. CALL SSYTRI( '/', 0, A, 1, IP, W, INFO )
  176. CALL CHKXER( 'SSYTRI', INFOT, NOUT, LERR, OK )
  177. INFOT = 2
  178. CALL SSYTRI( 'U', -1, A, 1, IP, W, INFO )
  179. CALL CHKXER( 'SSYTRI', INFOT, NOUT, LERR, OK )
  180. INFOT = 4
  181. CALL SSYTRI( 'U', 2, A, 1, IP, W, INFO )
  182. CALL CHKXER( 'SSYTRI', INFOT, NOUT, LERR, OK )
  183. *
  184. * SSYTRI2
  185. *
  186. SRNAMT = 'SSYTRI2'
  187. INFOT = 1
  188. CALL SSYTRI2( '/', 0, A, 1, IP, W, IW(1), INFO )
  189. CALL CHKXER( 'SSYTRI2', INFOT, NOUT, LERR, OK )
  190. INFOT = 2
  191. CALL SSYTRI2( 'U', -1, A, 1, IP, W, IW(1), INFO )
  192. CALL CHKXER( 'SSYTRI2', INFOT, NOUT, LERR, OK )
  193. INFOT = 4
  194. CALL SSYTRI2( 'U', 2, A, 1, IP, W, IW(1), INFO )
  195. CALL CHKXER( 'SSYTRI2', INFOT, NOUT, LERR, OK )
  196. *
  197. * SSYTRI2X
  198. *
  199. SRNAMT = 'SSYTRI2X'
  200. INFOT = 1
  201. CALL SSYTRI2X( '/', 0, A, 1, IP, W, 1, INFO )
  202. CALL CHKXER( 'SSYTRI2X', INFOT, NOUT, LERR, OK )
  203. INFOT = 2
  204. CALL SSYTRI2X( 'U', -1, A, 1, IP, W, 1, INFO )
  205. CALL CHKXER( 'SSYTRI2X', INFOT, NOUT, LERR, OK )
  206. INFOT = 4
  207. CALL SSYTRI2X( 'U', 2, A, 1, IP, W, 1, INFO )
  208. CALL CHKXER( 'SSYTRI2X', INFOT, NOUT, LERR, OK )
  209. *
  210. * SSYTRS
  211. *
  212. SRNAMT = 'SSYTRS'
  213. INFOT = 1
  214. CALL SSYTRS( '/', 0, 0, A, 1, IP, B, 1, INFO )
  215. CALL CHKXER( 'SSYTRS', INFOT, NOUT, LERR, OK )
  216. INFOT = 2
  217. CALL SSYTRS( 'U', -1, 0, A, 1, IP, B, 1, INFO )
  218. CALL CHKXER( 'SSYTRS', INFOT, NOUT, LERR, OK )
  219. INFOT = 3
  220. CALL SSYTRS( 'U', 0, -1, A, 1, IP, B, 1, INFO )
  221. CALL CHKXER( 'SSYTRS', INFOT, NOUT, LERR, OK )
  222. INFOT = 5
  223. CALL SSYTRS( 'U', 2, 1, A, 1, IP, B, 2, INFO )
  224. CALL CHKXER( 'SSYTRS', INFOT, NOUT, LERR, OK )
  225. INFOT = 8
  226. CALL SSYTRS( 'U', 2, 1, A, 2, IP, B, 1, INFO )
  227. CALL CHKXER( 'SSYTRS', INFOT, NOUT, LERR, OK )
  228. *
  229. * SSYRFS
  230. *
  231. SRNAMT = 'SSYRFS'
  232. INFOT = 1
  233. CALL SSYRFS( '/', 0, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, W,
  234. $ IW, INFO )
  235. CALL CHKXER( 'SSYRFS', INFOT, NOUT, LERR, OK )
  236. INFOT = 2
  237. CALL SSYRFS( 'U', -1, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2,
  238. $ W, IW, INFO )
  239. CALL CHKXER( 'SSYRFS', INFOT, NOUT, LERR, OK )
  240. INFOT = 3
  241. CALL SSYRFS( 'U', 0, -1, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2,
  242. $ W, IW, INFO )
  243. CALL CHKXER( 'SSYRFS', INFOT, NOUT, LERR, OK )
  244. INFOT = 5
  245. CALL SSYRFS( 'U', 2, 1, A, 1, AF, 2, IP, B, 2, X, 2, R1, R2, W,
  246. $ IW, INFO )
  247. CALL CHKXER( 'SSYRFS', INFOT, NOUT, LERR, OK )
  248. INFOT = 7
  249. CALL SSYRFS( 'U', 2, 1, A, 2, AF, 1, IP, B, 2, X, 2, R1, R2, W,
  250. $ IW, INFO )
  251. CALL CHKXER( 'SSYRFS', INFOT, NOUT, LERR, OK )
  252. INFOT = 10
  253. CALL SSYRFS( 'U', 2, 1, A, 2, AF, 2, IP, B, 1, X, 2, R1, R2, W,
  254. $ IW, INFO )
  255. CALL CHKXER( 'SSYRFS', INFOT, NOUT, LERR, OK )
  256. INFOT = 12
  257. CALL SSYRFS( 'U', 2, 1, A, 2, AF, 2, IP, B, 2, X, 1, R1, R2, W,
  258. $ IW, INFO )
  259. CALL CHKXER( 'SSYRFS', INFOT, NOUT, LERR, OK )
  260. *
  261. * SSYCON
  262. *
  263. SRNAMT = 'SSYCON'
  264. INFOT = 1
  265. CALL SSYCON( '/', 0, A, 1, IP, ANRM, RCOND, W, IW, INFO )
  266. CALL CHKXER( 'SSYCON', INFOT, NOUT, LERR, OK )
  267. INFOT = 2
  268. CALL SSYCON( 'U', -1, A, 1, IP, ANRM, RCOND, W, IW, INFO )
  269. CALL CHKXER( 'SSYCON', INFOT, NOUT, LERR, OK )
  270. INFOT = 4
  271. CALL SSYCON( 'U', 2, A, 1, IP, ANRM, RCOND, W, IW, INFO )
  272. CALL CHKXER( 'SSYCON', INFOT, NOUT, LERR, OK )
  273. INFOT = 6
  274. CALL SSYCON( 'U', 1, A, 1, IP, -1.0, RCOND, W, IW, INFO )
  275. CALL CHKXER( 'SSYCON', INFOT, NOUT, LERR, OK )
  276. *
  277. ELSE IF( LSAMEN( 2, C2, 'SR' ) ) THEN
  278. *
  279. * Test error exits of the routines that use factorization
  280. * of a symmetric indefinite matrix with rook
  281. * (bounded Bunch-Kaufman) pivoting.
  282. *
  283. * SSYTRF_ROOK
  284. *
  285. SRNAMT = 'SSYTRF_ROOK'
  286. INFOT = 1
  287. CALL SSYTRF_ROOK( '/', 0, A, 1, IP, W, 1, INFO )
  288. CALL CHKXER( 'SSYTRF_ROOK', INFOT, NOUT, LERR, OK )
  289. INFOT = 2
  290. CALL SSYTRF_ROOK( 'U', -1, A, 1, IP, W, 1, INFO )
  291. CALL CHKXER( 'SSYTRF_ROOK', INFOT, NOUT, LERR, OK )
  292. INFOT = 4
  293. CALL SSYTRF_ROOK( 'U', 2, A, 1, IP, W, 4, INFO )
  294. CALL CHKXER( 'SSYTRF_ROOK', INFOT, NOUT, LERR, OK )
  295. INFOT = 7
  296. CALL SSYTRF_ROOK( 'U', 0, A, 1, IP, W, 0, INFO )
  297. CALL CHKXER( 'SSYTRF_ROOK', INFOT, NOUT, LERR, OK )
  298. INFOT = 7
  299. CALL SSYTRF_ROOK( 'U', 0, A, 1, IP, W, -2, INFO )
  300. CALL CHKXER( 'SSYTRF_ROOK', INFOT, NOUT, LERR, OK )
  301. *
  302. * SSYTF2_ROOK
  303. *
  304. SRNAMT = 'SSYTF2_ROOK'
  305. INFOT = 1
  306. CALL SSYTF2_ROOK( '/', 0, A, 1, IP, INFO )
  307. CALL CHKXER( 'SSYTF2_ROOK', INFOT, NOUT, LERR, OK )
  308. INFOT = 2
  309. CALL SSYTF2_ROOK( 'U', -1, A, 1, IP, INFO )
  310. CALL CHKXER( 'SSYTF2_ROOK', INFOT, NOUT, LERR, OK )
  311. INFOT = 4
  312. CALL SSYTF2_ROOK( 'U', 2, A, 1, IP, INFO )
  313. CALL CHKXER( 'SSYTF2_ROOK', INFOT, NOUT, LERR, OK )
  314. *
  315. * SSYTRI_ROOK
  316. *
  317. SRNAMT = 'SSYTRI_ROOK'
  318. INFOT = 1
  319. CALL SSYTRI_ROOK( '/', 0, A, 1, IP, W, INFO )
  320. CALL CHKXER( 'SSYTRI_ROOK', INFOT, NOUT, LERR, OK )
  321. INFOT = 2
  322. CALL SSYTRI_ROOK( 'U', -1, A, 1, IP, W, INFO )
  323. CALL CHKXER( 'SSYTRI_ROOK', INFOT, NOUT, LERR, OK )
  324. INFOT = 4
  325. CALL SSYTRI_ROOK( 'U', 2, A, 1, IP, W, INFO )
  326. CALL CHKXER( 'SSYTRI_ROOK', INFOT, NOUT, LERR, OK )
  327. *
  328. * SSYTRS_ROOK
  329. *
  330. SRNAMT = 'SSYTRS_ROOK'
  331. INFOT = 1
  332. CALL SSYTRS_ROOK( '/', 0, 0, A, 1, IP, B, 1, INFO )
  333. CALL CHKXER( 'SSYTRS_ROOK', INFOT, NOUT, LERR, OK )
  334. INFOT = 2
  335. CALL SSYTRS_ROOK( 'U', -1, 0, A, 1, IP, B, 1, INFO )
  336. CALL CHKXER( 'SSYTRS_ROOK', INFOT, NOUT, LERR, OK )
  337. INFOT = 3
  338. CALL SSYTRS_ROOK( 'U', 0, -1, A, 1, IP, B, 1, INFO )
  339. CALL CHKXER( 'SSYTRS_ROOK', INFOT, NOUT, LERR, OK )
  340. INFOT = 5
  341. CALL SSYTRS_ROOK( 'U', 2, 1, A, 1, IP, B, 2, INFO )
  342. CALL CHKXER( 'SSYTRS_ROOK', INFOT, NOUT, LERR, OK )
  343. INFOT = 8
  344. CALL SSYTRS_ROOK( 'U', 2, 1, A, 2, IP, B, 1, INFO )
  345. CALL CHKXER( 'SSYTRS_ROOK', INFOT, NOUT, LERR, OK )
  346. *
  347. * SSYCON_ROOK
  348. *
  349. SRNAMT = 'SSYCON_ROOK'
  350. INFOT = 1
  351. CALL SSYCON_ROOK( '/', 0, A, 1, IP, ANRM, RCOND, W, IW, INFO )
  352. CALL CHKXER( 'SSYCON_ROOK', INFOT, NOUT, LERR, OK )
  353. INFOT = 2
  354. CALL SSYCON_ROOK( 'U', -1, A, 1, IP, ANRM, RCOND, W, IW, INFO )
  355. CALL CHKXER( 'SSYCON_ROOK', INFOT, NOUT, LERR, OK )
  356. INFOT = 4
  357. CALL SSYCON_ROOK( 'U', 2, A, 1, IP, ANRM, RCOND, W, IW, INFO )
  358. CALL CHKXER( 'SSYCON_ROOK', INFOT, NOUT, LERR, OK )
  359. INFOT = 6
  360. CALL SSYCON_ROOK( 'U', 1, A, 1, IP, -1.0, RCOND, W, IW, INFO )
  361. CALL CHKXER( 'SSYCON_ROOK', INFOT, NOUT, LERR, OK )
  362. *
  363. ELSE IF( LSAMEN( 2, C2, 'SK' ) ) THEN
  364. *
  365. * Test error exits of the routines that use factorization
  366. * of a symmetric indefinite matrix with rook
  367. * (bounded Bunch-Kaufman) pivoting with the new storage
  368. * format for factors L ( or U) and D.
  369. *
  370. * L (or U) is stored in A, diagonal of D is stored on the
  371. * diagonal of A, subdiagonal of D is stored in a separate array E.
  372. *
  373. * SSYTRF_RK
  374. *
  375. SRNAMT = 'SSYTRF_RK'
  376. INFOT = 1
  377. CALL SSYTRF_RK( '/', 0, A, 1, E, IP, W, 1, INFO )
  378. CALL CHKXER( 'SSYTRF_RK', INFOT, NOUT, LERR, OK )
  379. INFOT = 2
  380. CALL SSYTRF_RK( 'U', -1, A, 1, E, IP, W, 1, INFO )
  381. CALL CHKXER( 'SSYTRF_RK', INFOT, NOUT, LERR, OK )
  382. INFOT = 4
  383. CALL SSYTRF_RK( 'U', 2, A, 1, E, IP, W, 4, INFO )
  384. CALL CHKXER( 'SSYTRF_RK', INFOT, NOUT, LERR, OK )
  385. INFOT = 8
  386. CALL SSYTRF_RK( 'U', 0, A, 1, E, IP, W, 0, INFO )
  387. CALL CHKXER( 'SSYTRF_RK', INFOT, NOUT, LERR, OK )
  388. INFOT = 8
  389. CALL SSYTRF_RK( 'U', 0, A, 1, E, IP, W, -2, INFO )
  390. CALL CHKXER( 'SSYTRF_RK', INFOT, NOUT, LERR, OK )
  391. *
  392. * SSYTF2_RK
  393. *
  394. SRNAMT = 'SSYTF2_RK'
  395. INFOT = 1
  396. CALL SSYTF2_RK( '/', 0, A, 1, E, IP, INFO )
  397. CALL CHKXER( 'SSYTF2_RK', INFOT, NOUT, LERR, OK )
  398. INFOT = 2
  399. CALL SSYTF2_RK( 'U', -1, A, 1, E, IP, INFO )
  400. CALL CHKXER( 'SSYTF2_RK', INFOT, NOUT, LERR, OK )
  401. INFOT = 4
  402. CALL SSYTF2_RK( 'U', 2, A, 1, E, IP, INFO )
  403. CALL CHKXER( 'SSYTF2_RK', INFOT, NOUT, LERR, OK )
  404. *
  405. * SSYTRI_3
  406. *
  407. SRNAMT = 'SSYTRI_3'
  408. INFOT = 1
  409. CALL SSYTRI_3( '/', 0, A, 1, E, IP, W, 1, INFO )
  410. CALL CHKXER( 'SSYTRI_3', INFOT, NOUT, LERR, OK )
  411. INFOT = 2
  412. CALL SSYTRI_3( 'U', -1, A, 1, E, IP, W, 1, INFO )
  413. CALL CHKXER( 'SSYTRI_3', INFOT, NOUT, LERR, OK )
  414. INFOT = 4
  415. CALL SSYTRI_3( 'U', 2, A, 1, E, IP, W, 1, INFO )
  416. CALL CHKXER( 'SSYTRI_3', INFOT, NOUT, LERR, OK )
  417. INFOT = 8
  418. CALL SSYTRI_3( 'U', 0, A, 1, E, IP, W, 0, INFO )
  419. CALL CHKXER( 'SSYTRI_3', INFOT, NOUT, LERR, OK )
  420. INFOT = 8
  421. CALL SSYTRI_3( 'U', 0, A, 1, E, IP, W, -2, INFO )
  422. CALL CHKXER( 'SSYTRI_3', INFOT, NOUT, LERR, OK )
  423. *
  424. * SSYTRI_3X
  425. *
  426. SRNAMT = 'SSYTRI_3X'
  427. INFOT = 1
  428. CALL SSYTRI_3X( '/', 0, A, 1, E, IP, W, 1, INFO )
  429. CALL CHKXER( 'SSYTRI_3X', INFOT, NOUT, LERR, OK )
  430. INFOT = 2
  431. CALL SSYTRI_3X( 'U', -1, A, 1, E, IP, W, 1, INFO )
  432. CALL CHKXER( 'SSYTRI_3X', INFOT, NOUT, LERR, OK )
  433. INFOT = 4
  434. CALL SSYTRI_3X( 'U', 2, A, 1, E, IP, W, 1, INFO )
  435. CALL CHKXER( 'SSYTRI_3X', INFOT, NOUT, LERR, OK )
  436. *
  437. * SSYTRS_3
  438. *
  439. SRNAMT = 'SSYTRS_3'
  440. INFOT = 1
  441. CALL SSYTRS_3( '/', 0, 0, A, 1, E, IP, B, 1, INFO )
  442. CALL CHKXER( 'SSYTRS_3', INFOT, NOUT, LERR, OK )
  443. INFOT = 2
  444. CALL SSYTRS_3( 'U', -1, 0, A, 1, E, IP, B, 1, INFO )
  445. CALL CHKXER( 'SSYTRS_3', INFOT, NOUT, LERR, OK )
  446. INFOT = 3
  447. CALL SSYTRS_3( 'U', 0, -1, A, 1, E, IP, B, 1, INFO )
  448. CALL CHKXER( 'SSYTRS_3', INFOT, NOUT, LERR, OK )
  449. INFOT = 5
  450. CALL SSYTRS_3( 'U', 2, 1, A, 1, E, IP, B, 2, INFO )
  451. CALL CHKXER( 'SSYTRS_3', INFOT, NOUT, LERR, OK )
  452. INFOT = 9
  453. CALL SSYTRS_3( 'U', 2, 1, A, 2, E, IP, B, 1, INFO )
  454. CALL CHKXER( 'SSYTRS_3', INFOT, NOUT, LERR, OK )
  455. *
  456. * SSYCON_3
  457. *
  458. SRNAMT = 'SSYCON_3'
  459. INFOT = 1
  460. CALL SSYCON_3( '/', 0, A, 1, E, IP, ANRM, RCOND, W, IW,
  461. $ INFO )
  462. CALL CHKXER( 'SSYCON_3', INFOT, NOUT, LERR, OK )
  463. INFOT = 2
  464. CALL SSYCON_3( 'U', -1, A, 1, E, IP, ANRM, RCOND, W, IW,
  465. $ INFO )
  466. CALL CHKXER( 'SSYCON_3', INFOT, NOUT, LERR, OK )
  467. INFOT = 4
  468. CALL SSYCON_3( 'U', 2, A, 1, E, IP, ANRM, RCOND, W, IW,
  469. $ INFO )
  470. CALL CHKXER( 'SSYCON_3', INFOT, NOUT, LERR, OK )
  471. INFOT = 7
  472. CALL SSYCON_3( 'U', 1, A, 1, E, IP, -1.0E0, RCOND, W, IW,
  473. $ INFO)
  474. CALL CHKXER( 'SSYCON_3', INFOT, NOUT, LERR, OK )
  475. *
  476. ELSE IF( LSAMEN( 2, C2, 'SA' ) ) THEN
  477. *
  478. * Test error exits of the routines that use factorization
  479. * of a symmetric indefinite matrix with Aasen's algorithm.
  480. *
  481. * SSYTRF_AA
  482. *
  483. SRNAMT = 'SSYTRF_AA'
  484. INFOT = 1
  485. CALL SSYTRF_AA( '/', 0, A, 1, IP, W, 1, INFO )
  486. CALL CHKXER( 'SSYTRF_AA', INFOT, NOUT, LERR, OK )
  487. INFOT = 2
  488. CALL SSYTRF_AA( 'U', -1, A, 1, IP, W, 1, INFO )
  489. CALL CHKXER( 'SSYTRF_AA', INFOT, NOUT, LERR, OK )
  490. INFOT = 4
  491. CALL SSYTRF_AA( 'U', 2, A, 1, IP, W, 4, INFO )
  492. CALL CHKXER( 'SSYTRF_AA', INFOT, NOUT, LERR, OK )
  493. INFOT = 7
  494. CALL SSYTRF_AA( 'U', 0, A, 1, IP, W, 0, INFO )
  495. CALL CHKXER( 'SSYTRF_AA', INFOT, NOUT, LERR, OK )
  496. INFOT = 7
  497. CALL SSYTRF_AA( 'U', 0, A, 1, IP, W, -2, INFO )
  498. CALL CHKXER( 'SSYTRF_AA', INFOT, NOUT, LERR, OK )
  499. *
  500. * SSYTRS_AA
  501. *
  502. SRNAMT = 'SSYTRS_AA'
  503. INFOT = 1
  504. CALL SSYTRS_AA( '/', 0, 0, A, 1, IP, B, 1, W, 1, INFO )
  505. CALL CHKXER( 'SSYTRS_AA', INFOT, NOUT, LERR, OK )
  506. INFOT = 2
  507. CALL SSYTRS_AA( 'U', -1, 0, A, 1, IP, B, 1, W, 1, INFO )
  508. CALL CHKXER( 'SSYTRS_AA', INFOT, NOUT, LERR, OK )
  509. INFOT = 3
  510. CALL SSYTRS_AA( 'U', 0, -1, A, 1, IP, B, 1, W, 1, INFO )
  511. CALL CHKXER( 'SSYTRS_AA', INFOT, NOUT, LERR, OK )
  512. INFOT = 5
  513. CALL SSYTRS_AA( 'U', 2, 1, A, 1, IP, B, 2, W, 1, INFO )
  514. CALL CHKXER( 'SSYTRS_AA', INFOT, NOUT, LERR, OK )
  515. INFOT = 8
  516. CALL SSYTRS_AA( 'U', 2, 1, A, 2, IP, B, 1, W, 1, INFO )
  517. CALL CHKXER( 'SSYTRS_AA', INFOT, NOUT, LERR, OK )
  518. INFOT = 10
  519. CALL SSYTRS_AA( 'U', 0, 1, A, 2, IP, B, 1, W, 0, INFO )
  520. CALL CHKXER( 'SSYTRS_AA', INFOT, NOUT, LERR, OK )
  521. INFOT = 10
  522. CALL SSYTRS_AA( 'U', 0, 1, A, 2, IP, B, 1, W, -2, INFO )
  523. CALL CHKXER( 'SSYTRS_AA', INFOT, NOUT, LERR, OK )
  524. ELSE IF( LSAMEN( 2, C2, 'S2' ) ) THEN
  525. *
  526. * Test error exits of the routines that use factorization
  527. * of a symmetric indefinite matrix with Aasen's algorithm.
  528. *
  529. * SSYTRF_AA_2STAGE
  530. *
  531. SRNAMT = 'SSYTRF_AA_2STAGE'
  532. INFOT = 1
  533. CALL SSYTRF_AA_2STAGE( '/', 0, A, 1, A, 1, IP, IP, W, 1,
  534. $ INFO )
  535. CALL CHKXER( 'SSYTRF_AA_2STAGE', INFOT, NOUT, LERR, OK )
  536. INFOT = 2
  537. CALL SSYTRF_AA_2STAGE( 'U', -1, A, 1, A, 1, IP, IP, W, 1,
  538. $ INFO )
  539. CALL CHKXER( 'SSYTRF_AA_2STAGE', INFOT, NOUT, LERR, OK )
  540. INFOT = 4
  541. CALL SSYTRF_AA_2STAGE( 'U', 2, A, 1, A, 2, IP, IP, W, 1,
  542. $ INFO )
  543. CALL CHKXER( 'SSYTRF_AA_2STAGE', INFOT, NOUT, LERR, OK )
  544. INFOT = 6
  545. CALL SSYTRF_AA_2STAGE( 'U', 2, A, 2, A, 1, IP, IP, W, 1,
  546. $ INFO )
  547. CALL CHKXER( 'SSYTRF_AA_2STAGE', INFOT, NOUT, LERR, OK )
  548. INFOT = 10
  549. CALL SSYTRF_AA_2STAGE( 'U', 2, A, 2, A, 8, IP, IP, W, 0,
  550. $ INFO )
  551. CALL CHKXER( 'SSYTRF_AA_2STAGE', INFOT, NOUT, LERR, OK )
  552. *
  553. * SSYTRS_AA_2STAGE
  554. *
  555. SRNAMT = 'SSYTRS_AA_2STAGE'
  556. INFOT = 1
  557. CALL SSYTRS_AA_2STAGE( '/', 0, 0, A, 1, A, 1, IP, IP,
  558. $ B, 1, INFO )
  559. CALL CHKXER( 'SSYTRS_AA_2STAGE', INFOT, NOUT, LERR, OK )
  560. INFOT = 2
  561. CALL SSYTRS_AA_2STAGE( 'U', -1, 0, A, 1, A, 1, IP, IP,
  562. $ B, 1, INFO )
  563. CALL CHKXER( 'SSYTRS_AA_2STAGE', INFOT, NOUT, LERR, OK )
  564. INFOT = 3
  565. CALL SSYTRS_AA_2STAGE( 'U', 0, -1, A, 1, A, 1, IP, IP,
  566. $ B, 1, INFO )
  567. CALL CHKXER( 'SSYTRS_AA_2STAGE', INFOT, NOUT, LERR, OK )
  568. INFOT = 5
  569. CALL SSYTRS_AA_2STAGE( 'U', 2, 1, A, 1, A, 1, IP, IP,
  570. $ B, 1, INFO )
  571. CALL CHKXER( 'SSYTRS_AA_2STAGE', INFOT, NOUT, LERR, OK )
  572. INFOT = 7
  573. CALL SSYTRS_AA_2STAGE( 'U', 2, 1, A, 2, A, 1, IP, IP,
  574. $ B, 1, INFO )
  575. CALL CHKXER( 'SSYTRS_AA_2STAGE', INFOT, NOUT, LERR, OK )
  576. INFOT = 11
  577. CALL SSYTRS_AA_2STAGE( 'U', 2, 1, A, 2, A, 8, IP, IP,
  578. $ B, 1, INFO )
  579. CALL CHKXER( 'SSYTRS_AA_STAGE', INFOT, NOUT, LERR, OK )
  580. *
  581. ELSE IF( LSAMEN( 2, C2, 'SP' ) ) THEN
  582. *
  583. * Test error exits of the routines that use factorization
  584. * of a symmetric indefinite packed matrix with patrial
  585. * (Bunch-Kaufman) pivoting.
  586. *
  587. * SSPTRF
  588. *
  589. SRNAMT = 'SSPTRF'
  590. INFOT = 1
  591. CALL SSPTRF( '/', 0, A, IP, INFO )
  592. CALL CHKXER( 'SSPTRF', INFOT, NOUT, LERR, OK )
  593. INFOT = 2
  594. CALL SSPTRF( 'U', -1, A, IP, INFO )
  595. CALL CHKXER( 'SSPTRF', INFOT, NOUT, LERR, OK )
  596. *
  597. * SSPTRI
  598. *
  599. SRNAMT = 'SSPTRI'
  600. INFOT = 1
  601. CALL SSPTRI( '/', 0, A, IP, W, INFO )
  602. CALL CHKXER( 'SSPTRI', INFOT, NOUT, LERR, OK )
  603. INFOT = 2
  604. CALL SSPTRI( 'U', -1, A, IP, W, INFO )
  605. CALL CHKXER( 'SSPTRI', INFOT, NOUT, LERR, OK )
  606. *
  607. * SSPTRS
  608. *
  609. SRNAMT = 'SSPTRS'
  610. INFOT = 1
  611. CALL SSPTRS( '/', 0, 0, A, IP, B, 1, INFO )
  612. CALL CHKXER( 'SSPTRS', INFOT, NOUT, LERR, OK )
  613. INFOT = 2
  614. CALL SSPTRS( 'U', -1, 0, A, IP, B, 1, INFO )
  615. CALL CHKXER( 'SSPTRS', INFOT, NOUT, LERR, OK )
  616. INFOT = 3
  617. CALL SSPTRS( 'U', 0, -1, A, IP, B, 1, INFO )
  618. CALL CHKXER( 'SSPTRS', INFOT, NOUT, LERR, OK )
  619. INFOT = 7
  620. CALL SSPTRS( 'U', 2, 1, A, IP, B, 1, INFO )
  621. CALL CHKXER( 'SSPTRS', INFOT, NOUT, LERR, OK )
  622. *
  623. * SSPRFS
  624. *
  625. SRNAMT = 'SSPRFS'
  626. INFOT = 1
  627. CALL SSPRFS( '/', 0, 0, A, AF, IP, B, 1, X, 1, R1, R2, W, IW,
  628. $ INFO )
  629. CALL CHKXER( 'SSPRFS', INFOT, NOUT, LERR, OK )
  630. INFOT = 2
  631. CALL SSPRFS( 'U', -1, 0, A, AF, IP, B, 1, X, 1, R1, R2, W, IW,
  632. $ INFO )
  633. CALL CHKXER( 'SSPRFS', INFOT, NOUT, LERR, OK )
  634. INFOT = 3
  635. CALL SSPRFS( 'U', 0, -1, A, AF, IP, B, 1, X, 1, R1, R2, W, IW,
  636. $ INFO )
  637. CALL CHKXER( 'SSPRFS', INFOT, NOUT, LERR, OK )
  638. INFOT = 8
  639. CALL SSPRFS( 'U', 2, 1, A, AF, IP, B, 1, X, 2, R1, R2, W, IW,
  640. $ INFO )
  641. CALL CHKXER( 'SSPRFS', INFOT, NOUT, LERR, OK )
  642. INFOT = 10
  643. CALL SSPRFS( 'U', 2, 1, A, AF, IP, B, 2, X, 1, R1, R2, W, IW,
  644. $ INFO )
  645. CALL CHKXER( 'SSPRFS', INFOT, NOUT, LERR, OK )
  646. *
  647. * SSPCON
  648. *
  649. SRNAMT = 'SSPCON'
  650. INFOT = 1
  651. CALL SSPCON( '/', 0, A, IP, ANRM, RCOND, W, IW, INFO )
  652. CALL CHKXER( 'SSPCON', INFOT, NOUT, LERR, OK )
  653. INFOT = 2
  654. CALL SSPCON( 'U', -1, A, IP, ANRM, RCOND, W, IW, INFO )
  655. CALL CHKXER( 'SSPCON', INFOT, NOUT, LERR, OK )
  656. INFOT = 5
  657. CALL SSPCON( 'U', 1, A, IP, -1.0, RCOND, W, IW, INFO )
  658. CALL CHKXER( 'SSPCON', INFOT, NOUT, LERR, OK )
  659. END IF
  660. *
  661. * Print a summary line.
  662. *
  663. CALL ALAESM( PATH, OK, NOUT )
  664. *
  665. RETURN
  666. *
  667. * End of SERRSY
  668. *
  669. END