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 integer c__7 = 7;
00039 static real c_b63 = 1.f;
00040 static real c_b64 = 0.f;
00041
00042 int cchkgt_(logical *dotype, integer *nn, integer *nval,
00043 integer *nns, integer *nsval, real *thresh, logical *tsterr, complex *
00044 a, complex *af, complex *b, complex *x, complex *xact, complex *work,
00045 real *rwork, 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[] = "(12x,\002N =\002,i5,\002,\002,10x,\002 type"
00054 " \002,i2,\002, test(\002,i2,\002) = \002,g12.5)";
00055 static char fmt_9997[] = "(\002 NORM ='\002,a1,\002', N =\002,i5,\002"
00056 ",\002,10x,\002 type \002,i2,\002, test(\002,i2,\002) = \002,g12."
00057 "5)";
00058 static char fmt_9998[] = "(\002 TRANS='\002,a1,\002', N =\002,i5,\002, N"
00059 "RHS=\002,i3,\002, type \002,i2,\002, test(\002,i2,\002) = \002,g"
00060 "12.5)";
00061
00062
00063 integer i__1, i__2, i__3, i__4, i__5;
00064 real r__1, r__2;
00065
00066
00067 int s_copy(char *, char *, ftnlen, ftnlen);
00068 integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void);
00069
00070
00071 integer i__, j, k, m, n;
00072 complex z__[3];
00073 integer in, kl, ku, ix, lda;
00074 real cond;
00075 integer mode, koff, imat, info;
00076 char path[3], dist[1];
00077 integer irhs, nrhs;
00078 char norm[1], type__[1];
00079 integer nrun;
00080 extern int alahd_(integer *, char *), cget04_(
00081 integer *, integer *, complex *, integer *, complex *, integer *,
00082 real *, real *);
00083 integer nfail, iseed[4];
00084 extern int cgtt01_(integer *, complex *, complex *,
00085 complex *, complex *, complex *, complex *, complex *, integer *,
00086 complex *, integer *, real *, real *), cgtt02_(char *, integer *,
00087 integer *, complex *, complex *, complex *, complex *, integer *,
00088 complex *, integer *, real *, real *);
00089 real rcond;
00090 extern int cgtt05_(char *, integer *, integer *, complex
00091 *, complex *, complex *, complex *, integer *, complex *, integer
00092 *, complex *, integer *, real *, real *, real *);
00093 integer nimat;
00094 extern doublereal sget06_(real *, real *);
00095 real anorm;
00096 integer itran;
00097 extern int ccopy_(integer *, complex *, integer *,
00098 complex *, integer *);
00099 char trans[1];
00100 integer izero, nerrs;
00101 logical zerot;
00102 extern int clatb4_(char *, integer *, integer *, integer
00103 *, char *, integer *, integer *, real *, integer *, real *, char *
00104 ), alaerh_(char *, char *, integer *,
00105 integer *, char *, integer *, integer *, integer *, integer *,
00106 integer *, integer *, integer *, integer *, integer *), cerrge_(char *, integer *);
00107 real rcondc;
00108 extern doublereal clangt_(char *, integer *, complex *, complex *,
00109 complex *);
00110 extern int clagtm_(char *, integer *, integer *, real *,
00111 complex *, complex *, complex *, complex *, integer *, real *,
00112 complex *, integer *), clacpy_(char *, integer *, integer
00113 *, complex *, integer *, complex *, integer *), csscal_(
00114 integer *, real *, complex *, integer *), cgtcon_(char *, integer
00115 *, complex *, complex *, complex *, complex *, integer *, real *,
00116 real *, complex *, integer *);
00117 real rcondi;
00118 extern int alasum_(char *, integer *, integer *, integer
00119 *, integer *);
00120 real rcondo;
00121 extern int clarnv_(integer *, integer *, integer *,
00122 complex *), clatms_(integer *, integer *, char *, integer *, char
00123 *, real *, integer *, real *, real *, integer *, integer *, char *
00124 , complex *, integer *, complex *, integer *);
00125 real ainvnm;
00126 extern int cgtrfs_(char *, integer *, integer *, complex
00127 *, complex *, complex *, complex *, complex *, complex *, complex
00128 *, integer *, complex *, integer *, complex *, integer *, real *,
00129 real *, complex *, real *, integer *), cgttrf_(integer *,
00130 complex *, complex *, complex *, complex *, integer *, integer *);
00131 logical trfcon;
00132 extern doublereal scasum_(integer *, complex *, integer *);
00133 extern int cgttrs_(char *, integer *, integer *, complex
00134 *, complex *, complex *, complex *, integer *, complex *, integer
00135 *, integer *);
00136 real result[7];
00137
00138
00139 static cilist io___29 = { 0, 0, 0, fmt_9999, 0 };
00140 static cilist io___39 = { 0, 0, 0, fmt_9997, 0 };
00141 static cilist io___44 = { 0, 0, 0, fmt_9998, 0 };
00142
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
00223
00224
00225
00226
00227
00228
00229 --iwork;
00230 --rwork;
00231 --work;
00232 --xact;
00233 --x;
00234 --b;
00235 --af;
00236 --a;
00237 --nsval;
00238 --nval;
00239 --dotype;
00240
00241
00242
00243
00244
00245 s_copy(path, "Complex precision", (ftnlen)1, (ftnlen)17);
00246 s_copy(path + 1, "GT", (ftnlen)2, (ftnlen)2);
00247 nrun = 0;
00248 nfail = 0;
00249 nerrs = 0;
00250 for (i__ = 1; i__ <= 4; ++i__) {
00251 iseed[i__ - 1] = iseedy[i__ - 1];
00252
00253 }
00254
00255
00256
00257 if (*tsterr) {
00258 cerrge_(path, nout);
00259 }
00260 infoc_1.infot = 0;
00261
00262 i__1 = *nn;
00263 for (in = 1; in <= i__1; ++in) {
00264
00265
00266
00267 n = nval[in];
00268
00269 i__2 = n - 1;
00270 m = max(i__2,0);
00271 lda = max(1,n);
00272 nimat = 12;
00273 if (n <= 0) {
00274 nimat = 1;
00275 }
00276
00277 i__2 = nimat;
00278 for (imat = 1; imat <= i__2; ++imat) {
00279
00280
00281
00282 if (! dotype[imat]) {
00283 goto L100;
00284 }
00285
00286
00287
00288 clatb4_(path, &imat, &n, &n, type__, &kl, &ku, &anorm, &mode, &
00289 cond, dist);
00290
00291 zerot = imat >= 8 && imat <= 10;
00292 if (imat <= 6) {
00293
00294
00295
00296
00297 i__3 = 2 - ku, i__4 = 3 - max(1,n);
00298 koff = max(i__3,i__4);
00299 s_copy(srnamc_1.srnamt, "CLATMS", (ftnlen)32, (ftnlen)6);
00300 clatms_(&n, &n, dist, iseed, type__, &rwork[1], &mode, &cond,
00301 &anorm, &kl, &ku, "Z", &af[koff], &c__3, &work[1], &
00302 info);
00303
00304
00305
00306 if (info != 0) {
00307 alaerh_(path, "CLATMS", &info, &c__0, " ", &n, &n, &kl, &
00308 ku, &c_n1, &imat, &nfail, &nerrs, nout);
00309 goto L100;
00310 }
00311 izero = 0;
00312
00313 if (n > 1) {
00314 i__3 = n - 1;
00315 ccopy_(&i__3, &af[4], &c__3, &a[1], &c__1);
00316 i__3 = n - 1;
00317 ccopy_(&i__3, &af[3], &c__3, &a[n + m + 1], &c__1);
00318 }
00319 ccopy_(&n, &af[2], &c__3, &a[m + 1], &c__1);
00320 } else {
00321
00322
00323
00324
00325 if (! zerot || ! dotype[7]) {
00326
00327
00328
00329
00330 i__3 = n + (m << 1);
00331 clarnv_(&c__2, iseed, &i__3, &a[1]);
00332 if (anorm != 1.f) {
00333 i__3 = n + (m << 1);
00334 csscal_(&i__3, &anorm, &a[1], &c__1);
00335 }
00336 } else if (izero > 0) {
00337
00338
00339
00340
00341 if (izero == 1) {
00342 i__3 = n;
00343 a[i__3].r = z__[1].r, a[i__3].i = z__[1].i;
00344 if (n > 1) {
00345 a[1].r = z__[2].r, a[1].i = z__[2].i;
00346 }
00347 } else if (izero == n) {
00348 i__3 = n * 3 - 2;
00349 a[i__3].r = z__[0].r, a[i__3].i = z__[0].i;
00350 i__3 = (n << 1) - 1;
00351 a[i__3].r = z__[1].r, a[i__3].i = z__[1].i;
00352 } else {
00353 i__3 = (n << 1) - 2 + izero;
00354 a[i__3].r = z__[0].r, a[i__3].i = z__[0].i;
00355 i__3 = n - 1 + izero;
00356 a[i__3].r = z__[1].r, a[i__3].i = z__[1].i;
00357 i__3 = izero;
00358 a[i__3].r = z__[2].r, a[i__3].i = z__[2].i;
00359 }
00360 }
00361
00362
00363
00364 if (! zerot) {
00365 izero = 0;
00366 } else if (imat == 8) {
00367 izero = 1;
00368 i__3 = n;
00369 z__[1].r = a[i__3].r, z__[1].i = a[i__3].i;
00370 i__3 = n;
00371 a[i__3].r = 0.f, a[i__3].i = 0.f;
00372 if (n > 1) {
00373 z__[2].r = a[1].r, z__[2].i = a[1].i;
00374 a[1].r = 0.f, a[1].i = 0.f;
00375 }
00376 } else if (imat == 9) {
00377 izero = n;
00378 i__3 = n * 3 - 2;
00379 z__[0].r = a[i__3].r, z__[0].i = a[i__3].i;
00380 i__3 = (n << 1) - 1;
00381 z__[1].r = a[i__3].r, z__[1].i = a[i__3].i;
00382 i__3 = n * 3 - 2;
00383 a[i__3].r = 0.f, a[i__3].i = 0.f;
00384 i__3 = (n << 1) - 1;
00385 a[i__3].r = 0.f, a[i__3].i = 0.f;
00386 } else {
00387 izero = (n + 1) / 2;
00388 i__3 = n - 1;
00389 for (i__ = izero; i__ <= i__3; ++i__) {
00390 i__4 = (n << 1) - 2 + i__;
00391 a[i__4].r = 0.f, a[i__4].i = 0.f;
00392 i__4 = n - 1 + i__;
00393 a[i__4].r = 0.f, a[i__4].i = 0.f;
00394 i__4 = i__;
00395 a[i__4].r = 0.f, a[i__4].i = 0.f;
00396
00397 }
00398 i__3 = n * 3 - 2;
00399 a[i__3].r = 0.f, a[i__3].i = 0.f;
00400 i__3 = (n << 1) - 1;
00401 a[i__3].r = 0.f, a[i__3].i = 0.f;
00402 }
00403 }
00404
00405
00406
00407
00408
00409 i__3 = n + (m << 1);
00410 ccopy_(&i__3, &a[1], &c__1, &af[1], &c__1);
00411 s_copy(srnamc_1.srnamt, "CGTTRF", (ftnlen)32, (ftnlen)6);
00412 cgttrf_(&n, &af[1], &af[m + 1], &af[n + m + 1], &af[n + (m << 1)
00413 + 1], &iwork[1], &info);
00414
00415
00416
00417 if (info != izero) {
00418 alaerh_(path, "CGTTRF", &info, &izero, " ", &n, &n, &c__1, &
00419 c__1, &c_n1, &imat, &nfail, &nerrs, nout);
00420 }
00421 trfcon = info != 0;
00422
00423 cgtt01_(&n, &a[1], &a[m + 1], &a[n + m + 1], &af[1], &af[m + 1], &
00424 af[n + m + 1], &af[n + (m << 1) + 1], &iwork[1], &work[1],
00425 &lda, &rwork[1], result);
00426
00427
00428
00429 if (result[0] >= *thresh) {
00430 if (nfail == 0 && nerrs == 0) {
00431 alahd_(nout, path);
00432 }
00433 io___29.ciunit = *nout;
00434 s_wsfe(&io___29);
00435 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
00436 do_fio(&c__1, (char *)&imat, (ftnlen)sizeof(integer));
00437 do_fio(&c__1, (char *)&c__1, (ftnlen)sizeof(integer));
00438 do_fio(&c__1, (char *)&result[0], (ftnlen)sizeof(real));
00439 e_wsfe();
00440 ++nfail;
00441 }
00442 ++nrun;
00443
00444 for (itran = 1; itran <= 2; ++itran) {
00445 *(unsigned char *)trans = *(unsigned char *)&transs[itran - 1]
00446 ;
00447 if (itran == 1) {
00448 *(unsigned char *)norm = 'O';
00449 } else {
00450 *(unsigned char *)norm = 'I';
00451 }
00452 anorm = clangt_(norm, &n, &a[1], &a[m + 1], &a[n + m + 1]);
00453
00454 if (! trfcon) {
00455
00456
00457
00458
00459 ainvnm = 0.f;
00460 i__3 = n;
00461 for (i__ = 1; i__ <= i__3; ++i__) {
00462 i__4 = n;
00463 for (j = 1; j <= i__4; ++j) {
00464 i__5 = j;
00465 x[i__5].r = 0.f, x[i__5].i = 0.f;
00466
00467 }
00468 i__4 = i__;
00469 x[i__4].r = 1.f, x[i__4].i = 0.f;
00470 cgttrs_(trans, &n, &c__1, &af[1], &af[m + 1], &af[n +
00471 m + 1], &af[n + (m << 1) + 1], &iwork[1], &x[
00472 1], &lda, &info);
00473
00474 r__1 = ainvnm, r__2 = scasum_(&n, &x[1], &c__1);
00475 ainvnm = dmax(r__1,r__2);
00476
00477 }
00478
00479
00480
00481 if (anorm <= 0.f || ainvnm <= 0.f) {
00482 rcondc = 1.f;
00483 } else {
00484 rcondc = 1.f / anorm / ainvnm;
00485 }
00486 if (itran == 1) {
00487 rcondo = rcondc;
00488 } else {
00489 rcondi = rcondc;
00490 }
00491 } else {
00492 rcondc = 0.f;
00493 }
00494
00495
00496
00497
00498
00499 s_copy(srnamc_1.srnamt, "CGTCON", (ftnlen)32, (ftnlen)6);
00500 cgtcon_(norm, &n, &af[1], &af[m + 1], &af[n + m + 1], &af[n +
00501 (m << 1) + 1], &iwork[1], &anorm, &rcond, &work[1], &
00502 info);
00503
00504
00505
00506 if (info != 0) {
00507 alaerh_(path, "CGTCON", &info, &c__0, norm, &n, &n, &c_n1,
00508 &c_n1, &c_n1, &imat, &nfail, &nerrs, nout);
00509 }
00510
00511 result[6] = sget06_(&rcond, &rcondc);
00512
00513
00514
00515 if (result[6] >= *thresh) {
00516 if (nfail == 0 && nerrs == 0) {
00517 alahd_(nout, path);
00518 }
00519 io___39.ciunit = *nout;
00520 s_wsfe(&io___39);
00521 do_fio(&c__1, norm, (ftnlen)1);
00522 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
00523 do_fio(&c__1, (char *)&imat, (ftnlen)sizeof(integer));
00524 do_fio(&c__1, (char *)&c__7, (ftnlen)sizeof(integer));
00525 do_fio(&c__1, (char *)&result[6], (ftnlen)sizeof(real));
00526 e_wsfe();
00527 ++nfail;
00528 }
00529 ++nrun;
00530
00531 }
00532
00533
00534
00535 if (trfcon) {
00536 goto L100;
00537 }
00538
00539 i__3 = *nns;
00540 for (irhs = 1; irhs <= i__3; ++irhs) {
00541 nrhs = nsval[irhs];
00542
00543
00544
00545 ix = 1;
00546 i__4 = nrhs;
00547 for (j = 1; j <= i__4; ++j) {
00548 clarnv_(&c__2, iseed, &n, &xact[ix]);
00549 ix += lda;
00550
00551 }
00552
00553 for (itran = 1; itran <= 3; ++itran) {
00554 *(unsigned char *)trans = *(unsigned char *)&transs[itran
00555 - 1];
00556 if (itran == 1) {
00557 rcondc = rcondo;
00558 } else {
00559 rcondc = rcondi;
00560 }
00561
00562
00563
00564 clagtm_(trans, &n, &nrhs, &c_b63, &a[1], &a[m + 1], &a[n
00565 + m + 1], &xact[1], &lda, &c_b64, &b[1], &lda);
00566
00567
00568
00569
00570 clacpy_("Full", &n, &nrhs, &b[1], &lda, &x[1], &lda);
00571 s_copy(srnamc_1.srnamt, "CGTTRS", (ftnlen)32, (ftnlen)6);
00572 cgttrs_(trans, &n, &nrhs, &af[1], &af[m + 1], &af[n + m +
00573 1], &af[n + (m << 1) + 1], &iwork[1], &x[1], &lda,
00574 &info);
00575
00576
00577
00578 if (info != 0) {
00579 alaerh_(path, "CGTTRS", &info, &c__0, trans, &n, &n, &
00580 c_n1, &c_n1, &nrhs, &imat, &nfail, &nerrs,
00581 nout);
00582 }
00583
00584 clacpy_("Full", &n, &nrhs, &b[1], &lda, &work[1], &lda);
00585 cgtt02_(trans, &n, &nrhs, &a[1], &a[m + 1], &a[n + m + 1],
00586 &x[1], &lda, &work[1], &lda, &rwork[1], &result[
00587 1]);
00588
00589
00590
00591
00592 cget04_(&n, &nrhs, &x[1], &lda, &xact[1], &lda, &rcondc, &
00593 result[2]);
00594
00595
00596
00597
00598 s_copy(srnamc_1.srnamt, "CGTRFS", (ftnlen)32, (ftnlen)6);
00599 cgtrfs_(trans, &n, &nrhs, &a[1], &a[m + 1], &a[n + m + 1],
00600 &af[1], &af[m + 1], &af[n + m + 1], &af[n + (m <<
00601 1) + 1], &iwork[1], &b[1], &lda, &x[1], &lda, &
00602 rwork[1], &rwork[nrhs + 1], &work[1], &rwork[(
00603 nrhs << 1) + 1], &info);
00604
00605
00606
00607 if (info != 0) {
00608 alaerh_(path, "CGTRFS", &info, &c__0, trans, &n, &n, &
00609 c_n1, &c_n1, &nrhs, &imat, &nfail, &nerrs,
00610 nout);
00611 }
00612
00613 cget04_(&n, &nrhs, &x[1], &lda, &xact[1], &lda, &rcondc, &
00614 result[3]);
00615 cgtt05_(trans, &n, &nrhs, &a[1], &a[m + 1], &a[n + m + 1],
00616 &b[1], &lda, &x[1], &lda, &xact[1], &lda, &rwork[
00617 1], &rwork[nrhs + 1], &result[4]);
00618
00619
00620
00621
00622 for (k = 2; k <= 6; ++k) {
00623 if (result[k - 1] >= *thresh) {
00624 if (nfail == 0 && nerrs == 0) {
00625 alahd_(nout, path);
00626 }
00627 io___44.ciunit = *nout;
00628 s_wsfe(&io___44);
00629 do_fio(&c__1, trans, (ftnlen)1);
00630 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer))
00631 ;
00632 do_fio(&c__1, (char *)&nrhs, (ftnlen)sizeof(
00633 integer));
00634 do_fio(&c__1, (char *)&imat, (ftnlen)sizeof(
00635 integer));
00636 do_fio(&c__1, (char *)&k, (ftnlen)sizeof(integer))
00637 ;
00638 do_fio(&c__1, (char *)&result[k - 1], (ftnlen)
00639 sizeof(real));
00640 e_wsfe();
00641 ++nfail;
00642 }
00643
00644 }
00645 nrun += 5;
00646
00647 }
00648
00649 }
00650 L100:
00651 ;
00652 }
00653
00654 }
00655
00656
00657
00658 alasum_(path, nout, &nfail, &nrun, &nerrs);
00659
00660 return 0;
00661
00662
00663
00664 }