/*---------------------------------------------------------------- Function : SpfgmrFree ---------------------------------------------------------------*/ void SpfgmrFree(SpfgmrMem mem) { int i; if (mem == NULL) return; for (i=0; i<=mem->l_max; i++) { free(mem->Hes[i]); mem->Hes[i] = NULL; } free(mem->Hes); mem->Hes = NULL; free(mem->givens); mem->givens = NULL; free(mem->yg); mem->yg = NULL; N_VDestroyVectorArray(mem->V, mem->l_max+1); N_VDestroyVectorArray(mem->Z, mem->l_max+1); N_VDestroy(mem->xcor); N_VDestroy(mem->vtemp); free(mem); mem = NULL; }
void SptfqmrFree(SptfqmrMem mem) { if (mem == NULL) return; 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); free(mem); mem = NULL; }
N_Vector *N_VCloneVectorArray(int count, N_Vector w) { N_Vector *vs = NULL; 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_VClone(w); if (vs[j] == NULL) { N_VDestroyVectorArray(vs, j-1); return(NULL); } } return(vs); }
void SpgmrFree(SpgmrMem mem) { int i, l_max; realtype **Hes, *givens, *yg; if (mem == NULL) return; l_max = mem->l_max; Hes = mem->Hes; givens = mem->givens; yg = mem->yg; for (i = 0; i <= l_max; i++) {free(Hes[i]); Hes[i] = NULL;} free(Hes); Hes = NULL; free(mem->givens); givens = NULL; free(mem->yg); yg = NULL; N_VDestroyVectorArray(mem->V, l_max+1); N_VDestroy(mem->xcor); N_VDestroy(mem->vtemp); free(mem); mem = NULL; }
/*---------------------------------------------------------------- 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(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 main(int argc, char *argv[]) { realtype dx, reltol, abstol, t, tout; N_Vector u; UserData data; void *cvode_mem; int iout, flag, my_pe, npes; long int local_N, nperpe, nrem, my_base; realtype *pbar; int is, *plist; N_Vector *uS; booleantype sensi, err_con; int sensi_meth; MPI_Comm comm; u = NULL; data = NULL; cvode_mem = NULL; pbar = NULL; plist = NULL; uS = NULL; /* Get processor number, total number of pe's, and my_pe. */ MPI_Init(&argc, &argv); comm = MPI_COMM_WORLD; MPI_Comm_size(comm, &npes); MPI_Comm_rank(comm, &my_pe); /* Process arguments */ ProcessArgs(argc, argv, my_pe, &sensi, &sensi_meth, &err_con); /* Set local vector length. */ nperpe = NEQ/npes; nrem = NEQ - npes*nperpe; local_N = (my_pe < nrem) ? nperpe+1 : nperpe; my_base = (my_pe < nrem) ? my_pe*local_N : my_pe*nperpe + nrem; /* USER DATA STRUCTURE */ data = (UserData) malloc(sizeof *data); /* Allocate data memory */ data->p = NULL; if(check_flag((void *)data, "malloc", 2, my_pe)) MPI_Abort(comm, 1); data->comm = comm; data->npes = npes; data->my_pe = my_pe; data->p = (realtype *) malloc(NP * sizeof(realtype)); if(check_flag((void *)data->p, "malloc", 2, my_pe)) MPI_Abort(comm, 1); dx = data->dx = XMAX/((realtype)(MX+1)); data->p[0] = RCONST(1.0); data->p[1] = RCONST(0.5); /* INITIAL STATES */ u = N_VNew_Parallel(comm, local_N, NEQ); /* Allocate u vector */ if(check_flag((void *)u, "N_VNew_Parallel", 0, my_pe)) MPI_Abort(comm, 1); SetIC(u, dx, local_N, my_base); /* Initialize u vector */ /* TOLERANCES */ reltol = ZERO; /* Set the tolerances */ abstol = ATOL; /* CVODE_CREATE & CVODE_MALLOC */ cvode_mem = CVodeCreate(CV_ADAMS, CV_FUNCTIONAL); if(check_flag((void *)cvode_mem, "CVodeCreate", 0, my_pe)) MPI_Abort(comm, 1); flag = CVodeSetUserData(cvode_mem, data); if(check_flag(&flag, "CVodeSetUserData", 1, my_pe)) MPI_Abort(comm, 1); flag = CVodeInit(cvode_mem, f, T0, u); if(check_flag(&flag, "CVodeInit", 1, my_pe)) MPI_Abort(comm, 1); flag = CVodeSStolerances(cvode_mem, reltol, abstol); if(check_flag(&flag, "CVodeSStolerances", 1, my_pe)) MPI_Abort(comm, 1); if (my_pe == 0) { printf("\n1-D advection-diffusion equation, mesh size =%3d \n", MX); printf("\nNumber of PEs = %3d \n",npes); } if(sensi) { plist = (int *) malloc(NS * sizeof(int)); if(check_flag((void *)plist, "malloc", 2, my_pe)) MPI_Abort(comm, 1); for(is=0; is<NS; is++) plist[is] = is; /* sensitivity w.r.t. i-th parameter */ pbar = (realtype *) malloc(NS * sizeof(realtype)); if(check_flag((void *)pbar, "malloc", 2, my_pe)) MPI_Abort(comm, 1); for(is=0; is<NS; is++) pbar[is] = data->p[plist[is]]; uS = N_VCloneVectorArray_Parallel(NS, u); if(check_flag((void *)uS, "N_VCloneVectorArray_Parallel", 0, my_pe)) MPI_Abort(comm, 1); for(is=0;is<NS;is++) N_VConst(ZERO,uS[is]); flag = CVodeSensInit1(cvode_mem, NS, sensi_meth, NULL, uS); if(check_flag(&flag, "CVodeSensInit1", 1, my_pe)) MPI_Abort(comm, 1); flag = CVodeSensEEtolerances(cvode_mem); if(check_flag(&flag, "CVodeSensEEtolerances", 1, my_pe)) MPI_Abort(comm, 1); flag = CVodeSetSensErrCon(cvode_mem, err_con); if(check_flag(&flag, "CVodeSetSensErrCon", 1, my_pe)) MPI_Abort(comm, 1); flag = CVodeSetSensDQMethod(cvode_mem, CV_CENTERED, ZERO); if(check_flag(&flag, "CVodeSetSensDQMethod", 1, my_pe)) MPI_Abort(comm, 1); flag = CVodeSetSensParams(cvode_mem, data->p, pbar, plist); if(check_flag(&flag, "CVodeSetSensParams", 1, my_pe)) MPI_Abort(comm, 1); if(my_pe == 0) { 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 { if(my_pe == 0) printf("Sensitivity: NO "); } /* In loop over output points, call CVode, print results, test for error */ if(my_pe == 0) { printf("\n\n"); printf("============================================================\n"); printf(" T Q H NST Max norm \n"); printf("============================================================\n"); } for (iout=1, tout=T1; iout <= NOUT; iout++, tout += DTOUT) { flag = CVode(cvode_mem, tout, u, &t, CV_NORMAL); if(check_flag(&flag, "CVode", 1, my_pe)) break; PrintOutput(cvode_mem, my_pe, t, u); if (sensi) { flag = CVodeGetSens(cvode_mem, &t, uS); if(check_flag(&flag, "CVodeGetSens", 1, my_pe)) break; PrintOutputS(my_pe, uS); } if (my_pe == 0) printf("------------------------------------------------------------\n"); } /* Print final statistics */ if (my_pe == 0) PrintFinalStats(cvode_mem, sensi); /* Free memory */ N_VDestroy(u); /* Free the u vector */ if (sensi) N_VDestroyVectorArray(uS, NS); /* Free the uS vectors */ free(data->p); /* Free the p vector */ free(data); /* Free block of UserData */ CVodeFree(&cvode_mem); /* Free the CVODES problem memory */ free(pbar); if(sensi) free(plist); MPI_Finalize(); 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); }