LAPACK: TESTING/LIN/zdrvpb.f Source File

Go to the documentation of this file.
00001       SUBROUTINE ZDRVPB( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX,
00002      $                   A, AFAC, ASAV, B, BSAV, X, XACT, S, WORK,
00003      $                   RWORK, NOUT )
00004 *
00005 *  -- LAPACK test routine (version 3.1) --
00006 *     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
00007 *     November 2006
00008 *
00009 *     .. Scalar Arguments ..
00010       LOGICAL            TSTERR
00011       INTEGER            NMAX, NN, NOUT, NRHS
00012       DOUBLE PRECISION   THRESH
00013 *     ..
00014 *     .. Array Arguments ..
00015       LOGICAL            DOTYPE( * )
00016       INTEGER            NVAL( * )
00017       DOUBLE PRECISION   RWORK( * ), S( * )
00018       COMPLEX*16         A( * ), AFAC( * ), ASAV( * ), B( * ),
00019      $                   BSAV( * ), WORK( * ), X( * ), XACT( * )
00020 *     ..
00021 *
00022 *  Purpose
00023 *  =======
00024 *
00025 *  ZDRVPB tests the driver routines ZPBSV and -SVX.
00026 *
00027 *  Arguments
00028 *  =========
00029 *
00030 *  DOTYPE  (input) LOGICAL array, dimension (NTYPES)
00031 *          The matrix types to be used for testing.  Matrices of type j
00032 *          (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
00033 *          .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
00034 *
00035 *  NN      (input) INTEGER
00036 *          The number of values of N contained in the vector NVAL.
00037 *
00038 *  NVAL    (input) INTEGER array, dimension (NN)
00039 *          The values of the matrix dimension N.
00040 *
00041 *  NRHS    (input) INTEGER
00042 *          The number of right hand side vectors to be generated for
00043 *          each linear system.
00044 *
00045 *  THRESH  (input) DOUBLE PRECISION
00046 *          The threshold value for the test ratios.  A result is
00047 *          included in the output file if RESULT >= THRESH.  To have
00048 *          every test ratio printed, use THRESH = 0.
00049 *
00050 *  TSTERR  (input) LOGICAL
00051 *          Flag that indicates whether error exits are to be tested.
00052 *
00053 *  NMAX    (input) INTEGER
00054 *          The maximum value permitted for N, used in dimensioning the
00055 *          work arrays.
00056 *
00057 *  A       (workspace) COMPLEX*16 array, dimension (NMAX*NMAX)
00058 *
00059 *  AFAC    (workspace) COMPLEX*16 array, dimension (NMAX*NMAX)
00060 *
00061 *  ASAV    (workspace) COMPLEX*16 array, dimension (NMAX*NMAX)
00062 *
00063 *  B       (workspace) COMPLEX*16 array, dimension (NMAX*NRHS)
00064 *
00065 *  BSAV    (workspace) COMPLEX*16 array, dimension (NMAX*NRHS)
00066 *
00067 *  X       (workspace) COMPLEX*16 array, dimension (NMAX*NRHS)
00068 *
00069 *  XACT    (workspace) COMPLEX*16 array, dimension (NMAX*NRHS)
00070 *
00071 *  S       (workspace) DOUBLE PRECISION array, dimension (NMAX)
00072 *
00073 *  WORK    (workspace) COMPLEX*16 array, dimension
00074 *                      (NMAX*max(3,NRHS))
00075 *
00076 *  RWORK   (workspace) DOUBLE PRECISION array, dimension (NMAX+2*NRHS)
00077 *
00078 *  NOUT    (input) INTEGER
00079 *          The unit number for output.
00080 *
00081 *  =====================================================================
00082 *
00083 *     .. Parameters ..
00084       DOUBLE PRECISION   ONE, ZERO
00085       PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
00086       INTEGER            NTYPES, NTESTS
00087       PARAMETER          ( NTYPES = 8, NTESTS = 6 )
00088       INTEGER            NBW
00089       PARAMETER          ( NBW = 4 )
00090 *     ..
00091 *     .. Local Scalars ..
00092       LOGICAL            EQUIL, NOFACT, PREFAC, ZEROT
00093       CHARACTER          DIST, EQUED, FACT, PACKIT, TYPE, UPLO, XTYPE
00094       CHARACTER*3        PATH
00095       INTEGER            I, I1, I2, IEQUED, IFACT, IKD, IMAT, IN, INFO,
00096      $                   IOFF, IUPLO, IW, IZERO, K, K1, KD, KL, KOFF,
00097      $                   KU, LDA, LDAB, MODE, N, NB, NBMIN, NERRS,
00098      $                   NFACT, NFAIL, NIMAT, NKD, NRUN, NT
00099       DOUBLE PRECISION   AINVNM, AMAX, ANORM, CNDNUM, RCOND, RCONDC,
00100      $                   ROLDC, SCOND
00101 *     ..
00102 *     .. Local Arrays ..
00103       CHARACTER          EQUEDS( 2 ), FACTS( 3 )
00104       INTEGER            ISEED( 4 ), ISEEDY( 4 ), KDVAL( NBW )
00105       DOUBLE PRECISION   RESULT( NTESTS )
00106 *     ..
00107 *     .. External Functions ..
00108       LOGICAL            LSAME
00109       DOUBLE PRECISION   DGET06, ZLANGE, ZLANHB
00110       EXTERNAL           LSAME, DGET06, ZLANGE, ZLANHB
00111 *     ..
00112 *     .. External Subroutines ..
00113       EXTERNAL           ALADHD, ALAERH, ALASVM, XLAENV, ZCOPY, ZERRVX,
00114      $                   ZGET04, ZLACPY, ZLAIPD, ZLAQHB, ZLARHS, ZLASET,
00115      $                   ZLATB4, ZLATMS, ZPBEQU, ZPBSV, ZPBSVX, ZPBT01,
00116      $                   ZPBT02, ZPBT05, ZPBTRF, ZPBTRS, ZSWAP
00117 *     ..
00118 *     .. Intrinsic Functions ..
00119       INTRINSIC          DCMPLX, MAX, MIN
00120 *     ..
00121 *     .. Scalars in Common ..
00122       LOGICAL            LERR, OK
00123       CHARACTER*32       SRNAMT
00124       INTEGER            INFOT, NUNIT
00125 *     ..
00126 *     .. Common blocks ..
00127       COMMON             / INFOC / INFOT, NUNIT, OK, LERR
00128       COMMON             / SRNAMC / SRNAMT
00129 *     ..
00130 *     .. Data statements ..
00131       DATA               ISEEDY / 1988, 1989, 1990, 1991 /
00132       DATA               FACTS / 'F', 'N', 'E' / , EQUEDS / 'N', 'Y' /
00133 *     ..
00134 *     .. Executable Statements ..
00135 *
00136 *     Initialize constants and the random number seed.
00137 *
00138       PATH( 1: 1 ) = 'Zomplex precision'
00139       PATH( 2: 3 ) = 'PB'
00140       NRUN = 0
00141       NFAIL = 0
00142       NERRS = 0
00143       DO 10 I = 1, 4
00144          ISEED( I ) = ISEEDY( I )
00145    10 CONTINUE
00146 *
00147 *     Test the error exits
00148 *
00149       IF( TSTERR )
00150      $   CALL ZERRVX( PATH, NOUT )
00151       INFOT = 0
00152       KDVAL( 1 ) = 0
00153 *
00154 *     Set the block size and minimum block size for testing.
00155 *
00156       NB = 1
00157       NBMIN = 2
00158       CALL XLAENV( 1, NB )
00159       CALL XLAENV( 2, NBMIN )
00160 *
00161 *     Do for each value of N in NVAL
00162 *
00163       DO 110 IN = 1, NN
00164          N = NVAL( IN )
00165          LDA = MAX( N, 1 )
00166          XTYPE = 'N'
00167 *
00168 *        Set limits on the number of loop iterations.
00169 *
00170          NKD = MAX( 1, MIN( N, 4 ) )
00171          NIMAT = NTYPES
00172          IF( N.EQ.0 )
00173      $      NIMAT = 1
00174 *
00175          KDVAL( 2 ) = N + ( N+1 ) / 4
00176          KDVAL( 3 ) = ( 3*N-1 ) / 4
00177          KDVAL( 4 ) = ( N+1 ) / 4
00178 *
00179          DO 100 IKD = 1, NKD
00180 *
00181 *           Do for KD = 0, (5*N+1)/4, (3N-1)/4, and (N+1)/4. This order
00182 *           makes it easier to skip redundant values for small values
00183 *           of N.
00184 *
00185             KD = KDVAL( IKD )
00186             LDAB = KD + 1
00187 *
00188 *           Do first for UPLO = 'U', then for UPLO = 'L'
00189 *
00190             DO 90 IUPLO = 1, 2
00191                KOFF = 1
00192                IF( IUPLO.EQ.1 ) THEN
00193                   UPLO = 'U'
00194                   PACKIT = 'Q'
00195                   KOFF = MAX( 1, KD+2-N )
00196                ELSE
00197                   UPLO = 'L'
00198                   PACKIT = 'B'
00199                END IF
00200 *
00201                DO 80 IMAT = 1, NIMAT
00202 *
00203 *                 Do the tests only if DOTYPE( IMAT ) is true.
00204 *
00205                   IF( .NOT.DOTYPE( IMAT ) )
00206      $               GO TO 80
00207 *
00208 *                 Skip types 2, 3, or 4 if the matrix size is too small.
00209 *
00210                   ZEROT = IMAT.GE.2 .AND. IMAT.LE.4
00211                   IF( ZEROT .AND. N.LT.IMAT-1 )
00212      $               GO TO 80
00213 *
00214                   IF( .NOT.ZEROT .OR. .NOT.DOTYPE( 1 ) ) THEN
00215 *
00216 *                    Set up parameters with ZLATB4 and generate a test
00217 *                    matrix with ZLATMS.
00218 *
00219                      CALL ZLATB4( PATH, IMAT, N, N, TYPE, KL, KU, ANORM,
00220      $                            MODE, CNDNUM, DIST )
00221 *
00222                      SRNAMT = 'ZLATMS'
00223                      CALL ZLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE,
00224      $                            CNDNUM, ANORM, KD, KD, PACKIT,
00225      $                            A( KOFF ), LDAB, WORK, INFO )
00226 *
00227 *                    Check error code from ZLATMS.
00228 *
00229                      IF( INFO.NE.0 ) THEN
00230                         CALL ALAERH( PATH, 'ZLATMS', INFO, 0, UPLO, N,
00231      $                               N, -1, -1, -1, IMAT, NFAIL, NERRS,
00232      $                               NOUT )
00233                         GO TO 80
00234                      END IF
00235                   ELSE IF( IZERO.GT.0 ) THEN
00236 *
00237 *                    Use the same matrix for types 3 and 4 as for type
00238 *                    2 by copying back the zeroed out column,
00239 *
00240                      IW = 2*LDA + 1
00241                      IF( IUPLO.EQ.1 ) THEN
00242                         IOFF = ( IZERO-1 )*LDAB + KD + 1
00243                         CALL ZCOPY( IZERO-I1, WORK( IW ), 1,
00244      $                              A( IOFF-IZERO+I1 ), 1 )
00245                         IW = IW + IZERO - I1
00246                         CALL ZCOPY( I2-IZERO+1, WORK( IW ), 1,
00247      $                              A( IOFF ), MAX( LDAB-1, 1 ) )
00248                      ELSE
00249                         IOFF = ( I1-1 )*LDAB + 1
00250                         CALL ZCOPY( IZERO-I1, WORK( IW ), 1,
00251      $                              A( IOFF+IZERO-I1 ),
00252      $                              MAX( LDAB-1, 1 ) )
00253                         IOFF = ( IZERO-1 )*LDAB + 1
00254                         IW = IW + IZERO - I1
00255                         CALL ZCOPY( I2-IZERO+1, WORK( IW ), 1,
00256      $                              A( IOFF ), 1 )
00257                      END IF
00258                   END IF
00259 *
00260 *                 For types 2-4, zero one row and column of the matrix
00261 *                 to test that INFO is returned correctly.
00262 *
00263                   IZERO = 0
00264                   IF( ZEROT ) THEN
00265                      IF( IMAT.EQ.2 ) THEN
00266                         IZERO = 1
00267                      ELSE IF( IMAT.EQ.3 ) THEN
00268                         IZERO = N
00269                      ELSE
00270                         IZERO = N / 2 + 1
00271                      END IF
00272 *
00273 *                    Save the zeroed out row and column in WORK(*,3)
00274 *
00275                      IW = 2*LDA
00276                      DO 20 I = 1, MIN( 2*KD+1, N )
00277                         WORK( IW+I ) = ZERO
00278    20                CONTINUE
00279                      IW = IW + 1
00280                      I1 = MAX( IZERO-KD, 1 )
00281                      I2 = MIN( IZERO+KD, N )
00282 *
00283                      IF( IUPLO.EQ.1 ) THEN
00284                         IOFF = ( IZERO-1 )*LDAB + KD + 1
00285                         CALL ZSWAP( IZERO-I1, A( IOFF-IZERO+I1 ), 1,
00286      $                              WORK( IW ), 1 )
00287                         IW = IW + IZERO - I1
00288                         CALL ZSWAP( I2-IZERO+1, A( IOFF ),
00289      $                              MAX( LDAB-1, 1 ), WORK( IW ), 1 )
00290                      ELSE
00291                         IOFF = ( I1-1 )*LDAB + 1
00292                         CALL ZSWAP( IZERO-I1, A( IOFF+IZERO-I1 ),
00293      $                              MAX( LDAB-1, 1 ), WORK( IW ), 1 )
00294                         IOFF = ( IZERO-1 )*LDAB + 1
00295                         IW = IW + IZERO - I1
00296                         CALL ZSWAP( I2-IZERO+1, A( IOFF ), 1,
00297      $                              WORK( IW ), 1 )
00298                      END IF
00299                   END IF
00300 *
00301 *                 Set the imaginary part of the diagonals.
00302 *
00303                   IF( IUPLO.EQ.1 ) THEN
00304                      CALL ZLAIPD( N, A( KD+1 ), LDAB, 0 )
00305                   ELSE
00306                      CALL ZLAIPD( N, A( 1 ), LDAB, 0 )
00307                   END IF
00308 *
00309 *                 Save a copy of the matrix A in ASAV.
00310 *
00311                   CALL ZLACPY( 'Full', KD+1, N, A, LDAB, ASAV, LDAB )
00312 *
00313                   DO 70 IEQUED = 1, 2
00314                      EQUED = EQUEDS( IEQUED )
00315                      IF( IEQUED.EQ.1 ) THEN
00316                         NFACT = 3
00317                      ELSE
00318                         NFACT = 1
00319                      END IF
00320 *
00321                      DO 60 IFACT = 1, NFACT
00322                         FACT = FACTS( IFACT )
00323                         PREFAC = LSAME( FACT, 'F' )
00324                         NOFACT = LSAME( FACT, 'N' )
00325                         EQUIL = LSAME( FACT, 'E' )
00326 *
00327                         IF( ZEROT ) THEN
00328                            IF( PREFAC )
00329      $                        GO TO 60
00330                            RCONDC = ZERO
00331 *
00332                         ELSE IF( .NOT.LSAME( FACT, 'N' ) ) THEN
00333 *
00334 *                          Compute the condition number for comparison
00335 *                          with the value returned by ZPBSVX (FACT =
00336 *                          'N' reuses the condition number from the
00337 *                          previous iteration with FACT = 'F').
00338 *
00339                            CALL ZLACPY( 'Full', KD+1, N, ASAV, LDAB,
00340      $                                  AFAC, LDAB )
00341                            IF( EQUIL .OR. IEQUED.GT.1 ) THEN
00342 *
00343 *                             Compute row and column scale factors to
00344 *                             equilibrate the matrix A.
00345 *
00346                               CALL ZPBEQU( UPLO, N, KD, AFAC, LDAB, S,
00347      $                                     SCOND, AMAX, INFO )
00348                               IF( INFO.EQ.0 .AND. N.GT.0 ) THEN
00349                                  IF( IEQUED.GT.1 )
00350      $                              SCOND = ZERO
00351 *
00352 *                                Equilibrate the matrix.
00353 *
00354                                  CALL ZLAQHB( UPLO, N, KD, AFAC, LDAB,
00355      $                                        S, SCOND, AMAX, EQUED )
00356                               END IF
00357                            END IF
00358 *
00359 *                          Save the condition number of the
00360 *                          non-equilibrated system for use in ZGET04.
00361 *
00362                            IF( EQUIL )
00363      $                        ROLDC = RCONDC
00364 *
00365 *                          Compute the 1-norm of A.
00366 *
00367                            ANORM = ZLANHB( '1', UPLO, N, KD, AFAC, LDAB,
00368      $                             RWORK )
00369 *
00370 *                          Factor the matrix A.
00371 *
00372                            CALL ZPBTRF( UPLO, N, KD, AFAC, LDAB, INFO )
00373 *
00374 *                          Form the inverse of A.
00375 *
00376                            CALL ZLASET( 'Full', N, N, DCMPLX( ZERO ),
00377      $                                  DCMPLX( ONE ), A, LDA )
00378                            SRNAMT = 'ZPBTRS'
00379                            CALL ZPBTRS( UPLO, N, KD, N, AFAC, LDAB, A,
00380      $                                  LDA, INFO )
00381 *
00382 *                          Compute the 1-norm condition number of A.
00383 *
00384                            AINVNM = ZLANGE( '1', N, N, A, LDA, RWORK )
00385                            IF( ANORM.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN
00386                               RCONDC = ONE
00387                            ELSE
00388                               RCONDC = ( ONE / ANORM ) / AINVNM
00389                            END IF
00390                         END IF
00391 *
00392 *                       Restore the matrix A.
00393 *
00394                         CALL ZLACPY( 'Full', KD+1, N, ASAV, LDAB, A,
00395      $                               LDAB )
00396 *
00397 *                       Form an exact solution and set the right hand
00398 *                       side.
00399 *
00400                         SRNAMT = 'ZLARHS'
00401                         CALL ZLARHS( PATH, XTYPE, UPLO, ' ', N, N, KD,
00402      $                               KD, NRHS, A, LDAB, XACT, LDA, B,
00403      $                               LDA, ISEED, INFO )
00404                         XTYPE = 'C'
00405                         CALL ZLACPY( 'Full', N, NRHS, B, LDA, BSAV,
00406      $                               LDA )
00407 *
00408                         IF( NOFACT ) THEN
00409 *
00410 *                          --- Test ZPBSV  ---
00411 *
00412 *                          Compute the L*L' or U'*U factorization of the
00413 *                          matrix and solve the system.
00414 *
00415                            CALL ZLACPY( 'Full', KD+1, N, A, LDAB, AFAC,
00416      $                                  LDAB )
00417                            CALL ZLACPY( 'Full', N, NRHS, B, LDA, X,
00418      $                                  LDA )
00419 *
00420                            SRNAMT = 'ZPBSV '
00421                            CALL ZPBSV( UPLO, N, KD, NRHS, AFAC, LDAB, X,
00422      $                                 LDA, INFO )
00423 *
00424 *                          Check error code from ZPBSV .
00425 *
00426                            IF( INFO.NE.IZERO ) THEN
00427                               CALL ALAERH( PATH, 'ZPBSV ', INFO, IZERO,
00428      $                                     UPLO, N, N, KD, KD, NRHS,
00429      $                                     IMAT, NFAIL, NERRS, NOUT )
00430                               GO TO 40
00431                            ELSE IF( INFO.NE.0 ) THEN
00432                               GO TO 40
00433                            END IF
00434 *
00435 *                          Reconstruct matrix from factors and compute
00436 *                          residual.
00437 *
00438                            CALL ZPBT01( UPLO, N, KD, A, LDAB, AFAC,
00439      $                                  LDAB, RWORK, RESULT( 1 ) )
00440 *
00441 *                          Compute residual of the computed solution.
00442 *
00443                            CALL ZLACPY( 'Full', N, NRHS, B, LDA, WORK,
00444      $                                  LDA )
00445                            CALL ZPBT02( UPLO, N, KD, NRHS, A, LDAB, X,
00446      $                                  LDA, WORK, LDA, RWORK,
00447      $                                  RESULT( 2 ) )
00448 *
00449 *                          Check solution from generated exact solution.
00450 *
00451                            CALL ZGET04( N, NRHS, X, LDA, XACT, LDA,
00452      $                                  RCONDC, RESULT( 3 ) )
00453                            NT = 3
00454 *
00455 *                          Print information about the tests that did
00456 *                          not pass the threshold.
00457 *
00458                            DO 30 K = 1, NT
00459                               IF( RESULT( K ).GE.THRESH ) THEN
00460                                  IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
00461      $                              CALL ALADHD( NOUT, PATH )
00462                                  WRITE( NOUT, FMT = 9999 )'ZPBSV ',
00463      $                              UPLO, N, KD, IMAT, K, RESULT( K )
00464                                  NFAIL = NFAIL + 1
00465                               END IF
00466    30                      CONTINUE
00467                            NRUN = NRUN + NT
00468    40                      CONTINUE
00469                         END IF
00470 *
00471 *                       --- Test ZPBSVX ---
00472 *
00473                         IF( .NOT.PREFAC )
00474      $                     CALL ZLASET( 'Full', KD+1, N, DCMPLX( ZERO ),
00475      $                                  DCMPLX( ZERO ), AFAC, LDAB )
00476                         CALL ZLASET( 'Full', N, NRHS, DCMPLX( ZERO ),
00477      $                               DCMPLX( ZERO ), X, LDA )
00478                         IF( IEQUED.GT.1 .AND. N.GT.0 ) THEN
00479 *
00480 *                          Equilibrate the matrix if FACT='F' and
00481 *                          EQUED='Y'
00482 *
00483                            CALL ZLAQHB( UPLO, N, KD, A, LDAB, S, SCOND,
00484      $                                  AMAX, EQUED )
00485                         END IF
00486 *
00487 *                       Solve the system and compute the condition
00488 *                       number and error bounds using ZPBSVX.
00489 *
00490                         SRNAMT = 'ZPBSVX'
00491                         CALL ZPBSVX( FACT, UPLO, N, KD, NRHS, A, LDAB,
00492      $                               AFAC, LDAB, EQUED, S, B, LDA, X,
00493      $                               LDA, RCOND, RWORK, RWORK( NRHS+1 ),
00494      $                               WORK, RWORK( 2*NRHS+1 ), INFO )
00495 *
00496 *                       Check the error code from ZPBSVX.
00497 *
00498                         IF( INFO.NE.IZERO ) THEN
00499                            CALL ALAERH( PATH, 'ZPBSVX', INFO, IZERO,
00500      $                                  FACT // UPLO, N, N, KD, KD,
00501      $                                  NRHS, IMAT, NFAIL, NERRS, NOUT )
00502                            GO TO 60
00503                         END IF
00504 *
00505                         IF( INFO.EQ.0 ) THEN
00506                            IF( .NOT.PREFAC ) THEN
00507 *
00508 *                             Reconstruct matrix from factors and
00509 *                             compute residual.
00510 *
00511                               CALL ZPBT01( UPLO, N, KD, A, LDAB, AFAC,
00512      $                                     LDAB, RWORK( 2*NRHS+1 ),
00513      $                                     RESULT( 1 ) )
00514                               K1 = 1
00515                            ELSE
00516                               K1 = 2
00517                            END IF
00518 *
00519 *                          Compute residual of the computed solution.
00520 *
00521                            CALL ZLACPY( 'Full', N, NRHS, BSAV, LDA,
00522      $                                  WORK, LDA )
00523                            CALL ZPBT02( UPLO, N, KD, NRHS, ASAV, LDAB,
00524      $                                  X, LDA, WORK, LDA,
00525      $                                  RWORK( 2*NRHS+1 ), RESULT( 2 ) )
00526 *
00527 *                          Check solution from generated exact solution.
00528 *
00529                            IF( NOFACT .OR. ( PREFAC .AND. LSAME( EQUED,
00530      $                         'N' ) ) ) THEN
00531                               CALL ZGET04( N, NRHS, X, LDA, XACT, LDA,
00532      $                                     RCONDC, RESULT( 3 ) )
00533                            ELSE
00534                               CALL ZGET04( N, NRHS, X, LDA, XACT, LDA,
00535      $                                     ROLDC, RESULT( 3 ) )
00536                            END IF
00537 *
00538 *                          Check the error bounds from iterative
00539 *                          refinement.
00540 *
00541                            CALL ZPBT05( UPLO, N, KD, NRHS, ASAV, LDAB,
00542      $                                  B, LDA, X, LDA, XACT, LDA,
00543      $                                  RWORK, RWORK( NRHS+1 ),
00544      $                                  RESULT( 4 ) )
00545                         ELSE
00546                            K1 = 6
00547                         END IF
00548 *
00549 *                       Compare RCOND from ZPBSVX with the computed
00550 *                       value in RCONDC.
00551 *
00552                         RESULT( 6 ) = DGET06( RCOND, RCONDC )
00553 *
00554 *                       Print information about the tests that did not
00555 *                       pass the threshold.
00556 *
00557                         DO 50 K = K1, 6
00558                            IF( RESULT( K ).GE.THRESH ) THEN
00559                               IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
00560      $                           CALL ALADHD( NOUT, PATH )
00561                               IF( PREFAC ) THEN
00562                                  WRITE( NOUT, FMT = 9997 )'ZPBSVX',
00563      $                              FACT, UPLO, N, KD, EQUED, IMAT, K,
00564      $                              RESULT( K )
00565                               ELSE
00566                                  WRITE( NOUT, FMT = 9998 )'ZPBSVX',
00567      $                              FACT, UPLO, N, KD, IMAT, K,
00568      $                              RESULT( K )
00569                               END IF
00570                               NFAIL = NFAIL + 1
00571                            END IF
00572    50                   CONTINUE
00573                         NRUN = NRUN + 7 - K1
00574    60                CONTINUE
00575    70             CONTINUE
00576    80          CONTINUE
00577    90       CONTINUE
00578   100    CONTINUE
00579   110 CONTINUE
00580 *
00581 *     Print a summary of the results.
00582 *
00583       CALL ALASVM( PATH, NOUT, NFAIL, NRUN, NERRS )
00584 *
00585  9999 FORMAT( 1X, A, ', UPLO=''', A1, ''', N =', I5, ', KD =', I5,
00586      $      ', type ', I1, ', test(', I1, ')=', G12.5 )
00587  9998 FORMAT( 1X, A, '( ''', A1, ''', ''', A1, ''', ', I5, ', ', I5,
00588      $      ', ... ), type ', I1, ', test(', I1, ')=', G12.5 )
00589  9997 FORMAT( 1X, A, '( ''', A1, ''', ''', A1, ''', ', I5, ', ', I5,
00590      $      ', ... ), EQUED=''', A1, ''', type ', I1, ', test(', I1,
00591      $      ')=', G12.5 )
00592       RETURN
00593 *
00594 *     End of ZDRVPB
00595 *
00596       END