cchkgt.c
Go to the documentation of this file.
00001 /* cchkgt.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__3 = 3;
00034 static integer c__0 = 0;
00035 static integer c_n1 = -1;
00036 static integer c__1 = 1;
00037 static integer c__2 = 2;
00038 static integer c__7 = 7;
00039 static real c_b63 = 1.f;
00040 static real c_b64 = 0.f;
00041 
00042 /* Subroutine */ int cchkgt_(logical *dotype, integer *nn, integer *nval, 
00043         integer *nns, integer *nsval, real *thresh, logical *tsterr, complex *
00044         a, complex *af, complex *b, complex *x, complex *xact, complex *work, 
00045         real *rwork, integer *iwork, integer *nout)
00046 {
00047     /* Initialized data */
00048 
00049     static integer iseedy[4] = { 0,0,0,1 };
00050     static char transs[1*3] = "N" "T" "C";
00051 
00052     /* Format strings */
00053     static char fmt_9999[] = "(12x,\002N =\002,i5,\002,\002,10x,\002 type"
00054             " \002,i2,\002, test(\002,i2,\002) = \002,g12.5)";
00055     static char fmt_9997[] = "(\002 NORM ='\002,a1,\002', N =\002,i5,\002"
00056             ",\002,10x,\002 type \002,i2,\002, test(\002,i2,\002) = \002,g12."
00057             "5)";
00058     static char fmt_9998[] = "(\002 TRANS='\002,a1,\002', N =\002,i5,\002, N"
00059             "RHS=\002,i3,\002, type \002,i2,\002, test(\002,i2,\002) = \002,g"
00060             "12.5)";
00061 
00062     /* System generated locals */
00063     integer i__1, i__2, i__3, i__4, i__5;
00064     real r__1, r__2;
00065 
00066     /* Builtin functions */
00067     /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
00068     integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void);
00069 
00070     /* Local variables */
00071     integer i__, j, k, m, n;
00072     complex z__[3];
00073     integer in, kl, ku, ix, lda;
00074     real cond;
00075     integer mode, koff, imat, info;
00076     char path[3], dist[1];
00077     integer irhs, nrhs;
00078     char norm[1], type__[1];
00079     integer nrun;
00080     extern /* Subroutine */ int alahd_(integer *, char *), cget04_(
00081             integer *, integer *, complex *, integer *, complex *, integer *, 
00082             real *, real *);
00083     integer nfail, iseed[4];
00084     extern /* Subroutine */ int cgtt01_(integer *, complex *, complex *, 
00085             complex *, complex *, complex *, complex *, complex *, integer *, 
00086             complex *, integer *, real *, real *), cgtt02_(char *, integer *, 
00087             integer *, complex *, complex *, complex *, complex *, integer *, 
00088             complex *, integer *, real *, real *);
00089     real rcond;
00090     extern /* Subroutine */ int cgtt05_(char *, integer *, integer *, complex 
00091             *, complex *, complex *, complex *, integer *, complex *, integer 
00092             *, complex *, integer *, real *, real *, real *);
00093     integer nimat;
00094     extern doublereal sget06_(real *, real *);
00095     real anorm;
00096     integer itran;
00097     extern /* Subroutine */ int ccopy_(integer *, complex *, integer *, 
00098             complex *, integer *);
00099     char trans[1];
00100     integer izero, nerrs;
00101     logical zerot;
00102     extern /* Subroutine */ int clatb4_(char *, integer *, integer *, integer 
00103             *, char *, integer *, integer *, real *, integer *, real *, char *
00104 ), alaerh_(char *, char *, integer *, 
00105             integer *, char *, integer *, integer *, integer *, integer *, 
00106             integer *, integer *, integer *, integer *, integer *), cerrge_(char *, integer *);
00107     real rcondc;
00108     extern doublereal clangt_(char *, integer *, complex *, complex *, 
00109             complex *);
00110     extern /* Subroutine */ int clagtm_(char *, integer *, integer *, real *, 
00111             complex *, complex *, complex *, complex *, integer *, real *, 
00112             complex *, integer *), clacpy_(char *, integer *, integer 
00113             *, complex *, integer *, complex *, integer *), csscal_(
00114             integer *, real *, complex *, integer *), cgtcon_(char *, integer 
00115             *, complex *, complex *, complex *, complex *, integer *, real *, 
00116             real *, complex *, integer *);
00117     real rcondi;
00118     extern /* Subroutine */ int alasum_(char *, integer *, integer *, integer 
00119             *, integer *);
00120     real rcondo;
00121     extern /* Subroutine */ int clarnv_(integer *, integer *, integer *, 
00122             complex *), clatms_(integer *, integer *, char *, integer *, char 
00123             *, real *, integer *, real *, real *, integer *, integer *, char *
00124 , complex *, integer *, complex *, integer *);
00125     real ainvnm;
00126     extern /* Subroutine */ int cgtrfs_(char *, integer *, integer *, complex 
00127             *, complex *, complex *, complex *, complex *, complex *, complex 
00128             *, integer *, complex *, integer *, complex *, integer *, real *, 
00129             real *, complex *, real *, integer *), cgttrf_(integer *, 
00130             complex *, complex *, complex *, complex *, integer *, integer *);
00131     logical trfcon;
00132     extern doublereal scasum_(integer *, complex *, integer *);
00133     extern /* Subroutine */ int cgttrs_(char *, integer *, integer *, complex 
00134             *, complex *, complex *, complex *, integer *, complex *, integer 
00135             *, integer *);
00136     real result[7];
00137 
00138     /* Fortran I/O blocks */
00139     static cilist io___29 = { 0, 0, 0, fmt_9999, 0 };
00140     static cilist io___39 = { 0, 0, 0, fmt_9997, 0 };
00141     static cilist io___44 = { 0, 0, 0, fmt_9998, 0 };
00142 
00143 
00144 
00145 /*  -- LAPACK test routine (version 3.1.1) -- */
00146 /*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
00147 /*     January 2007 */
00148 
00149 /*     .. Scalar Arguments .. */
00150 /*     .. */
00151 /*     .. Array Arguments .. */
00152 /*     .. */
00153 
00154 /*  Purpose */
00155 /*  ======= */
00156 
00157 /*  CCHKGT tests CGTTRF, -TRS, -RFS, and -CON */
00158 
00159 /*  Arguments */
00160 /*  ========= */
00161 
00162 /*  DOTYPE  (input) LOGICAL array, dimension (NTYPES) */
00163 /*          The matrix types to be used for testing.  Matrices of type j */
00164 /*          (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) = */
00165 /*          .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used. */
00166 
00167 /*  NN      (input) INTEGER */
00168 /*          The number of values of N contained in the vector NVAL. */
00169 
00170 /*  NVAL    (input) INTEGER array, dimension (NN) */
00171 /*          The values of the matrix dimension N. */
00172 
00173 /*  NNS     (input) INTEGER */
00174 /*          The number of values of NRHS contained in the vector NSVAL. */
00175 
00176 /*  NSVAL   (input) INTEGER array, dimension (NNS) */
00177 /*          The values of the number of right hand sides NRHS. */
00178 
00179 /*  THRESH  (input) REAL */
00180 /*          The threshold value for the test ratios.  A result is */
00181 /*          included in the output file if RESULT >= THRESH.  To have */
00182 /*          every test ratio printed, use THRESH = 0. */
00183 
00184 /*  TSTERR  (input) LOGICAL */
00185 /*          Flag that indicates whether error exits are to be tested. */
00186 
00187 /*  A       (workspace) COMPLEX array, dimension (NMAX*4) */
00188 
00189 /*  AF      (workspace) COMPLEX array, dimension (NMAX*4) */
00190 
00191 /*  B       (workspace) COMPLEX array, dimension (NMAX*NSMAX) */
00192 /*          where NSMAX is the largest entry in NSVAL. */
00193 
00194 /*  X       (workspace) COMPLEX array, dimension (NMAX*NSMAX) */
00195 
00196 /*  XACT    (workspace) COMPLEX array, dimension (NMAX*NSMAX) */
00197 
00198 /*  WORK    (workspace) COMPLEX 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 (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     --af;
00236     --a;
00237     --nsval;
00238     --nval;
00239     --dotype;
00240 
00241     /* Function Body */
00242 /*     .. */
00243 /*     .. Executable Statements .. */
00244 
00245     s_copy(path, "Complex precision", (ftnlen)1, (ftnlen)17);
00246     s_copy(path + 1, "GT", (ftnlen)2, (ftnlen)2);
00247     nrun = 0;
00248     nfail = 0;
00249     nerrs = 0;
00250     for (i__ = 1; i__ <= 4; ++i__) {
00251         iseed[i__ - 1] = iseedy[i__ - 1];
00252 /* L10: */
00253     }
00254 
00255 /*     Test the error exits */
00256 
00257     if (*tsterr) {
00258         cerrge_(path, nout);
00259     }
00260     infoc_1.infot = 0;
00261 
00262     i__1 = *nn;
00263     for (in = 1; in <= i__1; ++in) {
00264 
00265 /*        Do for each value of N in NVAL. */
00266 
00267         n = nval[in];
00268 /* Computing MAX */
00269         i__2 = n - 1;
00270         m = max(i__2,0);
00271         lda = max(1,n);
00272         nimat = 12;
00273         if (n <= 0) {
00274             nimat = 1;
00275         }
00276 
00277         i__2 = nimat;
00278         for (imat = 1; imat <= i__2; ++imat) {
00279 
00280 /*           Do the tests only if DOTYPE( IMAT ) is true. */
00281 
00282             if (! dotype[imat]) {
00283                 goto L100;
00284             }
00285 
00286 /*           Set up parameters with CLATB4. */
00287 
00288             clatb4_(path, &imat, &n, &n, type__, &kl, &ku, &anorm, &mode, &
00289                     cond, dist);
00290 
00291             zerot = imat >= 8 && imat <= 10;
00292             if (imat <= 6) {
00293 
00294 /*              Types 1-6:  generate matrices of known condition number. */
00295 
00296 /* Computing MAX */
00297                 i__3 = 2 - ku, i__4 = 3 - max(1,n);
00298                 koff = max(i__3,i__4);
00299                 s_copy(srnamc_1.srnamt, "CLATMS", (ftnlen)32, (ftnlen)6);
00300                 clatms_(&n, &n, dist, iseed, type__, &rwork[1], &mode, &cond, 
00301                         &anorm, &kl, &ku, "Z", &af[koff], &c__3, &work[1], &
00302                         info);
00303 
00304 /*              Check the error code from CLATMS. */
00305 
00306                 if (info != 0) {
00307                     alaerh_(path, "CLATMS", &info, &c__0, " ", &n, &n, &kl, &
00308                             ku, &c_n1, &imat, &nfail, &nerrs, nout);
00309                     goto L100;
00310                 }
00311                 izero = 0;
00312 
00313                 if (n > 1) {
00314                     i__3 = n - 1;
00315                     ccopy_(&i__3, &af[4], &c__3, &a[1], &c__1);
00316                     i__3 = n - 1;
00317                     ccopy_(&i__3, &af[3], &c__3, &a[n + m + 1], &c__1);
00318                 }
00319                 ccopy_(&n, &af[2], &c__3, &a[m + 1], &c__1);
00320             } else {
00321 
00322 /*              Types 7-12:  generate tridiagonal matrices with */
00323 /*              unknown condition numbers. */
00324 
00325                 if (! zerot || ! dotype[7]) {
00326 
00327 /*                 Generate a matrix with elements whose real and */
00328 /*                 imaginary parts are from [-1,1]. */
00329 
00330                     i__3 = n + (m << 1);
00331                     clarnv_(&c__2, iseed, &i__3, &a[1]);
00332                     if (anorm != 1.f) {
00333                         i__3 = n + (m << 1);
00334                         csscal_(&i__3, &anorm, &a[1], &c__1);
00335                     }
00336                 } else if (izero > 0) {
00337 
00338 /*                 Reuse the last matrix by copying back the zeroed out */
00339 /*                 elements. */
00340 
00341                     if (izero == 1) {
00342                         i__3 = n;
00343                         a[i__3].r = z__[1].r, a[i__3].i = z__[1].i;
00344                         if (n > 1) {
00345                             a[1].r = z__[2].r, a[1].i = z__[2].i;
00346                         }
00347                     } else if (izero == n) {
00348                         i__3 = n * 3 - 2;
00349                         a[i__3].r = z__[0].r, a[i__3].i = z__[0].i;
00350                         i__3 = (n << 1) - 1;
00351                         a[i__3].r = z__[1].r, a[i__3].i = z__[1].i;
00352                     } else {
00353                         i__3 = (n << 1) - 2 + izero;
00354                         a[i__3].r = z__[0].r, a[i__3].i = z__[0].i;
00355                         i__3 = n - 1 + izero;
00356                         a[i__3].r = z__[1].r, a[i__3].i = z__[1].i;
00357                         i__3 = izero;
00358                         a[i__3].r = z__[2].r, a[i__3].i = z__[2].i;
00359                     }
00360                 }
00361 
00362 /*              If IMAT > 7, set one column of the matrix to 0. */
00363 
00364                 if (! zerot) {
00365                     izero = 0;
00366                 } else if (imat == 8) {
00367                     izero = 1;
00368                     i__3 = n;
00369                     z__[1].r = a[i__3].r, z__[1].i = a[i__3].i;
00370                     i__3 = n;
00371                     a[i__3].r = 0.f, a[i__3].i = 0.f;
00372                     if (n > 1) {
00373                         z__[2].r = a[1].r, z__[2].i = a[1].i;
00374                         a[1].r = 0.f, a[1].i = 0.f;
00375                     }
00376                 } else if (imat == 9) {
00377                     izero = n;
00378                     i__3 = n * 3 - 2;
00379                     z__[0].r = a[i__3].r, z__[0].i = a[i__3].i;
00380                     i__3 = (n << 1) - 1;
00381                     z__[1].r = a[i__3].r, z__[1].i = a[i__3].i;
00382                     i__3 = n * 3 - 2;
00383                     a[i__3].r = 0.f, a[i__3].i = 0.f;
00384                     i__3 = (n << 1) - 1;
00385                     a[i__3].r = 0.f, a[i__3].i = 0.f;
00386                 } else {
00387                     izero = (n + 1) / 2;
00388                     i__3 = n - 1;
00389                     for (i__ = izero; i__ <= i__3; ++i__) {
00390                         i__4 = (n << 1) - 2 + i__;
00391                         a[i__4].r = 0.f, a[i__4].i = 0.f;
00392                         i__4 = n - 1 + i__;
00393                         a[i__4].r = 0.f, a[i__4].i = 0.f;
00394                         i__4 = i__;
00395                         a[i__4].r = 0.f, a[i__4].i = 0.f;
00396 /* L20: */
00397                     }
00398                     i__3 = n * 3 - 2;
00399                     a[i__3].r = 0.f, a[i__3].i = 0.f;
00400                     i__3 = (n << 1) - 1;
00401                     a[i__3].r = 0.f, a[i__3].i = 0.f;
00402                 }
00403             }
00404 
00405 /* +    TEST 1 */
00406 /*           Factor A as L*U and compute the ratio */
00407 /*              norm(L*U - A) / (n * norm(A) * EPS ) */
00408 
00409             i__3 = n + (m << 1);
00410             ccopy_(&i__3, &a[1], &c__1, &af[1], &c__1);
00411             s_copy(srnamc_1.srnamt, "CGTTRF", (ftnlen)32, (ftnlen)6);
00412             cgttrf_(&n, &af[1], &af[m + 1], &af[n + m + 1], &af[n + (m << 1) 
00413                     + 1], &iwork[1], &info);
00414 
00415 /*           Check error code from CGTTRF. */
00416 
00417             if (info != izero) {
00418                 alaerh_(path, "CGTTRF", &info, &izero, " ", &n, &n, &c__1, &
00419                         c__1, &c_n1, &imat, &nfail, &nerrs, nout);
00420             }
00421             trfcon = info != 0;
00422 
00423             cgtt01_(&n, &a[1], &a[m + 1], &a[n + m + 1], &af[1], &af[m + 1], &
00424                     af[n + m + 1], &af[n + (m << 1) + 1], &iwork[1], &work[1], 
00425                      &lda, &rwork[1], result);
00426 
00427 /*           Print the test ratio if it is .GE. THRESH. */
00428 
00429             if (result[0] >= *thresh) {
00430                 if (nfail == 0 && nerrs == 0) {
00431                     alahd_(nout, path);
00432                 }
00433                 io___29.ciunit = *nout;
00434                 s_wsfe(&io___29);
00435                 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
00436                 do_fio(&c__1, (char *)&imat, (ftnlen)sizeof(integer));
00437                 do_fio(&c__1, (char *)&c__1, (ftnlen)sizeof(integer));
00438                 do_fio(&c__1, (char *)&result[0], (ftnlen)sizeof(real));
00439                 e_wsfe();
00440                 ++nfail;
00441             }
00442             ++nrun;
00443 
00444             for (itran = 1; itran <= 2; ++itran) {
00445                 *(unsigned char *)trans = *(unsigned char *)&transs[itran - 1]
00446                         ;
00447                 if (itran == 1) {
00448                     *(unsigned char *)norm = 'O';
00449                 } else {
00450                     *(unsigned char *)norm = 'I';
00451                 }
00452                 anorm = clangt_(norm, &n, &a[1], &a[m + 1], &a[n + m + 1]);
00453 
00454                 if (! trfcon) {
00455 
00456 /*                 Use CGTTRS to solve for one column at a time of */
00457 /*                 inv(A), computing the maximum column sum as we go. */
00458 
00459                     ainvnm = 0.f;
00460                     i__3 = n;
00461                     for (i__ = 1; i__ <= i__3; ++i__) {
00462                         i__4 = n;
00463                         for (j = 1; j <= i__4; ++j) {
00464                             i__5 = j;
00465                             x[i__5].r = 0.f, x[i__5].i = 0.f;
00466 /* L30: */
00467                         }
00468                         i__4 = i__;
00469                         x[i__4].r = 1.f, x[i__4].i = 0.f;
00470                         cgttrs_(trans, &n, &c__1, &af[1], &af[m + 1], &af[n + 
00471                                 m + 1], &af[n + (m << 1) + 1], &iwork[1], &x[
00472                                 1], &lda, &info);
00473 /* Computing MAX */
00474                         r__1 = ainvnm, r__2 = scasum_(&n, &x[1], &c__1);
00475                         ainvnm = dmax(r__1,r__2);
00476 /* L40: */
00477                     }
00478 
00479 /*                 Compute RCONDC = 1 / (norm(A) * norm(inv(A)) */
00480 
00481                     if (anorm <= 0.f || ainvnm <= 0.f) {
00482                         rcondc = 1.f;
00483                     } else {
00484                         rcondc = 1.f / anorm / ainvnm;
00485                     }
00486                     if (itran == 1) {
00487                         rcondo = rcondc;
00488                     } else {
00489                         rcondi = rcondc;
00490                     }
00491                 } else {
00492                     rcondc = 0.f;
00493                 }
00494 
00495 /* +    TEST 7 */
00496 /*              Estimate the reciprocal of the condition number of the */
00497 /*              matrix. */
00498 
00499                 s_copy(srnamc_1.srnamt, "CGTCON", (ftnlen)32, (ftnlen)6);
00500                 cgtcon_(norm, &n, &af[1], &af[m + 1], &af[n + m + 1], &af[n + 
00501                         (m << 1) + 1], &iwork[1], &anorm, &rcond, &work[1], &
00502                         info);
00503 
00504 /*              Check error code from CGTCON. */
00505 
00506                 if (info != 0) {
00507                     alaerh_(path, "CGTCON", &info, &c__0, norm, &n, &n, &c_n1, 
00508                              &c_n1, &c_n1, &imat, &nfail, &nerrs, nout);
00509                 }
00510 
00511                 result[6] = sget06_(&rcond, &rcondc);
00512 
00513 /*              Print the test ratio if it is .GE. THRESH. */
00514 
00515                 if (result[6] >= *thresh) {
00516                     if (nfail == 0 && nerrs == 0) {
00517                         alahd_(nout, path);
00518                     }
00519                     io___39.ciunit = *nout;
00520                     s_wsfe(&io___39);
00521                     do_fio(&c__1, norm, (ftnlen)1);
00522                     do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
00523                     do_fio(&c__1, (char *)&imat, (ftnlen)sizeof(integer));
00524                     do_fio(&c__1, (char *)&c__7, (ftnlen)sizeof(integer));
00525                     do_fio(&c__1, (char *)&result[6], (ftnlen)sizeof(real));
00526                     e_wsfe();
00527                     ++nfail;
00528                 }
00529                 ++nrun;
00530 /* L50: */
00531             }
00532 
00533 /*           Skip the remaining tests if the matrix is singular. */
00534 
00535             if (trfcon) {
00536                 goto L100;
00537             }
00538 
00539             i__3 = *nns;
00540             for (irhs = 1; irhs <= i__3; ++irhs) {
00541                 nrhs = nsval[irhs];
00542 
00543 /*              Generate NRHS random solution vectors. */
00544 
00545                 ix = 1;
00546                 i__4 = nrhs;
00547                 for (j = 1; j <= i__4; ++j) {
00548                     clarnv_(&c__2, iseed, &n, &xact[ix]);
00549                     ix += lda;
00550 /* L60: */
00551                 }
00552 
00553                 for (itran = 1; itran <= 3; ++itran) {
00554                     *(unsigned char *)trans = *(unsigned char *)&transs[itran 
00555                             - 1];
00556                     if (itran == 1) {
00557                         rcondc = rcondo;
00558                     } else {
00559                         rcondc = rcondi;
00560                     }
00561 
00562 /*                 Set the right hand side. */
00563 
00564                     clagtm_(trans, &n, &nrhs, &c_b63, &a[1], &a[m + 1], &a[n 
00565                             + m + 1], &xact[1], &lda, &c_b64, &b[1], &lda);
00566 
00567 /* +    TEST 2 */
00568 /*              Solve op(A) * X = B and compute the residual. */
00569 
00570                     clacpy_("Full", &n, &nrhs, &b[1], &lda, &x[1], &lda);
00571                     s_copy(srnamc_1.srnamt, "CGTTRS", (ftnlen)32, (ftnlen)6);
00572                     cgttrs_(trans, &n, &nrhs, &af[1], &af[m + 1], &af[n + m + 
00573                             1], &af[n + (m << 1) + 1], &iwork[1], &x[1], &lda, 
00574                              &info);
00575 
00576 /*              Check error code from CGTTRS. */
00577 
00578                     if (info != 0) {
00579                         alaerh_(path, "CGTTRS", &info, &c__0, trans, &n, &n, &
00580                                 c_n1, &c_n1, &nrhs, &imat, &nfail, &nerrs, 
00581                                 nout);
00582                     }
00583 
00584                     clacpy_("Full", &n, &nrhs, &b[1], &lda, &work[1], &lda);
00585                     cgtt02_(trans, &n, &nrhs, &a[1], &a[m + 1], &a[n + m + 1], 
00586                              &x[1], &lda, &work[1], &lda, &rwork[1], &result[
00587                             1]);
00588 
00589 /* +    TEST 3 */
00590 /*              Check solution from generated exact solution. */
00591 
00592                     cget04_(&n, &nrhs, &x[1], &lda, &xact[1], &lda, &rcondc, &
00593                             result[2]);
00594 
00595 /* +    TESTS 4, 5, and 6 */
00596 /*              Use iterative refinement to improve the solution. */
00597 
00598                     s_copy(srnamc_1.srnamt, "CGTRFS", (ftnlen)32, (ftnlen)6);
00599                     cgtrfs_(trans, &n, &nrhs, &a[1], &a[m + 1], &a[n + m + 1], 
00600                              &af[1], &af[m + 1], &af[n + m + 1], &af[n + (m <<
00601                              1) + 1], &iwork[1], &b[1], &lda, &x[1], &lda, &
00602                             rwork[1], &rwork[nrhs + 1], &work[1], &rwork[(
00603                             nrhs << 1) + 1], &info);
00604 
00605 /*              Check error code from CGTRFS. */
00606 
00607                     if (info != 0) {
00608                         alaerh_(path, "CGTRFS", &info, &c__0, trans, &n, &n, &
00609                                 c_n1, &c_n1, &nrhs, &imat, &nfail, &nerrs, 
00610                                 nout);
00611                     }
00612 
00613                     cget04_(&n, &nrhs, &x[1], &lda, &xact[1], &lda, &rcondc, &
00614                             result[3]);
00615                     cgtt05_(trans, &n, &nrhs, &a[1], &a[m + 1], &a[n + m + 1], 
00616                              &b[1], &lda, &x[1], &lda, &xact[1], &lda, &rwork[
00617                             1], &rwork[nrhs + 1], &result[4]);
00618 
00619 /*              Print information about the tests that did not pass the */
00620 /*              threshold. */
00621 
00622                     for (k = 2; k <= 6; ++k) {
00623                         if (result[k - 1] >= *thresh) {
00624                             if (nfail == 0 && nerrs == 0) {
00625                                 alahd_(nout, path);
00626                             }
00627                             io___44.ciunit = *nout;
00628                             s_wsfe(&io___44);
00629                             do_fio(&c__1, trans, (ftnlen)1);
00630                             do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer))
00631                                     ;
00632                             do_fio(&c__1, (char *)&nrhs, (ftnlen)sizeof(
00633                                     integer));
00634                             do_fio(&c__1, (char *)&imat, (ftnlen)sizeof(
00635                                     integer));
00636                             do_fio(&c__1, (char *)&k, (ftnlen)sizeof(integer))
00637                                     ;
00638                             do_fio(&c__1, (char *)&result[k - 1], (ftnlen)
00639                                     sizeof(real));
00640                             e_wsfe();
00641                             ++nfail;
00642                         }
00643 /* L70: */
00644                     }
00645                     nrun += 5;
00646 /* L80: */
00647                 }
00648 /* L90: */
00649             }
00650 L100:
00651             ;
00652         }
00653 /* L110: */
00654     }
00655 
00656 /*     Print a summary of the results. */
00657 
00658     alasum_(path, nout, &nfail, &nrun, &nerrs);
00659 
00660     return 0;
00661 
00662 /*     End of CCHKGT */
00663 
00664 } /* cchkgt_ */


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