35 #ifndef TEMPLATE_LAPACK_LARRE_HEADER
36 #define TEMPLATE_LAPACK_LARRE_HEADER
46 *e, Treal *e2, Treal *rtol1, Treal *rtol2, Treal *
49 Treal *gers, Treal *pivmin, Treal *work,
integer *
54 Treal d__1, d__2, d__3;
65 Treal eps, tau, tmp, rtl;
87 Treal isrght, bsrtol, dpivot;
316 if (irange == 1 || ( irange == 3 && d__[1] > *vl && d__[1] <= *vu ) ||
317 ( irange == 2 && *il == 1 && *iu == 1 ) ) {
342 for (i__ = 1; i__ <= i__1; ++i__) {
345 eabs = (d__1 = e[i__],
absMACRO(d__1));
350 gers[(i__ << 1) - 1] = d__[i__] - tmp1;
352 d__1 = gl, d__2 = gers[(i__ << 1) - 1];
354 gers[i__ * 2] = d__[i__] + tmp1;
356 d__1 =
gu, d__2 = gers[i__ * 2];
365 d__1 = 1., d__2 = d__3 * d__3;
366 *pivmin = safmin *
maxMACRO(d__1,d__2);
378 usedqd = irange == 1 && ! forceb;
379 if (irange == 1 && ! forceb) {
390 template_lapack_larrd(range,
"B", n, vl, vu, il, iu, &gers[1], &bsrtol, &d__[1], &e[
391 1], &e2[1], pivmin, nsplit, &isplit[1], &mm, &w[1], &werr[1],
392 vl, vu, &iblock[1], &indexw[1], &work[1], &iwork[1], &iinfo);
399 for (i__ = mm + 1; i__ <= i__1; ++i__) {
412 for (jblk = 1; jblk <= i__1; ++jblk) {
414 in = iend - ibegin + 1;
417 if (irange == 1 || ( irange == 3 && d__[ibegin] > *vl && d__[ibegin]
418 <= *vu ) || ( irange == 2 && iblock[wbegin] == jblk ) ) {
444 for (i__ = ibegin; i__ <= i__2; ++i__) {
446 d__1 = gers[(i__ << 1) - 1];
449 d__1 = gers[i__ * 2];
454 if (! (irange == 1 && ! forceb)) {
458 for (i__ = wbegin; i__ <= i__2; ++i__) {
459 if (iblock[i__] == jblk) {
475 usedqd = (Treal) mb > in * .5 && ! forceb;
476 wend = wbegin + mb - 1;
482 for (i__ = wbegin; i__ <= i__2; ++i__) {
484 d__1 = 0., d__2 = w[i__ + 1] - werr[i__ + 1] - (w[i__] +
490 d__1 = 0., d__2 = *vu - sigma - (w[wend] + werr[wend]);
493 indl = indexw[wbegin];
497 if ( ( irange == 1 && ! forceb ) || usedqd) {
501 rtl, &tmp, &tmp1, &iinfo);
507 d__2 = gl, d__3 = tmp - tmp1 - eps * 100. * (d__1 = tmp - tmp1,
511 rtl, &tmp, &tmp1, &iinfo);
517 d__2 =
gu, d__3 = tmp + tmp1 + eps * 100. * (d__1 = tmp + tmp1,
521 spdiam = isrght - isleft;
526 d__2 = gl, d__3 = w[wbegin] - werr[wbegin] - eps * 100. * (d__1 =
527 w[wbegin] - werr[wbegin],
absMACRO(d__1));
530 d__2 =
gu, d__3 = w[wend] + werr[wend] + eps * 100. * (d__1 = w[
531 wend] + werr[wend],
absMACRO(d__1));
542 if (irange == 1 && ! forceb) {
550 wend = wbegin + mb - 1;
552 s1 = isleft + spdiam * .25;
553 s2 = isrght - spdiam * .25;
559 s1 = isleft + spdiam * .25;
560 s2 = isrght - spdiam * .25;
563 s1 =
maxMACRO(isleft,*vl) + tmp * .25;
564 s2 =
minMACRO(isrght,*vu) - tmp * .25;
570 cnt, &cnt1, &cnt2, &iinfo);
575 }
else if (cnt1 - indl >= indu - cnt2) {
576 if (irange == 1 && ! forceb) {
589 if (irange == 1 && ! forceb) {
610 tau = spdiam * eps * *n + *pivmin * 2.;
613 clwdth = w[wend] + werr[wend] - w[wbegin] - werr[wbegin];
614 avgap = (d__1 = clwdth / (Treal) (wend - wbegin),
absMACRO(
621 d__1 = tau, d__2 = werr[wbegin];
625 d__1 = wgap[wend - 1];
628 d__1 = tau, d__2 = werr[wend];
636 for (idum = 1; idum <= 6; ++idum) {
640 dpivot = d__[ibegin] - sigma;
645 for (i__ = 1; i__ <= i__2; ++i__) {
646 work[(in << 1) + i__] = 1. / work[i__];
647 tmp = e[j] * work[(in << 1) + i__];
648 work[in + i__] = tmp;
649 dpivot = d__[j + 1] - sigma - tmp * e[j];
650 work[i__ + 1] = dpivot;
652 d__1 = dmax__, d__2 =
absMACRO(dpivot);
658 if (dmax__ > spdiam * 64.) {
663 if (usedqd && ! norep) {
667 for (i__ = 1; i__ <= i__2; ++i__) {
668 tmp = sgndef * work[i__];
682 sigma = gl - spdiam * 2. * eps * *n - *pivmin * 4.;
684 sigma = gu + spdiam * 2. * eps * *n + *pivmin * 4.;
687 sigma -= sgndef * tau;
715 for (i__ = 1; i__ <= 4; ++i__) {
719 i__2 = (in << 1) - 1;
722 for (i__ = 1; i__ <= i__2; ++i__) {
723 d__[ibegin + i__ - 1] *= eps * 8. * work[i__] + 1.;
724 e[ibegin + i__ - 1] *= eps * 8. * work[in + i__] + 1.;
727 d__[iend] *= eps * 4. * work[in] + 1.;
743 for (j = wbegin; j <= i__2; ++j) {
745 werr[j] += (d__1 = w[j],
absMACRO(d__1)) * eps;
751 for (i__ = ibegin; i__ <= i__2; ++i__) {
754 work[i__] = d__[i__] * (d__1 * d__1);
760 rtol2, &i__2, &w[wbegin], &wgap[wbegin], &werr[wbegin], &
761 work[(*n << 1) + 1], &iwork[1], pivmin, &spdiam, &in, &
770 d__1 = 0., d__2 = *vu - sigma - (w[wend] + werr[wend]);
773 for (i__ = indl; i__ <= i__2; ++i__) {
794 for (i__ = 1; i__ <= i__2; ++i__) {
795 work[(i__ << 1) - 1] = (d__1 = d__[j],
absMACRO(d__1));
796 work[i__ * 2] = e[j] * e[j] * work[(i__ << 1) - 1];
800 work[(in << 1) - 1] = (d__1 = d__[iend],
absMACRO(d__1));
812 for (i__ = 1; i__ <= i__2; ++i__) {
813 if (work[i__] < 0.) {
822 for (i__ = indl; i__ <= i__2; ++i__) {
824 w[*m] = work[in - i__ + 1];
831 for (i__ = indl; i__ <= i__2; ++i__) {
840 for (i__ = *m - mb + 1; i__ <= i__2; ++i__) {
842 werr[i__] = rtol * (d__1 = w[i__],
absMACRO(d__1));
846 for (i__ = *m - mb + 1; i__ <= i__2; ++i__) {
849 d__1 = 0., d__2 = w[i__ + 1] - werr[i__ + 1] - (w[i__] + werr[
855 d__1 = 0., d__2 = *vu - sigma - (w[*m] + werr[*m]);
static const real gu
Definition: fun-pz81.c:71
int template_lapack_lasq2(integer *n, Treal *z__, integer *info)
Definition: template_lapack_lasq2.h:43
#define absMACRO(x)
Definition: template_blas_common.h:45
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:43
int template_lapack_larnv(const integer *idist, integer *iseed, const integer *n, Treal *x)
Definition: template_lapack_larnv.h:40
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:39
int integer
Definition: template_blas_common.h:38
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:44
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:39
#define maxMACRO(a, b)
Definition: template_blas_common.h:43
#define minMACRO(a, b)
Definition: template_blas_common.h:44
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:39
Treal template_lapack_lamch(const char *cmach, Treal dummyReal)
Definition: template_lapack_lamch.h:199
bool logical
Definition: template_blas_common.h:39
#define TRUE_
Definition: template_lapack_common.h:40
int template_blas_copy(const integer *n, const Treal *dx, const integer *incx, Treal *dy, const integer *incy)
Definition: template_blas_copy.h:40
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:39
#define FALSE_
Definition: template_lapack_common.h:41
Treal template_blas_sqrt(Treal x)
logical template_blas_lsame(const char *ca, const char *cb)
Definition: template_blas_common.cc:44