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