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.

cerrsy.f 23 kB

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