%# Copyright (C) 2015-2016, Jacopo Corno <jacopo.corno@gmail.com>
%# Copyright (C) 2008-2012, Thomas Treichl <treichl@users.sourceforge.net>
%# OdePkg - A package for solving ordinary differential equations and more
%#
%# This program is free software; you can redistribute it and/or modify
%# it under the terms of the GNU General Public License as published by
%# the Free Software Foundation; either version 2 of the License, or
%# (at your option) any later version.
%#
%# This program is distributed in the hope that it will be useful,
%# but WITHOUT ANY WARRANTY; without even the implied warranty of
%# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
%# GNU General Public License for more details.
%#
%# You should have received a copy of the GNU General Public License
%# along with this program; If not, see <http://www.gnu.org/licenses/>.

%# -*- texinfo -*-
%# @deftypefn  {} {[@var{t}, @var{y}] =} ode78d (@var{fun}, @var{trange}, @var{init}, @var{lags}, @var{history})
%# @deftypefnx {} {[@var{t}, @var{y}] =} ode78d (@var{fun}, @var{trange}, @var{init}, @var{lags}, @var{history}, @var{ode_opt})
%# @deftypefnx {} {[@var{t}, @var{y}, @var{te}, @var{ye}, @var{ie}] =} ode78d (@dots{})
%# @deftypefnx {} {@var{solution} =} ode78d (@dots{})
%#
%# 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
%# (7,8).
%#
%# @var{fun} is a function handle, inline function, or string containing the
%# name of the function that defines the ODE: @code{y' = f(t,y)}.  The function
%# must accept two inputs where the first is time @var{t} and the second is a
%# column vector of unknowns @var{y}.
%#
%# @var{trange} specifies the time interval over which the ODE will be
%# evaluated.  Typically, it is a two-element vector specifying the initial and
%# final times (@code{[tinit, tfinal]}).  If there are more than two elements
%# then the solution will also be evaluated at these intermediate time
%# instances using a Hermite interpolation of order 3.
%#
%# @var{init} contains the initial value for the unknowns.  If it is a row
%# vector then the solution @var{y} will be a matrix in which each column is
%# the solution for the corresponding initial value in @var{init}.
%#
%# @var{lags} is a vector that describes the lags of time.
%#
%# @var{history} is a matrix and describes the history of the DDEs.
%#
%# The optional fourth argument @var{ode_opt} specifies non-default options to
%# the ODE solver. It is a structure generated by @code{odeset}. @code{ode78d}
%# will ignore the following options: "BDF", "InitialSlope", "Jacobian",
%# "JPattern", "MassSingular", "MaxOrder", "MvPattern", "Vectorized".
%#
%# The function typically returns two outputs.  Variable @var{t} is a
%# column vector and contains the times where the solution was computed.  The
%# output @var{y} is a matrix in which each column refers to a different
%# unknown of the problem and each row corresponds to a time in @var{t}.  If
%# @var{trange} specifies intermediate time steps, only those will be returned.
%#
%# The output can also be returned as a structure @var{solution} which
%# has field @var{x} containing the time where the solution was evaluated and
%# field @var{y} containing the solution matrix for the times in @var{x}.
%# Use @code{fieldnames (@var{solution})} to see the other fields and
%# additional information returned.
%#
%# If using the @code{"Events"} option then three additional outputs may
%# be returned.  @var{te} holds the time when an Event function returned a
%# zero.  @var{ye} holds the value of the solution at time @var{te}.  @var{ie}
%# contains an index indicating which Event function was triggered in the case
%# of multiple Event functions.
%#
%# In other words, this function will solve a problem of the form
%# @example
%# dy/dt = fun (t, y(t), y(t-lags(1), y(t-lags(2), @dots{})))
%# y(slot(1)) = init
%# y(slot(1)-lags(1)) = hist(1), y(slot(1)-lags(2)) = hist(2), @dots{}
%# @end example
%#
%# For example:
%# @itemize @minus
%# @item
%# the following code solves an anonymous implementation of a chaotic behavior
%#
%# @example
%# fcao = @@(vt, vy, vz) [2 * vz / (1 + vz^9.65) - vy];
%#
%# vopt = odeset ("NormControl", "on", "RelTol", 1e-3);
%# vsol = ode78d (fcao, [0, 100], 0.5, 2, 0.5, vopt);
%#
%# vlag = interp1 (vsol.x, vsol.y, vsol.x - 2);
%# plot (vsol.y, vlag); legend ("fcao (t,y,z)");
%# @end example
%#
%# @item
%# to solve the following problem with two delayed state variables
%#
%# @example
%# d y1(t)/dt = -y1(t)
%# d y2(t)/dt = -y2(t) + y1(t-5)
%# d y3(t)/dt = -y3(t) + y2(t-10)*y1(t-10)
%# @end example
%#
%# one might do the following
%#
%# @example
%# function f = fun (t, y, yd)
%# f(1) = -y(1);                   %% y1' = -y1(t)
%# f(2) = -y(2) + yd(1,1);         %% y2' = -y2(t) + y1(t-lags(1))
%# f(3) = -y(3) + yd(2,2)*yd(1,2); %% y3' = -y3(t) + y2(t-lags(2))*y1(t-lags(2))
%# end
%# T = [0,20]
%# res = ode78d (@@fun, T, [1;1;1], [5, 10], ones (3,2));
%# @end example
%#
%# @end itemize
%# @seealso{odeset, ode23d, ode45d}
%# @end deftypefn

function varargout = ode78d (fun, trange, init, lags, history, varargin)

  if (nargin < 5)
    print_usage ();
  end

  order = 7;
  solver = "ode78d";

  if (nargin >= 6)
    if (! isstruct (varargin{1}))
      %# varargin{1:len} are parameters for fun
      odeopts = odeset ();
      funarguments = varargin;
    elseif (length (varargin) > 1)
      %# varargin{1} is an ODE options structure opt
      odeopts = varargin{1};
      funarguments = {varargin{2:length(varargin)}};
    else  # if (isstruct (varargin{1}))
      odeopts = varargin{1};
      funarguments = {};
    end
  else  # nargin == 3
    odeopts = odeset ();
    funarguments = {};
  end

  if (! isnumeric (trange) || ! isvector (trange))
    error ("Octave:invalid-input-arg",
           "ode78d: TRANGE must be a numeric vector");
  end

  if (length (trange) < 2)
    error ("Octave:invalid-input-arg",
           "ode78d: TRANGE must contain at least 2 elements");
  elseif (trange(2) == trange(1))
    error ("Octave:invalid-input-arg",
           "ode78d: invalid time span, TRANGE(1) == TRANGE(2)");
  else
    direction = sign (trange(2) - trange(1));
  end
  trange = trange(:)'; %# Create a row vector

  if (! isnumeric (init) || ! isvector (init))
    error ("Octave:invalid-input-arg",
           "ode78d: INIT must be a numeric vector");
  end
  init = init(:)'; %# Create a row vector

  if (ischar (fun))
    try
      fun = str2func (fun);
    catch
      warning (lasterr);
    end
  end
  if (! isa (fun, "function_handle"))
    error ("Octave:invalid-input-arg",
           "ode78d: FUN must be a valid function handle");
  end

  if (! isnumeric (lags) || ! isvector (lags))
    error ("Octave:invalid-input-arg",
      "ode78d: LAGS must be a valid numerical value");
  end
  lags = lags(:)'; %# Create a row vector

  if ! (isnumeric (history) || isa (history, "function_handle"))
    error ("Octave:invalid-input-arg",
      "ode78d: HISTORY must either be numeric or a function handle");
  end

  %# Start preprocessing, have a look which options are set in odeopts,
  %# check if an invalid or unused option is set
  [defaults, classes, attributes] = odedefaults (numel (init),
                                                 trange(1), trange(end));

  persistent ode78d_ignore_options = ...
    {"BDF", "InitialSlope", "Jacobian", "JPattern",
     "MassSingular", "MaxOrder", "MvPattern", "Vectorized"};

  defaults   = rmfield (defaults, ode78d_ignore_options);
  classes    = rmfield (classes, ode78d_ignore_options);
  attributes = rmfield (attributes, ode78d_ignore_options);

  odeopts = odemergeopts ("ode78d", odeopts, defaults, classes, attributes);

  odeopts.funarguments = funarguments;
  odeopts.direction    = direction;

  if (! isempty (odeopts.NonNegative))
    if (isempty (odeopts.Mass))
      odeopts.havenonnegative = true;
    else
      odeopts.havenonnegative = false;
      warning ("Octave:invalid-input-arg",
               ["ode78d: option \"NonNegative\" is ignored", ...
                " when mass matrix is set\n"]);
    end
  else
    odeopts.havenonnegative = false;
  end

  if (isempty (odeopts.OutputFcn) && nargout == 0)
    odeopts.OutputFcn = @odeplot;
    odeopts.haveoutputfunction = true;
  else
    odeopts.haveoutputfunction = ! isempty (odeopts.OutputFcn);
  end

  if (isempty (odeopts.InitialStep))
    if isempty (odeopts.Refine)
      odeopts.InitialStep = odeopts.MaxStep;
    else
      odeopts.InitialStep = odeopts.MaxStep / odeopts.Refine;
    end
  end
  stepsize = odeopts.InitialStep;

  if (! isempty (odeopts.Mass) && isnumeric (odeopts.Mass))
    havemasshandle = false;
    mass = odeopts.Mass;    # constant mass
  elseif (isa (odeopts.Mass, "function_handle"))
    havemasshandle = true;  # mass defined by a function handle
  else  # no mass matrix - creating a diag-matrix of ones for mass
    havemasshandle = false; # mass = diag (ones (length (init), 1), 0);
  end

  %# Starting the initialisation of the core solver ode78d
  timestamp  = trange(1,1);      %# timestamp = start time
  timestop   = trange(1,end);    %# stop time = last value
  minstepsize = (timestop - timestamp) / (1/eps);

  retvaltime = timestamp; %# first timestamp output
  if (! isempty (odeopts.OutputSel)) %# first solution output
    retvalresult = init(odeopts.OutputSel);
  else retvalresult = init;
  end

  %# Initialize the History
  if (isnumeric (history))
    hmat = history;
    havehistnumeric = true;
  else %# it must be a function handle
    for cnt = 1:length (lags);
      hmat(:,cnt) = feval (history, (trange(1)-lags(cnt)), funarguments{:});
    end
    havehistnumeric = false;
  end

  %# Initialize DDE variables for history calculation
  saveddetime = [timestamp - lags, timestamp]';
  saveddeinput = [hmat, init']';
  savedderesult = [hmat, init']';

  %# Initialize the EventFcn
  if (! isempty (odeopts.Events))
    ode_event_handler (odeopts.Events, timestamp,
                         {retvalresult', hmat}, "init",
                         funarguments{:});
  end

  pow = 1/8;                                  %# MC2001: see p.91 in Ascher & Petzold
  a = [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0;    %# The 7(8) coefficients
        1/18, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0; %# Coefficients proved, tt 20060827
        1/48, 1/16, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0; 
        1/32, 0, 3/32, 0, 0, 0, 0, 0, 0, 0, 0, 0; 
        5/16, 0, -75/64, 75/64, 0, 0, 0, 0, 0, 0, 0, 0; 
        3/80, 0, 0, 3/16, 3/20, 0, 0, 0, 0, 0, 0, 0; 
        29443841/614563906, 0, 0, 77736538/692538347, -28693883/1125000000, ...
            23124283/1800000000, 0, 0, 0, 0, 0, 0;
        16016141/946692911, 0, 0, 61564180/158732637, 22789713/633445777, ...
            545815736/2771057229, -180193667/1043307555, 0, 0, 0, 0, 0;
        39632708/573591083, 0, 0, -433636366/683701615, -421739975/2616292301, ...
            100302831/723423059, 790204164/839813087, 800635310/3783071287, 0, 0, 0, 0;
        246121993/1340847787, 0, 0, -37695042795/15268766246, -309121744/1061227803, ...
            -12992083/490766935, 6005943493/2108947869, 393006217/1396673457, ...
            123872331/1001029789, 0, 0, 0;
        -1028468189/846180014, 0, 0, 8478235783/508512852, 1311729495/1432422823, ...
            -10304129995/1701304382, -48777925059/3047939560, 15336726248/1032824649, ...
            -45442868181/3398467696, 3065993473/597172653, 0, 0;
        185892177/718116043, 0, 0, -3185094517/667107341, -477755414/1098053517, ...
            -703635378/230739211, 5731566787/1027545527, 5232866602/850066563, ...
            -4093664535/808688257, 3962137247/1805957418, 65686358/487910083, 0;
        403863854/491063109, 0, 0, -5068492393/434740067, -411421997/543043805, ...
            652783627/914296604, 11173962825/925320556, -13158990841/6184727034, ...
            3936647629/1978049680, -160528059/685178525, 248638103/1413531060, 0];
  b7 = [13451932/455176623; 0; 0; 0; 0; -808719846/976000145; ...
            1757004468/5645159321; 656045339/265891186; -3867574721/1518517206; ...
            465885868/322736535; 53011238/667516719; 2/45; 0];
  b8 = [14005451/335480064; 0; 0; 0; 0; -59238493/1068277825; 181606767/758867731; ...
            561292985/797845732; -1041891430/1371343529; 760417239/1151165299; ...
            118820643/751138087; -528747749/2220607170; 1/4];
  c = sum (a, 2);

  %# The solver main loop - stop if the endpoint has been reached
  cntloop = 2; cntcycles = 1; vu = init; vk = vu' * zeros(1,13);
  cntiter = 0; unhandledtermination = true;
  while ((timestamp < timestop && stepsize >= minstepsize))

    %# Hit the endpoint of the time slot exactely
    if ((timestamp + stepsize) > timestop)
      stepsize = timestop - timestamp; end

    %# Estimate the thirteen results when using this solver
    for j = 1:13
      thetime  = timestamp + c(j,1) * stepsize;
      theinput = vu' + stepsize * vk(:,1:j-1) * a(j,1:j-1)';
      %# Claculate the history values (or get them from an external
      %# function) that are needed for the next step of solving
      if (havehistnumeric)
        for vcnt = 1:length (lags)
          %# Direct implementation of a 'quadrature cubic Hermite interpolation'
          %# found at the Faculty for Mathematics of the University of Stuttgart
          %# http://mo.mathematik.uni-stuttgart.de/inhalt/aussage/aussage1269
          vnumb = find (thetime - lags(vcnt) >= saveddetime);
          velem = min (vnumb(end), length (saveddetime) - 1);
          vstep = saveddetime(velem+1) - saveddetime(velem);
          vdiff = (thetime - lags(vcnt) - saveddetime(velem)) / vstep;
          vsubs = 1 - vdiff;
          %# Calculation of the coefficients for the interpolation algorithm
          vua = (1 + 2 * vdiff) * vsubs^2;
          vub = (3 - 2 * vdiff) * vdiff^2;
          vva = vstep * vdiff * vsubs^2;
          vvb = -vstep * vsubs * vdiff^2;
          hmat(:,vcnt) = vua * saveddeinput(velem,:)' + ...
              vub * saveddeinput(velem+1,:)' + ...
              vva * savedderesult(velem,:)' + ...
              vvb * savedderesult(velem+1,:)';
        end
      else %# the history must be a function handle
        for vcnt = 1:length (lags)
          hmat(:,vcnt) = feval ...
            (history, thetime - lags(vcnt), funarguments{:});
        end
      end

      if (havemasshandle)   %# Handle only the dynamic mass matrix,
        if (! strcmp (odeopts.MStateDependence, "none")) %# constant mass matrices have already
          mass = feval ...  %# been set before (if any)
            (odeopts.Mass, thetime, theinput, funarguments{:});
        else                 %# if (massdependence == false)
          mass = feval ...  %# then we only have the time argument
            (odeopts.Mass, thetime, funarguments{:});
        end
        vk(:,j) = mass \ feval ...
          (fun, thetime, theinput, hmat, funarguments{:});
      else
        vk(:,j) = feval ...
          (fun, thetime, theinput, hmat, funarguments{:});
      end
    end

    %# Compute the 7th and the 8th order estimation
    y7 = vu' + stepsize * (vk * b7);
    y8 = vu' + stepsize * (vk * b8);
    if (odeopts.havenonnegative)
      vu(odeopts.NonNegative) = abs (vu(odeopts.NonNegative));
      y7(odeopts.NonNegative) = abs (y7(odeopts.NonNegative));
      y8(odeopts.NonNegative) = abs (y8(odeopts.NonNegative));
    end
    vSaveVUForRefine = vu;

    %# Calculate the absolute local truncation error and the acceptable error
    if (! strcmp (odeopts.NormControl, "on"))
      vdelta = y8 - y7;
      vtau = max (odeopts.RelTol * vu', odeopts.AbsTol);
    else
      vdelta = norm (y8 - y7, Inf);
      vtau = max (odeopts.RelTol * max (norm (vu', Inf), 1.0), ...
                  odeopts.AbsTol);
    end

    %# If the error is acceptable then update the vretval variables
    if (all (vdelta <= vtau))
      timestamp = timestamp + stepsize;
      vu = y8'; %# MC2001: the higher order estimation as "local extrapolation"
      retvaltime(cntloop,:) = timestamp;
      if (! isempty (odeopts.OutputSel))
        retvalresult(cntloop,:) = vu(odeopts.OutputSel);
      else
        retvalresult(cntloop,:) = vu;
      end
      cntloop = cntloop + 1; cntiter = 0;

      %# Update DDE values for next history calculation
      saveddetime(end+1) = timestamp;
      saveddeinput(end+1,:) = theinput';
      savedderesult(end+1,:) = vu;

      if (! isempty(odeopts.Refine))         %# Do interpolation
        for cnt = 0:odeopts.Refine-1 %# Approximation between told and t
          vapproxtime = (cnt + 1) * stepsize / (odeopts.Refine + 1);
          vapproxvals = vSaveVUForRefine' + vapproxtime * (vk * b8);
          if (! isempty (odeopts.OutputSel))
            vapproxvals = vapproxvals(odeopts.OutputSel);
          end
          if (odeopts.haveoutputfunction)
            feval (odeopts.OutputFcn, (timestamp - stepsize) + vapproxtime, ...
              vapproxvals, [], funarguments{:});
          end
        end
      end
      %# Call plot only if a valid result has been found, therefore this
      %# code fragment has moved here. Stop integration if plot function
      %# returns false
      if (odeopts.haveoutputfunction)
        vpltret = feval (odeopts.OutputFcn, timestamp, ...
          retvalresult(cntloop-1,:)', [], funarguments{:});
        if (vpltret), unhandledtermination = false; break; end
      end

      %# Call event only if a valid result has been found, therefore this
      %# code fragment has moved here. Stop integration if veventbreak is
      %# true
      if (! isempty (odeopts.Events))
        event = ode_event_handler (odeopts.Events, timestamp,
                                    {vu(:), hmat}, [], funarguments{:});
        if (! isempty (event{1}) && event{1} == 1)
          retvaltime(cntloop-1,:) = event{3}(end,:);
          retvalresult(cntloop-1,:) = event{4}(end,:);
          unhandledtermination = false; break;
        end
      end
    end %# If the error is acceptable ...

    %# Update the step size for the next integration step
    vdelta = max (vdelta, eps);
    stepsize = min (odeopts.MaxStep, ...
                    min (0.8 * stepsize * (vtau ./ vdelta) .^ pow));

    %# Update counters that count the number of iteration cycles
    cntcycles = cntcycles + 1; %# Needed for postprocessing
    cntiter = cntiter + 1;     %# Needed to find iteration problems

    %# Stop solving because the last 1000 steps no successful valid
    %# value has been found
    if (cntiter >= 5000)
      error (['Solving has not been successful. The iterative', ...
        ' integration loop exited at time t = %f before endpoint at', ...
        ' tend = %f was reached. This happened because the iterative', ...
        ' integration loop does not find a valid solution at this time', ...
        ' stamp. Try to reduce the value of "InitialStep" and/or', ...
        ' "MaxStep" with the command "odeset".\n'], timestamp, timestop);
    end

  end %# The main loop

  %# Check if integration of the ode has been successful
  if (timestamp < timestop)
    if (unhandledtermination == true)
      error (['Solving has not been successful. The iterative', ...
        ' integration loop exited at time t = %f', ...
        ' before endpoint at tend = %f was reached. This may', ...
        ' happen if the stepsize grows smaller than defined in', ...
        ' minstepsize. Try to reduce the value of "InitialStep" and/or', ...
        ' "MaxStep" with the command "odeset".\n'], timestamp, timestop);
    else
      warning ('OdePkg:HideWarning', ...
        ['Solver has been stopped by a call of "break" in', ...
         ' the main iteration loop at time t = %f before endpoint at', ...
         ' tend = %f was reached. This may happen because the @odeplot', ...
         ' function returned "true" or the @event function returned "true".'], ...
         timestamp, timestop);
    end
  end

  %# Postprocessing, do whatever when terminating integration algorithm
  if (odeopts.haveoutputfunction) %# Cleanup plotter
    feval (odeopts.OutputFcn, timestamp, ...
      retvalresult(cntloop-1,:)', 'done', funarguments{:});
  end
  if (! isempty (odeopts.Events))  %# Cleanup event function handling
    ode_event_handler (odeopts.Events, timestamp,
                       {retvalresult(cntloop-1,:), hmat}, "done",
                        funarguments{:});
  end

  %# Print additional information if option Stats is set
  if (strcmp (odeopts.Stats, 'on'))
    havestats = true;
    nsteps    = cntloop-2;                    %# cntloop from 2..end
    nfailed   = (cntcycles-1)-(cntloop-2)+1; %# vcntcycl from 1..end
    nfevals   = 13*(cntcycles-1);              %# number of ode evaluations
    ndecomps  = 0;                             %# number of LU decompositions
    npds      = 0;                             %# number of partial derivatives
    nlinsols  = 0;                             %# no. of solutions of linear systems
    %# Print cost statistics if no output argument is given
    if (nargout == 0)
      msg = fprintf (1, 'Number of successful steps: %d', nsteps);
      msg = fprintf (1, 'Number of failed attempts:  %d', nfailed);
      msg = fprintf (1, 'Number of function calls:   %d', nfevals);
    end
  else havestats = false;
  end

  if (nargout == 1)                 %# Sort output variables, depends on nargout
    varargout{1}.x = retvaltime.';   %# Time stamps are saved in field x
    varargout{1}.y = retvalresult.'; %# Results are saved in field y
    varargout{1}.solver = 'ode78d'; %# Solver name is saved in field solver
    if (! isempty (odeopts.Events))
      varargout{1}.ie = event{2};  %# Index info which event occurred
      varargout{1}.xe = event{3};  %# Time info when an event occurred
      varargout{1}.ye = event{4};  %# Results when an event occurred
    end
    if (havestats)
      varargout{1}.stats = struct;
      varargout{1}.stats.nsteps   = nsteps;
      varargout{1}.stats.nfailed  = nfailed;
      varargout{1}.stats.nfevals  = nfevals;
      varargout{1}.stats.npds     = npds;
      varargout{1}.stats.ndecomps = ndecomps;
      varargout{1}.stats.nlinsols = nlinsols;
    end
  elseif (nargout == 2)
    varargout{1} = retvaltime;     %# Time stamps are first output argument
    varargout{2} = retvalresult;   %# Results are second output argument
  elseif (nargout == 5)
    varargout{1} = retvaltime;     %# Same as (nargout == 2)
    varargout{2} = retvalresult;   %# Same as (nargout == 2)
    varargout{3} = [];              %# LabMat doesn't accept lines like
    varargout{4} = [];              %# varargout{3} = varargout{4} = [];
    varargout{5} = [];
    if (! isempty (odeopts.Events))
      varargout{3} = event{3};     %# Time info when an event occurred
      varargout{4} = event{4};     %# Results when an event occurred
      varargout{5} = event{2};     %# Index info which event occurred
    end
  %# else nothing will be returned, varargout{1} undefined
  end

end

%! # We are using a "pseudo-DDE" implementation for all tests that
%! # are done for this function. We also define an Events and a
%! # pseudo-Mass implementation. For further tests we also define a
%! # reference solution (computed at high accuracy) and an OutputFcn.
%!function [vyd] = fexp (vt, vy, vz, varargin)
%!  vyd(1,1) = exp (- vt) - vz(1); %# The DDEs that are
%!  vyd(2,1) = vy(1) - vz(2);      %# used for all examples
%!function [vval, vtrm, vdir] = feve (vt, vy, vz, varargin)
%!  vval = fexp (vt, vy, vz); %# We use the derivatives
%!  vtrm = zeros (2,1);       %# don't stop solving here
%!  vdir = ones (2,1);        %# in positive direction
%!function [vval, vtrm, vdir] = fevn (vt, vy, vz, varargin)
%!  vval = fexp (vt, vy, vz); %# We use the derivatives
%!  vtrm = ones (2,1);        %# stop solving here
%!  vdir = ones (2,1);        %# in positive direction
%!function [vmas] = fmas (vt, vy, vz, varargin)
%!  vmas =  [1, 0; 0, 1];     %# Dummy mass matrix for tests
%!function [vmas] = fmsa (vt, vy, vz, varargin)
%!  vmas = sparse ([1, 0; 0, 1]); %# A dummy sparse matrix
%!function [vref] = fref ()       %# The reference solution
%!  vref = [0.12194462133618, 0.01652432423938];
%!function [vout] = fout (vt, vy, vflag, varargin)
%!  if (regexp (char (vflag), 'init') == 1)
%!    if (any (size (vt) ~= [2, 1])) error ('"fout" step "init"'); end
%!  elseif (isempty (vflag))
%!    if (any (size (vt) ~= [1, 1])) error ('"fout" step "calc"'); end
%!    vout = false;
%!  elseif (regexp (char (vflag), 'done') == 1)
%!    if (any (size (vt) ~= [1, 1])) error ('"fout" step "done"'); end
%!  else
%!    error ("\"fout\" invalid vflag");
%!  end
%!
%! %# Turn off output of warning messages for all tests, turn them on
%! %# again if the last test is called
%!error %# input argument number one
%!  B = ode78d (1, [0 5], [1; 0], 1, [1; 0]);
%!error %# input argument number two
%!  B = ode78d (@fexp, 1, [1; 0], 1, [1; 0]);
%!error %# input argument number three
%!  B = ode78d (@fexp, [0 5], 1, 1, [1; 0]);
%!error %# input argument number four
%!  B = ode78d (@fexp, [0 5], [1; 0], [1; 1], [1; 0]);
%!error %# input argument number five
%!  B = ode78d (@fexp, [0 5], [1; 0], 1, 1);
%!test %# one output argument
%!  vsol = ode78d (@fexp, [0 5], [1; 0], 1, [1; 0]);
%!  assert ([vsol.x(end); vsol.y(:,end)], [5; fref'], 0.2);
%!  assert (isfield (vsol, 'solver'));
%!  assert (vsol.solver, 'ode78d');
%!test %# two output arguments
%!  [vt, vy] = ode78d (@fexp, [0 5], [1; 0], 1, [1; 0]);
%!  assert ([vt(end), vy(end,:)], [5, fref], 0.2);
%!test %# five output arguments and no Events
%!  [vt, vy, vxe, vye, vie] = ode78d (@fexp, [0 5], [1; 0], 1, [1; 0]);
%!  assert ([vt(end), vy(end,:)], [5, fref], 0.2);
%!  assert ([vie, vxe, vye], []);
%!test %# anonymous function instead of real function
%!  faym = @(vt, vy, vz) [exp(-vt) - vz(1); vy(1) - vz(2)];
%!  vsol = ode78d (faym, [0 5], [1; 0], 1, [1; 0]);
%!  assert ([vsol.x(end); vsol.y(:,end)], [5; fref'], 0.2);
%!test %# extra input arguments passed trhough
%!  vsol = ode78d (@fexp, [0 5], [1; 0], 1, [1; 0], 'KL');
%!  assert ([vsol.x(end); vsol.y(:,end)], [5; fref'], 0.2);
%!test %# empty OdePkg structure *but* extra input arguments
%!  vopt = odeset;
%!  vsol = ode78d (@fexp, [0 5], [1; 0], 1, [1; 0], vopt, 12, 13, 'KL');
%!  assert ([vsol.x(end); vsol.y(:,end)], [5; fref'], 0.2);
%!test %# AbsTol option
%!  vopt = odeset ('AbsTol', 1e-5);
%!  vsol = ode78d (@fexp, [0 5], [1; 0], 1, [1; 0], vopt);
%!  assert ([vsol.x(end); vsol.y(:,end)], [5; fref'], 0.2);
%!test %# AbsTol and RelTol option
%!  vopt = odeset ('AbsTol', 1e-7, 'RelTol', 1e-7);
%!  vsol = ode78d (@fexp, [0 5], [1; 0], 1, [1; 0], vopt);
%!  assert ([vsol.x(end); vsol.y(:,end)], [5; fref'], 0.2);
%!test %# RelTol and NormControl option
%!  vopt = odeset ('AbsTol', 1e-7, 'NormControl', 'on');
%!  vsol = ode78d (@fexp, [0 5], [1; 0], 1, [1; 0], vopt);
%!  assert ([vsol.x(end); vsol.y(:,end)], [5; fref'], 0.2);
%!test %# NonNegative for second component
%!  vopt = odeset ('NonNegative', 1);
%!  vsol = ode78d (@fexp, [0 2.5], [1; 0], 1, [1; 0], vopt);
%!  assert ([vsol.x(end); vsol.y(:,end)], [2.5; 0.001; 0.237], 0.2);
%!test %# Details of OutputSel and Refine can't be tested
%!  vopt = odeset ('OutputFcn', @fout, 'OutputSel', 1, 'Refine', 5);
%!  vsol = ode78d (@fexp, [0 2.5], [1; 0], 1, [1; 0], vopt);
%!test %# Stats must add further elements in vsol
%!  vopt = odeset ('Stats', 'on');
%!  vsol = ode78d (@fexp, [0 2.5], [1; 0], 1, [1; 0], vopt);
%!  assert (isfield (vsol, 'stats'));
%!  assert (isfield (vsol.stats, 'nsteps'));
%!test %# InitialStep option
%!  vopt = odeset ('InitialStep', 1e-8);
%!  vsol = ode78d (@fexp, [0 5], [1; 0], 1, [1; 0], vopt);
%!  assert ([vsol.x(end); vsol.y(:,end)], [5; fref'], 0.2);
%!test %# MaxStep option
%!  vopt = odeset ('MaxStep', 1e-2);
%!  vsol = ode78d (@fexp, [0 5], [1; 0], 1, [1; 0], vopt);
%!  assert ([vsol.x(end); vsol.y(:,end)], [5; fref'], 0.2);
%!test %# Events option add further elements in vsol
%!  vopt = odeset ('Events', @feve);
%!  vsol = ode78d (@fexp, [0 5], [1; 0], 1, [1; 0], vopt);
%!  assert (isfield (vsol, 'ie'));
%!  assert (vsol.ie, [1; 1]);
%!  assert (isfield (vsol, 'xe'));
%!  assert (isfield (vsol, 'ye'));
%!test %# Events option, now stop integration
%!  warning ('off', 'OdePkg:HideWarning');
%!  vopt = odeset ('Events', @fevn, 'NormControl', 'on');
%!  vsol = ode78d (@fexp, [0 5], [1; 0], 1, [1; 0], vopt);
%!  assert ([vsol.ie, vsol.xe, vsol.ye], ...
%!    [1.0000, 2.9219, -0.2127, -0.2671], 0.2);
%!test %# Events option, five output arguments
%!  vopt = odeset ('Events', @fevn, 'NormControl', 'on');
%!  [vt, vy, vxe, vye, vie] = ode78d (@fexp, [0 5], [1; 0], 1, [1; 0], vopt);
%!  assert ([vie, vxe, vye], ...
%!    [1.0000, 2.9219, -0.2127, -0.2671], 0.2);
%!
%! %# test for Jacobian option is missing
%! %# test for Jacobian (being a sparse matrix) is missing
%! %# test for JPattern option is missing
%! %# test for Vectorized option is missing
%! %# test for NewtonTol option is missing
%! %# test for MaxNewtonIterations option is missing
%!
%!test %# Mass option as function
%!  vopt = odeset ('Mass', eye (2,2));
%!  vsol = ode78d (@fexp, [0 5], [1; 0], 1, [1; 0], vopt);
%!  assert ([vsol.x(end); vsol.y(:,end)], [5; fref'], 0.2);
%!test %# Mass option as matrix
%!  vopt = odeset ('Mass', eye (2,2));
%!  vsol = ode78d (@fexp, [0 5], [1; 0], 1, [1; 0], vopt);
%!  assert ([vsol.x(end); vsol.y(:,end)], [5; fref'], 0.2);
%!test %# Mass option as sparse matrix
%!  vopt = odeset ('Mass', sparse (eye (2,2)));
%!  vsol = ode78d (@fexp, [0 5], [1; 0], 1, [1; 0], vopt);
%!  assert ([vsol.x(end); vsol.y(:,end)], [5; fref'], 0.2);
%!test %# Mass option as function and sparse matrix
%!  vopt = odeset ('Mass', @fmsa);
%!  vsol = ode78d (@fexp, [0 5], [1; 0], 1, [1; 0], vopt);
%!  assert ([vsol.x(end); vsol.y(:,end)], [5; fref'], 0.2);
%!test %# Mass option as function and MStateDependence
%!  vopt = odeset ('Mass', @fmas, 'MStateDependence', 'strong');
%!  vsol = ode78d (@fexp, [0 5], [1; 0], 1, [1; 0], vopt);
%!  assert ([vsol.x(end); vsol.y(:,end)], [5; fref'], 0.2);
%!test %# Set BDF option to something else than default
%!  vopt = odeset ('BDF', 'on');
%!  [vt, vy] = ode78d (@fexp, [0 5], [1; 0], 1, [1; 0], vopt);
%!  assert ([vt(end), vy(end,:)], [5, fref], 0.5);
%!
%! %# test for MvPattern option is missing
%! %# test for InitialSlope option is missing
%! %# test for MaxOrder option is missing
%!
%!  warning ('on', 'OdePkg:InvalidOption');

%# Local Variables: ***
%# mode: octave ***
%# End: ***
