CDECK ID>, HWBRAN. *CMZ :- -14/10/99 18.04.56 by Mike Seymour *-- Author : Bryan Webber & Mike Seymour C----------------------------------------------------------------------- SUBROUTINE HWBRAN(KPAR) C----------------------------------------------------------------------- C BRANCHES TIMELIKE PARTON KPAR INTO TWO, PUTS PRODUCTS C INTO NPAR+1 AND NPAR+2, AND INCREASES NPAR BY TWO C----------------------------------------------------------------------- INCLUDE 'HERWIG61.INC' DOUBLE PRECISION HWBVMC,HWR,HWUALF,HWUTAB,HWRUNI,HWULDO,PMOM, & QNOW,QLST,QKTHR,RN,QQBAR,DQQ,QGTHR,SNOW,QSUD,ZMIN,ZMAX,ZRAT,WMIN, & QLAM,Z1,Z2,ETEST,ZTEST,ENOW,XI,XIPREV,EPREV,QMAX,QGAM,SLST,SFNL, & TARG,ALF,BETA0(3:6),BETAP(3:6),SQRK(4:6,5),REJFAC,Z,X1,X2,OTHXI, & OTHZ,X3,FF,AW,XCUT,CC,JJ,HWUSQR INTEGER HWRINT,KPAR,ID,JD,IS,NTRY,N,ID1,ID2,MPAR,ISUD(13),IHEP, & JHEP,M,NF,NN,IREJ,NREJ,ITOP EXTERNAL HWBVMC,HWR,HWUALF,HWUTAB,HWRUNI,HWULDO,HWRINT,HWUSQR SAVE BETA0,BETAP,SQRK DATA ISUD,BETA0/2,2,3,4,5,6,2,2,3,4,5,6,1,4*ZERO/ IF (IERROR.NE.0) RETURN C---SET SQRK(M,N) TO THE PROBABILITY THAT A GLUON WILL NOT PRODUCE A C QUARK-ANTIQUARK PAIR BETWEEN SCALES RMASS(M) AND 2*HWBVMC(N) IF (SUDORD.NE.1.AND.BETA0(3).EQ.ZERO) THEN DO 100 M=3,6 BETA0(M)=(11.*CAFAC-2.*M)*0.5 100 BETAP(M)=(17.*CAFAC**2-(5.*CAFAC+3.*CFFAC)*M) & /BETA0(M)*0.25/PIFAC DO 120 N=1,5 DO 110 M=4,6 IF (M.LE.N) THEN SQRK(M,N)=ONE ELSEIF (M.EQ.4.OR.M.EQ.N+1) THEN NF=M IF (2*HWBVMC(N).GT.RMASS(M)) NF=M+1 SQRK(M,N)=((BETAP(NF-1)+1/HWUALF(1,2*HWBVMC(N)))/ $ (BETAP(NF-1)+1/HWUALF(1,RMASS(M))))**(1/BETA0(NF-1)) ELSE SQRK(M,N)=SQRK(M-1,N)* $ ((BETAP(M-1)+1/HWUALF(1,RMASS(M-1)))/ $ (BETAP(M-1)+1/HWUALF(1,RMASS(M))))**(1/BETA0(M-1)) ENDIF 110 CONTINUE 120 CONTINUE ENDIF ID=IDPAR(KPAR) C--TEST FOR PARTON TYPE IF (ID.LE.13) THEN JD=ID IS=ISUD(ID) ELSEIF (ID.GE.209.AND.ID.LE.220) THEN JD=ID-208 IS=7 ELSE IS=0 END IF QNOW=-1. IF (IS.NE.0) THEN C--TIMELIKE PARTON BRANCHING ENOW=PPAR(4,KPAR) XIPREV=PPAR(2,KPAR) IF (JMOPAR(1,KPAR).EQ.0) THEN EPREV=PPAR(4,KPAR) ELSE EPREV=PPAR(4,JMOPAR(1,KPAR)) ENDIF C--IF THIS IS CHARGED & PHOTONS ARE ALLOWED, ANGLES MIGHT NOT BE ORDERED QMAX=0 QLST=PPAR(1,KPAR) IF (ICHRG(ID).NE.0 .AND. VPCUT.LT.PPAR(1,2)) THEN C--LOOK FOR A PREVIOUS G->QQBAR, IF ANY MPAR=KPAR 1 IF (JMOPAR(1,MPAR).NE.0) THEN IF (IDPAR(JMOPAR(1,MPAR)).EQ.ID) THEN MPAR=JMOPAR(1,MPAR) GOTO 1 ENDIF ENDIF C--IF CLIMBED TO THE TOP OF THE LIST, FIND QED INTERFERENCE PARTNER IF (MPAR.EQ.2) THEN JHEP=0 IF (ID.LT.7) THEN IHEP=JDAHEP(2,JCOPAR(1,1)) IF (IHEP.GT.0) JHEP=JDAHEP(2,IHEP) ELSE IHEP=JMOHEP(2,JCOPAR(1,1)) IF (IHEP.GT.0) JHEP=JMOHEP(2,IHEP) ENDIF IF (IHEP.GT.0.AND.JHEP.GT.0) THEN QMAX=HWULDO(PHEP(1,IHEP),PHEP(1,JHEP)) & *(ENOW/PPAR(4,2))**2 ELSE C--FIX AT HARD PROCESS SCALE IF POINTER NOT YET SET C (CAN HAPPEN IN SUSY EVENTS) QMAX=EMSCA**2 ENDIF ELSE QMAX=ENOW**2*PPAR(2,MPAR) ENDIF C--IF PREVIOUS BRANCHING WAS Q->QGAMMA, LOOK FOR A QCD BRANCHING MPAR=KPAR 2 IF (JMOPAR(1,MPAR).NE.0) THEN IF (IDPAR(JDAPAR(1,JMOPAR(1,MPAR))).EQ.59 .OR. & IDPAR(JDAPAR(2,JMOPAR(1,MPAR))).EQ.59) THEN MPAR=JMOPAR(1,MPAR) GOTO 2 ENDIF ENDIF QLST=ENOW**2*PPAR(2,MPAR) QMAX=SQRT(MAX(ZERO,MIN( & QMAX , EPREV**2*XIPREV , ENOW**2*XIPREV*(2-XIPREV)))) QLST=SQRT(MIN( & QLST , EPREV**2*XIPREV , ENOW**2*XIPREV*(2-XIPREV))) ENDIF NTRY=0 5 NTRY=NTRY+1 IF (NTRY.GT.NBTRY) CALL HWWARN('HWBRAN',100,*999) IF (ID.EQ.13) THEN C--GLUON -> QUARK+ANTIQUARK OPTION IF (QLST.GT.QCDL3) THEN DO 8 N=1,NFLAV QKTHR=2.*HWBVMC(N) IF (QLST.GT.QKTHR) THEN RN=HWR() IF (SUDORD.NE.1) THEN C---FIND IN WHICH FLAVOUR INTERVAL THE UPPER LIMIT LIES NF=3 DO 200 M=MAX(3,N),NFLAV 200 IF (QLST.GT.RMASS(M)) NF=M C---CALCULATE THE FORM FACTOR IF (NF.EQ.MAX(3,N)) THEN SFNL=((BETAP(NF)+1/HWUALF(1,QKTHR))/ $ (BETAP(NF)+1/HWUALF(1,QLST)))**(1/BETA0(NF)) SLST=SFNL ELSE SFNL=((BETAP(NF)+1/HWUALF(1,RMASS(NF)))/ $ (BETAP(NF)+1/HWUALF(1,QLST)))**(1/BETA0(NF)) SLST=SFNL*SQRK(NF,N) ENDIF ENDIF IF (RN.GT.1.E-3) THEN QQBAR=QCDL3*(QLST/QCDL3)**(RN**BETAF) ELSE QQBAR=QCDL3 ENDIF IF (SUDORD.NE.1) THEN C---FIND IN WHICH FLAVOUR INTERVAL THE SOLUTION LIES IF (RN.GE.SFNL) THEN NN=NF ELSEIF (RN.GE.SLST) THEN NN=MAX(3,N) DO 210 M=MAX(3,N)+1,NF-1 210 IF (RN.GE.SLST/SQRK(M,N)) NN=M ELSE NN=0 QQBAR=QCDL3 ENDIF IF (NN.GT.0) THEN IF (NN.EQ.NF) THEN TARG=HWUALF(1,QLST) ELSE TARG=HWUALF(1,RMASS(NN+1)) RN=RN/SLST*SQRK(NN+1,N) ENDIF TARG=1/((BETAP(NN)+1/TARG)*RN**BETA0(NN)-BETAP(NN)) C---NOW SOLVE HWUALF(1,QQBAR)=TARG FOR QQBAR ITERATIVELY 7 QQBAR=MAX(QQBAR,HALF*QKTHR) ALF=HWUALF(1,QQBAR) IF (ABS(ALF-TARG).GT.ACCUR) THEN NTRY=NTRY+1 IF (NTRY.GT.NBTRY) CALL HWWARN('HWBRAN',101,*999) QQBAR=QQBAR*(1+3*PIFAC*(ALF-TARG) $ /(BETA0(NN)*ALF**2*(1+BETAP(NN)*ALF))) GOTO 7 ENDIF ENDIF ENDIF IF (QQBAR.GT.QNOW.AND.QQBAR.GT.QKTHR) THEN QNOW=QQBAR ID2=N ENDIF ELSE GOTO 9 ENDIF 8 CONTINUE ENDIF C--GLUON->DIQUARKS OPTION 9 IF (QLST.LT.QDIQK) THEN IF (PDIQK.NE.ZERO) THEN RN=HWR() DQQ=QLST*EXP(-RN/PDIQK) IF (DQQ.GT.QNOW) THEN IF (DQQ.GT.2.*RMASS(115)) THEN QNOW=DQQ ID2=115 ENDIF ENDIF ENDIF ENDIF ENDIF C--ENHANCE GLUON AND PHOTON EMISSION BY A FACTOR OF TWO IF THIS BRANCH C IS CAPABLE OF BEING THE HARDEST SO FAR NREJ=1 IF (TMPAR(2).AND.0.25*MAX(QLST,QMAX).GT.HARDST) NREJ=2 C--BRANCHING ID->ID+GLUON QGTHR=HWBVMC(ID)+HWBVMC(13) IF (QLST.GT.QGTHR) THEN DO 300 IREJ=1,NREJ RN=HWR() SLST=HWUTAB(SUD(1,IS),QEV(1,IS),NQEV,QLST,INTER) IF (RN.EQ.ZERO) THEN SNOW=2. ELSE SNOW=SLST/RN ENDIF IF (SNOW.LT.ONE) THEN QSUD=HWUTAB(QEV(1,IS),SUD(1,IS),NQEV,SNOW,INTER) C---IF FORM FACTOR DID NOT GET INVERTED CORRECTLY TRY LINEAR INSTEAD IF (QSUD.GT.QLST) THEN SNOW=HWUTAB(SUD(1,IS),QEV(1,IS),NQEV,QLST,1)/RN QSUD=HWUTAB(QEV(1,IS),SUD(1,IS),NQEV,SNOW,1) IF (QSUD.GT.QLST) THEN CALL HWWARN('HWBRAN',1,*999) QSUD=-1 ENDIF ENDIF IF (QSUD.GT.QGTHR.AND.QSUD.GT.QNOW) THEN ID2=13 QNOW=QSUD ENDIF ENDIF 300 CONTINUE ENDIF C--BRANCHING ID->ID+PHOTON IF (ICHRG(ID).NE.0) THEN QGTHR=MAX(HWBVMC(ID)+HWBVMC(59),HWBVMC(59)*EXP(0.75)) IF (QMAX.GT.QGTHR) THEN DO 400 IREJ=1,NREJ RN=HWR() IF (RN.EQ.ZERO) THEN QGAM=0 ELSE QGAM=(LOG(QMAX/HWBVMC(59))-0.75)**2 & +PIFAC*9/(ICHRG(ID)**2*ALPFAC*ALPHEM)*LOG(RN) IF (QGAM.GT.ZERO) THEN QGAM=HWBVMC(59)*EXP(0.75+SQRT(QGAM)) ELSE QGAM=0 ENDIF ENDIF IF (QGAM.GT.QGTHR.AND.QGAM.GT.QNOW) THEN ID2=59 QNOW=QGAM ENDIF 400 CONTINUE ENDIF ENDIF IF (QNOW.GT.ZERO) THEN C--BRANCHING HAS OCCURRED ZMIN=HWBVMC(ID2)/QNOW ZMAX=1.-ZMIN IF (ID.EQ.13) THEN IF (ID2.EQ.13) THEN C--GLUON -> GLUON + GLUON ID1=13 WMIN=ZMIN*ZMAX ETEST=(1.-WMIN)**2*HWUALF(5-SUDORD*2,QNOW*WMIN) ZRAT=(ZMAX*(1-ZMIN))/(ZMIN*(1-ZMAX)) C--CHOOSE Z1 DISTRIBUTED ON (ZMIN,ZMAX) C ACCORDING TO GLUON BRANCHING FUNCTION 10 Z1=ZMAX/(ZMAX+(1-ZMAX)*ZRAT**HWR()) Z2=1.-Z1 ZTEST=(1.-(Z1*Z2))**2*HWUALF(5-SUDORD*2,QNOW*(Z1*Z2)) IF (ZTEST.LT.ETEST*HWR()) GOTO 10 Z=Z1 ELSEIF (ID2.NE.115) THEN C--GLUON -> QUARKS ID1=ID2+6 ETEST=ZMIN**2+ZMAX**2 20 Z1=HWRUNI(0,ZMIN,ZMAX) Z2=1.-Z1 ZTEST=Z1*Z1+Z2*Z2 IF (ZTEST.LT.ETEST*HWR()) GOTO 20 ELSE C--GLUON -> DIQUARKS ID2=HWRINT(115,117) ID1=ID2-6 Z1=HWRUNI(0,ZMIN,ZMAX) Z2=1.-Z1 ENDIF ELSE C--QUARK OR ANTIQUARK BRANCHING IF (ID2.EQ.13) THEN C--TO GLUON ZMAX=1.-HWBVMC(ID)/QNOW WMIN=MIN(ZMIN*(1.-ZMIN),ZMAX*(1.-ZMAX)) ETEST=(1.+ZMAX**2)*HWUALF(5-SUDORD*2,QNOW*WMIN) ZRAT=ZMAX/ZMIN 30 Z1=ZMIN*ZRAT**HWR() Z2=1.-Z1 ZTEST=(1.+Z2*Z2)*HWUALF(5-SUDORD*2,QNOW*Z1*Z2) IF (ZTEST.LT.ETEST*HWR()) GOTO 30 ELSE C--TO PHOTON ZMIN= HWBVMC(59)/QNOW ZMAX=1-HWBVMC(ID)/QNOW ZRAT=ZMAX/ZMIN ETEST=1+(1-ZMIN)**2 40 Z1=ZMIN*ZRAT**HWR() Z2=1-Z1 ZTEST=1+Z2*Z2 IF (ZTEST.LT.ETEST*HWR()) GOTO 40 ENDIF C--QUARKS EMIT ON LOWER SIDE, ANTIQUARKS ON UPPER SIDE Z=Z1 IF (JD.LE.6) THEN Z1=Z2 Z2=1.-Z2 ID1=ID ELSE ID1=ID2 ID2=ID ENDIF ENDIF C--UPDATE THIS BRANCH AND CREATE NEW BRANCHES XI=(QNOW/ENOW)**2 IF (ID1.NE.59.AND.ID2.NE.59) THEN IF (ID.EQ.13.AND.ID1.NE.13) THEN QLAM=QNOW ELSE QLAM=QNOW*Z1*Z2 ENDIF IF (SUDORD.EQ.1.AND.HWUALF(2,QLAM).LT.HWR() .OR. & (2.-XI)*(QNOW*Z1*Z2)**2.GT.EMSCA**2) THEN C--BRANCHING REJECTED: REDUCE Q AND REPEAT QMAX=QNOW QLST=QNOW QNOW=-1. GOTO 5 ENDIF ENDIF C--IF THIS IS HARDEST EMISSION SO FAR, APPLY MATRIX-ELEMENT CORRECTION IF (ID.NE.13.OR.ID1.EQ.13) THEN QLAM=QNOW*Z1*Z2 REJFAC=1 IF (TMPAR(2).AND.QLAM.GT.HARDST) THEN C----SOFT MATRIX-ELEMENT CORRECTION TO TOP DECAYS ITOP=JCOPAR(1,1) IF (ISTHEP(ITOP).EQ.155.AND.(IDHW(ITOP).EQ.6 $ .OR.IDHW(ITOP).EQ.12)) THEN AW=(PHEP(5,JDAHEP(1,ITOP))/PHEP(5,ITOP))**2 FF=0.5*(1-AW)*(1-2*AW+1/AW) CC=0.25*(1-AW)**2 X1=1-2*CC*Z*(1-Z)*XI X3=0.5*(1-AW+2*CC*Z*(1-Z)*XI-(1-2*Z) & *HWUSQR(((1+AW-2*CC*Z*(1-Z)*XI)**2-4*AW) & /(1-2*Z*(1-Z)*XI))) C-----JACOBIAN FACTOR JJ=(1-X1)*(2-AW-X1-2*X3)*(1-2*Z*(1-Z)*XI)/( $ 4*CC**2*((X1+AW)**2-4*AW)*Z**2*(1-Z)**2*(1-2*Z)*XI) C-----REJECTION FACTOR XCUT=2*GCUTME/PHEP(5,ITOP) IF (X3.GT.XCUT) REJFAC=FF*JJ & *X3**2*(1-X1)*(1+(1-Z)**2)/(Z*XI) & /((1+1/AW-2*AW)*((1-AW)*X3-(1-X1) & *(1-X3)-X3**2)+(1+1/(2*AW))*X3*(X1+X3-1)**2 & +2*X3**2*(1-X1)) ELSEIF (MOD(ISTHEP(JCOPAR(1,1)),10).GE.3) THEN C---COLOUR PARTNER IS ALSO OUTGOING X1=1-Z*(1-Z)*XI X2=0.5*(1+Z*(1-Z)*XI + $ (1-Z*(1-Z)*XI)*(1-2*Z)/SQRT(1-2*Z*(1-Z)*XI)) REJFAC=SQRT(2*X1-1)/(X1*Z*(1-Z)) $ *(1+(1-Z)**2)/(Z*XI) $ *(1-X1)*(1-X2)/(X1**2+X2**2) C---CHECK WHETHER IT IS IN THE OVERLAP REGION OTHXI=4*(1-X2)*X2**2/(X2**2-(2*X2-1)*(2*X1+X2-2)**2) IF (OTHXI.LT.ONE) THEN OTHZ=0.5*(1-SQRT(2*X2-1)/X2*(2*X1+X2-2)) REJFAC=REJFAC+SQRT(2*X2-1)/(X2*OTHZ*(1-OTHZ)) $ *(1+(1-OTHZ)**2)/(OTHZ*OTHXI) $ *(1-X2)*(1-X1)/(X2**2+X1**2) ENDIF ELSE C---COLOUR PARTNER IS INCOMING (X1=XP, X2=ZP) X1=1/(1+Z*(1-Z)*XI) X2=0.5*(1+(1-2*Z)/SQRT(1-2*Z*(1-Z)*XI)) REJFAC=SQRT(3-2/X1)/(X1**2*Z*(1-Z)) $ *(1+(1-Z)**2)/(Z*XI) $ *(1-X1)*(1-X2)/ $ (1+(1-X1-X2+2*X1*X2)**2+2*(1-X1)*(1-X2)*X1*X2) C---CHECK WHETHER IT IS IN THE OVERLAP REGION OTHXI=(SQRT(X1+2*(1-X2)*(1-X2+X1*X2))-SQRT(X1))**2/ $ (1+X1-X2-SQRT(X1*(X1+2*(1-X2)*(1-X2+X1*X2)))) OTHZ=(SQRT(X1*(X1+2*(1-X2)*(1-X2+X1*X2)))-X1)/(1-X2) IF (OTHXI.LT.OTHZ**2) THEN REJFAC=REJFAC+OTHZ**3*(1-X1-X2+2*X1*X2) $ /(X1**2*(1-OTHZ)*(OTHZ+OTHXI*(1-OTHZ))) $ *(1+OTHZ**2)/((1-OTHZ)*OTHXI) $ *(1-X1)*(1-X2)/ $ (1+(1-X1-X2+2*X1*X2)**2+2*(1-X1)*(1-X2)*X1*X2) ENDIF ENDIF ENDIF IF (NREJ*REJFAC*HWR().GT.ONE) THEN QMAX=QNOW QLST=QNOW QNOW=-1. GOTO 5 ENDIF IF (QLAM.GT.HARDST) HARDST=QLAM ENDIF MPAR=NPAR+1 IDPAR(MPAR)=ID1 TMPAR(MPAR)=.TRUE. PPAR(1,MPAR)=QNOW*Z1 PPAR(2,MPAR)=XI PPAR(4,MPAR)=ENOW*Z1 NPAR=NPAR+2 IDPAR(NPAR)=ID2 TMPAR(NPAR)=.TRUE. PPAR(1,NPAR)=QNOW*Z2 PPAR(2,NPAR)=XI PPAR(4,NPAR)=ENOW*Z2 C---NEW MOTHER-DAUGHTER RELATIONS JDAPAR(1,KPAR)=MPAR JDAPAR(2,KPAR)=NPAR JMOPAR(1,MPAR)=KPAR JMOPAR(1,NPAR)=KPAR C---NEW COLOUR CONNECTIONS JCOPAR(3,KPAR)=NPAR JCOPAR(4,KPAR)=MPAR JCOPAR(1,MPAR)=NPAR JCOPAR(2,MPAR)=KPAR JCOPAR(1,NPAR)=KPAR JCOPAR(2,NPAR)=MPAR C ENDIF ENDIF IF (QNOW.LT.ZERO) THEN C--BRANCHING STOPS IF (ID.EQ.IDPAR(2).AND.PPAR(5,2).GT.1D-6) THEN PPAR(5,KPAR)=PPAR(5,2)**2 ELSE PPAR(5,KPAR)=RMASS(ID)**2 ENDIF PMOM=PPAR(4,KPAR)**2-PPAR(5,KPAR) IF (PMOM.LT.-1E-6) CALL HWWARN('HWBRAN',104,*999) IF (PMOM.LT.ZERO) PMOM=ZERO PPAR(3,KPAR)=SQRT(PMOM) JDAPAR(1,KPAR)=0 JDAPAR(2,KPAR)=0 JCOPAR(3,KPAR)=0 JCOPAR(4,KPAR)=0 ENDIF 999 END CDECK ID>, HWBRCN. *CMZ :- -20/07/99 10:56:12 by Peter Richardson *-- Author : Peter Richardson C----------------------------------------------------------------------- SUBROUTINE HWBRCN C----------------------------------------------------------------------- C SUBROUTINE TO REPLACE HWBCON IN RPARITY VIOLATING SUSY C BASED ON HWBCON BY BRW C----------------------------------------------------------------------- INCLUDE 'HERWIG61.INC' INTEGER IHEP,IST,ID,JC,JD,JHEP,IDP,IDM,IDP2,IDM2, & RHEP,IST2,ORG,ANTC,XHEP,IP,COLP LOGICAL BVVUSE,BVVHRD,BVDEC1,BVDEC2,COLRD,ACOLRD,BVHRD,BVHRD2, & BVDEC3 C--logical functions to decide if baryon number violating C--BVDEC1 DELTAB=+1 BVDEC1(IP) = ((IDHW(IP).GE.419.AND.IDHW(IP).LE.424).OR. & IDHW(IP).EQ.411.OR.IDHW(IP).EQ.412.OR. & IDHW(IP).EQ.449).AND.IDHW(JDAHEP(1,IP)).LE.6. & AND.IDHW(JDAHEP(1,IP)+1).LE.6.AND. & IDHW(JDAHEP(2,IP)).LE.6 C--BVDEC2 DELTAB=-1 BVDEC2(IP) = ((IDHW(IP).GE.413.AND.IDHW(IP).LE.418).OR. & IDHW(IP).EQ.405.OR.IDHW(IP).EQ.406.OR. & IDHW(IP).EQ.449).AND. & IDHW(JDAHEP(1,IP)).GE.7.AND.IDHW(JDAHEP(1,IP)).LE.12.AND. & IDHW(JDAHEP(1,IP)+1).GE.7.AND.IDHW(JDAHEP(1,IP)+1).LE.12.AND. & IDHW(JDAHEP(2,IP)).GE.7.AND.IDHW(JDAHEP(2,IP)).LE.12 C--Neutralino and Chargino Decays BVDEC3(IP) = ((IDHW(IP).GE.450.AND.IDHW(IP).LE.457).AND. & (IDHW(JDAHEP(1,IP)).LE.12.AND.IDHW(JDAHEP(1,IP)+1).LE.12. & .AND.IDHW(JDAHEP(2,IP)).LE.12)) C--Now the hard vertices BVHRD(IP) = IDHW(IP).EQ.15.AND.IDHW(JMOHEP(1,IP)).LE.12. & AND.IDHW(JMOHEP(2,IP)).LE.12.AND.IDHW(JDAHEP(1,IP)).LE.12. & AND.IDHW(JDAHEP(2,IP)).GE.449.AND.IDHW(JDAHEP(2,IP)).LE.457 BVHRD2(IP) = IDHW(IP).EQ.15.AND.IDHW(JMOHEP(1,IP)).LE.12. & AND.IDHW(JMOHEP(2,IP)).LE.12.AND.IDHW(JDAHEP(1,IP)).GE.198. & AND.IDHW(JDAHEP(1,IP)).LE.207. & AND.ABS(IDHEP(JDAHEP(2,IP))).GT.1000000 C--Those particles which are coloured COLRD(IP) = IP.LE.6.OR.IP.EQ.13.OR.IP.EQ.449.OR. & (IP.GE.401.AND.IP.LE.406).OR.(IP.GE.413.AND.IP.LE.418).OR. & (IP.GE.115.AND.IP.LE.120).OR.IP.EQ.59 C--Those particles which are anticoloured ACOLRD(IP) = (IP.GE.7.AND.IP.LE.12).OR.IP.EQ.13.OR.IP.EQ.449.OR. & (IP.GE.407.AND.IP.LE.412).OR.(IP.GE.419.AND.IP.LE.424).OR. & (IP.GE.109.AND.IP.LE.114).OR.IP.EQ.59 IF (IERROR.NE.0) RETURN COLP = 0 IF(COLUPD.AND.HRDCOL(1,3).NE.0) THEN JD = 0 DO IHEP = HRDCOL(1,3),HRDCOL(1,3)+4 JD = JD+1 IF(JD.NE.3) THEN JMOHEP(2,IHEP) = HRDCOL(1,JD) JDAHEP(2,IHEP) = HRDCOL(2,JD) ENDIF ENDDO COLUPD=.FALSE. DO IHEP=1,5 DO JHEP=1,2 HRDCOL(JHEP,IHEP)=0 ENDDO ENDDO ELSEIF(COLUPD) THEN RETURN ENDIF DO 110 IHEP=1,NHEP IST=ISTHEP(IHEP) JD =0 BVVUSE = .FALSE. BVVHRD = .FALSE. C---LOOK FOR PARTONS WITHOUT COLOUR MOTHERS IF ((IST.LT.145.OR.IST.GT.152).AND.IST.NE.155) GOTO 110 IF (JMOHEP(2,IHEP).EQ.0) THEN C---FIND COLOUR-CONNECTED PARTON IF(IST.EQ.155.AND.ABS(IDHEP(IHEP)).EQ.6) THEN JC = JMOHEP(1,IHEP) ELSEIF(IST.EQ.155) THEN GOTO 110 ELSE JC=JMOHEP(1,IHEP) ENDIF IF (IST.NE.152) JC=JMOHEP(1,JC) C--Correction for BV IF(HRDCOL(1,1).NE.0) THEN IDP = IDHW(HRDCOL(1,1)) IDP2 = 0 ELSE IDP = 0 IDP2 = 0 ENDIF IDM = JMOHEP(1,JC) IF(BVDEC1(IDM).OR.BVDEC2(IDM)) THEN IF(IDHW(IDM).EQ.449.AND.JDAHEP(1,IDM).EQ.JC) THEN JC=JMOHEP(2,JC) ELSE JD = JMOHEP(2,JC) JC = IDM IF(JC.EQ.JD) JD= JDAHEP(2,JC-1) BVVUSE = .TRUE. ENDIF C--NEW FOR BV HARD PROCESS ELSEIF(BVHRD(IDM)) THEN IF(IDHW(JDAHEP(2,JMOHEP(1,JC))).EQ.449) THEN JD = JMOHEP(2,JC) IDM2 = JDAHEP(2,HRDCOL(1,2)) IF(JD.EQ.IDM2) JD = HRDCOL(1,1) IF(JC.EQ.JDAHEP(2,IDM2).AND.COLRD(IDHW(IHEP))) THEN JC = JMOHEP(2,JC) ELSEIF(JC.EQ.IDM2) THEN IF(JDAHEP(2,JMOHEP(2,JC)).EQ.JC) THEN JC = JMOHEP(2,JC) ELSE JMOHEP(2,IHEP)=JMOHEP(2,JC) GOTO 110 ENDIF ELSE JC = HRDCOL(1,1) BVVUSE = .TRUE. BVVHRD = .TRUE. IF(ACOLRD(IDHW(IHEP))) JC = JD IF(JC.EQ.IDM2) GOTO 110 ENDIF ELSE JC =JMOHEP(2,JC) BVVUSE = .TRUE. BVVHRD = .TRUE. ENDIF ELSEIF(BVHRD2(IDM)) THEN JD = JMOHEP(2,JC) IF(JC.EQ.JDAHEP(2,HRDCOL(1,2))) THEN JMOHEP(2,IHEP)=JMOHEP(2,JC) GOTO 110 ENDIF IF(JD.EQ.JDAHEP(2,HRDCOL(1,2))) JD = HRDCOL(1,1) BVVUSE=.TRUE. BVVHRD = .TRUE. IF(JC.EQ.JDAHEP(2,HRDCOL(1,2))) THEN JC = JMOHEP(2,JC) ELSE JC = HRDCOL(1,1) ENDIF ELSE JC =JMOHEP(2,JC) ENDIF IF (JC.EQ.0) CALL HWWARN('HWBCON',51,*110) C---FIND SPECTATOR WHEN JC IS DECAYED HEAVY QUARK OR SUSY PARTICLE IF (ISTHEP(JC).EQ.155) THEN IF (IDHEP(JMOHEP(1,JC)).EQ.94) THEN C---DECAYED BEFORE HADRONIZING IF(BVVHRD) THEN JHEP = JC ELSEIF(BVVUSE) THEN JHEP=JDAHEP(2,JC-1) ELSE JHEP=JMOHEP(2,JC) ENDIF IF(JHEP.EQ.0.AND.ABS(IDHEP(JC)).EQ.6) THEN JHEP = JMOHEP(1,JMOHEP(1,JC)) IF(BVDEC1(JMOHEP(1,JHEP)).OR.BVDEC2(JMOHEP(1,JHEP))) THEN JC = JHEP JHEP = JDAHEP(2,JC-1) ELSE JHEP = 0 ENDIF ENDIF IF(BVVUSE.AND.ABS(IDHEP(JHEP)).GT.1000000.AND. & ISTHEP(JHEP).NE.155.OR.JHEP.EQ.0) GOTO 110 ID=IDHW(JHEP) IF (ISTHEP(JHEP).EQ.155) THEN C---SPECIAL FOR GLUINO DECAYS IF (ID.EQ.449) THEN ID=IDHW(JC) IF(BVVUSE) THEN ID=IDHW(IHEP) IF(ID.LE.6.OR.ID.EQ.13.OR. & (ID.GE.115.AND.ID.LE.120)) THEN ID = 7 ELSE ID = 1 ENDIF ENDIF CALL HWBRC1(JC,ID,JHEP,.TRUE.,*999) IF(BVVUSE.AND.JMOHEP(1,JC).EQ.JMOHEP(1,JD)) JC =JD ELSE JC=JDAHEP(2,JHEP) IF(COLRD(IDHW(IHEP)).AND.IDHW(JDAHEP(1,JHEP)).EQ.449) & JC=JDAHEP(1,JHEP) IF(BVVUSE.AND.JMOHEP(1,JC).EQ.JMOHEP(1,JD)) JC =JD ENDIF ELSE IF(BVVUSE) THEN IF(BVDEC2(JMOHEP(1,JHEP)).OR.JD.NE.JHEP.OR. & BVHRD(JMOHEP(1,JHEP)).OR.BVHRD2(JMOHEP(1,JHEP))) THEN JC = JD GOTO 100 ELSE JMOHEP(2,IHEP)=JHEP ID = IDHW(JHEP) IF((ID.GE.7.AND.ID.LE.12).OR. & (ID.GE.109.AND.ID.LE.114)) JMOHEP(2,JHEP)=IHEP ENDIF ELSE C--new for particles connected to BV IDM = JMOHEP(1,JHEP) IF(BVDEC1(IDM).OR.BVHRD(IDM).OR.BVHRD2(IDM)) THEN JC = JHEP IF(ABS(IDHEP(IHEP)).LT.1000000) GOTO 100 JMOHEP(2,IHEP)=JHEP GOTO 110 ENDIF C--new for top's from BV ID = IDHW(JC) IDP = JMOHEP(1,JMOHEP(1,JMOHEP(1,JC))) IF((ID.EQ.6.AND.(BVDEC1(IDP))). & OR.(ID.EQ.12.AND.BVDEC2(IDP)). & OR.((ID.EQ.12.OR.ID.EQ.449).AND.BVHRD(IDP))) THEN JMOHEP(2,IHEP)=JHEP IF(JDAHEP(2,JHEP).EQ.JC) JDAHEP(2,JHEP)=IHEP ELSE IF((IDHW(IHEP).GE.7.AND.IDHW(IHEP).LE.12. & AND.IDHW(JHEP).GE.7.AND.IDHW(JHEP).LE.12).OR. & (IDHW(IHEP).LE.6.AND.IDHW(JHEP).LE.6)) THEN JMOHEP(2,IHEP)=JHEP ELSE JMOHEP(2,IHEP)=JHEP IF((COLRD(IDHW(IHEP)).AND.ACOLRD(IDHW(JHEP))).OR. & (.NOT.COLRD(IDHW(IHEP)).AND. & .NOT.ACOLRD(IDHW(JHEP)))) THEN IF(JDAHEP(2,JHEP).EQ.0) THEN JDAHEP(2,JHEP)=IHEP ELSEIF(JMOHEP(2,JDAHEP(2,JHEP)).NE.JHEP) THEN JDAHEP(2,JHEP)=IHEP ENDIF ELSE IF(JMOHEP(2,JHEP).EQ.JC) JMOHEP(2,JHEP)=IHEP ENDIF ENDIF ENDIF ENDIF GOTO 110 ENDIF ELSE JC=JMOHEP(2,JC) ENDIF ENDIF 100 CONTINUE IF(BVVUSE.AND.ABS(IDHEP(JC)).LT.1000000.AND.JC.NE.JD & .AND.JD.NE.0.AND.JD.NE.JMOHEP(1,JC)) JC = JD IF(BVVUSE.AND.ABS(IDHEP(JC)).GT.1000000) THEN IF(COLRD(IDHW(IHEP)).AND..NOT.BVVHRD) GOTO 110 ENDIF IF(BVVUSE.AND.ISTHEP(JC).EQ.149) JC=JMOHEP(1,JMOHEP(1,JC)) C--SEARCH IN THE JET IF((ISTHEP(JC).GT.145.AND.ISTHEP(JC).LT.152).AND. & ISTHEP(IHEP).EQ.155) THEN JMOHEP(2,IHEP) = JC GOTO 110 ENDIF CALL HWBRC2(COLP,IHEP,JC,.TRUE.,BVVUSE,BVVHRD) IF(COLP.NE.0) THEN JMOHEP(2,IHEP) = COLP IF(COLRD(IDHW(IHEP)).AND.ACOLRD(IDHW(COLP)). & AND.JDAHEP(2,COLP).EQ.0) & JDAHEP(2,COLP) = IHEP IF((IDHW(IHEP).GE.7.AND.IDHW(IHEP).LE.12).AND. & (IDHW(COLP).GE.7.AND.IDHW(COLP).LE.12)) THEN IF(JMOHEP(2,COLP).EQ.0) JMOHEP(2,COLP) = IHEP ENDIF ENDIF ENDIF 110 CONTINUE C---BREAK COLOUR CONNECTIONS WITH PHOTONS modified for Rslash IHEP=1 130 IF (IHEP.LE.NHEP) THEN IF (IDHW(IHEP).EQ.59 .AND. ISTHEP(IHEP).EQ.149.AND. & (JMOHEP(2,IHEP).NE.IHEP.OR.JDAHEP(2,IHEP).NE.IHEP)) THEN IF(JMOHEP(2,IHEP).NE.0) THEN IF (JDAHEP(2,JMOHEP(2,IHEP)).EQ.IHEP) & JDAHEP(2,JMOHEP(2,IHEP))=JDAHEP(2,IHEP) ENDIF IF (JDAHEP(2,IHEP).NE.0) THEN IF (JMOHEP(2,JDAHEP(2,IHEP)).EQ.IHEP) & JMOHEP(2,JDAHEP(2,IHEP))=JMOHEP(2,IHEP) ENDIF DO RHEP=1,NHEP IST=ISTHEP(RHEP) IF((IST.GE.147.AND.IST.LE.149).AND.JDAHEP(2,RHEP).EQ.IHEP) & JDAHEP(2,RHEP)=JMOHEP(2,IHEP) ENDDO DO RHEP=1,NHEP IST=ISTHEP(RHEP) IF((IST.GE.147.AND.IST.LE.149).AND.JMOHEP(2,RHEP).EQ.IHEP) & JMOHEP(2,RHEP) = JDAHEP(2,IHEP) ENDDO JMOHEP(2,IHEP)=IHEP JDAHEP(2,IHEP)=IHEP ENDIF IHEP=IHEP+1 GOTO 130 ENDIF C--Update the BV anticolour corrections DO 210 IHEP=1,NHEP+1 IF(IHEP.EQ.1) GOTO 210 IST2 = 0 IF(IHEP.EQ.NHEP+1) THEN ANTC = HRDCOL(1,1) IF(ANTC.EQ.0.OR.(IDHW(JMOHEP(1,HRDCOL(1,2))).LE.6)) GOTO 210 IST=155 XHEP=HRDCOL(1,2) IF(ANTC.EQ.JDAHEP(2,XHEP)) ANTC=JDAHEP(1,JDAHEP(1,ANTC)) IF(ANTC.NE.0.AND.JDAHEP(1,ANTC).NE.0) IST2=ISTHEP(ANTC) ELSE ANTC = JDAHEP(2,IHEP-1) IF(ANTC.NE.0) IST2=ISTHEP(ANTC) IST=ISTHEP(IHEP) IDM = IDHW(IHEP) XHEP=IHEP ENDIF JC = 0 JHEP = 0 JD = 0 ORG = 0 IF(IST.EQ.155.AND.IST2.EQ.155) THEN IDM = IDHW(XHEP) ORG = ANTC IF(BVDEC1(XHEP).OR.BVDEC2(XHEP).OR.BVHRD(XHEP).OR. & BVHRD2(XHEP)) THEN JC=ANTC ID = IDHW(JC) JHEP = JC IF(BVDEC1(JC).OR.BVDEC2(JC)) THEN IF(IHEP.EQ.(NHEP+1)) ANTC=JDAHEP(1,JC) GOTO 200 ENDIF IF (ID.EQ.449) THEN C--SPECIAL FOR GLUINO DECAYS ID=IDHW(XHEP) IF(IHEP.EQ.NHEP+1) ID = 407 CALL HWBRC1(JC,ID,JHEP,.FALSE.,*999) ELSE IF(IDHW(JDAHEP(1,JHEP)).EQ.449) THEN JC=JDAHEP(1,JHEP) ELSE JC=JDAHEP(2,JHEP) ENDIF ENDIF C--SEARCH IN JET CALL HWBRC2(COLP,XHEP,JC,.FALSE.,BVVUSE,.FALSE.) ANTC = COLP IF(IHEP.LE.NHEP.AND.ACOLRD(IDHW(IHEP)).AND. & COLRD(IDHW(COLP)).AND.JMOHEP(2,COLP).EQ.0) THEN JMOHEP(2,COLP) = IHEP ELSEIF(IHEP.LE.NHEP.AND.IDHW(IHEP).LE.6.AND. & IDHW(COLP).LE.6.AND.JDAHEP(2,COLP).EQ.0) THEN JDAHEP(2,COLP) = IHEP ELSEIF(IHEP.GT.NHEP.AND. & ((BVHRD(XHEP).AND.COLRD(JDAHEP(1,XHEP))). & OR.(BVHRD2(XHEP).AND.ACOLRD(JDAHEP(2,XHEP)))).AND. & ACOLRD(IDHW(COLP)).AND.JDAHEP(2,COLP).EQ.0) THEN JDAHEP(2,COLP) = IHEP ENDIF ENDIF ENDIF 200 CONTINUE IF(IHEP.EQ.NHEP+1) THEN IF(HRDCOL(1,1).NE.ANTC.AND.ANTC.NE.0) THEN HRDCOL(1,1)=ANTC IF(JDAHEP(2,ANTC).EQ.IHEP) THEN IF(JDAHEP(2,JMOHEP(1,HRDCOL(1,2))).EQ.JDAHEP(2,HRDCOL(1,2)). & AND.JMOHEP(2,JDAHEP(2,HRDCOL(1,2))).EQ.JMOHEP(1,HRDCOL(1,2))) & THEN JDAHEP(2,ANTC) = JMOHEP(2,HRDCOL(1,2)) ELSE JDAHEP(2,ANTC) = JMOHEP(1,HRDCOL(1,2)) ENDIF ELSEIF(JMOHEP(2,ANTC).EQ.IHEP) THEN JMOHEP(2,ANTC) = JMOHEP(1,HRDCOL(1,2)) ENDIF ENDIF ELSEIF(IHEP.NE.1) THEN IF(JDAHEP(2,IHEP-1).NE.ANTC.AND.ANTC.NE.0) JDAHEP(2,IHEP-1)=ANTC ENDIF 210 CONTINUE C--Update BV decaying particles connections DO 310 IHEP=1,NHEP+1 IF(IHEP.EQ.1) GOTO 310 IF(IHEP.EQ.NHEP+1) THEN ANTC=HRDCOL(1,1) IF(ANTC.EQ.0.OR.IDHW(JDAHEP(1,HRDCOL(1,2))).LE.6) GOTO 310 IST=155 XHEP=HRDCOL(1,2) IF(ANTC.EQ.JDAHEP(2,XHEP)) ANTC=JDAHEP(1,JDAHEP(1,ANTC)) ELSE ANTC=JMOHEP(2,IHEP) IST=ISTHEP(IHEP) IDM = IDHW(IHEP) XHEP=IHEP ENDIF IST2 = 0 JC = 0 JD = 0 IF(ANTC.NE.0.AND.IHEP.NE.NHEP+1) THEN IF(JDAHEP(1,ANTC).NE.0) IST2 = ISTHEP(ANTC) ELSEIF(ANTC.NE.0.AND.IHEP.EQ.NHEP+1) THEN IST2=ISTHEP(ANTC) ENDIF IF(IST.EQ.155.AND.IST2.EQ.155) THEN IF(BVDEC2(XHEP).OR.BVHRD(XHEP).OR.BVHRD2(XHEP)) THEN C--FIND COLOUR CONNECTED PARTON JC = ANTC ID=IDHW(JC) JHEP = JC IF(BVDEC2(JHEP)) THEN ANTC=JC GOTO 300 ENDIF IF (ID.EQ.449) THEN ID=IDHW(XHEP) IF(IHEP.EQ.NHEP+1) ID = 401 C--SPECIAL FOR GLUINO DECAYS CALL HWBRC1(JC,ID,JHEP,.TRUE.,*999) ELSE IF(IDHW(JDAHEP(1,JHEP)).EQ.449) THEN JC=JDAHEP(1,JHEP) ELSE JC=JDAHEP(2,JHEP) ENDIF ENDIF C--SEARCH IN JET CALL HWBRC2(COLP,XHEP,JC,.TRUE.,BVVUSE,.FALSE.) ANTC = COLP IF(COLP.EQ.0) GOTO 300 IF(IHEP.LE.NHEP) THEN IF(JDAHEP(2,COLP).EQ.0) THEN JDAHEP(2,COLP) = JDAHEP(2,IHEP) ELSEIF(JMOHEP(2,JDAHEP(2,COLP)).NE.COLP) THEN JDAHEP(2,COLP) = JDAHEP(2,IHEP) ENDIF ELSEIF(IHEP.GT.NHEP.AND. & ((BVHRD(XHEP).AND.ACOLRD(JDAHEP(1,XHEP)).AND. & IDHW(JDAHEP(2,XHEP)).EQ.449). & OR.(BVHRD2(XHEP).AND.ACOLRD(JDAHEP(2,XHEP)))).AND. & ACOLRD(IDHW(COLP)).AND.JDAHEP(2,COLP).EQ.0) THEN JDAHEP(2,COLP) = IHEP ENDIF ENDIF ENDIF 300 CONTINUE IF(IHEP.NE.NHEP+1.AND.IHEP.NE.1) THEN IF(JMOHEP(2,IHEP).NE.ANTC.AND.ANTC.NE.0) JMOHEP(2,IHEP)=ANTC ELSEIF(IHEP.GT.NHEP) THEN IF(HRDCOL(1,1).NE.ANTC.AND.ANTC.NE.0) HRDCOL(1,1)=ANTC IF(ANTC.EQ.0) GOTO 310 IF(JDAHEP(2,ANTC).EQ.IHEP) THEN IF(JDAHEP(2,JMOHEP(1,HRDCOL(1,2))).EQ.JDAHEP(2,HRDCOL(1,2)). & AND.JMOHEP(2,JDAHEP(2,HRDCOL(1,2))).EQ.JMOHEP(1,HRDCOL(1,2))) & THEN JDAHEP(2,ANTC) = JMOHEP(2,HRDCOL(1,2)) ELSE JDAHEP(2,ANTC) = JMOHEP(1,HRDCOL(1,2)) ENDIF ELSEIF(JMOHEP(2,ANTC).EQ.IHEP) THEN JMOHEP(2,ANTC) = JMOHEP(1,HRDCOL(1,2)) ENDIF ENDIF 310 CONTINUE C--Update partons connected to decaying SUSY particle DO 400 IHEP=1,NHEP IST=ISTHEP(IHEP) C--LOOK FOR PARTONS CONNECTED TO A DECAYING SUSY PARTICLE IF (IST.LT.145.OR.IST.GT.152) GOTO 400 IF(JMOHEP(2,IHEP).EQ.0) GOTO 400 IF(ISTHEP(JMOHEP(2,IHEP)).EQ.155) THEN C--FIND THE COLOUR CONNECTED PARTON JC=JMOHEP(2,IHEP) ID=IDHW(JC) JHEP = JC IF(BVDEC2(JC).AND.IDHW(JC).NE.449) GOTO 400 IF (ID.EQ.449) THEN C--SPECIAL FOR GLUINO DECAYS ID=IDHW(IHEP) CALL HWBRC1(JC,ID,JHEP,.TRUE.,*999) ELSE ID=IDHW(IHEP) IF(COLRD(ID).AND.IDHW(JDAHEP(1,JC)).EQ.449) THEN JC=JDAHEP(1,JHEP) ELSE JC=JDAHEP(2,JHEP) ENDIF ENDIF C--SEARCH IN JET CALL HWBRC2(COLP,IHEP,JC,.TRUE.,BVVUSE,.FALSE.) JMOHEP(2,IHEP) = COLP ENDIF 400 CONTINUE C--Update partons connected to decaying SUSY particle DO 500 IHEP=1,NHEP IST=ISTHEP(IHEP) C--LOOK FOR PARTONS CONNECTED TO A DECAYING SUSY PARTICLE IF (IST.LT.145.OR.IST.GT.152) GOTO 500 IF(JDAHEP(2,IHEP).EQ.0) GOTO 500 IF(ISTHEP(JDAHEP(2,IHEP)).EQ.155) THEN C--FIND THE COLOUR CONNECTED PARTON JC=JDAHEP(2,IHEP) ID=IDHW(JC) ID=IDHW(JC) IF (ID.EQ.449) THEN ID=IDHW(IHEP) C--SPECIAL FOR GLUINO DECAYS JHEP = JC CALL HWBRC1(JC,ID,JHEP,.FALSE.,*999) ELSE IF(ACOLRD(IDHW(IHEP)).AND.IDHW(JDAHEP(1,JC)).EQ.449) THEN JC = JDAHEP(1,JC) ELSE JC=JDAHEP(2,JC) ENDIF ENDIF C--SEARCH IN THE JET CALL HWBRC2(COLP,IHEP,JC,.FALSE.,BVVUSE,.FALSE.) IF(COLP.NE.0) JDAHEP(2,IHEP) = COLP ENDIF 500 CONTINUE C--Flavour and anticolour connections in Rslash DO 610 IHEP=1,NHEP IST=ISTHEP(IHEP) IF(IST.LT.145.OR.IST.GT.152.OR.JDAHEP(2,IHEP).NE.0) GOTO 610 JD = 0 BVVUSE = .FALSE. JC = JMOHEP(1,IHEP) IF(IST.NE.152) JC = JMOHEP(1,JC) IF(JC.EQ.0) CALL HWWARN('HWBRCN',51,*610) C--For particles which came from a top decay IF(ABS(IDHEP(JMOHEP(1,JC))).EQ.6) THEN JD = JMOHEP(1,JMOHEP(1,JMOHEP(1,JC))) C--flavour connect to self if needed IF(JDAHEP(2,JMOHEP(1,JC)-1).EQ.JMOHEP(1,JC)) THEN JDAHEP(2,IHEP) = IHEP GOTO 610 ELSEIF(JDAHEP(2,JMOHEP(1,JC)-1).NE.0) THEN JDAHEP(2,IHEP) = JDAHEP(2,JMOHEP(1,JC)-1) GOTO 610 ELSE JC = JD ENDIF ENDIF C--Decide if this came from a BV decay IDM = JMOHEP(1,JC) IF(BVDEC1(IDM).OR.BVDEC2(IDM).OR.BVDEC3(IDM). & OR.BVHRD(IDM).OR.BVHRD2(IDM)) THEN C--Do BV piece IF(JDAHEP(2,JC).EQ.JMOHEP(1,JC)) THEN IF(IDHW(JMOHEP(1,JC)).EQ.449.AND. & JDAHEP(1,JMOHEP(1,JC)).EQ.JC) THEN JC = JDAHEP(2,JMOHEP(1,JC)-1) ELSE JC = JMOHEP(2,JMOHEP(1,JC)) ENDIF IF(ABS(IDHEP(JC)).LT.1000000) THEN IF(JDAHEP(1,JC).EQ.0) THEN JDAHEP(2,IHEP) = JC GOTO 610 ELSE GOTO 600 ENDIF ELSEIF(ABS(IDHEP(JC)).GT.1000000 & .AND.ISTHEP(JC).NE.155) THEN GOTO 610 ENDIF IF(ISTHEP(JC).EQ.155.AND.ACOLRD(IDHW(IHEP))) THEN JC = JDAHEP(1,JC) ELSE IF(ISTHEP(JC).EQ.155.AND.IDHW(JDAHEP(1,JC)).NE.449) THEN JC = JDAHEP(1,JC) ELSE JC = JDAHEP(2,JC) ENDIF ENDIF ELSE C--For the hard process IF(IDHW(IDM).EQ.15.AND.JC.EQ.JDAHEP(2,JMOHEP(1,JC))) THEN JDAHEP(2,IHEP) = JDAHEP(2,JC) GOTO 610 ELSEIF(IDHW(IDM).EQ.15.AND.IDHW(IHEP).NE.449) THEN JD=HRDCOL(1,1) IF(BVHRD(IDM).AND.IDHW(JDAHEP(2,IDM)).NE.449) THEN JC = JDAHEP(2,JC) GOTO 600 ELSEIF(JMOHEP(1,JDAHEP(2,JC)).EQ.JD) THEN JC=JDAHEP(2,JC) GOTO 600 ENDIF IF(JDAHEP(2,JC).EQ.8) JC = JD ELSE JD=JMOHEP(2,JMOHEP(1,JC)) ENDIF IF(COLRD(IDHW(IHEP)).AND..NOT.ACOLRD(IDHW(IHEP)).AND. & ABS(IDHEP(JD)).GT.1000000.AND.ISTHEP(JD).NE.155) THEN JDAHEP(2,IHEP) = JD IF(JDAHEP(2,JD).EQ.0) JDAHEP(2,JD) = IHEP ENDIF IF(ABS(IDHEP(JD)).GT.1000000 & .AND.ISTHEP(JD).NE.155) GOTO 610 IF(ISTHEP(JC).EQ.149) THEN JDAHEP(2,IHEP)=JC GOTO 610 ENDIF IF(ACOLRD(IDHW(IHEP)).AND.IDHW(JC).EQ.449.AND.BVDEC2(JC)) THEN JC = JDAHEP(1,JC) ELSE JC = JDAHEP(2,JC) ENDIF ENDIF C--SEARCH IN THE JET 600 CALL HWBRC2(COLP,IHEP,JC,.FALSE.,BVVUSE,.FALSE.) IF(COLP.NE.0) THEN IF(ABS(IDHEP(COLP)).EQ.6.AND.JDAHEP(1,COLP).NE.0) THEN IF(ISTHEP(COLP).EQ.155) THEN JC = JDAHEP(2,COLP) ELSE JC = JDAHEP(2,JDAHEP(2,COLP)) ENDIF GOTO 600 ENDIF JDAHEP(2,IHEP) = COLP ENDIF ELSE C--check if it came from a top IF(ABS(IDHEP(JC)).EQ.6) THEN C--start the analysis again JC = JMOHEP(1,IHEP) IF(IST.NE.152) JC = JMOHEP(1,JC) JC = JDAHEP(2,JC) IF(JC.EQ.0) CALL HWWARN('HWBRCN',52,*610) IF(ISTHEP(JC).EQ.155) THEN IF (IDHEP(JMOHEP(1,JC)).EQ.94) THEN C---DECAYED BEFORE HADRONIZING JHEP=JDAHEP(2,JC-1) IF (JHEP.EQ.0) GO TO 610 ID=IDHW(JHEP) IF (ISTHEP(JHEP).EQ.155) THEN C---SPECIAL FOR GLUINO DECAYS IF (ID.EQ.449) THEN CALL HWBRC1(JC,ID,JHEP,.TRUE.,*999) ELSE JC=JDAHEP(2,JHEP) ENDIF ELSE IF(JMOHEP(2,JHEP).EQ.JC) JMOHEP(2,JHEP)=IHEP JDAHEP(2,IHEP) = JHEP GOTO 610 ENDIF ELSE JC=JDAHEP(2,JC-1) ENDIF ENDIF C--SEARCH IN JET CALL HWBRC2(COLP,IHEP,JC,.FALSE.,BVVUSE,.FALSE.) IF(COLP.NE.0) JDAHEP(2,IHEP) = COLP ELSE CALL HWWARN('HWBRCN',100,*610) ENDIF ENDIF 610 CONTINUE 999 END CDECK ID>, HWBRC1. *CMZ :- -20/07/99 10:56:12 by Peter Richardson *-- Author : PeterRichardson C----------------------------------------------------------------------- SUBROUTINE HWBRC1(JC,ID,JHEP,COL,*) C----------------------------------------------------------------------- C--Function to find the right daugther of a decaying gluino C----------------------------------------------------------------------- INCLUDE 'HERWIG61.INC' INTEGER ID,JHEP,KC,JC LOGICAL COL C---N.B. WILL NEED MODS WHEN SUSY PARTICLES CAN SHOWER C--Rparity take the first daughther IF(IDHW(JDAHEP(1,JHEP)).LE.12.AND.IDHW(JDAHEP(1,JHEP)+1).LE.12 & .AND.IDHW(JDAHEP(2,JHEP)).LE.12) THEN KC = JDAHEP(1,JHEP) GOTO 20 ELSEIF ((COL.AND.(ID.EQ.449.OR.ID.EQ.13)).OR. & (ID.GE.401.AND.ID.LE.406).OR. & (ID.GE.413.AND.ID.LE.418).OR.ID.LE.6.OR. & (ID.GE.115.AND.ID.LE.120)) THEN C---LOOK FOR ANTI(S)QUARK OR GLUON DO KC=JDAHEP(1,JHEP),JDAHEP(2,JHEP) ID=IDHW(KC) IF ((ID.GE.7.AND.ID.LE.13).OR.(ID.GE.407.AND.ID.LE.412).OR. & (ID.GE.419.AND.ID.LE.424)) GOTO 20 ENDDO ELSE C---LOOK FOR (S)QUARK OR GLUON DO KC=JDAHEP(1,JHEP),JDAHEP(2,JHEP) ID=IDHW(KC) IF (ID.LE. 6.OR. ID.EQ. 13.OR.(ID.GE.401.AND.ID.LE.406).OR. & (ID.GE.413.AND.ID.LE.418)) GOTO 20 ENDDO ENDIF C---COULDNT FIND ONE CALL HWWARN('HWBRC1',100,*10) 10 RETURN 1 20 JC=KC END