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.

cerrhe.f 24 kB

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