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

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