C Spinors 1.  e+ e- -> m+ m-. Fermion - anti-fermion scattering, box diagrams.
C Spinors 2.  e+ e- -> m+ m-. Fermion - W diagrams.
C Spinors 3.  Total cross section for e+e- -> mu+mu-. Lowest order, em only.
C Spinors 4.  e+ e- to W+ W-. Part I of two parts.
C Spinors 5.  e+ e- to W+ W-. Part II of two parts.
C Spinors 6.  Electron neutrino scattering.
C Spinors 7.  Electron neutrino(mu) scattering.
C Spinors 8.  Electron neutrino scattering with bremsstrahlung.
C Spinors 9.  Electron neutrino scattering with bremsstrahlung (soft only).
C Spinors 10. Electron neutrino scattering w bremsstrahlung (Green's method).
C Spinors 11. e+ e- to e+ e-, various interactions.
C Spinors 12. K to pi, muon, neutrino with CP violation.
C Spinors 13. Muon decay with CP violation.
C Spinors 14. Muon decay.
C Spinors 15. Neu + e- -> neu + mu- + gam (inv. muon decay, Green's method).
C Spinors 16. Roskies problem (CERN, CDC 6500, 12 April 1972).
C Spinors 17. Production of 3 muons by one muon in Coulomb field.
*end

C Spinors 1. e+ e- -> m+ m-. Fermion - anti-fermion scattering, box diagrams.

P stat
Oldnew,i=I
V   P1,P2,K1,K2
F   Q,V1,V2,V3,V4,FBOX,FBOY,MAS,ALOG2,D27,UNM5,UNM,UEN5,UEN
F   UNN5,UNN,UEE5,UEE
S   SNT,CST,D0,D11,D12,D13,D21,D22,D23,D24,D25,D26
S   M1,M2,M3,M4,M5,M6,MF,ME,MM,DBOX,CRBOX,M0,MC,MP,LCST2,LWCM2
I   MU,MUP,NU,NUP,AL,ALP,BE,BEP
D   DIB(N,M1,M2,M3,M4,M5,M6) =
   (Ubg(I1,M1,P1)*G(I1,MU)*V1*(-I*G(I1,AL)*Q(AL)-I*G(I1,P2)+M5)*G(I1,NU)
   *V2*Ug(I1,M2,P2)*Ubg(I2,M3,K2)*G(I2,NU)*V3*(-I*G(I2,BE)*Q(BE)
   +I*G(I2,K2)+M6)*G(I2,MU)*V4*Ug(I2,M4,K1)*DBOX)   ,
   (Ubg(I1,M1,P1)*G(I1,NU)*V1*(I*G(I1,AL)*Q(AL)+I*G(I1,P1)+M5)*G(I1,MU)
   *V2*Ug(I1,M2,P2)*Ubg(I2,M3,K2)*G(I2,NU)*V3*(-I*G(I2,BE)*Q(BE)
   +I*G(I2,K2)+M6)*G(I2,MU)*V4*Ug(I2,M4,K1)*CRBOX)
P ninput
BLOCK BOXES{}
P ninput
Id,Multi,W2**-2=1/2
Id,Ainbe,DBOX*Q(BE~)*Q(BEP~)=FBOX(P2,P1,BE,BEP)
Al,Ainbe,CRBOX*Q(BE~)*Q(BEP~)=FBOX(P1,P2,BE,BEP)
Id,DBOX*Q(BE~)=FBOY(P2,P1,BE)
Al,CRBOX*Q(BE~)=FBOY(P1,P2,BE)
Id,Ainbe,FBOX(P1~,P2~,BE~,BEP~)*MAS(M1~,M2~)=D27(M1,M2)*D(BE,BEP)
Al,FBOY(P1~,P2~,BE~)=0
Al,DBOX=0
Al,CRBOX=0
Id,6,G5(I1~)*G(I1~,MU~)=-G(I1,MU)*G5(I1)
Al,6,G5(I1~)*G5(I1~)=1
Sum,MU,NU,AL,BE
*yep
B  GG
Id,Gammas,I1,I2
*yep
Id,D27(M1~,MP)=D27(MP,M1)
Al,D27(M0,MC)=D27(MC,M0)
Id,D27(M1~,M1~)=I*PI2/M1/M1/4
Id,D27(MP,M1~)=-(C24(0,M1,0)-I*PI2/2)/M1/M1
Al,D27(MC,M0)=-I*PI2*CST**2/MC**2/SNT**2*ALOG2(CST)/4
Id,C24(0,M1~,0)=I*PI2*DDPI2/4.+3.*I*PI2/8.-I*PI2*ALOG2(M1)/4
Id,ALOG2(M0)=ALOG2(MC)-ALOG2(CST)
Al,Multi,M0**-1=CST/MC

Id,Ubg(I1,0,P1)*G(I1,"S,"5,N1~)*Ug(I1,MM,P2)=-UNM5(N1)
Al,Ubg(I1,0,P1)*G(I1,"S,"4,N1~)*Ug(I1,MM,P2)=UNM(N1)
Al,Ubg(I2,ME,K2)*G(I2,"S,"5,N1~)*Ug(I2,0,K1)=-UEN5(N1)
Al,Ubg(I2,ME,K2)*G(I2,"S,"4,N1~)*Ug(I2,0,K1)=UEN(N1)
Id,Ubg(I1,0,P1)*G(I1,"S,"5,N1~)*Ug(I1,0,P2)=-UNN5(N1)
Al,Ubg(I1,0,P1)*G(I1,"S,"4,N1~)*Ug(I1,0,P2)=UNN(N1)
Al,Ubg(I2,ME,K2)*G(I2,"S,"5,N1~)*Ug(I2,ME,K1)=-UEE5(N1)
Al,Ubg(I2,ME,K2)*G(I2,"S,"4,N1~)*Ug(I2,ME,K1)=UEE(N1)

Id,ALOG2(CST)=LCST2
Al,ALOG2(MC)=LWMC2
Id,VT=4*SNT**2-1
Id,Multi,SNT**2=1-CST**2
Id,Multi,CST**2=1-SNT**2
Keep SOM,BOX
*next
B   GG,I,PI2,MC
Z  SOM=SOM+BOX
Keep SOM
ENDBLOCK
*fix
Z  SOM=0
Keep SOM
*next
C  NM,E - NM,E.   MOMENTA   P(NM)=P2, P(E)=-K1, P(NM)=-P1, P(E)=K2.
C  NOW DIRECT BOX IS 2, CROSSED IS 1.
C  DIRECT BOX, W0,W0 EXCHANGE.
C   D(P1,P2,-K1,-K2,M0,0,M0,ME)
Z   BOX=DIB(2,0,0,ME,ME,0,ME)*MAS(M0,M0)
Id  V1=I*GG*(1+G5(I1))/4/CST
Al  V2=I*GG*(1+G5(I1))/4/CST
Al  V3=I*GG*(VT-G5(I2))/4/CST
Al  V4=I*GG*(VT-G5(I2))/4/CST
BOXES{}
*next
C  NM,E - NM,E.     DIRECT BOX, WC,WC EXCHANGE.
C  D(P1,P2,-K1,-K2,MC,ME,MC,0)
Z   BOX=DIB(2,0,0,ME,ME,ME,0)*MAS(MC,MC)
Id  V1=I*GG*(1+G5(I1))/2/W2
Al  V2=I*GG*(1+G5(I1))/2/W2
Al  V3=I*GG*(1+G5(I2))/2/W2
Al  V4=I*GG*(1+G5(I2))/2/W2
BOXES{}
*next
C  NM,E - NM,E.     CROSSED BOX, W0,W0 EXCHANGE.
C  D(P2,P1,-K1,-K2,M0,0,M0,ME)
Z   BOX=DIB(1,0,0,ME,ME,0,ME)*MAS(M0,M0)
Id  V1=I*GG*(1+G5(I1))/4/CST
Al  V2=I*GG*(1+G5(I1))/4/CST
Al  V3=I*GG*(VT-G5(I2))/4/CST
Al  V4=I*GG*(VT-G5(I2))/4/CST
BOXES{}
*end

C Spinors 2. e+ e- -> m+ m-. Fermion - W diagrams.

P stat
Oldnew,i=I
V   P1,P2,P3,P4,P5
F  Q,V1,V2,V3
S   MF,SNT,CST,DNQ,C21,C22,C23,C24,C11,C12,C0,NM4,R,M1,M2,M3,M4,ME
I    MU,MUP,NU,NUP,AL=R,BE=R,BEP=R
B   SNT
D  DIA(N,M1,M2,M3,M4) =
       (  Ubg(I1,M1,P1)*G(I1,AL)*V1*(-I*G(I1,BE)*Q(BE)+M2)
   *G(I1,MU)*V2*(-I*G(I1,BEP)*Q(BEP)-I*G(I1,P5)+M3)
   *G(I1,AL)*V3*Ug(I1,M4,P2)*DNQ  ),
     ( Ubg(I1,M1,P1)*G(I1,AL)*V1*(I*G(I1,BE)*Q(BE)+I*G(I1,P1)+M2)
      *G(I1,BEP)*V3*Ug(I1,M4,P2)
      *V2*(-D(MU,BEP)*(Q(AL)+2*P5(AL))+D(BEP,AL)*(2*Q(MU)+P5(MU))
       +D(MU,AL)*(P5(BEP)-Q(BEP)))*DNQ   )
BLOCK TREAT{}
Id,MAS(M1~,M2~,M3~)=1
Id,P5(MU~)=P1(MU)+P2(MU)
Al,Funct,P5(MU~)=P1(MU)+P2(MU)
Al,Multi,W2**-2=1/2
Id,Ainbe,DNQ*Q(BE~)*Q(BEP~) = C21*P1(BE)*P1(BEP) + C22*P2(BE)*P2(BEP)
   + C23*(P1(BE)*P2(BEP)+P2(BE)*P1(BEP)) + C24*D(BE,BEP)
Id   DNQ*Q(BE~) = C11*P1(BE) + C12*P2(BE)
Id   DNQ = C0
Id,9,G5(I1)*G(I1,MU~) = - G(I1,MU)*G5(I1)
Al,9,G5(I1)*G5(I1) = 1
*yep
Id   G(I1,AL~)*G(I1,MU~)*G(I1,NU~)*G(I1,NUP~)*G(I1,AL~) =
      - G(I1,AL)*G(I1,MU)*G(I1,NU)*G(I1,AL)*G(I1,NUP)
      + 2*D(AL,NUP)*G(I1,AL)*G(I1,MU)*G(I1,NU)
Id   G(I1,AL~)*G(I1,MU~)*G(I1,NU~)*G(I1,AL~) =
      - G(I1,AL)*G(I1,MU)*G(I1,AL)*G(I1,NU)
      + 2*D(NU,AL)*G(I1,AL)*G(I1,MU)
Id,3,G(I1,AL~)*G(I1,MU~)*G(I1,AL~) = -D(AL,AL)*G(I1,MU)
      + 2*G(I1,AL)*D(MU,AL)
Al,3,G(I1,AL~)*G(I1,AL~) = D(AL,AL)
Id,R**N~*C24 = R**N*(C24-N*IPI2/R/2)
Id,R=4
*yep
B   I,GG,SNT,CST,W2
Id,3,G(I1,MU~)*G(I1,P1) = -G(I1,P1)*G(I1,MU) + 2*P1(MU)
Al,3,Ubg(I1,MF~,P1)*G(I1,P1) = I*MF*Ubg(I1,MF,P1)
Id,4,G(I1,P2)*G(I1,MU~) = - G(I1,MU)*G(I1,P2) + 2*P2(MU)
Al,4,G(I1,P2)*G5(I1) = - G5(I1)*G(I1,P2)
Al,4,G(I1,P2)*Ug(I1,MF~,P2) = I*MF*Ug(I1,MF,P2)
Id   P1DP1*Ubg(I1,MF~,P1) = -MF**2*Ubg(I1,MF,P1)
Al   P2DP2*Ug(I1,MF~,P2) = -MF**2*Ug(I1,MF,P2)
ENDBLOCK
*fix
C  E,E,G.   PHOTON EXCHANGE.  C=C(P1,P2,ME,MP,ME)
Z   VER = DIA(1,-ME,ME,ME,ME)
Id   V1=-I*GG*SNT
Al   V2=-I*GG*SNT
Al   V3=-I*GG*SNT
TREAT{}
*begin
C  E,E,G.   W0 EXCHANGE.   C=C(P1,P2,ME,M0,ME)
Z   VER = DIA(1,-ME,ME,ME,ME)
   *MAS(0,M0,0)
Id   V1=I*GG*(VT-G5(I1))/4/CST
Al   V2=-I*GG*SNT
Al   V3=I*GG*(VT-G5(I1))/4/CST
TREAT{}
*begin
C  E,E,G.   NEUTRINO EXCHANGE.   C=C(P1,P2,MC,0,MC)
Z   VER = DIA(2,-ME,0,ME,ME)
   *MAS(MC,0,MC)
Id   V1=I*GG*(1+G5(I1))/2/W2
Al   V2=I*GG*SNT*I
Al   V3=I*GG*(1+G5(I1))/2/W2
TREAT{}
*begin
C  N,E,W.   ELECTRON EXCHANGE.   C=C(P1,P2,MC,ME,MP)
Z   VER = DIA(2,0,ME,ME,ME)
   *MAS(MC,0,0)
Id   V1 = I*GG*(1+G5(I1))/2/W2
Al   V2 = I*GG*SNT*I
Al   V3 = - I*GG*SNT
TREAT{}
*begin
C   N,E,W.   ELECTRON EXCHANGE.   C=C(P1,P2,MC,ME,M0)
Z   VER = DIA(2,0,ME,ME,ME)
   *MAS(MC,0,M0)
Id   V1 = I*GG*(1+G5(I1))/2/W2
Al   V2 = I*GG*CST*I
Al   V3 = I*GG*(VT-G5(I1))/4/CST
TREAT{}
*begin
C  N,E,W.   NEUTRINO EXHANGE.  C=C(P1,P2,M0,0,MC)
Z   VER = DIA(2,0,0,0,ME)
    *MAS(M0,0,MC)
Id   V1 = I*GG*(1+G5(I1))/4/CST
Al   V2 = - I*GG*CST*I
Al   V3 = I*GG*(1+G5(I1))/2/W2
TREAT{}
*begin
C  N,E,W.   W0 EXCHANGE.   C=C(P1,P2,0,M0,ME)
Z   VER = DIA(1,0,0,ME,ME)
   *MAS(0,M0,0)
Id   V1 = I*GG*(1+G5(I1))/4/CST
Al   V2 = I*GG*(1+G5(I1))/2/W2
Al   V3 = I*GG*(VT-G5(I1))/4/CST
TREAT{}
*begin
C  E,E,W0.   PHOTON EXCHANGE.   C=C(P1,P2,ME,MP,ME)
Z   VER = DIA(1,-ME,ME,ME,ME)
Id   V1=-I*GG*SNT
Al   V2 = I*GG*(VT-G5(I1))/4/CST
Al   V3=-I*GG*SNT
TREAT{}
*begin
C  E,E,W0.   W0 EXCHANGE.   C=C(P1,P2,ME,M0,ME)
Z   VER = DIA(1,-ME,ME,ME,ME)
    *MAS(0,M0,0)
Id   V1=I*GG*(VT-G5(I1))/4/CST
Al   V2 = I*GG*(VT-G5(I1))/4/CST
Al   V3=I*GG*(VT-G5(I1))/4/CST
TREAT{}
*begin
C  E,E,W0.   NEUTRINO EXCHANGE.   C=C(P1,P2,MC,0,MC)
Z   VER = DIA(2,-ME,0,ME,ME)
   *MAS(MC,0,MC)
Id   V1=I*GG*(1+G5(I1))/2/W2
Al   V2=I*GG*CST*I
Al   V3=I*GG*(1+G5(I1))/2/W2
TREAT{}
*begin
C   E,E,W0.   CHARGED W EXCHANGE.   C=C(P1,P2,0,MC,0)
Z   VER = DIA(1,-ME,0,0,ME)
   *MAS(0,MC,0)
Id   V1 = I*GG*(1+G5(I1))/2/W2
Al   V2 = I*GG*(1+G5(I1))/4/CST
Al   V3 = I*GG*(1+G5(I1))/2/W2
TREAT{}
*begin
C   N,N,W0.   W0 EXCHANGE.   C=C(P1,P2,0,M0,0)
Z   VER = DIA(1,0,0,0,0)
   *MAS(0,M0,0)
Id   V1 = I*GG*(1+G5(I1))/4/CST
Al   V2 = I*GG*(1+G5(I1))/4/CST
Al   V3 = I*GG*(1+G5(I1))/4/CST
TREAT{}
*begin
C   N,N,W0.   CHARGED W EXCHANGE.   C=C(P1,P2,ME,MC,ME)
Z   VER = DIA(1,0,ME,ME,0)
   *MAS(0,MC,0)
Id   V1 = I*GG*(1+G5(I1))/2/W2
Al   V2 = I*GG*(VT-G5(I1))/4/CST
Al   V3 = I*GG*(1+G5(I1))/2/W2
TREAT{}
*begin
C   N,N,W0.   ELECTRON EXCHANGE.   C=C(P1,P2,MC,ME,MC)
Z   VER = DIA(2,0,ME,ME,0)
   *MAS(MC,0,MC)
Id   V1 = I*GG*(1+G5(I1))/2/W2
Al   V2 = - I*GG*CST*I
Al   V3 = I*GG*(1+G5(I1))/2/W2
TREAT{}
*begin
C  N,N,G.   CHARGED W EXCHANGE.   C=C(P1,P2,ME,MC,ME)
Z   VER = DIA(1,0,ME,ME,0)
   *MAS(0,MC,0)
Id   V1 = I*GG*(1+G5(I1))/2/W2
Al   V2 = - I*GG*SNT
Al   V3 = I*GG*(1+G5(I1))/2/W2
TREAT{}
*begin
C   N,N,G.   ELECTRON EXCHANGE.   C=C(P1,P2,MC,ME,MC)
Z   VER = DIA(2,0,ME,ME,0)
   *MAS(MC,0,MC)
Id   V1 = I*GG*(1+G5(I1))/2/W2
Al   V2 = - I*GG*SNT*I
Al   V3 = I*GG*(1+G5(I1))/2/W2
TREAT{}
*end

C Spinors 3. Total cross section for e+e- -> mu+mu-. Lowest order, em only.

P stat
C  TOTAL CROSS SECTION FOR  E+E- GOING INTO MU+MU-
C  MOMENTA -    E-   P2,  E+  P1,  MU-  P3,  MU+  P4.   ALL MOMENTA INGO
C  S = - (P1+P2)**2,   T = - (P2+P3)**2 .  E = ELECTRON ENERGY.
C  COS = COSINUS OF THE ANGLE BETWEEN ELECTRON AND MUON DIRECTION.
F  DIA=u
V   P1,P2,P3,P4
S  S,T,V,E,COST,ACH
I   MU,MUP
C  SIGMA = TOTAL CROSS SECTION
Z  SIGMA=V**4/64/TP**9/E**2/4
  *DIA(I1,I2,MU)*Conjg(DIA(I3,I4,MUP))*ACH
C  V = VOLUME, TP = TWO PI.
C  ACH IS A VARIABLE USED IN THE INTEGRATION OVER COS.
C  EC = ELECTRIC CHARGE.
C  DIA = LOWEST ORDER DIAGRAM, WITH ONE PHOTON.
Id  DIA(I1~,I2~,MU~)=TP**4*i*EC**2/V**2/S*
  Ubg(I1,0,-P3)*G(I1,MU)*Ug(I1,0,-P4)
   *Ubg(I2,0,P1)*G(I2,MU)*Ug(I2,0,P2)
C  DO SUMMATION OVER SPINS.
Id  Spin,I1,I2
C  TAKE TRACES.
Id    Trick,Trace,I1,I2
C  KINEMATIC IDENTITIES. ELECTRON AND MUON MASS ARE NEGLECTED.
Id  P2DP3=P1DP4
Al  P2DP4=P1DP3
Al  P3DP4=P1DP2
Id  P1DP4=-0.5*T
Al  P1DP3=0.5*(S+T)
Al  P1DP2=-0.5*S
P output
*yep
Id  S=4*E**2
Al  Multi,S**-1=0.25*E**-2
Al   T=2*E**2*(COST-1)
C  INTEGRATION OVER COS
Id  COST**2*ACH=2/3
Al  COST*ACH=0
Al  ACH=2
*end

C Spinors 4. e+ e- to W+ W-. Part I of two parts.

C This program writes common file Ewcom. The program in the next example
C  uses this file.

P stat
Common MA2
S EC,GG,PR1,PR2,PR3,SI,M,FS2,ACH,LA,LOG,OMK
C OMK = 1 - Magn. Moment.
S E,R,COST
C FS2 = 4*SI**2 - 1
F AM=u
V K1,K2,P,Q,K
I I1,I2,MU,GA,BE,MUP,GAP,BEP
B EC,GG,PR1,PR2,PR3

Z MA2 = 0.25*AM(I1,MU,GA,BE)*Conjg(AM(I2,MUP,GAP,BEP))
	*{D(GA,GAP) + P(GA)*P(GAP)/M**2}*{D(BE,BEP) + Q(BE)*Q(BEP)/M**2}
	*ACH

Id,AM(I1~,MU~,GA~,BE~) =
	{(-i*EC**2)*PR1*Ubg(I1,0,K2)*G(I1,MU)*Ug(I1,0,K1)
	 + (i*GG**2)*PR2/4*Ubg(I1,0,K2)*G(I1,MU)*(FS2-G5(I1))*
	 Ug(I1,0,K1) }*
	{ - D(GA,MU)*(P(BE)+K(BE)) +D(BE,GA)*(P(MU)-Q(MU)) +
	D(MU,BE)*(K(GA)+Q(GA)) + OMK*(D(MU,GA)*K(BE)-D(BE,MU)*K(GA)) }
	+ (i*GG**2)*PR3/8*Ubg(I1,0,K2)*G(I1,GA)*G6(I1)*
	(G(I1,K1)-G(I1,Q))*G(I1,BE)*G6(I1)*Ug(I1,0,K1)

Id,Spin,I1,I2
Id,Trick,Trace,I1,I2

Id,K1DK1=0
Al,K2DK2=0
Id,KDK=-4*E**2
Al,KDK1=-2*E**2
Al,KDK2=-2*E**2
Al,KDQ=-2*E**2
Al,KDP=-2*E**2
Al,K1DK2=-2*E**2
Id,PDP=-M**2
Al,QDQ=-M**2
Id,QDK1=PDK2
Al,QDK2=PDK1
*yep
B EC,GG,PR1,PR2,PR3
Id,PDQ=M**2-2*E**2
Al,PDK2=-E**2+E**2*R*COST
Al,PDK1=-E**2-E**2*R*COST
*yep
C Integration over angles.

Id,5,PR3**N1~*COST**N2~=0.5*LA/R*PR3**N1*COST**N2/COST -
	PR3**N1/PR3*COST**N2/COST*0.5*E**-2/R
C LA = 1+R**2

*yep

Id,COST**5=0
Al,COST**4=0.4/ACH
Al,COST**3=0
Al,COST**2=2/3/ACH
Id,COST=0

Id,PR3**2=2*M**-4/ACH
Id,PR3=LOG*E**-2/R/ACH
Id,ACH=2
C LOG=LOG(ABS((1+R)/(U-R)))
Id,LA=1+R**2
*begin
Write Ewcom
*end

C Spinors 5. e+ e- to W+ W-. Part II of two parts.

C The file Ewcom is supposed to have been made by the first part.

Enter Ewcom
*fix
S M,LOG
C E,M,M0,LOG,R,OMK

D QU(N)=100,62,78.465,2.11446222,0.7846,0

Z SIGMA=MA2*R*E**-2*1.973*1.973*1.E5/402.1238597

Id,FS2=4*1444/(QU(2))**2-1
Al,Multi,EC**2=0.091725
Al,Multi,GG**2=0.091725*QU(2)*QU(2)/1444
Al,E=QU(1)
Al,Multi,E**-1=(QU(1))**-1
Al,M=QU(2)
Al,Multi,M**-1=(QU(2))**-1
Al,LOG=QU(4)
Al,R=QU(5)
Al,OMK=QU(6)
Id,PR1=-(2*QU(1))**-2*AG
Al,PR2=(-4*(QU(1))**2+(QU(3))**2)**-1*W0
P output
*yep
Id,AG=1
Al,W0=1
*end

C Spinors 6. Electron neutrino scattering.

P stat
F  AM=u
V  Q,K,P,PA
S  GA,GV,M,EN,EE,EN
I  MU,MUP,I1,I2,I3,I4
B  EE,EN
Z  SIGM=AM(I1,I2,MU)*Conjg(AM(I3,I4,MUP))
Id  AM(I1~,I2~,MU~)=Ubg(I1,M,PA)*G(I1,MU)*(GV+GA*G5(I1))*Ug(I1,M,P)
  * Ubg(I2,0,K)*G(I2,MU)*G6(I2)*Ug(I2,0,Q)
Id  Spin,I1,I2,I3,I4
Id  Trick,Trace,I1,I2,I3,I4
Id  PADPA=-M**2
Al  PDP=-M**2
Al  KDK=0.
Al  QDQ=0.
*yep
Id  QDPA=KDPA-QDK
Id  PDK=PDQ-M**2-PDPA
Al  QDK=M**2+PDPA
Al  KDPA=QDP
Id  QDP=-EN*M
Al  PDPA=-EE*M
*end

C Spinors 7. Electron neutrino(mu) scattering.

P stat
C  ELECTRON, NEUTRINO(MU)  ---  ELECTRON, NEUTRINO(MU).
V   Q,R,P,PP,K
I   MU,AL,MUP,ALP
F   DIA=u
S  FACT,ME,VT,VT2,VTB,VTB2
S   QL,PL,KL,X,K0,PPL,PP0,SQRX,SQRZ,CSF,ECM,KAP
B  FACT,VT,ME,INT
X   VER(N)=1-(-1)**N
C   FACT=(2.*PI)**-2*GG**4/(16.*CST2*W0M**2)**2
Z  AMPL2=0.5*FACT*DIA(MU)*Conjg(DIA(MUP))
C   0.5 FOR AVERAGING INITIAL ELECTRON SPIN. NOT SO FOR NEUTRINO.
Id   DIA(MU~) = Ubg(I1,0,R)*G(I1,MU)*G6(I1)*Ug(I1,0,Q)
     *Ubg(I2,ME,PP)*(G(I2,MU)*(AA+BB*G5(I2)))*Ug(I2,ME,P)
Id,Spin,I1,I2
Id,Trick,Trace,I1,I2
Id   PDP=-ME**2
Al   PPDPP=-ME**2
Al   QDQ=0
Al   RDR=0
Al   KDK=0
Id,AA=AA+AAA*AK2
Al,BB=BB+BBB*AK2
Id,AK2**2=0.
Id,AK2=-2.*QDR
*yep
Id,R(MU~)=Q(MU)+P(MU)-PP(MU)
Al,Dotpr,R(MU~)=Q(MU)+P(MU)-PP(MU)
Al,Funct,R(MU~)=Q(MU)+P(MU)-PP(MU)
Id   PDP=-ME**2
Al   PPDPP=-ME**2
Al   QDQ=0
Al   KDK=0
*yep
B  FACT,AA,AAA,BB,BBB
Id  QDPP=-ME**2+QDP-PDPP
Id,QDP=-QL*ECM
Al,PDPP=-OPX*QL**2-ME**2
Id,5,Multi,ECM**2=2.*ECM*QL+ME**2
C  IN FORTRAN PROGRAM MAKE
C  FACT=FACT*QL/ECM*PI/2
P output
*yep
B  FACT,AA,AAA,BB,BBB
Id,OPX=1.+X
Id   FACT=FACT*X
Id   X**N~=VER(N)/N
C *end
C *   YEP
C B   PIF,FACT,PDK,PPDK
C Id,QL=ECM/2-ME**2/2/ECM
C Al,Multi,QL**-1=ME**2/ECM**2/QL + 2/ECM
C Al,PP0=0.5*ECM+ME**2/2/ECM
C Id   PPL**2=PP0**2-ME**2
C Al,PPL=0.5*ECM - ME**2/2/ECM
C *yep
C V   FA
C B  FA(2),FA(4),FA(6),FA(10),FA(1),DIFZI,ALOZI,DIFXI,ALOXI,KLM1
C    ,FA(8),RAT,CC,CD,PPL,ECM
C     ,AA,BB
C     ,AAA,BBB
C Id,FACT*PI*ME**N~=FA(N)*RAT
C C   RAT=(2.*PI)**3/(PI*GG2*SNT2)
C Id,FACT*PI=FA(1)*RAT
C Id,ECM**2=ECM2
C Al,ECM**3=ECM3
C Al,ECM**4=ECM4
C Id,ECM**-1=EMM1
C Al,ECM**-2=EMM2
C Al,ECM**-3=EMM3
C Al,ECM**-4=EMM4
C Al,ECM**-5=EMM5
C Al,ECM**-6=EMM6
C Id,KL**-1=KLM1
C Al,VT**2=VT2
C Al,QL**-1=QLM1
C Id,VTB**2=VTB2
*end

C Spinors 8. Electron neutrino scattering with bremsstrahlung.

P stat
C  ELECTRON, NEUTRINO(MU)  ---  ELECTRON, NEUTRINO(MU), PHOTON.
V   Q,R,P,PP,K
I   MU,AL,MUP,ALP
F   DIA=u
S   FACT,ME,VT
S   QL,PL,KL,X,K0,PPL,PP0,SQRX,SQRZ,CSF,ECM,KAP
B  FACT,VT,ME,INT
X   VER(N)=1-(-1)**N
X  COEF(N)=N
X  POW(A,M)=A**M
D  VERH(M,N,XMA,X,A) = (POW(A,N-M+1)/XMA+POW(A,N-M)*DS(J,0,N-1,(X**J/
          A**J))),
      (POW(A,N-M+2)/XMA**2 + POW(A,N-M+1)*N/XMA
          + POW(A,N-M)*DS(K,0,N-2,(X**K/A**K*COEF(N-K-1))))
C  VERH = X**N/(X-A)**M
C   FACT=(2*PI)**-5*GG**6*SNT**2/(16*CST2*W0M**2)**2
Z   AMPL2 = 0.5*FACT*DIA(MU,AL)*Conjg(DIA(MUP,AL)) *INT
C   0.5 FOR AVERAGING INITIAL ELECTRON SPIN. NOT SO FOR NEUTRINO.
Id  DIA(MU~,AL~) = Ubg(I1,0,R)*G(I1,MU)*G6(I1)*Ug(I1,0,Q)
      *Ubg(I2,ME,PP)*(
          G(I2,AL)*(-i*G(I2,K)-i*G(I2,PP)+ME)/2/KDPP*G(I2,MU)
          *(VT-G5(I2))
  -G(I2,MU)*(VT-G5(I2))*(-i*G(I2,P)+i*G(I2,K)+ME)/2/PDK*G(I2,AL)
      )*Ug(I2,ME,P)
Id,Spin,I1,I2
Id,Trick,Trace,I1,I2
Id   PDP=-ME**2
Al   PPDPP=-ME**2
Al   QDQ=0
Al   RDR=0
Al   KDK=0
*yep
Id,R(MU~)=Q(MU)+P(MU)-PP(MU)-K(MU)
Al,Dotpr,R(MU~)=Q(MU)+P(MU)-PP(MU)-K(MU)
Al,Funct,R(MU~)=Q(MU)+P(MU)-PP(MU)-K(MU)
Id   PDP=-ME**2
Al   PPDPP=-ME**2
Al   QDQ=0
Al   KDK=0
*yep
B  FACT,VT,ME
Id   QDPP=-ME**2+QDP-QDK-PDPP-PDK+PPDK
*yep
B   PIF,FACT,PDK,PPDK
Id,FACT=FACT*PI/4
Id,QDP=-QL*ECM
Al,QDK=QL*KL*X-QL*KL
Al   PDPP=-QL*PPL*X*Z-QL*PPL*SQRX*SQRZ*CSF -PP0*P0
Al   PDK=-QL*KL*X-P0*KL
Al   PPDK=PPL*KL*Z-PP0*KL
Id,Epf(Q,P,PP,K)=0
Id   CSF**3=0.
Al   CSF**2*INT=PIF
Al   CSF**1=0
Id   INT=2*PIF
Id   SQRX**2=1-X**2
Al   SQRZ**2=1-Z**2
Id,Z=-EP*(ECM-KL)/PPL
C  PP0 = KAP/2/(ECM-K0) + KL*EP .  THIS DEFINES EP.
C  KAP = (ECM-K0)**2+ME**2-KL**2
Id,Multi,PPL**2=PP0**2-ME**2
Id,MP=0
*yep
S   PDKN
B  PI,FACT,PPDK,DIFF,ALOGD
Id,Multi,PDK**-1=-PDKN**-1/QL/KL
C  PDKN=X-BA
C   BA=-P0*K0/(QL*KL)
Id,PDKN**M~*X**N~=VERH(-M,N,PDKN,X,BA)
Id,PIF*PDKN**-2=-QL*KL*DIFF*PI
C   DIFF=1/(P0*K0+QL*KL) - 1/(P0*K0-QL*KL)
Al,PIF*PDKN**-1=ALOGD*PI
C  ALOGD=LOG((P0*K0+QL*KL)/(P0*K0-QL*KL))
Id,PIF=PIF*X
Id,PIF*X**N~=VER(N)*PI/N
Id,BA=-P0*KL/QL/KL
Id,K0=KL
Id,Multi,P0**2=QL**2+ME**2
*yep
B  PI,FACT,DIFF,ALOGD,ALOGE,DIFP,ME,VT,KL
N   7
V   U
S  PPDKN
C  NEW INTEGRATION VARIABLE  PP0=PP0A+KL*EP
Id,FACT=KL*FACT*PINT
Id,PP0**2=PP0A**2+KL**2*EP**2+2*PP0A*KL*EP
Al,PP0=PP0A+KL*EP
Id,Multi,PPDK**-1=-PPDKN**-1/ECM/KL
C  PPDKN=EP-BA
Id,PPDKN**M~*EP**N~=VERH(-M,N,PPDKN,EP,BA)
C   BA=-K0*PP0A/(ECM*KL)
Id,PINT*PPDKN**-2=-ECM*KL*DIFP
C  DIFP=1/(ECM*KL*EPMAX+K0*PP0A) - 1/(ECM*KL*EPMIN+K0*PP0A)
Al,PINT*PPDKN**-1=ALOGE
C  ALOGE=LOG((ECM*KL*EPMAX+K0*PP0A)/(ECM*KL*EPMIN+K0*PP0A))
Id,PINT=PINT*EP
Id,PINT*EP**N~=U(N)/N
C  U(N)=EPMAX**N-EPMIN**N
Id,BA=-K0*PP0A/ECM/KL
Id,K0=KL
Id,5,Once,ECM**2=2.*ECM*QL+ME**2
Al,P0**2=QL**2+ME**2
*yep
C  N   7
V   FA
B  FA(1),FA(2),FA(4),FA(6),FA(8),FA(10),VT,VT2,KL,KLM1,KLP2
    ,DIFF,ALOGD,ALOGE,DIFP
Id,FACT*PI**2*ME**N~=FA(N)
Id,FACT*PI**2=FA(1)
Id,ECM**2=ECM2
Al,ECM**3=ECM3
Al,ECM**4=ECM4
Id,ECM**-1=EMM1
Al,ECM**-2=EMM2
Al,ECM**-3=EMM3
Al,ECM**-4=EMM4
Al,ECM**-5=EMM5
Al,ECM**-6=EMM6
Id,KL**-1=KLM1
Al,VT**2=VT2
Al,QL**-1=QLM1
Al,KL**2=KLP2
Al,PP0A**2=PP0A2
Punch AMPL2
*end

C Spinors 9. Electron neutrino scattering with bremsstrahlung (soft only).

P stat
C  ELECTRON, NEUTRINO(MU)  ---  ELECTRON, NEUTRINO(MU), PHOTON.
C  APPROXIMATE CASE (NO K DEPENDENCE IN DELTA FUNCTION).
V   Q,R,P,PP,K
I   MU,AL,MUP,ALP
F   DIA=u
S   FACT,ME,VT
S   QL,PL,KL,X,K0,PPL,PP0,SQRX,SQRZ,CSF,ECM,KAP
B  FACT,VT,ME,INT
X   VER(N)=1-(-1)**N
X  COEF(N)=N
X  POW(A,M)=A**M
D  VERH(M,N,XMA,X,A) = (POW(A,N-M+1)/XMA+POW(A,N-M)*DS(J,0,N-1,(X**J/
          A**J))),
      (POW(A,N-M+2)/XMA**2 + POW(A,N-M+1)*N/XMA
          + POW(A,N-M)*DS(K,0,N-2,(X**K/A**K*COEF(N-K-1))))
C  VERH = X**N/(X-A)**M
C   FACT=(2*PI)**-5*GG**6*SNT**2/(16*CST2*W0M**2)**2
Z   AMPL2 = 0.5*FACT*DIA(MU,AL)*Conjg(DIA(MUP,AL)) *INT
C   0.5 FOR AVERAGING INITIAL ELECTRON SPIN. NOT SO FOR NEUTRINO.
Id  DIA(MU~,AL~) = Ubg(I1,0,R)*G(I1,MU)*G6(I1)*Ug(I1,0,Q)
      *Ubg(I2,ME,PP)*(-i*PP(AL)/KDPP + i*P(AL)/KDP)*G(I2,MU)*(VT-G5(I2))
      *Ug(I2,ME,P)
Id,Spin,I1,I2
Id,Trick,Trace,I1,I2
Id   PDP=-ME**2
Al   PPDPP=-ME**2
Al   QDQ=0
Al   RDR=0
Al   KDK=0
*yep
Id,R(MU~)=Q(MU)+P(MU)-PP(MU)
Al,Dotpr,R(MU~)=Q(MU)+P(MU)-PP(MU)
Al,Funct,R(MU~)=Q(MU)+P(MU)-PP(MU)
Id   PDP=-ME**2
Al   PPDPP=-ME**2
Al   QDQ=0
Al   KDK=0
*yep
B  FACT,VT,ME
Id  QDPP=-ME**2+QDP-PDPP
*yep
B   PIF,FACT,PDK,PPDK
Id,QDP=-QL*ECM
Al   PDPP=-QL*PPL*X*Z-QL*PPL*SQRX*SQRZ*CSF -PP0*(ECM-QL)
Id   CSF**3=0.
Al   CSF**2*INT=PIF
Al   CSF**1=0
Id   INT=2*PIF
Id   SQRX**2=1-X**2
Al   SQRZ**2=1-Z**2
*yep
S   PPDKN,PDKN
Id,FACT=FACT*KL*PPL/ECM*PI/4
Id,Multi,PPDK**-1=PPDKN**-1/PPL/KL
C  PPDKN=Z-PP0*K0/PPL/KL
Id,PPDKN**M~*Z**N~=VERH(-M,N,PPDKN,Z,BA)
Id,PIF*PPDKN**-2=-PPL*KL*DIFZI*PI
C  DIFZI=1/(PPL*KL+PP0*K0) + 1/(PPL*KL-PP0*K0)
Al,PIF*PPDKN**-1=ALOZI*PI
C  ALOZI=LOG((PP0*K0-PPL*KL)/(PP0*K0+PPL*KL))
Id,PIF=PIF*Z
Id,PIF*Z**N~=VER(N)/N*PI
Id,BA=PP0*K0/PPL/KL
Id,Multi,PP0**2=PPL**2+ME**2
*yep
Id,Multi,PDK**-1=-PDKN**-1/QL/KL
C  PDKN=X+P0*K0/(QL*KL)
Id,PDKN**M~*X**N~=VERH(-M,N,PDKN,X,BA)
Id,FACT=FACT*XIN
Id,XIN*PDKN**-2=-QL*KL*DIFXI
C  DIFXI=1/(P0*K0+QL*KL)-1/(P0*K0-QL*KL)
Al,XIN*PDKN**-1=ALOXI
C  ALOXI=LOG((P0*K0+QL*KL)/(P0*K0-QL*KL))
Id,XIN=XIN*X
Id,XIN*X**N~=VER(N)/N
Id,BA=-P0*K0/QL/KL
Id,K0=KL
*yep
B   DIFZI,ALOZI,DIFXI,ALOXI,FACT,PI,ME
Id,P0=ECM-QL
Al,PP0=ECM-QL
Al,PPL=QL
Al,Multi,PPL**-1=QL**-1
Id,5,Once,ECM**2=2.*ECM*QL+ME**2
*yep
V   FA
B  FA(2),FA(4),FA(6),FA(10),FA(1),DIFZI,ALOZI,DIFXI,ALOXI,KLM1
Id,FACT*PI**2*ME**N~=FA(N)
Id,FACT*PI**2=FA(1)
Id,ECM**2=ECM2
Al,ECM**3=ECM3
Al,ECM**4=ECM4
Id,ECM**-1=EMM1
Al,ECM**-2=EMM2
Al,ECM**-3=EMM3
Al,ECM**-4=EMM4
Al,ECM**-5=EMM5
Al,ECM**-6=EMM6
Id,KL**-1=KLM1
Al,VT**2=VT2
Al,QL**-1=QLM1
*end

C Spinors 10. Electron neutrino scattering w bremsstrahlung (Green's method).
C M. Green, J. Phys. G: Nucl Phys. 7(1981)1169. See also inv. muon decay.

P stat

C Electron + Neutrino(mu) --> Electron + Neutrino(mu) + Photon.

C Momenta: P,q to p,r,k
  q,r neutrino's, P electron, p electron, k photon.
  M electron mass.
  ql is the length of the three-dimensional part of q.
  ql = E/2 - M**2/E/2

V   r,q,p,P,k
I   MU,AL,MUP,ALP
F   DIA=u,LogX,LogY,LogYu,LogYp
S   a,b,M,ql,X,Y,E

B  X,Y

C   FACT=(2*PI)**-5*GG**6*SNT**2/(16*CST2*W0M**2)**2

Z   Ampl2 = 0.5*DIA(MU,AL)*Conjg(DIA(MUP,AL))

C   0.5 FOR AVERAGING INITIAL ELECTRON SPIN. NOT SO FOR NEUTRINO.

Id DIA(MU~,AL~) = -Ubg(I1,0,r)*G(I1,MU)*G6(I1)*Ug(I1,0,q)
    *Ubg(I2,M,p)*(
    G(I2,AL)*(-i*G(I2,k)-i*G(I2,p)+M)/2/om/Y*G(I2,MU)
             *(a*G6(I2)+b*G7(I2))
   -G(I2,MU)*(a*G6(I2)+b*G7(I2))*(-i*G(I2,P)+i*G(I2,k)+M)/2/om/X*G(I2,AL)
      )*Ug(I2,M,P)

Id,Spin,I1,I2
Id,Trick,Trace,I1,I2
Id,PDP=-M**2
Al,pDp=-M**2
Id,qDq=0
Al,rDr=0
Al,kDk=0
Id,Addfa,om**2
*yep

B  X,Y

Id,r(MU~)=q(MU)+P(MU)-p(MU)-k(MU)
Al,Dotpr,r(MU~)=q(MU)+P(MU)-p(MU)-k(MU)
Al,Funct,r(MU~)=q(MU)+P(MU)-p(MU)-k(MU)
Id,qDq=0
Al,kDk=0
*yep

B   PI,X,Y

Id,Addfa,PI/4/E/ql
Id,qDp = - PDp - om*Y + om*E + E*ql - E**2
Id,qDP = -ql*E
Al,PDP = 2*ql*E-E**2
Al,pDp = 2*ql*E-E**2
Al,qDk = om*(X-E)
Al,PDp = X*Y*(1-om/E) + Y*(ql-E) + X*{om + ql - E} - wt*CSF
Al,PDk = - om*X
Al,pDk = - om*Y

*yep
Id,CSF**1=0
Al,CSF**3=0.

IF NOT CSF**2=PI
Id,Addfa,2*PI
ENDIF

Id,Multi,wt**2=(X-E)*(X-E+2*ql)*(Y-E)*
 {Y*(E-2*om)-E*(E-2*ql)}/E

*yep

IF NOT X**-1=LogX
AND NOT X**-2=2*ql/M**2
AND NOT X**n~=E**(n+1)/(n+1) - (E-2*ql)**(n+1)/(n+1)
Id,Addfa,2*ql
ENDIF

*yep

IF Y^n~
Id,Y**-1=LogY
Al,Y**-2=Sty*(1-2*om/E)/M**2
Id,Y**2={E**2-2*E*ql+4*ql**2/3 +
 0.5*om*M**2*omMhE**-2/E*{4*(E-ql)*(E-om)-E**2}/3}*Sty
Al,Y**1={E-ql-0.5*om*(E-2*ql)*omMhE**-1}*Sty
ELSE
Id,Addfa,Sty
ENDIF

Id,Sty=2*ql+om*M**2*omMhE**-1/E

*yep
IF NOT om**0*LogY=LogYp	!LogYp = Log(1-2*om/E)
Id,Addfa,1-soft
ENDIF

Id,soft*om**n~=0
Al,soft=1
Id,Addfa,om**-1

*yep
C LogYu = Log( E*(E-2*omu)/M**2 )
Id,om**n~*LogY=omu**(n+1)/(n+1)*LogYu - om**(n+1)/(n+1)*omMhE**-1
Id,Ratio,omMhE,om,hE
Id,hE=E/2
Al,Multi,hE**-1=2/E

*yep
B PI
IF NOT LogYp
AND NOT LogYu
AND NOT omMhE**-1=-LogX
AND NOT omMhE**n~=(-2*E/M**2)**(-n-1)/(n+1)
 - (-2/E)**(-n-1)/(n+1)
AND NOT om**n~=omu**(n+1)/(n+1)
AND NOT LogY=0.5*E*LogX - omu
Id,Addfa,omu
ENDIF

*yep
Id,omu=ql
Al,LogYu=0
Al,LogYp*om**-1=-Sp(tqldE)	! tqldE = 2*ql/E
Id,Multi,M**2=E**2-2*ql*E
P output

*yep
N 28,R23
Id,a=vt/2-1/2
Al,b=vt/2+1/2
*end

C Spinors 11. e+ e- to e+ e-, various interactions.

P stat
V K1,K2,P,Q
S AC,EC,GA,GV,GS,GP,BW1=c,BW2=c
S GGV,GGS,COS,A
B AC,EC,A
S X,Y
F DIA=u,AMP=u,DIB=u

Z MAT2= AMP(I1,I2,MU)*Conjg(AMP(I3,I4,NU))*A/4

Id,AMP(I1~,I2~,MU~)=
	AC**2*S**-2*Ubg(I1,0,K2)*G(I1,MU)*Ug(I1,0,K1)
		*Ubg(I2,0,Q)*G(I2,MU)*Ug(I2,0,P)

	+ 2*S**-2*EMC**-1*EC**2*DIA(I1,I2,(G(I1,MU)),(G(I2,MU)))

	- GGV**2*BW1*DIB(I1,I2,(G(I1,MU)*GV+G(I1,MU)*G5(I1)*GA),
		(G(I2,MU)*GV+G(I2,MU)*G5(I2)*GA) )

	+ GGS**2*BW2*DIB(I1,I2,(GS+i*GP*G5(I1)),(GS+i*GP*G5(I2)))

Id,DIA(I1~,I2~,X~,Y~)=
	Ubg(I1,0,K2)*Gi(I1)*X*Ug(I1,0,P) * Ubg(I2,0,Q)*Gi(I2)*Y*Ug(I2,0,K1)

Id,DIB(I1~,I2~,X~,Y~)=
	Ubg(I1,0,K2)*Gi(I1)*X*Ug(I1,0,K1) * Ubg(I2,0,Q)*Gi(I2)*Y*Ug(I2,0,P)

Id,Spin,I1,I2,I3,I4
Id,Trick,Trace,I1,I2,I3,I4
Id,K1DK1=0
Al,PDP=0
Al,QDQ=0
Id,PDK2=-S**2*EMC/4
Al,PDK1=-S**2*EPC/4
Al,QDK1=-S**2*EMC/4
Al,QDK2=-S**2*EPC/4
Al,K1DK2=-S**2/2
Al,PDQ=-S**2/2
Id,GGV=1
Al,GGS=1
P output
*yep
B EMC,EPC,A
Id,AC=EC
P output
*yep
B EMC,COS,A
Id,EMC=1-COS
Al,EPC=1+COS
P output
*yep
Id,COS=1-EMC
Id,EMC=1-COS
P output
*yep
C Integrate COS from -0.6 to 0.6

N 5,R0
Id,A*EMC**-2=5/2-1/1.6
Al,A*EMC**-1=1.3863
Al,A*COS**2=0.432/3
Al,A*COS=0.
Al,A=1.2
*end

C Spinors 12. K to pi, muon, neutrino with CP violation.

P stat
C K to PI, MU, NU
F Dia=u
S LA=c,KSI=c,F1,M,MN,MK,MP
V Q,QP,K,W
I MU,NU,MUP,NUP,I1,I2
B LA,LAC,KSI,KSIC,F1

Z Rate = Dia(MU,NU)*Conjg(Dia(MUP,NUP))

Id,Dia(MU~,NU~) = Ubg(I1,MN,QP)*{G(I1,MU)*G6(I1) + i*LA*{G(I1,MU)*
	G(I1,NU)-G(I1,NU)*G(I1,MU)}*M**-1*(Q(NU)+QP(NU))*G5(I1)}*0.5
	*{Gi(I1)+i*G(I1,W)*G5(I1)}*Ug(I1,-M,Q)*(F1*2*K(MU)+(KSI-F1)
	*(Q(MU)+QP(MU)) )

Id,Spin,I1
Id,Trick,Trace,I1
Id,Numer,MN,0,WDQ,0,WDQP,0,WDK,0,QPDQP,0,WDW,1
Id,QDQ=-M**2
Al,KDK=-MK**2
*yep
S RLA,ILA,RKSI,IKSI,EPSC
B RLA,ILA,RKSI,IKSI,F1

Id,QDQP=-0.5*MP**2+0.5*MK**2+QDK+QPDK+0.5*M**2
Id,LA=RLA+i*ILA
Al,LAC=RLA-i*ILA
Al,KSI=RKSI+i*IKSI
Al,KSIC=RKSI-i*IKSI
*end

C Spinors 13. Muon decay with CP violation.

P stat
S ME,MM,MN,A=c
V P,Q,QP,K,W1,W2
F DIA=u,PR=u
I MU,MUP,I1,I2
S B,COSF,SINF,X,Z,W1X,W1Z,QL,PL,P0
S PI
S nul=c

Z Amp2=B*DIA(MU)*Conjg(DIA(MUP))

Id,DIA(MU~)=Ubg(I1,ME,P)*PR(W2)*G(I1,MU)*(
	Gi(I1)
	+A*G5(I1))*PR(W1)*
		Ug(I1,MM,K) *
	Ubg(I2,MN,Q)*G(I2,MU)*G6(I2)*Ug(I2,MN,QP)

Id,PR(W1~)= 0.5*Gi(I1)-0.5*i*G(I1,W1)*G5(I1)
Id,Spin,I1,I2
Id,Trick,Trace,I1,I2

Id,MN=0
Al,W1DK=0
Al,W2DK=0
Al,W2DP=0
Al,W1DW2=0
Al,QPDQ=KDQ-PDQ
Al,QPDK=-MM**2-PDK-QDK
Al,QPDP=PDK+ME**2-QDP
Al,QPDW1=-PDW1-QDW1
Al,QPDW2=-QDW2
Id,Funct,QP(MU~)=K(MU)-P(MU)-Q(MU)
Al,QP(MU~)=K(MU)-P(MU)-Q(MU)
Al,W1DW1=1
Al,W2DW2=1
Id,Trick
P output
*yep
Id,Funct,Q(MU~)=QL*W1Z*COSF/i/MM/PL*Epf(MU,W2,P,K)*POL
	+ QDW2*W2(MU)
	+ QL*Z*(P(MU)/PL-K(MU)*P0/PL/MM)
	+ QL*K(MU)/MM
Id,Trick,I1
Id,PDQ=PL*QL*Z-P0*QL
Al,PDW1=PL*X
Al,PDK=-MM*P0
Al,QDK=-QL*MM
Al,QDW1=QL*X*Z-QL*W1X*W1Z*COSF
Al,QDW2=QL*W1Z*SINF*POL
Al,W1DW1=1
Al,W2DW2=1
Al,W1DW2=0
Al,KDK=-MM**2
Al,PDP=-ME**2
Al,W1DK=0
Al,W2DK=0
Al,W2DP=0
B B,COSF,SINF,Z,X,W1X,W1Z
P output
*yep
Id,B*COSF**2=PI*B
Al,B*SINF**2=PI*B
Al,B*SINF*COSF=0
Al,B*COSF=0
Al,B*SINF=0
Al,B=2*PI*B
Id,W1Z**2=1-Z**2
Al,W1X**2=1-X**2
*yep
B B,QL,X,PI
Id,Z=(0.5*ME**2+0.5*MM**2-MM*P0-QL*MM+QL*P0)/PL/QL
Al,B=B/PL/QL/P0/QL/MM
Id,B=B*PL**2*QL**2
Al,P0**5=P0*(PL**2+ME**2)**2
Al,P0**4=(PL**2+ME**2)**2
Al,P0**3=P0*PL**2+P0*ME**2
Al,P0**2=PL**2+ME**2
Al,POL**2=1
*yep
S POL,REA,IMA
B B,PI,i,POL,REA,IMA
Id,B*QL**2=B*(QMA**3-QMI**3)/3
Al,B*QL**1=B*(QMA**2-QMI**2)/2
Al,B=B*(QMA-QMI)
Id,QMA=0.5*MM-0.5*P0+0.5*PL
Al,QMI=0.5*MM-0.5*P0-0.5*PL
Id,B*X**2=B*2/3
Al,B*X=0
Al,B*W1X=0.5*B*PI
Al,B*Epf(P,K,W1,W2)=B*0.5*PI*PL*i*MM*POL
Al,B=2*B
Id,POL**2=1
Id,P0**5=P0*(PL**2+ME**2)**2
Al,P0**4=(PL**2+ME**2)**2
Al,P0**3=P0*PL**2+P0*ME**2
Al,P0**2=PL**2+ME**2
Id,A=REA+i*IMA
Al,AC=REA-i*IMA
Al,B=9*B
Id,i*PL*P0=i*PL**3/P0+i*PL*ME**2/P0
Id,i*PL**3=i*PL*(P0**2-ME**2)
*end

C Spinors 14. Muon decay.

P stat
C   MU(K) -- E(P),NBE(QP),NMU(Q)
S     ME,MM,MN,QL,QPL,PL,P0,PI,B,Z
S  LOGQA,LOGQB,LMUME,BP,MPR,AL
V      P,Q,QP,K
I     MU,MUP,I1,I2
F     DIA=u
Z     RATE = B*DIA(MU)*Conjg(DIA(MUP))*0.5
C  FACTOR 0.5 FOR AVERAGING OVER MU POL.
Id    DIA(MU~) = Ubg(I1,ME,P)*G(I1,MU)*G6(I1)*Ug(I1,MN,QP)
             *Ubg(I2,MN,Q)*G(I2,MU)*G6(I2)*Ug(I2,MM,K)
Id    Spin,I1,I2
Id    Trick,Trace,I1,I2
Id    MN=0
C  QP=K-P-Q
Id    QPDQ=KDQ-PDQ
Al    QPDK=-MM**2-PDK-QDK
Al    QPDP=PDK+ME**2-QDP
Id,Funct,QP(MU~) = K(MU) - P(MU) - Q(MU)
*yep
Id    PDQ=PL*QL*Z - P0*QL
Al     PDK = -MM*P0
Al     QDK = -QL*MM
Al     KDK = -MM**2
Al     PDP = -ME**2
C  INTEGRATION OVER ANGLES P
Id    B=B*4.*PI
C  INTEGRATION OVER AZIMUTH Q, AND VARIOUS FACTORS.
Id    B=B*2*PI/16/MM/P0/QL/QPL*PL**2*QL**2/32/PI**5
C  INTEGRATION OVER DELTA(QP0)
Id     Z = (0.5*ME**2+0.5*MM**2-MM*P0-QL*MM+QL*P0)/PL/QL
Al    B = B*QPL/QL/PL
*yep
B    B,PI
C   INTEGRATION OVER QL
Id  B*QL**-1 = BP*(LOGQA-LOGQB)
Id     B = B*QL
Id     B*QL**N~ = B*(QMA**N-QMI**N)/N
Id     QMA = 0.5*MM-0.5*P0+0.5*PL
Al     QMI = 0.5*MM - 0.5*P0 - 0.5*PL
Id   BP=B
*yep
B    B,PI
Id,Multi,P0**2 = PL**2+ME**2
Id   P0 = (PL**2+ME**2)/P0
P output
*yep
B  B,PI
Id  B*P0**-1 = X**-1*BP
Id   B=B*PL
Id   B*PL**N~ = B*AL**N/N
Al   PL**N~*BP = BP*(0.5*X-0.5*ME**2/X)**N
Id  AL = 0.5*MM - 0.5*ME**2/MM
Id   BP*X**-1 = LMUME*B
C  LMUME = LOG(MM/ME)
Id  BP=B*X
Id  X**N~ = (MM**N - ME**N)/N
P output
*yep
N 8
Id  B=B*GG**2/6.582173E-22
Id,Numer,MM,105.65946,ME,0.5110034,LMUME,5.33160,MPR,938.2796
Al,Numer,PI,3.141592653589793238
P output
*yep
Id  B=B/MPR**4
Id,Numer,MM,105.65946,ME,0.5110034,LMUME,5.33160,MPR,938.2796
P output
*yep
C  GG MUST BE SUCH THAT THE RESULT IS ONE.
Id   B = 2.197134E-6
P output
*yep
C THIS GG RESULTS (ABOUT 1.02*10^-5 / SQUARE_ROOT(2) ):

Id,GG=1.024627489E-5/W2
Id,W2**-2=1/2
*end

C Spinors 15. Neu + e- -> neu + mu- + gam (inv. muon decay, Green's method).

C Inverse muon decay, bremsstrahlung.
C Reproduces M. Green, J. Phys. G: Nucl Phys. 7(1981)1169.

C Momenta: q,P to r,k,p
  q,r neutrino's, P electron, p muon, k photon.
  M electron mass, m muon mass.
  ql and Ql are the lengths of the three-dimensional part of q and Q.

P stat

V  r,q,p,P,k
I   MU,AL,MUP,ALP
F   DIA=u,LogX,LogXa,LogY,LogYu,LogYp
S   M,m,ql,Ql,X,Y,E
B  X,Y

Z   Ampl2 = DIA(MU,AL)*Conjg(DIA(MUP,AL))/32

Id  DIA(MU~,AL~) = Ubg(I1,0,r)*G(I1,MU)*G6(I1)*Ug(I1,M,P)
      *Ubg(I2,m,p)*(
          G(I2,AL)*(-i*G(I2,k)-i*G(I2,p)+m)/2/om/Y*G(I2,MU)
          *G6(I2)  )*Ug(I2,0,q)
  - Ubg(I1,0,r)*G(I1,MU)*G6(I1)*
	{ -i*G(I1,P)+i*G(I1,k)+M}*G(I1,AL)*Ug(I1,M,P)/2/om/X
	*Ubg(I2,m,p)*G(I2,MU)*G6(I2)*Ug(I2,0,q)

Id,Spin,I1,I2
Id,Trick,Trace,I1,I2
Id,PDP=-M**2
Al,pDp=-m**2
Id,qDq=0
Al,rDr=0
Al,kDk=0
Id,Addfa,om**2
*yep

Id,r(MU~)=q(MU)+P(MU)-p(MU)-k(MU)
Al,Dotpr,r(MU~)=q(MU)+P(MU)-p(MU)-k(MU)
Al,Funct,r(MU~)=q(MU)+P(MU)-p(MU)-k(MU)
Id,qDq=0
Al,kDk=0
*yep

B   PI,X,Y
Id,Addfa,PI/4/E/ql
Id,qDp = - PDp - om*Y + om*E + E*Ql - E**2
Id,qDP = -ql*E
Al,PDP = 2*ql*E-E**2
Al,pDp = 2*Ql*E-E**2
Al,qDk = om*(X-E)
Al,PDp = X*Y*(1-om/E) + Y*(ql-E) + X*{om + Ql - E} - wt*CSF
Al,PDk = - om*X
Al,pDk = - om*Y
*yep
Id,CSF**1=0
Al,CSF**3=0.

IF NOT CSF**2=PI
Id,Addfa,2*PI
ENDIF

Id,Multi,wt**2=(X-E)*(X-E+2*ql)*(Y-E)*
 {Y*(E-2*om)-E*(E-2*Ql)}/E

*yep

IF NOT X**-1=LogX
AND NOT X**-2=2*ql/M**2
AND NOT X**n~=E**(n+1)/(n+1) - (E-2*ql)**(n+1)/(n+1)
Id,Addfa,2*ql
ENDIF

*yep

IF Y^n~
Id,Y**-1=LogY
Al,Y**-2=Sty*(1-2*om/E)/m**2
Id,Y**2={E**2-2*E*Ql+4*Ql**2/3 +
 0.5*om*m**2*omMhE**-2/E*{4*(E-Ql)*(E-om)-E**2}/3}*Sty
Al,Y**1={E-Ql-0.5*om*(E-2*Ql)*omMhE**-1}*Sty
ELSE
Id,Addfa,Sty
ENDIF

Id,Sty=2*Ql+om*m**2*omMhE**-1/E

*yep
IF NOT om**0*LogY=LogYp	!LogYp = Log(1-2*om/E)
Id,Addfa,1-soft
ENDIF

Id,soft*om**n~=0
Al,soft=1
Id,Addfa,om**-1

*yep
C LogYu = Log( E*(E-2*omu)/m**2 )
Id,om**n~*LogY=omu**(n+1)/(n+1)*LogYu - om**(n+1)/(n+1)*omMhE**-1
Id,Ratio,omMhE,om,hE
Id,hE=E/2
Al,Multi,hE**-1=2/E

*yep
B PI
IF NOT LogYp
AND NOT LogYu
AND NOT omMhE**-1=-LogXa
AND NOT omMhE**n~=(-2*E/m**2)**(-n-1)/(n+1)
 - (-2/E)**(-n-1)/(n+1)
AND NOT om**n~=omu**(n+1)/(n+1)
AND NOT LogY=0.5*E*LogXa - omu
Id,Addfa,omu
ENDIF

*yep
Id,omu=Ql
Al,LogYu=0
Al,LogYp*om**-1=-Sp(tQldE)	! tQldE = 2*Ql/E
Id,Multi,m**2=E**2-2*Ql*E
Al,Multi,M**2=E**2-2*ql*E
*end

C Spinors 16. Roskies problem (CERN, CDC 6500, 12 April 1972).

C 6500: 35.88, 47.62, 60.45 sec.
P stats
V P,Q,P1,P2,P3,P4,P5,P6,P7
V L1,L2,L3,X,Y,E4
I A1,A2,A3
B QDP7,QDP1,QDP2,QDP3,QDP4,QDP5,QDP6,A,B

Z Rosk = i*A*B*
 G(1,A1)*{i*G(1,P6)+1}*G(1,A2)*{i*G(1,P5)+1}*G(1,A3)*{i*G(1,P4)+1}
 *G(1,E4)*{i*G(1,P3)+1}*G(1,A1)*{i*G(1,P2)+1}*G(1,A2)
 *{i*G(1,P1)+1}*G(1,A3)*{i*G(1,P7)+1}*{G(1,E4)-1}*G(1,Q)

Id,7,Trick,Trace,1
Id,P7DE4=i
Id,Numer,QDE4,0,E4DE4,0
Id,P1DE4=i*X(1)
Al,P2DE4=i*X(2)
Al,P3DE4=i*X(3)
Al,P4DE4=i*X(4)
Al,P5DE4=i*X(5)
Al,P6DE4=i*X(6)
Id,Numer,QDP1,0,QDP3,0,QDP4,0,QDP5,0,QDP6,0,QDP7,0
P output
*yep
B B
D PT(N,M)=(0.5*Q(M)-L1(M)),(0.5*Q(M)-L2(M)),(0.5*Q(M)-L3(M)),
	  (-0.5*Q(M)-L3(M)),(-0.5*Q(M)-L3(M)+L1(M)),
	  (-0.5*Q(M)-L3(M)+L2(M)),(0.5*Q(M))
Id,P1DQ=PT(1,Q)
Al,P2DQ=PT(2,Q)
Al,P3DQ=PT(3,Q)
Al,P4DQ=PT(4,Q)
Al,P5DQ=PT(5,Q)
Al,P6DQ=PT(6,Q)
Al,P7DQ=PT(7,Q)
Id,P1DP2=F(1,2)
Al,P1DP3=F(1,3)
Al,P1DP4=F(1,4)
Al,P1DP5=F(1,5)
Al,P1DP6=F(1,6)
Al,P1DP7=F(1,7)
Id,P2DP3=F(2,3)
Al,P2DP4=F(2,4)
Al,P2DP5=F(2,5)
Al,P2DP6=F(2,6)
Al,P2DP7=F(2,7)
Al,P3DP4=F(3,4)
Al,P3DP5=F(3,5)
Al,P3DP6=F(3,6)
Al,P3DP7=F(3,7)
Al,P4DP5=F(4,5)
Al,P4DP6=F(4,6)
Al,P4DP7=F(4,7)
Al,P5DP6=F(5,6)
Al,P5DP7=F(5,7)
Al,P6DP7=F(6,7)
Id,A*F(N~,M~) = -X(N)*Y(M)*{1 + PT(M,MU)*PT(M,MU) }
		-X(M)*Y(N)*{1 + PT(N,MU)*PT(N,MU) }
		- PT(N,MU)*PT(M,MU)
Id,Count,-2,Q,-1
Id,QDL1**2=0.5*QDQ*L1DL1
Al,QDL1*QDL2=0.5*QDQ*L1DL2
Al,QDL1*QDL3=0.5*QDQ*L1DL3
Al,QDL2**2=0.5*QDQ*L2DL2
Al,QDL2*QDL3=0.5*QDQ*L2DL3
Al,QDL3**2=0.5*QDQ*L3DL3

Id,Numer,A,1,X(7),1,Y(7),0.5

P output
*yep
B QDQ,QDL1,QDL2,QDL3
Id,B*F(N~,M~)=-X(N)*Y(M)*{1 + PT(M,MU)*PT(M,MU) }
		- X(M)*Y(N)*{1 + PT(N,MU)*PT(N,MU)} - PT(N,MU)*PT(M,MU)

Id,Count,-2,Q,-1
Id,QDL1**2=0.5*QDQ*L1DL1
Al,QDL1*QDL2=0.5*QDQ*L1DL2
Al,QDL1*QDL3=0.5*QDQ*L1DL3
Al,QDL2**2=0.5*QDQ*L2DL2
Al,QDL2*QDL3=0.5*QDQ*L2DL3
Al,QDL3**2=0.5*QDQ*L3DL3

Id,Numer,A,1,B,1,X(7),1,Y(7),0.5

P output
*end

C Spinors 17. Production of 3 muons by one muon in Coulomb field.

P stat
V X1,X2,X3,X4,P,PP,R,RP,Q
F D1=u,D2=u,D3=u,D4=u,SDI=u,PROP=u,PROL=u

Z xx=	{SDI(I1,I2,PP,RP,MU)*Conjg(SDI(I3,I4,PP,RP,MP))} +
	{SDI(I1,I2,RP,PP,MU)*Conjg(SDI(I3,I4,RP,PP,MP))} -
	{SDI(I1,I2,PP,RP,MU)*Conjg(SDI(I3,I4,RP,PP,MP))} -
	{SDI(I3,I4,RP,PP,MP)*Conjg(SDI(I1,I2,PP,RP,MU))}

Id,SDI(I1~,I2~,PP~,RP~,MU~)=	D1(I1,I2,PP,RP,MU) +
				D2(I1,I2,PP,RP,MU) +
				D3(I1,I2,PP,RP,MU) +
				D4(I1,I2,PP,RP,MU)
Id,D1(I1~,I2~,PP~,RP~,MU~)=	PPDX1*Ubg(I1,AM,RP)*G(I1,MU)*PROP(I1,R,-Q,4)
	*Ug(I1,AM,R)*Ubg(I2,AM,PP)*G(I2,MU)*Ug(I2,-AM,P)
Al,D2(I1~,I2~,PP~,RP~,MU~)=	PPDX2*Ubg(I1,AM,RP)*PROL(I1,RP,Q,4)
	*G(I1,MU)*Ug(I1,AM,R)*Ubg(I2,AM,PP)*G(I2,MU)*Ug(I2,-AM,P)
Al,D3(I1~,I2~,PP~,RP~,MU~)=	PPDX3*Ubg(I1,AM,RP)*G(I1,MU)*Ug(I1,AM,R)
	*Ubg(I2,AM,PP)*G(I2,MU)*PROP(I2,-P,-Q,4)*Ug(I2,-AM,P)
Al,D4(I1~,I2~,PP~,RP~,MU~)=	PPDX4*Ubg(I1,AM,RP)*G(I1,MU)*Ug(I1,AM,R)
	*Ubg(I2,AM,PP)*PROL(I2,PP,Q,4)*G(I2,MU)*Ug(I2,-AM,P)

Id,Spin,I1,I2

Id,PROP(I1~,R~,Q~,L~)=i*G(I1,Q)*G(I1,L) + 2*i*D(R,L)
Al,PROL(I1~,RP~,Q~,L~)=i*G(I1,L)*G(I1,Q) + 2*i*D(RP,L)
B X1DPP,X1DRP,X2DPP,X2DRP,X3DPP,X3DRP,X4DPP,X4DRP

Id,Trick,Trace,I1,I2

*end