HEL: HEL.fr

File HEL.fr, 36.2 KB (added by Adam, 6 years ago)
Line 
1(* ************************** *)
2(* *****  Information   ***** *)
3(* ************************** *)
4M$ModelName = "HEL";
5
6M$Information = {
7  Authors      -> {"A. Alloul, B. Fuks, V. Sanz"},
8  Version      -> "2.0",
9  Date         -> "11. 03. 2014",
10  Institutions -> {"GRPHE Strasbourg / U. Haute Alsace", "CERN / IPHC Strasbourg / U. Strasbourg", "University of Sussex"},
11  Emails       -> {"adam.alloul@iphc.cnrs.fr", "benjamin.fuks@iphc.cnrs.fr", "v.sanz@sussex.ac.uk"},
12  References   -> "arXiv:1310.5150",
13  URLs         -> "https://feynrules.irmp.ucl.ac.be/wiki/HEL"
14};
15
16FeynmanGauge = True;
17
18(* Change log *)
19 (* v1.1 (23.10.2013) BF: Fixing the coupling orders                                   *)
20 (* v1.2 (24.10.2013) BF: Adding the SM gghh contribution in the large mtop limit      *)
21 (* v2.0 (11.03.2014) BF: Adding the full SM + modifying the parameters cf. NP effects *)
22
23(* ************************** *)
24(* *****  Gauge groups  ***** *)
25(* ************************** *)
26M$GaugeGroups = {
27  U1Y  == {
28    Abelian          -> True, 
29    CouplingConstant -> g1,
30    GaugeBoson       -> B,
31    Charge           -> Y
32  },
33  SU2L == {
34    Abelian           -> False,
35    CouplingConstant  -> gw,
36    GaugeBoson        -> Wi,
37    StructureConstant -> Eps,
38    Representations   -> {Ta,SU2D},
39    Definitions       -> {Ta[a_,b_,c_]->PauliSigma[a,b,c]/2, FSU2L[i_,j_,k_]:> I Eps[i,j,k]}
40  },
41  SU3C == {
42    Abelian           -> False,
43    CouplingConstant  -> gs,
44    GaugeBoson        -> G,
45    StructureConstant -> f,
46    Representations   -> {T,Colour},
47    SymmetricTensor   -> dSUN
48  }
49};
50
51(* ************************** *)
52(* *****    Indices     ***** *)
53(* ************************** *)
54IndexRange[Index[SU2W      ]] = Unfold[Range[3]];
55IndexRange[Index[SU2D      ]] = Unfold[Range[2]];
56IndexRange[Index[Gluon     ]] = NoUnfold[Range[8]];
57IndexRange[Index[Colour    ]] = NoUnfold[Range[3]];
58IndexRange[Index[Generation]] = Range[3];
59IndexStyle[SU2W,       j];
60IndexStyle[SU2D,       k];
61IndexStyle[Gluon,      a];
62IndexStyle[Colour,     m];
63IndexStyle[Generation, f];
64
65
66(* ************************** *)
67(* *****  Orders        ***** *)
68(* ************************** *)
69M$InteractionOrderHierarchy = { {QCD, 1}, {QED, 2}, {NP,1} };
70
71M$InteractionOrderLimit = { {QCD, 99}, {QED, 99} , {NP,1}};
72
73
74(* ************************** *)
75(* **** Particle classes **** *)
76(* ************************** *)
77M$ClassesDescription = {
78
79(* Gauge bosons: physical vector fields *)
80  V[1] == {
81    ClassName       -> A,
82    SelfConjugate   -> True, 
83    Mass            -> 0, 
84    Width           -> 0, 
85    ParticleName    -> "a",
86    PDG             -> 22,
87    PropagatorLabel -> "a",
88    PropagatorType  -> W,
89    PropagatorArrow -> None,
90    FullName        -> "Photon"
91  },
92  V[2] == {
93    ClassName       -> Z,
94    SelfConjugate   -> True,
95    Mass            -> {MZ, Internal},
96    Width           -> {WZ, 2.4952},
97    ParticleName    -> "Z",
98    PDG             -> 23,
99    PropagatorLabel -> "Z",
100    PropagatorType  -> Sine,
101    PropagatorArrow -> None,
102    FullName        -> "Z"
103  },
104  V[3] == {
105    ClassName        -> W,
106    SelfConjugate    -> False,
107    Mass             -> {MW, 80.385},
108    Width            -> {WW, 2.085},
109    ParticleName     -> "W+",
110    AntiParticleName -> "W-",
111    QuantumNumbers   -> {Q -> 1},
112    PDG              -> 24,
113    PropagatorLabel  -> "W",
114    PropagatorType   -> Sine,
115    PropagatorArrow  -> Forward,
116    FullName         -> "W"
117  },
118  V[4] == {
119    ClassName        -> G,
120    SelfConjugate    -> True,
121    Indices          -> {Index[Gluon]},
122    Mass             -> 0,
123    Width            -> 0,
124    ParticleName     -> "g",
125    PDG              -> 21,
126    PropagatorLabel  -> "G",
127    PropagatorType   -> C,
128    PropagatorArrow  -> None,
129    FullName         -> "G"
130  },
131
132(* Ghosts: related to physical gauge bosons *)
133  U[1] == {
134    ClassName       -> ghA,
135    SelfConjugate   -> False,
136    Ghost           -> A,
137    QuantumNumbers  -> {GhostNumber -> 1},
138    Mass            -> 0,
139    Width           -> 0,
140    PropagatorLabel -> "uA",
141    PropagatorType  -> GhostDash,
142    PropagatorArrow -> Forward
143  },
144  U[2] == {
145    ClassName       -> ghZ,
146    SelfConjugate   -> False,
147    Ghost           -> Z,
148    QuantumNumbers  -> {GhostNumber -> 1},
149    Mass            -> {MZ,Internal},
150    Width           -> {WZ, 2.4952},
151    PropagatorLabel -> "uZ",
152    PropagatorType  -> GhostDash,
153    PropagatorArrow -> Forward
154  },
155  U[31] == {
156    ClassName       -> ghWp,
157    SelfConjugate   -> False,
158    Ghost           -> W,
159    QuantumNumbers  -> {GhostNumber -> 1, Q -> 1},
160    Mass            -> {MW,80.385},
161    Width           -> {WW, 2.085},
162    PropagatorLabel -> "uWp",
163    PropagatorType  -> GhostDash,
164    PropagatorArrow -> Forward
165  },
166  U[32] == {
167    ClassName       -> ghWm,
168    SelfConjugate   -> False,
169    Ghost           -> Wbar,
170    QuantumNumbers  -> {GhostNumber -> 1, Q -> -1},
171    Mass            -> {MW,80.385},
172    Width           -> {WW, 2.085},
173    PropagatorLabel -> "uWm",
174    PropagatorType  -> GhostDash,
175    PropagatorArrow -> Forward
176  },
177  U[4] == {
178    ClassName       -> ghG,
179    SelfConjugate   -> False,
180    Indices         -> {Index[Gluon]},
181    Ghost           -> G,
182    PDG             -> 82,
183    QuantumNumbers  ->{GhostNumber -> 1},
184    Mass            -> 0,
185    Width           -> 0,
186    PropagatorLabel -> "uG",
187    PropagatorType  -> GhostDash,
188    PropagatorArrow -> Forward
189  },
190
191(* Gauge bosons: unphysical vector fields *)
192  V[11] == {
193    ClassName     -> B,
194    Unphysical    -> True,
195    SelfConjugate -> True,
196    Definitions   -> { B[mu_] -> -sw Z[mu]+cw A[mu]}
197  },
198  V[12] == {
199    ClassName     -> Wi,
200    Unphysical    -> True,
201    SelfConjugate -> True,
202    Indices       -> {Index[SU2W]},
203    FlavorIndex   -> SU2W,
204    Definitions   -> { Wi[mu_,1] -> (Wbar[mu]+W[mu])/Sqrt[2], Wi[mu_,2] -> (Wbar[mu]-W[mu])/(I*Sqrt[2]), Wi[mu_,3] -> cw Z[mu] + sw A[mu]}
205  },
206
207(* Ghosts: related to unphysical gauge bosons *)
208  U[11] == {
209    ClassName     -> ghB,
210    Unphysical    -> True,
211    SelfConjugate -> False,
212    Ghost         -> B,
213    Definitions   -> { ghB -> -sw ghZ + cw ghA}
214  },
215  U[12] == {
216    ClassName     -> ghWi,
217    Unphysical    -> True,
218    SelfConjugate -> False,
219    Ghost         -> Wi,
220    Indices       -> {Index[SU2W]},
221    FlavorIndex   -> SU2W,
222    Definitions   -> { ghWi[1] -> (ghWp+ghWm)/Sqrt[2], ghWi[2] -> (ghWm-ghWp)/(I*Sqrt[2]), ghWi[3] -> cw ghZ+sw ghA}
223  } ,
224
225(* Fermions: physical fields *)
226  F[1] == {
227    ClassName        -> vl,
228    ClassMembers     -> {ve,vm,vt},
229    Indices          -> {Index[Generation]},
230    FlavorIndex      -> Generation,
231    SelfConjugate    -> False,
232    Mass             -> 0,
233    Width            -> 0,
234    QuantumNumbers   -> {LeptonNumber -> 1},
235    PropagatorLabel  -> {"v", "ve", "vm", "vt"} ,
236    PropagatorType   -> S,
237    PropagatorArrow  -> Forward,
238    PDG              -> {12,14,16},
239    ParticleName     -> {"ve","vm","vt"},
240    AntiParticleName -> {"ve~","vm~","vt~"},
241    FullName         -> {"Electron-neutrino", "Mu-neutrino", "Tau-neutrino"}
242  },
243  F[2] == {
244    ClassName        -> l,
245    ClassMembers     -> {e, mu, ta},
246    Indices          -> {Index[Generation]},
247    FlavorIndex      -> Generation,
248    SelfConjugate    -> False,
249    Mass             -> {Ml, {Me,5.11*^-4}, {MMU,0.10566}, {MTA,1.777}},
250    Width            -> 0,
251    QuantumNumbers   -> {Q -> -1, LeptonNumber -> 1},
252    PropagatorLabel  -> {"l", "e", "mu", "ta"},
253    PropagatorType   -> Straight,
254    PropagatorArrow  -> Forward,
255    PDG              -> {11, 13, 15},
256    ParticleName     -> {"e-", "mu-", "ta-"},
257    AntiParticleName -> {"e+", "mu+", "ta+"},
258    FullName         -> {"Electron", "Muon", "Tau"}
259  },
260  F[3] == {
261    ClassName        -> uq,
262    ClassMembers     -> {u, c, t},
263    Indices          -> {Index[Generation], Index[Colour]},
264    FlavorIndex      -> Generation,
265    SelfConjugate    -> False,
266    Mass             -> {Mu, {MU, 2.55*^-3}, {MC,1.27}, {MT,172}},
267    Width            -> {0, 0, {WT,1.50833649}},
268    QuantumNumbers   -> {Q -> 2/3},
269    PropagatorLabel  -> {"uq", "u", "c", "t"},
270    PropagatorType   -> Straight,
271    PropagatorArrow  -> Forward,
272    PDG              -> {2, 4, 6},
273    ParticleName     -> {"u",  "c",  "t" },
274    AntiParticleName -> {"u~", "c~", "t~"},
275    FullName         -> {"u-quark", "c-quark", "t-quark"}
276  },
277  F[4] == {
278    ClassName        -> dq,
279    ClassMembers     -> {d, s, b},
280    Indices          -> {Index[Generation], Index[Colour]},
281    FlavorIndex      -> Generation,
282    SelfConjugate    -> False,
283    Mass             -> {Md, {MD,5.04*^-3}, {MS,0.101}, {MB,4.7}},
284    Width            -> 0,
285    QuantumNumbers   -> {Q -> -1/3},
286    PropagatorLabel  -> {"dq", "d", "s", "b"},
287    PropagatorType   -> Straight,
288    PropagatorArrow  -> Forward,
289    PDG              -> {1,3,5},
290    ParticleName     -> {"d",  "s",  "b" },
291    AntiParticleName -> {"d~", "s~", "b~"},
292    FullName         -> {"d-quark", "s-quark", "b-quark"}
293  },
294
295(* Fermions: unphysical fields *)
296  F[11] == {
297    ClassName      -> LL,
298    Unphysical     -> True,
299    Indices        -> {Index[SU2D], Index[Generation]},
300    FlavorIndex    -> SU2D,
301    SelfConjugate  -> False,
302    QuantumNumbers -> {Y -> -1/2},
303    Definitions    -> { LL[sp1_,1,ff_] :> Module[{sp2}, ProjM[sp1,sp2] vl[sp2,ff]], LL[sp1_,2,ff_] :> Module[{sp2}, ProjM[sp1,sp2] l[sp2,ff]] }
304  },
305  F[12] == {
306    ClassName      -> lR,
307    Unphysical     -> True,
308    Indices        -> {Index[Generation]},
309    FlavorIndex    -> Generation,
310    SelfConjugate  -> False,
311    QuantumNumbers -> {Y -> -1},
312    Definitions    -> { lR[sp1_,ff_] :> Module[{sp2}, ProjP[sp1,sp2] l[sp2,ff]] }
313  },
314  F[13] == {
315    ClassName      -> QL,
316    Unphysical     -> True,
317    Indices        -> {Index[SU2D], Index[Generation], Index[Colour]},
318    FlavorIndex    -> SU2D,
319    SelfConjugate  -> False,
320    QuantumNumbers -> {Y -> 1/6},
321    Definitions    -> {
322      QL[sp1_,1,ff_,cc_] :> Module[{sp2}, ProjM[sp1,sp2] uq[sp2,ff,cc]],
323      QL[sp1_,2,ff_,cc_] :> Module[{sp2,ff2}, CKM[ff,ff2] ProjM[sp1,sp2] dq[sp2,ff2,cc]] }
324  },
325  F[14] == {
326    ClassName      -> uR,
327    Unphysical     -> True,
328    Indices        -> {Index[Generation], Index[Colour]},
329    FlavorIndex    -> Generation,
330    SelfConjugate  -> False,
331    QuantumNumbers -> {Y -> 2/3},
332    Definitions    -> { uR[sp1_,ff_,cc_] :> Module[{sp2}, ProjP[sp1,sp2] uq[sp2,ff,cc]] }
333  },
334  F[15] == {
335    ClassName      -> dR,
336    Unphysical     -> True,
337    Indices        -> {Index[Generation], Index[Colour]},
338    FlavorIndex    -> Generation,
339    SelfConjugate  -> False,
340    QuantumNumbers -> {Y -> -1/3},
341    Definitions    -> { dR[sp1_,ff_,cc_] :> Module[{sp2}, ProjP[sp1,sp2] dq[sp2,ff,cc]] }
342  },
343
344(* Higgs: physical scalars  *)
345  S[1] == {
346    ClassName       -> H,
347    SelfConjugate   -> True,
348    Mass            -> {MH,125},
349    Width           -> {WH,0.00407},
350    PropagatorLabel -> "H",
351    PropagatorType  -> D,
352    PropagatorArrow -> None,
353    PDG             -> 25,
354    ParticleName    -> "H",
355    FullName        -> "H"
356  },
357
358(* Higgs: physical scalars  *)
359  S[2] == {
360    ClassName       -> G0,
361    SelfConjugate   -> True,
362    Goldstone       -> Z,
363    Mass            -> {MZ, Internal},
364    Width           -> {WZ, 2.4952},
365    PropagatorLabel -> "Go",
366    PropagatorType  -> D,
367    PropagatorArrow -> None,
368    PDG             -> 250,
369    ParticleName    -> "G0",
370    FullName        -> "G0"
371  },
372  S[3] == {
373    ClassName        -> GP,
374    SelfConjugate    -> False,
375    Goldstone        -> W,
376    Mass             -> {MW, 80.385},
377    QuantumNumbers   -> {Q -> 1},
378    Width            -> {WW, 2.085},
379    PropagatorLabel  -> "GP",
380    PropagatorType   -> D,
381    PropagatorArrow  -> None,
382    PDG              -> 251,
383    ParticleName     -> "G+",
384    AntiParticleName -> "G-",
385    FullName         -> "GP"
386  },
387
388(* Higgs: unphysical scalars  *)
389  S[11] == {
390    ClassName      -> Phi,
391    Unphysical     -> True,
392    Indices        -> {Index[SU2D]},
393    FlavorIndex    -> SU2D,
394    SelfConjugate  -> False,
395    QuantumNumbers -> {Y -> 1/2},
396    Definitions    -> { Phi[1] -> -I GP, Phi[2] -> (vev + H + I G0)/Sqrt[2]  }
397  }
398};
399
400
401(* ************************** *)
402(* *****     Gauge      ***** *)
403(* *****   Parameters   ***** *)
404(* *****   (FeynArts)   ***** *)
405(* ************************** *)
406
407GaugeXi[ V[1]  ] = GaugeXi[A];
408GaugeXi[ V[2]  ] = GaugeXi[Z];
409GaugeXi[ V[3]  ] = GaugeXi[W];
410GaugeXi[ V[4]  ] = GaugeXi[G];
411GaugeXi[ S[1]  ] = 1;
412GaugeXi[ S[2]  ] = GaugeXi[Z];
413GaugeXi[ S[3]  ] = GaugeXi[W];
414GaugeXi[ U[1]  ] = GaugeXi[A];
415GaugeXi[ U[2]  ] = GaugeXi[Z];
416GaugeXi[ U[31] ] = GaugeXi[W];
417GaugeXi[ U[32] ] = GaugeXi[W];
418GaugeXi[ U[4]  ] = GaugeXi[G];
419
420
421(* ************************** *)
422(* *****   Parameters   ***** *)
423(* ************************** *)
424(* The loop coefficients *)
425sert[x_] := 1+ 7/30 x + 2/21 x^2 + 26/525 x^3;
426serw[xw_, xt_] := 1 + xw * 66/235 +xw^2 * 228/1645 + xw^3 * 696/8225 +
427            xw^4 * 5248/90475 +xw^5 * 1280/29939+ xw^6 * 54528/1646645-
428            xt * 56/705 - xt^2 * 32/987;
429
430M$Parameters = {
431  (* New physics parameters *)
432  cH  == { TeX -> Subscript[C,H],          ParameterType -> External,   Value -> 0.1,   BlockName -> NEWCOUP,   OrderBlock -> 1 , InteractionOrder -> {NP,1} },
433  cT  == { TeX -> Subscript[C,T],          ParameterType -> External,   Value -> 0.1,   BlockName -> NEWCOUP,   OrderBlock -> 2 , InteractionOrder -> {NP,1} },
434  c6  == { TeX -> Subscript[C,6],          ParameterType -> External,   Value -> 0.1,   BlockName -> NEWCOUP,   OrderBlock -> 3 , InteractionOrder -> {NP,1} },
435  cu  == { TeX -> Subscript[C,u],          ParameterType -> External,   Value -> 0.1,   BlockName -> NEWCOUP,   OrderBlock -> 4 , InteractionOrder -> {NP,1} },
436  cd  == { TeX -> Subscript[C,d],          ParameterType -> External,   Value -> 0.1,   BlockName -> NEWCOUP,   OrderBlock -> 5 , InteractionOrder -> {NP,1} },
437  cl  == { TeX -> Subscript[C,l],          ParameterType -> External,   Value -> 0.1,   BlockName -> NEWCOUP,   OrderBlock -> 6 , InteractionOrder -> {NP,1} },
438  cWW == { TeX -> Subscript[C,W],          ParameterType -> External,   Value -> 0.1,   BlockName -> NEWCOUP,   OrderBlock -> 7 , InteractionOrder -> {NP,1} },
439  cB  == { TeX -> Subscript[C,B],          ParameterType -> External,   Value -> 0.1,   BlockName -> NEWCOUP,   OrderBlock -> 8 , InteractionOrder -> {NP,1} },
440  cHW == { TeX -> Subscript[C,HW],         ParameterType -> External,   Value -> 0.1,   BlockName -> NEWCOUP,   OrderBlock -> 9 , InteractionOrder -> {NP,1} },
441  cHB == { TeX -> Subscript[C,HB],         ParameterType -> External,   Value -> 0.1,   BlockName -> NEWCOUP,   OrderBlock -> 10, InteractionOrder -> {NP,1} },
442  cA  == { TeX -> Subscript[C,\[Gamma]],   ParameterType -> External,   Value -> 0.1,   BlockName -> NEWCOUP,   OrderBlock -> 11, InteractionOrder -> {NP,1} },
443  cG  == { TeX -> Subscript[C,g] ,         ParameterType -> External,   Value -> 0.1,   BlockName -> NEWCOUP,   OrderBlock -> 12, InteractionOrder -> {NP,1} },
444  cHQ == { TeX -> Subscript[C,Hq],         ParameterType -> External,   Value -> 0.1,   BlockName -> NEWCOUP,   OrderBlock -> 13, InteractionOrder -> {NP,1} },
445  cpHQ== { TeX -> Subscript[C',Hq],        ParameterType -> External,   Value -> 0.1,   BlockName -> NEWCOUP,   OrderBlock -> 14, InteractionOrder -> {NP,1} },
446  cHu == { TeX -> Subscript[C,Hu],         ParameterType -> External,   Value -> 0.1,   BlockName -> NEWCOUP,   OrderBlock -> 15, InteractionOrder -> {NP,1} },
447  cHd == { TeX -> Subscript[C,Hd],         ParameterType -> External,   Value -> 0.1,   BlockName -> NEWCOUP,   OrderBlock -> 16, InteractionOrder -> {NP,1} },
448  cHud== { TeX -> Subscript[C,Hud],        ParameterType -> External,   Value -> 0.1,   BlockName -> NEWCOUP,   OrderBlock -> 17, InteractionOrder -> {NP,1} },
449  cHL == { TeX -> Subscript[C,Hl],         ParameterType -> External,   Value -> 0.1,   BlockName -> NEWCOUP,   OrderBlock -> 18, InteractionOrder -> {NP,1} },
450  cpHL== { TeX -> Subscript[C',Hl],        ParameterType -> External,   Value -> 0.1,   BlockName -> NEWCOUP,   OrderBlock -> 19, InteractionOrder -> {NP,1} },
451  cHe == { TeX -> Subscript[C,He],         ParameterType -> External,   Value -> 0.1,   BlockName -> NEWCOUP,   OrderBlock -> 20, InteractionOrder -> {NP,1} },
452  cuB == { TeX -> Subscript[C,uB],         ParameterType -> External,   Value -> 0.1,   BlockName -> NEWCOUP,   OrderBlock -> 21, InteractionOrder -> {NP,1} },
453  cuW == { TeX -> Subscript[C,uW],         ParameterType -> External,   Value -> 0.1,   BlockName -> NEWCOUP,   OrderBlock -> 22, InteractionOrder -> {NP,1} },
454  cuG == { TeX -> Subscript[C,uG],         ParameterType -> External,   Value -> 0.1,   BlockName -> NEWCOUP,   OrderBlock -> 23, InteractionOrder -> {NP,1} },
455  cdB == { TeX -> Subscript[C,dB],         ParameterType -> External,   Value -> 0.1,   BlockName -> NEWCOUP,   OrderBlock -> 24, InteractionOrder -> {NP,1} },
456  cdW == { TeX -> Subscript[C,dW],         ParameterType -> External,   Value -> 0.1,   BlockName -> NEWCOUP,   OrderBlock -> 25, InteractionOrder -> {NP,1} },
457  cdG == { TeX -> Subscript[C,dG],         ParameterType -> External,   Value -> 0.1,   BlockName -> NEWCOUP,   OrderBlock -> 26, InteractionOrder -> {NP,1} },
458  clB == { TeX -> Subscript[C,lB],         ParameterType -> External,   Value -> 0.1,   BlockName -> NEWCOUP,   OrderBlock -> 27, InteractionOrder -> {NP,1} },
459  clW == { TeX -> Subscript[C,lW],         ParameterType -> External,   Value -> 0.1,   BlockName -> NEWCOUP,   OrderBlock -> 28, InteractionOrder -> {NP,1} },
460  c3W == { TeX -> Subscript[C,3W],         ParameterType -> External,   Value -> 0.1,   BlockName -> NEWCOUP,   OrderBlock -> 29, InteractionOrder -> {NP,1} },
461  c3G == { TeX -> Subscript[C,3G],         ParameterType -> External,   Value -> 0.1,   BlockName -> NEWCOUP,   OrderBlock -> 30, InteractionOrder -> {NP,1} },
462  c2W == { TeX -> Subscript[C,2W],         ParameterType -> External,   Value -> 0.1,   BlockName -> NEWCOUP,   OrderBlock -> 31, InteractionOrder -> {NP,1} },
463  c2B == { TeX -> Subscript[C,2B],         ParameterType -> External,   Value -> 0.1,   BlockName -> NEWCOUP,   OrderBlock -> 32, InteractionOrder -> {NP,1} },
464  c2G == { TeX -> Subscript[C,2G],         ParameterType -> External,   Value -> 0.1,   BlockName -> NEWCOUP,   OrderBlock -> 33, InteractionOrder -> {NP,1} },
465  tcHW== { TeX -> Subscript[OverTilde[C],HW], ParameterType -> External,   Value -> 0.1,   BlockName -> NEWCOUP,   OrderBlock -> 34 , InteractionOrder -> {NP,1}},
466  tcHB== { TeX -> Subscript[OverTilde[C],HB], ParameterType -> External,   Value -> 0.1,   BlockName -> NEWCOUP,   OrderBlock -> 35 , InteractionOrder -> {NP,1}},
467  tcG == { TeX -> Subscript[OverTilde[C],G],  ParameterType -> External,   Value -> 0.1,   BlockName -> NEWCOUP,   OrderBlock -> 36 , InteractionOrder -> {NP,1}},
468  tcA == { TeX -> Subscript[OverTilde[C],A],  ParameterType -> External,   Value -> 0.1,   BlockName -> NEWCOUP,   OrderBlock -> 37 , InteractionOrder -> {NP,1}},
469  tc3W== { TeX -> Subscript[OverTilde[C],3W], ParameterType -> External,   Value -> 0.1,   BlockName -> NEWCOUP,   OrderBlock -> 38 , InteractionOrder -> {NP,1}},
470  tc3G== { TeX -> Subscript[OverTilde[C],3G], ParameterType -> External,   Value -> 0.1,   BlockName -> NEWCOUP,   OrderBlock -> 39 , InteractionOrder -> {NP,1}},
471  dum  == { TeX -> "", ParameterType -> Internal,   Definition -> {dum->1}, InteractionOrder -> {QED,1}},
472
473  (* External parameters *)
474  aEWM1 == {
475    ParameterType    -> External,
476    BlockName        -> SMINPUTS,
477    OrderBlock       -> 1,
478    Value            -> 127.9,
479    InteractionOrder -> {QED,-2},
480    Description      -> "Inverse of the EW coupling constant at the Z pole"
481  },
482  Gf == {
483    ParameterType    -> External,
484    BlockName        -> SMINPUTS,
485    OrderBlock       -> 2,
486    Value            -> 1.16637*^-5,
487    InteractionOrder -> {QED,2},
488    TeX              -> Subscript[G,f],
489    Description      -> "Fermi constant"
490  },
491  aS    == {
492    ParameterType    -> External,
493    BlockName        -> SMINPUTS,
494    OrderBlock       -> 3,
495    Value            -> 0.1184,
496    InteractionOrder -> {QCD,2},
497    TeX              -> Subscript[\[Alpha],s],
498    Description      -> "Strong coupling constant at the Z pole"
499  },
500  ymdo == {
501    ParameterType -> External,
502    BlockName     -> YUKAWA,
503    OrderBlock    -> 1,
504    Value         -> 5.04*^-3,
505    Description   -> "Down Yukawa mass"
506  },
507  ymup == {
508    ParameterType -> External,
509    BlockName     -> YUKAWA,
510    OrderBlock    -> 2,
511    Value         -> 2.55*^-3,
512    Description   -> "Up Yukawa mass"
513  },
514  yms == {
515    ParameterType -> External,
516    BlockName     -> YUKAWA,
517    OrderBlock    -> 3,
518    Value         -> 0.101,
519    Description   -> "Strange Yukawa mass"
520  },
521  ymc == {
522    ParameterType -> External,
523    BlockName     -> YUKAWA,
524    OrderBlock    -> 4,
525    Value         -> 1.27,
526    Description   -> "Charm Yukawa mass"
527  },
528  ymb == {
529    ParameterType -> External,
530    BlockName     -> YUKAWA,
531    OrderBlock    -> 5,
532    Value         -> 4.7,
533    Description   -> "Bottom Yukawa mass"
534  },
535  ymt == {
536    ParameterType -> External,
537    BlockName     -> YUKAWA,
538    OrderBlock    -> 6,
539    Value         -> 172,
540    Description   -> "Top Yukawa mass"
541  },
542  yme == {
543    ParameterType -> External,
544    BlockName     -> YUKAWA,
545    OrderBlock    -> 11,
546    Value         -> 5.11*^-4,
547    Description   -> "Electron Yukawa mass"
548  },
549  ymm == {
550    ParameterType -> External,
551    BlockName     -> YUKAWA,
552    OrderBlock    -> 13,
553    Value         -> 0.10566,
554    Description   -> "Muon Yukawa mass"
555  },
556  ymtau == {
557    ParameterType -> External,
558    BlockName     -> YUKAWA,
559    OrderBlock    -> 15,
560    Value         -> 1.777,
561    Description   -> "Tau Yukawa mass"
562  },
563  cabi == {
564    ParameterType -> External,
565    BlockName     -> CKMBLOCK,
566    OrderBlock    -> 1,
567    Value         -> 0.227736,
568    TeX           -> Subscript[\[Theta], c],
569    Description   -> "Cabibbo angle"
570  },
571
572  (* Internal Parameters *)
573  aEW == {
574    ParameterType    -> Internal,
575    Value            -> 1/aEWM1,
576    InteractionOrder -> {QED,2},
577    TeX              -> Subscript[\[Alpha], EW],
578    Description      -> "Electroweak coupling contant"
579  },
580  ee == {
581    ParameterType    -> Internal,
582    Value            -> Sqrt[4 Pi aEW],
583    InteractionOrder -> {QED,1},
584    TeX              -> e, 
585    Description      -> "Electric coupling constant"
586  },
587  vev == {
588    ParameterType    -> Internal,
589    Value            -> Sqrt[1/(Sqrt[2] Gf)],
590    InteractionOrder -> {QED,-1},
591    Description      -> "Higgs vacuum expectation value"
592  },
593  sw == {
594    ParameterType -> Internal,
595    Value         -> ee*vev/(2*MW),
596    TeX           -> Subscript[s,w],
597    Description   -> "Sine of the Weinberg angle"
598  },
599  cw == {
600    ParameterType -> Internal,
601    Value         -> Sqrt[1-sw^2],
602    TeX           -> Subscript[c,w],
603    Description   -> "Cosine of the Weinberg angle"
604  },
605  gw == {
606    ParameterType    -> Internal,
607    Definitions      -> {gw->ee/sw},
608    InteractionOrder -> {QED,1}, 
609    TeX              -> Subscript[g,w],
610    Description      -> "Weak coupling constant at the Z pole"
611  },
612  g1 == {
613    ParameterType    -> Internal,
614    Definitions      -> {g1->ee/cw},
615    InteractionOrder -> {QED,1}, 
616    TeX              -> Subscript[g,1],
617    Description      -> "U(1)Y coupling constant at the Z pole"
618  },
619  MZ == {
620    ParameterType -> Internal,
621    Value         -> Sqrt[gw^2 vev^2/(4 cw^2) (1-cT+8 cA sw^4/cw^2)],
622    TeX           -> Subscript[M,Z],
623    Description   -> "Z mass"
624  },
625  gs == {
626    ParameterType    -> Internal,
627    Value            -> Sqrt[4 Pi aS],
628    InteractionOrder -> {QCD,1}, 
629    TeX              -> Subscript[g,s],
630    ParameterName    -> G,
631    Description      -> "Strong coupling constant at the Z pole"
632  },
633  lam == {
634    ParameterType    -> Internal,
635    Definitions      -> {lam->MH^2/(2 vev^2)*(1-13/8*c6+cH)},
636    InteractionOrder -> {QED, 2},
637    Description      -> "Higgs quartic coupling"
638  },
639  muH == {
640    ParameterType -> Internal,
641    Definitions   -> {muH->(1+c6/4) Sqrt[lam vev^2]},
642    TeX           -> \[Mu],
643    Description   -> "Coefficient of the quadratic piece of the Higgs potential"
644  },
645  yl == {
646    ParameterType    -> Internal,
647    Indices          -> {Index[Generation], Index[Generation]},
648    Definitions      -> {yl[i_?NumericQ, j_?NumericQ] :> 0  /; (i =!= j)},
649    Value            -> {yl[1,1] -> Sqrt[2] yme / vev, yl[2,2] -> Sqrt[2] ymm / vev, yl[3,3] -> Sqrt[2] ymtau / vev},
650    InteractionOrder -> {QED, 1},
651    ParameterName    -> {yl[1,1] -> ye, yl[2,2] -> ym, yl[3,3] -> ytau},
652    TeX              -> Superscript[y, l],
653    Description      -> "Lepton Yukawa couplings"
654  },
655  yu == {
656    ParameterType    -> Internal,
657    Indices          -> {Index[Generation], Index[Generation]},
658    Definitions      -> {yu[i_?NumericQ, j_?NumericQ] :> 0  /; (i =!= j)},
659    Value            -> {yu[1,1] -> Sqrt[2] ymup/vev, yu[2,2] -> Sqrt[2] ymc/vev, yu[3,3] -> Sqrt[2] ymt/vev},
660    InteractionOrder -> {QED, 1},
661    ParameterName    -> {yu[1,1] -> yup, yu[2,2] -> yc, yu[3,3] -> yt},
662    TeX              -> Superscript[y, u],
663    Description      -> "Up-type Yukawa couplings"
664  },
665  yd == {
666    ParameterType    -> Internal,
667    Indices          -> {Index[Generation], Index[Generation]},
668    Definitions      -> {yd[i_?NumericQ, j_?NumericQ] :> 0  /; (i =!= j)},
669    Value            -> {yd[1,1] -> Sqrt[2] ymdo/vev, yd[2,2] -> Sqrt[2] yms/vev, yd[3,3] -> Sqrt[2] ymb/vev},
670    InteractionOrder -> {QED, 1},
671    ParameterName    -> {yd[1,1] -> ydo, yd[2,2] -> ys, yd[3,3] -> yb},
672    TeX              -> Superscript[y, d],
673    Description      -> "Down-type Yukawa couplings"
674  },
675(* N. B. : only Cabibbo mixing! *)
676  CKM == {
677    ParameterType -> Internal,
678    Indices       -> {Index[Generation], Index[Generation]},
679    Unitary       -> True,
680    Value         -> {CKM[1,1] -> Cos[cabi],  CKM[1,2] -> Sin[cabi], CKM[1,3] -> 0,
681                      CKM[2,1] -> -Sin[cabi], CKM[2,2] -> Cos[cabi], CKM[2,3] -> 0,
682                      CKM[3,1] -> 0,          CKM[3,2] -> 0,         CKM[3,3] -> 1},
683    TeX         -> Superscript[V,CKM],
684    Description -> "CKM-Matrix"},
685  AH  == { TeX->Subscript[A,H], ParameterType->Internal, Value -> ee^2/4/Pi/(Pi*vev)*(47/18)*serw[(MH/2/MW)^2, (MH/2/MT)^2], InteractionOrder -> {QED, 2}},
686  GH  == { TeX->Subscript[G,H], ParameterType->Internal, Value -> -gs^2/(4Pi(3Pi vev)) (*sert[(MH/2/MT)^2]*),                InteractionOrder -> {QCD, 2}}
687};
688
689(* ************************** *)
690(* *****   Lagrangian   ***** *)
691(* ************************** *)
692
693
694LGauge := Block[{mu,nu,ii,aa},
695  ExpandIndices[-1/4 FS[B,mu,nu] FS[B,mu,nu] - 1/4 FS[Wi,mu,nu,ii] FS[Wi,mu,nu,ii] - 1/4 FS[G,mu,nu,aa] FS[G,mu,nu,aa], FlavorExpand->SU2W]];
696
697LFermions := Block[{mu},
698  ExpandIndices[I*(
699    QLbar.Ga[mu].DC[QL, mu] + LLbar.Ga[mu].DC[LL, mu] + uRbar.Ga[mu].DC[uR, mu] + dRbar.Ga[mu].DC[dR, mu] + lRbar.Ga[mu].DC[lR, mu]),
700  FlavorExpand->{SU2W,SU2D}]/.{CKM[a_,b_] Conjugate[CKM[a_,c_]]->IndexDelta[b,c], CKM[b_,a_] Conjugate[CKM[c_,a_]]->IndexDelta[b,c]}];
701
702LHiggs := Block[{ii,mu, feynmangaugerules},
703  feynmangaugerules = If[Not[FeynmanGauge], {G0|GP|GPbar ->0}, {}];
704 
705  ExpandIndices[DC[Phibar[ii],mu] DC[Phi[ii],mu] + muH^2 Phibar[ii] Phi[ii] - lam Phibar[ii] Phi[ii] Phibar[jj] Phi[jj], FlavorExpand->{SU2D,SU2W}]/.feynmangaugerules
706 ];
707
708LYukawa := Block[{sp,ii,jj,cc,ff1,ff2,ff3,yuk,feynmangaugerules},
709  feynmangaugerules = If[Not[FeynmanGauge], {G0|GP|GPbar ->0}, {}];
710 
711  yuk = ExpandIndices[
712   -yd[ff2, ff3] CKM[ff1, ff2] QLbar[sp, ii, ff1, cc].dR [sp, ff3, cc] Phi[ii] -
713    yl[ff1, ff3] LLbar[sp, ii, ff1].lR [sp, ff3] Phi[ii] -
714    yu[ff1, ff2] QLbar[sp, ii, ff1, cc].uR [sp, ff2, cc] Phibar[jj] Eps[ii, jj], FlavorExpand -> SU2D];
715  yuk = yuk /. { CKM[a_, b_] Conjugate[CKM[a_, c_]] -> IndexDelta[b, c], CKM[b_, a_] Conjugate[CKM[c_, a_]] -> IndexDelta[b, c]};
716  yuk+HC[yuk]/.feynmangaugerules
717 ];
718
719LGhost := Block[{LGh1,LGhw,LGhs,LGhphi,mu, generators,gh,ghbar,Vectorize,phi1,phi2,togoldstones,doublet,doublet0},
720  (* Pure gauge piece *)       
721  LGh1 = -ghBbar.del[DC[ghB,mu],mu];
722  LGhw = -ghWibar.del[DC[ghWi,mu],mu];
723  LGhs = -ghGbar.del[DC[ghG,mu],mu];
724
725  (* Scalar pieces: see Peskin pages 739-742 *)
726  (* phi1 and phi2 are the real degrees of freedom of GP *)
727  (* Vectorize transforms a doublet in a vector in the phi-basis, i.e. the basis of real degrees of freedom *)
728  gh    = {ghB, ghWi[1], ghWi[2], ghWi[3]};
729  ghbar = {ghBbar, ghWibar[1], ghWibar[2], ghWibar[3]};
730  generators = {-I/2 g1 IdentityMatrix[2], -I/2 gw PauliSigma[1], -I/2 gw PauliSigma[2], -I/2 gw PauliSigma[3]};
731  doublet = Expand[{(-I phi1 - phi2)/Sqrt[2], Phi[2]} /. MR$Definitions /. vev -> 0];
732  doublet0 = {0, vev/Sqrt[2]};
733  Vectorize[{a_, b_}]:= Simplify[{Sqrt[2] Re[Expand[a]], Sqrt[2] Im[Expand[a]], Sqrt[2] Re[Expand[b]], Sqrt[2] Im[Expand[b]]}/.{Im[_]->0, Re[num_]->num}];
734  togoldstones := {phi1 -> (GP + GPbar)/Sqrt[2], phi2 -> (-GP + GPbar)/(I Sqrt[2])};
735  LGhphi=Plus@@Flatten[Table[-ghbar[[kkk]].gh[[lll]] Vectorize[generators[[kkk]].doublet0].Vectorize[generators[[lll]].(doublet+doublet0)],{kkk,4},{lll,4}]] /.togoldstones;
736
737ExpandIndices[ LGhs + If[FeynmanGauge, LGh1 + LGhw + LGhphi,0], FlavorExpand->SU2W]];
738
739LSM:= LGauge + LFermions + LHiggs + LYukawa + LGhost;
740
741Wvec[mu_,nu_,ii_,jj_]:= Module[{aa},Ta[aa,ii,jj] FS[Wi,mu,nu,aa]];
742
743LSILH := Block[{ii,jj,kk, ff1,ff2,ff3, cc, sp,mu,nu, LHSelf, LHFermions, LHGauge},
744  LHSelf = ExpandIndices[
745    cH/(2 vev^2) del[Phibar[ii] Phi[ii],mu] del[Phibar[jj] Phi[jj],mu] +
746    cT/(2 vev^2) ( Phibar[ii] DC[Phi[ii],mu] - DC[Phibar[ii],mu] Phi[ii]) (Phibar[jj] DC[Phi[jj],mu] - DC[Phibar[jj],mu] Phi[jj]) -
747    c6 lam / vev^2 Phibar[ii] Phi[ii] Phibar[jj] Phi[jj] Phibar[kk] Phi[kk],
748  FlavorExpand->{SU2W,SU2D}];
749
750  LHFermions = ExpandIndices[
751    -cu/vev^2 yu[ff1,ff2] Phibar[ii] Phi[ii] QLbar[sp,jj,ff1,cc].uR[sp,ff2,cc] Phibar[kk] Eps[jj,kk] -
752     cd/vev^2 yd[ff2,ff3] CKM[ff1,ff2] Phibar[ii] Phi[ii] QLbar[sp,jj,ff1,cc].dR[sp,ff3,cc] Phi[jj] -
753     cl/vev^2 yl[ff1,ff2] Phibar[ii] Phi[ii] LLbar[sp,jj,ff1].lR[sp,ff2] Phi[jj],
754  FlavorExpand->{SU2W,SU2D}]/. { CKM[a_, b_] Conjugate[CKM[a_, c_]] -> IndexDelta[b, c], CKM[b_, a_] Conjugate[CKM[c_, a_]] -> IndexDelta[b, c]};
755
756  LHGauge = ExpandIndices[
757    I cWW gw / MW^2     DC[Wvec[mu,nu,ii,jj],nu] (Phibar[ii] DC[Phi[jj],mu] - DC[Phibar[ii],mu] Phi[jj]) +
758    I cB g1 / (2 MW^2) del[FS[B,mu,nu],nu] (Phibar[ii] DC[Phi[ii],mu] - DC[Phibar[ii],mu] Phi[ii]) +
759    2 I cHW gw / MW^2  Wvec[mu,nu,ii,jj] DC[Phibar[ii],mu] DC[Phi[jj],nu] +
760    I cHB g1 / MW^2  FS[B,mu,nu] DC[Phibar[ii],mu] DC[Phi[ii],nu] +
761    cA g1^2 / MW^2 Phibar[ii] Phi[ii] FS[B,mu,nu] FS[B,mu,nu] +
762    cG dum^2 gs^2 / MW^2 Phibar[ii] Phi[ii] FS[G,mu,nu,jj] FS[G,mu,nu,jj],
763  FlavorExpand->{SU2W,SU2D}];
764
765  Return[LHSelf + LHFermions + HC[LHFermions] + LHGauge];
766];
767
768LF1 := Block[{LFQL, LFQR, LFLL, LFLR, ii,jj,kk,ll,sp1,sp2,ff,cc,mu},
769  LFQL = ExpandIndices[
770    I cHQ    / vev^2 QLbar.Ga[mu].QL  ( Phibar[ii] DC[Phi[ii],mu] - DC[Phibar[ii],mu] Phi[ii])  +
771    4 I cpHQ / vev^2 Ta[aa,ii,jj] Ta[aa,kk,ll] Ga[mu,sp1,sp2] QLbar[sp1,ii,ff,cc].QL[sp2,jj,ff,cc]  ( Phibar[kk] DC[Phi[ll],mu] - DC[Phibar[kk],mu] Phi[ll]),
772  FlavorExpand->{SU2W,SU2D}];
773
774  LFQR = ExpandIndices[
775    I cHu    / (2 vev^2) uRbar.Ga[mu].uR  ( Phibar[ii] DC[Phi[ii],mu] - DC[Phibar[ii],mu] Phi[ii])  +
776    I cHd    / (2 vev^2) dRbar.Ga[mu].dR  ( Phibar[ii] DC[Phi[ii],mu] - DC[Phibar[ii],mu] Phi[ii])  +
777    I cHud   / vev^2 Eps[ii,jj] uRbar.Ga[mu].dR  ( Phi[jj] DC[Phi[ii],mu] - DC[Phi[jj],mu] Phi[ii]),
778  FlavorExpand->{SU2W,SU2D}];
779
780  LFLL = ExpandIndices[
781    I cHL    / vev^2 LLbar.Ga[mu].LL  ( Phibar[ii] DC[Phi[ii],mu] - DC[Phibar[ii],mu] Phi[ii])  +
782    4 I cpHL / vev^2 Ta[aa,ii,jj] Ta[aa,kk,ll] Ga[mu,sp1,sp2] LLbar[sp1,ii,ff].LL[sp2,jj,ff]  ( Phibar[kk] DC[Phi[ll],mu] - DC[Phibar[kk],mu] Phi[ll]),
783  FlavorExpand->{SU2W,SU2D}];
784
785  LFLR = ExpandIndices[
786    I cHe    / (2 vev^2) lRbar.Ga[mu].lR  ( Phibar[ii] DC[Phi[ii],mu] - DC[Phibar[ii],mu] Phi[ii]),
787  FlavorExpand->{SU2W,SU2D}];
788
789  Return[LFQL + LFQR + HC[LFQR] + LFLL + LFLR];
790];
791
792LF2 := Block[{LFu, LFd, LFl, sp1,sp2,sp3, mu,nu, ff1,ff2, ii,jj,kk,ll, cc},
793  LFu = ExpandIndices[
794    I cuB g1/(2 MW^2) (Ga[mu,sp1,sp3] Ga[nu,sp3,sp2] - Ga[nu,sp1,sp3] Ga[mu,sp3,sp2] ) yu[ff1,ff2] QLbar[sp1,jj,ff1,cc].uR[sp2,ff2,cc] Phibar[kk] Eps[jj,kk] FS[B,mu,nu] +
795    I cuW gw/MW^2 Ta[ii,jj,ll] (Ga[mu,sp1,sp3] Ga[nu,sp3,sp2] - Ga[nu,sp1,sp3] Ga[mu,sp3,sp2] ) yu[ff1,ff2] QLbar[sp1,jj,ff1,cc].uR[sp2,ff2,cc] Phibar[kk] Eps[ll,kk] FS[Wi,mu,nu,ii] +
796    I cuG gs/MW^2 T[ii,cc1,cc] (Ga[mu,sp1,sp3] Ga[nu,sp3,sp2] - Ga[nu,sp1,sp3] Ga[mu,sp3,sp2] ) yu[ff1,ff2] QLbar[sp1,jj,ff1,cc1].uR[sp2,ff2,cc] Phibar[kk] Eps[jj,kk] FS[G,mu,nu,ii],
797  FlavorExpand->{SU2W,SU2D}];
798
799  LFd = ExpandIndices[
800    I cdB g1/(2 MW^2) (Ga[mu,sp1,sp3] Ga[nu,sp3,sp2] - Ga[nu,sp1,sp3] Ga[mu,sp3,sp2] ) yd[ff2,ff3] CKM[ff1,ff2] QLbar[sp1,jj,ff1,cc].dR[sp2,ff3,cc] Phi[jj] FS[B,mu,nu] +
801    I cdW gw/MW^2 Ta[ii,jj,ll] (Ga[mu,sp1,sp3] Ga[nu,sp3,sp2] - Ga[nu,sp1,sp3] Ga[mu,sp3,sp2] ) yd[ff2,ff3] CKM[ff1,ff2] QLbar[sp1,jj,ff1,cc].dR[sp2,ff3,cc] Phi[ll] FS[Wi,mu,nu,ii] +
802    I cdG gs/MW^2 T[ii,cc1,cc] (Ga[mu,sp1,sp3] Ga[nu,sp3,sp2] - Ga[nu,sp1,sp3] Ga[mu,sp3,sp2] ) yd[ff2,ff3] CKM[ff1,ff2] QLbar[sp1,jj,ff1,cc1].dR[sp2,ff3,cc] Phi[jj] FS[G,mu,nu,ii],
803  FlavorExpand->{SU2W,SU2D}];
804
805  LFl = ExpandIndices[
806    I clB g1/(2 MW^2) (Ga[mu,sp1,sp3] Ga[nu,sp3,sp2] - Ga[nu,sp1,sp3] Ga[mu,sp3,sp2] ) yl[ff1,ff2] LLbar[sp1,jj,ff1].lR[sp2,ff2] Phi[jj] FS[B,mu,nu] +
807    I clW gw/MW^2 Ta[ii,jj,ll] (Ga[mu,sp1,sp3] Ga[nu,sp3,sp2] - Ga[nu,sp1,sp3] Ga[mu,sp3,sp2] ) yl[ff1,ff2] LLbar[sp1,jj,ff1].lR[sp2,ff2] Phi[ll] FS[Wi,mu,nu,ii],
808  FlavorExpand->{SU2W,SU2D}];
809
810  Return[LFu + LFd + LFl + HC[LFu + LFd + LFl]];
811];
812
813LBosons := Block[{LWWW, LGGG, LWW, LBB, LGG, ii,jj,kk,mu,nu,ro},
814  LWWW = ExpandIndices[-I c3W/MW^2 gw^3 FSU2L[ii,jj,kk] FS[Wi,mu,nu,ii] FS[Wi,nu,ro,jj] FS[Wi,ro,mu,kk], FlavorExpand->{SU2D,SU2W}];
815  LGGG = -I c3G/MW^2 gs^3 FSU3C[ii,jj,kk] FS[G,mu,nu,ii] FS[G,nu,ro,jj] FS[G,ro,mu,kk];
816
817  LWW = ExpandIndices[ c2W/MW^2 DC[FS[Wi,mu,nu,ii],mu] DC[FS[Wi,ro,nu,ii],ro], FlavorExpand->{SU2D,SU2W}];
818  LBB = ExpandIndices[ c2B/MW^2 del[FS[B,mu,nu],mu] del[FS[B,ro,nu],ro], FlavorExpand->{SU2D,SU2W}];
819  LGG = c2G/MW^2 DC[FS[G,mu,nu,ii],mu] DC[FS[G,ro,nu,ii],ro];
820
821  Return[LWWW + LGGG + LWW + LGG + LBB];
822];
823
824LCP := Block[{LHV, LVVV, ii,jj,kk,aa,mu,nu,ro,rop,mup, outlag},
825  LHV = ExpandIndices[
826    I Eps[mu,nu,ro,sig] tcHW gw/MW^2 Ta[aa,ii,jj] DC[Phibar[ii],mu] DC[Phi[jj],nu] FS[Wi,ro,sig,aa] +
827    I/2 Eps[mu,nu,ro,sig] tcHB g1/MW^2 DC[Phibar[ii],mu] DC[Phi[ii],nu] FS[B,ro,sig] +
828    1/2 Eps[mu,nu,ro,sig] tcA g1^2/MW^2 Phibar[ii] Phi[ii] FS[B,mu,nu] FS[B,ro,sig] +
829    1/2 Eps[mu,nu,ro,sig] dum^2 tcG gs^2/MW^2 Phibar[ii] Phi[ii] FS[G,mu,nu,aa] FS[G,ro,sig,aa],
830  FlavorExpand->{SU2W,SU2D}];
831
832  LVVV= ExpandIndices[
833    -I/2 Eps[ro,mu,rop,mup] tc3W gw^3/MW^2 FSU2L[ii,jj,kk] FS[Wi,mu,nu,ii] FS[Wi,nu,ro,jj] FS[Wi,rop,mup,kk] +
834    -I/2 Eps[ro,mu,rop,mup] tc3G gs^3/MW^2 FSU3C[ii,jj,kk] FS[G,mu,nu,ii] FS[G,nu,ro,jj] FS[G,rop,mup,kk],
835  FlavorExpand->{SU2W,SU2D}];
836
837  outlag = OptimizeIndex[LHV+LVVV]/.Eps[args__] :> Signature[{args}] Eps[Sequence @@ Sort[{args}]];
838  outlag=outlag /. del[a_, m1_] del[a_, m2_] Eps[n1___, m1_, n2___, m2_, n3___] :> 0;
839
840 Return[ outlag ];
841];
842
843LLOPP := -1/4 GH FS[G, mu, nu, b] FS[G, mu, nu, b] H (1-0*H/(2 vev)) - 1/4 AH FS[A, mu, nu] FS[A, mu, nu] H;
844
845RemoveL2[exp_]:= Block[{tmp=Expand[exp]},
846  tmp=If[Length[tmp]===1,{tmp}, List@@tmp];
847  tmp = Select[tmp, (PRIVATE`GetIntOrder[#]/.{QCD->1, QED->1, PRIVATE`GetIntOrder[__] -> 1}) =!= NP^2 &];
848  tmp = Select[tmp, (PRIVATE`GetIntOrder[#]/.{QCD->1, QED->1, PRIVATE`GetIntOrder[__] -> 1}) =!= NP^3 &];
849  tmp = Select[tmp, (PRIVATE`GetIntOrder[#]/.{QCD->1, QED->1, PRIVATE`GetIntOrder[__] -> 1}) =!= NP^4 &];
850  tmp = Select[tmp, (PRIVATE`GetIntOrder[#]/.{QCD->1, QED->1, PRIVATE`GetIntOrder[__] -> 1}) =!= NP^5 &];
851  tmp = Select[tmp, (PRIVATE`GetIntOrder[#]/.{QCD->1, QED->1, PRIVATE`GetIntOrder[__] -> 1}) =!= NP^6 &];
852  Return[Plus@@tmp];
853];
854
855LagHEL := Block[{lagtmp},
856  lagtmp = {LF1+LF2+LSILH+LBosons+LCP+LSM};
857  lagtmp = RemoveL2[#/.H->H (1- cH/2)] &/@ lagtmp;
858  lagtmp = RemoveL2[#/.G[inds__] :> G[inds] (1 + cG dum^2 gs^2 vev^2/MW^2)] &/@ lagtmp;
859  lagtmp = RemoveL2[#/.Z[mu_] :> Z[mu] (1 + cA  ee^2 (1 - cw^2) vev^2/(cw^2 MW^2))] &/@ lagtmp;
860  lagtmp = RemoveL2[#/.A[mu_] :> A[mu] (1 + cA  ee^2 vev^2/MW^2) - 2 Z[mu] cA  sw ee^2 vev^2/(cw MW^2)] &/@ lagtmp;
861  lagtmp = lagtmp/.Conjugate[CKM[a_, b_]]*CKM[a_, c_]->IndexDelta[b, c];
862  lagtmp = OptimizeIndex/@lagtmp;
863  Return[(Plus@@lagtmp)+LLOPP];
864];
865
866