tsbres threesumsb(double x, double y, double z) {
volatile tsbres res;
volatile flerr tmp1,tmp2;
tmp1 = twosum(x,y);
tmp2 = twosum(tmp1.r,z);
res.v[0] = tmp2.r;
res.v[1] = tmp1.e+tmp2.e;
// Rprintf(" Three-Sum; a=%g, b=%g, c=%g, sum=%g, error1=%g\n",x,y,z,res.v[0],res.v[1],res.v[2]);
return(res);
}
tsares sixthreesum(double a, double b, double c, double d, double e, double f) {
volatile tsares res,tmp1,tmp2;
volatile flerr tmp3, tmp4, tmp5;
tmp1 = threesumsa(a,b,c);
tmp2 = threesumsa(d,e,f);
tmp3 = twosum(tmp1.v[0],tmp2.v[0]);
res.v[0] = tmp3.r;
tmp4 = twosum(tmp1.v[1],tmp2.v[1]);
tmp5 = twosum(tmp4.r,tmp3.e);
res.v[1] = tmp5.r;
res.v[2] = tmp1.v[2]+tmp2.v[2]+tmp4.e+tmp5.e;
return(res);
}
qdouble qdplusd(qdouble a, double b) {
unqdouble us;
flerr tmp;
tmp = twosum(a.v[0],b);
us.v[0] = tmp.r;
tmp = twosum(a.v[1],tmp.e);
us.v[1] = tmp.r;
tmp = twosum(a.v[2],tmp.e);
us.v[2] = tmp.r;
tmp = twosum(a.v[3],tmp.e);
us.v[3] = tmp.r;
us.v[4] = tmp.e;
// Rprintf(" sum of %g + %g + %g + %g and %g\n",a.v[0],a.v[1],a.v[2],a.v[3],b);
return(renormalize(us));
}
flerr ninetwosum_old(double a, double b, double c, double d, double e, double f,
double g, double h, double i) {
volatile flerr res;
volatile flerr tmp1,tmp2,tmp3,tmp4;
tmp1 = twosum(a,b);
tmp2 = twosum(c,d);
tmp3 = twosum(e,f);
tmp4 = twosum(g,h);
tmp1 = doubledoublesum(tmp1,tmp2);
tmp2 = doubledoublesum(tmp3,tmp4);
tmp3 = doubledoublesum(tmp1,tmp2);
tmp4 = twosum(tmp3.r,i);
res.r = tmp4.r;
res.e = tmp4.e+tmp3.e;
return(res);
}
flerr doubledoublesum(flerr a, flerr b) {
volatile flerr res,tmp;
tmp = twosum(a.r,b.r);
res.r = tmp.r;
res.e = tmp.e+a.e+b.e;
return(res);
}
int main(void)
{
int a[] = {2, 7, 11, 15};
int* idx = twosum(a, 4, 26);
printf("%d\n", *idx);
idx++;
printf("%d\n", *idx);
return 0;
}
qdouble qdadd2 (qdouble a, qdouble b) {
unqdouble us;
flerr tmp1, tmp2, tmp3, tmp4;
tsares tmpA;
tsbres tmpB;
tmp1 = twosum(a.v[0],b.v[0]);
us.v[0] = tmp1.r;
tmp2 = twosum(a.v[1],b.v[1]);
tmp1 = twosum(tmp2.r,tmp1.e);
us.v[1] = tmp1.r;
tmp3 = twosum(a.v[2],b.v[2]);
tmpA = threesumsa(tmp3.r,tmp1.e,tmp2.e);
us.v[2] = tmpA.v[0];
tmp4 = twosum(a.v[3],b.v[3]);
tmpB = threesumsb(tmp4.r,tmp3.e,tmpA.v[1]);
us.v[3] = tmpB.v[0];
us.v[4] = tmpB.v[1]+tmpA.v[2]+tmp4.e;
return(renormalize(us));
}
daccres doubleacc(double u, double v, double x) {
// Rprintf("DACC In: %20g, %20g, %20g\n",u,v,x);
daccres res;
flerr tmp;
double vint,uint,s;
tmp = twosum(v,x);
vint = tmp.e;
tmp = twosum(u,tmp.r);
uint = tmp.e;
s = tmp.r;
if (uint==0.) {
uint = s; s = 0.0;
}
if (vint==0.) {
vint = uint; uint = s; s = 0.0;
}
res.s = s; res.u = uint; res.v = vint;
// Rprintf("DACC Out: %20g, %20g, %20g\n",res.s,res.u,res.v);
return(res);
}
int main() {
// The following is just a single test case. Not meant to be exhaustive.
int nums[7] = {0,1,1,1,1,1,3};
int* indices = twosum(nums, 7, 5);
if (!indices) {
printf("no indices found.\n");
exit(1);
}
printf("The indices are: ");
int i;
for (i = 0; i < 2; i++){
printf("%i ", indices[i]);
}
printf("\n");
}
qdouble qdtimesd (qdouble a, double b) {
unqdouble us;
volatile flerr tmp1, tmp2, tmp3;
tmp1 = twoprod(a.v[0],b);
tmp2 = twoprod(a.v[1],b);
tmp3 = twoprod(a.v[2],b);
us.v[0] = tmp1.r;
tmp1 = twosum(tmp2.r,tmp1.e);
us.v[1] = tmp1.r;
volatile tsares tmp4 = threesumsa(tmp3.r,tmp2.e,tmp1.e);
us.v[2] = tmp4.v[0];
volatile tsbres tmp5 = threesumsb(a.v[3]*b,tmp3.e,tmp4.v[1]);
us.v[3] = tmp5.v[0];
us.v[4] = tmp5.v[1]+tmp4.v[2];
return(renormalize(us));
}
int possible(ull n)
{
int pos=bisect(0,N,n);
return twosum(pos,n);
}
/*
* Z = q0, q1, ..., qn1, qn (N columns, 4 rows)
* qq0, qq1, ..., qqn1, qqn
* e0, e1, ..., en1, 0
* ee0, ee1, ..., een1, 0
*
* \return number of deflations
*/
static
int __dqds_goodstep(DTYPE *ssum, armas_x_dense_t *Z, int N, int pp, dmin_data_t *dmind)
{
armas_x_dense_t sq, dq, se, de;
int n, ncnt, nfail, newseg;
DTYPE x, y, q0, q1, sigma, tau;
EMPTY(de); EMPTY(dq); EMPTY(se); EMPTY(sq);
sigma = *ssum;
newseg = __SIGN(dmind->dmin);
//printf("..[goodstep] entering ping=%d, N=%d, newseg=%d, sigma=%e, dmin=%e\n",
// pp, N, newseg, sigma, dmind->dmin);
armas_x_row(&sq, Z, pp);
armas_x_row(&dq, Z, 1 - pp);
armas_x_row(&se, Z, 2 + pp);
armas_x_row(&de, Z, 3 - pp);
dmind->niter++;
if (N == 1) {
armas_x_set_unsafe(Z, 0, 0, armas_x_get_at_unsafe(&sq, 0)+(sigma+dmind->cterm));
//printf("..[goodstep] deflated single valued vector eig=%9.6f\n", __SQRT(armas_x_get_unsafe(Z, 0, 0)));
return 1;
}
// 1. Look for neglible E-values
ncnt = 0;
if (! newseg) {
do {
n = __dqds_neglible(Z, N-ncnt, pp, sigma+dmind->cterm);
ncnt += n;
} while (n != 0 && N-ncnt > 0);
}
if (N-ncnt == 0) {
//printf("..[goodstep] deflated (%d) to zero length\n", ncnt);
return ncnt;
}
// 2 test flipping 1.5*q(0) < q(N-1) if new segment or deflated values
if (newseg || ncnt > 0) {
q0 = armas_x_get_at_unsafe(&sq, 0);
q1 = armas_x_get_at_unsafe(&sq, N-ncnt-1);
if (CFLIP*q0 < q1) {
//printf("..[goodstep] need flipping.. [0, %d]\n", N-ncnt-1);
__dqds_flip(Z, N-ncnt);
}
}
// 3a. if no overflow or no new segment, choose shift
__dqds_shift(&tau, &sq, &se, &dq, &de, N-ncnt, ncnt, dmind);
//printf("..[goodstep]: tau=%e [type=%d, dmin=%e,%e, dmin1=%e]\n", tau, t, dmind->ttype, dmind->dmin, dmind->dn, dmind->dmin1);
// 4. run dqds until dmin > 0
nfail = 0;
do {
__dqds_sweep(&dq, &de, &sq, &se, N-ncnt, tau, dmind);
if (dmind->dmin < __ZERO) {
// failure here
DTYPE en1 = armas_x_get_at_unsafe(&de, N-ncnt-2);
if (dmind->dmin1 > __ZERO && en1 < __EPS*(sigma+dmind->dn1) &&
__ABS(dmind->dn) < __EPS*sigma) {
// convergence masked by negative d (section 6.4)
armas_x_set_at_unsafe(&dq, N-ncnt-1, __ZERO);
dmind->dmin = __ZERO;
//printf("..[masked] dmin1 > %e, setting qn to zero.!\n", dmind->dmin1);
// break out from loop
//break;
}
nfail++;
if (nfail > 1) {
tau = __ZERO;
} else if (dmind->dmin1 > __ZERO) {
// late failure
tau = (tau + dmind->dmin)*(1.0 - 2.0*__EPS);
dmind->ttype -= 11;
} else {
tau *= 0.25;
dmind->ttype -= 12;
}
//printf("..failure[%d]: tau=%e\n", nfail, tau);
dmind->niter++;
dmind->nfail++;
}
} while (dmind->dmin < __ZERO || dmind->dmin1 < __ZERO);
// 5. update sigma; sequence of tau values.
// use cascaded summation from (2), algorithm 4.1
// this here is one step of the algorithm, error term
// is summated to dmind->cterm
twosum(&x, &y, *ssum, tau);
//printf("..[goodstep] 2sum x=%13e, y=%13e, a=%13e, b=%13e\n", x, y, *ssum, tau);
*ssum = x;
dmind->cterm += y;
//printf("..[goodstep] 2sum c=%13e, eig=%13e\n", dmind->cterm, __SQRT(x+dmind->cterm));
return ncnt;
}
