From 47ce1e4a628c9f58f800a24e50cce990b45a68a1 Mon Sep 17 00:00:00 2001 From: Liam Healy <liam@thinkpad.local> Date: Sun, 15 Feb 2009 08:46:18 -0500 Subject: [PATCH] Callback struct stored in ode-stepper slot Changed the code so that the callback struct is now in ode-stepper instead of ode-evolution, because all solvers need stepper but only variable step integrators need evolution. The ode examples/tests work. --- .../evolution.lisp | 42 ++----------- .../ode-example.lisp | 4 +- .../ode-system.lisp | 6 +- ordinary-differential-equations/stepping.lisp | 63 ++++++++++++++----- 4 files changed, 57 insertions(+), 58 deletions(-) diff --git a/ordinary-differential-equations/evolution.lisp b/ordinary-differential-equations/evolution.lisp index d50f44a4..aa9e6972 100644 --- a/ordinary-differential-equations/evolution.lisp +++ b/ordinary-differential-equations/evolution.lisp @@ -1,55 +1,23 @@ ;; Evolution functions for ODE integration. ;; Liam Healy, Sun Sep 30 2007 - 14:31 -;; Time-stamp: <2009-02-14 19:29:21EST evolution.lisp> +;; Time-stamp: <2009-02-15 08:35:23EST evolution.lisp> ;; $Id$ (in-package :gsl) (defmobject ode-evolution "gsl_odeiv_evolve" - (((first dimensions) sizet)) + ((dimensions sizet)) "evolution for ordinary differential equations" - :documentation - "Make an object to advance the ODE solution." - :superclasses (callback-included-cl) - :ci-class-slots (ode-system marray (function jacobian) (dimension)) - :class-slots-instance (#.+callback-argument-name+) + :documentation "Make an object to advance the ODE solution." :initialize-suffix "reset" - :initialize-args nil - :singular (dimension)) - -(def-make-callbacks ode-evolution - (function jacobian dimension &optional (scalars t)) - (if scalars - `(progn - (defmcallback ,function - :success-failure - (:double (:double ,dimension) (:set :double ,dimension)) - nil nil - ,function) - (defmcallback ,jacobian - :success-failure - (:double - (:double ,dimension) - (:set :double ,(expt dimension 2)) - (:set :double ,dimension)) - nil nil ,jacobian)) - `(progn - (defmcallback ,function - :success-failure - (:double :pointer :pointer) - nil nil - ,function) - (defmcallback ,jacobian - :success-failure - (:double :pointer :pointer :pointer) - nil nil ,jacobian)))) + :initialize-args nil) (defmfun apply-evolution (evolve control step time max-time step-size y) "gsl_odeiv_evolve_apply" (((mpointer evolve) :pointer) ((mpointer control) :pointer) ((mpointer step) :pointer) - ((callback-struct evolve) :pointer) ((c-pointer time) :pointer) + ((callback-struct step) :pointer) ((c-pointer time) :pointer) (max-time :double) ((c-pointer step-size) :pointer) ((c-pointer y) :pointer)) :inputs (time step-size y) diff --git a/ordinary-differential-equations/ode-example.lisp b/ordinary-differential-equations/ode-example.lisp index c03c6e9b..a00f2584 100644 --- a/ordinary-differential-equations/ode-example.lisp +++ b/ordinary-differential-equations/ode-example.lisp @@ -1,6 +1,6 @@ ;; Example ODE ;; Liam Healy Sat Sep 29 2007 - 17:49 -;; Time-stamp: <2009-02-14 18:17:29EST ode-example.lisp> +;; Time-stamp: <2009-02-15 08:39:44EST ode-example.lisp> ;; $Id$ ;;; van der Pol as given in Section 25.5 of the GSL manual. To @@ -26,7 +26,7 @@ (defparameter *max-iter* 2000) -(make-callbacks ode-evolution vanderpol vanderpol-jacobian 2)) +(make-callbacks ode-stepper vanderpol vanderpol-jacobian 2) (defun integrate-vanderpol (max-time &optional (step-size 1.0d-6) (stepper *step-rk8pd*) (print-steps t)) diff --git a/ordinary-differential-equations/ode-system.lisp b/ordinary-differential-equations/ode-system.lisp index 689bf567..1bb30725 100644 --- a/ordinary-differential-equations/ode-system.lisp +++ b/ordinary-differential-equations/ode-system.lisp @@ -1,6 +1,6 @@ ;; ODE system setup ;; Liam Healy, Sun Apr 15 2007 - 14:19 -;; Time-stamp: <2009-02-14 19:31:58EST ode-system.lisp> +;; Time-stamp: <2009-02-15 08:42:48EST ode-system.lisp> ;; $Id$ (in-package :gsl) @@ -24,9 +24,9 @@ (let ((dep (make-symbol "DEP")) (ctime (make-symbol "CTIME")) (cstep (make-symbol "CSTEP"))) - `(let ((stepperobj (make-ode-stepper ,stepper ,dimensions)) + `(let ((stepperobj (make-ode-stepper ,stepper ,dimensions ',function)) (control (make-y-control ,absolute-error ,relative-error)) - (evolve (make-ode-evolution ,dimensions ',function)) + (evolve (make-ode-evolution ,dimensions)) (,dep (make-marray 'double-float :dimensions ,dimensions)) (,ctime (make-marray 'double-float :dimensions 1)) diff --git a/ordinary-differential-equations/stepping.lisp b/ordinary-differential-equations/stepping.lisp index c5f38ce0..453b496f 100644 --- a/ordinary-differential-equations/stepping.lisp +++ b/ordinary-differential-equations/stepping.lisp @@ -1,12 +1,12 @@ ;; Stepping functions for ODE systems. ;; Liam Healy, Mon Sep 24 2007 - 21:33 -;; Time-stamp: <2009-01-25 10:00:40EST stepping.lisp> +;; Time-stamp: <2009-02-15 08:36:27EST stepping.lisp> ;; $Id$ (in-package :gsl) (defmobject ode-stepper "gsl_odeiv_step" - ((type :pointer) (dimensions sizet)) + ((type :pointer) ((first dimensions) sizet)) "stepper for ordinary differential equations" :documentation "Make a stepper for ordinary differential equations. The type is @@ -14,8 +14,39 @@ dimensions is the number of dependent variables. This instance should be reinitialized whenever the next use of it will not be a continuation of a previous step." + :superclasses (callback-included-cl) + :ci-class-slots (ode-system marray (function jacobian) (dimension)) + :class-slots-instance (#.+callback-argument-name+) :initialize-suffix "reset" - :initialize-args nil) + :initialize-args nil + :singular (dimension)) + +(def-make-callbacks ode-stepper + (function jacobian dimension &optional (scalars t)) + (if scalars + `(progn + (defmcallback ,function + :success-failure + (:double (:double ,dimension) (:set :double ,dimension)) + nil nil + ,function) + (defmcallback ,jacobian + :success-failure + (:double + (:double ,dimension) + (:set :double ,(expt dimension 2)) + (:set :double ,dimension)) + nil nil ,jacobian)) + `(progn + (defmcallback ,function + :success-failure + (:double :pointer :pointer) + nil nil + ,function) + (defmcallback ,jacobian + :success-failure + (:double :pointer :pointer :pointer) + nil nil ,jacobian)))) (defmfun name ((object ode-stepper)) "gsl_odeiv_step_name" @@ -34,7 +65,7 @@ step, which can vary if the stepping function itself is adaptive.") (defmfun step-apply - (stepper time step-size y yerr dydt-in dydt-out dydt) + (stepper time step-size y yerr dydt-in dydt-out) "gsl_odeiv_step_apply" (((mpointer stepper) :pointer) (time :double) @@ -43,19 +74,19 @@ (yerr :pointer) (dydt-in :pointer) (dydt-out :pointer) - (dydt :pointer)) + ((callback-struct stepper) :pointer)) :documentation ; FDL - "Apply the stepping function stepper to the system of - equations defined by dydt, using the step size step-size to advance - the system from time time and state y to time t+h. - The new state of the system is stored in y on output, with an - estimate of the absolute error in each component stored in yerr - If the argument dydt_in is not null it should point an array - containing the derivatives for the system at time t on input. This - is optional as the derivatives will be computed internally if they are - not provided, but allows the reuse of existing derivative information. - On output the new derivatives of the system at time t+h will - be stored in dydt-out if it is not null. + "Apply the stepping function stepper to the system of equations + defined by make-ode-stepper, using the step size step-size to + advance the system from time time and state y to time t+h. The new + state of the system is stored in y on output, with an estimate of + the absolute error in each component stored in yerr If the argument + dydt-in is not null it should point an array containing the + derivatives for the system at time t on input. This is optional as + the derivatives will be computed internally if they are not + provided, but allows the reuse of existing derivative information. + On output the new derivatives of the system at time t+h will be + stored in dydt-out if it is not null. User-supplied functions defined in the system dydt should signal an error or return the correct value.") -- GitLab