/*----------------------------------------------------------------
Function : SpfgmrMalloc
---------------------------------------------------------------*/
SpfgmrMem SpfgmrMalloc(int l_max, N_Vector vec_tmpl)
{
SpfgmrMem mem;
N_Vector *V, *Z, xcor, vtemp;
realtype **Hes, *givens, *yg;
int k, i;
/* Check the input parameters. */
if (l_max <= 0) return(NULL);
/* Get memory for the Krylov basis vectors V[0], ..., V[l_max]. */
V = N_VCloneVectorArray(l_max+1, vec_tmpl);
if (V == NULL) return(NULL);
/* Get memory for the preconditioned basis vectors Z[0], ..., Z[l_max]. */
Z = N_VCloneVectorArray(l_max+1, vec_tmpl);
if (Z == NULL) {
N_VDestroyVectorArray(V, l_max+1);
return(NULL);
}
/* Get memory for the Hessenberg matrix Hes. */
Hes = NULL;
Hes = (realtype **) malloc((l_max+1)*sizeof(realtype *));
if (Hes == NULL) {
N_VDestroyVectorArray(V, l_max+1);
N_VDestroyVectorArray(Z, l_max+1);
return(NULL);
}
for (k=0; k<=l_max; k++) {
Hes[k] = NULL;
Hes[k] = (realtype *) malloc(l_max*sizeof(realtype));
if (Hes[k] == NULL) {
for (i=0; i<k; i++) {free(Hes[i]); Hes[i] = NULL;}
free(Hes); Hes = NULL;
N_VDestroyVectorArray(V, l_max+1);
N_VDestroyVectorArray(Z, l_max+1);
return(NULL);
}
}
/* Get memory for Givens rotation components. */
givens = NULL;
givens = (realtype *) malloc(2*l_max*sizeof(realtype));
if (givens == NULL) {
for (i=0; i<=l_max; i++) {free(Hes[i]); Hes[i] = NULL;}
free(Hes); Hes = NULL;
N_VDestroyVectorArray(V, l_max+1);
N_VDestroyVectorArray(Z, l_max+1);
return(NULL);
}
/* Get memory to hold the correction to z_tilde. */
xcor = N_VClone(vec_tmpl);
if (xcor == NULL) {
free(givens); givens = NULL;
for (i=0; i<=l_max; i++) {free(Hes[i]); Hes[i] = NULL;}
free(Hes); Hes = NULL;
N_VDestroyVectorArray(V, l_max+1);
N_VDestroyVectorArray(Z, l_max+1);
return(NULL);
}
/* Get memory to hold SPFGMR y and g vectors. */
yg = NULL;
yg = (realtype *) malloc((l_max+1)*sizeof(realtype));
if (yg == NULL) {
N_VDestroy(xcor);
free(givens); givens = NULL;
for (i=0; i<=l_max; i++) {free(Hes[i]); Hes[i] = NULL;}
free(Hes); Hes = NULL;
N_VDestroyVectorArray(V, l_max+1);
N_VDestroyVectorArray(Z, l_max+1);
return(NULL);
}
/* Get an array to hold a temporary vector. */
vtemp = N_VClone(vec_tmpl);
if (vtemp == NULL) {
free(yg); yg = NULL;
N_VDestroy(xcor);
free(givens); givens = NULL;
for (i=0; i<=l_max; i++) {free(Hes[i]); Hes[i] = NULL;}
free(Hes); Hes = NULL;
N_VDestroyVectorArray(V, l_max+1);
N_VDestroyVectorArray(Z, l_max+1);
return(NULL);
}
/* Get memory for an SpfgmrMemRec containing SPFGMR matrices and vectors. */
mem = NULL;
mem = (SpfgmrMem) malloc(sizeof(SpfgmrMemRec));
if (mem == NULL) {
N_VDestroy(vtemp);
free(yg); yg = NULL;
N_VDestroy(xcor);
free(givens); givens = NULL;
for (i=0; i<=l_max; i++) {free(Hes[i]); Hes[i] = NULL;}
free(Hes); Hes = NULL;
N_VDestroyVectorArray(V, l_max+1);
N_VDestroyVectorArray(Z, l_max+1);
return(NULL);
}
/* Set the fields of mem. */
mem->l_max = l_max;
mem->V = V;
mem->Z = Z;
mem->Hes = Hes;
mem->givens = givens;
mem->xcor = xcor;
mem->yg = yg;
mem->vtemp = vtemp;
/* Return the pointer to SPFGMR memory. */
return(mem);
}
SptfqmrMem SptfqmrMalloc(int l_max, N_Vector vec_tmpl)
{
SptfqmrMem mem;
N_Vector *r;
N_Vector q, d, v, p, u;
N_Vector r_star, vtemp1, vtemp2, vtemp3;
/* Check the input parameters */
if ((l_max <= 0) || (vec_tmpl == NULL)) return(NULL);
/* Allocate space for vectors */
r_star = NULL;
r_star = N_VClone(vec_tmpl);
if (r_star == NULL) return(NULL);
q = NULL;
q = N_VClone(vec_tmpl);
if (q == NULL) {
N_VDestroy(r_star);
return(NULL);
}
d = NULL;
d = N_VClone(vec_tmpl);
if (d == NULL) {
N_VDestroy(r_star);
N_VDestroy(q);
return(NULL);
}
v = NULL;
v = N_VClone(vec_tmpl);
if (v == NULL) {
N_VDestroy(r_star);
N_VDestroy(q);
N_VDestroy(d);
return(NULL);
}
p = NULL;
p = N_VClone(vec_tmpl);
if (p == NULL) {
N_VDestroy(r_star);
N_VDestroy(q);
N_VDestroy(d);
N_VDestroy(v);
return(NULL);
}
r = NULL;
r = N_VCloneVectorArray(2, vec_tmpl);
if (r == NULL) {
N_VDestroy(r_star);
N_VDestroy(q);
N_VDestroy(d);
N_VDestroy(v);
N_VDestroy(p);
return(NULL);
}
u = NULL;
u = N_VClone(vec_tmpl);
if (u == NULL) {
N_VDestroy(r_star);
N_VDestroy(q);
N_VDestroy(d);
N_VDestroy(v);
N_VDestroy(p);
N_VDestroyVectorArray(r, 2);
return(NULL);
}
vtemp1 = NULL;
vtemp1 = N_VClone(vec_tmpl);
if (vtemp1 == NULL) {
N_VDestroy(r_star);
N_VDestroy(q);
N_VDestroy(d);
N_VDestroy(v);
N_VDestroy(p);
N_VDestroyVectorArray(r, 2);
N_VDestroy(u);
return(NULL);
}
vtemp2 = NULL;
vtemp2 = N_VClone(vec_tmpl);
if (vtemp2 == NULL) {
N_VDestroy(r_star);
N_VDestroy(q);
N_VDestroy(d);
N_VDestroy(v);
N_VDestroy(p);
N_VDestroyVectorArray(r, 2);
N_VDestroy(u);
N_VDestroy(vtemp1);
return(NULL);
}
vtemp3 = NULL;
vtemp3 = N_VClone(vec_tmpl);
if (vtemp3 == NULL) {
N_VDestroy(r_star);
N_VDestroy(q);
N_VDestroy(d);
N_VDestroy(v);
N_VDestroy(p);
N_VDestroyVectorArray(r, 2);
N_VDestroy(u);
N_VDestroy(vtemp1);
N_VDestroy(vtemp2);
return(NULL);
}
/* Allocate memory for SptfqmrMemRec */
mem = NULL;
mem = (SptfqmrMem) malloc(sizeof(SptfqmrMemRec));
if (mem == NULL) {
N_VDestroy(r_star);
N_VDestroy(q);
N_VDestroy(d);
N_VDestroy(v);
N_VDestroy(p);
N_VDestroyVectorArray(r, 2);
N_VDestroy(u);
N_VDestroy(vtemp1);
N_VDestroy(vtemp2);
N_VDestroy(vtemp3);
return(NULL);
}
/* Intialize SptfqmrMemRec data structure */
mem->l_max = l_max;
mem->r_star = r_star;
mem->q = q;
mem->d = d;
mem->v = v;
mem->p = p;
mem->r = r;
mem->u = u;
mem->vtemp1 = vtemp1;
mem->vtemp2 = vtemp2;
mem->vtemp3 = vtemp3;
/* Return pointer to SPTFQMR memory block */
return(mem);
}
int main(void)
{
UserData data;
void *mem;
N_Vector yy, yp, id, q, *yyS, *ypS, *qS;
realtype tret;
realtype pbar[2];
realtype dp, G, Gm[2], Gp[2];
int flag, is;
realtype atolS[NP];
id = N_VNew_Serial(NEQ);
yy = N_VNew_Serial(NEQ);
yp = N_VNew_Serial(NEQ);
q = N_VNew_Serial(1);
yyS= N_VCloneVectorArray(NP,yy);
ypS= N_VCloneVectorArray(NP,yp);
qS = N_VCloneVectorArray_Serial(NP, q);
data = (UserData) malloc(sizeof *data);
data->a = 0.5; /* half-length of crank */
data->J1 = 1.0; /* crank moment of inertia */
data->m2 = 1.0; /* mass of connecting rod */
data->m1 = 1.0;
data->J2 = 2.0; /* moment of inertia of connecting rod */
data->params[0] = 1.0; /* spring constant */
data->params[1] = 1.0; /* damper constant */
data->l0 = 1.0; /* spring free length */
data->F = 1.0; /* external constant force */
N_VConst(ONE, id);
NV_Ith_S(id, 9) = ZERO;
NV_Ith_S(id, 8) = ZERO;
NV_Ith_S(id, 7) = ZERO;
NV_Ith_S(id, 6) = ZERO;
printf("\nSlider-Crank example for IDAS:\n");
/* Consistent IC*/
setIC(yy, yp, data);
for (is=0;is<NP;is++) {
N_VConst(ZERO, yyS[is]);
N_VConst(ZERO, ypS[is]);
}
/* IDA initialization */
mem = IDACreate();
flag = IDAInit(mem, ressc, TBEGIN, yy, yp);
flag = IDASStolerances(mem, RTOLF, ATOLF);
flag = IDASetUserData(mem, data);
flag = IDASetId(mem, id);
flag = IDASetSuppressAlg(mem, TRUE);
flag = IDASetMaxNumSteps(mem, 20000);
/* Call IDADense and set up the linear solver. */
flag = IDADense(mem, NEQ);
flag = IDASensInit(mem, NP, IDA_SIMULTANEOUS, NULL, yyS, ypS);
pbar[0] = data->params[0];pbar[1] = data->params[1];
flag = IDASetSensParams(mem, data->params, pbar, NULL);
flag = IDASensEEtolerances(mem);
IDASetSensErrCon(mem, TRUE);
N_VConst(ZERO, q);
flag = IDAQuadInit(mem, rhsQ, q);
flag = IDAQuadSStolerances(mem, RTOLQ, ATOLQ);
flag = IDASetQuadErrCon(mem, TRUE);
N_VConst(ZERO, qS[0]);
flag = IDAQuadSensInit(mem, rhsQS, qS);
atolS[0] = atolS[1] = ATOLQ;
flag = IDAQuadSensSStolerances(mem, RTOLQ, atolS);
flag = IDASetQuadSensErrCon(mem, TRUE);
/* Perform forward run */
printf("\nForward integration ... ");
flag = IDASolve(mem, TEND, &tret, yy, yp, IDA_NORMAL);
if (check_flag(&flag, "IDASolve", 1)) return(1);
printf("done!\n");
PrintFinalStats(mem);
IDAGetQuad(mem, &tret, q);
printf("--------------------------------------------\n");
printf(" G = %24.16f\n", Ith(q,1));
printf("--------------------------------------------\n\n");
IDAGetQuadSens(mem, &tret, qS);
printf("-------------F O R W A R D------------------\n");
printf(" dG/dp: %12.4le %12.4le\n", Ith(qS[0],1), Ith(qS[1],1));
printf("--------------------------------------------\n\n");
IDAFree(&mem);
/* Finite differences for dG/dp */
dp = 0.00001;
data->params[0] = ONE;
data->params[1] = ONE;
mem = IDACreate();
setIC(yy, yp, data);
flag = IDAInit(mem, ressc, TBEGIN, yy, yp);
flag = IDASStolerances(mem, RTOLFD, ATOLFD);
flag = IDASetUserData(mem, data);
flag = IDASetId(mem, id);
flag = IDASetSuppressAlg(mem, TRUE);
/* Call IDADense and set up the linear solver. */
flag = IDADense(mem, NEQ);
N_VConst(ZERO, q);
IDAQuadInit(mem, rhsQ, q);
IDAQuadSStolerances(mem, RTOLQ, ATOLQ);
IDASetQuadErrCon(mem, TRUE);
IDASolve(mem, TEND, &tret, yy, yp, IDA_NORMAL);
IDAGetQuad(mem,&tret,q);
G = Ith(q,1);
/*printf(" G =%12.6e\n", Ith(q,1));*/
/******************************
* BACKWARD for k
******************************/
data->params[0] -= dp;
setIC(yy, yp, data);
IDAReInit(mem, TBEGIN, yy, yp);
N_VConst(ZERO, q);
IDAQuadReInit(mem, q);
IDASolve(mem, TEND, &tret, yy, yp, IDA_NORMAL);
IDAGetQuad(mem, &tret, q);
Gm[0] = Ith(q,1);
/*printf("Gm[0]=%12.6e\n", Ith(q,1));*/
/****************************
* FORWARD for k *
****************************/
data->params[0] += (TWO*dp);
setIC(yy, yp, data);
IDAReInit(mem, TBEGIN, yy, yp);
N_VConst(ZERO, q);
IDAQuadReInit(mem, q);
IDASolve(mem, TEND, &tret, yy, yp, IDA_NORMAL);
IDAGetQuad(mem, &tret, q);
Gp[0] = Ith(q,1);
/*printf("Gp[0]=%12.6e\n", Ith(q,1));*/
/* Backward for c */
data->params[0] = ONE;
data->params[1] -= dp;
setIC(yy, yp, data);
IDAReInit(mem, TBEGIN, yy, yp);
N_VConst(ZERO, q);
IDAQuadReInit(mem, q);
IDASolve(mem, TEND, &tret, yy, yp, IDA_NORMAL);
IDAGetQuad(mem, &tret, q);
Gm[1] = Ith(q,1);
/* Forward for c */
data->params[1] += (TWO*dp);
setIC(yy, yp, data);
IDAReInit(mem, TBEGIN, yy, yp);
N_VConst(ZERO, q);
IDAQuadReInit(mem, q);
IDASolve(mem, TEND, &tret, yy, yp, IDA_NORMAL);
IDAGetQuad(mem, &tret, q);
Gp[1] = Ith(q,1);
IDAFree(&mem);
printf("\n\n Checking using Finite Differences \n\n");
printf("---------------BACKWARD------------------\n");
printf(" dG/dp: %12.4le %12.4le\n", (G-Gm[0])/dp, (G-Gm[1])/dp);
printf("-----------------------------------------\n\n");
printf("---------------FORWARD-------------------\n");
printf(" dG/dp: %12.4le %12.4le\n", (Gp[0]-G)/dp, (Gp[1]-G)/dp);
printf("-----------------------------------------\n\n");
printf("--------------CENTERED-------------------\n");
printf(" dG/dp: %12.4le %12.4le\n", (Gp[0]-Gm[0])/(TWO*dp) ,(Gp[1]-Gm[1])/(TWO*dp));
printf("-----------------------------------------\n\n");
/* Free memory */
free(data);
N_VDestroy(id);
N_VDestroy_Serial(yy);
N_VDestroy_Serial(yp);
N_VDestroy_Serial(q);
return(0);
}
int main(int argc, char *argv[])
{
SUNMatrix A;
SUNLinearSolver LS;
void *cvode_mem;
UserData data;
realtype t, tout;
N_Vector y, constraints;
int iout, retval;
realtype pbar[NS];
int is;
N_Vector *yS;
booleantype sensi, err_con;
int sensi_meth;
cvode_mem = NULL;
data = NULL;
y = NULL;
yS = NULL;
A = NULL;
LS = NULL;
constraints = NULL;
/* Process arguments */
ProcessArgs(argc, argv, &sensi, &sensi_meth, &err_con);
/* User data structure */
data = (UserData) malloc(sizeof *data);
if (check_retval((void *)data, "malloc", 2)) return(1);
data->p[0] = RCONST(0.04);
data->p[1] = RCONST(1.0e4);
data->p[2] = RCONST(3.0e7);
/* Initial conditions */
y = N_VNew_Serial(NEQ);
if (check_retval((void *)y, "N_VNew_Serial", 0)) return(1);
Ith(y,1) = Y1;
Ith(y,2) = Y2;
Ith(y,3) = Y3;
/* Set constraints to all 1's for nonnegative solution values. */
constraints = N_VNew_Serial(NEQ);
if(check_retval((void *)constraints, "N_VNew_Serial", 0)) return(1);
N_VConst(ONE, constraints);
/* Create CVODES object */
cvode_mem = CVodeCreate(CV_BDF);
if (check_retval((void *)cvode_mem, "CVodeCreate", 0)) return(1);
/* Allocate space for CVODES */
retval = CVodeInit(cvode_mem, f, T0, y);
if (check_retval(&retval, "CVodeInit", 1)) return(1);
/* Use private function to compute error weights */
retval = CVodeWFtolerances(cvode_mem, ewt);
if (check_retval(&retval, "CVodeSetEwtFn", 1)) return(1);
/* Attach user data */
retval = CVodeSetUserData(cvode_mem, data);
if (check_retval(&retval, "CVodeSetUserData", 1)) return(1);
/* Call CVodeSetConstraints to initialize constraints */
retval = CVodeSetConstraints(cvode_mem, constraints);
if(check_retval(&retval, "CVodeSetConstraints", 1)) return(1);
N_VDestroy(constraints);
/* Create dense SUNMatrix */
A = SUNDenseMatrix(NEQ, NEQ);
if (check_retval((void *)A, "SUNDenseMatrix", 0)) return(1);
/* Create dense SUNLinearSolver */
LS = SUNLinSol_Dense(y, A);
if (check_retval((void *)LS, "SUNLinSol_Dense", 0)) return(1);
/* Attach the matrix and linear solver */
retval = CVDlsSetLinearSolver(cvode_mem, LS, A);
if (check_retval(&retval, "CVDlsSetLinearSolver", 1)) return(1);
/* Set the user-supplied Jacobian routine Jac */
retval = CVDlsSetJacFn(cvode_mem, Jac);
if (check_retval(&retval, "CVDlsSetJacFn", 1)) return(1);
printf("\n3-species chemical kinetics problem\n");
/* Sensitivity-related settings */
if (sensi) {
/* Set parameter scaling factor */
pbar[0] = data->p[0];
pbar[1] = data->p[1];
pbar[2] = data->p[2];
/* Set sensitivity initial conditions */
yS = N_VCloneVectorArray(NS, y);
if (check_retval((void *)yS, "N_VCloneVectorArray", 0)) return(1);
for (is=0;is<NS;is++) N_VConst(ZERO, yS[is]);
/* Call CVodeSensInit1 to activate forward sensitivity computations
and allocate internal memory for COVEDS related to sensitivity
calculations. Computes the right-hand sides of the sensitivity
ODE, one at a time */
retval = CVodeSensInit1(cvode_mem, NS, sensi_meth, fS, yS);
if(check_retval(&retval, "CVodeSensInit", 1)) return(1);
/* Call CVodeSensEEtolerances to estimate tolerances for sensitivity
variables based on the rolerances supplied for states variables and
the scaling factor pbar */
retval = CVodeSensEEtolerances(cvode_mem);
if(check_retval(&retval, "CVodeSensEEtolerances", 1)) return(1);
/* Set sensitivity analysis optional inputs */
/* Call CVodeSetSensErrCon to specify the error control strategy for
sensitivity variables */
retval = CVodeSetSensErrCon(cvode_mem, err_con);
if (check_retval(&retval, "CVodeSetSensErrCon", 1)) return(1);
/* Call CVodeSetSensParams to specify problem parameter information for
sensitivity calculations */
retval = CVodeSetSensParams(cvode_mem, NULL, pbar, NULL);
if (check_retval(&retval, "CVodeSetSensParams", 1)) return(1);
printf("Sensitivity: YES ");
if(sensi_meth == CV_SIMULTANEOUS)
printf("( SIMULTANEOUS +");
else
if(sensi_meth == CV_STAGGERED) printf("( STAGGERED +");
else printf("( STAGGERED1 +");
if(err_con) printf(" FULL ERROR CONTROL )");
else printf(" PARTIAL ERROR CONTROL )");
} else {
printf("Sensitivity: NO ");
}
/* In loop over output points, call CVode, print results, test for error */
printf("\n\n");
printf("===========================================");
printf("============================\n");
printf(" T Q H NST y1");
printf(" y2 y3 \n");
printf("===========================================");
printf("============================\n");
for (iout=1, tout=T1; iout <= NOUT; iout++, tout *= TMULT) {
retval = CVode(cvode_mem, tout, y, &t, CV_NORMAL);
if (check_retval(&retval, "CVode", 1)) break;
PrintOutput(cvode_mem, t, y);
/* Call CVodeGetSens to get the sensitivity solution vector after a
successful return from CVode */
if (sensi) {
retval = CVodeGetSens(cvode_mem, &t, yS);
if (check_retval(&retval, "CVodeGetSens", 1)) break;
PrintOutputS(yS);
}
printf("-----------------------------------------");
printf("------------------------------\n");
}
/* Print final statistics */
PrintFinalStats(cvode_mem, sensi);
/* Free memory */
N_VDestroy(y); /* Free y vector */
if (sensi) {
N_VDestroyVectorArray(yS, NS); /* Free yS vector */
}
free(data); /* Free user data */
CVodeFree(&cvode_mem); /* Free CVODES memory */
SUNLinSolFree(LS); /* Free the linear solver memory */
SUNMatDestroy(A); /* Free the matrix memory */
return(0);
}
int IDACalcIC(void *ida_mem, int icopt, realtype tout1)
{
int ewtsetOK;
int ier, nwt, nh, mxnh, icret, retval=0;
int is;
realtype tdist, troundoff, minid, hic, ypnorm;
IDAMem IDA_mem;
booleantype sensi_stg, sensi_sim;
/* Check if IDA memory exists */
if(ida_mem == NULL) {
IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDACalcIC", MSG_NO_MEM);
return(IDA_MEM_NULL);
}
IDA_mem = (IDAMem) ida_mem;
/* Check if problem was malloc'ed */
if(IDA_mem->ida_MallocDone == FALSE) {
IDAProcessError(IDA_mem, IDA_NO_MALLOC, "IDAS", "IDACalcIC", MSG_NO_MALLOC);
return(IDA_NO_MALLOC);
}
/* Check inputs to IDA for correctness and consistency */
ier = IDAInitialSetup(IDA_mem);
if(ier != IDA_SUCCESS) return(IDA_ILL_INPUT);
IDA_mem->ida_SetupDone = TRUE;
/* Check legality of input arguments, and set IDA memory copies. */
if(icopt != IDA_YA_YDP_INIT && icopt != IDA_Y_INIT) {
IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDACalcIC", MSG_IC_BAD_ICOPT);
return(IDA_ILL_INPUT);
}
IDA_mem->ida_icopt = icopt;
if(icopt == IDA_YA_YDP_INIT && (id == NULL)) {
IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDACalcIC", MSG_IC_MISSING_ID);
return(IDA_ILL_INPUT);
}
tdist = SUNRabs(tout1 - tn);
troundoff = TWO*uround*(SUNRabs(tn) + SUNRabs(tout1));
if(tdist < troundoff) {
IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDACalcIC", MSG_IC_TOO_CLOSE);
return(IDA_ILL_INPUT);
}
/* Are we computing sensitivities? */
sensi_stg = (sensi && (ism==IDA_STAGGERED));
sensi_sim = (sensi && (ism==IDA_SIMULTANEOUS));
/* Allocate space and initialize temporary vectors */
yy0 = N_VClone(ee);
yp0 = N_VClone(ee);
t0 = tn;
N_VScale(ONE, phi[0], yy0);
N_VScale(ONE, phi[1], yp0);
if (sensi) {
/* Allocate temporary space required for sensitivity IC: yyS0 and ypS0. */
yyS0 = N_VCloneVectorArray(Ns, ee);
ypS0 = N_VCloneVectorArray(Ns, ee);
/* Initialize sensitivity vector. */
for (is=0; is<Ns; is++) {
N_VScale(ONE, phiS[0][is], yyS0[is]);
N_VScale(ONE, phiS[1][is], ypS0[is]);
}
/* Initialize work space vectors needed for sensitivities. */
savresS = phiS[2];
delnewS = phiS[3];
yyS0new = phiS[4];
ypS0new = eeS;
}
/* For use in the IDA_YA_YP_INIT case, set sysindex and tscale. */
IDA_mem->ida_sysindex = 1;
IDA_mem->ida_tscale = tdist;
if(icopt == IDA_YA_YDP_INIT) {
minid = N_VMin(id);
if(minid < ZERO) {
IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDACalcIC", MSG_IC_BAD_ID);
return(IDA_ILL_INPUT);
}
if(minid > HALF) IDA_mem->ida_sysindex = 0;
}
/* Set the test constant in the Newton convergence test */
IDA_mem->ida_epsNewt = epiccon;
/* Initializations:
cjratio = 1 (for use in direct linear solvers);
set nbacktr = 0; */
cjratio = ONE;
nbacktr = 0;
/* Set hic, hh, cj, and mxnh. */
hic = PT001*tdist;
ypnorm = IDAWrmsNorm(IDA_mem, yp0, ewt, suppressalg);
if (sensi_sim)
ypnorm = IDASensWrmsNormUpdate(IDA_mem, ypnorm, ypS0, ewtS, FALSE);
if(ypnorm > HALF/hic) hic = HALF/ypnorm;
if(tout1 < tn) hic = -hic;
hh = hic;
if(icopt == IDA_YA_YDP_INIT) {
cj = ONE/hic;
mxnh = maxnh;
}
else {
cj = ZERO;
mxnh = 1;
}
/* Loop over nwt = number of evaluations of ewt vector. */
for(nwt = 1; nwt <= 2; nwt++) {
/* Loop over nh = number of h values. */
for(nh = 1; nh <= mxnh; nh++) {
/* Call the IC nonlinear solver function. */
retval = IDANlsIC(IDA_mem);
/* Cut h and loop on recoverable IDA_YA_YDP_INIT failure; else break. */
if(retval == IDA_SUCCESS) break;
ncfn++;
if(retval < 0) break;
if(nh == mxnh) break;
/* If looping to try again, reset yy0 and yp0 if not converging. */
if(retval != IC_SLOW_CONVRG) {
N_VScale(ONE, phi[0], yy0);
N_VScale(ONE, phi[1], yp0);
if (sensi_sim) {
/* Reset yyS0 and ypS0. */
/* Copy phiS[0] and phiS[1] into yyS0 and ypS0. */
for (is=0; is<Ns; is++) {
N_VScale(ONE, phiS[0][is], yyS0[is]);
N_VScale(ONE, phiS[1][is], ypS0[is]);
}
}
}
hic *= PT1;
cj = ONE/hic;
hh = hic;
} /* End of nh loop */
/* Break on failure */
if(retval != IDA_SUCCESS) break;
/* Reset ewt, save yy0, yp0 in phi, and loop. */
ewtsetOK = efun(yy0, ewt, edata);
if(ewtsetOK != 0) {
retval = IDA_BAD_EWT;
break;
}
N_VScale(ONE, yy0, phi[0]);
N_VScale(ONE, yp0, phi[1]);
if (sensi_sim) {
/* Reevaluate ewtS. */
ewtsetOK = IDASensEwtSet(IDA_mem, yyS0, ewtS);
if(ewtsetOK != 0) {
retval = IDA_BAD_EWT;
break;
}
/* Save yyS0 and ypS0. */
for (is=0; is<Ns; is++) {
N_VScale(ONE, yyS0[is], phiS[0][is]);
N_VScale(ONE, ypS0[is], phiS[1][is]);
}
}
} /* End of nwt loop */
/* Load the optional outputs. */
if(icopt == IDA_YA_YDP_INIT) hused = hic;
/* On any failure, free memory, print error message and return */
if(retval != IDA_SUCCESS) {
N_VDestroy(yy0);
N_VDestroy(yp0);
if(sensi) {
N_VDestroyVectorArray(yyS0, Ns);
N_VDestroyVectorArray(ypS0, Ns);
}
icret = IDAICFailFlag(IDA_mem, retval);
return(icret);
}
/* Unless using the STAGGERED approach for sensitivities, return now */
if (!sensi_stg) {
N_VDestroy(yy0);
N_VDestroy(yp0);
if(sensi) {
N_VDestroyVectorArray(yyS0, Ns);
N_VDestroyVectorArray(ypS0, Ns);
}
return(IDA_SUCCESS);
}
/* Find consistent I.C. for sensitivities using a staggered approach */
/* Evaluate res at converged y, needed for future evaluations of sens. RHS
If res() fails recoverably, treat it as a convergence failure and
attempt the step again */
retval = res(t0, yy0, yp0, delta, user_data);
nre++;
if(retval < 0)
/* res function failed unrecoverably. */
return(IDA_RES_FAIL);
if(retval > 0)
/* res function failed recoverably but no recovery possible. */
return(IDA_FIRST_RES_FAIL);
/* Loop over nwt = number of evaluations of ewt vector. */
for(nwt = 1; nwt <= 2; nwt++) {
/* Loop over nh = number of h values. */
for(nh = 1; nh <= mxnh; nh++) {
retval = IDASensNlsIC(IDA_mem);
if(retval == IDA_SUCCESS) break;
/* Increment the number of the sensitivity related corrector convergence failures. */
ncfnS++;
if(retval < 0) break;
if(nh == mxnh) break;
/* If looping to try again, reset yyS0 and ypS0 if not converging. */
if(retval != IC_SLOW_CONVRG) {
for (is=0; is<Ns; is++) {
N_VScale(ONE, phiS[0][is], yyS0[is]);
N_VScale(ONE, phiS[1][is], ypS0[is]);
}
}
hic *= PT1;
cj = ONE/hic;
hh = hic;
} /* End of nh loop */
/* Break on failure */
if(retval != IDA_SUCCESS) break;
/* Since it was successful, reevaluate ewtS with the new values of yyS0, save
yyS0 and ypS0 in phiS[0] and phiS[1] and loop one more time to check and
maybe correct the new sensitivities IC with respect to the new weights. */
/* Reevaluate ewtS. */
ewtsetOK = IDASensEwtSet(IDA_mem, yyS0, ewtS);
if(ewtsetOK != 0) {
retval = IDA_BAD_EWT;
break;
}
/* Save yyS0 and ypS0. */
for (is=0; is<Ns; is++) {
N_VScale(ONE, yyS0[is], phiS[0][is]);
N_VScale(ONE, ypS0[is], phiS[1][is]);
}
} /* End of nwt loop */
/* Load the optional outputs. */
if(icopt == IDA_YA_YDP_INIT) hused = hic;
/* Free temporary space */
N_VDestroy(yy0);
N_VDestroy(yp0);
/* Here sensi is TRUE, so deallocate sensitivity temporary vectors. */
N_VDestroyVectorArray(yyS0, Ns);
N_VDestroyVectorArray(ypS0, Ns);
/* On any failure, print message and return proper flag. */
if(retval != IDA_SUCCESS) {
icret = IDAICFailFlag(IDA_mem, retval);
return(icret);
}
/* Otherwise return success flag. */
return(IDA_SUCCESS);
}
