CDECK ID>, HWHRBB. *CMZ :- -20/10/99 09:46:43 by Peter Richardson *-- Author : Peter Richardson C----------------------------------------------------------------------- SUBROUTINE HWHRBB C----------------------------------------------------------------------- C Subroutine for 2 parton -> 2 parton via UDD resonant squarks C----------------------------------------------------------------------- INCLUDE 'HERWIG61.INC' DOUBLE PRECISION HCS,S,RCS,HWR,MQ1,MQ2,TAU,LOWTLM,UPPTLM,RTAB, & SQSH,MATELM,SCF(12),CHANPB(2),HWRUNI,PCM,MIX(12), & ME(2,3,3,3,3),WD,MS(12),SWD(12),RAND,TAUA, & CHAN(12),EPS,SH,FAC,TAUB,LAM(6,3,3,3,3), & XMIN,XMAX,XPOW,XUPP,MS2(12),MSWD(12) INTEGER I,J,K,L,I1,J1,K1,L1,N,THEP,CONECT(4,5),HWRINT, & GENR,GN,MIG,MXG,GEN LOGICAL FIRST EXTERNAL HWR,HWRUNI PARAMETER(EPS=1D-20) COMMON/HWRPIN/XMIN,XMAX,XPOW,FIRST SAVE HCS,ME,MS,SWD,CHAN,LAM,MIX,FAC,SH,SQSH,SCF,MS2,MSWD DATA CONECT/1,1,3,4,-1,-1,2,3,0,0,0,0,1,1,-2,-3,-1,-1,-3,-4/ IF(GENEV) THEN RCS = HCS*HWR() ELSE IF(FSTWGT) THEN C--Extract masses and width's needed DO I=1,3 MS(2*I-1) = RMASS(399+2*I) MS(2*I) = RMASS(411+2*I) MS(2*I+5) = RMASS(400+2*I) MS(2*I+6) = RMASS(412+2*I) SWD(2*I-1) = HBAR/RLTIM(399+2*I) SWD(2*I) = HBAR/RLTIM(411+2*I) SWD(2*I+5) = HBAR/RLTIM(400+2*I) SWD(2*I+6) = HBAR/RLTIM(412+2*I) ENDDO DO I=1,12 MS2(I) = MS(I)**2 MSWD(I) = MS(I)*SWD(I) ENDDO C--Now set up the parmaters for multichannel integration RAND = ZERO DO K=1,3 CHANPB(1) = ZERO CHANPB(2) = ZERO DO I=1,3 DO J=1,3 CHANPB(1)=CHANPB(1)+LAMDA3(I,J,K)**2 CHANPB(2)=CHANPB(2)+LAMDA3(K,I,J)**2 ENDDO ENDDO RAND=RAND+CHANPB(1)+CHANPB(2) DO J=1,2 CHAN(2*K-2+J) = CHANPB(1)*QMIXSS(2*K-1,2,J)**2 CHAN(2*K+4+J) = CHANPB(2)*QMIXSS(2*K ,2,J)**2 MIX(2*K-2+J) = QMIXSS(2*K-1,2,J)**2 MIX(2*K+4+J) = QMIXSS(2*K,2,J)**2 ENDDO ENDDO IF(RAND.GT.ZERO) THEN DO I=1,12 CHAN(I)=CHAN(I)/RAND ENDDO ELSE HCS =ZERO CALL HWWARN('HWHRBB',500,*999) ENDIF C--find the couplings DO GN=1,3 DO I=1,3 DO J=1,3 DO K=1,3 DO L=1,3 LAM(GN,I,J,K,L) =LAMDA3(I,J,GN)*LAMDA3(K,L,GN) LAM(GN+3,I,J,K,L)=LAMDA3(GN,I,J)*LAMDA3(GN,K,L) ENDDO ENDDO ENDDO ENDDO ENDDO ENDIF EVWGT = ZERO S = PHEP(5,3)**2 COSTH = HWRUNI(0,-ONE,ONE) C--Generate the smoothing RAND=HWRUNI(0,ZERO,ONE) DO I=1,12 IF(CHAN(I).GT.RAND) GOTO 20 RAND=RAND-CHAN(I) ENDDO 20 GENR=I C--Calculate hard scale and obtain parton distributions TAUA = MS2(GENR)/S TAUB = SWD(GENR)**2/S RTAB = SQRT(TAUA*TAUB) XUPP = XMAX IF(XMAX**2.GT.S) XUPP = SQRT(S) LOWTLM = DATAN((XMIN**2/S-TAUA)/RTAB)/RTAB UPPTLM = DATAN((XUPP**2/S-TAUA)/RTAB)/RTAB TAU = HWRUNI(0,LOWTLM,UPPTLM) TAU = RTAB*TAN(RTAB*TAU)+TAUA SH = S*TAU SQSH = SQRT(SH) EMSCA = SQSH XX(1) = EXP(HWRUNI(0,ZERO,LOG(TAU))) XX(2) = TAU/XX(1) CALL HWSGEN(.FALSE.) C--Calculate the prefactor due multichannel approach FAC = ZERO DO GN=1,12 SCF(GN)=1/((SH-MS2(GN))**2+MSWD(GN)**2) FAC=FAC+CHAN(GN)*SCF(GN) ENDDO FAC=-(UPPTLM-LOWTLM)*LOG(TAU)*GEV2NB & /(24*PIFAC*SQSH*SH*TAU*FAC*S**2) ENDIF C--loop over the quarks HCS = ZERO C--temp mod DO GN=1,2 IF(GN.EQ.1) THEN MIG = 1 MXG = 6 ELSE MIG = 7 MXG = 12 ENDIF DO K1=1,3 DO 70 L1=1,3 IF(GN.EQ.1) THEN K = 2*K1 L = 2*L1-1 ELSE K=2*K1-1 L=2*L1-1 IF(GN.EQ.2.AND.L1.GE.K1) GOTO 70 ENDIF MQ1=RMASS(K) MQ2=RMASS(L) IF(SQSH.GT.(MQ1+MQ2)) THEN PCM=SQRT((SH-(MQ1+MQ2)**2)*(SH-(MQ1-MQ2)**2)/(4*SH)) WD = SH*(SH-MQ1**2-MQ2**2)*PCM ELSE GOTO 70 ENDIF DO I1=1,3 DO 60 J1=1,3 IF(GN.EQ.1) THEN I = 2*I1 J = 2*J1-1 ELSE I=2*I1-1 J=2*J1-1 IF(J1.GT.I1) GOTO 60 ENDIF IF(GENEV) GOTO 50 MATELM = ZERO DO 40 GEN=MIG,MXG IF(ABS(MIX(GEN)).LT.EPS.OR. & ABS(LAM(INT((GEN+1)/2),I1,J1,K1,L1)).LT.EPS) GOTO 40 DO 30 GENR=MIG,MXG IF(ABS(LAM(INT((GENR+1)/2),I1,J1,K1,L1)).LT.EPS. & OR.ABS(MIX(GENR)).LT.EPS) GOTO 30 MATELM =MATELM+SCF(GEN)*SCF(GENR)*WD* & ((SH-MS2(GEN))*(SH-MS2(GENR))+ & MSWD(GEN)*MSWD(GENR)) & *LAM(INT((GEN+1)/2),I1,J1,K1,L1)*MIX(GEN) & *LAM(INT((GENR+1)/2),I1,J1,K1,L1)*MIX(GENR) 30 CONTINUE 40 CONTINUE ME(GN,I1,J1,K1,L1) = MATELM*FAC C--Add up the term to get the cross-section 50 HCS = HCS+ME(GN,I1,J1,K1,L1)*DISF(I,1)*DISF(J,2) IF(HCS.GT.RCS.AND.GENEV) & CALL HWHRSS(1,I,J,K,L,0,0,*100) HCS = HCS+ME(GN,I1,J1,K1,L1)*DISF(J,1)*DISF(I,2) IF(HCS.GT.RCS.AND.GENEV) & CALL HWHRSS(2,J,I,K,L,0,0,*100) HCS = HCS+ME(GN,I1,J1,K1,L1)*DISF(I+6,1)*DISF(J+6,2) IF(HCS.GT.RCS.AND.GENEV) & CALL HWHRSS(1,I,J,K,L,1,0,*100) HCS = HCS+ME(GN,I1,J1,K1,L1)*DISF(J+6,1)*DISF(I+6,2) IF(HCS.GT.RCS.AND.GENEV) & CALL HWHRSS(2,J,I,K,L,1,0,*100) 60 CONTINUE ENDDO 70 CONTINUE ENDDO ENDDO 100 IF(GENEV) THEN CALL HWETWO C--first stage of the colour connection corrections DO THEP=1,5 IF(THEP.NE.3) THEN JMOHEP(2,THEP+NHEP-5)=NHEP-5+THEP+CONECT(HWRINT(1,4),THEP) JDAHEP(2,THEP+NHEP-5) = JMOHEP(2,THEP+NHEP-5) ENDIF ENDDO THEP = NHEP-4 IF(HWRINT(1,2).EQ.1) THEN HRDCOL(2,1) = THEP+3 HRDCOL(2,2) = THEP+4 HRDCOL(1,4) = THEP HRDCOL(1,5) = THEP+1 ELSE HRDCOL(2,1) = THEP+4 HRDCOL(2,2) = THEP+3 HRDCOL(1,4) = THEP+1 HRDCOL(1,5) = THEP ENDIF DO N=1,5 IF(N.LE.2) THEN HRDCOL(1,N)=HRDCOL(2,N) ELSEIF(N.GE.4) THEN HRDCOL(2,N)=HRDCOL(1,N) ENDIF ENDDO HRDCOL(1,3) = 4 COLUPD = .TRUE. ELSE EVWGT = HCS ENDIF 999 END CDECK ID>, HWHRBS. *CMZ :- -20/10/99 09:46:43 by Peter Richardson *-- Author : Peter Richardson C----------------------------------------------------------------------- SUBROUTINE HWHRBS C----------------------------------------------------------------------- C Subroutine for 2 parton -> parton SUSY particle via UDD resonant C squarks. C----------------------------------------------------------------------- INCLUDE 'HERWIG61.INC' DOUBLE PRECISION HCS,S,RCS,HWR,ME(4),CW,MER(6),MZ,TAU,TAUA, & TAUB,LOWTLM,UPPTLM,HWRUNI,SH,SQSH,SCF(12),MW2, & LAMC(3),CHANPB(2),PCM,ECM,RAND,MEN(7,6,3,3), & MEC(2,6,3,3),RTAB,MS(12),SWD(12),AS,HWUALF, & MQ,MN,MQS,SIN2B,TH,UH,FAC,MX(14),CHAN(12),MC(2), & MNS,HWUAEM,SW,G,EC,MW,A(7,14),B(7,14),EPS,XUPP, & MEH(3,42),XMIN,XMAX,XPOW,FAC2,MH(4),ZSQU(2,2), & ZQRK(2),MZ2,GUU(4),GDD(4),ME2,MS2(12),MSWD(12) INTEGER I,J,K,I1,J1,GEN,THEP,HWRINT,L,GT,GU,GR,I2, & CONECT(2,6,5),GN,GENR,SP,SPMN,SPMX,CON,CHARMN,CHARMX, & CM,CN LOGICAL RAD,NEUT,CHAR,HIGGS,FIRST EXTERNAL HWR,HWRUNI,HWUAEM,HWUALF,HWRINT COMMON/HWRPIN/XMIN,XMAX,XPOW,FIRST SAVE HCS,MS,SWD,MX,CHAN,A,B,SPMN,SPMX,RAD,MEN,MEC,HIGGS, & CHARMN,CHARMX,NEUT,CHAR,SQSH,MEH,SW,CW,MW,MZ,MER,SH,MH, & AS,EC,FAC,G,SCF,ZSQU,ZQRK,MW2,MZ2,MS2,MSWD PARAMETER(EPS=1D-20) DATA CONECT/ 4, 4, 2, 3, 0, 0, 1,-2,-1,-3,-4,-4, & 3, 4, 3, 3, 0, 0, 1,-3,-1,-4,-3,-3, & 1, 4,-1, 3, 0, 0, 1, 1,-3,-4,-1,-1, & 1, 3,-1, 2, 0, 0,-3,-2, 0, 0, 0, 0, & 1, 4,-1, 3, 0, 0,-3,-2,-1,-1,-1,-1/ IF(GENEV) THEN RCS = HCS*HWR() ELSE IF(FSTWGT) THEN C--Extract masses and width's needed DO I=1,3 MS(2*I-1) = RMASS(399+2*I) MS(2*I) = RMASS(411+2*I) MS(2*I+5) = RMASS(400+2*I) MS(2*I+6) = RMASS(412+2*I) SWD(2*I-1) = HBAR/RLTIM(399+2*I) SWD(2*I) = HBAR/RLTIM(411+2*I) SWD(2*I+5) = HBAR/RLTIM(400+2*I) SWD(2*I+6) = HBAR/RLTIM(412+2*I) ENDDO DO I=1,12 MS2(I) = MS(I)**2 MSWD(I) = MS(I)*SWD(I) ENDDO C--Electroweak parameters SW = SQRT(SWEIN) CW = SQRT(1-SWEIN) MW = RMASS(198) MZ = RMASS(200) MW2 = MW**2 MZ2 = MZ**2 SIN2B = TWO*SINB*COSB C--Now set up the parmaters for multichannel integration RAND = ZERO DO K=1,3 CHANPB(1) = ZERO CHANPB(2) = ZERO DO I=1,3 DO J=1,3 CHANPB(1)=CHANPB(1)+LAMDA3(I,J,K)**2 CHANPB(2)=CHANPB(2)+LAMDA3(K,I,J)**2 ENDDO ENDDO RAND=RAND+CHANPB(1)+CHANPB(2) DO J=1,2 CHAN(2*K-2+J) = CHANPB(1)*QMIXSS(2*K-1,2,J)**2 CHAN(2*K+4+J) = CHANPB(2)*QMIXSS(2*K ,2,J)**2 MX(2*K-2+J) = QMIXSS(2*K-1,2,J) MX(2*K+4+J) = QMIXSS(2*K,2,J) ENDDO MX(13) = ZERO MX(14) = ZERO ENDDO IF(RAND.GT.ZERO) THEN DO I=1,12 CHAN(I)=CHAN(I)/RAND ENDDO ELSE CALL HWWARN('HWHRBS',500,*999) ENDIF C--Couplings we need for the various processes C--Gluino DO I=1,3 DO J=1,2 A(1,2*I-2+J) = QMIXSS(2*I-1,2,J) B(1,2*I-2+J) = -QMIXSS(2*I-1,1,J) A(1,2*I+4+J) = QMIXSS(2*I,2,J) B(1,2*I+4+J) = -QMIXSS(2*I,1,J) ENDDO ENDDO C--Now the neutralinos DO L=1,4 MC(1) = ZMIXSS(L,3)/(2*MW*COSB*SW) MC(2) = ZMIXSS(L,4)/(2*MW*SINB*SW) DO I=1,3 DO J=1,2 A(L+1,2*I-2+J) = ZSGNSS(L)*(MC(1)*QMIXSS(2*I-1,1,J)* & RMASS(2*I-1)+SRFCH(2*I-1,L)*QMIXSS(2*I-1,2,J)) B(L+1,2*I-2+J) = MC(1)*QMIXSS(2*I-1,2,J)* & RMASS(2*I-1)+SLFCH(2*I-1,L)*QMIXSS(2*I-1,1,J) A(L+1,2*I+4+J) = ZSGNSS(L)*(MC(2)*QMIXSS(2*I,1,J)* & RMASS(2*I)+SRFCH(2*I ,L)*QMIXSS(2*I,2,J)) B(L+1,2*I+4+J) = MC(2)*QMIXSS(2*I,2,J)* & RMASS(2*I)+SLFCH(2*I, L)*QMIXSS(2*I,1,J) ENDDO ENDDO ENDDO C--Now for the charginos DO L=1,2 MC(1) = 1/(SQRT(2.0D0)*MW*COSB) MC(2) = 1/(SQRT(2.0D0)*MW*SINB) DO I=1,3 DO J=1,2 A(5+L,2*I-2+J) = -WSGNSS(L)*WMXVSS(L,2)*MC(2)* & RMASS(2*I)*QMIXSS(2*I-1,1,J) B(5+L,2*I-2+J) = WMXUSS(L,1)*QMIXSS(2*I-1,1,J) & -WMXUSS(L,2)*MC(1)*RMASS(2*I-1)*QMIXSS(2*I-1,2,J) A(5+L,2*I+4+J) = -WMXUSS(L,2)*MC(1)*RMASS(2*I-1) & *QMIXSS(2*I,1,J) B(5+L,2*I+4+J) = WSGNSS(L)*(WMXVSS(L,1)*QMIXSS(2*I,1,J) & -WMXVSS(L,2)*MC(2)*RMASS(2*I)*QMIXSS(2*I,2,J)) ENDDO ENDDO ENDDO C--Zero couplings DO I=1,7 A(I,13) = ZERO B(I,13) = ZERO A(I,14) = ZERO B(I,14) = ZERO ENDDO C--Couplings to the Z boson of squarks and right-handed quarks ZQRK(1) = -SW**2/6.0D0/CW ZQRK(2) = SW**2/3.0D0/CW ZSQU(1,1) = HALF*(QMIXSS(5,1,1)**2-2.0D0*SW**2/3.0D0)/CW ZSQU(1,2) = HALF*QMIXSS(5,1,1)*QMIXSS(5,1,2)/CW ZSQU(2,1) = -HALF*(QMIXSS(6,1,1)**2-4.0D0*SW**2/3.0D0)/CW ZSQU(2,2) = -HALF*QMIXSS(6,1,1)*QMIXSS(6,1,2)/CW C--Higgs Masses DO I=1,4 MH(I) = RMASS(202+I) ENDDO C--Higgs couplings to quarks DO I=1,3 GUU(I) = GHUUSS(I)**2*HALF**2/MW2 GDD(I) = GHDDSS(I)**2*HALF**2/MW2 ENDDO GUU(4) = ONE/TANB**2/MW2/8.0D0 GDD(4) = ONE*TANB**2/MW2/8.0D0 C--decide which processes to generate from IPROC RAD = .FALSE. NEUT = .FALSE. CHAR = .FALSE. HIGGS = .FALSE. SPMN = 1 SPMX = 5 CHARMN = 1 CHARMX = 2 IF(IPROC.EQ.4100) THEN RAD = .TRUE. NEUT = .TRUE. CHAR = .TRUE. HIGGS = .TRUE. ELSEIF(IPROC.LT.4120) THEN SPMN = 2 IF(IPROC.NE.4110) THEN SPMN = MOD(IPROC,10)+1 SPMX = SPMN ENDIF NEUT=.TRUE. ELSEIF(IPROC.LT.4130) THEN IF(IPROC.NE.4120) THEN CHARMN = MOD(IPROC,10) CHARMX=CHARMN ENDIF CHAR = .TRUE. ELSEIF(IPROC.EQ.4130) THEN SPMX = 1 NEUT=.TRUE. ELSEIF(IPROC.EQ.4140) THEN RAD = .TRUE. ELSEIF(IPROC.EQ.4150) THEN HIGGS = .TRUE. ELSE CALL HWWARN('HWHRBS',501,*999) ENDIF ENDIF EVWGT = ZERO S = PHEP(5,3)**2 COSTH = HWRUNI(0,-ONE,ONE) C--zero the array DO I=1,6 DO J=1,3 DO K=1,3 DO L=1,7 MEN(L,I,J,K)=ZERO ENDDO DO L=1,2 MEC(L,I,J,K)=ZERO ENDDO ENDDO ENDDO ENDDO C--Multichannel peak RAND=HWRUNI(0,ZERO,ONE) DO I=1,12 IF(CHAN(I).GT.RAND) GOTO 25 RAND=RAND-CHAN(I) ENDDO 25 GENR=I C--Calculate the hard scale and obtain parton distributions TAUA = MS2(GENR)/S TAUB = SWD(GENR)**2/S RTAB = SQRT(TAUA*TAUB) XUPP = XMAX IF(XMAX**2.GT.S) XUPP = SQRT(S) LOWTLM = DATAN((XMIN**2/S-TAUA)/RTAB)/RTAB UPPTLM = DATAN((XUPP**2/S-TAUA)/RTAB)/RTAB TAU = HWRUNI(0,LOWTLM,UPPTLM) TAU = RTAB*TAN(RTAB*TAU)+TAUA SH = S*TAU SQSH = SQRT(SH) EMSCA = SQSH XX(1) = EXP(HWRUNI(0,ZERO,LOG(TAU))) XX(2) = TAU/XX(1) CALL HWSGEN(.FALSE.) C--Strong, EM coupling and weak couplings AS = HWUALF(1,EMSCA) EC = SQRT(4*PIFAC*HWUAEM(SH)) G = EC/SW C--Calculate the prefactor due multichannel approach FAC = ZERO DO GN=1,12 SCF(GN)=1/((SH-MS2(GN))**2+MSWD(GN)**2) FAC=FAC+CHAN(GN)*SCF(GN) ENDDO FAC=-(UPPTLM-LOWTLM)*LOG(TAU)*GEV2NB & /(48*PIFAC*SQSH*SH*TAU*FAC*S**2) ENDIF HCS = ZERO IF(.NOT.NEUT) GOTO 200 DO 140 GN=1,6 GR=2*GN IF(CHAN(GR).LT.EPS) GOTO 140 DO 130 L=SPMN,SPMX K = 2*GN+5 IF(GN.GT.3) K = 2*GN MQ = RMASS(K) MN = ABS(RMASS(448+L)) MQS = MQ**2 MNS = MN**2 IF(SQSH.LT.(MQ+MN)) GOTO 130 PCM=SQRT((SH-(MQ+MN)**2)*(SH-(MQ-MN)**2)/(4*SH)) ECM=SQRT(PCM**2+MQS) TH = MQS-SQSH*(ECM-PCM*COSTH) UH = MQS-SQSH*(ECM+PCM*COSTH) DO I=1,3 DO 120 J=1,3 IF(GN.LE.3) THEN GU = 6+2*I I1 = 2*I LAMC(1) = LAMDA3(I,J,GN)**2 ELSE GU = 2*I I1 = 2*I-1 LAMC(1) = LAMDA3(GN-3,I,J)**2 IF(J.GT.I) LAMC(1) = ZERO ENDIF GT = 2*J J1 = 2*J-1 C--Now the matrix elements IF(LAMC(1).LT.EPS) GOTO 120 IF(GENEV) GOTO 110 C--S channel ME(3) = MX(GR)**2*SCF(GR)*SH*((SH-MQS-MNS)*(A(L,GR)**2+ & B(L,GR)**2)-4*MQ*MN*A(L,GR)*B(L,GR)) ME(4) =-TWO*MX(GU)*MX(GT)*(MQS*MNS-UH*TH)*A(L,GT)*A(L,GU) & /(TH-MS2(GT))/(UH-MS2(GU)) & +TWO*MX(GR)*MX(GU)*(SH-MS2(GR))*SCF(GR)*SH* & A(L,GU)*(A(L,GR)*UH+B(L,GR)*MQ*MN)/(UH-MS2(GU)) & +TWO*MX(GR)*MX(GT)*(SH-MS2(GR))*SCF(GR)*SH* & A(L,GT)*(A(L,GR)*TH+B(L,GR)*MQ*MN)/(TH-MS2(GT)) C--L/R s channel and interference IF(ABS(MX(GR-1)).GT.EPS) THEN ME(3) = ME(3)+ & MX(GR-1)**2*SCF(GR-1)*SH*((SH-MQS-MNS)*(A(L,GR-1)**2 & +B(L,GR-1)**2)-4*MQ*MN*A(L,GR-1)*B(L,GR-1)) & +TWO*MX(GR)*MX(GR-1)*SCF(GR)*SCF(GR-1)*SH* & ((SH-MS2(GR))*(SH-MS2(GR-1))+MSWD(GR)*MSWD(GR-1))* & ((SH-MQS-MNS)*(A(L,GR)*A(L,GR-1) & +B(L,GR)*B(L,GR-1)) & -TWO*MQ*MN*(A(L,GR)*B(L,GR-1)+A(L,GR-1)*B(L,GR))) ME(4) = ME(4)+TWO*MX(GR-1)*MX(GU)*(SH-MS2(GR-1)) & *SCF(GR-1)*A(L,GU)*SH*(A(L,GR-1)*UH+B(L,GR-1)*MQ*MN) & /(UH-MS2(GU)) & +TWO*MX(GR-1)*MX(GT)*(SH-MS2(GR-1))*SCF(GR-1)*SH* & A(L,GT)*(A(L,GR-1)*TH+B(L,GR-1)*MQ*MN)/(TH-MS2(GT)) IF(ABS(MX(GU-1)).GT.EPS) ME(4)=ME(4)+TWO*MX(GR-1)* & MX(GU-1)*(SH-MS2(GR-1))*SCF(GR-1)*A(L,GU-1)*SH*( & A(L,GR-1)*UH+B(L,GR-1)*MQ*MN)/(UH-MS2(GU-1)) IF(ABS(MX(GT-1)).GT.EPS) ME(4)=ME(4)+TWO*MX(GR-1)* & MX(GT-1)*(SH-MS2(GR-1))*SCF(GR-1)*A(L,GT-1)*SH* & (A(L,GR-1)*TH+B(L,GR-1)*MQ*MN)/(TH-MS2(GT-1)) ENDIF C--u channel and L/R mixing ME(1)= MX(GU)**2*(MQS-UH)*(MNS-UH)* & (A(L,GU)**2+B(L,GU)**2)/(UH-MS2(GU))**2 IF(ABS(MX(GU-1)).GT.EPS) THEN ME(1) = ME(1)+MX(GU-1)**2*(MQS-UH)*(MNS-UH)* & (A(L,GU-1)**2+B(L,GU-1)**2)/(UH-MS2(GU-1))**2 & +TWO*MX(GU)*MX(GU-1)*(MQS-UH)*(MNS-UH)* & (A(L,GU)*A(L,GU-1)+B(L,GU)*B(L,GU-1)) & /(UH-MS2(GU))/(UH-MS2(GU-1)) ME(4) =ME(4)+TWO*MX(GR)*MX(GU-1)*(SH-MS2(GR))* & SCF(GR)*A(L,GU-1)*SH*(A(L,GR)*UH+B(L,GR)*MQ*MN) & /(UH-MS2(GU-1)) & -2*MX(GU-1)*MX(GT)*(MQS*MNS-UH*TH)*A(L,GT)* & A(L,GU-1)/(TH-MS2(GT))/(UH-MS2(GU-1)) IF(ABS(MX(GT-1)).GT.EPS) ME(4)=ME(4)-2*MX(GU-1)*MX(GT-1) & *(MQS*MNS-UH*TH)*A(L,GT-1)*A(L,GU-1) & /(TH-MS2(GT-1))/(UH-MS2(GU-1)) ENDIF C--t channel and t channel L/R mixing ME(2) = MX(GT)**2*(MQS-TH)*(MNS-TH)* & (A(L,GT)**2+B(L,GT)**2)/(TH-MS2(GT))**2 IF(ABS(MX(GT-1)).GT.EPS) THEN ME(2) = ME(2)+MX(GT-1)**2*(MQS-TH)*(MNS-TH)* & (A(L,GT-1)**2+B(L,GT-1)**2)/(TH-MS2(GT-1))**2 & +TWO*MX(GT)*MX(GT-1)*(MQS-TH)*(MNS-TH)*(A(L,GT)* & A(L,GT-1)+ B(L,GT)*B(L,GT-1)) & /(TH-MS2(GT))/(TH-MS2(GT-1)) ME(4)=ME(4)-TWO*MX(GU)*MX(GT-1)*(MQS*MNS-UH*TH)* & A(L,GT-1)*A(L,GU)/(TH-MS2(GT-1))/(UH-MS2(GU)) & +TWO*MX(GR)*MX(GT-1)*(SH-MS2(GR))*SCF(GR)* & A(L,GT-1)*SH*(A(L,GR)*TH+B(L,GR)*MQ*MN) & /(TH-MS2(GT-1)) ENDIF C--Angular ordering and the phase space factors IF(L.EQ.1) THEN ME(4)=-HALF*ME(4)/(ME(1)+ME(2)+ME(3)) LAMC(1) = 32.0D0*LAMC(1)*AS*PIFAC/THREE DO GEN=1,3 MEN(GEN,GN,I,J) = FAC*PCM*LAMC(1)*ME(GEN)*(ONE+ME(4)) ENDDO ELSE LAMC(1) = TWO*LAMC(1)*EC**2 MEN(L+2,GN,I,J)=FAC*PCM*LAMC(1)*(ME(1)+ME(2)+ME(3)+ME(4)) ENDIF C--Multiply by the pdf's 110 IF(L.EQ.1) THEN CM = 1 CN = 3 ELSE CM = L+2 CN = L+2 ENDIF DO GEN=CM,CN CON = 4 IF(GEN.LE.3) CON = GEN HCS=HCS+MEN(GEN,GN,I,J)*DISF(I1,1)*DISF(J1,2) IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(3,I1,J1,K,GEN,0,0,*900) HCS=HCS+MEN(GEN,GN,I,J)*DISF(J1,1)*DISF(I1,2) IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(4,J1,I1,K,GEN,0,0,*900) HCS=HCS+MEN(GEN,GN,I,J)*DISF(I1+6,1)*DISF(J1+6,2) IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(3,I1,J1,K,GEN,1,0,*900) HCS=HCS+MEN(GEN,GN,I,J)*DISF(J1+6,1)*DISF(I1+6,2) IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(4,J1,I1,K,GEN,1,0,*900) ENDDO 120 CONTINUE ENDDO 130 CONTINUE 140 CONTINUE C--Now the chargino processes if wanted 200 IF(.NOT.CHAR) GOTO 300 DO 240 GN=1,6 GR=2*GN IF(CHAN(GR).LT.EPS) GOTO 240 DO 230 L=CHARMN,CHARMX SP =5+L K = 2*GN+6 IF(GN.GT.3) K = 2*GN-1 MQ = RMASS(K) MN = ABS(RMASS(453+L)) MQS = MQ**2 MNS = MN**2 IF(SQSH.LT.(MQ+MN)) GOTO 230 PCM=SQRT((SH-(MQ+MN)**2)*(SH-(MQ-MN)**2)/(4*SH)) ECM=SQRT(PCM**2+MQS) TH = MQS-SQSH*(ECM-PCM*COSTH) UH = MQS-SQSH*(ECM+PCM*COSTH) DO I=1,3 DO 220 J=1,3 IF(GN.LE.3) THEN GU = 2*I GT = 14 I1 = 2*I LAMC(1) = LAMDA3(I,J,GN) LAMC(2) = LAMDA3(GN,I,J) LAMC(3) = ZERO ELSE GU = 6+2*I GT = 6+2*J I1 = 2*I-1 LAMC(1) = LAMDA3(GN-3,I,J) LAMC(2) = LAMDA3(I,J,GN-3) LAMC(3) = LAMDA3(J,GN-3,I) IF(J.GT.I) LAMC(1) = ZERO ENDIF J1 = 2*J-1 IF(ABS(LAMC(1)).LT.EPS) GOTO 220 IF(GENEV) GOTO 210 C--Matrix element C--S channel ME(1) = LAMC(1)**2*MX(GR)**2*SCF(GR)*SH*((SH-MQS-MNS)* & (A(SP,GR)**2+B(SP,GR)**2)-4*MQ*MN*A(SP,GR)*B(SP,GR)) IF(ABS(MX(GU)).GT.EPS) THEN ME(1) = ME(1)+LAMC(2)**2*MX(GU)**2*(MQS-UH)*(MNS-UH)* & (A(SP,GU)**2+B(SP,GU)**2)/(UH-MS2(GU))**2 & +LAMC(1)*LAMC(2)*TWO*MX(GR)*MX(GU)* & (SH-MS2(GR))*SCF(GR)*A(SP,GU)*SH* & (A(SP,GR)*UH+B(SP,GR)*MQ*MN)/(UH-MS2(GU)) IF(ABS(MX(GT)).GT.EPS) ME(1) = ME(1)-LAMC(2)*LAMC(3)* & TWO*MX(GU)*MX(GT)*(MQS*MNS-UH*TH)*A(SP,GT)* & A(SP,GU)/(TH-MS2(GT))/(UH-MS2(GU)) ENDIF IF(ABS(MX(GT)).GT.EPS) THEN ME(1) = ME(1)+LAMC(3)**2*MX(GT)**2*(MQS-TH)*(MNS-TH)* & (A(SP,GT)**2+B(SP,GT)**2)/(TH-MS2(GT))**2 & +LAMC(1)*LAMC(3)*TWO*MX(GR)*MX(GT)* & (SH-MS2(GR))*SCF(GR)*A(SP,GT)*SH* & (A(SP,GR)*TH+B(SP,GR)*MQ*MN)/(TH-MS2(GT)) ENDIF c--L/R s channel and interference IF(ABS(MX(GR-1)).GT.EPS) THEN ME(1) = ME(1)+LAMC(1)**2*MX(GR-1)**2*SCF(GR-1)*SH* & ((SH-MQS-MNS)*(A(SP,GR-1)**2+B(SP,GR-1)**2) & -4*MQ*MN*A(SP,GR-1)*B(SP,GR-1)) & +LAMC(1)**2*TWO*MX(GR)*MX(GR-1)*SCF(GR)* & SCF(GR-1)*SH* & ((SH-MS2(GR))*(SH-MS2(GR-1))+ & MSWD(GR)*MSWD(GR-1))* & ((SH-MQS-MNS)*(A(SP,GR)*A(SP,GR-1)+ & B(SP,GR)*B(SP,GR-1))-TWO*MQ*MN* & (A(SP,GR)*B(SP,GR-1)+A(SP,GR-1)*B(SP,GR))) IF(ABS(MX(GU)).GT.EPS) ME(1) = ME(1)+LAMC(1)*LAMC(2)* & TWO*MX(GR-1)*MX(GU)*(SH-MS2(GR-1))*SCF(GR-1)* & A(SP,GU)*SH*(A(SP,GR-1)*UH+B(SP,GR-1)*MQ*MN) & /(UH-MS2(GU)) IF(ABS(MX(GT)).GT.EPS) ME(1) = ME(1)+LAMC(1)*LAMC(3)* & TWO*MX(GR-1)*MX(GT)*(SH-MS2(GR-1))*SCF(GR-1)* & A(SP,GT)*SH*(A(SP,GR-1)*TH+B(SP,GR-1)*MQ*MN) & /(TH-MS2(GT)) IF(ABS(MX(GU-1)).GT.EPS) ME(1)=ME(1)+LAMC(1)*LAMC(2)* & TWO*MX(GR-1)*MX(GU-1)*(SH-MS2(GR-1))* & SCF(GR-1)*A(SP,GU-1)*SH*(A(SP,GR-1)*UH+ & B(SP,GR-1)*MQ*MN)/(UH-MS2(GU-1)) IF(ABS(MX(GT-1)).GT.EPS) ME(1)=ME(1)+LAMC(1)*LAMC(3)* & TWO*MX(GR-1)*MX(GT-1)*(SH-MS2(GR-1))* & SCF(GR-1)*A(SP,GT-1)*SH*(A(SP,GR-1)*TH+ & B(SP,GR-1)*MQ*MN)/(TH-MS2(GT-1)) ENDIF C--u channel and L/R mixing IF(ABS(MX(GU-1)).GT.EPS) THEN ME(1) = ME(1)+LAMC(2)**2*MX(GU-1)**2*(MQS-UH)*(MNS-UH)* & (A(SP,GU-1)**2+B(SP,GU-1)**2)/(UH-MS2(GU-1))**2 & +LAMC(2)**2*TWO*MX(GU)*MX(GU-1)*(MQS-UH)*(MNS-UH)* & (A(SP,GU)*A(SP,GU-1)+B(SP,GU)*B(SP,GU-1)) & /(UH-MS2(GU))/(UH-MS2(GU-1)) & +TWO*LAMC(1)*LAMC(2)*MX(GR)*MX(GU-1)* & (SH-MS2(GR))*SCF(GR)*A(SP,GU-1)*SH* & (A(SP,GR)*UH+B(SP,GR)*MQ*MN)/(UH-MS2(GU-1)) IF(ABS(MX(GT)).GT.EPS) ME(1)=ME(1)-LAMC(2)*LAMC(3)*TWO* & MX(GU-1)*MX(GT)*(MQS*MNS-UH*TH)*A(SP,GT)*A(SP,GU-1) & /(TH-MS2(GT))/(UH-MS2(GU-1)) IF(ABS(MX(GT-1)).GT.EPS) ME(1)=ME(1)-LAMC(2)*LAMC(3)* & TWO*MX(GU-1)*MX(GT-1)*(MQS*MNS-UH*TH)*A(SP,GT-1)* & A(SP,GU-1)/(TH-MS2(GT-1))/(UH-MS2(GU-1)) ENDIF C--t channel and t channel L/R mixing IF(ABS(MX(GT-1)).GT.EPS) THEN ME(1) = ME(1)+LAMC(3)**2*MX(GT-1)**2*(MQS-TH)*(MNS-TH)* & (A(SP,GT-1)**2+B(SP,GT-1)**2)/(TH-MS2(GT-1))**2 & +LAMC(3)**2*TWO*MX(GT)*MX(GT-1)*(MQS-TH)*(MNS-TH)* & (A(SP,GT)*A(SP,GT-1)+B(SP,GT)*B(SP,GT-1)) & /(TH-MS2(GT))/(TH-MS2(GT-1)) & +LAMC(1)*LAMC(3)*TWO*MX(GR)*MX(GT-1)* & (SH-MS2(GR))*SCF(GR)*A(SP,GT-1)*SH* & (A(SP,GR)*TH+B(SP,GR)*MQ*MN)/(TH-MS2(GT-1)) IF(ABS(MX(GU)).GT.EPS) ME(1)=ME(1)-LAMC(2)*LAMC(3)*TWO* & MX(GU)*MX(GT-1)*(MQS*MNS-UH*TH)*A(SP,GT-1)*A(SP,GU) & /(TH-MS2(GT-1))/(UH-MS2(GU)) ENDIF c--phase space factors MEC(L,GN,I,J) = G**2*FAC*ME(1)*PCM 210 CON = 4 I2 = SP+2 IF(MOD(K,2).EQ.1) I2 =I2+2 HCS=HCS+MEC(L,GN,I,J)*DISF(I1,1)*DISF(J1,2) IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(3,I1,J1,K,I2,0,0,*900) HCS=HCS+MEC(L,GN,I,J)*DISF(J1,1)*DISF(I1,2) IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(4,J1,I1,K,I2,0,0,*900) HCS=HCS+MEC(L,GN,I,J)*DISF(I1+6,1)*DISF(J1+6,2) IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(3,I1,J1,K,I2+2,1,0,*900) HCS=HCS+MEC(L,GN,I,J)*DISF(J1+6,1)*DISF(I1+6,2) IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(4,J1,I1,K,I2+2,1,0,*900) 220 CONTINUE ENDDO 230 CONTINUE 240 CONTINUE C--Now the radiative decays, if possible 300 IF(.NOT.RAD.OR.(CHAN(5).LT.EPS.AND.CHAN(11).LT.EPS)) GOTO 400 IF(GENEV) GOTO 320 DO 310 I=1,6 310 MER(I)=ZERO C--stop to light stop and Z IF(SH.GT.(MZ+MS(11))**2) THEN PCM = SQRT((SH-(MZ+MS(11))**2)*(SH-(MZ-MS(11))**2))*HALF/SQSH ECM=SQRT(PCM**2+MZ2) TH = MZ2-SQSH*(ECM-PCM*COSTH) UH = MZ2-SQSH*(ECM+PCM*COSTH) MER(3) = SH**2*PCM**2*(SCF(11)*ZSQU(2,1)**2*QMIXSS(6,2,1)**2 & +SCF(12)*ZSQU(2,2)**2*QMIXSS(6,2,2)**2 & +TWO*SCF(11)*SCF(12)*QMIXSS(6,2,1)*QMIXSS(6,2,2)* & ZSQU(2,1)*ZSQU(2,2)*((SH-MS2(11))* & (SH-MS2(12))+MSWD(11)*MSWD(12))) & +QMIXSS(6,2,1)**2/UH**2*ZQRK(1)**2*( & TWO*MZ2*(UH*TH-MS2(11)*MZ2)+UH**2*SH) & +QMIXSS(6,2,1)**2/TH**2*ZQRK(1)**2*( & TWO*MZ2*(UH*TH-MS2(11)*MZ2)+TH**2*SH) & +ZQRK(1)*SH*QMIXSS(6,2,1)* & (QMIXSS(6,2,1)*ZSQU(2,1)*(SH-MS2(11))*SCF(11) & +QMIXSS(6,2,2)*ZSQU(2,2)*(SH-MS2(12))*SCF(12)) & *((MZ2*(TWO*MS2(11)-TH)+TH*(SH-MS2(11)))/TH & +(MZ2*(TWO*MS2(11)-UH)+UH*(SH-MS2(11)))/UH) & -TWO*QMIXSS(6,2,1)**2/UH/TH*ZQRK(1)**2* & (TWO*MZ2*(MS2(11)-UH)*(MS2(11)-TH)-SH*TH*UH) MER(3) = MER(3)*FOUR*PCM/MZ2 ENDIF C--sbottom to light sbottom and Z IF(SH.GT.(MZ+MS(5))**2) THEN PCM = SQRT((SH-(MZ+MS(5))**2)*(SH-(MZ-MS(5))**2))*HALF/SQSH ECM=SQRT(PCM**2+MZ2) TH = MZ2-SQSH*(ECM-PCM*COSTH) UH = MZ2-SQSH*(ECM+PCM*COSTH) MER(6) = SH**2*PCM**2*(SCF(5)*QMIXSS(5,2,1)**2*ZSQU(1,1)**2 & +SCF(6)*QMIXSS(5,2,2)**2*ZSQU(1,2)**2 & +TWO*SCF(5)*SCF(6)*QMIXSS(5,2,1)*QMIXSS(5,2,2)* & ZSQU(1,1)*ZSQU(1,2)*((SH-MS2(5))* & (SH-MS2(6))+MSWD(5)*MSWD(6))) & +QMIXSS(5,2,1)**2/UH**2*ZQRK(1)**2* & (TWO*MZ2*(UH*TH-MS2(5)*MZ2)+UH**2*SH) & +QMIXSS(5,2,1)**2/TH**2*ZQRK(2)**2* & (TWO*MZ2*(UH*TH-MS2(5)*MZ2)+TH**2*SH) & +QMIXSS(5,2,1)*SH* & (QMIXSS(5,2,1)*ZSQU(1,1)*(SH-MS2(5))*SCF(5) & +QMIXSS(5,2,2)*ZSQU(1,2)*(SH-MS2(6))*SCF(6))* & (ZQRK(1)/UH*(MZ2*(TWO*MS2(5)-UH)+(SH-MS2(5))*UH) & +ZQRK(2)/TH*(MZ2*(TWO*MS2(5)-TH)+(SH-MS2(5))*TH)) & -TWO*QMIXSS(5,2,1)**2*ZQRK(1)*ZQRK(2)/UH/TH* & (TWO*MZ2*(MS2(5)-UH)*(MS2(5)-TH)-SH*TH*UH) MER(6) = MER(6)*FOUR*PCM/MZ2 ENDIF C--stop to sbottom and W DO J=1,2 IF(SH.GT.(MW+MS(4+J))**2) THEN PCM =SQRT((SH-(MW+MS(4+J))**2)*(SH-(MW-MS(4+J))**2))*HALF/SQSH C--diagram square pieces DO I=1,2 MER(J)=MER(J)+SCF(10+I)* & (QMIXSS(6,2,I)*QMIXSS(6,1,I)*QMIXSS(5,1,J))**2 ENDDO C--light/heavy interference MER(J)=TWO*SH**2*PCM**3/MW2*(MER(J)+TWO*SCF(11)*SCF(12)* & ((SH-MS2(11))*(SH-MS2(12)) & +MSWD(11)*MSWD(12))*QMIXSS(5,1,J)**2* & QMIXSS(6,2,1)*QMIXSS(6,2,2)*QMIXSS(6,1,1)*QMIXSS(6,1,2)) ENDIF C--sbottom to stop and W IF(SH.GT.(MW+MS(10+J))**2) THEN PCM=SQRT((SH-(MW+MS(10+J))**2)*(SH-(MW-MS(10+J))**2))*HALF/SQSH C--diagram square pieces DO I=1,2 MER(J+3)=MER(J+3)+SCF(4+I)* & (QMIXSS(5,2,I)*QMIXSS(5,1,I)*QMIXSS(6,1,J))**2 ENDDO C--light/heavy interference MER(J+3)=TWO*SH**2*PCM**3/MW2*(MER(J+3)+TWO*SCF(5)*SCF(6)* & ((SH-MS2(5))*(SH-MS2(6))+ & MSWD(5)*MSWD(6))*QMIXSS(6,1,J)**2* & QMIXSS(5,2,1)*QMIXSS(5,2,2)*QMIXSS(5,1,1)*QMIXSS(5,1,2)) ENDIF ENDDO C--Now multiply by the parton distributions and phase space factors 320 DO J=1,3 DO K=1,3 CON = 5 C--resonant stop's IF(ABS(LAMDA3(3,J,K)).GT.EPS.AND.J.LT.K) THEN FAC2 = LAMDA3(3,J,K)**2*FAC*G**2 DO I=1,3 I1=2*J-1 J1=2*K-1 ME2 = MER(I)*FAC2 HCS=HCS+ME2*DISF(I1,1)*DISF(J1,2) IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(5,I1,J1,I,I,0,0,*900) HCS=HCS+ME2*DISF(J1,1)*DISF(I1,2) IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(6,J1,I1,I,I,0,0,*900) HCS=HCS+ME2*DISF(I1+6,1)*DISF(J1+6,2) IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(5,I1,J1,I,I,1,0,*900) HCS=HCS+ME2*DISF(J1+6,1)*DISF(I1+6,2) IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(6,J1,I1,I,I,1,0,*900) ENDDO ENDIF C--resonant sbottom's IF(ABS(LAMDA3(J,K,3)).GT.EPS) THEN FAC2 = LAMDA3(J,K,3)**2*FAC*G**2 DO I=4,6 I1=2*J J1=2*K-1 ME2 = MER(I)*FAC2 HCS=HCS+ME2*DISF(I1,1)*DISF(J1,2) IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(5,I1,J1,I,I,0,0,*900) HCS=HCS+ME2*DISF(J1,1)*DISF(I1,2) IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(6,J1,I1,I,I,0,0,*900) HCS=HCS+ME2*DISF(I1+6,1)*DISF(J1+6,2) IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(5,I1,J1,I,I,1,0,*900) HCS=HCS+ME2*DISF(J1+6,1)*DISF(I1+6,2) IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(6,J1,I1,I,I,1,0,*900) ENDDO ENDIF ENDDO ENDDO C--Now the Higgs decays if possible 400 IF(.NOT.HIGGS) GOTO 900 IF(GENEV) GOTO 490 DO I=1,3 DO 405 J=1,42 405 MEH(I,J) = ZERO ENDDO DO I=1,3 DO 420 J=1,3 C--Neutral Higgs down type squark IF(SQSH.LT.MH(J)+MS(2*I-1)) GOTO 410 PCM = SQRT((SH-(MH(J)+MS(2*I-1))**2)* & (SH-(MH(J)-MS(2*I-1))**2))*HALF/SQSH ECM=SQRT(PCM**2+MH(J)**2) TH = MH(J)**2-SQSH*(ECM-PCM*COSTH) UH = MH(J)**2-SQSH*(ECM+PCM*COSTH) MEH(1,3*I-3+J) = PCM*SH*( & QMIXSS(2*I-1,2,1)**2*SCF(2*I-1)*GHSQSS(J,2*I-1,1,1)**2 & +QMIXSS(2*I-1,2,2)**2*SCF(2*I)*GHSQSS(J,2*I-1,2,1)**2 & +TWO*QMIXSS(2*I-1,2,1)*QMIXSS(2*I-1,2,2)*SCF(2*I-1) & *SCF(2*I)*GHSQSS(J,2*I-1,1,1)*GHSQSS(J,2*I-1,2,1)* & ((SH-MS2(2*I-1))*(SH-MS2(2*I))+MSWD(2*I-1)*MSWD(2*I))) MEH(2,3*I-3+J) = PCM*GUU(J)*QMIXSS(2*I,2,1)**2/TH**2* & (TH*UH-MH(J)**2*MS2(2*I-1)) MEH(3,3*I-3+J) = PCM*GDD(J)*QMIXSS(2*I,2,1)**2/UH**2* & (TH*UH-MH(J)**2*MS2(2*I-1)) C--Neutral Higgs up type squarks 410 IF(SQSH.LT.MH(J)+MS(2*I+5)) GOTO 420 PCM = SQRT((SH-(MH(J)+MS(2*I+5))**2)* & (SH-(MH(J)-MS(2*I+5))**2))*HALF/SQSH ECM=SQRT(PCM**2+MH(J)**2) TH = MH(J)**2-SQSH*(ECM-PCM*COSTH) UH = MH(J)**2-SQSH*(ECM+PCM*COSTH) MEH(1,3*I+6+J) = PCM*SH*( & QMIXSS(2*I,2,1)**2*SCF(2*I+5)*GHSQSS(J,2*I,1,1)**2 & +QMIXSS(2*I,2,2)**2*SCF(2*I+6)*GHSQSS(J,2*I,2,1)**2 & +TWO*QMIXSS(2*I,2,1)*QMIXSS(2*I,2,2)*SCF(2*I+5) & *SCF(2*I+6)*GHSQSS(J,2*I,1,1)*GHSQSS(J,2*I,2,1)* & ((SH-MS2(2*I+5))*(SH-MS2(2*I+6))+ & MSWD(2*I+5)*MSWD(2*I+6))) MEH(2,3*I+6+J) = PCM*GDD(J)*QMIXSS(2*I-1,2,1)**2/TH**2* & (TH*UH-MH(J)**2*MS2(2*I+5)) MEH(3,3*I+6+J) = PCM*GDD(J)*QMIXSS(2*I-1,2,1)**2/UH**2* & (TH*UH-MH(J)**2*MS2(2*I+5)) 420 CONTINUE C--Charged Higgs up type squark DO 440 J=1,2 IF(SQSH.LT.MH(4)+MS(2*I+4+J)) GOTO 430 PCM = SQRT((SH-(MH(4)+MS(2*I+4+J))**2)* & (SH-(MH(4)-MS(2*I+4+J))**2))*HALF/SQSH ECM=SQRT(PCM**2+MH(4)**2) TH = MH(4)**2-SQSH*(ECM-PCM*COSTH) UH = MH(4)**2-SQSH*(ECM+PCM*COSTH) MEH(1,4*I+14+J) = PCM*SH*( & QMIXSS(2*I-1,2,1)**2*GHSQSS(4,2*I,J,1)**2*SCF(2*I-1) & +QMIXSS(2*I-1,2,2)**2*GHSQSS(4,2*I,J,2)**2*SCF(2*I) & +TWO*QMIXSS(2*I-1,2,1)*QMIXSS(2*I-1,2,2)*SCF(2*I-1) & *SCF(2*I)*GHSQSS(4,2*I,J,1)*GHSQSS(4,2*I,J,2)* & ((SH-MS2(2*I-1))*(SH-MS2(2*I))+ & MSWD(2*I-1)*MSWD(2*I))) MEH(2,4*I+14+J) = PCM*QMIXSS(2*I,2,J)**2*GDD(4)/TH**2* & (UH*TH-MS2(2*I+4+J)*MH(4)**2) C--Charged Higgs down type squark 430 IF(SQSH.LT.MH(4)+MS(2*I-2+J)) GOTO 440 PCM = SQRT((SH-(MH(4)+MS(2*I-2+J))**2)* & (SH-(MH(4)-MS(2*I-2+J))**2))*HALF/SQSH ECM=SQRT(PCM**2+MH(4)**2) TH = MH(4)**2-SQSH*(ECM-PCM*COSTH) UH = MH(4)**2-SQSH*(ECM+PCM*COSTH) MEH(1,4*I+16+J) = PCM*SH*( & QMIXSS(2*I,2,1)**2*GHSQSS(4,2*I-1,J,1)**2*SCF(2*I+5) & +QMIXSS(2*I,2,2)**2*GHSQSS(4,2*I-1,J,2)**2*SCF(2*I+6) & +TWO*QMIXSS(2*I,2,1)*QMIXSS(2*I,2,2)*SCF(2*I+5) & *SCF(2*I+6)*GHSQSS(4,2*I-1,J,1)*GHSQSS(4,2*I-1,J,2)* & ((SH-MS2(2*I+5))*(SH-MS2(2*I+6))+ & MSWD(2*I+5)*MSWD(2*I+6))) MEH(2,4*I+16+J) = PCM*QMIXSS(2*I-1,2,J)**2*GUU(4)/TH**2* & (UH*TH-MS2(2*I-2+J)*MH(4)**2) MEH(3,4*I+16+J) = PCM*QMIXSS(2*I-1,2,J)**2*GUU(4)/UH**2* & (UH*TH-MS2(2*I-2+J)*MH(4)**2) 440 CONTINUE ENDDO 490 DO I=1,3 DO J=1,3 DO K=1,3 CON = 5 DO L=1,3 IF(ABS(LAMDA3(J,K,I)).GT.EPS) THEN C--neutral higgs and sdown FAC2 = FAC*G**2*LAMDA3(J,K,I)**2 I1=2*J J1=2*K-1 ME2 = FAC2*(MEH(1,3*I-3+L)+RMASS(I1)**2*MEH(2,3*I-3+L) & +RMASS(J1)**2*MEH(3,3*I-3+L)) HCS=HCS+ME2*DISF(I1,1)*DISF(J1,2) IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(7,I1,J1,L,2*I-1,0,0,*900) HCS=HCS+ME2*DISF(J1,1)*DISF(I1,2) IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(8,J1,I1,L,2*I-1,0,0,*900) IF(I2.NE.200) I2=198 HCS=HCS+ME2*DISF(I1+6,1)*DISF(J1+6,2) IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(7,I1,J1,L,2*I-1,1,0,*900) HCS=HCS+ME2*DISF(J1+6,1)*DISF(I1+6,2) IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(8,J1,I1,L,2*I-1,1,0,*900) ENDIF IF(ABS(LAMDA3(I,J,K)).GT.EPS.AND.J.LT.K) THEN FAC2 = FAC*G**2*LAMDA3(I,J,K)**2 C--neutral higgs and sup I1=2*J-1 J1=2*K-1 ME2 = FAC2*(MEH(1,3*I+6+L)+RMASS(I1)**2*MEH(2,3*I+6+L) & +RMASS(J1)**2*MEH(3,3*I+6+L)) HCS=HCS+ME2*DISF(I1,1)*DISF(J1,2) IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(7,I1,J1,L,2*I+5,0,0,*900) HCS=HCS+ME2*DISF(J1,1)*DISF(I1,2) IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(8,J1,I1,L,2*I+5,0,0,*900) HCS=HCS+ME2*DISF(I1+6,1)*DISF(J1+6,2) IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(7,I1,J1,L,2*I+5,1,0,*900) HCS=HCS+ME2*DISF(J1+6,1)*DISF(I1+6,2) IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(8,J1,I1,L,2*I+5,1,0,*900) ENDIF ENDDO DO L=1,2 IF(ABS(LAMDA3(J,K,I)).GT.EPS) THEN C--charged higgs and sup I1=2*J J1=2*K-1 FAC2 = FAC*G**2 ME2 = FAC2*(LAMDA3(J,K,I)**2*MEH(1,4*I+L+14) & +LAMDA3(I,J,K)**2*RMASS(I1-1)**2*MEH(2,4*I+L+14)) HCS= HCS+ME2*DISF(I1,1)*DISF(J1,2) IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(7,I1,J1,4,2*I+4+L,0,0,*900) HCS= HCS+ME2*DISF(J1,1)*DISF(I1,2) IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(8,J1,I1,4,2*I+4+L,0,0,*900) HCS= HCS+ME2*DISF(I1+6,1)*DISF(J1+6,2) IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(7,I1,J1,5,2*I+4+L,1,0,*900) HCS= HCS+ME2*DISF(J1+6,1)*DISF(I1+6,2) IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(8,J1,I1,5,2*I+4+L,1,0,*900) ENDIF C--charged higgs and sdown IF(ABS(LAMDA3(I,J,K)).GT.EPS.AND.J.LT.K) THEN I1=2*J-1 J1=2*K-1 FAC2 = FAC*G**2 ME2 = FAC2*(MEH(1,4*I+L+16)*LAMDA3(I,J,K)**2 & +RMASS(I1+1)**2*LAMDA3(J,I,K)**2*MEH(2,4*I+L+16) & +RMASS(J1+1)**2*LAMDA3(K,I,J)**2*MEH(3,4*I+L+16)) HCS=HCS+ME2*DISF(I1,1)*DISF(J1,2) IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(7,I1,J1,5,2*I-2+L,0,0,*900) HCS=HCS+ME2*DISF(J1,1)*DISF(I1,2) IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(8,J1,I1,5,2*I-2+L,0,0,*900) HCS=HCS+ME2*DISF(I1+6,1)*DISF(J1+6,2) IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(7,I1,J1,4,2*I-2+L,1,0,*900) HCS=HCS+ME2*DISF(J1+6,1)*DISF(I1+6,2) IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(8,J1,I1,4,2*I-2+L,1,0,*900) ENDIF ENDDO ENDDO ENDDO ENDDO C--calculate of the matrix elements 900 IF(GENEV) THEN CALL HWETWO IF(IERROR.NE.0) RETURN HVFCEN = .TRUE. C--first stage of the colour connection corrections DO THEP=1,5 IF(THEP.NE.3) THEN JMOHEP(2,THEP+NHEP-5)=NHEP-5+THEP & +CONECT(HWRINT(1,2),THEP,CON) JDAHEP(2,THEP+NHEP-5) = JMOHEP(2,THEP+NHEP-5) ENDIF ENDDO IF(IDHEP(NHEP-4).LT.0) THEN JDAHEP(2,NHEP-4)=NHEP-1 JDAHEP(2,NHEP-3)=NHEP-3 JDAHEP(2,NHEP-1)=NHEP-4 IF(CON.EQ.5) JDAHEP(2,NHEP-4)=NHEP JDAHEP(2,NHEP)=CONECT(1,6,CON)+NHEP ELSE JMOHEP(2,NHEP-4)=NHEP-1 JMOHEP(2,NHEP-3)=NHEP-3 JMOHEP(2,NHEP-1)=NHEP-4 IF(CON.EQ.5) JMOHEP(2,NHEP-4)=NHEP JMOHEP(2,NHEP)=CONECT(1,6,CON)+NHEP ENDIF IF(CON.EQ.5) THEN SP=JDAHEP(2,NHEP) JDAHEP(2,NHEP) = JDAHEP(2,NHEP-1) JDAHEP(2,NHEP-1) = SP SP=JMOHEP(2,NHEP) JMOHEP(2,NHEP) = JMOHEP(2,NHEP-1) JMOHEP(2,NHEP-1) = SP ENDIF HRDCOL(1,1) = NHEP HRDCOL(1,2) = NHEP-2 ELSE EVWGT = HCS ENDIF 999 END CDECK ID>, HWHREM. *CMZ :- -01/06/94 17.03.31 by Mike Seymour *-- Author : Mike Seymour C----------------------------------------------------------------------- SUBROUTINE HWHREM(IBEAM,ITARG) C----------------------------------------------------------------------- C IDENTIFY THE REMNANTS OF THE HARD SCATTERING C AND BREAK THEIR COLOUR CONNECTION IF NECESSARY C----------------------------------------------------------------------- INCLUDE 'HERWIG61.INC' DOUBLE PRECISION PCL(5) INTEGER IBEAM,ITARG,IHEP,NTEMP,I,ICOL,IANT LOGICAL LTEMP,T,COL,ANT PARAMETER (T=.TRUE.) COL(I)=I.EQ.13 .OR. I.GE.1.AND.I.LE.6 .OR. I.GE.115.AND.I.LE.120 ANT(I)=I.EQ.13 .OR. I.GE.7.AND.I.LE.12.OR. I.GE.109.AND.I.LE.114 C---LOOK FOR UNTREATED BEAM AND TARGET REMNANTS IBEAM=0 ITARG=0 DO 10 IHEP=1,NHEP IF (ISTHEP(IHEP).EQ.148) THEN IF (ITARG.NE.0) CALL HWWARN('HWHREM',100,*999) ITARG=IHEP ELSEIF (ISTHEP(IHEP).EQ.147) THEN IF (IBEAM.NE.0) CALL HWWARN('HWHREM',101,*999) IBEAM=IHEP ENDIF 10 CONTINUE IF (ITARG.EQ.0) CALL HWWARN('HWHREM',102,*999) IF (IBEAM.EQ.0) CALL HWWARN('HWHREM',103,*999) C---IF THEY ARE COLOUR CONNECTED, DISCONNECT THEM BY EMITTING A SOFT C GLUON AND SPLITTING THAT GLUON TO LIGHT QUARKS C (WHICH NORMALLY GETS DONE AS THE FIRST STAGE OF CLUSTER FORMATION) C---LOOP OVER COLOUR/ANTICOLOUR LINE DO 20 I=1,2 IF (I.EQ.1) THEN ICOL=IBEAM IANT=ITARG ELSE ICOL=ITARG IANT=IBEAM ENDIF IF (COL(IDHW(ICOL)).AND.ANT(IDHW(IANT)).AND. $ JMOHEP(2,ICOL).EQ.IANT.AND.JDAHEP(2,IANT).EQ.ICOL) THEN CALL HWVSUM(4,PHEP(1,ICOL),PHEP(1,IANT),PCL) CALL HWUMAS(PCL) NTEMP=NHEP CALL HWCCUT(ICOL,IANT,PCL,T,LTEMP) C---IF NOTHING WAS CREATED THEY MUST BE BELOW THRESHOLD, SO GIVE UP IF (NHEP.NE.NTEMP+2) RETURN C---RELABEL THEM AS PERTUBATIVE JUST TO NEATEN UP THE EVENT RECORD ISTHEP(NHEP-1)=149 ISTHEP(NHEP)=149 ENDIF 20 CONTINUE 999 END CDECK ID>, HWHRLL. *CMZ :- -13/12/99 15:12:21 by Peter Richardson *-- Author : Peter Richardson C----------------------------------------------------------------------- SUBROUTINE HWHRLL C----------------------------------------------------------------------- C Subroutine for resonant sleptons to standard model particles C----------------------------------------------------------------------- INCLUDE 'HERWIG61.INC' DOUBLE PRECISION HCS,S,RCS,HWR,FAC,ECM,TH,PCM,CFAC,CHANPB,SH, & TAU,TAUA,TAUB,LOWTLM,UPPTLM,HWRUNI,MSL(12), & SQSH,MET(2),SCF(12),MIX(12),ME(4,3,3,3,3,2), & RAND,CHAN(12),LAM(2,7,3,3,3,3),SLWD(12),RTAB, & WD,MQ1,MQ2,EPS,XMIN,XMAX,XPOW,XUPP,MSL2(12), & MSWD(12) INTEGER I,J,K,L,I1,J1,K1,L1,GEN,GN,GR,GNMX,GNMN,MIG,MXG,CUP,CF LOGICAL FIRST EXTERNAL HWR,HWRUNI PARAMETER(EPS=1D-20) COMMON/HWRPIN/XMIN,XMAX,XPOW,FIRST SAVE HCS,ME,MSL,SLWD,LAM,MIX,CHAN,GNMN,GNMX,SH,SQSH,FAC,SCF IF(GENEV) THEN RCS = HCS*HWR() ELSE IF(FSTWGT) THEN DO I=1,3 MSL(2*I-1) = RMASS(423+2*I) MSL(2*I) = RMASS(435+2*I) MSL(2*I+5) = RMASS(424+2*I) MSL(2*I+6) = RMASS(436+2*I) SLWD(2*I-1) = HBAR/RLTIM(423+2*I) SLWD(2*I) = HBAR/RLTIM(435+2*I) SLWD(2*I+5) = HBAR/RLTIM(424+2*I) SLWD(2*I+6) = HBAR/RLTIM(436+2*I) ENDDO DO I=1,12 MSL2(I) = MSL(I)**2 MSWD(I) = MSL(I)*SLWD(I) ENDDO RAND = ZERO DO I=1,3 CHANPB=ZERO DO J=1,3 DO K=1,3 CHANPB=CHANPB+LAMDA2(I,J,K)**4 ENDDO ENDDO RAND=RAND+2*CHANPB DO J=1,2 CHAN(2*I-2+J) = LMIXSS(2*I-1,1,J)**2*CHANPB CHAN(2*I+4+J) = LMIXSS(2*I ,1,J)**2*CHANPB MIX(2*I-2+J) = LMIXSS(2*I-1,1,J)**2 MIX(2*I+4+J) = LMIXSS(2*I ,1,J)**2 ENDDO ENDDO IF(RAND.GT.ZERO) THEN DO I=1,12 CHAN(I)=CHAN(I)/RAND ENDDO ELSE CALL HWWARN('HWHRLL',500,*999) ENDIF C--find the couplings DO GN=1,3 DO I=1,3 DO J=1,3 DO K=1,3 DO L=1,3 LAM(1,GN,I,J,K,L) =LAMDA2(GN,I,J)*LAMDA1(GN,K,L) LAM(2,GN,I,J,K,L) =LAMDA2(GN,I,J)*LAMDA2(GN,K,L) LAM(1,GN+3,I,J,K,L)=LAM(1,GN,I,J,K,L) LAM(2,GN+3,I,J,K,L)=LAM(2,GN,I,J,K,L) ENDDO ENDDO ENDDO ENDDO ENDDO C--select the process from the IPROC code GNMN = 1 GNMX = 4 IF(IPROC.EQ.4070) THEN GNMX = 2 ELSEIF(IPROC.EQ.4080) THEN GNMN = 3 ENDIF ENDIF EVWGT = ZERO S = PHEP(5,3)**2 COSTH = HWRUNI(0,-ONE,ONE) C--Generate the smoothing RAND=HWRUNI(0,ZERO,ONE) DO I=1,12 IF(CHAN(I).GT.RAND) GOTO 20 RAND=RAND-CHAN(I) ENDDO 20 GR = I C--Calculate hard scale and obtain parton distributions TAUA = MSL2(GR)/S TAUB = SLWD(GR)**2/S RTAB = SQRT(TAUA*TAUB) XUPP = XMAX IF(XMAX**2.GT.S) XUPP = SQRT(S) LOWTLM = DATAN((XMIN**2/S-TAUA)/RTAB)/RTAB UPPTLM = DATAN((XUPP**2/S-TAUA)/RTAB)/RTAB TAU = HWRUNI(0,LOWTLM,UPPTLM) TAU = RTAB*TAN(RTAB*TAU)+TAUA SH = S*TAU SQSH = SQRT(SH) EMSCA = SQSH XX(1) = EXP(HWRUNI(0,ZERO,LOG(TAU))) XX(2) = TAU/XX(1) CALL HWSGEN(.FALSE.) C--Calculate the prefactor due multichannel approach FAC = ZERO DO GN=1,12 SCF(GN)=1/((SH-MSL2(GN))**2+MSWD(GN)**2) FAC=FAC+CHAN(GN)*SCF(GN) ENDDO FAC=-(UPPTLM-LOWTLM)*LOG(TAU)*GEV2NB & /(96*PIFAC*SQSH*SH*TAU*FAC*S**2) ENDIF C--Now the loop to actually calculate the cross-sections HCS = ZERO DO GN=GNMN,GNMX IF(MOD(GN,2).EQ.1) THEN MIG = 1 MXG = 6 ELSE MIG = 7 MXG = 12 ENDIF IF(GN.LE.2) THEN CFAC = THREE*FAC CUP=2 ELSE CFAC = FAC CUP=1 ENDIF DO K1=1,3 DO 80 L1=1,3 IF(GN.EQ.1) THEN K = 2*K1 L = 2*L1+5 ELSEIF(GN.EQ.2) THEN K = 2*K1-1 L = 2*L1+5 ELSEIF(GN.EQ.3) THEN K = 120+2*K1 L = 125+2*L1 ELSEIF(GN.EQ.4) THEN K = 119+2*K1 L = 125+2*L1 ENDIF MQ1 = RMASS(K) MQ2 = RMASS(L) IF(SQSH.GT.(MQ1+MQ2)) THEN PCM = SQRT((SH-(MQ1+MQ2)**2)*(SH-(MQ1-MQ2)**2))/(2*SQSH) WD = (SH-MQ1**2-MQ2**2)*SH*PCM ELSE GOTO 80 ENDIF DO I1=1,3 DO 70 J1=1,3 IF(MOD(GN,2).EQ.1) THEN I=2*I1 J=2*J1+5 ELSE I=2*I1-1 J=2*J1+5 ENDIF DO GR =1,2 MET(GR) = ZERO ENDDO IF(GENEV) GOTO 60 DO 50 GEN=MIG,MXG IF(ABS(LAM(CUP,INT((GEN+1)/2),I1,J1,K1,L1)).LT.EPS. & OR.ABS(MIX(GEN)).LT.EPS) GOTO 50 DO GR=MIG,MXG IF(ABS(LAM(CUP,INT((GR+1)/2),I1,J1,K1,L1)).GT.EPS. & AND.ABS(MIX(GR)).GT.EPS) THEN MET(1) =MET(1)+SCF(GEN)*SCF(GR)*WD* & ((SH-MSL2(GEN))*(SH-MSL2(GR))+MSWD(GEN)*MSWD(GR)) & *LAM(CUP,INT((GEN+1)/2),I1,J1,K1,L1)*MIX(GEN) & *LAM(CUP,INT((GR+1)/2),I1,J1,K1,L1)*MIX(GR) ENDIF ENDDO C--Now the t-channel diagrams if the s-channel particles is a sneutrino IF(GN.EQ.2) THEN ECM=SQRT(PCM**2+MQ1**2) TH=MQ1**2-SQSH*(ECM-PCM*COSTH) DO GR=MIG,MXG MET(2)=MET(2)+(MQ1**2-TH)*(MQ2**2-TH)*PCM* & LAM(2,INT((GEN+1)/2),I1,K1,J1,L1)*MIX(GEN)* & LAM(2,INT((GR+1)/2),I1,K1,J1,L1)*MIX(GR) & /((TH-MSL2(GEN))*(TH-MSL2(GR))) ENDDO ENDIF 50 CONTINUE C--final phase space factors IF(MET(1).LT.EPS.AND.MET(2).LT.EPS) GOTO 70 DO GR = 1,2 ME(GN,I1,J1,K1,L1,GR) = MET(GR)*CFAC ENDDO 60 DO GR = 1,2 CF = GR IF(CUP.EQ.1) CF=0 HCS = HCS+ME(GN,I1,J1,K1,L1,GR)*DISF(I,1)*DISF(J,2) IF(HCS.GT.RCS.AND.GENEV) & CALL HWHRSS(9,I,J,K,L,0,CF,*100) HCS = HCS+ME(GN,I1,J1,K1,L1,GR)*DISF(J,1)*DISF(I,2) IF(HCS.GT.RCS.AND.GENEV) & CALL HWHRSS(10,J,I,K,L,0,CF,*100) HCS = HCS+ME(GN,I1,J1,K1,L1,GR) & *DISF(I+6,1)*DISF(J-6,2) IF(HCS.GT.RCS.AND.GENEV) & CALL HWHRSS(9,I,J,K,L,1,CF,*100) HCS = HCS+ME(GN,I1,J1,K1,L1,GR) & *DISF(J-6,1)*DISF(I+6,2) IF(HCS.GT.RCS.AND.GENEV) & CALL HWHRSS(10,J,I,K,L,1,CF,*100) ENDDO 70 CONTINUE ENDDO 80 CONTINUE ENDDO ENDDO 100 IF(GENEV) THEN CALL HWETWO ELSE EVWGT = HCS ENDIF 999 END CDECK ID>, HWHRLS. *CMZ :- -20/10/99 09:46:43 by Peter Richardson *-- Author : Peter Richardson C----------------------------------------------------------------------- SUBROUTINE HWHRLS C----------------------------------------------------------------------- C Subroutine for 2 parton -> sparticle + X via LQD C----------------------------------------------------------------------- INCLUDE 'HERWIG61.INC' DOUBLE PRECISION HCS,A(6,12),B(6,12),S,RCS,HWR,CW,FAC2,EC,ME2, & MW,G,TAU,TAUA,TAUB,LOWTLM,UPPTLM,HWRUNI,SW,SQSH,LC, & SH,MSL(12),MSU(12),MST(6),C(2,6,12),D(2,6,12),UH, & TH,MEN(4,6,3,3),SCF(12),SLWD(12),MLT(6),MNT(4),PCM, & MXS(12),MER(8),MCR(2),RTAB,H(18),MEH(3,18),MXT(12), & CHAN(12),MXU(12),RAND,FAC,ECM,MC(2),MEC(2,6,3,3), & MZ,CHPROB,EPS,HWUAEM,XMIN,XMAX,XPOW,SIN2B,GUU(4), & ML,MN,MLS,MNS,XUPP,MW2,MZ2,ZSLP(2),ZQRK(2),GDD(4), & MSL2(12),MH(4),MSWD(12) INTEGER I,J,K,L,J1,K1,GN,GR,SP,GU,GT,I2,I1,NEUTMN & ,NEUTMX,CHARMN,CHARMX,P LOGICAL RAD,NEUT,CHAR,HIGGS,FIRST EXTERNAL HWR,HWRUNI,HWUAEM COMMON/HWRPIN/XMIN,XMAX,XPOW,FIRST SAVE HCS,A,B,C,D,FAC,MER,MEC,MEN,MLT,MSL,MSU,MST,SLWD,MNT,MXT,MXU, & SW,CW,MXS,H,MEH,CHAN,NEUTMN,NEUTMX,CHARMN,CHARMX,RAD,NEUT, & CHAR,HIGGS,MW,MZ,MW2,MZ2,MCR,SH,SQSH,EC,G,SCF,ZSLP,ZQRK,GUU, & GDD,MSL2,MH,MSWD PARAMETER(EPS=1D-20) IF(GENEV) THEN RCS = HCS*HWR() ELSE IF(FSTWGT) THEN C--Calculate Electroweak parameters needed SW = SQRT(SWEIN) CW = SQRT(1-SWEIN) MW = RMASS(198) MZ = RMASS(200) MW2 = MW**2 MZ2 = MZ**2 SIN2B = TWO*SINB*COSB C--Masses and widths DO I=1,3 MSL(2*I-1) = RMASS(423+2*I) MSL(2*I) = RMASS(435+2*I) MSL(2*I+5) = RMASS(424+2*I) MSL(2*I+6) = RMASS(436+2*I) SLWD(2*I-1) = HBAR/RLTIM(423+2*I) SLWD(2*I) = HBAR/RLTIM(435+2*I) SLWD(2*I+5) = HBAR/RLTIM(424+2*I) SLWD(2*I+6) = HBAR/RLTIM(436+2*I) MSU(2*I-1) = RMASS(400+2*I)**2 MSU(2*I) = RMASS(412+2*I)**2 MSU(2*I+5) = RMASS(399+2*I)**2 MSU(2*I+6) = RMASS(411+2*I)**2 MST(2*I-1) = RMASS(399+2*I)**2 MST(2*I) = RMASS(411+2*I)**2 MLT(2*I) = ZERO MLT(2*I-1) = RMASS(119+2*I) ENDDO DO I=1,12 MSL2(I) = MSL(I)**2 MSWD(I) = MSL(I)*SLWD(I) ENDDO DO I=1,4 MNT(I) = ABS(RMASS(449+I)) ENDDO MCR(1) = ABS(RMASS(454)) MCR(2) = ABS(RMASS(455)) C--Couplings for the neutralinos DO L=1,4 MC(1) = ZMIXSS(L,3)/(2*MW*COSB*SW) MC(2) = ZMIXSS(L,4)/(2*MW*SINB*SW) DO I=1,3 DO J=1,2 C--resonant charged sleptons A(L,2*I-2+J) = MC(1)*MLT(2*I-1)*LMIXSS(2*I-1,2,J) & +SLFCH(9+2*I,L)*LMIXSS(2*I-1,1,J) B(L,2*I-2+J) = ZSGNSS(L)*(MC(1)*MLT(2*I-1)* & LMIXSS(2*I-1,1,J)+SRFCH(9+2*I,L)*LMIXSS(2*I-1,2,J)) C--resonant sneutrinos A(L,2*I+4+J) = SLFCH(10+2*I,L)*LMIXSS(2*I,1,J) B(L,2*I+4+J) = ZERO C--u channel up type squarks C(1,L,2*I-2+J) = MC(2)*QMIXSS(2*I,2,J)* & RMASS(2*I)+SLFCH(2*I,L)*QMIXSS(2*I,1,J) D(1,L,2*I-2+J) = ZSGNSS(L)*(MC(2)*QMIXSS(2*I,1,J)* & RMASS(2*I)+SRFCH(2*I ,L)*QMIXSS(2*I,2,J)) C--u channel down type squarks C(1,L,2*I+4+J) = MC(1)*QMIXSS(2*I-1,2,J)* & RMASS(2*I-1)+SLFCH(2*I-1,L)*QMIXSS(2*I-1,1,J) D(1,L,2*I+4+J) = ZSGNSS(L)*(MC(1)*QMIXSS(2*I-1,1,J)* & RMASS(2*I-1)+SRFCH(2*I-1,L)*QMIXSS(2*I-1,2,J)) C--t channel down type squarks C(2,L,2*I-2+J) = ZSGNSS(L)*(MC(1)*QMIXSS(2*I-1,1,J)* & RMASS(2*I-1)+SRFCH(2*I-1,L)*QMIXSS(2*I-1,2,J)) D(2,L,2*I-2+J) = MC(1)*QMIXSS(2*I-1,2,J)* & RMASS(2*I-1)+SLFCH(2*I-1,L)*QMIXSS(2*I-1,1,J) ENDDO ENDDO DO I=1,6 C(2,L,6+I) = C(2,L,I) D(2,L,6+I) = D(2,L,I) ENDDO ENDDO C--Couplings for charginos DO L=1,2 MC(1) = 1/(SQRT(2.0D0)*MW*COSB) MC(2) = 1/(SQRT(2.0D0)*MW*SINB) SP=L+4 DO I=1,3 DO J=1,2 C--resonant charged slepton A(SP,2*I-2+J) = WMXUSS(L,1)*LMIXSS(2*I-1,1,J) & -LMIXSS(2*I-1,2,J)*WMXUSS(L,2)* & MLT(2*I-1)*MC(1) B(SP,2*I-2+J) = ZERO C--resonant sneutrinos A(SP,2*I+4+J) = WSGNSS(L)*WMXVSS(L,1)*LMIXSS(2*I,1,J) B(SP,2*I+4+J) = -MLT(2*I-1)*WMXUSS(L,2)*LMIXSS(2*I,1,J) & *MC(1) C--u channel sup C(1,SP,2*I-2+J) = WSGNSS(L)*(WMXVSS(L,1)*QMIXSS(2*I,1,J) & -WMXVSS(L,2)*MC(2)*RMASS(2*I)*QMIXSS(2*I,2,J)) D(1,SP,2*I-2+J) = -WMXUSS(L,2)*MC(1)*RMASS(2*I-1) & *QMIXSS(2*I,1,J) C--u channel sdown C(1,SP,2*I+4+J) = WMXUSS(L,1)*QMIXSS(2*I-1,1,J) & -WMXUSS(L,2)*MC(1)*RMASS(2*I-1)*QMIXSS(2*I-1,2,J) D(1,SP,2*I+4+J) = -WSGNSS(L)*WMXVSS(L,2)*MC(2)* & RMASS(2*I)*QMIXSS(2*I-1,1,J) ENDDO ENDDO ENDDO C--Couplings and massesfor Higgs DO I=1,4 MH(I) = RMASS(202+I) ENDDO C--first the neutral Higgs DO I=1,3 H(I) = -MLT(2*I-1)*HALF/MW/COSB*MUSS*COSA H(I+4) = -MLT(2*I-1)*HALF/MW/COSB*MUSS*SINA H(I+8) = MLT(2*I-1)*HALF/MW*MUSS ENDDO H(3) = (H(3)-MLT(5)*HALF/MW/COSB*ALSS*SINA)*TWO* & LMIXSS(5,2,1)*LMIXSS(5,1,1) & -MZ*SINBPA/CW*(LMIXSS(5,1,1)**2*(HALF-SWEIN) & +SWEIN*LMIXSS(5,2,1)**2)+MLT(5)**2*SINA/MW/COSB H(4) = -MZ*SINBPA/CW*(LMIXSS(5,1,1)*LMIXSS(5,1,2)*(HALF-SWEIN) & +SWEIN*LMIXSS(5,2,1)*LMIXSS(5,2,2)) & -MLT(5)*HALF/COSB/MW*(MUSS*COSA+ALSS*SINA)* & (LMIXSS(5,2,2)*LMIXSS(5,1,1)+LMIXSS(5,1,2)*LMIXSS(5,2,1)) H(7) = (H(7)+MLT(5)*HALF/MW/COSB*ALSS*COSA)*TWO* & LMIXSS(5,2,1)*LMIXSS(5,1,1) & +MZ*COSBPA/CW*(LMIXSS(5,1,1)**2*(HALF-SWEIN) & +LMIXSS(5,2,1)**2*SWEIN)-MLT(5)**2*COSA/MW/COSB H(8) = MZ*COSBPA/CW*(LMIXSS(5,1,2)*LMIXSS(5,1,1)*(HALF-SWEIN) & +LMIXSS(5,2,2)*LMIXSS(5,2,1)*SWEIN) & -MLT(5)*HALF/MW/COSB*(MUSS*SINA-ALSS*COSA)* & (LMIXSS(5,2,2)*LMIXSS(5,1,1)+LMIXSS(5,1,2)*LMIXSS(5,2,1)) H(12) = H(11)+MLT(5)*HALF/MW*ALSS*TANB H(11) = ZERO C--Now the charged Higgs DO J=1,2 DO I=1,3 H(10+2*I+J) = LMIXSS(2*I-1,1,J)* & (MLT(2*I-1)**2*TANB-MW2*SIN2B) & -LMIXSS(2*I-1,2,J)*MLT(2*I-1)*MUSS ENDDO H(16+J) = H(16+J)-LMIXSS(5,2,J)*MLT(5)*ALSS*TANB ENDDO C--couplings of the Higgs to Squarks DO I=1,3 GUU(I) = GHUUSS(I)**2/MW2*HALF**2 GDD(I) = GHDDSS(I)**2/MW2*HALF**2 ENDDO GUU(4) = ONE/TANB**2/MW2/8.0D0 GDD(4) = ONE*TANB**2/MW2/8.0D0 C--Couplings of the Z to quarks, left up right down, and charged sleptons ZQRK(1) = -SW**2/6.0D0/CW ZQRK(2) = (SW**2/3.0D0-HALF**2)/CW ZSLP(1) = HALF*(LMIXSS(5,1,1)**2-2.0D0*SW**2)/CW ZSLP(2) = HALF*LMIXSS(5,1,1)*LMIXSS(5,1,2)/CW C--parameters for multichannel integration RAND = ZERO DO I=1,3 CHPROB = ZERO DO J=1,3 DO K=1,3 CHPROB=CHPROB+LAMDA2(I,J,K)**2 ENDDO ENDDO RAND = RAND+2*CHPROB DO J=1,2 MXS(2*I-2+J) = LMIXSS(2*I-1,1,J) MXS(2*I+4+J) = LMIXSS(2*I,1,J) MXU(2*I-2+J) = QMIXSS(2*I,1,J) MXU(2*I+4+J) = QMIXSS(2*I-1,1,J) MXT(2*I-2+J) = QMIXSS(2*I-1,2,J) MXT(2*I+4+J) = QMIXSS(2*I-1,2,J) CHAN(2*I-2+J) = LMIXSS(2*I-1,1,J)**2*CHPROB CHAN(2*I+4+J) = LMIXSS(2*I,1,J)**2*CHPROB ENDDO ENDDO IF(RAND.GT.ZERO) THEN DO I=1,12 CHAN(I)=CHAN(I)/RAND ENDDO ELSE CALL HWWARN('HWHRLS',500,*999) ENDIF C--decide what processes to generate RAD = .FALSE. NEUT = .FALSE. CHAR = .FALSE. HIGGS = .FALSE. NEUTMN= 1 NEUTMX = 4 CHARMN = 1 CHARMX = 2 C--Decide which process to generate IF(IPROC.EQ.4000) THEN RAD = .TRUE. NEUT = .TRUE. CHAR = .TRUE. HIGGS = .TRUE. ELSEIF(IPROC.LT.4020) THEN IF(IPROC.NE.4010) THEN NEUTMN = MOD(IPROC,10) NEUTMX = NEUTMN ENDIF NEUT=.TRUE. ELSEIF(IPROC.LT.4030) THEN IF(IPROC.NE.4020) THEN CHARMN = MOD(IPROC,10) CHARMX=CHARMN ENDIF CHAR = .TRUE. ELSEIF(IPROC.EQ.4040) THEN RAD = .TRUE. ELSEIF(IPROC.EQ.4050) THEN HIGGS = .TRUE. ENDIF ENDIF C--basic parameters EVWGT = ZERO S = PHEP(5,3)**2 COSTH = HWRUNI(0,-ONE,ONE) RAND = HWRUNI(0,ZERO,ONE) C--zero arrays DO I=1,6 DO J=1,3 DO K=1,3 DO L=1,2 MEN(L,I,J,K) = ZERO MEN(L+2,I,J,K) = ZERO MEC(L,I,J,K) = ZERO ENDDO ENDDO ENDDO ENDDO DO I=1,8 MER(I)=ZERO ENDDO C--Perform multichannel integration DO I=1,12 IF(CHAN(I).GT.RAND) THEN GR=I GOTO 25 ENDIF RAND=RAND-CHAN(I) ENDDO C--Calculate the hard scale and obtain parton distributions 25 TAUA = MSL2(GR)/S TAUB = SLWD(GR)**2/S RTAB = SQRT(TAUA*TAUB) XUPP = XMAX IF(XMAX**2.GT.S) XUPP = SQRT(S) LOWTLM = DATAN((XMIN**2/S-TAUA)/RTAB)/RTAB UPPTLM = DATAN((XUPP**2/S-TAUA)/RTAB)/RTAB TAU = HWRUNI(0,LOWTLM,UPPTLM) TAU = RTAB*TAN(RTAB*TAU)+TAUA SH = S*TAU SQSH = SQRT(SH) EMSCA = SQSH XX(1) = EXP(HWRUNI(0,LOG(TAU),ZERO)) XX(2) = TAU/XX(1) CALL HWSGEN(.FALSE.) C--EM and Weak couplings EC = SQRT(4*PIFAC*HWUAEM(SH)) G = EC/SW C--Calculate the prefactor due multichannel approach FAC = ZERO DO GN=1,12 SCF(GN)=1/((SH-MSL2(GN))**2+MSWD(GN)**2) FAC=FAC+CHAN(GN)*SCF(GN) ENDDO FAC=-(UPPTLM-LOWTLM)*GEV2NB*LOG(TAU)/ & (48*TAU*FAC*PIFAC*S**2*SH*SQSH) ENDIF HCS = ZERO C--First we do the neutralino production IF(.NOT.NEUT) GOTO 200 DO 140 GN=1,6 I=GN GR = 2*GN-1 I1 = 2*GN-1 IF(GN.GT.3) THEN I=I-3 I1=I1-5 ENDIF IF(CHAN(GR).LT.EPS) GOTO 140 DO 130 L=NEUTMN,NEUTMX MN = MNT(L) MNS = MN**2 ML = MLT(I1) MLS = ML**2 IF((ML+MN).GT.SQSH) GOTO 130 C--that and uhat PCM = SQRT((SH-(ML+MN)**2)*(SH-(ML-MN)**2))*HALF/SQSH ECM = SQRT(PCM**2+MLS) TH = MLS-SQSH*(ECM-PCM*COSTH) UH = MLS-SQSH*(ECM+PCM*COSTH) DO J=1,3 DO 120 K=1,3 IF(ABS(LAMDA2(I,J,K)).LT.EPS) GOTO 120 J1 = 2*J K1 = 2*K+5 IF(GN.GT.3) J1=J1-1 IF(GENEV) GOTO 110 C--squarks in u and t channels GU = 6*INT((GN-1)/3)+2*J-1 GT = 2*K C--calulate the matrix element ME2=MXS(GR)**2*SCF(GR)*SH*((SH-MLS-MNS)* & (A(L,GR)**2+B(L,GR)**2)-4*ML*MN*A(L,GR)*B(L,GR)) & +MXU(GU)**2*(MLS-UH)*(MNS-UH)* & (C(1,L,GU)**2+D(1,L,GU)**2)/(UH-MSU(GU))**2 & +MXT(GT)**2*(MLS-TH)*(MNS-TH)* & (C(2,L,GT)**2+D(2,L,GT)**2)/(TH-MST(GT))**2 & -TWO*MXT(GT)*MXU(GU)*C(1,L,GU)*C(2,L,GT)*(MLS*MNS-UH*TH) & /(UH-MSU(GU))/(TH-MST(GT)) & +TWO*MXS(GR)*MXU(GU)*(SH-MSL2(GR))*SCF(GR)*C(1,L,GU)* & SH*(UH*A(L,GR)+ML*MN*B(L,GR))/(UH-MSU(GU)) & +TWO*MXS(GR)*MXT(GT)*(SH-MSL2(GR))*SCF(GR)*C(2,L,GT)* & SH*(TH*A(L,GR)+ML*MN*B(L,GR))/(TH-MST(GT)) C--s channel mixing L/R mixing IF(ABS(MXS(GR+1)).GT.EPS) THEN ME2=ME2+MXS(GR+1)**2*SCF(GR+1)*SH*((SH-MLS-MNS)* & (A(L,GR+1)**2+B(L,GR+1)**2) & -4*ML*MN*A(L,GR+1)*B(L,GR+1)) & +TWO*MXS(GR)*MXS(GR+1)*SCF(GR)*SCF(GR+1)* & ((SH-MSL2(GR))*(SH-MSL2(GR+1))+ & MSWD(GR)*MSWD(GR+1))*SH* & ((SH-MLS-MNS)*(A(L,GR)*A(L,GR+1)+B(L,GR)*B(L,GR+1)) & -2*ML*MN*(A(L,GR)*B(L,GR+1)+A(L,GR+1)*B(L,GR))) & +TWO*MXS(GR+1)*MXU(GU)*(SH-MSL2(GR+1))*SCF(GR+1)* & SH*C(1,L,GU)*(UH*A(L,GR+1)+ML*MN*B(L,GR+1)) & /(UH-MSU(GU)) & +TWO*MXS(GR+1)*MXT(GT)*(SH-MSL2(GR+1))*SCF(GR+1)* & SH*C(2,L,GT)*(TH*A(L,GR+1)+ML*MN*B(L,GR+1)) & /(TH-MST(GT)) IF(ABS(MXU(GU+1)).GT.EPS) ME2=ME2+TWO*MXS(GR+1)*MXU(GU+1)* & (SH-MSL2(GR+1))*SCF(GR+1)*SH*C(1,L,GU+1)* & (UH*A(L,GR+1)+ML*MN*B(L,GR+1))/(UH-MSU(GU+1)) IF(ABS(MXT(GT-1)).GT.EPS) ME2=ME2+TWO*MXS(GR+1)*MXT(GT-1)* & (SH-MSL2(GR+1))*SCF(GR+1)*SH*C(2,L,GT-1)* & (TH*A(L,GR+1)+ML*MN*B(L,GR+1))/(TH-MST(GT-1)) ENDIF C--u channel L/R mixing IF(ABS(MXU(GU+1)).GT.EPS) THEN ME2=ME2+MXU(GU+1)**2*(MLS-UH)*(MNS-UH)*(C(1,L,GU+1)**2+ & D(1,L,GU+1)**2)/(UH-MSU(GU+1))**2 & +TWO*MXU(GU)*MXU(GU+1)*(MLS-UH)*(MNS-UH)* & (C(1,L,GU)*C(1,L,GU+1)+D(1,L,GU)*D(1,L,GU+1)) & /(UH-MSU(GU))/(UH-MSU(GU+1)) & -TWO*MXT(GT)*MXU(GU+1)*C(1,L,GU+1)*C(2,L,GT)* & (MLS*MNS-UH*TH)/(UH-MSU(GU+1))/(TH-MST(GT)) & +TWO*MXS(GR)*MXU(GU+1)*(SH-MSL2(GR))*SCF(GR)* & SH*C(1,L,GU+1)*(UH*A(L,GR)+ML*MN*B(L,GR)) & /(UH-MSU(GU+1)) IF(ABS(MXT(GT-1)).GT.EPS) ME2=ME2-TWO*MXT(GT-1)*MXU(GU+1)* & C(1,L,GU+1)*C(2,L,GT-1)*(MLS*MNS-UH*TH) & /(UH-MSU(GU+1))/(TH-MST(GT-1)) ENDIF C--t channel L/R mixing IF(ABS(MXT(GT-1)).GT.EPS) THEN ME2=ME2+MXT(GT-1)**2*(MLS-TH)*(MNS-TH)*(C(2,L,GT-1)**2 & +D(2,L,GT-1)**2)/(TH-MST(GT-1))**2 & +TWO*MXT(GT)*MXT(GT-1)*(MLS-TH)*(MNS-TH)* & (C(2,L,GT)*C(2,L,GT-1)+D(2,L,GT)*D(2,L,GT-1)) & /(TH-MST(GT))/(TH-MST(GT-1)) & -TWO*MXT(GT-1)*MXU(GU)*C(1,L,GU)*C(2,L,GT-1)* & (MLS*MNS-UH*TH)/(UH-MSU(GU))/(TH-MST(GT-1)) & +TWO*MXS(GR)*MXT(GT-1)*(SH-MSL2(GR))*SCF(GR)* & SH*C(2,L,GT-1)*(TH*A(L,GR)+ML*MN*B(L,GR)) & /(TH-MST(GT-1)) ENDIF C--multiply by lamda and factors MEN(L,GN,J,K) = FAC*ME2*EC**2*LAMDA2(I,J,K)**2*PCM 110 I2=I1+6 HCS = HCS+MEN(L,GN,J,K)*DISF(J1,1)*DISF(K1,2) IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(11,J1,K1,I2,L,0,0,*500) HCS = HCS+MEN(L,GN,J,K)*DISF(K1,1)*DISF(J1,2) IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(12,K1,J1,I2,L,0,0,*500) HCS = HCS+MEN(L,GN,J,K)*DISF(J1+6,1)*DISF(K1-6,2) IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(11,J1,K1,I2,L,1,0,*500) HCS = HCS+MEN(L,GN,J,K)*DISF(K1-6,1)*DISF(J1+6,2) IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(12,K1,J1,I2,L,1,0,*500) 120 CONTINUE ENDDO 130 CONTINUE 140 CONTINUE 200 IF(.NOT.CHAR) GOTO 300 C--Chargino production DO 240 GN=1,6 GR=2*GN-1 I=GN I1 = 2*GN IF(GN.GT.3) THEN I1=I1-7 I=GN-3 ENDIF IF(CHAN(GR).LT.EPS) GOTO 240 DO 230 L=CHARMN,CHARMX MN = MCR(L) MNS = MN**2 ML = MLT(I1) MLS = ML**2 SP = L+4 IF((ML+MN).GT.EMSCA) GOTO 230 PCM = SQRT((SH-(ML+MN)**2)*(SH-(ML-MN)**2))*HALF/SQSH ECM = SQRT(PCM**2+MLS) TH = MLS-SQSH*(ECM-PCM*COSTH) UH = MLS-SQSH*(ECM+PCM*COSTH) DO J=1,3 DO 220 K=1,3 IF(ABS(LAMDA2(I,J,K)).LT.EPS) GOTO 220 J1=2*J K1=2*K+5 IF(GN.GT.3) J1=J1-1 IF(GENEV) GOTO 210 GU = 2*J-1 IF(GN.LE.3) GU=GU+6 C--Calculate the matrix element, s and u terms ME2 =MXS(GR)**2*SCF(GR)*SH*( & (SH-MLS-MNS)*(A(SP,GR)**2+B(SP,GR)**2) & -4*ML*MN*A(SP,GR)*B(SP,GR)) & +MXU(GU)**2*(MLS-UH)*(MNS-UH)* & (C(1,SP,GU)**2+D(1,SP,GU)**2)/(UH-MSU(GU))**2 & -2*MXS(GR)*MXU(GU)*(SH-MSL2(GR))*SCF(GR)*C(1,SP,GU)* & SH*(UH*A(SP,GR)+B(SP,GR)*ML*MN)/(UH-MSU(GU)) C--s channel L/R mixing IF(ABS(MXS(GR+1)).GT.EPS) THEN ME2=ME2+MXS(GR+1)**2*SCF(GR+1)*SH*((SH-MLS-MNS)* & (A(SP,GR+1)**2+B(SP,GR+1)**2) & -4*ML*MN*A(SP,GR+1)*B(SP,GR+1)) & +2*MXS(GR)*MXS(GR+1)*SCF(GR)*SCF(GR+1)* & ((SH-MSL2(GR))*(SH-MSL2(GR+1))+ & MSWD(GR)*MSWD(GR+1))*SH* & ((SH-MLS-MNS)*(A(SP,GR)*A(SP,GR+1) & +B(SP,GR)*B(SP,GR+1))-4*ML*MN* & (A(SP,GR)*B(SP,GR+1)+B(SP,GR)*A(SP,GR+1))) & -2*MXS(GR+1)*MXU(GU)*(SH-MSL2(GR+1))*SCF(GR+1)*SH* & C(1,SP,GU)*(UH*A(SP,GR+1)+B(SP,GR+1)*ML*MN) & /(UH-MSU(GU)) IF(ABS(MXU(GU+1)).GT.EPS) ME2=ME2-2*MXS(GR+1)*MXU(GU+1)* & (SH-MSL2(GR+1))*SCF(GR+1)*C(1,SP,GU+1)*SH* & (UH*A(SP,GR+1)+B(SP,GR+1)*ML*MN)/(UH-MSU(GU+1)) ENDIF C--u channel L/R mixing IF(ABS(MXU(GU+1)).GT.EPS) ME2 = ME2+MXU(GU+1)**2*(MLS-UH)* & (MNS-UH)*(C(1,SP,GU+1)**2+D(1,SP,GU+1)**2) & /(UH-MSU(GU+1))**2 & +2*MXU(GU)*MXU(GU+1)*(MLS-UH)*(MNS-UH)* & (C(1,SP,GU)*C(1,SP,GU+1)+D(1,SP,GU)*D(1,SP,GU+1)) & /(UH-MSU(GU))/(UH-MSU(GU+1)) & -2*MXS(GR)*MXU(GU+1)*(SH-MSL2(GR))*SCF(GR)*SH* & C(1,SP,GU+1)*(UH*A(SP,GR)+B(SP,GR)*ML*MN) & /(UH-MSU(GU+1)) MEC(L,GN,J,K) = FAC*ME2*G**2*LAMDA2(I,J,K)**2*PCM*HALF 210 I2 = I1+6 P = L+4 HCS = HCS+MEC(L,GN,J,K)*DISF(J1,1)*DISF(K1,2) IF(GN.GT.3) P = P+2 IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(11,J1,K1,I2,P,0,0,*500) HCS = HCS+MEC(L,GN,J,K)*DISF(K1,1)*DISF(J1,2) IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(12,K1,J1,I2,P,0,0,*500) HCS = HCS+MEC(L,GN,J,K)*DISF(J1+6,1)*DISF(K1-6,2) IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(11,J1,K1,I2,P,1,0,*500) HCS = HCS+MEC(L,GN,J,K)*DISF(K1-6,1)*DISF(J1+6,2) IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(12,K1,J1,I2,P,1,0,*500) 220 CONTINUE ENDDO 230 CONTINUE 240 CONTINUE 300 IF(.NOT.RAD) GOTO 400 C--Radiative decays IF(GENEV) GOTO 320 DO 310 GN=1,3 I1= 2*GN+5 I = 2*GN-1 C--charged slepton to sneutrino W IF(SQSH.GT.(MW+MSL(I1))) THEN PCM = SQRT((SH-(MW+MSL(I1))**2)*(SH-(MW-MSL(I1))**2))*HALF/SQSH ECM = SQRT(PCM**2+MW2) TH = MW2-SQSH*(ECM-PCM*COSTH) UH = MW2-SQSH*(ECM+PCM*COSTH) ME2 = MXS(I)**4*SCF(I)*SH**2*PCM**2 & +HALF**2/TH**2*(TWO*MW2*(UH*TH-MSL2(I1)*MW2)+TH**2*SH) & +HALF*MXS(I)*SH*(SH-MSL2(I))*SCF(I)/TH* & (MW2*(TWO*MSL2(I1)-TH)+(SH-MSL2(I1))*TH) IF(GN.EQ.3) ME2 = ME2+MXS(I+1)**4*SCF(I+1)*SH**2*PCM**2 & +2*MXS(I)**2*MXS(I+1)**2*SCF(I)*SCF(I+1)*SH**2*PCM**2 & *((SH-MSL2(I))*(SH-MSL2(I+1))+MSWD(I)*MSWD(I+1)) & +HALF*MXS(I+1)*SH*(SH-MSL2(I+1))*SCF(I+1)/TH* & (MW2*(TWO*MSL2(I1)-TH)+(SH-MSL2(I))*TH) MER(GN) = ME2*PCM/MW2 ENDIF C--sneutrino to charged slepton W IF(SQSH.GT.(MW+MSL(I))) THEN PCM = SQRT((SH-(MW+MSL(I))**2)*(SH-(MW-MSL(I))**2))*HALF/SQSH ECM = SQRT(PCM**2+MW2) TH = MW2-SQSH*(ECM-PCM*COSTH) UH = MW2-SQSH*(ECM+PCM*COSTH) ME2 = MXS(I)**2*SCF(I1)*SH**2*PCM**2 & +HALF**2*MXS(I)**2/TH**2* & (TWO*MW2*(UH*TH-MW2*MSL2(I))+TH**2*SH) & +HALF*MXS(I)**2*SH*(SH-MSL2(I1))*SCF(I1)/TH* & (MW2*(TWO*MSL2(I)-TH)+(SH-MSL2(I))*TH) MER(GN+4) = ME2*PCM/MW2 ENDIF 310 CONTINUE C--now the decay stau_2 to stau_1 Z IF(SQSH.GT.(MZ+MSL(5))) THEN PCM = SQRT((SH-(MZ+MSL(5))**2)*(SH-(MZ-MSL(5))**2))*HALF/SQSH ECM = SQRT(PCM**2+MZ2) TH = MZ2-SQSH*(ECM-PCM*COSTH) UH = MZ2-SQSH*(ECM+PCM*COSTH) ME2 = SH**2*PCM**2*(SCF(5)*MXS(5)**2*ZSLP(1)**2 & +SCF(6)*MXS(6)**2*ZSLP(2)**2+TWO*SCF(5)*SCF(6)* & MXS(5)*MXS(6)*ZSLP(1)*ZSLP(2)*((SH-MSL2(5))* & (SH-MSL2(6))+MSWD(5)*MSWD(6))) & +MXS(5)**2*ZQRK(2)**2/TH**2* & (TWO*MZ2*(UH*TH-MZ2*MSL2(5))+TH**2*SH) & +MXS(5)**2*ZQRK(1)**2/UH**2* & (TWO*MZ2*(UH*TH-MZ2*MSL2(5))+UH**2*SH) & +MXS(5)*SH*(MXS(5)*SCF(5)*ZSLP(1)*(SH-MSL2(5)) & +MXS(6)*SCF(6)*ZSLP(2)*(SH-MSL2(6)))* & ( ZQRK(2)/TH*(MZ2*(TWO*MSL2(5)-TH)+TH*(SH-MSL2(5))) & +ZQRK(1)/UH*(MZ2*(TWO*MSL2(5)-UH)+UH*(SH-MSL2(5)))) & -TWO*MXS(5)**2*ZQRK(1)*ZQRK(2)/UH/TH* & (TWO*MZ2*(MSL2(5)-UH)*(MSL2(5)-TH)-SH*UH*TH) MER(4) = TWO*ME2*PCM/MZ2 ENDIF C--now the decay tau sneutrino to tau_2 W IF(SQSH.GT.(MW+MSL(6))) THEN PCM = SQRT((SH-(MW+MSL(6))**2)*(SH-(MW-MSL(6))**2))*HALF/SQSH ECM = SQRT(PCM**2+MW2) TH = MW2-SQSH*(ECM-PCM*COSTH) UH = MW2-SQSH*(ECM+PCM*COSTH) ME2 = MXS(6)**2*SCF(11)*SH**2*PCM**2 & +HALF**2*MXS(6)**2/TH**2* & (TWO*MW2*(UH*TH-MW2*MSL2(6))+TH**2*SH) & +HALF*MXS(6)**2*SH*(SH-MSL2(11))*SCF(11)/TH* & (MW2*(2*MSL2(6)-TH)+(SH-MSL2(6))*TH) MER(8) = ME2*PCM/MW2 ENDIF C--Multiply by the parton distributions 320 DO I=1,4 DO J=1,3 DO 330 K=1,3 IF(I.LE.3) THEN LC = LAMDA2(I,J,K)**2 ELSE LC = LAMDA2(3,J,K)**2 ENDIF IF(LC.LT.EPS) GOTO 330 FAC2 = G**2*LC*FAC C--radiative cross-sections J1=2*J K1=2*K+5 ME2 = FAC2*MER(I) HCS = HCS+ME2*DISF(J1,1)*DISF(K1,2) IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(13,J1,K1,I,I,0,0,*500) HCS = HCS+ME2*DISF(K1,1)*DISF(J1,2) IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(14,K1,J1,I,I,0,0,*500) HCS = HCS+ME2*DISF(J1+6,1)*DISF(K1-6,2) IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(13,J1,K1,I,I,1,0,*500) HCS = HCS+ME2*DISF(K1-6,1)*DISF(J1+6,2) IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(14,K1,J1,I,I,1,0,*500) J1=2*J-1 K1=2*K+5 ME2 = FAC2*MER(I+4) HCS = HCS+ME2*DISF(J1,1)*DISF(K1,2) IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(13,J1,K1,I+4,I+4,0,0,*500) HCS = HCS+ME2*DISF(K1,1)*DISF(J1,2) IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(14,K1,J1,I+4,I+4,0,0,*500) HCS = HCS+ME2*DISF(J1+6,1)*DISF(K1-6,2) IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(13,J1,K1,I+4,I+4,1,0,*500) HCS = HCS+ME2*DISF(K1-6,1)*DISF(J1+6,2) IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(14,K1,J1,I+4,I+4,1,0,*500) 330 CONTINUE ENDDO ENDDO 400 IF(.NOT.HIGGS) GOTO 500 IF(GENEV) GOTO 480 DO I=1,3 DO 405 J=1,18 405 MEH(I,J) = ZERO ENDDO C--Neutral higgs charged slepton DO 420 L=1,3 DO 410 I=1,2 C--first two generations IF(SQSH.LT.MH(L)+MSL(2*I)) GOTO 410 PCM = SQRT((SH-(MSL(2*I)+MH(L))**2)* & (SH-(MSL(2*I)-MH(L))**2))*HALF/SQSH MEH(1,3*L-3+I) = PCM*SH*SCF(2*I-1)*H(4*L+I-4)**2 410 CONTINUE C--third generation IF(SQSH.LT.MH(L)+MSL(5)) GOTO 420 PCM = SQRT((SH-(MSL(5)+MH(L))**2)* & (SH-(MSL(5)-MH(L))**2))*HALF/SQSH ECM = SQRT(PCM**2+MH(L)**2) TH = MH(L)**2-SQSH*(ECM-PCM*COSTH) UH = MH(L)**2-SQSH*(ECM+PCM*COSTH) MEH(1,3*L) = PCM*SH*(MXS(5)**2*SCF(5)*H(4*L-1)**2 & +MXS(6)**2*SCF(6)*H(4*L)**2 & +TWO*MXS(5)*MXS(6)*SCF(5)*SCF(6)*H(4*L-1)* & H(4*L)*((SH-MSL2(5))*(SH-MSL2(6))+ & MSWD(5)*MSWD(6)) ) ME2 = MXS(5)**2*PCM*(UH*TH-MSL2(5)*MH(L)**2) MEH(2,3*L) =ME2*GUU(L)/TH**2 MEH(3,3*L) =ME2*GDD(L)/UH**2 420 CONTINUE C--Charged higgs DO 440 I=1,3 C--charged slepton charged Higgs DO 430 J=1,2 IF(SQSH.LT.(MH(4)+MSL(2*I-2+J))) GOTO 430 PCM = SQRT((SH-(MH(4)+MSL(2*I-2+J))**2)* & (SH-(MH(4)-MSL(2*I-2+J))**2))*HALF/SQSH ECM = SQRT(PCM**2+MH(4)**2) TH = MH(4)**2-SQSH*(ECM-PCM*COSTH) UH = MH(4)**2-SQSH*(ECM+PCM*COSTH) MEH(1,2*I+J+7) = PCM*SH*HALF/MW2*H(2*I+J+10)**2*SCF(5+2*I) MEH(2,2*I+J+7) = PCM*GDD(4)*MXS(2*I-2+J)**2* & (UH*TH-MH(4)**2*MSL2(2*I-2+J))/TH**2 430 CONTINUE C--Sneutrino Charged Higgs IF(SQSH.LT.(MH(4)+MSL(2*I+5))) GOTO 440 PCM = SQRT((SH-(MH(4)+MSL(2*I+5))**2)* & (SH-(MH(4)-MSL(2*I+5))**2))*HALF/SQSH ECM = SQRT(PCM**2+MH(4)**2) TH = MH(4)**2-SQSH*(ECM-PCM*COSTH) UH = MH(4)**2-SQSH*(ECM+PCM*COSTH) MEH(1,15+I) = PCM*SH*HALF/MW2*( & MXS(2*I-1)**2*SCF(2*I-1)*H(11+2*I)**2 & +MXS(2*I)**2*SCF(2*I)*H(12+2*I)**2 & +TWO*MXS(2*I-1)*MXS(2*I)*SCF(2*I-1)* & SCF(2*I)*H(11+2*I)*H(12+2*I)* & ((SH-MSL2(2*I-1))*(SH-MSL2(2*I))+ & MSWD(2*I-1)*MSWD(2*I))) MEH(2,15+I) = PCM*GUU(4)* & (UH*TH-MH(4)**2*MSL2(2*I+5))/TH**2 440 CONTINUE C--Multiply by the parton distributions 480 DO I=1,3 DO J=1,3 DO 490 K=1,3 IF(LAMDA2(I,J,K).LT.EPS) GOTO 490 C--Higgs cross-sections J1=2*J K1=2*K+5 FAC2 = G**2*LAMDA2(I,J,K)**2*FAC*HALF DO L=1,3 ME2 = FAC2*(MEH(1,3*L-3+I)+RMASS(J1)**2*MEH(2,3*L-3+I) & +RMASS(K1)**2*MEH(3,3*L-3+I)) HCS = HCS+ME2*DISF(J1,1)*DISF(K1,2) IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(15,J1,K1,I,L,0,0,*500) HCS = HCS+ME2*DISF(K1,1)*DISF(J1,2) IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(16,K1,J1,I,L,0,0,*500) HCS = HCS+ME2*DISF(J1+6,1)*DISF(K1-6,2) IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(15,J1,K1,I,L,1,0,*500) HCS = HCS+ME2*DISF(K1-6,1)*DISF(J1+6,2) IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(16,K1,J1,I,L,1,0,*500) ENDDO ME2 = FAC2*(MEH(1,15+I)+RMASS(J1)**2*MEH(2,15+I)) HCS = HCS+ME2*DISF(J1,1)*DISF(K1,2) IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(15,J1,K1,9+I,4,0,0,*500) HCS = HCS+ME2*DISF(K1,1)*DISF(J1,2) IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(16,K1,J1,9+I,4,0,0,*500) HCS = HCS+ME2*DISF(J1+6,1)*DISF(K1-6,2) IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(15,J1,K1,9+I,5,1,0,*500) HCS = HCS+ME2*DISF(K1-6,1)*DISF(J1+6,2) IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(16,K1,J1,9+I,5,1,0,*500) J1=2*J-1 K1=2*K+5 DO L=2,3 ME2 = FAC2*(MEH(1,2*I+L+6)+RMASS(J1)**2*MEH(2,2*I+L+6)) HCS = HCS+ME2*DISF(J1,1)*DISF(K1,2) IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(15,J1,K1,2*I+L,5,0,0,*500) HCS = HCS+ME2*DISF(K1,1)*DISF(J1,2) IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(16,K1,J1,2*I+L,5,0,0,*500) HCS = HCS+ME2*DISF(J1+6,1)*DISF(K1-6,2) IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(15,J1,K1,2*I+L,4,1,0,*500) HCS = HCS+ME2*DISF(K1-6,1)*DISF(J1+6,2) IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(16,K1,J1,2*I+L,4,1,0,*500) ENDDO 490 CONTINUE ENDDO ENDDO C--Setup to generate the event 500 IF(GENEV) THEN CALL HWETWO ELSE EVWGT = HCS ENDIF 999 END CDECK ID>, HWHRSP. *CMZ :- -20/07/99 10:56:12 by Peter Richardson *-- Author : Peter Richardson C----------------------------------------------------------------------- SUBROUTINE HWHRSP C----------------------------------------------------------------------- C Subroutine for all hadron-hadron Rparity violating processes C----------------------------------------------------------------------- INCLUDE 'HERWIG61.INC' IF(IPROC.GE.4000.AND.IPROC.LT.4060) THEN C--SINGLE SPARTICLE VIA LQD CALL HWHRLS ELSEIF(IPROC.GE.4060.AND.IPROC.LT.4100) THEN C--RESONANT SLEPTONS TO STANDARD MODEL VIA LQD CALL HWHRLL ELSEIF(IPROC.GE.4100.AND.IPROC.LT.4160) THEN C--SINGLE SPARTICLE VIA UDD CALL HWHRBS C--RESONANT SQUARKS TO STANDARD MODEL VIA UDD ELSEIF(IPROC.EQ.4160) THEN CALL HWHRBB ELSE C--UNKNOWN PROCESS CALL HWWARN('HWHRSP',500,*999) ENDIF 999 END CDECK ID>, HWHRSS. *CMZ :- -20/07/99 10:56:12 by Peter Richardson *-- Author : Peter Richardson C----------------------------------------------------------------------- SUBROUTINE HWHRSS(TYPE,ID1,ID2,ID3,ID4,R4,IPERM,*) C----------------------------------------------------------------------- C IDENTIDY HARD R-PARITY VIOLATING PROCESS C----------------------------------------------------------------------- INCLUDE 'HERWIG61.INC' INTEGER ID3, ID4, R4, IPERM,TYPE,ID1,ID2,NEUTD1(8),SLEPID(8), & NEUTD2(13),SQUID(6),SGN,HWUANT,SQUID2(12),SLPID2(12), & GAGID1(6),GAGID2(8) EXTERNAL HWUANT DATA NEUTD1 /450,451,452,453,454,455,456,457/ DATA NEUTD2 /449,449,449,450,451,452,453,454,455,456,457,454,455/ DATA SLEPID /432,434,436,435,431,433,435,447/ DATA SQUID /411,423,412,412,424,411/ DATA SQUID2 /407,419,409,421,411,423,408,420,410,422,412,424/ DATA SLPID2 /443,445,435,431,443,433,445,435,447,432,434,436/ DATA GAGID1 /199,199,200,198,198,200/ DATA GAGID2 /198,198,198,200,199,199,199,199/ IDCMF = 15 IF(IPERM.EQ.0) THEN ICO(1) = 2 ICO(2) = 1 ICO(3) = 3 ICO(4) = 4 ELSEIF(IPERM.EQ.1) THEN ICO(1) = 2 ICO(2) = 1 ICO(3) = 4 ICO(4) = 3 ELSEIF(IPERM.EQ.2) THEN ICO(1) = 3 ICO(2) = 4 ICO(3) = 1 ICO(4) = 2 ELSE CALL HWWARN('HWHRSS',100,*999) ENDIF IF(TYPE.LE.8) THEN IDN(1) = ID1+R4*6 IDN(2) = ID2+R4*6 ELSE SGN = 1 IF(MOD(TYPE,2).EQ.0) SGN = -1 IDN(1) = ID1+R4*6*SGN IDN(2) = ID2-R4*6*SGN ENDIF IF(TYPE.LE.2) THEN IDN(3) = ID3+6*R4 IDN(4) = ID4+6*R4 ELSEIF(TYPE.GE.3.AND.TYPE.LE.4) THEN IDN(3) = ID3-R4*6 IDN(4) = NEUTD2(ID4) ELSEIF(TYPE.GE.5.AND.TYPE.LE.6) THEN IDN(3) = GAGID1(ID3) IDN(4) = SQUID(ID4)-R4*6 IF(R4.EQ.1) IDN(3) = HWUANT(IDN(3)) ELSEIF(TYPE.GE.7.AND.TYPE.LE.8) THEN IDN(3) =202+ID3 IDN(4) = SQUID2(ID4)-R4*6 ELSEIF(TYPE.GE.9.AND.TYPE.LE.10) THEN IDN(3) = ID3+6*R4 IDN(4) = ID4-6*R4 IF(IPERM.EQ.2.AND.TYPE.EQ.10) THEN SGN=IDN(3) IDN(3) = IDN(4) IDN(4) = SGN ENDIF ELSEIF(TYPE.GE.11.AND.TYPE.LE.12) THEN IDN(3) = 120+ID3-R4*6 IDN(4) = NEUTD1(ID4) IF(R4.EQ.1) IDN(4) = HWUANT(IDN(4)) ELSEIF(TYPE.GE.13.AND.TYPE.LE.14) THEN IDN(3) = SLEPID(ID3)-R4*6 IDN(4) = GAGID2(ID4) IF(R4.NE.0) IDN(4) = HWUANT(IDN(4)) ELSEIF(TYPE.GE.15.AND.TYPE.LE.16) THEN IDN(3) = SLPID2(ID3)-R4*6 IDN(4) = 202+ID4 ENDIF IF(MOD(TYPE,2).EQ.0.AND.TYPE.NE.8) COSTH=-COSTH RETURN 1 999 END CDECK ID>, HWHSCT. *CMZ :- -30/05/94 18.42.43 by Mike Seymour *-- Author : Mike Seymour C----------------------------------------------------------------------- SUBROUTINE HWHSCT(REPORT) C----------------------------------------------------------------------- C RELABEL THE EVENT RECORD FOR EXTRA HARD SCATTERING, C DO THE SCATTERING, PARTON SHOWER IT, AND CLEAN UP THE EVENT RECORD C REPORT RETURNS THE OUTCOME: C 0 = SUCCESSFUL C 1 = FAILED DUE TO ERROR IN HARD SCATTERING GENERATION C 2 = FAILED DUE TO ENERGY CONSERVATION IN HARD SCATTERING C 3 = FAILED DUE TO ERROR IN PARTON EVOLUTION C 4 = FAILED DUE TO ENERGY CONSERVATION IN PARTON EVOLUTION C 5 = COMPLETELY FAILED (IERROR IS ALSO NON-ZERO TO CANCEL EVENT) C----------------------------------------------------------------------- INCLUDE 'HERWIG61.INC' DOUBLE PRECISION HWR,TMPWGT,PBOOST(5),RBOOST(3,3) INTEGER IHEP,IBM,ITG,IBMN,ITGN,IBMT,ITGT,I,REPORT LOGICAL COL EXTERNAL HWR COL(I)=I.EQ.13 .OR. I.GE.1.AND.I.LE.6 .OR. I.GE.115.AND.I.LE.120 REPORT=5 IF (IERROR.NE.0) RETURN C---FIND BEAM AND TARGET REMNANTS CALL HWHREM(IBM,ITG) IF (IERROR.NE.0) RETURN C---RECALCULATE THEIR MASS CORRECTLY CALL HWUMAS(PHEP(1,IBM)) CALL HWUMAS(PHEP(1,ITG)) C---SET UP NEW ENTRIES IN THE EVENT RECORD NHEP=NHEP+1 CALL HWVEQU(5,PHEP(1,IBM),PHEP(1,NHEP)) ISTHEP(NHEP)=3 IBMN=NHEP IBMT=JDAHEP(1,1) IF (IBMT.EQ.0) THEN JMOHEP(1,NHEP)=1 IDHW(NHEP)=72 ELSE JMOHEP(1,NHEP)=IBMT IDHW(NHEP)=71 ENDIF JMOHEP(2,NHEP)=0 JDAHEP(1,NHEP)=0 JDAHEP(2,NHEP)=0 IDHEP(NHEP)=IDPDG(IDHW(NHEP)) NHEP=NHEP+1 CALL HWVEQU(5,PHEP(1,ITG),PHEP(1,NHEP)) ISTHEP(NHEP)=3 ITGN=NHEP ITGT=JDAHEP(1,2) IF (ITGT.EQ.0) THEN JMOHEP(1,NHEP)=2 IDHW(NHEP)=72 ELSE JMOHEP(1,NHEP)=ITGT IDHW(NHEP)=71 ENDIF JMOHEP(2,NHEP)=0 JDAHEP(1,NHEP)=0 JDAHEP(2,NHEP)=0 IDHEP(NHEP)=IDPDG(IDHW(NHEP)) C---BOOST TO THEIR CENTRE-OF-MASS FRAME CALL HWVSUM(4,PHEP(1,IBMN),PHEP(1,ITGN),PBOOST) CALL HWUMAS(PBOOST) DO 100 IHEP=IBMN,NHEP CALL HWULOF(PBOOST,PHEP(1,IHEP),PHEP(1,IHEP)) 100 CONTINUE CALL HWUROT(PHEP(1,IBMN),ONE,ZERO,RBOOST) DO 110 IHEP=IBMN,NHEP CALL HWUROF(RBOOST,PHEP(1,IHEP),PHEP(1,IHEP)) 110 CONTINUE C---GENERATE A NEW HARD SCATTERING TMPWGT=EVWGT GENEV=.FALSE. 10 CALL HWHQCD IF (IERROR.NE.0.OR.GAMWT*EVWGT.LE.WGTMAX*HWR()) THEN IERROR=0 GOTO 10 ENDIF GENEV=.TRUE. CALL HWHQCD EVWGT=TMPWGT C---IF MOMENTUM CANNOT BE CONSERVED, STOP GENERATING HARD SCATTERS IF ( PHEP(4,IBMN+2) .GT. PHEP(4,IBMN).OR. $ PHEP(4,ITGN+2) .GT. PHEP(4,ITGN).OR. $ PHEP(3,IBMN+2) .GT. PHEP(3,IBMN).OR. $ -PHEP(3,ITGN+2) .GT.-PHEP(3,ITGN).OR.IERROR.NE.0) THEN IF (IERROR.GT.0) THEN WRITE (6,'(A/A)') $ ' THIS ERROR OCCURED DURING A SECONDARY SCATTER AND WAS', $ ' CAUGHT BY HWHSCT, SO EVENT IS NOT KILLED AFTER ALL' REPORT=1 ELSE REPORT=2 ENDIF NHEP=IBMN-1 IERROR=0 RETURN ENDIF C---RELABEL OUTGOING REMNANTS AS INCOMING HADRONS JDAHEP(1,1)=IBMN JDAHEP(1,2)=ITGN C---EVOLVE THEM ISLENT=-1 CALL HWBGEN ISLENT=1 C---PUT THE LABELS BACK JDAHEP(1,1)=IBMT JDAHEP(1,2)=ITGT C---IF THERE WERE ANY PROBLEMS, STOP GENERATING HARD SCATTERS IF (IERROR.NE.0) THEN IF (IERROR.GT.0) THEN WRITE (6,'(A/A)') $ ' THIS ERROR OCCURED DURING A SECONDARY SCATTER AND WAS', $ ' CAUGHT BY HWHSCT, SO EVENT IS NOT KILLED AFTER ALL' REPORT=3 ELSE REPORT=4 ENDIF NHEP=IBMN-1 IERROR=0 RETURN ENDIF C---UNDO THE LORENTZ BOOST DO 200 IHEP=IBMN,NHEP CALL HWUROB(RBOOST,PHEP(1,IHEP),PHEP(1,IHEP)) CALL HWULOB(PBOOST,PHEP(1,IHEP),PHEP(1,IHEP)) 200 CONTINUE C---FIND THE NEW BEAM AND TARGET REMNANTS ISTHEP(IBM)=3 ISTHEP(ITG)=3 CALL HWHREM(IBMN,ITGN) IF (IERROR.NE.0) RETURN C---CONNECT UP THE COLOUR/FLAVOUR LINES OF THE TWO SCATTERS IDHW(IBMN)=IDHW(IBM) IDHEP(IBMN)=IDHEP(IBM) IF (COL(IDHW(IBM))) THEN JMOHEP(2,JDAHEP(2,IBMN))=JMOHEP(2,IBM) JDAHEP(2,JMOHEP(2,IBM))=JDAHEP(2,IBMN) JDAHEP(2,IBMN)=JDAHEP(2,IBM) JMOHEP(2,JDAHEP(2,IBM))=IBMN ELSE JDAHEP(2,JMOHEP(2,IBMN))=JDAHEP(2,IBM) JMOHEP(2,JDAHEP(2,IBM))=JMOHEP(2,IBMN) JMOHEP(2,IBMN)=JMOHEP(2,IBM) JDAHEP(2,JMOHEP(2,IBM))=IBMN ENDIF JMOHEP(2,IBM)=0 JDAHEP(1,IBM)=IBMN JDAHEP(2,IBM)=0 IDHW(ITGN)=IDHW(ITG) IDHEP(ITGN)=IDHEP(ITG) IF (COL(IDHW(ITG))) THEN JMOHEP(2,JDAHEP(2,ITGN))=JMOHEP(2,ITG) JDAHEP(2,JMOHEP(2,ITG))=JDAHEP(2,ITGN) JDAHEP(2,ITGN)=JDAHEP(2,ITG) JMOHEP(2,JDAHEP(2,ITG))=ITGN ELSE JDAHEP(2,JMOHEP(2,ITGN))=JDAHEP(2,ITG) JMOHEP(2,JDAHEP(2,ITG))=JMOHEP(2,ITGN) JMOHEP(2,ITGN)=JMOHEP(2,ITG) JDAHEP(2,JMOHEP(2,ITG))=ITGN ENDIF JMOHEP(2,ITG)=0 JDAHEP(1,ITG)=ITGN JDAHEP(2,ITG)=0 C---LOOK FOR COLOUR SINGLET GLUONS (A RARE BUT ANNOYING SPECIAL CASE) DO 20 IHEP=1,NHEP IF (IDHW(IHEP).EQ.13.AND.JMOHEP(2,IHEP).EQ.IHEP) $ CALL HWWARN('HWHSCT',120,*999) 20 CONTINUE REPORT=0 999 END CDECK ID>, HWHSNG. *CMZ :- -20/09/95 14.59.15 by Mike Seymour *-- Author : Mike Seymour C----------------------------------------------------------------------- SUBROUTINE HWHSNG C PARTON-PARTON SCATTERING VIA COLOUR SINGLET C MEAN EVWGT = SIGMA IN NB C TREATS ALL PARTONS ON EQUAL FOOTING WITH HWHSNM(ID1,ID2,S,T) C PROVIDING THE MATRIX ELEMENT SQUARED FOR PARTON TYPES ID1 AND ID2 C----------------------------------------------------------------------- INCLUDE 'HERWIG61.INC' INTEGER ID1,ID2 DOUBLE PRECISION HWR,HWRUNI,HWHSNM,EPS,RCS,ET,EJ,KK,KK2, & YJ1INF,YJ1SUP,Z1,YJ2INF,YJ2SUP,Z2,FACT,S,T,U,HCS SAVE HCS,FACT,S,T PARAMETER (EPS=1.D-9) IF (GENEV) THEN RCS=HCS*HWR() ELSE EVWGT=0. CALL HWRPOW(ET,EJ) KK=ET/PHEP(5,3) KK2=KK**2 IF (KK.GE.ONE) RETURN YJ1INF=MAX( YJMIN , LOG((1.-SQRT(1.-KK2))/KK) ) YJ1SUP=MIN( YJMAX , LOG((1.+SQRT(1.-KK2))/KK) ) IF (YJ1INF.GE.YJ1SUP) RETURN Z1=EXP(HWRUNI(1,YJ1INF,YJ1SUP)) YJ2INF=MAX( YJMIN , -LOG(2./KK-1./Z1) ) YJ2SUP=MIN( YJMAX , LOG(2./KK-Z1) ) IF (YJ2INF.GE.YJ2SUP) RETURN Z2=EXP(HWRUNI(2,YJ2INF,YJ2SUP)) XX(1)=0.5*(Z1+Z2)*KK IF (XX(1).GE.ONE) RETURN XX(2)=XX(1)/(Z1*Z2) IF (XX(2).GE.ONE) RETURN COSTH=(Z1-Z2)/(Z1+Z2) S=XX(1)*XX(2)*PHEP(5,3)**2 T=-0.5*S*(1.-COSTH) U=-S-T C---SET EMSCA TO HARD PROCESS SCALE (APPROX ET-JET) EMSCA=SQRT(2.*S*T*U/(S*S+T*T+U*U)) FACT=GEV2NB*0.5*ET*EJ*(YJ1SUP-YJ1INF)*(YJ2SUP-YJ2INF) $ /(16*PIFAC*S**2) CALL HWSGEN(.FALSE.) ENDIF C HCS=0. DO 20 ID1=1,13 IF (DISF(ID1,1).LT.EPS) GOTO 20 DO 10 ID2=1,13 IF (DISF(ID2,1).LT.EPS) GOTO 10 HCS=HCS+FACT*DISF(ID1,1)*DISF(ID2,2)*HWHSNM(ID1,ID2,S,T) IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,ID2,3412,90,*30) 10 CONTINUE 20 CONTINUE EVWGT=HCS RETURN C---GENERATE EVENT 30 IDN(1)=ID1 IDN(2)=ID2 IDCMF=15 CALL HWETWO 999 END CDECK ID>, HWHSNM. *CMZ :- -20/09/95 15.28.53 by Mike Seymour *-- Author : Mike Seymour C----------------------------------------------------------------------- FUNCTION HWHSNM(ID1,ID2,S,T) C MATRIX ELEMENT SQUARED FOR COLOUR-SINGLET PARTON-PARTON SCATTERING C INCLUDES SPIN AND COLOUR AVERAGES AND SUMS. C FOR PHOTON EXCHANGE, INTERFERENCE WITH U-CHANNEL CONTRIBUTION IS C INCLUDED FOR IDENTICAL QUARKS AND LIKEWISE S-CHANNEL CONTRIBUTION C FOR IDENTICAL QUARK-ANTIQUARK PAIRS. C----------------------------------------------------------------------- INCLUDE 'HERWIG61.INC' DOUBLE PRECISION HWHSNM,HWUAEM,HWUALF,S,T,ASQ,AINU,AINS,Y,SOLD, $ TOLD,QQ(13,13),ZETA3 INTEGER ID1,ID2 LOGICAL PHOTON C---ZETA3=RIEMANN ZETA FUNCTION(3) PARAMETER (ZETA3=1.202056903159594D0) C---PHOTON=.TRUE. FOR PHOTON EXCHANGE, .FALSE. FOR MUELLER-TANG PHOTON=MOD(IPROC,100).GE.50 DATA ASQ,AINU,AINS,SOLD,TOLD,QQ/5*0,169*-1/ C---QQ CACHES THE KINEMATIC-INDEPENDENT FACTORS, TO MAKE IT RUN FASTER C (BEARING IN MIND THAT THIS ROUTINE IS CALLED 169 TIMES PER EVENT) IF (QQ(ID1,ID2).LT.ZERO) THEN IF (PHOTON) THEN IF (ID1.EQ.13.OR.ID2.EQ.13) THEN QQ(ID1,ID2)=0 ELSE QQ(ID1,ID2)=(QFCH(MOD(ID1-1,6)+1)*QFCH(MOD(ID2-1,6)+1))**2 $ *(4*PIFAC)**2 ENDIF ELSE IF (ID1.EQ.13.AND.ID2.EQ.13) THEN QQ(ID1,ID2)=CAFAC**4 ELSEIF (ID1.EQ.13.OR.ID2.EQ.13) THEN QQ(ID1,ID2)=(CAFAC*CFFAC)**2 ELSE QQ(ID1,ID2)=CFFAC**4 ENDIF QQ(ID1,ID2)=QQ(ID1,ID2)* $ PIFAC**3/(4*(3.5*ASFIXD*CAFAC*ZETA3)**3) $ *(16*PIFAC) ENDIF ENDIF C---THE KINEMATIC-DEPENDENT PART IS ALSO CACHED IF (S.NE.SOLD.OR.T.NE.TOLD) THEN IF (PHOTON) THEN AINS=HWUAEM(T)**2 ASQ=2*(S**2+(S+T)**2)/T**2*AINS AINU=-4*S/T*AINS/NCOLO AINS=4*AINS/NCOLO-AINU ELSE Y=LOG(S/(-T))+ONE ASQ=HWUALF(1,EMSCA)**4*(S/T)**2*EXP(2*OMEGA0*Y)/Y**3 AINU=0 AINS=0 ENDIF ENDIF C---THE FINAL ANSWER IS JUST THEIR PRODUCT IF (ID1.EQ.ID2) THEN HWHSNM=QQ(ID1,ID2)*(ASQ+AINU) ELSEIF (ABS(ID1-ID2).EQ.6) THEN HWHSNM=QQ(ID1,ID2)*(ASQ+AINS) ELSE HWHSNM=QQ(ID1,ID2)*ASQ ENDIF END