(* 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[      6893,        206]
NotebookOptionsPosition[      6351,        184]
NotebookOutlinePosition[      6829,        203]
CellTagsIndexPosition[      6786,        200]
WindowFrame->Normal
ContainsDynamic->False*)

(* Beginning of Notebook Content *)
Notebook[{
Cell["\<\
(* Curvature Template *)

(* F[u_,v_]:=r*Cos[v]*Cos[u]; *)   (* Definition of Longitude/Latitude \
Coordinate Mapping *) 
(* G[u_,v_]:=r*Cos[v]*Sin[u]; *)   (* for Sphere *)
(* H[u_,v_]:=r*Sin[v]; *)

(* F[u_,v_]:=r*((2*u)/(u^2+v^2+1)); *)         (* Definition of Stereographic \
Coordinate *) 
(* G[u_,v_]:=r*((2*v)/(u^2+v^2+1)); *)         (* Mapping for Sphere *)
(* H[u_,v_]:=r*((u^2+v^2-1)/(u^2+v^2+1)); *)

(* F[u_,v_]:=a*Cos[v]*Cos[u]; *)    (* Definition of Coordinate Mapping for \
Ellipsoid *)
(* G[u_,v_]:=b*Cos[v]*Sin[u]; *) 
(* H[u_,v_]:=c*Sin[v]; *)       

(* F[u_,v_]:=(s+r*Cos[v])*Cos[u]; *)      (* Definition of Coordinate Mapping \
for Torus *)
(* G[u_,v_]:=(s+r*Cos[v])*Sin[u]; *)   
(* H[u_,v_]:=r*Sin[v]; *)  

(* f[u_]:=1/u; *)
(* g[u_]:=u; *)
F[u_,v_]:=f[u]*Cos[v];\t    (* Definition of Coordinate Mapping for \
Cylindrical *)
G[u_,v_]:=f[u]*Sin[v];\t\t(* Surface with Profile Functions f[u] and g[u] *) 
H[u_,v_]:=g[u];

(* F[u_,v_]:=Cosh[u]*Cos[v]; *)\t    (* Definition of Coordinate Mapping for \
Particular *)
(* G[u_,v_]:=Cosh[u]*Sin[v]; *)\t\t(* Cylindrical Surface with Profile \
Functions Cosh[u] *) 
(* H[u_,v_]:=Sinh[u]; *)            (* and Sinh[u] *)

(* F[u_,v_]:=; *)   (* General Coordinate Mapping *)
(* G[u_,v_]:=; *)
(* H[u_,v_]:=; *)

Fu[u_,v_]:=D[F[u,v],u];\t\t(* Jacobian of Coordinate Mapping *)
Fv[u_,v_]:=D[F[u,v],v];
Gu[u_,v_]:=D[G[u,v],u];
Gv[u_,v_]:=D[G[u,v],v];
Hu[u_,v_]:=D[H[u,v],u];
Hv[u_,v_]:=D[H[u,v],v];

Fuu[u_,v_]:=D[Fu[u,v],u];\t\t(* Second Derivatives *)
Fuv[u_,v_]:=D[Fu[u,v],v];
Fvu[u_,v_]:=D[Fv[u,v],u];
Fvv[u_,v_]:=D[Fv[u,v],v];
Guu[u_,v_]:=D[Gu[u,v],u];
Guv[u_,v_]:=D[Gu[u,v],v];
Gvu[u_,v_]:=D[Gv[u,v],u];
Gvv[u_,v_]:=D[Gv[u,v],v];
Huu[u_,v_]:=D[Hu[u,v],u];
Huv[u_,v_]:=D[Hu[u,v],v];
Hvu[u_,v_]:=D[Hv[u,v],u];
Hvv[u_,v_]:=D[Hv[u,v],v];

FFFuu[u_,v_]:=Fu[u,v]*Fu[u,v]+Gu[u,v]*Gu[u,v]+Hu[u,v]*Hu[u,v];\t(* First \
Fundamental Form *)
FFFuv[u_,v_]:=Fu[u,v]*Fv[u,v]+Gu[u,v]*Gv[u,v]+Hu[u,v]*Hv[u,v];
FFFvu[u_,v_]:=Fv[u,v]*Fu[u,v]+Gv[u,v]*Gu[u,v]+Hv[u,v]*Hu[u,v];
FFFvv[u_,v_]:=Fv[u,v]*Fv[u,v]+Gv[u,v]*Gv[u,v]+Hv[u,v]*Hv[u,v];

PP[u_,v_]:=Gu[u,v]*Hv[u,v]-Hu[u,v]*Gv[u,v];\t\t(* Cross Product *)
QQ[u_,v_]:=Hu[u,v]*Fv[u,v]-Fu[u,v]*Hv[u,v];
RR[u_,v_]:=Fu[u,v]*Gv[u,v]-Gu[u,v]*Fv[u,v];

DD[u_,v_]:=PP[u,v]*PP[u,v]+QQ[u,v]*QQ[u,v]+RR[u,v]*RR[u,v];\t\t(* Norm *)
EE[u_,v_]:=Sqrt[DD[u,v]];

LL[u_,v_]:=PP[u,v]/EE[u,v];\t\t(* Normalization *)
MM[u_,v_]:=QQ[u,v]/EE[u,v];
NN[u_,v_]:=RR[u,v]/EE[u,v];

SFFuu[u_,v_]:=Fuu[u,v]*LL[u,v]+Guu[u,v]*MM[u,v]+Huu[u,v]*NN[u,v];\t(* Second \
Fundamental *)  
SFFuv[u_,v_]:=Fuv[u,v]*LL[u,v]+Guv[u,v]*MM[u,v]+Huv[u,v]*NN[u,v];\t(* Form *)
SFFvu[u_,v_]:=Fvu[u,v]*LL[u,v]+Gvu[u,v]*MM[u,v]+Hvu[u,v]*NN[u,v];
SFFvv[u_,v_]:=Fvv[u,v]*LL[u,v]+Gvv[u,v]*MM[u,v]+Hvv[u,v]*NN[u,v];

XX[u_,v_]:=FFFuu[u,v]*FFFvv[u,v]-FFFvu[u,v]*FFFuv[u,v];\t\t(* Determinants *)
YY[u_,v_]:=SFFuu[u,v]*SFFvv[u,v]-SFFvu[u,v]*SFFuv[u,v];

KK[u_,v_]:=YY[u,v]/XX[u,v];\t\t(* Ratio: the Curvature *)
\
\>", "Input",
 CellChangeTimes->{{3.402763830992558*^9, 3.402763917916519*^9}, {
  3.40276395290476*^9, 3.402763971377486*^9}, {3.40276430742645*^9, 
  3.4027643696232967`*^9}, {3.402764477508917*^9, 3.40276447772155*^9}, {
  3.40390555965106*^9, 3.4039055812742157`*^9}, {3.4039056118353767`*^9, 
  3.403905805463848*^9}, {3.403905840339959*^9, 3.4039058523076344`*^9}, {
  3.403906012058404*^9, 3.403906012522147*^9}, {3.405804038787219*^9, 
  3.405804073443071*^9}, {3.4058049619144897`*^9, 3.4058049783812017`*^9}, {
  3.405805050745706*^9, 3.4058050529637527`*^9}, {3.4058051612152452`*^9, 
  3.405805181215218*^9}, {3.405805245694944*^9, 3.405805262510861*^9}, {
  3.40580537309522*^9, 3.4058054708305893`*^9}, {3.405805521750436*^9, 
  3.4058055334634132`*^9}, {3.405805576812798*^9, 3.4058055966691732`*^9}}],

Cell[CellGroupData[{

Cell["TWW=KK[u,v]; FullSimplify[TWW]", "Input",
 CellChangeTimes->{{3.4039059685723886`*^9, 3.4039059696109257`*^9}}],

Cell[BoxData[
 FractionBox[
  RowBox[{
   RowBox[{
    SuperscriptBox["g", "\[Prime]",
     MultilineFunction->None], "[", "u", "]"}], " ", 
   RowBox[{"(", 
    RowBox[{
     RowBox[{
      RowBox[{"-", 
       RowBox[{
        SuperscriptBox["g", "\[Prime]",
         MultilineFunction->None], "[", "u", "]"}]}], " ", 
      RowBox[{
       SuperscriptBox["f", "\[Prime]\[Prime]",
        MultilineFunction->None], "[", "u", "]"}]}], "+", 
     RowBox[{
      RowBox[{
       SuperscriptBox["f", "\[Prime]",
        MultilineFunction->None], "[", "u", "]"}], " ", 
      RowBox[{
       SuperscriptBox["g", "\[Prime]\[Prime]",
        MultilineFunction->None], "[", "u", "]"}]}]}], ")"}]}], 
  RowBox[{
   RowBox[{"f", "[", "u", "]"}], " ", 
   SuperscriptBox[
    RowBox[{"(", 
     RowBox[{
      SuperscriptBox[
       RowBox[{
        SuperscriptBox["f", "\[Prime]",
         MultilineFunction->None], "[", "u", "]"}], "2"], "+", 
      SuperscriptBox[
       RowBox[{
        SuperscriptBox["g", "\[Prime]",
         MultilineFunction->None], "[", "u", "]"}], "2"]}], ")"}], 
    "2"]}]]], "Output",
 CellChangeTimes->{
  3.4039058753959227`*^9, 3.403905979575646*^9, 3.405804095796826*^9, 
   3.405804994638612*^9, 3.405805062412208*^9, 3.405805189612854*^9, 
   3.405805274449506*^9, 3.4058054485475817`*^9, 3.405805541446851*^9, {
   3.405805607810111*^9, 3.405805618118198*^9}, 3.405805812395227*^9}]
}, Open  ]],

Cell["\<\
(* f1[u_]:=D[f[u],u]; *)\t\t\t(* Conditions on f, g:  f1*f1+g1*g1=1, \
f1*f2+g1*g2=0 *) 
(* f2[u_]:=D[f1[u],u]; *)
(* g1[u_]:=D[g[u],u]; *)
(* g2[u_]:=D[g1[u],u]; *)

(* Simplify[TWW,f1[u]*f1[u]+g1[u]*g1[u]==1 && f1[u]*f2[u]+g1[u]*g2[u]==0] *)
\t\t(*  Simplify Subject to Conditions on f[u] and g[u]  *) \
\>", "Input",
 CellChangeTimes->{
  3.4027641176329517`*^9, {3.402764401937872*^9, 3.402764440205802*^9}}]
},
WindowSize->{868, 910},
WindowMargins->{{39, Automatic}, {4, Automatic}},
DockedCells->FEPrivate`FrontEndResource[
 "FEExpressions", "CompatibilityToolbar"],
PrintingCopies->1,
PrintingPageRange->{1, Automatic},
FrontEndVersion->"6.0 for Mac OS X PowerPC (32-bit) (April 20, 2007)",
StyleDefinitions->"Default.nb"
]
(* End of Notebook Content *)

(* Internal cache information *)
(*CellTagsOutline
CellTagsIndex->{}
*)
(*CellTagsIndex
CellTagsIndex->{}
*)
(*NotebookFileOutline
Notebook[{
Cell[568, 21, 3786, 99, 1028, "Input"],
Cell[CellGroupData[{
Cell[4379, 124, 117, 1, 27, "Input"],
Cell[4499, 127, 1411, 41, 53, "Output"]
}, Open  ]],
Cell[5925, 171, 422, 11, 105, "Input"]
}
]
*)

(* End of internal cache information *)