* * $Id: hwepro.F,v 1.1.1.1 1996/03/08 17:02:12 mclareni Exp $ * * $Log: hwepro.F,v $ * Revision 1.1.1.1 1996/03/08 17:02:12 mclareni * Herwig58 * * *CMZ : 29/08/94 11.51.46 by Unknown *-- Author : CDECK ID>, HWEPRO. *CMZ :- -26/04/91 14.09.18 by Federico Carminati *-- Author : Bryan Webber C----------------------------------------------------------------------- SUBROUTINE HWEPRO C WHEN NEVHEP=0, CHOOSES X VALUES AND FINDS WEIGHT FOR PROCESS IPROC C OTHERWISE, CHOOSES AND LOADS ALL VARIABLES FOR HARD PROCESS C----------------------------------------------------------------------- #include "herwig58/herwig58.inc" DOUBLE PRECISION HWRGEN,GAMWT IF (IERROR.NE.0) RETURN C---FSTWGT IS .TRUE. DURING FIRST CALL TO HARD PROCESS ROUTINE FSTWGT=NWGTS.EQ.0.AND.NEVHEP.EQ.0 C---FSTEVT IS .TRUE. THROUGHOUT THE FIRST EVENT FSTEVT=NEVHEP.EQ.1 C---ROUTINE LOOPS BACK TO HERE IF GENERATED WEIGHT WAS NOT ACCEPTED 10 GENEV=.FALSE. C---SET UP INITIAL STATE NHEP=1 ISTHEP(NHEP)=101 PHEP(1,NHEP)=0. PHEP(2,NHEP)=0. PHEP(3,NHEP)=PBEAM1 PHEP(4,NHEP)=EBEAM1 PHEP(5,NHEP)=RMASS(IPART1) JMOHEP(1,NHEP)=0 JMOHEP(2,NHEP)=0 JDAHEP(1,NHEP)=0 JDAHEP(2,NHEP)=0 IDHW(NHEP)=IPART1 IDHEP(NHEP)=IDPDG(IPART1) NHEP=NHEP+1 ISTHEP(NHEP)=102 PHEP(1,NHEP)=0. PHEP(2,NHEP)=0. PHEP(3,NHEP)=-PBEAM2 PHEP(4,NHEP)=EBEAM2 PHEP(5,NHEP)=RMASS(IPART2) JMOHEP(1,NHEP)=0 JMOHEP(2,NHEP)=0 JDAHEP(1,NHEP)=0 JDAHEP(2,NHEP)=0 IDHW(NHEP)=IPART2 IDHEP(NHEP)=IDPDG(IPART2) C---NEXT ENTRY IS OVERALL CM FRAME NHEP=NHEP+1 IDHW(NHEP)=14 IDHEP(NHEP)=0 ISTHEP(NHEP)=103 JMOHEP(1,NHEP)=NHEP-2 JMOHEP(2,NHEP)=NHEP-1 JDAHEP(1,NHEP)=0 JDAHEP(2,NHEP)=0 CALL HWVSUM(4,PHEP(1,NHEP-1),PHEP(1,NHEP-2),PHEP(1,NHEP)) CALL HWUMAS(PHEP(1,NHEP)) C---GENERATE PHOTONS (WEIZSACKER-WILLIAMS APPROX) C FOR HADRONIC PROCESSES WITH LEPTON BEAMS GAMWT=ONE IF (IPRO.GT.10.AND.IPRO.LT.90) THEN IF (ABS(IDHEP(1)).EQ.11.OR.ABS(IDHEP(1)).EQ.13) & CALL HWEGAM(1,GAMWT,ZERO, ONE,.FALSE.) IF (ABS(IDHEP(2)).EQ.11.OR.ABS(IDHEP(2)).EQ.13) & CALL HWEGAM(2,GAMWT,ZERO, ONE,.FALSE.) ELSEIF (IPRO.GE.90) THEN IF (ABS(IDHEP(2)).EQ.11.OR.ABS(IDHEP(2)).EQ.13) & CALL HWEGAM(2,GAMWT,ZERO, ONE,.FALSE.) ENDIF C---IF USER LIMITS WERE TOO TIGHT, MIGHT NOT BE ANY PHASE-SPACE IF (GAMWT.LE.ZERO) GOTO 30 C---IF CMF HAS ACQUIRED A TRANSVERSE BOOST, OR USER REQUESTS IT ANYWAY, C BOOST EVENT RECORD BACK TO CMF IF (PHEP(1,3)**2+PHEP(2,3)**2.GT.0 .OR. USECMF) CALL HWUBST(1) C---ROUTINE LOOPS BACK TO HERE IF GENERATED WEIGHT WAS ACCEPTED 20 CONTINUE C---IPRO=MOD(IPROC/100,100) IF (IPRO.EQ.1) THEN IF (IPROC.LT.110.OR.IPROC.GE.120) THEN C--- E+E- -> Q-QBAR OR L-LBAR CALL HWHEPA ELSE C--- E+E- -> Q-QBAR-GLUON CALL HWHEPG ENDIF ELSEIF (IPRO.EQ.2) THEN C--- E+E- -> W+ W- CALL HWHEWW ELSEIF (IPRO.EQ.3) THEN C---E+E- -> Z H CALL HWHIGZ ELSEIF (IPRO.EQ.4) THEN C---E+E- -> NUEB NUE H CALL HWHIGW ELSEIF (IPRO.EQ.5 .AND. IPROC.LT.550) THEN C---EE -> EE GAMGAM -> EE FFBAR/WW CALL HWHEGG ELSEIF (IPRO.EQ.5) THEN C---EE -> ENU GAMW -> ENU FF'BAR/WZ CALL HWHEGW ELSEIF (IPRO.EQ.13) THEN C---GAMMA/Z0/Z' DRELL-YAN PROCESS CALL HWHDYP ELSEIF (IPRO.EQ.14) THEN C---W+/- PRODUCTION VIA DRELL-YAN PROCESS CALL HWHWPR ELSEIF (IPRO.EQ.15) THEN C---QCD HARD 2->2 PROCESSES CALL HWHQCD ELSEIF (IPRO.EQ.16) THEN C---HIGGS PRODUCTION VIA GLUON FUSION CALL HWHIGS ELSEIF (IPRO.EQ.17) THEN C---QCD HEAVY FLAVOUR PRODUCTION CALL HWHHVY ELSEIF (IPRO.EQ.18) THEN C---QCD DIRECT PHOTON + JET PRODUCTION CALL HWHPHO ELSEIF (IPRO.EQ.19) THEN C---HIGGS PRODUCTION VIA W FUSION CALL HWHIGW ELSEIF (IPRO.EQ.20) THEN C---TOP PRODUCTION FROM W EXCHANGE CALL HWHWEX ELSEIF (IPRO.EQ.21) THEN C---W + JET PRODUCTION CALL HWHW1J ELSEIF (IPRO.EQ.22) THEN C QCD direct photon pair production CALL HWHPH2 ELSEIF (IPRO.EQ.23) THEN C QCD Higgs plus jet production CALL HWHIGJ ELSEIF (IPRO.EQ.50) THEN C Point-like photon two-jet production CALL HWHPPT ELSEIF (IPRO.EQ.51) THEN C Point-like photon/QCD heavy flavour pair production CALL HWHPPH ELSEIF (IPRO.EQ.52) THEN C Point-like photon/QCD heavy flavour single excitation CALL HWHPPE ELSEIF (IPRO.EQ.55) THEN C Point-like photon/higher twist meson production CALL HWHPPM ELSEIF (IPRO.GE.70.AND.IPRO.LE.79) THEN C---BARYON-NUMBER VIOLATION, AND OTHER MULTI-W PRODUCTION PROCESSES CALL HVHBVI ELSEIF (IPRO.EQ.80) THEN C---MINIMUM-BIAS: NO HARD SUBPROCESS C FIND WEIGHT CALL HWMWGT ELSEIF (IPRO.EQ.90) THEN C---DEEP INELASTIC CALL HWHDIS ELSEIF(IPRO.EQ.91) THEN C---BOSON - GLUON(QUARK) FUSION --> ANTIQUARK(GLUON) + QUARK CALL HWHBGF ELSEIF(IPRO.EQ.92) THEN C---DEEP INELASTIC WITH EXTRA JET: OBSOLETE PROCESS WRITE (6,40) 40 FORMAT (1X,' IPROC=92** is no longer supported.' & /1X,' Please use IPROC=91** instead.') CALL HWWARN('HWEPRO',500,*999) ELSEIF(IPRO.EQ.95) THEN C---HIGGS PRODUCTION VIA W FUSION IN E P CALL HWHIGW ELSE C---UNKNOWN PROCESS CALL HWWARN('HWEPRO',102,*999) ENDIF 30 IF (GENEV) THEN IF (NOWGT) EVWGT=AVWGT ISTAT=10 RETURN ELSE C---IF AN EVENT IS CANCELLED BEFORE IT IS GENERATED, GIVE IT ZERO WEIGHT IF (IERROR.NE.0) THEN EVWGT=ZERO IERROR=0 ENDIF EVWGT=EVWGT*GAMWT NWGTS=NWGTS+1 WGTSUM=WGTSUM+EVWGT WSQSUM=WSQSUM+EVWGT**2 IF (EVWGT.GT.WBIGST) THEN WBIGST=EVWGT IF (NOWGT.AND.WBIGST.GT.WGTMAX) THEN IF (NEVHEP.NE.0) CALL HWWARN('HWEPRO',1,*999) WGTMAX=WBIGST*1.1 WRITE (6,99) WGTMAX ENDIF ELSEIF (EVWGT.LT.0.) THEN IF (EVWGT.LT.-1.D-9) CALL HWWARN('HWEPRO',3,*999) EVWGT=0. ENDIF IF (NEVHEP.NE.0) THEN C---LOW EFFICIENCY WARNINGS: C RESET AT 1 PER CENT, STOP AT 1 PER MILLE IF (NWGTS.GT.100*NEVHEP) THEN IF (NWGTS.GT.1000*NEVHEP) CALL HWWARN('HWEPRO',200,*999) IF (MOD(NWGTS,10000).EQ.0) THEN CALL HWWARN('HWEPRO',2,*999) WGTMAX=WBIGST*1.1 WRITE (6,99) WGTMAX ENDIF ENDIF IF (NOWGT) THEN GENEV=EVWGT.GT.WGTMAX*HWRGEN(0) ELSE GENEV=EVWGT.NE.0. ENDIF IF (GENEV) GO TO 20 GO TO 10 ENDIF ENDIF 99 FORMAT(10X,'NEW MAXIMUM WEIGHT =',1PG24.16) 999 END