00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013 #include "f2c.h"
00014 #include "blaswrap.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__3 = 3;
00034 static integer c__0 = 0;
00035 static integer c_n1 = -1;
00036 static integer c__1 = 1;
00037 static integer c__2 = 2;
00038 static real c_b43 = 1.f;
00039 static real c_b44 = 0.f;
00040 static complex c_b65 = {0.f,0.f};
00041
00042 int cdrvgt_(logical *dotype, integer *nn, integer *nval,
00043 integer *nrhs, real *thresh, logical *tsterr, complex *a, complex *af,
00044 complex *b, complex *x, complex *xact, complex *work, real *rwork,
00045 integer *iwork, integer *nout)
00046 {
00047
00048
00049 static integer iseedy[4] = { 0,0,0,1 };
00050 static char transs[1*3] = "N" "T" "C";
00051
00052
00053 static char fmt_9999[] = "(1x,a,\002, N =\002,i5,\002, type \002,i2,\002"
00054 ", test \002,i2,\002, ratio = \002,g12.5)";
00055 static char fmt_9998[] = "(1x,a,\002, FACT='\002,a1,\002', TRANS='\002,a"
00056 "1,\002', N =\002,i5,\002, type \002,i2,\002, test \002,i2,\002, "
00057 "ratio = \002,g12.5)";
00058
00059
00060 address a__1[2];
00061 integer i__1, i__2, i__3, i__4, i__5, i__6[2];
00062 real r__1, r__2;
00063 char ch__1[2];
00064
00065
00066 int s_copy(char *, char *, ftnlen, ftnlen);
00067 integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void);
00068 int s_cat(char *, char **, integer *, integer *, ftnlen);
00069
00070
00071 integer i__, j, k, m, n;
00072 real z__[3];
00073 integer k1, in, kl, ku, ix, nt, lda;
00074 char fact[1];
00075 real cond;
00076 integer mode, koff, imat, info;
00077 char path[3], dist[1], type__[1];
00078 integer nrun, ifact;
00079 extern int cget04_(integer *, integer *, complex *,
00080 integer *, complex *, integer *, real *, real *);
00081 integer nfail, iseed[4];
00082 extern int cgtt01_(integer *, complex *, complex *,
00083 complex *, complex *, complex *, complex *, complex *, integer *,
00084 complex *, integer *, real *, real *), cgtt02_(char *, integer *,
00085 integer *, complex *, complex *, complex *, complex *, integer *,
00086 complex *, integer *, real *, real *);
00087 real rcond;
00088 extern int cgtt05_(char *, integer *, integer *, complex
00089 *, complex *, complex *, complex *, integer *, complex *, integer
00090 *, complex *, integer *, real *, real *, real *);
00091 integer nimat;
00092 extern doublereal sget06_(real *, real *);
00093 real anorm;
00094 integer itran;
00095 extern int ccopy_(integer *, complex *, integer *,
00096 complex *, integer *), cgtsv_(integer *, integer *, complex *,
00097 complex *, complex *, complex *, integer *, integer *);
00098 char trans[1];
00099 integer izero, nerrs;
00100 logical zerot;
00101 extern int clatb4_(char *, integer *, integer *, integer
00102 *, char *, integer *, integer *, real *, integer *, real *, char *
00103 ), aladhd_(integer *, char *),
00104 alaerh_(char *, char *, integer *, integer *, char *, integer *,
00105 integer *, integer *, integer *, integer *, integer *, integer *,
00106 integer *, integer *), clagtm_(char *,
00107 integer *, integer *, real *, complex *, complex *, complex *,
00108 complex *, integer *, real *, complex *, integer *);
00109 real rcondc;
00110 extern doublereal clangt_(char *, integer *, complex *, complex *,
00111 complex *);
00112 extern int csscal_(integer *, real *, complex *, integer
00113 *), clacpy_(char *, integer *, integer *, complex *, integer *,
00114 complex *, integer *), claset_(char *, integer *, integer
00115 *, complex *, complex *, complex *, integer *);
00116 real rcondi;
00117 extern int alasvm_(char *, integer *, integer *, integer
00118 *, integer *);
00119 real rcondo, anormi;
00120 extern int clarnv_(integer *, integer *, integer *,
00121 complex *), clatms_(integer *, integer *, char *, integer *, char
00122 *, real *, integer *, real *, real *, integer *, integer *, char *
00123 , complex *, integer *, complex *, integer *);
00124 real ainvnm;
00125 extern int cgttrf_(integer *, complex *, complex *,
00126 complex *, complex *, integer *, integer *);
00127 logical trfcon;
00128 real anormo;
00129 extern doublereal scasum_(integer *, complex *, integer *);
00130 extern int cgttrs_(char *, integer *, integer *, complex
00131 *, complex *, complex *, complex *, integer *, complex *, integer
00132 *, integer *), cerrvx_(char *, integer *);
00133 real result[6];
00134 extern int cgtsvx_(char *, char *, integer *, integer *,
00135 complex *, complex *, complex *, complex *, complex *, complex *,
00136 complex *, integer *, complex *, integer *, complex *, integer *,
00137 real *, real *, real *, complex *, real *, integer *);
00138
00139
00140 static cilist io___42 = { 0, 0, 0, fmt_9999, 0 };
00141 static cilist io___46 = { 0, 0, 0, fmt_9998, 0 };
00142 static cilist io___47 = { 0, 0, 0, fmt_9998, 0 };
00143
00144
00145
00146
00147
00148
00149
00150
00151
00152
00153
00154
00155
00156
00157
00158
00159
00160
00161
00162
00163
00164
00165
00166
00167
00168
00169
00170
00171
00172
00173
00174
00175
00176
00177
00178
00179
00180
00181
00182
00183
00184
00185
00186
00187
00188
00189
00190
00191
00192
00193
00194
00195
00196
00197
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 --iwork;
00223 --rwork;
00224 --work;
00225 --xact;
00226 --x;
00227 --b;
00228 --af;
00229 --a;
00230 --nval;
00231 --dotype;
00232
00233
00234
00235
00236
00237 s_copy(path, "Complex precision", (ftnlen)1, (ftnlen)17);
00238 s_copy(path + 1, "GT", (ftnlen)2, (ftnlen)2);
00239 nrun = 0;
00240 nfail = 0;
00241 nerrs = 0;
00242 for (i__ = 1; i__ <= 4; ++i__) {
00243 iseed[i__ - 1] = iseedy[i__ - 1];
00244
00245 }
00246
00247
00248
00249 if (*tsterr) {
00250 cerrvx_(path, nout);
00251 }
00252 infoc_1.infot = 0;
00253
00254 i__1 = *nn;
00255 for (in = 1; in <= i__1; ++in) {
00256
00257
00258
00259 n = nval[in];
00260
00261 i__2 = n - 1;
00262 m = max(i__2,0);
00263 lda = max(1,n);
00264 nimat = 12;
00265 if (n <= 0) {
00266 nimat = 1;
00267 }
00268
00269 i__2 = nimat;
00270 for (imat = 1; imat <= i__2; ++imat) {
00271
00272
00273
00274 if (! dotype[imat]) {
00275 goto L130;
00276 }
00277
00278
00279
00280 clatb4_(path, &imat, &n, &n, type__, &kl, &ku, &anorm, &mode, &
00281 cond, dist);
00282
00283 zerot = imat >= 8 && imat <= 10;
00284 if (imat <= 6) {
00285
00286
00287
00288
00289 i__3 = 2 - ku, i__4 = 3 - max(1,n);
00290 koff = max(i__3,i__4);
00291 s_copy(srnamc_1.srnamt, "CLATMS", (ftnlen)32, (ftnlen)6);
00292 clatms_(&n, &n, dist, iseed, type__, &rwork[1], &mode, &cond,
00293 &anorm, &kl, &ku, "Z", &af[koff], &c__3, &work[1], &
00294 info);
00295
00296
00297
00298 if (info != 0) {
00299 alaerh_(path, "CLATMS", &info, &c__0, " ", &n, &n, &kl, &
00300 ku, &c_n1, &imat, &nfail, &nerrs, nout);
00301 goto L130;
00302 }
00303 izero = 0;
00304
00305 if (n > 1) {
00306 i__3 = n - 1;
00307 ccopy_(&i__3, &af[4], &c__3, &a[1], &c__1);
00308 i__3 = n - 1;
00309 ccopy_(&i__3, &af[3], &c__3, &a[n + m + 1], &c__1);
00310 }
00311 ccopy_(&n, &af[2], &c__3, &a[m + 1], &c__1);
00312 } else {
00313
00314
00315
00316
00317 if (! zerot || ! dotype[7]) {
00318
00319
00320
00321 i__3 = n + (m << 1);
00322 clarnv_(&c__2, iseed, &i__3, &a[1]);
00323 if (anorm != 1.f) {
00324 i__3 = n + (m << 1);
00325 csscal_(&i__3, &anorm, &a[1], &c__1);
00326 }
00327 } else if (izero > 0) {
00328
00329
00330
00331
00332 if (izero == 1) {
00333 i__3 = n;
00334 a[i__3].r = z__[1], a[i__3].i = 0.f;
00335 if (n > 1) {
00336 a[1].r = z__[2], a[1].i = 0.f;
00337 }
00338 } else if (izero == n) {
00339 i__3 = n * 3 - 2;
00340 a[i__3].r = z__[0], a[i__3].i = 0.f;
00341 i__3 = (n << 1) - 1;
00342 a[i__3].r = z__[1], a[i__3].i = 0.f;
00343 } else {
00344 i__3 = (n << 1) - 2 + izero;
00345 a[i__3].r = z__[0], a[i__3].i = 0.f;
00346 i__3 = n - 1 + izero;
00347 a[i__3].r = z__[1], a[i__3].i = 0.f;
00348 i__3 = izero;
00349 a[i__3].r = z__[2], a[i__3].i = 0.f;
00350 }
00351 }
00352
00353
00354
00355 if (! zerot) {
00356 izero = 0;
00357 } else if (imat == 8) {
00358 izero = 1;
00359 i__3 = n;
00360 z__[1] = a[i__3].r;
00361 i__3 = n;
00362 a[i__3].r = 0.f, a[i__3].i = 0.f;
00363 if (n > 1) {
00364 z__[2] = a[1].r;
00365 a[1].r = 0.f, a[1].i = 0.f;
00366 }
00367 } else if (imat == 9) {
00368 izero = n;
00369 i__3 = n * 3 - 2;
00370 z__[0] = a[i__3].r;
00371 i__3 = (n << 1) - 1;
00372 z__[1] = a[i__3].r;
00373 i__3 = n * 3 - 2;
00374 a[i__3].r = 0.f, a[i__3].i = 0.f;
00375 i__3 = (n << 1) - 1;
00376 a[i__3].r = 0.f, a[i__3].i = 0.f;
00377 } else {
00378 izero = (n + 1) / 2;
00379 i__3 = n - 1;
00380 for (i__ = izero; i__ <= i__3; ++i__) {
00381 i__4 = (n << 1) - 2 + i__;
00382 a[i__4].r = 0.f, a[i__4].i = 0.f;
00383 i__4 = n - 1 + i__;
00384 a[i__4].r = 0.f, a[i__4].i = 0.f;
00385 i__4 = i__;
00386 a[i__4].r = 0.f, a[i__4].i = 0.f;
00387
00388 }
00389 i__3 = n * 3 - 2;
00390 a[i__3].r = 0.f, a[i__3].i = 0.f;
00391 i__3 = (n << 1) - 1;
00392 a[i__3].r = 0.f, a[i__3].i = 0.f;
00393 }
00394 }
00395
00396 for (ifact = 1; ifact <= 2; ++ifact) {
00397 if (ifact == 1) {
00398 *(unsigned char *)fact = 'F';
00399 } else {
00400 *(unsigned char *)fact = 'N';
00401 }
00402
00403
00404
00405
00406 if (zerot) {
00407 if (ifact == 1) {
00408 goto L120;
00409 }
00410 rcondo = 0.f;
00411 rcondi = 0.f;
00412
00413 } else if (ifact == 1) {
00414 i__3 = n + (m << 1);
00415 ccopy_(&i__3, &a[1], &c__1, &af[1], &c__1);
00416
00417
00418
00419 anormo = clangt_("1", &n, &a[1], &a[m + 1], &a[n + m + 1]);
00420 anormi = clangt_("I", &n, &a[1], &a[m + 1], &a[n + m + 1]);
00421
00422
00423
00424 cgttrf_(&n, &af[1], &af[m + 1], &af[n + m + 1], &af[n + (
00425 m << 1) + 1], &iwork[1], &info);
00426
00427
00428
00429
00430 ainvnm = 0.f;
00431 i__3 = n;
00432 for (i__ = 1; i__ <= i__3; ++i__) {
00433 i__4 = n;
00434 for (j = 1; j <= i__4; ++j) {
00435 i__5 = j;
00436 x[i__5].r = 0.f, x[i__5].i = 0.f;
00437
00438 }
00439 i__4 = i__;
00440 x[i__4].r = 1.f, x[i__4].i = 0.f;
00441 cgttrs_("No transpose", &n, &c__1, &af[1], &af[m + 1],
00442 &af[n + m + 1], &af[n + (m << 1) + 1], &
00443 iwork[1], &x[1], &lda, &info);
00444
00445 r__1 = ainvnm, r__2 = scasum_(&n, &x[1], &c__1);
00446 ainvnm = dmax(r__1,r__2);
00447
00448 }
00449
00450
00451
00452 if (anormo <= 0.f || ainvnm <= 0.f) {
00453 rcondo = 1.f;
00454 } else {
00455 rcondo = 1.f / anormo / ainvnm;
00456 }
00457
00458
00459
00460
00461 ainvnm = 0.f;
00462 i__3 = n;
00463 for (i__ = 1; i__ <= i__3; ++i__) {
00464 i__4 = n;
00465 for (j = 1; j <= i__4; ++j) {
00466 i__5 = j;
00467 x[i__5].r = 0.f, x[i__5].i = 0.f;
00468
00469 }
00470 i__4 = i__;
00471 x[i__4].r = 1.f, x[i__4].i = 0.f;
00472 cgttrs_("Conjugate transpose", &n, &c__1, &af[1], &af[
00473 m + 1], &af[n + m + 1], &af[n + (m << 1) + 1],
00474 &iwork[1], &x[1], &lda, &info);
00475
00476 r__1 = ainvnm, r__2 = scasum_(&n, &x[1], &c__1);
00477 ainvnm = dmax(r__1,r__2);
00478
00479 }
00480
00481
00482
00483 if (anormi <= 0.f || ainvnm <= 0.f) {
00484 rcondi = 1.f;
00485 } else {
00486 rcondi = 1.f / anormi / ainvnm;
00487 }
00488 }
00489
00490 for (itran = 1; itran <= 3; ++itran) {
00491 *(unsigned char *)trans = *(unsigned char *)&transs[itran
00492 - 1];
00493 if (itran == 1) {
00494 rcondc = rcondo;
00495 } else {
00496 rcondc = rcondi;
00497 }
00498
00499
00500
00501 ix = 1;
00502 i__3 = *nrhs;
00503 for (j = 1; j <= i__3; ++j) {
00504 clarnv_(&c__2, iseed, &n, &xact[ix]);
00505 ix += lda;
00506
00507 }
00508
00509
00510
00511 clagtm_(trans, &n, nrhs, &c_b43, &a[1], &a[m + 1], &a[n +
00512 m + 1], &xact[1], &lda, &c_b44, &b[1], &lda);
00513
00514 if (ifact == 2 && itran == 1) {
00515
00516
00517
00518
00519
00520
00521 i__3 = n + (m << 1);
00522 ccopy_(&i__3, &a[1], &c__1, &af[1], &c__1);
00523 clacpy_("Full", &n, nrhs, &b[1], &lda, &x[1], &lda);
00524
00525 s_copy(srnamc_1.srnamt, "CGTSV ", (ftnlen)32, (ftnlen)
00526 6);
00527 cgtsv_(&n, nrhs, &af[1], &af[m + 1], &af[n + m + 1], &
00528 x[1], &lda, &info);
00529
00530
00531
00532 if (info != izero) {
00533 alaerh_(path, "CGTSV ", &info, &izero, " ", &n, &
00534 n, &c__1, &c__1, nrhs, &imat, &nfail, &
00535 nerrs, nout);
00536 }
00537 nt = 1;
00538 if (izero == 0) {
00539
00540
00541
00542 clacpy_("Full", &n, nrhs, &b[1], &lda, &work[1], &
00543 lda);
00544 cgtt02_(trans, &n, nrhs, &a[1], &a[m + 1], &a[n +
00545 m + 1], &x[1], &lda, &work[1], &lda, &
00546 rwork[1], &result[1]);
00547
00548
00549
00550 cget04_(&n, nrhs, &x[1], &lda, &xact[1], &lda, &
00551 rcondc, &result[2]);
00552 nt = 3;
00553 }
00554
00555
00556
00557
00558 i__3 = nt;
00559 for (k = 2; k <= i__3; ++k) {
00560 if (result[k - 1] >= *thresh) {
00561 if (nfail == 0 && nerrs == 0) {
00562 aladhd_(nout, path);
00563 }
00564 io___42.ciunit = *nout;
00565 s_wsfe(&io___42);
00566 do_fio(&c__1, "CGTSV ", (ftnlen)6);
00567 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(
00568 integer));
00569 do_fio(&c__1, (char *)&imat, (ftnlen)sizeof(
00570 integer));
00571 do_fio(&c__1, (char *)&k, (ftnlen)sizeof(
00572 integer));
00573 do_fio(&c__1, (char *)&result[k - 1], (ftnlen)
00574 sizeof(real));
00575 e_wsfe();
00576 ++nfail;
00577 }
00578
00579 }
00580 nrun = nrun + nt - 1;
00581 }
00582
00583
00584
00585 if (ifact > 1) {
00586
00587
00588
00589 i__3 = n * 3 - 2;
00590 for (i__ = 1; i__ <= i__3; ++i__) {
00591 i__4 = i__;
00592 af[i__4].r = 0.f, af[i__4].i = 0.f;
00593
00594 }
00595 }
00596 claset_("Full", &n, nrhs, &c_b65, &c_b65, &x[1], &lda);
00597
00598
00599
00600
00601 s_copy(srnamc_1.srnamt, "CGTSVX", (ftnlen)32, (ftnlen)6);
00602 cgtsvx_(fact, trans, &n, nrhs, &a[1], &a[m + 1], &a[n + m
00603 + 1], &af[1], &af[m + 1], &af[n + m + 1], &af[n +
00604 (m << 1) + 1], &iwork[1], &b[1], &lda, &x[1], &
00605 lda, &rcond, &rwork[1], &rwork[*nrhs + 1], &work[
00606 1], &rwork[(*nrhs << 1) + 1], &info);
00607
00608
00609
00610 if (info != izero) {
00611
00612 i__6[0] = 1, a__1[0] = fact;
00613 i__6[1] = 1, a__1[1] = trans;
00614 s_cat(ch__1, a__1, i__6, &c__2, (ftnlen)2);
00615 alaerh_(path, "CGTSVX", &info, &izero, ch__1, &n, &n,
00616 &c__1, &c__1, nrhs, &imat, &nfail, &nerrs,
00617 nout);
00618 }
00619
00620 if (ifact >= 2) {
00621
00622
00623
00624
00625 cgtt01_(&n, &a[1], &a[m + 1], &a[n + m + 1], &af[1], &
00626 af[m + 1], &af[n + m + 1], &af[n + (m << 1) +
00627 1], &iwork[1], &work[1], &lda, &rwork[1],
00628 result);
00629 k1 = 1;
00630 } else {
00631 k1 = 2;
00632 }
00633
00634 if (info == 0) {
00635 trfcon = FALSE_;
00636
00637
00638
00639 clacpy_("Full", &n, nrhs, &b[1], &lda, &work[1], &lda);
00640 cgtt02_(trans, &n, nrhs, &a[1], &a[m + 1], &a[n + m +
00641 1], &x[1], &lda, &work[1], &lda, &rwork[1], &
00642 result[1]);
00643
00644
00645
00646 cget04_(&n, nrhs, &x[1], &lda, &xact[1], &lda, &
00647 rcondc, &result[2]);
00648
00649
00650
00651 cgtt05_(trans, &n, nrhs, &a[1], &a[m + 1], &a[n + m +
00652 1], &b[1], &lda, &x[1], &lda, &xact[1], &lda,
00653 &rwork[1], &rwork[*nrhs + 1], &result[3]);
00654 nt = 5;
00655 }
00656
00657
00658
00659
00660 i__3 = nt;
00661 for (k = k1; k <= i__3; ++k) {
00662 if (result[k - 1] >= *thresh) {
00663 if (nfail == 0 && nerrs == 0) {
00664 aladhd_(nout, path);
00665 }
00666 io___46.ciunit = *nout;
00667 s_wsfe(&io___46);
00668 do_fio(&c__1, "CGTSVX", (ftnlen)6);
00669 do_fio(&c__1, fact, (ftnlen)1);
00670 do_fio(&c__1, trans, (ftnlen)1);
00671 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer))
00672 ;
00673 do_fio(&c__1, (char *)&imat, (ftnlen)sizeof(
00674 integer));
00675 do_fio(&c__1, (char *)&k, (ftnlen)sizeof(integer))
00676 ;
00677 do_fio(&c__1, (char *)&result[k - 1], (ftnlen)
00678 sizeof(real));
00679 e_wsfe();
00680 ++nfail;
00681 }
00682
00683 }
00684
00685
00686
00687 result[5] = sget06_(&rcond, &rcondc);
00688 if (result[5] >= *thresh) {
00689 if (nfail == 0 && nerrs == 0) {
00690 aladhd_(nout, path);
00691 }
00692 io___47.ciunit = *nout;
00693 s_wsfe(&io___47);
00694 do_fio(&c__1, "CGTSVX", (ftnlen)6);
00695 do_fio(&c__1, fact, (ftnlen)1);
00696 do_fio(&c__1, trans, (ftnlen)1);
00697 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
00698 do_fio(&c__1, (char *)&imat, (ftnlen)sizeof(integer));
00699 do_fio(&c__1, (char *)&k, (ftnlen)sizeof(integer));
00700 do_fio(&c__1, (char *)&result[k - 1], (ftnlen)sizeof(
00701 real));
00702 e_wsfe();
00703 ++nfail;
00704 }
00705 nrun = nrun + nt - k1 + 2;
00706
00707
00708 }
00709 L120:
00710 ;
00711 }
00712 L130:
00713 ;
00714 }
00715
00716 }
00717
00718
00719
00720 alasvm_(path, nout, &nfail, &nrun, &nerrs);
00721
00722 return 0;
00723
00724
00725
00726 }