void lpf_btran(LPF *lpf, double x[])
{ int m0 = lpf->m0;
int m = lpf->m;
int n = lpf->n;
int *P_row = lpf->P_row;
int *Q_row = lpf->Q_row;
double *fg = lpf->work1;
double *f = fg;
double *g = fg + m0;
int i, ii;
#if GLPLPF_DEBUG
double *b;
#endif
if (!lpf->valid)
xfault("lpf_btran: the factorization is not valid\n");
xassert(0 <= m && m <= m0 + n);
#if GLPLPF_DEBUG
/* save the right-hand side vector */
b = xcalloc(1+m, sizeof(double));
for (i = 1; i <= m; i++) b[i] = x[i];
#endif
/* (f g) := Q * (b 0) */
for (i = 1; i <= m0 + n; i++)
fg[i] = ((ii = Q_row[i]) <= m ? x[ii] : 0.0);
/* f1 := inv(U'0) * f */
#if 0 /* 06/VI-2013 */
luf_v_solve(lpf->luf, 1, f);
#else
{ double *work = lpf->lufint->sgf->work;
luf_vt_solve(lpf->lufint->luf, f, work);
memcpy(&f[1], &work[1], m0 * sizeof(double));
}
#endif
/* g1 := inv(C') * (g - R' * f1) */
rt_prod(lpf, g, -1.0, f);
scf_solve_it(lpf->scf, 1, g);
/* g2 := g1 */
g = g;
/* f2 := inv(L'0) * (f1 - S' * g2) */
st_prod(lpf, f, -1.0, g);
#if 0 /* 06/VI-2013 */
luf_f_solve(lpf->luf, 1, f);
#else
luf_ft_solve(lpf->lufint->luf, f);
#endif
/* (x y) := P * (f2 g2) */
for (i = 1; i <= m; i++)
x[i] = fg[P_row[i]];
#if GLPLPF_DEBUG
/* check relative error in solution */
check_error(lpf, 1, x, b);
xfree(b);
#endif
return;
}
void scf_s0_solve(SCF *scf, int tr, double x[/*1+n0*/],
double w1[/*1+n0*/], double w2[/*1+n0*/], double w3[/*1+n0*/])
{ int n0 = scf->n0;
switch (scf->type)
{ case 1:
/* A0 = F0 * V0, so S0 = V0 */
if (!tr)
luf_v_solve(scf->a0.luf, x, w1);
else
luf_vt_solve(scf->a0.luf, x, w1);
break;
case 2:
/* A0 = I * A0, so S0 = A0 */
if (!tr)
btf_a_solve(scf->a0.btf, x, w1, w2, w3);
else
btf_at_solve(scf->a0.btf, x, w1, w2, w3);
break;
default:
xassert(scf != scf);
}
memcpy(&x[1], &w1[1], n0 * sizeof(double));
return;
}
int lpf_update_it(LPF *lpf, int j, int bh, int len, const int ind[],
const double val[])
{ int m0 = lpf->m0;
int m = lpf->m;
#if GLPLPF_DEBUG
double *B = lpf->B;
#endif
int n = lpf->n;
int *R_ptr = lpf->R_ptr;
int *R_len = lpf->R_len;
int *S_ptr = lpf->S_ptr;
int *S_len = lpf->S_len;
int *P_row = lpf->P_row;
int *P_col = lpf->P_col;
int *Q_row = lpf->Q_row;
int *Q_col = lpf->Q_col;
int v_ptr = lpf->v_ptr;
int *v_ind = lpf->v_ind;
double *v_val = lpf->v_val;
double *a = lpf->work2; /* new column */
double *fg = lpf->work1, *f = fg, *g = fg + m0;
double *vw = lpf->work2, *v = vw, *w = vw + m0;
double *x = g, *y = w, z;
int i, ii, k, ret;
xassert(bh == bh);
if (!lpf->valid)
xfault("lpf_update_it: the factorization is not valid\n");
if (!(1 <= j && j <= m))
xfault("lpf_update_it: j = %d; column number out of range\n",
j);
xassert(0 <= m && m <= m0 + n);
/* check if the basis factorization can be expanded */
if (n == lpf->n_max)
{ lpf->valid = 0;
ret = LPF_ELIMIT;
goto done;
}
/* convert new j-th column of B to dense format */
for (i = 1; i <= m; i++)
a[i] = 0.0;
for (k = 1; k <= len; k++)
{ i = ind[k];
if (!(1 <= i && i <= m))
xfault("lpf_update_it: ind[%d] = %d; row number out of rang"
"e\n", k, i);
if (a[i] != 0.0)
xfault("lpf_update_it: ind[%d] = %d; duplicate row index no"
"t allowed\n", k, i);
if (val[k] == 0.0)
xfault("lpf_update_it: val[%d] = %g; zero element not allow"
"ed\n", k, val[k]);
a[i] = val[k];
}
#if GLPLPF_DEBUG
/* change column in the basis matrix for debugging */
for (i = 1; i <= m; i++)
B[(i - 1) * m + j] = a[i];
#endif
/* (f g) := inv(P) * (a 0) */
for (i = 1; i <= m0+n; i++)
fg[i] = ((ii = P_col[i]) <= m ? a[ii] : 0.0);
/* (v w) := Q * (ej 0) */
for (i = 1; i <= m0+n; i++) vw[i] = 0.0;
vw[Q_col[j]] = 1.0;
/* f1 := inv(L0) * f (new column of R) */
#if 0 /* 06/VI-2013 */
luf_f_solve(lpf->luf, 0, f);
#else
luf_f_solve(lpf->lufint->luf, f);
#endif
/* v1 := inv(U'0) * v (new row of S) */
#if 0 /* 06/VI-2013 */
luf_v_solve(lpf->luf, 1, v);
#else
{ double *work = lpf->lufint->sgf->work;
luf_vt_solve(lpf->lufint->luf, v, work);
memcpy(&v[1], &work[1], m0 * sizeof(double));
}
#endif
/* we need at most 2 * m0 available locations in the SVA to store
new column of matrix R and new row of matrix S */
if (lpf->v_size < v_ptr + m0 + m0)
{ enlarge_sva(lpf, v_ptr + m0 + m0);
v_ind = lpf->v_ind;
v_val = lpf->v_val;
}
/* store new column of R */
R_ptr[n+1] = v_ptr;
for (i = 1; i <= m0; i++)
{ if (f[i] != 0.0)
v_ind[v_ptr] = i, v_val[v_ptr] = f[i], v_ptr++;
}
R_len[n+1] = v_ptr - lpf->v_ptr;
lpf->v_ptr = v_ptr;
/* store new row of S */
S_ptr[n+1] = v_ptr;
for (i = 1; i <= m0; i++)
{ if (v[i] != 0.0)
v_ind[v_ptr] = i, v_val[v_ptr] = v[i], v_ptr++;
}
S_len[n+1] = v_ptr - lpf->v_ptr;
lpf->v_ptr = v_ptr;
/* x := g - S * f1 (new column of C) */
s_prod(lpf, x, -1.0, f);
/* y := w - R' * v1 (new row of C) */
rt_prod(lpf, y, -1.0, v);
/* z := - v1 * f1 (new diagonal element of C) */
z = 0.0;
for (i = 1; i <= m0; i++) z -= v[i] * f[i];
/* update factorization of new matrix C */
switch (scf_update_exp(lpf->scf, x, y, z))
{ case 0:
break;
case SCF_ESING:
lpf->valid = 0;
ret = LPF_ESING;
goto done;
case SCF_ELIMIT:
xassert(lpf != lpf);
default:
xassert(lpf != lpf);
}
/* expand matrix P */
P_row[m0+n+1] = P_col[m0+n+1] = m0+n+1;
/* expand matrix Q */
Q_row[m0+n+1] = Q_col[m0+n+1] = m0+n+1;
/* permute j-th and last (just added) column of matrix Q */
i = Q_col[j], ii = Q_col[m0+n+1];
Q_row[i] = m0+n+1, Q_col[m0+n+1] = i;
Q_row[ii] = j, Q_col[j] = ii;
/* increase the number of additional rows and columns */
lpf->n++;
xassert(lpf->n <= lpf->n_max);
/* the factorization has been successfully updated */
ret = 0;
done: /* return to the calling program */
return ret;
}
