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