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}, 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.001I, 0, 50]], Re[N[sumima[t - 0.001I, 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.0001I, 0, 40]], Re[N[sumima[t - 0.0001I, 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.0001I, 0, 100]], Re[N[sumima[t - 0.0001I, 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.001I, 0, 100]], Re[N[sumima[t - 0.001I, 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.00001I, 0, 100]], Re[N[sumima[t - 0.00001I, 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.0001I, x, 100]], Re[N[sumima[1/3 - 0.0001I, 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.0001I, x, 100]], Re[N[sumima[1/Pi - 0.0001I, 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.00001I, x, 200]], Re[N[sumima[0.85 - 0.00001I, 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.00001I, x, 200]], Re[N[sumima[0.87 - 0.00001I, 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]]