NLSM: FromFA.m

File FromFA.m, 6.5 KB (added by claudeduhr, 7 years ago)

Simplification package

Line 
1(* ::Package:: *)
2
3(*add properties to the scalar product*)
4ScalarProduct[xx_,yy_+zz_] := ScalarProduct[xx,yy]+ScalarProduct[xx,zz];
5ScalarProduct[xx_,aa_*yy_/;NumberQ[aa] ] := aa*ScalarProduct[xx,yy];
6ScalarProduct[xx_,0] := 0;
7
8log = 0;(*if 0 no log terms in the integrals, if 1 ok*)
9l4 = 1;(*if 0 no \[CapitalLambda]^4 terms in the integrals, if 1 ok*)
10
11SimplifyAmpList::usage="Simplify the result return by FeynArts (a FeynAmpList) and compute the integrals for tree level
12or one loop diagrams involving only scalars (TL simplify the result if #2==1)"
13(*Begin["Private`"]*)
14SimplifyAmpList:=(Module[{k,i,result,gen,result2},
15SimplifyAmpList::mt1l="More than one loop, not implemented";result=0;
16(*run over the FeynAmps*)
17For[k=1,k<=Length[#],k++,
18result2=0;
19If[Length[#[[k,2]]]==0,gen = #[[k,3]];,
20(*integrate if one loop*)
21If[Length[#[[k,2]]]==1,gen=LoopIntegrate[#[[k,3]],#[[k,2,1]]];,Message[SimplifyAmpList::mt1l]](*end if*)
22](*end if*);
23(*make the different replacement du to the different particles in the loop*)
24For[i=1,i<=Length[#[[k,4,2]]],i++,result2 = result2+(gen)/.MakeReplaceList[#[[k,4,1]],#[[k,4,2,i]]];
25];(*end for*)
26If[#2==1,
27result2 = TLSimplify[result2/.M$FACouplings];,result2 = Simplify[result2/.M$FACouplings];];
28result = result+result2;
29];(*end for*)
30Simplify[result]
31](*end module*))&(*end SimpifyAmpList*)
32
33
34LoopIntegrate::usage="takes a generic one loop amplitude FeynAmp[[3]] and the momentum in the loop FeynAmp[[2,1]]
35and return the result of the integration"
36LoopIntegrate:=(Module[{n,res,temp,dP,D},
37LoopIntegrate::tlnp="Too large number of propagtor(not implemented)";
38(*number of propagators<=2*)
39If[Length[#[[4]]]<=2,
40(*number of propagator=2*)
41If[Length[#[[4]]]==2,
42res=0;
43temp = (#[[5]]*#[[6]]);
44ScalarProduct[xx_,x*yy_] := x*ScalarProduct[xx,yy];
45dP = Simplify[(Coefficient[#[[4,1,1]]^2*(1-x)/2+#[[4,2,1]]^2*x,#2,1]/2)];
46D = Simplify[(ScalarProduct[Coefficient[#[[4,1,1]],#2,0],Coefficient[#[[4,1,1]],#2,0]]+#[[4,1,2]]^2)*(1-x)
47+(ScalarProduct[Coefficient[#[[4,2,1]],#2,0],Coefficient[#[[4,2,1]],#2,0]]+#[[4,2,2]]^2)*x-ScalarProduct[dP,dP]];
48(*Check change of variable : Print[(ScalarProduct[#[[4,1,1]],#[[4,1,1]]]+#[[4,1,2]]^2)*(1-x)+(ScalarProduct[#[[4,2,1]],#[[4,2,1]]]+#[[4,2,2]]^2)*x];
49Print[Simplify[(((ScalarProduct[#[[4,1,1]],#[[4,1,1]]]+#[[4,1,2]]^2)*(1-x)+(ScalarProduct[#[[4,2,1]],#[[4,2,1]]]+#[[4,2,2]]^2)*x)/.{#2->#2-dP})-D]];*)
50temp = temp/.{#2->#2-dP};temp=ExpandAll[temp];
51For[n=1,n<=Length[temp],n++,
52Switch[temp[[n]],
53_*ScalarProduct[#2,#2]*ScalarProduct[#2,#2],
54(*Print[temp[[n]]];*)res = res+(l4*\[CapitalLambda]^4/2-2*Integrate[((D)/.ScalarProduct[xx_,yy_]->-ScalarProduct[xx,yy]),{x,0,1}]*\[CapitalLambda]^2)*temp[[n]]/ScalarProduct[#2,#2]/ScalarProduct[#2,#2];
55(*Print[(l4*\[CapitalLambda]^4/2-2Integrate[D,{x,0,1}]*\[CapitalLambda]^2)*temp[[n]]/ScalarProduct[#2,#2]/ScalarProduct[#2,#2]];*),
56_*ScalarProduct[#2,#2]*ScalarProduct[#2,_],
57(*Print[temp[[n]]];*)res = res-(2*\[CapitalLambda]^2/d)*Integrate[(temp[[n]]/ScalarProduct[#2,#2])/.ScalarProduct[#2,xx_]->ScalarProduct[dP,xx],{x,0,1}];
58(*Print[(2*\[CapitalLambda]^2/d)*Integrate[(temp[[n]]/ScalarProduct[#2,#2])/.ScalarProduct[#2,xx_]->ScalarProduct[dP,xx],{x,0,1}]];*),
59_*ScalarProduct[#2,#2],
60res = res-(\[CapitalLambda]^2)*Integrate[(temp[[n]]/ScalarProduct[#2,#2]),{x,0,1}];(*-sign, wick*)
61(*Print[temp[[n]]];Print[-(\[CapitalLambda]^2)*Integrate[(temp[[n]]/ScalarProduct[#2,#2]),{x,0,1}]];*),
62_*ScalarProduct[#2,_]*ScalarProduct[#2,bof_],
63res = res+(-\[CapitalLambda]^2/d)*Integrate[(temp[[n]])/.{ScalarProduct[#2,xx_]*ScalarProduct[#2,yy_]->ScalarProduct[yy,xx]},{x,0,1}];
64(*Print[temp[[n]]];Print[(-\[CapitalLambda]^2/d)*Integrate[(temp[[n]])/.ScalarProduct[#2,xx_]*ScalarProduct[#2,yy_]->ScalarProduct[yy,xx],{x,0,1}]];*),
65_*ScalarProduct[#2,_]*ScalarProduct[#2,_],
66res = res+(-\[CapitalLambda]^2/d)*Integrate[(temp[[n]])/.{ScalarProduct[#2,xx_]->(ScalarProduct[xx,xx])^(1/2)},{x,0,1}];
67](*end switch*)
68];(*end for*)
69res=(\[ImaginaryI]*\[Pi]^2*res),
70(*number of propagator=1*)
71res=0;For[n=1,n<=Length[#[[5]]],n++,
72Switch[#[[5,n]],(*on the kinematic factor of the numerator*)
73_*ScalarProduct[#2,#2],
74res = res+#[[5,n]]/ScalarProduct[#2,#2]*\[ImaginaryI] \[Pi]^2(l4*(\[CapitalLambda]^4)/2-#[[4,1,2]]^2*\[CapitalLambda]^2+#[[4,1,2]]^4*log*Log[1+\[CapitalLambda]^2/#[[4,1,2]]^2]);,
75_*ScalarProduct[#2,_],
76res =res;,
77_,
78res=res+#[[5,n]](-\[ImaginaryI]) \[Pi]^2(\[CapitalLambda]^2-#[[4,1,2]]^2*log*Log[1+\[CapitalLambda]^2/#[[4,1,2]]^2])];](*end for*)];(*end if*),
79Message[LoopIntegrate::tlnp]
80];(*end if*)
81res*#[[1]]*#[[2]]*#[[3]]](*end module*))&(*end LoopIntegrate*)
82
83MakeReplaceList::usage="takes 2 lists of the same length, l1 and l2 and return a list of replacement L[[i]]=l1[[i]]->l2[[i]]"
84MakeReplaceList:=(Module[{i,Rep},MakeReplaceList::dll="The lists are not of the same length";
85If[Length[#]==Length[#2],
86Rep = {};
87For[i=1,i<=Length[#],i++,Rep = Append[Rep,#[[i]]-> #2[[i]]];];Rep,
88Message[MakeReplaceList::dll]](*end if*)
89](*end module*))&(*end MakeReplaceList*)
90
91(*End[]
92EndPackage[]*)
93
94
95TLSimplify::usage="return the expression after simplification using the tree level relation
96for the masses and the parameters m0, rmu, rmd, rms in the isospin limit"
97TLSimplify:=(Module[{res},
98m0=Sqrt[2/3(mk^2-mp^2)(1-2Sqrt[2]/Tan[2T])];
99mup=mp^2/r;
100md=mp^2/r;
101ms = (2mk^2-mp^2)/r;
102res = Simplify[#/.{MK0 ->mk, MKm->mk,Mpi0->mp,Mpim->mp,Meta->Sqrt[1/3(4mk^2-mp^2+2Sqrt[2](mk^2-mp^2)Tan[T])],
103Metap->Sqrt[1/3(4mk^2-mp^2-2Sqrt[2](mk^2-mp^2)Cot[T])]}];
104Clear[m0,mup,md,ms];
105res
106](*end module*))&(*end TLSimplify*)
107
108
109MomSimplify::usage="return the expression after simplification using momentum conservation and p^2=m^2 for the process #2(FeynAmpList[[0,8,2]])"
110MomSimplify:=(Module[{temp},
111temp = #/.MomConservation[Join[-#2[[1]],#2[[2]]]];temp = Simplify[temp/.MomConservation[Join[-#2[[1]],#2[[2]]]]];(*Print[MomConservation[Join[-#2[[1]],#2[[2]]]]];*)
112temp = Simplify[temp/.MakeMomentumRL[Join[-#2[[1]],#2[[2]]]]];temp
113](*end Module*)
114)&(*end MomSimplify*)
115
116MakeMomentumRL::usage="For a process, make the replacement list, p^2->m^2"
117MakeMomentumRL:=(Module[{list,k},
118list = {};
119For[k=2,k<=Length[#],k++,list = Append[list,ScalarProduct[#[[k,2]],#[[k,2]]]->#[[k,3]]^2];
120];(*end for*)
121list
122](*end module*)
123)&(*end momentumRL*)
124
125MomConservation::usage="p1->sum of outgoing momentum-sum of ingoing momentum+p1 and p1^2=m1^2"
126MomConservation:=(Module[{p1,k},
127p1=0;
128For[k=2,k<=Length[#],k++,p1 = p1 +#[[k,2]];];
129If[Length[#]>=3,
130{-#[[1,2]]->p1,ScalarProduct[#[[Length[#],2]],#[[Length[#]-1,2]]]->Simplify[#[[1,3]]^2/2-ScalarProduct[p1,p1]/2+ScalarProduct[#[[Length[#],2]],#[[Length[#]-1,2]]]]},
131-#[[1,2]]->p1
132](*end if*)
133
134](*end module*)
135)&(*end MomConservation*)