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