2 #include "types/simple.h"
4 #include "../gmx_lapack.h"
5 #include "lapack_limits.h"
8 F77_FUNC(slasq3,SLASQ3)(int *i0,
54 nn = (*n0 << 2) + *pp;
59 if (z__[nn - 5] > tol2 * (*sigma + z__[nn - 3]) && z__[nn - (*pp << 1) -
60 4] > tol2 * z__[nn - 7]) {
66 z__[(*n0 << 2) - 3] = z__[(*n0 << 2) + *pp - 3] + *sigma;
72 if (z__[nn - 9] > tol2 * *sigma && z__[nn - (*pp << 1) - 8] > tol2 * z__[
79 if (z__[nn - 3] > z__[nn - 7]) {
81 z__[nn - 3] = z__[nn - 7];
84 if (z__[nn - 5] > z__[nn - 3] * tol2) {
85 t = (z__[nn - 7] - z__[nn - 3] + z__[nn - 5]) * .5;
86 s = z__[nn - 3] * (z__[nn - 5] / t);
88 s = z__[nn - 3] * (z__[nn - 5] / (t * (sqrt(s / t + 1.) + 1.)));
90 s = z__[nn - 3] * (z__[nn - 5] / (t + sqrt(t) * sqrt(t + s)));
92 t = z__[nn - 7] + (s + z__[nn - 5]);
93 z__[nn - 3] *= z__[nn - 7] / t;
96 z__[(*n0 << 2) - 7] = z__[nn - 7] + *sigma;
97 z__[(*n0 << 2) - 3] = z__[nn - 3] + *sigma;
106 if (*dmin__ <= 0. || *n0 < n0in) {
107 if (z__[(*i0 << 2) + *pp - 3] * 1.5 < z__[(*n0 << 2) + *pp - 3]) {
108 ipn4 = 4*(*i0 + *n0);
109 i__1 = 2*(*i0 + *n0 - 1);
110 for (j4 = *i0 << 2; j4 <= i__1; j4 += 4) {
112 z__[j4 - 3] = z__[ipn4 - j4 - 3];
113 z__[ipn4 - j4 - 3] = temp;
115 z__[j4 - 2] = z__[ipn4 - j4 - 2];
116 z__[ipn4 - j4 - 2] = temp;
118 z__[j4 - 1] = z__[ipn4 - j4 - 5];
119 z__[ipn4 - j4 - 5] = temp;
121 z__[j4] = z__[ipn4 - j4 - 4];
122 z__[ipn4 - j4 - 4] = temp;
124 if (*n0 - *i0 <= 4) {
125 z__[(*n0 << 2) + *pp - 1] = z__[(*i0 << 2) + *pp - 1];
126 z__[(*n0 << 2) - *pp] = z__[(*i0 << 2) - *pp];
128 d__1 = dmin2, d__2 = z__[(*n0 << 2) + *pp - 1];
129 dmin2 = ((d__1<d__2) ? d__1 : d__2);
130 d__1 = z__[(*n0 << 2) + *pp - 1], d__2 = z__[(*i0 << 2) + *pp - 1]
131 , d__1 = ((d__1<d__2) ? d__1 : d__2), d__2 = z__[(*i0 << 2) + *pp + 3];
132 z__[(*n0 << 2) + *pp - 1] = ((d__1<d__2) ? d__1 : d__2);
133 d__1 = z__[(*n0 << 2) - *pp], d__2 = z__[(*i0 << 2) - *pp], d__1 =
134 ((d__1<d__2) ? d__1 : d__2), d__2 = z__[(*i0 << 2) - *pp + 4];
135 z__[(*n0 << 2) - *pp] = ((d__1<d__2) ? d__1 : d__2);
137 d__2 = z__[(*i0 << 2) + *pp - 3];
138 d__1 = (d__1>d__2) ? d__1 : d__2;
139 d__2 = z__[(*i0 << 2) + *pp + 1];
140 *qmax = ((d__1>d__2) ? d__1 : d__2);
146 F77_FUNC(slasq4,SLASQ4)(i0, n0, &z__[1], pp, &n0in, dmin__, &dmin1, &dmin2, &dn, &dn1, &
151 F77_FUNC(slasq5,SLASQ5)(i0, n0, &z__[1], pp, &tau, dmin__, &dmin1, &dmin2, &dn, &dn1, &
154 *ndiv += *n0 - *i0 + 2;
157 if (*dmin__ >= 0. && dmin1 > 0.) {
161 } else if (*dmin__ < 0. && dmin1 > 0. && z__[4*(*n0 - 1) - *pp] < tol *
162 (*sigma + dn1) && fabs(dn) < tol * *sigma) {
164 z__[4*(*n0 - 1) - *pp + 2] = 0.;
167 } else if (*dmin__ < 0.) {
173 } else if (dmin1 > 0.) {
175 tau = (tau + *dmin__) * (1. - eps * 2.);
190 F77_FUNC(slasq6,SLASQ6)(i0, n0, &z__[1], pp, dmin__, &dmin1, &dmin2, &dn, &dn1, &dn2);
191 *ndiv += *n0 - *i0 + 2;
199 *desig -= t - *sigma;
202 *desig = *sigma - (t - tau) + *desig;