37 #ifndef TEMPLATE_LAPACK_LARRD_HEADER 38 #define TEMPLATE_LAPACK_LARRD_HEADER 43 Treal *reltol, Treal *d__, Treal *e, Treal *e2,
45 Treal *w, Treal *werr, Treal *wl, Treal *wu,
66 integer iend, jblk, ioff, iout, itmp1, itmp2, jdisc;
70 Treal wkill, rtoli, uflow, tnorm;
72 integer irange, idiscl, idumma[1];
331 }
else if (irange == 2) {
335 }
else if (irange == 3 && (*il < 1 || *il >
maxMACRO(1,*n))) {
337 }
else if (irange == 3 && (*iu <
minMACRO(*n,*il) || *iu > *n)) {
354 if (irange == 3 && *il == 1 && *iu == *n) {
363 if ( irange == 1 || ( irange == 2 && d__[1] > *vl && d__[1] <= *vu ) ||
364 ( irange == 3 && *il == 1 && *iu == 1 ) ) {
384 for (i__ = 1; i__ <= i__1; ++i__) {
386 d__1 = gl, d__2 = gers[(i__ << 1) - 1];
389 d__1 =
gu, d__2 = gers[i__ * 2];
397 gl = gl - tnorm * 2. * eps * *n - *pivmin * 4.;
398 gu =
gu + tnorm * 2. * eps * *n + *pivmin * 4.;
411 atoli = uflow * 4. + *pivmin * 4.;
432 d__[1], &e[1], &e2[1], &iwork[5], &work[*n + 1], &work[*n + 5]
433 , &iout, &iwork[1], &w[1], &iblock[1], &iinfo);
439 if (iwork[6] == *iu) {
456 if (nwl < 0 || nwl >= *n || nwu < 1 || nwu > *n) {
460 }
else if (irange == 2) {
463 }
else if (irange == 1) {
477 for (jblk = 1; jblk <= i__1; ++jblk) {
485 if (*wl >= d__[ibegin] - *pivmin) {
488 if (*wu >= d__[ibegin] - *pivmin) {
491 if (irange == 1 || ( *wl < d__[ibegin] - *pivmin && *wu >= d__[
492 ibegin] - *pivmin ) ) {
555 for (j = ibegin; j <= i__2; ++j) {
557 d__1 = gl, d__2 = gers[(j << 1) - 1];
560 d__1 =
gu, d__2 = gers[j * 2];
570 gl = gl - tnorm * 2. * eps * in - *pivmin * 2.;
571 gu =
gu + tnorm * 2. * eps * in + *pivmin * 2.;
589 work[*n + in + 1] =
gu;
591 pivmin, &d__[ibegin], &e[ibegin], &e2[ibegin], idumma, &
592 work[*n + 1], &work[*n + (in << 1) + 1], &im, &iwork[1], &
593 w[*m + 1], &iblock[*m + 1], &iinfo);
600 nwu += iwork[in + 1];
601 iwoff = *m - iwork[1];
606 pivmin, &d__[ibegin], &e[ibegin], &e2[ibegin], idumma, &
607 work[*n + 1], &work[*n + (in << 1) + 1], &iout, &iwork[1],
608 &w[*m + 1], &iblock[*m + 1], &iinfo);
618 for (j = 1; j <= i__2; ++j) {
620 tmp1 = (work[j + *n] + work[j + in + *n]) * .5;
622 tmp2 = (d__1 = work[j + *n] - work[j + in + *n],
absMACRO(d__1)) *
624 if (j > iout - iinfo) {
631 i__3 = iwork[j + in] + iwoff;
632 for (je = iwork[j] + 1 + iwoff; je <= i__3; ++je) {
635 indexw[je] = je - iwoff;
650 idiscl = *il - 1 - nwl;
656 for (je = 1; je <= i__1; ++je) {
659 if (w[je] <= wlu && idiscl > 0) {
665 indexw[im] = indexw[je];
666 iblock[im] = iblock[je];
676 for (je = *m; je >= 1; --je) {
677 if (w[je] >= wul && idiscu > 0) {
683 indexw[im] = indexw[je];
684 iblock[im] = iblock[je];
690 for (je = im; je <= i__1; ++je) {
693 werr[jee] = werr[je];
694 indexw[jee] = indexw[je];
695 iblock[jee] = iblock[je];
700 if (idiscl > 0 || idiscu > 0) {
710 for (jdisc = 1; jdisc <= i__1; ++jdisc) {
713 for (je = 1; je <= i__2; ++je) {
714 if (iblock[je] != 0 && (w[je] < wkill || iw == 0)) {
727 for (jdisc = 1; jdisc <= i__1; ++jdisc) {
730 for (je = 1; je <= i__2; ++je) {
731 if (iblock[je] != 0 && (w[je] >= wkill || iw == 0)) {
744 for (je = 1; je <= i__1; ++je) {
745 if (iblock[je] != 0) {
749 indexw[im] = indexw[je];
750 iblock[im] = iblock[je];
756 if (idiscl < 0 || idiscu < 0) {
761 if ( ( irange == 1 && *m != *n ) || ( irange == 3 && *m != *iu - *il + 1 ) ) {
769 for (je = 1; je <= i__1; ++je) {
773 for (j = je + 1; j <= i__2; ++j) {
786 iblock[ie] = iblock[je];
787 indexw[ie] = indexw[je];
static const real gu
Definition: fun-pz81.c:68
#define absMACRO(x)
Definition: template_blas_common.h:47
int template_lapack_laebz(const integer *ijob, const integer *nitmax, const integer *n, const integer *mmax, const integer *minp, const integer *nbmin, const Treal *abstol, const Treal *reltol, const Treal *pivmin, const Treal *d__, const Treal *e, const Treal *e2, integer *nval, Treal *ab, Treal *c__, integer *mout, integer *nab, Treal *work, integer *iwork, integer *info)
Definition: template_lapack_laebz.h:42
int integer
Definition: template_blas_common.h:40
integer template_lapack_ilaenv(const integer *ispec, const char *name__, const char *opts, const integer *n1, const integer *n2, const integer *n3, const integer *n4, ftnlen name_len, ftnlen opts_len)
Definition: template_lapack_common.cc:281
#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
#define FALSE_
Definition: template_lapack_common.h:43
int ftnlen
Definition: template_blas_common.h:42
logical template_blas_lsame(const char *ca, const char *cb)
Definition: template_blas_common.cc:46