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_b20 = {0.,0.};
00038 static logical c_true = TRUE_;
00039 static integer c__6 = 6;
00040 static integer c__7 = 7;
00041 static doublereal c_b166 = 0.;
00042
00043 int zdrvge_(logical *dotype, integer *nn, integer *nval,
00044 integer *nrhs, doublereal *thresh, logical *tsterr, integer *nmax,
00045 doublecomplex *a, doublecomplex *afac, 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[] = "(1x,a,\002, N =\002,i5,\002, type \002,i2,\002"
00059 ", test(\002,i2,\002) =\002,g12.5)";
00060 static char fmt_9997[] = "(1x,a,\002, FACT='\002,a1,\002', TRANS='\002,a"
00061 "1,\002', N=\002,i5,\002, EQUED='\002,a1,\002', type \002,i2,\002"
00062 ", test(\002,i1,\002)=\002,g12.5)";
00063 static char fmt_9998[] = "(1x,a,\002, FACT='\002,a1,\002', TRANS='\002,a"
00064 "1,\002', N=\002,i5,\002, type \002,i2,\002, test(\002,i1,\002)"
00065 "=\002,g12.5)";
00066
00067
00068 address a__1[2];
00069 integer i__1, i__2, i__3, i__4, i__5[2];
00070 doublereal d__1, d__2;
00071 char ch__1[2];
00072
00073
00074 int s_copy(char *, char *, ftnlen, ftnlen);
00075 integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void);
00076 int s_cat(char *, char **, integer *, integer *, ftnlen);
00077
00078
00079 extern int zebchvxx_(doublereal *, char *);
00080 integer i__, k, n;
00081 doublereal *errbnds_c__, *errbnds_n__;
00082 integer k1, nb, in, kl, ku, nt, n_err_bnds__;
00083 extern doublereal zla_rpvgrw__(integer *, integer *, doublecomplex *,
00084 integer *, doublecomplex *, integer *);
00085 integer lda;
00086 char fact[1];
00087 integer ioff, mode;
00088 doublereal amax;
00089 char path[3];
00090 integer imat, info;
00091 doublereal *berr;
00092 char dist[1];
00093 doublereal rdum[1], rpvgrw_svxx__;
00094 char type__[1];
00095 integer nrun, ifact, nfail, iseed[4], nfact;
00096 extern doublereal dget06_(doublereal *, doublereal *);
00097 extern logical lsame_(char *, char *);
00098 char equed[1];
00099 integer nbmin;
00100 doublereal rcond, roldc;
00101 integer nimat;
00102 doublereal roldi;
00103 extern int zget01_(integer *, integer *, doublecomplex *,
00104 integer *, doublecomplex *, integer *, integer *, doublereal *,
00105 doublereal *), zget02_(char *, integer *, integer *, integer *,
00106 doublecomplex *, integer *, doublecomplex *, integer *,
00107 doublecomplex *, integer *, doublereal *, doublereal *);
00108 doublereal anorm;
00109 integer itran;
00110 extern int zget04_(integer *, integer *, doublecomplex *,
00111 integer *, doublecomplex *, integer *, doublereal *, doublereal *
00112 );
00113 logical equil;
00114 doublereal roldo;
00115 extern int zget07_(char *, integer *, integer *,
00116 doublecomplex *, integer *, doublecomplex *, integer *,
00117 doublecomplex *, integer *, doublecomplex *, integer *,
00118 doublereal *, logical *, doublereal *, doublereal *);
00119 char trans[1];
00120 integer izero, nerrs, lwork;
00121 extern int zgesv_(integer *, integer *, doublecomplex *,
00122 integer *, integer *, doublecomplex *, integer *, integer *);
00123 logical zerot;
00124 char xtype[1];
00125 extern int zlatb4_(char *, integer *, integer *, integer
00126 *, char *, integer *, integer *, doublereal *, integer *,
00127 doublereal *, char *), aladhd_(integer *,
00128 char *);
00129 extern doublereal dlamch_(char *);
00130 extern int alaerh_(char *, char *, integer *, integer *,
00131 char *, integer *, integer *, integer *, integer *, integer *,
00132 integer *, integer *, integer *, integer *);
00133 logical prefac;
00134 doublereal colcnd, rcondc;
00135 logical nofact;
00136 integer iequed;
00137 doublereal rcondi;
00138 extern doublereal zlange_(char *, integer *, integer *, doublecomplex *,
00139 integer *, doublereal *);
00140 extern int alasvm_(char *, integer *, integer *, integer
00141 *, integer *);
00142 doublereal cndnum, anormi, rcondo, ainvnm;
00143 extern int zlaqge_(integer *, integer *, doublecomplex *,
00144 integer *, doublereal *, doublereal *, doublereal *, doublereal *
00145 , doublereal *, char *);
00146 logical trfcon;
00147 doublereal anormo, rowcnd;
00148 extern int xlaenv_(integer *, integer *), zgeequ_(
00149 integer *, integer *, doublecomplex *, integer *, doublereal *,
00150 doublereal *, doublereal *, doublereal *, doublereal *, integer *)
00151 , zgetrf_(integer *, integer *, doublecomplex *, integer *,
00152 integer *, integer *), zlacpy_(char *, integer *, integer *,
00153 doublecomplex *, integer *, doublecomplex *, integer *),
00154 zgetri_(integer *, doublecomplex *, integer *, integer *,
00155 doublecomplex *, integer *, integer *), zlarhs_(char *, char *,
00156 char *, char *, integer *, integer *, integer *, integer *,
00157 integer *, doublecomplex *, integer *, doublecomplex *, integer *,
00158 doublecomplex *, integer *, integer *, integer *), zlaset_();
00159 extern doublereal zlantr_(char *, char *, char *, integer *, integer *,
00160 doublecomplex *, integer *, doublereal *);
00161 extern int zlatms_(integer *, integer *, char *, integer
00162 *, char *, doublereal *, integer *, doublereal *, doublereal *,
00163 integer *, integer *, char *, doublecomplex *, integer *,
00164 doublecomplex *, integer *);
00165 doublereal result[7];
00166 extern int zgesvx_(char *, char *, integer *, integer *,
00167 doublecomplex *, integer *, doublecomplex *, integer *, integer *,
00168 char *, doublereal *, doublereal *, doublecomplex *, integer *,
00169 doublecomplex *, integer *, doublereal *, doublereal *,
00170 doublereal *, doublecomplex *, doublereal *, integer *);
00171 doublereal rpvgrw;
00172 extern int zerrvx_(char *, integer *), zgesvxx_(
00173 char *, char *, integer *, integer *, doublecomplex *, integer *,
00174 doublecomplex *, integer *, integer *, char *, doublereal *,
00175 doublereal *, doublecomplex *, integer *, doublecomplex *,
00176 integer *, doublereal *, doublereal *, doublereal *, integer *,
00177 doublereal *, doublereal *, integer *, doublereal *,
00178 doublecomplex *, doublereal *, integer *);
00179
00180
00181 static cilist io___55 = { 0, 0, 0, fmt_9999, 0 };
00182 static cilist io___62 = { 0, 0, 0, fmt_9997, 0 };
00183 static cilist io___63 = { 0, 0, 0, fmt_9998, 0 };
00184 static cilist io___64 = { 0, 0, 0, fmt_9997, 0 };
00185 static cilist io___65 = { 0, 0, 0, fmt_9998, 0 };
00186 static cilist io___66 = { 0, 0, 0, fmt_9997, 0 };
00187 static cilist io___67 = { 0, 0, 0, fmt_9998, 0 };
00188 static cilist io___68 = { 0, 0, 0, fmt_9997, 0 };
00189 static cilist io___69 = { 0, 0, 0, fmt_9998, 0 };
00190 static cilist io___75 = { 0, 0, 0, fmt_9997, 0 };
00191 static cilist io___76 = { 0, 0, 0, fmt_9998, 0 };
00192 static cilist io___77 = { 0, 0, 0, fmt_9997, 0 };
00193 static cilist io___78 = { 0, 0, 0, fmt_9998, 0 };
00194 static cilist io___79 = { 0, 0, 0, fmt_9997, 0 };
00195 static cilist io___80 = { 0, 0, 0, fmt_9998, 0 };
00196 static cilist io___81 = { 0, 0, 0, fmt_9997, 0 };
00197 static cilist io___82 = { 0, 0, 0, fmt_9998, 0 };
00198
00199
00200
00201
00202
00203
00204
00205
00206
00207
00208
00209
00210
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 --iwork;
00295 --rwork;
00296 --work;
00297 --s;
00298 --xact;
00299 --x;
00300 --bsav;
00301 --b;
00302 --asav;
00303 --afac;
00304 --a;
00305 --nval;
00306 --dotype;
00307
00308
00309
00310
00311
00312
00313
00314 s_copy(path, "Zomplex precision", (ftnlen)1, (ftnlen)17);
00315 s_copy(path + 1, "GE", (ftnlen)2, (ftnlen)2);
00316 nrun = 0;
00317 nfail = 0;
00318 nerrs = 0;
00319 for (i__ = 1; i__ <= 4; ++i__) {
00320 iseed[i__ - 1] = iseedy[i__ - 1];
00321
00322 }
00323
00324
00325
00326 if (*tsterr) {
00327 zerrvx_(path, nout);
00328 }
00329 infoc_1.infot = 0;
00330
00331
00332
00333 nb = 1;
00334 nbmin = 2;
00335 xlaenv_(&c__1, &nb);
00336 xlaenv_(&c__2, &nbmin);
00337
00338
00339
00340 i__1 = *nn;
00341 for (in = 1; in <= i__1; ++in) {
00342 n = nval[in];
00343 lda = max(n,1);
00344 *(unsigned char *)xtype = 'N';
00345 nimat = 11;
00346 if (n <= 0) {
00347 nimat = 1;
00348 }
00349
00350 i__2 = nimat;
00351 for (imat = 1; imat <= i__2; ++imat) {
00352
00353
00354
00355 if (! dotype[imat]) {
00356 goto L80;
00357 }
00358
00359
00360
00361 zerot = imat >= 5 && imat <= 7;
00362 if (zerot && n < imat - 4) {
00363 goto L80;
00364 }
00365
00366
00367
00368
00369 zlatb4_(path, &imat, &n, &n, type__, &kl, &ku, &anorm, &mode, &
00370 cndnum, dist);
00371 rcondc = 1. / cndnum;
00372
00373 s_copy(srnamc_1.srnamt, "ZLATMS", (ftnlen)32, (ftnlen)6);
00374 zlatms_(&n, &n, dist, iseed, type__, &rwork[1], &mode, &cndnum, &
00375 anorm, &kl, &ku, "No packing", &a[1], &lda, &work[1], &
00376 info);
00377
00378
00379
00380 if (info != 0) {
00381 alaerh_(path, "ZLATMS", &info, &c__0, " ", &n, &n, &c_n1, &
00382 c_n1, &c_n1, &imat, &nfail, &nerrs, nout);
00383 goto L80;
00384 }
00385
00386
00387
00388
00389 if (zerot) {
00390 if (imat == 5) {
00391 izero = 1;
00392 } else if (imat == 6) {
00393 izero = n;
00394 } else {
00395 izero = n / 2 + 1;
00396 }
00397 ioff = (izero - 1) * lda;
00398 if (imat < 7) {
00399 i__3 = n;
00400 for (i__ = 1; i__ <= i__3; ++i__) {
00401 i__4 = ioff + i__;
00402 a[i__4].r = 0., a[i__4].i = 0.;
00403
00404 }
00405 } else {
00406 i__3 = n - izero + 1;
00407 zlaset_("Full", &n, &i__3, &c_b20, &c_b20, &a[ioff + 1], &
00408 lda);
00409 }
00410 } else {
00411 izero = 0;
00412 }
00413
00414
00415
00416 zlacpy_("Full", &n, &n, &a[1], &lda, &asav[1], &lda);
00417
00418 for (iequed = 1; iequed <= 4; ++iequed) {
00419 *(unsigned char *)equed = *(unsigned char *)&equeds[iequed -
00420 1];
00421 if (iequed == 1) {
00422 nfact = 3;
00423 } else {
00424 nfact = 1;
00425 }
00426
00427 i__3 = nfact;
00428 for (ifact = 1; ifact <= i__3; ++ifact) {
00429 *(unsigned char *)fact = *(unsigned char *)&facts[ifact -
00430 1];
00431 prefac = lsame_(fact, "F");
00432 nofact = lsame_(fact, "N");
00433 equil = lsame_(fact, "E");
00434
00435 if (zerot) {
00436 if (prefac) {
00437 goto L60;
00438 }
00439 rcondo = 0.;
00440 rcondi = 0.;
00441
00442 } else if (! nofact) {
00443
00444
00445
00446
00447
00448
00449 zlacpy_("Full", &n, &n, &asav[1], &lda, &afac[1], &
00450 lda);
00451 if (equil || iequed > 1) {
00452
00453
00454
00455
00456 zgeequ_(&n, &n, &afac[1], &lda, &s[1], &s[n + 1],
00457 &rowcnd, &colcnd, &amax, &info);
00458 if (info == 0 && n > 0) {
00459 if (lsame_(equed, "R"))
00460 {
00461 rowcnd = 0.;
00462 colcnd = 1.;
00463 } else if (lsame_(equed, "C")) {
00464 rowcnd = 1.;
00465 colcnd = 0.;
00466 } else if (lsame_(equed, "B")) {
00467 rowcnd = 0.;
00468 colcnd = 0.;
00469 }
00470
00471
00472
00473 zlaqge_(&n, &n, &afac[1], &lda, &s[1], &s[n +
00474 1], &rowcnd, &colcnd, &amax, equed);
00475 }
00476 }
00477
00478
00479
00480
00481 if (equil) {
00482 roldo = rcondo;
00483 roldi = rcondi;
00484 }
00485
00486
00487
00488 anormo = zlange_("1", &n, &n, &afac[1], &lda, &rwork[
00489 1]);
00490 anormi = zlange_("I", &n, &n, &afac[1], &lda, &rwork[
00491 1]);
00492
00493
00494
00495 zgetrf_(&n, &n, &afac[1], &lda, &iwork[1], &info);
00496
00497
00498
00499 zlacpy_("Full", &n, &n, &afac[1], &lda, &a[1], &lda);
00500 lwork = *nmax * max(3,*nrhs);
00501 zgetri_(&n, &a[1], &lda, &iwork[1], &work[1], &lwork,
00502 &info);
00503
00504
00505
00506 ainvnm = zlange_("1", &n, &n, &a[1], &lda, &rwork[1]);
00507 if (anormo <= 0. || ainvnm <= 0.) {
00508 rcondo = 1.;
00509 } else {
00510 rcondo = 1. / anormo / ainvnm;
00511 }
00512
00513
00514
00515 ainvnm = zlange_("I", &n, &n, &a[1], &lda, &rwork[1]);
00516 if (anormi <= 0. || ainvnm <= 0.) {
00517 rcondi = 1.;
00518 } else {
00519 rcondi = 1. / anormi / ainvnm;
00520 }
00521 }
00522
00523 for (itran = 1; itran <= 3; ++itran) {
00524 for (i__ = 1; i__ <= 7; ++i__) {
00525 result[i__ - 1] = 0.;
00526 }
00527
00528
00529
00530 *(unsigned char *)trans = *(unsigned char *)&transs[
00531 itran - 1];
00532 if (itran == 1) {
00533 rcondc = rcondo;
00534 } else {
00535 rcondc = rcondi;
00536 }
00537
00538
00539
00540 zlacpy_("Full", &n, &n, &asav[1], &lda, &a[1], &lda);
00541
00542
00543
00544 s_copy(srnamc_1.srnamt, "ZLARHS", (ftnlen)32, (ftnlen)
00545 6);
00546 zlarhs_(path, xtype, "Full", trans, &n, &n, &kl, &ku,
00547 nrhs, &a[1], &lda, &xact[1], &lda, &b[1], &
00548 lda, iseed, &info);
00549 *(unsigned char *)xtype = 'C';
00550 zlacpy_("Full", &n, nrhs, &b[1], &lda, &bsav[1], &lda);
00551
00552 if (nofact && itran == 1) {
00553
00554
00555
00556
00557
00558
00559 zlacpy_("Full", &n, &n, &a[1], &lda, &afac[1], &
00560 lda);
00561 zlacpy_("Full", &n, nrhs, &b[1], &lda, &x[1], &
00562 lda);
00563
00564 s_copy(srnamc_1.srnamt, "ZGESV ", (ftnlen)32, (
00565 ftnlen)6);
00566 zgesv_(&n, nrhs, &afac[1], &lda, &iwork[1], &x[1],
00567 &lda, &info);
00568
00569
00570
00571 if (info != izero) {
00572 alaerh_(path, "ZGESV ", &info, &izero, " ", &
00573 n, &n, &c_n1, &c_n1, nrhs, &imat, &
00574 nfail, &nerrs, nout);
00575 goto L50;
00576 }
00577
00578
00579
00580
00581 zget01_(&n, &n, &a[1], &lda, &afac[1], &lda, &
00582 iwork[1], &rwork[1], result);
00583 nt = 1;
00584 if (izero == 0) {
00585
00586
00587
00588 zlacpy_("Full", &n, nrhs, &b[1], &lda, &work[
00589 1], &lda);
00590 zget02_("No transpose", &n, &n, nrhs, &a[1], &
00591 lda, &x[1], &lda, &work[1], &lda, &
00592 rwork[1], &result[1]);
00593
00594
00595
00596 zget04_(&n, nrhs, &x[1], &lda, &xact[1], &lda,
00597 &rcondc, &result[2]);
00598 nt = 3;
00599 }
00600
00601
00602
00603
00604 i__4 = nt;
00605 for (k = 1; k <= i__4; ++k) {
00606 if (result[k - 1] >= *thresh) {
00607 if (nfail == 0 && nerrs == 0) {
00608 aladhd_(nout, path);
00609 }
00610 io___55.ciunit = *nout;
00611 s_wsfe(&io___55);
00612 do_fio(&c__1, "ZGESV ", (ftnlen)6);
00613 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(
00614 integer));
00615 do_fio(&c__1, (char *)&imat, (ftnlen)
00616 sizeof(integer));
00617 do_fio(&c__1, (char *)&k, (ftnlen)sizeof(
00618 integer));
00619 do_fio(&c__1, (char *)&result[k - 1], (
00620 ftnlen)sizeof(doublereal));
00621 e_wsfe();
00622 ++nfail;
00623 }
00624
00625 }
00626 nrun += nt;
00627 }
00628
00629
00630
00631 if (! prefac) {
00632 zlaset_("Full", &n, &n, &c_b20, &c_b20, &afac[1],
00633 &lda);
00634 }
00635 zlaset_("Full", &n, nrhs, &c_b20, &c_b20, &x[1], &lda);
00636 if (iequed > 1 && n > 0) {
00637
00638
00639
00640
00641 zlaqge_(&n, &n, &a[1], &lda, &s[1], &s[n + 1], &
00642 rowcnd, &colcnd, &amax, equed);
00643 }
00644
00645
00646
00647
00648 s_copy(srnamc_1.srnamt, "ZGESVX", (ftnlen)32, (ftnlen)
00649 6);
00650 zgesvx_(fact, trans, &n, nrhs, &a[1], &lda, &afac[1],
00651 &lda, &iwork[1], equed, &s[1], &s[n + 1], &b[
00652 1], &lda, &x[1], &lda, &rcond, &rwork[1], &
00653 rwork[*nrhs + 1], &work[1], &rwork[(*nrhs <<
00654 1) + 1], &info);
00655
00656
00657
00658 if (info == n + 1) {
00659 goto L50;
00660 }
00661 if (info != izero) {
00662
00663 i__5[0] = 1, a__1[0] = fact;
00664 i__5[1] = 1, a__1[1] = trans;
00665 s_cat(ch__1, a__1, i__5, &c__2, (ftnlen)2);
00666 alaerh_(path, "ZGESVX", &info, &izero, ch__1, &n,
00667 &n, &c_n1, &c_n1, nrhs, &imat, &nfail, &
00668 nerrs, nout);
00669 goto L50;
00670 }
00671
00672
00673
00674
00675 if (info != 0) {
00676 rpvgrw = zlantr_("M", "U", "N", &info, &info, &
00677 afac[1], &lda, rdum);
00678 if (rpvgrw == 0.) {
00679 rpvgrw = 1.;
00680 } else {
00681 rpvgrw = zlange_("M", &n, &info, &a[1], &lda,
00682 rdum) / rpvgrw;
00683 }
00684 } else {
00685 rpvgrw = zlantr_("M", "U", "N", &n, &n, &afac[1],
00686 &lda, rdum);
00687 if (rpvgrw == 0.) {
00688 rpvgrw = 1.;
00689 } else {
00690 rpvgrw = zlange_("M", &n, &n, &a[1], &lda,
00691 rdum) / rpvgrw;
00692 }
00693 }
00694
00695 d__2 = rwork[(*nrhs << 1) + 1];
00696 result[6] = (d__1 = rpvgrw - rwork[(*nrhs << 1) + 1],
00697 abs(d__1)) / max(d__2,rpvgrw) / dlamch_("E");
00698
00699 if (! prefac) {
00700
00701
00702
00703
00704 zget01_(&n, &n, &a[1], &lda, &afac[1], &lda, &
00705 iwork[1], &rwork[(*nrhs << 1) + 1],
00706 result);
00707 k1 = 1;
00708 } else {
00709 k1 = 2;
00710 }
00711
00712 if (info == 0) {
00713 trfcon = FALSE_;
00714
00715
00716
00717 zlacpy_("Full", &n, nrhs, &bsav[1], &lda, &work[1]
00718 , &lda);
00719 zget02_(trans, &n, &n, nrhs, &asav[1], &lda, &x[1]
00720 , &lda, &work[1], &lda, &rwork[(*nrhs <<
00721 1) + 1], &result[1]);
00722
00723
00724
00725 if (nofact || prefac && lsame_(equed, "N")) {
00726 zget04_(&n, nrhs, &x[1], &lda, &xact[1], &lda,
00727 &rcondc, &result[2]);
00728 } else {
00729 if (itran == 1) {
00730 roldc = roldo;
00731 } else {
00732 roldc = roldi;
00733 }
00734 zget04_(&n, nrhs, &x[1], &lda, &xact[1], &lda,
00735 &roldc, &result[2]);
00736 }
00737
00738
00739
00740
00741 zget07_(trans, &n, nrhs, &asav[1], &lda, &b[1], &
00742 lda, &x[1], &lda, &xact[1], &lda, &rwork[
00743 1], &c_true, &rwork[*nrhs + 1], &result[3]
00744 );
00745 } else {
00746 trfcon = TRUE_;
00747 }
00748
00749
00750
00751
00752 result[5] = dget06_(&rcond, &rcondc);
00753
00754
00755
00756
00757 if (! trfcon) {
00758 for (k = k1; k <= 7; ++k) {
00759 if (result[k - 1] >= *thresh) {
00760 if (nfail == 0 && nerrs == 0) {
00761 aladhd_(nout, path);
00762 }
00763 if (prefac) {
00764 io___62.ciunit = *nout;
00765 s_wsfe(&io___62);
00766 do_fio(&c__1, "ZGESVX", (ftnlen)6);
00767 do_fio(&c__1, fact, (ftnlen)1);
00768 do_fio(&c__1, trans, (ftnlen)1);
00769 do_fio(&c__1, (char *)&n, (ftnlen)
00770 sizeof(integer));
00771 do_fio(&c__1, equed, (ftnlen)1);
00772 do_fio(&c__1, (char *)&imat, (ftnlen)
00773 sizeof(integer));
00774 do_fio(&c__1, (char *)&k, (ftnlen)
00775 sizeof(integer));
00776 do_fio(&c__1, (char *)&result[k - 1],
00777 (ftnlen)sizeof(doublereal));
00778 e_wsfe();
00779 } else {
00780 io___63.ciunit = *nout;
00781 s_wsfe(&io___63);
00782 do_fio(&c__1, "ZGESVX", (ftnlen)6);
00783 do_fio(&c__1, fact, (ftnlen)1);
00784 do_fio(&c__1, trans, (ftnlen)1);
00785 do_fio(&c__1, (char *)&n, (ftnlen)
00786 sizeof(integer));
00787 do_fio(&c__1, (char *)&imat, (ftnlen)
00788 sizeof(integer));
00789 do_fio(&c__1, (char *)&k, (ftnlen)
00790 sizeof(integer));
00791 do_fio(&c__1, (char *)&result[k - 1],
00792 (ftnlen)sizeof(doublereal));
00793 e_wsfe();
00794 }
00795 ++nfail;
00796 }
00797
00798 }
00799 nrun = nrun + 7 - k1;
00800 } else {
00801 if (result[0] >= *thresh && ! prefac) {
00802 if (nfail == 0 && nerrs == 0) {
00803 aladhd_(nout, path);
00804 }
00805 if (prefac) {
00806 io___64.ciunit = *nout;
00807 s_wsfe(&io___64);
00808 do_fio(&c__1, "ZGESVX", (ftnlen)6);
00809 do_fio(&c__1, fact, (ftnlen)1);
00810 do_fio(&c__1, trans, (ftnlen)1);
00811 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(
00812 integer));
00813 do_fio(&c__1, equed, (ftnlen)1);
00814 do_fio(&c__1, (char *)&imat, (ftnlen)
00815 sizeof(integer));
00816 do_fio(&c__1, (char *)&c__1, (ftnlen)
00817 sizeof(integer));
00818 do_fio(&c__1, (char *)&result[0], (ftnlen)
00819 sizeof(doublereal));
00820 e_wsfe();
00821 } else {
00822 io___65.ciunit = *nout;
00823 s_wsfe(&io___65);
00824 do_fio(&c__1, "ZGESVX", (ftnlen)6);
00825 do_fio(&c__1, fact, (ftnlen)1);
00826 do_fio(&c__1, trans, (ftnlen)1);
00827 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(
00828 integer));
00829 do_fio(&c__1, (char *)&imat, (ftnlen)
00830 sizeof(integer));
00831 do_fio(&c__1, (char *)&c__1, (ftnlen)
00832 sizeof(integer));
00833 do_fio(&c__1, (char *)&result[0], (ftnlen)
00834 sizeof(doublereal));
00835 e_wsfe();
00836 }
00837 ++nfail;
00838 ++nrun;
00839 }
00840 if (result[5] >= *thresh) {
00841 if (nfail == 0 && nerrs == 0) {
00842 aladhd_(nout, path);
00843 }
00844 if (prefac) {
00845 io___66.ciunit = *nout;
00846 s_wsfe(&io___66);
00847 do_fio(&c__1, "ZGESVX", (ftnlen)6);
00848 do_fio(&c__1, fact, (ftnlen)1);
00849 do_fio(&c__1, trans, (ftnlen)1);
00850 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(
00851 integer));
00852 do_fio(&c__1, equed, (ftnlen)1);
00853 do_fio(&c__1, (char *)&imat, (ftnlen)
00854 sizeof(integer));
00855 do_fio(&c__1, (char *)&c__6, (ftnlen)
00856 sizeof(integer));
00857 do_fio(&c__1, (char *)&result[5], (ftnlen)
00858 sizeof(doublereal));
00859 e_wsfe();
00860 } else {
00861 io___67.ciunit = *nout;
00862 s_wsfe(&io___67);
00863 do_fio(&c__1, "ZGESVX", (ftnlen)6);
00864 do_fio(&c__1, fact, (ftnlen)1);
00865 do_fio(&c__1, trans, (ftnlen)1);
00866 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(
00867 integer));
00868 do_fio(&c__1, (char *)&imat, (ftnlen)
00869 sizeof(integer));
00870 do_fio(&c__1, (char *)&c__6, (ftnlen)
00871 sizeof(integer));
00872 do_fio(&c__1, (char *)&result[5], (ftnlen)
00873 sizeof(doublereal));
00874 e_wsfe();
00875 }
00876 ++nfail;
00877 ++nrun;
00878 }
00879 if (result[6] >= *thresh) {
00880 if (nfail == 0 && nerrs == 0) {
00881 aladhd_(nout, path);
00882 }
00883 if (prefac) {
00884 io___68.ciunit = *nout;
00885 s_wsfe(&io___68);
00886 do_fio(&c__1, "ZGESVX", (ftnlen)6);
00887 do_fio(&c__1, fact, (ftnlen)1);
00888 do_fio(&c__1, trans, (ftnlen)1);
00889 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(
00890 integer));
00891 do_fio(&c__1, equed, (ftnlen)1);
00892 do_fio(&c__1, (char *)&imat, (ftnlen)
00893 sizeof(integer));
00894 do_fio(&c__1, (char *)&c__7, (ftnlen)
00895 sizeof(integer));
00896 do_fio(&c__1, (char *)&result[6], (ftnlen)
00897 sizeof(doublereal));
00898 e_wsfe();
00899 } else {
00900 io___69.ciunit = *nout;
00901 s_wsfe(&io___69);
00902 do_fio(&c__1, "ZGESVX", (ftnlen)6);
00903 do_fio(&c__1, fact, (ftnlen)1);
00904 do_fio(&c__1, trans, (ftnlen)1);
00905 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(
00906 integer));
00907 do_fio(&c__1, (char *)&imat, (ftnlen)
00908 sizeof(integer));
00909 do_fio(&c__1, (char *)&c__7, (ftnlen)
00910 sizeof(integer));
00911 do_fio(&c__1, (char *)&result[6], (ftnlen)
00912 sizeof(doublereal));
00913 e_wsfe();
00914 }
00915 ++nfail;
00916 ++nrun;
00917 }
00918
00919 }
00920
00921
00922
00923
00924
00925 zlacpy_("Full", &n, &n, &asav[1], &lda, &a[1], &lda);
00926 zlacpy_("Full", &n, nrhs, &bsav[1], &lda, &b[1], &lda);
00927 if (! prefac) {
00928 zlaset_("Full", &n, &n, &c_b166, &c_b166, &afac[1]
00929 , &lda);
00930 }
00931 zlaset_("Full", &n, nrhs, &c_b166, &c_b166, &x[1], &
00932 lda);
00933 if (iequed > 1 && n > 0) {
00934
00935
00936
00937
00938 zlaqge_(&n, &n, &a[1], &lda, &s[1], &s[n + 1], &
00939 rowcnd, &colcnd, &amax, equed);
00940 }
00941
00942
00943
00944
00945 s_copy(srnamc_1.srnamt, "ZGESVXX", (ftnlen)32, (
00946 ftnlen)7);
00947 n_err_bnds__ = 3;
00948
00949 dalloc3();
00950
00951 zgesvxx_(fact, trans, &n, nrhs, &a[1], &lda, &afac[1],
00952 &lda, &iwork[1], equed, &s[1], &s[n + 1], &b[
00953 1], &lda, &x[1], &lda, &rcond, &rpvgrw_svxx__,
00954 berr, &n_err_bnds__, errbnds_n__,
00955 errbnds_c__, &c__0, &c_b166, &work[1], &rwork[
00956 1], &info);
00957
00958 free3();
00959
00960
00961
00962 if (info == n + 1) {
00963 goto L50;
00964 }
00965 if (info != izero) {
00966
00967 i__5[0] = 1, a__1[0] = fact;
00968 i__5[1] = 1, a__1[1] = trans;
00969 s_cat(ch__1, a__1, i__5, &c__2, (ftnlen)2);
00970 alaerh_(path, "ZGESVXX", &info, &izero, ch__1, &n,
00971 &n, &c_n1, &c_n1, nrhs, &imat, &nfail, &
00972 nerrs, nout);
00973 goto L50;
00974 }
00975
00976
00977
00978
00979 if (info > 0 && info < n + 1) {
00980 rpvgrw = zla_rpvgrw__(&n, &info, &a[1], &lda, &
00981 afac[1], &lda);
00982 } else {
00983 rpvgrw = zla_rpvgrw__(&n, &n, &a[1], &lda, &afac[
00984 1], &lda);
00985 }
00986 result[6] = (d__1 = rpvgrw - rpvgrw_svxx__, abs(d__1))
00987 / max(rpvgrw_svxx__,rpvgrw) / dlamch_("E");
00988
00989 if (! prefac) {
00990
00991
00992
00993
00994 zget01_(&n, &n, &a[1], &lda, &afac[1], &lda, &
00995 iwork[1], &rwork[(*nrhs << 1) + 1],
00996 result);
00997 k1 = 1;
00998 } else {
00999 k1 = 2;
01000 }
01001
01002 if (info == 0) {
01003 trfcon = FALSE_;
01004
01005
01006
01007 zlacpy_("Full", &n, nrhs, &bsav[1], &lda, &work[1]
01008 , &lda);
01009 zget02_(trans, &n, &n, nrhs, &asav[1], &lda, &x[1]
01010 , &lda, &work[1], &lda, &rwork[(*nrhs <<
01011 1) + 1], &result[1]);
01012
01013
01014
01015 if (nofact || prefac && lsame_(equed, "N")) {
01016 zget04_(&n, nrhs, &x[1], &lda, &xact[1], &lda,
01017 &rcondc, &result[2]);
01018 } else {
01019 if (itran == 1) {
01020 roldc = roldo;
01021 } else {
01022 roldc = roldi;
01023 }
01024 zget04_(&n, nrhs, &x[1], &lda, &xact[1], &lda,
01025 &roldc, &result[2]);
01026 }
01027 } else {
01028 trfcon = TRUE_;
01029 }
01030
01031
01032
01033
01034 result[5] = dget06_(&rcond, &rcondc);
01035
01036
01037
01038
01039 if (! trfcon) {
01040 for (k = k1; k <= 7; ++k) {
01041 if (result[k - 1] >= *thresh) {
01042 if (nfail == 0 && nerrs == 0) {
01043 aladhd_(nout, path);
01044 }
01045 if (prefac) {
01046 io___75.ciunit = *nout;
01047 s_wsfe(&io___75);
01048 do_fio(&c__1, "ZGESVXX", (ftnlen)7);
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, equed, (ftnlen)1);
01054 do_fio(&c__1, (char *)&imat, (ftnlen)
01055 sizeof(integer));
01056 do_fio(&c__1, (char *)&k, (ftnlen)
01057 sizeof(integer));
01058 do_fio(&c__1, (char *)&result[k - 1],
01059 (ftnlen)sizeof(doublereal));
01060 e_wsfe();
01061 } else {
01062 io___76.ciunit = *nout;
01063 s_wsfe(&io___76);
01064 do_fio(&c__1, "ZGESVXX", (ftnlen)7);
01065 do_fio(&c__1, fact, (ftnlen)1);
01066 do_fio(&c__1, trans, (ftnlen)1);
01067 do_fio(&c__1, (char *)&n, (ftnlen)
01068 sizeof(integer));
01069 do_fio(&c__1, (char *)&imat, (ftnlen)
01070 sizeof(integer));
01071 do_fio(&c__1, (char *)&k, (ftnlen)
01072 sizeof(integer));
01073 do_fio(&c__1, (char *)&result[k - 1],
01074 (ftnlen)sizeof(doublereal));
01075 e_wsfe();
01076 }
01077 ++nfail;
01078 }
01079
01080 }
01081 nrun = nrun + 7 - k1;
01082 } else {
01083 if (result[0] >= *thresh && ! prefac) {
01084 if (nfail == 0 && nerrs == 0) {
01085 aladhd_(nout, path);
01086 }
01087 if (prefac) {
01088 io___77.ciunit = *nout;
01089 s_wsfe(&io___77);
01090 do_fio(&c__1, "ZGESVXX", (ftnlen)7);
01091 do_fio(&c__1, fact, (ftnlen)1);
01092 do_fio(&c__1, trans, (ftnlen)1);
01093 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(
01094 integer));
01095 do_fio(&c__1, equed, (ftnlen)1);
01096 do_fio(&c__1, (char *)&imat, (ftnlen)
01097 sizeof(integer));
01098 do_fio(&c__1, (char *)&c__1, (ftnlen)
01099 sizeof(integer));
01100 do_fio(&c__1, (char *)&result[0], (ftnlen)
01101 sizeof(doublereal));
01102 e_wsfe();
01103 } else {
01104 io___78.ciunit = *nout;
01105 s_wsfe(&io___78);
01106 do_fio(&c__1, "ZGESVXX", (ftnlen)7);
01107 do_fio(&c__1, fact, (ftnlen)1);
01108 do_fio(&c__1, trans, (ftnlen)1);
01109 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(
01110 integer));
01111 do_fio(&c__1, (char *)&imat, (ftnlen)
01112 sizeof(integer));
01113 do_fio(&c__1, (char *)&c__1, (ftnlen)
01114 sizeof(integer));
01115 do_fio(&c__1, (char *)&result[0], (ftnlen)
01116 sizeof(doublereal));
01117 e_wsfe();
01118 }
01119 ++nfail;
01120 ++nrun;
01121 }
01122 if (result[5] >= *thresh) {
01123 if (nfail == 0 && nerrs == 0) {
01124 aladhd_(nout, path);
01125 }
01126 if (prefac) {
01127 io___79.ciunit = *nout;
01128 s_wsfe(&io___79);
01129 do_fio(&c__1, "ZGESVXX", (ftnlen)7);
01130 do_fio(&c__1, fact, (ftnlen)1);
01131 do_fio(&c__1, trans, (ftnlen)1);
01132 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(
01133 integer));
01134 do_fio(&c__1, equed, (ftnlen)1);
01135 do_fio(&c__1, (char *)&imat, (ftnlen)
01136 sizeof(integer));
01137 do_fio(&c__1, (char *)&c__6, (ftnlen)
01138 sizeof(integer));
01139 do_fio(&c__1, (char *)&result[5], (ftnlen)
01140 sizeof(doublereal));
01141 e_wsfe();
01142 } else {
01143 io___80.ciunit = *nout;
01144 s_wsfe(&io___80);
01145 do_fio(&c__1, "ZGESVXX", (ftnlen)7);
01146 do_fio(&c__1, fact, (ftnlen)1);
01147 do_fio(&c__1, trans, (ftnlen)1);
01148 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(
01149 integer));
01150 do_fio(&c__1, (char *)&imat, (ftnlen)
01151 sizeof(integer));
01152 do_fio(&c__1, (char *)&c__6, (ftnlen)
01153 sizeof(integer));
01154 do_fio(&c__1, (char *)&result[5], (ftnlen)
01155 sizeof(doublereal));
01156 e_wsfe();
01157 }
01158 ++nfail;
01159 ++nrun;
01160 }
01161 if (result[6] >= *thresh) {
01162 if (nfail == 0 && nerrs == 0) {
01163 aladhd_(nout, path);
01164 }
01165 if (prefac) {
01166 io___81.ciunit = *nout;
01167 s_wsfe(&io___81);
01168 do_fio(&c__1, "ZGESVXX", (ftnlen)7);
01169 do_fio(&c__1, fact, (ftnlen)1);
01170 do_fio(&c__1, trans, (ftnlen)1);
01171 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(
01172 integer));
01173 do_fio(&c__1, equed, (ftnlen)1);
01174 do_fio(&c__1, (char *)&imat, (ftnlen)
01175 sizeof(integer));
01176 do_fio(&c__1, (char *)&c__7, (ftnlen)
01177 sizeof(integer));
01178 do_fio(&c__1, (char *)&result[6], (ftnlen)
01179 sizeof(doublereal));
01180 e_wsfe();
01181 } else {
01182 io___82.ciunit = *nout;
01183 s_wsfe(&io___82);
01184 do_fio(&c__1, "ZGESVXX", (ftnlen)7);
01185 do_fio(&c__1, fact, (ftnlen)1);
01186 do_fio(&c__1, trans, (ftnlen)1);
01187 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(
01188 integer));
01189 do_fio(&c__1, (char *)&imat, (ftnlen)
01190 sizeof(integer));
01191 do_fio(&c__1, (char *)&c__7, (ftnlen)
01192 sizeof(integer));
01193 do_fio(&c__1, (char *)&result[6], (ftnlen)
01194 sizeof(doublereal));
01195 e_wsfe();
01196 }
01197 ++nfail;
01198 ++nrun;
01199 }
01200
01201 }
01202
01203 L50:
01204 ;
01205 }
01206 L60:
01207 ;
01208 }
01209
01210 }
01211 L80:
01212 ;
01213 }
01214
01215 }
01216
01217
01218
01219 alasvm_(path, nout, &nfail, &nrun, &nerrs);
01220
01221
01222 zebchvxx_(thresh, path);
01223 return 0;
01224
01225
01226
01227 }