コード例 #1
0
CAMLprim value sundials_ml_ida_create(value unit) {

  static struct custom_operations ida_ctxt_ops = {
    "sundials_ml_ida_solver",
    sundials_ml_ida_solver_finalize,
    custom_compare_default,
    custom_hash_default,
    custom_serialize_default,
    custom_deserialize_default,
  };

  CAMLparam0 ();
  CAMLlocal1 (block);
 
  block = caml_alloc_custom(&ida_ctxt_ops, sizeof(struct sundials_ml_ida_ctxt), 1, 10);

  ROOT(block) = malloc(sizeof(value));
  IDA_MEM(block) = IDACreate();

  IDASetUserData(IDA_MEM(block), ROOT(block));

  CAMLreturn (block);
}
コード例 #2
0
int main(void)
{
  void *mem;
  N_Vector yy, yp, avtol;
  realtype rtol, *yval, *ypval, *atval;
  realtype t0, t1, tout, tret;
  int iout, retval;

  mem = NULL;
  yy = yp = avtol = NULL;
  yval = ypval = atval = NULL;

  /* Allocate N-vectors. */

  yy = N_VNew_Serial(NEQ);
  if(check_flag((void *)yy, "N_VNew_Serial", 0)) return(1);
  yp = N_VNew_Serial(NEQ);
  if(check_flag((void *)yp, "N_VNew_Serial", 0)) return(1);
  avtol = N_VNew_Serial(NEQ);
  if(check_flag((void *)avtol, "N_VNew_Serial", 0)) return(1);

  /* Create and initialize  y, y', and absolute tolerance vectors. */

  yval  = NV_DATA_S(yy);
  yval[0] = ONE;
  yval[1] = ZERO;
  yval[2] = ZERO;

  ypval = NV_DATA_S(yp);
  ypval[0]  = RCONST(-0.04);
  ypval[1]  = RCONST(0.04);
  ypval[2]  = ZERO;  

  rtol = RCONST(1.0e-4);

  atval = NV_DATA_S(avtol);
  atval[0] = RCONST(1.0e-6);
  atval[1] = RCONST(1.0e-10);
  atval[2] = RCONST(1.0e-6);

  /* Integration limits */

  t0 = ZERO;
  t1 = RCONST(0.4);

  PrintHeader(rtol, avtol, yy);

  /* Call IDACreate and IDAMalloc to initialize IDA memory */

  mem = IDACreate();
  if(check_flag((void *)mem, "IDACreate", 0)) return(1);
  retval = IDAMalloc(mem, resrob, t0, yy, yp, IDA_SV, rtol, avtol);
  if(check_flag(&retval, "IDAMalloc", 1)) return(1);
  
  /* Free avtol */
  N_VDestroy_Serial(avtol);

  /* Call IDADense and set up the linear solver. */

  retval = IDADense(mem, NEQ);
  if(check_flag(&retval, "IDADense", 1)) return(1);
  retval = IDADenseSetJacFn(mem, jacrob, NULL);
  if(check_flag(&retval, "IDADenseSetJacFn", 1)) return(1);

  /* Loop over tout values and call IDASolve. */

  for (tout = t1, iout = 1; iout <= NOUT ; iout++, tout *= RCONST(10.0)) {
    retval=IDASolve(mem, tout, &tret, yy, yp, IDA_NORMAL);
    if(check_flag(&retval, "IDASolve", 1)) return(1);
    PrintOutput(mem,tret,yy);
  }

  PrintFinalStats(mem);

  /* Free memory */

  IDAFree(mem);
  N_VDestroy_Serial(yy);
  N_VDestroy_Serial(yp);

  return(0);
  
}
コード例 #3
0
ファイル: idasHeat2D_bnd.c プロジェクト: luca-heltai/sundials
int main(void)
{
  void *mem;
  UserData data;
  N_Vector uu, up, constraints, id, res;
  int ier, iout;
  long int mu, ml, netf, ncfn;
  realtype rtol, atol, t0, t1, tout, tret;
  
  mem = NULL;
  data = NULL;
  uu = up = constraints = id = res = NULL;

  /* Create vectors uu, up, res, constraints, id. */
  uu = N_VNew_Serial(NEQ);
  if(check_flag((void *)uu, "N_VNew_Serial", 0)) return(1);
  up = N_VNew_Serial(NEQ);
  if(check_flag((void *)up, "N_VNew_Serial", 0)) return(1);
  res = N_VNew_Serial(NEQ);
  if(check_flag((void *)res, "N_VNew_Serial", 0)) return(1);
  constraints = N_VNew_Serial(NEQ);
  if(check_flag((void *)constraints, "N_VNew_Serial", 0)) return(1);
  id = N_VNew_Serial(NEQ);
  if(check_flag((void *)id, "N_VNew_Serial", 0)) return(1);

  /* Create and load problem data block. */
  data = (UserData) malloc(sizeof *data);
  if(check_flag((void *)data, "malloc", 2)) return(1);
  data->mm = MGRID;
  data->dx = ONE/(MGRID - ONE);
  data->coeff = ONE/( (data->dx) * (data->dx) );

  /* Initialize uu, up, id. */
  SetInitialProfile(data, uu, up, id, res);

  /* Set constraints to all 1's for nonnegative solution values. */
  N_VConst(ONE, constraints);

  /* Set remaining input parameters. */
  t0   = ZERO;
  t1   = RCONST(0.01);
  rtol = ZERO;
  atol = RCONST(1.0e-3);

  /* Call IDACreate and IDAMalloc to initialize solution */
  mem = IDACreate();
  if(check_flag((void *)mem, "IDACreate", 0)) return(1);

  ier = IDASetUserData(mem, data);
  if(check_flag(&ier, "IDASetUserData", 1)) return(1);

  ier = IDASetId(mem, id);
  if(check_flag(&ier, "IDASetId", 1)) return(1);

  ier = IDASetConstraints(mem, constraints);
  if(check_flag(&ier, "IDASetConstraints", 1)) return(1);
  N_VDestroy_Serial(constraints);

  ier = IDAInit(mem, heatres, t0, uu, up);
  if(check_flag(&ier, "IDAInit", 1)) return(1);

  ier = IDASStolerances(mem, rtol, atol);
  if(check_flag(&ier, "IDASStolerances", 1)) return(1);

  /* Call IDABand to specify the linear solver. */
  mu = MGRID; ml = MGRID;
  ier = IDABand(mem, NEQ, mu, ml);
  if(check_flag(&ier, "IDABand", 1)) return(1);
 
  /* Call IDACalcIC to correct the initial values. */
  
  ier = IDACalcIC(mem, IDA_YA_YDP_INIT, t1);
  if(check_flag(&ier, "IDACalcIC", 1)) return(1);

  /* Print output heading. */
  PrintHeader(rtol, atol);
  
  PrintOutput(mem, t0, uu);


  /* Loop over output times, call IDASolve, and print results. */
  
  for (tout = t1, iout = 1; iout <= NOUT; iout++, tout *= TWO) {
    
    ier = IDASolve(mem, tout, &tret, uu, up, IDA_NORMAL);
    if(check_flag(&ier, "IDASolve", 1)) return(1);

    PrintOutput(mem, tret, uu);
  
  }
  
  /* Print remaining counters and free memory. */
  ier = IDAGetNumErrTestFails(mem, &netf);
  check_flag(&ier, "IDAGetNumErrTestFails", 1);
  ier = IDAGetNumNonlinSolvConvFails(mem, &ncfn);
  check_flag(&ier, "IDAGetNumNonlinSolvConvFails", 1);
  printf("\n netf = %ld,   ncfn = %ld \n", netf, ncfn);

  IDAFree(&mem);
  N_VDestroy_Serial(uu);
  N_VDestroy_Serial(up);
  N_VDestroy_Serial(id);
  N_VDestroy_Serial(res);
  free(data);

  return(0);
}
コード例 #4
0
ファイル: idas_interface.cpp プロジェクト: andrescodas/casadi
  void IdasInterface::init_memory(void* mem) const {
    SundialsInterface::init_memory(mem);
    auto m = to_mem(mem);

    // Create IDAS memory block
    m->mem = IDACreate();
    casadi_assert_message(m->mem!=0, "IDACreate: Creation failed");

    // Set error handler function
    THROWING(IDASetErrHandlerFn, m->mem, ehfun, m);

    // Set user data
    THROWING(IDASetUserData, m->mem, m);

    // Allocate n-vectors for ivp
    m->xzdot = N_VNew_Serial(nx_+nz_);

    // Initialize Idas
    double t0 = 0;
    N_VConst(0.0, m->xz);
    N_VConst(0.0, m->xzdot);
    IDAInit(m->mem, res, t0, m->xz, m->xzdot);
    log("IdasInterface::init", "IDA initialized");

    // Include algebraic variables in error testing
    THROWING(IDASetSuppressAlg, m->mem, suppress_algebraic_);

    // Maxinum order for the multistep method
    THROWING(IDASetMaxOrd, m->mem, max_multistep_order_);

    // Set maximum step size
    THROWING(IDASetMaxStep, m->mem, max_step_size_);

    // Initial step size
    if (step0_) THROWING(IDASetInitStep, m->mem, step0_);

    // Maximum order of method
    if (max_order_) THROWING(IDASetMaxOrd, m->mem, max_order_);

    // Coeff. in the nonlinear convergence test
    if (nonlin_conv_coeff_) THROWING(IDASetNonlinConvCoef, m->mem, nonlin_conv_coeff_);

    if (!abstolv_.empty()) {
      // Vector absolute tolerances
      N_Vector nv_abstol = N_VNew_Serial(abstolv_.size());
      copy(abstolv_.begin(), abstolv_.end(), NV_DATA_S(nv_abstol));
      THROWING(IDASVtolerances, m->mem, reltol_, nv_abstol);
      N_VDestroy_Serial(nv_abstol);
    } else {
      // Scalar absolute tolerances
      THROWING(IDASStolerances, m->mem, reltol_, abstol_);
    }

    // Maximum number of steps
    THROWING(IDASetMaxNumSteps, m->mem, max_num_steps_);

    // Set algebraic components
    N_Vector id = N_VNew_Serial(nx_+nz_);
    fill_n(NV_DATA_S(id), nx_, 1);
    fill_n(NV_DATA_S(id)+nx_, nz_, 0);

    // Pass this information to IDAS
    THROWING(IDASetId, m->mem, id);

    // Delete the allocated memory
    N_VDestroy_Serial(id);

    // attach a linear solver
    if (newton_scheme_==SD_DIRECT) {
      // Direct scheme
      IDAMem IDA_mem = IDAMem(m->mem);
      IDA_mem->ida_lmem   = m;
      IDA_mem->ida_lsetup = lsetup;
      IDA_mem->ida_lsolve = lsolve;
      IDA_mem->ida_setupNonNull = TRUE;
    } else {
      // Iterative scheme
      switch (newton_scheme_) {
      case SD_DIRECT: casadi_assert(0);
      case SD_GMRES: THROWING(IDASpgmr, m->mem, max_krylov_); break;
      case SD_BCGSTAB: THROWING(IDASpbcg, m->mem, max_krylov_); break;
      case SD_TFQMR: THROWING(IDASptfqmr, m->mem, max_krylov_); break;
      }
      THROWING(IDASpilsSetJacTimesVecFn, m->mem, jtimes);
      if (use_precon_) THROWING(IDASpilsSetPreconditioner, m->mem, psetup, psolve);
    }

    // Quadrature equations
    if (nq_>0) {

      // Initialize quadratures in IDAS
      THROWING(IDAQuadInit, m->mem, rhsQ, m->q);

      // Should the quadrature errors be used for step size control?
      if (quad_err_con_) {
        THROWING(IDASetQuadErrCon, m->mem, true);

        // Quadrature error tolerances
        // TODO(Joel): vector absolute tolerances
        THROWING(IDAQuadSStolerances, m->mem, reltol_, abstol_);
      }
    }

    log("IdasInterface::init", "attached linear solver");

    // Adjoint sensitivity problem
    if (nrx_>0) {
      m->rxzdot = N_VNew_Serial(nrx_+nrz_);
      N_VConst(0.0, m->rxz);
      N_VConst(0.0, m->rxzdot);
    }
    log("IdasInterface::init", "initialized adjoint sensitivities");

    // Initialize adjoint sensitivities
    if (nrx_>0) {
      int interpType = interp_==SD_HERMITE ? IDA_HERMITE : IDA_POLYNOMIAL;
      THROWING(IDAAdjInit, m->mem, steps_per_checkpoint_, interpType);
    }

    m->first_callB = true;
  }
コード例 #5
0
ファイル: idaHeat2D_klu.c プロジェクト: luca-heltai/sundials
int main(void)
{
  void *mem;
  UserData data;
  N_Vector uu, up, constraints, id, res;  /* uu is u, up is du/dt */
  int ier, iout;
  long int netf, ncfn;
  realtype rtol, atol, t0, t1, tout, tret;

  int nnz; /* number of non-zeroes  */
  
  mem = NULL;
  data = NULL;
  uu = up = constraints = id = res = NULL;

  /* Create vectors uu, up, res, constraints, id. */
  uu = N_VNew_Serial(NEQ);
  if(check_flag((void *)uu, "N_VNew_Serial", 0)) return(1);
  up = N_VNew_Serial(NEQ);
  if(check_flag((void *)up, "N_VNew_Serial", 0)) return(1);
  res = N_VNew_Serial(NEQ);
  if(check_flag((void *)res, "N_VNew_Serial", 0)) return(1);
  constraints = N_VNew_Serial(NEQ);
  if(check_flag((void *)constraints, "N_VNew_Serial", 0)) return(1);
  id = N_VNew_Serial(NEQ); /* differentiate between algebraic and differential */
  if(check_flag((void *)id, "N_VNew_Serial", 0)) return(1);

  /* Create and load problem data block. */
  data = (UserData) malloc(sizeof *data);
  if(check_flag((void *)data, "malloc", 2)) return(1);
  data->mm = MGRID;
  data->dx = ONE/(MGRID - ONE);
  data->coeff = ONE/( (data->dx) * (data->dx) );

  /* Initialize uu, up, id. */
  SetInitialProfile(data, uu, up, id, res);

  /* Set constraints to all 1's for nonnegative solution values. */
  N_VConst(ONE, constraints);

  /* Set remaining input parameters. */
  t0   = ZERO;
  t1   = RCONST(0.01);
  rtol = ZERO;
  atol = RCONST(1.0e-8);

  /* 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);

  /* Sets up which components are algebraic or differential */
  ier = IDASetId(mem, id); 
  if(check_flag(&ier, "IDASetId", 1)) return(1);

  ier = IDASetConstraints(mem, constraints);
  if(check_flag(&ier, "IDASetConstraints", 1)) return(1);
  N_VDestroy_Serial(constraints);

  ier = IDAInit(mem, heatres, t0, uu, up);
  if(check_flag(&ier, "IDAInit", 1)) return(1);

  ier = IDASStolerances(mem, rtol, atol);
  if(check_flag(&ier, "IDASStolerances", 1)) return(1);

  /* Call IDAKLU and set up the linear solver  */
  nnz = NEQ*NEQ;
  ier = IDAKLU(mem, NEQ, nnz, CSC_MAT);
  if(check_flag(&ier, "IDAKLU", 1)) return(1);
  /* check size of Jacobian matrix  */
  if(MGRID >= 4){
    ier = IDASlsSetSparseJacFn(mem, jacHeat);
  }
  /* special case MGRID=3  */
  else if(MGRID==3){
    ier = IDASlsSetSparseJacFn(mem, jacHeat3);
  }
  /* MGRID<=2 is pure boundary points, nothing to solve  */
  else{
    printf("MGRID size is too small to run.\n");
    return(1);
  }
  if(check_flag(&ier, "IDASlsSetSparseJacFn", 1)) return(1);

  /* Call IDACalcIC to correct the initial values. */
  ier = IDACalcIC(mem, IDA_YA_YDP_INIT, t1);
  if(check_flag(&ier, "IDACalcIC", 1)) return(1);

  /* Print output heading. */
  PrintHeader(rtol, atol);
  
  PrintOutput(mem, t0, uu);


  /* Loop over output times, call IDASolve, and print results. */
  
  for (tout = t1, iout = 1; iout <= NOUT; iout++, tout *= TWO) {
    
    ier = IDASolve(mem, tout, &tret, uu, up, IDA_NORMAL);
    if(check_flag(&ier, "IDASolve", 1)) return(1);

    PrintOutput(mem, tret, uu);
  
  }
  
  /* Print remaining counters and free memory. */
  ier = IDAGetNumErrTestFails(mem, &netf);
  check_flag(&ier, "IDAGetNumErrTestFails", 1);
  ier = IDAGetNumNonlinSolvConvFails(mem, &ncfn);
  check_flag(&ier, "IDAGetNumNonlinSolvConvFails", 1);
  printf("\n netf = %ld,   ncfn = %ld \n", netf, ncfn);

  IDAFree(&mem);
  N_VDestroy_Serial(uu);
  N_VDestroy_Serial(up);
  N_VDestroy_Serial(id);
  N_VDestroy_Serial(res);
  free(data);

  return(0);
}
コード例 #6
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);

}
コード例 #7
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));
    }
}
コード例 #8
0
ファイル: idaRoberts_sps.c プロジェクト: drhansj/polymec-dev
int main(void)
{
  void *mem;
  N_Vector yy, yp, avtol;
  realtype rtol, *yval, *ypval, *atval;
  realtype t0, tout1, tout, tret;
  int iout, retval, retvalr;
  int rootsfound[2];

  int nnz;

  mem = NULL;
  yy = yp = avtol = NULL;
  yval = ypval = atval = NULL;

  /* Allocate N-vectors. */
  yy = N_VNew_Serial(NEQ);
  if(check_flag((void *)yy, "N_VNew_Serial", 0)) return(1);
  yp = N_VNew_Serial(NEQ);
  if(check_flag((void *)yp, "N_VNew_Serial", 0)) return(1);
  avtol = N_VNew_Serial(NEQ);
  if(check_flag((void *)avtol, "N_VNew_Serial", 0)) return(1);

  /* Create and initialize  y, y', and absolute tolerance vectors. */
  yval  = NV_DATA_S(yy);
  yval[0] = ONE;
  yval[1] = ZERO;
  yval[2] = ZERO;

  ypval = NV_DATA_S(yp);
  ypval[0]  = RCONST(-0.04);
  ypval[1]  = RCONST(0.04);
  ypval[2]  = ZERO;  

  rtol = RCONST(1.0e-4);

  atval = NV_DATA_S(avtol);
  atval[0] = RCONST(1.0e-8);
  atval[1] = RCONST(1.0e-6);
  atval[2] = RCONST(1.0e-6);

  /* Integration limits */
  t0 = ZERO;
  tout1 = RCONST(0.4);

  PrintHeader(rtol, avtol, yy);

  /* Call IDACreate and IDAMalloc to initialize IDA memory */
  mem = IDACreate();
  if(check_flag((void *)mem, "IDACreate", 0)) return(1);
  retval = IDAInit(mem, resrob, t0, yy, yp);
  if(check_flag(&retval, "IDAInit", 1)) return(1);
  retval = IDASVtolerances(mem, rtol, avtol);
  if(check_flag(&retval, "IDASVtolerances", 1)) return(1);

  /* Free avtol */
  N_VDestroy_Serial(avtol);

  /* Call IDARootInit to specify the root function grob with 2 components */
  retval = IDARootInit(mem, 2, grob);
  if (check_flag(&retval, "IDARootInit", 1)) return(1);

  /* Call IDASuperLUMT and set up the linear solver. */
  nnz = NEQ * NEQ;
  retval = IDASuperLUMT(mem, 1, NEQ, nnz);
  if(check_flag(&retval, "IDASuperLUMT", 1)) return(1);
  retval = IDASlsSetSparseJacFn(mem, jacrob);
  if(check_flag(&retval, "IDASlsSetSparseJacFn", 1)) return(1);

  /* In loop, call IDASolve, print results, and test for error.
     Break out of loop when NOUT preset output times have been reached. */

  iout = 0; tout = tout1;
  while(1) {

    retval = IDASolve(mem, tout, &tret, yy, yp, IDA_NORMAL);

    PrintOutput(mem,tret,yy);

    if(check_flag(&retval, "IDASolve", 1)) return(1);

    if (retval == IDA_ROOT_RETURN) {
      retvalr = IDAGetRootInfo(mem, rootsfound);
      check_flag(&retvalr, "IDAGetRootInfo", 1);
      PrintRootInfo(rootsfound[0],rootsfound[1]);
    }

    if (retval == IDA_SUCCESS) {
      iout++;
      tout *= RCONST(10.0);
    }

    if (iout == NOUT) break;
  }

  PrintFinalStats(mem);

  /* Free memory */

  IDAFree(&mem);
  N_VDestroy_Serial(yy);
  N_VDestroy_Serial(yp);

  return(0);
  
}
コード例 #9
0
ファイル: daeSolver.c プロジェクト: raim/SBML_odeSolver
/* creates CVODES structures and fills cvodeSolver 
   return 1 => success
   return 0 => failure
*/
int
IntegratorInstance_createIDASolverStructures(integratorInstance_t *engine)
{
  int i, flag, neq, nalg;
  realtype *ydata, *abstoldata, *dydata;
  
  odeModel_t *om = engine->om;
  cvodeData_t *data = engine->data;
  cvodeSolver_t *solver = engine->solver;
  cvodeSettings_t *opt = engine->opt;
  
  neq = engine->om->neq;   /* number of ODEs */
  nalg = engine->om->nalg; /* number of algebraic constraints */
  
  /* construct jacobian, if wanted and not yet existing */
  if ( opt->UseJacobian && om->jacob == NULL ) 
    /* reset UseJacobian option, depending on success */
    engine->UseJacobian = ODEModel_constructJacobian(om);
  else if ( !opt->UseJacobian )
  {
    /* free jacobian from former runs (not necessary, frees also
       unsuccessful jacobians from former runs ) */
    ODEModel_freeJacobian(om);
    SolverError_error(WARNING_ERROR_TYPE,
		      SOLVER_ERROR_MODEL_NOT_SIMPLIFIED,
		      "Jacobian matrix construction skipped.");
    engine->UseJacobian = om->jacobian;
  }
  /* construct algebraic `Jacobian' (or do that in constructJacobian */
  
  /* CVODESolverStructures from former runs must be freed */
  if ( engine->run > 1 )
    IntegratorInstance_freeIDASolverStructures(engine);
  
  
    /*
     * Allocate y, abstol vectors
     */
  solver->y = N_VNew_Serial(neq + nalg);
  CVODE_HANDLE_ERROR((void *)solver->y, "N_VNew_Serial for vector y", 0);
  
  solver->dy = N_VNew_Serial(neq + nalg);
  CVODE_HANDLE_ERROR((void *)solver->dy, "N_VNew_Serial for vector dy", 0);
    
  solver->abstol = N_VNew_Serial(neq + nalg);
  CVODE_HANDLE_ERROR((void *)solver->abstol,
		     "N_VNew_Serial for vector abstol", 0);
  
  /*
   * Initialize y, abstol vectors
   */
  ydata      = NV_DATA_S(solver->y);
  abstoldata = NV_DATA_S(solver->abstol);
  dydata     = NV_DATA_S(solver->dy);
  
  for ( i=0; i<neq; i++ )
  {
    /* Set initial value vector components of y and y' */
    ydata[i] = data->value[i];
    /* Set absolute tolerance vector components,
       currently the same absolute error is used for all y */ 
    abstoldata[i] = opt->Error;
    dydata[i] = evaluateAST(om->ode[i], data);
  }
  /* set initial value vector components for algebraic rule variables  */
    
  /* scalar relative tolerance: the same for all y */
  solver->reltol = opt->RError;

  /*
   * Call IDACreate to create the solver memory:
   *
   */
  solver->cvode_mem = IDACreate();
  CVODE_HANDLE_ERROR((void *)(solver->cvode_mem), "IDACreate", 0);

  /*
   * Call IDAInit to initialize the integrator memory:
   *
   * cvode_mem  pointer to the CVode memory block returned by CVodeCreate
   * fRes         user's right hand side function
   * t0         initial value of time
   * y          the dependent variable vector
   * dy         the ODE value vector
   */
  flag = IDAInit(solver->cvode_mem, fRes, solver->t0, solver->y,
                 solver->dy);
  CVODE_HANDLE_ERROR(&flag, "IDAInit", 1);
  /*
   * specify scalar relative and vector absolute tolerances
   * reltol     the scalar relative tolerance
   * abstol     pointer to the absolute tolerance vector
   */
  flag = IDASVtolerances(solver->cvode_mem, solver->reltol, solver->abstol);
  CVODE_HANDLE_ERROR(&flag, "IDASVtolerances", 1);

  /* 
   * Link the main integrator with data for right-hand side function
   */ 
  flag = IDASetUserData(solver->cvode_mem, engine->data);
  CVODE_HANDLE_ERROR(&flag, "IDASetUserData", 1);
    
  /*
   * Link the main integrator with the IDADENSE linear solver
   */
  flag = IDADense(solver->cvode_mem, neq);
  CVODE_HANDLE_ERROR(&flag, "IDADense", 1);


  /*
   * Set the routine used by the IDADense linear solver
   * to approximate the Jacobian matrix to ...
   */
  if ( opt->UseJacobian == 1 ) {
    /* ... user-supplied routine JacRes : put JacRes instead of NULL
       when working */
    flag = IDADlsSetDenseJacFn(solver->cvode_mem, JacRes);
    CVODE_HANDLE_ERROR(&flag, "IDADlsSetDenseJacFn", 1);
  }
     
  return 1; /* OK */
}
コード例 #10
0
int main(void)
{
  UserData data;

  void *mem;
  N_Vector yy, yp, id, q;
  realtype tret, tout;
  int flag;

  id = N_VNew_Serial(NEQ);
  yy = N_VNew_Serial(NEQ);
  yp = N_VNew_Serial(NEQ);
  q = N_VNew_Serial(1);

  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;
  
  /* Consistent IC*/
  setIC(yy, yp, data);

  /* IDAS 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);

  N_VConst(ZERO, q);
  flag = IDAQuadInit(mem, rhsQ, q);
  flag = IDAQuadSStolerances(mem, RTOLQ, ATOLQ);
  flag = IDASetQuadErrCon(mem, TRUE);

  PrintHeader(RTOLF, ATOLF, yy);

  /* Print initial states */
  PrintOutput(mem,0.0,yy);

  /* Perform forward run */
  tout = TEND/NOUT;

  while (1) {

    flag = IDASolve(mem, tout, &tret, yy, yp, IDA_NORMAL);
    if (check_flag(&flag, "IDASolve", 1)) return(1);

    PrintOutput(mem,tret,yy);

    tout += TEND/NOUT;
    
    if (tret > TEND) break;
  }
  
  PrintFinalStats(mem);

  IDAGetQuad(mem, &tret, q);
  printf("--------------------------------------------\n");
  printf("  G = %24.16f\n", Ith(q,1));
  printf("--------------------------------------------\n\n");
  
  IDAFree(&mem);

  /* Free memory */

  free(data);
  N_VDestroy(id);
  N_VDestroy_Serial(yy);
  N_VDestroy_Serial(yp);
  N_VDestroy_Serial(q);

  return(0);  
}
コード例 #11
0
int main(int argc, char *argv[])
{ 
  void *ida_mem;
  SUNMatrix A;
  SUNLinearSolver LS;
  UserData webdata;
  N_Vector cc, cp, id;
  int iout, retval;
  sunindextype mu, ml;
  realtype rtol, atol, t0, tout, tret;
  int num_threads;

  ida_mem = NULL;
  A = NULL;
  LS = NULL;
  webdata = NULL;
  cc = cp = id = NULL;

  /* Set the number of threads to use */
  num_threads = 1;       /* default value */
#ifdef _OPENMP
  num_threads = omp_get_max_threads();  /* overwrite with OMP_NUM_THREADS enviroment variable */
#endif
  if (argc > 1)      /* overwrite with command line value, if supplied */
    num_threads = strtol(argv[1], NULL, 0);

  /* Allocate and initialize user data block webdata. */

  webdata = (UserData) malloc(sizeof *webdata);
  webdata->rates = N_VNew_OpenMP(NEQ, num_threads);
  webdata->acoef = newDenseMat(NUM_SPECIES, NUM_SPECIES);
  webdata->nthreads = num_threads;

  InitUserData(webdata);

  /* Allocate N-vectors and initialize cc, cp, and id. */

  cc  = N_VNew_OpenMP(NEQ, num_threads);
  if(check_retval((void *)cc, "N_VNew_OpenMP", 0)) return(1);

  cp  = N_VNew_OpenMP(NEQ, num_threads);
  if(check_retval((void *)cp, "N_VNew_OpenMP", 0)) return(1);

  id  = N_VNew_OpenMP(NEQ, num_threads);
  if(check_retval((void *)id, "N_VNew_OpenMP", 0)) return(1);
  
  SetInitialProfiles(cc, cp, id, webdata);
  
  /* Set remaining inputs to IDAMalloc. */
  
  t0 = ZERO;
  rtol = RTOL; 
  atol = ATOL;

  /* Call IDACreate and IDAMalloc to initialize IDA. */
  
  ida_mem = IDACreate();
  if(check_retval((void *)ida_mem, "IDACreate", 0)) return(1);

  retval = IDASetUserData(ida_mem, webdata);
  if(check_retval(&retval, "IDASetUserData", 1)) return(1);

  retval = IDASetId(ida_mem, id);
  if(check_retval(&retval, "IDASetId", 1)) return(1);

  retval = IDAInit(ida_mem, resweb, t0, cc, cp);
  if(check_retval(&retval, "IDAInit", 1)) return(1);

  retval = IDASStolerances(ida_mem, rtol, atol);
  if(check_retval(&retval, "IDASStolerances", 1)) return(1);

  /* Setup band matrix and linear solver, and attach to IDA. */

  mu = ml = NSMX;
  A = SUNBandMatrix(NEQ, mu, ml);
  if(check_retval((void *)A, "SUNBandMatrix", 0)) return(1);
  LS = SUNLinSol_Band(cc, A);
  if(check_retval((void *)LS, "SUNLinSol_Band", 0)) return(1);
  retval = IDASetLinearSolver(ida_mem, LS, A);
  if(check_retval(&retval, "IDASetLinearSolver", 1)) return(1);

  /* Call IDACalcIC (with default options) to correct the initial values. */

  tout = RCONST(0.001);
  retval = IDACalcIC(ida_mem, IDA_YA_YDP_INIT, tout);
  if(check_retval(&retval, "IDACalcIC", 1)) return(1);
  
  /* Print heading, basic parameters, and initial values. */

  PrintHeader(mu, ml, rtol, atol);
  PrintOutput(ida_mem, cc, ZERO);
  
  /* Loop over iout, call IDASolve (normal mode), print selected output. */
  
  for (iout = 1; iout <= NOUT; iout++) {
    
    retval = IDASolve(ida_mem, tout, &tret, cc, cp, IDA_NORMAL);
    if(check_retval(&retval, "IDASolve", 1)) return(retval);
    
    PrintOutput(ida_mem, cc, tret);
    
    if (iout < 3) tout *= TMULT; else tout += TADD;
    
  }
  
  /* Print final statistics and free memory. */  
  
  PrintFinalStats(ida_mem);
  printf("num_threads = %i\n\n", num_threads);

  /* Free memory */

  IDAFree(&ida_mem);
  SUNLinSolFree(LS);
  SUNMatDestroy(A);

  N_VDestroy_OpenMP(cc);
  N_VDestroy_OpenMP(cp);
  N_VDestroy_OpenMP(id);


  destroyMat(webdata->acoef);
  N_VDestroy_OpenMP(webdata->rates);
  free(webdata);

  return(0);
}
コード例 #12
0
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);
  
}
コード例 #13
0
void SundialsIda::initialize()
{
    sundialsMem = IDACreate();
    if (check_flag((void *)sundialsMem, "IDACreate", 0)) {
        throw DebugException("SundialsIda::initialize: error in IDACreate");
    }

    IDASetUserData(sundialsMem, theDAE);

    int flag;
    if (calcIC)    {
        // Pick an appropriate initial condition for ydot and algebraic components of y
        flag = IDASetId(sundialsMem, componentId.forSundials());
    }

    flag = IDAInit(sundialsMem, f, t0, y.forSundials(), ydot.forSundials());
    if (check_flag(&flag, "IDAMalloc", 1)) {
        throw DebugException("SundialsIda::initialize: error in IDAInit");
    }

    IDASVtolerances(sundialsMem, reltol, abstol.forSundials());

    if (findRoots) {
        rootsFound.resize(nRoots);
        // Call IDARootInit to specify the root function g with nRoots components
        flag = IDARootInit(sundialsMem, nRoots, g);
        if (check_flag(&flag, "IDARootInit", 1)) {
            throw DebugException("SundialsIda::initialize: error in IDARootInit");
        }
    }

    // Call IDASpbcg to specify the IDASpbcg dense linear solver
    flag = IDASpbcg(sundialsMem, 0);
    if (check_flag(&flag, "IDASpbcg", 1)) {
        throw DebugException("SundialsIda::initialize: error in IDASpbcg");
    }

    if (imposeConstraints) {
        flag = IDASetConstraints(sundialsMem, constraints.forSundials());
        if (check_flag(&flag, "IDASetConstraints", 1)) {
            throw DebugException("SundialsIda::initialize: error in IDASetConstraints");
        }
    }

    // this seems to work better using the default J-v function rather than specifying our own...
    //flag = IDASpilsSetJacTimesVecFn(sundialsMem, JvProd, theDAE);
    //if (check_flag(&flag, "IDASpilsSetJacTimesVecFn", 1)) {
    //    throw myException("SundialsIda::initialize: error in IDASpilsSetJacTimesVecFn");
    //}

    flag = IDASpilsSetPreconditioner(sundialsMem, preconditionerSetup, preconditionerSolve);
    if (check_flag(&flag, "IDASpilsSetPreconditioner", 1)) {
        throw DebugException("SundialsIda::initialize: error in IDASpilsSetPreconditioner");
    }

    if (calcIC) {
        flag = IDACalcIC(sundialsMem, IDA_YA_YDP_INIT, t0+1e-4);
        if (check_flag(&flag, "IDACalcIC", 1)) {
            logFile.write("IDACalcIC Error");
            throw DebugException("SundialsIda::initialize: error in IDACalcIC");
        }

        flag = IDAGetConsistentIC(sundialsMem, y0.forSundials(), ydot0.forSundials());
        if (check_flag(&flag, "IDAGetConsistentIC", 1)) {
            throw DebugException("SundialsIda::initialize: error in IDAGetConsistentIC");
        }
    }

}
コード例 #14
0
ファイル: idaFoodWeb_bnd.c プロジェクト: drhansj/polymec-dev
int main()
{ 
  void *mem;
  UserData webdata;
  N_Vector cc, cp, id;
  int iout, retval;
  long int mu, ml;
  realtype rtol, atol, t0, tout, tret;

  mem = NULL;
  webdata = NULL;
  cc = cp = id = NULL;

  /* Allocate and initialize user data block webdata. */

  webdata = (UserData) malloc(sizeof *webdata);
  webdata->rates = N_VNew_Serial(NEQ);
  webdata->acoef = newDenseMat(NUM_SPECIES, NUM_SPECIES);

  InitUserData(webdata);

  /* Allocate N-vectors and initialize cc, cp, and id. */

  cc  = N_VNew_Serial(NEQ);
  if(check_flag((void *)cc, "N_VNew_Serial", 0)) return(1);

  cp  = N_VNew_Serial(NEQ);
  if(check_flag((void *)cp, "N_VNew_Serial", 0)) return(1);

  id  = N_VNew_Serial(NEQ);
  if(check_flag((void *)id, "N_VNew_Serial", 0)) return(1);
  
  SetInitialProfiles(cc, cp, id, webdata);
  
  /* Set remaining inputs to IDAMalloc. */
  
  t0 = ZERO;
  rtol = RTOL; 
  atol = ATOL;

  /* Call IDACreate and IDAMalloc to initialize IDA. */
  
  mem = IDACreate();
  if(check_flag((void *)mem, "IDACreate", 0)) return(1);

  retval = IDASetUserData(mem, webdata);
  if(check_flag(&retval, "IDASetUserData", 1)) return(1);

  retval = IDASetId(mem, id);
  if(check_flag(&retval, "IDASetId", 1)) return(1);

  retval = IDAInit(mem, resweb, t0, cc, cp);
  if(check_flag(&retval, "IDAInit", 1)) return(1);

  retval = IDASStolerances(mem, rtol, atol);
  if(check_flag(&retval, "IDASStolerances", 1)) return(1);

  /* Call IDABand to specify the IDA linear solver. */

  mu = ml = NSMX;
  retval = IDABand(mem, NEQ, mu, ml);
  if(check_flag(&retval, "IDABand", 1)) return(1);

  /* Call IDACalcIC (with default options) to correct the initial values. */

  tout = RCONST(0.001);
  retval = IDACalcIC(mem, IDA_YA_YDP_INIT, tout);
  if(check_flag(&retval, "IDACalcIC", 1)) return(1);
  
  /* Print heading, basic parameters, and initial values. */

  PrintHeader(mu, ml, rtol, atol);
  PrintOutput(mem, cc, ZERO);
  
  /* Loop over iout, call IDASolve (normal mode), print selected output. */
  
  for (iout = 1; iout <= NOUT; iout++) {
    
    retval = IDASolve(mem, tout, &tret, cc, cp, IDA_NORMAL);
    if(check_flag(&retval, "IDASolve", 1)) return(retval);
    
    PrintOutput(mem, cc, tret);
    
    if (iout < 3) tout *= TMULT; else tout += TADD;
    
  }
  
  /* Print final statistics and free memory. */  
  
  PrintFinalStats(mem);

  /* Free memory */

  IDAFree(&mem);

  N_VDestroy_Serial(cc);
  N_VDestroy_Serial(cp);
  N_VDestroy_Serial(id);


  destroyMat(webdata->acoef);
  N_VDestroy_Serial(webdata->rates);
  free(webdata);

  return(0);
}
コード例 #15
0
ファイル: IDA.cpp プロジェクト: mflehmig/OMCompiler
void Ida::initialize()
{
  _properties = dynamic_cast<ISystemProperties*>(_system);
  _continuous_system = dynamic_cast<IContinuous*>(_system);
  _event_system = dynamic_cast<IEvent*>(_system);
  _mixed_system = dynamic_cast<IMixedSystem*>(_system);
  _time_system = dynamic_cast<ITime*>(_system);
  IGlobalSettings* global_settings = dynamic_cast<ISolverSettings*>(_idasettings)->getGlobalSettings();
  // Kennzeichnung, dass initialize()() (vor der Integration) aufgerufen wurde
  _idid = 5000;
  _tLastEvent = 0.0;
  _event_n = 0;
  SolverDefaultImplementation::initialize();

  _dimStates = _continuous_system->getDimContinuousStates();
  _dimZeroFunc = _event_system->getDimZeroFunc()+_event_system->getDimClock();
  _dimAE = _continuous_system->getDimAE();
   if(_dimAE>0)
		_dimSys=_dimAE+ _dimStates;
	else
		_dimSys=_dimStates;
  if (_dimStates <= 0)

  {
    _idid = -1;
    throw std::invalid_argument("Ida::initialize()");
  }
  else
  {
    // Allocate state vectors, stages and temporary arrays

   /*if (_z)
      delete[] _z;
    if (_zInit)
      delete[] _zInit;
    if (_zWrite)
      delete[] _zWrite;*/
    if (_y)
      delete[] _y;
    if (_yInit)
      delete[] _yInit;
    if (_yWrite)
      delete[] _yWrite;
    if (_ypWrite)
      delete[] _ypWrite;
    if (_yp)
      delete[] _yp;
    if (_dae_res)
      delete[] _dae_res;
    if (_zeroSign)
      delete[] _zeroSign;
    if (_absTol)
      delete[] _absTol;
    if(_delta)
      delete [] _delta;
    if(_deltaInv)
      delete [] _deltaInv;
    if(_ysave)
      delete [] _ysave;


	_y = new double[_dimSys];
	_yp = new double[_dimSys];
    _yInit = new double[_dimSys];
    _yWrite = new double[_dimSys];
	_ypWrite = new double[_dimSys];
	_dae_res = new double[_dimSys];
	/*
	_z = new double[_dimSys];
    _zInit = new double[_dimSys];
    _zWrite = new double[_dimSys];
	*/

    _zeroSign = new int[_dimZeroFunc];
    _absTol = new double[_dimSys];
    _delta =new double[_dimSys];
    _deltaInv =new double[_dimSys];
    _ysave =new double[_dimSys];

    memset(_y, 0, _dimSys * sizeof(double));
	memset(_yp, 0, _dimSys * sizeof(double));
    memset(_yInit, 0, _dimSys * sizeof(double));
    memset(_ysave, 0, _dimSys * sizeof(double));
	 std::fill_n(_absTol, _dimSys, 1.0);
    // Counter initialisieren
    _outStps = 0;

    if (_idasettings->getDenseOutput())
    {
      // Ausgabeschrittweite
      _hOut = global_settings->gethOutput();

    }

    // Allocate memory for the solver
    _idaMem = IDACreate();
    if (check_flag((void*) _idaMem, "IDACreate", 0))
    {
      _idid = -5;
      throw std::invalid_argument(/*_idid,_tCurrent,*/"Ida::initialize()");
    }

    //
    // Make Ida ready for integration
    //

    // Set initial values for IDA
    //_continuous_system->evaluateAll(IContinuous::CONTINUOUS);
   _continuous_system->getContinuousStates(_yInit);
    memcpy(_y, _yInit, _dimStates * sizeof(double));
    if(_dimAE>0)
	{
       _mixed_system->getAlgebraicDAEVars(_yInit+_dimStates);
	    memcpy(_y+_dimStates, _yInit+_dimStates, _dimAE * sizeof(double));
	  _continuous_system->getContinuousStates(_yp);
	}
    // Get nominal values
	 _continuous_system->getNominalStates(_absTol);
    for (int i = 0; i < _dimStates; i++)
	    _absTol[i] = dynamic_cast<ISolverSettings*>(_idasettings)->getATol();

    _CV_y0 = N_VMake_Serial(_dimSys, _yInit);
    _CV_y = N_VMake_Serial(_dimSys, _y);
    _CV_yp = N_VMake_Serial(_dimSys, _yp);
    _CV_yWrite = N_VMake_Serial(_dimSys, _yWrite);
	_CV_ypWrite = N_VMake_Serial(_dimSys, _ypWrite);
    _CV_absTol = N_VMake_Serial(_dimSys, _absTol);

    if (check_flag((void*) _CV_y0, "N_VMake_Serial", 0))
    {
      _idid = -5;
      throw std::invalid_argument("Ida::initialize()");
    }

	//is already initialized: calcFunction(_tCurrent, NV_DATA_S(_CV_y0), NV_DATA_S(_CV_yp),NV_DATA_S(_CV_yp));

    // Initialize Ida (Initial values are required)
    _idid = IDAInit(_idaMem, rhsFunctionCB, _tCurrent, _CV_y0, _CV_yp);
    if (_idid < 0)
    {
      _idid = -5;
      throw std::invalid_argument("Ida::initialize()");
    }
	_idid = IDASetErrHandlerFn(_idaMem, errOutputIDA, _data);
	 if (_idid < 0)
      throw std::invalid_argument("IDA::initialize()");
    // Set Tolerances
    _idid = IDASVtolerances(_idaMem, dynamic_cast<ISolverSettings*>(_idasettings)->getRTol(), _CV_absTol);    // RTOL and ATOL
    if (_idid < 0)
      throw std::invalid_argument("IDA::initialize()");

    // Set the pointer to user-defined data
    _idid = IDASetUserData(_idaMem, _data);
    if (_idid < 0)
      throw std::invalid_argument("IDA::initialize()");

    _idid = IDASetInitStep(_idaMem, 1e-6);    // INITIAL STEPSIZE
    if (_idid < 0)
      throw std::invalid_argument("Ida::initialize()");


    _idid = IDASetMaxStep(_idaMem, global_settings->getEndTime() / 10.0);       // MAXIMUM STEPSIZE
    if (_idid < 0)
      throw std::invalid_argument("IDA::initialize()");

    _idid = IDASetMaxNonlinIters(_idaMem, 5);      // Max number of iterations
    if (_idid < 0)
      throw std::invalid_argument("IDA::initialize()");
    _idid = IDASetMaxErrTestFails(_idaMem, 100);
    if (_idid < 0)
      throw std::invalid_argument("IDA::initialize()");

    _idid = IDASetMaxNumSteps(_idaMem, 1e3);            // Max Number of steps
    if (_idid < 0)
      throw std::invalid_argument(/*_idid,_tCurrent,*/"IDA::initialize()");

    // Initialize linear solver
    _idid = IDADense(_idaMem, _dimSys);
    if (_idid < 0)
      throw std::invalid_argument("IDA::initialize()");
    if(_dimAE>0)
	{
	    _idid = IDASetSuppressAlg(_idaMem, TRUE);
        double* tmp = new double[_dimSys];
	    std::fill_n(tmp, _dimStates, 1.0);
	    std::fill_n(tmp+_dimStates, _dimAE, 0.0);
	   _idid = IDASetId(_idaMem, N_VMake_Serial(_dimSys,tmp));
	    delete [] tmp;
	    if (_idid < 0)
         throw std::invalid_argument("IDA::initialize()");
	}

  // Use own jacobian matrix
  //_idid = CVDlsSetDenseJacFn(_idaMem, &jacobianFunctionCB);
  //if (_idid < 0)
  //    throw std::invalid_argument("IDA::initialize()");

    if (_dimZeroFunc)
    {
      _idid = IDARootInit(_idaMem, _dimZeroFunc, &zeroFunctionCB);

      memset(_zeroSign, 0, _dimZeroFunc * sizeof(int));
      _idid = IDASetRootDirection(_idaMem, _zeroSign);
      if (_idid < 0)
        throw std::invalid_argument(/*_idid,_tCurrent,*/"IDA::initialize()");
      memset(_zeroSign, -1, _dimZeroFunc * sizeof(int));
      memset(_zeroVal, -1, _dimZeroFunc * sizeof(int));

    }


    _ida_initialized = true;

    //
    // IDA is ready for integration
    //
    // BOOST_LOG_SEV(ida_lg::get(), ida_info) << "IDA initialized";
  }
}
コード例 #16
0
ファイル: idaSlCrank_dns.c プロジェクト: drhansj/polymec-dev
int main(void)
{
  UserData data;

  void *mem;
  N_Vector yy, yp, id;
  realtype rtol, atol;
  realtype t0, tf, tout, dt, tret;
  int flag, iout;

  /* User data */

  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->J2 = 2.0;  /* moment of inertia of connecting rod */
  data->k = 1.0;   /* spring constant */
  data->c = 1.0;   /* damper constant */
  data->l0 = 1.0;  /* spring free length */
  data->F = 1.0;   /* external constant force */

  /* Create N_Vectors */
  yy = N_VNew_Serial(NEQ);
  yp = N_VNew_Serial(NEQ);
  id = N_VNew_Serial(NEQ);

  /* Consistent IC */
  setIC(yy, yp, data);

  /* ID array */
  N_VConst(ONE, id);
  NV_Ith_S(id,6) = ZERO;
  NV_Ith_S(id,7) = ZERO;
  NV_Ith_S(id,8) = ZERO;
  NV_Ith_S(id,9) = ZERO;

  /* Tolerances */
  rtol = RCONST(1.0e-6);
  atol = RCONST(1.0e-6);

  /* Integration limits */
  t0 = ZERO;
  tf = TEND;
  dt = (tf-t0)/(NOUT-1);

  /* IDA initialization */
  mem = IDACreate();
  flag = IDAInit(mem, ressc, t0, yy, yp);
  flag = IDASStolerances(mem, rtol, atol);
  flag = IDASetUserData(mem, data);
  flag = IDASetId(mem, id);
  flag = IDASetSuppressAlg(mem, TRUE);

  /* Call IDADense and set up the linear solver. */
  flag = IDADense(mem, NEQ);

  PrintHeader(rtol, atol, yy);

  /* In loop, call IDASolve, print results, and test for error. */

  PrintOutput(mem,t0,yy);

  tout = dt;
  for (iout=1; iout<NOUT; iout++) {
    tout = iout*dt;
    flag = IDASolve(mem, tout, &tret, yy, yp, IDA_NORMAL);
    if (flag < 0) break;

    PrintOutput(mem,tret,yy);

  }

  PrintFinalStats(mem);

  /* Free memory */

  free(data);
  IDAFree(&mem);
  N_VDestroy_Serial(yy);
  N_VDestroy_Serial(yp);
  N_VDestroy_Serial(id);

  return(0);
  
}
コード例 #17
0
ファイル: idaRoberts_sps.c プロジェクト: polymec/polymec-dev
int main(void)
{
  void *mem;
  N_Vector yy, yp, avtol;
  realtype rtol, *yval, *ypval, *atval;
  realtype t0, tout1, tout, tret;
  int iout, retval, retvalr;
  int rootsfound[2];
  SUNMatrix A;
  SUNLinearSolver LS;
  sunindextype nnz;

  mem = NULL;
  yy = yp = avtol = NULL;
  yval = ypval = atval = NULL;
  A = NULL;
  LS = NULL;

  /* Allocate N-vectors. */
  yy = N_VNew_Serial(NEQ);
  if(check_retval((void *)yy, "N_VNew_Serial", 0)) return(1);
  yp = N_VNew_Serial(NEQ);
  if(check_retval((void *)yp, "N_VNew_Serial", 0)) return(1);
  avtol = N_VNew_Serial(NEQ);
  if(check_retval((void *)avtol, "N_VNew_Serial", 0)) return(1);

  /* Create and initialize  y, y', and absolute tolerance vectors. */
  yval  = N_VGetArrayPointer(yy);
  yval[0] = ONE;
  yval[1] = ZERO;
  yval[2] = ZERO;

  ypval = N_VGetArrayPointer(yp);
  ypval[0]  = RCONST(-0.04);
  ypval[1]  = RCONST(0.04);
  ypval[2]  = ZERO;

  rtol = RCONST(1.0e-4);

  atval = N_VGetArrayPointer(avtol);
  atval[0] = RCONST(1.0e-8);
  atval[1] = RCONST(1.0e-6);
  atval[2] = RCONST(1.0e-6);

  /* Integration limits */
  t0 = ZERO;
  tout1 = RCONST(0.4);

  PrintHeader(rtol, avtol, yy);

  /* Call IDACreate and IDAInit to initialize IDA memory */
  mem = IDACreate();
  if(check_retval((void *)mem, "IDACreate", 0)) return(1);
  retval = IDAInit(mem, resrob, t0, yy, yp);
  if(check_retval(&retval, "IDAInit", 1)) return(1);
  /* Call IDASVtolerances to set tolerances */
  retval = IDASVtolerances(mem, rtol, avtol);
  if(check_retval(&retval, "IDASVtolerances", 1)) return(1);

  /* Free avtol */
  N_VDestroy(avtol);

  /* Call IDARootInit to specify the root function grob with 2 components */
  retval = IDARootInit(mem, 2, grob);
  if (check_retval(&retval, "IDARootInit", 1)) return(1);

  /* Create sparse SUNMatrix for use in linear solves */
  nnz = NEQ * NEQ;
  A = SUNSparseMatrix(NEQ, NEQ, nnz, CSC_MAT);
  if(check_retval((void *)A, "SUNSparseMatrix", 0)) return(1);

  /* Create SuperLUMT SUNLinearSolver object (one thread) */
  LS = SUNLinSol_SuperLUMT(yy, A, 1);
  if(check_retval((void *)LS, "SUNLinSol_SuperLUMT", 0)) return(1);

  /* Attach the matrix and linear solver */
  retval = IDASetLinearSolver(mem, LS, A);
  if(check_retval(&retval, "IDASetLinearSolver", 1)) return(1);

  /* Set the user-supplied Jacobian routine */
  retval = IDASetJacFn(mem, jacrob);
  if(check_retval(&retval, "IDASetJacFn", 1)) return(1);

  /* In loop, call IDASolve, print results, and test for error.
     Break out of loop when NOUT preset output times have been reached. */

  iout = 0; tout = tout1;
  while(1) {

    retval = IDASolve(mem, tout, &tret, yy, yp, IDA_NORMAL);

    PrintOutput(mem,tret,yy);

    if(check_retval(&retval, "IDASolve", 1)) return(1);

    if (retval == IDA_ROOT_RETURN) {
      retvalr = IDAGetRootInfo(mem, rootsfound);
      check_retval(&retvalr, "IDAGetRootInfo", 1);
      PrintRootInfo(rootsfound[0],rootsfound[1]);
    }

    if (retval == IDA_SUCCESS) {
      iout++;
      tout *= RCONST(10.0);
    }

    if (iout == NOUT) break;
  }

  PrintFinalStats(mem);

  /* Free memory */

  IDAFree(&mem);
  SUNLinSolFree(LS);
  SUNMatDestroy(A);
  N_VDestroy(yy);
  N_VDestroy(yp);

  return(0);

}
コード例 #18
0
int main(int argc, char *argv[])
{
  MPI_Comm comm;
  void *mem;
  UserData data;
  int thispe, iout, ier, npes;
  int Neq, local_N, mudq, mldq, mukeep, mlkeep;
  realtype rtol, atol, t0, t1, tout, tret;
  N_Vector uu, up, constraints, id, res;

  realtype *pbar;
  int is;
  N_Vector *uuS, *upS;
  booleantype sensi, err_con;
  int sensi_meth;

  mem = NULL;
  data = NULL;
  uu = up = constraints = id = res = NULL;
  uuS = upS = 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);
  }
  
  /* Process arguments */

  ProcessArgs(argc, argv, thispe, &sensi, &sensi_meth, &err_con);

  /* 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 IDAInit to initialize solution and various
     IDASet*** functions to specify optional inputs:
     - indicate which variables are differential and which are algebraic
     - exclude algebraic variables from error test
     - specify additional constraints on solution components */

  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);

  /* Specify state tolerances (scalar relative and absolute tolerances) */

  ier = IDASStolerances(mem, rtol, atol);
  if(check_flag(&ier, "IDASStolerances", 1, thispe)) MPI_Abort(comm, 1);

  /* Call IDASpgmr to specify the linear solver. */

  ier = IDASpgmr(mem, 12);
  if(check_flag(&ier, "IDASpgmr", 1, thispe)) MPI_Abort(comm, 1);
  
  /* Call IDABBDPrecInit to initialize BBD preconditioner. */

  mudq = MXSUB;
  mldq = MXSUB;
  mukeep = 1;
  mlkeep = 1;
  ier = IDABBDPrecInit(mem, local_N, mudq, mldq, mukeep, mlkeep, 
                       ZERO, reslocal, NULL);
  if(check_flag(&ier, "IDABBDPrecInit", 1, thispe)) MPI_Abort(comm, 1);

  /* Sensitivity-related settings */

  if( sensi) {

    /* Allocate and set pbar, the vector with order of magnitude
       information for the problem parameters. (Note: this is 
       done here as an illustration only, as the default values
       for pbar, if pbar is not supplied, are anyway 1.0) */

    pbar = (realtype *) malloc(NS*sizeof(realtype));
    if (check_flag((void *)pbar, "malloc", 2, thispe)) MPI_Abort(comm, 1);
    for (is=0; is<NS; is++) pbar[is] = data->p[is]; 

    /* Allocate sensitivity solution vectors uuS and upS and set them
       to an initial guess for the sensitivity ICs (the IC for uuS are
       0.0 since the state IC do not depend on the porblem parameters;
       however, the derivatives upS may not and therefore we will have
       to call IDACalcIC to find them) */

    uuS = N_VCloneVectorArray_Parallel(NS, uu);
    if (check_flag((void *)uuS, "N_VCloneVectorArray_Parallel", 0, thispe)) MPI_Abort(comm, 1);
    for (is = 0; is < NS; is++)  N_VConst(ZERO,uuS[is]);

    upS = N_VCloneVectorArray_Parallel(NS, uu);
    if (check_flag((void *)upS, "N_VCloneVectorArray_Parallel", 0, thispe)) MPI_Abort(comm, 1);
    for (is = 0; is < NS; is++)  N_VConst(ZERO,upS[is]);

    /* Initialize FSA using the default internal sensitivity residual function
       (Note that this requires specifying the problem parameters -- see below) */

    ier = IDASensInit(mem, NS, sensi_meth, NULL, uuS, upS);
    if(check_flag(&ier, "IDASensInit", 1, thispe)) MPI_Abort(comm, 1);

    /* Indicate the use of internally estimated tolerances for the sensitivity
       variables (based on the tolerances provided for the states and the 
       pbar values) */

    ier = IDASensEEtolerances(mem);
    if(check_flag(&ier, "IDASensEEtolerances", 1, thispe)) MPI_Abort(comm, 1);

    /* Specify whether the sensitivity variables are included in the error
       test or not */

    ier = IDASetSensErrCon(mem, err_con);
    if(check_flag(&ier, "IDASetSensErrCon", 1, thispe)) MPI_Abort(comm, 1);

    /* Specify the problem parameters and their order of magnitude
       (Note that we do not specify the index array plist and therefore
       IDAS will compute sensitivities w.r.t. the first NS parameters) */

    ier = IDASetSensParams(mem, data->p, pbar, NULL);
    if(check_flag(&ier, "IDASetSensParams", 1, thispe)) MPI_Abort(comm, 1);

    /* Compute consistent initial conditions (Note that this is required
       only if performing SA since uu and up already contain consistent 
       initial conditions for the states) */
  
    ier = IDACalcIC(mem, IDA_YA_YDP_INIT, t1);
    if(check_flag(&ier, "IDACalcIC", 1, thispe)) MPI_Abort(comm, 1);

  }

  /* Print problem description */

  if (thispe == 0 ) PrintHeader(Neq, rtol, atol, mudq, mukeep, 
                                sensi, sensi_meth, err_con);

  /* 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);

    if (sensi) {
      ier = IDAGetSens(mem, &tret, uuS);
      if(check_flag(&ier, "IDAGetSens", 1, thispe)) MPI_Abort(comm, 1);
    }

    PrintOutput(thispe, mem, tret, uu, sensi, uuS);
    
  }

  /* 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);

}
コード例 #19
0
int main(int argc, char *argv[])
{
  MPI_Comm comm;
  void *mem;
  UserData webdata;
  long int SystemSize, local_N, mudq, mldq, mukeep, mlkeep;
  realtype rtol, atol, t0, tout, tret;
  N_Vector cc, cp, res, id;
  int thispe, npes, maxl, iout, retval;

  cc = cp = res = id = NULL;
  webdata = NULL;
  mem = NULL;

  /* Set communicator, and get processor number and total number of PE's. */

  MPI_Init(&argc, &argv);
  comm = MPI_COMM_WORLD;
  MPI_Comm_rank(comm, &thispe);
  MPI_Comm_size(comm, &npes);

  if (npes != NPEX*NPEY) {
    if (thispe == 0)
      fprintf(stderr, 
              "\nMPI_ERROR(0): npes = %d not equal to NPEX*NPEY = %d\n", 
              npes, NPEX*NPEY);
    MPI_Finalize();
    return(1); 
  }
  
  /* Set local length (local_N) and global length (SystemSize). */

  local_N = MXSUB*MYSUB*NUM_SPECIES;
  SystemSize = NEQ;

  /* Set up user data block webdata. */

  webdata = (UserData) malloc(sizeof *webdata);
  webdata->rates = N_VNew_Parallel(comm, local_N, SystemSize);
  webdata->acoef = newDenseMat(NUM_SPECIES, NUM_SPECIES);

  InitUserData(webdata, thispe, npes, comm);
  
  /* Create needed vectors, and load initial values.
     The vector res is used temporarily only.        */
  
  cc  = N_VNew_Parallel(comm, local_N, SystemSize);
  if(check_flag((void *)cc, "N_VNew_Parallel", 0, thispe)) MPI_Abort(comm, 1);

  cp  = N_VNew_Parallel(comm, local_N, SystemSize);
  if(check_flag((void *)cp, "N_VNew_Parallel", 0, thispe)) MPI_Abort(comm, 1);

  res = N_VNew_Parallel(comm, local_N, SystemSize);
  if(check_flag((void *)res, "N_VNew_Parallel", 0, thispe)) MPI_Abort(comm, 1);

  id  = N_VNew_Parallel(comm, local_N, SystemSize);
  if(check_flag((void *)id, "N_VNew_Parallel", 0, thispe)) MPI_Abort(comm, 1);
  
  SetInitialProfiles(cc, cp, id, res, webdata);
  
  N_VDestroy_Parallel(res);
  
  /* Set remaining inputs to IDAMalloc. */
  
  t0 = ZERO;
  rtol = RTOL; 
  atol = ATOL;
  
  /* Call IDACreate and IDAMalloc to initialize solution */

  mem = IDACreate();
  if(check_flag((void *)mem, "IDACreate", 0, thispe)) MPI_Abort(comm, 1);

  retval = IDASetUserData(mem, webdata);
  if(check_flag(&retval, "IDASetUserData", 1, thispe)) MPI_Abort(comm, 1);

  retval = IDASetId(mem, id);
  if(check_flag(&retval, "IDASetId", 1, thispe)) MPI_Abort(comm, 1);

  retval = IDAInit(mem, resweb, t0, cc, cp);
  if(check_flag(&retval, "IDAInit", 1, thispe)) MPI_Abort(comm, 1);
  
  retval = IDASStolerances(mem, rtol, atol);
  if(check_flag(&retval, "IDASStolerances", 1, thispe)) MPI_Abort(comm, 1);

  /* Call IDASpgmr to specify the IDA linear solver IDASPGMR */

  maxl = 16;
  retval = IDASpgmr(mem, maxl);
  if(check_flag(&retval, "IDASpgmr", 1, thispe)) MPI_Abort(comm, 1);

  /* Call IDABBDPrecInit to initialize the band-block-diagonal preconditioner.
     The half-bandwidths for the difference quotient evaluation are exact
     for the system Jacobian, but only a 5-diagonal band matrix is retained. */
  
  mudq = mldq = NSMXSUB;
  mukeep = mlkeep = 2;
  retval = IDABBDPrecInit(mem, local_N, mudq, mldq, mukeep, mlkeep, 
                          ZERO, reslocal, NULL);
  if(check_flag(&retval, "IDABBDPrecInit", 1, thispe)) MPI_Abort(comm, 1);
  
  /* Call IDACalcIC (with default options) to correct the initial values. */
  
  tout = RCONST(0.001);
  retval = IDACalcIC(mem, IDA_YA_YDP_INIT, tout);
  if(check_flag(&retval, "IDACalcIC", 1, thispe)) MPI_Abort(comm, 1);
  
  /* On PE 0, print heading, basic parameters, initial values. */
 
  if (thispe == 0) PrintHeader(SystemSize, maxl, 
                               mudq, mldq, mukeep, mlkeep,
                               rtol, atol);
  PrintOutput(mem, cc, t0, webdata, comm);

  /* Call IDA in tout loop, normal mode, and print selected output. */
  
  for (iout = 1; iout <= NOUT; iout++) {
    
    retval = IDASolve(mem, tout, &tret, cc, cp, IDA_NORMAL);
    if(check_flag(&retval, "IDASolve", 1, thispe)) MPI_Abort(comm, 1);
    
    PrintOutput(mem, cc, tret, webdata, comm);
    
    if (iout < 3) tout *= TMULT; 
    else          tout += TADD;

  }
  
  /* On PE 0, print final set of statistics. */
  
  if (thispe == 0)  PrintFinalStats(mem);

  /* Free memory. */

  N_VDestroy_Parallel(cc);
  N_VDestroy_Parallel(cp);
  N_VDestroy_Parallel(id);

  IDAFree(&mem);

  destroyMat(webdata->acoef);
  N_VDestroy_Parallel(webdata->rates);
  free(webdata);

  MPI_Finalize();

  return(0);
}
コード例 #20
0
/* Main program */
int main()
{
  UserData data;
  void *mem;
  N_Vector yy, yp, rr, q;
  int flag;
  realtype time, tout, incr;
  int nout;

  mem = NULL;
  yy = yp = NULL;

  /* Allocate user data. */
  data = (UserData) malloc(sizeof(*data));

  /* Fill user's data with the appropriate values for coefficients. */
  data->k1 = RCONST(18.7);
  data->k2 = RCONST(0.58);
  data->k3 = RCONST(0.09);
  data->k4 = RCONST(0.42);
  data->K = RCONST(34.4);
  data->klA = RCONST(3.3);
  data->Ks = RCONST(115.83);
  data->pCO2 = RCONST(0.9);
  data->H = RCONST(737.0);

  /* Allocate N-vectors. */
  yy = N_VNew_Serial(NEQ);
  if (check_flag((void *)yy, "N_VNew_Serial", 0)) return(1);
  yp = N_VNew_Serial(NEQ);
  if (check_flag((void *)yp, "N_VNew_Serial", 0)) return(1);

  /* Consistent IC for  y, y'. */
#define y01 0.444
#define y02 0.00123
#define y03 0.00
#define y04 0.007
#define y05 0.0
  Ith(yy,1) = RCONST(y01);
  Ith(yy,2) = RCONST(y02);
  Ith(yy,3) = RCONST(y03);
  Ith(yy,4) = RCONST(y04);
  Ith(yy,5) = RCONST(y05);
  Ith(yy,6) = data->Ks * RCONST(y01) * RCONST(y04);

  /* Get y' = - res(t0, y, 0) */
  N_VConst(ZERO, yp);

  rr = N_VNew_Serial(NEQ);
  res(T0, yy, yp, rr, data);
  N_VScale(-ONE, rr, yp);
  N_VDestroy_Serial(rr);
  
 /* Create and initialize q0 for quadratures. */
  q = N_VNew_Serial(1);
  if (check_flag((void *)q, "N_VNew_Serial", 0)) return(1);
  Ith(q,1) = ZERO;

  /* Call IDACreate and IDAInit to initialize IDA memory */
  mem = IDACreate();
  if(check_flag((void *)mem, "IDACreate", 0)) return(1);

  flag = IDAInit(mem, res, T0, yy, yp);
  if(check_flag(&flag, "IDAInit", 1)) return(1);


  /* Set tolerances. */
  flag = IDASStolerances(mem, RTOL, ATOL);
  if(check_flag(&flag, "IDASStolerances", 1)) return(1);

  /* Attach user data. */
  flag = IDASetUserData(mem, data);
  if(check_flag(&flag, "IDASetUserData", 1)) return(1);
  
  /* Attach linear solver. */
  flag = IDADense(mem, NEQ);

  /* Initialize QUADRATURE(S). */
  flag = IDAQuadInit(mem, rhsQ, q);
  if (check_flag(&flag, "IDAQuadInit", 1)) return(1);

  /* Set tolerances and error control for quadratures. */
  flag = IDAQuadSStolerances(mem, RTOLQ, ATOLQ);
  if (check_flag(&flag, "IDAQuadSStolerances", 1)) return(1);

  flag = IDASetQuadErrCon(mem, TRUE);
  if (check_flag(&flag, "IDASetQuadErrCon", 1)) return(1);

  PrintHeader(RTOL, ATOL, yy);
  /* Print initial states */
  PrintOutput(mem,0.0,yy);

  tout = T1; nout = 0;
  incr = RPowerR(TF/T1,ONE/NF);
 
  /* FORWARD run. */
  while (1) {

    flag = IDASolve(mem, tout, &time, yy, yp, IDA_NORMAL);
    if (check_flag(&flag, "IDASolve", 1)) return(1);

    PrintOutput(mem, time, yy);

    nout++;
    tout *= incr;

    if (nout>NF) break;
  }

  flag = IDAGetQuad(mem, &time, q);
  if (check_flag(&flag, "IDAGetQuad", 1)) return(1);

  printf("\n--------------------------------------------------------\n");
  printf("G:          %24.16f \n",Ith(q,1));
  printf("--------------------------------------------------------\n\n");

  PrintFinalStats(mem);

  IDAFree(&mem);

  N_VDestroy_Serial(yy);
  N_VDestroy_Serial(yp);
  N_VDestroy_Serial(q);

  return(0);
}
コード例 #21
0
ファイル: fida.c プロジェクト: ladlung/CERENA
void FIDA_MALLOC(realtype *t0, realtype *yy0, realtype *yp0,
                 int *iatol, realtype *rtol, realtype *atol,
                 long int *iout, realtype *rout, 
                 long int *ipar, realtype *rpar,
                 int *ier)
{
  N_Vector Vatol;
  FIDAUserData IDA_userdata;

  *ier = 0;

  /* Check for required vector operations */
  if ((F2C_IDA_vec->ops->nvgetarraypointer == NULL) ||
      (F2C_IDA_vec->ops->nvsetarraypointer == NULL)) {
    *ier = -1;
    printf("A required vector operation is not implemented.\n\n");
    return;
  }

  /* Initialize all pointers to NULL */
  IDA_idamem = NULL;
  Vatol = NULL;
  F2C_IDA_ypvec = F2C_IDA_ewtvec = NULL;

  /* Create IDA object */
  IDA_idamem = IDACreate();
  if (IDA_idamem == NULL) {
    *ier = -1;
    return;
  }

  /* Set and attach user data */
  IDA_userdata = NULL;
  IDA_userdata = (FIDAUserData) malloc(sizeof *IDA_userdata);
  if (IDA_userdata == NULL) {
    *ier = -1;
    return;
  }
  IDA_userdata->rpar = rpar;
  IDA_userdata->ipar = ipar;

  *ier = IDASetUserData(IDA_idamem, IDA_userdata);
  if(*ier != IDA_SUCCESS) {
    free(IDA_userdata); IDA_userdata = NULL;
    *ier = -1;
    return;
  }

  /* Attach user's yy0 to F2C_IDA_vec */
  N_VSetArrayPointer(yy0, F2C_IDA_vec);

  /* Create F2C_IDA_ypvec and attach user's yp0 to it */
  F2C_IDA_ypvec = NULL;
  F2C_IDA_ypvec = N_VCloneEmpty(F2C_IDA_vec);
  if (F2C_IDA_ypvec == NULL) {
    free(IDA_userdata); IDA_userdata = NULL;
    *ier = -1;
  }
  N_VSetArrayPointer(yp0, F2C_IDA_ypvec);

  /* Call IDAInit */
  *ier = IDAInit(IDA_idamem, FIDAresfn, *t0, F2C_IDA_vec, F2C_IDA_ypvec);

  /* Reset data pointers */
  N_VSetArrayPointer(NULL, F2C_IDA_vec);
  N_VSetArrayPointer(NULL, F2C_IDA_ypvec);

  /* On failure, clean-up and exit */
  if (*ier != IDA_SUCCESS) {
    N_VDestroy(F2C_IDA_ypvec);
    free(IDA_userdata); IDA_userdata = NULL;
    *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) {
      free(IDA_userdata); IDA_userdata = NULL;
      *ier = -1;
      return;
    }
    N_VSetArrayPointer(atol, Vatol);
    *ier = IDASVtolerances(IDA_idamem, *rtol, Vatol);
    N_VDestroy(Vatol);
    break;
  }

  /* On failure, clean-up and exit */
  if (*ier != IDA_SUCCESS) {
    free(IDA_userdata); IDA_userdata = NULL;
    *ier = -1;
    return;
  }

  /* Grab optional output arrays and store them in global variables */
  IDA_iout = iout;
  IDA_rout = rout;

  /* Store the unit roundoff in rout for user access */
  IDA_rout[5] = UNIT_ROUNDOFF;

  /* Set F2C_IDA_ewtvec on NULL */
  F2C_IDA_ewtvec = NULL;

  return;
}
コード例 #22
0
int main(int argc, char *argv[])
{
  MPI_Comm comm;
  void *mem;
  UserData webdata;
  long int SystemSize, local_N;
  realtype rtol, atol, t0, tout, tret;
  N_Vector cc, cp, res, id;
  int thispe, npes, maxl, iout, flag;

  cc = cp = res = id = NULL;
  webdata = NULL;
  mem = NULL;

  /* Set communicator, and get processor number and total number of PE's. */

  MPI_Init(&argc, &argv);
  comm = MPI_COMM_WORLD;
  MPI_Comm_rank(comm, &thispe);
  MPI_Comm_size(comm, &npes);

  if (npes != NPEX*NPEY) {
    if (thispe == 0)
      fprintf(stderr, 
              "\nMPI_ERROR(0): npes = %d not equal to NPEX*NPEY = %d\n",
	      npes, NPEX*NPEY);
    MPI_Finalize();
    return(1); 
  }

  /* Set local length (local_N) and global length (SystemSize). */

  local_N = MXSUB*MYSUB*NUM_SPECIES;
  SystemSize = NEQ;

  /* Set up user data block webdata. */

  webdata = AllocUserData(comm, local_N, SystemSize);
  if (check_flag((void *)webdata, "AllocUserData", 0, thispe)) MPI_Abort(comm, 1);

  InitUserData(webdata, thispe, npes, comm);
  
  /* Create needed vectors, and load initial values.
     The vector res is used temporarily only.        */

  cc  = N_VNew_Parallel(comm, local_N, SystemSize);
  if (check_flag((void *)cc, "N_VNew_Parallel", 0, thispe)) MPI_Abort(comm, 1);

  cp  = N_VNew_Parallel(comm, local_N, SystemSize);
  if (check_flag((void *)cp, "N_VNew_Parallel", 0, thispe)) MPI_Abort(comm, 1);

  res = N_VNew_Parallel(comm, local_N, SystemSize);
  if (check_flag((void *)res, "N_VNew_Parallel", 0, thispe)) MPI_Abort(comm, 1);

  id  = N_VNew_Parallel(comm, local_N, SystemSize);
  if (check_flag((void *)id, "N_VNew_Parallel", 0, thispe)) MPI_Abort(comm, 1);
  
  SetInitialProfiles(cc, cp, id, res, webdata);
  
  N_VDestroy(res);

  /* Set remaining inputs to IDAMalloc. */

  t0 = ZERO;
  rtol = RTOL; 
  atol = ATOL;
  
  /* Call IDACreate and IDAMalloc to initialize IDA.
     A pointer to IDA problem memory is returned and stored in idamem. */

  mem = IDACreate();
  if (check_flag((void *)mem, "IDACreate", 0, thispe)) MPI_Abort(comm, 1);

  flag = IDASetUserData(mem, webdata);
  if (check_flag(&flag, "IDASetUserData", 1, thispe)) MPI_Abort(comm, 1);

  flag = IDASetId(mem, id);
  if (check_flag(&flag, "IDASetId", 1, thispe)) MPI_Abort(comm, 1);

  flag = IDAInit(mem, resweb, t0, cc, cp);
  if (check_flag(&flag, "IDAinit", 1, thispe)) MPI_Abort(comm, 1);

  flag = IDASStolerances(mem, rtol, atol);
  if (check_flag(&flag, "IDASStolerances", 1, thispe)) MPI_Abort(comm, 1);

  webdata->ida_mem = mem;

  /* Call IDASpgmr to specify the IDA linear solver IDASPGMR and specify
     the preconditioner routines supplied (Precondbd and PSolvebd).
     maxl (max. Krylov subspace dim.) is set to 16. */

  maxl = 16;
  flag = IDASpgmr(mem, maxl);
  if (check_flag(&flag, "IDASpgmr", 1, thispe)) 
    MPI_Abort(comm, 1);

  flag = IDASpilsSetPreconditioner(mem, Precondbd, PSolvebd);
  if (check_flag(&flag, "IDASpilsSetPreconditioner", 1, thispe)) 
    MPI_Abort(comm, 1);
  
  /* Call IDACalcIC (with default options) to correct the initial values. */

  tout = RCONST(0.001);
  flag = IDACalcIC(mem, IDA_YA_YDP_INIT, tout);
  if (check_flag(&flag, "IDACalcIC", 1, thispe)) 
    MPI_Abort(comm, 1);

  /* On PE 0, print heading, basic parameters, initial values. */

  if (thispe == 0) PrintHeader(SystemSize, maxl, rtol, atol);
  PrintOutput(mem, cc, t0, webdata, comm);
  
  /* Loop over iout, call IDASolve (normal mode), print selected output. */

  for (iout = 1; iout <= NOUT; iout++) {
    
    flag = IDASolve(mem, tout, &tret, cc, cp, IDA_NORMAL);
    if (check_flag(&flag, "IDASolve", 1, thispe)) MPI_Abort(comm, 1);

    PrintOutput(mem, cc, tret, webdata, comm);
    
    if (iout < 3) tout *= TMULT; 
    else          tout += TADD;
    
  }
  
  /* On PE 0, print final set of statistics. */
  if (thispe == 0) PrintFinalStats(mem);

  /* Free memory. */

  N_VDestroy_Parallel(cc);
  N_VDestroy_Parallel(cp);
  N_VDestroy_Parallel(id);

  IDAFree(&mem);

  FreeUserData(webdata);

  MPI_Finalize();

  return(0);

}
コード例 #23
0
ファイル: idaHeat2D_kry.c プロジェクト: luca-heltai/sundials
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);
}
コード例 #24
0
ファイル: idaFoodWeb_kry.c プロジェクト: luca-heltai/sundials
int main()
{ 
  void *mem;
  UserData webdata;
  N_Vector cc, cp, id;
  int iout, jx, jy, flag;
  long int maxl;
  realtype rtol, atol, t0, tout, tret;

  mem = NULL;
  webdata = NULL;
  cc = cp = id = NULL;

  /* Allocate and initialize user data block webdata. */

  webdata = (UserData) malloc(sizeof *webdata);
  webdata->rates = N_VNew_Serial(NEQ);
  webdata->acoef = newDenseMat(NUM_SPECIES, NUM_SPECIES);
  webdata->ewt = N_VNew_Serial(NEQ);
  for (jx = 0; jx < MX; jx++) {
    for (jy = 0; jy < MY; jy++) {
      (webdata->pivot)[jx][jy] = newLintArray(NUM_SPECIES);
      (webdata->PP)[jx][jy] = newDenseMat(NUM_SPECIES, NUM_SPECIES);
    }
  }

  InitUserData(webdata);

  /* Allocate N-vectors and initialize cc, cp, and id. */

  cc  = N_VNew_Serial(NEQ);
  if(check_flag((void *)cc, "N_VNew_Serial", 0)) return(1);

  cp  = N_VNew_Serial(NEQ);
  if(check_flag((void *)cp, "N_VNew_Serial", 0)) return(1);

  id  = N_VNew_Serial(NEQ);
  if(check_flag((void *)id, "N_VNew_Serial", 0)) return(1);
  
  SetInitialProfiles(cc, cp, id, webdata);
  
  /* Set remaining inputs to IDAMalloc. */
  
  t0 = ZERO;
  rtol = RTOL; 
  atol = ATOL;

  /* Call IDACreate and IDAMalloc to initialize IDA. */
  
  mem = IDACreate();
  if(check_flag((void *)mem, "IDACreate", 0)) return(1);

  flag = IDASetUserData(mem, webdata);
  if(check_flag(&flag, "IDASetUserData", 1)) return(1);

  flag = IDASetId(mem, id);
  if(check_flag(&flag, "IDASetId", 1)) return(1);

  flag = IDAInit(mem, resweb, t0, cc, cp);
  if(check_flag(&flag, "IDAInit", 1)) return(1);

  flag = IDASStolerances(mem, rtol, atol);
  if(check_flag(&flag, "IDASStolerances", 1)) return(1);

  webdata->ida_mem = mem;

  /* Call IDASpgmr to specify the IDA linear solver. */

  maxl = 16;                    /* max dimension of the Krylov subspace */
  flag = IDASpgmr(mem, maxl);
  if(check_flag(&flag, "IDASpgmr", 1)) return(1);

  flag = IDASpilsSetPreconditioner(mem, Precond, PSolve);
  if(check_flag(&flag, "IDASpilsSetPreconditioner", 1)) return(1);

  /* Call IDACalcIC (with default options) to correct the initial values. */

  tout = RCONST(0.001);
  flag = IDACalcIC(mem, IDA_YA_YDP_INIT, tout);
  if(check_flag(&flag, "IDACalcIC", 1)) return(1);
  
  /* Print heading, basic parameters, and initial values. */

  PrintHeader(maxl, rtol, atol);
  PrintOutput(mem, cc, ZERO);
  
  /* Loop over iout, call IDASolve (normal mode), print selected output. */
  
  for (iout = 1; iout <= NOUT; iout++) {
    
    flag = IDASolve(mem, tout, &tret, cc, cp, IDA_NORMAL);
    if(check_flag(&flag, "IDASolve", 1)) return(flag);
    
    PrintOutput(mem, cc, tret);
    
    if (iout < 3) tout *= TMULT; else tout += TADD;
    
  }
  
  /* Print final statistics and free memory. */  
  
  PrintFinalStats(mem);

  /* Free memory */

  IDAFree(&mem);

  N_VDestroy_Serial(cc);
  N_VDestroy_Serial(cp);
  N_VDestroy_Serial(id);


  destroyMat(webdata->acoef);
  N_VDestroy_Serial(webdata->rates);
  N_VDestroy_Serial(webdata->ewt);
  for (jx = 0; jx < MX; jx++) {
    for (jy = 0; jy < MY; jy ++) {
      destroyArray((webdata->pivot)[jx][jy]);
      destroyMat((webdata->PP)[jx][jy]);
    }
  }
  free(webdata);

  return(0);
}