void FCVDenseJac(long int N, DenseMat J, realtype t,
N_Vector y, N_Vector fy, void *jac_data,
N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3)
{
N_Vector ewt;
realtype *ydata, *fydata, *jacdata, *ewtdata, *v1data, *v2data, *v3data;
realtype h;
ewt = N_VClone(y);
CVodeGetErrWeights(CV_cvodemem, ewt);
CVodeGetLastStep(CV_cvodemem, &h);
ydata = N_VGetArrayPointer(y);
fydata = N_VGetArrayPointer(fy);
v1data = N_VGetArrayPointer(vtemp1);
v2data = N_VGetArrayPointer(vtemp2);
v3data = N_VGetArrayPointer(vtemp3);
ewtdata = N_VGetArrayPointer(ewt);
jacdata = DENSE_COL(J,0);
FCV_DJAC(&N, &t, ydata, fydata, jacdata,
ewtdata, &h, v1data, v2data, v3data);
N_VDestroy(ewt);
}
void FCVBandJac(long int N, long int mupper, long int mlower,
BandMat J, realtype t,
N_Vector y, N_Vector fy, void *jac_data,
N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3)
{
N_Vector ewt;
realtype *ydata, *fydata, *jacdata, *ewtdata, *v1data, *v2data, *v3data;
realtype h;
long int eband;
ewt = N_VClone(y);
CVodeGetErrWeights(CV_cvodemem, ewt);
CVodeGetLastStep(CV_cvodemem, &h);
ydata = N_VGetArrayPointer(y);
fydata = N_VGetArrayPointer(fy);
v1data = N_VGetArrayPointer(vtemp1);
v2data = N_VGetArrayPointer(vtemp2);
v3data = N_VGetArrayPointer(vtemp3);
ewtdata = N_VGetArrayPointer(ewt);
eband = (J->smu) + mlower + 1;
jacdata = BAND_COL(J,0) - mupper;
FCV_BJAC(&N, &mupper, &mlower, &eband,
&t, ydata, fydata, jacdata,
ewtdata, &h, v1data, v2data, v3data);
N_VDestroy(ewt);
}
void FCV_GETERRWEIGHTS(realtype *eweight, int *ier)
{
/* Attach user data to vector */
realtype *f2c_data = N_VGetArrayPointer(F2C_CVODE_vec);
N_VSetArrayPointer(eweight, F2C_CVODE_vec);
*ier = 0;
*ier = CVodeGetErrWeights(CV_cvodemem, F2C_CVODE_vec);
/* Reset data pointers */
N_VSetArrayPointer(f2c_data, F2C_CVODE_vec);
return;
}
string CVodesIntegrator::getErrorInfo(int N)
{
N_Vector errs = N_VNew_Serial(static_cast<sd_size_t>(m_neq));
N_Vector errw = N_VNew_Serial(static_cast<sd_size_t>(m_neq));
CVodeGetErrWeights(m_cvode_mem, errw);
CVodeGetEstLocalErrors(m_cvode_mem, errs);
vector<tuple<double, double, size_t> > weightedErrors;
for (size_t i=0; i<m_neq; i++) {
double err = NV_Ith_S(errs, i) * NV_Ith_S(errw, i);
weightedErrors.emplace_back(-abs(err), err, i);
}
N_VDestroy(errs);
N_VDestroy(errw);
N = std::min(N, static_cast<int>(m_neq));
sort(weightedErrors.begin(), weightedErrors.end());
stringstream s;
for (int i=0; i<N; i++) {
s << get<2>(weightedErrors[i]) << ": "
<< get<1>(weightedErrors[i]) << endl;
}
return s.str();
}
/*
This routine generates the block-diagonal part of the Jacobian
corresponding to the interaction rates, multiplies by -gamma, adds
the identity matrix, and calls denseGETRF to do the LU decomposition of
each diagonal block. The computation of the diagonal blocks uses
the preset block and grouping information. One block per group is
computed. The Jacobian elements are generated by difference
quotients using calls to the routine fblock.
This routine can be regarded as a prototype for the general case
of a block-diagonal preconditioner. The blocks are of size mp, and
there are ngrp=ngx*ngy blocks computed in the block-grouping scheme.
*/
static int Precond(realtype t, N_Vector c, N_Vector fc,
booleantype jok, booleantype *jcurPtr, realtype gamma,
void *user_data, N_Vector vtemp1, N_Vector vtemp2,
N_Vector vtemp3)
{
realtype ***P;
long int **pivot, ier;
int i, if0, if00, ig, igx, igy, j, jj, jx, jy;
int *jxr, *jyr, ngrp, ngx, ngy, mxmp, flag;
long int mp;
realtype uround, fac, r, r0, save, srur;
realtype *f1, *fsave, *cdata, *rewtdata;
WebData wdata;
void *cvode_mem;
N_Vector rewt;
wdata = (WebData) user_data;
cvode_mem = wdata->cvode_mem;
cdata = NV_DATA_S(c);
rewt = wdata->rewt;
flag = CVodeGetErrWeights(cvode_mem, rewt);
if(check_flag(&flag, "CVodeGetErrWeights", 1)) return(1);
rewtdata = NV_DATA_S(rewt);
uround = UNIT_ROUNDOFF;
P = wdata->P;
pivot = wdata->pivot;
jxr = wdata->jxr;
jyr = wdata->jyr;
mp = wdata->mp;
srur = wdata->srur;
ngrp = wdata->ngrp;
ngx = wdata->ngx;
ngy = wdata->ngy;
mxmp = wdata->mxmp;
fsave = wdata->fsave;
/* Make mp calls to fblock to approximate each diagonal block of Jacobian.
Here, fsave contains the base value of the rate vector and
r0 is a minimum increment factor for the difference quotient. */
f1 = NV_DATA_S(vtemp1);
fac = N_VWrmsNorm (fc, rewt);
r0 = RCONST(1000.0)*ABS(gamma)*uround*NEQ*fac;
if (r0 == ZERO) r0 = ONE;
for (igy = 0; igy < ngy; igy++) {
jy = jyr[igy];
if00 = jy*mxmp;
for (igx = 0; igx < ngx; igx++) {
jx = jxr[igx];
if0 = if00 + jx*mp;
ig = igx + igy*ngx;
/* Generate ig-th diagonal block */
for (j = 0; j < mp; j++) {
/* Generate the jth column as a difference quotient */
jj = if0 + j;
save = cdata[jj];
r = MAX(srur*ABS(save),r0/rewtdata[jj]);
cdata[jj] += r;
fac = -gamma/r;
fblock (t, cdata, jx, jy, f1, wdata);
for (i = 0; i < mp; i++) {
P[ig][j][i] = (f1[i] - fsave[if0+i])*fac;
}
cdata[jj] = save;
}
}
}
/* Add identity matrix and do LU decompositions on blocks. */
for (ig = 0; ig < ngrp; ig++) {
denseAddIdentity(P[ig], mp);
ier = denseGETRF(P[ig], mp, mp, pivot[ig]);
if (ier != 0) return(1);
}
*jcurPtr = TRUE;
return(0);
}
int Cvode::calcJacobian(double t, long int N, N_Vector fHelp, N_Vector errorWeight, N_Vector jthCol, double* y, N_Vector fy, DlsMat Jac)
{
try
{
int l,g;
double fnorm, minInc, *f_data, *fHelp_data, *errorWeight_data, h, srur, delta_inv;
f_data = NV_DATA_S(fy);
errorWeight_data = NV_DATA_S(errorWeight);
fHelp_data = NV_DATA_S(fHelp);
//Get relevant info
_idid = CVodeGetErrWeights(_cvodeMem, errorWeight);
if (_idid < 0)
{
_idid = -5;
throw ModelicaSimulationError(SOLVER,"Cvode::calcJacobian()");
}
_idid = CVodeGetCurrentStep(_cvodeMem, &h);
if (_idid < 0)
{
_idid = -5;
throw ModelicaSimulationError(SOLVER,"Cvode::calcJacobian()");
}
srur = sqrt(UROUND);
fnorm = N_VWrmsNorm(fy, errorWeight);
minInc = (fnorm != 0.0) ?
(1000.0 * abs(h) * UROUND * N * fnorm) : 1.0;
for(int j=0;j<N;j++)
{
_delta[j] = max(srur*abs(y[j]), minInc/errorWeight_data[j]);
}
for(int j=0;j<N;j++)
{
_deltaInv[j] = 1/_delta[j];
}
if (_jacobianANonzeros != 0)
{
for(int color=1; color <= _maxColors; color++)
{
for(int k=0; k < _dimSys; k++)
{
if((_colorOfColumn[k] ) == color)
{
_ysave[k] = y[k];
y[k]+= _delta[k];
}
}
calcFunction(t, y, fHelp_data);
for (int k = 0; k < _dimSys; k++)
{
if((_colorOfColumn[k]) == color)
{
y[k] = _ysave[k];
int startOfColumn = k * _dimSys;
for (int j = _jacobianALeadindex[k]; j < _jacobianALeadindex[k+1];j++)
{
l = _jacobianAIndex[j];
g = l + startOfColumn;
Jac->data[g] = (fHelp_data[l] - f_data[l]) * _deltaInv[k];
}
}
}
}
}
}
/*
//Calculation of J without colouring
for (j = 0; j < N; j++)
{
//N_VSetArrayPointer(DENSE_COL(Jac,j), jthCol);
_ysave[j] = y[j];
y[j] += _delta[j];
calcFunction(t, y, fHelp_data);
y[j] = _ysave[j];
delta_inv = 1.0/_delta[j];
N_VLinearSum(delta_inv, fHelp, -delta_inv, fy, jthCol);
for(int i=0; i<_dimSys; ++i)
{
Jac->data[i+j*_dimSys] = NV_Ith_S(jthCol,i);
}
//DENSE_COL(Jac,j) = N_VGetArrayPointer(jthCol);
}
*/
//workaround until exception can be catch from c- libraries
catch (std::exception & ex )
{
cerr << "CVode integration error: " << ex.what();
return 1;
}
return 0;
}
static int PrecondB(realtype t, N_Vector c,
N_Vector cB, N_Vector fcB, booleantype jok,
booleantype *jcurPtr, realtype gamma,
void *user_data)
{
int N, retval;
realtype ***P;
sunindextype **pivot;
int i, if0, if00, ig, igx, igy, j, jj, jx, jy;
int *jxr, *jyr, ngrp, ngx, ngy, mxmp;
sunindextype mp, denseretval;
realtype uround, fac, r, r0, save, srur;
realtype *f1, *fsave, *cdata, *rewtdata;
void *cvode_mem;
WebData wdata;
N_Vector rewt;
wdata = (WebData) user_data;
cvode_mem = CVodeGetAdjCVodeBmem(wdata->cvode_mem, wdata->indexB);
if(check_retval((void *)cvode_mem, "CVadjGetCVodeBmem", 0)) return(1);
rewt = wdata->rewt;
retval = CVodeGetErrWeights(cvode_mem, rewt);
if(check_retval(&retval, "CVodeGetErrWeights", 1)) return(1);
cdata = N_VGetArrayPointer(c);
rewtdata = N_VGetArrayPointer(rewt);
uround = UNIT_ROUNDOFF;
P = wdata->P;
pivot = wdata->pivot;
jxr = wdata->jxr;
jyr = wdata->jyr;
mp = wdata->mp;
srur = wdata->srur;
ngrp = wdata->ngrp;
ngx = wdata->ngx;
ngy = wdata->ngy;
mxmp = wdata->mxmp;
fsave = wdata->fsave;
/* Make mp calls to fblock to approximate each diagonal block of Jacobian.
Here, fsave contains the base value of the rate vector and
r0 is a minimum increment factor for the difference quotient. */
f1 = N_VGetArrayPointer(wdata->vtemp);
fac = N_VWrmsNorm (fcB, rewt);
N = NEQ;
r0 = RCONST(1000.0)*SUNRabs(gamma)*uround*N*fac;
if (r0 == ZERO) r0 = ONE;
for (igy = 0; igy < ngy; igy++) {
jy = jyr[igy];
if00 = jy*mxmp;
for (igx = 0; igx < ngx; igx++) {
jx = jxr[igx];
if0 = if00 + jx*mp;
ig = igx + igy*ngx;
/* Generate ig-th diagonal block */
for (j = 0; j < mp; j++) {
/* Generate the jth column as a difference quotient */
jj = if0 + j;
save = cdata[jj];
r = SUNMAX(srur*SUNRabs(save),r0/rewtdata[jj]);
cdata[jj] += r;
fac = gamma/r;
fblock (t, cdata, jx, jy, f1, wdata);
for (i = 0; i < mp; i++) {
P[ig][i][j] = (f1[i] - fsave[if0+i])*fac;
}
cdata[jj] = save;
}
}
}
/* Add identity matrix and do LU decompositions on blocks. */
for (ig = 0; ig < ngrp; ig++) {
denseAddIdentity(P[ig], mp);
denseretval = denseGETRF(P[ig], mp, mp, pivot[ig]);
if (denseretval != 0) return(1);
}
*jcurPtr = SUNTRUE;
return(0);
}
