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