131 lines
4.5 KiB
OCaml
131 lines
4.5 KiB
OCaml
(* The Zelus compiler, version 2.2-dev
|
|
(2025-06-16-15:24) *)
|
|
open Common
|
|
open Ztypes
|
|
open Solvers
|
|
|
|
let (+=) r v = r := !r + v
|
|
|
|
let g = 9.81
|
|
|
|
let y0 = 50.
|
|
|
|
let y'0 = 0.
|
|
|
|
type ball =
|
|
{ mutable major : bool;
|
|
mutable h : float;
|
|
mutable init : bool;
|
|
mutable z : (bool, float) zerocrossing;
|
|
mutable y' : float continuous;
|
|
mutable y : float continuous }
|
|
|
|
let ball cstate =
|
|
|
|
let ball_alloc _ =
|
|
cstate.cmax <- cstate.cmax + 2;
|
|
cstate.zmax <- cstate.zmax + 1;
|
|
{ major = false;
|
|
h = 42.;
|
|
init = false;
|
|
z = { zin = false; zout = 1. };
|
|
y' = { pos = 42.; der = 0. };
|
|
y = { pos = 42.; der = 0. }
|
|
} in
|
|
|
|
let ball_step self (_, ()) =
|
|
let cidx = cstate.cindex in let cpos = ref cidx in
|
|
let zidx = cstate.zindex in let zpos = ref zidx in
|
|
cstate.cindex <- cstate.cindex + 2;
|
|
cstate.zindex <- cstate.zindex + 1;
|
|
self.major <- cstate.major;
|
|
if cstate.major then
|
|
for i = cidx to 1 do Zls.set cstate.dvec i 0. done
|
|
else begin
|
|
self.y'.pos <- Zls.get cstate.cvec !cpos; cpos += 1;
|
|
self.y.pos <- Zls.get cstate.cvec !cpos; cpos += 1
|
|
end;
|
|
let res0, res1 =
|
|
let encore = ref false in
|
|
if self.init then self.y'.pos <- y'0;
|
|
let last_y' = self.y'.pos in
|
|
if self.z.zin then begin
|
|
encore := true; self.y'.pos <- -0.8 *. last_y'
|
|
end;
|
|
self.h <- if !encore then 0. else infinity;
|
|
if self.init then self.y.pos <- y0;
|
|
self.init <- false;
|
|
self.z.zout <- -. self.y.pos;
|
|
self.y'.der <- -. g;
|
|
self.y.der <- self.y'.pos;
|
|
self.y.pos, self.y.der
|
|
in
|
|
cstate.horizon <- min cstate.horizon self.h;
|
|
cpos := cidx;
|
|
if cstate.major then begin
|
|
Zls.set cstate.cvec !cpos self.y'.pos; cpos += 1;
|
|
Zls.set cstate.cvec !cpos self.y.pos; cpos += 1;
|
|
self.z.zin <- false
|
|
end else begin
|
|
self.z.zin <- Zls.get_zin cstate.zinvec !zpos; zpos += 1;
|
|
zpos := zidx;
|
|
Zls.set cstate.zoutvec !zpos self.z.zout; zpos += 1;
|
|
Zls.set cstate.dvec !cpos self.y'.der; cpos += 1;
|
|
Zls.set cstate.dvec !cpos self.y.der; cpos += 1
|
|
end;
|
|
Bigarray.(Array1.of_array Float64 c_layout [| res0; res1 |]) in
|
|
|
|
let ball_reset self = self.init <- true in
|
|
|
|
Node { alloc = ball_alloc; step = ball_step ; reset = ball_reset }
|
|
|
|
type ('f , 'e , 'd , 'c , 'b , 'a) _main =
|
|
{ mutable i_73 : 'f ;
|
|
mutable major_62 : 'e ;
|
|
mutable h_72 : 'd ;
|
|
mutable i_70 : 'c ; mutable h_68 : 'b ; mutable t_63 : 'a }
|
|
|
|
let main (cstate_80:Ztypes.cstate) =
|
|
let Node { alloc = i_73_alloc; step = i_73_step ; reset = i_73_reset } = ball
|
|
cstate_80 in
|
|
let main_alloc _ =
|
|
cstate_80.cmax <- (+) cstate_80.cmax 1;
|
|
{ major_62 = false ;
|
|
h_72 = 42. ;
|
|
i_70 = (false:bool) ;
|
|
h_68 = (42.:float) ; t_63 = { pos = 42.; der = 0. };
|
|
i_73 = i_73_alloc () (* continuous *) } in
|
|
let main_step self ((time_61:float) , ()) =
|
|
((let (cindex_81:int) = cstate_80.cindex in
|
|
let cpos_83 = ref (cindex_81:int) in
|
|
cstate_80.cindex <- (+) cstate_80.cindex 1 ;
|
|
self.major_62 <- cstate_80.major ;
|
|
(if cstate_80.major then
|
|
for i_1 = cindex_81 to 0 do Zls.set cstate_80.dvec i_1 0. done
|
|
else ((self.t_63.pos <- Zls.get cstate_80.cvec !cpos_83 ;
|
|
cpos_83 := (+) !cpos_83 1))) ;
|
|
(let (result_85) =
|
|
let h_71 = ref (infinity:float) in
|
|
(if self.i_70 then self.h_68 <- (+.) time_61 0.) ;
|
|
(let (z_69:bool) = (&&) self.major_62 ((>=) time_61 self.h_68) in
|
|
self.h_68 <- (if z_69 then (+.) self.h_68 0.01 else self.h_68) ;
|
|
h_71 := min !h_71 self.h_68 ;
|
|
self.h_72 <- !h_71 ;
|
|
self.i_70 <- false ;
|
|
self.t_63.der <- 1. ;
|
|
(let (y_64:float) = (i_73_step self.i_73 (time_61 , ())).{0} in
|
|
(begin match z_69 with
|
|
| true -> Printf.printf "%.10e\t%.10e\n" self.t_63.pos y_64
|
|
| _ -> () end) ;
|
|
Bigarray.(Array1.create Float64 c_layout 0))) in
|
|
cstate_80.horizon <- min cstate_80.horizon self.h_72 ;
|
|
cpos_83 := cindex_81 ;
|
|
(if cstate_80.major then
|
|
(((Zls.set cstate_80.cvec !cpos_83 self.t_63.pos ;
|
|
cpos_83 := (+) !cpos_83 1)))
|
|
else (((Zls.set cstate_80.dvec !cpos_83 self.t_63.der ;
|
|
cpos_83 := (+) !cpos_83 1)))) ; result_85))) in
|
|
let main_reset self =
|
|
((self.i_70 <- true ; self.t_63.pos <- 0. ; i_73_reset self.i_73 ):
|
|
unit) in
|
|
Node { alloc = main_alloc; step = main_step ; reset = main_reset }
|