1*> \brief \b ZCHKPO 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 ZCHKPO( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL, 12* THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, 13* XACT, WORK, RWORK, NOUT ) 14* 15* .. Scalar Arguments .. 16* LOGICAL TSTERR 17* INTEGER NMAX, NN, NNB, NNS, NOUT 18* DOUBLE PRECISION THRESH 19* .. 20* .. Array Arguments .. 21* LOGICAL DOTYPE( * ) 22* INTEGER NBVAL( * ), NSVAL( * ), NVAL( * ) 23* DOUBLE PRECISION RWORK( * ) 24* COMPLEX*16 A( * ), AFAC( * ), AINV( * ), B( * ), 25* $ WORK( * ), X( * ), XACT( * ) 26* .. 27* 28* 29*> \par Purpose: 30* ============= 31*> 32*> \verbatim 33*> 34*> ZCHKPO tests ZPOTRF, -TRI, -TRS, -RFS, and -CON 35*> \endverbatim 36* 37* Arguments: 38* ========== 39* 40*> \param[in] DOTYPE 41*> \verbatim 42*> DOTYPE is LOGICAL array, dimension (NTYPES) 43*> The matrix types to be used for testing. Matrices of type j 44*> (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) = 45*> .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used. 46*> \endverbatim 47*> 48*> \param[in] NN 49*> \verbatim 50*> NN is INTEGER 51*> The number of values of N contained in the vector NVAL. 52*> \endverbatim 53*> 54*> \param[in] NVAL 55*> \verbatim 56*> NVAL is INTEGER array, dimension (NN) 57*> The values of the matrix dimension N. 58*> \endverbatim 59*> 60*> \param[in] NNB 61*> \verbatim 62*> NNB is INTEGER 63*> The number of values of NB contained in the vector NBVAL. 64*> \endverbatim 65*> 66*> \param[in] NBVAL 67*> \verbatim 68*> NBVAL is INTEGER array, dimension (NBVAL) 69*> The values of the blocksize NB. 70*> \endverbatim 71*> 72*> \param[in] NNS 73*> \verbatim 74*> NNS is INTEGER 75*> The number of values of NRHS contained in the vector NSVAL. 76*> \endverbatim 77*> 78*> \param[in] NSVAL 79*> \verbatim 80*> NSVAL is INTEGER array, dimension (NNS) 81*> The values of the number of right hand sides NRHS. 82*> \endverbatim 83*> 84*> \param[in] THRESH 85*> \verbatim 86*> THRESH is DOUBLE PRECISION 87*> The threshold value for the test ratios. A result is 88*> included in the output file if RESULT >= THRESH. To have 89*> every test ratio printed, use THRESH = 0. 90*> \endverbatim 91*> 92*> \param[in] TSTERR 93*> \verbatim 94*> TSTERR is LOGICAL 95*> Flag that indicates whether error exits are to be tested. 96*> \endverbatim 97*> 98*> \param[in] NMAX 99*> \verbatim 100*> NMAX is INTEGER 101*> The maximum value permitted for N, used in dimensioning the 102*> work arrays. 103*> \endverbatim 104*> 105*> \param[out] A 106*> \verbatim 107*> A is COMPLEX*16 array, dimension (NMAX*NMAX) 108*> \endverbatim 109*> 110*> \param[out] AFAC 111*> \verbatim 112*> AFAC is COMPLEX*16 array, dimension (NMAX*NMAX) 113*> \endverbatim 114*> 115*> \param[out] AINV 116*> \verbatim 117*> AINV is COMPLEX*16 array, dimension (NMAX*NMAX) 118*> \endverbatim 119*> 120*> \param[out] B 121*> \verbatim 122*> B is COMPLEX*16 array, dimension (NMAX*NSMAX) 123*> where NSMAX is the largest entry in NSVAL. 124*> \endverbatim 125*> 126*> \param[out] X 127*> \verbatim 128*> X is COMPLEX*16 array, dimension (NMAX*NSMAX) 129*> \endverbatim 130*> 131*> \param[out] XACT 132*> \verbatim 133*> XACT is COMPLEX*16 array, dimension (NMAX*NSMAX) 134*> \endverbatim 135*> 136*> \param[out] WORK 137*> \verbatim 138*> WORK is COMPLEX*16 array, dimension 139*> (NMAX*max(3,NSMAX)) 140*> \endverbatim 141*> 142*> \param[out] RWORK 143*> \verbatim 144*> RWORK is DOUBLE PRECISION array, dimension 145*> (NMAX+2*NSMAX) 146*> \endverbatim 147*> 148*> \param[in] NOUT 149*> \verbatim 150*> NOUT is INTEGER 151*> The unit number for output. 152*> \endverbatim 153* 154* Authors: 155* ======== 156* 157*> \author Univ. of Tennessee 158*> \author Univ. of California Berkeley 159*> \author Univ. of Colorado Denver 160*> \author NAG Ltd. 161* 162*> \date December 2016 163* 164*> \ingroup complex16_lin 165* 166* ===================================================================== 167 SUBROUTINE ZCHKPO( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL, 168 $ THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, 169 $ XACT, WORK, RWORK, NOUT ) 170* 171* -- LAPACK test routine (version 3.7.0) -- 172* -- LAPACK is a software package provided by Univ. of Tennessee, -- 173* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 174* December 2016 175* 176* .. Scalar Arguments .. 177 LOGICAL TSTERR 178 INTEGER NMAX, NN, NNB, NNS, NOUT 179 DOUBLE PRECISION THRESH 180* .. 181* .. Array Arguments .. 182 LOGICAL DOTYPE( * ) 183 INTEGER NBVAL( * ), NSVAL( * ), NVAL( * ) 184 DOUBLE PRECISION RWORK( * ) 185 COMPLEX*16 A( * ), AFAC( * ), AINV( * ), B( * ), 186 $ WORK( * ), X( * ), XACT( * ) 187* .. 188* 189* ===================================================================== 190* 191* .. Parameters .. 192 COMPLEX*16 CZERO 193 PARAMETER ( CZERO = ( 0.0D+0, 0.0D+0 ) ) 194 INTEGER NTYPES 195 PARAMETER ( NTYPES = 9 ) 196 INTEGER NTESTS 197 PARAMETER ( NTESTS = 8 ) 198* .. 199* .. Local Scalars .. 200 LOGICAL ZEROT 201 CHARACTER DIST, TYPE, UPLO, XTYPE 202 CHARACTER*3 PATH 203 INTEGER I, IMAT, IN, INB, INFO, IOFF, IRHS, IUPLO, 204 $ IZERO, K, KL, KU, LDA, MODE, N, NB, NERRS, 205 $ NFAIL, NIMAT, NRHS, NRUN 206 DOUBLE PRECISION ANORM, CNDNUM, RCOND, RCONDC 207* .. 208* .. Local Arrays .. 209 CHARACTER UPLOS( 2 ) 210 INTEGER ISEED( 4 ), ISEEDY( 4 ) 211 DOUBLE PRECISION RESULT( NTESTS ) 212* .. 213* .. External Functions .. 214 DOUBLE PRECISION DGET06, ZLANHE 215 EXTERNAL DGET06, ZLANHE 216* .. 217* .. External Subroutines .. 218 EXTERNAL ALAERH, ALAHD, ALASUM, XLAENV, ZERRPO, ZGET04, 219 $ ZLACPY, ZLAIPD, ZLARHS, ZLATB4, ZLATMS, ZPOCON, 220 $ ZPORFS, ZPOT01, ZPOT02, ZPOT03, ZPOT05, ZPOTRF, 221 $ ZPOTRI, ZPOTRS 222* .. 223* .. Scalars in Common .. 224 LOGICAL LERR, OK 225 CHARACTER*32 SRNAMT 226 INTEGER INFOT, NUNIT 227* .. 228* .. Common blocks .. 229 COMMON / INFOC / INFOT, NUNIT, OK, LERR 230 COMMON / SRNAMC / SRNAMT 231* .. 232* .. Intrinsic Functions .. 233 INTRINSIC MAX 234* .. 235* .. Data statements .. 236 DATA ISEEDY / 1988, 1989, 1990, 1991 / 237 DATA UPLOS / 'U', 'L' / 238* .. 239* .. Executable Statements .. 240* 241* Initialize constants and the random number seed. 242* 243 PATH( 1: 1 ) = 'Zomplex precision' 244 PATH( 2: 3 ) = 'PO' 245 NRUN = 0 246 NFAIL = 0 247 NERRS = 0 248 DO 10 I = 1, 4 249 ISEED( I ) = ISEEDY( I ) 250 10 CONTINUE 251* 252* Test the error exits 253* 254 IF( TSTERR ) 255 $ CALL ZERRPO( PATH, NOUT ) 256 INFOT = 0 257* 258* Do for each value of N in NVAL 259* 260 DO 120 IN = 1, NN 261 N = NVAL( IN ) 262 LDA = MAX( N, 1 ) 263 XTYPE = 'N' 264 NIMAT = NTYPES 265 IF( N.LE.0 ) 266 $ NIMAT = 1 267* 268 IZERO = 0 269 DO 110 IMAT = 1, NIMAT 270* 271* Do the tests only if DOTYPE( IMAT ) is true. 272* 273 IF( .NOT.DOTYPE( IMAT ) ) 274 $ GO TO 110 275* 276* Skip types 3, 4, or 5 if the matrix size is too small. 277* 278 ZEROT = IMAT.GE.3 .AND. IMAT.LE.5 279 IF( ZEROT .AND. N.LT.IMAT-2 ) 280 $ GO TO 110 281* 282* Do first for UPLO = 'U', then for UPLO = 'L' 283* 284 DO 100 IUPLO = 1, 2 285 UPLO = UPLOS( IUPLO ) 286* 287* Set up parameters with ZLATB4 and generate a test matrix 288* with ZLATMS. 289* 290 CALL ZLATB4( PATH, IMAT, N, N, TYPE, KL, KU, ANORM, MODE, 291 $ CNDNUM, DIST ) 292* 293 SRNAMT = 'ZLATMS' 294 CALL ZLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE, 295 $ CNDNUM, ANORM, KL, KU, UPLO, A, LDA, WORK, 296 $ INFO ) 297* 298* Check error code from ZLATMS. 299* 300 IF( INFO.NE.0 ) THEN 301 CALL ALAERH( PATH, 'ZLATMS', INFO, 0, UPLO, N, N, -1, 302 $ -1, -1, IMAT, NFAIL, NERRS, NOUT ) 303 GO TO 100 304 END IF 305* 306* For types 3-5, zero one row and column of the matrix to 307* test that INFO is returned correctly. 308* 309 IF( ZEROT ) THEN 310 IF( IMAT.EQ.3 ) THEN 311 IZERO = 1 312 ELSE IF( IMAT.EQ.4 ) THEN 313 IZERO = N 314 ELSE 315 IZERO = N / 2 + 1 316 END IF 317 IOFF = ( IZERO-1 )*LDA 318* 319* Set row and column IZERO of A to 0. 320* 321 IF( IUPLO.EQ.1 ) THEN 322 DO 20 I = 1, IZERO - 1 323 A( IOFF+I ) = CZERO 324 20 CONTINUE 325 IOFF = IOFF + IZERO 326 DO 30 I = IZERO, N 327 A( IOFF ) = CZERO 328 IOFF = IOFF + LDA 329 30 CONTINUE 330 ELSE 331 IOFF = IZERO 332 DO 40 I = 1, IZERO - 1 333 A( IOFF ) = CZERO 334 IOFF = IOFF + LDA 335 40 CONTINUE 336 IOFF = IOFF - IZERO 337 DO 50 I = IZERO, N 338 A( IOFF+I ) = CZERO 339 50 CONTINUE 340 END IF 341 ELSE 342 IZERO = 0 343 END IF 344* 345* Set the imaginary part of the diagonals. 346* 347 CALL ZLAIPD( N, A, LDA+1, 0 ) 348* 349* Do for each value of NB in NBVAL 350* 351 DO 90 INB = 1, NNB 352 NB = NBVAL( INB ) 353 CALL XLAENV( 1, NB ) 354* 355* Compute the L*L' or U'*U factorization of the matrix. 356* 357 CALL ZLACPY( UPLO, N, N, A, LDA, AFAC, LDA ) 358 SRNAMT = 'ZPOTRF' 359 CALL ZPOTRF( UPLO, N, AFAC, LDA, INFO ) 360* 361* Check error code from ZPOTRF. 362* 363 IF( INFO.NE.IZERO ) THEN 364 CALL ALAERH( PATH, 'ZPOTRF', INFO, IZERO, UPLO, N, 365 $ N, -1, -1, NB, IMAT, NFAIL, NERRS, 366 $ NOUT ) 367 GO TO 90 368 END IF 369* 370* Skip the tests if INFO is not 0. 371* 372 IF( INFO.NE.0 ) 373 $ GO TO 90 374* 375*+ TEST 1 376* Reconstruct matrix from factors and compute residual. 377* 378 CALL ZLACPY( UPLO, N, N, AFAC, LDA, AINV, LDA ) 379 CALL ZPOT01( UPLO, N, A, LDA, AINV, LDA, RWORK, 380 $ RESULT( 1 ) ) 381* 382*+ TEST 2 383* Form the inverse and compute the residual. 384* 385 CALL ZLACPY( UPLO, N, N, AFAC, LDA, AINV, LDA ) 386 SRNAMT = 'ZPOTRI' 387 CALL ZPOTRI( UPLO, N, AINV, LDA, INFO ) 388* 389* Check error code from ZPOTRI. 390* 391 IF( INFO.NE.0 ) 392 $ CALL ALAERH( PATH, 'ZPOTRI', INFO, 0, UPLO, N, N, 393 $ -1, -1, -1, IMAT, NFAIL, NERRS, NOUT ) 394* 395 CALL ZPOT03( UPLO, N, A, LDA, AINV, LDA, WORK, LDA, 396 $ RWORK, RCONDC, RESULT( 2 ) ) 397* 398* Print information about the tests that did not pass 399* the threshold. 400* 401 DO 60 K = 1, 2 402 IF( RESULT( K ).GE.THRESH ) THEN 403 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 404 $ CALL ALAHD( NOUT, PATH ) 405 WRITE( NOUT, FMT = 9999 )UPLO, N, NB, IMAT, K, 406 $ RESULT( K ) 407 NFAIL = NFAIL + 1 408 END IF 409 60 CONTINUE 410 NRUN = NRUN + 2 411* 412* Skip the rest of the tests unless this is the first 413* blocksize. 414* 415 IF( INB.NE.1 ) 416 $ GO TO 90 417* 418 DO 80 IRHS = 1, NNS 419 NRHS = NSVAL( IRHS ) 420* 421*+ TEST 3 422* Solve and compute residual for A * X = B . 423* 424 SRNAMT = 'ZLARHS' 425 CALL ZLARHS( PATH, XTYPE, UPLO, ' ', N, N, KL, KU, 426 $ NRHS, A, LDA, XACT, LDA, B, LDA, 427 $ ISEED, INFO ) 428 CALL ZLACPY( 'Full', N, NRHS, B, LDA, X, LDA ) 429* 430 SRNAMT = 'ZPOTRS' 431 CALL ZPOTRS( UPLO, N, NRHS, AFAC, LDA, X, LDA, 432 $ INFO ) 433* 434* Check error code from ZPOTRS. 435* 436 IF( INFO.NE.0 ) 437 $ CALL ALAERH( PATH, 'ZPOTRS', INFO, 0, UPLO, N, 438 $ N, -1, -1, NRHS, IMAT, NFAIL, 439 $ NERRS, NOUT ) 440* 441 CALL ZLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA ) 442 CALL ZPOT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK, 443 $ LDA, RWORK, RESULT( 3 ) ) 444* 445*+ TEST 4 446* Check solution from generated exact solution. 447* 448 CALL ZGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC, 449 $ RESULT( 4 ) ) 450* 451*+ TESTS 5, 6, and 7 452* Use iterative refinement to improve the solution. 453* 454 SRNAMT = 'ZPORFS' 455 CALL ZPORFS( UPLO, N, NRHS, A, LDA, AFAC, LDA, B, 456 $ LDA, X, LDA, RWORK, RWORK( NRHS+1 ), 457 $ WORK, RWORK( 2*NRHS+1 ), INFO ) 458* 459* Check error code from ZPORFS. 460* 461 IF( INFO.NE.0 ) 462 $ CALL ALAERH( PATH, 'ZPORFS', INFO, 0, UPLO, N, 463 $ N, -1, -1, NRHS, IMAT, NFAIL, 464 $ NERRS, NOUT ) 465* 466 CALL ZGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC, 467 $ RESULT( 5 ) ) 468 CALL ZPOT05( UPLO, N, NRHS, A, LDA, B, LDA, X, LDA, 469 $ XACT, LDA, RWORK, RWORK( NRHS+1 ), 470 $ RESULT( 6 ) ) 471* 472* Print information about the tests that did not pass 473* the threshold. 474* 475 DO 70 K = 3, 7 476 IF( RESULT( K ).GE.THRESH ) THEN 477 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 478 $ CALL ALAHD( NOUT, PATH ) 479 WRITE( NOUT, FMT = 9998 )UPLO, N, NRHS, 480 $ IMAT, K, RESULT( K ) 481 NFAIL = NFAIL + 1 482 END IF 483 70 CONTINUE 484 NRUN = NRUN + 5 485 80 CONTINUE 486* 487*+ TEST 8 488* Get an estimate of RCOND = 1/CNDNUM. 489* 490 ANORM = ZLANHE( '1', UPLO, N, A, LDA, RWORK ) 491 SRNAMT = 'ZPOCON' 492 CALL ZPOCON( UPLO, N, AFAC, LDA, ANORM, RCOND, WORK, 493 $ RWORK, INFO ) 494* 495* Check error code from ZPOCON. 496* 497 IF( INFO.NE.0 ) 498 $ CALL ALAERH( PATH, 'ZPOCON', INFO, 0, UPLO, N, N, 499 $ -1, -1, -1, IMAT, NFAIL, NERRS, NOUT ) 500* 501 RESULT( 8 ) = DGET06( RCOND, RCONDC ) 502* 503* Print the test ratio if it is .GE. THRESH. 504* 505 IF( RESULT( 8 ).GE.THRESH ) THEN 506 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 507 $ CALL ALAHD( NOUT, PATH ) 508 WRITE( NOUT, FMT = 9997 )UPLO, N, IMAT, 8, 509 $ RESULT( 8 ) 510 NFAIL = NFAIL + 1 511 END IF 512 NRUN = NRUN + 1 513 90 CONTINUE 514 100 CONTINUE 515 110 CONTINUE 516 120 CONTINUE 517* 518* Print a summary of the results. 519* 520 CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS ) 521* 522 9999 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ', NB =', I4, ', type ', 523 $ I2, ', test ', I2, ', ratio =', G12.5 ) 524 9998 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ', NRHS=', I3, ', type ', 525 $ I2, ', test(', I2, ') =', G12.5 ) 526 9997 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ',', 10X, ' type ', I2, 527 $ ', test(', I2, ') =', G12.5 ) 528 RETURN 529* 530* End of ZCHKPO 531* 532 END 533