1*> \brief \b CERRHEX 2* 3* =========== DOCUMENTATION =========== 4* 5* Online html documentation available at 6* http://www.netlib.org/lapack/explore-html/ 7* 8* Definition: 9* =========== 10* 11* SUBROUTINE CERRHE( PATH, NUNIT ) 12* 13* .. Scalar Arguments .. 14* CHARACTER*3 PATH 15* INTEGER NUNIT 16* .. 17* 18* 19*> \par Purpose: 20* ============= 21*> 22*> \verbatim 23*> 24*> CERRHE tests the error exits for the COMPLEX routines 25*> for Hermitian indefinite matrices. 26*> 27*> Note that this file is used only when the XBLAS are available, 28*> otherwise cerrhe.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 complex_lin 55* 56* ===================================================================== 57 SUBROUTINE CERRHE( 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 REAL ANRM, RCOND, BERR 80* .. 81* .. Local Arrays .. 82 INTEGER IP( NMAX ) 83 REAL R( NMAX ), R1( NMAX ), R2( NMAX ), 84 $ S( NMAX ), ERR_BNDS_N( NMAX, 3 ), 85 $ ERR_BNDS_C( NMAX, 3 ), PARAMS( 1 ) 86 COMPLEX 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, CHECON, CHECON_3, CHECON_ROOK, CHERFS, 95 $ CHETF2, CHETF2_RK, CHETF2_ROOK, CHETRF, 96 $ CHETRF_RK, CHETRF_ROOK, CHETRI, CHETRI_3, 97 $ CHETRI_3X, CHETRI_ROOK, CHETRI2, CHETRI2X, 98 $ CHETRS, CHETRS_3, CHETRS_ROOK, CHKXER, CHPCON, 99 $ CHPRFS, CHPTRF, CHPTRI, CHPTRS, CHERFSX 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 CMPLX, REAL 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 ) = CMPLX( 1. / REAL( I+J ), -1. / REAL( I+J ) ) 124 AF( I, J ) = CMPLX( 1. / REAL( I+J ), -1. / REAL( I+J ) ) 125 10 CONTINUE 126 B( J ) = 0.E+0 127 E( J ) = 0.E+0 128 R1( J ) = 0.E+0 129 R2( J ) = 0.E+0 130 W( J ) = 0.E+0 131 X( J ) = 0.E+0 132 IP( J ) = J 133 20 CONTINUE 134 ANRM = 1.0 135 OK = .TRUE. 136* 137 IF( LSAMEN( 2, C2, 'HE' ) ) THEN 138* 139* Test error exits of the routines that use factorization 140* of a Hermitian indefinite matrix with patrial 141* (Bunch-Kaufman) diagonal pivoting method. 142* 143* CHETRF 144* 145 SRNAMT = 'CHETRF' 146 INFOT = 1 147 CALL CHETRF( '/', 0, A, 1, IP, W, 1, INFO ) 148 CALL CHKXER( 'CHETRF', INFOT, NOUT, LERR, OK ) 149 INFOT = 2 150 CALL CHETRF( 'U', -1, A, 1, IP, W, 1, INFO ) 151 CALL CHKXER( 'CHETRF', INFOT, NOUT, LERR, OK ) 152 INFOT = 4 153 CALL CHETRF( 'U', 2, A, 1, IP, W, 4, INFO ) 154 CALL CHKXER( 'CHETRF', INFOT, NOUT, LERR, OK ) 155 INFOT = 7 156 CALL CHETRF( 'U', 0, A, 1, IP, W, 0, INFO ) 157 CALL CHKXER( 'CHETRF', INFOT, NOUT, LERR, OK ) 158 INFOT = 7 159 CALL CHETRF( 'U', 0, A, 1, IP, W, -2, INFO ) 160 CALL CHKXER( 'CHETRF', INFOT, NOUT, LERR, OK ) 161* 162* CHETF2 163* 164 SRNAMT = 'CHETF2' 165 INFOT = 1 166 CALL CHETF2( '/', 0, A, 1, IP, INFO ) 167 CALL CHKXER( 'CHETF2', INFOT, NOUT, LERR, OK ) 168 INFOT = 2 169 CALL CHETF2( 'U', -1, A, 1, IP, INFO ) 170 CALL CHKXER( 'CHETF2', INFOT, NOUT, LERR, OK ) 171 INFOT = 4 172 CALL CHETF2( 'U', 2, A, 1, IP, INFO ) 173 CALL CHKXER( 'CHETF2', INFOT, NOUT, LERR, OK ) 174* 175* CHETRI 176* 177 SRNAMT = 'CHETRI' 178 INFOT = 1 179 CALL CHETRI( '/', 0, A, 1, IP, W, INFO ) 180 CALL CHKXER( 'CHETRI', INFOT, NOUT, LERR, OK ) 181 INFOT = 2 182 CALL CHETRI( 'U', -1, A, 1, IP, W, INFO ) 183 CALL CHKXER( 'CHETRI', INFOT, NOUT, LERR, OK ) 184 INFOT = 4 185 CALL CHETRI( 'U', 2, A, 1, IP, W, INFO ) 186 CALL CHKXER( 'CHETRI', INFOT, NOUT, LERR, OK ) 187* 188* CHETRI2 189* 190 SRNAMT = 'CHETRI2' 191 INFOT = 1 192 CALL CHETRI2( '/', 0, A, 1, IP, W, 1, INFO ) 193 CALL CHKXER( 'CHETRI2', INFOT, NOUT, LERR, OK ) 194 INFOT = 2 195 CALL CHETRI2( 'U', -1, A, 1, IP, W, 1, INFO ) 196 CALL CHKXER( 'CHETRI2', INFOT, NOUT, LERR, OK ) 197 INFOT = 4 198 CALL CHETRI2( 'U', 2, A, 1, IP, W, 1, INFO ) 199 CALL CHKXER( 'CHETRI2', INFOT, NOUT, LERR, OK ) 200* 201* CHETRI2X 202* 203 SRNAMT = 'CHETRI2X' 204 INFOT = 1 205 CALL CHETRI2X( '/', 0, A, 1, IP, W, 1, INFO ) 206 CALL CHKXER( 'CHETRI2X', INFOT, NOUT, LERR, OK ) 207 INFOT = 2 208 CALL CHETRI2X( 'U', -1, A, 1, IP, W, 1, INFO ) 209 CALL CHKXER( 'CHETRI2X', INFOT, NOUT, LERR, OK ) 210 INFOT = 4 211 CALL CHETRI2X( 'U', 2, A, 1, IP, W, 1, INFO ) 212 CALL CHKXER( 'CHETRI2X', INFOT, NOUT, LERR, OK ) 213* 214* CHETRS 215* 216 SRNAMT = 'CHETRS' 217 INFOT = 1 218 CALL CHETRS( '/', 0, 0, A, 1, IP, B, 1, INFO ) 219 CALL CHKXER( 'CHETRS', INFOT, NOUT, LERR, OK ) 220 INFOT = 2 221 CALL CHETRS( 'U', -1, 0, A, 1, IP, B, 1, INFO ) 222 CALL CHKXER( 'CHETRS', INFOT, NOUT, LERR, OK ) 223 INFOT = 3 224 CALL CHETRS( 'U', 0, -1, A, 1, IP, B, 1, INFO ) 225 CALL CHKXER( 'CHETRS', INFOT, NOUT, LERR, OK ) 226 INFOT = 5 227 CALL CHETRS( 'U', 2, 1, A, 1, IP, B, 2, INFO ) 228 CALL CHKXER( 'CHETRS', INFOT, NOUT, LERR, OK ) 229 INFOT = 8 230 CALL CHETRS( 'U', 2, 1, A, 2, IP, B, 1, INFO ) 231 CALL CHKXER( 'CHETRS', INFOT, NOUT, LERR, OK ) 232* 233* CHERFS 234* 235 SRNAMT = 'CHERFS' 236 INFOT = 1 237 CALL CHERFS( '/', 0, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, W, 238 $ R, INFO ) 239 CALL CHKXER( 'CHERFS', INFOT, NOUT, LERR, OK ) 240 INFOT = 2 241 CALL CHERFS( 'U', -1, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, 242 $ W, R, INFO ) 243 CALL CHKXER( 'CHERFS', INFOT, NOUT, LERR, OK ) 244 INFOT = 3 245 CALL CHERFS( 'U', 0, -1, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, 246 $ W, R, INFO ) 247 CALL CHKXER( 'CHERFS', INFOT, NOUT, LERR, OK ) 248 INFOT = 5 249 CALL CHERFS( 'U', 2, 1, A, 1, AF, 2, IP, B, 2, X, 2, R1, R2, W, 250 $ R, INFO ) 251 CALL CHKXER( 'CHERFS', INFOT, NOUT, LERR, OK ) 252 INFOT = 7 253 CALL CHERFS( 'U', 2, 1, A, 2, AF, 1, IP, B, 2, X, 2, R1, R2, W, 254 $ R, INFO ) 255 CALL CHKXER( 'CHERFS', INFOT, NOUT, LERR, OK ) 256 INFOT = 10 257 CALL CHERFS( 'U', 2, 1, A, 2, AF, 2, IP, B, 1, X, 2, R1, R2, W, 258 $ R, INFO ) 259 CALL CHKXER( 'CHERFS', INFOT, NOUT, LERR, OK ) 260 INFOT = 12 261 CALL CHERFS( 'U', 2, 1, A, 2, AF, 2, IP, B, 2, X, 1, R1, R2, W, 262 $ R, INFO ) 263 CALL CHKXER( 'CHERFS', INFOT, NOUT, LERR, OK ) 264* 265* CHECON 266* 267 SRNAMT = 'CHECON' 268 INFOT = 1 269 CALL CHECON( '/', 0, A, 1, IP, ANRM, RCOND, W, INFO ) 270 CALL CHKXER( 'CHECON', INFOT, NOUT, LERR, OK ) 271 INFOT = 2 272 CALL CHECON( 'U', -1, A, 1, IP, ANRM, RCOND, W, INFO ) 273 CALL CHKXER( 'CHECON', INFOT, NOUT, LERR, OK ) 274 INFOT = 4 275 CALL CHECON( 'U', 2, A, 1, IP, ANRM, RCOND, W, INFO ) 276 CALL CHKXER( 'CHECON', INFOT, NOUT, LERR, OK ) 277 INFOT = 6 278 CALL CHECON( 'U', 1, A, 1, IP, -ANRM, RCOND, W, INFO ) 279 CALL CHKXER( 'CHECON', INFOT, NOUT, LERR, OK ) 280* 281* CHERFSX 282* 283 N_ERR_BNDS = 3 284 NPARAMS = 0 285 SRNAMT = 'CHERFSX' 286 INFOT = 1 287 CALL CHERFSX( '/', EQ, 0, 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( 'CHERFSX', INFOT, NOUT, LERR, OK ) 291 INFOT = 2 292 CALL CHERFSX( 'U', EQ, -1, 0, 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( 'CHERFSX', INFOT, NOUT, LERR, OK ) 296 EQ = 'N' 297 INFOT = 3 298 CALL CHERFSX( 'U', EQ, -1, 0, A, 1, AF, 1, IP, S, B, 1, X, 1, 299 $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS, 300 $ PARAMS, W, R, INFO ) 301 CALL CHKXER( 'CHERFSX', INFOT, NOUT, LERR, OK ) 302 INFOT = 4 303 CALL CHERFSX( 'U', EQ, 0, -1, A, 1, AF, 1, IP, S, B, 1, X, 1, 304 $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS, 305 $ PARAMS, W, R, INFO ) 306 CALL CHKXER( 'CHERFSX', INFOT, NOUT, LERR, OK ) 307 INFOT = 6 308 CALL CHERFSX( 'U', EQ, 2, 1, A, 1, AF, 2, IP, S, B, 2, X, 2, 309 $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS, 310 $ PARAMS, W, R, INFO ) 311 CALL CHKXER( 'CHERFSX', INFOT, NOUT, LERR, OK ) 312 INFOT = 8 313 CALL CHERFSX( 'U', EQ, 2, 1, A, 2, AF, 1, IP, S, B, 2, X, 2, 314 $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS, 315 $ PARAMS, W, R, INFO ) 316 CALL CHKXER( 'CHERFSX', INFOT, NOUT, LERR, OK ) 317 INFOT = 12 318 CALL CHERFSX( 'U', EQ, 2, 1, A, 2, AF, 2, IP, S, B, 1, X, 2, 319 $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS, 320 $ PARAMS, W, R, INFO ) 321 CALL CHKXER( 'CHERFSX', INFOT, NOUT, LERR, OK ) 322 INFOT = 14 323 CALL CHERFSX( 'U', EQ, 2, 1, A, 2, AF, 2, IP, S, B, 2, X, 1, 324 $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS, 325 $ PARAMS, W, R, INFO ) 326 CALL CHKXER( 'CHERFSX', INFOT, NOUT, LERR, OK ) 327* 328 ELSE IF( LSAMEN( 2, C2, 'HR' ) ) THEN 329* 330* Test error exits of the routines that use factorization 331* of a Hermitian indefinite matrix with rook 332* (bounded Bunch-Kaufman) diagonal pivoting method. 333* 334* CHETRF_ROOK 335* 336 SRNAMT = 'CHETRF_ROOK' 337 INFOT = 1 338 CALL CHETRF_ROOK( '/', 0, A, 1, IP, W, 1, INFO ) 339 CALL CHKXER( 'CHETRF_ROOK', INFOT, NOUT, LERR, OK ) 340 INFOT = 2 341 CALL CHETRF_ROOK( 'U', -1, A, 1, IP, W, 1, INFO ) 342 CALL CHKXER( 'CHETRF_ROOK', INFOT, NOUT, LERR, OK ) 343 INFOT = 4 344 CALL CHETRF_ROOK( 'U', 2, A, 1, IP, W, 4, INFO ) 345 CALL CHKXER( 'CHETRF_ROOK', INFOT, NOUT, LERR, OK ) 346 INFOT = 7 347 CALL CHETRF_ROOK( 'U', 0, A, 1, IP, W, 0, INFO ) 348 CALL CHKXER( 'CHETRF_ROOK', INFOT, NOUT, LERR, OK ) 349 INFOT = 7 350 CALL CHETRF_ROOK( 'U', 0, A, 1, IP, W, -2, INFO ) 351 CALL CHKXER( 'CHETRF_ROOK', INFOT, NOUT, LERR, OK ) 352* 353* CHETF2_ROOK 354* 355 SRNAMT = 'CHETF2_ROOK' 356 INFOT = 1 357 CALL CHETF2_ROOK( '/', 0, A, 1, IP, INFO ) 358 CALL CHKXER( 'CHETF2_ROOK', INFOT, NOUT, LERR, OK ) 359 INFOT = 2 360 CALL CHETF2_ROOK( 'U', -1, A, 1, IP, INFO ) 361 CALL CHKXER( 'CHETF2_ROOK', INFOT, NOUT, LERR, OK ) 362 INFOT = 4 363 CALL CHETF2_ROOK( 'U', 2, A, 1, IP, INFO ) 364 CALL CHKXER( 'CHETF2_ROOK', INFOT, NOUT, LERR, OK ) 365* 366* CHETRI_ROOK 367* 368 SRNAMT = 'CHETRI_ROOK' 369 INFOT = 1 370 CALL CHETRI_ROOK( '/', 0, A, 1, IP, W, INFO ) 371 CALL CHKXER( 'CHETRI_ROOK', INFOT, NOUT, LERR, OK ) 372 INFOT = 2 373 CALL CHETRI_ROOK( 'U', -1, A, 1, IP, W, INFO ) 374 CALL CHKXER( 'CHETRI_ROOK', INFOT, NOUT, LERR, OK ) 375 INFOT = 4 376 CALL CHETRI_ROOK( 'U', 2, A, 1, IP, W, INFO ) 377 CALL CHKXER( 'CHETRI_ROOK', INFOT, NOUT, LERR, OK ) 378* 379* CHETRS_ROOK 380* 381 SRNAMT = 'CHETRS_ROOK' 382 INFOT = 1 383 CALL CHETRS_ROOK( '/', 0, 0, A, 1, IP, B, 1, INFO ) 384 CALL CHKXER( 'CHETRS_ROOK', INFOT, NOUT, LERR, OK ) 385 INFOT = 2 386 CALL CHETRS_ROOK( 'U', -1, 0, A, 1, IP, B, 1, INFO ) 387 CALL CHKXER( 'CHETRS_ROOK', INFOT, NOUT, LERR, OK ) 388 INFOT = 3 389 CALL CHETRS_ROOK( 'U', 0, -1, A, 1, IP, B, 1, INFO ) 390 CALL CHKXER( 'CHETRS_ROOK', INFOT, NOUT, LERR, OK ) 391 INFOT = 5 392 CALL CHETRS_ROOK( 'U', 2, 1, A, 1, IP, B, 2, INFO ) 393 CALL CHKXER( 'CHETRS_ROOK', INFOT, NOUT, LERR, OK ) 394 INFOT = 8 395 CALL CHETRS_ROOK( 'U', 2, 1, A, 2, IP, B, 1, INFO ) 396 CALL CHKXER( 'CHETRS_ROOK', INFOT, NOUT, LERR, OK ) 397* 398* CHECON_ROOK 399* 400 SRNAMT = 'CHECON_ROOK' 401 INFOT = 1 402 CALL CHECON_ROOK( '/', 0, A, 1, IP, ANRM, RCOND, W, INFO ) 403 CALL CHKXER( 'CHECON_ROOK', INFOT, NOUT, LERR, OK ) 404 INFOT = 2 405 CALL CHECON_ROOK( 'U', -1, A, 1, IP, ANRM, RCOND, W, INFO ) 406 CALL CHKXER( 'CHECON_ROOK', INFOT, NOUT, LERR, OK ) 407 INFOT = 4 408 CALL CHECON_ROOK( 'U', 2, A, 1, IP, ANRM, RCOND, W, INFO ) 409 CALL CHKXER( 'CHECON_ROOK', INFOT, NOUT, LERR, OK ) 410 INFOT = 6 411 CALL CHECON_ROOK( 'U', 1, A, 1, IP, -ANRM, RCOND, W, INFO ) 412 CALL CHKXER( 'CHECON_ROOK', INFOT, NOUT, LERR, OK ) 413* 414 ELSE IF( LSAMEN( 2, C2, 'HK' ) ) THEN 415* 416* Test error exits of the routines that use factorization 417* of a Hermitian indefinite matrix with rook 418* (bounded Bunch-Kaufman) pivoting with the new storage 419* format for factors L ( or U) and D. 420* 421* L (or U) is stored in A, diagonal of D is stored on the 422* diagonal of A, subdiagonal of D is stored in a separate array E. 423* 424* CHETRF_RK 425* 426 SRNAMT = 'CHETRF_RK' 427 INFOT = 1 428 CALL CHETRF_RK( '/', 0, A, 1, E, IP, W, 1, INFO ) 429 CALL CHKXER( 'CHETRF_RK', INFOT, NOUT, LERR, OK ) 430 INFOT = 2 431 CALL CHETRF_RK( 'U', -1, A, 1, E, IP, W, 1, INFO ) 432 CALL CHKXER( 'CHETRF_RK', INFOT, NOUT, LERR, OK ) 433 INFOT = 4 434 CALL CHETRF_RK( 'U', 2, A, 1, E, IP, W, 4, INFO ) 435 CALL CHKXER( 'CHETRF_RK', INFOT, NOUT, LERR, OK ) 436 INFOT = 8 437 CALL CHETRF_RK( 'U', 0, A, 1, E, IP, W, 0, INFO ) 438 CALL CHKXER( 'CHETRF_RK', INFOT, NOUT, LERR, OK ) 439 INFOT = 8 440 CALL CHETRF_RK( 'U', 0, A, 1, E, IP, W, -2, INFO ) 441 CALL CHKXER( 'CHETRF_RK', INFOT, NOUT, LERR, OK ) 442* 443* CHETF2_RK 444* 445 SRNAMT = 'CHETF2_RK' 446 INFOT = 1 447 CALL CHETF2_RK( '/', 0, A, 1, E, IP, INFO ) 448 CALL CHKXER( 'CHETF2_RK', INFOT, NOUT, LERR, OK ) 449 INFOT = 2 450 CALL CHETF2_RK( 'U', -1, A, 1, E, IP, INFO ) 451 CALL CHKXER( 'CHETF2_RK', INFOT, NOUT, LERR, OK ) 452 INFOT = 4 453 CALL CHETF2_RK( 'U', 2, A, 1, E, IP, INFO ) 454 CALL CHKXER( 'CHETF2_RK', INFOT, NOUT, LERR, OK ) 455* 456* CHETRI_3 457* 458 SRNAMT = 'CHETRI_3' 459 INFOT = 1 460 CALL CHETRI_3( '/', 0, A, 1, E, IP, W, 1, INFO ) 461 CALL CHKXER( 'CHETRI_3', INFOT, NOUT, LERR, OK ) 462 INFOT = 2 463 CALL CHETRI_3( 'U', -1, A, 1, E, IP, W, 1, INFO ) 464 CALL CHKXER( 'CHETRI_3', INFOT, NOUT, LERR, OK ) 465 INFOT = 4 466 CALL CHETRI_3( 'U', 2, A, 1, E, IP, W, 1, INFO ) 467 CALL CHKXER( 'CHETRI_3', INFOT, NOUT, LERR, OK ) 468 INFOT = 8 469 CALL CHETRI_3( 'U', 0, A, 1, E, IP, W, 0, INFO ) 470 CALL CHKXER( 'CHETRI_3', INFOT, NOUT, LERR, OK ) 471 INFOT = 8 472 CALL CHETRI_3( 'U', 0, A, 1, E, IP, W, -2, INFO ) 473 CALL CHKXER( 'CHETRI_3', INFOT, NOUT, LERR, OK ) 474* 475* CHETRI_3X 476* 477 SRNAMT = 'CHETRI_3X' 478 INFOT = 1 479 CALL CHETRI_3X( '/', 0, A, 1, E, IP, W, 1, INFO ) 480 CALL CHKXER( 'CHETRI_3X', INFOT, NOUT, LERR, OK ) 481 INFOT = 2 482 CALL CHETRI_3X( 'U', -1, A, 1, E, IP, W, 1, INFO ) 483 CALL CHKXER( 'CHETRI_3X', INFOT, NOUT, LERR, OK ) 484 INFOT = 4 485 CALL CHETRI_3X( 'U', 2, A, 1, E, IP, W, 1, INFO ) 486 CALL CHKXER( 'CHETRI_3X', INFOT, NOUT, LERR, OK ) 487* 488* CHETRS_3 489* 490 SRNAMT = 'CHETRS_3' 491 INFOT = 1 492 CALL CHETRS_3( '/', 0, 0, A, 1, E, IP, B, 1, INFO ) 493 CALL CHKXER( 'CHETRS_3', INFOT, NOUT, LERR, OK ) 494 INFOT = 2 495 CALL CHETRS_3( 'U', -1, 0, A, 1, E, IP, B, 1, INFO ) 496 CALL CHKXER( 'CHETRS_3', INFOT, NOUT, LERR, OK ) 497 INFOT = 3 498 CALL CHETRS_3( 'U', 0, -1, A, 1, E, IP, B, 1, INFO ) 499 CALL CHKXER( 'CHETRS_3', INFOT, NOUT, LERR, OK ) 500 INFOT = 5 501 CALL CHETRS_3( 'U', 2, 1, A, 1, E, IP, B, 2, INFO ) 502 CALL CHKXER( 'CHETRS_3', INFOT, NOUT, LERR, OK ) 503 INFOT = 9 504 CALL CHETRS_3( 'U', 2, 1, A, 2, E, IP, B, 1, INFO ) 505 CALL CHKXER( 'CHETRS_3', INFOT, NOUT, LERR, OK ) 506* 507* CHECON_3 508* 509 SRNAMT = 'CHECON_3' 510 INFOT = 1 511 CALL CHECON_3( '/', 0, A, 1, E, IP, ANRM, RCOND, W, INFO ) 512 CALL CHKXER( 'CHECON_3', INFOT, NOUT, LERR, OK ) 513 INFOT = 2 514 CALL CHECON_3( 'U', -1, A, 1, E, IP, ANRM, RCOND, W, INFO ) 515 CALL CHKXER( 'CHECON_3', INFOT, NOUT, LERR, OK ) 516 INFOT = 4 517 CALL CHECON_3( 'U', 2, A, 1, E, IP, ANRM, RCOND, W, INFO ) 518 CALL CHKXER( 'CHECON_3', INFOT, NOUT, LERR, OK ) 519 INFOT = 7 520 CALL CHECON_3( 'U', 1, A, 1, E, IP, -1.0E0, RCOND, W, INFO) 521 CALL CHKXER( 'CHECON_3', INFOT, NOUT, LERR, OK ) 522* 523 ELSE IF( LSAMEN( 2, C2, 'HP' ) ) THEN 524* 525* Test error exits of the routines that use factorization 526* of a Hermitian indefinite packed matrix with patrial 527* (Bunch-Kaufman) diagonal pivoting method. 528* 529* CHPTRF 530* 531 SRNAMT = 'CHPTRF' 532 INFOT = 1 533 CALL CHPTRF( '/', 0, A, IP, INFO ) 534 CALL CHKXER( 'CHPTRF', INFOT, NOUT, LERR, OK ) 535 INFOT = 2 536 CALL CHPTRF( 'U', -1, A, IP, INFO ) 537 CALL CHKXER( 'CHPTRF', INFOT, NOUT, LERR, OK ) 538* 539* CHPTRI 540* 541 SRNAMT = 'CHPTRI' 542 INFOT = 1 543 CALL CHPTRI( '/', 0, A, IP, W, INFO ) 544 CALL CHKXER( 'CHPTRI', INFOT, NOUT, LERR, OK ) 545 INFOT = 2 546 CALL CHPTRI( 'U', -1, A, IP, W, INFO ) 547 CALL CHKXER( 'CHPTRI', INFOT, NOUT, LERR, OK ) 548* 549* CHPTRS 550* 551 SRNAMT = 'CHPTRS' 552 INFOT = 1 553 CALL CHPTRS( '/', 0, 0, A, IP, B, 1, INFO ) 554 CALL CHKXER( 'CHPTRS', INFOT, NOUT, LERR, OK ) 555 INFOT = 2 556 CALL CHPTRS( 'U', -1, 0, A, IP, B, 1, INFO ) 557 CALL CHKXER( 'CHPTRS', INFOT, NOUT, LERR, OK ) 558 INFOT = 3 559 CALL CHPTRS( 'U', 0, -1, A, IP, B, 1, INFO ) 560 CALL CHKXER( 'CHPTRS', INFOT, NOUT, LERR, OK ) 561 INFOT = 7 562 CALL CHPTRS( 'U', 2, 1, A, IP, B, 1, INFO ) 563 CALL CHKXER( 'CHPTRS', INFOT, NOUT, LERR, OK ) 564* 565* CHPRFS 566* 567 SRNAMT = 'CHPRFS' 568 INFOT = 1 569 CALL CHPRFS( '/', 0, 0, A, AF, IP, B, 1, X, 1, R1, R2, W, R, 570 $ INFO ) 571 CALL CHKXER( 'CHPRFS', INFOT, NOUT, LERR, OK ) 572 INFOT = 2 573 CALL CHPRFS( 'U', -1, 0, A, AF, IP, B, 1, X, 1, R1, R2, W, R, 574 $ INFO ) 575 CALL CHKXER( 'CHPRFS', INFOT, NOUT, LERR, OK ) 576 INFOT = 3 577 CALL CHPRFS( 'U', 0, -1, A, AF, IP, B, 1, X, 1, R1, R2, W, R, 578 $ INFO ) 579 CALL CHKXER( 'CHPRFS', INFOT, NOUT, LERR, OK ) 580 INFOT = 8 581 CALL CHPRFS( 'U', 2, 1, A, AF, IP, B, 1, X, 2, R1, R2, W, R, 582 $ INFO ) 583 CALL CHKXER( 'CHPRFS', INFOT, NOUT, LERR, OK ) 584 INFOT = 10 585 CALL CHPRFS( 'U', 2, 1, A, AF, IP, B, 2, X, 1, R1, R2, W, R, 586 $ INFO ) 587 CALL CHKXER( 'CHPRFS', INFOT, NOUT, LERR, OK ) 588* 589* CHPCON 590* 591 SRNAMT = 'CHPCON' 592 INFOT = 1 593 CALL CHPCON( '/', 0, A, IP, ANRM, RCOND, W, INFO ) 594 CALL CHKXER( 'CHPCON', INFOT, NOUT, LERR, OK ) 595 INFOT = 2 596 CALL CHPCON( 'U', -1, A, IP, ANRM, RCOND, W, INFO ) 597 CALL CHKXER( 'CHPCON', INFOT, NOUT, LERR, OK ) 598 INFOT = 5 599 CALL CHPCON( 'U', 1, A, IP, -ANRM, RCOND, W, INFO ) 600 CALL CHKXER( 'CHPCON', INFOT, NOUT, LERR, OK ) 601 END IF 602* 603* Print a summary line. 604* 605 CALL ALAESM( PATH, OK, NOUT ) 606* 607 RETURN 608* 609* End of CERRHEX 610* 611 END 612