37 #ifndef TEMPLATE_LAPACK_LARRE_HEADER 38 #define TEMPLATE_LAPACK_LARRE_HEADER 48 *e, Treal *e2, Treal *rtol1, Treal *rtol2, Treal *
51 Treal *gers, Treal *pivmin, Treal *work,
integer *
56 Treal d__1, d__2, d__3;
67 Treal eps, tau, tmp, rtl;
89 Treal isrght, bsrtol, dpivot;
318 if (irange == 1 || ( irange == 3 && d__[1] > *vl && d__[1] <= *vu ) ||
319 ( irange == 2 && *il == 1 && *iu == 1 ) ) {
344 for (i__ = 1; i__ <= i__1; ++i__) {
347 eabs = (d__1 = e[i__],
absMACRO(d__1));
352 gers[(i__ << 1) - 1] = d__[i__] - tmp1;
354 d__1 = gl, d__2 = gers[(i__ << 1) - 1];
356 gers[i__ * 2] = d__[i__] + tmp1;
358 d__1 =
gu, d__2 = gers[i__ * 2];
367 d__1 = 1., d__2 = d__3 * d__3;
368 *pivmin = safmin *
maxMACRO(d__1,d__2);
380 usedqd = irange == 1 && ! forceb;
381 if (irange == 1 && ! forceb) {
392 template_lapack_larrd(range,
"B", n, vl, vu, il, iu, &gers[1], &bsrtol, &d__[1], &e[
393 1], &e2[1], pivmin, nsplit, &isplit[1], &mm, &w[1], &werr[1],
394 vl, vu, &iblock[1], &indexw[1], &work[1], &iwork[1], &iinfo);
401 for (i__ = mm + 1; i__ <= i__1; ++i__) {
414 for (jblk = 1; jblk <= i__1; ++jblk) {
416 in = iend - ibegin + 1;
419 if (irange == 1 || ( irange == 3 && d__[ibegin] > *vl && d__[ibegin]
420 <= *vu ) || ( irange == 2 && iblock[wbegin] == jblk ) ) {
446 for (i__ = ibegin; i__ <= i__2; ++i__) {
448 d__1 = gers[(i__ << 1) - 1];
451 d__1 = gers[i__ * 2];
456 if (! (irange == 1 && ! forceb)) {
460 for (i__ = wbegin; i__ <= i__2; ++i__) {
461 if (iblock[i__] == jblk) {
477 usedqd = (Treal) mb > in * .5 && ! forceb;
478 wend = wbegin + mb - 1;
484 for (i__ = wbegin; i__ <= i__2; ++i__) {
486 d__1 = 0., d__2 = w[i__ + 1] - werr[i__ + 1] - (w[i__] +
492 d__1 = 0., d__2 = *vu - sigma - (w[wend] + werr[wend]);
495 indl = indexw[wbegin];
499 if ( ( irange == 1 && ! forceb ) || usedqd) {
503 rtl, &tmp, &tmp1, &iinfo);
509 d__2 = gl, d__3 = tmp - tmp1 - eps * 100. * (d__1 = tmp - tmp1,
513 rtl, &tmp, &tmp1, &iinfo);
519 d__2 =
gu, d__3 = tmp + tmp1 + eps * 100. * (d__1 = tmp + tmp1,
523 spdiam = isrght - isleft;
528 d__2 = gl, d__3 = w[wbegin] - werr[wbegin] - eps * 100. * (d__1 =
529 w[wbegin] - werr[wbegin],
absMACRO(d__1));
532 d__2 =
gu, d__3 = w[wend] + werr[wend] + eps * 100. * (d__1 = w[
533 wend] + werr[wend],
absMACRO(d__1));
544 if (irange == 1 && ! forceb) {
552 wend = wbegin + mb - 1;
554 s1 = isleft + spdiam * .25;
555 s2 = isrght - spdiam * .25;
561 s1 = isleft + spdiam * .25;
562 s2 = isrght - spdiam * .25;
565 s1 =
maxMACRO(isleft,*vl) + tmp * .25;
566 s2 =
minMACRO(isrght,*vu) - tmp * .25;
572 cnt, &cnt1, &cnt2, &iinfo);
577 }
else if (cnt1 - indl >= indu - cnt2) {
578 if (irange == 1 && ! forceb) {
591 if (irange == 1 && ! forceb) {
612 tau = spdiam * eps * *n + *pivmin * 2.;
615 clwdth = w[wend] + werr[wend] - w[wbegin] - werr[wbegin];
616 avgap = (d__1 = clwdth / (Treal) (wend - wbegin),
absMACRO(
623 d__1 = tau, d__2 = werr[wbegin];
627 d__1 = wgap[wend - 1];
630 d__1 = tau, d__2 = werr[wend];
638 for (idum = 1; idum <= 6; ++idum) {
642 dpivot = d__[ibegin] - sigma;
647 for (i__ = 1; i__ <= i__2; ++i__) {
648 work[(in << 1) + i__] = 1. / work[i__];
649 tmp = e[j] * work[(in << 1) + i__];
650 work[in + i__] = tmp;
651 dpivot = d__[j + 1] - sigma - tmp * e[j];
652 work[i__ + 1] = dpivot;
654 d__1 = dmax__, d__2 =
absMACRO(dpivot);
660 if (dmax__ > spdiam * 64.) {
665 if (usedqd && ! norep) {
669 for (i__ = 1; i__ <= i__2; ++i__) {
670 tmp = sgndef * work[i__];
684 sigma = gl - spdiam * 2. * eps * *n - *pivmin * 4.;
686 sigma =
gu + spdiam * 2. * eps * *n + *pivmin * 4.;
689 sigma -= sgndef * tau;
717 for (i__ = 1; i__ <= 4; ++i__) {
721 i__2 = (in << 1) - 1;
724 for (i__ = 1; i__ <= i__2; ++i__) {
725 d__[ibegin + i__ - 1] *= eps * 8. * work[i__] + 1.;
726 e[ibegin + i__ - 1] *= eps * 8. * work[in + i__] + 1.;
729 d__[iend] *= eps * 4. * work[in] + 1.;
745 for (j = wbegin; j <= i__2; ++j) {
747 werr[j] += (d__1 = w[j],
absMACRO(d__1)) * eps;
753 for (i__ = ibegin; i__ <= i__2; ++i__) {
756 work[i__] = d__[i__] * (d__1 * d__1);
762 rtol2, &i__2, &w[wbegin], &wgap[wbegin], &werr[wbegin], &
763 work[(*n << 1) + 1], &iwork[1], pivmin, &spdiam, &in, &
772 d__1 = 0., d__2 = *vu - sigma - (w[wend] + werr[wend]);
775 for (i__ = indl; i__ <= i__2; ++i__) {
796 for (i__ = 1; i__ <= i__2; ++i__) {
797 work[(i__ << 1) - 1] = (d__1 = d__[j],
absMACRO(d__1));
798 work[i__ * 2] = e[j] * e[j] * work[(i__ << 1) - 1];
802 work[(in << 1) - 1] = (d__1 = d__[iend],
absMACRO(d__1));
814 for (i__ = 1; i__ <= i__2; ++i__) {
815 if (work[i__] < 0.) {
824 for (i__ = indl; i__ <= i__2; ++i__) {
826 w[*m] = work[in - i__ + 1];
833 for (i__ = indl; i__ <= i__2; ++i__) {
842 for (i__ = *m - mb + 1; i__ <= i__2; ++i__) {
844 werr[i__] = rtol * (d__1 = w[i__],
absMACRO(d__1));
848 for (i__ = *m - mb + 1; i__ <= i__2; ++i__) {
851 d__1 = 0., d__2 = w[i__ + 1] - werr[i__ + 1] - (w[i__] + werr[
857 d__1 = 0., d__2 = *vu - sigma - (w[*m] + werr[*m]);
static const real gu
Definition: fun-pz81.c:68
int template_lapack_lasq2(integer *n, Treal *z__, integer *info)
Definition: template_lapack_lasq2.h:45
#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_larnv(const integer *idist, integer *iseed, const integer *n, Treal *x)
Definition: template_lapack_larnv.h:42
int template_lapack_larrk(integer *n, integer *iw, Treal *gl, Treal *gu, Treal *d__, Treal *e2, Treal *pivmin, Treal *reltol, Treal *w, Treal *werr, integer *info)
Definition: template_lapack_larrk.h:41
int integer
Definition: template_blas_common.h:40
int template_lapack_larre(const char *range, const integer *n, Treal *vl, Treal *vu, integer *il, integer *iu, Treal *d__, Treal *e, Treal *e2, Treal *rtol1, Treal *rtol2, Treal *spltol, integer *nsplit, integer *isplit, integer *m, Treal *w, Treal *werr, Treal *wgap, integer *iblock, integer *indexw, Treal *gers, Treal *pivmin, Treal *work, integer *iwork, integer *info)
Definition: template_lapack_larre.h:46
int template_lapack_larrc(const char *jobt, const integer *n, const Treal *vl, const Treal *vu, Treal *d__, Treal *e, Treal *pivmin, integer *eigcnt, integer *lcnt, integer *rcnt, integer *info)
Definition: template_lapack_larrc.h:41
#define maxMACRO(a, b)
Definition: template_blas_common.h:45
#define minMACRO(a, b)
Definition: template_blas_common.h:46
Treal template_blas_log(Treal x)
int template_lapack_larrd(const char *range, const char *order, const integer *n, Treal *vl, Treal *vu, integer *il, integer *iu, Treal *gers, Treal *reltol, Treal *d__, Treal *e, Treal *e2, Treal *pivmin, integer *nsplit, integer *isplit, integer *m, Treal *w, Treal *werr, Treal *wl, Treal *wu, integer *iblock, integer *indexw, Treal *work, integer *iwork, integer *info)
Definition: template_lapack_larrd.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
int template_lapack_larra(const integer *n, Treal *d__, Treal *e, Treal *e2, Treal *spltol, Treal *tnrm, integer *nsplit, integer *isplit, integer *info)
Definition: template_lapack_larra.h:41
#define FALSE_
Definition: template_lapack_common.h:43
Treal template_blas_sqrt(Treal x)
logical template_blas_lsame(const char *ca, const char *cb)
Definition: template_blas_common.cc:46