35 #ifndef TEMPLATE_LAPACK_STERF_HEADER 36 #define TEMPLATE_LAPACK_STERF_HEADER 91 Treal d__1, d__2, d__3;
97 Treal p, gamma, r__, s, alpha, sigma, anorm;
101 Treal oldgam, safmin;
106 Treal ssfmax, rt1, rt2, eps, rte;
136 safmax = 1. / safmin;
160 for (m = l1; m <= i__1; ++m) {
185 if (anorm > ssfmax) {
193 }
else if (anorm < ssfmin) {
204 for (i__ = l; i__ <= i__1; ++i__) {
207 e[i__] = d__1 * d__1;
227 for (m = l; m <= i__1; ++m) {
228 if ((d__2 = e[m],
absMACRO(d__2)) <= eps2 * (d__1 = d__[m] * d__[m
262 if (jtot == nmaxit) {
270 sigma = (d__[l + 1] - p) / (rte * 2.);
276 gamma = d__[m] - sigma;
282 for (i__ = m - 1; i__ >= i__1; --i__) {
286 e[i__ + 1] = s * r__;
293 gamma = c__ * (alpha - sigma) - s * oldgam;
294 d__[i__ + 1] = oldgam + (alpha - gamma);
296 p = gamma * gamma / c__;
304 d__[l] = sigma + gamma;
326 for (m = l; m >= i__1; --m) {
327 if ((d__2 = e[m - 1],
absMACRO(d__2)) <= eps2 * (d__1 = d__[m] * d__[m
360 if (jtot == nmaxit) {
368 sigma = (d__[l - 1] - p) / (rte * 2.);
374 gamma = d__[m] - sigma;
380 for (i__ = m; i__ <= i__1; ++i__) {
384 e[i__ - 1] = s * r__;
390 alpha = d__[i__ + 1];
391 gamma = c__ * (alpha - sigma) - s * oldgam;
392 d__[i__] = oldgam + (alpha - gamma);
394 p = gamma * gamma / c__;
402 d__[l] = sigma + gamma;
422 i__1 = lendsv - lsv + 1;
427 i__1 = lendsv - lsv + 1;
439 for (i__ = 1; i__ <= i__1; ++i__) {
#define absMACRO(x)
Definition: template_blas_common.h:45
int template_lapack_lascl(const char *type__, const integer *kl, const integer *ku, const Treal *cfrom, const Treal *cto, const integer *m, const integer *n, Treal *a, const integer *lda, integer *info)
Definition: template_lapack_lascl.h:40
int integer
Definition: template_blas_common.h:38
Treal template_lapack_lapy2(Treal *x, Treal *y)
Definition: template_lapack_lapy2.h:40
int template_lapack_lasrt(const char *id, const integer *n, Treal *d__, integer *info)
Definition: template_lapack_lasrt.h:40
Treal template_lapack_d_sign(const Treal *a, const Treal *b)
Definition: template_lapack_lamch.h:46
int template_blas_erbla(const char *srname, integer *info)
Definition: template_blas_common.cc:144
Treal template_lapack_lamch(const char *cmach, Treal dummyReal)
Definition: template_lapack_lamch.h:199
int template_lapack_sterf(const integer *n, Treal *d__, Treal *e, integer *info)
Definition: template_lapack_sterf.h:41
int template_lapack_lae2(const Treal *a, const Treal *b, const Treal *c__, Treal *rt1, Treal *rt2)
Definition: template_lapack_lae2.h:40
Treal template_lapack_lanst(const char *norm, const integer *n, const Treal *d__, const Treal *e)
Definition: template_lapack_lanst.h:40
Treal template_blas_sqrt(Treal x)