Export the list of value for the system of equation in the Loop using NDSolve

Question

I want to solve a system of ODEs in sweeping a parameter $\omega$, and in that final conditions need to be carried for the initial condition for the next value of parameter $\omega$. Also, I want to export the data to Excel sheet. The given answer is useful, but exporting the values seems very difficult. Here, I have written my code.

tmax = 30; 
X0 = {1, 0.9, 2, 0.5, -1};
X0d = {0, 0, 0, 0, 0};
ω = {0.5, 0.6, 0.7, 0.8, 0.9, 1};
mt = ConstantArray[0, {1000, 6}];
K = 2*IdentityMatrix[5];

i = 1; While[i < 5, K[[i, i + 1]] = -1; i++];
i = 1; While[i < 5, K[[i + 1, i]] = -1; i++]

Table[
    X[t_] := Table[Subscript[x, i][t], {i, 1, 5}];  
    Xb[t_] := Subscript[x, 5][t]*Sin[ω [[j]] t];
    {s} = NDSolve[
        {D[X[t], t, t] + K.X[t] == {Xb[t], 1, Xb[t], 1, Xb[t]} * Sin[t],
        X[0] == X0, X'[0] == X0d},
        X[t],
        {t, 0, tmax}
    ];
    (*Using Subscript[x,1][t] /. s /. t -> tmax  and Updating X0 && X0d*)
    i = 1;
    While[
        i < 6,           
        X0[[i]] = Subscript[x, i][t] /. s /. t -> tmax;    
        X0d[[i]] = D[Subscript[x, i][t] /. s, t] /. t -> tmax;
        i++
    ]; 
    (* To get the list of all values for perticular Subscript[x,i][t] *)
    Needs["DifferentialEquations`InterpolatingFunctionAnatomy`"];
    xvals = InterpolatingFunctionValuesOnGrid[First[First[s]]];
    (* But even for x1 also it is not working *)
    mt[[1 ;; Length[xvals], j]] = xvals;,
    {j, 1, 6}
]

Export["narhari.xls", {"trials" -> mt}]

Here, I am not able to export the list for $x_i$ values and also D[X[t],t]/.t->tmax also not possible.

I am confused among different types of usage of NDSolve.

Answer 1

The problem with this code is to track output NDSolve[] must exactly match input InterpolatingFunctionCoordinates[]. To do this, separate the variables X[t] and X.

tmax = 30; X0 = {1, 0.9, 2, 0.5, -1}; X0d = {0, 0, 0, 0, 
  0}; \[Omega] = {0.5, 0.6, 0.7, 0.8, 0.9, 1};
mt = ConstantArray[0, {1000, 6}];
M = SparseArray[{{i_, i_} -> 
     2, {i_, j_} /; Abs[i - j] == 1 -> -1}, {5, 5}];

X = Table[Subscript[x, i][t], {i, 1, 5}]; X1 = 
 Table[Subscript[x, i]'[t], {i, 1, 5}];
Xb[t_, j_] := Subscript[x, 5][t]*Sin[\[Omega][[j]] t];
f[t_, j_] := {Xb[t, j], 1, Xb[t, j], 1, Xb[t, j]}*Sin[t]
eq[j_] := {D[X, t, t] == -M.X + f[t, j], (X /. t -> 0) == 
    X0, (X1 /. t -> 0) == X0d};
var = Table[Subscript[x, i], {i, 1, 5}]; var1 = 
 Table[Subscript[x, i]', {i, 1, 5}]; T = {t, 0, tmax};

sol = Table[NDSolve[eq[j], var, T], {j, 6}]; sol1 = 
 Table[NDSolve[eq[j], var1, T], {j, 6}];

fun = X /. sol;fun1 = X1 /. sol1;

Let's see what we got

Table[Plot[Evaluate[fun[[i]]], T, PlotLegends -> Automatic, 
  PlotLabel -> \[Omega][[i]]], {i, 6}]


Table[Plot[Evaluate[fun1[[i]]], T, PlotLegends -> Automatic, 
  PlotLabel -> \[Omega][[i]]], {i, 6}]

Now we compose a list of variable $x_1$ for export

ifun = var /. sol;
ifun1 = First[First[First[ifun]]];
Needs["DifferentialEquations`InterpolatingFunctionAnatomy`"];
coords = First[InterpolatingFunctionCoordinates[ifun1]];
Table[mt[[i]] = 
   Table[First[ifun[[j]]][[1]][#], {j, 6}] &@coords[[i]], {i, 
   Length[coords]}];
Export["C:\\…\\var.xls", mt]

Check var.xls and compare the function $x_1(t)and its values on thecoords`

Show[Plot[First[First[fun[[1]]]], T], 
 ListPlot[Transpose[{coords, ifun1[coords]}], PlotStyle -> Red]]