(* Content-type: application/mathematica *) (*** Wolfram Notebook File ***) (* http://www.wolfram.com/nb *) (* CreatedBy='Mathematica 6.0' *) (*CacheID: 234*) (* Internal cache information: NotebookFileLineBreakTest NotebookFileLineBreakTest NotebookDataPosition[ 145, 7] NotebookDataLength[ 10835, 400] NotebookOptionsPosition[ 9281, 347] NotebookOutlinePosition[ 9733, 365] CellTagsIndexPosition[ 9690, 362] WindowFrame->Normal ContainsDynamic->False*) (* Beginning of Notebook Content *) Notebook[{ Cell[CellGroupData[{ Cell["Chen - Gackstatter with k - fold dihedral symmetry", "Title", CellChangeTimes->{{3.4077664189237137`*^9, 3.407766460767865*^9}}], Cell[BoxData[ RowBox[{"<<", "Own`Mesh`"}]], "Input"], Cell[CellGroupData[{ Cell["Weierstra\[SZ] Data", "Section", CellChangeTimes->{3.40776649074349*^9}], Cell["Use k >= 3", "Text", CellChangeTimes->{{3.407766469036078*^9, 3.407766476686974*^9}}], Cell[BoxData[{ RowBox[{ RowBox[{"k", "=", "3"}], ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{"exp", "=", RowBox[{ RowBox[{"(", RowBox[{"k", "-", "1"}], ")"}], "/", "k"}]}], ";"}]}], "Input"], Cell[BoxData[{ RowBox[{ RowBox[{ RowBox[{"fi1", "[", "z_", "]"}], ":=", RowBox[{ RowBox[{ RowBox[{"(", RowBox[{"1", "-", RowBox[{"z", "^", "2"}]}], " ", ")"}], "^", "exp"}], "/", RowBox[{"(", RowBox[{"z", "^", "exp"}], ")"}]}]}], ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{"fi2", "[", "z_", "]"}], ":=", " ", RowBox[{ RowBox[{"(", RowBox[{"z", "^", "exp"}], ")"}], "/", RowBox[{ RowBox[{"(", RowBox[{"1", "-", RowBox[{"z", "^", "2"}]}], " ", ")"}], "^", "exp"}]}]}], ";"}]}], "Input"], Cell[BoxData[ RowBox[{ RowBox[{"G", "[", "z_", "]"}], ":=", RowBox[{ SuperscriptBox["z", RowBox[{"-", "exp"}]], " ", SuperscriptBox[ RowBox[{"(", RowBox[{"1", "-", SuperscriptBox["z", "2"]}], ")"}], "exp"]}]}]], "Input"], Cell[BoxData[{ RowBox[{ RowBox[{ RowBox[{"phi1", "[", "z_", "]"}], ":=", RowBox[{"-", FractionBox[ RowBox[{ SuperscriptBox["z", RowBox[{"1", "-", "exp"}]], " ", RowBox[{"Hypergeometric2F1", "[", RowBox[{ FractionBox[ RowBox[{"1", "-", "exp"}], "2"], ",", RowBox[{"-", "exp"}], ",", RowBox[{"1", "+", FractionBox[ RowBox[{"1", "-", "exp"}], "2"]}], ",", SuperscriptBox["z", "2"]}], "]"}]}], RowBox[{ RowBox[{"-", "1"}], "+", "exp"}]]}]}], ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{"phi2", "[", "z_", "]"}], ":=", FractionBox[ RowBox[{ SuperscriptBox["z", RowBox[{"1", "+", "exp"}]], " ", RowBox[{"Hypergeometric2F1", "[", RowBox[{ FractionBox[ RowBox[{"1", "+", "exp"}], "2"], ",", "exp", ",", RowBox[{"1", "+", FractionBox[ RowBox[{"1", "+", "exp"}], "2"]}], ",", SuperscriptBox["z", "2"]}], "]"}]}], RowBox[{"1", "+", "exp"}]]}], ";"}]}], "Input"], Cell[BoxData[ StyleBox[ RowBox[{"\n", " ", "\n", RowBox[{ RowBox[{ RowBox[{"om1", "[", "z_", "]"}], " ", ":=", " ", RowBox[{ RowBox[{"(", RowBox[{ RowBox[{ RowBox[{"-", "rho"}], "*", RowBox[{"phi1", "[", "z", "]"}]}], " ", "+", " ", RowBox[{ RowBox[{"phi2", "[", "z", "]"}], "/", "rho"}]}], ")"}], "/", "2"}]}], ";"}]}], ShowStringCharacters->True, NumberMarks->True]], "Input"], Cell[BoxData[ StyleBox[ RowBox[{"\n", " ", "\n", RowBox[{ RowBox[{ RowBox[{"om2", "[", "z_", "]"}], " ", ":=", " ", RowBox[{"I", "*", RowBox[{ RowBox[{"(", RowBox[{ RowBox[{"rho", "*", RowBox[{"phi1", "[", "z", "]"}]}], " ", "+", " ", RowBox[{ RowBox[{"phi2", "[", "z", "]"}], "/", "rho"}]}], ")"}], "/", "2"}]}]}], ";"}]}], ShowStringCharacters->True, NumberMarks->True]], "Input"], Cell[BoxData[ StyleBox[ RowBox[{" ", "\n", RowBox[{ RowBox[{ RowBox[{"om3", "[", "z_", "]"}], " ", ":=", " ", "z"}], ";"}]}], ShowStringCharacters->True, NumberMarks->True]], "Input"], Cell[BoxData[ RowBox[{ RowBox[{"rho", "=", RowBox[{ RowBox[{"1", "/", RowBox[{"Sqrt", "[", FractionBox[ RowBox[{ SuperscriptBox["4", "exp"], " ", RowBox[{"Gamma", "[", RowBox[{ FractionBox["3", "2"], "-", FractionBox["exp", "2"]}], "]"}], " ", RowBox[{"Gamma", "[", RowBox[{"1", "+", FractionBox["exp", "2"]}], "]"}]}], RowBox[{ RowBox[{"Gamma", "[", RowBox[{"1", "-", FractionBox["exp", "2"]}], "]"}], " ", RowBox[{"Gamma", "[", FractionBox[ RowBox[{"3", "+", "exp"}], "2"], "]"}]}]], "]"}]}], "//", "N"}]}], ";"}]], "Input"], Cell[BoxData[ RowBox[{ RowBox[{"f", "[", "z_", "]"}], ":=", RowBox[{"Re", "[", RowBox[{"{", RowBox[{ RowBox[{"om1", "[", "z", "]"}], ",", RowBox[{"om2", "[", "z", "]"}], ",", RowBox[{"om3", "[", "z", "]"}]}], "}"}], "]"}]}]], "Input"], Cell[BoxData[ RowBox[{ RowBox[{"n", "[", "z_", "]"}], ":=", RowBox[{"StereographicProjection", "[", RowBox[{"rho", " ", RowBox[{"G", "[", "z", "]"}]}], "]"}]}]], "Input"] }, Open ]], Cell[CellGroupData[{ Cell["Parametrization", "Section", CellChangeTimes->{{3.407766500107359*^9, 3.407766504777317*^9}}], Cell[BoxData[""], "Input"], Cell[BoxData[{ RowBox[{ RowBox[{"r1", "=", "2."}], ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{"nr1", "=", "8"}], ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{"nr2", "=", "8"}], ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{"nt", "=", "15"}], ";"}]}], "Input"], Cell[BoxData[ RowBox[{ RowBox[{"dm", "=", RowBox[{"RectangularDomain", "[", RowBox[{ RowBox[{ RowBox[{"NRange", "[", RowBox[{"0", ",", "1", ",", "nr1"}], "]"}], "\[Union]", RowBox[{"NRange", "[", RowBox[{"1", ",", "r1", ",", "nr2"}], "]"}]}], ",", RowBox[{"NRange", "[", RowBox[{"0", ",", RowBox[{"Pi", "/", "2."}], ",", "nt"}], "]"}]}], "]"}]}], ";"}]], "Input"], Cell[BoxData[{ RowBox[{ RowBox[{"\[Epsilon]", "=", "0.00000001"}], ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{"polar", "[", "z_", "]"}], ":=", RowBox[{ RowBox[{ RowBox[{"Re", "[", "z", "]"}], RowBox[{"E", "^", RowBox[{"(", RowBox[{"I", " ", RowBox[{"Im", "[", "z", "]"}]}], ")"}]}]}], "+", RowBox[{"\[Epsilon]", RowBox[{"(", RowBox[{"1", "+", "I"}], ")"}]}]}]}]}], "Input"], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{ RowBox[{"dm2", "=", RowBox[{"MeshApply", "[", RowBox[{"polar", ",", "dm"}], "]"}]}], ";"}]], "Input", CellChangeTimes->{3.407766519278495*^9}], Cell[BoxData[ RowBox[{"\[SkeletonIndicator]", "Domain", "\[SkeletonIndicator]"}]], "Output"] }, Open ]] }, Open ]], Cell[CellGroupData[{ Cell["Plotting", "Section"], Cell[BoxData[ RowBox[{ RowBox[{"p1", "=", RowBox[{"MeshPlot3D", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"f", "[", RowBox[{"x", "+", RowBox[{"I", " ", "y"}]}], "]"}], ",", RowBox[{"n", "[", RowBox[{"x", "+", RowBox[{"I", " ", "y"}]}], "]"}]}], "}"}], ",", RowBox[{"{", RowBox[{"x", ",", "y"}], "}"}], ",", "dm2"}], "]"}]}], ";"}]], "Input"], Cell[BoxData[ RowBox[{ RowBox[{"gr", "=", RowBox[{"Mesh3DToGraphics3D", "[", "p1", "]"}]}], ";"}]], "Input"], Cell[BoxData[ RowBox[{ RowBox[{"p2", "=", RowBox[{"MeshJoin", "[", RowBox[{"p1", ",", RowBox[{"MeshRotate", "[", RowBox[{"p1", ",", RowBox[{"StraightLine", "[", RowBox[{ RowBox[{"{", RowBox[{"0", ",", "0", ",", "0"}], "}"}], ",", RowBox[{"f", "[", "I", "]"}]}], "]"}]}], "]"}]}], "]"}]}], ";"}]], "Input"], Cell[BoxData[ RowBox[{ RowBox[{"p3", "=", RowBox[{"MeshJoin", "[", RowBox[{"p2", ",", RowBox[{"MeshReflect", "[", RowBox[{"p2", ",", RowBox[{"Plane", "[", RowBox[{ RowBox[{"{", RowBox[{"0", ",", "1", ",", "0"}], "}"}], ",", "0"}], "]"}]}], "]"}]}], "]"}]}], ";"}]], "Input"], Cell[BoxData[ RowBox[{ RowBox[{"p4", "=", RowBox[{"MeshJoin", "@@", RowBox[{"Table", "[", RowBox[{ RowBox[{"MeshRotateZ", "[", RowBox[{"p3", ",", RowBox[{"i", " ", "2", RowBox[{"Pi", "/", "k"}]}], ",", "0"}], "]"}], ",", RowBox[{"{", RowBox[{"i", ",", "0", ",", RowBox[{"k", "-", "1"}]}], "}"}]}], "]"}]}]}], ";"}]], "Input", CellChangeTimes->{3.407766543451438*^9}], Cell[BoxData[ RowBox[{"Show", "[", RowBox[{ RowBox[{"gr", "=", RowBox[{"Mesh3DToGraphics3D", "[", "p4", "]"}]}], ",", RowBox[{"Axes", "\[Rule]", "True"}], ",", RowBox[{"AxesLabel", "\[Rule]", RowBox[{"{", RowBox[{"x", ",", "y", ",", "z"}], "}"}]}]}], "]"}]], "Input", CellChangeTimes->{{3.4077665538658247`*^9, 3.407766596890141*^9}}] }, Open ]] }, Open ]] }, WindowSize->{688, 766}, WindowMargins->{{Automatic, 182}, {Automatic, 45}}, DockedCells->(FrontEndExecute[{ FrontEnd`NotebookApply[ FrontEnd`InputNotebook[], #, Placeholder]}]& ), FrontEndVersion->"6.0 for Mac OS X PowerPC (32-bit) (June 19, 2007)", StyleDefinitions->"Default.nb" ] (* End of Notebook Content *) (* Internal cache information *) (*CellTagsOutline CellTagsIndex->{} *) (*CellTagsIndex CellTagsIndex->{} *) (*NotebookFileOutline Notebook[{ Cell[CellGroupData[{ Cell[590, 23, 136, 1, 123, "Title"], Cell[729, 26, 53, 1, 27, "Input"], Cell[CellGroupData[{ Cell[807, 31, 79, 1, 67, "Section"], Cell[889, 34, 92, 1, 26, "Text"], Cell[984, 37, 214, 7, 43, "Input"], Cell[1201, 46, 591, 21, 43, "Input"], Cell[1795, 69, 255, 9, 34, "Input"], Cell[2053, 80, 1081, 35, 106, "Input"], Cell[3137, 117, 468, 16, 58, "Input"], Cell[3608, 135, 479, 16, 58, "Input"], Cell[4090, 153, 203, 7, 43, "Input"], Cell[4296, 162, 704, 23, 63, "Input"], Cell[5003, 187, 266, 8, 27, "Input"], Cell[5272, 197, 185, 5, 27, "Input"] }, Open ]], Cell[CellGroupData[{ Cell[5494, 207, 100, 1, 67, "Section"], Cell[5597, 210, 26, 0, 27, "Input"], Cell[5626, 212, 281, 8, 73, "Input"], Cell[5910, 222, 433, 13, 43, "Input"], Cell[6346, 237, 435, 14, 43, "Input"], Cell[CellGroupData[{ Cell[6806, 255, 178, 5, 27, "Input"], Cell[6987, 262, 93, 1, 27, "Output"] }, Open ]] }, Open ]], Cell[CellGroupData[{ Cell[7129, 269, 27, 0, 67, "Section"], Cell[7159, 271, 433, 14, 27, "Input"], Cell[7595, 287, 115, 3, 27, "Input"], Cell[7713, 292, 380, 12, 27, "Input"], Cell[8096, 306, 343, 11, 27, "Input"], Cell[8442, 319, 442, 13, 27, "Input"], Cell[8887, 334, 366, 9, 27, "Input"] }, Open ]] }, Open ]] } ] *) (* End of internal cache information *)