35 #ifndef TEMPLATE_LAPACK_LARRV_HEADER
36 #define TEMPLATE_LAPACK_LARRV_HEADER
40 Treal *d__, Treal *l, Treal *pivmin,
integer *isplit,
42 Treal *rtol1, Treal *rtol2, Treal *w, Treal *werr,
48 integer z_dim1, z_offset, i__1, i__2, i__3, i__4, i__5;
54 integer minwsize, i__, j, k, p, q, miniwsize, ii;
57 Treal
gu, gap, eps, tau, tol, tmp;
94 integer newcls, oldfst, indwrk, windex, oldlst;
96 integer newfst, newftt, parity, windmn, windpl, isupmn, newlst, zusedl;
294 z_offset = 1 + z_dim1;
302 indlld = (*n << 1) + 1;
306 for (i__ = 1; i__ <= i__1; ++i__) {
320 for (i__ = 1; i__ <= i__1; ++i__) {
335 zusedw = zusedu - zusedl + 1;
342 if (*dol == 1 && *dou == *m) {
360 for (jblk = 1; jblk <= i__1; ++jblk) {
368 if (iblock[wend + 1] == jblk) {
376 }
else if (wend < *dol || wbegin > *dou) {
382 gl = gers[(ibegin << 1) - 1];
383 gu = gers[ibegin * 2];
385 for (i__ = ibegin + 1; i__ <= i__2; ++i__) {
387 d__1 = gers[(i__ << 1) - 1];
390 d__1 = gers[i__ * 2];
398 in = iend - ibegin + 1;
400 im = wend - wbegin + 1;
402 if (ibegin == iend) {
404 z__[ibegin + wbegin * z_dim1] = 1.;
405 isuppz[(wbegin << 1) - 1] = ibegin;
406 isuppz[wbegin * 2] = ibegin;
408 work[wbegin] = w[wbegin];
423 for (i__ = 1; i__ <= i__2; ++i__) {
424 w[wbegin + i__ - 1] += sigma;
434 iwork[iindc1 + 1] = 1;
435 iwork[iindc1 + 2] = im;
465 for (i__ = 1; i__ <= i__2; ++i__) {
466 j = oldcls + (i__ << 1);
470 oldfst = iwork[j - 1];
477 if (*dol == 1 && *dou == *m) {
480 j = wbegin + oldfst - 1;
482 if (wbegin + oldfst - 1 < *dol) {
485 }
else if (wbegin + oldfst - 1 > *dou) {
489 j = wbegin + oldfst - 1;
497 sigma = z__[iend + (j + 1) * z_dim1];
504 for (j = ibegin; j <= i__3; ++j) {
506 work[indld - 1 + j] = tmp;
507 work[indlld - 1 + j] = tmp * l[j];
513 p = indexw[wbegin - 1 + oldfst];
514 q = indexw[wbegin - 1 + oldlst];
518 offset = indexw[wbegin] - 1;
522 &q, rtol1, rtol2, &offset, &work[wbegin], &wgap[
523 wbegin], &werr[wbegin], &work[indwrk], &iwork[
524 iindwk], pivmin, &spdiam, &in, &iinfo);
538 d__1 = wgap[wbegin + oldfst - 2], d__2 = w[wbegin +
539 oldfst - 1] - werr[wbegin + oldfst - 1] - w[
540 wbegin + oldfst - 2] - werr[wbegin + oldfst -
542 wgap[wbegin + oldfst - 2] =
maxMACRO(d__1,d__2);
544 if (wbegin + oldlst - 1 < wend) {
546 d__1 = wgap[wbegin + oldlst - 1], d__2 = w[wbegin +
547 oldlst] - werr[wbegin + oldlst] - w[wbegin +
548 oldlst - 1] - werr[wbegin + oldlst - 1];
549 wgap[wbegin + oldlst - 1] =
maxMACRO(d__1,d__2);
554 for (j = oldfst; j <= i__3; ++j) {
555 w[wbegin + j - 1] = work[wbegin + j - 1] + sigma;
562 for (j = oldfst; j <= i__3; ++j) {
567 }
else if (wgap[wbegin + j - 1] >= *minrgp * (d__1 = work[
578 newsiz = newlst - newfst + 1;
581 if (*dol == 1 && *dou == *m) {
584 newftt = wbegin + newfst - 1;
586 if (wbegin + newfst - 1 < *dol) {
589 }
else if (wbegin + newfst - 1 > *dou) {
593 newftt = wbegin + newfst - 1;
613 d__1 = 0., d__2 = w[wbegin] - werr[wbegin] - *vl;
616 lgap = wgap[wbegin + newfst - 2];
618 rgap = wgap[wbegin + newlst - 1];
625 for (k = 1; k <= 2; ++k) {
627 p = indexw[wbegin - 1 + newfst];
629 p = indexw[wbegin - 1 + newlst];
631 offset = indexw[wbegin] - 1;
633 - 1], &p, &p, &rqtol, &rqtol, &offset, &
634 work[wbegin], &wgap[wbegin], &werr[wbegin]
635 , &work[indwrk], &iwork[iindwk], pivmin, &
636 spdiam, &in, &iinfo);
640 if (wbegin + newlst - 1 < *dol || wbegin + newfst - 1
649 idone = idone + newlst - newfst + 1;
658 ibegin - 1], &newfst, &newlst, &work[wbegin],
659 &wgap[wbegin], &werr[wbegin], &spdiam, &lgap,
660 &rgap, pivmin, &tau, &z__[ibegin + newftt *
661 z_dim1], &z__[ibegin + (newftt + 1) * z_dim1],
662 &work[indwrk], &iinfo);
666 ssigma = sigma + tau;
667 z__[iend + (newftt + 1) * z_dim1] = ssigma;
671 for (k = newfst; k <= i__4; ++k) {
672 fudge = eps * 3. * (d__1 = work[wbegin + k -
674 work[wbegin + k - 1] -= tau;
675 fudge += eps * 4. * (d__1 = work[wbegin + k -
678 werr[wbegin + k - 1] += fudge;
689 k = newcls + (nclus << 1);
690 iwork[k - 1] = newfst;
705 windex = wbegin + k - 1;
712 lambda = work[windex];
715 if (windex < *dol || windex > *dou) {
721 left = work[windex] - werr[windex];
722 right = work[windex] + werr[windex];
723 indeig = indexw[windex];
756 if (k == 1 || k == im) {
771 savgap = wgap[windex];
788 itmp1 = iwork[iindr + windex];
789 offset = indexw[wbegin] - 1;
792 - 1], &indeig, &indeig, &c_b5, &d__1, &
793 offset, &work[wbegin], &wgap[wbegin], &
794 werr[wbegin], &work[indwrk], &iwork[
795 iindwk], pivmin, &spdiam, &itmp1, &iinfo);
800 lambda = work[windex];
803 iwork[iindr + windex] = 0;
808 ibegin], &work[indld + ibegin - 1], &work[
809 indlld + ibegin - 1], pivmin, &gaptol, &z__[
810 ibegin + windex * z_dim1], &L__1, &negcnt, &
811 ztz, &mingma, &iwork[iindr + windex], &isuppz[
812 (windex << 1) - 1], &nrminv, &resid, &rqcorr,
817 }
else if (resid < bstres) {
822 i__4 = isupmn, i__5 = isuppz[(windex << 1) - 1];
825 i__4 = isupmx, i__5 = isuppz[windex * 2];
837 lambda) && ! usedbs) {
841 if (indeig <= negcnt) {
850 if (rqcorr * sgndef >= 0. && lambda + rqcorr <=
851 right && lambda + rqcorr >= left) {
872 work[windex] = (right +
left) * .5;
877 werr[windex] = (right -
left) * .5;
881 if (right - left < rqtol *
absMACRO(lambda)) {
886 }
else if (iter < 10) {
888 }
else if (iter == 10) {
897 if (usedrq && usedbs && bstres <= resid) {
905 , &l[ibegin], &work[indld + ibegin -
906 1], &work[indlld + ibegin - 1],
907 pivmin, &gaptol, &z__[ibegin + windex
908 * z_dim1], &L__1, &negcnt, &ztz, &
909 mingma, &iwork[iindr + windex], &
910 isuppz[(windex << 1) - 1], &nrminv, &
911 resid, &rqcorr, &work[indwrk]);
913 work[windex] = lambda;
918 isuppz[(windex << 1) - 1] += oldien;
919 isuppz[windex * 2] += oldien;
920 zfrom = isuppz[(windex << 1) - 1];
921 zto = isuppz[windex * 2];
925 if (isupmn < zfrom) {
927 for (ii = isupmn; ii <= i__4; ++ii) {
928 z__[ii + windex * z_dim1] = 0.;
934 for (ii = zto + 1; ii <= i__4; ++ii) {
935 z__[ii + windex * z_dim1] = 0.;
939 i__4 = zto - zfrom + 1;
944 w[windex] = lambda + sigma;
954 d__1 = wgap[windmn], d__2 = w[windex] - werr[
955 windex] - w[windmn] - werr[windmn];
960 d__1 = savgap, d__2 = w[windpl] - werr[windpl]
961 - w[windex] - werr[windex];