Exploring the Box Propagator

S.  A. Fulling and K. S. Gunturk, July 2001

Notation:

t is in the fourth quadrant of the complex plane.
    Imaginary t yields the heat kernel (at I*t); real t yields the Schrodinger kernel (quantum propagator for a box with periodic boundary conditions).
    A small imaginary part in t also serves as a necessary cutoff in the quantum calculations.
    The box has circumference 2.
    x is the coordinate on the circle with the other coordinate fixed at y=0; in other words, x is the difference between the two spatial coordinates (field point and source point).

eigen[t_, x_, k_]  :=  (1/2) Exp[I*Pi*k*x]*
        Exp[-I*Pi*k^2*t]

image[t_, x_, n_] := (1/Sqrt[4  I*t])*
        Exp[I*Pi*(x - 2  n)^2/(4  t)]

sumeig[t_, x_, K_]  :=  
      N[eigen[t, x, 0] + 
          Sum[eigen[t, x, k] + eigen[t, x, -k],  {k, 1, K}]]

sumima[t_, x_, N_] := 
      Evaluate[image[t, x, 0] + 
          Sum[image[t, x, n] + image[t, x, -n],  {n, 1, N}]]

The propagator as a function of t with x = 0:

fig1a  =  
      Plot[{Re[sumeig[t - 0.01  I, 0, 50]],  
          Re[N[sumima[t - 0.01  I, 0, 50]]]}, {t, -0.08, 2.08},  
        TextStyle -> {FontFamily -> "Times"}]

h = Plot[0, {x, - .1, 2.08}, Ticks  ->  None]

Show[fig1a, h,    Graphics[Text[a,  {1, 4.8}]],  
      AxesOrigin  ->   {- .1, -2},  
      AxesStyle -> AbsoluteThickness[0.5]]

\(fig1b = 
      Plot[{Re[sumeig[t - 0.001  I, 0, 50]], \ 
          Re[N[sumima[t - 0.001  I, 0, 50]]]}, {t, \(-0.08\), 
          2.08}, 
TextStyle -> {FontFamily -> "Times"}]\)

fig1b0 = 
      Plot[0, {x, -0.1, 2.08}, Ticks  ->  None]

Show[fig1b, fig1b0, Graphics[Text[b, {1, 9}]],  
      AxesOrigin  ->  {-0.1, -6}, 
      AxesStyle -> AbsoluteThickness[0.5]]

fig1c = 
      Plot[{Re[sumeig[t - 0.0001  I, 0, 40]],  
          Re[N[sumima[t - 0.0001  I, 0, 40]]]}, {t, 0.8, 1.2}, 
        TextStyle -> {FontFamily -> "Times"}]

fig1c0 = Plot[0, {t, 0.8, 1.2}, Ticks  ->  None]

Show[fig1c, fig1c0, Graphics[Text[c, {1, 11}]],  
      AxesOrigin  ->  {0.8, -16}, 
      AxesStyle -> AbsoluteThickness[0.5]]

fig1d = 
      Plot[{Re[sumeig[t - 0.0001  I, 0, 100]],  
          Re[N[sumima[t - 0.0001  I, 0, 100]]]},  {t, 0.799, 0.903},  
        PlotRange -> {-26.0, 25.0},  
        TextStyle -> {FontFamily -> "Times"}]

fig1d0 = Plot[0, {t, 0.798, 0.903}, Ticks  ->  None]

Show[fig1d, fig1d0,  
      Graphics[{Text[d, {0.833, 20}], 
          Text[4/5,  { .8,  -23}, 
            TextStyle -> {FontFamily -> "Times", 
                FontSize -> 7}],  
          Text[5/6,  { .833333,  -20}, 
            TextStyle -> {FontFamily -> "Times", 
                FontSize -> 7}],  
          Text[6/7,  { .857143,  -16}, 
            TextStyle -> {FontFamily -> "Times", 
                FontSize -> 7}],  
          Text[7/8,  { .875, 19}, 
            TextStyle -> {FontFamily -> "Times", 
                FontSize -> 7}], 
          Text[8/9,  { .888889,  19.5}, 
            TextStyle -> {FontFamily -> "Times", 
                FontSize -> 7}],   Text[9/10,  { .9, 19}, 
            TextStyle -> {FontFamily -> "Times", 
                FontSize -> 7}],  
Text[
            13/16, { .8125, -15}, 
            TextStyle -> {FontFamily -> "Times", 
                FontSize -> 7}], 
          Text[14/17, {  .823529, -15}, 
            TextStyle -> {FontFamily -> "Times", 
                FontSize -> 7}], 
          Text[16/19, { .842105 , 11}, 
            TextStyle -> {FontFamily -> "Times", 
                FontSize -> 7}],    Text[17/20,  { .85, -12}, 
            TextStyle -> {FontFamily -> "Times", 
                FontSize -> 7}], 
Text[
            19/22, { .863636, 12}, 
            TextStyle -> {FontFamily -> "Times", 
                FontSize -> 7}],  
          Text[20/23,  { .869565, -12}, 
            TextStyle -> {FontFamily -> "Times", 
                FontSize -> 7}],  
          Text[22/25, { .88, 13}, 
            TextStyle -> {FontFamily -> "Times", 
                FontSize -> 7}], 
          Text[23/26, { .884615, -12}, 
            TextStyle -> {FontFamily -> "Times", 
                FontSize -> 7}],  
          Text[25/28,  { .892857, -11}, 
            TextStyle -> {FontFamily -> "Times", 
                FontSize -> 7}],  
          Text[17/21,  {  .809524, 10}, 
            TextStyle -> {FontFamily -> "Times", 
                FontSize -> 7}], 
          Text[19/23,  { .826087, 10}, 
            TextStyle -> {FontFamily -> "Times", 
                FontSize -> 7}],  
          Text[21/25,  { .84, -11}, 
            TextStyle -> {FontFamily -> "Times", 
                FontSize -> 7}],  
          Text[23/27,  { .851852, 10}, 
            TextStyle -> {FontFamily -> "Times", 
                FontSize -> 7}],  
          Text[25/29, { .862069, -11}, 
            TextStyle -> {FontFamily -> "Times", 
                FontSize -> 7}],  
          Text[27/31,  { .870968, 10}, 
            TextStyle -> {FontFamily -> "Times", 
                FontSize -> 7}],  
          Text[29/33, { .878788, -11}, 
            TextStyle -> {FontFamily -> "Times", 
                FontSize -> 7}],  
          Text[31/35, { .885714, 12}, 
            TextStyle -> {FontFamily -> "Times", 
                FontSize -> 7}],  
          Text[33/37, { .891892, 11}, 
            TextStyle -> {FontFamily -> "Times", 
                FontSize -> 7}],  
          Text[35/39, { .897436, 12}, 
            TextStyle -> {FontFamily -> "Times", 
                FontSize -> 7}] }  ], 
      AxesOrigin  ->  {0.798, -25},  
      AxesStyle -> AbsoluteThickness[0.5]]

plot1e = 
      Plot[{Re[sumeig[t - 0.001  I, 0, 100]],  
          Re[N[sumima[t - 0.001  I, 0, 100]]]}, {t, 1.3, 1.7}, 
        TextStyle -> {FontFamily -> "Times"}]

plot1e0 = Plot[0, {t, 1.3, 1.7}, Ticks  ->  None]

Show[plot1e, plot1e0, Graphics[Text[e, {1.4, 8}]], 
      AxesOrigin  ->  {1.3, -4}, 
      AxesStyle -> AbsoluteThickness[0.5]]

plot1f = 
      Plot[{Re[sumeig[t - 0.00001  I, 0, 100]],  
          Re[N[sumima[t - 0.00001  I, 0, 100]]]}, {t, 1.32, 1.36}, 
        TextStyle -> {FontFamily -> "Times"}]

plot1f0 = Plot[0, {t, 1.32, 1.36}, Ticks  ->  None]

Show[plot1f, plot1f0, Graphics[Text[f,  { 1.327, 21}]], 
      AxesOrigin  ->  {1.32, -23}, 
      AxesStyle -> AbsoluteThickness[0.5]]

Now fix t and vary x.

fig2a = 
      Plot[{Re[sumeig[1/3 - 0.0001  I, x, 100]],  
          Re[N[sumima[1/3 - 0.0001  I, x, 100]]]},  {x, 0,  1},  
        PlotRange -> {-1, 20}, 
        TextStyle -> {FontFamily -> "Times"}  ]

Show[fig2a, Graphics[Text[a, {0.6, 19}]], 
      AxesStyle -> AbsoluteThickness[0.5]]

fig2b = 
      Plot[{Re[sumeig[1/Pi - 0.0001  I, x, 100]],  
          Re[N[sumima[1/Pi - 0.0001  I, x, 100]]]},  {x, 0,  1.05}, 
        TextStyle -> {FontFamily -> "Times"}]

fig2b0 = Plot[0, {x, 0, 1.05}, Ticks  ->  None]

Show[fig2b, fig2b0, Graphics[Text[b, {0.6, 7.8}]],  
      AxesOrigin  ->  {0, -8}, 
      AxesStyle -> AbsoluteThickness[0.5]]

fig2c = 
      Plot[{Re[sumeig[0.85 - 0.00001  I, x, 200]],  
          Re[N[sumima[0.85 - 0.00001  I, x, 200]]]},  {x, 0,  1.025},  
        PlotRange -> {-20, 20}, 
        TextStyle -> {FontFamily -> "Times"}]

fig2c0 = Plot[0, {x, 0, 1.025}, Ticks  ->  None]

Show[fig2c, fig2c0, Graphics[Text[c, {0.25, 19}]], 
      AxesOrigin  ->  {0, -20}, 
      TextStyle -> {FontFamily -> "Times"}, 
      AxesStyle -> AbsoluteThickness[0.5]]

fig2d = 
      Plot[{Re[sumeig[0.87 - 0.00001  I, x, 200]],  
          Re[N[sumima[0.87 - 0.00001  I, x, 200]]]},  {x, 0,  1.025},  
        PlotRange -> {-20, 20}, 
        TextStyle -> {FontFamily -> "Times"}]

fig2d0 = Plot[0, {x, 0, 1.025}, Ticks  ->  None]

Show[fig2d, fig2d0, Graphics[Text[d, {0.6, 18}]], 
      AxesOrigin  ->  {0, -20}, 
      AxesStyle -> AbsoluteThickness[0.5]]

The antiderivative:

P[t_, x_, K_] := 
      N[Sum[ (1/(Pi*k^2)) 
            Cos[Pi*k*x] (1 - Exp[-I*Pi*k^2*t]), {k, 1, 
            K}]]

fig3a = 
      Plot[Re[P[t, 0, 20]],  {t, 0, 4}, 
        TextStyle -> {FontFamily -> "Times"}]

Show[fig3a, Graphics[Text[a, {2, 0.8}]], 
      AxesStyle -> AbsoluteThickness[0.5] ]

fig3b = 
      Plot[Re[P[t, 0, 100]],  {t, 0.2, 0.46}, 
        TextStyle -> {FontFamily -> "Times"}]

Show[fig3b, 
      Graphics[{Text[b, {0.24, 0.455}],  
          Text[1/3,  { .3333,  .35}, 
            TextStyle -> {FontFamily -> "Times", 
                FontSize -> 7}], 
          Text[1/5, { .2,  .31}, 
            TextStyle -> {FontFamily -> "Times", 
                FontSize -> 7}],  
          Text[3/7, { .4286,  .35}, 
            TextStyle -> {FontFamily -> "Times", 
                FontSize -> 7}],  
          Text[3/11, { .2727,  .34}, 
            TextStyle -> {FontFamily -> "Times", 
                FontSize -> 7}],  
          Text[5/11, { .4545,   .34}, 
            TextStyle -> {FontFamily -> "Times", 
                FontSize -> 7}],  
          Text[3/13, { .2308,  .35}, 
            TextStyle -> {FontFamily -> "Times", 
                FontSize -> 7}],  
          Text[5/13, { .3846,  .34}, 
            TextStyle -> {FontFamily -> "Times", 
                FontSize -> 7}],  
          Text[7/17,  { .4118,  .34}, 
            TextStyle -> {FontFamily -> "Times", 
                FontSize -> 7}]}], 
      AxesOrigin  ->  {0.193, 0.287}, 
      AxesStyle -> AbsoluteThickness[0.5]]

fig4a = 
      Plot[Re[P[7/8, x, 200]], {x, 1.8, 2.2}, 
        TextStyle -> {FontFamily -> "Times"}]

Show[fig4a, Graphics[Text[a, {1.88, 0.735}]], 
      AxesStyle -> AbsoluteThickness[0.5]]

fig4b = 
      Plot[Re[P[0.8761234, x, 200]], {x, 1.8, 2.2}, 
        TextStyle -> {FontFamily -> "Times"}]

Show[fig4b, Graphics[Text[b, {1.88, 0.735}]], 
      AxesStyle -> AbsoluteThickness[0.5]]