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*> \date December 2016 55* 56*> \ingroup complex_lin 57* 58* ===================================================================== 59 SUBROUTINE CERRHE( 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* 74* .. Parameters .. 75 INTEGER NMAX 76 PARAMETER ( NMAX = 4 ) 77* .. 78* .. Local Scalars .. 79 CHARACTER EQ 80 CHARACTER*2 C2 81 INTEGER I, INFO, J, N_ERR_BNDS, NPARAMS 82 REAL ANRM, RCOND, BERR 83* .. 84* .. Local Arrays .. 85 INTEGER IP( NMAX ) 86 REAL R( NMAX ), R1( NMAX ), R2( NMAX ), 87 $ S( NMAX ), ERR_BNDS_N( NMAX, 3 ), 88 $ ERR_BNDS_C( NMAX, 3 ), PARAMS( 1 ) 89 COMPLEX A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ), 90 $ E( NMAX ), W( 2*NMAX ), X( NMAX ) 91* .. 92* .. External Functions .. 93 LOGICAL LSAMEN 94 EXTERNAL LSAMEN 95* .. 96* .. External Subroutines .. 97 EXTERNAL ALAESM, CHECON, CHECON_3, CHECON_ROOK, CHERFS, 98 $ CHETF2, CHETF2_RK, CHETF2_ROOK, CHETRF, 99 $ CHETRF_RK, CHETRF_ROOK, CHETRI, CHETRI_3, 100 $ CHETRI_3X, CHETRI_ROOK, CHETRI2, CHETRI2X, 101 $ CHETRS, CHETRS_3, CHETRS_ROOK, CHKXER, CHPCON, 102 $ CHPRFS, CHPTRF, CHPTRI, CHPTRS, CHERFSX 103* .. 104* .. Scalars in Common .. 105 LOGICAL LERR, OK 106 CHARACTER*32 SRNAMT 107 INTEGER INFOT, NOUT 108* .. 109* .. Common blocks .. 110 COMMON / INFOC / INFOT, NOUT, OK, LERR 111 COMMON / SRNAMC / SRNAMT 112* .. 113* .. Intrinsic Functions .. 114 INTRINSIC CMPLX, REAL 115* .. 116* .. Executable Statements .. 117* 118 NOUT = NUNIT 119 WRITE( NOUT, FMT = * ) 120 C2 = PATH( 2: 3 ) 121* 122* Set the variables to innocuous values. 123* 124 DO 20 J = 1, NMAX 125 DO 10 I = 1, NMAX 126 A( I, J ) = CMPLX( 1. / REAL( I+J ), -1. / REAL( I+J ) ) 127 AF( I, J ) = CMPLX( 1. / REAL( I+J ), -1. / REAL( I+J ) ) 128 10 CONTINUE 129 B( J ) = 0.E+0 130 E( J ) = 0.E+0 131 R1( J ) = 0.E+0 132 R2( J ) = 0.E+0 133 W( J ) = 0.E+0 134 X( J ) = 0.E+0 135 IP( J ) = J 136 20 CONTINUE 137 ANRM = 1.0 138 OK = .TRUE. 139* 140 IF( LSAMEN( 2, C2, 'HE' ) ) THEN 141* 142* Test error exits of the routines that use factorization 143* of a Hermitian indefinite matrix with patrial 144* (Bunch-Kaufman) diagonal pivoting method. 145* 146* CHETRF 147* 148 SRNAMT = 'CHETRF' 149 INFOT = 1 150 CALL CHETRF( '/', 0, A, 1, IP, W, 1, INFO ) 151 CALL CHKXER( 'CHETRF', INFOT, NOUT, LERR, OK ) 152 INFOT = 2 153 CALL CHETRF( 'U', -1, A, 1, IP, W, 1, INFO ) 154 CALL CHKXER( 'CHETRF', INFOT, NOUT, LERR, OK ) 155 INFOT = 4 156 CALL CHETRF( 'U', 2, A, 1, IP, W, 4, INFO ) 157 CALL CHKXER( 'CHETRF', INFOT, NOUT, LERR, OK ) 158 INFOT = 7 159 CALL CHETRF( 'U', 0, A, 1, IP, W, 0, INFO ) 160 CALL CHKXER( 'CHETRF', INFOT, NOUT, LERR, OK ) 161 INFOT = 7 162 CALL CHETRF( 'U', 0, A, 1, IP, W, -2, INFO ) 163 CALL CHKXER( 'CHETRF', INFOT, NOUT, LERR, OK ) 164* 165* CHETF2 166* 167 SRNAMT = 'CHETF2' 168 INFOT = 1 169 CALL CHETF2( '/', 0, A, 1, IP, INFO ) 170 CALL CHKXER( 'CHETF2', INFOT, NOUT, LERR, OK ) 171 INFOT = 2 172 CALL CHETF2( 'U', -1, A, 1, IP, INFO ) 173 CALL CHKXER( 'CHETF2', INFOT, NOUT, LERR, OK ) 174 INFOT = 4 175 CALL CHETF2( 'U', 2, A, 1, IP, INFO ) 176 CALL CHKXER( 'CHETF2', INFOT, NOUT, LERR, OK ) 177* 178* CHETRI 179* 180 SRNAMT = 'CHETRI' 181 INFOT = 1 182 CALL CHETRI( '/', 0, A, 1, IP, W, INFO ) 183 CALL CHKXER( 'CHETRI', INFOT, NOUT, LERR, OK ) 184 INFOT = 2 185 CALL CHETRI( 'U', -1, A, 1, IP, W, INFO ) 186 CALL CHKXER( 'CHETRI', INFOT, NOUT, LERR, OK ) 187 INFOT = 4 188 CALL CHETRI( 'U', 2, A, 1, IP, W, INFO ) 189 CALL CHKXER( 'CHETRI', INFOT, NOUT, LERR, OK ) 190* 191* CHETRI2 192* 193 SRNAMT = 'CHETRI2' 194 INFOT = 1 195 CALL CHETRI2( '/', 0, A, 1, IP, W, 1, INFO ) 196 CALL CHKXER( 'CHETRI2', INFOT, NOUT, LERR, OK ) 197 INFOT = 2 198 CALL CHETRI2( 'U', -1, A, 1, IP, W, 1, INFO ) 199 CALL CHKXER( 'CHETRI2', INFOT, NOUT, LERR, OK ) 200 INFOT = 4 201 CALL CHETRI2( 'U', 2, A, 1, IP, W, 1, INFO ) 202 CALL CHKXER( 'CHETRI2', INFOT, NOUT, LERR, OK ) 203* 204* CHETRI2X 205* 206 SRNAMT = 'CHETRI2X' 207 INFOT = 1 208 CALL CHETRI2X( '/', 0, A, 1, IP, W, 1, INFO ) 209 CALL CHKXER( 'CHETRI2X', INFOT, NOUT, LERR, OK ) 210 INFOT = 2 211 CALL CHETRI2X( 'U', -1, A, 1, IP, W, 1, INFO ) 212 CALL CHKXER( 'CHETRI2X', INFOT, NOUT, LERR, OK ) 213 INFOT = 4 214 CALL CHETRI2X( 'U', 2, A, 1, IP, W, 1, INFO ) 215 CALL CHKXER( 'CHETRI2X', INFOT, NOUT, LERR, OK ) 216* 217* CHETRS 218* 219 SRNAMT = 'CHETRS' 220 INFOT = 1 221 CALL CHETRS( '/', 0, 0, A, 1, IP, B, 1, INFO ) 222 CALL CHKXER( 'CHETRS', INFOT, NOUT, LERR, OK ) 223 INFOT = 2 224 CALL CHETRS( 'U', -1, 0, A, 1, IP, B, 1, INFO ) 225 CALL CHKXER( 'CHETRS', INFOT, NOUT, LERR, OK ) 226 INFOT = 3 227 CALL CHETRS( 'U', 0, -1, A, 1, IP, B, 1, INFO ) 228 CALL CHKXER( 'CHETRS', INFOT, NOUT, LERR, OK ) 229 INFOT = 5 230 CALL CHETRS( 'U', 2, 1, A, 1, IP, B, 2, INFO ) 231 CALL CHKXER( 'CHETRS', INFOT, NOUT, LERR, OK ) 232 INFOT = 8 233 CALL CHETRS( 'U', 2, 1, A, 2, IP, B, 1, INFO ) 234 CALL CHKXER( 'CHETRS', INFOT, NOUT, LERR, OK ) 235* 236* CHERFS 237* 238 SRNAMT = 'CHERFS' 239 INFOT = 1 240 CALL CHERFS( '/', 0, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, W, 241 $ R, INFO ) 242 CALL CHKXER( 'CHERFS', INFOT, NOUT, LERR, OK ) 243 INFOT = 2 244 CALL CHERFS( 'U', -1, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, 245 $ W, R, INFO ) 246 CALL CHKXER( 'CHERFS', INFOT, NOUT, LERR, OK ) 247 INFOT = 3 248 CALL CHERFS( 'U', 0, -1, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, 249 $ W, R, INFO ) 250 CALL CHKXER( 'CHERFS', INFOT, NOUT, LERR, OK ) 251 INFOT = 5 252 CALL CHERFS( 'U', 2, 1, A, 1, AF, 2, IP, B, 2, X, 2, R1, R2, W, 253 $ R, INFO ) 254 CALL CHKXER( 'CHERFS', INFOT, NOUT, LERR, OK ) 255 INFOT = 7 256 CALL CHERFS( 'U', 2, 1, A, 2, AF, 1, IP, B, 2, X, 2, R1, R2, W, 257 $ R, INFO ) 258 CALL CHKXER( 'CHERFS', INFOT, NOUT, LERR, OK ) 259 INFOT = 10 260 CALL CHERFS( 'U', 2, 1, A, 2, AF, 2, IP, B, 1, X, 2, R1, R2, W, 261 $ R, INFO ) 262 CALL CHKXER( 'CHERFS', INFOT, NOUT, LERR, OK ) 263 INFOT = 12 264 CALL CHERFS( 'U', 2, 1, A, 2, AF, 2, IP, B, 2, X, 1, R1, R2, W, 265 $ R, INFO ) 266 CALL CHKXER( 'CHERFS', INFOT, NOUT, LERR, OK ) 267* 268* CHECON 269* 270 SRNAMT = 'CHECON' 271 INFOT = 1 272 CALL CHECON( '/', 0, A, 1, IP, ANRM, RCOND, W, INFO ) 273 CALL CHKXER( 'CHECON', INFOT, NOUT, LERR, OK ) 274 INFOT = 2 275 CALL CHECON( 'U', -1, A, 1, IP, ANRM, RCOND, W, INFO ) 276 CALL CHKXER( 'CHECON', INFOT, NOUT, LERR, OK ) 277 INFOT = 4 278 CALL CHECON( 'U', 2, A, 1, IP, ANRM, RCOND, W, INFO ) 279 CALL CHKXER( 'CHECON', INFOT, NOUT, LERR, OK ) 280 INFOT = 6 281 CALL CHECON( 'U', 1, A, 1, IP, -ANRM, RCOND, W, INFO ) 282 CALL CHKXER( 'CHECON', INFOT, NOUT, LERR, OK ) 283* 284* CHERFSX 285* 286 N_ERR_BNDS = 3 287 NPARAMS = 0 288 SRNAMT = 'CHERFSX' 289 INFOT = 1 290 CALL CHERFSX( '/', EQ, 0, 0, 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( 'CHERFSX', INFOT, NOUT, LERR, OK ) 294 INFOT = 2 295 CALL CHERFSX( 'U', EQ, -1, 0, A, 1, AF, 1, IP, S, B, 1, X, 1, 296 $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS, 297 $ PARAMS, W, R, INFO ) 298 CALL CHKXER( 'CHERFSX', INFOT, NOUT, LERR, OK ) 299 EQ = 'N' 300 INFOT = 3 301 CALL CHERFSX( 'U', EQ, -1, 0, A, 1, AF, 1, IP, S, B, 1, X, 1, 302 $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS, 303 $ PARAMS, W, R, INFO ) 304 CALL CHKXER( 'CHERFSX', INFOT, NOUT, LERR, OK ) 305 INFOT = 4 306 CALL CHERFSX( 'U', EQ, 0, -1, A, 1, AF, 1, IP, S, B, 1, X, 1, 307 $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS, 308 $ PARAMS, W, R, INFO ) 309 CALL CHKXER( 'CHERFSX', INFOT, NOUT, LERR, OK ) 310 INFOT = 6 311 CALL CHERFSX( 'U', EQ, 2, 1, A, 1, AF, 2, IP, S, B, 2, X, 2, 312 $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS, 313 $ PARAMS, W, R, INFO ) 314 CALL CHKXER( 'CHERFSX', INFOT, NOUT, LERR, OK ) 315 INFOT = 8 316 CALL CHERFSX( 'U', EQ, 2, 1, A, 2, AF, 1, IP, S, B, 2, X, 2, 317 $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS, 318 $ PARAMS, W, R, INFO ) 319 CALL CHKXER( 'CHERFSX', INFOT, NOUT, LERR, OK ) 320 INFOT = 12 321 CALL CHERFSX( 'U', EQ, 2, 1, A, 2, AF, 2, IP, S, B, 1, X, 2, 322 $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS, 323 $ PARAMS, W, R, INFO ) 324 CALL CHKXER( 'CHERFSX', INFOT, NOUT, LERR, OK ) 325 INFOT = 14 326 CALL CHERFSX( 'U', EQ, 2, 1, A, 2, AF, 2, IP, S, B, 2, X, 1, 327 $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS, 328 $ PARAMS, W, R, INFO ) 329 CALL CHKXER( 'CHERFSX', 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* CHETRF_ROOK 338* 339 SRNAMT = 'CHETRF_ROOK' 340 INFOT = 1 341 CALL CHETRF_ROOK( '/', 0, A, 1, IP, W, 1, INFO ) 342 CALL CHKXER( 'CHETRF_ROOK', INFOT, NOUT, LERR, OK ) 343 INFOT = 2 344 CALL CHETRF_ROOK( 'U', -1, A, 1, IP, W, 1, INFO ) 345 CALL CHKXER( 'CHETRF_ROOK', INFOT, NOUT, LERR, OK ) 346 INFOT = 4 347 CALL CHETRF_ROOK( 'U', 2, A, 1, IP, W, 4, INFO ) 348 CALL CHKXER( 'CHETRF_ROOK', INFOT, NOUT, LERR, OK ) 349 INFOT = 7 350 CALL CHETRF_ROOK( 'U', 0, A, 1, IP, W, 0, INFO ) 351 CALL CHKXER( 'CHETRF_ROOK', INFOT, NOUT, LERR, OK ) 352 INFOT = 7 353 CALL CHETRF_ROOK( 'U', 0, A, 1, IP, W, -2, INFO ) 354 CALL CHKXER( 'CHETRF_ROOK', INFOT, NOUT, LERR, OK ) 355* 356* CHETF2_ROOK 357* 358 SRNAMT = 'CHETF2_ROOK' 359 INFOT = 1 360 CALL CHETF2_ROOK( '/', 0, A, 1, IP, INFO ) 361 CALL CHKXER( 'CHETF2_ROOK', INFOT, NOUT, LERR, OK ) 362 INFOT = 2 363 CALL CHETF2_ROOK( 'U', -1, A, 1, IP, INFO ) 364 CALL CHKXER( 'CHETF2_ROOK', INFOT, NOUT, LERR, OK ) 365 INFOT = 4 366 CALL CHETF2_ROOK( 'U', 2, A, 1, IP, INFO ) 367 CALL CHKXER( 'CHETF2_ROOK', INFOT, NOUT, LERR, OK ) 368* 369* CHETRI_ROOK 370* 371 SRNAMT = 'CHETRI_ROOK' 372 INFOT = 1 373 CALL CHETRI_ROOK( '/', 0, A, 1, IP, W, INFO ) 374 CALL CHKXER( 'CHETRI_ROOK', INFOT, NOUT, LERR, OK ) 375 INFOT = 2 376 CALL CHETRI_ROOK( 'U', -1, A, 1, IP, W, INFO ) 377 CALL CHKXER( 'CHETRI_ROOK', INFOT, NOUT, LERR, OK ) 378 INFOT = 4 379 CALL CHETRI_ROOK( 'U', 2, A, 1, IP, W, INFO ) 380 CALL CHKXER( 'CHETRI_ROOK', INFOT, NOUT, LERR, OK ) 381* 382* CHETRS_ROOK 383* 384 SRNAMT = 'CHETRS_ROOK' 385 INFOT = 1 386 CALL CHETRS_ROOK( '/', 0, 0, A, 1, IP, B, 1, INFO ) 387 CALL CHKXER( 'CHETRS_ROOK', INFOT, NOUT, LERR, OK ) 388 INFOT = 2 389 CALL CHETRS_ROOK( 'U', -1, 0, A, 1, IP, B, 1, INFO ) 390 CALL CHKXER( 'CHETRS_ROOK', INFOT, NOUT, LERR, OK ) 391 INFOT = 3 392 CALL CHETRS_ROOK( 'U', 0, -1, A, 1, IP, B, 1, INFO ) 393 CALL CHKXER( 'CHETRS_ROOK', INFOT, NOUT, LERR, OK ) 394 INFOT = 5 395 CALL CHETRS_ROOK( 'U', 2, 1, A, 1, IP, B, 2, INFO ) 396 CALL CHKXER( 'CHETRS_ROOK', INFOT, NOUT, LERR, OK ) 397 INFOT = 8 398 CALL CHETRS_ROOK( 'U', 2, 1, A, 2, IP, B, 1, INFO ) 399 CALL CHKXER( 'CHETRS_ROOK', INFOT, NOUT, LERR, OK ) 400* 401* CHECON_ROOK 402* 403 SRNAMT = 'CHECON_ROOK' 404 INFOT = 1 405 CALL CHECON_ROOK( '/', 0, A, 1, IP, ANRM, RCOND, W, INFO ) 406 CALL CHKXER( 'CHECON_ROOK', INFOT, NOUT, LERR, OK ) 407 INFOT = 2 408 CALL CHECON_ROOK( 'U', -1, A, 1, IP, ANRM, RCOND, W, INFO ) 409 CALL CHKXER( 'CHECON_ROOK', INFOT, NOUT, LERR, OK ) 410 INFOT = 4 411 CALL CHECON_ROOK( 'U', 2, A, 1, IP, ANRM, RCOND, W, INFO ) 412 CALL CHKXER( 'CHECON_ROOK', INFOT, NOUT, LERR, OK ) 413 INFOT = 6 414 CALL CHECON_ROOK( 'U', 1, A, 1, IP, -ANRM, RCOND, W, INFO ) 415 CALL CHKXER( 'CHECON_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 Hermitian 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* CHETRF_RK 428* 429 SRNAMT = 'CHETRF_RK' 430 INFOT = 1 431 CALL CHETRF_RK( '/', 0, A, 1, E, IP, W, 1, INFO ) 432 CALL CHKXER( 'CHETRF_RK', INFOT, NOUT, LERR, OK ) 433 INFOT = 2 434 CALL CHETRF_RK( 'U', -1, A, 1, E, IP, W, 1, INFO ) 435 CALL CHKXER( 'CHETRF_RK', INFOT, NOUT, LERR, OK ) 436 INFOT = 4 437 CALL CHETRF_RK( 'U', 2, A, 1, E, IP, W, 4, INFO ) 438 CALL CHKXER( 'CHETRF_RK', INFOT, NOUT, LERR, OK ) 439 INFOT = 8 440 CALL CHETRF_RK( 'U', 0, A, 1, E, IP, W, 0, INFO ) 441 CALL CHKXER( 'CHETRF_RK', INFOT, NOUT, LERR, OK ) 442 INFOT = 8 443 CALL CHETRF_RK( 'U', 0, A, 1, E, IP, W, -2, INFO ) 444 CALL CHKXER( 'CHETRF_RK', INFOT, NOUT, LERR, OK ) 445* 446* CHETF2_RK 447* 448 SRNAMT = 'CHETF2_RK' 449 INFOT = 1 450 CALL CHETF2_RK( '/', 0, A, 1, E, IP, INFO ) 451 CALL CHKXER( 'CHETF2_RK', INFOT, NOUT, LERR, OK ) 452 INFOT = 2 453 CALL CHETF2_RK( 'U', -1, A, 1, E, IP, INFO ) 454 CALL CHKXER( 'CHETF2_RK', INFOT, NOUT, LERR, OK ) 455 INFOT = 4 456 CALL CHETF2_RK( 'U', 2, A, 1, E, IP, INFO ) 457 CALL CHKXER( 'CHETF2_RK', INFOT, NOUT, LERR, OK ) 458* 459* CHETRI_3 460* 461 SRNAMT = 'CHETRI_3' 462 INFOT = 1 463 CALL CHETRI_3( '/', 0, A, 1, E, IP, W, 1, INFO ) 464 CALL CHKXER( 'CHETRI_3', INFOT, NOUT, LERR, OK ) 465 INFOT = 2 466 CALL CHETRI_3( 'U', -1, A, 1, E, IP, W, 1, INFO ) 467 CALL CHKXER( 'CHETRI_3', INFOT, NOUT, LERR, OK ) 468 INFOT = 4 469 CALL CHETRI_3( 'U', 2, A, 1, E, IP, W, 1, INFO ) 470 CALL CHKXER( 'CHETRI_3', INFOT, NOUT, LERR, OK ) 471 INFOT = 8 472 CALL CHETRI_3( 'U', 0, A, 1, E, IP, W, 0, INFO ) 473 CALL CHKXER( 'CHETRI_3', INFOT, NOUT, LERR, OK ) 474 INFOT = 8 475 CALL CHETRI_3( 'U', 0, A, 1, E, IP, W, -2, INFO ) 476 CALL CHKXER( 'CHETRI_3', INFOT, NOUT, LERR, OK ) 477* 478* CHETRI_3X 479* 480 SRNAMT = 'CHETRI_3X' 481 INFOT = 1 482 CALL CHETRI_3X( '/', 0, A, 1, E, IP, W, 1, INFO ) 483 CALL CHKXER( 'CHETRI_3X', INFOT, NOUT, LERR, OK ) 484 INFOT = 2 485 CALL CHETRI_3X( 'U', -1, A, 1, E, IP, W, 1, INFO ) 486 CALL CHKXER( 'CHETRI_3X', INFOT, NOUT, LERR, OK ) 487 INFOT = 4 488 CALL CHETRI_3X( 'U', 2, A, 1, E, IP, W, 1, INFO ) 489 CALL CHKXER( 'CHETRI_3X', INFOT, NOUT, LERR, OK ) 490* 491* CHETRS_3 492* 493 SRNAMT = 'CHETRS_3' 494 INFOT = 1 495 CALL CHETRS_3( '/', 0, 0, A, 1, E, IP, B, 1, INFO ) 496 CALL CHKXER( 'CHETRS_3', INFOT, NOUT, LERR, OK ) 497 INFOT = 2 498 CALL CHETRS_3( 'U', -1, 0, A, 1, E, IP, B, 1, INFO ) 499 CALL CHKXER( 'CHETRS_3', INFOT, NOUT, LERR, OK ) 500 INFOT = 3 501 CALL CHETRS_3( 'U', 0, -1, A, 1, E, IP, B, 1, INFO ) 502 CALL CHKXER( 'CHETRS_3', INFOT, NOUT, LERR, OK ) 503 INFOT = 5 504 CALL CHETRS_3( 'U', 2, 1, A, 1, E, IP, B, 2, INFO ) 505 CALL CHKXER( 'CHETRS_3', INFOT, NOUT, LERR, OK ) 506 INFOT = 9 507 CALL CHETRS_3( 'U', 2, 1, A, 2, E, IP, B, 1, INFO ) 508 CALL CHKXER( 'CHETRS_3', INFOT, NOUT, LERR, OK ) 509* 510* CHECON_3 511* 512 SRNAMT = 'CHECON_3' 513 INFOT = 1 514 CALL CHECON_3( '/', 0, A, 1, E, IP, ANRM, RCOND, W, INFO ) 515 CALL CHKXER( 'CHECON_3', INFOT, NOUT, LERR, OK ) 516 INFOT = 2 517 CALL CHECON_3( 'U', -1, A, 1, E, IP, ANRM, RCOND, W, INFO ) 518 CALL CHKXER( 'CHECON_3', INFOT, NOUT, LERR, OK ) 519 INFOT = 4 520 CALL CHECON_3( 'U', 2, A, 1, E, IP, ANRM, RCOND, W, INFO ) 521 CALL CHKXER( 'CHECON_3', INFOT, NOUT, LERR, OK ) 522 INFOT = 7 523 CALL CHECON_3( 'U', 1, A, 1, E, IP, -1.0E0, RCOND, W, INFO) 524 CALL CHKXER( 'CHECON_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 patrial 530* (Bunch-Kaufman) diagonal pivoting method. 531* 532* CHPTRF 533* 534 SRNAMT = 'CHPTRF' 535 INFOT = 1 536 CALL CHPTRF( '/', 0, A, IP, INFO ) 537 CALL CHKXER( 'CHPTRF', INFOT, NOUT, LERR, OK ) 538 INFOT = 2 539 CALL CHPTRF( 'U', -1, A, IP, INFO ) 540 CALL CHKXER( 'CHPTRF', INFOT, NOUT, LERR, OK ) 541* 542* CHPTRI 543* 544 SRNAMT = 'CHPTRI' 545 INFOT = 1 546 CALL CHPTRI( '/', 0, A, IP, W, INFO ) 547 CALL CHKXER( 'CHPTRI', INFOT, NOUT, LERR, OK ) 548 INFOT = 2 549 CALL CHPTRI( 'U', -1, A, IP, W, INFO ) 550 CALL CHKXER( 'CHPTRI', INFOT, NOUT, LERR, OK ) 551* 552* CHPTRS 553* 554 SRNAMT = 'CHPTRS' 555 INFOT = 1 556 CALL CHPTRS( '/', 0, 0, A, IP, B, 1, INFO ) 557 CALL CHKXER( 'CHPTRS', INFOT, NOUT, LERR, OK ) 558 INFOT = 2 559 CALL CHPTRS( 'U', -1, 0, A, IP, B, 1, INFO ) 560 CALL CHKXER( 'CHPTRS', INFOT, NOUT, LERR, OK ) 561 INFOT = 3 562 CALL CHPTRS( 'U', 0, -1, A, IP, B, 1, INFO ) 563 CALL CHKXER( 'CHPTRS', INFOT, NOUT, LERR, OK ) 564 INFOT = 7 565 CALL CHPTRS( 'U', 2, 1, A, IP, B, 1, INFO ) 566 CALL CHKXER( 'CHPTRS', INFOT, NOUT, LERR, OK ) 567* 568* CHPRFS 569* 570 SRNAMT = 'CHPRFS' 571 INFOT = 1 572 CALL CHPRFS( '/', 0, 0, A, AF, IP, B, 1, X, 1, R1, R2, W, R, 573 $ INFO ) 574 CALL CHKXER( 'CHPRFS', INFOT, NOUT, LERR, OK ) 575 INFOT = 2 576 CALL CHPRFS( 'U', -1, 0, A, AF, IP, B, 1, X, 1, R1, R2, W, R, 577 $ INFO ) 578 CALL CHKXER( 'CHPRFS', INFOT, NOUT, LERR, OK ) 579 INFOT = 3 580 CALL CHPRFS( 'U', 0, -1, A, AF, IP, B, 1, X, 1, R1, R2, W, R, 581 $ INFO ) 582 CALL CHKXER( 'CHPRFS', INFOT, NOUT, LERR, OK ) 583 INFOT = 8 584 CALL CHPRFS( 'U', 2, 1, A, AF, IP, B, 1, X, 2, R1, R2, W, R, 585 $ INFO ) 586 CALL CHKXER( 'CHPRFS', INFOT, NOUT, LERR, OK ) 587 INFOT = 10 588 CALL CHPRFS( 'U', 2, 1, A, AF, IP, B, 2, X, 1, R1, R2, W, R, 589 $ INFO ) 590 CALL CHKXER( 'CHPRFS', INFOT, NOUT, LERR, OK ) 591* 592* CHPCON 593* 594 SRNAMT = 'CHPCON' 595 INFOT = 1 596 CALL CHPCON( '/', 0, A, IP, ANRM, RCOND, W, INFO ) 597 CALL CHKXER( 'CHPCON', INFOT, NOUT, LERR, OK ) 598 INFOT = 2 599 CALL CHPCON( 'U', -1, A, IP, ANRM, RCOND, W, INFO ) 600 CALL CHKXER( 'CHPCON', INFOT, NOUT, LERR, OK ) 601 INFOT = 5 602 CALL CHPCON( 'U', 1, A, IP, -ANRM, RCOND, W, INFO ) 603 CALL CHKXER( 'CHPCON', 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 CERRHE 613* 614 END 615