void FIDA_REINIT(realtype *t0, realtype *yy0, realtype *yp0, int *iatol, realtype *rtol, realtype *atol, int *ier) { N_Vector Vatol; *ier = 0; /* Initialize all pointers to NULL */ Vatol = NULL; /* Attach user's yy0 to F2C_IDA_vec */ N_VSetArrayPointer(yy0, F2C_IDA_vec); /* Attach user's yp0 to F2C_IDA_ypvec */ N_VSetArrayPointer(yp0, F2C_IDA_ypvec); /* Call IDAReInit */ *ier = IDAReInit(IDA_idamem, *t0, F2C_IDA_vec, F2C_IDA_ypvec); /* Reset data pointers */ N_VSetArrayPointer(NULL, F2C_IDA_vec); N_VSetArrayPointer(NULL, F2C_IDA_ypvec); /* On failure, exit */ if (*ier != IDA_SUCCESS) { *ier = -1; return; } /* Set tolerances */ switch (*iatol) { case 1: *ier = IDASStolerances(IDA_idamem, *rtol, *atol); break; case 2: Vatol = NULL; Vatol= N_VCloneEmpty(F2C_IDA_vec); if (Vatol == NULL) { *ier = -1; return; } N_VSetArrayPointer(atol, Vatol); *ier = IDASVtolerances(IDA_idamem, *rtol, Vatol); N_VDestroy(Vatol); break; } /* On failure, exit */ if (*ier != IDA_SUCCESS) { *ier = -1; return; } return; }
CAMLprim value sundials_ml_ida_reinit(value ida_solver, value t, value ida_ctxt) { CAMLparam2(ida_solver, ida_ctxt); const realtype rt_t0 = Double_val(t); value y0 = NUMSTATE_YY(ida_solver); value yp0 = NUMSTATE_YP(ida_solver); BA_STACK_NVECTOR(y0, nv_y0); BA_STACK_NVECTOR(yp0, nv_yp0); const int ret = IDAReInit(IDA_MEM(ida_solver), rt_t0, &nv_y0, &nv_yp0); CAMLreturn(Val_int(ret)); }
int main() { void *mem; UserData data; N_Vector uu, up, constraints, res; int ier, iout; realtype rtol, atol, t0, t1, tout, tret; long int netf, ncfn, ncfl; mem = NULL; data = NULL; uu = up = constraints = res = NULL; /* Allocate N-vectors and the user data structure. */ uu = N_VNew_Serial(NEQ); if(check_flag((void *)uu, "N_VNew_Serial", 0)) return(1); up = N_VNew_Serial(NEQ); if(check_flag((void *)up, "N_VNew_Serial", 0)) return(1); res = N_VNew_Serial(NEQ); if(check_flag((void *)res, "N_VNew_Serial", 0)) return(1); constraints = N_VNew_Serial(NEQ); if(check_flag((void *)constraints, "N_VNew_Serial", 0)) return(1); data = (UserData) malloc(sizeof *data); data->pp = NULL; if(check_flag((void *)data, "malloc", 2)) return(1); /* Assign parameters in the user data structure. */ data->mm = MGRID; data->dx = ONE/(MGRID-ONE); data->coeff = ONE/(data->dx * data->dx); data->pp = N_VNew_Serial(NEQ); if(check_flag((void *)data->pp, "N_VNew_Serial", 0)) return(1); /* Initialize uu, up. */ SetInitialProfile(data, uu, up, res); /* Set constraints to all 1's for nonnegative solution values. */ N_VConst(ONE, constraints); /* Assign various parameters. */ t0 = ZERO; t1 = RCONST(0.01); rtol = ZERO; atol = RCONST(1.0e-3); /* Call IDACreate and IDAMalloc to initialize solution */ mem = IDACreate(); if(check_flag((void *)mem, "IDACreate", 0)) return(1); ier = IDASetUserData(mem, data); if(check_flag(&ier, "IDASetUserData", 1)) return(1); ier = IDASetConstraints(mem, constraints); if(check_flag(&ier, "IDASetConstraints", 1)) return(1); N_VDestroy_Serial(constraints); ier = IDAInit(mem, resHeat, t0, uu, up); if(check_flag(&ier, "IDAInit", 1)) return(1); ier = IDASStolerances(mem, rtol, atol); if(check_flag(&ier, "IDASStolerances", 1)) return(1); /* Call IDASpgmr to specify the linear solver. */ ier = IDASpgmr(mem, 0); if(check_flag(&ier, "IDASpgmr", 1)) return(1); ier = IDASpilsSetPreconditioner(mem, PsetupHeat, PsolveHeat); if(check_flag(&ier, "IDASpilsSetPreconditioner", 1)) return(1); /* Print output heading. */ PrintHeader(rtol, atol); /* * ------------------------------------------------------------------------- * CASE I * ------------------------------------------------------------------------- */ /* Print case number, output table heading, and initial line of table. */ printf("\n\nCase 1: gsytpe = MODIFIED_GS\n"); printf("\n Output Summary (umax = max-norm of solution) \n\n"); printf(" time umax k nst nni nje nre nreLS h npe nps\n" ); printf("----------------------------------------------------------------------\n"); /* Loop over output times, call IDASolve, and print results. */ for (tout = t1,iout = 1; iout <= NOUT ; iout++, tout *= TWO) { ier = IDASolve(mem, tout, &tret, uu, up, IDA_NORMAL); if(check_flag(&ier, "IDASolve", 1)) return(1); PrintOutput(mem, tret, uu); } /* Print remaining counters. */ ier = IDAGetNumErrTestFails(mem, &netf); check_flag(&ier, "IDAGetNumErrTestFails", 1); ier = IDAGetNumNonlinSolvConvFails(mem, &ncfn); check_flag(&ier, "IDAGetNumNonlinSolvConvFails", 1); ier = IDASpilsGetNumConvFails(mem, &ncfl); check_flag(&ier, "IDASpilsGetNumConvFails", 1); printf("\nError test failures = %ld\n", netf); printf("Nonlinear convergence failures = %ld\n", ncfn); printf("Linear convergence failures = %ld\n", ncfl); /* * ------------------------------------------------------------------------- * CASE II * ------------------------------------------------------------------------- */ /* Re-initialize uu, up. */ SetInitialProfile(data, uu, up, res); /* Re-initialize IDA and IDASPGMR */ ier = IDAReInit(mem, t0, uu, up); if(check_flag(&ier, "IDAReInit", 1)) return(1); ier = IDASpilsSetGSType(mem, CLASSICAL_GS); if(check_flag(&ier, "IDASpilsSetGSType",1)) return(1); /* Print case number, output table heading, and initial line of table. */ printf("\n\nCase 2: gstype = CLASSICAL_GS\n"); printf("\n Output Summary (umax = max-norm of solution) \n\n"); printf(" time umax k nst nni nje nre nreLS h npe nps\n" ); printf("----------------------------------------------------------------------\n"); /* Loop over output times, call IDASolve, and print results. */ for (tout = t1,iout = 1; iout <= NOUT ; iout++, tout *= TWO) { ier = IDASolve(mem, tout, &tret, uu, up, IDA_NORMAL); if(check_flag(&ier, "IDASolve", 1)) return(1); PrintOutput(mem, tret, uu); } /* Print remaining counters. */ ier = IDAGetNumErrTestFails(mem, &netf); check_flag(&ier, "IDAGetNumErrTestFails", 1); ier = IDAGetNumNonlinSolvConvFails(mem, &ncfn); check_flag(&ier, "IDAGetNumNonlinSolvConvFails", 1); ier = IDASpilsGetNumConvFails(mem, &ncfl); check_flag(&ier, "IDASpilsGetNumConvFails", 1); printf("\nError test failures = %ld\n", netf); printf("Nonlinear convergence failures = %ld\n", ncfn); printf("Linear convergence failures = %ld\n", ncfl); /* Free Memory */ IDAFree(&mem); N_VDestroy_Serial(uu); N_VDestroy_Serial(up); N_VDestroy_Serial(res); N_VDestroy_Serial(data->pp); free(data); return(0); }
int main(int argc, char *argv[]) { MPI_Comm comm; void *mem; UserData data; int thispe, iout, ier, npes; long int Neq, local_N, mudq, mldq, mukeep, mlkeep; realtype rtol, atol, t0, t1, tout, tret; N_Vector uu, up, constraints, id, res; mem = NULL; data = NULL; uu = up = constraints = id = res = NULL; /* Get processor number and total number of pe's. */ MPI_Init(&argc, &argv); comm = MPI_COMM_WORLD; MPI_Comm_size(comm, &npes); MPI_Comm_rank(comm, &thispe); if (npes != NPEX*NPEY) { if (thispe == 0) fprintf(stderr, "\nMPI_ERROR(0): npes = %d is not equal to NPEX*NPEY = %d\n", npes,NPEX*NPEY); MPI_Finalize(); return(1); } /* Set local length local_N and global length Neq. */ local_N = MXSUB*MYSUB; Neq = MX * MY; /* Allocate N-vectors. */ uu = N_VNew_Parallel(comm, local_N, Neq); if(check_flag((void *)uu, "N_VNew_Parallel", 0, thispe)) MPI_Abort(comm, 1); up = N_VNew_Parallel(comm, local_N, Neq); if(check_flag((void *)up, "N_VNew_Parallel", 0, thispe)) MPI_Abort(comm, 1); res = N_VNew_Parallel(comm, local_N, Neq); if(check_flag((void *)res, "N_VNew_Parallel", 0, thispe)) MPI_Abort(comm, 1); constraints = N_VNew_Parallel(comm, local_N, Neq); if(check_flag((void *)constraints, "N_VNew_Parallel", 0, thispe)) MPI_Abort(comm, 1); id = N_VNew_Parallel(comm, local_N, Neq); if(check_flag((void *)id, "N_VNew_Parallel", 0, thispe)) MPI_Abort(comm, 1); /* Allocate and initialize the data structure. */ data = (UserData) malloc(sizeof *data); if(check_flag((void *)data, "malloc", 2, thispe)) MPI_Abort(comm, 1); InitUserData(thispe, comm, data); /* Initialize the uu, up, id, and constraints profiles. */ SetInitialProfile(uu, up, id, res, data); N_VConst(ONE, constraints); t0 = ZERO; t1 = RCONST(0.01); /* Scalar relative and absolute tolerance. */ rtol = ZERO; atol = RCONST(1.0e-3); /* Call IDACreate and IDAMalloc to initialize solution */ mem = IDACreate(); if(check_flag((void *)mem, "IDACreate", 0, thispe)) MPI_Abort(comm, 1); ier = IDASetUserData(mem, data); if(check_flag(&ier, "IDASetUserData", 1, thispe)) MPI_Abort(comm, 1); ier = IDASetSuppressAlg(mem, TRUE); if(check_flag(&ier, "IDASetSuppressAlg", 1, thispe)) MPI_Abort(comm, 1); ier = IDASetId(mem, id); if(check_flag(&ier, "IDASetId", 1, thispe)) MPI_Abort(comm, 1); ier = IDASetConstraints(mem, constraints); if(check_flag(&ier, "IDASetConstraints", 1, thispe)) MPI_Abort(comm, 1); N_VDestroy_Parallel(constraints); ier = IDAInit(mem, heatres, t0, uu, up); if(check_flag(&ier, "IDAInit", 1, thispe)) MPI_Abort(comm, 1); ier = IDASStolerances(mem, rtol, atol); if(check_flag(&ier, "IDASStolerances", 1, thispe)) MPI_Abort(comm, 1); mudq = MXSUB; mldq = MXSUB; mukeep = 1; mlkeep = 1; /* Print problem description */ if (thispe == 0 ) PrintHeader(Neq, rtol, atol); /* * ----------------------------- * Case 1 -- mldq = mudq = MXSUB * ----------------------------- */ /* Call IDASpgmr to specify the linear solver. */ ier = IDASpgmr(mem, 0); if(check_flag(&ier, "IDASpgmr", 1, thispe)) MPI_Abort(comm, 1); /* Call IDABBDPrecInit to initialize BBD preconditioner. */ ier = IDABBDPrecInit(mem, local_N, mudq, mldq, mukeep, mlkeep, ZERO, reslocal, NULL); if(check_flag(&ier, "IDABBDPrecAlloc", 1, thispe)) MPI_Abort(comm, 1); /* Print output heading (on processor 0 only) and initial solution. */ if (thispe == 0) PrintCase(1, mudq, mukeep); /* Loop over tout, call IDASolve, print output. */ for (tout = t1, iout = 1; iout <= NOUT; iout++, tout *= TWO) { ier = IDASolve(mem, tout, &tret, uu, up, IDA_NORMAL); if(check_flag(&ier, "IDASolve", 1, thispe)) MPI_Abort(comm, 1); PrintOutput(thispe, mem, tret, uu); } /* Print final statistics */ if (thispe == 0) PrintFinalStats(mem); /* * ----------------------------- * Case 2 -- mldq = mudq = 1 * ----------------------------- */ mudq = 1; mldq = 1; /* Re-initialize the uu and up profiles. */ SetInitialProfile(uu, up, id, res, data); /* Call IDAReInit to re-initialize IDA. */ ier = IDAReInit(mem, t0, uu, up); if(check_flag(&ier, "IDAReInit", 1, thispe)) MPI_Abort(comm, 1); /* Call IDABBDPrecReInit to re-initialize BBD preconditioner. */ ier = IDABBDPrecReInit(mem, mudq, mldq, ZERO); if(check_flag(&ier, "IDABBDPrecReInit", 1, thispe)) MPI_Abort(comm, 1); /* Print output heading (on processor 0 only). */ if (thispe == 0) PrintCase(2, mudq, mukeep); /* Loop over tout, call IDASolve, print output. */ for (tout = t1, iout = 1; iout <= NOUT; iout++, tout *= TWO) { ier = IDASolve(mem, tout, &tret, uu, up, IDA_NORMAL); if(check_flag(&ier, "IDASolve", 1, thispe)) MPI_Abort(comm, 1); PrintOutput(thispe, mem, tret, uu); } /* Print final statistics */ if (thispe == 0) PrintFinalStats(mem); /* Free Memory */ IDAFree(&mem); free(data); N_VDestroy_Parallel(id); N_VDestroy_Parallel(res); N_VDestroy_Parallel(up); N_VDestroy_Parallel(uu); MPI_Finalize(); return(0); }
void IdaSolver::initialize(const double &pVoiStart, const double &pVoiEnd, const int &pStatesCount, const int &pCondVarCount, double *pConstants, double *pRates, double *pStates, double *pAlgebraic, double *pCondVar, ComputeEssentialVariablesFunction pComputeEssentialVariables, ComputeResidualsFunction pComputeResiduals, ComputeRootInformationFunction pComputeRootInformation, ComputeStateInformationFunction pComputeStateInformation) { static const double VoiEpsilon = 1.0e-9; if (!mSolver) { // Initialise the ODE solver itself OpenCOR::CoreSolver::CoreDaeSolver::initialize(pVoiStart, pVoiEnd, pStatesCount, pCondVarCount, pConstants, pRates, pStates, pAlgebraic, pCondVar, pComputeEssentialVariables, pComputeResiduals, pComputeRootInformation, pComputeStateInformation); // Retrieve some of the IDA properties if (mProperties.contains(MaximumStepProperty)) mMaximumStep = mProperties.value(MaximumStepProperty).toDouble(); else emit error(QObject::tr("the 'maximum step' property value could not be retrieved")); if (mProperties.contains(MaximumNumberOfStepsProperty)) mMaximumNumberOfSteps = mProperties.value(MaximumNumberOfStepsProperty).toInt(); else emit error(QObject::tr("the 'maximum number of steps' property value could not be retrieved")); if (mProperties.contains(RelativeToleranceProperty)) mRelativeTolerance = mProperties.value(RelativeToleranceProperty).toDouble(); else emit error(QObject::tr("the 'relative tolerance' property value could not be retrieved")); if (mProperties.contains(AbsoluteToleranceProperty)) mAbsoluteTolerance = mProperties.value(AbsoluteToleranceProperty).toDouble(); else emit error(QObject::tr("the 'absolute tolerance' property value could not be retrieved")); // Create the states vector mStatesVector = N_VMake_Serial(pStatesCount, pStates); mRatesVector = N_VMake_Serial(pStatesCount, pRates); // Create the IDA solver mSolver = IDACreate(); // Use our own error handler IDASetErrHandlerFn(mSolver, errorHandler, this); // Initialise the IDA solver IDAInit(mSolver, residualFunction, pVoiStart, mStatesVector, mRatesVector); IDARootInit(mSolver, pCondVarCount, rootFindingFunction); //---GRY--- NEED TO CHECK THAT OUR IDA CODE WORKS AS EXPECTED BY TRYING // IT OUT ON A MODEL WHICH NEEDS ROOT FINDING (E.G. THE // SAUCERMAN MODEL)... // Set some user data delete mUserData; // Just in case the solver got initialised before mUserData = new IdaSolverUserData(pConstants, pAlgebraic, pCondVar, pComputeEssentialVariables, pComputeResiduals, pComputeRootInformation); IDASetUserData(mSolver, mUserData); // Set the linear solver IDADense(mSolver, pStatesCount); // Set the maximum step IDASetMaxStep(mSolver, mMaximumStep); // Set the maximum number of steps IDASetMaxNumSteps(mSolver, mMaximumNumberOfSteps); // Set the relative and absolute tolerances IDASStolerances(mSolver, mRelativeTolerance, mAbsoluteTolerance); // Compute the model's initial conditions // Note: this requires retrieving the model's state information, setting // the IDA object's id vector and then calling IDACalcIC()... double *id = new double[pStatesCount]; pComputeStateInformation(id); N_Vector idVector = N_VMake_Serial(pStatesCount, id); IDASetId(mSolver, idVector); IDACalcIC(mSolver, IDA_YA_YDP_INIT, pVoiStart+((pVoiEnd-pVoiStart > 0)?VoiEpsilon:-VoiEpsilon)); N_VDestroy_Serial(idVector); delete[] id; } else { // Reinitialise the IDA object IDAReInit(mSolver, pVoiStart, mStatesVector, mRatesVector); // Compute the model's new initial conditions IDACalcIC(mSolver, IDA_YA_YDP_INIT, pVoiStart+((pVoiEnd-pVoiStart > 0)?VoiEpsilon:-VoiEpsilon)); } }
void Ida::IDACore() { _idid = IDAReInit(_idaMem, _tCurrent, _CV_y,_CV_yp); _idid = IDASetStopTime(_idaMem, _tEnd); _idid = IDASetInitStep(_idaMem, 1e-12); if (_idid < 0) throw std::runtime_error("IDA::ReInit"); bool writeEventOutput = (_settings->getGlobalSettings()->getOutputPointType() == OPT_ALL); bool writeOutput = !(_settings->getGlobalSettings()->getOutputPointType() == OPT_NONE); while ((_solverStatus & ISolver::CONTINUE) && !_interrupt ) { _cv_rt = IDASolve(_idaMem, _tEnd, &_tCurrent, _CV_y, _CV_yp, IDA_ONE_STEP); _idid = IDAGetNumSteps(_idaMem, &_locStps); if (_idid != IDA_SUCCESS) throw std::runtime_error("IDAGetNumSteps failed. The ida mem pointer is NULL"); _idid =IDAGetLastStep(_idaMem, &_h); if (_idid != IDA_SUCCESS) throw std::runtime_error("IDAGetLastStep failed. The ida mem pointer is NULL"); //Check if there was at least one output-point within the last solver interval // -> Write output if true if (writeOutput) { writeIDAOutput(_tCurrent, _h, _locStps); } #ifdef RUNTIME_PROFILING MEASURETIME_REGION_DEFINE(idaStepCompletedHandler, "IDAStepCompleted"); if(MeasureTime::getInstance() != NULL) { MEASURETIME_START(measuredFunctionStartValues, idaStepCompletedHandler, "IDAStepCompleted"); } #endif //set completed step to system and check if terminate was called if(_continuous_system->stepCompleted(_tCurrent)) _solverStatus = DONE; #ifdef RUNTIME_PROFILING if(MeasureTime::getInstance() != NULL) { MEASURETIME_END(measuredFunctionStartValues, measuredFunctionEndValues, (*measureTimeFunctionsArray)[5], idaStepCompletedHandler); } #endif // Perform state selection bool state_selection = stateSelection(); if (state_selection) _continuous_system->getContinuousStates(_y); _zeroFound = false; // Check if step was successful if (check_flag(&_cv_rt, "IDA", 1)) { _solverStatus = ISolver::SOLVERERROR; break; } // A root was found if ((_cv_rt == IDA_ROOT_RETURN) && !isInterrupted()) { // IDA is setting _tCurrent to the time where the first event occurred double _abs = fabs(_tLastEvent - _tCurrent); _zeroFound = true; if ((_abs < 1e-3) && _event_n == 0) { _tLastEvent = _tCurrent; _event_n++; } else if ((_abs < 1e-3) && (_event_n >= 1 && _event_n < 500)) { _event_n++; } else if ((_abs >= 1e-3)) { //restart event counter _tLastEvent = _tCurrent; _event_n = 0; } else throw std::runtime_error("Number of events exceeded in time interval " + to_string(_abs) + " at time " + to_string(_tCurrent)); // IDA has interpolated the states at time 'tCurrent' _time_system->setTime(_tCurrent); // To get steep steps in the result file, two value points (P1 and P2) must be added // // Y | (P2) X........... // | : // | : // |........X (P1) // |----------------------------------> // | ^ t // _tCurrent // Write the values of (P1) if (writeEventOutput) { if(_dimAE>0) { _continuous_system->evaluateDAE(IContinuous::CONTINUOUS); } else { _continuous_system->evaluateAll(IContinuous::CONTINUOUS); } writeToFile(0, _tCurrent, _h); } _idid = IDAGetRootInfo(_idaMem, _zeroSign); for (int i = 0; i < _dimZeroFunc; i++) _events[i] = bool(_zeroSign[i]); if (_mixed_system->handleSystemEvents(_events)) { // State variables were reinitialized, thus we have to give these values to the ida-solver // Take care about the memory regions, _z is the same like _CV_y _continuous_system->getContinuousStates(_y); if(_dimAE>0) { _mixed_system->getAlgebraicDAEVars(_y+_dimStates); _continuous_system->getRHS(_yp); } calcFunction(_tCurrent, NV_DATA_S(_CV_y), NV_DATA_S(_CV_yp),_dae_res); } } if ((_zeroFound || state_selection)&& !isInterrupted()) { // Write the values of (P2) if (writeEventOutput) { // If we want to write the event-results, we should evaluate the whole system again if(_dimAE>0) { _continuous_system->evaluateDAE(IContinuous::CONTINUOUS); } else { _continuous_system->evaluateAll(IContinuous::CONTINUOUS); } writeToFile(0, _tCurrent, _h); } _idid = IDAReInit(_idaMem, _tCurrent, _CV_y,_CV_yp); if (_idid < 0) throw std::runtime_error("IDA::ReInit()"); // Der Eventzeitpunkt kann auf der Endzeit liegen (Time-Events). In diesem Fall wird der Solver beendet, da IDA sonst eine interne Warnung schmeißt if (_tCurrent == _tEnd) _cv_rt = IDA_TSTOP_RETURN; } // Zähler für die Anzahl der ausgegebenen Schritte erhöhen ++_outStps; _tLastSuccess = _tCurrent; if (_cv_rt == IDA_TSTOP_RETURN) { _time_system->setTime(_tEnd); _continuous_system->setContinuousStates(NV_DATA_S(_CV_y)); if(_dimAE>0) { _mixed_system->setAlgebraicDAEVars(NV_DATA_S(_CV_y)+_dimStates); _continuous_system->setStateDerivatives(NV_DATA_S(_CV_yp)); _continuous_system->evaluateDAE(IContinuous::CONTINUOUS); } else { _continuous_system->evaluateAll(IContinuous::CONTINUOUS); } if(writeOutput) writeToFile(0, _tEnd, _h); _accStps += _locStps; _solverStatus = DONE; } } }
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); }