* * $Id: hwdcle.F,v 1.1.1.1 1996/03/08 17:02:11 mclareni Exp $ * * $Log: hwdcle.F,v $ * Revision 1.1.1.1 1996/03/08 17:02:11 mclareni * Herwig58 * * *CMZ : 29/08/94 11.51.46 by Unknown *-- Author : CDECK ID>, HWDCLE. *CMZ :- -28/01/92 12.34.44 by Mike Seymour *-- Author : Luca Stanco C----------------------------------------------------------------------- SUBROUTINE HWDCLE(IHEP) C C INTERFACE TO QQ-CLEO MONTE CARLO (LS 11/12/91) C C----------------------------------------------------------------------- #include "herwig58/herwig58.inc" CHARACTER*4 NAME INTEGER IHEP,IIHEP,NHEPHF LOGICAL QQLERR INTEGER QQLMAT EXTERNAL QQLMAT C---QQ-CLEO COMMON'S C*** MCPARS.INC INTEGER MCTRK, NTRKS, MCVRTX, NVTXS, MCHANS, MCDTRS, MPOLQQ INTEGER MCNUM, MCSTBL, MCSTAB, MCTLQQ, MDECQQ INTEGER MHLPRB, MHLLST, MHLANG, MCPLST, MFDECA PARAMETER (MCTRK = 512) PARAMETER (NTRKS = MCTRK) PARAMETER (MCVRTX = 256) PARAMETER (NVTXS = MCVRTX) PARAMETER (MCHANS = 4000) PARAMETER (MCDTRS = 8000) PARAMETER (MPOLQQ = 300) PARAMETER (MCNUM = 500) PARAMETER (MCSTBL = 40) PARAMETER (MCSTAB = 512) PARAMETER (MCTLQQ = 100) PARAMETER (MDECQQ = 300) PARAMETER (MHLPRB = 500) PARAMETER (MHLLST = 1000) PARAMETER (MHLANG = 500) PARAMETER (MCPLST = 200) PARAMETER (MFDECA = 5) C*** MCPROP.INC REAL AMASS, CHARGE, CTAU, SPIN, RWIDTH, RMASMN, RMASMX REAL RMIXPP, RCPMIX INTEGER NPMNQQ, NPMXQQ, IDMC, INVMC, LPARTY, CPARTY INTEGER IMIXPP, ICPMIX COMMON/MCMAS1/ * NPMNQQ, NPMXQQ, * AMASS(-20:MCNUM), CHARGE(-20:MCNUM), CTAU(-20:MCNUM), * IDMC(-20:MCNUM), SPIN(-20:MCNUM), * RWIDTH(-20:MCNUM), RMASMN(-20:MCNUM), RMASMX(-20:MCNUM), * LPARTY(-20:MCNUM), CPARTY(-20:MCNUM), * IMIXPP(-20:MCNUM), RMIXPP(-20:MCNUM), * ICPMIX(-20:MCNUM), RCPMIX(-20:MCNUM), * INVMC(0:MCSTBL) C INTEGER NPOLQQ, IPOLQQ COMMON/MCPOL1/ * NPOLQQ, IPOLQQ(5,MPOLQQ) CHARACTER QNAME*10, PNAME*10 COMMON/MCNAMS/ * QNAME(37), PNAME(-20:MCNUM) C C*** MCCOMS.INC INTEGER NCTLQQ, NDECQQ, IVRSQQ, IORGQQ, IRS1QQ INTEGER IEVTQQ, IRUNQQ, IBMRAD INTEGER NTRKMC, QQNTRK, NSTBMC, NSTBQQ, NCHGMC, NCHGQQ INTEGER IRANQQ, IRANMC, IRANCC, IRS2QQ INTEGER IPFTQQ, IPCDQQ, IPRNTV, ITYPEV, IDECSV, IDAUTV INTEGER ISTBMC, NDAUTV INTEGER IVPROD, IVDECA REAL BFLDQQ REAL ENERQQ, BEAMQQ, BMPSQQ, BMNGQQ, EWIDQQ, BWPSQQ, BWNGQQ REAL BPOSQQ, BSIZQQ REAL ECM, P4CMQQ, P4PHQQ, ENERNW, BEAMNW, BEAMP, BEAMN REAL PSAV, P4QQ, HELCQQ CHARACTER DATEQQ*20, TIMEQQ*20, FOUTQQ*80, FCTLQQ*80, FDECQQ*80 CHARACTER FGEOQQ*80 CHARACTER CCTLQQ*80, CDECQQ*80 COMMON/MCCM1A/ * NCTLQQ, NDECQQ, IVRSQQ, IORGQQ, IRS1QQ(3), BFLDQQ, * ENERQQ, BEAMQQ, BMPSQQ, BMNGQQ, EWIDQQ, BWPSQQ, BWNGQQ, * BPOSQQ(3), BSIZQQ(3), * IEVTQQ, IRUNQQ, * IBMRAD, ECM, P4CMQQ(4), P4PHQQ(4), * ENERNW, BEAMNW, BEAMP, BEAMN, * NTRKMC, QQNTRK, NSTBMC, NSTBQQ, NCHGMC, NCHGQQ, * IRANQQ(2), IRANMC(2), IRANCC(2), IRS2QQ(5), * IPFTQQ(MCTRK), IPCDQQ(MCTRK), IPRNTV(MCTRK), ITYPEV(MCTRK,2), * IDECSV(MCTRK), IDAUTV(MCTRK), ISTBMC(MCTRK), NDAUTV(MCTRK), * IVPROD(MCTRK), IVDECA(MCTRK), * PSAV(MCTRK,4), HELCQQ(MCTRK), P4QQ(4,MCTRK) COMMON/MCCM1B/ * DATEQQ, TIMEQQ, FOUTQQ, FCTLQQ, FDECQQ, FGEOQQ, * CCTLQQ(MCTLQQ), CDECQQ(MDECQQ) INTEGER IDSTBL COMMON/MCCM1C/ * IDSTBL(MCSTAB) C INTEGER IFINAL(MCTRK), IFINSV(MCSTAB), NFINAL EQUIVALENCE (IFINAL,ISTBMC), (IFINSV,IDSTBL), (NFINAL,NSTBMC) C INTEGER NVRTX, ITRKIN, NTRKOU, ITRKOU, IVKODE REAL XVTX, TVTX, RVTX COMMON/MCCM2/ * NVRTX, XVTX(MCVRTX,3), TVTX(MCVRTX), RVTX(MCVRTX), * ITRKIN(MCVRTX), NTRKOU(MCVRTX), ITRKOU(MCVRTX), * IVKODE(MCVRTX) C*** MCGEN.INC INTEGER QQIST,QQIFR,QQN,QQK,QQMESO,QQNC,QQKC,QQLASTN REAL QQPUD,QQPS1,QQSIGM,QQMAS,QQPAR,QQCMIX,QQCND,QQBSPI,QQBSYM,QQP REAL QQPC,QQCZF C COMMON/DATA1/QQIST,QQIFR,QQPUD,QQPS1,QQSIGM,QQMAS(15),QQPAR(25) COMMON/DATA2/QQCZF(15),QQMESO(36),QQCMIX(6,2) COMMON/DATA3/QQCND(3) COMMON/DATA5/QQBSPI(5),QQBSYM(3) COMMON/JET/QQN,QQK(250,2),QQP(250,5),QQNC,QQKC(10),QQPC(10,4), * QQLASTN C--- IF(FSTEVT) THEN C---INITIALIZE QQ-CLEO CALL QQINIT(QQLERR) IF(QQLERR) CALL HWWARN('HWDEUR',500,*999) ENDIF C---CONSTRUCT THE HADRON FOR QQ-CLEO C NOTE: THE IDPDG CODE IS PROVIDED THROUGH THE QQLMAT ROUTINE C FROM THE CLEO PACKAGE (QQ-CLEO <--> IDPDG CODE TRANSFORMATION) QQN=1 IDHEP(IHEP)=IDPDG(IDHW(IHEP)) QQK(1,1)=0 QQK(1,2)=QQLMAT(IDHEP(IHEP),1) QQP(1,1)=PHEP(1,IHEP) QQP(1,2)=PHEP(2,IHEP) QQP(1,3)=PHEP(3,IHEP) QQP(1,5)=AMASS(QQK(1,2)) QQP(1,4)=SQRT(QQP(1,5)**2+QQP(1,1)**2+QQP(1,2)**2+QQP(1,3)**2) C---LET QQ-CLEO DO THE JOB QQNTRK=0 NVRTX=0 CALL DECADD(.FALSE.) C---UPDATE THE HERWIG TABLE : LOOP OVER QQN-CLEO FINAL PARTICLES DO 40 IIHEP=1,QQN NHEP=NHEP+1 ISTHEP(NHEP)=198 IF(ITYPEV(IIHEP,2).GE.0) ISTHEP(NHEP)=1 IDHEP(NHEP)=QQLMAT(ITYPEV(IIHEP,1),2) CALL HWUIDT(1,IDHEP(NHEP),IDHW(NHEP),NAME) IF(IIHEP.EQ.1) THEN ISTHEP(IHEP)=199 JDAHEP(1,IHEP)=NHEP JDAHEP(2,IHEP)=NHEP ISTHEP(NHEP)=199 NHEPHF=NHEP JMOHEP(1,NHEP)=IHEP JMOHEP(2,NHEP)=IHEP ELSE JMOHEP(1,NHEP)=IPRNTV(IIHEP)+NHEPHF-1 JMOHEP(2,NHEP)=NHEPHF ENDIF JDAHEP(1,NHEP)=0 JDAHEP(2,NHEP)=0 IF(NDAUTV(IIHEP).GT.0) THEN JDAHEP(1,NHEP)=IDAUTV(IIHEP)+NHEPHF-1 JDAHEP(2,NHEP)=JDAHEP(1,NHEP)+NDAUTV(IIHEP)-1 ENDIF PHEP(1,NHEP)=QQP(IIHEP,1) PHEP(2,NHEP)=QQP(IIHEP,2) PHEP(3,NHEP)=QQP(IIHEP,3) PHEP(4,NHEP)=QQP(IIHEP,4) PHEP(5,NHEP)=QQP(IIHEP,5) VHEP(1,NHEP)=XVTX(IVPROD(IIHEP),1) VHEP(2,NHEP)=XVTX(IVPROD(IIHEP),2) VHEP(3,NHEP)=XVTX(IVPROD(IIHEP),3) VHEP(4,NHEP)=0. 40 CONTINUE 999 END