1
$\begingroup$

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.

$\endgroup$

1 Answer 1

1
$\begingroup$

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]

enter image description here

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

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.