static int IDAfnorm(IDAMem IDA_mem, realtype *fnorm)
{
int retval, is;
/* Get residual vector F, return if failed, and save F in savres. */
retval = res(t0, ynew, ypnew, delnew, user_data);
nre++;
if(retval < 0) return(IDA_RES_FAIL);
if(retval > 0) return(IC_FAIL_RECOV);
N_VScale(ONE, delnew, savres);
/* Call the linear solve function to get J-inverse F; return if failed. */
retval = lsolve(IDA_mem, delnew, ewt, ynew, ypnew, savres);
if(retval < 0) return(IDA_LSOLVE_FAIL);
if(retval > 0) return(IC_FAIL_RECOV);
/* Compute the WRMS-norm. */
*fnorm = IDAWrmsNorm(IDA_mem, delnew, ewt, FALSE);
/* Are we computing SENSITIVITIES with the IDA_SIMULTANEOUS approach? */
if(sensi && (ism==IDA_SIMULTANEOUS)) {
/* Evaluate the residual for sensitivities. */
retval = resS(Ns, t0,
ynew, ypnew, savres,
yyS0new, ypS0new, delnewS,
user_dataS, tmpS1, tmpS2, tmpS3);
nrSe++;
if(retval < 0) return(IDA_RES_FAIL);
if(retval > 0) return(IC_FAIL_RECOV);
/* Save delnewS in savresS. */
for(is=0; is<Ns; is++)
N_VScale(ONE, delnewS[is], savresS[is]);
/* Call the linear solve function to get J-inverse deltaS. */
for(is=0; is<Ns; is++) {
retval = lsolve(IDA_mem, delnewS[is], ewtS[is], ynew, ypnew, savres);
if(retval < 0) return(IDA_LSOLVE_FAIL);
if(retval > 0) return(IC_FAIL_RECOV);
}
/* Include sensitivities in norm. */
*fnorm = IDASensWrmsNormUpdate(IDA_mem, *fnorm, delnewS, ewtS, FALSE);
}
/* Rescale norm if index = 0. */
if(sysindex == 0) (*fnorm) *= tscale*SUNRabs(cj);
return(IDA_SUCCESS);
}
static int IDAfnorm(IDAMem IDA_mem, realtype *fnorm)
{
int retval;
/* Get residual vector F, return if failed, and save F in savres. */
retval = res(t0, ynew, ypnew, delnew, user_data);
nre++;
if(retval < 0) return(IDA_RES_FAIL);
if(retval > 0) return(IC_FAIL_RECOV);
N_VScale(ONE, delnew, savres);
/* Call the linear solve function to get J-inverse F; return if failed. */
retval = lsolve(IDA_mem, delnew, ewt, ynew, ypnew, savres);
if(retval < 0) return(IDA_LSOLVE_FAIL);
if(retval > 0) return(IC_FAIL_RECOV);
/* Compute the WRMS-norm; rescale if index = 0. */
*fnorm = IDAWrmsNorm(IDA_mem, delnew, ewt, FALSE);
if(sysindex == 0) (*fnorm) *= tscale*SUNRabs(cj);
return(IDA_SUCCESS);
}
static int IDASensfnorm(IDAMem IDA_mem, realtype *fnorm)
{
int is, retval;
/* Get sensitivity residual */
retval = resS(Ns, t0,
yy0, yp0, delta,
yyS0new, ypS0new, delnewS,
user_dataS, tmpS1, tmpS2, tmpS3);
nrSe++;
if(retval < 0) return(IDA_RES_FAIL);
if(retval > 0) return(IC_FAIL_RECOV);
for(is=0; is<Ns; is++) N_VScale(ONE, delnewS[is], savresS[is]);
/* Call linear solve function */
for(is=0; is<Ns; is++) {
retval = lsolve(IDA_mem, delnewS[is], ewtS[is], yy0, yp0, delta);
if(retval < 0) return(IDA_LSOLVE_FAIL);
if(retval > 0) return(IC_FAIL_RECOV);
}
/* Compute the WRMS-norm; rescale if index = 0. */
*fnorm = IDASensWrmsNorm(IDA_mem, delnewS, ewtS, FALSE);
if(sysindex == 0) (*fnorm) *= tscale*SUNRabs(cj);
return(IDA_SUCCESS);
}
static int cpNewtonIterationImpl(CPodeMem cp_mem)
{
int m, retval;
realtype del, delp, dcon;
/* Initialize counters */
mnewt = m = 0;
/* Initialize delp to avoid compiler warning message */
del = delp = ZERO;
/* Looping point for Newton iteration */
loop {
/* Evaluate the residual of the nonlinear system*/
N_VScale(-gamma, ftemp, tempv);
/* Call the lsolve function (solution in tempv) */
retval = lsolve(cp_mem, tempv, ewt, y, yp, ftemp);
nni++;
if (retval < 0) return(CP_LSOLVE_FAIL);
if (retval > 0) return(CONV_FAIL);
/* Get WRMS norm of correction and add correction to acor, y, and yp */
del = N_VWrmsNorm(tempv, ewt);
N_VLinearSum(ONE, acor, ONE, tempv, acor);
N_VLinearSum(ONE, y, ONE, tempv, y);
N_VLinearSum(ONE, yp, ONE/gamma, tempv, yp);
/* Test for convergence. If m > 0, an estimate of the convergence
rate constant is stored in crate, and used in the test. */
if (m > 0) crate = MAX(NLS_CRDOWN * crate, del/delp);
dcon = del * MIN(ONE, crate) / tq[4];
if (dcon <= ONE) {
acnrm = (m==0) ? del : N_VWrmsNorm(acor, ewt);
return(CP_SUCCESS);
}
mnewt = ++m;
/* Stop at maxcor iterations or if iter. seems to be diverging. */
if ((m == maxcor) || ((m >= 2) && (del > NLS_RDIV*delp))) return(CONV_FAIL);
/* Save norm of correction, evaluate f, and loop again */
delp = del;
retval = fi(tn, y, yp, ftemp, f_data);
nfe++;
if (retval < 0) return(CP_ODEFUNC_FAIL);
if (retval > 0) return(ODEFUNC_RECVR);
} /* end loop */
}
static int IDANewtonIC(IDAMem IDA_mem)
{
int retval, mnewt;
realtype delnorm, fnorm, fnorm0, oldfnrm, rate;
/* Set pointer for vector delnew */
delnew = phi[2];
/* Call the linear solve function to get the Newton step, delta. */
retval = lsolve(IDA_mem, delta, ewt, yy0, yp0, savres);
if(retval < 0) return(IDA_LSOLVE_FAIL);
if(retval > 0) return(IC_FAIL_RECOV);
/* Compute the norm of the step; return now if this is small. */
fnorm = IDAWrmsNorm(IDA_mem, delta, ewt, FALSE);
if(sysindex == 0) fnorm *= tscale*SUNRabs(cj);
if(fnorm <= epsNewt) return(IDA_SUCCESS);
fnorm0 = fnorm;
/* Initialize rate to avoid compiler warning message */
rate = ZERO;
/* Newton iteration loop */
for(mnewt = 0; mnewt < maxnit; mnewt++) {
nni++;
delnorm = fnorm;
oldfnrm = fnorm;
/* Call the Linesearch function and return if it failed. */
retval = IDALineSrch(IDA_mem, &delnorm, &fnorm);
if(retval != IDA_SUCCESS) return(retval);
/* Set the observed convergence rate and test for convergence. */
rate = fnorm/oldfnrm;
if(fnorm <= epsNewt) return(IDA_SUCCESS);
/* If not converged, copy new step vector, and loop. */
N_VScale(ONE, delnew, delta);
} /* End of Newton iteration loop */
/* Return either IC_SLOW_CONVRG or recoverable fail flag. */
if(rate <= ICRATEMAX || fnorm < PT1*fnorm0) return(IC_SLOW_CONVRG);
return(IC_CONV_FAIL);
}
/*
* -----------------------------------------------------------------
* IDASensNewtonIC
* -----------------------------------------------------------------
* IDANewtonIC performs the Newton iteration to solve for
* sensitivities consistent initial conditions. It calls
* IDASensLineSrch within each iteration.
* On return, savresS contains the current residual vectors.
*
* The return value is IDA_SUCCESS = 0 if no error occurred.
* The error return values (positive) considered recoverable are:
* IC_FAIL_RECOV if res or lsolve failed recoverably
* IC_CONSTR_FAILED if the constraints could not be met
* IC_LINESRCH_FAILED if the linesearch failed (on steptol test)
* IC_CONV_FAIL if the Newton iterations failed to converge
* IC_SLOW_CONVRG if the iterations appear to be converging slowly.
* They failed the convergence test, but showed
* an overall norm reduction (by a factor of < 0.1)
* or a convergence rate <= ICRATEMAX).
* The error return values (negative) considered non-recoverable are:
* IDA_RES_FAIL if res had a non-recoverable error
* IDA_LSOLVE_FAIL if lsolve had a non-recoverable error
* -----------------------------------------------------------------
*/
static int IDASensNewtonIC(IDAMem IDA_mem)
{
int retval, is, mnewt;
realtype delnorm, fnorm, fnorm0, oldfnrm, rate;
for(is=0;is<Ns;is++) {
/* Call the linear solve function to get the Newton step, delta. */
retval = lsolve(IDA_mem, deltaS[is], ewtS[is], yy0, yp0, delta);
if(retval < 0) return(IDA_LSOLVE_FAIL);
if(retval > 0) return(IC_FAIL_RECOV);
}
/* Compute the norm of the step and return if it is small enough */
fnorm = IDASensWrmsNorm(IDA_mem, deltaS, ewtS, FALSE);
if(sysindex == 0) fnorm *= tscale*SUNRabs(cj);
if(fnorm <= epsNewt) return(IDA_SUCCESS);
fnorm0 = fnorm;
rate = ZERO;
/* Newton iteration loop */
for(mnewt = 0; mnewt < maxnit; mnewt++) {
nniS++;
delnorm = fnorm;
oldfnrm = fnorm;
/* Call the Linesearch function and return if it failed. */
retval = IDASensLineSrch(IDA_mem, &delnorm, &fnorm);
if(retval != IDA_SUCCESS) return(retval);
/* Set the observed convergence rate and test for convergence. */
rate = fnorm/oldfnrm;
if(fnorm <= epsNewt) return(IDA_SUCCESS);
/* If not converged, copy new step vectors, and loop. */
for(is=0; is<Ns; is++) N_VScale(ONE, delnewS[is], deltaS[is]);
} /* End of Newton iteration loop */
/* Return either IC_SLOW_CONVRG or recoverable fail flag. */
if(rate <= ICRATEMAX || fnorm < PT1*fnorm0) return(IC_SLOW_CONVRG);
return(IC_CONV_FAIL);
}
static int KINLinSolDrv(KINMem kin_mem, N_Vector bb, N_Vector xx)
{
int ret;
if (nni - nnilpre >= msbpre)
pthrsh = TWO;
loop {
precondcurrent = FALSE;
if ((pthrsh > ONEPT5) && setupNonNull)
{
/* Call precondset routine */
ret = lsetup(kin_mem);
precondcurrent = TRUE;
nnilpre = nni;
if (ret != 0)
return(KINSOL_PRECONDSET_FAILURE);
}
/* load bb with the current value of fval */
N_VScale(-ONE, fval, bb);
/* call the generic 'lsolve' routine to solve the system J x = b */
ret = lsolve(kin_mem, xx, bb, &res_norm);
if (ret != 1)
return(ret);
if (!precondflag)
return(KINSOL_KRYLOV_FAILURE);
if (precondcurrent)
return(KINSOL_KRYLOV_FAILURE);
/* loop back only if the preconditioner is in use and is not current */
pthrsh = TWO;
} /* end of loop */
}
static int IDANewtonIC(IDAMem IDA_mem)
{
int retval, mnewt;
realtype delnorm, fnorm, fnorm0, oldfnrm, rate;
//---OPENCOR--- BEGIN
unsigned char *uc;
//---OPENCOR--- END
/* Set pointer for vector delnew */
delnew = phi[2];
/* Call the linear solve function to get the Newton step, delta. */
retval = lsolve(IDA_mem, delta, ewt, yy0, yp0, savres);
if(retval < 0) return(IDA_LSOLVE_FAIL);
if(retval > 0) return(IC_FAIL_RECOV);
/* Compute the norm of the step; return now if this is small. */
fnorm = IDAWrmsNorm(IDA_mem, delta, ewt, FALSE);
if(sysindex == 0) fnorm *= tscale*ABS(cj);
if(fnorm <= epsNewt) return(IDA_SUCCESS);
//---OPENCOR--- BEGIN
// Note #1: when trying to retrieve consistent initial conditions, the user may
// have provided some (very) bad initial conditions, in which case
// fnorm won't have a finite value. This means that we won't be able to
// retrieve consistent initial conditions. So, IDA really ought to
// check that fnorm has a finite value and, if not, then return with
// some error code...
// Note #2: the code to test whether a value is finite comes from Qt. It's just
// that using it directly would require a C++ compiler while we would
// rather stick to a C compiler whenever possible since this will avoid
// potential warnings because of differences between C and C++...
uc = (unsigned char *) &fnorm;
#if Q_BYTE_ORDER == Q_BIG_ENDIAN
if (((uc[0] & 0x7F) == 0x7F) && ((uc[1] & 0xF0) == 0xF0))
return IC_CONV_FAIL;
#else
if (((uc[7] & 0x7F) == 0x7F) && ((uc[6] & 0xF0) == 0xF0))
return IC_CONV_FAIL;
#endif
//---OPENCOR--- END
fnorm0 = fnorm;
/* Initialize rate to avoid compiler warning message */
rate = ZERO;
/* Newton iteration loop */
for(mnewt = 0; mnewt < maxnit; mnewt++) {
nni++;
delnorm = fnorm;
oldfnrm = fnorm;
/* Call the Linesearch function and return if it failed. */
retval = IDALineSrch(IDA_mem, &delnorm, &fnorm);
if(retval != IDA_SUCCESS) return(retval);
/* Set the observed convergence rate and test for convergence. */
rate = fnorm/oldfnrm;
if(fnorm <= epsNewt) return(IDA_SUCCESS);
/* If not converged, copy new step vector, and loop. */
N_VScale(ONE, delnew, delta);
} /* End of Newton iteration loop */
/* Return either IC_SLOW_CONVRG or recoverable fail flag. */
if(rate <= ICRATEMAX || fnorm < PT1*fnorm0) return(IC_SLOW_CONVRG);
return(IC_CONV_FAIL);
}
static int cpNewtonIterationExpl(CPodeMem cp_mem)
{
int m, retval;
realtype del, delp, dcon;
N_Vector b;
mnewt = m = 0;
/* Initialize delp to avoid compiler warning message */
del = delp = ZERO;
/* Looping point for Newton iteration */
loop {
#ifdef CPODES_DEBUG
printf(" Iteration # %d\n",m);
#endif
#ifdef CPODES_DEBUG_SERIAL
printf(" zn[0] = "); N_VPrint_Serial(zn[0]);
printf(" zn[1] = "); N_VPrint_Serial(zn[1]);
printf(" ewt = "); N_VPrint_Serial(ewt);
printf(" acor = "); N_VPrint_Serial(acor);
printf(" ftemp = "); N_VPrint_Serial(ftemp);
#endif
/* Evaluate the residual of the nonlinear system*/
N_VLinearSum(rl1, zn[1], ONE, acor, tempv);
N_VLinearSum(gamma, ftemp, -ONE, tempv, tempv);
/* Call the lsolve function */
b = tempv;
#ifdef CPODES_DEBUG
printf(" Linear solver solve\n");
#endif
#ifdef CPODES_DEBUG_SERIAL
printf(" rhs = "); N_VPrint_Serial(b);
#endif
retval = lsolve(cp_mem, b, ewt, y, NULL, ftemp);
#ifdef CPODES_DEBUG_SERIAL
printf(" sol = "); N_VPrint_Serial(b);
#endif
#ifdef CPODES_DEBUG
printf(" Linear solver solve return value = %d\n",retval);
#endif
nni++;
if (retval < 0) return(CP_LSOLVE_FAIL);
if (retval > 0) return(CONV_FAIL);
/* Get WRMS norm of correction; add correction to acor and y */
del = N_VWrmsNorm(b, ewt);
#ifdef CPODES_DEBUG
printf(" Norm of correction: del = %lg\n", del);
#endif
N_VLinearSum(ONE, acor, ONE, b, acor);
N_VLinearSum(ONE, zn[0], ONE, acor, y);
/* Test for convergence. If m > 0, an estimate of the convergence
rate constant is stored in crate, and used in the test. */
if (m > 0) {
crate = MAX(NLS_CRDOWN * crate, del/delp);
}
dcon = del * MIN(ONE, crate) / tq[4];
#ifdef CPODES_DEBUG
printf(" Convergence test dcon = %lg\n", dcon);
#endif
if (dcon <= ONE) {
acnrm = (m==0) ? del : N_VWrmsNorm(acor, ewt);
#ifdef CPODES_DEBUG_SERIAL
printf(" acor = "); N_VPrint_Serial(acor);
#endif
#ifdef CPODES_DEBUG
printf(" Accumulated correction norm = %lg\n", acnrm);
#endif
jcur = FALSE;
return(CP_SUCCESS); /* Nonlinear system was solved successfully */
}
mnewt = ++m;
/* Stop at maxcor iterations or if iter. seems to be diverging. */
if ((m == maxcor) || ((m >= 2) && (del > NLS_RDIV*delp))) return(CONV_FAIL);
/* Save norm of correction, evaluate f, and loop again */
delp = del;
retval = fe(tn, y, ftemp, f_data);
nfe++;
if (retval < 0) return(CP_ODEFUNC_FAIL);
if (retval > 0) return(ODEFUNC_RECVR);
} /* end loop */
}
ex lsolve(const ex &eqns, const ex &symbols, unsigned options)
{
// solve a system of linear equations
if (eqns.info(info_flags::relation_equal)) {
if (!symbols.info(info_flags::symbol))
throw(std::invalid_argument("lsolve(): 2nd argument must be a symbol"));
const ex sol = lsolve(lst{eqns}, lst{symbols});
GINAC_ASSERT(sol.nops()==1);
GINAC_ASSERT(is_exactly_a<relational>(sol.op(0)));
return sol.op(0).op(1); // return rhs of first solution
}
// syntax checks
if (!eqns.info(info_flags::list)) {
throw(std::invalid_argument("lsolve(): 1st argument must be a list or an equation"));
}
for (size_t i=0; i<eqns.nops(); i++) {
if (!eqns.op(i).info(info_flags::relation_equal)) {
throw(std::invalid_argument("lsolve(): 1st argument must be a list of equations"));
}
}
if (!symbols.info(info_flags::list)) {
throw(std::invalid_argument("lsolve(): 2nd argument must be a list or a symbol"));
}
for (size_t i=0; i<symbols.nops(); i++) {
if (!symbols.op(i).info(info_flags::symbol)) {
throw(std::invalid_argument("lsolve(): 2nd argument must be a list of symbols"));
}
}
// build matrix from equation system
matrix sys(eqns.nops(),symbols.nops());
matrix rhs(eqns.nops(),1);
matrix vars(symbols.nops(),1);
for (size_t r=0; r<eqns.nops(); r++) {
const ex eq = eqns.op(r).op(0)-eqns.op(r).op(1); // lhs-rhs==0
ex linpart = eq;
for (size_t c=0; c<symbols.nops(); c++) {
const ex co = eq.coeff(ex_to<symbol>(symbols.op(c)),1);
linpart -= co*symbols.op(c);
sys(r,c) = co;
}
linpart = linpart.expand();
rhs(r,0) = -linpart;
}
// test if system is linear and fill vars matrix
for (size_t i=0; i<symbols.nops(); i++) {
vars(i,0) = symbols.op(i);
if (sys.has(symbols.op(i)))
throw(std::logic_error("lsolve: system is not linear"));
if (rhs.has(symbols.op(i)))
throw(std::logic_error("lsolve: system is not linear"));
}
matrix solution;
try {
solution = sys.solve(vars,rhs,options);
} catch (const std::runtime_error & e) {
// Probably singular matrix or otherwise overdetermined system:
// It is consistent to return an empty list
return lst{};
}
GINAC_ASSERT(solution.cols()==1);
GINAC_ASSERT(solution.rows()==symbols.nops());
// return list of equations of the form lst{var1==sol1,var2==sol2,...}
lst sollist;
for (size_t i=0; i<symbols.nops(); i++)
sollist.append(symbols.op(i)==solution(i,0));
return sollist;
}
static int IDANewtonIC(IDAMem IDA_mem)
{
int retval, mnewt, is;
realtype delnorm, fnorm, fnorm0, oldfnrm, rate;
booleantype sensi_sim;
/* Are we computing sensitivities with the IDA_SIMULTANEOUS approach? */
sensi_sim = (sensi && (ism==IDA_SIMULTANEOUS));
/* Set pointer for vector delnew */
delnew = phi[2];
/* Call the linear solve function to get the Newton step, delta. */
retval = lsolve(IDA_mem, delta, ewt, yy0, yp0, savres);
if(retval < 0) return(IDA_LSOLVE_FAIL);
if(retval > 0) return(IC_FAIL_RECOV);
/* Compute the norm of the step. */
fnorm = IDAWrmsNorm(IDA_mem, delta, ewt, FALSE);
/* Call the lsolve function to get correction vectors deltaS. */
if (sensi_sim) {
for(is=0;is<Ns;is++) {
retval = lsolve(IDA_mem, deltaS[is], ewtS[is], yy0, yp0, savres);
if(retval < 0) return(IDA_LSOLVE_FAIL);
if(retval > 0) return(IC_FAIL_RECOV);
}
/* Update the norm of delta. */
fnorm = IDASensWrmsNormUpdate(IDA_mem, fnorm, deltaS, ewtS, FALSE);
}
/* Test for convergence. Return now if the norm is small. */
if(sysindex == 0) fnorm *= tscale*SUNRabs(cj);
if(fnorm <= epsNewt) return(IDA_SUCCESS);
fnorm0 = fnorm;
/* Initialize rate to avoid compiler warning message */
rate = ZERO;
/* Newton iteration loop */
for(mnewt = 0; mnewt < maxnit; mnewt++) {
nni++;
delnorm = fnorm;
oldfnrm = fnorm;
/* Call the Linesearch function and return if it failed. */
retval = IDALineSrch(IDA_mem, &delnorm, &fnorm);
if(retval != IDA_SUCCESS) return(retval);
/* Set the observed convergence rate and test for convergence. */
rate = fnorm/oldfnrm;
if(fnorm <= epsNewt) return(IDA_SUCCESS);
/* If not converged, copy new step vector, and loop. */
N_VScale(ONE, delnew, delta);
if(sensi_sim) {
/* Update the iteration's step for sensitivities. */
for(is=0; is<Ns; is++)
N_VScale(ONE, delnewS[is], deltaS[is]);
}
} /* End of Newton iteration loop */
/* Return either IC_SLOW_CONVRG or recoverable fail flag. */
if(rate <= ICRATEMAX || fnorm < PT1*fnorm0) return(IC_SLOW_CONVRG);
return(IC_CONV_FAIL);
}
