1
$\begingroup$

Let

sigma1[v_]=-0.0000438577 Sqrt[-5.19886*10^8 + 100. v^2]; sigma2[v_]=-1.*Sqrt[-(1.34039*10^13/( 1.34039*10^13 - (0. + 1.34039*10^12 I) v)) + ((0. + 5.49727*10^16 I) v)/( 1.34039*10^13 - (0. + 1.34039*10^12 I) v) + (5.49714*10^15 v^2)/( 1.34039*10^13 - (0. + 1.34039*10^12 I) v) - ((0. + 2.74857*10^14 I) v^3)/( 1.34039*10^13 - (0. + 1.34039*10^12 I) v) - ( 0.5 Sqrt[-1.20874*10^34 v^2 + (0. + 2.41748*10^33 I) v^3 + 2.41748*10^32 v^4 - (0. + 1.20874*10^31 I) v^5 - 3.02185*10^29 v^6])/(1.34039*10^13 - (0. + 1.34039*10^12 I) v)]; sigma3[v_]= Sqrt[(-1.34039*10^13 + (0. + 5.49727*10^16 I) v + 5.49714*10^15 v^2 - (0. + 2.74857*10^14 I) v^3 - 0.5 Sqrt[v^2 (-1.20874*10^34 + (0. + 2.41748*10^33 I) v + 2.41748*10^32 v^2 - (0. + 1.20874*10^31 I) v^3 - 3.02185*10^29 v^4)])/(1.34039*10^13 - (0. + 1.34039*10^12 I) v)];

where the use the following parameters:

c1=4631.0; c2=2280.1; d=8066.8; eps=0.0168; kap=1; taut=0.1;tauq=0.1;

Consider now the following 5th degree Polynomial h[v]:

h[v_] =I*sigma2[v]*(1+sigma2[v]^2-v^2/c1^2)*(4*sigma1[v]*sigma3[v]-(2-v^2/c2^2)*((1+sigma1[v]^2)*c1^2/c2^2-2))*(1-I*kap*taut*v-(I*d*v/(kap*(1+sigma1[v]^2)))*(1-I*kap*tauq*v-kap^2*tauq^2*v^2/2))+(eps*c1^2*d*v/(kap*c2^2))*(1-I*kap*tauq*v-kap^2*tauq^2*v^2/2)*(4*sigma2[v]*sigma3[v]*c2^2/c1^2+(2-v^2/c2^2)*(2*c2^2/c1^2-v^2/c1^2-sigma2[v]*(1+sigma2[v]^2-v^2/c1^2)))

and further define F(Re(v), Im(v))=Log|h(v)|.

I need a plot like the following Figure 3 from the above information: enter image description here

Note that we use the function h(v) instead of D(v) in Mathematica. Also, it would be nice if possible to show the extremum values and the corresponding points in the figures. Can anyone please help me? I am at basic level in learning Mathematica. Seeking kind help!

Thank you very much in advance!!!

Improve this question
$\endgroup$
1
  • $\begingroup$ What is plotted in figure 3: Log[Abs[h[v]] or Abs[Log[h[v]]]? $\endgroup$ Commented Dec 7, 2023 at 10:47

2 Answers 2

Reset to default
1
$\begingroup$

Assuming we have to plot Log[Abs[h[v]]] (Thanks @user64494 's comment)

Try DensityPlotand Plot3D:

DensityPlot[Evaluate@Log[Abs[h[vre + I vim]]], {vre, 0, 10},{vim, -10, 0 },ColorFunction -> Hue, ColorFunctionScaling -> False]

enter image description here

Plot3D[Evaluate@Log[Abs[h[vre + I vim]]], {vre, 0, 10}, {vim,-10,0 }, AxesLabel -> {"Re[v]", "Im[v]", "Log[Abs[h[v ]]]"},ColorFunction -> Hue, MeshFunctions -> {#3 &}]

enter image description here

Improve this answer
$\endgroup$
2
  • $\begingroup$ Abs@Log!=Log@Abs $\endgroup$ Commented Dec 7, 2023 at 10:32
  • $\begingroup$ For example, Log[Abs[h[2 - I]]] results in 18.8443, but Abs[Log[h[2 - I]]] outputs 18.8781. $\endgroup$ Commented Dec 7, 2023 at 11:07
1
$\begingroup$

Here are plots:

ComplexPlot[Log[Abs[h[v]]], {v, 0 + 0*I, 10 - 10*I}]

enter image description here

ComplexPlot3D[Log[Abs[h[v]]], {v, 0 + 0*I, 10 - 10*I},PlotPoints -> 50]

enter image description here

It is difficult with the extrema since ComplexExpand[h[s + I*t]] takes 140.4 MB.The following works.

NMaximize[{ComplexExpand[Log[Abs[h[s + I*t]]]], s >= 0 && s <= 10 && t >= -10 && t <= 0}, {s, t}]

{56.0063, {s -> 1.21431*10^-9, t -> -10.}}

NMinimize[{ComplexExpand[Log[Abs[h[s+I*t]]]],s>=0&&s<=10&&t>=-10&&t<=0},{s,t},Method->"DifferentialEvolution"]

{-13.3409 + 0. I, {s -> 0., t -> -1.48265*10^-9}}

Improve this answer
$\endgroup$

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.