Conservative systems of 1degree of freedom,    x''=f(x)
Example 2 - Polynomial potential
(v 2/2021)

Clear["Global`*"]

System

f=-(1/4)+2x-4x^3;  (* συνάρτηση δύναμης *)
deq1=x'[t]==y[t]     (* Διαφορικές εξισώσεις του συστήματος *)
deq2=y'[t]==-(1/4)+2x[t]-4x[t]^3

Potential and energy functions

V=-∫f \[DifferentialD]x
graph1=Plot[V,{x,-1.5,1.5}, PlotRange->{-0.5,0.5}]
Energy[x_,y_]=(1/2)y^2+V

Equilibria and Stability index k

eqpoints=NSolve[f==0,x]

x01=x/.eqpoints[[1]]
x02=x/.eqpoints[[2]]
x03=x/.eqpoints[[3]]

Stability index k  (* k>0 : stability, k<0 : instability *)

k=-D[f,x]  (* k= d^2V/dx^2 *)
k1=k /.x->x01    
k2=k /.x->x02  
k3=k /.x->x03

Energy value for Equilibria

E01=Energy[x01,0] 
E02=Energy[x02,0] 
E03=Energy[x03,0]

Bounded motion and Oscillation modes

E1=-0.2; E2=-0.05; E3=0.2;
graph2=Plot[{E1,E2,E3},{x,-1.5,1.5}, PlotStyle->Green];
graph3=Plot[{E01,E02,E03},{x,-1.5,1.5}, PlotStyle->Red];
Show[{graph1,graph2,graph3}, Frame->True,Axes->None, PlotRange->{-0.5,0.5}]

Oscillation mode around x01

Plot[{V,E1},{x,-1.5,1.5}, PlotRange->{-0.5,0.5}]

(* limits of motion *)
sol=NSolve[V-E1==0]

x1=x/.sol[[1]]
x2=x/.sol[[2]]
amplitude=Abs[x2-x1]

(* period *)
period=2*NIntegrate[(2*(E1-V))^(-1/2),{x,x1,x2}]

(* numerical solution *) 
nsol=NDSolve[{deq1,deq2,x[0]==x1,y[0]==0},{x,y},{t,0,3*period}];
xt=x[t]/.nsol[[1]]
Plot[xt,{t,0,3*period}, PlotRange->{-1.5,1}]

Mode 2. Oscillation mode around x03

Plot[{V,E2},{x,-1.5,1.5}, PlotRange->{-0.5,0.5}]

(* limits of motion *)
sol=NSolve[V-E2==0]

(* motion on the right domain *)
x1=x/.sol[[3]]
x2=x/.sol[[4]]
amplitude=Abs[x2-x1]

(* period *)
period2=2*NIntegrate[(2*(E2-V))^(-1/2),{x,x1,x2}]

(* trajectory solution *) 
nsol=NDSolve[{deq1,deq2,x[0]==x1,y[0]==0},{x,y},{t,0,3*period2}];
xt2=x[t]/.nsol[[1]]
Plot[xt2,{t,0,3*period2}, PlotRange->{-1,1}]

Mode 3.  Oscillations around both x01 and x03

Plot[{V,E3},{x,-1.5,1.5}, PlotRange->{-0.5,0.5}]

(* limits of motion *)
sol=NSolve[V-E3==0]

x1=x/.sol[[1]]
x2=x/.sol[[4]]
amplitude=Abs[x2-x1]

(* περίοδος *)
period=2*NIntegrate[(2*(E3-V))^(-1/2),{x,x1,x2}]

(* Λύση *) 
nsol=NDSolve[{deq1,deq2,x[0]==x1,y[0]==0},{x,y},{t,0,3*period}];
xt=x[t]/.nsol[[1]]
Plot[xt,{t,0,3*period}, PlotRange->{-1.5,1}]

Phase Portrait

phasespace=ContourPlot[Energy[x,y],{x,-1.5,1.5},{y,-1.5,1.5},ContourShading->False, Contours->{E01+0.001,E03+0.001,E1,E2,E3, 0.4},PlotPoints->100,FrameLabel->{"x","y"}, ContourLabels->True]

separatrix=ContourPlot[Energy[x,y],{x,-1.5,1.5},{y,-1.5,1.5},ContourShading->False, Contours->{E02},PlotPoints->250,FrameLabel->{"x","y"}, ContourStyle->Red]

vectorfield=VectorPlot[{y,f},{x,-1.5,1.5},{y,-1.5,1.5},VectorPoints->15, VectorScale->{0.02,1.2,None}, VectorStyle->Gray, Frame->None]

Show[phasespace, separatrix,vectorfield]

Period & Amplitude in a separatrix Loop

Print["Energy of left minimum E01=",E01,  "  at x01=",x01]
Print["Energy of maximum E02=",E02]
T0=2Pi/Sqrt[k1];
Print["Period of small oscilations=",T0]

Energy=-0.3;
Print["Calculate Period (of the left potential cavity) at Energy=", Energy]
sol=NSolve[Energy-V==0,x]
x1=x/.sol[[1]];
x2=x/.sol[[2]];
delta=0;
period=2*NIntegrate[(2*(Energy-V))^(-1/2),{x,x1,x2}] ;
Print["Period=",period]

dataET={};  (* data of period *) 
dataEA={};   (* data of amplitude *)
For[Energy=E01+delta, Energy<E02, Energy+=0.001, 
sol=NSolve[Energy-V==0,x];
x1=x/.sol[[1]];
x2=x/.sol[[2]];
period=2*NIntegrate[(2*(Energy-V))^(-1/2),{x,x1,x2}] ;
(* Print["E=", Energy, " x1=",x1,"  x2=",x2,"  T=",period]; *)
AppendTo[dataET,{Energy,period}];
AppendTo[dataEA,{Energy,x2-x1}];
]
Short[dataET]
Short[dataEA]

ListPlot[dataET, PlotRange->{0,10}, PlotLabel->"Period"]
ListPlot[dataEA, PlotRange->{0,2}, PlotLabel->"Amplitude"]