static void Vaxpy_Serial(realtype a, N_Vector x, N_Vector y)
{
long int i, N;
realtype *xd, *yd;
xd = yd = NULL;
N = NV_LENGTH_S(x);
xd = NV_DATA_S(x);
yd = NV_DATA_S(y);
if (a == ONE) {
for (i = 0; i < N; i++)
yd[i] += xd[i];
return;
}
if (a == -ONE) {
for (i = 0; i < N; i++)
yd[i] -= xd[i];
return;
}
for (i = 0; i < N; i++)
yd[i] += a*xd[i];
return;
}
N_Vector N_VCloneEmpty_Serial(N_Vector w)
{
N_Vector v;
N_Vector_Ops ops;
N_VectorContent_Serial content;
if (w == NULL) return(NULL);
/* Create vector */
v = NULL;
v = (N_Vector) malloc(sizeof *v);
if (v == NULL) return(NULL);
/* Create vector operation structure */
ops = NULL;
ops = (N_Vector_Ops) malloc(sizeof(struct _generic_N_Vector_Ops));
if (ops == NULL) { free(v); return(NULL); }
ops->nvclone = w->ops->nvclone;
ops->nvcloneempty = w->ops->nvcloneempty;
ops->nvdestroy = w->ops->nvdestroy;
ops->nvspace = w->ops->nvspace;
ops->nvgetarraypointer = w->ops->nvgetarraypointer;
ops->nvsetarraypointer = w->ops->nvsetarraypointer;
ops->nvlinearsum = w->ops->nvlinearsum;
ops->nvconst = w->ops->nvconst;
ops->nvprod = w->ops->nvprod;
ops->nvdiv = w->ops->nvdiv;
ops->nvscale = w->ops->nvscale;
ops->nvabs = w->ops->nvabs;
ops->nvinv = w->ops->nvinv;
ops->nvaddconst = w->ops->nvaddconst;
ops->nvdotprod = w->ops->nvdotprod;
ops->nvmaxnorm = w->ops->nvmaxnorm;
ops->nvwrmsnormmask = w->ops->nvwrmsnormmask;
ops->nvwrmsnorm = w->ops->nvwrmsnorm;
ops->nvmin = w->ops->nvmin;
ops->nvwl2norm = w->ops->nvwl2norm;
ops->nvl1norm = w->ops->nvl1norm;
ops->nvcompare = w->ops->nvcompare;
ops->nvinvtest = w->ops->nvinvtest;
ops->nvconstrmask = w->ops->nvconstrmask;
ops->nvminquotient = w->ops->nvminquotient;
ops->nvlength = w->ops->nvlength;
/* Create content */
content = NULL;
content = (N_VectorContent_Serial) malloc(sizeof(struct _N_VectorContent_Serial));
if (content == NULL) { free(ops); free(v); return(NULL); }
content->length = NV_LENGTH_S(w);
content->own_data = FALSE;
content->data = NULL;
/* Attach content and ops */
v->content = content;
v->ops = ops;
return(v);
}
booleantype N_VConstrMask_Serial(N_Vector c, N_Vector x, N_Vector m)
{
long int i, N;
booleantype test;
realtype *cd, *xd, *md;
cd = xd = md = NULL;
N = NV_LENGTH_S(x);
xd = NV_DATA_S(x);
cd = NV_DATA_S(c);
md = NV_DATA_S(m);
test = TRUE;
for (i = 0; i < N; i++) {
md[i] = ZERO;
if (cd[i] == ZERO) continue;
if (cd[i] > ONEPT5 || cd[i] < -ONEPT5) {
if ( xd[i]*cd[i] <= ZERO) { test = FALSE; md[i] = ONE; }
continue;
}
if ( cd[i] > HALF || cd[i] < -HALF) {
if (xd[i]*cd[i] < ZERO ) { test = FALSE; md[i] = ONE; }
}
}
return(test);
}
realtype N_VMinQuotient_Serial(N_Vector num, N_Vector denom)
{
booleantype notEvenOnce;
long int i, N;
realtype *nd, *dd, min;
nd = dd = NULL;
N = NV_LENGTH_S(num);
nd = NV_DATA_S(num);
dd = NV_DATA_S(denom);
notEvenOnce = TRUE;
min = BIG_REAL;
for (i = 0; i < N; i++) {
if (dd[i] == ZERO) continue;
else {
if (!notEvenOnce) min = MIN(min, nd[i]/dd[i]);
else {
min = nd[i]/dd[i];
notEvenOnce = FALSE;
}
}
}
return(min);
}
void N_VScale_Serial(realtype c, N_Vector x, N_Vector z)
{
long int i, N;
realtype *xd, *zd;
xd = zd = NULL;
if (z == x) { /* BLAS usage: scale x <- cx */
VScaleBy_Serial(c, x);
return;
}
if (c == ONE) {
VCopy_Serial(x, z);
} else if (c == -ONE) {
VNeg_Serial(x, z);
} else {
N = NV_LENGTH_S(x);
xd = NV_DATA_S(x);
zd = NV_DATA_S(z);
for (i = 0; i < N; i++)
zd[i] = c*xd[i];
}
return;
}
void N_VSpace_Serial(N_Vector v, long int *lrw, long int *liw)
{
*lrw = NV_LENGTH_S(v);
*liw = 1;
return;
}
N_Vector N_VClone_Serial(N_Vector w)
{
N_Vector v;
realtype *data;
long int length;
v = NULL;
v = N_VCloneEmpty_Serial(w);
if (v == NULL) return(NULL);
length = NV_LENGTH_S(w);
/* Create data */
if (length > 0) {
/* Allocate memory */
data = NULL;
data = (realtype *) malloc(length * sizeof(realtype));
if(data == NULL) { N_VDestroy_Serial(v); return(NULL); }
/* Attach data */
NV_OWN_DATA_S(v) = TRUE;
NV_DATA_S(v) = data;
}
return(v);
}
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
}
static void* vmin(NrnThread* nt) {
realtype min;
int i = nt->id;
if (NV_LENGTH_S(xarg(i))) {
min = N_VMin_Serial(xarg(i));
lockmin(min);
}
return (void*)0;
}
static void VScaleBy_Serial(realtype a, N_Vector x)
{
long int i, N;
realtype *xd;
N = NV_LENGTH_S(x);
xd = NV_DATA_S(x);
for (i=0; i < N; i++)
*xd++ *= a;
}
void N_VConst_Serial(realtype c, N_Vector z)
{
long int i, N;
realtype *zd;
N = NV_LENGTH_S(z);
zd = NV_DATA_S(z);
for (i=0; i < N; i++)
*zd++ = c;
}
void N_VAddConst_Serial(N_Vector x, realtype b, N_Vector z)
{
long int i, N;
realtype *xd, *zd;
N = NV_LENGTH_S(x);
xd = NV_DATA_S(x);
zd = NV_DATA_S(z);
for (i=0; i < N; i++)
*zd++ = (*xd++) + b;
}
void N_VAbs_Serial(N_Vector x, N_Vector z)
{
long int i, N;
realtype *xd, *zd;
N = NV_LENGTH_S(x);
xd = NV_DATA_S(x);
zd = NV_DATA_S(z);
for (i=0; i < N; i++, xd++, zd++)
*zd = ABS(*xd);
}
static void VNeg_Serial(N_Vector x, N_Vector z)
{
long int i, N;
realtype *xd, *zd;
N = NV_LENGTH_S(x);
xd = NV_DATA_S(x);
zd = NV_DATA_S(z);
for (i=0; i < N; i++)
*zd++ = -(*xd++);
}
void N_VOneMask_Serial(N_Vector x)
{
long int i, N;
realtype *xd;
N = NV_LENGTH_S(x);
xd = NV_DATA_S(x);
for (i=0; i<N; i++,xd++) {
if (*xd != ZERO) *xd = ONE;
}
}
void N_VInv_Serial(N_Vector x, N_Vector z)
{
long int i, N;
realtype *xd, *zd;
N = NV_LENGTH_S(x);
xd = NV_DATA_S(x);
zd = NV_DATA_S(z);
for (i=0; i < N; i++)
*zd++ = ONE / (*xd++);
}
void N_VCompare_Serial(realtype c, N_Vector x, N_Vector z)
{
long int i, N;
realtype *xd, *zd;
N = NV_LENGTH_S(x);
xd = NV_DATA_S(x);
zd = NV_DATA_S(z);
for (i=0; i < N; i++, xd++, zd++) {
*zd = (ABS(*xd) >= c) ? ONE : ZERO;
}
}
void N_VDiv_Serial(N_Vector x, N_Vector y, N_Vector z)
{
long int i, N;
realtype *xd, *yd, *zd;
N = NV_LENGTH_S(x);
xd = NV_DATA_S(x);
yd = NV_DATA_S(y);
zd = NV_DATA_S(z);
for (i=0; i < N; i++)
*zd++ = (*xd++) / (*yd++);
}
static void VLin2_Serial(realtype a, N_Vector x, N_Vector y, N_Vector z)
{
long int i, N;
realtype *xd, *yd, *zd;
N = NV_LENGTH_S(x);
xd = NV_DATA_S(x);
yd = NV_DATA_S(y);
zd = NV_DATA_S(z);
for (i=0; i < N; i++)
*zd++ = a * (*xd++) - (*yd++);
}
realtype N_VL1Norm_Serial(N_Vector x)
{
long int i, N;
realtype sum = ZERO, *xd;
N = NV_LENGTH_S(x);
xd = NV_DATA_S(x);
for (i=0; i<N; i++)
sum += ABS(xd[i]);
return(sum);
}
static void VScaleDiff_Serial(realtype c, N_Vector x, N_Vector y, N_Vector z)
{
long int i, N;
realtype *xd, *yd, *zd;
N = NV_LENGTH_S(x);
xd = NV_DATA_S(x);
yd = NV_DATA_S(y);
zd = NV_DATA_S(z);
for (i=0; i < N; i++)
*zd++ = c * ((*xd++) - (*yd++));
}
void N_VConst_Serial(realtype c, N_Vector z)
{
long int i, N;
realtype *zd;
zd = NULL;
N = NV_LENGTH_S(z);
zd = NV_DATA_S(z);
for (i = 0; i < N; i++) zd[i] = c;
return;
}
realtype N_VDotProd_Serial(N_Vector x, N_Vector y)
{
long int i, N;
realtype sum = ZERO, *xd, *yd;
N = NV_LENGTH_S(x);
xd = NV_DATA_S(x);
yd = NV_DATA_S(y);
for (i=0; i < N; i++)
sum += (*xd++) * (*yd++);
return(sum);
}
realtype N_VMaxNorm_Serial(N_Vector x)
{
long int i, N;
realtype max = ZERO, *xd;
N = NV_LENGTH_S(x);
xd = NV_DATA_S(x);
for (i=0; i < N; i++, xd++) {
if (ABS(*xd) > max) max = ABS(*xd);
}
return(max);
}
static void VScaleBy_Serial(realtype a, N_Vector x)
{
long int i, N;
realtype *xd;
xd = NULL;
N = NV_LENGTH_S(x);
xd = NV_DATA_S(x);
for (i = 0; i < N; i++)
xd[i] *= a;
return;
}
static int f(realtype t,N_Vector y,N_Vector ydot,void *f_data)
{
ExecutableModel* em = (ExecutableModel*)f_data;
realtype* yD = NV_DATA_S(y);
realtype* ydotD = NV_DATA_S(ydot);
long int len = NV_LENGTH_S(y);
long int i;
for (i=0;i<len;i++) em->states[i]=(double)yD[i];
/* while integrating we only need to compute the rates */
em->computeRates(t);
for (i=0;i<len;i++) ydotD[i] = (realtype)(em->rates[i]);
return(0);
}
void print(N_Vector v, const char *title) {
double *d = NV_DATA_S(v);
int len = NV_LENGTH_S(v);
int count = 0;
pdePrintf("Vector: %s(%d)\n", title, len);
for (int i = 0; i < len; i++) {
pdePrintf(" %14.9e", d[i]);
if (++count == 6) {
pdePrintf("\n");
count = 0;
}
}
if (count)
pdePrintf("\n");
}
static realtype N_VWL2Norm_helper(N_Vector x, N_Vector w)
{
long int i, N;
realtype sum = ZERO, prodi, *xd, *wd;
N = NV_LENGTH_S(x);
xd = NV_DATA_S(x);
wd = NV_DATA_S(w);
for (i=0; i < N; i++) {
prodi = (*xd++) * (*wd++);
sum += prodi * prodi;
}
return sum;
}
booleantype N_VInvTest_Serial(N_Vector x, N_Vector z)
{
long int i, N;
realtype *xd, *zd;
N = NV_LENGTH_S(x);
xd = NV_DATA_S(x);
zd = NV_DATA_S(z);
for (i=0; i < N; i++) {
if (*xd == ZERO) return(FALSE);
*zd++ = ONE / (*xd++);
}
return(TRUE);
}
realtype N_VWL2Norm_Serial(N_Vector x, N_Vector w)
{
long int i, N;
realtype sum = ZERO, prodi, *xd, *wd;
N = NV_LENGTH_S(x);
xd = NV_DATA_S(x);
wd = NV_DATA_S(w);
for (i=0; i < N; i++) {
prodi = (*xd++) * (*wd++);
sum += prodi * prodi;
}
return(RSqrt(sum));
}
