Exploring the (Subscript[V, F])->0 Limit.

Matthew C .  Johnson

        12/7/05

Clear[r, x, rd, xd, r0, rdot0, x0, xdot0, b, z, epsilon, 
      smax, BC, Udot, Vdot, f]
Off[General::"spell1"]

  

  
(*-----------------------------------*)





 (*-----------------------------------*) 
  

f[x_] := ((-1)/2) (x^2) - (b/3) (x^3) + (1/4) (x^4);

  

Udot[
          x_] := -(-x - b (x^2) + (x^3));
Uddot[x_] := -(-1 - 2 b x + 3 (x^2));

s1 = Sort[
            p /. Solve[Udot[p] == 0, p], 
            Less][[1]];
s2 = Sort[
            p /. Solve[Udot[p] == 0, p], 
            Less][[2]];
s3 = Sort[p /. Solve[Udot[p] == 0, p], 
              Less][[3]];

  

V[x_] := 
        f[x] - (1 + z) f[s1];
U[
        x_] := -V[x]
Plot[V[x], {x, -2, 2}, 
          AxesLabel -> {"x", "V[x]"}];

  

x0 = 
        x0 - (10^(-16));
r0 := 
        N[Sqrt[(8/Udot)[x0] (10^(-16))]];
rdot0 := 
        1;
xdot0 := N[-Udot[x0]/4 r0];

  

BC = {r[0] == r0, rd[0] == rdot0, x[0] == x0, 
            xd[0] == xdot0};

 (*We define a system of 4 1  
            st order equations from the 2  
            nd order equations for r (s) and x (s).*) 

Eqns = {rd'[s] == 
              (epsilon^2) r[
                  s] (-(((xd[s]))^2) +  U[x[s]]), xd'[s] + 
                3 rd[s]/r[s] xd[s] + Udot[x[s]] == 0, 
            rd[s] == r'[s], xd[s] == x'[s]};


  


r[t_, smax_, 
            BC_] := (solution = 
              NDSolve[Join[Eqns, BC], {r, x, rd, xd}, {s, 0, smax}, 
                MaxSteps -> 
                  200000]; Evaluate[{r[t]} /. 
                    solution][[1]][[1]]);


  


x[t_, smax_, 
            BC_] := (solution = 
              NDSolve[Join[Eqns, BC], {r, x, rd, xd}, {s, 0, smax}, 
                MaxSteps -> 
                  200000]; Evaluate[{x[t]} /. 
                    solution][[1]][[1]]);


 (*Plot r (s) between its two zeros.*) 

p1 = 
          Plot[r[s, smax, BC], {s, 0, smax}, 
            PlotStyle -> {{Thickness[ .009], Hue[0. ]}}, 
            PlotRange -> All, 
            AxesLabel -> {"s", "r[s]"}];

 (*Plot x (s) between its two zeros.*) 

p3 = 
          Show[Plot[x[s, smax, BC], {s, 0, smax}, 
              PlotStyle -> {{Thickness[ .009], Hue[0.6]}}, 
              PlotRange -> All, AxesLabel -> {"s", "x[s]"}, 
              DisplayFunction -> Identity ], 
            Graphics[{{Dashing[{ .005,  .005}], 
                  Line[{{0, s1}, {smax, s1}}]}, {Dashing[{ .005,  .005}], 
                  Line[{{0, s2}, {smax, s2}}]}, {Dashing[{ .005,  .005}], 
                  Line[{{0, s3}, {smax, s3}}]}}],  
            PlotRange -> {s1 -  .1, s3 +  .1}, 
            DisplayFunction -> $DisplayFunction];

 (*Calculate the action of the instanton.*) 

SI = -4 (Pi^2) NIntegrate[(((r[s, smax, BC]))^3) U[
                    x[s, smax, BC]] + r[s, smax, BC]/(epsilon^2), {s, 0, 
                smax}];

SBG = ((8 (Pi^2))/(3 (epsilon^4))) (1/U)[s1];

Print["The \
instanton action is:"]
Print[
      N[SI]]
Print["The total Euclidean action \
is:"]
Print[N[SI - SBG]]

Some example initial conditions for single - 
        pass instantons .  
            Copy and paste in the cell above.

(*-----------------------------------*) 

b :=  .3;
z :=  .1;
epsilon :=  .6;
x0 := 1.13974688727622;
smax = 13.78420732392601;

  
  

b :=  .3;
z :=  .01;
epsilon :=  .6;
x0 := 1.14958255226612;
smax = 15.27332516289715;

  
  

b :=  .3;
z :=  .001;
epsilon :=  .6;
x0 := 1.150441748398848;
smax = 15.44947137247597;

  
  

b :=  .3;
z :=  .0001;
epsilon :=  .6;
x0 := 1.150526303707762;
smax = 15.47978952529135;

  
  

b :=  .3;
z :=  .00001;
epsilon :=  .6;
x0 := 1.150534745457904;
smax = 15.4994585859033;

  
  

b :=  .3;
z :=  .1;
epsilon :=  .85;
x0 := 0.8589026248965081;
smax = 8.236888698068979;

  
  

b :=  .3;
z :=  .01;
epsilon :=  .85;
x0 := 0.910945569175263;
smax = 8.662829817404183;

  
  

b :=  .3;
z :=  .001;
epsilon :=  .85;
x0 := 0.9161368121027716;
smax = 8.711289175379738;

  
  

b :=  .3;
z :=  .0001;
epsilon :=  .85;
x0 := 0.9166596628532317;
smax = 8.713066498859538;

  
  

b :=  .3;
z :=  .00001;
epsilon :=  .85;
x0 := 0.91670796518813;
smax = 8.715448496063078;

  
  

b :=  .05;
z :=  .1;
epsilon :=  .7;
x0 := 0.871002797708976;
smax = 8.599999999999999;

  
  

b :=  .05;
z :=  .01;
epsilon :=  .7;
x0 := 0.9060392763395042;
smax = 9.099999999999999;

  
  

b :=  .05;
z :=  .001;
epsilon :=  .7;
x0 := 0.909402656808811;
smax = 9.099999999999999;

  
  

b :=  .05;
z :=  .0001;
epsilon :=  .7;
x0 := 0.9097361611585042;
smax = 9.15;

  
  

b :=  .05;
z :=  .1;
epsilon :=  .9;
x0 := 0.4505732202523388;
smax = 6.4;

  
  

b :=  .05;
z :=  .01;
epsilon :=  .9;
x0 := 0.5406508779247492;
smax = 6.8;

  
  

b :=  .05;
z :=  .001;
epsilon :=  .9;
x0 := 0.5490273355737542;
smax = 6.85;

  
  

b :=  .05;
z :=  .0001;
epsilon :=  .9;
x0 := 0.5498335216890011;
smax = 6.85;

Some example initial conditions for multiple - 
        pass instantons .  
            Copy and paste in the first cell.

(*-----------------------------------*) 
b :=  .3;
z :=  .1;
epsilon :=  .6;
x0 :=  .94411758;
smax = 11.57;
  
  
b :=  .3;
z :=  .00001;
epsilon :=  .6;
x0 := 1.0045259;
smax = 12.1;