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