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

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