sdrvgbx.c
Go to the documentation of this file.
00001 /* sdrvgbx.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 real c_b48 = 0.f;
00038 static real c_b49 = 1.f;
00039 static integer c__6 = 6;
00040 static integer c__7 = 7;
00041 
00042 /* Subroutine */ int sdrvgb_(logical *dotype, integer *nn, integer *nval, 
00043         integer *nrhs, real *thresh, logical *tsterr, real *a, integer *la, 
00044         real *afb, integer *lafb, real *asav, real *b, real *bsav, real *x, 
00045         real *xact, real *s, real *work, real *rwork, integer *iwork, integer 
00046         *nout)
00047 {
00048     /* Initialized data */
00049 
00050     static integer iseedy[4] = { 1988,1989,1990,1991 };
00051     static char transs[1*3] = "N" "T" "C";
00052     static char facts[1*3] = "F" "N" "E";
00053     static char equeds[1*4] = "N" "R" "C" "B";
00054 
00055     /* Format strings */
00056     static char fmt_9999[] = "(\002 *** In SDRVGB, LA=\002,i5,\002 is too sm"
00057             "all for N=\002,i5,\002, KU=\002,i5,\002, KL=\002,i5,/\002 ==> In"
00058             "crease LA to at least \002,i5)";
00059     static char fmt_9998[] = "(\002 *** In SDRVGB, LAFB=\002,i5,\002 is too "
00060             "small for N=\002,i5,\002, KU=\002,i5,\002, KL=\002,i5,/\002 ==> "
00061             "Increase LAFB to at least \002,i5)";
00062     static char fmt_9997[] = "(1x,a,\002, N=\002,i5,\002, KL=\002,i5,\002, K"
00063             "U=\002,i5,\002, type \002,i1,\002, test(\002,i1,\002)=\002,g12.5)"
00064             ;
00065     static char fmt_9995[] = "(1x,a,\002( '\002,a1,\002','\002,a1,\002',\002"
00066             ",i5,\002,\002,i5,\002,\002,i5,\002,...), EQUED='\002,a1,\002', t"
00067             "ype \002,i1,\002, test(\002,i1,\002)=\002,g12.5)";
00068     static char fmt_9996[] = "(1x,a,\002( '\002,a1,\002','\002,a1,\002',\002"
00069             ",i5,\002,\002,i5,\002,\002,i5,\002,...), type \002,i1,\002, test("
00070             "\002,i1,\002)=\002,g12.5)";
00071 
00072     /* System generated locals */
00073     address a__1[2];
00074     integer i__1, i__2, i__3, i__4, i__5, i__6, i__7, i__8, i__9, i__10, 
00075             i__11[2];
00076     real r__1, r__2, r__3;
00077     char ch__1[2];
00078 
00079     /* Builtin functions */
00080     /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
00081     integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void);
00082     /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
00083 
00084     /* Local variables */
00085     extern /* Subroutine */ int sebchvxx_(real *, char *);
00086     integer i__, j, k, n;
00087     real *errbnds_c__;
00088     integer i1, i2, k1;
00089     real *errbnds_n__;
00090     integer nb, in, kl, ku, nt, n_err_bnds__, lda, ldb, ikl, nkl, iku, nku;
00091     char fact[1];
00092     integer ioff, mode;
00093     real amax;
00094     char path[3];
00095     integer imat, info;
00096     real *berr;
00097     char dist[1];
00098     real rpvgrw_svxx__;
00099     char type__[1];
00100     integer nrun;
00101     extern doublereal sla_gbrpvgrw__(integer *, integer *, integer *, integer 
00102             *, real *, integer *, real *, integer *);
00103     integer ldafb, ifact, nfail, iseed[4], nfact;
00104     extern logical lsame_(char *, char *);
00105     extern /* Subroutine */ int sgbt01_(integer *, integer *, integer *, 
00106             integer *, real *, integer *, real *, integer *, integer *, real *
00107 , real *);
00108     char equed[1];
00109     integer nbmin;
00110     real rcond, roldc;
00111     extern /* Subroutine */ int sgbt02_(char *, integer *, integer *, integer 
00112             *, integer *, integer *, real *, integer *, real *, integer *, 
00113             real *, integer *, real *);
00114     integer nimat;
00115     real roldi;
00116     extern doublereal sget06_(real *, real *);
00117     extern /* Subroutine */ int sgbt05_(char *, integer *, integer *, integer 
00118             *, integer *, real *, integer *, real *, integer *, real *, 
00119             integer *, real *, integer *, real *, real *, real *);
00120     real anorm;
00121     integer itran;
00122     extern /* Subroutine */ int sget04_(integer *, integer *, real *, integer 
00123             *, real *, integer *, real *, real *);
00124     logical equil;
00125     real roldo;
00126     extern /* Subroutine */ int sgbsv_(integer *, integer *, integer *, 
00127             integer *, real *, integer *, integer *, real *, integer *, 
00128             integer *);
00129     char trans[1];
00130     integer izero, nerrs;
00131     logical zerot;
00132     char xtype[1];
00133     extern /* Subroutine */ int slatb4_(char *, integer *, integer *, integer 
00134             *, char *, integer *, integer *, real *, integer *, real *, char *
00135 ), aladhd_(integer *, char *), 
00136             alaerh_(char *, char *, integer *, integer *, char *, integer *, 
00137             integer *, integer *, integer *, integer *, integer *, integer *, 
00138             integer *, integer *);
00139     logical prefac;
00140     real colcnd;
00141     extern doublereal slangb_(char *, integer *, integer *, integer *, real *, 
00142              integer *, real *), slamch_(char *);
00143     real rcondc;
00144     extern doublereal slange_(char *, integer *, integer *, real *, integer *, 
00145              real *);
00146     logical nofact;
00147     extern /* Subroutine */ int slaqgb_(integer *, integer *, integer *, 
00148             integer *, real *, integer *, real *, real *, real *, real *, 
00149             real *, char *);
00150     integer iequed;
00151     real rcondi;
00152     extern doublereal slantb_(char *, char *, char *, integer *, integer *, 
00153             real *, integer *, real *);
00154     real cndnum, anormi, rcondo, ainvnm;
00155     extern /* Subroutine */ int alasvm_(char *, integer *, integer *, integer 
00156             *, integer *);
00157     logical trfcon;
00158     real anormo, rowcnd;
00159     extern /* Subroutine */ int sgbequ_(integer *, integer *, integer *, 
00160             integer *, real *, integer *, real *, real *, real *, real *, 
00161             real *, integer *), sgbtrf_(integer *, integer *, integer *, 
00162             integer *, real *, integer *, integer *, integer *), slacpy_(char 
00163             *, integer *, integer *, real *, integer *, real *, integer *), slarhs_(char *, char *, char *, char *, integer *, 
00164             integer *, integer *, integer *, integer *, real *, integer *, 
00165             real *, integer *, real *, integer *, integer *, integer *);
00166     real anrmpv;
00167     extern /* Subroutine */ int sgbtrs_(char *, integer *, integer *, integer 
00168             *, integer *, real *, integer *, integer *, real *, integer *, 
00169             integer *), slaset_(char *, integer *, integer *, real *, 
00170             real *, real *, integer *), slatms_(integer *, integer *, 
00171             char *, integer *, char *, real *, integer *, real *, real *, 
00172             integer *, integer *, char *, real *, integer *, real *, integer *
00173 ), xlaenv_(integer *, integer *), sgbsvx_(
00174             char *, char *, integer *, integer *, integer *, integer *, real *
00175 , integer *, real *, integer *, integer *, char *, real *, real *, 
00176              real *, integer *, real *, integer *, real *, real *, real *, 
00177             real *, integer *, integer *);
00178     real result[7], rpvgrw;
00179     extern /* Subroutine */ int serrvx_(char *, integer *), sgbsvxx_(
00180             char *, char *, integer *, integer *, integer *, integer *, real *
00181 , integer *, real *, integer *, integer *, char *, real *, real *, 
00182              real *, integer *, real *, integer *, real *, real *, real *, 
00183             integer *, real *, real *, integer *, real *, real *, integer *, 
00184             integer *);
00185 
00186     /* Fortran I/O blocks */
00187     static cilist io___26 = { 0, 0, 0, fmt_9999, 0 };
00188     static cilist io___27 = { 0, 0, 0, fmt_9998, 0 };
00189     static cilist io___65 = { 0, 0, 0, fmt_9997, 0 };
00190     static cilist io___72 = { 0, 0, 0, fmt_9995, 0 };
00191     static cilist io___73 = { 0, 0, 0, fmt_9996, 0 };
00192     static cilist io___74 = { 0, 0, 0, fmt_9995, 0 };
00193     static cilist io___75 = { 0, 0, 0, fmt_9996, 0 };
00194     static cilist io___76 = { 0, 0, 0, fmt_9995, 0 };
00195     static cilist io___77 = { 0, 0, 0, fmt_9996, 0 };
00196     static cilist io___78 = { 0, 0, 0, fmt_9995, 0 };
00197     static cilist io___79 = { 0, 0, 0, fmt_9996, 0 };
00198     static cilist io___85 = { 0, 0, 0, fmt_9997, 0 };
00199     static cilist io___86 = { 0, 0, 0, fmt_9998, 0 };
00200     static cilist io___87 = { 0, 0, 0, fmt_9997, 0 };
00201     static cilist io___88 = { 0, 0, 0, fmt_9998, 0 };
00202     static cilist io___89 = { 0, 0, 0, fmt_9997, 0 };
00203     static cilist io___90 = { 0, 0, 0, fmt_9998, 0 };
00204     static cilist io___91 = { 0, 0, 0, fmt_9997, 0 };
00205     static cilist io___92 = { 0, 0, 0, fmt_9998, 0 };
00206 
00207 
00208 
00209 /*  -- LAPACK test routine (version 3.1) -- */
00210 /*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
00211 /*     November 2006 */
00212 
00213 /*     .. Scalar Arguments .. */
00214 /*     .. */
00215 /*     .. Array Arguments .. */
00216 /*     .. */
00217 
00218 /*  Purpose */
00219 /*  ======= */
00220 
00221 /*  SDRVGB tests the driver routines SGBSV and -SVX. */
00222 
00223 /*  Arguments */
00224 /*  ========= */
00225 
00226 /*  DOTYPE  (input) LOGICAL array, dimension (NTYPES) */
00227 /*          The matrix types to be used for testing.  Matrices of type j */
00228 /*          (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) = */
00229 /*          .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used. */
00230 
00231 /*  NN      (input) INTEGER */
00232 /*          The number of values of N contained in the vector NVAL. */
00233 
00234 /*  NVAL    (input) INTEGER array, dimension (NN) */
00235 /*          The values of the matrix column dimension N. */
00236 
00237 /*  NRHS    (input) INTEGER */
00238 /*          The number of right hand side vectors to be generated for */
00239 /*          each linear system. */
00240 
00241 /*  THRESH  (input) REAL */
00242 /*          The threshold value for the test ratios.  A result is */
00243 /*          included in the output file if RESULT >= THRESH.  To have */
00244 /*          every test ratio printed, use THRESH = 0. */
00245 
00246 /*  TSTERR  (input) LOGICAL */
00247 /*          Flag that indicates whether error exits are to be tested. */
00248 
00249 /*  A       (workspace) REAL array, dimension (LA) */
00250 
00251 /*  LA      (input) INTEGER */
00252 /*          The length of the array A.  LA >= (2*NMAX-1)*NMAX */
00253 /*          where NMAX is the largest entry in NVAL. */
00254 
00255 /*  AFB     (workspace) REAL array, dimension (LAFB) */
00256 
00257 /*  LAFB    (input) INTEGER */
00258 /*          The length of the array AFB.  LAFB >= (3*NMAX-2)*NMAX */
00259 /*          where NMAX is the largest entry in NVAL. */
00260 
00261 /*  ASAV    (workspace) REAL array, dimension (LA) */
00262 
00263 /*  B       (workspace) REAL array, dimension (NMAX*NRHS) */
00264 
00265 /*  BSAV    (workspace) REAL array, dimension (NMAX*NRHS) */
00266 
00267 /*  X       (workspace) REAL array, dimension (NMAX*NRHS) */
00268 
00269 /*  XACT    (workspace) REAL array, dimension (NMAX*NRHS) */
00270 
00271 /*  S       (workspace) REAL array, dimension (2*NMAX) */
00272 
00273 /*  WORK    (workspace) REAL array, dimension */
00274 /*                      (NMAX*max(3,NRHS,NMAX)) */
00275 
00276 /*  RWORK   (workspace) REAL array, dimension */
00277 /*                      (max(NMAX,2*NRHS)) */
00278 
00279 /*  IWORK   (workspace) INTEGER array, dimension (2*NMAX) */
00280 
00281 /*  NOUT    (input) INTEGER */
00282 /*          The unit number for output. */
00283 
00284 /*  ===================================================================== */
00285 
00286 /*     .. Parameters .. */
00287 /*     .. */
00288 /*     .. Local Scalars .. */
00289 /*     .. */
00290 /*     .. Local Arrays .. */
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, "Single precision", (ftnlen)1, (ftnlen)16);
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         serrvx_(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 SLATB4 and generate a */
00461 /*                 test matrix with SLATMS. */
00462 
00463                     slatb4_(path, &imat, &n, &n, type__, &kl, &ku, &anorm, &
00464                             mode, &cndnum, dist);
00465                     rcondc = 1.f / cndnum;
00466 
00467                     s_copy(srnamc_1.srnamt, "SLATMS", (ftnlen)32, (ftnlen)6);
00468                     slatms_(&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 SLATMS. */
00473 
00474                     if (info != 0) {
00475                         alaerh_(path, "SLATMS", &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                                 a[ioff + i__] = 0.f;
00503 /* L20: */
00504                             }
00505                         } else {
00506                             i__5 = n;
00507                             for (j = izero; j <= i__5; ++j) {
00508 /* Computing MAX */
00509                                 i__6 = 1, i__7 = ku + 2 - j;
00510 /* Computing MIN */
00511                                 i__9 = kl + ku + 1, i__10 = ku + 1 + (n - j);
00512                                 i__8 = min(i__9,i__10);
00513                                 for (i__ = max(i__6,i__7); i__ <= i__8; ++i__)
00514                                          {
00515                                     a[ioff + i__] = 0.f;
00516 /* L30: */
00517                                 }
00518                                 ioff += lda;
00519 /* L40: */
00520                             }
00521                         }
00522                     }
00523 
00524 /*                 Save a copy of the matrix A in ASAV. */
00525 
00526                     i__5 = kl + ku + 1;
00527                     slacpy_("Full", &i__5, &n, &a[1], &lda, &asav[1], &lda);
00528 
00529                     for (iequed = 1; iequed <= 4; ++iequed) {
00530                         *(unsigned char *)equed = *(unsigned char *)&equeds[
00531                                 iequed - 1];
00532                         if (iequed == 1) {
00533                             nfact = 3;
00534                         } else {
00535                             nfact = 1;
00536                         }
00537 
00538                         i__5 = nfact;
00539                         for (ifact = 1; ifact <= i__5; ++ifact) {
00540                             *(unsigned char *)fact = *(unsigned char *)&facts[
00541                                     ifact - 1];
00542                             prefac = lsame_(fact, "F");
00543                             nofact = lsame_(fact, "N");
00544                             equil = lsame_(fact, "E");
00545 
00546                             if (zerot) {
00547                                 if (prefac) {
00548                                     goto L100;
00549                                 }
00550                                 rcondo = 0.f;
00551                                 rcondi = 0.f;
00552 
00553                             } else if (! nofact) {
00554 
00555 /*                          Compute the condition number for comparison */
00556 /*                          with the value returned by SGESVX (FACT = */
00557 /*                          'N' reuses the condition number from the */
00558 /*                          previous iteration with FACT = 'F'). */
00559 
00560                                 i__8 = kl + ku + 1;
00561                                 slacpy_("Full", &i__8, &n, &asav[1], &lda, &
00562                                         afb[kl + 1], &ldafb);
00563                                 if (equil || iequed > 1) {
00564 
00565 /*                             Compute row and column scale factors to */
00566 /*                             equilibrate the matrix A. */
00567 
00568                                     sgbequ_(&n, &n, &kl, &ku, &afb[kl + 1], &
00569                                             ldafb, &s[1], &s[n + 1], &rowcnd, 
00570                                             &colcnd, &amax, &info);
00571                                     if (info == 0 && n > 0) {
00572                                         if (lsame_(equed, "R")) {
00573                                             rowcnd = 0.f;
00574                                             colcnd = 1.f;
00575                                         } else if (lsame_(equed, "C")) {
00576                                             rowcnd = 1.f;
00577                                             colcnd = 0.f;
00578                                         } else if (lsame_(equed, "B")) {
00579                                             rowcnd = 0.f;
00580                                             colcnd = 0.f;
00581                                         }
00582 
00583 /*                                Equilibrate the matrix. */
00584 
00585                                         slaqgb_(&n, &n, &kl, &ku, &afb[kl + 1]
00586 , &ldafb, &s[1], &s[n + 1], &
00587                                                 rowcnd, &colcnd, &amax, equed);
00588                                     }
00589                                 }
00590 
00591 /*                          Save the condition number of the */
00592 /*                          non-equilibrated system for use in SGET04. */
00593 
00594                                 if (equil) {
00595                                     roldo = rcondo;
00596                                     roldi = rcondi;
00597                                 }
00598 
00599 /*                          Compute the 1-norm and infinity-norm of A. */
00600 
00601                                 anormo = slangb_("1", &n, &kl, &ku, &afb[kl + 
00602                                         1], &ldafb, &rwork[1]);
00603                                 anormi = slangb_("I", &n, &kl, &ku, &afb[kl + 
00604                                         1], &ldafb, &rwork[1]);
00605 
00606 /*                          Factor the matrix A. */
00607 
00608                                 sgbtrf_(&n, &n, &kl, &ku, &afb[1], &ldafb, &
00609                                         iwork[1], &info);
00610 
00611 /*                          Form the inverse of A. */
00612 
00613                                 slaset_("Full", &n, &n, &c_b48, &c_b49, &work[
00614                                         1], &ldb);
00615                                 s_copy(srnamc_1.srnamt, "SGBTRS", (ftnlen)32, 
00616                                         (ftnlen)6);
00617                                 sgbtrs_("No transpose", &n, &kl, &ku, &n, &
00618                                         afb[1], &ldafb, &iwork[1], &work[1], &
00619                                         ldb, &info);
00620 
00621 /*                          Compute the 1-norm condition number of A. */
00622 
00623                                 ainvnm = slange_("1", &n, &n, &work[1], &ldb, 
00624                                         &rwork[1]);
00625                                 if (anormo <= 0.f || ainvnm <= 0.f) {
00626                                     rcondo = 1.f;
00627                                 } else {
00628                                     rcondo = 1.f / anormo / ainvnm;
00629                                 }
00630 
00631 /*                          Compute the infinity-norm condition number */
00632 /*                          of A. */
00633 
00634                                 ainvnm = slange_("I", &n, &n, &work[1], &ldb, 
00635                                         &rwork[1]);
00636                                 if (anormi <= 0.f || ainvnm <= 0.f) {
00637                                     rcondi = 1.f;
00638                                 } else {
00639                                     rcondi = 1.f / anormi / ainvnm;
00640                                 }
00641                             }
00642 
00643                             for (itran = 1; itran <= 3; ++itran) {
00644 
00645 /*                          Do for each value of TRANS. */
00646 
00647                                 *(unsigned char *)trans = *(unsigned char *)&
00648                                         transs[itran - 1];
00649                                 if (itran == 1) {
00650                                     rcondc = rcondo;
00651                                 } else {
00652                                     rcondc = rcondi;
00653                                 }
00654 
00655 /*                          Restore the matrix A. */
00656 
00657                                 i__8 = kl + ku + 1;
00658                                 slacpy_("Full", &i__8, &n, &asav[1], &lda, &a[
00659                                         1], &lda);
00660 
00661 /*                          Form an exact solution and set the right hand */
00662 /*                          side. */
00663 
00664                                 s_copy(srnamc_1.srnamt, "SLARHS", (ftnlen)32, 
00665                                         (ftnlen)6);
00666                                 slarhs_(path, xtype, "Full", trans, &n, &n, &
00667                                         kl, &ku, nrhs, &a[1], &lda, &xact[1], 
00668                                         &ldb, &b[1], &ldb, iseed, &info);
00669                                 *(unsigned char *)xtype = 'C';
00670                                 slacpy_("Full", &n, nrhs, &b[1], &ldb, &bsav[
00671                                         1], &ldb);
00672 
00673                                 if (nofact && itran == 1) {
00674 
00675 /*                             --- Test SGBSV  --- */
00676 
00677 /*                             Compute the LU factorization of the matrix */
00678 /*                             and solve the system. */
00679 
00680                                     i__8 = kl + ku + 1;
00681                                     slacpy_("Full", &i__8, &n, &a[1], &lda, &
00682                                             afb[kl + 1], &ldafb);
00683                                     slacpy_("Full", &n, nrhs, &b[1], &ldb, &x[
00684                                             1], &ldb);
00685 
00686                                     s_copy(srnamc_1.srnamt, "SGBSV ", (ftnlen)
00687                                             32, (ftnlen)6);
00688                                     sgbsv_(&n, &kl, &ku, nrhs, &afb[1], &
00689                                             ldafb, &iwork[1], &x[1], &ldb, &
00690                                             info);
00691 
00692 /*                             Check error code from SGBSV . */
00693 
00694                                     if (info == n + 1) {
00695                                         goto L90;
00696                                     }
00697                                     if (info != izero) {
00698                                         alaerh_(path, "SGBSV ", &info, &izero, 
00699                                                  " ", &n, &n, &kl, &ku, nrhs, 
00700                                                 &imat, &nfail, &nerrs, nout);
00701                                         goto L90;
00702                                     }
00703 
00704 /*                             Reconstruct matrix from factors and */
00705 /*                             compute residual. */
00706 
00707                                     sgbt01_(&n, &n, &kl, &ku, &a[1], &lda, &
00708                                             afb[1], &ldafb, &iwork[1], &work[
00709                                             1], result);
00710                                     nt = 1;
00711                                     if (izero == 0) {
00712 
00713 /*                                Compute residual of the computed */
00714 /*                                solution. */
00715 
00716                                         slacpy_("Full", &n, nrhs, &b[1], &ldb, 
00717                                                  &work[1], &ldb);
00718                                         sgbt02_("No transpose", &n, &n, &kl, &
00719                                                 ku, nrhs, &a[1], &lda, &x[1], 
00720                                                 &ldb, &work[1], &ldb, &result[
00721                                                 1]);
00722 
00723 /*                                Check solution from generated exact */
00724 /*                                solution. */
00725 
00726                                         sget04_(&n, nrhs, &x[1], &ldb, &xact[
00727                                                 1], &ldb, &rcondc, &result[2])
00728                                                 ;
00729                                         nt = 3;
00730                                     }
00731 
00732 /*                             Print information about the tests that did */
00733 /*                             not pass the threshold. */
00734 
00735                                     i__8 = nt;
00736                                     for (k = 1; k <= i__8; ++k) {
00737                                         if (result[k - 1] >= *thresh) {
00738                                             if (nfail == 0 && nerrs == 0) {
00739                           aladhd_(nout, path);
00740                                             }
00741                                             io___65.ciunit = *nout;
00742                                             s_wsfe(&io___65);
00743                                             do_fio(&c__1, "SGBSV ", (ftnlen)6)
00744                                                     ;
00745                                             do_fio(&c__1, (char *)&n, (ftnlen)
00746                                                     sizeof(integer));
00747                                             do_fio(&c__1, (char *)&kl, (
00748                                                     ftnlen)sizeof(integer));
00749                                             do_fio(&c__1, (char *)&ku, (
00750                                                     ftnlen)sizeof(integer));
00751                                             do_fio(&c__1, (char *)&imat, (
00752                                                     ftnlen)sizeof(integer));
00753                                             do_fio(&c__1, (char *)&k, (ftnlen)
00754                                                     sizeof(integer));
00755                                             do_fio(&c__1, (char *)&result[k - 
00756                                                     1], (ftnlen)sizeof(real));
00757                                             e_wsfe();
00758                                             ++nfail;
00759                                         }
00760 /* L50: */
00761                                     }
00762                                     nrun += nt;
00763                                 }
00764 
00765 /*                          --- Test SGBSVX --- */
00766 
00767                                 if (! prefac) {
00768                                     i__8 = (kl << 1) + ku + 1;
00769                                     slaset_("Full", &i__8, &n, &c_b48, &c_b48, 
00770                                              &afb[1], &ldafb);
00771                                 }
00772                                 slaset_("Full", &n, nrhs, &c_b48, &c_b48, &x[
00773                                         1], &ldb);
00774                                 if (iequed > 1 && n > 0) {
00775 
00776 /*                             Equilibrate the matrix if FACT = 'F' and */
00777 /*                             EQUED = 'R', 'C', or 'B'. */
00778 
00779                                     slaqgb_(&n, &n, &kl, &ku, &a[1], &lda, &s[
00780                                             1], &s[n + 1], &rowcnd, &colcnd, &
00781                                             amax, equed);
00782                                 }
00783 
00784 /*                          Solve the system and compute the condition */
00785 /*                          number and error bounds using SGBSVX. */
00786 
00787                                 s_copy(srnamc_1.srnamt, "SGBSVX", (ftnlen)32, 
00788                                         (ftnlen)6);
00789                                 sgbsvx_(fact, trans, &n, &kl, &ku, nrhs, &a[1]
00790 , &lda, &afb[1], &ldafb, &iwork[1], 
00791                                         equed, &s[1], &s[n + 1], &b[1], &ldb, 
00792                                         &x[1], &ldb, &rcond, &rwork[1], &
00793                                         rwork[*nrhs + 1], &work[1], &iwork[n 
00794                                         + 1], &info);
00795 
00796 /*                          Check the error code from SGBSVX. */
00797 
00798                                 if (info == n + 1) {
00799                                     goto L90;
00800                                 }
00801                                 if (info != izero) {
00802 /* Writing concatenation */
00803                                     i__11[0] = 1, a__1[0] = fact;
00804                                     i__11[1] = 1, a__1[1] = trans;
00805                                     s_cat(ch__1, a__1, i__11, &c__2, (ftnlen)
00806                                             2);
00807                                     alaerh_(path, "SGBSVX", &info, &izero, 
00808                                             ch__1, &n, &n, &kl, &ku, nrhs, &
00809                                             imat, &nfail, &nerrs, nout);
00810                                     goto L90;
00811                                 }
00812 
00813 /*                          Compare WORK(1) from SGBSVX with the computed */
00814 /*                          reciprocal pivot growth factor RPVGRW */
00815 
00816                                 if (info != 0) {
00817                                     anrmpv = 0.f;
00818                                     i__8 = info;
00819                                     for (j = 1; j <= i__8; ++j) {
00820 /* Computing MAX */
00821                                         i__6 = ku + 2 - j;
00822 /* Computing MIN */
00823                                         i__9 = n + ku + 1 - j, i__10 = kl + 
00824                                                 ku + 1;
00825                                         i__7 = min(i__9,i__10);
00826                                         for (i__ = max(i__6,1); i__ <= i__7; 
00827                                                 ++i__) {
00828 /* Computing MAX */
00829                                             r__2 = anrmpv, r__3 = (r__1 = a[
00830                                                     i__ + (j - 1) * lda], 
00831                                                     dabs(r__1));
00832                                             anrmpv = dmax(r__2,r__3);
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 = slantb_("M", "U", "N", &info, &
00843                                             i__8, &afb[max(i__9, i__10)], &
00844                                             ldafb, &work[1]);
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 = slantb_("M", "U", "N", &n, &i__8, 
00853                                              &afb[1], &ldafb, &work[1]);
00854                                     if (rpvgrw == 0.f) {
00855                                         rpvgrw = 1.f;
00856                                     } else {
00857                                         rpvgrw = slangb_("M", &n, &kl, &ku, &
00858                                                 a[1], &lda, &work[1]) / rpvgrw;
00859                                     }
00860                                 }
00861                                 result[6] = (r__1 = rpvgrw - work[1], dabs(
00862                                         r__1)) / dmax(work[1],rpvgrw) / 
00863                                         slamch_("E");
00864 
00865                                 if (! prefac) {
00866 
00867 /*                             Reconstruct matrix from factors and */
00868 /*                             compute residual. */
00869 
00870                                     sgbt01_(&n, &n, &kl, &ku, &a[1], &lda, &
00871                                             afb[1], &ldafb, &iwork[1], &work[
00872                                             1], result);
00873                                     k1 = 1;
00874                                 } else {
00875                                     k1 = 2;
00876                                 }
00877 
00878                                 if (info == 0) {
00879                                     trfcon = FALSE_;
00880 
00881 /*                             Compute residual of the computed solution. */
00882 
00883                                     slacpy_("Full", &n, nrhs, &bsav[1], &ldb, 
00884                                             &work[1], &ldb);
00885                                     sgbt02_(trans, &n, &n, &kl, &ku, nrhs, &
00886                                             asav[1], &lda, &x[1], &ldb, &work[
00887                                             1], &ldb, &result[1]);
00888 
00889 /*                             Check solution from generated exact */
00890 /*                             solution. */
00891 
00892                                     if (nofact || prefac && lsame_(equed, 
00893                                             "N")) {
00894                                         sget04_(&n, nrhs, &x[1], &ldb, &xact[
00895                                                 1], &ldb, &rcondc, &result[2])
00896                                                 ;
00897                                     } else {
00898                                         if (itran == 1) {
00899                                             roldc = roldo;
00900                                         } else {
00901                                             roldc = roldi;
00902                                         }
00903                                         sget04_(&n, nrhs, &x[1], &ldb, &xact[
00904                                                 1], &ldb, &roldc, &result[2]);
00905                                     }
00906 
00907 /*                             Check the error bounds from iterative */
00908 /*                             refinement. */
00909 
00910                                     sgbt05_(trans, &n, &kl, &ku, nrhs, &asav[
00911                                             1], &lda, &b[1], &ldb, &x[1], &
00912                                             ldb, &xact[1], &ldb, &rwork[1], &
00913                                             rwork[*nrhs + 1], &result[3]);
00914                                 } else {
00915                                     trfcon = TRUE_;
00916                                 }
00917 
00918 /*                          Compare RCOND from SGBSVX with the computed */
00919 /*                          value in RCONDC. */
00920 
00921                                 result[5] = sget06_(&rcond, &rcondc);
00922 
00923 /*                          Print information about the tests that did */
00924 /*                          not pass the threshold. */
00925 
00926                                 if (! trfcon) {
00927                                     for (k = k1; k <= 7; ++k) {
00928                                         if (result[k - 1] >= *thresh) {
00929                                             if (nfail == 0 && nerrs == 0) {
00930                           aladhd_(nout, path);
00931                                             }
00932                                             if (prefac) {
00933                           io___72.ciunit = *nout;
00934                           s_wsfe(&io___72);
00935                           do_fio(&c__1, "SGBSVX", (ftnlen)6);
00936                           do_fio(&c__1, fact, (ftnlen)1);
00937                           do_fio(&c__1, trans, (ftnlen)1);
00938                           do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
00939                           do_fio(&c__1, (char *)&kl, (ftnlen)sizeof(integer));
00940                           do_fio(&c__1, (char *)&ku, (ftnlen)sizeof(integer));
00941                           do_fio(&c__1, equed, (ftnlen)1);
00942                           do_fio(&c__1, (char *)&imat, (ftnlen)sizeof(integer)
00943                                   );
00944                           do_fio(&c__1, (char *)&k, (ftnlen)sizeof(integer));
00945                           do_fio(&c__1, (char *)&result[k - 1], (ftnlen)
00946                                   sizeof(real));
00947                           e_wsfe();
00948                                             } else {
00949                           io___73.ciunit = *nout;
00950                           s_wsfe(&io___73);
00951                           do_fio(&c__1, "SGBSVX", (ftnlen)6);
00952                           do_fio(&c__1, fact, (ftnlen)1);
00953                           do_fio(&c__1, trans, (ftnlen)1);
00954                           do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
00955                           do_fio(&c__1, (char *)&kl, (ftnlen)sizeof(integer));
00956                           do_fio(&c__1, (char *)&ku, (ftnlen)sizeof(integer));
00957                           do_fio(&c__1, (char *)&imat, (ftnlen)sizeof(integer)
00958                                   );
00959                           do_fio(&c__1, (char *)&k, (ftnlen)sizeof(integer));
00960                           do_fio(&c__1, (char *)&result[k - 1], (ftnlen)
00961                                   sizeof(real));
00962                           e_wsfe();
00963                                             }
00964                                             ++nfail;
00965                                         }
00966 /* L80: */
00967                                     }
00968                                     nrun = nrun + 7 - k1;
00969                                 } else {
00970                                     if (result[0] >= *thresh && ! prefac) {
00971                                         if (nfail == 0 && nerrs == 0) {
00972                                             aladhd_(nout, path);
00973                                         }
00974                                         if (prefac) {
00975                                             io___74.ciunit = *nout;
00976                                             s_wsfe(&io___74);
00977                                             do_fio(&c__1, "SGBSVX", (ftnlen)6)
00978                                                     ;
00979                                             do_fio(&c__1, fact, (ftnlen)1);
00980                                             do_fio(&c__1, trans, (ftnlen)1);
00981                                             do_fio(&c__1, (char *)&n, (ftnlen)
00982                                                     sizeof(integer));
00983                                             do_fio(&c__1, (char *)&kl, (
00984                                                     ftnlen)sizeof(integer));
00985                                             do_fio(&c__1, (char *)&ku, (
00986                                                     ftnlen)sizeof(integer));
00987                                             do_fio(&c__1, equed, (ftnlen)1);
00988                                             do_fio(&c__1, (char *)&imat, (
00989                                                     ftnlen)sizeof(integer));
00990                                             do_fio(&c__1, (char *)&c__1, (
00991                                                     ftnlen)sizeof(integer));
00992                                             do_fio(&c__1, (char *)&result[0], 
00993                                                     (ftnlen)sizeof(real));
00994                                             e_wsfe();
00995                                         } else {
00996                                             io___75.ciunit = *nout;
00997                                             s_wsfe(&io___75);
00998                                             do_fio(&c__1, "SGBSVX", (ftnlen)6)
00999                                                     ;
01000                                             do_fio(&c__1, fact, (ftnlen)1);
01001                                             do_fio(&c__1, trans, (ftnlen)1);
01002                                             do_fio(&c__1, (char *)&n, (ftnlen)
01003                                                     sizeof(integer));
01004                                             do_fio(&c__1, (char *)&kl, (
01005                                                     ftnlen)sizeof(integer));
01006                                             do_fio(&c__1, (char *)&ku, (
01007                                                     ftnlen)sizeof(integer));
01008                                             do_fio(&c__1, (char *)&imat, (
01009                                                     ftnlen)sizeof(integer));
01010                                             do_fio(&c__1, (char *)&c__1, (
01011                                                     ftnlen)sizeof(integer));
01012                                             do_fio(&c__1, (char *)&result[0], 
01013                                                     (ftnlen)sizeof(real));
01014                                             e_wsfe();
01015                                         }
01016                                         ++nfail;
01017                                         ++nrun;
01018                                     }
01019                                     if (result[5] >= *thresh) {
01020                                         if (nfail == 0 && nerrs == 0) {
01021                                             aladhd_(nout, path);
01022                                         }
01023                                         if (prefac) {
01024                                             io___76.ciunit = *nout;
01025                                             s_wsfe(&io___76);
01026                                             do_fio(&c__1, "SGBSVX", (ftnlen)6)
01027                                                     ;
01028                                             do_fio(&c__1, fact, (ftnlen)1);
01029                                             do_fio(&c__1, trans, (ftnlen)1);
01030                                             do_fio(&c__1, (char *)&n, (ftnlen)
01031                                                     sizeof(integer));
01032                                             do_fio(&c__1, (char *)&kl, (
01033                                                     ftnlen)sizeof(integer));
01034                                             do_fio(&c__1, (char *)&ku, (
01035                                                     ftnlen)sizeof(integer));
01036                                             do_fio(&c__1, equed, (ftnlen)1);
01037                                             do_fio(&c__1, (char *)&imat, (
01038                                                     ftnlen)sizeof(integer));
01039                                             do_fio(&c__1, (char *)&c__6, (
01040                                                     ftnlen)sizeof(integer));
01041                                             do_fio(&c__1, (char *)&result[5], 
01042                                                     (ftnlen)sizeof(real));
01043                                             e_wsfe();
01044                                         } else {
01045                                             io___77.ciunit = *nout;
01046                                             s_wsfe(&io___77);
01047                                             do_fio(&c__1, "SGBSVX", (ftnlen)6)
01048                                                     ;
01049                                             do_fio(&c__1, fact, (ftnlen)1);
01050                                             do_fio(&c__1, trans, (ftnlen)1);
01051                                             do_fio(&c__1, (char *)&n, (ftnlen)
01052                                                     sizeof(integer));
01053                                             do_fio(&c__1, (char *)&kl, (
01054                                                     ftnlen)sizeof(integer));
01055                                             do_fio(&c__1, (char *)&ku, (
01056                                                     ftnlen)sizeof(integer));
01057                                             do_fio(&c__1, (char *)&imat, (
01058                                                     ftnlen)sizeof(integer));
01059                                             do_fio(&c__1, (char *)&c__6, (
01060                                                     ftnlen)sizeof(integer));
01061                                             do_fio(&c__1, (char *)&result[5], 
01062                                                     (ftnlen)sizeof(real));
01063                                             e_wsfe();
01064                                         }
01065                                         ++nfail;
01066                                         ++nrun;
01067                                     }
01068                                     if (result[6] >= *thresh) {
01069                                         if (nfail == 0 && nerrs == 0) {
01070                                             aladhd_(nout, path);
01071                                         }
01072                                         if (prefac) {
01073                                             io___78.ciunit = *nout;
01074                                             s_wsfe(&io___78);
01075                                             do_fio(&c__1, "SGBSVX", (ftnlen)6)
01076                                                     ;
01077                                             do_fio(&c__1, fact, (ftnlen)1);
01078                                             do_fio(&c__1, trans, (ftnlen)1);
01079                                             do_fio(&c__1, (char *)&n, (ftnlen)
01080                                                     sizeof(integer));
01081                                             do_fio(&c__1, (char *)&kl, (
01082                                                     ftnlen)sizeof(integer));
01083                                             do_fio(&c__1, (char *)&ku, (
01084                                                     ftnlen)sizeof(integer));
01085                                             do_fio(&c__1, equed, (ftnlen)1);
01086                                             do_fio(&c__1, (char *)&imat, (
01087                                                     ftnlen)sizeof(integer));
01088                                             do_fio(&c__1, (char *)&c__7, (
01089                                                     ftnlen)sizeof(integer));
01090                                             do_fio(&c__1, (char *)&result[6], 
01091                                                     (ftnlen)sizeof(real));
01092                                             e_wsfe();
01093                                         } else {
01094                                             io___79.ciunit = *nout;
01095                                             s_wsfe(&io___79);
01096                                             do_fio(&c__1, "SGBSVX", (ftnlen)6)
01097                                                     ;
01098                                             do_fio(&c__1, fact, (ftnlen)1);
01099                                             do_fio(&c__1, trans, (ftnlen)1);
01100                                             do_fio(&c__1, (char *)&n, (ftnlen)
01101                                                     sizeof(integer));
01102                                             do_fio(&c__1, (char *)&kl, (
01103                                                     ftnlen)sizeof(integer));
01104                                             do_fio(&c__1, (char *)&ku, (
01105                                                     ftnlen)sizeof(integer));
01106                                             do_fio(&c__1, (char *)&imat, (
01107                                                     ftnlen)sizeof(integer));
01108                                             do_fio(&c__1, (char *)&c__7, (
01109                                                     ftnlen)sizeof(integer));
01110                                             do_fio(&c__1, (char *)&result[6], 
01111                                                     (ftnlen)sizeof(real));
01112                                             e_wsfe();
01113                                         }
01114                                         ++nfail;
01115                                         ++nrun;
01116                                     }
01117 
01118                                 }
01119 
01120 /*                    --- Test SGBSVXX --- */
01121 
01122 /*                    Restore the matrices A and B. */
01123 
01124                                 i__8 = kl + ku + 1;
01125                                 slacpy_("Full", &i__8, &n, &asav[1], &lda, &a[
01126                                         1], &lda);
01127                                 slacpy_("Full", &n, nrhs, &bsav[1], &ldb, &b[
01128                                         1], &ldb);
01129                                 if (! prefac) {
01130                                     i__8 = (kl << 1) + ku + 1;
01131                                     slaset_("Full", &i__8, &n, &c_b48, &c_b48, 
01132                                              &afb[1], &ldafb);
01133                                 }
01134                                 slaset_("Full", &n, nrhs, &c_b48, &c_b48, &x[
01135                                         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                                     slaqgb_(&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 SGBSVXX. */
01148 
01149                                 s_copy(srnamc_1.srnamt, "SGBSVXX", (ftnlen)32,
01150                                          (ftnlen)7);
01151                                 n_err_bnds__ = 3;
01152 
01153                                 salloc3();
01154 
01155                                 sgbsvxx_(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_b48, &work[1], 
01161                                         &iwork[n + 1], &info);
01162 
01163                                 free3();
01164 
01165 /*                    Check the error code from SGBSVXX. */
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, "SGBSVXX", &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 SGBSVXX with the computed */
01183 /*                    reciprocal pivot growth factor RPVGRW */
01184 
01185                                 if (info > 0 && info < n + 1) {
01186                                     rpvgrw = sla_gbrpvgrw__(&n, &kl, &ku, &
01187                                             info, &a[1], &lda, &afb[1], &
01188                                             ldafb);
01189                                 } else {
01190                                     rpvgrw = sla_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                                     sgbt01_(&n, &n, &kl, &ku, &a[1], &lda, &
01203                                             afb[1], &ldafb, &iwork[1], &work[
01204                                             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                                     slacpy_("Full", &n, nrhs, &bsav[1], &ldb, 
01216                                             &work[1], &ldb);
01217                                     sgbt02_(trans, &n, &n, &kl, &ku, nrhs, &
01218                                             asav[1], &lda, &x[1], &ldb, &work[
01219                                             1], &ldb, &result[1]);
01220 
01221 /*                       Check solution from generated exact solution. */
01222 
01223                                     if (nofact || prefac && lsame_(equed, 
01224                                             "N")) {
01225                                         sget04_(&n, nrhs, &x[1], &ldb, &xact[
01226                                                 1], &ldb, &rcondc, &result[2])
01227                                                 ;
01228                                     } else {
01229                                         if (itran == 1) {
01230                                             roldc = roldo;
01231                                         } else {
01232                                             roldc = roldi;
01233                                         }
01234                                         sget04_(&n, nrhs, &x[1], &ldb, &xact[
01235                                                 1], &ldb, &roldc, &result[2]);
01236                                     }
01237                                 } else {
01238                                     trfcon = TRUE_;
01239                                 }
01240 
01241 /*                    Compare RCOND from SGBSVXX with the computed value */
01242 /*                    in RCONDC. */
01243 
01244                                 result[5] = sget06_(&rcond, &rcondc);
01245 
01246 /*                    Print information about the tests that did not pass */
01247 /*                    the threshold. */
01248 
01249                                 if (! trfcon) {
01250                                     for (k = k1; k <= 7; ++k) {
01251                                         if (result[k - 1] >= *thresh) {
01252                                             if (nfail == 0 && nerrs == 0) {
01253                           aladhd_(nout, path);
01254                                             }
01255                                             if (prefac) {
01256                           io___85.ciunit = *nout;
01257                           s_wsfe(&io___85);
01258                           do_fio(&c__1, "SGBSVXX", (ftnlen)7);
01259                           do_fio(&c__1, fact, (ftnlen)1);
01260                           do_fio(&c__1, trans, (ftnlen)1);
01261                           do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
01262                           do_fio(&c__1, (char *)&kl, (ftnlen)sizeof(integer));
01263                           do_fio(&c__1, (char *)&ku, (ftnlen)sizeof(integer));
01264                           do_fio(&c__1, equed, (ftnlen)1);
01265                           do_fio(&c__1, (char *)&imat, (ftnlen)sizeof(integer)
01266                                   );
01267                           do_fio(&c__1, (char *)&k, (ftnlen)sizeof(integer));
01268                           do_fio(&c__1, (char *)&result[k - 1], (ftnlen)
01269                                   sizeof(real));
01270                           e_wsfe();
01271                                             } else {
01272                           io___86.ciunit = *nout;
01273                           s_wsfe(&io___86);
01274                           do_fio(&c__1, "SGBSVXX", (ftnlen)7);
01275                           do_fio(&c__1, fact, (ftnlen)1);
01276                           do_fio(&c__1, trans, (ftnlen)1);
01277                           do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
01278                           do_fio(&c__1, (char *)&kl, (ftnlen)sizeof(integer));
01279                           do_fio(&c__1, (char *)&ku, (ftnlen)sizeof(integer));
01280                           do_fio(&c__1, (char *)&imat, (ftnlen)sizeof(integer)
01281                                   );
01282                           do_fio(&c__1, (char *)&k, (ftnlen)sizeof(integer));
01283                           do_fio(&c__1, (char *)&result[k - 1], (ftnlen)
01284                                   sizeof(real));
01285                           e_wsfe();
01286                                             }
01287                                             ++nfail;
01288                                         }
01289 /* L45: */
01290                                     }
01291                                     nrun = nrun + 7 - k1;
01292                                 } else {
01293                                     if (result[0] >= *thresh && ! prefac) {
01294                                         if (nfail == 0 && nerrs == 0) {
01295                                             aladhd_(nout, path);
01296                                         }
01297                                         if (prefac) {
01298                                             io___87.ciunit = *nout;
01299                                             s_wsfe(&io___87);
01300                                             do_fio(&c__1, "SGBSVXX", (ftnlen)
01301                                                     7);
01302                                             do_fio(&c__1, fact, (ftnlen)1);
01303                                             do_fio(&c__1, trans, (ftnlen)1);
01304                                             do_fio(&c__1, (char *)&n, (ftnlen)
01305                                                     sizeof(integer));
01306                                             do_fio(&c__1, (char *)&kl, (
01307                                                     ftnlen)sizeof(integer));
01308                                             do_fio(&c__1, (char *)&ku, (
01309                                                     ftnlen)sizeof(integer));
01310                                             do_fio(&c__1, equed, (ftnlen)1);
01311                                             do_fio(&c__1, (char *)&imat, (
01312                                                     ftnlen)sizeof(integer));
01313                                             do_fio(&c__1, (char *)&c__1, (
01314                                                     ftnlen)sizeof(integer));
01315                                             do_fio(&c__1, (char *)&result[0], 
01316                                                     (ftnlen)sizeof(real));
01317                                             e_wsfe();
01318                                         } else {
01319                                             io___88.ciunit = *nout;
01320                                             s_wsfe(&io___88);
01321                                             do_fio(&c__1, "SGBSVXX", (ftnlen)
01322                                                     7);
01323                                             do_fio(&c__1, fact, (ftnlen)1);
01324                                             do_fio(&c__1, trans, (ftnlen)1);
01325                                             do_fio(&c__1, (char *)&n, (ftnlen)
01326                                                     sizeof(integer));
01327                                             do_fio(&c__1, (char *)&kl, (
01328                                                     ftnlen)sizeof(integer));
01329                                             do_fio(&c__1, (char *)&ku, (
01330                                                     ftnlen)sizeof(integer));
01331                                             do_fio(&c__1, (char *)&imat, (
01332                                                     ftnlen)sizeof(integer));
01333                                             do_fio(&c__1, (char *)&c__1, (
01334                                                     ftnlen)sizeof(integer));
01335                                             do_fio(&c__1, (char *)&result[0], 
01336                                                     (ftnlen)sizeof(real));
01337                                             e_wsfe();
01338                                         }
01339                                         ++nfail;
01340                                         ++nrun;
01341                                     }
01342                                     if (result[5] >= *thresh) {
01343                                         if (nfail == 0 && nerrs == 0) {
01344                                             aladhd_(nout, path);
01345                                         }
01346                                         if (prefac) {
01347                                             io___89.ciunit = *nout;
01348                                             s_wsfe(&io___89);
01349                                             do_fio(&c__1, "SGBSVXX", (ftnlen)
01350                                                     7);
01351                                             do_fio(&c__1, fact, (ftnlen)1);
01352                                             do_fio(&c__1, trans, (ftnlen)1);
01353                                             do_fio(&c__1, (char *)&n, (ftnlen)
01354                                                     sizeof(integer));
01355                                             do_fio(&c__1, (char *)&kl, (
01356                                                     ftnlen)sizeof(integer));
01357                                             do_fio(&c__1, (char *)&ku, (
01358                                                     ftnlen)sizeof(integer));
01359                                             do_fio(&c__1, equed, (ftnlen)1);
01360                                             do_fio(&c__1, (char *)&imat, (
01361                                                     ftnlen)sizeof(integer));
01362                                             do_fio(&c__1, (char *)&c__6, (
01363                                                     ftnlen)sizeof(integer));
01364                                             do_fio(&c__1, (char *)&result[5], 
01365                                                     (ftnlen)sizeof(real));
01366                                             e_wsfe();
01367                                         } else {
01368                                             io___90.ciunit = *nout;
01369                                             s_wsfe(&io___90);
01370                                             do_fio(&c__1, "SGBSVXX", (ftnlen)
01371                                                     7);
01372                                             do_fio(&c__1, fact, (ftnlen)1);
01373                                             do_fio(&c__1, trans, (ftnlen)1);
01374                                             do_fio(&c__1, (char *)&n, (ftnlen)
01375                                                     sizeof(integer));
01376                                             do_fio(&c__1, (char *)&kl, (
01377                                                     ftnlen)sizeof(integer));
01378                                             do_fio(&c__1, (char *)&ku, (
01379                                                     ftnlen)sizeof(integer));
01380                                             do_fio(&c__1, (char *)&imat, (
01381                                                     ftnlen)sizeof(integer));
01382                                             do_fio(&c__1, (char *)&c__6, (
01383                                                     ftnlen)sizeof(integer));
01384                                             do_fio(&c__1, (char *)&result[5], 
01385                                                     (ftnlen)sizeof(real));
01386                                             e_wsfe();
01387                                         }
01388                                         ++nfail;
01389                                         ++nrun;
01390                                     }
01391                                     if (result[6] >= *thresh) {
01392                                         if (nfail == 0 && nerrs == 0) {
01393                                             aladhd_(nout, path);
01394                                         }
01395                                         if (prefac) {
01396                                             io___91.ciunit = *nout;
01397                                             s_wsfe(&io___91);
01398                                             do_fio(&c__1, "SGBSVXX", (ftnlen)
01399                                                     7);
01400                                             do_fio(&c__1, fact, (ftnlen)1);
01401                                             do_fio(&c__1, trans, (ftnlen)1);
01402                                             do_fio(&c__1, (char *)&n, (ftnlen)
01403                                                     sizeof(integer));
01404                                             do_fio(&c__1, (char *)&kl, (
01405                                                     ftnlen)sizeof(integer));
01406                                             do_fio(&c__1, (char *)&ku, (
01407                                                     ftnlen)sizeof(integer));
01408                                             do_fio(&c__1, equed, (ftnlen)1);
01409                                             do_fio(&c__1, (char *)&imat, (
01410                                                     ftnlen)sizeof(integer));
01411                                             do_fio(&c__1, (char *)&c__7, (
01412                                                     ftnlen)sizeof(integer));
01413                                             do_fio(&c__1, (char *)&result[6], 
01414                                                     (ftnlen)sizeof(real));
01415                                             e_wsfe();
01416                                         } else {
01417                                             io___92.ciunit = *nout;
01418                                             s_wsfe(&io___92);
01419                                             do_fio(&c__1, "SGBSVXX", (ftnlen)
01420                                                     7);
01421                                             do_fio(&c__1, fact, (ftnlen)1);
01422                                             do_fio(&c__1, trans, (ftnlen)1);
01423                                             do_fio(&c__1, (char *)&n, (ftnlen)
01424                                                     sizeof(integer));
01425                                             do_fio(&c__1, (char *)&kl, (
01426                                                     ftnlen)sizeof(integer));
01427                                             do_fio(&c__1, (char *)&ku, (
01428                                                     ftnlen)sizeof(integer));
01429                                             do_fio(&c__1, (char *)&imat, (
01430                                                     ftnlen)sizeof(integer));
01431                                             do_fio(&c__1, (char *)&c__7, (
01432                                                     ftnlen)sizeof(integer));
01433                                             do_fio(&c__1, (char *)&result[6], 
01434                                                     (ftnlen)sizeof(real));
01435                                             e_wsfe();
01436                                         }
01437                                         ++nfail;
01438                                         ++nrun;
01439                                     }
01440                                 }
01441 
01442 L90:
01443                                 ;
01444                             }
01445 L100:
01446                             ;
01447                         }
01448 /* L110: */
01449                     }
01450 L120:
01451                     ;
01452                 }
01453 L130:
01454                 ;
01455             }
01456 /* L140: */
01457         }
01458 /* L150: */
01459     }
01460 
01461 /*     Print a summary of the results. */
01462 
01463     alasvm_(path, nout, &nfail, &nrun, &nerrs);
01464 
01465 /*     Test Error Bounds from SGBSVXX */
01466     sebchvxx_(thresh, path);
01467 
01468     return 0;
01469 
01470 /*     End of SDRVGB */
01471 
01472 } /* sdrvgb_ */


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