1*> \brief \b CERRPO 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 CERRPO( 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*> CERRPO tests the error exits for the COMPLEX routines 25*> for Hermitian positive definite matrices. 26*> \endverbatim 27* 28* Arguments: 29* ========== 30* 31*> \param[in] PATH 32*> \verbatim 33*> PATH is CHARACTER*3 34*> The LAPACK path name for the routines to be tested. 35*> \endverbatim 36*> 37*> \param[in] NUNIT 38*> \verbatim 39*> NUNIT is INTEGER 40*> The unit number for output. 41*> \endverbatim 42* 43* Authors: 44* ======== 45* 46*> \author Univ. of Tennessee 47*> \author Univ. of California Berkeley 48*> \author Univ. of Colorado Denver 49*> \author NAG Ltd. 50* 51*> \ingroup complex_lin 52* 53* ===================================================================== 54 SUBROUTINE CERRPO( PATH, NUNIT ) 55* 56* -- LAPACK test routine -- 57* -- LAPACK is a software package provided by Univ. of Tennessee, -- 58* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 59* 60* .. Scalar Arguments .. 61 CHARACTER*3 PATH 62 INTEGER NUNIT 63* .. 64* 65* ===================================================================== 66* 67* .. Parameters .. 68 INTEGER NMAX 69 PARAMETER ( NMAX = 4 ) 70* .. 71* .. Local Scalars .. 72 CHARACTER*2 C2 73 INTEGER I, INFO, J 74 REAL ANRM, RCOND 75* .. 76* .. Local Arrays .. 77 REAL R( NMAX ), R1( NMAX ), R2( NMAX ) 78 COMPLEX A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ), 79 $ W( 2*NMAX ), X( NMAX ) 80* .. 81* .. External Functions .. 82 LOGICAL LSAMEN 83 EXTERNAL LSAMEN 84* .. 85* .. External Subroutines .. 86 EXTERNAL ALAESM, CHKXER, CPBCON, CPBEQU, CPBRFS, CPBTF2, 87 $ CPBTRF, CPBTRS, CPOCON, CPOEQU, CPORFS, CPOTF2, 88 $ CPOTRF, CPOTRI, CPOTRS, CPPCON, CPPEQU, CPPRFS, 89 $ CPPTRF, CPPTRI, CPPTRS 90* .. 91* .. Scalars in Common .. 92 LOGICAL LERR, OK 93 CHARACTER*32 SRNAMT 94 INTEGER INFOT, NOUT 95* .. 96* .. Common blocks .. 97 COMMON / INFOC / INFOT, NOUT, OK, LERR 98 COMMON / SRNAMC / SRNAMT 99* .. 100* .. Intrinsic Functions .. 101 INTRINSIC CMPLX, REAL 102* .. 103* .. Executable Statements .. 104* 105 NOUT = NUNIT 106 WRITE( NOUT, FMT = * ) 107 C2 = PATH( 2: 3 ) 108* 109* Set the variables to innocuous values. 110* 111 DO 20 J = 1, NMAX 112 DO 10 I = 1, NMAX 113 A( I, J ) = CMPLX( 1. / REAL( I+J ), -1. / REAL( I+J ) ) 114 AF( I, J ) = CMPLX( 1. / REAL( I+J ), -1. / REAL( I+J ) ) 115 10 CONTINUE 116 B( J ) = 0. 117 R1( J ) = 0. 118 R2( J ) = 0. 119 W( J ) = 0. 120 X( J ) = 0. 121 20 CONTINUE 122 ANRM = 1. 123 OK = .TRUE. 124* 125* Test error exits of the routines that use the Cholesky 126* decomposition of a Hermitian positive definite matrix. 127* 128 IF( LSAMEN( 2, C2, 'PO' ) ) THEN 129* 130* CPOTRF 131* 132 SRNAMT = 'CPOTRF' 133 INFOT = 1 134 CALL CPOTRF( '/', 0, A, 1, INFO ) 135 CALL CHKXER( 'CPOTRF', INFOT, NOUT, LERR, OK ) 136 INFOT = 2 137 CALL CPOTRF( 'U', -1, A, 1, INFO ) 138 CALL CHKXER( 'CPOTRF', INFOT, NOUT, LERR, OK ) 139 INFOT = 4 140 CALL CPOTRF( 'U', 2, A, 1, INFO ) 141 CALL CHKXER( 'CPOTRF', INFOT, NOUT, LERR, OK ) 142* 143* CPOTF2 144* 145 SRNAMT = 'CPOTF2' 146 INFOT = 1 147 CALL CPOTF2( '/', 0, A, 1, INFO ) 148 CALL CHKXER( 'CPOTF2', INFOT, NOUT, LERR, OK ) 149 INFOT = 2 150 CALL CPOTF2( 'U', -1, A, 1, INFO ) 151 CALL CHKXER( 'CPOTF2', INFOT, NOUT, LERR, OK ) 152 INFOT = 4 153 CALL CPOTF2( 'U', 2, A, 1, INFO ) 154 CALL CHKXER( 'CPOTF2', INFOT, NOUT, LERR, OK ) 155* 156* CPOTRI 157* 158 SRNAMT = 'CPOTRI' 159 INFOT = 1 160 CALL CPOTRI( '/', 0, A, 1, INFO ) 161 CALL CHKXER( 'CPOTRI', INFOT, NOUT, LERR, OK ) 162 INFOT = 2 163 CALL CPOTRI( 'U', -1, A, 1, INFO ) 164 CALL CHKXER( 'CPOTRI', INFOT, NOUT, LERR, OK ) 165 INFOT = 4 166 CALL CPOTRI( 'U', 2, A, 1, INFO ) 167 CALL CHKXER( 'CPOTRI', INFOT, NOUT, LERR, OK ) 168* 169* CPOTRS 170* 171 SRNAMT = 'CPOTRS' 172 INFOT = 1 173 CALL CPOTRS( '/', 0, 0, A, 1, B, 1, INFO ) 174 CALL CHKXER( 'CPOTRS', INFOT, NOUT, LERR, OK ) 175 INFOT = 2 176 CALL CPOTRS( 'U', -1, 0, A, 1, B, 1, INFO ) 177 CALL CHKXER( 'CPOTRS', INFOT, NOUT, LERR, OK ) 178 INFOT = 3 179 CALL CPOTRS( 'U', 0, -1, A, 1, B, 1, INFO ) 180 CALL CHKXER( 'CPOTRS', INFOT, NOUT, LERR, OK ) 181 INFOT = 5 182 CALL CPOTRS( 'U', 2, 1, A, 1, B, 2, INFO ) 183 CALL CHKXER( 'CPOTRS', INFOT, NOUT, LERR, OK ) 184 INFOT = 7 185 CALL CPOTRS( 'U', 2, 1, A, 2, B, 1, INFO ) 186 CALL CHKXER( 'CPOTRS', INFOT, NOUT, LERR, OK ) 187* 188* CPORFS 189* 190 SRNAMT = 'CPORFS' 191 INFOT = 1 192 CALL CPORFS( '/', 0, 0, A, 1, AF, 1, B, 1, X, 1, R1, R2, W, R, 193 $ INFO ) 194 CALL CHKXER( 'CPORFS', INFOT, NOUT, LERR, OK ) 195 INFOT = 2 196 CALL CPORFS( 'U', -1, 0, A, 1, AF, 1, B, 1, X, 1, R1, R2, W, R, 197 $ INFO ) 198 CALL CHKXER( 'CPORFS', INFOT, NOUT, LERR, OK ) 199 INFOT = 3 200 CALL CPORFS( 'U', 0, -1, A, 1, AF, 1, B, 1, X, 1, R1, R2, W, R, 201 $ INFO ) 202 CALL CHKXER( 'CPORFS', INFOT, NOUT, LERR, OK ) 203 INFOT = 5 204 CALL CPORFS( 'U', 2, 1, A, 1, AF, 2, B, 2, X, 2, R1, R2, W, R, 205 $ INFO ) 206 CALL CHKXER( 'CPORFS', INFOT, NOUT, LERR, OK ) 207 INFOT = 7 208 CALL CPORFS( 'U', 2, 1, A, 2, AF, 1, B, 2, X, 2, R1, R2, W, R, 209 $ INFO ) 210 CALL CHKXER( 'CPORFS', INFOT, NOUT, LERR, OK ) 211 INFOT = 9 212 CALL CPORFS( 'U', 2, 1, A, 2, AF, 2, B, 1, X, 2, R1, R2, W, R, 213 $ INFO ) 214 CALL CHKXER( 'CPORFS', INFOT, NOUT, LERR, OK ) 215 INFOT = 11 216 CALL CPORFS( 'U', 2, 1, A, 2, AF, 2, B, 2, X, 1, R1, R2, W, R, 217 $ INFO ) 218 CALL CHKXER( 'CPORFS', INFOT, NOUT, LERR, OK ) 219* 220* CPOCON 221* 222 SRNAMT = 'CPOCON' 223 INFOT = 1 224 CALL CPOCON( '/', 0, A, 1, ANRM, RCOND, W, R, INFO ) 225 CALL CHKXER( 'CPOCON', INFOT, NOUT, LERR, OK ) 226 INFOT = 2 227 CALL CPOCON( 'U', -1, A, 1, ANRM, RCOND, W, R, INFO ) 228 CALL CHKXER( 'CPOCON', INFOT, NOUT, LERR, OK ) 229 INFOT = 4 230 CALL CPOCON( 'U', 2, A, 1, ANRM, RCOND, W, R, INFO ) 231 CALL CHKXER( 'CPOCON', INFOT, NOUT, LERR, OK ) 232 INFOT = 5 233 CALL CPOCON( 'U', 1, A, 1, -ANRM, RCOND, W, R, INFO ) 234 CALL CHKXER( 'CPOCON', INFOT, NOUT, LERR, OK ) 235* 236* CPOEQU 237* 238 SRNAMT = 'CPOEQU' 239 INFOT = 1 240 CALL CPOEQU( -1, A, 1, R1, RCOND, ANRM, INFO ) 241 CALL CHKXER( 'CPOEQU', INFOT, NOUT, LERR, OK ) 242 INFOT = 3 243 CALL CPOEQU( 2, A, 1, R1, RCOND, ANRM, INFO ) 244 CALL CHKXER( 'CPOEQU', INFOT, NOUT, LERR, OK ) 245* 246* Test error exits of the routines that use the Cholesky 247* decomposition of a Hermitian positive definite packed matrix. 248* 249 ELSE IF( LSAMEN( 2, C2, 'PP' ) ) THEN 250* 251* CPPTRF 252* 253 SRNAMT = 'CPPTRF' 254 INFOT = 1 255 CALL CPPTRF( '/', 0, A, INFO ) 256 CALL CHKXER( 'CPPTRF', INFOT, NOUT, LERR, OK ) 257 INFOT = 2 258 CALL CPPTRF( 'U', -1, A, INFO ) 259 CALL CHKXER( 'CPPTRF', INFOT, NOUT, LERR, OK ) 260* 261* CPPTRI 262* 263 SRNAMT = 'CPPTRI' 264 INFOT = 1 265 CALL CPPTRI( '/', 0, A, INFO ) 266 CALL CHKXER( 'CPPTRI', INFOT, NOUT, LERR, OK ) 267 INFOT = 2 268 CALL CPPTRI( 'U', -1, A, INFO ) 269 CALL CHKXER( 'CPPTRI', INFOT, NOUT, LERR, OK ) 270* 271* CPPTRS 272* 273 SRNAMT = 'CPPTRS' 274 INFOT = 1 275 CALL CPPTRS( '/', 0, 0, A, B, 1, INFO ) 276 CALL CHKXER( 'CPPTRS', INFOT, NOUT, LERR, OK ) 277 INFOT = 2 278 CALL CPPTRS( 'U', -1, 0, A, B, 1, INFO ) 279 CALL CHKXER( 'CPPTRS', INFOT, NOUT, LERR, OK ) 280 INFOT = 3 281 CALL CPPTRS( 'U', 0, -1, A, B, 1, INFO ) 282 CALL CHKXER( 'CPPTRS', INFOT, NOUT, LERR, OK ) 283 INFOT = 6 284 CALL CPPTRS( 'U', 2, 1, A, B, 1, INFO ) 285 CALL CHKXER( 'CPPTRS', INFOT, NOUT, LERR, OK ) 286* 287* CPPRFS 288* 289 SRNAMT = 'CPPRFS' 290 INFOT = 1 291 CALL CPPRFS( '/', 0, 0, A, AF, B, 1, X, 1, R1, R2, W, R, INFO ) 292 CALL CHKXER( 'CPPRFS', INFOT, NOUT, LERR, OK ) 293 INFOT = 2 294 CALL CPPRFS( 'U', -1, 0, A, AF, B, 1, X, 1, R1, R2, W, R, 295 $ INFO ) 296 CALL CHKXER( 'CPPRFS', INFOT, NOUT, LERR, OK ) 297 INFOT = 3 298 CALL CPPRFS( 'U', 0, -1, A, AF, B, 1, X, 1, R1, R2, W, R, 299 $ INFO ) 300 CALL CHKXER( 'CPPRFS', INFOT, NOUT, LERR, OK ) 301 INFOT = 7 302 CALL CPPRFS( 'U', 2, 1, A, AF, B, 1, X, 2, R1, R2, W, R, INFO ) 303 CALL CHKXER( 'CPPRFS', INFOT, NOUT, LERR, OK ) 304 INFOT = 9 305 CALL CPPRFS( 'U', 2, 1, A, AF, B, 2, X, 1, R1, R2, W, R, INFO ) 306 CALL CHKXER( 'CPPRFS', INFOT, NOUT, LERR, OK ) 307* 308* CPPCON 309* 310 SRNAMT = 'CPPCON' 311 INFOT = 1 312 CALL CPPCON( '/', 0, A, ANRM, RCOND, W, R, INFO ) 313 CALL CHKXER( 'CPPCON', INFOT, NOUT, LERR, OK ) 314 INFOT = 2 315 CALL CPPCON( 'U', -1, A, ANRM, RCOND, W, R, INFO ) 316 CALL CHKXER( 'CPPCON', INFOT, NOUT, LERR, OK ) 317 INFOT = 4 318 CALL CPPCON( 'U', 1, A, -ANRM, RCOND, W, R, INFO ) 319 CALL CHKXER( 'CPPCON', INFOT, NOUT, LERR, OK ) 320* 321* CPPEQU 322* 323 SRNAMT = 'CPPEQU' 324 INFOT = 1 325 CALL CPPEQU( '/', 0, A, R1, RCOND, ANRM, INFO ) 326 CALL CHKXER( 'CPPEQU', INFOT, NOUT, LERR, OK ) 327 INFOT = 2 328 CALL CPPEQU( 'U', -1, A, R1, RCOND, ANRM, INFO ) 329 CALL CHKXER( 'CPPEQU', INFOT, NOUT, LERR, OK ) 330* 331* Test error exits of the routines that use the Cholesky 332* decomposition of a Hermitian positive definite band matrix. 333* 334 ELSE IF( LSAMEN( 2, C2, 'PB' ) ) THEN 335* 336* CPBTRF 337* 338 SRNAMT = 'CPBTRF' 339 INFOT = 1 340 CALL CPBTRF( '/', 0, 0, A, 1, INFO ) 341 CALL CHKXER( 'CPBTRF', INFOT, NOUT, LERR, OK ) 342 INFOT = 2 343 CALL CPBTRF( 'U', -1, 0, A, 1, INFO ) 344 CALL CHKXER( 'CPBTRF', INFOT, NOUT, LERR, OK ) 345 INFOT = 3 346 CALL CPBTRF( 'U', 1, -1, A, 1, INFO ) 347 CALL CHKXER( 'CPBTRF', INFOT, NOUT, LERR, OK ) 348 INFOT = 5 349 CALL CPBTRF( 'U', 2, 1, A, 1, INFO ) 350 CALL CHKXER( 'CPBTRF', INFOT, NOUT, LERR, OK ) 351* 352* CPBTF2 353* 354 SRNAMT = 'CPBTF2' 355 INFOT = 1 356 CALL CPBTF2( '/', 0, 0, A, 1, INFO ) 357 CALL CHKXER( 'CPBTF2', INFOT, NOUT, LERR, OK ) 358 INFOT = 2 359 CALL CPBTF2( 'U', -1, 0, A, 1, INFO ) 360 CALL CHKXER( 'CPBTF2', INFOT, NOUT, LERR, OK ) 361 INFOT = 3 362 CALL CPBTF2( 'U', 1, -1, A, 1, INFO ) 363 CALL CHKXER( 'CPBTF2', INFOT, NOUT, LERR, OK ) 364 INFOT = 5 365 CALL CPBTF2( 'U', 2, 1, A, 1, INFO ) 366 CALL CHKXER( 'CPBTF2', INFOT, NOUT, LERR, OK ) 367* 368* CPBTRS 369* 370 SRNAMT = 'CPBTRS' 371 INFOT = 1 372 CALL CPBTRS( '/', 0, 0, 0, A, 1, B, 1, INFO ) 373 CALL CHKXER( 'CPBTRS', INFOT, NOUT, LERR, OK ) 374 INFOT = 2 375 CALL CPBTRS( 'U', -1, 0, 0, A, 1, B, 1, INFO ) 376 CALL CHKXER( 'CPBTRS', INFOT, NOUT, LERR, OK ) 377 INFOT = 3 378 CALL CPBTRS( 'U', 1, -1, 0, A, 1, B, 1, INFO ) 379 CALL CHKXER( 'CPBTRS', INFOT, NOUT, LERR, OK ) 380 INFOT = 4 381 CALL CPBTRS( 'U', 0, 0, -1, A, 1, B, 1, INFO ) 382 CALL CHKXER( 'CPBTRS', INFOT, NOUT, LERR, OK ) 383 INFOT = 6 384 CALL CPBTRS( 'U', 2, 1, 1, A, 1, B, 1, INFO ) 385 CALL CHKXER( 'CPBTRS', INFOT, NOUT, LERR, OK ) 386 INFOT = 8 387 CALL CPBTRS( 'U', 2, 0, 1, A, 1, B, 1, INFO ) 388 CALL CHKXER( 'CPBTRS', INFOT, NOUT, LERR, OK ) 389* 390* CPBRFS 391* 392 SRNAMT = 'CPBRFS' 393 INFOT = 1 394 CALL CPBRFS( '/', 0, 0, 0, A, 1, AF, 1, B, 1, X, 1, R1, R2, W, 395 $ R, INFO ) 396 CALL CHKXER( 'CPBRFS', INFOT, NOUT, LERR, OK ) 397 INFOT = 2 398 CALL CPBRFS( 'U', -1, 0, 0, A, 1, AF, 1, B, 1, X, 1, R1, R2, W, 399 $ R, INFO ) 400 CALL CHKXER( 'CPBRFS', INFOT, NOUT, LERR, OK ) 401 INFOT = 3 402 CALL CPBRFS( 'U', 1, -1, 0, A, 1, AF, 1, B, 1, X, 1, R1, R2, W, 403 $ R, INFO ) 404 CALL CHKXER( 'CPBRFS', INFOT, NOUT, LERR, OK ) 405 INFOT = 4 406 CALL CPBRFS( 'U', 0, 0, -1, A, 1, AF, 1, B, 1, X, 1, R1, R2, W, 407 $ R, INFO ) 408 CALL CHKXER( 'CPBRFS', INFOT, NOUT, LERR, OK ) 409 INFOT = 6 410 CALL CPBRFS( 'U', 2, 1, 1, A, 1, AF, 2, B, 2, X, 2, R1, R2, W, 411 $ R, INFO ) 412 CALL CHKXER( 'CPBRFS', INFOT, NOUT, LERR, OK ) 413 INFOT = 8 414 CALL CPBRFS( 'U', 2, 1, 1, A, 2, AF, 1, B, 2, X, 2, R1, R2, W, 415 $ R, INFO ) 416 CALL CHKXER( 'CPBRFS', INFOT, NOUT, LERR, OK ) 417 INFOT = 10 418 CALL CPBRFS( 'U', 2, 0, 1, A, 1, AF, 1, B, 1, X, 2, R1, R2, W, 419 $ R, INFO ) 420 CALL CHKXER( 'CPBRFS', INFOT, NOUT, LERR, OK ) 421 INFOT = 12 422 CALL CPBRFS( 'U', 2, 0, 1, A, 1, AF, 1, B, 2, X, 1, R1, R2, W, 423 $ R, INFO ) 424 CALL CHKXER( 'CPBRFS', INFOT, NOUT, LERR, OK ) 425* 426* CPBCON 427* 428 SRNAMT = 'CPBCON' 429 INFOT = 1 430 CALL CPBCON( '/', 0, 0, A, 1, ANRM, RCOND, W, R, INFO ) 431 CALL CHKXER( 'CPBCON', INFOT, NOUT, LERR, OK ) 432 INFOT = 2 433 CALL CPBCON( 'U', -1, 0, A, 1, ANRM, RCOND, W, R, INFO ) 434 CALL CHKXER( 'CPBCON', INFOT, NOUT, LERR, OK ) 435 INFOT = 3 436 CALL CPBCON( 'U', 1, -1, A, 1, ANRM, RCOND, W, R, INFO ) 437 CALL CHKXER( 'CPBCON', INFOT, NOUT, LERR, OK ) 438 INFOT = 5 439 CALL CPBCON( 'U', 2, 1, A, 1, ANRM, RCOND, W, R, INFO ) 440 CALL CHKXER( 'CPBCON', INFOT, NOUT, LERR, OK ) 441 INFOT = 6 442 CALL CPBCON( 'U', 1, 0, A, 1, -ANRM, RCOND, W, R, INFO ) 443 CALL CHKXER( 'CPBCON', INFOT, NOUT, LERR, OK ) 444* 445* CPBEQU 446* 447 SRNAMT = 'CPBEQU' 448 INFOT = 1 449 CALL CPBEQU( '/', 0, 0, A, 1, R1, RCOND, ANRM, INFO ) 450 CALL CHKXER( 'CPBEQU', INFOT, NOUT, LERR, OK ) 451 INFOT = 2 452 CALL CPBEQU( 'U', -1, 0, A, 1, R1, RCOND, ANRM, INFO ) 453 CALL CHKXER( 'CPBEQU', INFOT, NOUT, LERR, OK ) 454 INFOT = 3 455 CALL CPBEQU( 'U', 1, -1, A, 1, R1, RCOND, ANRM, INFO ) 456 CALL CHKXER( 'CPBEQU', INFOT, NOUT, LERR, OK ) 457 INFOT = 5 458 CALL CPBEQU( 'U', 2, 1, A, 1, R1, RCOND, ANRM, INFO ) 459 CALL CHKXER( 'CPBEQU', INFOT, NOUT, LERR, OK ) 460 END IF 461* 462* Print a summary line. 463* 464 CALL ALAESM( PATH, OK, NOUT ) 465* 466 RETURN 467* 468* End of CERRPO 469* 470 END 471