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