00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013 #include "f2c.h"
00014 #include "memory_alloc.h"
00015
00016
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
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 doublereal c_b48 = 0.;
00038 static doublereal c_b49 = 1.;
00039 static integer c__6 = 6;
00040 static integer c__7 = 7;
00041
00042 int ddrvgb_(logical *dotype, integer *nn, integer *nval,
00043 integer *nrhs, doublereal *thresh, logical *tsterr, doublereal *a,
00044 integer *la, doublereal *afb, integer *lafb, doublereal *asav,
00045 doublereal *b, doublereal *bsav, doublereal *x, doublereal *xact,
00046 doublereal *s, doublereal *work, doublereal *rwork, integer *iwork,
00047 integer *nout)
00048 {
00049
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
00057 static char fmt_9999[] = "(\002 *** In DDRVGB, 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 DDRVGB, 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
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 doublereal d__1, d__2, d__3;
00078 char ch__1[2];
00079
00080
00081 int s_copy(char *, char *, ftnlen, ftnlen);
00082 integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void);
00083 int s_cat(char *, char **, integer *, integer *, ftnlen);
00084
00085
00086 extern int debchvxx_(doublereal *, char *);
00087 integer i__, j, k, n;
00088 doublereal *errbnds_c__;
00089 integer i1, i2, k1;
00090 doublereal *errbnds_n__;
00091 integer nb, in, kl, ku, nt, n_err_bnds__, lda, ldb, ikl, nkl, iku, nku;
00092 char fact[1];
00093 integer ioff, mode;
00094 doublereal amax;
00095 char path[3];
00096 integer imat, info;
00097 doublereal *berr;
00098 char dist[1];
00099 doublereal rpvgrw_svxx__;
00100 char type__[1];
00101 integer nrun;
00102 extern doublereal dla_gbrpvgrw__(integer *, integer *, integer *, integer
00103 *, doublereal *, integer *, doublereal *, integer *);
00104 integer ldafb;
00105 extern int dgbt01_(integer *, integer *, integer *,
00106 integer *, doublereal *, integer *, doublereal *, integer *,
00107 integer *, doublereal *, doublereal *), dgbt02_(), dgbt05_(char *,
00108 integer *, integer *, integer *, integer *, doublereal *,
00109 integer *, doublereal *, integer *, doublereal *, integer *,
00110 doublereal *, integer *, doublereal *, doublereal *, doublereal *);
00111 integer ifact;
00112 extern int dget04_(integer *, integer *, doublereal *,
00113 integer *, doublereal *, integer *, doublereal *, doublereal *);
00114 integer nfail, iseed[4], nfact;
00115 extern doublereal dget06_(doublereal *, doublereal *);
00116 extern logical lsame_(char *, char *);
00117 char equed[1];
00118 integer nbmin;
00119 doublereal rcond, roldc;
00120 extern int dgbsv_(integer *, integer *, integer *,
00121 integer *, doublereal *, integer *, integer *, doublereal *,
00122 integer *, integer *);
00123 integer nimat;
00124 doublereal roldi, anorm;
00125 integer itran;
00126 logical equil;
00127 doublereal roldo;
00128 char trans[1];
00129 integer izero, nerrs;
00130 logical zerot;
00131 char xtype[1];
00132 extern int dlatb4_(char *, integer *, integer *, integer
00133 *, char *, integer *, integer *, doublereal *, integer *,
00134 doublereal *, char *), aladhd_(integer *,
00135 char *);
00136 extern doublereal dlangb_(char *, integer *, integer *, integer *,
00137 doublereal *, integer *, doublereal *), dlamch_(char *), dlange_(char *, integer *, integer *, doublereal *,
00138 integer *, doublereal *);
00139 extern int dlaqgb_(integer *, integer *, integer *,
00140 integer *, doublereal *, integer *, doublereal *, doublereal *,
00141 doublereal *, doublereal *, doublereal *, char *),
00142 alaerh_(char *, char *, integer *, integer *, char *, integer *,
00143 integer *, integer *, integer *, integer *, integer *, integer *,
00144 integer *, integer *);
00145 logical prefac;
00146 doublereal colcnd;
00147 extern doublereal dlantb_(char *, char *, char *, integer *, integer *,
00148 doublereal *, integer *, doublereal *);
00149 extern int dgbequ_(integer *, integer *, integer *,
00150 integer *, doublereal *, integer *, doublereal *, doublereal *,
00151 doublereal *, doublereal *, doublereal *, integer *);
00152 doublereal rcondc;
00153 logical nofact;
00154 extern int dgbtrf_(integer *, integer *, integer *,
00155 integer *, doublereal *, integer *, integer *, integer *);
00156 integer iequed;
00157 extern int dlacpy_(char *, integer *, integer *,
00158 doublereal *, integer *, doublereal *, integer *);
00159 doublereal rcondi;
00160 extern int dlarhs_(char *, char *, char *, char *,
00161 integer *, integer *, integer *, integer *, integer *, doublereal
00162 *, integer *, doublereal *, integer *, doublereal *, integer *,
00163 integer *, integer *), dlaset_(
00164 char *, integer *, integer *, doublereal *, doublereal *,
00165 doublereal *, integer *), alasvm_(char *, integer *,
00166 integer *, integer *, integer *);
00167 doublereal cndnum, anormi, rcondo, ainvnm;
00168 extern int dgbtrs_(char *, integer *, integer *, integer
00169 *, integer *, doublereal *, integer *, integer *, doublereal *,
00170 integer *, integer *), dlatms_(integer *, integer *, char
00171 *, integer *, char *, doublereal *, integer *, doublereal *,
00172 doublereal *, integer *, integer *, char *, doublereal *, integer
00173 *, doublereal *, integer *);
00174 logical trfcon;
00175 doublereal anormo, rowcnd;
00176 extern int dgbsvx_(char *, char *, integer *, integer *,
00177 integer *, integer *, doublereal *, integer *, doublereal *,
00178 integer *, integer *, char *, doublereal *, doublereal *,
00179 doublereal *, integer *, doublereal *, integer *, doublereal *,
00180 doublereal *, doublereal *, doublereal *, integer *, integer *), xlaenv_(integer *, integer *);
00181 doublereal anrmpv;
00182 extern int derrvx_(char *, integer *);
00183 doublereal result[7], rpvgrw;
00184 extern int dgbsvxx_(char *, char *, integer *, integer *,
00185 integer *, integer *, doublereal *, integer *, doublereal *,
00186 integer *, integer *, char *, doublereal *, doublereal *,
00187 doublereal *, integer *, doublereal *, integer *, doublereal *,
00188 doublereal *, doublereal *, integer *, doublereal *, doublereal *,
00189 integer *, doublereal *, doublereal *, integer *, integer *);
00190
00191
00192 static cilist io___26 = { 0, 0, 0, fmt_9999, 0 };
00193 static cilist io___27 = { 0, 0, 0, fmt_9998, 0 };
00194 static cilist io___65 = { 0, 0, 0, fmt_9997, 0 };
00195 static cilist io___72 = { 0, 0, 0, fmt_9995, 0 };
00196 static cilist io___73 = { 0, 0, 0, fmt_9996, 0 };
00197 static cilist io___74 = { 0, 0, 0, fmt_9995, 0 };
00198 static cilist io___75 = { 0, 0, 0, fmt_9996, 0 };
00199 static cilist io___76 = { 0, 0, 0, fmt_9995, 0 };
00200 static cilist io___77 = { 0, 0, 0, fmt_9996, 0 };
00201 static cilist io___78 = { 0, 0, 0, fmt_9995, 0 };
00202 static cilist io___79 = { 0, 0, 0, fmt_9996, 0 };
00203 static cilist io___85 = { 0, 0, 0, fmt_9997, 0 };
00204 static cilist io___86 = { 0, 0, 0, fmt_9998, 0 };
00205 static cilist io___87 = { 0, 0, 0, fmt_9997, 0 };
00206 static cilist io___88 = { 0, 0, 0, fmt_9998, 0 };
00207 static cilist io___89 = { 0, 0, 0, fmt_9997, 0 };
00208 static cilist io___90 = { 0, 0, 0, fmt_9998, 0 };
00209 static cilist io___91 = { 0, 0, 0, fmt_9997, 0 };
00210 static cilist io___92 = { 0, 0, 0, fmt_9998, 0 };
00211
00212
00213
00214
00215
00216
00217
00218
00219
00220
00221
00222
00223
00224
00225
00226
00227
00228
00229
00230
00231
00232
00233
00234
00235
00236
00237
00238
00239
00240
00241
00242
00243
00244
00245
00246
00247
00248
00249
00250
00251
00252
00253
00254
00255
00256
00257
00258
00259
00260
00261
00262
00263
00264
00265
00266
00267
00268
00269
00270
00271
00272
00273
00274
00275
00276
00277
00278
00279
00280
00281
00282
00283
00284
00285
00286
00287
00288
00289
00290
00291
00292
00293
00294
00295
00296
00297
00298
00299
00300
00301
00302
00303
00304
00305
00306
00307
00308
00309 --iwork;
00310 --rwork;
00311 --work;
00312 --s;
00313 --xact;
00314 --x;
00315 --bsav;
00316 --b;
00317 --asav;
00318 --afb;
00319 --a;
00320 --nval;
00321 --dotype;
00322
00323
00324
00325
00326
00327
00328
00329 s_copy(path, "Double precision", (ftnlen)1, (ftnlen)16);
00330 s_copy(path + 1, "GB", (ftnlen)2, (ftnlen)2);
00331 nrun = 0;
00332 nfail = 0;
00333 nerrs = 0;
00334 for (i__ = 1; i__ <= 4; ++i__) {
00335 iseed[i__ - 1] = iseedy[i__ - 1];
00336
00337 }
00338
00339
00340
00341 if (*tsterr) {
00342 derrvx_(path, nout);
00343 }
00344 infoc_1.infot = 0;
00345
00346
00347
00348 nb = 1;
00349 nbmin = 2;
00350 xlaenv_(&c__1, &nb);
00351 xlaenv_(&c__2, &nbmin);
00352
00353
00354
00355 i__1 = *nn;
00356 for (in = 1; in <= i__1; ++in) {
00357 n = nval[in];
00358 ldb = max(n,1);
00359 *(unsigned char *)xtype = 'N';
00360
00361
00362
00363
00364 i__2 = 1, i__3 = min(n,4);
00365 nkl = max(i__2,i__3);
00366 if (n == 0) {
00367 nkl = 1;
00368 }
00369 nku = nkl;
00370 nimat = 8;
00371 if (n <= 0) {
00372 nimat = 1;
00373 }
00374
00375 i__2 = nkl;
00376 for (ikl = 1; ikl <= i__2; ++ikl) {
00377
00378
00379
00380
00381 if (ikl == 1) {
00382 kl = 0;
00383 } else if (ikl == 2) {
00384
00385 i__3 = n - 1;
00386 kl = max(i__3,0);
00387 } else if (ikl == 3) {
00388 kl = (n * 3 - 1) / 4;
00389 } else if (ikl == 4) {
00390 kl = (n + 1) / 4;
00391 }
00392 i__3 = nku;
00393 for (iku = 1; iku <= i__3; ++iku) {
00394
00395
00396
00397
00398
00399 if (iku == 1) {
00400 ku = 0;
00401 } else if (iku == 2) {
00402
00403 i__4 = n - 1;
00404 ku = max(i__4,0);
00405 } else if (iku == 3) {
00406 ku = (n * 3 - 1) / 4;
00407 } else if (iku == 4) {
00408 ku = (n + 1) / 4;
00409 }
00410
00411
00412
00413
00414 lda = kl + ku + 1;
00415 ldafb = (kl << 1) + ku + 1;
00416 if (lda * n > *la || ldafb * n > *lafb) {
00417 if (nfail == 0 && nerrs == 0) {
00418 aladhd_(nout, path);
00419 }
00420 if (lda * n > *la) {
00421 io___26.ciunit = *nout;
00422 s_wsfe(&io___26);
00423 do_fio(&c__1, (char *)&(*la), (ftnlen)sizeof(integer))
00424 ;
00425 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
00426 do_fio(&c__1, (char *)&kl, (ftnlen)sizeof(integer));
00427 do_fio(&c__1, (char *)&ku, (ftnlen)sizeof(integer));
00428 i__4 = n * (kl + ku + 1);
00429 do_fio(&c__1, (char *)&i__4, (ftnlen)sizeof(integer));
00430 e_wsfe();
00431 ++nerrs;
00432 }
00433 if (ldafb * n > *lafb) {
00434 io___27.ciunit = *nout;
00435 s_wsfe(&io___27);
00436 do_fio(&c__1, (char *)&(*lafb), (ftnlen)sizeof(
00437 integer));
00438 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
00439 do_fio(&c__1, (char *)&kl, (ftnlen)sizeof(integer));
00440 do_fio(&c__1, (char *)&ku, (ftnlen)sizeof(integer));
00441 i__4 = n * ((kl << 1) + ku + 1);
00442 do_fio(&c__1, (char *)&i__4, (ftnlen)sizeof(integer));
00443 e_wsfe();
00444 ++nerrs;
00445 }
00446 goto L130;
00447 }
00448
00449 i__4 = nimat;
00450 for (imat = 1; imat <= i__4; ++imat) {
00451
00452
00453
00454 if (! dotype[imat]) {
00455 goto L120;
00456 }
00457
00458
00459
00460 zerot = imat >= 2 && imat <= 4;
00461 if (zerot && n < imat - 1) {
00462 goto L120;
00463 }
00464
00465
00466
00467
00468 dlatb4_(path, &imat, &n, &n, type__, &kl, &ku, &anorm, &
00469 mode, &cndnum, dist);
00470 rcondc = 1. / cndnum;
00471
00472 s_copy(srnamc_1.srnamt, "DLATMS", (ftnlen)32, (ftnlen)6);
00473 dlatms_(&n, &n, dist, iseed, type__, &rwork[1], &mode, &
00474 cndnum, &anorm, &kl, &ku, "Z", &a[1], &lda, &work[
00475 1], &info);
00476
00477
00478
00479 if (info != 0) {
00480 alaerh_(path, "DLATMS", &info, &c__0, " ", &n, &n, &
00481 kl, &ku, &c_n1, &imat, &nfail, &nerrs, nout);
00482 goto L120;
00483 }
00484
00485
00486
00487
00488 izero = 0;
00489 if (zerot) {
00490 if (imat == 2) {
00491 izero = 1;
00492 } else if (imat == 3) {
00493 izero = n;
00494 } else {
00495 izero = n / 2 + 1;
00496 }
00497 ioff = (izero - 1) * lda;
00498 if (imat < 4) {
00499
00500 i__5 = 1, i__6 = ku + 2 - izero;
00501 i1 = max(i__5,i__6);
00502
00503 i__5 = kl + ku + 1, i__6 = ku + 1 + (n - izero);
00504 i2 = min(i__5,i__6);
00505 i__5 = i2;
00506 for (i__ = i1; i__ <= i__5; ++i__) {
00507 a[ioff + i__] = 0.;
00508
00509 }
00510 } else {
00511 i__5 = n;
00512 for (j = izero; j <= i__5; ++j) {
00513
00514 i__6 = 1, i__7 = ku + 2 - j;
00515
00516 i__9 = kl + ku + 1, i__10 = ku + 1 + (n - j);
00517 i__8 = min(i__9,i__10);
00518 for (i__ = max(i__6,i__7); i__ <= i__8; ++i__)
00519 {
00520 a[ioff + i__] = 0.;
00521
00522 }
00523 ioff += lda;
00524
00525 }
00526 }
00527 }
00528
00529
00530
00531 i__5 = kl + ku + 1;
00532 dlacpy_("Full", &i__5, &n, &a[1], &lda, &asav[1], &lda);
00533
00534 for (iequed = 1; iequed <= 4; ++iequed) {
00535 *(unsigned char *)equed = *(unsigned char *)&equeds[
00536 iequed - 1];
00537 if (iequed == 1) {
00538 nfact = 3;
00539 } else {
00540 nfact = 1;
00541 }
00542
00543 i__5 = nfact;
00544 for (ifact = 1; ifact <= i__5; ++ifact) {
00545 *(unsigned char *)fact = *(unsigned char *)&facts[
00546 ifact - 1];
00547 prefac = lsame_(fact, "F");
00548 nofact = lsame_(fact, "N");
00549 equil = lsame_(fact, "E");
00550
00551 if (zerot) {
00552 if (prefac) {
00553 goto L100;
00554 }
00555 rcondo = 0.;
00556 rcondi = 0.;
00557
00558 } else if (! nofact) {
00559
00560
00561
00562
00563
00564
00565 i__8 = kl + ku + 1;
00566 dlacpy_("Full", &i__8, &n, &asav[1], &lda, &
00567 afb[kl + 1], &ldafb);
00568 if (equil || iequed > 1) {
00569
00570
00571
00572
00573 dgbequ_(&n, &n, &kl, &ku, &afb[kl + 1], &
00574 ldafb, &s[1], &s[n + 1], &rowcnd,
00575 &colcnd, &amax, &info);
00576 if (info == 0 && n > 0) {
00577 if (lsame_(equed, "R")) {
00578 rowcnd = 0.;
00579 colcnd = 1.;
00580 } else if (lsame_(equed, "C")) {
00581 rowcnd = 1.;
00582 colcnd = 0.;
00583 } else if (lsame_(equed, "B")) {
00584 rowcnd = 0.;
00585 colcnd = 0.;
00586 }
00587
00588
00589
00590 dlaqgb_(&n, &n, &kl, &ku, &afb[kl + 1]
00591 , &ldafb, &s[1], &s[n + 1], &
00592 rowcnd, &colcnd, &amax, equed);
00593 }
00594 }
00595
00596
00597
00598
00599 if (equil) {
00600 roldo = rcondo;
00601 roldi = rcondi;
00602 }
00603
00604
00605
00606 anormo = dlangb_("1", &n, &kl, &ku, &afb[kl +
00607 1], &ldafb, &rwork[1]);
00608 anormi = dlangb_("I", &n, &kl, &ku, &afb[kl +
00609 1], &ldafb, &rwork[1]);
00610
00611
00612
00613 dgbtrf_(&n, &n, &kl, &ku, &afb[1], &ldafb, &
00614 iwork[1], &info);
00615
00616
00617
00618 dlaset_("Full", &n, &n, &c_b48, &c_b49, &work[
00619 1], &ldb);
00620 s_copy(srnamc_1.srnamt, "DGBTRS", (ftnlen)32,
00621 (ftnlen)6);
00622 dgbtrs_("No transpose", &n, &kl, &ku, &n, &
00623 afb[1], &ldafb, &iwork[1], &work[1], &
00624 ldb, &info);
00625
00626
00627
00628 ainvnm = dlange_("1", &n, &n, &work[1], &ldb,
00629 &rwork[1]);
00630 if (anormo <= 0. || ainvnm <= 0.) {
00631 rcondo = 1.;
00632 } else {
00633 rcondo = 1. / anormo / ainvnm;
00634 }
00635
00636
00637
00638
00639 ainvnm = dlange_("I", &n, &n, &work[1], &ldb,
00640 &rwork[1]);
00641 if (anormi <= 0. || ainvnm <= 0.) {
00642 rcondi = 1.;
00643 } else {
00644 rcondi = 1. / anormi / ainvnm;
00645 }
00646 }
00647
00648 for (itran = 1; itran <= 3; ++itran) {
00649
00650
00651
00652 *(unsigned char *)trans = *(unsigned char *)&
00653 transs[itran - 1];
00654 if (itran == 1) {
00655 rcondc = rcondo;
00656 } else {
00657 rcondc = rcondi;
00658 }
00659
00660
00661
00662 i__8 = kl + ku + 1;
00663 dlacpy_("Full", &i__8, &n, &asav[1], &lda, &a[
00664 1], &lda);
00665
00666
00667
00668
00669 s_copy(srnamc_1.srnamt, "DLARHS", (ftnlen)32,
00670 (ftnlen)6);
00671 dlarhs_(path, xtype, "Full", trans, &n, &n, &
00672 kl, &ku, nrhs, &a[1], &lda, &xact[1],
00673 &ldb, &b[1], &ldb, iseed, &info);
00674 *(unsigned char *)xtype = 'C';
00675 dlacpy_("Full", &n, nrhs, &b[1], &ldb, &bsav[
00676 1], &ldb);
00677
00678 if (nofact && itran == 1) {
00679
00680
00681
00682
00683
00684
00685 i__8 = kl + ku + 1;
00686 dlacpy_("Full", &i__8, &n, &a[1], &lda, &
00687 afb[kl + 1], &ldafb);
00688 dlacpy_("Full", &n, nrhs, &b[1], &ldb, &x[
00689 1], &ldb);
00690
00691 s_copy(srnamc_1.srnamt, "DGBSV ", (ftnlen)
00692 32, (ftnlen)6);
00693 dgbsv_(&n, &kl, &ku, nrhs, &afb[1], &
00694 ldafb, &iwork[1], &x[1], &ldb, &
00695 info);
00696
00697
00698
00699 if (info == n + 1) {
00700 goto L90;
00701 }
00702 if (info != izero) {
00703 alaerh_(path, "DGBSV ", &info, &izero,
00704 " ", &n, &n, &kl, &ku, nrhs,
00705 &imat, &nfail, &nerrs, nout);
00706 goto L90;
00707 }
00708
00709
00710
00711
00712 dgbt01_(&n, &n, &kl, &ku, &a[1], &lda, &
00713 afb[1], &ldafb, &iwork[1], &work[
00714 1], result);
00715 nt = 1;
00716 if (izero == 0) {
00717
00718
00719
00720
00721 dlacpy_("Full", &n, nrhs, &b[1], &ldb,
00722 &work[1], &ldb);
00723 dgbt02_("No transpose", &n, &n, &kl, &
00724 ku, nrhs, &a[1], &lda, &x[1],
00725 &ldb, &work[1], &ldb, &result[
00726 1]);
00727
00728
00729
00730
00731 dget04_(&n, nrhs, &x[1], &ldb, &xact[
00732 1], &ldb, &rcondc, &result[2])
00733 ;
00734 nt = 3;
00735 }
00736
00737
00738
00739
00740 i__8 = nt;
00741 for (k = 1; k <= i__8; ++k) {
00742 if (result[k - 1] >= *thresh) {
00743 if (nfail == 0 && nerrs == 0) {
00744 aladhd_(nout, path);
00745 }
00746 io___65.ciunit = *nout;
00747 s_wsfe(&io___65);
00748 do_fio(&c__1, "DGBSV ", (ftnlen)6)
00749 ;
00750 do_fio(&c__1, (char *)&n, (ftnlen)
00751 sizeof(integer));
00752 do_fio(&c__1, (char *)&kl, (
00753 ftnlen)sizeof(integer));
00754 do_fio(&c__1, (char *)&ku, (
00755 ftnlen)sizeof(integer));
00756 do_fio(&c__1, (char *)&imat, (
00757 ftnlen)sizeof(integer));
00758 do_fio(&c__1, (char *)&k, (ftnlen)
00759 sizeof(integer));
00760 do_fio(&c__1, (char *)&result[k -
00761 1], (ftnlen)sizeof(
00762 doublereal));
00763 e_wsfe();
00764 ++nfail;
00765 }
00766
00767 }
00768 nrun += nt;
00769 }
00770
00771
00772
00773 if (! prefac) {
00774 i__8 = (kl << 1) + ku + 1;
00775 dlaset_("Full", &i__8, &n, &c_b48, &c_b48,
00776 &afb[1], &ldafb);
00777 }
00778 dlaset_("Full", &n, nrhs, &c_b48, &c_b48, &x[
00779 1], &ldb);
00780 if (iequed > 1 && n > 0) {
00781
00782
00783
00784
00785 dlaqgb_(&n, &n, &kl, &ku, &a[1], &lda, &s[
00786 1], &s[n + 1], &rowcnd, &colcnd, &
00787 amax, equed);
00788 }
00789
00790
00791
00792
00793 s_copy(srnamc_1.srnamt, "DGBSVX", (ftnlen)32,
00794 (ftnlen)6);
00795 dgbsvx_(fact, trans, &n, &kl, &ku, nrhs, &a[1]
00796 , &lda, &afb[1], &ldafb, &iwork[1],
00797 equed, &s[1], &s[n + 1], &b[1], &ldb,
00798 &x[1], &ldb, &rcond, &rwork[1], &
00799 rwork[*nrhs + 1], &work[1], &iwork[n
00800 + 1], &info);
00801
00802
00803
00804 if (info == n + 1) {
00805 goto L90;
00806 }
00807 if (info != izero) {
00808
00809 i__11[0] = 1, a__1[0] = fact;
00810 i__11[1] = 1, a__1[1] = trans;
00811 s_cat(ch__1, a__1, i__11, &c__2, (ftnlen)
00812 2);
00813 alaerh_(path, "DGBSVX", &info, &izero,
00814 ch__1, &n, &n, &kl, &ku, nrhs, &
00815 imat, &nfail, &nerrs, nout);
00816 goto L90;
00817 }
00818
00819
00820
00821
00822 if (info != 0) {
00823 anrmpv = 0.;
00824 i__8 = info;
00825 for (j = 1; j <= i__8; ++j) {
00826
00827 i__6 = ku + 2 - j;
00828
00829 i__9 = n + ku + 1 - j, i__10 = kl +
00830 ku + 1;
00831 i__7 = min(i__9,i__10);
00832 for (i__ = max(i__6,1); i__ <= i__7;
00833 ++i__) {
00834
00835 d__2 = anrmpv, d__3 = (d__1 = a[
00836 i__ + (j - 1) * lda], abs(
00837 d__1));
00838 anrmpv = max(d__2,d__3);
00839
00840 }
00841
00842 }
00843
00844 i__7 = info - 1, i__6 = kl + ku;
00845 i__8 = min(i__7,i__6);
00846
00847 i__9 = 1, i__10 = kl + ku + 2 - info;
00848 rpvgrw = dlantb_("M", "U", "N", &info, &
00849 i__8, &afb[max(i__9, i__10)], &
00850 ldafb, &work[1]);
00851 if (rpvgrw == 0.) {
00852 rpvgrw = 1.;
00853 } else {
00854 rpvgrw = anrmpv / rpvgrw;
00855 }
00856 } else {
00857 i__8 = kl + ku;
00858 rpvgrw = dlantb_("M", "U", "N", &n, &i__8,
00859 &afb[1], &ldafb, &work[1]);
00860 if (rpvgrw == 0.) {
00861 rpvgrw = 1.;
00862 } else {
00863 rpvgrw = dlangb_("M", &n, &kl, &ku, &
00864 a[1], &lda, &work[1]) / rpvgrw;
00865 }
00866 }
00867 result[6] = (d__1 = rpvgrw - work[1], abs(
00868 d__1)) / max(work[1],rpvgrw) /
00869 dlamch_("E");
00870
00871 if (! prefac) {
00872
00873
00874
00875
00876 dgbt01_(&n, &n, &kl, &ku, &a[1], &lda, &
00877 afb[1], &ldafb, &iwork[1], &work[
00878 1], result);
00879 k1 = 1;
00880 } else {
00881 k1 = 2;
00882 }
00883
00884 if (info == 0) {
00885 trfcon = FALSE_;
00886
00887
00888
00889 dlacpy_("Full", &n, nrhs, &bsav[1], &ldb,
00890 &work[1], &ldb);
00891 dgbt02_(trans, &n, &n, &kl, &ku, nrhs, &
00892 asav[1], &lda, &x[1], &ldb, &work[
00893 1], &ldb, &result[1]);
00894
00895
00896
00897
00898 if (nofact || prefac && lsame_(equed,
00899 "N")) {
00900 dget04_(&n, nrhs, &x[1], &ldb, &xact[
00901 1], &ldb, &rcondc, &result[2])
00902 ;
00903 } else {
00904 if (itran == 1) {
00905 roldc = roldo;
00906 } else {
00907 roldc = roldi;
00908 }
00909 dget04_(&n, nrhs, &x[1], &ldb, &xact[
00910 1], &ldb, &roldc, &result[2]);
00911 }
00912
00913
00914
00915
00916 dgbt05_(trans, &n, &kl, &ku, nrhs, &asav[
00917 1], &lda, &b[1], &ldb, &x[1], &
00918 ldb, &xact[1], &ldb, &rwork[1], &
00919 rwork[*nrhs + 1], &result[3]);
00920 } else {
00921 trfcon = TRUE_;
00922 }
00923
00924
00925
00926
00927 result[5] = dget06_(&rcond, &rcondc);
00928
00929
00930
00931
00932 if (! trfcon) {
00933 for (k = k1; k <= 7; ++k) {
00934 if (result[k - 1] >= *thresh) {
00935 if (nfail == 0 && nerrs == 0) {
00936 aladhd_(nout, path);
00937 }
00938 if (prefac) {
00939 io___72.ciunit = *nout;
00940 s_wsfe(&io___72);
00941 do_fio(&c__1, "DGBSVX", (ftnlen)6);
00942 do_fio(&c__1, fact, (ftnlen)1);
00943 do_fio(&c__1, trans, (ftnlen)1);
00944 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
00945 do_fio(&c__1, (char *)&kl, (ftnlen)sizeof(integer));
00946 do_fio(&c__1, (char *)&ku, (ftnlen)sizeof(integer));
00947 do_fio(&c__1, equed, (ftnlen)1);
00948 do_fio(&c__1, (char *)&imat, (ftnlen)sizeof(integer)
00949 );
00950 do_fio(&c__1, (char *)&k, (ftnlen)sizeof(integer));
00951 do_fio(&c__1, (char *)&result[k - 1], (ftnlen)
00952 sizeof(doublereal));
00953 e_wsfe();
00954 } else {
00955 io___73.ciunit = *nout;
00956 s_wsfe(&io___73);
00957 do_fio(&c__1, "DGBSVX", (ftnlen)6);
00958 do_fio(&c__1, fact, (ftnlen)1);
00959 do_fio(&c__1, trans, (ftnlen)1);
00960 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
00961 do_fio(&c__1, (char *)&kl, (ftnlen)sizeof(integer));
00962 do_fio(&c__1, (char *)&ku, (ftnlen)sizeof(integer));
00963 do_fio(&c__1, (char *)&imat, (ftnlen)sizeof(integer)
00964 );
00965 do_fio(&c__1, (char *)&k, (ftnlen)sizeof(integer));
00966 do_fio(&c__1, (char *)&result[k - 1], (ftnlen)
00967 sizeof(doublereal));
00968 e_wsfe();
00969 }
00970 ++nfail;
00971 }
00972
00973 }
00974 nrun = nrun + 7 - k1;
00975 } else {
00976 if (result[0] >= *thresh && ! prefac) {
00977 if (nfail == 0 && nerrs == 0) {
00978 aladhd_(nout, path);
00979 }
00980 if (prefac) {
00981 io___74.ciunit = *nout;
00982 s_wsfe(&io___74);
00983 do_fio(&c__1, "DGBSVX", (ftnlen)6)
00984 ;
00985 do_fio(&c__1, fact, (ftnlen)1);
00986 do_fio(&c__1, trans, (ftnlen)1);
00987 do_fio(&c__1, (char *)&n, (ftnlen)
00988 sizeof(integer));
00989 do_fio(&c__1, (char *)&kl, (
00990 ftnlen)sizeof(integer));
00991 do_fio(&c__1, (char *)&ku, (
00992 ftnlen)sizeof(integer));
00993 do_fio(&c__1, equed, (ftnlen)1);
00994 do_fio(&c__1, (char *)&imat, (
00995 ftnlen)sizeof(integer));
00996 do_fio(&c__1, (char *)&c__1, (
00997 ftnlen)sizeof(integer));
00998 do_fio(&c__1, (char *)&result[0],
00999 (ftnlen)sizeof(doublereal)
01000 );
01001 e_wsfe();
01002 } else {
01003 io___75.ciunit = *nout;
01004 s_wsfe(&io___75);
01005 do_fio(&c__1, "DGBSVX", (ftnlen)6)
01006 ;
01007 do_fio(&c__1, fact, (ftnlen)1);
01008 do_fio(&c__1, trans, (ftnlen)1);
01009 do_fio(&c__1, (char *)&n, (ftnlen)
01010 sizeof(integer));
01011 do_fio(&c__1, (char *)&kl, (
01012 ftnlen)sizeof(integer));
01013 do_fio(&c__1, (char *)&ku, (
01014 ftnlen)sizeof(integer));
01015 do_fio(&c__1, (char *)&imat, (
01016 ftnlen)sizeof(integer));
01017 do_fio(&c__1, (char *)&c__1, (
01018 ftnlen)sizeof(integer));
01019 do_fio(&c__1, (char *)&result[0],
01020 (ftnlen)sizeof(doublereal)
01021 );
01022 e_wsfe();
01023 }
01024 ++nfail;
01025 ++nrun;
01026 }
01027 if (result[5] >= *thresh) {
01028 if (nfail == 0 && nerrs == 0) {
01029 aladhd_(nout, path);
01030 }
01031 if (prefac) {
01032 io___76.ciunit = *nout;
01033 s_wsfe(&io___76);
01034 do_fio(&c__1, "DGBSVX", (ftnlen)6)
01035 ;
01036 do_fio(&c__1, fact, (ftnlen)1);
01037 do_fio(&c__1, trans, (ftnlen)1);
01038 do_fio(&c__1, (char *)&n, (ftnlen)
01039 sizeof(integer));
01040 do_fio(&c__1, (char *)&kl, (
01041 ftnlen)sizeof(integer));
01042 do_fio(&c__1, (char *)&ku, (
01043 ftnlen)sizeof(integer));
01044 do_fio(&c__1, equed, (ftnlen)1);
01045 do_fio(&c__1, (char *)&imat, (
01046 ftnlen)sizeof(integer));
01047 do_fio(&c__1, (char *)&c__6, (
01048 ftnlen)sizeof(integer));
01049 do_fio(&c__1, (char *)&result[5],
01050 (ftnlen)sizeof(doublereal)
01051 );
01052 e_wsfe();
01053 } else {
01054 io___77.ciunit = *nout;
01055 s_wsfe(&io___77);
01056 do_fio(&c__1, "DGBSVX", (ftnlen)6)
01057 ;
01058 do_fio(&c__1, fact, (ftnlen)1);
01059 do_fio(&c__1, trans, (ftnlen)1);
01060 do_fio(&c__1, (char *)&n, (ftnlen)
01061 sizeof(integer));
01062 do_fio(&c__1, (char *)&kl, (
01063 ftnlen)sizeof(integer));
01064 do_fio(&c__1, (char *)&ku, (
01065 ftnlen)sizeof(integer));
01066 do_fio(&c__1, (char *)&imat, (
01067 ftnlen)sizeof(integer));
01068 do_fio(&c__1, (char *)&c__6, (
01069 ftnlen)sizeof(integer));
01070 do_fio(&c__1, (char *)&result[5],
01071 (ftnlen)sizeof(doublereal)
01072 );
01073 e_wsfe();
01074 }
01075 ++nfail;
01076 ++nrun;
01077 }
01078 if (result[6] >= *thresh) {
01079 if (nfail == 0 && nerrs == 0) {
01080 aladhd_(nout, path);
01081 }
01082 if (prefac) {
01083 io___78.ciunit = *nout;
01084 s_wsfe(&io___78);
01085 do_fio(&c__1, "DGBSVX", (ftnlen)6)
01086 ;
01087 do_fio(&c__1, fact, (ftnlen)1);
01088 do_fio(&c__1, trans, (ftnlen)1);
01089 do_fio(&c__1, (char *)&n, (ftnlen)
01090 sizeof(integer));
01091 do_fio(&c__1, (char *)&kl, (
01092 ftnlen)sizeof(integer));
01093 do_fio(&c__1, (char *)&ku, (
01094 ftnlen)sizeof(integer));
01095 do_fio(&c__1, equed, (ftnlen)1);
01096 do_fio(&c__1, (char *)&imat, (
01097 ftnlen)sizeof(integer));
01098 do_fio(&c__1, (char *)&c__7, (
01099 ftnlen)sizeof(integer));
01100 do_fio(&c__1, (char *)&result[6],
01101 (ftnlen)sizeof(doublereal)
01102 );
01103 e_wsfe();
01104 } else {
01105 io___79.ciunit = *nout;
01106 s_wsfe(&io___79);
01107 do_fio(&c__1, "DGBSVX", (ftnlen)6)
01108 ;
01109 do_fio(&c__1, fact, (ftnlen)1);
01110 do_fio(&c__1, trans, (ftnlen)1);
01111 do_fio(&c__1, (char *)&n, (ftnlen)
01112 sizeof(integer));
01113 do_fio(&c__1, (char *)&kl, (
01114 ftnlen)sizeof(integer));
01115 do_fio(&c__1, (char *)&ku, (
01116 ftnlen)sizeof(integer));
01117 do_fio(&c__1, (char *)&imat, (
01118 ftnlen)sizeof(integer));
01119 do_fio(&c__1, (char *)&c__7, (
01120 ftnlen)sizeof(integer));
01121 do_fio(&c__1, (char *)&result[6],
01122 (ftnlen)sizeof(doublereal)
01123 );
01124 e_wsfe();
01125 }
01126 ++nfail;
01127 ++nrun;
01128 }
01129
01130 }
01131
01132
01133
01134
01135
01136 i__8 = kl + ku + 1;
01137 dlacpy_("Full", &i__8, &n, &asav[1], &lda, &a[
01138 1], &lda);
01139 dlacpy_("Full", &n, nrhs, &bsav[1], &ldb, &b[
01140 1], &ldb);
01141 if (! prefac) {
01142 i__8 = (kl << 1) + ku + 1;
01143 dlaset_("Full", &i__8, &n, &c_b48, &c_b48,
01144 &afb[1], &ldafb);
01145 }
01146 dlaset_("Full", &n, nrhs, &c_b48, &c_b48, &x[
01147 1], &ldb);
01148 if (iequed > 1 && n > 0) {
01149
01150
01151
01152
01153 dlaqgb_(&n, &n, &kl, &ku, &a[1], &lda, &s[
01154 1], &s[n + 1], &rowcnd, &colcnd, &
01155 amax, equed);
01156 }
01157
01158
01159
01160
01161 s_copy(srnamc_1.srnamt, "DGBSVXX", (ftnlen)32,
01162 (ftnlen)7);
01163 n_err_bnds__ = 3;
01164
01165 dalloc3();
01166
01167 dgbsvxx_(fact, trans, &n, &kl, &ku, nrhs, &a[
01168 1], &lda, &afb[1], &ldafb, &iwork[1],
01169 equed, &s[1], &s[n + 1], &b[1], &ldb,
01170 &x[1], &ldb, &rcond, &rpvgrw_svxx__,
01171 berr, &n_err_bnds__, errbnds_n__,
01172 errbnds_c__, &c__0, &c_b48, &work[1],
01173 &iwork[n + 1], &info);
01174
01175 free3();
01176
01177
01178
01179 if (info == n + 1) {
01180 goto L90;
01181 }
01182 if (info != izero) {
01183
01184 i__11[0] = 1, a__1[0] = fact;
01185 i__11[1] = 1, a__1[1] = trans;
01186 s_cat(ch__1, a__1, i__11, &c__2, (ftnlen)
01187 2);
01188 alaerh_(path, "DGBSVXX", &info, &izero,
01189 ch__1, &n, &n, &c_n1, &c_n1, nrhs,
01190 &imat, &nfail, &nerrs, nout);
01191 goto L90;
01192 }
01193
01194
01195
01196
01197 if (info > 0 && info < n + 1) {
01198 rpvgrw = dla_gbrpvgrw__(&n, &kl, &ku, &
01199 info, &a[1], &lda, &afb[1], &
01200 ldafb);
01201 } else {
01202 rpvgrw = dla_gbrpvgrw__(&n, &kl, &ku, &n,
01203 &a[1], &lda, &afb[1], &ldafb);
01204 }
01205 result[6] = (d__1 = rpvgrw - rpvgrw_svxx__,
01206 abs(d__1)) / max(rpvgrw_svxx__,rpvgrw)
01207 / dlamch_("E");
01208
01209 if (! prefac) {
01210
01211
01212
01213
01214 dgbt01_(&n, &n, &kl, &ku, &a[1], &lda, &
01215 afb[1], &ldafb, &iwork[1], &work[
01216 1], result);
01217 k1 = 1;
01218 } else {
01219 k1 = 2;
01220 }
01221
01222 if (info == 0) {
01223 trfcon = FALSE_;
01224
01225
01226
01227 dlacpy_("Full", &n, nrhs, &bsav[1], &ldb,
01228 &work[1], &ldb);
01229 dgbt02_(trans, &n, &n, &kl, &ku, nrhs, &
01230 asav[1], &lda, &x[1], &ldb, &work[
01231 1], &ldb, &work[1], &result[1]);
01232
01233
01234
01235 if (nofact || prefac && lsame_(equed,
01236 "N")) {
01237 dget04_(&n, nrhs, &x[1], &ldb, &xact[
01238 1], &ldb, &rcondc, &result[2])
01239 ;
01240 } else {
01241 if (itran == 1) {
01242 roldc = roldo;
01243 } else {
01244 roldc = roldi;
01245 }
01246 dget04_(&n, nrhs, &x[1], &ldb, &xact[
01247 1], &ldb, &roldc, &result[2]);
01248 }
01249 } else {
01250 trfcon = TRUE_;
01251 }
01252
01253
01254
01255
01256 result[5] = dget06_(&rcond, &rcondc);
01257
01258
01259
01260
01261 if (! trfcon) {
01262 for (k = k1; k <= 7; ++k) {
01263 if (result[k - 1] >= *thresh) {
01264 if (nfail == 0 && nerrs == 0) {
01265 aladhd_(nout, path);
01266 }
01267 if (prefac) {
01268 io___85.ciunit = *nout;
01269 s_wsfe(&io___85);
01270 do_fio(&c__1, "DGBSVXX", (ftnlen)7);
01271 do_fio(&c__1, fact, (ftnlen)1);
01272 do_fio(&c__1, trans, (ftnlen)1);
01273 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
01274 do_fio(&c__1, (char *)&kl, (ftnlen)sizeof(integer));
01275 do_fio(&c__1, (char *)&ku, (ftnlen)sizeof(integer));
01276 do_fio(&c__1, equed, (ftnlen)1);
01277 do_fio(&c__1, (char *)&imat, (ftnlen)sizeof(integer)
01278 );
01279 do_fio(&c__1, (char *)&k, (ftnlen)sizeof(integer));
01280 do_fio(&c__1, (char *)&result[k - 1], (ftnlen)
01281 sizeof(doublereal));
01282 e_wsfe();
01283 } else {
01284 io___86.ciunit = *nout;
01285 s_wsfe(&io___86);
01286 do_fio(&c__1, "DGBSVXX", (ftnlen)7);
01287 do_fio(&c__1, fact, (ftnlen)1);
01288 do_fio(&c__1, trans, (ftnlen)1);
01289 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
01290 do_fio(&c__1, (char *)&kl, (ftnlen)sizeof(integer));
01291 do_fio(&c__1, (char *)&ku, (ftnlen)sizeof(integer));
01292 do_fio(&c__1, (char *)&imat, (ftnlen)sizeof(integer)
01293 );
01294 do_fio(&c__1, (char *)&k, (ftnlen)sizeof(integer));
01295 do_fio(&c__1, (char *)&result[k - 1], (ftnlen)
01296 sizeof(doublereal));
01297 e_wsfe();
01298 }
01299 ++nfail;
01300 }
01301
01302 }
01303 nrun = nrun + 7 - k1;
01304 } else {
01305 if (result[0] >= *thresh && ! prefac) {
01306 if (nfail == 0 && nerrs == 0) {
01307 aladhd_(nout, path);
01308 }
01309 if (prefac) {
01310 io___87.ciunit = *nout;
01311 s_wsfe(&io___87);
01312 do_fio(&c__1, "DGBSVXX", (ftnlen)
01313 7);
01314 do_fio(&c__1, fact, (ftnlen)1);
01315 do_fio(&c__1, trans, (ftnlen)1);
01316 do_fio(&c__1, (char *)&n, (ftnlen)
01317 sizeof(integer));
01318 do_fio(&c__1, (char *)&kl, (
01319 ftnlen)sizeof(integer));
01320 do_fio(&c__1, (char *)&ku, (
01321 ftnlen)sizeof(integer));
01322 do_fio(&c__1, equed, (ftnlen)1);
01323 do_fio(&c__1, (char *)&imat, (
01324 ftnlen)sizeof(integer));
01325 do_fio(&c__1, (char *)&c__1, (
01326 ftnlen)sizeof(integer));
01327 do_fio(&c__1, (char *)&result[0],
01328 (ftnlen)sizeof(doublereal)
01329 );
01330 e_wsfe();
01331 } else {
01332 io___88.ciunit = *nout;
01333 s_wsfe(&io___88);
01334 do_fio(&c__1, "DGBSVXX", (ftnlen)
01335 7);
01336 do_fio(&c__1, fact, (ftnlen)1);
01337 do_fio(&c__1, trans, (ftnlen)1);
01338 do_fio(&c__1, (char *)&n, (ftnlen)
01339 sizeof(integer));
01340 do_fio(&c__1, (char *)&kl, (
01341 ftnlen)sizeof(integer));
01342 do_fio(&c__1, (char *)&ku, (
01343 ftnlen)sizeof(integer));
01344 do_fio(&c__1, (char *)&imat, (
01345 ftnlen)sizeof(integer));
01346 do_fio(&c__1, (char *)&c__1, (
01347 ftnlen)sizeof(integer));
01348 do_fio(&c__1, (char *)&result[0],
01349 (ftnlen)sizeof(doublereal)
01350 );
01351 e_wsfe();
01352 }
01353 ++nfail;
01354 ++nrun;
01355 }
01356 if (result[5] >= *thresh) {
01357 if (nfail == 0 && nerrs == 0) {
01358 aladhd_(nout, path);
01359 }
01360 if (prefac) {
01361 io___89.ciunit = *nout;
01362 s_wsfe(&io___89);
01363 do_fio(&c__1, "DGBSVXX", (ftnlen)
01364 7);
01365 do_fio(&c__1, fact, (ftnlen)1);
01366 do_fio(&c__1, trans, (ftnlen)1);
01367 do_fio(&c__1, (char *)&n, (ftnlen)
01368 sizeof(integer));
01369 do_fio(&c__1, (char *)&kl, (
01370 ftnlen)sizeof(integer));
01371 do_fio(&c__1, (char *)&ku, (
01372 ftnlen)sizeof(integer));
01373 do_fio(&c__1, equed, (ftnlen)1);
01374 do_fio(&c__1, (char *)&imat, (
01375 ftnlen)sizeof(integer));
01376 do_fio(&c__1, (char *)&c__6, (
01377 ftnlen)sizeof(integer));
01378 do_fio(&c__1, (char *)&result[5],
01379 (ftnlen)sizeof(doublereal)
01380 );
01381 e_wsfe();
01382 } else {
01383 io___90.ciunit = *nout;
01384 s_wsfe(&io___90);
01385 do_fio(&c__1, "DGBSVXX", (ftnlen)
01386 7);
01387 do_fio(&c__1, fact, (ftnlen)1);
01388 do_fio(&c__1, trans, (ftnlen)1);
01389 do_fio(&c__1, (char *)&n, (ftnlen)
01390 sizeof(integer));
01391 do_fio(&c__1, (char *)&kl, (
01392 ftnlen)sizeof(integer));
01393 do_fio(&c__1, (char *)&ku, (
01394 ftnlen)sizeof(integer));
01395 do_fio(&c__1, (char *)&imat, (
01396 ftnlen)sizeof(integer));
01397 do_fio(&c__1, (char *)&c__6, (
01398 ftnlen)sizeof(integer));
01399 do_fio(&c__1, (char *)&result[5],
01400 (ftnlen)sizeof(doublereal)
01401 );
01402 e_wsfe();
01403 }
01404 ++nfail;
01405 ++nrun;
01406 }
01407 if (result[6] >= *thresh) {
01408 if (nfail == 0 && nerrs == 0) {
01409 aladhd_(nout, path);
01410 }
01411 if (prefac) {
01412 io___91.ciunit = *nout;
01413 s_wsfe(&io___91);
01414 do_fio(&c__1, "DGBSVXX", (ftnlen)
01415 7);
01416 do_fio(&c__1, fact, (ftnlen)1);
01417 do_fio(&c__1, trans, (ftnlen)1);
01418 do_fio(&c__1, (char *)&n, (ftnlen)
01419 sizeof(integer));
01420 do_fio(&c__1, (char *)&kl, (
01421 ftnlen)sizeof(integer));
01422 do_fio(&c__1, (char *)&ku, (
01423 ftnlen)sizeof(integer));
01424 do_fio(&c__1, equed, (ftnlen)1);
01425 do_fio(&c__1, (char *)&imat, (
01426 ftnlen)sizeof(integer));
01427 do_fio(&c__1, (char *)&c__7, (
01428 ftnlen)sizeof(integer));
01429 do_fio(&c__1, (char *)&result[6],
01430 (ftnlen)sizeof(doublereal)
01431 );
01432 e_wsfe();
01433 } else {
01434 io___92.ciunit = *nout;
01435 s_wsfe(&io___92);
01436 do_fio(&c__1, "DGBSVXX", (ftnlen)
01437 7);
01438 do_fio(&c__1, fact, (ftnlen)1);
01439 do_fio(&c__1, trans, (ftnlen)1);
01440 do_fio(&c__1, (char *)&n, (ftnlen)
01441 sizeof(integer));
01442 do_fio(&c__1, (char *)&kl, (
01443 ftnlen)sizeof(integer));
01444 do_fio(&c__1, (char *)&ku, (
01445 ftnlen)sizeof(integer));
01446 do_fio(&c__1, (char *)&imat, (
01447 ftnlen)sizeof(integer));
01448 do_fio(&c__1, (char *)&c__7, (
01449 ftnlen)sizeof(integer));
01450 do_fio(&c__1, (char *)&result[6],
01451 (ftnlen)sizeof(doublereal)
01452 );
01453 e_wsfe();
01454 }
01455 ++nfail;
01456 ++nrun;
01457 }
01458
01459 }
01460 L90:
01461 ;
01462 }
01463 L100:
01464 ;
01465 }
01466
01467 }
01468 L120:
01469 ;
01470 }
01471 L130:
01472 ;
01473 }
01474
01475 }
01476
01477 }
01478
01479
01480
01481 alasvm_(path, nout, &nfail, &nrun, &nerrs);
01482
01483 debchvxx_(thresh, path);
01484
01485 return 0;
01486
01487
01488
01489 }