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


swiftnav
Author(s):
autogenerated on Sat Jun 8 2019 18:56:20