Find all spectroscopic terms for equivalent electrons-- D.English 3/5/05

Make a list of all {(Subscript[m, S]), (Subscript[m, L])} for a given S and L

buildList[{S_, 
          L_}] := 
Flatten[
Table[{ms, 
            ml}, {ml, -L, L}, {ms, -S, 
            S}], 
1]

Removes from a list all {(Subscript[m, S]), 
        (Subscript[m, L])} pairs for the highest (Subscript[m, S]) in alist

RemoveTerm[l_] := 
      Block[{S = -l[[1, 1]], 
          L = -l[[1, 2]], rlist, 
          llen = Length[l], newl = l}, 
rlist = 
          buildList[{S, 
              L}]; 
(newl = 
                DeleteCases[newl, #, 1, 1]) & /@ 
          rlist; 
Print["Removed ", 
          llen - Length[
              newl], "=", (2  S + 1) (2  L + 
                1), " terms associated with ", {S, L}, 
          DisplayForm[SuperscriptBox[" ", 2  S + 1]], 
          StringTake["SPDFGHIJKLMNOP", {L + 
                1}]]; 
newl
]

Recursively remove multiplets from alist until there are none left

IDall[l_] := 
      If[Length[l] == 0, Print["All done"], 
        IDall[RemoveTerm[l]]]

Make a list of all combinations of n elements of a list ℓ

Combs[ℓ_, n_] := 
      Block[{}, 
If[Length[ℓ] == n, 
          Return[{ℓ}]]; 
If[n == 0, 
          Return[{{}}]]; 
Join[
Prepend[#, 
                First[ℓ]] & /@ 
            Combs[Rest[ℓ], n - 1], 
Combs[
            Rest[ℓ], 
            n]
]
]

Find all the terms for n electrons of type Lcode (a string "s", "p", etc...)

Terms[n_, Lcode_] := 
      Block[
{L = StringPosition["spdfghijkl", 
                  Lcode][[1, 1]] - 
              1, 
termList, combList, 
          totlList
}, 
termList = 
          buildList[{(1/2), L}]; 
combList = 
          Combs[termList, n]; 
totlList = 
          Total /@ combList // Sort; 
IDall[
          totlList];
]

Examples...

Terms[3, "p"]

Terms[2, "d"]

Terms[3, "f"]