cdrvgt.c
Go to the documentation of this file.
00001 /* cdrvgt.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 real c_b43 = 1.f;
00039 static real c_b44 = 0.f;
00040 static complex c_b65 = {0.f,0.f};
00041 
00042 /* Subroutine */ int cdrvgt_(logical *dotype, integer *nn, integer *nval, 
00043         integer *nrhs, real *thresh, logical *tsterr, complex *a, complex *af, 
00044          complex *b, complex *x, complex *xact, complex *work, real *rwork, 
00045         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[] = "(1x,a,\002, N =\002,i5,\002, type \002,i2,\002"
00054             ", test \002,i2,\002, ratio = \002,g12.5)";
00055     static char fmt_9998[] = "(1x,a,\002, FACT='\002,a1,\002', TRANS='\002,a"
00056             "1,\002', N =\002,i5,\002, type \002,i2,\002, test \002,i2,\002, "
00057             "ratio = \002,g12.5)";
00058 
00059     /* System generated locals */
00060     address a__1[2];
00061     integer i__1, i__2, i__3, i__4, i__5, i__6[2];
00062     real r__1, r__2;
00063     char ch__1[2];
00064 
00065     /* Builtin functions */
00066     /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
00067     integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void);
00068     /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
00069 
00070     /* Local variables */
00071     integer i__, j, k, m, n;
00072     real z__[3];
00073     integer k1, in, kl, ku, ix, nt, lda;
00074     char fact[1];
00075     real cond;
00076     integer mode, koff, imat, info;
00077     char path[3], dist[1], type__[1];
00078     integer nrun, ifact;
00079     extern /* Subroutine */ int cget04_(integer *, integer *, complex *, 
00080             integer *, complex *, integer *, real *, real *);
00081     integer nfail, iseed[4];
00082     extern /* Subroutine */ int cgtt01_(integer *, complex *, complex *, 
00083             complex *, complex *, complex *, complex *, complex *, integer *, 
00084             complex *, integer *, real *, real *), cgtt02_(char *, integer *, 
00085             integer *, complex *, complex *, complex *, complex *, integer *, 
00086             complex *, integer *, real *, real *);
00087     real rcond;
00088     extern /* Subroutine */ int cgtt05_(char *, integer *, integer *, complex 
00089             *, complex *, complex *, complex *, integer *, complex *, integer 
00090             *, complex *, integer *, real *, real *, real *);
00091     integer nimat;
00092     extern doublereal sget06_(real *, real *);
00093     real anorm;
00094     integer itran;
00095     extern /* Subroutine */ int ccopy_(integer *, complex *, integer *, 
00096             complex *, integer *), cgtsv_(integer *, integer *, complex *, 
00097             complex *, complex *, complex *, integer *, integer *);
00098     char trans[1];
00099     integer izero, nerrs;
00100     logical zerot;
00101     extern /* Subroutine */ int clatb4_(char *, integer *, integer *, integer 
00102             *, char *, integer *, integer *, real *, integer *, real *, char *
00103 ), aladhd_(integer *, char *), 
00104             alaerh_(char *, char *, integer *, integer *, char *, integer *, 
00105             integer *, integer *, integer *, integer *, integer *, integer *, 
00106             integer *, integer *), clagtm_(char *, 
00107             integer *, integer *, real *, complex *, complex *, complex *, 
00108             complex *, integer *, real *, complex *, integer *);
00109     real rcondc;
00110     extern doublereal clangt_(char *, integer *, complex *, complex *, 
00111             complex *);
00112     extern /* Subroutine */ int csscal_(integer *, real *, complex *, integer 
00113             *), clacpy_(char *, integer *, integer *, complex *, integer *, 
00114             complex *, integer *), claset_(char *, integer *, integer 
00115             *, complex *, complex *, complex *, integer *);
00116     real rcondi;
00117     extern /* Subroutine */ int alasvm_(char *, integer *, integer *, integer 
00118             *, integer *);
00119     real rcondo, anormi;
00120     extern /* Subroutine */ int clarnv_(integer *, integer *, integer *, 
00121             complex *), clatms_(integer *, integer *, char *, integer *, char 
00122             *, real *, integer *, real *, real *, integer *, integer *, char *
00123 , complex *, integer *, complex *, integer *);
00124     real ainvnm;
00125     extern /* Subroutine */ int cgttrf_(integer *, complex *, complex *, 
00126             complex *, complex *, integer *, integer *);
00127     logical trfcon;
00128     real anormo;
00129     extern doublereal scasum_(integer *, complex *, integer *);
00130     extern /* Subroutine */ int cgttrs_(char *, integer *, integer *, complex 
00131             *, complex *, complex *, complex *, integer *, complex *, integer 
00132             *, integer *), cerrvx_(char *, integer *);
00133     real result[6];
00134     extern /* Subroutine */ int cgtsvx_(char *, char *, integer *, integer *, 
00135             complex *, complex *, complex *, complex *, complex *, complex *, 
00136             complex *, integer *, complex *, integer *, complex *, integer *, 
00137             real *, real *, real *, complex *, real *, integer *);
00138 
00139     /* Fortran I/O blocks */
00140     static cilist io___42 = { 0, 0, 0, fmt_9999, 0 };
00141     static cilist io___46 = { 0, 0, 0, fmt_9998, 0 };
00142     static cilist io___47 = { 0, 0, 0, fmt_9998, 0 };
00143 
00144 
00145 
00146 /*  -- LAPACK test routine (version 3.1) -- */
00147 /*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
00148 /*     November 2006 */
00149 
00150 /*     .. Scalar Arguments .. */
00151 /*     .. */
00152 /*     .. Array Arguments .. */
00153 /*     .. */
00154 
00155 /*  Purpose */
00156 /*  ======= */
00157 
00158 /*  CDRVGT tests CGTSV and -SVX. */
00159 
00160 /*  Arguments */
00161 /*  ========= */
00162 
00163 /*  DOTYPE  (input) LOGICAL array, dimension (NTYPES) */
00164 /*          The matrix types to be used for testing.  Matrices of type j */
00165 /*          (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) = */
00166 /*          .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used. */
00167 
00168 /*  NN      (input) INTEGER */
00169 /*          The number of values of N contained in the vector NVAL. */
00170 
00171 /*  NVAL    (input) INTEGER array, dimension (NN) */
00172 /*          The values of the matrix dimension N. */
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 /*  A       (workspace) COMPLEX array, dimension (NMAX*4) */
00183 
00184 /*  AF      (workspace) COMPLEX array, dimension (NMAX*4) */
00185 
00186 /*  B       (workspace) COMPLEX array, dimension (NMAX*NRHS) */
00187 
00188 /*  X       (workspace) COMPLEX array, dimension (NMAX*NRHS) */
00189 
00190 /*  XACT    (workspace) COMPLEX array, dimension (NMAX*NRHS) */
00191 
00192 /*  WORK    (workspace) COMPLEX array, dimension */
00193 /*                      (NMAX*max(3,NRHS)) */
00194 
00195 /*  RWORK   (workspace) REAL array, dimension (NMAX+2*NRHS) */
00196 
00197 /*  IWORK   (workspace) INTEGER array, dimension (2*NMAX) */
00198 
00199 /*  NOUT    (input) INTEGER */
00200 /*          The unit number for output. */
00201 
00202 /*  ===================================================================== */
00203 
00204 /*     .. Parameters .. */
00205 /*     .. */
00206 /*     .. Local Scalars .. */
00207 /*     .. */
00208 /*     .. Local Arrays .. */
00209 /*     .. */
00210 /*     .. External Functions .. */
00211 /*     .. */
00212 /*     .. External Subroutines .. */
00213 /*     .. */
00214 /*     .. Intrinsic Functions .. */
00215 /*     .. */
00216 /*     .. Scalars in Common .. */
00217 /*     .. */
00218 /*     .. Common blocks .. */
00219 /*     .. */
00220 /*     .. Data statements .. */
00221     /* Parameter adjustments */
00222     --iwork;
00223     --rwork;
00224     --work;
00225     --xact;
00226     --x;
00227     --b;
00228     --af;
00229     --a;
00230     --nval;
00231     --dotype;
00232 
00233     /* Function Body */
00234 /*     .. */
00235 /*     .. Executable Statements .. */
00236 
00237     s_copy(path, "Complex precision", (ftnlen)1, (ftnlen)17);
00238     s_copy(path + 1, "GT", (ftnlen)2, (ftnlen)2);
00239     nrun = 0;
00240     nfail = 0;
00241     nerrs = 0;
00242     for (i__ = 1; i__ <= 4; ++i__) {
00243         iseed[i__ - 1] = iseedy[i__ - 1];
00244 /* L10: */
00245     }
00246 
00247 /*     Test the error exits */
00248 
00249     if (*tsterr) {
00250         cerrvx_(path, nout);
00251     }
00252     infoc_1.infot = 0;
00253 
00254     i__1 = *nn;
00255     for (in = 1; in <= i__1; ++in) {
00256 
00257 /*        Do for each value of N in NVAL. */
00258 
00259         n = nval[in];
00260 /* Computing MAX */
00261         i__2 = n - 1;
00262         m = max(i__2,0);
00263         lda = max(1,n);
00264         nimat = 12;
00265         if (n <= 0) {
00266             nimat = 1;
00267         }
00268 
00269         i__2 = nimat;
00270         for (imat = 1; imat <= i__2; ++imat) {
00271 
00272 /*           Do the tests only if DOTYPE( IMAT ) is true. */
00273 
00274             if (! dotype[imat]) {
00275                 goto L130;
00276             }
00277 
00278 /*           Set up parameters with CLATB4. */
00279 
00280             clatb4_(path, &imat, &n, &n, type__, &kl, &ku, &anorm, &mode, &
00281                     cond, dist);
00282 
00283             zerot = imat >= 8 && imat <= 10;
00284             if (imat <= 6) {
00285 
00286 /*              Types 1-6:  generate matrices of known condition number. */
00287 
00288 /* Computing MAX */
00289                 i__3 = 2 - ku, i__4 = 3 - max(1,n);
00290                 koff = max(i__3,i__4);
00291                 s_copy(srnamc_1.srnamt, "CLATMS", (ftnlen)32, (ftnlen)6);
00292                 clatms_(&n, &n, dist, iseed, type__, &rwork[1], &mode, &cond, 
00293                         &anorm, &kl, &ku, "Z", &af[koff], &c__3, &work[1], &
00294                         info);
00295 
00296 /*              Check the error code from CLATMS. */
00297 
00298                 if (info != 0) {
00299                     alaerh_(path, "CLATMS", &info, &c__0, " ", &n, &n, &kl, &
00300                             ku, &c_n1, &imat, &nfail, &nerrs, nout);
00301                     goto L130;
00302                 }
00303                 izero = 0;
00304 
00305                 if (n > 1) {
00306                     i__3 = n - 1;
00307                     ccopy_(&i__3, &af[4], &c__3, &a[1], &c__1);
00308                     i__3 = n - 1;
00309                     ccopy_(&i__3, &af[3], &c__3, &a[n + m + 1], &c__1);
00310                 }
00311                 ccopy_(&n, &af[2], &c__3, &a[m + 1], &c__1);
00312             } else {
00313 
00314 /*              Types 7-12:  generate tridiagonal matrices with */
00315 /*              unknown condition numbers. */
00316 
00317                 if (! zerot || ! dotype[7]) {
00318 
00319 /*                 Generate a matrix with elements from [-1,1]. */
00320 
00321                     i__3 = n + (m << 1);
00322                     clarnv_(&c__2, iseed, &i__3, &a[1]);
00323                     if (anorm != 1.f) {
00324                         i__3 = n + (m << 1);
00325                         csscal_(&i__3, &anorm, &a[1], &c__1);
00326                     }
00327                 } else if (izero > 0) {
00328 
00329 /*                 Reuse the last matrix by copying back the zeroed out */
00330 /*                 elements. */
00331 
00332                     if (izero == 1) {
00333                         i__3 = n;
00334                         a[i__3].r = z__[1], a[i__3].i = 0.f;
00335                         if (n > 1) {
00336                             a[1].r = z__[2], a[1].i = 0.f;
00337                         }
00338                     } else if (izero == n) {
00339                         i__3 = n * 3 - 2;
00340                         a[i__3].r = z__[0], a[i__3].i = 0.f;
00341                         i__3 = (n << 1) - 1;
00342                         a[i__3].r = z__[1], a[i__3].i = 0.f;
00343                     } else {
00344                         i__3 = (n << 1) - 2 + izero;
00345                         a[i__3].r = z__[0], a[i__3].i = 0.f;
00346                         i__3 = n - 1 + izero;
00347                         a[i__3].r = z__[1], a[i__3].i = 0.f;
00348                         i__3 = izero;
00349                         a[i__3].r = z__[2], a[i__3].i = 0.f;
00350                     }
00351                 }
00352 
00353 /*              If IMAT > 7, set one column of the matrix to 0. */
00354 
00355                 if (! zerot) {
00356                     izero = 0;
00357                 } else if (imat == 8) {
00358                     izero = 1;
00359                     i__3 = n;
00360                     z__[1] = a[i__3].r;
00361                     i__3 = n;
00362                     a[i__3].r = 0.f, a[i__3].i = 0.f;
00363                     if (n > 1) {
00364                         z__[2] = a[1].r;
00365                         a[1].r = 0.f, a[1].i = 0.f;
00366                     }
00367                 } else if (imat == 9) {
00368                     izero = n;
00369                     i__3 = n * 3 - 2;
00370                     z__[0] = a[i__3].r;
00371                     i__3 = (n << 1) - 1;
00372                     z__[1] = a[i__3].r;
00373                     i__3 = n * 3 - 2;
00374                     a[i__3].r = 0.f, a[i__3].i = 0.f;
00375                     i__3 = (n << 1) - 1;
00376                     a[i__3].r = 0.f, a[i__3].i = 0.f;
00377                 } else {
00378                     izero = (n + 1) / 2;
00379                     i__3 = n - 1;
00380                     for (i__ = izero; i__ <= i__3; ++i__) {
00381                         i__4 = (n << 1) - 2 + i__;
00382                         a[i__4].r = 0.f, a[i__4].i = 0.f;
00383                         i__4 = n - 1 + i__;
00384                         a[i__4].r = 0.f, a[i__4].i = 0.f;
00385                         i__4 = i__;
00386                         a[i__4].r = 0.f, a[i__4].i = 0.f;
00387 /* L20: */
00388                     }
00389                     i__3 = n * 3 - 2;
00390                     a[i__3].r = 0.f, a[i__3].i = 0.f;
00391                     i__3 = (n << 1) - 1;
00392                     a[i__3].r = 0.f, a[i__3].i = 0.f;
00393                 }
00394             }
00395 
00396             for (ifact = 1; ifact <= 2; ++ifact) {
00397                 if (ifact == 1) {
00398                     *(unsigned char *)fact = 'F';
00399                 } else {
00400                     *(unsigned char *)fact = 'N';
00401                 }
00402 
00403 /*              Compute the condition number for comparison with */
00404 /*              the value returned by CGTSVX. */
00405 
00406                 if (zerot) {
00407                     if (ifact == 1) {
00408                         goto L120;
00409                     }
00410                     rcondo = 0.f;
00411                     rcondi = 0.f;
00412 
00413                 } else if (ifact == 1) {
00414                     i__3 = n + (m << 1);
00415                     ccopy_(&i__3, &a[1], &c__1, &af[1], &c__1);
00416 
00417 /*                 Compute the 1-norm and infinity-norm of A. */
00418 
00419                     anormo = clangt_("1", &n, &a[1], &a[m + 1], &a[n + m + 1]);
00420                     anormi = clangt_("I", &n, &a[1], &a[m + 1], &a[n + m + 1]);
00421 
00422 /*                 Factor the matrix A. */
00423 
00424                     cgttrf_(&n, &af[1], &af[m + 1], &af[n + m + 1], &af[n + (
00425                             m << 1) + 1], &iwork[1], &info);
00426 
00427 /*                 Use CGTTRS to solve for one column at a time of */
00428 /*                 inv(A), computing the maximum column sum as we go. */
00429 
00430                     ainvnm = 0.f;
00431                     i__3 = n;
00432                     for (i__ = 1; i__ <= i__3; ++i__) {
00433                         i__4 = n;
00434                         for (j = 1; j <= i__4; ++j) {
00435                             i__5 = j;
00436                             x[i__5].r = 0.f, x[i__5].i = 0.f;
00437 /* L30: */
00438                         }
00439                         i__4 = i__;
00440                         x[i__4].r = 1.f, x[i__4].i = 0.f;
00441                         cgttrs_("No transpose", &n, &c__1, &af[1], &af[m + 1], 
00442                                  &af[n + m + 1], &af[n + (m << 1) + 1], &
00443                                 iwork[1], &x[1], &lda, &info);
00444 /* Computing MAX */
00445                         r__1 = ainvnm, r__2 = scasum_(&n, &x[1], &c__1);
00446                         ainvnm = dmax(r__1,r__2);
00447 /* L40: */
00448                     }
00449 
00450 /*                 Compute the 1-norm condition number of A. */
00451 
00452                     if (anormo <= 0.f || ainvnm <= 0.f) {
00453                         rcondo = 1.f;
00454                     } else {
00455                         rcondo = 1.f / anormo / ainvnm;
00456                     }
00457 
00458 /*                 Use CGTTRS to solve for one column at a time of */
00459 /*                 inv(A'), computing the maximum column sum as we go. */
00460 
00461                     ainvnm = 0.f;
00462                     i__3 = n;
00463                     for (i__ = 1; i__ <= i__3; ++i__) {
00464                         i__4 = n;
00465                         for (j = 1; j <= i__4; ++j) {
00466                             i__5 = j;
00467                             x[i__5].r = 0.f, x[i__5].i = 0.f;
00468 /* L50: */
00469                         }
00470                         i__4 = i__;
00471                         x[i__4].r = 1.f, x[i__4].i = 0.f;
00472                         cgttrs_("Conjugate transpose", &n, &c__1, &af[1], &af[
00473                                 m + 1], &af[n + m + 1], &af[n + (m << 1) + 1], 
00474                                  &iwork[1], &x[1], &lda, &info);
00475 /* Computing MAX */
00476                         r__1 = ainvnm, r__2 = scasum_(&n, &x[1], &c__1);
00477                         ainvnm = dmax(r__1,r__2);
00478 /* L60: */
00479                     }
00480 
00481 /*                 Compute the infinity-norm condition number of A. */
00482 
00483                     if (anormi <= 0.f || ainvnm <= 0.f) {
00484                         rcondi = 1.f;
00485                     } else {
00486                         rcondi = 1.f / anormi / ainvnm;
00487                     }
00488                 }
00489 
00490                 for (itran = 1; itran <= 3; ++itran) {
00491                     *(unsigned char *)trans = *(unsigned char *)&transs[itran 
00492                             - 1];
00493                     if (itran == 1) {
00494                         rcondc = rcondo;
00495                     } else {
00496                         rcondc = rcondi;
00497                     }
00498 
00499 /*                 Generate NRHS random solution vectors. */
00500 
00501                     ix = 1;
00502                     i__3 = *nrhs;
00503                     for (j = 1; j <= i__3; ++j) {
00504                         clarnv_(&c__2, iseed, &n, &xact[ix]);
00505                         ix += lda;
00506 /* L70: */
00507                     }
00508 
00509 /*                 Set the right hand side. */
00510 
00511                     clagtm_(trans, &n, nrhs, &c_b43, &a[1], &a[m + 1], &a[n + 
00512                             m + 1], &xact[1], &lda, &c_b44, &b[1], &lda);
00513 
00514                     if (ifact == 2 && itran == 1) {
00515 
00516 /*                    --- Test CGTSV  --- */
00517 
00518 /*                    Solve the system using Gaussian elimination with */
00519 /*                    partial pivoting. */
00520 
00521                         i__3 = n + (m << 1);
00522                         ccopy_(&i__3, &a[1], &c__1, &af[1], &c__1);
00523                         clacpy_("Full", &n, nrhs, &b[1], &lda, &x[1], &lda);
00524 
00525                         s_copy(srnamc_1.srnamt, "CGTSV ", (ftnlen)32, (ftnlen)
00526                                 6);
00527                         cgtsv_(&n, nrhs, &af[1], &af[m + 1], &af[n + m + 1], &
00528                                 x[1], &lda, &info);
00529 
00530 /*                    Check error code from CGTSV . */
00531 
00532                         if (info != izero) {
00533                             alaerh_(path, "CGTSV ", &info, &izero, " ", &n, &
00534                                     n, &c__1, &c__1, nrhs, &imat, &nfail, &
00535                                     nerrs, nout);
00536                         }
00537                         nt = 1;
00538                         if (izero == 0) {
00539 
00540 /*                       Check residual of computed solution. */
00541 
00542                             clacpy_("Full", &n, nrhs, &b[1], &lda, &work[1], &
00543                                     lda);
00544                             cgtt02_(trans, &n, nrhs, &a[1], &a[m + 1], &a[n + 
00545                                     m + 1], &x[1], &lda, &work[1], &lda, &
00546                                     rwork[1], &result[1]);
00547 
00548 /*                       Check solution from generated exact solution. */
00549 
00550                             cget04_(&n, nrhs, &x[1], &lda, &xact[1], &lda, &
00551                                     rcondc, &result[2]);
00552                             nt = 3;
00553                         }
00554 
00555 /*                    Print information about the tests that did not pass */
00556 /*                    the threshold. */
00557 
00558                         i__3 = nt;
00559                         for (k = 2; k <= i__3; ++k) {
00560                             if (result[k - 1] >= *thresh) {
00561                                 if (nfail == 0 && nerrs == 0) {
00562                                     aladhd_(nout, path);
00563                                 }
00564                                 io___42.ciunit = *nout;
00565                                 s_wsfe(&io___42);
00566                                 do_fio(&c__1, "CGTSV ", (ftnlen)6);
00567                                 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(
00568                                         integer));
00569                                 do_fio(&c__1, (char *)&imat, (ftnlen)sizeof(
00570                                         integer));
00571                                 do_fio(&c__1, (char *)&k, (ftnlen)sizeof(
00572                                         integer));
00573                                 do_fio(&c__1, (char *)&result[k - 1], (ftnlen)
00574                                         sizeof(real));
00575                                 e_wsfe();
00576                                 ++nfail;
00577                             }
00578 /* L80: */
00579                         }
00580                         nrun = nrun + nt - 1;
00581                     }
00582 
00583 /*                 --- Test CGTSVX --- */
00584 
00585                     if (ifact > 1) {
00586 
00587 /*                    Initialize AF to zero. */
00588 
00589                         i__3 = n * 3 - 2;
00590                         for (i__ = 1; i__ <= i__3; ++i__) {
00591                             i__4 = i__;
00592                             af[i__4].r = 0.f, af[i__4].i = 0.f;
00593 /* L90: */
00594                         }
00595                     }
00596                     claset_("Full", &n, nrhs, &c_b65, &c_b65, &x[1], &lda);
00597 
00598 /*                 Solve the system and compute the condition number and */
00599 /*                 error bounds using CGTSVX. */
00600 
00601                     s_copy(srnamc_1.srnamt, "CGTSVX", (ftnlen)32, (ftnlen)6);
00602                     cgtsvx_(fact, trans, &n, nrhs, &a[1], &a[m + 1], &a[n + m 
00603                             + 1], &af[1], &af[m + 1], &af[n + m + 1], &af[n + 
00604                             (m << 1) + 1], &iwork[1], &b[1], &lda, &x[1], &
00605                             lda, &rcond, &rwork[1], &rwork[*nrhs + 1], &work[
00606                             1], &rwork[(*nrhs << 1) + 1], &info);
00607 
00608 /*                 Check the error code from CGTSVX. */
00609 
00610                     if (info != izero) {
00611 /* Writing concatenation */
00612                         i__6[0] = 1, a__1[0] = fact;
00613                         i__6[1] = 1, a__1[1] = trans;
00614                         s_cat(ch__1, a__1, i__6, &c__2, (ftnlen)2);
00615                         alaerh_(path, "CGTSVX", &info, &izero, ch__1, &n, &n, 
00616                                 &c__1, &c__1, nrhs, &imat, &nfail, &nerrs, 
00617                                 nout);
00618                     }
00619 
00620                     if (ifact >= 2) {
00621 
00622 /*                    Reconstruct matrix from factors and compute */
00623 /*                    residual. */
00624 
00625                         cgtt01_(&n, &a[1], &a[m + 1], &a[n + m + 1], &af[1], &
00626                                 af[m + 1], &af[n + m + 1], &af[n + (m << 1) + 
00627                                 1], &iwork[1], &work[1], &lda, &rwork[1], 
00628                                 result);
00629                         k1 = 1;
00630                     } else {
00631                         k1 = 2;
00632                     }
00633 
00634                     if (info == 0) {
00635                         trfcon = FALSE_;
00636 
00637 /*                    Check residual of computed solution. */
00638 
00639                         clacpy_("Full", &n, nrhs, &b[1], &lda, &work[1], &lda);
00640                         cgtt02_(trans, &n, nrhs, &a[1], &a[m + 1], &a[n + m + 
00641                                 1], &x[1], &lda, &work[1], &lda, &rwork[1], &
00642                                 result[1]);
00643 
00644 /*                    Check solution from generated exact solution. */
00645 
00646                         cget04_(&n, nrhs, &x[1], &lda, &xact[1], &lda, &
00647                                 rcondc, &result[2]);
00648 
00649 /*                    Check the error bounds from iterative refinement. */
00650 
00651                         cgtt05_(trans, &n, nrhs, &a[1], &a[m + 1], &a[n + m + 
00652                                 1], &b[1], &lda, &x[1], &lda, &xact[1], &lda, 
00653                                 &rwork[1], &rwork[*nrhs + 1], &result[3]);
00654                         nt = 5;
00655                     }
00656 
00657 /*                 Print information about the tests that did not pass */
00658 /*                 the threshold. */
00659 
00660                     i__3 = nt;
00661                     for (k = k1; k <= i__3; ++k) {
00662                         if (result[k - 1] >= *thresh) {
00663                             if (nfail == 0 && nerrs == 0) {
00664                                 aladhd_(nout, path);
00665                             }
00666                             io___46.ciunit = *nout;
00667                             s_wsfe(&io___46);
00668                             do_fio(&c__1, "CGTSVX", (ftnlen)6);
00669                             do_fio(&c__1, fact, (ftnlen)1);
00670                             do_fio(&c__1, trans, (ftnlen)1);
00671                             do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer))
00672                                     ;
00673                             do_fio(&c__1, (char *)&imat, (ftnlen)sizeof(
00674                                     integer));
00675                             do_fio(&c__1, (char *)&k, (ftnlen)sizeof(integer))
00676                                     ;
00677                             do_fio(&c__1, (char *)&result[k - 1], (ftnlen)
00678                                     sizeof(real));
00679                             e_wsfe();
00680                             ++nfail;
00681                         }
00682 /* L100: */
00683                     }
00684 
00685 /*                 Check the reciprocal of the condition number. */
00686 
00687                     result[5] = sget06_(&rcond, &rcondc);
00688                     if (result[5] >= *thresh) {
00689                         if (nfail == 0 && nerrs == 0) {
00690                             aladhd_(nout, path);
00691                         }
00692                         io___47.ciunit = *nout;
00693                         s_wsfe(&io___47);
00694                         do_fio(&c__1, "CGTSVX", (ftnlen)6);
00695                         do_fio(&c__1, fact, (ftnlen)1);
00696                         do_fio(&c__1, trans, (ftnlen)1);
00697                         do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
00698                         do_fio(&c__1, (char *)&imat, (ftnlen)sizeof(integer));
00699                         do_fio(&c__1, (char *)&k, (ftnlen)sizeof(integer));
00700                         do_fio(&c__1, (char *)&result[k - 1], (ftnlen)sizeof(
00701                                 real));
00702                         e_wsfe();
00703                         ++nfail;
00704                     }
00705                     nrun = nrun + nt - k1 + 2;
00706 
00707 /* L110: */
00708                 }
00709 L120:
00710                 ;
00711             }
00712 L130:
00713             ;
00714         }
00715 /* L140: */
00716     }
00717 
00718 /*     Print a summary of the results. */
00719 
00720     alasvm_(path, nout, &nfail, &nrun, &nerrs);
00721 
00722     return 0;
00723 
00724 /*     End of CDRVGT */
00725 
00726 } /* cdrvgt_ */


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