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