3 graviton contribution to the EIH potential

To run this code you need Feyncalc, which you can download for free at the Feyncalc website.

<< HighEnergyPhysics`fc`

FeynCalc 4.1.1    For help, type ?FeynCalc,  use the built-in help system  or visit www.feyncalc.org

MT[a_, b_] := MetricTensor[a, b, Dimension -> d]

SP[a_, b_] := ScalarProduct[a, b, Dimension -> d]

FV[a_, b_] := FourVector[a, b, Dimension -> d]

P is the projector onto a metric with which we are wick contracting.

P[a_, b_, c_, f_] := 
      1/2 (MT[a, c] MT[b, f] + 
            MT[a, f] MT[b, c])

prop[a_, b_, c_, f_] := 
      1/2 (MT[a, c] MT[b, f] + MT[a, f] MT[b, c]) - 
        1/(d - 2) MT[a, b] MT[c, f]

propn picks out the propagator dotted into two n's,
where n=(1,0,0,0).

propn[a_, b_] = 
      Contract[(1/2 (MT[a, c] MT[b, f] + MT[a, f] MT[b, c]) - 
                1/(d - 2) MT[a, b] MT[c, f]) FV[n, c] FV[n, f]] /. 
        SP[n, n] -> 1

The Feynman rules comes from expanding root(g) R
to third order in h.  There is no contribution from the gauge fixing term foe the three potential graviton vertex.

g2R1 This means the h^2 piece from the root(g)g_{mu nu} part of
root(g) R in the action.

hΓ1[p_, μ_, ν_, a_, b_, c_] = 
        I/2 ( FV[p, b] P[μ, ν, a, c] + 
              FV[p, c] P[μ, ν, a, b] - 
              FV[p, a] P[μ, ν, b, c]);

g2[p_, μ_, ν_, q_, ρ_, σ_, α_, β_] := 
      Contract[P[μ, ν, α, s] P[ρ, σ, s, β] - 
          1/4 MT[α, β] 
            P[μ, ν, r, s] P[ρ, σ, r, s] - 
          1/2 P[w, w, μ, ν] P[ρ, σ, α, β] + 
          1/8 MT[α, β] P[μ, ν, w, w] 
            P[ρ, σ, v, v]]

R1[k4_, a4_, b4_, α_, β_] := 
      I FV[k4, γ] 
          hΓ1[k4, a4, b4, γ, α, β] - 
        I FV[k4, β] 
          hΓ1[k4, a4, 
            b4, γ, α, γ]

R1g2[k1_, a1_, b1_, k2_, a2_, b2_, k3_, a3_, b3_] := 
      Contract[R1[k1, a1, b1, α, β] g2[k2, a2, b2, k3, a3, 
            b3, α, β]]

g1R2

g1[k4_, a4_, b4_, α_, β_] := 
      Contract[1/2 MT[α, β] P[a4, b4, s, s] - 
          P[a4, b4, α, β]]

hΓ2[p_, μ_, ν_, 
        q_, ρ_, σ_, γ_, α_, β_] := 
      Contract[-I/2 
           P[γ, 
            Q, μ, ν] (FV[q, β] P[
                  Q, α, ρ, σ] + 
              FV[q, α] P[Q, β, ρ, σ] - 
              FV[q, Q] P[α, β, ρ, σ])]

R2[k1_, a1_, b1_, k2_, a2_, b2_, α_, β_] := 
      Contract[I (FV[k1, γ] +  FV[k2, γ]) 
            hΓ2[k1, a1, b1, k2, a2, 
              b2, γ, α, β] - 
          I (FV[k1, β] +  FV[k2, β]) 
            hΓ2[k1, a1, b1, k2, a2, 
              b2, γ, α, γ] + 
          hΓ1[k1, a1, b1, γ, α, β] 
            hΓ1[k2, a2, b2, δ, γ, δ] - 
          hΓ1[k1, a1, b1, γ, α, δ] 
            hΓ1[k2, a2, 
              b2, δ, β, γ]]

R2g1[k1_, a1_, b1_, k2_, a2_, b2_, k3_, a3_, b3_] := 
      Contract[R2[k1, a1, b1, k2, a2, b2, α, β] g1[k3, a3, 
            b3, α, β]]

R3

R3'[k1_, a1_, b1_, k2_, a2_, b2_, k3_, a3_, b3_] := 
      Contract[MT[α, β] (hΓ1[k1, a1, 
                  b1, γ, α, β] hΓ2[k2, a2, 
                  b2, k3, a3, 
                  b3, δ, γ, δ] + 
hΓ2[k2, a2, b2, k3, a3, 
                  b3, γ, α, β] hΓ1[k1, a1, 
                  b1, δ, γ, δ] - 
hΓ1[k1, a1, b1, γ, α, δ] hΓ2[
                  k2, a2, b2, k3, a3, 
                  b3, δ, β, γ] - 
hΓ2[k2, a2, b2, k3, a3, 
                  b3, γ, α, δ] hΓ1[k1, 
                  a1, b1, δ, β, γ])]

threegrav[k1_, a1_, b1_, k2_, a2_, b2_, k3_, a3_, 
          b3_] = FCE[
              Contract[(R2g1[k1, a1, b1, k2, a2, b2, k3, a3, b3] + R3'[
                      k1, a1, b1, k2, a2, b2, k3, a3, b3] + 
                    R1g2[k1, a1, b1, k2, a2, b2, k3, a3, b3])]] /. 
            SP[n, n] -> 1 /. SP[n, x_] :> 0;

sym3Q[k1_, a1_, b1_, k2_, a2_, b2_, k3_, a3_, b3_] := 
      Apply[Plus, 
        Apply[threegrav, 
          Partition[
            Flatten[Permutations[{{k1, a1, b1}, {k2, a2, b2}, {k3, a3, 
                    b3}}]], 9], {1}]]

ressym3Q[k1_, a1_, b1_, k2_, a2_, b2_, k3_, a3_, 
        b3_] = FCE[
            Contract[
              propn[a2, b2] propn[a3, b3] propn[a1, b1] 
                sym3Q[k1, a1, b1, k2, a2, b2, k3, a3, b3]]] /. 
          SP[n, n] -> 1 /. SP[n, x_] :> 0

taking the d->4 limit gives the result we used in paper.
all three momenta flow into the vertex. the feynman rule is automatically symmetrized.

% /. d -> 4

I^7 (-1) (-1)^3