23 #if defined (HAVE_CONFIG_H) 40 #if defined (HAVE_SUNDIALS) 42 # if defined (HAVE_IDA_IDA_H) 46 # if defined (HAVE_IDA_IDA_DENSE_H) 47 # include <ida/ida_dense.h> 50 # if defined (HAVE_IDA_IDA_KLU_H) 51 # include <ida/ida_klu.h> 52 # include <sundials/sundials_sparse.h> 55 # if defined (HAVE_NVECTOR_NVECTOR_SERIAL_H) 56 # include <nvector/nvector_serial.h> 59 static inline realtype *
60 nv_data_s (N_Vector& v)
62 #if defined (HAVE_PRAGMA_GCC_DIAGNOSTIC) 66 # pragma GCC diagnostic push 67 # pragma GCC diagnostic ignored "-Wold-style-cast" 72 #if defined (HAVE_PRAGMA_GCC_DIAGNOSTIC) 74 # pragma GCC diagnostic pop 97 realtype
t, realtype cj,
110 : t0 (0.0), y0 (), yp0 (), havejac (
false), havejacfun (
false),
111 havejacsparse (
false), mem (nullptr), num (), ida_fun (nullptr),
112 ida_jac (nullptr), dfdy (nullptr), dfdyp (nullptr), spdfdy (nullptr),
113 spdfdyp (nullptr), fun (nullptr), jacfun (nullptr), jacspfun (nullptr),
114 jacdcell (nullptr), jacspcell (nullptr)
120 : t0 (
t), y0 (
y), yp0 (yp), havejac (
false), havejacfun (
false),
121 havejacsparse (
false), mem (nullptr), num (), ida_fun (ida_fcn),
122 ida_jac (nullptr), dfdy (nullptr), dfdyp (nullptr), spdfdy (nullptr),
123 spdfdyp (nullptr), fun (daefun), jacfun (nullptr), jacspfun (nullptr),
124 jacdcell (nullptr), jacspcell (nullptr)
128 ~IDA (
void) { IDAFree (&mem); }
137 havejacsparse =
false;
148 havejacsparse =
true;
153 set_jacobian (
Matrix *dy,
Matrix *dyp, DAEJacCellDense j)
160 havejacsparse =
false;
173 havejacsparse =
true;
177 void set_userdata (
void);
181 static ColumnVector NVecToCol (N_Vector& v,
long int n);
183 static N_Vector ColToNVec (
const ColumnVector& data,
long int n);
192 set_tolerance (realtype abstol, realtype reltol);
195 resfun (realtype
t, N_Vector yy, N_Vector yyp,
196 N_Vector rr,
void *user_data);
199 resfun_impl (realtype
t, N_Vector& yy,
200 N_Vector& yyp, N_Vector& rr);
203 jacdense (
long int Neq, realtype
t, realtype cj, N_Vector yy,
204 N_Vector yyp, N_Vector, DlsMat JJ,
void *user_data,
205 N_Vector, N_Vector, N_Vector)
207 IDA *
self = static_cast <IDA *> (user_data);
208 self->jacdense_impl (Neq,
t, cj, yy, yyp, JJ);
213 jacdense_impl (
long int Neq, realtype
t, realtype cj,
214 N_Vector& yy, N_Vector& yyp, DlsMat& JJ);
216 # if defined (HAVE_SUNDIALS_IDAKLU) 218 jacsparse (realtype
t, realtype cj, N_Vector yy, N_Vector yyp,
219 N_Vector, SlsMat Jac,
void *user_data, N_Vector,
222 IDA *
self = static_cast <IDA *> (user_data);
223 self->jacsparse_impl (
t, cj, yy, yyp, Jac);
228 jacsparse_impl (realtype
t, realtype cj, N_Vector& yy,
229 N_Vector& yyp, SlsMat& Jac);
232 void set_maxstep (realtype maxstep);
234 void set_initialstep (realtype initialstep);
238 int refine, realtype tend,
bool haveoutputfcn,
248 const ColumnVector& output, realtype tout, realtype tend,
258 int cont,
int& temp, realtype told,
ColumnVector& yold);
260 void set_maxorder (
int maxorder);
265 const int refine,
bool haverefine,
bool haveoutputfcn,
270 void print_stat (
void);
289 DAEJacFuncDense jacfun;
290 DAEJacFuncSparse jacspfun;
291 DAEJacCellDense jacdcell;
292 DAEJacCellSparse jacspcell;
296 IDA::resfun (realtype
t, N_Vector yy, N_Vector yyp, N_Vector rr,
299 IDA *
self = static_cast <IDA *> (user_data);
300 self->resfun_impl (
t, yy, yyp, rr);
305 IDA::resfun_impl (realtype
t, N_Vector& yy,
306 N_Vector& yyp, N_Vector& rr)
308 BEGIN_INTERRUPT_WITH_EXCEPTIONS;
316 realtype *puntrr = nv_data_s (rr);
321 END_INTERRUPT_WITH_EXCEPTIONS;
329 # if defined (HAVE_SUNDIALS_IDAKLU) 330 if (IDAKLU (mem, num, num*num, CSC_MAT) != 0)
331 error (
"IDAKLU solver not initialized");
333 IDASlsSetSparseJacFn (mem, IDA::jacsparse);
335 error (
"IDAKLU is not available in this version of Octave");
340 if (IDADense (mem, num) != 0)
341 error (
"IDADense solver not initialized");
343 if (havejac && IDADlsSetDenseJacFn (mem, IDA::jacdense) != 0)
344 error (
"Dense Jacobian not set");
349 IDA::jacdense_impl (
long int Neq, realtype
t, realtype cj,
350 N_Vector& yy, N_Vector& yyp, DlsMat& JJ)
353 BEGIN_INTERRUPT_WITH_EXCEPTIONS;
362 jac = (*jacfun) (
y, yp,
t, cj, ida_jac);
364 jac = (*jacdcell) (dfdy, dfdyp, cj);
366 std::copy (jac.fortran_vec (),
367 jac.fortran_vec () + jac.numel (),
370 END_INTERRUPT_WITH_EXCEPTIONS;
373 # if defined (HAVE_SUNDIALS_IDAKLU) 375 IDA::jacsparse_impl (realtype
t, realtype cj, N_Vector& yy, N_Vector& yyp,
379 BEGIN_INTERRUPT_WITH_EXCEPTIONS;
388 jac = (*jacspfun) (
y, yp,
t, cj, ida_jac);
390 jac = (*jacspcell) (spdfdy, spdfdyp, cj);
392 SparseSetMatToZero (Jac);
393 int *colptrs = *(Jac->colptrs);
394 int *rowvals = *(Jac->rowvals);
396 for (
int i = 0;
i < num + 1;
i++)
397 colptrs[
i] = jac.cidx(
i);
399 for (
int i = 0;
i < jac.nnz ();
i++)
401 rowvals[
i] = jac.ridx(
i);
402 Jac->data[
i] = jac.data(
i);
405 END_INTERRUPT_WITH_EXCEPTIONS;
410 IDA::NVecToCol (N_Vector& v,
long int n)
413 realtype *punt = nv_data_s (v);
424 N_Vector v = N_VNew_Serial (n);
426 realtype *punt = nv_data_s (v);
435 IDA::set_userdata (
void)
437 void *userdata =
this;
439 if (IDASetUserData (mem, userdata) != 0)
440 error (
"User data not set");
449 N_Vector yy = ColToNVec (y0, num);
451 N_Vector yyp = ColToNVec (yp0, num);
453 IDA::set_userdata ();
455 if (IDAInit (mem, IDA::resfun, t0, yy, yyp) != 0)
456 error (
"IDA not initialized");
460 IDA::set_tolerance (
ColumnVector& abstol, realtype reltol)
462 N_Vector abs_tol = ColToNVec (abstol, num);
464 if (IDASVtolerances (mem, reltol, abs_tol) != 0)
465 error (
"IDA: Tolerance not set");
467 N_VDestroy_Serial (abs_tol);
471 IDA::set_tolerance (realtype abstol, realtype reltol)
473 if (IDASStolerances (mem, reltol, abstol) != 0)
474 error (
"IDA: Tolerance not set");
478 IDA::integrate (
const int numt,
const ColumnVector& tspan,
480 const int refine,
bool haverefine,
bool haveoutputfcn,
489 int cont = 0, temp = 0;
494 realtype tsol = tspan(0);
495 realtype tend = tspan(numt-1);
497 N_Vector yyp = ColToNVec (yp, num);
499 N_Vector yy = ColToNVec (
y, num);
503 status = IDA::outputfun (output_fcn, haveoutputsel,
y,
504 tsol, tend, outputsel,
"init");
507 if (haveeventfunction)
508 status = IDA::event (event_fcn, te, ye, ie, tsol,
y,
509 "init", yp, oldval, oldisterminal,
510 olddir, cont, temp, tsol, yold);
517 output.
resize (numt, num);
520 output.
elem (0,
i) =
y.elem (
i);
527 if (IDASolve (mem, tspan (j), &tsol, yy, yyp, IDA_NORMAL) != 0)
528 error (
"IDASolve failed");
530 yout = NVecToCol (yy, num);
531 ypout = NVecToCol (yyp, num);
535 output.
elem (j,
i) = yout.elem (
i);
538 status = IDA::outputfun (output_fcn, haveoutputsel, yout, tsol,
539 tend, outputsel,
string);
541 if (haveeventfunction)
542 status = IDA::event (event_fcn, te, ye, ie, tout(j), yout,
543 string, ypout, oldval, oldisterminal,
544 olddir, j, temp, tout(j-1), yold);
549 output.
resize (j + 1, num);
563 output.
elem (0,
i) =
y.elem (
i);
565 bool posdirection = (tend > tsol);
568 while (((posdirection == 1 && tsol < tend)
569 || (posdirection == 0 && tsol > tend))
572 if (IDASolve (mem, tend, &tsol, yy, yyp, IDA_ONE_STEP) != 0)
573 error (
"IDASolve failed");
576 status = IDA::interpolate (cont, output, tout, refine, tend,
577 haveoutputfcn, haveoutputsel,
578 output_fcn, outputsel,
579 haveeventfunction, event_fcn, te,
580 ye, ie, oldval, oldisterminal,
583 ypout = NVecToCol (yyp, num);
585 output.
resize (cont + 1, num);
588 yout = NVecToCol (yy, num);
591 output.
elem (cont,
i) = yout.elem (
i);
593 if (haveoutputfcn && ! haverefine && tout(cont) < tend)
594 status = IDA::outputfun (output_fcn, haveoutputsel, yout, tsol,
595 tend, outputsel,
string);
597 if (haveeventfunction && ! haverefine && tout(cont) < tend)
598 status = IDA::event (event_fcn, te, ye, ie, tout(cont), yout,
599 string, ypout, oldval, oldisterminal,
600 olddir, cont, temp, tout(cont-1), yold);
606 N_Vector dky = N_VNew_Serial (num);
608 if (IDAGetDky (mem, tend, 0, dky) != 0)
609 error (
"IDA failed to interpolate y");
612 yout = NVecToCol (dky, num);
615 output.
elem (cont,
i) = yout.elem (
i);
620 status = IDA::outputfun (output_fcn, haveoutputsel, yout,
621 tend, tend, outputsel,
string);
624 if (haveeventfunction)
625 status = IDA::event (event_fcn, te, ye, ie, tend, yout,
626 string, ypout, oldval, oldisterminal,
627 olddir, cont, temp, tout(cont-1),
631 N_VDestroy_Serial (dky);
635 status = IDA::outputfun (output_fcn, haveoutputsel, yout, tend, tend,
640 return ovl (tout, output, te, ye, ie);
661 oldval = output(0).vector_value ();
662 oldisterminal = output(1).vector_value ();
663 olddir = output(2).vector_value ();
676 if ((
val(
i) > 0 && oldval(
i) < 0 && dir(
i) != -1)
677 || (
val(
i) < 0 && oldval(
i) > 0 && dir(
i) != 1))
679 index.
resize (index.numel () + 1);
680 index (index.numel () - 1) =
i;
684 if (cont == 1 && index.numel () > 0)
693 te(0) = tsol -
val (index(0)) * (tsol - told)
694 / (
val (index(0)) - oldval (index(0)));
697 =
y - ((tsol - te(0)) * (
y - yold) / (tsol - told));
700 ye.
elem (0,
i) = ytemp.elem (
i);
703 else if (index.numel () > 0)
706 te.
resize (temp + index.numel ());
707 ye.
resize (temp + index.numel (), num);
708 ie.
resize (temp + index.numel ());
713 if (isterminal (index(
i)) == 1)
717 ie(temp+
i) = index(
i);
718 te(temp+
i) = tsol -
val(index(
i)) * (tsol - told)
719 / (
val(index(
i)) - oldval(index(
i)));
722 =
y - (tsol - te (temp +
i)) * (
y - yold) / (tsol - told);
725 ye.
elem (temp +
i, j) = ytemp.elem (j);
729 temp += index.numel ();
737 oldisterminal = isterminal;
745 int refine, realtype tend,
bool haveoutputfcn,
753 realtype
h = 0, tcur = 0;
756 N_Vector dky = N_VNew_Serial (num);
758 N_Vector dkyp = N_VNew_Serial (num);
764 if (IDAGetLastStep (mem, &
h) != 0)
765 error (
"IDA failed to return last step");
767 if (IDAGetCurrentTime (mem, &tcur) != 0)
768 error (
"IDA failed to return the current time");
770 realtype tin = tcur -
h;
772 realtype step =
h / refine;
775 i < refine && tin + step *
i < tend && status == 0;
778 if (IDAGetDky (mem, tin + step*
i, 0, dky) != 0)
779 error (
"IDA failed to interpolate y");
781 if (IDAGetDky (mem, tin + step*
i, 1, dkyp) != 0)
782 error (
"IDA failed to interpolate yp");
785 output.
resize (cont + 1, num);
788 tout(cont) = tin + step *
i;
789 yout = NVecToCol (dky, num);
790 ypout = NVecToCol (dkyp, num);
793 output.
elem (cont, j) = yout.elem (j);
796 status = IDA::outputfun (output_fcn, haveoutputsel, yout,
797 tout(cont), tend, outputsel,
"");
799 if (haveeventfunction)
800 status = IDA::event (event_fcn, te, ye, ie, tout(cont),
801 yout,
string, ypout, oldval,
802 oldisterminal, olddir, cont, temp,
806 N_VDestroy_Serial (dky);
826 ysel(
i) = yout(outputsel(
i));
840 feval (output_fcn, output, 0);
846 status =
val(0).bool_value ();
852 feval (output_fcn, output, 0);
859 IDA::set_maxstep (realtype maxstep)
861 if (IDASetMaxStep (mem, maxstep) != 0)
862 error (
"IDA: Max Step not set");
866 IDA::set_initialstep (realtype initialstep)
868 if (IDASetInitStep (mem, initialstep) != 0)
869 error (
"IDA: Initial Step not set");
873 IDA::set_maxorder (
int maxorder)
875 if (IDASetMaxOrd (mem, maxorder) != 0)
876 error (
"IDA: Max Order not set");
880 IDA::print_stat (
void)
882 long int nsteps = 0, netfails = 0, nrevals = 0;
884 if (IDAGetNumSteps (mem, &nsteps) != 0)
885 error (
"IDA failed to return the number of internal steps");
887 if (IDAGetNumErrTestFails (mem, &netfails) != 0)
888 error (
"IDA failed to return the number of internal errors");
890 if (IDAGetNumResEvals (mem, &nrevals) != 0)
891 error (
"IDA failed to return the number of residual evaluations");
893 std::cout << nsteps <<
" successful steps\n";
894 std::cout << netfails <<
" failed attempts\n";
895 std::cout << nrevals <<
" function evaluations\n";
916 return tmp(0).vector_value ();
934 return tmp(0).matrix_value () + cj *
tmp(1).matrix_value ();
952 return tmp(0).sparse_matrix_value () + cj *
tmp(1).sparse_matrix_value ();
956 ida_dense_cell_jac (
Matrix *dfdy,
Matrix *dfdyp,
double cj)
958 return (*dfdy) + cj * (*dfdyp);
965 return (*spdfdy) + cj * (*spdfdyp);
980 IDA dae (t0, y0, yp0, ida_fcn, ida_user_function);
983 bool havejac =
options.getfield (
"havejac").bool_value ();
985 bool havejacsparse =
options.getfield (
"havejacsparse").bool_value ();
987 bool havejacfun =
options.getfield (
"havejacfun").bool_value ();
989 Matrix ida_dfdy, ida_dfdyp, *dfdy, *dfdyp;
990 SparseMatrix ida_spdfdy, ida_spdfdyp, *spdfdy, *spdfdyp;
998 ida_jac =
options.getfield (
"Jacobian").function_value ();
1001 dae.set_jacobian (ida_jac, ida_sparse_jac);
1003 dae.set_jacobian (ida_jac, ida_dense_jac);
1011 ida_spdfdy = jaccell(0).sparse_matrix_value ();
1012 ida_spdfdyp = jaccell(1).sparse_matrix_value ();
1013 spdfdy = &ida_spdfdy;
1014 spdfdyp = &ida_spdfdyp;
1015 dae.set_jacobian (spdfdy, spdfdyp, ida_sparse_cell_jac);
1019 ida_dfdy = jaccell(0).matrix_value ();
1020 ida_dfdyp = jaccell(1).matrix_value ();
1023 dae.set_jacobian (dfdy, dfdyp, ida_dense_cell_jac);
1032 realtype rel_tol =
options.getfield(
"RelTol").double_value ();
1034 bool haveabstolvec =
options.getfield (
"haveabstolvec").bool_value ();
1040 dae.set_tolerance (abs_tol, rel_tol);
1044 realtype abs_tol =
options.getfield(
"AbsTol").double_value ();
1046 dae.set_tolerance (abs_tol, rel_tol);
1050 realtype maxstep =
options.getfield(
"MaxStep").double_value ();
1052 dae.set_maxstep (maxstep);
1055 if (!
options.getfield(
"InitialStep").isempty ())
1057 realtype initialstep =
options.getfield(
"InitialStep").double_value ();
1059 dae.set_initialstep (initialstep);
1063 int maxorder =
options.getfield(
"MaxOrder").int_value ();
1065 dae.set_maxorder (maxorder);
1068 const int refine =
options.getfield(
"Refine").int_value ();
1070 bool haverefine = (refine > 1);
1076 bool haveoutputfunction
1077 =
options.getfield(
"haveoutputfunction").bool_value ();
1079 if (haveoutputfunction)
1080 output_fcn =
options.getfield(
"OutputFcn").function_value ();
1083 bool haveoutputsel =
options.getfield(
"haveoutputselection").bool_value ();
1086 outputsel =
options.getfield(
"OutputSel").vector_value ();
1091 bool haveeventfunction
1092 =
options.getfield(
"haveeventfunction").bool_value ();
1094 if (haveeventfunction)
1095 event_fcn =
options.getfield(
"Events").function_value ();
1101 retval = dae.integrate (numt, tspan, y0, yp0, refine,
1102 haverefine, haveoutputfunction,
1103 output_fcn, haveoutputsel, outputsel,
1104 haveeventfunction, event_fcn);
1107 bool havestats =
options.getfield(
"havestats").bool_value ();
1125 #if defined (HAVE_SUNDIALS) 1139 error (
"__ode15__: odefun must be a function handle");
1145 = args(1).xvector_value (
"__ode15__: TRANGE must be a vector of numbers");
1147 int numt = tspan.
numel ();
1149 realtype t0 = tspan (0);
1152 error (
"__ode15__: TRANGE must contain at least 2 elements");
1153 else if (! tspan.
issorted () || tspan(0) == tspan(numt - 1))
1154 error (
"__ode15__: TRANGE must be strictly monotonic");
1158 = args(2).xvector_value (
"__ode15__: initial state y0 must be a vector");
1161 = args(3).xvector_value (
"__ode15__: initial state yp0 must be a vector");
1165 error (
"__ode15__: initial state y0 and yp0 must have the same length");
1166 else if (y0.
numel () < 1)
1167 error (
"__ode15__: initial state yp0 must be a vector or a scalar");
1170 if (! args(4).isstruct ())
1171 error (
"__ode15__: OPTS argument must be a structure");
1174 = args(4).xscalar_map_value (
"__ode15__: OPTS argument must be a scalar structure");
1177 return octave::do_ode15 (ida_fcn, tspan, numt, t0, y0, yp0,
options);
1182 octave_unused_parameter (args);
OCTINTERP_API octave_value_list feval(const std::string &name, const octave_value_list &args=octave_value_list(), int nargout=0)
void resize(octave_idx_type nr, octave_idx_type nc, double rfv=0)
OCTINTERP_API void print_usage(void)
identity matrix If supplied two scalar respectively For allows like xample val
void error(const char *fmt,...)
T & elem(octave_idx_type n)
OCTAVE_EXPORT octave_value_list return the number of command line arguments passed to Octave If called with the optional argument the function t
static void initialize(void)
sortmode issorted(sortmode mode=UNSORTED) const
Ordering is auto-detected or can be specified.
bool is_function_handle(void) const
octave_function * function_value(bool silent=false) const
void err_user_supplied_eval(const char *name)
OCTAVE_EXPORT octave_value_list isa nd deftypefn *return ovl(args(0).isinteger())
OCTAVE_EXPORT octave_value_list only variables visible in the local scope are displayed The following are valid options
Cell cell_value(void) const
octave_idx_type length(void) const
the element is set to zero In other the statement xample y
void resize(octave_idx_type n, const octave_value &rfv=octave_value())
#define DEFUN_DLD(name, args_name, nargout_name, doc)
Macro to define an at run time dynamically loadable builtin function.
octave_idx_type numel(void) const
Number of elements in the array.
void err_disabled_feature(const std::string &fcn, const std::string &feature, const std::string &pkg)
If this string is the system will ring the terminal sometimes it is useful to be able to print the original representation of the string
F77_RET_T const F77_REAL const F77_REAL F77_REAL &F77_RET_T const F77_DBLE const F77_DBLE F77_DBLE &F77_RET_T const F77_DBLE F77_DBLE &F77_RET_T const F77_REAL F77_REAL &F77_RET_T const F77_DBLE * x
void resize(octave_idx_type n, const double &rfv=0)