swiftnav: cchksp.c Source File

Go to the documentation of this file.
00001 /* cchksp.f -- translated by f2c (version 20061008).
00002    You must link the resulting object file with libf2c:
00003         on Microsoft Windows system, link with libf2c.lib;
00004         on Linux or Unix systems, link with .../path/to/libf2c.a -lm
00005         or, if you install libf2c.a in a standard place, with -lf2c -lm
00006         -- in that order, at the end of the command line, as in
00007                 cc *.o -lf2c -lm
00008         Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
00009 
00010                 http://www.netlib.org/f2c/libf2c.zip
00011 */
00012 
00013 #include "f2c.h"
00014 #include "blaswrap.h"
00015 
00016 /* Common Block Declarations */
00017 
00018 struct {
00019     integer infot, nunit;
00020     logical ok, lerr;
00021 } infoc_;
00022 
00023 #define infoc_1 infoc_
00024 
00025 struct {
00026     char srnamt[32];
00027 } srnamc_;
00028 
00029 #define srnamc_1 srnamc_
00030 
00031 /* Table of constant values */
00032 
00033 static integer c__0 = 0;
00034 static integer c_n1 = -1;
00035 static integer c__1 = 1;
00036 static integer c__8 = 8;
00037 
00038 /* Subroutine */ int cchksp_(logical *dotype, integer *nn, integer *nval, 
00039         integer *nns, integer *nsval, real *thresh, logical *tsterr, integer *
00040         nmax, complex *a, complex *afac, complex *ainv, complex *b, complex *
00041         x, complex *xact, complex *work, real *rwork, integer *iwork, integer 
00042         *nout)
00043 {
00044     /* Initialized data */
00045 
00046     static integer iseedy[4] = { 1988,1989,1990,1991 };
00047     static char uplos[1*2] = "U" "L";
00048 
00049     /* Format strings */
00050     static char fmt_9999[] = "(\002 UPLO = '\002,a1,\002', N =\002,i5,\002, "
00051             "type \002,i2,\002, test \002,i2,\002, ratio =\002,g12.5)";
00052     static char fmt_9998[] = "(\002 UPLO = '\002,a1,\002', N =\002,i5,\002, "
00053             "NRHS=\002,i3,\002, type \002,i2,\002, test(\002,i2,\002) =\002,g"
00054             "12.5)";
00055 
00056     /* System generated locals */
00057     integer i__1, i__2, i__3, i__4, i__5;
00058 
00059     /* Builtin functions */
00060     /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
00061     integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void);
00062 
00063     /* Local variables */
00064     integer i__, j, k, n, i1, i2, in, kl, ku, nt, lda, npp, ioff, mode, imat, 
00065             info;
00066     char path[3], dist[1];
00067     integer irhs, nrhs;
00068     char uplo[1], type__[1];
00069     integer nrun;
00070     extern /* Subroutine */ int alahd_(integer *, char *), cget04_(
00071             integer *, integer *, complex *, integer *, complex *, integer *, 
00072             real *, real *);
00073     integer nfail, iseed[4];
00074     extern logical lsame_(char *, char *);
00075     real rcond;
00076     integer nimat;
00077     extern doublereal sget06_(real *, real *);
00078     extern /* Subroutine */ int cspt01_(char *, integer *, complex *, complex 
00079             *, integer *, complex *, integer *, real *, real *), 
00080             cppt05_(char *, integer *, integer *, complex *, complex *, 
00081             integer *, complex *, integer *, complex *, integer *, real *, 
00082             real *, real *);
00083     real anorm;
00084     extern /* Subroutine */ int ccopy_(integer *, complex *, integer *, 
00085             complex *, integer *), cspt02_(char *, integer *, integer *, 
00086             complex *, complex *, integer *, complex *, integer *, real *, 
00087             real *), cspt03_(char *, integer *, complex *, complex *, 
00088             complex *, integer *, real *, real *, real *);
00089     integer iuplo, izero, nerrs;
00090     logical zerot;
00091     char xtype[1];
00092     extern /* Subroutine */ int clatb4_(char *, integer *, integer *, integer 
00093             *, char *, integer *, integer *, real *, integer *, real *, char *
00094 ), alaerh_(char *, char *, integer *, 
00095             integer *, char *, integer *, integer *, integer *, integer *, 
00096             integer *, integer *, integer *, integer *, integer *);
00097     real rcondc;
00098     char packit[1];
00099     extern /* Subroutine */ int clacpy_(char *, integer *, integer *, complex 
00100             *, integer *, complex *, integer *), clarhs_(char *, char 
00101             *, char *, char *, integer *, integer *, integer *, integer *, 
00102             integer *, complex *, integer *, complex *, integer *, complex *, 
00103             integer *, integer *, integer *);
00104     extern doublereal clansp_(char *, char *, integer *, complex *, real *);
00105     extern /* Subroutine */ int alasum_(char *, integer *, integer *, integer 
00106             *, integer *);
00107     real cndnum;
00108     extern /* Subroutine */ int clatms_(integer *, integer *, char *, integer 
00109             *, char *, real *, integer *, real *, real *, integer *, integer *
00110 , char *, complex *, integer *, complex *, integer *), clatsp_(char *, integer *, complex *, integer *), cspcon_(char *, integer *, complex *, integer *, real *, 
00111             real *, complex *, integer *);
00112     logical trfcon;
00113     extern /* Subroutine */ int csprfs_(char *, integer *, integer *, complex 
00114             *, complex *, integer *, complex *, integer *, complex *, integer 
00115             *, real *, real *, complex *, real *, integer *), csptrf_(
00116             char *, integer *, complex *, integer *, integer *), 
00117             csptri_(char *, integer *, complex *, integer *, complex *, 
00118             integer *), cerrsy_(char *, integer *);
00119     real result[8];
00120     extern /* Subroutine */ int csptrs_(char *, integer *, integer *, complex 
00121             *, integer *, complex *, integer *, integer *);
00122 
00123     /* Fortran I/O blocks */
00124     static cilist io___38 = { 0, 0, 0, fmt_9999, 0 };
00125     static cilist io___41 = { 0, 0, 0, fmt_9998, 0 };
00126     static cilist io___43 = { 0, 0, 0, fmt_9999, 0 };
00127 
00128 
00129 
00130 /*  -- LAPACK test routine (version 3.1) -- */
00131 /*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
00132 /*     November 2006 */
00133 
00134 /*     .. Scalar Arguments .. */
00135 /*     .. */
00136 /*     .. Array Arguments .. */
00137 /*     .. */
00138 
00139 /*  Purpose */
00140 /*  ======= */
00141 
00142 /*  CCHKSP tests CSPTRF, -TRI, -TRS, -RFS, and -CON */
00143 
00144 /*  Arguments */
00145 /*  ========= */
00146 
00147 /*  DOTYPE  (input) LOGICAL array, dimension (NTYPES) */
00148 /*          The matrix types to be used for testing.  Matrices of type j */
00149 /*          (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) = */
00150 /*          .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used. */
00151 
00152 /*  NN      (input) INTEGER */
00153 /*          The number of values of N contained in the vector NVAL. */
00154 
00155 /*  NVAL    (input) INTEGER array, dimension (NN) */
00156 /*          The values of the matrix dimension N. */
00157 
00158 /*  NNS     (input) INTEGER */
00159 /*          The number of values of NRHS contained in the vector NSVAL. */
00160 
00161 /*  NSVAL   (input) INTEGER array, dimension (NNS) */
00162 /*          The values of the number of right hand sides NRHS. */
00163 
00164 /*  THRESH  (input) REAL */
00165 /*          The threshold value for the test ratios.  A result is */
00166 /*          included in the output file if RESULT >= THRESH.  To have */
00167 /*          every test ratio printed, use THRESH = 0. */
00168 
00169 /*  TSTERR  (input) LOGICAL */
00170 /*          Flag that indicates whether error exits are to be tested. */
00171 
00172 /*  NMAX    (input) INTEGER */
00173 /*          The maximum value permitted for N, used in dimensioning the */
00174 /*          work arrays. */
00175 
00176 /*  A       (workspace) COMPLEX array, dimension */
00177 /*                      (NMAX*(NMAX+1)/2) */
00178 
00179 /*  AFAC    (workspace) COMPLEX array, dimension */
00180 /*                      (NMAX*(NMAX+1)/2) */
00181 
00182 /*  AINV    (workspace) COMPLEX array, dimension */
00183 /*                      (NMAX*(NMAX+1)/2) */
00184 
00185 /*  B       (workspace) COMPLEX array, dimension (NMAX*NSMAX) */
00186 /*          where NSMAX is the largest entry in NSVAL. */
00187 
00188 /*  X       (workspace) COMPLEX array, dimension (NMAX*NSMAX) */
00189 
00190 /*  XACT    (workspace) COMPLEX array, dimension (NMAX*NSMAX) */
00191 
00192 /*  WORK    (workspace) COMPLEX array, dimension */
00193 /*                      (NMAX*max(2,NSMAX)) */
00194 
00195 /*  RWORK   (workspace) REAL array, */
00196 /*                                 dimension (NMAX+2*NSMAX) */
00197 
00198 /*  IWORK   (workspace) INTEGER array, dimension (NMAX) */
00199 
00200 /*  NOUT    (input) INTEGER */
00201 /*          The unit number for output. */
00202 
00203 /*  ===================================================================== */
00204 
00205 /*     .. Parameters .. */
00206 /*     .. */
00207 /*     .. Local Scalars .. */
00208 /*     .. */
00209 /*     .. Local Arrays .. */
00210 /*     .. */
00211 /*     .. External Functions .. */
00212 /*     .. */
00213 /*     .. External Subroutines .. */
00214 /*     .. */
00215 /*     .. Intrinsic Functions .. */
00216 /*     .. */
00217 /*     .. Scalars in Common .. */
00218 /*     .. */
00219 /*     .. Common blocks .. */
00220 /*     .. */
00221 /*     .. Data statements .. */
00222     /* Parameter adjustments */
00223     --iwork;
00224     --rwork;
00225     --work;
00226     --xact;
00227     --x;
00228     --b;
00229     --ainv;
00230     --afac;
00231     --a;
00232     --nsval;
00233     --nval;
00234     --dotype;
00235 
00236     /* Function Body */
00237 /*     .. */
00238 /*     .. Executable Statements .. */
00239 
00240 /*     Initialize constants and the random number seed. */
00241 
00242     s_copy(path, "Complex precision", (ftnlen)1, (ftnlen)17);
00243     s_copy(path + 1, "SP", (ftnlen)2, (ftnlen)2);
00244     nrun = 0;
00245     nfail = 0;
00246     nerrs = 0;
00247     for (i__ = 1; i__ <= 4; ++i__) {
00248         iseed[i__ - 1] = iseedy[i__ - 1];
00249 /* L10: */
00250     }
00251 
00252 /*     Test the error exits */
00253 
00254     if (*tsterr) {
00255         cerrsy_(path, nout);
00256     }
00257     infoc_1.infot = 0;
00258 
00259 /*     Do for each value of N in NVAL */
00260 
00261     i__1 = *nn;
00262     for (in = 1; in <= i__1; ++in) {
00263         n = nval[in];
00264         lda = max(n,1);
00265         *(unsigned char *)xtype = 'N';
00266         nimat = 11;
00267         if (n <= 0) {
00268             nimat = 1;
00269         }
00270 
00271         i__2 = nimat;
00272         for (imat = 1; imat <= i__2; ++imat) {
00273 
00274 /*           Do the tests only if DOTYPE( IMAT ) is true. */
00275 
00276             if (! dotype[imat]) {
00277                 goto L160;
00278             }
00279 
00280 /*           Skip types 3, 4, 5, or 6 if the matrix size is too small. */
00281 
00282             zerot = imat >= 3 && imat <= 6;
00283             if (zerot && n < imat - 2) {
00284                 goto L160;
00285             }
00286 
00287 /*           Do first for UPLO = 'U', then for UPLO = 'L' */
00288 
00289             for (iuplo = 1; iuplo <= 2; ++iuplo) {
00290                 *(unsigned char *)uplo = *(unsigned char *)&uplos[iuplo - 1];
00291                 if (lsame_(uplo, "U")) {
00292                     *(unsigned char *)packit = 'C';
00293                 } else {
00294                     *(unsigned char *)packit = 'R';
00295                 }
00296 
00297                 if (imat != 11) {
00298 
00299 /*                 Set up parameters with CLATB4 and generate a test */
00300 /*                 matrix with CLATMS. */
00301 
00302                     clatb4_(path, &imat, &n, &n, type__, &kl, &ku, &anorm, &
00303                             mode, &cndnum, dist);
00304 
00305                     s_copy(srnamc_1.srnamt, "CLATMS", (ftnlen)32, (ftnlen)6);
00306                     clatms_(&n, &n, dist, iseed, type__, &rwork[1], &mode, &
00307                             cndnum, &anorm, &kl, &ku, packit, &a[1], &lda, &
00308                             work[1], &info);
00309 
00310 /*                 Check error code from CLATMS. */
00311 
00312                     if (info != 0) {
00313                         alaerh_(path, "CLATMS", &info, &c__0, uplo, &n, &n, &
00314                                 c_n1, &c_n1, &c_n1, &imat, &nfail, &nerrs, 
00315                                 nout);
00316                         goto L150;
00317                     }
00318 
00319 /*                 For types 3-6, zero one or more rows and columns of */
00320 /*                 the matrix to test that INFO is returned correctly. */
00321 
00322                     if (zerot) {
00323                         if (imat == 3) {
00324                             izero = 1;
00325                         } else if (imat == 4) {
00326                             izero = n;
00327                         } else {
00328                             izero = n / 2 + 1;
00329                         }
00330 
00331                         if (imat < 6) {
00332 
00333 /*                       Set row and column IZERO to zero. */
00334 
00335                             if (iuplo == 1) {
00336                                 ioff = (izero - 1) * izero / 2;
00337                                 i__3 = izero - 1;
00338                                 for (i__ = 1; i__ <= i__3; ++i__) {
00339                                     i__4 = ioff + i__;
00340                                     a[i__4].r = 0.f, a[i__4].i = 0.f;
00341 /* L20: */
00342                                 }
00343                                 ioff += izero;
00344                                 i__3 = n;
00345                                 for (i__ = izero; i__ <= i__3; ++i__) {
00346                                     i__4 = ioff;
00347                                     a[i__4].r = 0.f, a[i__4].i = 0.f;
00348                                     ioff += i__;
00349 /* L30: */
00350                                 }
00351                             } else {
00352                                 ioff = izero;
00353                                 i__3 = izero - 1;
00354                                 for (i__ = 1; i__ <= i__3; ++i__) {
00355                                     i__4 = ioff;
00356                                     a[i__4].r = 0.f, a[i__4].i = 0.f;
00357                                     ioff = ioff + n - i__;
00358 /* L40: */
00359                                 }
00360                                 ioff -= izero;
00361                                 i__3 = n;
00362                                 for (i__ = izero; i__ <= i__3; ++i__) {
00363                                     i__4 = ioff + i__;
00364                                     a[i__4].r = 0.f, a[i__4].i = 0.f;
00365 /* L50: */
00366                                 }
00367                             }
00368                         } else {
00369                             if (iuplo == 1) {
00370 
00371 /*                          Set the first IZERO rows and columns to zero. */
00372 
00373                                 ioff = 0;
00374                                 i__3 = n;
00375                                 for (j = 1; j <= i__3; ++j) {
00376                                     i2 = min(j,izero);
00377                                     i__4 = i2;
00378                                     for (i__ = 1; i__ <= i__4; ++i__) {
00379                                         i__5 = ioff + i__;
00380                                         a[i__5].r = 0.f, a[i__5].i = 0.f;
00381 /* L60: */
00382                                     }
00383                                     ioff += j;
00384 /* L70: */
00385                                 }
00386                             } else {
00387 
00388 /*                          Set the last IZERO rows and columns to zero. */
00389 
00390                                 ioff = 0;
00391                                 i__3 = n;
00392                                 for (j = 1; j <= i__3; ++j) {
00393                                     i1 = max(j,izero);
00394                                     i__4 = n;
00395                                     for (i__ = i1; i__ <= i__4; ++i__) {
00396                                         i__5 = ioff + i__;
00397                                         a[i__5].r = 0.f, a[i__5].i = 0.f;
00398 /* L80: */
00399                                     }
00400                                     ioff = ioff + n - j;
00401 /* L90: */
00402                                 }
00403                             }
00404                         }
00405                     } else {
00406                         izero = 0;
00407                     }
00408                 } else {
00409 
00410 /*                 Use a special block diagonal matrix to test alternate */
00411 /*                 code for the 2 x 2 blocks. */
00412 
00413                     clatsp_(uplo, &n, &a[1], iseed);
00414                 }
00415 
00416 /*              Compute the L*D*L' or U*D*U' factorization of the matrix. */
00417 
00418                 npp = n * (n + 1) / 2;
00419                 ccopy_(&npp, &a[1], &c__1, &afac[1], &c__1);
00420                 s_copy(srnamc_1.srnamt, "CSPTRF", (ftnlen)32, (ftnlen)6);
00421                 csptrf_(uplo, &n, &afac[1], &iwork[1], &info);
00422 
00423 /*              Adjust the expected value of INFO to account for */
00424 /*              pivoting. */
00425 
00426                 k = izero;
00427                 if (k > 0) {
00428 L100:
00429                     if (iwork[k] < 0) {
00430                         if (iwork[k] != -k) {
00431                             k = -iwork[k];
00432                             goto L100;
00433                         }
00434                     } else if (iwork[k] != k) {
00435                         k = iwork[k];
00436                         goto L100;
00437                     }
00438                 }
00439 
00440 /*              Check error code from CSPTRF. */
00441 
00442                 if (info != k) {
00443                     alaerh_(path, "CSPTRF", &info, &k, uplo, &n, &n, &c_n1, &
00444                             c_n1, &c_n1, &imat, &nfail, &nerrs, nout);
00445                 }
00446                 if (info != 0) {
00447                     trfcon = TRUE_;
00448                 } else {
00449                     trfcon = FALSE_;
00450                 }
00451 
00452 /* +    TEST 1 */
00453 /*              Reconstruct matrix from factors and compute residual. */
00454 
00455                 cspt01_(uplo, &n, &a[1], &afac[1], &iwork[1], &ainv[1], &lda, 
00456                         &rwork[1], result);
00457                 nt = 1;
00458 
00459 /* +    TEST 2 */
00460 /*              Form the inverse and compute the residual. */
00461 
00462                 if (! trfcon) {
00463                     ccopy_(&npp, &afac[1], &c__1, &ainv[1], &c__1);
00464                     s_copy(srnamc_1.srnamt, "CSPTRI", (ftnlen)32, (ftnlen)6);
00465                     csptri_(uplo, &n, &ainv[1], &iwork[1], &work[1], &info);
00466 
00467 /*              Check error code from CSPTRI. */
00468 
00469                     if (info != 0) {
00470                         alaerh_(path, "CSPTRI", &info, &c__0, uplo, &n, &n, &
00471                                 c_n1, &c_n1, &c_n1, &imat, &nfail, &nerrs, 
00472                                 nout);
00473                     }
00474 
00475                     cspt03_(uplo, &n, &a[1], &ainv[1], &work[1], &lda, &rwork[
00476                             1], &rcondc, &result[1]);
00477                     nt = 2;
00478                 }
00479 
00480 /*              Print information about the tests that did not pass */
00481 /*              the threshold. */
00482 
00483                 i__3 = nt;
00484                 for (k = 1; k <= i__3; ++k) {
00485                     if (result[k - 1] >= *thresh) {
00486                         if (nfail == 0 && nerrs == 0) {
00487                             alahd_(nout, path);
00488                         }
00489                         io___38.ciunit = *nout;
00490                         s_wsfe(&io___38);
00491                         do_fio(&c__1, uplo, (ftnlen)1);
00492                         do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
00493                         do_fio(&c__1, (char *)&imat, (ftnlen)sizeof(integer));
00494                         do_fio(&c__1, (char *)&k, (ftnlen)sizeof(integer));
00495                         do_fio(&c__1, (char *)&result[k - 1], (ftnlen)sizeof(
00496                                 real));
00497                         e_wsfe();
00498                         ++nfail;
00499                     }
00500 /* L110: */
00501                 }
00502                 nrun += nt;
00503 
00504 /*              Do only the condition estimate if INFO is not 0. */
00505 
00506                 if (trfcon) {
00507                     rcondc = 0.f;
00508                     goto L140;
00509                 }
00510 
00511                 i__3 = *nns;
00512                 for (irhs = 1; irhs <= i__3; ++irhs) {
00513                     nrhs = nsval[irhs];
00514 
00515 /* +    TEST 3 */
00516 /*              Solve and compute residual for  A * X = B. */
00517 
00518                     s_copy(srnamc_1.srnamt, "CLARHS", (ftnlen)32, (ftnlen)6);
00519                     clarhs_(path, xtype, uplo, " ", &n, &n, &kl, &ku, &nrhs, &
00520                             a[1], &lda, &xact[1], &lda, &b[1], &lda, iseed, &
00521                             info);
00522                     clacpy_("Full", &n, &nrhs, &b[1], &lda, &x[1], &lda);
00523 
00524                     s_copy(srnamc_1.srnamt, "CSPTRS", (ftnlen)32, (ftnlen)6);
00525                     csptrs_(uplo, &n, &nrhs, &afac[1], &iwork[1], &x[1], &lda, 
00526                              &info);
00527 
00528 /*              Check error code from CSPTRS. */
00529 
00530                     if (info != 0) {
00531                         alaerh_(path, "CSPTRS", &info, &c__0, uplo, &n, &n, &
00532                                 c_n1, &c_n1, &nrhs, &imat, &nfail, &nerrs, 
00533                                 nout);
00534                     }
00535 
00536                     clacpy_("Full", &n, &nrhs, &b[1], &lda, &work[1], &lda);
00537                     cspt02_(uplo, &n, &nrhs, &a[1], &x[1], &lda, &work[1], &
00538                             lda, &rwork[1], &result[2]);
00539 
00540 /* +    TEST 4 */
00541 /*              Check solution from generated exact solution. */
00542 
00543                     cget04_(&n, &nrhs, &x[1], &lda, &xact[1], &lda, &rcondc, &
00544                             result[3]);
00545 
00546 /* +    TESTS 5, 6, and 7 */
00547 /*              Use iterative refinement to improve the solution. */
00548 
00549                     s_copy(srnamc_1.srnamt, "CSPRFS", (ftnlen)32, (ftnlen)6);
00550                     csprfs_(uplo, &n, &nrhs, &a[1], &afac[1], &iwork[1], &b[1]
00551 , &lda, &x[1], &lda, &rwork[1], &rwork[nrhs + 1], 
00552                             &work[1], &rwork[(nrhs << 1) + 1], &info);
00553 
00554 /*              Check error code from CSPRFS. */
00555 
00556                     if (info != 0) {
00557                         alaerh_(path, "CSPRFS", &info, &c__0, uplo, &n, &n, &
00558                                 c_n1, &c_n1, &nrhs, &imat, &nfail, &nerrs, 
00559                                 nout);
00560                     }
00561 
00562                     cget04_(&n, &nrhs, &x[1], &lda, &xact[1], &lda, &rcondc, &
00563                             result[4]);
00564                     cppt05_(uplo, &n, &nrhs, &a[1], &b[1], &lda, &x[1], &lda, 
00565                             &xact[1], &lda, &rwork[1], &rwork[nrhs + 1], &
00566                             result[5]);
00567 
00568 /*                 Print information about the tests that did not pass */
00569 /*                 the threshold. */
00570 
00571                     for (k = 3; k <= 7; ++k) {
00572                         if (result[k - 1] >= *thresh) {
00573                             if (nfail == 0 && nerrs == 0) {
00574                                 alahd_(nout, path);
00575                             }
00576                             io___41.ciunit = *nout;
00577                             s_wsfe(&io___41);
00578                             do_fio(&c__1, uplo, (ftnlen)1);
00579                             do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer))
00580                                     ;
00581                             do_fio(&c__1, (char *)&nrhs, (ftnlen)sizeof(
00582                                     integer));
00583                             do_fio(&c__1, (char *)&imat, (ftnlen)sizeof(
00584                                     integer));
00585                             do_fio(&c__1, (char *)&k, (ftnlen)sizeof(integer))
00586                                     ;
00587                             do_fio(&c__1, (char *)&result[k - 1], (ftnlen)
00588                                     sizeof(real));
00589                             e_wsfe();
00590                             ++nfail;
00591                         }
00592 /* L120: */
00593                     }
00594                     nrun += 5;
00595 /* L130: */
00596                 }
00597 
00598 /* +    TEST 8 */
00599 /*              Get an estimate of RCOND = 1/CNDNUM. */
00600 
00601 L140:
00602                 anorm = clansp_("1", uplo, &n, &a[1], &rwork[1]);
00603                 s_copy(srnamc_1.srnamt, "CSPCON", (ftnlen)32, (ftnlen)6);
00604                 cspcon_(uplo, &n, &afac[1], &iwork[1], &anorm, &rcond, &work[
00605                         1], &info);
00606 
00607 /*              Check error code from CSPCON. */
00608 
00609                 if (info != 0) {
00610                     alaerh_(path, "CSPCON", &info, &c__0, uplo, &n, &n, &c_n1, 
00611                              &c_n1, &c_n1, &imat, &nfail, &nerrs, nout);
00612                 }
00613 
00614                 result[7] = sget06_(&rcond, &rcondc);
00615 
00616 /*              Print the test ratio if it is .GE. THRESH. */
00617 
00618                 if (result[7] >= *thresh) {
00619                     if (nfail == 0 && nerrs == 0) {
00620                         alahd_(nout, path);
00621                     }
00622                     io___43.ciunit = *nout;
00623                     s_wsfe(&io___43);
00624                     do_fio(&c__1, uplo, (ftnlen)1);
00625                     do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
00626                     do_fio(&c__1, (char *)&imat, (ftnlen)sizeof(integer));
00627                     do_fio(&c__1, (char *)&c__8, (ftnlen)sizeof(integer));
00628                     do_fio(&c__1, (char *)&result[7], (ftnlen)sizeof(real));
00629                     e_wsfe();
00630                     ++nfail;
00631                 }
00632                 ++nrun;
00633 L150:
00634                 ;
00635             }
00636 L160:
00637             ;
00638         }
00639 /* L170: */
00640     }
00641 
00642 /*     Print a summary of the results. */
00643 
00644     alasum_(path, nout, &nfail, &nrun, &nerrs);
00645 
00646     return 0;
00647 
00648 /*     End of CCHKSP */
00649 
00650 } /* cchksp_ */