]> Creatis software - CreaPhase.git/blob - octave_packages/odepkg-0.8.2/ode23d.m
Add a useful package (from Source forge) for octave
[CreaPhase.git] / octave_packages / odepkg-0.8.2 / ode23d.m
1 %# Copyright (C) 2008-2012, Thomas Treichl <treichl@users.sourceforge.net>
2 %# OdePkg - A package for solving ordinary differential equations and more
3 %#
4 %# This program is free software; you can redistribute it and/or modify
5 %# it under the terms of the GNU General Public License as published by
6 %# the Free Software Foundation; either version 2 of the License, or
7 %# (at your option) any later version.
8 %#
9 %# This program is distributed in the hope that it will be useful,
10 %# but WITHOUT ANY WARRANTY; without even the implied warranty of
11 %# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
12 %# GNU General Public License for more details.
13 %#
14 %# You should have received a copy of the GNU General Public License
15 %# along with this program; If not, see <http://www.gnu.org/licenses/>.
16
17 %# -*- texinfo -*-
18 %# @deftypefn  {Function File} {[@var{}] =} ode23d (@var{@@fun}, @var{slot}, @var{init}, @var{lags}, @var{hist}, [@var{opt}], [@var{par1}, @var{par2}, @dots{}])
19 %# @deftypefnx {Command} {[@var{sol}] =} ode23d (@var{@@fun}, @var{slot}, @var{init}, @var{lags}, @var{hist}, [@var{opt}], [@var{par1}, @var{par2}, @dots{}])
20 %# @deftypefnx {Command} {[@var{t}, @var{y}, [@var{xe}, @var{ye}, @var{ie}]] =} ode23d (@var{@@fun}, @var{slot}, @var{init}, @var{lags}, @var{hist}, [@var{opt}], [@var{par1}, @var{par2}, @dots{}])
21 %#
22 %# This function file can be used to solve a set of non--stiff delay differential equations (non--stiff DDEs) with a modified version of the well known explicit Runge--Kutta method of order (2,3).
23 %#
24 %# If this function is called with no return argument then plot the solution over time in a figure window while solving the set of DDEs that are defined in a function and specified by the function handle @var{@@fun}. The second input argument @var{slot} is a double vector that defines the time slot, @var{init} is a double vector that defines the initial values of the states, @var{lags} is a double vector that describes the lags of time, @var{hist} is a double matrix and describes the history of the DDEs, @var{opt} can optionally be a structure array that keeps the options created with the command @command{odeset} and @var{par1}, @var{par2}, @dots{} can optionally be other input arguments of any type that have to be passed to the function defined by @var{@@fun}.
25 %#
26 %# In other words, this function will solve a problem of the form
27 %# @example
28 %# dy/dt = fun (t, y(t), y(t-lags(1), y(t-lags(2), @dots{})))
29 %# y(slot(1)) = init
30 %# y(slot(1)-lags(1)) = hist(1), y(slot(1)-lags(2)) = hist(2), @dots{} 
31 %# @end example
32 %#
33 %# If this function is called with one return argument then return the solution @var{sol} of type structure array after solving the set of DDEs. The solution @var{sol} has the fields @var{x} of type double column vector for the steps chosen by the solver, @var{y} of type double column vector for the solutions at each time step of @var{x}, @var{solver} of type string for the solver name and optionally the extended time stamp information @var{xe}, the extended solution information @var{ye} and the extended index information @var{ie} all of type double column vector that keep the informations of the event function if an event function handle is set in the option argument @var{opt}.
34 %#
35 %# If this function is called with more than one return argument then return the time stamps @var{t}, the solution values @var{y} and optionally the extended time stamp information @var{xe}, the extended solution information @var{ye} and the extended index information @var{ie} all of type double column vector.
36 %#
37 %# For example:
38 %# @itemize @minus
39 %# @item
40 %# the following code solves an anonymous implementation of a chaotic behavior
41 %#
42 %# @example
43 %# fcao = @@(vt, vy, vz) [2 * vz / (1 + vz^9.65) - vy];
44 %#
45 %# vopt = odeset ("NormControl", "on", "RelTol", 1e-3);
46 %# vsol = ode23d (fcao, [0, 100], 0.5, 2, 0.5, vopt);
47 %#
48 %# vlag = interp1 (vsol.x, vsol.y, vsol.x - 2);
49 %# plot (vsol.y, vlag); legend ("fcao (t,y,z)");
50 %# @end example
51 %#
52 %# @item
53 %# to solve the following problem with two delayed state variables
54 %#
55 %# @example
56 %# d y1(t)/dt = -y1(t)
57 %# d y2(t)/dt = -y2(t) + y1(t-5)
58 %# d y3(t)/dt = -y3(t) + y2(t-10)*y1(t-10)
59 %# @end example
60 %#
61 %# one might do the following
62 %#
63 %# @example
64 %# function f = fun (t, y, yd)
65 %# f(1) = -y(1);                   %% y1' = -y1(t)
66 %# f(2) = -y(2) + yd(1,1);         %% y2' = -y2(t) + y1(t-lags(1))
67 %# f(3) = -y(3) + yd(2,2)*yd(1,2); %% y3' = -y3(t) + y2(t-lags(2))*y1(t-lags(2))
68 %# endfunction
69 %# T = [0,20]
70 %# res = ode23d (@@fun, T, [1;1;1], [5, 10], ones (3,2));
71 %# @end example
72 %#
73 %# @end itemize
74 %# @end deftypefn
75 %#
76 %# @seealso{odepkg}
77
78 function [varargout] = ode23d (vfun, vslot, vinit, vlags, vhist, varargin)
79
80   if (nargin == 0) %# Check number and types of all input arguments
81     help ('ode23d');
82     error ('OdePkg:InvalidArgument', ...
83       'Number of input arguments must be greater than zero');
84
85   elseif (nargin < 5)
86     print_usage;
87
88   elseif (~isa (vfun, 'function_handle'))
89     error ('OdePkg:InvalidArgument', ...
90       'First input argument must be a valid function handle');
91
92   elseif (~isvector (vslot) || length (vslot) < 2)
93     error ('OdePkg:InvalidArgument', ...
94       'Second input argument must be a valid vector');
95
96   elseif (~isvector (vinit) || ~isnumeric (vinit))
97     error ('OdePkg:InvalidArgument', ...
98       'Third input argument must be a valid numerical value');
99
100   elseif (~isvector (vlags) || ~isnumeric (vlags))
101     error ('OdePkg:InvalidArgument', ...
102       'Fourth input argument must be a valid numerical value');
103
104   elseif ~(isnumeric (vhist) || isa (vhist, 'function_handle'))
105     error ('OdePkg:InvalidArgument', ...
106       'Fifth input argument must either be numeric or a function handle');
107
108   elseif (nargin >= 6)
109
110     if (~isstruct (varargin{1}))
111       %# varargin{1:len} are parameters for vfun
112       vodeoptions = odeset;
113       vfunarguments = varargin;
114
115     elseif (length (varargin) > 1)
116       %# varargin{1} is an OdePkg options structure vopt
117       vodeoptions = odepkg_structure_check (varargin{1}, 'ode23d');
118       vfunarguments = {varargin{2:length(varargin)}};
119
120     else %# if (isstruct (varargin{1}))
121       vodeoptions = odepkg_structure_check (varargin{1}, 'ode23d');
122       vfunarguments = {};
123
124     end
125
126   else %# if (nargin == 5)
127     vodeoptions = odeset; 
128     vfunarguments = {};
129   end
130
131   %# Start preprocessing, have a look which options have been set in
132   %# vodeoptions. Check if an invalid or unused option has been set and
133   %# print warnings.
134   vslot = vslot(:)'; %# Create a row vector
135   vinit = vinit(:)'; %# Create a row vector
136   vlags = vlags(:)'; %# Create a row vector
137
138   %# Check if the user has given fixed points of time
139   if (length (vslot) > 2), vstepsizegiven = true; %# Step size checking
140   else vstepsizegiven = false; end  
141
142   %# Get the default options that can be set with 'odeset' temporarily
143   vodetemp = odeset;
144
145   %# Implementation of the option RelTol has been finished. This option
146   %# can be set by the user to another value than default value.
147   if (isempty (vodeoptions.RelTol) && ~vstepsizegiven)
148     vodeoptions.RelTol = 1e-6;
149     warning ('OdePkg:InvalidOption', ...
150       'Option "RelTol" not set, new value %f is used', vodeoptions.RelTol);
151   elseif (~isempty (vodeoptions.RelTol) && vstepsizegiven)
152     warning ('OdePkg:InvalidOption', ...
153       'Option "RelTol" will be ignored if fixed time stamps are given');
154   %# This implementation has been added to odepkg_structure_check.m
155   %# elseif (~isscalar (vodeoptions.RelTol) && ~vstepsizegiven)
156   %# error ('OdePkg:InvalidOption', ...
157   %#   'Option "RelTol" must be set to a scalar value for this solver');
158   end
159
160   %# Implementation of the option AbsTol has been finished. This option
161   %# can be set by the user to another value than default value.
162   if (isempty (vodeoptions.AbsTol) && ~vstepsizegiven)
163     vodeoptions.AbsTol = 1e-6;
164     warning ('OdePkg:InvalidOption', ...
165       'Option "AbsTol" not set, new value %f is used', vodeoptions.AbsTol);
166   elseif (~isempty (vodeoptions.AbsTol) && vstepsizegiven)
167     warning ('OdePkg:InvalidOption', ...
168       'Option "AbsTol" will be ignored if fixed time stamps are given');
169   else %# create column vector
170     vodeoptions.AbsTol = vodeoptions.AbsTol(:);
171   end
172
173   %# Implementation of the option NormControl has been finished. This
174   %# option can be set by the user to another value than default value.
175   if (strcmp (vodeoptions.NormControl, 'on')), vnormcontrol = true;
176   else vnormcontrol = false;
177   end
178
179   %# Implementation of the option NonNegative has been finished. This
180   %# option can be set by the user to another value than default value.
181   if (~isempty (vodeoptions.NonNegative))
182     if (isempty (vodeoptions.Mass)), vhavenonnegative = true;
183     else
184       vhavenonnegative = false;
185       warning ('OdePkg:InvalidOption', ...
186         'Option "NonNegative" will be ignored if mass matrix is set');
187     end
188   else vhavenonnegative = false;
189   end
190
191   %# Implementation of the option OutputFcn has been finished. This
192   %# option can be set by the user to another value than default value.
193   if (isempty (vodeoptions.OutputFcn) && nargout == 0)
194     vodeoptions.OutputFcn = @odeplot;
195     vhaveoutputfunction = true;
196   elseif (isempty (vodeoptions.OutputFcn)), vhaveoutputfunction = false;
197   else vhaveoutputfunction = true;
198   end
199
200   %# Implementation of the option OutputSel has been finished. This
201   %# option can be set by the user to another value than default value.
202   if (~isempty (vodeoptions.OutputSel)), vhaveoutputselection = true;
203   else vhaveoutputselection = false; end
204
205   %# Implementation of the option Refine has been finished. This option
206   %# can be set by the user to another value than default value.
207   if (isequal (vodeoptions.Refine, vodetemp.Refine)), vhaverefine = true;
208   else vhaverefine = false; end
209
210   %# Implementation of the option Stats has been finished. This option
211   %# can be set by the user to another value than default value.
212
213   %# Implementation of the option InitialStep has been finished. This
214   %# option can be set by the user to another value than default value.
215   if (isempty (vodeoptions.InitialStep) && ~vstepsizegiven)
216     vodeoptions.InitialStep = abs (vslot(1,1) - vslot(1,2)) / 10;
217     vodeoptions.InitialStep = vodeoptions.InitialStep / 10^vodeoptions.Refine;
218     warning ('OdePkg:InvalidOption', ...
219       'Option "InitialStep" not set, new value %f is used', vodeoptions.InitialStep);
220   end
221
222   %# Implementation of the option MaxStep has been finished. This option
223   %# can be set by the user to another value than default value.
224   if (isempty (vodeoptions.MaxStep) && ~vstepsizegiven)
225     vodeoptions.MaxStep = abs (vslot(1,1) - vslot(1,length (vslot))) / 10;
226     %# vodeoptions.MaxStep = vodeoptions.MaxStep / 10^vodeoptions.Refine;
227     warning ('OdePkg:InvalidOption', ...
228       'Option "MaxStep" not set, new value %f is used', vodeoptions.MaxStep);
229   end
230
231   %# Implementation of the option Events has been finished. This option
232   %# can be set by the user to another value than default value.
233   if (~isempty (vodeoptions.Events)), vhaveeventfunction = true;
234   else vhaveeventfunction = false; end
235
236   %# The options 'Jacobian', 'JPattern' and 'Vectorized' will be ignored
237   %# by this solver because this solver uses an explicit Runge-Kutta
238   %# method and therefore no Jacobian calculation is necessary
239   if (~isequal (vodeoptions.Jacobian, vodetemp.Jacobian))
240     warning ('OdePkg:InvalidOption', ...
241       'Option "Jacobian" will be ignored by this solver');
242   end
243   if (~isequal (vodeoptions.JPattern, vodetemp.JPattern))
244     warning ('OdePkg:InvalidOption', ...
245       'Option "JPattern" will be ignored by this solver');
246   end
247   if (~isequal (vodeoptions.Vectorized, vodetemp.Vectorized))
248     warning ('OdePkg:InvalidOption', ...
249       'Option "Vectorized" will be ignored by this solver');
250   end
251   if (~isequal (vodeoptions.NewtonTol, vodetemp.NewtonTol))
252     warning ('OdePkg:InvalidArgument', ...
253       'Option "NewtonTol" will be ignored by this solver');
254   end
255   if (~isequal (vodeoptions.MaxNewtonIterations,...
256                 vodetemp.MaxNewtonIterations))
257     warning ('OdePkg:InvalidArgument', ...
258       'Option "MaxNewtonIterations" will be ignored by this solver');
259   end
260
261   %# Implementation of the option Mass has been finished. This option
262   %# can be set by the user to another value than default value.
263   if (~isempty (vodeoptions.Mass) && isnumeric (vodeoptions.Mass))
264     vhavemasshandle = false; vmass = vodeoptions.Mass; %# constant mass
265   elseif (isa (vodeoptions.Mass, 'function_handle'))
266     vhavemasshandle = true; %# mass defined by a function handle
267   else %# no mass matrix - creating a diag-matrix of ones for mass
268     vhavemasshandle = false; %# vmass = diag (ones (length (vinit), 1), 0);
269   end
270
271   %# Implementation of the option MStateDependence has been finished.
272   %# This option can be set by the user to another value than default
273   %# value. 
274   if (strcmp (vodeoptions.MStateDependence, 'none'))
275     vmassdependence = false;
276   else vmassdependence = true;
277   end
278
279   %# Other options that are not used by this solver. Print a warning
280   %# message to tell the user that the option(s) is/are ignored.
281   if (~isequal (vodeoptions.MvPattern, vodetemp.MvPattern))
282     warning ('OdePkg:InvalidOption', ...
283       'Option "MvPattern" will be ignored by this solver');
284   end
285   if (~isequal (vodeoptions.MassSingular, vodetemp.MassSingular))
286     warning ('OdePkg:InvalidOption', ...
287       'Option "MassSingular" will be ignored by this solver');
288   end
289   if (~isequal (vodeoptions.InitialSlope, vodetemp.InitialSlope))
290     warning ('OdePkg:InvalidOption', ...
291       'Option "InitialSlope" will be ignored by this solver');
292   end
293   if (~isequal (vodeoptions.MaxOrder, vodetemp.MaxOrder))
294     warning ('OdePkg:InvalidOption', ...
295       'Option "MaxOrder" will be ignored by this solver');
296   end
297   if (~isequal (vodeoptions.BDF, vodetemp.BDF))
298     warning ('OdePkg:InvalidOption', ...
299       'Option "BDF" will be ignored by this solver');
300   end
301
302   %# Starting the initialisation of the core solver ode23d 
303   vtimestamp  = vslot(1,1);           %# timestamp = start time
304   vtimelength = length (vslot);       %# length needed if fixed steps
305   vtimestop   = vslot(1,vtimelength); %# stop time = last value
306
307   if (~vstepsizegiven)
308     vstepsize = vodeoptions.InitialStep;
309     vminstepsize = (vtimestop - vtimestamp) / (1/eps);
310   else %# If step size is given then use the fixed time steps
311     vstepsize = abs (vslot(1,1) - vslot(1,2));
312     vminstepsize = eps; %# vslot(1,2) - vslot(1,1) - eps;
313   end
314
315   vretvaltime = vtimestamp; %# first timestamp output
316   if (vhaveoutputselection) %# first solution output
317     vretvalresult = vinit(vodeoptions.OutputSel);
318   else vretvalresult = vinit;
319   end
320
321   %# Initialize the OutputFcn
322   if (vhaveoutputfunction)
323     feval (vodeoptions.OutputFcn, vslot', ...
324       vretvalresult', 'init', vfunarguments{:});
325   end
326
327   %# Initialize the History
328   if (isnumeric (vhist))
329     vhmat = vhist;
330     vhavehistnumeric = true;
331   else %# it must be a function handle
332     for vcnt = 1:length (vlags);
333       vhmat(:,vcnt) = feval (vhist, (vslot(1)-vlags(vcnt)), vfunarguments{:});
334     end
335     vhavehistnumeric = false;
336   end
337
338   %# Initialize DDE variables for history calculation
339   vsaveddetime = [vtimestamp - vlags, vtimestamp]';
340   vsaveddeinput = [vhmat, vinit']';
341   vsavedderesult = [vhmat, vinit']';
342
343   %# Initialize the EventFcn
344   if (vhaveeventfunction)
345     odepkg_event_handle (vodeoptions.Events, vtimestamp, ...
346       {vretvalresult', vhmat}, 'init', vfunarguments{:});
347   end
348
349   vpow = 1/3;            %# 20071016, reported by Luis Randez
350   va = [  0, 0, 0;       %# The Runge-Kutta-Fehlberg 2(3) coefficients
351         1/2, 0, 0;       %# Coefficients proved on 20060827
352          -1, 2, 0];      %# See p.91 in Ascher & Petzold
353   vb2 = [0; 1; 0];       %# 2nd and 3rd order
354   vb3 = [1/6; 2/3; 1/6]; %# b-coefficients
355   vc = sum (va, 2);
356
357   %# The solver main loop - stop if the endpoint has been reached
358   vcntloop = 2; vcntcycles = 1; vu = vinit; vk = vu' * zeros(1,3);
359   vcntiter = 0; vunhandledtermination = true;
360   while ((vtimestamp < vtimestop && vstepsize >= vminstepsize))
361
362     %# Hit the endpoint of the time slot exactely
363     if ((vtimestamp + vstepsize) > vtimestop)
364       vstepsize = vtimestop - vtimestamp; end
365
366     %# Estimate the three results when using this solver
367     for j = 1:3
368       vthetime  = vtimestamp + vc(j,1) * vstepsize;
369       vtheinput = vu' + vstepsize * vk(:,1:j-1) * va(j,1:j-1)';
370       %# Claculate the history values (or get them from an external
371       %# function) that are needed for the next step of solving
372       if (vhavehistnumeric)
373         for vcnt = 1:length (vlags)
374           %# Direct implementation of a 'quadrature cubic Hermite interpolation'
375           %# found at the Faculty for Mathematics of the University of Stuttgart
376           %# http://mo.mathematik.uni-stuttgart.de/inhalt/aussage/aussage1269
377           vnumb = find (vthetime - vlags(vcnt) >= vsaveddetime);
378           velem = min (vnumb(end), length (vsaveddetime) - 1);
379           vstep = vsaveddetime(velem+1) - vsaveddetime(velem);
380           vdiff = (vthetime - vlags(vcnt) - vsaveddetime(velem)) / vstep;
381           vsubs = 1 - vdiff;
382           %# Calculation of the coefficients for the interpolation algorithm
383           vua = (1 + 2 * vdiff) * vsubs^2;
384           vub = (3 - 2 * vdiff) * vdiff^2;
385           vva = vstep * vdiff * vsubs^2;
386           vvb = -vstep * vsubs * vdiff^2;
387           vhmat(:,vcnt) = vua * vsaveddeinput(velem,:)' + ...
388               vub * vsaveddeinput(velem+1,:)' + ...
389               vva * vsavedderesult(velem,:)' + ...
390               vvb * vsavedderesult(velem+1,:)';
391         end
392       else %# the history must be a function handle
393         for vcnt = 1:length (vlags)
394           vhmat(:,vcnt) = feval ...
395             (vhist, vthetime - vlags(vcnt), vfunarguments{:});
396         end
397       end
398
399       if (vhavemasshandle)   %# Handle only the dynamic mass matrix,
400         if (vmassdependence) %# constant mass matrices have already
401           vmass = feval ...  %# been set before (if any)
402             (vodeoptions.Mass, vthetime, vtheinput, vfunarguments{:});
403         else                 %# if (vmassdependence == false)
404           vmass = feval ...  %# then we only have the time argument
405             (vodeoptions.Mass, vthetime, vfunarguments{:});
406         end
407         vk(:,j) = vmass \ feval ...
408           (vfun, vthetime, vtheinput, vhmat, vfunarguments{:});
409       else
410         vk(:,j) = feval ...
411           (vfun, vthetime, vtheinput, vhmat, vfunarguments{:});
412       end
413     end
414
415     %# Compute the 2nd and the 3rd order estimation
416     y2 = vu' + vstepsize * (vk * vb2);
417     y3 = vu' + vstepsize * (vk * vb3);
418     if (vhavenonnegative)
419       vu(vodeoptions.NonNegative) = abs (vu(vodeoptions.NonNegative));
420       y2(vodeoptions.NonNegative) = abs (y2(vodeoptions.NonNegative));
421       y3(vodeoptions.NonNegative) = abs (y3(vodeoptions.NonNegative));
422     end
423     vSaveVUForRefine = vu;
424
425     %# Calculate the absolute local truncation error and the acceptable error
426     if (~vstepsizegiven)
427       if (~vnormcontrol)
428         vdelta = y3 - y2;
429         vtau = max (vodeoptions.RelTol * vu', vodeoptions.AbsTol);
430       else
431         vdelta = norm (y3 - y2, Inf);
432         vtau = max (vodeoptions.RelTol * max (norm (vu', Inf), 1.0), ...
433                     vodeoptions.AbsTol);
434       end
435     else %# if (vstepsizegiven == true)
436       vdelta = 1; vtau = 2;
437     end
438
439     %# If the error is acceptable then update the vretval variables
440     if (all (vdelta <= vtau))
441       vtimestamp = vtimestamp + vstepsize;
442       vu = y3'; %# MC2001: the higher order estimation as "local extrapolation"
443       vretvaltime(vcntloop,:) = vtimestamp;
444       if (vhaveoutputselection)
445         vretvalresult(vcntloop,:) = vu(vodeoptions.OutputSel);
446       else
447         vretvalresult(vcntloop,:) = vu;
448       end
449       vcntloop = vcntloop + 1; vcntiter = 0;
450
451       %# Update DDE values for next history calculation      
452       vsaveddetime(end+1) = vtimestamp;
453       vsaveddeinput(end+1,:) = vtheinput';
454       vsavedderesult(end+1,:) = vu;
455
456       %# Call plot only if a valid result has been found, therefore this
457       %# code fragment has moved here. Stop integration if plot function
458       %# returns false
459       if (vhaveoutputfunction)
460         if (vhaverefine)                  %# Do interpolation
461           for vcnt = 0:vodeoptions.Refine %# Approximation between told and t
462             vapproxtime = (vcnt + 1) * vstepsize / (vodeoptions.Refine + 2);
463             vapproxvals = vSaveVUForRefine' + vapproxtime * (vk * vb3);
464             if (vhaveoutputselection)
465               vapproxvals = vapproxvals(vodeoptions.OutputSel);
466             end
467             feval (vodeoptions.OutputFcn, (vtimestamp - vstepsize) + vapproxtime, ...
468               vapproxvals, [], vfunarguments{:});
469           end
470         end
471         vpltret = feval (vodeoptions.OutputFcn, vtimestamp, ...
472           vretvalresult(vcntloop-1,:)', [], vfunarguments{:});
473         if (vpltret), vunhandledtermination = false; break; end
474       end
475
476       %# Call event only if a valid result has been found, therefore this
477       %# code fragment has moved here. Stop integration if veventbreak is
478       %# true
479       if (vhaveeventfunction)
480         vevent = ...
481           odepkg_event_handle (vodeoptions.Events, vtimestamp, ...
482             {vu(:), vhmat}, [], vfunarguments{:});
483         if (~isempty (vevent{1}) && vevent{1} == 1)
484           vretvaltime(vcntloop-1,:) = vevent{3}(end,:);
485           vretvalresult(vcntloop-1,:) = vevent{4}(end,:);
486           vunhandledtermination = false; break;
487         end
488       end
489     end %# If the error is acceptable ...
490
491     %# Update the step size for the next integration step
492     if (~vstepsizegiven)
493       %# vdelta may be 0 or even negative - could be an iteration problem
494       vdelta = max (vdelta, eps); 
495       vstepsize = min (vodeoptions.MaxStep, ...
496         min (0.8 * vstepsize * (vtau ./ vdelta) .^ vpow));
497     elseif (vstepsizegiven)
498       if (vcntloop < vtimelength)
499         vstepsize = vslot(1,vcntloop-1) - vslot(1,vcntloop-2);
500       end
501     end
502
503     %# Update counters that count the number of iteration cycles
504     vcntcycles = vcntcycles + 1; %# Needed for postprocessing
505     vcntiter = vcntiter + 1;     %# Needed to find iteration problems
506
507     %# Stop solving because the last 1000 steps no successful valid
508     %# value has been found
509     if (vcntiter >= 5000)
510       error (['Solving has not been successful. The iterative', ...
511         ' integration loop exited at time t = %f before endpoint at', ...
512         ' tend = %f was reached. This happened because the iterative', ...
513         ' integration loop does not find a valid solution at this time', ...
514         ' stamp. Try to reduce the value of "InitialStep" and/or', ...
515         ' "MaxStep" with the command "odeset".\n'], vtimestamp, vtimestop);
516     end
517
518   end %# The main loop
519
520   %# Check if integration of the ode has been successful
521   if (vtimestamp < vtimestop)
522     if (vunhandledtermination == true)
523       error (['Solving has not been successful. The iterative', ...
524         ' integration loop exited at time t = %f', ...
525         ' before endpoint at tend = %f was reached. This may', ...
526         ' happen if the stepsize grows smaller than defined in', ...
527         ' vminstepsize. Try to reduce the value of "InitialStep" and/or', ...
528         ' "MaxStep" with the command "odeset".\n'], vtimestamp, vtimestop);
529     else
530       warning ('OdePkg:HideWarning', ...
531         ['Solver has been stopped by a call of "break" in', ...
532          ' the main iteration loop at time t = %f before endpoint at', ...
533          ' tend = %f was reached. This may happen because the @odeplot', ...
534          ' function returned "true" or the @event function returned "true".'], ...
535          vtimestamp, vtimestop);
536     end
537   end
538
539   %# Postprocessing, do whatever when terminating integration algorithm
540   if (vhaveoutputfunction) %# Cleanup plotter
541     feval (vodeoptions.OutputFcn, vtimestamp, ...
542       vretvalresult(vcntloop-1,:)', 'done', vfunarguments{:});
543   end
544   if (vhaveeventfunction)  %# Cleanup event function handling
545     odepkg_event_handle (vodeoptions.Events, vtimestamp, ...
546       {vretvalresult(vcntloop-1,:), vhmat}, 'done', vfunarguments{:});
547   end
548
549   %# Print additional information if option Stats is set
550   if (strcmp (vodeoptions.Stats, 'on'))
551     vhavestats = true;
552     vnsteps    = vcntloop-2;                    %# vcntloop from 2..end
553     vnfailed   = (vcntcycles-1)-(vcntloop-2)+1; %# vcntcycl from 1..end
554     vnfevals   = 3*(vcntcycles-1);              %# number of ode evaluations
555     vndecomps  = 0;                             %# number of LU decompositions
556     vnpds      = 0;                             %# number of partial derivatives
557     vnlinsols  = 0;                             %# no. of solutions of linear systems
558     %# Print cost statistics if no output argument is given
559     if (nargout == 0)
560       vmsg = fprintf (1, 'Number of successful steps: %d', vnsteps);
561       vmsg = fprintf (1, 'Number of failed attempts:  %d', vnfailed);
562       vmsg = fprintf (1, 'Number of function calls:   %d', vnfevals);
563     end
564   else vhavestats = false;
565   end
566
567   if (nargout == 1)                 %# Sort output variables, depends on nargout
568     varargout{1}.x = vretvaltime;   %# Time stamps are saved in field x
569     varargout{1}.y = vretvalresult; %# Results are saved in field y
570     varargout{1}.solver = 'ode23d'; %# Solver name is saved in field solver
571     if (vhaveeventfunction) 
572       varargout{1}.ie = vevent{2};  %# Index info which event occured
573       varargout{1}.xe = vevent{3};  %# Time info when an event occured
574       varargout{1}.ye = vevent{4};  %# Results when an event occured
575     end
576     if (vhavestats)
577       varargout{1}.stats = struct;
578       varargout{1}.stats.nsteps   = vnsteps;
579       varargout{1}.stats.nfailed  = vnfailed;
580       varargout{1}.stats.nfevals  = vnfevals;
581       varargout{1}.stats.npds     = vnpds;
582       varargout{1}.stats.ndecomps = vndecomps;
583       varargout{1}.stats.nlinsols = vnlinsols;
584     end
585   elseif (nargout == 2)
586     varargout{1} = vretvaltime;     %# Time stamps are first output argument
587     varargout{2} = vretvalresult;   %# Results are second output argument
588   elseif (nargout == 5)
589     varargout{1} = vretvaltime;     %# Same as (nargout == 2)
590     varargout{2} = vretvalresult;   %# Same as (nargout == 2)
591     varargout{3} = [];              %# LabMat doesn't accept lines like
592     varargout{4} = [];              %# varargout{3} = varargout{4} = [];
593     varargout{5} = [];
594     if (vhaveeventfunction) 
595       varargout{3} = vevent{3};     %# Time info when an event occured
596       varargout{4} = vevent{4};     %# Results when an event occured
597       varargout{5} = vevent{2};     %# Index info which event occured
598     end
599   %# else nothing will be returned, varargout{1} undefined
600   end
601
602 %! # We are using a "pseudo-DDE" implementation for all tests that
603 %! # are done for this function. We also define an Events and a
604 %! # pseudo-Mass implementation. For further tests we also define a
605 %! # reference solution (computed at high accuracy) and an OutputFcn.
606 %!function [vyd] = fexp (vt, vy, vz, varargin)
607 %!  vyd(1,1) = exp (- vt) - vz(1); %# The DDEs that are
608 %!  vyd(2,1) = vy(1) - vz(2);      %# used for all examples
609 %!function [vval, vtrm, vdir] = feve (vt, vy, vz, varargin)
610 %!  vval = fexp (vt, vy, vz); %# We use the derivatives
611 %!  vtrm = zeros (2,1);       %# don't stop solving here
612 %!  vdir = ones (2,1);        %# in positive direction
613 %!function [vval, vtrm, vdir] = fevn (vt, vy, vz, varargin)
614 %!  vval = fexp (vt, vy, vz); %# We use the derivatives
615 %!  vtrm = ones (2,1);        %# stop solving here
616 %!  vdir = ones (2,1);        %# in positive direction
617 %!function [vmas] = fmas (vt, vy, vz, varargin)
618 %!  vmas =  [1, 0; 0, 1];     %# Dummy mass matrix for tests
619 %!function [vmas] = fmsa (vt, vy, vz, varargin)
620 %!  vmas = sparse ([1, 0; 0, 1]); %# A dummy sparse matrix
621 %!function [vref] = fref ()       %# The reference solution
622 %!  vref = [0.12194462133618, 0.01652432423938];
623 %!function [vout] = fout (vt, vy, vflag, varargin)
624 %!  if (regexp (char (vflag), 'init') == 1)
625 %!    if (any (size (vt) ~= [2, 1])) error ('"fout" step "init"'); end
626 %!  elseif (isempty (vflag))
627 %!    if (any (size (vt) ~= [1, 1])) error ('"fout" step "calc"'); end
628 %!    vout = false;
629 %!  elseif (regexp (char (vflag), 'done') == 1)
630 %!    if (any (size (vt) ~= [1, 1])) error ('"fout" step "done"'); end
631 %!  else error ('"fout" invalid vflag');
632 %!  end
633 %!
634 %! %# Turn off output of warning messages for all tests, turn them on
635 %! %# again if the last test is called
636 %!error %# input argument number one
637 %!  warning ('off', 'OdePkg:InvalidOption');
638 %!  B = ode23d (1, [0 5], [1; 0], 1, [1; 0]);
639 %!error %# input argument number two
640 %!  B = ode23d (@fexp, 1, [1; 0], 1, [1; 0]);
641 %!error %# input argument number three
642 %!  B = ode23d (@fexp, [0 5], 1, 1, [1; 0]);
643 %!error %# input argument number four
644 %!  B = ode23d (@fexp, [0 5], [1; 0], [1; 1], [1; 0]);
645 %!error %# input argument number five
646 %!  B = ode23d (@fexp, [0 5], [1; 0], 1, 1);
647 %!test %# one output argument
648 %!  vsol = ode23d (@fexp, [0 5], [1; 0], 1, [1; 0]);
649 %!  assert ([vsol.x(end), vsol.y(end,:)], [5, fref], 1e-1);
650 %!  assert (isfield (vsol, 'solver'));
651 %!  assert (vsol.solver, 'ode23d');
652 %!test %# two output arguments
653 %!  [vt, vy] = ode23d (@fexp, [0 5], [1; 0], 1, [1; 0]);
654 %!  assert ([vt(end), vy(end,:)], [5, fref], 1e-1);
655 %!test %# five output arguments and no Events
656 %!  [vt, vy, vxe, vye, vie] = ode23d (@fexp, [0 5], [1; 0], 1, [1; 0]);
657 %!  assert ([vt(end), vy(end,:)], [5, fref], 1e-1);
658 %!  assert ([vie, vxe, vye], []);
659 %!test %# anonymous function instead of real function
660 %!  faym = @(vt, vy, vz) [exp(-vt) - vz(1); vy(1) - vz(2)];
661 %!  vsol = ode23d (faym, [0 5], [1; 0], 1, [1; 0]);
662 %!  assert ([vsol.x(end), vsol.y(end,:)], [5, fref], 1e-1);
663 %!test %# extra input arguments passed trhough
664 %!  vsol = ode23d (@fexp, [0 5], [1; 0], 1, [1; 0], 'KL');
665 %!  assert ([vsol.x(end), vsol.y(end,:)], [5, fref], 1e-1);
666 %!test %# empty OdePkg structure *but* extra input arguments
667 %!  vopt = odeset;
668 %!  vsol = ode23d (@fexp, [0 5], [1; 0], 1, [1; 0], vopt, 12, 13, 'KL');
669 %!  assert ([vsol.x(end), vsol.y(end,:)], [5, fref], 1e-1);
670 %!error %# strange OdePkg structure
671 %!  vopt = struct ('foo', 1);
672 %!  vsol = ode23d (@fexp, [0 5], [1; 0], 1, [1; 0], vopt);
673 %!test %# AbsTol option
674 %!  vopt = odeset ('AbsTol', 1e-5);
675 %!  vsol = ode23d (@fexp, [0 5], [1; 0], 1, [1; 0], vopt);
676 %!  assert ([vsol.x(end), vsol.y(end,:)], [5, fref], 1e-1);
677 %!test %# AbsTol and RelTol option
678 %!  vopt = odeset ('AbsTol', 1e-7, 'RelTol', 1e-7);
679 %!  vsol = ode23d (@fexp, [0 5], [1; 0], 1, [1; 0], vopt);
680 %!  assert ([vsol.x(end), vsol.y(end,:)], [5, fref], 1e-1);
681 %!test %# RelTol and NormControl option
682 %!  vopt = odeset ('AbsTol', 1e-7, 'NormControl', 'on');
683 %!  vsol = ode23d (@fexp, [0 5], [1; 0], 1, [1; 0], vopt);
684 %!  assert ([vsol.x(end), vsol.y(end,:)], [5, fref], .5e-1);
685 %!test %# NonNegative for second component
686 %!  vopt = odeset ('NonNegative', 1);
687 %!  vsol = ode23d (@fexp, [0 2.5], [1; 0], 1, [1; 0], vopt);
688 %!  assert ([vsol.x(end), vsol.y(end,:)], [2.5, 0.001, 0.237], 1e-1);
689 %!test %# Details of OutputSel and Refine can't be tested
690 %!  vopt = odeset ('OutputFcn', @fout, 'OutputSel', 1, 'Refine', 5);
691 %!  vsol = ode23d (@fexp, [0 2.5], [1; 0], 1, [1; 0], vopt);
692 %!test %# Stats must add further elements in vsol
693 %!  vopt = odeset ('Stats', 'on');
694 %!  vsol = ode23d (@fexp, [0 2.5], [1; 0], 1, [1; 0], vopt);
695 %!  assert (isfield (vsol, 'stats'));
696 %!  assert (isfield (vsol.stats, 'nsteps'));
697 %!test %# InitialStep option
698 %!  vopt = odeset ('InitialStep', 1e-8);
699 %!  vsol = ode23d (@fexp, [0 5], [1; 0], 1, [1; 0], vopt);
700 %!  assert ([vsol.x(end), vsol.y(end,:)], [5, fref], 1e-1);
701 %!test %# MaxStep option
702 %!  vopt = odeset ('MaxStep', 1e-2);
703 %!  vsol = ode23d (@fexp, [0 5], [1; 0], 1, [1; 0], vopt);
704 %!  assert ([vsol.x(end), vsol.y(end,:)], [5, fref], 1e-1);
705 %!test %# Events option add further elements in vsol
706 %!  vopt = odeset ('Events', @feve);
707 %!  vsol = ode23d (@fexp, [0 5], [1; 0], 1, [1; 0], vopt);
708 %!  assert (isfield (vsol, 'ie'));
709 %!  assert (vsol.ie, [1; 1]);
710 %!  assert (isfield (vsol, 'xe'));
711 %!  assert (isfield (vsol, 'ye'));
712 %!test %# Events option, now stop integration
713 %!  warning ('off', 'OdePkg:HideWarning');
714 %!  vopt = odeset ('Events', @fevn, 'NormControl', 'on');
715 %!  vsol = ode23d (@fexp, [0 5], [1; 0], 1, [1; 0], vopt);
716 %!  assert ([vsol.ie, vsol.xe, vsol.ye], ...
717 %!    [1.0000, 2.9219, -0.2127, -0.2671], 1e-1);
718 %!test %# Events option, five output arguments
719 %!  vopt = odeset ('Events', @fevn, 'NormControl', 'on');
720 %!  [vt, vy, vxe, vye, vie] = ode23d (@fexp, [0 5], [1; 0], 1, [1; 0], vopt);
721 %!  assert ([vie, vxe, vye], ...
722 %!    [1.0000, 2.9219, -0.2127, -0.2671], 1e-1);
723 %!
724 %! %# test for Jacobian option is missing
725 %! %# test for Jacobian (being a sparse matrix) is missing
726 %! %# test for JPattern option is missing
727 %! %# test for Vectorized option is missing
728 %! %# test for NewtonTol option is missing
729 %! %# test for MaxNewtonIterations option is missing
730 %!
731 %!test %# Mass option as function
732 %!  vopt = odeset ('Mass', eye (2,2));
733 %!  vsol = ode23d (@fexp, [0 5], [1; 0], 1, [1; 0], vopt);
734 %!  assert ([vsol.x(end), vsol.y(end,:)], [5, fref], 1e-1);
735 %!test %# Mass option as matrix
736 %!  vopt = odeset ('Mass', eye (2,2));
737 %!  vsol = ode23d (@fexp, [0 5], [1; 0], 1, [1; 0], vopt);
738 %!  assert ([vsol.x(end), vsol.y(end,:)], [5, fref], 1e-1);
739 %!test %# Mass option as sparse matrix
740 %!  vopt = odeset ('Mass', sparse (eye (2,2)));
741 %!  vsol = ode23d (@fexp, [0 5], [1; 0], 1, [1; 0], vopt);
742 %!  assert ([vsol.x(end), vsol.y(end,:)], [5, fref], 1e-1);
743 %!test %# Mass option as function and sparse matrix
744 %!  vopt = odeset ('Mass', @fmsa);
745 %!  vsol = ode23d (@fexp, [0 5], [1; 0], 1, [1; 0], vopt);
746 %!  assert ([vsol.x(end), vsol.y(end,:)], [5, fref], 1e-1);
747 %!test %# Mass option as function and MStateDependence
748 %!  vopt = odeset ('Mass', @fmas, 'MStateDependence', 'strong');
749 %!  vsol = ode23d (@fexp, [0 5], [1; 0], 1, [1; 0], vopt);
750 %!  assert ([vsol.x(end), vsol.y(end,:)], [5, fref], 1e-1);
751 %!test %# Set BDF option to something else than default
752 %!  vopt = odeset ('BDF', 'on');
753 %!  [vt, vy] = ode23d (@fexp, [0 5], [1; 0], 1, [1; 0], vopt);
754 %!  assert ([vt(end), vy(end,:)], [5, fref], 0.5);
755 %!
756 %! %# test for MvPattern option is missing
757 %! %# test for InitialSlope option is missing
758 %! %# test for MaxOrder option is missing
759 %!
760 %!  warning ('on', 'OdePkg:InvalidOption');
761
762 %# Local Variables: ***
763 %# mode: octave ***
764 %# End: ***