MSSMatNLO: MoGRe.m

File MoGRe.m, 27.9 KB (added by Benjamin Fuks, 5 years 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];