35 #ifndef TEMPLATE_LAPACK_LASQ2_HEADER 36 #define TEMPLATE_LAPACK_LASQ2_HEADER 57 Treal dn1, dn2, dee, eps, tau, tol;
62 Treal dmin__, emin, emax;
64 Treal qmin, temp, qmax, zmax;
68 Treal desig,
trace, sigma;
184 }
else if (*n == 0) {
186 }
else if (*n == 1) {
195 }
else if (*n == 2) {
199 if (z__[2] < 0. || z__[3] < 0.) {
203 }
else if (z__[3] > z__[1]) {
208 z__[5] = z__[1] + z__[2] + z__[3];
209 if (z__[2] > z__[3] * tol2) {
210 t = (z__[1] - z__[3] + z__[2]) * .5;
211 s = z__[3] * (z__[2] / t);
217 t = z__[1] + (s + z__[2]);
218 z__[3] *= z__[1] / t;
222 z__[6] = z__[2] + z__[1];
235 i__1 = ( *n - 1 ) << 1;
236 for (k = 1; k <= i__1; k += 2) {
241 }
else if (z__[k + 1] < 0.) {
249 d__1 = qmax, d__2 = z__[k];
252 d__1 = emin, d__2 = z__[k + 1];
255 d__1 =
maxMACRO(qmax,zmax), d__2 = z__[k + 1];
259 if (z__[(*n << 1) - 1] < 0.) {
260 *info = -((*n << 1) + 199);
264 d__ += z__[(*n << 1) - 1];
266 d__1 = qmax, d__2 = z__[(*n << 1) - 1];
274 for (k = 2; k <= i__1; ++k) {
275 z__[k] = z__[(k << 1) - 1];
279 z__[(*n << 1) - 1] = d__;
288 z__[(*n << 1) - 1] = 0.;
294 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,
299 for (k = *n << 1; k >= 2; k += -2) {
301 z__[(k << 1) - 1] = z__[k];
302 z__[(k << 1) - 2] = 0.;
303 z__[(k << 1) - 3] = z__[k - 1];
312 if (z__[(i0 << 2) - 3] * 1.5 < z__[(n0 << 2) - 3]) {
313 ipn4 = ( i0 + n0 ) << 2;
314 i__1 = ( i0 + n0 - 1 ) << 1;
315 for (i4 = i0 << 2; i4 <= i__1; i4 += 4) {
317 z__[i4 - 3] = z__[ipn4 - i4 - 3];
318 z__[ipn4 - i4 - 3] = temp;
320 z__[i4 - 1] = z__[ipn4 - i4 - 5];
321 z__[ipn4 - i4 - 5] = temp;
330 for (k = 1; k <= 2; ++k) {
332 d__ = z__[(n0 << 2) + pp - 3];
333 i__1 = (i0 << 2) + pp;
334 for (i4 = ( ( n0 - 1 ) << 2) + pp; i4 >= i__1; i4 += -4) {
335 if (z__[i4 - 1] <= tol2 * d__) {
339 d__ = z__[i4 - 3] * (d__ / (d__ + z__[i4 - 1]));
346 emin = z__[(i0 << 2) + pp + 1];
347 d__ = z__[(i0 << 2) + pp - 3];
348 i__1 = ( ( n0 - 1 ) << 2) + pp;
349 for (i4 = (i0 << 2) + pp; i4 <= i__1; i4 += 4) {
350 z__[i4 - (pp << 1) - 2] = d__ + z__[i4 - 1];
351 if (z__[i4 - 1] <= tol2 * d__) {
353 z__[i4 - (pp << 1) - 2] = d__;
354 z__[i4 - (pp << 1)] = 0.;
356 }
else if (safmin * z__[i4 + 1] < z__[i4 - (pp << 1) - 2] &&
357 safmin * z__[i4 - (pp << 1) - 2] < z__[i4 + 1]) {
358 temp = z__[i4 + 1] / z__[i4 - (pp << 1) - 2];
359 z__[i4 - (pp << 1)] = z__[i4 - 1] * temp;
362 z__[i4 - (pp << 1)] = z__[i4 + 1] * (z__[i4 - 1] / z__[i4 - (
364 d__ = z__[i4 + 1] * (d__ / z__[i4 - (pp << 1) - 2]);
367 d__1 = emin, d__2 = z__[i4 - (pp << 1)];
371 z__[(n0 << 2) - pp - 2] = d__;
375 qmax = z__[(i0 << 2) - pp - 2];
376 i__1 = (n0 << 2) - pp - 2;
377 for (i4 = (i0 << 2) - pp + 2; i4 <= i__1; i4 += 4) {
379 d__1 = qmax, d__2 = z__[i4];
403 ndiv = ( n0 - i0 ) << 1;
406 for (iwhila = 1; iwhila <= i__1; ++iwhila) {
420 sigma = -z__[(n0 << 2) - 1];
432 emin = (d__1 = z__[(n0 << 2) - 5],
absMACRO(d__1));
436 qmin = z__[(n0 << 2) - 3];
438 for (i4 = n0 << 2; i4 >= 8; i4 += -4) {
439 if (z__[i4 - 5] <= 0.) {
442 if (qmin >= emax * 4.) {
444 d__1 = qmin, d__2 = z__[i4 - 3];
447 d__1 = emax, d__2 = z__[i4 - 5];
451 d__1 = qmax, d__2 = z__[i4 - 7] + z__[i4 - 5];
454 d__1 = emin, d__2 = z__[i4 - 5];
465 dee = z__[(i0 << 2) - 3];
468 i__2 = (n0 << 2) - 3;
469 for (i4 = (i0 << 2) + 1; i4 <= i__2; i4 += 4) {
470 dee = z__[i4] * (dee / (dee + z__[i4 - 2]));
477 if ( ( kmin - i0 ) << 1 < n0 - kmin && deemin <= z__[(n0 << 2) - 3] *
479 ipn4 = ( i0 + n0 ) << 2;
481 i__2 = ( i0 + n0 - 1 ) << 1;
482 for (i4 = i0 << 2; i4 <= i__2; i4 += 4) {
484 z__[i4 - 3] = z__[ipn4 - i4 - 3];
485 z__[ipn4 - i4 - 3] = temp;
487 z__[i4 - 2] = z__[ipn4 - i4 - 2];
488 z__[ipn4 - i4 - 2] = temp;
490 z__[i4 - 1] = z__[ipn4 - i4 - 5];
491 z__[ipn4 - i4 - 5] = temp;
493 z__[i4] = z__[ipn4 - i4 - 4];
494 z__[ipn4 - i4 - 4] = temp;
512 nbig = (n0 - i0 + 1) * 30;
514 for (iwhilb = 1; iwhilb <= i__2; ++iwhilb) {
522 nfail, &iter, &ndiv, &ieee, &ttype, &dmin1, &dmin2, &dn, &
523 dn1, &dn2, &g, &tau);
529 if (pp == 0 && n0 - i0 >= 3) {
530 if (z__[n0 * 4] <= tol2 * qmax || z__[(n0 << 2) - 1] <= tol2 *
533 qmax = z__[(i0 << 2) - 3];
534 emin = z__[(i0 << 2) - 1];
535 oldemn = z__[i0 * 4];
536 i__3 = ( n0 - 3 ) << 2;
537 for (i4 = i0 << 2; i4 <= i__3; i4 += 4) {
538 if (z__[i4] <= tol2 * z__[i4 - 3] || z__[i4 - 1] <=
540 z__[i4 - 1] = -sigma;
544 oldemn = z__[i4 + 4];
547 d__1 = qmax, d__2 = z__[i4 + 1];
550 d__1 = emin, d__2 = z__[i4 - 1];
553 d__1 = oldemn, d__2 = z__[i4];
558 z__[(n0 << 2) - 1] = emin;
559 z__[n0 * 4] = oldemn;
588 for (k = 2; k <= i__1; ++k) {
589 z__[k] = z__[(k << 2) - 3];
598 for (k = *n; k >= 1; --k) {
605 z__[(*n << 1) + 1] = trace;
606 z__[(*n << 1) + 2] = e;
607 z__[(*n << 1) + 3] = (Treal) iter;
610 z__[(*n << 1) + 4] = (Treal) ndiv / (Treal) (i__1 * i__1);
611 z__[(*n << 1) + 5] = nfail * 100. / (Treal) iter;
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 integer
Definition: template_blas_common.h:38
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:279
#define maxMACRO(a, b)
Definition: template_blas_common.h:43
int template_lapack_lasrt(const char *id, const integer *n, Treal *d__, integer *info)
Definition: template_lapack_lasrt.h:40
#define minMACRO(a, b)
Definition: template_blas_common.h:44
int template_blas_erbla(const char *srname, integer *info)
Definition: template_blas_common.cc:144
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:45
Treal template_lapack_lamch(const char *cmach, Treal dummyReal)
Definition: template_lapack_lamch.h:199
bool logical
Definition: template_blas_common.h:39
int ftnlen
Definition: template_blas_common.h:40
Treal trace(const XYZ< Treal, MatrixGeneral< Treal, Tmatrix >, MatrixGeneral< Treal, Tmatrix > > &smm)
Definition: MatrixGeneral.h:902
Treal template_blas_sqrt(Treal x)