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[4I*t])*Exp[I*Pi*(x - 2n)^2/(4t)]
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.01I, 0, 50]], 
      Re[N[sumima[t - 0.01I, 0, 50]]]}, {t, -0.08, 2.08}]
Show[fig1a, Graphics[Text[a, {1, 5}]]]
fig1b = Plot[{Re[sumeig[t - 0.001I, 0, 50]], 
      Re[N[sumima[t - 0.001I, 0, 50]]]}, {t, -0.08, 2.08}]
Show[fig1b, Graphics[Text[b, {1, 9}]]]
fig1c = Plot[{Re[sumeig[t - 0.0001I, 0, 40]], 
      Re[N[sumima[t - 0.0001I, 0, 40]]]}, {t, 0.8, 1.2}]
Show[fig1c, Graphics[Text[c, {0.925, 11}]]]
fig1d = Plot[{Re[sumeig[t - 0.0001I, 0, 100]], 
      Re[N[sumima[t - 0.0001I, 0, 100]]]}, {t, 0.798, 0.902}, 
    PlotRange -> {-18.5, 16.5}]
Show[fig1d, 
  Graphics[{Text[d, {0.8333, 15}], Text[4/5, {.8, -16}], 
      Text[5/6, {.833333, -16}], Text[6/7, {.857143, -16}], 
      Text[7/8, {.875, 14}], Text[8/9, {.888889, 14}],  
      Text[9/10, {.9, 14}], 
      Text[13/16, {.8125, -12}], Text[14/17, { .823529, -12}], 
      Text[16/19, {.842105 , 9}],   Text[17/20, {.85, -12}],
      Text[19/22, {.863636, 9}], Text[20/23, {.869565, -12}], 
      Text[22/25, {.88, 9}], Text[23/26, {.884615, -12}], 
      Text[25/28, {.892857, -12}], Text[17/21, { .809524, 10}], 
      Text[19/23, {.826087, 10}], Text[21/25, {.84, -11}], 
      Text[23/27, {.851852, 10}], Text[25/29, {.862069, -11}], 
      Text[27/31, {.870968, 10}], Text[29/33, {.878788, -11}], 
      Text[31/35, {.885714, 10}], Text[33/37, {.891892, 9.5}], 
      Text[35/39, {.897436, 10}] } ]]
plot1e = Plot[{Re[sumeig[t - 0.001I, 0, 100]], 
      Re[N[sumima[t - 0.001I, 0, 100]]]}, {t, 1.3, 1.7}]
Show[plot1e, Graphics[Text[e, {1.4, 8.5}]]]
plot1f = Plot[{Re[sumeig[t - 0.00001I, 0, 100]], 
      Re[N[sumima[t - 0.00001I, 0, 100]]]}, {t, 1.32, 1.36}]
Show[plot1f, Graphics[Text[f, { 1.327, 21}]]]
Now fix t and vary x.
fig2a = Plot[{Re[sumeig[1/3 - 0.0001I, x, 100]], 
      Re[N[sumima[1/3 - 0.0001I, x, 100]]]}, {x, 0, 1}, PlotRange -> {-1, 20}]
Show[fig2a, Graphics[Text[a, {0.6, 19}]]]
fig2b = Plot[{Re[sumeig[1/Pi - 0.0001I, x, 100]], 
      Re[N[sumima[1/Pi - 0.0001I, x, 100]]]}, {x, 0, 1}]
Show[fig2b, Graphics[Text[b, {0.6, 8}]]]
fig2c = Plot[{Re[sumeig[0.85 - 0.00001I, x, 200]], 
      Re[N[sumima[0.85 - 0.00001I, x, 200]]]}, {x, 0, 1}, 
    PlotRange -> {-20, 20}]
Show[fig2c, Graphics[Text[c, {0.25, 18.5}]]]
fig2d = Plot[{Re[sumeig[0.87 - 0.00001I, x, 200]], 
      Re[N[sumima[0.87 - 0.00001I, x, 200]]]}, {x, 0, 1}, 
    PlotRange -> {-20, 20}]
Show[fig2d, Graphics[Text[d, {0.26, 18}]]]
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}]
Show[fig3a, Graphics[Text[a, {2, 0.85}]]]
fig3b = Plot[Re[P[t, 0, 100]], {t, 0.2, 0.46}]
Show[fig3b, 
  Graphics[{Text[b, {0.24, 0.455}], Text[1/3, {.3333, .35}], 
      Text[1/5, {.2, .31}], Text[3/7, {.4286, .35}], 
      Text[3/11, {.2727, .34}], Text[5/11, {.4545, .34}], 
      Text[3/13, {.2308, .35}], Text[5/13, {.3846, .34}], 
      Text[7/17, {.4118, .34}]}]]
fig4a = Plot[Re[P[7/8, x, 200]], {x, 1.8, 2.2}]
Show[fig4a, Graphics[Text[a, {1.88, 0.735}]]]
fig4b = Plot[Re[P[0.8761234, x, 200]], {x, 1.8, 2.2}]
Show[fig4b, Graphics[Text[b, {1.88, 0.735}]]]