void lpf_ftran(LPF *lpf, double x[]) { int m0 = lpf->m0; int m = lpf->m; int n = lpf->n; int *P_col = lpf->P_col; int *Q_col = lpf->Q_col; 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_ftran: 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) := inv(P) * (b 0) */ for (i = 1; i <= m0 + n; i++) fg[i] = ((ii = P_col[i]) <= m ? x[ii] : 0.0); /* f1 := inv(L0) * f */ #if 0 /* 06/VI-2013 */ luf_f_solve(lpf->luf, 0, f); #else luf_f_solve(lpf->lufint->luf, f); #endif /* g1 := g - S * f1 */ s_prod(lpf, g, -1.0, f); /* g2 := inv(C) * g1 */ scf_solve_it(lpf->scf, 0, g); /* f2 := inv(U0) * (f1 - R * g2) */ r_prod(lpf, f, -1.0, g); #if 0 /* 06/VI-2013 */ luf_v_solve(lpf->luf, 0, f); #else { double *work = lpf->lufint->sgf->work; luf_v_solve(lpf->lufint->luf, f, work); memcpy(&f[1], &work[1], m0 * sizeof(double)); } #endif /* (x y) := inv(Q) * (f2 g2) */ for (i = 1; i <= m; i++) x[i] = fg[Q_col[i]]; #if GLPLPF_DEBUG /* check relative error in solution */ check_error(lpf, 0, x, b); xfree(b); #endif return; }
void inv_ftran(INV *inv, double x[], int save) { int m = inv->m; int *pp_row = inv->luf->pp_row; int *pp_col = inv->luf->pp_col; double eps_tol = inv->luf->eps_tol; int *p0_row = inv->p0_row; int *p0_col = inv->p0_col; int *cc_ndx = inv->cc_ndx; double *cc_val = inv->cc_val; int i, len; double temp; if (!inv->valid) fault("inv_ftran: the factorization is not valid"); /* B = F*H*V, therefore inv(B) = inv(V)*inv(H)*inv(F) */ inv->luf->pp_row = p0_row; inv->luf->pp_col = p0_col; luf_f_solve(inv->luf, 0, x); inv->luf->pp_row = pp_row; inv->luf->pp_col = pp_col; inv_h_solve(inv, 0, x); /* save partially transformed column (if required) */ if (save) { len = 0; for (i = 1; i <= m; i++) { temp = x[i]; if (temp == 0.0 || fabs(temp) < eps_tol) continue; len++; cc_ndx[len] = i; cc_val[len] = temp; } inv->cc_len = len; } luf_v_solve(inv->luf, 0, x); return; }
void inv_btran(INV *inv, double x[]) { int *pp_row = inv->luf->pp_row; int *pp_col = inv->luf->pp_col; int *p0_row = inv->p0_row; int *p0_col = inv->p0_col; /* B = F*H*V, therefore inv(B') = inv(F')*inv(H')*inv(V') */ if (!inv->valid) fault("inv_btran: the factorization is not valid"); luf_v_solve(inv->luf, 1, x); inv_h_solve(inv, 1, x); inv->luf->pp_row = p0_row; inv->luf->pp_col = p0_col; luf_f_solve(inv->luf, 1, x); inv->luf->pp_row = pp_row; inv->luf->pp_col = pp_col; return; }
void fhv_btran(FHV *fhv, double x[]) { int *pp_row = fhv->luf->pp_row; int *pp_col = fhv->luf->pp_col; int *p0_row = fhv->p0_row; int *p0_col = fhv->p0_col; if (!fhv->valid) xfault("fhv_btran: the factorization is not valid\n"); /* B = F*H*V, therefore inv(B') = inv(F')*inv(H')*inv(V') */ luf_v_solve(fhv->luf, 1, x); fhv_h_solve(fhv, 1, x); fhv->luf->pp_row = p0_row; fhv->luf->pp_col = p0_col; luf_f_solve(fhv->luf, 1, x); fhv->luf->pp_row = pp_row; fhv->luf->pp_col = pp_col; return; }
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 */ luf_v_solve(lpf->luf, 1, f); /* 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); luf_f_solve(lpf->luf, 1, f); /* (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; }