# Speed up and Smooth Plot3D of NDSolve Evaluated Results

may I ask is there any space for my code to be improved in terms of the speed and resolution of the plotted results. Currently, it takes more than one hour to plot the 3D graph and as shown in the attached example, the 3D plot has lots of spikes rather than smoothed oscillations shown in the single-value (OpticCoupl) evaluated plot (P.S. Time scale in the two plots are slightly different). The code is the following:

Nrmlphoton[t_] = 4.64903*10^22*Piecewise[{{5904.29 t + 3.13641*10^8 t^2 - 7.0716*10^12 t^3 + 5.50886*10^16 t^4 -
1.91492*10^20 t^5 + 2.51145*10^23 t^6,
0 <= t < 0.0002274269422873725}, {-2.86583*10^6 t + 1.69452*10^10 t^2 - 4.01716*10^13 t^3 +
4.77113*10^16 t^4 - 2.83738*10^19 t^5 + 6.75503*10^21 t^6,
0.0007374377891266094 < t < 0.0009481855159674386}, {6.63274*10^6 t - 2.17507*10^10 t^2 + 2.82046*10^13 t^3 -
1.81037*10^16 t^4 + 5.75833*10^18 t^5 - 7.26732*10^20 t^6,
0.0014995956366184178 < t < 0.0016925447841110407}, {0,
0.0002274269422873725 <= t <= 0.0007374377891266094}, {0,
0.0009481855159674386 <= t <= 0.0014995956366184178}, {0,
t >= 0.0016925447841110407}}]

ISCEff = 0.625;
w = 2 Pi 1.45 10^9;
Q = 3.6 10^3;
q0 = 4277;
qthermal = 4277;
Kx = 2.7 10^4;
Ky = 0.6 10^4;
Kz = 1.7 10^3;
Wxz = 1.1 10^4;
Wyz = 2.2 10^4;
Wxy = 4.4 10^3;
Px = 0.76;
Py = 0.16;
Pz = 0.08;
gs = 2 Pi 0.036;
ks = 2 Pi 0.15 10^6;
Ns = 1.3 10^17;

sol1 = ParametricNDSolve[{T'[t] ==
Nrmlphoton ISCEff OpticCoupl S[t]/Ns,
S'[t] == -T'[t] + Kx X[t] + Ky Y[t] + Kz Z[t],
X'[t] ==
T'[t] Px - X[t] Kx - (X[t] - Z[t]) Wxz - (X[t] - Y[t]) Wxy +
I gs (Conjugate[a[t]]  Sminu[t] - Conjugate[Sminu[t]] a[t]),
Y'[t] ==
T'[t] Py - Y[t] Ky - (Y[t] - Z[t]) Wyz - (Y[t] - X[t]) Wxy,
Z'[t] ==
T'[t] Pz - Z[t] Kz + (X[t] - Z[t]) Wxz + (Y[t] - Z[t]) Wyz -
I gs (Conjugate[a[t]]  Sminu[t] - Conjugate[Sminu[t]] a[t]),
Sminu'[t] == -(ks/2) Sminu[t] + I gs (X[t] - Z[t]) a[t],
a'[t] == -(w/Q) a[t] + (w/Q) qthermal - I gs Sminu[t],
a[0] == Sqrt[q0], X[0] == Y[0] == Z[0] == T[0] == 0, S[0] == Ns,
Sminu[0] == 0}, {X, Y, Z, a, T, S, Sminu}, {t, 0.00073,
0.0009}, {OpticCoupl}]

f[OpticCoupl_, t_] := ( a[OpticCoupl] /. sol1)[t]

plotsol1 =
Plot3D[Evaluate[Abs[Log10[Conjugate[f[x, y]] f[x, y]]]], {y, 0.00073,
0.0009}, {x, 0.001, 0.1}, PlotRange -> All,
AxesLabel -> {"t", "OpticCoupl", "n"}, Mesh -> False,
ColorFunction -> "BlueGreenYellow"]


Your input will be much appreciated! Thank you

• Look, how you defined the first function Plot[Nrmlphoton[t], {t, 0, .002}, PlotRange -> All] . Is this realy what you want? Dec 12, 2019 at 6:58
• @Akku14 Hi, thanks for your reply! Yes, this is an essential function I need to simulate my experimental results. But for the evaluation of the ParametricNDSolve model, I only focused on a portion of Nrmlphoton[t] (t from 0.00073 to 0.0009). Do you mean if I shorten the timescale of the Nrmlphoton[t] function, the calculation will be faster? Thank you! Dec 12, 2019 at 11:03