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