C Calculation of the one loop longitudinal WW sattering amplitude.
  M. Veltman and F. Yndurain.

 U-particle with mass M or m depending on _Sw0=1 or 0.
 Can be set on command line: S=1

  Running times quoted are for a 68020 system. For 68000 multiply by 2.

  External file used: WWb.e

C WW-scattering 1.  Polarization vectors.
C WW-scattering 2.  Tree amplitude, general expression.
			Produces file TreeWW, containing TreeWW.
C WW-scattering 3.  Tree amplitude, case of longitudinal W's.
			Uses output of 2.
C WW-scattering 4.  Tree amplitude, Fi-Fi scattering.
C WW-scattering 5.  One loop diagrams, two external lines.
C WW-scattering 6.  One loop diagrams, three external lines.
C WW-scattering 7.  One loop Fi-Fi scattering, part 1. 33 sec.
			Produces BoxFF1, containing BoxFF.
C WW-scattering 8.  One loop Fi-Fi scattering, part 2. 228 sec.
			Uses output from 7.
			Produces BoxFF2, containing BoxFF.
C WW-scattering 9.  One loop Fi-Fi scattering, part 3. 125 sec.
			Uses output from 8.
			Produces BoxFF_comm, containing Ftot.
C WW-scattering 10. Fi-Fi Renormalization. Result Fi-Fi amplitude.
			Uses output from 8.
C WW-scattering 11. One loop W-W scattering, part 1. 681 sec.
			Produces BoxWW1, containing BoxWW.
C WW-scattering 12. One loop W-W scattering, part 2. 605 sec.
			Uses output from 11.
			Produces BoxWW2, containing BoxWW.
C WW-scattering 13. One loop W-W scattering, part 3. 447 sec.
			Uses output from 12.
			Produces BoxWW_comm, containing Wtot.
C WW-scattering 14. W-W Renormalization. Result W-W amplitude.
			Uses output from 13.
C WW-scattering 15. Verification of part of WW scattering calculation.
			Uses output from 11.
C WW-scattering 16. Infinities and Log's of irreducible 4-point W function.

*end

C WW-scattering 1.  Polarization vectors.
  Dot-products in restframe.
  Verification of equations used below.

C A k0,kl,sin,cos,M

D Xk(n) = 0,	0,	kl,		i*k0
D Xp(n) = 0,	0,	-kl,		i*k0
D Xpp(n) = -kl*sin,	0,	-kl*cos,	i*k0
D Xkp(n) = kl*sin,	0,	kl*cos,		i*k0

D Xek(n) = 0,	0,	k0/M,		i*kl/M
D Xep(n) = 0,	0,	-k0/M,		i*kl/M
D Xfp(n)=-k0*sin/M,	0,	-k0*cos/M,	i*kl/M
D Xfk(n)=k0*sin/M,	0,	k0*cos/M,	i*kl/M

X Dot(Xk,Xp) = DS(j,1,4,(Xk(j)*Xp(j)))

Z ekDp  = Dot(Xek,Xp)
Z ekDpp = Dot(Xek,Xpp)
Z ekDep = Dot(Xek,Xep)
Z ekDfk = Dot(Xek,Xfk)
Z ekDfp = Dot(Xek,Xfp)
Z epDk  = Dot(Xep,Xk)
Z epDpp = Dot(Xep,Xpp)
Z epDfk = Dot(Xep,Xfk)
Z epDfp = Dot(Xep,Xfp)
Z fkDk  = Dot(Xfk,Xk)
Z fkDp  = Dot(Xfk,Xp)
Z fkDfp = Dot(Xfk,Xfp)
Z fpDk  = Dot(Xfp,Xk)
Z fpDp  = Dot(Xfp,Xp)
Id,sin^2=1-cos^2
*end

C WW-scattering 2.  Tree amplitude, general expression.
  Result is written to file TreeWW. Used in part 3.

  The term V4 is maintained to show how the pure 4-vertex behaves.
  Renamed Fourv in part 3.

P ninput

Read WWb.e
VERT{}
*fix

Common TreeWW

P stats
I mu,nu
I a=3,b=3,c=3,d=3,e=3,f=3,g=3,h=3,j=3

A kl,k0,sin,cos

Z TreeWW(al,be,ga,de) = Tree("W,a,al,k,"W,b,be,p,"W,c,ga,pp,"W,d,de,kp)

Id,Tree(I1~,a~,al~,k~,I2~,b~,be~,p~,I3~,c~,ga~,pp~,I4~,d~,de~,kp~) =

   DS(I1;I4;-J,(TreeT(I1,I2,I3,I4,J,a,al,k,b,be,p,c,ga,pp,d,de,kp)))
 + DS(I1;I2;-K,(TreeS(I1,I2,I3,I4,K,a,al,k,b,be,p,c,ga,pp,d,de,kp)))
 + DS(I1;I3;-L,(TreeU(I1,I2,I3,I4,L,a,al,k,b,be,p,c,ga,pp,d,de,kp)))

 + (1+V4)*VE4(I1,I2,I3,I4,*,a,al,k,*,b,be,p,*,c,ga,pp,*,d,de,kp)

Id,TreeS(I1~,I2~,I3~,I4~,K1~,a~,al~,k~,b~,be~,p~,c~,ga~,pp~,d~,de~,kp~)=
  VE3(I1,I2,-K1,*,a,al,k,*,b,be,p,*,l1,ka,-qs)*
  VE3(I3,I4,K1,*,c,ga,-pp,*,d,de,-kp,*,l2,kap,qs)*
  PROP(K1,-K1,*,l1,ka,qs,*,l2,kap,-qs)
Al,TreeT(I1~,I2~,I3~,I4~,K1~,a~,al~,k~,b~,be~,p~,c~,ga~,pp~,d~,de~,kp~)=
  VE3(I1,I4,-K1,*,a,al,k,*,d,de,-kp,*,l1,ka,-qt)*
  VE3(I2,I3,K1,*,b,be,p,*,c,ga,-pp,*,l2,kap,qt)*
  PROP(K1,-K1,*,l1,ka,qt,*,l2,kap,-qt)
Al,TreeU(I1~,I2~,I3~,I4~,K1~,a~,al~,k~,b~,be~,p~,c~,ga~,pp~,d~,de~,kp~)=
  VE3(I1,I3,-K1,*,a,al,k,*,c,ga,-pp,*,l1,ka,-qu)*
  VE3(I2,I4,K1,*,b,be,p,*,d,de,-kp,*,l2,kap,qu)*
  PROP(K1,-K1,*,l1,ka,qu,*,l2,kap,-qu)

Id,Anti,TAP

Id,Compo,<X>,VE4,VE3,PROP
Id,VE4(FF~,l1~,al~,k~,l2~,be~,p~,l3~,ga~,pp~,l4~,la~,kp~)=
 FF(l1,al,k,l2,be,p,l3,ga,pp,l4,la,kp)
Al,VE3(FF~,l1~,al~,k~,l2~,be~,q~,l3~,ga~,p~)=
       FF(l1,al,k,l2,be,q,l3,ga,p)
Al,PROP(FF~,l1~,al~,q~,l2~,be~,k~)=FF(l1,al,l2,be,k)

Id,kp(al~)=p(al)+k(al)-pp(al)
Al,Dotpr,kp(al~)=p(al)+k(al)-pp(al)
*yep
Id,qt(al~)=-p(al)+pp(al)
Al,Dotpr,qt(al~)=-p(al)+pp(al)
Id,qs(al~)=p(al)+k(al)
Al,Dotpr,qs(al~)=p(al)+k(al)
Id,qu(al~)=k(al)-pp(al)
Al,Dotpr,qu(al~)=k(al)-pp(al)
Id,k(al)=0
Al,p(be)=0
Al,pp(ga)=0
Al,pp(de)=p(de)+k(de)
Id,pDp=-M^2
Al,kDk=-M^2
Al,ppDpp=-M^2
Id,Epfred
*yep
C s = - (p+k)^2 = -pDp - 2*pDk - kDk
  t = - (p-pp)^2 = - pDp + 2*pDpp - ppDpp
  u = - (k-pp)^2 = - kDk + 2*kDpp - ppDpp
  s + t + u = 4*M^2

Id,pDk =-0.5*s-0.5*pDp-0.5*kDk
Al,pDpp= 0.5*t+0.5*pDp+0.5*ppDpp
Al,kDpp= 0.5*u+0.5*kDk+0.5*ppDpp
Id,pDp=-M^2
Al,kDk=-M^2
Al,ppDpp=-M^2
*yep

Id,NOM(-qs,M)=-1/s*(1+M^2/s+M^4/s^2)
Al,NOM(-qt,M)=-1/t*(1+M^2/t+M^4/t^2)
Al,NOM(-qu,M)=-1/u*(1+M^2/u+M^4/u^2)
Id,Count,-3,s,2,t,2,u,2,k,1,p,1,pp,1,V4,10
*begin

Write TreeWW
*end

C WW-scattering 3.  Tree amplitude, case of longitudinal W's.
		    Uses output of 2.

  Filling in the transversal polarization vectors.

Enter TreeWW
*fix

P ninput

V ek,ep,fp,fk
A cos,sin

Names TreeWW

Z Ampl= ek(al)*ep(be)*fp(ga)*fk(de) * TreeWW(al,be,ga,de)

C In restframe:
  k  = 0	0	kl		i*k0
  p  = 0	0	-kl		i*k0
  pp = -kl*sin	0	-kl*cos		i*k0
  kp = kl*sin	0	kl*cos		i*k0

  ek = 0	0	k0/M		i*kl/M
  ep = 0	0	-k0/M		i*kl/M
  fp=-k0*sin/M	0	-k0*cos/M	i*kl/M
  fk=k0*sin/M	0	k0*cos/M	i*kl/M

Id,ekDp  = -2*k0*kl/M
Al,ekDpp = -kl*k0*cos/M - kl*k0/M
Al,ekDep = -k0^2/M^2 - kl^2/M^2
Al,ekDfk= k0^2*cos/M^2 - kl^2/M^2
Al,ekDfp=-k0^2*cos/M^2 - kl^2/M^2
Id,epDk  = -2*k0*kl/M
Al,epDpp = kl*k0*cos/M - kl*k0/M
Al,epDfk=-k0^2*cos/M^2 - kl^2/M^2
Al,epDfp= k0^2*cos/M^2 - kl^2/M^2
Id,fkDk = k0*kl*cos/M - k0*kl/M
Al,fkDp =-k0*kl*cos/M - k0*kl/M
Al,fkDfp= -k0^2/M^2 - kl^2/M^2
Id,fpDk = -k0*kl*cos/M - k0*kl/M
Al,fpDp = k0*kl*cos/M - k0*kl/M
*yep

C Remember:	pDk  =-0.5*s + M^2
		pDpp = 0.5*t - M^2
		kDpp = 0.5*u - M^2
Id,cos=1+0.5*t/kl^2
Id,Multi,kl^2 = 0.25*s - M^2
Al,Multi,k0^2=0.25*s
Id,Count,2,s,2,t,2,u,2,NOM,2,kl,1
*yep

Id,Multi,kl^-2= 4/s*(1 + 4*M^2/s + 16*M^4/s^2)
Id,Count,2,s,2,t,2,u,2,NOM,2,kl,1
*yep

IF s
Id,3,s^n~*u^-2 = s^(n-1)*(- t - u + 4*M^2)/u^2
ENDIF
Id,Count,2,s,2,t,2,u,2,NOM,2,kl,1
*yep

IF s
Id,3,s^n~*u^-1 = s^(n-1)*(- t - u + 4*M^2)/u
ENDIF
Id,Count,2,s,2,t,2,u,2,NOM,-2
*yep

Id,t^3*u^-1=t^2*(- s - u + 4*M^2)/u
Id,Count,2,s,2,t,2,u,2,NOM,-2
*yep

C Id,u*s^-1 = ( - s - t + 4*M^2)/s
Id,u=- s -t + 4*M^2
Id,Count,2,s,2,t,2,u,2,NOM,-2,V4,10
IF D(a,c)
Id,t=-s-u
ENDIF

F Fourv
Id,V4=Fourv
*end

C WW-scattering 4.  Tree amplitude, Fi-Fi scattering.

  Tree diagrams with four FI lines.
  Verifying the equivalence theorem.

P ninput
Read WWb.e
VERT{}
*fix

P stats
I mu,nu
I a=3,b=3,c=3,d=3,e=3,f=3,g=3,h=3,j=3

A kl,k0,sin,cos

Z TreeFF = Tree("F,a,al,k,"F,b,be,p,"F,c,ga,pp,"F,d,de,kp)

Id,Tree(I1~,a~,al~,k~,I2~,b~,be~,p~,I3~,c~,ga~,pp~,I4~,d~,de~,kp~) =

   DS(I1;I4;-J,(TreeT(I1,I2,I3,I4,J,a,al,k,b,be,p,c,ga,pp,d,de,kp)))
 + DS(I1;I2;-K,(TreeS(I1,I2,I3,I4,K,a,al,k,b,be,p,c,ga,pp,d,de,kp)))
 + DS(I1;I3;-L,(TreeU(I1,I2,I3,I4,L,a,al,k,b,be,p,c,ga,pp,d,de,kp)))

 + VE4(I1,I2,I3,I4,*,a,al,k,*,b,be,p,*,c,ga,pp,*,d,de,kp)

Id,TreeS(I1~,I2~,I3~,I4~,K1~,a~,al~,k~,b~,be~,p~,c~,ga~,pp~,d~,de~,kp~)=
  VE3(I1,I2,-K1,*,a,al,k,*,b,be,p,*,l1,ka,-qs)*
  VE3(I3,I4,K1,*,c,ga,-pp,*,d,de,-kp,*,l2,kap,qs)*
  PROP(K1,-K1,*,l1,ka,qs,*,l2,kap,-qs)
Al,TreeT(I1~,I2~,I3~,I4~,K1~,a~,al~,k~,b~,be~,p~,c~,ga~,pp~,d~,de~,kp~)=
  VE3(I1,I4,-K1,*,a,al,k,*,d,de,-kp,*,l1,ka,-qt)*
  VE3(I2,I3,K1,*,b,be,p,*,c,ga,-pp,*,l2,kap,qt)*
  PROP(K1,-K1,*,l1,ka,qt,*,l2,kap,-qt)
Al,TreeU(I1~,I2~,I3~,I4~,K1~,a~,al~,k~,b~,be~,p~,c~,ga~,pp~,d~,de~,kp~)=
  VE3(I1,I3,-K1,*,a,al,k,*,c,ga,-pp,*,l1,ka,-qu)*
  VE3(I2,I4,K1,*,b,be,p,*,d,de,-kp,*,l2,kap,qu)*
  PROP(K1,-K1,*,l1,ka,qu,*,l2,kap,-qu)

Id,Anti,TAP

Id,Compo,<X>,VE4,VE3,PROP
Id,VE4(FF~,l1~,al~,k~,l2~,be~,p~,l3~,ga~,pp~,l4~,la~,kp~)=
 FF(l1,al,k,l2,be,p,l3,ga,pp,l4,la,kp)
Al,VE3(FF~,l1~,al~,k~,l2~,be~,q~,l3~,ga~,p~)=
       FF(l1,al,k,l2,be,q,l3,ga,p)
Al,PROP(FF~,l1~,al~,q~,l2~,be~,k~)=FF(l1,al,l2,be,k)

Id,kp(al~)=p(al)+k(al)-pp(al)
Al,Dotpr,kp(al~)=p(al)+k(al)-pp(al)
*yep
Id,qt(al~)=-p(al)+pp(al)
Al,Dotpr,qt(al~)=-p(al)+pp(al)
Id,qs(al~)=p(al)+k(al)
Al,Dotpr,qs(al~)=p(al)+k(al)
Id,qu(al~)=k(al)-pp(al)
Al,Dotpr,qu(al~)=k(al)-pp(al)
C Id,pDp=-M^2
C Al,kDk=-M^2
C Al,ppDpp=-M^2
Id,Epfred
*yep
C s = - (p+k)^2 = -pDp - 2*pDk - kDk
  t = - (p-pp)^2 = - pDp + 2*pDpp - ppDpp
  u = - (k-pp)^2 = - kDk + 2*kDpp - ppDpp
  s + t + u = - kDk - pDp - ppDpp - kpDkp = 4*M^2

Id,pDk =-0.5*s-0.5*pDp-0.5*kDk
Al,pDpp= 0.5*t+0.5*pDp+0.5*ppDpp
Al,kDpp= 0.5*u+0.5*kDk+0.5*ppDpp
C Id,pDp=-M^2
C Al,kDk=-M^2
C Al,ppDpp=-M^2
*yep
Id,NOM(-qs,m)= 1/m^2 + s/m^4 + s^2/m^4*NOM(-qs,m)
Al,NOM(-qt,m)= 1/m^2 + t/m^4 + t^2/m^4*NOM(-qt,m)
Al,NOM(-qu,m)= 1/m^2 + u/m^4 + u^2/m^4*NOM(-qu,m)
*yep
Id,u = - s - t - kDk - pDp - ppDpp - kpDkp
IF D(a,c)
Id,t = - s - u - kDk - pDp - ppDpp - kpDkp
ENDIF
Id,NOM(-qs,M)=-1/s*(1+M^2/s+M^4/s^2)
Al,NOM(-qt,M)=-1/t*(1+M^2/t+M^4/t^2)
Al,NOM(-qu,M)=-1/u*(1+M^2/u+M^4/u^2)
*yep
IF s
Id,3,s^n~*u^-2 = s^(n-1)*(- t - u + 4*M^2)/u^2
ENDIF
Id,Count,2,s,2,t,2,u,2,NOM,2,kl,1,m,20
*yep
IF s
Id,3,s^n~*u^-1 = s^(n-1)*(- t - u + 4*M^2)/u
ENDIF
Id,Count,2,s,2,t,2,u,2,NOM,-2,m,20
*yep
Id,t^3*u^-1=t^2*(- s - u + 4*M^2)/u
Id,Count,2,s,2,t,2,u,2,NOM,-2,m,20
*yep
C Id,u*s^-1 = ( - s - t + 4*M^2)/s
Id,u= - s -t + 4*M^2
Id,Count,2,s,2,t,2,u,2,NOM,-2,m,20
*yep
Id,NOM(-qs,m)= 1/m^2*( 1 + s/m^2 + s^2/m^4)
Al,NOM(-qt,m)= 1/m^2*( 1 + t/m^2 + t^2/m^4)
Al,NOM(-qu,m)= 1/m^2*( 1 + u/m^2 + u^2/m^4)
Id,u= - s -t + 4*M^2
Id,Count,2,s,2,t,2,u,2,NOM,-2,m,20
*end

C WW-scattering 5.  One loop diagrams, two external lines.

P ninput

A N,N_,M,M2,m,m2,n,n1,n2,n3,n4,Fact,Nom,Nohm,Shi,LogM2,Logm2
F Log,Fq,Tad,Fxx,Two

Read WWb.e

VERT{}

ETE1{}

C q1 = q+p
  q2 = q+p+pp
  q3 = q-k
  q4 = q-k-pp
  q5 = q-k-p
  q6 = q+pp
  qu = k+pp
  qs = q-k-p
  qt =

V q,q1,q2,q3,q4,q5,q6,qs,qu,qt

I al=N,be=N,la=N,de=N,ga=N,la=N

I a=3,b=3,c=3,d=3

X dede(al,be,ga,de)=D(al,be)*D(ga,de)+D(al,ga)*D(be,de)+D(al,de)*D(be,ga)

C n1: -2 for every factor 1/(q^2+m^2)
  n2: number of factors m
  n3: degree of divergence with respect to integration variable q not
      counting n1 types. Integral is convergent if n3+4 < 0.

X Fdiv(n1,n2,n3)= DT(-n3-4)*DT(n1+n2) + DT(n3+4-1)*DT(n1+n2+4+n3)

C Series expansion for { Nohm/(1-x*Nohm) }^n4
C
X Exp(n1,n2,n3,x,n4) =
   DT(-n3-4)*Nohm^n4*DS(J,0,n1+n2,(DB(n4+J-1,J)*x^J*Nohm^J))
 + DT(n3+4-1)*Nohm^n4*DS(K,0,n1+n2+4+n3,(DB(n4+K-1,K)*x^K*Nohm^K))

BLOCK MASS{}
Id,pDp=-M^2
Al,kDk=-M^2
Al,ppDpp=-M^2
Al,pDk=0.5*M^2
Al,kDpp=0.5*M^2
Al,pDpp=0.5*M^2
ENDBLOCK

BDELETE COUNT
BDELETE HCOUNT
BDELETE SHIFT
BDELETE STINT

BLOCK COUNT{}
Al,NOM(q~,m)=Fact*NOM(q,m)
Id,Count,Fxx,Nohm,-2,Fact,-2 : m,1,[m2-M2],2,m2,2
  : q,1,Fact,2,NOM,-2,Nom,-2,Two,-4,Three,-6
  : Nohm,1
Al,Fact=1
ENDBLOCK

BLOCK HCOUNT{}
C Count behaviour with respect to m for large m.
  Eliminate if zero in that limit.
IF Nohm
AND NOT Ztag
COUNT{}
Id,Fxx(n1~,n2~,n3~,n4~)=Fdiv(n1,n2,n3)
ELSE
Id,Count,0,m,1,[m2-M2],2,Three,10,DLP,10,Ztag,10
ENDIF
ENDBLOCK

BLOCK SHIFT{}
IF Shi^1
Al,qDq=qDq-2*qDp+pDp
Al,q(al~)=q(al)-p(al)
Al,Dotpr,q(al~)=q(al)-p(al)
ENDIF
IF Shi^3
Al,qDq=qDq+2*qDk+kDk
Al,q(al~)=q(al)+k(al)
Al,Dotpr,q(al~)=q(al)+k(al)
ENDIF
IF Shi^6
Al,qDq=qDq-2*qDpp+ppDpp
Al,q(al~)=q(al)-pp(al)
Al,Dotpr,q(al~)=q(al)-pp(al)
ENDIF

IF NOT Nohm
Id,Shi=1
ENDIF

*yep

C Working out of shifted 1/(q^2+m^2)^n

IF Nohm^n~*Shi^l~
COUNT{}
Al,Nohm=1

Id,Shi^1*Fxx(n1~,n2~,n3~,n4~)=Fdiv(n1,n2,n3)*Exp(n1,n2,n3,(2*qDp-pDp),n4)
Al,Shi^3*Fxx(n1~,n2~,n3~,n4~)=Fdiv(n1,n2,n3)*Exp(n1,n2,n3,(-2*qDk-kDk),n4)
Al,Shi^6*Fxx(n1~,n2~,n3~,n4~)=Fdiv(n1,n2,n3)*Exp(n1,n2,n3,(2*qDpp-ppDpp),n4)
ENDIF

ENDBLOCK

BLOCK STINT{}
C Standard integrals.

C Type Fn = 1/(q^2+M^2)^n
  Gn = q(mu)*q(nu)*Fn (exclusive D(mu,nu))
  Hn = q(mu)*q(nu)*q(al)*q(be)*Fn (exclusive D*D etc part).

Id,F(1,m2~) = 2*i*Pi^2*m2/N_ + i*Pi^2*m2*(-1+Log(m2))
Al,F(2,m2~) = - 2*i*Pi^2/N_ - i*Pi^2*Log(m2)
Al,F(3,m2~) = 0.5*i*Pi^2/m2
Al,F(4,m2~) = i*Pi^2/6/m2^2
Al,F(5,m2~) = 1/12*i*Pi^2*m2^-3
Al,F(6,m2~) = 1/20*i*Pi^2*m2^-4
Al,F(7,m2~) = 1/30*i*Pi^2*m2^-5

Id,G(1,m2~) = - 0.5*i*Pi^2*m2^2/N_ + 3/8*i*Pi^2*m2^2
  - 0.25*i*Pi^2*m2^2*Log(m2)

Al,G(2,m2~) = i*Pi^2 * ( - 1/2*m2 + m2*N_^-1 )
 + 0.5*m2*Log(m2)*i*Pi^2

Al,G(3,m2~) = i*Pi^2 * ( - 1/2*N_^-1 )
 - 1/4*Log(m2)*i*Pi^2

Al,G(4,m2~) = 1/12*i*Pi^2*m2^-1

Al,G(5,m2~) = 1/48*i*Pi^2*m2^-2

Al,G(6,m2~) = 1/120*i*Pi^2*m2^-3

Al,G(7,m2~) = 1/240*i*Pi^2*m2^-4

Id,H(1,m2~) = 1/12*i*Pi^2*m2^3/N_ - 11/144*i*Pi^2*m2^3
 + 1/24*i*Pi^2*m2^3*Log(m2)

Al,H(2,m2~) = i*Pi^2 * ( 3/16*m2^2 - 1/4*m2^2*N_^-1 )
 - 1/8*Log(m2)*i*Pi^2*m2^2

Al,H(3,m2~) = i*Pi^2 * ( - 1/8*m2 + 1/4*m2*N_^-1 )
 + 1/8*Log(m2)*i*Pi^2  *m2

Al,H(4,m2~) = - 1/12*i*Pi^2*N_^-1
 - 1/24*Log(m2)*i*Pi^2

Al,H(5,m2~) = i*Pi^2/96/m2

Al,H(6,m2~) = 1/480*i*Pi^2*m2^-2

Al,H(7,m2~) = 1/1200*i*Pi^2*m2^-3

ENDBLOCK

*fix
I mu,nu
I m1=N,m0=N,m3=N,m4=N,m5=N,m6=N,m7=N,m8=N
V k,p,pp,kp,q0

BLOCK WORK{}
Id,Self(I1~,I2~)=
   DS(I1;J2;-J1;Sym;J2;-J1;TAP,(DIB(I1,J1,J2,I2)
  *DC("F,TFE,-1,J1,J2) ))

 + DS(I1;J3;-J3;I2;Sym;J3,-J3;TAP,(DIC(I1,J3,I2) ))

 + CONTR(I1,I2)*DLP

C + DS(I1;I2;-J4;TAP,{ DS(J4;J5;-J5;Sym;J5;-J5,TAP,{DIT(I1,J4,J5,I2)
  *DC("F,TFE,-1,J5) } ) } )

Id,Anti,TAP

Id,DIB(I1~,K1~,K2~,I2~)=
   VE3(I1,K2,-K1,*,a,al,p,*,l4,m4,q,*,l1,m1,-q1)*
   VE3(K1,I2,-K2,*,l2,m0,q1,*,b,be,-p,*,l3,m3,-q)*
   PROP(K1,-K1,*,l1,m1,q1,*,l2,m0,-q1)*
   PROP(K2,-K2,*,l3,m3,q,*,l4,m4,-q)
Al,DIC(I1~,K1~,I2~)=
   VE4(I1,K1,-K1,I2,*,a,al,p,*,l1,m1,-q,*,l2,m0,q,*,b,be,-p)*
   PROP(K1,-K1,*,l1,m1,q,*,l2,m0,-q)

Al,DIT(I1~,K1~,K2~,I2~) = Tad*
   VE3(I1,I2,-K1,*,a,al,p,*,b,be,-p,*,l1,m1,-q0)*
   PROP(K1,-K1,*,l1,m1,q0,*,l2,m0,-q0)*
   VE3(K1,K2,-K2,*,l2,m0,q0,*,l3,m3,-q,*,l4,m4,q)*
   PROP(K2,-K2,*,l3,m3,q,*,l4,m4,-q)

Al,CONTR(I1~,I2~)=CONT(I1,I2,"N,*,a,al,p,*,b,be,-p,*,c,ga,q0)

Id,Compo,<X>,VE4,VE3,PROP,CONT

Id,VE4(FF~,l1~,al~,k~,l2~,be~,p~,l3~,ga~,pp~,l4~,la~,kp~)=
 FF(l1,al,k,l2,be,p,l3,ga,pp,l4,la,kp)
Al,VE3(FF~,l1~,al~,k~,l2~,be~,q~,l3~,ga~,p~)=
       FF(l1,al,k,l2,be,q,l3,ga,p)
Al,PROP(FF~,l1~,al~,q~,l2~,be~,k~)=FF(l1,al,l2,be,k)

Id,Even,NOM,1
Al,Commu,NOM

*yep
Id,q0(al~)=0
Al,Dotpr,q0(al~)=0
Al,NOM(q0,M~) = 1/M^2
Id,q1Dq1=qDq+2*pDq+pDp
Al,q1(al~)=q(al)+p(al)
Al,Dotpr,q1(al~)=q(al)+p(al)
Id,qDq*NOM(q,M~)=1-M^2*NOM(q,M)
Id,Adiso,qDp^n~*NOM(q,M~)*NOM(q1,m~)=-0.5*qDp^(n-1)*
 {NOM(q1,m) - NOM(q,M) + (pDp-M^2+m^2)*NOM(q,M)*NOM(q1,m)}
Id,Commu,NOM
Id,Epfred
B Nohm,Nom,i,Pi,Ztag,Xetid
*yep

Id,NOM(q,m)=Nohm

IF NOM(q~,m)
AND NOT Ztag
COUNT{}
Id,Adiso,Fxx(n1~,n2~,n3~,n4~)*NOM(q1,m)=Fdiv(n1,n2,n3)
 *Exp(n1,n2,n3,(-2*qDp-pDp),1)
ENDIF

HCOUNT{}
*yep

IF NOM(q,M)=Nom
AND Nohm
Id,Nohm^n~=a1^-n
Al,Nom^n~=a2^-n
Id,Ratio,a2,a1,[m2-M2]
Id,a1^n~=Nohm^-n
Al,a2^n~=Nom^-n
ENDIF

Id,Nom*NOM(q1~,M)= Two(q,q1,M)
Al,Nohm*NOM(q1~,m)= Two(q,q1,m)
Id,NOM(q1,M)=Nom*Shi
SHIFT{}

IF Nohm^n~*Nom^l~
Id,Nohm^n~=a1^-n
Al,Nom^n~=a2^-n
Id,Ratio,a2,a1,[m2-M2]
Id,a1^n~=Nohm^-n
Al,a2^n~=Nom^-n
ENDIF
*yep

IF Nohm
OR Nom
Id,All,q,N,Fq
ENDIF

Id,Fq(al~)=0
Al,Fq(al~,be~,ga~)=0
Al,Fq(al~,be~,ga~,de~,la~)=0
Al,Fq(al~,be~,ga~,de~,la~,a~,b~)=0

*yep

Id,Fq(al~,be~,ga~,de~)*Nom^l~ = dede(al,be,ga,de)*H(l,M2)
Al,Fq(al~,be~)*Nom^l~ = D(al,be)*G(l,M2)
Al,Nom^n~ = F(n,M2)
Id,Fq(al~,be~,ga~,de~)*Nohm^l~ = dede(al,be,ga,de)*H(l,m2)
Al,Fq(al~,be~)*Nohm^l~ = D(al,be)*G(l,m2)
Al,Nohm^l~ = F(l,m2)

STINT{}

Id,Multi,M2^n~=M^(2*n)
Al,Multi,m2^n~=m^(2*n)

*yep

IF NOT Two(q~,q1~,M~)
Id,Count,0,m,1,m2,2,[m2-M2],2,DLP,10
Id,Count,x,m2,2,m,1,DLP,10
..IF x
..Id,x^n1~*[m2-M2]^n~=m2^n*DS(K,0,n+(n1+1)/2,(DB(-n+K-1,K)*M2^K*m2^-K))
..Id,m2^n~=m^(2*n)
..Al,M2^n~=M^(2*n)
..ELSE
..Id,[m2-M2]^n~=m^(2*n)
..ENDIF
Id,Count,0,m2,2,m,1,DLP,10,Ztag,10
Al,x=1
ENDIF

IF Two(q~,q1~,M~)
Id,All,q,N,Fq,"F_
Id,Adiso,Two(q,q1~,M~)*Fq(al~,be~)=B21(pDp,M,M)*Fxx(q1,al,be)
 +B22(pDp,M,M)*D(al,be)
Al,Adiso,Two(q,q1~,M~)*Fq(al~)=B1(pDp,M,M)*Fxx(q1,al)
Al,Two(q,q1~,M~)=B0(pDp,M,M)
Id,Fxx(q1,al~)=p(al)
Id,Fxx(q1,al~,be~)=p(al)*p(be)
ENDIF

Id,B22(u~,M~,m~)=(-0.5*F1(m)+M**2*B0(u,M,m)
      -0.5*(u+m^2-M**2)*B1(u,M,m))/[1-N]
Id,B21(u~,M~,m~)=-((0.5*N-1)*F1(m)
       -0.5*N*(u+m^2-M**2)*B1(u,M,m)
       +M**2*B0(u,M,m) )/u/[1-N]
Id,B1(u~,M~,m~)= (0.5*F1(M)-0.5*F1(m)
              -0.5*(u+m^2-M**2)*B0(u,M,m) )/u

Al,F1(M~) = 2*i*Pi^2*M^2/N_ + i*Pi^2*M^2*(-1+LogM2)
Id,N=N_+4
Al,[1-N]^-1=-1/3 + N_/9
Id,N_=0
Id,N=4

IF Ztag
Id,B0(u~,M,M)=i*Pi^2*(Logm2-LogM2-2)*(u+m^2)/m^2
   -2*i*Pi^2/N_-i*Pi^2*(Logm2-2)
Al,B0(u~,m,m)=-i*Pi^2*[Pi/Sqrt(3)-2]*(u+m^2)/m^2
   -2*i*Pi^2/N_- i*Pi^2*(Logm2+[Pi/Sqrt(3)-2])
ELSE
Id,B0(u~,M,M)= -2*i*Pi^2/N_ - i*Pi^2*LogM2 + u*BB0F(u,M,M)/M^2
ENDIF

Id,Log(m2)=Logm2
Al,Log(M2)=LogM2

Al,CONT(FF~,l1~,al~,k~,l2~,be~,q~,l3~,ga~,p~)=
       FF(l1,al,k,l2,be,q,l3,ga,p)

Id,Count,1,m,1,N_,-1,Logm2,1,DLP,10,Ztag,10,Xetid,10
*yep
ETE1{}
P output
*yep
Id,DLP=-1
Id,Count,1,m,1,N_,-10,Logm2,1,DLP,10,Ztag,10,Xetid,10
Id,Ztag=1
ENDBLOCK

Z TADP=DS("Z;J1;-J1;Sym;J1;-J1,(DIT("Z,J1)*DC("F,TFE,-1,J1) ))
  + DLP*NNZ(b,be,p,c,ga,q,a,al,q0)
   + Xetid*Et

Id,DIT(K1~,K2~)=
   VE3(K1,K2,-K2,*,a,al,q0,*,l3,m3,-q,*,l4,m4,q)*
   PROP(K2,-K2,*,l3,m3,q,*,l4,m4,-q)
Id,Compo,<X>,VE4,VE3,PROP

Id,VE3(FF~,l1~,al~,k~,l2~,be~,q~,l3~,ga~,p~)=
       FF(l1,al,k,l2,be,q,l3,ga,p)
Al,PROP(FF~,l1~,al~,q~,l2~,be~,k~)=FF(l1,al,l2,be,k)

Id,Even,NOM,1
Al,Commu,NOM

*yep
Id,q0(al~)=0
Al,Dotpr,q0(al~)=0
Id,Commu,NOM
Id,Epfred

B Nohm,Nom,i,Pi,DEL,Xetid

Id,NOM(q~,M)=F(1,M2)
Al,NOM(q~,m)=F(1,m2)
Id,F(1,m2~) = 2*i*Pi^2*m2/N_ + i*Pi^2*m2*(-1+Log(m2))

Id,Multi,M2^n~=M^(2*n)
Al,Multi,m2^n~=m^(2*n)

Id,N=N_+4
Al,[1-N]^-1=-1/3 + N_/9
Id,N_=0
Id,N=4

Id,Log(m2)=Logm2
Al,Log(M2)=LogM2
P output
*yep

ETE1{}
Id,DLP=-1
*next

Z SelfWW = Self("W,"W)
C - {2*M^2*Ew + 2*M^2*E1 + 2*pDp*Ew}*D(a,b)*D(al,be)*DLP
 + 2*p(al)*p(be)*D(a,b)*Ew*DLP
WORK{}
*next

Z SelfFF = Self("F,"F)
C - 2*pDp*Eh*D(a,b)*DLP
 - 1/2*m^2*Et*D(a,b)*DLP
WORK{}
*next

Z SelfWF = Self("W,"F)
C + M*{Ew+Eh+E1}*D(a,b)*(-i*p(al))*DLP
WORK{}
*next
Z SelfZZ = Self("Z,"Z)*Ztag
C + m^2*{-2*Eh-1/2*Et+2*E2-2*E1}*DLP
 - 2*pDp*Eh*DLP
WORK{}
P output
*yep
Id,pDp=-m^2
Id,Count,1,m,1,N_,-10,Logm2,1
*end

C WW-scattering 6.  One loop diagrams, three external lines.

P ninput

A N,N_,M,M2,m,m2,n,n1,n2,n3,n4,Fact,Nom,Nohm,Shi,LogM2,Logm2
F Fxx,Two,Three,Fq

Read WWb.e

VERT{}

C q1 = q+p
  q2 = q+p+pp
  q3 = q-k
  q4 = q-k-pp
  q5 = q-k-p
  q6 = q+pp
  q7 = q+kp
  qu = k+pp
  qs = q-k-p
  qt =

V q,q1,q2,q3,q4,q5,q6,qs,qu,qt

I al=N,be=N,la=N,de=N,ga=N,la=N

I a=3,b=3,c=3,d=3

X dede(al,be,ga,de)=D(al,be)*D(ga,de)+D(al,ga)*D(be,de)+D(al,de)*D(be,ga)

C n1: -2 for every factor 1/(q^2+m^2)
  n2: number of factors m
  n3: degree of divergence with respect to integration variable q not
      counting n1 types. Integral is convergent if n3+4 < 0.

X Fdiv(n1,n2,n3)= DT(-n3-4)*DT(n1+n2) + DT(n3+4-1)*DT(n1+n2+4+n3)

C Series expansion for { Nohm/(1-x*Nohm) }^n4
C
X Exp(n1,n2,n3,x,n4) =
   DT(-n3-4)*Nohm^n4*DS(J,0,n1+n2,(DB(n4+J-1,J)*x^J*Nohm^J))
 + DT(n3+4-1)*Nohm^n4*DS(K,0,n1+n2+4+n3,(DB(n4+K-1,K)*x^K*Nohm^K))

BLOCK MASS{}
Id,pDp=-M^2
Al,kDk=-M^2
Al,ppDpp=-M^2
Al,pDk=0.5*M^2
Al,kDpp=0.5*M^2
Al,pDpp=0.5*M^2
ENDBLOCK

BDELETE COUNT
BDELETE HCOUNT
BDELETE SHIFT
BDELETE STINT

BLOCK COUNT{}
Al,NOM(q~,m)=Fact*NOM(q,m)
Id,Count,Fxx,Nohm,-2,Fact,-2 : m,1,[m2-M2],2,m2,2
  : q,1,Fact,2,NOM,-2,Nom,-2,Two,-4,Three,-6
  : Nohm,1
Al,Fact=1
ENDBLOCK

BLOCK HCOUNT{}
C Count behaviour with respect to m for large m.
  Eliminate if zero in that limit.
IF Nohm
COUNT{}
Id,Fxx(n1~,n2~,n3~,n4~)=Fdiv(n1,n2,n3)
ELSE
Id,Count,0,m,1,[m2-M2],2,Three,10
ENDIF
ENDBLOCK

BLOCK SHIFT{}
IF Shi^1
Al,qDq=qDq-2*qDp+pDp
Al,q(al~)=q(al)-p(al)
Al,Dotpr,q(al~)=q(al)-p(al)
ENDIF
IF Shi^3
Al,qDq=qDq+2*qDk+kDk
Al,q(al~)=q(al)+k(al)
Al,Dotpr,q(al~)=q(al)+k(al)
ENDIF
IF Shi^6
Al,qDq=qDq-2*qDpp+ppDpp
Al,q(al~)=q(al)-pp(al)
Al,Dotpr,q(al~)=q(al)-pp(al)
ENDIF

IF NOT Nohm
Id,Shi=1
ENDIF

*yep

C Working out of shifted 1/(q^2+m^2)^n

IF Nohm^n~*Shi^l~
COUNT{}
Al,Nohm=1

Id,Shi^1*Fxx(n1~,n2~,n3~,n4~)=Fdiv(n1,n2,n3)*Exp(n1,n2,n3,(2*qDp-pDp),n4)
Al,Shi^3*Fxx(n1~,n2~,n3~,n4~)=Fdiv(n1,n2,n3)*Exp(n1,n2,n3,(-2*qDk-kDk),n4)
Al,Shi^6*Fxx(n1~,n2~,n3~,n4~)=Fdiv(n1,n2,n3)*Exp(n1,n2,n3,(2*qDpp-ppDpp),n4)
ENDIF

ENDBLOCK

BLOCK STINT{}
C Standard integrals.

C Type Fn = 1/(q^2+M^2)^n

Id,F(1,m2~) = 2*i*Pi^2*m2/N_ + i*Pi^2*m2*(-1+Log(m2))
Al,F(2,m2~) = - 2*i*Pi^2/N_ - i*Pi^2*Log(m2)
Al,F(3,m2~) = 0.5*i*Pi^2/m2
Al,F(4,m2~) = i*Pi^2/6/m2^2
Al,F(5,m2~) = 1/12*i*Pi^2*m2^-3
Al,F(6,m2~) = 1/20*i*Pi^2*m2^-4
Al,F(7,m2~) = 1/30*i*Pi^2*m2^-5

Id,G(1,m2~) = - 0.5*i*Pi^2*m2^2/N_ + 3/8*i*Pi^2*m2^2
  - 0.25*i*Pi^2*m2^2*Log(m2)

Al,G(2,m2~) = i*Pi^2 * ( - 1/2*m2 + m2*N_^-1 )
 + 0.5*m2*Log(m2)*i*Pi^2

Al,G(3,m2~) = i*Pi^2 * ( - 1/2*N_^-1 )
 - 1/4*Log(m2)*i*Pi^2

Al,G(4,m2~) = 1/12*i*Pi^2*m2^-1

Al,G(5,m2~) = 1/48*i*Pi^2*m2^-2

Al,G(6,m2~) = 1/120*i*Pi^2*m2^-3

Al,G(7,m2~) = 1/240*i*Pi^2*m2^-4

Id,H(1,m2~) = 1/12*i*Pi^2*m2^3/N_ - 11/144*i*Pi^2*m2^3
 + 1/24*i*Pi^2*m2^3*Log(m2)

Al,H(2,m2~) = i*Pi^2 * ( 3/16*m2^2 - 1/4*m2^2*N_^-1 )
 - 1/8*Log(m2)*i*Pi^2*m2^2

Al,H(3,m2~) = i*Pi^2 * ( - 1/8*m2 + 1/4*m2*N_^-1 )
 + 1/8*Log(m2)*i*Pi^2  *m2

Al,H(4,m2~) = - 1/12*i*Pi^2*N_^-1
 - 1/24*Log(m2)*i*Pi^2

Al,H(5,m2~) = i*Pi^2/96/m2

Al,H(6,m2~) = 1/480*i*Pi^2*m2^-2

Al,H(7,m2~) = 1/1200*i*Pi^2*m2^-3

ENDBLOCK

BLOCK COEF{}
C Generated with program BCij.e

Id,BB0=i*Pi^2*( - LogM2 - 2*N_^-1 - [Pi/Sqrt(3)-2] )
Al,BB1=i*Pi^2*( 1/2*LogM2 + N_^-1 + 1/2*[Pi/Sqrt(3)-2] )
Al,BB21=i*Pi^2*( 1/18 - 1/3*LogM2 - 2/3*N_^-1 )
Al,BB22=i*Pi^2*M^2*( - 4/9 + 5/12*LogM2 + 5/6*N_^-1 + 1/4*[Pi/Sqrt(3)-2] )

Id,C11= - 2/3*C0
Al,C12= - 1/3*C0
Al,C21= 1/3*i*M^-2*Pi^2
Al,C22= 1/3*i*M^-2*Pi^2 - 1/3*C0
Al,C23= 1/6*i*M^-2*Pi^2
Al,C24= - 1/2*i*N_^-1*Pi^2 + 1/4*i*Pi^2 - 1/4*i*Pi^2*LogM2 - 1/4*i*Pi^2
  *[Pi/Sqrt(3)-2] - 1/3*M^2*C0
Al,C31= - 19/27*i*M^-2*Pi^2 - 2/9*i*M^-2*Pi^2*[Pi/Sqrt(3)-2]
  + 16/27*C0
Al,C32= - 8/27*i*M^-2*Pi^2 + 2/9*i*M^-2*Pi^2*[Pi/Sqrt(3)-2]
  + 11/27*C0
Al,C33= - 19/54*i*M^-2*Pi^2 - 1/9*i*M^-2*Pi^2*[Pi/Sqrt(3)-2]
  + 8/27*C0
Al,C34= - 17/54*i*M^-2*Pi^2 + 1/9*i*M^-2*Pi^2*[Pi/Sqrt(3)-2]
  + 10/27*C0
Al,C35= 1/3*i*N_^-1*Pi^2 - 1/6*i*Pi^2 + 1/6*i*Pi^2*LogM2 + 1/6*i*Pi^2
  *[Pi/Sqrt(3)-2] + 2/9*M^2*C0
Al,C36= 1/6*i*N_^-1*Pi^2 - 1/12*i*Pi^2 + 1/12*i*Pi^2*LogM2
  + 1/12*i*Pi^2*[Pi/Sqrt(3)-2] + 1/9*M^2*C0
Id,C0=i*Pi^2*CC0
ENDBLOCK

*fix

I mu,nu
I m1=N,m0=N,m3=N,m4=N,m5=N,m6=N,m7=N,m8=N,m9=N
V k,p,pp

BLOCK WORK{TADP}
Id,VERT(K1~,K2~,K3~)=
  DS(K1;J3;-J1;TAP,(DS(K2;J1;-J2;TAP,(
  DIB(K1,K2,K3,J1,J2,J3)*DC("F,TFE,-1,J1,J2,J3) ))))

 +DS(K1;K2;-J4;J5;Sym;-J4;J5;TAP,(VIR1(K1,K2,K3,J4,J5) ))

 +DS(K2;K3;J6;-J7;Sym;J6;-J7;TAP,(VIR2(K1,K2,K3,J6,J7) ))

 +DS(K1;K3;-J8;J9;Sym;-J8;J9;TAP,(VIR3(K1,K2,K3,J8,J9) ))


Id,DIB(K1~,K2~,K3~,J1~,J2~,J3~)=
   VE3(K1,-J1,J3,*,a,al,k,*,l1,m1,-q,*,l6,m6,q3)*
   VE3(K2,J1,-J2,*,b,be,p,*,l2,m0,q,*,l3,m3,-q1)*
   VE3(K3,J2,-J3,*,c,ga,pp,*,l4,m4,q1,*,l5,m5,-q3)*
   PROP(J1,-J1,*,l1,m1,q,*,l2,m0,-q)*
   PROP(J2,-J2,*,l3,m3,q1,*,l4,m4,-q1)*
   PROP(J3,-J3,*,l5,m5,q3,*,l6,m6,-q3)

Al,VIR1(K1~,K2~,K3~,J1~,J2~)=
   VE4(K1,K2,-J1,J2,*,a,al,k,*,b,be,p,*,l1,m1,-q,*,l4,m4,q6)*
   VE3(K3,J1,-J2,*,c,ga,pp,*,l2,m0,q,*,l3,m3,-q6)*
   PROP(J1,-J1,*,l1,m1,q,*,l2,m0,-q)*
   PROP(J2,-J2,*,l3,m3,q6,*,l4,m4,-q6)

Al,VIR2(K1~,K2~,K3~,J1~,J2~)=
   VE4(K2,K3,J1,-J2,*,b,be,p,*,c,ga,pp,*,l2,m0,q,*,l3,m3,-q3)*
   VE3(K1,-J1,J2,*,a,al,k,*,l1,m1,-q,*,l4,m4,q3)*
   PROP(J1,-J1,*,l1,m1,q,*,l2,m0,-q)*
   PROP(J2,-J2,*,l3,m3,q3,*,l4,m4,-q3)

Al,VIR3(K1~,K2~,K3~,J1~,J2~)=
   VE4(K1,K3,-J1,J2,*,a,al,k,*,c,ga,pp,*,l1,m1,-q,*,l4,m4,q1)*
   VE3(K2,J1,-J2,*,b,be,p,*,l2,m0,q,*,l3,m3,-q1)*
   PROP(J1,-J1,*,l1,m1,q,*,l2,m0,-q)*
   PROP(J2,-J2,*,l3,m3,q1,*,l4,m4,-q1)

Id,Anti,TAP

Id,Compo,<X>,VE4,VE3,PROP
Id,VE4(FF~,l1~,al~,k~,l2~,be~,p~,l3~,ga~,pp~,l4~,la~,kp~)=
 FF(l1,al,k,l2,be,p,l3,ga,pp,l4,la,kp)
Al,VE3(FF~,l1~,al~,k~,l2~,be~,q~,l3~,ga~,p~)=
       FF(l1,al,k,l2,be,q,l3,ga,p)
Al,PROP(FF~,l1~,al~,q~,l2~,be~,k~)=FF(l1,al,l2,be,k)

Id,Even,NOM,1
Id,Commu,NOM

C q1 = q+p
  q3 = q+p+pp = q-k
  q6 = q+pp

Id,q1Dq1=qDq+pDp+2*qDp
Al,q3Dq3=qDq+kDk-2*qDk
Al,q6Dq6=qDq+ppDpp+2*qDpp
Id,q1(al~)=q(al)+p(al)
Al,Dotpr,q1(al~)=q(al)+p(al)
Id,q3(al~)=q(al)-k(al)
Al,Dotpr,q3(al~)=q(al)-k(al)
Id,q6(al~)=q(al)+pp(al)
Al,Dotpr,q6(al~)=q(al)+pp(al)

Id,qDq*NOM(q,M~)=1-M^2*NOM(q,M)
Id,Adiso,qDp^n~*NOM(q,M~)*NOM(q1,m~)=-0.5*qDp^(n-1)*
 {NOM(q1,m) - NOM(q,M) + (pDp-M^2+m^2)*NOM(q,M)*NOM(q1,m)}
Id,Adiso,qDk^n~*NOM(q,M~)*NOM(q3,m~)=0.5*qDk^(n-1)*
 {NOM(q3,m) - NOM(q,M) + (kDk-M^2+m^2)*NOM(q,M)*NOM(q3,m)}
Id,Adiso,qDpp^n~*NOM(q,M~)*NOM(q6,m~)=-0.5*qDpp^(n-1)*
 {NOM(q6,m) - NOM(q,M) + (ppDpp-M^2+m^2)*NOM(q,M)*NOM(q6,m)}

Id,Commu,NOM
Id,Epfred
Id,ppDpp=kDk+pDp+2*kDp
Id,pp(al~)=-k(al)-p(al)
Al,Dotpr,pp(al~)=-k(al)-p(al)

Id,NOM(q1~,M)*NOM(q3~,M)*NOM(q6~,M)= Three(M,q1,q3,q6)

B Nohm,Nom,i,Pi,DEL

*yep

Id,NOM(q,m)=Nohm

IF NOM(q~,m)
COUNT{}
Id,Adiso,Fxx(n1~,n2~,n3~,n4~)*NOM(q1,m)=Fdiv(n1,n2,n3)
 *Exp(n1,n2,n3,(-2*qDp-pDp),1)
Al,Adiso,Fxx(n1~,n2~,n3~,n4~)*NOM(q3,m)=Fdiv(n1,n2,n3)
 *Exp(n1,n2,n3,(2*qDk-kDk),1)
Al,Adiso,Fxx(n1~,n2~,n3~,n4~)*NOM(q6,m)=Fdiv(n1,n2,n3)
 *Exp(n1,n2,n3,(-2*qDpp-ppDpp),1)
ENDIF

HCOUNT{}
MASS{}
*yep

IF NOM(q~,m)
COUNT{}
Id,Adiso,Fxx(n1~,n2~,n3~,n4~)*NOM(q1,m)=Fdiv(n1,n2,n3)
 *Exp(n1,n2,n3,(-2*qDp-pDp),1)
Al,Adiso,Fxx(n1~,n2~,n3~,n4~)*NOM(q3,m)=Fdiv(n1,n2,n3)
 *Exp(n1,n2,n3,(2*qDk-kDk),1)
Al,Adiso,Fxx(n1~,n2~,n3~,n4~)*NOM(q6,m)=Fdiv(n1,n2,n3)
 *Exp(n1,n2,n3,(-2*qDpp-ppDpp),1)
ENDIF

HCOUNT{}
MASS{}

IF NOM(q,M)=Nom
AND Nohm
Id,Nohm^n~=a1^-n
Al,Nom^n~=a2^-n
Id,Ratio,a2,a1,[m2-M2]
Id,a1^n~=Nohm^-n
Al,a2^n~=Nom^-n
ENDIF

Id,Nom*NOM(q1~,M)= Two(q,q1)

*yep

IF NOT NOM(q1,M)=Nom*Shi
AND NOT NOM(q3,M)=Nom*Shi^3
Al,NOM(q6,M)=Nom*Shi^6
ENDIF

*yep

Id,Shi^1*NOM(q3,M)=NOM(q6,M)*Shi

SHIFT{}

*yep

HCOUNT{}
MASS{}

IF Nohm^n~*Nom^l~
Id,Nohm^n~=a1^-n
Al,Nom^n~=a2^-n
Id,Ratio,a2,a1,[m2-M2]
Id,a1^n~=Nohm^-n
Al,a2^n~=Nom^-n
ENDIF

Id,Nom*NOM(q1~,M)=Two(q,q1)

*yep

Id,NOM(q6,M)=Nom*Shi^6

SHIFT{}
HCOUNT{}
MASS{}

IF Nohm^n~*Nom^l~
Id,Nohm^n~=a1^-n
Al,Nom^n~=a2^-n
Id,Ratio,a2,a1,[m2-M2]
Id,a1^n~=Nohm^-n
Al,a2^n~=Nom^-n
ENDIF

IF NOT Nohm
AND NOT Three(m,q1~,q3~,q6~)
Id,Count,0,m,1,[m2-M2],2,DLP,10
ENDIF

*yep

IF Nohm
OR Nom
Id,All,q,N,Fq
ENDIF

Id,Fq(al~)=0
Al,Fq(al~,be~,ga~)=0
Al,Fq(al~,be~,ga~,de~,la~)=0
Al,Fq(al~,be~,ga~,de~,la~,a~,b~)=0

*yep

Id,Fq(al~,be~,ga~,de~)*Nom^l~ = dede(al,be,ga,de)*H(l,M2)
Al,Fq(al~,be~)*Nom^l~ = D(al,be)*G(l,M2)
Al,Nom^n~ = F(n,M2)
Id,Fq(al~,be~,ga~,de~)*Nohm^l~ = dede(al,be,ga,de)*H(l,m2)
Al,Fq(al~,be~)*Nohm^l~ = D(al,be)*G(l,m2)
Al,Nohm^l~ = F(l,m2)

STINT{}
MASS{}

Id,Multi,M2^n~=M^(2*n)
Al,Multi,m2^n~=m^(2*n)

IF NOT Two(q~,M~)
AND NOT Three(M~,q~,q1~,q2~)
Id,Count,0,m,1,m2,2,[m2-M2],2
Id,Count,x,m2,2,m,1
..IF x
..Id,x^n1~*[m2-M2]^n~=m2^n*DS(K,0,n+(n1+1)/2,(DB(-n+K-1,K)*M2^K*m2^-K))
..Id,m2^n~=m^(2*n)
..Al,M2^n~=M^(2*n)
..ELSE
..Id,[m2-M2]^n~=m^(2*n)
..ENDIF
Id,Count,0,m2,2,m,1,DLP,10
Al,x=1
ENDIF

Id,ppDpp=kDk+pDp+2*kDp
Al,pp(al~)=-k(al)-p(al)
Al,Dotpr,pp(al~)=-k(al)-p(al)

Id,Log(m2)=Logm2
Al,Log(M2)=LogM2

IF Three(M~,q,q1,q3)=Fxx(M)
Al,All,q,N,Fq,"F_
Id,Adiso,Fxx(m~)*Fq(al~,be~,ga~)=
    p(al)*p(be)*p(ga)*C31
  + pp(al)*pp(be)*pp(ga)*C32
  + (pp(al)*p(be)*p(ga)+p(al)*pp(be)*p(ga)+p(al)*p(be)*pp(ga))*C33
  + (p(al)*pp(be)*pp(ga)+pp(al)*p(be)*pp(ga)+pp(al)*pp(be)*p(ga))*C34
  + (p(al)*D(be,ga)+p(be)*D(al,ga)+p(ga)*D(al,be))*C35
  + (pp(al)*D(be,ga)+pp(be)*D(al,ga)+pp(ga)*D(al,be))*C36
Al,Adiso,Fxx(m~)*Fq(al~,be~)=
    p(al)*p(be)*C21
  + pp(al)*pp(be)*C22
  + (p(al)*pp(be)+pp(al)*p(be))*C23
  + D(al,be)*C24
Al,Adiso,Fxx(m~)*Fq(al~)= p(al)*C11 + pp(al)*C12
Al,Fxx(m~)=C0
ENDIF

IF Two(q~,q1~)
Id,All,q,N,Fq,"F_
Id,Adiso,Two(q,q1~)*Fq(al~,be~)=BB21*Fxx(q1,al,be)+BB22*D(al,be)
Al,Adiso,Two(q,q1~)*Fq(al~)=BB1*Fxx(q1,al)
Al,Two(q,q1~)=BB0
Id,Fxx(q1,al~)=p(al)
Al,Fxx(q3,al~)=-k(al)
Al,Fxx(q6,al~)=-p(al)-k(al)
Id,Fxx(q1,al~,be~)=p(al)*p(be)
Al,Fxx(q3,al~,be~)=k(al)*k(be)
Al,Fxx(q6,al~,be~)=(p(al)+k(al))*(p(be)+k(be))
ENDIF

*yep

COEF{}

Id,pp(al~)=-k(al)-p(al)
MASS{}
Id,N=N_+4
Id,N_=0
C Id,[Pi/Sqrt(3)-2]= - BB0F - LogM2
*yep
Id,Count,0,m,1,m2,2,[m2-M2],2,DLP,10
Id,Count,x,m2,2,m,1
..IF x
..Id,x^n1~*[m2-M2]^n~=m2^n*DS(K,0,n+(n1+1)/2,(DB(-n+K-1,K)*M2^K*m2^-K))
..Id,m2^n~=m^(2*n)
..Al,M2^n~=M^(2*n)
..ELSE
..Id,[m2-M2]^n~=m^(2*n)
..ENDIF
Id,Count,0,m2,2,m,1,DLP,10
Al,x=1

Id,Count,1,m,1,Logm2,1,N_,-1,DLP,10

ETE1{}
P output
*yep
Id,DLP=-1

ENDBLOCK

Z IWWW = VERT("W,"W,"W)
  + (Eg+3*Ew)*WWW(a,al,k,b,be,p,c,ga,pp)*DLP
WORK{IWWW}
*next
Z IFFW = VERT("F,"F,"W)
  + (Eg+Ew+2*Eh)*FFW(a,al,k,b,be,p,c,ga,pp)*DLP
WORK{IFFW}
*next
Z IFWZ = VERT("F,"W,"Z)
  + (Eg+Ew+2*Eh)*FWZ(a,al,k,b,be,p,c,ga,pp)*DLP
WORK{IFWZ}
*next
Z IWWZ = VERT("W,"W,"Z)
  + (Eg+2*Ew+Eh+E1)*WWZ(a,al,k,b,be,p,c,ga,pp)*DLP
WORK{IWWZ}
*next
Z IFFZ = VERT("F,"F,"Z)
 + (Eg+3*Eh-2*E2+E1)*FFZ(a,al,k,b,be,p,c,ga,pp)*DLP
WORK{IFFZ}
*next
Z IZZZ = VERT("Z,"Z,"Z)
 + (Eg+3*Eh-2*E2+E1)*ZZZ(a,al,k,b,be,p,c,ga,pp)*DLP
WORK{IZZZ}
*end

C WW-scattering 7.  One loop Fi-Fi scattering, part 1. 33 sec.
  Result to file BoxFF1.

C One loop diagrams.
  Four point function. FF scattering.
  Evaluated in the limit m^2 >> s,t,u >> M^2, where m = Higgs boson
  mass and M = W boson mass.

C Terms in the output are labelled by A0, A1, A2, A3, and R, T for the
  reducible and tadpole types.
  The connection is:
  Rx: reducible diagrams (in u-channel, as A3).
  R1 type: One propagator.
  R5 type: Two propagators: selfenergy insertion.
  Diagrams marked with R1Z and R5Z are Z-exchange diagrams.
  Tx: tadpole types.
  A0: Box diagram, a,al,k and c,ga,pp in opposite corners.
  A1: Inverted Triangle diagram, a,al,k and c,ga,pp on 4-vertex.
  A2: Triangle diagram, a,al,k and c,ga, pp on triangle basis.
  A3: Bubble diagram, a,al,k and c,ga,pp on one end.

P ninput

C Work done:
  - Generate the diagrams.
  - Reduce as much as possible q ocurrences in the numerator.
  - Eliminate Higgs mass in terms containing at least one Higgs
    and one non-Higgs propagator. Cost: each m^2 gives one q.

  As it happens, of the four-propagator terms only some are left,
  with numerator pDq^4. That one is zero, because there are two
  Higgs propagators, and a non-zero result for large m obtains
  only for the most divergent part, i.e. when qqqq = D(,,,)
  Then the result is proportional to M^4, where behaviour as
  s^2 (or u^2, s*t etc.) is to be computed.

  These terms are put to zero, and Error wil be attached if there is
  any other four propagator term.

  It is assumed that there are no more than two non-Higgs propagators.
  If there are Error will be attached.

P ninput

C This order is of importance when ordering NOM.

A M,M2,m,m2,x,qq2,qqM,q2M
V q,q1,q3,q2,q4,q0

Read WWb.e
VERT{}
*fix

BLOCK REDUC{}
Id,Count,x,NOM,1
IF x^4
Id,Adiso,qDk^n~*NOM(q,M~)*NOM(q3,m~)=0.5*qDk^(n-1)*
 {NOM(q3,m) - NOM(q,M) + (kDk-M^2+m^2)*NOM(q,M)*NOM(q3,m)}
Id,Adiso,qDp^n~*NOM(q1,M~)*NOM(q,m~)=0.5*qDp^(n-1)*
 {NOM(q,m) - NOM(q1,M) + NOM(q,m)*NOM(q1,M)*(-pDp+m^2-M^2)}
Id,Adiso,qDpp^n~*NOM(q2,M~)*NOM(q1,m~)=0.5*qDpp^(n-1)*
 {NOM(q1,m) - NOM(q2,M) + NOM(q1,m)*NOM(q2,M)*(- 2*pDpp -ppDpp+m^2-M^2)}
Id,Adiso,qDkp^n~*NOM(q2,M~)*NOM(q3,m~)=0.5*qDkp^(n-1)*
 {NOM(q2,M) - NOM(q3,m) + NOM(q2,M)*NOM(q3,m)*(
 - kpDkp - 2*pDkp - 2*ppDkp + M^2 - m^2)}
Id,pDp=-M^2
Al,kDk=-M^2
Al,ppDpp=-M^2
Al,kpDkp=-M^2
Id,NOM(q~,M~)=NOM(M,q)
Id,Commu,NOM
Id,NOM(M~,q~)=NOM(q,M)
ENDIF
Id,x=1
ENDBLOCK

BLOCK Q2RED{X}
Id,NOM(q~,M~)=NOM(M,q)
Id,Commu,NOM
Id,NOM(M~,q~)=NOM(q,M)
Id,qDq=qq2

C Do only for X.

Id,qq2^n~*NOM(q~,'X')=qq2^n/qqM*Fxx(q,'X')

C This works for M and m.

Id,Ratio,qq2,qqM,q2M
Id,q2M^n~*Fxx(q,m~)=m^(2*n)*Fxx(q,m)
Al,q2M^n~*Fxx(q1,m~)={2*qDp-M^2+m^2}^n*Fxx(q1,m)
Al,q2M^n~*Fxx(q2,m~)={2*qDp+2*qDpp+2*pDpp-2*M^2+m^2}^n*Fxx(q2,m)
Al,q2M^n~*Fxx(q3,m~)={-2*qDk-M^2+m^2}^n*Fxx(q3,m)
Al,q2M^n~*Fxx(q4,m~)={-2*qDk-2*qDpp+2*kDpp-2*M^2+m^2}^n*Fxx(q4,m)
Id,qqM^-1*Fxx(q~,m~)=NOM(q,m)
Al,Fxx(q~,m~)=1
Al,qq2=qDq
ENDBLOCK

P stats
P input

Common BoxFF

V q1,q2,q3,q4
I m1=N,m0=N,m3=N,m4=N,m5=N,m6=N,m7=N,m8=N
I a=3,b=3,c=3,d=3

F F4q,F3,F2,F1

C Momenta: all taken to be ingoing.
  k,p in, pp,kp out. k + p = - pp - kp.

Z BoxFF(a,al,k,b,be,p,c,ga,pp,d,de,kp) =
    VIER("F,a,al,k,"F,b,be,p,"F,c,ga,pp,"F,d,de,kp)

C  For information: this is to be added to get the full result:
   + VIER("F,a,al,k,"F,c,ga,pp,"F,b,be,p,"F,d,de,kp)
   + VIER("F,a,al,k,"F,b,be,p,"F,d,de,kp,"F,c,ga,pp)

FOUR{}

Id,q1(al~)=q(al)+p(al)
Al,q1Dq1=qDq+pDp+2*qDp
Al,Dotpr,q1(al~)=q(al)+p(al)
Al,q0(al~)=0
Al,Dotpr,q0(al~)=0
Id,q2(al~)=q(al)+p(al)+pp(al)
Al,q2Dq2=qDq+pDp+ppDpp+2*qDp+2*qDpp+2*pDpp
Al,Dotpr,q2(al~)=q(al)+p(al)+pp(al)
Id,q3(al~)=q(al)-k(al)
Al,q3Dq3=qDq-2*qDk+kDk
Al,Dotpr,q3(al~)=q(al)-k(al)
Id,q4(al~)=q(al)-k(al)-pp(al)
Al,q4Dq4=qDq+kDk+ppDpp-2*qDk-2*qDpp+2*kDpp
Al,Dotpr,q4(al~)=q(al)-k(al)-pp(al)
Id,qu(al~)=k(al)+pp(al)
Al,quDqu=kDk+ppDpp+2*kDpp
Al,Dotpr,qu(al~)=k(al)+pp(al)

Al,Even,NOM,1

C By definition:
  Extm = 1/{1 + (2*kDpp + kDk + ppDpp)/m^2}
       = 1/{1 + 2*(kDpp - M^2)/m^2}
  ExtM = - 2*kDpp/(u-M^2)
  This makes their principal behaviour explicit.

Id,NOM(qu,m)= Extm/m^2
Al,NOM(qu,M)= ExtM/kDpp/2
Al,NOM(q0,M~)= 1/M^2

Id,pDp=-M^2
Al,kDk=-M^2
Al,ppDpp=-M^2
Al,kpDkp=-M^2
Id,Count,4,M,-1,M2,-2
Id,kp(al~)= - p(al)- k(al) - pp(al)
Al,Dotpr,kp(al~)= - p(al) - k(al)- pp(al)
Id,Epfred
Al,Even,NOM,1

Id,Count,4,M,-1,M2,-2
Id,pDpp=-pDk-kDpp

IF NOT NOM(q~,m)
Id,Count,0,m,1
ENDIF

*yep

Q2RED{M}
Q2RED{M}
*yep
Q2RED{m}
Q2RED{m}
*yep
REDUC{}
*yep
REDUC{}
*yep
REDUC{}

Id,Count,4,M,-1,M2,-2

*yep

Id,NOM(q~,M~)=NOM(M,q)
Id,Commu,NOM
Id,NOM(M~,q~)=NOM(q,M)

Id,Adiso,pDq^4*NOM(q~,m)*NOM(q1~,m)*NOM(q2~,M)*NOM(q3~,M)=0

*yep

Id,Count,x,NOM,1

IF NOT x
Id,Addfa,0
ENDIF

Id,x=1

Id,NOM(q~,M)=x*NOM(q,M)
IF Multi,x^3
Id,Addfa,Error
ENDIF

Id,x=1

*begin
Write BoxFF1
*end

C WW-scattering 8.  One loop Fi-Fi scattering, part 2. 228 sec.
  Uses output from 7, file BoxFF1. Produces BoxFF2.

C Work done:
 - Expand all Higgs propagators: 1/((q+qx)^2+m^2) => 1/(q^2+m^2)
 - The assumption at this point is that that there are no more
   than 2 non-Higgs propagators. If two, take them together in
   the function Two(qa,qb). If qa not q then shift momentum so
   that only Two(q,qx) occurs. The Higgs propagators become shifted
   again. They are expanded again.
 - Expand Two(q,qx) times any non-zero number of Higgs propagators:
   Rationalize 1/(q^2+M^2)* 1/(q^2+m^2), the result contains a NOM
   but no more Two.
   Reduce any non-zero number of qDq together with Two(q,qx).
 - Work out NOM(qx,M) with qx not q, and any number of Higgs propagators.
   Shift qx to q. Expand shifted Higgs propagators.
 - Rationalize again.
 - Reduce all qDq occurences.
 - After this work there are the following types of terms:
   One Two function and no Higgs propagator;
   One NOM(q,M);
   Any number of Higgs propagators.

P ninput

Enter BoxFF1

Read WWb.e
ASSIGN{}

*fix

Names BoxFF
P stats

Z BoxFF(a,al,k,b,be,p,c,ga,pp,d,de,kp) =
  BoxFF(a,al,k,b,be,p,c,ga,pp,d,de,kp)

C Expand Higgs propagators.
  There may be two of them.

Id,NOM(q,m)=Nohm

IF NOM(q~,m)=Fxx(q)
Id,Count,Div,q,1,NOM,-2,Two,-4
Id,Fxx(q~)=Fact^-2*NOM(q,m)
Id,Fact^n~=Fxx(n,0,0)
Id,Nohm^n~*Fxx(n1~,0,0)=Nohm^n*Fxx(n1-2*n,0,0)
Id,m^n~*Fxx(n1~,0,0)=m^n*Fxx(n1,n,0)
Id,Div^n~*Fxx(n1~,n2~,0)=Fxx(n1,n2,n)
Id,Adiso,Fxx(n1~,n2~,n3~)*NOM(q1,m)=Fdiv(n1,n2,n3)*Exp(n1,n2,n3,(-2*qDp),1)
Al,Adiso,Fxx(n1~,n2~,n3~)*NOM(q2,m)=Fdiv(n1,n2,n3)*
 Exp(n1,n2,n3,(-2*qDp-2*qDpp-2*pDpp),1)
Al,Adiso,Fxx(n1~,n2~,n3~)*NOM(q3,m)=Fdiv(n1,n2,n3)
 *Exp(n1,n2,n3,(2*qDk),1)
Al,Adiso,Fxx(n1~,n2~,n3~)*NOM(q4,m)=Fdiv(n1,n2,n3)
 *Exp(n1,n2,n3,(2*qDk+2*qDpp-2*kDpp),1)
ENDIF

Id,Fact^n~=1

B Nohm,Nom
*yep

IF NOM(q~,m)=Fxx(q)
Id,Count,Div,q,1,NOM,-2,Two,-4
Id,Fxx(q~)=Fact^-2*NOM(q,m)
Id,Fact^n~=Fxx(n,0,0)
Id,Nohm^n~*Fxx(n1~,0,0)=Nohm^n*Fxx(n1-2*n,0,0)
Id,m^n~*Fxx(n1~,0,0)=m^n*Fxx(n1,n,0)
Id,Div^n~*Fxx(n1~,n2~,0)=Fxx(n1,n2,n)
Id,Adiso,Fxx(n1~,n2~,n3~)*NOM(q1,m)=Fdiv(n1,n2,n3)*Exp(n1,n2,n3,(-2*qDp),1)
Al,Adiso,Fxx(n1~,n2~,n3~)*NOM(q2,m)=Fdiv(n1,n2,n3)*
 Exp(n1,n2,n3,(-2*qDp-2*qDpp-2*pDpp),1)
Al,Adiso,Fxx(n1~,n2~,n3~)*NOM(q3,m)=Fdiv(n1,n2,n3)
 *Exp(n1,n2,n3,(2*qDk),1)
Al,Adiso,Fxx(n1~,n2~,n3~)*NOM(q4,m)=Fdiv(n1,n2,n3)
 *Exp(n1,n2,n3,(2*qDk+2*qDpp-2*kDpp),1)
ENDIF

Id,Fact^n~=1

B Nohm,Nom
*yep
Id,pDpp=M^2-pDk-kDpp
Id,Count,4,M,-1,M2,-2

HCOUNT{}
*yep

Id,Adiso,NOM(q~,M)*NOM(q1~,M) = Two(q,q1)
Id,Commu,NOM
Id,Two(q1~,q)=Two(q,q1~)

Id,Two(q1,q2~)=Sh1*Two(q,q2,-p)
Al,Two(q2,q5~)=Sh2*Two(q,q5,qt)
Al,Two(q3,q5~)=Sh3*Two(q,q5,k)
Al,Two(q4,q5~)=Sh4*Two(q,q5,qu)

Id,Two(q,q3,-p)=Two(q,q5)

SHIFT{}
HCOUNT{}

*yep

C Reduction of 1/(q^2+M^2) * 1/(q^2+m^2)^n

IF Nohm^n~*Two(q,q1~)=1/q2M*Fxx(q1)/q2m^n
Id,2,Ratio,q2M,q2m,[m2-M2]
Id,q2M^-1*Fxx(q1~)=Two(q,q1)
Al,Fxx(q1~)=NOM(q1,M)
Al,q2m^n~=1/Nohm^n
ENDIF

HCOUNT{}

C Elimination of qDq and Two.
  Should not occur, as qDq and M type propagators were already treated.

IF qDq^n~*Two(q,q1~)=qq2^n*Fxx(q1)/q2M
Id,2,Ratio,qq2,q2M,M2
Id,q2M^-1*Fxx(q1~)=Two(q,q1)
Al,Fxx(q1~)=NOM(q1,M)
Al,qq2=qDq^2
ENDIF

*yep

C Integration variable shift of  1/((q+qx)^2 + M^2)

IF NOT NOM(q,M)=Nom
Id,NOM(q1,M)=Sh1*Nom
Al,NOM(q2,M)=Sh2*Nom
Al,NOM(q3,M)=Sh3*Nom
Al,NOM(q4,M)=Sh4*Nom
Al,NOM(q5,M)=Sh5*Nom
ENDIF

SHIFT{}

HCOUNT{}

*yep

C Reduction of 1/(q^2+M^2) * 1/(q^2+m^2)^n

IF Nohm^n~*Nom=1/q2M/q2m^n
Id,2,Ratio,q2M,q2m,[m2-M2]
Id,q2M^-1=Nom
Al,q2m^n~=1/Nohm^n
ENDIF

*yep

C Elimination of qDq.

IF Nom
Id,Nom^n~=1/q2M^n
Al,qDq^n~=qq2^n
Id,Ratio,qq2,q2M,M2
Id,q2M^n~=1/Nom^n
Al,qq2=qDq
Al,M2=M^2
ENDIF

IF Nohm
Id,Nohm^n~=1/q2m^n
Al,qDq^n~=qq2^n
Id,Ratio,qq2,q2m,m2
Id,q2m^n~=1/Nohm^n
Al,qq2=qDq
Al,m2=m^2
ENDIF

IF NOM(q~,M~)
OR Two(q~,q1~)*Nohm^n~
Id,Addfa,Error
ENDIF

Id,Count,4,M,-1,M2,-2

Id,Count,x,Nohm,1,Nom,1,Two,1,NOM,1

IF NOT x
Id,Addfa,0
ENDIF

Id,x=1

C Check dimension 0.
C
Id,Count,x,M,1,M2,2,m,1,m2,2,Two,-4,Nom,-2,Nohm,-2,[m2-M2],2,
 q,1,p,1,k,1,pp,1,kp,1

IF NOT x^-4=1
Id,Addfa,Error
ENDIF

B Error,Nohm,Nom

*begin
Write BoxFF2
*end

C WW-scattering 9.  One loop Fi-Fi scattering, part 3. 125 sec.
  Uses output from 8. Produces BoxFF_comm.

C Part 3 of BoxFF.

C One loop diagrams.
  Four point function. FF scattering.
  Evaluated in the limit m^2 >> s,t,u >> M^2, where m = Higgs boson
  mass and M = W boson mass.

C Work to be done:
 - Do integrals.
   1/(qx^2+M^2) with or without Higgs propagators;
   Higgs propagators;
   Functions Two and no Higgs propagator.

P ninput

Enter BoxFF2

Read WWb.e
ASSIGN{}

*fix

Names BoxFF
P stats

Z Box(a,b,c,d,s,t,u) =
 BoxFF(a,al,k,b,be,p,c,ga,pp,d,de,kp)

IF NOT Two(q~,q1~)
Id,All,q,N,Fq
ENDIF

Id,Fq(al~)=0
Al,Fq(al~,be~,ga~)=0
Al,Fq(al~,be~,ga~,de~,la~)=0
Al,Fq(al~,be~,ga~,de~,la~,a~,b~)=0

Id,Fq(al~,al~)=0

Id,Fq(al~,be~,be~,be~)=0
Al,Fq(be~,be~,be~,al~)=0

Al,Fq(be~,be~,be~,be~,al~,ga~)=0
Al,Fq(al~,be~,be~,be~,be~,al~)=0
Al,Fq(al~,ga~,be~,be~,be~,be~)=0

B Nohm,Nom
*yep
IF NOT Two(q~,q1~)
Id,Fq(al~,be~,ga~,de~)*Nom^l~ = dede(al,be,ga,de)*H(l,M2)
Al,Fq(al~,be~)*Nom^l~ = D(al,be)*G(l,M2)
Al,Nom^n~ = F(n,M2)
Id,Fq(al~,be~,ga~,de~)*Nohm^l~ = dede(al,be,ga,de)*H(l,m2)
Al,Fq(al~,be~)*Nohm^l~ = D(al,be)*G(l,m2)
Al,Nohm^l~ = F(l,m2)
ENDIF

Id,pDp=-M^2
Al,kDk=-M^2
Al,ppDpp=-M^2
Al,kpDkp=-M^2

Id,Multi,M^-2=M2^-1
Al,Multi,m^2=m2
Al,Multi,m^-2=m2^-1

*yep

STINT{}

Id,N=N_+4
Id,N_=0
Al,N=4
Id,pDpp=-kDp-kDpp+M2
B i,Pi,N_,Nohm,M2
Id,Count,4,M,-1,M2,-2
*yep

Id,Two(q,q1~)=Two(q1)
IF Two(q~)
Al,All,q,N,Fq
ENDIF
Id,Adiso,Two(q4)*Fq(al~,be~) =
 D(al,be)*B22(u,M,M) + (k(al)+pp(al))*(k(be)+pp(be))*B21(u,M,M)
Al,Adiso,Two(q4)*Fq(al~)=- (k(al)+pp(al))*B1(u,M,M)
Al,Two(q4)=B0(u,M,M)

Id,Adiso,Two(q5)*Fq(al~,be~) =
 D(al,be)*B22(s,M,M) + (k(al)+p(al))*(k(be)+p(be))*B21(s,M,M)
Al,Adiso,Two(q5)*Fq(al~)=- (k(al)+p(al))*B1(s,M,M)
Al,Two(q5)=B0(s,M,M)

Id,Adiso,Two(q2)*Fq(al~,be~) =
 D(al,be)*B22(t,M,M) + (pp(al)+p(al))*(pp(be)+p(be))*B21(t,M,M)
Al,Adiso,Two(q2)*Fq(al~)= (pp(al)+p(al))*B1(t,M,M)
Al,Two(q2)=B0(t,M,M)

*yep

Id,B22(u~,M~,m~)=(-0.5*F1(m)+M**2*B0(u,M,m)
      -0.5*(-u+m^2-M**2)*B1(u,M,m))/[1-N]
Id,B21(u~,M~,m~)=((0.5*N-1)*F1(m)
       -0.5*N*(-u+m^2-M**2)*B1(u,M,m)
       +M**2*B0(u,M,m) )/u/[1-N]
Id,B1(u~,M~,m~)=- (0.5*F1(M)-0.5*F1(m)
              -0.5*(-u+m^2-M**2)*B0(u,M,m) )/u
Id,B0(u~,M~,M~)= - 2*i*Pi^2/N_ - i*Pi^2*Log(u) + 2*i*Pi^2
Al,F1(M) = 2*i*Pi^2*M2/N_ + i*Pi^2*M2*(-1+Log(M2))
Al,F1(m) = 2*i*Pi^2*m2/N_ + i*Pi^2*m2*(-1+Log(m2))
Al,M^n~=M2^(n/2)
Al,m^n~=m2^(n/2)

Id,N=N_+4
Al,[1-N]^-1=-1/3 + N_/9
Id,N_=0
Id,N=4
Al,ExtM = - 2*kDpp/u*{1 + M2/u + M2^2/u^2}

Id,Count,0,m2,2,[m2-M2],2
Al,Multi,m2^-1=0
Id,Count,x,m2,1
IF x
Id,x^n1~*[m2-M2]^n~=x^n1*m2^n*DS(K,0,n1+n,(DB(-n+K-1,K)*M2^K*m2^-K))
Id,x^n1~*Extm^n~=DS(K,0,n1,(DB(n+K-1,K)*(-2*kDpp/m2)^K))
ELSE
Id,[m2-M2]^n~=m2^n
Al,Extm=1
ENDIF
Id,Count,0,m2,1
Al,x=1

Id,pDk= - 0.5*s
Al,pDpp = - 0.5*t
Al,kDpp = - 0.5*u
Id,pDp=-M2
Al,kDk=-M2
Al,ppDpp=-M2
Al,kpDkp=-M2
Id,Count,4,s,2,u,2,t,2
Id,t=-s-u
Keep Box
*next

P input

Common FTot
Delete BoxFF

C Add further diagrams, obtained by crossing. Set labels A0-A3 to 1.

Z FTot=Box(a,b,c,d,s,t,u) + Box(a,c,b,d,u,t,s) + Box(a,b,d,c,s,u,t)

B i,Pi,N_,M2
Id,A0=1
Al,A1=1
Al,A2=1
Al,A3=1
Al,R1=1
Al,R2=1
Al,R3=1
Al,R3a=1
Al,R3b=1
Al,R4=1
Al,R4a=1
Al,R4b=1
Al,R5=1
Al,R6=1
Al,T1=1
Al,T2=1
Al,T3=1

IF D(a,c)
Id,t=-s-u
ENDIF

IF D(a,b)
Id,u=-s-t
ENDIF

IF D(a,d)
Id,s=-t-u
ENDIF
P output
*yep

Id,R1Z=1
Al,R5Z=1

*begin
Write BoxFF_comm
*end

C WW-scattering 10. Fi-Fi Renormalization. Result Fi-Fi amplitude.
  Uses output from 9.

C Subtraction terms four-Fi amplitude.

P ninput

A M,m,x,qq2,qqM,q2M,s,t,u
V q,q0,q1,q3,q2,q4

Enter BoxFF_comm

Read WWb.e
VERT{}
*fix

Names FTot

I m1=N,m0=N,m3=N,m4=N,m5=N,m6=N,m7=N,m8=N
I a=3,b=3,c=3,d=3

C Momenta: all taken to be ingoing.
  k,p in, pp,kp out. k + p = - pp - kp.

Z RenFF4 = FFFF(a,k,k,b,p,p,c,pp,pp,d,kp,kp)*FFFFK

Z RenFFr(a,b,c,d,s,t,u)=
   DS("F;"F;-J1;TAP,(
   VIE1("F,a,k,k,"F,b,p,p,"F,c,pp,pp,"F,d,kp,kp,J1) ))

 + DS("F;"F;-J2;TAP,(DS("F;"F;J3;TAP,(
   VIE2("F,a,k,k,"F,b,p,p,"F,c,pp,pp,"F,d,kp,kp,J2,J3) )) ))

 + DS("F;"F;J4;"Z;TAP,(
   VIE3("F,a,k,k,"F,b,p,p,"F,c,pp,pp,"F,d,kp,kp,J4) ))


Id,VIE1(K1~,a~,al~,k~,K2~,b~,be~,p~,K3~,c~,ga~,pp~,K4~,d~,de~,kp~,J1~) =
   VE3(K1,K3,-J1,*,a,al,k,*,c,ga,-pp,*,l1,m1,-qu)*
   VE3(K2,K4,J1,*,b,be,p,*,d,de,-kp,*,l2,m0,qu)*
   PROP(J1,-J1,*,l1,m1,qu,*,l2,m0,-qu)*
   CONT(K1,K3,J1,/,"K)*CONT(K2,K4,-J1,/,"K)
   *R3

Al,VIE2(K1~,a~,al~,k~,K2~,b~,be~,p~,K3~,c~,ga~,pp~,K4~,d~,de~,kp~,J1~,J2~) =
   VE3(K1,K3,-J1,*,a,al,k,*,c,ga,-pp,*,l1,m1,-qu)*
   VE3(K2,K4,J2,*,b,be,p,*,d,de,-kp,*,l4,m4,qu)*
   VE3(J1,-J2,"N,*,l2,m0,qu,*,l3,m3,-qu,*,l5,m5,q0)*
   PROP(J1,-J1,*,l1,m1,qu,*,l2,m0,-qu)*
   PROP(J2,-J2,*,l3,m3,qu,*,l4,m4,-qu)
   *R5

 + VE3(K1,K3,-J1,*,a,al,k,*,c,ga,-pp,*,l1,m1,-qu)*
   VE3(K2,K4,J2,*,b,be,p,*,d,de,-kp,*,l4,m4,qu)*
   VE3(J1,-J2,"Z,*,l2,m0,qu,*,l3,m3,-qu,*,l5,m5,q0)*
   NNZ(a,al,k,b,be,p,l6,m6,-q0)*
   PROP(J1,-J1,*,l1,m1,qu,*,l2,m0,-qu)*
   PROP(J2,-J2,*,l3,m3,qu,*,l4,m4,-qu)*
   PROP("Z,"Z,*,l5,m5,q0,*,l6,m6,-q0)
   *T3

Id,VIE3(K1~,a~,al~,k~,K2~,b~,be~,p~,K3~,c~,ga~,pp~,K4~,d~,de~,kp~,J1~) =
   VE4(K1,K3,-J1,"Z,*,a,al,k,*,c,ga,-pp,*,l1,m1,-qu,*,l3,m3,-q0)*
   VE3(K2,K4,J1,*,b,be,p,*,d,de,-kp,*,l2,m0,qu)*
   NNZ(a,al,k,b,be,p,l4,m4,q0)*
   PROP(J1,-J1,*,l1,m1,qu,*,l2,m0,-qu)*
   PROP("Z,"Z,*,l3,m3,q0,*,l4,m4,-q0)
   *T1

  +VE3(K1,K3,-J1,*,a,al,k,*,c,ga,-pp,*,l1,m1,-qu)*
   VE4(K2,K4,J1,"Z,*,b,be,p,*,d,de,-kp,*,l2,m0,qu,*,l3,m3,-q0)*
   NNZ(a,al,k,b,be,p,l4,m4,q0)*
   PROP(J1,-J1,*,l1,m1,qu,*,l2,m0,-qu)*
   PROP("Z,"Z,*,l3,m3,q0,*,l4,m4,-q0)
   *T2

Id,Anti,TAP

Id,Compo,<X>,VE4,VE3,PROP
Id,Compo,<X>,CONT

Id,Adiso,CONT(FF~)*CONT(WW~)= FF + WW
Al,CONT(FF~)= FF

Id,VE4(FF~,l1~,al~,k~,l2~,be~,p~,l3~,ga~,pp~,l4~,la~,kp~)=
 FF(l1,al,k,l2,be,p,l3,ga,pp,l4,la,kp)
Al,VE3(FF~,l1~,al~,k~,l2~,be~,q~,l3~,ga~,p~)=
       FF(l1,al,k,l2,be,q,l3,ga,p)
Al,PROP(FF~,l1~,al~,q~,l2~,be~,k~)=FF(l1,al,l2,be,k)
B i,Pi,N_,M

Id,qu(al~)=k(al)+pp(al)
Al,quDqu=2*kDpp
Al,Dotpr,qu(al~)=k(al)+pp(al)
Al,Even,NOM,1

C By definition:
  Extm = 1/{1 + (2*kDpp + kDk + ppDpp)/m^2}
       = 1/{1 + 2*(kDpp - M^2)/m^2}
  This makes the principal behaviour explicit.

Id,NOM(qu,m)= Extm/m^2
Al,NOM(q0,M~)= 1/M^2

Id,NOM(qu,M)=-1/u
Al,Even,NOM,1
Id,kpDkp=0
Al,kp(al~)=-k(al)-p(al)-pp(al)
Al,Dotpr,kp(al~)=-k(al)-p(al)-pp(al)
Id,kDk=0
Al,pDp=0
Al,ppDpp=0
Id,pDk=-0.5*s
Al,pDpp=-0.5*t
Al,kDpp=-0.5*u

ETE1{}

*yep

Id,Count,0,m,1,m2,2,[m2-M2],2
Id,Count,x,m,1,m2,2,[m2-M2],2
IF x
Id,x^n1~*[m2-M2]^n~=x^n1*m2^n*DS(K,0,n1/2+n+1,(DB(-n+K-1,K)*M2^K*m2^-K))
Id,x^n1~*Extm^n~=DS(K,0,n1/2+1,(DB(n+K-1,K)*(-2*kDpp/m^2)^K))
ELSE
Id,[m2-M2]^n~=m2^n
Al,Extm=1
ENDIF
Id,M2^n~=M^(2*n)
Al,m2^n~=m^(2*n)
Al,kDpp=-0.5*u
Id,Count,0,m,1,m2,2
Al,x=1

Id,Count,4,s,2,t,2,u,2
*yep

Id,Epfred

IF D(a,c)
Id,t=-s-u
ENDIF
IF D(a,b)
Id,u=-s-t
ENDIF
IF D(a,d)
Id,u=-s-t
ENDIF

Keep RenFF4,RenFFr
*next
B i,Pi,N_,M

Z RenFFt=RenFF4
  + RenFFr(a,b,c,d,s,t,u) + RenFFr(a,c,b,d,u,t,s) + RenFFr(a,b,d,c,s,u,t)

Id,R5W=1
Al,R3=1

IF D(a,c)
Id,t=-s-u
ENDIF
IF D(a,b)
Id,u=-s-t
ENDIF
IF D(a,d)
Id,s=-t-u
ENDIF

*yep
Id,T1=1
Al,T2=1
Al,T3=1
Al,R5Z=1
Al,R5=1
Keep RenFFt
*next
P input
C Renormalized FFFF amplitude.

Z RenF = FTot - RenFFt
B i,Pi,N_,M2,M
Id,Multi,M2^n~=M^(2*n)
Al,Logm2=Log(m2)
Id,Log(s)=Log(s,m2)+Log(m2)
Al,Log(t)=Log(t,m2)+Log(m2)
Al,Log(u)=Log(u,m2)+Log(m2)
P output
*yep
C Specialize, for computimg purposes, to index a=b, c=d, a not c.

IF NOT D(a,b)=1
Id,Addfa,0
ENDIF
Id,D(c,d)=1

*end

C WW-scattering 11. One loop W-W scattering, part 1. 681 sec.
  Produces BoxWW1, containing BoxWW.

C One loop diagrams.
  Four point function. WW scattering.
  Evaluated in the limit m^2 >> s,t,u >> M^2, where m = Higgs boson
  mass and M = W boson mass.

C Terms in the output are labelled by A0, A1, A2, A3, and R, T for the
  reducible and tadpole types.
  The connection is:
  Rx: reducible diagrams (in u-channel, as A3).
  R1 type: One propagator.
  R5 type: Two propagators: selfenergy insertion.
  Diagrams marked with R1Z and R5Z are Z-exchange diagrams.
  Tx: tadpole types.
  A0: Box diagram, a,al,k and c,ga,pp in opposite corners.
  A1: Inverted Triangle diagram, a,al,k and c,ga,pp on 4-vertex.
  A2: Triangle diagram, a,al,k and c,ga, pp on triangle basis.
  A3: Bubble diagram, a,al,k and c,ga,pp on one end.

P ninput

C Work done:
  - Generate the diagrams.
  - Reduce as much as possible q ocurrences in the numerator.

  It is assumed that there are no more than two non-Higgs propagators.
  If there are Error will be attached. Such terms add up to zero,
  demonstrated elsewhere.

P ninput

C This order is of importance when ordering NOM.
C
A M,M2,m,m2,x,qq2,qqM,q2M
V q,q1,q3,q2,q4,q0

Read WWb.e
VERT{}
*fix

BLOCK REDUC{}
Id,Count,x,NOM,1
IF Multi,x^3
Id,Adiso,qDk^n~*NOM(q,M~)*NOM(q3,m~)=0.5*qDk^(n-1)*
 {NOM(q3,m) - NOM(q,M) + (kDk-M^2+m^2)*NOM(q,M)*NOM(q3,m)}
Id,Adiso,qDp^n~*NOM(q1,M~)*NOM(q,m~)=0.5*qDp^(n-1)*
 {NOM(q,m) - NOM(q1,M) + NOM(q,m)*NOM(q1,M)*(-pDp+m^2-M^2)}
Id,Adiso,qDpp^n~*NOM(q2,M~)*NOM(q1,m~)=0.5*qDpp^(n-1)*
 {NOM(q1,m) - NOM(q2,M) + NOM(q1,m)*NOM(q2,M)*(- 2*pDpp -ppDpp+m^2-M^2)}
Id,Adiso,qDpp^n~*NOM(q4,M~)*NOM(q3,m~)=-0.5*qDpp^(n-1)*
 {NOM(q3,m) - NOM(q4,M) + NOM(q3,m)*NOM(q4,M)*(- 2*kDpp -ppDpp+m^2-M^2)}
Id,Adiso,qDkp^n~*NOM(q2,M~)*NOM(q3,m~)=0.5*qDkp^(n-1)*
 {NOM(q2,M) - NOM(q3,m) + NOM(q2,M)*NOM(q3,m)*(
 - kpDkp - 2*pDkp - 2*ppDkp + M^2 - m^2)}
Id,Adiso,qDkp^n~*NOM(q4,M~)*NOM(q1,m~)=0.5*qDkp^(n-1)*
 {NOM(q1,m) - NOM(q4,M) + NOM(q1,m)*NOM(q4,M)*(- 2*pDkp -kpDkp+m^2-M^2)}
Id,pDp=0
Al,kDk=0
Al,ppDpp=0
Al,kpDkp=0
Id,pDpp=-pDk-kDpp
Id,NOM(q~,M~)=NOM(M,q)
Id,Commu,NOM
Id,NOM(M~,q~)=NOM(q,M)
ENDIF
Id,x=1
ENDBLOCK

BLOCK Q2RED{X}
Id,NOM(q~,M~)=NOM(M,q)
Id,Commu,NOM
Id,NOM(M~,q~)=NOM(q,M)
Id,qDq=qq2

C Do only for X.

Id,qq2^n~*NOM(q~,'X')=qq2^n/qqM*Fxx(q,'X')

C This works for M and m.

Id,Ratio,qq2,qqM,q2M
Id,q2M^n~*Fxx(q,m~)=m^(2*n)*Fxx(q,m)
Al,q2M^n~*Fxx(q1,m~)={2*qDp-M^2+m^2}^n*Fxx(q1,m)
Al,q2M^n~*Fxx(q2,m~)={2*qDp+2*qDpp+2*pDpp-2*M^2+m^2}^n*Fxx(q2,m)
Al,q2M^n~*Fxx(q3,m~)={-2*qDk-M^2+m^2}^n*Fxx(q3,m)
Al,q2M^n~*Fxx(q4,m~)={-2*qDk-2*qDpp+2*kDpp-2*M^2+m^2}^n*Fxx(q4,m)
Id,qqM^-1*Fxx(q~,m~)=NOM(q,m)
Al,Fxx(q~,m~)=1
Al,qq2=qDq
ENDBLOCK

P stats

Common BoxWW

V q1,q2,q3,q4
I m1=N,m0=N,m3=N,m4=N,m5=N,m6=N,m7=N,m8=N
I a=3,b=3,c=3,d=3

F F4q,F3,F2,F1

C Momenta: all taken to be ingoing.
  k,p in, pp,kp out. k + p = - pp - kp.

Z BoxWW(a,al,k,b,be,p,c,ga,pp,d,de,kp) =
    VIER("W,a,k,k,"W,b,p,p,"W,c,pp,pp,"W,d,kp,kp)/M^4

C  For information: this is to be added to get the full result:

   + VIER("W,a,al,k,"W,c,ga,pp,"W,b,be,p,"W,d,de,kp)
   + VIER("W,a,al,k,"W,b,be,p,"W,d,de,kp,"W,c,ga,pp)

FOUR{}

Id,pDp=0
Al,kDk=0
Al,ppDpp=0
Al,kpDkp=0

*yep

Id,q1(al~)=q(al)+p(al)
Al,q1Dq1=qDq+2*qDp
Al,Dotpr,q1(al~)=q(al)+p(al)
Al,q0(al~)=0
Al,Dotpr,q0(al~)=0
Id,q2(al~)=q(al)+p(al)+pp(al)
Al,q2Dq2=qDq+2*qDp+2*qDpp+2*pDpp
Al,Dotpr,q2(al~)=q(al)+p(al)+pp(al)
Id,q3(al~)=q(al)-k(al)
Al,q3Dq3=qDq-2*qDk
Al,Dotpr,q3(al~)=q(al)-k(al)
Id,q4(al~)=q(al)-k(al)-pp(al)
Al,q4Dq4=qDq-2*qDk-2*qDpp+2*kDpp
Al,Dotpr,q4(al~)=q(al)-k(al)-pp(al)
Id,qu(al~)=k(al)+pp(al)
Al,quDqu=kDk+2*kDpp
Al,Dotpr,qu(al~)=k(al)+pp(al)

Al,Even,NOM,1

Id,Epfred
*yep


C By definition:
  Extm = 1/{1 + (2*kDpp + kDk + ppDpp)/m^2}
       = 1/{1 + 2*(kDpp - M^2)/m^2}
  ExtM = - 2*kDpp/(u-M^2). Note ExtM=-1 in lowest order.
  This makes their principal behaviour explicit.

Id,NOM(qu,m)= Extm/m^2
Al,NOM(qu,M)= ExtM/kDpp/2
Al,NOM(q0,M~)= 1/M^2

Id,pDp=0
Al,kDk=0
Al,ppDpp=0
Al,kpDkp=0
*yep
Id,Count,0,NOM,-2,p,1,k,1,pp,1,kp,1,q,1,m,1
Id,kp(al~)= - p(al)- k(al) - pp(al)
Al,Dotpr,kp(al~)= - p(al) - k(al)- pp(al)
Id,Count,0,NOM,-2,p,1,k,1,pp,1,kp,1,q,1,m,1
Id,pDpp=-pDk-kDpp
Id,Count,0,NOM,-2,p,1,k,1,pp,1,kp,1,q,1,m,1

Id,pDp=0
Al,kDk=0
Al,ppDpp=0
Al,kpDkp=0

Id,Epfred
Al,Even,NOM,1

IF NOT NOM(q~,m)
Id,Count,0,m,1
ENDIF

*yep

Q2RED{M}
Q2RED{M}
*yep
Q2RED{m}
Q2RED{m}
*yep
REDUC{}
*yep
REDUC{}
*yep
REDUC{}
*yep
REDUC{}
*yep
REDUC{}
*yep
REDUC{}
*yep
Id,qDk=-qDkp-qDp-qDpp
REDUC{}
*yep
REDUC{}
*yep
Id,Dotpr,kp(al~)=-k(al)-p(al)-pp(al)
Id,pDp=0
Al,kDk=0
Al,ppDpp=0
Al,kpDkp=0
*yep
REDUC{}
*yep
REDUC{}
Id,qDpp=-qDkp-qDp-qDk
*yep
REDUC{}
*yep
REDUC{}
*yep
Id,Dotpr,kp(al~)=-k(al)-p(al)-pp(al)
Id,pDp=0
Al,kDk=0
Al,ppDpp=0
Al,kpDkp=0
*yep
REDUC{}
*yep
REDUC{}

Id,pDpp=-pDk-kDpp
Id,Count,0,NOM,-2,p,1,k,1,pp,1,kp,1,q,1,m,1

*yep

Id,NOM(q~,M~)=NOM(M,q)
Id,Commu,NOM
Id,NOM(M~,q~)=NOM(q,M)

Id,Adiso,pDq^4*NOM(q~,m)*NOM(q1~,m)*NOM(q2~,M)*NOM(q3~,M)=0

*yep

Id,Count,x,NOM,1

IF NOT x
Id,Addfa,0
ENDIF

Id,x=1

Id,NOM(q~,M)=x*NOM(q,M)
IF Multi,x^3
Id,Addfa,Error
ENDIF

B Error

Id,x=1

*begin
Write BoxWW1
*end

C WW-scattering 12. One loop W-W scattering, part 2. 605 sec.
  Uses output from 11. Produces BoxWW2, containing BoxWW.

C Part 2 of BoxWW.

C The input file contains terms (three-point functions, no Higgs propagators)
  labelled with 'Error'. They add up to zero; see program 15 for proof.
  Here only the inifinite part is kept, and shown to add up to zero as
  no 'Error' label remains.

C Work done:
 - Expand all Higgs propagators: 1/((q+qx)^2+m^2) => 1/(q^2+m^2)
 - The assumption at this point is that that there are no more
   than 2 non-Higgs propagators. If two, take them together in
   the function Two(qa,qb). If qa not q then shift momentum so
   that only Two(q,qx) occurs. The Higgs propagators become shifted
   again. They are expanded again.
 - Expand Two(q,qx) times any non-zero number of Higgs propagators:
   Rationalize 1/(q^2+M^2)* 1/(q^2+m^2), the result contains a NOM
   but no more Two.
   Reduce any non-zero number of qDq together with Two(q,qx).
 - Work out NOM(qx,M) with qx not q, and any number of Higgs propagators.
   Shift qx to q. Expand shifted Higgs propagators.
 - Rationalize again.
 - Reduce all qDq occurences.
 - After this work there are the following types of terms:
   One Two function and no Higgs propagator;
   One NOM(q,M);
   Any number of Higgs propagators.

P ninput

Enter BoxWW1

Read WWb.e

ASSIGN{}

*fix

Names BoxWW

P stats

Z BoxWW(a,al,k,b,be,p,c,ga,pp,d,de,kp) =
  BoxWW(a,al,k,b,be,p,c,ga,pp,d,de,kp)

IF Error
C Compute infinite part of three-pount functions not containing m.
  Supposedly nothing survives. See program 15.

Id,Count,-4,NOM,-2,q,1
Id,All,q,N,Fq,"F_
Id,Adiso,NOM(q~,M)*NOM(q1~,M)*NOM(q2~,M)*Fq(al~,be~)=
 -2*i*Pi^2/N_*D(al,be)
ENDIF

Id,pDp=0
Al,kDk=0
Al,ppDpp=0
Al,kpDkp=0
Id,Dotpr,kp(al~)=-k(al)-p(al)-pp(al)
Id,pDp=0
Al,kDk=0
Al,ppDpp=0
Al,kpDkp=0

Id,pDpp=-pDk-kDpp

*yep

C Expand Higgs propagators.
  There may be two of them.

Id,NOM(q,m)=Nohm

IF NOM(q~,m)=Fxx(q)
Id,Count,Div,q,1,NOM,-2,Two,-4
Id,Fxx(q~)=Fact^-2*NOM(q,m)
Id,Fact^n~=Fxx(n,0,0)
Id,Nohm^n~*Fxx(n1~,0,0)=Nohm^n*Fxx(n1-2*n,0,0)
Id,m^n~*Fxx(n1~,0,0)=m^n*Fxx(n1,n,0)
Id,Div^n~*Fxx(n1~,n2~,0)=Fxx(n1,n2,n)
Id,Adiso,Fxx(n1~,n2~,n3~)*NOM(q1,m)=Fdiv(n1,n2,n3)*Exp(n1,n2,n3,(-2*qDp),1)
Al,Adiso,Fxx(n1~,n2~,n3~)*NOM(q2,m)=Fdiv(n1,n2,n3)*
 Exp(n1,n2,n3,(-2*qDp-2*qDpp-2*pDpp),1)
Al,Adiso,Fxx(n1~,n2~,n3~)*NOM(q3,m)=Fdiv(n1,n2,n3)
 *Exp(n1,n2,n3,(2*qDk),1)
Al,Adiso,Fxx(n1~,n2~,n3~)*NOM(q4,m)=Fdiv(n1,n2,n3)
 *Exp(n1,n2,n3,(2*qDk+2*qDpp-2*kDpp),1)
ENDIF

Id,Fact^n~=1

B Nohm,Nom
*yep

IF NOM(q~,m)=Fxx(q)
Id,Count,Div,q,1,NOM,-2,Two,-4
Id,Fxx(q~)=Fact^-2*NOM(q,m)
Id,Fact^n~=Fxx(n,0,0)
Id,Nohm^n~*Fxx(n1~,0,0)=Nohm^n*Fxx(n1-2*n,0,0)
Id,m^n~*Fxx(n1~,0,0)=m^n*Fxx(n1,n,0)
Id,Div^n~*Fxx(n1~,n2~,0)=Fxx(n1,n2,n)
Id,Adiso,Fxx(n1~,n2~,n3~)*NOM(q1,m)=Fdiv(n1,n2,n3)*Exp(n1,n2,n3,(-2*qDp),1)
Al,Adiso,Fxx(n1~,n2~,n3~)*NOM(q2,m)=Fdiv(n1,n2,n3)*
 Exp(n1,n2,n3,(-2*qDp-2*qDpp-2*pDpp),1)
Al,Adiso,Fxx(n1~,n2~,n3~)*NOM(q3,m)=Fdiv(n1,n2,n3)
 *Exp(n1,n2,n3,(2*qDk),1)
Al,Adiso,Fxx(n1~,n2~,n3~)*NOM(q4,m)=Fdiv(n1,n2,n3)
 *Exp(n1,n2,n3,(2*qDk+2*qDpp-2*kDpp),1)
ENDIF

Id,Fact^n~=1

B Nohm,Nom
*yep
Id,pDpp=M^2-pDk-kDpp
Id,Count,0,NOM,-2,Two,-4,Nom,-2,Nohm,-2,[m2-M2],2,p,1,k,1,pp,1,kp,1,q,1,m,1

HCOUNT{}
*yep

Id,Adiso,NOM(q~,M)*NOM(q1~,M) = Two(q,q1)
Id,Commu,NOM
Id,Two(q1~,q)=Two(q,q1~)

Id,Two(q1,q2~)=Sh1*Two(q,q2,-p)
Al,Two(q2,q5~)=Sh2*Two(q,q5,qt)
Al,Two(q3,q5~)=Sh3*Two(q,q5,k)
Al,Two(q4,q5~)=Sh4*Two(q,q5,qu)

SHIFT{}
HCOUNT{}

*yep

Id,Two(q,q3,-p)=Two(q,q5)
Al,Two(q,q4,k)=Two(q,q6)*Chsi
Al,Two(q,q4,-p)=Two(q,q7)
Al,Two(q,q2,k)=Two(q,q7)*Chsi
Al,Two(q,q2,-p)=Two(q,q6)

Id,Multi,Chsi^2=1
IF Chsi=1
Al,qDq=qDq
Al,Dotpr,q(al~)=-q(al)
ENDIF

*yep

C Reduction of 1/(q^2+M^2) * 1/(q^2+m^2)^n

IF Nohm^n~*Two(q,q1~)=1/q2M*Fxx(q1)/q2m^n
Id,2,Ratio,q2M,q2m,[m2-M2]
Id,q2M^-1*Fxx(q1~)=Two(q,q1)
Al,Fxx(q1~)=NOM(q1,M)
Al,q2m^n~=1/Nohm^n
ENDIF

HCOUNT{}

C Elimination of qDq and Two.
  Should not occur, as qDq and M type propagators were already treated.

IF qDq^n~*Two(q,q1~)=qq2^n*Fxx(q1)/q2M
Id,2,Ratio,qq2,q2M,M2
Id,q2M^-1*Fxx(q1~)=Two(q,q1)
Al,Fxx(q1~)=NOM(q1,M)
Al,qq2=qDq^2
ENDIF

*yep

C Integration variable shift of  1/((q+qx)^2 + M^2)

IF NOT NOM(q,M)=Nom
Id,NOM(q1,M)=Sh1*Nom
Al,NOM(q2,M)=Sh2*Nom
Al,NOM(q3,M)=Sh3*Nom
Al,NOM(q4,M)=Sh4*Nom
Al,NOM(q5,M)=Sh5*Nom
Al,NOM(q6,M)=Sh6*Nom
Al,NOM(q7,M)=Sh7*Nom
ENDIF

SHIFT{}

HCOUNT{}

*yep

C Reduction of 1/(q^2+M^2) * 1/(q^2+m^2)^n

IF Nohm^n~*Nom=1/q2M/q2m^n
Id,2,Ratio,q2M,q2m,[m2-M2]
Id,q2M^-1=Nom
Al,q2m^n~=1/Nohm^n
ENDIF

*yep

C Elimination of qDq.

IF Nom
Id,Nom^n~=1/q2M^n
Al,qDq^n~=qq2^n
Id,Ratio,qq2,q2M,M2
Id,q2M^n~=1/Nom^n
Al,qq2=qDq
Al,M2=M^2
ENDIF

IF Nohm
Id,Nohm^n~=1/q2m^n
Al,qDq^n~=qq2^n
Id,Ratio,qq2,q2m,m2
Id,q2m^n~=1/Nohm^n
Al,qq2=qDq
Al,m2=m^2
ENDIF

IF NOM(q~,M~)
OR Two(q~,q1~)*Nohm^n~
Id,Addfa,Error
ENDIF

C Count all but M.
C
Id,Count,0,NOM,-2,Two,-4,Nom,-2,Nohm,-2,[m2-M2],2,
 p,1,k,1,pp,1,kp,1,q,1,m,1

Id,Count,x,Nohm,1,Nom,1,Two,1,NOM,1

IF NOT x
Id,Addfa,0
ENDIF

Id,x=1

C Check dimension 0.
C
Id,Count,x,M,1,M2,2,m,1,m2,2,Two,-4,Nom,-2,Nohm,-2,[m2-M2],2,
 q,1,p,1,k,1,pp,1,kp,1

IF NOT x^-4=1
Id,Addfa,Error
ENDIF

B Error,Nohm,Nom

*begin
Write BoxWW2
*end

C WW-scattering 13. One loop W-W scattering, part 3. 447 sec.
  Uses output from 12. Produces BoxWW_comm, containing Wtot.

C One loop diagrams.
  Four point function. WW scattering.
  Evaluated in the limit m^2 >> s,t,u >> M^2, where m = Higgs boson
  mass and M = W boson mass.

P ninput

C Work to be done:
 - Do integrals.
   1/(qx^2+M^2) with or without Higgs propagators;
   Higgs propagators;
   Functions Two and no Higgs propagator.

Enter BoxWW2

Read WWb.e

ASSIGN{}

*fix

Names BoxWW
P stats

Z BoxW(a,b,c,d,s,t,u) =
 BoxWW(a,al,k,b,be,p,c,ga,pp,d,de,kp)

IF NOT Two(q~,q1~)
Id,All,q,N,Fq
ENDIF

Id,Fq(al~)=0
Al,Fq(al~,be~,ga~)=0
Al,Fq(al~,be~,ga~,de~,la~)=0
Al,Fq(al~,be~,ga~,de~,la~,a~,b~)=0

Id,Fq(al~,al~)=0

Id,Fq(al~,be~,be~,be~)=0
Al,Fq(be~,be~,be~,al~)=0

Al,Fq(be~,be~,be~,be~,al~,ga~)=0
Al,Fq(al~,be~,be~,be~,be~,al~)=0
Al,Fq(al~,ga~,be~,be~,be~,be~)=0

B Nohm,Nom
*yep
IF NOT Two(q~,q1~)
Id,Fq(al~,be~,ga~,de~)*Nom^l~ = dede(al,be,ga,de)*H(l,M2)
Al,Fq(al~,be~)*Nom^l~ = D(al,be)*G(l,M2)
Al,Nom^n~ = F(n,M2)
Id,Fq(al~,be~,ga~,de~)*Nohm^l~ = dede(al,be,ga,de)*H(l,m2)
Al,Fq(al~,be~)*Nohm^l~ = D(al,be)*G(l,m2)
Al,Nohm^l~ = F(l,m2)
ENDIF

Id,pDp=-M^2
Al,kDk=-M^2
Al,ppDpp=-M^2
Al,kpDkp=-M^2

Id,Multi,M^-2=M2^-1
Al,Multi,m^2=m2
Al,Multi,m^-2=m2^-1

*yep

STINT{}

Id,N=N_+4
Id,N_=0
Al,N=4
Id,pDpp=-kDp-kDpp+M2
B i,Pi,N_,Nohm,M2
Id,Count,x,M,1,M2,2
IF NOT x^-4=1
Id,Addfa,0
ENDIF
C Id,Count,4,p,1,k,1,pp,1,kp,1,q,1,Two,10,Extm,10,ExtM,10
*yep
Id,Two(q,q1~)=Two(q1)
IF Two(q~)
Al,All,q,N,Fq
ENDIF
Id,Adiso,Two(q4)*Fq(al~,be~) =
 D(al,be)*B22(u,M,M) + (k(al)+pp(al))*(k(be)+pp(be))*B21(u,M,M)
Al,Adiso,Two(q4)*Fq(al~)=- (k(al)+pp(al))*B1(u,M,M)
Al,Two(q4)=B0(u,M,M)

Id,Adiso,Two(q5)*Fq(al~,be~) =
 D(al,be)*B22(s,M,M) + (k(al)+p(al))*(k(be)+p(be))*B21(s,M,M)
Al,Adiso,Two(q5)*Fq(al~)=- (k(al)+p(al))*B1(s,M,M)
Al,Two(q5)=B0(s,M,M)

Id,Adiso,Two(q2)*Fq(al~,be~) =
 D(al,be)*B22(t,M,M) + (pp(al)+p(al))*(pp(be)+p(be))*B21(t,M,M)
Al,Adiso,Two(q2)*Fq(al~)= (pp(al)+p(al))*B1(t,M,M)
Al,Two(q2)=B0(t,M,M)

Al,Adiso,Two(q1)*Fq(al~,be~) =
 D(al,be)*BB22 + p(al)*p(be)*BB21
Al,Adiso,Two(q1)*Fq(al~)= p(al)*BB1
Al,Two(q1)=BB0

Al,Adiso,Two(q3)*Fq(al~,be~) =
 D(al,be)*BB22 + k(al)*k(be)*BB21
Al,Adiso,Two(q3)*Fq(al~)= -k(al)*BB1
Al,Two(q3)=BB0

Al,Adiso,Two(q6)*Fq(al~,be~) =
 D(al,be)*BB22 + pp(al)*pp(be)*BB21
Al,Adiso,Two(q6)*Fq(al~)= pp(al)*BB1
Al,Two(q6)=BB0

Al,Adiso,Two(q7)*Fq(al~,be~) =
 D(al,be)*BB22 + (k(al)+pp(al)+p(al))*(k(be)+pp(be)+p(be))*BB21
Al,Adiso,Two(q7)*Fq(al~)= -(k(al)+pp(al)+p(al))*BB1
Al,Two(q7)=BB0

*yep

Id,B22(u~,M~,m~)=(-0.5*F1(m)+M**2*B0(u,M,m)
      -0.5*(-u+m^2-M**2)*B1(u,M,m))/[1-N]
Id,B21(u~,M~,m~)=((0.5*N-1)*F1(m)
       -0.5*N*(-u+m^2-M**2)*B1(u,M,m)
       +M**2*B0(u,M,m) )/u/[1-N]
Id,B1(u~,M~,m~)=- (0.5*F1(M)-0.5*F1(m)
              -0.5*(-u+m^2-M**2)*B0(u,M,m) )/u
Id,B0(u~,M~,M~)= - 2*i*Pi^2/N_ - i*Pi^2*Log(u) + 2*i*Pi^2
Al,F1(M) = 2*i*Pi^2*M2/N_ + i*Pi^2*M2*(-1+Log(M2))
Al,F1(m) = 2*i*Pi^2*m2/N_ + i*Pi^2*m2*(-1+Log(m2))
Al,M^n~=M2^(n/2)
Al,m^n~=m2^(n/2)

Id,BB0=i*Pi^2
  * ( - Log(M2) - 2*N_^-1 - [Pi/Sqrt(3)-2] )
Al,BB1=i*Pi^2
  * ( 1/2*Log(M2) + N_^-1 + 1/2*[Pi/Sqrt(3)-2] )
Al,BB21=i*Pi^2
  * ( 1/18 - 1/3*Log(M2) - 2/3*N_^-1 )
Al,BB22=i*Pi^2*M2
  * ( - 4/9 + 5/12*Log(M2) + 5/6*N_^-1 + 1/4*[Pi/Sqrt(3)-2] )

Id,N=N_+4
Al,[1-N]^-1=-1/3 + N_/9
Id,N_=0
Id,N=4
Al,ExtM = - 2*kDpp/u*{1 + M2/u + M2^2/u^2}

Id,Count,0,m2,2,[m2-M2],2
Al,Multi,m2^-1=0
Id,Count,x,m2,1
IF x
Id,x^n1~*[m2-M2]^n~=x^n1*m2^n*DS(K,0,n1+n,(DB(-n+K-1,K)*M2^K*m2^-K))
Id,x^n1~*Extm^n~=DS(K,0,n1,(DB(n+K-1,K)*(-2*kDpp/m2)^K))
ELSE
Id,[m2-M2]^n~=m2^n
Al,Extm=1
ENDIF
Id,Count,0,m2,1
Al,x=1

Id,pDk= - 0.5*s
C - 0.5*pDp - 0.5*kDk
Al,pDpp = - 0.5*t
C - 0.5*pDp - 0.5*ppDpp
Al,kDpp = - 0.5*u
C - 0.5*kDk - 0.5*ppDpp
Id,pDp=-M2
Al,kDk=-M2
Al,ppDpp=-M2
Al,kpDkp=-M2
Id,Count,4,s,2,u,2,t,2
Id,t=-s-u
Keep BoxW
*next
P input
C Add further diagrams, obtained by crossing. Set labels A0-A3 to 1.

Common WTot
Delete BoxWW

Z WTot=BoxW(a,b,c,d,s,t,u) + BoxW(a,c,b,d,u,t,s) + BoxW(a,b,d,c,s,u,t)

B i,Pi,N_,M2
Id,A0=1
Al,A1=1
Al,A2=1
Al,A3=1
Al,R1=1
Al,R2=1
Al,R3=1
Al,R3a=1
Al,R3b=1
Al,R4=1
Al,R4a=1
Al,R4b=1
Al,R5=1
Al,R6=1
Al,T1=1
Al,T2=1
Al,T3=1
IF D(a,c)
Id,t=-s-u
ENDIF
IF D(a,b)
Id,u=-s-t
ENDIF
IF D(a,d)
Id,s=-t-u
ENDIF
P output
*yep

Id,R1Z=1
Al,R5Z=1

*begin
Write BoxWW_comm
*end

C WW-scattering 14. W-W Renormalization. Result W-W amplitude.
  Uses output from 14.

C Subtraction terms four-W amplitude.

P ninput

A M,m,x,qq2,qqM,q2M,s,t,u
V q,q0,q1,q3,q2,q4

Enter BoxWW_comm

Read WWb.e
VERT{}
*fix

Names WTot

I m1=N,m0=N,m3=N,m4=N,m5=N,m6=N,m7=N,m8=N
I a=3,b=3,c=3,d=3

C Momenta: all taken to be ingoing.
  k,p in, pp,kp out. k + p = - pp - kp.

Z RenWW4 = WWWW(a,k,k,b,p,p,c,pp,pp,d,kp,kp)/M^4*WWWWK

Z RenWWr(a,b,c,d,s,t,u)=
   DS("W;"W;-J1;TAP,(
   VIE1("W,a,k,k,"W,b,p,p,"W,c,pp,pp,"W,d,kp,kp,J1)/M^4 ))

 + DS("W;"W;-J2;TAP,(DS("W;"W;J3;TAP,(
   VIE2("W,a,k,k,"W,b,p,p,"W,c,pp,pp,"W,d,kp,kp,J2,J3)/M^4 )) ))

 + DS("W;"W;J4;"Z;TAP,(
   VIE3("W,a,k,k,"W,b,p,p,"W,c,pp,pp,"W,d,kp,kp,J4)/M^4 ))


Id,VIE1(K1~,a~,al~,k~,K2~,b~,be~,p~,K3~,c~,ga~,pp~,K4~,d~,de~,kp~,J1~) =
   VE3(K1,K3,-J1,*,a,al,k,*,c,ga,-pp,*,l1,m1,-qu)*
   VE3(K2,K4,J1,*,b,be,p,*,d,de,-kp,*,l2,m0,qu)*
   PROP(J1,-J1,*,l1,m1,qu,*,l2,m0,-qu)*
   CONT(K1,K3,J1,/,"K)*CONT(K2,K4,-J1,/,"K)
   *R3

Al,VIE2(K1~,a~,al~,k~,K2~,b~,be~,p~,K3~,c~,ga~,pp~,K4~,d~,de~,kp~,J1~,J2~) =
   VE3(K1,K3,-J1,*,a,al,k,*,c,ga,-pp,*,l1,m1,-qu)*
   VE3(K2,K4,J2,*,b,be,p,*,d,de,-kp,*,l4,m4,qu)*
   VE3(J1,-J2,"N,*,l2,m0,qu,*,l3,m3,-qu,*,l5,m5,q0)*
   PROP(J1,-J1,*,l1,m1,qu,*,l2,m0,-qu)*
   PROP(J2,-J2,*,l3,m3,qu,*,l4,m4,-qu)
   *R5(J1,J2)

 + VE3(K1,K3,-J1,*,a,al,k,*,c,ga,-pp,*,l1,m1,-qu)*
   VE3(K2,K4,J2,*,b,be,p,*,d,de,-kp,*,l4,m4,qu)*
   VE3(J1,-J2,"Z,*,l2,m0,qu,*,l3,m3,-qu,*,l5,m5,q0)*
   NNZ(a,al,k,b,be,p,l6,m6,-q0)*
   PROP(J1,-J1,*,l1,m1,qu,*,l2,m0,-qu)*
   PROP(J2,-J2,*,l3,m3,qu,*,l4,m4,-qu)*
   PROP("Z,"Z,*,l5,m5,q0,*,l6,m6,-q0)
   *T3

Id,VIE3(K1~,a~,al~,k~,K2~,b~,be~,p~,K3~,c~,ga~,pp~,K4~,d~,de~,kp~,J1~) =
   VE4(K1,K3,-J1,"Z,*,a,al,k,*,c,ga,-pp,*,l1,m1,-qu,*,l3,m3,-q0)*
   VE3(K2,K4,J1,*,b,be,p,*,d,de,-kp,*,l2,m0,qu)*
   NNZ(a,al,k,b,be,p,l4,m4,q0)*
   PROP(J1,-J1,*,l1,m1,qu,*,l2,m0,-qu)*
   PROP("Z,"Z,*,l3,m3,q0,*,l4,m4,-q0)
   *T1

  +VE3(K1,K3,-J1,*,a,al,k,*,c,ga,-pp,*,l1,m1,-qu)*
   VE4(K2,K4,J1,"Z,*,b,be,p,*,d,de,-kp,*,l2,m0,qu,*,l3,m3,-q0)*
   NNZ(a,al,k,b,be,p,l4,m4,q0)*
   PROP(J1,-J1,*,l1,m1,qu,*,l2,m0,-qu)*
   PROP("Z,"Z,*,l3,m3,q0,*,l4,m4,-q0)
   *T2

Id,Anti,TAP

Id,Compo,<X>,VE4,VE3,PROP
Id,Compo,<X>,CONT

Id,Adiso,CONT(FF~)*CONT(WW~)= FF + WW
Al,CONT(FF~)= FF

Id,VE4(FF~,l1~,al~,k~,l2~,be~,p~,l3~,ga~,pp~,l4~,la~,kp~)=
 FF(l1,al,k,l2,be,p,l3,ga,pp,l4,la,kp)
Al,VE3(FF~,l1~,al~,k~,l2~,be~,q~,l3~,ga~,p~)=
       FF(l1,al,k,l2,be,q,l3,ga,p)
Al,PROP(FF~,l1~,al~,q~,l2~,be~,k~)=FF(l1,al,l2,be,k)
B i,Pi

Id,qu(al~)=k(al)+pp(al)
Al,quDqu=2*kDpp
Al,Dotpr,qu(al~)=k(al)+pp(al)
Al,Even,NOM,1

C By definition:
  Extm = 1/{1 + (2*kDpp + kDk + ppDpp)/m^2}
       = 1/{1 + 2*(kDpp - M^2)/m^2}
  This makes the principal behaviour explicit.

Id,NOM(qu,m)= Extm/m^2
Al,NOM(q0,M~)= 1/M^2

Id,NOM(qu,M)=-1/u
Al,Even,NOM,1
Id,kpDkp=0
Al,kp(al~)=-k(al)-p(al)-pp(al)
Al,Dotpr,kp(al~)=-k(al)-p(al)-pp(al)
Id,kDk=0
Al,pDp=0
Al,ppDpp=0
Id,pDk=-0.5*s
Al,pDpp=-0.5*t
Al,kDpp=-0.5*u

ETE1{}
Id,Count,0,m,1,m2,2,[m2-M2],2
*yep

Id,Count,x,m,1,m2,2,[m2-M2],2
IF x
Id,x^n1~*[m2-M2]^n~=x^n1*m2^n*DS(K,0,n1/2+n+1,(DB(-n+K-1,K)*M2^K*m2^-K))
Id,x^n1~*Extm^n~=DS(K,0,n1/2+1,(DB(n+K-1,K)*(-2*kDpp/m^2)^K))
ELSE
Id,[m2-M2]^n~=m2^n
Al,Extm=1
ENDIF
Id,M2^n~=M^(2*n)
Al,m2^n~=m^(2*n)
Al,kDpp=-0.5*u
Id,t=-s-u
Id,Count,0,m,1
Al,x=1

Id,Count,4,s,2,t,2,u,2
Al,R5("W,"W)=R5W
Al,R5("Z,"Z)=R5Z
*yep

Id,Epfred

Id,t=-s-u

Keep RenWW4,RenWWr
*next
B i,Pi,N_,M

Z RenWWt=RenWW4
  + RenWWr(a,b,c,d,s,t,u) + RenWWr(a,c,b,d,u,t,s) + RenWWr(a,b,d,c,s,u,t)

C Id,R5W=1
  Al,R3=1

IF D(a,c)
Id,t=-s-u
ENDIF
IF D(a,b)
Id,u=-s-t
ENDIF
IF D(a,d)
Id,s=-t-u
ENDIF

*yep
Id,T1=1
Al,T2=1
Al,T3=1
Al,R5Z=1
Al,R5W=1
Al,R3=1
Keep RenWWt
*next
P input
C Renormalized WWWW (all longitudinal) amplitude.

Z RenW = WTot - RenWWt

B i,Pi,N_,M2,M
Id,Multi,M2^n~=M^(2*n)
Al,Logm2=Log(m2)
Id,Log(s)=Log(s,m2)+Log(m2)
Al,Log(t)=Log(t,m2)+Log(m2)
Al,Log(u)=Log(u,m2)+Log(m2)

P output
*yep
C Specialize, for computimg purposes, to index a=b, c=d, a not c.

IF NOT D(a,b)=1
Id,Addfa,0
ENDIF
Id,D(c,d)=1

*end

C WW-scattering 15. Verification of part of WW scattering calculation.
  Uses output from 11.

C Cross.e: demonstrates that the part labelled with 'Error' in file
  BoxWW1 is zero.
  This requires addition of the crossed pieces and working out of the
  three point functions.
  The block CCCP contains expressions for the C-functions as needed
  for the purposes here. Block CCC is somewhat more detailed.

P ninput

Enter BoxWW1

BLOCK CCC{}

Id,C11(t~) =  + 2*i*N_^-1*Pi^2*t^-1 + i*Pi^2*LogM2*t^-1 + i*Pi^2*
 [Pi/Sqrt(3)-2]*t^-1 - CC0(t)
 
 + B0(t,M,M)
  * ( t^-1 )
 
Al,C12(t~) =  - 2*i*N_^-1*Pi^2*t^-1 - i*Pi^2*LogM2*t^-1 - i*Pi^2*
 [Pi/Sqrt(3)-2]*t^-1
 
 + B0(t,M,M) * ( - t^-1 )
 
Al,C24(t~) =  + 1/4*i*Pi^2 - 1/2*M^2*CC0(t) + 1/4*B0(t,M,M)

Al,C21(t~) =  - 3*i*N_^-1*Pi^2*t^-1 - 3/2*i*Pi^2*LogM2*t^-1 - 3/2*i*Pi^2*
 [Pi/Sqrt(3)-2]*t^-1 + CC0(t)
 
 + B0(t,M,M)
  * ( - 3/2*t^-1 )
 
Al,C23(t~) = 
  + 2*i*N_^-1*Pi^2*t^-1 + i*Pi^2*LogM2*t^-1 + i*Pi^2*
 [Pi/Sqrt(3)-2]*t^-1 + 1/2*i*Pi^2*t^-1 - M^2*t^-1*CC0(t)
 
 + B0(t,M,M)
  * ( t^-1 )
 
Al,C22(t~) =  + i*N_^-1*Pi^2*t^-1 + 1/2*i*Pi^2*LogM2*t^-1 + 1/2*i*Pi^2*
 [Pi/Sqrt(3)-2]*t^-1
 
 + B0(t,M,M)
  * ( 1/2*t^-1 )

Id,B0(u~,M~,M~)= - 2*i*Pi^2/N_ - i*Pi^2*Log(u) + 2*i*Pi^2

ENDBLOCK


BLOCK CCCP{}
C BB0 and BB1 are the two-point functions for equal mass with
  also pDp = - M^2.

Id,C11(t~) =  - t^-1*BB0 - CC0(t) + B0(t,M,M) * ( t^-1 )
 
Al,C12(t~) =  t^-1*BB0 + B0(t,M,M) * ( - t^-1 )

Al,C24(t~) =  1/4*i*Pi^2 - 1/2*M^2*CC0(t) + 1/4*B0(t,M,M)

Al,C21(t~) =  t^-1*BB0 - t^-1*BB1 + CC0(t) + B0(t,M,M) * ( - 3/2*t^-1 )

Al,C23(t~) =  1/2*i*Pi^2*t^-1 - M^2*t^-1*CC0(t) - t^-1*BB0
 + B0(t,M,M) * ( t^-1 )

Al,C22(t~) =  t^-1*BB1 + B0(t,M,M) * ( 1/2*t^-1 )

Id,BB1 = -0.5*BB0

ENDBLOCK

*fix

F Fq,CC0,C11,C12,C21,C22,C23,C24

Names BoxWW
P stats

Z BoxW(a,k,b,p,c,pp,d,kp,s,t,u,q1,q2,q3,q4) =
 BoxWW(a,al,k,b,be,p,c,ga,pp,d,de,kp)

IF NOT Error=1
Id,Addfa,0
ENDIF

Id,ExtM=1

Keep BoxW
*next

Z Box=
    BoxW(a,k,b,p,c,pp,d,kp,s,t,u,q1,q2,q3,q4)
  + BoxW(a,k,c,pp,b,p,d,kp,u,t,s,q6,q2,q3,q5)
  + BoxW(a,k,b,p,d,kp,c,pp,s,u,t,q1,q4,q3,q2)
*yep

IF Adiso,NOM(q,M)*NOM(q1,M)*NOM(q3,M)=Three(k,p,s)
Al,Dotpr,q(al~)=q(al)+k(al)
ENDIF

Id,Adiso,NOM(q,M)*NOM(q1,M)*NOM(q2,M)=Three(p,pp,t)

Id,Adiso,NOM(q,M)*NOM(q1,M)*NOM(q4,M)=Three(p,kp,u)

IF Adiso,NOM(q,M)*NOM(q2,M)*NOM(q3,M)=Three(k,kp,t)
Al,Dotpr,q(al~)=-q(al)
ENDIF

IF Adiso,NOM(q,M)*NOM(q3,M)*NOM(q4,M)=Three(k,pp,u)
Al,Dotpr,q(al~)=-q(al)
ENDIF

IF Adiso,NOM(q1,M)*NOM(q2,M)*NOM(q3,M)=Three(pp,kp,s)
Al,Dotpr,q(al~)=q(al)-p(al)
ENDIF

IF Adiso,NOM(q,M)*NOM(q3,M)*NOM(q5,M)=Three(k,p,s)
Al,Dotpr,q(al~)=-q(al)
ENDIF

Id,Adiso,NOM(q,M)*NOM(q6,M)*NOM(q2,M)=Three(pp,p,t)

IF Adiso,NOM(q,M)*NOM(q6,M)*NOM(q3,M)=Three(k,pp,u)
Al,Dotpr,q(al~)=q(al)+k(al)
ENDIF

Id,Adiso,NOM(q,M)*NOM(q6,M)*NOM(q5,M)=Three(pp,kp,s)

IF Adiso,NOM(q1,M)*NOM(q3,M)*NOM(q4,M)=Three(kp,pp,s)
Al,Dotpr,q(al~)=q(al)-p(al)
ENDIF

IF Adiso,NOM(q6,M)*NOM(q3,M)*NOM(q2,M)=Three(p,kp,u)
Al,Dotpr,q(al~)=q(al)-pp(al)
ENDIF

Id,Dotpr,kp(al~)=-k(al)-p(al)-pp(al)
B i,Pi,M

C IF NOT D(a,b)
  Id,Addfa,0
  ENDIF

P output
*yep

C Id,Three(p~,k~,t~)=Three(p,k,t)*Fxx(p,k,t)

Id,All,q,N,Fq
Id,Adiso,Three(p~,k~,t~)*Fq(al~,be~)=
 p(al)*p(be)*C21(t) + k(al)*k(be)*C22(t)
 + (p(al)*k(be)+k(al)*p(be))*C23(t) + D(al,be)*C24(t)
Al,Adiso,Three(p~,k~,t~)*Fq(al~)=p(al)*C11(t) + k(al)*C12(t)
Al,Three(p~,k~,t~)=CC0(t)
Id,pDp=0
Al,kDk=0
Al,ppDpp=0
Al,kpDkp=0
Id,Dotpr,kp(al~)=-k(al)-p(al)-pp(al)
Id,pDp=0
Al,kDk=0
Al,ppDpp=0
Al,kpDkp=0
Id,pDpp=-pDk-kDpp
P output
*yep

Id,A0=1
Al,A1=1
Al,A2=1
Al,R1=1
Al,R2=1
P output
*yep

CCCP{}
*end

C WW-scattering 16. Infinities and Log's of irreducible 4-point W function.

C One loop diagrams.
  Four point function: WW scattering.
  Ln(m^2) and infinities.
  Notation: N_ = n-4, m = Higgs mass, Log(m) = Ln(m^2).

  Separate results: 'Long', containing partial result for longitudinal
  W's, crossed contributions not yet added. 'Tot' includes crossed
  pieces.

P ninput

I al=N,be=N,la=N,de=N,ga=N,la=N

Read WWb.e

ASSIGN{}

VERT{}

*fix

V q1,q2,q3,q4,q0
I m1=N,m0=N,m3=N,m4=N,m5=N,m6=N,m7=N,m8=N
I a=3,b=3,c=3,d=3,e=3,f=3,g=3,h=3,j=3
A N,N_
F Ph,Pw,Fq

Z BoxWW(a,al,k,b,be,p,c,ga,pp,d,de,kp) =
    VIER("W,a,al,k,"W,b,be,p,"W,c,ga,-pp,"W,d,de,-kp)

C  + VIER("W,a,al,k,"W,c,ga,-pp,"W,b,be,p,"W,d,de,-kp)
   + VIER("W,a,al,k,"W,b,be,p,"W,d,de,-kp,"W,c,ga,-pp)

Id,VIER(K1~,a~,al~,k~,K2~,b~,be~,p~,K3~,c~,ga~,pp~,K4~,d~,de~,kp~)=
   + DS(K1;J4;-J1;TAP,(
     DS(K2;J1;-J2;TAP,(
     DS(K3;J2;-J3;TAP,(
    A0*VIE(K1,a,al,k,K2,b,be,p,K3,c,ga,pp,K4,d,de,kp,J1,J2,J3,J4)
     * DC("F,TFE,-1,J1,J2,J3,J4) ))) )))

    + DS(K1;K3;J7;-J5;TAP,(
     DS(K2;J5;-J6;TAP,(DC("F,TFE,-1,J5,J6,J7)*
    A1*VIE1(K1,a,al,k,K2,b,be,p,K3,c,ga,pp,K4,d,de,kp,J5,J6,J7) )) ))

   + DS(K2;K4;J8;-J9;TAP,(
     DS(K1;JA;-J8;TAP,(DC("F,TFE,-1,J8,J9,JA)*
   A2*VIE2(K1,a,al,k,K2,b,be,p,K3,c,ga,pp,K4,d,de,kp,J8,J9,JA) )) ))

   + DS(K1;K3;J0;-JB;Sym;J0;-JB;TAP,(DC("F,TFE,-1,J0,JB)*
    A3*VIE3(K1,a,al,k,K2,b,be,p,K3,c,ga,pp,K4,d,de,kp,JB,J0) ) )


Id,Anti,TAP

Id, VIE(K1~,a~,al~,k~,K2~,b~,be~,p~,
	K3~,c~,ga~,pp~,K4~,d~,de~,kp~,J1~,J2~,J3~,J4~)=
   VE3(K1,J4,-J1,*,a,al,k,*,l8,m8,q3,*,l1,m1,-q)*
   VE3(K2,J1,-J2,*,b,be,p,*,l2,m0,q,*,l3,m3,-q1)*
   VE3(K3,J2,-J3,*,c,ga,pp,*,l4,m4,q1,*,l5,m5,-q2)*
   VE3(K4,J3,-J4,*,d,de,kp,*,l6,m6,q2,*,l7,m7,-q3)*
   PROP(J1,-J1,*,l1,m1,q,*,l2,m0,-q)*
   PROP(J2,-J2,*,l3,m3,q1,*,l4,m4,-q1)*
   PROP(J3,-J3,*,l5,m5,q2,*,l6,m6,-q2)*
   PROP(J4,-J4,*,l7,m7,q3,*,l8,m8,-q3)

Al,VIE1(K1~,a~,al~,k~,K2~,b~,be~,p~,
	K3~,c~,ga~,pp~,K4~,d~,de~,kp~,J1~,J2~,J3~)=
   VE4(K1,K3,J3,-J1,*,a,al,k,*,c,ga,pp,*,l6,m6,q4,*,l1,m1,-q)*
   VE3(K2,J1,-J2,*,b,be,p,*,l2,m0,q,*,l3,m3,-q1)*
   VE3(K4,J2,-J3,*,d,de,kp,*,l4,m4,q1,*,l5,m5,-q4)*
   PROP(J1,-J1,*,l1,m1,q,*,l2,m0,-q)*
   PROP(J2,-J2,*,l3,m3,q1,*,l4,m4,-q1)*
   PROP(J3,-J3,*,l5,m5,q4,*,l6,m6,-q4)

Al,VIE2(K1~,a~,al~,k~,K2~,b~,be~,p~,
	K3~,c~,ga~,pp~,K4~,d~,de~,kp~,J1~,J2~,J3~)=
   VE4(K2,K4,J1,-J2,*,b,be,p,*,d,de,kp,*,l2,m0,q,*,l3,m3,-q4)*
   VE3(K1,J3,-J1,*,a,al,k,*,l6,m6,q3,*,l1,m1,-q)*
   VE3(K3,J2,-J3,*,c,ga,pp,*,l4,m4,q4,*,l5,m5,-q3)*
   PROP(J1,-J1,*,l1,m1,q,*,l2,m0,-q)*
   PROP(J2,-J2,*,l3,m3,q4,*,l4,m4,-q4)*
   PROP(J3,-J3,*,l5,m5,q3,*,l6,m6,-q3)

Al,VIE3(K1~,a~,al~,k~,K2~,b~,be~,p~,
	K3~,c~,ga~,pp~,K4~,d~,de~,kp~,J1~,J2~)=
   VE4(K1,K3,J2,-J1,*,a,al,k,*,c,ga,pp,*,l4,m4,q4,*,l1,m1,-q)*
   VE4(K2,K4,J1,-J2,*,b,be,p,*,d,de,kp,*,l2,m0,q,*,l3,m3,-q4)*
   PROP(J1,-J1,*,l1,m1,q,*,l2,m0,-q)*
   PROP(J2,-J2,*,l3,m3,q4,*,l4,m4,-q4)

Id,Compo,<X>,VE4,VE3,PROP
Id,Stats
Id,VE4(FF~,l1~,al~,k~,l2~,be~,p~,l3~,ga~,pp~,l4~,la~,kp~)=
 FF(l1,al,k,l2,be,p,l3,ga,pp,l4,la,kp)
Al,VE3(FF~,l1~,al~,k~,l2~,be~,q~,l3~,ga~,p~)=
       FF(l1,al,k,l2,be,q,l3,ga,p)
Al,PROP(FF~,l1~,al~,q~,l2~,be~,k~)=FF(l1,al,l2,be,k)

Id,Count,-4,NOM,-2,q,1,q1,1,q2,1,q3,1,q4,1

C Only divergent pieces.

Id,q1(al~)=q(al)
Al,Dotpr,q1(al~)=q(al)
Id,q2(al~)=q(al)
Al,Dotpr,q2(al~)=q(al)
Id,q3(al~)=q(al)
Al,Dotpr,q3(al~)=q(al)
Id,q4(al~)=q(al)
Al,Dotpr,q4(al~)=q(al)
Id,k(al)=0
Al,p(be)=0
Al,pp(ga)=0
Al,kp(de)=0
Id,pDp=-M^2
Al,kDk=-M^2
Al,ppDpp=-M^2
Al,kpDkp=-M^2

Id,Count,-4,q,1,NOM,-2
Al,Even,NOM,1
Id,NOM(q~,M)=Nom
Al,NOM(q~,m)=Nohm
B Nom,Nohm
Id,Epfred
*yep

IF Nohm^n~*Nom^l~=1/q2M^l/q2m^n
Id,2,Ratio,q2M,q2m,[m2-M2]
Id,q2M^n~=1/Nom^n
Al,q2m^n~=1/Nohm^n
ENDIF

Id,All,q,N,Fq

Id,Fq(al~)=0
Al,Fq(al~,be~,ga~)=0
Al,Fq(al~,be~,ga~,de~,la~)=0
Al,Fq(al~,be~,ga~,de~,la~,a~,b~)=0
Id,Fq(al~,be~,ga~,de~)*Nom^l~ = dede(al,be,ga,de)*H(l,M2)
Al,Fq(al~,be~)*Nom^l~ = D(al,be)*G(l,M2)
Al,Nom^n~ = F(n,M2)
Id,Fq(al~,be~,ga~,de~)*Nohm^l~ = dede(al,be,ga,de)*H(l,m2)
Al,Fq(al~,be~)*Nohm^l~ = D(al,be)*G(l,m2)
Al,Nohm^l~ = F(l,m2)

STINT{}

Id,Count,0,m,1,m2,2,[m2-M2],2
Id,[m2-M2]^n~=m2^n

Id,M2^n~=M^(2*n)
Al,m2^n~=m^(2*n)
Id,N=N_+4
Id,N_=0

Id,Count,1,N_,-1,Log,1
Id,Log(M2)=0
Al,Log(m2)=Logm2

B i,Pi,M,N_
Keep BoxWW

*next

C Longitudinal, u-channel.

Z Long(a,k,b,p,c,pp,d,kp)
 = BoxWW(a,k,k,b,p,p,c,pp,pp,d,kp,kp)/M^4

Id,kpDkp=0
Al,kp(al~)=-k(al)-p(al)-pp(al)
Al,Dotpr,kp(al~)=-k(al)-p(al)-pp(al)

Id,pDp=0
Al,kDk=0
Al,ppDpp=0
Id,pDk= - 0.5*s
Al,pDpp = - 0.5*t
Al,kDpp = - 0.5*u
B i,Pi,M,N_
Id,t=-s-u
Keep BoxWW
*next

P input
C The calculation sofar needs addition of further diagrams, obtained
  by crossing. Also add counterterms.

Z Total(a,al,k,b,be,p,c,ga,pp,d,de,kp)
 = BoxWW(a,al,k,b,be,p,c,ga,pp,d,de,kp)
 + BoxWW(a,al,k,c,ga,pp,b,be,p,d,de,kp)
 + BoxWW(a,al,k,b,be,p,d,de,kp,c,ga,pp)
 + DLP*WWWW(a,al,k,b,be,p,c,ga,pp,d,de,kp)*WWWWK

B i,Pi

Id,A0=1
Al,A1=1
Al,A2=1
Al,A3=1

Id,Epfred
ETE1{}
P output
*yep
C Id,DLP=-1
Keep Total
*next
C Longitudinal, full result.

Z Tot = Total(a,k,k,b,p,p,c,pp,pp,d,kp,kp)/M^4
Id,kpDkp=0
Al,kp(al~)=-k(al)-p(al)-pp(al)
Al,Dotpr,kp(al~)=-k(al)-p(al)-pp(al)

Id,pDp=0
Al,kDk=0
Al,ppDpp=0
Id,pDk= - 0.5*s
Al,pDpp = - 0.5*t
Al,kDpp = - 0.5*u
B i,Pi,M,N_
IF D(a,c)
Id,t=-s-u
ENDIF
IF D(a,b)
Id,u=-s-t
ENDIF
IF D(a,d)
Id,s=-t-u
ENDIF
P output
*yep
Id,DLP=-1
*end