LAPACK: TESTING/LIN/sdrvpb.f Source File

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