(* Content-type: application/mathematica *) (*** Wolfram Notebook File ***) (* http://www.wolfram.com/nb *) (* CreatedBy='Mathematica 6.0' *) (*CacheID: 234*) (* Internal cache information: NotebookFileLineBreakTest NotebookFileLineBreakTest NotebookDataPosition[ 145, 7] NotebookDataLength[ 28459, 670] NotebookOptionsPosition[ 28001, 651] NotebookOutlinePosition[ 28419, 669] CellTagsIndexPosition[ 28376, 666] WindowFrame->Normal*) (* Beginning of Notebook Content *) Notebook[{ Cell["\<\ (* This code is written by Antun Balaz (antun@ipb.ac.rs) from the Scientific \ Computing Laboratory of the Institute of Physics Belgrade, http://www.scl.rs/ The code calculates real-time single-particle one-dimensional effective \ potential W[x, xbar; eps, t] to level eps^(p-1) for time dependent potential \ V[x, t]. The use of level p effective potential for calculation of short-time \ amplitudes leads to substantially reduces errors, proportional to \ eps^(p+1-Pd/2), where P is the number of particles, and d is spatial \ dimensionality. For the case P=d=1 considered in this file, the errors are \ proportional to eps^(p+1/2). In Path-Integral Monte Carlo calculations of \ transition amplitudes, the error is proportional to 1/N^p, where N is the \ number of time steps used in the discretization. The effective potential is \ defined as W[p, x, xbar, eps, t] = Sum[c[m, k] eps^(m - k) xbar^(2 k) + c[m - 1/2, k] \ eps^(m - 1 - k) xbar^(2 k + 1), {m, 0, p - 1}, {k, 0, m}] , where the coefficients c[m, k] and c[m-1/2, k] are calculated by iterating \ the recursions given in Eqs. (49) and (50) from the paper \"Fast Converging \ Path Integrals for Time-Dependent Potentials\" by A. Balaz, I. Vidanovic, A. \ Bogojevic, and A. Pelster, available from http://arxiv.org/abs/0912.2743 The effective potential here is calculated for the specific case of a \ harmonic oscillator V[x] = M omega^2 x^2 / 2, rescaled with the Grosche \ factor Sqrt[t^2+1], as explained in the paper. The effective actions to level p=20 are available in the file \ EffectiveAction-1d-Vt-RT-HOG-p20.m from http://www.scl.rs/speedup/ *)\ \>", "Subsection", CellChangeTimes->{{3.42381068277704*^9, 3.42381073036242*^9}, { 3.423810800855299*^9, 3.423810805995591*^9}, 3.423810846446319*^9, { 3.423812543628626*^9, 3.423812546483864*^9}, 3.42381261430955*^9, { 3.423812718903902*^9, 3.423812746478442*^9}, {3.423820488578125*^9, 3.42382054334375*^9}, {3.423820599359375*^9, 3.423820611359375*^9}, { 3.42382064503125*^9, 3.423820819234375*^9}, {3.423820849890625*^9, 3.423820895921875*^9}, {3.423820981265625*^9, 3.423821047015625*^9}, { 3.423821079*^9, 3.4238211924375*^9}, {3.423821650171875*^9, 3.423821659953125*^9}, {3.423821907703125*^9, 3.423821911328125*^9}, { 3.423822085640625*^9, 3.42382221115625*^9}, {3.423822252234375*^9, 3.4238223495*^9}, {3.423822753921875*^9, 3.42382280321875*^9}, { 3.4238228519375*^9, 3.423822895015625*^9}, {3.423822940828125*^9, 3.423823128796875*^9}, 3.423823174203125*^9, {3.4238232443125*^9, 3.42382327590625*^9}, {3.423823343453125*^9, 3.423823587546875*^9}, { 3.423824143046875*^9, 3.42382414440625*^9}, {3.423825899875*^9, 3.423825903578125*^9}, 3.42393765125*^9, {3.469800787498416*^9, 3.469800852319084*^9}, {3.469801647581909*^9, 3.469801945523847*^9}, { 3.4698019863713303`*^9, 3.469802030281867*^9}, {3.4698020647447453`*^9, 3.469802138141613*^9}, {3.4698022227084017`*^9, 3.469802229051044*^9}, { 3.469806549202832*^9, 3.469806634709569*^9}, {3.469806666549074*^9, 3.469806675043716*^9}, {3.469806711621361*^9, 3.469806718898356*^9}, { 3.469806949450293*^9, 3.4698069676648483`*^9}, {3.4698070210105677`*^9, 3.4698070825568523`*^9}, {3.469810533388669*^9, 3.46981055963455*^9}, { 3.492160375821292*^9, 3.492160386259363*^9}, {3.492160422073659*^9, 3.492160431098172*^9}, {3.4921668004377527`*^9, 3.4921668030289173`*^9}, { 3.492167467426416*^9, 3.492167470447816*^9}}], Cell[BoxData[{ RowBox[{ RowBox[{"p", " ", "=", " ", "20"}], ";"}], "\n", RowBox[{ RowBox[{ RowBox[{ RowBox[{"V", "[", RowBox[{"x_", ",", " ", "t_"}], "]"}], " ", "=", " ", RowBox[{"M", " ", "omega", " ", RowBox[{ RowBox[{ RowBox[{"x", "^", "2"}], "/", " ", "2"}], " ", "/", " ", RowBox[{ RowBox[{"(", RowBox[{ RowBox[{"t", "^", "2"}], " ", "+", " ", "1"}], ")"}], "^", "2"}]}]}]}], ";"}], ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{"CurrentTime", " ", "=", " ", RowBox[{"FromDate", "[", RowBox[{"Date", "[", "]"}], "]"}]}], ";"}], "\n", RowBox[{ RowBox[{"StartTime", " ", "=", " ", "CurrentTime"}], ";"}], "\n", RowBox[{ RowBox[{ RowBox[{"c", "[", RowBox[{"_", ",", " ", "_"}], "]"}], "=", "0"}], ";"}], "\n", RowBox[{"For", "[", RowBox[{ RowBox[{"m", " ", "=", " ", "0"}], ",", " ", RowBox[{"m", " ", "<", " ", "p"}], ",", " ", RowBox[{"m", "++"}], ",", " ", RowBox[{ RowBox[{ RowBox[{"c", "[", RowBox[{"m", ",", " ", "m"}], "]"}], "=", RowBox[{ RowBox[{"D", "[", RowBox[{ RowBox[{"V", "[", RowBox[{"x", ",", " ", "t"}], "]"}], ",", " ", RowBox[{"{", RowBox[{"x", ",", " ", RowBox[{"2", " ", "m"}]}], "}"}]}], "]"}], " ", "/", " ", RowBox[{ RowBox[{"(", RowBox[{ RowBox[{"2", " ", "m"}], "+", "1"}], ")"}], "!"}]}]}], ";", " ", RowBox[{"For", "[", RowBox[{ RowBox[{"k", " ", "=", " ", RowBox[{"m", "-", "1"}]}], ",", " ", RowBox[{"k", " ", "\[GreaterEqual]", " ", "0"}], ",", " ", RowBox[{"k", "--"}], ",", " ", RowBox[{ RowBox[{"c", "[", RowBox[{"m", ",", " ", "k"}], "]"}], "=", RowBox[{"Expand", "[", RowBox[{ RowBox[{"(", RowBox[{ RowBox[{"I", " ", RowBox[{"(", RowBox[{ RowBox[{"2", " ", "k"}], "+", "2"}], ")"}], " ", RowBox[{"(", RowBox[{ RowBox[{"2", " ", "k"}], "+", "1"}], ")"}], " ", RowBox[{"c", "[", RowBox[{"m", ",", " ", RowBox[{"k", "+", "1"}]}], "]"}]}], " ", "+", " ", RowBox[{"I", " ", RowBox[{"D", "[", RowBox[{ RowBox[{"c", "[", RowBox[{ RowBox[{"m", "-", "1"}], ",", " ", "k"}], "]"}], ",", RowBox[{"{", RowBox[{"x", ",", " ", "2"}], "}"}]}], "]"}]}], " ", "+", " ", "\[IndentingNewLine]", RowBox[{"Sum", "[", " ", RowBox[{ RowBox[{ RowBox[{"D", "[", RowBox[{ RowBox[{"c", "[", RowBox[{"l", ",", " ", "r"}], "]"}], ",", " ", RowBox[{"{", RowBox[{"x", ",", " ", "1"}], "}"}]}], "]"}], " ", RowBox[{"D", "[", " ", RowBox[{ RowBox[{"c", "[", RowBox[{ RowBox[{"m", "-", "l", "-", "2"}], ",", " ", RowBox[{"k", "-", "r"}]}], "]"}], ",", " ", RowBox[{"{", RowBox[{"x", ",", " ", "1"}], "}"}]}], "]"}]}], ",", " ", RowBox[{"{", RowBox[{"l", ",", " ", "0", ",", " ", RowBox[{"m", "-", "2"}]}], "}"}], ",", " ", RowBox[{"{", RowBox[{"r", ",", " ", RowBox[{"Max", "[", RowBox[{"0", ",", " ", RowBox[{"k", "-", "m", "+", "l", "+", "2"}]}], "]"}], ",", " ", RowBox[{"Min", "[", RowBox[{"k", ",", " ", "l"}], "]"}]}], "}"}]}], "]"}], " ", "+", " ", RowBox[{"Sum", "[", " ", RowBox[{ RowBox[{ RowBox[{"D", "[", RowBox[{ RowBox[{"c", "[", RowBox[{ RowBox[{"l", "+", RowBox[{"1", "/", "2"}]}], ",", " ", "r"}], "]"}], ",", " ", RowBox[{"{", RowBox[{"x", ",", " ", "1"}], "}"}]}], "]"}], " ", RowBox[{"D", "[", " ", RowBox[{ RowBox[{"c", "[", RowBox[{ RowBox[{"m", "-", "l", "-", RowBox[{"5", "/", "2"}]}], ",", " ", RowBox[{"k", "-", "r", "-", "1"}]}], "]"}], ",", " ", RowBox[{"{", RowBox[{"x", ",", " ", "1"}], "}"}]}], "]"}]}], ",", " ", RowBox[{"{", RowBox[{"l", ",", " ", "0", ",", " ", RowBox[{"m", "-", "2"}]}], "}"}], ",", " ", RowBox[{"{", RowBox[{"r", ",", " ", RowBox[{"Max", "[", RowBox[{"0", ",", " ", RowBox[{"k", "-", "m", "+", "l", "-", "1"}]}], "]"}], ",", " ", RowBox[{"Min", "[", RowBox[{"k", ",", " ", "l"}], "]"}]}], "}"}]}], "]"}], " ", "+", "\[IndentingNewLine]", RowBox[{"Sum", "[", RowBox[{ RowBox[{"2", " ", "r", " ", RowBox[{"(", RowBox[{ RowBox[{"2", " ", "k"}], " ", "-", " ", RowBox[{"2", " ", "r"}], " ", "+", " ", "2"}], ")"}], " ", RowBox[{"c", "[", RowBox[{"l", ",", " ", "r"}], "]"}], " ", RowBox[{"c", "[", RowBox[{ RowBox[{"m", "-", "l", "-", "1"}], ",", " ", RowBox[{"k", "-", "r", "+", "1"}]}], "]"}]}], ",", " ", RowBox[{"{", RowBox[{"l", ",", " ", "0", ",", " ", RowBox[{"m", "-", "1"}]}], "}"}], ",", " ", RowBox[{"{", RowBox[{"r", ",", " ", RowBox[{"Max", "[", RowBox[{"0", ",", " ", RowBox[{"k", "-", "m", "+", "l", "+", "2"}]}], "]"}], ",", " ", RowBox[{"Min", "[", RowBox[{ RowBox[{"k", "+", "1"}], ",", " ", "l"}], "]"}]}], "}"}]}], "]"}], " ", "+", " ", RowBox[{"Sum", "[", RowBox[{ RowBox[{ RowBox[{"(", RowBox[{ RowBox[{"2", " ", "r"}], " ", "+", "1"}], ")"}], " ", RowBox[{"(", RowBox[{ RowBox[{"2", " ", "k"}], " ", "-", " ", RowBox[{"2", " ", "r"}], " ", "+", " ", "1"}], ")"}], " ", RowBox[{"c", "[", RowBox[{ RowBox[{"l", "+", RowBox[{"1", "/", "2"}]}], ",", " ", "r"}], "]"}], " ", RowBox[{"c", "[", RowBox[{ RowBox[{"m", "-", "l", "-", RowBox[{"3", "/", "2"}]}], ",", " ", RowBox[{"k", "-", "r"}]}], "]"}]}], ",", " ", RowBox[{"{", RowBox[{"l", ",", " ", "0", ",", " ", RowBox[{"m", "-", "2"}]}], "}"}], ",", " ", RowBox[{"{", RowBox[{"r", ",", " ", RowBox[{"Max", "[", RowBox[{"0", ",", " ", RowBox[{"k", "-", "m", "+", "l", "+", "2"}]}], "]"}], ",", " ", RowBox[{"Min", "[", RowBox[{"k", ",", " ", "l"}], "]"}]}], "}"}]}], "]"}], " ", "+", " ", RowBox[{"8", " ", RowBox[{"If", "[", RowBox[{ RowBox[{"EvenQ", "[", RowBox[{"m", "-", "k"}], "]"}], ",", " ", "1", ",", " ", "0"}], "]"}], " ", RowBox[{ RowBox[{ RowBox[{ RowBox[{"D", "[", RowBox[{ RowBox[{"D", "[", RowBox[{ RowBox[{"V", "[", RowBox[{"x", ",", " ", "t"}], "]"}], ",", " ", RowBox[{"{", RowBox[{"x", ",", " ", RowBox[{"2", " ", "k"}]}], "}"}]}], "]"}], ",", " ", RowBox[{"{", RowBox[{"t", ",", " ", RowBox[{"m", " ", "-", " ", "k"}]}], "}"}]}], "]"}], " ", "/", " ", RowBox[{ RowBox[{"(", RowBox[{"2", "k"}], ")"}], "!"}]}], " ", "/", RowBox[{ RowBox[{"(", RowBox[{"m", "-", "k"}], ")"}], "!"}]}], " ", "/", " ", RowBox[{"2", "^", RowBox[{"(", RowBox[{"m", "-", "k"}], ")"}]}]}]}]}], ")"}], " ", "/", " ", RowBox[{"(", RowBox[{"8", " ", RowBox[{"(", RowBox[{"m", "+", "k", "+", "1"}], ")"}]}], ")"}]}], "]"}]}]}], "]"}], ";", " ", RowBox[{"For", "[", RowBox[{ RowBox[{"k", " ", "=", " ", "m"}], ",", " ", RowBox[{"k", " ", "\[GreaterEqual]", " ", "0"}], ",", " ", RowBox[{"k", "--"}], ",", " ", RowBox[{ RowBox[{"c", "[", RowBox[{ RowBox[{"m", "+", RowBox[{"1", "/", "2"}]}], ",", " ", "k"}], "]"}], "=", RowBox[{"Expand", "[", RowBox[{ RowBox[{"(", RowBox[{ RowBox[{"I", " ", RowBox[{"(", RowBox[{ RowBox[{"2", " ", "k"}], "+", "3"}], ")"}], " ", RowBox[{"(", RowBox[{ RowBox[{"2", " ", "k"}], "+", "2"}], ")"}], " ", RowBox[{"c", "[", RowBox[{ RowBox[{"m", "+", RowBox[{"1", "/", "2"}]}], ",", " ", RowBox[{"k", "+", "1"}]}], "]"}]}], " ", "+", " ", RowBox[{"I", " ", RowBox[{"D", "[", RowBox[{ RowBox[{"c", "[", RowBox[{ RowBox[{"m", "-", RowBox[{"1", "/", "2"}]}], ",", " ", "k"}], "]"}], ",", RowBox[{"{", RowBox[{"x", ",", " ", "2"}], "}"}]}], "]"}]}], " ", "+", " ", "\[IndentingNewLine]", RowBox[{"Sum", "[", " ", RowBox[{ RowBox[{ RowBox[{"D", "[", RowBox[{ RowBox[{"c", "[", RowBox[{ RowBox[{"l", "+", RowBox[{"1", "/", "2"}]}], ",", " ", "r"}], "]"}], ",", " ", RowBox[{"{", RowBox[{"x", ",", " ", "1"}], "}"}]}], "]"}], " ", RowBox[{"D", "[", " ", RowBox[{ RowBox[{"c", "[", RowBox[{ RowBox[{"m", "-", "l", "-", "2"}], ",", " ", RowBox[{"k", "-", "r"}]}], "]"}], ",", " ", RowBox[{"{", RowBox[{"x", ",", " ", "1"}], "}"}]}], "]"}]}], ",", " ", RowBox[{"{", RowBox[{"l", ",", " ", "0", ",", " ", RowBox[{"m", "-", "2"}]}], "}"}], ",", " ", RowBox[{"{", RowBox[{"r", ",", " ", RowBox[{"Max", "[", RowBox[{"0", ",", " ", RowBox[{"k", "-", "m", "+", "l", "+", "2"}]}], "]"}], ",", " ", RowBox[{"Min", "[", RowBox[{"k", ",", " ", "l"}], "]"}]}], "}"}]}], "]"}], " ", "+", " ", RowBox[{"Sum", "[", " ", RowBox[{ RowBox[{ RowBox[{"D", "[", RowBox[{ RowBox[{"c", "[", RowBox[{"l", ",", " ", "r"}], "]"}], ",", " ", RowBox[{"{", RowBox[{"x", ",", " ", "1"}], "}"}]}], "]"}], " ", RowBox[{"D", "[", " ", RowBox[{ RowBox[{"c", "[", RowBox[{ RowBox[{"m", "-", "l", "-", RowBox[{"3", "/", "2"}]}], ",", " ", RowBox[{"k", "-", "r"}]}], "]"}], ",", " ", RowBox[{"{", RowBox[{"x", ",", " ", "1"}], "}"}]}], "]"}]}], ",", " ", RowBox[{"{", RowBox[{"l", ",", " ", "0", ",", " ", RowBox[{"m", "-", "2"}]}], "}"}], ",", " ", RowBox[{"{", RowBox[{"r", ",", " ", RowBox[{"Max", "[", RowBox[{"0", ",", " ", RowBox[{"k", "-", "m", "+", "l", "+", "2"}]}], "]"}], ",", " ", RowBox[{"Min", "[", RowBox[{"k", ",", " ", "l"}], "]"}]}], "}"}]}], "]"}], " ", "+", "\[IndentingNewLine]", RowBox[{"Sum", "[", RowBox[{ RowBox[{ RowBox[{"(", RowBox[{ RowBox[{"2", " ", "r"}], " ", "+", "1"}], ")"}], " ", RowBox[{"(", RowBox[{ RowBox[{"2", " ", "k"}], " ", "-", " ", RowBox[{"2", " ", "r"}], " ", "+", " ", "2"}], ")"}], " ", RowBox[{"c", "[", RowBox[{ RowBox[{"l", "+", RowBox[{"1", "/", "2"}]}], ",", " ", "r"}], "]"}], " ", RowBox[{"c", "[", RowBox[{ RowBox[{"m", "-", "l", "-", "1"}], ",", " ", RowBox[{"k", "-", "r", "+", "1"}]}], "]"}]}], ",", " ", RowBox[{"{", RowBox[{"l", ",", " ", "0", ",", " ", RowBox[{"m", "-", "1"}]}], "}"}], ",", " ", RowBox[{"{", RowBox[{"r", ",", " ", RowBox[{"Max", "[", RowBox[{"0", ",", " ", RowBox[{"k", "-", "m", "+", "l", "+", "2"}]}], "]"}], ",", " ", RowBox[{"Min", "[", RowBox[{ RowBox[{"k", "+", "1"}], ",", " ", "l"}], "]"}]}], "}"}]}], "]"}], " ", "+", " ", RowBox[{"Sum", "[", RowBox[{ RowBox[{"2", " ", "r", " ", RowBox[{"(", RowBox[{ RowBox[{"2", " ", "k"}], " ", "-", " ", RowBox[{"2", " ", "r"}], " ", "+", " ", "3"}], ")"}], " ", RowBox[{"c", "[", RowBox[{"l", ",", " ", "r"}], "]"}], " ", RowBox[{"c", "[", RowBox[{ RowBox[{"m", "-", "l", "-", RowBox[{"1", "/", "2"}]}], ",", " ", RowBox[{"k", "-", "r", "+", "1"}]}], "]"}]}], ",", " ", RowBox[{"{", RowBox[{"l", ",", " ", "0", ",", " ", RowBox[{"m", "-", "2"}]}], "}"}], ",", " ", RowBox[{"{", RowBox[{"r", ",", " ", RowBox[{"Max", "[", RowBox[{"0", ",", " ", RowBox[{"k", "-", "m", "+", "2"}]}], "]"}], ",", " ", RowBox[{"Min", "[", RowBox[{ RowBox[{"k", "+", "1"}], ",", " ", "l"}], "]"}]}], "}"}]}], "]"}], " ", "+", " ", RowBox[{"8", " ", RowBox[{"If", "[", RowBox[{ RowBox[{"OddQ", "[", RowBox[{"m", "-", "k"}], "]"}], ",", " ", "1", ",", " ", "0"}], "]"}], " ", RowBox[{ RowBox[{ RowBox[{ RowBox[{"D", "[", RowBox[{ RowBox[{"D", "[", RowBox[{ RowBox[{"V", "[", RowBox[{"x", ",", " ", "t"}], "]"}], ",", " ", RowBox[{"{", RowBox[{"x", ",", " ", RowBox[{ RowBox[{"2", " ", "k"}], "+", "1"}]}], "}"}]}], "]"}], ",", " ", RowBox[{"{", RowBox[{"t", ",", " ", RowBox[{"m", " ", "-", " ", "k"}]}], "}"}]}], "]"}], " ", "/", " ", RowBox[{ RowBox[{"(", RowBox[{ RowBox[{"2", "k"}], "+", "1"}], ")"}], "!"}]}], " ", "/", RowBox[{ RowBox[{"(", RowBox[{"m", "-", "k"}], ")"}], "!"}]}], " ", "/", " ", RowBox[{"2", "^", RowBox[{"(", RowBox[{"m", "-", "k"}], ")"}]}]}]}]}], ")"}], " ", "/", " ", RowBox[{"(", RowBox[{"8", " ", RowBox[{"(", RowBox[{"m", "+", "k", "+", "2"}], ")"}]}], ")"}]}], "]"}]}]}], "]"}], ";", "\[IndentingNewLine]", RowBox[{"Print", "[", RowBox[{"\"\
\"", ",",
RowBox[{"m", "+", "1"}], ",", "\"\< contribution calculated.\>\""}],
"]"}], ";", " ",
RowBox[{"CalculationEndTime", "=",
RowBox[{"FromDate", "[",
RowBox[{"Date", "[", "]"}], "]"}]}], ";", " ",
RowBox[{"CalculationTime", "=",
RowBox[{"CalculationEndTime", "-", "StartTime"}]}], ";", " ",
RowBox[{"Print", "[",
RowBox[{
"\"\