Point symmetries of 3D Kepler problem

Run TMF064.Package.m first!

Clear["Global`*"]

Variables and differential equations in the form R(x,u,∂u,...) = 0

(* Independent variables *)
IndepVar={t};
(* Dependent variables *)
DepVar={x,y,z};
(* PDE *)
V[x_,y_,z_]=v[Sqrt[x^2+y^2+z^2]];(* general spherical potential*)
(* V[x_,y_,z_]=Z/Sqrt[x^2+y^2+z^2];(* Coulomb potential *) *)
(* V[x_,y_,z_]=Z/(x^2+y^2+z^2);(* Z/r^2 potential *) *)
PDEs = {m D[x[t],t,t]+D[V[x[t],y[t],z[t]],x[t]],m D[y[t],t,t]+D[V[x[t],y[t],z[t]],y[t]],m D[z[t],t,t]+D[V[x[t],y[t],z[t]],z[t]]}

Expression to substitute for in the infinitesimal criterion of invariance

subs = {D[x[t],t,t],D[y[t],t,t],D[z[t],t,t]};
sol=Solve[PDEs==0, subs]

Finding point symmetries by using a more and more specific ansatz

General ansatz

(* Infinitesimals for all variables *)
ξ[t]=Ξ[t,x[t],y[t],z[t]];
η[x]=α[t,x[t],y[t],z[t]];
η[y]=β[t,x[t],y[t],z[t]];
η[z]=γ[t,x[t],y[t],z[t]];
(* Next expression should return zeroes if infinitesimals give a point symmetry of PDEs *)
zero=CheckPointSymmetryOfDE[PDEs,subs, IndepVar, DepVar,ξ,η]

variables=Flatten[Table[Table[var[j],{j,1,2}],{var,DepVar}]]
Column[GetConditionsForPointSymmetries[zero,variables]]/.{(Sqrt[((x[0])^2)+((y[0])^2)+((z[0])^2)])->r,(((((x[0])^2)+((y[0])^2)+((z[0])^2)))^(3/2))->r^3,((x[0])^2)+((y[0])^2)+((z[0])^2)->r^2}

Second ansatz

ξ[t]=δx[t]x[t]+δy[t]y[t]+δz[t]z[t]+δ0[t];
η[x]=αy[t,x[t]]y[t]+αz[t,x[t]]z[t]+α0[t,x[t]];
η[y]=βx[t,y[t]]x[t]+βz[t,y[t]]z[t]+β0[t,y[t]];
η[z]=γx[t,z[t]]x[t]+γy[t,z[t]]y[t]+γ0[t,z[t]];
zero=CheckPointSymmetryOfDE[PDEs,subs, IndepVar, DepVar,ξ,η]

variables=Flatten[Table[Table[var[j],{j,1,2}],{var,DepVar}]]
Column[GetConditionsForPointSymmetries[zero,variables]]/.{(Sqrt[((x[0])^2)+((y[0])^2)+((z[0])^2)])->r,(((((x[0])^2)+((y[0])^2)+((z[0])^2)))^(3/2))->r^3,((x[0])^2)+((y[0])^2)+((z[0])^2)->r^2}

Third ansatz

αy[t,x[t]]=αy0[t]+(δy)'[t]x[t];
αz[t,x[t]]=αz0[t]+(δz)'[t]x[t];
βx[t,y[t]]=βx0[t]+(δx)'[t]y[t];
βz[t,y[t]]=βz0[t]+(δz)'[t]y[t];
γx[t,z[t]]=γx0[t]+(δx)'[t]z[t];
γy[t,z[t]]=γy0[t]+(δy)'[t]z[t];
α0[t,x[t]]=α00[t]+α01[t]x[t]+(δx)'[t]x[t]^2;
β0[t,y[t]]=β00[t]+β01[t]y[t]+(δy)'[t]y[t]^2;
γ0[t,z[t]]=γ00[t]+γ01[t]z[t]+(δz)'[t]z[t]^2;
ξ[t]=δx[t]x[t]+δy[t]y[t]+δz[t]z[t]+δ0[t];
η[x]=αy[t,x[t]]y[t]+αz[t,x[t]]z[t]+α0[t,x[t]];
η[y]=βx[t,y[t]]x[t]+βz[t,y[t]]z[t]+β0[t,y[t]];
η[z]=γx[t,z[t]]x[t]+γy[t,z[t]]y[t]+γ0[t,z[t]];
zero=CheckPointSymmetryOfDE[PDEs,subs, IndepVar, DepVar,ξ,η]

variables=Flatten[Table[Table[var[j],{j,0,2}],{var,DepVar}]]
Column[GetConditionsForPointSymmetries[zero (((((x[0])^2)+((y[0])^2)+((z[0])^2)))^(3/2)),variables]]/.{(Sqrt[((x[0])^2)+((y[0])^2)+((z[0])^2)])->r,(((((x[0])^2)+((y[0])^2)+((z[0])^2)))^(3/2))->r^3,((x[0])^2)+((y[0])^2)+((z[0])^2)->r^2}

Fourth ansatz

(* only for V(r) ≠ a r^2 + b *)
αy[t,x[t]]=c[1];
αz[t,x[t]]=-c[3];
βx[t,y[t]]=-c[1];
βz[t,y[t]]=c[2];
γx[t,z[t]]=c[3];
γy[t,z[t]]=-c[2];
α0[t,x[t]]=α01[t]x[t];
β0[t,y[t]]=β01[t]y[t];
γ0[t,z[t]]=γ01[t]z[t];
ξ[t]=δ0[t];
η[x]=αy[t,x[t]]y[t]+αz[t,x[t]]z[t]+α0[t,x[t]];
η[y]=βx[t,y[t]]x[t]+βz[t,y[t]]z[t]+β0[t,y[t]];
η[z]=γx[t,z[t]]x[t]+γy[t,z[t]]y[t]+γ0[t,z[t]];
zero=CheckPointSymmetryOfDE[PDEs,subs, IndepVar, DepVar,ξ,η]

variables=Flatten[Table[Table[var[j],{j,0,2}],{var,DepVar}]]
Column[GetConditionsForPointSymmetries[zero (((((x[0])^2)+((y[0])^2)+((z[0])^2)))^(3/2)),variables]]/.{(Sqrt[((x[0])^2)+((y[0])^2)+((z[0])^2)])->r,(((((x[0])^2)+((y[0])^2)+((z[0])^2)))^(3/2))->r^3,((x[0])^2)+((y[0])^2)+((z[0])^2)->r^2}

Fifth ansatz

(* only for V(r) ≠ a r^2 + b *)
αy[t,x[t]]=c[1];
αz[t,x[t]]=-c[3];
βx[t,y[t]]=-c[1];
βz[t,y[t]]=c[2];
γx[t,z[t]]=c[3];
γy[t,z[t]]=-c[2];
α0[t,x[t]]=(δ02 t+α00)x[t];
β0[t,y[t]]=(δ02 t+β00)y[t];
γ0[t,z[t]]=(δ02 t+γ00)z[t];
ξ[t] = δ02 t^2+δ01 t+δ00;
η[x] =αy[t,x[t]]y[t]+αz[t,x[t]]z[t]+α0[t,x[t]];
η[y] =βx[t,y[t]]x[t]+βz[t,y[t]]z[t]+β0[t,y[t]];
η[z] =γx[t,z[t]]x[t]+γy[t,z[t]]y[t]+γ0[t,z[t]];
zero=CheckPointSymmetryOfDE[PDEs,subs, IndepVar, DepVar,ξ,η]

variables=Flatten[Table[Table[var[j],{j,0,2}],{var,DepVar}]];
AppendTo[variables,t]
Column[GetConditionsForPointSymmetries[zero (((((x[0])^2)+((y[0])^2)+((z[0])^2)))^(3/2)),variables]]/.{(Sqrt[((x[0])^2)+((y[0])^2)+((z[0])^2)])->r,(((((x[0])^2)+((y[0])^2)+((z[0])^2)))^(3/2))->r^3,((x[0])^2)+((y[0])^2)+((z[0])^2)->r^2}

The last ansatz

nc=4;
αy[t,x[t]]=c[1];
αz[t,x[t]]=-c[3];
βx[t,y[t]]=-c[1];
βz[t,y[t]]=c[2];
γx[t,z[t]]=c[3];
γy[t,z[t]]=-c[2];
α0[t,x[t]]=0;
β0[t,y[t]]=0;
γ0[t,z[t]]=0;
ξ[t]=c[4];
η[x]=αy[t,x[t]]y[t]+αz[t,x[t]]z[t]+α0[t,x[t]];
η[y]=βx[t,y[t]]x[t]+βz[t,y[t]]z[t]+β0[t,y[t]];
η[z]=γx[t,z[t]]x[t]+γy[t,z[t]]y[t]+γ0[t,z[t]];
zero=CheckPointSymmetryOfDE[PDEs,subs, IndepVar, DepVar,ξ,η]

(* Coulomb ansatz *)
nc=5;
αy[t,x[t]]=c[1];
αz[t,x[t]]=-c[3];
βx[t,y[t]]=-c[1];
βz[t,y[t]]=c[2];
γx[t,z[t]]=c[3];
γy[t,z[t]]=-c[2];
α0[t,x[t]]=2/3c[5]x[t];
β0[t,y[t]]=2/3c[5]y[t];
γ0[t,z[t]]=2/3c[5]z[t];
ξ[t]=c[4]+c[5] t;
η[x]=αy[t,x[t]]y[t]+αz[t,x[t]]z[t]+α0[t,x[t]];
η[y]=βx[t,y[t]]x[t]+βz[t,y[t]]z[t]+β0[t,y[t]];
η[z]=γx[t,z[t]]x[t]+γy[t,z[t]]y[t]+γ0[t,z[t]];
zero=CheckPointSymmetryOfDE[PDEs,subs, IndepVar, DepVar,ξ,η]

(* Z/r^2 ansatz *)
nc=6;
αy[t,x[t]]=c[1];
αz[t,x[t]]=-c[3];
βx[t,y[t]]=-c[1];
βz[t,y[t]]=c[2];
γx[t,z[t]]=c[3];
γy[t,z[t]]=-c[2];
α0[t,x[t]]=1/2c[5]x[t]+c[6] t x[t];
β0[t,y[t]]=1/2c[5]y[t]+c[6] t y[t];
γ0[t,z[t]]=1/2c[5]z[t]+c[6] t z[t];
ξ[t]=c[4]+c[5] t+c[6]t^2;
η[x]=αy[t,x[t]]y[t]+αz[t,x[t]]z[t]+α0[t,x[t]];
η[y]=βx[t,y[t]]x[t]+βz[t,y[t]]z[t]+β0[t,y[t]];
η[z]=γx[t,z[t]]x[t]+γy[t,z[t]]y[t]+γ0[t,z[t]];
zero=CheckPointSymmetryOfDE[PDEs,subs, IndepVar, DepVar,ξ,η]

Infinitesimal generators, point transformations and commutator table from the last ansatz

ShowPointSymmetriesAndCommutationRelations[X,f,ϵ,IndepVar,DepVar,ξ,η,c,nc,{}]