C----------------------------------------------------------------------- C This subroutine is designed to calculate the properties of the C little Higgs model C The routine fills the common block LHIGGS with the parameters C C MW mass of the W boson (input) C MZ mass of the Z boson (input) C MF(12) masses of the fermions (1-6 are the leptons e,ve,mu,vmu,tau,vtau) C (input) (7-12 are the quarks d,u,s,c,b,t) C ALPHA electromagnetic coupling (input) C SW sin theta_W (input) C MT mass of the new heavy top quark (input) C FH symmetry breaking scale (input) C THETA mixing angle for SU(2) groups (input) C THETAP mixing angle for U(1) groups(input) C G weak coupling (calculated) C GP SM U(1) coupling (calculated) C E electric charge (calculated) C PI pi (calculated) C CW cos theta_W (calculated) C VEV SM VEV (calculated) C VEVP New VEV (calculated) C ST sin(theta) (calculated) C CT cos(theta) (calculated) C STP sin(thetap) (calculated) C CTP cos(thetap) (calculated) C LAM(2) top quark Yukawa couplings (calculated) C MZH Heavy Z mass (calculated) C MWH Heavy W mass (calculated) C MAH Heavy Photon Mass (calculated) C GL(14,6) left couplings of fermion (calculated) C (second index as for width) C (1-6 are the leptons e,ve,mu,vmu,tau,vtau) C (input) (7-12 are the quarks d,u,s,c,b,t) C (13 is TT 14 is tT) C GR(14,6) right couplings of fermion (calculated) C (second index as for width) C (1-6 are the leptons e,ve,mu,vmu,tau,vtau) C (input) (7-12 are the quarks d,u,s,c,b,t) C (13 is TT 14 is tT) C WIDTH(6) widths of the gauge bosons C (2 is Z, 3 is heavy photon, 4 is heavy Z C 5 is W, 6 is heavy W) C----------------------------------------------------------------------- SUBROUTINE LITTLE C----------------------------------------------------------------------- C Subroutine to calculate the parameters of the Little Higgs Model C----------------------------------------------------------------------- IMPLICIT NONE C--common block with Liggle Higgs parameters DOUBLE PRECISION MW,MZ,MF,ALPHA,SW,MT,FH,THETA,THETAP,G,GP,E,PI, & CW,VEV,VEVP,ST,CT,STP,CTP,LAM,MZH,MWH,MAH,GL,GR,WIDTH COMMON /LHIGGS/MW,MZ,MF(12),ALPHA,SW,MT,FH,THETA,THETAP,G,GP,E,PI, & CW,VEV,VEVP,ST,CT,STP,CTP, & LAM(2),MZH,MWH,MAH,GL(14,6),GR(14,6),WIDTH(6) C--local variables DOUBLE PRECISION A,XH,XL,M(0:2),ME,PHS INTEGER I,J CHARACTER *17 NAME(12) DATA NAME/'Electron','Electron Neutrino','Muon','Muon Neutrino', &'Tau','Tau Neutrino','Down','Up','Strange','Charm','Bottom','Top'/ C--mass of the SM gauge bosons MW = 80.423D0 MZ = 91.1876D0 print *,'input W boson mass = ',mw print *,'input Z boson mass = ',mz C--mass of the Standard Model fermions (1-6 are the leptons e,ve,mu,vmu,tau,vtau) C (7-12 are the quarks d,u,s,c,b,t) MF(1 ) = 0.511D-3 MF(2 ) = 0.0D0 MF(3 ) = 105.66D-3 MF(4 ) = 0.0D0 MF(5 ) = 1776.99D-3 MF(6 ) = 0.0D0 MF(7 ) = 0.0D0 MF(8 ) = 0.0D0 MF(9 ) = 100.0D-3 MF(10) = 1.2D0 MF(11) = 4.25D0 MF(12) = 174.3D0 DO I=1,12 WRITE(*,'(A6,A17,A8,E15.5)') 'Input ',NAME(I),' mass = ',MF(I) ENDDO C--SM gauge couplings PI = ACOS(-1.0D0) ALPHA = 1.0D0/128.0D0 SW = SQRT(0.2319) CW = SQRT(1.0D0-SW**2) E = SQRT(4.0D0*PI*ALPHA) G = E/SW GP = E/CW VEV = 2.0D0*MW/G print *,'input value of alpha = ',alpha print *,'inout value of sin^2theta_W = ',SW**2 print *,'calculated SM VEV =',vev C--parameters of the Little Higgs Model go here C--mixings THETA = 0.25D0*PI THETAP = 0.25D0*PI ST = SIN(THETA) CT = COS(THETA) STP = SIN(THETAP) CTP = COS(THETAP) print *,"input mixing angle theta = ",theta print *,"input mixing angle theta' = ",thetap C--Vacuum expectation values FH = 2.0D3 VEVP = 0.25D0*VEV**2/FH print *,'input value of f = ',fh print *,'calculated value of new VEV = ',vevp C--mass of the heavy top quark MT = 2900.0D0 C--Yukawa couplings A = 4.0D0*FH**2*MF(12)**2/MT**2/VEV**2 IF(A.GT.1.0D0) THEN print *,'invalid choice of heavy top mass and F' STOP ENDIF A = SQRT(1.0D0-A) C--remember you can change the signs here LAM(1) = SQRT(0.5D0*(MT/FH)**2*(1.0D0+A)) LAM(2) = SQRT(0.5D0*(MT/FH)**2*(1.0D0-A)) print *,'Input heavy top mass = ',MT print *,'Calculated Top Yukawas = ',LAM C--masses of the new gauge bosons XH = 2.5D0*G*GP*ST*CT*STP*CTP*(CT**2*STP**2+ST**2*CTP**2)/ & (5.0D0*G**2*STP**2*CTP**2-GP**2*ST**2*CT**2) XL = LAM(1)**2/(LAM(1)**2+LAM(2)**2) C--heavy W MWH = MW**2*(FH**2/ST**2/CT**2/VEV**2-1.0D0) MWH = SQRT(MWH) C--heavy photon MAH = MZ**2*SW**2*(FH**2/5.0D0/STP**2/CTP**2/VEV**2-1.0D0+ & XH*CW**2/4.0D0/ST**2/CT**2/SW**2) MAH = SQRT(MAH) C--heavy Z MZH = MW**2*(FH**2/ST**2/CT**2/VEV**2-1.0D0- & XH*SW**2/STP**2/CTP**2/CW**2) MZH = SQRT(MZH) print *,'Calculated Heavy W Boson mass = ',MWH print *,'Calculated Heavy Photon mass = ',MAH print *,'Calculated Heavy Z Boson mass = ',MZH C--set up the couplings of the particles to the gauge bosons C--first to the photon DO I=1,3 C----------------------------couplings to the photon-------------------- C--charged leptons GL(2*I-1,1) = -E GR(2*I-1,1) = -E C--neutrinos GL(2*I ,1) = 0.0D0 GR(2*I ,1) = 0.0D0 C--down type quarks GL(2*I+5,1) = -E/3.0D0 GR(2*I+5,1) = -E/3.0D0 C--up type quarks GL(2*I+6,1) = 2.0D0*E/3.0D0 GR(2*I+6,1) = 2.0D0*E/3.0D0 ENDDO C--heavy top quark GL(13 ,1) = 2.0D0*E/3.0D0 GR(13 ,1) = 2.0D0*E/3.0D0 GL(14 ,1) = 0.0D0 GR(14 ,1) = 0.0D0 C------------------------couplings to the Z boson---------------------- DO I=1,3 C--charged leptons GL(2*I-1,2) = G/CW*(-0.5D0+SW**2) GR(2*I-1,2) = G/CW*SW**2 C--neutrinos GL(2*I ,2) = G/CW*(+0.5D0) GR(2*I ,2) = 0.0D0 C--down type quarks GL(2*I+5,2) = G/CW*(-0.5D0+SW**2/3.0D0) GR(2*I+5,2) = G/CW*SW**2/3.0D0 C--up type quarks GL(2*I+6,2) = G/CW*(+0.5D0-2.0D0*SW**2/3.0D0) GR(2*I+6,2) = -G/CW*2.0D0*SW**2/3.0D0 ENDDO C--heavy top quark GL(13 ,2) = -2.0D0*G*SW**2/3.0D0/CW GR(13 ,2) = -2.0D0*G*SW**2/3.0D0/CW GL(14 ,2) = -G*XL*VEV/2.0D0/FH/CW GR(14 ,2) = 0.0D0 C------------------------couplings to the heavy photon ---------------------- DO I=1,3 C--charged leptons GL(2*I-1,3) = 0.5D0*GP/STP/CTP*(1.2D0-1.6D0+ CTP**2) GR(2*I-1,3) = 0.5D0*GP/STP/CTP*(1.2D0-2.0D0+2.0D0*CTP**2) C--neutrinos GL(2*I ,3) = 0.5D0*GP/STP/CTP*(1.2D0-1.6D0+ CTP**2) GR(2*I ,3) = 0.0D0 C--down type quarks GL(2*I+5,3) = 0.5D0*GP/STP/CTP*(-0.8D0+14.0D0/15.0D0 & -CTP**2/3.0D0) GR(2*I+5,3) = 0.5D0*GP/STP/CTP*(-0.8D0+ 8.0D0/15.0D0 & +2.0D0*CTP**2/3.0D0) C--up type quarks GL(2*I+6,3) = 0.5D0*GP/STP/CTP*(-0.8D0+14.0D0/15.0D0 & - CTP**2/3.0D0) GR(2*I+6,3) = 0.5D0*GP/STP/CTP*(-0.8D0+20.0D0/15.0D0 & -4.0D0*CTP**2/3.0D0) ENDDO C--corrections for the top GR(12,3) = GR(12,3)-0.2D0*GP/STP/CTP*XL C--heavy top quark GL(13 ,3) = 0.5D0*GP/STP/CTP*(-0.8D0+14.0D0/15.0D0 & -4.0D0*CTP**2/3.0D0) GR(13 ,3) = 0.5D0*GP/STP/CTP*(-0.8D0+14.0D0/15.0D0 & -4.0D0*CTP**2/3.0D0+0.4D0*XL) GL(14 ,3) = 0.0D0 GR(14 ,3) = 0.2D0*GP/STP*CTP*LAM(1)*LAM(2)/ & (LAM(1)**2+LAM(2)**2) C------------------------couplings to the heavy Z boson ---------------------- DO I=1,3 C--charged leptons GL(2*I-1,4) =-0.5D0*G*CT/ST GR(2*I-1,4) = 0.0D0 C--neutrinos GL(2*I ,4) = 0.5D0*G*CT/ST GR(2*I ,4) = 0.0D0 C--down type quarks GL(2*I+5,4) =-0.5D0*G*CT/ST GR(2*I+5,4) = 0.0D0 C--up type quarks GL(2*I+6,4) = 0.5D0*G*CT/ST GR(2*I+6,4) = 0.0D0 ENDDO C--heavy top quark GL(13 ,4) = 0.0D0 GR(13 ,4) = 0.0D0 GL(14 ,4) = 0.5D0*G*CT/ST*XL*VEV/FH GR(14 ,4) = 0.0D0 C------------------------couplings to the W boson ---------------------- DO I=1,3 C--leptons GL(I,5) = G/SQRT(2.0D0) GR(I,5) = 0.0D0 C--quarks GL(I+3,5) = G/SQRT(2.0D0) GR(I+3,5) = 0.0D0 ENDDO C--heavy top quark GL(7 ,5) =-G/SQRT(2.0D0)*VEV/FH*XL GR(7 ,5) = 0.0D0 C------------------------couplings to the heavy W boson ---------------------- DO I=1,3 C--leptons GL(I,6) =-G/SQRT(2.0D0)*CT/ST GR(I,6) = 0.0D0 C--quarks GL(I+3,6) =-G/SQRT(2.0D0)*CT/ST GR(I+3,6) = 0.0D0 ENDDO C--heavy top quark GL(7 ,6) =+G/SQRT(2.0D0)*VEV/FH*XL*CT/ST GR(7 ,6) = 0.0D0 C--compute the widths of the neutral gauge bosons DO I=2,4 C--mass of decaying particle IF(I.EQ.2) THEN M(0) = MZ ELSEIF(I.EQ.3) THEN M(0) = MAH ELSEIF(I.EQ.4) THEN M(0) = MZH ENDIF WIDTH(I) = 0.0D0 C--loop over the possible final state particles DO J=1,14 C--masses of the final state particles IF(J.LE.12) THEN M(1)=MF(J) M(2)=MF(J) ELSEIF(J.EQ.13) THEN M(1) = MT M(2) = MT ELSE M(1) = MT M(2) = MF(6) ENDIF C--check whether mode is kinematically allowed IF(M(0).GT.M(1)+M(2)) THEN C--calculate phase space factor PHS = 0.5D0/M(0)*SQRT((M(0)**2-(M(1)+M(2))**2)* & (M(0)**2-(M(1)-M(2))**2)) PHS = PHS/8.0D0/PI/M(0)**2 C--calculate decay matrix element ME = (GL(J,I)**2+GR(J,I)**2)/M(0)**2*( & 2.0D0*M(0)**4-M(1)**4-M(2)**4+2.0D0*M(1)**2*M(2)**2 & -M(0)**2*M(1)**2-M(0)**2*M(2)**2) & +12*GL(J,I)*GR(J,I)*M(1)*M(2) C--spin average ME = ME/3.0D0 C--include colour factors and charge conjugation factor for tT IF(J.GT.6.AND.J.LE.12) THEN ME = ME*3.0D0 ELSEIF(J.EQ.14) THEN ME = ME*6.0D0 ENDIF C--add to the total width WIDTH(I)=WIDTH(I)+PHS*ME ENDIF ENDDO ENDDO C--compute the widths of the charged gauge bosons DO I=5,6 C--mass of decaying particle IF(I.EQ.5) THEN M(0) = MW ELSEIF(I.EQ.6) THEN M(0) = MWH ENDIF WIDTH(I) = 0.0D0 C--loop over the possible final state particles DO J=1,7 C--masses of the final state particles IF(J.LE.6) THEN M(1)=MF(2*J-1) M(2)=MF(2*J ) ELSEIF(J.EQ.7) THEN M(1) = MT M(2) = MF(11) ENDIF C--check whether mode is kinematically allowed IF(M(0).GT.M(1)+M(2)) THEN C--calculate phase space factor PHS = 0.5D0/M(0)*SQRT((M(0)**2-(M(1)+M(2))**2)* & (M(0)**2-(M(1)-M(2))**2)) PHS = PHS/8.0D0/PI/M(0)**2 C--calculate decay matrix element ME = (GL(J,I)**2+GR(J,I)**2)/M(0)**2*( & 2.0D0*M(0)**4-M(1)**4-M(2)**4+2.0D0*M(1)**2*M(2)**2 & -M(0)**2*M(1)**2-M(0)**2*M(2)**2) & +12*GL(J,I)*GR(J,I)*M(1)*M(2) C--spin average ME = ME/3.0D0 C--include colour factors IF(J.GT.3) ME = ME*3.0D0 C--add to the total width WIDTH(I)=WIDTH(I)+PHS*ME ENDIF ENDDO ENDDO C--output the widths of the new particles print *,'Calculated Z boson width = ',WIDTH(2) print *,'Calculated W boson width = ',WIDTH(5) print *,'Calculated Heavy W boson width = ',WIDTH(6) print *,'Calculated Heavy photon width = ',WIDTH(3) print *,'Calculated Heavy Z boson width = ',WIDTH(4) END