2
$\begingroup$

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. enter image description here

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}]
$\endgroup$
2

2 Answers 2

3
$\begingroup$

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

enter image description here

$\endgroup$
2
  • $\begingroup$ 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. $\endgroup$ Commented May 12, 2021 at 4:21
  • $\begingroup$ @CATrevillian - Then I believe that the OP should specify what the desired plot range is for each segment. $\endgroup$
    – Bob Hanlon
    Commented May 12, 2021 at 4:34
2
$\begingroup$

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},
        {Charting`ScaledTicks[{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}}]

enter image description here

$\endgroup$

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.