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.

zerrsyx.f 22 kB

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