C Varia 1. F-G series.
C Varia 2. Two-point function, coefficients of F(N).
C Varia 3. Table test.
C Varia 4. Test of Tables, character-number facility.
C Varia 5. Calculation of two-component Riemann tensor from metric.
C Varia 6. Calculation of Riemann tensors from metric.
C Varia 7. Lagrangian for SU(5) once broken to SU(3)*SU(2)*U(1).
C Varia 8. Lagrangian for SU(5) twice broken to SU(3)*U(1).
*end

C Varia 1. F-G series.

  P. Sconzo, A. Le Schack and R. Tobey, The Astronomical Journal 70(1965)269.

C Calculate up to and including F(25), G(25).

C Running time:
C		CRDS	 	32 secs, without cache 50 sec.
C		HP PC		257 secs. (run from floppy)
C		Torch    	47 secs.
C		Atari ST 	41 secs. (run from ram disk)
C		Sun 3/60	15 secs.
C		Amiga 2000	52 secs. (run from ram disk)
C		Amiga 3000	11 secs.
C		Mac II	 	12 secs.
C		NeXT		 3 secs.

BLOCK Subs{}
Id,mu**n~*Diff=Diff*mu**n + n*mup*mu**(n-1)
Id,si**n~*Diff=Diff*si**n + n*sip*si**(n-1)
Id,ep**n~*Diff=Diff*ep**n + n*epp*ep**(n-1)
Id,Diff=0
Id,mup=-3*mu*si
Al,epp=-si*(mu+2*ep)
Al,sip=ep-2*si**2
ENDBLOCK

F Diff
S mu,ep,si,mup,epp,sip
I K,N
Z FF(0)=1
Z FG(0)=0
Keep FF,FG
*next
DO L1=1,25
Z FF('L1')=FF('L1'-1)*Diff - mu*FG('L1'-1)
Z FG('L1')=FF('L1'-1) + FG('L1'-1)*Diff
Subs{}
Keep FF('L1'),FG('L1')
*next
ENDDO
*end

C Varia 2. Two-point function, coefficients of F(N).

P stat
C  COEFFICIENTS OF  F(N) FOR USE WITH THE TWO-POINT FUNCTION.
N  13,R0
X  C(N)=1./N
X  EX(N,Y)=DS(J,1,16,(N**J*Y**J),(J**-1)) + 1
Z  F1=DS(J,1,16,(X**J*C(1+J)))
Z  F2=DS(J,1,16,(X**J*C(2+J)))
Z  F3=DS(J,1,16,(X**J*C(3+J)))
Z  F4=DS(J,1,16,(X**J*C(4+J)))
Z  F5=DS(J,1,16,(X**J*C(5+J)))
Z  F6=DS(J,1,16,(X**J*C(6+J)))
Z  F7=DS(J,1,16,(X**J*C(7+J)))
Z  F8=DS(J,1,16,(X**J*C(8+J)))
Id  X**N~=1-DS(J,1,N,(DB(N,J)*Z**J),(-1))
*yep
Id  Z**N~ = EX(N,Y)
*end

C Varia 3. Table test.

T A(K1)=(A1_A2**2),A3,"F,"Z
T B(K1)=0,1,-1,2,-2

Z XX=0.1*F2(A(1),A(2))
    +0.2*F3(A(3),A(4))
    +C1*DC(1,2,3) + 2*C2*DC(1,2,-3)
    +3*C3*DC(B(2),B(2),B(5)) + 4*C4*DC(B(2),B(2),B(4))
    +5*C5*DC(B(1),B(2),B(3),B(1)) + 6*C6*DC(B(2),B(3),B(2),B(3))
    +7*C7*DC(B(2),B(3),B(2),B(1))
Id,F2(X~,Y~)=B1*X+B2*Y
*begin
B D1,D2,D3,D4
S A1=c,A2=c,A3=c,A4=c
T A(K)=Conjg(A1+A2),-Conjg(A3+A4),Integ(5+7),-Integ(5+7)

Z X=F1(A(1),A(2),-A(1),-A(2),A(3),A(4),-A(3),-A(4))

Id,F1(B1~,B2~,B3~,B4~,B5~,B6~,B7~,B8~)=
   F2(B5,B6,B7,B8)+11*D1*B1+12*D2*B2+13*D3*B3+14*D4*B4
*next
T T0(K1)=A7,-4
T T1(K1)=4,2,T0,5
T T2(K1)=A1,A2,A3,A4,-A5
Z xx=F1(B1,-T2(T1(-T1(3,2))),B2)
Id,F1(C1~,C2~,C3~)=11*C1*D1+12*C2*D2+13*C3*D3
*begin
S A1=c,A2=c,A3=c,A4=c,B1,B2,B3,B4,B5,B6,FA1,FA2,FA3
B BR,BR1,BR2,BR3,BR4
D TIC(K)=C1,C2,C3,C4,C5,C6,C7,C8
T TE(K1)=A1,A2
T TC(K1,B1,B2,B3,B4,TE)=A1,A2,(BR3*(B1-B2)+BR4*(B3-B4))
T TB(K1,K2,B1,B2,B3,B4,TE)=A1,TC
T TA(K1,K2,K3,B1,B2,B3,B4,TE)=((B1+B2)*BR1),((B1-B2)*BR2)
  ,((B3+B4)*BR3),((B3-B4)*BR4),TE

Z XX=DS(J1,4,8,(F1(A1,A2,A3,A4,-J1,3)*BR**J1*TIC(J1)))

Id,F1(B1~,B2~,B3~,B4~,B5~,B6~)=
   F3(Conjg(B1+B2),-Conjg(B1+B2),
       TA(-Integ(B5+B6),2,3,Conjg(B3+B4),-Conjg(B3+B4),
              Integ(B5-B6),-Integ(B5-B6),TB))
Id,F3(B1~,B2~,B3~)=FA1*B1+FA2*B2+FA3*B3
*end

C Varia 4. Test of Tables, character-number facility.

P brackets
T TT(n)=1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,
	21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,
	38,39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54,55,56
T ALF(N)="A,"B,"C,"D,"E,"F,"G,"H,"I,"J,"K,"L,"M,"N,"O,"P,"Q,
	"R,"S,"T,"U,"V,"W,"X,"Y,"Z,
	"a,"b,"c,"d,"e,"f,"g,"h,"i,"j,"k,"l,"m,"n,"o,"p,"q,
	"r,"s,"t,"u,"v,"w,"x,"y,"z

Z xx=DS{J1,1,52,(f1(ALF(J1)))}

Id,f1(a1~)=f2(TT(a1))*f0(a1)
Id,f2(n1~)=a2**n1
*end

C Varia 5. Calculation of two-component Riemann tensor from metric.

C Calculation of components of Rieman tensor from
C a given form for the metric tensor g(mu,nu).
C That form was:
C
C			a k l 0
C			k b m 0
C	g(mu,nu) =	l m c 0
C			0 0 0 e


P lists
P stats

S Det,a,b,c,e,k,l,m

V ap,bp,cp,ep,kp,lp,mp

X zero(n,j) = 1 - DK(n,j)

BLOCK GGX{x,n,y}
D gg'x'('n') = a'y',k'y',l'y',0,
	k'y',b'y',m'y',0,
	l'y',m'y',c'y',0,
	0,0,0,e'y'
ENDBLOCK

C***** The metric tensor g(mu,nu) :

GGX{,n}

C***** The first derivative of g(mu,nu), i.e. d/dx(n) g(mu,nu) :

GGX{d,{n1,n},p(n)}

C***** The second derivative d^2/dx(n)/dx(j) g(mu,nu) :

GGX{dd,{n1,n,j},{pp(n,j)}}

D ggi(n) =	(b*c - m**2),(l*m - k*c),(k*m - l*b),0,
		(l*m - k*c),(a*c - l^2),(k*l - a*m),0,
		(k*m - l*b),(k*l - a*m),(a*b - k^2),0,
		0,0,0,(2*k*l*m + a*b*c - a*m^2 - c*k^2 - b*l^2)/e

X tg(j,n) = gg(j*4+n+1)

X tgi(j,n)=ggi(j*4+n+1)*e

X tgd(n,j,j1) = ggd(n*4+j+1,j1)

X tgdd(n,j,j1,j2) = DT(j2-j1)*ggdd(n*4+j+1,j1,j2) +
	DT(j1-j2-1)*ggdd(n*4+j+1,j2,j1)

C***** The Christoffel symbol:

X chr(n1,n2,n3) = 0.5*tgd(n3,n1,n2) + 0.5*tgd(n3,n2,n1)
	- 0.5*tgd(n1,n2,n3)

C***** The derivative of the Christoffel symbol:

X chd(n1,n2,n3,n4) = 0.5*tgdd(n3,n1,n2,n4) + 0.5*tgdd(n3,n2,n1,n4)
	- 0.5*tgdd(n1,n2,n3,n4)

C***** Gamma in terms of the Christoffel symbol:

X ga(n1,n2,n3) = DS{n4,0,3,{tgi(n3,n4)*chr(n1,n2,n4) } }

C***** The Riemann tensor:

X Rt4(n1,n2,n3,n4) = Det*chd(n2,n4,n1,n3) - Det*chd(n2,n3,n1,n4)
	+ DS{n5,0,3,{	chr(n2,n3,n5)*ga(n1,n4,n5) -
			chr(n2,n4,n5)*ga(n1,n3,n5) } }

C***** This the the two-index Riemann tensor:

X Rt2(n1,n2) = DS{n3,0,3,{zero(n3,n1)*
	DS{n4,0,3,{zero(n4,n2)*tgi(n3,n4)*Rt4(n3,n1,n4,n2)} } } }

*fix

B e,Det,a

C***** Now calculate some component, here Rt2(0,0) :

Z R00 = Rt2(0,0)

*begin

B e,Det,a

Z R01 = Rt2(0,1)

*end

C Varia 6. Calculation of Riemann tensors from metric.
C Calculation of components of Rieman tensors from
C a given form for the metric tensor g(mu,nu).
C That form was:
C
C			a k l 0
C			k b m 0
C	g(mu,nu) =	l m c 0
C			0 0 0 e


P lists
P stats

S Det,a,b,c,e,k,l,m

V ap,bp,cp,ep,kp,lp,mp

X zero(n,j) = 1 - DK(n,j)

C The metric tensor is given further down. The inverse was calculated
C by hand and follows here as a one dimensional array:

D ggi(n) =	(b*c - m**2),(l*m - k*c),(k*m - l*b),0,
		(l*m - k*c),(a*c - l^2),(k*l - a*m),0,
		(k*m - l*b),(k*l - a*m),(a*b - k^2),0,
		0,0,0,(2*k*l*m + a*b*c - a*m^2 - c*k^2 - b*l^2)/e

C This is the two-dimensional form of ggi:

X tgi(j,n)=ggi(j*4+n+1)*e

X R5(n1,n2,n3,n4) = zero(n1,n2)*zero(n3,n4)*
	{ DT(n4-n3)*R6(n1,n2,n3,n4) - DT(n3-n4)*R6(n1,n2,n4,n3) }

X R4(n1,n2,n3,n4) = DT(n4-n2)*R5(n1,n2,n3,n4)
	- DT(n2-n4-1)*{ R5(n1,n4,n2,n3) + R5(n1,n3,n4,n2) }

X R3(n1,n2,n3,n4) = DT(n3-n1)*R4(n1,n2,n3,n4)
	+ DT(n1-n3-1)*R4(n3,n4,n1,n2)

X R2(n1,n2,n3,n4) = DT(n4-n3)*R3(n1,n2,n3,n4)
	- DT(n3-n4)*R3(n1,n2,n4,n3)

X R1(n1,n2,n3,n4) = zero(n1,n2)*zero(n3,n4)*
	{ DT(n2-n1)*R2(n1,n2,n3,n4) - DT(n1-n2)*R2(n2,n1,n3,n4) }

*fix

BLOCK GGX{x,n,y}
D gg'x'('n') = a'y',k'y',l'y',0,
	k'y',b'y',m'y',0,
	l'y',m'y',c'y',0,
	0,0,0,e'y'
ENDBLOCK

C***** The metric tensor g(mu,nu) :

GGX{,n}

C***** The first derivative of g(mu,nu), i.e. d/dx(n) g(mu,nu) :

GGX{d,{n1,n},p(n)}

C***** The second derivative d^2/dx(n)/dx(j) g(mu,nu) :

GGX{dd,{n1,n,j},{pp(n,j)}}

C***** Two component forms:

X tg(j,n) = gg(j*4+n+1)

X tgd(n,j,j1) = ggd(n*4+j+1,j1)

X tgdd(n,j,j1,j2) = DT(j2-j1)*ggdd(n*4+j+1,j1,j2) +
	DT(j1-j2-1)*ggdd(n*4+j+1,j2,j1)

C***** The Christoffel symbol:

X chr(n1,n2,n3) = 0.5*tgd(n3,n1,n2) + 0.5*tgd(n3,n2,n1)
	- 0.5*tgd(n1,n2,n3)

C***** The derivative of the Christoffel symbol:

X chd(n1,n2,n3,n4) = 0.5*tgdd(n3,n1,n2,n4) + 0.5*tgdd(n3,n2,n1,n4)
	- 0.5*tgdd(n1,n2,n3,n4)

C***** Gamma in terms of the Christoffel symbol:

X ga(n1,n2,n3) = DS{n4,0,3,{tgi(n3,n4)*chr(n1,n2,n4) } }

C***** The Riemann tensor:

X Rt4(n1,n2,n3,n4) = Det*chd(n2,n4,n1,n3) - Det*chd(n2,n3,n1,n4)
	+ DS{n5,0,3,{	chr(n2,n3,n5)*ga(n1,n4,n5) -
			chr(n2,n4,n5)*ga(n1,n3,n5) } }

C***** Now compute the components of the Riemann tensor:

BLOCK R{n,n1,n2,n3,n4}
Z Rt('n') = Rt4('n1','n2','n3','n4')
ENDBLOCK
R{18,0,1,0,1}
R{19,0,1,0,2}
R{23,0,1,1,2}
R{35,0,2,0,2}
R{39,0,2,1,2}
R{20,0,1,0,3}
R{24,0,1,1,3}
R{28,0,1,2,3}
R{36,0,2,0,3}
R{40,0,2,1,3}
R{44,0,2,2,3}
R{52,0,3,0,3}
R{56,0,3,1,3}
R{60,0,3,2,3}
R{103,1,2,1,2}
R{104,1,2,1,3}
R{108,1,2,2,3}
R{120,1,3,1,3}
R{124,1,3,2,3}
R{198,2,3,2,3}
Keep Rt
P noutput
*next

B e,Det,a

C***** This the the two-index Riemann tensor:

X Rt2(n1,n2) = DS{n3,0,3,{zero(n3,n1)*
	DS{n4,0,3,{zero(n4,n2)*tgi(n3,n4)*R1(n3,n1,n4,n2)} } } }

C***** Now calculate some component, here Rt2(0,0) :

Z R00 = Rt2(0,0)

*yep

C***** Use the components of the four-index tensor as computed before:

Id,R6(n1~,n2~,n3~,n4~) = Rt(64*n1+16*n2+4*n3+n4+1)

*end

C Varia 7. Lagrangian for SU(5) once broken to SU(3)*SU(2)*U(1).

P error
C PROGRAM WRITTEN BY MARTIN GREEN, AUGUST 1981.
P stat
Oldnew i=I
Common A,DIF,DIFH,CDIFH,DIFHH,F1,F2,DIFZ,DIFZB,Zb,GAUGE,H,HH,F1B,F0,MZ
   ,HSH,HHHH,HH2,LH1,LH2,LH3,LH4,LH5,LH6,LH7,LH8,LH9
F TA
*fix
C RT12=SQRT(1/2) ETC
C GG = GAUGE COUPLING CONSTANT
C UNIT = 3 BY 3 UNIT MATRIX
C UNI=2*2 UNIT MATRIX
C          SUMMATION CONVENTIONS
C LG(MU)=LAMBDA(A)*GL(A,MU)
C TB(MU)=TAU(A)*B(A,MU)
C LDIFF(GL)=LAMBDA(A)*DIFF(GL(A))
C LDIFF(B)=TAU(A)*DIFF(B(A))
B GG
S GG,UNIT,RT12,RT13,RT15,UNI
I MU1,MU2,MU3,MU4,I1=3,I2=3,I3=3,I4=3
V B,B0,GL,XM,XP
F DIFF,LDIFF,LG,MX=c,TB
Oldnew MXC=PX
C DIFFERENTIAL OF A(MU)
Z DIF(MU1,MU2,I1,I2)=-I*RT12*(
   +DIFF(MU1,XM,MU2)*D(I1,1)*D(I2,2)
   +DIFF(MU1,XP,MU2)*D(I1,2)*D(I2,1)
   +(RT12*LDIFF(MU1,GL,MU2)+UNIT*2*RT12*RT13*RT15*DIFF(MU1,B0,MU2))
   *D(I1,1)*D(I2,1)
   +(RT12*LDIFF(MU1,B,MU2)-UNI*3*RT12*RT13*RT15*DIFF(MU1,B0,MU2))
   *D(I1,2)*D(I2,2))
Id RT12**2=1/2

*next
C                                      A(MU)
Z A(MU1,I1,I2)=DIF(MU2,MU1,I1,I2)
Id DIFF(MU1~,XM,MU2~)=MX(MU2)
Al DIFF(MU1~,XP,MU2~)=PX(MU2)
Al LDIFF(MU1~,GL,MU2~)=LG(MU2)
Al LDIFF(MU1~,B,MU2~)=TB(MU2)
Id DIFF(MU1~,B0~,MU2~)=B0(MU2)
*next
C SUMMED COLOUR IN XX IS XP.XM ETC
B GG,I
S FF,MMX,HA,HB,HB0,PHI=c,HXM=c,XX,HXX,XHX,HXHX
Oldnew HXMC=HXP,PHIC=PHIG
F HT,TA,EHBB,HL,HMX=c,LA,FHAGL
Oldnew HMXC=HPX
C          SUMMATION CONVENTIONS
C HM*HP*XMDXP=XM(MU1,I1)*HP(I1)*XP(MU1,I2)*HM(I2)    I.E.  P.M  ETC
S HM=c
Oldnew HMC=HP
X HH1(I1,I2)=HMX*D(I1,1)*D(I2,2)
C                 HIGGS 24
Z HH(I1,I2)=-I*HH1(I1,I2)+I*Conjg(HH1(I2,I1))
   +(HL*RT12+UNIT*(2*HB0*RT12*RT13*RT15+4*RT12*FF/GG/5))*D(I1,1)*D(I2,1)
   +(HT*RT12-UNI*(3*HB0*RT12*RT13*RT15+6*RT12*FF/GG/5))*D(I1,2)*D(I2,2)
C                     HIGGS 5
Z H(I1)=I*HM*D(I1,1)+I*PHI*D(I1,2)
*next
X DIFFH(I1)=I*DIFF(MU1,HM)*D(I1,1)+I*DIFF(MU1,PHI)*D(I1,2)
Z DIFH(I1)=DIFFH(I1)+GG*A(MU1,I1,I2)*H(I2)
Z DIFHH(I1,I2)=GG*A(MU1,I1,I3)*HH(I3,I2)-HH(I1,I3)*A(MU1,I3,I2)*GG
 -I*DIFF(MU1,HXM)*D(I1,1)*D(I2,2)+DIFF(MU1,HXP)*D(I1,2)*D(I2,1)*I
   +(DIFF(MU1,HL)*RT12+UNIT*UNIT* DIFF(MU1,HB0)*2*RT12*RT13*RT15)
            *D(I1,1)*D(I2,1)
   +(DIFF(MU1,HT)*RT12-UNI*UNI*3*DIFF(MU1,HB0)*RT12*RT13*RT15)
   *D(I1,2)*D(I2,2)
Id UNIT**N~=UNIT**N/UNIT
Al UNI**N~=UNI**N/UNI
Al,Multi,RT12**2=1/2
Al RT13**2=1/3
Al RT15**2=1/5
Id HL*LG(MU1)=LG(MU1)*HL+2*I*FHAGL*LA
Al HT*TB(MU1)=TB(MU1)*HT+2*I*EHBB*TA
Id HL=HA*LA
Al HT=HB*TA
Al LG(MU1)=GL(MU1)*LA
Al TB(MU1)=B(MU1)*TA
Al DIFF(MU1,HL)=DIFF(MU1,HA)*LA
Al DIFF(MU1,HT)=DIFF(MU1,HB)*TA
*next
B GG
Z CDIFH(I1)=Conjg(DIFH(I1))
*next
B GG,I,FF
Z Z=-CDIFH(I1)*DIFH(I1)
   -DIFHH(I1,I2)*DIFHH(I2,I1)/2
   -FF      *(DIFF(XP,HXM)+DIFF(XM,HXP))
C PART OF GAUGE FIXING TERM
Id UNIT**2=3
Al UNI**2=2
Al RT13**2=1/3
Al RT15**2=1/5
Al,Multi,RT12**2=1/2
Id UNIT=1
Al UNI=1
Al,Ainbe,LA*LA=2
Al,Ainbe,TA*TA=2
Id LA=0
Al TA=0
*yep
Id MX(MU1)*HPX*MX(MU1)*HPX=HXX**2
Al MX(MU1)*HPX*HMX*PX(MU1)=HXHX*XX
Al PX(MU1)*HMX*PX(MU1)*HMX=XHX**2
Al PX(MU1)*HMX*HPX*MX(MU1)=XHX*HXX
Al HMX*PX(MU1)*MX(MU1)*HPX=XX*HXHX
Al HMX*PX(MU1)*HMX*PX(MU1)=XHX**2
Al HPX*MX(MU1)*PX(MU1)*HMX=HXX*XHX
Al HPX*MX(MU1)*HPX*MX(MU1)=HXX**2
*yep
Id MX(MU1~)=XM(MU1)
Al PX(MU1~)=XP(MU1)
Al HMX=HXM
Al HPX=HXP
Id,Commu,DIFF
Print STAT
P output
C HIGGS KINETIC TERM
*next
F ZXM=c,ZXP=c,ZA=c,ZB=c,ZB0=c
Oldnew ZXMC=ZXMG,ZXPC=ZXPG,ZAC=ZAG,ZBC=ZBG,ZB0C=ZB0G
C     DIFFERENTIAL OF F.P. GHOST MULTIPLET
Z DIFZ(I1,I2)=
       D(I1,1)*D(I2,2)*DIFF(MU1,ZXM)
   +D(I1,2)*D(I2,1)*DIFF(MU1,ZXP)
   +D(I1,1)*D(I2,1)*(RT12*LA*DIFF(MU1,ZA)+UNIT*2*RT12*RT13*RT15*DIFF(MU1
   ,ZB0))
   +D(I1,2)*D(I2,2)*(RT12*TA*DIFF(MU1,ZB)-UNI*3*RT12*RT13*RT15*DIFF(MU1,
   ZB0))
*next
Z DIFZB(I1,I2)=Conjg(DIFZ(I2,I1))
Z HH(I1,I2)=HH(I1,I2)
Id HMX=HXM
Al HPX=HXP
*next
C          GHOST MULTIPLET
Z GAUGE(I1,I2)=DIFZ(I1,I2)
Z Zb(I1,I2)=DIFZB(I1,I2)
Id DIFF(MU1,ZB0~)=ZB0
*next
B GG,I
F FZAHA,FZAGL,EZBHB,EZBB
C          SUMMATION CONVENTIONS
C FZAHA=F(A,B,C)*ZA(B)*HA(C)
C EZBB=Epf(A,B,C)*ZB(B)*B(C)
C   ETC
Z F0(I1,I2)=GAUGE(I1,I3)*A(MU1,I3,I2)-A(MU1,I1,I3)*GAUGE(I3,I2)
Z F2(I1,I2)=-I*GG*RT12*(GAUGE(I1,I3)*HH(I3,I2)-HH(I1,I3)*GAUGE(I3,I2))
Id LA*ZA*HL=HL*LA*ZA+2*I*FZAHA*LA
Al TA*ZB*HT=HT*TA*ZB+2*I*EZBHB*TA
Al LA*ZA*LG(MU1)=LG(MU1)*LA*ZA+2*I*LA*FZAGL(MU1)
Al TA*ZB*TB(MU1)=TB(MU1)*TA*ZB+2*I*TA*EZBB(MU1)
Al,Multi,RT12**2=1/2
Al UNIT=1
Al UNI=1
Id HL=HA*LA
Al HT=HB*TA
Al LG(MU1)=LA*GL(MU1)
Al TB(MU1)=TA*B(MU1)
*next
B GG,I,FF
Z MZ(I1,I2)=I*FF* (F2(1,2)*D(I1,1)*D(I2,2)-F2(2,1)*D(I1,2)*D(I2,1))
*next
B GG,I,FF
Z LFP1=-DIFZB(I1,I2)*DIFZ(I2,I1)
Z LFP2=DIFZB(I1,I2)*F0(I2,I1)*GG
Z LFP3=Zb(I1,I2)*MZ(I2,I1)
*yep
B GG,I,FF
Id,Ainbe,LA*LA=2
Al,Ainbe,TA*TA=2
Al,UNIT**2=3
Al UNI**2=2
Al MX(MU1)=XM(MU1)
Al PX(MU1)=XP(MU1)
Id LA=0
Al TA=0
Al UNIT=1
Al UNI=1
Al RT13**2=1/3
Al RT15**2=1/5
Al,Multi,RT12**2=1/2
P output
C FADEEV POPOV GHOST LAGRANGIAN
*next
B GG,I,FF
Z HSH=Conjg(H(I1))*H(I1)
Z HHHH=HH(I1,I2)*HH(I2,I1)
Id UNIT**2=3
Al UNI**2=2
Al RT13**2=1/3
Al RT15**2=1/5
Al,Multi,RT12**2=1/2
Al HL*HL=2*HA*HA
Al HT*HT=2*HB*HB
Id UNIT=1
Al UNI=1
Al HL=0
Al HT=0
*next
B GG,I,FF
Z HH2(I1,I2)=HH(I1,I3)*HH(I3,I2)
Id UNIT**N~=UNIT**N/UNIT
Al UNI**N~=UNI**N/UNI
Al,RT13**2=1/3
Al RT15**2=1/5
Al,Multi,RT12**2=1/2
*next
S MM1,MM2
B MM1,MM2,GG,I,FF
Z LH1=-MM1**2*HSH
Z LH2=-MM2**2/2*HHHH
Id GG**-2=0
*next
S MM3,MM4
B MM3,GG,I,FF
C LH3 COLOUR IS HP.LA*HA.HM
C LH3 COLOUR IS PHIG.TA*HB.PHI
Z LH3=-GG*MM3*Conjg(H(I1))*HH(I1,I2)*H(I2)
Id UNIT=1
Al UNI=1
Al HL=LA*HA
Al HT=TA*HB
Al,Multi,RT12**2=1/2
Al GG**-2=0
*next
B MM4,GG,I,FF
Z LH4=-GG*MM4*HH(I1,I2)*HH(I2,I3)*HH(I3,I1)
Id UNIT**3=3
Al UNI**3=2
Al HL*HL*HL=0
Al HT*HT*HT=0
Id UNIT=1
Al UNI=1
Al GG**-2=0
Al HL*HL=2*HA*HA
Al HT*HT=2*HB*HB
Al,Multi,RT12**2=1/2
Al,Multi,RT13**2=1/3
Al,Multi,RT15**2=1/5
Id HL=0
Al HT=0
*next
S LL5,LL6,LL7,LL8,LL9
B LL5,LL6,LL7,GG,I,FF
C LH5 COLOUR IS POWERS OF HP.HM AND PHIG.PHI
C LH6 COLOUR IS HP.HM AND PHIG.PHI AND HXP.HXM
C LH7 COLOUR IS POWERS OF HXP.HXM
Z LH5=-LL5*GG*GG*HSH*HSH
Z LH6=-LL6*GG*GG*HSH*HHHH
Z LH7=-LL7*GG*GG*HHHH*HHHH
Id GG**-2=0
Al RT12**2=1/2
Al RT13**2=1/3
Al RT15**2=1/5
*next
B LL8,GG,I,FF
C LH8 QUARTIC COLOUR IS HP.LA.LA.HM OR HP.HXM.HXP.HM OR HP.LA.HXM.PHI
C  OR HP.HXM.TA.PHI OR PHIG.TA.TA.PHI OR PHIG.HXP.HXM.PHI OR
C    PHIG.HXP.LA.HM OR PHIG.TA.HXP.HM
C LH8 CUBIC COLOUR IS HP.LA.HM OR HP.HXM.PHI OR PHIG.TA.PHI OR PHIG.HXP.
Z LH8=-LL8*Conjg(H(I1))*HH2(I1,I2)*H(I2)*GG*GG
Id UNIT=1
Al UNI=1
Al HL=LA*HA
Al HT=TA*HB
Id,Multi,RT12**2=1/2
Al GG**-2=0
Al,Commu,LA
Al,Commu,TA
*next
B LL9,GG,I,FF
F HL4,HT4
C LH9 COLOUR IS TR(HXP.HXM.HXP.HXM) = HXP(A,J)*HYM(A,I)*HXP(B,I)*HXM(B,J
Z LH9=-LL9*GG*GG*HH2(I1,I2)*HH2(I2,I1)
Id UNIT**2=3
Al UNI**2=2
Al GG**-2=0
Al HL*HL*HL*HL=HL4
Al HT*HT*HT*HT=HT4
Al RT13**2=1/3
Al RT15**2=1/5
Al,Multi,RT12**2=1/2
Id UNIT=1
Al UNI=1
Al HL*HL*HL=0
Al HT*HT*HT=0
Id,Ainbe,HL*HL=2*HA*HA
Al,Ainbe,HT*HT=2*HB*HB
Id HL=0
Al HT=0
*next
S LL10,LL11,LL12,LL21,LL23
B GG,I,HP,HM,PHIG,PHI,HA,HB0,HB,HXP,HXM,MMX
Z LHA=LH1+LH2+LH3+LH4+LH5+LH6+LH7+LH8+LH9
   -MMX**2*HXP*HXM
C PART OF GAUGE FIXING TERM
Id MM2**2=6*RT12/5*FF*MM4-48/5*FF**2*LL7-56/25*FF**2*LL9
Id MM4=-FF*LL11*RT12/15+4*FF*LL12*RT12/15
Al LL7=-LL11/32-LL12/48+5*LL10/96
Al LL9=LL12/8+LL11/8
Al MM1**2=6*FF*MM3*RT12/5-12*FF**2*LL6/5-18*FF**2*LL8/25+FF**2*LL21
Id MM3=2*FF*LL8*RT12/5+RT12*FF*LL23-RT12*FF*LL21
Id,Multi,RT12**2=1/2
P output
C HIGGS POTENTIAL
*begin
Common A,E,DIF
C RT12=SQRT(1/2) ETC
C GG = GAUGE COUPLING CONSTANT
C          SUMMATION CONVENTIONS
C UNIT = 3 BY 3 UNIT MATRIX
C UNI= 2 BY 2 MATRIX
C LG(MU)=LAMBDA(A)*GL(A,MU)
C TB(MU)=TAU(A)*B(A,MU)
C LDIFF(GL)=LAMBDA(A)*DIFF(GL(A))
C TDIFF(B)=TAU(A)*DIFF(B(MU))
C FGGDG(MU,NU,RO,SI)=F(A,B,C)*GL(A,MU)*GL(B,NU)*D(RO)*GL(C,SI)
C EBBDB(MU,NU,RO,SI)=Epf(A,B,C)*B(A,MU)*B(B,NU)*D(RO)*B(C,SI)
C FGGL(MU,NU)=F(A,B,C)*GL(A,MU)*GL(B,NU)*LAMBDA(C)
C EBBT(MU,NU)=Epf(A,B,C)*B(A,MU)*B(B,NU)*TAU(C)
C F2G4(MU,NU,RO,SI)=F(A,B,E)*F(C,D,E)*GL(A,MU)*GL(B,NU)*GL(C,RO)*GL(D,SI
C E2B4(MU,NU,RO,SI)=Epf(A,B,E)*Epf(C,D,E)*B(A,MU)*B(B,NU)*B(C,RO)*B(D,SI
C E2B4(MU,NU,MU,NU)=B(I,MU)*B(I,MU)*B(J,NU)*B(J,NU)-B(I,MU)*B(I,NU)*B(J,
C    B(J,NU)
C XXXX=XP(A,I,MU)*XM(A,J,NU)*XP(B,J,NU)*XM(B,I,MU)
C XP.XP*XM.XM=XP(A,I,MU)*XM(A,J,NU)*XP(B,J,MU)*XM(B,I,NU)
C (XP.XM)**2=XP(A,I,MU)*XM(A,J,MU)*XP(B,J,NU)*XM(B,I,NU)
B GG
S GG,UNIT,RT12,RT13,RT15,UNI
I MU1,MU2,MU3,MU4,I1=3,I2=3,I3=3,I4=3
V GL,B,B0,XM,XP
F XXXX,DIFF,LDIFF,TDIFF,LG,TB,FGGDG,EBBDB,FGGL,EBBT,F2G4,E2B4,MX=c
Oldnew MXC=PX
Z DIF(MU1,MU2,I1,I2)=-I*RT12*(
   +DIFF(MU1,XM,MU2)*D(I1,1)*D(I2,2)
   +DIFF(MU1,XP,MU2)*D(I1,2)*D(I2,1)
   +(RT12*LDIFF(MU1,GL,MU2)+UNIT*2*RT12*RT13*RT15*DIFF(MU1,B0,MU2))
   *D(I1,1)*D(I2,1)
   +(RT12*TDIFF(MU1,B,MU2)-UNI*3*RT12*RT13*RT15*DIFF(MU1,B0,MU2))
   *D(I1,2)*D(I2,2))
Id RT12**2=1/2
*next
Z A(MU1,I1,I2)=DIF(MU2,MU1,I1,I2)
Id DIFF(MU1~,XM,MU2~)=MX(MU2)
Al DIFF(MU1~,XP,MU2~)=PX(MU2)
Al LDIFF(MU1~,GL,MU2~)=LG(MU2)
Al TDIFF(MU1~,B,MU2~)=TB(MU2)
Id DIFF(MU1~,B0~,MU2~)=B0(MU2)
*next
B GG
Z E(I1,I3)=GG*(A(MU1,I1,I2)*A(MU2,I2,I3)-A(MU2,I1,I2)*A(MU1,I2,I3))
*yep
Id,Multi,RT12**2=1/2
Al LG(MU1)*LG(MU2)=LG(MU2)*LG(MU1)+2*I*FGGL(MU1,MU2)
Al TB(MU1)*TB(MU2)=TB(MU2)*TB(MU1)+2*I*EBBT(MU1,MU2)
Al UNIT**N~=UNIT**N/UNIT
Al UNI**N~=UNI**N/UNI
*next
B GG
Z ZG0=DIF(MU1,MU2,I1,I2)*DIF(MU1,MU2,I2,I1)
Z ZG00=-DIF(MU1,MU1,I1,I2)*DIF(MU2,MU2,I2,I1)
C ZG00=0 WHEN THE GAUGE FIXING TERM IS ADDED
Z ZG1=2*E(I1,I2)*DIF(MU1,MU2,I2,I1)
Z ZG2=E(I1,I2)*E(I2,I1)/2
*yep
Id UNIT**N~=UNIT**N/UNIT
Al UNI**N~=UNI**N/UNI
Al RT12**2=1/2
Al RT13**2=1/3
Al RT15**2=1/5
Sum MU1,MU2
Id,Ainbe,LG(MU1~)*LG(MU2~)=2*GL(MU1)*GL(MU2)
Al,Ainbe,TB(MU1~)*TB(MU2~)=2*B(MU1)*B(MU2)
Al LDIFF(MU1~,GL,MU2~)*LDIFF(MU3~,GL,MU4~)=2*DIFF(MU1,GL,MU2)*DIFF(MU3,
   GL,MU4)
Al TDIFF(MU1~,B,MU2~)*TDIFF(MU3~,B,MU4~)=2*DIFF(MU1,B,MU2)*DIFF(MU3,B,
   MU4)
Al FGGL(MU1~,MU2~)*LDIFF(MU3~,GL,MU4~)=2*FGGDG(MU1,MU2,MU3,MU4)
Al EBBT(MU1~,MU2~)*TDIFF(MU3~,B,MU4~)=2*EBBDB(MU1,MU2,MU3,MU4)
Al FGGL(MU1~,MU2~)*FGGL(MU3~,MU4~)=2*F2G4(MU1,MU2,MU3,MU4)
Al EBBT(MU1~,MU2~)*EBBT(MU3~,MU4~)=2*E2B4(MU1,MU2,MU3,MU4)
Id FGGL(MU1~,MU2~)=0
Al EBBT(MU1~,MU2~)=0
Al LG(MU1~)=0
Al TB(MU1~)=0
Al LDIFF(MU1~,GL,MU2~)=0
Al TDIFF(MU1~,B,MU2~)=0
Al UNIT=3
Al UNI=2
*yep
B GG,B0DB0,BDB,GLDGL,XPDXM,XMDXM,XPDXP
Id PX(MU1~)*MX(MU2~)*PX(MU2~)*MX(MU1~)=XXXX
Id MX(MU1~)=XM(MU1)
Al PX(MU1~)=XP(MU1)
Id,Commu,DIFF
C -1/4*F(MU,NU,A)*F(MU,NU,A)
C ZG0+ZG1+ZG2=-1/4*F(MU,NU)**2   + PART OF GAUGE FIXING
*begin
B I,GG,RT12,RT13,RT15
C THERE IS IMPLICIT LA IN G(1,GL) AND TA IN G(1,B)
S GG,RT12,RT13,RT15,T
I I1=5,I2=5,I3=5
V GL,B,B0,XM,XP,K
F CH
F C=c,Cc=c,L=c,UPB=c,DNB=c,ELB=c,UDB=c,ENB=c
Oldnew CC=CG,Cc=CC,CcC=CCG
Oldnew LC=R,UPBC=UP,DNBC=DN,ELBC=EL,UDBC=UD,ENBC=EN
X ASLSH(I1,I2)=-I*RT12*(G(1,XM)*(D(I1,1)+D(I1,2))*(D(I2,4)+D(I2,5))
   +G(1,XP)*(D(I1,4)+D(I1,5))*(D(I2,1)+D(I2,2)))
   -I/2*((G(1,GL)+2*RT13*RT15*G(1,B0))*D(I1,1)*D(I2,1)
   +(-2*G(1,GL)+2*RT13*RT15*G(1,B0))*D(I1,2)*D(I2,2)
   +(G(1,B)-3*RT13*RT15*G(1,B0))*D(I1,4)*D(I2,4)
   +(-2*G(1,B)-3*RT13*RT15*G(1,B0))*D(I1,5)*D(I2,5))
X DSLSH(T,I1,I2)=I*G(1,K)*D(I1,I2)+T*GG*ASLSH(I1,I2)
X MM(I1,I2,L,CC,C)=RT12*(
   C(L,UP  )*(D(I1,1)*D(I2,2)-D(I1,2)*D(I2,1))*Epf(1,2,3)
   +CC(L,UD)*(D(I1,1)*D(I2,4)-D(I1,4)*D(I2,1))
  +C(L,EL  )*(D(I1,4)*D(I2,5)-D(I1,5)*D(I2,4))*Epf(1,2))
X M(I1,I2)=MM(I1,I2,L,CC,C)
X MB(I1,I2)=Conjg(MM(I2,I1,L,CC,C))
X P(I1)=CC(R,DN)*D(I1,1)+C(R,EN)*D(I1,4)
X PB(I1)=Conjg(P(I1))
Z LGRN1=
   -PB(I1)*DSLSH(1,I1,I2)*P(I2)
Z LGRN2=
   -MB(I1,I2)*DSLSH(2,I2,I3)*M(I3,I1)
*yep
Id,Multi,RT12**2=1/2
Al Epf(1,2,3)*Epf(1,2,3)=-1
Al Epf(1,2)*Epf(1,2)=-1
Al CG(R~,DN~)*G(1,K )*C(L~,EL~)= Conjg(EL)*L*G(1,K)*R*Conjg(DN)
Id CG(R~,DN~)*G(1,K~)*C(L~,EL~)=-Conjg(EL)*L*G(1,K)*R*Conjg(DN)
Id CC(L~,EL~)=L*EL
Al CCG(R~,ELB~)=ELB*R
Al C(L~,EL~)=L*CH*EL
Al CG(R~,ELB~)=ELB*CH*R
*yep
Id,Adiso,L*G(1,K)*R=G(1,K)
Id L*G(1,B~)*R=G(1,B)*R
Al R*G(1,B~)*L=G(1,B)*L
P output
C FERMION KINETIC TERMS
C   AND FERMION INTERACTIONS WITH GAUGE FIELD
*yep
Id L=G6(1)/2
Al R=G7(1)/2
*begin
S HM=c,PHI=c
Oldnew HMC=HP,PHIC=PHIG
I I1=5,I2=5
Z H(I1)=I*HM*D(I1,1)+I*PHI*(D(I1,4)+D(I1,5))
*next
C EN*Epf(1,2)*PHIG=Epf(I1,I2)*EN(I1)*PHIG(I2)
C ENB*Epf(1,2)*PHI=Epf(I1,I2)*PHI(I1)*ENB(I2)
S RT12,L2
B L2,I,RT12,HM,HP,PHI,PHIG
F CH
F C=c,Cc=c,L=c,UPB=c,DNB=c,ELB=c,UDB=c,ENB=c
Oldnew CC=CG,Cc=CC,CcC=CCG
Oldnew LC=R,UPBC=UP,DNBC=DN,ELBC=EL,UDBC=UD,ENBC=EN
X MM(I1,I2,L,CC,C)=RT12*(
   -C(L,UP)*(D(I1,1)*D(I2,3)-D(I1,3)*D(I2,1))*Epf(3,2,1)
   +CC(L,UD)*(D(I1,1)*D(I2,4)-D(I1,4)*D(I2,1))
  +C(L,EL  )*(D(I1,4)*D(I2,5)-D(I1,5)*D(I2,4))*Epf(1,2))
X P(I1)=CC(R,DN)*(D(I1,1)+D(I1,3))+C(R,EN)*D(I1,4)
X PB(I1)=Conjg(P(I1))
X M(I1,I2)=MM(I1,I2,L,CC,C)
X MB(I1,I2)=Conjg(MM(I2,I1,L,CC,C))
Z Z=-L2*(H(I1)*MB(I1,I2)*P(I2)+PB(I1)*M(I1,I2)*Conjg(H(I2)))
*yep
Al CG(R~,UP~)*C(L~,EL~)=Conjg(EL)*L*R*Conjg(UP)
Id CC(L~,EL~)=L*EL
Al CCG(R~,ELB~)=ELB*R
Al C(L~,EL~)=L*CH*EL
Al CG(R~,ELB~)=ELB*CH*R
Id R*R=R
Al L*L=L
P output
C FERMION HIGGS COUPLING 2
*yep
Id L=G6(1)/2
Al R=G7(1)/2
*begin
S HM=c,PHI=c
Oldnew HMC=HP,PHIC=PHIG
I I1=5,I2=5,I3=5,I4=5,I5=5
Z H(I1)=I*HM*D(I1,1)+I*PHI*D(I1,4)
*next
S RT12,L1
B L1,I,RT12,HM,HP,PHI,PHIG
F CH
F C=c,Cc=c,L=c,UPB=c,UDB=c,ELB=c
Oldnew CC=CG,Cc=CC,CcC=CCG
Oldnew LC=R,UPBC=UP,UDBC=UD,ELBC=EL
X MM(I1,I2,L,CC,C)=RT12*(
   C(L,UP  )*(D(I1,1)*D(I2,2)-D(I1,2)*D(I2,1))
  +C(L,UP  )*(D(I1,2)*D(I2,3)-D(I1,3)*D(I2,2))
  +CC(L,UD  )*(D(I1,2)*D(I2,4)-D(I1,4)*D(I2,2))*Epf(3,2,1)*Epf(2,1)
 /2
  +CC(L,UD  )*(D(I1,3)*D(I2,5)-D(I1,5)*D(I2,3))
  +C(L,EL  )*(D(I1,4)*D(I2,5)-D(I1,5)*D(I2,4)))
X M(I1,I2)=MM(I1,I2,L,CC,C)
X MC(I1,I2)=MM(I1,I2,R,C,CC)
X MB(I1,I2)=Conjg(MM(I2,I1,L,CC,C))
X MCB(I1,I2)=Conjg(MM(I2,I1,R,C,CC))
Z Z=-L1*Epf(I1,I2,I3,I4,I5)*
   (MCB(I1,I2)*M(I3,I4)*H(I5)+MB(I1,I2)*MC(I3,I4)*Conjg(H(I5)))
*yep
Id Epf(1,2,3,4,5)=1
Al CG(R~,UP~)*C(L~,EL~)=Conjg(EL)*L*R*Conjg(UP)
Al CCG(R~,UP~)*C(L~,EL)=ELB*L*R*CH*Conjg(UP)
Al CG(R~,ELB)*CC(L~,UP~)=Conjg(UP)*CH*L*R*EL
Id CC(L~,EL~)=L*EL
Al CCG(R~,ELB~)=ELB*R
Al C(L~,EL~)=L*CH*EL
Al CG(R~,ELB~)=ELB*CH*R
Id,Multi,RT12**2=1/2
Id Epf(1,2,3)*Epf(1,2)=Epf(1,2)*Epf(1,2,3)
Id R*R=R
Al L*L=L
P output
C FERMION HIGGS COUPLING 1
*yep
Id L=G6(1)/2
Al R=G7(1)/2
*end

C Varia 8. Lagrangian for SU(5) twice broken to SU(3)*U(1).

C PROGRAM WRITTEN BY MARTIN GREEN, AUGUST 1981.
P stat
Common A,DIF,DIFH,CDIFH,DIFHH,F1,F2,DIFZ,DIFZB,ZB,GAUGE
   ,H,HH,F1B,F0,MZ,HSH,HHHH,HH2
   ,LH1,LH2,LH3,LH4,LH5,LH6,LH7,LH8,LH9
C RT12=SQRT(1/2) ETC
C GG = GAUGE COUPLING CONSTANT
C UNIT = 3 BY 3 UNIT MATRIX
C          SUMMATION CONVENTIONS
C LG(MU)=LAMBDA(A)*GL(A,MU)
C LDIFF(GL)=LAMBDA(A)*DIFF(GL(A))
P noutp
Oldnew i=I
B GG
S GG,UNIT,RT12,RT13,RT15
I MU1,MU2,MU3,MU4,I1=3,I2=3,I3=3,I4=3
V Z,PH,GL,WP,WM,XM,XP,YM,YP
F DIFF,LDIFF,LG,MX=c,MY=c
Oldnew MXC=PX,MYC=PY
C   DIFFERENTIAL OF A(MU)
Z DIF(MU1,MU2,I1,I2)=-I*RT12*(
   DIFF(MU1,WP,MU2)*D(I1,2)*D(I2,3)+DIFF(MU1,WM,MU2)*D(I1,3)*D(I2,2)
   +DIFF(MU1,XM,MU2)*D(I1,1)*D(I2,2)+DIFF(MU1,YM,MU2)*D(I1,1)*D(I2,3)
   +DIFF(MU1,XP,MU2)*D(I1,2)*D(I2,1)+DIFF(MU1,YP,MU2)*D(I1,3)*D(I2,1)
 +(RT12*LDIFF(MU1,GL,MU2)+UNIT*DIFF(MU1,Z,MU2)*RT15/2-UNIT*DIFF(MU1,PH,
   MU2)*RT13/2)*D(I1,1)*D(I2,1)+(DIFF(MU1,Z,MU2)*RT15/2+3*DIFF(MU1,PH,MU
   2)*RT13/2)*D(I1,2)*D(I2,2)-2*DIFF(MU1,Z,MU2)*RT15*D(I1,3)*D(I2,3))
Id RT12**2=1/2
*next
C                     A(MU)
Z A(MU1,I1,I2)=DIF(MU2,MU1,I1,I2)
Id DIFF(MU1~,XM,MU2~)=MX(MU2)
Al DIFF(MU1~,XP,MU2~)=PX(MU2)
Al DIFF(MU1~,YM,MU2~)=MY(MU2)
Al DIFF(MU1~,YP,MU2~)=PY(MU2)
Al LDIFF(MU1~,GL,MU2~)=LG(MU2)
Id DIFF(MU1~,Z~,MU2~)=Z(MU2)
*next
C          SUMMATION CONVENTIONS
C SUMMED COLOUR IS OF THE FORM PX.MY OR PY.MX ETC
C SUMMED COLOUR IN XX IS XP.XM ETC
B GG,I
S MMW,MMY,MMX
S C1,S1,C2,S2
F HM1=c
Oldnew HM1C=HP1
S HB0,HB3
S XX,YY,HXX,HYY,XHX,YHY,HXHX,HYHY
S H1Y,H1H1,YH1,H1HY,HYH1
S HA,HZ,HPH,HWP=c,FF
S HXM=c,HYM=c
Oldnew HXMC=HXP,HYMC=HYP
F HL,HMX=c,HMY=c,LA,FHAGL
Oldnew HWPC=HWM,HMXC=HPX,HMYC=HPY
C          SUMMATION CONVENTIONS
C HM*HP*YMDYP=YM(MU1,I1)*HP(I1)*YP(MU1,I2)*HM(I2)    I.E.  P.M  ETC
S HM=c,PHIP=c,F,H0,PHI0
Oldnew HMC=HP,PHIPC=PHIM
X HH1(I1,I2)=HMX*D(I1,1)*D(I2,2)+(C1*HMY+S1*HM1)*D(I1,1)*D(I2,3)
   +(C2*HWP-S2*PHIP)*D(I1,2)*D(I2,3)
C                       HIGGS 24
Z HH(I1,I2)=-I*HH1(I1,I2)+I*Conjg(HH1(I2,I1))
   +(HL*RT12+UNIT*(2*HB0*RT12*RT13*RT15+4*RT12*FF/GG/5))*D(I1,1)*D(I2,1)
   +(HB3*RT12-3*HB0*RT12*RT13*RT15-6*RT12*FF/GG/5)*D(I1,2)*D(I2,2)
   -(HB3*RT12+3*HB0*RT12*RT13*RT15+6*RT12*FF/GG/5)*D(I1,3)*D(I2,3)
   +EPS/GG*(D(I1,2)*D(I2,2)-D(I1,3)*D(I2,3))*2*RT12
C                         HIGGS 5
Z H(I1)=I*(C1*HM-S1*HYM)*D(I1,1)+I*(C2*PHIP+S2*HWP)*D(I1,2)
   +(H0+2*F/GG-I*PHI0)*RT12*D(I1,3)
*next
X DIFFH(I1)=I*(C1*DIFF(MU1,HM)-S1*DIFF(MU1,HYM))*D(I1,1)
   +I*(C2*DIFF(MU1,PHIP)+S2*DIFF(MU1,HWP))*D(I1,2)
   +(DIFF(MU1,H0)*RT12-I*DIFF(MU1,PHI0)*RT12)*D(I1,3)
Z DIFH(I1)=DIFFH(I1)+GG*A(MU1,I1,I2)*H(I2)
Z DIFHH(I1,I2)=GG*A(MU1,I1,I3)*HH(I3,I2)-HH(I1,I3)*A(MU1,I3,I2)*GG
 -I*DIFF(MU1,HXM)*D(I1,1)*D(I2,2)+DIFF(MU1,HXP)*D(I1,2)*D(I2,1)*I
   -I*(C1*DIFF(MU1,HYM)+S1*DIFF(MU1,HM))*D(I1,1)*D(I2,3)
   +I*(C1*DIFF(MU1,HYP)+S1*DIFF(MU1,HP))*D(I1,3)*D(I2,1)
   -I*(C2*DIFF(MU1,HWP)-S2*DIFF(MU1,PHIP))*D(I1,2)*D(I2,3)
   +I*(C2*DIFF(MU1,HWM)-S2*DIFF(MU1,PHIM))*D(I1,3)*D(I2,2)
   +(DIFF(MU1,HL)*RT12+UNIT*UNIT* DIFF(MU1,HB0)*2*RT12*RT13*RT15)
            *D(I1,1)*D(I2,1)
   +(DIFF(MU1,HB3)*RT12-3*DIFF(MU1,HB0)*RT12*RT13*RT15)*D(I1,2)*D(I2,2)
   -(DIFF(MU1,HB3)*RT12+3*DIFF(MU1,HB0)*RT12*RT13*RT15)*D(I1,3)*D(I2,3)
Id UNIT**N~=UNIT**N/UNIT
Al,Multi,RT12**2=1/2
Al RT13**2=1/3
Al RT15**2=1/5
Id HL*LG(MU1)=LG(MU1)*HL+2*I*FHAGL*LA
Id HL=HA*LA
Al LG(MU1)=GL(MU1)*LA
Al DIFF(MU1,HL)=DIFF(MU1,HA)*LA
*next
B GG
Z CDIFH(I1)=Conjg(DIFH(I1))
Id WP(MU1)=GL(MU1)
Id WM(MU1)=WP(MU1)
Id GL(MU1)=WM(MU1)
*next
B GG,I,F,EPS,FFEPS,MMW,MMY
Z Z=-CDIFH(I1)*DIFH(I1)
   -DIFHH(I1,I2)*DIFHH(I2,I1)/2
   -4*F*RT12*RT15*DIFF(Z,PHI0)
   -(FF-EPS)*(DIFF(XP,HXM)+DIFF(XM,HXP))
   -MMY*(DIFF(YP,HYM)+DIFF(YM,HYP))
   -MMW*(DIFF(WM,PHIP)+DIFF(WP,PHIM))
C PART OF GAUGE FIXING TERM
Id UNIT**2=3
Al RT13**2=1/3
Al RT15**2=1/5
Al,Multi,RT12**2=1/2
Id UNIT=1
Al,Ainbe,LA*LA=2
Id LA=0
Al S1**2=1-C1*C1
Al S2**2=1-C2*C2
Al S2*F=-2*EPS*C2
Al S1*FF=-EPS*S1-F*C1
Al S1*F=(FF+EPS)*C1-MMY
Al S2*EPS=F*C2/2-MMW/2
*yep
C          SUMMATION CONVENTIONS
Id MX(MU1)*HPX*MX(MU1)*HPX=HXX**2
Al MX(MU1)*HPX*HMX*PX(MU1)=HXHX*XX
Al PX(MU1)*HMX*PX(MU1)*HMX=XHX**2
Al PX(MU1)*HMX*HPX*MX(MU1)=XHX*HXX
Al HMX*PX(MU1)*MX(MU1)*HPX=XX*HXHX
Al HMX*PX(MU1)*HMX*PX(MU1)=XHX**2
Al HPX*MX(MU1)*PX(MU1)*HMX=HXX*XHX
Al HPX*MX(MU1)*HPX*MX(MU1)=HXX**2
Al MY(MU1)*HPY*MY(MU1)*HPY=HYY**2
Al MY(MU1)*HP1*MY(MU1)*HP1=H1Y**2
Al MY(MU1)*HP1*MY(MU1)*HPY=HYY*H1Y
Al MY(MU1)*HPY*MY(MU1)*HP1=HYY*H1Y
Al MY(MU1)*HPY*HMY*PY(MU1)=HYHY*YY
Al MY(MU1)*HPY*HM1*PY(MU1)=HYH1*YY
Al MY(MU1)*HP1*HMY*PY(MU1)=H1HY*YY
Al MY(MU1)*HP1*HM1*PY(MU1)=H1H1*YY
Al PY(MU1)*HMY*PY(MU1)*HMY=YHY**2
Al PY(MU1)*HM1*PY(MU1)*HMY=YHY*YH1
Al PY(MU1)*HMY*PY(MU1)*HM1=YHY*YH1
Al PY(MU1)*HM1*PY(MU1)*HM1=YH1**2
Al PY(MU1)*HMY*HPY*MY(MU1)=YHY*HYY
Al PY(MU1)*HM1*HPY*MY(MU1)=YH1*HYY
Al PY(MU1)*HMY*HP1*MY(MU1)=YHY*H1Y
Al PY(MU1)*HM1*HP1*MY(MU1)=YH1*H1Y
Al HMY*PY(MU1)*MY(MU1)*HPY=YY*HYHY
Al HM1*PY(MU1)*MY(MU1)*HP1=YY*H1H1
Al HM1*PY(MU1)*MY(MU1)*HPY=YY*HYH1
Al HMY*PY(MU1)*MY(MU1)*HP1=YY*H1HY
Al HMY*PY(MU1)*HMY*PY(MU1)=YHY**2
Al HM1*PY(MU1)*HMY*PY(MU1)=YHY*YH1
Al HMY*PY(MU1)*HM1*PY(MU1)=YHY*YH1
Al HM1*PY(MU1)*HM1*PY(MU1)=YH1**2
Al HPY*MY(MU1)*PY(MU1)*HMY=HYY*YHY
Al HPY*MY(MU1)*PY(MU1)*HM1=HYY*YH1
Al HP1*MY(MU1)*PY(MU1)*HM1=H1Y*YH1
Al HP1*MY(MU1)*PY(MU1)*HMY=H1Y*YHY
Al HPY*MY(MU1)*HPY*MY(MU1)=HYY**2
Al HP1*MY(MU1)*HPY*MY(MU1)=HYY*H1Y
Al HPY*MY(MU1)*HP1*MY(MU1)=HYY*H1Y
Al HP1*MY(MU1)*HP1*MY(MU1)=H1Y**2
*yep
Id MX(MU1~)=XM(MU1)
Al PX(MU1~)=XP(MU1)
Al HMX=HXM
Al HPX=HXP
Al MY(MU1~)=YM(MU1)
Al PY(MU1~)=YP(MU1)
Al HMY=HYM
Al HPY=HYP
Al HM1=HM
Al HP1=HP
Al S1=-F/MMY
Al S2=-2*EPS/MMW
Al C1=(FF+EPS)/MMY
Al C2=F/MMW
Id,Commu,DIFF
Id FF=FFEPS-EPS
*yep
B GG,I,F,FF
C    THROWING AWAY VERY NEGLIGABLE TERMS
Id,Count,0,F,-1,EPS,-2,MMW,-1,H0,1,PHI0,1,PHIP,1,PHIM,1
   ,WM,1,WP,1,Z,1
Id FFEPS=FF
Al MMY**N~=FF**N
Al MMW**N~=F**N
Al GG**1=GG*GG1
Id,Count,-2,GG,-1,GG1,-1,F,-1,EPS,-2
Id GG1=1
C HIGGS KINETIC TERM
*next
P noutput
F ZXM=c,ZXP=c,ZYM=c,ZYP=c,ZWM=c,ZWP=c,ZA=c,ZPH=c,ZZ=c
Oldnew ZXMC=ZXMG,ZYMC=ZYMG,ZYPC=ZYPG,ZWMC=ZWMG,ZWPC=ZWPG,ZAC=ZAG,ZPHC=ZPHG
Oldnew ZZC=ZZG,ZXPC=ZXPG
C   DIFFERENTIAL OF F.P. GHOST MULTIPLET
Z DIFZ(I1,I2)=
       D(I1,1)*D(I2,2)*DIFF(MU1,ZXM)+D(I1,1)*D(I2,3)*DIFF(MU1,ZYM)
   +D(I1,2)*D(I2,1)*DIFF(MU1,ZXP)+D(I1,3)*D(I2,1)*DIFF(MU1,ZYP)
   +D(I1,2)*D(I2,3)*DIFF(MU1,ZWP)+D(I1,3)*D(I2,2)*DIFF(MU1,ZWM)
   +D(I1,1)*D(I2,1)*(RT12*LA*DIFF(MU1,ZA)+UNIT*(-DIFF(MU1,ZPH)*RT13+DIFF
   (MU1,ZZ)*RT15)/2)
   +D(I1,2)*D(I2,2)*(3*DIFF(MU1,ZPH)*RT13+DIFF(MU1,ZZ)*RT15)/2
   -D(I1,3)*D(I2,3)*2*RT15*DIFF(MU1,ZZ)
*next
Z DIFZB(I1,I2)=Conjg(DIFZ(I2,I1))
Z HH(I1,I2)=HH(I1,I2)
Id HMX=HXM
Al HPX=HXP
Al HMY=HYM
Al HPY=HYP
Al HM1=HM
Al HP1=HP
*next
C      GHOST MULTIPLET
Z GAUGE(I1,I2)=DIFZ(I1,I2)
Z ZB(I1,I2)=DIFZB(I1,I2)
Id DIFF(MU1,ZZ~)=ZZ
*next
B GG,I
F FZAHA,FZAGL
C          SUMMATION CONVENTIONS
C FZAHA=F(A,B,C)*ZA(B)*HA(C)      ETC
C   INFINITESIMAL GAUGE TRANSFORMATIONS OF FIELDS
Z F0(I1,I2)=GAUGE(I1,I3)*A(MU1,I3,I2)-A(MU1,I1,I3)*GAUGE(I3,I2)
Z F1(I1)=-I*GG*RT12*H(I2)*GAUGE(I1,I2)
Z F1B(I1)=I*GG*RT12*Conjg(H(I2))*GAUGE(I2,I1)
Z F2(I1,I2)=-I*GG*RT12*(GAUGE(I1,I3)*HH(I3,I2)-HH(I1,I3)*GAUGE(I3,I2))
Id LA*ZA*HL=HL*LA*ZA+2*I*FZAHA*LA
Al LA*ZA*LG(MU1)=LG(MU1)*LA*ZA+2*I*LA*FZAGL(MU1)
Al,Multi,RT12**2=1/2
Al UNIT=1
Id HL=HA*LA
Al LG(MU1)=LA*GL(MU1)
*next
B GG,I,F,FF,EPS
C   INFINITESIMAL GAUGE TRANSFORMATIONS OF GAUGE FIXING TERM
Z MZ(I1,I2)=I*GG*RT12*(4*RT12*EPS/GG
        *(F2(2,3)*D(I1,2)*D(I2,3)-F2(3,2)*D(I1,3)*D(I2,2))
   +2*RT12*(FF-EPS)/GG
                *(F2(1,2)*D(I1,1)*D(I2,2)-F2(2,1)*D(I1,2)*D(I2,1))
   +2*RT12*(FF+EPS)/GG
                *(F2(1,3)*D(I1,1)*D(I2,3)-F2(3,1)*D(I1,3)*D(I2,1))
   +2*RT12*F/GG
     *(-F1(1)*D(I1,1)*D(I2,3)+F1B(1)*D(I1,3)*D(I2,1)
   -F1(2)*D(I1,2)*D(I2,3)+F1B(2)*D(I1,3)*D(I2,2)
   +(F1(3)-F1B(3))/5*(UNIT*D(I1,1)*D(I2,1)+D(I1,2)*D(I2,2)-4*D(I1,3)*D(I
   2,3))))
*next
B GG,I,F,FF
Z LFP1=-DIFZB(I1,I2)*DIFZ(I2,I1)
Z LFP2=DIFZB(I1,I2)*F0(I2,I1)*GG
Z LFP3=ZB(I1,I2)*MZ(I2,I1)
*yep
B MMW,MMY,GG,I,F,FFEPS,EPS
Id,Ainbe,LA*LA=2
Al,UNIT**2=3
Al MX(MU1)=XM(MU1)
Al PX(MU1)=XP(MU1)
Al MY(MU1)=YM(MU1)
Al PY(MU1)=YP(MU1)
Id LA=0
Al UNIT=1
Al RT13**2=1/3
Al RT15**2=1/5
Al,Multi,RT12**2=1/2
Al S1=-F/MMY
Al S2=-2*EPS/MMW
Al C1=(FF+EPS)/MMY
Al C2=F/MMW
Id FF=FFEPS-EPS
*yep
B GG,I,F,FF
C    THROWING AWAY VERY NEGLIGABLE TERMS
Id,Count,0,F,-1,EPS,-2,MMW,-1,H0,1,PHI0,1,PHIP,1,PHIM,1
   ,ZWMG,1,ZWM,1,ZZG,1,ZZ,1,ZWPG,1,ZWP,1
Id FFEPS=FF
Al MMY**N~=FF**N
Al MMW**N~=F**N
Al GG**1=GG*GG1
Id,Count,-2,GG,-1,GG1,-1,F,-1,EPS,-2
Id GG1=1
C FADEEV POPOV GHOST LAGRANGIAN
*next
P noutp
B GG,I,F,FF,EPS
Z HSH=Conjg(H(I1))*H(I1)
Z HHHH=HH(I1,I2)*HH(I2,I1)
Id UNIT**2=3
Al RT13**2=1/3
Al RT15**2=1/5
Al,Multi,RT12**2=1/2
Al HL*HL=2*HA*HA
Id UNIT=1
Al HL=0
*next
B GG,I,FF,EPS
Z HH2(I1,I2)=HH(I1,I3)*HH(I3,I2)
Id UNIT**N~=UNIT**N/UNIT
Al,RT13**2=1/3
Al RT15**2=1/5
Al,Multi,RT12**2=1/2
*next
S MM1,MM2
B MM1,MM2,GG,I,F,FF,EPS
Z LH1=-MM1**2*HSH
Z LH2=-MM2**2/2*HHHH
Id GG**-2=0
*next
S MM3,MM4
B MM3,GG,I,F,FF,EPS
C LH3 COLOUR IS HP.LA*HA.HM
Z LH3=-GG*MM3*Conjg(H(I1))*HH(I1,I2)*H(I2)
Id UNIT=1
Al HL=LA*HA
Al,Multi,RT12**2=1/2
Al GG**-2=0
*next
B MM4,GG,I,F,FF,EPS
Z LH4=-GG*MM4*HH(I1,I2)*HH(I2,I3)*HH(I3,I1)
Id UNIT**3=3
Al HL*HL*HL=0
Id UNIT=1
Al GG**-2=0
Al HL*HL=2*HA*HA
Al,Multi,RT12**2=1/2
Al,Multi,RT13**2=1/3
Al,Multi,RT15**2=1/5
Id HL=0
*next
S LL5,LL6,LL7,LL8,LL9
B LL5,LL6,LL7,GG,I,F,FF,EPS
C LH5 COLOUR IS POWERS OF HP.HM
C LH6 COLOUR IS HP.HM AND X.X OR Y.Y
C LH7 COLOUR IS POWERS OF X.X AND Y.Y
Z LH5=-LL5*GG*GG*HSH*HSH
Z LH6=-LL6*GG*GG*HSH*HHHH
Z LH7=-LL7*GG*GG*HHHH*HHHH
Id GG**-2=0
Al RT12**2=1/2
Al RT13**2=1/3
Al RT15**2=1/5
*next
B LL8,GG,I,F,FF,EPS
C SUMMED COLOUR IS HP.HXM , HXP.HM AND SAME FOR Y
C ALSO COLOUR HP.LA.LA.HM AND HP.LA.HM
Z LH8=-LL8*Conjg(H(I1))*HH2(I1,I2)*H(I2)*GG*GG
Id UNIT=1
Al HL=LA*HA
Id,Multi,RT12**2=1/2
Al GG**-2=0
Al,Commu,LA
*next
B LL9,GG,I,FF,EPS
F HL4
C SUMMED COLOUR IS OF THE FORM HXP,HYM OR HYP.HXM OR (HXP.HXM)**2 OR SAM
Z LH9=-LL9*GG*GG*HH2(I1,I2)*HH2(I2,I1)
Id UNIT**2=3
Al GG**-2=0
Al HL*HL*HL*HL=HL4
Al RT13**2=1/3
Al RT15**2=1/5
Al,Multi,RT12**2=1/2
Id UNIT=1
Al HL*HL*HL=0
Id,Ainbe,HL*HL=2*HA*HA
Id HL=0
*next
S FFEPS
B GG,I,HP,HM,PHIP,PHIM,H0,PHI0,HA,HB0,HB3,HYP,HYM,HXP,HXM,HWP,HWM,MMW
   ,MMX,MMY
   ,FF,F
Z LHA=LH1+LH2+LH3+LH4+LH5+LH6+LH7+LH8+LH9
   -4*F*F/5*PHI0**2-MMW**2*PHIP*PHIM-MMY**2*HYP*HYM-MMX**2*HXP*HXM
C PART OF GAUGE FIXING TERM
C    REPLACING HIGGS PARAMETERS IN TERMS OF V.E.V.,S
Id MM1**2=6*RT12/5*FF*MM3-12/5*LL6*FF**2-18/25*FF**2*LL8-4*LL5*F*F
      -4*LL6*EPS**2-2*LL8*EPS**2-12/5*EPS*FF*LL8+2*RT12*MM3*EPS
Al MM2**2=6*RT12/5*FF*MM4-48/5*FF**2*LL7-56/25*FF**2*LL9-4*F*F*LL6
   -6*EPS*MM4*RT12+32/5*LL9*EPS*(EPS+FF)+6/5*F*F*LL8
   -6/5*LL8*F*F
   -72/5*EPS**2*LL9
   -16*LL7*EPS**2
Id MM3=-6*MM4*EPS*(FF+EPS)/F/F+LL8*(12/5*FF+4*EPS)*RT12
   +64/5*LL9*EPS*FF*(FF+EPS)*RT12/F/F
Id,Multi,RT12**2=1/2
Id S1=-F/MMY
Al S2=-2*EPS/MMW
Al C1=(FF+EPS)/MMY
Al C2=F/MMW
*yep
C    THROWING AWAY VERY NEGLIGABLE TERMS
Id,Count,0,F,-1,EPS,-2,MMW,-1
   ,H0,1,PHI0,1,PHIP,1,PHIM,1
*yep
S LL,LL10,LL11,LL12,LL13,LL14,LL15
C REPLACING HIGGS PARAMETERS BY MASSES OF PHYSICAL HIGGS FIELDS
Id MM4=-RT12*FF*LL11/15+4*RT12*LL12*FF/15
Al LL7=-LL11/32-LL12/48+5*LL10/96
Al LL9=LL12/8+LL11/8
Al LL8=LL13/2-FF*EPS/F/F*LL11
Al LL6=LL11*EPS*FF/F/F/4+LL14*RT13*RT15*5/16*LL10
Id MMW**N~=F**N
Al RT12**2=1/2
Al RT13**2=1/3
Al RT15**2=1/5
Al MMX=FF
Al MMY**N~=FF**N
*yep
S F10,F11,F12,F13,F14,F15
C     DIAGONALISING NEUTRAL HIGGS FIELDS
Id HB3=HB3+2*EPS*H0/F
Al HB0=HB0-F*LL14*H0/FF/2
Al LL5=LL15/8+FF**2*EPS**2/F**4*LL11/2+LL14*LL10/32*LL14
*yep
Id GG**1=GG*GG1
C    THROWING AWAY VERY NEGLIGABLE TERMS
Id Count,-2,GG,-1,GG1,-1,F,-1,EPS,-2
Id GG1=1
Id EPS=LL*F*F/FF
P outp
C HIGGS POTENTIAL
*begin
Common A,E,DIF
C RT12=SQRT(1/2) ETC
C GG = GAUGE COUPLING CONSTANT
C UNIT = 3 BY 3 UNIT MATRIX
C          SUMMATION CONVENTIONS
C LG(MU)=LAMBDA(A)*GL(A,MU)
C LDIFF(GL)=LAMBDA(A)*DIFF(GL(A))
C FGGDG(MU,NU,RO,SI)=F(A,B,C)*GL(A,MU)*GL(B,NU)*D(RO)*GL(C,SI)
C FGGL(MU,NU)=F(A,B,C)*GL(A,MU)*GL(B,NU)*LAMBDA(C)
C F2G4(MU,NU,RO,SI)=F(A,B,E)*F(C,D,E)*GL(A,MU)*GL(B,NU)*GL(C,RO)*GL(D,SI
C XYYX=XP(A,MU)*YM(A,NU)*YP(B,NU)*XM(B,MU)   ETC
C P.PM.M=P(A,MU)*P(B,MU)*M(A,NU)*M(B,NU)
C (P.M)**2=(P(A,MU)*M(A,MU))**2
P noutp
B GG
S GG,UNIT,RT12,RT13,RT15
I MU1,MU2,MU3,MU4,I1=3,I2=3,I3=3,I4=3
V Z,PH,GL,WP,WM,XM,XP,YM,YP
F XXXX,XYYX,YYYY,DIFF,LDIFF,LG,FGGDG,FGGL,F2G4,MX=c,MY=c
Oldnew MXC=PX,MYC=PY
Z DIF(MU1,MU2,I1,I2)=-I*RT12*(
   DIFF(MU1,WP,MU2)*D(I1,2)*D(I2,3)+DIFF(MU1,WM,MU2)*D(I1,3)*D(I2,2)
   +DIFF(MU1,XM,MU2)*D(I1,1)*D(I2,2)+DIFF(MU1,YM,MU2)*D(I1,1)*D(I2,3)
   +DIFF(MU1,XP,MU2)*D(I1,2)*D(I2,1)+DIFF(MU1,YP,MU2)*D(I1,3)*D(I2,1)
 +(RT12*LDIFF(MU1,GL,MU2)+UNIT*DIFF(MU1,Z,MU2)*RT15/2-UNIT*DIFF(MU1,PH,
   MU2)*RT13/2)*D(I1,1)*D(I2,1)+(DIFF(MU1,Z,MU2)*RT15/2+3*DIFF(MU1,PH,MU
   2)*RT13/2)*D(I1,2)*D(I2,2)-2*DIFF(MU1,Z,MU2)*RT15*D(I1,3)*D(I2,3))
Id RT12**2=1/2
*next
P noutp
Z A(MU1,I1,I2)=DIF(MU2,MU1,I1,I2)
Id DIFF(MU1~,XM,MU2~)=MX(MU2)
Al DIFF(MU1~,XP,MU2~)=PX(MU2)
Al DIFF(MU1~,YM,MU2~)=MY(MU2)
Al DIFF(MU1~,YP,MU2~)=PY(MU2)
Al LDIFF(MU1~,GL,MU2~)=LG(MU2)
Id DIFF(MU1~,Z~,MU2~)=Z(MU2)
*next
P noutp
B GG
Z E(I1,I3)=GG*(A(MU1,I1,I2)*A(MU2,I2,I3)-A(MU2,I1,I2)*A(MU1,I2,I3))
*yep
Id,Multi,RT12**2=1/2
Al LG(MU1)*LG(MU2)=LG(MU2)*LG(MU1)+2*I*FGGL(MU1,MU2)
Al UNIT**N~=UNIT**N/UNIT
*next
B GG
Z ZG0=DIF(MU1,MU2,I1,I2)*DIF(MU1,MU2,I2,I1)
Z ZG00=-DIF(MU1,MU1,I1,I2)*DIF(MU2,MU2,I2,I1)
C ZG00=0 WHEN THE GAUGE FIXING TERM IS ADDED
Z ZG1=2*E(I1,I2)*DIF(MU1,MU2,I2,I1)
Z ZG2=E(I1,I2)*E(I2,I1)/2
*yep
Id UNIT**N~=UNIT**N/UNIT
Al RT12**2=1/2
Al RT13**2=1/3
Al RT15**2=1/5
Sum MU1,MU2
Id,Ainbe,LG(MU1~)*LG(MU2~)=2*GL(MU1)*GL(MU2)
Al LDIFF(MU1~,GL,MU2~)*LDIFF(MU3~,GL,MU4~)=2*DIFF(MU1,GL,MU2)*DIFF(MU3,
   GL,MU4)
Al FGGL(MU1~,MU2~)*LDIFF(MU3~,GL,MU4~)=2*FGGDG(MU1,MU2,MU3,MU4)
Al FGGL(MU1~,MU2~)*FGGL(MU3~,MU4~)=2*F2G4(MU1,MU2,MU3,MU4)
Id FGGL(MU1~,MU2~)=0
Al LG(MU1~)=0
Al LDIFF(MU1~,GL,MU2~)=0
Al UNIT=3
*yep
B GG,PHDPH,ZDZ,GLDGL,WPDWM,XPDXM,YPDYM,XMDXM,YMDYM,XMDYM,XPDXP,YPDYP
   ,XPDYP,XPDYM,YPDXM
Id PX(MU1~)*MX(MU2~)*PX(MU2~)*MX(MU1~)=XXXX
Al PX(MU1~)*MY(MU2~)*PY(MU2~)*MX(MU1~)=XYYX
Al PY(MU1~)*MY(MU2~)*PY(MU2~)*MY(MU1~)=YYYY
Al PY(MU1~)*MX(MU2~)*PX(MU2~)*MY(MU1~)=XYYX
Id MX(MU1~)=XM(MU1)
Al PX(MU1~)=XP(MU1)
Al MY(MU1~)=YM(MU1)
Al PY(MU1~)=YP(MU1)
Id,Commu,DIFF
C -1/4*F(MU,NU,A)*F(MU,NU,A)
C ZG0+ZG1+ZG2=-1/4*F(MU,NU)**2+PART OF GAUGE FIXING
*begin
B I,GG,RT12,RT13,RT15
C THERE IS IMPLICIT LA IN G(1,GL)
S GG,RT12,RT13,RT15,T
I I1=5,I2=5,I3=5
V WP,WM,XM,XP,YM,YP,GL,PH,Z,K
F UQB=c
Oldnew UQBC=UQ
F CH=c,TR
F C=c,Cc=c,L=c,UPB=c,DNB=c,ELB=c,NUB=c
Oldnew CC=CG,Cc=CC,CcC=CCG,CHC=CHG
Oldnew LC=R,UPBC=UP,DNBC=DN,ELBC=EL,NUBC=NU
X ASLSH(I1,I2)=-I*RT12*(G(1,WP)*D(I1,4)*D(I2,5)+G(1,WM)*D(I1,5)*D(I2,4)
  +(RT12*G(1,GL)+RT15/2*G(1,Z)-RT13/2*G(1,PH))*D(I1,1)*D(I2,1)
   +(-2*
    RT12*G(1,GL)+RT15/2*G(1,Z)-RT13/2*G(1,PH))*D(I1,2)*D(I2,2)
   +(RT15/2*G(1,Z)+3*RT13/2*G(1,PH))*D(I1,4)*D(I2,4)
   -2*RT15*G(1,Z)*D(I1,5)*D(I2,5)
   +G(1,XM)*(D(I1,1)+D(I1,2))*D(I2,4)+G(1,XP)*D(I1,4)*(D(I2,1)+D(I2,2))
   +G(1,YM)*(D(I1,1)+D(I1,2))*D(I2,5)+G(1,YP)*D(I1,5)*(D(I2,1)+D(I2,2)))
X DSLSH(T,I1,I2)=I*G(1,K)*D(I1,I2)+T*GG*ASLSH(I1,I2)
X MM(I1,I2,L,CC,C)=RT12*(
   C(L,UQ  )*(D(I1,1)*D(I2,2)-D(I1,2)*D(I2,1))*Epf(1,2,3)
   +CC(L,UP)*(D(I1,1)*D(I2,4)-D(I1,4)*D(I2,1))
   +CC(L,DN)*(D(I1,1)*D(I2,5)-D(I1,5)*D(I2,1))
  +C(L,EL  )*(D(I1,4)*D(I2,5)-D(I1,5)*D(I2,4)))
X M(I1,I2)=MM(I1,I2,L,CC,C)
X MB(I1,I2)=Conjg(MM(I2,I1,L,CC,C))
X P(I1)=CC(R,DN)*D(I1,1)+C(R,EL)*D(I1,4)-C(R,NU)*D(I1,5)
X PB(I1)=Conjg(P(I1))
Z LAGRN=
   -PB(I1)*DSLSH(1,I1,I2)*P(I2)
   -MB(I1,I2)*DSLSH(2,I2,I3)*M(I3,I1)
*yep
Id,Multi,RT12**2=1/2
Al Epf(1,2,3)*Epf(1,2,3)=-1
Al CG(R~,NU~)*G(1,K )*C(L~,EL~)= Conjg(EL)*L*G(1,K)*R*Conjg(NU)
Id CG(R~,NU~)*G(1,K~)*C(L~,EL~)=-Conjg(EL)*L*G(1,K)*R*Conjg(NU)
Id CC(L~,EL~)=L*EL
Al CCG(R~,ELB~)=ELB*R
Al C(L~,EL~)=L*CH*TR*Conjg(EL)
Al CG(R~,ELB~)=Conjg(ELB)*TR*CHG*R
P outp
*yep
F UU=c,UUT=c,U7=c
Oldnew UUTC=UUS,UUC=UUG,U7C=U7G
C T=TRANSPOSE , S=STAR , G=DAGGER=INVERSE
Id UP=UUG*UP
Al UPB=UPB*UU
Al UQ*TR*CHG*R=UP*TR*CHG*U7*UU*R
Al L*CH*TR*UQB=L*UUG*U7G*CH*TR*UPB
Al R*UQ=R*UUT*U7*UP
Al UQB*L=UPB*U7G*UUS*L
Id,Ainbe,UU*UUG=1
Al,Ainbe,UUS*UUT=1
Al,Adiso,U7*U7G=1
*yep
Id L*G(1,Z~)*R=L*G(1,Z)
Al R*G(1,Z~)*L=R*G(1,Z)
Id R*G(1,K)=(1-L)*G(1,K)
Al R*G(1,PH)=(1-L)*G(1,PH)
Al R*G(1,GL)=(1-L)*G(1,GL)
Id NUB*L=0
Al L*G(1,Z)=G(1,Z)*(1+G5(1))/2
Al R*G(1,Z)=G(1,Z)*(1-G5(1))/2
Al ELB*CH*R*G(1,XP)=ELB*CH*(1-L)*G(1,XP)
Al R*G(1,XM)*CH*EL=(1-L)*G(1,XM)*CH*EL
P stat
C FERMION KINETIC TERMS
C   AND FERMION INTERACTIONS WITH GAUGE FIELD
*begin
S HM=c,PHIP=c,F,H0,PHI0,RT12
Oldnew HMC=HP,PHIPC=PHIM
I I1=5,I2=5
Z H(I1)=I*HM*D(I1,1)+I*PHIP*D(I1,4)+RT12*(H0+2*F/GG-I*PHI0)*D(I1,5)
P noutp
*next
C UPB*CH*DN*HM*Epf(1,2,3)=Epf(I1,I2,I3)*UPB(I1)*CH*DN(I2)*HM(I3)   ETC
S L2,M2,GGM2M
B L2,M2,F,HM,HP,PHIP,PHIM,H0,PHI0,GGM2M
F UQB=c
Oldnew UQBC=UQ
F CH=c,TR
F C=c,Cc=c,L=c,UPB=c,DNB=c,ELB=c,NUB=c
Oldnew CC=CG,Cc=CC,CcC=CCG,CHC=CHG
Oldnew LC=R,UPBC=UP,DNBC=DN,ELBC=EL,NUBC=NU
X MM(I1,I2,L,CC,C)=RT12*(
   -C(L,UQ)*(D(I1,1)*D(I2,3)-D(I1,3)*D(I2,1))*Epf(3,2,1)
   +CC(L,UP)*(D(I1,1)*D(I2,4)-D(I1,4)*D(I2,1))
   +CC(L,DN)*(D(I1,1)*D(I2,5)-D(I1,5)*D(I2,1))
  +C(L,EL  )*(D(I1,4)*D(I2,5)-D(I1,5)*D(I2,4)))
X P(I1)=CC(R,DN)*(D(I1,1)+D(I1,3))+C(R,EL)*D(I1,4)-C(R,NU)*D(I1,5)
X PB(I1)=Conjg(P(I1))
X M(I1,I2)=MM(I1,I2,L,CC,C)
X MB(I1,I2)=Conjg(MM(I2,I1,L,CC,C))
Z Z=-L2*(H(I1)*MB(I1,I2)*P(I2)+PB(I1)*M(I1,I2)*Conjg(H(I2)))
Id L2=GG*M2/F
Al CG(R~,UP~)*C(L~,EL~)=Conjg(EL)*L*R*Conjg(UP)
Id CC(L~,EL~)=L*EL
Al CCG(R~,ELB~)=ELB*R
Al C(L~,EL~)=L*CH*TR*Conjg(EL)
Al CG(R~,ELB~)=Conjg(ELB)*TR*CHG*R
Al M2*F**-1=GGM2M/GG
Id,Multi,RT12**2=1/2
P outp
*yep
F UU=c,UUT=c,U7=c
Oldnew UUTC=UUS,UUC=UUG,U7C=U7G
C T=TRANSPOSE , S=STAR , G=DAGGER=INVERSE
Id UP=UUG*UP
Al UPB=UPB*UU
Al UQ*TR*CHG*R=UP*TR*CHG*U7*UU*R
Al L*CH*TR*UQB=L*UUG*U7G*CH*TR*UPB
Id R*R=R
Al L*L=L
Id L*M2=G6(1)/2*M2
Al R*M2=G7(1)/2*M2
Al L*H0=G6(1)/2*H0
Al R*H0=G7(1)/2*H0
Al L*PHI0=G6(1)/2*PHI0
Al R*PHI0=G7(1)/2*PHI0
Id Trick,1
Id Gi(1)=1
P outp
C FERMION HIGGS COUPLING 2
*yep
S FFEPS,EPS,MMW,MMY,HYM,HYP,HWP,HWM
B FFEPS,EPS,F,MMW,MMY,M2,GGM2M
Id HM=FFEPS/MMY*HM+F*HYM/MMY
Al HP=FFEPS/MMY*HP+F*HYP/MMY
Al PHIP=F*PHIP/MMW-2*EPS/MMW*HWP
Al PHIM=F*PHIM/MMW-2*EPS/MMW*HWM
P noutp
*begin
Common Z
S HM=c,PHIP=c,F,H0,PHI0,RT12
Oldnew HMC=HP,PHIPC=PHIM
I I1=5,I2=5,I3=5,I4=5,I5=5
Z H(I1)=I*HM*D(I1,1)+I*PHIP*D(I1,4)+RT12*(H0+2*F/GG-I*PHI0)*D(I1,5)
P noutp
*next
F L1,M1
B F,HM,HP,PHIP,PHIM,H0,PHI0,GG
F UQB=c
Oldnew UQBC=UQ
F CH=c,TR
F C=c,Cc=c,L=c,UPB=c,DNB=c,ELB=c
Oldnew CC=CG,Cc=CC,CcC=CCG,CHC=CHG
Oldnew LC=R,UPBC=UP,DNBC=DN,ELBC=EL
X MM(I1,I2,L,CC,C)=RT12*(
   C(L,UQ  )*(D(I1,1)*D(I2,2)-D(I1,2)*D(I2,1))
  +C(L,UQ  )*(D(I1,2)*D(I2,3)-D(I1,3)*D(I2,2))
  +CC(L,UP  )*(D(I1,2)*D(I2,4)-D(I1,4)*D(I2,2))*Epf(3,2,1)
  +CC(L,UP  )*(D(I1,3)*D(I2,4)-D(I1,4)*D(I2,3))
  +CC(L,DN  )*(D(I1,3)*D(I2,5)-D(I1,5)*D(I2,3))
  +C(L,EL  )*(D(I1,4)*D(I2,5)-D(I1,5)*D(I2,4)))
X M(I1,I2)=MM(I1,I2,L,CC,C)
X MCT(I1,I2)=Conjg(MM(I2,I1,R,C,CC))
Z Z=-Epf(I1,I2,I3,I4,I5)*MCT(I1,I2)*L1*M(I3,I4)*H(I5)
*yep
Id Epf(1,2,3,4,5)=1
Id CG(R~,UP~)*L1~*C(L~,EL~)=Conjg(EL)*L*L1*R*Conjg(UP)
Al CG(R~,DNB)*L1~*CC(L~,UP~)*Epf(1,2,3)=-UP*TR*CHG*L*L1*R*DN*Epf(1,2,3)
Id CC(L~,EL~)=L*EL
Al CCG(R~,ELB~)=ELB*R
Al C(L~,EL~)=L*CH*TR*Conjg(EL)
Al CG(R~,ELB~)=Conjg(ELB)*TR*CHG*R
Id,Multi,RT12**2=1/2
P outp
*yep
F UU=c,UUT=c,U7=c
Oldnew UUTC=UUS,UUC=UUG,U7C=U7G
C T=TRANSPOSE , S=STAR , G=DAGGER=INVERSE
Id L1=UUT*L1*U7*UU
Al UQB*L=UPB*L*U7G*UUS
Al UP*TR*CHG*L=UP*TR*CHG*L*UUS
Al L*CH*TR*UQB=UUG*U7G*L*CH*TR*UPB
Al L*UP=UUG*L*UP
Id,Ainbe,L*L=L
Id UU*UUG=1
Al UUS*UUT=1
Id U7*U7G=1
Id U7G*L1*U7=L1
P noutp
*next
P outp
B F,HM,HP,PHIP,PHIM,H0,PHI0,GGM1M
Z Z=Z+Conjg(Z)
Id UPB*L1*L=UPB*(1-G5(1))/2*L1
Al R*L1*UP=(1+G5(1))/2*L1*UP
Id L1=-GG*M1*RT12/4/F
Id RT12**2=1/2
P outp
C FERMION HIGGS COUPLING 1
*yep
S FFEPS,EPS,MMW,MMY,HYM,HYP,HWP,HWM
B FFEPS,EPS,F,MMW,MMY,GGM1M
C    INCLUDING EXCEEDINGLY SMALL TERMS
Id HM=FFEPS/MMY*HM+F*HYM/MMY
Al HP=FFEPS/MMY*HP+F*HYP/MMY
Al PHIP=F*PHIP/MMW-2*EPS/MMW*HWP
Al PHIM=F*PHIM/MMW-2*EPS/MMW*HWM
*end