void scf_add_s_col(SCF *scf, const double v[/*1+n0*/])
{ int n0 = scf->n0;
int nn = scf->nn;
SVA *sva = scf->sva;
int *sv_ind = sva->ind;
double *sv_val = sva->val;
int ss_ref = scf->ss_ref;
int *ss_ptr = &sva->ptr[ss_ref-1];
int *ss_len = &sva->len[ss_ref-1];
int i, len, ptr;
xassert(0 <= nn && nn < scf->nn_max);
/* determine length of new column */
len = 0;
for (i = 1; i <= n0; i++)
{ if (v[i] != 0.0)
len++;
}
/* reserve locations for new column in static part of SVA */
if (len > 0)
{ if (sva->r_ptr - sva->m_ptr < len)
{ sva_more_space(sva, len);
sv_ind = sva->ind;
sv_val = sva->val;
}
sva_reserve_cap(sva, ss_ref + nn, len);
}
/* store new column in sparse format */
ptr = ss_ptr[nn+1];
for (i = 1; i <= n0; i++)
{ if (v[i] != 0.0)
{ sv_ind[ptr] = i;
sv_val[ptr] = v[i];
ptr++;
}
}
xassert(ptr - ss_ptr[nn+1] == len);
ss_len[nn+1] = len;
#ifdef GLP_DEBUG
sva_check_area(sva);
#endif
return;
}
void scf_add_r_row(SCF *scf, const double w[/*1+n0*/])
{ int n0 = scf->n0;
int nn = scf->nn;
SVA *sva = scf->sva;
int *sv_ind = sva->ind;
double *sv_val = sva->val;
int rr_ref = scf->rr_ref;
int *rr_ptr = &sva->ptr[rr_ref-1];
int *rr_len = &sva->len[rr_ref-1];
int j, len, ptr;
xassert(0 <= nn && nn < scf->nn_max);
/* determine length of new row */
len = 0;
for (j = 1; j <= n0; j++)
{ if (w[j] != 0.0)
len++;
}
/* reserve locations for new row in static part of SVA */
if (len > 0)
{ if (sva->r_ptr - sva->m_ptr < len)
{ sva_more_space(sva, len);
sv_ind = sva->ind;
sv_val = sva->val;
}
sva_reserve_cap(sva, rr_ref + nn, len);
}
/* store new row in sparse format */
ptr = rr_ptr[nn+1];
for (j = 1; j <= n0; j++)
{ if (w[j] != 0.0)
{ sv_ind[ptr] = j;
sv_val[ptr] = w[j];
ptr++;
}
}
xassert(ptr - rr_ptr[nn+1] == len);
rr_len[nn+1] = len;
#ifdef GLP_DEBUG
sva_check_area(sva);
#endif
return;
}
int sgf_eliminate(SGF *sgf, int p, int q)
{ LUF *luf = sgf->luf;
int n = luf->n;
SVA *sva = luf->sva;
int *sv_ind = sva->ind;
double *sv_val = sva->val;
int fc_ref = luf->fc_ref;
int *fc_ptr = &sva->ptr[fc_ref-1];
int *fc_len = &sva->len[fc_ref-1];
int vr_ref = luf->vr_ref;
int *vr_ptr = &sva->ptr[vr_ref-1];
int *vr_len = &sva->len[vr_ref-1];
int *vr_cap = &sva->cap[vr_ref-1];
double *vr_piv = luf->vr_piv;
int vc_ref = luf->vc_ref;
int *vc_ptr = &sva->ptr[vc_ref-1];
int *vc_len = &sva->len[vc_ref-1];
int *vc_cap = &sva->cap[vc_ref-1];
int *rs_head = sgf->rs_head;
int *rs_prev = sgf->rs_prev;
int *rs_next = sgf->rs_next;
int *cs_head = sgf->cs_head;
int *cs_prev = sgf->cs_prev;
int *cs_next = sgf->cs_next;
double *vr_max = sgf->vr_max;
char *flag = sgf->flag;
double *work = sgf->work;
double eps_tol = sgf->eps_tol;
int nnz_diff = 0;
int fill, i, i_ptr, i_end, j, j_ptr, j_end, ptr, len, loc, loc1;
double vpq, fip, vij;
xassert(1 <= p && p <= n);
xassert(1 <= q && q <= n);
/* remove p-th row from the active set; this row will never
* return there */
sgf_deactivate_row(p);
/* process p-th (pivot) row */
ptr = 0;
for (i_end = (i_ptr = vr_ptr[p]) + vr_len[p];
i_ptr < i_end; i_ptr++)
{ /* get column index of v[p,j] */
j = sv_ind[i_ptr];
if (j == q)
{ /* save pointer to pivot v[p,q] */
ptr = i_ptr;
}
else
{ /* store v[p,j], j != q, to working array */
flag[j] = 1;
work[j] = sv_val[i_ptr];
}
/* remove j-th column from the active set; q-th column will
* never return there while other columns will return to the
* active set with new length */
if (cs_next[j] == j)
{ /* j-th column was marked by the pivoting routine according
* to Uwe Suhl's suggestion and is already inactive */
xassert(cs_prev[j] == j);
}
else
sgf_deactivate_col(j);
nnz_diff -= vc_len[j];
/* find and remove v[p,j] from j-th column */
for (j_end = (j_ptr = vc_ptr[j]) + vc_len[j];
sv_ind[j_ptr] != p; j_ptr++)
/* nop */;
xassert(j_ptr < j_end);
sv_ind[j_ptr] = sv_ind[j_end-1];
vc_len[j]--;
}
/* save pivot v[p,q] and remove it from p-th row */
xassert(ptr > 0);
vpq = vr_piv[p] = sv_val[ptr];
sv_ind[ptr] = sv_ind[i_end-1];
sv_val[ptr] = sv_val[i_end-1];
vr_len[p]--;
/* if it is not planned to update matrix V, relocate p-th row to
* the right (static) part of SVA */
if (!sgf->updat)
{ len = vr_len[p];
if (sva->r_ptr - sva->m_ptr < len)
{ sva_more_space(sva, len);
sv_ind = sva->ind;
sv_val = sva->val;
}
sva_make_static(sva, vr_ref-1+p);
}
/* copy the pattern (row indices) of q-th column of the active
* submatrix (from which v[p,q] has been just removed) to p-th
* column of matrix F (without unity diagonal element) */
len = vc_len[q];
if (len > 0)
{ if (sva->r_ptr - sva->m_ptr < len)
{ sva_more_space(sva, len);
sv_ind = sva->ind;
sv_val = sva->val;
}
sva_reserve_cap(sva, fc_ref-1+p, len);
memcpy(&sv_ind[fc_ptr[p]], &sv_ind[vc_ptr[q]],
len * sizeof(int));
fc_len[p] = len;
}
/* make q-th column of the active submatrix empty */
vc_len[q] = 0;
/* transform non-pivot rows of the active submatrix */
for (loc = fc_len[p]-1; loc >= 0; loc--)
{ /* get row index of v[i,q] = row index of f[i,p] */
i = sv_ind[fc_ptr[p] + loc];
xassert(i != p); /* v[p,q] was removed */
/* remove i-th row from the active set; this row will return
* there with new length */
sgf_deactivate_row(i);
/* find v[i,q] in i-th row */
for (i_end = (i_ptr = vr_ptr[i]) + vr_len[i];
sv_ind[i_ptr] != q; i_ptr++)
/* nop */;
xassert(i_ptr < i_end);
/* compute gaussian multiplier f[i,p] = v[i,q] / v[p,q] */
fip = sv_val[fc_ptr[p] + loc] = sv_val[i_ptr] / vpq;
/* remove v[i,q] from i-th row */
sv_ind[i_ptr] = sv_ind[i_end-1];
sv_val[i_ptr] = sv_val[i_end-1];
vr_len[i]--;
/* perform elementary gaussian transformation:
* (i-th row) := (i-th row) - f[i,p] * (p-th row)
* note that p-th row of V, which is in the working array,
* doesn't contain pivot v[p,q], and i-th row of V doesn't
* contain v[i,q] to be eliminated */
/* walk thru i-th row and transform existing elements */
fill = vr_len[p];
for (i_end = (i_ptr = ptr = vr_ptr[i]) + vr_len[i];
i_ptr < i_end; i_ptr++)
{ /* get column index and value of v[i,j] */
j = sv_ind[i_ptr];
vij = sv_val[i_ptr];
if (flag[j])
{ /* v[p,j] != 0 */
flag[j] = 0, fill--;
/* v[i,j] := v[i,j] - f[i,p] * v[p,j] */
vij -= fip * work[j];
if (-eps_tol < vij && vij < +eps_tol)
{ /* new v[i,j] is close to zero; remove it from the
* active submatrix, i.e. replace it by exact zero */
/* find and remove v[i,j] from j-th column */
for (j_end = (j_ptr = vc_ptr[j]) + vc_len[j];
sv_ind[j_ptr] != i; j_ptr++)
/* nop */;
xassert(j_ptr < j_end);
sv_ind[j_ptr] = sv_ind[j_end-1];
vc_len[j]--;
continue;
}
}
/* keep new v[i,j] in i-th row */
sv_ind[ptr] = j;
sv_val[ptr] = vij;
ptr++;
}
/* (new length of i-th row may decrease because of numerical
* cancellation) */
vr_len[i] = len = ptr - vr_ptr[i];
/* now flag[*] is the pattern of the set v[p,*] \ v[i,*], and
* fill is the number of non-zeros in this set */
if (fill == 0)
{ /* no fill-in occurs */
/* walk thru p-th row and restore the column flags */
for (i_end = (i_ptr = vr_ptr[p]) + vr_len[p];
i_ptr < i_end; i_ptr++)
flag[sv_ind[i_ptr]] = 1; /* v[p,j] != 0 */
goto skip;
}
/* up to fill new non-zero elements may appear in i-th row due
* to fill-in; reserve locations for these elements (note that
* actual length of i-th row is currently stored in len) */
if (vr_cap[i] < len + fill)
{ if (sva->r_ptr - sva->m_ptr < len + fill)
{ sva_more_space(sva, len + fill);
sv_ind = sva->ind;
sv_val = sva->val;
}
sva_enlarge_cap(sva, vr_ref-1+i, len + fill, 0);
}
vr_len[i] += fill;
/* walk thru p-th row and add new elements to i-th row */
for (loc1 = vr_len[p]-1; loc1 >= 0; loc1--)
{ /* get column index of v[p,j] */
j = sv_ind[vr_ptr[p] + loc1];
if (!flag[j])
{ /* restore j-th column flag */
flag[j] = 1;
/* v[i,j] was computed earlier on transforming existing
* elements of i-th row */
continue;
}
/* v[i,j] := 0 - f[i,p] * v[p,j] */
vij = - fip * work[j];
if (-eps_tol < vij && vij < +eps_tol)
{ /* new v[i,j] is close to zero; do not add it to the
* active submatrix, i.e. replace it by exact zero */
continue;
}
/* add new v[i,j] to i-th row */
sv_ind[ptr = vr_ptr[i] + (len++)] = j;
sv_val[ptr] = vij;
/* add new v[i,j] to j-th column */
if (vc_cap[j] == vc_len[j])
{ /* we reserve extra locations in j-th column to reduce
* further relocations of that column */
#if 1 /* FIXME */
/* use control parameter to specify the number of extra
* locations reserved */
int need = vc_len[j] + 10;
#endif
if (sva->r_ptr - sva->m_ptr < need)
{ sva_more_space(sva, need);
sv_ind = sva->ind;
sv_val = sva->val;
}
sva_enlarge_cap(sva, vc_ref-1+j, need, 1);
}
sv_ind[vc_ptr[j] + (vc_len[j]++)] = i;
}
/* set final length of i-th row just transformed */
xassert(len <= vr_len[i]);
vr_len[i] = len;
skip: /* return i-th row to the active set with new length */
sgf_activate_row(i);
/* since i-th row has been changed, largest magnitude of its
* elements becomes unknown */
vr_max[i] = -1.0;
}
/* walk thru p-th (pivot) row */
for (i_end = (i_ptr = vr_ptr[p]) + vr_len[p];
i_ptr < i_end; i_ptr++)
{ /* get column index of v[p,j] */
j = sv_ind[i_ptr];
xassert(j != q); /* v[p,q] was removed */
/* return j-th column to the active set with new length */
if (cs_next[j] == j && vc_len[j] != 1)
{ /* j-th column was marked by the pivoting routine and it is
* still not a column singleton, so leave it incative */
xassert(cs_prev[j] == j);
}
else
sgf_activate_col(j);
nnz_diff += vc_len[j];
/* restore zero content of the working arrays */
flag[j] = 0;
work[j] = 0.0;
}
/* return the difference between the numbers of non-zeros in the
* active submatrix on entry and on exit, resp. */
return nnz_diff;
}
int fhv_ft_update(FHV *fhv, int q, int aq_len, const int aq_ind[],
const double aq_val[], int ind[/*1+n*/], double val[/*1+n*/],
double work[/*1+n*/])
{ LUF *luf = fhv->luf;
int n = luf->n;
SVA *sva = luf->sva;
int *sv_ind = sva->ind;
double *sv_val = sva->val;
int vr_ref = luf->vr_ref;
int *vr_ptr = &sva->ptr[vr_ref-1];
int *vr_len = &sva->len[vr_ref-1];
int *vr_cap = &sva->cap[vr_ref-1];
double *vr_piv = luf->vr_piv;
int vc_ref = luf->vc_ref;
int *vc_ptr = &sva->ptr[vc_ref-1];
int *vc_len = &sva->len[vc_ref-1];
int *vc_cap = &sva->cap[vc_ref-1];
int *pp_ind = luf->pp_ind;
int *pp_inv = luf->pp_inv;
int *qq_ind = luf->qq_ind;
int *qq_inv = luf->qq_inv;
int *hh_ind = fhv->hh_ind;
int hh_ref = fhv->hh_ref;
int *hh_ptr = &sva->ptr[hh_ref-1];
int *hh_len = &sva->len[hh_ref-1];
#if 1 /* FIXME */
const double eps_tol = DBL_EPSILON;
const double vpq_tol = 1e-5;
const double err_tol = 1e-10;
#endif
int end, i, i_end, i_ptr, j, j_end, j_ptr, k, len, nnz, p, p_end,
p_ptr, ptr, q_end, q_ptr, s, t;
double f, vpq, temp;
/*--------------------------------------------------------------*/
/* replace current q-th column of matrix V by new one */
/*--------------------------------------------------------------*/
xassert(1 <= q && q <= n);
/* convert new q-th column of matrix A to dense format */
for (i = 1; i <= n; i++)
val[i] = 0.0;
xassert(0 <= aq_len && aq_len <= n);
for (k = 1; k <= aq_len; k++)
{ i = aq_ind[k];
xassert(1 <= i && i <= n);
xassert(val[i] == 0.0);
xassert(aq_val[k] != 0.0);
val[i] = aq_val[k];
}
/* compute new q-th column of matrix V:
* new V[q] = inv(F * H) * (new A[q]) */
luf->pp_ind = fhv->p0_ind;
luf->pp_inv = fhv->p0_inv;
luf_f_solve(luf, val);
luf->pp_ind = pp_ind;
luf->pp_inv = pp_inv;
fhv_h_solve(fhv, val);
/* q-th column of V = s-th column of U */
s = qq_inv[q];
/* determine row number of element v[p,q] that corresponds to
* diagonal element u[s,s] */
p = pp_inv[s];
/* convert new q-th column of V to sparse format;
* element v[p,q] = u[s,s] is not included in the element list
* and stored separately */
vpq = 0.0;
len = 0;
for (i = 1; i <= n; i++)
{ temp = val[i];
#if 1 /* FIXME */
if (-eps_tol < temp && temp < +eps_tol)
#endif
/* nop */;
else if (i == p)
vpq = temp;
else
{ ind[++len] = i;
val[len] = temp;
}
}
/* clear q-th column of matrix V */
for (q_end = (q_ptr = vc_ptr[q]) + vc_len[q];
q_ptr < q_end; q_ptr++)
{ /* get row index of v[i,q] */
i = sv_ind[q_ptr];
/* find and remove v[i,q] from i-th row */
for (i_end = (i_ptr = vr_ptr[i]) + vr_len[i];
sv_ind[i_ptr] != q; i_ptr++)
/* nop */;
xassert(i_ptr < i_end);
sv_ind[i_ptr] = sv_ind[i_end-1];
sv_val[i_ptr] = sv_val[i_end-1];
vr_len[i]--;
}
/* now q-th column of matrix V is empty */
vc_len[q] = 0;
/* put new q-th column of V (except element v[p,q] = u[s,s]) in
* column-wise format */
if (len > 0)
{ if (vc_cap[q] < len)
{ if (sva->r_ptr - sva->m_ptr < len)
{ sva_more_space(sva, len);
sv_ind = sva->ind;
sv_val = sva->val;
}
sva_enlarge_cap(sva, vc_ref-1+q, len, 0);
}
ptr = vc_ptr[q];
memcpy(&sv_ind[ptr], &ind[1], len * sizeof(int));
memcpy(&sv_val[ptr], &val[1], len * sizeof(double));
vc_len[q] = len;
}
/* put new q-th column of V (except element v[p,q] = u[s,s]) in
* row-wise format, and determine largest row number t such that
* u[s,t] != 0 */
t = (vpq == 0.0 ? 0 : s);
for (k = 1; k <= len; k++)
{ /* get row index of v[i,q] */
i = ind[k];
/* put v[i,q] to i-th row */
if (vr_cap[i] == vr_len[i])
{ /* reserve extra locations in i-th row to reduce further
* relocations of that row */
#if 1 /* FIXME */
int need = vr_len[i] + 5;
#endif
if (sva->r_ptr - sva->m_ptr < need)
{ sva_more_space(sva, need);
sv_ind = sva->ind;
sv_val = sva->val;
}
sva_enlarge_cap(sva, vr_ref-1+i, need, 0);
}
sv_ind[ptr = vr_ptr[i] + (vr_len[i]++)] = q;
sv_val[ptr] = val[k];
/* v[i,q] is non-zero; increase t */
if (t < pp_ind[i])
t = pp_ind[i];
}
/*--------------------------------------------------------------*/
/* check if matrix U is already upper triangular */
/*--------------------------------------------------------------*/
/* check if there is a spike in s-th column of matrix U, which
* is q-th column of matrix V */
if (s >= t)
{ /* no spike; matrix U is already upper triangular */
/* store its diagonal element u[s,s] = v[p,q] */
vr_piv[p] = vpq;
if (s > t)
{ /* matrix U is structurally singular, because its diagonal
* element u[s,s] = v[p,q] is exact zero */
xassert(vpq == 0.0);
return 1;
}
#if 1 /* FIXME */
else if (-vpq_tol < vpq && vpq < +vpq_tol)
#endif
{ /* matrix U is not well conditioned, because its diagonal
* element u[s,s] = v[p,q] is too small in magnitude */
return 2;
}
else
{ /* normal case */
return 0;
}
}
/*--------------------------------------------------------------*/
/* perform implicit symmetric permutations of rows and columns */
/* of matrix U */
/*--------------------------------------------------------------*/
/* currently v[p,q] = u[s,s] */
xassert(p == pp_inv[s] && q == qq_ind[s]);
for (k = s; k < t; k++)
{ pp_ind[pp_inv[k] = pp_inv[k+1]] = k;
qq_inv[qq_ind[k] = qq_ind[k+1]] = k;
}
/* now v[p,q] = u[t,t] */
pp_ind[pp_inv[t] = p] = qq_inv[qq_ind[t] = q] = t;
/*--------------------------------------------------------------*/
/* check if matrix U is already upper triangular */
/*--------------------------------------------------------------*/
/* check if there is a spike in t-th row of matrix U, which is
* p-th row of matrix V */
for (p_end = (p_ptr = vr_ptr[p]) + vr_len[p];
p_ptr < p_end; p_ptr++)
{ if (qq_inv[sv_ind[p_ptr]] < t)
break; /* spike detected */
}
if (p_ptr == p_end)
{ /* no spike; matrix U is already upper triangular */
/* store its diagonal element u[t,t] = v[p,q] */
vr_piv[p] = vpq;
#if 1 /* FIXME */
if (-vpq_tol < vpq && vpq < +vpq_tol)
#endif
{ /* matrix U is not well conditioned, because its diagonal
* element u[t,t] = v[p,q] is too small in magnitude */
return 2;
}
else
{ /* normal case */
return 0;
}
}
/*--------------------------------------------------------------*/
/* copy p-th row of matrix V, which is t-th row of matrix U, to */
/* working array */
/*--------------------------------------------------------------*/
/* copy p-th row of matrix V, including element v[p,q] = u[t,t],
* to the working array in dense format and remove these elements
* from matrix V; since no pivoting is used, only this row will
* change during elimination */
for (j = 1; j <= n; j++)
work[j] = 0.0;
work[q] = vpq;
for (p_end = (p_ptr = vr_ptr[p]) + vr_len[p];
p_ptr < p_end; p_ptr++)
{ /* get column index of v[p,j] and store this element to the
* working array */
work[j = sv_ind[p_ptr]] = sv_val[p_ptr];
/* find and remove v[p,j] from j-th column */
for (j_end = (j_ptr = vc_ptr[j]) + vc_len[j];
sv_ind[j_ptr] != p; j_ptr++)
/* nop */;
xassert(j_ptr < j_end);
sv_ind[j_ptr] = sv_ind[j_end-1];
sv_val[j_ptr] = sv_val[j_end-1];
vc_len[j]--;
}
/* now p-th row of matrix V is temporarily empty */
vr_len[p] = 0;
/*--------------------------------------------------------------*/
/* perform gaussian elimination */
/*--------------------------------------------------------------*/
/* transform p-th row of matrix V stored in working array, which
* is t-th row of matrix U, to eliminate subdiagonal elements
* u[t,s], ..., u[t,t-1]; corresponding gaussian multipliers will
* form non-trivial row of new row-like factor */
nnz = 0; /* number of non-zero gaussian multipliers */
for (k = s; k < t; k++)
{ /* diagonal element u[k,k] = v[i,j] is used as pivot */
i = pp_inv[k], j = qq_ind[k];
/* take subdiagonal element u[t,k] = v[p,j] */
temp = work[j];
#if 1 /* FIXME */
if (-eps_tol < temp && temp < +eps_tol)
continue;
#endif
/* compute and save gaussian multiplier:
* f := u[t,k] / u[k,k] = v[p,j] / v[i,j] */
ind[++nnz] = i;
val[nnz] = f = work[j] / vr_piv[i];
/* gaussian transformation to eliminate u[t,k] = v[p,j]:
* (p-th row of V) := (p-th row of V) - f * (i-th row of V) */
for (i_end = (i_ptr = vr_ptr[i]) + vr_len[i];
i_ptr < i_end; i_ptr++)
work[sv_ind[i_ptr]] -= f * sv_val[i_ptr];
}
/* now matrix U is again upper triangular */
#if 1 /* FIXME */
if (-vpq_tol < work[q] && work[q] < +vpq_tol)
#endif
{ /* however, its new diagonal element u[t,t] = v[p,q] is too
* small in magnitude */
return 3;
}
/*--------------------------------------------------------------*/
/* create new row-like factor H[k] and add to eta file H */
/*--------------------------------------------------------------*/
/* (nnz = 0 means that all subdiagonal elements were too small
* in magnitude) */
if (nnz > 0)
{ if (fhv->nfs == fhv->nfs_max)
{ /* maximal number of row-like factors has been reached */
return 4;
}
k = ++(fhv->nfs);
hh_ind[k] = p;
/* store non-trivial row of H[k] in right (dynamic) part of
* SVA (diagonal unity element is not stored) */
if (sva->r_ptr - sva->m_ptr < nnz)
{ sva_more_space(sva, nnz);
sv_ind = sva->ind;
sv_val = sva->val;
}
sva_reserve_cap(sva, fhv->hh_ref-1+k, nnz);
ptr = hh_ptr[k];
memcpy(&sv_ind[ptr], &ind[1], nnz * sizeof(int));
memcpy(&sv_val[ptr], &val[1], nnz * sizeof(double));
hh_len[k] = nnz;
}
/*--------------------------------------------------------------*/
/* copy transformed p-th row of matrix V, which is t-th row of */
/* matrix U, from working array back to matrix V */
/*--------------------------------------------------------------*/
/* copy elements of transformed p-th row of matrix V, which are
* non-diagonal elements u[t,t+1], ..., u[t,n] of matrix U, from
* working array to corresponding columns of matrix V (note that
* diagonal element u[t,t] = v[p,q] not copied); also transform
* p-th row of matrix V to sparse format */
len = 0;
for (k = t+1; k <= n; k++)
{ /* j-th column of V = k-th column of U */
j = qq_ind[k];
/* take non-diagonal element v[p,j] = u[t,k] */
temp = work[j];
#if 1 /* FIXME */
if (-eps_tol < temp && temp < +eps_tol)
continue;
#endif
/* add v[p,j] to j-th column of matrix V */
if (vc_cap[j] == vc_len[j])
{ /* reserve extra locations in j-th column to reduce further
* relocations of that column */
#if 1 /* FIXME */
int need = vc_len[j] + 5;
#endif
if (sva->r_ptr - sva->m_ptr < need)
{ sva_more_space(sva, need);
sv_ind = sva->ind;
sv_val = sva->val;
}
sva_enlarge_cap(sva, vc_ref-1+j, need, 0);
}
sv_ind[ptr = vc_ptr[j] + (vc_len[j]++)] = p;
sv_val[ptr] = temp;
/* store element v[p,j] = u[t,k] to working sparse vector */
ind[++len] = j;
val[len] = temp;
}
/* copy elements from working sparse vector to p-th row of matrix
* V (this row is currently empty) */
if (vr_cap[p] < len)
{ if (sva->r_ptr - sva->m_ptr < len)
{ sva_more_space(sva, len);
sv_ind = sva->ind;
sv_val = sva->val;
}
sva_enlarge_cap(sva, vr_ref-1+p, len, 0);
}
ptr = vr_ptr[p];
memcpy(&sv_ind[ptr], &ind[1], len * sizeof(int));
memcpy(&sv_val[ptr], &val[1], len * sizeof(double));
vr_len[p] = len;
/* store new diagonal element u[t,t] = v[p,q] */
vr_piv[p] = work[q];
/*--------------------------------------------------------------*/
/* perform accuracy test (only if new H[k] was added) */
/*--------------------------------------------------------------*/
if (nnz > 0)
{ /* copy p-th (non-trivial) row of row-like factor H[k] (except
* unity diagonal element) to working array in dense format */
for (j = 1; j <= n; j++)
work[j] = 0.0;
k = fhv->nfs;
for (end = (ptr = hh_ptr[k]) + hh_len[k]; ptr < end; ptr++)
work[sv_ind[ptr]] = sv_val[ptr];
/* compute inner product of p-th (non-trivial) row of matrix
* H[k] and q-th column of matrix V */
temp = vr_piv[p]; /* 1 * v[p,q] */
ptr = vc_ptr[q];
end = ptr + vc_len[q];
for (; ptr < end; ptr++)
temp += work[sv_ind[ptr]] * sv_val[ptr];
/* inner product should be equal to element v[p,q] *before*
* matrix V was transformed */
/* compute relative error */
temp = fabs(vpq - temp) / (1.0 + fabs(vpq));
#if 1 /* FIXME */
if (temp > err_tol)
#endif
{ /* relative error is too large */
return 5;
}
}
/* factorization has been successfully updated */
return 0;
}
