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; }