cdrvgbx.c
Go to the documentation of this file.
00001 /* cdrvgbx.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 "memory_alloc.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__1 = 1;
00034 static integer c__2 = 2;
00035 static integer c__0 = 0;
00036 static integer c_n1 = -1;
00037 static complex c_b48 = {0.f,0.f};
00038 static complex c_b49 = {1.f,0.f};
00039 static integer c__6 = 6;
00040 static integer c__7 = 7;
00041 static real c_b197 = 0.f;
00042 
00043 /* Subroutine */ int cdrvgb_(logical *dotype, integer *nn, integer *nval, 
00044         integer *nrhs, real *thresh, logical *tsterr, complex *a, integer *la, 
00045          complex *afb, integer *lafb, complex *asav, complex *b, complex *
00046         bsav, complex *x, complex *xact, real *s, complex *work, real *rwork, 
00047         integer *iwork, integer *nout)
00048 {
00049     /* Initialized data */
00050 
00051     static integer iseedy[4] = { 1988,1989,1990,1991 };
00052     static char transs[1*3] = "N" "T" "C";
00053     static char facts[1*3] = "F" "N" "E";
00054     static char equeds[1*4] = "N" "R" "C" "B";
00055 
00056     /* Format strings */
00057     static char fmt_9999[] = "(\002 *** In CDRVGB, LA=\002,i5,\002 is too sm"
00058             "all for N=\002,i5,\002, KU=\002,i5,\002, KL=\002,i5,/\002 ==> In"
00059             "crease LA to at least \002,i5)";
00060     static char fmt_9998[] = "(\002 *** In CDRVGB, LAFB=\002,i5,\002 is too "
00061             "small for N=\002,i5,\002, KU=\002,i5,\002, KL=\002,i5,/\002 ==> "
00062             "Increase LAFB to at least \002,i5)";
00063     static char fmt_9997[] = "(1x,a,\002, N=\002,i5,\002, KL=\002,i5,\002, K"
00064             "U=\002,i5,\002, type \002,i1,\002, test(\002,i1,\002)=\002,g12.5)"
00065             ;
00066     static char fmt_9995[] = "(1x,a,\002( '\002,a1,\002','\002,a1,\002',\002"
00067             ",i5,\002,\002,i5,\002,\002,i5,\002,...), EQUED='\002,a1,\002', t"
00068             "ype \002,i1,\002, test(\002,i1,\002)=\002,g12.5)";
00069     static char fmt_9996[] = "(1x,a,\002( '\002,a1,\002','\002,a1,\002',\002"
00070             ",i5,\002,\002,i5,\002,\002,i5,\002,...), type \002,i1,\002, test("
00071             "\002,i1,\002)=\002,g12.5)";
00072 
00073     /* System generated locals */
00074     address a__1[2];
00075     integer i__1, i__2, i__3, i__4, i__5, i__6, i__7, i__8, i__9, i__10, 
00076             i__11[2];
00077     real r__1, r__2;
00078     char ch__1[2];
00079 
00080     /* Builtin functions */
00081     /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
00082     integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void);
00083     /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
00084     double c_abs(complex *);
00085 
00086     /* Local variables */
00087     extern /* Subroutine */ int cebchvxx_(real *, char *);
00088     integer i__, j, k, n;
00089     real *errbnds_c__;
00090     integer i1, i2, k1;
00091     real *errbnds_n__;
00092     integer nb, in, kl, ku, nt, n_err_bnds__, lda, ldb, ikl, nkl, iku, nku;
00093     char fact[1];
00094     integer ioff, mode;
00095     real amax;
00096     char path[3];
00097     integer imat, info;
00098     real *berr;
00099     char dist[1];
00100     real rdum[1], rpvgrw_svxx__;
00101     char type__[1];
00102     integer nrun;
00103     extern doublereal cla_gbrpvgrw__(integer *, integer *, integer *, integer 
00104             *, complex *, integer *, complex *, integer *);
00105     integer ldafb;
00106     extern /* Subroutine */ int cgbt01_(), cgbt02_(), cgbt05_(char *, integer 
00107             *, integer *, integer *, integer *, complex *, integer *, complex 
00108             *, integer *, complex *, integer *, complex *, integer *, real *, 
00109             real *, real *);
00110     integer ifact;
00111     extern /* Subroutine */ int cget04_(integer *, integer *, complex *, 
00112             integer *, complex *, integer *, real *, real *);
00113     integer nfail, iseed[4], nfact;
00114     extern logical lsame_(char *, char *);
00115     char equed[1];
00116     integer nbmin;
00117     real rcond, roldc;
00118     extern /* Subroutine */ int cgbsv_(integer *, integer *, integer *, 
00119             integer *, complex *, integer *, integer *, complex *, integer *, 
00120             integer *);
00121     integer nimat;
00122     real roldi;
00123     extern doublereal sget06_(real *, real *);
00124     real anorm;
00125     integer itran;
00126     logical equil;
00127     real roldo;
00128     char trans[1];
00129     integer izero, nerrs;
00130     logical zerot;
00131     char xtype[1];
00132     extern /* Subroutine */ int clatb4_(char *, integer *, integer *, integer 
00133             *, char *, integer *, integer *, real *, integer *, real *, char *
00134 ), aladhd_(integer *, char *);
00135     extern doublereal clangb_(char *, integer *, integer *, integer *, 
00136             complex *, integer *, real *), clange_(char *, integer *, 
00137             integer *, complex *, integer *, real *);
00138     extern /* Subroutine */ int claqgb_(integer *, integer *, integer *, 
00139             integer *, complex *, integer *, real *, real *, real *, real *, 
00140             real *, char *), alaerh_(char *, char *, integer *, 
00141             integer *, char *, integer *, integer *, integer *, integer *, 
00142             integer *, integer *, integer *, integer *, integer *);
00143     logical prefac;
00144     real colcnd;
00145     extern doublereal clantb_(char *, char *, char *, integer *, integer *, 
00146             complex *, integer *, real *);
00147     extern /* Subroutine */ int cgbequ_(integer *, integer *, integer *, 
00148             integer *, complex *, integer *, real *, real *, real *, real *, 
00149             real *, integer *);
00150     real rcondc;
00151     extern doublereal slamch_(char *);
00152     logical nofact;
00153     extern /* Subroutine */ int cgbtrf_(integer *, integer *, integer *, 
00154             integer *, complex *, integer *, integer *, integer *);
00155     integer iequed;
00156     extern /* Subroutine */ int clacpy_(char *, integer *, integer *, complex 
00157             *, integer *, complex *, integer *);
00158     real rcondi;
00159     extern /* Subroutine */ int clarhs_(char *, char *, char *, char *, 
00160             integer *, integer *, integer *, integer *, integer *, complex *, 
00161             integer *, complex *, integer *, complex *, integer *, integer *, 
00162             integer *), claset_(), alasvm_(
00163             char *, integer *, integer *, integer *, integer *);
00164     real cndnum, anormi, rcondo, ainvnm;
00165     extern /* Subroutine */ int cgbtrs_(char *, integer *, integer *, integer 
00166             *, integer *, complex *, integer *, integer *, complex *, integer 
00167             *, integer *), clatms_(integer *, integer *, char *, 
00168             integer *, char *, real *, integer *, real *, real *, integer *, 
00169             integer *, char *, complex *, integer *, complex *, integer *);
00170     logical trfcon;
00171     real anormo, rowcnd;
00172     extern /* Subroutine */ int cgbsvx_(char *, char *, integer *, integer *, 
00173             integer *, integer *, complex *, integer *, complex *, integer *, 
00174             integer *, char *, real *, real *, complex *, integer *, complex *
00175 , integer *, real *, real *, real *, complex *, real *, integer *), xlaenv_(integer *, integer *);
00176     real anrmpv;
00177     extern /* Subroutine */ int cerrvx_(char *, integer *);
00178     real result[7], rpvgrw;
00179     extern /* Subroutine */ int cgbsvxx_(char *, char *, integer *, integer *, 
00180              integer *, integer *, complex *, integer *, complex *, integer *, 
00181              integer *, char *, real *, real *, complex *, integer *, complex 
00182             *, integer *, real *, real *, real *, integer *, real *, real *, 
00183             integer *, real *, complex *, real *, integer *);
00184 
00185     /* Fortran I/O blocks */
00186     static cilist io___26 = { 0, 0, 0, fmt_9999, 0 };
00187     static cilist io___27 = { 0, 0, 0, fmt_9998, 0 };
00188     static cilist io___65 = { 0, 0, 0, fmt_9997, 0 };
00189     static cilist io___73 = { 0, 0, 0, fmt_9995, 0 };
00190     static cilist io___74 = { 0, 0, 0, fmt_9996, 0 };
00191     static cilist io___75 = { 0, 0, 0, fmt_9995, 0 };
00192     static cilist io___76 = { 0, 0, 0, fmt_9996, 0 };
00193     static cilist io___77 = { 0, 0, 0, fmt_9995, 0 };
00194     static cilist io___78 = { 0, 0, 0, fmt_9996, 0 };
00195     static cilist io___79 = { 0, 0, 0, fmt_9995, 0 };
00196     static cilist io___80 = { 0, 0, 0, fmt_9996, 0 };
00197     static cilist io___86 = { 0, 0, 0, fmt_9997, 0 };
00198     static cilist io___87 = { 0, 0, 0, fmt_9998, 0 };
00199     static cilist io___88 = { 0, 0, 0, fmt_9997, 0 };
00200     static cilist io___89 = { 0, 0, 0, fmt_9998, 0 };
00201     static cilist io___90 = { 0, 0, 0, fmt_9997, 0 };
00202     static cilist io___91 = { 0, 0, 0, fmt_9998, 0 };
00203     static cilist io___92 = { 0, 0, 0, fmt_9997, 0 };
00204     static cilist io___93 = { 0, 0, 0, fmt_9998, 0 };
00205 
00206 
00207 
00208 /*  -- LAPACK test routine (version 3.1) -- */
00209 /*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
00210 /*     November 2006 */
00211 
00212 /*     .. Scalar Arguments .. */
00213 /*     .. */
00214 /*     .. Array Arguments .. */
00215 /*     .. */
00216 
00217 /*  Purpose */
00218 /*  ======= */
00219 
00220 /*  CDRVGB tests the driver routines CGBSV and -SVX. */
00221 
00222 /*  Arguments */
00223 /*  ========= */
00224 
00225 /*  DOTYPE  (input) LOGICAL array, dimension (NTYPES) */
00226 /*          The matrix types to be used for testing.  Matrices of type j */
00227 /*          (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) = */
00228 /*          .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used. */
00229 
00230 /*  NN      (input) INTEGER */
00231 /*          The number of values of N contained in the vector NVAL. */
00232 
00233 /*  NVAL    (input) INTEGER array, dimension (NN) */
00234 /*          The values of the matrix column dimension N. */
00235 
00236 /*  NRHS    (input) INTEGER */
00237 /*          The number of right hand side vectors to be generated for */
00238 /*          each linear system. */
00239 
00240 /*  THRESH  (input) REAL */
00241 /*          The threshold value for the test ratios.  A result is */
00242 /*          included in the output file if RESULT >= THRESH.  To have */
00243 /*          every test ratio printed, use THRESH = 0. */
00244 
00245 /*  TSTERR  (input) LOGICAL */
00246 /*          Flag that indicates whether error exits are to be tested. */
00247 
00248 /*  A       (workspace) COMPLEX array, dimension (LA) */
00249 
00250 /*  LA      (input) INTEGER */
00251 /*          The length of the array A.  LA >= (2*NMAX-1)*NMAX */
00252 /*          where NMAX is the largest entry in NVAL. */
00253 
00254 /*  AFB     (workspace) COMPLEX array, dimension (LAFB) */
00255 
00256 /*  LAFB    (input) INTEGER */
00257 /*          The length of the array AFB.  LAFB >= (3*NMAX-2)*NMAX */
00258 /*          where NMAX is the largest entry in NVAL. */
00259 
00260 /*  ASAV    (workspace) COMPLEX array, dimension (LA) */
00261 
00262 /*  B       (workspace) COMPLEX array, dimension (NMAX*NRHS) */
00263 
00264 /*  BSAV    (workspace) COMPLEX array, dimension (NMAX*NRHS) */
00265 
00266 /*  X       (workspace) COMPLEX array, dimension (NMAX*NRHS) */
00267 
00268 /*  XACT    (workspace) COMPLEX array, dimension (NMAX*NRHS) */
00269 
00270 /*  S       (workspace) REAL array, dimension (2*NMAX) */
00271 
00272 /*  WORK    (workspace) COMPLEX array, dimension */
00273 /*                      (NMAX*max(3,NRHS,NMAX)) */
00274 
00275 /*  RWORK   (workspace) REAL array, dimension */
00276 /*                      (max(NMAX,2*NRHS)) */
00277 
00278 /*  IWORK   (workspace) INTEGER array, dimension (NMAX) */
00279 
00280 /*  NOUT    (input) INTEGER */
00281 /*          The unit number for output. */
00282 
00283 /*  ===================================================================== */
00284 
00285 /*     .. Parameters .. */
00286 /*     .. */
00287 /*     .. Local Scalars .. */
00288 /*     .. */
00289 /*     .. Local Arrays .. */
00290 /*                                           replace NRHS with 99 to make f2c work through */
00291 /*     .. */
00292 /*     .. External Functions .. */
00293 /*     .. */
00294 /*     .. External Subroutines .. */
00295 /*     .. */
00296 /*     .. Intrinsic Functions .. */
00297 /*     .. */
00298 /*     .. Scalars in Common .. */
00299 /*     .. */
00300 /*     .. Common blocks .. */
00301 /*     .. */
00302 /*     .. Data statements .. */
00303     /* Parameter adjustments */
00304     --iwork;
00305     --rwork;
00306     --work;
00307     --s;
00308     --xact;
00309     --x;
00310     --bsav;
00311     --b;
00312     --asav;
00313     --afb;
00314     --a;
00315     --nval;
00316     --dotype;
00317 
00318     /* Function Body */
00319 /*     .. */
00320 /*     .. Executable Statements .. */
00321 
00322 /*     Initialize constants and the random number seed. */
00323 
00324     s_copy(path, "Complex precision", (ftnlen)1, (ftnlen)17);
00325     s_copy(path + 1, "GB", (ftnlen)2, (ftnlen)2);
00326     nrun = 0;
00327     nfail = 0;
00328     nerrs = 0;
00329     for (i__ = 1; i__ <= 4; ++i__) {
00330         iseed[i__ - 1] = iseedy[i__ - 1];
00331 /* L10: */
00332     }
00333 
00334 /*     Test the error exits */
00335 
00336     if (*tsterr) {
00337         cerrvx_(path, nout);
00338     }
00339     infoc_1.infot = 0;
00340 
00341 /*     Set the block size and minimum block size for testing. */
00342 
00343     nb = 1;
00344     nbmin = 2;
00345     xlaenv_(&c__1, &nb);
00346     xlaenv_(&c__2, &nbmin);
00347 
00348 /*     Do for each value of N in NVAL */
00349 
00350     i__1 = *nn;
00351     for (in = 1; in <= i__1; ++in) {
00352         n = nval[in];
00353         ldb = max(n,1);
00354         *(unsigned char *)xtype = 'N';
00355 
00356 /*        Set limits on the number of loop iterations. */
00357 
00358 /* Computing MAX */
00359         i__2 = 1, i__3 = min(n,4);
00360         nkl = max(i__2,i__3);
00361         if (n == 0) {
00362             nkl = 1;
00363         }
00364         nku = nkl;
00365         nimat = 8;
00366         if (n <= 0) {
00367             nimat = 1;
00368         }
00369 
00370         i__2 = nkl;
00371         for (ikl = 1; ikl <= i__2; ++ikl) {
00372 
00373 /*           Do for KL = 0, N-1, (3N-1)/4, and (N+1)/4. This order makes */
00374 /*           it easier to skip redundant values for small values of N. */
00375 
00376             if (ikl == 1) {
00377                 kl = 0;
00378             } else if (ikl == 2) {
00379 /* Computing MAX */
00380                 i__3 = n - 1;
00381                 kl = max(i__3,0);
00382             } else if (ikl == 3) {
00383                 kl = (n * 3 - 1) / 4;
00384             } else if (ikl == 4) {
00385                 kl = (n + 1) / 4;
00386             }
00387             i__3 = nku;
00388             for (iku = 1; iku <= i__3; ++iku) {
00389 
00390 /*              Do for KU = 0, N-1, (3N-1)/4, and (N+1)/4. This order */
00391 /*              makes it easier to skip redundant values for small */
00392 /*              values of N. */
00393 
00394                 if (iku == 1) {
00395                     ku = 0;
00396                 } else if (iku == 2) {
00397 /* Computing MAX */
00398                     i__4 = n - 1;
00399                     ku = max(i__4,0);
00400                 } else if (iku == 3) {
00401                     ku = (n * 3 - 1) / 4;
00402                 } else if (iku == 4) {
00403                     ku = (n + 1) / 4;
00404                 }
00405 
00406 /*              Check that A and AFB are big enough to generate this */
00407 /*              matrix. */
00408 
00409                 lda = kl + ku + 1;
00410                 ldafb = (kl << 1) + ku + 1;
00411                 if (lda * n > *la || ldafb * n > *lafb) {
00412                     if (nfail == 0 && nerrs == 0) {
00413                         aladhd_(nout, path);
00414                     }
00415                     if (lda * n > *la) {
00416                         io___26.ciunit = *nout;
00417                         s_wsfe(&io___26);
00418                         do_fio(&c__1, (char *)&(*la), (ftnlen)sizeof(integer))
00419                                 ;
00420                         do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
00421                         do_fio(&c__1, (char *)&kl, (ftnlen)sizeof(integer));
00422                         do_fio(&c__1, (char *)&ku, (ftnlen)sizeof(integer));
00423                         i__4 = n * (kl + ku + 1);
00424                         do_fio(&c__1, (char *)&i__4, (ftnlen)sizeof(integer));
00425                         e_wsfe();
00426                         ++nerrs;
00427                     }
00428                     if (ldafb * n > *lafb) {
00429                         io___27.ciunit = *nout;
00430                         s_wsfe(&io___27);
00431                         do_fio(&c__1, (char *)&(*lafb), (ftnlen)sizeof(
00432                                 integer));
00433                         do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
00434                         do_fio(&c__1, (char *)&kl, (ftnlen)sizeof(integer));
00435                         do_fio(&c__1, (char *)&ku, (ftnlen)sizeof(integer));
00436                         i__4 = n * ((kl << 1) + ku + 1);
00437                         do_fio(&c__1, (char *)&i__4, (ftnlen)sizeof(integer));
00438                         e_wsfe();
00439                         ++nerrs;
00440                     }
00441                     goto L130;
00442                 }
00443 
00444                 i__4 = nimat;
00445                 for (imat = 1; imat <= i__4; ++imat) {
00446 
00447 /*                 Do the tests only if DOTYPE( IMAT ) is true. */
00448 
00449                     if (! dotype[imat]) {
00450                         goto L120;
00451                     }
00452 
00453 /*                 Skip types 2, 3, or 4 if the matrix is too small. */
00454 
00455                     zerot = imat >= 2 && imat <= 4;
00456                     if (zerot && n < imat - 1) {
00457                         goto L120;
00458                     }
00459 
00460 /*                 Set up parameters with CLATB4 and generate a */
00461 /*                 test matrix with CLATMS. */
00462 
00463                     clatb4_(path, &imat, &n, &n, type__, &kl, &ku, &anorm, &
00464                             mode, &cndnum, dist);
00465                     rcondc = 1.f / cndnum;
00466 
00467                     s_copy(srnamc_1.srnamt, "CLATMS", (ftnlen)32, (ftnlen)6);
00468                     clatms_(&n, &n, dist, iseed, type__, &rwork[1], &mode, &
00469                             cndnum, &anorm, &kl, &ku, "Z", &a[1], &lda, &work[
00470                             1], &info);
00471 
00472 /*                 Check the error code from CLATMS. */
00473 
00474                     if (info != 0) {
00475                         alaerh_(path, "CLATMS", &info, &c__0, " ", &n, &n, &
00476                                 kl, &ku, &c_n1, &imat, &nfail, &nerrs, nout);
00477                         goto L120;
00478                     }
00479 
00480 /*                 For types 2, 3, and 4, zero one or more columns of */
00481 /*                 the matrix to test that INFO is returned correctly. */
00482 
00483                     izero = 0;
00484                     if (zerot) {
00485                         if (imat == 2) {
00486                             izero = 1;
00487                         } else if (imat == 3) {
00488                             izero = n;
00489                         } else {
00490                             izero = n / 2 + 1;
00491                         }
00492                         ioff = (izero - 1) * lda;
00493                         if (imat < 4) {
00494 /* Computing MAX */
00495                             i__5 = 1, i__6 = ku + 2 - izero;
00496                             i1 = max(i__5,i__6);
00497 /* Computing MIN */
00498                             i__5 = kl + ku + 1, i__6 = ku + 1 + (n - izero);
00499                             i2 = min(i__5,i__6);
00500                             i__5 = i2;
00501                             for (i__ = i1; i__ <= i__5; ++i__) {
00502                                 i__6 = ioff + i__;
00503                                 a[i__6].r = 0.f, a[i__6].i = 0.f;
00504 /* L20: */
00505                             }
00506                         } else {
00507                             i__5 = n;
00508                             for (j = izero; j <= i__5; ++j) {
00509 /* Computing MAX */
00510                                 i__6 = 1, i__7 = ku + 2 - j;
00511 /* Computing MIN */
00512                                 i__9 = kl + ku + 1, i__10 = ku + 1 + (n - j);
00513                                 i__8 = min(i__9,i__10);
00514                                 for (i__ = max(i__6,i__7); i__ <= i__8; ++i__)
00515                                          {
00516                                     i__6 = ioff + i__;
00517                                     a[i__6].r = 0.f, a[i__6].i = 0.f;
00518 /* L30: */
00519                                 }
00520                                 ioff += lda;
00521 /* L40: */
00522                             }
00523                         }
00524                     }
00525 
00526 /*                 Save a copy of the matrix A in ASAV. */
00527 
00528                     i__5 = kl + ku + 1;
00529                     clacpy_("Full", &i__5, &n, &a[1], &lda, &asav[1], &lda);
00530 
00531                     for (iequed = 1; iequed <= 4; ++iequed) {
00532                         *(unsigned char *)equed = *(unsigned char *)&equeds[
00533                                 iequed - 1];
00534                         if (iequed == 1) {
00535                             nfact = 3;
00536                         } else {
00537                             nfact = 1;
00538                         }
00539 
00540                         i__5 = nfact;
00541                         for (ifact = 1; ifact <= i__5; ++ifact) {
00542                             *(unsigned char *)fact = *(unsigned char *)&facts[
00543                                     ifact - 1];
00544                             prefac = lsame_(fact, "F");
00545                             nofact = lsame_(fact, "N");
00546                             equil = lsame_(fact, "E");
00547 
00548                             if (zerot) {
00549                                 if (prefac) {
00550                                     goto L100;
00551                                 }
00552                                 rcondo = 0.f;
00553                                 rcondi = 0.f;
00554 
00555                             } else if (! nofact) {
00556 
00557 /*                          Compute the condition number for comparison */
00558 /*                          with the value returned by SGESVX (FACT = */
00559 /*                          'N' reuses the condition number from the */
00560 /*                          previous iteration with FACT = 'F'). */
00561 
00562                                 i__8 = kl + ku + 1;
00563                                 clacpy_("Full", &i__8, &n, &asav[1], &lda, &
00564                                         afb[kl + 1], &ldafb);
00565                                 if (equil || iequed > 1) {
00566 
00567 /*                             Compute row and column scale factors to */
00568 /*                             equilibrate the matrix A. */
00569 
00570                                     cgbequ_(&n, &n, &kl, &ku, &afb[kl + 1], &
00571                                             ldafb, &s[1], &s[n + 1], &rowcnd, 
00572                                             &colcnd, &amax, &info);
00573                                     if (info == 0 && n > 0) {
00574                                         if (lsame_(equed, "R")) {
00575                                             rowcnd = 0.f;
00576                                             colcnd = 1.f;
00577                                         } else if (lsame_(equed, "C")) {
00578                                             rowcnd = 1.f;
00579                                             colcnd = 0.f;
00580                                         } else if (lsame_(equed, "B")) {
00581                                             rowcnd = 0.f;
00582                                             colcnd = 0.f;
00583                                         }
00584 
00585 /*                                Equilibrate the matrix. */
00586 
00587                                         claqgb_(&n, &n, &kl, &ku, &afb[kl + 1]
00588 , &ldafb, &s[1], &s[n + 1], &
00589                                                 rowcnd, &colcnd, &amax, equed);
00590                                     }
00591                                 }
00592 
00593 /*                          Save the condition number of the */
00594 /*                          non-equilibrated system for use in CGET04. */
00595 
00596                                 if (equil) {
00597                                     roldo = rcondo;
00598                                     roldi = rcondi;
00599                                 }
00600 
00601 /*                          Compute the 1-norm and infinity-norm of A. */
00602 
00603                                 anormo = clangb_("1", &n, &kl, &ku, &afb[kl + 
00604                                         1], &ldafb, &rwork[1]);
00605                                 anormi = clangb_("I", &n, &kl, &ku, &afb[kl + 
00606                                         1], &ldafb, &rwork[1]);
00607 
00608 /*                          Factor the matrix A. */
00609 
00610                                 cgbtrf_(&n, &n, &kl, &ku, &afb[1], &ldafb, &
00611                                         iwork[1], &info);
00612 
00613 /*                          Form the inverse of A. */
00614 
00615                                 claset_("Full", &n, &n, &c_b48, &c_b49, &work[
00616                                         1], &ldb);
00617                                 s_copy(srnamc_1.srnamt, "CGBTRS", (ftnlen)32, 
00618                                         (ftnlen)6);
00619                                 cgbtrs_("No transpose", &n, &kl, &ku, &n, &
00620                                         afb[1], &ldafb, &iwork[1], &work[1], &
00621                                         ldb, &info);
00622 
00623 /*                          Compute the 1-norm condition number of A. */
00624 
00625                                 ainvnm = clange_("1", &n, &n, &work[1], &ldb, 
00626                                         &rwork[1]);
00627                                 if (anormo <= 0.f || ainvnm <= 0.f) {
00628                                     rcondo = 1.f;
00629                                 } else {
00630                                     rcondo = 1.f / anormo / ainvnm;
00631                                 }
00632 
00633 /*                          Compute the infinity-norm condition number */
00634 /*                          of A. */
00635 
00636                                 ainvnm = clange_("I", &n, &n, &work[1], &ldb, 
00637                                         &rwork[1]);
00638                                 if (anormi <= 0.f || ainvnm <= 0.f) {
00639                                     rcondi = 1.f;
00640                                 } else {
00641                                     rcondi = 1.f / anormi / ainvnm;
00642                                 }
00643                             }
00644 
00645                             for (itran = 1; itran <= 3; ++itran) {
00646 
00647 /*                          Do for each value of TRANS. */
00648 
00649                                 *(unsigned char *)trans = *(unsigned char *)&
00650                                         transs[itran - 1];
00651                                 if (itran == 1) {
00652                                     rcondc = rcondo;
00653                                 } else {
00654                                     rcondc = rcondi;
00655                                 }
00656 
00657 /*                          Restore the matrix A. */
00658 
00659                                 i__8 = kl + ku + 1;
00660                                 clacpy_("Full", &i__8, &n, &asav[1], &lda, &a[
00661                                         1], &lda);
00662 
00663 /*                          Form an exact solution and set the right hand */
00664 /*                          side. */
00665 
00666                                 s_copy(srnamc_1.srnamt, "CLARHS", (ftnlen)32, 
00667                                         (ftnlen)6);
00668                                 clarhs_(path, xtype, "Full", trans, &n, &n, &
00669                                         kl, &ku, nrhs, &a[1], &lda, &xact[1], 
00670                                         &ldb, &b[1], &ldb, iseed, &info);
00671                                 *(unsigned char *)xtype = 'C';
00672                                 clacpy_("Full", &n, nrhs, &b[1], &ldb, &bsav[
00673                                         1], &ldb);
00674 
00675                                 if (nofact && itran == 1) {
00676 
00677 /*                             --- Test CGBSV  --- */
00678 
00679 /*                             Compute the LU factorization of the matrix */
00680 /*                             and solve the system. */
00681 
00682                                     i__8 = kl + ku + 1;
00683                                     clacpy_("Full", &i__8, &n, &a[1], &lda, &
00684                                             afb[kl + 1], &ldafb);
00685                                     clacpy_("Full", &n, nrhs, &b[1], &ldb, &x[
00686                                             1], &ldb);
00687 
00688                                     s_copy(srnamc_1.srnamt, "CGBSV ", (ftnlen)
00689                                             32, (ftnlen)6);
00690                                     cgbsv_(&n, &kl, &ku, nrhs, &afb[1], &
00691                                             ldafb, &iwork[1], &x[1], &ldb, &
00692                                             info);
00693 
00694 /*                             Check error code from CGBSV . */
00695 
00696                                     if (info == n + 1) {
00697                                         goto L90;
00698                                     }
00699                                     if (info != izero) {
00700                                         alaerh_(path, "CGBSV ", &info, &izero, 
00701                                                  " ", &n, &n, &kl, &ku, nrhs, 
00702                                                 &imat, &nfail, &nerrs, nout);
00703                                         goto L90;
00704                                     }
00705 
00706 /*                             Reconstruct matrix from factors and */
00707 /*                             compute residual. */
00708 
00709                                     cgbt01_(&n, &n, &kl, &ku, &a[1], &lda, &
00710                                             afb[1], &ldafb, &iwork[1], &work[
00711                                             1], result);
00712                                     nt = 1;
00713                                     if (izero == 0) {
00714 
00715 /*                                Compute residual of the computed */
00716 /*                                solution. */
00717 
00718                                         clacpy_("Full", &n, nrhs, &b[1], &ldb, 
00719                                                  &work[1], &ldb);
00720                                         cgbt02_("No transpose", &n, &n, &kl, &
00721                                                 ku, nrhs, &a[1], &lda, &x[1], 
00722                                                 &ldb, &work[1], &ldb, &result[
00723                                                 1]);
00724 
00725 /*                                Check solution from generated exact */
00726 /*                                solution. */
00727 
00728                                         cget04_(&n, nrhs, &x[1], &ldb, &xact[
00729                                                 1], &ldb, &rcondc, &result[2])
00730                                                 ;
00731                                         nt = 3;
00732                                     }
00733 
00734 /*                             Print information about the tests that did */
00735 /*                             not pass the threshold. */
00736 
00737                                     i__8 = nt;
00738                                     for (k = 1; k <= i__8; ++k) {
00739                                         if (result[k - 1] >= *thresh) {
00740                                             if (nfail == 0 && nerrs == 0) {
00741                           aladhd_(nout, path);
00742                                             }
00743                                             io___65.ciunit = *nout;
00744                                             s_wsfe(&io___65);
00745                                             do_fio(&c__1, "CGBSV ", (ftnlen)6)
00746                                                     ;
00747                                             do_fio(&c__1, (char *)&n, (ftnlen)
00748                                                     sizeof(integer));
00749                                             do_fio(&c__1, (char *)&kl, (
00750                                                     ftnlen)sizeof(integer));
00751                                             do_fio(&c__1, (char *)&ku, (
00752                                                     ftnlen)sizeof(integer));
00753                                             do_fio(&c__1, (char *)&imat, (
00754                                                     ftnlen)sizeof(integer));
00755                                             do_fio(&c__1, (char *)&k, (ftnlen)
00756                                                     sizeof(integer));
00757                                             do_fio(&c__1, (char *)&result[k - 
00758                                                     1], (ftnlen)sizeof(real));
00759                                             e_wsfe();
00760                                             ++nfail;
00761                                         }
00762 /* L50: */
00763                                     }
00764                                     nrun += nt;
00765                                 }
00766 
00767 /*                          --- Test CGBSVX --- */
00768 
00769                                 if (! prefac) {
00770                                     i__8 = (kl << 1) + ku + 1;
00771                                     claset_("Full", &i__8, &n, &c_b48, &c_b48, 
00772                                              &afb[1], &ldafb);
00773                                 }
00774                                 claset_("Full", &n, nrhs, &c_b48, &c_b48, &x[
00775                                         1], &ldb);
00776                                 if (iequed > 1 && n > 0) {
00777 
00778 /*                             Equilibrate the matrix if FACT = 'F' and */
00779 /*                             EQUED = 'R', 'C', or 'B'. */
00780 
00781                                     claqgb_(&n, &n, &kl, &ku, &a[1], &lda, &s[
00782                                             1], &s[n + 1], &rowcnd, &colcnd, &
00783                                             amax, equed);
00784                                 }
00785 
00786 /*                          Solve the system and compute the condition */
00787 /*                          number and error bounds using CGBSVX. */
00788 
00789                                 s_copy(srnamc_1.srnamt, "CGBSVX", (ftnlen)32, 
00790                                         (ftnlen)6);
00791                                 cgbsvx_(fact, trans, &n, &kl, &ku, nrhs, &a[1]
00792 , &lda, &afb[1], &ldafb, &iwork[1], 
00793                                         equed, &s[1], &s[ldb + 1], &b[1], &
00794                                         ldb, &x[1], &ldb, &rcond, &rwork[1], &
00795                                         rwork[*nrhs + 1], &work[1], &rwork[(*
00796                                         nrhs << 1) + 1], &info);
00797 
00798 /*                          Check the error code from CGBSVX. */
00799 
00800                                 if (info == n + 1) {
00801                                     goto L90;
00802                                 }
00803                                 if (info != izero) {
00804 /* Writing concatenation */
00805                                     i__11[0] = 1, a__1[0] = fact;
00806                                     i__11[1] = 1, a__1[1] = trans;
00807                                     s_cat(ch__1, a__1, i__11, &c__2, (ftnlen)
00808                                             2);
00809                                     alaerh_(path, "CGBSVX", &info, &izero, 
00810                                             ch__1, &n, &n, &kl, &ku, nrhs, &
00811                                             imat, &nfail, &nerrs, nout);
00812                                     goto L90;
00813                                 }
00814 /*                          Compare RWORK(2*NRHS+1) from CGBSVX with the */
00815 /*                          computed reciprocal pivot growth RPVGRW */
00816 
00817                                 if (info != 0) {
00818                                     anrmpv = 0.f;
00819                                     i__8 = info;
00820                                     for (j = 1; j <= i__8; ++j) {
00821 /* Computing MAX */
00822                                         i__6 = ku + 2 - j;
00823 /* Computing MIN */
00824                                         i__9 = n + ku + 1 - j, i__10 = kl + 
00825                                                 ku + 1;
00826                                         i__7 = min(i__9,i__10);
00827                                         for (i__ = max(i__6,1); i__ <= i__7; 
00828                                                 ++i__) {
00829 /* Computing MAX */
00830                                             r__1 = anrmpv, r__2 = c_abs(&a[
00831                                                     i__ + (j - 1) * lda]);
00832                                             anrmpv = dmax(r__1,r__2);
00833 /* L60: */
00834                                         }
00835 /* L70: */
00836                                     }
00837 /* Computing MIN */
00838                                     i__7 = info - 1, i__6 = kl + ku;
00839                                     i__8 = min(i__7,i__6);
00840 /* Computing MAX */
00841                                     i__9 = 1, i__10 = kl + ku + 2 - info;
00842                                     rpvgrw = clantb_("M", "U", "N", &info, &
00843                                             i__8, &afb[max(i__9, i__10)], &
00844                                             ldafb, rdum);
00845                                     if (rpvgrw == 0.f) {
00846                                         rpvgrw = 1.f;
00847                                     } else {
00848                                         rpvgrw = anrmpv / rpvgrw;
00849                                     }
00850                                 } else {
00851                                     i__8 = kl + ku;
00852                                     rpvgrw = clantb_("M", "U", "N", &n, &i__8, 
00853                                              &afb[1], &ldafb, rdum);
00854                                     if (rpvgrw == 0.f) {
00855                                         rpvgrw = 1.f;
00856                                     } else {
00857                                         rpvgrw = clangb_("M", &n, &kl, &ku, &
00858                                                 a[1], &lda, rdum) /
00859                                                  rpvgrw;
00860                                     }
00861                                 }
00862 /* Computing MAX */
00863                                 r__2 = rwork[(*nrhs << 1) + 1];
00864                                 result[6] = (r__1 = rpvgrw - rwork[(*nrhs << 
00865                                         1) + 1], dabs(r__1)) / dmax(r__2,
00866                                         rpvgrw) / slamch_("E");
00867 
00868                                 if (! prefac) {
00869 
00870 /*                             Reconstruct matrix from factors and */
00871 /*                             compute residual. */
00872 
00873                                     cgbt01_(&n, &n, &kl, &ku, &a[1], &lda, &
00874                                             afb[1], &ldafb, &iwork[1], &work[
00875                                             1], result);
00876                                     k1 = 1;
00877                                 } else {
00878                                     k1 = 2;
00879                                 }
00880 
00881                                 if (info == 0) {
00882                                     trfcon = FALSE_;
00883 
00884 /*                             Compute residual of the computed solution. */
00885 
00886                                     clacpy_("Full", &n, nrhs, &bsav[1], &ldb, 
00887                                             &work[1], &ldb);
00888                                     cgbt02_(trans, &n, &n, &kl, &ku, nrhs, &
00889                                             asav[1], &lda, &x[1], &ldb, &work[
00890                                             1], &ldb, &result[1]);
00891 
00892 /*                             Check solution from generated exact */
00893 /*                             solution. */
00894 
00895                                     if (nofact || prefac && lsame_(equed, 
00896                                             "N")) {
00897                                         cget04_(&n, nrhs, &x[1], &ldb, &xact[
00898                                                 1], &ldb, &rcondc, &result[2])
00899                                                 ;
00900                                     } else {
00901                                         if (itran == 1) {
00902                                             roldc = roldo;
00903                                         } else {
00904                                             roldc = roldi;
00905                                         }
00906                                         cget04_(&n, nrhs, &x[1], &ldb, &xact[
00907                                                 1], &ldb, &roldc, &result[2]);
00908                                     }
00909 
00910 /*                             Check the error bounds from iterative */
00911 /*                             refinement. */
00912 
00913                                     cgbt05_(trans, &n, &kl, &ku, nrhs, &asav[
00914                                             1], &lda, &bsav[1], &ldb, &x[1], &
00915                                             ldb, &xact[1], &ldb, &rwork[1], &
00916                                             rwork[*nrhs + 1], &result[3]);
00917                                 } else {
00918                                     trfcon = TRUE_;
00919                                 }
00920 
00921 /*                          Compare RCOND from CGBSVX with the computed */
00922 /*                          value in RCONDC. */
00923 
00924                                 result[5] = sget06_(&rcond, &rcondc);
00925 
00926 /*                          Print information about the tests that did */
00927 /*                          not pass the threshold. */
00928 
00929                                 if (! trfcon) {
00930                                     for (k = k1; k <= 7; ++k) {
00931                                         if (result[k - 1] >= *thresh) {
00932                                             if (nfail == 0 && nerrs == 0) {
00933                           aladhd_(nout, path);
00934                                             }
00935                                             if (prefac) {
00936                           io___73.ciunit = *nout;
00937                           s_wsfe(&io___73);
00938                           do_fio(&c__1, "CGBSVX", (ftnlen)6);
00939                           do_fio(&c__1, fact, (ftnlen)1);
00940                           do_fio(&c__1, trans, (ftnlen)1);
00941                           do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
00942                           do_fio(&c__1, (char *)&kl, (ftnlen)sizeof(integer));
00943                           do_fio(&c__1, (char *)&ku, (ftnlen)sizeof(integer));
00944                           do_fio(&c__1, equed, (ftnlen)1);
00945                           do_fio(&c__1, (char *)&imat, (ftnlen)sizeof(integer)
00946                                   );
00947                           do_fio(&c__1, (char *)&k, (ftnlen)sizeof(integer));
00948                           do_fio(&c__1, (char *)&result[k - 1], (ftnlen)
00949                                   sizeof(real));
00950                           e_wsfe();
00951                                             } else {
00952                           io___74.ciunit = *nout;
00953                           s_wsfe(&io___74);
00954                           do_fio(&c__1, "CGBSVX", (ftnlen)6);
00955                           do_fio(&c__1, fact, (ftnlen)1);
00956                           do_fio(&c__1, trans, (ftnlen)1);
00957                           do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
00958                           do_fio(&c__1, (char *)&kl, (ftnlen)sizeof(integer));
00959                           do_fio(&c__1, (char *)&ku, (ftnlen)sizeof(integer));
00960                           do_fio(&c__1, (char *)&imat, (ftnlen)sizeof(integer)
00961                                   );
00962                           do_fio(&c__1, (char *)&k, (ftnlen)sizeof(integer));
00963                           do_fio(&c__1, (char *)&result[k - 1], (ftnlen)
00964                                   sizeof(real));
00965                           e_wsfe();
00966                                             }
00967                                             ++nfail;
00968                                         }
00969 /* L80: */
00970                                     }
00971                                     nrun = nrun + 7 - k1;
00972                                 } else {
00973                                     if (result[0] >= *thresh && ! prefac) {
00974                                         if (nfail == 0 && nerrs == 0) {
00975                                             aladhd_(nout, path);
00976                                         }
00977                                         if (prefac) {
00978                                             io___75.ciunit = *nout;
00979                                             s_wsfe(&io___75);
00980                                             do_fio(&c__1, "CGBSVX", (ftnlen)6)
00981                                                     ;
00982                                             do_fio(&c__1, fact, (ftnlen)1);
00983                                             do_fio(&c__1, trans, (ftnlen)1);
00984                                             do_fio(&c__1, (char *)&n, (ftnlen)
00985                                                     sizeof(integer));
00986                                             do_fio(&c__1, (char *)&kl, (
00987                                                     ftnlen)sizeof(integer));
00988                                             do_fio(&c__1, (char *)&ku, (
00989                                                     ftnlen)sizeof(integer));
00990                                             do_fio(&c__1, equed, (ftnlen)1);
00991                                             do_fio(&c__1, (char *)&imat, (
00992                                                     ftnlen)sizeof(integer));
00993                                             do_fio(&c__1, (char *)&c__1, (
00994                                                     ftnlen)sizeof(integer));
00995                                             do_fio(&c__1, (char *)&result[0], 
00996                                                     (ftnlen)sizeof(real));
00997                                             e_wsfe();
00998                                         } else {
00999                                             io___76.ciunit = *nout;
01000                                             s_wsfe(&io___76);
01001                                             do_fio(&c__1, "CGBSVX", (ftnlen)6)
01002                                                     ;
01003                                             do_fio(&c__1, fact, (ftnlen)1);
01004                                             do_fio(&c__1, trans, (ftnlen)1);
01005                                             do_fio(&c__1, (char *)&n, (ftnlen)
01006                                                     sizeof(integer));
01007                                             do_fio(&c__1, (char *)&kl, (
01008                                                     ftnlen)sizeof(integer));
01009                                             do_fio(&c__1, (char *)&ku, (
01010                                                     ftnlen)sizeof(integer));
01011                                             do_fio(&c__1, (char *)&imat, (
01012                                                     ftnlen)sizeof(integer));
01013                                             do_fio(&c__1, (char *)&c__1, (
01014                                                     ftnlen)sizeof(integer));
01015                                             do_fio(&c__1, (char *)&result[0], 
01016                                                     (ftnlen)sizeof(real));
01017                                             e_wsfe();
01018                                         }
01019                                         ++nfail;
01020                                         ++nrun;
01021                                     }
01022                                     if (result[5] >= *thresh) {
01023                                         if (nfail == 0 && nerrs == 0) {
01024                                             aladhd_(nout, path);
01025                                         }
01026                                         if (prefac) {
01027                                             io___77.ciunit = *nout;
01028                                             s_wsfe(&io___77);
01029                                             do_fio(&c__1, "CGBSVX", (ftnlen)6)
01030                                                     ;
01031                                             do_fio(&c__1, fact, (ftnlen)1);
01032                                             do_fio(&c__1, trans, (ftnlen)1);
01033                                             do_fio(&c__1, (char *)&n, (ftnlen)
01034                                                     sizeof(integer));
01035                                             do_fio(&c__1, (char *)&kl, (
01036                                                     ftnlen)sizeof(integer));
01037                                             do_fio(&c__1, (char *)&ku, (
01038                                                     ftnlen)sizeof(integer));
01039                                             do_fio(&c__1, equed, (ftnlen)1);
01040                                             do_fio(&c__1, (char *)&imat, (
01041                                                     ftnlen)sizeof(integer));
01042                                             do_fio(&c__1, (char *)&c__6, (
01043                                                     ftnlen)sizeof(integer));
01044                                             do_fio(&c__1, (char *)&result[5], 
01045                                                     (ftnlen)sizeof(real));
01046                                             e_wsfe();
01047                                         } else {
01048                                             io___78.ciunit = *nout;
01049                                             s_wsfe(&io___78);
01050                                             do_fio(&c__1, "CGBSVX", (ftnlen)6)
01051                                                     ;
01052                                             do_fio(&c__1, fact, (ftnlen)1);
01053                                             do_fio(&c__1, trans, (ftnlen)1);
01054                                             do_fio(&c__1, (char *)&n, (ftnlen)
01055                                                     sizeof(integer));
01056                                             do_fio(&c__1, (char *)&kl, (
01057                                                     ftnlen)sizeof(integer));
01058                                             do_fio(&c__1, (char *)&ku, (
01059                                                     ftnlen)sizeof(integer));
01060                                             do_fio(&c__1, (char *)&imat, (
01061                                                     ftnlen)sizeof(integer));
01062                                             do_fio(&c__1, (char *)&c__6, (
01063                                                     ftnlen)sizeof(integer));
01064                                             do_fio(&c__1, (char *)&result[5], 
01065                                                     (ftnlen)sizeof(real));
01066                                             e_wsfe();
01067                                         }
01068                                         ++nfail;
01069                                         ++nrun;
01070                                     }
01071                                     if (result[6] >= *thresh) {
01072                                         if (nfail == 0 && nerrs == 0) {
01073                                             aladhd_(nout, path);
01074                                         }
01075                                         if (prefac) {
01076                                             io___79.ciunit = *nout;
01077                                             s_wsfe(&io___79);
01078                                             do_fio(&c__1, "CGBSVX", (ftnlen)6)
01079                                                     ;
01080                                             do_fio(&c__1, fact, (ftnlen)1);
01081                                             do_fio(&c__1, trans, (ftnlen)1);
01082                                             do_fio(&c__1, (char *)&n, (ftnlen)
01083                                                     sizeof(integer));
01084                                             do_fio(&c__1, (char *)&kl, (
01085                                                     ftnlen)sizeof(integer));
01086                                             do_fio(&c__1, (char *)&ku, (
01087                                                     ftnlen)sizeof(integer));
01088                                             do_fio(&c__1, equed, (ftnlen)1);
01089                                             do_fio(&c__1, (char *)&imat, (
01090                                                     ftnlen)sizeof(integer));
01091                                             do_fio(&c__1, (char *)&c__7, (
01092                                                     ftnlen)sizeof(integer));
01093                                             do_fio(&c__1, (char *)&result[6], 
01094                                                     (ftnlen)sizeof(real));
01095                                             e_wsfe();
01096                                         } else {
01097                                             io___80.ciunit = *nout;
01098                                             s_wsfe(&io___80);
01099                                             do_fio(&c__1, "CGBSVX", (ftnlen)6)
01100                                                     ;
01101                                             do_fio(&c__1, fact, (ftnlen)1);
01102                                             do_fio(&c__1, trans, (ftnlen)1);
01103                                             do_fio(&c__1, (char *)&n, (ftnlen)
01104                                                     sizeof(integer));
01105                                             do_fio(&c__1, (char *)&kl, (
01106                                                     ftnlen)sizeof(integer));
01107                                             do_fio(&c__1, (char *)&ku, (
01108                                                     ftnlen)sizeof(integer));
01109                                             do_fio(&c__1, (char *)&imat, (
01110                                                     ftnlen)sizeof(integer));
01111                                             do_fio(&c__1, (char *)&c__7, (
01112                                                     ftnlen)sizeof(integer));
01113                                             do_fio(&c__1, (char *)&result[6], 
01114                                                     (ftnlen)sizeof(real));
01115                                             e_wsfe();
01116                                         }
01117                                         ++nfail;
01118                                         ++nrun;
01119                                     }
01120                                 }
01121 /*                    --- Test CGBSVXX --- */
01122 /*                    Restore the matrices A and B. */
01123 /*                     write(*,*) 'begin cgbsvxx testing' */
01124                                 i__8 = kl + ku + 1;
01125                                 clacpy_("Full", &i__8, &n, &asav[1], &lda, &a[
01126                                         1], &lda);
01127                                 clacpy_("Full", &n, nrhs, &bsav[1], &ldb, &b[
01128                                         1], &ldb);
01129                                 if (! prefac) {
01130                                     i__8 = (kl << 1) + ku + 1;
01131                                     claset_("Full", &i__8, &n, &c_b197, &
01132                                             c_b197, &afb[1], &ldafb);
01133                                 }
01134                                 claset_("Full", &n, nrhs, &c_b197, &c_b197, &
01135                                         x[1], &ldb);
01136                                 if (iequed > 1 && n > 0) {
01137 
01138 /*                       Equilibrate the matrix if FACT = 'F' and */
01139 /*                       EQUED = 'R', 'C', or 'B'. */
01140 
01141                                     claqgb_(&n, &n, &kl, &ku, &a[1], &lda, &s[
01142                                             1], &s[n + 1], &rowcnd, &colcnd, &
01143                                             amax, equed);
01144                                 }
01145 
01146 /*                    Solve the system and compute the condition number */
01147 /*                    and error bounds using CGBSVXX. */
01148 
01149                                 s_copy(srnamc_1.srnamt, "CGBSVXX", (ftnlen)32,
01150                                          (ftnlen)7);
01151                                 n_err_bnds__ = 3;
01152 
01153                                 salloc3();
01154 
01155                                 cgbsvxx_(fact, trans, &n, &kl, &ku, nrhs, &a[
01156                                         1], &lda, &afb[1], &ldafb, &iwork[1], 
01157                                         equed, &s[1], &s[n + 1], &b[1], &ldb, 
01158                                         &x[1], &ldb, &rcond, &rpvgrw_svxx__, 
01159                                         berr, &n_err_bnds__, errbnds_n__, 
01160                                         errbnds_c__, &c__0, &c_b197, &work[1], 
01161                                          &rwork[1], &info);
01162 
01163                                 free3();
01164 
01165 /*                    Check the error code from CGBSVXX. */
01166 
01167                                 if (info == n + 1) {
01168                                     goto L90;
01169                                 }
01170                                 if (info != izero) {
01171 /* Writing concatenation */
01172                                     i__11[0] = 1, a__1[0] = fact;
01173                                     i__11[1] = 1, a__1[1] = trans;
01174                                     s_cat(ch__1, a__1, i__11, &c__2, (ftnlen)
01175                                             2);
01176                                     alaerh_(path, "CGBSVXX", &info, &izero, 
01177                                             ch__1, &n, &n, &c_n1, &c_n1, nrhs, 
01178                                              &imat, &nfail, &nerrs, nout);
01179                                     goto L90;
01180                                 }
01181 
01182 /*                    Compare rpvgrw_svxx from CGESVXX with the computed */
01183 /*                    reciprocal pivot growth factor RPVGRW */
01184 
01185                                 if (info > 0 && info < n + 1) {
01186                                     rpvgrw = cla_gbrpvgrw__(&n, &kl, &ku, &
01187                                             info, &a[1], &lda, &afb[1], &
01188                                             ldafb);
01189                                 } else {
01190                                     rpvgrw = cla_gbrpvgrw__(&n, &kl, &ku, &n, 
01191                                             &a[1], &lda, &afb[1], &ldafb);
01192                                 }
01193                                 result[6] = (r__1 = rpvgrw - rpvgrw_svxx__, 
01194                                         dabs(r__1)) / dmax(rpvgrw_svxx__,
01195                                         rpvgrw) / slamch_("E");
01196 
01197                                 if (! prefac) {
01198 
01199 /*                       Reconstruct matrix from factors and compute */
01200 /*                       residual. */
01201 
01202                                     cgbt01_(&n, &n, &kl, &ku, &a[1], &lda, &
01203                                             afb[1], &ldafb, &iwork[1], &rwork[
01204                                             (*nrhs << 1) + 1], result);
01205                                     k1 = 1;
01206                                 } else {
01207                                     k1 = 2;
01208                                 }
01209 
01210                                 if (info == 0) {
01211                                     trfcon = FALSE_;
01212 
01213 /*                       Compute residual of the computed solution. */
01214 
01215                                     clacpy_("Full", &n, nrhs, &bsav[1], &ldb, 
01216                                             &work[1], &ldb);
01217                                     cgbt02_(trans, &n, &n, &kl, &ku, nrhs, &
01218                                             asav[1], &lda, &x[1], &ldb, &work[
01219                                             1], &ldb, &rwork[(*nrhs << 1) + 1]
01220 , &result[1]);
01221 
01222 /*                       Check solution from generated exact solution. */
01223 
01224                                     if (nofact || prefac && lsame_(equed, 
01225                                             "N")) {
01226                                         cget04_(&n, nrhs, &x[1], &ldb, &xact[
01227                                                 1], &ldb, &rcondc, &result[2])
01228                                                 ;
01229                                     } else {
01230                                         if (itran == 1) {
01231                                             roldc = roldo;
01232                                         } else {
01233                                             roldc = roldi;
01234                                         }
01235                                         cget04_(&n, nrhs, &x[1], &ldb, &xact[
01236                                                 1], &ldb, &roldc, &result[2]);
01237                                     }
01238                                 } else {
01239                                     trfcon = TRUE_;
01240                                 }
01241 
01242 /*                    Compare RCOND from CGBSVXX with the computed value */
01243 /*                    in RCONDC. */
01244 
01245                                 result[5] = sget06_(&rcond, &rcondc);
01246 
01247 /*                    Print information about the tests that did not pass */
01248 /*                    the threshold. */
01249 
01250                                 if (! trfcon) {
01251                                     for (k = k1; k <= 7; ++k) {
01252                                         if (result[k - 1] >= *thresh) {
01253                                             if (nfail == 0 && nerrs == 0) {
01254                           aladhd_(nout, path);
01255                                             }
01256                                             if (prefac) {
01257                           io___86.ciunit = *nout;
01258                           s_wsfe(&io___86);
01259                           do_fio(&c__1, "CGBSVXX", (ftnlen)7);
01260                           do_fio(&c__1, fact, (ftnlen)1);
01261                           do_fio(&c__1, trans, (ftnlen)1);
01262                           do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
01263                           do_fio(&c__1, (char *)&kl, (ftnlen)sizeof(integer));
01264                           do_fio(&c__1, (char *)&ku, (ftnlen)sizeof(integer));
01265                           do_fio(&c__1, equed, (ftnlen)1);
01266                           do_fio(&c__1, (char *)&imat, (ftnlen)sizeof(integer)
01267                                   );
01268                           do_fio(&c__1, (char *)&k, (ftnlen)sizeof(integer));
01269                           do_fio(&c__1, (char *)&result[k - 1], (ftnlen)
01270                                   sizeof(real));
01271                           e_wsfe();
01272                                             } else {
01273                           io___87.ciunit = *nout;
01274                           s_wsfe(&io___87);
01275                           do_fio(&c__1, "CGBSVXX", (ftnlen)7);
01276                           do_fio(&c__1, fact, (ftnlen)1);
01277                           do_fio(&c__1, trans, (ftnlen)1);
01278                           do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
01279                           do_fio(&c__1, (char *)&kl, (ftnlen)sizeof(integer));
01280                           do_fio(&c__1, (char *)&ku, (ftnlen)sizeof(integer));
01281                           do_fio(&c__1, (char *)&imat, (ftnlen)sizeof(integer)
01282                                   );
01283                           do_fio(&c__1, (char *)&k, (ftnlen)sizeof(integer));
01284                           do_fio(&c__1, (char *)&result[k - 1], (ftnlen)
01285                                   sizeof(real));
01286                           e_wsfe();
01287                                             }
01288                                             ++nfail;
01289                                         }
01290 /* L45: */
01291                                     }
01292                                     nrun = nrun + 7 - k1;
01293                                 } else {
01294                                     if (result[0] >= *thresh && ! prefac) {
01295                                         if (nfail == 0 && nerrs == 0) {
01296                                             aladhd_(nout, path);
01297                                         }
01298                                         if (prefac) {
01299                                             io___88.ciunit = *nout;
01300                                             s_wsfe(&io___88);
01301                                             do_fio(&c__1, "CGBSVXX", (ftnlen)
01302                                                     7);
01303                                             do_fio(&c__1, fact, (ftnlen)1);
01304                                             do_fio(&c__1, trans, (ftnlen)1);
01305                                             do_fio(&c__1, (char *)&n, (ftnlen)
01306                                                     sizeof(integer));
01307                                             do_fio(&c__1, (char *)&kl, (
01308                                                     ftnlen)sizeof(integer));
01309                                             do_fio(&c__1, (char *)&ku, (
01310                                                     ftnlen)sizeof(integer));
01311                                             do_fio(&c__1, equed, (ftnlen)1);
01312                                             do_fio(&c__1, (char *)&imat, (
01313                                                     ftnlen)sizeof(integer));
01314                                             do_fio(&c__1, (char *)&c__1, (
01315                                                     ftnlen)sizeof(integer));
01316                                             do_fio(&c__1, (char *)&result[0], 
01317                                                     (ftnlen)sizeof(real));
01318                                             e_wsfe();
01319                                         } else {
01320                                             io___89.ciunit = *nout;
01321                                             s_wsfe(&io___89);
01322                                             do_fio(&c__1, "CGBSVXX", (ftnlen)
01323                                                     7);
01324                                             do_fio(&c__1, fact, (ftnlen)1);
01325                                             do_fio(&c__1, trans, (ftnlen)1);
01326                                             do_fio(&c__1, (char *)&n, (ftnlen)
01327                                                     sizeof(integer));
01328                                             do_fio(&c__1, (char *)&kl, (
01329                                                     ftnlen)sizeof(integer));
01330                                             do_fio(&c__1, (char *)&ku, (
01331                                                     ftnlen)sizeof(integer));
01332                                             do_fio(&c__1, (char *)&imat, (
01333                                                     ftnlen)sizeof(integer));
01334                                             do_fio(&c__1, (char *)&c__1, (
01335                                                     ftnlen)sizeof(integer));
01336                                             do_fio(&c__1, (char *)&result[0], 
01337                                                     (ftnlen)sizeof(real));
01338                                             e_wsfe();
01339                                         }
01340                                         ++nfail;
01341                                         ++nrun;
01342                                     }
01343                                     if (result[5] >= *thresh) {
01344                                         if (nfail == 0 && nerrs == 0) {
01345                                             aladhd_(nout, path);
01346                                         }
01347                                         if (prefac) {
01348                                             io___90.ciunit = *nout;
01349                                             s_wsfe(&io___90);
01350                                             do_fio(&c__1, "CGBSVXX", (ftnlen)
01351                                                     7);
01352                                             do_fio(&c__1, fact, (ftnlen)1);
01353                                             do_fio(&c__1, trans, (ftnlen)1);
01354                                             do_fio(&c__1, (char *)&n, (ftnlen)
01355                                                     sizeof(integer));
01356                                             do_fio(&c__1, (char *)&kl, (
01357                                                     ftnlen)sizeof(integer));
01358                                             do_fio(&c__1, (char *)&ku, (
01359                                                     ftnlen)sizeof(integer));
01360                                             do_fio(&c__1, equed, (ftnlen)1);
01361                                             do_fio(&c__1, (char *)&imat, (
01362                                                     ftnlen)sizeof(integer));
01363                                             do_fio(&c__1, (char *)&c__6, (
01364                                                     ftnlen)sizeof(integer));
01365                                             do_fio(&c__1, (char *)&result[5], 
01366                                                     (ftnlen)sizeof(real));
01367                                             e_wsfe();
01368                                         } else {
01369                                             io___91.ciunit = *nout;
01370                                             s_wsfe(&io___91);
01371                                             do_fio(&c__1, "CGBSVXX", (ftnlen)
01372                                                     7);
01373                                             do_fio(&c__1, fact, (ftnlen)1);
01374                                             do_fio(&c__1, trans, (ftnlen)1);
01375                                             do_fio(&c__1, (char *)&n, (ftnlen)
01376                                                     sizeof(integer));
01377                                             do_fio(&c__1, (char *)&kl, (
01378                                                     ftnlen)sizeof(integer));
01379                                             do_fio(&c__1, (char *)&ku, (
01380                                                     ftnlen)sizeof(integer));
01381                                             do_fio(&c__1, (char *)&imat, (
01382                                                     ftnlen)sizeof(integer));
01383                                             do_fio(&c__1, (char *)&c__6, (
01384                                                     ftnlen)sizeof(integer));
01385                                             do_fio(&c__1, (char *)&result[5], 
01386                                                     (ftnlen)sizeof(real));
01387                                             e_wsfe();
01388                                         }
01389                                         ++nfail;
01390                                         ++nrun;
01391                                     }
01392                                     if (result[6] >= *thresh) {
01393                                         if (nfail == 0 && nerrs == 0) {
01394                                             aladhd_(nout, path);
01395                                         }
01396                                         if (prefac) {
01397                                             io___92.ciunit = *nout;
01398                                             s_wsfe(&io___92);
01399                                             do_fio(&c__1, "CGBSVXX", (ftnlen)
01400                                                     7);
01401                                             do_fio(&c__1, fact, (ftnlen)1);
01402                                             do_fio(&c__1, trans, (ftnlen)1);
01403                                             do_fio(&c__1, (char *)&n, (ftnlen)
01404                                                     sizeof(integer));
01405                                             do_fio(&c__1, (char *)&kl, (
01406                                                     ftnlen)sizeof(integer));
01407                                             do_fio(&c__1, (char *)&ku, (
01408                                                     ftnlen)sizeof(integer));
01409                                             do_fio(&c__1, equed, (ftnlen)1);
01410                                             do_fio(&c__1, (char *)&imat, (
01411                                                     ftnlen)sizeof(integer));
01412                                             do_fio(&c__1, (char *)&c__7, (
01413                                                     ftnlen)sizeof(integer));
01414                                             do_fio(&c__1, (char *)&result[6], 
01415                                                     (ftnlen)sizeof(real));
01416                                             e_wsfe();
01417                                         } else {
01418                                             io___93.ciunit = *nout;
01419                                             s_wsfe(&io___93);
01420                                             do_fio(&c__1, "CGBSVXX", (ftnlen)
01421                                                     7);
01422                                             do_fio(&c__1, fact, (ftnlen)1);
01423                                             do_fio(&c__1, trans, (ftnlen)1);
01424                                             do_fio(&c__1, (char *)&n, (ftnlen)
01425                                                     sizeof(integer));
01426                                             do_fio(&c__1, (char *)&kl, (
01427                                                     ftnlen)sizeof(integer));
01428                                             do_fio(&c__1, (char *)&ku, (
01429                                                     ftnlen)sizeof(integer));
01430                                             do_fio(&c__1, (char *)&imat, (
01431                                                     ftnlen)sizeof(integer));
01432                                             do_fio(&c__1, (char *)&c__7, (
01433                                                     ftnlen)sizeof(integer));
01434                                             do_fio(&c__1, (char *)&result[6], 
01435                                                     (ftnlen)sizeof(real));
01436                                             e_wsfe();
01437                                         }
01438                                         ++nfail;
01439                                         ++nrun;
01440                                     }
01441 
01442                                 }
01443 
01444 L90:
01445                                 ;
01446                             }
01447 L100:
01448                             ;
01449                         }
01450 /* L110: */
01451                     }
01452 L120:
01453                     ;
01454                 }
01455 L130:
01456                 ;
01457             }
01458 /* L140: */
01459         }
01460 /* L150: */
01461     }
01462 
01463 /*     Print a summary of the results. */
01464 
01465     alasvm_(path, nout, &nfail, &nrun, &nerrs);
01466 
01467 /*     Test Error Bounds from CGBSVXX */
01468     cebchvxx_(thresh, path);
01469 
01470     return 0;
01471 
01472 /*     End of CDRVGB */
01473 
01474 } /* cdrvgb_ */


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