I have encountered somewhat the same problem as here. But with the equations,

$x'(t) = p(t), p'(t) = - x(t) - y(t), y'(t) = q(t), q'(t) = - y(t) - x(t)$

My code is,

abc = {x'[t] == p[t], p'[t] == -x[t] - y[t], y'[t] == q[t], q'[t] == -y[t] - x[t]};

psect[{x0_, p0_, y0_, q0_}] :=

Reap[NDSolve[{abc, x[0] == x0, p[0] == p0, y[0] == y0, q[0] == q0, 
WhenEvent[x[t] == 0 && p[t] > 0, Sow[{y[t], q[t]}]]}, {x[t], p[t],
y[t], q[t]}, {t, 0, 1000}, MaxSteps -> \[Infinity]]][[-1, 1]]

abcdata = Map[psect, {{1, 1, 1, 2}, {2, 1, -1, 2}, {3, 2, -1, 1}}];

ListPlot[abcdata, ImageSize -> Medium]

I got such an error: Mathematica Kernel for Windows has encountered a problem and needs to close.

I appreciate any help.

I have encountered somewhat the same problem as here. But with the equations,

$x'(t) = p(t), p'(t) = - x(t) - y(t), y'(t) = q(t), q'(t) = - y(t) - x(t)$

My code is,

abc = {x'[t] == p[t], p'[t] == -x[t] - y[t], y'[t] == q[t], q'[t] == -y[t] - x[t]};

psect[{x0_, p0_, y0_, q0_}] :=

Reap[NDSolve[{abc, x[0] == x0, p[0] == p0, y[0] == y0, q[0] == q0, 
WhenEvent[x[t] == 0 && p[t] > 0, Sow[{y[t], q[t]}]]}, {x[t], p[t],
y[t], q[t]}, {t, 0, 1000}, MaxSteps -> \[Infinity]]][[-1, 1]]

abcdata = Map[psect, {{1, 1, 1, 2}, {2, 1, -1, 2}, {3, 2, -1, 1}}];

ListPlot[abcdata, ImageSize -> Medium]

I got such an error: Mathematica Kernel for Windows has encountered a problem and needs to close.

I appreciate any help.