void FNV_INITS(int *code, long int *N, int *ier)
{
*ier = 0;
switch(*code) {
case FCMIX_CVODE:
F2C_CVODE_vec = NULL;
F2C_CVODE_vec = N_VNewEmpty_Serial(*N);
if (F2C_CVODE_vec == NULL) *ier = -1;
break;
case FCMIX_IDA:
F2C_IDA_vec = NULL;
F2C_IDA_vec = N_VNewEmpty_Serial(*N);
if (F2C_IDA_vec == NULL) *ier = -1;
break;
case FCMIX_KINSOL:
F2C_KINSOL_vec = NULL;
F2C_KINSOL_vec = N_VNewEmpty_Serial(*N);
if (F2C_KINSOL_vec == NULL) *ier = -1;
break;
case FCMIX_ARKODE:
F2C_ARKODE_vec = NULL;
F2C_ARKODE_vec = N_VNewEmpty_Serial(*N);
if (F2C_ARKODE_vec == NULL) *ier = -1;
break;
default:
*ier = -1;
}
}
N_Vector N_VNew_Serial(long int length)
{
N_Vector v;
realtype *data;
v = N_VNewEmpty_Serial(length);
if (v == NULL) return(NULL);
/* Create data */
if (length > 0) {
/* Allocate memory */
#if HAVE_MEMALIGN
if (posix_memalign((void**)&data, 64, length*sizeof(realtype)) != 0) {
N_VDestroy_Serial(v);return(NULL);
}
#else
data = (realtype *) malloc(length * sizeof(realtype));
#endif
if(data == NULL) {N_VDestroy_Serial(v);return(NULL);}
/* Attach data */
NV_OWN_DATA_S(v) = TRUE;
NV_DATA_S(v) = data;
}
return(v);
}
N_Vector N_VNew_Serial(long int length)
{
N_Vector v;
realtype *data;
v = NULL;
v = N_VNewEmpty_Serial(length);
if (v == NULL) return(NULL);
/* 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);
}
void FNV_INITS_B(int *code, long int *NB, int *ier)
{
*ier = 0;
switch(*code) {
case FCMIX_CVODE:
F2C_CVODE_vecB = NULL;
F2C_CVODE_vecB = N_VNewEmpty_Serial(*NB);
if (F2C_CVODE_vecB == NULL) *ier = -1;
break;
case FCMIX_IDA:
F2C_IDA_vecB = NULL;
F2C_IDA_vecB = N_VNewEmpty_Serial(*NB);
if (F2C_IDA_vecB == NULL) *ier = -1;
break;
default:
*ier = -1;
}
}
N_Vector N_VMake_Serial(long int length, realtype *v_data)
{
N_Vector v;
v = N_VNewEmpty_Serial(length);
if (v == NULL) return(NULL);
if (length > 0) {
/* Attach data */
NV_OWN_DATA_S(v) = FALSE;
NV_DATA_S(v) = v_data;
}
return(v);
}
void ode_solver_setErrTol(ode_solver* solver, const double rel_tol, double* abs_tol, const int abs_tol_len){
if( (abs_tol_len != 1) && (abs_tol_len != solver->odeModel->N)){
fprintf(stderr,"ode_solver_setErrTol: length of abs_tol must be 1 or equal to the number of variables in the ode model.\n");
return ;
}
/* set tollerances to the cvode_mem internal structure */
if ( abs_tol_len == 1 )
CVodeSStolerances(solver->cvode_mem, rel_tol, abs_tol[0]);
else{
N_Vector abs_tol_vec = N_VNewEmpty_Serial(abs_tol_len); /* alloc */
NV_DATA_S(abs_tol_vec) = abs_tol;
CVodeSVtolerances(solver->cvode_mem, rel_tol, abs_tol_vec);
N_VDestroy_Serial(abs_tol_vec); /* free */
}
}
N_Vector *N_VNewVectorArrayEmpty_Serial(int count, long int length)
{
N_Vector *vs;
int j;
if (count <= 0) return(NULL);
vs = (N_Vector *) malloc(count * sizeof(N_Vector));
if(vs == NULL) return(NULL);
for (j=0; j<count; j++) {
vs[j] = N_VNewEmpty_Serial(length);
if (vs[j] == NULL) {
N_VDestroyVectorArray_Serial(vs, j-1);
return(NULL);
}
}
return(vs);
}
ode_solver* ode_solver_alloc(ode_model* model){
ode_solver* solver = (ode_solver*) malloc( sizeof(ode_solver) ); /* alloc */
if (solver == 0){
/* TODO: write a proper error handler */
fprintf(stderr,"malloc failed to allocate memory for ode_solver\n");
return 0;
}
solver->cvode_mem = CVodeCreate(CV_BDF,CV_NEWTON); /* alloc */
if( solver->cvode_mem == 0){
/* TODO: write a proper error handler */
fprintf(stderr,"CVodeCreate failed to allocate memory in ode_solver for cvode_mem.\n");
free(solver);
return 0;
}
int P = ode_model_getP(model);
solver->params = (double*) malloc( sizeof(double) * P ); /* alloc */
if( solver->params == 0 ){
/* TODO: write a proper error handler */
fprintf(stderr,"malloc failed to allocate memory in ode_solver for params.\n");
CVodeFree(solver->cvode_mem);
free(solver);
return 0;
}
ode_model_get_default_params(model, solver->params, P);
int N = ode_model_getN(model);
solver->odeModel = model;
solver->y = N_VNewEmpty_Serial(N); /* alloc */
NV_DATA_S(solver->y) = solver->odeModel->v;
solver->yS = 0;
return solver;
}
/*---------------------------------------------------------------
User-Callable Functions: initialization, reinit and free
---------------------------------------------------------------*/
int IDABBDPrecInit(void *ida_mem, sunindextype Nlocal,
sunindextype mudq, sunindextype mldq,
sunindextype mukeep, sunindextype mlkeep,
realtype dq_rel_yy,
IDABBDLocalFn Gres, IDABBDCommFn Gcomm)
{
IDAMem IDA_mem;
IDALsMem idals_mem;
IBBDPrecData pdata;
sunindextype muk, mlk, storage_mu, lrw1, liw1;
long int lrw, liw;
int flag;
if (ida_mem == NULL) {
IDAProcessError(NULL, IDALS_MEM_NULL, "IDASBBDPRE",
"IDABBDPrecInit", MSGBBD_MEM_NULL);
return(IDALS_MEM_NULL);
}
IDA_mem = (IDAMem) ida_mem;
/* Test if the LS linear solver interface has been created */
if (IDA_mem->ida_lmem == NULL) {
IDAProcessError(IDA_mem, IDALS_LMEM_NULL, "IDASBBDPRE",
"IDABBDPrecInit", MSGBBD_LMEM_NULL);
return(IDALS_LMEM_NULL);
}
idals_mem = (IDALsMem) IDA_mem->ida_lmem;
/* Test compatibility of NVECTOR package with the BBD preconditioner */
if(IDA_mem->ida_tempv1->ops->nvgetarraypointer == NULL) {
IDAProcessError(IDA_mem, IDALS_ILL_INPUT, "IDASBBDPRE",
"IDABBDPrecInit", MSGBBD_BAD_NVECTOR);
return(IDALS_ILL_INPUT);
}
/* Allocate data memory. */
pdata = NULL;
pdata = (IBBDPrecData) malloc(sizeof *pdata);
if (pdata == NULL) {
IDAProcessError(IDA_mem, IDALS_MEM_FAIL, "IDASBBDPRE",
"IDABBDPrecInit", MSGBBD_MEM_FAIL);
return(IDALS_MEM_FAIL);
}
/* Set pointers to glocal and gcomm; load half-bandwidths. */
pdata->ida_mem = IDA_mem;
pdata->glocal = Gres;
pdata->gcomm = Gcomm;
pdata->mudq = SUNMIN(Nlocal-1, SUNMAX(0, mudq));
pdata->mldq = SUNMIN(Nlocal-1, SUNMAX(0, mldq));
muk = SUNMIN(Nlocal-1, SUNMAX(0, mukeep));
mlk = SUNMIN(Nlocal-1, SUNMAX(0, mlkeep));
pdata->mukeep = muk;
pdata->mlkeep = mlk;
/* Set extended upper half-bandwidth for PP (required for pivoting). */
storage_mu = SUNMIN(Nlocal-1, muk+mlk);
/* Allocate memory for preconditioner matrix. */
pdata->PP = NULL;
pdata->PP = SUNBandMatrixStorage(Nlocal, muk, mlk, storage_mu);
if (pdata->PP == NULL) {
free(pdata); pdata = NULL;
IDAProcessError(IDA_mem, IDALS_MEM_FAIL, "IDASBBDPRE",
"IDABBDPrecInit", MSGBBD_MEM_FAIL);
return(IDALS_MEM_FAIL);
}
/* Allocate memory for temporary N_Vectors */
pdata->zlocal = NULL;
pdata->zlocal = N_VNewEmpty_Serial(Nlocal);
if (pdata->zlocal == NULL) {
SUNMatDestroy(pdata->PP);
free(pdata); pdata = NULL;
IDAProcessError(IDA_mem, IDALS_MEM_FAIL, "IDASBBDPRE",
"IDABBDPrecInit", MSGBBD_MEM_FAIL);
return(IDALS_MEM_FAIL);
}
pdata->rlocal = NULL;
pdata->rlocal = N_VNewEmpty_Serial(Nlocal);
if (pdata->rlocal == NULL) {
N_VDestroy(pdata->zlocal);
SUNMatDestroy(pdata->PP);
free(pdata); pdata = NULL;
IDAProcessError(IDA_mem, IDALS_MEM_FAIL, "IDASBBDPRE",
"IDABBDPrecInit", MSGBBD_MEM_FAIL);
return(IDALS_MEM_FAIL);
}
pdata->tempv1 = NULL;
pdata->tempv1 = N_VClone(IDA_mem->ida_tempv1);
if (pdata->tempv1 == NULL){
N_VDestroy(pdata->rlocal);
N_VDestroy(pdata->zlocal);
SUNMatDestroy(pdata->PP);
free(pdata); pdata = NULL;
IDAProcessError(IDA_mem, IDALS_MEM_FAIL, "IDASBBDPRE",
"IDABBDPrecInit", MSGBBD_MEM_FAIL);
return(IDALS_MEM_FAIL);
}
pdata->tempv2 = NULL;
pdata->tempv2 = N_VClone(IDA_mem->ida_tempv1);
if (pdata->tempv2 == NULL){
N_VDestroy(pdata->rlocal);
N_VDestroy(pdata->zlocal);
N_VDestroy(pdata->tempv1);
SUNMatDestroy(pdata->PP);
free(pdata); pdata = NULL;
IDAProcessError(IDA_mem, IDALS_MEM_FAIL, "IDASBBDPRE",
"IDABBDPrecInit", MSGBBD_MEM_FAIL);
return(IDALS_MEM_FAIL);
}
pdata->tempv3 = NULL;
pdata->tempv3 = N_VClone(IDA_mem->ida_tempv1);
if (pdata->tempv3 == NULL){
N_VDestroy(pdata->rlocal);
N_VDestroy(pdata->zlocal);
N_VDestroy(pdata->tempv1);
N_VDestroy(pdata->tempv2);
SUNMatDestroy(pdata->PP);
free(pdata); pdata = NULL;
IDAProcessError(IDA_mem, IDALS_MEM_FAIL, "IDASBBDPRE",
"IDABBDPrecInit", MSGBBD_MEM_FAIL);
return(IDALS_MEM_FAIL);
}
pdata->tempv4 = NULL;
pdata->tempv4 = N_VClone(IDA_mem->ida_tempv1);
if (pdata->tempv4 == NULL){
N_VDestroy(pdata->rlocal);
N_VDestroy(pdata->zlocal);
N_VDestroy(pdata->tempv1);
N_VDestroy(pdata->tempv2);
N_VDestroy(pdata->tempv3);
SUNMatDestroy(pdata->PP);
free(pdata); pdata = NULL;
IDAProcessError(IDA_mem, IDALS_MEM_FAIL, "IDASBBDPRE",
"IDABBDPrecInit", MSGBBD_MEM_FAIL);
return(IDALS_MEM_FAIL);
}
/* Allocate memory for banded linear solver */
pdata->LS = NULL;
pdata->LS = SUNLinSol_Band(pdata->rlocal, pdata->PP);
if (pdata->LS == NULL) {
N_VDestroy(pdata->zlocal);
N_VDestroy(pdata->rlocal);
N_VDestroy(pdata->tempv1);
N_VDestroy(pdata->tempv2);
N_VDestroy(pdata->tempv3);
N_VDestroy(pdata->tempv4);
SUNMatDestroy(pdata->PP);
free(pdata); pdata = NULL;
IDAProcessError(IDA_mem, IDALS_MEM_FAIL, "IDASBBDPRE",
"IDABBDPrecInit", MSGBBD_MEM_FAIL);
return(IDALS_MEM_FAIL);
}
/* initialize band linear solver object */
flag = SUNLinSolInitialize(pdata->LS);
if (flag != SUNLS_SUCCESS) {
N_VDestroy(pdata->zlocal);
N_VDestroy(pdata->rlocal);
N_VDestroy(pdata->tempv1);
N_VDestroy(pdata->tempv2);
N_VDestroy(pdata->tempv3);
N_VDestroy(pdata->tempv4);
SUNMatDestroy(pdata->PP);
SUNLinSolFree(pdata->LS);
free(pdata); pdata = NULL;
IDAProcessError(IDA_mem, IDALS_SUNLS_FAIL, "IDASBBDPRE",
"IDABBDPrecInit", MSGBBD_SUNLS_FAIL);
return(IDALS_SUNLS_FAIL);
}
/* Set rel_yy based on input value dq_rel_yy (0 implies default). */
pdata->rel_yy = (dq_rel_yy > ZERO) ?
dq_rel_yy : SUNRsqrt(IDA_mem->ida_uround);
/* Store Nlocal to be used in IDABBDPrecSetup */
pdata->n_local = Nlocal;
/* Set work space sizes and initialize nge. */
pdata->rpwsize = 0;
pdata->ipwsize = 0;
if (IDA_mem->ida_tempv1->ops->nvspace) {
N_VSpace(IDA_mem->ida_tempv1, &lrw1, &liw1);
pdata->rpwsize += 4*lrw1;
pdata->ipwsize += 4*liw1;
}
if (pdata->rlocal->ops->nvspace) {
N_VSpace(pdata->rlocal, &lrw1, &liw1);
pdata->rpwsize += 2*lrw1;
pdata->ipwsize += 2*liw1;
}
if (pdata->PP->ops->space) {
flag = SUNMatSpace(pdata->PP, &lrw, &liw);
pdata->rpwsize += lrw;
pdata->ipwsize += liw;
}
if (pdata->LS->ops->space) {
flag = SUNLinSolSpace(pdata->LS, &lrw, &liw);
pdata->rpwsize += lrw;
pdata->ipwsize += liw;
}
pdata->nge = 0;
/* make sure pdata is free from any previous allocations */
if (idals_mem->pfree)
idals_mem->pfree(IDA_mem);
/* Point to the new pdata field in the LS memory */
idals_mem->pdata = pdata;
/* Attach the pfree function */
idals_mem->pfree = IDABBDPrecFree;
/* Attach preconditioner solve and setup functions */
flag = IDASetPreconditioner(ida_mem, IDABBDPrecSetup,
IDABBDPrecSolve);
return(flag);
}
