MSSMatNLO: MoGRe.m

File MoGRe.m, 27.9 KB (added by BenjF, 3 weeks ago)

The MoGRe plugin for FeynRules

Line 
1(* ::Package:: *)
2
3(* ::Section:: *)
4(*Renormalization scheme definitions*)
5
6
7(* ::Subsection:: *)
8(*Declaring unrenormalized parameters*)
9
10
11DefineUnrenormalizedParameters[List[args__]]:=DefineUnrenormalizeOne/@{args};
12
13
14DefineUnrenormalizedParameters[args__]:=DefineUnrenormalizeOne/@{args};
15
16
17DefineUnrenormalizeOne[exp_]:=Block[{},SchemeRules=Append[SchemeRules,FR$delta[{exp},{}]->0];];
18
19
20(* ::Subsection:: *)
21(*Defining a dependent renormalisation constant*)
22
23
24AddRenormalizationCondition[obj_, rule_]:= Block[{}, SchemeRules=Append[SchemeRules,Rule[obj,rule]]];
25
26
27(* ::Subsection::Closed:: *)
28(*Declaring unrenormalized fields*)
29
30
31DeclareUnrenormalizedFields[List[args__]]:=DeclareUnrenormalizedOneField/@{args};
32
33
34DeclareUnrenormalizedFields[args__]:=DeclareUnrenormalizedOneField/@{args};
35
36
37DeclareUnrenormalizedOneField[exp_]:=Block[{},NoRenoFields=Append[NoRenoFields,exp];];
38
39
40(* ::Subsection::Closed:: *)
41(*Removing vanishing internal parameters*)
42
43
44EnforceZeroParameters[]:=PrePutIndices/@Cases[(Rule[#[[1]],#[[2]]]&/@IParamList)/.ParameterSwitchesAndSwaps[][[3]]/.Rule->myr,myr[_,0]]/.myr->Rule;
45
46
47(* ::Subsection::Closed:: *)
48(*Declaring real renormalization constants*)
49
50
51RealFieldRenormalization[{fields__}]:= RealFieldRenormalization/@{fields};
52
53
54RealFieldRenormalization[field_]:=Block[{}, RealRenoFields=Append[RealRenoFields,field]; CnumQ[FR$deltaZ[{field, field},__]]:=False;];
55
56
57RealFieldRenormalization[fields___]:= RealFieldRenormalization/@{fields};
58
59
60RealFieldRenormalization[]:= RealFieldRenormalization/@Select[Flatten[ClassMemberList/@PartList[[All,1,2]]],!(GhostFieldQ[#]===True||GoldstoneQ[#]===True)&];
61
62
63(* ::Subsection::Closed:: *)
64(*Removing an internal parameter renormalization constants*)
65
66
67RemovingInternalCst[param_]:=Block[{},If[FreeQ[InternalRemovalList,param], InternalRemovalList = Append[InternalRemovalList,param]];];
68
69
70ExecuteRemovingInternalCst[]:= DeleteDuplicates[Flatten[Cases[Global`RenormalizationRules["Internals"][[1]]/.Rule->myr,myr[FR$delta[{PrePutIndices[#]},{}],_]] &/@ InternalRemovalList,1]/.myr->Rule];
71
72
73(* ::Subsection::Closed:: *)
74(*Clearing the rules*)
75
76
77ClearRenormalizationScheme[]:=Block[{},
78  If[Length[FR$RmDblExt]===0,FR$RmDblExt={}];
79  Block[{}, CnumQ[FR$deltaZ[{#, _},__]]:=True;]&/@RealRenoFields;
80  SchemeRules = {}; InternalRemovalList = {}; Global`EnforceZeros = True; RealRenoFields={}; NoRenoFields = {};
81  Global`RenormalizationRules["Externals"]={}; Global`RenormalizationRules["Masses"]={}; Global`RenormalizationRules["Internals"]={{},{}};
82  Global`RenormalizationRules["Fields"]={}; Global`RenormalizationRules["Tadpoles"]={}; Global`RenormalizationRules["MassShifts"] = {};
83];
84
85
86ClearRenormalizationScheme[];
87
88
89(* ::Subsection::Closed:: *)
90(*Enforcing the scheme*)
91
92
93SchemeDependence[rules_]:=Block[{output=rules/.SchemeRules},
94  output=DeleteCases[output,Rule[a_,a_]];
95  Return[output];
96];
97
98
99SchemeDependenceInternal[{intdefs_, intrules_}]:=Block[{newintdefs, newintrules},
100  (* Simplifying the definitions and the rules according to the scheme *)
101  newintdefs = If[FreeQ[#[[2]],FR$delta],Rule[#[[1]],Simplify[#[[2]]]],#]&/@SchemeDependence[intdefs];
102  newintrules=intrules/.newintdefs;
103  newintrules=If[FreeQ[Coefficient[#[[2]],FR$CT],FR$delta],Rule[#[[1]],(#[[2]]/.FR$CT->0)+FR$CT*Simplify[Coefficient[#[[2]],FR$CT]]],#]&/@newintrules;
104  newintrules=SchemeDependence[newintrules];
105  newintrules=Rule[#[[1]], Collect[#[[2]],{FR$delta[__], FR$deltaZ[__]}]]&/@newintrules;
106  newintrules=Rule[#[[1]],#[[1]]+FR$CT*FR$delta[{#[[1]]},{}]]&/@newintrules;
107  newintrules = newintrules/.FR$delta[{Conjugate[aaa_]},{}]:>Conjugate[FR$delta[{aaa},{}]];
108  newintdefs=DeleteCases[newintdefs,Rule[_,0]];
109  (* output *)
110  Return[{PrePutIndices/@newintdefs,PrePutIndices/@newintrules}];
111];
112
113
114(* ::Section:: *)
115(*Misc*)
116
117
118(* ::Subsection::Closed:: *)
119(*Definitions*)
120
121
122numQ[FR$CT]=True;  CnumQ[FR$CT]=False;
123
124
125(* ::Subsection::Closed:: *)
126(*Printing*)
127
128
129(* ::Text:: *)
130(*Set of methods for print statements*)
131
132
133TimeStamp[method_, msg_,t0_]:= Block[{ti=SessionTime[]},Print[Style[method,Orange,Bold],": ",msg ," done in ", ti-t0," seconds"];Return[ti];];
134SubMethodStamp[method_, msg_]:= Print[Style[method,Darker[Green],Bold],": starting ", msg];
135Error[ msg_]:=Print[Style["  ** Error: ",Darker[Red],Bold], msg];
136Warning[ msg_]:=Print[Style["  ** Warning: ",Darker[Purple],Bold], msg];
137DebugPrint[msg__]:=If[Global`MoGRe$Debug,Print[msg]];
138
139
140(* ::Subsection::Closed:: *)
141(*Parallelization*)
142
143
144(* ::Text:: *)
145(*Condition for parallelization (expressions longer than 40 terms and kernel availability)*)
146
147
148DoPara[expr_]:=Global`FR$Parallelize && Length[expr]>40 && $KernelCount>1;
149
150
151(* ::Text:: *)
152(*Options of the method*)
153
154
155Options[ParaExec]={Opts->MR$Null};
156
157
158(* ::Text:: *)
159(*Main method (two ways, depending whether the method to parallelize has options*)
160
161
162ParaExec[func_,arg_,OptionsPattern[]]:=Block[{myoptions=OptionValue[Opts],tmpres,inter},
163
164  tmpres=If[myoptions=!=MR$Null,
165    (* with options *)
166    DistributeDefinitions[myoptions];SetSharedFunction[func];
167    Table[inter=arg[[ii]]; ParallelSubmit[{ii,inter},$Output={}; tmpres=func[inter,Sequence@@myoptions]; $Output={OutputStream["stdout",1]}; tmpres],{ii,Length[arg]}],
168
169    (*no options *)
170    SetSharedFunction[func];
171    Table[inter=arg[[ii]]; ParallelSubmit[{ii,inter},$Output={}; tmpres=func[inter]; $Output={OutputStream["stdout",1]}; tmpres],{ii,Length[arg]}]
172  ];
173
174  (* output and exit *)
175  tmpres=WaitAll[tmpres];
176  Return[tmpres];
177];
178
179
180(* ::Subsection::Closed:: *)
181(*Get the class name of a particle*)
182
183
184ParticleClassName[particle_]:=If[MemberQ[PartList[[All,1,2]],particle], Cases[PartList[[All,1]],{_,particle}][[1,1]],Error["The particle does not exist"];Abort[]];
185
186
187(* ::Subsection::Closed:: *)
188(*Get the index type of the flavor index*)
189
190
191ParticleClassFlavorType[class_]:=FlavorIndex/.MR$ClassesRules[class];
192
193
194(* ::Section:: *)
195(*Checks*)
196
197
198(* ::Subsection::Closed:: *)
199(*Mixing*)
200
201
202(* ::Text:: *)
203(*Checks whether the mixing pattern is either a boolean, or a list of 2-tuples*)
204
205
206CheckRenormalizeOptions["Mixing", mixpattern_]:= Block[{},
207  If[BooleanQ[mixpattern],Return[]];
208  If[Not[ListQ[mixpattern]], Error["The mixing fields must be provided as a list of n-tuples"]; Abort[]];
209  If[Not[And@@(ListQ/@mixpattern)], Error["The mixing fields must be provided as a list of n-tuples"]; Abort[]];
210  If[Not[And@@((#===1)&/@(Length[Union[#]]&/@Map[Through,Map[MR$QuantumNumbers,#]&/@mixpattern,{2}]))],
211     Error["Imposing the one-loop mixing of fields with different quantum numbers"]; Abort[];]
212];
213
214
215(* ::Subsection::Closed:: *)
216(*Coupling orders*)
217
218
219(* ::Text:: *)
220(*Checks whether the selected coupling orders are consistent with the QCDOnly option*)
221
222
223CheckRenormalizeOptions["Couplings",couplingorders_]:=Block[{},
224  If[Not[ListQ[couplingorders]],Error["The CouplingOrders option must be a list of coupling orders"]; Abort[]];
225  If[Complement[couplingorders,M$InteractionOrderHierarchy[[All,1]]]=!={},Error["At least one unknown CouplingOrder"]; Abort[]];
226];
227
228
229(* ::Subsection::Closed:: *)
230(*Vevs*)
231
232
233VevDeclarations[]:= Block[{},
234  If[Not[And@@(!FreeQ[#[[1]]//.MR$Definitions,#[[2]]]&/@M$vevs)], Error["vev declarations (M$vevs) incompatible with (unphysical) field definitions."]; Abort[]];
235];
236
237
238(* ::Section:: *)
239(*Formatting the Lagrangian so that it could be processes by the renormalization method*)
240
241
242(* ::Text:: *)
243(*This method flavor-expands the Lagrangian (necessary as some fields of a given class can be massive or massless so that the renormalization is different.*)
244(*Next, the 4-scalar interactions are factored out in case they do not need to be renormalized (option to be provided by the user)*)
245
246
247FormattingLagrangian[lag_,no4S_]:=Block[{tmplag,lag4S={},l2pt,irules},
248  (* init *)
249  tmplag=PRIVATE`Listize[lag];
250
251  (* 1. Flavor expansion *)
252  tmplag=If[DoPara[tmplag],
253    DebugPrint["  ** Expanding indices over ", Global`FR$KernelNumber," cores"];
254    ParaExec[ExpandIndices,tmplag,Opts->{FlavorExpand->True}],
255    DebugPrint["  ** Expanding indices"];
256    Plus@@(ExpandIndices[#,FlavorExpand->True]&/@tmplag)
257  ];
258  tmplag=PRIVATE`Listize[Plus@@tmplag];
259 
260  (* 2. Removing 4-scalar interactions *)
261  If[no4S,
262    DebugPrint["  ** Removing four scalar interactions"];
263    lag4S=Select[tmplag,(GetFieldContent[#]/._?ScalarFieldQ -> S)==={S,S,S,S}&];
264    tmplag=Complement[tmplag,lag4S];
265  ];
266
267  (* Cleaning the two-point/one-point interactions *)
268  irules = DeleteCases[(Rule[#[[1]],#[[2]]]&/@IParamList)/.ParameterSwitchesAndSwaps[][[3]],Rule[_,0]];
269  irules = Join[ParameterSwitchesAndSwaps[][[2]],Flatten[irules/.ConditionalExpression[a_,_]->a]/.ParameterSwitchesAndSwaps[][[2]]];
270  irules=(If[MemberQ[ParameterSwitchesAndSwaps[][[1]][[All,2]],#1],Solve[#1==(#2//.irules),Cases[ParameterSwitchesAndSwaps[][[1]],{_,#1}][[1,1]]][[1,1]],#1->#2]&)@@@irules;
271  irules = Rule[#[[1]],#[[2]]//.MR$Definitions]&/@irules;
272  irules = Rule[#[[1]],#[[2]]//.irules]&/@irules;
273  l2pt=Join[DeleteCases[GetQuadraticTerms/@tmplag,0], Select[tmplag,Length[GetFieldContent[#]]===1&]];
274  tmplag=Complement[tmplag,PRIVATE`Listize[Plus@@l2pt]];
275  l2pt=Simplify/@ (l2pt//.Join[MR$Definitions,Rule[PrePutIndices[#[[1]]],#[[2]]]&/@irules]);
276 
277  (* output *)
278  Return[{Join[tmplag,l2pt],lag4S}];
279];
280
281
282(* ::Section:: *)
283(*Field renormalization*)
284
285
286(* ::Subsection::Closed:: *)
287(*Shortcut to get a field renormalization constant*)
288
289
290ConstructDeltaZ[fld1_,fld2_,idx_,newidx_,tp___]:= FR$CT*FR$deltaZ[{fld1,fld2},{DeleteCases[Append[Cases[idx,Index[FindClassFlavor[fld1],_]],Index[FindClassFlavor[fld2],newidx]],Index[MR$Null,_]]}, tp];
291
292
293(* ::Subsection:: *)
294(*Main method to get the replacement rule 'bare field => renormalized field'*)
295
296
297(* ::Text:: *)
298(*The method starts by defining a unique sequence of indices that the given field carries.*)
299(*Then, all fields with which the given field can mix, at the loop-level, are determined.*)
300(*The renormalized field can then be computed, with off-diagonal terms corresponding to the potential mixing pattern.*)
301(*The results for the antifeld are then derived, and the replacement rule finally generated.*)
302
303
304RenormalizeField[field_]:= Block[{FreeIndices,SummedIndices,MixList,rfield=field,result,antiresult,newidx=Unique["idx"],spidx=Index[Spin,Unique["sp"]]},
305  (* 1. Indices *)
306  FreeIndices=List@@PrePutIndices[field[Sequence@@Table[Unique["idx"],{Length[$IndList[field]]}]]];
307
308  (* 2. Potiential mixing generated at the loop level *)
309  If[AntiFieldQ[field]===True,rfield=anti[field]];
310  MixList=DeleteCases[PRIVATE`MR$ClassNameList,_?(UnphysicalQ[#]===True&)];
311  MixList=DeleteCases[ MixList,_?(DeleteCases[$IndList[#],Index[FindClassFlavor[#]]]=!=DeleteCases[$IndList[rfield],Index[FindClassFlavor[rfield]]]&)];
312  MixList=(DeleteCases[ MixList,_?( Through[MR$QuantumNumbers[#]]=!=Through[MR$QuantumNumbers[rfield]]&)]);
313
314  (* 3. Main routine *)
315  result=(If[FermionQ[rfield]===True && GhostFieldQ[rfield]=!=True,
316    ConstructDeltaZ[rfield,#, FreeIndices,newidx,"L"]*ProjM[FreeIndices[[1]],spidx] + ConstructDeltaZ[rfield,#,FreeIndices,newidx,"R"] * ProjP[FreeIndices[[1]],spidx],
317    ConstructDeltaZ[rfield,#, FreeIndices,newidx]]*
318    (#[Sequence@@DeleteCases[$IndList[#]/.(FreeIndices/.Index[a_,b_]:>Rule[Index[a],Index[a,b]])/.{Index[Spin,_]->spidx,Index[FindClassFlavor[#],___]->Index[FindClassFlavor[#],newidx]},Index[MR$Null,_]]]/.#[]->#)
319  )&/@MixList;
320  result=Expand[(rfield[Sequence@@FreeIndices]/.rfield[]->rfield )+Plus@@result/2];
321
322  (* Majorana *)
323  If[FermionQ[rfield]===True && SelfConjugateQ[field], result = Expand[result/.{FR$deltaZ[{a_,b_}, {{}}, "R"]:>FR$deltaZ[{a,b}, {{}}, "L"]}]];
324
325  (* 4. Derivation of results for the antifield case *)
326  antiresult=result;
327  If[AntiFieldQ[field]===True,
328    result=result/.{fld_?(FieldQ[#]===True&)->anti[fld],FR$deltaZ[args__]->Conjugate[FR$deltaZ[args]],ProjP[a_,b_]->ProjM[b,a],ProjM[a_,b_]->ProjP[b,a]};
329    result=Refine[result/.FR$deltaZ[{fi_?(AntiFieldQ[#]===True&),gi_?(AntiFieldQ[#]===True&)},bla___]:>FR$deltaZ[{anti[fi],anti[gi]},bla],Assumptions->Element[FR$CT,Reals]],
330    (* else *)
331    antiresult=result/.{fld_?(FieldQ[#]===True&)->anti[fld],FR$deltaZ[args__]->Conjugate[FR$deltaZ[args]],ProjP[a_,b_]->ProjM[b,a],ProjM[a_,b_]->ProjP[b,a]};
332    antiresult=Refine[antiresult/.FR$deltaZ[{fi_?(AntiFieldQ[#]===True&),gi_?(AntiFieldQ[#]===True&)},bla___]:>FR$deltaZ[{anti[fi],anti[gi]},bla],Assumptions->Element[FR$CT,Reals]]
333  ];
334
335  (* 5. Creating elements for the replacement rule *)
336  SummedIndices=Union[Flatten[Complement[PRIVATE`ToIndexList[#]/.Index[_,a_]->a, FreeIndices/.Index[_,a_]->a]&/@List@@result]];
337  FreeIndices=#/.Index[a_,b_]:>Index[a,MyPattern[b,Blank[]]]&/@FreeIndices;
338  rfield=field[Sequence@@FreeIndices]/.a_?(FieldQ[#]===True&)[]->a/.MyPattern->Pattern;
339
340  (* 6. Outputting the replacement rule *)
341  result=If[field===anti[field], {MyRuleDelayed[rfield,MyModule[SummedIndices,result]]}, {MyRuleDelayed[rfield,MyModule[SummedIndices,result]],MyRuleDelayed[anti[rfield],MyModule[SummedIndices,antiresult]]}];
342  Return[result/.{MyRuleDelayed->RuleDelayed,MyModule[{},a_]->a}/.MyModule->Module];
343];
344
345
346(* ::Subsection::Closed:: *)
347(*Expansion over flavors*)
348
349
350(* ::Text:: *)
351(*This perform a full flavor expansion in the rules (to get one rule for each flavor) and in the expression (to have no implicit summed flavor index in the rules)*)
352(*First, this method checks what is the flavor index of the bare field and makes this expansion.*)
353(*Next, it gets the summed flavor indices in the rules, and makes this flavor expasion.*)
354
355
356FlavorExpFieldReno[field_, rule_]:=Block[{myfield=field,flavtype,flavindex,nflavors,newfields={field},newrules={rule},kill},
357  (* we need the field name and not the antifield name *)
358  If[AntiFieldQ[Head[field]], myfield=anti[field]];
359
360  (* treatment of the flavor of the field *)
361  If[PRIVATE`FlavoredQ[field],
362    (* We get the type of flavor index, its range and the name of the index as it apepars in the replacement rule*)
363    flavtype=ParticleClassFlavorType[ParticleClassName[Head[myfield]]];
364    flavindex=(Cases[List@@field, Index[flavtype,_]]/.Pattern->mypattern/.mypattern[a_,_]:>a)[[1]];
365    nflavors = IndexRange[Index[flavtype]][[-1]];
366 
367   (* from class to classmembers *)
368    newfields=Table[ApplyDefinitions[field/.Index[flavtype,_]->Index[flavtype,ii]],{ii,nflavors}]/.fld_?(FieldQ[#]===True&)[]->fld;
369    newrules=Table[
370      ApplyDefinitions[Refine[rule,Assumptions->Element[FR$CT,Reals]]/.flavindex->Index[flavtype,ii]/.FR$deltaZ[{a_,b_},{{Index[flavtype,ii],c___}},tp___]:>FR$deltaZ[{ClassMemberList[Head[myfield]][[ii]],b},{{c}},tp]],
371    {ii,nflavors}];
372    newrules=newrules/.fld_?(FieldQ[#]===True&)[]->fld
373  ];
374
375  (* Treating the implicit sums *)
376  newrules=newrules/.{
377    FR$deltaZ[{a_, cls_}, {{ix_}},tp___]*fld_[c___, ix_,d___]:>Plus@@Table[ApplyDefinitions[FR$deltaZ[{a, ClassMemberList[cls][[jj]]}, {{}},tp]*PrePutIndices[fld[c,jj,d]]],{jj,Length[ ClassMemberList[cls]]}]*kill[ix],
378    Conjugate[FR$deltaZ[{a_, cl_}, {{ix_}},tp___]]*fld_[c___, ix_,d___]:>Plus@@Table[ApplyDefinitions[Conjugate[FR$deltaZ[{a,ClassMemberList[cl][[jj]]},{{}},tp]]*PrePutIndices[fld[c,jj,d]]],{jj,Length[ClassMemberList[cl]]}]*kill[ix]
379  }/.fld_?(FieldQ[#]===True&)[]->fld/.kill[Index[_,a_]]->kill[a];
380  newrules=newrules/.{mymod[{a1___,ix_,a2___},bla_]:>mymod[{a1,a2},bla]/; Not[FreeQ[bla,kill[ix]]]}//.{kill[_]->1, mymod[{},bla_]->bla};
381
382  (* output *)
383  Return[Inner[RuleDelayed,newfields,newrules,List]/.mymod->Module];
384];
385
386
387(* ::Subsection::Closed:: *)
388(*Field mixing*)
389
390
391(* ::Text:: *)
392(*This method removes potential loop-induced mixings if not needed.*)
393(*By default, all potential mixings are kept, except of FieldMixing is set to False or contains a list of 2-tuples representing all fields that can mix*)
394
395
396TreatFieldMixing[renorule_,mix_]:=Block[{right = (renorule/.Module->mod)[[2]]},
397
398  (* Field mixing is not allowed *)
399  If[mix===False,Return[myrd[renorule[[1]],right/.{FR$deltaZ[{a_,b_},__]:>0/;a=!=b}]/.myrd->RuleDelayed/.mod->Module]];
400
401  (* Field mixing only allowed for specific fields *)
402  Return[myrd[renorule[[1]],right/.{FR$deltaZ[{flds__},__]:>0/;(Not[MatchQ[{flds},{a_,a_}]]&& Not[MemberQ[Sort/@Flatten[Subsets[#,{2}]&/@mix,1],Sort[{flds}]]] )}]/.myrd->RuleDelayed/.mod->Module];
403
404];
405
406
407(* ::Subsection:: *)
408(*Tadpole renormalization*)
409
410
411TadpoleShift[vev_,field_]:=Block[{ShiftedField},
412  (* Sanity check *)
413  If[Not[SelfConjugateQ[field]],Error["All fields getting a vev must be selfconjugate"];Abort[]];
414
415  (* Getting the shift *)
416  ShiftedField=Select[Expand[If[Im[Coefficient[field,vev]]===0,(field+HC[field])/.{vev->0},(field-HC[field])/.{vev->0}]],FieldQ[#]===True&];
417  CnumQ[FR$deltat[ShiftedField]]=False;
418  Return[Rule[ShiftedField,ShiftedField-FR$CT*FR$deltat[ShiftedField]/Mass[ShiftedField]^2]];
419];
420
421
422TadpoleShifts[fields_]:=Block[{RelevantFields = Select[fields,ScalarFieldQ[#]===True&],rules},
423  (*Sanity checks *)
424  VevDeclarations[];
425
426  (* Getting the field connected with the vevs and creating the rule; filtering all irrelevant fields*)
427  rules=TadpoleShift[Sequence@@#]&/@({#[[2]],#[[1]]/.MR$Definitions}&/@M$vevs);
428  Return[Select[rules,MemberQ[RelevantFields,#[[1]]]&]];
429];
430
431
432DeltaMShifts[lag_]:=Block[{massterms,shifts,FR$delta2,shiftedlag},
433  (* Extracting the mass shift induced by the normalization procedure *)
434  massterms =Select[lag,!FreeQ[#,FR$CT]&&FreeQ[#,FR$deltaZ]&& FreeQ[#,_?(GhostFieldQ[#]===True&)]&& FreeQ[#,_?(GoldstoneQ[#]===True&)]&& Length[GetFieldContent[#]]===2&];
435  $Output=OpenWrite[];massterms=(GetMassSpectrum[Plus@@massterms])[[1,2;;,{1,2}]];$Output={OutputStream["stdout",1]};
436  shifts=Flatten[If[FreeQ[#,FR$delta],{},Solve[Simplify[#[[2]]/.{FR$deltat[_]->0,FR$delta->FR$delta2}]==#[[2]],{Cases[#[[2]],_FR$delta,\[Infinity]][[1]]}]/.FR$delta2->FR$delta]&/@massterms];
437 
438  (* Preparing the replacement rules and applying them *)
439  shifts=Join[shifts, (Expand[#/.shifts]&/@Global`RenormalizationRules["Internals"][[1]])];
440  shifts=Select[shifts,!MemberQ[Global`RenormalizationRules["Internals"][[1,All,2]],#[[2]]]&];
441  shiftedlag =Expand[#/.shifts]&/@lag;
442
443  (* output *)
444  Return[{shifts, PRIVATE`Listize[Expand[Plus@@shiftedlag]]}];
445];
446
447
448(* ::Subsection::Closed:: *)
449(*Wrapper*)
450
451
452(* ::Text:: *)
453(*Loop over all relevant fields; the lagrangian must be properly formatted*)
454
455
456Renormalization["Fields", lag_, couplingorders_]:= Block[{fields, orderrules,myrule},
457  (* Relevant orders *)
458  orderrules =myrule[#,1]&/@ Select[M$InteractionOrderHierarchy[[All,1]],Not[MemberQ[couplingorders,#]]&];
459
460  (* Getting the fields involved in the interactions related to the coupling orders under consideration *)
461  fields=Select[lag, Union[
462    Map[PRIVATE`GetIntOrder,If[ListQ[#],#,{#}]//.{ del[a_,_]->a,_?(FieldQ[#]===True&)[__]->1,Dot->Times,Index[_,i_]->i}]/.PRIVATE`GetIntOrder->IntOrder/.(orderrules/.myrule->Rule)]=!={1}&];
463  fields=Flatten[GetFieldContent/@fields];
464  fields=Union[If[AntiFieldQ[#],anti[#],#]&/@ DeleteCases[fields,_?(UnphysicalQ[#] || GhostFieldQ[#]===True &)]];
465  fields = Select[fields,!MemberQ[NoRenoFields,#]&];
466
467  (* Renormalization *)
468  fields = Flatten[RenormalizeField /@ fields];
469
470  (* exiting the function *)
471  Return[fields];
472];
473
474
475(* ::Section:: *)
476(*Parameter renormalization*)
477
478
479(* ::Subsection:: *)
480(*Get replacement rules*)
481
482
483(* ::Text:: *)
484(*This method check whether some external parameters and internal parameters must be traded.  It then gets a formatted list for the switches.*)
485(*It also format the parameter names (matrix elements with things as "1x1" for the "1,1" element must be replaced by things like M[1,1])*)
486
487
488ParameterSwitchesAndSwaps[]:=Block[{switches1,switches2,renames},
489
490  (* Getting and formatting the switches *)
491  switches1=DeleteCases[FR$LoopSwitches/.Index[_,b_]->b/.MR$Restrictions,Rule[_,0]];
492  switches2=DeleteCases[FR$RmDblExt/.Index[_,b_]->b/.MR$Restrictions,Rule[_,0]];
493  renames = Reverse/@DeleteCases[Union[Rule[#[[1]],#[[2]]]&/@PRIVATE`$ParamListtemp],Rule[a_,a_]]/.Index[_,b_]->b;
494
495  (* output *)
496  Return[{switches1,switches2,renames}];
497];
498
499
500(* ::Subsection:: *)
501(*Main method to get the replacement rules 'bare parameter' to 'renormalized parameter'*)
502
503
504(* ::Text:: *)
505(*The method starts by getting all necessary switches (trade-of of external/internal parameters, etc...).*)
506(*Then we start the real business:*)
507(*   - we get the list of External parameters.*)
508(*   - we focus on the internal parameters and deduce the list of those that can appear in the bare Lagrangian*)
509(*   - we then get the list of masses to renormalize (removing those of the non QCD fields in the QCD case)*)
510(* Finally, we renormalize the external parameters (g -> g + delta g) and deduce the renormalization relations for the internal parameters.*)
511
512
513Renormalization["Parameters", fields_]:=Block[{switches, Externals,Internals, Masses, IntRules, ZeroRules},
514  (* Getting the switches *)
515  switches = ParameterSwitchesAndSwaps[];
516
517  (* External parameters (without the masses and after applying the switches *)
518  Externals=Sort[Flatten[EParamList[[All,2,All,2,1]]]]/.switches[[3]]/.Rule@@@switches[[1]]/.switches[[2]];
519  Externals=Select[Externals,Not[MemberQ[MassList[[2,All,2]],#]]&];
520  (CnumQ[FR$delta[{#},{}]]=CnumQ[#])&/@Externals;
521
522  (* Internal parameters (applying the switches where relevant) *)
523  Internals = If[Global`EnforceZeros,
524    DeleteCases[(Rule[#[[1]],#[[2]]]&/@IParamList)/.switches[[3]],Rule[_,0]],
525    (Rule[#[[1]],#[[2]]]&/@IParamList)/.switches[[3]]
526  ];
527  Internals=If[FreeQ[switches[[1,All,2]],#[[1]]],#,Solve[#[[1]]==(#[[2]]//.Internals),Cases[switches[[1]],{_,#[[1]]}][[1,1]] ][[1]]]&/@Internals;
528  Internals=Join[switches[[2]],Flatten[Internals/.ConditionalExpression[a_,_]->a]/.switches[[2]]];
529  Internals = Rule[#[[1]],#[[2]]//.MR$Definitions]&/@Internals;
530  Internals = Rule[#[[1]],#[[2]]//.Internals]&/@Internals;
531
532  (* Masses *)
533  Masses=DeleteCases[Union[Mass/@fields],0];
534  (CnumQ[FR$delta[{#},{}]]=False)&/@Masses;
535
536  (* From bare parameters to renormalized parameters *)
537  Externals=Rule[#,#+FR$CT*FR$delta[{#},{}]]&/@Externals;
538  Masses=Rule[#,#+FR$CT*FR$delta[{#},{}]]&/@Masses;
539  IntRules =Select[ Internals/.Join[Externals, Masses],Not[FreeQ[#,FR$CT]]&];
540  ZeroRules =Rule[FR$delta[{#},{}],0]&/@Select[ Internals/.Join[Externals, Masses],FreeQ[#,FR$CT]&][[All,1]];
541  Internals=Flatten[If[CnumQ[#], List[Rule[#,#+FR$CT*FR$delta[{#},{}]],Rule[Conjugate[#],Conjugate[#]+FR$CT*Conjugate[FR$delta[{#},{}]]]],Rule[#,#+FR$CT*FR$delta[{#},{}]]]&/@Internals[[All,1]]];
542  Internals=DeleteCases[Internals/.ZeroRules,Rule[a_,a_]];
543  Internals = Internals/.FR$delta[{Conjugate[aaa_]},{}]:>Conjugate[FR$delta[{aaa},{}]];
544  IntRules=Rule[#[[1]],Expand[Normal[Series[#[[2]],{FR$CT,0,1}]]/(Normal[Series[#[[2]],{FR$CT,0,0}]]/#[[1]])]]&/@IntRules;
545  IntRules = Rule[FR$delta[{#[[1]]},{}],Collect [#[[2]]-#[[1]],{ FR$delta[__]},Simplify]]/.FR$CT->1&/@IntRules;
546 
547  (* Output *)
548  Return[{Externals,Masses, Internals, IntRules}];
549];
550
551
552(* ::Section:: *)
553(*Tools*)
554
555
556(* ::Subsection:: *)
557(*Get all renormalization constants*)
558
559
560(* ::Text:: *)
561(*Allow to extract all the possible renormalization constants of the *)
562
563
564ParameterRenormalizationConstants[]:= Block[{RenoPrms,RenoFields,dummy,tmplag},
565  {RenoPrms,dummy,dummy,dummy}=Renormalization["Parameters",{}]; 
566  RenoPrms = DeleteCases[Coefficient[#,FR$CT]&/@RenoPrms[[All,2]],Conjugate[__]];
567  RenoPrms = Join[FR$delta[{#},{}]&/@Union[MassList[[2,All,2]]],RenoPrms];
568  Return[Union[RenoPrms]];
569];
570
571
572FieldRenormalizationConstants[lag_]:=Block[{dummy = Global`MoGRe$Debug, tmplag, RenoFields},
573  (* Verbose = off *)
574  Global`MoGRe$Debug=False;
575
576  (* Lagrangian formatting *)
577  tmplag = Expand[lag-(lag/.{(_?FieldQ)[__]->0,_?FieldQ->0})];
578  tmplag= FormattingLagrangian[tmplag,False][[1]];
579
580  (* Constants *)
581  RenoFields=Flatten[FlavorExpFieldReno[Sequence@@(#/.{Module->mymod})]&/@Renormalization["Fields",tmplag,OptionValue[Global`MoGRe$Renormalize,CouplingOrders]]];
582  If[OptionValue[Global`MoGRe$Renormalize,FlavorMixing]=!=True,RenoFields = TreatFieldMixing[#,OptionValue[Global`MoGRe$Renormalize,FlavorMixing]]&/@RenoFields];
583  RenoFields=Expand[Coefficient[#,FR$CT]]&/@RenoFields[[All,2]];
584  RenoFields=Union[DeleteCases[Select[Expand[#],!FreeQ[#,FR$deltaZ]&]&/@(RenoFields/.Plus->Sequence),Conjugate[_]]];
585
586  (* Output and verbose set to default again *)
587  Global`MoGRe$Debug = dummy;
588  Return[RenoFields];
589];
590
591
592RenormalizationConstants[lag_]:= InputForm[Join[FieldRenormalizationConstants[lag], ParameterRenormalizationConstants[]]];
593
594
595(* ::Section:: *)
596(*Main method*)
597
598
599ShiftRules[]:= Block[{irules,rules},
600  irules = ExecuteRemovingInternalCst[];
601  rules = Join[Global`RenormalizationRules["Externals"],Global`RenormalizationRules["Masses"],Global`RenormalizationRules["Internals"][[2]],Global`RenormalizationRules["Fields"]];
602  Return[rules/.irules];
603];
604
605
606Options[Global`MoGRe$Renormalize]={Exclude4Scalars->False,FlavorMixing->True, Global`CouplingOrders->M$InteractionOrderHierarchy[[All,1]]};
607
608
609Global`MoGRe$Renormalize[lag_, OptionsPattern[]]:=Block[{time=SessionTime[],lasttime,tmplag,lag4S, dum1, dum2,ishift,tmpCC},
610
611  (* Initialization *)
612  If[Global`MoGRe$Debug,SubMethodStamp["Renormalize[]","initialization"]];
613  FR$Loop=True;                (*Keep two point in the vertex list*)
614  CheckRenormalizeOptions["Mixing",OptionValue[FlavorMixing]];
615  CheckRenormalizeOptions["Couplings",OptionValue[CouplingOrders]];
616  tmplag = Expand[lag-(lag/.{(_?FieldQ)[__]->0,_?FieldQ->0})];
617  If[Global`EnforceZeros, tmplag = tmplag/.EnforceZeroParameters[]];
618  If[Global`MoGRe$Debug,lasttime=TimeStamp["Renormalize[]","initialization" ,time]];
619 
620  (* Formatting the Lagrangian *)
621  If[Global`MoGRe$Debug,SubMethodStamp["Renormalize[]","Lagrangian formatting"]];
622  {tmplag,lag4S} = FormattingLagrangian[tmplag,OptionValue[Exclude4Scalars]];
623  If[Global`MoGRe$Debug,lasttime=TimeStamp["Renormalize[]","Lagrangian formatting" ,lasttime]];
624 
625  (* Field renormalization *)
626  If[Global`MoGRe$Debug,SubMethodStamp["MoGRe$Renormalize[]","field renormalization"]];
627  DebugPrint["  ** Getting the replacement rules (bare into renormalized)"];
628  Global`RenormalizationRules["Fields"]=Flatten[FlavorExpFieldReno[Sequence@@(#/.{Module->mymod})]&/@Renormalization["Fields",tmplag, OptionValue[CouplingOrders]]];
629  If[OptionValue[FlavorMixing]=!=True,
630    DebugPrint["  ** Removing unnecessary field mixing"];
631    Global`RenormalizationRules["Fields"] = TreatFieldMixing[#,OptionValue[FlavorMixing]]&/@Global`RenormalizationRules["Fields"];
632  ];
633  DebugPrint["  ** tadpole renormalization"];
634  Global`RenormalizationRules["Tadpoles"] = TadpoleShifts[If[Head[#]=!=Symbol, Head[#], #]&/@Global`RenormalizationRules["Fields"][[All,1]]];
635  If[Global`MoGRe$Debug,lasttime=TimeStamp["BF$enormalize[]","field renormalization" ,lasttime]];
636
637  (* Parameter renormalization *)
638  If[Global`MoGRe$Debug,SubMethodStamp["MoGRe$Renormalize[]","parameter renormalization"]];
639  DebugPrint["  ** Getting the replacement rules (bare into renormalized)"];
640  {Global`RenormalizationRules["Externals"],Global`RenormalizationRules["Masses"],dum2,dum1}=Renormalization["Parameters",If[Head[#]=!=Symbol, Head[#], #]&/@Global`RenormalizationRules["Fields"][[All,1]]];
641  Global`RenormalizationRules["Internals"]={dum1,dum2};
642  DebugPrint["  ** Enforcing the renormalization scheme"];
643  Global`RenormalizationRules["Externals"]= SchemeDependence[Global`RenormalizationRules["Externals"]];
644  Global`RenormalizationRules["Masses"]   = SchemeDependence[Global`RenormalizationRules["Masses"]];
645  Global`RenormalizationRules["Internals"]= SchemeDependenceInternal[Global`RenormalizationRules["Internals"]];
646  If[Global`MoGRe$Debug,lasttime=TimeStamp["MoGRe$Renormalize[]","parameter renormalization" ,lasttime]];
647   
648  (* Lagrangian (with a special treatment for charge-conjugate fields) *)
649  If[Global`MoGRe$Debug,SubMethodStamp["MoGRe$Renormalize[]","Lagrangian renormalization"]];
650  DebugPrint["  ** Shifting parameters and fields"];
651  ishift = ShiftRules[];
652  tmplag = (#/.CC[fld_][inds__]:>tmpCC[fld[inds]]/.ishift/.Global`RenormalizationRules["Tadpoles"])&/@tmplag;
653  tmplag =Normal[Series[(Expand[#/.tmpCC->CC/.Dot->FR$Dot/.FR$Dot->Dot]),{FR$CT,0,1}]]&/@tmplag;
654  tmplag=PRIVATE`Listize[Expand[Plus@@tmplag]];
655  DebugPrint["  ** Absorbing all mass shifts in the renormalization constant"];
656  {Global`RenormalizationRules["MassShifts"],tmplag}=DeltaMShifts[tmplag]; 
657  tmplag = Collect[#,{FR$CT},Simplify]&/@tmplag;
658  If[Global`MoGRe$Debug,lasttime=TimeStamp["MoGRe$Renormalize[]","Lagrangian renormalization" ,lasttime]];
659
660  (* output *)
661  Return[Plus@@Join[tmplag,lag4S]];
662];