hms/hsim
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

feat: re-hide inner states, properly reset sundials

Browse source
This commit is contained in:
Henri Saudubray 2025-05-12 17:27:52 +02:00
parent 80d4aef23f
commit 76dc461d44
Signed by: hms
GPG key ID: 7065F57ED8856128
14 changed files with 162 additions and 253 deletions
Download patch file Download diff file Expand all files Collapse all files

28
src/lib/solvers/csolver.ml
View file

@ -1,28 +0,0 @@
open Hsim.Types
open Hsim.Solver
open Zls
module type Csolver =
sig
type ('a, 'b) state
type session
type vec
val csolve : ((session, vec) state, carray, carray) csolver
end
module type CsolverC =
sig
type ('a, 'b) state
type session
type vec
val csolve : ((session, vec) state, carray, carray) csolver_c
end
module CsolverOfC =
functor (S : CsolverC) -> (struct
type ('a, 'b) state = ('a, 'b) S.state
type session = S.session
type vec = S.vec
let csolve = d_of_dc S.csolve
end : Csolver)

20
src/lib/solvers/statefulRK45.ml
View file

@ -3,16 +3,14 @@ open Hsim.Types
open Hsim.Solver
open Zls
module Functional : Csolver.CsolverC =
module Functional =
struct
type ('state, 'vec) state = { state: 'state; vec: 'vec }
type session = Odexx.Ode45.t
type vec = carray
let csolve : ((session, vec) state, carray, carray) csolver_c =
let csolve : (carray, carray) csolver_c =
let open Odexx.Ode45 in
let init _ =
let state =
let v = Zls.cmake 0 in
let state = initialize (fun _ _ _ -> ()) (vec v) in
set_stop_time state 1.0; { state; vec=v } in
@ -32,19 +30,17 @@ module Functional : Csolver.CsolverC =
let copy { state; vec } = { state; vec } in
DNodeC { init; step; reset; copy }
DNodeC { state; step; reset; copy }
end
module InPlace : Csolver.CsolverC =
module InPlace =
struct
type ('state, 'vec) state = { mutable state: 'state; mutable vec : 'vec }
type session = Odexx.Ode45.t
type vec = carray
let csolve : ((session, vec) state, carray, carray) csolver_c =
let csolve : (carray, carray) csolver_c =
let open Odexx.Ode45 in
let init _ =
let state =
let v = Zls.cmake 0 in
let state = initialize (fun _ _ _ -> ()) (vec v) in
set_stop_time state 1.0;
@ -65,5 +61,5 @@ module InPlace : Csolver.CsolverC =
let copy { state; vec } =
{ state = copy state; vec = Zls.copy vec } in
DNodeC { init; reset; step; copy }
DNodeC { state; reset; step; copy }
end

34
src/lib/solvers/statefulSundials.ml
View file

@ -3,29 +3,26 @@ open Hsim.Types
open Hsim.Solver
open Zls
module Functional : Csolver.Csolver =
module Functional =
struct
type ('state, 'vec) state = { state : 'state; vec : 'vec }
type session = (Sundials_RealArray.t, Nvector_serial.kind) Cvode.session
type vec = carray
let csolve : ((session, vec) state, carray, carray) csolver =
let csolve : (carray, carray) csolver =
let open Cvode in
let init { size; fder=_; _ } =
let vec = cmake size in
let state =
let vec = cmake 0 in
let state = init Adams default_tolerances (fun _ _ _ -> ()) 0.
(Nvector_serial.wrap vec) in
set_stop_time state 1.0;
{ state; vec } in
let reset { init=i; fder; stop; _ } { vec; _ } =
let fder t cvec dvec =
let dvec' = fder t cvec in blit dvec' dvec in
let reset { init=i; fder; stop; _ } _ =
let f t cvec dvec = let dvec' = fder t cvec in blit dvec' dvec in
let state =
Cvode.init Adams default_tolerances fder 0. (Nvector_serial.wrap i) in
Cvode.init Adams default_tolerances f 0. (Nvector_serial.wrap i) in
set_stop_time state stop;
{ state; vec } in
{ state; vec=i } in
let step ({ state; vec } as s) h =
let y = Nvector_serial.wrap vec in
@ -33,21 +30,18 @@ module Functional : Csolver.Csolver =
let f t = get_dky state y t 0; Nvector_serial.unwrap y in
(h, f), s in
DNode { init; reset; step }
DNode { state; reset; step }
end
module InPlace : Csolver.Csolver =
module InPlace =
struct
type ('state, 'vec) state = { mutable state: 'state; mutable vec : 'vec }
type session = (Sundials_RealArray.t, Nvector_serial.kind) Cvode.session
type vec = carray
let csolve : ((session, vec) state, carray, carray) csolver =
let csolve : (carray, carray) csolver =
let open Cvode in
let init { size; fder=_; _ } =
let vec = cmake size in
let state =
let vec = cmake 0 in
let state = init Adams default_tolerances (fun _ _ _ -> ()) 0.
(Nvector_serial.wrap vec) in
set_stop_time state 1.0;
@ -66,6 +60,6 @@ module InPlace : Csolver.Csolver =
let f t = get_dky s.state y t 0; Nvector_serial.unwrap y in
(h, f), s in
DNode { init; reset; step }
DNode { state; reset; step }
end

21
src/lib/solvers/statefulZ.ml
View file

@ -3,17 +3,14 @@ open Hsim.Types
open Hsim.Solver
open Zls
module Functional : Zsolver.ZsolverC =
module Functional =
struct
type ('state, 'vec) state = { state: 'state; vec: 'vec }
type session = Illinois.t
type vec = zarray
let zsolve : ((session, vec) state, carray, vec, carray) zsolver_c =
let zsolve : (carray, zarray, carray) zsolver_c =
let open Illinois in
let init _ =
let state =
{ state = initialize 0 (fun _ _ _ -> ()) (cmake 0);
vec = zmake 0 } in
@ -33,19 +30,17 @@ module Functional : Zsolver.ZsolverC =
let copy s = s in
DNodeC { init; step; reset; copy }
DNodeC { state; step; reset; copy }
end
module InPlace : Zsolver.ZsolverC =
module InPlace =
struct
type ('state, 'vec) state = { mutable state : 'state; mutable vec : 'vec }
type session = Illinois.t
type vec = zarray
let zsolve : ((session, vec) state, carray, vec, carray) zsolver_c =
let zsolve : (carray, zarray, carray) zsolver_c =
let open Illinois in
let init _ =
let state =
{ state=initialize 0 (fun _ _ _ -> ()) (cmake 0);
vec=zmake 0 } in
@ -65,5 +60,5 @@ module InPlace : Zsolver.ZsolverC =
let copy _ = raise Common.Errors.TODO in
DNodeC { init; step; reset; copy }
DNodeC { state; step; reset; copy }
end

28
src/lib/solvers/zsolver.ml
View file

@ -1,28 +0,0 @@
open Hsim.Types
open Hsim.Solver
open Zls
module type Zsolver =
sig
type ('a, 'b) state
type session
type vec
val zsolve : ((session, vec) state, carray, zarray, carray) zsolver
end
module type ZsolverC =
sig
type ('a, 'b) state
type session
type vec
val zsolve : ((session, vec) state, carray, zarray, carray) zsolver_c
end
module ZsolverOfC =
functor (S : ZsolverC) -> (struct
type ('a, 'b) state = ('a, 'b) S.state
type session = S.session
type vec = S.vec
let zsolve = d_of_dc S.zsolve
end : Zsolver)