/* Jacobian routine to compute J(t,y) = df/dy. */
static int Jac(long int N, realtype t,
N_Vector y, N_Vector fy, DlsMat J, void *user_data,
N_Vector tmp1, N_Vector tmp2, N_Vector tmp3)
{
realtype *rdata = (realtype *) user_data; /* cast user_data to realtype */
realtype ep = rdata[2]; /* access data entries */
realtype u = NV_Ith_S(y,0); /* access solution values */
realtype v = NV_Ith_S(y,1);
realtype w = NV_Ith_S(y,2);
/* fill in the Jacobian */
DENSE_ELEM(J,0,0) = -(w+1.0) + 2.0*u*v;
DENSE_ELEM(J,0,1) = u*u;
DENSE_ELEM(J,0,2) = -u;
DENSE_ELEM(J,1,0) = w - 2.0*u*v;
DENSE_ELEM(J,1,1) = -u*u;
DENSE_ELEM(J,1,2) = u;
DENSE_ELEM(J,2,0) = -w;
DENSE_ELEM(J,2,1) = 0.0;
DENSE_ELEM(J,2,2) = -1.0/ep - u;
return 0; /* Return with success */
}
void PrintMat(DlsMat A)
{
long int i, j, start, finish;
realtype **a;
switch (A->type) {
case SUNDIALS_DENSE:
printf("\n");
for (i=0; i < A->M; i++) {
for (j=0; j < A->N; j++) {
#if defined(SUNDIALS_EXTENDED_PRECISION)
printf("%12Lg ", DENSE_ELEM(A,i,j));
#elif defined(SUNDIALS_DOUBLE_PRECISION)
printf("%12g ", DENSE_ELEM(A,i,j));
#else
printf("%12g ", DENSE_ELEM(A,i,j));
#endif
}
printf("\n");
}
printf("\n");
break;
case SUNDIALS_BAND:
a = A->cols;
printf("\n");
for (i=0; i < A->N; i++) {
start = SUNMAX(0,i-A->ml);
finish = SUNMIN(A->N-1,i+A->mu);
for (j=0; j < start; j++) printf("%12s ","");
for (j=start; j <= finish; j++) {
#if defined(SUNDIALS_EXTENDED_PRECISION)
printf("%12Lg ", a[j][i-j+A->s_mu]);
#elif defined(SUNDIALS_DOUBLE_PRECISION)
printf("%12g ", a[j][i-j+A->s_mu]);
#else
printf("%12g ", a[j][i-j+A->s_mu]);
#endif
}
printf("\n");
}
printf("\n");
break;
}
}
static void Jac1(long int N, DenseMat J, realtype tn,
N_Vector y, N_Vector fy, void *jac_data,
N_Vector tmp1, N_Vector tmp2, N_Vector tmp3)
{
realtype y0, y1;
y0 = NV_Ith_S(y,0);
y1 = NV_Ith_S(y,1);
DENSE_ELEM(J,0,1) = ONE;
DENSE_ELEM(J,1,0) = -TWO * P1_ETA * y0 * y1 - ONE;
DENSE_ELEM(J,1,1) = P1_ETA * (ONE - SQR(y0));
}
/*
* function calculates a jacobian matrix
*/
static
int nlsDenseJac(long int N, N_Vector vecX, N_Vector vecFX, DlsMat Jac, void *userData, N_Vector tmp1, N_Vector tmp2)
{
NLS_KINSOL_USERDATA *kinsolUserData = (NLS_KINSOL_USERDATA*) userData;
DATA* data = kinsolUserData->data;
threadData_t *threadData = kinsolUserData->threadData;
int sysNumber = kinsolUserData->sysNumber;
NONLINEAR_SYSTEM_DATA *nlsData = &(data->simulationInfo->nonlinearSystemData[sysNumber]);
NLS_KINSOL_DATA* kinsolData = (NLS_KINSOL_DATA*) nlsData->solverData;
/* prepare variables */
double *x = N_VGetArrayPointer(vecX);
double *fx = N_VGetArrayPointer(vecFX);
double *xScaling = NV_DATA_S(kinsolData->xScale);
double *fRes = NV_DATA_S(kinsolData->fRes);
double xsave, xscale, sign;
double delta_hh;
const double delta_h = sqrt(DBL_EPSILON*2e1);
long int i,j;
/* performance measurement */
rt_ext_tp_tick(&nlsData->jacobianTimeClock);
for(i = 0; i < N; i++)
{
xsave = x[i];
delta_hh = delta_h * (fabs(xsave) + 1.0);
if ((xsave + delta_hh >= nlsData->max[i]))
delta_hh *= -1;
x[i] += delta_hh;
/* Calculate difference quotient */
nlsKinsolResiduals(vecX, kinsolData->fRes, userData);
/* Calculate scaled difference quotient */
delta_hh = 1. / delta_hh;
for(j = 0; j < N; j++)
{
DENSE_ELEM(Jac, j, i) = (fRes[j] - fx[j]) * delta_hh;
}
x[i] = xsave;
}
/* debug */
if (ACTIVE_STREAM(LOG_NLS_JAC)){
infoStreamPrint(LOG_NLS_JAC, 0, "##KINSOL## omc dense matrix.");
PrintMat(Jac);
}
/* performance measurement and statistics */
nlsData->jacobianTime += rt_ext_tp_tock(&(nlsData->jacobianTimeClock));
nlsData->numberOfJEval++;
return 0;
}
static int
JacRes(int N, realtype t, realtype cj, N_Vector y, N_Vector dy,
N_Vector resvec, DlsMat J, void *jac_data,
N_Vector tempv1, N_Vector tempv2, N_Vector tempv3)
{
int i, j;
realtype *ydata;
cvodeData_t *data;
data = (cvodeData_t *) jac_data;
ydata = NV_DATA_S(y);
/* update ODE variables from CVODE */
for ( i=0; i<data->model->neq; i++ ) {
data->value[i] = ydata[i];
}
/* update algebraic constraint defined variables */
/* update assignment rules */
for ( i=0; i<data->model->nass; i++ ) {
data->value[data->model->neq+i] =
evaluateAST(data->model->assignment[i],data);
}
/* update time */
data->currenttime = t;
/* evaluate Jacobian*/
for ( i=0; i<data->model->neq; i++ ) {
for ( j=0; j<data->model->neq; j++ ) {
DENSE_ELEM(J,i,j) = evaluateAST(data->model->jacob[i][j], data);
if ( i == j )
DENSE_ELEM(J, i, j) -= cj;
}
}
for ( i=0; i<data->model->nalg; i++ )
for ( j=0; j<data->model->nalg; j++ )
DENSE_ELEM(J,i,j) = 1.; /* algebraic jacobian here!! */
return (0);
}
CAMLprim value c_densematrix_set(value vmatrix, value vi, value vj, value v)
{
CAMLparam4(vmatrix, vi, vj, v);
DlsMat m = DLSMAT(vmatrix);
int i = Long_val(vi);
int j = Long_val(vj);
#if SUNDIALS_ML_SAFE == 1
if (i < 0 || i >= m->M) caml_invalid_argument("DenseMatrix.set: invalid i.");
if (j < 0 || j >= m->N) caml_invalid_argument("DenseMatrix.set: invalid j.");
#endif
DENSE_ELEM(m, i, j) = Double_val(v);
CAMLreturn(caml_copy_double(v));
}
/* Jacobian routine to compute J(t,y) = df/dy. */
static int Jac(long int N, realtype t,
N_Vector y, N_Vector fy, DlsMat J, void *user_data,
N_Vector tmp1, N_Vector tmp2, N_Vector tmp3)
{
realtype v = NV_Ith_S(y,1); /* access current solution */
realtype w = NV_Ith_S(y,2);
SetToZero(J); /* initialize Jacobian to zero */
/* Fill in the Jacobian of the ODE RHS function */
DENSE_ELEM(J,0,0) = -0.04;
DENSE_ELEM(J,0,1) = 1.e4*w;
DENSE_ELEM(J,0,2) = 1.e4*v;
DENSE_ELEM(J,1,0) = 0.04;
DENSE_ELEM(J,1,1) = -1.e4*w - 6.e7*v;
DENSE_ELEM(J,1,2) = -1.e4*v;
DENSE_ELEM(J,2,1) = 6.e7*v;
return 0; /* Return with success */
}
/*
* -----------------------------------------------------------------
* cpDlsDenseProjDQJac
* -----------------------------------------------------------------
* This routine generates a dense difference quotient approximation
* to the transpose of the Jacobian of c(t,y). It loads it into a
* dense matrix of type DlsMat stored column-wise with elements
* within each column contiguous. The address of the jth column of
* J is obtained via the macro DENSE_COL and this pointer is
* associated with an N_Vector using the N_VGetArrayPointer and
* N_VSetArrayPointer functions.
* Finally, the actual computation of the jth column of the Jacobian
* transposed is done with a call to N_VLinearSum.
* -----------------------------------------------------------------
*/
int cpDlsDenseProjDQJac(int Nc, int Ny, realtype t,
N_Vector y, N_Vector cy,
DlsMat Jac, void *jac_data,
N_Vector c_tmp1, N_Vector c_tmp2)
{
realtype inc, inc_inv, yj, srur;
realtype *y_data, *ewt_data, *jthCol_data;
N_Vector ctemp, jthCol;
int i, j;
int retval = 0;
CPodeMem cp_mem;
CPDlsProjMem cpdlsP_mem;
/* jac_data points to cpode_mem */
cp_mem = (CPodeMem) jac_data;
cpdlsP_mem = (CPDlsProjMem) lmemP;
/* Rename work vectors for readibility */
ctemp = c_tmp1;
jthCol = c_tmp2;
/* Obtain pointers to the data for ewt and y */
ewt_data = N_VGetArrayPointer(ewt);
y_data = N_VGetArrayPointer(y);
/* Obtain pointer to the data for jthCol */
jthCol_data = N_VGetArrayPointer(jthCol);
/* Set minimum increment based on uround and norm of f */
srur = RSqrt(uround);
/* Generate each column of the Jacobian G = dc/dy as delta(c)/delta(y_j). */
for (j = 0; j < Ny; j++) {
/* Save the y_j values. */
yj = y_data[j];
/* Set increment inc to y_j based on sqrt(uround)*abs(y_j),
with an adjustment using ewt_j if this is small */
inc = MAX( srur * ABS(yj) , ONE/ewt_data[j] );
inc = (yj + inc) - yj;
/* Increment y_j, call cfun, and break on error return. */
y_data[j] += inc;
retval = cfun(t, y, ctemp, c_data);
nceDQ++;
if (retval != 0) break;
/* Generate the jth col of G(tn,y) */
inc_inv = ONE/inc;
N_VLinearSum(inc_inv, ctemp, -inc_inv, cy, jthCol);
/* Copy the j-th column of G into the j-th row of Jac */
for (i = 0; i < Nc ; i++) {
DENSE_ELEM(Jac,j,i) = jthCol_data[i];
}
/* Reset y_j */
y_data[j] = yj;
}
return(retval);
}
static int jacDense(long int N,
N_Vector y, N_Vector f,
DlsMat J, void *user_data,
N_Vector tmp1, N_Vector tmp2)
{
realtype *yd;
yd = N_VGetArrayPointer_Serial(y);
/* row 0 */
DENSE_ELEM(J,0,0) = PT5 * cos(yd[0]*yd[1]) * yd[1] - PT5;
DENSE_ELEM(J,0,1) = PT5 * cos(yd[0]*yd[1]) * yd[0] - PT25/PI;
/* row 1 */
DENSE_ELEM(J,1,0) = TWO * (ONE - PT25/PI) * (SUNRexp(TWO*yd[0]) - E);
DENSE_ELEM(J,1,1) = E/PI;
/* row 2 */
DENSE_ELEM(J,2,0) = -ONE;
DENSE_ELEM(J,2,2) = ONE;
/* row 3 */
DENSE_ELEM(J,3,0) = -ONE;
DENSE_ELEM(J,3,3) = ONE;
/* row 4 */
DENSE_ELEM(J,4,1) = -ONE;
DENSE_ELEM(J,4,4) = ONE;
/* row 5 */
DENSE_ELEM(J,5,1) = -ONE;
DENSE_ELEM(J,5,5) = ONE;
return(0);
}
