Pensieve header: A trace for GDO at $k=1$.

SetDirectory["C:\\drorbn\\AcademicPensieve\\2018-08"];
<< ../Projects/SL2Invariant/SL2Invariant.m

$k=1;ℏ=1;γ=1;

(Subscript[tr, m_]):=(Subscript[(Subscript[𝔼, {m}->{}])[ (Subscript[β, m])(Subscript[b, m]),(( (Subscript[𝒜, m]) (1-(Subscript[B, m])))/( (Subscript[𝒜, m])-1))(Subscript[ξ, m])(Subscript[η, m])/ℏ,1+Sum[((ϵ^k)/((( (Subscript[𝒜, m])-1))^(k+l)))(Subscript[p, k,n,l])(Subscript[β, m]^n)((((Subscript[ξ, m])(Subscript[η, m])))^l), {k,$k},{n,0,2k},{l,1,2k-n}]], $k])

(Subscript[tr, m])

(Subscript[E, kk_]):=Block[{$k=kk}, (((-1+(Subscript[𝒜, i]) (Subscript[𝒜, j])))^(3$k))Coefficient[((Subscript[dm, i,j->m])//(Subscript[tr, m]))[[3]]-((Subscript[dm, j,i->m])//(Subscript[tr, m]))[[3]],ϵ,$k]//Together]

(Subscript[E, 0])

(Subscript[E, 1])

SolveAlways[(Subscript[E, 1])==0, {(Subscript[ξ, i]),(Subscript[ξ, j]),(Subscript[η, i]),(Subscript[η, j]),(Subscript[β, i]),(Subscript[β, j])(*,(Subscript[𝒜, i]),(Subscript[𝒜, j]),(Subscript[B, k])*)}]

{(Subscript[p, 1,0,1])=-(-1+(Subscript[B, m])) (Subscript[𝒜, m]),(Subscript[p, 1,0,2])=(1/4) (1-4 (Subscript[B, m])+3 (Subscript[B, m]^2)) (Subscript[𝒜, m]^2) (1+(Subscript[𝒜, m])),(Subscript[p, 1,1,1])=(-1+(Subscript[B, m])) (Subscript[𝒜, m])}

(Subscript[E, 1])

(Subscript[E, 2])

SolveAlways[(Subscript[E, 2])==0, {(Subscript[ξ, i]),(Subscript[ξ, j]),(Subscript[η, i]),(Subscript[η, j]),(Subscript[β, i]),(Subscript[β, j])(*,(Subscript[𝒜, i]),(Subscript[𝒜, j]),(Subscript[B, k])*)}]

Expand /@ (Subscript[dm, i,j->k])

(Subscript[tr, k_]):=(Subscript[𝔼, {k}->{}])[ (Subscript[β, k])(Subscript[b, k]),(( (Subscript[𝒜, k]) (1-(Subscript[B, k])))/(-1+ (Subscript[𝒜, k])))(Subscript[ξ, k])(Subscript[η, k])/ℏ,
1+ϵ(c+d (Subscript[β, k])+e (Subscript[ξ, k])(Subscript[η, k])+f ((Subscript[β, k])^2)+m (Subscript[β, k])(Subscript[ξ, k])(Subscript[η, k])+g ((Subscript[ξ, k])^2)((Subscript[η, k])^2))];
Simplify[((Subscript[dm, i,j->k])//(Subscript[tr, k]))≡((Subscript[dm, j,i->k])//(Subscript[tr, k]))]

eqn=Coefficient[((Subscript[dm, i,j->k])//(Subscript[tr, k]))[[3]]-((Subscript[dm, j,i->k])//(Subscript[tr, k]))[[3]],ϵ]//Simplify//Numerator

sol=Last@SolveAlways[eqn==0, {(Subscript[ξ, i]),(Subscript[ξ, j]),(Subscript[η, i]),(Subscript[η, j]),(Subscript[β, i]),(Subscript[β, j])(*,(Subscript[𝒜, i]),(Subscript[𝒜, j]),(Subscript[B, k])*)}]

Simplify[eqn /. sol]

sol /. {c|d|f->0}

(Subscript[Tr, k_]):=(Subscript[𝔼, {k}->{}])[ (Subscript[β, k])(Subscript[b, k]),(( (Subscript[𝒜, k]) (1-(Subscript[B, k])))/(-1+ (Subscript[𝒜, k])))(Subscript[ξ, k])(Subscript[η, k])/ℏ,
1+ϵ(c+d (Subscript[β, k])+e (Subscript[ξ, k])(Subscript[η, k])+f ((Subscript[β, k])^2)+m (Subscript[β, k])(Subscript[ξ, k])(Subscript[η, k])+g ((Subscript[ξ, k])^2)((Subscript[η, k])^2))] /. sol /. {(Subscript[𝒜, i])->1,(Subscript[𝒜, j])->(Subscript[𝒜, k])};
(Subscript[Tr, k])

Simplify[((Subscript[dm, i,j->k])//(Subscript[Tr, k]))≡((Subscript[dm, j,i->k])//(Subscript[Tr, k]))]

Simplify /@ ((Subscript[Tr, k])/.{c|d|f->0})

(Subscript[TR, k_]):=(Subscript[𝔼, {k}->{}])[(Subscript[b, k]) (Subscript[β, k]),-(((-1+(Subscript[B, k])) (Subscript[𝒜, k]) (Subscript[η, k]) (Subscript[ξ, k]))/(-1+(Subscript[𝒜, k]))),1+((ϵ (-1+(Subscript[B, k])) (Subscript[𝒜, k]) (Subscript[η, k]) (Subscript[ξ, k]) (4-4 (Subscript[β, k])+(-1+3 (Subscript[B, k])) (Subscript[𝒜, k]^2) (Subscript[η, k]) (Subscript[ξ, k])+(Subscript[𝒜, k]) (-4+4 (Subscript[β, k])+(-1+3 (Subscript[B, k])) (Subscript[η, k]) (Subscript[ξ, k]))))/(4 (((-1+(Subscript[𝒜, k])))^3)))]

Simplify/@ (((Subscript[R, 1,2])(Subscript[R, 3,4])(Subscript[C, 5]))//((Subscript[dm, 1,4->1]) (Subscript[dm, 2,3->2]))//((Subscript[dm, 1,5->1]))//((Subscript[TR, 1])))

Simplify/@ (((Subscript[R, 1,2])(Subscript[R, 3,4])(Subscript[C, 5]))//((Subscript[dm, 1,4->1]) (Subscript[dm, 2,3->2]))//((Subscript[dm, 1,5->1]))//((Subscript[TR, 1]))) /. (Subscript[B, 1])->1