/*
====================
Read_IntArray
====================
*/
int_array_t* Read_IntArray( tokenstream_t *ts )
{
int_array_t *ia;
int i;
// get intnum
GetToken( ts );
i = atoi( ts->token );
ia = NewIntArray( i );
ia->intnum = i;
for ( i = 0; i < ia->intnum; i++ )
{
GetToken( ts );
ia->ints[i] = atoi( ts->token );
}
return ia;
}
void *CPBBDPrecAlloc(void *cpode_mem, int Nlocal,
int mudq, int mldq, int mukeep, int mlkeep,
realtype dqrely,
void *gloc, CPBBDCommFn cfn)
{
CPodeMem cp_mem;
CPBBDPrecData pdata;
N_Vector tmp4;
int muk, mlk, storage_mu;
if (cpode_mem == NULL) {
cpProcessError(NULL, 0, "CPBBDPRE", "CPBBDPrecAlloc", MSGBBDP_CPMEM_NULL);
return(NULL);
}
cp_mem = (CPodeMem) cpode_mem;
/* Test if the NVECTOR package is compatible with the BLOCK BAND preconditioner */
if(vec_tmpl->ops->nvgetarraypointer == NULL) {
cpProcessError(cp_mem, 0, "CPBBDPRE", "CPBBDPrecAlloc", MSGBBDP_BAD_NVECTOR);
return(NULL);
}
/* Allocate data memory */
pdata = NULL;
pdata = (CPBBDPrecData) malloc(sizeof *pdata);
if (pdata == NULL) {
cpProcessError(cp_mem, 0, "CPBBDPRE", "CPBBDPrecAlloc", MSGBBDP_MEM_FAIL);
return(NULL);
}
/* Set pointers to gloc and cfn; load half-bandwidths */
pdata->cpode_mem = cpode_mem;
switch (ode_type) {
case CP_EXPL:
pdata->glocE = (CPBBDLocalRhsFn) gloc;
pdata->glocI = NULL;
break;
case CP_IMPL:
pdata->glocI = (CPBBDLocalResFn) gloc;
pdata->glocE = NULL;
break;
}
pdata->cfn = cfn;
pdata->mudq = MIN(Nlocal-1, MAX(0,mudq));
pdata->mldq = MIN(Nlocal-1, MAX(0,mldq));
muk = MIN(Nlocal-1, MAX(0,mukeep));
mlk = MIN(Nlocal-1, MAX(0,mlkeep));
pdata->mukeep = muk;
pdata->mlkeep = mlk;
/* Allocate memory for saved Jacobian */
pdata->savedJ = NewBandMat(Nlocal, muk, mlk, muk);
if (pdata->savedJ == NULL) {
free(pdata); pdata = NULL;
cpProcessError(cp_mem, 0, "CPBBDPRE", "CPBBDPrecAlloc", MSGBBDP_MEM_FAIL);
return(NULL);
}
/* Allocate memory for preconditioner matrix */
storage_mu = MIN(Nlocal-1, muk + mlk);
pdata->savedP = NULL;
pdata->savedP = NewBandMat(Nlocal, muk, mlk, storage_mu);
if (pdata->savedP == NULL) {
DestroyMat(pdata->savedJ);
free(pdata); pdata = NULL;
cpProcessError(cp_mem, 0, "CPBBDPRE", "CPBBDPrecAlloc", MSGBBDP_MEM_FAIL);
return(NULL);
}
/* Allocate memory for pivots */
pdata->pivots = NULL;
pdata->pivots = NewIntArray(Nlocal);
if (pdata->savedJ == NULL) {
DestroyMat(pdata->savedP);
DestroyMat(pdata->savedJ);
free(pdata); pdata = NULL;
cpProcessError(cp_mem, 0, "CPBBDPRE", "CPBBDPrecAlloc", MSGBBDP_MEM_FAIL);
return(NULL);
}
/* Allocate tmp4 for use by cpBBDDQJacImpl */
tmp4 = NULL;
tmp4 = N_VClone(vec_tmpl);
if (tmp4 == NULL){
DestroyMat(pdata->savedP);
DestroyMat(pdata->savedJ);
DestroyArray(pdata->pivots);
free(pdata); pdata = NULL;
cpProcessError(cp_mem, 0, "CPBBDPRE", "CPBBDPrecAlloc", MSGBBDP_MEM_FAIL);
return(NULL);
}
pdata->tmp4 = tmp4;
/* Set pdata->dqrely based on input dqrely (0 implies default). */
pdata->dqrely = (dqrely > ZERO) ? dqrely : RSqrt(uround);
/* Store Nlocal to be used in cpBBDPrecSetupExpl and cpBBDPrecSetupImpl */
pdata->n_local = Nlocal;
/* Set work space sizes and initialize nge */
pdata->rpwsize = Nlocal*(muk + 2*mlk + storage_mu + 2);
pdata->ipwsize = Nlocal;
pdata->nge = 0;
return((void *)pdata);
}
int IDADense(void *ida_mem, int Neq)
{
IDAMem IDA_mem;
IDADlsMem idadls_mem;
int flag;
/* Return immediately if ida_mem is NULL. */
if (ida_mem == NULL) {
IDAProcessError(NULL, IDADLS_MEM_NULL, "IDADENSE", "IDADense", MSGD_IDAMEM_NULL);
return(IDADLS_MEM_NULL);
}
IDA_mem = (IDAMem) ida_mem;
/* Test if the NVECTOR package is compatible with the DENSE solver */
if(vec_tmpl->ops->nvgetarraypointer == NULL ||
vec_tmpl->ops->nvsetarraypointer == NULL) {
IDAProcessError(IDA_mem, IDADLS_ILL_INPUT, "IDADENSE", "IDADense", MSGD_BAD_NVECTOR);
return(IDADLS_ILL_INPUT);
}
if (lfree != NULL) flag = lfree(IDA_mem);
/* Set five main function fields in IDA_mem. */
linit = IDADenseInit;
lsetup = IDADenseSetup;
lsolve = IDADenseSolve;
lperf = NULL;
lfree = IDADenseFree;
/* Get memory for IDADlsMemRec. */
idadls_mem = NULL;
idadls_mem = (IDADlsMem) malloc(sizeof(struct IDADlsMemRec));
if (idadls_mem == NULL) {
IDAProcessError(IDA_mem, IDADLS_MEM_FAIL, "IDADENSE", "IDADense", MSGD_MEM_FAIL);
return(IDADLS_MEM_FAIL);
}
/* Set matrix type */
mtype = SUNDIALS_DENSE;
/* Set default Jacobian routine and Jacobian data */
jacDQ = TRUE;
djac = NULL;
jacdata = NULL;
last_flag = IDADLS_SUCCESS;
setupNonNull = TRUE;
/* Store problem size */
neq = Neq;
/* Allocate memory for JJ and pivot array. */
JJ = NULL;
JJ = NewDenseMat(Neq, Neq);
if (JJ == NULL) {
IDAProcessError(IDA_mem, IDADLS_MEM_FAIL, "IDADENSE", "IDADense", MSGD_MEM_FAIL);
free(idadls_mem); idadls_mem = NULL;
return(IDADLS_MEM_FAIL);
}
pivots = NULL;
pivots = NewIntArray(Neq);
if (pivots == NULL) {
IDAProcessError(IDA_mem, IDADLS_MEM_FAIL, "IDADENSE", "IDADense", MSGD_MEM_FAIL);
DestroyMat(JJ);
free(idadls_mem); idadls_mem = NULL;
return(IDADLS_MEM_FAIL);
}
/* Attach linear solver memory to the integrator memory */
lmem = idadls_mem;
return(IDADLS_SUCCESS);
}
int CVDense(void *cvode_mem, int N)
{
CVodeMem cv_mem;
CVDlsMem cvdls_mem;
/* Return immediately if cvode_mem is NULL */
if (cvode_mem == NULL) {
CVProcessError(NULL, CVDLS_MEM_NULL, "CVDENSE", "CVDense", MSGD_CVMEM_NULL);
return(CVDLS_MEM_NULL);
}
cv_mem = (CVodeMem) cvode_mem;
/* Test if the NVECTOR package is compatible with the DENSE solver */
if (vec_tmpl->ops->nvgetarraypointer == NULL ||
vec_tmpl->ops->nvsetarraypointer == NULL) {
CVProcessError(cv_mem, CVDLS_ILL_INPUT, "CVDENSE", "CVDense", MSGD_BAD_NVECTOR);
return(CVDLS_ILL_INPUT);
}
if (lfree !=NULL) lfree(cv_mem);
/* Set four main function fields in cv_mem */
linit = cvDenseInit;
lsetup = cvDenseSetup;
lsolve = cvDenseSolve;
lfree = cvDenseFree;
/* Get memory for CVDlsMemRec */
cvdls_mem = NULL;
cvdls_mem = (CVDlsMem) malloc(sizeof(struct CVDlsMemRec));
if (cvdls_mem == NULL) {
CVProcessError(cv_mem, CVDLS_MEM_FAIL, "CVDENSE", "CVDense", MSGD_MEM_FAIL);
return(CVDLS_MEM_FAIL);
}
/* Set matrix type */
mtype = SUNDIALS_DENSE;
/* Initialize Jacobian-related data */
jacDQ = TRUE;
jac = NULL;
J_data = NULL;
last_flag = CVDLS_SUCCESS;
setupNonNull = TRUE;
/* Set problem dimension */
n = N;
/* Allocate memory for M, savedJ, and pivot array */
M = NULL;
M = NewDenseMat(N, N);
if (M == NULL) {
CVProcessError(cv_mem, CVDLS_MEM_FAIL, "CVDENSE", "CVDense", MSGD_MEM_FAIL);
free(cvdls_mem); cvdls_mem = NULL;
return(CVDLS_MEM_FAIL);
}
savedJ = NULL;
savedJ = NewDenseMat(N, N);
if (savedJ == NULL) {
CVProcessError(cv_mem, CVDLS_MEM_FAIL, "CVDENSE", "CVDense", MSGD_MEM_FAIL);
DestroyMat(M);
free(cvdls_mem); cvdls_mem = NULL;
return(CVDLS_MEM_FAIL);
}
pivots = NULL;
pivots = NewIntArray(N);
if (pivots == NULL) {
CVProcessError(cv_mem, CVDLS_MEM_FAIL, "CVDENSE", "CVDense", MSGD_MEM_FAIL);
DestroyMat(M);
DestroyMat(savedJ);
free(cvdls_mem); cvdls_mem = NULL;
return(CVDLS_MEM_FAIL);
}
/* Attach linear solver memory to integrator memory */
lmem = cvdls_mem;
return(CVDLS_SUCCESS);
}
int CVBand(void *cvode_mem, int N, int mupper, int mlower)
{
CVodeMem cv_mem;
CVDlsMem cvdls_mem;
/* Return immediately if cvode_mem is NULL */
if (cvode_mem == NULL) {
cvProcessError(NULL, CVDLS_MEM_NULL, "CVSBAND", "CVBand", MSGD_CVMEM_NULL);
return(CVDLS_MEM_NULL);
}
cv_mem = (CVodeMem) cvode_mem;
/* Test if the NVECTOR package is compatible with the BAND solver */
if (vec_tmpl->ops->nvgetarraypointer == NULL) {
cvProcessError(cv_mem, CVDLS_ILL_INPUT, "CVSBAND", "CVBand", MSGD_BAD_NVECTOR);
return(CVDLS_ILL_INPUT);
}
if (lfree != NULL) lfree(cv_mem);
/* Set four main function fields in cv_mem */
linit = cvBandInit;
lsetup = cvBandSetup;
lsolve = cvBandSolve;
lfree = cvBandFree;
/* Get memory for CVDlsMemRec */
cvdls_mem = NULL;
cvdls_mem = (CVDlsMem) malloc(sizeof(struct CVDlsMemRec));
if (cvdls_mem == NULL) {
cvProcessError(cv_mem, CVDLS_MEM_FAIL, "CVSBAND", "CVBand", MSGD_MEM_FAIL);
return(CVDLS_MEM_FAIL);
}
/* Set matrix type */
mtype = SUNDIALS_BAND;
/* Initialize Jacobian-related data */
jacDQ = TRUE;
jac = NULL;
J_data = NULL;
last_flag = CVDLS_SUCCESS;
setupNonNull = TRUE;
/* Load problem dimension */
n = N;
/* Load half-bandwiths in cvdls_mem */
ml = mlower;
mu = mupper;
/* Test ml and mu for legality */
if ((ml < 0) || (mu < 0) || (ml >= N) || (mu >= N)) {
cvProcessError(cv_mem, CVDLS_ILL_INPUT, "CVSBAND", "CVBand", MSGD_BAD_SIZES);
return(CVDLS_ILL_INPUT);
}
/* Set extended upper half-bandwith for M (required for pivoting) */
smu = MIN(N-1, mu + ml);
/* Allocate memory for M, savedJ, and pivot arrays */
M = NULL;
M = NewBandMat(N, mu, ml, smu);
if (M == NULL) {
cvProcessError(cv_mem, CVDLS_MEM_FAIL, "CVSBAND", "CVBand", MSGD_MEM_FAIL);
free(cvdls_mem); cvdls_mem = NULL;
return(CVDLS_MEM_FAIL);
}
savedJ = NULL;
savedJ = NewBandMat(N, mu, ml, mu);
if (savedJ == NULL) {
cvProcessError(cv_mem, CVDLS_MEM_FAIL, "CVSBAND", "CVBand", MSGD_MEM_FAIL);
DestroyMat(M);
free(cvdls_mem); cvdls_mem = NULL;
return(CVDLS_MEM_FAIL);
}
pivots = NULL;
pivots = NewIntArray(N);
if (pivots == NULL) {
cvProcessError(cv_mem, CVDLS_MEM_FAIL, "CVSBAND", "CVBand", MSGD_MEM_FAIL);
DestroyMat(M);
DestroyMat(savedJ);
free(cvdls_mem); cvdls_mem = NULL;
return(CVDLS_MEM_FAIL);
}
/* Attach linear solver memory to integrator memory */
lmem = cvdls_mem;
return(CVDLS_SUCCESS);
}
/*
* -----------------------------------------------------------------
* IDALapackBand
* -----------------------------------------------------------------
* This routine initializes the memory record and sets various function
* fields specific to the band linear solver module. It first calls
* the existing lfree routine if this is not NULL. It then sets the
* ida_linit, ida_lsetup, ida_lsolve, and ida_lfree fields in (*ida_mem)
* to be idaLapackBandInit, idaLapackBandSetup, idaLapackBandSolve,
* and idaLapackBandFree, respectively. It allocates memory for a
* structure of type IDALapackBandMemRec and sets the ida_lmem field in
* (*ida_mem) to the address of this structure. It sets setupNonNull
* in (*ida_mem) to be TRUE, mu to be mupper, ml to be mlower, and
* the jacE and jacI field to NULL.
* Finally, it allocates memory for M and pivots.
* The IDALapackBand return value is IDADLS_SUCCESS = 0,
* IDADLS_MEM_FAIL = -1, or IDADLS_ILL_INPUT = -2.
*
* NOTE: The IDALAPACK linear solver assumes a serial implementation
* of the NVECTOR package. Therefore, IDALapackBand will first
* test for compatible a compatible N_Vector internal
* representation by checking that the function
* N_VGetArrayPointer exists.
* -----------------------------------------------------------------
*/
int IDALapackBand(void *ida_mem, int N, int mupper, int mlower)
{
IDAMem IDA_mem;
IDADlsMem idadls_mem;
/* Return immediately if ida_mem is NULL */
if (ida_mem == NULL) {
IDAProcessError(NULL, IDADLS_MEM_NULL, "IDALAPACK", "IDALapackBand", MSGD_IDAMEM_NULL);
return(IDADLS_MEM_NULL);
}
IDA_mem = (IDAMem) ida_mem;
/* Test if the NVECTOR package is compatible with the BAND solver */
if (tempv->ops->nvgetarraypointer == NULL) {
IDAProcessError(IDA_mem, IDADLS_ILL_INPUT, "IDALAPACK", "IDALapackBand", MSGD_BAD_NVECTOR);
return(IDADLS_ILL_INPUT);
}
if (lfree != NULL) lfree(IDA_mem);
/* Set four main function fields in IDA_mem */
linit = idaLapackBandInit;
lsetup = idaLapackBandSetup;
lsolve = idaLapackBandSolve;
lperf = NULL;
lfree = idaLapackBandFree;
/* Get memory for IDADlsMemRec */
idadls_mem = NULL;
idadls_mem = (IDADlsMem) malloc(sizeof(struct IDADlsMemRec));
if (idadls_mem == NULL) {
IDAProcessError(IDA_mem, IDADLS_MEM_FAIL, "IDALAPACK", "IDALapackBand", MSGD_MEM_FAIL);
return(IDADLS_MEM_FAIL);
}
/* Set matrix type */
mtype = SUNDIALS_BAND;
/* Set default Jacobian routine and Jacobian data */
jacDQ = TRUE;
bjac = NULL;
J_data = NULL;
last_flag = IDADLS_SUCCESS;
setupNonNull = TRUE;
/* Load problem dimension */
n = (long int) N;
/* Load half-bandwiths in idadls_mem */
ml = (long int) mlower;
mu = (long int) mupper;
/* Test ml and mu for legality */
if ((ml < 0) || (mu < 0) || (ml >= n) || (mu >= n)) {
IDAProcessError(IDA_mem, IDADLS_ILL_INPUT, "IDALAPACK", "IDALapackBand", MSGD_BAD_SIZES);
free(idadls_mem); idadls_mem = NULL;
return(IDADLS_ILL_INPUT);
}
/* Set extended upper half-bandwith for M (required for pivoting) */
smu = MIN(n-1, mu + ml);
/* Allocate memory for JJ and pivot arrays */
JJ = NULL;
pivots = NULL;
JJ = NewBandMat(n, mu, ml, smu);
if (JJ == NULL) {
IDAProcessError(IDA_mem, IDADLS_MEM_FAIL, "IDALAPACK", "IDALapackBand", MSGD_MEM_FAIL);
free(idadls_mem); idadls_mem = NULL;
return(IDADLS_MEM_FAIL);
}
pivots = NewIntArray(N);
if (pivots == NULL) {
IDAProcessError(IDA_mem, IDADLS_MEM_FAIL, "IDALAPACK", "IDALapackBand", MSGD_MEM_FAIL);
DestroyMat(JJ);
free(idadls_mem); idadls_mem = NULL;
return(IDADLS_MEM_FAIL);
}
/* Attach linear solver memory to integrator memory */
lmem = idadls_mem;
return(IDADLS_SUCCESS);
}
int CPDense(void *cpode_mem, int N)
{
CPodeMem cp_mem;
CPDlsMem cpdls_mem;
/* Return immediately if cpode_mem is NULL */
if (cpode_mem == NULL) {
cpProcessError(NULL, CPDIRECT_MEM_NULL, "CPDENSE", "CPDense", MSGD_CPMEM_NULL);
return(CPDIRECT_MEM_NULL);
}
cp_mem = (CPodeMem) cpode_mem;
/* Test if the NVECTOR package is compatible with the DENSE solver */
if (tempv->ops->nvgetarraypointer == NULL ||
tempv->ops->nvsetarraypointer == NULL) {
cpProcessError(cp_mem, CPDIRECT_ILL_INPUT, "CPDENSE", "CPDense", MSGD_BAD_NVECTOR);
return(CPDIRECT_ILL_INPUT);
}
if (lfree !=NULL) lfree(cp_mem);
/* Set four main function fields in cp_mem */
linit = cpDenseInit;
lsetup = cpDenseSetup;
lsolve = cpDenseSolve;
lfree = cpDenseFree;
/* Get memory for CPDlsMemRec */
cpdls_mem = NULL;
cpdls_mem = (CPDlsMem) malloc(sizeof(CPDlsMemRec));
if (cpdls_mem == NULL) {
cpProcessError(cp_mem, CPDIRECT_MEM_FAIL, "CPDENSE", "CPDense", MSGD_MEM_FAIL);
return(CPDIRECT_MEM_FAIL);
}
/* Set matrix type */
mtype = SUNDIALS_DENSE;
/* Set default Jacobian routine and Jacobian data */
jacE = NULL;
jacI = NULL;
J_data = NULL;
last_flag = CPDIRECT_SUCCESS;
lsetup_exists = TRUE;
/* Set problem dimension */
n = N;
/* Allocate memory for M, pivot array, and (if needed) savedJ */
M = NULL;
pivots = NULL;
savedJ = NULL;
M = NewDenseMat(N, N);
if (M == NULL) {
cpProcessError(cp_mem, CPDIRECT_MEM_FAIL, "CPDENSE", "CPDense", MSGD_MEM_FAIL);
free(cpdls_mem);
return(CPDIRECT_MEM_FAIL);
}
pivots = NewIntArray(N);
if (pivots == NULL) {
cpProcessError(cp_mem, CPDIRECT_MEM_FAIL, "CPDENSE", "CPDense", MSGD_MEM_FAIL);
DestroyMat(M);
free(cpdls_mem);
return(CPDIRECT_MEM_FAIL);
}
if (ode_type == CP_EXPL) {
savedJ = NewDenseMat(N, N);
if (savedJ == NULL) {
cpProcessError(cp_mem, CPDIRECT_MEM_FAIL, "CPDENSE", "CPDense", MSGD_MEM_FAIL);
DestroyMat(M);
DestroyArray(pivots);
free(cpdls_mem);
return(CPDIRECT_MEM_FAIL);
}
}
/* Attach linear solver memory to integrator memory */
lmem = cpdls_mem;
return(CPDIRECT_SUCCESS);
}
/*
* -----------------------------------------------------------------
* KINLapackBand
* -----------------------------------------------------------------
* This routine initializes the memory record and sets various function
* fields specific to the band linear solver module. It first calls
* the existing lfree routine if this is not NULL. It then sets the
* kin_linit, kin_lsetup, kin_lsolve, and kin_lfree fields in (*kinmem)
* to be kinLapackBandInit, kinLapackBandSetup, kinLapackBandSolve,
* and kinLapackBandFree, respectively. It allocates memory for a
* structure of type KINLapackBandMemRec and sets the kin_lmem field in
* (*kinmem) to the address of this structure. It sets lsetup_exists
* in (*kinmem) to be TRUE, mu to be mupper, ml to be mlower, and
* the bjac field to kinDlsBandDQJac
* Finally, it allocates memory for M, pivots, and (if needed) savedJ.
* The KINLapackBand return value is KINDLS_SUCCESS = 0,
* KINDLS_MEM_FAIL = -1, or KINDLS_ILL_INPUT = -2.
*
* NOTE: The KINLAPACK linear solver assumes a serial implementation
* of the NVECTOR package. Therefore, KINLapackBand will first
* test for compatible a compatible N_Vector internal
* representation by checking that the function
* N_VGetArrayPointer exists.
* -----------------------------------------------------------------
*/
int KINLapackBand(void *kinmem, int N, int mupper, int mlower)
{
KINMem kin_mem;
KINDlsMem kindls_mem;
/* Return immediately if kinmem is NULL */
if (kinmem == NULL) {
KINProcessError(NULL, KINDLS_MEM_NULL, "KINLAPACK", "KINLapackBand", MSGD_KINMEM_NULL);
return(KINDLS_MEM_NULL);
}
kin_mem = (KINMem) kinmem;
/* Test if the NVECTOR package is compatible with the BAND solver */
if (vec_tmpl->ops->nvgetarraypointer == NULL) {
KINProcessError(kin_mem, KINDLS_ILL_INPUT, "KINLAPACK", "KINLapackBand", MSGD_BAD_NVECTOR);
return(KINDLS_ILL_INPUT);
}
if (lfree != NULL) lfree(kin_mem);
/* Set four main function fields in kin_mem */
linit = kinLapackBandInit;
lsetup = kinLapackBandSetup;
lsolve = kinLapackBandSolve;
lfree = kinLapackBandFree;
/* Get memory for KINDlsMemRec */
kindls_mem = NULL;
kindls_mem = (KINDlsMem) malloc(sizeof(struct KINDlsMemRec));
if (kindls_mem == NULL) {
KINProcessError(kin_mem, KINDLS_MEM_FAIL, "KINLAPACK", "KINLapackBand", MSGD_MEM_FAIL);
return(KINDLS_MEM_FAIL);
}
/* Set matrix type */
mtype = SUNDIALS_BAND;
/* Set default Jacobian routine and Jacobian data */
jacDQ = TRUE;
bjac = NULL;
J_data = NULL;
last_flag = KINDLS_SUCCESS;
setupNonNull = TRUE;
/* Load problem dimension */
n = N;
/* Load half-bandwiths in kindls_mem */
ml = mlower;
mu = mupper;
/* Test ml and mu for legality */
if ((ml < 0) || (mu < 0) || (ml >= N) || (mu >= N)) {
KINProcessError(kin_mem, KINDLS_MEM_FAIL, "KINLAPACK", "KINLapackBand", MSGD_MEM_FAIL);
return(KINDLS_ILL_INPUT);
}
/* Set extended upper half-bandwith for M (required for pivoting) */
smu = MIN(N-1, mu + ml);
/* Allocate memory for J and pivot array */
J = NULL;
J = NewBandMat(N, mu, ml, smu);
if (J == NULL) {
KINProcessError(kin_mem, KINDLS_MEM_FAIL, "KINLAPACK", "KINLapackBand", MSGD_MEM_FAIL);
free(kindls_mem); kindls_mem = NULL;
return(KINDLS_MEM_FAIL);
}
pivots = NULL;
pivots = NewIntArray(N);
if (pivots == NULL) {
KINProcessError(kin_mem, KINDLS_MEM_FAIL, "KINLAPACK", "KINLapackBand", MSGD_MEM_FAIL);
DestroyMat(J);
free(kindls_mem); kindls_mem = NULL;
return(KINDLS_MEM_FAIL);
}
/* This is a direct linear solver */
inexact_ls = FALSE;
/* Attach linear solver memory to integrator memory */
lmem = kindls_mem;
return(KINDLS_SUCCESS);
}
/*---------------------------------------------------------------
ARKMassLapackBand:
This routine initializes the memory record and sets various
function fields specific to the band mass matrix solver module.
It first calls the existing mfree routine if this is not NULL.
It then sets the ark_minit, ark_msetup, ark_msolve, and ark_mfree
fields in (*arkode_mem) to be arkMassLapackBandInit,
arkMassLapackBandSetup, arkMassLapackBandSolve, and
arkMassLapackBandFree, respectively. It allocates memory for a
structure of type ARKMassLapackBandMemRec and sets the
ark_mass_mem field in (*arkode_mem) to the address of this
structure. It sets MassSetupNonNull in (*arkode_mem) to be TRUE,
mu to be mupper, and ml to be mlower. Finally, it allocates
memory for M and pivots. The ARKMassLapackBand return value is
ARKDLS_SUCCESS=0, ARKDLS_MEM_FAIL=-1, or ARKDLS_ILL_INPUT=-2.
NOTE: The ARKLAPACK linear solver assumes a serial implementation
of the NVECTOR package. Therefore, ARKMassLapackBand will first
test for compatible a compatible N_Vector internal
representation by checking that the function
N_VGetArrayPointer exists. Again, this test is insufficient
to guarantee the serial NVECTOR package, but it's a start.
---------------------------------------------------------------*/
int ARKMassLapackBand(void *arkode_mem, int N, int mupper,
int mlower, ARKDlsBandMassFn bmass)
{
ARKodeMem ark_mem;
ARKDlsMassMem arkdls_mem;
/* Return immediately if arkode_mem is NULL */
if (arkode_mem == NULL) {
arkProcessError(NULL, ARKDLS_MEM_NULL, "ARKLAPACK",
"ARKMassLapackBand", MSGD_ARKMEM_NULL);
return(ARKDLS_MEM_NULL);
}
ark_mem = (ARKodeMem) arkode_mem;
/* Test if the NVECTOR package is compatible with the BAND solver */
if (ark_mem->ark_tempv->ops->nvgetarraypointer == NULL) {
arkProcessError(ark_mem, ARKDLS_ILL_INPUT, "ARKLAPACK",
"ARKMassLapackBand", MSGD_BAD_NVECTOR);
return(ARKDLS_ILL_INPUT);
}
if (ark_mem->ark_mfree != NULL) ark_mem->ark_mfree(ark_mem);
/* Set four main function fields in ark_mem, enable mass matrix */
ark_mem->ark_mass_matrix = TRUE;
ark_mem->ark_minit = arkMassLapackBandInit;
ark_mem->ark_msetup = arkMassLapackBandSetup;
ark_mem->ark_msolve = arkMassLapackBandSolve;
ark_mem->ark_mfree = arkMassLapackBandFree;
ark_mem->ark_mtimes = arkMassLapackBandMultiply;
ark_mem->ark_mtimes_data = (void *) ark_mem;
ark_mem->ark_msolve_type = 2;
/* Get memory for ARKDlsMassMemRec */
arkdls_mem = NULL;
arkdls_mem = (ARKDlsMassMem) malloc(sizeof(struct ARKDlsMassMemRec));
if (arkdls_mem == NULL) {
arkProcessError(ark_mem, ARKDLS_MEM_FAIL, "ARKLAPACK",
"ARKMassLapackBand", MSGD_MEM_FAIL);
return(ARKDLS_MEM_FAIL);
}
/* Set matrix type */
arkdls_mem->d_type = SUNDIALS_BAND;
/* Initialize mass-matrix-related data */
arkdls_mem->d_bmass = bmass;
arkdls_mem->d_M_data = NULL;
arkdls_mem->d_last_flag = ARKDLS_SUCCESS;
ark_mem->ark_MassSetupNonNull = TRUE;
/* Load problem dimension */
arkdls_mem->d_n = (long int) N;
/* Load half-bandwiths in arkdls_mem */
arkdls_mem->d_ml = (long int) mlower;
arkdls_mem->d_mu = (long int) mupper;
/* Test ml and mu for legality */
if ((arkdls_mem->d_ml < 0) || (arkdls_mem->d_mu < 0) ||
(arkdls_mem->d_ml >= arkdls_mem->d_n) ||
(arkdls_mem->d_mu >= arkdls_mem->d_n)) {
arkProcessError(ark_mem, ARKDLS_ILL_INPUT, "ARKLAPACK",
"ARKMassLapackBand", MSGD_BAD_SIZES);
free(arkdls_mem); arkdls_mem = NULL;
return(ARKDLS_ILL_INPUT);
}
/* Set extended upper half-bandwith for M (required for pivoting) */
arkdls_mem->d_smu = SUNMIN(arkdls_mem->d_n-1,
arkdls_mem->d_mu + arkdls_mem->d_ml);
/* Allocate memory for M and pivot array */
arkdls_mem->d_M = NULL;
arkdls_mem->d_pivots = NULL;
arkdls_mem->d_M = NewBandMat(arkdls_mem->d_n, arkdls_mem->d_mu,
arkdls_mem->d_ml, arkdls_mem->d_smu);
if (arkdls_mem->d_M == NULL) {
arkProcessError(ark_mem, ARKDLS_MEM_FAIL, "ARKLAPACK",
"ARKMassLapackBand", MSGD_MEM_FAIL);
free(arkdls_mem); arkdls_mem = NULL;
return(ARKDLS_MEM_FAIL);
}
arkdls_mem->d_pivots = NewIntArray(N);
if (arkdls_mem->d_pivots == NULL) {
arkProcessError(ark_mem, ARKDLS_MEM_FAIL, "ARKLAPACK",
"ARKMassLapackBand", MSGD_MEM_FAIL);
DestroyMat(arkdls_mem->d_M);
free(arkdls_mem); arkdls_mem = NULL;
return(ARKDLS_MEM_FAIL);
}
/* Attach linear solver memory to integrator memory */
ark_mem->ark_mass_mem = arkdls_mem;
return(ARKDLS_SUCCESS);
}
/*
* -----------------------------------------------------------------
* KINLapackDense
* -----------------------------------------------------------------
* This routine initializes the memory record and sets various function
* fields specific to the linear solver module. KINLapackDense first
* calls the existing lfree routine if this is not NULL. Then it sets
* the kin_linit, kin_lsetup, kin_lsolve, kin_lfree fields in (*kinmem)
* to be kinLapackDenseInit, kinLapackDenseSetup, kinLapackDenseSolve,
* and kinLapackDenseFree, respectively. It allocates memory for a
* structure of type KINDlsMemRec and sets the kin_lmem field in
* (*kinmem) to the address of this structure. It sets lsetup_exists
* in (*kinmem) to TRUE, and the djac field to the default
* kinLapackDenseDQJac. Finally, it allocates memory for M, pivots, and
* (if needed) savedJ.
*
* NOTE: The dense linear solver assumes a serial implementation
* of the NVECTOR package. Therefore, KINLapackDense will first
* test for a compatible N_Vector internal representation
* by checking that N_VGetArrayPointer and N_VSetArrayPointer
* exist.
* -----------------------------------------------------------------
*/
int KINLapackDense(void *kinmem, int N)
{
KINMem kin_mem;
KINDlsMem kindls_mem;
/* Return immediately if kinmem is NULL */
if (kinmem == NULL) {
KINProcessError(NULL, KINDLS_MEM_NULL, "KINLAPACK", "KINLapackDense", MSGD_KINMEM_NULL);
return(KINDLS_MEM_NULL);
}
kin_mem = (KINMem) kinmem;
/* Test if the NVECTOR package is compatible with the DENSE solver */
if (vec_tmpl->ops->nvgetarraypointer == NULL ||
vec_tmpl->ops->nvsetarraypointer == NULL) {
KINProcessError(kin_mem, KINDLS_ILL_INPUT, "KINLAPACK", "KINLapackDense", MSGD_BAD_NVECTOR);
return(KINDLS_ILL_INPUT);
}
if (lfree !=NULL) lfree(kin_mem);
/* Set four main function fields in kin_mem */
linit = kinLapackDenseInit;
lsetup = kinLapackDenseSetup;
lsolve = kinLapackDenseSolve;
lfree = kinLapackDenseFree;
/* Get memory for KINDlsMemRec */
kindls_mem = NULL;
kindls_mem = (KINDlsMem) malloc(sizeof(struct KINDlsMemRec));
if (kindls_mem == NULL) {
KINProcessError(kin_mem, KINDLS_MEM_FAIL, "KINLAPACK", "KINLapackDense", MSGD_MEM_FAIL);
return(KINDLS_MEM_FAIL);
}
/* Set matrix type */
mtype = SUNDIALS_DENSE;
/* Set default Jacobian routine and Jacobian data */
jacDQ = TRUE;
djac = NULL;
J_data = NULL;
last_flag = KINDLS_SUCCESS;
setupNonNull = TRUE;
/* Set problem dimension */
n = N;
/* Allocate memory for J and pivot array */
J = NULL;
J = NewDenseMat(N, N);
if (J == NULL) {
KINProcessError(kin_mem, KINDLS_MEM_FAIL, "KINLAPACK", "KINLapackDense", MSGD_MEM_FAIL);
free(kindls_mem); kindls_mem = NULL;
return(KINDLS_MEM_FAIL);
}
pivots = NULL;
pivots = NewIntArray(N);
if (pivots == NULL) {
KINProcessError(kin_mem, KINDLS_MEM_FAIL, "KINLAPACK", "KINLapackDense", MSGD_MEM_FAIL);
DestroyMat(J);
free(kindls_mem); kindls_mem = NULL;
return(KINDLS_MEM_FAIL);
}
/* This is a direct linear solver */
inexact_ls = FALSE;
/* Attach linear solver memory to integrator memory */
lmem = kindls_mem;
return(KINDLS_SUCCESS);
}
/*---------------------------------------------------------------
ARKMassLapackDense:
This routine initializes the memory record and sets various
function fields specific to the mass matrix solver module.
ARKMassLapackDense first calls the existing mfree routine if
this is not NULL. Then it sets the ark_minit, ark_msetup,
ark_msolve, ark_mfree fields in (*arkode_mem) to be
arkMassLapackDenseInit, arkMassLapackDenseSetup,
arkMassLapackDenseSolve, and arkMassLapackDenseFree,
respectively. It allocates memory for a structure of type
ARKDlsMassMemRec and sets the ark_mass_mem field in
(*arkode_mem) to the address of this structure. It sets
MassSetupNonNull in (*arkode_mem) to TRUE. Finally, it
allocates memory for M and pivots. The return value is
SUCCESS = 0, or LMEM_FAIL = -1.
NOTE: The dense linear solver assumes a serial implementation
of the NVECTOR package. Therefore, ARKMassLapackDense will
first test for a compatible N_Vector internal
representation by checking that N_VGetArrayPointer and
N_VSetArrayPointer exist. Of course, other vector
implementations may also have these functions set, so
this test is not sufficient to guarantee use of the
serial NVECTOR package.
---------------------------------------------------------------*/
int ARKMassLapackDense(void *arkode_mem, int N,
ARKDlsDenseMassFn dmass)
{
ARKodeMem ark_mem;
ARKDlsMassMem arkdls_mem;
/* Return immediately if arkode_mem is NULL */
if (arkode_mem == NULL) {
arkProcessError(NULL, ARKDLS_MEM_NULL, "ARKLAPACK",
"ARKMassLapackDense", MSGD_ARKMEM_NULL);
return(ARKDLS_MEM_NULL);
}
ark_mem = (ARKodeMem) arkode_mem;
/* Test if the NVECTOR package is compatible with the LAPACK solver */
if (ark_mem->ark_tempv->ops->nvgetarraypointer == NULL ||
ark_mem->ark_tempv->ops->nvsetarraypointer == NULL) {
arkProcessError(ark_mem, ARKDLS_ILL_INPUT, "ARKLAPACK",
"ARKMassLapackDense", MSGD_BAD_NVECTOR);
return(ARKDLS_ILL_INPUT);
}
if (ark_mem->ark_mfree !=NULL) ark_mem->ark_mfree(ark_mem);
/* Set related function fields in ark_mem, enable mass matrix */
ark_mem->ark_mass_matrix = TRUE;
ark_mem->ark_minit = arkMassLapackDenseInit;
ark_mem->ark_msetup = arkMassLapackDenseSetup;
ark_mem->ark_msolve = arkMassLapackDenseSolve;
ark_mem->ark_mfree = arkMassLapackDenseFree;
ark_mem->ark_mtimes = arkMassLapackDenseMultiply;
ark_mem->ark_mtimes_data = (void *) ark_mem;
ark_mem->ark_msolve_type = 1;
/* Get memory for ARKDlsMassMemRec */
arkdls_mem = NULL;
arkdls_mem = (ARKDlsMassMem) malloc(sizeof(struct ARKDlsMassMemRec));
if (arkdls_mem == NULL) {
arkProcessError(ark_mem, ARKDLS_MEM_FAIL, "ARKLAPACK",
"ARKMassLapackDense", MSGD_MEM_FAIL);
return(ARKDLS_MEM_FAIL);
}
/* Set matrix type */
arkdls_mem->d_type = SUNDIALS_DENSE;
/* Initialize mass-matrix-related data */
arkdls_mem->d_dmass = dmass;
arkdls_mem->d_M_data = NULL;
arkdls_mem->d_last_flag = ARKDLS_SUCCESS;
ark_mem->ark_MassSetupNonNull = TRUE;
/* Set problem dimension */
arkdls_mem->d_n = (long int) N;
/* Allocate memory for M and pivot array */
arkdls_mem->d_M = NULL;
arkdls_mem->d_pivots = NULL;
arkdls_mem->d_M = NewDenseMat(arkdls_mem->d_n, arkdls_mem->d_n);
if (arkdls_mem->d_M == NULL) {
arkProcessError(ark_mem, ARKDLS_MEM_FAIL, "ARKLAPACK",
"ARKMassLapackDense", MSGD_MEM_FAIL);
free(arkdls_mem); arkdls_mem = NULL;
return(ARKDLS_MEM_FAIL);
}
arkdls_mem->d_pivots = NewIntArray(N);
if (arkdls_mem->d_pivots == NULL) {
arkProcessError(ark_mem, ARKDLS_MEM_FAIL, "ARKLAPACK",
"ARKMassLapackDense", MSGD_MEM_FAIL);
DestroyMat(arkdls_mem->d_M);
free(arkdls_mem); arkdls_mem = NULL;
return(ARKDLS_MEM_FAIL);
}
/* Attach linear solver memory to integrator memory */
ark_mem->ark_mass_mem = arkdls_mem;
return(ARKDLS_SUCCESS);
}
/*---------------------------------------------------------------
ARKLapackDense:
This routine initializes the memory record and sets various
function fields specific to the linear solver module.
ARKLapackDense first calls the existing lfree routine if this is
not NULL. Then it sets the ark_linit, ark_lsetup, ark_lsolve,
ark_lfree fields in (*arkode_mem) to be arkLapackDenseInit,
arkLapackDenseSetup, arkLapackDenseSolve, and arkLapackDenseFree,
respectively. It allocates memory for a structure of type
ARKDlsMemRec and sets the ark_lmem field in (*arkode_mem) to the
address of this structure. It sets setupNonNull in (*arkode_mem)
to TRUE, and the d_jac field to the default arkDlsDenseDQJac.
Finally, it allocates memory for M, pivots, and savedJ.
The return value is SUCCESS = 0, or LMEM_FAIL = -1.
NOTE: The dense linear solver assumes a serial implementation
of the NVECTOR package. Therefore, ARKLapackDense will
first test for a compatible N_Vector internal
representation by checking that N_VGetArrayPointer and
N_VSetArrayPointer exist. Of course, other vector
implementations may also have these functions set, so
this test is not sufficient to guarantee use of the
serial NVECTOR package.
---------------------------------------------------------------*/
int ARKLapackDense(void *arkode_mem, int N)
{
ARKodeMem ark_mem;
ARKDlsMem arkdls_mem;
/* Return immediately if arkode_mem is NULL */
if (arkode_mem == NULL) {
arkProcessError(NULL, ARKDLS_MEM_NULL, "ARKLAPACK",
"ARKLapackDense", MSGD_ARKMEM_NULL);
return(ARKDLS_MEM_NULL);
}
ark_mem = (ARKodeMem) arkode_mem;
/* Test if the NVECTOR package is compatible with the LAPACK solver */
if (ark_mem->ark_tempv->ops->nvgetarraypointer == NULL ||
ark_mem->ark_tempv->ops->nvsetarraypointer == NULL) {
arkProcessError(ark_mem, ARKDLS_ILL_INPUT, "ARKLAPACK",
"ARKLapackDense", MSGD_BAD_NVECTOR);
return(ARKDLS_ILL_INPUT);
}
if (ark_mem->ark_lfree !=NULL) ark_mem->ark_lfree(ark_mem);
/* Set four main function fields in ark_mem */
ark_mem->ark_linit = arkLapackDenseInit;
ark_mem->ark_lsetup = arkLapackDenseSetup;
ark_mem->ark_lsolve = arkLapackDenseSolve;
ark_mem->ark_lfree = arkLapackDenseFree;
ark_mem->ark_lsolve_type = 1;
/* Get memory for ARKDlsMemRec */
arkdls_mem = NULL;
arkdls_mem = (ARKDlsMem) malloc(sizeof(struct ARKDlsMemRec));
if (arkdls_mem == NULL) {
arkProcessError(ark_mem, ARKDLS_MEM_FAIL, "ARKLAPACK",
"ARKLapackDense", MSGD_MEM_FAIL);
return(ARKDLS_MEM_FAIL);
}
/* Set matrix type */
arkdls_mem->d_type = SUNDIALS_DENSE;
/* Initialize Jacobian-related data */
arkdls_mem->d_jacDQ = TRUE;
arkdls_mem->d_djac = NULL;
arkdls_mem->d_J_data = NULL;
arkdls_mem->d_last_flag = ARKDLS_SUCCESS;
ark_mem->ark_setupNonNull = TRUE;
/* Set problem dimension */
arkdls_mem->d_n = (long int) N;
/* Allocate memory for M, pivot array, and savedJ */
arkdls_mem->d_M = NULL;
arkdls_mem->d_pivots = NULL;
arkdls_mem->d_savedJ = NULL;
arkdls_mem->d_M = NewDenseMat(arkdls_mem->d_n, arkdls_mem->d_n);
if (arkdls_mem->d_M == NULL) {
arkProcessError(ark_mem, ARKDLS_MEM_FAIL, "ARKLAPACK",
"ARKLapackDense", MSGD_MEM_FAIL);
free(arkdls_mem); arkdls_mem = NULL;
return(ARKDLS_MEM_FAIL);
}
arkdls_mem->d_pivots = NewIntArray(N);
if (arkdls_mem->d_pivots == NULL) {
arkProcessError(ark_mem, ARKDLS_MEM_FAIL, "ARKLAPACK",
"ARKLapackDense", MSGD_MEM_FAIL);
DestroyMat(arkdls_mem->d_M);
free(arkdls_mem); arkdls_mem = NULL;
return(ARKDLS_MEM_FAIL);
}
arkdls_mem->d_savedJ = NewDenseMat(arkdls_mem->d_n, arkdls_mem->d_n);
if (arkdls_mem->d_savedJ == NULL) {
arkProcessError(ark_mem, ARKDLS_MEM_FAIL, "ARKLAPACK",
"ARKLapackDense", MSGD_MEM_FAIL);
DestroyMat(arkdls_mem->d_M);
DestroyArray(arkdls_mem->d_pivots);
free(arkdls_mem); arkdls_mem = NULL;
return(ARKDLS_MEM_FAIL);
}
/* Attach linear solver memory to integrator memory */
ark_mem->ark_lmem = arkdls_mem;
return(ARKDLS_SUCCESS);
}
int CPDenseProj(void *cpode_mem, int Nc, int Ny, int fact_type)
{
CPodeMem cp_mem;
CPDlsProjMem cpdlsP_mem;
/* Return immediately if cpode_mem is NULL */
if (cpode_mem == NULL) {
cpProcessError(NULL, CPDIRECT_MEM_NULL, "CPDENSE", "CPDenseProj", MSGD_CPMEM_NULL);
return(CPDIRECT_MEM_NULL);
}
cp_mem = (CPodeMem) cpode_mem;
/* Test if the NVECTOR package is compatible with the DENSE solver */
if (tempv->ops->nvgetarraypointer == NULL ||
tempv->ops->nvsetarraypointer == NULL) {
cpProcessError(cp_mem, CPDIRECT_ILL_INPUT, "CPDENSE", "CPDenseProj", MSGD_BAD_NVECTOR);
return(CPDIRECT_ILL_INPUT);
}
/* Check if fact_type has a legal value */
if ( (fact_type != CPDIRECT_LU) && (fact_type != CPDIRECT_QR) && (fact_type != CPDIRECT_SC) ) {
cpProcessError(cp_mem, CPDIRECT_ILL_INPUT, "CPDENSE", "CPDenseProj", MSGD_BAD_FACT);
return(CPDIRECT_ILL_INPUT);
}
if (lfreeP !=NULL) lfreeP(cp_mem);
/* Set the five function fields in cp_mem */
linitP = cpDenseProjInit;
lsetupP = cpDenseProjSetup;
lsolveP = cpDenseProjSolve;
lmultP = cpDenseProjMult;
lfreeP = cpDenseProjFree;
/* Get memory for CPDlsProjMemRec */
cpdlsP_mem = NULL;
cpdlsP_mem = (CPDlsProjMem) malloc(sizeof(CPDlsProjMemRec));
if (cpdlsP_mem == NULL) {
cpProcessError(cp_mem, CPDIRECT_MEM_FAIL, "CPDENSE", "CPDenseProj", MSGD_MEM_FAIL);
return(CPDIRECT_MEM_FAIL);
}
lsetupP_exists = TRUE;
/* Initialize all internal pointers to NULL */
G = NULL;
K = NULL;
pivotsP = NULL;
beta = NULL;
/* Allocate memory for G and other work space */
G = NewDenseMat(Ny, Nc);
if (G == NULL) {
cpProcessError(cp_mem, CPDIRECT_MEM_FAIL, "CPDENSE", "CPDenseProj", MSGD_MEM_FAIL);
free(cpdlsP_mem);
return(CPDIRECT_MEM_FAIL);
}
savedG = NewDenseMat(Ny, Nc);
if (savedG == NULL) {
cpProcessError(cp_mem, CPDIRECT_MEM_FAIL, "CPDENSE", "CPDenseProj", MSGD_MEM_FAIL);
DestroyMat(G);
free(cpdlsP_mem);
return(CPDIRECT_MEM_FAIL);
}
/* Allocate additional work space, depending on factorization */
switch(fact_type) {
case CPDIRECT_LU:
/* Allocate space for pivotsP and K */
pivotsP = NewIntArray(Nc);
if (pivotsP == NULL) {
cpProcessError(cp_mem, CPDIRECT_MEM_FAIL, "CPDENSE", "CPDenseProj", MSGD_MEM_FAIL);
DestroyMat(savedG);
DestroyMat(G);
free(cpdlsP_mem);
return(CPDIRECT_MEM_FAIL);
}
K = NewDenseMat(Ny-Nc, Ny-Nc);
if (K == NULL) {
cpProcessError(cp_mem, CPDIRECT_MEM_FAIL, "CPDENSE", "CPDenseProj", MSGD_MEM_FAIL);
DestroyArray(pivotsP);
DestroyMat(savedG);
DestroyMat(G);
free(cpdlsP_mem);
return(CPDIRECT_MEM_FAIL);
}
break;
case CPDIRECT_QR:
/* Allocate space for beta */
beta = NewRealArray(Nc);
if (beta == NULL) {
cpProcessError(cp_mem, CPDIRECT_MEM_FAIL, "CPDENSE", "CPDenseProj", MSGD_MEM_FAIL);
DestroyMat(savedG);
DestroyMat(G);
free(cpdlsP_mem);
return(CPDIRECT_MEM_FAIL);
}
/* If projecting in WRMS norm, allocate space for K=Q^T*D^(-1)*Q */
if (pnorm == CP_PROJ_ERRNORM) {
K = NewDenseMat(Nc, Nc);
if (K == NULL) {
cpProcessError(cp_mem, CPDIRECT_MEM_FAIL, "CPDENSE", "CPDenseProj", MSGD_MEM_FAIL);
DestroyArray(beta);
DestroyMat(savedG);
DestroyMat(G);
free(cpdlsP_mem);
return(CPDIRECT_MEM_FAIL);
}
}
break;
case CPDIRECT_SC:
/* Allocate space for K = G * D^(-1) * G^T */
K = NewDenseMat(Nc, Nc);
if (K == NULL) {
cpProcessError(cp_mem, CPDIRECT_MEM_FAIL, "CPDENSE", "CPDenseProj", MSGD_MEM_FAIL);
DestroyMat(savedG);
DestroyMat(G);
free(cpdlsP_mem);
return(CPDIRECT_MEM_FAIL);
}
break;
}
/* Set default Jacobian routine and Jacobian data */
jacP = NULL;
JP_data = NULL;
lsetupP_exists = TRUE;
/* Copy inputs into memory */
nc = Nc; /* number of constraints */
ny = Ny; /* number of states */
ftype = fact_type; /* factorization type */
/* Attach linear solver memory to integrator memory */
lmemP = cpdlsP_mem;
return(CPDIRECT_SUCCESS);
}
int CVBBDPrecInit(void *cvode_mem, int Nlocal,
int mudq, int mldq,
int mukeep, int mlkeep,
realtype dqrely,
CVLocalFn gloc, CVCommFn cfn)
{
CVodeMem cv_mem;
CVSpilsMem cvspils_mem;
CVBBDPrecData pdata;
int muk, mlk, storage_mu;
int flag;
if (cvode_mem == NULL) {
CVProcessError(NULL, CVSPILS_MEM_NULL, "CVBBDPRE", "CVBBDPrecInit", MSGBBD_MEM_NULL);
return(CVSPILS_MEM_NULL);
}
cv_mem = (CVodeMem) cvode_mem;
/* Test if one of the SPILS linear solvers has been attached */
if (cv_mem->cv_lmem == NULL) {
CVProcessError(cv_mem, CVSPILS_LMEM_NULL, "CVBBDPRE", "CVBBDPrecInit", MSGBBD_LMEM_NULL);
return(CVSPILS_LMEM_NULL);
}
cvspils_mem = (CVSpilsMem) cv_mem->cv_lmem;
/* Test if the NVECTOR package is compatible with the BLOCK BAND preconditioner */
if(vec_tmpl->ops->nvgetarraypointer == NULL) {
CVProcessError(cv_mem, CVSPILS_ILL_INPUT, "CVBBDPRE", "CVBBDPrecInit", MSGBBD_BAD_NVECTOR);
return(CVSPILS_ILL_INPUT);
}
/* Allocate data memory */
pdata = NULL;
pdata = (CVBBDPrecData) malloc(sizeof *pdata);
if (pdata == NULL) {
CVProcessError(cv_mem, CVSPILS_MEM_FAIL, "CVBBDPRE", "CVBBDPrecInit", MSGBBD_MEM_FAIL);
return(CVSPILS_MEM_FAIL);
}
/* Set pointers to gloc and cfn; load half-bandwidths */
pdata->cvode_mem = cvode_mem;
pdata->gloc = gloc;
pdata->cfn = cfn;
pdata->mudq = MIN(Nlocal-1, MAX(0,mudq));
pdata->mldq = MIN(Nlocal-1, MAX(0,mldq));
muk = MIN(Nlocal-1, MAX(0,mukeep));
mlk = MIN(Nlocal-1, MAX(0,mlkeep));
pdata->mukeep = muk;
pdata->mlkeep = mlk;
/* Allocate memory for saved Jacobian */
pdata->savedJ = NewBandMat(Nlocal, muk, mlk, muk);
if (pdata->savedJ == NULL) {
free(pdata); pdata = NULL;
CVProcessError(cv_mem, CVSPILS_MEM_FAIL, "CVBBDPRE", "CVBBDPrecInit", MSGBBD_MEM_FAIL);
return(CVSPILS_MEM_FAIL);
}
/* Allocate memory for preconditioner matrix */
storage_mu = MIN(Nlocal-1, muk + mlk);
pdata->savedP = NULL;
pdata->savedP = NewBandMat(Nlocal, muk, mlk, storage_mu);
if (pdata->savedP == NULL) {
DestroyMat(pdata->savedJ);
free(pdata); pdata = NULL;
CVProcessError(cv_mem, CVSPILS_MEM_FAIL, "CVBBDPRE", "CVBBDPrecInit", MSGBBD_MEM_FAIL);
return(CVSPILS_MEM_FAIL);
}
/* Allocate memory for pivots */
pdata->pivots = NULL;
pdata->pivots = NewIntArray(Nlocal);
if (pdata->savedJ == NULL) {
DestroyMat(pdata->savedP);
DestroyMat(pdata->savedJ);
free(pdata); pdata = NULL;
CVProcessError(cv_mem, CVSPILS_MEM_FAIL, "CVBBDPRE", "CVBBDPrecInit", MSGBBD_MEM_FAIL);
return(CVSPILS_MEM_FAIL);
}
/* Set pdata->dqrely based on input dqrely (0 implies default). */
pdata->dqrely = (dqrely > ZERO) ? dqrely : RSqrt(uround);
/* Store Nlocal to be used in CVBBDPrecSetup */
pdata->n_local = Nlocal;
/* Set work space sizes and initialize nge */
pdata->rpwsize = Nlocal*(muk + 2*mlk + storage_mu + 2);
pdata->ipwsize = Nlocal;
pdata->nge = 0;
/* Overwrite the P_data field in the SPILS memory */
cvspils_mem->s_P_data = pdata;
/* Attach the pfree function */
cvspils_mem->s_pfree = CVBBDPrecFree;
/* Attach preconditioner solve and setup functions */
flag = CVSpilsSetPreconditioner(cvode_mem, CVBBDPrecSetup, CVBBDPrecSolve);
return(flag);
}
int CVBandPrecInit(void *cvode_mem, int N, int mu, int ml)
{
CVodeMem cv_mem;
CVSpilsMem cvspils_mem;
CVBandPrecData pdata;
int mup, mlp, storagemu;
int flag;
if (cvode_mem == NULL) {
CVProcessError(NULL, CVSPILS_MEM_NULL, "CVBANDPRE", "CVBandPrecInit", MSGBP_MEM_NULL);
return(CVSPILS_MEM_NULL);
}
cv_mem = (CVodeMem) cvode_mem;
/* Test if one of the SPILS linear solvers has been attached */
if (cv_mem->cv_lmem == NULL) {
CVProcessError(cv_mem, CVSPILS_LMEM_NULL, "CVBANDPRE", "CVBandPrecInit", MSGBP_LMEM_NULL);
return(CVSPILS_LMEM_NULL);
}
cvspils_mem = (CVSpilsMem) cv_mem->cv_lmem;
/* Test if the NVECTOR package is compatible with the BAND preconditioner */
if(vec_tmpl->ops->nvgetarraypointer == NULL) {
CVProcessError(cv_mem, CVSPILS_ILL_INPUT, "CVBANDPRE", "CVBandPrecInit", MSGBP_BAD_NVECTOR);
return(CVSPILS_ILL_INPUT);
}
pdata = NULL;
pdata = (CVBandPrecData) malloc(sizeof *pdata); /* Allocate data memory */
if (pdata == NULL) {
CVProcessError(cv_mem, CVSPILS_MEM_FAIL, "CVBANDPRE", "CVBandPrecInit", MSGBP_MEM_FAIL);
return(CVSPILS_MEM_FAIL);
}
/* Load pointers and bandwidths into pdata block. */
pdata->cvode_mem = cvode_mem;
pdata->N = N;
pdata->mu = mup = MIN(N-1, MAX(0,mu));
pdata->ml = mlp = MIN(N-1, MAX(0,ml));
/* Initialize nfeBP counter */
pdata->nfeBP = 0;
/* Allocate memory for saved banded Jacobian approximation. */
pdata->savedJ = NULL;
pdata->savedJ = NewBandMat(N, mup, mlp, mup);
if (pdata->savedJ == NULL) {
free(pdata); pdata = NULL;
CVProcessError(cv_mem, CVSPILS_MEM_FAIL, "CVBANDPRE", "CVBandPrecInit", MSGBP_MEM_FAIL);
return(CVSPILS_MEM_FAIL);
}
/* Allocate memory for banded preconditioner. */
storagemu = MIN(N-1, mup+mlp);
pdata->savedP = NULL;
pdata->savedP = NewBandMat(N, mup, mlp, storagemu);
if (pdata->savedP == NULL) {
DestroyMat(pdata->savedJ);
free(pdata); pdata = NULL;
CVProcessError(cv_mem, CVSPILS_MEM_FAIL, "CVBANDPRE", "CVBandPrecInit", MSGBP_MEM_FAIL);
return(CVSPILS_MEM_FAIL);
}
/* Allocate memory for pivot array. */
pdata->pivots = NULL;
pdata->pivots = NewIntArray(N);
if (pdata->savedJ == NULL) {
DestroyMat(pdata->savedP);
DestroyMat(pdata->savedJ);
free(pdata); pdata = NULL;
CVProcessError(cv_mem, CVSPILS_MEM_FAIL, "CVBANDPRE", "CVBandPrecInit", MSGBP_MEM_FAIL);
return(CVSPILS_MEM_FAIL);
}
/* Overwrite the P_data field in the SPILS memory */
cvspils_mem->s_P_data = pdata;
/* Attach the pfree function */
cvspils_mem->s_pfree = CVBandPrecFree;
/* Attach preconditioner solve and setup functions */
flag = CVSpilsSetPreconditioner(cvode_mem, CVBandPrecSetup, CVBandPrecSolve);
return(flag);
}
int KINBBDPrecInit(void *kinmem, int Nlocal,
int mudq, int mldq,
int mukeep, int mlkeep,
realtype dq_rel_uu,
KINLocalFn gloc, KINCommFn gcomm)
{
KBBDPrecData pdata;
KINSpilsMem kinspils_mem;
KINMem kin_mem;
N_Vector vtemp3;
int muk, mlk, storage_mu;
int flag;
pdata = NULL;
if (kinmem == NULL) {
KINProcessError(NULL, 0, "KINBBDPRE", "KINBBDPrecInit", MSGBBD_MEM_NULL);
return(KINSPILS_MEM_NULL);
}
kin_mem = (KINMem) kinmem;
/* Test if one of the SPILS linear solvers has been attached */
if (kin_mem->kin_lmem == NULL) {
KINProcessError(kin_mem, KINSPILS_LMEM_NULL, "KINBBDPRE", "KINBBDPrecInit", MSGBBD_LMEM_NULL);
return(KINSPILS_LMEM_NULL);
}
kinspils_mem = (KINSpilsMem) kin_mem->kin_lmem;
/* Test if the NVECTOR package is compatible with BLOCK BAND preconditioner.
Note: do NOT need to check for N_VScale since it is required by KINSOL and
so has already been checked for (see KINMalloc) */
if (vec_tmpl->ops->nvgetarraypointer == NULL) {
KINProcessError(kin_mem, KINSPILS_ILL_INPUT, "KINBBDPRE", "KINBBDPrecInit", MSGBBD_BAD_NVECTOR);
return(KINSPILS_ILL_INPUT);
}
pdata = NULL;
pdata = (KBBDPrecData) malloc(sizeof *pdata); /* allocate data memory */
if (pdata == NULL) {
KINProcessError(kin_mem, KINSPILS_MEM_FAIL, "KINBBDPRE", "KINBBDPrecInit", MSGBBD_MEM_FAIL);
return(KINSPILS_MEM_FAIL);
}
/* set pointers to gloc and gcomm and load half-bandwiths */
pdata->kin_mem = kinmem;
pdata->gloc = gloc;
pdata->gcomm = gcomm;
pdata->mudq = MIN(Nlocal-1, MAX(0, mudq));
pdata->mldq = MIN(Nlocal-1, MAX(0, mldq));
muk = MIN(Nlocal-1, MAX(0,mukeep));
mlk = MIN(Nlocal-1, MAX(0,mlkeep));
pdata->mukeep = muk;
pdata->mlkeep = mlk;
/* allocate memory for preconditioner matrix */
storage_mu = MIN(Nlocal-1, muk+mlk);
pdata->PP = NULL;
pdata->PP = NewBandMat(Nlocal, muk, mlk, storage_mu);
if (pdata->PP == NULL) {
free(pdata); pdata = NULL;
KINProcessError(kin_mem, KINSPILS_MEM_FAIL, "KINBBDPRE", "KINBBDPrecInit", MSGBBD_MEM_FAIL);
return(KINSPILS_MEM_FAIL);
}
/* allocate memory for pivots */
pdata->pivots = NULL;
pdata->pivots = NewIntArray(Nlocal);
if (pdata->pivots == NULL) {
DestroyMat(pdata->PP);
free(pdata); pdata = NULL;
KINProcessError(kin_mem, KINSPILS_MEM_FAIL, "KINBBDPRE", "KINBBDPrecInit", MSGBBD_MEM_FAIL);
return(KINSPILS_MEM_FAIL);
}
/* allocate vtemp3 for use by KBBDDQJac routine */
vtemp3 = NULL;
vtemp3 = N_VClone(kin_mem->kin_vtemp1);
if (vtemp3 == NULL) {
DestroyArray(pdata->pivots);
DestroyMat(pdata->PP);
free(pdata); pdata = NULL;
KINProcessError(kin_mem, KINSPILS_MEM_FAIL, "KINBBDPRE", "KINBBDPrecInit", MSGBBD_MEM_FAIL);
return(KINSPILS_MEM_FAIL);
}
pdata->vtemp3 = vtemp3;
/* set rel_uu based on input value dq_rel_uu */
if (dq_rel_uu > ZERO) pdata->rel_uu = dq_rel_uu;
else pdata->rel_uu = RSqrt(uround); /* using dq_rel_uu = 0.0 means use default */
/* store Nlocal to be used by the preconditioner routines */
pdata->n_local = Nlocal;
/* set work space sizes and initialize nge */
pdata->rpwsize = Nlocal * (storage_mu*mlk + 1) + 1;
pdata->ipwsize = Nlocal + 1;
pdata->nge = 0;
/* Overwrite the P_data field in the SPILS memory */
kinspils_mem->s_P_data = pdata;
/* Attach the pfree function */
kinspils_mem->s_pfree = KINBBDPrecFree;
/* Attach preconditioner solve and setup functions */
flag = KINSpilsSetPreconditioner(kinmem, KINBBDPrecSetup, KINBBDPrecSolve);
return(flag);
}
/*
* -----------------------------------------------------------------
* IDALapackDense
* -----------------------------------------------------------------
* This routine initializes the memory record and sets various function
* fields specific to the linear solver module. IDALapackDense first
* calls the existing lfree routine if this is not NULL. Then it sets
* the ida_linit, ida_lsetup, ida_lsolve, ida_lfree fields in (*ida_mem)
* to be idaLapackDenseInit, idaLapackDenseSetup, idaLapackDenseSolve,
* and idaLapackDenseFree, respectively. It allocates memory for a
* structure of type IDADlsMemRec and sets the ida_lmem field in
* (*ida_mem) to the address of this structure. It sets setupNonNull
* in (*ida_mem) to TRUE, and the d_jac field to the default
* idaLapackDenseDQJac. Finally, it allocates memory for M, pivots.
*
* The return value is SUCCESS = 0, or LMEM_FAIL = -1.
*
* NOTE: The dense linear solver assumes a serial implementation
* of the NVECTOR package. Therefore, IDALapackDense will first
* test for a compatible N_Vector internal representation
* by checking that N_VGetArrayPointer and N_VSetArrayPointer
* exist.
* -----------------------------------------------------------------
*/
int IDALapackDense(void *ida_mem, int N)
{
IDAMem IDA_mem;
IDADlsMem idadls_mem;
/* Return immediately if ida_mem is NULL */
if (ida_mem == NULL) {
IDAProcessError(NULL, IDADLS_MEM_NULL, "IDALAPACK", "IDALapackDense", MSGD_IDAMEM_NULL);
return(IDADLS_MEM_NULL);
}
IDA_mem = (IDAMem) ida_mem;
/* Test if the NVECTOR package is compatible with the LAPACK solver */
if (tempv->ops->nvgetarraypointer == NULL ||
tempv->ops->nvsetarraypointer == NULL) {
IDAProcessError(IDA_mem, IDADLS_ILL_INPUT, "IDALAPACK", "IDALapackDense", MSGD_BAD_NVECTOR);
return(IDADLS_ILL_INPUT);
}
if (lfree !=NULL) lfree(IDA_mem);
/* Set four main function fields in IDA_mem */
linit = idaLapackDenseInit;
lsetup = idaLapackDenseSetup;
lsolve = idaLapackDenseSolve;
lperf = NULL;
lfree = idaLapackDenseFree;
/* Get memory for IDADlsMemRec */
idadls_mem = NULL;
idadls_mem = (IDADlsMem) malloc(sizeof(struct IDADlsMemRec));
if (idadls_mem == NULL) {
IDAProcessError(IDA_mem, IDADLS_MEM_FAIL, "IDALAPACK", "IDALapackDense", MSGD_MEM_FAIL);
return(IDADLS_MEM_FAIL);
}
/* Set matrix type */
mtype = SUNDIALS_DENSE;
/* Set default Jacobian routine and Jacobian data */
jacDQ = TRUE;
djac = NULL;
J_data = NULL;
last_flag = IDADLS_SUCCESS;
setupNonNull = TRUE;
/* Set problem dimension */
n = (long int) N;
/* Allocate memory for JJ and pivot array */
JJ = NULL;
pivots = NULL;
JJ = NewDenseMat(n, n);
if (JJ == NULL) {
IDAProcessError(IDA_mem, IDADLS_MEM_FAIL, "IDALAPACK", "IDALapackDense", MSGD_MEM_FAIL);
free(idadls_mem); idadls_mem = NULL;
return(IDADLS_MEM_FAIL);
}
pivots = NewIntArray(N);
if (pivots == NULL) {
IDAProcessError(IDA_mem, IDADLS_MEM_FAIL, "IDALAPACK", "IDALapackDense", MSGD_MEM_FAIL);
DestroyMat(JJ);
free(idadls_mem); idadls_mem = NULL;
return(IDADLS_MEM_FAIL);
}
/* Attach linear solver memory to integrator memory */
lmem = idadls_mem;
return(IDADLS_SUCCESS);
}
int IDABand(void *ida_mem, int Neq, int mupper, int mlower)
{
IDAMem IDA_mem;
IDADlsMem idadls_mem;
int flag;
/* Return immediately if ida_mem is NULL. */
if (ida_mem == NULL) {
IDAProcessError(NULL, IDADLS_MEM_NULL, "IDASBAND", "IDABand", MSGD_IDAMEM_NULL);
return(IDADLS_MEM_NULL);
}
IDA_mem = (IDAMem) ida_mem;
/* Test if the NVECTOR package is compatible with the BAND solver */
if(vec_tmpl->ops->nvgetarraypointer == NULL) {
IDAProcessError(IDA_mem, IDADLS_ILL_INPUT, "IDASBAND", "IDABand", MSGD_BAD_NVECTOR);
return(IDADLS_ILL_INPUT);
}
/* Test mlower and mupper for legality. */
if ((mlower < 0) || (mupper < 0) || (mlower >= Neq) || (mupper >= Neq)) {
IDAProcessError(IDA_mem, IDADLS_ILL_INPUT, "IDASBAND", "IDABand", MSGD_BAD_SIZES);
return(IDADLS_ILL_INPUT);
}
if (lfree != NULL) flag = lfree((IDAMem) ida_mem);
/* Set five main function fields in ida_mem. */
linit = IDABandInit;
lsetup = IDABandSetup;
lsolve = IDABandSolve;
lperf = NULL;
lfree = IDABandFree;
/* Get memory for IDADlsMemRec. */
idadls_mem = NULL;
idadls_mem = (IDADlsMem) malloc(sizeof(struct IDADlsMemRec));
if (idadls_mem == NULL) {
IDAProcessError(IDA_mem, IDADLS_MEM_FAIL, "IDASBAND", "IDABand", MSGD_MEM_FAIL);
return(IDADLS_MEM_FAIL);
}
/* Set matrix type */
mtype = SUNDIALS_BAND;
/* Set default Jacobian routine and Jacobian data */
jacDQ = TRUE;
bjac = NULL;
jacdata = NULL;
last_flag = IDADLS_SUCCESS;
setupNonNull = TRUE;
/* Store problem size */
neq = Neq;
idadls_mem->d_ml = mlower;
idadls_mem->d_mu = mupper;
/* Set extended upper half-bandwidth for JJ (required for pivoting). */
smu = MIN(Neq-1, mupper + mlower);
/* Allocate memory for JJ and pivot array. */
JJ = NULL;
JJ = NewBandMat(Neq, mupper, mlower, smu);
if (JJ == NULL) {
IDAProcessError(IDA_mem, IDADLS_MEM_FAIL, "IDASBAND", "IDABand", MSGD_MEM_FAIL);
free(idadls_mem); idadls_mem = NULL;
return(IDADLS_MEM_FAIL);
}
pivots = NULL;
pivots = NewIntArray(Neq);
if (pivots == NULL) {
IDAProcessError(IDA_mem, IDADLS_MEM_FAIL, "IDASBAND", "IDABand", MSGD_MEM_FAIL);
DestroyMat(JJ);
free(idadls_mem); idadls_mem = NULL;
return(IDADLS_MEM_FAIL);
}
/* Attach linear solver memory to the integrator memory */
lmem = idadls_mem;
return(IDADLS_SUCCESS);
}
/*
* -----------------------------------------------------------------
* CPLapackBand
* -----------------------------------------------------------------
* This routine initializes the memory record and sets various function
* fields specific to the band linear solver module. It first calls
* the existing lfree routine if this is not NULL. It then sets the
* cp_linit, cp_lsetup, cp_lsolve, and cp_lfree fields in (*cpode_mem)
* to be cpLapackBandInit, cpLapackBandSetup, cpLapackBandSolve,
* and cpLapackBandFree, respectively. It allocates memory for a
* structure of type CPLapackBandMemRec and sets the cp_lmem field in
* (*cpode_mem) to the address of this structure. It sets lsetup_exists
* in (*cpode_mem) to be TRUE, mu to be mupper, ml to be mlower, and
* the jacE and jacI field to NULL.
* Finally, it allocates memory for M, pivots, and (if needed) savedJ.
* The CPLapackBand return value is CPDIRECT_SUCCESS = 0,
* CPDIRECT_MEM_FAIL = -1, or CPDIRECT_ILL_INPUT = -2.
*
* NOTE: The CPLAPACK linear solver assumes a serial implementation
* of the NVECTOR package. Therefore, CPLapackBand will first
* test for compatible a compatible N_Vector internal
* representation by checking that the function
* N_VGetArrayPointer exists.
* -----------------------------------------------------------------
*/
int CPLapackBand(void *cpode_mem, int N, int mupper, int mlower)
{
CPodeMem cp_mem;
CPDlsMem cpdls_mem;
/* Return immediately if cpode_mem is NULL */
if (cpode_mem == NULL) {
cpProcessError(NULL, CPDIRECT_MEM_NULL, "CPLAPACK", "CPLapackBand", MSGD_CPMEM_NULL);
return(CPDIRECT_MEM_NULL);
}
cp_mem = (CPodeMem) cpode_mem;
/* Test if the NVECTOR package is compatible with the BAND solver */
if (tempv->ops->nvgetarraypointer == NULL) {
cpProcessError(cp_mem, CPDIRECT_ILL_INPUT, "CPLAPACK", "CPLapackBand", MSGD_BAD_NVECTOR);
return(CPDIRECT_ILL_INPUT);
}
if (lfree != NULL) lfree(cp_mem);
/* Set four main function fields in cp_mem */
linit = cpLapackBandInit;
lsetup = cpLapackBandSetup;
lsolve = cpLapackBandSolve;
lfree = cpLapackBandFree;
/* Get memory for CPDlsMemRec */
cpdls_mem = NULL;
cpdls_mem = (CPDlsMem) malloc(sizeof(CPDlsMemRec));
if (cpdls_mem == NULL) {
cpProcessError(cp_mem, CPDIRECT_MEM_FAIL, "CPLAPACK", "CPLapackBand", MSGD_MEM_FAIL);
return(CPDIRECT_MEM_FAIL);
}
/* Set matrix type */
mtype = SUNDIALS_BAND;
/* Set default Jacobian routine and Jacobian data */
bjacE = NULL;
bjacI = NULL;
J_data = NULL;
last_flag = CPDIRECT_SUCCESS;
lsetup_exists = TRUE;
/* Load problem dimension */
n = N;
/* Load half-bandwiths in cpdls_mem */
ml = mlower;
mu = mupper;
/* Test ml and mu for legality */
if ((ml < 0) || (mu < 0) || (ml >= N) || (mu >= N)) {
cpProcessError(cp_mem, CPDIRECT_ILL_INPUT, "CPLAPACK", "CPLapackBand", MSGD_BAD_SIZES);
return(CPDIRECT_ILL_INPUT);
}
/* Set extended upper half-bandwith for M (required for pivoting) */
smu = MIN(N-1, mu + ml);
/* Allocate memory for M, savedJ, and pivot arrays */
M = NULL;
pivots = NULL;
savedJ = NULL;
M = NewBandMat(N, mu, ml, smu);
if (M == NULL) {
cpProcessError(cp_mem, CPDIRECT_MEM_FAIL, "CPLAPACK", "CPLapackBand", MSGD_MEM_FAIL);
free(cpdls_mem);
return(CPDIRECT_MEM_FAIL);
}
pivots = NewIntArray(N);
if (pivots == NULL) {
cpProcessError(cp_mem, CPDIRECT_MEM_FAIL, "CPLAPACK", "CPLapackBand", MSGD_MEM_FAIL);
DestroyMat(M);
free(cpdls_mem);
return(CPDIRECT_MEM_FAIL);
}
if (ode_type == CP_EXPL) {
savedJ = NewBandMat(N, mu, ml, smu);
if (savedJ == NULL) {
cpProcessError(cp_mem, CPDIRECT_MEM_FAIL, "CPLAPACK", "CPLapackBand", MSGD_MEM_FAIL);
DestroyMat(M);
DestroyArray(pivots);
free(cpdls_mem);
return(CPDIRECT_MEM_FAIL);
}
}
/* Attach linear solver memory to integrator memory */
lmem = cpdls_mem;
return(CPDIRECT_SUCCESS);
}
