# speed of WhenEvent in NDSolve with many events

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, {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}];][]
(*3.62943*)


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, {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}];][]
(* 2.739674 *)


The following is the vectorized version:

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


Finally, a comparison:

Plot[{sol[][t], sol2[t][]}, {t, 0, 2}, PlotStyle -> {{Thick, Dashed}, Red}] Plot[sol[][t] - sol2[t][], {t, 0, 2}, PlotStyle -> {{Thick, Dashed}, Red},
PlotRange -> All] As one can see, the results are in full agreement.