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.

zerrhe.f 24 kB

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