static int KBBDDQJac(KBBDPrecData pdata,
N_Vector uu, N_Vector uscale,
N_Vector gu, N_Vector gtemp, N_Vector utemp)
{
realtype inc, inc_inv;
long int group, i, j, width, ngroups, i1, i2;
KINMem kin_mem;
realtype *udata, *uscdata, *gudata, *gtempdata, *utempdata, *col_j;
int retval;
kin_mem = (KINMem) pdata->kin_mem;
/* set pointers to the data for all vectors */
udata = N_VGetArrayPointer(uu);
uscdata = N_VGetArrayPointer(uscale);
gudata = N_VGetArrayPointer(gu);
gtempdata = N_VGetArrayPointer(gtemp);
utempdata = N_VGetArrayPointer(utemp);
/* load utemp with uu = predicted solution vector */
N_VScale(ONE, uu, utemp);
/* call gcomm and gloc to get base value of g(uu) */
if (gcomm != NULL) {
retval = gcomm(Nlocal, uu, user_data);
if (retval != 0) return(retval);
}
retval = gloc(Nlocal, uu, gu, user_data);
if (retval != 0) return(retval);
/* set bandwidth and number of column groups for band differencing */
width = mldq + mudq + 1;
ngroups = SUNMIN(width, Nlocal);
/* loop over groups */
for (group = 1; group <= ngroups; group++) {
/* increment all u_j in group */
for(j = group - 1; j < Nlocal; j += width) {
inc = rel_uu * SUNMAX(SUNRabs(udata[j]), (ONE / uscdata[j]));
utempdata[j] += inc;
}
/* evaluate g with incremented u */
retval = gloc(Nlocal, utemp, gtemp, user_data);
if (retval != 0) return(retval);
/* restore utemp, then form and load difference quotients */
for (j = group - 1; j < Nlocal; j += width) {
utempdata[j] = udata[j];
col_j = BAND_COL(PP,j);
inc = rel_uu * SUNMAX(SUNRabs(udata[j]) , (ONE / uscdata[j]));
inc_inv = ONE / inc;
i1 = SUNMAX(0, (j - mukeep));
i2 = SUNMIN((j + mlkeep), (Nlocal - 1));
for (i = i1; i <= i2; i++)
BAND_COL_ELEM(col_j, i, j) = inc_inv * (gtempdata[i] - gudata[i]);
}
}
return(0);
}
static int IBBDDQJac(IBBDPrecData pdata, realtype tt, realtype cj,
N_Vector yy, N_Vector yp, N_Vector gref,
N_Vector ytemp, N_Vector yptemp, N_Vector gtemp)
{
IDAMem IDA_mem;
realtype inc, inc_inv;
int retval;
long int group, i, j, width, ngroups, i1, i2;
realtype *ydata, *ypdata, *ytempdata, *yptempdata, *grefdata, *gtempdata;
realtype *cnsdata = NULL, *ewtdata;
realtype *col_j, conj, yj, ypj, ewtj;
IDA_mem = (IDAMem) pdata->ida_mem;
/* Initialize ytemp and yptemp. */
N_VScale(ONE, yy, ytemp);
N_VScale(ONE, yp, yptemp);
/* Obtain pointers as required to the data array of vectors. */
ydata = N_VGetArrayPointer(yy);
ypdata = N_VGetArrayPointer(yp);
gtempdata = N_VGetArrayPointer(gtemp);
ewtdata = N_VGetArrayPointer(ewt);
if (constraints != NULL)
cnsdata = N_VGetArrayPointer(constraints);
ytempdata = N_VGetArrayPointer(ytemp);
yptempdata= N_VGetArrayPointer(yptemp);
grefdata = N_VGetArrayPointer(gref);
/* Call gcomm and glocal to get base value of G(t,y,y'). */
if (gcomm != NULL) {
retval = gcomm(Nlocal, tt, yy, yp, res_data);
if (retval != 0) return(retval);
}
retval = glocal(Nlocal, tt, yy, yp, gref, res_data);
nge++;
if (retval != 0) return(retval);
/* Set bandwidth and number of column groups for band differencing. */
width = mldq + mudq + 1;
ngroups = MIN(width, Nlocal);
/* Loop over groups. */
for(group = 1; group <= ngroups; group++) {
/* Loop over the components in this group. */
for(j = group-1; j < Nlocal; j += width) {
yj = ydata[j];
ypj = ypdata[j];
ewtj = ewtdata[j];
/* Set increment inc to yj based on rel_yy*abs(yj), with
adjustments using ypj and ewtj if this is small, and a further
adjustment to give it the same sign as hh*ypj. */
inc = rel_yy*MAX(ABS(yj), MAX( ABS(hh*ypj), ONE/ewtj));
if (hh*ypj < ZERO) inc = -inc;
inc = (yj + inc) - yj;
/* Adjust sign(inc) again if yj has an inequality constraint. */
if (constraints != NULL) {
conj = cnsdata[j];
if (ABS(conj) == ONE) {if ((yj+inc)*conj < ZERO) inc = -inc;}
else if (ABS(conj) == TWO) {if ((yj+inc)*conj <= ZERO) inc = -inc;}
}
/* Increment yj and ypj. */
ytempdata[j] += inc;
yptempdata[j] += cj*inc;
}
/* Evaluate G with incremented y and yp arguments. */
retval = glocal(Nlocal, tt, ytemp, yptemp, gtemp, res_data);
nge++;
if (retval != 0) return(retval);
/* Loop over components of the group again; restore ytemp and yptemp. */
for(j = group-1; j < Nlocal; j += width) {
yj = ytempdata[j] = ydata[j];
ypj = yptempdata[j] = ypdata[j];
ewtj = ewtdata[j];
/* Set increment inc as before .*/
inc = rel_yy*MAX(ABS(yj), MAX( ABS(hh*ypj), ONE/ewtj));
if (hh*ypj < ZERO) inc = -inc;
inc = (yj + inc) - yj;
if (constraints != NULL) {
conj = cnsdata[j];
if (ABS(conj) == ONE) {if ((yj+inc)*conj < ZERO) inc = -inc;}
else if (ABS(conj) == TWO) {if ((yj+inc)*conj <= ZERO) inc = -inc;}
}
/* Form difference quotients and load into PP. */
inc_inv = ONE/inc;
col_j = BAND_COL(PP,j);
i1 = MAX(0, j-mukeep);
i2 = MIN(j+mlkeep, Nlocal-1);
for(i = i1; i <= i2; i++) BAND_COL_ELEM(col_j,i,j) =
inc_inv * (gtempdata[i] - grefdata[i]);
}
}
return(0);
}
