Re: The show command freezes
- To: mathgroup at smc.vnet.net
- Subject: [mg90311] Re: The show command freezes
- From: Jean-Marc Gulliet <jeanmarc.gulliet at gmail.com>
- Date: Sat, 5 Jul 2008 04:50:57 -0400 (EDT)
- Organization: The Open University, Milton Keynes, UK
- References: <g4d2sh$ep1$1@smc.vnet.net> <g4klhc$m8n$1@smc.vnet.net>
Aaron Fude wrote:
> Fair enough. Here's the code!
>
> F = 1000;
> K1 = 2; K2 = 1; g = 0.01; H1 = 14*F; H2 = 6*F; H = H1 + H2;
> \[CapitalDelta]1[c_, k_] := c^2/K1^2 - 1;
> \[CapitalGamma]1[c_, k_] := g/(k*K1^2);
> U1[c_, k_] :=
> Power[\[CapitalGamma]1[c, k], 2] - 4*\[CapitalDelta]1[c, k];
> Q1[c_, k_] := Sqrt[U1[c, k]];
> A1[c_, k_] := 1/2 k*Q1[c, k]*H1;
> \[CapitalPhi]1[c_, k_] := E^(-(1/2) k \[CapitalGamma]1[c, k] H1)/(
> 2 I c Cosh[A1[c, k]]);
> \[CapitalDelta]2[c_, k_] := c^2/K2^2 - 1;
> \[CapitalGamma]2[c_, k_] := g/(k*K2^2);
> U2[c_, k_] :=
> Power[\[CapitalGamma]2[c, k], 2] - 4*\[CapitalDelta]2[c, k];
> Q2[c_, k_] := Sqrt[U2[c, k]];
> A2[c_, k_] := 1/2 k*Q2[c, k]*H2;
> \[CapitalPhi]2[c_, k_] := E^(1/2 k \[CapitalGamma]2[c, k] H2)/(
> 2 I c Cosh[A2[c, k]]);
> M[c_, k_] := (\[NoBreak]{
> {0, -2 \[CapitalDelta]1[c, k] Tanh[
> A1[c, k]], -2 \[CapitalDelta]2[c, k] Tanh[A2[c, k]]},
> {g, 0, c k (Q2[c, k] + \[CapitalGamma]2[c, k] Tanh[A2[c, k]])},
> {g, c k (Q1[c, k] - \[CapitalGamma]1[c, k] Tanh[A1[c, k]]), 0}
> }\[NoBreak]);
> \[NoBreak]ns[c_, k_, tol_] := NullSpace[M[c, k], Tolerance -> tol]
> (*fh[c_,k_]:=Det[M[c, k]]*)
> fh[c_, k_] := \[CapitalDelta]1[c, k]*
> Tanh[A1[c,
> k]]*(Q2[c, k] + \[CapitalGamma]2[c, k]*
> Tanh[A2[c, k]]) + \[CapitalDelta]2[c, k]*
> Tanh[A2[c,
> k]]*(Q1[c, k] - \[CapitalGamma]1[c, k]*Tanh[A1[c, k]]);
> ff[c_, k_] :=
> Piecewise[{{fh[c, k], ( U1[c, k] >= 0) && (U2[c, k] >= 0)}}, None];
>
>
> FirstRoot[k_, p_] :=
> c /. FindRoot[(ff[c, m] /. m -> k) == 0, {c, 1.2},
> WorkingPrecision -> p + 5, PrecisionGoal -> p];
>
> Needs["VectorFieldPlots`"]
> k = 0.001;
> c = FirstRoot[k, 40];
>
> NS = ns[c, k, 10^-12];
>
> ZRange = {0, H};
>
> TicksYes = True;
> L = 2*H;
>
> vf1[x_, z_] := {\[CapitalGamma]1[c, k] + Q1[c, k], -2
> I \[CapitalDelta]1[c, k]}*E^(
> 1/2 k (\[CapitalGamma]1[c, k] - Q1[c, k])
> z) - {\[CapitalGamma]1[c, k] - Q1[c, k], -2
> I \[CapitalDelta]1[c, k]}*E^(
> 1/2 k (\[CapitalGamma]1[c, k] + Q1[c, k]) z);
> vf2[x_, z_] := {\[CapitalGamma]2[c, k] + Q2[c, k], -2
> I \[CapitalDelta]2[c, k]}*E^(
> 1/2 k (\[CapitalGamma]2[c, k] - Q2[c, k]) (z -
> H)) - {\[CapitalGamma]2[c, k] - Q2[c, k], -2
> I \[CapitalDelta]2[c, k]}*E^(
> 1/2 k (\[CapitalGamma]2[c, k] + Q2[c, k]) (z - H));
> vf[x_, z_] := Re[Piecewise[{
> {\[CapitalPhi]1[c, k] NS[[1]][[2]]*vf1[x, z], z < H1},
> {\[CapitalPhi]2[c, k] NS[[1]][[3]]*vf2[x, z], z > H1}}]*E^(
> I k (x - 2*c) )];
> profile =
> ParametricPlot[{Abs[Norm[vf[0, z]]], z}, {z, 0, H},
> AxesOrigin -> {0, 0}, AspectRatio -> 1/1.5,
> Ticks -> {TicksYes, Automatic}, PlotStyle -> {Thick, Black},
> PlotRange -> {Full, ZRange},
> AxesLabel -> {"|v|", "z"}, PlotPoints -> 1000];
>
> S0 = Graphics[{Dashed, Line[{{0, H1}, {1, H1}}]}];
>
> Show[profile]
> (*Show[profile, S0]*) (* This line makes it freeze *)
Aaron,
What version of Mathematica do you use? On my system, even with the
number of plot points increased ten fold, I get both plots in a blink:
profile =
ParametricPlot[{Abs[Norm[vf[0, z]]], z}, {z, 0, H},
AxesOrigin -> {0, 0}, AspectRatio -> 1/1.5,
Ticks -> {TicksYes, Automatic}, PlotStyle -> {Thick, Black},
PlotRange -> {Full, ZRange}, AxesLabel -> {"|v|", "z"},
PlotPoints -> 10000];
S0 = Graphics[{Dashed, Line[{{0, H1}, {1, H1}}]}];
Show[profile]
Show[profile, S0]
$Version
[... both graphs deleted ...]
"6.0 for Mac OS X x86 (64-bit) (February 7, 2008)"
Regards,
-- Jean-Marc