(Subscript[S, 1]) leptoquark model

Load Matchete

<<Matchete`

Overview of all Matchete functions

?Matchete`*

Define the Standard Model

All definitions in this section can be automatically loaded with
ℒSM=LoadModel["SM"];

Define symmetries

QCD

DefineGaugeGroup[SU3c,SU[3],gs,G,
	FundAlphabet->{"a","b","c","d","e","f"},
	AdjAlphabet->{"A","B","C","D","E","F"}
]

This automatically defines a gauge coupling gs[] and the field-strength tensor G[μ,ν].

Weak force

DefineGaugeGroup[SU2L,SU[2],gL,W,
	FundAlphabet->{"i","j","k","l","m","n"},
	AdjAlphabet->{"I","J","K","L","M","N"}
]

Hypercharge

DefineGaugeGroup[U1Y,U1,gY,B]

Define flavor indices

DefineFlavorIndex[Flavor,3,
	IndexAlphabet->{"p","r","s","t","u","v"}
]

Define field content

Fermions

Quark doubled

DefineField[q,Fermion,
	Indices->{SU3c[fund],SU2L[fund],Flavor},
	Charges->{U1Y[1/6]},
	Chiral->LeftHanded,
	Mass->0
]

Up-type quark singlet

DefineField[u,Fermion,
	Indices->{SU3c[fund],Flavor},
	Charges->{U1Y[2/3]},
	Chiral->RightHanded,
	Mass->0
]

Down-type quark singlet

DefineField[d,Fermion,
	Indices->{SU3c[fund],Flavor},
	Charges->{U1Y[-1/3]},
	Chiral->RightHanded,
	Mass->0
]

Lepton doublet

DefineField[l,Fermion,
	Indices->{SU2L[fund],Flavor},
	Charges->{U1Y[-1/2]},
	Chiral->LeftHanded,
	Mass->0
]

Charged lepton singlet

DefineField[e,Fermion,
	Indices->{Flavor},
	Charges->{U1Y[-1]},
	Chiral->RightHanded,
	Mass->0
]

Higgs field

DefineField[H,Scalar,
	Indices->{SU2L[fund]},
	Charges->{U1Y[1/2]},
	Mass->0
]

The Higgs field is defined as massless, since its mass parameter is tachyonic. We will define it as a coupling.

Define couplings

Yukawa couplings

DefineCoupling[Yu,Indices->{Flavor,Flavor}]

DefineCoupling[Yd,Indices->{Flavor,Flavor}]

DefineCoupling[Ye,Indices->{Flavor,Flavor}]

Higgs mass and coupling

Higgs mass

DefineCoupling[μ,SelfConjugate->True,EFTOrder->1] (* μ has light mass dimension one *)

Higgs quartic coupling

DefineCoupling[λ,SelfConjugate->True,EFTOrder->0] (* λ has light mass dimension zero *)

Defining the SM Lagrangian

Yukawa interaction Lagrangian

ℒYukawa=Ye[p,r] Bar[l[i,p]]**e[r]H[i]+
	Yd[p,r]Bar[q[a,i,p]]**d[a,r]H[i]+
	Yu[p,r]Bar[q[a,i,p]]**u[a,r]CG[eps[SU2L],{i,j}]Bar[H[j]]//PlusHc;

%//HcSimplify//NiceForm

Scalar potential

ℒH=-((μ[])^2)Bar[H[i]]H[i]+((λ[])/2)Bar[H[i]]H[i]Bar[H[j]]H[j];
%//NiceForm

Full SM Lagrangian

ℒSM=FreeLag[q,d,u,l,e,H,B,W,G]-ℒYukawa-ℒH//RelabelIndices;

%//HcSimplify//NiceForm

Define the (Subscript[S, 1]) model

Equivalent alternative to the above SM definitions:

(*
LSM=LoadModel["SM"];
*)

Define the (Subscript[S, 1]) field

DefineField[S1,Scalar,
	Indices->{Bar[SU3c[fund]]},
	Charges->{U1Y[1/3]},
	SelfConjugate->False,
	Mass->{Heavy,M}
]

Define (Subscript[S, 1]) couplings

DefineCoupling[λL,Indices->{Flavor,Flavor}]
DefineCoupling[λR,Indices->{Flavor,Flavor}]

Define the (Subscript[S, 1]) interaction Lagrangian

ℒint=λL[p,r]CConj@Bar[q[a,n,p]]**l[m,r]Bar@CG[eps[SU2L],{n,m}]S1[a]+λR[p,r]CConj@Bar[u[a,p]]**e[r]S1[a]//PlusHc;
%//HcSimplify//NiceForm

Define (Subscript[S, 1]) Lagrangian entire

ℒS1=FreeLag[S1]-ℒint//RelabelIndices;
%//HcSimplify//NiceForm

Define full BSM Lagrangian

ℒBSM=ℒSM+ℒS1;
%//HcSimplify//NiceForm

Tree-level

ℒSMEFT0=Match[ℒBSM,EFTOrder->6,LoopOrder->0];

ℒSMEFT0ψ4=ℒSMEFT0-ℒSM;
%//HcSimplify//NiceForm

Fierz identities not yet included due to evanescent operators.
No other simplifications required.

Manual Fierzing

FierzIDs={
(* eu *)
Bar[Field[e,Fermion,{Index[s_,Flavor]},{}]]**DiracProduct[GammaCC,Proj[-1]]**Transp[Bar[Field[u,Fermion,{Index[a_,SU3c[fund]],Index[t_,Flavor]},{}]]] Transp[Field[e,Fermion,{Index[p_,Flavor]},{}]]**DiracProduct[GammaCC,Proj[1]]**Field[u,Fermion,{Index[a_,SU3c[fund]],Index[r_,Flavor]},{}]:>(1/2)Bar[e[s]]**γ[ν]**e[p]Bar[u[a,t]]**γ[ν]**u[a,r]
,
(* lq *)
Bar[Field[l,Fermion,{Index[i_,SU2L[fund]],Index[s_,Flavor]},{}]]**DiracProduct[GammaCC,Proj[1]]**Transp[Bar[Field[q,Fermion,{Index[a_,SU3c[fund]],Index[j_,SU2L[fund]],Index[t_,Flavor]},{}]]] Transp[Field[l,Fermion,{Index[i_,SU2L[fund]],Index[p_,Flavor]},{}]]**DiracProduct[GammaCC,Proj[-1]]**Field[q,Fermion,{Index[a_,SU3c[fund]],Index[j_,SU2L[fund]],Index[r_,Flavor]},{}]:>(1/2)Bar[l[i,s]]**γ[ν]**l[i,p]Bar[q[a,j,t]]**γ[ν]**q[a,j,r]
,
(* lq' *)
Bar[Field[l,Fermion,{Index[i_,SU2L[fund]],Index[s_,Flavor]},{}]]**DiracProduct[GammaCC,Proj[1]]**Transp[Bar[Field[q,Fermion,{Index[a_,SU3c[fund]],Index[j_,SU2L[fund]],Index[t_,Flavor]},{}]]] Transp[Field[l,Fermion,{Index[j_,SU2L[fund]],Index[p_,Flavor]},{}]]**DiracProduct[GammaCC,Proj[-1]]**Field[q,Fermion,{Index[a_,SU3c[fund]],Index[i_,SU2L[fund]],Index[r_,Flavor]},{}]:>(1/4)Bar[l[i,s]]**γ[ν]**l[i,p]Bar[q[a,j,t]]**γ[ν]**q[a,j,r]+CG[gen[SU2L[fund]],{A,i,j}]CG[gen[SU2L[fund]],{A,ii,jj}]Bar[l[i,s]]**γ[ν]**l[j,p]Bar[q[a,ii,t]]**γ[ν]**q[a,jj,r]
,
(* lequ *)
Bar[Field[l,Fermion,{Index[j_,SU2L[fund]],Index[s_,Flavor]},{}]]**DiracProduct[GammaCC,Proj[1]]**Transp[Bar[Field[q,Fermion,{Index[a_,SU3c[fund]],Index[i_,SU2L[fund]],Index[t_,Flavor]},{}]]] Transp[Field[e,Fermion,{Index[p_,Flavor]},{}]]**DiracProduct[GammaCC,Proj[1]]**Field[u,Fermion,{Index[a_,SU3c[fund]],Index[r_,Flavor]},{}]:>-(1/2)Bar[l[j,s]]**e[p]Bar[q[a,i,t]]**u[a,r]+(1/8)Bar[l[j,s]]**σ[ν1,ν2]**e[p]Bar[q[a,i,t]]**σ[ν1,ν2]**u[a,r]
,
Bar[Field[e,Fermion,{Index[r_,Flavor]},{}]]**DiracProduct[GammaCC,Proj[-1]]**Transp[Bar[Field[u,Fermion,{Index[a_,SU3c[fund]],Index[p_,Flavor]},{}]]] Transp[Field[l,Fermion,{Index[j_,SU2L[fund]],Index[t_,Flavor]},{}]]**DiracProduct[GammaCC,Proj[-1]]**Field[q,Fermion,{Index[a_,SU3c[fund]],Index[i_,SU2L[fund]],Index[s_,Flavor]},{}]:>-(1/2)Bar[e[r]]**l[j,t]Bar[u[a,p]]**q[a,i,s]+(1/8)Bar[e[r]]**σ[ν1,ν2]**l[j,t]Bar[u[a,p]]**σ[ν1,ν2]**q[a,i,s]
};

ℒSMEFT0ψ4/.FierzIDs//RelabelIndices//NiceForm

Full one-loop matching

ℒSMEFT1=EchoTiming@Match[ℒBSM,EFTOrder->6,LoopOrder->1]/.(1/ϵ)->0;

ℒSMEFT1simpl=EchoTiming@EOMSimplify[ℒSMEFT1];

ℒSMEFT1simpl//NiceForm

Extract leptonic dipole operators (Subscript[Q, eB]) and (Subscript[Q, eW])

Both dipoles at once

ℒdipoles=SelectOperatorClass[ℒSMEFT1simpl,{Bar@l,e,H},2];
%//HcSimplify//NiceForm

Only (Subscript[Q, eW])

SelectOperatorClass[ℒSMEFT1simpl,{Bar@l,e,H,W},0]//HcSimplify//NiceForm

Only (Subscript[Q, eB])

SelectOperatorClass[ℒSMEFT1simpl,{Bar@l,e,H,B},0]//HcSimplify//NiceForm

Extract ((Subscript[Q, lequ])^((3)))

SelectOperatorClass[ℒSMEFT0ψ4/.FierzIDs,{Bar@l,e,Bar@q,u},0]//NiceForm

Trick to extract only ((Subscript[Q, lequ])^((3)))

SelectOperatorClass[ℒSMEFT0ψ4/.FierzIDs,{Bar@l,e,Bar@q,u},0]/.DiracProduct[Proj[_]]->0//HcSimplify//NiceForm

Get matching conditions as replacement rules

((Subscript[C, lequ])^((3))) in the Warsaw basis

Define the Wilson coefficient

DefineCoupling[Clequ3,Indices->{Flavor,Flavor,Flavor,Flavor}]

Get the matching condition

Matching$tree=SelectOperatorClass[ℒSMEFT0ψ4/.FierzIDs,{Bar@l,e,Bar@q,u},0]/.DiracProduct[_Proj]->0;
%//NiceForm

Write the corresponding expression in the Warsaw basis

Warsaw$Clequ3=Clequ3[p,r,s,t](Bar[l[j,p]]**σ[ν,ρ]**e[r])(Bar[q[a,i,s]]**σ[ν,ρ]**u[a,t])CG[eps@SU2L,{j,i}]//PlusHc//RelabelIndices;
%//NiceForm

Subtract the two results (and simplify)

GreensSimplify[Warsaw$Clequ3-Matching$tree];
%//NiceForm

Drop the Hermitian conjugate

MatchingConditionClequ3=HcSimplify@GreensSimplify[Warsaw$Clequ3-Matching$tree]/.HcTerms[a_]->a;
%//NiceForm

Solve for the Wilson coefficient

MatchedCledq3=With[
	{var=First@Cases[MatchingConditionClequ3,Coupling[Clequ3,___],All]},
	Solve[MatchingConditionClequ3==0,var]//First
];
%//NiceForm

(* function to convert indices into patterns *)
IndexToPattern=a_Index:>Index[Pattern[Evaluate@First@a,Blank[]],Last@a];

MatchCledq3=MatchedCledq3/.{Rule[a_,b_]:>Rule[a/.IndexToPattern,b]};
%//NiceForm

(Subscript[C, eB]) and (Subscript[C, eW]) in the Warsaw basis

DefineCoupling[CeW,Indices->{Flavor,Flavor}]
DefineCoupling[CeB,Indices->{Flavor,Flavor}]

Warsaw$CeW=2CeW[p,r](Bar[l[i,p]]**σ[ν,ρ]**e[r])H[j]CG[gen@SU2L@fund,{J,i,j}]FS[W,ν,ρ,J]//PlusHc//RelabelIndices;
%//NiceForm

Warsaw$CeB=CeB[p,r](Bar[l[i,p]]**σ[ν,ρ]**e[r])H[i]FS[B,ν,ρ]//PlusHc//RelabelIndices;
%//NiceForm

MatchingConditionCeB=HcSimplify@GreensSimplify[SelectOperatorClass[ℒSMEFT1simpl,{Bar[l],e,H,B},0]-Warsaw$CeB]/.HcTerms[a_]->a;
%//NiceForm

MatchingConditionCeW=HcSimplify@GreensSimplify[SelectOperatorClass[ℒSMEFT1simpl,{Bar[l],e,H,W},0]-Warsaw$CeW]/.HcTerms[a_]->a;
%//NiceForm

MatchedCeB=With[
	{x=First@Cases[MatchingConditionCeB,Coupling[CeB,___],All]},
	First@Solve[MatchingConditionCeB==0,x]
];
%//NiceForm

MatchCeB=MatchedCeB/.{Rule[a_,b_]:>Rule[a/.IndexToPattern,b]};
%//NiceForm

MatchedCeW=With[
	{x=First@Cases[MatchingConditionCeW,Coupling[CeW,___],All]},
	First@Solve[MatchingConditionCeW==0,x]
];
%//NiceForm

MatchCeW=MatchedCeW/.{Rule[a_,b_]:>Rule[a/.IndexToPattern,b]};
%//NiceForm

FullMatching=Join[MatchCeB,MatchCeW,MatchCledq3];
%//NiceForm