TESTING/LIN/zdrvsyx.f

   1 *> \brief \b ZDRVSYX
   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 ZDRVSY( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX,
  12 *                          A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK,
  13 *                          NOUT )
  14 *
  15 *       .. Scalar Arguments ..
  16 *       LOGICAL            TSTERR
  17 *       INTEGER            NMAX, NN, NOUT, NRHS
  18 *       DOUBLE PRECISION   THRESH
  19 *       ..
  20 *       .. Array Arguments ..
  21 *       LOGICAL            DOTYPE( * )
  22 *       INTEGER            IWORK( * ), 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 *> ZDRVSY tests the driver routines ZSYSV, -SVX, and -SVXX.
  35 *>
  36 *> Note that this file is used only when the XBLAS are available,
  37 *> otherwise zdrvsy.f defines this subroutine.
  38 *> \endverbatim
  39 *
  40 *  Arguments:
  41 *  ==========
  42 *
  43 *> \param[in] DOTYPE
  44 *> \verbatim
  45 *>          DOTYPE is LOGICAL array, dimension (NTYPES)
  46 *>          The matrix types to be used for testing.  Matrices of type j
  47 *>          (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
  48 *>          .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
  49 *> \endverbatim
  50 *>
  51 *> \param[in] NN
  52 *> \verbatim
  53 *>          NN is INTEGER
  54 *>          The number of values of N contained in the vector NVAL.
  55 *> \endverbatim
  56 *>
  57 *> \param[in] NVAL
  58 *> \verbatim
  59 *>          NVAL is INTEGER array, dimension (NN)
  60 *>          The values of the matrix dimension N.
  61 *> \endverbatim
  62 *>
  63 *> \param[in] NRHS
  64 *> \verbatim
  65 *>          NRHS is INTEGER
  66 *>          The number of right hand side vectors to be generated for
  67 *>          each linear system.
  68 *> \endverbatim
  69 *>
  70 *> \param[in] THRESH
  71 *> \verbatim
  72 *>          THRESH is DOUBLE PRECISION
  73 *>          The threshold value for the test ratios.  A result is
  74 *>          included in the output file if RESULT >= THRESH.  To have
  75 *>          every test ratio printed, use THRESH = 0.
  76 *> \endverbatim
  77 *>
  78 *> \param[in] TSTERR
  79 *> \verbatim
  80 *>          TSTERR is LOGICAL
  81 *>          Flag that indicates whether error exits are to be tested.
  82 *> \endverbatim
  83 *>
  84 *> \param[in] NMAX
  85 *> \verbatim
  86 *>          NMAX is INTEGER
  87 *>          The maximum value permitted for N, used in dimensioning the
  88 *>          work arrays.
  89 *> \endverbatim
  90 *>
  91 *> \param[out] A
  92 *> \verbatim
  93 *>          A is COMPLEX*16 array, dimension (NMAX*NMAX)
  94 *> \endverbatim
  95 *>
  96 *> \param[out] AFAC
  97 *> \verbatim
  98 *>          AFAC is COMPLEX*16 array, dimension (NMAX*NMAX)
  99 *> \endverbatim
 100 *>
 101 *> \param[out] AINV
 102 *> \verbatim
 103 *>          AINV is COMPLEX*16 array, dimension (NMAX*NMAX)
 104 *> \endverbatim
 105 *>
 106 *> \param[out] B
 107 *> \verbatim
 108 *>          B is COMPLEX*16 array, dimension (NMAX*NRHS)
 109 *> \endverbatim
 110 *>
 111 *> \param[out] X
 112 *> \verbatim
 113 *>          X is COMPLEX*16 array, dimension (NMAX*NRHS)
 114 *> \endverbatim
 115 *>
 116 *> \param[out] XACT
 117 *> \verbatim
 118 *>          XACT is COMPLEX*16 array, dimension (NMAX*NRHS)
 119 *> \endverbatim
 120 *>
 121 *> \param[out] WORK
 122 *> \verbatim
 123 *>          WORK is COMPLEX*16 array, dimension
 124 *>                      (NMAX*max(2,NRHS))
 125 *> \endverbatim
 126 *>
 127 *> \param[out] RWORK
 128 *> \verbatim
 129 *>          RWORK is DOUBLE PRECISION array, dimension (2*NMAX+2*NRHS)
 130 *> \endverbatim
 131 *>
 132 *> \param[out] IWORK
 133 *> \verbatim
 134 *>          IWORK is INTEGER array, dimension (NMAX)
 135 *> \endverbatim
 136 *>
 137 *> \param[in] NOUT
 138 *> \verbatim
 139 *>          NOUT is INTEGER
 140 *>          The unit number for output.
 141 *> \endverbatim
 142 *
 143 *  Authors:
 144 *  ========
 145 *
 146 *> \author Univ. of Tennessee
 147 *> \author Univ. of California Berkeley
 148 *> \author Univ. of Colorado Denver
 149 *> \author NAG Ltd.
 150 *
 151 *> \date April 2012
 152 *
 153 *> \ingroup complex16_lin
 154 *
 155 *  =====================================================================
 156       SUBROUTINE ZDRVSY( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX,
 157      $                   A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK,
 158      $                   NOUT )
 159 *
 160 *  -- LAPACK test routine (version 3.4.1) --
 161 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 162 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
 163 *     April 2012
 164 *
 165 *     .. Scalar Arguments ..
 166       LOGICAL            TSTERR
 167       INTEGER            NMAX, NN, NOUT, NRHS
 168       DOUBLE PRECISION   THRESH
 169 *     ..
 170 *     .. Array Arguments ..
 171       LOGICAL            DOTYPE( * )
 172       INTEGER            IWORK( * ), NVAL( * )
 173       DOUBLE PRECISION   RWORK( * )
 174       COMPLEX*16         A( * ), AFAC( * ), AINV( * ), B( * ),
 175      $                   WORK( * ), X( * ), XACT( * )
 176 *     ..
 177 *
 178 *  =====================================================================
 179 *
 180 *     .. Parameters ..
 181       DOUBLE PRECISION   ONE, ZERO
 182       PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
 183       INTEGER            NTYPES, NTESTS
 184       PARAMETER          ( NTYPES = 11, NTESTS = 6 )
 185       INTEGER            NFACT
 186       PARAMETER          ( NFACT = 2 )
 187 *     ..
 188 *     .. Local Scalars ..
 189       LOGICAL            ZEROT
 190       CHARACTER          DIST, EQUED, FACT, TYPE, UPLO, XTYPE
 191       CHARACTER*3        PATH
 192       INTEGER            I, I1, I2, IFACT, IMAT, IN, INFO, IOFF, IUPLO,
 193      $                   IZERO, J, K, K1, KL, KU, LDA, LWORK, MODE, N,
 194      $                   NB, NBMIN, NERRS, NFAIL, NIMAT, NRUN, NT,
 195      $                   N_ERR_BNDS
 196       DOUBLE PRECISION   AINVNM, ANORM, CNDNUM, RCOND, RCONDC,
 197      $                   RPVGRW_SVXX
 198 *     ..
 199 *     .. Local Arrays ..
 200       CHARACTER          FACTS( NFACT ), UPLOS( 2 )
 201       INTEGER            ISEED( 4 ), ISEEDY( 4 )
 202       DOUBLE PRECISION   RESULT( NTESTS ), BERR( NRHS ),
 203      $                   ERRBNDS_N( NRHS, 3 ), ERRBNDS_C( NRHS, 3 )
 204 *     ..
 205 *     .. External Functions ..
 206       DOUBLE PRECISION   DGET06, ZLANSY
 207       EXTERNAL           DGET06, ZLANSY
 208 *     ..
 209 *     .. External Subroutines ..
 210       EXTERNAL           ALADHD, ALAERH, ALASVM, XLAENV, ZERRVX, ZGET04,
 211      $                   ZLACPY, ZLARHS, ZLASET, ZLATB4, ZLATMS, ZLATSY,
 212      $                   ZPOT05, ZSYSV, ZSYSVX, ZSYT01, ZSYT02, ZSYTRF,
 213      $                   ZSYTRI2, ZSYSVXX
 214 *     ..
 215 *     .. Scalars in Common ..
 216       LOGICAL            LERR, OK
 217       CHARACTER*32       SRNAMT
 218       INTEGER            INFOT, NUNIT
 219 *     ..
 220 *     .. Common blocks ..
 221       COMMON             / INFOC / INFOT, NUNIT, OK, LERR
 222       COMMON             / SRNAMC / SRNAMT
 223 *     ..
 224 *     .. Intrinsic Functions ..
 225       INTRINSIC          DCMPLX, MAX, MIN
 226 *     ..
 227 *     .. Data statements ..
 228       DATA               ISEEDY / 1988, 1989, 1990, 1991 /
 229       DATA               UPLOS / 'U', 'L' / , FACTS / 'F', 'N' /
 230 *     ..
 231 *     .. Executable Statements ..
 232 *
 233 *     Initialize constants and the random number seed.
 234 *
 235       PATH( 1: 1 ) = 'Zomplex precision'
 236       PATH( 2: 3 ) = 'SY'
 237       NRUN = 0
 238       NFAIL = 0
 239       NERRS = 0
 240       DO 10 I = 1, 4
 241          ISEED( I ) = ISEEDY( I )
 242    10 CONTINUE
 243       LWORK = MAX( 2*NMAX, NMAX*NRHS )
 244 *
 245 *     Test the error exits
 246 *
 247       IF( TSTERR )
 248      $   CALL ZERRVX( PATH, NOUT )
 249       INFOT = 0
 250 *
 251 *     Set the block size and minimum block size for testing.
 252 *
 253       NB = 1
 254       NBMIN = 2
 255       CALL XLAENV( 1, NB )
 256       CALL XLAENV( 2, NBMIN )
 257 *
 258 *     Do for each value of N in NVAL
 259 *
 260       DO 180 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          DO 170 IMAT = 1, NIMAT
 269 *
 270 *           Do the tests only if DOTYPE( IMAT ) is true.
 271 *
 272             IF( .NOT.DOTYPE( IMAT ) )
 273      $         GO TO 170
 274 *
 275 *           Skip types 3, 4, 5, or 6 if the matrix size is too small.
 276 *
 277             ZEROT = IMAT.GE.3 .AND. IMAT.LE.6
 278             IF( ZEROT .AND. N.LT.IMAT-2 )
 279      $         GO TO 170
 280 *
 281 *           Do first for UPLO = 'U', then for UPLO = 'L'
 282 *
 283             DO 160 IUPLO = 1, 2
 284                UPLO = UPLOS( IUPLO )
 285 *
 286                IF( IMAT.NE.NTYPES ) THEN
 287 *
 288 *                 Set up parameters with ZLATB4 and generate a test
 289 *                 matrix with ZLATMS.
 290 *
 291                   CALL ZLATB4( PATH, IMAT, N, N, TYPE, KL, KU, ANORM,
 292      $                         MODE, CNDNUM, DIST )
 293 *
 294                   SRNAMT = 'ZLATMS'
 295                   CALL ZLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE,
 296      $                         CNDNUM, ANORM, KL, KU, UPLO, A, LDA,
 297      $                         WORK, INFO )
 298 *
 299 *                 Check error code from ZLATMS.
 300 *
 301                   IF( INFO.NE.0 ) THEN
 302                      CALL ALAERH( PATH, 'ZLATMS', INFO, 0, UPLO, N, N,
 303      $                            -1, -1, -1, IMAT, NFAIL, NERRS, NOUT )
 304                      GO TO 160
 305                   END IF
 306 *
 307 *                 For types 3-6, zero one or more rows and columns of
 308 *                 the matrix to test that INFO is returned correctly.
 309 *
 310                   IF( ZEROT ) THEN
 311                      IF( IMAT.EQ.3 ) THEN
 312                         IZERO = 1
 313                      ELSE IF( IMAT.EQ.4 ) THEN
 314                         IZERO = N
 315                      ELSE
 316                         IZERO = N / 2 + 1
 317                      END IF
 318 *
 319                      IF( IMAT.LT.6 ) THEN
 320 *
 321 *                       Set row and column IZERO to zero.
 322 *
 323                         IF( IUPLO.EQ.1 ) THEN
 324                            IOFF = ( IZERO-1 )*LDA
 325                            DO 20 I = 1, IZERO - 1
 326                               A( IOFF+I ) = ZERO
 327    20                      CONTINUE
 328                            IOFF = IOFF + IZERO
 329                            DO 30 I = IZERO, N
 330                               A( IOFF ) = ZERO
 331                               IOFF = IOFF + LDA
 332    30                      CONTINUE
 333                         ELSE
 334                            IOFF = IZERO
 335                            DO 40 I = 1, IZERO - 1
 336                               A( IOFF ) = ZERO
 337                               IOFF = IOFF + LDA
 338    40                      CONTINUE
 339                            IOFF = IOFF - IZERO
 340                            DO 50 I = IZERO, N
 341                               A( IOFF+I ) = ZERO
 342    50                      CONTINUE
 343                         END IF
 344                      ELSE
 345                         IF( IUPLO.EQ.1 ) THEN
 346 *
 347 *                          Set the first IZERO rows to zero.
 348 *
 349                            IOFF = 0
 350                            DO 70 J = 1, N
 351                               I2 = MIN( J, IZERO )
 352                               DO 60 I = 1, I2
 353                                  A( IOFF+I ) = ZERO
 354    60                         CONTINUE
 355                               IOFF = IOFF + LDA
 356    70                      CONTINUE
 357                         ELSE
 358 *
 359 *                          Set the last IZERO rows to zero.
 360 *
 361                            IOFF = 0
 362                            DO 90 J = 1, N
 363                               I1 = MAX( J, IZERO )
 364                               DO 80 I = I1, N
 365                                  A( IOFF+I ) = ZERO
 366    80                         CONTINUE
 367                               IOFF = IOFF + LDA
 368    90                      CONTINUE
 369                         END IF
 370                      END IF
 371                   ELSE
 372                      IZERO = 0
 373                   END IF
 374                ELSE
 375 *
 376 *                 IMAT = NTYPES:  Use a special block diagonal matrix to
 377 *                 test alternate code for the 2-by-2 blocks.
 378 *
 379                   CALL ZLATSY( UPLO, N, A, LDA, ISEED )
 380                END IF
 381 *
 382                DO 150 IFACT = 1, NFACT
 383 *
 384 *                 Do first for FACT = 'F', then for other values.
 385 *
 386                   FACT = FACTS( IFACT )
 387 *
 388 *                 Compute the condition number for comparison with
 389 *                 the value returned by ZSYSVX.
 390 *
 391                   IF( ZEROT ) THEN
 392                      IF( IFACT.EQ.1 )
 393      $                  GO TO 150
 394                      RCONDC = ZERO
 395 *
 396                   ELSE IF( IFACT.EQ.1 ) THEN
 397 *
 398 *                    Compute the 1-norm of A.
 399 *
 400                      ANORM = ZLANSY( '1', UPLO, N, A, LDA, RWORK )
 401 *
 402 *                    Factor the matrix A.
 403 *
 404                      CALL ZLACPY( UPLO, N, N, A, LDA, AFAC, LDA )
 405                      CALL ZSYTRF( UPLO, N, AFAC, LDA, IWORK, WORK,
 406      $                            LWORK, INFO )
 407 *
 408 *                    Compute inv(A) and take its norm.
 409 *
 410                      CALL ZLACPY( UPLO, N, N, AFAC, LDA, AINV, LDA )
 411                      LWORK = (N+NB+1)*(NB+3)
 412                      CALL ZSYTRI2( UPLO, N, AINV, LDA, IWORK, WORK,
 413      $                            LWORK, INFO )
 414                      AINVNM = ZLANSY( '1', UPLO, N, AINV, LDA, RWORK )
 415 *
 416 *                    Compute the 1-norm condition number of A.
 417 *
 418                      IF( ANORM.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN
 419                         RCONDC = ONE
 420                      ELSE
 421                         RCONDC = ( ONE / ANORM ) / AINVNM
 422                      END IF
 423                   END IF
 424 *
 425 *                 Form an exact solution and set the right hand side.
 426 *
 427                   SRNAMT = 'ZLARHS'
 428                   CALL ZLARHS( PATH, XTYPE, UPLO, ' ', N, N, KL, KU,
 429      $                         NRHS, A, LDA, XACT, LDA, B, LDA, ISEED,
 430      $                         INFO )
 431                   XTYPE = 'C'
 432 *
 433 *                 --- Test ZSYSV  ---
 434 *
 435                   IF( IFACT.EQ.2 ) THEN
 436                      CALL ZLACPY( UPLO, N, N, A, LDA, AFAC, LDA )
 437                      CALL ZLACPY( 'Full', N, NRHS, B, LDA, X, LDA )
 438 *
 439 *                    Factor the matrix and solve the system using ZSYSV.
 440 *
 441                      SRNAMT = 'ZSYSV '
 442                      CALL ZSYSV( UPLO, N, NRHS, AFAC, LDA, IWORK, X,
 443      $                           LDA, WORK, LWORK, INFO )
 444 *
 445 *                    Adjust the expected value of INFO to account for
 446 *                    pivoting.
 447 *
 448                      K = IZERO
 449                      IF( K.GT.0 ) THEN
 450   100                   CONTINUE
 451                         IF( IWORK( K ).LT.0 ) THEN
 452                            IF( IWORK( K ).NE.-K ) THEN
 453                               K = -IWORK( K )
 454                               GO TO 100
 455                            END IF
 456                         ELSE IF( IWORK( K ).NE.K ) THEN
 457                            K = IWORK( K )
 458                            GO TO 100
 459                         END IF
 460                      END IF
 461 *
 462 *                    Check error code from ZSYSV .
 463 *
 464                      IF( INFO.NE.K ) THEN
 465                         CALL ALAERH( PATH, 'ZSYSV ', INFO, K, UPLO, N,
 466      $                               N, -1, -1, NRHS, IMAT, NFAIL,
 467      $                               NERRS, NOUT )
 468                         GO TO 120
 469                      ELSE IF( INFO.NE.0 ) THEN
 470                         GO TO 120
 471                      END IF
 472 *
 473 *                    Reconstruct matrix from factors and compute
 474 *                    residual.
 475 *
 476                      CALL ZSYT01( UPLO, N, A, LDA, AFAC, LDA, IWORK,
 477      $                            AINV, LDA, RWORK, RESULT( 1 ) )
 478 *
 479 *                    Compute residual of the computed solution.
 480 *
 481                      CALL ZLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA )
 482                      CALL ZSYT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK,
 483      $                            LDA, RWORK, RESULT( 2 ) )
 484 *
 485 *                    Check solution from generated exact solution.
 486 *
 487                      CALL ZGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC,
 488      $                            RESULT( 3 ) )
 489                      NT = 3
 490 *
 491 *                    Print information about the tests that did not pass
 492 *                    the threshold.
 493 *
 494                      DO 110 K = 1, NT
 495                         IF( RESULT( K ).GE.THRESH ) THEN
 496                            IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
 497      $                        CALL ALADHD( NOUT, PATH )
 498                            WRITE( NOUT, FMT = 9999 )'ZSYSV ', UPLO, N,
 499      $                        IMAT, K, RESULT( K )
 500                            NFAIL = NFAIL + 1
 501                         END IF
 502   110                CONTINUE
 503                      NRUN = NRUN + NT
 504   120                CONTINUE
 505                   END IF
 506 *
 507 *                 --- Test ZSYSVX ---
 508 *
 509                   IF( IFACT.EQ.2 )
 510      $               CALL ZLASET( UPLO, N, N, DCMPLX( ZERO ),
 511      $                            DCMPLX( ZERO ), AFAC, LDA )
 512                   CALL ZLASET( 'Full', N, NRHS, DCMPLX( ZERO ),
 513      $                         DCMPLX( ZERO ), X, LDA )
 514 *
 515 *                 Solve the system and compute the condition number and
 516 *                 error bounds using ZSYSVX.
 517 *
 518                   SRNAMT = 'ZSYSVX'
 519                   CALL ZSYSVX( FACT, UPLO, N, NRHS, A, LDA, AFAC, LDA,
 520      $                         IWORK, B, LDA, X, LDA, RCOND, RWORK,
 521      $                         RWORK( NRHS+1 ), WORK, LWORK,
 522      $                         RWORK( 2*NRHS+1 ), INFO )
 523 *
 524 *                 Adjust the expected value of INFO to account for
 525 *                 pivoting.
 526 *
 527                   K = IZERO
 528                   IF( K.GT.0 ) THEN
 529   130                CONTINUE
 530                      IF( IWORK( K ).LT.0 ) THEN
 531                         IF( IWORK( K ).NE.-K ) THEN
 532                            K = -IWORK( K )
 533                            GO TO 130
 534                         END IF
 535                      ELSE IF( IWORK( K ).NE.K ) THEN
 536                         K = IWORK( K )
 537                         GO TO 130
 538                      END IF
 539                   END IF
 540 *
 541 *                 Check the error code from ZSYSVX.
 542 *
 543                   IF( INFO.NE.K ) THEN
 544                      CALL ALAERH( PATH, 'ZSYSVX', INFO, K, FACT // UPLO,
 545      $                            N, N, -1, -1, NRHS, IMAT, NFAIL,
 546      $                            NERRS, NOUT )
 547                      GO TO 150
 548                   END IF
 549 *
 550                   IF( INFO.EQ.0 ) THEN
 551                      IF( IFACT.GE.2 ) THEN
 552 *
 553 *                       Reconstruct matrix from factors and compute
 554 *                       residual.
 555 *
 556                         CALL ZSYT01( UPLO, N, A, LDA, AFAC, LDA, IWORK,
 557      $                               AINV, LDA, RWORK( 2*NRHS+1 ),
 558      $                               RESULT( 1 ) )
 559                         K1 = 1
 560                      ELSE
 561                         K1 = 2
 562                      END IF
 563 *
 564 *                    Compute residual of the computed solution.
 565 *
 566                      CALL ZLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA )
 567                      CALL ZSYT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK,
 568      $                            LDA, RWORK( 2*NRHS+1 ), RESULT( 2 ) )
 569 *
 570 *                    Check solution from generated exact solution.
 571 *
 572                      CALL ZGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC,
 573      $                            RESULT( 3 ) )
 574 *
 575 *                    Check the error bounds from iterative refinement.
 576 *
 577                      CALL ZPOT05( UPLO, N, NRHS, A, LDA, B, LDA, X, LDA,
 578      $                            XACT, LDA, RWORK, RWORK( NRHS+1 ),
 579      $                            RESULT( 4 ) )
 580                   ELSE
 581                      K1 = 6
 582                   END IF
 583 *
 584 *                 Compare RCOND from ZSYSVX with the computed value
 585 *                 in RCONDC.
 586 *
 587                   RESULT( 6 ) = DGET06( RCOND, RCONDC )
 588 *
 589 *                 Print information about the tests that did not pass
 590 *                 the threshold.
 591 *
 592                   DO 140 K = K1, 6
 593                      IF( RESULT( K ).GE.THRESH ) THEN
 594                         IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
 595      $                     CALL ALADHD( NOUT, PATH )
 596                         WRITE( NOUT, FMT = 9998 )'ZSYSVX', FACT, UPLO,
 597      $                     N, IMAT, K, RESULT( K )
 598                         NFAIL = NFAIL + 1
 599                      END IF
 600   140             CONTINUE
 601                   NRUN = NRUN + 7 - K1
 602 *
 603 *                 --- Test ZSYSVXX ---
 604 *
 605 *                 Restore the matrices A and B.
 606 *
 607                   IF( IFACT.EQ.2 )
 608      $               CALL ZLASET( UPLO, N, N, CMPLX( ZERO ),
 609      $                 CMPLX( ZERO ), AFAC, LDA )
 610                   CALL ZLASET( 'Full', N, NRHS, CMPLX( ZERO ),
 611      $                 CMPLX( ZERO ), X, LDA )
 612 *
 613 *                 Solve the system and compute the condition number
 614 *                 and error bounds using ZSYSVXX.
 615 *
 616                   SRNAMT = 'ZSYSVXX'
 617                   N_ERR_BNDS = 3
 618                   EQUED = 'N'
 619                   CALL ZSYSVXX( FACT, UPLO, N, NRHS, A, LDA, AFAC,
 620      $                 LDA, IWORK, EQUED, WORK( N+1 ), B, LDA, X,
 621      $                 LDA, RCOND, RPVGRW_SVXX, BERR, N_ERR_BNDS,
 622      $                 ERRBNDS_N, ERRBNDS_C, 0, ZERO, WORK,
 623      $                 RWORK, INFO )
 624 *
 625 *                 Adjust the expected value of INFO to account for
 626 *                 pivoting.
 627 *
 628                   K = IZERO
 629                   IF( K.GT.0 ) THEN
 630  135                 CONTINUE
 631                      IF( IWORK( K ).LT.0 ) THEN
 632                         IF( IWORK( K ).NE.-K ) THEN
 633                            K = -IWORK( K )
 634                            GO TO 135
 635                         END IF
 636                      ELSE IF( IWORK( K ).NE.K ) THEN
 637                         K = IWORK( K )
 638                         GO TO 135
 639                      END IF
 640                   END IF
 641 *
 642 *                 Check the error code from ZSYSVXX.
 643 *
 644                   IF( INFO.NE.K .AND. INFO.LE.N ) THEN
 645                      CALL ALAERH( PATH, 'ZSYSVXX', INFO, K,
 646      $                    FACT // UPLO, N, N, -1, -1, NRHS, IMAT, NFAIL,
 647      $                    NERRS, NOUT )
 648                      GO TO 150
 649                   END IF
 650 *
 651                   IF( INFO.EQ.0 ) THEN
 652                      IF( IFACT.GE.2 ) THEN
 653 *
 654 *                 Reconstruct matrix from factors and compute
 655 *                 residual.
 656 *
 657                         CALL ZSYT01( UPLO, N, A, LDA, AFAC, LDA, IWORK,
 658      $                       AINV, LDA, RWORK(2*NRHS+1),
 659      $                       RESULT( 1 ) )
 660                         K1 = 1
 661                      ELSE
 662                         K1 = 2
 663                      END IF
 664 *
 665 *                 Compute residual of the computed solution.
 666 *
 667                      CALL ZLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA )
 668                      CALL ZSYT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK,
 669      $                    LDA, RWORK( 2*NRHS+1 ), RESULT( 2 ) )
 670                      RESULT( 2 ) = 0.0
 671 *
 672 *                 Check solution from generated exact solution.
 673 *
 674                      CALL ZGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC,
 675      $                    RESULT( 3 ) )
 676 *
 677 *                 Check the error bounds from iterative refinement.
 678 *
 679                      CALL ZPOT05( UPLO, N, NRHS, A, LDA, B, LDA, X, LDA,
 680      $                    XACT, LDA, RWORK, RWORK( NRHS+1 ),
 681      $                    RESULT( 4 ) )
 682                   ELSE
 683                      K1 = 6
 684                   END IF
 685 *
 686 *                 Compare RCOND from ZSYSVXX with the computed value
 687 *                 in RCONDC.
 688 *
 689                   RESULT( 6 ) = DGET06( RCOND, RCONDC )
 690 *
 691 *                 Print information about the tests that did not pass
 692 *                 the threshold.
 693 *
 694                   DO 85 K = K1, 6
 695                      IF( RESULT( K ).GE.THRESH ) THEN
 696                         IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
 697      $                       CALL ALADHD( NOUT, PATH )
 698                         WRITE( NOUT, FMT = 9998 )'ZSYSVXX',
 699      $                       FACT, UPLO, N, IMAT, K,
 700      $                       RESULT( K )
 701                         NFAIL = NFAIL + 1
 702                      END IF
 703  85               CONTINUE
 704                   NRUN = NRUN + 7 - K1
 705 *
 706   150          CONTINUE
 707 *
 708   160       CONTINUE
 709   170    CONTINUE
 710   180 CONTINUE
 711 *
 712 *     Print a summary of the results.
 713 *
 714       CALL ALASVM( PATH, NOUT, NFAIL, NRUN, NERRS )
 715 *
 716
 717 *     Test Error Bounds from ZSYSVXX
 718
 719       CALL ZEBCHVXX(THRESH, PATH)
 720
 721  9999 FORMAT( 1X, A, ', UPLO=''', A1, ''', N =', I5, ', type ', I2,
 722      $      ', test ', I2, ', ratio =', G12.5 )
 723  9998 FORMAT( 1X, A, ', FACT=''', A1, ''', UPLO=''', A1, ''', N =', I5,
 724      $      ', type ', I2, ', test ', I2, ', ratio =', G12.5 )
 725       RETURN
 726 *
 727 *     End of ZDRVSY
 728 *
 729       END