CAMLprim value sunml_lsolver_lapack_band(value vnvec, value vbmat)
{
CAMLparam2(vnvec, vbmat);
#if SUNDIALS_LIB_VERSION >= 300 && defined SUNDIALS_ML_LAPACK
SUNMatrix bmat = MAT_VAL(vbmat);
SUNLinearSolver ls = SUNLapackBand(NVEC_VAL(vnvec), bmat);
if (ls == NULL) {
if (SUNBandMatrix_Rows(bmat) != SUNBandMatrix_Columns(bmat))
caml_raise_constant(LSOLVER_EXN(MatrixNotSquare));
if (SUNBandMatrix_StoredUpperBandwidth(bmat) <
SUNMIN(SUNBandMatrix_Rows(bmat) - 1,
SUNBandMatrix_LowerBandwidth(bmat)
+ SUNBandMatrix_UpperBandwidth(bmat)))
caml_raise_constant(LSOLVER_EXN(InsufficientStorageUpperBandwidth));
if (SUNBandMatrix_Rows(bmat) != NV_LENGTH_S(NVEC_VAL(vnvec)))
caml_raise_constant(LSOLVER_EXN(MatrixVectorMismatch));
caml_raise_out_of_memory();
}
CAMLreturn(alloc_lsolver(ls));
#else
CAMLreturn(Val_unit);
#endif
}
/*-----------------------------------------------------------------
cvLsBandDQJac
This routine generates a banded difference quotient approximation
to the Jacobian of f(t,y). It assumes that a band SUNMatrix is
stored column-wise, and that elements within each column are
contiguous. This makes it possible to get the address of a column
of J via the accessor function SUNBandMatrix_Column, and to write
a simple for loop to set each of the elements of a column in
succession.
-----------------------------------------------------------------*/
int cvLsBandDQJac(realtype t, N_Vector y, N_Vector fy, SUNMatrix Jac,
CVodeMem cv_mem, N_Vector tmp1, N_Vector tmp2)
{
N_Vector ftemp, ytemp;
realtype fnorm, minInc, inc, inc_inv, srur, conj;
realtype *col_j, *ewt_data, *fy_data, *ftemp_data;
realtype *y_data, *ytemp_data, *cns_data;
sunindextype group, i, j, width, ngroups, i1, i2;
sunindextype N, mupper, mlower;
CVLsMem cvls_mem;
int retval = 0;
/* access LsMem interface structure */
cvls_mem = (CVLsMem) cv_mem->cv_lmem;
/* access matrix dimensions */
N = SUNBandMatrix_Columns(Jac);
mupper = SUNBandMatrix_UpperBandwidth(Jac);
mlower = SUNBandMatrix_LowerBandwidth(Jac);
/* Rename work vectors for use as temporary values of y and f */
ftemp = tmp1;
ytemp = tmp2;
/* Obtain pointers to the data for ewt, fy, ftemp, y, ytemp */
ewt_data = N_VGetArrayPointer(cv_mem->cv_ewt);
fy_data = N_VGetArrayPointer(fy);
ftemp_data = N_VGetArrayPointer(ftemp);
y_data = N_VGetArrayPointer(y);
ytemp_data = N_VGetArrayPointer(ytemp);
if (cv_mem->cv_constraints != NULL)
cns_data = N_VGetArrayPointer(cv_mem->cv_constraints);
/* Load ytemp with y = predicted y vector */
N_VScale(ONE, y, ytemp);
/* Set minimum increment based on uround and norm of f */
srur = SUNRsqrt(cv_mem->cv_uround);
fnorm = N_VWrmsNorm(fy, cv_mem->cv_ewt);
minInc = (fnorm != ZERO) ?
(MIN_INC_MULT * SUNRabs(cv_mem->cv_h) * cv_mem->cv_uround * N * fnorm) : ONE;
/* Set bandwidth and number of column groups for band differencing */
width = mlower + mupper + 1;
ngroups = SUNMIN(width, N);
/* Loop over column groups. */
for (group=1; group <= ngroups; group++) {
/* Increment all y_j in group */
for(j=group-1; j < N; j+=width) {
inc = SUNMAX(srur*SUNRabs(y_data[j]), minInc/ewt_data[j]);
/* Adjust sign(inc) if yj has an inequality constraint. */
if (cv_mem->cv_constraints != NULL) {
conj = cns_data[j];
if (SUNRabs(conj) == ONE) {if ((ytemp_data[j]+inc)*conj < ZERO) inc = -inc;}
else if (SUNRabs(conj) == TWO) {if ((ytemp_data[j]+inc)*conj <= ZERO) inc = -inc;}
}
ytemp_data[j] += inc;
}
/* Evaluate f with incremented y */
retval = cv_mem->cv_f(cv_mem->cv_tn, ytemp, ftemp, cv_mem->cv_user_data);
cvls_mem->nfeDQ++;
if (retval != 0) break;
/* Restore ytemp, then form and load difference quotients */
for (j=group-1; j < N; j+=width) {
ytemp_data[j] = y_data[j];
col_j = SUNBandMatrix_Column(Jac, j);
inc = SUNMAX(srur*SUNRabs(y_data[j]), minInc/ewt_data[j]);
/* Adjust sign(inc) as before. */
if (cv_mem->cv_constraints != NULL) {
conj = cns_data[j];
if (SUNRabs(conj) == ONE) {if ((ytemp_data[j]+inc)*conj < ZERO) inc = -inc;}
else if (SUNRabs(conj) == TWO) {if ((ytemp_data[j]+inc)*conj <= ZERO) inc = -inc;}
}
inc_inv = ONE/inc;
i1 = SUNMAX(0, j-mupper);
i2 = SUNMIN(j+mlower, N-1);
for (i=i1; i <= i2; i++)
SM_COLUMN_ELEMENT_B(col_j,i,j) = inc_inv * (ftemp_data[i] - fy_data[i]);
}
}
return(retval);
}
