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 24 kB

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