speed of WhenEvent in NDSolve with many events

Question

Is there a way to speed up NDSolve with WhenEvent in this example (many state variables and many events)?

n = 555;
vars = Table[f[i], {i, n}];
eqs = Table[f[i]'[t] == 0, {i, n}];
inis = Table[f[i][0] == 0, {i, n}];
action = Table[f[i][t] -> f[i][t] + 1, {i, n}];
AbsoluteTiming[sol = NDSolve[Flatten[{eqs, inis, WhenEvent[t == 1, Evaluate[action]]}], vars, {t, 0, 2}];][[1]]
(*3.62943*)

Answer 1

You need vectorization.

Let's make the ODE a bit more interesting:

n = 555;
vars = Table[f[i], {i, n}];
eqs = Table[f[i]'[t] == Sin[i t/10], {i, n}];
inis = Table[f[i][0] == 0, {i, n}];
action = Table[f[i][t] -> f[i][t] + 1, {i, n}];
AbsoluteTiming[
  sol = NDSolveValue[Flatten[{eqs, inis, WhenEvent[t == 1, Evaluate[action]]}], 
     vars, {t, 0, 2}];][[1]]
(* 2.739674 *)

The following is the vectorized version:

sol2 = NDSolveValue[
    Flatten[{f'[t] == Sin[Range@n/10 t], f[0] == ConstantArray[0, n], 
      WhenEvent[t == 1, f[t] -> f[t] + 1]}], f, {t, 0, 2}]; // AbsoluteTiming
(* {0.143942, Null} *)

Finally, a comparison:

Plot[{sol[[50]][t], sol2[t][[50]]}, {t, 0, 2}, PlotStyle -> {{Thick, Dashed}, Red}]

Plot[sol[[50]][t] - sol2[t][[50]], {t, 0, 2}, PlotStyle -> {{Thick, Dashed}, Red}, 
 PlotRange -> All]

As one can see, the results are in full agreement.