Another bug fix in propagation generation code in RbXMDSSetup.nb.

1 files changed, 258 insertions, 120 deletions

diff --git a/mathemathica_fwm/RbXMDSSetup.nb b/mathemathica_fwm/RbXMDSSetup.nb
index abe1982..21fe46a 100755
--- a/mathemathica_fwm/RbXMDSSetup.nb
+++ b/mathemathica_fwm/RbXMDSSetup.nb
@@ -1926,7 +1926,12 @@ Cell[BoxData[
    RowBox[{"ToFileName", "[", 

     RowBox[{

      RowBox[{"NotebookDirectory", "[", "]"}], ",", 

-     "\"\<VariableDeclaration.txt\>\""}], "]"}], ",", "%"}], "]"}]], "Input"],

+     "\"\<VariableDeclaration.txt\>\""}], "]"}], ",", "%"}], "]"}]], "Input"]

+}, Open  ]],

+

+Cell[CellGroupData[{

+

+Cell["Find propagation equations", "Section"],

 

 Cell["Here we find the propagation equations.", "Text"],

 

@@ -1936,41 +1941,50 @@ assumed to interact with.\
 \>", "Text"],

 

 Cell[BoxData[

- RowBox[{"subsys", "=", 

-  RowBox[{

+ RowBox[{"transitioncriteria", "=", 

+  RowBox[{"{", 

    RowBox[{

-    RowBox[{"SelectStates", "[", 

-     RowBox[{"system", ",", "#"}], "]"}], "&"}], "/@", 

-   RowBox[{"{", 

     RowBox[{

      RowBox[{

-      RowBox[{

-       RowBox[{"Label", "\[Equal]", "0"}], "&&", 

-       RowBox[{"F", "\[Equal]", "2"}]}], "||", 

-      RowBox[{

-       RowBox[{"Label", "\[Equal]", "1"}], "&&", 

-       RowBox[{"F", "\[Equal]", "1"}]}]}], ",", 

+      RowBox[{"Label", "\[Equal]", "0"}], "&&", 

+      RowBox[{"F", "\[Equal]", "2"}]}], "||", 

      RowBox[{

-      RowBox[{

-       RowBox[{"Label", "\[Equal]", "0"}], "&&", 

-       RowBox[{"F", "\[Equal]", "1"}]}], "||", 

-      RowBox[{

-       RowBox[{"Label", "\[Equal]", "1"}], "&&", 

-       RowBox[{"F", "\[Equal]", "1"}]}]}], ",", 

+      RowBox[{"Label", "\[Equal]", "1"}], "&&", 

+      RowBox[{"F", "\[Equal]", "1"}]}]}], ",", 

+    RowBox[{

      RowBox[{

-      RowBox[{

-       RowBox[{"Label", "\[Equal]", "0"}], "&&", 

-       RowBox[{"F", "\[Equal]", "1"}]}], "||", 

-      RowBox[{

-       RowBox[{"Label", "\[Equal]", "2"}], "&&", 

-       RowBox[{"F", "\[Equal]", "2"}]}]}], ",", 

+      RowBox[{"Label", "\[Equal]", "0"}], "&&", 

+      RowBox[{"F", "\[Equal]", "1"}]}], "||", 

      RowBox[{

-      RowBox[{

-       RowBox[{"Label", "\[Equal]", "0"}], "&&", 

-       RowBox[{"F", "\[Equal]", "2"}]}], "||", 

-      RowBox[{

-       RowBox[{"Label", "\[Equal]", "2"}], "&&", 

-       RowBox[{"F", "\[Equal]", "2"}]}]}]}], "}"}]}]}]], "Input"],

+      RowBox[{"Label", "\[Equal]", "1"}], "&&", 

+      RowBox[{"F", "\[Equal]", "1"}]}]}], ",", 

+    RowBox[{

+     RowBox[{

+      RowBox[{"Label", "\[Equal]", "0"}], "&&", 

+      RowBox[{"F", "\[Equal]", "1"}]}], "||", 

+     RowBox[{

+      RowBox[{"Label", "\[Equal]", "2"}], "&&", 

+      RowBox[{"F", "\[Equal]", "2"}]}]}], ",", 

+    RowBox[{

+     RowBox[{

+      RowBox[{"Label", "\[Equal]", "0"}], "&&", 

+      RowBox[{"F", "\[Equal]", "2"}]}], "||", 

+     RowBox[{

+      RowBox[{"Label", "\[Equal]", "2"}], "&&", 

+      RowBox[{"F", "\[Equal]", "2"}]}]}]}], "}"}]}]], "Input"],

+

+Cell[BoxData[

+ RowBox[{"subsys", "=", 

+  RowBox[{"Table", "[", 

+   RowBox[{

+    RowBox[{"SelectStates", "[", 

+     RowBox[{"system", ",", 

+      RowBox[{"transitioncriteria", "[", 

+       RowBox[{"[", "k", "]"}], "]"}]}], "]"}], ",", 

+    RowBox[{"{", 

+     RowBox[{"k", ",", 

+      RowBox[{"Length", "[", "transitioncriteria", "]"}]}], "}"}]}], 

+   "]"}]}]], "Input"],

 

 Cell["\<\

 The reduced matrix elements corresponding to the transition for each field.\

@@ -1999,93 +2013,218 @@ Cell[BoxData[
         RowBox[{"Dipole", ",", "1"}], "}"}], ",", "2"}], "]"}]}], "}"}]}], 

   ";"}]], "Input"],

 

-Cell["\<\

-Spherical components of the E1 polarization generated on each of the 4 \

-transitions in terms of the density matrix elements.\

-\>", "Text"],

+Cell[TextData[{

+ "The first-order wave equation is given in terms of the rotating-frame \

+density matrix by\n\t",

+ Cell[BoxData[

+  FormBox[

+   RowBox[{

+    RowBox[{

+     FractionBox[

+      RowBox[{"\[PartialD]", 

+       SubscriptBox[

+        StyleBox["E",

+         FontWeight->"Bold",

+         FontSlant->"Plain"], "0"]}], 

+      RowBox[{"\[PartialD]", "z"}]], "+", 

+     RowBox[{

+      FractionBox["1", "c"], 

+      FractionBox[

+       RowBox[{"\[PartialD]", 

+        SubscriptBox[

+         StyleBox["E",

+          FontWeight->"Bold",

+          FontSlant->"Plain"], "0"]}], 

+       RowBox[{"\[PartialD]", "t"}]]}]}], "=", 

+    RowBox[{

+     FractionBox[

+      RowBox[{"4", "\[Pi]", " ", "\[ImaginaryI]", " ", "\[Omega]", " ", "n"}],

+       "c"], 

+     RowBox[{

+      UnderscriptBox["\[Sum]", 

+       RowBox[{"m", "<", "n"}]], 

+      RowBox[{

+       SubscriptBox["\[Rho]", 

+        RowBox[{"n", ",", "m"}]], 

+       SubscriptBox[

+        StyleBox["d",

+         FontWeight->"Bold",

+         FontSlant->"Plain"], 

+        RowBox[{"m", ",", "n"}]], " "}]}]}]}], TraditionalForm]],

+  FormatType->"TraditionalForm"]

+}], "Text"],

 

-Cell[BoxData[

- RowBox[{"polarizationcomponents", "=", 

-  RowBox[{"MapThread", "[", 

+Cell[TextData[{

+ "First we calculate the right-hand side. Here are the covariant spherical \

+components of ",

+ Cell[BoxData[

+  FormBox[

    RowBox[{

+    UnderscriptBox["\[Sum]", 

+     RowBox[{"m", "<", "n"}]], 

     RowBox[{

-     RowBox[{"Expand", "[", 

+     SubscriptBox["\[Rho]", 

+      RowBox[{"n", ",", "m"}]], 

+     SubscriptBox[

+      StyleBox["d",

+       FontWeight->"Bold",

+       FontSlant->"Plain"], 

+      RowBox[{"m", ",", "n"}]]}]}], TraditionalForm]],

+  FormatType->"TraditionalForm"],

+ " for each of the four transitions, in terms of the reduced dipole matrix \

+element ||d||."

+}], "Text"],

+

+Cell[BoxData[

+ RowBox[{"polarizationcomponents1", "=", 

+  RowBox[{

+   RowBox[{"Table", "[", 

+    RowBox[{

+     RowBox[{"Sum", "[", 

       RowBox[{

        RowBox[{

-        RowBox[{"ExpandDipoleRME", "[", 

-         RowBox[{"#1", ",", 

-          RowBox[{

-           RowBox[{"4", "\[Pi]", " ", "\[ImaginaryI]", " ", 

-            RowBox[{"Energy", "[", 

-             RowBox[{"Last", "@", "#2"}], "]"}], " ", "n0", " ", "#2", 

-            RowBox[{"Components", "@", " ", 

-             RowBox[{"ECT", "@", 

-              RowBox[{"Sum", "[", 

-               RowBox[{

-                RowBox[{

-                 RowBox[{

-                  RowBox[{"DensityMatrix", "[", "#1", "]"}], "[", 

-                  RowBox[{"[", 

-                   RowBox[{"j", ",", "i"}], "]"}], "]"}], 

-                 RowBox[{"WignerEckart", "[", 

-                  RowBox[{

-                   RowBox[{"#1", "[", 

-                    RowBox[{"[", "i", "]"}], "]"}], ",", 

-                   RowBox[{"{", 

-                    RowBox[{"Dipole", ",", "1"}], "}"}], ",", 

-                   RowBox[{"#1", "[", 

-                    RowBox[{"[", "j", "]"}], "]"}]}], "]"}]}], ",", 

-                RowBox[{"{", 

-                 RowBox[{"i", ",", 

-                  RowBox[{"Length", "[", "#1", "]"}]}], "}"}], ",", 

-                RowBox[{"{", 

-                 RowBox[{"j", ",", "i"}], "}"}]}], "]"}]}]}]}], "/.", 

-           "delreps"}]}], "]"}], "/.", 

         RowBox[{

-         RowBox[{"Energy", "[", "s_", "]"}], "\[Rule]", 

-         RowBox[{"2", 

-          RowBox[{"\[Pi]", "/", 

-           RowBox[{"\[Lambda]", "[", "s", "]"}]}]}]}]}], "/.", 

+         RowBox[{"DensityMatrix", "[", 

+          RowBox[{

+          "subsys", "\[LeftDoubleBracket]", "k", "\[RightDoubleBracket]"}], 

+          "]"}], "\[LeftDoubleBracket]", 

+         RowBox[{"n", ",", "m"}], "\[RightDoubleBracket]"}], 

+        RowBox[{"WignerEckart", "[", 

+         RowBox[{

+          RowBox[{

+           RowBox[{

+           "subsys", "\[LeftDoubleBracket]", "k", "\[RightDoubleBracket]"}], 

+           "\[LeftDoubleBracket]", "m", "\[RightDoubleBracket]"}], ",", 

+          RowBox[{"{", 

+           RowBox[{"Dipole", ",", "1"}], "}"}], ",", 

+          RowBox[{

+           RowBox[{

+           "subsys", "\[LeftDoubleBracket]", "k", "\[RightDoubleBracket]"}], 

+           "\[LeftDoubleBracket]", "n", "\[RightDoubleBracket]"}]}], "]"}]}], 

+       ",", 

+       RowBox[{"{", 

+        RowBox[{"n", ",", 

+         RowBox[{"Length", "[", 

+          RowBox[{

+          "subsys", "\[LeftDoubleBracket]", "k", "\[RightDoubleBracket]"}], 

+          "]"}]}], "}"}], ",", 

+       RowBox[{"{", 

+        RowBox[{"m", ",", "n"}], "}"}]}], "]"}], ",", 

+     RowBox[{"{", 

+      RowBox[{"k", ",", 

+       RowBox[{"Length", "[", "subsys", "]"}]}], "}"}]}], "]"}], "/.", 

+   "delreps"}]}]], "Input"],

+

+Cell[TextData[{

+ "Multiply through by ",

+ Cell[BoxData[

+  FormBox[

+   RowBox[{

+    RowBox[{"4", "\[Pi]", " ", "\[ImaginaryI]", " ", "\[Omega]", " ", "n"}], 

+    " ", "||", "d", "||"}], TraditionalForm]]],

+ ", and rewrite ",

+ Cell[BoxData[

+  FormBox[

+   RowBox[{"||", "d", 

+    SuperscriptBox["||", "2"]}], TraditionalForm]],

+  FormatType->"TraditionalForm"],

+ " in terms of the natural width \[CapitalGamma] of the transition."

+}], "Text"],

+

+Cell[BoxData[

+ RowBox[{"polarizationcomponents2", "=", 

+  RowBox[{"Table", "[", 

+   RowBox[{

+    RowBox[{"Expand", "[", 

+     RowBox[{"ExpandDipoleRME", "[", 

+      RowBox[{

+       RowBox[{

+       "subsys", "\[LeftDoubleBracket]", "k", "\[RightDoubleBracket]"}], ",", 

        RowBox[{

-        RowBox[{"NaturalWidth", "[", "s_", "]"}], "\[Rule]", 

-        RowBox[{"4", "\[VeryThinSpace]", "\[Pi]", " ", 

+        RowBox[{"4", "\[Pi]", " ", "\[ImaginaryI]", " ", 

+         RowBox[{"Energy", "[", 

+          RowBox[{"Last", "[", 

+           RowBox[{

+           "rmes", "\[LeftDoubleBracket]", "k", "\[RightDoubleBracket]"}], 

+           "]"}], "]"}], " ", "n0", " ", 

          RowBox[{

-          RowBox[{"\[Eta]", "[", "s", "]"}], "/", 

-          RowBox[{"(", 

-           RowBox[{"n0", " ", 

-            SuperscriptBox[

-             RowBox[{"\[Lambda]", "[", "s", "]"}], "2"], "3"}], ")"}]}]}]}]}],

-       "]"}], "&"}], ",", 

+         "rmes", "\[LeftDoubleBracket]", "k", "\[RightDoubleBracket]"}], " ", 

+         RowBox[{

+         "polarizationcomponents1", "\[LeftDoubleBracket]", "k", 

+          "\[RightDoubleBracket]"}]}], "/.", "delreps"}]}], "]"}], "]"}], ",", 

+    RowBox[{"{", 

+     RowBox[{"k", ",", 

+      RowBox[{"Length", "[", "subsys", "]"}]}], "}"}]}], "]"}]}]], "Input"],

+

+Cell[TextData[{

+ "Make the substitution ",

+ Cell[BoxData[

+  FormBox[

+   RowBox[{

+    SubscriptBox["\[Eta]", "s"], "=", 

+    FractionBox[

+     RowBox[{"3", 

+      SubsuperscriptBox["\[Lambda]", "s", "2"], 

+      SubscriptBox["\[CapitalGamma]", "s"], "n"}], 

+     RowBox[{"4", "\[Pi]"}]]}], TraditionalForm]],

+  FormatType->"TraditionalForm"],

+ "."

+}], "Text"],

+

+Cell[BoxData[

+ RowBox[{"polarizationcomponents3", "=", 

+  RowBox[{

+   RowBox[{

+    RowBox[{"polarizationcomponents2", "/.", 

+     RowBox[{

+      RowBox[{"Energy", "[", "s_", "]"}], "\[Rule]", 

+      RowBox[{"2", 

+       RowBox[{"\[Pi]", "/", 

+        RowBox[{"\[Lambda]", "[", "s", "]"}]}]}]}]}], "/.", 

+    RowBox[{

+     RowBox[{"NaturalWidth", "[", "s_", "]"}], "\[Rule]", 

+     RowBox[{"4", "\[VeryThinSpace]", "\[Pi]", " ", 

+      RowBox[{

+       RowBox[{"\[Eta]", "[", "s", "]"}], "/", 

+       RowBox[{"(", 

+        RowBox[{"n0", " ", 

+         SuperscriptBox[

+          RowBox[{"\[Lambda]", "[", "s", "]"}], "2"], "3"}], ")"}]}]}]}]}], "//",

+    "Simplify"}]}]], "Input"],

+

+Cell["\<\

+Cartesian components of the amplitude of each of the 4 fields.\

+\>", "Text"],

+

+Cell[BoxData[

+ RowBox[{"fieldcomponents1", "=", 

+  RowBox[{"Table", "[", 

+   RowBox[{

+    RowBox[{"field", "/.", 

+     RowBox[{"{", 

+      RowBox[{

+       RowBox[{

+        SubscriptBox["k", "_"], "\[Rule]", "0"}], ",", 

+       RowBox[{"t", "\[Rule]", "0"}], ",", 

+       RowBox[{

+        SubscriptBox["\[Phi]", "_"], "\[Rule]", "0"}], ",", 

+       RowBox[{

+        RowBox[{

+         SubscriptBox["\[CapitalOmega]", "s_"], "/;", 

+         RowBox[{"i", "\[NotEqual]", "s"}]}], "\[Rule]", "0"}]}], "}"}]}], 

+    ",", 

     RowBox[{"{", 

-     RowBox[{"subsys", ",", "rmes"}], "}"}]}], "]"}]}]], "Input"],

+     RowBox[{"i", ",", "4"}], "}"}]}], "]"}]}]], "Input"],

 

 Cell["\<\

-Spherical components of the amplitude of each of the 4 fields.\

+Convert to covariant spherical components and multiply by ||d||.\

 \>", "Text"],

 

 Cell[BoxData[

- RowBox[{"fieldcomponents", "=", 

+ RowBox[{"fieldcomponents2", "=", 

   RowBox[{

-   RowBox[{"rmes", " ", 

-    RowBox[{"Table", "[", 

-     RowBox[{

-      RowBox[{"Components", "@", 

-       RowBox[{"ToContravariant", "[", 

-        RowBox[{"field", "/.", 

-         RowBox[{"{", 

-          RowBox[{

-           RowBox[{

-            SubscriptBox["k", "_"], "\[Rule]", "0"}], ",", 

-           RowBox[{"t", "\[Rule]", "0"}], ",", 

-           RowBox[{

-            SubscriptBox["\[Phi]", "_"], "\[Rule]", "0"}], ",", 

-           RowBox[{

-            RowBox[{

-             SubscriptBox["\[CapitalOmega]", "s_"], "/;", 

-             RowBox[{"i", "\[NotEqual]", "s"}]}], "\[Rule]", "0"}]}], "}"}]}],

-         "]"}]}], ",", 

-      RowBox[{"{", 

-       RowBox[{"i", ",", "4"}], "}"}]}], "]"}]}], "/.", 

+   RowBox[{

+    RowBox[{"ToCovariant", "/@", "fieldcomponents1"}], " ", "rmes"}], "/.", 

    RowBox[{

     SubscriptBox["\[CapitalOmega]", "s_"], "->", 

     RowBox[{

@@ -2093,31 +2232,30 @@ Cell[BoxData[
 

 Cell["\<\

 Find propagation equations using the spherical components of the polarization \

-and fields.\

+and fields. Here we leave out the time-derivative term, which we will add in \

+below.\

 \>", "Text"],

 

 Cell[BoxData[

- RowBox[{

-  RowBox[{"propeqs", "=", 

+ RowBox[{"propeqs", "=", 

+  RowBox[{

    RowBox[{

-    RowBox[{

-     RowBox[{"Solve", "[", 

+    RowBox[{"Solve", "[", 

+     RowBox[{

       RowBox[{

+       RowBox[{"D", "[", 

+        RowBox[{"fieldcomponents2", ",", "z"}], "]"}], "==", 

+       RowBox[{"Simplify", "@", "polarizationcomponents3"}]}], ",", 

+      RowBox[{"Table", "[", 

        RowBox[{

-        RowBox[{"D", "[", 

-         RowBox[{"fieldcomponents", ",", "z"}], "]"}], "==", 

-        RowBox[{"Simplify", "@", "polarizationcomponents"}]}], ",", 

-       RowBox[{"Table", "[", 

         RowBox[{

-         RowBox[{

-          SuperscriptBox[

-           SubscriptBox["\[CapitalOmega]", "i"], "\[Prime]",

-           MultilineFunction->None], "[", "z", "]"}], ",", 

-         RowBox[{"{", 

-          RowBox[{"i", ",", "4"}], "}"}]}], "]"}]}], "]"}], "[", 

-     RowBox[{"[", "1", "]"}], "]"}], "/.", 

-    RowBox[{"Rule", "\[Rule]", "Equal"}]}]}], 

-  "\[IndentingNewLine]"}]], "Input"],

+         SuperscriptBox[

+          SubscriptBox["\[CapitalOmega]", "i"], "\[Prime]",

+          MultilineFunction->None], "[", "z", "]"}], ",", 

+        RowBox[{"{", 

+         RowBox[{"i", ",", "4"}], "}"}]}], "]"}]}], "]"}], "[", 

+    RowBox[{"[", "1", "]"}], "]"}], "/.", 

+   RowBox[{"Rule", "\[Rule]", "Equal"}]}]}]], "Input"],

 

 Cell["Convert propagation equations to c form.", "Text"],