(* ::Package:: *)

BeginPackage["ThadStuff`"]

wignerd::usage = "wignerd[j,m,mp,\[Beta]] gives the Wigner d-matrix"
conj::usage="Replaces I by -I in an expression"
nineJSymbol::usage="nineJSymbol[{a,b,c},{d,e,f},{g,h,j}]"
CG::usage="fast ClebschGordan routine"
C::usage="Clebsch-Gordan \!\(\*SubsuperscriptBox[\(C\), \(l1, m1, l2, m2\), \(l3, m3\)]\)  "
rmat::usage="rmat[{l2,j2},{l1,j1}]=\[LeftAngleBracket]{l2,j2}||r||{l1,j1}\[RightAngleBracket]"
ThadForm::usage="Better Display of Matrices"
ThadPlot::usage="Plot[a,b,Style options,{xlabel,ylabel}] or Show[oldplot,{xlabel,ylabel}]"
ThadListPlot::usage="ListPlot[a,Style options,{xlabel,ylabel}]"
T::usage="Spherical Tensor \!\(\*SubsuperscriptBox[\(T\), \(l, m\), \(I, J\)]\) "
\[DoubleStruckCapitalI]::usage="Identity Matrix \!\(\*SubscriptBox[\"II\", \"g\"]\)"
toCart::usage="toCart[{\!\(\*SubscriptBox[\"a\", 
RowBox[{\"-\", \"1\"}]]\),\!\(\*SubscriptBox[\"a\", \"1\"]\),\!\(\*SubscriptBox[\"a\", \"1\"]\)}]={\!\(\*SubscriptBox[\"a\", \"x\"]\),\!\(\*SubscriptBox[\"a\", \"y\"]\),\!\(\*SubscriptBox[\"a\", \"z\"]\)}"
\[Flat]::usage="\[Flat][a],\[Flat][a,b] Flat Superoperator"
\[Sharp]::usage="\[Sharp][a],\[Sharp][a,b] Sharp Superoperator"
\[Copyright]::usage="\[Copyright][a] Commutator Superoperator"
diag::usage="diag[a] is diagonal matrix of vector a"
toL::usage="toL[M]convert Schrodinger matrix to Liouvile vector"
toS::usage="toS[M] converts Liouville vector to square Schrodinger matrix"
angmom::usage="angmom[jqn,j] constructs  matrices j[1]=\!\(\*SubscriptBox[\(J\), \(x\)]\),j[2]=\!\(\*SubscriptBox[\(J\), \(y\)]\),j[3]=\!\(\*SubscriptBox[\(J\), \(z\)]\)"
const::usage="list of constants, units eV, MHz, \[Micro]sec, cm, Gauss"
constunits::usage="list of constants, units eV, MHz, \[Micro]sec, cm, Gauss"
MF::usage="equiv to MatrixForm"
\[Epsilon]::usage="Signature"
\[Delta]::usage="Kronecker delta"
Begin["`Private`"]
<<Notation`
Notation[ParsedBoxWrapper[SubsuperscriptBox["T", RowBox[{"L_", ",", "M_"}], RowBox[{"j1_", ",", "j2_"}]]] \[DoubleLongLeftRightArrow] ParsedBoxWrapper[SubscriptBox[RowBox[{"T", "[", RowBox[{"j1_", ",", "j2_"}], "]"}], RowBox[{"L_", ",", "M_"}]]]]
Notation[ParsedBoxWrapper[SubsuperscriptBox["C", RowBox[{"j1_", ",", "m1_", ",", "j2_", ",", "m2_"}], RowBox[{"j3_", ",", "m3_"}]]] \[DoubleLongLeftRightArrow] ParsedBoxWrapper[RowBox[{"CG", "[", RowBox[{RowBox[{"{", RowBox[{"j1_", ",", "m1_"}], "}"}], ",", RowBox[{"{", RowBox[{"j2_", ",", "m2_"}], "}"}], ",", RowBox[{"{", RowBox[{"j3_", ",", "m3_"}], "}"}]}], "]"}]]]
Notation[ParsedBoxWrapper[RowBox[{"\[LeftAngleBracket]", RowBox[{"l2_", ",", RowBox[{"j2_", RowBox[{"\[LeftDoubleBracketingBar]", "r", "\[RightDoubleBracketingBar]"}], "l1_"}], ",", "j1_"}], "\[RightAngleBracket]"}]] \[DoubleLongLeftRightArrow] ParsedBoxWrapper[RowBox[{"rmat", "[", RowBox[{RowBox[{"{", RowBox[{"l2_", ",", "j2_"}], "}"}], ",", RowBox[{"{", RowBox[{"l1_", ",", "j1_"}], "}"}]}], "]"}]]]
Notation[ParsedBoxWrapper[SubsuperscriptBox[RowBox[{"\[LeftAngleBracket]", "r", "\[RightAngleBracket]"}], "l1_", "l2_"]] \[DoubleLongLeftRightArrow] ParsedBoxWrapper[RowBox[{"rmat0", "[", RowBox[{"l1_", ",", "l2_"}], "]"}]]]
\!\(\*
TagBox[
StyleBox[
RowBox[{"Notation", "[", 
RowBox[{"DoubleLongLeftRightArrow", "[", 
RowBox[{
RowBox[{"Notation`ParsedBoxWrapper", "[", 
RowBox[{"RowBox", "[", 
RowBox[{"List", "[", 
RowBox[{"\"\<\\[ScriptC]\>\"", ",", "\"\<[\>\"", ",", "\"\<x_\>\"", ",", "\"\<]\>\""}], "]"}], "]"}], "]"}], ",", 
RowBox[{"Notation`ParsedBoxWrapper", "[", 
RowBox[{"RowBox", "[", 
RowBox[{"List", "[", 
RowBox[{"\"\<Conjugate\>\"", ",", "\"\<[\>\"", ",", "\"\<x_\>\"", ",", "\"\<]\>\""}], "]"}], "]"}], "]"}]}], "]"}], "]"}],
ShowSpecialCharacters->False,
ShowStringCharacters->True,
NumberMarks->True],
FullForm]\)

CG[{a_,\[Alpha]_},{b_,\[Beta]_},{c_,\[Gamma]_}]:=If[c>a+b||c<Abs[a-b]||\[Gamma]!= \[Alpha]+\[Beta]||Abs[\[Alpha]]>a||Abs[\[Beta]]>b||Abs[\[Gamma]]>c,0,Sqrt[(a+b-c)!(a-b+c)!(-a+b+c)!/(a+b+c+1)!]Sqrt[(a+\[Alpha])!(a-\[Alpha])!(b+\[Beta])!(b-\[Beta])!(c+\[Gamma])!(c-\[Gamma])!(2c+1)]\!\(
\*UnderoverscriptBox[\(\[Sum]\), \(z = Max[0, b - c - \[Alpha], a + \[Beta] - c]\), \(Min[a + b - c, a - \[Alpha], b + \[Beta]]\)]
\*FractionBox[
SuperscriptBox[\((\(-1\))\), \(z\)], \(\(z!\) \(\((a + b - c - z)\)!\) \(\((a - \[Alpha] - z)\)!\) \(\((b + \[Beta] - z)\)!\) \(\((c - b + \[Alpha] + z)\)!\) \(\((c - a - \[Beta] + z)\)!\)\)]\)]
wignerd[j_,m_,mp_,\[Beta]_]:=Simplify[With[{\[Mu]=Abs[m-mp],\[Nu]=Abs[m+mp]},With[{s=j-(\[Mu]+\[Nu])/2},If[mp>=m,1,(-1)^(mp-m)]Sqrt[(s!(s+\[Mu]+\[Nu])!)/((s+\[Mu])!(s+\[Nu])!)]Sin[\[Beta]/2]^\[Mu] Cos[\[Beta]/2]^\[Nu] JacobiP[s,\[Mu],\[Nu],Cos[\[Beta]]]]]]
nineJSymbol[{a_, b_, c_}, {d_, e_, f_}, {g_, h_, j_}] := 
    Sum[(-1)^(2 x) (2  x + 1) SixJSymbol[{a, b, c}, {f, j, x}] SixJSymbol[{d, e, f}, {b, x, h}] SixJSymbol[{g, h, j}, {x, a, d}], {x, Abs[a - j], a + j}]
conj[x_]:=x/.Complex[a_,b_]->Complex[a,-b]
rmat[{l2_,j2_},{l1_,j1_}]:=(-1)^(j1+l2+3/2) Sqrt[(2j2+1)(2j1+1)]SixJSymbol[{j2,1,j1},{l1,1/2,l2}]rmat0[l1,l2]
rmat[{l2_,i_,j2_},{l1_,i_,j1_}]:=(-1)^(j1+l2+i+1) Sqrt[(2j2+1)(2j1+1)]SixJSymbol[{j2,1,j1},{l1,i,l2}]
ThadForm[q_]:=Quiet[NumberForm[MatrixForm[Chop[q]],3]]
ThadPlot[a_,b_,c_,d_]:=Plot[a,b,{c,AxesStyle->Directive[Black,18],GridLines->Automatic,GridLinesStyle->LightGray,Frame->True,Axes->False,
	FrameLabel->{Text[Style[d[[1]],FontSize->14]],Text[Style[d[[2]],FontSize->14]]},FrameStyle->{{Directive[GrayLevel[0],14],GrayLevel[1]},{Directive[GrayLevel[0],14],GrayLevel[1]}}}]
ThadPlot[a_,b_]:=Show[a,{AxesStyle->Directive[Black,18],GridLines->Automatic,GridLinesStyle->Directive[Thin,LightGray],Axes->False,Frame->True,FrameLabel->b,FrameStyle->{{Directive[GrayLevel[0],14],GrayLevel[1]},{Directive[GrayLevel[0],14],GrayLevel[1]}}}]
ThadListPlot[a_,c_,d_]:=ListPlot[a,{c,AxesStyle->Directive[Black,18],GridLines->Automatic,GridLinesStyle->LightGray,Frame->True,
	FrameLabel->{Text[Style[d[[1]],FontSize->14]],Text[Style[d[[2]],FontSize->14]]},FrameStyle->{{Directive[GrayLevel[0],14],GrayLevel[1]},{Directive[GrayLevel[0],14],GrayLevel[1]}}}]
a_\[CircleTimes]b_:=If[Length[Dimensions[a]]==Length[Dimensions[b]]==1,Flatten[KroneckerProduct[{a},{b}]], KroneckerProduct[a,b]]
a_\[CenterDot]b_:=\!\(
\*UnderoverscriptBox[\(\[Sum]\), \(p = 1\), \(3\)]\(a[p] . b[p]\)\)
angmom[jqn_]:=With[{jp=DiagonalMatrix[Table[Sqrt[jqn(jqn+1)-mqn(mqn+1)],{mqn,jqn-1,-jqn,-1}],1]},{(jp+jp\[Transpose])/2,(jp-jp\[Transpose])/(2I),DiagonalMatrix[Range[jqn,-jqn,-1]]}]
angmom[jqn_,j_]:=With[{jp=DiagonalMatrix[Table[Sqrt[jqn(jqn+1)-mqn(mqn+1)],{mqn,jqn-1,-jqn,-1}],1]},{j[1]=(jp+jp\[Transpose])/2,j[2]=(jp-jp\[Transpose])/(2I),j[3]=DiagonalMatrix[Range[jqn,-jqn,-1]]};]
toCart[{am_,a0_,ap_}]:={(am-ap)/Sqrt[2],(am+ap)/(-I Sqrt[2]),a0}

\[Flat][a_]:=Subscript[\[DoubleStruckCapitalI], Length[a]]\[CircleTimes]a
\[Sharp][a_]:=a\[Transpose]\[CircleTimes]Subscript[\[DoubleStruckCapitalI], Length[a]]
\[Flat][a_,b_]:=Subscript[\[DoubleStruckCapitalI], Length[b]]\[CircleTimes]a
\[Sharp][a_,b_]:=a\[Transpose]\[CircleTimes]Subscript[\[DoubleStruckCapitalI], Length[b]]
\[Copyright][a_]:=\[Flat][a]-\[Sharp][SuperDagger[a]]
diag[a_]:=DiagonalMatrix[a]
toL[a_]:=Flatten[a\[Transpose]]
toS[a_]:=Partition[a,Sqrt[Length[a]]]\[Transpose]
SuperStar[a_]:=a/.Complex[x_,y_]->Complex[x,-y]
SuperDagger[b_]:=Transpose[SuperStar[b]]
Subscript[\[DoubleStruckCapitalI], g_]:=IdentityMatrix[g]
Subscript[T[i_,j_], \[Lambda]_,m\[Lambda]_]:=With[{is=Range[i,-i,-1],js=Range[j,-j,-1]},Table[If[is[[a]]-js[[b]]==m\[Lambda]&&\[Lambda] <=Abs[i+j],(-1)^(j-js[[b]]) ClebschGordan[{i,is[[a]]},{j,-js[[b]]},{\[Lambda],m\[Lambda]}],0],{a,2i+1},{b,2j+1}]]
MF[q_]:=Quiet[NumberForm[MatrixForm[Chop[q]],3]]
Ket[a_]:={a}\[Transpose]
Bra[a_]:={SuperStar[a]}
BraKet[a_,b_]:=Bra[Flatten[a]] . Ket[Flatten[b]]//Tr
Subscript[\[DoubleStruckOne], n_]:=IdentityMatrix[n];
Subscript[\[Epsilon], i_,j_,k_] :=Signature[{i,j,k}];
Subscript[\[Delta], i_,j_]:=KroneckerDelta[i,j];
End[]
EndPackage[]





