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.

zerrhex.f 22 kB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614
  1. *> \brief \b ZERRHEX
  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. *>
  27. *> Note that this file is used only when the XBLAS are available,
  28. *> otherwise zerrhe.f defines this subroutine.
  29. *> \endverbatim
  30. *
  31. * Arguments:
  32. * ==========
  33. *
  34. *> \param[in] PATH
  35. *> \verbatim
  36. *> PATH is CHARACTER*3
  37. *> The LAPACK path name for the routines to be tested.
  38. *> \endverbatim
  39. *>
  40. *> \param[in] NUNIT
  41. *> \verbatim
  42. *> NUNIT is INTEGER
  43. *> The unit number for output.
  44. *> \endverbatim
  45. *
  46. * Authors:
  47. * ========
  48. *
  49. *> \author Univ. of Tennessee
  50. *> \author Univ. of California Berkeley
  51. *> \author Univ. of Colorado Denver
  52. *> \author NAG Ltd.
  53. *
  54. *> \ingroup complex16_lin
  55. *
  56. * =====================================================================
  57. SUBROUTINE ZERRHE( PATH, NUNIT )
  58. *
  59. * -- LAPACK test routine --
  60. * -- LAPACK is a software package provided by Univ. of Tennessee, --
  61. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  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 EQ
  77. CHARACTER*2 C2
  78. INTEGER I, INFO, J, N_ERR_BNDS, NPARAMS
  79. DOUBLE PRECISION ANRM, RCOND, BERR
  80. * ..
  81. * .. Local Arrays ..
  82. INTEGER IP( NMAX )
  83. DOUBLE PRECISION R( NMAX ), R1( NMAX ), R2( NMAX ),
  84. $ S( NMAX ), ERR_BNDS_N( NMAX, 3 ),
  85. $ ERR_BNDS_C( NMAX, 3 ), PARAMS( 1 )
  86. COMPLEX*16 A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
  87. $ E( NMAX ), W( 2*NMAX ), X( NMAX )
  88. * ..
  89. * .. External Functions ..
  90. LOGICAL LSAMEN
  91. EXTERNAL LSAMEN
  92. * ..
  93. * .. External Subroutines ..
  94. EXTERNAL ALAESM, CHKXER, ZHECON, ZHECON_3, ZHECON_ROOK,
  95. $ ZHERFS, ZHETF2, ZHETF2_RK, ZHETF2_ROOK, ZHETRF,
  96. $ ZHETRF_RK, ZHETRF_ROOK, ZHETRI, ZHETRI_3,
  97. $ ZHETRI_3X, ZHETRI_ROOK, ZHETRI2, ZHETRI2X,
  98. $ ZHETRS, ZHETRS_3, ZHETRS_ROOK, ZHPCON,
  99. $ ZHPRFS, ZHPTRF, ZHPTRI, ZHPTRS, ZHERFSX
  100. * ..
  101. * .. Scalars in Common ..
  102. LOGICAL LERR, OK
  103. CHARACTER*32 SRNAMT
  104. INTEGER INFOT, NOUT
  105. * ..
  106. * .. Common blocks ..
  107. COMMON / INFOC / INFOT, NOUT, OK, LERR
  108. COMMON / SRNAMC / SRNAMT
  109. * ..
  110. * .. Intrinsic Functions ..
  111. INTRINSIC DBLE, DCMPLX
  112. * ..
  113. * .. Executable Statements ..
  114. *
  115. NOUT = NUNIT
  116. WRITE( NOUT, FMT = * )
  117. C2 = PATH( 2: 3 )
  118. *
  119. * Set the variables to innocuous values.
  120. *
  121. DO 20 J = 1, NMAX
  122. DO 10 I = 1, NMAX
  123. A( I, J ) = DCMPLX( 1.D0 / DBLE( I+J ),
  124. $ -1.D0 / DBLE( I+J ) )
  125. AF( I, J ) = DCMPLX( 1.D0 / DBLE( I+J ),
  126. $ -1.D0 / DBLE( I+J ) )
  127. 10 CONTINUE
  128. B( J ) = 0.D0
  129. E( J ) = 0.D0
  130. R1( J ) = 0.D0
  131. R2( J ) = 0.D0
  132. W( J ) = 0.D0
  133. X( J ) = 0.D0
  134. S( J ) = 0.D0
  135. IP( J ) = J
  136. 20 CONTINUE
  137. ANRM = 1.0D0
  138. OK = .TRUE.
  139. *
  140. * Test error exits of the routines that use factorization
  141. * of a Hermitian indefinite matrix with partial
  142. * (Bunch-Kaufman) diagonal pivoting method.
  143. *
  144. IF( LSAMEN( 2, C2, 'HE' ) ) THEN
  145. *
  146. * ZHETRF
  147. *
  148. SRNAMT = 'ZHETRF'
  149. INFOT = 1
  150. CALL ZHETRF( '/', 0, A, 1, IP, W, 1, INFO )
  151. CALL CHKXER( 'ZHETRF', INFOT, NOUT, LERR, OK )
  152. INFOT = 2
  153. CALL ZHETRF( 'U', -1, A, 1, IP, W, 1, INFO )
  154. CALL CHKXER( 'ZHETRF', INFOT, NOUT, LERR, OK )
  155. INFOT = 4
  156. CALL ZHETRF( 'U', 2, A, 1, IP, W, 4, INFO )
  157. CALL CHKXER( 'ZHETRF', INFOT, NOUT, LERR, OK )
  158. INFOT = 7
  159. CALL ZHETRF( 'U', 0, A, 1, IP, W, 0, INFO )
  160. CALL CHKXER( 'ZHETRF', INFOT, NOUT, LERR, OK )
  161. INFOT = 7
  162. CALL ZHETRF( 'U', 0, A, 1, IP, W, -2, INFO )
  163. CALL CHKXER( 'ZHETRF', INFOT, NOUT, LERR, OK )
  164. *
  165. * ZHETF2
  166. *
  167. SRNAMT = 'ZHETF2'
  168. INFOT = 1
  169. CALL ZHETF2( '/', 0, A, 1, IP, INFO )
  170. CALL CHKXER( 'ZHETF2', INFOT, NOUT, LERR, OK )
  171. INFOT = 2
  172. CALL ZHETF2( 'U', -1, A, 1, IP, INFO )
  173. CALL CHKXER( 'ZHETF2', INFOT, NOUT, LERR, OK )
  174. INFOT = 4
  175. CALL ZHETF2( 'U', 2, A, 1, IP, INFO )
  176. CALL CHKXER( 'ZHETF2', INFOT, NOUT, LERR, OK )
  177. *
  178. * ZHETRI
  179. *
  180. SRNAMT = 'ZHETRI'
  181. INFOT = 1
  182. CALL ZHETRI( '/', 0, A, 1, IP, W, INFO )
  183. CALL CHKXER( 'ZHETRI', INFOT, NOUT, LERR, OK )
  184. INFOT = 2
  185. CALL ZHETRI( 'U', -1, A, 1, IP, W, INFO )
  186. CALL CHKXER( 'ZHETRI', INFOT, NOUT, LERR, OK )
  187. INFOT = 4
  188. CALL ZHETRI( 'U', 2, A, 1, IP, W, INFO )
  189. CALL CHKXER( 'ZHETRI', INFOT, NOUT, LERR, OK )
  190. *
  191. * ZHETRI2
  192. *
  193. SRNAMT = 'ZHETRI2'
  194. INFOT = 1
  195. CALL ZHETRI2( '/', 0, A, 1, IP, W, 1, INFO )
  196. CALL CHKXER( 'ZHETRI2', INFOT, NOUT, LERR, OK )
  197. INFOT = 2
  198. CALL ZHETRI2( 'U', -1, A, 1, IP, W, 1, INFO )
  199. CALL CHKXER( 'ZHETRI2', INFOT, NOUT, LERR, OK )
  200. INFOT = 4
  201. CALL ZHETRI2( 'U', 2, A, 1, IP, W, 1, INFO )
  202. CALL CHKXER( 'ZHETRI2', INFOT, NOUT, LERR, OK )
  203. *
  204. * ZHETRI2X
  205. *
  206. SRNAMT = 'ZHETRI2X'
  207. INFOT = 1
  208. CALL ZHETRI2X( '/', 0, A, 1, IP, W, 1, INFO )
  209. CALL CHKXER( 'ZHETRI2X', INFOT, NOUT, LERR, OK )
  210. INFOT = 2
  211. CALL ZHETRI2X( 'U', -1, A, 1, IP, W, 1, INFO )
  212. CALL CHKXER( 'ZHETRI2X', INFOT, NOUT, LERR, OK )
  213. INFOT = 4
  214. CALL ZHETRI2X( 'U', 2, A, 1, IP, W, 1, INFO )
  215. CALL CHKXER( 'ZHETRI2X', INFOT, NOUT, LERR, OK )
  216. *
  217. * ZHETRS
  218. *
  219. SRNAMT = 'ZHETRS'
  220. INFOT = 1
  221. CALL ZHETRS( '/', 0, 0, A, 1, IP, B, 1, INFO )
  222. CALL CHKXER( 'ZHETRS', INFOT, NOUT, LERR, OK )
  223. INFOT = 2
  224. CALL ZHETRS( 'U', -1, 0, A, 1, IP, B, 1, INFO )
  225. CALL CHKXER( 'ZHETRS', INFOT, NOUT, LERR, OK )
  226. INFOT = 3
  227. CALL ZHETRS( 'U', 0, -1, A, 1, IP, B, 1, INFO )
  228. CALL CHKXER( 'ZHETRS', INFOT, NOUT, LERR, OK )
  229. INFOT = 5
  230. CALL ZHETRS( 'U', 2, 1, A, 1, IP, B, 2, INFO )
  231. CALL CHKXER( 'ZHETRS', INFOT, NOUT, LERR, OK )
  232. INFOT = 8
  233. CALL ZHETRS( 'U', 2, 1, A, 2, IP, B, 1, INFO )
  234. CALL CHKXER( 'ZHETRS', INFOT, NOUT, LERR, OK )
  235. *
  236. * ZHERFS
  237. *
  238. SRNAMT = 'ZHERFS'
  239. INFOT = 1
  240. CALL ZHERFS( '/', 0, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, W,
  241. $ R, INFO )
  242. CALL CHKXER( 'ZHERFS', INFOT, NOUT, LERR, OK )
  243. INFOT = 2
  244. CALL ZHERFS( 'U', -1, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2,
  245. $ W, R, INFO )
  246. CALL CHKXER( 'ZHERFS', INFOT, NOUT, LERR, OK )
  247. INFOT = 3
  248. CALL ZHERFS( 'U', 0, -1, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2,
  249. $ W, R, INFO )
  250. CALL CHKXER( 'ZHERFS', INFOT, NOUT, LERR, OK )
  251. INFOT = 5
  252. CALL ZHERFS( 'U', 2, 1, A, 1, AF, 2, IP, B, 2, X, 2, R1, R2, W,
  253. $ R, INFO )
  254. CALL CHKXER( 'ZHERFS', INFOT, NOUT, LERR, OK )
  255. INFOT = 7
  256. CALL ZHERFS( 'U', 2, 1, A, 2, AF, 1, IP, B, 2, X, 2, R1, R2, W,
  257. $ R, INFO )
  258. CALL CHKXER( 'ZHERFS', INFOT, NOUT, LERR, OK )
  259. INFOT = 10
  260. CALL ZHERFS( 'U', 2, 1, A, 2, AF, 2, IP, B, 1, X, 2, R1, R2, W,
  261. $ R, INFO )
  262. CALL CHKXER( 'ZHERFS', INFOT, NOUT, LERR, OK )
  263. INFOT = 12
  264. CALL ZHERFS( 'U', 2, 1, A, 2, AF, 2, IP, B, 2, X, 1, R1, R2, W,
  265. $ R, INFO )
  266. CALL CHKXER( 'ZHERFS', INFOT, NOUT, LERR, OK )
  267. *
  268. * ZHERFSX
  269. *
  270. N_ERR_BNDS = 3
  271. NPARAMS = 0
  272. SRNAMT = 'ZHERFSX'
  273. INFOT = 1
  274. CALL ZHERFSX( '/', EQ, 0, 0, A, 1, AF, 1, IP, S, B, 1, X, 1,
  275. $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS,
  276. $ PARAMS, W, R, INFO )
  277. CALL CHKXER( 'ZHERFSX', INFOT, NOUT, LERR, OK )
  278. INFOT = 2
  279. CALL ZHERFSX( 'U', EQ, -1, 0, A, 1, AF, 1, IP, S, B, 1, X, 1,
  280. $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS,
  281. $ PARAMS, W, R, INFO )
  282. CALL CHKXER( 'ZHERFSX', INFOT, NOUT, LERR, OK )
  283. EQ = 'N'
  284. INFOT = 3
  285. CALL ZHERFSX( 'U', EQ, -1, 0, A, 1, AF, 1, IP, S, B, 1, X, 1,
  286. $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS,
  287. $ PARAMS, W, R, INFO )
  288. CALL CHKXER( 'ZHERFSX', INFOT, NOUT, LERR, OK )
  289. INFOT = 4
  290. CALL ZHERFSX( 'U', EQ, 0, -1, A, 1, AF, 1, IP, S, B, 1, X, 1,
  291. $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS,
  292. $ PARAMS, W, R, INFO )
  293. CALL CHKXER( 'ZHERFSX', INFOT, NOUT, LERR, OK )
  294. INFOT = 6
  295. CALL ZHERFSX( 'U', EQ, 2, 1, A, 1, AF, 2, IP, S, B, 2, X, 2,
  296. $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS,
  297. $ PARAMS, W, R, INFO )
  298. CALL CHKXER( 'ZHERFSX', INFOT, NOUT, LERR, OK )
  299. INFOT = 8
  300. CALL ZHERFSX( 'U', EQ, 2, 1, A, 2, AF, 1, IP, S, B, 2, X, 2,
  301. $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS,
  302. $ PARAMS, W, R, INFO )
  303. CALL CHKXER( 'ZHERFSX', INFOT, NOUT, LERR, OK )
  304. INFOT = 12
  305. CALL ZHERFSX( 'U', EQ, 2, 1, A, 2, AF, 2, IP, S, B, 1, X, 2,
  306. $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS,
  307. $ PARAMS, W, R, INFO )
  308. CALL CHKXER( 'ZHERFSX', INFOT, NOUT, LERR, OK )
  309. INFOT = 14
  310. CALL ZHERFSX( 'U', EQ, 2, 1, A, 2, AF, 2, IP, S, B, 2, X, 1,
  311. $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS,
  312. $ PARAMS, W, R, INFO )
  313. CALL CHKXER( 'ZHERFSX', INFOT, NOUT, LERR, OK )
  314. *
  315. * ZHECON
  316. *
  317. SRNAMT = 'ZHECON'
  318. INFOT = 1
  319. CALL ZHECON( '/', 0, A, 1, IP, ANRM, RCOND, W, INFO )
  320. CALL CHKXER( 'ZHECON', INFOT, NOUT, LERR, OK )
  321. INFOT = 2
  322. CALL ZHECON( 'U', -1, A, 1, IP, ANRM, RCOND, W, INFO )
  323. CALL CHKXER( 'ZHECON', INFOT, NOUT, LERR, OK )
  324. INFOT = 4
  325. CALL ZHECON( 'U', 2, A, 1, IP, ANRM, RCOND, W, INFO )
  326. CALL CHKXER( 'ZHECON', INFOT, NOUT, LERR, OK )
  327. INFOT = 6
  328. CALL ZHECON( 'U', 1, A, 1, IP, -ANRM, RCOND, W, INFO )
  329. CALL CHKXER( 'ZHECON', INFOT, NOUT, LERR, OK )
  330. *
  331. ELSE IF( LSAMEN( 2, C2, 'HR' ) ) THEN
  332. *
  333. * Test error exits of the routines that use factorization
  334. * of a Hermitian indefinite matrix with rook
  335. * (bounded Bunch-Kaufman) diagonal pivoting method.
  336. *
  337. * ZHETRF_ROOK
  338. *
  339. SRNAMT = 'ZHETRF_ROOK'
  340. INFOT = 1
  341. CALL ZHETRF_ROOK( '/', 0, A, 1, IP, W, 1, INFO )
  342. CALL CHKXER( 'ZHETRF_ROOK', INFOT, NOUT, LERR, OK )
  343. INFOT = 2
  344. CALL ZHETRF_ROOK( 'U', -1, A, 1, IP, W, 1, INFO )
  345. CALL CHKXER( 'ZHETRF_ROOK', INFOT, NOUT, LERR, OK )
  346. INFOT = 4
  347. CALL ZHETRF_ROOK( 'U', 2, A, 1, IP, W, 4, INFO )
  348. CALL CHKXER( 'ZHETRF_ROOK', INFOT, NOUT, LERR, OK )
  349. INFOT = 7
  350. CALL ZHETRF_ROOK( 'U', 0, A, 1, IP, W, 0, INFO )
  351. CALL CHKXER( 'ZHETRF_ROOK', INFOT, NOUT, LERR, OK )
  352. INFOT = 7
  353. CALL ZHETRF_ROOK( 'U', 0, A, 1, IP, W, -2, INFO )
  354. CALL CHKXER( 'ZHETRF_ROOK', INFOT, NOUT, LERR, OK )
  355. *
  356. * ZHETF2_ROOK
  357. *
  358. SRNAMT = 'ZHETF2_ROOK'
  359. INFOT = 1
  360. CALL ZHETF2_ROOK( '/', 0, A, 1, IP, INFO )
  361. CALL CHKXER( 'ZHETF2_ROOK', INFOT, NOUT, LERR, OK )
  362. INFOT = 2
  363. CALL ZHETF2_ROOK( 'U', -1, A, 1, IP, INFO )
  364. CALL CHKXER( 'ZHETF2_ROOK', INFOT, NOUT, LERR, OK )
  365. INFOT = 4
  366. CALL ZHETF2_ROOK( 'U', 2, A, 1, IP, INFO )
  367. CALL CHKXER( 'ZHETF2_ROOK', INFOT, NOUT, LERR, OK )
  368. *
  369. * ZHETRI_ROOK
  370. *
  371. SRNAMT = 'ZHETRI_ROOK'
  372. INFOT = 1
  373. CALL ZHETRI_ROOK( '/', 0, A, 1, IP, W, INFO )
  374. CALL CHKXER( 'ZHETRI_ROOK', INFOT, NOUT, LERR, OK )
  375. INFOT = 2
  376. CALL ZHETRI_ROOK( 'U', -1, A, 1, IP, W, INFO )
  377. CALL CHKXER( 'ZHETRI_ROOK', INFOT, NOUT, LERR, OK )
  378. INFOT = 4
  379. CALL ZHETRI_ROOK( 'U', 2, A, 1, IP, W, INFO )
  380. CALL CHKXER( 'ZHETRI_ROOK', INFOT, NOUT, LERR, OK )
  381. *
  382. * ZHETRS_ROOK
  383. *
  384. SRNAMT = 'ZHETRS_ROOK'
  385. INFOT = 1
  386. CALL ZHETRS_ROOK( '/', 0, 0, A, 1, IP, B, 1, INFO )
  387. CALL CHKXER( 'ZHETRS_ROOK', INFOT, NOUT, LERR, OK )
  388. INFOT = 2
  389. CALL ZHETRS_ROOK( 'U', -1, 0, A, 1, IP, B, 1, INFO )
  390. CALL CHKXER( 'ZHETRS_ROOK', INFOT, NOUT, LERR, OK )
  391. INFOT = 3
  392. CALL ZHETRS_ROOK( 'U', 0, -1, A, 1, IP, B, 1, INFO )
  393. CALL CHKXER( 'ZHETRS_ROOK', INFOT, NOUT, LERR, OK )
  394. INFOT = 5
  395. CALL ZHETRS_ROOK( 'U', 2, 1, A, 1, IP, B, 2, INFO )
  396. CALL CHKXER( 'ZHETRS_ROOK', INFOT, NOUT, LERR, OK )
  397. INFOT = 8
  398. CALL ZHETRS_ROOK( 'U', 2, 1, A, 2, IP, B, 1, INFO )
  399. CALL CHKXER( 'ZHETRS_ROOK', INFOT, NOUT, LERR, OK )
  400. *
  401. * ZHECON_ROOK
  402. *
  403. SRNAMT = 'ZHECON_ROOK'
  404. INFOT = 1
  405. CALL ZHECON_ROOK( '/', 0, A, 1, IP, ANRM, RCOND, W, INFO )
  406. CALL CHKXER( 'ZHECON_ROOK', INFOT, NOUT, LERR, OK )
  407. INFOT = 2
  408. CALL ZHECON_ROOK( 'U', -1, A, 1, IP, ANRM, RCOND, W, INFO )
  409. CALL CHKXER( 'ZHECON_ROOK', INFOT, NOUT, LERR, OK )
  410. INFOT = 4
  411. CALL ZHECON_ROOK( 'U', 2, A, 1, IP, ANRM, RCOND, W, INFO )
  412. CALL CHKXER( 'ZHECON_ROOK', INFOT, NOUT, LERR, OK )
  413. INFOT = 6
  414. CALL ZHECON_ROOK( 'U', 1, A, 1, IP, -ANRM, RCOND, W, INFO )
  415. CALL CHKXER( 'ZHECON_ROOK', INFOT, NOUT, LERR, OK )
  416. *
  417. ELSE IF( LSAMEN( 2, C2, 'HK' ) ) THEN
  418. *
  419. * Test error exits of the routines that use factorization
  420. * of a symmetric indefinite matrix with rook
  421. * (bounded Bunch-Kaufman) pivoting with the new storage
  422. * format for factors L ( or U) and D.
  423. *
  424. * L (or U) is stored in A, diagonal of D is stored on the
  425. * diagonal of A, subdiagonal of D is stored in a separate array E.
  426. *
  427. * ZHETRF_RK
  428. *
  429. SRNAMT = 'ZHETRF_RK'
  430. INFOT = 1
  431. CALL ZHETRF_RK( '/', 0, A, 1, E, IP, W, 1, INFO )
  432. CALL CHKXER( 'ZHETRF_RK', INFOT, NOUT, LERR, OK )
  433. INFOT = 2
  434. CALL ZHETRF_RK( 'U', -1, A, 1, E, IP, W, 1, INFO )
  435. CALL CHKXER( 'ZHETRF_RK', INFOT, NOUT, LERR, OK )
  436. INFOT = 4
  437. CALL ZHETRF_RK( 'U', 2, A, 1, E, IP, W, 4, INFO )
  438. CALL CHKXER( 'ZHETRF_RK', INFOT, NOUT, LERR, OK )
  439. INFOT = 8
  440. CALL ZHETRF_RK( 'U', 0, A, 1, E, IP, W, 0, INFO )
  441. CALL CHKXER( 'ZHETRF_RK', INFOT, NOUT, LERR, OK )
  442. INFOT = 8
  443. CALL ZHETRF_RK( 'U', 0, A, 1, E, IP, W, -2, INFO )
  444. CALL CHKXER( 'ZHETRF_RK', INFOT, NOUT, LERR, OK )
  445. *
  446. * ZHETF2_RK
  447. *
  448. SRNAMT = 'ZHETF2_RK'
  449. INFOT = 1
  450. CALL ZHETF2_RK( '/', 0, A, 1, E, IP, INFO )
  451. CALL CHKXER( 'ZHETF2_RK', INFOT, NOUT, LERR, OK )
  452. INFOT = 2
  453. CALL ZHETF2_RK( 'U', -1, A, 1, E, IP, INFO )
  454. CALL CHKXER( 'ZHETF2_RK', INFOT, NOUT, LERR, OK )
  455. INFOT = 4
  456. CALL ZHETF2_RK( 'U', 2, A, 1, E, IP, INFO )
  457. CALL CHKXER( 'ZHETF2_RK', INFOT, NOUT, LERR, OK )
  458. *
  459. * ZHETRI_3
  460. *
  461. SRNAMT = 'ZHETRI_3'
  462. INFOT = 1
  463. CALL ZHETRI_3( '/', 0, A, 1, E, IP, W, 1, INFO )
  464. CALL CHKXER( 'ZHETRI_3', INFOT, NOUT, LERR, OK )
  465. INFOT = 2
  466. CALL ZHETRI_3( 'U', -1, A, 1, E, IP, W, 1, INFO )
  467. CALL CHKXER( 'ZHETRI_3', INFOT, NOUT, LERR, OK )
  468. INFOT = 4
  469. CALL ZHETRI_3( 'U', 2, A, 1, E, IP, W, 1, INFO )
  470. CALL CHKXER( 'ZHETRI_3', INFOT, NOUT, LERR, OK )
  471. INFOT = 8
  472. CALL ZHETRI_3( 'U', 0, A, 1, E, IP, W, 0, INFO )
  473. CALL CHKXER( 'ZHETRI_3', INFOT, NOUT, LERR, OK )
  474. INFOT = 8
  475. CALL ZHETRI_3( 'U', 0, A, 1, E, IP, W, -2, INFO )
  476. CALL CHKXER( 'ZHETRI_3', INFOT, NOUT, LERR, OK )
  477. *
  478. * ZHETRI_3X
  479. *
  480. SRNAMT = 'ZHETRI_3X'
  481. INFOT = 1
  482. CALL ZHETRI_3X( '/', 0, A, 1, E, IP, W, 1, INFO )
  483. CALL CHKXER( 'ZHETRI_3X', INFOT, NOUT, LERR, OK )
  484. INFOT = 2
  485. CALL ZHETRI_3X( 'U', -1, A, 1, E, IP, W, 1, INFO )
  486. CALL CHKXER( 'ZHETRI_3X', INFOT, NOUT, LERR, OK )
  487. INFOT = 4
  488. CALL ZHETRI_3X( 'U', 2, A, 1, E, IP, W, 1, INFO )
  489. CALL CHKXER( 'ZHETRI_3X', INFOT, NOUT, LERR, OK )
  490. *
  491. * ZHETRS_3
  492. *
  493. SRNAMT = 'ZHETRS_3'
  494. INFOT = 1
  495. CALL ZHETRS_3( '/', 0, 0, A, 1, E, IP, B, 1, INFO )
  496. CALL CHKXER( 'ZHETRS_3', INFOT, NOUT, LERR, OK )
  497. INFOT = 2
  498. CALL ZHETRS_3( 'U', -1, 0, A, 1, E, IP, B, 1, INFO )
  499. CALL CHKXER( 'ZHETRS_3', INFOT, NOUT, LERR, OK )
  500. INFOT = 3
  501. CALL ZHETRS_3( 'U', 0, -1, A, 1, E, IP, B, 1, INFO )
  502. CALL CHKXER( 'ZHETRS_3', INFOT, NOUT, LERR, OK )
  503. INFOT = 5
  504. CALL ZHETRS_3( 'U', 2, 1, A, 1, E, IP, B, 2, INFO )
  505. CALL CHKXER( 'ZHETRS_3', INFOT, NOUT, LERR, OK )
  506. INFOT = 9
  507. CALL ZHETRS_3( 'U', 2, 1, A, 2, E, IP, B, 1, INFO )
  508. CALL CHKXER( 'ZHETRS_3', INFOT, NOUT, LERR, OK )
  509. *
  510. * ZHECON_3
  511. *
  512. SRNAMT = 'ZHECON_3'
  513. INFOT = 1
  514. CALL ZHECON_3( '/', 0, A, 1, E, IP, ANRM, RCOND, W, INFO )
  515. CALL CHKXER( 'ZHECON_3', INFOT, NOUT, LERR, OK )
  516. INFOT = 2
  517. CALL ZHECON_3( 'U', -1, A, 1, E, IP, ANRM, RCOND, W, INFO )
  518. CALL CHKXER( 'ZHECON_3', INFOT, NOUT, LERR, OK )
  519. INFOT = 4
  520. CALL ZHECON_3( 'U', 2, A, 1, E, IP, ANRM, RCOND, W, INFO )
  521. CALL CHKXER( 'ZHECON_3', INFOT, NOUT, LERR, OK )
  522. INFOT = 7
  523. CALL ZHECON_3( 'U', 1, A, 1, E, IP, -1.0D0, RCOND, W, INFO)
  524. CALL CHKXER( 'ZHECON_3', INFOT, NOUT, LERR, OK )
  525. *
  526. ELSE IF( LSAMEN( 2, C2, 'HP' ) ) THEN
  527. *
  528. * Test error exits of the routines that use factorization
  529. * of a Hermitian indefinite packed matrix with partial
  530. * (Bunch-Kaufman) diagonal pivoting method.
  531. *
  532. * ZHPTRF
  533. *
  534. SRNAMT = 'ZHPTRF'
  535. INFOT = 1
  536. CALL ZHPTRF( '/', 0, A, IP, INFO )
  537. CALL CHKXER( 'ZHPTRF', INFOT, NOUT, LERR, OK )
  538. INFOT = 2
  539. CALL ZHPTRF( 'U', -1, A, IP, INFO )
  540. CALL CHKXER( 'ZHPTRF', INFOT, NOUT, LERR, OK )
  541. *
  542. * ZHPTRI
  543. *
  544. SRNAMT = 'ZHPTRI'
  545. INFOT = 1
  546. CALL ZHPTRI( '/', 0, A, IP, W, INFO )
  547. CALL CHKXER( 'ZHPTRI', INFOT, NOUT, LERR, OK )
  548. INFOT = 2
  549. CALL ZHPTRI( 'U', -1, A, IP, W, INFO )
  550. CALL CHKXER( 'ZHPTRI', INFOT, NOUT, LERR, OK )
  551. *
  552. * ZHPTRS
  553. *
  554. SRNAMT = 'ZHPTRS'
  555. INFOT = 1
  556. CALL ZHPTRS( '/', 0, 0, A, IP, B, 1, INFO )
  557. CALL CHKXER( 'ZHPTRS', INFOT, NOUT, LERR, OK )
  558. INFOT = 2
  559. CALL ZHPTRS( 'U', -1, 0, A, IP, B, 1, INFO )
  560. CALL CHKXER( 'ZHPTRS', INFOT, NOUT, LERR, OK )
  561. INFOT = 3
  562. CALL ZHPTRS( 'U', 0, -1, A, IP, B, 1, INFO )
  563. CALL CHKXER( 'ZHPTRS', INFOT, NOUT, LERR, OK )
  564. INFOT = 7
  565. CALL ZHPTRS( 'U', 2, 1, A, IP, B, 1, INFO )
  566. CALL CHKXER( 'ZHPTRS', INFOT, NOUT, LERR, OK )
  567. *
  568. * ZHPRFS
  569. *
  570. SRNAMT = 'ZHPRFS'
  571. INFOT = 1
  572. CALL ZHPRFS( '/', 0, 0, A, AF, IP, B, 1, X, 1, R1, R2, W, R,
  573. $ INFO )
  574. CALL CHKXER( 'ZHPRFS', INFOT, NOUT, LERR, OK )
  575. INFOT = 2
  576. CALL ZHPRFS( 'U', -1, 0, A, AF, IP, B, 1, X, 1, R1, R2, W, R,
  577. $ INFO )
  578. CALL CHKXER( 'ZHPRFS', INFOT, NOUT, LERR, OK )
  579. INFOT = 3
  580. CALL ZHPRFS( 'U', 0, -1, A, AF, IP, B, 1, X, 1, R1, R2, W, R,
  581. $ INFO )
  582. CALL CHKXER( 'ZHPRFS', INFOT, NOUT, LERR, OK )
  583. INFOT = 8
  584. CALL ZHPRFS( 'U', 2, 1, A, AF, IP, B, 1, X, 2, R1, R2, W, R,
  585. $ INFO )
  586. CALL CHKXER( 'ZHPRFS', INFOT, NOUT, LERR, OK )
  587. INFOT = 10
  588. CALL ZHPRFS( 'U', 2, 1, A, AF, IP, B, 2, X, 1, R1, R2, W, R,
  589. $ INFO )
  590. CALL CHKXER( 'ZHPRFS', INFOT, NOUT, LERR, OK )
  591. *
  592. * ZHPCON
  593. *
  594. SRNAMT = 'ZHPCON'
  595. INFOT = 1
  596. CALL ZHPCON( '/', 0, A, IP, ANRM, RCOND, W, INFO )
  597. CALL CHKXER( 'ZHPCON', INFOT, NOUT, LERR, OK )
  598. INFOT = 2
  599. CALL ZHPCON( 'U', -1, A, IP, ANRM, RCOND, W, INFO )
  600. CALL CHKXER( 'ZHPCON', INFOT, NOUT, LERR, OK )
  601. INFOT = 5
  602. CALL ZHPCON( 'U', 1, A, IP, -ANRM, RCOND, W, INFO )
  603. CALL CHKXER( 'ZHPCON', INFOT, NOUT, LERR, OK )
  604. END IF
  605. *
  606. * Print a summary line.
  607. *
  608. CALL ALAESM( PATH, OK, NOUT )
  609. *
  610. RETURN
  611. *
  612. * End of ZERRHEX
  613. *
  614. END