feat: start of lift, debugging, cleanup

src/lib/solvers/illinois.ml

@@ -3,7 +3,9 @@
 (* part of the Zelus standard library.                                        *)
 (* It is implemented with in-place modification of arrays.                    *)
 
-let debug = ref false
+let debug () =
+  (* false *)
+  !Common.Debug.debug
 		
 let printf x = Format.printf x
 
@@ -121,7 +123,7 @@ type t = {
 let reinitialize ({ g; f1 = f1; t1 = t1; _ } as s) t c =
   s.t1 <- t;
   g t1 c f1;   (* fill f1, because it is immediately copied into f0 by next_mesh *)
-  if !debug then (printf "z|---------- init(%.24e, ... ----------@." t;
+  if debug () then (printf "z|---------- init(%.24e, ... ----------@." t;
                   log_limit s.f1);
   s.bothf_valid  <- false
 
@@ -152,6 +154,7 @@ let num_roots { f0; _ } = Zls.length f0
 
 (* f0/t0 take the previous values of f1/t1, f1/t1 are refreshed by g *)
 let step ({ g; f0 = f0; f1 = f1; t1 = t1; _ } as s) t c =
+  Common.Debug.print "ZSOL :: Calling [step]";
   (* swap f0 and f1; f0 takes the previous value of f1 *)
   s.f0 <- f1;
   s.t0 <- t1;
@@ -162,7 +165,7 @@ let step ({ g; f0 = f0; f1 = f1; t1 = t1; _ } as s) t c =
   g t c s.f1;
   s.bothf_valid <- true;
 
-  if !debug then
+  if debug () then
     (printf "z|---------- step(%.24e, %.24e)----------@." s.t0 s.t1;
      log_limits s.f0 s.f1)
 
@@ -212,7 +215,7 @@ let find ({ g = g; bothf_valid = bothf_valid;
     dky t_right 0;      (* c = dky_0(t_right); update state *)
     ignore (update_roots calc_zc f_left (get_f_right f_right') roots);
 
-    if !debug then
+    if debug () then
       (printf
           "z|---------- stall(%.24e, %.24e) {interval < %.24e !}--@."
           t_left t_right ttol;
@@ -280,20 +283,20 @@ let find ({ g = g; bothf_valid = bothf_valid;
 
         match check_interval calc_zc f_left f_mid with
         | SearchLeft  ->
-            if !debug then printf "z| (%.24e -- %.24e]   %.24e@."
+            if debug () then printf "z| (%.24e -- %.24e]   %.24e@."
                            t_left t_mid t_right;
             let alpha = if i >= 1 then alpha *. 0.5 else alpha in
             let n_mid = f_mid_from_f_right f_right' in
             seek (t_left, f_left, n_mid,  t_mid,   Some f_mid, alpha, i + 1)
 
         | SearchRight ->
-            if !debug then printf "z|  %.24e   (%.24e -- %.24e]@."
+            if debug () then printf "z|  %.24e   (%.24e -- %.24e]@."
                            t_left t_mid t_right;
             let alpha = if i >= 1 then alpha *. 2.0 else alpha in
             seek (t_mid,  f_mid,  f_left, t_right, f_right',   alpha, i + 1)
 
         | FoundMid    ->
-            if !debug then printf "z|  %.24e   [%.24e]   %.24e@."
+            if debug () then printf "z|  %.24e   [%.24e]   %.24e@."
                            t_left t_mid t_right;
             ignore (update_roots calc_zc f_left f_mid roots);
             let f_tmp = f_mid_from_f_right f_right' in
@@ -303,7 +306,7 @@ let find ({ g = g; bothf_valid = bothf_valid;
 
   if not bothf_valid then (clear_roots roots; assert false)
   else begin
-    if !debug then
+    if debug () then
       printf "z|\nz|---------- find(%.24e, %.24e)----------@." t0 t1;
 
     match check_interval calc_zc f0 f1 with
@@ -314,7 +317,7 @@ let find ({ g = g; bothf_valid = bothf_valid;
       end
 
     | FoundMid    -> begin
-        if !debug then printf "z| zero-crossing at limit (%.24e)@." t1;
+        if debug () then printf "z| zero-crossing at limit (%.24e)@." t1;
         ignore (update_roots calc_zc f0 f1 roots);
         s.bothf_valid <- false;
         t1

src/lib/solvers/odexx.ml

@@ -51,7 +51,9 @@ module GenericODE (Butcher : BUTCHER_TABLEAU) : STATE_ODE_SOLVER =
 struct (* {{{1 *)
   open Bigarray
 
-  let debug = ref false (* !Debug.debug *)
+  let debug () =
+    false
+    (* !Common.Debug.debug *)
 
   let pow = 1.0 /. float(Butcher.order)
 
@@ -274,7 +276,7 @@ struct (* {{{1 *)
            "odexx: step size < min step size (\n       now=%.24e\n         h=%.24e\n< min_step=%.24e)"
            t h s.min_step);
 
-    if !debug then Printf.printf "s|\ns|----------step(%.24e)----------\n" max_t;
+   if debug () then Printf.printf "s|\ns|----------step(%.24e)----------\n" max_t;
 
     let rec onestep (alreadyfailed: bool) h =
 
@@ -288,11 +290,11 @@ struct (* {{{1 *)
       let tnew = if finished then max_t else t +. h *. (mA maxK) in
       mapinto ynew (make_newval y k maxK);
       f tnew ynew k.(maxK);
-      if !debug then log_step t y k.(0) tnew ynew k.(maxK);
+     if debug () then log_step t y k.(0) tnew ynew k.(maxK);
 
       let err = h *. calculate_error (abs_tol /. rel_tol) k y ynew in
       if err > rel_tol then begin
-        if !debug then Printf.printf "s| error exceeds tolerance\n";
+       if debug () then Printf.printf "s| error exceeds tolerance\n";
 
         if h <= hmin then failwith
             (Printf.sprintf "Error (%e) > relative tolerance (%e) at t=%e"

src/lib/solvers/statefulRK45.ml

@@ -22,6 +22,8 @@ module Functional =
         { state; vec = init } in
 
       let step ({ state ; vec=v } as s) h =
+        Common.Debug.print "SOLVER STEP";
+        Common.Debug.print_entry v;
         let y_nv = vec v in
         let h = step state h y_nv in
         let state = copy state in

src/lib/solvers/statefulZ.ml

@@ -15,7 +15,10 @@ module Functional =
           vec = zmake 0 } in
 
       let reset { fzer; init; size } { vec; _ } =
-        let fzer t cvec zout = let zout' = fzer t cvec in blit zout' zout in
+        let fzer t cvec zout =
+          let zout' = fzer t cvec in blit zout' zout in
+        Common.Debug.print "ZSolver Reset";
+        Common.Debug.print_entry init;
         { state = initialize size fzer init;
           vec = if length vec = size then vec else zmake size } in