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


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