First pass of a Clebsch-Gordon computation functions, used to compute coefficients for (Subscript[l, 1 ])= 2, (Subscript[l, 2])= 1.

ClearAll[lower, lowerKet, lowerTwo, sumByList, lowerAll, formatKetTot, formatKetInd, formatKetList, normalPair]

(*Boole does this: http://mathematica.stackexchange.com/a/100113/10 .*)
(*boolToNum[ e_ ] := (e /. False -> 0 /. True -> 1 )*)

(*Compute the lowering coefficient √(l+m)(l-m+1)
input ket stored as a list {l,m}
 *)
lower[ket_, mmin_] := Module[{l,m},
{l,m} = ket ;
Boole[m ≥ mmin] 
Sqrt[(l+m)(l-m+1)] 
] 

(*|l,m> -> |l,m-1>
input ket stored as a list {l,m}
 *)
lowerKet[ket_, d_ :  1] := {ket[[1]], ket[[2]]-d} 

(*
|l1,m1 ; l2, m2> -> ((SubMinus[L])^1)|l1,m1 ; l2, m2> + ((SubMinus[L])^2)|l1,m1 ; l2, m2>

Input ket stored as a set of two kets and a numeric coefficent c:

{c, k1, k2}, where k1 = {l1, m1}, k2 = {l2,m2}

output is a list of the form:
{{c', k1', k2'}, {c'', k1'', k2''}}

List input param mmin are the minimum values of m1, m2 respectively.
*)
lowerTwo[in_, mmin_List] := Module[{r1, r2, c, k1, k2}, {c, {k1,k2}} = in ;
r1 = { c lower[k1, mmin[[1]]],{lowerKet[k1], k2}} ;
r2 ={ c lower[ k2, mmin[[2]]] ,{k1, lowerKet[k2]}} ;
{r1, r2}
]

(*Given a list
l = {{v_1,k_1}, {v_2, k_2}, ...} 
find and sum the v_i values for any k_j == k
*)
sumByList[l_,k_] := #[[1]] &/@ Select[l, #[[2]] == k &] // Total;

(*
apply lowerTwo to all elements in a list (sum) of kets, weed out any zeros and merge (sum) the coefficients for any kets that are duplicated.
Each coefficient is divided by scale.
 *)
lowerAll[in_, mmin_List, scale_] := Module[{lowered, flattened, nonzero, kets},
lowered = lowerTwo[#, mmin] & /@ in ;
flattened = Flatten[lowered, 1] ;
nonzero = Select[flattened, #[[1]] ≠ 0 & ] ;
kets = (#[[2]] &/@ nonzero) // DeleteDuplicates ;
{sumByList[nonzero, #]/scale // Simplify, #} &/@ kets
]




(*A display method for a total angular momentum ket {l,m}*)
formatKetTot[k_] := Row[{"\[VerticalSeparator]",k[[1]],",", k[[2]],"⟩"}] ;
(*A display method for an individual two particle ket {c, {{l1, m1},{l2,m2}}}
*)
formatKetInd[k_] := Module[{c,k1, k2},
c = k // First ;
{k1, k2} = k// Last ;Row[{c,"\[VerticalSeparator]",k1[[1]],",", k1[[2]], ";", k2[[1]],",", k2[[2]],"⟩"}] 
]
formatKetList[k_] := formatKetInd[#] &/@ k ;



normalPair[k_] := Module[{c1, k1, c2,k2},
{c1, k1} = First[k] ;
{c2, k2} = Last[k] ;
{{c2, k1}, {-c1, k2}}
]

Compute the Clebsch-Gordon coefficients for (Subscript[l, 1 ])= 2, (Subscript[l, 2])= 1.

l1=1;
l2=1/2;
lt=l1+l2;
kt11={lt,lt};
minM=-{l1,l2};
k11={{1,{{1,1},{1/2,1/2}}}};
k12=lowerAll[k11,minM,lower[kt11,-lt]];
kt12=lowerKet[kt11];
k13=lowerAll[k12,minM,lower[kt12,-lt]];
kt13=lowerKet[kt12];
k14=lowerAll[k13,minM,lower[kt13,-lt]];
kt14=lowerKet[kt13];

k21=normalPair[k12];
kt21={1/2,1/2};
k22=lowerAll[k21,minM,lower[kt21,-lt]];

formatKetList[k11]
formatKetList[k12]
formatKetList[k13]
formatKetList[k14]

formatKetList[k21]
formatKetList[k22]