Surface of Section

Author

Eric W. Weisstein
March 18, 2006

This notebook downloaded from http://mathworld.wolfram.com/notebooks/DynamicalSystems/SurfaceofSection.nb.

For more information, see Eric's MathWorld entry http://mathworld.wolfram.com/SurfaceofSection.html.

©2006 Wolfram Research, Inc. except for portions noted otherwise

Code

SurfaceOfSection[{x0_,{y0_,dy0_},e_},tmax_]:=Module[{dx0=Sqrt[2/3 y0^3+2e-x0^2-y0^2-2x0^2y0-dy0^2],x,y,t},
If[#=={},{},First[#]]&@Last[Reap[NDSolve[{
x''[t]==-x[t]-2y[t] x[t],
y''[t]==-y[t]-x[t]^2+y[t]^2,
y[0]==y0,
y'[0]==dy0,
x[0]==x0,
x'[0]==dx0
},
{x,y},{t,0,tmax},Method->{EventLocator,"Event"->x[t], "EventAction":> Sow[{y[t], y'[t]}]}
]]]
]

Plot

With[{x=.3},
Internal`DeactivateMessages[
ListPlot[Join@@Table[
SurfaceOfSection[{Random[Real,{-x,x}],{Random[Real,{-x,x}],Random[Real,{-x,x}]},1/8},1000],
{100}],
PlotStyle->{PointSize[.004],Red},
AspectRatio->Automatic,AxesLabel->TraditionalForm/@{y[t],(OverDot[y])[t]},
ImageSize->500]
]
]//Timing