Services & Resources / Wolfram Forums / MathGroup Archive
-----

MathGroup Archive 2008

[Date Index] [Thread Index] [Author Index]

Search the Archive

Fwd: The show command freezes

  • To: mathgroup at smc.vnet.net
  • Subject: [mg90333] Fwd: The show command freezes
  • From: "Jean-Marc Gulliet" <jeanmarc.gulliet at gmail.com>
  • Date: Sun, 6 Jul 2008 07:19:03 -0400 (EDT)
  • References: <g4d2sh$ep1$1@smc.vnet.net> <g4klhc$m8n$1@smc.vnet.net>

On Fri, Jul 4, 2008 at 8:26 PM, Aaron Fude <aaronfude at gmail.com> wrote:
> Mine is
>
> 6.0 for Microsoft Windows (32-bit) (March 13, 2008)

I won't be able to test on this version during the weekend (only Mac at home!)

Perhaps someone else from the group (I have crossposted the message on
MathGroup.)

Have a great weekend,
-- Jean-Marc

>
> On Fri, Jul 4, 2008 at 4:54 AM, Jean-Marc Gulliet
> <jeanmarc.gulliet at gmail.com> wrote:
>>
>> 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
>
>


  • Prev by Date: Re: simple neural network with mathematica HELP
  • Next by Date: Re: Mathematica and Spaces on Mac Os X
  • Previous by thread: Re: The show command freezes
  • Next by thread: questions about Mathematica