37 #ifndef TEMPLATE_LAPACK_LARRV_HEADER 38 #define TEMPLATE_LAPACK_LARRV_HEADER 46 Treal *d__, Treal *l, Treal *pivmin,
integer *isplit,
48 Treal *rtol1, Treal *rtol2, Treal *w, Treal *werr,
54 integer z_dim1, z_offset, i__1, i__2, i__3, i__4, i__5;
60 integer minwsize, i__, j, k, p, q, miniwsize, ii;
63 Treal
gu, gap, eps, tau, tol, tmp;
100 integer newcls, oldfst, indwrk, windex, oldlst;
102 integer newfst, newftt, parity, windmn, windpl, isupmn, newlst, zusedl;
104 integer newsiz, zusedu, zusedw;
105 Treal nrminv, rqcorr;
300 z_offset = 1 + z_dim1;
308 indlld = (*n << 1) + 1;
312 for (i__ = 1; i__ <= i__1; ++i__) {
326 for (i__ = 1; i__ <= i__1; ++i__) {
341 zusedw = zusedu - zusedl + 1;
348 if (*dol == 1 && *dou == *m) {
366 for (jblk = 1; jblk <= i__1; ++jblk) {
374 if (iblock[wend + 1] == jblk) {
382 }
else if (wend < *dol || wbegin > *dou) {
388 gl = gers[(ibegin << 1) - 1];
389 gu = gers[ibegin * 2];
391 for (i__ = ibegin + 1; i__ <= i__2; ++i__) {
393 d__1 = gers[(i__ << 1) - 1];
396 d__1 = gers[i__ * 2];
404 in = iend - ibegin + 1;
406 im = wend - wbegin + 1;
408 if (ibegin == iend) {
410 z__[ibegin + wbegin * z_dim1] = 1.;
411 isuppz[(wbegin << 1) - 1] = ibegin;
412 isuppz[wbegin * 2] = ibegin;
414 work[wbegin] = w[wbegin];
429 for (i__ = 1; i__ <= i__2; ++i__) {
430 w[wbegin + i__ - 1] += sigma;
440 iwork[iindc1 + 1] = 1;
441 iwork[iindc1 + 2] = im;
471 for (i__ = 1; i__ <= i__2; ++i__) {
472 j = oldcls + (i__ << 1);
476 oldfst = iwork[j - 1];
483 if (*dol == 1 && *dou == *m) {
486 j = wbegin + oldfst - 1;
488 if (wbegin + oldfst - 1 < *dol) {
491 }
else if (wbegin + oldfst - 1 > *dou) {
495 j = wbegin + oldfst - 1;
503 sigma = z__[iend + (j + 1) * z_dim1];
510 for (j = ibegin; j <= i__3; ++j) {
512 work[indld - 1 + j] = tmp;
513 work[indlld - 1 + j] = tmp * l[j];
519 p = indexw[wbegin - 1 + oldfst];
520 q = indexw[wbegin - 1 + oldlst];
524 offset = indexw[wbegin] - 1;
528 &q, rtol1, rtol2, &offset, &work[wbegin], &wgap[
529 wbegin], &werr[wbegin], &work[indwrk], &iwork[
530 iindwk], pivmin, &spdiam, &in, &iinfo);
544 d__1 = wgap[wbegin + oldfst - 2], d__2 = w[wbegin +
545 oldfst - 1] - werr[wbegin + oldfst - 1] - w[
546 wbegin + oldfst - 2] - werr[wbegin + oldfst -
548 wgap[wbegin + oldfst - 2] =
maxMACRO(d__1,d__2);
550 if (wbegin + oldlst - 1 < wend) {
552 d__1 = wgap[wbegin + oldlst - 1], d__2 = w[wbegin +
553 oldlst] - werr[wbegin + oldlst] - w[wbegin +
554 oldlst - 1] - werr[wbegin + oldlst - 1];
555 wgap[wbegin + oldlst - 1] =
maxMACRO(d__1,d__2);
560 for (j = oldfst; j <= i__3; ++j) {
561 w[wbegin + j - 1] = work[wbegin + j - 1] + sigma;
568 for (j = oldfst; j <= i__3; ++j) {
573 }
else if (wgap[wbegin + j - 1] >= *minrgp * (d__1 = work[
584 newsiz = newlst - newfst + 1;
587 if (*dol == 1 && *dou == *m) {
590 newftt = wbegin + newfst - 1;
592 if (wbegin + newfst - 1 < *dol) {
595 }
else if (wbegin + newfst - 1 > *dou) {
599 newftt = wbegin + newfst - 1;
619 d__1 = 0., d__2 = w[wbegin] - werr[wbegin] - *vl;
622 lgap = wgap[wbegin + newfst - 2];
624 rgap = wgap[wbegin + newlst - 1];
631 for (k = 1; k <= 2; ++k) {
633 p = indexw[wbegin - 1 + newfst];
635 p = indexw[wbegin - 1 + newlst];
637 offset = indexw[wbegin] - 1;
639 - 1], &p, &p, &rqtol, &rqtol, &offset, &
640 work[wbegin], &wgap[wbegin], &werr[wbegin]
641 , &work[indwrk], &iwork[iindwk], pivmin, &
642 spdiam, &in, &iinfo);
646 if (wbegin + newlst - 1 < *dol || wbegin + newfst - 1
655 idone = idone + newlst - newfst + 1;
664 ibegin - 1], &newfst, &newlst, &work[wbegin],
665 &wgap[wbegin], &werr[wbegin], &spdiam, &lgap,
666 &rgap, pivmin, &tau, &z__[ibegin + newftt *
667 z_dim1], &z__[ibegin + (newftt + 1) * z_dim1],
668 &work[indwrk], &iinfo);
672 ssigma = sigma + tau;
673 z__[iend + (newftt + 1) * z_dim1] = ssigma;
677 for (k = newfst; k <= i__4; ++k) {
678 fudge = eps * 3. * (d__1 = work[wbegin + k -
680 work[wbegin + k - 1] -= tau;
681 fudge += eps * 4. * (d__1 = work[wbegin + k -
684 werr[wbegin + k - 1] += fudge;
695 k = newcls + (nclus << 1);
696 iwork[k - 1] = newfst;
711 windex = wbegin + k - 1;
718 lambda = work[windex];
721 if (windex < *dol || windex > *dou) {
727 left = work[windex] - werr[windex];
728 right = work[windex] + werr[windex];
729 indeig = indexw[windex];
762 if (k == 1 || k == im) {
777 savgap = wgap[windex];
794 itmp1 = iwork[iindr + windex];
795 offset = indexw[wbegin] - 1;
798 - 1], &indeig, &indeig, &c_b5, &d__1, &
799 offset, &work[wbegin], &wgap[wbegin], &
800 werr[wbegin], &work[indwrk], &iwork[
801 iindwk], pivmin, &spdiam, &itmp1, &iinfo);
806 lambda = work[windex];
809 iwork[iindr + windex] = 0;
814 ibegin], &work[indld + ibegin - 1], &work[
815 indlld + ibegin - 1], pivmin, &gaptol, &z__[
816 ibegin + windex * z_dim1], &L__1, &negcnt, &
817 ztz, &mingma, &iwork[iindr + windex], &isuppz[
818 (windex << 1) - 1], &nrminv, &resid, &rqcorr,
823 }
else if (resid < bstres) {
828 i__4 = isupmn, i__5 = isuppz[(windex << 1) - 1];
831 i__4 = isupmx, i__5 = isuppz[windex * 2];
843 lambda) && ! usedbs) {
847 if (indeig <= negcnt) {
856 if (rqcorr * sgndef >= 0. && lambda + rqcorr <=
892 }
else if (iter < 10) {
894 }
else if (iter == 10) {
903 if (usedrq && usedbs && bstres <= resid) {
911 , &l[ibegin], &work[indld + ibegin -
912 1], &work[indlld + ibegin - 1],
913 pivmin, &gaptol, &z__[ibegin + windex
914 * z_dim1], &L__1, &negcnt, &ztz, &
915 mingma, &iwork[iindr + windex], &
916 isuppz[(windex << 1) - 1], &nrminv, &
917 resid, &rqcorr, &work[indwrk]);
919 work[windex] = lambda;
924 isuppz[(windex << 1) - 1] += oldien;
925 isuppz[windex * 2] += oldien;
926 zfrom = isuppz[(windex << 1) - 1];
927 zto = isuppz[windex * 2];
931 if (isupmn < zfrom) {
933 for (ii = isupmn; ii <= i__4; ++ii) {
934 z__[ii + windex * z_dim1] = 0.;
940 for (ii = zto + 1; ii <= i__4; ++ii) {
941 z__[ii + windex * z_dim1] = 0.;
945 i__4 = zto - zfrom + 1;
950 w[windex] = lambda + sigma;
960 d__1 = wgap[windmn], d__2 = w[windex] - werr[
961 windex] - w[windmn] - werr[windmn];
966 d__1 = savgap, d__2 = w[windpl] - werr[windpl]
967 - w[windex] - werr[windex];
static const real gu
Definition: fun-pz81.c:68
int template_blas_scal(const integer *n, const Treal *da, Treal *dx, const integer *incx)
Definition: template_blas_scal.h:43
#define absMACRO(x)
Definition: template_blas_common.h:47
int template_lapack_larrb(integer *n, Treal *d__, Treal *lld, integer *ifirst, integer *ilast, Treal *rtol1, Treal *rtol2, integer *offset, Treal *w, Treal *wgap, Treal *werr, Treal *work, integer *iwork, Treal *pivmin, Treal *spdiam, integer *twist, integer *info)
Definition: template_lapack_larrb.h:45
int template_lapack_larrf(integer *n, Treal *d__, Treal *l, Treal *ld, integer *clstrt, integer *clend, Treal *w, Treal *wgap, Treal *werr, Treal *spdiam, Treal *clgapl, Treal *clgapr, Treal *pivmin, Treal *sigma, Treal *dplus, Treal *lplus, Treal *work, integer *info)
Definition: template_lapack_larrf.h:42
int template_lapack_laset(const char *uplo, const integer *m, const integer *n, const Treal *alpha, const Treal *beta, Treal *a, const integer *lda)
Definition: template_lapack_laset.h:42
int integer
Definition: template_blas_common.h:40
#define maxMACRO(a, b)
Definition: template_blas_common.h:45
#define minMACRO(a, b)
Definition: template_blas_common.h:46
int template_lapack_larrv(const integer *n, Treal *vl, Treal *vu, Treal *d__, Treal *l, Treal *pivmin, integer *isplit, integer *m, integer *dol, integer *dou, Treal *minrgp, Treal *rtol1, Treal *rtol2, Treal *w, Treal *werr, Treal *wgap, integer *iblock, integer *indexw, Treal *gers, Treal *z__, const integer *ldz, integer *isuppz, Treal *work, integer *iwork, integer *info)
Definition: template_lapack_larrv.h:45
Treal template_blas_log(Treal x)
int template_lapack_lar1v(integer *n, integer *b1, integer *bn, Treal *lambda, Treal *d__, Treal *l, Treal *ld, Treal *lld, Treal *pivmin, Treal *gaptol, Treal *z__, logical *wantnc, integer *negcnt, Treal *ztz, Treal *mingma, integer *r__, integer *isuppz, Treal *nrminv, Treal *resid, Treal *rqcorr, Treal *work)
Definition: template_lapack_lar1v.h:41
Treal template_lapack_lamch(const char *cmach, Treal dummyReal)
Definition: template_lapack_lamch.h:202
bool logical
Definition: template_blas_common.h:41
#define TRUE_
Definition: template_lapack_common.h:42
int template_blas_copy(const integer *n, const Treal *dx, const integer *incx, Treal *dy, const integer *incy)
Definition: template_blas_copy.h:42
#define FALSE_
Definition: template_lapack_common.h:43