# Plotting for Set of Initial Conditions

I have solved my system of coupled odes. I have solved it for a set of initial conditions which I had to provide manually, making complications for me. I know there would be an efficient method through which I can obtain a number of plots against a set of initial conditions. Here is my attempt,

H = Sqrt[(1/
3)*(0.5/(a^6*V^2*Exp[6*t])*(P[t]^2 + 0.5*sig^2) + (0.25*m^2*
M^2)*(1 - Exp[-1/(sig^2*M^2)]*Cos[2*\[Psi][t]/M]) + (0.25*g*
M^3)*(Cos[3*\[Psi][t]/M]*Exp[-(9/4)*(sig^2*M^2)] +
3*Sin[\[Psi][t]/M]*Exp[-0.25/(sig^2*M^2)]))];


My equations are:

eqs = {\[Psi]'[t] == P[t] Exp[-3 t]/(H a^3 V),
P'[t] == -(a^3 *V *
Exp[3 t])*((0.5)* (
m^2 Exp[-1/(M^2*sig^2)] Sin[2 \[Psi][t]/M]) - (3*g*
M^2)*(Sin[3*\[Psi][t]/M]*Exp[-(9/4)*(sig^2*M^2)] +
Cos[\[Psi][t]/M]*Exp[-0.25/(sig^2*M^2)]))};


Here is my solution code:

  sol = ParametricNDSolve[{eqs /. {M -> 1.0, m -> 1.0, V -> 1, a -> 1,
sig -> 1000.0, g -> 050}, \[Psi][-10] == c,
P[-10] == b}, {\[Psi], P}, {t, -10, 12}, {c, b},
MaxSteps -> 100000];


Finally, here is my attempt with manually provided initial conditions:(That's pretty hard for me):

 plot = ParametricPlot3D[{{t, \[Psi][16, 12][t],
P[16, 12][t]/Exp[3*t]}, {t, \[Psi][14, 10][t],
P[14, 10][t]/Exp[3*t]}, {t, \[Psi][1, 3][t],
P[1, 3][t]/Exp[3*t]}, {t, \[Psi][4, 4][t],
P[4, 4][t]/Exp[3*t]}, {t, \[Psi][6, 2][t],
P[6, 2][t]/Exp[3*t]}, {t, \[Psi][10, 4][t],
P[10, 4][t]/Exp[3*t]}, t, \[Psi][12, 6][t],
P[12, 6][t]/Exp[3*t], {t, \[Psi][-1, -3][t],
P[-1, -3][t]/Exp[2.5*t]}, {t, \[Psi][-4, -4][t],
P[-4, -4][t]/Exp[3*t]}, {t, \[Psi][-6, -2][t],
P[-6, -2][t]/Exp[3*t]}, {t, \[Psi][-10, -4][t],
P[-10, -4][t]/Exp[3*t]}, {t, \[Psi][-12, -6][t],
P[-12, -6][t]/Exp[3*t]}, {t, \[Psi][-14, -10][t],
P[-14, -10][t]/Exp[3*t]}} /. sol, {t, -10, 12},
BoxRatios -> {1, 1, 1}, AxesLabel -> {"t", "\[Psi]", "P"},
Boxed -> False]


This is quite messy. I I want to create a set of initial conditions. For example, I want to give initial conditions; P[-10] ranging from (-5,5) and $$\psi[-10]$$=(-5,5), and for each value of P[-10] whole range of $$\psi[-10]$$ gets plotted. Can we do something like that in Mathematica easily? Please assist, TIA.

## 1 Answer

Maybe this:

curves = Flatten[
Table[{t, ψ[a, b][t], P[a, b][t]/Exp[3*t]}, {a, -5,
5}, {b, -5, 5}] /. sol, 1];
curves // Length;(*11*11= 121 curves *)
plot = ParametricPlot3D[curves // Evaluate, {t, -10, 12},
BoxRatios -> {1, 1, 1}, AxesLabel -> {"t", "ψ", "P"},
Boxed -> False]


• Thanks, Sir, I really appreciate your help.
– Jpmg
Aug 18, 2021 at 3:57
• One more thing, can you tell by how much difference our initial conditions are working?
– Jpmg
Aug 18, 2021 at 4:21