(* Content-type: application/vnd.wolfram.mathematica *) (*** Wolfram Notebook File ***) (* http://www.wolfram.com/nb *) (* CreatedBy='Mathematica 11.1' *) (*CacheID: 234*) (* Internal cache information: NotebookFileLineBreakTest NotebookFileLineBreakTest NotebookDataPosition[ 158, 7] NotebookDataLength[ 70452, 1501] NotebookOptionsPosition[ 70003, 1483] NotebookOutlinePosition[ 70347, 1498] CellTagsIndexPosition[ 70304, 1495] WindowFrame->Normal*) (* Beginning of Notebook Content *) Notebook[{ Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"DynamicModule", "[", RowBox[{ RowBox[{"{", RowBox[{ "npc1", ",", "npc2", ",", "npc1p1", ",", "npc2p1", ",", "npc1p2", ",", "npc2p2", ",", "npc1neck", ",", "npc2neck", ",", "neck", ",", "graph"}], "}"}], ",", "\[IndentingNewLine]", RowBox[{ RowBox[{"npctype", " ", "=", "1"}], ";", "\[IndentingNewLine]", RowBox[{"Manipulate", "[", "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{"Which", "[", RowBox[{ RowBox[{"npctype", "==", "1"}], ",", " ", "\[IndentingNewLine]", RowBox[{ RowBox[{"\[Alpha]", "=", RowBox[{"3.3058", "/", SuperscriptBox["10", "10"]}]}], ";", " ", RowBox[{"\[Gamma]", "=", "1.645"}], ";", " ", RowBox[{"m\[Alpha]", "=", RowBox[{"3.0047", "/", SuperscriptBox["10", "25"]}]}], ";", " ", RowBox[{"\[Rho]", "=", "16654"}], ";", " ", RowBox[{"kB", "=", RowBox[{"1.38064852", "/", SuperscriptBox["10", "23"]}]}], ";", " ", RowBox[{"Tm", "=", "3290"}], ";", " ", RowBox[{"rmin", " ", "=", RowBox[{"1", " ", SuperscriptBox["10", RowBox[{"-", "9"}]]}]}], ";", " ", RowBox[{"rmax", " ", "=", " ", RowBox[{"9", " ", SuperscriptBox["10", RowBox[{"-", "9"}]]}]}], ";", " ", RowBox[{"Tmin", " ", "=", "100"}], ";", " ", RowBox[{"Tmax", " ", "=", "3285"}]}], ",", "\[IndentingNewLine]", " ", RowBox[{"npctype", " ", "\[Equal]", "2"}], ",", "\n", " ", RowBox[{ RowBox[{"\[Alpha]", "=", RowBox[{"2.72", "/", SuperscriptBox["10", "10"]}]}], ";", " ", RowBox[{"\[Gamma]", "=", "1.6"}], ";", " ", RowBox[{"m\[Alpha]", "=", RowBox[{"3.2706", "/", SuperscriptBox["10", "25"]}]}], ";", " ", RowBox[{"\[Rho]", "=", "19300"}], ";", " ", RowBox[{"kB", "=", RowBox[{"1.38064852", "/", SuperscriptBox["10", "23"]}]}], ";", " ", RowBox[{"Tm", "=", "1337"}], ";", " ", RowBox[{"rmin", " ", "=", RowBox[{"1", " ", SuperscriptBox["10", RowBox[{"-", "9"}]]}]}], ";", " ", RowBox[{"rmax", " ", "=", " ", RowBox[{"9", " ", SuperscriptBox["10", RowBox[{"-", "9"}]]}]}], ";", " ", RowBox[{"Tmin", " ", "=", "100"}], ";", " ", RowBox[{"Tmax", " ", "=", "3285"}]}], ",", "\[IndentingNewLine]", " ", RowBox[{"npctype", " ", "\[Equal]", "3"}], ",", "\n", " ", RowBox[{ RowBox[{"\[Alpha]", "=", RowBox[{"2.64", "/", SuperscriptBox["10", "10"]}]}], ";", " ", RowBox[{"\[Gamma]", "=", "1.6"}], ";", " ", RowBox[{"m\[Alpha]", "=", RowBox[{"1.055", "/", SuperscriptBox["10", "25"]}]}], ";", " ", RowBox[{"\[Rho]", "=", "8960"}], ";", " ", RowBox[{"kB", "=", RowBox[{"1.38064852", "/", SuperscriptBox["10", "23"]}]}], ";", " ", RowBox[{"Tm", "=", "1357"}], ";", " ", RowBox[{"rmin", " ", "=", RowBox[{"1", " ", SuperscriptBox["10", RowBox[{"-", "9"}]]}]}], ";", " ", RowBox[{"rmax", " ", "=", " ", RowBox[{"9", " ", SuperscriptBox["10", RowBox[{"-", "9"}]]}]}], ";", " ", RowBox[{"Tmin", " ", "=", "100"}], ";", " ", RowBox[{"Tmax", " ", "=", "3285"}]}], ",", "\[IndentingNewLine]", " ", RowBox[{"npctype", " ", "\[Equal]", "4"}], ",", "\n", " ", RowBox[{ RowBox[{"\[Alpha]", "=", RowBox[{"2.90", "/", SuperscriptBox["10", "10"]}]}], ";", " ", RowBox[{"\[Gamma]", "=", "1.2"}], ";", " ", RowBox[{"m\[Alpha]", "=", RowBox[{"1.791", "/", SuperscriptBox["10", "25"]}]}], ";", " ", RowBox[{"\[Rho]", "=", "10490"}], ";", " ", RowBox[{"kB", "=", RowBox[{"1.38064852", "/", SuperscriptBox["10", "23"]}]}], ";", " ", RowBox[{"Tm", "=", "1234"}], ";", " ", RowBox[{"rmin", " ", "=", RowBox[{"1", " ", SuperscriptBox["10", RowBox[{"-", "9"}]]}]}], ";", " ", RowBox[{"rmax", " ", "=", " ", RowBox[{"9", " ", SuperscriptBox["10", RowBox[{"-", "9"}]]}]}], ";", " ", RowBox[{"Tmin", " ", "=", "100"}], ";", " ", RowBox[{"Tmax", " ", "=", "3285"}]}]}], "]"}], ";", "\[IndentingNewLine]", " ", "\[IndentingNewLine]", "\[IndentingNewLine]", "\[IndentingNewLine]", "\[IndentingNewLine]", RowBox[{"Vrel", ":=", RowBox[{ FractionBox[ RowBox[{"2", " ", "m\[Alpha]", " ", FractionBox["1", "2"], "\[Gamma]", " ", "\[Pi]", " ", "r", " ", "\[Alpha]", " "}], RowBox[{"3", " ", RowBox[{"(", RowBox[{"\[Rho]", " ", "kB"}], ")"}], " ", RowBox[{"(", RowBox[{"Tm", "-", "T"}], ")"}]}]], FractionBox["1", SuperscriptBox["r", "3"]]}]}], ";", "\[IndentingNewLine]", RowBox[{"If", "[", " ", RowBox[{ RowBox[{"Vrel", "<", " ", RowBox[{ FractionBox["4", "3"], " ", "Pi"}]}], " ", ",", " ", RowBox[{"(*", "Then", "*)"}], " ", "\[IndentingNewLine]", " ", RowBox[{"If", "[", RowBox[{ RowBox[{"Vrel", " ", "<", " ", RowBox[{ FractionBox["2", "3"], "Pi"}]}], " ", ",", " ", RowBox[{"(*", "Then", "*)"}], " ", "\[IndentingNewLine]", " ", RowBox[{ RowBox[{"arel", " ", "=", RowBox[{"Chop", "[", RowBox[{"x", "/.", "\[VeryThinSpace]", RowBox[{"FindRoot", "[", RowBox[{ RowBox[{ RowBox[{ FractionBox["1", "6"], " ", RowBox[{"(", RowBox[{"\[Pi]", " ", RowBox[{"(", RowBox[{"1", "-", RowBox[{"\[Sqrt]", RowBox[{"(", RowBox[{"1", "-", SuperscriptBox["x", "2"]}], ")"}]}]}], ")"}]}], ")"}], " ", RowBox[{"(", RowBox[{ RowBox[{"3", " ", SuperscriptBox["x", "2"]}], "+", SuperscriptBox[ RowBox[{"(", RowBox[{"1", "-", RowBox[{"\[Sqrt]", RowBox[{"(", RowBox[{"1", "-", SuperscriptBox["x", "2"]}], ")"}]}]}], ")"}], "2"]}], ")"}]}], "-", "Vrel"}], ",", RowBox[{"{", RowBox[{"x", ",", "0.01"}], "}"}]}], "]"}]}], "]"}]}], ";", "\[IndentingNewLine]", " ", RowBox[{"hrel", "=", " ", RowBox[{"(", RowBox[{"1", "-", RowBox[{"\[Sqrt]", RowBox[{"(", RowBox[{"1", "-", SuperscriptBox["arel", "2"]}], ")"}]}]}], ")"}]}], ";", "\[IndentingNewLine]", " ", RowBox[{"alpha", " ", "=", " ", RowBox[{"ArcSin", "[", "arel", "]"}]}], ";", "\[IndentingNewLine]", " ", RowBox[{"model", " ", "=", " ", "True"}], ";", "\[IndentingNewLine]", " ", RowBox[{"valec", " ", "=", " ", "True"}], ";"}], "\[IndentingNewLine]", " ", ",", " ", RowBox[{"(*", "Else", "*)"}], " ", "\[IndentingNewLine]", " ", RowBox[{ RowBox[{"arel", " ", "=", RowBox[{"Chop", "[", RowBox[{"x", "/.", "\[VeryThinSpace]", RowBox[{"FindRoot", "[", RowBox[{ RowBox[{ RowBox[{ FractionBox["1", "6"], " ", RowBox[{"(", RowBox[{"\[Pi]", " ", RowBox[{"(", RowBox[{"1", "-", RowBox[{"\[Sqrt]", RowBox[{"(", RowBox[{"1", "-", SuperscriptBox["x", "2"]}], ")"}]}]}], ")"}]}], ")"}], " ", RowBox[{"(", RowBox[{ RowBox[{"3", " ", SuperscriptBox["x", "2"]}], "+", SuperscriptBox[ RowBox[{"(", RowBox[{"1", "-", RowBox[{"\[Sqrt]", RowBox[{"(", RowBox[{"1", "-", SuperscriptBox["x", "2"]}], ")"}]}]}], ")"}], "2"]}], ")"}]}], "-", RowBox[{"(", RowBox[{ RowBox[{ FractionBox["4", "3"], "Pi"}], " ", "-", "Vrel"}], ")"}]}], ",", RowBox[{"{", RowBox[{"x", ",", "0.01"}], "}"}]}], "]"}]}], "]"}]}], ";", "\[IndentingNewLine]", " ", RowBox[{"hrel", "=", " ", RowBox[{"2", "-", RowBox[{"(", RowBox[{"1", "-", RowBox[{"\[Sqrt]", RowBox[{"(", RowBox[{"1", "-", SuperscriptBox["arel", "2"]}], ")"}]}]}], ")"}]}]}], ";", "\[IndentingNewLine]", " ", RowBox[{"alpha", " ", "=", " ", RowBox[{"Pi", "-", RowBox[{"ArcSin", "[", "arel", "]"}]}]}], ";", "\[IndentingNewLine]", " ", RowBox[{"model", " ", "=", " ", "True"}], ";", "\[IndentingNewLine]", " ", RowBox[{"valec", " ", "=", " ", "False"}], ";"}]}], "]"}], "\[IndentingNewLine]", " ", ",", RowBox[{"(*", "Else", "*)"}], " ", "\[IndentingNewLine]", " ", RowBox[{ RowBox[{"model", " ", "=", " ", "False"}], ";", "\[IndentingNewLine]", " ", RowBox[{"valec", " ", "=", " ", "False"}]}]}], "]"}], ";", "\[IndentingNewLine]", "\[IndentingNewLine]", RowBox[{"\[Phi]rel", " ", "=", RowBox[{"1", "-", "hrel"}]}], ";", "\[IndentingNewLine]", RowBox[{"If", "[", RowBox[{"valec", ",", " ", RowBox[{"Hvrel", " ", "=", RowBox[{ RowBox[{"(", RowBox[{ RowBox[{ SuperscriptBox["hrel", "3"], "/", RowBox[{"(", RowBox[{"3", " ", SuperscriptBox["arel", "2"]}], ")"}]}], "+", "hrel"}], ")"}], "/", "2"}]}], ",", "\[IndentingNewLine]", " ", RowBox[{"Hvrel", " ", "=", RowBox[{ FractionBox["4", "3"], "/", "2"}]}]}], "]"}], ";", "\[IndentingNewLine]", RowBox[{"M", "=", RowBox[{ RowBox[{"{", RowBox[{"c1", ",", "c3", ",", "H0"}], "}"}], "/.", RowBox[{"NSolve", "[", RowBox[{ RowBox[{"{", " ", RowBox[{ RowBox[{ RowBox[{"2", "c1", " ", RowBox[{"(", RowBox[{"\[Phi]rel", " ", "-", " ", "H0"}], ")"}]}], " ", "\[Equal]", RowBox[{"-", " ", FractionBox["\[Phi]rel", RowBox[{"Sqrt", "[", RowBox[{ SuperscriptBox["1", "2"], "-", SuperscriptBox["\[Phi]rel", "2"]}], "]"}]]}]}], ",", "\[IndentingNewLine]", " ", RowBox[{ RowBox[{ RowBox[{"c1", " ", SuperscriptBox[ RowBox[{"(", RowBox[{"\[Phi]rel", "-", "H0"}], ")"}], "2"]}], " ", "+", "c3"}], "\[Equal]", "arel"}], " ", ",", "\[IndentingNewLine]", "\[IndentingNewLine]", " ", RowBox[{ RowBox[{"Pi", RowBox[{"(", RowBox[{ RowBox[{ SuperscriptBox["c1", "2"], RowBox[{"(", RowBox[{ FractionBox[ RowBox[{ SuperscriptBox["H0", "5"], "-", SuperscriptBox["\[Phi]rel", "5"]}], "5"], "-", RowBox[{"4", " ", "H0", FractionBox[ RowBox[{ SuperscriptBox["H0", "4"], "-", SuperscriptBox["\[Phi]rel", "4"]}], "4"]}], "+", RowBox[{"6", SuperscriptBox["H0", "2"], FractionBox[ RowBox[{ SuperscriptBox["H0", "3"], "-", SuperscriptBox["\[Phi]rel", "3"]}], "3"]}], "-", RowBox[{"4", SuperscriptBox["H0", "3"], FractionBox[ RowBox[{ SuperscriptBox["H0", "2"], "-", SuperscriptBox["\[Phi]rel", "2"]}], "2"]}], "+", RowBox[{ SuperscriptBox["H0", "4"], RowBox[{"(", RowBox[{"H0", "-", "\[Phi]rel"}], ")"}]}]}], ")"}]}], "+", RowBox[{"c1", " ", "c3", RowBox[{"(", RowBox[{ FractionBox[ RowBox[{ SuperscriptBox["H0", "3"], "-", SuperscriptBox["\[Phi]rel", "3"]}], "3"], "-", RowBox[{"2", "H0", FractionBox[ RowBox[{ SuperscriptBox["H0", "2"], "-", SuperscriptBox["\[Phi]rel", "2"]}], "2"]}], "+", RowBox[{ SuperscriptBox["H0", "2"], RowBox[{"(", RowBox[{"H0", "-", "\[Phi]rel"}], ")"}]}]}], ")"}]}], "+", RowBox[{ SuperscriptBox["c3", "2"], RowBox[{"(", RowBox[{"H0", "-", "\[Phi]rel"}], ")"}]}]}], ")"}]}], "\[Equal]", "Vrel"}]}], "}"}], " ", ",", " ", RowBox[{"{", RowBox[{"c1", ",", "c3", ",", "H0"}], "}"}], ",", "Reals"}], "]"}]}]}], ";", "\[IndentingNewLine]", "\[IndentingNewLine]", "\[IndentingNewLine]", "\[IndentingNewLine]", RowBox[{"cp1", " ", "=", RowBox[{"Extract", "[", RowBox[{ RowBox[{"Flatten", "[", RowBox[{"Take", "[", RowBox[{"M", ",", RowBox[{"{", "1", "}"}]}], "]"}], "]"}], ",", RowBox[{"{", "1", "}"}]}], "]"}]}], ";", "\[IndentingNewLine]", RowBox[{"cp2", " ", "=", RowBox[{"Extract", "[", RowBox[{ RowBox[{"Flatten", "[", RowBox[{"Take", "[", RowBox[{"M", ",", RowBox[{"{", "1", "}"}]}], "]"}], "]"}], ",", RowBox[{"{", "2", "}"}]}], "]"}]}], ";", "\[IndentingNewLine]", RowBox[{"Hprel", " ", "=", RowBox[{"Extract", "[", RowBox[{ RowBox[{"Flatten", "[", RowBox[{"Take", "[", RowBox[{"M", ",", RowBox[{"{", "1", "}"}]}], "]"}], "]"}], ",", RowBox[{"{", "3", "}"}]}], "]"}]}], ";", "\[IndentingNewLine]", "\[IndentingNewLine]", "\[IndentingNewLine]", "\[IndentingNewLine]", RowBox[{"castice1", " ", "=", " ", RowBox[{"ParametricPlot3D", "[", RowBox[{ RowBox[{"{", "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{"r", " ", RowBox[{"Sin", "[", "u", "]"}]}], "-", "r"}], " ", ",", "\[IndentingNewLine]", RowBox[{"r", " ", RowBox[{"Cos", "[", "t", "]"}], " ", RowBox[{"Cos", "[", "u", "]"}]}], ",", " ", "\[IndentingNewLine]", RowBox[{"r", " ", RowBox[{"Sin", "[", "t", "]"}], " ", RowBox[{"Cos", "[", "u", "]"}]}]}], "}"}], ",", " ", "\[IndentingNewLine]", " ", RowBox[{"{", RowBox[{"t", ",", "0", ",", " ", RowBox[{"2", "Pi"}]}], "}"}], ",", RowBox[{"{", RowBox[{"u", ",", RowBox[{ RowBox[{"-", "Pi"}], "/", "2"}], ",", RowBox[{"Pi", "/", "2"}]}], "}"}]}], "]"}]}], ";", "\[IndentingNewLine]", RowBox[{"castice2", " ", "=", " ", RowBox[{"ParametricPlot3D", "[", RowBox[{ RowBox[{"{", "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{ RowBox[{"-", "r"}], " ", RowBox[{"Sin", "[", "u", "]"}]}], "+", "r"}], " ", ",", "\[IndentingNewLine]", RowBox[{ RowBox[{"-", "r"}], " ", RowBox[{"Cos", "[", "t", "]"}], " ", RowBox[{"Cos", "[", "u", "]"}]}], ",", " ", "\[IndentingNewLine]", RowBox[{ RowBox[{"-", "r"}], " ", RowBox[{"Sin", "[", "t", "]"}], " ", RowBox[{"Cos", "[", "u", "]"}]}]}], "}"}], ",", " ", "\[IndentingNewLine]", " ", RowBox[{"{", RowBox[{"t", ",", "0", ",", " ", RowBox[{"2", "Pi"}]}], "}"}], ",", RowBox[{"{", RowBox[{"u", ",", RowBox[{ RowBox[{"-", "Pi"}], "/", "2"}], ",", RowBox[{"Pi", "/", "2"}]}], "}"}]}], "]"}]}], ";", "\[IndentingNewLine]", "\[IndentingNewLine]", RowBox[{"castice1p1", " ", "=", " ", RowBox[{"ParametricPlot3D", "[", RowBox[{ RowBox[{"{", "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{"r", " ", RowBox[{"Sin", "[", "u", "]"}]}], "-", "r"}], " ", ",", "\[IndentingNewLine]", RowBox[{"r", " ", RowBox[{"Cos", "[", "t", "]"}], " ", RowBox[{"Cos", "[", "u", "]"}]}], ",", " ", "\[IndentingNewLine]", RowBox[{"r", " ", RowBox[{"Sin", "[", "t", "]"}], " ", RowBox[{"Cos", "[", "u", "]"}]}]}], "}"}], ",", " ", "\[IndentingNewLine]", " ", RowBox[{"{", RowBox[{"t", ",", "0", ",", " ", RowBox[{"2", "Pi"}]}], "}"}], ",", RowBox[{"{", RowBox[{"u", ",", RowBox[{ RowBox[{"Pi", "/", "2"}], "-", "alpha"}], ",", RowBox[{ RowBox[{"-", "Pi"}], "/", "2"}]}], "}"}]}], "]"}]}], ";", "\[IndentingNewLine]", RowBox[{"castice1p2", " ", "=", " ", RowBox[{"ParametricPlot3D", "[", RowBox[{ RowBox[{"{", "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{"r", " ", RowBox[{"Sin", "[", "u", "]"}]}], "-", "r"}], " ", ",", "\[IndentingNewLine]", RowBox[{"r", " ", RowBox[{"Cos", "[", "t", "]"}], " ", RowBox[{"Cos", "[", "u", "]"}]}], ",", " ", "\[IndentingNewLine]", RowBox[{"r", " ", RowBox[{"Sin", "[", "t", "]"}], " ", RowBox[{"Cos", "[", "u", "]"}]}]}], "}"}], ",", " ", "\[IndentingNewLine]", " ", RowBox[{"{", RowBox[{"t", ",", "0", ",", " ", RowBox[{"2", "Pi"}]}], "}"}], ",", RowBox[{"{", RowBox[{"u", ",", RowBox[{"Pi", "/", "2"}], ",", RowBox[{ RowBox[{"Pi", "/", "2"}], "-", "alpha"}]}], "}"}], ",", RowBox[{"PlotStyle", " ", "\[Rule]", "Red"}]}], "]"}]}], ";", "\[IndentingNewLine]", "\[IndentingNewLine]", RowBox[{"castice2p1", " ", "=", " ", RowBox[{"ParametricPlot3D", "[", RowBox[{ RowBox[{"{", "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{ RowBox[{"-", "r"}], " ", RowBox[{"Sin", "[", "u", "]"}]}], "+", "r"}], " ", ",", "\[IndentingNewLine]", RowBox[{ RowBox[{"-", "r"}], " ", RowBox[{"Cos", "[", "t", "]"}], " ", RowBox[{"Cos", "[", "u", "]"}]}], ",", " ", "\[IndentingNewLine]", RowBox[{ RowBox[{"-", "r"}], " ", RowBox[{"Sin", "[", "t", "]"}], " ", RowBox[{"Cos", "[", "u", "]"}]}]}], "}"}], ",", " ", "\[IndentingNewLine]", " ", RowBox[{"{", RowBox[{"t", ",", "0", ",", " ", RowBox[{"2", "Pi"}]}], "}"}], ",", RowBox[{"{", RowBox[{"u", ",", RowBox[{ RowBox[{"-", "Pi"}], "/", "2"}], ",", RowBox[{ RowBox[{"Pi", "/", "2"}], "-", "alpha"}]}], "}"}]}], "]"}]}], ";", "\[IndentingNewLine]", RowBox[{"castice2p2", " ", "=", " ", RowBox[{"ParametricPlot3D", "[", RowBox[{ RowBox[{"{", "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{ RowBox[{"-", "r"}], " ", RowBox[{"Sin", "[", "u", "]"}]}], "+", "r"}], " ", ",", "\[IndentingNewLine]", RowBox[{ RowBox[{"-", "r"}], " ", RowBox[{"Cos", "[", "t", "]"}], " ", RowBox[{"Cos", "[", "u", "]"}]}], ",", " ", "\[IndentingNewLine]", RowBox[{ RowBox[{"-", "r"}], " ", RowBox[{"Sin", "[", "t", "]"}], " ", RowBox[{"Cos", "[", "u", "]"}]}]}], "}"}], ",", " ", "\[IndentingNewLine]", " ", RowBox[{"{", RowBox[{"t", ",", "0", ",", " ", RowBox[{"2", "Pi"}]}], "}"}], ",", RowBox[{"{", RowBox[{"u", ",", RowBox[{"Pi", "/", "2"}], ",", RowBox[{ RowBox[{"Pi", "/", "2"}], "-", "alpha"}]}], "}"}], ",", RowBox[{"PlotStyle", " ", "\[Rule]", "Red"}]}], "]"}]}], ";", "\[IndentingNewLine]", "\[IndentingNewLine]", "\[IndentingNewLine]", "\[IndentingNewLine]", RowBox[{"latticecastice1", " ", "=", " ", RowBox[{"ParametricPlot3D", "[", RowBox[{ RowBox[{"{", "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{ RowBox[{"(", RowBox[{"r", " ", "+", "\[Alpha]"}], ")"}], " ", RowBox[{"Sin", "[", "u", "]"}]}], "-", RowBox[{"If", "[", RowBox[{"B3", ",", RowBox[{"If", "[", RowBox[{"B4", ",", RowBox[{"r", RowBox[{"(", RowBox[{"Hvrel", " ", "+", "\[Phi]rel"}], " ", ")"}]}], ",", RowBox[{"(", RowBox[{"r", " ", "Hprel"}], ")"}]}], "]"}], ",", "r"}], "]"}]}], ",", "\[IndentingNewLine]", RowBox[{ RowBox[{"(", RowBox[{"r", " ", "+", "\[Alpha]"}], ")"}], " ", RowBox[{"Cos", "[", "t", "]"}], " ", RowBox[{"Cos", "[", "u", "]"}]}], ",", " ", "\[IndentingNewLine]", RowBox[{ RowBox[{"(", RowBox[{"r", " ", "+", "\[Alpha]"}], ")"}], " ", " ", RowBox[{"Sin", "[", "t", "]"}], " ", RowBox[{"Cos", "[", "u", "]"}]}]}], "}"}], ",", " ", "\[IndentingNewLine]", " ", RowBox[{"{", RowBox[{"t", ",", "0", ",", " ", RowBox[{"2", "Pi"}]}], "}"}], ",", RowBox[{"{", RowBox[{"u", ",", RowBox[{ RowBox[{"-", "Pi"}], "/", "2"}], ",", RowBox[{"Pi", "/", "2"}]}], "}"}], ",", RowBox[{"PlotStyle", " ", "\[Rule]", " ", RowBox[{"{", RowBox[{ RowBox[{"Opacity", "[", "0.2", "]"}], ",", "Blue"}], "}"}]}], ",", RowBox[{"Mesh", "\[Rule]", "None"}]}], "]"}]}], ";", "\[IndentingNewLine]", RowBox[{"latticecastice2", " ", "=", " ", RowBox[{"ParametricPlot3D", "[", RowBox[{ RowBox[{"{", "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{ RowBox[{"-", RowBox[{"(", RowBox[{"r", " ", "+", "\[Alpha]"}], ")"}]}], " ", RowBox[{"Sin", "[", "u", "]"}]}], "+", RowBox[{"If", "[", RowBox[{"B3", ",", RowBox[{"If", "[", RowBox[{"B4", ",", RowBox[{"r", RowBox[{"(", RowBox[{"Hvrel", " ", "+", "\[Phi]rel"}], " ", ")"}]}], ",", RowBox[{"(", RowBox[{"r", " ", "Hprel"}], ")"}]}], "]"}], ",", "r"}], "]"}]}], ",", "\[IndentingNewLine]", RowBox[{ RowBox[{"-", RowBox[{"(", RowBox[{"r", " ", "+", "\[Alpha]"}], ")"}]}], " ", RowBox[{"Cos", "[", "t", "]"}], " ", RowBox[{"Cos", "[", "u", "]"}]}], ",", " ", "\[IndentingNewLine]", RowBox[{ RowBox[{"-", RowBox[{"(", RowBox[{"r", " ", "+", "\[Alpha]"}], ")"}]}], " ", " ", RowBox[{"Sin", "[", "t", "]"}], " ", RowBox[{"Cos", "[", "u", "]"}]}]}], "}"}], ",", " ", "\[IndentingNewLine]", " ", RowBox[{"{", RowBox[{"t", ",", "0", ",", " ", RowBox[{"2", "Pi"}]}], "}"}], ",", RowBox[{"{", RowBox[{"u", ",", RowBox[{ RowBox[{"-", "Pi"}], "/", "2"}], ",", RowBox[{"Pi", "/", "2"}]}], "}"}], ",", RowBox[{"PlotStyle", " ", "\[Rule]", " ", RowBox[{"{", RowBox[{ RowBox[{"Opacity", "[", "0.2", "]"}], ",", "Blue"}], "}"}]}], ",", RowBox[{"Mesh", "\[Rule]", "None"}]}], "]"}]}], ";", "\[IndentingNewLine]", "\[IndentingNewLine]", "\n", " ", RowBox[{"If", "[", RowBox[{"valec", ",", " ", "\[IndentingNewLine]", " ", RowBox[{ RowBox[{"Val", " ", "=", " ", RowBox[{"ParametricPlot3D", "[", " ", RowBox[{ RowBox[{ "{", "\[IndentingNewLine]", " ", RowBox[{ "u", ",", " ", "\[IndentingNewLine]", " ", RowBox[{"arel", " ", "r", " ", RowBox[{"Cos", "[", "t", "]"}]}], ",", "\[IndentingNewLine]", " ", RowBox[{"arel", " ", "r", " ", RowBox[{"Sin", "[", "t", "]"}]}]}], "}"}], ",", " ", "\[IndentingNewLine]", " ", RowBox[{"{", RowBox[{"t", ",", "0", ",", " ", RowBox[{"2", "Pi"}]}], "}"}], ",", RowBox[{"{", RowBox[{"u", ",", RowBox[{"r", RowBox[{"(", RowBox[{"-", "Hvrel"}], ")"}]}], " ", ",", RowBox[{"r", RowBox[{"(", " ", "Hvrel", ")"}]}]}], " ", "}"}], ",", RowBox[{"PlotStyle", " ", "\[Rule]", "Red"}]}], "]"}]}], ";", "\[IndentingNewLine]", RowBox[{"Valcastice1", " ", "=", " ", RowBox[{"ParametricPlot3D", "[", RowBox[{ RowBox[{ "{", "\[IndentingNewLine]", " ", RowBox[{ RowBox[{ RowBox[{"r", " ", RowBox[{"Sin", "[", "u", "]"}]}], "-", RowBox[{"r", RowBox[{"(", RowBox[{"Hvrel", " ", "+", "\[Phi]rel"}], " ", ")"}]}]}], ",", "\[IndentingNewLine]", " ", RowBox[{"r", " ", RowBox[{"Cos", "[", "t", "]"}], " ", RowBox[{"Cos", "[", "u", "]"}]}], ",", " ", "\[IndentingNewLine]", " ", RowBox[{"r", " ", RowBox[{"Sin", "[", "t", "]"}], " ", RowBox[{"Cos", "[", "u", "]"}]}]}], "}"}], ",", " ", "\[IndentingNewLine]", " ", RowBox[{"{", RowBox[{"t", ",", "0", ",", " ", RowBox[{"2", "Pi"}]}], "}"}], ",", RowBox[{"{", RowBox[{"u", ",", RowBox[{ RowBox[{"-", "Pi"}], "/", "2"}], ",", RowBox[{ RowBox[{"Pi", "/", "2"}], "-", "alpha"}]}], "}"}]}], "]"}]}], ";", "\[IndentingNewLine]", RowBox[{"Valcastice2", " ", "=", " ", RowBox[{"ParametricPlot3D", "[", RowBox[{ RowBox[{ "{", "\[IndentingNewLine]", " ", RowBox[{ RowBox[{ RowBox[{ RowBox[{"(", RowBox[{"-", "r"}], ")"}], " ", RowBox[{"Sin", "[", "u", "]"}]}], "+", RowBox[{"r", " ", RowBox[{"(", RowBox[{"Hvrel", " ", "+", "\[Phi]rel"}], " ", ")"}]}]}], " ", ",", "\[IndentingNewLine]", " ", RowBox[{ RowBox[{"(", RowBox[{"-", "r"}], ")"}], " ", RowBox[{"Cos", "[", "t", "]"}], " ", RowBox[{"Cos", "[", "u", "]"}]}], ",", " ", "\[IndentingNewLine]", " ", RowBox[{ RowBox[{"(", RowBox[{"-", "r"}], ")"}], " ", RowBox[{"Sin", "[", "t", "]"}], " ", RowBox[{"Cos", "[", "u", "]"}]}]}], "}"}], ",", " ", "\[IndentingNewLine]", " ", RowBox[{"{", RowBox[{"t", ",", "0", ",", RowBox[{"2", " ", "Pi"}]}], "}"}], ",", RowBox[{"{", RowBox[{"u", ",", RowBox[{ RowBox[{"-", "Pi"}], "/", "2"}], ",", RowBox[{ RowBox[{"Pi", "/", "2"}], "-", "alpha"}]}], "}"}]}], "]"}]}]}], ",", "\[IndentingNewLine]", "\[IndentingNewLine]", " ", RowBox[{ RowBox[{"Val", " ", "=", " ", RowBox[{"ParametricPlot3D", "[", " ", RowBox[{ RowBox[{ "{", "\[IndentingNewLine]", " ", RowBox[{ "u", ",", " ", "\[IndentingNewLine]", " ", RowBox[{"r", " ", RowBox[{"Cos", "[", "t", "]"}]}], ",", "\[IndentingNewLine]", " ", RowBox[{"r", " ", RowBox[{"Sin", "[", "t", "]"}]}]}], "}"}], ",", " ", "\[IndentingNewLine]", " ", RowBox[{"{", RowBox[{"t", ",", "0", ",", " ", RowBox[{"2", "Pi"}]}], "}"}], ",", RowBox[{"{", RowBox[{"u", ",", RowBox[{"r", RowBox[{"(", RowBox[{"-", "Hvrel"}], ")"}]}], " ", ",", RowBox[{"r", " ", "Hvrel"}]}], " ", "}"}], ",", RowBox[{"PlotStyle", " ", "\[Rule]", "Red"}]}], "]"}]}], ";", "\[IndentingNewLine]", " ", RowBox[{"Valcastice1", " ", "=", " ", RowBox[{"ParametricPlot3D", "[", RowBox[{ RowBox[{ "{", "\[IndentingNewLine]", " ", RowBox[{ RowBox[{ RowBox[{"r", " ", RowBox[{"Sin", "[", "u", "]"}]}], "-", RowBox[{"r", " ", "Hvrel"}]}], ",", "\[IndentingNewLine]", " ", RowBox[{"r", " ", RowBox[{"Cos", "[", "t", "]"}], " ", RowBox[{"Cos", "[", "u", "]"}]}], ",", " ", "\[IndentingNewLine]", " ", RowBox[{"r", " ", RowBox[{"Sin", "[", "t", "]"}], " ", RowBox[{"Cos", "[", "u", "]"}]}]}], "}"}], ",", " ", "\[IndentingNewLine]", " ", RowBox[{"{", RowBox[{"t", ",", "0", ",", " ", RowBox[{"2", "Pi"}]}], "}"}], ",", RowBox[{"{", RowBox[{"u", ",", RowBox[{ RowBox[{"-", "Pi"}], "/", "2"}], ",", "0"}], "}"}]}], "]"}]}], ";", "\[IndentingNewLine]", RowBox[{"Valcastice2", " ", "=", " ", RowBox[{"ParametricPlot3D", "[", RowBox[{ RowBox[{ "{", "\[IndentingNewLine]", " ", RowBox[{ RowBox[{ RowBox[{ RowBox[{"(", RowBox[{"-", "r"}], ")"}], " ", RowBox[{"Sin", "[", "u", "]"}]}], "+", RowBox[{"r", " ", "Hvrel"}]}], ",", "\[IndentingNewLine]", " ", RowBox[{ RowBox[{"(", RowBox[{"-", "r"}], ")"}], " ", RowBox[{"Cos", "[", "t", "]"}], " ", RowBox[{"Cos", "[", "u", "]"}]}], ",", " ", "\[IndentingNewLine]", " ", RowBox[{ RowBox[{"(", RowBox[{"-", "r"}], ")"}], " ", RowBox[{"Sin", "[", "t", "]"}], " ", RowBox[{"Cos", "[", "u", "]"}]}]}], "}"}], ",", " ", "\[IndentingNewLine]", " ", RowBox[{"{", RowBox[{"t", ",", "0", ",", RowBox[{"2", " ", "Pi"}]}], "}"}], ",", RowBox[{"{", RowBox[{"u", ",", RowBox[{ RowBox[{"-", "Pi"}], "/", "2"}], ",", "0"}], "}"}]}], "]"}]}]}]}], "]"}], ";", "\[IndentingNewLine]", "\n", " ", RowBox[{"Par1", " ", "=", " ", RowBox[{"ParametricPlot3D", "[", " ", RowBox[{ RowBox[{"{", "\[IndentingNewLine]", " ", RowBox[{ RowBox[{ RowBox[{"r", " ", "u"}], "-", RowBox[{"(", RowBox[{"r", " ", "Hprel"}], ")"}]}], ",", "\[IndentingNewLine]", " ", RowBox[{"r", RowBox[{"(", " ", RowBox[{ RowBox[{"cp1", " ", SuperscriptBox[ RowBox[{"(", RowBox[{"u", "-", "Hprel"}], ")"}], "2"]}], " ", "+", "cp2"}], " ", ")"}], " ", RowBox[{"Cos", "[", "t", "]"}]}], ",", "\[IndentingNewLine]", " ", RowBox[{"r", RowBox[{"(", " ", RowBox[{ RowBox[{"cp1", " ", SuperscriptBox[ RowBox[{"(", RowBox[{"u", "-", "Hprel"}], ")"}], "2"]}], " ", "+", "cp2"}], " ", ")"}], " ", RowBox[{"Sin", "[", "t", "]"}]}]}], "}"}], ",", " ", "\[IndentingNewLine]", " ", RowBox[{"{", RowBox[{"t", ",", "0", ",", " ", RowBox[{"2", "Pi"}]}], "}"}], ",", RowBox[{"{", RowBox[{"u", ",", "\[Phi]rel", " ", ",", "Hprel"}], "}"}], ",", RowBox[{"PlotStyle", " ", "\[Rule]", "Red"}]}], "]"}]}], ";", "\[IndentingNewLine]", RowBox[{"Parcastice1", " ", "=", " ", RowBox[{"ParametricPlot3D", "[", RowBox[{ RowBox[{"{", "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{"r", " ", RowBox[{"Sin", "[", "u", "]"}]}], "-", RowBox[{"(", RowBox[{"r", " ", "Hprel"}], ")"}]}], ",", "\[IndentingNewLine]", RowBox[{"r", " ", RowBox[{"Cos", "[", "t", "]"}], " ", RowBox[{"Cos", "[", "u", "]"}]}], ",", " ", "\[IndentingNewLine]", RowBox[{"r", " ", RowBox[{"Sin", "[", "t", "]"}], " ", RowBox[{"Cos", "[", "u", "]"}]}]}], "}"}], ",", " ", "\[IndentingNewLine]", " ", RowBox[{"{", RowBox[{"t", ",", "0", ",", " ", RowBox[{"2", "Pi"}]}], "}"}], ",", RowBox[{"{", RowBox[{"u", ",", RowBox[{ RowBox[{"-", "Pi"}], "/", "2"}], ",", RowBox[{ RowBox[{"Pi", "/", "2"}], "-", "alpha"}]}], "}"}]}], "]"}]}], ";", "\[IndentingNewLine]", " ", RowBox[{"Par2", " ", "=", " ", RowBox[{"ParametricPlot3D", "[", " ", RowBox[{ RowBox[{"{", "\[IndentingNewLine]", " ", RowBox[{ RowBox[{ RowBox[{ RowBox[{"-", "r"}], " ", "u"}], "+", RowBox[{"(", RowBox[{"r", " ", "Hprel"}], ")"}]}], ",", " ", "\[IndentingNewLine]", " ", RowBox[{ RowBox[{"-", "r"}], RowBox[{"(", " ", RowBox[{ RowBox[{"cp1", " ", SuperscriptBox[ RowBox[{"(", RowBox[{"u", "-", "Hprel"}], ")"}], "2"]}], " ", "+", "cp2"}], " ", ")"}], " ", RowBox[{"Cos", "[", "t", "]"}]}], ",", "\[IndentingNewLine]", " ", RowBox[{ RowBox[{"-", "r"}], RowBox[{"(", " ", RowBox[{ RowBox[{"cp1", " ", SuperscriptBox[ RowBox[{"(", RowBox[{"u", "-", "Hprel"}], ")"}], "2"]}], " ", "+", "cp2"}], " ", ")"}], " ", RowBox[{"Sin", "[", "t", "]"}]}]}], "}"}], ",", " ", "\[IndentingNewLine]", " ", RowBox[{"{", RowBox[{"t", ",", "0", ",", " ", RowBox[{"2", "Pi"}]}], "}"}], ",", RowBox[{"{", RowBox[{"u", ",", "\[Phi]rel", " ", ",", "Hprel"}], "}"}], ",", RowBox[{"PlotStyle", " ", "\[Rule]", "Red"}]}], "]"}]}], ";", "\[IndentingNewLine]", RowBox[{"Parcastice2", " ", "=", " ", RowBox[{"ParametricPlot3D", "[", RowBox[{ RowBox[{"{", "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{ RowBox[{"-", "r"}], " ", RowBox[{"Sin", "[", "u", "]"}]}], "+", RowBox[{"(", RowBox[{"r", " ", "Hprel"}], ")"}]}], ",", "\[IndentingNewLine]", RowBox[{ RowBox[{"-", "r"}], " ", RowBox[{"Cos", "[", "t", "]"}], " ", RowBox[{"Cos", "[", "u", "]"}]}], ",", " ", "\[IndentingNewLine]", RowBox[{ RowBox[{"-", "r"}], " ", RowBox[{"Sin", "[", "t", "]"}], " ", RowBox[{"Cos", "[", "u", "]"}]}]}], "}"}], ",", " ", "\[IndentingNewLine]", " ", RowBox[{"{", RowBox[{"t", ",", "0", ",", " ", RowBox[{"2", "Pi"}]}], "}"}], ",", RowBox[{"{", RowBox[{"u", ",", RowBox[{ RowBox[{"-", "Pi"}], "/", "2"}], ",", RowBox[{ RowBox[{"Pi", "/", "2"}], "-", "alpha"}]}], "}"}]}], "]"}]}], ";", "\[IndentingNewLine]", "\[IndentingNewLine]", "\[IndentingNewLine]", "\[IndentingNewLine]", "\[IndentingNewLine]", "\[IndentingNewLine]", RowBox[{"Show", "[", RowBox[{ RowBox[{"If", "[", RowBox[{"B1", ",", RowBox[{"{", RowBox[{"latticecastice1", ",", "latticecastice2"}], "}"}], ",", RowBox[{"{", "}"}]}], "]"}], ",", RowBox[{"If", "[", RowBox[{"B3", ",", RowBox[{"If", "[", RowBox[{"B4", ",", RowBox[{"{", RowBox[{"Val", ",", "Valcastice1", ",", "Valcastice2"}], "}"}], ",", RowBox[{"{", RowBox[{ "Par1", ",", "Par2", ",", "Parcastice1", ",", "Parcastice2"}], "}"}]}], "]"}], ",", RowBox[{"If", "[", RowBox[{"B2", ",", RowBox[{"{", RowBox[{ "castice1p1", ",", "castice1p2", ",", "castice2p1", ",", "castice2p2"}], "}"}], ",", RowBox[{"{", RowBox[{"castice1", ",", "castice2"}], "}"}]}], "]"}]}], "]"}], ",", "\[IndentingNewLine]", "\[IndentingNewLine]", RowBox[{"PlotRange", " ", "\[Rule]", "Automatic"}]}], "]"}]}], ",", "\[IndentingNewLine]", "\[IndentingNewLine]", "\[IndentingNewLine]", "\[IndentingNewLine]", "\[IndentingNewLine]", RowBox[{"Grid", "[", RowBox[{"{", "\[IndentingNewLine]", RowBox[{ RowBox[{"{", RowBox[{"\"\\"", ",", ",", ",", ",", ",", RowBox[{"PopupMenu", "[", RowBox[{"Ta", ",", RowBox[{"{", RowBox[{"Ta", ",", "Cu", ",", "Au", ",", "Ag"}], "}"}]}], "]"}]}], "}"}], ",", "\[IndentingNewLine]", RowBox[{"{", RowBox[{"\"\\"", ",", RowBox[{"Checkbox", "[", RowBox[{"Dynamic", "[", "B1", "]"}], "]"}]}], " ", "}"}], ",", "\[IndentingNewLine]", RowBox[{"{", RowBox[{ "\"\<\!\(\*SubscriptBox[\(V\), \(molten\)]\)\>\"", ",", " ", RowBox[{"Checkbox", "[", RowBox[{"Dynamic", "[", "B2", "]"}], "]"}]}], " ", "}"}], ",", "\[IndentingNewLine]", RowBox[{"{", RowBox[{"\"\\"", ",", " ", RowBox[{"Checkbox", "[", RowBox[{"Dynamic", "[", "B3", "]"}], "]"}], " ", ",", ",", "\"\\"", ",", " ", RowBox[{"RadioButton", "[", RowBox[{ RowBox[{"Dynamic", "[", "B4", "]"}], ",", "True", ",", RowBox[{"Enabled", "\[Rule]", RowBox[{"Dynamic", "[", "B3", "]"}]}]}], "]"}]}], " ", "}"}], ",", "\[IndentingNewLine]", RowBox[{"{", RowBox[{ ",", ",", " \ ", ",", "\"\\"", ",", " ", RowBox[{"RadioButton", "[", RowBox[{ RowBox[{"Dynamic", "[", "B4", "]"}], ",", "False", ",", " ", RowBox[{"Enabled", "\[Rule]", RowBox[{"Dynamic", "[", "B3", "]"}]}]}], "]"}]}], " ", "}"}], ",", "\[IndentingNewLine]", RowBox[{"{", RowBox[{"\"\\"", ",", ",", RowBox[{"Control", "[", RowBox[{"{", RowBox[{"r", ",", "rmin", ",", "rmax"}], "}"}], "]"}], ",", RowBox[{"Dynamic", "[", RowBox[{"NumberForm", "[", RowBox[{"r", ",", "2"}], "]"}], "]"}], ",", "\"\<[m]\>\""}], "}"}], ",", "\[IndentingNewLine]", RowBox[{"{", RowBox[{"\"\\"", ",", ",", RowBox[{"Control", "[", RowBox[{"{", RowBox[{"T", ",", "Tmin", ",", "Tmax"}], "}"}], "]"}], ",", RowBox[{"Dynamic", "[", "T", "]"}], ",", "\"\<[K]\>\""}], "}"}]}], "}"}], RowBox[{"(*", RowBox[{",", "\[IndentingNewLine]", RowBox[{"Frame", "\[Rule]", "All"}]}], "*)"}], "]"}]}], "\[IndentingNewLine]", "\[IndentingNewLine]", "]"}]}]}], "]"}]], "Input", CellChangeTimes->{{3.703162606008401*^9, 3.703162609863654*^9}, { 3.7031626568806458`*^9, 3.7031627300751476`*^9}, {3.7031627896550922`*^9, 3.7031628136557627`*^9}, {3.7031710628709936`*^9, 3.703171207907817*^9}, { 3.703171441075051*^9, 3.7031715238505783`*^9}, {3.703171625076838*^9, 3.7031716558095737`*^9}, {3.7031718423462296`*^9, 3.7031718731058073`*^9}, {3.7031720929123282`*^9, 3.703172126201363*^9}, { 3.703172302628374*^9, 3.7031723204855194`*^9}, {3.7031724260644226`*^9, 3.7031725217845135`*^9}, {3.7031726088110514`*^9, 3.703172611838604*^9}, { 3.7031727527384048`*^9, 3.703172960566354*^9}, {3.703173024977434*^9, 3.7031730300308747`*^9}, {3.703174593189083*^9, 3.703174615833976*^9}, { 3.703174709788909*^9, 3.703174772080378*^9}, {3.70317523583815*^9, 3.703175352843332*^9}, {3.7031755818149295`*^9, 3.703175744264695*^9}, { 3.703175813312559*^9, 3.7031758285117965`*^9}, {3.7031758825349474`*^9, 3.703175970226016*^9}, {3.7031761323049088`*^9, 3.703176335393197*^9}, { 3.703176423700153*^9, 3.703176548108102*^9}, {3.7031765980522413`*^9, 3.703176608528604*^9}, {3.7031767878091383`*^9, 3.7031767959821973`*^9}, { 3.70317686396682*^9, 3.703176882722969*^9}, {3.7031769322625513`*^9, 3.7031770915930533`*^9}, {3.7031779205864587`*^9, 3.7031779238335953`*^9}, {3.7031780127385445`*^9, 3.7031780675834093`*^9}, {3.7031781412162695`*^9, 3.7031782702861896`*^9}, {3.703178303833913*^9, 3.703178352364998*^9}, { 3.7031784041793103`*^9, 3.7031784519458485`*^9}, {3.7031802809719906`*^9, 3.7031806166453495`*^9}, {3.703180656737479*^9, 3.7031807073265233`*^9}, { 3.703180761679079*^9, 3.703180834155334*^9}, {3.7031808945649986`*^9, 3.7031810429150457`*^9}, {3.703181074892091*^9, 3.703181080429318*^9}, { 3.7031811135288486`*^9, 3.7031811224144807`*^9}, {3.703181181508646*^9, 3.703181213955942*^9}, 3.703182482102481*^9, {3.7031825915106044`*^9, 3.7031827168601136`*^9}, {3.703183802581833*^9, 3.7031839852552023`*^9}, { 3.703184051726812*^9, 3.7031840564846644`*^9}, {3.7031841117378216`*^9, 3.7031841490651684`*^9}, {3.7031842017552204`*^9, 3.703184209652251*^9}, { 3.7031842410866528`*^9, 3.7031842827545385`*^9}, {3.7031843346709795`*^9, 3.703184337838451*^9}, {3.7031843974979043`*^9, 3.7031844041973753`*^9}, { 3.7031851785882115`*^9, 3.7031851813956776`*^9}, {3.7031852419296722`*^9, 3.703185261208865*^9}, {3.7031854165032635`*^9, 3.703185480378748*^9}, { 3.70318557149515*^9, 3.703185641576682*^9}, 3.70318568552787*^9, { 3.703186052428939*^9, 3.7031860804494605`*^9}, {3.703186220113058*^9, 3.7031862206174*^9}, {3.703186260265357*^9, 3.703186262769516*^9}, { 3.70318632582078*^9, 3.7031863261977816`*^9}, {3.7031865594584055`*^9, 3.7031866002676077`*^9}, {3.7031866688905764`*^9, 3.7031867377537427`*^9}, {3.7031868330720925`*^9, 3.703186867935918*^9}, { 3.703187510185047*^9, 3.7031875191931324`*^9}, {3.7031875730712223`*^9, 3.703187597918806*^9}, {3.7031876443879004`*^9, 3.703187645308609*^9}, { 3.703188257490141*^9, 3.7031882717460923`*^9}, {3.7031957084877605`*^9, 3.7031958858198824`*^9}, {3.703196084570407*^9, 3.7031961355209007`*^9}, { 3.703244828801281*^9, 3.7032448788990297`*^9}},ExpressionUUID->"bc3adc0c-6fa8-45da-ba2b-\ 2046239c9f54"], Cell[BoxData[ DynamicModuleBox[{$CellContext`npc1$$, $CellContext`npc2$$, \ $CellContext`npc1p1$$, $CellContext`npc2p1$$, $CellContext`npc1p2$$, \ $CellContext`npc2p2$$, $CellContext`npc1neck$$, $CellContext`npc2neck$$, \ $CellContext`neck$$, $CellContext`graph$$}, TagBox[ StyleBox[ DynamicModuleBox[{$CellContext`r$$ = 1.196*^-9, $CellContext`T$$ = 3110., Typeset`show$$ = True, Typeset`bookmarkList$$ = {}, Typeset`bookmarkMode$$ = "Menu", Typeset`animator$$, Typeset`animvar$$ = 1, Typeset`name$$ = "\"untitled\"", Typeset`specs$$ = {{ Hold[$CellContext`r$$], Rational[1, 1000000000], Rational[1, 20000000]}, { Hold[$CellContext`T$$], 0, 3285}, { Hold[ Grid[{{"Nps type", Null, Null, Null, Null, PopupMenu[$CellContext`Ta, {$CellContext`Ta, $CellContext`Cu, \ $CellContext`Au, $CellContext`Ag}]}, {"Lattice constant", Checkbox[ Dynamic[$CellContext`B1]]}, { "\!\(\*SubscriptBox[\(V\), \(molten\)]\)", Checkbox[ Dynamic[$CellContext`B2]]}, {"Neck", Checkbox[ Dynamic[$CellContext`B3]], Null, "valec", RadioButton[ Dynamic[$CellContext`B4], True, Enabled -> Dynamic[$CellContext`B3]]}, {Null, Null, Null, "parabola", RadioButton[ Dynamic[$CellContext`B4], False, Enabled -> Dynamic[$CellContext`B3]]}, {"Nps radius", Null, Manipulate`Place[1], Dynamic[ NumberForm[$CellContext`r$$, 2]], "[m]"}, { "Nps temperature", Null, Manipulate`Place[2], Dynamic[$CellContext`T$$], "[K]"}}]], Manipulate`Dump`ThisIsNotAControl}}, Typeset`size$$ = { 540., {214., 219.}}, Typeset`update$$ = 0, Typeset`initDone$$, Typeset`skipInitDone$$ = True, $CellContext`r$18599$$ = 0, $CellContext`T$18600$$ = 0}, DynamicBox[Manipulate`ManipulateBoxes[ 2, StandardForm, "Variables" :> {$CellContext`r$$ = Rational[1, 1000000000], $CellContext`T$$ = 0}, "ControllerVariables" :> { Hold[$CellContext`r$$, $CellContext`r$18599$$, 0], Hold[$CellContext`T$$, $CellContext`T$18600$$, 0]}, "OtherVariables" :> { Typeset`show$$, Typeset`bookmarkList$$, Typeset`bookmarkMode$$, Typeset`animator$$, Typeset`animvar$$, Typeset`name$$, Typeset`specs$$, Typeset`size$$, Typeset`update$$, Typeset`initDone$$, Typeset`skipInitDone$$}, "Body" :> ( Which[$CellContext`npctype == 1, $CellContext`\[Alpha] = 3.3058/10^10; $CellContext`\[Gamma] = 1.645; $CellContext`m\[Alpha] = 3.0047/10^25; $CellContext`\[Rho] = 16654; $CellContext`kB = 1.38064852/10^23; $CellContext`Tm = 3290; $CellContext`rmin = 1 10^(-9); $CellContext`rmax = 9 10^(-9); $CellContext`Tmin = 100; $CellContext`Tmax = 3285, $CellContext`npctype == 2, $CellContext`\[Alpha] = 2.72/10^10; $CellContext`\[Gamma] = 1.6; $CellContext`m\[Alpha] = 3.2706/10^25; $CellContext`\[Rho] = 19300; $CellContext`kB = 1.38064852/10^23; $CellContext`Tm = 1337; $CellContext`rmin = 1 10^(-9); $CellContext`rmax = 9 10^(-9); $CellContext`Tmin = 100; $CellContext`Tmax = 3285, $CellContext`npctype == 3, $CellContext`\[Alpha] = 2.64/10^10; $CellContext`\[Gamma] = 1.6; $CellContext`m\[Alpha] = 1.055/10^25; $CellContext`\[Rho] = 8960; $CellContext`kB = 1.38064852/10^23; $CellContext`Tm = 1357; $CellContext`rmin = 1 10^(-9); $CellContext`rmax = 9 10^(-9); $CellContext`Tmin = 100; $CellContext`Tmax = 3285, $CellContext`npctype == 4, $CellContext`\[Alpha] = 2.9/10^10; $CellContext`\[Gamma] = 1.2; $CellContext`m\[Alpha] = 1.791/10^25; $CellContext`\[Rho] = 10490; $CellContext`kB = 1.38064852/10^23; $CellContext`Tm = 1234; $CellContext`rmin = 1 10^(-9); $CellContext`rmax = 9 10^(-9); $CellContext`Tmin = 100; $CellContext`Tmax = 3285]; $CellContext`Vrel := ( 2 $CellContext`m\[Alpha] (1/2) $CellContext`\[Gamma] Pi $CellContext`r$$ $CellContext`\[Alpha]/( 3 ($CellContext`\[Rho] $CellContext`kB) ($CellContext`Tm - \ $CellContext`T$$))) (1/$CellContext`r$$^3); If[$CellContext`Vrel < (4/3) Pi, If[$CellContext`Vrel < (2/3) Pi, $CellContext`arel = Chop[ ReplaceAll[$CellContext`x, FindRoot[(1/6) (Pi (1 - Sqrt[1 - $CellContext`x^2])) ( 3 $CellContext`x^2 + (1 - Sqrt[ 1 - $CellContext`x^2])^2) - $CellContext`Vrel, \ {$CellContext`x, 0.01}]]]; $CellContext`hrel = 1 - Sqrt[1 - $CellContext`arel^2]; $CellContext`alpha = ArcSin[$CellContext`arel]; $CellContext`model = True; $CellContext`valec = True; Null, $CellContext`arel = Chop[ ReplaceAll[$CellContext`x, FindRoot[(1/6) (Pi (1 - Sqrt[1 - $CellContext`x^2])) ( 3 $CellContext`x^2 + (1 - Sqrt[ 1 - $CellContext`x^2])^2) - ((4/3) Pi - $CellContext`Vrel), {$CellContext`x, 0.01}]]]; $CellContext`hrel = 2 - (1 - Sqrt[1 - $CellContext`arel^2]); $CellContext`alpha = Pi - ArcSin[$CellContext`arel]; $CellContext`model = True; $CellContext`valec = False; Null], $CellContext`model = False; $CellContext`valec = False]; $CellContext`\[Phi]rel = 1 - $CellContext`hrel; If[$CellContext`valec, $CellContext`Hvrel = ($CellContext`hrel^3/( 3 $CellContext`arel^2) + $CellContext`hrel)/ 2, $CellContext`Hvrel = (4/3)/2]; $CellContext`M = ReplaceAll[{$CellContext`c1, $CellContext`c3, $CellContext`H0}, NSolve[{2 $CellContext`c1 ($CellContext`\[Phi]rel - \ $CellContext`H0) == -($CellContext`\[Phi]rel/Sqrt[ 1^2 - $CellContext`\[Phi]rel^2]), $CellContext`c1 \ ($CellContext`\[Phi]rel - $CellContext`H0)^2 + $CellContext`c3 == \ $CellContext`arel, Pi ($CellContext`c1^2 (($CellContext`H0^5 - \ $CellContext`\[Phi]rel^5)/5 - 4 $CellContext`H0 (($CellContext`H0^4 - \ $CellContext`\[Phi]rel^4)/4) + 6 $CellContext`H0^2 (($CellContext`H0^3 - \ $CellContext`\[Phi]rel^3)/3) - 4 $CellContext`H0^3 (($CellContext`H0^2 - \ $CellContext`\[Phi]rel^2)/ 2) + $CellContext`H0^4 ($CellContext`H0 - $CellContext`\ \[Phi]rel)) + $CellContext`c1 $CellContext`c3 (($CellContext`H0^3 - \ $CellContext`\[Phi]rel^3)/3 - 2 $CellContext`H0 (($CellContext`H0^2 - \ $CellContext`\[Phi]rel^2)/ 2) + $CellContext`H0^2 ($CellContext`H0 - $CellContext`\ \[Phi]rel)) + $CellContext`c3^2 ($CellContext`H0 - $CellContext`\[Phi]rel)) == \ $CellContext`Vrel}, {$CellContext`c1, $CellContext`c3, $CellContext`H0}, Reals]]; $CellContext`cp1 = Extract[ Flatten[ Take[$CellContext`M, {1}]], {1}]; $CellContext`cp2 = Extract[ Flatten[ Take[$CellContext`M, {1}]], {2}]; $CellContext`Hprel = Extract[ Flatten[ Take[$CellContext`M, {1}]], {3}]; $CellContext`castice1 = ParametricPlot3D[{$CellContext`r$$ Sin[$CellContext`u] - $CellContext`r$$, $CellContext`r$$ Cos[$CellContext`t] Cos[$CellContext`u], $CellContext`r$$ Sin[$CellContext`t] Cos[$CellContext`u]}, {$CellContext`t, 0, 2 Pi}, {$CellContext`u, (-Pi)/2, Pi/2}]; $CellContext`castice2 = ParametricPlot3D[{(-$CellContext`r$$) Sin[$CellContext`u] + $CellContext`r$$, (-$CellContext`r$$) Cos[$CellContext`t] Cos[$CellContext`u], (-$CellContext`r$$) Sin[$CellContext`t] Cos[$CellContext`u]}, {$CellContext`t, 0, 2 Pi}, {$CellContext`u, (-Pi)/2, Pi/2}]; $CellContext`castice1p1 = ParametricPlot3D[{$CellContext`r$$ Sin[$CellContext`u] - $CellContext`r$$, $CellContext`r$$ Cos[$CellContext`t] Cos[$CellContext`u], $CellContext`r$$ Sin[$CellContext`t] Cos[$CellContext`u]}, {$CellContext`t, 0, 2 Pi}, {$CellContext`u, Pi/2 - $CellContext`alpha, (-Pi)/ 2}]; $CellContext`castice1p2 = ParametricPlot3D[{$CellContext`r$$ Sin[$CellContext`u] - $CellContext`r$$, $CellContext`r$$ Cos[$CellContext`t] Cos[$CellContext`u], $CellContext`r$$ Sin[$CellContext`t] Cos[$CellContext`u]}, {$CellContext`t, 0, 2 Pi}, {$CellContext`u, Pi/2, Pi/2 - $CellContext`alpha}, PlotStyle -> Red]; $CellContext`castice2p1 = ParametricPlot3D[{(-$CellContext`r$$) Sin[$CellContext`u] + $CellContext`r$$, (-$CellContext`r$$) Cos[$CellContext`t] Cos[$CellContext`u], (-$CellContext`r$$) Sin[$CellContext`t] Cos[$CellContext`u]}, {$CellContext`t, 0, 2 Pi}, {$CellContext`u, (-Pi)/2, Pi/2 - $CellContext`alpha}]; $CellContext`castice2p2 = ParametricPlot3D[{(-$CellContext`r$$) Sin[$CellContext`u] + $CellContext`r$$, (-$CellContext`r$$) Cos[$CellContext`t] Cos[$CellContext`u], (-$CellContext`r$$) Sin[$CellContext`t] Cos[$CellContext`u]}, {$CellContext`t, 0, 2 Pi}, {$CellContext`u, Pi/2, Pi/2 - $CellContext`alpha}, PlotStyle -> Red]; $CellContext`latticecastice1 = ParametricPlot3D[{($CellContext`r$$ + $CellContext`\[Alpha]) Sin[$CellContext`u] - If[$CellContext`B3, If[$CellContext`B4, $CellContext`r$$ ($CellContext`Hvrel + \ $CellContext`\[Phi]rel), $CellContext`r$$ $CellContext`Hprel], \ $CellContext`r$$], ($CellContext`r$$ + $CellContext`\[Alpha]) Cos[$CellContext`t] Cos[$CellContext`u], ($CellContext`r$$ + $CellContext`\[Alpha]) Sin[$CellContext`t] Cos[$CellContext`u]}, {$CellContext`t, 0, 2 Pi}, {$CellContext`u, (-Pi)/2, Pi/2}, PlotStyle -> { Opacity[0.2], Blue}, Mesh -> None]; $CellContext`latticecastice2 = ParametricPlot3D[{(-($CellContext`r$$ + $CellContext`\[Alpha])) Sin[$CellContext`u] + If[$CellContext`B3, If[$CellContext`B4, $CellContext`r$$ ($CellContext`Hvrel + \ $CellContext`\[Phi]rel), $CellContext`r$$ $CellContext`Hprel], \ $CellContext`r$$], (-($CellContext`r$$ + $CellContext`\[Alpha])) Cos[$CellContext`t] Cos[$CellContext`u], (-($CellContext`r$$ + $CellContext`\[Alpha])) Sin[$CellContext`t] Cos[$CellContext`u]}, {$CellContext`t, 0, 2 Pi}, {$CellContext`u, (-Pi)/2, Pi/2}, PlotStyle -> { Opacity[0.2], Blue}, Mesh -> None]; If[$CellContext`valec, $CellContext`Val = ParametricPlot3D[{$CellContext`u, $CellContext`arel \ $CellContext`r$$ Cos[$CellContext`t], $CellContext`arel $CellContext`r$$ Sin[$CellContext`t]}, {$CellContext`t, 0, 2 Pi}, {$CellContext`u, $CellContext`r$$ (-$CellContext`Hvrel), \ $CellContext`r$$ $CellContext`Hvrel}, PlotStyle -> Red]; $CellContext`Valcastice1 = ParametricPlot3D[{$CellContext`r$$ Sin[$CellContext`u] - $CellContext`r$$ ($CellContext`Hvrel + \ $CellContext`\[Phi]rel), $CellContext`r$$ Cos[$CellContext`t] Cos[$CellContext`u], $CellContext`r$$ Sin[$CellContext`t] Cos[$CellContext`u]}, {$CellContext`t, 0, 2 Pi}, {$CellContext`u, (-Pi)/2, Pi/2 - $CellContext`alpha}]; $CellContext`Valcastice2 = ParametricPlot3D[{(-$CellContext`r$$) Sin[$CellContext`u] + $CellContext`r$$ ($CellContext`Hvrel + \ $CellContext`\[Phi]rel), (-$CellContext`r$$) Cos[$CellContext`t] Cos[$CellContext`u], (-$CellContext`r$$) Sin[$CellContext`t] Cos[$CellContext`u]}, {$CellContext`t, 0, 2 Pi}, {$CellContext`u, (-Pi)/2, Pi/2 - $CellContext`alpha}], $CellContext`Val = ParametricPlot3D[{$CellContext`u, $CellContext`r$$ Cos[$CellContext`t], $CellContext`r$$ Sin[$CellContext`t]}, {$CellContext`t, 0, 2 Pi}, {$CellContext`u, $CellContext`r$$ (-$CellContext`Hvrel), \ $CellContext`r$$ $CellContext`Hvrel}, PlotStyle -> Red]; $CellContext`Valcastice1 = ParametricPlot3D[{$CellContext`r$$ Sin[$CellContext`u] - $CellContext`r$$ $CellContext`Hvrel, \ $CellContext`r$$ Cos[$CellContext`t] Cos[$CellContext`u], $CellContext`r$$ Sin[$CellContext`t] Cos[$CellContext`u]}, {$CellContext`t, 0, 2 Pi}, {$CellContext`u, (-Pi)/2, 0}]; $CellContext`Valcastice2 = ParametricPlot3D[{(-$CellContext`r$$) Sin[$CellContext`u] + $CellContext`r$$ $CellContext`Hvrel, \ (-$CellContext`r$$) Cos[$CellContext`t] Cos[$CellContext`u], (-$CellContext`r$$) Sin[$CellContext`t] Cos[$CellContext`u]}, {$CellContext`t, 0, 2 Pi}, {$CellContext`u, (-Pi)/2, 0}]]; $CellContext`Par1 = ParametricPlot3D[{$CellContext`r$$ $CellContext`u - $CellContext`r$$ \ $CellContext`Hprel, $CellContext`r$$ ($CellContext`cp1 ($CellContext`u - \ $CellContext`Hprel)^2 + $CellContext`cp2) Cos[$CellContext`t], $CellContext`r$$ ($CellContext`cp1 \ ($CellContext`u - $CellContext`Hprel)^2 + $CellContext`cp2) Sin[$CellContext`t]}, {$CellContext`t, 0, 2 Pi}, {$CellContext`u, $CellContext`\[Phi]rel, $CellContext`Hprel}, PlotStyle -> Red]; $CellContext`Parcastice1 = ParametricPlot3D[{$CellContext`r$$ Sin[$CellContext`u] - $CellContext`r$$ $CellContext`Hprel, \ $CellContext`r$$ Cos[$CellContext`t] Cos[$CellContext`u], $CellContext`r$$ Sin[$CellContext`t] Cos[$CellContext`u]}, {$CellContext`t, 0, 2 Pi}, {$CellContext`u, (-Pi)/2, Pi/2 - $CellContext`alpha}]; $CellContext`Par2 = ParametricPlot3D[{(-$CellContext`r$$) $CellContext`u + \ $CellContext`r$$ $CellContext`Hprel, (-$CellContext`r$$) ($CellContext`cp1 \ ($CellContext`u - $CellContext`Hprel)^2 + $CellContext`cp2) Cos[$CellContext`t], (-$CellContext`r$$) ($CellContext`cp1 \ ($CellContext`u - $CellContext`Hprel)^2 + $CellContext`cp2) Sin[$CellContext`t]}, {$CellContext`t, 0, 2 Pi}, {$CellContext`u, $CellContext`\[Phi]rel, $CellContext`Hprel}, PlotStyle -> Red]; $CellContext`Parcastice2 = ParametricPlot3D[{(-$CellContext`r$$) Sin[$CellContext`u] + $CellContext`r$$ $CellContext`Hprel, \ (-$CellContext`r$$) Cos[$CellContext`t] Cos[$CellContext`u], (-$CellContext`r$$) Sin[$CellContext`t] Cos[$CellContext`u]}, {$CellContext`t, 0, 2 Pi}, {$CellContext`u, (-Pi)/2, Pi/2 - $CellContext`alpha}]; Show[ If[$CellContext`B1, {$CellContext`latticecastice1, \ $CellContext`latticecastice2}, {}], If[$CellContext`B3, If[$CellContext`B4, {$CellContext`Val, $CellContext`Valcastice1, \ $CellContext`Valcastice2}, {$CellContext`Par1, $CellContext`Par2, \ $CellContext`Parcastice1, $CellContext`Parcastice2}], If[$CellContext`B2, {$CellContext`castice1p1, \ $CellContext`castice1p2, $CellContext`castice2p1, $CellContext`castice2p2}, \ {$CellContext`castice1, $CellContext`castice2}]], PlotRange -> Automatic]), "Specifications" :> {{$CellContext`r$$, Rational[1, 1000000000], Rational[1, 20000000], ControlPlacement -> 1}, {$CellContext`T$$, 0, 3285, ControlPlacement -> 2}, Grid[{{"Nps type", Null, Null, Null, Null, PopupMenu[$CellContext`Ta, {$CellContext`Ta, $CellContext`Cu, \ $CellContext`Au, $CellContext`Ag}]}, {"Lattice constant", Checkbox[ Dynamic[$CellContext`B1]]}, { "\!\(\*SubscriptBox[\(V\), \(molten\)]\)", Checkbox[ Dynamic[$CellContext`B2]]}, {"Neck", Checkbox[ Dynamic[$CellContext`B3]], Null, "valec", RadioButton[ Dynamic[$CellContext`B4], True, Enabled -> Dynamic[$CellContext`B3]]}, {Null, Null, Null, "parabola", RadioButton[ Dynamic[$CellContext`B4], False, Enabled -> Dynamic[$CellContext`B3]]}, {"Nps radius", Null, Manipulate`Place[1], Dynamic[ NumberForm[$CellContext`r$$, 2]], "[m]"}, { "Nps temperature", Null, Manipulate`Place[2], Dynamic[$CellContext`T$$], "[K]"}}]}, "Options" :> {}, "DefaultOptions" :> {}], ImageSizeCache->{591., {323., 330.}}, SingleEvaluation->True], Deinitialization:>None, DynamicModuleValues:>{}, SynchronousInitialization->True, UndoTrackedVariables:>{Typeset`show$$, Typeset`bookmarkMode$$}, UnsavedVariables:>{Typeset`initDone$$}, UntrackedVariables:>{Typeset`size$$}], "Manipulate", Deployed->True, StripOnInput->False], Manipulate`InterpretManipulate[1]], DynamicModuleValues:>{}]], "Output", CellChangeTimes->{{3.703186721882881*^9, 3.703186732789452*^9}, { 3.7031868526827836`*^9, 3.7031869000501194`*^9}, 3.7031875214426374`*^9, { 3.7031875777235947`*^9, 3.7031876082121816`*^9}, 3.7031876489703484`*^9, 3.703188275874764*^9, {3.703244837953121*^9, 3.7032448813124557`*^9}},ExpressionUUID->"1be487c1-8f6f-4244-b8e3-\ c8af1e2a9858"] }, Open ]] }, WindowSize->{1536, 781}, WindowMargins->{{-8, Automatic}, {Automatic, -8}}, FrontEndVersion->"11.1 for Microsoft Windows (64-bit) (March 13, 2017)", StyleDefinitions->"Default.nb" ] (* End of Notebook Content *) (* Internal cache information *) (*CellTagsOutline CellTagsIndex->{} *) (*CellTagsIndex CellTagsIndex->{} *) (*NotebookFileOutline Notebook[{ Cell[CellGroupData[{ Cell[580, 22, 51505, 1137, 3556, "Input", "ExpressionUUID" -> \ "bc3adc0c-6fa8-45da-ba2b-2046239c9f54"], Cell[52088, 1161, 17899, 319, 670, "Output", "ExpressionUUID" -> \ "1be487c1-8f6f-4244-b8e3-c8af1e2a9858"] }, Open ]] } ] *)