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__2 = 2;
00034 static integer c__0 = 0;
00035 static integer c_n1 = -1;
00036 static integer c__1 = 1;
00037 static integer c__8 = 8;
00038
00039 int schksy_(logical *dotype, integer *nn, integer *nval,
00040 integer *nnb, integer *nbval, integer *nns, integer *nsval, real *
00041 thresh, logical *tsterr, integer *nmax, real *a, real *afac, real *
00042 ainv, real *b, real *x, real *xact, real *work, real *rwork, integer *
00043 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;
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 real rcond;
00078 extern int sget04_(integer *, integer *, real *, integer
00079 *, real *, integer *, real *, real *);
00080 integer nimat;
00081 extern doublereal sget06_(real *, real *);
00082 real anorm;
00083 extern int spot02_(char *, integer *, integer *, real *,
00084 integer *, real *, integer *, real *, integer *, real *, real *);
00085 integer iuplo, izero, nerrs;
00086 extern int spot03_(char *, integer *, real *, integer *,
00087 real *, integer *, real *, integer *, real *, real *, real *), spot05_(char *, integer *, integer *, real *, integer *,
00088 real *, integer *, real *, integer *, real *, integer *, real *,
00089 real *, real *);
00090 integer lwork;
00091 logical zerot;
00092 extern int ssyt01_(char *, integer *, real *, integer *,
00093 real *, integer *, integer *, real *, integer *, real *, real *);
00094 char xtype[1];
00095 extern int slatb4_(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 alasum_(char *, integer *, integer *, integer
00102 *, integer *);
00103 real cndnum;
00104 logical trfcon;
00105 extern int slacpy_(char *, integer *, integer *, real *,
00106 integer *, real *, integer *), slarhs_(char *, char *,
00107 char *, char *, integer *, integer *, integer *, integer *,
00108 integer *, real *, integer *, real *, integer *, real *, integer *
00109 , integer *, integer *), xlaenv_(
00110 integer *, integer *), slatms_(integer *, integer *, char *,
00111 integer *, char *, real *, integer *, real *, real *, integer *,
00112 integer *, char *, real *, integer *, real *, integer *);
00113 extern doublereal slansy_(char *, char *, integer *, real *, integer *,
00114 real *);
00115 real result[8];
00116 extern int ssycon_(char *, integer *, real *, integer *,
00117 integer *, real *, real *, real *, integer *, integer *),
00118 serrsy_(char *, integer *), ssyrfs_(char *, integer *,
00119 integer *, real *, integer *, real *, integer *, integer *, real *
00120 , integer *, real *, integer *, real *, real *, real *, integer *,
00121 integer *), ssytrf_(char *, integer *, real *, integer *,
00122 integer *, real *, integer *, integer *), ssytri_(char *,
00123 integer *, real *, integer *, integer *, real *, integer *), ssytrs_(char *, integer *, integer *, real *, integer *,
00124 integer *, real *, integer *, integer *);
00125
00126
00127 static cilist io___39 = { 0, 0, 0, fmt_9999, 0 };
00128 static cilist io___42 = { 0, 0, 0, fmt_9998, 0 };
00129 static cilist io___44 = { 0, 0, 0, fmt_9997, 0 };
00130
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 --iwork;
00230 --rwork;
00231 --work;
00232 --xact;
00233 --x;
00234 --b;
00235 --ainv;
00236 --afac;
00237 --a;
00238 --nsval;
00239 --nbval;
00240 --nval;
00241 --dotype;
00242
00243
00244
00245
00246
00247
00248
00249 s_copy(path, "Single precision", (ftnlen)1, (ftnlen)16);
00250 s_copy(path + 1, "SY", (ftnlen)2, (ftnlen)2);
00251 nrun = 0;
00252 nfail = 0;
00253 nerrs = 0;
00254 for (i__ = 1; i__ <= 4; ++i__) {
00255 iseed[i__ - 1] = iseedy[i__ - 1];
00256
00257 }
00258
00259
00260
00261 if (*tsterr) {
00262 serrsy_(path, nout);
00263 }
00264 infoc_1.infot = 0;
00265 xlaenv_(&c__2, &c__2);
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 = 10;
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
00302
00303
00304 slatb4_(path, &imat, &n, &n, type__, &kl, &ku, &anorm, &mode,
00305 &cndnum, dist);
00306
00307 s_copy(srnamc_1.srnamt, "SLATMS", (ftnlen)32, (ftnlen)6);
00308 slatms_(&n, &n, dist, iseed, type__, &rwork[1], &mode, &
00309 cndnum, &anorm, &kl, &ku, uplo, &a[1], &lda, &work[1],
00310 &info);
00311
00312
00313
00314 if (info != 0) {
00315 alaerh_(path, "SLATMS", &info, &c__0, uplo, &n, &n, &c_n1,
00316 &c_n1, &c_n1, &imat, &nfail, &nerrs, nout);
00317 goto L160;
00318 }
00319
00320
00321
00322
00323 if (zerot) {
00324 if (imat == 3) {
00325 izero = 1;
00326 } else if (imat == 4) {
00327 izero = n;
00328 } else {
00329 izero = n / 2 + 1;
00330 }
00331
00332 if (imat < 6) {
00333
00334
00335
00336 if (iuplo == 1) {
00337 ioff = (izero - 1) * lda;
00338 i__3 = izero - 1;
00339 for (i__ = 1; i__ <= i__3; ++i__) {
00340 a[ioff + i__] = 0.f;
00341
00342 }
00343 ioff += izero;
00344 i__3 = n;
00345 for (i__ = izero; i__ <= i__3; ++i__) {
00346 a[ioff] = 0.f;
00347 ioff += lda;
00348
00349 }
00350 } else {
00351 ioff = izero;
00352 i__3 = izero - 1;
00353 for (i__ = 1; i__ <= i__3; ++i__) {
00354 a[ioff] = 0.f;
00355 ioff += lda;
00356
00357 }
00358 ioff -= izero;
00359 i__3 = n;
00360 for (i__ = izero; i__ <= i__3; ++i__) {
00361 a[ioff + i__] = 0.f;
00362
00363 }
00364 }
00365 } else {
00366 ioff = 0;
00367 if (iuplo == 1) {
00368
00369
00370
00371 i__3 = n;
00372 for (j = 1; j <= i__3; ++j) {
00373 i2 = min(j,izero);
00374 i__4 = i2;
00375 for (i__ = 1; i__ <= i__4; ++i__) {
00376 a[ioff + i__] = 0.f;
00377
00378 }
00379 ioff += lda;
00380
00381 }
00382 } else {
00383
00384
00385
00386 i__3 = n;
00387 for (j = 1; j <= i__3; ++j) {
00388 i1 = max(j,izero);
00389 i__4 = n;
00390 for (i__ = i1; i__ <= i__4; ++i__) {
00391 a[ioff + i__] = 0.f;
00392
00393 }
00394 ioff += lda;
00395
00396 }
00397 }
00398 }
00399 } else {
00400 izero = 0;
00401 }
00402
00403
00404
00405 i__3 = *nnb;
00406 for (inb = 1; inb <= i__3; ++inb) {
00407 nb = nbval[inb];
00408 xlaenv_(&c__1, &nb);
00409
00410
00411
00412
00413 slacpy_(uplo, &n, &n, &a[1], &lda, &afac[1], &lda);
00414 lwork = max(2,nb) * lda;
00415 s_copy(srnamc_1.srnamt, "SSYTRF", (ftnlen)32, (ftnlen)6);
00416 ssytrf_(uplo, &n, &afac[1], &lda, &iwork[1], &ainv[1], &
00417 lwork, &info);
00418
00419
00420
00421
00422 k = izero;
00423 if (k > 0) {
00424 L100:
00425 if (iwork[k] < 0) {
00426 if (iwork[k] != -k) {
00427 k = -iwork[k];
00428 goto L100;
00429 }
00430 } else if (iwork[k] != k) {
00431 k = iwork[k];
00432 goto L100;
00433 }
00434 }
00435
00436
00437
00438 if (info != k) {
00439 alaerh_(path, "SSYTRF", &info, &k, uplo, &n, &n, &
00440 c_n1, &c_n1, &nb, &imat, &nfail, &nerrs, nout);
00441 }
00442 if (info != 0) {
00443 trfcon = TRUE_;
00444 } else {
00445 trfcon = FALSE_;
00446 }
00447
00448
00449
00450
00451 ssyt01_(uplo, &n, &a[1], &lda, &afac[1], &lda, &iwork[1],
00452 &ainv[1], &lda, &rwork[1], result);
00453 nt = 1;
00454
00455
00456
00457
00458 if (inb == 1 && ! trfcon) {
00459 slacpy_(uplo, &n, &n, &afac[1], &lda, &ainv[1], &lda);
00460 s_copy(srnamc_1.srnamt, "SSYTRI", (ftnlen)32, (ftnlen)
00461 6);
00462 ssytri_(uplo, &n, &ainv[1], &lda, &iwork[1], &work[1],
00463 &info);
00464
00465
00466
00467 if (info != 0) {
00468 alaerh_(path, "SSYTRI", &info, &c_n1, uplo, &n, &
00469 n, &c_n1, &c_n1, &c_n1, &imat, &nfail, &
00470 nerrs, nout);
00471 }
00472
00473 spot03_(uplo, &n, &a[1], &lda, &ainv[1], &lda, &work[
00474 1], &lda, &rwork[1], &rcondc, &result[1]);
00475 nt = 2;
00476 }
00477
00478
00479
00480
00481 i__4 = nt;
00482 for (k = 1; k <= i__4; ++k) {
00483 if (result[k - 1] >= *thresh) {
00484 if (nfail == 0 && nerrs == 0) {
00485 alahd_(nout, path);
00486 }
00487 io___39.ciunit = *nout;
00488 s_wsfe(&io___39);
00489 do_fio(&c__1, uplo, (ftnlen)1);
00490 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer))
00491 ;
00492 do_fio(&c__1, (char *)&nb, (ftnlen)sizeof(integer)
00493 );
00494 do_fio(&c__1, (char *)&imat, (ftnlen)sizeof(
00495 integer));
00496 do_fio(&c__1, (char *)&k, (ftnlen)sizeof(integer))
00497 ;
00498 do_fio(&c__1, (char *)&result[k - 1], (ftnlen)
00499 sizeof(real));
00500 e_wsfe();
00501 ++nfail;
00502 }
00503
00504 }
00505 nrun += nt;
00506
00507
00508
00509
00510 if (inb > 1) {
00511 goto L150;
00512 }
00513
00514
00515
00516 if (trfcon) {
00517 rcondc = 0.f;
00518 goto L140;
00519 }
00520
00521 i__4 = *nns;
00522 for (irhs = 1; irhs <= i__4; ++irhs) {
00523 nrhs = nsval[irhs];
00524
00525
00526
00527
00528 s_copy(srnamc_1.srnamt, "SLARHS", (ftnlen)32, (ftnlen)
00529 6);
00530 slarhs_(path, xtype, uplo, " ", &n, &n, &kl, &ku, &
00531 nrhs, &a[1], &lda, &xact[1], &lda, &b[1], &
00532 lda, iseed, &info);
00533 slacpy_("Full", &n, &nrhs, &b[1], &lda, &x[1], &lda);
00534
00535 s_copy(srnamc_1.srnamt, "SSYTRS", (ftnlen)32, (ftnlen)
00536 6);
00537 ssytrs_(uplo, &n, &nrhs, &afac[1], &lda, &iwork[1], &
00538 x[1], &lda, &info);
00539
00540
00541
00542 if (info != 0) {
00543 alaerh_(path, "SSYTRS", &info, &c__0, uplo, &n, &
00544 n, &c_n1, &c_n1, &nrhs, &imat, &nfail, &
00545 nerrs, nout);
00546 }
00547
00548 slacpy_("Full", &n, &nrhs, &b[1], &lda, &work[1], &
00549 lda);
00550 spot02_(uplo, &n, &nrhs, &a[1], &lda, &x[1], &lda, &
00551 work[1], &lda, &rwork[1], &result[2]);
00552
00553
00554
00555
00556 sget04_(&n, &nrhs, &x[1], &lda, &xact[1], &lda, &
00557 rcondc, &result[3]);
00558
00559
00560
00561
00562 s_copy(srnamc_1.srnamt, "SSYRFS", (ftnlen)32, (ftnlen)
00563 6);
00564 ssyrfs_(uplo, &n, &nrhs, &a[1], &lda, &afac[1], &lda,
00565 &iwork[1], &b[1], &lda, &x[1], &lda, &rwork[1]
00566 , &rwork[nrhs + 1], &work[1], &iwork[n + 1], &
00567 info);
00568
00569
00570
00571 if (info != 0) {
00572 alaerh_(path, "SSYRFS", &info, &c__0, uplo, &n, &
00573 n, &c_n1, &c_n1, &nrhs, &imat, &nfail, &
00574 nerrs, nout);
00575 }
00576
00577 sget04_(&n, &nrhs, &x[1], &lda, &xact[1], &lda, &
00578 rcondc, &result[4]);
00579 spot05_(uplo, &n, &nrhs, &a[1], &lda, &b[1], &lda, &x[
00580 1], &lda, &xact[1], &lda, &rwork[1], &rwork[
00581 nrhs + 1], &result[5]);
00582
00583
00584
00585
00586 for (k = 3; k <= 7; ++k) {
00587 if (result[k - 1] >= *thresh) {
00588 if (nfail == 0 && nerrs == 0) {
00589 alahd_(nout, path);
00590 }
00591 io___42.ciunit = *nout;
00592 s_wsfe(&io___42);
00593 do_fio(&c__1, uplo, (ftnlen)1);
00594 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(
00595 integer));
00596 do_fio(&c__1, (char *)&nrhs, (ftnlen)sizeof(
00597 integer));
00598 do_fio(&c__1, (char *)&imat, (ftnlen)sizeof(
00599 integer));
00600 do_fio(&c__1, (char *)&k, (ftnlen)sizeof(
00601 integer));
00602 do_fio(&c__1, (char *)&result[k - 1], (ftnlen)
00603 sizeof(real));
00604 e_wsfe();
00605 ++nfail;
00606 }
00607
00608 }
00609 nrun += 5;
00610
00611 }
00612
00613
00614
00615
00616 L140:
00617 anorm = slansy_("1", uplo, &n, &a[1], &lda, &rwork[1]);
00618 s_copy(srnamc_1.srnamt, "SSYCON", (ftnlen)32, (ftnlen)6);
00619 ssycon_(uplo, &n, &afac[1], &lda, &iwork[1], &anorm, &
00620 rcond, &work[1], &iwork[n + 1], &info);
00621
00622
00623
00624 if (info != 0) {
00625 alaerh_(path, "SSYCON", &info, &c__0, uplo, &n, &n, &
00626 c_n1, &c_n1, &c_n1, &imat, &nfail, &nerrs,
00627 nout);
00628 }
00629
00630 result[7] = sget06_(&rcond, &rcondc);
00631
00632
00633
00634
00635 if (result[7] >= *thresh) {
00636 if (nfail == 0 && nerrs == 0) {
00637 alahd_(nout, path);
00638 }
00639 io___44.ciunit = *nout;
00640 s_wsfe(&io___44);
00641 do_fio(&c__1, uplo, (ftnlen)1);
00642 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
00643 do_fio(&c__1, (char *)&imat, (ftnlen)sizeof(integer));
00644 do_fio(&c__1, (char *)&c__8, (ftnlen)sizeof(integer));
00645 do_fio(&c__1, (char *)&result[7], (ftnlen)sizeof(real)
00646 );
00647 e_wsfe();
00648 ++nfail;
00649 }
00650 ++nrun;
00651 L150:
00652 ;
00653 }
00654
00655 L160:
00656 ;
00657 }
00658 L170:
00659 ;
00660 }
00661
00662 }
00663
00664
00665
00666 alasum_(path, nout, &nfail, &nrun, &nerrs);
00667
00668 return 0;
00669
00670
00671
00672 }