Notebook[{ Cell[CellGroupData[{ Cell["Find evolution equations", "Section"], Cell["Load the package.", "Text"], Cell[BoxData[ RowBox[{"<<", "AtomicDensityMatrix`"}]], "Input", CellGroupingRules->{GroupTogetherGrouping, 10001.}, CellID->2058623809], Cell["Use density matrix variables with explict time dependence.", "Text"], Cell[BoxData[ RowBox[{"SetOptions", "[", RowBox[{"DensityMatrix", ",", RowBox[{"TimeDependence", "\[Rule]", "True"}]}], "]"}]], "Input"], Cell["\<\ Pull quantum numbers and other basic info about the states from a database.\ \>", "Text", CellID->429217524], Cell[BoxData[ RowBox[{"s12data", "=", RowBox[{"AtomicData", "[", RowBox[{ RowBox[{"{", RowBox[{"\"\\"", ",", "87", ",", RowBox[{"{", RowBox[{"\"\\"", ",", RowBox[{"{", RowBox[{"5", ",", "\"\\""}], "}"}]}], "}"}], ",", RowBox[{"{", RowBox[{"2", ",", "\"\\"", ",", FractionBox["1", "2"]}], "}"}]}], "}"}], ",", RowBox[{"{", RowBox[{ "Energy", ",", "J", ",", "L", ",", "S", ",", "NuclearSpin", ",", "NaturalWidth", ",", "Parity"}], "}"}]}], "]"}]}]], "Input"], Cell[BoxData[ RowBox[{"p12data", "=", RowBox[{"Append", "[", RowBox[{ RowBox[{"AtomicData", "[", RowBox[{ RowBox[{"{", RowBox[{"\"\\"", ",", "87", ",", RowBox[{"{", RowBox[{"\"\\"", ",", RowBox[{"{", RowBox[{"5", ",", "\"\\""}], "}"}]}], "}"}], ",", RowBox[{"{", RowBox[{"2", ",", "\"\\"", ",", FractionBox["1", "2"]}], "}"}]}], "}"}], ",", RowBox[{"{", RowBox[{"J", ",", "L", ",", "S", ",", "NuclearSpin", ",", "Parity"}], "}"}]}], "]"}], ",", RowBox[{ RowBox[{"BranchingRatio", "[", "0", "]"}], "\[Rule]", "1"}]}], "]"}]}]], "Input"], Cell[BoxData[ RowBox[{"p32data", "=", RowBox[{"Append", "[", RowBox[{ RowBox[{"AtomicData", "[", RowBox[{ RowBox[{"{", RowBox[{"\"\\"", ",", "87", ",", RowBox[{"{", RowBox[{"\"\\"", ",", RowBox[{"{", RowBox[{"5", ",", "\"\\""}], "}"}]}], "}"}], ",", RowBox[{"{", RowBox[{"2", ",", "\"\\"", ",", FractionBox["3", "2"]}], "}"}]}], "}"}], ",", RowBox[{"{", RowBox[{"J", ",", "L", ",", "S", ",", "NuclearSpin", ",", "Parity"}], "}"}]}], "]"}], ",", RowBox[{ RowBox[{"BranchingRatio", "[", "0", "]"}], "\[Rule]", "1"}]}], "]"}]}]], "Input"], Cell["\<\ Using the quantum numbers, create a list of all hyperfine and Zeeman \ sublevels of the J states, which are labeled 0, 1, and 2 for reference. This \ list will be passed to the functions from the ADM package that create the DM \ evolution equations.\ \>", "Text"], Cell[BoxData[ RowBox[{ RowBox[{"system0", "=", RowBox[{"Sublevels", "[", RowBox[{"{", RowBox[{ RowBox[{"AtomicState", "[", RowBox[{"0", ",", "s12data"}], "]"}], ",", RowBox[{"AtomicState", "[", RowBox[{"1", ",", "p12data"}], "]"}], ",", RowBox[{"AtomicState", "[", RowBox[{"2", ",", "p32data"}], "]"}]}], "}"}], "]"}]}], ";"}]], "Input", CellID->433132487], Cell[TextData[{ "For simplicity, we delete some excited states from the system, leaving only \ ", Cell[BoxData[ FormBox[ RowBox[{ RowBox[{ SubscriptBox["P", RowBox[{"1", "/", "2"}]], " ", "F"}], "=", "1"}], TraditionalForm]]], " and ", Cell[BoxData[ FormBox[ RowBox[{ RowBox[{ SubscriptBox["P", RowBox[{"3", "/", "2"}]], " ", "F"}], "=", "2"}], TraditionalForm]]], "." }], "Text"], Cell[BoxData[ RowBox[{"system", "=", RowBox[{"DeleteStates", "[", RowBox[{"system0", ",", RowBox[{ RowBox[{"(", RowBox[{ RowBox[{"Label", "\[Equal]", "1"}], "&&", RowBox[{"F", "\[NotEqual]", "1"}]}], ")"}], "||", RowBox[{"(", RowBox[{ RowBox[{"Label", "\[Equal]", "2"}], "&&", RowBox[{"F", "\[NotEqual]", "2"}]}], ")"}]}]}], "]"}]}]], "Input"], Cell[TextData[{ "Define the optical field with four frequencies, ", Cell[BoxData[ FormBox[ StyleBox[ SubscriptBox["\[Omega]", "1"], "InlineMath"], TraditionalForm]]], ", ", Cell[BoxData[ FormBox[ StyleBox[ SubscriptBox["\[Omega]", "2"], "InlineMath"], TraditionalForm]]], ", ", Cell[BoxData[ FormBox[ StyleBox[ SubscriptBox["\[Omega]", "3"], "InlineMath"], TraditionalForm]]], ", and ", Cell[BoxData[ FormBox[ StyleBox[ SubscriptBox["\[Omega]", "4"], "InlineMath"], TraditionalForm]]], ". Each field can have arbitrary ", Cell[BoxData[ FormBox[ SuperscriptBox["\[Sigma]", "+"], TraditionalForm]]], " and ", Cell[BoxData[ FormBox[ SuperscriptBox["\[Sigma]", "-"], TraditionalForm]]], " components, labeled ", Cell[BoxData[ FormBox[ SubscriptBox["\[CapitalOmega]", RowBox[{"i", ",", "1"}]], TraditionalForm]]], "and ", Cell[BoxData[ FormBox[ SubscriptBox["\[CapitalOmega]", RowBox[{"i", ",", RowBox[{"-", "1"}]}]], TraditionalForm]]], "." }], "Text", CellID->133602844], Cell[BoxData[ RowBox[{"SetOptions", "[", RowBox[{"OpticalField", ",", RowBox[{"PolarizationVector", "\[Rule]", RowBox[{"{", RowBox[{"1", ",", "0", ",", "0"}], "}"}]}], ",", RowBox[{"CartesianCoordinates", "\[Rule]", RowBox[{"{", RowBox[{"x", ",", "y", ",", "z"}], "}"}]}]}], "]"}]], "Input"], Cell[TextData[{ "Parameters for the OpticalField function are {frequency, wavenumber}, \ {electric amplitude, phase}, {rotation angle (relative to \ PolarizationVector), ellipticity}. Here ", Cell[BoxData[ FormBox[ SubscriptBox["\[CapitalOmega]", RowBox[{"i", ",", "q"}]], TraditionalForm]]], " are the Rabi frequencies defined in terms of the dipole reduced matrix \ elements." }], "Text"], Cell[BoxData[ RowBox[{ RowBox[{"rmes", "=", RowBox[{"{", RowBox[{ RowBox[{"ReducedME", "[", RowBox[{"0", ",", RowBox[{"{", RowBox[{"Dipole", ",", "1"}], "}"}], ",", "1"}], "]"}], ",", " ", RowBox[{"ReducedME", "[", RowBox[{"0", ",", RowBox[{"{", RowBox[{"Dipole", ",", "1"}], "}"}], ",", "1"}], "]"}], ",", " ", RowBox[{"ReducedME", "[", RowBox[{"0", ",", RowBox[{"{", RowBox[{"Dipole", ",", "1"}], "}"}], ",", "2"}], "]"}], ",", " ", RowBox[{"ReducedME", "[", RowBox[{"0", ",", RowBox[{"{", RowBox[{"Dipole", ",", "1"}], "}"}], ",", "2"}], "]"}]}], "}"}]}], ";"}]], "Input"], Cell[BoxData[ RowBox[{"contrafield", "=", RowBox[{"Sum", "[", RowBox[{ RowBox[{ FractionBox[ SuperscriptBox["\[ExponentialE]", RowBox[{"\[ImaginaryI]", " ", RowBox[{"(", RowBox[{ RowBox[{"z", " ", SubscriptBox["k", "i"]}], "-", RowBox[{"t", " ", SubscriptBox["\[Omega]", "i"]}]}], ")"}]}]], RowBox[{"rmes", "\[LeftDoubleBracket]", "i", "\[RightDoubleBracket]"}]], " ", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{ SuperscriptBox["\[ExponentialE]", RowBox[{"\[ImaginaryI]", " ", SubscriptBox["\[Phi]", RowBox[{"i", ",", "p"}]]}]], SubscriptBox["\[CapitalOmega]", RowBox[{"i", ",", "p"}]]}], "}"}], ",", RowBox[{"{", "0", "}"}], ",", RowBox[{"{", RowBox[{ SuperscriptBox["\[ExponentialE]", RowBox[{"\[ImaginaryI]", " ", SubscriptBox["\[Phi]", RowBox[{"i", ",", "m"}]]}]], SubscriptBox["\[CapitalOmega]", RowBox[{"i", ",", "m"}]]}], "}"}]}], "}"}]}], ",", RowBox[{"{", RowBox[{"i", ",", "4"}], "}"}]}], "]"}]}]], "Input"], Cell[BoxData[ RowBox[{"field", "=", RowBox[{ RowBox[{"ToCartesian", "[", "contrafield", "]"}], "//", "Expand"}]}]], "Input"], Cell["\<\ The Hamiltonian for the system subject to the optical field. Each field is \ assumed to interact with only one transition\[LongDash]the replacement rule \ (Cos[_]|Sin[_]) ReducedME[_,{Dipole,1},_]\[Rule]0 causes other terms to be \ set to zero.\ \>", "Text", CellID->462076121], Cell[BoxData[ RowBox[{"MatrixForm", "[", RowBox[{"H", "=", RowBox[{ RowBox[{"Expand", "@", RowBox[{"Hamiltonian", "[", RowBox[{"system", ",", RowBox[{"ElectricField", "\[Rule]", "field"}], ",", RowBox[{"MagneticField", "\[Rule]", RowBox[{ RowBox[{"{", RowBox[{ SubscriptBox["\[CapitalOmega]L", "x"], ",", SubscriptBox["\[CapitalOmega]L", "y"], ",", SubscriptBox["\[CapitalOmega]L", "z"]}], "}"}], "/", "BohrMagneton"}]}]}], "]"}]}], "/.", " ", RowBox[{ RowBox[{ RowBox[{"(", RowBox[{ RowBox[{"Cos", "[", "_", "]"}], "|", RowBox[{"Sin", "[", "_", "]"}]}], ")"}], " ", RowBox[{"ReducedME", "[", RowBox[{"_", ",", RowBox[{"{", RowBox[{"Dipole", ",", "1"}], "}"}], ",", "_"}], "]"}]}], "\[Rule]", "0"}]}]}], "]"}]], "Input", CellID->494599775], Cell["\<\ The level diagram for the system, showing optical couplings. Note that both \ resonant and off-resonant (counter-rotating) couplings are shown, because we \ have not yet performed the rotating-wave approximation.\ \>", "Text", CellID->358620443], Cell[BoxData[ RowBox[{"LevelDiagram", "[", RowBox[{"system", ",", RowBox[{"H", "/.", RowBox[{"{", RowBox[{ RowBox[{ RowBox[{"Energy", "[", "0", "]"}], "\[Rule]", "0"}], ",", RowBox[{ RowBox[{"Energy", "[", "1", "]"}], "\[Rule]", "2"}], ",", RowBox[{ RowBox[{"Energy", "[", "2", "]"}], "\[Rule]", "4"}], ",", RowBox[{ RowBox[{"HyperfineA", "[", "_", "]"}], "\[Rule]", ".2"}], ",", RowBox[{ RowBox[{"HyperfineB", "[", "_", "]"}], "\[Rule]", ".1"}], ",", RowBox[{ SubscriptBox["\[CapitalOmega]L", "z"], "\[Rule]", ".1"}], ",", RowBox[{ SubscriptBox["\[CapitalOmega]L", "_"], "\[Rule]", "0"}]}], "}"}]}], ",", RowBox[{"ParityOffset", "\[Rule]", "False"}]}], "]"}]], "Input", CellID->167259034], Cell[TextData[{ "Here we apply the rotating-wave approximation to the Hamiltonian. Here we \ construct a list of frequency shifts for the list of Zeeman sublevels that \ will have the effect of removing the optical frequencies from the \ Hamiltonian. I.e., we hold ", Cell[BoxData[ FormBox[ RowBox[{ RowBox[{ SubscriptBox["S", RowBox[{"1", "/", "2"}]], "F"}], "=", "2"}], TraditionalForm]]], " fixed, shift ", Cell[BoxData[ FormBox[ SubscriptBox["P", RowBox[{"1", "/", "2"}]], TraditionalForm]]], " down by ", Cell[BoxData[ FormBox[ SubscriptBox["\[Omega]", "1"], TraditionalForm]]], ", shift ", Cell[BoxData[ FormBox[ RowBox[{ RowBox[{ SubscriptBox["S", RowBox[{"1", "/", "2"}]], " ", "F"}], "=", "1"}], TraditionalForm]]], " down by ", Cell[BoxData[ FormBox[ RowBox[{ SubscriptBox["\[Omega]", "1"], "-", SubscriptBox["\[Omega]", "2"]}], TraditionalForm]]], ", and shift ", Cell[BoxData[ FormBox[ SubscriptBox["P", RowBox[{"3", "/", "2"}]], TraditionalForm]]], " down by ", Cell[BoxData[ FormBox[ RowBox[{ SubscriptBox["\[Omega]", "1"], "-", SubscriptBox["\[Omega]", "2"], "+", SubscriptBox["\[Omega]", "3"]}], TraditionalForm]]], "." }], "Text", CellID->577766068], Cell[BoxData[{ RowBox[{ RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"Label", "[", "#", "]"}], ",", RowBox[{"F", "[", "#", "]"}]}], "}"}], "&"}], "/@", "system"}], "\[IndentingNewLine]", RowBox[{"shifts", "=", RowBox[{"%", "/.", RowBox[{"{", RowBox[{ RowBox[{ RowBox[{"{", RowBox[{"0", ",", "2"}], "}"}], "\[Rule]", "0"}], ",", RowBox[{ RowBox[{"{", RowBox[{"1", ",", "_"}], "}"}], "\[Rule]", SubscriptBox["\[Omega]", "1"]}], ",", RowBox[{ RowBox[{"{", RowBox[{"0", ",", "1"}], "}"}], "\[Rule]", RowBox[{ SubscriptBox["\[Omega]", "1"], "-", SubscriptBox["\[Omega]", "2"]}]}], ",", RowBox[{ RowBox[{"{", RowBox[{"2", ",", "_"}], "}"}], "\[Rule]", RowBox[{ SubscriptBox["\[Omega]", "1"], "-", SubscriptBox["\[Omega]", "2"], "+", SubscriptBox["\[Omega]", "3"]}]}]}], "}"}]}]}]}], "Input"], Cell["\<\ Make a unitary transformation matrix to implement the chosen frequency shifts.\ \>", "Text"], Cell[BoxData[ RowBox[{"MatrixForm", "[", RowBox[{"transmat", "=", RowBox[{"MatrixExp", "[", RowBox[{ RowBox[{ RowBox[{"-", "\[ImaginaryI]"}], " ", "t", " ", RowBox[{"DiagonalMatrix", "[", "shifts", "]"}]}], "+", RowBox[{"\[ImaginaryI]", " ", "z", " ", RowBox[{"DiagonalMatrix", "[", RowBox[{"shifts", "/.", RowBox[{"\[Omega]", "\[Rule]", "k"}]}], "]"}]}]}], "]"}]}], "]"}]], "Input"], Cell[TextData[{ "Write ", Cell[BoxData[ FormBox[ SubscriptBox["\[Omega]", "4"], TraditionalForm]]], " and ", Cell[BoxData[ FormBox[ SubscriptBox["k", "4"], TraditionalForm]]], " in terms of the non-degenerate detuning and phase-mismatch parameters \ \[Delta]\[Omega] and \[Delta]k, which we set here to zero for simplicity. We \ then apply the transform matrix to the Hamiltonian and set off resonant terms \ oscillating at harmonics of ", Cell[BoxData[ FormBox[ SubscriptBox["\[Omega]", "1"], TraditionalForm]]], ", ", Cell[BoxData[ FormBox[ SubscriptBox["\[Omega]", "2"], TraditionalForm]]], ", and ", Cell[BoxData[ FormBox[ SubscriptBox["\[Omega]", "3"], TraditionalForm]]], " to zero." }], "Text"], Cell[BoxData[ RowBox[{"MatrixForm", "[", RowBox[{"H1", "=", RowBox[{"RotatingWaveApproximation", "[", RowBox[{"system", ",", RowBox[{ RowBox[{"H", "/.", RowBox[{"{", RowBox[{ RowBox[{ SubscriptBox["\[Omega]", "4"], "\[Rule]", RowBox[{ SubscriptBox["\[Omega]", "1"], "-", SubscriptBox["\[Omega]", "2"], "+", SubscriptBox["\[Omega]", "3"], "-", "\[Delta]\[Omega]"}]}], ",", RowBox[{ SubscriptBox["k", "4"], "\[Rule]", RowBox[{ SubscriptBox["k", "1"], "-", SubscriptBox["k", "2"], "+", SubscriptBox["k", "3"], "-", "\[Delta]k"}]}]}], "}"}]}], "/.", RowBox[{"{", RowBox[{ RowBox[{"\[Delta]\[Omega]", "\[Rule]", "0"}], ",", RowBox[{"\[Delta]k", "\[Rule]", "0"}]}], "}"}]}], ",", RowBox[{"{", RowBox[{ SubscriptBox["\[Omega]", "1"], ",", SubscriptBox["\[Omega]", "2"], ",", SubscriptBox["\[Omega]", "3"]}], "}"}], ",", RowBox[{"TransformMatrix", "\[Rule]", "transmat"}]}], "]"}]}], "]"}]], "Input"], Cell[TextData[{ "There are remaining fast-oscillating terms in the Hamiltonian at the \ difference frequency between ", Cell[BoxData[ FormBox[ SubscriptBox["\[Omega]", "1"], TraditionalForm]]], " and ", Cell[BoxData[ FormBox[ SubscriptBox["\[Omega]", "2"], TraditionalForm]]], ", due to the fact that each optical field can interact with both \ ground-state hyperfine levels. We set these terms to zero, which is \ equivalent to assuming that each field interacts with only the ", Cell[BoxData[ FormBox[ RowBox[{"F", "=", "1"}], TraditionalForm]]], " or the ", Cell[BoxData[ FormBox[ RowBox[{"F", "=", "2"}], TraditionalForm]]], " ground-state hyperfine sublevel. We also absorb the complex phases into \ the \[CapitalOmega]\[CloseCurlyQuote]s." }], "Text"], Cell[BoxData[ RowBox[{"MatrixForm", "[", RowBox[{"H2", "=", RowBox[{"H1", "/.", RowBox[{"{", RowBox[{ RowBox[{ SuperscriptBox["\[ExponentialE]", RowBox[{"\[Phi]_", "-", RowBox[{"\[ImaginaryI]", " ", "t", " ", SubscriptBox["\[Omega]", "1"]}], "+", RowBox[{"\[ImaginaryI]", " ", "t", " ", SubscriptBox["\[Omega]", "2"]}]}]], "\[Rule]", "0"}], ",", RowBox[{ SuperscriptBox["\[ExponentialE]", RowBox[{"\[Phi]_", "+", RowBox[{"\[ImaginaryI]", " ", "t", " ", SubscriptBox["\[Omega]", "1"]}], "-", RowBox[{"\[ImaginaryI]", " ", "t", " ", SubscriptBox["\[Omega]", "2"]}]}]], "\[Rule]", "0"}], ",", RowBox[{ RowBox[{ SuperscriptBox["\[ExponentialE]", RowBox[{"\[ImaginaryI]", " ", SubscriptBox["\[Phi]", RowBox[{"i_", ",", "q_"}]]}]], " ", SubscriptBox["\[CapitalOmega]", RowBox[{"i_", ",", "q_"}]]}], "\[Rule]", SubscriptBox["\[CapitalOmega]", RowBox[{"i", ",", "q"}]]}], ",", RowBox[{ RowBox[{ SuperscriptBox["\[ExponentialE]", RowBox[{ RowBox[{"-", "\[ImaginaryI]"}], " ", SubscriptBox["\[Phi]", RowBox[{"i_", ",", "q_"}]]}]], " ", SubscriptBox["\[CapitalOmega]", RowBox[{"i_", ",", "q_"}]]}], "\[Rule]", RowBox[{"Conjugate", "[", SubscriptBox["\[CapitalOmega]", RowBox[{"i", ",", "q"}]], "]"}]}]}], "}"}]}]}], "]"}]], "Input"], Cell["\<\ Find the frequencies at which each field is assumed to be resonant with its F\ \[Rule]F\[CloseCurlyQuote] transition.\ \>", "Text"], Cell[BoxData[ RowBox[{"\[Omega]1res", "=", RowBox[{ RowBox[{ RowBox[{"Hamiltonian", "[", RowBox[{"{", RowBox[{"SelectState", "[", RowBox[{"system", ",", " ", RowBox[{ RowBox[{"Label", "\[Equal]", "1"}], "&&", RowBox[{"F", "\[Equal]", "1"}]}]}], "]"}], "}"}], "]"}], "\[LeftDoubleBracket]", RowBox[{"1", ",", "1"}], "\[RightDoubleBracket]"}], "-", RowBox[{ RowBox[{"Hamiltonian", "[", RowBox[{"{", RowBox[{"SelectState", "[", RowBox[{"system", ",", " ", RowBox[{ RowBox[{"Label", "\[Equal]", "0"}], "&&", RowBox[{"F", "\[Equal]", "2"}]}]}], "]"}], "}"}], "]"}], "\[LeftDoubleBracket]", RowBox[{"1", ",", "1"}], "\[RightDoubleBracket]"}]}]}]], "Input"], Cell[BoxData[ RowBox[{"\[Omega]2res", "=", RowBox[{ RowBox[{ RowBox[{"Hamiltonian", "[", RowBox[{"{", RowBox[{"SelectState", "[", RowBox[{"system", ",", " ", RowBox[{ RowBox[{"Label", "\[Equal]", "1"}], "&&", RowBox[{"F", "\[Equal]", "1"}]}]}], "]"}], "}"}], "]"}], "\[LeftDoubleBracket]", RowBox[{"1", ",", "1"}], "\[RightDoubleBracket]"}], "-", RowBox[{ RowBox[{"Hamiltonian", "[", RowBox[{"{", RowBox[{"SelectState", "[", RowBox[{"system", ",", " ", RowBox[{ RowBox[{"Label", "\[Equal]", "0"}], "&&", RowBox[{"F", "\[Equal]", "1"}]}]}], "]"}], "}"}], "]"}], "\[LeftDoubleBracket]", RowBox[{"1", ",", "1"}], "\[RightDoubleBracket]"}]}]}]], "Input"], Cell[BoxData[ RowBox[{"\[Omega]3res", "=", RowBox[{ RowBox[{ RowBox[{"Hamiltonian", "[", RowBox[{"{", RowBox[{"SelectState", "[", RowBox[{"system", ",", " ", RowBox[{ RowBox[{"Label", "\[Equal]", "2"}], "&&", RowBox[{"F", "\[Equal]", "2"}]}]}], "]"}], "}"}], "]"}], "\[LeftDoubleBracket]", RowBox[{"1", ",", "1"}], "\[RightDoubleBracket]"}], "-", RowBox[{ RowBox[{"Hamiltonian", "[", RowBox[{"{", RowBox[{"SelectState", "[", RowBox[{"system", ",", " ", RowBox[{ RowBox[{"Label", "\[Equal]", "0"}], "&&", RowBox[{"F", "\[Equal]", "1"}]}]}], "]"}], "}"}], "]"}], "\[LeftDoubleBracket]", RowBox[{"1", ",", "1"}], "\[RightDoubleBracket]"}]}]}]], "Input"], Cell[TextData[{ "Rewrite the frequencies ", Cell[BoxData[ FormBox[ SubscriptBox["\[Omega]", "1"], TraditionalForm]]], ", ", Cell[BoxData[ FormBox[ SubscriptBox["\[Omega]", "2"], TraditionalForm]]], ", and ", Cell[BoxData[ FormBox[ SubscriptBox["\[Omega]", "3"], TraditionalForm]]], " in terms of a detuning ", Cell[BoxData[ FormBox[ SubscriptBox["\[Delta]", "1"], TraditionalForm]]], ", ", Cell[BoxData[ FormBox[ SubscriptBox["\[Delta]", "2"], TraditionalForm]]], ", or ", Cell[BoxData[ FormBox[ SubscriptBox["\[Delta]", "3"], TraditionalForm]]], " from resonance with the appropriate transition between ground-state and \ excited state hyperfine levels, and subtract a constant term off of the \ diagonal to simplify the appearance." }], "Text"], Cell[BoxData[ RowBox[{"MatrixForm", "[", RowBox[{"Hrwa", "=", RowBox[{ RowBox[{"(", RowBox[{"H2", "/.", RowBox[{"{", RowBox[{ RowBox[{ SubscriptBox["\[Omega]", "1"], "\[Rule]", RowBox[{"\[Omega]1res", "+", SubscriptBox["\[Delta]", "1"]}]}], ",", RowBox[{ SubscriptBox["\[Omega]", "2"], "\[Rule]", RowBox[{"\[Omega]2res", "+", SubscriptBox["\[Delta]", "2"]}]}], ",", RowBox[{ SubscriptBox["\[Omega]", "3"], "\[Rule]", RowBox[{"\[Omega]3res", "+", SubscriptBox["\[Delta]", "3"]}]}]}], "}"}]}], ")"}], "-", RowBox[{ FractionBox[ RowBox[{"3", " ", RowBox[{"HyperfineA", "[", "0", "]"}]}], "4"], RowBox[{"IdentityMatrix", "[", RowBox[{"Length", "[", "system", "]"}], "]"}]}]}]}], "]"}]], "Input"], Cell["\<\ The level diagram showing resonant (co-rotating) optical couplings. \ \>", "Text"], Cell[BoxData[ RowBox[{"diagram", "=", RowBox[{"LevelDiagram", "[", RowBox[{"system", ",", RowBox[{ RowBox[{"Hrwa", "/.", RowBox[{"{", RowBox[{ RowBox[{ SubscriptBox["\[Delta]", "1"], "\[Rule]", RowBox[{"-", "\[Omega]1res"}]}], ",", RowBox[{ SubscriptBox["\[Delta]", "2"], "\[Rule]", RowBox[{"-", "\[Omega]2res"}]}], ",", RowBox[{ SubscriptBox["\[Delta]", "3"], "\[Rule]", RowBox[{"-", "\[Omega]3res"}]}]}], "}"}]}], "/.", RowBox[{"{", RowBox[{ RowBox[{ RowBox[{"Energy", "[", "0", "]"}], "\[Rule]", "0"}], ",", RowBox[{ RowBox[{"Energy", "[", "1", "]"}], "\[Rule]", "2"}], ",", RowBox[{ RowBox[{"Energy", "[", "2", "]"}], "\[Rule]", "3"}], ",", RowBox[{ RowBox[{"HyperfineA", "[", "_", "]"}], "\[Rule]", ".2"}], ",", RowBox[{ RowBox[{"HyperfineB", "[", "_", "]"}], "\[Rule]", ".1"}], ",", RowBox[{ SubscriptBox["\[CapitalOmega]L", "z"], "\[Rule]", ".1"}], ",", RowBox[{ SubscriptBox["\[CapitalOmega]L", "_"], "\[Rule]", "0"}]}], "}"}]}], ",", RowBox[{"ParityOffset", "\[Rule]", "False"}], ",", RowBox[{"Epilog", "\[Rule]", RowBox[{"{", RowBox[{ RowBox[{"Text", "[", RowBox[{ RowBox[{"Style", "[", RowBox[{ "\"\<\!\(\*SuperscriptBox[\(\[VeryThinSpace]\), \ \(2\)]\)\!\(\*SubscriptBox[\(S\), \(1/2\)]\)\>\"", ",", RowBox[{"SingleLetterItalics", "\[Rule]", "False"}]}], "]"}], ",", RowBox[{"{", RowBox[{ RowBox[{"-", "2.9"}], ",", "0"}], "}"}]}], "]"}], ",", RowBox[{"Text", "[", RowBox[{ RowBox[{"Style", "[", RowBox[{ "\"\<\!\(\*SuperscriptBox[\(\[VeryThinSpace]\), \ \(2\)]\)\!\(\*SubscriptBox[\(P\), \(1/2\)]\)\>\"", ",", RowBox[{"SingleLetterItalics", "\[Rule]", "False"}]}], "]"}], ",", RowBox[{"{", RowBox[{ RowBox[{"-", "2.9"}], ",", "1.6"}], "}"}]}], "]"}], ",", RowBox[{"Text", "[", RowBox[{ RowBox[{"Style", "[", RowBox[{ "\"\<\!\(\*SuperscriptBox[\(\[VeryThinSpace]\), \ \(2\)]\)\!\(\*SubscriptBox[\(P\), \(3/2\)]\)\>\"", ",", RowBox[{"SingleLetterItalics", "\[Rule]", "False"}]}], "]"}], ",", RowBox[{"{", RowBox[{ RowBox[{"-", "2.9"}], ",", "2.7"}], "}"}]}], "]"}]}], "}"}]}], ",", RowBox[{"ImageSize", "\[Rule]", RowBox[{"3.5", " ", "72"}]}], ",", RowBox[{"ImagePadding", "\[Rule]", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{"35", ",", "0"}], "}"}], ",", RowBox[{"{", RowBox[{"10", ",", "10"}], "}"}]}], "}"}]}]}], "]"}]}]], "Input", CellID->102096636], Cell[TextData[{ Cell[BoxData[ ButtonBox["IntrinsicRelaxation", BaseStyle->"Link", ButtonData->"paclet:AtomicDensityMatrix/ref/IntrinsicRelaxation"]]], " and ", Cell[BoxData[ ButtonBox["TransitRelaxation", BaseStyle->"Link", ButtonData->"paclet:AtomicDensityMatrix/ref/TransitRelaxation"]]], " supply the matrices describing relaxation due to spontaneous decay and \ atomic transit, respectively. ", Cell[BoxData[ FormBox[ SubscriptBox["\[Gamma]", "t"], TraditionalForm]]], " is the transit rate." }], "Text", CellID->610306692], Cell[BoxData[ RowBox[{"MatrixForm", "[", RowBox[{"relax", "=", RowBox[{ RowBox[{"IntrinsicRelaxation", "[", "system", "]"}], "+", RowBox[{"TransitRelaxation", "[", RowBox[{"system", ",", "\[Gamma]t"}], "]"}]}]}], "]"}]], "Input", CellID->645617687], Cell[TextData[{ Cell[BoxData[ ButtonBox["OpticalRepopulation", BaseStyle->"Link", ButtonData->"paclet:AtomicDensityMatrix/ref/OpticalRepopulation"]]], " and ", Cell[BoxData[ ButtonBox["TransitRepopulation", BaseStyle->"Link", ButtonData->"paclet:AtomicDensityMatrix/ref/TransitRepopulation"]]], " supply the matrices describing repopulation of the ground state due to \ spontaneous decay and atomic transit." }], "Text", CellID->854192725], Cell[BoxData[ RowBox[{"MatrixForm", "[", RowBox[{"repop", "=", RowBox[{ RowBox[{"OpticalRepopulation", "[", "system", "]"}], "+", RowBox[{"TransitRepopulation", "[", RowBox[{"system", ",", "\[Gamma]t"}], "]"}]}]}], "]"}]], "Input", CellID->465762594], Cell["Here are the evolution equations.", "Text", CellID->314466782], Cell[BoxData[ RowBox[{"TableForm", "[", RowBox[{"eqs0", "=", RowBox[{"LiouvilleEquation", "[", RowBox[{"system", ",", "Hrwa", ",", "relax", ",", "repop"}], "]"}]}], "]"}]], "Input"], Cell["\<\ Here we pull useful numerical atomic data for Rb out of the database. These \ numbers are in omega units, so that the unit \[OpenCurlyDoubleQuote]Hertz\ \[CloseCurlyDoubleQuote] actually corresponds to rad/s.\ \>", "Text"], Cell[BoxData[ RowBox[{"atomicdata", "=", RowBox[{"Join", "[", RowBox[{ RowBox[{"AtomicData", "[", RowBox[{ RowBox[{"{", RowBox[{"\"\\"", ",", "87", ",", RowBox[{"{", RowBox[{"\"\\"", ",", RowBox[{"{", RowBox[{"5", ",", "\"\\""}], "}"}]}], "}"}], ",", RowBox[{"{", RowBox[{"2", ",", "\"\\"", ",", FractionBox["1", "2"]}], "}"}]}], "}"}], ",", RowBox[{"{", "HyperfineA", "}"}], ",", RowBox[{"Label", "\[Rule]", "0"}]}], "]"}], ",", RowBox[{"AtomicData", "[", RowBox[{ RowBox[{"{", RowBox[{"\"\\"", ",", "87", ",", RowBox[{"{", RowBox[{"\"\\"", ",", RowBox[{"{", RowBox[{"5", ",", "\"\\""}], "}"}]}], "}"}], ",", RowBox[{"{", RowBox[{"2", ",", "\"\\"", ",", FractionBox["1", "2"]}], "}"}]}], "}"}], ",", RowBox[{"{", RowBox[{"HyperfineA", ",", "NaturalWidth"}], "}"}], ",", RowBox[{"Label", "\[Rule]", "1"}]}], "]"}], ",", RowBox[{"AtomicData", "[", RowBox[{ RowBox[{"{", RowBox[{"\"\\"", ",", "87", ",", RowBox[{"{", RowBox[{"\"\\"", ",", RowBox[{"{", RowBox[{"5", ",", "\"\\""}], "}"}]}], "}"}], ",", RowBox[{"{", RowBox[{"2", ",", "\"\\"", ",", FractionBox["3", "2"]}], "}"}]}], "}"}], ",", RowBox[{"{", RowBox[{"HyperfineA", ",", "HyperfineB", ",", "NaturalWidth"}], "}"}], ",", RowBox[{"Label", "\[Rule]", "2"}]}], "]"}], ",", RowBox[{"{", RowBox[{ RowBox[{ RowBox[{"Wavelength", "[", "1", "]"}], "->", RowBox[{"1", "/", RowBox[{"Wavenumber", "[", RowBox[{"{", RowBox[{"\"\\"", ",", "87", ",", RowBox[{"{", RowBox[{"\"\\"", ",", RowBox[{"{", RowBox[{"5", ",", "\"\\""}], "}"}]}], "}"}], ",", RowBox[{"{", RowBox[{"2", ",", "\"\\"", ",", FractionBox["1", "2"]}], "}"}]}], "}"}], "]"}]}]}], ",", RowBox[{ RowBox[{"Wavelength", "[", "2", "]"}], "->", RowBox[{"1", "/", RowBox[{"Wavenumber", "[", RowBox[{"{", RowBox[{"\"\\"", ",", "87", ",", RowBox[{"{", RowBox[{"\"\\"", ",", RowBox[{"{", RowBox[{"5", ",", "\"\\""}], "}"}]}], "}"}], ",", RowBox[{"{", RowBox[{"2", ",", "\"\\"", ",", FractionBox["3", "2"]}], "}"}]}], "}"}], "]"}]}]}]}], "}"}]}], "]"}]}]], "Input"], Cell[TextData[{ "Here we find DM elements that are always identically zero, so we can remove \ them from the evolution equations. We put in sample values for all of the \ parameters, use the values for the atomic data from above, and set time \ derivatives to zero with ", Cell[BoxData[ RowBox[{ RowBox[{ SuperscriptBox[ SubscriptBox["\[Rho]", RowBox[{"s1_", ",", "s2_"}]], "\[Prime]", MultilineFunction->None], "[", "t", "]"}], "\[Rule]", "0"}]]], " to find the steady state. " }], "Text"], Cell[BoxData[ RowBox[{ RowBox[{"sol", "=", RowBox[{ RowBox[{"NSolve", "[", RowBox[{ RowBox[{"Evaluate", "[", RowBox[{ RowBox[{ RowBox[{ RowBox[{ RowBox[{"eqs0", "/.", RowBox[{"{", RowBox[{ RowBox[{ SubscriptBox["\[Phi]", "_"], "\[Rule]", "1."}], ",", RowBox[{"\[Delta]k", "\[Rule]", "0"}], ",", RowBox[{"\[Delta]\[Omega]", "\[Rule]", "0"}], ",", RowBox[{ SubscriptBox["\[CapitalOmega]", RowBox[{"_", ",", "p"}]], "\[Rule]", SuperscriptBox["10", "11"]}], ",", RowBox[{ SubscriptBox["\[CapitalOmega]", RowBox[{"_", ",", "m"}]], "\[Rule]", RowBox[{"3.", " ", SuperscriptBox["10", "11"]}]}], ",", RowBox[{ SubscriptBox["\[Delta]", "_"], "\[Rule]", RowBox[{"1.", " ", SuperscriptBox["10", "7"]}]}], ",", RowBox[{"\[Gamma]t", "\[Rule]", "10."}], ",", RowBox[{ SubscriptBox["\[CapitalOmega]L", "x"], "\[Rule]", ".1"}], ",", RowBox[{ SubscriptBox["\[CapitalOmega]L", "y"], "\[Rule]", ".2"}], ",", RowBox[{ SubscriptBox["\[CapitalOmega]L", "z"], "\[Rule]", ".3"}]}], "}"}]}], "/.", "atomicdata"}], "/.", RowBox[{"Hertz", "\[Rule]", "1"}]}], "/.", RowBox[{"Mega", "\[Rule]", "1"}]}], "/.", RowBox[{ RowBox[{ SuperscriptBox[ SubscriptBox["\[Rho]", RowBox[{"s1_", ",", "s2_"}]], "\[Prime]", MultilineFunction->None], "[", "t", "]"}], "\[Rule]", "0"}]}], "]"}], ",", RowBox[{"DMVariables", "[", "system", "]"}]}], "]"}], "[", RowBox[{"[", "1", "]"}], "]"}]}], ";"}]], "Input"], Cell["\<\ Find the position in the solution list of all of the DM elements that are \ zero.\ \>", "Text"], Cell[BoxData[ RowBox[{"delpos", "=", RowBox[{"Position", "[", RowBox[{"sol", ",", RowBox[{"_", "\[Rule]", RowBox[{"0.", "+", RowBox[{"0.", " ", "\[ImaginaryI]"}]}]}]}], "]"}]}]], "Input"], Cell["\<\ Find the list of DM elements that correspond to these zero positions.\ \>", "Text"], Cell[BoxData[ RowBox[{"delvars", "=", RowBox[{"Extract", "[", RowBox[{ RowBox[{"DMVariables", "[", "system", "]"}], ",", "delpos"}], "]"}]}]], "Input"], Cell["Create a list of rules to set these DM elements to zero.", "Text"], Cell[BoxData[ RowBox[{ RowBox[{"delreps", "=", RowBox[{"(", RowBox[{ RowBox[{ RowBox[{"(", RowBox[{"#", "\[Rule]", "0"}], ")"}], "&"}], "/@", "delvars"}], ")"}]}], ";"}]], "Input"], Cell["\<\ Find the list of variables corresponding to nonzero DM elements.\ \>", "Text"], Cell[BoxData[ RowBox[{"vars", "=", RowBox[{"Delete", "[", RowBox[{ RowBox[{"DMVariables", "[", "system", "]"}], ",", "delpos"}], "]"}]}]], "Input"], Cell["\<\ Remove all of the zero elements from the evolution equations.\ \>", "Text"], Cell[BoxData[ RowBox[{"TableForm", "[", RowBox[{"eqs", "=", RowBox[{"Delete", "[", RowBox[{ RowBox[{"eqs0", "/.", "delreps"}], ",", "delpos"}], "]"}]}], "]"}]], "Input"], Cell["Initial conditions for the time-dependent case.", "Text"], Cell[BoxData[ RowBox[{"inits", "=", RowBox[{"Delete", "[", RowBox[{ RowBox[{"InitialConditions", "[", RowBox[{"system", ",", RowBox[{"TransitRepopulation", "[", RowBox[{"system", ",", "1"}], "]"}], ",", "0"}], "]"}], ",", "delpos"}], "]"}]}]], "Input"], Cell[TextData[{ "Find equations for the steady state by setting time derivatives to zero. We \ also substitute in numerical values for natural widths in units of ", Cell[BoxData[ FormBox[ SuperscriptBox["10", "6"], TraditionalForm]]], " rad/s." }], "Text"], Cell[BoxData[ RowBox[{"steadyeqs", "=", RowBox[{ RowBox[{ RowBox[{ RowBox[{"eqs", "/.", "atomicdata"}], "/.", RowBox[{"Hertz", "\[Rule]", "1"}]}], "/.", RowBox[{"Mega", "\[Rule]", "1"}]}], "/.", RowBox[{ RowBox[{ SuperscriptBox[ SubscriptBox["\[Rho]", RowBox[{"s1_", ",", "s2_"}]], "\[Prime]", MultilineFunction->None], "[", "t", "]"}], "\[Rule]", "0"}]}]}]], "Input"], Cell[TextData[{ "Here we find expressions for the change of the spherical components of the \ probe light amplitude upon propagation through a thin slice of medium in \ terms of the density matrix elements. Since the probe light does not interact \ with the D2 transition, we set DM elements involving the ", Cell[BoxData[ FormBox[ SubscriptBox["P", RowBox[{"3", "/", "2"}]], TraditionalForm]]], " state to zero. We also set the vanishing DM elements found above to zero." }], "Text"], Cell["Polarization components for the probe light.", "Text"], Cell[BoxData[ RowBox[{"pc", "=", RowBox[{"Simplify", "[", RowBox[{ RowBox[{ RowBox[{"PolarizationComponents", "[", RowBox[{"system", ",", RowBox[{"Energy", "[", "1", "]"}], ",", "E0"}], "]"}], "/.", RowBox[{ RowBox[{ RowBox[{"DMElementPattern", "[", "]"}], "/;", RowBox[{ RowBox[{"Label2", "\[Equal]", "2"}], "||", RowBox[{"F1", "\[Equal]", "2"}]}]}], "\[Rule]", "0"}]}], "/.", "delreps"}], "]"}]}]], "Input"], Cell["Differential change of the spherical components.", "Text"], Cell[BoxData[{ RowBox[{ RowBox[{ RowBox[{"{", RowBox[{ RowBox[{ RowBox[{"EpRe", "'"}], "+", RowBox[{"\[ImaginaryI]", " ", RowBox[{"EpIm", "'"}]}]}], ",", RowBox[{ RowBox[{"EmRe", "'"}], "+", RowBox[{"\[ImaginaryI]", " ", RowBox[{"EmIm", "'"}]}]}]}], "}"}], "/.", RowBox[{"{", RowBox[{ RowBox[{ SuperscriptBox["EpRe", "\[Prime]", MultilineFunction->None], "\[Rule]", RowBox[{ RowBox[{"-", SqrtBox["2"]}], " ", RowBox[{"(", RowBox[{"P2", "+", "P3"}], ")"}], " ", "\[Pi]", " ", "\[Omega]"}]}], ",", RowBox[{ SuperscriptBox["EpIm", "\[Prime]", MultilineFunction->None], "\[Rule]", RowBox[{ SqrtBox["2"], " ", RowBox[{"(", RowBox[{ RowBox[{"-", "P1"}], "+", "P4"}], ")"}], " ", "\[Pi]", " ", "\[Omega]"}]}], ",", RowBox[{ SuperscriptBox["EmRe", "\[Prime]", MultilineFunction->None], "\[Rule]", RowBox[{ SqrtBox["2"], " ", RowBox[{"(", RowBox[{"P2", "-", "P3"}], ")"}], " ", "\[Pi]", " ", "\[Omega]"}]}], ",", RowBox[{ SuperscriptBox["EmIm", "\[Prime]", MultilineFunction->None], "\[Rule]", RowBox[{ SqrtBox["2"], " ", RowBox[{"(", RowBox[{"P1", "+", "P4"}], ")"}], " ", "\[Pi]", " ", "\[Omega]"}]}]}], "}"}]}], "//", "Simplify"}], "\[IndentingNewLine]", RowBox[{"dsigma0", "=", RowBox[{ RowBox[{"ExpandDipoleRME", "[", RowBox[{"system", ",", RowBox[{ RowBox[{ RowBox[{"%", " ", RowBox[{"ReducedME", "[", RowBox[{"0", ",", RowBox[{"{", RowBox[{"Dipole", ",", "1"}], "}"}], ",", "1"}], "]"}]}], "/.", RowBox[{"{", RowBox[{ RowBox[{"P1", "\[Rule]", RowBox[{"pc", "[", RowBox[{"[", "1", "]"}], "]"}]}], ",", RowBox[{"P2", "\[Rule]", RowBox[{"pc", "[", RowBox[{"[", "2", "]"}], "]"}]}], ",", RowBox[{"P3", "\[Rule]", RowBox[{"pc", "[", RowBox[{"[", "3", "]"}], "]"}]}], ",", RowBox[{"P4", "\[Rule]", RowBox[{"pc", "[", RowBox[{"[", "4", "]"}], "]"}]}]}], "}"}]}], "/.", RowBox[{"\[Omega]", "\[Rule]", RowBox[{"Energy", "[", "1", "]"}]}]}]}], "]"}], "//", "Simplify"}]}]}], "Input"], Cell["\<\ Calculate linear probe absorption with weak probe light on resonance and no \ pump to find reference level\ \>", "Text"], Cell[BoxData[{ RowBox[{ RowBox[{"params", "=", RowBox[{"{", RowBox[{ RowBox[{ SubscriptBox["\[CapitalOmega]", RowBox[{"2", ",", "p"}]], "\[Rule]", ".000002"}], ",", RowBox[{ SubscriptBox["\[CapitalOmega]", RowBox[{"_", ",", "_"}]], "\[Rule]", "0"}], ",", RowBox[{ SubscriptBox["\[Delta]", "2"], "\[Rule]", "0"}], ",", RowBox[{ SubscriptBox["\[Delta]", "1"], "\[Rule]", "0"}], ",", RowBox[{ SubscriptBox["\[Delta]", "3"], "\[Rule]", "0"}], ",", RowBox[{"\[Gamma]t", "\[Rule]", ".0001"}], ",", RowBox[{ SubscriptBox["\[CapitalOmega]L", "_"], "\[Rule]", "0"}], ",", RowBox[{ SubscriptBox["\[Epsilon]", "2"], "\[Rule]", "0"}]}], "}"}]}], ";"}], "\[IndentingNewLine]", RowBox[{"linabs", "=", RowBox[{ RowBox[{ RowBox[{ FractionBox[ RowBox[{"dsigma0", "[", RowBox[{"[", "1", "]"}], "]"}], RowBox[{"Abs", "[", SubscriptBox["\[CapitalOmega]", RowBox[{"2", ",", "p"}]], "]"}]], "/.", RowBox[{"Chop", "@", RowBox[{ RowBox[{"NSolve", "[", RowBox[{ RowBox[{"Evaluate", "[", RowBox[{"steadyeqs", "/.", "params"}], "]"}], ",", "vars"}], "]"}], "\[LeftDoubleBracket]", "1", "\[RightDoubleBracket]"}]}]}], "/.", "params"}], "/.", RowBox[{"\[Omega]", "\[Rule]", RowBox[{"Energy", "[", "1", "]"}]}]}]}]}], "Input"], Cell["\<\ Divide change of the spherical components by the linear absorption per unit \ length to find change per absorption length.\ \>", "Text"], Cell[BoxData[ RowBox[{"obs", "=", RowBox[{ RowBox[{"dsigma0", "/", "linabs"}], "//", "Chop"}]}]], "Input"], Cell["\<\ Relate absorption and phase shift to changes in the real and imaginary parts \ of the spherical field components.\ \>", "Text"], Cell["\<\ Fractional absorption of one spherical component of the field.\ \>", "Text"], Cell[BoxData[ RowBox[{ RowBox[{"dE", "[", RowBox[{"\[CapitalOmega]_", ",", "d\[CapitalOmega]_"}], "]"}], "=", RowBox[{ RowBox[{"FullSimplify", "[", RowBox[{ RowBox[{"D", "[", RowBox[{ SqrtBox[ RowBox[{ SuperscriptBox[ RowBox[{ SubscriptBox["\[CapitalOmega]", "Im"], "[", "z", "]"}], "2"], "+", SuperscriptBox[ RowBox[{ SubscriptBox["\[CapitalOmega]", "Re"], "[", "z", "]"}], "2"]}]], ",", "z"}], "]"}], "/", SqrtBox[ RowBox[{ SuperscriptBox[ RowBox[{ SubscriptBox["\[CapitalOmega]", "Im"], "[", "z", "]"}], "2"], "+", SuperscriptBox[ RowBox[{ SubscriptBox["\[CapitalOmega]", "Re"], "[", "z", "]"}], "2"]}]]}], "]"}], "/.", RowBox[{"{", RowBox[{ RowBox[{ RowBox[{ SubscriptBox["\[CapitalOmega]", "i_"], "[", "z", "]"}], "\[Rule]", RowBox[{"i", "[", "\[CapitalOmega]", "]"}]}], ",", RowBox[{ RowBox[{ RowBox[{ SubscriptBox["\[CapitalOmega]", "i_"], "'"}], "[", "z", "]"}], "\[Rule]", RowBox[{"i", "[", "d\[CapitalOmega]", "]"}]}]}], "}"}]}]}]], "Input"], Cell["Phase shift of one component of the field.", "Text"], Cell[BoxData[ RowBox[{ RowBox[{"d\[Phi]", "[", RowBox[{"\[CapitalOmega]_", ",", "d\[CapitalOmega]_"}], "]"}], "=", RowBox[{ RowBox[{"FullSimplify", "[", RowBox[{"D", "[", RowBox[{ RowBox[{"ArcTan", "[", FractionBox[ RowBox[{ SubscriptBox["\[CapitalOmega]", "Im"], "[", "z", "]"}], RowBox[{ SubscriptBox["\[CapitalOmega]", "Re"], "[", "z", "]"}]], "]"}], ",", "z"}], "]"}], "]"}], "/.", RowBox[{"{", RowBox[{ RowBox[{ RowBox[{ SubscriptBox["\[CapitalOmega]", "i_"], "[", "z", "]"}], "\[Rule]", RowBox[{"i", "[", "\[CapitalOmega]", "]"}]}], ",", RowBox[{ RowBox[{ RowBox[{ SubscriptBox["\[CapitalOmega]", "i_"], "'"}], "[", "z", "]"}], "\[Rule]", RowBox[{"i", "[", "d\[CapitalOmega]", "]"}]}]}], "}"}]}]}]], "Input"] }, Open ]], Cell[CellGroupData[{ Cell["Plot steady-state results", "Section"], Cell[BoxData[ RowBox[{ RowBox[{"SetOptions", "[", RowBox[{"ListLinePlot", ",", RowBox[{"Frame", "\[Rule]", "True"}], ",", RowBox[{"Axes", "\[Rule]", "False"}], ",", RowBox[{"PlotRange", "\[Rule]", "All"}]}], "]"}], ";"}]], "Input"], Cell["\<\ Here we set parameters and plot the fractional absorption and phase shift of \ the probe light per absorption length, corresponding to imaginary and real \ parts of the index of refraction, respectively, as a function of probe \ detuning.\ \>", "Text"], Cell[BoxData[{ RowBox[{ RowBox[{"params", "=", RowBox[{"{", RowBox[{ RowBox[{ SubscriptBox["\[CapitalOmega]", RowBox[{"1", ",", "m"}]], "\[Rule]", "100."}], ",", RowBox[{ SubscriptBox["\[CapitalOmega]", RowBox[{"2", ",", "p"}]], "\[Rule]", ".01"}], ",", RowBox[{ SubscriptBox["\[CapitalOmega]", RowBox[{"3", ",", "m"}]], "\[Rule]", "10."}], ",", RowBox[{ SubscriptBox["\[CapitalOmega]", RowBox[{"_", ",", "_"}]], "\[Rule]", "0."}], ",", RowBox[{ SubscriptBox["\[Delta]", "2"], "\[Rule]", "d"}], ",", RowBox[{ SubscriptBox["\[Delta]", "1"], "\[Rule]", "0"}], ",", RowBox[{ SubscriptBox["\[Delta]", "3"], "\[Rule]", "0"}], ",", RowBox[{"\[Gamma]t", "\[Rule]", ".1"}], ",", RowBox[{ SubscriptBox["\[CapitalOmega]L", "x"], "\[Rule]", "0"}], ",", RowBox[{ SubscriptBox["\[CapitalOmega]L", "y"], "\[Rule]", "0"}], ",", RowBox[{ SubscriptBox["\[CapitalOmega]L", "z"], "\[Rule]", "0"}]}], "}"}]}], ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{"steadyeqs1", "=", RowBox[{"steadyeqs", "/.", "params"}]}], ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{"table", "=", RowBox[{"Table", "[", RowBox[{ RowBox[{ RowBox[{ RowBox[{"{", RowBox[{"d", ",", "obs"}], "}"}], "/.", RowBox[{ RowBox[{"NSolve", "[", RowBox[{"steadyeqs1", ",", "vars"}], "]"}], "\[LeftDoubleBracket]", "1", "\[RightDoubleBracket]"}]}], "/.", "params"}], ",", RowBox[{"{", RowBox[{"d", ",", RowBox[{"-", "200"}], ",", "200", ",", "2"}], "}"}]}], "]"}]}], ";"}], "\[IndentingNewLine]", RowBox[{"ListLinePlot", "[", RowBox[{"Transpose", "[", RowBox[{"{", RowBox[{ RowBox[{"table", "[", RowBox[{"[", RowBox[{"All", ",", "1"}], "]"}], "]"}], ",", RowBox[{ RowBox[{ RowBox[{"dE", "[", RowBox[{ RowBox[{ SubscriptBox["\[CapitalOmega]", RowBox[{"2", ",", "p"}]], "/.", "params"}], ",", "#"}], "]"}], "&"}], "/@", RowBox[{"table", "[", RowBox[{"[", RowBox[{"All", ",", "2", ",", "1"}], "]"}], "]"}]}]}], "}"}], "]"}], "]"}], "\[IndentingNewLine]", RowBox[{"ListLinePlot", "[", RowBox[{"Transpose", "[", RowBox[{"{", RowBox[{ RowBox[{"table", "[", RowBox[{"[", RowBox[{"All", ",", "1"}], "]"}], "]"}], ",", RowBox[{ RowBox[{ RowBox[{"d\[Phi]", "[", RowBox[{ RowBox[{ SubscriptBox["\[CapitalOmega]", RowBox[{"2", ",", "p"}]], "/.", "params"}], ",", "#"}], "]"}], "&"}], "/@", RowBox[{"table", "[", RowBox[{"[", RowBox[{"All", ",", "2", ",", "1"}], "]"}], "]"}]}]}], "}"}], "]"}], "]"}]}], "Input"], Cell["Plot atomic populations for a given set of parameters.", "Text"], Cell[BoxData[{ RowBox[{ RowBox[{"params", "=", RowBox[{"{", RowBox[{ RowBox[{ SubscriptBox["\[CapitalOmega]", RowBox[{"1", ",", "m"}]], "\[Rule]", "100."}], ",", RowBox[{ SubscriptBox["\[CapitalOmega]", RowBox[{"2", ",", "p"}]], "\[Rule]", ".01"}], ",", RowBox[{ SubscriptBox["\[CapitalOmega]", RowBox[{"3", ",", "m"}]], "\[Rule]", "10."}], ",", RowBox[{ SubscriptBox["\[CapitalOmega]", RowBox[{"_", ",", "_"}]], "\[Rule]", "0."}], ",", RowBox[{ SubscriptBox["\[Delta]", "2"], "\[Rule]", "0"}], ",", RowBox[{ SubscriptBox["\[Delta]", "1"], "\[Rule]", "0"}], ",", RowBox[{ SubscriptBox["\[Delta]", "3"], "\[Rule]", "0"}], ",", RowBox[{"\[Gamma]t", "\[Rule]", ".1"}], ",", RowBox[{ SubscriptBox["\[CapitalOmega]L", "x"], "\[Rule]", "0"}], ",", RowBox[{ SubscriptBox["\[CapitalOmega]L", "y"], "\[Rule]", "0"}], ",", RowBox[{ SubscriptBox["\[CapitalOmega]L", "z"], "\[Rule]", "0"}]}], "}"}]}], ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{"steadyeqs1", "=", RowBox[{"steadyeqs", "/.", "params"}]}], ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{"sol", "=", RowBox[{ RowBox[{"Chop", "@", RowBox[{ RowBox[{"NSolve", "[", RowBox[{"steadyeqs1", ",", "vars"}], "]"}], "\[LeftDoubleBracket]", "1", "\[RightDoubleBracket]"}]}], "/.", "params"}]}], ";"}], "\n", RowBox[{"LevelDiagram", "[", RowBox[{"system", ",", RowBox[{ RowBox[{ RowBox[{"Hrwa", "/.", RowBox[{"{", RowBox[{ RowBox[{ SubscriptBox["\[Delta]", "1"], "\[Rule]", RowBox[{"-", "\[Omega]1res"}]}], ",", RowBox[{ SubscriptBox["\[Delta]", "2"], "\[Rule]", RowBox[{"-", "\[Omega]2res"}]}], ",", RowBox[{ SubscriptBox["\[Delta]", "3"], "\[Rule]", RowBox[{"-", "\[Omega]3res"}]}]}], "}"}]}], "/.", "params"}], "/.", RowBox[{"{", RowBox[{ RowBox[{ RowBox[{"Energy", "[", "0", "]"}], "\[Rule]", "0"}], ",", RowBox[{ RowBox[{"Energy", "[", "1", "]"}], "\[Rule]", "2"}], ",", RowBox[{ RowBox[{"Energy", "[", "2", "]"}], "\[Rule]", "3"}], ",", RowBox[{ RowBox[{"HyperfineA", "[", "_", "]"}], "\[Rule]", ".2"}], ",", RowBox[{ RowBox[{"HyperfineB", "[", "_", "]"}], "\[Rule]", ".1"}], ",", RowBox[{"\[CapitalOmega]L", "\[Rule]", "0"}]}], "}"}]}], ",", RowBox[{ RowBox[{ RowBox[{"DensityMatrix", "[", "system", "]"}], "/.", "sol"}], "/.", RowBox[{ RowBox[{"DMElementPattern", "[", "]"}], "\[Rule]", "0"}]}], ",", RowBox[{"ParityOffset", "\[Rule]", "False"}], ",", RowBox[{"Epilog", "\[Rule]", RowBox[{"{", RowBox[{ RowBox[{"Text", "[", RowBox[{ RowBox[{"Style", "[", RowBox[{ "\"\<\!\(\*SuperscriptBox[\(\[VeryThinSpace]\), \ \(2\)]\)\!\(\*SubscriptBox[\(S\), \(1/2\)]\)\>\"", ",", RowBox[{"SingleLetterItalics", "\[Rule]", "False"}]}], "]"}], ",", RowBox[{"{", RowBox[{ RowBox[{"-", "2.9"}], ",", "0"}], "}"}]}], "]"}], ",", RowBox[{"Text", "[", RowBox[{ RowBox[{"Style", "[", RowBox[{ "\"\<\!\(\*SuperscriptBox[\(\[VeryThinSpace]\), \ \(2\)]\)\!\(\*SubscriptBox[\(P\), \(1/2\)]\)\>\"", ",", RowBox[{"SingleLetterItalics", "\[Rule]", "False"}]}], "]"}], ",", RowBox[{"{", RowBox[{ RowBox[{"-", "2.9"}], ",", "1.6"}], "}"}]}], "]"}], ",", RowBox[{"Text", "[", RowBox[{ RowBox[{"Style", "[", RowBox[{ "\"\<\!\(\*SuperscriptBox[\(\[VeryThinSpace]\), \ \(2\)]\)\!\(\*SubscriptBox[\(P\), \(3/2\)]\)\>\"", ",", RowBox[{"SingleLetterItalics", "\[Rule]", "False"}]}], "]"}], ",", RowBox[{"{", RowBox[{ RowBox[{"-", "2.9"}], ",", "2.7"}], "}"}]}], "]"}]}], "}"}]}], ",", RowBox[{"ImageSize", "\[Rule]", RowBox[{"3.5", " ", "72"}]}], ",", RowBox[{"ImagePadding", "\[Rule]", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{"35", ",", "0"}], "}"}], ",", RowBox[{"{", RowBox[{"10", ",", "10"}], "}"}]}], "}"}]}], ",", RowBox[{"PopulationStyle", "\[Rule]", RowBox[{"PointSize", "[", ".018", "]"}]}]}], "]"}]}], "Input"], Cell[BoxData[{ RowBox[{ RowBox[{"params", "=", RowBox[{"{", RowBox[{ RowBox[{ SubscriptBox["\[CapitalOmega]", RowBox[{"1", ",", "p"}]], "\[Rule]", "100."}], ",", RowBox[{ SubscriptBox["\[CapitalOmega]", RowBox[{"2", ",", "p"}]], "\[Rule]", ".01"}], ",", RowBox[{ SubscriptBox["\[CapitalOmega]", RowBox[{"3", ",", "m"}]], "\[Rule]", "10."}], ",", RowBox[{ SubscriptBox["\[CapitalOmega]", RowBox[{"_", ",", "_"}]], "\[Rule]", "0."}], ",", RowBox[{ SubscriptBox["\[Delta]", "2"], "\[Rule]", "0"}], ",", RowBox[{ SubscriptBox["\[Delta]", "1"], "\[Rule]", "0"}], ",", RowBox[{ SubscriptBox["\[Delta]", "3"], "\[Rule]", "0"}], ",", RowBox[{"\[Gamma]t", "\[Rule]", ".1"}], ",", RowBox[{ SubscriptBox["\[CapitalOmega]L", "x"], "\[Rule]", "0"}], ",", RowBox[{ SubscriptBox["\[CapitalOmega]L", "y"], "\[Rule]", "0"}], ",", RowBox[{ SubscriptBox["\[CapitalOmega]L", "z"], "\[Rule]", "0"}]}], "}"}]}], ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{"steadyeqs1", "=", RowBox[{"steadyeqs", "/.", "params"}]}], ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{"sol", "=", RowBox[{ RowBox[{"Chop", "@", RowBox[{ RowBox[{"NSolve", "[", RowBox[{"steadyeqs1", ",", "vars"}], "]"}], "\[LeftDoubleBracket]", "1", "\[RightDoubleBracket]"}]}], "/.", "params"}]}], ";"}], "\n", RowBox[{"LevelDiagram", "[", RowBox[{"system", ",", RowBox[{ RowBox[{ RowBox[{"Hrwa", "/.", RowBox[{"{", RowBox[{ RowBox[{ SubscriptBox["\[Delta]", "1"], "\[Rule]", RowBox[{"-", "\[Omega]1res"}]}], ",", RowBox[{ SubscriptBox["\[Delta]", "2"], "\[Rule]", RowBox[{"-", "\[Omega]2res"}]}], ",", RowBox[{ SubscriptBox["\[Delta]", "3"], "\[Rule]", RowBox[{"-", "\[Omega]3res"}]}]}], "}"}]}], "/.", "params"}], "/.", RowBox[{"{", RowBox[{ RowBox[{ RowBox[{"Energy", "[", "0", "]"}], "\[Rule]", "0"}], ",", RowBox[{ RowBox[{"Energy", "[", "1", "]"}], "\[Rule]", "2"}], ",", RowBox[{ RowBox[{"Energy", "[", "2", "]"}], "\[Rule]", "3"}], ",", RowBox[{ RowBox[{"HyperfineA", "[", "_", "]"}], "\[Rule]", ".2"}], ",", RowBox[{ RowBox[{"HyperfineB", "[", "_", "]"}], "\[Rule]", ".1"}], ",", RowBox[{"\[CapitalOmega]L", "\[Rule]", "0"}]}], "}"}]}], ",", RowBox[{ RowBox[{ RowBox[{"DensityMatrix", "[", "system", "]"}], "/.", "sol"}], "/.", RowBox[{ RowBox[{"DMElementPattern", "[", "]"}], "\[Rule]", "0"}]}], ",", RowBox[{"ParityOffset", "\[Rule]", "False"}], ",", RowBox[{"Epilog", "\[Rule]", RowBox[{"{", RowBox[{ RowBox[{"Text", "[", RowBox[{ RowBox[{"Style", "[", RowBox[{ "\"\<\!\(\*SuperscriptBox[\(\[VeryThinSpace]\), \ \(2\)]\)\!\(\*SubscriptBox[\(S\), \(1/2\)]\)\>\"", ",", RowBox[{"SingleLetterItalics", "\[Rule]", "False"}]}], "]"}], ",", RowBox[{"{", RowBox[{ RowBox[{"-", "2.9"}], ",", "0"}], "}"}]}], "]"}], ",", RowBox[{"Text", "[", RowBox[{ RowBox[{"Style", "[", RowBox[{ "\"\<\!\(\*SuperscriptBox[\(\[VeryThinSpace]\), \ \(2\)]\)\!\(\*SubscriptBox[\(P\), \(1/2\)]\)\>\"", ",", RowBox[{"SingleLetterItalics", "\[Rule]", "False"}]}], "]"}], ",", RowBox[{"{", RowBox[{ RowBox[{"-", "2.9"}], ",", "1.6"}], "}"}]}], "]"}], ",", RowBox[{"Text", "[", RowBox[{ RowBox[{"Style", "[", RowBox[{ "\"\<\!\(\*SuperscriptBox[\(\[VeryThinSpace]\), \ \(2\)]\)\!\(\*SubscriptBox[\(P\), \(3/2\)]\)\>\"", ",", RowBox[{"SingleLetterItalics", "\[Rule]", "False"}]}], "]"}], ",", RowBox[{"{", RowBox[{ RowBox[{"-", "2.9"}], ",", "2.7"}], "}"}]}], "]"}]}], "}"}]}], ",", RowBox[{"ImageSize", "\[Rule]", RowBox[{"3.5", " ", "72"}]}], ",", RowBox[{"ImagePadding", "\[Rule]", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{"35", ",", "0"}], "}"}], ",", RowBox[{"{", RowBox[{"10", ",", "10"}], "}"}]}], "}"}]}], ",", RowBox[{"PopulationStyle", "\[Rule]", RowBox[{"PointSize", "[", ".018", "]"}]}]}], "]"}]}], "Input"], Cell[BoxData[ RowBox[{ RowBox[{"table", "=", RowBox[{"Flatten", "[", RowBox[{ RowBox[{"Table", "[", "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{"params", "=", RowBox[{"{", RowBox[{ RowBox[{ SubscriptBox["\[CapitalOmega]", RowBox[{"1", ",", "m"}]], "\[Rule]", SuperscriptBox["10", "e1m"]}], ",", RowBox[{ SubscriptBox["\[CapitalOmega]", RowBox[{"2", ",", "p"}]], "\[Rule]", ".001"}], ",", RowBox[{ SubscriptBox["\[CapitalOmega]", RowBox[{"3", ",", "m"}]], "\[Rule]", SuperscriptBox["10", "e3m"]}], ",", RowBox[{ SubscriptBox["\[CapitalOmega]", RowBox[{"_", ",", "_"}]], "\[Rule]", "0."}], ",", RowBox[{ SubscriptBox["\[Delta]", "2"], "\[Rule]", "d"}], ",", RowBox[{ SubscriptBox["\[Delta]", "1"], "\[Rule]", "0"}], ",", RowBox[{ SubscriptBox["\[Delta]", "3"], "\[Rule]", "0"}], ",", RowBox[{"\[Gamma]t", "\[Rule]", ".1"}], ",", RowBox[{ SubscriptBox["\[CapitalOmega]L", "x"], "\[Rule]", "0"}], ",", RowBox[{ SubscriptBox["\[CapitalOmega]L", "y"], "\[Rule]", "0"}], ",", RowBox[{ SubscriptBox["\[CapitalOmega]L", "z"], "\[Rule]", "0"}]}], "}"}]}], ";", "\[IndentingNewLine]", RowBox[{"steadyeqs1", "=", RowBox[{"steadyeqs", "/.", "params"}]}], ";", "\[IndentingNewLine]", RowBox[{"points", "=", RowBox[{"Table", "[", RowBox[{ RowBox[{ RowBox[{ RowBox[{"{", RowBox[{"d", ",", "obs"}], "}"}], "/.", RowBox[{ RowBox[{"NSolve", "[", RowBox[{"steadyeqs1", ",", "vars"}], "]"}], "\[LeftDoubleBracket]", "1", "\[RightDoubleBracket]"}]}], "/.", "params"}], ",", RowBox[{"{", RowBox[{"d", ",", RowBox[{ RowBox[{"-", "1"}], " ", SuperscriptBox["10", RowBox[{"-", "4"}]]}], ",", RowBox[{"1", " ", SuperscriptBox["10", RowBox[{"-", "4"}]]}], ",", RowBox[{"2", " ", SuperscriptBox["10", RowBox[{"-", "4"}]]}]}], "}"}]}], "]"}]}], ";", "\[IndentingNewLine]", RowBox[{"absorption", "=", RowBox[{"dE", "[", RowBox[{ RowBox[{ SubscriptBox["\[CapitalOmega]", RowBox[{"2", ",", "p"}]], "/.", "params"}], ",", RowBox[{"points", "[", RowBox[{"[", RowBox[{"2", ",", "2", ",", "1"}], "]"}], "]"}]}], "]"}]}], ";", "\[IndentingNewLine]", RowBox[{"slope", "=", RowBox[{ RowBox[{"(", RowBox[{ RowBox[{"d\[Phi]", "[", RowBox[{ RowBox[{ SubscriptBox["\[CapitalOmega]", RowBox[{"2", ",", "p"}]], "/.", "params"}], ",", RowBox[{"points", "[", RowBox[{"[", RowBox[{"2", ",", "2", ",", "1"}], "]"}], "]"}]}], "]"}], "-", RowBox[{"d\[Phi]", "[", RowBox[{ RowBox[{ SubscriptBox["\[CapitalOmega]", RowBox[{"2", ",", "p"}]], "/.", "params"}], ",", RowBox[{"points", "[", RowBox[{"[", RowBox[{"1", ",", "2", ",", "1"}], "]"}], "]"}]}], "]"}]}], ")"}], "/", RowBox[{"(", RowBox[{ RowBox[{"points", "[", RowBox[{"[", RowBox[{"2", ",", "1"}], "]"}], "]"}], "-", RowBox[{"points", "[", RowBox[{"[", RowBox[{"1", ",", "1"}], "]"}], "]"}]}], ")"}]}]}], ";", "\[IndentingNewLine]", RowBox[{ RowBox[{"{", RowBox[{"e1m", ",", "e3m", ",", "absorption", ",", "slope"}], "}"}], "/.", "params"}]}], ",", RowBox[{"{", RowBox[{"e1m", ",", RowBox[{"-", "1."}], ",", "3.", ",", ".2"}], "}"}], ",", RowBox[{"{", RowBox[{"e3m", ",", RowBox[{"-", "1."}], ",", "3.", ",", ".2"}], "}"}]}], "]"}], ",", "1"}], "]"}]}], ";"}]], "Input"], Cell["\<\ Plot fractional absorption of the electric field per absorption length.\ \>", "Text"], Cell[BoxData[ RowBox[{"ListContourPlot", "[", RowBox[{ RowBox[{"table", "[", RowBox[{"[", RowBox[{"All", ",", RowBox[{"{", RowBox[{"1", ",", "2", ",", "3"}], "}"}]}], "]"}], "]"}], ",", RowBox[{"PlotRange", "\[Rule]", "All"}], ",", RowBox[{"ContourLabels", "\[Rule]", "All"}], ",", RowBox[{"FrameLabel", "\[Rule]", RowBox[{"{", RowBox[{ "\"\\"", ",", "\"\\""}], "}"}]}], ",", RowBox[{"BaseStyle", "\[Rule]", "14"}], ",", RowBox[{"Contours", "\[Rule]", RowBox[{"Join", "[", RowBox[{ RowBox[{"{", RowBox[{".001", ",", ".01"}], "}"}], ",", RowBox[{"Range", "[", RowBox[{".1", ",", "1", ",", ".1"}], "]"}]}], "]"}]}]}], "]"}]], "Input"], Cell["\<\ Plot slope of the phase shift in rad/(Mrad/s) per absorption length\ \>", "Text"], Cell[BoxData[ RowBox[{"ListContourPlot", "[", RowBox[{ RowBox[{"table", "[", RowBox[{"[", RowBox[{"All", ",", RowBox[{"{", RowBox[{"1", ",", "2", ",", "4"}], "}"}]}], "]"}], "]"}], ",", RowBox[{"PlotRange", "\[Rule]", "All"}], ",", RowBox[{"ContourLabels", "\[Rule]", "All"}], ",", RowBox[{"FrameLabel", "\[Rule]", RowBox[{"{", RowBox[{ "\"\\"", ",", "\"\\""}], "}"}]}], ",", RowBox[{"BaseStyle", "\[Rule]", "14"}], ",", RowBox[{"Contours", "\[Rule]", RowBox[{"Join", "[", RowBox[{ RowBox[{"Range", "[", RowBox[{ RowBox[{"-", "5"}], ",", "0", ",", ".5"}], "]"}], ",", RowBox[{"10", "^", RowBox[{"Range", "[", RowBox[{ RowBox[{"-", "4."}], ",", RowBox[{"-", "2."}], ",", "1"}], "]"}]}]}], "]"}]}]}], "]"}]], "Input"], Cell[BoxData[ RowBox[{ RowBox[{"table", "=", RowBox[{"Flatten", "[", RowBox[{ RowBox[{"Table", "[", "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{"params", "=", RowBox[{"{", RowBox[{ RowBox[{ SubscriptBox["\[CapitalOmega]", RowBox[{"1", ",", "m"}]], "\[Rule]", SuperscriptBox["10", "e1m"]}], ",", RowBox[{ SubscriptBox["\[CapitalOmega]", RowBox[{"2", ",", "p"}]], "\[Rule]", ".001"}], ",", RowBox[{ SubscriptBox["\[CapitalOmega]", RowBox[{"3", ",", "m"}]], "\[Rule]", SuperscriptBox["10", "e3m"]}], ",", RowBox[{ SubscriptBox["\[CapitalOmega]", RowBox[{"_", ",", "_"}]], "\[Rule]", "0."}], ",", RowBox[{ SubscriptBox["\[Delta]", "2"], "\[Rule]", "d"}], ",", RowBox[{ SubscriptBox["\[Delta]", "1"], "\[Rule]", "0"}], ",", RowBox[{ SubscriptBox["\[Delta]", "3"], "\[Rule]", "0"}], ",", RowBox[{"\[Gamma]t", "\[Rule]", "1."}], ",", RowBox[{ SubscriptBox["\[CapitalOmega]L", "x"], "\[Rule]", "0"}], ",", RowBox[{ SubscriptBox["\[CapitalOmega]L", "y"], "\[Rule]", "0"}], ",", RowBox[{ SubscriptBox["\[CapitalOmega]L", "z"], "\[Rule]", "0"}]}], "}"}]}], ";", "\[IndentingNewLine]", RowBox[{"steadyeqs1", "=", RowBox[{"steadyeqs", "/.", "params"}]}], ";", "\[IndentingNewLine]", RowBox[{"points", "=", RowBox[{"Table", "[", RowBox[{ RowBox[{ RowBox[{ RowBox[{"{", RowBox[{"d", ",", "obs"}], "}"}], "/.", RowBox[{ RowBox[{"NSolve", "[", RowBox[{"steadyeqs1", ",", "vars"}], "]"}], "\[LeftDoubleBracket]", "1", "\[RightDoubleBracket]"}]}], "/.", "params"}], ",", RowBox[{"{", RowBox[{"d", ",", RowBox[{ RowBox[{"-", "1"}], " ", SuperscriptBox["10", RowBox[{"-", "4"}]]}], ",", RowBox[{"1", " ", SuperscriptBox["10", RowBox[{"-", "4"}]]}], ",", RowBox[{"2", " ", SuperscriptBox["10", RowBox[{"-", "4"}]]}]}], "}"}]}], "]"}]}], ";", "\[IndentingNewLine]", RowBox[{"absorption", "=", RowBox[{"dE", "[", RowBox[{ RowBox[{ SubscriptBox["\[CapitalOmega]", RowBox[{"2", ",", "p"}]], "/.", "params"}], ",", RowBox[{"points", "[", RowBox[{"[", RowBox[{"2", ",", "2", ",", "1"}], "]"}], "]"}]}], "]"}]}], ";", "\[IndentingNewLine]", RowBox[{"slope", "=", RowBox[{ RowBox[{"(", RowBox[{ RowBox[{"d\[Phi]", "[", RowBox[{ RowBox[{ SubscriptBox["\[CapitalOmega]", RowBox[{"2", ",", "p"}]], "/.", "params"}], ",", RowBox[{"points", "[", RowBox[{"[", RowBox[{"2", ",", "2", ",", "1"}], "]"}], "]"}]}], "]"}], "-", RowBox[{"d\[Phi]", "[", RowBox[{ RowBox[{ SubscriptBox["\[CapitalOmega]", RowBox[{"2", ",", "p"}]], "/.", "params"}], ",", RowBox[{"points", "[", RowBox[{"[", RowBox[{"1", ",", "2", ",", "1"}], "]"}], "]"}]}], "]"}]}], ")"}], "/", RowBox[{"(", RowBox[{ RowBox[{"points", "[", RowBox[{"[", RowBox[{"2", ",", "1"}], "]"}], "]"}], "-", RowBox[{"points", "[", RowBox[{"[", RowBox[{"1", ",", "1"}], "]"}], "]"}]}], ")"}]}]}], ";", "\[IndentingNewLine]", RowBox[{ RowBox[{"{", RowBox[{"e1m", ",", "e3m", ",", "absorption", ",", "slope"}], "}"}], "/.", "params"}]}], ",", RowBox[{"{", RowBox[{"e1m", ",", RowBox[{"-", "1."}], ",", "3.", ",", ".2"}], "}"}], ",", RowBox[{"{", RowBox[{"e3m", ",", RowBox[{"-", "1."}], ",", "3.", ",", ".2"}], "}"}]}], "]"}], ",", "1"}], "]"}]}], ";"}]], "Input"], Cell[BoxData[ RowBox[{"ListContourPlot", "[", RowBox[{ RowBox[{"table", "[", RowBox[{"[", RowBox[{"All", ",", RowBox[{"{", RowBox[{"1", ",", "2", ",", "3"}], "}"}]}], "]"}], "]"}], ",", RowBox[{"PlotRange", "\[Rule]", "All"}], ",", RowBox[{"ContourLabels", "\[Rule]", "All"}], ",", RowBox[{"FrameLabel", "\[Rule]", RowBox[{"{", RowBox[{ "\"\\"", ",", "\"\\""}], "}"}]}], ",", RowBox[{"BaseStyle", "\[Rule]", "14"}], ",", RowBox[{"Contours", "\[Rule]", RowBox[{"Join", "[", RowBox[{ RowBox[{"{", RowBox[{".001", ",", ".01"}], "}"}], ",", RowBox[{"Range", "[", RowBox[{".1", ",", "1", ",", ".1"}], "]"}]}], "]"}]}]}], "]"}]], "Input"], Cell[BoxData[ RowBox[{"ListContourPlot", "[", RowBox[{ RowBox[{"table", "[", RowBox[{"[", RowBox[{"All", ",", RowBox[{"{", RowBox[{"1", ",", "2", ",", "4"}], "}"}]}], "]"}], "]"}], ",", RowBox[{"PlotRange", "\[Rule]", "All"}], ",", RowBox[{"ContourLabels", "\[Rule]", "All"}], ",", RowBox[{"FrameLabel", "\[Rule]", RowBox[{"{", RowBox[{ "\"\\"", ",", "\"\\""}], "}"}]}], ",", RowBox[{"BaseStyle", "\[Rule]", "14"}], ",", RowBox[{"Contours", "\[Rule]", RowBox[{"Join", "[", RowBox[{ RowBox[{"Range", "[", RowBox[{ RowBox[{"-", "5"}], ",", "0", ",", ".05"}], "]"}], ",", RowBox[{"10", "^", RowBox[{"Range", "[", RowBox[{ RowBox[{"-", "3."}], ",", RowBox[{"-", "2."}], ",", "1"}], "]"}]}]}], "]"}]}]}], "]"}]], "Input"] }, Open ]], Cell[CellGroupData[{ Cell["Eliminate conjugate DM variables", "Section"], Cell[BoxData[{ RowBox[{"delvars1", "=", RowBox[{"Intersection", "[", RowBox[{"vars", ",", RowBox[{"Cases", "[", RowBox[{"vars", ",", RowBox[{ RowBox[{ RowBox[{"DMElementPattern", "[", "]"}], "/;", RowBox[{"!", RowBox[{"OrderedQ", "[", RowBox[{"{", RowBox[{"State2", ",", "State1"}], "}"}], "]"}]}]}], "\[Rule]", RowBox[{ SubscriptBox["\[Rho]", RowBox[{"State2", ",", "State1"}]], "[", "t", "]"}]}]}], "]"}]}], "]"}]}], "\[IndentingNewLine]", RowBox[{"delpos1", "=", RowBox[{"Flatten", "[", RowBox[{ RowBox[{ RowBox[{ RowBox[{"Position", "[", RowBox[{"vars", ",", "#"}], "]"}], "&"}], "/@", "delvars1"}], ",", "1"}], "]"}]}], "\[IndentingNewLine]", RowBox[{"vars1", "=", RowBox[{"Delete", "[", RowBox[{"vars", ",", "delpos1"}], "]"}]}]}], "Input"], Cell[BoxData[ RowBox[{"delreps1", "=", RowBox[{"delvars1", "/.", RowBox[{ RowBox[{ SubscriptBox["\[Rho]", RowBox[{"s1_", ",", "s2_"}]], "[", "t", "]"}], "\[Rule]", RowBox[{"(", RowBox[{ RowBox[{ SubscriptBox["\[Rho]", RowBox[{"s1", ",", "s2"}]], "[", "t", "]"}], "\[Rule]", RowBox[{"Conjugate", "[", RowBox[{ SubscriptBox["\[Rho]", RowBox[{"s2", ",", "s1"}]], "[", "t", "]"}], "]"}]}], ")"}]}]}]}]], "Input"], Cell[BoxData[ RowBox[{"eqs1", "=", RowBox[{ RowBox[{"Delete", "[", RowBox[{"eqs", ",", "delpos1"}], "]"}], "/.", "delreps1"}]}]], "Input"], Cell[BoxData[ RowBox[{"inits1", "=", RowBox[{"Delete", "[", RowBox[{"inits", ",", "delpos1"}], "]"}]}]], "Input"] }, Open ]], Cell[CellGroupData[{ Cell["Convert equations to XMDS form", "Section"], Cell[BoxData[{ RowBox[{ RowBox[{ RowBox[{ RowBox[{ RowBox[{ RowBox[{"Join", "[", RowBox[{"atomicdata", ",", "\[IndentingNewLine]", RowBox[{ RowBox[{"Table", "[", RowBox[{ RowBox[{ RowBox[{"eta", "[", "s", "]"}], "\[Equal]", RowBox[{"3", SuperscriptBox[ RowBox[{"Wavelength", "[", "s", "]"}], "2"], RowBox[{ RowBox[{"NaturalWidth", "[", "s", "]"}], "/", RowBox[{"(", RowBox[{"4", "\[VeryThinSpace]", "\[Pi]"}], ")"}]}]}]}], ",", RowBox[{"{", RowBox[{"s", ",", RowBox[{"Union", "[", RowBox[{"Label", "/@", RowBox[{"ExcitedStates", "[", "system", "]"}]}], "]"}]}], "}"}]}], "]"}], "/.", "atomicdata"}], ",", RowBox[{"{", RowBox[{ RowBox[{"rt6", "==", RowBox[{"N", "[", SqrtBox["6"], "]"}]}], ",", RowBox[{"rt3", "==", RowBox[{"N", "[", SqrtBox["3"], "]"}]}], ",", RowBox[{"rt2", "==", RowBox[{"N", "[", SqrtBox["2"], "]"}]}]}], "}"}]}], "\[IndentingNewLine]", "]"}], "/.", RowBox[{"Mega", "\[Rule]", SuperscriptBox["10", "6"]}]}], "/.", RowBox[{"Hertz", "\[Rule]", "1"}]}], "/.", RowBox[{"Centimeter", "\[Rule]", ".01"}]}], "/.", RowBox[{"Rule", "\[Rule]", "Equal"}]}], "/.", RowBox[{"{", RowBox[{ RowBox[{"NaturalWidth", "\[Rule]", "g"}], ",", RowBox[{"HyperfineA", "\[Rule]", "ha"}], ",", RowBox[{"HyperfineB", "\[Rule]", "hb"}], ",", RowBox[{"Wavelength", "\[Rule]", "lambda"}]}], "}"}]}], "\[IndentingNewLine]", RowBox[{"StringReplace", "[", RowBox[{ RowBox[{ "\"\<\"", "<>", RowBox[{"StringJoin", "[", RowBox[{ RowBox[{ RowBox[{"\"\\"", "<>", RowBox[{"ToString", "@", RowBox[{"CForm", "[", "#", "]"}]}], "<>", "\"\<;\\n\>\""}], "&"}], "/@", "%"}], "]"}], "<>", "\"\\n\>\""}], ",", RowBox[{"{", RowBox[{ RowBox[{"\"\<==\>\"", "\[Rule]", "\"\<=\>\""}], ",", RowBox[{ RowBox[{"Shortest", "[", RowBox[{ "\"\\"", "~~", "a__", "~~", "\"\<,\>\"", "~~", "b__", "~~", "\"\<)\>\""}], "]"}], ":>", RowBox[{"\"\\"", "<>", "a", "<>", "b", "<>", "\"\<_dt\>\""}]}], ",", RowBox[{ RowBox[{"Shortest", "[", RowBox[{ "\"\\"", "~~", "a__", "~~", "\"\<,\>\"", "~~", "b__", "~~", "\"\<)\>\""}], "]"}], ":>", RowBox[{"\"\\"", "<>", "a", "<>", "b"}]}], ",", RowBox[{ RowBox[{"\"\\"", "~~", "a_", "~~", "\"\<)\>\""}], "\[RuleDelayed]", RowBox[{"\"\\"", "<>", "a"}]}], ",", RowBox[{ RowBox[{"\"\\"", "~~", "a_", "~~", "\"\<)\>\""}], "\[RuleDelayed]", RowBox[{"\"\\"", "<>", "a"}]}], ",", RowBox[{ RowBox[{"\"\\"", "~~", "a_", "~~", "\"\<)\>\""}], "\[RuleDelayed]", RowBox[{"\"\\"", "<>", "a"}]}], ",", RowBox[{ RowBox[{"\"\\"", "~~", "a_", "~~", "\"\<)\>\""}], "\[RuleDelayed]", RowBox[{"\"\\"", "<>", "a"}]}], ",", RowBox[{ RowBox[{"\"\\"", "~~", "a_", "~~", "\"\<)\>\""}], "\[RuleDelayed]", RowBox[{"\"\\"", "<>", "a"}]}], ",", RowBox[{ RowBox[{"\"\\"", "~~", "a_", "~~", "\"\<)\>\""}], "\[RuleDelayed]", RowBox[{"\"\\"", "<>", "a"}]}], ",", RowBox[{ RowBox[{"\"\\"", "~~", "a_", "~~", "\"\<)\>\""}], "\[RuleDelayed]", RowBox[{"\"\\"", "<>", "a"}]}], ",", RowBox[{ RowBox[{"\"\\"", "~~", "a_", "~~", "\"\<)\>\""}], "\[RuleDelayed]", RowBox[{"\"\\"", "<>", "a"}]}]}], "}"}]}], "]"}]}], "Input", CellChangeTimes->{{3.563131143065538*^9, 3.563131165863379*^9}, { 3.563191857093402*^9, 3.563191863236822*^9}, {3.563191931036034*^9, 3.563191939330001*^9}, {3.563191988192757*^9, 3.563191992633498*^9}}], Cell[BoxData[ RowBox[{"Export", "[", RowBox[{ RowBox[{"ToFileName", "[", RowBox[{ RowBox[{"NotebookDirectory", "[", "]"}], ",", "\"\\""}], "]"}], ",", "%", ",", " ", "\"\\""}], "]"}]], "Input", CellChangeTimes->{{3.563131169422084*^9, 3.563131175165862*^9}, { 3.563131630756442*^9, 3.563131637140431*^9}, {3.563191866089081*^9, 3.563191880631552*^9}}], Cell["Convert equations to C form", "Text"], Cell[BoxData[{ RowBox[{ RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"Label", "[", "#", "]"}], ",", RowBox[{"F", "[", "#", "]"}], ",", RowBox[{"M", "[", "#", "]"}]}], "}"}], "&"}], "/@", "system"}], "\[IndentingNewLine]", RowBox[{"labelrep", "=", RowBox[{"Table", "[", RowBox[{ RowBox[{ RowBox[{"%", "[", RowBox[{"[", "i", "]"}], "]"}], "\[Rule]", RowBox[{"ToString", "@", RowBox[{"PaddedForm", "[", RowBox[{"i", ",", "2", ",", RowBox[{"NumberPadding", "\[Rule]", RowBox[{"{", RowBox[{"\"\<0\>\"", ",", "\"\<\>\""}], "}"}]}], ",", RowBox[{"NumberSigns", "\[Rule]", RowBox[{"{", RowBox[{"\"\<\>\"", ",", "\"\<\>\""}], "}"}]}]}], "]"}]}]}], ",", RowBox[{"{", RowBox[{"i", ",", RowBox[{"Length", "@", "%"}]}], "}"}]}], "]"}]}]}], "Input"], Cell[BoxData[{ RowBox[{ RowBox[{ RowBox[{ RowBox[{ RowBox[{ RowBox[{ RowBox[{"eqs1", "/.", RowBox[{"{", RowBox[{ RowBox[{ SubscriptBox["\[Delta]", "s_"], "\[Rule]", RowBox[{ SubscriptBox["\[Delta]", "s"], "+", RowBox[{ SubscriptBox["k", "s"], "v"}]}]}], ",", RowBox[{"\[Delta]\[Omega]", "\[Rule]", RowBox[{"\[Delta]\[Omega]", "+", RowBox[{"\[Delta]k", " ", "v"}]}]}]}], "}"}]}], "/.", RowBox[{"{", RowBox[{ RowBox[{"NaturalWidth", "\[Rule]", "g"}], ",", RowBox[{"HyperfineA", "\[Rule]", "ha"}], ",", RowBox[{"HyperfineB", "\[Rule]", "hb"}], ",", RowBox[{ RowBox[{ SuperscriptBox[ SubscriptBox["\[Rho]", RowBox[{"s1_", ",", "s2_"}]], "\[Prime]", MultilineFunction->None], "[", "t", "]"}], "\[RuleDelayed]", RowBox[{"dr", "[", RowBox[{"s1", ",", "s2"}], "]"}]}], ",", RowBox[{ RowBox[{ SubscriptBox["\[Rho]", RowBox[{"s1_", ",", "s2_"}]], "[", "t", "]"}], "\[RuleDelayed]", RowBox[{"r", "[", RowBox[{"s1", ",", "s2"}], "]"}]}], ",", RowBox[{"\[Gamma]t", "\[Rule]", "gt"}], ",", RowBox[{ SubscriptBox["\[CapitalOmega]L", "x_"], "\[Rule]", RowBox[{"WL", "[", "x", "]"}]}], ",", RowBox[{ SubscriptBox["\[Delta]", "i_"], "\[Rule]", RowBox[{"d", "[", "i", "]"}]}], ",", RowBox[{ SubscriptBox["k", "i_"], "\[Rule]", RowBox[{"k", "[", "i", "]"}]}], ",", RowBox[{ SubscriptBox["\[CapitalOmega]", RowBox[{"j_", ",", "p"}]], "\[Rule]", RowBox[{"Ep", "[", "j", "]"}]}], ",", RowBox[{ SubscriptBox["\[CapitalOmega]", RowBox[{"j_", ",", "m"}]], "\[Rule]", RowBox[{"Em", "[", "j", "]"}]}]}], "}"}]}], "/.", "labelrep"}], "/.", RowBox[{ RowBox[{"Power", "[", RowBox[{"E", ",", "b_"}], "]"}], "\[Rule]", RowBox[{"exp", "[", "b", "]"}]}]}], "/.", RowBox[{"Conjugate", "\[Rule]", "conj"}]}], "/.", RowBox[{ RowBox[{"Complex", "[", RowBox[{"0", ",", "a_"}], "]"}], "\[Rule]", RowBox[{"a", " ", "i"}]}]}], "/.", RowBox[{"{", RowBox[{ RowBox[{ RowBox[{"1", "/", SqrtBox["6"]}], "\[Rule]", RowBox[{"1", "/", "rt6"}]}], ",", RowBox[{ RowBox[{"1", "/", SqrtBox["3"]}], "\[Rule]", RowBox[{"1", "/", "rt3"}]}], ",", RowBox[{ RowBox[{"1", "/", SqrtBox["2"]}], "\[Rule]", RowBox[{"1", "/", "rt2"}]}]}], "}"}]}], "\[IndentingNewLine]", RowBox[{"StringReplace", "[", "\[IndentingNewLine]", RowBox[{ RowBox[{ "\"\<\"", "<>", RowBox[{"StringJoin", "[", RowBox[{ RowBox[{ RowBox[{ RowBox[{"ToString", "@", RowBox[{"CForm", "[", "#", "]"}]}], "<>", "\"\<;\\n\>\""}], "&"}], "/@", "%"}], "]"}], "<>", "\[IndentingNewLine]", "\"\\n\ \>\""}], ",", RowBox[{"{", RowBox[{ RowBox[{"\"\<==\>\"", "\[Rule]", "\"\<=\>\""}], ",", RowBox[{ RowBox[{"Shortest", "[", RowBox[{ "\"\\"", "~~", "a__", "~~", "\"\<\\\",\\\"\>\"", "~~", "b__", "~~", "\"\<\\\")\>\""}], "]"}], ":>", RowBox[{"\"\\"", "<>", "a", "<>", "b", "<>", "\"\<_dt\>\""}]}], ",", RowBox[{ RowBox[{"Shortest", "[", RowBox[{ "\"\\"", "~~", "a__", "~~", "\"\<\\\",\\\"\>\"", "~~", "b__", "~~", "\"\<\\\")\>\""}], "]"}], ":>", RowBox[{"\"\\"", "<>", "a", "<>", "b"}]}], ",", RowBox[{ RowBox[{"\"\\"", "~~", "a_", "~~", "\"\<)\>\""}], "\[RuleDelayed]", RowBox[{"\"\\"", "<>", "a"}]}], ",", RowBox[{ RowBox[{"\"\\"", "~~", "a_", "~~", "\"\<)\>\""}], "\[RuleDelayed]", RowBox[{"\"\\"", "<>", "a"}]}], ",", RowBox[{ RowBox[{"\"\\"", "~~", "a_", "~~", "\"\<)\>\""}], "\[RuleDelayed]", RowBox[{"\"\\"", "<>", "a"}]}], ",", RowBox[{ RowBox[{"\"\\"", "~~", "a_", "~~", "\"\<)\>\""}], "\[RuleDelayed]", RowBox[{"\"\\"", "<>", "a", "<>", "\"\\""}]}], ",", RowBox[{ RowBox[{"\"\\"", "~~", "a_", "~~", "\"\<)\>\""}], "\[RuleDelayed]", RowBox[{"\"\\"", "<>", "a", "<>", "\"\\""}]}], ",", RowBox[{ RowBox[{"\"\\"", "~~", "a_", "~~", "\"\<)\>\""}], "\[RuleDelayed]", RowBox[{"\"\\"", "<>", "a"}]}], ",", RowBox[{ RowBox[{"\"\\"", "~~", "a_", "~~", "\"\<)\>\""}], "\[RuleDelayed]", RowBox[{"\"\\"", "<>", "a"}]}], ",", RowBox[{ RowBox[{"\"\\"", "~~", "a_", "~~", "\"\<)\>\""}], "\[RuleDelayed]", RowBox[{"\"\\"", "<>", "a"}]}], ",", " ", RowBox[{"\"\\"", "\[RuleDelayed]", " ", "\"\\""}]}], "}"}]}], "]"}]}], "Input", CellChangeTimes->{{3.562070277693772*^9, 3.562070303169202*^9}, { 3.563192105708145*^9, 3.563192138635019*^9}, {3.563192213088303*^9, 3.563192214825335*^9}}], Cell[BoxData[ RowBox[{"Export", "[", RowBox[{ RowBox[{"ToFileName", "[", RowBox[{ RowBox[{"NotebookDirectory", "[", "]"}], ",", "\"\\""}], "]"}], ",", "%", ",", "\"\\""}], "]"}]], "Input", CellChangeTimes->{{3.563192279213451*^9, 3.563192285261531*^9}}], Cell[BoxData[""], "Input", CellChangeTimes->{{3.563192320102122*^9, 3.563192327859529*^9}}], Cell["List of variables", "Text"], Cell[BoxData[ RowBox[{"StringReplace", "[", "\[IndentingNewLine]", RowBox[{ RowBox[{ "\"\<\n\ \>\"", "<>", RowBox[{"StringJoin", "[", RowBox[{ RowBox[{ RowBox[{ RowBox[{"ToString", "@", RowBox[{"CForm", "[", "#", "]"}]}], "<>", "\"\< \>\""}], "&"}], "/@", RowBox[{"(", RowBox[{ RowBox[{"vars1", "/.", "labelrep"}], "/.", RowBox[{ RowBox[{ SubscriptBox["\[Rho]", RowBox[{"s1_", ",", "s2_"}]], "[", "t_", "]"}], "\[RuleDelayed]", RowBox[{"r", "[", RowBox[{"s1", ",", "s2"}], "]"}]}]}], ")"}]}], "]"}], "<>", "\[IndentingNewLine]", "\"\<\n\n\ \>\""}], ",", RowBox[{"{", RowBox[{ RowBox[{"\"\<==\>\"", "\[Rule]", "\"\<=\>\""}], ",", RowBox[{ RowBox[{"Shortest", "[", RowBox[{ "\"\\"", "~~", "a__", "~~", "\"\<\\\",\\\"\>\"", "~~", "b__", "~~", "\"\<\\\")\>\""}], "]"}], ":>", RowBox[{"\"\\"", "<>", "a", "<>", "b", "<>", "\"\<_dt\>\""}]}], ",", RowBox[{ RowBox[{"Shortest", "[", RowBox[{ "\"\\"", "~~", "a__", "~~", "\"\<\\\",\\\"\>\"", "~~", "b__", "~~", "\"\<\\\")\>\""}], "]"}], ":>", RowBox[{"\"\\"", "<>", "a", "<>", "b"}]}], ",", RowBox[{ RowBox[{"\"\\"", "~~", "a_", "~~", "\"\<)\>\""}], "\[RuleDelayed]", RowBox[{"\"\\"", "<>", "a"}]}], ",", RowBox[{ RowBox[{"\"\\"", "~~", "a_", "~~", "\"\<)\>\""}], "\[RuleDelayed]", RowBox[{"\"\\"", "<>", "a"}]}], ",", RowBox[{ RowBox[{"\"\\"", "~~", "a_", "~~", "\"\<)\>\""}], "\[RuleDelayed]", RowBox[{"\"\\"", "<>", "a"}]}], ",", RowBox[{ RowBox[{"\"\\"", "~~", "a_", "~~", "\"\<)\>\""}], "\[RuleDelayed]", RowBox[{"\"\\"", "<>", "a"}]}], ",", RowBox[{ RowBox[{"\"\\"", "~~", "a_", "~~", "\"\<)\>\""}], "\[RuleDelayed]", RowBox[{"\"\\"", "<>", "a"}]}], ",", RowBox[{ RowBox[{"\"\\"", "~~", "a_", "~~", "\"\<)\>\""}], "\[RuleDelayed]", RowBox[{"\"\\"", "<>", "a"}]}], ",", RowBox[{ RowBox[{"\"\\"", "~~", "a_", "~~", "\"\<)\>\""}], "\[RuleDelayed]", RowBox[{"\"\\"", "<>", "a"}]}]}], "}"}]}], "]"}]], "Input", CellChangeTimes->{{3.55783111253207*^9, 3.557831139052502*^9}, { 3.55783118557623*^9, 3.557831207536057*^9}, {3.55783156483857*^9, 3.557831608540392*^9}, {3.557831696356534*^9, 3.557831697724494*^9}}], Cell[BoxData[ RowBox[{"Export", "[", RowBox[{ RowBox[{"ToFileName", "[", RowBox[{ RowBox[{"NotebookDirectory", "[", "]"}], ",", "\"\\""}], "]"}], ",", "%"}], "]"}]], "Input"], Cell["Convert initial conditions to c form.", "Text"], Cell[BoxData[{ RowBox[{ RowBox[{ RowBox[{ RowBox[{ RowBox[{ RowBox[{"inits1", "/.", RowBox[{"{", RowBox[{ RowBox[{ SubscriptBox["\[Delta]", "s_"], "\[Rule]", RowBox[{ SubscriptBox["\[Delta]", "s"], "+", RowBox[{ SubscriptBox["k", "s"], "v"}]}]}], ",", RowBox[{"\[Delta]\[Omega]", "\[Rule]", RowBox[{"\[Delta]\[Omega]", "+", RowBox[{"\[Delta]k", " ", "v"}]}]}]}], "}"}]}], "/.", RowBox[{"{", RowBox[{ RowBox[{"NaturalWidth", "\[Rule]", "g"}], ",", RowBox[{"HyperfineA", "\[Rule]", "ha"}], ",", RowBox[{"HyperfineB", "\[Rule]", "hb"}], ",", RowBox[{ RowBox[{ SuperscriptBox[ SubscriptBox["\[Rho]", RowBox[{"s1_", ",", "s2_"}]], "\[Prime]", MultilineFunction->None], "[", "t_", "]"}], "\[RuleDelayed]", RowBox[{"dr", "[", RowBox[{"s1", ",", "s2"}], "]"}]}], ",", RowBox[{ RowBox[{ SubscriptBox["\[Rho]", RowBox[{"s1_", ",", "s2_"}]], "[", "t_", "]"}], "\[RuleDelayed]", RowBox[{"r", "[", RowBox[{"s1", ",", "s2"}], "]"}]}], ",", RowBox[{"\[Gamma]t", "\[Rule]", "gt"}], ",", RowBox[{ SubscriptBox["\[Delta]", "i_"], "\[Rule]", RowBox[{"d", "[", "i", "]"}]}], ",", RowBox[{ SubscriptBox["k", "i_"], "\[Rule]", RowBox[{"k", "[", "i", "]"}]}], ",", RowBox[{ SuperscriptBox["\[ExponentialE]", RowBox[{"a_.", "+", RowBox[{"\[ImaginaryI]", " ", SubscriptBox["\[Phi]", "i_"]}]}]], "\[Rule]", RowBox[{ SuperscriptBox["\[ExponentialE]", "a"], RowBox[{ RowBox[{"W", "[", "i", "]"}], "/", SubscriptBox["\[CapitalOmega]", "i"]}]}]}], ",", RowBox[{ SuperscriptBox["\[ExponentialE]", RowBox[{"a_.", "-", RowBox[{"\[ImaginaryI]", " ", SubscriptBox["\[Phi]", "i_"]}]}]], "\[Rule]", RowBox[{ SuperscriptBox["\[ExponentialE]", "a"], RowBox[{ RowBox[{"Wc", "[", "i", "]"}], "/", SubscriptBox["\[CapitalOmega]", "i"]}]}]}]}], "}"}]}], "/.", "labelrep"}], "/.", RowBox[{ RowBox[{"Power", "[", RowBox[{"E", ",", "b_"}], "]"}], "\[Rule]", RowBox[{"exp", "[", "b", "]"}]}]}], "/.", RowBox[{ RowBox[{"Complex", "[", RowBox[{"0", ",", "a_"}], "]"}], "\[Rule]", RowBox[{"a", " ", "i"}]}]}], "/.", RowBox[{"{", RowBox[{ RowBox[{ RowBox[{"1", "/", SqrtBox["6"]}], "\[Rule]", RowBox[{"1", "/", "rt6"}]}], ",", RowBox[{ RowBox[{"1", "/", SqrtBox["3"]}], "\[Rule]", RowBox[{"1", "/", "rt3"}]}], ",", RowBox[{ RowBox[{"1", "/", SqrtBox["2"]}], "\[Rule]", RowBox[{"1", "/", "rt2"}]}]}], "}"}]}], "\[IndentingNewLine]", RowBox[{"StringReplace", "[", "\[IndentingNewLine]", RowBox[{ RowBox[{ "\"\<\"", "<>", RowBox[{"StringJoin", "[", RowBox[{ RowBox[{ RowBox[{ RowBox[{"ToString", "@", RowBox[{"CForm", "[", "#", "]"}]}], "<>", "\"\<;\\n\>\""}], "&"}], "/@", "%"}], "]"}], "<>", "\[IndentingNewLine]", "\"\\n\ \>\""}], ",", RowBox[{"{", RowBox[{ RowBox[{"\"\<==\>\"", "\[Rule]", "\"\<=\>\""}], ",", RowBox[{ RowBox[{"Shortest", "[", RowBox[{ "\"\\"", "~~", "a__", "~~", "\"\<\\\",\\\"\>\"", "~~", "b__", "~~", "\"\<\\\")\>\""}], "]"}], ":>", RowBox[{"\"\\"", "<>", "a", "<>", "b", "<>", "\"\<_dt\>\""}]}], ",", RowBox[{ RowBox[{"Shortest", "[", RowBox[{ "\"\\"", "~~", "a__", "~~", "\"\<\\\",\\\"\>\"", "~~", "b__", "~~", "\"\<\\\")\>\""}], "]"}], ":>", RowBox[{"\"\\"", "<>", "a", "<>", "b"}]}], ",", RowBox[{ RowBox[{"\"\\"", "~~", "a_", "~~", "\"\<)\>\""}], "\[RuleDelayed]", RowBox[{"\"\\"", "<>", "a"}]}], ",", RowBox[{ RowBox[{"\"\\"", "~~", "a_", "~~", "\"\<)\>\""}], "\[RuleDelayed]", RowBox[{"\"\\"", "<>", "a"}]}], ",", RowBox[{ RowBox[{"\"\\"", "~~", "a_", "~~", "\"\<)\>\""}], "\[RuleDelayed]", RowBox[{"\"\\"", "<>", "a"}]}], ",", RowBox[{ RowBox[{"\"\\"", "~~", "a_", "~~", "\"\<)\>\""}], "\[RuleDelayed]", RowBox[{"\"\\"", "<>", "a"}]}], ",", RowBox[{ RowBox[{"\"\\"", "~~", "a_", "~~", "\"\<)\>\""}], "\[RuleDelayed]", RowBox[{"\"\\"", "<>", "a"}]}], ",", RowBox[{ RowBox[{"\"\\"", "~~", "a_", "~~", "\"\<)\>\""}], "\[RuleDelayed]", RowBox[{"\"\\"", "<>", "a"}]}], ",", RowBox[{ RowBox[{"\"\\"", "~~", "a_", "~~", "\"\<)\>\""}], "\[RuleDelayed]", RowBox[{"\"\\"", "<>", "a"}]}]}], "}"}]}], "]"}]}], "Input", CellChangeTimes->{{3.56313119628875*^9, 3.563131201119614*^9}, { 3.563192359426774*^9, 3.563192389243625*^9}}], Cell[BoxData[ RowBox[{"Export", "[", RowBox[{ RowBox[{"ToFileName", "[", RowBox[{ RowBox[{"NotebookDirectory", "[", "]"}], ",", "\"\\""}], "]"}], ",", "%", ",", " ", "\"\\""}], "]"}]], "Input", CellChangeTimes->{{3.563131203982983*^9, 3.563131205084772*^9}, { 3.563131547287279*^9, 3.563131550711413*^9}, {3.563192406122287*^9, 3.56319240727765*^9}}] }, Open ]], Cell[CellGroupData[{ Cell["Find propagation equations", "Section"], Cell["Here we find the propagation equations.", "Text"], Cell["\<\ First, for each field 1--4, extract the list of sublevels that the field is \ assumed to interact with.\ \>", "Text"], Cell[BoxData[ RowBox[{"transitioncriteria", "=", RowBox[{"{", RowBox[{ RowBox[{ RowBox[{ RowBox[{"Label", "\[Equal]", "0"}], "&&", RowBox[{"F", "\[Equal]", "2"}]}], "||", RowBox[{ RowBox[{"Label", "\[Equal]", "1"}], "&&", RowBox[{"F", "\[Equal]", "1"}]}]}], ",", RowBox[{ RowBox[{ RowBox[{"Label", "\[Equal]", "0"}], "&&", RowBox[{"F", "\[Equal]", "1"}]}], "||", RowBox[{ 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.\ \>", "Text"], Cell[BoxData[ RowBox[{ RowBox[{"rmes", "=", RowBox[{"{", RowBox[{ RowBox[{"ReducedME", "[", RowBox[{"0", ",", RowBox[{"{", RowBox[{"Dipole", ",", "1"}], "}"}], ",", "1"}], "]"}], ",", " ", RowBox[{"ReducedME", "[", RowBox[{"0", ",", RowBox[{"{", RowBox[{"Dipole", ",", "1"}], "}"}], ",", "1"}], "]"}], ",", " ", RowBox[{"ReducedME", "[", RowBox[{"0", ",", RowBox[{"{", RowBox[{"Dipole", ",", "1"}], "}"}], ",", "2"}], "]"}], ",", " ", RowBox[{"ReducedME", "[", RowBox[{"0", ",", RowBox[{"{", RowBox[{"Dipole", ",", "1"}], "}"}], ",", "2"}], "]"}]}], "}"}]}], ";"}]], "Input"], 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]]] }], "Text"], 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[{ SubscriptBox["\[Rho]", RowBox[{"n", ",", "m"}]], SubscriptBox[ StyleBox["d", FontWeight->"Bold", FontSlant->"Plain"], RowBox[{"m", ",", "n"}]]}]}], 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[{"Boole", "[", RowBox[{ RowBox[{ RowBox[{ RowBox[{"BranchingRatio", "[", "m", "]"}], "[", "n", "]"}], "=!=", "0"}], "&&", RowBox[{ RowBox[{ RowBox[{"BranchingRatio", "[", "n", "]"}], "[", "m", "]"}], "===", "0"}]}], "]"}], RowBox[{"DMElement", "[", RowBox[{ RowBox[{"SublevelLabel", "@", "n"}], ",", RowBox[{"SublevelLabel", "@", "m"}], ",", "t"}], "]"}], RowBox[{"WignerEckart", "[", RowBox[{"m", ",", RowBox[{"{", RowBox[{"Dipole", ",", "1"}], "}"}], ",", "n"}], "]"}]}], ",", RowBox[{"{", RowBox[{"n", ",", "s"}], "}"}], ",", RowBox[{"{", RowBox[{"m", ",", "s"}], "}"}]}], "]"}], ",", RowBox[{"{", RowBox[{"s", ",", "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]]], " 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[{"4", "\[Pi]", " ", "\[ImaginaryI]", " ", RowBox[{"Energy", "[", RowBox[{"Last", "[", RowBox[{ "rmes", "\[LeftDoubleBracket]", "k", "\[RightDoubleBracket]"}], "]"}], "]"}], " ", "n0", " ", RowBox[{ "rmes", "\[LeftDoubleBracket]", "k", "\[RightDoubleBracket]"}], " ", RowBox[{ "polarizationcomponents1", "\[LeftDoubleBracket]", "k", "\[RightDoubleBracket]"}]}], "/.", "delreps1"}]}], "]"}], "]"}], ",", 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]]], "." }], "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"}], ")"}]}]}]}]}], "//", "Expand"}]}]], "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]", RowBox[{"_", ",", "_"}]], "\[Rule]", "0"}], ",", RowBox[{ RowBox[{ SubscriptBox["\[CapitalOmega]", RowBox[{"s_", ",", "_"}]], "/;", RowBox[{"i", "\[NotEqual]", "s"}]}], "\[Rule]", "0"}]}], "}"}]}], ",", RowBox[{"{", RowBox[{"i", ",", "4"}], "}"}]}], "]"}]}]], "Input"], Cell["\<\ Convert to covariant spherical components and multiply by ||d||.\ \>", "Text"], Cell[BoxData[ RowBox[{"fieldcomponents2", "=", RowBox[{ RowBox[{ RowBox[{ RowBox[{"ToCovariant", "/@", "fieldcomponents1"}], " ", "rmes"}], "/.", RowBox[{ SubscriptBox["\[CapitalOmega]", RowBox[{"s_", ",", "q_"}]], "->", RowBox[{ SubscriptBox["\[CapitalOmega]", RowBox[{"s", ",", "q"}]], "[", "z", "]"}]}]}], "//", "Simplify"}]}]], "Input"], Cell["\<\ Find propagation equations using the spherical components of the polarization \ and fields. Here we leave out the time-derivative term, which we will add in \ below.\ \>", "Text"], Cell[BoxData[ RowBox[{"fieldvars", "=", RowBox[{"Flatten", "@", RowBox[{"Table", "[", RowBox[{ RowBox[{ SubscriptBox["\[CapitalOmega]", RowBox[{"i", ",", "q"}]], "[", "z", "]"}], ",", RowBox[{"{", RowBox[{"i", ",", "4"}], "}"}], ",", RowBox[{"{", RowBox[{"q", ",", RowBox[{"{", RowBox[{"p", ",", "m"}], "}"}]}], "}"}]}], "]"}]}]}]], "Input"], Cell[BoxData[{ RowBox[{ RowBox[{ RowBox[{"Solve", "[", RowBox[{ RowBox[{ RowBox[{ RowBox[{"D", "[", RowBox[{"fieldcomponents2", ",", "z"}], "]"}], "[", RowBox[{"[", RowBox[{"All", ",", "All", ",", RowBox[{"{", RowBox[{"1", ",", "3"}], "}"}]}], "]"}], "]"}], "==", RowBox[{"Simplify", "@", RowBox[{"polarizationcomponents3", "[", RowBox[{"[", RowBox[{"All", ",", "All", ",", RowBox[{"{", RowBox[{"1", ",", "3"}], "}"}]}], "]"}], "]"}]}]}], ",", RowBox[{"D", "[", RowBox[{"fieldvars", ",", "z"}], "]"}]}], "]"}], "[", RowBox[{"[", "1", "]"}], "]"}], "/.", RowBox[{"Rule", "\[Rule]", "Equal"}]}], "\[IndentingNewLine]", RowBox[{"propeqs", "=", RowBox[{ RowBox[{ RowBox[{"Expand", "[", "%", "]"}], "/.", RowBox[{"{", RowBox[{ RowBox[{ RowBox[{"1", "/", SqrtBox["6"]}], "\[Rule]", RowBox[{"1", "/", "rt6"}]}], ",", RowBox[{ RowBox[{"1", "/", SqrtBox["3"]}], "\[Rule]", RowBox[{"1", "/", "rt3"}]}], ",", RowBox[{ RowBox[{"1", "/", SqrtBox["2"]}], "\[Rule]", RowBox[{"1", "/", "rt2"}]}]}], "}"}]}], "/.", RowBox[{"{", RowBox[{ RowBox[{ SqrtBox["2"], "\[Rule]", "rt2"}], ",", RowBox[{ SqrtBox[ FractionBox["2", "3"]], "\[Rule]", RowBox[{"rt2", "/", "rt3"}]}]}], "}"}]}]}]}], "Input", CellChangeTimes->{3.562066098773316*^9}], Cell["Convert propagation equations to C form.", "Text"], Cell[BoxData[{ RowBox[{ RowBox[{ RowBox[{ RowBox[{ RowBox[{"propeqs", "/.", RowBox[{"{", RowBox[{ RowBox[{ RowBox[{"\[Eta]", "[", "s_", "]"}], "\[Rule]", RowBox[{"Ndens", " ", RowBox[{"eta", "[", "s", "]"}]}]}], ",", RowBox[{"NaturalWidth", "\[Rule]", "g"}], ",", RowBox[{ RowBox[{ SubscriptBox["\[Rho]", RowBox[{"s1_", ",", "s2_"}]], "[", "t", "]"}], "\[RuleDelayed]", RowBox[{"r", "[", RowBox[{"s1", ",", "s2"}], "]"}]}], ",", RowBox[{ RowBox[{ RowBox[{ SubscriptBox["\[CapitalOmega]", RowBox[{"j_", ",", "p"}]], "'"}], "[", "z", "]"}], "\[Rule]", RowBox[{"dEp", "[", "j", "]"}]}], ",", RowBox[{ RowBox[{ RowBox[{ SubscriptBox["\[CapitalOmega]", RowBox[{"j_", ",", "m"}]], "'"}], "[", "z", "]"}], "\[Rule]", RowBox[{"dEm", "[", "j", "]"}]}], ",", RowBox[{ RowBox[{ SubscriptBox["\[CapitalOmega]", RowBox[{"j_", ",", "p"}]], "[", "z", "]"}], "\[Rule]", RowBox[{"Ep", "[", "j", "]"}]}], ",", RowBox[{ RowBox[{ SubscriptBox["\[CapitalOmega]", RowBox[{"j_", ",", "m"}]], "[", "z", "]"}], "\[Rule]", RowBox[{"Em", "[", "j", "]"}]}]}], "}"}]}], "/.", "labelrep"}], "/.", RowBox[{ RowBox[{"Complex", "[", RowBox[{"0", ",", "a_"}], "]"}], "\[Rule]", RowBox[{"a", " ", "i"}]}]}], "/.", RowBox[{"Conjugate", "\[Rule]", "conj"}]}], "/.", RowBox[{ RowBox[{"a", ":", RowBox[{"Power", "[", RowBox[{ RowBox[{"_", "?", "NumericQ"}], ",", "_"}], "]"}]}], "\[RuleDelayed]", RowBox[{"N", "[", "a", "]"}]}]}], "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{"MapAt", "[", RowBox[{"Simplify", ",", "#", ",", RowBox[{"{", "2", "}"}]}], "]"}], "&"}], "/@", "%"}], "\[IndentingNewLine]", RowBox[{"StringJoin", "[", RowBox[{"MapThread", "[", RowBox[{ RowBox[{ RowBox[{ RowBox[{"ToString", "@", RowBox[{"CForm", "[", "#1", "]"}]}], "<>", "\"\< - Lt[\>\"", "<>", RowBox[{"ToString", "@", RowBox[{"CForm", "[", "#2", "]"}]}], "<>", "\"\<];\\n\>\""}], "&"}], ",", RowBox[{"{", RowBox[{"%", ",", RowBox[{"fieldvars", "/.", RowBox[{"{", RowBox[{ RowBox[{ RowBox[{ SubscriptBox["\[CapitalOmega]", RowBox[{"j_", ",", "p"}]], "[", "z", "]"}], "\[Rule]", RowBox[{"Ep", "[", "j", "]"}]}], ",", RowBox[{ RowBox[{ SubscriptBox["\[CapitalOmega]", RowBox[{"j_", ",", "m"}]], "[", "z", "]"}], "\[Rule]", RowBox[{"Em", "[", "j", "]"}]}]}], "}"}]}]}], "}"}]}], "]"}], "]"}], "\[IndentingNewLine]", RowBox[{"\"\<\"", "<>", RowBox[{"StringReplace", "[", RowBox[{"%", ",", RowBox[{"{", RowBox[{ RowBox[{"\"\<==\>\"", "\[Rule]", "\"\<=\>\""}], ",", RowBox[{ RowBox[{"\"\\"", "~~", "a_", "~~", "\"\<)\>\""}], "\[RuleDelayed]", RowBox[{"\"\\"", "<>", "a"}]}], ",", RowBox[{ RowBox[{"Shortest", "[", RowBox[{ "\"\\"", "~~", "a__", "~~", "\"\<\\\",\\\"\>\"", "~~", "b__", "~~", "\"\<\\\")\>\""}], "]"}], ":>", RowBox[{"\"\\"", "<>", "a", "<>", "b", "<>", "\"\<_dt\>\""}]}], ",", RowBox[{ RowBox[{"Shortest", "[", RowBox[{ "\"\\"", "~~", "a__", "~~", "\"\<\\\",\\\"\>\"", "~~", "b__", "~~", "\"\<\\\")\>\""}], "]"}], ":>", RowBox[{"\"\\"", "<>", "a", "<>", "b"}]}], ",", RowBox[{ RowBox[{"\"\\"", "~~", "a_", "~~", "\"\<)\>\""}], "\[RuleDelayed]", RowBox[{"\"\\"", "<>", "a"}]}], ",", RowBox[{ RowBox[{"\"\\"", "~~", "a_", "~~", "\"\<)\>\""}], "\[RuleDelayed]", RowBox[{"\"\\"", "<>", "a"}]}], ",", RowBox[{ RowBox[{"\"\\"", "~~", "a_", "~~", "\"\<)\>\""}], "\[RuleDelayed]", RowBox[{"\"\\"", "<>", "a"}]}], ",", RowBox[{ RowBox[{"\"\\"", "~~", "a_", "~~", "\"\<)\>\""}], "\[RuleDelayed]", RowBox[{"\"\\"", "<>", "a", "<>", "\"\<_dz\>\""}]}], ",", RowBox[{ RowBox[{"\"\\"", "~~", "a_", "~~", "\"\<)\>\""}], "\[RuleDelayed]", RowBox[{"\"\\"", "<>", "a", "<>", "\"\<_dz\>\""}]}], ",", RowBox[{ RowBox[{"\"\\"", "~~", "a_", "~~", "\"\<)\>\""}], "\[RuleDelayed]", RowBox[{"\"\\"", "<>", "a"}]}], ",", RowBox[{ RowBox[{"\"\\"", "~~", "a_", "~~", "\"\<)\>\""}], "\[RuleDelayed]", RowBox[{"\"\\"", "<>", "a"}]}], ",", RowBox[{ RowBox[{"\"\\"", "~~", "a_", "~~", "\"\<)\>\""}], "\[RuleDelayed]", RowBox[{"\"\\"", "<>", "a"}]}]}], "}"}]}], "]"}], "<>", "\[IndentingNewLine]", "\"\\n\>\""}], "\[IndentingNewLine]", RowBox[{"Export", "[", RowBox[{ RowBox[{"ToFileName", "[", RowBox[{ RowBox[{"NotebookDirectory", "[", "]"}], ",", "\"\\""}], "]"}], ",", "%", ",", " ", "\"\\""}], "]"}]}], "Input", CellChangeTimes->{{3.562016303354669*^9, 3.562016328411399*^9}, { 3.563192454091908*^9, 3.563192495728373*^9}, {3.563192582676104*^9, 3.56319258550938*^9}}] }, Open ]] }, WindowSize->{998, 902}, WindowMargins->{{-2, Automatic}, {Automatic, 0}}, PrivateNotebookOptions->{"FileOutlineCache"->False}, ShowSelection->True, FrontEndVersion->"8.0 for Microsoft Windows (64-bit) (October 6, 2011)", StyleDefinitions->"Default.nb" ]