Using ParametricNDSolve with n subscripted functions

Question

I want to calculate trajectories of an n-pendulum. For the number n=1 it's just a pendulum, for n=2 a double pendulum , for n=3 a triple and so on. The Solver has to solve n equations for the angle. The phi's are the angles and ParametricNDSolve has to solve these. The parameters of ParametricNDSolve are the initial conditions - position and velocity at t=0 of each pendulum. So for n=3 pendulums I have 6 Parameters (position and velocity three times).

The Problem is that I cannot figure out how to define these parameters later and plot the function. I tried the solution from the documentation, but I cannot adapt it to my subscripted functions (I guess - maybe the problem lies somewhere else).

(The whole thing works if I use NDSolve and define the starting conditions beforehand.)

my code:

n = 1; (*number of pendulums chained to each other*)

g = 10; 
α =  0; 
tend = 50; 
(* g is gravity, alpha  is friction, tend is end-time of solve *)

m = Table[1, {i, n}]; (* masses of pendulums *)
l = Table[1 + 0 i, {i, n}]; (* lengths of pendulume *)

r[i_, t_] := Sum[l[[j]]*{Sin[ Subscript[ϕ, j][t]], -Cos[Subscript[ϕ, j][t]]}, {j, 1, i}]; (* positions of pendulums *)
T = Sum[m[[i]]*D[r[i, t], t].D[r[i, t], t]/2, {i, 1, n}];(* kinetic energy *)
U = Sum[m[[i]]*r[i, t].{0, g}, {i, 1, n}];(* potential energy *)
F = Sum[1/2*α*m[[i]]*D[r[i, t], t].D[r[i, t], t], {i, 1, n}]; (* friction term *)
L = T - U // Simplify // Evaluate (* lagrangian *)

sol = ParametricNDSolve[
  Table[{D[D[L, Subscript[ϕ, i]'[t]], t] - 
      D[L, Subscript[ϕ, i][t]] == -D[F, 
       Subscript[ϕ, i]'[t]], 
    Subscript[ϕ, i][0] == Subscript[ϕ0s, i], 
    Subscript[ϕ, i]'[0] == Subscript[ϕ0v, i]}, {i, n}], 
  Table[Subscript[ϕ, i][t], {i, 1, n}], {t, 0, tend + 1}, 
  Flatten[Table[{Subscript[ϕ0s, i], Subscript[ϕ0v, i]}, {i, 
     n}], 1]]

(* ϕ0s is start value, ϕ0v is start velocity *)

f10 = Subscript[ϕ, 1][1, 0][t] /. sol
Plot[f10[t], {t, 0, 1}]

Help would be much appreciated. For anyone interested, I'm trying to find cyclic solutions of the pendulum.

Answer 1

Example for n=3

n = 3;(*number of pendulums chained to each other*)g = 10;
\[Alpha] = 0;
tend = 50;
(*g is gravity,alpha is friction,tend is end-time of solve*)

m = Table[1, {i, n}];(*masses of pendulums*)l = 
 Table[1 + 0 i, {i, n}];(*lengths of pendulume*)
r[i_, t_] := 
 Sum[l[[j]]*{Sin[
     Subscript[\[Phi], j][t]], -Cos[Subscript[\[Phi], j][t]]}, {j, 1, 
   i}];(*positions of pendulums*)T = 
 Sum[m[[i]]*D[r[i, t], t].D[r[i, t], t]/2, {i, 1, 
   n}];(*kinetic energy*)U = 
 Sum[m[[i]]*r[i, t].{0, g}, {i, 1, n}];(*potential energy*)F = 
 Sum[1/2*\[Alpha]*m[[i]]*D[r[i, t], t].D[r[i, t], t], {i, 1, 
   n}];(*friction term*)L = 
 T - U // Simplify // Evaluate (*lagrangian*);

sol = ParametricNDSolve[
  Table[{D[D[L, Subscript[\[Phi], i]'[t]], t] - 
      D[L, Subscript[\[Phi], i][t]] == -D[F, 
       Subscript[\[Phi], i]'[t]], 
    Subscript[\[Phi], i][0] == Subscript[\[Phi]0s, i], 
    Subscript[\[Phi], i]'[0] == Subscript[\[Phi]0v, i]}, {i, n}], 
  Table[Subscript[\[Phi], i][t], {i, 1, n}], {t, 0, tend + 1}, 
  Flatten[
   Table[{Subscript[\[Phi]0s, i], Subscript[\[Phi]0v, i]}, {i, n}], 1]]

(*\[Phi]0s is start value,\[Phi]0v is start velocity*)



f10 = Subscript[\[Phi], 1][t] /. sol
Plot[f10[1, .1, .1, 1, 0, .1], {t, 0, 1}, 
 PlotLabel -> Row[{"n = ", n}]]

To show several functions we use

Table[f[i] = Subscript[\[Phi], i][t] /. sol, {i, 1, n}]

Plot[Evaluate[Table[f[i][1, .1, .1, 1, 0, .1], {i, 1, n}]], {t, 0, 1},
  PlotLabel -> Row[{"n = ", n}]]