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.

serrsyx.f 22 kB

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