*
* $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
