(* ::Package:: *)

(* ::Input:: *)
(*(* The ultraviolet behavior of quantum gravity - One-loop renormalization *)*)


(* ::Input:: *)
(*(* Field renormalizations *)*)


(* ::Input:: *)
(*(** A - Definitions and general rules **)*)


(* ::Input:: *)
(*(*** A.1 - Definitions ***)*)


(* ::Input:: *)
(*SetAttributes[delta,Orderless]*)
(*SetAttributes[h,Orderless]*)
(*Unprotect[Power,Times,Plus,Integer];*)
(*delta[mu_,nu_]^2:=4*)
(*delta[mu_,mu_]:=4*)
(*delta[mu_,nu_]A_[B___,mu_,Cc___]:=A[B,nu,Cc]*)
(*delta[mu_,nu_]A_[B___,mu_,Cc___][Dd___]:=A[B,nu,Cc][Dd]*)
(*delta[mu_,nu_]A_[B___][Dd___,mu_,Cc___]:=A[B][Dd,nu,Cc]*)
(*p[mu_]^2:=p2*)
(*q[mu_]^2:=q2*)
(*k[a_]^2:=k2*)
(*p[mu_]q[mu_]:=pq*)
(*p[a_]k[a_]:=pk*)
(*q[a_]k[a_]:=qk*)
(*kappa^m_:=0/;m>4*)
(*(a_+b_)[c_]:=a[c]+b[c]*)
(*(-a_)[b_]:=-a[b]*)
(*h[a_,b_][A___,c_,d_,B___]:=h[a,b][A,d,c,B]/;Sort[{c,d}]=!={c,d}*)
(*Der[h[a_,b_][A___],m_]:=h[a,b][A,m]*)
(*Der[A_+B_,m_]:=Der[A,m]+Der[B,m]*)
(*Der[A_ B_,m_]:=Der[A,m]B+A Der[B,m]*)
(*Der[A_^n_,m_]:=n Der[A,m]A^(n-1)*)
(*Der[A_,m_]:=0/;NumberQ[A]=!=False*)
(*Der[A_,m_]:=0/;A==kappa||A==Pi*)
(*Der[delta[m_,n_],r_]:=0*)
(*ginv[m_,n_,a_,b_]=ExpandAll[delta[m,n]-2 kappa h[m,n][]+4kappa^2 h[m,a][]h[a,n][]-8 kappa^3 h[m,a][]h[a,b][]h[b,n][]];*)


(* ::Input:: *)
(*sqrtg[a_,b_,c_]=ExpandAll[1+h[a,a][]kappa+((h[a,a][]h[b,b][])/2-h[a,b][]h[b,a][]) kappa^2+1/6 (h[a,a][]h[b,b][]h[c,c][]-6 h[a,a][] h[b,c][]h[c,b][]+8 h[a,b][]h[b,c][]h[c,a][]) kappa^3+1/24 (h[a,a][]h[b,b][]h[c,c][]h[d,d][]-12 h[a,a][]h[b,b][]  h[c,d][]h[d,c][]+12  h[a,b][]h[b,a][] h[c,d][]h[d,c][]+32 h[a,b][]h[b,c][]h[c,a][]h[d,d][]-48 h[a,b][]h[b,c][]h[c,d][]h[d,a][]) kappa^4];*)
(*Gammat[m_,n_,r_]=ExpandAll[kappa (h[n,r][m]+h[m,r][n]-h[m,n][r])];*)
(*Riem[m_,n_,r_,s_,a_,b_,c_,d_]=ExpandAll[kappa (h[m,s][n,r]-h[n,s][m,r]+h[n,r][m,s]-h[m,r][n,s])+ginv[a,b,c,d]Gammat[m,s,a]Gammat[n,r,b]-ginv[a,b,c,d]Gammat[m,r,a]Gammat[n,s,b]];*)
(*Ric[m_,n_,a_,b_,c_,d_,e_,f_,g_,i_]=ExpandAll[Riem[m,a,n,b,e,f,g,i]ginv[a,b,c,d]];*)
(*CDRic[m_,n_,t_,a_,b_,c_,d_,e1_,e2_,e3_,e4_,e5_,e6_,e7_,e8_]=ExpandAll[Der[Ric[m,n,e1,e2,e3,e4,e5,e6,e7,e8],t]-Gammat[m,t,a]ginv[a,b,c,d]Ric[b,n,e1,e2,e3,e4,e5,e6,e7,e8]-Gammat[n,t,a]ginv[a,b,c,d]Ric[m,b,e1,e2,e3,e4,e5,e6,e7,e8]];*)


(* ::Input:: *)
(*(*** A.2 - Symmetric integration rules ***)*)


(* ::Input:: *)
(*rul1=p[a_] :>0;*)
(*rul2=p[a_] p[b_] :>p2/4 delta[a,b];*)
(*rul3=p[a_] p[b_] p[c_]:>0;*)
(*delta4[a_,b_,c_,d_]:=delta[a,b] delta[c,d]+delta[a,c] delta[b,d]+delta[a,d] delta[b,c];*)
(*rul4=p[a_] p[b_] p[c_] p[d_]:>p2^2/24 delta4[a,b,c,d];*)
(*rul5=p[a_] p[b_] p[c_] p[d_]p[e_]:>0;*)
(*delta6[a_,b_,c_,d_,e_,f_]=Expand[delta[a,b] delta4[c,d,e,f]+delta[a,c] delta4[b,d,e,f]+delta[a,d] delta4[c,b,e,f]+delta[a,e] delta4[c,d,b,f]+delta[a,f] delta4[c,d,e,b]];*)
(*rul6=p[a_] p[b_] p[c_] p[d_]p[e_]p[f_]:>p2^3/192 delta6[a,b,c,d,e,f];*)
(*rul7=p[a_] p[b_] p[c_] p[d_]p[e_]p[f_]p[g_]:>0;*)
(*delta8[a_,b_,c_,d_,e_,f_,g_,h_]=Expand[delta[a,b] delta6[c,d,e,f,g,h]+delta[a,c] delta6[b,d,e,f,g,h]+delta[a,d] delta6[c,b,e,f,g,h]+delta[a,e] delta6[c,d,b,f,g,h]+delta[a,f] delta6[c,d,e,b,g,h]+delta[a,g] delta6[c,d,e,f,b,h]+delta[a,h] delta6[c,d,e,f,g,b]];*)
(*rul8=p[a_] p[b_] p[c_] p[d_]p[e_]p[f_]p[g_]p[h_]:>p2^4/1920 delta8[a,b,c,d,e,f,g,h];*)
(*r44=pk^4 p[a_]p[b_]p[c_]p[d_]:>1/640 p2^4 (k2^2 delta[a,b] delta[c,d]+4 k2 delta[c,d] k[a] k[b]+4 k2 delta[b,d] k[a] k[c]+k2 delta[a,d] (k2 delta[b,c]+4 k[b] k[c])+4 k2 delta[b,c] k[a] k[d]+4 k2 delta[a,b] k[c] k[d]+8 k[a] k[b] k[c] k[d]+k2 delta[a,c] (k2 delta[b,d]+4 k[b] k[d]));*)
(*r43=pk^4 p[a_]p[b_]p[c_]:>0;*)
(*r42=pk^4 p[a_]p[b_]:>1/64 k2 p2^3 (k2 delta[a,b]+4 k[a] k[b]);*)
(*r41=pk^4 p[a_]:>0;*)
(*r40=pk^4:>(k2^2 p2^2)/8;*)
(*r34=pk^3 p[a_]p[b_]p[c_]p[d_]:>0;*)
(*r33=pk^3 p[a_]p[b_]p[c_]:>1/64 p2^3 (k2 delta[b,c] k[a]+k2 delta[a,c]k[b]+(k2 delta[a,b]+2 k[a]k[b]) k[c]);*)
(*r32=pk^3 p[a_]p[b_]:>0;*)
(*r31=pk^3 p[a_]:>1/8 k2 p2^2 k[a];*)
(*r30=pk^3:>0;*)
(*r24=pk^2 p[a_]p[b_]p[c_]p[d_]:>1/192 p2^3 (k2 delta[a,b] delta[c,d]+2 delta[c,d] k[a] k[b]+2 delta[b,d] k[a] k[c]+delta[a,d] (k2 delta[b,c]+2 k[b] k[c])+2 delta[b,c] k[a] k[d]+2 delta[a,b] k[c] k[d]+delta[a,c] (k2 delta[b,d]+2 k[b] k[d]));*)
(*r23=pk^2 p[a_]p[b_]p[c_]:>0;*)
(*r22=pk^2 p[a_]p[b_]:>1/24 p2^2 (k2 delta[a,b]+2 k[a] k[b]);*)
(*r21=pk^2 p[a_]:>0;*)
(*r20=pk^2:>(k2 p2)/4;*)
(*r14=pk p[a_]p[b_]p[c_]p[d_]:>0;*)
(*r13=pk p[a_]p[b_]p[c_]:>1/24 p2^2 (delta[b,c] k[a]+delta[a,c] k[b]+delta[a,b] k[c]);*)
(*r12=pk p[a_]p[b_]:>0;*)
(*r11=pk p[a_]:>1/4 p2 k[a];*)
(*r10=pk:>0;*)
(*r04=rul4;*)
(*r03=rul3;*)
(*r02=rul2;*)
(*r01=rul1;*)


(* ::Input:: *)
(*(*** A.3 - Lagrangian invariants ***)*)


(* ::Input:: *)
(*Ic=ExpandAll[sqrtg[vv1,vv2,vv3]];*)
(*Ic=Expand[2I kappa^2 Coefficient[Ic,kappa,2]];*)
(*Ic/.{A___ h[a_,b_][]:>A delta[a,zp]delta[b,wp],A___ h[a_,b_][m_]:>-I A p[m]delta[a,zp]delta[b,wp],A___ h[a_,b_][m_,n_]:>- A p[m]p[n] delta[a,zp]delta[b,wp],h[a_,b_][]^2:>h[a,b][] delta[a,zp]delta[b,wp],h[a_,b_][m_]^2:>-I h[a,b][m] p[m]delta[a,zp]delta[b,wp],h[a_,b_][m_,n_]^2:>- h[a,b][m,n] p[m]p[n] delta[a,zp]delta[b,wp]};*)
(*%/.{h[a_,b_][]:>delta[a,zq]delta[b,wq],h[a_,b_][m_]:>-I q[m]delta[a,zq]delta[b,wq],h[a_,b_][m_,n_]:>- q[m]q[n] delta[a,zq]delta[b,wq]};*)
(*InvC0[zp_,wp_,zq_,wq_,p_,q_,p2_,q2_,pq_]=Expand[%];*)
(*InvCa[m_,n_,r_,s_,p_,p2_]=Expand[InvC0[m,n,r,s,p,-p,p2,p2,-p2]];*)
(*InvCb[m_,n_,r_,s_,p_,p2_]=Expand[1/2(InvCa[m,n,r,s,p,p2]+InvCa[n,m,r,s,p,p2])];*)
(*InvCc[m_,n_,r_,s_,p_,p2_]=Expand[1/2(InvCb[m,n,r,s,p,p2]+InvCb[m,n,s,r,p,p2])];*)
(*InvC[m_,n_,r_,s_,p_,p2_]=Expand[1/2(InvCc[m,n,r,s,p,p2]+InvCc[s,r,m,n,-p,p2])];*)
(*I0=ExpandAll[sqrtg[vv1,vv2,vv3]ginv[n,r,n2,n3]Ric[n,r,c1,c2,c3,c4,c5,c6,c7,c8]];*)
(*I0=Expand[2I kappa^2 Coefficient[I0,kappa,2]];*)
(*I0/.{A___ h[a_,b_][]:>A delta[a,zp]delta[b,wp],A___ h[a_,b_][m_]:>-I A p[m]delta[a,zp]delta[b,wp],A___ h[a_,b_][m_,n_]:>- A p[m]p[n] delta[a,zp]delta[b,wp],h[a_,b_][]^2:>h[a,b][] delta[a,zp]delta[b,wp],h[a_,b_][m_]^2:>-I h[a,b][m] p[m]delta[a,zp]delta[b,wp],h[a_,b_][m_,n_]^2:>- h[a,b][m,n] p[m]p[n] delta[a,zp]delta[b,wp]};*)
(*%/.{h[a_,b_][]:>delta[a,zq]delta[b,wq],h[a_,b_][m_]:>-I q[m]delta[a,zq]delta[b,wq],h[a_,b_][m_,n_]:>- q[m]q[n] delta[a,zq]delta[b,wq]};*)
(*Inv0[zp_,wp_,zq_,wq_,p_,q_,p2_,q2_,pq_]=Expand[%];*)
(*Inv0a[m_,n_,r_,s_,p_,p2_]=Expand[Inv0[m,n,r,s,p,-p,p2,p2,-p2]];*)
(*Inv0b[m_,n_,r_,s_,p_,p2_]=Expand[1/2(Inv0a[m,n,r,s,p,p2]+Inv0a[n,m,r,s,p,p2])];*)
(*Inv0c[m_,n_,r_,s_,p_,p2_]=Expand[1/2(Inv0b[m,n,r,s,p,p2]+Inv0b[m,n,s,r,p,p2])];*)
(*InvR[m_,n_,r_,s_,p_,p2_]=Expand[1/2(Inv0c[m,n,r,s,p,p2]+Inv0c[s,r,m,n,-p,p2])];*)
(*I1=ExpandAll[sqrtg[vv1,vv2,vv3]ginv[m,n1,m2,m3]ginv[n,r,n2,n3]Ric[m,n,bp1,bp2,bp3,b4,b5,b6,b7,b8]Ric[n1,r,c1,c2,c3,c4,c5,c6,c7,c8]];*)
(*I1=Expand[2 I kappa^2Coefficient[I1,kappa,2]];*)
(*I1/.{A___ h[a_,b_][]:>A delta[a,zp]delta[b,wp],A___ h[a_,b_][m_]:>- I A p[m]delta[a,zp]delta[b,wp],A___ h[a_,b_][m_,n_]:>- A p[m]p[n] delta[a,zp]delta[b,wp],h[a_,b_][]^2:>h[a,b][] delta[a,zp]delta[b,wp],h[a_,b_][m_]^2:>- I h[a,b][m] p[m]delta[a,zp]delta[b,wp],h[a_,b_][m_,n_]^2:>- h[a,b][m,n] p[m]p[n] delta[a,zp]delta[b,wp]};*)
(*%/.{h[a_,b_][]:>delta[a,zq]delta[b,wq],h[a_,b_][m_]:>- I q[m]delta[a,zq]delta[b,wq],h[a_,b_][m_,n_]:>- q[m]q[n] delta[a,zq]delta[b,wq]};*)
(*Inv1[zp_,wp_,zq_,wq_,p_,q_,p2_,q2_,pq_]=Expand[%];*)
(*Inv1a[m_,n_,r_,s_,p_,p2_]=Expand[Inv1[m,n,r,s,p,-p,p2,p2,-p2]];*)
(*Inv1b[m_,n_,r_,s_,p_,p2_]=Expand[1/2(Inv1a[m,n,r,s,p,p2]+Inv1a[n,m,r,s,p,p2])];*)
(*Inv1c[m_,n_,r_,s_,p_,p2_]=Expand[1/2(Inv1b[m,n,r,s,p,p2]+Inv1b[m,n,s,r,p,p2])];*)
(*InvRic2[m_,n_,r_,s_,p_,p2_]=Expand[1/2(Inv1c[m,n,r,s,p,p2]+Inv1c[s,r,m,n,-p,p2])];*)
(*I2=ExpandAll[sqrtg[vv1,vv2,vv3]ginv[m,n,m2,m3]ginv[n1,r,n2,n3]Ric[m,n,bp1,bp2,bp3,b4,b5,b6,b7,b8]Ric[n1,r,c1,c2,c3,c4,c5,c6,c7,c8]];*)
(*I2=Expand[2 I kappa^2Coefficient[I2,kappa,2]];*)
(*I2/.{A___ h[a_,b_][]:>A delta[a,zp]delta[b,wp],A___ h[a_,b_][m_]:>- I A p[m]delta[a,zp]delta[b,wp],A___ h[a_,b_][m_,n_]:>- A p[m]p[n] delta[a,zp]delta[b,wp],h[a_,b_][]^2:>h[a,b][] delta[a,zp]delta[b,wp],h[a_,b_][m_]^2:>- I h[a,b][m] p[m]delta[a,zp]delta[b,wp],h[a_,b_][m_,n_]^2:>- h[a,b][m,n] p[m]p[n] delta[a,zp]delta[b,wp]};*)
(*%/.{h[a_,b_][]:>delta[a,zq]delta[b,wq],h[a_,b_][m_]:>- I q[m]delta[a,zq]delta[b,wq],h[a_,b_][m_,n_]:>- q[m]q[n] delta[a,zq]delta[b,wq]};*)
(*Inv2[zp_,wp_,zq_,wq_,p_,q_,p2_,q2_,pq_]=Expand[%];*)
(*Inv2a[m_,n_,r_,s_,p_,p2_]=Expand[Inv2[m,n,r,s,p,-p,p2,p2,-p2]];*)
(*Inv2b[m_,n_,r_,s_,p_,p2_]=Expand[1/2(Inv2a[m,n,r,s,p,p2]+Inv2a[n,m,r,s,p,p2])];*)
(*Inv2c[m_,n_,r_,s_,p_,p2_]=Expand[1/2(Inv2b[m,n,r,s,p,p2]+Inv2b[m,n,s,r,p,p2])];*)
(*InvR2[m_,n_,r_,s_,p_,p2_]=Expand[1/2(Inv2c[m,n,r,s,p,p2]+Inv2c[s,r,m,n,-p,p2])];*)


(* ::Input:: *)
(*(*** A.4 - Lagrangian ***)*)


(* ::Input:: *)
(*Lagra1kappa2=ExpandAll[-1/2 2 LamC sqrtg[a1,a2,a3]-zeta/2 sqrtg[a1,a2,a3] ginv[m,n,a4,a5]Ric[m,n,b1,b2,b3,b4,b5,b6,b7,b8]]+xi/12 sqrtg[vv1,vv2,vv3]ginv[m,n,m2,m3]ginv[n1,r,n2,n3]Ric[m,n,b1,b2,b3,b4,b5,b6,b7,b8]Ric[n1,r,c1,c2,c3,c4,c5,c6,c7,c8];*)


(* ::Input:: *)
(*Lagra2gkappa2=Expand[-alpha/2sqrtg[a1,a2,a3] ginv[m,r,a6,a7]ginv[n,s,a8,a9]*)
(*(Ric[m,n,b1,b2,b3,b4,b5,b6,b7,b8]Ric[r,s,c1,c2,c3,c4,c5,c6,c7,c8]-1/3Ric[m,r,b1,b2,b3,b4,b5,b6,b7,b8]Ric[n,s,c1,c2,c3,c4,c5,c6,c7,c8])];*)
(*Lagra2gkappa2=ExpandAll[Lagra2gkappa2];*)


(* ::Input:: *)
(*Lagra1=Expand[Lagra1kappa2/kappa^2];*)
(*Lagra2g=Expand[Lagra2gkappa2/kappa^2];*)


(* ::Input:: *)
(*(** B - Vertices and propagators **)*)


(* ::Input:: *)
(*(*** B.1 - Ghost propagator and vertices ***)*)


(* ::Input:: *)
(*pgh[m_,n_,p_,p2_]:=-I/p2(delta[m,n]-(1+1/(2 omega))p[m]p[n]/p2)*)
(*Lgh=Expand[-2 kappa (I (p[n]+k[n])Cbar[m]-(omega+1) delta[m,n]I (p[r]+k[r])Cbar[r])(-I p[m]h[s,n][]-I p[n] h[s,m][]-I k[s] h[m,n][])C[s] ];*)
(*Lgh/.{Cbar[m_]:>delta[m,a]};*)
(*%/.{C[m_]:>delta[m,b]};*)
(*%/.{A___ h[a_,b_][]:>A delta[a,zk]delta[b,wk],A___ h[a_,b_][m_]:>-I A k[m]delta[a,zk]delta[b,wk]};*)
(*V3gh1[a_,zk_,wk_,b_,k_,p_,k2_,p2_,pk_]=Expand[I %];*)
(*V3gh[a_,m_,n_,b_,k_,p_,k2_,p2_,pk_]=Expand[1/2(V3gh1[a,m,n,b,k,p,k2,p2,pk]+V3gh1[a,n,m,b,k,p,k2,p2,pk])];*)
(*(* In V3gh[a,m,n,b,k,p,k2,p2,pk], a is the index of the antighost leg, m and n are the indices of the graviton leg, b is the index of the ghost leg. Moreover, k is the incoming momentum of the graviton leg, p is the incoming momentum of the ghost leg *)*)


(* ::Input:: *)
(*(*** B.2 - Graviton propagator ***)*)


(* ::Input:: *)
(*Lgf=Expand[Lagra1+Lagra2g+ lamb (h[m,n][n]-(omega+1) h[n,n][m])(h[m,r][r]-(omega+1) h[r,r][m])];*)


(* ::Input:: *)
(*Q2=Coefficient[Lgf,kappa,0];*)
(*Q2=Q2/.{A___ h[a_,b_][]:>A delta[a,zp]delta[b,wp],A___ h[a_,b_][m_]:>- I A p[m]delta[a,zp]delta[b,wp],A___ h[a_,b_][m_,n_]:>- A p[m]p[n] delta[a,zp]delta[b,wp],A___ h[a_,b_][m_,n_,r_]:>I A p[m]p[n] p[r] delta[a,zp]delta[b,wp],h[a_,b_][]^2:>h[a,b][] delta[a,zp]delta[b,wp],h[a_,b_][m_]^2:>- I h[a,b][m] p[m]delta[a,zp]delta[b,wp],h[a_,b_][m_,n_]^2:>- h[a,b][m,n] p[m]p[n] delta[a,zp]delta[b,wp], h[a_,b_][m_,n_,r_]^2:>I h[a,b][m,n,r] p[m]p[n] p[r] delta[a,zp]delta[b,wp]};*)
(*Q2=Q2/.{h[a_,b_][]:>delta[a,zq]delta[b,wq],A___ h[a_,b_][m_]:>- I A q[m]delta[a,zq]delta[b,wq],h[a_,b_][m_,n_]:>- q[m]q[n] delta[a,zq]delta[b,wq],h[a_,b_][m_,n_,r_]:>I q[m]q[n] q[r] delta[a,zq]delta[b,wq]};*)
(*QQ[zp_,wp_,zq_,wq_,p_,q_,p2_,q2_,pq_]=Q2;*)
(*QQ2[m_,n_,r_,s_,p_,p2_]=QQ[m,n,r,s,p,-p,p2,p2,-p2];*)
(*QQ3[m_,n_,r_,s_,p_,p2_]=1/2(QQ2[m,n,r,s,p,p2]+QQ2[n,m,r,s,p,p2]);*)
(*QQ4[m_,n_,r_,s_,p_,p2_]=1/2(QQ3[m,n,r,s,p,p2]+QQ3[m,n,s,r,p,p2]);*)
(*Qu[m_,n_,r_,s_,p_,p2_]=Expand[QQ4[m,n,r,s,p,p2]+QQ4[r,s,m,n,-p,p2]];*)


(* ::Input:: *)
(*PP[r_,s_,m_,n_,p_,p2_]=aa (delta[m,s] delta[n,r]+delta[m,r] delta[n,s])+bb  delta[m,n] delta[r,s]+cc (delta[r,s] p[m] p[n]+ delta[m,n] p[r] p[s])+dd (delta[m,r] p[n] p[s]+ delta[m,s] p[n] p[r]+delta[n,r] p[m] p[s]+ delta[n,s] p[m] p[r])+ee p[m] p[n] p[r] p[s];*)
(*riss=Simplify[Expand[PP[m,n,a,b,p,p2]Qu[a,b,r,s,p,p2]]];*)
(*cc1=Simplify[Coefficient[riss,delta[m,n] delta[r,s]]];*)
(*cc2=Simplify[Coefficient[riss,delta[m,r] delta[n,s]]];*)
(*cc3=Simplify[Coefficient[riss,delta[m,r] p[n] p[s]]];*)
(*cc4=Simplify[Coefficient[riss,delta[m,n] p[r] p[s]]];*)
(*cc5=Simplify[Coefficient[riss,p[m] p[n] p[r] p[s]]];*)
(*sol=Simplify[Solve[{cc1==0,cc2==I/2,cc3==0,cc4==0,cc5==0},{aa,bb,cc,dd,ee}]];*)
(*sol=Simplify[Expand[sol]];*)
(*ppp=PP[m,n,r,s,p,p2]/.sol[[1]];*)
(*P[m_,n_,r_,s_,p_,p2_]=Simplify[ppp/.{lamb->lambda (sigma zeta-alpha p2)}];*)


(* ::Input:: *)
(*(*** B.3 - Graviton vertices ***)*)


(* ::Input:: *)
(*(**** B.1.a - Relevant portions of the Lagrangian ****)*)


(* ::Input:: *)
(*Lagra=Expand[Lagra1+Lagra2g];*)
(*Vert3=kappa Coefficient[Lagra,kappa,1];*)
(*Vert4=kappa^2 Coefficient[Lagra,kappa,2];*)
(*Vert3=Expand[Vert3];*)
(*Vert4=Expand[Vert4];*)


(* ::Input:: *)
(*(**** B.1.b - Three graviton vertex ****) *)


(* ::Input:: *)
(*Expand[Vert3/.{A___ h[a_,b_][]:>A delta[a,zp]delta[b,wp],A___ h[a_,b_][m_]:>-I A p[m]delta[a,zp]delta[b,wp],A___ h[a_,b_][m_,n_]:>- A p[m]p[n] delta[a,zp]delta[b,wp],A___ h[a_,b_][m_,n_,r_]:> I A p[m]p[n] p[r] delta[a,zp]delta[b,wp],A___ h[a_,b_][]^2:>A h[a,b][] delta[a,zp]delta[b,wp],A___ h[a_,b_][m_]^2:>-I A h[a,b][m] p[m]delta[a,zp]delta[b,wp],A___ h[a_,b_][m_,n_]^2:>- A h[a,b][m,n] p[m]p[n] delta[a,zp]delta[b,wp], A___ h[a_,b_][m_,n_,r_]^2:> I A h[a,b][m,n,r] p[m]p[n] p[r] delta[a,zp]delta[b,wp]}];*)
(*Expand[%/.{A___ h[a_,b_][]:>A delta[a,zq]delta[b,wq],A___ h[a_,b_][m_]:>-I A q[m]delta[a,zq]delta[b,wq],A___ h[a_,b_][m_,n_]:>- A q[m]q[n] delta[a,zq]delta[b,wq],A___ h[a_,b_][m_,n_,r_]:> I A q[m]q[n] q[r] delta[a,zq]delta[b,wq],h[a_,b_][]^2:>h[a,b][] delta[a,zq]delta[b,wq],h[a_,b_][m_]^2:>-I h[a,b][m] q[m]delta[a,zq]delta[b,wq],h[a_,b_][m_,n_]^2:>- h[a,b][m,n] q[m]q[n] delta[a,zq]delta[b,wq], h[a_,b_][m_,n_,r_]^2:> I h[a,b][m,n,r] q[m]q[n] q[r] delta[a,zq]delta[b,wq]}];*)
(*Expand[%/.{h[a_,b_][]:>delta[a,z]delta[b,w],h[a_,b_][m_]:>I (p[m]+q[m])delta[a,z]delta[b,w],h[a_,b_][m_,n_]:>- (p[m]+q[m])(p[n]+q[n]) delta[a,z]delta[b,w],h[a_,b_][m_,n_,r_]:>-I (p[m]+q[m])(p[n]+q[n])(p[r]+ q[r]) delta[a,z]delta[b,w]}];*)


(* ::Input:: *)
(*V1[z_,w_,zp_,wp_,zq_,wq_,p_,q_,p2_,q2_,pq_]=ExpandAll[%];*)
(*V1a[z_,w_,zp_,wp_,zq_,wq_,p_,q_,p2_,q2_,pq_]=ExpandAll[I V1[z,w,zp,wp,zq,wq,p,q,p2,q2,pq]];*)
(*V2[z_,w_,m_,n_,r_,s_,p_,q_,p2_,q2_,pq_]=ExpandAll[1/2(V1a[z,w,m,n,r,s,p,q,p2,q2,pq]+V1a[w,z,m,n,r,s,p,q,p2,q2,pq])];*)
(*V3[z_,w_,m_,n_,r_,s_,p_,q_,p2_,q2_,pq_]=ExpandAll[1/2(V2[z,w,m,n,r,s,p,q,p2,q2,pq]+V2[z,w,n,m,r,s,p,q,p2,q2,pq])];*)
(*V4[z_,w_,m_,n_,r_,s_,p_,q_,p2_,q2_,pq_]=Expand[1/2(V3[z,w,m,n,r,s,p,q,p2,q2,pq]+V3[z,w,m,n,s,r,p,q,p2,q2,pq])];*)
(*V[z_,w_,m_,n_,r_,s_,p_,q_,p2_,q2_,pq_]=ExpandAll[V4[z,w,m,n,r,s,p,q,p2,q2,pq]+V4[m,n,z,w,r,s,-p-q,q,p2+q2+2 pq,q2,-pq -q2]+V4[r,s,m,n,z,w,p,-p-q,p2,p2+q2+2 pq,-p2-pq]+V4[z,w,r,s,m,n,q,p,q2,p2,pq]+V4[r,s,z,w,m,n,-p-q,p,p2+q2+2 pq,p2,-p2-pq]+V4[m,n,r,s,z,w,q,-p-q,q2,p2+q2+2 pq,-pq-q2]];*)
(*(* The three graviton vertex V[z,w,m,n,r,s,p,q,p2,q2,pq] has an external leg with indices m and n and incoming momentum p, an external leg with indices r and s and incoming momentum q, an external leg with indices z and w (and incoming momentum -p-q) *)*)


(* ::Input:: *)
(*(**** B.1.c - Four graviton vertex ****) *)


(* ::Input:: *)
(*Expand[Vert4/.{A___ h[a_,b_][]:>A delta[a,zp]delta[b,wp],A___ h[a_,b_][m_]:>-I A p[m]delta[a,zp]delta[b,wp],A___ h[a_,b_][m_,n_]:>- A p[m]p[n] delta[a,zp]delta[b,wp],A___ h[a_,b_][m_,n_,r_]:>I A p[m]p[n] p[r] delta[a,zp]delta[b,wp],A___ h[a_,b_][]^2:>A h[a,b][] delta[a,zp]delta[b,wp],A___ h[a_,b_][m_]^2:>-A I h[a,b][m] p[m]delta[a,zp]delta[b,wp],A___ h[a_,b_][m_,n_]^2:>- A h[a,b][m,n] p[m]p[n] delta[a,zp]delta[b,wp], A___ h[a_,b_][m_,n_,r_]^2:> I A h[a,b][m,n,r] p[m]p[n] p[r] delta[a,zp]delta[b,wp]}];*)
(*Expand[%/.{A___ h[a_,b_][]:>A delta[a,zq]delta[b,wq],A___ h[a_,b_][m_]:>-I A q[m]delta[a,zq]delta[b,wq],A___ h[a_,b_][m_,n_]:>- A q[m]q[n] delta[a,zq]delta[b,wq],A___ h[a_,b_][m_,n_,r_]:> I A q[m]q[n] q[r] delta[a,zq]delta[b,wq],A___ h[a_,b_][]^2:>A h[a,b][] delta[a,zq]delta[b,wq],A___ h[a_,b_][m_]^2:>-I A h[a,b][m] q[m]delta[a,zq]delta[b,wq],A___ h[a_,b_][m_,n_]^2:>- A h[a,b][m,n] q[m]q[n] delta[a,zq]delta[b,wq], A___ h[a_,b_][m_,n_,r_]^2:> I A h[a,b][m,n,r] q[m]q[n] q[r] delta[a,zq]delta[b,wq]}];*)
(*Expand[%/.{A___ h[a_,b_][]:>A delta[a,zk]delta[b,wk],A___ h[a_,b_][m_]:>-I A k[m]delta[a,zk]delta[b,wk],A___ h[a_,b_][m_,n_]:>- A k[m]k[n] delta[a,zk]delta[b,wk],A___ h[a_,b_][m_,n_,r_]:> I A k[m]k[n] k[r] delta[a,zk]delta[b,wk],h[a_,b_][]^2:>h[a,b][] delta[a,zk]delta[b,wk],h[a_,b_][m_]^2:>-I h[a,b][m] k[m]delta[a,zk]delta[b,wk],h[a_,b_][m_,n_]^2:>- h[a,b][m,n] k[m]k[n] delta[a,zk]delta[b,wk], h[a_,b_][m_,n_,r_]^2:> I h[a,b][m,n,r] k[m]k[n] k[r] delta[a,zk]delta[b,wk]}];*)
(*Expand[%/.{h[a_,b_][]:>delta[a,z]delta[b,w],h[a_,b_][m_]:>I (p[m]+q[m]+k[m])delta[a,z]delta[b,w],h[a_,b_][m_,n_]:>- (p[m]+q[m]+k[m])(p[n]+q[n]+k[n]) delta[a,z]delta[b,w],h[a_,b_][m_,n_,r_]:>-I (p[m]+q[m]+k[m])(p[n]+q[n]+k[n])(p[r]+ q[r]+k[r]) delta[a,z]delta[b,w]}];*)


(* ::Input:: *)
(*VV1[z_,w_,zp_,wp_,zq_,wq_,zk_,wk_,p_,q_,k_,p2_,q2_,k2_,pq_,pk_,qk_]=ExpandAll[%];*)
(*VV1a[z_,w_,zp_,wp_,zq_,wq_,zk_,wk_,p_,q_,k_,p2_,q2_,k2_,pq_,pk_,qk_]=Expand[I VV1[z,w,zp,wp,zq,wq,zk,wk,p,q,k,p2,q2,k2,pq,pk,qk]];*)
(*VV2[z_,w_,zp_,wp_,zq_,wq_,zk_,wk_,p_,q_,k_,p2_,q2_,k2_,pq_,pk_,qk_]=Expand[1/2(VV1a[z,w,zp,wp,zq,wq,zk,wk,p,q,k,p2,q2,k2,pq,pk,qk]+VV1a[w,z,zp,wp,zq,wq,zk,wk,p,q,k,p2,q2,k2,pq,pk,qk])];*)
(*VV3[z_,w_,zp_,wp_,zq_,wq_,zk_,wk_,p_,q_,k_,p2_,q2_,k2_,pq_,pk_,qk_]=Expand[1/2(VV2[z,w,zp,wp,zq,wq,zk,wk,p,q,k,p2,q2,k2,pq,pk,qk]+VV2[z,w,wp,zp,zq,wq,zk,wk,p,q,k,p2,q2,k2,pq,pk,qk])];*)
(*VV4[z_,w_,zp_,wp_,zq_,wq_,zk_,wk_,p_,q_,k_,p2_,q2_,k2_,pq_,pk_,qk_]=Expand[1/2(VV3[z,w,zp,wp,zq,wq,zk,wk,p,q,k,p2,q2,k2,pq,pk,qk]+VV3[z,w,zp,wp,wq,zq,zk,wk,p,q,k,p2,q2,k2,pq,pk,qk])];*)
(*VV5[z_,w_,zp_,wp_,zq_,wq_,zk_,wk_,p_,q_,k_,p2_,q2_,k2_,pq_,pk_,qk_]=Expand[1/2(VV4[z,w,zp,wp,zq,wq,zk,wk,p,q,k,p2,q2,k2,pq,pk,qk]+VV4[z,w,zp,wp,zq,wq,wk,zk,p,q,k,p2,q2,k2,pq,pk,qk])];*)


(* ::Input:: *)
(*VV6[s_,s1_,m_,m1_,n_,n1_,r_,r1_,p_,q_,k_,p2_,q2_,k2_,pq_,pk_,qk_]=Expand[VV5[s,s1,m,m1,n,n1,r,r1,p,q,k,p2,q2,k2,pq,pk,qk]+VV5[s,s1,m,m1,r,r1,n,n1,p,k,q,p2,k2,q2,pk,pq,qk]+VV5[s,s1,n,n1,m,m1,r,r1,q,p,k,q2,p2,k2,pq,qk,pk]+VV5[s,s1,n,n1,r,r1,m,m1,q,k,p,q2,k2,p2,qk,pq,pk]+VV5[s,s1,r,r1,m,m1,n,n1,k,p,q,k2,p2,q2,pk,qk,pq]+VV5[s,s1,r,r1,n,n1,m,m1,k,q,p,k2,q2,p2,qk,pk,pq]];*)


(* ::Input:: *)
(*VV7[s_,s1_,m_,m1_,n_,n1_,r_,r1_,p_,q_,k_,p2_,q2_,k2_,pq_,pk_,qk_]=Expand[VV6[s,s1,m,m1,n,n1,r,r1,p,q,k,p2,q2,k2,pq,pk,qk]+VV6[m,m1,s,s1,n,n1,r,r1,-p-q-k,q,k,p2+q2+k2+2pq+2pk+2qk,q2,k2,-pq-q2-qk,-pk-qk-k2,qk]+VV6[n,n1,m,m1,s,s1,r,r1,p,-p-q-k,k,p2,p2+q2+k2+2pq+2pk+2qk,k2,-p2-pq-pk,pk,-pk-qk-k2]+VV6[r,r1,m,m1,n,n1,s,s1,p,q,-p-q-k,p2,q2,p2+q2+k2+2pq+2pk+2qk,pq,-p2-pq-pk,-pq-q2-qk]];*)
(*(* The four graviton vertex VV7[z,w,m,n,r,s,a,b,p,q,k,p2,q2,k2,pq,pk,qk] has an external leg with indices m and n and incoming momentum p, an external leg with indices r and s and incoming momentum q, an external leg with indices a and b and incoming momentum k, an external leg with indices z and w (and incoming momentum -p-q-k) *)*)


(* ::Input:: *)
(*(** C - Coefficients of the solution **)*)


(* ::Input:: *)
(*s1=1/(64 alpha lambda omega^2 \[Pi]^2);*)
(*s2=-1/(12 alpha lambda \[Pi]^2)-1/(24 alpha lambda omega^2 \[Pi]^2);*)
(*s3=1/(48 alpha lambda \[Pi]^2)-1/(192 alpha lambda omega^2 \[Pi]^2);*)
(*t0=3/(16 alpha lambda \[Pi]^2)+1/(64 alpha lambda omega^2 \[Pi]^2)-3/(64 omega^2 \[Pi]^2 xi)-3/(16 omega \[Pi]^2 xi)+A/(8Pi^2);*)
(*t1=-5/(18 alpha \[Pi]^2)-1/(3 alpha lambda \[Pi]^2)-1/(24 alpha lambda omega^2 \[Pi]^2)+5/(18 alpha omega \[Pi]^2)+1/(9 \[Pi]^2 xi)+1/(12 omega^2 \[Pi]^2 xi)+5/(36 omega \[Pi]^2 xi);*)
(*t2=5/(72 alpha \[Pi]^2)-5/(48 alpha lambda \[Pi]^2)-1/(192 alpha lambda omega^2 \[Pi]^2)-5/(72 alpha omega \[Pi]^2)-1/(36 \[Pi]^2 xi)-1/(48 omega^2 \[Pi]^2 xi)-5/(144 omega \[Pi]^2 xi);*)
(*t3=-25/(72 alpha \[Pi]^2)-1/(12 alpha lambda \[Pi]^2)-5/(72 alpha omega^2 \[Pi]^2)+1/(48 alpha lambda omega^2 \[Pi]^2)+5/(12 alpha omega \[Pi]^2)+7/(72 \[Pi]^2 xi)+7/(144 omega^2 \[Pi]^2 xi)+1/(12 omega \[Pi]^2 xi);*)
(*t4=25/(144 alpha \[Pi]^2)+5/(144 alpha omega^2 \[Pi]^2)-5/(24 alpha omega \[Pi]^2)-7/(144 \[Pi]^2 xi)-7/(288 omega^2 \[Pi]^2 xi)-1/(24 omega \[Pi]^2 xi);*)
(*t5=5/(32 alpha \[Pi]^2)+5/(24 alpha lambda \[Pi]^2)+25/(288 alpha omega^2 \[Pi]^2)+1/(96 alpha lambda omega^2 \[Pi]^2)+25/(144 alpha omega \[Pi]^2)-1/(96 \[Pi]^2 xi)-11/(576 omega^2 \[Pi]^2 xi)-7/(144 omega \[Pi]^2 xi);*)
(*t6=-35/(576 alpha \[Pi]^2)-5/(192 alpha omega^2 \[Pi]^2)-5/(288 alpha omega \[Pi]^2)+5/(576 \[Pi]^2 xi)+1/(128 omega^2 \[Pi]^2 xi)+5/(288 omega \[Pi]^2 xi);*)
(*DeltaC=2 A LamC-(5 LamC)/alpha-(5 zeta^2)/(4 alpha^2)-(-8 LamC xi+zeta^2)/(4 xi^2);*)
(*Deltazeta=A zeta+(5 zeta)/(6 xi)+(5 xi zeta)/(3 alpha^2);*)
(*Deltaalpha=-133/10;*)
(*Deltaxi=5/6+(5 xi)/alpha+(5 xi^2)/(3 alpha^2);*)
(*B=-(A kappa^2)/(16 \[Pi]^2)-(3 kappa^2)/(32 \[Pi]^2 xi);*)
(*(* See below for the definitions of t1, t2, t3, t4, t5, t6, s1, s2 and s3 *)*)


(* ::Input:: *)
(*(** D - Renormalization of the gauge transformations **)*)


(* ::Input:: *)
(*(*** D.1 - General instructions ***)*)


(* ::Input:: *)
(*Unprotect[Times,Power];*)
(*LamC=0;*)
(*zeta=0;*)
(*k2:=0*)
(*pk^m_:=0/;m>1*)
(*pk^m_ k[n_]:=0/;m>1*)
(*pk k[n_]:=0*)
(*k[m_]k[n_]:=0*)
(*q2:=0*)
(*pq^m_:=0/;m>1*)
(*pq^m_ q[n_]:=0/;m>1*)
(*pq q[n_]:=0*)
(*q[m_]q[n_]:=0*)
(*qk:=0*)
(*pk pq:=0*)
(*pk^m_ pq:=0/;m>1*)
(*pk pq^m_:=0/;m>1*)
(*pq pk :=0*)
(*pk^n_ pq^m_:=0/;m+n>1*)
(*pk^m_ q[n_]:=0/;m>1*)
(*pq^m_ k[n_]:=0/;m>1*)
(*pk q[m_]:=0*)
(*pq k[m_]:=0*)
(*q[m_]k[n_]:=0*)


(* ::Input:: *)
(*SetAttributes[K,Orderless]*)
(*LK=Expand[-K[m,n](2C[n][m]+4kappa C[r][m]h[r,n][]+2 kappa h[m,n][r]C[r][])];*)
(*(* Ordering: the source K is taken to the left *)*)


(* ::Input:: *)
(*(*** D.2 - Vertex ghost-graviton-K ***)*)


(* ::Input:: *)
(*LK1=Expand[kappa Coefficient[LK,kappa,1]];*)
(*LK1=Expand[LK1/.{K[m_,n_]:>1/2(delta[m,mu]delta[n,nu]+delta[m,nu]delta[n,mu]),C[r_][]:>delta[r,ro],C[r_][m_]:>-I p[m]delta[r,ro]}];*)
(*Expand[%/.{h[a_,b_][]:>delta[a,z]delta[b,w],A___ h[a_,b_][m_]:>-I A k[m]delta[a,z]delta[b,w]}];*)
(*VKgh31[mu_,nu_,ro_,z_,w_,p_,k_]=ExpandAll[%];*)
(*VKgh31a[mu_,nu_,ro_,z_,w_,p_,k_]=ExpandAll[I VKgh31[mu,nu,ro,z,w,p,k]];*)
(*VKgh3[mu_,nu_,ro_,z_,w_,p_,k_]=ExpandAll[1/2(VKgh31a[mu,nu,ro,z,w,p,k]+VKgh31a[mu,nu,ro,w,z,p,k])];*)
(*(* In VKgh3[mu,nu,ro,z,w,p,k], mu and nu are the indices of the source K coupled to the graviton gauge transformation, ro is the index of the ghost, with incoming momentum p,*)
(*z and w are the indices of the graviton leg, with incoming momentum k *)*)


(* ::Input:: *)
(*(* Check: relation between antighost-ghost-graviton vertex and ghost-K-graviton vertex *)Simplify[Expand[V3gh[a,m,n,e,k,p,k2,p2,pk]-I (VKgh3[mu,a,e,m,n,p,k](p[mu]+k[mu])-(omega+1) VKgh3[mu,mu,e,m,n,p,k](p[a]+k[a]))]]*)


(* ::Input:: *)
(*(*** D.3 - Vertex CCK_C and its counterterm ***)*)


(* ::Input:: *)
(*VCCK[a_,g_,b_,p_,q_]:=q[a]delta[b,g]-p[b]delta[a,g]*)
(*(* Here g is the index of the source, a is the index of the left ghost, with incoming momentum p and b is the index of the right ghost, with incoming momentum q *)*)
(*diagCCK=Expand[VCCK[n,g,s,p+k,q-p]pgh[n,m,p+k,p2+k2+2 pk]];*)
(*diagCCK=Expand[diagCCK pgh[s,r,p-q,p2+q2-2pq]];*)
(*diagCCK=Expand[diagCCK V3gh[m,aa,bb,a,p,k,p2,k2,pk]];*)
(*diagCCK=Expand[diagCCK P[aa,bb,cc,dd,p,p2]];*)
(*diagCCK=Expand[diagCCK V3gh[r,cc,dd,b,-p,q,p2,q2,-pq]];*)


(* ::Input:: *)
(*diagCCK=Expand[diagCCK/.{k[m_]:>lam k[m],pk->lam pk,q[m_]:>lam q[m],pq->lam pq}];*)
(*diagCCK=Expand[D[diagCCK,lam]/.{lam->0}];*)
(*diagCCK=Expand[diagCCK/.{pk->p[n1]kk[n1],pq->p[n2]qq[n2]}];*)
(*diagCCK=Expand[Simplify[diagCCK]];*)
(*diagCCK=Expand[diagCCK/.rul6];*)
(*diagCCK=Expand[diagCCK/.rul5];*)
(*diagCCK=Expand[diagCCK/.rul4];*)
(*diagCCK=Expand[diagCCK/.rul3];*)
(*diagCCK=Expand[diagCCK/.rul2];*)
(*diagCCK=Expand[diagCCK/.rul1];*)
(*diagCCK=Expand[diagCCK];*)
(*diagCCK=Expand[I/(8 Pi^2)Coefficient[diagCCK,p2,-2]/.{kk->k,qq->q}];*)


(* ::Input:: *)
(*(* The Lagrangian counterterms are written as(S, Deltag[mu,nu] K[mu,nu] + DeltaC[ro] K[ro]), where Deltag[mu,nu] = kappa^2 t0 g[mu,nu] + kappa^3 (t1 h[mu,nu][] + t2 delta[mu,nu] h[a,a][]) + kappa^(t3 h[mu,ro][]h[ro,nu][] + t4 h[mu,nu][] h[a,a][] + t5 delta[mu,nu] h[a,b][]^2 + t6 delta[mu,nu] h[a,a][] h[b,b][]) *)
(*and DeltaC[ro] = kappa^2 s1 C[ro] + kappa^3 s2 h[ro,n][] C[n] + kappa^3 s3 h[a,a][] C[ro] *)*)


(* ::Input:: *)
(*Expand[diagCCK+kappa^2(s1+s2/2) VCCK[a,g,b,k,q]+kappa^2 s2/2(q[g]delta[a,b]-k[g]delta[a,b])+kappa^2 s3 (q[b]delta[a,g]-k[a]delta[b,g])]*)


(* ::Input:: *)
(*(*** D.4 - Counterterms partialC K_g ***)*)


(* ::Input:: *)
(*selfghK=ExpandAll[VKgh3[mu,nu,f,mm,nn,p+k,-p]P[m,n,mm,nn,p,p2]pgh[f,e,p+k,p2+k2+2 pk]V3gh[e,m,n,a,p,k,p2,k2,pk]];*)
(*selfghK=Expand[selfghK/.{k[m_]:>lam k[m],pk->lam pk}];*)
(*selfghK=Expand[D[selfghK,lam]/.{lam->0}];*)
(*selfghK=Expand[selfghK/.{pk->p[n1]kk[n1]}];*)
(*selfghK=Expand[Simplify[selfghK]];*)
(*selfghK=Expand[selfghK/.rul4];*)
(*selfghK=Expand[selfghK/.rul3];*)
(*selfghK=Expand[selfghK/.rul2];*)
(*selfghK=Expand[selfghK/.rul1];*)
(*selfghK=Expand[I/(8 Pi^2)Coefficient[selfghK,p2,-2]/.{kk->k}];*)


(* ::Input:: *)
(*(* Lagrangian counterterms (S, Deltag[mu,nu] K[mu,nu] + DeltaC[ro] K[ro]), where Deltag[mu,nu] = kappa^2 t0 g[mu,nu] + kappa^3 (t1 h[mu,nu][] + t2 delta[mu,nu] h[a,a][]) + kappa^4 (t3 h[mu,ro][]h[ro,nu][] + t4 h[mu,nu][] h[a,a][] + t5 delta[mu,nu] h[a,b][]^2 + t6 delta[mu,nu] h[a,a][] h[b,b][]) and DeltaC[ro] = kappa^2 s1 C[ro] + kappa^3 s2 h[ro,n][] C[n] + kappa^3 s3 h[a,a][] C[ro] *)*)
(*Expand[selfghK+kappa^2/2(t1-2s1)( k[mu]delta[nu,a]+ k[nu] delta[mu,a])+ kappa^2 t2 delta[mu,nu]k[a]]*)


(* ::Input:: *)
(*(*** D.5 - Counterterms ChK_g *)*)


(* ::Input:: *)
(*diag1=Expand[V3gh[b,mm,nn,a,p,q,p2,q2,pq]pgh[c,b,p+q,p2+q2+2pq]];*)
(*diag1=Expand[diag1 V3gh[d,m,n,c,k,p+q,k2,q2+p2+2pq,qk+pk]];*)
(*diag1=Expand[diag1 pgh[e,d,p+q+k,p2+q2+k2+2pq+2 pk+2 qk]];diag1=Expand[diag1 VKgh3[mu,nu,e,aa,bb,p+q+k,-p]];*)
(*diag1=Expand[diag1 P[mm,nn,aa,bb,p,p2]];*)


(* ::Input:: *)
(*diag2=Expand[VKgh3[mu,nu,b,aa,bb,p+q,k-p]pgh[b,c,p+q,p2+q2+2pq]];*)
(*diag2=Expand[diag2 V3gh[c,mm,nn,a,p,q,p2,q2,pq]];*)
(*diag2=Expand[diag2 P[cc,dd,mm,nn,p,p2]];*)
(*diag2=Expand[diag2 P[aa,bb,ee,ff,p-k,p2+k2-2pk]];*)
(*diag2=Expand[diag2 V[ee,ff,m,n,cc,dd,k,-p,k2,p2,-pk]];*)


(* ::Input:: *)
(*vertghdiv=Expand[diag1+diag2];*)


(* ::Input:: *)
(*vertghdiv=Expand[vertghdiv/.{k[m_]:>lam k[m],pk->lam pk,q[m_]:>lam q[m],pq->lam pq}];*)
(*vertghdiv=ExpandAll[D[vertghdiv,lam]/.{lam->0}];*)
(*vertghdiv=Expand[vertghdiv/.{pk->p[n1]kk[n1],pq->p[n2]qq[n2]}];*)
(*vertghdiv=Expand[Simplify[vertghdiv]];*)
(*vertghdiv=Expand[vertghdiv/.rul6];*)
(*vertghdiv=Expand[vertghdiv/.rul5];*)
(*vertghdiv=Expand[vertghdiv/.rul4];*)
(*vertghdiv=Expand[vertghdiv/.rul3];*)
(*vertghdiv=Expand[vertghdiv/.rul2];*)
(*vertghdiv=Expand[vertghdiv/.rul1];*)
(*vertghdiv=Expand[vertghdiv];*)
(*vertghdiv=Expand[I/(8 Pi^2)Coefficient[vertghdiv,p2,-2]/.{kk->k,qq->q}];*)


(* ::Input:: *)
(*Lcount=Expand[-4kappa^3 s1 K[a,b]C[r][a]h[r,b][]-2kappa^3 s1 K[a,b]C[r]h[a,b][r]+2kappa^3 K[a,b][a](s2 h[b,r][]C[r]+s3 C[b]h[r,r][])+kappa^3 K[a,b](t3 h[s,b][](C[s][a]+C[a][s])+t4 h[s,s][]C[b][a]+t4 h[a,b][]C[s][s]+2 t5 delta[a,b]h[r,s][]C[r][s]+2t6 delta[a,b]h[r,r][]C[s][s]-2t2 C[b][a]h[s,s][]+2t2 delta[a,b]h[r,s][]C[r][s])];*)
(*Expand[%/.{K[a_,b_]:>1/2(delta[a,ak]delta[b,bk]+delta[a,bk]delta[b,ak]),K[a_,b_][c_]:>-I(-q[c]-k[c])1/2(delta[a,ak]delta[b,bk]+delta[a,bk]delta[b,ak])}];*)
(*Expand[%/.{C[r_]:>delta[r,rc],C[r_][s_]:>-I q[s]delta[r,rc]}];*)
(*Expand[%/.{h[a_,b_][]:>1/2(delta[a,ah]delta[b,bh]+delta[a,bh]delta[b,ah]),h[a_,b_][c_]:>-I k[c]1/2(delta[a,ah]delta[b,bh]+delta[a,bh]delta[b,ah])}];*)
(*Counter[ak_,bk_,ah_,bh_,rc_,k_,q_]=Expand[I %];*)
(*ris=Expand[vertghdiv+Counter[mu,nu,m,n,a,k,q]]*)