Example 10.4: Centre Manifold depending upon a parameter 3D (Ch 10, page 173)

Clear["Global`*"]
Off[General::spell1]

<<VectorFieldPlots`;

System

Parameters

f[x_,y_,z_]:=-2μ x -3 μ z-2 x y - 4 y z;

g[x_,y_,z_]:=-b y  + (x^2)+ 3x z + 2(z^3);

h[x_,y_,z_]:=- c z + μ x + μ z + x y + 2 y z;

Vector field

V={f[x,y,z],g[x,y,z],h[x,y,z]}

Fixed Points

fp=Solve[{f[(Subscript[x, 1]),(Subscript[y, 1]),(Subscript[z, 1])]==0,g[(Subscript[x, 1]),(Subscript[y, 1]),(Subscript[z, 1])]==0,h[(Subscript[x, 1]),(Subscript[y, 1]),(Subscript[z, 1])]==0},{(Subscript[x, 1]),(Subscript[y, 1]),(Subscript[z, 1])}]

fp1=Sort[fp[[1]]];

{(Subscript[x, 1]),(Subscript[y, 1]),(Subscript[z, 1])}={Extract[fp1,{1}][[2]],Extract[fp1,{2}][[2]],Extract[fp1,{3}][[2]]};
fixedpoint1=Show[Graphics3D[{PointSize[0.025],Hue[0.33],Point[{(Subscript[x, 1]),(Subscript[y, 1]),(Subscript[z, 1])}]},PlotRange->{{(Subscript[x, min]),(Subscript[x, max])},{(Subscript[y, min]),(Subscript[y, max])},{(Subscript[z, min]),(Subscript[z, max])}}]];

Jacobian

a11=Simplify[D[f[x,y,z],x]]

a12=Simplify[D[f[x,y,z],y]]

a13=Simplify[D[f[x,y,z],z]]

a21=Simplify[D[g[x,y,z],x]]

a22=Simplify[D[g[x,y,z],y]]

a23=Simplify[D[g[x,y,z],z]]

a31=Simplify[D[h[x,y,z],x]]

a32=Simplify[D[h[x,y,z],y]]

a33=Simplify[D[h[x,y,z],z]]

J={{a11,a12,a13},{a21,a22,a23},{a31,a32,a33}}

MatrixForm[J]

Acceleration

γ=J . V

Over-Acceleration (jerk)

Γ=(J . γ +Dt[J] . V)/.{Dt[x]->f[x,y,z],Dt[y]->g[x,y,z],Dt[z]->h[x,y,z],Dt[b]->0,Dt[c]->0,Dt[μ]->0}

Fixed Points Stability - Eigenvalues

Eigenvalues[J]/.{x-> (Subscript[x, 1]),y->(Subscript[y, 1]),z->(Subscript[z, 1])}//N

Flow Curvature Manifold

ϕ=Factor[Γ  . Cross[V,γ]]

Centre Manifold Approximation by Flow Curvature Method (Proposition 10.2)

Coefficient (Subscript[a, 10]) (A10)

A10=Factor[-((D[ϕ,x])/(D[ϕ,y]))/.{y->((Subscript[a, 02]) (μ^2) + (Subscript[a, 11]) μ x + (Subscript[a, 20]) (x^2)),z->0}];

Coefficient (Subscript[a, 01]) (A01)

A01=Factor[-((D[ϕ,μ])/(D[ϕ,y]))/.{y->((Subscript[a, 02]) (μ^2) + (Subscript[a, 11]) μ x + (Subscript[a, 20]) (x^2)),z->0}];

Coefficient (Subscript[b, 10]) (B10)

B10=Factor[-((D[ϕ,x])/(D[ϕ,z]))/.{y->0,z->((Subscript[b, 02]) (μ^2) + (Subscript[b, 11]) μ x + (Subscript[b, 20]) (x^2))}];

Coefficient (Subscript[b, 01]) (B01)

B01=Factor[-((D[ϕ,μ])/(D[ϕ,z]))/.{y->0,z->((Subscript[b, 02]) (μ^2) + (Subscript[b, 11]) μ x + (Subscript[b, 20]) (x^2))}];

Coefficient (Subscript[a, 20])

FullSimplify[(1/2)Factor[D[A10,x]/.{μ->0}]/.{x->0}]

Solve[(Subscript[a, 20])==-((-4+3 (b+c) (Subscript[a, 20])-2 b c (Subscript[a, 20]^2))/(b+c-2 b c (Subscript[a, 20]))),(Subscript[a, 20])]

Coefficient (Subscript[a, 11])

FullSimplify[Factor[(1/2)D[A01,x]/.{x->0}]/.{μ->0}]

Solve[(Subscript[a, 11])==-(Subscript[a, 11]),(Subscript[a, 11])]

Coefficient (Subscript[a, 02])

FullSimplify[Factor[(1/2)D[A01,μ]/.{x->0}]/.{μ->0}]

Solve[(Subscript[a, 02])==-(Subscript[a, 02]),(Subscript[a, 02])]

Coefficient (Subscript[b, 20])

FullSimplify[(1/2)Factor[D[B10,x]/.{μ->0}]/.{x->0}]

Solve[(Subscript[b, 20])==-((5 (Subscript[b, 20]))/2),(Subscript[b, 20])]

Coefficient (Subscript[b, 02])

FullSimplify[Factor[(1/2)D[B01,μ]/.{x->0}]/.{μ->0}]

Solve[(Subscript[b, 02])==-((3 (Subscript[b, 02]))/8),(Subscript[b, 02])]

Coefficient (Subscript[b, 11])

Since we have found that (Subscript[b, 20])=0 and (Subscript[b, 02])=0 B10 may be reduced to

B10=Factor[-((D[ϕ,x])/(D[ϕ,z]))/.{y->0,z-> (Subscript[b, 11]) μ x }];

FullSimplify[Factor[D[B10,μ]/.{x->0}]/.{μ->0}]

Solve[(Subscript[b, 11])==(4/c)-3 (Subscript[b, 11]),(Subscript[b, 11])]

Centre Manifold Approximation by Euler's theorem (cf. remark page 174)

Using Euler's theorem leads fo the following system:

x((Overscript[y, •])/(Overscript[x, •]))+μ((∂(Subscript[h, 1]))/(∂μ))=2(Subscript[h, 1])(x,μ)     Eq. (1)

x((Overscript[z, •])/(Overscript[x, •]))+μ((∂(Subscript[h, 2]))/(∂μ))=2(Subscript[h, 2])(x,μ)     Eq. (2)

Equation (1)

D[((Subscript[a, 20]) (x^2) +(Subscript[a, 11]) x μ + (Subscript[a, 02]) (μ^2)),μ]

K1=Expand[x g[x,y,z] +f[x,y,z]( μ (2 μ (Subscript[a, 2])+x (Subscript[a, 11]))-2((Subscript[a, 20]) (x^2) +(Subscript[a, 11]) x μ + (Subscript[a, 02]) (μ^2))) /.{y-> ((Subscript[a, 20]) (x^2) +(Subscript[a, 11]) x μ + (Subscript[a, 02]) (μ^2)),z-> ((Subscript[b, 20]) (x^2) +(Subscript[b, 11]) x μ + (Subscript[b, 02]) (μ^2))}]

Collect[K1,{x}]

Coefficient[K1,{x^3}]/.{μ->0}

Coefficient[K1,{x^2 μ^1}]

Coefficient[K1,{x^1 μ^2}]

Equation (2)

D[((Subscript[b, 20]) (x^2) +(Subscript[b, 11]) x μ + (Subscript[b, 02]) (μ^2)),μ]

K2=Expand[x h[x,y,z] +f[x,y,z]( μ (2 μ (Subscript[b, 2])+x (Subscript[b, 11]))-2((Subscript[b, 20]) (x^2) +(Subscript[b, 11]) x μ + (Subscript[b, 02]) (μ^2))) /.{y-> ((Subscript[a, 20]) (x^2) +(Subscript[a, 11]) x μ + (Subscript[a, 02]) (μ^2)),z-> ((Subscript[b, 20]) (x^2) +(Subscript[b, 11]) x μ + (Subscript[b, 02]) (μ^2))}]

Collect[K2,{x}]

Coefficient[K2,{x^3}]/.{μ->0}

Coefficient[K2,{x^2 μ^1}]

Coefficient[K2,{x^1 μ^2}]