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