# How to plot two time intervals of a graph simultaneously?

The graphs of my provided code look approximately like the one in the picture below. How is it possible to plot such graphs? Please help how to break the axis scale as shown. Any suggestion appreciated. Thanks a lot.

Subscript[C, i]=2.5*10^6
Subscript[k, e]=315
σ=1*10^-9
Subscript[S, e]=1.58*10^-5
g=2.3*10^16
Subscript[C, e]=2.1*10^4
τ=1*10^-15
a=1/τ
Subscript[w, 1]=1
Subscript[s, 1]=y/(Subscript[w, 1]*σ)
Subscript[b, 1]=g/Subscript[C, e]*(1+(Subscript[k, e]*Subscript[s, 1]^2)/g)
Subscript[Δ, 1]=Sqrt[Subscript[b, 1]^2-4*Subscript[k, e]*Subscript[s, 1]^2*g/(Subscript[C, i]*Subscript[C, e])]
Subscript[p, 11]=(-Subscript[b, 1]+Subscript[Δ, 1])/2
Subscript[p, 12]=(-Subscript[b, 1]-Subscript[Δ, 1])/2
Subscript[T, i]=(Subscript[S, e]*g)/(2*π*τ*Subscript[C, i]*Subscript[C, e])*NIntegrate[BesselJ[0,y]*Exp[-((σ^2*Subscript[s, 1]^2)/4)]*(Exp[-a*t]/((a+Subscript[p, 11])*(a+Subscript[p, 12]))+1/(Subscript[p, 11]-Subscript[p, 12])*(Exp[Subscript[p, 11]*t]/(Subscript[p, 11]+a)-Exp[Subscript[p, 12]*t]/(Subscript[p, 12]+a)))*y/(σ*Subscript[w, 1])^2,{y,0,100}]
Subscript[T, e]=Subscript[T, i]+Subscript[S, e]/(2*π*τ*Subscript[C, e])*NIntegrate[BesselJ[0,y]*Exp[-((σ^2*Subscript[s, 1]^2)/4)]*(-((a*Exp[-a*t])/((a+Subscript[p, 11])*(a+Subscript[p, 12])))+1/(Subscript[p, 11]-Subscript[p, 12])*((Subscript[p, 11]*Exp[Subscript[p, 11]*t])/(Subscript[p, 11]+a)-(Subscript[p, 12]*Exp[Subscript[p, 12]*t])/(Subscript[p, 12]+a)))*y/(σ*Subscript[w, 1])^2,{y,0,100}]
Plot[Subscript[T, e],{t,0,1*10^-14}]
Plot[Subscript[T, i],{t,0,1*10^-14}]

• A related question, though without any answers; and a related answer Commented May 11, 2021 at 1:00
• Commented May 11, 2021 at 2:44

First, I recommend that you avoid using subscripts except for display.

Since the range of your plots is only {t, 0, 10^-14} there are no regions where the functions are essentially constant and where a gap in the axis would be appropriate.

Clear["Global*"]

Format[Ti] = Subscript[T, i];
Format[Te] = Subscript[T, e];

Ci = 25*10^5;
ke = 315;
σ = 1*10^-9;
Se = 158*10^-7;
g = 23*10^15;
Ce = 21*10^3;
τ = 1*10^-15;
a = 1/τ;
s1[w_] = y/(w*σ);
b1[w_] = g/Ce*(1 + (ke*s1[w]^2)/g);
Δ1[w_] = Sqrt[b1[w]^2 - 4*ke*s1[w]^2*g/(Ci*Ce)];
p11[w_] = (-b1[w] + Δ1[w])/2;
p12[w_] = (-b1[w] - Δ1[w])/2;

wValues = {1, 3, 5};

Ti[t_?NumericQ, w_?NumericQ] :=
(Se*g)/(2*π*τ*Ci*Ce)*
NIntegrate[BesselJ[0, y]*Exp[-((σ^2*s1[w]^2)/4)]*
(Exp[-a*t]/((a + p11[w])*(a + p12[w])) +
1/(p11[w] - p12[w])*
(Exp[p11[w]*t]/(p11[w] + a) -
Exp[p12[w]*t]/(p12[w] + a)))*y/(σ*w)^2,
{y, 0, 100},
WorkingPrecision -> 15]

Te[t_?NumericQ, w_?NumericQ] :=
Ti[t, w] + Se/(2*π*τ*Ce)*
NIntegrate[BesselJ[0, y]*Exp[-((σ^2*s1[w]^2)/4)]*
(-((a*Exp[-a*t])/((a + p11[w])*(a + p12[w]))) +
1/(p11[w] - p12[w])*
((p11[w]*Exp[p11[w]*t])/(p11[w] + a) -
(p12[w]*Exp[p12[w]*t])/(p12[w] + a)))*
y/(σ*w)^2,
{y, 0, 100},
WorkingPrecision -> 15]

Legended[
Column[
Plot[
Evaluate@Table[#[t, w], {w, wValues}],
{t, 0, 10^-14},
PlotRange -> All,
Frame -> True,
FrameLabel -> {None,
Style[StringForm["[t]", #], 12, Bold]},
WorkingPrecision -> 15,
PlotStyle -> {{Red, Dashed}, {Blue, Dotted}, Black},
ImageSize -> Medium,
ImagePadding -> {{60, 15}, {20, 8}},
AspectRatio ->
If[# === Te, 1/GoldenRatio, 1/3]] & /@ {Te, Ti}],
Placed[
LineLegend[
{{Red, Dashed}, {Blue, Dotted}, Black},
StringForm["w = ", #] & /@ wValues],
{.6, .9}]] // Quiet


• Bob, in their post, the OP shows the image of the plots they wish to emulate that stop at 10^-14 and then pick back up at 3*10^-12, perhaps this is what they wish to replicate. Commented May 12, 2021 at 4:21
• @CATrevillian - Then I believe that the OP should specify what the desired plot range is for each segment. Commented May 12, 2021 at 4:34

Use the functions Te and Ti from Bob Hanlon's answer to get two plots for each function with desired plot ranges:

{xrangea, xrangeb} = {{0, 10^-14}, {10^-13, 10^-12}};

{yrange1, yrange2} = {{0, 8 10^6}, {0, 350}};

{plot1a, plot1b, plot2a, plot2b} = Quiet@Plot[
Evaluate @ Table[#[t, w], {w, wValues}], {t, #2[[1]], #2[[2]]},
PlotRange -> {All, #3},
PlotRangePadding -> {Automatic, Scaled[.05]}, Axes -> False,
Frame -> True,
FrameTicks -> {{Automatic, Automatic},
{ChartingScaledTicks[{Identity, Identity}][#, #2, 3] &, Automatic}},
FrameLabel -> {None, #4}, WorkingPrecision -> 15,
PlotStyle -> {{Red, Dashed}, {Blue, Dotted}, Black},
PlotLegends -> ({#, #4} /. {{_, None} | {Ti, _} -> None, {Te, _} ->
Placed[PromptForm[w , #] & /@ wValues, {.7, .8}]})] & @@@
(Tuples[{{Te, Ti}, Thread[{{xrangea, xrangeb}, {lbl, None}}]}] /.
{a_, {b_, c_}} :> {a, b, a /. {Te -> yrange1, Ti -> yrange2},
c /. lbl -> Style[a[t], 12, Bold]});


and combine the four plots using Lukas Lang's ResourceFunction["PlotGrid"]

ResourceFunction["PlotGrid"][{{plot1a, plot1b}, {plot2a, plot2b}},
"MergeAxes" -> {"Cut", False}, Spacings -> {20, 30},
ImageSize -> 700, AspectRatio -> 1/GoldenRatio,
ItemSize -> {{{Scaled}, Scaled[.005]}, {700, 300}}]