/* Calculate matrices needed for stability analysis
* and solve for spectrum is required.
*
* Modified by Ian Gates Sep 26, 1997.
*
* Modified by MMH 1/15/00. Hacked out store_stability_problem.
*
* Modified by MMH 11/28/00. Changed the call list so we could pass
* x_dot, x_old, etc., to matrix_fill. Some of the call list probably
* isn't making any difference but I'd rather err on the cautious
* side...
*
* Modified by MMH 12/18/00. 3D stability of 2D flow begins! Broke
* the (single) function into multiple parts because it was getting
* too fat...
*/
int
solve_stability_problem(struct Aztec_Linear_Solver_System *ams,
double x[], /* Value of the solution vector */
double delta_t, /* Time step size */
double theta, /* Variable time integration parameter
explicit (theta = 1) to
implicit (theta = 0) */
double resid_vector[],
double x_old[], /* Value of the old solution vector */
double x_older[], /* */
double xdot[], /* Value of xdot predicted for new
solution */
double xdot_old[], /* */
double x_update[], /* */
int *converged, /* Whether the Newton has converged */
int *nprint, /* Counter for time step number */
int tnv, /* Number of nodal results */
int tnv_post, /* Number of post processing results */
struct Results_Description *rd,
int *gindex,
int *p_gsize,
double *gvec,
double time_value,
Exo_DB *exo, /* Ptr to finite element mesh db */
Dpi *dpi) /* Ptr to distributed processing info */
{
int res;
fprintf(stderr, "\nWARNING: Linear Stability Analysis is not (and cannot be) compatible\n");
fprintf(stderr, " with all user-supplied boundary conditions (i.e., BC cards with\n");
fprintf(stderr, " the term USER in them). If you are using some, and you want LSA,\n");
fprintf(stderr, " then you must modify your boundary conditions accordingly.\n\n");
/* MMH:
* Here's the trick! x_old was not the same as x when it came time
* to do transient calculations. So things were off by a small
* amount (a few nodes with < 1% difference, say). But this small
* difference caused large errors in the eigenvalues (10%). I fixed
* this 11/28/00. */
dcopy1(NumUnknowns,x,x_old);
dcopy1(NumUnknowns,x,x_older);
if(!(Linear_Stability == LSA_3D_OF_2D || Linear_Stability == LSA_3D_OF_2D_SAVE))
res = solve_full_stability_problem(ams, x, delta_t, theta, resid_vector,
x_old, x_older, xdot, xdot_old,
x_update, converged, nprint, tnv,
tnv_post, rd, gindex, p_gsize, gvec,
time_value, exo, dpi);
else
res = solve_3D_of_2D_stability_problem(ams, x, delta_t, theta,
resid_vector, x_old, x_older,
xdot, xdot_old, x_update,
converged, nprint, tnv, tnv_post,
rd, gindex, p_gsize, gvec,
time_value, exo, dpi);
return(res);
}/* END of routine solve_stability_problem */
/*
* Initialize the preconditioner
*/
static int initPreconditioner(double diagb[], double emat[], int n,
logical lreset, double yksk, double yrsr,
double sk[], double yk[], double sr[], double yr[],
logical upd1)
{
double srds, yrsk, td, sds;
int i;
double *bsk;
if (upd1)
{
dcopy1(n, diagb, emat);
return 0;
}
bsk = malloc(sizeof(*bsk)*n);
if (bsk == NULL) return -1;
if (lreset)
{
for (i = 0; i < n; i++) bsk[i] = diagb[i] * sk[i];
sds = ddot1(n, sk, bsk);
if (yksk == 0.0) yksk = 1.0;
if (sds == 0.0) sds = 1.0;
for (i = 0; i < n; i++)
{
td = diagb[i];
emat[i] = td - td * td * sk[i] * sk[i] / sds + yk[i] * yk[i] / yksk;
}
}
else
{
for (i = 0; i < n; i++) bsk[i] = diagb[i] * sr[i];
sds = ddot1(n, sr, bsk);
srds = ddot1(n, sk, bsk);
yrsk = ddot1(n, yr, sk);
if (yrsr == 0.0) yrsr = 1.0;
if (sds == 0.0) sds = 1.0;
for (i = 0; i < n; i++)
{
td = diagb[i];
bsk[i] = td * sk[i] - bsk[i] * srds / sds + yr[i] * yrsk / yrsr;
emat[i] = td - td * td * sr[i] * sr[i] / sds + yr[i] * yr[i] / yrsr;
}
sds = ddot1(n, sk, bsk);
if (yksk == 0.0) yksk = 1.0;
if (sds == 0.0) sds = 1.0;
for (i = 0; i < n; i++)
emat[i] = emat[i] - bsk[i] * bsk[i] / sds + yk[i] * yk[i] / yksk;
}
free(bsk);
return 0;
}
/*
* This routine is a bounds-constrained truncated-newton method.
* the truncated-newton method is preconditioned by a limited-memory
* quasi-newton method (this preconditioning strategy is developed
* in this routine) with a further diagonal scaling
* (see routine diagonalscaling).
*/
static tnc_rc tnc_minimize(int n, double x[],
double *f, double gfull[], tnc_function *function, void *state,
double xscale[], double xoffset[], double *fscale,
double low[], double up[], tnc_message messages,
int maxCGit, int maxnfeval, int *nfeval, int *niter, double eta, double
stepmx, double accuracy, double fmin, double ftol, double xtol, double
pgtol, double rescale, tnc_callback *callback)
{
double fLastReset, difnew, epsmch, epsred, oldgtp,
difold, oldf, xnorm, newscale,
gnorm, ustpmax, fLastConstraint, spe, yrsr, yksk,
*temp = NULL, *sk = NULL, *yk = NULL, *diagb = NULL, *sr = NULL,
*yr = NULL, *oldg = NULL, *pk = NULL, *g = NULL;
double alpha = 0.0; /* Default unused value */
int i, icycle, oldnfeval, *pivot = NULL, frc;
logical lreset, newcon, upd1, remcon;
tnc_rc rc = TNC_ENOMEM; /* Default error */
*niter = 0;
/* Allocate temporary vectors */
oldg = malloc(sizeof(*oldg)*n);
if (oldg == NULL) goto cleanup;
g = malloc(sizeof(*g)*n);
if (g == NULL) goto cleanup;
temp = malloc(sizeof(*temp)*n);
if (temp == NULL) goto cleanup;
diagb = malloc(sizeof(*diagb)*n);
if (diagb == NULL) goto cleanup;
pk = malloc(sizeof(*pk)*n);
if (pk == NULL) goto cleanup;
sk = malloc(sizeof(*sk)*n);
if (sk == NULL) goto cleanup;
yk = malloc(sizeof(*yk)*n);
if (yk == NULL) goto cleanup;
sr = malloc(sizeof(*sr)*n);
if (sr == NULL) goto cleanup;
yr = malloc(sizeof(*yr)*n);
if (yr == NULL) goto cleanup;
pivot = malloc(sizeof(*pivot)*n);
if (pivot == NULL) goto cleanup;
/* Initialize variables */
epsmch = mchpr1();
difnew = 0.0;
epsred = 0.05;
upd1 = TNC_TRUE;
icycle = n - 1;
newcon = TNC_TRUE;
/* Uneeded initialisations */
lreset = TNC_FALSE;
yrsr = 0.0;
yksk = 0.0;
/* Initial scaling */
scalex(n, x, xscale, xoffset);
(*f) *= *fscale;
/* initial pivot calculation */
setConstraints(n, x, pivot, xscale, xoffset, low, up);
dcopy1(n, gfull, g);
scaleg(n, g, xscale, *fscale);
/* Test the lagrange multipliers to see if they are non-negative. */
for (i = 0; i < n; i++)
if (-pivot[i] * g[i] < 0.0)
pivot[i] = 0;
project(n, g, pivot);
/* Set initial values to other parameters */
gnorm = dnrm21(n, g);
fLastConstraint = *f; /* Value at last constraint */
fLastReset = *f; /* Value at last reset */
if (messages & TNC_MSG_ITER) fprintf(stderr,
" NIT NF F GTG\n");
if (messages & TNC_MSG_ITER) printCurrentIteration(n, *f / *fscale, gfull,
*niter, *nfeval, pivot);
/* Set the diagonal of the approximate hessian to unity. */
for (i = 0; i < n; i++) diagb[i] = 1.0;
/* Start of main iterative loop */
while(TNC_TRUE)
{
/* Local minimum test */
if (dnrm21(n, g) <= pgtol * (*fscale))
{
/* |PG| == 0.0 => local minimum */
dcopy1(n, gfull, g);
project(n, g, pivot);
if (messages & TNC_MSG_INFO) fprintf(stderr,
"tnc: |pg| = %g -> local minimum\n", dnrm21(n, g) / (*fscale));
rc = TNC_LOCALMINIMUM;
break;
}
/* Terminate if more than maxnfeval evaluations have been made */
if (*nfeval >= maxnfeval)
{
rc = TNC_MAXFUN;
break;
}
/* Rescale function if necessary */
newscale = dnrm21(n, g);
if ((newscale > epsmch) && (fabs(log10(newscale)) > rescale))
{
newscale = 1.0/newscale;
*f *= newscale;
*fscale *= newscale;
gnorm *= newscale;
fLastConstraint *= newscale;
fLastReset *= newscale;
difnew *= newscale;
for (i = 0; i < n; i++) g[i] *= newscale;
for (i = 0; i < n; i++) diagb[i] = 1.0;
upd1 = TNC_TRUE;
icycle = n - 1;
newcon = TNC_TRUE;
if (messages & TNC_MSG_INFO) fprintf(stderr,
"tnc: fscale = %g\n", *fscale);
}
dcopy1(n, x, temp);
project(n, temp, pivot);
xnorm = dnrm21(n, temp);
oldnfeval = *nfeval;
/* Compute the new search direction */
frc = tnc_direction(pk, diagb, x, g, n, maxCGit, maxnfeval, nfeval,
upd1, yksk, yrsr, sk, yk, sr, yr,
lreset, function, state, xscale, xoffset, *fscale,
pivot, accuracy, gnorm, xnorm, low, up);
if (frc == -1)
{
rc = TNC_ENOMEM;
break;
}
if (frc)
{
rc = TNC_USERABORT;
break;
}
if (!newcon)
{
if (!lreset)
{
/* Compute the accumulated step and its corresponding gradient
difference. */
dxpy1(n, sk, sr);
dxpy1(n, yk, yr);
icycle++;
}
else
{
/* Initialize the sum of all the changes */
dcopy1(n, sk, sr);
dcopy1(n, yk, yr);
fLastReset = *f;
icycle = 1;
}
}
dcopy1(n, g, oldg);
oldf = *f;
oldgtp = ddot1(n, pk, g);
/* Maximum unconstrained step length */
ustpmax = stepmx / (dnrm21(n, pk) + epsmch);
/* Maximum constrained step length */
spe = stepMax(ustpmax, n, x, pk, pivot, low, up, xscale, xoffset);
if (spe > 0.0)
{
ls_rc lsrc;
/* Set the initial step length */
alpha = initialStep(*f, fmin / (*fscale), oldgtp, spe);
/* Perform the linear search */
lsrc = linearSearch(n, function, state, low, up,
xscale, xoffset, *fscale, pivot,
eta, ftol, spe, pk, x, f, &alpha, gfull, maxnfeval, nfeval);
if (lsrc == LS_ENOMEM)
{
rc = TNC_ENOMEM;
break;
}
if (lsrc == LS_USERABORT)
{
rc = TNC_USERABORT;
break;
}
if (lsrc == LS_FAIL)
{
rc = TNC_LSFAIL;
break;
}
/* If we went up to the maximum unconstrained step, increase it */
if (alpha >= 0.9 * ustpmax)
{
stepmx *= 1e2;
if (messages & TNC_MSG_INFO) fprintf(stderr,
"tnc: stepmx = %g\n", stepmx);
}
/* If we went up to the maximum constrained step,
a new constraint was encountered */
if (alpha - spe >= -epsmch * 10.0)
{
newcon = TNC_TRUE;
}
else
{
/* Break if the linear search has failed to find a lower point */
if (lsrc != LS_OK)
{
if (lsrc == LS_MAXFUN) rc = TNC_MAXFUN;
else rc = TNC_LSFAIL;
break;
}
newcon = TNC_FALSE;
}
}
else
{
/* Maximum constrained step == 0.0 => new constraint */
newcon = TNC_TRUE;
}
if (newcon)
{
if(!addConstraint(n, x, pk, pivot, low, up, xscale, xoffset))
{
if(*nfeval == oldnfeval)
{
rc = TNC_NOPROGRESS;
break;
}
}
fLastConstraint = *f;
}
(*niter)++;
/* Invoke the callback function */
if (callback)
{
unscalex(n, x, xscale, xoffset);
callback(x, state);
scalex(n, x, xscale, xoffset);
}
/* Set up parameters used in convergence and resetting tests */
difold = difnew;
difnew = oldf - *f;
/* If this is the first iteration of a new cycle, compute the
percentage reduction factor for the resetting test */
if (icycle == 1)
{
if (difnew > difold * 2.0) epsred += epsred;
if (difnew < difold * 0.5) epsred *= 0.5;
}
dcopy1(n, gfull, g);
scaleg(n, g, xscale, *fscale);
dcopy1(n, g, temp);
project(n, temp, pivot);
gnorm = dnrm21(n, temp);
/* Reset pivot */
remcon = removeConstraint(oldgtp, gnorm, pgtol * (*fscale), *f,
fLastConstraint, g, pivot, n);
/* If a constraint is removed */
if (remcon)
{
/* Recalculate gnorm and reset fLastConstraint */
dcopy1(n, g, temp);
project(n, temp, pivot);
gnorm = dnrm21(n, temp);
fLastConstraint = *f;
}
if (!remcon && !newcon)
{
/* No constraint removed & no new constraint : tests for convergence */
if (fabs(difnew) <= ftol * (*fscale))
{
if (messages & TNC_MSG_INFO) fprintf(stderr,
"tnc: |fn-fn-1] = %g -> convergence\n", fabs(difnew) / (*fscale));
rc = TNC_FCONVERGED;
break;
}
if (alpha * dnrm21(n, pk) <= xtol)
{
if (messages & TNC_MSG_INFO) fprintf(stderr,
"tnc: |xn-xn-1] = %g -> convergence\n", alpha * dnrm21(n, pk));
rc = TNC_XCONVERGED;
break;
}
}
project(n, g, pivot);
if (messages & TNC_MSG_ITER) printCurrentIteration(n, *f / *fscale, gfull,
*niter, *nfeval, pivot);
/* Compute the change in the iterates and the corresponding change in the
gradients */
if (!newcon)
{
for (i = 0; i < n; i++)
{
yk[i] = g[i] - oldg[i];
sk[i] = alpha * pk[i];
}
/* Set up parameters used in updating the preconditioning strategy */
yksk = ddot1(n, yk, sk);
if (icycle == (n - 1) || difnew < epsred * (fLastReset - *f))
lreset = TNC_TRUE;
else
{
yrsr = ddot1(n, yr, sr);
if (yrsr <= 0.0) lreset = TNC_TRUE;
else lreset = TNC_FALSE;
}
upd1 = TNC_FALSE;
}
}
if (messages & TNC_MSG_ITER) printCurrentIteration(n, *f / *fscale, gfull,
*niter, *nfeval, pivot);
/* Unscaling */
unscalex(n, x, xscale, xoffset);
coercex(n, x, low, up);
(*f) /= *fscale;
cleanup:
if (oldg) free(oldg);
if (g) free(g);
if (temp) free(temp);
if (diagb) free(diagb);
if (pk) free(pk);
if (sk) free(sk);
if (yk) free(yk);
if (sr) free(sr);
if (yr) free(yr);
if (pivot) free(pivot);
return rc;
}
/*
* Line search algorithm of gill and murray
*/
static ls_rc linearSearch(int n, tnc_function *function, void *state,
double low[], double up[],
double xscale[], double xoffset[], double fscale, int pivot[],
double eta, double ftol, double xbnd,
double p[], double x[], double *f,
double *alpha, double gfull[], int maxnfeval, int *nfeval)
{
double b1, big, tol, rmu, fpresn, fu, gu, fw, gw, gtest1, gtest2,
oldf, fmin, gmin, rtsmll, step, a, b, e, u, ualpha, factor, scxbnd, xw,
epsmch, reltol, abstol, tnytol, pe, xnorm, rteps;
double *temp = NULL, *tempgfull = NULL, *newgfull = NULL;
int maxlsit = 64, i, itcnt, frc;
ls_rc rc;
getptc_rc itest;
logical braktd;
rc = LS_ENOMEM;
temp = malloc(sizeof(*temp)*n);
if (temp == NULL) goto cleanup;
tempgfull = malloc(sizeof(*tempgfull)*n);
if (tempgfull == NULL) goto cleanup;
newgfull = malloc(sizeof(*newgfull)*n);
if (newgfull == NULL) goto cleanup;
dcopy1(n, gfull, temp);
scaleg(n, temp, xscale, fscale);
gu = ddot1(n, temp, p);
dcopy1(n, x, temp);
project(n, temp, pivot);
xnorm = dnrm21(n, temp);
/* Compute the absolute and relative tolerances for the linear search */
epsmch = mchpr1();
rteps = sqrt(epsmch);
pe = dnrm21(n, p) + epsmch;
reltol = rteps * (xnorm + 1.0) / pe;
abstol = -epsmch * (1.0 + fabs(*f)) / (gu - epsmch);
/* Compute the smallest allowable spacing between points in the linear
search */
tnytol = epsmch * (xnorm + 1.0) / pe;
rtsmll = epsmch;
big = 1.0 / (epsmch * epsmch);
itcnt = 0;
/* Set the estimated relative precision in f(x). */
fpresn = ftol;
u = *alpha;
fu = *f;
fmin = *f;
rmu = 1e-4;
/* Setup */
itest = getptcInit(&reltol, &abstol, tnytol, eta, rmu,
xbnd, &u, &fu, &gu, alpha, &fmin, &gmin, &xw, &fw, &gw, &a, &b,
&oldf, &b1, &scxbnd, &e, &step, &factor, &braktd, >est1, >est2, &tol);
/* If itest == GETPTC_EVAL, the algorithm requires the function value to be
calculated */
while(itest == GETPTC_EVAL)
{
/* Test for too many iterations or too many function evals */
if ((++itcnt > maxlsit) || ((*nfeval) >= maxnfeval)) break;
ualpha = *alpha + u;
for (i = 0; i < n; i++)
temp[i] = x[i] + ualpha * p[i];
/* Function evaluation */
unscalex(n, temp, xscale, xoffset);
coercex(n, temp, low, up);
frc = function(temp, &fu, tempgfull, state);
++(*nfeval);
if (frc)
{
rc = LS_USERABORT;
goto cleanup;
}
fu *= fscale;
dcopy1(n, tempgfull, temp);
scaleg(n, temp, xscale, fscale);
gu = ddot1(n, temp, p);
itest = getptcIter(big, rtsmll, &reltol, &abstol, tnytol, fpresn,
xbnd, &u, &fu, &gu, alpha, &fmin, &gmin, &xw, &fw, &gw, &a, &b,
&oldf, &b1, &scxbnd, &e, &step, &factor, &braktd, >est1, >est2, &tol);
/* New best point ? */
if (*alpha == ualpha)
dcopy1(n, tempgfull, newgfull);
}
if (itest == GETPTC_OK)
{
/* A successful search has been made */
*f = fmin;
daxpy1(n, *alpha, p, x);
dcopy1(n, newgfull, gfull);
rc = LS_OK;
}
/* Too many iterations ? */
else if (itcnt > maxlsit) rc = LS_FAIL;
/* If itest=GETPTC_FAIL or GETPTC_EINVAL a lower point could not be found */
else if (itest != GETPTC_EVAL) rc = LS_FAIL;
/* Too many function evaluations */
else rc = LS_MAXFUN;
cleanup:
if (temp) free(temp);
if (tempgfull) free(tempgfull);
if (newgfull) free(newgfull);
return rc;
}
/*
* This routine performs a preconditioned conjugate-gradient
* iteration in order to solve the newton equations for a search
* direction for a truncated-newton algorithm.
* When the value of the quadratic model is sufficiently reduced,
* the iteration is terminated.
*/
static int tnc_direction(double *zsol, double *diagb,
double *x, double g[], int n,
int maxCGit, int maxnfeval, int *nfeval,
logical upd1, double yksk, double yrsr,
double *sk, double *yk, double *sr, double *yr,
logical lreset, tnc_function *function, void *state,
double xscale[], double xoffset[], double fscale,
int *pivot, double accuracy,
double gnorm, double xnorm, double low[], double up[])
{
double alpha, beta, qold, qnew, rhsnrm, tol, vgv, rz, rzold, qtest, pr, gtp;
int i, k, frc;
/* Temporary vectors */
double *r = NULL, *zk = NULL, *v = NULL, *emat = NULL, *gv = NULL;
/* No CG it. => dir = -grad */
if (maxCGit == 0)
{
dcopy1(n, g, zsol);
dneg1(n, zsol);
project(n, zsol, pivot);
return 0;
}
/* General initialization */
rhsnrm = gnorm;
tol = 1e-12;
qold = 0.0;
rzold = 0.0; /* Uneeded */
frc = -1; /* ENOMEM here */
r = malloc(sizeof(*r)*n); /* Residual */
if (r == NULL) goto cleanup;
v = malloc(sizeof(*v)*n);
if (v == NULL) goto cleanup;
zk = malloc(sizeof(*zk)*n);
if (zk == NULL) goto cleanup;
emat = malloc(sizeof(*emat)*n); /* Diagonal preconditoning matrix */
if (emat == NULL) goto cleanup;
gv = malloc(sizeof(*gv)*n); /* hessian times v */
if (gv == NULL) goto cleanup;
/* Initialization for preconditioned conjugate-gradient algorithm */
frc = initPreconditioner(diagb, emat, n, lreset, yksk, yrsr, sk, yk, sr, yr,
upd1);
if (frc) goto cleanup;
for (i = 0; i < n; i++)
{
r[i] = -g[i];
v[i] = 0.0;
zsol[i] = 0.0; /* Computed search direction */
}
/* Main iteration */
for (k = 0; k < maxCGit; k++)
{
/* CG iteration to solve system of equations */
project(n, r, pivot);
frc = msolve(r, zk, n, sk, yk, diagb, sr, yr, upd1, yksk, yrsr, lreset);
if (frc) goto cleanup;
project(n, zk, pivot);
rz = ddot1(n, r, zk);
if ((rz / rhsnrm < tol) || ((*nfeval) >= (maxnfeval-1)))
{
/* Truncate algorithm in case of an emergency
or too many function evaluations */
if (k == 0)
{
dcopy1(n, g, zsol);
dneg1(n, zsol);
project(n, zsol, pivot);
}
break;
}
if (k == 0) beta = 0.0;
else beta = rz / rzold;
for (i = 0; i < n; i++)
v[i] = zk[i] + beta * v[i];
project(n, v, pivot);
frc = hessianTimesVector(v, gv, n, x, g, function, state,
xscale, xoffset, fscale, accuracy, xnorm, low, up);
++(*nfeval);
if (frc) goto cleanup;
project(n, gv, pivot);
vgv = ddot1(n, v, gv);
if (vgv / rhsnrm < tol)
{
/* Truncate algorithm in case of an emergency */
if (k == 0)
{
frc = msolve(g, zsol, n, sk, yk, diagb, sr, yr, upd1, yksk, yrsr,
lreset);
if (frc) goto cleanup;
dneg1(n, zsol);
project(n, zsol, pivot);
}
break;
}
diagonalScaling(n, emat, v, gv, r);
/* Compute linear step length */
alpha = rz / vgv;
/* Compute current solution and related vectors */
daxpy1(n, alpha, v, zsol);
daxpy1(n, -alpha, gv, r);
/* Test for convergence */
gtp = ddot1(n, zsol, g);
pr = ddot1(n, r, zsol);
qnew = (gtp + pr) * 0.5;
qtest = (k + 1) * (1.0 - qold / qnew);
if (qtest <= 0.5) break;
/* Perform cautionary test */
if (gtp > 0.0)
{
/* Truncate algorithm in case of an emergency */
daxpy1(n, -alpha, v, zsol);
break;
}
qold = qnew;
rzold = rz;
}
/* Terminate algorithm */
/* Store (or restore) diagonal preconditioning */
dcopy1(n, emat, diagb);
cleanup:
if (r) free(r);
if (v) free(v);
if (zk) free(zk);
if (emat) free(emat);
if (gv) free(gv);
return frc;
}
void
numerical_jacobian_fill(int ijaf[], /* fill Vector of integer pointers into a matrix */
double afill[], /* Vector of non-zero entries in the
* coefficient matrix */
double xf[], /* fill Solution vector for the current processor */
double rf[], /* Residual vector for the current
* processor */
double delta_t, /* time step size */
double theta, /* parameter to vary time integration
* from explicit (theta = 1) to
* implicit (theta = 0) */
double x[], /* Value current big solution vector holding everything*/
double x_old[], /* Value of the old solution vector */
double xdot[], /* Value of xdot predicted for new solution */
int Debug_Flag, /* flag for calculating numerical jacobian
-3 == calc num jac w/ rescaling */
int node_to_fill[], /* this is a map from the */
Exo_DB *exo, /* ptr to whole fe mesh */
Dpi *dpi) /* ptr to parallel info */
/******************************************************************************
This function compares the analytical jacobian entries calculated in matrix_fill
the numerical ones approximated by central difference method.
Author: K. S. Chen (1511) (based on an earlier version by P. R. Schunk).
Date: January 19, 1994
******************************************************************************/
{
int i, j, k, ii, nn, kount, nnonzero, num_total_nodes;
extern struct elem_side_bc_struct **First_Elem_Side_BC_Array;
const double epsilon = 1.e-07;
double epsilon1=1.e-3;
dbl *aj_diag, *aj_off_diag, *nj, *resid_vector_old, *x_save, *scale;
int *irow, *jcolumn, *nelem;
fprintf(stderr,"\n Starting Numerical Jacobian Checker for Fill equation\n");
nnonzero = fill_zeros+1;
nn = ijaf[num_fill_unknowns]-ijaf[0]; /* total number of diagonal entries a[] */
num_total_nodes = Num_Internal_Nodes + Num_Border_Nodes;
/* allocate arrays to hold jacobian and vector values */
irow = (int *) array_alloc(1, nnonzero, sizeof(int));
jcolumn = (int *) array_alloc(1, nnonzero, sizeof(int));
nelem = (int *) array_alloc(1, nnonzero, sizeof(int));
aj_diag = (double *) array_alloc(1, num_fill_unknowns, sizeof(double));
aj_off_diag = (double *) array_alloc(1, nnonzero, sizeof(double));
nj = (double *) array_alloc(1, nnonzero, sizeof(double));
resid_vector_old = (double *) array_alloc(1, num_fill_unknowns, sizeof(double));
x_save = (double *) array_alloc(1, num_fill_unknowns, sizeof(double));
scale = (double *) array_alloc(1, num_fill_unknowns, sizeof(double));
if (nj == NULL || scale == NULL) EH(-1, "No room for numerical jacobian arrays");
if (Debug_Flag == -2) epsilon1 = 1.e-6;
/* initialization */
memset(aj_off_diag, 0, nnonzero*sizeof(dbl)); /* off-diagonal analytical jacobian elements */
memset(nj, 0, nnonzero*sizeof(dbl)); /* numerical jacobian elements */
memset(aj_diag, 0, num_fill_unknowns*sizeof(dbl)); /* diagonal analytical jacobian elements */
/* first calculate the residual vector corresponding to the solution vector read in
the initial guess file; also calculate the analytical jacobian entries */
af->Assemble_Residual = TRUE;
af->Assemble_Jacobian = TRUE;
af->Assemble_LSA_Jacobian_Matrix = FALSE;
af->Assemble_LSA_Mass_Matrix = FALSE;
(void) fill_matrix(afill, ijaf, rf, xf, x, x_old,
xdot, delta_t, theta, ADVECT, node_to_fill,
First_Elem_Side_BC_Array, exo, dpi);
if (Debug_Flag == -2) {
/* Scale matrix first to get rid of problems with
penalt parameter */
row_sum_scale_MSR(num_fill_unknowns, afill, ijaf, rf, scale);
}
/* save solution vector and residual vector before numerical jacobian calculations */
dcopy1( num_fill_unknowns, xf, x_save);
dcopy1( num_fill_unknowns, rf, resid_vector_old);
/* extract diagonal and off-diagonal elements from the coefficient matrix stored
in sparse-storage format */
dcopy1(num_fill_unknowns, afill, aj_diag); /* diagonal elements */
kount=0; /* off-diagonal elements */
for (i=0; i<num_fill_unknowns; i++)
{
nelem[i] = ijaf[i+1] - ijaf[i];
for (k=0; k<nelem[i]; k++)
{
irow[kount]=i; /* row # in global jacobian matrix */
ii = kount + num_fill_unknowns + 1;
jcolumn[kount]=ijaf[ii]; /* column # in global jacobian matrix */
aj_off_diag[kount] = afill[ii];
kount=kount+1;
}
}
piksr2(nn, jcolumn, irow, aj_off_diag); /* arrange coefficient matrix columnwise,*/
/* in ascending column number order */
/* calculate numerical jacobian entries columnwise and then compare them with the
analytical jacobian entries */
for (j=0; j<num_fill_unknowns; j++) /* loop over each column */
{
xf[j] = x_save[j] + epsilon; /* perturb one variable at a time */
/* let big vector know of the change for load_fv */
put_fill_vector(num_total_nodes, x, xf, node_to_fill);
for (i=0; i<num_fill_unknowns; i++)
rf[i] = 0.0; /* zero residual vector before its calculation */
af->Assemble_Residual = TRUE;
af->Assemble_Jacobian = FALSE;
af->Assemble_LSA_Jacobian_Matrix = FALSE;
af->Assemble_LSA_Mass_Matrix = FALSE;
(void) fill_matrix(afill, ijaf, rf, xf, x, x_old,
xdot, delta_t, theta, ADVECT,
node_to_fill, First_Elem_Side_BC_Array, exo, dpi);
if (Debug_Flag == -2) {
/* Scale matrix first to get rid of problems with
penalt parameter */
row_scaling(num_fill_unknowns, afill, ijaf, rf, scale);
}
for (i=0; i<num_fill_unknowns; i++) /* cal numerical jacobian vector for column j */
nj[i] = (rf[i] - resid_vector_old[i])/epsilon;
/* COMPARISON: analytical vs. numerical --- the diagonal element for column j */
if(ABS(aj_diag[j] - nj[j]) > epsilon1)
fprintf(stderr, " aj=%-10.4g nj=%-10.4g resid=%-12.5g at unknown j = %d\n",
aj_diag[j], nj[j], rf[j], j);
/* COMPARISON: analytical vs. numerical --- the off-diagonal elements for column j */
for (k=0; k<(ijaf[num_fill_unknowns]-ijaf[0]); k++)
{
if(jcolumn[k] == j) /* match the column numbers */
{
for (i=0; i<num_fill_unknowns; i++)
{
if(i == irow[k]) /* match the row numbers */
{
if(ABS(aj_off_diag[k]-nj[i]) > epsilon1 && aj_off_diag[k] != 1.0e+06)
fprintf(stderr," aj=%-10.4g nj=%-10.4g at unknown j = %d row i = %d\n",
aj_off_diag[k], nj[i], j, i);
}
}
}
}
xf[j] = xf[j] - epsilon; /* return solution vector to its original state */
} /* End of for (j=0; j<num_fill_unknowns; j++) */
/* free arrays to hold jacobian and vector values */
safe_free( (void *) irow) ;
safe_free( (void *) jcolumn) ;
safe_free( (void *) nelem) ;
safe_free( (void *) aj_diag) ;
safe_free( (void *) aj_off_diag) ;
safe_free( (void *) nj) ;
safe_free( (void *) resid_vector_old) ;
safe_free( (void *) x_save) ;
safe_free( (void *) scale) ;
} /* End of function numerical_jacobian_fill */
void
continue_problem (Comm_Ex *cx, /* array of communications structures */
Exo_DB *exo, /* ptr to the finite element mesh database */
Dpi *dpi) /* distributed processing information */
{
int *ija=NULL; /* column pointer array */
double *a=NULL; /* nonzero array */
double *a_old=NULL; /* nonzero array */
double *x=NULL; /* solution vector */
int iAC; /* COUNTER */
double *x_AC = NULL; /* SOLUTION VECTOR OF EXTRA UNKNOWNS */
double *x_AC_old=NULL; /* old SOLUTION VECTOR OF EXTRA UNKNOWNS */
double *x_AC_dot=NULL;
int *ija_attic=NULL; /* storage for external dofs */
int eb_indx, ev_indx;
/*
* variables for path traversal
*/
double *x_old=NULL; /* old solution vector */
double *x_older=NULL; /* older solution vector */
double *x_oldest=NULL; /* oldest solution vector saved */
double *xdot=NULL; /* current path derivative of soln */
double *xdot_old=NULL;
double *x_update=NULL;
double *x_sens=NULL; /* solution sensitivity */
double *x_sens_temp=NULL; /* MMH thinks we need another one, so
* that when the solution is updated
* on a failure, it doesn't use the
* last computed x_sens b/c that might
* be crappy. We should use the last
* known good one... I haven't done
* the same thing with x_sens_p.
*/
double **x_sens_p=NULL; /* solution sensitivity for parameters */
int num_pvector=0; /* number of solution sensitivity vectors */
#ifdef COUPLED_FILL
struct Aztec_Linear_Solver_System *ams[NUM_ALSS]={NULL};
#else /* COUPLED_FILL */
struct Aztec_Linear_Solver_System *ams[NUM_ALSS]={NULL, NULL};
#endif /* COUPLED_FILL */
/* sl_util_structs.h */
double *resid_vector=NULL; /* residual */
double *resid_vector_sens=NULL;/* residual sensitivity */
double *scale=NULL; /* scale vector for modified newton */
int *node_to_fill = NULL;
int n; /* total number of path steps attempted */
int ni; /* total number of nonlinear solves */
int nt; /* total number of successful path steps */
int path_step_reform; /* counter for jacobian reformation stride */
int converged; /* success or failure of Newton iteration */
int success_ds; /* success or failure of path step */
int i, nprint=0, num_total_nodes;
int numProcUnknowns;
int const_delta_s, step_print;
double path_print, i_print;
double path, /* Current value (should have solution here) */
path1; /* New value (would like to get solution here) */
double delta_s, delta_s_new, delta_s_old, delta_s_older, delta_s_oldest;
double delta_t;
double theta=0.0;
double damp;
double eps;
double lambda, lambdaEnd;
double timeValueRead = 0.0;
/*
* ALC management variables
*/
int aldALC, /* direction of continuation, == -1 =>
beginning value is greater than ending value. */
alqALC; /* is -1 when we're on our last step. */
/*
* Other local variables
*/
int error, err, is_steady_state, inewton;
int *gindex = NULL, gsize;
int *p_gsize=NULL;
double *gvec=NULL;
double ***gvec_elem=NULL;
double err_dbl;
FILE *cl_aux=NULL, *file=NULL;
struct Results_Description *rd=NULL;
int tnv; /* total number of nodal variables and kinds */
int tev; /* total number of elem variables and kinds */
int tnv_post; /* total number of nodal variables and kinds
for post processing */
int tev_post; /* total number of elem variables and kinds
for post processing */
int iUC; /* User-defined continuation condition index */
int max_unk_elem, one, three; /* variables used as mf_setup arguments*/
unsigned int matrix_systems_mask;
double evol_local=0.0;
#ifdef PARALLEL
double evol_global=0.0;
#endif
static const char yo[]="continue_problem";
/*
* BEGIN EXECUTION
*/
#ifdef DEBUG
fprintf(stderr, "%s() begins...\n", yo);
#endif
is_steady_state = TRUE;
p_gsize = &gsize;
/*
* set aside space for gather global vectors to print to exoII file
* note: this is temporary
*
* For 2D prototype problem: allocate space for T, dx, dy arrays
*/
if( strlen(Soln_OutFile) )
{
file = fopen(Soln_OutFile, "w");
if (file == NULL) {
DPRINTF(stderr, "%s: opening soln file for writing\n", yo);
EH(-1, "\t");
}
}
#ifdef PARALLEL
check_parallel_error("Soln output file error");
#endif
/*
* Some preliminaries to help setup EXODUS II database output.
*/
#ifdef DEBUG
fprintf(stderr, "cnt_nodal_vars() begins...\n");
#endif
/*
* tnv_post is calculated in load_nodal_tkn
* tev_post is calculated in load_elem_tkn
*/
tnv = cnt_nodal_vars();
tev = cnt_elem_vars();
#ifdef DEBUG
fprintf(stderr, "Found %d total primitive nodal variables to output.\n", tnv);
fprintf(stderr, "Found %d total primitive elem variables to output.\n", tev);
#endif
if (tnv < 0)
{
DPRINTF(stderr, "%s:\tbad tnv.\n", yo);
EH(-1, "\t");
}
rd = (struct Results_Description *)
smalloc(sizeof(struct Results_Description));
if (rd == NULL)
EH(-1, "Could not grab Results Description.");
(void) memset((void *) rd, 0, sizeof(struct Results_Description));
rd->nev = 0; /* number element variables in results */
rd->ngv = 0; /* number global variables in results */
rd->nhv = 0; /* number history variables in results */
rd->ngv = 5; /* number global variables in results
see load_global_var_info for names*/
error = load_global_var_info(rd, 0, "CONV");
error = load_global_var_info(rd, 1, "NEWT_IT");
error = load_global_var_info(rd, 2, "MAX_IT");
error = load_global_var_info(rd, 3, "CONVRATE");
error = load_global_var_info(rd, 4, "MESH_VOLUME");
/* load nodal types, kinds, names */
error = load_nodal_tkn(rd,
&tnv,
&tnv_post);
if (error)
{
DPRINTF(stderr, "%s: problem with load_nodal_tkn()\n", yo);
EH(-1,"\t");
}
/* load elem types, names */
error = load_elem_tkn(rd,
exo,
tev,
&tev_post);
if (error)
{
DPRINTF(stderr, "%s: problem with load_elem_tkn()\n", yo);
EH(-1,"\t");
}
#ifdef PARALLEL
check_parallel_error("Results file error");
#endif
/*
* Write out the names of the nodal variables that we will be sending to
* the EXODUS II output file later.
*/
#ifdef DEBUG
fprintf(stderr, "wr_result_prelim() starts...\n", tnv);
#endif
gvec_elem = (double ***) smalloc ( (exo->num_elem_blocks)*sizeof(double **));
for (i = 0; i < exo->num_elem_blocks; i++)
gvec_elem[i] = (double **) smalloc ( (tev + tev_post)*sizeof(double *));
wr_result_prelim_exo(rd,
exo,
ExoFileOut,
gvec_elem );
#ifdef DEBUG
fprintf(stderr, "P_%d: wr_result_prelim_exo() ends...\n", ProcID, tnv);
#endif
/*
* This gvec workhorse transports output variables as nodal based vectors
* that are gather from the solution vector. Note: it is NOT a global
* vector at all and only carries this processor's nodal variables to
* the exodus database.
*/
asdv(&gvec, Num_Node);
/*
* Allocate space and manipulate for all the nodes that this processor
* is aware of...
*/
num_total_nodes = dpi->num_universe_nodes;
numProcUnknowns = NumUnknowns + NumExtUnknowns;
/* allocate memory for Volume Constraint Jacobian */
if ( nAC > 0)
for(iAC=0;iAC<nAC;iAC++)
augc[iAC].d_evol_dx = (double*) malloc(numProcUnknowns*sizeof(double));
asdv(&resid_vector, numProcUnknowns);
asdv(&resid_vector_sens, numProcUnknowns);
asdv(&scale, numProcUnknowns);
for (i = 0; i < NUM_ALSS; i++)
{
ams[i] = alloc_struct_1(struct Aztec_Linear_Solver_System, 1);
}
#ifdef MPI
AZ_set_proc_config( ams[0]->proc_config, MPI_COMM_WORLD );
#ifndef COUPLED_FILL
if( Explicit_Fill ) AZ_set_proc_config( ams[1]->proc_config, MPI_COMM_WORLD );
#endif /* not COUPLED_FILL */
#else /* MPI */
AZ_set_proc_config( ams[0]->proc_config, 0 );
#ifndef COUPLED_FILL
if( Explicit_Fill ) AZ_set_proc_config( ams[1]->proc_config, 0 );
#endif /* not COUPLED_FILL */
#endif /* MPI */
/*
* allocate space for and initialize solution arrays
*/
asdv(&x, numProcUnknowns);
asdv(&x_old, numProcUnknowns);
asdv(&x_older, numProcUnknowns);
asdv(&x_oldest, numProcUnknowns);
asdv(&xdot, numProcUnknowns);
asdv(&xdot_old, numProcUnknowns);
asdv(&x_update, numProcUnknowns);
asdv(&x_sens, numProcUnknowns);
asdv(&x_sens_temp, numProcUnknowns);
/*
* Initialize solid inertia flag
*/
set_solid_inertia();
/*
* FRIENDLY COMMAND LINE EQUIV
*/
if( ProcID == 0 )
{
cl_aux = fopen("goma-cl.txt", "w+");
fprintf(cl_aux, "goma -a -i input ");
fprintf(cl_aux, "-cb %10.6e ", cont->BegParameterValue);
fprintf(cl_aux, "-ce %10.6e ", cont->EndParameterValue);
fprintf(cl_aux, "-cd %10.6e ", cont->Delta_s0);
fprintf(cl_aux, "-cn %d ", cont->MaxPathSteps);
fprintf(cl_aux, "-cmin %10.6e ", cont->Delta_s_min);
fprintf(cl_aux, "-cmax %10.6e ", cont->Delta_s_max);
fprintf(cl_aux, "-cm %d ", Continuation);
fprintf(cl_aux, "-ct %d ", cont->upType);
switch (cont->upType)
{
case 1: /* BC TYPE */
fprintf(cl_aux, "-c_bc %d ", cont->upBCID);
fprintf(cl_aux, "-c_df %d ", cont->upDFID);
break;
case 2: /* MAT TYPE */
fprintf(cl_aux, "-c_mn %d ", cont->upMTID+1);
fprintf(cl_aux, "-c_mp %d ", cont->upMPID);
break;
case 3: /* AC TYPE */
fprintf(cl_aux, "-c_ac %d ", cont->upBCID);
fprintf(cl_aux, "-c_df %d ", cont->upDFID);
break;
case 4: /* USER MAT TYPE */
fprintf(cl_aux, "-c_mn %d ", cont->upMTID+1);
fprintf(cl_aux, "-c_mp %d ", cont->upMPID);
fprintf(cl_aux, "-c_md %d ", cont->upMDID);
break;
case 5: /* USER-DEFINED FUNCTION TYPE */
/* NOTE: This is not available via the command line! */
break;
case 6: /* ANGULAR CONTINUATION TYPE */
/* NOTE: This requires LOCA and is not available via the command line! */
EH(-1, "Angular continuation is available only in LOCA!");
break;
default:
fprintf(stderr, "%s: Bad cont->upType, %d\n", yo, cont->upType);
EH(-1,"Bad cont->upType");
break; /* duh */
}
fprintf(cl_aux, "\n");
fclose(cl_aux);
}
#ifdef PARALLEL
check_parallel_error("Continuation setup error");
#endif
/*
* FIRST ORDER CONTINUATION
*/
lambda = cont->BegParameterValue;
lambdaEnd = cont->EndParameterValue;
if (lambdaEnd > lambda)
aldALC = +1;
else
aldALC = -1;
delta_s_new = 0.0;
Delta_s0 = cont->Delta_s0;
Delta_s_min = cont->Delta_s_min;
Delta_s_max = cont->Delta_s_max;
MaxPathSteps = cont->MaxPathSteps;
PathMax = cont->PathMax;
eps = cont->eps;
if (Delta_s0 < 0.0 )
{
Delta_s0 = -Delta_s0;
const_delta_s = 1;
}
else
const_delta_s = 0;
damp = 1.0;
path = path1 = lambda;
if (Debug_Flag && ProcID == 0)
{
fprintf(stderr,"MaxPathSteps: %d \tlambdaEnd: %f\n", MaxPathSteps, lambdaEnd);
fprintf(stderr,"continuation in progress\n");
}
nprint = 0;
if (Delta_s0 > Delta_s_max)
Delta_s0 = Delta_s_max;
delta_s = delta_s_old = delta_s_older = Delta_s0;
delta_t = 0.0;
tran->delta_t = 0.0; /*for Newmark-Beta terms in Lagrangian Solid*/
/* Call prefront (or mf_setup) if necessary */
if (Linear_Solver == FRONT)
{
/* Also got to define these because it wants pointers to these numbers */
max_unk_elem = (MAX_PROB_VAR + MAX_CONC)*MDE;
one = 1;
three = 3;
/* NOTE: We need a overall flag in the vn_glob struct that tells whether FULL_DG
is on anywhere in domain. This assumes only one material. See sl_front_setup for test.
that test needs to be in the input parser. */
if(vn_glob[0]->dg_J_model == FULL_DG)
max_unk_elem = (MAX_PROB_VAR + MAX_CONC)*MDE + 4*vn_glob[0]->modes*4*MDE;
#ifdef PARALLEL
if (Num_Proc > 1) EH(-1, "Whoa. No front allowed with nproc>1");
check_parallel_error("Front solver not allowed with nprocs>1");
#endif
#ifdef HAVE_FRONT
err = mf_setup(&exo->num_elems,
&NumUnknowns,
&max_unk_elem,
&three,
&one,
exo->elem_order_map,
fss->el_proc_assign,
fss->level,
fss->nopdof,
fss->ncn,
fss->constraint,
front_scratch_directory,
&fss->ntra);
EH(err,"problems in frontal setup ");
#else
EH(-1,"Don't have frontal solver compiled and linked in");
#endif
}
/*
* if computing parameter sensitivities, allocate space for solution
* sensitivity vectors
*/
for(i=0;i<nn_post_fluxes_sens;i++)
{
num_pvector=MAX(num_pvector,pp_fluxes_sens[i]->vector_id);
}
for(i=0;i<nn_post_data_sens;i++)
{
num_pvector=MAX(num_pvector,pp_data_sens[i]->vector_id);
}
if((nn_post_fluxes_sens + nn_post_data_sens) > 0)
{
num_pvector++;
num_pvector = MAX(num_pvector,2);
x_sens_p = Dmatrix_birth(num_pvector,numProcUnknowns);
}
else
x_sens_p = NULL;
if (nAC > 0)
{
asdv(&x_AC, nAC);
asdv(&x_AC_old, nAC);
asdv(&x_AC_dot, nAC);
}
/*
* ADJUST NATURAL PARAMETER
*/
update_parameterC(0, path1, x, xdot, x_AC, delta_s, cx, exo, dpi);
/* Allocate sparse matrix */
if( strcmp( Matrix_Format, "msr" ) == 0)
{
log_msg("alloc_MSR_sparse_arrays...");
alloc_MSR_sparse_arrays(&ija,
&a,
&a_old,
0,
node_to_fill,
exo,
dpi);
/*
* An attic to store external dofs column names is needed when
* running in parallel.
*/
alloc_extern_ija_buffer(num_universe_dofs,
num_internal_dofs+num_boundary_dofs,
ija, &ija_attic);
/*
* Any necessary one time initialization of the linear
* solver package (Aztec).
*/
ams[JAC]->bindx = ija;
ams[JAC]->val = a;
ams[JAC]->belfry = ija_attic;
ams[JAC]->val_old = a_old;
/*
* These point to nowhere since we're using MSR instead of VBR
* format.
*/
ams[JAC]->indx = NULL;
ams[JAC]->bpntr = NULL;
ams[JAC]->rpntr = NULL;
ams[JAC]->cpntr = NULL;
ams[JAC]->npn = dpi->num_internal_nodes + dpi->num_boundary_nodes;
ams[JAC]->npn_plus = dpi->num_internal_nodes + dpi->num_boundary_nodes + dpi->num_external_nodes;
ams[JAC]->npu = num_internal_dofs+num_boundary_dofs;
ams[JAC]->npu_plus = num_universe_dofs;
ams[JAC]->nnz = ija[num_internal_dofs+num_boundary_dofs] - 1;
ams[JAC]->nnz_plus = ija[num_universe_dofs];
}
else if( strcmp( Matrix_Format, "vbr" ) == 0)
{
log_msg("alloc_VBR_sparse_arrays...");
alloc_VBR_sparse_arrays (ams[JAC],
exo,
dpi);
ija_attic = NULL;
ams[JAC]->belfry = ija_attic;
a = ams[JAC]->val;
if( !save_old_A ) a_old = ams[JAC]->val_old = NULL;
}
else if ( strcmp( Matrix_Format, "front") == 0 )
{
/* Don't allocate any sparse matrix space when using front */
ams[JAC]->bindx = NULL;
ams[JAC]->val = NULL;
ams[JAC]->belfry = NULL;
ams[JAC]->val_old = NULL;
ams[JAC]->indx = NULL;
ams[JAC]->bpntr = NULL;
ams[JAC]->rpntr = NULL;
ams[JAC]->cpntr = NULL;
}
else
EH(-1,"Attempted to allocate unknown sparse matrix format");
init_vec(x, cx, exo, dpi, x_AC, nAC, &timeValueRead);
/* if read ACs, update data floats */
if (nAC > 0)
if(augc[0].iread == 1)
{
for(iAC=0 ; iAC<nAC ; iAC++)
{ update_parameterAC(iAC, x, xdot, x_AC, cx, exo, dpi);}
}
vzero(numProcUnknowns, &x_sens[0]);
vzero(numProcUnknowns, &x_sens_temp[0]);
/*
* set boundary conditions on the initial conditions
*/
nullify_dirichlet_bcs();
find_and_set_Dirichlet(x, xdot, exo, dpi);
exchange_dof(cx, dpi, x);
dcopy1(numProcUnknowns,x,x_old);
dcopy1(numProcUnknowns,x_old,x_older);
dcopy1(numProcUnknowns,x_older,x_oldest);
if(nAC > 0)
dcopy1(nAC,x_AC, x_AC_old);
/*
* initialize the counters for when to print out data
*/
path_print = path1;
step_print = 1;
matrix_systems_mask = 1;
log_msg("sl_init()...");
sl_init(matrix_systems_mask, ams, exo, dpi, cx);
/*
* Make sure the solver was properly initialized on all processors.
*/
#ifdef PARALLEL
check_parallel_error("Solver initialization problems");
#endif
ams[JAC]->options[AZ_keep_info] = 1;
/*
* set the number of successful path steps to zero
*/
nt = 0;
/*
* LOOP THROUGH PARAMETER UNTIL MAX NUMBER
* OF STEPS SURPASSED
*/
for(n = 0; n < MaxPathSteps; n++)
{
alqALC = 1;
switch (aldALC)
{
case -1: /* REDUCING PARAMETER DIRECTION */
if (path1 <= lambdaEnd)
{
DPRINTF(stderr,"\n\t ******** LAST PATH STEP!\n");
alqALC = -1;
path1 = lambdaEnd;
delta_s = path-path1;
}
break;
case +1: /* RISING PARAMETER DIRECTION */
if (path1 >= lambdaEnd)
{
DPRINTF(stderr,"\n\t ******** LAST PATH STEP!\n");
alqALC = -1;
path1 = lambdaEnd;
delta_s = path1-path;
}
break;
default:
DPRINTF(stderr, "%s: Bad aldALC, %d\n", yo, aldALC);
EH(-1,"\t");
break; /* duh */
}
#ifdef PARALLEL
check_parallel_error("Bad aldALC");
#endif
/*
* ADJUST NATURAL PARAMETER
*/
update_parameterC(0, path1, x, xdot, x_AC, delta_s,
cx, exo, dpi);
/*
* IF STEP CHANGED, REDO FIRST ORDER PREDICTION
*/
if(alqALC == -1)
{
dcopy1(NumUnknowns,x_old,x);
switch (Continuation)
{
case ALC_ZEROTH:
break;
case ALC_FIRST:
switch (aldALC)
{
case -1:
v1add(NumUnknowns, &x[0], -delta_s, &x_sens[0]);
break;
case +1:
v1add(NumUnknowns, &x[0], +delta_s, &x_sens[0]);
break;
default:
DPRINTF(stderr, "%s: Bad aldALC, %d\n", yo, aldALC);
EH(-1,"\t");
break; /* duh */
}
break;
default:
DPRINTF(stderr, "%s: Bad Continuation, %d\n", yo, Continuation);
EH(-1,"\t");
break; /* duh */
}
}
#ifdef PARALLEL
check_parallel_error("Bad Continuation");
#endif
find_and_set_Dirichlet (x, xdot, exo, dpi);
exchange_dof(cx, dpi, x);
if (ProcID == 0)
{
fprintf(stderr, "\n\t----------------------------------");
switch (Continuation)
{
case ALC_ZEROTH:
DPRINTF(stderr, "\n\tZero Order Continuation:");
break;
case ALC_FIRST:
DPRINTF(stderr, "\n\tFirst Order Continuation:");
break;
default:
DPRINTF(stderr, "%s: Bad Continuation, %d\n", yo, Continuation);
EH(-1,"\t");
break; /* duh */
}
DPRINTF(stderr, "\n\tStep number: %4d of %4d (max)", n+1, MaxPathSteps);
DPRINTF(stderr, "\n\tAttempting solution at:");
switch (cont->upType)
{
case 1: /* BC */
case 3: /* AC */
DPRINTF(stderr, "\n\tBCID=%3d DFID=%5d", cont->upBCID, cont->upDFID);
break;
case 2: /* MT */
DPRINTF(stderr, "\n\tMTID=%3d MPID=%5d", cont->upMTID, cont->upMPID);
break;
case 4: /* UM */
DPRINTF(stderr, "\n\tMTID=%3d MPID=%5d MDID=%3d", cont->upMTID, cont->upMPID, cont->upMDID);
break;
/* This case requires an inner switch block */
case 5: /* UF */
for (iUC=0; iUC<nUC; iUC++)
{
switch (cpuc[iUC].Type)
{
case 1: /* BC */
case 3: /* AC */
DPRINTF(stderr, "\n\tBCID=%3d DFID=%5d",
cpuc[iUC].BCID, cpuc[iUC].DFID);
break;
case 2: /* MT */
DPRINTF(stderr, "\n\tMTID=%3d MPID=%5d",
cpuc[iUC].MTID, cpuc[iUC].MPID);
break;
case 4: /* UM */
DPRINTF(stderr, "\n\tMTID=%3d MPID=%5d MDID=%3d",
cpuc[iUC].MTID, cpuc[iUC].MPID, cpuc[iUC].MDID);
break;
default:
DPRINTF(stderr, "%s: Bad user continuation type, %d\n",
yo, cont->upType);
EH(-1,"\t");
break;
}
DPRINTF(stderr, " Parameter= % 10.6e delta_s= %10.6e",
cpuc[iUC].value, (cpuc[iUC].value-cpuc[iUC].old_value) );
}
break;
default:
DPRINTF(stderr, "%s: Bad cont->upType, %d\n", yo, cont->upType);
EH(-1,"\t");
break; /* duh */
}
if (cont->upType != 5)
{
DPRINTF(stderr, " Parameter= % 10.6e delta_s= %10.6e", path1, delta_s);
}
}
#ifdef PARALLEL
check_parallel_error("Bad cont->upType");
#endif
ni = 0;
do {
#ifdef DEBUG
DPRINTF(stderr, "%s: starting solve_nonlinear_problem\n", yo);
#endif
err = solve_nonlinear_problem(ams[JAC],
x,
delta_t,
theta,
x_old,
x_older,
xdot,
xdot_old,
resid_vector,
x_update,
scale,
&converged,
&nprint,
tev,
tev_post,
NULL,
rd,
gindex,
p_gsize,
gvec,
gvec_elem,
path1,
exo,
dpi,
cx,
0,
&path_step_reform,
is_steady_state,
x_AC,
x_AC_dot,
path1,
resid_vector_sens,
x_sens_temp,
x_sens_p,
NULL);
#ifdef DEBUG
fprintf(stderr, "%s: returned from solve_nonlinear_problem\n", yo);
#endif
if (err == -1)
converged = 0;
inewton = err;
if (converged)
{
if (Write_Intermediate_Solutions == 0) {
#ifdef DEBUG
DPRINTF(stderr, "%s: write_solution call WIS\n", yo);
#endif
write_solution(ExoFileOut, resid_vector, x, x_sens_p,
x_old, xdot, xdot_old, tev, tev_post, NULL, rd,
gindex, p_gsize, gvec, gvec_elem, &nprint,
delta_s, theta, path1, NULL, exo, dpi);
#ifdef DEBUG
fprintf(stderr, "%s: write_solution end call WIS\n", yo);
#endif
}
#ifdef PARALLEL
check_parallel_error("Error writing exodusII file");
#endif
/*
* PRINT OUT VALUES OF EXTRA UNKNOWNS
* FROM AUGMENTING CONDITIONS
*/
if (nAC > 0)
{
DPRINTF(stderr, "\n------------------------------\n");
DPRINTF(stderr, "Augmenting Conditions: %4d\n", nAC);
DPRINTF(stderr, "Number of extra unknowns: %4d\n\n", nAC);
for (iAC = 0; iAC < nAC; iAC++)
{
if (augc[iAC].Type == AC_USERBC)
{
DPRINTF(stderr, "\tBC[%4d] DF[%4d] = %10.6e\n",
augc[iAC].BCID, augc[iAC].DFID, x_AC[iAC]);
}
else if (augc[iAC].Type == AC_USERMAT ||
augc[iAC].Type == AC_FLUX_MAT )
{
DPRINTF(stderr, "\tMT[%4d] MP[%4d] = %10.6e\n",
augc[iAC].MTID, augc[iAC].MPID, x_AC[iAC]);
}
else if(augc[iAC].Type == AC_VOLUME)
{
evol_local = augc[iAC].evol;
#ifdef PARALLEL
if( Num_Proc > 1 ) {
MPI_Allreduce( &evol_local, &evol_global, 1,
MPI_DOUBLE, MPI_SUM, MPI_COMM_WORLD);
}
evol_local = evol_global;
#endif
DPRINTF(stderr, "\tMT[%4d] VC[%4d]=%10.6e Param=%10.6e\n",
augc[iAC].MTID, augc[iAC].VOLID, evol_local,
x_AC[iAC]);
}
else if(augc[iAC].Type == AC_POSITION)
{
evol_local = augc[iAC].evol;
#ifdef PARALLEL
if( Num_Proc > 1 ) {
MPI_Allreduce( &evol_local, &evol_global, 1,
MPI_DOUBLE, MPI_SUM, MPI_COMM_WORLD);
}
evol_local = evol_global;
#endif
DPRINTF(stderr, "\tMT[%4d] XY[%4d]=%10.6e Param=%10.6e\n",
augc[iAC].MTID, augc[iAC].VOLID, evol_local,
x_AC[iAC]);
}
else if(augc[iAC].Type == AC_FLUX)
{
DPRINTF(stderr, "\tBC[%4d] DF[%4d]=%10.6e\n",
augc[iAC].BCID, augc[iAC].DFID, x_AC[iAC]);
}
}
}
/*
* INTEGRATE FLUXES, FORCES
*/
for (i = 0; i < nn_post_fluxes; i++)
err_dbl = evaluate_flux (exo, dpi,
pp_fluxes[i]->ss_id,
pp_fluxes[i]->flux_type ,
pp_fluxes[i]->flux_type_name ,
pp_fluxes[i]->blk_id ,
pp_fluxes[i]->species_number,
pp_fluxes[i]->flux_filenm,
pp_fluxes[i]->profile_flag,
x,xdot,NULL, delta_s,path1,1);
/*
* COMPUTE FLUX, FORCE SENSITIVITIES
*/
for (i = 0; i < nn_post_fluxes_sens; i++)
err_dbl = evaluate_flux_sens (exo, dpi,
pp_fluxes_sens[i]->ss_id,
pp_fluxes_sens[i]->flux_type ,
pp_fluxes_sens[i]->flux_type_name ,
pp_fluxes_sens[i]->blk_id ,
pp_fluxes_sens[i]->species_number,
pp_fluxes_sens[i]->sens_type,
pp_fluxes_sens[i]->sens_id,
pp_fluxes_sens[i]->sens_flt,
pp_fluxes_sens[i]->sens_flt2,
pp_fluxes_sens[i]->vector_id,
pp_fluxes_sens[i]->flux_filenm,
pp_fluxes_sens[i]->profile_flag,
x,xdot,x_sens_p,delta_s,path1,1);
/*
* Compute global volumetric quantities
*/
for (i = 0; i < nn_volume; i++ ) {
evaluate_volume_integral(exo, dpi,
pp_volume[i]->volume_type,
pp_volume[i]->volume_name,
pp_volume[i]->blk_id,
pp_volume[i]->species_no,
pp_volume[i]->volume_fname,
pp_volume[i]->params,
NULL, x, xdot, delta_s,
path1, 1);
}
} /* end of if converged block */
/*
* INCREMENT COUNTER
*/
ni++;
/*
* DID IT CONVERGE ?
* IF NOT, REDUCE STEP SIZE AND TRY AGAIN
*/
if (!converged)
{
if (ni > 5)
{
puts(" ");
puts(" ************************************");
puts(" W: Did not converge in Newton steps.");
puts(" Find better initial guess. ");
puts(" ************************************");
/* This needs to have a return value of 0, indicating
* success, for the continuation script to not treat this
* as a failed command. */
exit(0);
}
/*
* ADJUST STEP SIZE
*/
DPRINTF(stderr, "\n\tFailed to converge:\n");
delta_s *= 0.5;
switch (aldALC)
{
case -1:
path1 = path - delta_s;
break;
case +1:
path1 = path + delta_s;
break;
default:
DPRINTF(stderr, "%s: Bad aldALC, %d\n", yo, aldALC);
EH(-1,"\t");
break; /* duh */
}
#ifdef PARALLEL
check_parallel_error("Bad aldALC");
#endif
/*
* RESET
*/
alqALC = 1; /* If necessary, don't call this the last step... */
DPRINTF(stderr, "\n\tDecreasing step-length to %10.6e.\n", delta_s);
if (delta_s < Delta_s_min)
{
puts("\n X: C step-length reduced below minimum.");
puts("\n Program terminated.\n");
/* This needs to have a return value of 0, indicating
* success, for the continuation script to not treat this
* as a failed command. */
exit(0);
}
#ifdef PARALLEL
check_parallel_error("\t");
#endif
/*
* ADJUST NATURAL PARAMETER
*/
dcopy1(numProcUnknowns, x_old, x);
update_parameterC(0, path1, x, xdot, x_AC, delta_s,
cx, exo, dpi);
/*
* GET ZERO OR FIRST ORDER PREDICTION
*/
switch (Continuation)
{
case ALC_ZEROTH:
break;
case ALC_FIRST:
switch (aldALC)
{
case -1:
v1add(numProcUnknowns, &x[0], -delta_s, &x_sens[0]);
break;
case +1:
v1add(numProcUnknowns, &x[0], +delta_s, &x_sens[0]);
break;
default:
DPRINTF(stderr, "%s: Bad aldALC, %d\n", yo, aldALC);
EH(-1,"\t");
break; /* duh */
}
break;
default:
DPRINTF(stderr, "%s: Bad Continuation, %d\n", yo, Continuation);
EH(-1,"\t");
break; /* duh */
}
#ifdef PARALLEL
check_parallel_error("Bad Continuation");
#endif
/* MMH: Needed to put this in, o/w it may find that the
* solution and residual HAPPEN to satisfy the convergence
* criterion for the next newton solve...
*/
find_and_set_Dirichlet(x, xdot, exo, dpi);
exchange_dof(cx, dpi, x);
/* Should be doing first order prediction on ACs
* but for now, just reset the AC variables
*/
if( nAC > 0)
{
dcopy1(nAC, x_AC_old, x_AC);
for(iAC=0 ; iAC<nAC ; iAC++)
{ update_parameterAC(iAC, x, xdot, x_AC, cx, exo, dpi);}
}
} /* end of !converged */
} while (converged == 0);
/*
* CONVERGED
*/
nt++;
if( Continuation == ALC_ZEROTH ) {
DPRINTF(stderr, "\n\tStep accepted, parameter = %10.6e\n", path1);
}
else {
DPRINTF(stderr, "\tStep accepted, parameter = %10.6e\n", path1);
}
/*
* check path step error, if too large do not enlarge path step
*/
if ((ni == 1) && (n != 0) && (!const_delta_s))
{
delta_s_new = path_step_control(num_total_nodes,
delta_s, delta_s_old,
x,
eps,
&success_ds,
cont->use_var_norm, inewton);
if (delta_s_new > Delta_s_max)
delta_s_new = Delta_s_max;
}
else
{
success_ds = 1;
delta_s_new = delta_s;
}
/*
* determine whether to print out the data or not
*/
i_print = 0;
if (nt == step_print)
{
i_print = 1;
step_print += cont->print_freq;
}
if (alqALC == -1)
i_print = 1;
if (i_print)
{
error = write_ascii_soln(x, resid_vector, numProcUnknowns,
x_AC, nAC, path1, file);
if (error) {
DPRINTF(stdout, "%s: error writing ASCII soln file\n", yo);
}
if (Write_Intermediate_Solutions == 0 ) {
write_solution(ExoFileOut, resid_vector, x, x_sens_p,
x_old, xdot, xdot_old, tev, tev_post, NULL,
rd, gindex, p_gsize, gvec, gvec_elem, &nprint,
delta_s, theta, path1, NULL, exo, dpi);
nprint++;
}
}
/*
* backup old solutions
* can use previous solutions for prediction one day
*/
dcopy1(numProcUnknowns,x_older,x_oldest);
dcopy1(numProcUnknowns,x_old,x_older);
dcopy1(numProcUnknowns, x, x_old);
dcopy1(numProcUnknowns, x_sens_temp, x_sens);
delta_s_oldest = delta_s_older;
delta_s_older = delta_s_old;
delta_s_old = delta_s;
delta_s = delta_s_new;
if( nAC > 0)
dcopy1(nAC, x_AC, x_AC_old);
/*
* INCREMENT/DECREMENT PARAMETER
*/
path = path1;
switch (aldALC)
{
case -1:
path1 = path - delta_s;
break;
case +1:
path1 = path + delta_s;
break;
default:
DPRINTF(stderr, "%s: Bad aldALC, %d\n", yo, aldALC);
EH(-1,"\t");
break; /* duh */
}
#ifdef PARALLEL
check_parallel_error("Bad aldALC");
#endif
/*
* ADJUST NATURAL PARAMETER
*/
update_parameterC(0, path1, x, xdot, x_AC, delta_s,
cx, exo, dpi);
/*
display_parameterC(path1, x, xdot, delta_s,
cx, exo, dpi);
*/
/*
* GET FIRST ORDER PREDICTION
*/
switch (Continuation)
{
case ALC_ZEROTH:
break;
case ALC_FIRST:
switch (aldALC)
{
case -1:
v1add(numProcUnknowns, &x[0], -delta_s, &x_sens[0]);
break;
case +1:
v1add(numProcUnknowns, &x[0], +delta_s, &x_sens[0]);
break;
default:
DPRINTF(stderr, "%s: Bad aldALC, %d\n", yo, aldALC);
EH(-1,"\t");
break; /* duh */
}
break;
}
#ifdef PARALLEL
check_parallel_error("Bad aldALC");
#endif
/*
* CHECK END CONTINUATION
*/
/*
if (alqALC == -1)
alqALC = 0;
else
alqALC = 1;
*/
if (alqALC == -1)
{
DPRINTF(stderr,"\n\n\t I will continue no more!\n\t No more continuation for you!\n");
goto free_and_clear;
}
} /* for(n = 0; n < MaxPathSteps; n++) */
if(n == MaxPathSteps &&
aldALC * (lambdaEnd - path) > 0)
{
DPRINTF(stderr, "\n\tFailed to reach end of hunt in maximum number of successful steps (%d).\n\tSorry.\n",
MaxPathSteps);
/*
EH(-1,"\t");
*/
}
#ifdef PARALLEL
check_parallel_error("Continuation error");
#endif
/*
* DONE CONTINUATION
*/
free_and_clear:
/*
* Transform the node point coordinates according to the
* displacements and write out all the results using the
* displaced coordinates. Set the displacement field to
* zero, too.
*/
if (Anneal_Mesh)
{
#ifdef DEBUG
fprintf(stderr, "%s: anneal_mesh()...\n", yo);
#endif
err = anneal_mesh(x, tev, tev_post, NULL, rd, path1, exo, dpi);
#ifdef DEBUG
fprintf(stderr, "%s: anneal_mesh()-done\n", yo);
#endif
EH(err, "anneal_mesh() bad return.");
}
#ifdef PARALLEL
check_parallel_error("Trouble annealing mesh");
#endif
/*
* Free a bunch of variables that aren't needed anymore
*/
safer_free((void **) &ROT_Types);
safer_free((void **) &node_to_fill);
safer_free( (void **) &resid_vector);
safer_free( (void **) &resid_vector_sens);
safer_free( (void **) &scale);
safer_free( (void **) &x);
if (nAC > 0)
{
safer_free( (void **) &x_AC);
safer_free( (void **) &x_AC_old);
safer_free( (void **) &x_AC_dot);
}
safer_free( (void **) &x_old);
safer_free( (void **) &x_older);
safer_free( (void **) &x_oldest);
safer_free( (void **) &xdot);
safer_free( (void **) &xdot_old);
safer_free( (void **) &x_update);
safer_free( (void **) &x_sens);
safer_free( (void **) &x_sens_temp);
if((nn_post_data_sens+nn_post_fluxes_sens) > 0)
Dmatrix_death(x_sens_p,num_pvector,numProcUnknowns);
for(i = 0; i < MAX_NUMBER_MATLS; i++) {
for(n = 0; n < MAX_MODES; n++) {
safer_free((void **) &(ve_glob[i][n]->gn));
safer_free((void **) &(ve_glob[i][n]));
}
safer_free((void **) &(vn_glob[i]));
}
sl_free(matrix_systems_mask, ams);
for (i = 0; i < NUM_ALSS; i++)
safer_free((void **) &(ams[i]));
safer_free( (void **) &gvec);
i = 0;
for ( eb_indx = 0; eb_indx < exo->num_elem_blocks; eb_indx++ )
{
for ( ev_indx = 0; ev_indx < rd->nev; ev_indx++ ) {
if (exo->elem_var_tab[i++] == 1) {
safer_free((void **) &(gvec_elem [eb_indx][ev_indx]));
}
}
safer_free((void **) &(gvec_elem [eb_indx]));
}
safer_free( (void **) &gvec_elem);
if (cpcc != NULL) safer_free( (void **) &cpcc);
safer_free( (void **) &rd);
safer_free( (void **) &Local_Offset);
safer_free( (void **) &Dolphin);
if (file != NULL) fclose(file);
return;
} /* END of routine continue_problem */
void
hunt_problem(Comm_Ex *cx, /* array of communications structures */
Exo_DB *exo, /* ptr to the finite element mesh database */
Dpi *dpi) /* distributed processing information */
{
int *ija=NULL; /* column pointer array */
double *a=NULL; /* nonzero array */
double *a_old=NULL; /* nonzero array */
double *x=NULL; /* solution vector */
int iAC; /* COUNTER */
double *x_AC = NULL; /* SOLUTION VECTOR OF EXTRA UNKNOWNS */
double *x_AC_old=NULL; /* old SOLUTION VECTOR OF EXTRA UNKNOWNS */
double *x_AC_dot = NULL;
int iHC; /* COUNTER */
int *ija_attic=NULL; /* storage for external dofs */
int eb_indx, ev_indx;
/*
* variables for path traversal
*/
double *x_old=NULL; /* old solution vector */
double *x_older=NULL; /* older solution vector */
double *x_oldest=NULL; /* oldest solution vector saved */
double *xdot=NULL; /* current path derivative of soln */
double *xdot_old=NULL;
double *x_update=NULL;
double *x_sens=NULL; /* solution sensitivity */
double **x_sens_p=NULL; /* solution sensitivity for parameters */
int num_pvector=0; /* number of solution sensitivity vectors */
#ifdef COUPLED_FILL
struct Aztec_Linear_Solver_System *ams[NUM_ALSS]={NULL};
#else /* COUPLED_FILL */
struct Aztec_Linear_Solver_System *ams[NUM_ALSS]={NULL, NULL};
#endif /* COUPLED_FILL */
/* sl_util_structs.h */
double *resid_vector=NULL; /* residual */
double *resid_vector_sens=NULL; /* residual sensitivity */
double *scale=NULL; /* scale vector for modified newton */
int *node_to_fill = NULL;
int n; /* total number of path steps attempted */
int ni; /* total number of nonlinear solves */
int nt; /* total number of successful path steps */
int path_step_reform; /* counter for jacobian reformation stride */
int converged; /* success or failure of Newton iteration */
int success_ds; /* success or failure of path step */
int i;
int nprint=0, num_total_nodes;
int numProcUnknowns;
int *const_delta_s=NULL;
int step_print;
double i_print;
int good_mesh = TRUE;
double *path=NULL, *path1=NULL;
double *delta_s=NULL, *delta_s_new=NULL, *delta_s_old=NULL;
double *delta_s_older=NULL, *delta_s_oldest=NULL;
double *hDelta_s0=NULL, *hDelta_s_min=NULL, *hDelta_s_max=NULL;
double delta_t;
double theta=0.0;
double damp;
double eps;
double *lambda=NULL, *lambdaEnd=NULL;
double hunt_par, dhunt_par, hunt_par_old; /* hunting continuation parameter */
double timeValueRead = 0.0;
/*
* ALC management variables
*/
int alqALC;
int *aldALC=NULL;
/*
* Other local variables
*/
int error, err, is_steady_state, inewton;
int *gindex = NULL, gsize;
int *p_gsize=NULL;
double *gvec=NULL;
double ***gvec_elem;
double err_dbl;
FILE *file=NULL;
double toler_org[3],damp_org;
struct Results_Description *rd=NULL;
int tnv; /* total number of nodal variables and kinds */
int tev; /* total number of elem variables and kinds */
int tnv_post; /* total number of nodal variables and kinds
for post processing */
int tev_post; /* total number of elem variables and kinds
for post processing */
int max_unk_elem, one, three; /* variables used as mf_setup arguments*/
unsigned int
matrix_systems_mask;
double evol_local=0.0;
#ifdef PARALLEL
double evol_global=0.0;
#endif
static char yo[]="hunt_problem";
/*
* BEGIN EXECUTION
*/
#ifdef DEBUG
fprintf(stderr, "hunt_problem() begins...\n");
#endif
toler_org[0] = custom_tol1;
toler_org[1] = custom_tol2;
toler_org[2] = custom_tol3;
damp_org = damp_factor1;
is_steady_state = TRUE;
p_gsize = &gsize;
/*
* set aside space for gather global vectors to print to exoII file
* note: this is temporary
*
* For 2D prototype problem: allocate space for T, dx, dy arrays
*/
if( strlen( Soln_OutFile) )
{
#ifdef DEBUG
printf("Trying to open \"%s\" for writing.\n", Soln_OutFile);
#endif
file = fopen(Soln_OutFile, "w");
if (file == NULL) {
DPRINTF(stderr, "%s: opening soln file for writing\n", yo);
EH(-1, "\t");
}
}
#ifdef PARALLEL
check_parallel_error("Soln output file error");
#endif
/*
* Some preliminaries to help setup EXODUS II database output.
*/
#ifdef DEBUG
fprintf(stderr, "cnt_nodal_vars() begins...\n");
#endif
tnv = cnt_nodal_vars();
/* tnv_post is calculated in load_nodal_tkn*/
tev = cnt_elem_vars();
/* tev_post is calculated in load_elem_tkn*/
#ifdef DEBUG
fprintf(stderr, "Found %d total primitive nodal variables to output.\n", tnv);
fprintf(stderr, "Found %d total primitive elem variables to output.\n", tev);
#endif
if ( tnv < 0 )
{
DPRINTF(stderr, "%s:\tbad tnv.\n", yo);
EH(-1, "\t");
}
if ( tev < 0 )
{
DPRINTF(stderr, "%s:\tMaybe bad tev? See goma design committee ;) \n", yo);
/* exit(-1); */
}
rd = (struct Results_Description *)
smalloc(sizeof(struct Results_Description));
if (rd == NULL)
{ EH(-1, "Could not grab Results Description."); }
(void) memset((void *) rd, 0, sizeof(struct Results_Description));
rd->nev = 0; /* number element variables in results */
rd->ngv = 0; /* number global variables in results */
rd->nhv = 0; /* number history variables in results */
if ( is_steady_state == TRUE ) {
rd->ngv = 5; /* number global variables in results
see load_global_var_info for names*/
error = load_global_var_info(rd, 0, "CONV");
error = load_global_var_info(rd, 1, "NEWT_IT");
error = load_global_var_info(rd, 2, "MAX_IT");
error = load_global_var_info(rd, 3, "CONVRATE");
error = load_global_var_info(rd, 4, "MESH_VOLUME");
}
/* load nodal types, kinds, names */
error = load_nodal_tkn( rd,
&tnv,
&tnv_post); /* load nodal types, kinds, names */
if (error !=0)
{
DPRINTF(stderr, "%s: problem with load_nodal_tkn()\n", yo);
EH(-1,"\t");
}
/* load elem types, names */
error = load_elem_tkn( rd,
exo,
tev,
&tev_post); /* load elem types, names */
if ( error !=0 )
{
DPRINTF(stderr, "%s: problem with load_elem_tkn()\n", yo);
EH(-1,"\t");
}
/*
* Write out the names of the nodal variables that we will be sending to
* the EXODUS II output file later.
*/
#ifdef DEBUG
fprintf(stderr, "wr_result_prelim() starts...\n", tnv);
#endif
gvec_elem = (double ***) smalloc ( (exo->num_elem_blocks)*sizeof(double **));
for (i = 0; i < exo->num_elem_blocks; i++) {
gvec_elem[i] = (double **) smalloc ( (tev + tev_post)*sizeof(double *));
}
wr_result_prelim_exo( rd,
exo,
ExoFileOut,
gvec_elem );
#ifdef DEBUG
fprintf(stderr, "P_%d: wr_result_prelim_exo() ends...\n", ProcID, tnv);
#endif
/*
* This gvec workhorse transports output variables as nodal based vectors
* that are gather from the solution vector. Note: it is NOT a global
* vector at all and only carries this processor's nodal variables to
* the exodus database.
*/
asdv(&gvec, Num_Node);
/*
* Allocate space and manipulate for all the nodes that this processor
* is aware of...
*/
num_total_nodes = dpi->num_universe_nodes;
numProcUnknowns = NumUnknowns + NumExtUnknowns;
/* allocate memory for Volume Constraint Jacobian. ACS 2/99 */
if ( nAC > 0)
{
for(iAC=0;iAC<nAC;iAC++) {
augc[iAC].d_evol_dx = (double*) malloc(numProcUnknowns*sizeof(double));
} }
asdv(&resid_vector, numProcUnknowns);
asdv(&resid_vector_sens, numProcUnknowns);
asdv(&scale, numProcUnknowns);
for (i=0;i<NUM_ALSS;i++)
{
ams[i] = (struct Aztec_Linear_Solver_System *)
array_alloc(1, 1, sizeof(struct Aztec_Linear_Solver_System ));
}
#ifdef MPI
AZ_set_proc_config( ams[0]->proc_config, MPI_COMM_WORLD );
#ifndef COUPLED_FILL
if( Explicit_Fill ) AZ_set_proc_config( ams[1]->proc_config, MPI_COMM_WORLD );
#endif /* not COUPLED_FILL */
#else /* MPI */
AZ_set_proc_config( ams[0]->proc_config, 0 );
#ifndef COUPLED_FILL
if( Explicit_Fill ) AZ_set_proc_config( ams[1]->proc_config, 0 );
#endif /* not COUPLED_FILL */
#endif /* MPI */
/*
* allocate space for and initialize solution arrays
*/
asdv(&x, numProcUnknowns);
asdv(&x_old, numProcUnknowns);
asdv(&x_older, numProcUnknowns);
asdv(&x_oldest, numProcUnknowns);
asdv(&xdot, numProcUnknowns);
asdv(&xdot_old, numProcUnknowns);
asdv(&x_update, numProcUnknowns);
asdv(&x_sens, numProcUnknowns);
/*
* Initialize solid inertia flag
*/
set_solid_inertia();
/*
* ALLOCATE ALL THOSE WORK VECTORS FOR HUNTING
*/
asdv(&lambda, nHC);
asdv(&lambdaEnd, nHC);
asdv(&path, nHC);
asdv(&path1, nHC);
asdv(&hDelta_s0, nHC);
asdv(&hDelta_s_min, nHC);
asdv(&hDelta_s_max, nHC);
asdv(&delta_s, nHC);
asdv(&delta_s_new, nHC);
asdv(&delta_s_old, nHC);
asdv(&delta_s_older, nHC);
asdv(&delta_s_oldest, nHC);
aldALC = Ivector_birth(nHC);
const_delta_s = Ivector_birth(nHC);
/*
HUNTING BY ZERO AND FIRST ORDER CONTINUATION
*/
alqALC = 1;
damp = 1.0;
delta_t = 0.0;
tran->delta_t = 0.0; /*for Newmark-Beta terms in Lagrangian Solid*/
nprint = 0;
MaxPathSteps = cont->MaxPathSteps;
eps = cont->eps;
for (iHC=0;iHC<nHC;iHC++) {
const_delta_s[iHC] = 0;
lambda[iHC] = hunt[iHC].BegParameterValue;
lambdaEnd[iHC] = hunt[iHC].EndParameterValue;
if ((lambdaEnd[iHC]-lambda[iHC]) > 0.0)
{
aldALC[iHC] = +1;
}
else
{
aldALC[iHC] = -1;
}
if (hunt[iHC].ramp == 1) {
hunt[iHC].Delta_s0 = fabs(lambdaEnd[iHC]-lambda[iHC])/((double)(MaxPathSteps-1));
const_delta_s[iHC] = 1;
}
hDelta_s0[iHC] = hunt[iHC].Delta_s0;
hDelta_s_min[iHC] = hunt[iHC].Delta_s_min;
hDelta_s_max[iHC] = hunt[iHC].Delta_s_max;
path[iHC] = path1[iHC] = lambda[iHC];
if (Debug_Flag && ProcID == 0) {
fprintf(stderr,"MaxPathSteps: %d \tlambdaEnd: %f\n", MaxPathSteps, lambdaEnd[iHC]);
fprintf(stderr,"continuation in progress\n");
}
if (hDelta_s0[iHC] > hDelta_s_max[iHC])
{
hDelta_s0[iHC] = hDelta_s_max[iHC];
}
delta_s[iHC] = delta_s_old[iHC] = delta_s_older[iHC] = hDelta_s0[iHC];
/*
* ADJUST NATURAL PARAMETER
*/
update_parameterHC(iHC, path1[iHC], x, xdot, x_AC, delta_s[iHC], cx, exo, dpi);
}
/* define continuation parameter */
if(hunt[0].EndParameterValue == hunt[0].BegParameterValue)
{ hunt_par = 1.0; }
else
{
hunt_par = (path1[0]-hunt[0].BegParameterValue)
/(hunt[0].EndParameterValue - hunt[0].BegParameterValue) ;
hunt_par=fabs(hunt_par);
}
hunt_par_old = hunt_par;
/* Call prefront (or mf_setup) if necessary */
if (Linear_Solver == FRONT)
{
/* Also got to define these because it wants pointers to these numbers */
max_unk_elem = (MAX_PROB_VAR + MAX_CONC)*MDE;
one = 1;
three = 3;
/* NOTE: We need a overall flag in the vn_glob struct that tells whether FULL_DG
is on anywhere in domain. This assumes only one material. See sl_front_setup for test.
that test needs to be in the input parser. */
if(vn_glob[0]->dg_J_model == FULL_DG)
{
max_unk_elem = (MAX_PROB_VAR + MAX_CONC)*MDE + 4*vn_glob[0]->modes*4*MDE;
}
if (Num_Proc > 1) EH(-1, "Whoa. No front allowed with nproc>1");
#ifdef HAVE_FRONT
err = mf_setup(&exo->num_elems,
&NumUnknowns,
&max_unk_elem,
&three,
&one,
exo->elem_order_map,
fss->el_proc_assign,
fss->level,
fss->nopdof,
fss->ncn,
fss->constraint,
front_scratch_directory,
&fss->ntra);
EH(err,"problems in frontal setup ");
#else
EH(-1,"Don't have frontal solver compiled and linked in");
#endif
}
/*
* if compute parameter sensitivities, allocate space for solution
* sensitivity vectors
*/
for(i=0;i<nn_post_fluxes_sens;i++) {
num_pvector=MAX(num_pvector,pp_fluxes_sens[i]->vector_id);}
for(i=0;i<nn_post_data_sens;i++) {
num_pvector=MAX(num_pvector,pp_data_sens[i]->vector_id);}
if((nn_post_fluxes_sens + nn_post_data_sens) > 0)
{
num_pvector++;
num_pvector = MAX(num_pvector,2);
x_sens_p = Dmatrix_birth(num_pvector,numProcUnknowns);
}
else
{
x_sens_p = NULL;
}
if (nAC > 0)
{
asdv(&x_AC, nAC);
asdv(&x_AC_old, nAC);
asdv(&x_AC_dot, nAC);
}
/* Allocate sparse matrix */
if( strcmp( Matrix_Format, "msr" ) == 0)
{
log_msg("alloc_MSR_sparse_arrays...");
alloc_MSR_sparse_arrays(&ija,
&a,
&a_old,
0,
node_to_fill,
exo,
dpi);
/*
* An attic to store external dofs column names is needed when
* running in parallel.
*/
alloc_extern_ija_buffer(num_universe_dofs,
num_internal_dofs+num_boundary_dofs,
ija, &ija_attic);
/*
* Any necessary one time initialization of the linear
* solver package (Aztec).
*/
ams[JAC]->bindx = ija;
ams[JAC]->val = a;
ams[JAC]->belfry = ija_attic;
ams[JAC]->val_old = a_old;
/*
* These point to nowhere since we're using MSR instead of VBR
* format.
*/
ams[JAC]->indx = NULL;
ams[JAC]->bpntr = NULL;
ams[JAC]->rpntr = NULL;
ams[JAC]->cpntr = NULL;
ams[JAC]->npn = dpi->num_internal_nodes + dpi->num_boundary_nodes;
ams[JAC]->npn_plus = dpi->num_internal_nodes + dpi->num_boundary_nodes + dpi->num_external_nodes;
ams[JAC]->npu = num_internal_dofs+num_boundary_dofs;
ams[JAC]->npu_plus = num_universe_dofs;
ams[JAC]->nnz = ija[num_internal_dofs+num_boundary_dofs] - 1;
ams[JAC]->nnz_plus = ija[num_universe_dofs];
}
else if( strcmp( Matrix_Format, "vbr" ) == 0)
{
log_msg("alloc_VBR_sparse_arrays...");
alloc_VBR_sparse_arrays ( ams[JAC],
exo,
dpi);
ija_attic = NULL;
ams[JAC]->belfry = ija_attic;
a = ams[JAC]->val;
if( !save_old_A ) a_old = ams[JAC]->val_old;
}
else if ( strcmp( Matrix_Format, "front") == 0 )
{
/* Don't allocate any sparse matrix space when using front */
ams[JAC]->bindx = NULL;
ams[JAC]->val = NULL;
ams[JAC]->belfry = NULL;
ams[JAC]->val_old = NULL;
ams[JAC]->indx = NULL;
ams[JAC]->bpntr = NULL;
ams[JAC]->rpntr = NULL;
ams[JAC]->cpntr = NULL;
}
else
{
EH(-1,"Attempted to allocate unknown sparse matrix format");
}
init_vec(x, cx, exo, dpi, x_AC, nAC, &timeValueRead);
/* if read ACs, update data floats */
if (nAC > 0)
{
if(augc[0].iread == 1)
{
for(iAC=0 ; iAC<nAC ; iAC++)
{ update_parameterAC(iAC, x, xdot, x_AC, cx, exo, dpi); }
}
}
/*
* set boundary conditions on the initial conditions
*/
find_and_set_Dirichlet(x, xdot, exo, dpi);
exchange_dof(cx, dpi, x);
dcopy1(numProcUnknowns,x,x_old);
dcopy1(numProcUnknowns,x_old,x_older);
dcopy1(numProcUnknowns,x_older,x_oldest);
if( nAC > 0)
{
dcopy1(nAC,x_AC, x_AC_old);}
/*
* initialize the counters for when to print out data
*/
step_print = 1;
matrix_systems_mask = 1;
log_msg("sl_init()...");
sl_init(matrix_systems_mask, ams, exo, dpi, cx);
#ifdef PARALLEL
/*
* Make sure the solver was properly initialized on all processors.
*/
check_parallel_error("Solver initialization problems");
#endif
ams[JAC]->options[AZ_keep_info] = 1;
DPRINTF(stderr, "\nINITIAL ELEMENT QUALITY CHECK---\n");
good_mesh = element_quality(exo, x, ams[0]->proc_config);
/*
* set the number of successful path steps to zero
*/
nt = 0;
/*
* LOOP THROUGH PARAMETER UNTIL MAX NUMBER
* OF STEPS SURPASSED
*/
for (n=0;n<MaxPathSteps;n++) {
alqALC = 1;
for (iHC=0;iHC<nHC;iHC++) {
switch (aldALC[iHC]) {
case -1: /* REDUCING PARAMETER DIRECTION */
if (path1[iHC] <= lambdaEnd[iHC]) {
alqALC = -1;
path1[iHC] = lambdaEnd[iHC];
delta_s[iHC] = path[iHC]-path1[iHC];
}
break;
case +1: /* RISING PARAMETER DIRECTION */
if (path1[iHC] >= lambdaEnd[iHC]) {
alqALC = -1;
path1[iHC] = lambdaEnd[iHC];
delta_s[iHC] = path1[iHC]-path[iHC];
}
break;
}
/*
* ADJUST NATURAL PARAMETER
*/
update_parameterHC(iHC, path1[iHC], x, xdot, x_AC, delta_s[iHC], cx, exo, dpi);
} /* end of iHC loop */
if(hunt[0].EndParameterValue == hunt[0].BegParameterValue)
{ hunt_par = 1.0; }
else
{
hunt_par = (path1[0]-hunt[0].BegParameterValue)
/(hunt[0].EndParameterValue - hunt[0].BegParameterValue) ;
hunt_par=fabs(hunt_par);
}
/*
* IF STEP CHANGED, REDO FIRST ORDER PREDICTION
*/
if(alqALC == -1)
{
DPRINTF(stderr,"\n\t ******** LAST PATH STEP!\n");
dcopy1(numProcUnknowns,x_old,x);
dhunt_par = hunt_par-hunt_par_old;
switch (Continuation) {
case HUN_ZEROTH:
break;
case HUN_FIRST:
v1add(numProcUnknowns, &x[0], dhunt_par, &x_sens[0]);
break;
}
}
/*
* reset Dirichlet condition Mask, node->DBC to -1 where it
* is set in order for Dirichlet conditions to be
* set appropriately for each path step
*/
nullify_dirichlet_bcs();
find_and_set_Dirichlet (x, xdot, exo, dpi);
exchange_dof(cx, dpi, x);
if(ProcID ==0) {
DPRINTF(stderr, "\n\t----------------------------------");
switch (Continuation) {
case HUN_ZEROTH:
DPRINTF(stderr, "\n\tZero Order Hunting:");
break;
case HUN_FIRST:
DPRINTF(stderr, "\n\tFirst Order Hunting:");
break; }
DPRINTF(stderr, "\n\tStep number: %4d of %4d (max)", n+1, MaxPathSteps);
DPRINTF(stderr, "\n\tAttempting solution at: theta = %g",hunt_par);
for (iHC=0;iHC<nHC;iHC++) {
switch (hunt[iHC].Type) {
case 1: /* BC */
DPRINTF(stderr, "\n\tBCID=%3d DFID=%5d", hunt[iHC].BCID, hunt[iHC].DFID);
break;
case 2: /* MT */
DPRINTF(stderr, "\n\tMTID=%3d MPID=%5d", hunt[iHC].MTID, hunt[iHC].MPID);
break;
case 3: /* AC */
DPRINTF(stderr, "\n\tACID=%3d DFID=%5d", hunt[iHC].BCID, hunt[iHC].DFID);
break;
}
DPRINTF(stderr, " Parameter= % 10.6e delta_s= %10.6e", path1[iHC], delta_s[iHC]);
}
}
ni = 0;
do {
#ifdef DEBUG
fprintf(stderr, "%s: starting solve_nonlinear_problem\n", yo);
#endif
err = solve_nonlinear_problem(ams[JAC],
x,
delta_t,
theta,
x_old,
x_older,
xdot,
xdot_old,
resid_vector,
x_update,
scale,
&converged,
&nprint,
tev,
tev_post,
NULL,
rd,
gindex,
p_gsize,
gvec,
gvec_elem,
path1[0],
exo,
dpi,
cx,
0,
&path_step_reform,
is_steady_state,
x_AC,
x_AC_dot,
hunt_par,
resid_vector_sens,
x_sens,
x_sens_p,
NULL);
#ifdef DEBUG
fprintf(stderr, "%s: returned from solve_nonlinear_problem\n", yo);
#endif
if (err == -1) converged = 0;
inewton = err;
if (converged)
{
EH(error, "error writing ASCII soln file."); /* srs need to check */
if (Write_Intermediate_Solutions == 0) {
#ifdef DEBUG
fprintf(stderr, "%s: write_solution call WIS\n", yo);
#endif
write_solution(ExoFileOut, resid_vector, x, x_sens_p, x_old,
xdot, xdot_old, tev, tev_post,NULL, rd, gindex,
p_gsize, gvec, gvec_elem, &nprint, delta_s[0],
theta, path1[0], NULL, exo, dpi);
#ifdef DEBUG
fprintf(stderr, "%s: write_solution end call WIS\n", yo);
#endif
}
/*
* PRINT OUT VALUES OF EXTRA UNKNOWNS
* FROM AUGMENTING CONDITIONS
*/
if (nAC > 0)
{
DPRINTF(stderr, "\n------------------------------\n");
DPRINTF(stderr, "Augmenting Conditions: %4d\n", nAC);
DPRINTF(stderr, "Number of extra unknowns: %4d\n\n", nAC);
for (iAC = 0; iAC < nAC; iAC++)
{
if (augc[iAC].Type == AC_USERBC)
{
DPRINTF(stderr, "\tAC[%4d] DF[%4d] = %10.6e\n",
augc[iAC].BCID, augc[iAC].DFID, x_AC[iAC]);
}
else if (augc[iAC].Type == AC_USERMAT ||
augc[iAC].Type == AC_FLUX_MAT )
{
DPRINTF(stderr, "\n MT[%4d] MP[%4d] = %10.6e\n",
augc[iAC].MTID, augc[iAC].MPID, x_AC[iAC]);
}
else if(augc[iAC].Type == AC_VOLUME)
{
evol_local = augc[iAC].evol;
#ifdef PARALLEL
if( Num_Proc > 1 ) {
MPI_Allreduce( &evol_local, &evol_global, 1,
MPI_DOUBLE, MPI_SUM, MPI_COMM_WORLD);
}
evol_local = evol_global;
#endif
DPRINTF(stderr, "\tMT[%4d] VC[%4d]=%10.6e Param=%10.6e\n",
augc[iAC].MTID, augc[iAC].VOLID, evol_local,
x_AC[iAC]);
}
else if(augc[iAC].Type == AC_POSITION)
{
evol_local = augc[iAC].evol;
#ifdef PARALLEL
if( Num_Proc > 1 ) {
MPI_Allreduce( &evol_local, &evol_global, 1,
MPI_DOUBLE, MPI_SUM, MPI_COMM_WORLD);
}
evol_local = evol_global;
#endif
DPRINTF(stderr, "\tMT[%4d] XY[%4d]=%10.6e Param=%10.6e\n",
augc[iAC].MTID, augc[iAC].VOLID, evol_local,
x_AC[iAC]);
}
else if(augc[iAC].Type == AC_FLUX)
{
DPRINTF(stderr, "\tBC[%4d] DF[%4d]=%10.6e\n",
augc[iAC].BCID, augc[iAC].DFID, x_AC[iAC]);
}
}
}
/* Check element quality */
good_mesh = element_quality(exo, x, ams[0]->proc_config);
/*
INTEGRATE FLUXES, FORCES
*/
for (i = 0; i < nn_post_fluxes; i++)
{
err_dbl = evaluate_flux ( exo, dpi,
pp_fluxes[i]->ss_id,
pp_fluxes[i]->flux_type ,
pp_fluxes[i]->flux_type_name ,
pp_fluxes[i]->blk_id ,
pp_fluxes[i]->species_number,
pp_fluxes[i]->flux_filenm,
pp_fluxes[i]->profile_flag,
x,xdot,NULL,delta_s[0],path1[0],1);
}
/*
COMPUTE FLUX, FORCE SENSITIVITIES
*/
for (i = 0; i < nn_post_fluxes_sens; i++)
{
err_dbl = evaluate_flux_sens ( exo, dpi,
pp_fluxes_sens[i]->ss_id,
pp_fluxes_sens[i]->flux_type ,
pp_fluxes_sens[i]->flux_type_name ,
pp_fluxes_sens[i]->blk_id ,
pp_fluxes_sens[i]->species_number,
pp_fluxes_sens[i]->sens_type,
pp_fluxes_sens[i]->sens_id,
pp_fluxes_sens[i]->sens_flt,
pp_fluxes_sens[i]->sens_flt2,
pp_fluxes_sens[i]->vector_id,
pp_fluxes_sens[i]->flux_filenm,
pp_fluxes_sens[i]->profile_flag,
x,xdot,x_sens_p,delta_s[0],path1[0],1);
}
/*
* Compute global volumetric quantities
*/
for (i = 0; i < nn_volume; i++ ) {
evaluate_volume_integral(exo, dpi,
pp_volume[i]->volume_type,
pp_volume[i]->volume_name,
pp_volume[i]->blk_id,
pp_volume[i]->species_no,
pp_volume[i]->volume_fname,
pp_volume[i]->params,
NULL, x, xdot, delta_s[0],
path1[0], 1);
}
} /* end of if converged block */
/*
* INCREMENT COUNTER
*/
ni++;
/*
*
* DID IT CONVERGE ?
* IF NOT, REDUCE STEP SIZE AND TRY AGAIN
*
*/
if (!converged) {
if (ni > 10) {
DPRINTF(stderr,"\n ************************************\n");
DPRINTF(stderr," W: Did not converge in Newton steps.\n");
DPRINTF(stderr," Find better initial guess. \n");
DPRINTF(stderr," ************************************\n");
exit(0);
}
/*
* ADJUST STEP SIZE - unless failed on first step
*/
if ( nt != 0 )
{
DPRINTF(stderr, "\n\tFailed to converge:\n");
for (iHC=0;iHC<nHC;iHC++) {
delta_s[iHC] *= 0.5;
switch (aldALC[iHC]) {
case -1:
path1[iHC] = path[iHC] - delta_s[iHC];
break;
case +1:
path1[iHC] = path[iHC] + delta_s[iHC];
break;
}
/*
* RESET
*/
alqALC = 1;
DPRINTF(stderr, "Decreasing step-length to %10.6e.\n", delta_s[iHC]);
if (delta_s[iHC] < hDelta_s_min[iHC]) {
DPRINTF(stderr,"\n X: C step-length reduced below minimum.");
DPRINTF(stderr,"\n Program terminated.\n");
/* This needs to have a return value of 0, indicating
* success, for the continuation script to not treat this
* as a failed command. */
exit(0);
}
#ifdef PARALLEL
check_parallel_error("\t");
#endif
/*
* ADJUST NATURAL PARAMETER
*/
update_parameterHC(iHC, path1[iHC], x, xdot, x_AC, delta_s[iHC], cx, exo, dpi);
} /* end of iHC loop */
if(hunt[0].EndParameterValue == hunt[0].BegParameterValue)
{ hunt_par = 1.0; }
else
{
hunt_par = (path1[0]-hunt[0].BegParameterValue)
/(hunt[0].EndParameterValue - hunt[0].BegParameterValue) ;
hunt_par=fabs(hunt_par);
}
/*
* GET ZERO OR FIRST ORDER PREDICTION
*/
dhunt_par = hunt_par-hunt_par_old;
switch (Continuation) {
case HUN_ZEROTH:
vcopy(numProcUnknowns, &x[0], 1.0, &x_old[0]);
break;
case HUN_FIRST:
v2sum(numProcUnknowns, &x[0], 1.0, &x_old[0], dhunt_par, &x_sens[0]);
break;
}
/* MMH: Needed to put this in, o/w it may find that the
* solution and residual HAPPEN to satisfy the convergence
* criterion for the next newton solve...
*/
find_and_set_Dirichlet(x, xdot, exo, dpi);
exchange_dof(cx, dpi, x);
if (nAC > 0)
{
dcopy1(nAC, x_AC_old, x_AC);
for(iAC=0 ; iAC<nAC ; iAC++)
{ update_parameterAC(iAC, x, xdot, x_AC, cx, exo, dpi); }
}
if(hunt[0].EndParameterValue == hunt[0].BegParameterValue)
{ hunt_par = 1.0; }
else
{
hunt_par = (path1[0]-hunt[0].BegParameterValue)
/(hunt[0].EndParameterValue - hunt[0].BegParameterValue) ;
hunt_par=fabs(hunt_par);
}
}
else if (inewton == -1)
{
DPRINTF(stderr,"\nHmm... trouble on first step \n Let's try some more relaxation \n");
if((damp_factor1 <= 1. && damp_factor1 >= 0.) &&
(damp_factor2 <= 1. && damp_factor2 >= 0.) &&
(damp_factor3 <= 1. && damp_factor3 >= 0.))
{
custom_tol1 *= 0.01;
custom_tol2 *= 0.01;
custom_tol3 *= 0.01;
DPRINTF(stderr," custom tolerances %g %g %g \n",custom_tol1,custom_tol2,custom_tol3);
}
else
{
damp_factor1 *= 0.5;
DPRINTF(stderr," damping factor %g \n",damp_factor1);
}
vcopy(numProcUnknowns, &x[0], 1.0, &x_old[0]);
/* MMH: Needed to put this in, o/w it may find that the
* solution and residual HAPPEN to satisfy the convergence
* criterion for the next newton solve...
*/
find_and_set_Dirichlet(x, xdot, exo, dpi);
exchange_dof(cx, dpi, x);
if (nAC > 0)
{
dcopy1(nAC, x_AC_old, x_AC);
for(iAC=0 ; iAC<nAC ; iAC++)
{ update_parameterAC(iAC, x, xdot, x_AC, cx, exo, dpi); }
}
}
else
{
DPRINTF(stderr,"\nHmm... could not converge on first step\n Let's try some more iterations\n");
if((damp_factor1 <= 1. && damp_factor1 >= 0.) &&
(damp_factor2 <= 1. && damp_factor2 >= 0.) &&
(damp_factor3 <= 1. && damp_factor3 >= 0.))
{
custom_tol1 *= 100.;
custom_tol2 *= 100.;
custom_tol3 *= 100.;
DPRINTF(stderr," custom tolerances %g %g %g \n",custom_tol1,custom_tol2,custom_tol3);
}
else
{
damp_factor1 *= 2.0;
damp_factor1 = MIN(damp_factor1,1.0);
DPRINTF(stderr," damping factor %g \n",damp_factor1);
}
}
} /* end of !converged */
} while (converged == 0);
/*
* CONVERGED
*/
nt++;
custom_tol1 = toler_org[0];
custom_tol2 = toler_org[1];
custom_tol3 = toler_org[2];
damp_factor1 = damp_org;
DPRINTF(stderr,
"\n\tStep accepted, theta (proportion complete) = %10.6e\n",
hunt_par);
for (iHC=0;iHC<nHC;iHC++) {
switch (hunt[iHC].Type) {
case 1: /* BC */
DPRINTF(stderr, "\tStep accepted, BCID=%3d DFID=%5d",
hunt[iHC].BCID, hunt[iHC].DFID);
break;
case 2: /* MT */
DPRINTF(stderr, "\tStep accepted, MTID=%3d MPID=%5d",
hunt[iHC].MTID, hunt[iHC].MPID);
break;
case 3: /* AC */
DPRINTF(stderr, "\tStep accepted, ACID=%3d DFID=%5d",
hunt[iHC].BCID, hunt[iHC].DFID);
break;
}
DPRINTF(stderr, " Parameter= % 10.6e\n", path1[iHC]);
}
/*
* check path step error, if too large do not enlarge path step
*/
for (iHC=0;iHC<nHC;iHC++) {
if ((ni == 1) && (n != 0) && (!const_delta_s[iHC]))
{
delta_s_new[iHC] = path_step_control(num_total_nodes,
delta_s[iHC], delta_s_old[iHC],
x,
eps,
&success_ds,
cont->use_var_norm, inewton);
if (delta_s_new[iHC] > hDelta_s_max[iHC]) {delta_s_new[iHC] = hDelta_s_max[iHC];}
}
else
{
success_ds = 1;
delta_s_new[iHC] = delta_s[iHC];
}
}
/*
* determine whether to print out the data or not
*/
i_print = 0;
if (nt == step_print) {
i_print = 1;
step_print += cont->print_freq; }
if (alqALC == -1)
{ i_print = 1; }
if (i_print) {
error = write_ascii_soln(x, resid_vector, numProcUnknowns,
x_AC, nAC, path1[0], file);
if (error) {
DPRINTF(stderr, "%s: error writing ASCII soln file\n", yo);
}
if ( Write_Intermediate_Solutions == 0 ) {
write_solution(ExoFileOut, resid_vector, x, x_sens_p,
x_old, xdot, xdot_old, tev, tev_post, NULL,
rd, gindex, p_gsize, gvec, gvec_elem, &nprint,
delta_s[0], theta, path1[0], NULL, exo, dpi);
nprint++;
}
}
/*
* backup old solutions
* can use previous solutions for prediction one day
*/
dcopy1(numProcUnknowns,x_older,x_oldest);
dcopy1(numProcUnknowns,x_old,x_older);
dcopy1(numProcUnknowns,x,x_old);
dcopy1(nHC,delta_s_older,delta_s_oldest);
dcopy1(nHC,delta_s_old ,delta_s_older );
dcopy1(nHC,delta_s ,delta_s_old );
dcopy1(nHC,delta_s_new ,delta_s );
/*
delta_s_oldest = delta_s_older;
delta_s_older = delta_s_old;
delta_s_old = delta_s;
delta_s = delta_s_new;
*/
hunt_par_old=hunt_par;
if ( nAC > 0) {
dcopy1(nAC, x_AC, x_AC_old);
}
/*
* INCREMENT/DECREMENT PARAMETER
*/
for (iHC=0;iHC<nHC;iHC++) {
path[iHC] = path1[iHC];
switch (aldALC[iHC]) {
case -1:
path1[iHC] = path[iHC] - delta_s[iHC];
break;
case +1:
path1[iHC] = path[iHC] + delta_s[iHC];
break;
}
/*
* ADJUST NATURAL PARAMETER
*/
update_parameterHC(iHC, path1[iHC], x, xdot, x_AC, delta_s[iHC], cx, exo, dpi);
} /* end of iHC loop */
/*
* GET FIRST ORDER PREDICTION
*/
if(hunt[0].EndParameterValue == hunt[0].BegParameterValue)
{ hunt_par = 1.0; }
else
{
hunt_par = (path1[0]-hunt[0].BegParameterValue)
/(hunt[0].EndParameterValue - hunt[0].BegParameterValue) ;
hunt_par=fabs(hunt_par);
}
dhunt_par = hunt_par-hunt_par_old;
switch (Continuation) {
case HUN_ZEROTH:
break;
case HUN_FIRST:
v1add(numProcUnknowns, &x[0], dhunt_par, &x_sens[0]);
break; }
if (!good_mesh) goto free_and_clear;
/*
*
* CHECK END CONTINUATION
*
*/
if (alqALC == -1)
{ alqALC = 0; }
else
{ alqALC = 1; }
if (alqALC == 0) {
DPRINTF(stderr,"\n\n\t I will continue no more!\n\t No more continuation for you!\n");
goto free_and_clear;
}
} /* n */
if(n == MaxPathSteps &&
aldALC[0] * (lambdaEnd[0] - path[0]) > 0)
{
DPRINTF(stderr,"\n\tFailed to reach end of hunt in maximum number of successful steps (%d).\n\tSorry.\n",
MaxPathSteps);
exit(0);
}
#ifdef PARALLEL
check_parallel_error("Hunting error");
#endif
/*
* DONE CONTINUATION
*/
free_and_clear:
/*
* Transform the node point coordinates according to the
* displacements and write out all the results using the
* displaced coordinates. Set the displacement field to
* zero, too.
*/
if (Anneal_Mesh) {
#ifdef DEBUG
fprintf(stderr, "%s: anneal_mesh()...\n", yo);
#endif
err = anneal_mesh(x, tev, tev_post, NULL, rd, path1[0], exo, dpi);
#ifdef DEBUG
DPRINTF(stderr, "%s: anneal_mesh()-done\n", yo);
#endif
EH(err, "anneal_mesh() bad return.");
}
/*
* Free a bunch of variables that aren't needed anymore
*/
safer_free((void **) &ROT_Types);
safer_free((void **) &node_to_fill);
safer_free( (void **) &resid_vector);
safer_free( (void **) &resid_vector_sens);
safer_free( (void **) &scale);
safer_free( (void **) &x);
if (nAC > 0) {
safer_free( (void **) &x_AC);
safer_free( (void **) &x_AC_old);
safer_free( (void **) &x_AC_dot);
}
safer_free( (void **) &x_old);
safer_free( (void **) &x_older);
safer_free( (void **) &x_oldest);
safer_free( (void **) &xdot);
safer_free( (void **) &xdot_old);
safer_free( (void **) &x_update);
safer_free( (void **) &x_sens);
if((nn_post_data_sens+nn_post_fluxes_sens) > 0)
Dmatrix_death(x_sens_p,num_pvector,numProcUnknowns);
for(i = 0; i < MAX_NUMBER_MATLS; i++) {
for(n = 0; n < MAX_MODES; n++) {
safer_free((void **) &(ve_glob[i][n]->gn));
safer_free((void **) &(ve_glob[i][n]));
}
safer_free((void **) &(vn_glob[i]));
}
sl_free(matrix_systems_mask, ams);
for (i=0;i<NUM_ALSS;i++) {
safer_free( (void**) &(ams[i]));
}
safer_free( (void **) &gvec);
safer_free( (void **) &lambda);
safer_free( (void **) &lambdaEnd);
safer_free( (void **) &path);
safer_free( (void **) &path1);
safer_free( (void **) &hDelta_s0);
safer_free( (void **) &hDelta_s_min);
safer_free( (void **) &hDelta_s_max);
safer_free( (void **) &delta_s);
safer_free( (void **) &delta_s_new);
safer_free( (void **) &delta_s_old);
safer_free( (void **) &delta_s_older);
safer_free( (void **) &delta_s_oldest);
Ivector_death(&aldALC[0], nHC);
Ivector_death(&const_delta_s[0], nHC);
i = 0;
for ( eb_indx = 0; eb_indx < exo->num_elem_blocks; eb_indx++ ) {
for ( ev_indx = 0; ev_indx < rd->nev; ev_indx++ ) {
if ( exo->elem_var_tab[i++] == 1 ) {
safer_free ((void **) &(gvec_elem [eb_indx][ev_indx]) );
}
}
safer_free ((void **) &(gvec_elem [eb_indx]));
}
safer_free( (void **) &gvec_elem);
safer_free( (void **) &rd);
safer_free( (void **) &Local_Offset);
safer_free( (void **) &Dolphin);
if( strlen( Soln_OutFile) )
{
fclose(file);
}
return;
} /* END of routine hunt_problem */
int
get_new_coord(double *new_coord[DIM],
double *x,
const Exo_DB *exo )
{
int p,i,j;
int dim = exo->num_dim;
int num_nodes = exo->num_nodes;
int displacement_somewhere = FALSE;
int ln;
int *moved;
int e_start = exo->eb_ptr[0];
int e_end = exo->eb_ptr[exo->num_elem_blocks];
int ielem;
int gnn;
int var;
double phi[MDE];
for(p = 0; p < dim; p++)
{
new_coord[p] = (double *) calloc(num_nodes, sizeof(double));
dcopy1( num_nodes, Coor[p], new_coord[p] );
}
for(p = 0; p < upd->Num_Mat; p++)
displacement_somewhere |= ( pd_glob[p]->e[R_MESH1] );
if ( displacement_somewhere == FALSE ) return (FALSE );
moved = (int *) calloc( num_nodes, sizeof(int) );
/*
* Loop through nodes, find displacement, and add it into
* the coordinate
*/
for(ielem = e_start; ielem < e_end; ielem++)
{
double displacement[DIM];
load_elem_dofptr(ielem, exo, x, x, x, x, x, 1);
for(ln = 0; ln < ei->num_local_nodes; ln++)
{
double xi[3] = {0.0, 0.0, 0.0};
find_nodal_stu(ln, ei->ielem_type, xi, xi+1, xi+2);
gnn = exo->elem_node_list[ exo->elem_node_pntr[ielem] + ln ] ;
memset(displacement, 0, sizeof(double)*DIM);
if( moved[gnn] != 1 )
{
for(p = 0; p < DIM; p++)
{
var = MESH_DISPLACEMENT1 + p;
for(i = 0; i < ei->dof[var]; i++)
{
phi[i] = newshape(xi,
ei->ielem_type,
PSI,
ei->dof_list[var][i],
ei->ielem_shape,
pd->i[var],
i);
}
if( pd->v[var] )
{
for(j = 0; j < ei->dof[var]; j++)
{
displacement[p] += *esp->d[p][j] * phi[j];
}
moved[gnn] = 1;
}
else
displacement[p] = 0.0;
}
}
for(p = 0; p < dim; p++)
new_coord[p][gnn] += displacement[p];
}
}
safer_free((void **) &moved);
return( TRUE );
}
