37 #ifndef TEMPLATE_LAPACK_LASQ2_HEADER 38 #define TEMPLATE_LAPACK_LASQ2_HEADER 59 Treal dn1, dn2, dee, eps, tau, tol;
64 Treal dmin__, emin, emax;
66 Treal qmin, temp, qmax, zmax;
70 Treal desig,
trace, sigma;
186 }
else if (*n == 0) {
188 }
else if (*n == 1) {
197 }
else if (*n == 2) {
201 if (z__[2] < 0. || z__[3] < 0.) {
205 }
else if (z__[3] > z__[1]) {
210 z__[5] = z__[1] + z__[2] + z__[3];
211 if (z__[2] > z__[3] * tol2) {
212 t = (z__[1] - z__[3] + z__[2]) * .5;
213 s = z__[3] * (z__[2] / t);
219 t = z__[1] + (s + z__[2]);
220 z__[3] *= z__[1] / t;
224 z__[6] = z__[2] + z__[1];
237 i__1 = ( *n - 1 ) << 1;
238 for (k = 1; k <= i__1; k += 2) {
243 }
else if (z__[k + 1] < 0.) {
251 d__1 = qmax, d__2 = z__[k];
254 d__1 = emin, d__2 = z__[k + 1];
257 d__1 =
maxMACRO(qmax,zmax), d__2 = z__[k + 1];
261 if (z__[(*n << 1) - 1] < 0.) {
262 *info = -((*n << 1) + 199);
266 d__ += z__[(*n << 1) - 1];
268 d__1 = qmax, d__2 = z__[(*n << 1) - 1];
276 for (k = 2; k <= i__1; ++k) {
277 z__[k] = z__[(k << 1) - 1];
281 z__[(*n << 1) - 1] = d__;
290 z__[(*n << 1) - 1] = 0.;
296 ieee =
template_lapack_ilaenv(&c__10,
"DLASQ2",
"N", &c__1, &c__2, &c__3, &c__4, (
ftnlen)6, (
ftnlen)1) == 1 &&
template_lapack_ilaenv(&c__11,
"DLASQ2",
"N", &c__1, &c__2,
301 for (k = *n << 1; k >= 2; k += -2) {
303 z__[(k << 1) - 1] = z__[k];
304 z__[(k << 1) - 2] = 0.;
305 z__[(k << 1) - 3] = z__[k - 1];
314 if (z__[(i0 << 2) - 3] * 1.5 < z__[(n0 << 2) - 3]) {
315 ipn4 = ( i0 + n0 ) << 2;
316 i__1 = ( i0 + n0 - 1 ) << 1;
317 for (i4 = i0 << 2; i4 <= i__1; i4 += 4) {
319 z__[i4 - 3] = z__[ipn4 - i4 - 3];
320 z__[ipn4 - i4 - 3] = temp;
322 z__[i4 - 1] = z__[ipn4 - i4 - 5];
323 z__[ipn4 - i4 - 5] = temp;
332 for (k = 1; k <= 2; ++k) {
334 d__ = z__[(n0 << 2) + pp - 3];
335 i__1 = (i0 << 2) + pp;
336 for (i4 = ( ( n0 - 1 ) << 2) + pp; i4 >= i__1; i4 += -4) {
337 if (z__[i4 - 1] <= tol2 * d__) {
341 d__ = z__[i4 - 3] * (d__ / (d__ + z__[i4 - 1]));
348 emin = z__[(i0 << 2) + pp + 1];
349 d__ = z__[(i0 << 2) + pp - 3];
350 i__1 = ( ( n0 - 1 ) << 2) + pp;
351 for (i4 = (i0 << 2) + pp; i4 <= i__1; i4 += 4) {
352 z__[i4 - (pp << 1) - 2] = d__ + z__[i4 - 1];
353 if (z__[i4 - 1] <= tol2 * d__) {
355 z__[i4 - (pp << 1) - 2] = d__;
356 z__[i4 - (pp << 1)] = 0.;
358 }
else if (safmin * z__[i4 + 1] < z__[i4 - (pp << 1) - 2] &&
359 safmin * z__[i4 - (pp << 1) - 2] < z__[i4 + 1]) {
360 temp = z__[i4 + 1] / z__[i4 - (pp << 1) - 2];
361 z__[i4 - (pp << 1)] = z__[i4 - 1] * temp;
364 z__[i4 - (pp << 1)] = z__[i4 + 1] * (z__[i4 - 1] / z__[i4 - (
366 d__ = z__[i4 + 1] * (d__ / z__[i4 - (pp << 1) - 2]);
369 d__1 = emin, d__2 = z__[i4 - (pp << 1)];
373 z__[(n0 << 2) - pp - 2] = d__;
377 qmax = z__[(i0 << 2) - pp - 2];
378 i__1 = (n0 << 2) - pp - 2;
379 for (i4 = (i0 << 2) - pp + 2; i4 <= i__1; i4 += 4) {
381 d__1 = qmax, d__2 = z__[i4];
405 ndiv = ( n0 - i0 ) << 1;
408 for (iwhila = 1; iwhila <= i__1; ++iwhila) {
422 sigma = -z__[(n0 << 2) - 1];
434 emin = (d__1 = z__[(n0 << 2) - 5],
absMACRO(d__1));
438 qmin = z__[(n0 << 2) - 3];
440 for (i4 = n0 << 2; i4 >= 8; i4 += -4) {
441 if (z__[i4 - 5] <= 0.) {
444 if (qmin >= emax * 4.) {
446 d__1 = qmin, d__2 = z__[i4 - 3];
449 d__1 = emax, d__2 = z__[i4 - 5];
453 d__1 = qmax, d__2 = z__[i4 - 7] + z__[i4 - 5];
456 d__1 = emin, d__2 = z__[i4 - 5];
467 dee = z__[(i0 << 2) - 3];
470 i__2 = (n0 << 2) - 3;
471 for (i4 = (i0 << 2) + 1; i4 <= i__2; i4 += 4) {
472 dee = z__[i4] * (dee / (dee + z__[i4 - 2]));
479 if ( ( kmin - i0 ) << 1 < n0 - kmin && deemin <= z__[(n0 << 2) - 3] *
481 ipn4 = ( i0 + n0 ) << 2;
483 i__2 = ( i0 + n0 - 1 ) << 1;
484 for (i4 = i0 << 2; i4 <= i__2; i4 += 4) {
486 z__[i4 - 3] = z__[ipn4 - i4 - 3];
487 z__[ipn4 - i4 - 3] = temp;
489 z__[i4 - 2] = z__[ipn4 - i4 - 2];
490 z__[ipn4 - i4 - 2] = temp;
492 z__[i4 - 1] = z__[ipn4 - i4 - 5];
493 z__[ipn4 - i4 - 5] = temp;
495 z__[i4] = z__[ipn4 - i4 - 4];
496 z__[ipn4 - i4 - 4] = temp;
514 nbig = (n0 - i0 + 1) * 30;
516 for (iwhilb = 1; iwhilb <= i__2; ++iwhilb) {
524 nfail, &iter, &ndiv, &ieee, &ttype, &dmin1, &dmin2, &dn, &
525 dn1, &dn2, &g, &tau);
531 if (pp == 0 && n0 - i0 >= 3) {
532 if (z__[n0 * 4] <= tol2 * qmax || z__[(n0 << 2) - 1] <= tol2 *
535 qmax = z__[(i0 << 2) - 3];
536 emin = z__[(i0 << 2) - 1];
537 oldemn = z__[i0 * 4];
538 i__3 = ( n0 - 3 ) << 2;
539 for (i4 = i0 << 2; i4 <= i__3; i4 += 4) {
540 if (z__[i4] <= tol2 * z__[i4 - 3] || z__[i4 - 1] <=
542 z__[i4 - 1] = -sigma;
546 oldemn = z__[i4 + 4];
549 d__1 = qmax, d__2 = z__[i4 + 1];
552 d__1 = emin, d__2 = z__[i4 - 1];
555 d__1 = oldemn, d__2 = z__[i4];
560 z__[(n0 << 2) - 1] = emin;
561 z__[n0 * 4] = oldemn;
590 for (k = 2; k <= i__1; ++k) {
591 z__[k] = z__[(k << 2) - 3];
600 for (k = *n; k >= 1; --k) {
607 z__[(*n << 1) + 1] =
trace;
608 z__[(*n << 1) + 2] = e;
609 z__[(*n << 1) + 3] = (Treal) iter;
612 z__[(*n << 1) + 4] = (Treal) ndiv / (Treal) (i__1 * i__1);
613 z__[(*n << 1) + 5] = nfail * 100. / (Treal) iter;
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 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
int template_lapack_lasrt(const char *id, const integer *n, Treal *d__, integer *info)
Definition: template_lapack_lasrt.h:42
#define minMACRO(a, b)
Definition: template_blas_common.h:46
int template_blas_erbla(const char *srname, integer *info)
Definition: template_blas_common.cc:146
int template_lapack_lasq3(integer *i0, integer *n0, Treal *z__, integer *pp, Treal *dmin__, Treal *sigma, Treal *desig, Treal *qmax, integer *nfail, integer *iter, integer *ndiv, logical *ieee, integer *ttype, Treal *dmin1, Treal *dmin2, Treal *dn, Treal *dn1, Treal *dn2, Treal *g, Treal *tau)
Definition: template_lapack_lasq3.h:47
Treal template_lapack_lamch(const char *cmach, Treal dummyReal)
Definition: template_lapack_lamch.h:202
bool logical
Definition: template_blas_common.h:41
int ftnlen
Definition: template_blas_common.h:42
Treal trace(const XYZ< Treal, MatrixGeneral< Treal, Tmatrix >, MatrixGeneral< Treal, Tmatrix > > &smm)
Definition: MatrixGeneral.h:904
Treal template_blas_sqrt(Treal x)