void FIDA_BAND(long int *neq, long int *mupper, long int *mlower, int *ier)
{
*ier = 0;
*ier = IDABand(IDA_idamem, *neq, *mupper, *mlower);
IDA_ls = IDA_LS_BAND;
return;
}
int IDABandB(void *ida_mem, int which,
int NeqB, int mupperB, int mlowerB)
{
IDAMem IDA_mem;
IDAadjMem IDAADJ_mem;
IDABMem IDAB_mem;
IDADlsMemB idadlsB_mem;
void *ida_memB;
int flag;
/* Is ida_mem allright? */
if (ida_mem == NULL) {
IDAProcessError(NULL, IDADLS_MEM_NULL, "IDASBAND", "IDABandB", MSGD_CAMEM_NULL);
return(IDADLS_MEM_NULL);
}
IDA_mem = (IDAMem) ida_mem;
/* Is ASA initialized? */
if (IDA_mem->ida_adjMallocDone == FALSE) {
IDAProcessError(IDA_mem, IDADLS_NO_ADJ, "IDASBAND", "IDABandB", MSGD_NO_ADJ);
return(IDADLS_NO_ADJ);
}
IDAADJ_mem = IDA_mem->ida_adj_mem;
/* Check the value of which */
if ( which >= IDAADJ_mem->ia_nbckpbs ) {
IDAProcessError(IDA_mem, IDADLS_ILL_INPUT, "IDASBAND", "IDABandB", MSGD_BAD_WHICH);
return(IDADLS_ILL_INPUT);
}
/* Find the IDABMem entry in the linked list corresponding to 'which'. */
IDAB_mem = IDAADJ_mem->IDAB_mem;
while (IDAB_mem != NULL) {
if( which == IDAB_mem->ida_index ) break;
/* advance */
IDAB_mem = IDAB_mem->ida_next;
}
/* Get memory for IDADlsMemRecB */
idadlsB_mem = (IDADlsMemB) malloc(sizeof(struct IDADlsMemRecB));
if (idadlsB_mem == NULL) {
IDAProcessError(IDAB_mem->IDA_mem, IDADLS_MEM_FAIL, "IDASBAND", "IDABandB", MSGD_MEM_FAIL);
return(IDADLS_MEM_FAIL);
}
/* set matrix type and initialize Jacob function. */
idadlsB_mem->d_typeB = SUNDIALS_BAND;
idadlsB_mem->d_bjacB = NULL;
/* Attach lmemB data and lfreeB function. */
IDAB_mem->ida_lmem = idadlsB_mem;
IDAB_mem->ida_lfree = IDABandFreeB;
/* Call IDABand for the IDAS data of the backward problem. */
ida_memB = (void *)IDAB_mem->IDA_mem;
flag = IDABand(ida_memB, NeqB, mupperB, mlowerB);
if (flag != IDADLS_SUCCESS) {
free(idadlsB_mem);
idadlsB_mem = NULL;
}
return(flag);
}
CAMLprim value sundials_ml_ida_band(value ida_solver, value N, value mupper, value mlower) {
CAMLparam4(ida_solver, N, mupper, mlower);
const int ret = IDABand(IDA_MEM(ida_solver), Int_val(N), Int_val(mupper), Int_val(mlower));
CAMLreturn(Val_int(ret));
}
int main(void)
{
void *mem;
UserData data;
N_Vector uu, up, constraints, id, res;
int ier, iout;
long int mu, ml, netf, ncfn;
realtype rtol, atol, t0, t1, tout, tret;
mem = NULL;
data = NULL;
uu = up = constraints = id = res = NULL;
/* Create vectors uu, up, res, constraints, id. */
uu = N_VNew_Serial(NEQ);
if(check_flag((void *)uu, "N_VNew_Serial", 0)) return(1);
up = N_VNew_Serial(NEQ);
if(check_flag((void *)up, "N_VNew_Serial", 0)) return(1);
res = N_VNew_Serial(NEQ);
if(check_flag((void *)res, "N_VNew_Serial", 0)) return(1);
constraints = N_VNew_Serial(NEQ);
if(check_flag((void *)constraints, "N_VNew_Serial", 0)) return(1);
id = N_VNew_Serial(NEQ);
if(check_flag((void *)id, "N_VNew_Serial", 0)) return(1);
/* Create and load problem data block. */
data = (UserData) malloc(sizeof *data);
if(check_flag((void *)data, "malloc", 2)) return(1);
data->mm = MGRID;
data->dx = ONE/(MGRID - ONE);
data->coeff = ONE/( (data->dx) * (data->dx) );
/* Initialize uu, up, id. */
SetInitialProfile(data, uu, up, id, res);
/* Set constraints to all 1's for nonnegative solution values. */
N_VConst(ONE, constraints);
/* Set remaining input parameters. */
t0 = ZERO;
t1 = RCONST(0.01);
rtol = ZERO;
atol = RCONST(1.0e-3);
/* Call IDACreate and IDAMalloc to initialize solution */
mem = IDACreate();
if(check_flag((void *)mem, "IDACreate", 0)) return(1);
ier = IDASetUserData(mem, data);
if(check_flag(&ier, "IDASetUserData", 1)) return(1);
ier = IDASetId(mem, id);
if(check_flag(&ier, "IDASetId", 1)) return(1);
ier = IDASetConstraints(mem, constraints);
if(check_flag(&ier, "IDASetConstraints", 1)) return(1);
N_VDestroy_Serial(constraints);
ier = IDAInit(mem, heatres, t0, uu, up);
if(check_flag(&ier, "IDAInit", 1)) return(1);
ier = IDASStolerances(mem, rtol, atol);
if(check_flag(&ier, "IDASStolerances", 1)) return(1);
/* Call IDABand to specify the linear solver. */
mu = MGRID; ml = MGRID;
ier = IDABand(mem, NEQ, mu, ml);
if(check_flag(&ier, "IDABand", 1)) return(1);
/* Call IDACalcIC to correct the initial values. */
ier = IDACalcIC(mem, IDA_YA_YDP_INIT, t1);
if(check_flag(&ier, "IDACalcIC", 1)) return(1);
/* Print output heading. */
PrintHeader(rtol, atol);
PrintOutput(mem, t0, uu);
/* Loop over output times, call IDASolve, and print results. */
for (tout = t1, iout = 1; iout <= NOUT; iout++, tout *= TWO) {
ier = IDASolve(mem, tout, &tret, uu, up, IDA_NORMAL);
if(check_flag(&ier, "IDASolve", 1)) return(1);
PrintOutput(mem, tret, uu);
}
/* Print remaining counters and free memory. */
ier = IDAGetNumErrTestFails(mem, &netf);
check_flag(&ier, "IDAGetNumErrTestFails", 1);
ier = IDAGetNumNonlinSolvConvFails(mem, &ncfn);
check_flag(&ier, "IDAGetNumNonlinSolvConvFails", 1);
printf("\n netf = %ld, ncfn = %ld \n", netf, ncfn);
IDAFree(&mem);
N_VDestroy_Serial(uu);
N_VDestroy_Serial(up);
N_VDestroy_Serial(id);
N_VDestroy_Serial(res);
free(data);
return(0);
}
int main()
{
void *mem;
UserData webdata;
N_Vector cc, cp, id;
int iout, retval;
long int mu, ml;
realtype rtol, atol, t0, tout, tret;
mem = NULL;
webdata = NULL;
cc = cp = id = NULL;
/* Allocate and initialize user data block webdata. */
webdata = (UserData) malloc(sizeof *webdata);
webdata->rates = N_VNew_Serial(NEQ);
webdata->acoef = newDenseMat(NUM_SPECIES, NUM_SPECIES);
InitUserData(webdata);
/* Allocate N-vectors and initialize cc, cp, and id. */
cc = N_VNew_Serial(NEQ);
if(check_flag((void *)cc, "N_VNew_Serial", 0)) return(1);
cp = N_VNew_Serial(NEQ);
if(check_flag((void *)cp, "N_VNew_Serial", 0)) return(1);
id = N_VNew_Serial(NEQ);
if(check_flag((void *)id, "N_VNew_Serial", 0)) return(1);
SetInitialProfiles(cc, cp, id, webdata);
/* Set remaining inputs to IDAMalloc. */
t0 = ZERO;
rtol = RTOL;
atol = ATOL;
/* Call IDACreate and IDAMalloc to initialize IDA. */
mem = IDACreate();
if(check_flag((void *)mem, "IDACreate", 0)) return(1);
retval = IDASetUserData(mem, webdata);
if(check_flag(&retval, "IDASetUserData", 1)) return(1);
retval = IDASetId(mem, id);
if(check_flag(&retval, "IDASetId", 1)) return(1);
retval = IDAInit(mem, resweb, t0, cc, cp);
if(check_flag(&retval, "IDAInit", 1)) return(1);
retval = IDASStolerances(mem, rtol, atol);
if(check_flag(&retval, "IDASStolerances", 1)) return(1);
/* Call IDABand to specify the IDA linear solver. */
mu = ml = NSMX;
retval = IDABand(mem, NEQ, mu, ml);
if(check_flag(&retval, "IDABand", 1)) return(1);
/* Call IDACalcIC (with default options) to correct the initial values. */
tout = RCONST(0.001);
retval = IDACalcIC(mem, IDA_YA_YDP_INIT, tout);
if(check_flag(&retval, "IDACalcIC", 1)) return(1);
/* Print heading, basic parameters, and initial values. */
PrintHeader(mu, ml, rtol, atol);
PrintOutput(mem, cc, ZERO);
/* Loop over iout, call IDASolve (normal mode), print selected output. */
for (iout = 1; iout <= NOUT; iout++) {
retval = IDASolve(mem, tout, &tret, cc, cp, IDA_NORMAL);
if(check_flag(&retval, "IDASolve", 1)) return(retval);
PrintOutput(mem, cc, tret);
if (iout < 3) tout *= TMULT; else tout += TADD;
}
/* Print final statistics and free memory. */
PrintFinalStats(mem);
/* Free memory */
IDAFree(&mem);
N_VDestroy_Serial(cc);
N_VDestroy_Serial(cp);
N_VDestroy_Serial(id);
destroyMat(webdata->acoef);
N_VDestroy_Serial(webdata->rates);
free(webdata);
return(0);
}
