void FIDA_GETERRWEIGHTS(realtype *eweight, int *ier)
{
/* Attach user data to vector */
N_VSetArrayPointer(eweight, F2C_IDA_vec);
*ier = 0;
*ier = IDAGetErrWeights(IDA_idamem, F2C_IDA_vec);
/* Reset data pointer */
N_VSetArrayPointer(NULL, F2C_IDA_vec);
return;
}
void FIDA_GETERRWEIGHTS(realtype *eweight, int *ier)
{
/* Store existing F2C_IDA_vec data pointer */
realtype *f2c_data = N_VGetArrayPointer(F2C_IDA_vec);
/* Attach user data to vector */
N_VSetArrayPointer(eweight, F2C_IDA_vec);
*ier = 0;
*ier = IDAGetErrWeights(IDA_idamem, F2C_IDA_vec);
/* Reset data pointer */
N_VSetArrayPointer(f2c_data, F2C_IDA_vec);
return;
}
int FIDALapackBandJac(long int N, long int mupper, long int mlower,
realtype t, realtype c_j,
N_Vector yy, N_Vector yp, N_Vector rr,
DlsMat J, void *user_data,
N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3)
{
realtype *yy_data, *yp_data, *rr_data, *jacdata, *ewtdata, *v1data, *v2data, *v3data;
realtype h;
long int eband;
int ier;
FIDAUserData IDA_userdata;
/* Initialize all pointers to NULL */
yy_data = yp_data = rr_data = jacdata = ewtdata = NULL;
v1data = v2data = v3data = NULL;
/* NOTE: The user-supplied routine should set ier to an
appropriate value, but we preset the value to zero
(meaning SUCCESS) so the user need only reset the
value if an error occurred */
ier = 0;
IDAGetErrWeights(IDA_idamem, F2C_IDA_ewtvec);
IDAGetLastStep(IDA_idamem, &h);
/* Get pointers to vector data */
yy_data = N_VGetArrayPointer(yy);
yp_data = N_VGetArrayPointer(yp);
rr_data = N_VGetArrayPointer(rr);
ewtdata = N_VGetArrayPointer(F2C_IDA_ewtvec);
v1data = N_VGetArrayPointer(vtemp1);
v2data = N_VGetArrayPointer(vtemp2);
v3data = N_VGetArrayPointer(vtemp3);
eband = (J->s_mu) + mlower + 1;
jacdata = BAND_COL(J,0) - mupper;
IDA_userdata = (FIDAUserData) user_data;
/* Call user-supplied routine */
FIDA_BJAC(&N, &mupper, &mlower, &eband, &t, yy_data, yp_data, rr_data,
&c_j, jacdata, ewtdata, &h,
IDA_userdata->ipar, IDA_userdata->rpar,
v1data, v2data, v3data, &ier);
return(ier);
}
int FIDAJtimes(realtype t, N_Vector yy, N_Vector yp, N_Vector rr,
N_Vector v, N_Vector Jv,
realtype c_j, void *jac_data,
N_Vector vtemp1, N_Vector vtemp2)
{
realtype *yy_data, *yp_data, *rr_data, *vdata, *Jvdata, *ewtdata;
realtype *v1data, *v2data;
realtype h;
FIDAUserData IDA_userdata;
int ier;
/* Initialize all pointers to NULL */
yy_data = yp_data = rr_data = vdata = Jvdata = ewtdata = NULL;
/* NOTE: The user-supplied routine should set ier to an
appropriate value, but we preset the value to zero
(meaning SUCCESS) so the user need only reset the
value if an error occurred */
ier = 0;
IDAGetErrWeights(IDA_idamem, F2C_IDA_ewtvec);
IDAGetLastStep(IDA_idamem, &h);
/* Get pointers to vector data */
yy_data = N_VGetArrayPointer(yy);
yp_data = N_VGetArrayPointer(yp);
rr_data = N_VGetArrayPointer(rr);
ewtdata = N_VGetArrayPointer(F2C_IDA_ewtvec);
vdata = N_VGetArrayPointer(v);
Jvdata = N_VGetArrayPointer(Jv);
v1data = N_VGetArrayPointer(vtemp1);
v2data = N_VGetArrayPointer(vtemp2);
IDA_userdata = (FIDAUserData) jac_data;
/* Call user-supplied routine */
FIDA_JTIMES(&t, yy_data, yp_data, rr_data, vdata, Jvdata,
&c_j, ewtdata, &h,
IDA_userdata->ipar, IDA_userdata->rpar,
v1data, v2data, &ier);
return(ier);
}
int FIDAPSol(realtype t, N_Vector yy, N_Vector yp, N_Vector rr,
N_Vector rvec, N_Vector zvec,
realtype c_j, realtype delta, void *user_data,
N_Vector vtemp1)
{
realtype *yy_data, *yp_data, *rr_data, *ewtdata, *rdata, *zdata, *v1data;
int ier;
FIDAUserData IDA_userdata;
/* Initialize all pointers to NULL */
yy_data = yp_data = rr_data = ewtdata = zdata = v1data = NULL;
/* NOTE: The user-supplied routine should set ier to an
appropriate value, but we preset the value to zero
(meaning SUCCESS) so the user need only reset the
value if an error occurred */
ier = 0;
IDAGetErrWeights(IDA_idamem, F2C_IDA_ewtvec);
/* Get pointers to vector data */
yy_data = N_VGetArrayPointer(yy);
yp_data = N_VGetArrayPointer(yp);
rr_data = N_VGetArrayPointer(rr);
ewtdata = N_VGetArrayPointer(F2C_IDA_ewtvec);
rdata = N_VGetArrayPointer(rvec);
zdata = N_VGetArrayPointer(zvec);
v1data = N_VGetArrayPointer(vtemp1);
IDA_userdata = (FIDAUserData) user_data;
/* Call user-supplied routine */
FIDA_PSOL(&t, yy_data, yp_data, rr_data, rdata, zdata,
&c_j, &delta, ewtdata,
IDA_userdata->ipar, IDA_userdata->rpar,
v1data, &ier);
return(ier);
}
int Ida::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 = IDAGetErrWeights(_idaMem, errorWeight);
if (_idid < 0)
{
_idid = -5;
throw std::invalid_argument("IDA::calcJacobian()");
}
_idid = IDAGetCurrentStep(_idaMem, &h);
if (_idid < 0)
{
_idid = -5;
throw std::invalid_argument("IDA::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];
}
// Calculation of the jacobian
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,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)
{
std::string error = ex.what();
cerr << "IDA integration error: " << error;
return 1;
}
return 0;
}
static int Precondbd(realtype tt, N_Vector cc,
N_Vector cp, N_Vector rr,
realtype cj, void *user_data,
N_Vector tempv1, N_Vector tempv2, N_Vector tempv3)
{
int flag, thispe;
realtype uround;
realtype xx, yy, *cxy, *ewtxy, cctemp, **Pxy, *ratesxy, *Pxycol, *cpxy;
realtype inc, sqru, fac, perturb_rates[NUM_SPECIES];
int is, js, ix, jy, ret;
UserData webdata;
void *mem;
N_Vector ewt;
realtype hh;
webdata = (UserData)user_data;
uround = UNIT_ROUNDOFF;
sqru = SUNRsqrt(uround);
thispe = webdata->thispe;
mem = webdata->ida_mem;
ewt = webdata->ewt;
flag = IDAGetErrWeights(mem, ewt);
check_flag(&flag, "IDAGetErrWeights", 1, thispe);
flag = IDAGetCurrentStep(mem, &hh);
check_flag(&flag, "IDAGetCurrentStep", 1, thispe);
for (jy = 0; jy < mysub; jy++) {
yy = (jy + jysub*mysub)*dy;
for (ix = 0; ix < mxsub; ix++) {
xx = (ix+ ixsub*mxsub)*dx;
Pxy = (webdata->PP)[ix][jy];
cxy = IJ_Vptr(cc,ix,jy);
cpxy = IJ_Vptr(cp,ix,jy);
ewtxy= IJ_Vptr(ewt,ix,jy);
ratesxy = IJ_Vptr(rates,ix,jy);
for (js = 0; js < ns; js++) {
inc = sqru*(SUNMAX(SUNRabs(cxy[js]), SUNMAX(hh*SUNRabs(cpxy[js]), ONE/ewtxy[js])));
cctemp = cxy[js]; /* Save the (js,ix,jy) element of cc. */
cxy[js] += inc; /* Perturb the (js,ix,jy) element of cc. */
fac = -ONE/inc;
WebRates(xx, yy, cxy, perturb_rates, webdata);
Pxycol = Pxy[js];
for (is = 0; is < ns; is++)
Pxycol[is] = (perturb_rates[is] - ratesxy[is])*fac;
if (js < np) Pxycol[js] += cj; /* Add partial with respect to cp. */
cxy[js] = cctemp; /* Restore (js,ix,jy) element of cc. */
} /* End of js loop. */
/* Do LU decomposition of matrix block for grid point (ix,jy). */
ret = denseGETRF(Pxy, ns, ns, (webdata->pivot)[ix][jy]);
if (ret != 0) return(1);
} /* End of ix loop. */
} /* End of jy loop. */
return(0);
}
static int Precond(realtype tt,
N_Vector cc, N_Vector cp, N_Vector rr,
realtype cj, void *user_data,
N_Vector tmp1, N_Vector tmp2, N_Vector tmp3)
{
int flag;
realtype uround, xx, yy, del_x, del_y;
realtype **Pxy, *ratesxy, *Pxycol, *cxy, *cpxy, *ewtxy, cctmp;
realtype inc, fac, sqru, perturb_rates[NUM_SPECIES];
int is, js, jx, jy, ret;
void *mem;
N_Vector ewt;
realtype hh;
UserData webdata;
webdata = (UserData) user_data;
del_x = webdata->dx;
del_y = webdata->dy;
uround = UNIT_ROUNDOFF;
sqru = SUNRsqrt(uround);
mem = webdata->ida_mem;
ewt = webdata->ewt;
flag = IDAGetErrWeights(mem, ewt);
if(check_flag(&flag, "IDAGetErrWeights", 1)) return(1);
flag = IDAGetCurrentStep(mem, &hh);
if(check_flag(&flag, "IDAGetCurrentStep", 1)) return(1);
for (jy = 0; jy < MY; jy++) {
yy = jy * del_y;
for (jx = 0; jx < MX; jx++) {
xx = jx * del_x;
Pxy = (webdata->PP)[jx][jy];
cxy = IJ_Vptr(cc, jx, jy);
cpxy = IJ_Vptr(cp, jx, jy);
ewtxy = IJ_Vptr(ewt, jx, jy);
ratesxy = IJ_Vptr((webdata->rates), jx, jy);
for (js = 0; js < NUM_SPECIES; js++) {
inc = sqru*(SUNMAX(SUNRabs(cxy[js]), SUNMAX(hh*SUNRabs(cpxy[js]), ONE/ewtxy[js])));
cctmp = cxy[js];
cxy[js] += inc;
fac = -ONE/inc;
WebRates(xx, yy, cxy, perturb_rates, webdata);
Pxycol = Pxy[js];
for (is = 0; is < NUM_SPECIES; is++)
Pxycol[is] = (perturb_rates[is] - ratesxy[is])*fac;
if (js < 1) Pxycol[js] += cj;
cxy[js] = cctmp;
}
ret = denseGETRF(Pxy, NUM_SPECIES, NUM_SPECIES, (webdata->pivot)[jx][jy]);
if (ret != 0) return(1);
}
}
return(0);
}
