00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013 #include "f2c.h"
00014 #include "blaswrap.h"
00015
00016
00017
00018 static real c_b18 = 0.f;
00019 static integer c__0 = 0;
00020 static integer c__6 = 6;
00021 static real c_b35 = 1.f;
00022 static integer c__1 = 1;
00023 static integer c__4 = 4;
00024 static integer c__5 = 5;
00025 static real c_b82 = 10.f;
00026 static integer c__3 = 3;
00027
00028 int sdrvsg_(integer *nsizes, integer *nn, integer *ntypes,
00029 logical *dotype, integer *iseed, real *thresh, integer *nounit, real *
00030 a, integer *lda, real *b, integer *ldb, real *d__, real *z__, integer
00031 *ldz, real *ab, real *bb, real *ap, real *bp, real *work, integer *
00032 nwork, integer *iwork, integer *liwork, real *result, integer *info)
00033 {
00034
00035
00036 static integer ktype[21] = { 1,2,4,4,4,4,4,5,5,5,5,5,8,8,8,9,9,9,9,9,9 };
00037 static integer kmagn[21] = { 1,1,1,1,1,2,3,1,1,1,2,3,1,2,3,1,1,1,1,1,1 };
00038 static integer kmode[21] = { 0,0,4,3,1,4,4,4,3,1,4,4,0,0,0,4,4,4,4,4,4 };
00039
00040
00041 static char fmt_9999[] = "(\002 SDRVSG: \002,a,\002 returned INFO=\002,i"
00042 "6,\002.\002,/9x,\002N=\002,i6,\002, JTYPE=\002,i6,\002, ISEED="
00043 "(\002,3(i5,\002,\002),i5,\002)\002)";
00044
00045
00046 address a__1[3];
00047 integer a_dim1, a_offset, ab_dim1, ab_offset, b_dim1, b_offset, bb_dim1,
00048 bb_offset, z_dim1, z_offset, i__1, i__2, i__3, i__4, i__5, i__6[3]
00049 , i__7;
00050 char ch__1[10], ch__2[11], ch__3[12], ch__4[13];
00051
00052
00053 double sqrt(doublereal);
00054 integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void);
00055 int s_cat(char *, char **, integer *, integer *, ftnlen);
00056
00057
00058 integer i__, j, m, n, ka, kb, ij, il, iu;
00059 real vl, vu;
00060 integer ka9, kb9;
00061 real ulp, cond;
00062 integer jcol, nmax;
00063 real unfl, ovfl;
00064 char uplo[1];
00065 logical badnn;
00066 integer imode;
00067 extern logical lsame_(char *, char *);
00068 integer iinfo;
00069 real aninv, anorm;
00070 integer itemp;
00071 extern int ssgt01_(integer *, char *, integer *, integer
00072 *, real *, integer *, real *, integer *, real *, integer *, real *
00073 , real *, real *);
00074 integer nmats, jsize;
00075 extern int ssbgv_(char *, char *, integer *, integer *,
00076 integer *, real *, integer *, real *, integer *, real *, real *,
00077 integer *, real *, integer *);
00078 integer nerrs, itype, jtype, ntest;
00079 extern int sspgv_(integer *, char *, char *, integer *,
00080 real *, real *, real *, real *, integer *, real *, integer *);
00081 integer iseed2[4];
00082 extern int ssygv_(integer *, char *, char *, integer *,
00083 real *, integer *, real *, integer *, real *, real *, integer *,
00084 integer *), slabad_(real *, real *);
00085 extern doublereal slamch_(char *);
00086 integer idumma[1];
00087 extern int xerbla_(char *, integer *);
00088 integer ioldsd[4];
00089 extern doublereal slarnd_(integer *, integer *);
00090 real abstol;
00091 extern int ssbgvd_(char *, char *, integer *, integer *,
00092 integer *, real *, integer *, real *, integer *, real *, real *,
00093 integer *, real *, integer *, integer *, integer *, integer *);
00094 integer ibuplo;
00095 extern int slacpy_(char *, integer *, integer *, real *,
00096 integer *, real *, integer *);
00097 integer ibtype;
00098 extern int slafts_(char *, integer *, integer *, integer
00099 *, integer *, real *, integer *, real *, integer *, integer *), slaset_(char *, integer *, integer *, real *, real *,
00100 real *, integer *), slatmr_(integer *, integer *, char *,
00101 integer *, char *, real *, integer *, real *, real *, char *,
00102 char *, real *, integer *, real *, real *, integer *, real *,
00103 char *, integer *, integer *, integer *, real *, real *, char *,
00104 real *, integer *, integer *, integer *), slatms_(integer *, integer *, char *,
00105 integer *, char *, real *, integer *, real *, real *, integer *,
00106 integer *, char *, real *, integer *, real *, integer *), slasum_(char *, integer *, integer *, integer *), sspgvd_(integer *, char *, char *, integer *, real *,
00107 real *, real *, real *, integer *, real *, integer *, integer *,
00108 integer *, integer *);
00109 real rtunfl, rtovfl, ulpinv;
00110 extern int ssbgvx_(char *, char *, char *, integer *,
00111 integer *, integer *, real *, integer *, real *, integer *, real *
00112 , integer *, real *, real *, integer *, integer *, real *,
00113 integer *, real *, real *, integer *, real *, integer *, integer *
00114 , integer *);
00115 integer mtypes, ntestt;
00116 extern int ssygvd_(integer *, char *, char *, integer *,
00117 real *, integer *, real *, integer *, real *, real *, integer *,
00118 integer *, integer *, integer *), sspgvx_(integer
00119 *, char *, char *, char *, integer *, real *, real *, real *,
00120 real *, integer *, integer *, real *, integer *, real *, real *,
00121 integer *, real *, integer *, integer *, integer *), ssygvx_(integer *, char *, char *, char *,
00122 integer *, real *, integer *, real *, integer *, real *, real *,
00123 integer *, integer *, real *, integer *, real *, real *, integer *
00124 , real *, integer *, integer *, integer *, integer *);
00125
00126
00127 static cilist io___36 = { 0, 0, 0, fmt_9999, 0 };
00128 static cilist io___44 = { 0, 0, 0, fmt_9999, 0 };
00129 static cilist io___45 = { 0, 0, 0, fmt_9999, 0 };
00130 static cilist io___49 = { 0, 0, 0, fmt_9999, 0 };
00131 static cilist io___50 = { 0, 0, 0, fmt_9999, 0 };
00132 static cilist io___51 = { 0, 0, 0, fmt_9999, 0 };
00133 static cilist io___53 = { 0, 0, 0, fmt_9999, 0 };
00134 static cilist io___54 = { 0, 0, 0, fmt_9999, 0 };
00135 static cilist io___55 = { 0, 0, 0, fmt_9999, 0 };
00136 static cilist io___56 = { 0, 0, 0, fmt_9999, 0 };
00137 static cilist io___57 = { 0, 0, 0, fmt_9999, 0 };
00138 static cilist io___58 = { 0, 0, 0, fmt_9999, 0 };
00139 static cilist io___59 = { 0, 0, 0, fmt_9999, 0 };
00140 static cilist io___60 = { 0, 0, 0, fmt_9999, 0 };
00141 static cilist io___61 = { 0, 0, 0, fmt_9999, 0 };
00142 static cilist io___62 = { 0, 0, 0, fmt_9999, 0 };
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
00237
00238
00239
00240
00241
00242
00243
00244
00245
00246
00247
00248
00249
00250
00251
00252
00253
00254
00255
00256
00257
00258
00259
00260
00261
00262
00263
00264
00265
00266
00267
00268
00269
00270
00271
00272
00273
00274
00275
00276
00277
00278
00279
00280
00281
00282
00283
00284
00285
00286
00287
00288
00289
00290
00291
00292
00293
00294
00295
00296
00297
00298
00299
00300
00301
00302
00303
00304
00305
00306
00307
00308
00309
00310
00311
00312
00313
00314
00315
00316
00317
00318
00319
00320
00321
00322
00323
00324
00325
00326
00327
00328
00329
00330
00331
00332
00333
00334
00335
00336
00337
00338
00339
00340
00341
00342
00343
00344
00345
00346
00347
00348
00349
00350
00351
00352
00353
00354
00355
00356
00357
00358
00359
00360
00361
00362
00363
00364
00365
00366
00367
00368
00369
00370
00371
00372
00373
00374
00375
00376
00377
00378
00379
00380
00381
00382
00383
00384
00385
00386
00387
00388
00389
00390
00391
00392
00393
00394
00395
00396
00397
00398
00399
00400
00401
00402
00403
00404
00405
00406
00407
00408
00409
00410
00411
00412
00413
00414
00415
00416
00417
00418
00419
00420
00421
00422
00423
00424
00425
00426
00427
00428
00429
00430
00431
00432
00433
00434
00435
00436
00437
00438
00439
00440
00441
00442
00443
00444
00445
00446
00447
00448
00449
00450
00451
00452
00453
00454
00455
00456
00457
00458
00459
00460
00461
00462
00463
00464
00465
00466
00467
00468
00469
00470
00471
00472
00473
00474
00475
00476
00477
00478
00479
00480
00481
00482
00483
00484
00485
00486
00487 --nn;
00488 --dotype;
00489 --iseed;
00490 ab_dim1 = *lda;
00491 ab_offset = 1 + ab_dim1;
00492 ab -= ab_offset;
00493 a_dim1 = *lda;
00494 a_offset = 1 + a_dim1;
00495 a -= a_offset;
00496 bb_dim1 = *ldb;
00497 bb_offset = 1 + bb_dim1;
00498 bb -= bb_offset;
00499 b_dim1 = *ldb;
00500 b_offset = 1 + b_dim1;
00501 b -= b_offset;
00502 --d__;
00503 z_dim1 = *ldz;
00504 z_offset = 1 + z_dim1;
00505 z__ -= z_offset;
00506 --ap;
00507 --bp;
00508 --work;
00509 --iwork;
00510 --result;
00511
00512
00513
00514
00515
00516
00517
00518 ntestt = 0;
00519 *info = 0;
00520
00521 badnn = FALSE_;
00522 nmax = 0;
00523 i__1 = *nsizes;
00524 for (j = 1; j <= i__1; ++j) {
00525
00526 i__2 = nmax, i__3 = nn[j];
00527 nmax = max(i__2,i__3);
00528 if (nn[j] < 0) {
00529 badnn = TRUE_;
00530 }
00531
00532 }
00533
00534
00535
00536 if (*nsizes < 0) {
00537 *info = -1;
00538 } else if (badnn) {
00539 *info = -2;
00540 } else if (*ntypes < 0) {
00541 *info = -3;
00542 } else if (*lda <= 1 || *lda < nmax) {
00543 *info = -9;
00544 } else if (*ldz <= 1 || *ldz < nmax) {
00545 *info = -16;
00546 } else {
00547
00548 i__1 = max(nmax,3);
00549 if (i__1 * i__1 << 1 > *nwork) {
00550 *info = -21;
00551 } else {
00552
00553 i__1 = max(nmax,3);
00554 if (i__1 * i__1 << 1 > *liwork) {
00555 *info = -23;
00556 }
00557 }
00558 }
00559
00560 if (*info != 0) {
00561 i__1 = -(*info);
00562 xerbla_("SDRVSG", &i__1);
00563 return 0;
00564 }
00565
00566
00567
00568 if (*nsizes == 0 || *ntypes == 0) {
00569 return 0;
00570 }
00571
00572
00573
00574 unfl = slamch_("Safe minimum");
00575 ovfl = slamch_("Overflow");
00576 slabad_(&unfl, &ovfl);
00577 ulp = slamch_("Epsilon") * slamch_("Base");
00578 ulpinv = 1.f / ulp;
00579 rtunfl = sqrt(unfl);
00580 rtovfl = sqrt(ovfl);
00581
00582 for (i__ = 1; i__ <= 4; ++i__) {
00583 iseed2[i__ - 1] = iseed[i__];
00584
00585 }
00586
00587
00588
00589 nerrs = 0;
00590 nmats = 0;
00591
00592 i__1 = *nsizes;
00593 for (jsize = 1; jsize <= i__1; ++jsize) {
00594 n = nn[jsize];
00595 aninv = 1.f / (real) max(1,n);
00596
00597 if (*nsizes != 1) {
00598 mtypes = min(21,*ntypes);
00599 } else {
00600 mtypes = min(22,*ntypes);
00601 }
00602
00603 ka9 = 0;
00604 kb9 = 0;
00605 i__2 = mtypes;
00606 for (jtype = 1; jtype <= i__2; ++jtype) {
00607 if (! dotype[jtype]) {
00608 goto L640;
00609 }
00610 ++nmats;
00611 ntest = 0;
00612
00613 for (j = 1; j <= 4; ++j) {
00614 ioldsd[j - 1] = iseed[j];
00615
00616 }
00617
00618
00619
00620
00621
00622
00623
00624
00625
00626
00627
00628
00629
00630
00631
00632
00633 if (mtypes > 21) {
00634 goto L90;
00635 }
00636
00637 itype = ktype[jtype - 1];
00638 imode = kmode[jtype - 1];
00639
00640
00641
00642 switch (kmagn[jtype - 1]) {
00643 case 1: goto L40;
00644 case 2: goto L50;
00645 case 3: goto L60;
00646 }
00647
00648 L40:
00649 anorm = 1.f;
00650 goto L70;
00651
00652 L50:
00653 anorm = rtovfl * ulp * aninv;
00654 goto L70;
00655
00656 L60:
00657 anorm = rtunfl * n * ulpinv;
00658 goto L70;
00659
00660 L70:
00661
00662 iinfo = 0;
00663 cond = ulpinv;
00664
00665
00666
00667 if (itype == 1) {
00668
00669
00670
00671 ka = 0;
00672 kb = 0;
00673 slaset_("Full", lda, &n, &c_b18, &c_b18, &a[a_offset], lda);
00674
00675 } else if (itype == 2) {
00676
00677
00678
00679 ka = 0;
00680 kb = 0;
00681 slaset_("Full", lda, &n, &c_b18, &c_b18, &a[a_offset], lda);
00682 i__3 = n;
00683 for (jcol = 1; jcol <= i__3; ++jcol) {
00684 a[jcol + jcol * a_dim1] = anorm;
00685
00686 }
00687
00688 } else if (itype == 4) {
00689
00690
00691
00692 ka = 0;
00693 kb = 0;
00694 slatms_(&n, &n, "S", &iseed[1], "S", &work[1], &imode, &cond,
00695 &anorm, &c__0, &c__0, "N", &a[a_offset], lda, &work[n
00696 + 1], &iinfo);
00697
00698 } else if (itype == 5) {
00699
00700
00701
00702
00703 i__3 = 0, i__4 = n - 1;
00704 ka = max(i__3,i__4);
00705 kb = ka;
00706 slatms_(&n, &n, "S", &iseed[1], "S", &work[1], &imode, &cond,
00707 &anorm, &n, &n, "N", &a[a_offset], lda, &work[n + 1],
00708 &iinfo);
00709
00710 } else if (itype == 7) {
00711
00712
00713
00714 ka = 0;
00715 kb = 0;
00716 slatmr_(&n, &n, "S", &iseed[1], "S", &work[1], &c__6, &c_b35,
00717 &c_b35, "T", "N", &work[n + 1], &c__1, &c_b35, &work[(
00718 n << 1) + 1], &c__1, &c_b35, "N", idumma, &c__0, &
00719 c__0, &c_b18, &anorm, "NO", &a[a_offset], lda, &iwork[
00720 1], &iinfo);
00721
00722 } else if (itype == 8) {
00723
00724
00725
00726
00727 i__3 = 0, i__4 = n - 1;
00728 ka = max(i__3,i__4);
00729 kb = ka;
00730 slatmr_(&n, &n, "S", &iseed[1], "H", &work[1], &c__6, &c_b35,
00731 &c_b35, "T", "N", &work[n + 1], &c__1, &c_b35, &work[(
00732 n << 1) + 1], &c__1, &c_b35, "N", idumma, &n, &n, &
00733 c_b18, &anorm, "NO", &a[a_offset], lda, &iwork[1], &
00734 iinfo);
00735
00736 } else if (itype == 9) {
00737
00738
00739
00740
00741
00742
00743
00744
00745
00746
00747
00748
00749 ++kb9;
00750 if (kb9 > ka9) {
00751 ++ka9;
00752 kb9 = 1;
00753 }
00754
00755
00756 i__5 = n - 1;
00757 i__3 = 0, i__4 = min(i__5,ka9);
00758 ka = max(i__3,i__4);
00759
00760
00761 i__5 = n - 1;
00762 i__3 = 0, i__4 = min(i__5,kb9);
00763 kb = max(i__3,i__4);
00764 slatms_(&n, &n, "S", &iseed[1], "S", &work[1], &imode, &cond,
00765 &anorm, &ka, &ka, "N", &a[a_offset], lda, &work[n + 1]
00766 , &iinfo);
00767
00768 } else {
00769
00770 iinfo = 1;
00771 }
00772
00773 if (iinfo != 0) {
00774 io___36.ciunit = *nounit;
00775 s_wsfe(&io___36);
00776 do_fio(&c__1, "Generator", (ftnlen)9);
00777 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
00778 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
00779 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
00780 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer));
00781 e_wsfe();
00782 *info = abs(iinfo);
00783 return 0;
00784 }
00785
00786 L90:
00787
00788 abstol = unfl + unfl;
00789 if (n <= 1) {
00790 il = 1;
00791 iu = n;
00792 } else {
00793 il = (n - 1) * slarnd_(&c__1, iseed2) + 1;
00794 iu = (n - 1) * slarnd_(&c__1, iseed2) + 1;
00795 if (il > iu) {
00796 itemp = il;
00797 il = iu;
00798 iu = itemp;
00799 }
00800 }
00801
00802
00803
00804
00805
00806
00807
00808
00809
00810 for (ibtype = 1; ibtype <= 3; ++ibtype) {
00811
00812
00813
00814 for (ibuplo = 1; ibuplo <= 2; ++ibuplo) {
00815 if (ibuplo == 1) {
00816 *(unsigned char *)uplo = 'U';
00817 }
00818 if (ibuplo == 2) {
00819 *(unsigned char *)uplo = 'L';
00820 }
00821
00822
00823
00824
00825 slatms_(&n, &n, "U", &iseed[1], "P", &work[1], &c__5, &
00826 c_b82, &c_b35, &kb, &kb, uplo, &b[b_offset], ldb,
00827 &work[n + 1], &iinfo);
00828
00829
00830
00831 ++ntest;
00832
00833 slacpy_(" ", &n, &n, &a[a_offset], lda, &z__[z_offset],
00834 ldz);
00835 slacpy_(uplo, &n, &n, &b[b_offset], ldb, &bb[bb_offset],
00836 ldb);
00837
00838 ssygv_(&ibtype, "V", uplo, &n, &z__[z_offset], ldz, &bb[
00839 bb_offset], ldb, &d__[1], &work[1], nwork, &iinfo);
00840 if (iinfo != 0) {
00841 io___44.ciunit = *nounit;
00842 s_wsfe(&io___44);
00843
00844 i__6[0] = 8, a__1[0] = "SSYGV(V,";
00845 i__6[1] = 1, a__1[1] = uplo;
00846 i__6[2] = 1, a__1[2] = ")";
00847 s_cat(ch__1, a__1, i__6, &c__3, (ftnlen)10);
00848 do_fio(&c__1, ch__1, (ftnlen)10);
00849 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer))
00850 ;
00851 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
00852 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer))
00853 ;
00854 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(
00855 integer));
00856 e_wsfe();
00857 *info = abs(iinfo);
00858 if (iinfo < 0) {
00859 return 0;
00860 } else {
00861 result[ntest] = ulpinv;
00862 goto L100;
00863 }
00864 }
00865
00866
00867
00868 ssgt01_(&ibtype, uplo, &n, &n, &a[a_offset], lda, &b[
00869 b_offset], ldb, &z__[z_offset], ldz, &d__[1], &
00870 work[1], &result[ntest]);
00871
00872
00873
00874 ++ntest;
00875
00876 slacpy_(" ", &n, &n, &a[a_offset], lda, &z__[z_offset],
00877 ldz);
00878 slacpy_(uplo, &n, &n, &b[b_offset], ldb, &bb[bb_offset],
00879 ldb);
00880
00881 ssygvd_(&ibtype, "V", uplo, &n, &z__[z_offset], ldz, &bb[
00882 bb_offset], ldb, &d__[1], &work[1], nwork, &iwork[
00883 1], liwork, &iinfo);
00884 if (iinfo != 0) {
00885 io___45.ciunit = *nounit;
00886 s_wsfe(&io___45);
00887
00888 i__6[0] = 9, a__1[0] = "SSYGVD(V,";
00889 i__6[1] = 1, a__1[1] = uplo;
00890 i__6[2] = 1, a__1[2] = ")";
00891 s_cat(ch__2, a__1, i__6, &c__3, (ftnlen)11);
00892 do_fio(&c__1, ch__2, (ftnlen)11);
00893 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer))
00894 ;
00895 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
00896 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer))
00897 ;
00898 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(
00899 integer));
00900 e_wsfe();
00901 *info = abs(iinfo);
00902 if (iinfo < 0) {
00903 return 0;
00904 } else {
00905 result[ntest] = ulpinv;
00906 goto L100;
00907 }
00908 }
00909
00910
00911
00912 ssgt01_(&ibtype, uplo, &n, &n, &a[a_offset], lda, &b[
00913 b_offset], ldb, &z__[z_offset], ldz, &d__[1], &
00914 work[1], &result[ntest]);
00915
00916
00917
00918 ++ntest;
00919
00920 slacpy_(" ", &n, &n, &a[a_offset], lda, &ab[ab_offset],
00921 lda);
00922 slacpy_(uplo, &n, &n, &b[b_offset], ldb, &bb[bb_offset],
00923 ldb);
00924
00925 ssygvx_(&ibtype, "V", "A", uplo, &n, &ab[ab_offset], lda,
00926 &bb[bb_offset], ldb, &vl, &vu, &il, &iu, &abstol,
00927 &m, &d__[1], &z__[z_offset], ldz, &work[1], nwork,
00928 &iwork[n + 1], &iwork[1], &iinfo);
00929 if (iinfo != 0) {
00930 io___49.ciunit = *nounit;
00931 s_wsfe(&io___49);
00932
00933 i__6[0] = 10, a__1[0] = "SSYGVX(V,A";
00934 i__6[1] = 1, a__1[1] = uplo;
00935 i__6[2] = 1, a__1[2] = ")";
00936 s_cat(ch__3, a__1, i__6, &c__3, (ftnlen)12);
00937 do_fio(&c__1, ch__3, (ftnlen)12);
00938 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer))
00939 ;
00940 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
00941 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer))
00942 ;
00943 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(
00944 integer));
00945 e_wsfe();
00946 *info = abs(iinfo);
00947 if (iinfo < 0) {
00948 return 0;
00949 } else {
00950 result[ntest] = ulpinv;
00951 goto L100;
00952 }
00953 }
00954
00955
00956
00957 ssgt01_(&ibtype, uplo, &n, &n, &a[a_offset], lda, &b[
00958 b_offset], ldb, &z__[z_offset], ldz, &d__[1], &
00959 work[1], &result[ntest]);
00960
00961 ++ntest;
00962
00963 slacpy_(" ", &n, &n, &a[a_offset], lda, &ab[ab_offset],
00964 lda);
00965 slacpy_(uplo, &n, &n, &b[b_offset], ldb, &bb[bb_offset],
00966 ldb);
00967
00968
00969
00970
00971
00972
00973 vl = 0.f;
00974 vu = anorm;
00975 ssygvx_(&ibtype, "V", "V", uplo, &n, &ab[ab_offset], lda,
00976 &bb[bb_offset], ldb, &vl, &vu, &il, &iu, &abstol,
00977 &m, &d__[1], &z__[z_offset], ldz, &work[1], nwork,
00978 &iwork[n + 1], &iwork[1], &iinfo);
00979 if (iinfo != 0) {
00980 io___50.ciunit = *nounit;
00981 s_wsfe(&io___50);
00982
00983 i__6[0] = 11, a__1[0] = "SSYGVX(V,V,";
00984 i__6[1] = 1, a__1[1] = uplo;
00985 i__6[2] = 1, a__1[2] = ")";
00986 s_cat(ch__4, a__1, i__6, &c__3, (ftnlen)13);
00987 do_fio(&c__1, ch__4, (ftnlen)13);
00988 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer))
00989 ;
00990 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
00991 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer))
00992 ;
00993 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(
00994 integer));
00995 e_wsfe();
00996 *info = abs(iinfo);
00997 if (iinfo < 0) {
00998 return 0;
00999 } else {
01000 result[ntest] = ulpinv;
01001 goto L100;
01002 }
01003 }
01004
01005
01006
01007 ssgt01_(&ibtype, uplo, &n, &m, &a[a_offset], lda, &b[
01008 b_offset], ldb, &z__[z_offset], ldz, &d__[1], &
01009 work[1], &result[ntest]);
01010
01011 ++ntest;
01012
01013 slacpy_(" ", &n, &n, &a[a_offset], lda, &ab[ab_offset],
01014 lda);
01015 slacpy_(uplo, &n, &n, &b[b_offset], ldb, &bb[bb_offset],
01016 ldb);
01017
01018 ssygvx_(&ibtype, "V", "I", uplo, &n, &ab[ab_offset], lda,
01019 &bb[bb_offset], ldb, &vl, &vu, &il, &iu, &abstol,
01020 &m, &d__[1], &z__[z_offset], ldz, &work[1], nwork,
01021 &iwork[n + 1], &iwork[1], &iinfo);
01022 if (iinfo != 0) {
01023 io___51.ciunit = *nounit;
01024 s_wsfe(&io___51);
01025
01026 i__6[0] = 11, a__1[0] = "SSYGVX(V,I,";
01027 i__6[1] = 1, a__1[1] = uplo;
01028 i__6[2] = 1, a__1[2] = ")";
01029 s_cat(ch__4, a__1, i__6, &c__3, (ftnlen)13);
01030 do_fio(&c__1, ch__4, (ftnlen)13);
01031 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer))
01032 ;
01033 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
01034 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer))
01035 ;
01036 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(
01037 integer));
01038 e_wsfe();
01039 *info = abs(iinfo);
01040 if (iinfo < 0) {
01041 return 0;
01042 } else {
01043 result[ntest] = ulpinv;
01044 goto L100;
01045 }
01046 }
01047
01048
01049
01050 ssgt01_(&ibtype, uplo, &n, &m, &a[a_offset], lda, &b[
01051 b_offset], ldb, &z__[z_offset], ldz, &d__[1], &
01052 work[1], &result[ntest]);
01053
01054 L100:
01055
01056
01057
01058 ++ntest;
01059
01060
01061
01062 if (lsame_(uplo, "U")) {
01063 ij = 1;
01064 i__3 = n;
01065 for (j = 1; j <= i__3; ++j) {
01066 i__4 = j;
01067 for (i__ = 1; i__ <= i__4; ++i__) {
01068 ap[ij] = a[i__ + j * a_dim1];
01069 bp[ij] = b[i__ + j * b_dim1];
01070 ++ij;
01071
01072 }
01073
01074 }
01075 } else {
01076 ij = 1;
01077 i__3 = n;
01078 for (j = 1; j <= i__3; ++j) {
01079 i__4 = n;
01080 for (i__ = j; i__ <= i__4; ++i__) {
01081 ap[ij] = a[i__ + j * a_dim1];
01082 bp[ij] = b[i__ + j * b_dim1];
01083 ++ij;
01084
01085 }
01086
01087 }
01088 }
01089
01090 sspgv_(&ibtype, "V", uplo, &n, &ap[1], &bp[1], &d__[1], &
01091 z__[z_offset], ldz, &work[1], &iinfo);
01092 if (iinfo != 0) {
01093 io___53.ciunit = *nounit;
01094 s_wsfe(&io___53);
01095
01096 i__6[0] = 8, a__1[0] = "SSPGV(V,";
01097 i__6[1] = 1, a__1[1] = uplo;
01098 i__6[2] = 1, a__1[2] = ")";
01099 s_cat(ch__1, a__1, i__6, &c__3, (ftnlen)10);
01100 do_fio(&c__1, ch__1, (ftnlen)10);
01101 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer))
01102 ;
01103 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
01104 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer))
01105 ;
01106 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(
01107 integer));
01108 e_wsfe();
01109 *info = abs(iinfo);
01110 if (iinfo < 0) {
01111 return 0;
01112 } else {
01113 result[ntest] = ulpinv;
01114 goto L310;
01115 }
01116 }
01117
01118
01119
01120 ssgt01_(&ibtype, uplo, &n, &n, &a[a_offset], lda, &b[
01121 b_offset], ldb, &z__[z_offset], ldz, &d__[1], &
01122 work[1], &result[ntest]);
01123
01124
01125
01126 ++ntest;
01127
01128
01129
01130 if (lsame_(uplo, "U")) {
01131 ij = 1;
01132 i__3 = n;
01133 for (j = 1; j <= i__3; ++j) {
01134 i__4 = j;
01135 for (i__ = 1; i__ <= i__4; ++i__) {
01136 ap[ij] = a[i__ + j * a_dim1];
01137 bp[ij] = b[i__ + j * b_dim1];
01138 ++ij;
01139
01140 }
01141
01142 }
01143 } else {
01144 ij = 1;
01145 i__3 = n;
01146 for (j = 1; j <= i__3; ++j) {
01147 i__4 = n;
01148 for (i__ = j; i__ <= i__4; ++i__) {
01149 ap[ij] = a[i__ + j * a_dim1];
01150 bp[ij] = b[i__ + j * b_dim1];
01151 ++ij;
01152
01153 }
01154
01155 }
01156 }
01157
01158 sspgvd_(&ibtype, "V", uplo, &n, &ap[1], &bp[1], &d__[1], &
01159 z__[z_offset], ldz, &work[1], nwork, &iwork[1],
01160 liwork, &iinfo);
01161 if (iinfo != 0) {
01162 io___54.ciunit = *nounit;
01163 s_wsfe(&io___54);
01164
01165 i__6[0] = 9, a__1[0] = "SSPGVD(V,";
01166 i__6[1] = 1, a__1[1] = uplo;
01167 i__6[2] = 1, a__1[2] = ")";
01168 s_cat(ch__2, a__1, i__6, &c__3, (ftnlen)11);
01169 do_fio(&c__1, ch__2, (ftnlen)11);
01170 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer))
01171 ;
01172 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
01173 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer))
01174 ;
01175 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(
01176 integer));
01177 e_wsfe();
01178 *info = abs(iinfo);
01179 if (iinfo < 0) {
01180 return 0;
01181 } else {
01182 result[ntest] = ulpinv;
01183 goto L310;
01184 }
01185 }
01186
01187
01188
01189 ssgt01_(&ibtype, uplo, &n, &n, &a[a_offset], lda, &b[
01190 b_offset], ldb, &z__[z_offset], ldz, &d__[1], &
01191 work[1], &result[ntest]);
01192
01193
01194
01195 ++ntest;
01196
01197
01198
01199 if (lsame_(uplo, "U")) {
01200 ij = 1;
01201 i__3 = n;
01202 for (j = 1; j <= i__3; ++j) {
01203 i__4 = j;
01204 for (i__ = 1; i__ <= i__4; ++i__) {
01205 ap[ij] = a[i__ + j * a_dim1];
01206 bp[ij] = b[i__ + j * b_dim1];
01207 ++ij;
01208
01209 }
01210
01211 }
01212 } else {
01213 ij = 1;
01214 i__3 = n;
01215 for (j = 1; j <= i__3; ++j) {
01216 i__4 = n;
01217 for (i__ = j; i__ <= i__4; ++i__) {
01218 ap[ij] = a[i__ + j * a_dim1];
01219 bp[ij] = b[i__ + j * b_dim1];
01220 ++ij;
01221
01222 }
01223
01224 }
01225 }
01226
01227 sspgvx_(&ibtype, "V", "A", uplo, &n, &ap[1], &bp[1], &vl,
01228 &vu, &il, &iu, &abstol, &m, &d__[1], &z__[
01229 z_offset], ldz, &work[1], &iwork[n + 1], &iwork[1]
01230 , info);
01231 if (iinfo != 0) {
01232 io___55.ciunit = *nounit;
01233 s_wsfe(&io___55);
01234
01235 i__6[0] = 10, a__1[0] = "SSPGVX(V,A";
01236 i__6[1] = 1, a__1[1] = uplo;
01237 i__6[2] = 1, a__1[2] = ")";
01238 s_cat(ch__3, a__1, i__6, &c__3, (ftnlen)12);
01239 do_fio(&c__1, ch__3, (ftnlen)12);
01240 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer))
01241 ;
01242 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
01243 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer))
01244 ;
01245 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(
01246 integer));
01247 e_wsfe();
01248 *info = abs(iinfo);
01249 if (iinfo < 0) {
01250 return 0;
01251 } else {
01252 result[ntest] = ulpinv;
01253 goto L310;
01254 }
01255 }
01256
01257
01258
01259 ssgt01_(&ibtype, uplo, &n, &m, &a[a_offset], lda, &b[
01260 b_offset], ldb, &z__[z_offset], ldz, &d__[1], &
01261 work[1], &result[ntest]);
01262
01263 ++ntest;
01264
01265
01266
01267 if (lsame_(uplo, "U")) {
01268 ij = 1;
01269 i__3 = n;
01270 for (j = 1; j <= i__3; ++j) {
01271 i__4 = j;
01272 for (i__ = 1; i__ <= i__4; ++i__) {
01273 ap[ij] = a[i__ + j * a_dim1];
01274 bp[ij] = b[i__ + j * b_dim1];
01275 ++ij;
01276
01277 }
01278
01279 }
01280 } else {
01281 ij = 1;
01282 i__3 = n;
01283 for (j = 1; j <= i__3; ++j) {
01284 i__4 = n;
01285 for (i__ = j; i__ <= i__4; ++i__) {
01286 ap[ij] = a[i__ + j * a_dim1];
01287 bp[ij] = b[i__ + j * b_dim1];
01288 ++ij;
01289
01290 }
01291
01292 }
01293 }
01294
01295 vl = 0.f;
01296 vu = anorm;
01297 sspgvx_(&ibtype, "V", "V", uplo, &n, &ap[1], &bp[1], &vl,
01298 &vu, &il, &iu, &abstol, &m, &d__[1], &z__[
01299 z_offset], ldz, &work[1], &iwork[n + 1], &iwork[1]
01300 , info);
01301 if (iinfo != 0) {
01302 io___56.ciunit = *nounit;
01303 s_wsfe(&io___56);
01304
01305 i__6[0] = 10, a__1[0] = "SSPGVX(V,V";
01306 i__6[1] = 1, a__1[1] = uplo;
01307 i__6[2] = 1, a__1[2] = ")";
01308 s_cat(ch__3, a__1, i__6, &c__3, (ftnlen)12);
01309 do_fio(&c__1, ch__3, (ftnlen)12);
01310 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer))
01311 ;
01312 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
01313 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer))
01314 ;
01315 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(
01316 integer));
01317 e_wsfe();
01318 *info = abs(iinfo);
01319 if (iinfo < 0) {
01320 return 0;
01321 } else {
01322 result[ntest] = ulpinv;
01323 goto L310;
01324 }
01325 }
01326
01327
01328
01329 ssgt01_(&ibtype, uplo, &n, &m, &a[a_offset], lda, &b[
01330 b_offset], ldb, &z__[z_offset], ldz, &d__[1], &
01331 work[1], &result[ntest]);
01332
01333 ++ntest;
01334
01335
01336
01337 if (lsame_(uplo, "U")) {
01338 ij = 1;
01339 i__3 = n;
01340 for (j = 1; j <= i__3; ++j) {
01341 i__4 = j;
01342 for (i__ = 1; i__ <= i__4; ++i__) {
01343 ap[ij] = a[i__ + j * a_dim1];
01344 bp[ij] = b[i__ + j * b_dim1];
01345 ++ij;
01346
01347 }
01348
01349 }
01350 } else {
01351 ij = 1;
01352 i__3 = n;
01353 for (j = 1; j <= i__3; ++j) {
01354 i__4 = n;
01355 for (i__ = j; i__ <= i__4; ++i__) {
01356 ap[ij] = a[i__ + j * a_dim1];
01357 bp[ij] = b[i__ + j * b_dim1];
01358 ++ij;
01359
01360 }
01361
01362 }
01363 }
01364
01365 sspgvx_(&ibtype, "V", "I", uplo, &n, &ap[1], &bp[1], &vl,
01366 &vu, &il, &iu, &abstol, &m, &d__[1], &z__[
01367 z_offset], ldz, &work[1], &iwork[n + 1], &iwork[1]
01368 , info);
01369 if (iinfo != 0) {
01370 io___57.ciunit = *nounit;
01371 s_wsfe(&io___57);
01372
01373 i__6[0] = 10, a__1[0] = "SSPGVX(V,I";
01374 i__6[1] = 1, a__1[1] = uplo;
01375 i__6[2] = 1, a__1[2] = ")";
01376 s_cat(ch__3, a__1, i__6, &c__3, (ftnlen)12);
01377 do_fio(&c__1, ch__3, (ftnlen)12);
01378 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer))
01379 ;
01380 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
01381 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer))
01382 ;
01383 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(
01384 integer));
01385 e_wsfe();
01386 *info = abs(iinfo);
01387 if (iinfo < 0) {
01388 return 0;
01389 } else {
01390 result[ntest] = ulpinv;
01391 goto L310;
01392 }
01393 }
01394
01395
01396
01397 ssgt01_(&ibtype, uplo, &n, &m, &a[a_offset], lda, &b[
01398 b_offset], ldb, &z__[z_offset], ldz, &d__[1], &
01399 work[1], &result[ntest]);
01400
01401 L310:
01402
01403 if (ibtype == 1) {
01404
01405
01406
01407 ++ntest;
01408
01409
01410
01411 if (lsame_(uplo, "U")) {
01412 i__3 = n;
01413 for (j = 1; j <= i__3; ++j) {
01414
01415 i__4 = 1, i__5 = j - ka;
01416 i__7 = j;
01417 for (i__ = max(i__4,i__5); i__ <= i__7; ++i__)
01418 {
01419 ab[ka + 1 + i__ - j + j * ab_dim1] = a[
01420 i__ + j * a_dim1];
01421
01422 }
01423
01424 i__7 = 1, i__4 = j - kb;
01425 i__5 = j;
01426 for (i__ = max(i__7,i__4); i__ <= i__5; ++i__)
01427 {
01428 bb[kb + 1 + i__ - j + j * bb_dim1] = b[
01429 i__ + j * b_dim1];
01430
01431 }
01432
01433 }
01434 } else {
01435 i__3 = n;
01436 for (j = 1; j <= i__3; ++j) {
01437
01438 i__7 = n, i__4 = j + ka;
01439 i__5 = min(i__7,i__4);
01440 for (i__ = j; i__ <= i__5; ++i__) {
01441 ab[i__ + 1 - j + j * ab_dim1] = a[i__ + j
01442 * a_dim1];
01443
01444 }
01445
01446 i__7 = n, i__4 = j + kb;
01447 i__5 = min(i__7,i__4);
01448 for (i__ = j; i__ <= i__5; ++i__) {
01449 bb[i__ + 1 - j + j * bb_dim1] = b[i__ + j
01450 * b_dim1];
01451
01452 }
01453
01454 }
01455 }
01456
01457 ssbgv_("V", uplo, &n, &ka, &kb, &ab[ab_offset], lda, &
01458 bb[bb_offset], ldb, &d__[1], &z__[z_offset],
01459 ldz, &work[1], &iinfo);
01460 if (iinfo != 0) {
01461 io___58.ciunit = *nounit;
01462 s_wsfe(&io___58);
01463
01464 i__6[0] = 8, a__1[0] = "SSBGV(V,";
01465 i__6[1] = 1, a__1[1] = uplo;
01466 i__6[2] = 1, a__1[2] = ")";
01467 s_cat(ch__1, a__1, i__6, &c__3, (ftnlen)10);
01468 do_fio(&c__1, ch__1, (ftnlen)10);
01469 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(
01470 integer));
01471 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer))
01472 ;
01473 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(
01474 integer));
01475 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(
01476 integer));
01477 e_wsfe();
01478 *info = abs(iinfo);
01479 if (iinfo < 0) {
01480 return 0;
01481 } else {
01482 result[ntest] = ulpinv;
01483 goto L620;
01484 }
01485 }
01486
01487
01488
01489 ssgt01_(&ibtype, uplo, &n, &n, &a[a_offset], lda, &b[
01490 b_offset], ldb, &z__[z_offset], ldz, &d__[1],
01491 &work[1], &result[ntest]);
01492
01493
01494
01495 ++ntest;
01496
01497
01498
01499 if (lsame_(uplo, "U")) {
01500 i__3 = n;
01501 for (j = 1; j <= i__3; ++j) {
01502
01503 i__5 = 1, i__7 = j - ka;
01504 i__4 = j;
01505 for (i__ = max(i__5,i__7); i__ <= i__4; ++i__)
01506 {
01507 ab[ka + 1 + i__ - j + j * ab_dim1] = a[
01508 i__ + j * a_dim1];
01509
01510 }
01511
01512 i__4 = 1, i__5 = j - kb;
01513 i__7 = j;
01514 for (i__ = max(i__4,i__5); i__ <= i__7; ++i__)
01515 {
01516 bb[kb + 1 + i__ - j + j * bb_dim1] = b[
01517 i__ + j * b_dim1];
01518
01519 }
01520
01521 }
01522 } else {
01523 i__3 = n;
01524 for (j = 1; j <= i__3; ++j) {
01525
01526 i__4 = n, i__5 = j + ka;
01527 i__7 = min(i__4,i__5);
01528 for (i__ = j; i__ <= i__7; ++i__) {
01529 ab[i__ + 1 - j + j * ab_dim1] = a[i__ + j
01530 * a_dim1];
01531
01532 }
01533
01534 i__4 = n, i__5 = j + kb;
01535 i__7 = min(i__4,i__5);
01536 for (i__ = j; i__ <= i__7; ++i__) {
01537 bb[i__ + 1 - j + j * bb_dim1] = b[i__ + j
01538 * b_dim1];
01539
01540 }
01541
01542 }
01543 }
01544
01545 ssbgvd_("V", uplo, &n, &ka, &kb, &ab[ab_offset], lda,
01546 &bb[bb_offset], ldb, &d__[1], &z__[z_offset],
01547 ldz, &work[1], nwork, &iwork[1], liwork, &
01548 iinfo);
01549 if (iinfo != 0) {
01550 io___59.ciunit = *nounit;
01551 s_wsfe(&io___59);
01552
01553 i__6[0] = 9, a__1[0] = "SSBGVD(V,";
01554 i__6[1] = 1, a__1[1] = uplo;
01555 i__6[2] = 1, a__1[2] = ")";
01556 s_cat(ch__2, a__1, i__6, &c__3, (ftnlen)11);
01557 do_fio(&c__1, ch__2, (ftnlen)11);
01558 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(
01559 integer));
01560 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer))
01561 ;
01562 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(
01563 integer));
01564 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(
01565 integer));
01566 e_wsfe();
01567 *info = abs(iinfo);
01568 if (iinfo < 0) {
01569 return 0;
01570 } else {
01571 result[ntest] = ulpinv;
01572 goto L620;
01573 }
01574 }
01575
01576
01577
01578 ssgt01_(&ibtype, uplo, &n, &n, &a[a_offset], lda, &b[
01579 b_offset], ldb, &z__[z_offset], ldz, &d__[1],
01580 &work[1], &result[ntest]);
01581
01582
01583
01584 ++ntest;
01585
01586
01587
01588 if (lsame_(uplo, "U")) {
01589 i__3 = n;
01590 for (j = 1; j <= i__3; ++j) {
01591
01592 i__7 = 1, i__4 = j - ka;
01593 i__5 = j;
01594 for (i__ = max(i__7,i__4); i__ <= i__5; ++i__)
01595 {
01596 ab[ka + 1 + i__ - j + j * ab_dim1] = a[
01597 i__ + j * a_dim1];
01598
01599 }
01600
01601 i__5 = 1, i__7 = j - kb;
01602 i__4 = j;
01603 for (i__ = max(i__5,i__7); i__ <= i__4; ++i__)
01604 {
01605 bb[kb + 1 + i__ - j + j * bb_dim1] = b[
01606 i__ + j * b_dim1];
01607
01608 }
01609
01610 }
01611 } else {
01612 i__3 = n;
01613 for (j = 1; j <= i__3; ++j) {
01614
01615 i__5 = n, i__7 = j + ka;
01616 i__4 = min(i__5,i__7);
01617 for (i__ = j; i__ <= i__4; ++i__) {
01618 ab[i__ + 1 - j + j * ab_dim1] = a[i__ + j
01619 * a_dim1];
01620
01621 }
01622
01623 i__5 = n, i__7 = j + kb;
01624 i__4 = min(i__5,i__7);
01625 for (i__ = j; i__ <= i__4; ++i__) {
01626 bb[i__ + 1 - j + j * bb_dim1] = b[i__ + j
01627 * b_dim1];
01628
01629 }
01630
01631 }
01632 }
01633
01634 i__3 = max(1,n);
01635 ssbgvx_("V", "A", uplo, &n, &ka, &kb, &ab[ab_offset],
01636 lda, &bb[bb_offset], ldb, &bp[1], &i__3, &vl,
01637 &vu, &il, &iu, &abstol, &m, &d__[1], &z__[
01638 z_offset], ldz, &work[1], &iwork[n + 1], &
01639 iwork[1], &iinfo);
01640 if (iinfo != 0) {
01641 io___60.ciunit = *nounit;
01642 s_wsfe(&io___60);
01643
01644 i__6[0] = 10, a__1[0] = "SSBGVX(V,A";
01645 i__6[1] = 1, a__1[1] = uplo;
01646 i__6[2] = 1, a__1[2] = ")";
01647 s_cat(ch__3, a__1, i__6, &c__3, (ftnlen)12);
01648 do_fio(&c__1, ch__3, (ftnlen)12);
01649 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(
01650 integer));
01651 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer))
01652 ;
01653 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(
01654 integer));
01655 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(
01656 integer));
01657 e_wsfe();
01658 *info = abs(iinfo);
01659 if (iinfo < 0) {
01660 return 0;
01661 } else {
01662 result[ntest] = ulpinv;
01663 goto L620;
01664 }
01665 }
01666
01667
01668
01669 ssgt01_(&ibtype, uplo, &n, &m, &a[a_offset], lda, &b[
01670 b_offset], ldb, &z__[z_offset], ldz, &d__[1],
01671 &work[1], &result[ntest]);
01672
01673
01674 ++ntest;
01675
01676
01677
01678 if (lsame_(uplo, "U")) {
01679 i__3 = n;
01680 for (j = 1; j <= i__3; ++j) {
01681
01682 i__4 = 1, i__5 = j - ka;
01683 i__7 = j;
01684 for (i__ = max(i__4,i__5); i__ <= i__7; ++i__)
01685 {
01686 ab[ka + 1 + i__ - j + j * ab_dim1] = a[
01687 i__ + j * a_dim1];
01688
01689 }
01690
01691 i__7 = 1, i__4 = j - kb;
01692 i__5 = j;
01693 for (i__ = max(i__7,i__4); i__ <= i__5; ++i__)
01694 {
01695 bb[kb + 1 + i__ - j + j * bb_dim1] = b[
01696 i__ + j * b_dim1];
01697
01698 }
01699
01700 }
01701 } else {
01702 i__3 = n;
01703 for (j = 1; j <= i__3; ++j) {
01704
01705 i__7 = n, i__4 = j + ka;
01706 i__5 = min(i__7,i__4);
01707 for (i__ = j; i__ <= i__5; ++i__) {
01708 ab[i__ + 1 - j + j * ab_dim1] = a[i__ + j
01709 * a_dim1];
01710
01711 }
01712
01713 i__7 = n, i__4 = j + kb;
01714 i__5 = min(i__7,i__4);
01715 for (i__ = j; i__ <= i__5; ++i__) {
01716 bb[i__ + 1 - j + j * bb_dim1] = b[i__ + j
01717 * b_dim1];
01718
01719 }
01720
01721 }
01722 }
01723
01724 vl = 0.f;
01725 vu = anorm;
01726 i__3 = max(1,n);
01727 ssbgvx_("V", "V", uplo, &n, &ka, &kb, &ab[ab_offset],
01728 lda, &bb[bb_offset], ldb, &bp[1], &i__3, &vl,
01729 &vu, &il, &iu, &abstol, &m, &d__[1], &z__[
01730 z_offset], ldz, &work[1], &iwork[n + 1], &
01731 iwork[1], &iinfo);
01732 if (iinfo != 0) {
01733 io___61.ciunit = *nounit;
01734 s_wsfe(&io___61);
01735
01736 i__6[0] = 10, a__1[0] = "SSBGVX(V,V";
01737 i__6[1] = 1, a__1[1] = uplo;
01738 i__6[2] = 1, a__1[2] = ")";
01739 s_cat(ch__3, a__1, i__6, &c__3, (ftnlen)12);
01740 do_fio(&c__1, ch__3, (ftnlen)12);
01741 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(
01742 integer));
01743 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer))
01744 ;
01745 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(
01746 integer));
01747 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(
01748 integer));
01749 e_wsfe();
01750 *info = abs(iinfo);
01751 if (iinfo < 0) {
01752 return 0;
01753 } else {
01754 result[ntest] = ulpinv;
01755 goto L620;
01756 }
01757 }
01758
01759
01760
01761 ssgt01_(&ibtype, uplo, &n, &m, &a[a_offset], lda, &b[
01762 b_offset], ldb, &z__[z_offset], ldz, &d__[1],
01763 &work[1], &result[ntest]);
01764
01765 ++ntest;
01766
01767
01768
01769 if (lsame_(uplo, "U")) {
01770 i__3 = n;
01771 for (j = 1; j <= i__3; ++j) {
01772
01773 i__5 = 1, i__7 = j - ka;
01774 i__4 = j;
01775 for (i__ = max(i__5,i__7); i__ <= i__4; ++i__)
01776 {
01777 ab[ka + 1 + i__ - j + j * ab_dim1] = a[
01778 i__ + j * a_dim1];
01779
01780 }
01781
01782 i__4 = 1, i__5 = j - kb;
01783 i__7 = j;
01784 for (i__ = max(i__4,i__5); i__ <= i__7; ++i__)
01785 {
01786 bb[kb + 1 + i__ - j + j * bb_dim1] = b[
01787 i__ + j * b_dim1];
01788
01789 }
01790
01791 }
01792 } else {
01793 i__3 = n;
01794 for (j = 1; j <= i__3; ++j) {
01795
01796 i__4 = n, i__5 = j + ka;
01797 i__7 = min(i__4,i__5);
01798 for (i__ = j; i__ <= i__7; ++i__) {
01799 ab[i__ + 1 - j + j * ab_dim1] = a[i__ + j
01800 * a_dim1];
01801
01802 }
01803
01804 i__4 = n, i__5 = j + kb;
01805 i__7 = min(i__4,i__5);
01806 for (i__ = j; i__ <= i__7; ++i__) {
01807 bb[i__ + 1 - j + j * bb_dim1] = b[i__ + j
01808 * b_dim1];
01809
01810 }
01811
01812 }
01813 }
01814
01815 i__3 = max(1,n);
01816 ssbgvx_("V", "I", uplo, &n, &ka, &kb, &ab[ab_offset],
01817 lda, &bb[bb_offset], ldb, &bp[1], &i__3, &vl,
01818 &vu, &il, &iu, &abstol, &m, &d__[1], &z__[
01819 z_offset], ldz, &work[1], &iwork[n + 1], &
01820 iwork[1], &iinfo);
01821 if (iinfo != 0) {
01822 io___62.ciunit = *nounit;
01823 s_wsfe(&io___62);
01824
01825 i__6[0] = 10, a__1[0] = "SSBGVX(V,I";
01826 i__6[1] = 1, a__1[1] = uplo;
01827 i__6[2] = 1, a__1[2] = ")";
01828 s_cat(ch__3, a__1, i__6, &c__3, (ftnlen)12);
01829 do_fio(&c__1, ch__3, (ftnlen)12);
01830 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(
01831 integer));
01832 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer))
01833 ;
01834 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(
01835 integer));
01836 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(
01837 integer));
01838 e_wsfe();
01839 *info = abs(iinfo);
01840 if (iinfo < 0) {
01841 return 0;
01842 } else {
01843 result[ntest] = ulpinv;
01844 goto L620;
01845 }
01846 }
01847
01848
01849
01850 ssgt01_(&ibtype, uplo, &n, &m, &a[a_offset], lda, &b[
01851 b_offset], ldb, &z__[z_offset], ldz, &d__[1],
01852 &work[1], &result[ntest]);
01853
01854 }
01855
01856 L620:
01857 ;
01858 }
01859
01860 }
01861
01862
01863
01864 ntestt += ntest;
01865 slafts_("SSG", &n, &n, &jtype, &ntest, &result[1], ioldsd, thresh,
01866 nounit, &nerrs);
01867 L640:
01868 ;
01869 }
01870
01871 }
01872
01873
01874
01875 slasum_("SSG", nounit, &nerrs, &ntestt);
01876
01877 return 0;
01878
01879
01880
01881 }