static void check_error(SCF *scf, const char *func) { int n = scf->n; double *f = scf->f; double *u = scf->u; int *p = scf->p; double *c = scf->c; int i, j, k; double d, dmax = 0.0, s, t; xassert(c != NULL); for (i = 1; i <= n; i++) { for (j = 1; j <= n; j++) { /* compute element (i,j) of product F * C */ s = 0.0; for (k = 1; k <= n; k++) s += f[f_loc(scf, i, k)] * c[f_loc(scf, k, j)]; /* compute element (i,j) of product U * P */ k = p[j]; t = (i <= k ? u[u_loc(scf, i, k)] : 0.0); /* compute the maximal relative error */ d = fabs(s - t) / (1.0 + fabs(t)); if (dmax < d) dmax = d; } } if (dmax > 1e-8) xprintf("%s: dmax = %g; relative error too large\n", func, dmax); return; }
static void bg_transform(SCF *scf, int k, double un[]) { int n = scf->n; double *f = scf->f; double *u = scf->u; int j, k1, kj, kk, n1, nj; double t; xassert(1 <= k && k <= n); /* main elimination loop */ for (k = k; k < n; k++) { /* determine location of U[k,k] */ kk = u_loc(scf, k, k); /* determine location of F[k,1] */ k1 = f_loc(scf, k, 1); /* determine location of F[n,1] */ n1 = f_loc(scf, n, 1); /* if |U[k,k]| < |U[n,k]|, interchange k-th and n-th rows to provide |U[k,k]| >= |U[n,k]| */ if (fabs(u[kk]) < fabs(un[k])) { /* interchange k-th and n-th rows of matrix U */ for (j = k, kj = kk; j <= n; j++, kj++) t = u[kj], u[kj] = un[j], un[j] = t; /* interchange k-th and n-th rows of matrix F to keep the main equality F * C = U * P */ for (j = 1, kj = k1, nj = n1; j <= n; j++, kj++, nj++) t = f[kj], f[kj] = f[nj], f[nj] = t; } /* now |U[k,k]| >= |U[n,k]| */ /* if U[k,k] is too small in the magnitude, replace U[k,k] and U[n,k] by exact zero */ if (fabs(u[kk]) < eps) u[kk] = un[k] = 0.0; /* if U[n,k] is already zero, elimination is not needed */ if (un[k] == 0.0) continue; /* compute gaussian multiplier t = U[n,k] / U[k,k] */ t = un[k] / u[kk]; /* apply gaussian elimination to nullify U[n,k] */ /* (n-th row of U) := (n-th row of U) - t * (k-th row of U) */ for (j = k+1, kj = kk+1; j <= n; j++, kj++) un[j] -= t * u[kj]; /* (n-th row of F) := (n-th row of F) - t * (k-th row of F) to keep the main equality F * C = U * P */ for (j = 1, kj = k1, nj = n1; j <= n; j++, kj++, nj++) f[nj] -= t * f[kj]; } /* if U[n,n] is too small in the magnitude, replace it by exact zero */ if (fabs(un[n]) < eps) un[n] = 0.0; /* store U[n,n] in a proper location */ u[u_loc(scf, n, n)] = un[n]; return; }
void VectorFEBoundaryTangentLFIntegrator::AssembleRHSElementVect( const FiniteElement &el, ElementTransformation &Tr, Vector &elvect) { int dof = el.GetDof(); DenseMatrix vshape(dof, 2); Vector f_loc(3); Vector f_hat(2); elvect.SetSize(dof); elvect = 0.0; const IntegrationRule *ir = IntRule; if (ir == NULL) { int intorder = 2*el.GetOrder(); // <---------- ir = &IntRules.Get(el.GetGeomType(), intorder); } for (int i = 0; i < ir->GetNPoints(); i++) { const IntegrationPoint &ip = ir->IntPoint(i); Tr.SetIntPoint(&ip); f.Eval(f_loc, Tr, ip); Tr.Jacobian().MultTranspose(f_loc, f_hat); el.CalcVShape(ip, vshape); Swap<double>(f_hat(0), f_hat(1)); f_hat(0) = -f_hat(0); f_hat *= ip.weight; vshape.AddMult(f_hat, elvect); } }
static void tsolve(SCF *scf, double x[]) { int n = scf->n; double *f = scf->f; double *u = scf->u; int *p = scf->p; double *y = scf->w; int i, j, ij; double t; /* y := P * b */ for (i = 1; i <= n; i++) y[i] = x[p[i]]; /* y := inv(U') * y */ for (i = 1; i <= n; i++) { /* compute y[i] */ ij = u_loc(scf, i, i); t = (y[i] /= u[ij]); /* substitute y[i] in other equations */ for (j = i+1, ij++; j <= n; j++, ij++) y[j] -= u[ij] * t; } /* x := F' * y (computed as linear combination of rows of F) */ for (j = 1; j <= n; j++) x[j] = 0.0; for (i = 1; i <= n; i++) { t = y[i]; /* coefficient of linear combination */ for (j = 1, ij = f_loc(scf, i, 1); j <= n; j++, ij++) x[j] += f[ij] * t; } return; }
static void solve(SCF *scf, double x[]) { int n = scf->n; double *f = scf->f; double *u = scf->u; int *p = scf->p; double *y = scf->w; int i, j, ij; double t; /* y := F * b */ for (i = 1; i <= n; i++) { /* y[i] = (i-th row of F) * b */ t = 0.0; for (j = 1, ij = f_loc(scf, i, 1); j <= n; j++, ij++) t += f[ij] * x[j]; y[i] = t; } /* y := inv(U) * y */ for (i = n; i >= 1; i--) { t = y[i]; for (j = n, ij = u_loc(scf, i, n); j > i; j--, ij--) t -= u[ij] * y[j]; y[i] = t / u[ij]; } /* x := P' * y */ for (i = 1; i <= n; i++) x[p[i]] = y[i]; return; }
static void gr_transform(SCF *scf, int k, double un[]) { int n = scf->n; double *f = scf->f; double *u = scf->u; int j, k1, kj, kk, n1, nj; double c, s; xassert(1 <= k && k <= n); /* main elimination loop */ for (k = k; k < n; k++) { /* determine location of U[k,k] */ kk = u_loc(scf, k, k); /* determine location of F[k,1] */ k1 = f_loc(scf, k, 1); /* determine location of F[n,1] */ n1 = f_loc(scf, n, 1); /* if both U[k,k] and U[n,k] are too small in the magnitude, replace them by exact zero */ if (fabs(u[kk]) < eps && fabs(un[k]) < eps) u[kk] = un[k] = 0.0; /* if U[n,k] is already zero, elimination is not needed */ if (un[k] == 0.0) continue; /* compute the parameters of Givens plane rotation */ givens(u[kk], un[k], &c, &s); /* apply Givens rotation to k-th and n-th rows of matrix U */ for (j = k, kj = kk; j <= n; j++, kj++) { double ukj = u[kj], unj = un[j]; u[kj] = c * ukj - s * unj; un[j] = s * ukj + c * unj; } /* apply Givens rotation to k-th and n-th rows of matrix F to keep the main equality F * C = U * P */ for (j = 1, kj = k1, nj = n1; j <= n; j++, kj++, nj++) { double fkj = f[kj], fnj = f[nj]; f[kj] = c * fkj - s * fnj; f[nj] = s * fkj + c * fnj; } } /* if U[n,n] is too small in the magnitude, replace it by exact zero */ if (fabs(un[n]) < eps) un[n] = 0.0; /* store U[n,n] in a proper location */ u[u_loc(scf, n, n)] = un[n]; return; }
int scf_update_exp(SCF *scf, const double x[], const double y[], double z) { int n_max = scf->n_max; int n = scf->n; double *f = scf->f; double *u = scf->u; int *p = scf->p; #if _GLPSCF_DEBUG double *c = scf->c; #endif double *un = scf->w; int i, ij, in, j, k, nj, ret = 0; double t; /* check if the factorization can be expanded */ if (n == n_max) { /* there is not enough room */ ret = SCF_ELIMIT; goto done; } /* increase the order of the factorization */ scf->n = ++n; /* fill new zero column of matrix F */ for (i = 1, in = f_loc(scf, i, n); i < n; i++, in += n_max) f[in] = 0.0; /* fill new zero row of matrix F */ for (j = 1, nj = f_loc(scf, n, j); j < n; j++, nj++) f[nj] = 0.0; /* fill new unity diagonal element of matrix F */ f[f_loc(scf, n, n)] = 1.0; /* compute new column of matrix U, which is (old F) * x */ for (i = 1; i < n; i++) { /* u[i,n] := (i-th row of old F) * x */ t = 0.0; for (j = 1, ij = f_loc(scf, i, 1); j < n; j++, ij++) t += f[ij] * x[j]; u[u_loc(scf, i, n)] = t; } /* compute new (spiked) row of matrix U, which is (old P) * y */ for (j = 1; j < n; j++) un[j] = y[p[j]]; /* store new diagonal element of matrix U, which is z */ un[n] = z; /* expand matrix P */ p[n] = n; #if _GLPSCF_DEBUG /* expand matrix C */ /* fill its new column, which is x */ for (i = 1, in = f_loc(scf, i, n); i < n; i++, in += n_max) c[in] = x[i]; /* fill its new row, which is y */ for (j = 1, nj = f_loc(scf, n, j); j < n; j++, nj++) c[nj] = y[j]; /* fill its new diagonal element, which is z */ c[f_loc(scf, n, n)] = z; #endif /* restore upper triangular structure of matrix U */ for (k = 1; k < n; k++) if (un[k] != 0.0) break; transform(scf, k, un); /* estimate the rank of matrices C and U */ scf->rank = estimate_rank(scf); if (scf->rank != n) ret = SCF_ESING; #if _GLPSCF_DEBUG /* check that the factorization is accurate enough */ check_error(scf, "scf_update_exp"); #endif done: return ret; }