Mercurial > forge
changeset 3046:d3b6766e56b6 octave-forge
Removed the C solver package dopri.tar.gz but added the Fortran solver package hairer.tgz instead.
author | treichl |
---|---|
date | Sun, 04 Feb 2007 12:45:39 +0000 |
parents | d4073e11ebc5 |
children | 108ef774d9fd |
files | main/odepkg/src/dopri.tar.gz main/odepkg/src/hairer.tgz main/odepkg/src/odepkg_mexsolver_dopri5.c |
diffstat | 3 files changed, 190 insertions(+), 125 deletions(-) [+] |
line wrap: on
line diff
--- a/main/odepkg/src/odepkg_mexsolver_dopri5.c Sat Feb 03 19:57:26 2007 +0000 +++ b/main/odepkg/src/odepkg_mexsolver_dopri5.c Sun Feb 04 12:45:39 2007 +0000 @@ -17,38 +17,63 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA */ -/* mkoctfile --mex -Wall -W -Wshadow -DHAVE_CONFIG_H -D__ODEPKGDEBUG__ -I./cprog\ - odepkg_mexsolver_dopri5.c odepkgmex.c odepkgext.c cprog/dopri5.o -*/ -/* octave --eval "A = odeset (\"RelTol\", 1e-3, \"AbsTol\", 1e-4, \"OutputFcn\", \ - @odeprint, \"OutputSel\", [2, 1], \"Refine\", 3); \ - [C, B] = odepkg_mexsolver_dopri5 (@odepkg_equations_vanderpol, [0, 1], [2, 0], A, 12)" -*/ +/* To manually compile this file with debug messages + + mkoctfile --mex -Wall -W -Wshadow -D__ODEPKGDEBUG__ \ + odepkg_mexsolver_dopri5.c odepkgmex.c odepkgext.c hairer/dopri5.f + + or -/* mex -v -D__ODEPKGDEBUG__ -I./cprog odepkg_mexsolver_dopri5.c odepkgext.c odepkgmex.c cprog/dopri5.c - odepkg_mexsolver_dopri5 (@odepkg_equations_vanderpol, [0,2], [2,0]) + mex -v -D__ODEPKGDEBUG__ odepkg_mexsolver_dopri5.c odepkgext.c \ + odepkgmex.c hairer/dopri5.f + + a function check can be done via + + octave --quiet --eval "A = odeset (\"RelTol\", 1e-3, \"AbsTol\", 1e-4, \ + \"OutputFcn\", @odeprint, \"OutputSel\", [2, 1], \"Refine\", 3); \ + [C, B] = odepkg_mexsolver_dopri5 (@odepkg_equations_vanderpol, \ + [0, 1], [2, 0], A, 12)" */ -#ifdef HAVE_CONFIG_H - #include "config.h" /* Needed for GCC_ATTR_UNUSED if compiled with mkoctfile */ -#endif +#include <config.h> /* Needed for the F77_FUNC definition etc. */ +#include <mex.h> /* Needed for all mex definitions */ +/* #include <f77-fcn.h> */ /* Needed for the use of Fortran routines */ +#include <stdio.h> /* Needed for the sprintf function etc.*/ +#include <string.h> /* Needed for the memcpy function etc.*/ +#include "odepkgmex.h" /* Needed for the mex extensions */ +#include "odepkgext.h" /* Needed for the odepkg interfaces */ -#include <mex.h> /* Needed for all mex definitions */ -#include <string.h> /* Needed for the memcpy function etc.*/ -#include "odepkgmex.h" /* Needed for the mex extensions */ -#include "odepkgext.h" /* Needed for the odepkg interfaces */ -#include "dopri5.h" /* Needed for the solver function */ - -/* These prototype definitions from functions that are found in this file */ -void fodefun (unsigned n, double x, double *y, double *f); -void fsolout (long nr, double xold, double x, double* y, unsigned n, int* irtrn); -void mexFunction (int nlhs, mxArray* plhs[], int nrhs, const mxArray* prhs[]); +/** + * dopri5 - Stores mxArrays in an internal variable + * @vdeci: The decision for what has to be done + * @vname: The name of the variable that is stored + * @vvalue: The value of the stored variable + * + * TODO TODO TODO If @vdeci is 0 (@vname is %NULL and @vvalue is + * %NULL) then this function @is initialized. Otherwise if @vdeci is 1 + * (@vname must be the name of the variable and @vvalue must be a + * pointer to its + * + * Return value: On success the constant %true, otherwise %false. + **/ +extern void F77_FUNC (dopri5, DOPRI5) (int *N, void *FCN, double *X, double *Y, + double *XEND, double *RTOL, double *ATOL, int *ITOL, void *SOL, int *IOUT, + double *WORK, int *LWORK, int *IWORK, int *LIWORK, double *RPAR, int *IPAR, + int *VRET); /** * TODO - * Return value: On success the constant %true, otherwise %false. + * **/ -void fodefun (unsigned n, double x, double *y, double *f) { +extern double F77_FUNC (contd5, CONTD5) (int *II, double *X, double *CON, + int *ICOMP, int *ND); + +/** + * TODO + * + **/ +void F77_FUNC (ffcn, FFCN) (int *N, double *X, double *Y, double *F, + GCC_ATTR_UNUSED double *RPAR, GCC_ATTR_UNUSED int *IPAR) { int vcnt = 0; int vnum = 0; char vmsg[64] = ""; @@ -64,11 +89,11 @@ /* Allocate memory and set up variables lhs-arguments and rhs-arguments */ vlhs = (mxArray **) mxMalloc (sizeof (mxArray *)); vrhs = (mxArray **) mxMalloc ((2 + vnum) * sizeof (mxArray *)); - vrhs[0] = mxCreateDoubleScalar (x); + vrhs[0] = mxCreateDoubleScalar (*X); /* Copy the values that are given from the solver into the mxArray */ - vrhs[1] = mxCreateDoubleMatrix (n, 1, mxREAL); - memcpy ((void *) mxGetPr (vrhs[1]), (void *) y, n * sizeof (double)); + vrhs[1] = mxCreateDoubleMatrix (*N, 1, mxREAL); + memcpy ((void *) mxGetPr (vrhs[1]), (void *) Y, *N * sizeof (double)); if (vnum > 0) /* Fill up vrhs[2..] */ for (vcnt = 0; vcnt < vnum; vcnt++) @@ -82,17 +107,24 @@ } /* Save the result of this time step in the variable f */ - memcpy ((void *) f, (void *) mxGetPr (vlhs[0]), n * sizeof (double)); + memcpy ((void *) F, (void *) mxGetPr (vlhs[0]), *N * sizeof (double)); mxFree (vlhs); /* Free the vlhs mxArray */ mxFree (vrhs); /* Free the vrhs mxArray */ } -void fsolout (long nr, double xold, double x, double* y, unsigned n, int* irtrn) { +/** + * TODO + * + **/ +void F77_FUNC (fsol, FSOL) (int *NR, double *XOLD, double *X, double *Y, int *N, + double *CON, int *ICOMP, int *ND, GCC_ATTR_UNUSED double *RPAR, + GCC_ATTR_UNUSED int *IPAR, int *IRTRN) { + bool vsuc = false; double vdbt = 0.0; unsigned int vref = 0; unsigned int vcnt = 0; - unsigned int vnum = 0; + int vnum = 0; double *vdob = NULL; double *vdbl = NULL; @@ -103,29 +135,31 @@ mxArray *vrvl = NULL; /* Convert the double *y into a selection of variables */ - fy2mxArray (n, y, &vtem); - vtim = mxCreateDoubleScalar (x); + fy2mxArray (*N, Y, &vtem); + vtim = mxCreateDoubleScalar (*X); /* Save the solution if this is not the initial first call */ - if (nr > 1) fsolstore (1, &vtim, &vtem); + if (*NR > 1) fsolstore (1, &vtim, &vtem); /* Call output function if this is not the initial first call */ fodepkgvar (2, "PlotFunction", &vtmp); - if (!mxIsEmpty (vtmp) && nr > 1) { + if (!mxIsEmpty (vtmp) && *NR > 1) { fodepkgvar (2, "Refine", &vtmp); /* Check for "Refine" option */ vdbl = mxGetPr (vtmp); vref = (int)vdbl[0]; if (vref > 0) { /* If the Refine option is > 0 */ - vdob = (double *) mxMalloc (n * sizeof (double)); + vdob = (double *) mxMalloc (*N * sizeof (double)); for (vcnt = 0; vcnt < vref; vcnt++) { - vdbt = xold + (double)(vcnt + 1) * ((x - xold) / (vdbl[0] + 2)); + vdbt = *XOLD + (double)(vcnt + 1) * ((*X - *XOLD) / (vref + 2)); vrtm = mxCreateDoubleScalar (vdbt); - /* Time stamps for approximation: mexPrintf ("%f %f %f\n", xold, vdbt, x); */ + /* Time stamps for approximation: mexPrintf ("%f %f %f\n", *XOLD, vdbt, x); */ - for (vnum = 0; vnum < n; vnum++) vdob[vnum] = contd5(vnum, vdbt); - fy2mxArray (n, vdob, &vrvl); + for (vnum = 1; vnum <= *N; vnum++) + vdob[vnum-1] = F77_FUNC (contd5, CONTD5) (&vnum, &vdbt, CON, ICOMP, ND); + + fy2mxArray (*N, vdob, &vrvl); /* Time stamps and approx. values: mexPrintf ("%f %f %f\n", vdbt, vdob[0], vdob[1]); */ fodepkgplot (vrtm, vrvl, mxCreateString ("")); } @@ -133,8 +167,8 @@ } vsuc = fodepkgplot (vtim, vtem, mxCreateString ("")); if (vsuc == false) { - mexPrintf ("Integration has been stopped from output function at time t=%f\n", x); - irtrn[0] = - 1; /* Stop integration ? */ + mexPrintf ("Integration has been stopped from output function at time t=%f\n", *X); + IRTRN[0] = - 1; /* Stop integration ? */ } } @@ -148,36 +182,37 @@ if (mxIsLogicalScalarTrue (vtem)) { fsolstore (3, NULL, NULL); /* Remove the last solution entry */ vtem = mxGetCell (vtmp, 3); /* Get last row of events solution */ - vtim = mxCreateDoubleScalar (x); + vtim = mxCreateDoubleScalar (*X); vtmp = mxGetMatrixRow (vtem, mxGetM (vtem) - 1); fsolstore (1, &vtim, &vtmp); /* Set last row of events solution */ - mexPrintf ("Integration has been stopped from event function at time t=%f\n", x); - irtrn[0] = -1; /* Tell the solver to stop solving */ + mexPrintf ("Integration has been stopped from event function at time t=%f\n", *X); + IRTRN[0] = -1; /* Tell the solver to stop solving */ } } } void mexFunction (int nlhs, mxArray* plhs[], int nrhs, const mxArray* prhs[]) { - int vcnt = 0; - int vnum = 0; - int vone = 1; - + int vcnt = 0; + int vnum = 0; double *vdbl = NULL; char vmsg[64] = ""; - mxArray *vtmp = NULL; mxArray *vtem = NULL; - int vodedimen = 0; - double *vtimeslot = NULL; - double *vinitvals = NULL; - - int vtoltype = 0; - double *vtolrelat = NULL; - double *vtolabsol = NULL; - - double vinitstep = 0.0; - double vmaxstep = 0.0; + /* Variables that are needed to call the solver function */ + int N = 0; /* Dimension of differential equations */ + int ITOL = 0; /* Type of error tolerance handling */ + int LWORK = 0; /* Size of work vector will be set later */ + int LIWORK = 0; /* Size of iwork vector will be set later */ + int *IWORK = NULL; /* Memory of iwork vector will be allocated later */ + int IPAR = 0; /* Integer parameters will be unused */ + int VRET = 0; /* Return value of the solver function */ + double *SLOT = NULL; /* Time slot values tstart and tend */ + double *INIT = NULL; /* Initial values for differential equations */ + double *RTOL = NULL; /* Relative tolerances scalar or vector */ + double *ATOL = NULL; /* Absolute tolerances scalar or vector */ + double *WORK = NULL; /* Memory of work vector will be allocated later */ + double RPAR = 0; /* Real parameters will be unused */ #ifdef __ODEPKGDEBUG__ mexPrintf ("ODEPKGDEBUG: ----- STARTING SOLVER INITIALISATION PROCEDURE\n"); @@ -256,55 +291,67 @@ /* Handle the prhs[1] element: Split the integration interval */ if (mxGetM (prhs[1]) == 2 || mxGetN (prhs[1]) == 2) { - vtimeslot = mxMalloc (2 * sizeof (double)); - memcpy ((void *) vtimeslot, (void *) mxGetPr (prhs[1]), 2 * sizeof (double)); + SLOT = mxMalloc (2 * sizeof (double)); + memcpy ((void *) SLOT, (void *) mxGetPr (prhs[1]), 2 * sizeof (double)); } else mexErrMsgTxt ("Second input argument of this solver must be of size 1x2 or 2x1"); #ifdef __ODEPKGDEBUG__ mexPrintf ("ODEPKGDEBUG: Solving is done from tStart=%f to tStop=%f\n", - vtimeslot[0], vtimeslot[1]); + SLOT[0], SLOT[1]); #endif - /* Handle the prhs[2] element: Set the initial values */ - if (mxIsRowVector (prhs[2])) vodedimen = (int) mxGetN (prhs[2]); - else vodedimen = (int) mxGetM (prhs[2]); - vinitvals = mxMalloc (vodedimen * sizeof (double)); - vtmp = mxCreateDoubleScalar (vodedimen); + /* Handle the prhs[2] element: Set the dimension and the initial values */ + if (mxIsRowVector (prhs[2])) N = (int) mxGetN (prhs[2]); + else N = (int) mxGetM (prhs[2]); + INIT = mxMalloc (N * sizeof (double)); + vtmp = mxCreateDoubleScalar (N); fodepkgvar (1, "OdeDimension", &vtmp); - memcpy ((void *) vinitvals, (void *) mxGetPr (prhs[2]), vodedimen * sizeof (double)); + memcpy ((void *) INIT, (void *) mxGetPr (prhs[2]), N * sizeof (double)); #ifdef __ODEPKGDEBUG__ - mexPrintf ("ODEPKGDEBUG: Number of initial values is %d\n", vodedimen); - mexPrintf ("ODEPKGDEBUG: Last element of initial values is %f\n", vinitvals[vodedimen-1]); + mexPrintf ("ODEPKGDEBUG: Number of initial values is %d\n", N); + mexPrintf ("ODEPKGDEBUG: Last element of initial values is %f\n", INIT[N-1]); #endif + /* Initialize the WORK and LWORK vectors with zeros */ + LWORK = 8*N+5*N+21; /* LWORK = 8*N+5*NRDENS+21; */ + WORK = (double *) mxMalloc (LWORK * sizeof (double)); + for (vcnt = 0; vcnt < LWORK; vcnt++) WORK[vcnt] = 0.0; + LIWORK = N+21; /* LIWORK = NRDENS+21; */ + IWORK = (int *) mxMalloc (LIWORK * sizeof (int)); + for (vcnt = 0; vcnt < LIWORK; vcnt++) IWORK[vcnt] = 0; + /* Handle the OdeOptions structure field: RELTOL */ fodepkgvar (2, "OdeOptions", &vtmp); vtem = mxGetField (vtmp, 0, "RelTol"); if (mxIsRowVector (vtem)) vcnt = (int) mxGetN (vtem); else vcnt = (int) mxGetM (vtem); - vtolrelat = mxMalloc (vcnt * sizeof (double)); - memcpy ((void *) vtolrelat, (void *) mxGetPr (vtem), vcnt * sizeof (double)); + RTOL = mxMalloc (vcnt * sizeof (double)); + memcpy ((void *) RTOL, (void *) mxGetPr (vtem), vcnt * sizeof (double)); #ifdef __ODEPKGDEBUG__ - mexPrintf ("ODEPKGDEBUG: Last element of relative error is %f\n", vtolrelat[vcnt-1]); + mexPrintf ("ODEPKGDEBUG: Last element of relative error is %f\n", RTOL[vcnt-1]); #endif /* Handle the OdeOptions structure field: ABSTOL */ vtem = mxGetField (vtmp, 0, "AbsTol"); if (mxIsRowVector (vtem)) vnum = (int) mxGetN (vtem); else vnum = (int) mxGetM (vtem); - vtolabsol = mxMalloc (vnum * sizeof (double)); - memcpy ((void *) vtolabsol, (void *) mxGetPr (vtem), vnum * sizeof (double)); + ATOL = mxMalloc (vnum * sizeof (double)); + memcpy ((void *) ATOL, (void *) mxGetPr (vtem), vnum * sizeof (double)); #ifdef __ODEPKGDEBUG__ - mexPrintf ("ODEPKGDEBUG: Last element of relative error is %f\n", vtolabsol[vnum-1]); + mexPrintf ("ODEPKGDEBUG: Last element of relative error is %f\n", ATOL[vnum-1]); #endif - /* Handle the OdeOptions structure field: RELTOL vs. ABSTOL */ + /* Handle the OdeOptions structure field: RELTOL vs. ABSTOL vs. N */ if (vcnt != vnum) - mexErrMsgTxt ("Values of \"AbsTol\" and \"RelTol\" must have same size"); - else if (vcnt > 1) vtoltype = 1; - else vtoltype = 0; + mexErrMsgTxt ("\"AbsTol\" and \"RelTol\" must have same size"); + else if (vcnt > 1) { + if (vcnt != N) + mexErrMsgTxt ("\"AbsTol\", \"RelTol\" and the dimension must have same size"); + ITOL = 1; + } + else ITOL = 0; #ifdef __ODEPKGDEBUG__ - mexPrintf ("ODEPKGDEBUG: Type of dopri tolerance handling is %d\n", vtoltype); + mexPrintf ("ODEPKGDEBUG: Type of dopri tolerance handling is %d\n", ITOL); #endif /* Handle the OdeOptions structure field: NORMCONTROL */ @@ -344,10 +391,10 @@ vnum = (int) mxGetNumberOfElements (vtmp); vdbl = mxGetPr (vtmp); for (vcnt = 0; vcnt < vnum; vcnt++) - if ((int)(vdbl[vcnt]) > vodedimen) { - sprintf (vmsg, "Found invalid number element \"%d\" in option \"OuputSel\"", - (int)(vdbl[vcnt])); - mexErrMsgTxt (vmsg); + if ((int)(vdbl[vcnt]) > N) { + sprintf (vmsg, "Found invalid number element \"%d\" in option \"OuputSel\"", + (int)(vdbl[vcnt])); + mexErrMsgTxt (vmsg); } fodepkgvar (1, "OutputSelection", &vtmp); } @@ -384,18 +431,18 @@ fodepkgvar (2, "OdeOptions", &vtmp); fodepkgvar (2, "DefaultOptions", &vtem); if (!mxIsEqual (mxGetField (vtmp, 0, "InitialStep"), mxGetField (vtem, 0, "InitialStep"))) - vinitstep = *mxGetPr (mxGetField (vtmp, 0, "InitialStep") ); + WORK[6] = *mxGetPr (mxGetField (vtmp, 0, "InitialStep") ); #ifdef __ODEPKGDEBUG__ - mexPrintf ("ODEPKGDEBUG: The inital step size is %f\n", vinitstep); + mexPrintf ("ODEPKGDEBUG: The inital step size is %f\n", WORK[6]); #endif /* Handle the OdeOptions structure field: MAXSTEP */ fodepkgvar (2, "OdeOptions", &vtmp); fodepkgvar (2, "DefaultOptions", &vtem); if (!mxIsEqual (mxGetField (vtmp, 0, "MaxStep"), mxGetField (vtem, 0, "MaxStep"))) - vmaxstep = *mxGetPr (mxGetField (vtmp, 0, "MaxStep") ); + WORK[5] = *mxGetPr (mxGetField (vtmp, 0, "MaxStep") ); #ifdef __ODEPKGDEBUG__ - mexPrintf ("ODEPKGDEBUG: The maximum step size is %f\n", vmaxstep); + mexPrintf ("ODEPKGDEBUG: The maximum step size is %f\n", WORK[5]); #endif /* Handle the OdeOptions structure field: EVENTS */ @@ -510,7 +557,7 @@ fodepkgvar (2, "PlotFunction", &vtmp); if (!mxIsEmpty (vtmp)) { vtmp = mxDuplicateArray (prhs[1]); - fy2mxArray (vodedimen, vinitvals, &vtem); + fy2mxArray (N, INIT, &vtem); if (!fodepkgplot (vtmp, vtem, mxCreateString ("init"))) { fodepkgvar (2, "PlotFunction", &vtmp); sprintf (vmsg, "Error at initialisation of output function \"%s\"", mxArrayToString (vtmp)); @@ -525,8 +572,8 @@ /* Initialize the function: FODEPKGEVENT */ fodepkgvar (2, "EventFunction", &vtmp); if (!mxIsEmpty (vtmp)) { - vtmp = mxCreateDoubleScalar (vtimeslot[0]); - fy2mxArray (vodedimen, vinitvals, &vtem); + vtmp = mxCreateDoubleScalar (SLOT[0]); + fy2mxArray (N, INIT, &vtem); if (!fodepkgevent (vtmp, vtem, mxCreateString ("init"), NULL)) { fodepkgvar (2, "EventFunction", &vtmp); sprintf (vmsg, "Error at initialisation of event function \"%s\"", mxArrayToString (vtmp)); @@ -539,8 +586,8 @@ } /* Initialize the function: FSOLSTORE */ - vtmp = mxCreateDoubleScalar (vtimeslot[0]); - fy2mxArray (vodedimen, vinitvals, &vtem); + vtmp = mxCreateDoubleScalar (SLOT[0]); + fy2mxArray (N, INIT, &vtem); fsolstore (0, &vtmp, &vtem); #ifdef __ODEPKGDEBUG__ mexPrintf ("ODEPKGDEBUG: Initialisation of fsolstore function successfully completed\n"); @@ -550,26 +597,38 @@ mexPrintf ("ODEPKGDEBUG: ----- STARTING SOLVER CALCULATION PROCEDURE\n"); #endif - vnum = dopri5 (vodedimen, fodefun, vtimeslot[0], vinitvals, - vtimeslot[1], vtolrelat, vtolabsol, vtoltype, fsolout, 2, - stdout, 0.0, 0.0, 0.0, 0.0, 0.0, vmaxstep, vinitstep, - 0, 0, 100, vodedimen, NULL, vodedimen); - switch (vnum) { + /* IWORK[0] = 10^6; */ /* The maximal number of allowed steps */ + IWORK[2] = -1; /* Switch for turning on/off messages */ + IWORK[3] = 1000; /* Step number for stiffness checking */ + IWORK[4] = N; /* Number of components for dense output */ + + /* FORTRAN SUBROUTINE DOPRI5(N, FCN, X, Y, XEND, RTOL, ATOL, ITOL, */ + /* SOLOUT, IOUT, WORK, LWORK, IWORK, LIWORK, RPAR, IPAR, IDID) */ + + vnum = 2; /* Needed to call output at every successful step */ + F77_FUNC (dopri5, DOPRI5) (&N, &F77_FUNC (ffcn, FFCN), &SLOT[0], + INIT, &SLOT[1], RTOL, ATOL, &ITOL, &F77_FUNC (fsol, FSOL), + &vnum, WORK, &LWORK, IWORK, &LIWORK, &RPAR, &IPAR, &VRET); +#ifdef __ODEPKGDEBUG__ + mexPrintf ("ODEPKGDEBUG: Solving has been finished, exit status %d\n", VRET); +#endif + + switch (VRET) { case -4: - mexPrintf ("The computation has been stopped because the problem is probably stff\n"); + mexPrintf ("The computation has been stopped because the problem is probably stiff\n"); break; case -3: mexPrintf ("The step size grew too small, reduce InitialStep and/or MaxStep\n"); break; case -2: - mexPrintf ("Maximal number of allowed steps (100000) has been reached\n"); + mexPrintf ("Maximal number of allowed steps (1000000) has been reached\n"); break; case -1: mexPrintf ("Input is not consistent\n"); break; case 0: break; /* Not treated */ case 1: break; /* Computation has been successful */ - case 2: break; /* Computation has been successful, stopped of fsolout */ + case 2: break; /* Computation has been successful, stopped by fsolout */ default: break; } #ifdef __ODEPKGDEBUG__ @@ -578,30 +637,32 @@ /* Handle the OdeOptions structure field: STATS */ fodepkgvar (2, "Stats", &vtmp); - if (mxIsLogicalScalarTrue (vtmp)) { /* Print additional information */ - vnum = nstepRead (); /* A dopri solver function */ + if (mxIsLogicalScalarTrue (vtmp)) { + /* Print additional information on the screen */ + vnum = IWORK[16]; /* A dopri solver result */ + vtem = mxCreateDoubleScalar ((double) vnum); + fodepkgvar (1, "vfevals", &vtem); + mexPrintf ("Number of function calls: %d\n", vnum); + + vnum = IWORK[17]; /* A dopri solver result */ vtem = mxCreateDoubleScalar ((double) vnum); fodepkgvar (1, "vsuccess", &vtem); mexPrintf ("Number of used steps: %d\n", vnum); - vnum = naccptRead (); /* A dopri solver function */ + vnum = IWORK[18]; /* A dopri solver result */ vtem = mxCreateDoubleScalar ((double) vnum); fodepkgvar (1, "vaccept", &vtem); mexPrintf ("Number of accepted steps: %d\n", vnum); - vnum = nrejctRead (); /* A dopri solver function */ + vnum = IWORK[19]; /* A dopri solver result */ vtem = mxCreateDoubleScalar ((double) vnum); fodepkgvar (1, "vreject", &vtem); mexPrintf ("Number of rejected steps: %d\n", vnum); - - vnum = nfcnRead (); /* A dopri solver function */ - vtem = mxCreateDoubleScalar ((double) vnum); - fodepkgvar (1, "vfevals", &vtem); - mexPrintf ("Number of function calls: %d\n", vnum); } if (nlhs == 1) { /* Handle the PLHS array (1 output argument) */ - plhs[0] = mxCreateStructArray (1, &vone, 0, NULL); + vnum = 1; + plhs[0] = mxCreateStructArray (1, &vnum, 0, NULL); fsolstore (2, &vtmp, &vtem); @@ -618,8 +679,9 @@ mxSetFieldByNumber (plhs[0], 0, vnum, mxCreateString ("ode5d")); fodepkgvar (2, "Stats", &vtmp); - if (mxIsLogicalScalarTrue (vtmp)) { /* Put additional information */ - vtem = mxCreateStructArray (1, &vone, 0, NULL); + if (mxIsLogicalScalarTrue (vtmp)) { + vnum = 1; /* Put additional information into structure */ + vtem = mxCreateStructArray (1, &vnum, 0, NULL); mxAddField (vtem, "success"); vnum = mxGetFieldNumber (vtem, "success"); @@ -654,7 +716,8 @@ } fodepkgvar (2, "EventFunction", &vtmp); - if (!mxIsEmpty (vtmp)) { /* Put additional information about events */ + if (!mxIsEmpty (vtmp)) { + /* Put additional information about events into structure */ fodepkgvar (2, "EventSolution", &vtem); mxAddField (plhs[0], "ie"); @@ -674,13 +737,15 @@ } } - else if (nlhs == 2) { /* Handle the PLHS array (2 output arguments) */ + else if (nlhs == 2) { + /* Handle the PLHS array (2 output arguments) */ fsolstore (2, &vtmp, &vtem); plhs[0] = vtmp; plhs[1] = mxTransposeMatrix (vtem); } - else if (nlhs == 5) { /* Handle the PLHS array (5 output arguments) */ + else if (nlhs == 5) { + /* Handle the PLHS array (5 output arguments) */ fsolstore (2, &vtmp, &vtem); plhs[0] = vtmp; plhs[1] = mxTransposeMatrix (vtem); @@ -700,7 +765,7 @@ fodepkgvar (2, "PlotFunction", &vtmp); if (!mxIsEmpty (vtmp)) { vtmp = mxDuplicateArray (prhs[1]); - fy2mxArray (vodedimen, vinitvals, &vtem); /* vtem = mxDuplicateArray (prhs[2]); */ + fy2mxArray (N, INIT, &vtem); /* vtem = mxDuplicateArray (prhs[2]); */ if (!fodepkgplot (vtmp, vtem, mxCreateString ("done"))) { fodepkgvar (2, "PlotFunction", &vtmp); sprintf (vmsg, "Error at finalisation of output function \"%s\"", mxArrayToString (vtmp)); @@ -715,8 +780,8 @@ /* Cleanup all internals of: FODEPKGEVENT */ fodepkgvar (2, "EventFunction", &vtmp); if (!mxIsEmpty (vtmp)) { - vtmp = mxCreateDoubleScalar (vtimeslot[0]); - fy2mxArray (vodedimen, vinitvals, &vtem); + vtmp = mxCreateDoubleScalar (SLOT[0]); + fy2mxArray (N, INIT, &vtem); if (!fodepkgevent (vtmp, vtem, mxCreateString ("done"), NULL)) { fodepkgvar (2, "EventFunction", &vtmp); sprintf (vmsg, "Error at initialisation of event function \"%s\"", mxArrayToString (vtmp)); @@ -729,13 +794,13 @@ } /* Free and destroy the mxAllocated arrays */ -/* mxFree (vtimeslot); */ -/* mxFree (vinitvals); */ -/* mxFree (vtolrelat); */ -/* mxFree (vtolabsol); */ +/* mxFree (SLOT); */ +/* mxFree (INIT); */ +/* mxFree (RTOL); */ +/* mxFree (ATOL); */ /* mxDestroyArray (vtmp); */ /* mxDestroyArray (vtem); */ -fodepkgvar (9, NULL, NULL); +/* fodepkgvar (9, NULL, NULL); */ /* Cleanup all internals of: FSOLSTORE */ fsolstore (4, NULL, NULL);