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