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


swiftnav
Author(s):
autogenerated on Sat Jun 8 2019 18:55:19