From: morsch Date: Mon, 15 Jul 2002 17:07:47 +0000 (+0000) Subject: HERWIG fortran code to be used with THerwig and AliGenHerwig X-Git-Url: http://git.uio.no/git/?a=commitdiff_plain;h=d909f1695756fa851fdf9a82de7d6d9fb2d74bef;p=u%2Fmrichter%2FAliRoot.git HERWIG fortran code to be used with THerwig and AliGenHerwig --- diff --git a/HERWIG/HERWIG61.INC b/HERWIG/HERWIG61.INC new file mode 100644 index 00000000000..5d0e35681fe --- /dev/null +++ b/HERWIG/HERWIG61.INC @@ -0,0 +1,217 @@ +C ****COMMON BLOCK FILE FOR HERWIG VERSION 6.1**** +C +C ALTERATIONS: Layout completely overhauled for 5.9 +C +C +C New common blocks added for version 6.1: +C HWCLUS,HWSUSY,HWRPAR,HWMINB +C +C New variables added for version 6.1: +C OMHMIX,ET2MIX,PH3MIX,IOP4JT,NPRFMT, +C PRNDEF,PRNTEX,PRNWEB,EFFMIN,GCUTME, +C IOP4JT,NPRFMT see HWPRAM +C Y4JT,DURHAM see HWHARD +C QORQQB,QBORQQ see HWPROP +C NRECO see HWUCLU +C TXNAME see HWUNAM +C PPCL,NCL,IDCL see HWCLUS +C TANB,ALPHAH,COSBPA,SINBPA,COSBMA, +C SINBMA,COSA,SINA,COSB,SINB,COTB, +C ZMIXSS,ZMXNSS,ZSGNSS,LFCH,RFCH, +C SLFCH,SRFCH,WMXUSS,WMXVSS,WSGNSS, +C QMIXSS,LMIXSS,THETAT,THETAB,THETAL, +C ATSS,ABSS,ALSS,MUSS,FACTSS,GHWWSS, +C GHZZSS,GHDDSS,GHUUSS,GHWHSS,GHSQSS, +C XLMNSS,RMMNSS,IMSSM,SENHNC, +C SSPARITY,SUSYIN see HWSUSY +C LAMDA1,LAMDA2,LAMDA3,HRDCOL,RPARTY, +C COLUPD see HWRPAR +C PMBN1,PMBN2,PMBN3,PMBK1,PMBK2, +C PMBM1,PMBM2,PMBP1,PMBP2,PMBP3 see HWMINB +C +C New parameters added for version 6.1: +C NMXCL +C +C Parameter NMXRES raised to 500 +C +C Scalar variables changed to arrays of size 2: +C CLSMR,PSPLT,CLDIR see HWPRAM +C + IMPLICIT NONE + DOUBLE PRECISION ZERO,ONE,TWO,THREE,FOUR,HALF + PARAMETER (ZERO =0.D0, ONE =1.D0, TWO =2.D0, + & THREE=3.D0, FOUR=4.D0, HALF=0.5D0) +C + DOUBLE PRECISION + & ACCUR,AFCH,ALPFAC,ALPHEM,ANOMSC,ASFIXD,AVWGT,B1LIM,BETAF,BRFRAC, + & BRHIG,BTCLM,CAFAC,CFFAC,CLDKWT,CLMAX,CLPOW,CLQ,CLSMR,CMMOM,COSS, + & COSTH,CSPEED,CTHRPW,CTMAX,DECPAR,DECWT,DISF,DKLTM,EBEAM1,EBEAM2, + & EMLST,EMMAX,EMMIN,EMPOW,EMSCA,ENHANC,ENSOF,EPOLN,ETAMIX,EVWGT, + & EXAG,F0MIX,F1MIX,F2MIX,GAMH,GAMMAX,GAMW,GAMWT,GAMZ,GAMZP,GCOEF, + & GEV2NB,GEV2MM,GPOLN,H1MIX,HBAR,HARDST,OMEGA0,PBEAM1,PBEAM2,PDIQK, + & PGSMX,PGSPL,PHEP,PHIMIX,PHIPAR,PHOMAS,PIFAC,PLTCUT,PPAR,PPOLN, + & PRECO,PRSOF,PSPLT,PTINT,PTMAX,PTMIN,PTPOW,PTRMS,PXRMS,PWT,Q2MAX, + & Q2MIN,Q2POW,Q2WWMN,Q2WWMX,QCDL3,QCDL5,QCDLAM,QDIQK,QEV,QFCH,QG, + & QLIM,QSPAC,QV,QWT,REPWT,RESN,RHOHEP,RHOPAR,RLTIM,RMASS,RMIN, + & RSPIN,SCABI,SINS,SNGWT,SWEIN,SWTEF,SUD,THMAX,TLOUT,TMTOP,TMNISR, + & TQWT,VCKM,VFCH,VGCUT,VHEP,VMIN2,VPAR,VPCUT,VQCUT,VTXPIP,VTXQDK, + & WBIGST,WGTMAX,WGTSUM,WHMIN,WSQSUM,XFACT,XLMIN,XMIX,XMRCT,XX, + & XXMIN,YBMAX,YBMIN,YJMAX,YJMIN,YMIX,YMRCT,YWWMAX,YWWMIN,ZBINM, + & ZJMAX,ZMXISR,Y4JT,EFFMIN,PPCL, + & TANB,ALPHAH,COSBPA,SINBPA,COSBMA,SINBMA,COSA,SINA,COSB,SINB,COTB, + & ZMIXSS,ZMXNSS,ZSGNSS,LFCH,RFCH,SLFCH,SRFCH, WMXUSS,WMXVSS,WSGNSS, + & QMIXSS,LMIXSS,THETAT,THETAB,THETAL,ATSS,ABSS,ALSS,MUSS,FACTSS, + & GHWWSS,GHZZSS,GHDDSS,GHUUSS,GHWHSS,GHSQSS, + & XLMNSS,RMMNSS,IMSSM,SENHNC,SSPARITY,LAMDA1,LAMDA2,LAMDA3, + & PMBN1,PMBN2,PMBN3,PMBK1,PMBK2,PMBM1,PMBM2,PMBP1,PMBP2,PMBP3, + & OMHMIX,ET2MIX,PH3MIX,GCUTME +C + INTEGER + & CLDIR,IAPHIG,IBRN,IBSH,ICHRG,ICO,IDCMF,IDHEP,IDHW,IDK,IDKPRD,IDN, + & IDPAR,IDPDG,IERROR,IFLAV,IFLMAX,IFLMIN,IHPRO,IMQDK,INHAD,INTER, + & IOPDKL,IOPHIG,IOPREM,IPART1,IPART2,IPRINT,IPRO,IPROC,ISLENT, + & ISPAC,ISTAT,ISTHEP,ISTPAR,JCOPAR,JDAHEP,JDAPAR,JMOHEP,JMOPAR, + & JNHAD,LNEXT,LOCN,LOCQ,LRSUD,LSTRT,LWEVT,LWSUD,MAPQ,MAXER,MAXEV, + & MAXFL,MAXPR,MODBOS,MODMAX,MODPDF,NBTRY,NCLDK,NCOLO,NCTRY,NDKYS, + & NDTRY,NETRY,NEVHEP,NEVPAR,NFLAV,NGSPL,NHEP,NME,NMODES,NMXCDK, + & NMXDKS,NMXHEP,NMXJET,NMXMOD,NMXPAR,NMXQDK,NMXRES,NMXSUD,NPAR, + & NPRODS,NQDK,NQEV,NRES,NRN,NSPAC,NSTRU,NSTRY,NSUD,NUMER,NUMERU, + & NWGTS,NZBIN,SUDORD,IOP4JT,HRDCOL,NMXCL,NCL,IDCL,NPRFMT,NRECO +C + LOGICAL + & AZSOFT,AZSPIN,BGSHAT,BREIT,CLRECO,COLISR,DKPSET,FROST,FSTEVT, + & FSTWGT,GENEV,GENSOF,HARDME,HVFCEN,MAXDKL,MIXING,NOSPAC,NOWGT, + & PRNDEC,PIPSMR,PRVTX,RSTAB,SOFTME,TMPAR,TPOL,USECMF,VTOCDK,VTORDK, + & ZPRIME,RPARTY,COLUPD,PRNDEF,PRNTEX,PRNWEB,DURHAM,SUSYIN, + & QORQQB,QBORQQ +C + CHARACTER*4 + & BDECAY + CHARACTER*8 + & PART1,PART2,RNAME + CHARACTER*20 + & AUTPDF + CHARACTER*37 + & TXNAME +C +C New standard event common + PARAMETER (NMXHEP=2000) + COMMON/HEPEVT/NEVHEP,NHEP,ISTHEP(NMXHEP),IDHEP(NMXHEP), + & JMOHEP(2,NMXHEP),JDAHEP(2,NMXHEP),PHEP(5,NMXHEP),VHEP(4,NMXHEP) +C +C Beams, process and number of events + COMMON/HWBEAM/IPART1,IPART2 + COMMON/HWBMCH/PART1,PART2 + COMMON/HWPROC/EBEAM1,EBEAM2,PBEAM1,PBEAM2,IPROC,MAXEV +C +C Basic parameters (and quantities derived from them) + COMMON/HWPRAM/AFCH(16,2),ALPHEM,B1LIM,BETAF,BTCLM,CAFAC,CFFAC, + & CLMAX,CLPOW,CLSMR(2),CSPEED,ENSOF,ETAMIX,F0MIX,F1MIX,F2MIX,GAMH, + & GAMW,GAMZ,GAMZP,GEV2NB,H1MIX,PDIQK,PGSMX,PGSPL(4),PHIMIX,PIFAC, + & PRSOF,PSPLT(2),PTRMS,PXRMS,QCDL3,QCDL5,QCDLAM,QDIQK,QFCH(16),QG, + & QSPAC,QV,SCABI,SWEIN,TMTOP,VFCH(16,2),VCKM(3,3),VGCUT,VQCUT, + & VPCUT,ZBINM,EFFMIN,OMHMIX,ET2MIX,PH3MIX,GCUTME, + & IOPREM,IPRINT,ISPAC,LRSUD,LWSUD,MODPDF(2),NBTRY,NCOLO,NCTRY, + & NDTRY,NETRY,NFLAV,NGSPL,NSTRU,NSTRY,NZBIN,IOP4JT(2),NPRFMT, + & AZSOFT,AZSPIN,CLDIR(2),HARDME,NOSPAC,PRNDEC,PRVTX,SOFTME,ZPRIME, + & PRNDEF,PRNTEX,PRNWEB +C + COMMON/HWPRCH/AUTPDF(2),BDECAY +C +C Parton shower common (same format as /HEPEVT/) + PARAMETER (NMXPAR=500) + COMMON/HWPART/NEVPAR,NPAR,ISTPAR(NMXPAR),IDPAR(NMXPAR), + & JMOPAR(2,NMXPAR),JDAPAR(2,NMXPAR),PPAR(5,NMXPAR),VPAR(4,NMXPAR) +C +C Parton polarization common + COMMON/HWPARP/DECPAR(2,NMXPAR),PHIPAR(2,NMXPAR),RHOPAR(2,NMXPAR), + & TMPAR(NMXPAR) +C +C Electroweak boson common + PARAMETER (MODMAX=5) + COMMON/HWBOSC/ALPFAC,BRHIG(12),ENHANC(12),GAMMAX,RHOHEP(3,NMXHEP), + & IOPHIG,MODBOS(MODMAX) +C +C Parton colour common + COMMON/HWPARC/JCOPAR(4,NMXPAR) +C +C other HERWIG branching, event and hard subprocess common blocks + COMMON/HWBRCH/ANOMSC(2,2),HARDST,PTINT(3,2),XFACT,INHAD,JNHAD, + & NSPAC(7),ISLENT,BREIT,FROST,USECMF +C + COMMON/HWEVNT/AVWGT,EVWGT,GAMWT,TLOUT,WBIGST,WGTMAX,WGTSUM,WSQSUM, + & IDHW(NMXHEP),IERROR,ISTAT,LWEVT,MAXER,MAXPR,NOWGT,NRN(2),NUMER, + & NUMERU,NWGTS,GENSOF +C + COMMON/HWHARD/ASFIXD,CLQ(7,6),COSS,COSTH,CTMAX,DISF(13,2),EMLST, + & EMMAX,EMMIN,EMPOW,EMSCA,EPOLN(3),GCOEF(7),GPOLN,OMEGA0,PHOMAS, + & PPOLN(3),PTMAX,PTMIN,PTPOW,Q2MAX,Q2MIN,Q2POW,Q2WWMN,Q2WWMX,QLIM, + & SINS,THMAX,Y4JT,TMNISR,TQWT,XX(2),XLMIN,XXMIN,YBMAX,YBMIN,YJMAX, + & YJMIN,YWWMAX,YWWMIN,WHMIN,ZJMAX,ZMXISR,IAPHIG,IBRN(2),IBSH, + & ICO(10),IDCMF,IDN(10),IFLMAX,IFLMIN,IHPRO,IPRO,MAPQ(6),MAXFL, + & BGSHAT,COLISR,FSTEVT,FSTWGT,GENEV,HVFCEN,TPOL,DURHAM +C +C Arrays for particle properties (NMXRES = max no of particles defined) + PARAMETER(NMXRES=500) + COMMON/HWPROP/RLTIM(0:NMXRES),RMASS(0:NMXRES),RSPIN(0:NMXRES), + & ICHRG(0:NMXRES),IDPDG(0:NMXRES),IFLAV(0:NMXRES),NRES, + & VTOCDK(0:NMXRES),VTORDK(0:NMXRES), + & QORQQB(0:NMXRES),QBORQQ(0:NMXRES) +C + COMMON/HWUNAM/RNAME(0:NMXRES),TXNAME(2,0:NMXRES) +C +C Arrays for particle decays (NMXDKS = max total no of decays, +C NMXMOD = max no of modes for a particle) + PARAMETER(NMXDKS=4000,NMXMOD=200) + COMMON/HWUPDT/BRFRAC(NMXDKS),CMMOM(NMXDKS),DKLTM(NMXRES), + & IDK(NMXDKS),IDKPRD(5,NMXDKS),LNEXT(NMXDKS),LSTRT(NMXRES),NDKYS, + & NME(NMXDKS),NMODES(NMXRES),NPRODS(NMXDKS),DKPSET,RSTAB(0:NMXRES) +C +C Weights used in cluster decays + COMMON/HWUWTS/REPWT(0:3,0:4,0:4),SNGWT,DECWT,QWT(3),PWT(12), + & SWTEF(NMXRES) +C +C Parameters for cluster decays (NMXCDK = max total no of cluster +C decay channels) + PARAMETER(NMXCDK=4000) + COMMON/HWUCLU/CLDKWT(NMXCDK),CTHRPW(12,12),PRECO,RESN(12,12), + & RMIN(12,12),LOCN(12,12),NCLDK(NMXCDK),NRECO,CLRECO +C +C Variables controling mixing and vertex information + COMMON/HWDIST/EXAG,GEV2MM,HBAR,PLTCUT,VMIN2,VTXPIP(4),XMIX(2), + & XMRCT(2),YMIX(2),YMRCT(2),IOPDKL,MAXDKL,MIXING,PIPSMR +C +C Arrays for temporarily storing heavy-b,c-hadrons decaying partonicaly +C (NMXQDK = max no such decays in an event) + PARAMETER (NMXQDK=20) + COMMON/HWQDKS/VTXQDK(4,NMXQDK),IMQDK(NMXQDK),LOCQ(NMXQDK),NQDK +C +C Parameters for Sudakov form factors +C (NMXSUD= max no of entries in lookup table) + PARAMETER (NMXSUD=1024) + COMMON/HWUSUD/ACCUR,QEV(NMXSUD,6),SUD(NMXSUD,6),INTER,NQEV,NSUD, + & SUDORD +C + PARAMETER (NMXJET=200) +C +C SUSY parameters + COMMON/HWSUSY/ + & TANB,ALPHAH,COSBPA,SINBPA,COSBMA,SINBMA,COSA,SINA,COSB,SINB,COTB, + & ZMIXSS(4,4),ZMXNSS(4,4),ZSGNSS(4), LFCH(16),RFCH(16), + & SLFCH(16,4),SRFCH(16,4), WMXUSS(2,2),WMXVSS(2,2), WSGNSS(2), + & QMIXSS(6,2,2),LMIXSS(6,2,2), + & THETAT,THETAB,THETAL,ATSS,ABSS,ALSS,MUSS,FACTSS, + & GHWWSS(3),GHZZSS(3),GHDDSS(4),GHUUSS(4),GHWHSS(3), + & GHSQSS(4,6,2,2),XLMNSS,RMMNSS,IMSSM,SENHNC(24),SSPARITY,SUSYIN +C +C R-Parity violating parameters and colours + COMMON /HWRPAR/ LAMDA1(3,3,3),LAMDA2(3,3,3), + & LAMDA3(3,3,3),HRDCOL(2,5),RPARTY,COLUPD +C +C Parameters for minimum bias/soft underlying event + COMMON/HWMINB/ + & PMBN1,PMBN2,PMBN3,PMBK1,PMBK2,PMBM1,PMBM2,PMBP1,PMBP2,PMBP3 +C +C Cluster common used by soft event routines + PARAMETER (NMXCL=500) + COMMON/HWCLUS/PPCL(5,NMXCL),IDCL(NMXCL),NCL diff --git a/HERWIG/HERWIG6100.f b/HERWIG/HERWIG6100.f new file mode 100644 index 00000000000..cdcd8051c58 --- /dev/null +++ b/HERWIG/HERWIG6100.f @@ -0,0 +1,31811 @@ +C----------------------------------------------------------------------- +C H E R W I G +C +C a Monte Carlo event generator for simulating +C +---------------------------------------------------+ +C | Hadron Emission Reactions With Interfering Gluons | +C +---------------------------------------------------+ +C I.G. Knowles(*), G. Marchesini(+), M.H. Seymour($) and B.R. Webber(#) +C----------------------------------------------------------------------- +C with Minimal Supersymmetric Standard Model Matrix Elements by +C S. Moretti($) and K. Odagiri($) +C----------------------------------------------------------------------- +C R parity violating Supersymmetric Decays and Matrix Elements by +C P. Richardson(&) +C----------------------------------------------------------------------- +C matrix element corrections to top decay and Drell-Yan type processes +C by G. Corcella(+) +C----------------------------------------------------------------------- +C Deep Inelastic Scattering and Heavy Flavour Electroproduction by +C G. Abbiendi(@) and L. Stanco(%) +C----------------------------------------------------------------------- +C and Jet Photoproduction in Lepton-Hadron Collisions by J. Chyla(~) +C----------------------------------------------------------------------- +C(*) Department of Physics & Astronomy, University of Edinburgh +C(+) Dipartimento di Fisica, Universita di Milano +C($) Rutherford Appleton Laboratory +C(#) Cavendish Laboratory, Cambridge +C(&) Department of Physics, University of Oxford +C(@) Dipartimento di Fisica, Universita di Bologna +C(%) Dipartimento di Fisica, Universita di Padova +C(~) Institute of Physics, Prague +C----------------------------------------------------------------------- +C Version 6.100 - 16th December 1999 +C----------------------------------------------------------------------- +C Main reference: +C G.Marchesini, B.R.Webber, G.Abbiendi, I.G.Knowles, M.H.Seymour, +C and L.Stanco, Computer Physics Communications 67 (1992) 465. +C----------------------------------------------------------------------- +C Please send e-mail about this program to one of the authors at the +C following Internet addresses: +C I.Knowles@ed.ac.uk Giuseppe.Marchesini@mi.infn.it +C M.Seymour@rl.ac.uk webber@hep.phy.cam.ac.uk +C----------------------------------------------------------------------- +CDECK ID>, DECADD. +*CMZ :- -28/01/92 12.34.44 by Mike Seymour +*-- Author : Luca Stanco +C----------------------------------------------------------------------- + SUBROUTINE DECADD(LOGI) +C----------------------------------------------------------------------- +C DUMMY SUBROUTINE: DELETE AND SET BDECAY='CLEO' +C IN MAIN PROGRAM IF YOU USE CLEO DECAY PACKAGE +C----------------------------------------------------------------------- + LOGICAL LOGI + WRITE (6,10) + 10 FORMAT(/10X,'DECADD CALLED BUT NOT LINKED') + STOP + END +CDECK ID>, EUDINI. +*CMZ :- -28/01/92 12.34.44 by Mike Seymour +*-- Author : Luca Stanco +C----------------------------------------------------------------------- + SUBROUTINE EUDINI +C----------------------------------------------------------------------- +C DUMMY SUBROUTINE: DELETE AND SET BDECAY='EURO' +C IN MAIN PROGRAM IF YOU USE EURODEC DECAY PACKAGE +C----------------------------------------------------------------------- + WRITE (6,10) + 10 FORMAT(/10X,'EUDINI CALLED BUT NOT LINKED') + STOP + END +CDECK ID>, FRAGMT. +*CMZ :- -28/01/92 12.34.44 by Mike Seymour +*-- Author : Luca Stanco +C----------------------------------------------------------------------- + SUBROUTINE FRAGMT(I,J,K) +C----------------------------------------------------------------------- +C DUMMY SUBROUTINE: DELETE AND SET BDECAY='EURO' +C IN MAIN PROGRAM IF YOU USE EURODEC DECAY PACKAGE +C----------------------------------------------------------------------- + INTEGER I,J,K + WRITE (6,10) + 10 FORMAT(/10X,'FRAGMT CALLED BUT NOT LINKED') + STOP + END +CDECK ID>, HVCBVI. +*CMZ :- -28/01/92 12.34.44 by Mike Seymour +*-- Author : Mike Seymour +C----------------------------------------------------------------------- + SUBROUTINE HVCBVI +C----------------------------------------------------------------------- +C DUMMY ROUTINE: DELETE IF YOU LINK TO BARYON NUMBER VIOLATN PACKAGE +C----------------------------------------------------------------------- + WRITE (6,10) + 10 FORMAT(/10X,'HVCBVI CALLED BUT NOT LINKED') + STOP + END +CDECK ID>, HVHBVI. +*CMZ :- -28/01/92 12.34.44 by Mike Seymour +*-- Author : Mike Seymour +C----------------------------------------------------------------------- + SUBROUTINE HVHBVI +C----------------------------------------------------------------------- +C DUMMY ROUTINE: DELETE IF YOU LINK TO BARYON NUMBER VIOLATN PACKAGE +C----------------------------------------------------------------------- + WRITE (6,10) + 10 FORMAT(/10X,'HERBVI CALLED BUT NOT LINKED') + STOP + END +CDECK ID>, HWBAZF. +*CMZ :- -26/04/91 11.11.54 by Bryan Webber +*-- Author : Ian Knowles +C----------------------------------------------------------------------- + SUBROUTINE HWBAZF(IPAR,JPAR,VEC1,VEC2,VEC3,VEC) +C----------------------------------------------------------------------- +C Azimuthal correlation functions for Collins' algorithm, +C see I.G.Knowles, Comp. Phys. Comm. 58 (90) 271 for notation. +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + DOUBLE PRECISION Z1,Z2,DOT12,DOT23,DOT31,TR,FN(7),VEC1(2),VEC2(2), + & VEC3(2),VEC(2) + INTEGER IPAR,JPAR + LOGICAL GLUI,GLUJ + IF (.NOT.AZSPIN) RETURN + Z1=PPAR(4,JPAR)/PPAR(4,IPAR) + Z2=1.-Z1 + GLUI=IDPAR(IPAR).EQ.13 + GLUJ=IDPAR(JPAR).EQ.13 + IF (GLUI) THEN + IF (GLUJ) THEN +C Branching: g--->gg + FN(2)=Z2/Z1 + FN(3)=1./FN(2) + FN(4)=Z1*Z2 + FN(1)=FN(2)+FN(3)+FN(4) + FN(5)=FN(2)+2.*Z1 + FN(6)=FN(3)+2.*Z2 + FN(7)=FN(4)-2. + ELSE +C Branching: g--->qqbar + FN(1)=(Z1*Z1+Z2*Z2)/2. + FN(2)=0. + FN(3)=0. + FN(4)=-Z1*Z2 + FN(5)=-(2.*Z1-1.)/2. + FN(6)=-FN(5) + FN(7)=FN(1) + ENDIF + ELSE + IF (GLUJ) THEN +C Branching: q--->gq + FN(1)=(1.+Z2*Z2)/(2.*Z1) + FN(2)=Z2/Z1 + FN(3)=0. + FN(4)=0. + FN(5)=FN(1) + FN(6)=(1.+Z2)/2. + FN(7)=-FN(6) + ELSE +C Branching: q--->qg + FN(1)=(1.+Z1*Z1)/(2.*Z2) + FN(2)=0. + FN(3)=Z1/Z2 + FN(4)=0. + FN(5)=(1.+Z1)/2. + FN(6)=FN(1) + FN(7)=-FN(5) + ENDIF + ENDIF + DOT12=VEC1(1)*VEC2(1)+VEC1(2)*VEC2(2) + DOT23=VEC2(1)*VEC3(1)+VEC2(2)*VEC3(2) + DOT31=VEC3(1)*VEC1(1)+VEC3(2)*VEC1(2) + TR=1./(FN(1)+FN(2)*DOT23+FN(3)*DOT31+FN(4)*DOT12) + VEC(1)=((FN(2)+FN(5)*DOT23)*VEC1(1) + & +(FN(3)+FN(6)*DOT31)*VEC2(1) + & +(FN(4)+FN(7)*DOT12)*VEC3(1))*TR + VEC(2)=((FN(2)+FN(5)*DOT23)*VEC1(2) + & +(FN(3)+FN(6)*DOT31)*VEC2(2) + & +(FN(4)+FN(7)*DOT12)*VEC3(2))*TR + END +CDECK ID>, HWBCON. +*CMZ :- -26/04/91 10.18.56 by Bryan Webber +*-- Author : Bryan Webber +C----------------------------------------------------------------------- + SUBROUTINE HWBCON +C----------------------------------------------------------------------- +C MAKES COLOUR CONNECTIONS BETWEEN JETS +C MODIFIED 12/10/97 BY BRW FOR SUSY PROCESSES +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + INTEGER IHEP,IST,ID,JC,KC,JD,JHEP,LHEP,ID2 + IF (IERROR.NE.0) RETURN + IF(.NOT.RPARTY) THEN + CALL HWBRCN + RETURN + ENDIF + DO 20 IHEP=1,NHEP + IST=ISTHEP(IHEP) +C---LOOK FOR PARTONS WITHOUT COLOUR MOTHERS + IF (IST.LT.145.OR.IST.GT.152) GOTO 20 + IF (JMOHEP(2,IHEP).EQ.0) THEN +C---FIND COLOUR-CONNECTED PARTON + JC=JMOHEP(1,IHEP) + IF (IST.NE.152) JC=JMOHEP(1,JC) + JC =JMOHEP(2,JC) + IF (JC.EQ.0) CALL HWWARN('HWBCON',51,*20) +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 + JHEP=JMOHEP(2,JC) + IF (JHEP.EQ.0) GO TO 20 + ID=IDHW(JHEP) + IF (ISTHEP(JHEP).EQ.155) THEN +C---SPECIAL FOR GLUINO DECAYS + IF (ID.EQ.449) THEN + ID=IDHW(JC) +C---N.B. WILL NEED MODS WHEN SUSY PARTICLES CAN SHOWER + IF (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 5 + 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 5 + ENDDO + ENDIF +C---COULDNT FIND ONE + CALL HWWARN('HWBCON',101,*999) + 5 JC=KC + ELSE +C--PR MOD 30/6/99 should fix HWCFOR 104 errors + ID2 = IDHW(IHEP) + IF(IDHW(JDAHEP(1,JHEP)).EQ.449.AND. + & (ID2.LE.6.OR.(ID2.GE.115.AND.ID2.LE.120).OR. + & (ID2.GE.401.AND.ID2.LE.406).OR.ID2.EQ.13.OR. + & (ID2.GE.413.AND.ID2.LE.418).OR.ID2.EQ.449)) THEN + JC = JDAHEP(1,JHEP) + ELSE + JC=JDAHEP(2,JHEP) + ENDIF + ENDIF + ELSEIF (ID.EQ.6.OR.ID.EQ.12.OR. + & (ID.GE.209.AND.ID.LE.218).OR. + & (ID.GE.401.AND.ID.LE.424).OR.ID.EQ.449) THEN +C Wait for partner heavy quark to decay +C RETURN +C---N.B. MAY BE A PROBLEM HERE + GOTO 20 + ELSE + JMOHEP(2,IHEP)=JHEP + JDAHEP(2,JHEP)=IHEP + GOTO 20 + ENDIF + ELSE + JC=JMOHEP(2,JC) + ENDIF + ENDIF + JC=JDAHEP(1,JC) + JD=JDAHEP(2,JC) +C---SEARCH IN CORRESPONDING JET + IF (JD.LT.JC) JD=JC + LHEP=0 + DO 10 JHEP=JC,JD + IF (ISTHEP(JHEP).LT.145.OR.ISTHEP(JHEP).GT.152) GOTO 10 + IF (JDAHEP(2,JHEP).EQ.IHEP) LHEP=JHEP + IF (JDAHEP(2,JHEP).NE.0) GOTO 10 +C---JOIN IHEP AND JHEP + JMOHEP(2,IHEP)=JHEP + JDAHEP(2,JHEP)=IHEP + GOTO 20 + 10 CONTINUE + IF (LHEP.NE.0) THEN + JMOHEP(2,IHEP)=LHEP +C ELSE +C---DIDN'T FIND PARTNER OF IHEP YET +C CALL HWWARN('HWBCON',52,*20) + ENDIF + ENDIF + 20 CONTINUE +C---BREAK COLOUR CONNECTIONS WITH PHOTONS + IHEP=1 + 30 IF (IHEP.LE.NHEP) THEN + IF (IDHW(IHEP).EQ.59 .AND. ISTHEP(IHEP).EQ.149) THEN +C BRW FIX 13/03/99 + IF (JMOHEP(2,IHEP).NE.0) THEN + IF (JDAHEP(2,JMOHEP(2,IHEP)).EQ.IHEP) + & JDAHEP(2,JMOHEP(2,IHEP))=JDAHEP(2,IHEP) + ENDIF +C END FIX + IF (JDAHEP(2,IHEP).NE.0) THEN + IF (JMOHEP(2,JDAHEP(2,IHEP)).EQ.IHEP) + & JMOHEP(2,JDAHEP(2,IHEP))=JMOHEP(2,IHEP) + ENDIF + JMOHEP(2,IHEP)=IHEP + JDAHEP(2,IHEP)=IHEP + ENDIF + IHEP=IHEP+1 + GOTO 30 + ENDIF + 999 END +CDECK ID>, HWBDED. +*CMZ :- -22/04/96 13.54.08 by Mike Seymour +*-- Author : Mike Seymour +C----------------------------------------------------------------------- + SUBROUTINE HWBDED(IOPT) +C FILL MISSING AREA OF DALITZ PLOT WITH 3-JET AND 2-JET+GAMMA EVENTS +C IF (IOPT.EQ.1) SET UP EVENT RECORD +C IF (IOPT.EQ.2) CLEAN UP EVENT RECORD AFTER SHOWERING +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + DOUBLE PRECISION HWBVMC,HWR,HWUALF,HWUSQR,X(3),W,WMAX,WSUM, + & X1MIN,X1MAX,X2MIN,X2MAX,QSCALE,GAMFAC,GLUFAC,R(3,3),CS,SN,M(3), + & E(3),LAMBDA,A,B,C,PTSQ,EM,P1(5),P2(5),PVRT(4),EPS,MASDEP + INTEGER ID,ID3,EMIT,NOEMIT,IEVT,IHEP,JHEP,KHEP,ICMF,IOPT,IEDT(3), + & I,NDEL + EXTERNAL HWBVMC,HWR,HWUALF,HWUSQR + SAVE X,WMAX + DATA WSUM,WMAX,X1MIN,X1MAX,EMIT,ICMF,IEVT + & /0.994651,1.84096,0,0.773459,3*0/ + LAMBDA(A,B,C)=(A**2+B**2+C**2-2*A*B-2*B*C-2*C*A)/(4*A) + IF (IOPT.EQ.1) THEN +C---FIND AN UNTREATED CMF + IF (IEVT.EQ.NEVHEP+NWGTS) RETURN + IEVT=0 + ICMF=0 + DO 10 IHEP=1,NHEP + 10 IF (ICMF.EQ.0 .AND. ISTHEP(IHEP).EQ.110 .AND. + & JDAHEP(2,IHEP).EQ.JDAHEP(1,IHEP)+1) ICMF=IHEP + IF (ICMF.EQ.0) RETURN + EM=PHEP(5,ICMF) + IF (EM.LT.2*HWBVMC(1)) RETURN +C---GENERATE X1,X2 ACCORDING TO 1/((1-X1)*(1-X2)) + 100 CONTINUE +C---CHOOSE X1 + X(1)=1-(1-X1MAX)*((1-X1MIN)/(1-X1MAX))**HWR() +C---CHOOSE X2 + X2MIN=MAX(X(1),1-X(1)) + X2MAX=(4*X(1)-3+2*REAL( CMPLX( X(1)**3+135*(X(1)-1)**3, + & 3*HWUSQR(3*(128*X(1)**4-368*X(1)**3+405*X(1)**2-216*X(1)+54))* + & (X(1)-1) )**(1./3) ))/3 + IF (X2MAX.GE.ONE.OR.X2MIN.GE.ONE.OR.X2MAX.LE.X2MIN) GOTO 100 + X(2)=1-(1-X2MAX)*((1-X2MIN)/(1-X2MAX))**HWR() +C---CALCULATE WEIGHT + W=2 * LOG((1-X1MIN)/(1-X1MAX))*LOG((1-X2MIN)/(1-X2MAX)) * + & (X(1)**2+X(2)**2) +C---GENERATE UNWEIGHTED (X1,X2) PAIRS (EFFICIENCY IS ~50%) + IF (WMAX*HWR().GT.W) GOTO 100 +C---SYMMETRIZE X1,X2 + X(3)=2-X(1)-X(2) + IF (HWR().GT.HALF) THEN + X(1)=X(2) + X(2)=2-X(3)-X(1) + ENDIF +C---CHOOSE WHICH PARTON WILL EMIT + EMIT=1 + IF (HWR().LT.X(1)**2/(X(1)**2+X(2)**2)) EMIT=2 + NOEMIT=3-EMIT + IHEP=JDAHEP( EMIT,ICMF) + JHEP=JDAHEP(NOEMIT,ICMF) +C---PREFACTORS FOR GAMMA AND GLUON CASES + QSCALE=HWUSQR((1-X(1))*(1-X(2))*(1-X(3)))*EM/X(NOEMIT) + ID=IDHW(JDAHEP(1,ICMF)) + GAMFAC=ALPFAC*ALPHEM*ICHRG(ID)**2/(18*PIFAC) + GLUFAC=0 + IF (QSCALE.GT.HWBVMC(13)) + & GLUFAC=CFFAC/(2*PIFAC)*HWUALF(1,QSCALE) +C---IN FRACTION FAC*WSUM OF EVENTS ADD A GAMMA/GLUON + IF (GAMFAC*WSUM .GT. HWR()) THEN + ID3=59 + ELSEIF (GLUFAC*WSUM .GT. HWR()) THEN + ID3=13 + ELSE + EMIT=0 + RETURN + ENDIF +C---CHECK INFRA-RED CUT-OFF FOR GAMMA/GLUON + M(1)=HWBVMC(ID) + M(2)=HWBVMC(ID) + M(3)=HWBVMC(ID3) + E(1)=HALF*EM*(X(1)+(M(1)**2-M(2)**2-M(3)**2)/EM**2) + E(2)=HALF*EM*(X(2)+(M(2)**2-M(3)**2-M(1)**2)/EM**2) + E(3)=EM-E(1)-E(2) + PTSQ=-LAMBDA(E(NOEMIT)**2-M(NOEMIT)**2,E(3)**2-M(3)**2, + & E(EMIT)**2-M(EMIT)**2) + IF (PTSQ.LE.ZERO .OR. + $ E(1).LE.M(1).OR.E(2).LE.M(2).OR.E(3).LE.M(3)) THEN + EMIT=0 + RETURN + ENDIF +C---CALCULATE MASS-DEPENDENT SUPRESSION + IF (MOD(IPROC,10).GT.0) THEN + EPS=(RMASS(ID)/EM)**2 + MASDEP=X(1)**2+X(2)**2 + $ -4*EPS*X(3)-2*EPS*((1-X(2))/(1-X(1))+(1-X(1))/(1-X(2))) + $ -4*EPS**2*X(3)**2/((1-X(1))*(1-X(2))) + IF (MASDEP.LT.HWR()*(X(1)**2+X(2)**2)) THEN + EMIT=0 + RETURN + ENDIF + ENDIF +C---STORE OLD MOMENTA + CALL HWVEQU(5,PHEP(1,JDAHEP(1,ICMF)),P1) + CALL HWVEQU(5,PHEP(1,JDAHEP(2,ICMF)),P2) +C---GET THE NON-EMITTING PARTON'S CMF DIRECTION + CALL HWULOF(PHEP(1,ICMF),PHEP(1,JHEP),PHEP(1,JHEP)) + CALL HWRAZM(ONE,CS,SN) + CALL HWUROT(PHEP(1,JHEP),CS,SN,R) + M(1)=PHEP(5,IHEP) + M(2)=PHEP(5,JHEP) + M(3)=RMASS(ID3) +C---REORDER ENTRIES: IHEP=EMITTER, JHEP=NON-EMITTER, KHEP=EMITTED + NHEP=NHEP+1 + IF (IDHW(IHEP).LT.IDHW(JHEP)) THEN + IHEP=JDAHEP(1,ICMF) + JHEP=NHEP + ELSE + IHEP=NHEP + JHEP=JDAHEP(1,ICMF) + ENDIF + KHEP=JDAHEP(2,ICMF) +C---SET UP MOMENTA + PHEP(5,JHEP)=M(NOEMIT) + PHEP(5,IHEP)=M(EMIT) + PHEP(5,KHEP)=M(3) + PHEP(4,JHEP)=HALF*EM*(X(NOEMIT)+ + & (M(NOEMIT)**2-M(EMIT)**2-M(3)**2)/EM**2) + PHEP(4,IHEP)=HALF*EM*(X(EMIT)+ + & (M(EMIT)**2-M(NOEMIT)**2-M(3)**2)/EM**2) + PHEP(4,KHEP)=EM-PHEP(4,IHEP)-PHEP(4,JHEP) + PHEP(3,JHEP)=HWUSQR(PHEP(4,JHEP)**2-PHEP(5,JHEP)**2) + PHEP(3,IHEP)=( (PHEP(4,KHEP)**2-PHEP(5,KHEP)**2) - + & (PHEP(4,IHEP)**2-PHEP(5,IHEP)**2) - + & (PHEP(3,JHEP)**2) )*HALF/PHEP(3,JHEP) + PHEP(3,KHEP)=-PHEP(3,IHEP)-PHEP(3,JHEP) + PHEP(2,JHEP)=0 + PHEP(2,IHEP)=0 + PHEP(2,KHEP)=0 + PHEP(1,JHEP)=0 + PHEP(1,IHEP)=HWUSQR(PHEP(4,IHEP)**2- + & PHEP(3,IHEP)**2-PHEP(5,IHEP)**2) + PHEP(1,KHEP)=-PHEP(1,IHEP) +C---ORIENT IN CMF, THEN BOOST TO LAB + CALL HWUROB(R,PHEP(1,IHEP),PHEP(1,IHEP)) + CALL HWUROB(R,PHEP(1,JHEP),PHEP(1,JHEP)) + CALL HWUROB(R,PHEP(1,KHEP),PHEP(1,KHEP)) + CALL HWULOB(PHEP(1,ICMF),PHEP(1,IHEP),PHEP(1,IHEP)) + CALL HWULOB(PHEP(1,ICMF),PHEP(1,JHEP),PHEP(1,JHEP)) + CALL HWULOB(PHEP(1,ICMF),PHEP(1,KHEP),PHEP(1,KHEP)) +C---CALCULATE PRODUCTION VERTICES + CALL HWVZRO(4,VHEP(1,JHEP)) + CALL HWVSUM(4,PHEP(1,IHEP),PHEP(1,KHEP),PVRT) + CALL HWUDKL(ID,PVRT,VHEP(1,KHEP)) + CALL HWVEQU(4,VHEP(1,KHEP),VHEP(1,IHEP)) +C---REORDER ENTRIES: IHEP=QUARK, JHEP=ANTI-QUARK, KHEP=EMITTED + IF (IHEP.EQ.NHEP) THEN + IHEP=JHEP + JHEP=NHEP + ENDIF +C---STATUS, ID AND POINTERS + ISTHEP(JHEP)=114 + IDHW(JHEP)=IDHW(KHEP) + IDHEP(JHEP)=IDHEP(KHEP) + IDHW(KHEP)=ID3 + IDHEP(KHEP)=IDPDG(ID3) + JDAHEP(2,ICMF)=JHEP + JMOHEP(1,JHEP)=ICMF + JDAHEP(1,JHEP)=0 +C---COLOUR CONNECTIONS AND GLUON POLARIZATION + JMOHEP(2,JHEP)=IHEP + JDAHEP(2,IHEP)=JHEP + IF (ID3.EQ.13) THEN + JMOHEP(2,IHEP)=KHEP + JMOHEP(2,KHEP)=JHEP + JDAHEP(2,JHEP)=KHEP + JDAHEP(2,KHEP)=IHEP + GPOLN=((1-X(1))**2+(1-X(2))**2)/(4*(1-X(3))) + GPOLN=1/(1+GPOLN) + ELSE + JMOHEP(2,IHEP)=JHEP + JMOHEP(2,KHEP)=KHEP + JDAHEP(2,JHEP)=IHEP + JDAHEP(2,KHEP)=KHEP + ENDIF + IEVT=NEVHEP+NWGTS + ELSEIF (IOPT.EQ.2) THEN +C---MAKE THREE-JET EVENTS FROM THE `DEAD-ZONE' LOOK LIKE TWO-JET EVENTS + IF (EMIT.EQ.0.OR.IEVT.NE.NEVHEP+NWGTS) THEN + RETURN + ELSEIF (EMIT.EQ.1) THEN + IHEP=JDAHEP(1,JDAHEP(1,ICMF)+1) + JHEP=JDAHEP(1,JDAHEP(1,ICMF)) + ELSE + IHEP=JDAHEP(1,JDAHEP(2,ICMF)) + JHEP=JDAHEP(1,JDAHEP(1,ICMF)+1) + JDAHEP(1,JDAHEP(2,ICMF))=JHEP + IDHW(JHEP)=IDHW(IHEP) + IF (ISTHEP(IHEP+1).EQ.100 .AND. ISTHEP(JHEP+1).EQ.100) + & CALL HWVEQU(5,PHEP(1,IHEP+1),PHEP(1,JHEP+1)) + ENDIF + JMOHEP(2,JDAHEP(1,ICMF))=JDAHEP(2,ICMF) + JDAHEP(2,JDAHEP(1,ICMF))=JDAHEP(2,ICMF) + JMOHEP(2,JDAHEP(2,ICMF))=JDAHEP(1,ICMF) + JDAHEP(2,JDAHEP(2,ICMF))=JDAHEP(1,ICMF) + CALL HWVEQU(5,P1,PHEP(1,JDAHEP(1,ICMF))) + CALL HWVEQU(5,P2,PHEP(1,JDAHEP(2,ICMF))) + CALL HWVSUM(4,PHEP(1,IHEP),PHEP(1,JHEP),PHEP(1,JHEP)) + CALL HWUMAS(PHEP(1,JHEP)) + JDAHEP(2,JHEP)=JDAHEP(2,IHEP) + IEDT(1)=JDAHEP(1,ICMF)+1 + IEDT(2)=IHEP + IEDT(3)=IHEP+1 + NDEL=3 + IF (ISTHEP(IHEP+1).NE.100) NDEL=2 + CALL HWUEDT(NDEL,IEDT) + DO 410 I=1,2 + IHEP=JDAHEP(1,JDAHEP(I,ICMF)) + JMOHEP(1,IHEP)=JDAHEP(I,ICMF) + IF (ISTHEP(IHEP+1).EQ.100) THEN + JMOHEP(1,IHEP+1)=JMOHEP(1,IHEP) + JMOHEP(2,IHEP+1)=JMOHEP(2,JMOHEP(1,IHEP)) + ENDIF + DO 400 JHEP=JDAHEP(1,IHEP),JDAHEP(2,IHEP) + JMOHEP(1,JHEP)=IHEP + 400 CONTINUE + CALL HWVZRO(4,VHEP(1,JDAHEP(I,ICMF))) + CALL HWVZRO(4,VHEP(1,IHEP)) + IF (ISTHEP(IHEP+1).EQ.100) CALL HWVZRO(4,VHEP(1,IHEP+1)) + 410 CONTINUE + EMIT=0 + IEVT=0 + ELSE + CALL HWWARN('HWBDED',500,*999) + ENDIF + 999 END +CDECK ID>, HWBDIS. +*CMZ :- -17/05/94 09.33.08 by Mike Seymour +*-- Author : Mike Seymour +C----------------------------------------------------------------------- + SUBROUTINE HWBDIS(IOPT) +C----------------------------------------------------------------------- +C FILL MISSING AREA OF DIS PHASE-SPACE WITH 2+1-JET EVENTS +C IF (IOPT.EQ.1) SET UP EVENT RECORD +C IF (IOPT.EQ.2) CLEAN UP EVENT RECORD AFTER SHOWERING +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + DOUBLE PRECISION HWR,HWBVMC,HWUALF,HWULDO,P1(5),P2(5),P3(5), + & PCMF(5),L(5),R(3,3),Q,XBJ,RN,XPMIN,XPMAX,XP,ZPMIN,ZPMAX,ZP,FAC, + & X1,X2,XTSQ,XT,PTSQ,SIN1,SIN2,W1,W2,CFAC,PDFOLD(13),PDFNEW(13), + & PHI,SCALE,Q1(5),Q2(5),DIR1,DIR2,DIR,PM(5),POLD,PNEW,COMINT, + & BGFINT,COMWGT,C1,C2,CM,B1,B2,BM,PVRT(4) + INTEGER IOPT,EMIT,ICMF,IHEP,JHEP,IIN,IOUT,ILEP,IHAD,ID,IDNEW, + & IEDT(3),NDEL,NTRY,ITEMP + LOGICAL BGF + EXTERNAL HWR,HWBVMC,HWUALF,HWULDO + SAVE BGF,IIN,IOUT,ICMF,ID,Q1,Q2,XP,XBJ + DATA EMIT,COMINT,BGFINT,COMWGT/0,3.9827,1.2462,0.3/ + DATA C1,C2,CM,B1,B2,BM/0.56,0.20,10,0.667,0.167,3/ + IF (IERROR.NE.0) RETURN + IF (IOPT.EQ.1) THEN +C---FIND AN UNTREATED CMF + IF (EMIT.EQ.NEVHEP+NWGTS) RETURN + ICMF=0 + DO 10 IHEP=1,NHEP + 10 IF (ICMF.EQ.0 .AND. ISTHEP(IHEP).EQ.110 .AND. + & JDAHEP(2,IHEP).EQ.JDAHEP(1,IHEP)+1) ICMF=IHEP + IF (ICMF.EQ.0) RETURN + IIN=JMOHEP(2,ICMF) + IOUT=JDAHEP(2,ICMF) + ILEP=JMOHEP(1,ICMF) + CALL HWVEQU(5,PHEP(1,IIN),P1) + CALL HWVEQU(5,PHEP(1,IOUT),P2) + CALL HWVEQU(5,PHEP(1,ILEP),L) + IHAD=2 + IF (JDAHEP(1,IHAD).NE.0) IHAD=JDAHEP(1,IHAD) + ID=IDHW(IIN) +C---STORE OLD MOMENTA + CALL HWVEQU(5,P1,Q1) + CALL HWVEQU(5,P2,Q2) +C---BOOST AND ROTATE THE MOMENTA TO THE BREIT FRAME + CALL HWVDIF(4,P2,P1,PCMF) + CALL HWUMAS(PCMF) + CALL HWVEQU(5,PHEP(1,IHAD),PM) + Q=-PCMF(5) + XBJ=HALF*Q**2/HWULDO(PM,PCMF) + CALL HWVSCA(4,HALF/XBJ,PCMF,PCMF) + CALL HWVSUM(4,PM,PCMF,PCMF) + CALL HWUMAS(PCMF) + CALL HWULOF(PCMF,L,L) + CALL HWULOF(PCMF,PM,PM) + CALL HWUROT(PM,ONE,ZERO,R) + CALL HWUROF(R,L,L) + PHI=ATAN2(L(2),L(1)) + CALL HWUROT(PM,COS(PHI),SIN(PHI),R) +C---CHOOSE THE HADRONIC-PLANE CONFIGURATION, XP,ZP + IF (HWR().LT.COMWGT) THEN +C-----CONSIDER GENERATING A QCD COMPTON EVENT + BGF=.FALSE. + P3(5)=RMASS(13) + 100 RN=HWR() + IF (RN.LT.C1) THEN + ZP=HWR() + XPMAX=MIN(ZP,1-ZP) + XP=HWR()*XPMAX + FAC=1/C1*2*XPMAX/((1-XP)*(1-ZP))* + $ (1+(1-XP-ZP+2*XP*ZP)**2+2*(1-XP)*(1-ZP)*XP*ZP) + IF (HWR().LT.HALF) THEN + ZPMAX=ZP + ZP=XP + XP=ZPMAX + ENDIF + ELSEIF (RN.LT.C1+C2) THEN + XPMAX=0.83 + XP=XPMAX*HWR() + ZPMIN=MAX(XP,1-XP) + ZPMAX=1-2./3.*XP*(1+REAL( CMPLX(10-45*XP+18*XP**2,3*SQRT( + $ 3*(9+66*XP-93*XP**2+12*XP**3-8*XP**4+24*XP**5-8*XP**6))) + $ **(1./3.) * CMPLX(0.5,0.8660254) )) + ZP=1-((1-ZPMIN)/(1-ZPMAX))**HWR()*(1-ZPMAX) + FAC=1/C2*XPMAX*LOG((1-ZPMIN)/(1-ZPMAX))/(1-XP)* + $ (1+(1-XP-ZP+2*XP*ZP)**2+2*(1-XP)*(1-ZP)*XP*ZP) + ELSE + ZPMAX=0.85 + ZP=ZPMAX*HWR() + XPMIN=MAX(ZP,1-ZP) + XPMAX=(1+4*ZP*(1-ZP))/(1+6*ZP*(1-ZP)) + XP=1-((1-XPMIN)/(1-XPMAX))**HWR()*(1-XPMAX) + FAC=1/(1-C1-C2)*ZPMAX*LOG((1-XPMIN)/(1-XPMAX))/(1-ZP)* + $ (1+(1-XP-ZP+2*XP*ZP)**2+2*(1-XP)*(1-ZP)*XP*ZP) + ENDIF + XPMAX=(1+4*ZP*(1-ZP))/(1+6*ZP*(1-ZP)) + ZPMAX=1-2./3.*XP*(1+REAL( CMPLX(10-45*XP+18*XP**2,3*SQRT( + $ 3*(9+66*XP-93*XP**2+12*XP**3-8*XP**4+24*XP**5-8*XP**6))) + $ **(1./3.) * CMPLX(0.5,0.8660254) )) + IF (XP.GT.XPMAX.OR.ZP.GT.ZPMAX.OR.CM*HWR().GT.FAC) + $ GOTO 100 + ELSE +C-----CONSIDER GENERATING A BGF EVENT + BGF=.TRUE. + P3(5)=P1(5) + P1(5)=RMASS(13) + 110 RN=HWR() + IF (RN.LT.B1) THEN + ZP=HWR() + XPMAX=MIN(ZP,1-ZP) + XP=HWR()*XPMAX + FAC=1/B1*2*XPMAX/(1-ZP)* + $ (( XP+ZP-2*XP*ZP)**2+2*(1-XP)*(1-ZP)*XP*ZP + $ +(1-XP-ZP+2*XP*ZP)**2+2*(1-XP)*(1-ZP)*XP*ZP) + IF (HWR().LT.HALF) XP=1-XP + ELSEIF (RN.LT.B1+B2) THEN + XPMAX=0.83 + XP=XPMAX*HWR() + ZPMIN=MAX(XP,1-XP) + ZPMAX=1-2./3.*XP*(1+REAL( CMPLX(10-45*XP+18*XP**2,3*SQRT( + $ 3*(9+66*XP-93*XP**2+12*XP**3-8*XP**4+24*XP**5-8*XP**6))) + $ **(1./3.) * CMPLX(0.5,0.8660254) )) + ZP=1-((1-ZPMIN)/(1-ZPMAX))**HWR()*(1-ZPMAX) + FAC=1/B2*XPMAX*LOG((1-ZPMIN)/(1-ZPMAX))* + $ (( XP+ZP-2*XP*ZP)**2+2*(1-XP)*(1-ZP)*XP*ZP + $ +(1-XP-ZP+2*XP*ZP)**2+2*(1-XP)*(1-ZP)*XP*ZP) + ELSE + XPMAX=0.83 + XP=XPMAX*HWR() + ZPMAX=MIN(XP,1-XP) + ZPMIN=2./3.*XP*(1+REAL( CMPLX(10-45*XP+18*XP**2,3*SQRT( + $ 3*(9+66*XP-93*XP**2+12*XP**3-8*XP**4+24*XP**5-8*XP**6))) + $ **(1./3.) * CMPLX(0.5,0.8660254) )) + ZP=(ZPMAX-ZPMIN)*HWR()+ZPMIN + FAC=1/(1-B1-B2)*XPMAX*(ZPMAX-ZPMIN)/(1-ZP)* + $ (( XP+ZP-2*XP*ZP)**2+2*(1-XP)*(1-ZP)*XP*ZP + $ +(1-XP-ZP+2*XP*ZP)**2+2*(1-XP)*(1-ZP)*XP*ZP) + ENDIF + ZPMAX=1-2./3.*XP*(1+REAL( CMPLX(10-45*XP+18*XP**2,3*SQRT( + $ 3*(9+66*XP-93*XP**2+12*XP**3-8*XP**4+24*XP**5-8*XP**6))) + $ **(1./3.) * CMPLX(0.5,0.8660254) )) + IF (ZP.GT.ZPMAX.OR.ZP.LT.ONE-ZPMAX.OR.BM*HWR().GT.FAC) + $ GOTO 110 + ENDIF +C---CALCULATE THE ADDITIONAL FACTORS IN THE WEIGHT + IF (BGF) THEN + IDNEW=13 + CFAC=1./2 + FAC=BGFINT/(1-COMWGT) + ELSE + IDNEW=ID + CFAC=4./3 + FAC=COMINT/COMWGT + ENDIF + SCALE=Q*SQRT((1-XP)*(1-ZP)*ZP/XP+1) + ITEMP=ISTAT + ISTAT=7 + CALL HWSFUN(XBJ,Q,IDHW(IHAD),NSTRU,PDFOLD,2) + ISTAT=ITEMP + IF (PDFOLD(ID).LE.ZERO) CALL HWWARN('HWBDIS',100,*999) + IF (XP.GT.XBJ) THEN + CALL HWSFUN(XBJ/XP,SCALE,IDHW(IHAD),NSTRU,PDFNEW,2) + FAC=CFAC/(2*PIFAC) * HWUALF(1,SCALE) * FAC * + $ PDFNEW(IDNEW)/PDFOLD(ID) + ELSE + FAC=0 + ENDIF +C---FOR PHOTON BEAMS, INCLUDE DIRECT PHOTON COUPLING + IF (IDHW(IHAD).EQ.59) THEN + ZPMIN=2./3.*XBJ*(1+REAL( CMPLX(10-45*XBJ+18*XBJ**2,3*SQRT( + $ 3*(9+66*XBJ-93*XBJ**2+12*XBJ**3-8*XBJ**4+24*XBJ**5 + $ -8*XBJ**6)))**(1./3.) * CMPLX(0.5,0.8660254) )) + ZPMAX=1-ZPMIN + DIR1=(XBJ**2+(1-XBJ)**2)*(LOG(ZPMAX/ZPMIN)-(ZPMAX-ZPMIN)) + DIR2=4*XBJ*(1-XBJ)*(ZPMAX-ZPMIN) + DIR=QFCH(MOD(ID-1,6)+1)**2*ALPHEM/(2*PIFAC*PDFOLD(ID))*XBJ + $ *(DIR1+DIR2) + ELSE + DIR=0 + ENDIF +C---DECIDE WHETHER TO MAKE AN EVENT HERE + IF (HWR().GT.FAC+DIR) RETURN +C---FOR DIRECT COUPLING, CHOOSE ZP VALUE + IF ((FAC+DIR)*HWR().GT.FAC) THEN + IF ((DIR1+DIR2)*HWR().LT.DIR1) THEN + NTRY=0 + 120 NTRY=NTRY+2 + ZP=1-(ZPMAX/ZPMIN)**HWR()*ZPMIN + IF ((ZPMIN**2+(1-ZPMIN)**2)*HWR().GT.ZP**2+(1-ZP)**2) + $ GOTO 120 + ELSE + ZP=SQRT((ZPMAX-ZPMIN)*HWR()+ZPMIN**2) + ENDIF + XP=XBJ + BGF=.TRUE. + P3(5)=P2(5) + P1(5)=0 + ENDIF + X1=1- ZP /XP + X2=1-(1-ZP)/XP + XTSQ=4*(1-XP)*(1-ZP)*ZP/XP + XT=SQRT(XTSQ) + SIN1=XT/SQRT(X1**2+XTSQ) + SIN2=XT/SQRT(X2**2+XTSQ) +C---CHOOSE THE AZIMUTH BETWEEN THE TWO PLANES + IF (BGF) THEN + W1=XP**2*(X1**2+1.5*XTSQ) + ELSE + W1=1 + ENDIF + W2=XP**2*(X2**2+1.5*XTSQ) + IF (HWR()*(W1+W2).GT.W2) THEN + IF (BGF) THEN +C-----WEIGHTED BY (1+SIN1*COS(PHI))**2 + 200 PHI=(2*HWR()-1)*PIFAC + IF (HWR()*(1+SIN1)**2.GT.(1+SIN1*COS(PHI))**2) GOTO 200 + ELSE +C-----UNIFORMLY + PHI=(2*HWR()-1)*PIFAC + ENDIF + ELSE +C-----WEIGHTED BY (1-SIN2*COS(PHI))**2 + 210 PHI=(2*HWR()-1)*PIFAC + IF (HWR()*(1+SIN2)**2.GT.(1-SIN2*COS(PHI))**2) GOTO 210 + ENDIF +C---RECONSTRUCT MOMENTA AND BOOST BACK TO LAB + P1(1)=0 + P1(2)=0 + P1(3)=HALF*Q/XP + P1(4)=SQRT(P1(3)**2+P1(5)**2) + PTSQ=((ZP*Q*(P1(4)+P1(3)-Q)-P2(5)**2)*(P1(4)-P1(3)+(1-ZP)*Q) + $ -P3(5)**2*ZP*Q)/(P1(4)-P1(3)+Q) +C---CHECK INFRARED CUTOFF FOR THIS PARTON TYPE + IF (PTSQ.LT.MAX(HWBVMC(ID),HWBVMC(IDHW(IOUT)))**2) RETURN + P2(1)=SQRT(PTSQ)*COS(PHI) + P2(2)=SQRT(PTSQ)*SIN(PHI) + P2(3)=-0.5*(ZP*Q-(PTSQ+P2(5)**2)/(ZP*Q)) + P2(4)= 0.5*(ZP*Q+(PTSQ+P2(5)**2)/(ZP*Q)) + P3(1)=P1(1)-P2(1) + P3(2)=P1(2)-P2(2) + P3(3)=P1(3)-P2(3)-Q + P3(4)=P1(4)-P2(4) + CALL HWUROB(R,P1,P1) + CALL HWUROB(R,P2,P2) + CALL HWUROB(R,P3,P3) + CALL HWULOB(PCMF,P1,P1) + CALL HWULOB(PCMF,P2,P2) + CALL HWULOB(PCMF,P3,P3) +C---SPECIAL CASE FOR DIRECT PHOTON - COPY THE EXACT BEAM MOMENTUM +C---SHARE THE MISMATCH EQUALLY BETWEEN THE OUTGOING PARTONS +C---AND PUT THEM BACK ON SHELL + IF (XP.EQ.XBJ) THEN + CALL HWVDIF(4,PHEP(1,IHAD),P1,PM) + CALL HWVSCA(4,HALF,PM,PM) + CALL HWVSUM(4,PM,P2,P2) + CALL HWVSUM(4,PM,P3,P3) + CALL HWUMAS(P2) + CALL HWUMAS(P3) + CALL HWVEQU(5,PHEP(1,IHAD),P1) + CALL HWVSUM(4,P2,P3,PCMF) + CALL HWUMAS(PCMF) + POLD=HWULDO(P2,PCMF)**2/PCMF(5)**2-SIGN(P2(5)**2,P2(5)) + PNEW=PCMF(5)**2/4-RMASS(ID)**2 + IF (PCMF(5).LE.ZERO.OR.POLD.LE.ZERO.OR.PNEW.LE.ZERO) RETURN + CALL HWVSCA(4,SQRT(PNEW/POLD),P2,P2) + CALL HWVSCA(4,HALF-HWULDO(P2,PCMF)/PCMF(5)**2,PCMF,PM) + CALL HWVSUM(4,PM,P2,P2) + CALL HWUMAS(P2) + CALL HWVDIF(4,PCMF,P2,P3) + CALL HWUMAS(P3) + ENDIF + NHEP=NHEP+1 + CALL HWVEQU(5,P1,PHEP(1,IIN)) + IF (BGF.AND.ID.GT.6.OR..NOT.BGF.AND.ID.LT.7) THEN + CALL HWVEQU(5,P2,PHEP(1,IOUT)) + CALL HWVEQU(5,P3,PHEP(1,NHEP)) + ELSE + CALL HWVEQU(5,P3,PHEP(1,IOUT)) + CALL HWVEQU(5,P2,PHEP(1,NHEP)) + ENDIF + CALL HWVSUM(4,PHEP(1,ILEP),PHEP(1,IIN),PHEP(1,ICMF)) + CALL HWUMAS(PHEP(1,ICMF)) +C Decide which quark radiated and assign production vertices + IF (BGF) THEN +C Boson-Gluon fusion case + IF (1-ZP.LT.HWR()) THEN +C Gluon splitting to quark + CALL HWVZRO(4,VHEP(1,NHEP-1)) + CALL HWVDIF(4,PHEP(1,NHEP-4),PHEP(1,NHEP),PVRT) + CALL HWUDKL(ID,PVRT,VHEP(1,NHEP)) + CALL HWVEQU(4,VHEP(1,NHEP),VHEP(1,NHEP-4)) + ELSE +C Gluon splitting to antiquark + CALL HWVZRO(4,VHEP(1,NHEP)) + CALL HWVDIF(4,PHEP(1,NHEP-4),PHEP(1,NHEP-1),PVRT) + CALL HWUDKL(ID,PVRT,VHEP(1,NHEP-1)) + CALL HWVEQU(4,VHEP(1,NHEP-1),VHEP(1,NHEP-4)) + ENDIF + ELSE +C QCD Compton case + IF (1.LT.HWR()*(1+(1-XP-ZP)**2+6*XP*(1-XP)*ZP*(1-ZP)))THEN +C Incoming quark radiated the gluon + CALL HWVZRO(4,VHEP(1,NHEP-1)) + CALL HWVDIF(4,PHEP(1,NHEP-4),PHEP(1,NHEP),PVRT) + CALL HWUDKL(ID,PVRT,VHEP(1,NHEP)) + CALL HWVEQU(4,VHEP(1,NHEP),VHEP(1,NHEP-4)) + ELSE +C Outgoing quark radiated the gluon + CALL HWVZRO(4,VHEP(1,NHEP-4)) + CALL HWVSUM(4,PHEP(1,NHEP-1),PHEP(1,NHEP),PVRT) + CALL HWUDKL(ID,PVRT,VHEP(1,NHEP)) + CALL HWVEQU(4,VHEP(1,NHEP),VHEP(1,NHEP-1)) + ENDIF + ENDIF +C---STATUS, ID AND POINTERS + ISTHEP(NHEP)=114 + IF (BGF) THEN + IF (XP.EQ.XBJ) THEN + IDHW(IIN)=59 + IDHEP(IIN)=IDPDG(59) + ELSE + IDHW(IIN)=13 + IDHEP(IIN)=IDPDG(13) + ENDIF + IF (ID.LT.7) THEN + IDHW(NHEP)=IDHW(IOUT) + IDHEP(NHEP)=IDHEP(IOUT) + IDHW(IOUT)=MOD(ID,6)+6 + IDHEP(IOUT)=IDPDG(IDHW(IOUT)) + ELSE + IDHW(NHEP)=MOD(ID,6) + IDHEP(NHEP)=IDPDG(IDHW(NHEP)) + ENDIF + ELSEIF (ID.LT.7) THEN + IDHW(NHEP)=13 + IDHEP(NHEP)=IDPDG(13) + ELSE + IDHW(NHEP)=IDHW(IOUT) + IDHEP(NHEP)=IDHEP(IOUT) + IDHW(IOUT)=13 + IDHEP(IOUT)=IDPDG(13) + ENDIF + JDAHEP(2,ICMF)=NHEP + JMOHEP(1,NHEP)=ICMF +C---COLOUR CONNECTIONS + IF (XP.EQ.XBJ) THEN + JMOHEP(2,IIN)=IIN + JDAHEP(2,IIN)=IIN + JMOHEP(2,IOUT)=NHEP + JDAHEP(2,IOUT)=NHEP + JMOHEP(2,NHEP)=IOUT + JDAHEP(2,NHEP)=IOUT + ELSE + JDAHEP(2,IIN)=NHEP + JDAHEP(2,NHEP)=IOUT + JMOHEP(2,IOUT)=NHEP + JMOHEP(2,NHEP)=IIN + ENDIF +C---FACTORISATION SCALE + EMSCA=SCALE + EMIT=NEVHEP+NWGTS + ELSEIF (IOPT.EQ.2) THEN +C---MAKE TWO-JET EVENTS LOOK LIKE ONE-JET EVENTS + IF (EMIT.NE.NEVHEP+NWGTS .OR. XP.EQ.XBJ) RETURN + IF (.NOT.BGF) THEN + CALL HWVEQU(5,Q1,PHEP(1,IIN)) + CALL HWVEQU(5,Q2,PHEP(1,IOUT)) + JMOHEP(2,IIN)=IOUT + JDAHEP(2,IIN)=IOUT + JMOHEP(2,IOUT)=IIN + JDAHEP(2,IOUT)=IIN + JDAHEP(2,ICMF)=IOUT + IHEP=JDAHEP(1,IOUT) + JHEP=JDAHEP(1,IOUT+1) + CALL HWVSUM(4,PHEP(1,IHEP),PHEP(1,JHEP),PHEP(1,IHEP)) + CALL HWUMAS(PHEP(1,IHEP)) + JDAHEP(2,IHEP)=JDAHEP(2,JHEP) + IEDT(1)=IOUT+1 + IEDT(2)=JHEP + IEDT(3)=JHEP+1 + NDEL=3 + IF (ISTHEP(JHEP+1).NE.100) NDEL=2 + IHEP=JDAHEP(1,IOUT) + JMOHEP(1,IHEP)=IOUT + IF (ISTHEP(IHEP+1).EQ.100) THEN + JMOHEP(1,IHEP+1)=IOUT + JMOHEP(2,IHEP+1)=IIN + ENDIF + DO 300 JHEP=JDAHEP(1,IHEP),JDAHEP(2,IHEP) + JMOHEP(1,JHEP)=IHEP + 300 CONTINUE + IF (IDHW(IOUT).EQ.13) IDHW(IOUT)=IDHW(IOUT+1) + IDHEP(IOUT)=IDPDG(IDHW(IOUT)) + IDHW(IHEP)=IDHW(IOUT) + CALL HWUEDT(NDEL,IEDT) + ELSEIF (ID.LT.7) THEN + CALL HWVEQU(5,Q1,PHEP(1,IIN)) + CALL HWVEQU(5,Q2,PHEP(1,IOUT+1)) + JMOHEP(2,IIN)=IOUT+1 + JDAHEP(2,IIN)=IOUT+1 + JMOHEP(2,IOUT+1)=IIN + JDAHEP(2,IOUT+1)=IIN + JDAHEP(2,ICMF)=IOUT+1 + IHEP=JDAHEP(1,IIN) + JHEP=JDAHEP(1,IOUT) + CALL HWVDIF(4,PHEP(1,IHEP),PHEP(1,JHEP),PHEP(1,IHEP)) + CALL HWUMAS(PHEP(1,IHEP)) + CALL HWVDIF(4,PHEP(1,ICMF),PHEP(1,JHEP),PHEP(1,ICMF)) + CALL HWUMAS(PHEP(1,ICMF)) + CALL HWUEMV(JDAHEP(2,JHEP)-JDAHEP(1,JHEP)+1, + $ JDAHEP(1,JHEP),JDAHEP(2,IHEP)) + JHEP=JDAHEP(1,IOUT) + JDAHEP(2,IHEP)=JDAHEP(2,JHEP) + IEDT(1)=IOUT + IEDT(2)=JHEP + IEDT(3)=JHEP+1 + NDEL=3 + IF (ISTHEP(JHEP+1).NE.100) NDEL=2 + CALL HWUEDT(NDEL,IEDT) + IHEP=JDAHEP(1,IIN) + DO 400 JHEP=JDAHEP(1,IHEP),JDAHEP(2,IHEP) + JMOHEP(1,JHEP)=IHEP + 400 CONTINUE + IDHW(IIN)=ID + IDHEP(IIN)=IDPDG(ID) + IDHW(IHEP)=ID + ELSE + CALL HWVEQU(5,Q1,PHEP(1,IIN)) + CALL HWVEQU(5,Q2,PHEP(1,IOUT)) + JMOHEP(2,IIN)=IOUT + JDAHEP(2,IIN)=IOUT + JMOHEP(2,IOUT)=IIN + JDAHEP(2,IOUT)=IIN + JDAHEP(2,ICMF)=IOUT + IHEP=JDAHEP(1,IIN) + JHEP=JDAHEP(1,IOUT+1) + CALL HWVDIF(4,PHEP(1,IHEP),PHEP(1,JHEP),PHEP(1,IHEP)) + CALL HWUMAS(PHEP(1,IHEP)) + CALL HWVDIF(4,PHEP(1,ICMF),PHEP(1,JHEP),PHEP(1,ICMF)) + CALL HWUMAS(PHEP(1,ICMF)) + CALL HWUEMV(JDAHEP(2,JHEP)-JDAHEP(1,JHEP)+1, + $ JDAHEP(1,JHEP),JDAHEP(1,IHEP)-1) + JHEP=JDAHEP(1,IOUT+1) + JDAHEP(1,IHEP)=JDAHEP(1,JHEP) + IEDT(1)=IOUT+1 + IEDT(2)=JHEP + IEDT(3)=JHEP+1 + NDEL=3 + IF (ISTHEP(JHEP+1).NE.100.OR.JHEP.EQ.NHEP) NDEL=2 + CALL HWUEDT(NDEL,IEDT) + IHEP=JDAHEP(1,IIN) + DO 500 JHEP=JDAHEP(1,IHEP),JDAHEP(2,IHEP) + JMOHEP(1,JHEP)=IHEP + 500 CONTINUE + IDHW(IIN)=ID + IDHEP(IIN)=IDPDG(ID) + IDHW(IHEP)=ID + ENDIF + CALL HWVZRO(4,VHEP(1,IIN)) + CALL HWVZRO(4,VHEP(1,JDAHEP(1,IIN))) + IF (ISTHEP(JDAHEP(1,IIN)+1).EQ.100) + $ CALL HWVZRO(4,VHEP(1,JDAHEP(1,IIN)+1)) + CALL HWVZRO(4,VHEP(1,IOUT)) + CALL HWVZRO(4,VHEP(1,JDAHEP(1,IOUT))) + IF (ISTHEP(JDAHEP(1,IOUT)+1).EQ.100) + $ CALL HWVZRO(4,VHEP(1,JDAHEP(1,IOUT)+1)) + EMIT=0 + ELSE + CALL HWWARN('HWBDIS',500,*999) + ENDIF + 999 END +CDECK ID>, HWBDYP. +*CMZ :- -26/10/99 17.46.56 by Mike Seymour +*-- Author : Gennaro Corcella +C----------------------------------------------------------------------- + SUBROUTINE HWBDYP(IOPT) +C MATRIX ELEMENT CORRECTIONS TO DRELL-YAN PROCESSES +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + DOUBLE PRECISION HWBVMC,HWR,HWUALF,HWUSQR,PMODK,AZ,CZ, + & T,U,S,EM,TMIN,TMAX,PMOD2,GLUFAC,SMIN,SMAX,SZ,TEST, + & JAC,M(3),W1,W,PMOD3,SCAPR,CPHI,SPHI,SCALE,XI1,XI2, + & PDFOLD1(13),PDFOLD2(13),PDFNEW1(13),PDFNEW2(13),ETA1,ETA2,Y, + & COMWGT1,COMWGT2,WW,COS3,MODP,RN,BETA1,SIN3,R3(3,3),CTH,STH,M1, + & M2,M3,GAMMA1,R5(3,3),CW,SW,R4(3,3),SCALE1,X1,X2,X3,MM, + & PHAD1(5),PHAD2(5),P1(5),P2(5),P3(5),P4(5),PF(5),PV(5),PK(5), + & PR(5),PNE(5),PE(5),PP1(5),PP2(5),PZ(5),PS(5),PD(5),P2N(5), + & PBOS(5),PLAB(5),PTOT(5),P3N(5),SVNTN + LOGICAL GLUIN,GP + INTEGER EMIT,NOEMIT,IHEP,JHEP,KHEP,ICMF,IOPT,CHEP, + & ID2,ID1,K,ID4,ID5,IDBOS,IHAD1,IHAD2,NTMP + EXTERNAL HWBVMC,HWR,HWUALF,HWUSQR + SAVE ICMF,ID4,ID5 + DATA EMIT,NTMP/2*0/ + IF (IOPT.EQ.1) THEN + EMIT=0 + NTMP=0 +C-----CHOOSE WEIGHTS + COMWGT1=0.1 + COMWGT2=0.55 +C---FIND AN UNTREATED CMF + ICMF=0 + DO 10 IHEP=1,NHEP + 10 IF (ICMF.EQ.0 .AND. ISTHEP(IHEP).EQ.110.AND. + & JDAHEP(2,IHEP).EQ.JDAHEP(1,IHEP)+1) ICMF=IHEP + IF (ICMF.EQ.0) RETURN + EM=PHEP(5,ICMF) +C-----SET THE VECTOR BOSON RAPIDITY + Y=HALF*LOG((PHEP(4,ICMF)+PHEP(3,ICMF))/ + & (PHEP(4,ICMF)-PHEP(3,ICMF))) +C------SET PARTICLE IDENTIES +c------ID1=QUARK, ID2=ANTIQUARK, IDBOS=VECTOR BOSON, ID4-5 BOSON DECAY + IDBOS=IDHW(ICMF) + ID1=IDHW(JMOHEP(1,ICMF)) + ID2=IDHW(JMOHEP(2,ICMF)) + ID4=IDHW(JDAHEP(1,ICMF)) + ID5=IDHW(JDAHEP(2,ICMF)) + M1=RMASS(ID1) + M2=RMASS(ID2) + M3=RMASS(13) +C---STORE OLD MOMENTA +C------VECTOR BOSON MOMENTUM + CALL HWVEQU(5,PHEP(1,ICMF),PBOS) +C----QUARK MOMENTUM + CALL HWVEQU(5,PHEP(1,JMOHEP(1,ICMF)),P1) +C------ANTIQUARK MOMENTUM + CALL HWVEQU(5,PHEP(1,JMOHEP(2,ICMF)),P2) +C-------VECTOR DECAY (LEPTON) PRODUCT MOMENTA + CALL HWVEQU(5,PHEP(1,JDAHEP(1,ICMF)),P3) + CALL HWVEQU(5,PHEP(1,JDAHEP(2,ICMF)),P4) +C------LEPTON MOMENTA IN THE BOSON REST FRAME + CALL HWULOF(PHEP(1,ICMF),P2,P2N) + CALL HWULOF(PHEP(1,ICMF),P3,P3N) +C------AZ=AZIMUTHAL ANGLE OF P3N + AZ=ATAN2(P3N(2),P3N(1)) + CZ=COS(AZ) + SZ=SIN(AZ) +C------PHI=ANGLE BETWEEN P2N AND P3N + SCAPR=P2N(1)*P3N(1)+P2N(2)*P3N(2)+P2N(3)*P3N(3) + PMOD2=SQRT(P2N(1)**2+P2N(2)**2+P2N(3)**2) + PMOD3=SQRT(P3N(1)**2+P3N(2)**2+P3N(3)**2) + CPHI=SCAPR/(PMOD3*PMOD2) + SPHI=SQRT(1-CPHI**2) +C------HADRON MOMENTA + IHAD1=1 + IHAD2=2 + IF (JDAHEP(1,IHAD1).NE.0) IHAD1=JDAHEP(1,IHAD1) + IF (JDAHEP(1,IHAD2).NE.0) IHAD2=JDAHEP(1,IHAD2) + CALL HWVEQU(5,PHEP(1,IHAD1),PHAD1) + CALL HWVEQU(5,PHEP(1,IHAD2),PHAD2) + CALL HWVSUM(4,PHAD1,PHAD2,PTOT) + CALL HWUMAS(PTOT) +C------ Q - QBAR ENERGY FRACTIONS (BORN PROCESS) + ETA1=P1(4)/PHAD1(4) + ETA2=P2(4)/PHAD2(4) +C------ PDFs FOR THE BORN PROCESS + CALL HWSFUN(ETA1,EM,IDHW(IHAD1),NSTRU,PDFOLD1,1) + CALL HWSFUN(ETA2,EM,IDHW(IHAD2),NSTRU,PDFOLD2,2) +C-------CONSIDER Q(QBAR) IN THE INITIAL STATE + RN=HWR() + IF (RN.LT.COMWGT1) THEN +C-------NO GLUON IN THE INITIAL STATE + GLUIN=.FALSE. +C---CHOOSE S ACCORDING TO 1/S**2 + SVNTN=17 + SMIN=HALF*EM**2*(7-SQRT(SVNTN)) + SMAX=PTOT(5)**2 + IF (SMAX.LE.SMIN) RETURN + S=SMIN*SMAX/(SMIN+HWR()*(SMAX-SMIN)) + JAC=S**2*(1/SMIN-1/SMAX) +C---CHOOSE T ACCORDING TO (S-EM**2)/(T*U)=1/T+1/U + TMAX=-HALF*EM**2*(3-HWUSQR(1+8*EM**2/S)) + TMIN=EM**2-S-TMAX + IF (TMAX.LE.TMIN) RETURN + T=TMAX*(TMIN/TMAX)**HWR() + IF (HWR().GT.HALF) T=EM**2-S-T + U=EM**2-S-T + JAC=JAC*2*T*U/(S-EM**2)*LOG(TMIN/TMAX) + SCALE=SQRT(U*T/S) + SCALE1=SQRT(U*T/S+EM**2) + GLUFAC=0 + IF (SCALE1.GT.HWBVMC(13)) GLUFAC=HWUALF(1,SCALE1)/(2*PIFAC) +C----Q-QBAR ENERGY FRACTIONS FOR Q QBAR-> VG + XI1=(HALF/PHAD1(4))*EXP(Y)*SQRT(S*(S+T)/(S+U)) + XI2=S/(4*XI1*PHAD1(4)*PHAD2(4)) + IF (XI1.GE.1.OR.XI2.GE.1) RETURN +C-----PDFs WITH AN EMITTED GLUON + CALL HWSFUN(XI1,SCALE,IDHW(IHAD1),NSTRU,PDFNEW1,1) + CALL HWSFUN(XI2,SCALE,IDHW(IHAD2),NSTRU,PDFNEW2,2) +C------CALCULATE WEIGHT + W=JAC*((EM**2-T)**2+(EM**2-U)**2)/(S**2*T*U) + W1=(GLUFAC/COMWGT1)*W*PDFNEW1(ID1)*PDFNEW2(ID2)/(PDFOLD1(ID1)* + & PDFOLD2(ID2))*(CFFAC*ETA1*ETA2/(XI1*XI2)) +C-------CHOOSE WHICH PARTON WILL EMIT + EMIT=1 + IF (HWR().LT.(EM**2-U)**2/((EM**2-U)**2+(EM**2-T)**2)) + & EMIT=2 + NOEMIT=3-EMIT + ELSE +C--------GLUON IN THE INITIAL STATE + GLUIN=.TRUE. +C---CHOOSE S ACCORDING TO 1/S**2 + SMIN=EM**2 + SMAX=PTOT(5)**2 + IF (SMAX.LE.SMIN) RETURN + S=SMIN*SMAX/(SMIN+HWR()*(SMAX-SMIN)) + JAC=S**2*(1/SMIN-1/SMAX) +C---CHOOSE T ACCORDING TO 1/T + TMAX=-HALF*EM**2*(3-HWUSQR(1+8*EM**2/S)) + TMIN=EM**2-S + IF (TMAX.LE.TMIN) RETURN + T=TMAX*(TMIN/TMAX)**HWR() + JAC=JAC*T*LOG(TMAX/TMIN) + U=EM**2-S-T + SCALE=SQRT(U*T/S) + SCALE1=SQRT(U*T/S+EM**2) + GLUFAC=0 + IF (SCALE1.GT.HWBVMC(13)) GLUFAC=HWUALF(1,SCALE1)/(2*PIFAC) +C--------INITIAL STATE GLUON COMING FROM HADRON 1 + IF (RN.LE.COMWGT2) THEN + GP=.TRUE. +C--------ENERGY FRACTIONS and PDFs + XI1=(HALF/PHAD1(4))*EXP(Y)*SQRT(S*(S+U)/(S+T)) + XI2=S/(4*XI1*PHAD1(4)*PHAD2(4)) + IF (XI1.GE.1.OR.XI2.GE.1) RETURN + CALL HWSFUN(XI1,SCALE,IDHW(IHAD1),NSTRU,PDFNEW1,1) + CALL HWSFUN(XI2,SCALE,IDHW(IHAD2),NSTRU,PDFNEW2,2) + WW=PDFNEW1(13)*PDFNEW2(ID2)/((COMWGT2-COMWGT1)* + & PDFOLD1(ID1)*PDFOLD2(ID2)) + ELSE +C-------INITIAL STATE GLUON COMING FROM HADRON 2 + GP=.FALSE. +C-------ENERGY FRACTIONS AND PDFs + XI1=(HALF/PHAD1(4))*EXP(Y)*SQRT(S*(S+T)/(S+U)) + XI2=S/(4*XI1*PHAD1(4)*PHAD2(4)) + IF (XI1.GE.1.OR.XI2.GE.1) RETURN + CALL HWSFUN(XI1,SCALE,IDHW(IHAD1),NSTRU,PDFNEW1,1) + CALL HWSFUN(XI2,SCALE,IDHW(IHAD2),NSTRU,PDFNEW2,2) + WW=PDFNEW1(ID1)*PDFNEW2(13)/((1-COMWGT2)* + & PDFOLD1(ID1)*PDFOLD2(ID2)) + ENDIF + W=-HALF*JAC*((EM**2-T)**2+(EM**2-S)**2)/(S**3*T) +C-------CHOOSE WHICH PARTON WILL EMIT + EMIT=1 + IF (HWR().LT.(EM**2-S)**2/((EM**2-S)**2+(EM**2-T)**2)) + & EMIT=2 + NOEMIT=3-EMIT +C-------FINAL WEIGHT FOR ALL THE CONSIDERED OPTIONS + W1=GLUFAC*W*WW*ETA1*ETA2/(XI1*XI2) + ENDIF +C--------ADD ONE MORE GLUON + IF (W1.GT.HWR()) THEN + NTMP=NEVHEP+NWGTS + ELSE + RETURN + ENDIF +C---------INCLUDE MASSES + S=S+M1**2+M2**2+M3**2 + IF (.NOT.GLUIN) THEN + TEST=((S+M1**2-M2**2)*(S+M3**2-EM**2)-2*S*(M1**2+M3**2-T))**2 + $ -((S-M1**2-M2**2)**2-4*M1**2*M2**2)* + $ ((S-M3**2-EM**2)**2-4*M3**2*EM**2) + ELSEIF (GP) THEN + TEST=((S+M3**2-M2**2)*(S+M1**2-EM**2)-2*S*(M3**2+M1**2-T))**2 + $ -((S-M3**2-M2**2)**2-4*M3**2*M2**2)* + $ ((S-M1**2-EM**2)**2-4*M1**2*EM**2) + ELSE + TEST=((S+M3**2-M1**2)*(S+M2**2-EM**2)-2*S*(M3**2+M2**2-T))**2 + $ -((S-M3**2-M1**2)**2-4*M3**2*M1**2)* + $ ((S-M2**2-EM**2)**2-4*M2**2*EM**2) + ENDIF + IF (TEST.GE.0) THEN + EMIT=0 + RETURN + ENDIF + M(1)=M1 + M(2)=M2 + M(3)=M3 +C----MOMENTA IN THE V-REST FRAME WITH NON EMITTER ALONG THE Z AXIS +C----V=BOSON,K=GLUON,E=EMITTER,NE=NON-EMITTER + PV(1)=0 + PV(2)=0 + PV(3)=0 + PV(4)=EM + PV(5)=EM + PNE(2)=0 + PNE(1)=0 + IF (.NOT.GLUIN) THEN + PK(4)=(S-M(3)**2-EM**2)/(2*EM) + PMODK=SQRT(PK(4)**2-M(3)**2) + IF (EMIT.EQ.1) THEN + MM=M(1) + X1=T + X2=U + X3=-1 + ELSE + MM=M(2) + X1=U + X2=T + X3=+1 + ENDIF + PNE(4)=(EM**2+MM**2-X1)/(2*EM) + PNE(3)=X3*SQRT(PNE(4)**2-MM**2) + COS3=HALF*(X2-MM**2-M(3)**2+2*PNE(4)*PK(4))/(PNE(3)*PMODK) + ELSE + PK(4)=(EM**2+M(3)**2-U)/(2*EM) + PMODK=SQRT(PK(4)**2-M(3)**2) + IF (EMIT.EQ.1) THEN + IF (GP) THEN + MM=M(1) + X3=+1 + ELSE + MM=M(2) + X3=-1 + ENDIF + PNE(4)=(S-MM**2-EM**2)/(2*EM) + PNE(3)=X3*SQRT(PNE(4)**2-MM**2) + COS3=HALF*(T-MM**2-M(3)**2+2*PNE(4)*PK(4))/(PNE(3)*PMODK) + ELSE + IF (GP) THEN + MM=M(2) + X3=-1 + ELSE + MM=M(1) + X3=+1 + ENDIF + PNE(4)=(EM**2+MM**2-T)/(2*EM) + PNE(3)=X3*SQRT(PNE(4)**2-MM**2) + COS3=HALF*(MM**2+M(3)**2-S+2*PNE(4)*PK(4))/(PNE(3)*PMODK) + ENDIF + ENDIF + CALL HWUMAS(PNE) + SIN3=SQRT(1-COS3**2) +C---------DEFINE A RANDOM ROTATION AROUND THE Z-AXIS + CALL HWRAZM(PMODK*SIN3,PK(1),PK(2)) + PK(3)=PMODK*COS3 + CALL HWUMAS(PK) + DO K=1,4 + IF (.NOT.GLUIN) THEN + PE(K)=PV(K)+PK(K)-PNE(K) + ELSE + IF (EMIT.EQ.1) THEN + PE(K)=PV(K)+PNE(K)-PK(K) + ELSE + PE(K)=PNE(K)+PK(K)-PV(K) + ENDIF + ENDIF + ENDDO + CALL HWUMAS(PE) +c------LEPTON MOMENTA IN THE BOSON REST FRAME, WITH THE DIRECTION +C------TAKEN FROM THE BORN PROCESS + PS(5)=P3(5) + PS(4)=(EM**2+P3(5)**2-P4(5)**2)/(2*EM) + PS(3)=-SQRT(PS(4)**2-P3(5)**2)*CPHI + PS(2)=SQRT(PS(4)**2-P3(5)**2)*SPHI*SZ + PS(1)=SQRT(PS(4)**2-P3(5)**2)*SPHI*CZ + PF(5)=P4(5) + PF(4)=(EM**2+P4(5)**2-P3(5)**2)/(2*EM) + PF(3)=-PS(3) + PF(2)=-PS(2) + PF(1)=-PS(1) +C----FIND A STATIONARY VECTOR PLAB IN THE LAB FRAME + IF (.NOT.GLUIN) THEN + IF (EMIT.EQ.1) THEN + CALL HWVEQU(5,PE,PP1) + CALL HWVEQU(5,PNE,PP2) + ELSE + CALL HWVEQU(5,PNE,PP1) + CALL HWVEQU(5,PE,PP2) + ENDIF + ELSE + IF (GP) THEN + CALL HWVEQU(5,PK,PP1) + IF (EMIT.EQ.1) THEN + CALL HWVEQU(5,PE,PP2) + ELSE + CALL HWVEQU(5,PNE,PP2) + ENDIF + ELSE + CALL HWVEQU(5,PK,PP2) + IF (EMIT.EQ.1) THEN + CALL HWVEQU(5,PE,PP1) + ELSE + CALL HWVEQU(5,PNE,PP1) + ENDIF + ENDIF + ENDIF + CALL HWVSCA(4,1/XI1,PP1,PP1) + CALL HWVSCA(4,1/XI2,PP2,PP2) + CALL HWVSUM(4,PP1,PP2,PLAB) + CALL HWUMAS(PLAB) +C------BOOST TO PLAB REST FRAME + CALL HWULOF(PLAB,PE,PE) + CALL HWULOF(PLAB,PNE,PNE) + CALL HWULOF(PLAB,PK,PK) + CALL HWULOF(PLAB,PS,PS) + CALL HWULOF(PLAB,PF,PF) + CALL HWULOF(PLAB,PV,PV) +C----PUT THE INITIAL PARTON BELONGING TO HADRON 1 ON THE Z-AXIS + IF (.NOT.GLUIN) THEN + IF (EMIT.EQ.1) THEN + CALL HWVEQU(5,PE,PZ) + ELSE + CALL HWVEQU(5,PNE,PZ) + ENDIF + ELSE + IF (GP) THEN + CALL HWVEQU(5,PK,PZ) + ELSE + IF (EMIT.EQ.1) THEN + CALL HWVEQU(5,PE,PZ) + ELSE + CALL HWVEQU(5,PNE,PZ) + ENDIF + ENDIF + ENDIF + MODP=SQRT(PZ(1)**2+PZ(2)**2) + CTH=PZ(1)/MODP + STH=PZ(2)/MODP + CALL HWUROT(PZ,CTH,STH,R3) +C-----ROTATE EVERYTHING BY R3 + CALL HWUROF(R3,PE,PE) + CALL HWUROF(R3,PNE,PNE) + CALL HWUROF(R3,PV,PV) + CALL HWUROF(R3,PK,PK) + CALL HWUROF(R3,PS,PS) + CALL HWUROF(R3,PF,PF) +C--REORDER ENTRIES:--IHEP=EMITTER,JHEP=NON-EMITTER,KHEP=EMITTED + IF (.NOT.GLUIN) THEN + IHEP=JMOHEP(EMIT,ICMF) + JHEP=JMOHEP(NOEMIT,ICMF) + ENDIF + CHEP=ICMF + IDHW(CHEP)=15 + IDHEP(CHEP)=IDPDG(15) + ICMF=ICMF+1 + IDHW(ICMF)=IDBOS + IDHEP(ICMF)=IDPDG(IDBOS) +C-----NO GLUON IN THE INITIAL STATE: JUST ADD IT AFTER THE VECTOR BOSON + IF (.NOT.GLUIN) THEN + KHEP=ICMF+1 + ISTHEP(KHEP)=114 +C---STATUS OF EMITTER/NON EMITTER + ISTHEP(IHEP)=110+EMIT + ISTHEP(JHEP)=110+NOEMIT + ELSE +C-----GLUON COMING FROM THE 1ST HADRON + IF (GP) THEN + KHEP=CHEP-2 + ISTHEP(KHEP)=111 +C----EMIT=1 + IF (EMIT.EQ.1) THEN + IHEP=KHEP+1 + ISTHEP(IHEP)=112 + JHEP=ICMF+1 + ISTHEP(JHEP)=114 + IDHW(IHEP)=ID2 + IF (ID1.LE.6) THEN + IDHW(JHEP)=ID1+6 + ELSE + IDHW(JHEP)=ID1-6 + ENDIF + ELSE +C-------EMIT=2 + JHEP=KHEP+1 + ISTHEP(JHEP)=112 + IDHW(JHEP)=ID2 + IHEP=ICMF+1 + ISTHEP(IHEP)=114 + IF (ID1.LE.6) THEN + IDHW(IHEP)=ID1+6 + ELSE + IDHW(IHEP)=ID1-6 + ENDIF + ENDIF + ENDIF +C------GLUON COMING FROM THE HADRON 2 + IF (.NOT.GP) THEN + KHEP=CHEP-1 + ISTHEP(KHEP)=112 +C-------EMIT=1 + IF (EMIT.EQ.1) THEN + IHEP=KHEP-1 + ISTHEP(IHEP)=111 + IDHW(IHEP)=ID1 + JHEP=ICMF+1 + ISTHEP(JHEP)=114 + IF (ID2.LE.6) THEN + IDHW(JHEP)=ID2+6 + ELSE + IDHW(JHEP)=ID2-6 + ENDIF + ELSE +C-------EMIT=2 + JHEP=KHEP-1 + ISTHEP(JHEP)=111 + IDHW(JHEP)=ID1 + IHEP=ICMF+1 + ISTHEP(IHEP)=114 + IF (ID2.LE.6) THEN + IDHW(IHEP)=ID2+6 + ELSE + IDHW(IHEP)=ID2-6 + ENDIF + ENDIF + ENDIF + ENDIF + IDHEP(IHEP)=IDPDG(IDHW(IHEP)) + IDHEP(JHEP)=IDPDG(IDHW(JHEP)) + ISTHEP(ICMF)=113 + ISTHEP(CHEP)=110 + IDHW(KHEP)=13 + IDHEP(KHEP)=IDPDG(13) +C---------DEFINE MOMENTA IN THE LAB FRAME + CALL HWVEQU(5,PV,PHEP(1,ICMF)) + CALL HWVEQU(5,PK,PHEP(1,KHEP)) + CALL HWVEQU(5,PNE,PHEP(1,JHEP)) + CALL HWVEQU(5,PE,PHEP(1,IHEP)) + IF (.NOT.GLUIN) THEN + CALL HWVSUM(4,PHEP(1,IHEP),PHEP(1,JHEP),PHEP(1,CHEP)) + ELSE + IF (EMIT.EQ.1) THEN + CALL HWVSUM(4,PHEP(1,IHEP),PHEP(1,KHEP),PHEP(1,CHEP)) + ELSE + CALL HWVSUM(4,PHEP(1,KHEP),PHEP(1,JHEP),PHEP(1,CHEP)) + ENDIF + ENDIF + CALL HWUMAS(PHEP(1,CHEP)) + IF (.NOT.GLUIN) THEN + JMOHEP(1,JHEP)=CHEP + JMOHEP(1,IHEP)=CHEP + JDAHEP(1,JHEP)=CHEP + JDAHEP(1,IHEP)=CHEP + JMOHEP(1,KHEP)=CHEP + JDAHEP(1,KHEP)=0 + JMOHEP(1,ICMF)=CHEP + JMOHEP(2,ICMF)=ICMF + JDAHEP(1,ICMF)=0 + JDAHEP(2,ICMF)=ICMF + ENDIF + IF (GLUIN) THEN + JMOHEP(2,ICMF)=ICMF + JDAHEP(2,ICMF)=ICMF + JMOHEP(1,KHEP)=CHEP + JDAHEP(1,KHEP)=CHEP + JMOHEP(1,IHEP)=CHEP + JMOHEP(1,JHEP)=CHEP + IF (EMIT.EQ.1) THEN + JDAHEP(1,IHEP)=CHEP + JDAHEP(1,JHEP)=0 + ELSE + JDAHEP(1,JHEP)=CHEP + JDAHEP(1,IHEP)=0 + ENDIF + ENDIF +C---COLOUR CONNECTIONS + IF (.NOT.GLUIN) THEN + IF (IDHW(IHEP).LT.IDHW(JHEP)) THEN + JMOHEP(2,KHEP)=IHEP + JDAHEP(2,KHEP)=JHEP + JMOHEP(2,IHEP)=JHEP + JDAHEP(2,IHEP)=KHEP + JDAHEP(2,JHEP)=IHEP + JMOHEP(2,JHEP)=KHEP + ELSE + JMOHEP(2,KHEP)=JHEP + JDAHEP(2,KHEP)=IHEP + JMOHEP(2,JHEP)=IHEP + JDAHEP(2,JHEP)=KHEP + JDAHEP(2,IHEP)=JHEP + JMOHEP(2,IHEP)=KHEP + ENDIF + ENDIF + IF (GLUIN) THEN + IF (EMIT.EQ.1) THEN + IF (IDHEP(IHEP).GT.0) THEN + JMOHEP(2,IHEP)=JHEP + JDAHEP(2,IHEP)=KHEP + JMOHEP(2,JHEP)=KHEP + JDAHEP(2,JHEP)=IHEP + JMOHEP(2,KHEP)=IHEP + JDAHEP(2,KHEP)=JHEP + ELSE + JMOHEP(2,IHEP)=KHEP + JDAHEP(2,IHEP)=JHEP + JMOHEP(2,JHEP)=IHEP + JDAHEP(2,JHEP)=KHEP + JMOHEP(2,KHEP)=JHEP + JDAHEP(2,KHEP)=IHEP + ENDIF + ELSE + IF (IDHEP(JHEP).GT.0) THEN + JMOHEP(2,JHEP)=IHEP + JDAHEP(2,JHEP)=KHEP + JMOHEP(2,IHEP)=KHEP + JDAHEP(2,IHEP)=JHEP + JMOHEP(2,KHEP)=JHEP + JDAHEP(2,KHEP)=IHEP + ELSE + JMOHEP(2,JHEP)=KHEP + JDAHEP(2,JHEP)=IHEP + JMOHEP(2,IHEP)=JHEP + JDAHEP(2,IHEP)=KHEP + JMOHEP(2,KHEP)=IHEP + JDAHEP(2,KHEP)=JHEP + ENDIF + ENDIF + ENDIF + EMSCA=SQRT(EM**2+PHEP(1,ICMF)**2+PHEP(2,ICMF)**2) +C--------SET STATUS AND LEPTON MOMENTA AFTER THE PARTON SHOWER + ELSEIF (IOPT.EQ.2) THEN + IF (EMIT.EQ.0.OR.NEVHEP+NWGTS.NE.NTMP) RETURN + ISTHEP(JDAHEP(1,ICMF))=195 + IDHW(NHEP+1)=ID4 + IDHW(NHEP+2)=ID5 + IDHEP(NHEP+1)=IDPDG(ID4) + IDHEP(NHEP+2)=IDPDG(ID5) + ISTHEP(NHEP+1)=113 + ISTHEP(NHEP+2)=114 + CW=PHEP(3,ICMF)/SQRT(PHEP(1,ICMF)**2+PHEP(2,ICMF)**2+ + & PHEP(3,ICMF)**2) + SW=SQRT(1-CW**2) + CALL HWUROT(PHEP(1,ICMF),CW,SW,R4) + CALL HWUROF(R4,PHEP(1,ICMF),PR) + PR(4)=PHEP(4,ICMF) + CALL HWUMAS(PR) + CALL HWUROF(R4,PS,PS) + CALL HWUROF(R4,PF,PF) + CALL HWUMAS(PS) + CALL HWUMAS(PF) + CALL HWUROT(PHEP(1,JDAHEP(1,ICMF)),CW,SW,R5) + CALL HWUROF(R5,PHEP(1,JDAHEP(1,ICMF)),PD) + PD(4)=PHEP(4,JDAHEP(1,ICMF)) + CALL HWUMAS(PD) + BETA1=(PR(4)*PR(3)-SQRT(PR(4)**2*PD(3)**2-PR(3)**2*PD(3)**2+ + & PD(3)**4))/(PD(3)**2+PR(4)**2) + GAMMA1=1/SQRT(1-BETA1**2) + PHEP(4,NHEP+1)=GAMMA1*PS(4)-BETA1*GAMMA1*PS(3) + PHEP(3,NHEP+1)=-BETA1*GAMMA1*PS(4)+GAMMA1*PS(3) + PHEP(4,NHEP+2)=GAMMA1*PF(4)-BETA1*GAMMA1*PF(3) + PHEP(3,NHEP+2)=-BETA1*GAMMA1*PF(4)+GAMMA1*PF(3) + PHEP(1,NHEP+1)=PS(1) + PHEP(2,NHEP+1)=PS(2) + PHEP(1,NHEP+2)=PF(1) + PHEP(2,NHEP+2)=PF(2) + CALL HWUMAS(PHEP(1,NHEP+1)) + CALL HWUMAS(PHEP(1,NHEP+2)) + CALL HWUROB(R5,PHEP(1,NHEP+1),PHEP(1,NHEP+1)) + CALL HWUROB(R5,PHEP(1,NHEP+2),PHEP(1,NHEP+2)) + JDAHEP(1,JDAHEP(1,ICMF))=NHEP+1 + JDAHEP(2,JDAHEP(1,ICMF))=NHEP+2 + JMOHEP(1,NHEP+1)=JDAHEP(1,ICMF) + JMOHEP(1,NHEP+2)=JDAHEP(1,ICMF) + JMOHEP(2,NHEP+1)=NHEP+2 + JDAHEP(2,NHEP+1)=NHEP+2 + JMOHEP(2,NHEP+2)=NHEP+1 + JDAHEP(2,NHEP+2)=NHEP+1 + NHEP=NHEP+2 + EMIT=0 + ENDIF + END +CDECK ID>, HWBFIN. +*CMZ :- -26/04/91 10.18.56 by Bryan Webber +*-- Author : Bryan Webber +C----------------------------------------------------------------------- + SUBROUTINE HWBFIN(IHEP) +C----------------------------------------------------------------------- +C DELETES INTERNAL LINES FROM SHOWER, MAKES COLOUR CONNECTION INDEX +C AND COPIES INTO /HEPEVT/ IN COLOUR ORDER. +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + INTEGER IHEP,ID,IJET,KHEP,IPAR,JPAR,NXPAR,IP,JP + IF (IERROR.NE.0) RETURN +C---SAVE VIRTUAL PARTON DATA + NHEP=NHEP+1 + IF(NHEP.GT.NMXHEP) CALL HWWARN('HWBFIN',100,*999) + ID=IDPAR(2) + IDHW(NHEP)=ID + IDHEP(NHEP)=IDPDG(ID) + ISTHEP(NHEP)=ISTHEP(IHEP)+20 + JMOHEP(1,NHEP)=IHEP + JMOHEP(2,NHEP)=JMOHEP(1,IHEP) + JDAHEP(1,IHEP)=NHEP + JDAHEP(1,NHEP)=0 + JDAHEP(2,NHEP)=0 + CALL HWVEQU(5,PPAR(1,2),PHEP(1,NHEP)) + CALL HWVEQU(4,VPAR(1,2),VHEP(1,NHEP)) +C---FINISHED FOR SPECTATOR OR NON-PARTON JETS + IF (ISTHEP(NHEP).GT.136) RETURN + IF (ID.GT.13.AND.ID.LT.209 .AND. ID.NE.59) RETURN + IF (ID.GT.220.AND.ABS(IDPDG(ID)).LT.1000000) RETURN + IF (ID.GT.424.AND.ID.NE.449) RETURN + IF (.NOT.TMPAR(2).AND.ID.EQ.59) RETURN + IDHEP(NHEP)=94 + IJET=NHEP + IF (NPAR.GT.2) THEN +C---SAVE CONE DATA + NHEP=NHEP+1 + IF(NHEP.GT.NMXHEP) CALL HWWARN('HWBFIN',101,*999) + IDHW(NHEP)=IDPAR(1) + IDHEP(NHEP)=0 + ISTHEP(NHEP)=100 + JMOHEP(1,NHEP)=IHEP + JMOHEP(2,NHEP)=JCOPAR(1,1) + JDAHEP(1,NHEP)=0 + JDAHEP(2,NHEP)=0 + CALL HWVEQU(5,PPAR,PHEP(1,NHEP)) + CALL HWVEQU(4,VPAR(1,2),VHEP(1,NHEP)) + ENDIF + KHEP=NHEP +C---START WITH ANTICOLOUR DAUGHTER OF HARDEST PARTON + IPAR=2 + JPAR=JCOPAR(4,IPAR) + NXPAR=NPAR/2 + DO 20 IP=1,NXPAR + DO 10 JP=1,NXPAR + IF (JPAR.EQ.0) GOTO 15 + IF (JCOPAR(2,JPAR).EQ.IPAR) THEN + IPAR=JPAR + JPAR=JCOPAR(4,IPAR) + ELSE + IPAR=JPAR + JPAR=JCOPAR(1,IPAR) + ENDIF + 10 CONTINUE +C---COULDN'T FIND COLOUR PARTNER + CALL HWWARN('HWBFIN',1,*999) + 15 JPAR=JCOPAR(1,IPAR) + KHEP=KHEP+1 + IF(KHEP.GT.NMXHEP) CALL HWWARN('HWBFIN',102,*999) + ID=IDPAR(IPAR) + IF (TMPAR(IPAR)) THEN + IF (ID.LT.14) THEN + ISTHEP(KHEP)=139 + ELSEIF (ID.EQ.59) THEN + ISTHEP(KHEP)=139 + ELSEIF (ID.LT.109) THEN + ISTHEP(KHEP)=130 + ELSEIF (ID.LT.120) THEN + ISTHEP(KHEP)=139 + ELSEIF (ABS(IDPDG(ID)).LT.1000000) THEN + ISTHEP(KHEP)=130 + ELSEIF (ID.LT.425) THEN + ISTHEP(KHEP)=139 + ELSEIF (ID.EQ.449) THEN + ISTHEP(KHEP)=139 + ELSE + ISTHEP(KHEP)=130 + ENDIF + ELSE + ISTHEP(KHEP)=ISTHEP(IHEP)+24 + ENDIF + IDHW(KHEP)=ID + IDHEP(KHEP)=IDPDG(ID) + CALL HWVEQU(5,PPAR(1,IPAR),PHEP(1,KHEP)) + CALL HWVEQU(4,VPAR(1,IPAR),VHEP(1,KHEP)) + JMOHEP(1,KHEP)=IJET + JMOHEP(2,KHEP)=KHEP+1 + JDAHEP(1,KHEP)=0 + JDAHEP(2,KHEP)=KHEP-1 + 20 CONTINUE + JMOHEP(2,KHEP)=0 + JDAHEP(2,NHEP+1)=0 + JDAHEP(1,IJET)=NHEP+1 + JDAHEP(2,IJET)=KHEP + NHEP=KHEP + 999 END +CDECK ID>, HWBGEN. +*CMZ :- -14/10/99 18.04.56 by Mike Seymour +*-- Author : Bryan Webber +C----------------------------------------------------------------------- + SUBROUTINE HWBGEN +C----------------------------------------------------------------------- +C BRANCHING GENERATOR WITH INTERFERING GLUONS +C HWBGEN EVOLVES QCD JETS ACCORDING TO THE METHOD OF +C G.MARCHESINI & B.R.WEBBER, NUCL. PHYS. B238(1984)1 +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + DOUBLE PRECISION HWULDO,HWRGAU,EINHEP,ERTXI,RTXI,XF + INTEGER NTRY,LASHEP,IHEP,NRHEP,ID,IST,JHEP,KPAR,I,J,IRHEP(NMXJET), + & IRST(NMXJET) + LOGICAL HWRLOG + EXTERNAL HWULDO,HWRGAU + IF (IERROR.NE.0) RETURN + IF (IPRO.EQ.80) RETURN +C---CHECK THAT EMSCA IS SET + IF (EMSCA.LE.ZERO) CALL HWWARN('HWBGEN',200,*999) + IF (HARDME) THEN +C---FORCE A BRANCH INTO THE `DEAD ZONE' IN E+E- + IF (IPROC/10.EQ.10) CALL HWBDED(1) +C---FORCE A BRANCH INTO THE `DEAD ZONE' IN DIS + IF (IPRO.EQ.90) CALL HWBDIS(1) +C---FORCE A BRANCH INTO THE `DEAD ZONE' IN DRELL-YAN PROCESSES + IF (IPRO.EQ.13.OR.IPRO.EQ.14) CALL HWBDYP(1) +C---FORCE A BRANCH INTO THE `DEAD ZONE' IN TOP DECAYS + CALL HWBTOP + ENDIF +C---GENERATE INTRINSIC PT ONCE AND FOR ALL + DO 5 JNHAD=1,2 + IF (PTRMS.NE.0.) THEN + PTINT(1,JNHAD)=HWRGAU(1,ZERO,PXRMS) + PTINT(2,JNHAD)=HWRGAU(2,ZERO,PXRMS) + PTINT(3,JNHAD)=PTINT(1,JNHAD)**2+PTINT(2,JNHAD)**2 + ELSE + CALL HWVZRO(3,PTINT(1,JNHAD)) + ENDIF + 5 CONTINUE + NTRY=0 + LASHEP=NHEP + 10 NTRY=NTRY+1 + IF (NTRY.GT.NETRY) CALL HWWARN('HWBGEN',ISLENT*100,*999) + NRHEP=0 + NHEP=LASHEP + FROST=.FALSE. + DO 100 IHEP=1,LASHEP + IST=ISTHEP(IHEP) + IF (IST.GE.111.AND.IST.LE.115) THEN + NRHEP=NRHEP+1 + IRHEP(NRHEP)=IHEP + IRST(NRHEP)=IST + ID=IDHW(IHEP) + IF (IST.NE.115) THEN +C---FOUND A PARTON TO EVOLVE + NEVPAR=IHEP + NPAR=2 + IDPAR(1)=17 + IDPAR(2)=ID + TMPAR(1)=.TRUE. + PPAR(2,1)=0. + PPAR(4,1)=1. + DO 15 J=1,2 + DO 15 I=1,2 + JMOPAR(I,J)=0 + 15 JCOPAR(I,J)=0 +C---SET UP EVOLUTION SCALE AND FRAME + JHEP=JMOHEP(2,IHEP) + IF (ID.EQ.13) THEN + IF (HWRLOG(HALF)) JHEP=JDAHEP(2,IHEP) + ELSEIF (IST.GT.112) THEN + IF ((ID.GT.6.AND.ID.LT.13).OR. + & (ID.GT.214.AND.ID.LT.221)) JHEP=JDAHEP(2,IHEP) + ELSE + IF (ID.LT.7.OR.(ID.GT.208.AND.ID.LT.215)) JHEP=JDAHEP(2,IHEP) + ENDIF + IF (JHEP.LE.0.OR.JHEP.GT.NHEP) THEN + CALL HWWARN('HWBGEN',1,*999) + JHEP=IHEP + ENDIF + JCOPAR(1,1)=JHEP + EINHEP=PHEP(4,IHEP) + ERTXI=HWULDO(PHEP(1,IHEP),PHEP(1,JHEP)) + IF (ERTXI.LT.ZERO) ERTXI=0. + IF (IST.LE.112.AND.IHEP.EQ.JHEP) ERTXI=0. + IF (ISTHEP(JHEP).EQ.155) THEN + ERTXI=ERTXI/PHEP(5,JHEP) + RTXI=1. + ELSE + ERTXI=SQRT(ERTXI) + RTXI=ERTXI/EINHEP + ENDIF + IF (RTXI.EQ.ZERO) THEN + XF=1. + PPAR(1,1)=0. + PPAR(3,1)=1. + PPAR(1,2)=EINHEP + PPAR(2,2)=0. + PPAR(4,2)=EINHEP + ELSE + XF=1./RTXI + PPAR(1,1)=1. + PPAR(3,1)=0. + PPAR(1,2)=ERTXI + PPAR(2,2)=1. + PPAR(4,2)=ERTXI + ENDIF + IF (PPAR(4,2).LT.PHEP(5,IHEP)) PPAR(4,2)=PHEP(5,IHEP) +C---STORE MASS + PPAR(5,2)=PHEP(5,IHEP) + CALL HWVZRO(4,VPAR(1,1)) + CALL HWVZRO(4,VPAR(1,2)) + IF (IST.GT.112) THEN + TMPAR(2)=.TRUE. + INHAD=0 + JNHAD=0 + XFACT=0. + ELSE + TMPAR(2)=.FALSE. + JNHAD=IST-110 + INHAD=JNHAD + IF (JDAHEP(1,JNHAD).NE.0) INHAD=JDAHEP(1,JNHAD) + XFACT=XF/PHEP(4,INHAD) + ANOMSC(1,JNHAD)=ZERO + ANOMSC(2,JNHAD)=ZERO + ENDIF +C---FOR QUARKS IN A COLOUR SINGLET, ALLOW SOFT MATRIX-ELEMENT CORRECTION + HARDST=PPAR(4,2) + IF (SOFTME.AND.IDHW(IHEP).LT.13.AND. + $ ((JMOHEP(2,JHEP).EQ.IHEP.AND.JDAHEP(2,JHEP).EQ.IHEP).OR. + $ ISTHEP(JHEP).EQ.155)) HARDST=0 +C---CREATE BRANCHES AND COMPUTE ENERGIES + DO 20 KPAR=2,NMXPAR + IF (TMPAR(KPAR)) THEN + CALL HWBRAN(KPAR) + ELSE + CALL HWSBRN(KPAR) + ENDIF + IF (IERROR.NE.0) RETURN + IF (FROST) GOTO 100 + IF (KPAR.EQ.NPAR) GOTO 30 + 20 CONTINUE +C---COMPUTE MASSES AND 3-MOMENTA + 30 CONTINUE + CALL HWBMAS + IF (AZSPIN) CALL HWBSPN + IF (TMPAR(2)) THEN + CALL HWBTIM(2,1) + ELSE + CALL HWBSPA + ENDIF +C---ENTER PARTON JET IN /HEPEVT/ + CALL HWBFIN(IHEP) + ELSE +C---COPY SPECTATOR + NHEP=NHEP+1 + IF (ID.GT.120.AND.ID.LT.133 .OR. ID.GE.198.AND.ID.LE.201) THEN + ISTHEP(NHEP)=190 + ELSE + ISTHEP(NHEP)=152 + ENDIF + IDHW(NHEP)=ID + IDHEP(NHEP)=IDPDG(ID) + JMOHEP(1,NHEP)=IHEP + JMOHEP(2,NHEP)=0 + JDAHEP(2,NHEP)=0 + JDAHEP(1,IHEP)=NHEP + CALL HWVEQU(5,PHEP(1,IHEP),PHEP(1,NHEP)) + ENDIF + ISTHEP(IHEP)=ISTHEP(IHEP)+10 + ENDIF + 100 CONTINUE + IF (.NOT.FROST) THEN +C---COMBINE JETS + ISTAT=20 + CALL HWBJCO + ENDIF + IF (.NOT.FROST) THEN +C---ATTACH SPECTATORS + ISTAT=30 + CALL HWSSPC + ENDIF + IF (FROST) THEN +C---BAD JET: RESTORE PARTONS AND RE-EVOLVE + DO 120 I=1,NRHEP + 120 ISTHEP(IRHEP(I))=IRST(I) + GOTO 10 + ENDIF +C---CONNECT COLOURS + CALL HWBCON + ISTAT=40 + LASHEP=NHEP + IF (HARDME) THEN +C---CLEAN UP IF THERE WAS A BRANCH IN THE `DEAD ZONE' IN E+E- + IF (IPROC/10.EQ.10) CALL HWBDED(2) +C---CLEAN UP IF THERE WAS A BRANCH IN THE `DEAD ZONE' IN DIS + IF (IPRO.EQ.90) CALL HWBDIS(2) +C---CLEAN UP IF THERE WAS A BRANCH IN THE `DEAD ZONE' IN DRELL-YAN PROC + IF (IPRO.EQ.13.OR.IPRO.EQ.14) CALL HWBDYP(2) + ENDIF +C---IF THE CLEAN-UP OPERATION ADDED ANY PARTONS TO THE EVENT RECORD +C IT MIGHT NEED RESHOWERING + IF (NHEP.GT.LASHEP) THEN + LASHEP=NHEP + GOTO 10 + ENDIF + 999 END +CDECK ID>, HWBJCO. +*CMZ :- -26/04/91 14.25.31 by Federico Carminati +*-- Author : Bryan Webber +C----------------------------------------------------------------------- + SUBROUTINE HWBJCO +C----------------------------------------------------------------------- +C COMBINES JETS WITH REQUIRED KINEMATICS +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + DOUBLE PRECISION HWULDO,EPS,PTX,PTY,PF,PTINF,PTCON,CN,CP,SP,PP0, + & PM0,ET0,DET,ECM,EMJ,EMP,EMS,DMS,ES,DPF,ALF,AL(2),ET(2),PP(2), + & PT(3),PB(5),PC(5),PQ(5),PR(5),PS(5),RR(3,3),RS(3,3),ETC, + & PJ(NMXJET),PM(NMXJET),PBR(5),RBR(3,3),DISP(4) + INTEGER LJET,IJ1,IST,IP,ICM,IP1,IP2,NP,IHEP,MHEP,JP,KP,LP,KHEP, + & JHEP,NE,IJT,IEND(2),IJET(NMXJET),IPAR(NMXJET) + LOGICAL AZCOR,JETRAD,DISPRO,DISLOW + EXTERNAL HWULDO + PARAMETER (EPS=1.D-4) + IF (IERROR.NE.0) RETURN + AZCOR=AZSOFT.OR.AZSPIN +C---FIRST LOOK FOR SPACELIKE JETS + LJET=131 + 10 IJET(1)=1 + 20 IJ1=IJET(1) + DO 40 IHEP=IJ1,NHEP + IST=ISTHEP(IHEP) + IF (IST.EQ.137.OR.IST.EQ.138) IST=133 + IF (IST.EQ.LJET) THEN +C---FOUND AN UNBOOSTED JET - FIND PARTNERS + IP=JMOHEP(1,IHEP) + ICM=JMOHEP(1,IP) + DISPRO=IPRO/10.EQ.9.AND.IDHW(ICM).EQ.15 + DISLOW=DISPRO.AND.JDAHEP(1,ICM).EQ.JDAHEP(2,ICM)-1 + IF (IST.EQ.131) THEN + IP1=JMOHEP(1,ICM) + IP2=JMOHEP(2,ICM) + ELSE + IP1=JDAHEP(1,ICM) + IP2=JDAHEP(2,ICM) + ENDIF + IF (IP1.NE.IP) CALL HWWARN('HWBJCO',100,*999) + NP=0 + DO 30 JHEP=IP1,IP2 + NP=NP+1 + IPAR(NP)=JHEP + 30 IJET(NP)=JDAHEP(1,JHEP) + GOTO 50 + ENDIF + 40 CONTINUE +C---NO MORE JETS? + IF (LJET.EQ.131) THEN + LJET=133 + GOTO 10 + ENDIF + RETURN + 50 IF (LJET.EQ.131) THEN +C---SPACELIKE JETS: FIND SPACELIKE PARTONS + IF (NP.NE.2) CALL HWWARN('HWBJCO',103,*999) +C---special for DIS: FIND BOOST AND ROTATION FROM LAB TO BREIT FRAME + IF (DISPRO.AND.BREIT) THEN + IP=2 + IF (JDAHEP(1,IP).NE.0) IP=JDAHEP(1,IP) + CALL HWVDIF(4,PHEP(1,JMOHEP(1,ICM)),PHEP(1,JDAHEP(1,ICM)),PB) + CALL HWUMAS(PB) +C---IF Q**2<10**-2, SOMETHING MUST HAVE ALREADY GONE WRONG + IF (PB(5)**2.LT.1.D-2) CALL HWWARN('HWBJCO',102,*999) + CALL HWVSCA(4,PB(5)**2/HWULDO(PHEP(1,IP),PB),PHEP(1,IP),PBR) + CALL HWVSUM(4,PB,PBR,PBR) + CALL HWUMAS(PBR) + CALL HWULOF(PBR,PB,PB) + CALL HWUROT(PB,ONE,ZERO,RBR) + ENDIF + PTX=0. + PTY=0. + PF=1.D0 + DO 90 IP=1,2 + MHEP=IJET(IP) + IF (JDAHEP(1,MHEP).EQ.0) THEN +C---SPECIAL FOR NON-PARTON JETS + IHEP=MHEP + GOTO 70 + ELSE + IST=134+IP + DO 60 IHEP=MHEP,NHEP + 60 IF (ISTHEP(IHEP).EQ.IST) GOTO 70 +C---COULDN'T FIND SPACELIKE PARTON + CALL HWWARN('HWBJCO',101,*999) + ENDIF + 70 CALL HWVSCA(3,PF,PHEP(1,IHEP),PS) + IF (PTINT(3,IP).GT.ZERO) THEN +C---ADD INTRINSIC PT + PT(1)=PTINT(1,IP) + PT(2)=PTINT(2,IP) + PT(3)=0. + CALL HWUROT(PS, ONE,ZERO,RS) + CALL HWUROB(RS,PT,PT) + CALL HWVSUM(3,PS,PT,PS) + ENDIF + JP=IJET(IP)+1 + IF (AZCOR.AND.JP.LE.NHEP.AND.IDHW(JP).EQ.17) THEN +C---ALIGN CONE WITH INTERFERING PARTON + CALL HWUROT(PS, ONE,ZERO,RS) + CALL HWUROF(RS,PHEP(1,JP),PR) + PTCON=PR(1)**2+PR(2)**2 + KP=JMOHEP(2,JP) + IF (KP.EQ.0) THEN + CALL HWWARN('HWBJCO',1,*999) + PTINF=0. + ELSE + CALL HWVEQU(4,PHEP(1,KP),PB) + IF (DISPRO.AND.BREIT) THEN + CALL HWULOF(PBR,PB,PB) + CALL HWUROF(RBR,PB,PB) + ENDIF + PTINF=PB(1)**2+PB(2)**2 + IF (PTINF.LT.EPS) THEN +C---COLLINEAR JETS: ALIGN CONES + KP=JDAHEP(1,KP)+1 + IF (ISTHEP(KP).EQ.100.AND.ISTHEP(KP-1)/10.EQ.14) THEN + CALL HWVEQU(4,PHEP(1,KP),PB) + IF (DISPRO.AND.BREIT) THEN + CALL HWULOF(PBR,PB,PB) + CALL HWUROF(RBR,PB,PB) + ENDIF + PTINF=PB(1)**2+PB(2)**2 + ELSE + PTINF=0. + ENDIF + ENDIF + ENDIF + IF (PTCON.NE.ZERO.AND.PTINF.NE.ZERO) THEN + CN=1./SQRT(PTINF*PTCON) + CP=CN*(PR(1)*PB(1)+PR(2)*PB(2)) + SP=CN*(PR(1)*PB(2)-PR(2)*PB(1)) + ELSE + CALL HWRAZM( ONE,CP,SP) + ENDIF + ELSE + CALL HWRAZM( ONE,CP,SP) + ENDIF +C---ROTATE SO SPACELIKE IS ALONG AXIS (APART FROM INTRINSIC PT) + CALL HWUROT(PS,CP,SP,RS) + IHEP=IJET(IP) + KHEP=JDAHEP(2,IHEP) + IF (KHEP.LT.IHEP) KHEP=IHEP + IEND(IP)=KHEP + DO 80 JHEP=IHEP,KHEP + CALL HWUROF(RS,PHEP(1,JHEP),PHEP(1,JHEP)) + 80 CALL HWUROF(RS,VHEP(1,JHEP),VHEP(1,JHEP)) + PP(IP)=PHEP(4,IHEP)+PF*PHEP(3,IHEP) + ET(IP)=PHEP(1,IHEP)**2+PHEP(2,IHEP)**2-PHEP(5,IHEP)**2 +C---REDEFINE HARD CM + PTX=PTX+PHEP(1,IHEP) + PTY=PTY+PHEP(2,IHEP) + 90 PF=-PF + PHEP(1,ICM)=PTX + PHEP(2,ICM)=PTY +C---special for DIS: keep lepton momenta fixed + IF (DISPRO) THEN + IP1=JMOHEP(1,ICM) + IP2=JDAHEP(1,ICM) + IJT=IJET(1) +C---IJT will be used to store lepton momentum transfer + CALL HWVDIF(4,PHEP(1,IP1),PHEP(1,IP2),PHEP(1,IJT)) + CALL HWUMAS(PHEP(1,IJT)) + IF (IDHEP(IP1).EQ.IDHEP(IP2)) THEN + IDHW(IJT)=200 + ELSEIF (IDHEP(IP1).LT.IDHEP(IP2)) THEN + IDHW(IJT)=199 + ELSE + IDHW(IJT)=198 + ENDIF + IDHEP(IJT)=IDPDG(IDHW(IJT)) + ISTHEP(IJT)=3 +C---calculate boost for struck parton +C PC is momentum of outgoing parton(s) + IP2=JDAHEP(2,ICM) + IF (.NOT.DISLOW) THEN +C---FOR heavy QQbar PQ and PC are old and new QQbar momenta + CALL HWVSUM(4,PHEP(1,IP2-1),PHEP(1,IP2),PQ) + CALL HWUMAS(PQ) + PC(5)=PQ(5) + ELSE + PC(5)=PHEP(5,JDAHEP(1,IP2)) + ENDIF + CALL HWVSUM(2,PHEP(1,IJT),PHEP(1,IJET(2)),PC) + ET(1)=ET(2) +C---USE BREIT FRAME BOSON MOMENTUM IF NECESSARY + IF (BREIT) THEN + ET(2)=ET(1)+PC(5)**2+PHEP(5,IJET(2))**2 + PM0=PHEP(5,IJT) + PP0=-PM0 + ELSE + ET(2)=PC(1)**2+PC(2)**2+PC(5)**2 + PP0=PHEP(4,IJT)+PHEP(3,IJT) + PM0=PHEP(4,IJT)-PHEP(3,IJT) + ENDIF + ET0=(PP0*PM0)+ET(1)-ET(2) + DET=ET0**2-4.*(PP0*PM0)*ET(1) + IF (DET.LT.ZERO) THEN + FROST=.TRUE. + RETURN + ENDIF + ALF=(SQRT(DET)-ET0)/(2.*PP0*PP(2)) + PB(1)=0. + PB(2)=0. + PB(5)=2.D0 + PB(3)=ALF-(1./ALF) + PB(4)=ALF+(1./ALF) + DO 100 IHEP=IJET(2),IEND(2) + CALL HWULOF(PB,PHEP(1,IHEP),PHEP(1,IHEP)) + CALL HWULF4(PB,VHEP(1,IHEP),VHEP(1,IHEP)) +C---BOOST FROM BREIT FRAME IF NECESSARY + IF (BREIT) THEN + CALL HWUROB(RBR,PHEP(1,IHEP),PHEP(1,IHEP)) + CALL HWULOB(PBR,PHEP(1,IHEP),PHEP(1,IHEP)) + CALL HWUROB(RBR,VHEP(1,IHEP),VHEP(1,IHEP)) + CALL HWULB4(PBR,VHEP(1,IHEP),VHEP(1,IHEP)) + ENDIF + 100 ISTHEP(IHEP)=ISTHEP(IHEP)+10 + CALL HWVDIF(4,VHEP(1,IPAR(2)),VHEP(1,IJET(2)),DISP) + DO 110 IHEP=IJET(2),IEND(2) + 110 CALL HWVSUM(4,DISP,VHEP(1,IHEP),VHEP(1,IHEP)) + IF (IEND(2).GT.IJET(2)+1) ISTHEP(IJET(2)+1)=100 + CALL HWVSUM(4,PHEP(1,IJT),PHEP(1,IJET(2)),PC) + CALL HWVSUM(4,PHEP(1,IP1),PHEP(1,IJET(2)),PHEP(1,ICM)) + CALL HWUMAS(PHEP(1,ICM)) + ELSEIF (IPRO/10.EQ.5) THEN +C Special to preserve photon momentum + ETC=PTX**2+PTY**2+PHEP(5,ICM)**2 + ET0=ETC+ET(1)-ET(2) + DET=ET0**2-4.*ETC*ET(1) + IF (DET.LT.ZERO) THEN + FROST=.TRUE. + RETURN + ENDIF + ALF=(SQRT(DET)+ET0-2.*ET(1))/(2.*PP(1)*PP(2)) + PB(1)=0. + PB(2)=0. + PB(3)=ALF-1./ALF + PB(4)=ALF+1./ALF + PB(5)=2. + IJT=IJET(2) + DO 120 IHEP=IJT,IEND(2) + CALL HWULOF(PB,PHEP(1,IHEP),PHEP(1,IHEP)) + CALL HWULF4(PB,VHEP(1,IHEP),VHEP(1,IHEP)) + 120 ISTHEP(IHEP)=ISTHEP(IHEP)+10 + CALL HWVDIF(4,VHEP(1,IPAR(2)),VHEP(1,IJT),DISP) + DO 130 IHEP=IJT,IEND(2) + 130 CALL HWVSUM(4,DISP,VHEP(1,IHEP),VHEP(1,IHEP)) + IF (IEND(2).GT.IJT+1) ISTHEP(IJT+1)=100 + ISTHEP(IJET(1))=ISTHEP(IJET(1))+10 + CALL HWVSUM(2,PHEP(3,IPAR(1)),PHEP(3,IJT),PHEP(3,ICM)) + ELSE + PHEP(4,ICM)=SQRT(PTX**2+PTY**2+PHEP(3,ICM)**2+PHEP(5,ICM)**2) +C---NOW BOOST TO REQUIRED Q**2 AND X-F + PP0=PHEP(4,ICM)+PHEP(3,ICM) + PM0=PHEP(4,ICM)-PHEP(3,ICM) + ET0=(PP0*PM0)+ET(1)-ET(2) + DET=ET0**2-4.*(PP0*PM0)*ET(1) + IF (DET.LT.ZERO) THEN + FROST=.TRUE. + RETURN + ENDIF + DET=SQRT(DET)+ET0 + AL(1)= 2.*PM0*PP(1)/DET + AL(2)=(PM0/PP(2))*(1.-2.*ET(1)/DET) + PB(1)=0. + PB(2)=0. + PB(5)=2. + DO 160 IP=1,2 + PB(3)=AL(IP)-(1./AL(IP)) + PB(4)=AL(IP)+(1./AL(IP)) + IJT=IJET(IP) + DO 140 IHEP=IJT,IEND(IP) + CALL HWULOF(PB,PHEP(1,IHEP),PHEP(1,IHEP)) + CALL HWULF4(PB,VHEP(1,IHEP),VHEP(1,IHEP)) + 140 ISTHEP(IHEP)=ISTHEP(IHEP)+10 + CALL HWVDIF(4,VHEP(1,IPAR(IP)),VHEP(1,IJT),DISP) + DO 150 IHEP=IJT,IEND(IP) + 150 CALL HWVSUM(4,DISP,VHEP(1,IHEP),VHEP(1,IHEP)) + IF (IEND(IP).GT.IJT+1) THEN + ISTHEP(IJT+1)=100 + ELSEIF (IEND(IP).EQ.IJT) THEN +C---NON-PARTON JET + ISTHEP(IJT)=3 + ENDIF + 160 CONTINUE + ENDIF + ISTHEP(ICM)=120 + ELSE +C---TIMELIKE JETS +C special for DIS: preserve outgoing lepton momentum + IF (DISPRO) THEN + CALL HWVEQU(5,PHEP(1,IPAR(1)),PHEP(1,IJET(1))) + ISTHEP(IJET(1))=1 + LP=2 + ELSE + CALL HWVEQU(5,PHEP(1,ICM),PC) +C--- PQ AND PC ARE OLD AND NEW PARTON CM + CALL HWVSUM(4,PHEP(1,IPAR(1)),PHEP(1,IPAR(2)),PQ) + PQ(5)=PHEP(5,ICM) + IF (NP.GT.2) THEN + DO 170 KP=3,NP + 170 CALL HWVSUM(4,PHEP(1,IPAR(KP)),PQ,PQ) + ENDIF + LP=1 + ENDIF + IF (.NOT.DISLOW) THEN +C---FIND JET CM MOMENTA + ECM=PQ(5) + EMS=0. + JETRAD=.FALSE. + DO 180 KP=LP,NP + EMJ=PHEP(5,IJET(KP)) + EMP=PHEP(5,IPAR(KP)) + JETRAD=JETRAD.OR.EMJ.NE.EMP + EMS=EMS+EMJ + PM(KP)= EMJ**2 +C---N.B. ROUNDING ERRORS HERE AT HIGH ENERGIES + PJ(KP)=(HWULDO(PHEP(1,IPAR(KP)),PQ)/ECM)**2-EMP**2 + IF (PJ(KP).LE.ZERO) CALL HWWARN('HWBJCO',104,*999) + 180 CONTINUE + PF=1. + IF (JETRAD) THEN +C---JETS DID RADIATE + IF (EMS.GE.ECM) THEN + FROST=.TRUE. + RETURN + ENDIF + DO 200 NE=1,NETRY + EMS=-ECM + DMS=0. + DO 190 KP=LP,NP + ES=SQRT(PF*PJ(KP)+PM(KP)) + EMS=EMS+ES + 190 DMS=DMS+PJ(KP)/ES + DPF=2.*EMS/DMS + IF (DPF.GT.PF) DPF=0.9*PF + PF=PF-DPF + 200 IF (ABS(DPF).LT.EPS) GOTO 210 + CALL HWWARN('HWBJCO',105,*999) + ENDIF + 210 CONTINUE + ENDIF +C---BOOST PC AND PQ TO BREIT FRAME IF NECESSARY + IF (DISPRO.AND.BREIT) THEN + CALL HWULOF(PBR,PC,PC) + CALL HWUROF(RBR,PC,PC) + IF (.NOT.DISLOW) THEN + CALL HWULOF(PBR,PQ,PQ) + CALL HWUROF(RBR,PQ,PQ) + ENDIF + ENDIF + DO 230 IP=LP,NP +C---FIND CM ROTATION FOR JET IP + IF (.NOT.DISLOW) THEN + CALL HWVEQU(4,PHEP(1,IPAR(IP)),PR) + IF (DISPRO.AND.BREIT) THEN + CALL HWULOF(PBR,PR,PR) + CALL HWUROF(RBR,PR,PR) + ENDIF + CALL HWULOF(PQ,PR,PR) + CALL HWUROT(PR, ONE,ZERO,RR) + PR(1)=0. + PR(2)=0. + PR(3)=SQRT(PF*PJ(IP)) + PR(4)=SQRT(PF*PJ(IP)+PM(IP)) + PR(5)=PHEP(5,IJET(IP)) + CALL HWUROB(RR,PR,PR) + CALL HWULOB(PC,PR,PR) + ELSE + CALL HWVEQU(5,PC,PR) + ENDIF +C---NOW PR IS LAB/BREIT MOMENTUM OF JET IP + KP=IJET(IP)+1 + IF (AZCOR.AND.KP.LE.NHEP.AND.IDHW(KP).EQ.17) THEN +C---ALIGN CONE WITH INTERFERING PARTON + CALL HWUROT(PR, ONE,ZERO,RS) + JP=JMOHEP(2,KP) + IF (JP.EQ.0) THEN + CALL HWWARN('HWBJCO',2,*999) + PTINF=0. + ELSE + CALL HWVEQU(4,PHEP(1,JP),PS) + IF (DISPRO.AND.BREIT) THEN + CALL HWULOF(PBR,PS,PS) + CALL HWUROF(RBR,PS,PS) + ENDIF + CALL HWUROF(RS,PS,PS) + PTINF=PS(1)**2+PS(2)**2 + IF (PTINF.LT.EPS) THEN +C---COLLINEAR JETS: ALIGN CONES + JP=JDAHEP(1,JP)+1 + IF (ISTHEP(JP).EQ.100.AND.ISTHEP(JP-1)/10.EQ.14) THEN + CALL HWVEQU(4,PHEP(1,JP),PS) + IF (DISPRO.AND.BREIT) THEN + CALL HWULOF(PBR,PS,PS) + CALL HWUROF(RBR,PS,PS) + ENDIF + CALL HWUROF(RS,PS,PS) + PTINF=PS(1)**2+PS(2)**2 + ELSE + PTINF=0. + ENDIF + ENDIF + ENDIF + CALL HWVEQU(4,PHEP(1,KP),PB) + IF (DISPRO.AND.BREIT) THEN + CALL HWULOF(PBR,PB,PB) + CALL HWUROF(RBR,PB,PB) + ENDIF + PTCON=PB(1)**2+PB(2)**2 + IF (PTCON.NE.ZERO.AND.PTINF.NE.ZERO) THEN + CN=1./SQRT(PTINF*PTCON) + CP=CN*(PS(1)*PB(1)+PS(2)*PB(2)) + SP=CN*(PS(1)*PB(2)-PS(2)*PB(1)) + ELSE + CALL HWRAZM( ONE,CP,SP) + ENDIF + ELSE + CALL HWRAZM( ONE,CP,SP) + ENDIF + CALL HWUROT(PR,CP,SP,RS) +C---FIND BOOST FOR JET IP + ALF=(PHEP(3,IJET(IP))+PHEP(4,IJET(IP)))/ + & (PR(4)+SQRT((PR(4)+PR(5))*(PR(4)-PR(5)))) + PB(1)=0. + PB(2)=0. + PB(3)=ALF-(1./ALF) + PB(4)=ALF+(1./ALF) + PB(5)=2. + IHEP=IJET(IP) + KHEP=JDAHEP(2,IHEP) + IF (KHEP.LT.IHEP) KHEP=IHEP + DO 220 JHEP=IHEP,KHEP + CALL HWULOF(PB,PHEP(1,JHEP),PHEP(1,JHEP)) + CALL HWUROB(RS,PHEP(1,JHEP),PHEP(1,JHEP)) + CALL HWULF4(PB,VHEP(1,JHEP),VHEP(1,JHEP)) + CALL HWUROB(RS,VHEP(1,JHEP),VHEP(1,JHEP)) +C---BOOST FROM BREIT FRAME IF NECESSARY + IF (DISPRO.AND.BREIT) THEN + CALL HWUROB(RBR,PHEP(1,JHEP),PHEP(1,JHEP)) + CALL HWULOB(PBR,PHEP(1,JHEP),PHEP(1,JHEP)) + CALL HWUROB(RBR,VHEP(1,JHEP),VHEP(1,JHEP)) + CALL HWULB4(PBR,VHEP(1,JHEP),VHEP(1,JHEP)) + ENDIF + CALL HWVSUM(4,VHEP(1,JHEP),VHEP(1,IPAR(IP)),VHEP(1,JHEP)) + 220 ISTHEP(JHEP)=ISTHEP(JHEP)+10 + IF (KHEP.GT.IHEP+1) THEN + ISTHEP(IHEP+1)=100 + ELSEIF (KHEP.EQ.IHEP) THEN +C---NON-PARTON JET + ISTHEP(IHEP)=190 + ENDIF + 230 CONTINUE + IF (ISTHEP(ICM).EQ.110) ISTHEP(ICM)=120 + ENDIF + GOTO 20 + 999 END +CDECK ID>, HWBMAS. +*CMZ :- -26/04/91 11.11.54 by Bryan Webber +*-- Author : Bryan Webber +C----------------------------------------------------------------------- + SUBROUTINE HWBMAS +C----------------------------------------------------------------------- +C Passes backwards through a jet cascade calculating the masses +C and magnitudes of the longitudinal and transverse three momenta. +C Components given relative to direction of parent for a time-like +C vertex and with respect to z-axis for space-like vertices. +C +C On input PPAR(1-5,*) contains: +C (E*sqrt(Xi),Xi,3-mom (if external),E,M-sq (if external)) +C +C On output PPAR(1-5,*) (if TMPAR(*)), containts: +C (P-trans,Xi or Xilast,P-long,E,M) +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + DOUBLE PRECISION HWUSQR,EXI,PISQ,PJPK,EJEK,PTSQ,Z,ZMIN,ZMAX, + $ EMI,EMJ,EMK,C,NQ,HWBVMC,RHO,POLD,PNEW,EOLD,ENEW,A,B + INTEGER IPAR,JPAR,KPAR,MPAR,I,J,K + EXTERNAL HWUSQR + IF (IERROR.NE.0) RETURN + IF (NPAR.GT.2) THEN + DO 30 MPAR=NPAR-1,3,-2 + JPAR=MPAR +C Find parent and partner of this branch + IPAR=JMOPAR(1,JPAR) + KPAR=JPAR+1 +C Determine type of branching + IF (TMPAR(IPAR)) THEN +C Time-like branching +C Compute mass of parent + EXI=PPAR(1,JPAR)*PPAR(1,KPAR) + PPAR(5,IPAR)=PPAR(5,JPAR)+PPAR(5,KPAR)+2.*EXI +C Compute three momentum of parent + PISQ=PPAR(4,IPAR)*PPAR(4,IPAR)-PPAR(5,IPAR) + PPAR(3,IPAR)=HWUSQR(PISQ) +C---SPECIAL FOR G-->QQBAR: READJUST ANGULAR DISTRIBUTION + IF (IDPAR(IPAR).EQ.13 .AND. IDPAR(JPAR).LT.13) THEN + Z=PPAR(4,JPAR)/PPAR(4,IPAR) + ZMIN=HWBVMC(IDPAR(JPAR))/PPAR(1,JPAR)*Z + RHO=(Z*(3-Z*(3-2*Z))-ZMIN*(3-ZMIN*(3-2*ZMIN))) + $ /(2*(1-2*ZMIN)*(1-ZMIN*(1-ZMIN))) + NQ=PPAR(3,IPAR)*(PPAR(3,IPAR)+PPAR(4,IPAR)) + EMI=PPAR(5,IPAR) + EMJ=PPAR(5,JPAR) + EMK=PPAR(5,KPAR) + ZMIN=MAX((EMI+EMJ-EMK)/(2*(EMI+NQ)), + $ (EMI+EMJ-EMK-SQRT((EMI-EMJ-EMK)**2-4*EMJ*EMK))/(2*EMI)) + ZMAX=1-MAX((EMI-EMJ+EMK)/(2*(EMI+NQ)), + $ (EMI-EMJ+EMK-SQRT((EMI-EMJ-EMK)**2-4*EMJ*EMK))/(2*EMI)) + C=2*RMASS(IDPAR(JPAR))**2/EMI + Z=(4*ZMIN*(1.5*(1+C-ZMIN)+ZMIN**2)*(1-RHO) + $ +4*ZMAX*(1.5*(1+C-ZMAX)+ZMAX**2)*RHO-2-3*C)/(1+2*C)**1.5 + Z=SQRT(1+2*C)*SINH(LOG(Z+SQRT(Z**2+1))/3)+0.5 + Z=(Z*NQ+(EMI+EMJ-EMK)/2)/(NQ+EMI) + PPAR(4,JPAR)=Z*PPAR(4,IPAR) + PPAR(4,KPAR)=PPAR(4,IPAR)-PPAR(4,JPAR) + PPAR(3,JPAR)=HWUSQR(PPAR(4,JPAR)**2-EMJ) + PPAR(3,KPAR)=HWUSQR(PPAR(4,KPAR)**2-EMK) + PPAR(2,JPAR)=EXI/(PPAR(4,JPAR)*PPAR(4,KPAR)) + IF(JDAPAR(2,JPAR).NE.0)PPAR(2,JDAPAR(2,JPAR))=PPAR(2,JPAR) + IF(JDAPAR(2,KPAR).NE.0)PPAR(2,JDAPAR(2,KPAR))=PPAR(2,JPAR) +C---FIND DESCENDENTS OF THIS SPLITTING AND READJUST THEIR MOMENTA TOO + DO 20 J=JPAR+2,NPAR-1,2 + I=J + 10 I=JMOPAR(1,I) + IF (I.GT.IPAR) GOTO 10 + IF (I.EQ.IPAR) THEN + I=JMOPAR(1,J) + K=J+1 + POLD=PPAR(3,J)+PPAR(3,K) + EOLD=PPAR(4,J)+PPAR(4,K) + PNEW=HWUSQR(PPAR(4,I)**2-PPAR(5,I)) + ENEW=PPAR(4,I) + A=(ENEW*EOLD-PNEW*POLD)/PPAR(5,I) + B=(PNEW*EOLD-ENEW*POLD)/PPAR(5,I) + PPAR(3,J)=A*PPAR(3,J)+B*PPAR(4,J) + PPAR(4,J)=(PPAR(4,J)+B*PPAR(3,J))/A + PPAR(3,K)=PNEW-PPAR(3,J) + PPAR(4,K)=ENEW-PPAR(4,J) + PPAR(2,J)=1-(PPAR(3,J)*PPAR(3,K)+PPAR(1,J)*PPAR(1,K)) + $ /(PPAR(4,J)*PPAR(4,K)) + IF (JDAPAR(2,J).NE.0) PPAR(2,JDAPAR(2,J))=PPAR(2,J) + IF (JDAPAR(2,K).NE.0) PPAR(2,JDAPAR(2,K))=PPAR(2,J) + ENDIF + 20 CONTINUE + ENDIF +C Compute daughter' transverse and longitudinal momenta + PJPK=PPAR(3,JPAR)*PPAR(3,KPAR) + EJEK=PPAR(4,JPAR)*PPAR(4,KPAR)-EXI + PTSQ=(PJPK+EJEK)*(PJPK-EJEK)/PISQ + PPAR(1,JPAR)=HWUSQR(PTSQ) + PPAR(3,JPAR)=HWUSQR(PPAR(3,JPAR)*PPAR(3,JPAR)-PTSQ) + PPAR(1,KPAR)=-PPAR(1,JPAR) + PPAR(3,KPAR)= PPAR(3,IPAR)-PPAR(3,JPAR) + ELSE +C Space-like branching +C Re-arrange such that JPAR is time-like + IF (TMPAR(KPAR)) THEN + KPAR=JPAR + JPAR=JPAR+1 + ENDIF +C Compute time-like branch + PTSQ=(2.-PPAR(2,JPAR))*PPAR(1,JPAR)*PPAR(1,JPAR) + & -PPAR(5,JPAR) + PPAR(1,JPAR)=HWUSQR(PTSQ) + PPAR(3,JPAR)=(1.-PPAR(2,JPAR))*PPAR(4,JPAR) + PPAR(3,IPAR)=PPAR(3,KPAR)-PPAR(3,JPAR) + PPAR(5,IPAR)=0. + PPAR(1,KPAR)=0. + ENDIF +C Reset Xi to Xilast + PPAR(2,KPAR)=PPAR(2,IPAR) + 30 CONTINUE + ENDIF + DO 40 IPAR=2,NPAR + 40 PPAR(5,IPAR)=HWUSQR(PPAR(5,IPAR)) + PPAR(1,2)=0. + PPAR(2,2)=0. + END +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 +CDECK ID>, HWBRC2. +*CMZ :- -20/07/99 10:56:12 by Peter Richardson +*-- Author : Peter Richardson +C----------------------------------------------------------------------- + SUBROUTINE HWBRC2(COLP,IHEP,JC,CON,BVVUSE,BVVHRD) +C----------------------------------------------------------------------- +C--Function to search in the jet for the particle +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + INTEGER JC,JD,QHEP,LHEP,IHEP,JHEP,IDM,NCOUNT,ID,IP,IDM2,COLP + LOGICAL CON,BVVUSE,FLA,AFLA,BVVHRD + FLA(IP) = (IP.LE.6.OR.(IP.GE.115.AND.IP.LE.120). + & OR.(IP.GE.401.AND.IP.LE.406). + & OR.(IP.GE.413.AND.IP.LE.418)) + AFLA(IP) = ((IP.LE.12.AND.IP.GE.7).OR.(IP.GE.109.AND.IP.LE.114). + & OR.(IP.GE.407.AND.IP.LE.412). + & OR.(IP.GE.419.AND.IP.LE.424)) + ID = IDHW(IHEP) + COLP = 0 +C--begining and end of jet + IF(JDAHEP(1,JC).NE.0) THEN + JC=JDAHEP(1,JC) + JD=JDAHEP(2,JC) + ELSE + COLP = JC + RETURN + ENDIF + IF (JD.LT.JC) JD=JC + LHEP=0 + IF(CON) THEN +C--SEARCH FOR A COLOUR PARTNER + DO 110 JHEP=JC,JD + IDM = IDHW(JHEP) + IF (ISTHEP(JHEP).LT.145.OR.ISTHEP(JHEP).GT.152) GOTO 110 + IF(AFLA(ID).AND.IDM.EQ.13) GOTO 110 + IF (JDAHEP(2,JHEP).EQ.IHEP) LHEP=JHEP + IF ((BVVUSE.AND.JMOHEP(2,JHEP).NE.0).OR. + & (.NOT.BVVUSE.AND.JDAHEP(2,JHEP).NE.0)) GOTO 110 + IF(BVVUSE.AND.ABS(IDHEP(JHEP)).GT.1000000) THEN + IF(BVVHRD.AND.AFLA(ID)) THEN + CONTINUE + ELSE + RETURN + ENDIF + ENDIF + IF(BVVUSE.AND.( + & ((FLA(ID).OR.ID.EQ.13.OR.ID.EQ.449).AND.AFLA(IDM)). + & OR.(AFLA(ID).AND.(FLA(IDM).OR.IDM.EQ.13.OR.IDM.EQ.449)))) + & GOTO 110 + IF(AFLA(ID).AND.(IDM.EQ.59.OR.IDM.EQ.449.OR.IDM.EQ.13)) GOTO 110 +C---JOIN IHEP AND JHEP + COLP=JHEP + IF(BVVUSE.OR.(ID.GE.7.AND.ID.LE.12. + & AND.((IDM.GE.7.AND.IDM.LE.12)))) RETURN + IF(IHEP.NE.HRDCOL(1,2).AND. + & (((FLA(ID).OR.ID.EQ.13.OR.ID.EQ.449.OR.ID.EQ.59) + & .AND.(AFLA(IDM).OR.IDM.EQ.13.OR.IDM.EQ.449.OR.IDM.EQ.59)) + & .OR.(AFLA(ID).AND.(FLA(IDM).OR.IDM.EQ.59)))) + & JDAHEP(2,JHEP)=IHEP + RETURN + 110 CONTINUE + IF (LHEP.NE.0) COLP=LHEP +C--Additional Baryon number violating piece + IF(COLP.EQ.0) THEN + IDM2= IDHW(JC) + IF(JMOHEP(1,JC).LT.6) THEN + IF(IDM2.LE.6) THEN + IDM2= IDM2+6 + ELSEIF(IDM2.GT.6) THEN + IDM2=IDM2-6 + ENDIF + ENDIF + IF(IHEP.EQ.HRDCOL(1,2).OR. + & ((FLA(ID).OR.ID.EQ.13.OR.ID.EQ.449.OR.ID.EQ.15.OR.ID.EQ.59) + & .AND.(AFLA(IDM2).OR.IDM2.EQ.13.OR.IDM2.EQ.13))) THEN + QHEP = JD+1 + 12 QHEP = QHEP-1 + IF(IDHEP(QHEP).EQ.0) GOTO 12 + IF(IDHW(QHEP).EQ.59) THEN + IF(JC.EQ.JD.AND.IDHW(JMOHEP(1,QHEP)).EQ.59) THEN + COLP = IHEP + RETURN + ELSE + GOTO 12 + ENDIF + ENDIF + NCOUNT = 0 + 11 IF(JDAHEP(2,QHEP).NE.0) THEN + IF(JMOHEP(2,JDAHEP(2,QHEP)).EQ.QHEP.AND. + & JDAHEP(2,QHEP).NE.QHEP) THEN + IF(JDAHEP(2,QHEP).GE.JC.AND.JDAHEP(2,QHEP).LE.JD) THEN + QHEP = JDAHEP(2,QHEP) + NCOUNT = NCOUNT+1 + IF(NCOUNT.LT.NHEP) GOTO 11 + ENDIF + ENDIF + ENDIF + ELSE + QHEP = JC + 13 QHEP = QHEP+1 + IF(IDHEP(QHEP).EQ.0) GOTO 13 + IF(IDHW(QHEP).EQ.59) THEN + IF(JC.EQ.JD.AND.IDHW(JMOHEP(1,QHEP)).EQ.59) THEN + COLP = IHEP + RETURN + ELSE + GOTO 13 + ENDIF + ENDIF + NCOUNT = 0 + 9 IF(JMOHEP(2,QHEP).NE.0) THEN + IF(JDAHEP(2,JMOHEP(2,QHEP)).EQ.QHEP.AND. + & JMOHEP(2,QHEP).NE.QHEP) THEN + IF(JMOHEP(2,QHEP).GE.JC.AND.JMOHEP(2,QHEP).LE.JD) THEN + QHEP = JMOHEP(2,QHEP) + NCOUNT = NCOUNT+1 + IF(NCOUNT.LT.NHEP) GOTO 9 + ENDIF + ENDIF + ENDIF + ENDIF + IF(ABS(IDHEP(QHEP)).LT.1000000) COLP=QHEP + ENDIF + ELSE +C--Search for an anticolour partner + DO 210 JHEP=JC,JD + IF (ISTHEP(JHEP).LT.145.OR.ISTHEP(JHEP).GT.152) GOTO 210 + IF (JMOHEP(2,JHEP).EQ.IHEP) LHEP=JHEP + IF (JMOHEP(2,JHEP).NE.0) GOTO 210 +C---JOIN IHEP AND JHEP + COLP=JHEP + RETURN + 210 CONTINUE + IF (LHEP.NE.0) COLP=LHEP +C--New piece + IF(COLP.EQ.0) THEN + IDM2=IDHW(JC) + IF(JMOHEP(1,JC).LT.6) THEN + IF(IDM2.LE.6) THEN + IDM2= IDM2+6 + ELSEIF(IDM2.GT.6) THEN + IDM2=IDM2-6 + ENDIF + ENDIF +C--Additional Baryon number violating piece + IF((FLA(ID).AND.AFLA(IDM2)).OR. + & ((AFLA(ID).OR.ID.EQ.13.OR.ID.EQ.449.OR.ID.EQ.15.OR.ID.EQ.59) + & .AND.(FLA(IDM2).OR.IDM2.EQ.13.OR.IDM2.EQ.449))) THEN + QHEP = JC + 211 QHEP = QHEP+1 + IF(IDHEP(QHEP).EQ.0) GOTO 211 + IF(IDHW(QHEP).EQ.59) THEN + IF(JC.EQ.JD.AND.IDHW(JMOHEP(1,QHEP)).EQ.59) THEN + COLP = IHEP + RETURN + ELSE + GOTO 211 + ENDIF + ENDIF + NCOUNT = 0 + 209 IF(JMOHEP(2,QHEP).NE.0) THEN + IF(JDAHEP(2,JMOHEP(2,QHEP)).EQ.QHEP.AND. + & JMOHEP(2,QHEP).NE.QHEP) THEN + IF(JMOHEP(2,QHEP).GE.JC.AND.JMOHEP(2,QHEP).LE.JD) THEN + QHEP = JMOHEP(2,QHEP) + NCOUNT = NCOUNT+1 + IF(NCOUNT.LT.NHEP) GOTO 209 + ENDIF + ENDIF + ENDIF + IF(QHEP.NE.0) COLP=QHEP + IF(JDAHEP(2,QHEP).EQ.0.AND.IHEP.NE.6) THEN + IDM2= IDHW(QHEP) + IF(FLA(IHEP).AND.FLA(QHEP).OR. + & ((AFLA(IHEP).OR.ID.EQ.13.OR.ID.EQ.449).AND. + & (AFLA(QHEP).OR.IDM2.EQ.13.OR.IDM2.EQ.449))) + & JDAHEP(2,QHEP)=IHEP + ENDIF + ELSE + QHEP = JD+1 + 220 QHEP = QHEP-1 + IF(IDHEP(QHEP).EQ.0) GOTO 220 + IF(IDHW(QHEP).EQ.59) THEN + IF(JC.EQ.JD.AND.IDHW(JMOHEP(1,QHEP)).EQ.59) THEN + COLP = IHEP + RETURN + ELSE + GOTO 220 + ENDIF + ENDIF + NCOUNT = 0 + 219 IF(JDAHEP(2,QHEP).NE.0) THEN + IF(JMOHEP(2,JDAHEP(2,QHEP)).EQ.QHEP) THEN + IF(JDAHEP(2,QHEP).GE.JC.AND.JDAHEP(2,QHEP).LE.JD) THEN + QHEP = JDAHEP(2,QHEP) + NCOUNT = NCOUNT+1 + IF(NCOUNT.LT.200) GOTO 219 + ENDIF + ENDIF + ENDIF + IF(QHEP.NE.0) COLP=QHEP + IDM2 = IDHW(QHEP) + IF(JDAHEP(2,QHEP).EQ.0.AND. + & (((AFLA(ID).OR.ID.EQ.13).AND.(AFLA(IDM2).OR.IDM2.EQ.13)).OR. + & (FLA(ID).AND.FLA(IDM2)))) JDAHEP(2,QHEP)=IHEP + ENDIF + ENDIF + ENDIF + END +CDECK ID>, HWBSPA. +*CMZ :- -26/04/91 14.26.44 by Federico Carminati +*-- Author : Ian Knowles +C----------------------------------------------------------------------- + SUBROUTINE HWBSPA +C----------------------------------------------------------------------- +C Constructs time-like 4-momenta & production vertices in space-like +C jet started by parton no.2 interference partner 1 and spin density +C DECPAR(2). RHOPAR(2) gives the jet spin density matrix. +C See I.G. Knowles, Comp. Phys. Comm. 58 (90) 271. +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + DOUBLE PRECISION HWR,DMIN,PT,EIKON,EISCR,EINUM,EIDEN1,EIDEN2, + & WT,SPIN,Z1,Z2,TR,PRMAX,CX,SX,CAZ,ROHEP(3),RMAT(3,3),ZERO2(2) + INTEGER JPAR,KPAR,LPAR,MPAR + LOGICAL EICOR + EXTERNAL HWR + DATA ZERO2,DMIN/ZERO,ZERO,1.D-15/ + IF (IERROR.NE.0) RETURN + JPAR=2 + KPAR=1 + IF (NPAR.EQ.2) THEN + CALL HWVZRO(2,RHOPAR(1,2)) + RETURN + ENDIF +C Generate azimuthal angle of JPAR's branching using an M-function +C Find the daughters of JPAR, with LPAR time-like + 10 LPAR=JDAPAR(1,JPAR) + IF (TMPAR(LPAR)) THEN + MPAR=LPAR+1 + ELSE + MPAR=LPAR + LPAR=MPAR+1 + ENDIF +C Soft correlations + CALL HWUROT(PPAR(1,JPAR), ONE,ZERO,RMAT) + CALL HWUROF(RMAT,PPAR(1,KPAR),ROHEP) + PT=MAX(SQRT(ROHEP(1)*ROHEP(1)+ROHEP(2)*ROHEP(2)),DMIN) + EIKON=1. + EICOR=AZSOFT.AND.IDPAR(LPAR).EQ.13 + IF (EICOR) THEN + EISCR=1.-PPAR(5,MPAR)*PPAR(5,MPAR)/(MIN(PPAR(2,LPAR), + & PPAR(2,MPAR))*PPAR(4,MPAR)*PPAR(4,MPAR)) + EINUM=PPAR(4,KPAR)*PPAR(4,LPAR)*ABS(PPAR(2,LPAR)-PPAR(2,MPAR)) + EIDEN1=PPAR(4,KPAR)*PPAR(4,LPAR)-ROHEP(3)*PPAR(3,LPAR) + EIDEN2=PT*ABS(PPAR(1,LPAR)) + EIKON=MAX(EISCR+EINUM/MAX(EIDEN1-EIDEN2,DMIN),ZERO) + ENDIF +C Spin correlations + WT=0. + SPIN=1. + IF (AZSPIN.AND.IDPAR(JPAR).EQ.13) THEN + Z1=PPAR(4,JPAR)/PPAR(4,MPAR) + Z2=1.-Z1 + IF (IDPAR(MPAR).EQ.13) THEN + TR=Z1/Z2+Z2/Z1+Z1*Z2 + ELSEIF (IDPAR(MPAR).LT.13) THEN + TR=(Z1*Z1+Z2*Z2)/2. + ENDIF + WT=Z2/(Z1*TR) + ENDIF +C Assign the azimuthal angle + PRMAX=(1.+ABS(WT))*EIKON + 50 CALL HWRAZM( ONE,CX,SX) + CALL HWUROT(PPAR(1,JPAR),CX,SX,RMAT) +C Determine the angle between the branching planes + CALL HWUROF(RMAT,PPAR(1,KPAR),ROHEP) + CAZ=ROHEP(1)/PT + PHIPAR(1,JPAR)=2.*CAZ*CAZ-1. + PHIPAR(2,JPAR)=2.*CAZ*ROHEP(2)/PT + IF (EICOR) EIKON=MAX(EISCR+EINUM/MAX(EIDEN1-EIDEN2*CAZ,DMIN),ZERO) + IF (AZSPIN) SPIN=1.+WT*(DECPAR(1,JPAR)*PHIPAR(1,JPAR) + & +DECPAR(2,JPAR)*PHIPAR(2,JPAR)) + IF (SPIN*EIKON.LT.HWR()*PRMAX) GOTO 50 +C Construct full 4-momentum of LPAR, sum P-trans of MPAR + PPAR(2,LPAR)=0. + PPAR(2,MPAR)=0. + CALL HWUROB(RMAT,PPAR(1,LPAR),PPAR(1,LPAR)) + CALL HWVDIF(2,PPAR(1,2),PPAR(1,LPAR),PPAR(1,2)) +C Test for end of space-like branches + IF (JDAPAR(1,MPAR).EQ.0) GOTO 60 +C Generate new Decay matrix + CALL HWBAZF(MPAR,JPAR,ZERO2,DECPAR(1,JPAR), + & PHIPAR(1,JPAR),DECPAR(1,MPAR)) +C Advance along the space-like branch + JPAR=MPAR + KPAR=LPAR + GOTO 10 +C Retreat along space-like line +C Assign initial spin density matrix + 60 CALL HWVEQU(2,ZERO2,RHOPAR(1,MPAR)) + CALL HWUMAS(PPAR(1,2)) + CALL HWVZRO(4,VPAR(1,MPAR)) + 70 CALL HWVEQU(4,VPAR(1,MPAR),VPAR(1,LPAR)) + IF (MPAR.EQ.2) RETURN +C Construct spin density matrix for time-like branch + CALL HWBAZF(MPAR,JPAR,RHOPAR(1,MPAR),PHIPAR(1,JPAR), + & DECPAR(1,JPAR),RHOPAR(1,LPAR)) +C Evolve time-like side branch + CALL HWBTIM(LPAR,MPAR) +C Construct spin density matrix for space-like branch + CALL HWBAZF(MPAR,JPAR,PHIPAR(1,JPAR),RHOPAR(1,MPAR), + & DECPAR(1,LPAR),RHOPAR(1,JPAR)) +C Assign production vertex to J + CALL HWVDIF(4,PPAR(1,MPAR),PPAR(1,LPAR),PPAR(1,JPAR)) + CALL HWUDKL(IDPAR(JPAR),PPAR(1,JPAR),VPAR(1,JPAR)) + CALL HWVSUM(4,VPAR(1,MPAR),VPAR(1,JPAR),VPAR(1,JPAR)) +C Find parent and partner of MPAR + MPAR=JPAR + JPAR=JMOPAR(1,MPAR) + LPAR=MPAR+1 + IF (JMOPAR(1,LPAR).NE.JPAR) LPAR=MPAR-1 + GOTO 70 + END +CDECK ID>, HWBSPN. +*CMZ :- -26/04/91 11.11.54 by Bryan Webber +*-- Author : Ian Knowles +C----------------------------------------------------------------------- + SUBROUTINE HWBSPN +C----------------------------------------------------------------------- +C Constructs appropriate spin density/decay matrix for parton +C in hard subprocess, othwise zero. Assignments based upon +C Comp. Phys. Comm. 58 (1990) 271. +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + DOUBLE PRECISION C,V12,V23,V13,TR,C1,C2,C3,R1(2),R2(2) + INTEGER IST + SAVE R1,R2,V12 + IF (IERROR.NE.0) RETURN + IST=MOD(ISTHEP(NEVPAR),10) +C Assumed partons processed in the order IST=1,2,3,4 + IF (IPROC.GE.100.AND.IPROC.LE.116) THEN +C An e+e- ---> qqbar g event + IF (IDPAR(2).EQ.13) THEN + RHOPAR(1,2)=GPOLN + RHOPAR(2,2)=0. + RETURN + ENDIF + ELSEIF (IPRO.EQ.15.OR.IPRO.EQ.17) THEN + IF (IHPRO.EQ. 7.OR.IHPRO.EQ. 8.OR. + & IHPRO.EQ.10.OR.IHPRO.EQ.11.OR. + & IHPRO.EQ.15.OR.IHPRO.EQ.16.OR. + & (IHPRO.GE.21.AND.IHPRO.LE.31)) THEN +C A hard 2 --- > 2 QCD subprocess involving gluons + IF (IST.EQ.2) THEN + CALL HWVEQU(2,RHOPAR(1,2),R1(1)) + C=GCOEF(2)/GCOEF(1) + DECPAR(1,2)=C*R1(1) + DECPAR(2,2)=C*R1(2) + RETURN + ELSEIF (IST.EQ.3) THEN + CALL HWVEQU(2,RHOPAR(1,2),R2(1)) + V12=R1(1)*R2(1)+R1(2)*R2(2) + TR=1./(GCOEF(1)+GCOEF(2)*V12) + RHOPAR(1,2)= (GCOEF(3)*R1(1)+GCOEF(4)*R2(1))*TR + RHOPAR(2,2)=-(GCOEF(3)*R1(2)+GCOEF(4)*R2(2))*TR + RETURN + ELSEIF (IST.EQ.4) THEN + V13=R1(1)*DECPAR(1,2)+R1(2)*DECPAR(2,2) + V23=R2(1)*DECPAR(1,2)+R2(2)*DECPAR(2,2) + TR=1./(GCOEF(1)+GCOEF(2)*V12+GCOEF(3)*V13+GCOEF(4)*V23) + C1=(GCOEF(2)+GCOEF(5))*TR + C2=(GCOEF(3)+GCOEF(6))*TR + C3=(GCOEF(4)+GCOEF(6))*TR + RHOPAR(1,2)=C1*DECPAR(1,2)+C2*R2(1)+C3*R1(1) + RHOPAR(2,2)=C1*DECPAR(2,2)-C2*R1(2)-C3*R2(2) + RETURN + ENDIF + ENDIF + ELSEIF (IPRO.EQ.16) THEN +C A gluon fusion ---> Higgs event + IF (IST.EQ.2) THEN + DECPAR(1,2)=RHOPAR(1,2) + DECPAR(2,2)=-RHOPAR(2,2) + RETURN + ENDIF + ENDIF + CALL HWVZRO(2,RHOPAR(1,2)) + CALL HWVZRO(2,DECPAR(1,2)) + END +CDECK ID>, HWBSU1. +*CMZ :- -13/07/92 20.15.54 by Mike Seymour +*-- Author : Bryan Webber, modified by Mike Seymour +C----------------------------------------------------------------------- + FUNCTION HWBSU1(ZLOG) +C----------------------------------------------------------------------- +C Z TIMES THE INTEGRAND IN EXPONENT OF QUARK SUDAKOV FORM FACTOR. +C HWBSU1 IS FOR UPPER PART OF Z INTEGRATION REGION +C----------------------------------------------------------------------- + DOUBLE PRECISION HWBSU1,HWBSUL,Z,ZLOG,U + EXTERNAL HWBSUL + Z=EXP(ZLOG) + U=1.-Z + HWBSU1=HWBSUL(Z)*(1.+U*U) + END +CDECK ID>, HWBSU2. +*CMZ :- -13/07/92 20.15.54 by Mike Seymour +*-- Author : Bryan Webber, modified by Mike Seymour +C----------------------------------------------------------------------- + FUNCTION HWBSU2(Z) +C----------------------------------------------------------------------- +C INTEGRAND IN EXPONENT OF QUARK SUDAKOV FORM FACTOR. +C HWBSU2 IS FOR LOWER PART OF Z INTEGRATION REGION +C----------------------------------------------------------------------- + DOUBLE PRECISION HWBSU2,HWBSUL,Z,U + EXTERNAL HWBSUL + U=1.-Z + HWBSU2=HWBSUL(Z)*(1.+Z*Z)/U + END +CDECK ID>, HWBSUD. +*CMZ :- -14/07/92 13.28.23 by Mike Seymour +*-- Author : Bryan Webber +C----------------------------------------------------------------------- + SUBROUTINE HWBSUD +C----------------------------------------------------------------------- +C COMPUTES (OR READS) TABLES OF SUDAKOV FORM FACTORS +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + DOUBLE PRECISION HWUGAU,HWBVMC,HWBSUG,HWBSU1,HWBSU2,G1,G2,QRAT, + & QLAM,POWER,AFAC,QMIN,QFAC,QNOW,ZMIN,ZMAX,Q1,QCOLD,VGOLD,VQOLD, + & RMOLD(6),ACOLD,ZLO,ZHI + INTEGER IQ,IS,L1,L2,L,LL,I,INOLD,NQOLD,NSOLD,NCOLD,NFOLD,SDOLD + EXTERNAL HWUGAU,HWBVMC,HWBSUG,HWBSU1,HWBSU2 + SAVE NQOLD,NSOLD,NCOLD,NFOLD,SDOLD,QCOLD,VGOLD,VQOLD,RMOLD,ACOLD + COMMON/HWSINT/QRAT,QLAM + IF (LRSUD.EQ.0) THEN + POWER=1./FLOAT(NQEV-1) + AFAC=6.*CAFAC/BETAF + QMIN=QG+QG + QFAC=(1.1*QLIM/QMIN)**POWER + SUD(1,1)=1. + QEV(1,1)=QMIN +C--IS=1 FOR GLUON->GLUON+GLUON FORM FACTOR + DO 10 IQ=2,NQEV + QNOW=QFAC*QEV(IQ-1,1) + QLAM=QNOW/QCDL3 + ZMIN=QG/QNOW + QRAT=1./ZMIN + G1=0 + DO 5 I=3,6 + ZLO=ZMIN + ZHI=HALF + IF (I.NE.6) ZLO=MAX(ZLO,QG/RMASS(I+1)) + IF (I.NE.3) ZHI=MIN(ZHI,QG/RMASS(I)) + IF (ZHI.GT.ZLO) G1=G1+HWUGAU(HWBSUG,LOG(ZLO),LOG(ZHI),ACCUR) + 5 CONTINUE + SUD(IQ,1)=EXP(AFAC*G1) + 10 QEV(IQ,1)=QNOW + AFAC=3.*CFFAC/BETAF +C--QUARK FORM FACTORS. +C--IS=2,3,4,5,6,7 FOR U/D,S,C,B,T,V + DO 15 IS=2,NSUD + Q1=HWBVMC(IS) + IF (IS.EQ.7) Q1=HWBVMC(209) + QMIN=Q1+QG + IF (QMIN.GT.QLIM) GOTO 15 + QFAC=(1.1*QLIM/QMIN)**POWER + SUD(1,IS)=1. + QEV(1,IS)=QMIN + DO 14 IQ=2,NQEV + QNOW=QFAC*QEV(IQ-1,IS) + QLAM=QNOW/QCDL3 + ZMIN=QG/QNOW + QRAT=1./ZMIN + ZMAX=QG/QMIN + G1=0 + DO 12 I=3,6 + ZLO=ZMIN + ZHI=ZMAX + IF (I.NE.6) ZLO=MAX(ZLO,QG/RMASS(I+1)) + IF (I.NE.3) ZHI=MIN(ZHI,QG/RMASS(I)) + IF (ZHI.GT.ZLO) G1=G1+HWUGAU(HWBSU1,LOG(ZLO),LOG(ZHI),ACCUR) + 12 CONTINUE + ZMIN=Q1/QNOW + QRAT=1./ZMIN + ZMAX=Q1/QMIN + G2=0 + DO 13 I=3,6 + ZLO=ZMIN + ZHI=ZMAX + IF (I.NE.6) ZLO=MAX(ZLO,Q1/RMASS(I+1)) + IF (I.NE.3) ZHI=MIN(ZHI,Q1/RMASS(I)) + IF (ZHI.GT.ZLO) G2=G2+HWUGAU(HWBSU2,ZLO,ZHI,ACCUR) + 13 CONTINUE + SUD(IQ,IS)=EXP(AFAC*(G1+G2)) + 14 QEV(IQ,IS)=QNOW + 15 CONTINUE + QCOLD=QCDLAM + VGOLD=VGCUT + VQOLD=VQCUT + ACOLD=ACCUR + INOLD=INTER + NQOLD=NQEV + NSOLD=NSUD + NCOLD=NCOLO + NFOLD=NFLAV + SDOLD=SUDORD + DO 16 IS=1,NSUD + 16 RMOLD(IS)=RMASS(IS) + ELSE + IF (LRSUD.GT.0) THEN + IF (IPRINT.NE.0) WRITE (6,17) LRSUD + 17 FORMAT(10X,'READING SUDAKOV TABLE ON UNIT',I4) + OPEN(UNIT=LRSUD,FORM='UNFORMATTED',STATUS='UNKNOWN') + READ(UNIT=LRSUD) QCOLD,VGOLD,VQOLD,RMOLD, + & ACOLD,QEV,SUD,INOLD,NQOLD,NSOLD,NCOLD,NFOLD,SDOLD + CLOSE(UNIT=LRSUD) + ENDIF +C---CHECK THAT RELEVANT PARAMETERS ARE UNCHANGED + IF (QCDLAM.NE.QCOLD) CALL HWWARN('HWBSUD',501,*999) + IF (VGCUT .NE.VGOLD) CALL HWWARN('HWBSUD',502,*999) + IF (VQCUT .NE.VQOLD) CALL HWWARN('HWBSUD',503,*999) + IF (ACCUR .NE.ACOLD) CALL HWWARN('HWBSUD',504,*999) + IF (INTER .NE.INOLD) CALL HWWARN('HWBSUD',505,*999) + IF (NQEV .NE.NQOLD) CALL HWWARN('HWBSUD',506,*999) + IF (NSUD .NE.NSOLD) CALL HWWARN('HWBSUD',507,*999) + IF (NCOLO .NE.NCOLD) CALL HWWARN('HWBSUD',508,*999) + IF (NFLAV .NE.NFOLD) CALL HWWARN('HWBSUD',509,*999) + IF (SUDORD.NE.SDOLD) CALL HWWARN('HWBSUD',510,*999) +C---CHECK MASSES AND THAT TABLES ARE BIG ENOUGH FOR THIS RUN + DO 18 IS=1,NSUD + IF (RMASS(IS).NE.RMOLD(IS)) + & CALL HWWARN('HWBSUD',510+IS,*999) + IF (QEV(NQEV,IS).LT.QLIM.AND.HWBVMC(IS)+QG.LT.QLIM) + & CALL HWWARN('HWBSUD',500,*999) + 18 CONTINUE + ENDIF + IF (LWSUD.GT.0) THEN + IF (IPRINT.NE.0) WRITE (6,19) LWSUD + 19 FORMAT(10X,'WRITING SUDAKOV TABLE ON UNIT',I4) + OPEN (UNIT=LWSUD,FORM='UNFORMATTED',STATUS='UNKNOWN') + WRITE(UNIT=LWSUD) QCDLAM,VGCUT,VQCUT,(RMASS(I),I=1,6), + & ACCUR,QEV,SUD,INTER,NQEV,NSUD,NCOLO,NFLAV,SUDORD + CLOSE(UNIT=LWSUD) + ENDIF + IF (IPRINT.GT.2) THEN +C--PRINT EXTRACTS FROM TABLES OF FORM FACTORS + DO 40 IS=1,NSUD + WRITE(6,20) IS,NQEV + 20 FORMAT(1H1//10X,'EXTRACT FROM TABLE OF SUDAKOV FORM FACTOR NO.', + & I2,' (',I5,' ACTUAL ENTRIES)'//10X,'SUD IS PROBABILITY THAT', + & ' PARTON WITH GIVEN UPPER LIMIT ON Q WILL REACH THRESHOLD', + & ' WITHOUT BRANCHING'///2X,8(' Q SUD ')/) + L2=NQEV/8 + L1=L2/32 + IF (L1.LT.1) L1=1 + DO 40 L=L1,L2,L1 + LL=L+7*L2 + WRITE(6,30) (QEV(I,IS),SUD(I,IS),I=L,LL,L2) + 30 FORMAT(2X,8(F9.2,F7.4)) + 40 CONTINUE + WRITE(6,50) + 50 FORMAT(1H1) + ENDIF + 999 END +CDECK ID>, HWBSUG. +*CMZ :- -13/07/92 20.15.54 by Mike Seymour +*-- Author : Bryan Webber, modified by Mike Seymour +C----------------------------------------------------------------------- + FUNCTION HWBSUG(ZLOG) +C----------------------------------------------------------------------- +C Z TIMES INTEGRAND IN EXPONENT OF GLUON SUDAKOV FORM FACTOR +C----------------------------------------------------------------------- + DOUBLE PRECISION HWBSUG,HWBSUL,Z,ZLOG,W + EXTERNAL HWBSUL + Z=EXP(ZLOG) + W=Z*(1.-Z) + HWBSUG=HWBSUL(Z)*(W-2.+1./W)*Z + END +CDECK ID>, HWBSUL. +*CMZ :- -13/07/92 20.15.54 by Mike Seymour +*-- Author : Mike Seymour +C----------------------------------------------------------------------- + FUNCTION HWBSUL(Z) +C----------------------------------------------------------------------- +C LOGARITHMIC PART OF INTEGRAND IN EXPONENT OF SUDAKOV FORM FACTOR. +C THE SECOND ORDER ALPHAS CASE COMES FROM CONVERTING INTEGRAL OVER +C Q^2 INTO ONE OVER ALPHAS, WITH FLAVOUR THRESHOLDS. +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + DOUBLE PRECISION HWBSUL,HWUALF,Z,QRAT,QLAM,U,AL,BL,QNOW,QMIN, + & BET(6),BEP(6),MUMI(6),MUMA(6),ALMI(6),ALMA(6),FINT(6),ALFINT, + & MUMIN,MUMAX,ALMIN,ALMAX + INTEGER NF + LOGICAL FIRST + EXTERNAL HWUALF + SAVE FIRST,BET,BEP,MUMI,MUMA + COMMON/HWSINT/QRAT,QLAM + DATA FIRST/.TRUE./ + ALFINT(AL,BL)=1/BET(NF)* + & LOG(BL/(AL*(1+BEP(NF)*BL))*(1+BEP(NF)*AL)) + HWBSUL=0 + U=1.-Z + IF (SUDORD.EQ.1) THEN + AL=LOG(QRAT*Z) + BL=LOG(QLAM*U*Z) + HWBSUL=LOG(1.-AL/BL) + ELSE + IF (FIRST) THEN + DO 10 NF=3,6 + BET(NF)=(11*CAFAC-2*NF)/(12*PIFAC) + BEP(NF)=(17*CAFAC**2-(5*CAFAC+3*CFFAC)*NF)/(24*PIFAC**2) + & /BET(NF) + IF (NF.EQ.3) THEN + MUMI(3)=0 + ALMI(3)=1D30 + ELSE + MUMI(NF)=RMASS(NF) + ALMI(NF)=HWUALF(1,MUMI(NF)) + ENDIF + IF (NF.EQ.6) THEN + MUMA(NF)=1D30 + ALMA(NF)=0 + ELSE + MUMA(NF)=RMASS(NF+1) + ALMA(NF)=HWUALF(1,MUMA(NF)) + ENDIF + IF (NF.NE.3.AND.NF.NE.6) FINT(NF)=ALFINT(ALMI(NF),ALMA(NF)) + 10 CONTINUE + FIRST=.FALSE. + ENDIF + QNOW=QLAM*QCDL3 + QMIN=QNOW/QRAT + MUMIN= U*QMIN + MUMAX=Z*U*QNOW + IF (MUMAX.LE.MUMIN) RETURN + ALMIN=HWUALF(1,MUMIN) + ALMAX=HWUALF(1,MUMAX) + NF=3 + 20 IF (MUMIN.GT.MUMA(NF)) THEN + NF=NF+1 + GOTO 20 + ENDIF + IF (MUMAX.LT.MUMA(NF)) THEN + HWBSUL=ALFINT(ALMIN,ALMAX) + ELSE + HWBSUL=ALFINT(ALMIN,ALMA(NF)) + NF=NF+1 + 30 IF (MUMAX.GT.MUMA(NF)) THEN + HWBSUL=HWBSUL+FINT(NF) + NF=NF+1 + GOTO 30 + ENDIF + HWBSUL=HWBSUL+ALFINT(ALMI(NF),ALMAX) + ENDIF + HWBSUL=HWBSUL*BET(5) + ENDIF + END +CDECK ID>, HWBTIM. +*CMZ :- -26/04/91 14.27.17 by Federico Carminati +*-- Author : Ian Knowles +C----------------------------------------------------------------------- + SUBROUTINE HWBTIM(INITBR,INTERF) +C----------------------------------------------------------------------- +C Constructs full 4-momentum & production vertices in time-like jet +C initiated by INITBR, interference partner INTERF and spin density +C RHOPAR(INITBR). DECPAR(INITBR) returns jet's spin density matrix. +C Includes azimuthal angular correlations between branching planes +C due to spin (if AZSPIN) using the algorithm of Knowles & Collins. +C Ses Nucl. Phys. B304 (1988) 794 & Comp. Phys. Comm. 58 (1990) 271. +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + DOUBLE PRECISION HWR,DMIN,PT,EIKON,EINUM,EIDEN1,EIDEN2,EISCR, + & WT,SPIN,Z1,Z2,PRMAX,CAZ,CX,SX,ROHEP(3),RMAT(3,3),ZERO2(2) + INTEGER INITBR,INTERF,IPAR,JPAR,KPAR,LPAR,MPAR,NTRY,JOLD + LOGICAL EICOR,SWAP + EXTERNAL HWR + DATA ZERO2,DMIN/ZERO,ZERO,1.D-15/ + IF (IERROR.NE.0) RETURN + JPAR=INITBR + KPAR=INTERF + IF ((JDAPAR(1,JPAR).NE.0).OR.(IDPAR(JPAR).EQ.13)) GOTO 30 +C No branching, assign decay matrix + CALL HWVZRO(2,DECPAR(1,JPAR)) + RETURN +C Advance up the leader +C Find the parent and partner of J + 10 IPAR=JMOPAR(1,JPAR) + KPAR=JPAR+1 +C Generate new Rho + IF (JMOPAR(1,KPAR).EQ.IPAR) THEN +C Generate Rho' + CALL HWBAZF(IPAR,JPAR,PHIPAR(1,IPAR),RHOPAR(1,IPAR), + & ZERO2,RHOPAR(1,JPAR)) + ELSE + KPAR=JPAR-1 + IF (JMOPAR(1,KPAR).NE.IPAR) + & CALL HWWARN('HWBTIM',100,*999) +C Generate Rho'' + CALL HWBAZF(IPAR,KPAR,RHOPAR(1,IPAR),PHIPAR(1,IPAR), + & DECPAR(1,KPAR),RHOPAR(1,JPAR)) + ENDIF +C Generate azimuthal angle of J's branching + 30 IF (JDAPAR(1,JPAR).EQ.0) THEN +C Final state gluon + CALL HWVZRO(2,DECPAR(1,JPAR)) + IF (JPAR.EQ.INITBR) RETURN + GOTO 70 + ELSE +C Assign an angle to a branching using an M-function +C Find the daughters of J + LPAR=JDAPAR(1,JPAR) + MPAR=JDAPAR(2,JPAR) +C Soft correlations + CALL HWUROT(PPAR(1,JPAR), ONE,ZERO,RMAT) + CALL HWUROF(RMAT,PPAR(1,KPAR),ROHEP) + PT=MAX(SQRT(ROHEP(1)*ROHEP(1)+ROHEP(2)*ROHEP(2)),DMIN) + EIKON=1. + SWAP=.FALSE. + EICOR=AZSOFT.AND.((IDPAR(LPAR).EQ.13).OR.(IDPAR(MPAR).EQ.13)) + IF (EICOR) THEN +C Rearrange s.t. LPAR is the (softest) gluon + IF (IDPAR(MPAR).EQ.13) THEN + IF (IDPAR(LPAR).NE.13.OR. + & PPAR(4,MPAR).LT.PPAR(4,LPAR)) THEN + SWAP=.TRUE. + LPAR=MPAR + MPAR=LPAR-1 + ENDIF + ENDIF + EINUM=(PPAR(4,KPAR)*PPAR(4,LPAR)) + & *ABS(PPAR(2,LPAR)-PPAR(2,MPAR)) + EIDEN1=(PPAR(4,KPAR)*PPAR(4,LPAR))-ROHEP(3)*PPAR(3,LPAR) + EIDEN2=PT*ABS(PPAR(1,LPAR)) + EISCR=1.-(PPAR(5,MPAR)/PPAR(4,MPAR))**2 + & /MIN(PPAR(2,LPAR),PPAR(2,MPAR)) + EIKON=EISCR+EINUM/MAX(EIDEN1-EIDEN2,DMIN) + ENDIF +C Spin correlations + WT=0. + SPIN=1. + IF (AZSPIN) THEN + Z1=PPAR(4,LPAR)/PPAR(4,JPAR) + Z2=1.-Z1 + IF (IDPAR(JPAR).EQ.13.AND.IDPAR(LPAR).EQ.13) THEN + WT=Z1*Z2/(Z1/Z2+Z2/Z1+Z1*Z2) + ELSEIF (IDPAR(JPAR).EQ.13.AND.IDPAR(LPAR).LT.13) THEN + WT=-2.*Z1*Z2/(Z1*Z1+Z2*Z2) + ENDIF + ENDIF +C Assign the azimuthal angle + PRMAX=(1.+ABS(WT))*EIKON + NTRY=0 + 50 NTRY=NTRY+1 + IF (NTRY.GT.NBTRY) CALL HWWARN('HWBTIM',101,*999) + CALL HWRAZM( ONE,CX,SX) + CALL HWUROT(PPAR(1,JPAR),CX,SX,RMAT) +C Determine the angle between the branching planes + CALL HWUROF(RMAT,PPAR(1,KPAR),ROHEP) + CAZ=ROHEP(1)/PT + PHIPAR(1,JPAR)=2.*CAZ*CAZ-1. + PHIPAR(2,JPAR)=2.*CAZ*ROHEP(2)/PT + IF (EICOR) EIKON=EISCR+EINUM/MAX(EIDEN1-EIDEN2*CAZ,DMIN) + IF (AZSPIN) SPIN=1.+WT*(RHOPAR(1,JPAR)*PHIPAR(1,JPAR) + & +RHOPAR(2,JPAR)*PHIPAR(2,JPAR)) + IF (SPIN*EIKON.LT.HWR()*PRMAX) GOTO 50 +C Construct full 4-momentum of L and M + JOLD=JPAR + IF (SWAP) THEN + PPAR(1,LPAR)=-PPAR(1,LPAR) + PPAR(1,MPAR)=-PPAR(1,MPAR) + JPAR=MPAR + ELSE + JPAR=LPAR + ENDIF + PPAR(2,LPAR)=0. + CALL HWUROB(RMAT,PPAR(1,LPAR),PPAR(1,LPAR)) + PPAR(2,MPAR)=0. + CALL HWUROB(RMAT,PPAR(1,MPAR),PPAR(1,MPAR)) +C Assign production vertex to L and M + CALL HWUDKL(IDPAR(JOLD),PPAR(1,JOLD),VPAR(1,LPAR)) + CALL HWVSUM(4,VPAR(1,JOLD),VPAR(1,LPAR),VPAR(1,LPAR)) + CALL HWVEQU(4,VPAR(1,LPAR),VPAR(1,MPAR)) + ENDIF + 60 IF (JDAPAR(1,JPAR).NE.0) GOTO 10 +C Assign decay matrix + CALL HWVZRO(2,DECPAR(1,JPAR)) +C Backtrack down the leader + 70 IPAR=JMOPAR(1,JPAR) + KPAR=JDAPAR(1,IPAR) + IF (KPAR.EQ.JPAR) THEN +C Develop the side branch + JPAR=JDAPAR(2,IPAR) + GOTO 60 + ELSE +C Construct decay matrix + CALL HWBAZF(IPAR,KPAR,DECPAR(1,JPAR),DECPAR(1,KPAR), + & PHIPAR(1,IPAR),DECPAR(1,IPAR)) + ENDIF + IF (IPAR.EQ.INITBR) RETURN + JPAR=IPAR + GOTO 70 + 999 END +CDECK ID>, HWBTOP. +*CMZ :- -14/10/99 18.04.56 by Mike Seymour +*-- Author : Gennaro Corcella +C----------------------------------------------------------------------- + SUBROUTINE HWBTOP +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + DOUBLE PRECISION HWBVMC,HWR,HWUALF,HWUSQR,X(3),W, + & X3MIN,X3MAX,X1MIN,X1MAX,QSCALE,GLUFAC,R(3,3),M(3), + & E(3),AW,PTSQ,EM,EPS,MASDEP,A,B,C,GAMDEP,LAMBDA, + & PW(5),PT(5),PW1(5),CS,SN,EPG,QQ,RR,CC + INTEGER ID,ID3,IHEP,KHEP,WHEP,ICMF,K + EXTERNAL HWBVMC,HWUALF,HWUSQR,HWR + LAMBDA(A,B,C)=(A**2+B**2+C**2-2*A*B-2*B*C-2*C*A)/(4*A) +C---FIND AN UNTREATED CMF + ICMF=0 + DO 10 IHEP=1,NHEP +C----FIND A DECAYING TOP QUARK + 10 IF (ISTHEP(IHEP).EQ.155.AND.ISTHEP(JDAHEP(1,IHEP)).EQ.113 + & .AND.(IDHW(IHEP).EQ.6.OR.IDHW(IHEP).EQ.12)) + & ICMF=IHEP + IF (ICMF.EQ.0) RETURN + EM=PHEP(5,ICMF) + X3MIN=2*GCUTME/EM +C---GENERATE X(1),X(3) ACCORDING TO 1/((1-X(1))*X(3)**2) + 100 CONTINUE +C-----AW=(MW/MT)**2 + AW=(PHEP(5,JDAHEP(1,ICMF))/EM)**2 +C---CHOOSE X3 + X3MAX=1-AW + X(3)=X3MIN*X3MAX/(X3MIN+(X3MAX-X3MIN)*HWR()) +C--CC, QQ AND RR ARE THE VARIABLE DEFINED IN OUR PAPER +C--IN ORDER TO SOLVE THE CUBIC EQUATION + CC=(1-AW)**2/4 + QQ=(AW**2-4*(1-X(3))*(2-CC-X(3))-2*AW*(3+2*X(3)))/3 + & -((3+2*AW-4*X(3))**2)/9 + RR=((3+2*AW-4*X(3))*(AW**2-4*(1-X(3))*(2-CC-X(3)) + & -2*AW*(3+2*X(3)))-3*(AW*(4-AW)*(2-CC)+(1-CC) + & *(2*(1-X(3))-AW)**2))/6-(ONE/27)*(3+2*AW-4*X(3))**3 +C---CHOOSE X1 + X1MAX=2*(-QQ**3)**(ONE/6)*COS(ACOS(RR/SQRT(-QQ**3))/3) + & -(3+2*AW-4*X(3))/3 + X1MIN=1-X(3)+(AW*X(3))/(1-X(3)) + IF (X1MAX.GE.1.OR.X1MIN.GE.1.OR.X1MAX.LE.X1MIN) GOTO 100 + X(1)=1-(1-X1MAX)*((1-X1MIN)/(1-X1MAX))**HWR() +C---CALCULATE WEIGHT + W=((1+1/AW-2*AW)*((1-AW)*X(3)-(1-X(1))*(1-X(3))-X(3)**2) + & +(1+1/(2*AW))*X(3)*(X(1)+X(3)-1)**2+2*X(3)**2*(1-X(1))) + & *(1/X3MIN-1/X3MAX)*LOG((1-X1MIN)/(1-X1MAX)) +C---QSCALE=DURHAM-LIKE TRANSVERSE MOMENTUM OF THE GLUON + QSCALE=EM*HWUSQR(X(3)*(1-X(1))/(2-X(1)-X(3)-AW)) +C---FACTOR FOR GLUON EMISSION + ID=IDHW(JDAHEP(2,ICMF)) + GLUFAC=0 + IF (QSCALE.GT.HWBVMC(13)) GLUFAC=CFFAC*HWUALF(1,QSCALE) + & /(PIFAC*(1-AW)*(1-2*AW+1/AW)) +C---IN FRACTION GLUFAC*W OF EVENTS ADD A GLUON + IF (GLUFAC*W.GT.HWR()) THEN + ID3=13 + ELSE + RETURN + ENDIF +C---CHECK INFRA-RED CUT-OFF FOR GLUON + M(1)=PHEP(5,JDAHEP(1,ICMF)) + M(2)=HWBVMC(ID) + M(3)=HWBVMC(ID3) + E(1)=HALF*EM*(X(1)+AW+(-M(2)**2-M(3)**2)/EM**2) + E(3)=HALF*EM*X(3) + E(2)=EM-E(1)-E(3) + PTSQ=-LAMBDA(E(1)**2-M(1)**2,E(3)**2-M(3)**2, + & E(2)**2-M(2)**2) + IF (PTSQ.LE.0.OR.E(1).LE.M(1).OR.E(2).LE.M(2).OR.E(3).LE.M(3)) + $ RETURN +C---CALCULATE MASS-DEPENDENT SUPPRESSION + EPS=(RMASS(ID)/EM)**2 + EPG=(RMASS(ID3)/EM)**2 + GAMDEP=(1-AW)*(1+1/AW-2*AW)/(SQRT(1+AW**2+EPS**2 + & -2*AW-2*EPS-2*AW*EPS)*(1+EPS+(1-EPS)**2/AW-2*AW)) + MASDEP=GAMDEP/(1-X(1))*((1+EPS+(1-EPS)**2/AW-2*AW) + & *((1-AW+EPS)*X(3)*(1-X(1))-(1-X(1))**2*(1-X(3)) + & -X(3)**2*(1-X(1)+EPS))+(1+(1+EPS)/(2*AW))*X(3) + & *(1-X(1))*(X(1)+X(3)-1)**2+2*X(3)**2*(1-X(1))**2) + IF (MASDEP.LT.HWR()*((1+1/AW-2*AW)*((1-AW)*X(3) + & -(1-X(1))*(1-X(3))-X(3)**2)+(1+1/(2*AW))*X(3) + & *(X(1)+X(3)-1)**2+2*X(3)**2*(1-X(1)))) RETURN +C---STORE OLD MOMENTA +c---PT = TOP MOMENTUM, PW= W MOMENTUM + CALL HWVEQU(5,PHEP(1,ICMF),PT) + CALL HWVEQU(5,PHEP(1,JDAHEP(1,ICMF)),PW) +C--------GET THE NON-EMITTING PARTON CMF DIRECTION + CALL HWULOF(PHEP(1,ICMF),PW,PW) + CALL HWRAZM(ONE,CS,SN) + CALL HWUROT(PW,CS,SN,R) + CALL HWUROF(R,PW,PW) + CALL HWUMAS(PW) +C---REORDER ENTRIES: IHEP=EMITTER, KHEP=EMITTED + NHEP=NHEP+1 + IHEP=JDAHEP(2,ICMF) + WHEP=JDAHEP(1,ICMF) + KHEP=NHEP +C---SET UP MOMENTA IN TOP REST FRAME + PHEP(1,ICMF)=0 + PHEP(2,ICMF)=0 + PHEP(3,ICMF)=0 + PHEP(4,ICMF)=EM + PHEP(5,ICMF)=EM + PHEP(4,IHEP)=HALF*EM*(2-X(1)-X(3)+EPS-AW+EPG) + PHEP(4,KHEP)=HALF*EM*X(3) + PHEP(5,IHEP)=RMASS(ID) + PHEP(5,KHEP)=RMASS(ID3) + PHEP(3,KHEP)=HALF*EM*((X(1)+AW-EPS-EPG)*X(3)-2*(1+EPS-AW + $ -EPG-(2+EPS+EPG-AW-X(1)-X(3))))/HWUSQR((X(1)+AW + $ -EPS-EPG)**2-4*AW) + PHEP(3,IHEP)=-PHEP(3,KHEP)-HALF*EM + $ *HWUSQR((X(1)+AW-EPS-EPG)**2-4*AW) + PHEP(2,IHEP)=0 + PHEP(1,KHEP)=HWUSQR(PHEP(4,KHEP)**2-PHEP(5,KHEP)**2 + $ -PHEP(3,KHEP)**2) + PHEP(1,IHEP)=-PHEP(1,KHEP) + PHEP(2,KHEP)=0 + CALL HWVSUM(4,PHEP(1,IHEP),PHEP(1,KHEP),PW1) + CALL HWVDIF(4,PHEP(1,ICMF),PW1,PW1) + CALL HWUMAS(PW1) + DO K=1,5 + PHEP(K,WHEP)=PW1(K) + ENDDO +C---ORIENT IN CMF, THEN BOOST TO LAB + CALL HWUROB(R,PHEP(1,ICMF),PHEP(1,ICMF)) + CALL HWUROB(R,PHEP(1,IHEP),PHEP(1,IHEP)) + CALL HWUROB(R,PHEP(1,WHEP),PHEP(1,WHEP)) + CALL HWUROB(R,PHEP(1,KHEP),PHEP(1,KHEP)) + CALL HWULOB(PT,PHEP(1,IHEP),PHEP(1,IHEP)) + CALL HWULOB(PT,PHEP(1,KHEP),PHEP(1,KHEP)) + CALL HWULOB(PT,PHEP(1,ICMF),PHEP(1,ICMF)) + CALL HWULOB(PT,PHEP(1,WHEP),PHEP(1,WHEP)) +C---STATUS AND COLOUR CONNECTION + ISTHEP(KHEP)=114 + IDHW(KHEP)=ID3 + IDHEP(KHEP)=IDPDG(ID3) + JDAHEP(2,ICMF)=KHEP + JMOHEP(1,KHEP)=ICMF + JMOHEP(1,IHEP)=ICMF + JDAHEP(1,KHEP)=0 + JMOHEP(2,IHEP)=ICMF + JDAHEP(2,IHEP)=KHEP + JMOHEP(2,KHEP)=IHEP + JDAHEP(2,KHEP)=ICMF + 999 END +CDECK ID>, HWBVMC. +*CMZ :- -26/04/91 11.11.54 by Bryan Webber +*-- Author : Bryan Webber +C----------------------------------------------------------------------- + FUNCTION HWBVMC(ID) +C----------------------------------------------------------------------- +C VIRTUAL MASS CUTOFF FOR PARTON TYPE ID +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + DOUBLE PRECISION HWBVMC + INTEGER ID + IF (ID.EQ.13) THEN + HWBVMC=RMASS(ID)+VGCUT + ELSEIF (ID.LT.13) THEN + HWBVMC=RMASS(ID)+VQCUT + ELSEIF (ID.EQ.59) THEN + HWBVMC=RMASS(ID)+VPCUT + ELSE + HWBVMC=RMASS(ID) + ENDIF + END +CDECK ID>, HWCBCT. +*CMZ :- -20/07/99 10:56:12 by Peter Richardson +*-- Author : Peter Richardson +C----------------------------------------------------------------------- + SUBROUTINE HWCBCT(JHEP,KHEP,THEP,PCL,SPLIT) +C----------------------------------------------------------------------- +C Subroutine to split a baryonic cluster containing two heavy quarks +C Based on HWCCUT +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + DOUBLE PRECISION HWUPCM,HWR,HWVDOT,EMC,QM1,QM2,QM3,QM4, + & PXY,PCX,PCY,RCM,PCL(5),AX(5),PA(5),PB(5),PC(5), + & VCLUS(4),DQM,EMX,EMY,SKAPPA,RKAPPA,VTMP(4), + & DELTM,PDIQUK(5),AY(5) + INTEGER HWRINT,JHEP,KHEP,LHEP,MHEP,THEP,ID1,ID2,ID3,ID4,NTRY, + & NTRYMX,J,IB + LOGICAL SPLIT + EXTERNAL HWUPCM,HWR,HWVDOT + PARAMETER(SKAPPA=1.,NTRYMX=100) + IF(IERROR.NE.0) RETURN + EMC=PCL(5) + ID1=IDHW(JHEP) + ID2=IDHW(KHEP) + ID3=IDHW(THEP) + QM1=RMASS(ID1) + QM2=RMASS(ID2) + QM3=RMASS(ID3) + SPLIT = .FALSE. + NTRY = 0 +C Decide if cluster contains a b-(anti)quark + IF (ID1.EQ.5.OR.ID1.EQ.11.OR.ID2.EQ.5.OR.ID2.EQ.11.OR. + & ID3.EQ.5.OR.ID3.EQ.11) THEN + IB=2 + ELSE + IB=1 + ENDIF +C-- Set the positon of the cluster to be that of the heavy quark + CALL HWVEQU(4,VHEP(1,THEP),VCLUS) +C--SPLIT THE BARYONIC CLUSTER INTO A HEAVY FLAVOUR MESON AND A HEAVY +C--FLAVOUR BARYON + PXY=EMC-QM1-QM2-QM3 + 20 NTRY=NTRY+1 + IF(NTRY.GT.NTRYMX) RETURN + 30 EMX=QM1+QM2+PXY*HWR()**PSPLT(IB) + EMY= QM3+PXY*HWR()**PSPLT(IB) + IF(EMX+EMY.GE.EMC) GOTO 30 +C--PULL A LIGHT QUARK PAIR OUT OF THE VACUUM + 40 ID4=HWRINT(1,3) + IF(QWT(ID4).LT.HWR()) GOTO 40 + QM4=RMASS(ID4) +C--Now combine particles 3 & 4 into a diquark +C--If three also heavy this diquark doesn't exist in HERWIG +C--just assume mass is sum of quark masses,as for other diquarks + DQM=QM3+QM4 +C--Now obtain the masses for the cluster splitting + PCX=HWUPCM(EMX,QM1,DQM) + IF(PCX.LT.ZERO) GOTO 20 + PCY=HWUPCM(EMY,QM2,QM4) + IF(PCY.LT.ZERO) GOTO 20 + SPLIT=.TRUE. +C--Now we've decided which light quark to pull out of the vacuum +C--Find the direction of the second heavy quark + CALL HWULOF(PCL,PHEP(1,THEP),AX) + RCM=1./SQRT(HWVDOT(3,AX,AX)) + CALL HWVSCA(3,RCM,AX,AX) +C--Construct the new CoM momenta(collinear) + PXY=HWUPCM(EMC,EMX,EMY) + CALL HWVSCA(3,PXY,AX,PC) +C--pc is momenta of Y cluster along 2nd quark dirn in cluster frame + PC(4)=SQRT(PXY**2+EMY**2) + PC(5)=EMY +C--pa is momenta of 2nd quark in Y frame + CALL HWVSCA(3,PCY,AX,PA) + PA(4)=SQRT(PCY**2+QM3**2) + PA(5)=QM3 +C--pb is momenta of 2nd quark in cluster frame,pa now momenta of antiquark + CALL HWULOB(PC,PA,PB) + CALL HWVDIF(4,PC,PB,PA) + PA(5)=QM4 + LHEP=NHEP+1 + MHEP=NHEP+2 +C--boost these momenta back to lab frame + CALL HWULOB(PCL,PB,PHEP(1,THEP)) + CALL HWULOB(PCL,PA,PHEP(1,MHEP)) +C--pc now becomes momenta of X cluster in cluster frame + CALL HWVSCA(3,-ONE,PC,PC) + PC(4)=EMC-PC(4) + PC(5)=EMX +C--find the dirn of the 1st heavy quark in the X frame +C--transform to cluster frame + CALL HWULOF(PCL,PHEP(1,JHEP),AY) +C--transform to X-frame + CALL HWULOF(PC,AY,AY) + RCM=1./SQRT(HWVDOT(3,AY,AY)) + CALL HWVSCA(3,RCM,AY,AY) +C--pa now momenta of 1st havy quark along this dirn + CALL HWVSCA(3,PCX,AY,PA) + PA(4)=SQRT(PCX**2+QM1**2) + PA(5)=QM1 +C--pb now momenta of 1st heavy quark in cluster frame then to lab + CALL HWULOB(PC,PA,PB) + CALL HWULOB(PCL,PB,PHEP(1,JHEP)) +C--now find the diquark momenta by momentum conservation + DO 50 J=1,4 + 50 PDIQUK(J)=PCL(J)-PHEP(J,THEP)-PHEP(J,MHEP)-PHEP(J,JHEP) + PDIQUK(5)=DQM +C--Now obtain the quark momenta from the diquark + DO 60 J=1,3 + 60 PA(J) = 0 + PA(4) = QM2 + PA(5) = QM2 + CALL HWULOB(PDIQUK,PA,PHEP(1,KHEP)) + CALL HWVDIF(4,PDIQUK,PHEP(1,KHEP),PHEP(1,LHEP)) +C--Construct new vertex positions + RKAPPA=GEV2MM/SKAPPA + CALL HWVSCA(3,RKAPPA,AX,AX) + DELTM=(EMX-EMY)*(EMX+EMY)/(TWO*EMC) + CALL HWVSCA(3,DELTM,AX,VTMP) + VTMP(4)=(HALF*EMC-PXY)*RKAPPA + CALL HWULB4(PCL,VTMP,VTMP) + CALL HWVSUM(4,VTMP,VCLUS,VHEP(1,LHEP)) + CALL HWVEQU(4,VHEP(1,LHEP),VHEP(1,MHEP)) +C--Relabel the colours of the quarks + IDHEP(LHEP) = IDPDG(ID4) + IDHEP(MHEP) = IDPDG(ID4) + IF(IDHEP(JHEP).GT.0) THEN + IDHW(LHEP) = ID4+6 + IDHEP(LHEP) = -IDHEP(LHEP) + IDHW(MHEP) = ID4 + JDAHEP(2,LHEP) = JHEP + JMOHEP(2,LHEP) = MHEP + JMOHEP(2,MHEP) = JMOHEP(2,JHEP) + JDAHEP(2,MHEP) = LHEP + JMOHEP(2,JHEP) = LHEP + ELSE + IDHW(LHEP) = ID4 + IDHW(MHEP) = ID4+6 + IDHEP(MHEP) = -IDHEP(MHEP) + JMOHEP(2,LHEP) = JHEP + JDAHEP(2,MHEP) = JDAHEP(2,JHEP) + JDAHEP(2,LHEP) = MHEP + JMOHEP(2,MHEP) = LHEP + JDAHEP(2,JHEP) = LHEP + ENDIF + ISTHEP(LHEP) = 151 + ISTHEP(MHEP) = 151 + JMOHEP(1,LHEP) = JMOHEP(1,KHEP) + JDAHEP(1,LHEP) = 0 + JMOHEP(1,MHEP) = JMOHEP(1,JHEP) + JDAHEP(1,MHEP) = 0 + NHEP = NHEP+2 + 999 END +CDECK ID>, HWCBVI. +*CMZ :- +*-- Author : Mark Gibbs modified by Peter Richardson +C----------------------------------------------------------------------- + SUBROUTINE HWCBVI +C----------------------------------------------------------------------- +C FINDS UNPAIRED PARTONS AFTER BARYON-NUMBER VIOLATION +C MODIFIED FOR RPARITY VIOLATING SUSY +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + COMMON/HWBVIC/NBV,IBV(18) + DOUBLE PRECISION HWR,PDQ(5) + INTEGER NBV,IBV,JBV,KBV,LBV,IHEP,IP1,IP2,IP3,JP1,JP2,JP3, + & HWCBVT,NBR,MBV,IQ1,IQ2,IQ3,ID1,ID2,IDQ,IDIQK(3,3) + LOGICAL SPLIT,DUNBV(18) + DATA IDIQK/111,110,113,110,109,112,113,112,114/ +C---Check for errors + IF (IERROR.NE.0) RETURN +C---Correct colour connections are gluon splitting + CALL HWCCCC +C---Reset bvi clustering flag + HVFCEN = .FALSE. +C---LIST PARTONS WITH WRONG COLOUR PARTNERS-QUARKS ONLY + 5 NBV=0 + DO 10 IHEP=1,NHEP + IF (ISTHEP(IHEP).GT.149.AND.ISTHEP(IHEP).LT.155) THEN + IF (QORQQB(IDHW(IHEP))) THEN + IF (.NOT.QORQQB(IDHW(JMOHEP(2,IHEP))). + & AND.JMOHEP(2,IHEP).GT.6) GOTO 10 + ELSE +C---Extra check for Gamma's + IF (IDHW(IHEP).EQ.59) GO TO 10 +C---End of bug fix. + IF (QORQQB(IDHW(JDAHEP(2,IHEP)))) GO TO 10 + GO TO 10 + ENDIF + IF(JMOHEP(2,IHEP).LT.6.AND. + & .NOT.QBORQQ(IDHW(JMOHEP(2,IHEP)))) GOTO 10 +C--new for hard process + NBV=NBV+1 + IF (NBV.GT.18) CALL HWWARN('HWCBVI',100,*999) + IBV(NBV)=IHEP + DUNBV(NBV)=.FALSE. + ENDIF + 10 CONTINUE +C--NOW FIND THE ANTIQUARKS WITH WRONG COLOUR CONNECTIONS + DO 11 IHEP=1,NHEP + IF(ISTHEP(IHEP).GT.149.AND.ISTHEP(IHEP).LT.155) THEN + IF(QBORQQ(IDHW(IHEP))) THEN + IF(.NOT.QBORQQ(IDHW(JDAHEP(2,IHEP))).AND. + & JDAHEP(2,IHEP).GT.6) GO TO 11 + ELSE +C--Extra check for gamma's + IF(IDHW(IHEP).EQ.59) GO TO 11 + IF(QBORQQ(IDHW(JMOHEP(2,IHEP)))) GO TO 11 + GO TO 11 + ENDIF + IF(JDAHEP(2,IHEP).LT.6.AND. + & .NOT.QORQQB(IDHW(JDAHEP(2,IHEP)))) GOTO 11 + NBV=NBV+1 + IF(NBV.GT.18) CALL HWWARN('HWCBVI',100,*999) + IBV(NBV)=IHEP + DUNBV(NBV)=.FALSE. + ENDIF + 11 CONTINUE + IF (NBV.EQ.0) RETURN + IF(MOD(NBV,3).NE.0) CALL HWWARN('HWCBVI',101,*999) +C---PROCESS FOUND PARTONS, STARTING AT RANDOM POINT IN LIST + NBR=NBV*HWR() + DO 100 MBV=1,NBV + JBV=MBV+NBR + IF (JBV.GT.NBV) JBV=JBV-NBV + IF (.NOT.DUNBV(JBV)) THEN + DUNBV(JBV)=.TRUE. + IP1=IBV(JBV) + JP1=HWCBVT(IP1) +C---FIND ASSOCIATED PARTONS + DO 20 KBV=1,NBV + IF (.NOT.DUNBV(KBV)) THEN + IP2=IBV(KBV) + JP2=HWCBVT(IP2) + IF (JP2.EQ.JP1) THEN + DUNBV(KBV)=.TRUE. + DO 15 LBV=1,NBV + IF (.NOT.DUNBV(LBV)) THEN + IP3=IBV(LBV) + JP3=HWCBVT(IP3) + IF (JP3.EQ.JP2) THEN + DUNBV(LBV)=.TRUE. + GO TO 25 + ENDIF + ENDIF + 15 CONTINUE + ENDIF + ENDIF + 20 CONTINUE + CALL HWWARN('HWCBVI',102,*999) + 25 IQ1=0 +C---LOOK FOR DIQUARK + IF (ABS(IDHEP(IP1)).GT.100) THEN + IQ1=IP1 + IQ2=IP2 + IQ3=IP3 + ELSEIF (ABS(IDHEP(IP2)).GT.100) THEN + IQ1=IP2 + IQ2=IP3 + IQ3=IP1 + ELSEIF (ABS(IDHEP(IP3)).GT.100) THEN + IQ1=IP3 + IQ2=IP1 + IQ3=IP2 + ENDIF + IF (IQ1.EQ.0) THEN +C---NO DIQUARKS: COMBINE TWO (ANTI)QUARKS + IF (ABS(IDHEP(IP1)).GT.3) THEN + IQ1=IP2 + IQ2=IP3 + IQ3=IP1 + ELSEIF (ABS(IDHEP(IP2)).GT.3) THEN + IQ1=IP3 + IQ2=IP1 + IQ3=IP2 + ELSE + IQ1=IP1 + IQ2=IP2 + IQ3=IP3 + ENDIF + ID1=IDHEP(IQ1) + ID2=IDHEP(IQ2) +C---CHECK FLAVOURS + IF (ID1.GT.0.AND.ID1.LT.4.AND. + & ID2.GT.0.AND.ID2.LT.4) THEN + IDQ=IDIQK(ID1,ID2) + ELSEIF (ID1.LT.0.AND.ID1.GT.-4.AND. + & ID1.LT.0.AND.ID2.GT.-4) THEN + IDQ=IDIQK(-ID1,-ID2)+6 + ELSE +C---CANT MAKE DIQUARKS WITH HEAVY QUARKS: TRY CLUSTER SPLITTING + CALL HWVSUM(4,PHEP(1,IQ1),PHEP(1,IQ2),PDQ) + CALL HWUMAS(PDQ) +C--Use the original splitting procedure + CALL HWCCUT(IQ1,IQ2,PDQ,.FALSE.,SPLIT) + IF(SPLIT) GOTO 5 +C--If it fails try the new procedure + CALL HWVSUM(4,PDQ,PHEP(1,IQ3),PDQ) + CALL HWUMAS(PDQ) + IF(ABS(ID1).GT.3) THEN + CALL HWCBCT(IQ3,IQ2,IQ1,PDQ,SPLIT) + ELSEIF(ABS(ID2).GT.3) THEN + CALL HWCBCT(IQ3,IQ1,IQ2,PDQ,SPLIT) + ELSE + CALL HWWARN('HWCBVI',100,*999) + ENDIF + IF (SPLIT) GO TO 5 +C---Unable to form cluster; dispose of event + CALL HWWARN('HWCBVI',-3,*999) + ENDIF +C---OVERWRITE FIRST AND CANCEL SECOND + IDHW(IQ1)=IDQ + IDHEP(IQ1)=IDPDG(IDQ) + CALL HWVSUM(4,PHEP(1,IQ1),PHEP(1,IQ2),PHEP(1,IQ1)) + CALL HWUMAS(PHEP(1,IQ1)) + ISTHEP(IQ2)=0 +C---REMAKE COLOUR CONNECTIONS + IF (QORQQB(IDQ)) THEN + JMOHEP(2,IQ1)=IQ3 + JDAHEP(2,IQ3)=IQ1 + ELSE + JDAHEP(2,IQ1)=IQ3 + JMOHEP(2,IQ3)=IQ1 + ENDIF + ELSE +C---SPLIT A DIQUARK + NHEP=NHEP+1 + CALL HWVSCA(5,HALF,PHEP(1,IQ1),PHEP(1,IQ1)) + CALL HWVEQU(5,PHEP(1,IQ1),PHEP(1,NHEP)) + ISTHEP(NHEP)=150 + JMOHEP(1,NHEP)=JMOHEP(1,IQ1) + JDAHEP(1,NHEP)=0 +C---FIND FLAVOURS + IDQ=IDHW(IQ1) + DO 30 ID2=1,3 + DO 30 ID1=1,3 + IF (IDIQK(ID1,ID2).EQ.IDQ) THEN + IDHW(IQ1)=ID1 + IDHW(NHEP)=ID2 +C---REMAKE COLOUR CONNECTIONS (DIQUARK) + JMOHEP(2,IQ1)=IQ2 + JMOHEP(2,IQ2)=NHEP + JMOHEP(2,IQ3)=IQ1 + JMOHEP(2,NHEP)=IQ3 + JDAHEP(2,IQ1)=IQ3 + JDAHEP(2,IQ2)=IQ1 + JDAHEP(2,IQ3)=NHEP + JDAHEP(2,NHEP)=IQ2 + GO TO 35 + ELSEIF (IDIQK(ID1,ID2).EQ.IDQ-6) THEN + IDHW(IQ1)=ID1+6 + IDHW(NHEP)=ID2+6 +C---REMAKE COLOUR CONNECTIONS (ANTIDIQUARK) + JMOHEP(2,IQ1)=IQ3 + JMOHEP(2,IQ2)=IQ1 + JMOHEP(2,IQ3)=NHEP + JMOHEP(2,NHEP)=IQ2 + JDAHEP(2,IQ1)=IQ2 + JDAHEP(2,IQ2)=NHEP + JDAHEP(2,IQ3)=IQ1 + JDAHEP(2,NHEP)=IQ3 + GO TO 35 + ENDIF + 30 CONTINUE + CALL HWWARN('HWCBVI',104,*999) + 35 IDHEP(IQ1)=IDPDG(IDHW(IQ1)) + IDHEP(NHEP)=IDPDG(IDHW(NHEP)) + ENDIF + ENDIF + 100 CONTINUE + RETURN + 999 END +CDECK ID>, HWCBVT. +*CMZ :- +*-- Author : Peter Richardson +C----------------------------------------------------------------------- + FUNCTION HWCBVT(IP) +C----------------------------------------------------------------------- +C Function to find the baryon number violating vertex a parton came from +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + INTEGER HWCBVT,IP,JP(2),KP,I,J,ID,TYPE,IDM,IDM2,IDM3,IDM4 + JP(1) = IP + ID = IDHW(IP) + IF(ID.LE.6.OR.(ID.GE.115.AND.ID.LE.120)) THEN + JP(2) = JMOHEP(2,IP) + ELSE + JP(2) = JDAHEP(2,IP) + ENDIF + DO I=1,2 + IDM = JMOHEP(1,JMOHEP(1,JMOHEP(1,JMOHEP(1,JP(I))))) + IF(IDHW(IDM).EQ.6.OR.IDHW(IDM).EQ.12) THEN + JP(I)=IDM + ENDIF + ENDDO + DO J=1,7 + DO I=1,2 + KP = JMOHEP(1,JP(I)) + IDM = IDHW(KP) + IDM2 = IDHW(JDAHEP(1,KP)) + IDM3 = IDHW(JDAHEP(2,KP)) + IDM4 = IDHW(JDAHEP(1,KP)+1) + IF((ISTHEP(KP).EQ.155.AND. + & ((IDM.GE.449.AND.IDM.LE.457.AND.IDM2.LE.12.AND. + & IDM3.LE.12.AND.IDM4.LE.12).OR. + & (((IDM.GE.411.AND.IDM.LE.424).OR.IDM.EQ.405.OR.IDM.EQ.406) + & .AND.IDM2.LE.12.AND.IDM3.LE.12))) + & .OR.(IDM.EQ.15.AND.IDM2.LE.12.AND. + & IDHW(JMOHEP(1,KP)).LE.12.AND. + & IDHW(JMOHEP(2,KP)).LE.12.AND.IDM3.GE.449.AND. + & IDM3.LE.457).OR. + & (IDM.EQ.15.AND.IDM2.GE.198.AND.IDM2.LE.200. + & AND.ABS(IDPDG(IDM3)).GT.1000000)) THEN + IF(IDHW(KP).EQ.449.AND.JDAHEP(1,KP).EQ.JP(I)) THEN + KP = JMOHEP(1,KP) + ELSEIF(IDHW(KP).EQ.15) THEN + TYPE=IDHW(JDAHEP(1,KP)) + IF(TYPE.GE.7.AND.TYPE.LE.12.AND. + & JMOHEP(2,JDAHEP(2,KP)).EQ.JP(I)) THEN + KP=IP + ELSEIF(TYPE.LE.6.AND. + & JDAHEP(2,JDAHEP(2,KP)).EQ.JP(I)) THEN + KP=IP + ELSE + HWCBVT = KP + RETURN + ENDIF + ELSE + HWCBVT = KP + RETURN + ENDIF + ENDIF + JP(I) =KP + ENDDO + ENDDO + HWCBVT = 0 + 999 END +CDECK ID>, HWCCCC. +*CMZ :- +*-- Author : Peter Richardson +C----------------------------------------------------------------------- + SUBROUTINE HWCCCC +C----------------------------------------------------------------------- +C Subroutine to correct colour connections after the gluon splitting +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + INTEGER IHEP,STFSPT,LHEP,MHEP,RHEP + IF(IERROR.NE.0) RETURN +C--Find the first particle in the event record with status 150 + DO IHEP=1,NHEP + IF(ISTHEP(IHEP).GE.150.AND.ISTHEP(IHEP).LE.154) THEN + STFSPT = IHEP + GOTO 10 + ENDIF + ENDDO + 10 CONTINUE +C--Now find any that are colour connected to earlier particles +C--in the event record + DO IHEP=STFSPT,NHEP +C--First the quarks and antidiquarks + IF(IDHW(IHEP).LT.6.OR. + & (IDHW(IHEP).GE.115.AND.IDHW(IHEP).LE.120)) THEN + IF(JMOHEP(2,IHEP).LT.STFSPT) THEN + LHEP = IHEP + MHEP = JMOHEP(2,IHEP) + RHEP = MHEP + IF(MHEP.GT.6) RHEP = JDAHEP(1,MHEP) +C--As from Rparity connect to particle not to antiparticle + IF(IDHW(MHEP).NE.13) THEN + JMOHEP(2,LHEP) = RHEP + ELSE + RHEP = RHEP+1 + JMOHEP(2,LHEP) = RHEP + ENDIF + ENDIF + ENDIF +C--Now the antiquarks + IF((IDHW(IHEP).GT.6.AND.IDHW(IHEP).LE.12).OR. + & (IDHW(IHEP).GE.109.AND.IDHW(IHEP).LE.114)) THEN + IF(JDAHEP(2,IHEP).LT.STFSPT) THEN + LHEP = IHEP + MHEP = JDAHEP(2,IHEP) + RHEP = MHEP + IF(MHEP.GT.6) RHEP = JDAHEP(1,MHEP) +C--As from Rparity connect to antiparticle not particle + IF(IDHW(MHEP).NE.13) THEN + JDAHEP(2,LHEP) = RHEP + ELSE + JDAHEP(2,LHEP) = RHEP + ENDIF + ENDIF + ENDIF + ENDDO + END +CDECK ID>, HWCCUT. +*CMZ :- -26/04/91 14.29.39 by Federico Carminati +*-- Author : Bryan Webber +C----------------------------------------------------------------------- + SUBROUTINE HWCCUT(JHEP,KHEP,PCL,BTCLUS,SPLIT) +C----------------------------------------------------------------------- +C Cuts into 2 the cluster, momentum PCL, made of partons JHEP & KHEP +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + DOUBLE PRECISION HWREXQ,HWUPCM,HWR,HWVDOT,EMC,QM1,QM2,EMX,EMY, + & QM3,PXY,PCX,PCY,RCM,PCL(5),AX(5),PA(5),PB(5),PC(5),SKAPPA,DELTM, + & VSCA,VTMP(4),RKAPPA,VCLUS + INTEGER HWRINT,JHEP,KHEP,LHEP,MHEP,ID1,ID2,ID3,NTRY,NTRYMX,J,IB + LOGICAL BTCLUS,SPLIT + EXTERNAL HWREXQ,HWUPCM,HWR,HWVDOT,HWRINT + COMMON/HWCFRM/VCLUS(4,NMXHEP) + PARAMETER (SKAPPA=1.,NTRYMX=100) + IF (IERROR.NE.0) RETURN + EMC=PCL(5) + ID1=IDHW(JHEP) + ID2=IDHW(KHEP) + QM1=RMASS(ID1) + QM2=RMASS(ID2) + SPLIT=.FALSE. + NTRY=0 +C Decide if cluster contains a b-(anti)quark + IF (ID1.EQ.5.OR.ID1.EQ.11.OR.ID2.EQ.5.OR.ID2.EQ.11) THEN + IB=2 + ELSE + IB=1 + ENDIF + IF (BTCLUS) THEN +C Split beam and target clusters as soft clusters +C Both (remnant) children treated like soft clusters if IOPREM=0(1) + 10 ID3=HWRINT(1,2) + QM3=RMASS(ID3) + IF (EMC.LE.QM1+QM2+2.*QM3) THEN + ID3=3-ID3 + QM3=RMASS(ID3) + IF (EMC.LE.QM1+QM2+2.*QM3) RETURN + ENDIF + PXY=EMC-QM1-QM2-TWO*QM3 + IF (ISTHEP(JHEP).EQ.153.OR.ISTHEP(JHEP).EQ.154.OR. + & IOPREM.EQ.0) THEN + EMX=QM1+QM3+HWREXQ(BTCLM,PXY) + ELSE + EMX=QM1+QM3+PXY*HWR()**PSPLT(IB) + ENDIF + IF (ISTHEP(KHEP).EQ.153.OR.ISTHEP(KHEP).EQ.154.OR. + & IOPREM.EQ.0) THEN + EMY=QM2+QM3+HWREXQ(BTCLM,PXY) + ELSE + EMY=QM2+QM3+PXY*HWR()**PSPLT(IB) + ENDIF + IF (EMX+EMY.GE.EMC) THEN + NTRY=NTRY+1 + IF (NTRY.GT.NTRYMX) RETURN + GOTO 10 + ENDIF + PCX=HWUPCM(EMX,QM1,QM3) + PCY=HWUPCM(EMY,QM2,QM3) + ELSE +C Choose fragment masses for ordinary cluster + PXY=EMC-QM1-QM2 + 20 NTRY=NTRY+1 + IF (NTRY.GT.NTRYMX) RETURN + 30 EMX=QM1+PXY*HWR()**PSPLT(IB) + EMY=QM2+PXY*HWR()**PSPLT(IB) + IF (EMX+EMY.GE.EMC) GOTO 30 +C u,d,s pair production with weights QWT + 40 ID3=HWRINT(1,3) + IF (QWT(ID3).LT.HWR()) GOTO 40 + QM3=RMASS(ID3) + PCX=HWUPCM(EMX,QM1,QM3) + IF (PCX.LT.ZERO) GOTO 20 + PCY=HWUPCM(EMY,QM2,QM3) + IF (PCY.LT.ZERO) GOTO 20 + SPLIT=.TRUE. + ENDIF +C Boost antiquark to CoM frame to find axis + CALL HWULOF(PCL,PHEP(1,KHEP),AX) + RCM=1./SQRT(HWVDOT(3,AX,AX)) + CALL HWVSCA(3,RCM,AX,AX) +C Construct new CoM momenta (collinear) + PXY=HWUPCM(EMC,EMX,EMY) + CALL HWVSCA(3,PXY,AX,PC) + PC(4)=SQRT(PXY**2+EMY**2) + PC(5)=EMY + CALL HWVSCA(3,PCY,AX,PA) + PA(4)=SQRT(PCY**2+QM2**2) + PA(5)=QM2 + CALL HWULOB(PC,PA,PB) + CALL HWVDIF(4,PC,PB,PA) + PA(5)=QM3 + LHEP=NHEP+1 + MHEP=NHEP+2 + CALL HWULOB(PCL,PB,PHEP(1,KHEP)) + CALL HWULOB(PCL,PA,PHEP(1,MHEP)) + CALL HWVSCA(3,-ONE,PC,PC) + PC(4)=EMC-PC(4) + PC(5)=EMX + CALL HWVSCA(3,PCX,AX,PA) + PA(4)=SQRT(PCX**2+QM3**2) + CALL HWULOB(PC,PA,PB) + CALL HWULOB(PCL,PB,PHEP(1,LHEP)) + DO 50 J=1,4 + 50 PHEP(J,JHEP)=PCL(J)-PHEP(J,KHEP)-PHEP(J,LHEP)-PHEP(J,MHEP) + PHEP(5,JHEP)=QM1 + CALL HWVEQU(4,VHEP(1,LHEP),VHEP(1,MHEP)) +C Construct new vertex positions + RKAPPA=GEV2MM/SKAPPA + CALL HWVSCA(3,RKAPPA,AX,AX) + DELTM=(EMX-EMY)*(EMX+EMY)/(TWO*EMC) + CALL HWVSCA(3,DELTM,AX,VTMP) + VTMP(4)=(HALF*EMC-PXY)*RKAPPA + CALL HWULB4(PCL,VTMP,VTMP) + CALL HWVSUM(4,VTMP,VCLUS(1,JHEP),VHEP(1,LHEP)) + CALL HWVEQU(4,VHEP(1,LHEP),VHEP(1,MHEP)) + VSCA=0.25*EMC+HALF*(PXY+DELTM) + CALL HWVSCA(3,VSCA,AX,VTMP) + VTMP(4)=(EMC-VSCA)*RKAPPA + CALL HWULB4(PCL,VTMP,VTMP) + CALL HWVSUM(4,VTMP,VCLUS(1,JHEP),VCLUS(1,MHEP)) + VSCA=-0.25*EMC+HALF*(DELTM-PXY) + CALL HWVSCA(3,VSCA,AX,VTMP) + VTMP(4)=(EMC+VSCA)*RKAPPA + CALL HWULB4(PCL,VTMP,VTMP) + CALL HWVSUM(4,VTMP,VCLUS(1,JHEP),VCLUS(1,JHEP)) +C (Re-)label quarks + IDHW(LHEP)=ID3+6 + IDHW(MHEP)=ID3 + IDHEP(MHEP)= IDPDG(ID3) + IDHEP(LHEP)=-IDPDG(ID3) + ISTHEP(LHEP)=151 + ISTHEP(MHEP)=151 + JMOHEP(2,JHEP)=LHEP + JDAHEP(2,KHEP)=MHEP + JMOHEP(1,LHEP)=JMOHEP(1,KHEP) + JMOHEP(2,LHEP)=MHEP + JDAHEP(1,LHEP)=0 + JDAHEP(2,LHEP)=JHEP + JMOHEP(1,MHEP)=JMOHEP(1,JHEP) + JMOHEP(2,MHEP)=KHEP + JDAHEP(1,MHEP)=0 + JDAHEP(2,MHEP)=LHEP + NHEP=NHEP+2 + 999 END +CDECK ID>, HWCDEC. +*CMZ :- -26/04/91 10.18.56 by Bryan Webber +*-- Author : Bryan Webber +C----------------------------------------------------------------------- + SUBROUTINE HWCDEC +C----------------------------------------------------------------------- +C DECAYS CLUSTERS INTO PRIMARY HADRONS +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + INTEGER JCL,KCL,IP,JP,KP,IST,ID1,ID2,ID3 + IF (IERROR.NE.0) RETURN + IF (IPROC/1000.EQ.9.OR.IPROC/1000.EQ.5) THEN +C---RELABEL CLUSTER CONNECTED TO REMNANT IN DIS + DO 10 JCL=2,NHEP + IF (ISTHEP(JCL).EQ.164) GOTO 20 + IF (ISTHEP(JCL).EQ.165) THEN + IP=JMOHEP(1,JCL) + JP=JMOHEP(2,JCL) + KP=IP + IF (ISTHEP(IP).EQ.162) THEN + KP=JP + JP=IP + ENDIF + IF (JMOHEP(2,KP).NE.JP) THEN + IP=JMOHEP(2,KP) + ELSE + IP=JDAHEP(2,KP) + ENDIF + KCL=JDAHEP(1,IP) + IF (ISTHEP(KCL)/10.NE.16) CALL HWWARN('HWCDEC',100,*999) + ISTHEP(KCL)=164 + GOTO 20 + ENDIF + 10 CONTINUE + ENDIF + 20 CONTINUE + DO 30 JCL=1,NHEP + IST=ISTHEP(JCL) + IF (IST.GT.162.AND.IST.LT.166) THEN +C---DON'T HADRONIZE BEAM/TARGET CLUSTERS + IF (IST.EQ.163.OR..NOT.GENSOF) THEN +C---SET UP FLAVOURS FOR CLUSTER DECAY + CALL HWCFLA(IDHW(JMOHEP(1,JCL)),IDHW(JMOHEP(2,JCL)),ID1,ID3) + CALL HWCHAD(JCL,ID1,ID3,ID2) + ENDIF + ENDIF + 30 CONTINUE + ISTAT=50 + 999 END +CDECK ID>, HWCFLA. +*CMZ :- -26/04/91 10.18.56 by Bryan Webber +*-- Author : Bryan Webber +C----------------------------------------------------------------------- + SUBROUTINE HWCFLA(JD1,JD2,ID1,ID2) +C----------------------------------------------------------------------- +C SETS UP FLAVOURS FOR CLUSTER DECAY +C----------------------------------------------------------------------- + INTEGER JD1,JD2,ID1,ID2,JD,JDEC(12) + DATA JDEC/1,2,3,10,11,12,4,5,6,7,8,9/ + JD=JD1 + IF (JD.GT.12) JD=JD-108 + ID1=JDEC(JD) + JD=JD2 + IF (JD.GT.12) JD=JD-96 + ID2=JDEC(JD-6) + END +CDECK ID>, HWCFOR. +*CMZ :- -26/04/91 14.15.56 by Federico Carminati +*-- Author : Bryan Webber +C----------------------------------------------------------------------- + SUBROUTINE HWCFOR +C----------------------------------------------------------------------- +C Converts colour-connected quark-antiquark pairs into clusters +C Modified by IGK to include BRW's colour rearrangement and +C MHS's cluster vertices +C MODIFIED 16/10/97 BY BRW FOR SUSY PROCESSES +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + DOUBLE PRECISION HWULDO,HWVDOT,HWR,HWUPCM,DCL0,DCL(4),DCL1, + & DFAC,DISP1(4),DISP2(4),DMAX,PCL(5),DOT1,DOT2,FAC,VCLUS,SCA1,SCA2, + & EM0,EM1,EM2,PC0,PC1 + INTEGER HWRINT,MAP(120),IBHEP,IBCL,JBHEP,JHEP, + & KHEP,LHEP,LCL,IHEP,MCL,I,ISTJ,ISTK,JCL,ID1,ID3,L + LOGICAL HWRLOG,SPLIT + EXTERNAL HWULDO,HWVDOT,HWR,HWUPCM,HWRINT + COMMON/HWCFRM/VCLUS(4,NMXHEP) + DATA MAP/1,2,3,4,5,6,1,2,3,4,5,6,96*0,7,8,9,10,11,12,7,8,9,10,11, + & 12/ + IF (IERROR.NE.0) RETURN +C Split gluons + CALL HWCGSP +C Find colour partners after baryon number violating event + IF (HVFCEN) THEN + IF(RPARTY) THEN + CALL HVCBVI + ELSE + CALL HWCBVI + ENDIF + ENDIF + IF (IERROR.NE.0) RETURN +C Look for partons to cluster + DO 10 IBHEP=1,NHEP + 10 IF (ISTHEP(IBHEP).GE.150.AND.ISTHEP(IBHEP).LE.154) GOTO 20 + IBCL=1 + GOTO 130 + 20 CONTINUE +C--Final check for colour disconnections + DO 25 JHEP=IBHEP,NHEP + IF (ISTHEP(JHEP).GE.150.AND.ISTHEP(JHEP).LE.154.AND. + & QORQQB(IDHW(JHEP))) THEN + KHEP=JMOHEP(2,JHEP) +C BRW FIX 13/03/99 + IF (KHEP.EQ.0.OR..NOT.( + & ISTHEP(KHEP).GE.150.AND.ISTHEP(KHEP).LE.154.AND. + & QBORQQ(IDHW(KHEP)))) THEN + DO KHEP=IBHEP,NHEP + IF (ISTHEP(KHEP).GE.150.AND.ISTHEP(KHEP).LE.154 + & .AND.QBORQQ(IDHW(KHEP))) THEN + LHEP=JDAHEP(2,KHEP) + IF (LHEP.EQ.0.OR..NOT.( + & ISTHEP(LHEP).GE.150.AND.ISTHEP(LHEP).LE.154.AND. + & QORQQB(IDHW(LHEP)))) THEN + JMOHEP(2,JHEP)=KHEP + JDAHEP(2,KHEP)=JHEP + GOTO 25 + ENDIF + ENDIF + ENDDO +C END FIX + CALL HWWARN('HWCFOR',100,*999) + ENDIF + ENDIF + 25 CONTINUE + IF (CLRECO) THEN +C Allow for colour rearrangement of primary clusters + NRECO=0 +C Randomize starting point + JBHEP=HWRINT(IBHEP,NHEP) + JHEP=JBHEP + 30 JHEP=JHEP+1 + IF (JHEP.GT.NHEP) JHEP=IBHEP + IF (ISTHEP(JHEP).GE.150.AND.ISTHEP(JHEP).LE.154.AND. + & QORQQB(IDHW(JHEP))) THEN +C Find colour connected antiquark or diquark + KHEP=JMOHEP(2,JHEP) +C Find partner antiquark or diquark + LHEP=JDAHEP(2,JHEP) +C Find closest antiquark or diquark + DCL0=1.D15 + LCL=0 + DO 40 IHEP=IBHEP,NHEP + IF (ISTHEP(IHEP).GE.150.AND.ISTHEP(IHEP).LE.154.AND. + & QBORQQ(IDHW(IHEP))) THEN +C Check whether already reconnected + IF (JDAHEP(2,IHEP).GT.0.AND.IHEP.NE.LHEP) THEN + CALL HWVDIF(4,VHEP(1,IHEP),VHEP(1,JHEP),DCL) + DCL1=ABS(HWULDO(DCL,DCL)) + IF (DCL1.LT.DCL0) THEN + DCL0=DCL1 + LCL=IHEP + ENDIF + ENDIF + ENDIF + 40 CONTINUE + IF (LCL.NE.0.AND.LCL.NE.KHEP) THEN + MCL=JDAHEP(2,LCL) + IF (JDAHEP(2,MCL).NE.KHEP) THEN +C Pairwise reconnection is possible + CALL HWVDIF(4,VHEP(1,KHEP),VHEP(1,MCL ),DCL) + DCL0=DCL0+ABS(HWULDO(DCL,DCL)) + CALL HWVDIF(4,VHEP(1,JHEP),VHEP(1,KHEP),DCL) + DCL1=ABS(HWULDO(DCL,DCL)) + CALL HWVDIF(4,VHEP(1,LCL ),VHEP(1,MCL ),DCL) + DCL1=DCL1+ABS(HWULDO(DCL,DCL)) + IF (DCL0.LT.DCL1.AND.HWRLOG(PRECO)) THEN +C Reconnection occurs + JMOHEP(2,JHEP)= LCL + JDAHEP(2,LCL )=-JHEP + JMOHEP(2,MCL) = KHEP + JDAHEP(2,KHEP)=-MCL + NRECO=NRECO+1 + ENDIF + ENDIF + ENDIF + ENDIF + IF (JHEP.NE.JBHEP) GOTO 30 + IF (NRECO.NE.0) THEN + DO 50 IHEP=IBHEP,NHEP + 50 JDAHEP(2,IHEP)=ABS(JDAHEP(2,IHEP)) + ENDIF + ENDIF +C Find (adjusted) cluster positions using MHS prescription + DFAC=10 + DMAX=1D-10 + DO 70 JHEP=IBHEP,NHEP + IF (ISTHEP(JHEP).GE.150.AND.ISTHEP(JHEP).LE.154.AND. + & QORQQB(IDHW(JHEP))) THEN + KHEP=JMOHEP(2,JHEP) + CALL HWUDKL(IDHW(JHEP),PHEP(1,JHEP),DISP1) + CALL HWVSCA(4,DFAC,DISP1,DISP1) + CALL HWUDKL(IDHW(KHEP),PHEP(1,KHEP),DISP2) + CALL HWVSCA(4,DFAC,DISP2,DISP2) +C Rescale the lengths of DISP1,DISP2 if too long + DOT1=HWVDOT(3,DISP1,DISP1) + DOT2=HWVDOT(3,DISP2,DISP2) + IF (MAX(DOT1,DOT2).GT.DMAX**2) THEN + CALL HWVSCA(4,DMAX/SQRT(DOT1),DISP1,DISP1) + CALL HWVSCA(4,DMAX/SQRT(DOT2),DISP2,DISP2) + ENDIF + CALL HWVSUM(4,PHEP(1,JHEP),PHEP(1,KHEP),PCL) + DOT1=HWVDOT(3,DISP1,PCL) + DOT2=HWVDOT(3,DISP2,PCL) +C If PCL > 90^o from either quark, use a vector which isn't + IF (DOT1.LE.ZERO.OR. DOT2.LE.ZERO) THEN + CALL HWVSUM(4,DISP1,DISP2,PCL) + DOT1=HWVDOT(3,DISP1,PCL) + DOT2=HWVDOT(3,DISP2,PCL) + ENDIF +C If vectors are exactly opposite each other this method cannot work + IF (DOT1.EQ.ZERO.OR.DOT2.EQ.ZERO) THEN +C So use midpoint of quark constituents + CALL HWVSUM(4,VHEP(1,JHEP),VHEP(1,KHEP),VCLUS(1,JHEP)) + CALL HWVSCA(4,HALF,VCLUS(1,JHEP),VCLUS(1,JHEP)) + GOTO 70 + ENDIF +C Rescale DISP1 or DISP2 to give equal components in the PCL direction + FAC=DOT1/DOT2 + IF (FAC.GT.ONE) THEN + CALL HWVSCA(4, FAC,DISP2,DISP2) + DOT2=DOT1 + ELSE + CALL HWVSCA(4,ONE/FAC,DISP1,DISP1) + DOT1=DOT2 + ENDIF +C Shift VHEP(1,JHEP) or VHEP(1,KHEP) s.t. their line is perp to PCL + FAC=(HWVDOT(3,PCL,VHEP(1,KHEP)) + & -HWVDOT(3,PCL,VHEP(1,JHEP)))/DOT1 + SCA1=MAX(ONE,ONE+FAC) + SCA2=MAX(ONE,ONE-FAC) + DO 60 I=1,4 + 60 VCLUS(I,JHEP)=.5*(VHEP(I,JHEP)+VHEP(I,KHEP) + & +SCA1*DISP1(I)+SCA2*DISP2(I)) + ENDIF + 70 CONTINUE +C First chop up beam/target clusters + DO 80 JHEP=IBHEP,NHEP + KHEP=JMOHEP(2,JHEP) + ISTJ=ISTHEP(JHEP) + ISTK=ISTHEP(KHEP) +C--PR MOD here 8/7/99 + IF (QORQQB(IDHW(JHEP)).AND. + & (((ISTJ.EQ.153.OR.ISTJ.EQ.154).AND.ISTK.NE.151.AND.ISTK.NE.0) + & .OR.((ISTK.EQ.153.OR.ISTK.EQ.154). + & AND.ISTJ.NE.151.AND.ISTJ.NE.0))) THEN +C--end + CALL HWVSUM(4,PHEP(1,JHEP),PHEP(1,KHEP),PCL) + CALL HWUMAS(PCL) + CALL HWCCUT(JHEP,KHEP,PCL,.TRUE.,SPLIT) + ENDIF + 80 CONTINUE +C Second chop up massive pairs + DO 100 JHEP=IBHEP,NMXHEP + IF (JHEP.GT.NHEP) GOTO 110 + IF (ISTHEP(JHEP).GE.150.AND.ISTHEP(JHEP).LE.154.AND. + & QORQQB(IDHW(JHEP))) THEN + 90 KHEP=JMOHEP(2,JHEP) + CALL HWVSUM(4,PHEP(1,JHEP),PHEP(1,KHEP),PCL) + CALL HWUMAS(PCL) + IF (PCL(5).GT.CTHRPW(MAP(IDHW(JHEP)),MAP(IDHW(KHEP)))) THEN + CALL HWCCUT(JHEP,KHEP,PCL,.FALSE.,SPLIT) + IF (SPLIT) GOTO 90 + ENDIF + ENDIF + 100 CONTINUE +C Third create clusters and store production vertex + 110 IBCL=NHEP+1 + JCL=NHEP + DO 120 JHEP=IBHEP,NHEP + IF (ISTHEP(JHEP).GE.150.AND.ISTHEP(JHEP).LE.154.AND. + & QORQQB(IDHW(JHEP))) THEN + JCL=JCL+1 + IF(JCL.GT.NMXHEP) CALL HWWARN('HWCFOR',105,*999) + IDHW(JCL)=19 + IDHEP(JCL)=91 + KHEP=JMOHEP(2,JHEP) + IF (KHEP.EQ.0.OR..NOT.( + & ISTHEP(KHEP).GE.150.AND.ISTHEP(KHEP).LE.154.AND. + & QBORQQ(IDHW(KHEP)))) CALL HWWARN('HWCFOR',104,*999) + CALL HWVSUM(4,PHEP(1,JHEP),PHEP(1,KHEP),PHEP(1,JCL)) + CALL HWUMAS(PHEP(1,JCL)) + IF (ISTHEP(JHEP).EQ.153.OR.ISTHEP(KHEP).EQ.153) THEN + ISTHEP(JCL)=164 + ELSEIF (ISTHEP(JHEP).EQ.154.OR.ISTHEP(KHEP).EQ.154) THEN + ISTHEP(JCL)=165 + ELSE + ISTHEP(JCL)=163 + ENDIF + JMOHEP(1,JCL)=JHEP + JMOHEP(2,JCL)=KHEP + JDAHEP(1,JCL)=0 + JDAHEP(2,JCL)=0 + JDAHEP(1,JHEP)=JCL + JDAHEP(1,KHEP)=JCL + ISTHEP(JHEP)=ISTHEP(JHEP)+8 + ISTHEP(KHEP)=ISTHEP(KHEP)+8 + CALL HWVEQU(4,VCLUS(1,JHEP),VHEP(1,JCL)) + ENDIF + 120 CONTINUE + NHEP=JCL +C Fix up momenta for single-hadron clusters + 130 DO 150 JCL=IBCL,NHEP +C Don't hadronize beam/target clusters + IF (ISTHEP(JCL).LT.163.OR.ISTHEP(JCL).GT.165) GOTO 150 + IF (ISTHEP(JCL).NE.163.AND.GENSOF) GOTO 150 +C Set up flavours for cluster decay + CALL HWCFLA(IDHW(JMOHEP(1,JCL)),IDHW(JMOHEP(2,JCL)),ID1,ID3) + EM0=PHEP(5,JCL) + IF ((B1LIM.EQ.ZERO).OR.(ID1.NE.11.AND.ID3.NE.11)) THEN + IF (EM0.GT.RMIN(ID1,2)+RMIN(2,ID3)) GOTO 150 + ELSE +C Special for b clusters: allow 1-hadron decay above threshold + IF (B1LIM*HWR().LT.EM0/(RMIN(ID1,2)+RMIN(2,ID3))-1.) + & GOTO 150 + ENDIF + EM1=RMIN(ID1,ID3) + IF (ABS(EM0-EM1).LT.1.D-5) GOTO 150 +C Decide to go backward or forward to transfer 4-momentum + L=1-TWO*INT(HALF+HWR()) + MCL=NHEP-IBCL+1 + LCL=JCL + DO 140 I=1,MCL + LCL=LCL+L + IF (LCL.LT.IBCL) LCL=LCL+MCL + IF (LCL.GT.NHEP) LCL=LCL-MCL + IF (LCL.EQ.JCL) THEN + IF (EM0.GE.EM1+RMIN(1,1)) GOTO 150 + CALL HWWARN('HWCFOR',101,*999) + ENDIF + IF (ISTHEP(LCL).LT.163.OR.ISTHEP(LCL).GT.165) GOTO 140 +C Rescale momenta in 2-cluster CoM + CALL HWVSUM(4,PHEP(1,JCL),PHEP(1,LCL),PCL) + CALL HWUMAS(PCL) + EM2=PHEP(5,LCL) + PC0=HWUPCM(PCL(5),EM0,EM2) + PC1=HWUPCM(PCL(5),EM1,EM2) + IF (PC1.LT.ZERO) THEN +C Need to rescale other mass as well + CALL HWCFLA(IDHW(JMOHEP(1,LCL)),IDHW(JMOHEP(2,LCL)),ID1,ID3) + EM2=RMIN(ID1,ID3) + PC1=HWUPCM(PCL(5),EM1,EM2) + IF (PC1.LT.ZERO) GOTO 140 + PHEP(5,LCL)=EM2 + ENDIF + IF (PC0.GT.ZERO) THEN + PC0=PC1/PC0 + CALL HWULOF(PCL,PHEP(1,JCL),PHEP(1,JCL)) + CALL HWVSCA(3,PC0,PHEP(1,JCL),PHEP(1,JCL)) + PHEP(4,JCL)=SQRT(PC1**2+EM1**2) + PHEP(5,JCL)=EM1 + CALL HWULOB(PCL,PHEP(1,JCL),PHEP(1,JCL)) + CALL HWVDIF(4,PCL,PHEP(1,JCL),PHEP(1,LCL)) + GOTO 150 + ELSEIF (PC0.EQ.ZERO) THEN + PHEP(5,JCL)=EM1 + CALL HWDTWO(PCL,PHEP(1,JCL),PHEP(1,LCL),PC1,TWO,.TRUE.) + GOTO 150 + ELSE + CALL HWWARN('HWCFOR',102,*999) + ENDIF + 140 CONTINUE + CALL HWWARN('HWCFOR',103,*999) + 150 CONTINUE + ISTAT=60 +C Non-partons labelled as partons (ie photons) should get copied + DO 160 IHEP=1,NHEP + IF (ISTHEP(IHEP).EQ.150) THEN + NHEP=NHEP+1 + JDAHEP(1,IHEP)=NHEP + ISTHEP(IHEP)=157 + ISTHEP(NHEP)=190 + IDHW(NHEP)=IDHW(IHEP) + IDHEP(NHEP)=IDPDG(IDHW(IHEP)) + CALL HWVEQU(5,PHEP(1,IHEP),PHEP(1,NHEP)) + CALL HWVEQU(4,VHEP(1,IHEP),VHEP(1,NHEP)) + JMOHEP(1,NHEP)=IHEP + JMOHEP(2,NHEP)=JMOHEP(1,IHEP) + JDAHEP(1,NHEP)=0 + JDAHEP(2,NHEP)=0 + ENDIF + 160 CONTINUE + 999 END +CDECK ID>, HWCGSP. +*CMZ :- -13/07/92 20.15.54 by Mike Seymour +*-- Author : Bryan Webber +C----------------------------------------------------------------------- + SUBROUTINE HWCGSP +C----------------------------------------------------------------------- +C SPLITS ANY TIMELIKE GLUONS REMAINING AFTER PERTURBATIVE +C BRANCHING INTO LIGHT (I.E. U OR D) Q-QBAR PAIRS +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + DOUBLE PRECISION HWR,PF + INTEGER HWRINT,IHEP,JHEP,KHEP,LHEP,MHEP,ID,J,IST + EXTERNAL HWR,HWRINT + IF (NGSPL.EQ.0) CALL HWWARN('HWCGSP',400,*999) + LHEP=NHEP-1 + MHEP=NHEP + DO 100 IHEP=1,NHEP + IF (ISTHEP(IHEP).GE.147.AND.ISTHEP(IHEP).LE.149) THEN + JHEP=JMOHEP(2,IHEP) +C BRW FIX 12/03/99 + IF (JHEP.LE.0) THEN + KHEP=0 + DO JHEP=1,NHEP + IF (ISTHEP(JHEP).GE.147.AND.ISTHEP(JHEP).LE.149 + & .AND.JDAHEP(2,JHEP).LE.0) THEN + KHEP=KHEP+1 + JMOHEP(2,IHEP)=JHEP + JDAHEP(2,JHEP)=IHEP + ENDIF + ENDDO + IF (KHEP.EQ.0) CALL HWWARN('HWCGSP',102,*999) + IF (KHEP.NE.1) CALL HWWARN('HWCGSP',103,*999) + ENDIF +C END FIX +C---CHECK FOR DECAYED HEAVY ANTIQUARKS + IF (ISTHEP(JHEP).EQ.155) THEN + JHEP=JDAHEP(1,JDAHEP(2,JHEP)) + DO 10 J=JDAHEP(1,JHEP),JDAHEP(2,JHEP) + 10 IF (ISTHEP(J).EQ.149.AND.JDAHEP(2,J).EQ.0) GOTO 20 + CALL HWWARN('HWCGSP',100,*999) + 20 JHEP=J + ENDIF + KHEP=JDAHEP(2,IHEP) +C BRW FIX 12/03/99 + IF (KHEP.LE.0) THEN + KHEP=0 + DO JHEP=1,NHEP + IF (ISTHEP(JHEP).GE.147.AND.ISTHEP(JHEP).LE.149 + & .AND.JMOHEP(2,JHEP).LE.0) THEN + KHEP=KHEP+1 + JDAHEP(2,IHEP)=JHEP + JMOHEP(2,JHEP)=IHEP + ENDIF + ENDDO + IF (KHEP.EQ.0) CALL HWWARN('HWCGSP',104,*999) + IF (KHEP.NE.1) CALL HWWARN('HWCGSP',105,*999) + KHEP=JDAHEP(2,IHEP) + ENDIF +C END FIX +C---CHECK FOR DECAYED HEAVY QUARKS + IF (ISTHEP(KHEP).EQ.155) CALL HWWARN('HWCGSP',101,*999) + IF (IDHW(IHEP).EQ.13) THEN +C---SPLIT A GLUON + LHEP=LHEP+2 + MHEP=MHEP+2 + IF(MHEP.GT.NMXHEP) CALL HWWARN('HWCGSP',106,*999) + 30 ID=HWRINT(1,NGSPL) + IF (PGSPL(ID).LT.PGSMX*HWR()) GOTO 30 + PHEP(5,LHEP)=RMASS(ID) + PHEP(5,MHEP)=RMASS(ID) +C---ASSUME ISOTROPIC ANGULAR DISTRIBUTION + IF (PHEP(5,IHEP).GT.PHEP(5,LHEP)+PHEP(5,MHEP)) THEN + CALL HWDTWO(PHEP(1,IHEP),PHEP(1,LHEP), + & PHEP(1,MHEP),PGSPL(ID),TWO,.TRUE.) + ELSE + PF=HWR() + CALL HWVSCA(4,PF,PHEP(1,IHEP),PHEP(1,LHEP)) + CALL HWVDIF(4,PHEP(1,IHEP),PHEP(1,LHEP),PHEP(1,MHEP)) + PHEP(5,LHEP)=PF*PHEP(5,IHEP) + PHEP(5,MHEP)=PHEP(5,IHEP)-PHEP(5,LHEP) + ENDIF + CALL HWUDKL(13,PHEP(1,IHEP),VHEP(1,LHEP)) + CALL HWVSUM(4,VHEP(1,IHEP),VHEP(1,LHEP),VHEP(1,LHEP)) + CALL HWVEQU(4,VHEP(1,LHEP),VHEP(1,MHEP)) + IDHW(LHEP)=ID+6 + IDHW(MHEP)=ID + IDHEP(MHEP)= IDPDG(ID) + IDHEP(LHEP)=-IDPDG(ID) + ISTHEP(IHEP)=2 + ISTHEP(LHEP)=150 + ISTHEP(MHEP)=150 +C---NEW COLOUR CONNECTIONS + IF(RPARTY.OR.JMOHEP(2,KHEP).EQ.IHEP) JMOHEP(2,KHEP)=LHEP + IF(RPARTY.OR.JDAHEP(2,JHEP).EQ.IHEP) JDAHEP(2,JHEP)=MHEP + JMOHEP(1,LHEP)=JMOHEP(1,IHEP) + JMOHEP(2,LHEP)=MHEP + JMOHEP(1,MHEP)=JMOHEP(1,IHEP) + JMOHEP(2,MHEP)=JHEP + JDAHEP(1,LHEP)=0 + JDAHEP(2,LHEP)=KHEP + JDAHEP(1,MHEP)=0 + JDAHEP(2,MHEP)=LHEP + JDAHEP(1,IHEP)=LHEP + JDAHEP(2,IHEP)=MHEP + ELSE +C---COPY A NON-GLUON + LHEP=LHEP+1 + MHEP=MHEP+1 + IF(MHEP.GT.NMXHEP) CALL HWWARN('HWCGSP',107,*999) + CALL HWVEQU(5,PHEP(1,IHEP),PHEP(1,MHEP)) + CALL HWVEQU(4,VHEP(1,IHEP),VHEP(1,MHEP)) + IDHW(MHEP)=IDHW(IHEP) + IDHEP(MHEP)=IDHEP(IHEP) + IST=ISTHEP(IHEP) + ISTHEP(IHEP)=2 + IF (IST.EQ.149) THEN + ISTHEP(MHEP)=150 + ELSE + ISTHEP(MHEP)=IST+6 + ENDIF +C---NEW COLOUR CONNECTIONS + IF(RPARTY.OR.JMOHEP(2,KHEP).EQ.IHEP) + & JMOHEP(2,KHEP)=MHEP + IF(RPARTY.OR.(JHEP.NE.IHEP.AND.JDAHEP(2,JHEP).EQ.IHEP)) + & JDAHEP(2,JHEP)=MHEP + JMOHEP(1,MHEP)=JMOHEP(1,IHEP) + JMOHEP(2,MHEP)=JMOHEP(2,IHEP) + JDAHEP(1,MHEP)=0 + JDAHEP(2,MHEP)=JDAHEP(2,IHEP) + JDAHEP(1,IHEP)=MHEP + ENDIF + ENDIF + 100 CONTINUE + NHEP=MHEP + 999 END +CDECK ID>, HWCHAD. +*CMZ :- -26/04/91 14.00.57 by Federico Carminati +*-- Author : Bryan Webber +C----------------------------------------------------------------------- + SUBROUTINE HWCHAD(JCL,ID1,ID3,ID2) +C----------------------------------------------------------------------- +C HADRONIZES CLUSTER JCL, CONSISTING OF PARTONS ID1,ID3 +C ID2 RETURNS PARTON-ANTIPARTON PAIR CREATED +C (IN SPECIAL CLUSTER CODE - SEE HWCFLA) +C +C MODIFIED 15/11/99 TO SMEAR POSITIONS OF HADRONS BY 1/(CLUSTER MASS) +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + DOUBLE PRECISION HWR,HWRGAU,HWVDOT,EM0,EM1,EM2,EMADU,EMSQ, + & PCMAX,PCM,PTEST,PCQK,PP(5),EMLOW,RMAT(3,3),CT,ST,CX,SX,HPSMR + INTEGER HWRINT,JCL,ID1,ID2,ID3,ID,IR1,IR2,NTRY,IDMIN,IMAX,I,MHEP, + & IM,JM,KM,IB + LOGICAL DIQK + EXTERNAL HWR,HWRINT + DIQK(ID)=ID.GT.3.AND.ID.LT.10 + IF (IERROR.NE.0) RETURN + ID2=0 + EM0=PHEP(5,JCL) + IR1=NCLDK(LOCN(ID1,ID3)) + EM1=RMIN(ID1,ID3) + IF (ABS(EM0-EM1).LT.0.001) THEN +C---SINGLE-HADRON CLUSTER + NHEP=NHEP+1 + IF (NHEP.GT.NMXHEP) CALL HWWARN('HWCHAD',100,*999) + IDHW(NHEP)=IR1 + IDHEP(NHEP)=IDPDG(IR1) + ISTHEP(NHEP)=191 + JDAHEP(1,JCL)=NHEP + JDAHEP(2,JCL)=NHEP + CALL HWVEQU(5,PHEP(1,JCL),PHEP(1,NHEP)) + CALL HWVSUM(4,VHEP(1,JCL),VTXPIP,VHEP(1,NHEP)) + ELSE + NTRY=0 + IDMIN=1 + EMLOW=RMIN(ID1,1)+RMIN(1,ID3) + EMADU=RMIN(ID1,2)+RMIN(2,ID3) + IF (EMADU.LT.EMLOW) THEN + IDMIN=2 + EMLOW=EMADU + ENDIF + EMSQ=EM0**2 + PCMAX=EMSQ-EMLOW**2 + IF (PCMAX.GE.ZERO) THEN +C---SET UP TWO QUARK-ANTIQUARK PAIRS OR A +C QUARK-DIQUARK AND AN ANTIDIQUARK-ANTIQUARK + PCMAX=PCMAX*(EMSQ-(RMIN(ID1,IDMIN)-RMIN(IDMIN,ID3))**2) + IMAX=12 + IF (DIQK(ID1).OR.DIQK(ID3)) IMAX=3 + DO 10 I=3,IMAX + IF (EM0.LT.RMIN(ID1,I)+RMIN(I,ID3)) GOTO 20 + 10 CONTINUE + I=IMAX+1 + 20 ID2=HWRINT(1,I-1) + IF (PWT(ID2).NE.ONE) THEN + IF (PWT(ID2).LT.HWR()) GOTO 20 + ENDIF +C---PICK TWO PARTICLES WITH THESE QUANTUM NUMBERS + NTRY=NTRY+1 + 30 IR1=LOCN(ID1,ID2)+INT(RESN(ID1,ID2)*HWR()) + IF (CLDKWT(IR1).LT.HWR()) GOTO 30 + IR1=NCLDK(IR1) + 40 IR2=LOCN(ID2,ID3)+INT(RESN(ID2,ID3)*HWR()) + IF (CLDKWT(IR2).LT.HWR()) GOTO 40 + IR2=NCLDK(IR2) + EM1=RMASS(IR1) + EM2=RMASS(IR2) + PCM=EMSQ-(EM1+EM2)**2 + IF (PCM.GT.ZERO) GOTO 70 + 50 IF (NTRY.LE.NDTRY) GOTO 20 +C---CAN'T FIND A DECAY MODE - CHOOSE LIGHTEST + 60 ID2=HWRINT(1,2) + IR1=NCLDK(LOCN(ID1,ID2)) + IR2=NCLDK(LOCN(ID2,ID3)) + EM1=RMASS(IR1) + EM2=RMASS(IR2) + PCM=EMSQ-(EM1+EM2)**2 + IF (PCM.GT.ZERO) GOTO 70 + NTRY=NTRY+1 + IF (NTRY.LE.NDTRY+50) GOTO 60 + CALL HWWARN('HWCHAD',101,*999) +C---DECAY IS ALLOWED + 70 PCM=PCM*(EMSQ-(EM1-EM2)**2) + IF (NTRY.GT.NCTRY) GOTO 80 + PTEST=PCM*SWTEF(IR1)*SWTEF(IR2) + IF (PTEST.LT.PCMAX*HWR()**2) GOTO 20 + ELSE +C---ALLOW DECAY BY PI0 EMISSION IF ONLY POSSIBILITY + ID2=1 + IR2=NCLDK(LOCN(1,1)) + EM2=RMASS(IR2) + PCM=(EMSQ-(EM1+EM2)**2)*(EMSQ-(EM1-EM2)**2) + ENDIF +C---DECAY IS CHOSEN. GENERATE DECAY MOMENTA +C AND PUT PARTICLES IN /HEPEVT/ + 80 IF (PCM.LT.ZERO) CALL HWWARN('HWCHAD',102,*999) + PCM=0.5*SQRT(PCM)/EM0 + MHEP=NHEP+1 + NHEP=NHEP+2 + IF (NHEP.GT.NMXHEP) CALL HWWARN('HWCHAD',103,*999) + PHEP(5,MHEP)=EM1 + PHEP(5,NHEP)=EM2 +C Decide if cluster contains a b-(anti)quark or not + IF (ID1.EQ.11.OR.ID2.EQ.11.OR.ID3.EQ.11) THEN + IB=2 + ELSE + IB=1 + ENDIF + IF (CLDIR(IB).NE.0) THEN + DO 110 IM=1,2 + JM=JMOHEP(IM,JCL) + IF (JM.EQ.0) GOTO 110 + IF (ISTHEP(JM).NE.158) GOTO 110 +C LOOK FOR PARENT PARTON + DO 100 KM=JMOHEP(1,JM)+1,JM + IF (ISTHEP(KM).EQ.2) THEN + IF (JDAHEP(1,KM).EQ.JM) THEN +C FOUND PARENT PARTON + IF (IDHW(KM).NE.13) THEN +C FIND ITS DIRECTION IN CLUSTER CMF + CALL HWULOF(PHEP(1,JCL),PHEP(1,KM),PP) + PCQK=PP(1)**2+PP(2)**2+PP(3)**2 + IF (PCQK.GT.ZERO) THEN + PCQK=SQRT(PCQK) + IF (CLSMR(IB).GT.ZERO) THEN +C DO GAUSSIAN SMEARING OF DIRECTION + 90 CT=ONE+CLSMR(IB)*LOG(HWR()) + IF (CT.LT.-ONE) GOTO 90 + ST=ONE-CT*CT + IF (ST.GT.ZERO) ST=SQRT(ST) + CALL HWRAZM( ONE,CX,SX) + CALL HWUROT(PP,CX,SX,RMAT) + PP(1)=ZERO + PP(2)=PCQK*ST + PP(3)=PCQK*CT + CALL HWUROB(RMAT,PP,PP) + ENDIF + PCQK=PCM/PCQK + IF (IM.EQ.2) PCQK=-PCQK + CALL HWVSCA(3,PCQK,PP,PHEP(1,MHEP)) + PHEP(4,MHEP)=SQRT(PHEP(5,MHEP)**2+PCM**2) + CALL HWULOB(PHEP(1,JCL),PHEP(1,MHEP),PHEP(1,MHEP)) + CALL HWVDIF(4,PHEP(1,JCL),PHEP(1,MHEP),PHEP(1,NHEP)) + GOTO 130 + ENDIF + ENDIF + GOTO 120 + ENDIF + ELSEIF (ISTHEP(KM).GT.140) THEN +C FINISHED THIS JET + GOTO 110 + ENDIF + 100 CONTINUE + 110 CONTINUE + ENDIF + 120 CALL HWDTWO(PHEP(1,JCL),PHEP(1,MHEP),PHEP(1,NHEP), + & PCM,TWO,.TRUE.) + 130 IDHW(MHEP)=IR1 + IDHW(NHEP)=IR2 + IDHEP(MHEP)=IDPDG(IR1) + IDHEP(NHEP)=IDPDG(IR2) + ISTHEP(MHEP)=192 + ISTHEP(NHEP)=192 + JMOHEP(1,MHEP)=JCL +C---SECOND MOTHER OF HADRON IS JET + JMOHEP(2,MHEP)=JMOHEP(1,JMOHEP(1,JCL)) + JDAHEP(1,JCL)=MHEP + JDAHEP(2,JCL)=NHEP +C---SMEAR HADRON POSITIONS + HPSMR=GEV2MM/PHEP(5,JCL) + DO I=1,4 + VHEP(I,MHEP)=HWRGAU(I,ZERO,HPSMR) + ENDDO + VHEP(4,MHEP)=ABS(VHEP(4,MHEP)) + & +SQRT(HWVDOT(3,VHEP(1,MHEP),VHEP(1,MHEP))) + CALL HWULB4(PHEP(1,JCL),VHEP(1,MHEP),VHEP(1,MHEP)) + CALL HWVSUM(4,VHEP(1,JCL),VHEP(1,MHEP),VHEP(1,MHEP)) + CALL HWVSUM(4,VTXPIP,VHEP(1,MHEP),VHEP(1,MHEP)) + DO I=1,4 + VHEP(I,NHEP)=HWRGAU(I,ZERO,HPSMR) + ENDDO + VHEP(4,NHEP)=ABS(VHEP(4,NHEP)) + & +SQRT(HWVDOT(3,VHEP(1,NHEP),VHEP(1,NHEP))) + CALL HWULB4(PHEP(1,JCL),VHEP(1,NHEP),VHEP(1,NHEP)) + CALL HWVSUM(4,VHEP(1,JCL),VHEP(1,NHEP),VHEP(1,NHEP)) + CALL HWVSUM(4,VTXPIP,VHEP(1,NHEP),VHEP(1,NHEP)) + ENDIF + ISTHEP(JCL)=180+MOD(ISTHEP(JCL),10) + JMOHEP(1,NHEP)=JCL + JMOHEP(2,NHEP)=JMOHEP(1,JMOHEP(1,JCL)) + 999 END +CDECK ID>, HWDBOS. +*CMZ :- -23/05/96 18.34.17 by Mike Seymour +*-- Author : Mike Seymour +C----------------------------------------------------------------------- + SUBROUTINE HWDBOS(IBOSON) +C----------------------------------------------------------------------- +C DECAY GAUGE BOSONS (ALREADY FOUND BY HWDHAD) +C USES SPIN DENSITY MATRIX IN RHOHEP (1ST CMPT=>-VE,2=>LONG,3=>+VE) +C IF BOSON CAME FROM HIGGS DECAY, GIVE BOTH THE SAME HELICITY (EPR) +C IF BOSON CAME FROM W+1JET, GIVE IT THE CORRECT DECAY CORRELATIONS +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + DOUBLE PRECISION HWR,HWRUNI,HWUPCM,HWULDO,R(3,3),CV,CA,BR,PCM, + & PBOS(5),PMAX,PROB,RRLL,RLLR + INTEGER HWRINT,IBOS,IBOSON,IPAIR,ICMF,IOPT,IHEL,IMOTH, + & I,IQRK,IANT,ID,IQ + LOGICAL QUARKS + EXTERNAL HWR,HWRUNI,HWUPCM,HWULDO,HWRINT + IBOS=IBOSON + IF (IDHW(IBOS).LT.198.OR.IDHW(IBOS).GT.200) + & CALL HWWARN('HWDBOS',101,*999) + QUARKS=.FALSE. +C---SEE IF IT IS PART OF A PAIR + IMOTH=JMOHEP(1,IBOS) + IPAIR=JMOHEP(2,IBOS) + ICMF=JMOHEP(1,IBOS) + IF (IDHW(ICMF).EQ.IDHW(IBOS).AND.ISTHEP(ICMF)/10.EQ.12) + & ICMF=JMOHEP(1,ICMF) + IOPT=0 + IF (IPAIR.NE.0) THEN + IF (JMOHEP(2,IPAIR).NE.IBOS.OR. + & IDHW(IPAIR).LT.198.OR.IDHW(IPAIR).GT.200) IPAIR=0 + ENDIF + IF (IPAIR.GT.0) IOPT=1 +C---SELECT DECAY PRODUCTS + 10 CALL HWDBOZ(IDHW(IBOS),IDN(1),IDN(2),CV,CA,BR,IOPT) +C---V + 1JET DECAYS ARE NOW HANDLED HERE ! + IF (IPRO.EQ.21) THEN + IQRK=IDHW(JMOHEP(1,ICMF)) + IANT=IDHW(JMOHEP(2,ICMF)) + IF (IQRK.EQ.13 .AND. IANT.LE.6) THEN + IQRK=JMOHEP(2,ICMF) + IANT=JDAHEP(2,ICMF) + ELSEIF (IQRK.EQ.13) THEN + IQRK=JDAHEP(2,ICMF) + IANT=JMOHEP(2,ICMF) + ELSEIF (IANT.EQ.13 .AND. IQRK.LE.6) THEN + IQRK=JMOHEP(1,ICMF) + IANT=JDAHEP(2,ICMF) + ELSEIF (IANT.EQ.13) THEN + IQRK=JDAHEP(2,ICMF) + IANT=JMOHEP(1,ICMF) + ELSEIF (IQRK.GT.IANT) THEN + IQRK=JMOHEP(2,ICMF) + IANT=JMOHEP(1,ICMF) + ELSE + IQRK=JMOHEP(1,ICMF) + IANT=JMOHEP(2,ICMF) + ENDIF + PHEP(5,NHEP+1)=RMASS(IDN(1)) + PHEP(5,NHEP+2)=RMASS(IDN(2)) + PCM=HWUPCM(PHEP(5,IBOS),PHEP(5,NHEP+1),PHEP(5,NHEP+2)) + IF (PCM.LT.ZERO) CALL HWWARN('HWDBOS',103,*999) + IF (IDHW(IBOS).EQ.200) THEN + ID=IDN(1) + IF (ID.GT.120) ID=ID-110 + IQ=IDHW(IQRK) + IF (IQ.GT.6) IQ=IQ-6 + RRLL=(VFCH(IQ,1)**2+AFCH(IQ,1)**2)* + $ (VFCH(ID,1)**2+AFCH(ID,1)**2) + $ +4*VFCH(IQ,1)*AFCH(IQ,1)* + $ VFCH(ID,1)*AFCH(ID,1) + RLLR=(VFCH(IQ,1)**2+AFCH(IQ,1)**2)* + $ (VFCH(ID,1)**2+AFCH(ID,1)**2) + $ -4*VFCH(IQ,1)*AFCH(IQ,1)* + $ VFCH(ID,1)*AFCH(ID,1) + ELSE + RRLL=1 + RLLR=0 + ENDIF + PMAX=(RRLL+RLLR) + & *(HWULDO(PHEP(1,IANT),PHEP(1,IBOS))**2+ + & HWULDO(PHEP(1,IQRK),PHEP(1,IBOS))**2) + 1 CALL HWDTWO(PHEP(1,IBOS),PHEP(1,NHEP+1),PHEP(1,NHEP+2), + & PCM,TWO,.TRUE.) + PROB=RRLL*(HWULDO(PHEP(1,IANT),PHEP(1,NHEP+1))**2+ + & HWULDO(PHEP(1,IQRK),PHEP(1,NHEP+2))**2)+ + & RLLR*(HWULDO(PHEP(1,IANT),PHEP(1,NHEP+2))**2+ + & HWULDO(PHEP(1,IQRK),PHEP(1,NHEP+1))**2) + IF (PROB.GT.PMAX.OR.PROB.LT.ZERO) + & CALL HWWARN('HWDBOS',104,*999) + IF (PMAX*HWR().GT.PROB) GOTO 1 + ELSE +C---SELECT HELICITY, UNLESS IT IS THE SECOND OF A HIGGS DECAY (EPR) + IF (IPAIR.NE.IBOS .OR. IDHW(ICMF).NE.201) THEN + IF (RHOHEP(1,IBOS)+RHOHEP(2,IBOS)+RHOHEP(3,IBOS).LE.ZERO) THEN +C---COPY PARENT HELICITY IF IT WAS A GAUGE BOSON + IF (IDHW(IMOTH).GE.198.AND.IDHW(IMOTH).LE.200) THEN + CALL HWVEQU(3,RHOHEP(1,IMOTH),RHOHEP(1,IBOS)) + IF (RHOHEP(1,IBOS)+RHOHEP(2,IBOS)+RHOHEP(3,IBOS).GT.ZERO) + & GOTO 20 +C---MAY BE FROM A SUSY DECAY + ELSEIF (ABS(IDHEP(IMOTH)).LT.1000000) THEN + CALL HWWARN('HWDBOS',1,*999) + ENDIF + RHOHEP(1,IBOS)=1. + RHOHEP(2,IBOS)=1. + RHOHEP(3,IBOS)=1. + ENDIF + 20 IHEL=HWRINT(1,3) + IF (HWR().GT.RHOHEP(IHEL,IBOS)) GOTO 20 + ENDIF +C---SELECT DIRECTION OF FERMION + 30 COSTH=HWRUNI(0,-ONE,ONE) + IF (IHEL.EQ.1 .AND. (ONE+COSTH)**2.LT.HWR()*FOUR) GOTO 30 + IF (IHEL.EQ.2 .AND. (ONE-COSTH**2).LT.HWR() ) GOTO 30 + IF (IHEL.EQ.3 .AND. (ONE-COSTH)**2.LT.HWR()*FOUR) GOTO 30 +C---GENERATE DECAY RELATIVE TO Z-AXIS + PHEP(5,NHEP+1)=RMASS(IDN(1)) + PHEP(5,NHEP+2)=RMASS(IDN(2)) + PCM=HWUPCM(PHEP(5,IBOS),PHEP(5,NHEP+1),PHEP(5,NHEP+2)) + IF (PCM.LT.ZERO) CALL HWWARN('HWDBOS',102,*999) + CALL HWRAZM(PCM*SQRT(1-COSTH**2),PHEP(1,NHEP+1),PHEP(2,NHEP+1)) + PHEP(3,NHEP+1)=PCM*COSTH + PHEP(4,NHEP+1)=SQRT(PHEP(5,NHEP+1)**2+PCM**2) +C---ROTATE SO THAT Z-AXIS BECOMES BOSON'S DIRECTION IN ORIGINAL CM FRAME + CALL HWULOF(PHEP(1,ICMF),PHEP(1,IBOS),PBOS) + CALL HWUROT(PBOS, ONE,ZERO,R) + CALL HWUROB(R,PHEP(1,NHEP+1),PHEP(1,NHEP+1)) +C---BOOST BACK TO LAB + CALL HWULOB(PHEP(1,IBOS),PHEP(1,NHEP+1),PHEP(1,NHEP+1)) + CALL HWVDIF(4,PHEP(1,IBOS),PHEP(1,NHEP+1),PHEP(1,NHEP+2)) + ENDIF +C---STATUS, IDs AND POINTERS + ISTHEP(IBOS)=195 + DO 50 I=1,2 + ISTHEP(NHEP+I)=193 + IDHW(NHEP+I)=IDN(I) + IDHEP(NHEP+I)=IDPDG(IDN(I)) + JDAHEP(I,IBOS)=NHEP+I + JMOHEP(1,NHEP+I)=IBOS + JMOHEP(2,NHEP+I)=JMOHEP(1,IBOS) + 50 CONTINUE + NHEP=NHEP+2 + IF (IDN(1).LE.12) THEN + ISTHEP(NHEP-1)=113 + ISTHEP(NHEP)=114 + JMOHEP(2,NHEP)=NHEP-1 + JDAHEP(2,NHEP)=NHEP-1 + JMOHEP(2,NHEP-1)=NHEP + JDAHEP(2,NHEP-1)=NHEP + QUARKS=.TRUE. + ENDIF +C---IF FIRST OF A PAIR, DO SECOND DECAY + IF (IPAIR.NE.0 .AND. IPAIR.NE.IBOS) THEN + IBOS=IPAIR + GOTO 10 + ENDIF +C---IF QUARK DECAY, HADRONIZE + IF (QUARKS) THEN + EMSCA=PHEP(5,IBOS) + CALL HWBGEN + CALL HWDHOB + CALL HWCFOR + CALL HWCDEC + ENDIF + 999 END +CDECK ID>, HWDBOZ. +*CMZ :- -29/04/91 18.00.03 by Federico Carminati +*-- Author : Mike Seymour +C----------------------------------------------------------------------- + SUBROUTINE HWDBOZ(IDBOS,IFER,IANT,CV,CA,BR,IOPT) +C----------------------------------------------------------------------- +C CHOOSE DECAY MODE OF BOSON +C IOPT=2 TO RESET COUNTERS, 1 FOR BOSON PAIR, 0 FOR ANY OTHERS +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + DOUBLE PRECISION HWR,BRMODE(12,3),CV,CA,BR,BRLST,BRCOM,FACZ, + & FACW + INTEGER HWRINT,IDBOS,IDEC,IDMODE(2,12,3),IFER,IANT,IOPT,I1,I2, + & I1LST,I2LST,NWGLST,NUMDEC,NPAIR,MODTMP,JFER + LOGICAL GENLST + EXTERNAL HWR,HWRINT + SAVE FACW,FACZ,NWGLST,GENLST,NUMDEC,NPAIR,I1LST,I2LST,BRLST + DATA NWGLST,GENLST,NPAIR/-1,.FALSE.,0/ +C---STORE THE DECAY MODES (FERMION FIRST) + DATA IDMODE/ 2, 7, 4, 9, 6, 11, 2, 9, 4, 7, + & 122,127,124,129,126,131,8*0, + & 1, 8, 3, 10, 5, 12, 3, 8, 1, 10, + & 121,128,123,130,125,132,8*0, + & 1, 7, 2, 8, 3, 9, 4, 10, 5, 11, 6, 12, + & 121,127,123,129,125,131,122,128,124,130,126,132/ +C---STORE THE BRANCHING RATIOS TO THESE MODES + DATA BRMODE/0.321,0.321,0.000,0.017,0.017,0.108,0.108,0.108,4*0.0, + & 0.321,0.321,0.000,0.017,0.017,0.108,0.108,0.108,4*0.0, + & 0.154,0.120,0.154,0.120,0.152,0.000, + & 0.033,0.033,0.033,0.067,0.067,0.067/ +C---FACTORS FOR CV AND CA FOR W AND Z + DATA FACW,FACZ/2*0.0/ + IF (FACZ.EQ.ZERO) FACZ=SQRT(SWEIN) + IF (FACW.EQ.ZERO) FACW=0.5/SQRT(2D0) + IF (IDBOS.LT.198.OR.IDBOS.GT.200) CALL HWWARN('HWDBOZ',101,*999) +C---IF THIS IS A NEW EVENT SINCE LAST TIME, ZERO COUNTERS + IF (NWGTS.NE.NWGLST .OR.(GENEV.NEQV.GENLST).OR. IOPT.EQ.2) THEN + NPAIR=0 + NUMDEC=0 + NWGLST=NWGTS + GENLST=GENEV + IF (IOPT.EQ.2) RETURN + ENDIF + NUMDEC=NUMDEC+1 + IF (NUMDEC.GT.MODMAX) CALL HWWARN('HWDBOZ',102,*999) +C---IF PAIR OPTION SPECIFIED FOR THE FIRST TIME, MAKE CHOICE + IF (IOPT.EQ.1) THEN + IF (NUMDEC.GT.MODMAX-1) CALL HWWARN('HWDBOZ',103,*999) + IF (NPAIR.EQ.0) THEN + IF (HWR().GT.HALF) THEN + MODTMP=MODBOS(NUMDEC+1) + MODBOS(NUMDEC+1)=MODBOS(NUMDEC) + MODBOS(NUMDEC)=MODTMP + ENDIF + NPAIR=NUMDEC + ELSE + NPAIR=0 + ENDIF + ENDIF +C---SELECT USER'S CHOICE + IF (IDBOS.EQ.200) THEN + IF (MODBOS(NUMDEC).EQ.1) THEN + I1=1 + I2=6 + ELSEIF (MODBOS(NUMDEC).EQ.2) THEN + I1=7 + I2=7 + ELSEIF (MODBOS(NUMDEC).EQ.3) THEN + I1=8 + I2=8 + ELSEIF (MODBOS(NUMDEC).EQ.4) THEN + I1=9 + I2=9 + ELSEIF (MODBOS(NUMDEC).EQ.5) THEN + I1=7 + I2=8 + ELSEIF (MODBOS(NUMDEC).EQ.6) THEN + I1=10 + I2=12 + ELSEIF (MODBOS(NUMDEC).EQ.7) THEN + I1=5 + I2=5 + ELSE + I1=1 + I2=12 + ENDIF + ELSE + IF (MODBOS(NUMDEC).EQ.1) THEN + I1=1 + I2=5 + ELSEIF (MODBOS(NUMDEC).EQ.2) THEN + I1=6 + I2=6 + ELSEIF (MODBOS(NUMDEC).EQ.3) THEN + I1=7 + I2=7 + ELSEIF (MODBOS(NUMDEC).EQ.4) THEN + I1=8 + I2=8 + ELSEIF (MODBOS(NUMDEC).EQ.5) THEN + I1=6 + I2=7 + ELSE + I1=1 + I2=8 + ENDIF + ENDIF + 10 IDEC=HWRINT(I1,I2) + IF (HWR().GT.BRMODE(IDEC,IDBOS-197).AND.I1.NE.I2) GOTO 10 + IFER=IDMODE(1,IDEC,IDBOS-197) + IANT=IDMODE(2,IDEC,IDBOS-197) +C---CALCULATE BRANCHING RATIO +C (RESULT IS NOT WELL-DEFINED AFTER THE FIRST CALL OF A PAIR) + BR=0 + DO 20 IDEC=I1,I2 + 20 BR=BR+BRMODE(IDEC,IDBOS-197) + IF (IOPT.EQ.1) THEN + IF (NPAIR.NE.0) THEN + I1LST=I1 + I2LST=I2 + BRLST=BR + ELSE + BRCOM=0 + DO 30 IDEC=MAX(I1,I1LST),MIN(I2,I2LST) + 30 BRCOM=BRCOM+BRMODE(IDEC,IDBOS-197) + BR=2*BR*BRLST - BRCOM**2 + ENDIF + ENDIF +C---SET UP VECTOR AND AXIAL VECTOR COUPLINGS (NORMALIZED TO THE +C CONVENTION WHERE THE WEAK CURRENT IS G*(CV-CA*GAM5) ) + IF (IDBOS.EQ.200) THEN + IF (IFER.LE.6) THEN +C Quark couplings + CV=VFCH(IFER,1) + CA=AFCH(IFER,1) + ELSE +C lepton couplings + JFER=IFER-110 + CV=VFCH(JFER,1) + CA=AFCH(JFER,1) + ENDIF + CV=CV * FACZ + CA=CA * FACZ + ELSE + CV=FACW + CA=FACW + ENDIF + 999 END +CDECK ID>, HWDCHK. +*CMZ :- -27/07/99 13.33.03 by Mike Seymour +*-- Author : Ian Knowles +C----------------------------------------------------------------------- + SUBROUTINE HWDCHK(IDKY,L,*) +C----------------------------------------------------------------------- +C Checks line L of decay table is compatible with decay of particle +C IDKY, tidies up the line and sets NPRODS. +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + DOUBLE PRECISION EPS,QS,Q,DM + INTEGER IDKY,L,IFAULT,I,ID,J + PARAMETER (EPS=1.D-6) + IF (VTOCDK(IDKY).AND.VTORDK(IDKY)) RETURN 1 + IFAULT=0 + QS=FLOAT(ICHRG(IDKY)) + IF (IDKY.LE.12.OR.(IDKY.GE.109.AND.IDKY.LE.120) + & .OR.(IDKY.GE.209.AND.IDKY.LE.220) + & .OR.(IDKY.GE.401.AND.IDKY.LE.424)) QS=QS/3. + DM=RMASS(IDKY) + NPRODS(L)=0 + DO 10 I=1,5 + ID=IDKPRD(I,L) + IF (ID.LT.0.OR.ID.EQ.20.OR.ID.GT.NRES) THEN + WRITE(6,20) L,RNAME(IDKY),(RNAME(IDKPRD(J,L)),J=1,5) + IFAULT=IFAULT+1 + ELSEIF (ID.NE.0) THEN + IF (VTORDK(ID)) THEN + WRITE(6,30) L,RNAME(IDKY),(RNAME(IDKPRD(J,L)),J=1,5),RNAME(ID) + IFAULT=IFAULT+1 + ENDIF + NPRODS(L)=NPRODS(L)+1 + IDKPRD(NPRODS(L),L)=ID + Q=FLOAT(ICHRG(ID)) + IF (ID.LE.12.OR.(ID.GE.109.AND.ID.LE.120) + & .OR.(ID.GE.209.AND.ID.LE.220) + & .OR.(ID.GE.401.AND.ID.LE.424)) Q=Q/3. + QS=QS-Q + DM=DM-RMASS(ID) + ENDIF + 10 CONTINUE +C print any warnings + IF (NPRODS(L).EQ.0) THEN + WRITE(6,20) L,RNAME(IDKY),(RNAME(IDKPRD(I,L)),I=1,5) + IFAULT=IFAULT+1 + ELSE + IF (ABS(QS).GT.EPS) THEN + WRITE(6,40) L,RNAME(IDKY),(RNAME(IDKPRD(I,L)),I=1,5),QS + IFAULT=IFAULT+1 + ENDIF + IF (DM.LT.ZERO) THEN + WRITE(6,50) L,RNAME(IDKY),(RNAME(IDKPRD(I,L)),I=1,5),DM + IFAULT=IFAULT+1 + ENDIF + ENDIF + 20 FORMAT(1X,'Line ',I4,' decay: ',A8,' --> ',4(A8,1X),A8/ + & 1X,'contains no or unrecognised decay product(s)') + 30 FORMAT(1X,'Line ',I4,' decay: ',A8,' --> ',4(A8,1X),A8/ + & 1X,'contains decay product ',A8,' which is vetoed') + 40 FORMAT(1X,'Line ',I4,' decay: ',A8,' --> ',4(A8,1X),A8/ + & 1X,'violates charge conservation, Qin-Qout= ',F6.3) + 50 FORMAT(1X,'Line ',I4,' decay: ',A8,' --> ',4(A8,1X),A8/ + & 1X,'is kinematically not allowed, Min-Mout= ',F10.3) + IF (IFAULT.NE.0) THEN + RETURN 1 + ELSE + RETURN + ENDIF + END +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----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + INTEGER IHEP,IIHEP,NHEPHF,QQLMAT + LOGICAL QQLERR + CHARACTER*8 NAME + 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) +C + 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 +C + 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) +C + 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 +CDECK ID>, HWDEUR. +*CMZ :- -28/01/92 12.34.44 by Mike Seymour +*-- Author : Luca Stanco +C----------------------------------------------------------------------- + SUBROUTINE HWDEUR(IHEP) +C----------------------------------------------------------------------- +C INTERFACE TO EURODEC PACKAGE (LS 10/29/91) +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + INTEGER IHEP,IIHEP,NHEPHF,IEUPDG,IPDGEU + CHARACTER*8 NAME +C---EURODEC COMMON'S : INITIAL INPUT + INTEGER EULUN0,EULUN1,EULUN2,EURUN,EUEVNT + CHARACTER*4 EUDATD,EUTIT + REAL AMINIE(12),EUWEI + COMMON/INPOUT/EULUN0,EULUN1,EULUN2 + COMMON/FILNAM/EUDATD,EUTIT + COMMON/HVYINI/AMINIE + COMMON/RUNINF/EURUN,EUEVNT,EUWEI +C---EURODEC WORKING COMMON'S + INTEGER NPMAX,NTMAX + PARAMETER (NPMAX=18,NTMAX=2000) + INTEGER EUNP,EUIP(NPMAX),EUPHEL(NPMAX),EUTEIL,EUINDX(NTMAX), + & EUORIG(NTMAX),EUDCAY(NTMAX),EUTHEL(NTMAX) + REAL EUAPM(NPMAX),EUPCM(5,NPMAX),EUPVTX(3,NPMAX),EUPTEI(5,NTMAX), + & EUSECV(3,NTMAX) + COMMON/MOMGEN/EUNP,EUIP,EUAPM,EUPCM,EUPHEL,EUPVTX + COMMON/RESULT/EUTEIL,EUPTEI,EUINDX,EUORIG,EUDCAY,EUTHEL,EUSECV +C---EURODEC COMMON'S FOR DECAY PROPERTIES + INTEGER NGMAX,NCMAX + PARAMETER (NGMAX=400,NCMAX=9000) + INTEGER EUNPA,EUIPC(NGMAX),EUIPDG(NGMAX),EUIDP(NGMAX), + & EUCONV(NCMAX) + REAL EUPM(NGMAX),EUPLT(NGMAX) + COMMON/PCTABL/EUNPA,EUIPC,EUIPDG,EUPM,EUPLT,EUIDP + COMMON/CONVRT/EUCONV +C--- + IF(FSTEVT) THEN +C---CHANGE HERE THE DEFAULT VALUES OF EURODEC COMMON'S +C +C---INITIALIZE EURODEC COMMON'S +CC CALL EUDCIN +C---INITIALIZE EURODEC + CALL EUDINI + ENDIF +C---CONSTRUCT THE HADRON FOR EURODEC FROM ID1,ID2 + EUNP=1 + IDHEP(IHEP)=IDPDG(IDHW(IHEP)) + EUIP(1)=IPDGEU(IDHEP(IHEP)) + EUAPM(1)=EUPM(EUCONV(IABS(EUIP(1)))) + EUPCM(1,1)=PHEP(1,IHEP) + EUPCM(2,1)=PHEP(2,IHEP) + EUPCM(3,1)=PHEP(3,IHEP) + EUPCM(5,1)=SQRT(PHEP(1,IHEP)**2+PHEP(2,IHEP)**2+PHEP(3,IHEP)**2) + EUPCM(4,1)=SQRT(EUPCM(5,1)**2+EUAPM(1)**2) +C NOT POLARIZED HADRONS + EUPHEL(1)=0 +C HADRONS START FROM PRIMARY VERTEX + EUPVTX(1,1)=0. + EUPVTX(2,1)=0. + EUPVTX(3,1)=0. +C---LET EURODEC DO THE JOB + EUTEIL=0 + CALL FRAGMT(1,1,0) +C---UPDATE THE HERWIG TABLE : LOOP OVER N-EURODEC FINAL PARTICLES + DO 40 IIHEP=1,EUTEIL + NHEP=NHEP+1 + ISTHEP(NHEP)=198 + IF(EUDCAY(IIHEP).EQ.0) ISTHEP(NHEP)=1 + IDHEP(NHEP)=IEUPDG(EUINDX(IIHEP)) + 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 + JDAHEP(1,NHEP)=EUDCAY(IIHEP)/10000+NHEPHF-1 + JDAHEP(2,NHEP)=MOD(EUDCAY(IIHEP),10000)+NHEPHF-1 + ELSE + JMOHEP(1,NHEP)=MOD(EUORIG(IIHEP),10000)+NHEPHF-1 + JMOHEP(2,NHEP)=NHEPHF + JDAHEP(1,NHEP)=EUDCAY(IIHEP)/10000+NHEPHF-1 + JDAHEP(2,NHEP)=MOD(EUDCAY(IIHEP),10000)+NHEPHF-1 + ENDIF + PHEP(1,NHEP)=EUPTEI(1,IIHEP) + PHEP(2,NHEP)=EUPTEI(2,IIHEP) + PHEP(3,NHEP)=EUPTEI(3,IIHEP) + PHEP(4,NHEP)=EUPTEI(4,IIHEP) + PHEP(5,NHEP)=EUPTEI(5,IIHEP) + VHEP(1,NHEP)=EUSECV(1,IIHEP) + VHEP(2,NHEP)=EUSECV(2,IIHEP) + VHEP(3,NHEP)=EUSECV(3,IIHEP) + VHEP(4,NHEP)=0. + IF (IIHEP.GT.NTMAX) CALL HWWARN('HWDEUR',99,*999) + 40 CONTINUE + 999 END +CDECK ID>, HWDFOR. +*CMZ :- -01/04/99 19.52.44 by Mike Seymour +*-- Author : Ian Knowles +C----------------------------------------------------------------------- + SUBROUTINE HWDFOR(P0,P1,P2,P3,P4) +C----------------------------------------------------------------------- +C Generates 4-body decay 0->1+2+3+4 using pure phase space +C----------------------------------------------------------------------- + IMPLICIT NONE + DOUBLE PRECISION HWR,P0(5),P1(5),P2(5),P3(5),P4(5),B,C,AA,BB, + & CC,DD,EE,TT,S1,RS1,FF,S2,PP,QQ,RR,P1CM,P234(5),P2CM,P34(5),P3CM + DOUBLE PRECISION TWO + PARAMETER (TWO=2.D0) + EXTERNAL HWR + B=P0(5)-P1(5) + C=P2(5)+P3(5)+P4(5) + IF (B.LT.C) CALL HWWARN('HWDFOR',100,*999) + AA=(P0(5)+P1(5))**2 + BB=B**2 + CC=C**2 + DD=(P3(5)+P4(5))**2 + EE=(P3(5)-P4(5))**2 + TT=(B-C)*P0(5)**7/16 +C Select squared masses S1 and S2 of 234 and 34 subsystems + 10 S1=BB+HWR()*(CC-BB) + RS1=SQRT(S1) + FF=(RS1-P2(5))**2 + S2=DD+HWR()*(FF-DD) + PP=(AA-S1)*(BB-S1) + QQ=((RS1+P2(5))**2-S2)*(FF-S2)/S1 + RR=(S2-DD)*(S2-EE)/S2 + IF (PP*QQ*RR*(FF-DD)**2.LT.TT*S1*S2*HWR()**2) GOTO 10 +C Do two body decays: 0-->1+234, 234-->2+34 and 34-->3+4 + P1CM=SQRT(PP/4)/P0(5) + P234(5)=RS1 + P2CM=SQRT(QQ/4) + P34(5)=SQRT(S2) + P3CM=SQRT(RR/4) + CALL HWDTWO(P0 ,P1,P234,P1CM,TWO,.TRUE.) + CALL HWDTWO(P234,P2,P34 ,P2CM,TWO,.TRUE.) + CALL HWDTWO(P34 ,P3,P4 ,P3CM,TWO,.TRUE.) + 999 END +CDECK ID>, HWDFIV. +*CMZ :- -01/04/99 19.52.44 by Mike Seymour +*-- Author : Ian Knowles +C----------------------------------------------------------------------- + SUBROUTINE HWDFIV(P0,P1,P2,P3,P4,P5) +C----------------------------------------------------------------------- +C Generates 5-body decay 0->1+2+3+4+5 using pure phase space +C----------------------------------------------------------------------- + IMPLICIT NONE + DOUBLE PRECISION HWR,P0(5),P1(5),P2(5),P3(5),P4(5),P5(5),B,C, + & AA,BB,CC,DD,EE,FF,TT,S1,RS1,GG,S2,RS2,HH,S3,PP,QQ,RR,SS,P1CM, + & P2345(5),P2CM,P345(5),P3CM,P45(5),P4CM + DOUBLE PRECISION TWO + PARAMETER (TWO=2.D0) + EXTERNAL HWR + B=P0(5)-P1(5) + C=P2(5)+P3(5)+P4(5)+P5(5) + IF (B.LT.C) CALL HWWARN('HWDFIV',100,*999) + AA=(P0(5)+P1(5))**2 + BB=B**2 + CC=C**2 + DD=(P3(5)+P4(5)+P5(5))**2 + EE=(P4(5)+P5(5))**2 + FF=(P4(5)-P5(5))**2 + TT=(B-C)*P0(5)**11/729 +C Select squared masses S1, S2 and S3 of 2345, 345 and 45 subsystems + 10 S1=BB+HWR()*(CC-BB) + RS1=SQRT(S1) + GG=(RS1-P2(5))**2 + S2=DD+HWR()*(GG-DD) + RS2=SQRT(S2) + HH=(RS2-P3(5))**2 + S3=EE+HWR()*(HH-EE) + PP=(AA-S1)*(BB-S1) + QQ=((RS1+P2(5))**2-S2)*(GG-S2)/S1 + RR=((RS2+P3(5))**2-S3)*(HH-S3)/S2 + SS=(S3-EE)*(S3-FF)/S3 + IF (PP*QQ*RR*SS*((GG-DD)*(HH-EE))**2.LT.TT*S1*S2*S3*HWR()**2) + & GOTO 10 +C Do two body decays: 0-->1+2345, 2345-->2+345, 345-->3+45 and 45-->4+5 + P1CM=SQRT(PP/4)/P0(5) + P2345(5)=RS1 + P2CM=SQRT(QQ/4) + P345(5)=RS2 + P3CM=SQRT(RR/4) + P45(5)=SQRT(S3) + P4CM=SQRT(SS/4) + CALL HWDTWO(P0 ,P1,P2345,P1CM,TWO,.TRUE.) + CALL HWDTWO(P2345,P2,P345 ,P2CM,TWO,.TRUE.) + CALL HWDTWO(P345 ,P3,P45 ,P3CM,TWO,.TRUE.) + CALL HWDTWO(P45 ,P4,P5 ,P4CM,TWO,.TRUE.) + 999 END +CDECK ID>, HWDHAD. +*CMZ :- -26/04/91 14.01.26 by Federico Carminati +*-- Author : Ian Knowles, Bryan Webber & Mike Seymour +C----------------------------------------------------------------------- + SUBROUTINE HWDHAD +C----------------------------------------------------------------------- +C GENERATES DECAYS OF UNSTABLE HADRONS AND LEPTONS +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + DOUBLE PRECISION HWR,HWULDO,RN,BF,COSANG,RSUM,DIST(4),VERTX(4), + & PMIX,WTMX,WTMX2,XS,DOT1,DOT2,HWDPWT,HWDWWT,XXX,YYY + INTEGER IHEP,ID,MHEP,IDM,I,IDS,IM,MO,IPDG + LOGICAL STABLE + EXTERNAL HWR,HWDPWT,HWDWWT,HWULDO + IF (IERROR.NE.0) RETURN + DO 100 IHEP=1,NMXHEP + IF (IHEP.GT.NHEP) THEN + ISTAT=90 + RETURN + ELSEIF (ISTHEP(IHEP).EQ.120 .AND. + & JDAHEP(1,IHEP).EQ.IHEP.AND.JDAHEP(2,IHEP).EQ.IHEP) THEN +C---COPY COLOUR SINGLET CMF + NHEP=NHEP+1 + IF (NHEP.GT.NMXHEP) CALL HWWARN('HWDHAD',100,*999) + CALL HWVEQU(5,PHEP(1,IHEP),PHEP(1,NHEP)) + CALL HWVEQU(4,VHEP(1,IHEP),VHEP(1,NHEP)) + IDHW(NHEP)=IDHW(IHEP) + IDHEP(NHEP)=IDHEP(IHEP) + ISTHEP(NHEP)=190 + JMOHEP(1,NHEP)=IHEP + JMOHEP(2,NHEP)=NHEP + JDAHEP(2,NHEP)=NHEP + JDAHEP(1,IHEP)=NHEP + JDAHEP(2,IHEP)=NHEP + ELSEIF (ISTHEP(IHEP).GE.190.AND.ISTHEP(IHEP).LE.193) THEN +C---FIRST CHECK FOR STABILITY + ID=IDHW(IHEP) + IF (RSTAB(ID)) THEN + ISTHEP(IHEP)=1 + JDAHEP(1,IHEP)=0 + JDAHEP(2,IHEP)=0 +C---SPECIAL FOR GAUGE BOSON DECAY + IF (ID.GE.198.AND.ID.LE.200) CALL HWDBOS(IHEP) +C---SPECIAL FOR HIGGS BOSON DECAY + IF (ID.EQ.201) CALL HWDHIG(ZERO) + ELSE +C---UNSTABLE. +C Calculate position of decay vertex + IF (DKLTM(ID).EQ.ZERO) THEN + CALL HWVEQU(4,VHEP(1,IHEP),VERTX) + MHEP=IHEP + IDM=ID + ELSE + CALL HWUDKL(ID,PHEP(1,IHEP),DIST) + CALL HWVSUM(4,VHEP(1,IHEP),DIST,VERTX) + IF (MAXDKL) THEN + CALL HWDXLM(VERTX,STABLE) + IF (STABLE) THEN + ISTHEP(IHEP)=1 + JDAHEP(1,IHEP)=0 + JDAHEP(2,IHEP)=0 + GOTO 100 + ENDIF + ENDIF + IF (MIXING.AND.(ID.EQ.221.OR.ID.EQ.223.OR. + & ID.EQ.245.OR.ID.EQ.247)) THEN +C Select flavour of decaying b-meson allowing for flavour oscillation + IDS=MOD(ID,3) + XXX=XMRCT(IDS)*DIST(4)/PHEP(4,IHEP) + YYY=YMRCT(IDS)*DIST(4)/PHEP(4,IHEP) + IF (ABS(YYY).LT.10) THEN + PMIX=HALF*(ONE-COS(XXX)/COSH(YYY)) + ELSE + PMIX=HALF + ENDIF + IF (HWR().LE.PMIX) THEN + IF (ID.LE.223) THEN + IDM=ID+24 + ELSE + IDM=ID-24 + ENDIF + ELSE + IDM=ID + ENDIF +C Introduce a decaying neutral b-meson + IF (NHEP+1.GT.NMXHEP) CALL HWWARN('HWDHAD',101,*999) + MHEP=NHEP+1 + ISTHEP(MHEP)=ISTHEP(IHEP) + ISTHEP(IHEP)=200 + JDAHEP(1,IHEP)=MHEP + JDAHEP(2,IHEP)=MHEP + IDHW(MHEP)=IDM + IDHEP(MHEP)=IDPDG(IDM) + JMOHEP(1,MHEP)=IHEP + JMOHEP(2,MHEP)=JMOHEP(2,IHEP) + CALL HWVEQU(5,PHEP(1,IHEP),PHEP(1,MHEP)) + CALL HWVEQU(4,VERTX,VHEP(1,MHEP)) + NHEP=NHEP+1 + ELSE + MHEP=IHEP + IDM=ID + ENDIF + ENDIF +C Use CLEO/EURODEC packages for b-hadrons if requested + IF ((IDM.GE.221.AND.IDM.LE.231).OR. + & (IDM.GE.245.AND.IDM.LE.254)) THEN + IF (BDECAY.EQ.'CLEO') THEN + CALL HWDCLE(MHEP) + GOTO 100 + ELSEIF (BDECAY.EQ.'EURO') THEN + CALL HWDEUR(MHEP) + GOTO 100 + ENDIF + ENDIF +C Choose decay mode + ISTHEP(MHEP)=ISTHEP(MHEP)+5 + RN=HWR() + BF=0. + IM=LSTRT(IDM) + DO 10 I=1,NMODES(IDM) + BF=BF+BRFRAC(IM) + IF (BF.GE.RN) GOTO 20 + 10 IM=LNEXT(IM) + CALL HWWARN('HWDHAD',50,*20) + 20 IF ((IDKPRD(1,IM).GE.1.AND.IDKPRD(1,IM).LE.13).OR. + & (IDKPRD(3,IM).GE.1.AND.IDKPRD(3,IM).LE.13)) THEN +C Partonic decay of a heavy-(b,c)-hadron, store details + NQDK=NQDK+1 + IF (NQDK.GT.NMXQDK) CALL HWWARN('HWDHAD',102,*999) + LOCQ(NQDK)=MHEP + IMQDK(NQDK)=IM + CALL HWVEQU(4,VERTX,VTXQDK(1,NQDK)) + GOTO 100 + ELSE +C Exclusive decay, add decay products to event record + IF (NHEP+NPRODS(IM).GT.NMXHEP) + & CALL HWWARN('HWDHAD',103,*999) + JDAHEP(1,MHEP)=NHEP+1 + DO 30 I=1,NPRODS(IM) + NHEP=NHEP+1 + IDHW(NHEP)=IDKPRD(I,IM) + IDHEP(NHEP)=IDPDG(IDKPRD(I,IM)) + ISTHEP(NHEP)=193 + JMOHEP(1,NHEP)=MHEP + JMOHEP(2,NHEP)=JMOHEP(2,MHEP) + PHEP(5,NHEP)=RMASS(IDKPRD(I,IM)) + 30 CALL HWVEQU(4,VERTX,VHEP(1,NHEP)) + JDAHEP(2,MHEP)=NHEP + ENDIF +C Next choose momenta: + IF (NPRODS(IM).EQ.1) THEN +C 1-body decay: K0(BR) --> K0S,K0L + CALL HWVEQU(4,PHEP(1,MHEP),PHEP(1,NHEP)) + ELSEIF (NPRODS(IM).EQ.2) THEN +C 2-body decay +C---SPECIAL TREATMENT OF POLARIZED MESONS + COSANG=TWO + IF (ID.EQ.IDHW(JMOHEP(1,MHEP))) THEN + MO=JMOHEP(1,MHEP) + RSUM=0 + DO 40 I=1,3 + 40 RSUM=RSUM+RHOHEP(I,MO) + IF (RSUM.GT.ZERO) THEN + RSUM=RSUM*HWR() + IF (RSUM.LT.RHOHEP(1,MO)) THEN +C---(1+COSANG)**2 + COSANG=MAX(HWR(),HWR(),HWR())*TWO-ONE + ELSEIF (RSUM.LT.RHOHEP(1,MO)+RHOHEP(2,MO)) THEN +C---1-COSANG**2 + COSANG=2*COS((ACOS(HWR()*TWO-ONE)+PIFAC)/THREE) + ELSE +C---(1-COSANG)**2 + COSANG=MIN(HWR(),HWR(),HWR())*TWO-ONE + ENDIF + ENDIF + ENDIF + CALL HWDTWO(PHEP(1,MHEP),PHEP(1,NHEP-1), + & PHEP(1,NHEP),CMMOM(IM),COSANG,.FALSE.) + ELSEIF (NPRODS(IM).EQ.3) THEN +C 3-body decay + IF (NME(IM).EQ.100) THEN +C Use free massless (V-A)*(V-A) Matrix Element + CALL HWDTHR(PHEP(1,MHEP),PHEP(1,NHEP-1),PHEP(1,NHEP-2), + & PHEP(1,NHEP),HWDWWT) + ELSEIF (NME(IM).EQ.101) THEN +C Use bound massless (V-A)*(V-A) Matrix Element + WTMX=((PHEP(5,MHEP)-PHEP(5,NHEP)) + & *(PHEP(5,MHEP)+PHEP(5,NHEP)) + & +(PHEP(5,NHEP-1)-PHEP(5,NHEP-2)) + & *(PHEP(5,NHEP-1)+PHEP(5,NHEP-2)))/TWO + WTMX2=WTMX**2 + IPDG=ABS(IDHEP(MHEP)) + XS=ONE-MAX(RMASS(MOD(IPDG/1000,10)), + & RMASS(MOD(IPDG/100,10)),RMASS(MOD(IPDG/10,10))) + & /(RMASS(MOD(IPDG/1000,10))+RMASS(MOD(IPDG/100,10)) + & +RMASS(MOD(IPDG/10,10))) + 50 CALL HWDTHR(PHEP(1,MHEP),PHEP(1,NHEP-1),PHEP(1,NHEP-2), + & PHEP(1,NHEP),HWDWWT) + DOT1=HWULDO(PHEP(1,MHEP),PHEP(1,NHEP-1)) + DOT2=HWULDO(PHEP(1,MHEP),PHEP(1,NHEP-2)) + IF (DOT1*(WTMX-DOT1-XS*DOT2).LT.HWR()*WTMX2) GOTO 50 + ELSE + CALL HWDTHR(PHEP(1,MHEP),PHEP(1,NHEP-2),PHEP(1,NHEP-1), + & PHEP(1,NHEP),HWDPWT) + ENDIF + ELSEIF (NPRODS(IM).EQ.4) THEN +C 4-body decay + CALL HWDFOR(PHEP(1,MHEP ),PHEP(1,NHEP-3),PHEP(1,NHEP-2), + & PHEP(1,NHEP-1),PHEP(1,NHEP)) + ELSEIF (NPRODS(IM).EQ.5) THEN +C 5-body decay + CALL HWDFIV(PHEP(1,MHEP ),PHEP(1,NHEP-4),PHEP(1,NHEP-3), + & PHEP(1,NHEP-2),PHEP(1,NHEP-1),PHEP(1,NHEP)) + ELSE + CALL HWWARN('HWDHAD',104,*999) + ENDIF + ENDIF + ENDIF + 100 CONTINUE +C---MAY HAVE OVERFLOWED /HEPEVT/ + CALL HWWARN('HWDHAD',105,*999) + 999 END +CDECK ID>, HWDHGC. +*CMZ :- -26/04/91 11.11.55 by Bryan Webber +*-- Author : Mike Seymour +C----------------------------------------------------------------------- + SUBROUTINE HWDHGC(TAU,FNREAL,FNIMAG) +C----------------------------------------------------------------------- +C CALCULATE THE COMPLEX FUNCTION F OF HHG eq 2.18 +C FOR USE IN H-->GAMMGAMM DECAYS +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + DOUBLE PRECISION TAU,FNREAL,FNIMAG,FNLOG,FNSQR + IF (TAU.GT.ONE) THEN + FNREAL=(ASIN(1/SQRT(TAU)))**2 + FNIMAG=0 + ELSEIF (TAU.LT.ONE) THEN + FNSQR=SQRT(1-TAU) + FNLOG=LOG((1+FNSQR)/(1-FNSQR)) + FNREAL=-0.25 * (FNLOG**2 - PIFAC**2) + FNIMAG= 0.5 * PIFAC*FNLOG + ELSE + FNREAL=0.25*PIFAC**2 + FNIMAG=0 + ENDIF + END +CDECK ID>, HWDHGF. +*CMZ :- -02/05/91 11.11.45 by Federico Carminati +*-- Author : Mike Seymour +C----------------------------------------------------------------------- + FUNCTION HWDHGF(X,Y) +C----------------------------------------------------------------------- +C CALCULATE THE DOUBLE BREIT-WIGNER INTEGRAL +C X=(EMV/EMH)**2 , Y=EMV*GAMV/EMH**2 +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + DOUBLE PRECISION HWDHGF,X,Y,CHANGE,X1,X2,FAC1,FAC2,TH1,TH2,TH1HI, + & TH1LO,TH2HI,TH2LO,X2MAX,SQFAC + INTEGER NBIN,IBIN1,IBIN2 +C CHANGE IS THE POINT WHERE DIRECT INTEGRATION BEGINS TO CONVERGE +C FASTER THAN STANDARD BREIT-WIGNER SUBSTITUTION + DATA CHANGE,NBIN/0.425,25/ + HWDHGF=0 + IF (Y.LT.ZERO) RETURN + IF (X.GT.CHANGE) THEN +C---DIRECT INTEGRATION + FAC1=0.25 / NBIN + DO 200 IBIN1=1,NBIN + X1=(IBIN1-0.5) * FAC1 + FAC2=( (1-SQRT(X1))**2-X1 ) / NBIN + DO 100 IBIN2=1,NBIN + X2=(IBIN2-0.5) * FAC2 + X1 + SQFAC=1+X1**2+X2**2-2*(X1+X2+X1*X2) + IF (SQFAC.LT.ZERO) GOTO 100 + HWDHGF=HWDHGF + 2. + & * ((1-X1-X2)**2+8*X1*X2) + & * SQRT(SQFAC) + & / ((X1-X)**2+Y**2) *Y + & / ((X2-X)**2+Y**2) *Y + & * FAC1*FAC2 + 100 CONTINUE + 200 CONTINUE + ELSE +C---INTEGRATION USING TAN THETA SUBSTITUTIONS + TH1LO=ATAN((0-X)/Y) + TH1HI=ATAN((1-X)/Y) + FAC1=(TH1HI-TH1LO) / NBIN + DO 400 IBIN1=1,NBIN + TH1=(IBIN1-0.5) * FAC1 + TH1LO + X1=Y*TAN(TH1) + X + X2MAX=MIN(X1,(1-SQRT(X1))**2) + TH2LO=ATAN((0-X)/Y) + TH2HI=ATAN((X2MAX-X)/Y) + FAC2=(TH2HI-TH2LO) / NBIN + DO 300 IBIN2=1,NBIN + TH2=(IBIN2-0.5) * FAC2 + TH2LO + X2=Y*TAN(TH2) + X + SQFAC=1+X1**2+X2**2-2*(X1+X2+X1*X2) + IF (SQFAC.LT.ZERO) GOTO 300 + HWDHGF=HWDHGF + 2. + & * ((1-X1-X2)**2+8*X1*X2) + & * SQRT(SQFAC) + & * FAC1 * FAC2 + 300 CONTINUE + 400 CONTINUE + ENDIF + HWDHGF=HWDHGF/(PIFAC*PIFAC) + END +CDECK ID>, HWDHIG. +*CMZ :- -24/04/92 14.23.44 by Mike Seymour +*-- Author : Mike Seymour +C----------------------------------------------------------------------- + SUBROUTINE HWDHIG(GAMINP) +C----------------------------------------------------------------------- +C HIGGS DECAY ROUTINE +C A) FOR GAMinp=0 FIND AND DECAY HIGGS +C B) FOR GAMinp>0 CALCULATE TOTAL HIGGS WIDTH +C FOR EMH=GAMINP. STORE RESULT IN GAMINP. +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + DOUBLE PRECISION HWDHGF,HWR,HWRUNI,HWUSQR,HWUPCM,GAMINP,EMH, + & EMF,COLFAC,ENF,K1,K0,BET0,BET1,GAM0,GAM1,SCLOG,CFAC,XF,EM,GAMLIM, + & GAM,XW,EMW,XZ,EMZ,YW,YZ,EMI,TAUT,TAUW,WIDHIG,VECDEC,EMB,GAMB, + & TMIN,TMAX1,EM1,TMAX2,EM2,X1,X2,PROB,PCM,SUMR,SUMI,TAUTR,TAUTI, + & TAUWR,TAUWI,GFACTR + INTEGER HWRINT,IHIG,I,IFERM,NLOOK,I1,I2,IPART,IMODE,IDEC,MMAX + LOGICAL HWRLOG + EXTERNAL HWDHGF,HWR,HWRUNI,HWUSQR,HWUPCM,HWRINT,HWRLOG + SAVE GAM,EM,VECDEC + PARAMETER (NLOOK=100) + DIMENSION VECDEC(2,0:NLOOK) + EQUIVALENCE (EMW,RMASS(198)),(EMZ,RMASS(200)) + DATA GAMLIM,GAM,EM/10D0,2*0D0/ +C---IF DECAY, FIND HIGGS (HWDHAD WILL HAVE GIVEN IT STATUS=1) + IF (GAMINP.EQ.ZERO) THEN + IHIG=0 + DO 10 I=1,NHEP + 10 IF (IHIG.EQ.0.AND.IDHW(I).EQ.201.AND.ISTHEP(I).EQ.1) IHIG=I + IF (IHIG.EQ.0) CALL HWWARN('HWDHIG',101,*999) + EMH=PHEP(5,IHIG) + IF (EMH.LE.ZERO) CALL HWWARN('HWDHIG',102,*999) + EMSCA=EMH + ELSE + EMH=GAMINP + IF (EMH.LE.ZERO) THEN + GAMINP=0 + RETURN + ENDIF + ENDIF +C---CALCULATE BRANCHING FRACTIONS +C---FERMIONS +C---NLL CORRECTION TO QUARK DECAY RATE (HHG eq 2.6-9) + ENF=0 + DO 1 I=1,6 + 1 IF (2*RMASS(I).LT.EMH) ENF=ENF+1 + K1=5/PIFAC**2 + K0=3/(4*PIFAC**2) + BET0=(11*CAFAC-2*ENF)/3 + BET1=(34*CAFAC**2-(10*CAFAC+6*CFFAC)*ENF)/3 + GAM0=-8 + GAM1=-404./3+40*ENF/9 + SCLOG=LOG(EMH**2/QCDLAM**2) + CFAC=1 + ( K1/K0 - 2*GAM0 + GAM0*BET1/BET0**2*LOG(SCLOG) + & + (GAM0*BET1-GAM1*BET0)/BET0**2) / (BET0*SCLOG) + DO 100 IFERM=1,9 + IF (IFERM.LE.6) THEN + EMF=RMASS(IFERM) + XF=(EMF/EMH)**2 + COLFAC=FLOAT(NCOLO) + IF (EMF.GT.QCDLAM) + & EMF=EMF*(LOG(EMH/QCDLAM)/LOG(EMF/QCDLAM))**(GAM0/(2*BET0)) + ELSE + EMF=RMASS(107+IFERM*2) + XF=(EMF/EMH)**2 + COLFAC=1 + CFAC=1 + ENDIF + IF (FOUR*XF.LT.ONE) THEN + GFACTR=ALPHEM/(8.*SWEIN*EMW**2) + BRHIG(IFERM)=COLFAC*GFACTR*EMH*EMF**2 * (1-4*XF)**1.5 * CFAC + ELSE + BRHIG(IFERM)=0 + ENDIF + 100 CONTINUE +C---W*W*/Z*Z* + IF (ABS(EM-EMH).GE.GAMLIM*GAM) THEN +C---OFF EDGE OF LOOK-UP TABLE + XW=(EMW/EMH)**2 + XZ=(EMZ/EMH)**2 + YW=EMW*GAMW/EMH**2 + YZ=EMZ*GAMZ/EMH**2 + BRHIG(10)=.50*GFACTR * EMH**3 * HWDHGF(XW,YW) + BRHIG(11)=.25*GFACTR * EMH**3 * HWDHGF(XZ,YZ) + ELSE +C---LOOK IT UP + EMI=((EMH-EM)/(GAM*GAMLIM)+1)*NLOOK/2.0 + I1=INT(EMI) + I2=INT(EMI+1) + BRHIG(10)=.50*GFACTR * EMH**3 * ( VECDEC(1,I1)*(I2-EMI) + + & VECDEC(1,I2)*(EMI-I1) ) + BRHIG(11)=.25*GFACTR * EMH**3 * ( VECDEC(2,I1)*(I2-EMI) + + & VECDEC(2,I2)*(EMI-I1) ) + ENDIF +C---GAMMAGAMMA + TAUT=(2*RMASS(6)/EMH)**2 + TAUW=(2*EMW/EMH)**2 + CALL HWDHGC(TAUT,TAUTR,TAUTI) + CALL HWDHGC(TAUW,TAUWR,TAUWI) + SUMR=4./3*( - 2*TAUT*( 1 + (1-TAUT)*TAUTR ) ) * ENHANC(6) + & +(2 + 3*TAUW*( 1 + (2-TAUW)*TAUWR ) ) * ENHANC(10) + SUMI=4./3*( - 2*TAUT*( (1-TAUT)*TAUTI ) ) * ENHANC(6) + & +( 3*TAUW*( (2-TAUW)*TAUWI ) ) * ENHANC(10) + BRHIG(12)=GFACTR*.03125*(ALPHEM/PIFAC)**2 + & *EMH**3 * (SUMR**2 + SUMI**2) + WIDHIG=0 + DO 200 IPART=1, 12 + IF (IPART.LT.12) BRHIG(IPART)=BRHIG(IPART)*ENHANC(IPART)**2 + 200 WIDHIG=WIDHIG+BRHIG(IPART) + IF (WIDHIG.EQ.ZERO) CALL HWWARN('HWDHIG',103,*999) + DO 300 IPART=1, 12 + 300 BRHIG(IPART)=BRHIG(IPART)/WIDHIG + IF (EM.NE.RMASS(201)) THEN +C---SET UP W*W*/Z*Z* LOOKUP TABLES + EM=EMH + GAM=WIDHIG + GAMLIM=MAX(GAMLIM,GAMMAX) + DO 400 I=0,NLOOK + EMH=(I*2.0/NLOOK-1)*GAM*GAMLIM+EM + XW=(EMW/EMH)**2 + XZ=(EMZ/EMH)**2 + YW=EMW*GAMW/EMH**2 + YZ=EMZ*GAMZ/EMH**2 + VECDEC(1,I)=HWDHGF(XW,YW) + VECDEC(2,I)=HWDHGF(XZ,YZ) + 400 CONTINUE + EMH=EM + ENDIF + IF (GAMINP.GT.ZERO) THEN + GAMINP=WIDHIG + RETURN + ENDIF +C---SEE IF USER SPECIFIED A DECAY MODE + IMODE=MOD(IPROC,100) +C---IF NOT, CHOOSE ONE + IF (IMODE.LT.1.OR.IMODE.GT.12) THEN + MMAX=12 + IF (IMODE.LT.1) MMAX=6 + 500 IMODE=HWRINT(1,MMAX) + IF (BRHIG(IMODE).LT.HWR()) GOTO 500 + ENDIF +C---SEE IF SPECIFIED DECAY IS POSSIBLE + IF (BRHIG(IMODE).EQ.ZERO) CALL HWWARN('HWDHIG',104,*999) + IF (IMODE.LE.6) THEN + IDEC=IMODE + ELSEIF (IMODE.LE.9) THEN + IDEC=107+IMODE*2 + ELSEIF (IMODE.EQ.10) THEN + IDEC=198 + ELSEIF (IMODE.EQ.11) THEN + IDEC=200 + ELSEIF (IMODE.EQ.12) THEN + IDEC=59 + ENDIF +C---STATUS, IDs AND POINTERS + ISTHEP(IHIG)=195 + DO 600 I=1,2 + ISTHEP(NHEP+I)=193 + IDHW(NHEP+I)=IDEC + IDHEP(NHEP+I)=IDPDG(IDEC) + JDAHEP(I,IHIG)=NHEP+I + JMOHEP(1,NHEP+I)=IHIG + JMOHEP(2,NHEP+I)=NHEP+(3-I) + JDAHEP(2,NHEP+I)=NHEP+(3-I) + PHEP(5,NHEP+I)=RMASS(IDEC) + IDEC=IDEC+6 + IF (IDEC.EQ.204) IDEC=199 + IF (IDEC.EQ.206) IDEC=200 + IF (IDEC.EQ. 65) IDEC= 59 + 600 CONTINUE +C---ALLOW W/Z TO BE OFF-SHELL + IF (IMODE.EQ.10.OR.IMODE.EQ.11) THEN + IF (IMODE.EQ.10) THEN + EMB=EMW + GAMB=GAMW + ELSE + EMB=EMZ + GAMB=GAMZ + ENDIF +C---STANDARD MASS DISTRIBUTION + 700 TMIN=ATAN(-EMB/GAMB) + TMAX1=ATAN((EMH**2/EMB-EMB)/GAMB) + EM1=HWUSQR(EMB*(GAMB*TAN(HWRUNI(0,TMIN,TMAX1))+EMB)) + TMAX2=ATAN(((EMH-EM1)**2/EMB-EMB)/GAMB) + EM2=HWUSQR(EMB*(GAMB*TAN(HWRUNI(0,TMIN,TMAX2))+EMB)) + X1=(EM1/EMH)**2 + X2=(EM2/EMH)**2 +C---CORRECT MASS DISTRIBUTION + PROB=HWUSQR(1+X1**2+X2**2-2*X1-2*X2-2*X1*X2) + & * ((X1+X2-1)**2 + 8*X1*X2) + IF (.NOT.HWRLOG(PROB)) GOTO 700 +C---CALCULATE SPIN DENSITY MATRIX + RHOHEP(1,NHEP+1)=4*X1*X2 / (8*X1*X2 + (X1+X2-1)**2) + RHOHEP(2,NHEP+1)=(X1+X2-1)**2 / (8*X1*X2 + (X1+X2-1)**2) + RHOHEP(3,NHEP+1)=RHOHEP(1,NHEP+1) +C---SYMMETRIZE DISTRIBUTIONS IN PARTICLES 1,2 + IF (HWRLOG(HALF)) THEN + PHEP(5,NHEP+1)=EM1 + PHEP(5,NHEP+2)=EM2 + ELSE + PHEP(5,NHEP+1)=EM2 + PHEP(5,NHEP+2)=EM1 + ENDIF + ENDIF +C---DO DECAY + PCM=HWUPCM(EMH,PHEP(5,NHEP+1),PHEP(5,NHEP+2)) + IF (PCM.LT.ZERO) CALL HWWARN('HWDHIG',105,*999) + CALL HWDTWO(PHEP(1,IHIG),PHEP(1,NHEP+1),PHEP(1,NHEP+2), + & PCM,TWO,.TRUE.) + NHEP=NHEP+2 +C---IF QUARK DECAY, HADRONIZE + IF (IMODE.LE.6) THEN + ISTHEP(NHEP-1)=113 + ISTHEP(NHEP)=114 + CALL HWBGEN + CALL HWDHOB + CALL HWCFOR + CALL HWCDEC + ENDIF + 999 END +CDECK ID>, HWDHOB. +*CMZ :- -20/10/99 09:46:43 by Peter Richardson +*-- Author : Ian Knowles & Bryan Webber +C----------------------------------------------------------------------- + SUBROUTINE HWDHOB +C----------------------------------------------------------------------- +C Performs decays of heavy objects (heavy quarks & SUSY particles) +C MODIFIED TO INCLUDE R-PARITY VIOLATING SUSY PR 9/4/99 +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + DOUBLE PRECISION HWUMBW,HWUPCM,HWR,SDKM,RN,BF,PCM, + & EMMX,EMWSQ,GMWSQ,EMLIM,PW(5),EMTST,HWDPWT,HWDWWT,HWULDO,PDW(5,3) + INTEGER IST(3),IHEP,IS,ID,IM,I,JHEP,KHEP,LHEP,MHEP,NPR,ISM,JCM, + & MTRY,NTRY,IDM,IDM2,THEP,CLSAVE(2),WHEP,RHEP + LOGICAL FOUND + EXTERNAL HWR,HWDPWT,HWDWWT + DATA IST/113,114,114/ + IF (IERROR.NE.0) RETURN + 10 FOUND=.FALSE. + CLSAVE(1) = 0 + CLSAVE(2) = 0 + DO 60 IHEP=1,NMXHEP + IS=ISTHEP(IHEP) + ID=IDHW(IHEP) + IF (.NOT.RSTAB(ID).AND.(ID.EQ.6.OR.ID.EQ.12.OR. + & (ID.GE.203.AND.ID.LE.218).OR.ABS(IDPDG(ID)).GT.1000000).AND. + & (IS.EQ.190.OR.(IS.GE.147.AND.IS.LE.151))) THEN + FOUND=.TRUE. + IF(.NOT.RPARTY) THEN + NHEP = NHEP+1 + ISTHEP(NHEP) = 3 + IDHW(NHEP) = 20 + IDHEP(NHEP) = 0 + CALL HWVEQU(5,PHEP(1,IHEP),PHEP(1,NHEP)) + CALL HWVEQU(4,VHEP(1,IHEP),VHEP(1,NHEP)) + JMOHEP(1,NHEP)=JMOHEP(1,IHEP) + JMOHEP(2,NHEP)=JMOHEP(2,IHEP) + JDAHEP(1,NHEP)=JDAHEP(1,IHEP) + JDAHEP(2,NHEP)=JDAHEP(2,IHEP) + ENDIF +C Make a copy of decaying object + NHEP=NHEP+1 + ISTHEP(NHEP)=155 + IDHW(NHEP)=IDHW(IHEP) + IDHEP(NHEP)=IDHEP(IHEP) + CALL HWVEQU(5,PHEP(1,IHEP),PHEP(1,NHEP)) + CALL HWVEQU(4,VHEP(1,IHEP),VHEP(1,NHEP)) + JMOHEP(1,NHEP)=JMOHEP(1,IHEP) + JMOHEP(2,NHEP)=JMOHEP(2,IHEP) + MTRY=0 + 15 MTRY=MTRY+1 +C Select decay mode + RN=HWR() + BF=0. + IM=LSTRT(ID) + DO 20 I=1,NMODES(ID) + BF=BF+BRFRAC(IM) + IF (BF.GE.RN) GOTO 30 + 20 IM=LNEXT(IM) + CALL HWWARN('HWDHOB',50,*30) + 30 IF (NHEP+5.GT.NMXHEP) CALL HWWARN('HWDHOB',100,*999) + NPR=NPRODS(IM) + JDAHEP(1,NHEP)=NHEP+1 + JDAHEP(2,NHEP)=NHEP+NPR +C Reset colour pointers (if set) + JHEP=JMOHEP(2,IHEP) + IF (JHEP.GT.0) THEN + IF (JDAHEP(2,JHEP).EQ.IHEP) JDAHEP(2,JHEP)=NHEP + IF(.NOT.RPARTY.AND.ISTHEP(JHEP).EQ.155 + & .AND.ABS(IDHEP(JHEP)).GT.1000000 + & .AND.JDAHEP(2,JHEP-1).EQ.IHEP) JDAHEP(2,JHEP-1) = NHEP + ENDIF + JHEP=JDAHEP(2,IHEP) + IF (JHEP.GT.0) THEN + IF (JMOHEP(2,JHEP).EQ.IHEP) JMOHEP(2,JHEP)=NHEP + IF(.NOT.RPARTY.AND.ISTHEP(JHEP).EQ.155 + & .AND.ABS(IDHEP(JHEP)).GT.1000000 + & .AND.JMOHEP(2,JHEP-1).EQ.IHEP) JMOHEP(2,JHEP-1) = NHEP + ENDIF +C--Reset colour pointers if baryon number violated + IF(.NOT.RPARTY) THEN + DO JHEP=1,NHEP + IF(ISTHEP(JHEP).EQ.155 + & .AND.ABS(IDHEP(JHEP)).GT.1000000.AND. + & JDAHEP(2,JHEP-1).EQ.IHEP) JDAHEP(2,JHEP-1)= NHEP + IF(JDAHEP(2,JHEP).EQ.IHEP) JDAHEP(2,JHEP)=NHEP + IF(JMOHEP(2,JHEP).EQ.IHEP) JMOHEP(2,JHEP)=NHEP + ENDDO + IF(HRDCOL(1,1).EQ.IHEP) HRDCOL(1,1)=NHEP + ENDIF +C Relabel original track + ISTHEP(IHEP)=3 + JMOHEP(2,IHEP)=JMOHEP(1,IHEP) + JDAHEP(1,IHEP)=NHEP + JDAHEP(2,IHEP)=NHEP +C Label decay products and choose masses + LHEP=NHEP + MHEP=LHEP+1 + NTRY=0 + 35 NTRY=NTRY+1 + SDKM=PHEP(5,NHEP) + DO 40 I=1,NPR + NHEP=NHEP+1 + IDHW(NHEP)=IDKPRD(I,IM) + IDHEP(NHEP)=IDPDG(IDKPRD(I,IM)) + ISTHEP(NHEP)=IST(I) + JMOHEP(1,NHEP)=LHEP + JDAHEP(1,NHEP)=0 + PHEP(5,NHEP)=HWUMBW(IDKPRD(I,IM)) + 40 SDKM=SDKM-PHEP(5,NHEP) + IF (SDKM.LT.ZERO) THEN + NHEP=NHEP-NPR + IF (NTRY.LE.NETRY) GO TO 35 + CALL HWWARN('HWDHOB',1,*45) + 45 IF (MTRY.LE.NETRY) GO TO 15 + CALL HWWARN('HWDHOB',101,*999) + ENDIF +C Assign production vertices to decay products + CALL HWUDKL(ID,PHEP(1,IHEP),VHEP(1,MHEP)) + CALL HWVSUM(4,VHEP(1,IHEP),VHEP(1,MHEP),VHEP(1,MHEP)) + CALL HWVEQU(4,VHEP(1,MHEP),VHEP(1,NHEP)) + IF (NPR.EQ.2) THEN +C Two body decay: LHEP -> MHEP + NHEP + PCM=HWUPCM(PHEP(5,IHEP),PHEP(5,MHEP),PHEP(5,NHEP)) + CALL HWDTWO(PHEP(1,IHEP),PHEP(1,MHEP), + & PHEP(1,NHEP),PCM,TWO,.FALSE.) + ELSEIF (NPR.EQ.3) THEN +C Three body decay: LHEP -> KHEP + MHEP + NHEP + KHEP=MHEP + MHEP=MHEP+1 +C Provisional colour self-connection of KHEP + JMOHEP(2,KHEP)=KHEP + JDAHEP(2,KHEP)=KHEP + IF (NME(IM).EQ.100) THEN +C Generate decay momenta using full (V-A)*(V-A) matrix element + EMMX=PHEP(5,IHEP)-PHEP(5,NHEP) + EMWSQ=RMASS(198)**2 + GMWSQ=(RMASS(198)*GAMW)**2 + EMLIM=GMWSQ + IF (EMMX.LT.RMASS(198)) EMLIM=EMLIM+(EMWSQ-EMMX**2)**2 + 50 CALL HWDTHR(PHEP(1,IHEP),PHEP(1,MHEP), + & PHEP(1,KHEP),PHEP(1,NHEP),HWDWWT) + CALL HWVSUM(4,PHEP(1,KHEP),PHEP(1,MHEP),PW) + PW(5)=HWULDO(PW,PW) + EMTST=(EMWSQ-PW(5))**2 + IF ((EMTST+GMWSQ)*HWR().GT.EMLIM) GOTO 50 + PW(5)=SQRT(PW(5)) +C Assign production vertices to 1 and 2 + CALL HWUDKL(198,PW,VHEP(1,KHEP)) + CALL HWVSUM(4,VHEP(1,NHEP),VHEP(1,KHEP),VHEP(1,KHEP)) + ELSEIF(NME(IM).EQ.300) THEN +C Generate momenta using 3-body RPV matrix element + CALL HWDRME(LHEP,KHEP) + ELSE +C Three body phase space decay + CALL HWDTHR(PHEP(1,IHEP),PHEP(1,MHEP), + & PHEP(1,KHEP),PHEP(1,NHEP),HWDPWT) + ENDIF + CALL HWVEQU(4,VHEP(1,KHEP),VHEP(1,MHEP)) + ELSEIF(NPR.EQ.4) THEN +C Four body decay: LHEP -> KHEP + RHEP + MHEP + NHEP + KHEP = MHEP + RHEP = MHEP+1 + MHEP = MHEP+2 +C Provisional colour connections of KHEP and RHEP + JMOHEP(2,KHEP)=RHEP + JDAHEP(2,KHEP)=RHEP + JMOHEP(2,RHEP)=KHEP + JDAHEP(2,RHEP)=KHEP +C Four body phase space decay + CALL HWDFOR(PHEP(1,IHEP),PHEP(1,KHEP),PHEP(1,RHEP), + & PHEP(1,MHEP),PHEP(1,NHEP)) + CALL HWVEQU(4,VHEP(1,KHEP),VHEP(1,RHEP)) + CALL HWVEQU(4,VHEP(1,KHEP),VHEP(1,MHEP)) + ELSE + CALL HWWARN('HWDHOB',102,*999) + ENDIF +C Colour connections + IF (ID.EQ.6.OR.ID.EQ.12.OR.(ID.GE.209.AND.ID.LE.212) + & .OR.(ID.GE.215.AND.ID.LE.218)) THEN + IF (NPR.EQ.3.AND.NME(IM).EQ.100) THEN +C usual heavy quark decay + JMOHEP(2,KHEP)=MHEP + JDAHEP(2,KHEP)=MHEP + JMOHEP(2,MHEP)=KHEP + JDAHEP(2,MHEP)=KHEP + JMOHEP(2,NHEP)=LHEP + JDAHEP(2,NHEP)=LHEP + ELSEIF (ABS(IDHEP(MHEP)).EQ.37) THEN +C heavy quark to charged Higgs + JMOHEP(2,MHEP)=MHEP + JDAHEP(2,MHEP)=MHEP + JMOHEP(2,NHEP)=LHEP + JDAHEP(2,NHEP)=LHEP + ELSEIF (ABS(IDHEP(NHEP)).EQ.37) THEN + JMOHEP(2,MHEP)=LHEP + JDAHEP(2,MHEP)=LHEP + JMOHEP(2,NHEP)=NHEP + JDAHEP(2,NHEP)=NHEP + ELSE + CALL HWWARN('HWDHOB',103,*999) + ENDIF + ELSE + IF(.NOT.RPARTY.AND. + & ((NPR.EQ.2.AND.ID.GE.401.AND.ID.LT.448.AND. + & IDHW(MHEP).LE.132.AND.IDHW(NHEP).LE.132) + & .OR.(NPR.EQ.3.AND.ID.GE.449.AND.ID.LE.457.AND. + & IDHW(MHEP).LE.132.AND.IDHW(NHEP).LE.132.AND. + & IDHW(MHEP-1).LE.132))) THEN +C R-parity violating SUSY decays + IF(NPR.EQ.2) THEN +C--Rparity slepton colour connections + IF(ID.GE.425.AND.ID.LE.448) THEN + IF(IDHW(MHEP).GT.12) THEN + JMOHEP(2,MHEP) = MHEP + JDAHEP(2,MHEP) = MHEP + JMOHEP(2,NHEP) = NHEP + JDAHEP(2,NHEP) = NHEP + ELSE + JMOHEP(2,MHEP) = NHEP + JDAHEP(2,MHEP) = NHEP + JMOHEP(2,NHEP) = MHEP + JDAHEP(2,NHEP) = MHEP + ENDIF +C--Rparity squark colour connections + ELSE + IF(IDHEP(LHEP).GT.0) THEN +C--LQD decay colour connections + IF(IDHW(MHEP).GT.12) THEN + JMOHEP(2,MHEP) = MHEP + JDAHEP(2,MHEP) = MHEP + JMOHEP(2,NHEP) = LHEP + JDAHEP(2,NHEP) = LHEP + ELSE +C--UDD decay colour connections + HVFCEN = .TRUE. + CALL HWDRCL(LHEP,MHEP,CLSAVE) + ENDIF + ELSE +C--Antisquark connections + IF(IDHW(MHEP).GT.12) THEN + JMOHEP(2,MHEP) = MHEP + JDAHEP(2,MHEP) = MHEP + JMOHEP(2,NHEP) = LHEP + JDAHEP(2,NHEP) = LHEP + ELSE + HVFCEN = .TRUE. + CALL HWDRCL(LHEP,MHEP,CLSAVE) + ENDIF + ENDIF + ENDIF + ELSE + IF(ID.GE.450.AND.ID.LE.457) THEN +C--Rparity Neutralino/Chargino colour connection + IF(IDHW(MHEP-1).LE.12.AND.IDHW(MHEP).LE.12. + & AND.IDHW(NHEP).LE.12) THEN + HVFCEN = .TRUE. + CALL HWDRCL(LHEP,MHEP,CLSAVE) + ELSE + JMOHEP(2,MHEP) = NHEP + JDAHEP(2,MHEP) = NHEP + JMOHEP(2,NHEP) = MHEP + JDAHEP(2,NHEP) = MHEP + ENDIF +C--Rparity gluino colour connections + ELSEIF(ID.EQ.449) THEN + IF(IDHW(MHEP-1).LE.12.AND.IDHW(MHEP).LE.12. + & AND.IDHW(NHEP).LE.12) THEN + HVFCEN = .TRUE. + CALL HWDRCL(LHEP,MHEP,CLSAVE) +C--Now the lepton number violating decay + ELSE + IF(IDHW(MHEP).LE.6) THEN + JMOHEP(2,MHEP) = LHEP + JDAHEP(2,MHEP) = NHEP + JMOHEP(2,NHEP) = MHEP + JDAHEP(2,NHEP) = LHEP + ELSE + JMOHEP(2,MHEP) = NHEP + JDAHEP(2,MHEP) = LHEP + JMOHEP(2,NHEP) = LHEP + JDAHEP(2,NHEP) = MHEP + ENDIF + ENDIF + ELSE + CALL HWWARN('HWDHOB',104,*999) + ENDIF + ENDIF + ELSE +C Normal SUSY decays + IF (ID.LE.448.AND.ID.GT.207) THEN +C Squark (or slepton) + IF (IDHW(MHEP).EQ.449) THEN + IF (IDHEP(LHEP).GT.0) THEN + JMOHEP(2,MHEP)=LHEP + JDAHEP(2,MHEP)=NHEP + JMOHEP(2,NHEP)=MHEP + JDAHEP(2,NHEP)=LHEP + ELSE + JMOHEP(2,MHEP)=NHEP + JDAHEP(2,MHEP)=LHEP + JMOHEP(2,NHEP)=LHEP + JDAHEP(2,NHEP)=MHEP + ENDIF + ELSE + IF(NPR.EQ.3.AND.IDHW(MHEP).LE.12) THEN + JMOHEP(2,MHEP)=NHEP + JDAHEP(2,MHEP)=NHEP + JMOHEP(2,NHEP)=MHEP + JDAHEP(2,NHEP)=MHEP + ELSE + JMOHEP(2,MHEP)=MHEP + JDAHEP(2,MHEP)=MHEP + JMOHEP(2,NHEP)=LHEP + JDAHEP(2,NHEP)=LHEP + ENDIF + ENDIF + ELSEIF (ID.EQ.449) THEN +C Gluino + IF (IDHW(NHEP).EQ.13) THEN + JMOHEP(2,MHEP)=MHEP + JDAHEP(2,MHEP)=MHEP + JMOHEP(2,NHEP)=LHEP + JDAHEP(2,NHEP)=LHEP + ELSEIF (IDHEP(MHEP).GT.0) THEN + JMOHEP(2,MHEP)=LHEP + JDAHEP(2,MHEP)=NHEP + JMOHEP(2,NHEP)=MHEP + JDAHEP(2,NHEP)=LHEP + ELSE + JMOHEP(2,MHEP)=NHEP + JDAHEP(2,MHEP)=LHEP + JMOHEP(2,NHEP)=LHEP + JDAHEP(2,NHEP)=MHEP + ENDIF + ELSE +C Gaugino or Higgs + JMOHEP(2,MHEP)=NHEP + JDAHEP(2,MHEP)=NHEP + JMOHEP(2,NHEP)=MHEP + JDAHEP(2,NHEP)=MHEP + ENDIF + ENDIF + ENDIF +C---SPECIAL CASE FOR THREE-BODY TOP DECAYS: +C RELABEL THEM AS TWO TWO-BODY DECAYS FOR PARTON SHOWERING + IF ((ID.EQ.6.OR.ID.EQ.12).AND.NPR.EQ.3.AND.NME(IM).EQ.100) THEN +C---STORE W DECAY PRODUCTS + CALL HWVEQU(10,PHEP(1,KHEP),PDW) +C---BOOST THEM INTO W REST FRAME + CALL HWULOF(PW,PDW(1,1),PDW(1,3)) +C---REPLACE THEM BY W + CALL HWVEQU(5,PW,PHEP(1,KHEP)) + WHEP=KHEP + IDHW(KHEP)=198 + IF (ID.EQ.12) IDHW(KHEP)=199 + IDHEP(KHEP)=IDPDG(IDHW(KHEP)) + JMOHEP(2,KHEP)=KHEP + JDAHEP(2,KHEP)=KHEP + CALL HWVEQU(4,VHEP(1,NHEP),VHEP(1,KHEP)) +C---AND MOVE B UP + CALL HWVEQU(5,PHEP(1,NHEP),PHEP(1,MHEP)) + IDHW(MHEP)=IDHW(NHEP) + IDHEP(MHEP)=IDHEP(NHEP) + JDAHEP(2,LHEP)=MHEP + JMOHEP(2,MHEP)=JMOHEP(2,NHEP) + JDAHEP(2,MHEP)=JDAHEP(2,NHEP) + CALL HWVEQU(4,VHEP(1,NHEP),VHEP(1,MHEP)) + NHEP=MHEP +C---DO PARTON SHOWER + EMSCA=PHEP(5,IHEP) + CALL HWBGEN + IF (IERROR.NE.0) RETURN +C---FIND BOOSTED W MOMENTUM + NTRY=0 + 41 NTRY=NTRY+1 + IF (NTRY.GT.NHEP.OR.WHEP.LE.0.OR.WHEP.GT.NHEP) + $ CALL HWWARN('HWDHOB',101,*999) + WHEP=JDAHEP(1,WHEP) + IF (ISTHEP(WHEP).NE.190) GOTO 41 +C---AND HENCE ITS CHILDRENS MOMENTA + CALL HWULOB(PHEP(1,WHEP),PDW(1,3),PHEP(1,NHEP+1)) + CALL HWVDIF(4,PHEP(1,WHEP),PHEP(1,NHEP+1),PHEP(1,NHEP+2)) + PHEP(5,NHEP+2)=PDW(5,2) +C---LABEL THEM + ISTHEP(WHEP)=195 + DO 51 I=1,2 + IDHW(NHEP+I)=IDKPRD(I,IM) + IDHEP(NHEP+I)=IDPDG(IDHW(NHEP+I)) + ISTHEP(NHEP+I)=112+I + JDAHEP(I,WHEP)=NHEP+I + JMOHEP(1,NHEP+I)=WHEP + JMOHEP(2,NHEP+I)=NHEP+3-I + JDAHEP(2,NHEP+I)=NHEP+3-I + 51 CONTINUE + NHEP=NHEP+2 +C---ASSIGN PRODUCTION VERTICES TO 1 AND 2 + CALL HWUDKL(198,PW,VHEP(1,NHEP)) + CALL HWVSUM(4,VHEP(1,WHEP),VHEP(1,NHEP),VHEP(1,NHEP)) + CALL HWVEQU(4,VHEP(1,NHEP),VHEP(1,NHEP-1)) +C---DO PARTON SHOWERS + EMSCA=PW(5) + CALL HWBGEN + IF (IERROR.NE.0) RETURN + ELSE +C Do parton showers + EMSCA=PHEP(5,IHEP) + CALL HWBGEN + IF (IERROR.NE.0) RETURN + ENDIF + ENDIF +C--New to correct colour connections in Rslash + IF(CLSAVE(1).NE.0) THEN + THEP = MHEP+1 + ID = IDHW(CLSAVE(1)) + IDM = IDHW(JMOHEP(1,CLSAVE(1))) + IDM2 = IDHW(LHEP) + IF(IDM.EQ.15) ID=IDHW(JMOHEP(1,JMOHEP(1,CLSAVE(1)))) + IF((ID.LE.6.AND.((IDM.GE.419.AND.IDM.LE.424).OR.IDM.EQ.411.OR. + & IDM.EQ.412). + & AND.((IDM2.GE.413.AND.IDM2.LE.418) + & .OR.IDM2.EQ.449).OR.IDM2.EQ.405.OR.IDM2.EQ.406) + & .OR.(ID.LE.6.AND.IDM.EQ.449.AND. + & (((IDM2.GE.413.AND.IDM2.LE.418).OR.IDM2.EQ.405.OR.IDM2.EQ.406) + & .OR.IDM2.EQ.449)).OR. + & (IDM.EQ.15.AND.ID.LE.12.AND.ID.GE.7.AND.((IDM2.GE.413.AND. + & IDM2.LE.418).OR.IDM2.EQ.449.OR.IDM2. + & EQ.405.OR.IDM2.EQ.406))) THEN + IF(JMOHEP(2,CLSAVE(1)).EQ.MHEP) THEN + IF(IDHW(CLSAVE(1)).NE.13.AND.IDHW(CLSAVE(1)).NE.449) + & JMOHEP(2,CLSAVE(2)) = THEP + JDAHEP(2,MHEP) = CLSAVE(1) + JDAHEP(2,THEP) = CLSAVE(2) + ELSE + IF(IDHW(CLSAVE(1)).NE.13.AND.IDHW(CLSAVE(1)).NE.449) + & JMOHEP(2,CLSAVE(2)) = MHEP + JDAHEP(2,MHEP) = CLSAVE(2) + JDAHEP(2,THEP) = CLSAVE(1) + ENDIF + ELSEIF((ID.GT.6.AND.ID.LE.12. + & AND.((IDM.GE.413.AND.IDM.LE.418).OR.IDM.EQ.405.OR. + & IDM.EQ.406).AND. + & ((IDM2.GE.419.AND.IDM2.LE.424).OR.IDM2.EQ.449.OR. + & IDM2.EQ.411.OR.IDM2.EQ.412)).OR. + & (ID.GT.6.AND.ID.LE.12.AND.IDM.EQ.449. + & AND.((IDM2.GE.419.AND.IDM2.LE.424).OR.IDM2.EQ.449.OR. + & IDM2.EQ.411.OR.IDM2.EQ.412)).OR. + & (IDM.EQ.15.AND.ID.LE.6.AND.((IDM2.GE.419.AND. + & IDM2.LE.424).OR.IDM2.EQ.449.OR.IDM2.EQ.411.OR. + & IDM2.EQ.412))) THEN + IF(JDAHEP(2,CLSAVE(1)).EQ.MHEP) THEN + JDAHEP(2,CLSAVE(2))=THEP + JMOHEP(2,MHEP)=CLSAVE(1) + JMOHEP(2,THEP)=CLSAVE(2) + ELSE + JDAHEP(2,CLSAVE(2))=MHEP + JMOHEP(2,MHEP)=CLSAVE(2) + JMOHEP(2,THEP)=CLSAVE(1) + ENDIF + ENDIF + COLUPD = .FALSE. + CALL HWBCON + ENDIF + IF (IHEP.EQ.NHEP) GOTO 70 + 60 CONTINUE + 70 IF (FOUND) THEN +C Fix any SUSY colour disconnections + DO 80 IHEP=1,NHEP + IF (ISTHEP(IHEP).GE.147.AND.ISTHEP(IHEP).LE.151 + & .AND.JDAHEP(2,IHEP).EQ.0) THEN + IM=JMOHEP(1,IHEP) +C Chase connection back through SUSY decays + 75 IM=JMOHEP(1,IM) + ISM=ISTHEP(IM) + IF (ISM.EQ.120) GOTO 80 + IF (ISM.NE.123.AND.ISM.NE.124.AND.ISM.NE.155) GOTO 75 +C Look for unclustered parton to connect + DO JHEP=1,NHEP + IF (ISTHEP(JHEP).GE.147.AND.ISTHEP(JHEP).LE.151) THEN + JCM=JMOHEP(2,JHEP) + IF (JCM.EQ.IM) THEN +C Found it: connect + JMOHEP(2,JHEP)=IHEP + JDAHEP(2,IHEP)=JHEP + GOTO 80 + ENDIF + ENDIF + ENDDO +C Not found: need to go further back + GOTO 75 + ENDIF + 80 CONTINUE +C Go back to check for further heavy decay products + GOTO 10 + ENDIF + 999 END +CDECK ID>, HWDHVY. +*CMZ :- -26/04/91 12.19.24 by Federico Carminati +*-- Author : Ian Knowles & Bryan Webber +C----------------------------------------------------------------------- + SUBROUTINE HWDHVY +C----------------------------------------------------------------------- +C Performs partonic decays of hadrons containing heavy quark(s): +C either, meson/baryon spectator model weak decays; +C or, quarkonia -> 2-gluons, q-qbar, 3-gluons, or 2-gluons + photon. +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + DOUBLE PRECISION HWULDO,HWR,XS,XB,EMWSQ,GMWSQ,EMLIM,PW(4), + & EMTST,X1,X2,X3,TEST,HWDWWT,HWDPWT + INTEGER IST(3),I,IHEP,IM,ID,IDQ,IQ,IS,J + EXTERNAL HWR,HWDWWT,HWDPWT,HWULDO + DATA IST/113,114,114/ + IF (IERROR.NE.0) RETURN + DO 100 I=1,NMXQDK + IF (I.GT.NQDK) THEN + NQDK=0 + RETURN + ENDIF + IHEP=LOCQ(I) + IF (ISTHEP(IHEP).EQ.199) GOTO 100 + IM=IMQDK(I) + IF (NHEP+NPRODS(IM).GT.NMXHEP) CALL HWWARN('HWDHVY',100,*999) + IF (IDKPRD(4,IM).NE.0) THEN +C Weak decay of meson or baryon +C Idenitify decaying heavy quark and spectator + ID=IDHW(IHEP) + IF (ID.EQ.136.OR.ID.EQ.140.OR.ID.EQ.144.OR. + & ID.EQ.150.OR.ID.EQ.155.OR.ID.EQ.158.OR.ID.EQ.161.OR. + & (ID.EQ.254.AND.IDKPRD(4,IM).EQ.11)) THEN +C c hadron or c decay of B_c+ + IDQ=4 + IQ=NHEP+1 + IS=NHEP+2 + ELSEIF (ID.EQ.171.OR.ID.EQ.175.OR.ID.EQ.179.OR. + & ID.EQ.185.OR.ID.EQ.190.OR.ID.EQ.194.OR.ID.EQ.196.OR. + & (ID.EQ.230.AND.IDKPRD(4,IM).EQ.5)) THEN +C cbar hadron or cbar decay of B_c- + IDQ=10 + IS=NHEP+1 + IQ=NHEP+2 + ELSEIF ((ID.GE.221.AND.ID.LE.229).OR. + & (ID.EQ.230.AND.IDKPRD(4,IM).EQ.10)) THEN +C b hadron or b decay of B_c- + IDQ=5 + IQ=NHEP+1 + IS=NHEP+2 + ELSEIF ((ID.GE.245.AND.ID.LE.253).OR. + & (ID.EQ.254.AND.IDKPRD(4,IM).EQ.4)) THEN +C bbar hadron or bbar decay of B_c+ + IDQ=11 + IS=NHEP+1 + IQ=NHEP+2 + ELSE +C Decay not recognized + CALL HWWARN('HWDHVY',101,*999) + ENDIF +C Label constituents + IF (NHEP+5.GT.NMXHEP) CALL HWWARN('HWDHVY',102,*999) + ISTHEP(IHEP)=199 + JDAHEP(1,IHEP)=NHEP+1 + JDAHEP(2,IHEP)=NHEP+2 + IDHW(IQ)=IDQ + IDHW(IS)=IDKPRD(4,IM) + IDHEP(IQ)=IDPDG(IDQ) + IDHEP(IS)=IDPDG(IDKPRD(4,IM)) + ISTHEP(IQ)=155 + ISTHEP(IS)=115 + JMOHEP(1,IQ)=IHEP + JMOHEP(2,IQ)=IS + JDAHEP(1,IQ)=NHEP+3 + JDAHEP(2,IQ)=NHEP+5 + JMOHEP(1,IS)=IHEP + JMOHEP(2,IS)=NHEP+5 + JDAHEP(1,IS)=0 + JDAHEP(2,IS)=NHEP+5 + NHEP=NHEP+2 +C and weak decay product jets + DO 10 J=1,3 + NHEP=NHEP+1 + IDHW(NHEP)=IDKPRD(J,IM) + IDHEP(NHEP)=IDPDG(IDKPRD(J,IM)) + ISTHEP(NHEP)=IST(J) + JMOHEP(1,NHEP)=IQ + JDAHEP(1,NHEP)=0 + 10 PHEP(5,NHEP)=RMASS(IDKPRD(J,IM)) + JMOHEP(2,NHEP-2)=NHEP-1 + JDAHEP(2,NHEP-2)=NHEP-1 + JMOHEP(2,NHEP-1)=NHEP-2 + JDAHEP(2,NHEP-1)=NHEP-2 + JMOHEP(2,NHEP )=IQ + JDAHEP(2,NHEP )=IQ +C Share momenta in ratio of masses, preserving specator mass + XS=RMASS(IDHW(IS))/PHEP(5,IHEP) + XB=ONE-XS + CALL HWVSCA(5,XB,PHEP(1,IHEP),PHEP(1,IQ)) + CALL HWVSCA(5,XS,PHEP(1,IHEP),PHEP(1,IS)) + IF (NME(IM).EQ.100) THEN +C Generate decay momenta using full (V-A)*(V-A) matrix element + EMWSQ=RMASS(198)**2 + GMWSQ=(RMASS(198)*GAMW)**2 + EMLIM=GMWSQ+(EMWSQ-(PHEP(5,IQ)-PHEP(5,NHEP))**2)**2 + 20 CALL HWDTHR(PHEP(1,IQ ),PHEP(1,NHEP-1), + & PHEP(1,NHEP-2),PHEP(1,NHEP),HWDWWT) + CALL HWVSUM(4,PHEP(1,NHEP-2),PHEP(1,NHEP-1),PW) + EMTST=(HWULDO(PW,PW)-EMWSQ)**2 + IF ((EMTST+GMWSQ)*HWR().GT.EMLIM) GOTO 20 + ELSE +C Use phase space + CALL HWDTHR(PHEP(1,IQ ),PHEP(1,NHEP-2), + & PHEP(1,NHEP-1),PHEP(1,NHEP),HWDPWT) + CALL HWVSUM(4,PHEP(1,NHEP-2),PHEP(1,NHEP-1),PW) + ENDIF +C Set up production vertices + CALL HWVZRO(4,VHEP(1,IQ)) + CALL HWVEQU(4,VHEP(1,IQ),VHEP(1,IS)) + CALL HWVEQU(4,VHEP(1,IQ),VHEP(1,NHEP)) + CALL HWUDKL(198,PW,VHEP(1,NHEP-2)) + CALL HWVSUM(4,VHEP(1,IQ),VHEP(1,NHEP-2),VHEP(1,NHEP-2)) + CALL HWVEQU(4,VHEP(1,NHEP-2),VHEP(1,NHEP-1)) + EMSCA=PHEP(5,IQ) + ELSE +C Quarkonium decay +C Label products + ISTHEP(IHEP)=199 + JDAHEP(1,IHEP)=NHEP+1 + DO 30 J=1,NPRODS(IM) + NHEP=NHEP+1 + IDHW(NHEP)=IDKPRD(J,IM) + IDHEP(NHEP)=IDPDG(IDKPRD(J,IM)) + ISTHEP(NHEP)=IST(J) + JMOHEP(1,NHEP)=IHEP + JDAHEP(1,NHEP)=0 + PHEP(5,NHEP)=RMASS(IDKPRD(J,IM)) + 30 CALL HWVZRO(4,VHEP(1,NHEP)) + JDAHEP(2,IHEP)=NHEP +C Establish colour connections and select momentum configuration + IF (NPRODS(IM).EQ.3) THEN + IF (IDKPRD(3,IM).EQ.13) THEN +C 3-gluon decay + JMOHEP(2,NHEP-2)=NHEP + JMOHEP(2,NHEP-1)=NHEP-2 + JMOHEP(2,NHEP )=NHEP-1 + JDAHEP(2,NHEP-2)=NHEP-1 + JDAHEP(2,NHEP-1)=NHEP + JDAHEP(2,NHEP )=NHEP-2 + ELSE +C or 2-gluon + photon decay + JMOHEP(2,NHEP-2)=NHEP-1 + JMOHEP(2,NHEP-1)=NHEP-2 + JMOHEP(2,NHEP )=NHEP + JDAHEP(2,NHEP-2)=NHEP-1 + JDAHEP(2,NHEP-1)=NHEP-2 + JDAHEP(2,NHEP )=NHEP + ENDIF + IF (NME(IM).EQ.130) THEN +C Use Ore & Powell orthopositronium matrix element + 40 CALL HWDTHR(PHEP(1,IHEP),PHEP(1,NHEP-2), + & PHEP(1,NHEP-1),PHEP(1,NHEP),HWDPWT) + X1=TWO*HWULDO(PHEP(1,IHEP),PHEP(1,NHEP-2))/PHEP(5,IHEP)**2 + X2=TWO*HWULDO(PHEP(1,IHEP),PHEP(1,NHEP-1))/PHEP(5,IHEP)**2 + X3=TWO-X1-X2 + TEST=((X1*(ONE-X1))**2+(X2*(ONE-X2))**2+(X3*(ONE-X3))**2) + & /(X1*X2*X3)**2 + IF (TEST.LT.TWO*HWR()) GOTO 40 + ELSE +C Use phase space + CALL HWDTHR(PHEP(1,IHEP),PHEP(1,NHEP-2), + & PHEP(1,NHEP-1),PHEP(1,NHEP),HWDPWT) + ENDIF + ELSE +C Parapositronium 2-gluon or q-qbar decay + JMOHEP(2,NHEP-1)=NHEP + JMOHEP(2,NHEP )=NHEP-1 + JDAHEP(2,NHEP-1)=NHEP + JDAHEP(2,NHEP )=NHEP-1 + CALL HWDTWO(PHEP(1,IHEP),PHEP(1,NHEP-1), + & PHEP(1,NHEP),CMMOM(IM),TWO,.FALSE.) + ENDIF + EMSCA=PHEP(5,IHEP) + ENDIF +C Process this new hard scatter + CALL HWVEQU(4,VTXQDK(1,I),VTXPIP) + CALL HWBGEN + CALL HWCFOR + CALL HWCDEC + CALL HWDHAD + 100 CONTINUE + NQDK=0 + 999 END +CDECK ID>, HWDRCL. +*CMZ :- -20/07/99 10:56:12 by Peter Richardson +*-- Author : Peter Richardson +C----------------------------------------------------------------------- + SUBROUTINE HWDRCL(IHEP,MHEP,CLSAVE) +C----------------------------------------------------------------------- +C Sets the colour connections in Baryon number violating decays +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + INTEGER IHEP,MHEP,ID,ID2,IDM2,IDM3,COLCON(2,2,3),FLACON(2,3),JHEP, + & DECAY,COLANT,KHEP,IDM,IDMB,IDMB2,IDMB3,IDMB4,QHEP,IDM4, + & CLSAVE(2),XHEP,I,HWRINT,THEP + LOGICAL CONBV +C--Colour connections for the decays + DATA COLCON/-1,1,-1,-2,-2,1,-3,-1,-1,1,-2,-1/ + DATA FLACON/1,-1,1,-1,-1,0/ +C--identify the decay + IF(IERROR.NE.0) RETURN + ID = IDHW(IHEP) + ID2 = IDHW(MHEP) + IF(ID.GE.450.AND.ID.LE.457) THEN + DECAY = 1 + ELSEIF(ID.EQ.449) THEN + DECAY = 2 + ELSEIF((ID.GE.411.AND.ID.LE.424).OR.ID.EQ.405.OR.ID.EQ.406) THEN + DECAY = 3 + ELSE +C--UNKNOWN DECAY + CALL HWWARN('HWDRCL',100,*999) + ENDIF + COLANT = 1 +C--identify the colour partner + IF(DECAY.GT.1.AND.ID2.LE.6) THEN +C--colour partner + COLANT = 2 + KHEP = JDAHEP(2,IHEP-1) + ELSEIF(DECAY.GT.1.AND.ID2.GE.7) THEN +C--anticolour partner + COLANT = 3 + KHEP = JMOHEP(2,IHEP) + ELSE + KHEP=IHEP + ENDIF + IDM = IDHW(JMOHEP(1,KHEP)) + IF(ABS(IDPDG(IDM)).GT.1000000.OR.IDM.EQ.15) THEN + IDM2 = IDHW(JDAHEP(1,JMOHEP(1,KHEP))) + IDM3 = IDHW(JDAHEP(2,JMOHEP(1,KHEP))) + IDM4 = IDHW(JDAHEP(2,JMOHEP(1,KHEP))-1) + QHEP = JMOHEP(1,KHEP) + IDMB = IDHW(JMOHEP(1,QHEP)) + IDMB2 = IDHW(JMOHEP(2,QHEP)) + IDMB3 = IDHW(JDAHEP(1,QHEP)) + IDMB4 = IDHW(JDAHEP(2,QHEP)) + ENDIF +C--Now decide if the colour partner decayed via BV + IF(COLANT.EQ.2.AND.((((IDM.GE.413.AND.IDM.LE.418).OR. + & IDM.EQ.449.OR.IDM.EQ.405.OR.IDM.EQ.406).AND. + & (IDM2.GE.7.AND.IDM2.LE.12.AND. + & IDM3.GE.7.AND.IDM3.LE.12.AND. + & IDM4.GE.7.AND.IDM4.LE.12)).OR. + & (IDM.EQ.15.AND.IDMB.LE.6.AND.IDMB2.LE.6.AND. + & ((IDMB3.GE.7.AND.IDMB4.GE.12.AND.IDMB4.EQ.449).OR. + & (IDMB3.GE.198.AND.IDMB3.LE.207.AND. + & ABS(IDPDG(IDMB4)).GT.1000000))))) THEN + CONBV = .TRUE. + COLUPD = .TRUE. + HVFCEN = .FALSE. + XHEP = JMOHEP(2,JDAHEP(2,JMOHEP(1,KHEP))) + ELSEIF(COLANT.EQ.3.AND.((((IDM.GE.419.AND.IDM.LE.424).OR. + & IDM.EQ.449.OR.IDM.EQ.411.OR.IDM.EQ.412).AND. + & (IDM2.LE.6.AND.IDM3.LE.6.AND.IDM4.LE.6)).OR. + & (IDM.EQ.15.AND.IDMB.GE.7.AND.IDMB.LE.12.AND. + & IDMB2.GE.7.AND.IDMB2.LE.12.AND.((IDMB3.LE.6.AND. + & IDMB4.EQ.449).OR.(ABS(IDPDG(IDMB4)).GT.1000000 + & .AND.IDMB3.GE.198.AND.IDMB3.LE.207))))) THEN + CONBV = .TRUE. + COLUPD = .TRUE. + HVFCEN = .FALSE. + XHEP = JDAHEP(2,JDAHEP(2,JMOHEP(1,KHEP))) + ELSE + CONBV = .FALSE. + COLUPD = .FALSE. + XHEP = 0 + ENDIF + IF(CONBV) THEN + IF(IDM.NE.15) THEN + CLSAVE(1) = JDAHEP(2,JMOHEP(1,KHEP))-1 + CLSAVE(2) = CLSAVE(1)+1 + ELSE + IF(IDMB4.EQ.449) THEN + DO I=1,2 + CLSAVE(I) = JMOHEP(I,JMOHEP(1,KHEP)) + IF(CLSAVE(I).EQ.XHEP) CLSAVE(I)=JDAHEP(1,JMOHEP(1,KHEP)) + ENDDO + ELSE + CLSAVE(1) = JMOHEP(1,JMOHEP(1,KHEP)) + CLSAVE(2) = JMOHEP(2,JMOHEP(1,KHEP)) + ENDIF + ENDIF + ELSE + CLSAVE(1)=0 + CLSAVE(2)=0 + ENDIF +C--Now set the colours for angular ordering + THEP = MHEP-1 + IF(DECAY.EQ.1) THEN + IF(ID2.LE.6) THEN + JMOHEP(2,THEP) = THEP+HWRINT(1,2) + JDAHEP(2,THEP) = THEP + ELSE + JMOHEP(2,THEP) = THEP + JDAHEP(2,THEP) = THEP+HWRINT(1,2) + ENDIF + ELSEIF(DECAY.EQ.2) THEN + IF(ID2.LE.6) THEN + JMOHEP(2,THEP) = IHEP + JDAHEP(2,THEP) = THEP + ELSE + JMOHEP(2,THEP) = THEP + JDAHEP(2,THEP) = IHEP + ENDIF + ENDIF +C--Colour of the second two + DO JHEP=1,2 + IF(ID2.LE.6) THEN + JMOHEP(2,MHEP+JHEP-1) = MHEP+JHEP-1+ + & COLCON(HWRINT(1,2),JHEP,DECAY) + JDAHEP(2,MHEP+JHEP-1) = MHEP+JHEP-1+FLACON(JHEP,DECAY) + ELSE + JDAHEP(2,MHEP+JHEP-1) = MHEP+JHEP-1+ + & COLCON(HWRINT(1,2),JHEP,DECAY) + JMOHEP(2,MHEP+JHEP-1) = MHEP+JHEP-1+FLACON(JHEP,DECAY) + ENDIF + ENDDO +C--Now set the colours of the colour partner + IF(DECAY.GT.1.AND..NOT.CONBV) THEN + IF(ID2.LE.6) JMOHEP(2,KHEP) = MHEP+HWRINT(0,1) + IF(ID2.GE.7) JDAHEP(2,KHEP) = MHEP+HWRINT(0,1) + ELSEIF(CONBV) THEN + IF(ID2.GT.6) THEN + JMOHEP(2,CLSAVE(1)) = MHEP+HWRINT(0,1) + IF(JMOHEP(2,CLSAVE(1)).EQ.MHEP) THEN + JMOHEP(2,CLSAVE(2)) = MHEP+1 + ELSE + JMOHEP(2,CLSAVE(2)) = MHEP + ENDIF + ELSE + JDAHEP(2,CLSAVE(1)) = MHEP+HWRINT(0,1) + IF(JDAHEP(2,CLSAVE(1)).EQ.MHEP) THEN + JDAHEP(2,CLSAVE(2)) = MHEP+1 + ELSE + JDAHEP(2,CLSAVE(2)) = MHEP + ENDIF + ENDIF + ENDIF + 999 END +CDECK ID>, HWDRME. +*CMZ :- -20/07/99 10:56:12 by Peter Richardson +*-- Author : Peter Richardson +C----------------------------------------------------------------------- + SUBROUTINE HWDRME(LHEP,MHEP) +C----------------------------------------------------------------------- +C SUBROUTINE TO IMPLEMENT ALL RPARITY DECAY MATRIX ELEMENTS +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + DOUBLE PRECISION SM(6),SW(6),HWULDO,INFCOL,AM, M12SQ,M23SQ,MSGN, + & M13SQ,A(6),B(6),SWEAK,MW,DECMOM(5),TEST(4),EPS, + & M12SQT(6),M23SQT(6),M13SQT(6),LIMIT,M(4),RAND, + & MC(2),MX2(6),MX(6),HWDPWT,HWR,HWDRM1,LAMD(3) + EXTERNAL HWDRM1,HWULDO,HWDPWT,HWR + INTEGER K,SN(3),LHEP,CSP,I,SB(3),J,ND,LTRY,MHEP,NSP,ID(3),IG, + & IDHWTP,IDHPTP,MTRY + PARAMETER(EPS=1D-20) + IF(IERROR.NE.0) RETURN +C--Electroweak parameters, etc + SWEAK = SQRT(SWEIN) + MW = RMASS(198) + M(4) = PHEP(5,LHEP) + IG = IDHW(LHEP) +C--Find the masses of the final state and zero parameters + DO K=1,3 + ID(K) = IDHW(MHEP+K-1) + IF(ID(K).LE.12) THEN + SN(K)=ID(K) + ELSE + SN(K)=ID(K)-120 + ENDIF + IF(SN(K).GT.6) SN(K)=SN(K)-6 + M(K) = PHEP(5,LHEP+K) + SB(K)=SN(K) + LAMD(K) = ZERO + ENDDO + DO J=1,6 + MX2(J) = ZERO + MX(J) = ZERO + M13SQT(J) = ZERO + M23SQT(J) = ZERO + M12SQT(J) = ZERO + ENDDO +C--Evaluate the coefficents for the mode we want + IF(IG.GE.450.AND.IG.LE.453) THEN +C--NEUTRALINO + NSP = IG-449 + AM = RMASS(IG) + MSGN = ZSGNSS(NSP) + MC(1) = ZMIXSS(NSP,3)/(2*MW*COSB*SWEAK) + MC(2) = ZMIXSS(NSP,4)/(2*MW*SINB*SWEAK) +C--Calculate the combinations of couplings needed + IF(ID(1).LE.12.AND.ID(2).LE.12.AND.ID(3).LE.12) THEN +C--first for the UDD modes + DO J=1,2 + A(J) = M(1)*MC(2)*QMIXSS(SN(1),2,J) + & +SLFCH(SN(1),NSP)*QMIXSS(SN(1),1,J) + B(J) = MSGN*(M(1)*MC(2)*QMIXSS(SN(1),1,J) + & +SRFCH(SN(1),NSP)*QMIXSS(SN(1),2,J)) + MX2(J) = QMIXSS(SN(1),2,J) + A(J+2) = M(2)*MC(1)*QMIXSS(SN(2),2,J) + & +SLFCH(SN(2),NSP)*QMIXSS(SN(2),1,J) + B(J+2) = MSGN*(M(2)*MC(1)*QMIXSS(SN(2),1,J) + & +SRFCH(SN(2),NSP)*QMIXSS(SN(2),2,J)) + MX2(J+2) = QMIXSS(SN(2),2,J) + A(J+4) = M(3)*MC(1)*QMIXSS(SN(3),2,J) + & +SLFCH(SN(3),NSP)*QMIXSS(SN(3),1,J) + B(J+4) = MSGN*(M(3)*MC(1)*QMIXSS(SN(3),1,J) + & +SRFCH(SN(3),NSP)*QMIXSS(SN(3),2,J)) + MX2(J+2) = QMIXSS(SN(3),2,J) + ENDDO + DO K=1,3 + SN(K) = SN(K)+400 + SB(K) = SB(K)+412 + ENDDO + ELSEIF(ID(1).GE.121.AND.ID(2).GE.121.AND.ID(3).GE.121) THEN +C--Now for the LLE modes + DO J=1,2 + A(J) = MSGN*(M(1)*MC(1)*LMIXSS(SN(1),1,J) + & +SRFCH(10+SN(1),NSP)*LMIXSS(SN(1),2,J)) + B(J) = M(1)*MC(1)*LMIXSS(SN(1),2,J) + & +SLFCH(10+SN(1),NSP)*LMIXSS(SN(2),1,J) + MX2(J)= LMIXSS(SN(1),1,J) + A(J+2) = ZERO + B(J+2) = SLFCH(10+SN(2),NSP)*LMIXSS(SN(2),1,J) + MX2(J+2) = LMIXSS(SN(2),1,J) + A(J+4) = M(3)*MC(1)*LMIXSS(SN(3),2,J) + & +SLFCH(10+SN(3),NSP)*LMIXSS(SN(3),1,J) + B(J+4) = MSGN*(M(3)*MC(1)*LMIXSS(SN(3),1,J) + & +SRFCH(10+SN(3),NSP)*LMIXSS(SN(3),2,J)) + MX2(4+J) = LMIXSS(SN(3),2,J) + ENDDO + DO J=1,3 + SN(J) = SN(J) + 424 + SB(J) = SB(J) + 436 + ENDDO + ELSE +C--Now for both types of LQD modes + IF(MOD(SN(1),2).EQ.0) THEN +C--First the neutrino,down,antidown mode + DO J=1,2 + A(J) = ZERO + B(J) = SLFCH(10+SN(1),NSP)* + & LMIXSS(SN(1),1,J) + MX2(J) = LMIXSS(SN(1),1,J) + A(J+2) = MSGN*(M(2)*MC(1)*QMIXSS(SN(2),1,J) + & +SRFCH(SN(2),NSP)*QMIXSS(SN(2),2,J)) + B(J+2) = M(2)*MC(1)*QMIXSS(SN(2),2,J) + & +SLFCH(SN(2),NSP)*QMIXSS(SN(2),1,J) + MX2(2+J) = QMIXSS(SN(2),1,J) + A(J+4) = M(3)*MC(1)*QMIXSS(SN(3),2,J) + & +SLFCH(SN(3),NSP)*QMIXSS(SN(3),1,J) + B(J+4) = MSGN*(M(3)*MC(1)*QMIXSS(SN(3),1,J) + & +SRFCH(SN(3),NSP)*QMIXSS(SN(3),2,J)) + MX2(J+4) = QMIXSS(SN(3),2,J) + ENDDO + ELSE +C--Now the charged lepton, antiup,down modes + DO J=1,2 + A(J) = MSGN*(M(1)*MC(1)*LMIXSS(SN(1),1,J) + & +SRFCH(10+SN(1),NSP)*LMIXSS(SN(1),2,J)) + B(J) = M(1)*MC(1)*LMIXSS(SN(1),2,J) + & +SLFCH(10+SN(1),NSP)*LMIXSS(SN(1),1,J) + MX2(J) = LMIXSS(SN(1),1,J) + A(J+2) =MSGN*(M(2)*MC(2)*QMIXSS(SN(2),1,J) + & +SRFCH(SN(2),NSP)*QMIXSS(SN(2),2,J)) + B(J+2) = M(2)*MC(2)*QMIXSS(SN(2),2,J) + & +SLFCH(SN(2),NSP)*QMIXSS(SN(2),1,J) + MX2(2+J) = QMIXSS(SN(2),1,J) + A(J+4) = M(3)*MC(1)*QMIXSS(SN(3),2,J) + & +SLFCH(SN(3),NSP)*QMIXSS(SN(3),1,J) + B(J+4) = MSGN*(M(3)*MC(1)*QMIXSS(SN(3),1,J) + & +SRFCH(SN(3),NSP)*QMIXSS(SN(3),2,J)) + MX2(J+4) = QMIXSS(SN(3),2,J) + ENDDO + ENDIF + SN(1) = SN(1) + 424 + SB(1) = SB(1) + 436 + DO J=2,3 + SN(J) = SN(J) + 400 + SB(J) = SB(J) + 412 + ENDDO + ENDIF + DO K=1,3 + SM(2*K-1) = RMASS(SN(K)) + SM(2*K) = RMASS(SB(K)) + SW(2*K-1) = HBAR/RLTIM(SN(K)) + SW(2*K) = HBAR/RLTIM(SB(K)) + ENDDO + ND = 3 + DO K=1,3 + LAMD(K) = ONE + ENDDO + INFCOL = ONE + ELSEIF(IG.EQ.449) THEN +C--GLUINO +C--First obtian the masses and widths needed + AM = RMASS(IG) + ND = 3 +C--Calculate the combinations of couplings needed + IF(ID(1).LE.12.AND.ID(2).LE.12.AND.ID(3).LE.12) THEN +C--first for the UDD modes + INFCOL = -0.5D0 +C--Couplings + DO I=1,3 + DO J=1,2 + A(2*I-2+J) = -QMIXSS(SN(I),1,J) + B(2*I-2+J) = QMIXSS(SN(I),2,J) + MX2(2*I-2+J) = QMIXSS(SN(I),2,J) + ENDDO + SN(I) = SN(I)+400 + SB(I) = SB(I)+412 + ENDDO + ELSE + INFCOL = ONE +C--Now for both types of LQD modes + IF(MOD(SN(1),2).EQ.0) THEN +C--First the neutrino,down,antidown mode + DO J=1,2 + A(J) = ZERO + B(J) = ZERO + MX2(J) = ZERO + A(J+2) = QMIXSS(SN(2),2,J) + B(J+2) = -QMIXSS(SN(2),1,J) + MX2(J+2) = QMIXSS(SN(2),1,J) + A(J+4) = -QMIXSS(SN(3),1,J) + B(J+4) = QMIXSS(SN(3),2,J) + MX2(4+J) = QMIXSS(SN(3),2,J) + ENDDO + ELSEIF(MOD(SN(1),2).EQ.1) THEN +C--Now the charged lepton, antiup,down modes + DO J=1,2 + A(J) = ZERO + B(J) = ZERO + MX2(J) = ZERO + A(J+2) = QMIXSS(SN(2),2,J) + B(J+2) = -QMIXSS(SN(2),1,J) + MX2(J+2) = QMIXSS(SN(2),1,J) + A(J+4) = -QMIXSS(SN(3),1,J) + B(J+4) = QMIXSS(SN(3),2,J) + MX2(J+4) = QMIXSS(SN(3),2,J) + ENDDO + ENDIF + SN(1) = SN(1) + 424 + SB(1) = SB(1) + 436 + DO K=2,3 + SN(K) = SN(K) + 400 + SB(K) = SB(K) + 412 + ENDDO + ENDIF + DO K=1,3 + SM(2*K-1) = RMASS(SN(K)) + SM(2*K) = RMASS(SB(K)) + SW(2*K-1) = HBAR/RLTIM(SN(K)) + SW(2*K) = HBAR/RLTIM(SB(K)) + ENDDO + DO K=1,3 + LAMD(K) = ONE + ENDDO + ELSEIF(IG.GE.454.AND.IG.LE.457) THEN +C--CHARGINO + CSP = IG-453 + IF(CSP.GT.2) CSP = CSP-2 + AM = RMASS(IG) + INFCOL = -ONE + MSGN = WSGNSS(CSP) + MC(1) = ONE/(SQRT(2.0D0)*MW*COSB) + MC(2) = ONE/(SQRT(2.0D0)*MW*SINB) +C--Calculate the combinations of the couplings needed + IF(ID(1).GT.120.AND.ID(2).GT.120.AND.ID(3).GT.120) THEN +C--first for the LLE modes, three modes + IF(MOD(SN(1),2).EQ.0.AND.MOD(SN(3),2).EQ.0) THEN +C--the one diagram mode nubar,positron, nu + DO J=1,2 + A(J+4) = LMIXSS(SN(3)-1,1,J)*WMXUSS(CSP,1) + & -RMASS(SN(3)+119)*MC(1)*LMIXSS(SN(3)-1,2,J)*WMXUSS(CSP,2) + B(J+4) = ZERO + MX2(J+4) = LMIXSS(SN(3)-1,2,J) + ENDDO + ND = 1 + SN(3) = SN(3)+423 + SB(3) = SB(3)+435 + ELSEIF(MOD(SN(1),2).EQ.0.AND.MOD(SN(2),2).EQ.0) THEN +C--the first two diagram mode nu, nu, positron + DO J=1,2 + A(J) = ZERO + B(J) = LMIXSS(SN(1)-1,1,J)*WMXUSS(CSP,1) + & -RMASS(SN(1)+119)*MC(1)*LMIXSS(SN(1)-1,2,J)*WMXUSS(CSP,2) + A(J+2) = ZERO + B(J+2) = LMIXSS(SN(2)-1,1,J)*WMXUSS(CSP,1) + & -RMASS(SN(2)+119)*MC(1)*LMIXSS(SN(2)-1,2,J)*WMXUSS(CSP,2) + MX2(J) = LMIXSS(SN(1)-1,1,J) + MX2(J+2) = LMIXSS(SN(2)-1,1,J) + ENDDO + ND = 2 + DO J=1,2 + SN(J) = SN(J)+423 + SB(J) = SB(J)+435 + ENDDO + ELSE +C--the second two diagram mode positron, positron, electron + DO J=1,2 + A(J) = -M(1)*WMXUSS(CSP,2)*MC(1)*LMIXSS(SN(1)+1,1,J) + B(J) = MSGN*WMXVSS(CSP,1)*LMIXSS(SN(1)+1,1,J) + A(J+2) = -M(2)*WMXUSS(CSP,2)*MC(1)*LMIXSS(SN(2)+1,1,J) + B(J+2) = MSGN*WMXVSS(CSP,1)*LMIXSS(SN(2)+1,1,J) + MX2(J) = LMIXSS(SN(1)+1,1,J) + MX2(J+2) = LMIXSS(SN(2)+1,1,J) + ENDDO + DO J=1,2 + SN(J) = SN(J)+425 + SB(J) = SB(J)+437 + ENDDO + ND = 2 + ENDIF + DO K=1,3 + LAMD(K) = ONE + ENDDO + ELSEIF(ID(1).LE.12.AND.ID(2).LE.12.AND.ID(3).LE.12) THEN +C--now for the UDD + IF(MOD(SN(1),2).EQ.0) THEN +C--two diagram mode + LAMD(1) = LAMDA3(SN(2)/2,SN(1)/2,(SN(3)+1)/2) + LAMD(2) = LAMDA3(SN(1)/2,SN(2)/2,(SN(3)+1)/2) + DO J=1,2 + A(J) = WMXUSS(CSP,1)*QMIXSS(SN(1)-1,1,J) + & -RMASS(SN(1)-1)*MC(1)*WMXUSS(CSP,2)*QMIXSS(SN(1)-1,2,J) + B(J) = -MSGN*M(2)*WMXVSS(CSP,2)*QMIXSS(SN(1)-1,1,J) + A(J+2) = WMXUSS(CSP,1)*QMIXSS(SN(2)-1,1,J) + & -RMASS(SN(2)-1)*MC(1)*WMXUSS(CSP,2)*QMIXSS(SN(2)-1,2,J) + B(J+2) = -MSGN*M(2)*WMXVSS(CSP,2)*QMIXSS(SN(2)-1,1,J) + MX2(J) = QMIXSS(SN(1)-1,2,J) + MX2(J+2) = QMIXSS(SN(2)-1,2,J) + ENDDO + DO J=1,2 + SN(J) = SN(J) + 399 + SB(J) = SB(J) + 411 + ENDDO + ND = 2 + ELSE +C--three diagram mode + LAMD(1) = LAMDA3((SN(1)+1)/2,(SN(2)+1)/2,(SN(3)+1)/2) + LAMD(2) = LAMDA3((SN(2)+1)/2,(SN(1)+1)/2,(SN(3)+1)/2) + LAMD(3) = LAMDA3((SN(3)+1)/2,(SN(2)+1)/2,(SN(1)+1)/2) + DO I=1,3 + DO J=1,2 + A(J+2*I-2) = MSGN*(WMXVSS(CSP,1)*QMIXSS(SN(I)+1,1,J) + & -RMASS(SN(I)+1)*MC(2)*WMXVSS(CSP,2)*QMIXSS(SN(I)+1,2,J)) + B(J+2*I-2) = -M(I)*MC(1)*WMXUSS(CSP,2) + & *QMIXSS(SN(I)+1,1,J) + MX2(J+2*I-2) = QMIXSS(SN(I)+1,2,J) + ENDDO + SN(I) = SN(I) + 401 + SB(I) = SB(I) + 413 + ENDDO + ND = 3 + ENDIF + ELSE +C--now for the LQD modes + IF(MOD(SN(2),2).EQ.1.AND.MOD(SN(3),2).EQ.0) THEN +C--first one diagram mode nubar, dbar, up + DO J=1,2 + A(J+4) = -MSGN*M(3)*WMXVSS(CSP,2)*MC(2)* + & QMIXSS(SN(3)-1,1,J) + B(J+4) = WMXUSS(CSP,1)*QMIXSS(SN(3)-1,1,J) + & -RMASS(SN(3)-1)*MC(1)*WMXUSS(CSP,2)*QMIXSS(SN(3)-1,2,1) + MX2(J+4) = QMIXSS(SN(3)-1,2,J) + ENDDO + SN(3) = SN(3) + 399 + SB(3) = SB(3) + 411 + ND = 1 + ELSEIF(MOD(SN(2),2).EQ.0.AND.MOD(SN(3),2).EQ.0) THEN +C--second one diagram mode positron, ubar, up + DO J=1,2 + A(J+4) = -MSGN*M(3)*WMXVSS(CSP,2)*MC(2)* + & QMIXSS(SN(3)-1,1,J) + B(J+4) = WMXUSS(CSP,1)*QMIXSS(SN(3)-1,1,J) + & -RMASS(SN(3)-1)*MC(1)*WMXUSS(CSP,2)*QMIXSS(SN(3)-1,2,1) + MX2(J+4) = QMIXSS(SN(3)-1,2,J) + ENDDO + SN(3) = SN(3) + 399 + SB(3) = SB(3) + 411 + ND = 1 + ELSEIF(MOD(SN(2),2).EQ.1.AND.MOD(SN(3),2).EQ.1) THEN +C--first two diagram mode positron, dbar, down + DO J=1,2 + A(J) = -M(1)*MC(1)*WMXUSS(CSP,2)*LMIXSS(SN(1)+1,1,J) + B(J) = MSGN*WMXVSS(CSP,1)*LMIXSS(SN(2)+1,1,J) + A(J+2) = -M(2)*WMXUSS(CSP,2)*MC(1)*QMIXSS(SN(2)+1,1,J) + B(J+2) = MSGN*(WMXVSS(CSP,1)*QMIXSS(SN(2)+1,1,J) + & -RMASS(SN(2)+1)*MC(2)*WMXVSS(CSP,2)*QMIXSS(SN(2)+1,2,J)) + MX2(J) = LMIXSS(SN(1)+1,1,J) + MX2(J+2) = QMIXSS(SN(2)+1,1,J) + ENDDO + SN(1) = SN(1) + 425 + SB(1) = SB(1) + 437 + SN(2) = SN(2) + 401 + SB(2) = SB(2) + 413 + ND = 2 + ELSE +C--second two diagram mode nu, up, dbar + DO J=1,2 + A(J) = ZERO + B(J) = WMXUSS(CSP,1)*LMIXSS(SN(1)-1,1,J) + & -RMASS(119+SN(1))*MC(1)*WMXUSS(CSP,2)*LMIXSS(SN(1)-1,2,J) + A(J+2) = -MSGN*M(2)*MC(2)*WMXVSS(CSP,2)* + & QMIXSS(SN(2)-1,1,J) + B(J+2) = WMXUSS(CSP,1)*QMIXSS(SN(2)-1,1,J) + & -RMASS(SN(2)-1)*MC(1)*WMXUSS(CSP,2)*QMIXSS(SN(2)-1,2,J) + MX2(J) = LMIXSS(SN(1)-1,1,J) + MX2(J+2) = QMIXSS(SN(2)-1,1,J) + ENDDO + SN(1) = SN(1) + 423 + SB(1) = SB(1) + 435 + SN(2) = SN(2) + 399 + SB(2) = SB(2) + 411 + ND = 2 + ENDIF + DO K=1,3 + LAMD(K) = ONE + ENDDO + ENDIF + IF(ND.EQ.1) THEN + DO K=1,2 + SM(2*K-1) = 0.0D0 + SM(2*K) = 0.0D0 + SW(2*K-1) = 0.0D0 + SW(2*K) = 0.0D0 + ENDDO + SM(5) = RMASS(SN(3)) + SM(6) = RMASS(SB(3)) + SW(5) = HBAR/RLTIM(SN(3)) + SW(6) = HBAR/RLTIM(SB(3)) + ELSE + DO K=1,2 + SM(2*K-1) = RMASS(SN(K)) + SM(2*K) = RMASS(SB(K)) + SW(2*K-1) = HBAR/RLTIM(SN(K)) + SW(2*K) = HBAR/RLTIM(SB(K)) + SM(4+K) = ZERO + SW(4+K) = ZERO + ENDDO + ENDIF + ELSE +C--UNKNOWN + CALL HWWARN('HWDRME',500,*999) + ENDIF +C--Set mixing to zero if diagram not available + IF((AM.LT.(ABS(SM(1))+M(1)).OR.ABS(SM(1)).LT.(M(2)+M(3))) + & .AND.ABS(MX2(1)).GT.ZERO.AND.ND.NE.1) MX(1) = MX2(1)*LAMD(1) + IF((AM.LT.(ABS(SM(2))+M(1)).OR.ABS(SM(2)).LT.(M(2)+M(3))) + & .AND.ABS(MX2(2)).GT.ZERO.AND.ND.NE.1) MX(2) = MX2(2)*LAMD(1) + IF((AM.LT.(ABS(SM(3))+M(2)).OR.ABS(SM(3)).LT.(M(1)+M(3))) + & .AND.ABS(MX2(3)).GT.ZERO.AND.ND.NE.1) MX(3) = MX2(3)*LAMD(2) + IF((AM.LT.(ABS(SM(4))+M(2)).OR.ABS(SM(4)).LT.(M(1)+M(3))) + & .AND.ABS(MX2(4)).GT.ZERO.AND.ND.NE.1) MX(4) = MX2(4)*LAMD(2) + IF((AM.LT.(ABS(SM(5))+M(3)).OR.ABS(SM(5)).LT.(M(1)+M(2))) + & .AND.ABS(MX2(5)).GT.ZERO.AND.ND.NE.2) MX(5) = MX2(5)*LAMD(3) + IF((AM.LT.(ABS(SM(6))+M(3)).OR.ABS(SM(6)).LT.(M(1)+M(2))) + & .AND.ABS(MX2(6)).GT.ZERO.AND.ND.NE.2) MX(6) = MX2(6)*LAMD(3) +C--Calculate the limiting points + DO J=1,2 + IF(ND.NE.1) THEN + IF(ABS(MX(J)).GT.EPS) CALL HWDRM5(M23SQT(J),M13SQT(J), + & M12SQT(J),A(J),B(J),M(2),M(3),M(1),M(4),SM(J),SW(J)) + IF(ABS(MX(J+2)).GT.EPS) CALL HWDRM5(M13SQT(2+J),M23SQT(2+J), + & M12SQT(2+J),A(2+J),B(2+J),M(1),M(3),M(2),M(4),SM(2+J),SW(2+J)) + ENDIF + IF(ND.NE.2) THEN + IF(ABS(MX(J+4)).GT.EPS) CALL HWDRM5(M12SQT(4+J),M23SQT(4+J), + & M13SQT(4+J),A(4+J),B(4+J),M(1),M(2),M(3),M(4),SM(4+J),SW(4+J)) + ENDIF + ENDDO +C--Now evaluate the limit using these points + LIMIT = ZERO + DO 100 I=1,6 + IF(ABS(MX(I)).LT.EPS) GOTO 100 + LIMIT = LIMIT+HWDRM1(TEST,M12SQT(I),M13SQT(I),M23SQT(I),A,B,MX, + & M,SM,SW,INFCOL,AM,0,ND) + 100 CONTINUE + LIMIT = TWO*LIMIT +C--Now evaluate at a random point + MTRY = 0 + 25 MTRY = MTRY+1 + LTRY = 0 + 35 LTRY = LTRY+1 + CALL HWDTHR(PHEP(1,LHEP),PHEP(1,MHEP), + & PHEP(1,MHEP+1),PHEP(1,MHEP+2),HWDPWT) +C--Now calculate the m12sq etc for the actual point + M12SQ = M(1)**2+M(2)**2+2*HWULDO(PHEP(1,MHEP),PHEP(1,MHEP+1)) + M13SQ = M(1)**2+M(3)**2+2*HWULDO(PHEP(1,MHEP),PHEP(1,MHEP+2)) + M23SQ = M(2)**2+M(3)**2+2*HWULDO(PHEP(1,MHEP+1),PHEP(1,MHEP+2)) +C--Now calulate the matrix element + TEST(4) = HWDRM1(TEST,M12SQ,M13SQ,M23SQ,A,B,MX, + & M,SM,SW,INFCOL,AM,1,ND) +C--Now test the value againest the limit + RAND = HWR()*LIMIT + IF(TEST(4).GT.LIMIT) THEN + LIMIT = 1.1D0*TEST(4) + CALL HWWARN('HWDRME',51,*150) + ENDIF + 150 IF(TEST(4).LT.RAND.AND.LTRY.LT.NETRY) THEN + GOTO 35 + ELSEIF(LTRY.GE.NETRY) THEN + IF(MTRY.LE.NETRY) THEN + LIMIT = LIMIT*0.9D0 + CALL HWWARN('HWDRME',52,*25) + ELSE + CALL HWWARN('HWDRME',100,*999) + ENDIF + ENDIF +C--Reorder the particles in gluino decay to get angular ordering right + IF(IG.EQ.449.AND.ID(1).LE.12.AND.ID(2).LE.12.AND.ID(3).LE.12) THEN + DO LTRY=1,3 + IF(TEST(LTRY).GT.RAND) THEN + IF(LTRY.EQ.2) THEN + IDHWTP = IDHW(MHEP) + IDHW(MHEP) = IDHW(MHEP+1) + IDHW(MHEP+1) = IDHWTP + IDHPTP = IDHEP(MHEP) + IDHEP(MHEP) = IDHEP(MHEP+1) + IDHEP(MHEP+1) = IDHPTP + CALL HWVEQU(5,PHEP(1,MHEP),DECMOM) + CALL HWVEQU(5,PHEP(1,MHEP+1),PHEP(1,MHEP)) + CALL HWVEQU(5,DECMOM,PHEP(1,MHEP+1)) + ELSEIF(LTRY.EQ.3) THEN + IDHWTP = IDHW(MHEP) + IDHW(MHEP) = IDHW(MHEP+2) + IDHW(MHEP+2) = IDHWTP + IDHPTP = IDHEP(MHEP) + IDHEP(MHEP) = IDHEP(MHEP+2) + IDHEP(MHEP+2) = IDHPTP + DO I=1,5 + CALL HWVEQU(5,PHEP(1,MHEP),DECMOM) + CALL HWVEQU(5,PHEP(1,MHEP+2),PHEP(1,MHEP)) + CALL HWVEQU(5,DECMOM,PHEP(1,MHEP+2)) + ENDDO + ENDIF + GOTO 52 + ENDIF + RAND=RAND-TEST(LTRY) + ENDDO + ENDIF + 52 CONTINUE + 999 END +CDECK ID>, HWDRM1. +*CMZ :- -20/07/99 10:56:12 by Peter Richardson +*-- Author : Peter Richardson +C----------------------------------------------------------------------- + FUNCTION HWDRM1(TEST,M12SQ,M13SQ,M23SQ,A,B,MX,M,SM,SW + & ,INFCOL,AM,LM,ND) +C----------------------------------------------------------------------- +C FUNCTION TO GIVE THE R-PARITY VIOLATING MATRIX ELEMENT AT A GIVEN +C PHASE-SPACE POINT +C----------------------------------------------------------------------- + IMPLICIT NONE + DOUBLE PRECISION M12SQ,M13SQ,M23SQ,MX(6),A(6),B(6),SM(6),SW(6), + & INFCOL,AM,TERM(21),TEST(4),PLN,NPLN,ZERO, + & M(4),HWDRM1,HWDRM2,HWDRM3,HWDRM4 + PARAMETER (ZERO=0) + EXTERNAL HWDRM2,HWDRM3,HWDRM4 + INTEGER LM,K,ND +C--Zero the array + DO K=1,21 + TERM(K) = 0.0D0 + ENDDO + HWDRM1 = 0.0D0 +C--The amplitude + IF(ABS(MX(1)).GT.ZERO.AND.ND.NE.1) THEN + TERM(1) = MX(1)**2*HWDRM2(M23SQ,M(2),M(3),M(1),M(4),SM(1), + & SW(1),A(1),B(1)) + IF(ABS(MX(2)).GT.ZERO) TERM(7)= MX(1)*MX(2)*HWDRM3(M23SQ,M(2), + & M(3),M(1),M(4),SM(1),SM(2),SW(1),SW(2),A(1),A(2),B(1),B(2)) + IF(ABS(MX(3)).GT.ZERO) TERM(10)=-MX(1)*MX(3)*HWDRM4(M13SQ,M23SQ, + & M(1),M(3),M(2),M(4),SM(3),SM(1),SW(3),SW(1),A(1),A(3),B(1),B(3)) + IF(ABS(MX(4)).GT.ZERO) TERM(11)=-MX(1)*MX(4)*HWDRM4(M13SQ,M23SQ, + & M(1),M(3),M(2),M(4),SM(4),SM(1),SW(4),SW(1),A(1),A(4),B(1),B(4)) + IF(ABS(MX(5)).GT.ZERO) TERM(12)=-MX(1)*MX(5)*HWDRM4(M23SQ,M12SQ, + & M(3),M(2),M(1),M(4),SM(1),SM(5),SW(1),SW(5),A(5),A(1),B(5),B(1)) + IF(ABS(MX(6)).GT.ZERO) TERM(13)=-MX(1)*MX(6)*HWDRM4(M23SQ,M12SQ, + & M(3),M(2),M(1),M(4),SM(1),SM(6),SW(1),SW(6),A(6),A(1),B(6),B(1)) + ENDIF + IF(ABS(MX(2)).GT.ZERO.AND.ND.NE.1) THEN + TERM(2) = MX(2)**2*HWDRM2(M23SQ,M(2),M(3),M(1),M(4),SM(2), + & SW(2),A(2),B(2)) + IF(ABS(MX(3)).GT.ZERO) TERM(14)=-MX(2)*MX(3)*HWDRM4(M13SQ,M23SQ, + & M(1),M(3),M(2),M(4),SM(3),SM(2),SW(3),SW(2),A(2),A(3),B(2),B(3)) + IF(ABS(MX(4)).GT.ZERO) TERM(15)=-MX(2)*MX(4)*HWDRM4(M13SQ,M23SQ, + & M(1),M(3),M(2),M(4),SM(4),SM(2),SW(4),SW(2),A(2),A(4),B(2),B(4)) + IF(ABS(MX(5)).GT.ZERO) TERM(16)=-MX(2)*MX(5)*HWDRM4(M23SQ,M12SQ, + & M(3),M(2),M(1),M(4),SM(2),SM(5),SW(2),SW(5),A(5),A(2),B(5),B(2)) + IF(ABS(MX(6)).GT.ZERO) TERM(17)=-MX(2)*MX(6)*HWDRM4(M23SQ,M12SQ, + & M(3),M(2),M(1),M(4),SM(2),SM(6),SW(2),SW(6),A(6),A(2),B(6),B(2)) + ENDIF + IF(ABS(MX(3)).GT.ZERO.AND.ND.NE.1) THEN + TERM(3) = MX(3)**2*HWDRM2(M13SQ,M(1),M(3),M(2),M(4),SM(3), + & SW(3),A(3),B(3)) + IF(ABS(MX(4)).GT.ZERO) TERM(8)= MX(3)*MX(4)*HWDRM3(M13SQ,M(1), + & M(3),M(2),M(4),SM(3),SM(4),SW(3),SW(4),A(3),A(4),B(3),B(4)) + IF(ABS(MX(5)).GT.ZERO) TERM(18)=-MX(3)*MX(5)*HWDRM4(M12SQ,M13SQ, + & M(2),M(1),M(3),M(4),SM(5),SM(3),SW(5),SW(3),A(3),A(5),B(3),B(5)) + IF(ABS(MX(6)).GT.ZERO) TERM(19)=-MX(3)*MX(6)*HWDRM4(M12SQ,M13SQ, + & M(2),M(1),M(3),M(4),SM(6),SM(3),SW(6),SW(3),A(3),A(6),B(3),B(6)) + ENDIF + IF(ABS(MX(4)).GT.ZERO.AND.ND.NE.1) THEN + TERM(4) = MX(4)**2*HWDRM2(M13SQ,M(1),M(3),M(2),M(4),SM(4), + & SW(4),A(4),B(4)) + IF(ABS(MX(5)).GT.ZERO) TERM(20)=-MX(4)*MX(5)*HWDRM4(M12SQ,M13SQ, + & M(2),M(1),M(3),M(4),SM(5),SM(4),SW(5),SW(4),A(4),A(5),B(4),B(5)) + IF(ABS(MX(6)).GT.ZERO) TERM(21)=-MX(4)*MX(6)*HWDRM4(M12SQ,M13SQ, + & M(2),M(1),M(3),M(4),SM(6),SM(4),SW(6),SW(4),A(4),A(6),B(4),B(6)) + ENDIF + IF(ABS(MX(5)).GT.ZERO.AND.ND.NE.2) THEN + TERM(5) = MX(5)**2*HWDRM2(M12SQ,M(1),M(2),M(3),M(4),SM(5), + & SW(5),A(5),B(5)) + IF(ABS(MX(6)).GT.ZERO) TERM(9)= MX(5)*MX(6)*HWDRM3(M12SQ,M(1), + & M(2),M(3),M(4),SM(5),SM(6),SW(5),SW(6),A(5),A(6),B(5),B(6)) + ENDIF + IF(ABS(MX(6)).GT.ZERO.AND.ND.NE.2) TERM(6) = MX(6)**2* + & HWDRM2(M12SQ,M(1),M(2),M(3),M(4),SM(6),SW(6),A(6),B(6)) + DO K=10,21 + TERM(K)=TERM(K)*INFCOL + ENDDO +C--Add them up + DO K=1,21 + HWDRM1 = HWDRM1+TERM(K) + ENDDO +C--Different colour flows for the gluino + IF(LM.NE.0) THEN + NPLN = 0.0D0 + PLN = 0.0D0 + DO K=1,9 + PLN = PLN+TERM(K) + ENDDO + DO K=10,21 + NPLN= NPLN+TERM(K) + ENDDO + DO K=1,3 + TEST(K) = (TERM(2*K-1)+TERM(2*K)+TERM(6+K))*(1+NPLN/PLN) + ENDDO + ELSE + DO K=1,3 + TEST(K) = 0.0D0 + ENDDO + ENDIF + IF(TEST(4).LT.ZERO) CALL HWWARN('HWDRM1',50,*999) + 999 END +CDECK ID>, HWDRM2. +*CMZ :- -20/07/99 10:56:12 by Peter Richardson +*-- Author : Peter Richardson +C----------------------------------------------------------------------- + FUNCTION HWDRM2(X,MA,MB,MC,MD,MR1,GAM1,A,B) +C----------------------------------------------------------------------- +C Function to compute the matrix element squared part of a 3-body +C R-parity decay +C----------------------------------------------------------------------- + IMPLICIT NONE + DOUBLE PRECISION X,MA,MB,MC,MD,A,B,HWDRM2,MR1,GAM1 + HWDRM2 = (X - MA**2 - MB**2)*(4*A*B*MC*MD + + & (A**2 + B**2)*(-X + MC**2 + MD**2))/ + & ((X-MR1**2)**2+GAM1**2*MR1**2) + END +CDECK ID>, HWDRM3. +*CMZ :- -20/07/99 10:56:12 by Peter Richardson +*-- Author : Peter Richardson +C----------------------------------------------------------------------- + FUNCTION HWDRM3(X,MA,MB,MC,MD,MR1,MR2,GAM1,GAM2,A1,A2,B1,B2) +C----------------------------------------------------------------------- +C Function to compute the light/heavy interference part of a 3-body +C R-parity decay +C----------------------------------------------------------------------- + IMPLICIT NONE + DOUBLE PRECISION X,MA,MB,MC,MD,A1,A2,B1,B2,HWDRM3,MR1,MR2,GAM1 + & ,GAM2 +C + HWDRM3 = 2*(X - MA**2 - MB**2)*(2*(A2*B1 + A1*B2)*MC*MD + + & (A1*A2 + B1*B2)*(-X + MC**2 + MD**2))* + & (GAM1*GAM2*MR1*MR2 + (X - MR1**2)*(X - MR2**2))/ + & (((X-MR1**2)**2+GAM1**2*MR1**2)*((X-MR2**2)**2+GAM2**2*MR2**2)) + END +CDECK ID>, HWDRM4. +*CMZ :- -20/07/99 10:56:12 by Peter Richardson +*-- Author : Peter Richardson +C----------------------------------------------------------------------- + FUNCTION HWDRM4(X,Y,MA,MB,MC,MD,MR1,MR2,GAM1,GAM2,A1,A2,B1,B2) +C----------------------------------------------------------------------- +C Function to compute the interference part of a 3-body +C R-parity decay +C----------------------------------------------------------------------- + IMPLICIT NONE + DOUBLE PRECISION X,Y,MA,MB,MC,MD,A1,A2,B1,B2,HWDRM4,MR1,MR2,GAM1 + & ,GAM2 +C + HWDRM4 = 2*((GAM1*GAM2*MR1*MR2 + (X - MR1**2)*(Y - MR2**2))* + & (A2*B1*MC*MD*(X - MA**2 - MB**2) + + & A1*A2*MA*MC*(X + Y - MA**2 - MC**2) + + & A1*B2*MA*MD*(Y - MB**2 - MC**2) + + & B1*B2*(X*Y - MA**2*MC**2 - MB**2*MD**2)))/ + & (((X-MR1**2)**2+GAM1**2*MR1**2)*((Y-MR2**2)**2+GAM2**2*MR2**2)) + END +CDECK ID>, HWDRM5. +*CMZ :- -20/07/99 10:56:12 by Peter Richardson +*-- Author : Peter Richardson +C----------------------------------------------------------------------- + SUBROUTINE HWDRM5(X,Y,Z,A,B,MA,MB,MC,MD,MR,GAM) +C----------------------------------------------------------------------- +C Subroutine to find the maximum of the ME +C----------------------------------------------------------------------- + IMPLICIT NONE + DOUBLE PRECISION X,Y,Z,MA,MB,MC,MD,MR,GAM,RES(3),A,B,C,D, + & E2S,E3S,E2M,E3M,LOW,UPP,HWRUNI,EPS,ZERO + EXTERNAL HWRUNI + PARAMETER(EPS=1D-9,ZERO=0) + C = A**2+B**2 + D = 4*A*B + RES(1) = -D*(MA**2 + MB**2)*MC*MD + + & C*(GAM**2*MR**2 + MR**4 - MA**2*MC**2 - MB**2*MC**2 - + & MA**2*MD**2 - MB**2*MD**2) + RES(2) = (GAM**2*MR**2 + (-MR**2 + MA**2 + MB**2)**2)* + & (D**2*MC**2*MD**2 + + & 2*C*D*MC*MD*(-MR**2 + MC**2 + MD**2) + + & C**2*(GAM**2*MR**2 + (-MR**2 + MC**2 + MD**2)**2)) + RES(3) = -D*MC*MD+C*(2*MR**2-(MA**2+MB**2+MC**2+MD**2)) + IF(RES(2).GT.ZERO) THEN + RES(2) = SQRT(RES(2)) + ELSE + RES(2) = 0.0D0 + ENDIF + IF((RES(1)+RES(2))/RES(3).GT.(MD-MC)**2.OR. + & (RES(1)+RES(2))/RES(3).LT.(MA+MB)**2) THEN + X = (RES(1)-RES(2))/RES(3) + ELSE + X = (RES(1)+RES(2))/RES(3) + ENDIF + IF(X.GT.(MD-MC)**2) X = (MD-MC)**2 + IF(X.LT.(MA+MB)**2) X = (MA+MB)**2 + E2S = (X-MA**2+MB**2)/(2*SQRT(X)) + E3S = (MD**2-X-MC**2)/(2*SQRT(X)) + E2M = E2S**2-MB**2 + E3M = E3S**2-MC**2 + IF(E2M.LT.ZERO) THEN + IF(ABS(E2M/E2S).GT.EPS) CALL HWWARN('HWDRM5',2,*10) + 10 E2M= 0.0D0 + ENDIF + IF(E3M.LT.ZERO) THEN + IF(ABS(E3M/E3S).GT.EPS) CALL HWWARN('HWDRM5',3,*20) + 20 E3M= 0.0D0 + ENDIF + E2M = SQRT(E2M) + E3M = SQRT(E3M) + LOW = (E2S+E3S)**2-(E2M+E3M)**2 + UPP = (E2S+E3S)**2-(E2M-E3M)**2 + Y = HWRUNI(1,LOW,UPP) + Z = MA**2+MB**2+MC**2+MD**2-X-Y + END +CDECK ID>, HWDPWT. +*CMZ :- -26/04/91 11.11.55 by Bryan Webber +*-- Author : Bryan Webber +C----------------------------------------------------------------------- + FUNCTION HWDPWT(EMSQ,A,B,C) +C----------------------------------------------------------------------- +C MATRIX ELEMENT SQUARED FOR PHASE SPACE DECAY +C----------------------------------------------------------------------- + DOUBLE PRECISION HWDPWT,EMSQ,A,B,C + HWDPWT=1. + END +CDECK ID>, HWDTHR. +*CMZ :- -26/04/91 14.55.44 by Federico Carminati +*-- Author : Bryan Webber +C----------------------------------------------------------------------- + SUBROUTINE HWDTHR(P0,P1,P2,P3,WEIGHT) +C----------------------------------------------------------------------- +C GENERATES THREE-BODY DECAY 0->1+2+3 DISTRIBUTED +C ACCORDING TO PHASE SPACE * WEIGHT +C----------------------------------------------------------------------- + DOUBLE PRECISION HWR,HWRUNI,A,B,C,D,AA,BB,CC,DD,EE,FF,PP,QQ,WW, + & RR,PCM1,PC23,WEIGHT,P0(5),P1(5),P2(5),P3(5),P23(5),TWO + EXTERNAL HWR,HWRUNI,WEIGHT + PARAMETER (TWO=2.D0) + A=P0(5)+P1(5) + B=P0(5)-P1(5) + C=P2(5)+P3(5) + IF (B.LT.C) CALL HWWARN('HWDTHR',100,*999) + D=ABS(P2(5)-P3(5)) + AA=A*A + BB=B*B + CC=C*C + DD=D*D + EE=(B-C)*(A-D) + A=0.5*(AA+BB) + B=0.5*(CC+DD) + C=4./(A-B)**2 +C +C CHOOSE MASS OF SUBSYSTEM 23 WITH PRESCRIBED DISTRIBUTION +C + 10 FF=HWRUNI(0,BB,CC) + PP=(AA-FF)*(BB-FF) + QQ=(CC-FF)*(DD-FF) + WW=WEIGHT(FF,A,B,C)**2 + RR=EE*FF*HWR() + IF (PP*QQ*WW.LT.RR*RR) GOTO 10 +C +C FF IS MASS SQUARED OF SUBSYSTEM 23. +C +C DO 2-BODY DECAYS 0->1+23, 23->2+3 +C + P23(5)=SQRT(FF) + PCM1=SQRT(PP)*0.5/P0(5) + PC23=SQRT(QQ)*0.5/P23(5) + CALL HWDTWO(P0,P1,P23,PCM1,TWO,.TRUE.) + CALL HWDTWO(P23,P2,P3,PC23,TWO,.TRUE.) + 999 END +CDECK ID>, HWDTOP. +*CMZ :- -09/12/92 11.03.46 by Bryan Webber +*-- Author : Bryan Webber +C----------------------------------------------------------------------- + SUBROUTINE HWDTOP(DECAY) +C----------------------------------------------------------------------- +C DECIDES WHETHER TO DO TOP QUARK DECAY BEFORE HADRONIZATION +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + LOGICAL DECAY + DECAY=RMASS(6).GT.130D0 + END +CDECK ID>, HWDTWO. +*CMZ :- -27/01/94 17.38.49 by Mike Seymour +*-- Author : Bryan Webber & Mike Seymour +C----------------------------------------------------------------------- + SUBROUTINE HWDTWO(P0,P1,P2,PCM,COSTH,ZAXIS) +C----------------------------------------------------------------------- +C GENERATES DECAY 0 -> 1+2 +C +C PCM IS CM MOMENTUM +C +C COSTH = COS THETA IN P0 REST FRAME (>1 FOR ISOTROPIC) +C IF ZAXIS=.TRUE., COS THETA IS MEASURED FROM THE ZAXIS +C IF .FALSE., IT IS MEASURED FROM P0'S DIRECTION +C----------------------------------------------------------------------- + DOUBLE PRECISION HWRUNI,ONE,ZERO,PCM,COSTH,C,S,P0(5),P1(5),P2(5), + & PP(5),R(9) + LOGICAL ZAXIS + EXTERNAL HWRUNI + PARAMETER (ZERO=0.D0, ONE=1.D0) +C--CHOOSE C.M. ANGLES + C=COSTH + IF (C.GT.ONE) C=HWRUNI(0,-ONE,ONE) + S=SQRT(ONE-C*C) + CALL HWRAZM(PCM*S,PP(1),PP(2)) +C--PP IS MOMENTUM OF 2 IN C.M. + PP(3)=-PCM*C + PP(4)=SQRT(P2(5)**2+PCM**2) + PP(5)=P2(5) +C--ROTATE IF NECESSARY + IF (COSTH.LE.ONE.AND..NOT.ZAXIS) THEN + CALL HWUROT(P0,ONE,ZERO,R) + CALL HWUROB(R,PP,PP) + ENDIF +C--BOOST FROM C.M. TO LAB FRAME + CALL HWULOB(P0,PP,P2) + CALL HWVDIF(4,P0,P2,P1) + END +CDECK ID>, HWDWWT. +*CMZ :- -26/04/91 11.11.55 by Bryan Webber +*-- Author : Bryan Webber +C----------------------------------------------------------------------- + FUNCTION HWDWWT(EMSQ,A,B,C) +C----------------------------------------------------------------------- +C MATRIX ELEMENT SQUARED FOR V-A WEAK DECAY +C----------------------------------------------------------------------- + DOUBLE PRECISION HWDWWT,EMSQ,A,B,C + HWDWWT=(A-EMSQ)*(EMSQ-B)*C + END +CDECK ID>, HWDXLM. +*CMZ :- -27/07/99 13.33.03 by Mike Seymour +*-- Author : Ian Knowles +C----------------------------------------------------------------------- + SUBROUTINE HWDXLM(DKVRTX,STAB) +C----------------------------------------------------------------------- +C Sets STAB=.TRUE. if DKVRTX lies outside the specified region. +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + DOUBLE PRECISION DKVRTX(4),RCYL,RSPH,ZMAX,R,S + LOGICAL STAB + PARAMETER (RCYL=20,RSPH=100,ZMAX=500) + STAB=.FALSE. + IF (IOPDKL.EQ.1) THEN +C Cylinderical geometry + S=SQRT(DKVRTX(1)**2+DKVRTX(2)**2) + IF (S.GE.RCYL.OR.ABS(DKVRTX(3)).GE.ZMAX) STAB=.TRUE. + ELSEIF (IOPDKL.EQ.2) THEN +C Spherical geometry + R=SQRT(DKVRTX(1)**2+DKVRTX(2)**2+DKVRTX(3)**2) + IF (R.GE.RSPH) STAB=.TRUE. + ELSE +C User supplied geometry + ENDIF + RETURN + 999 END +CDECK ID>, HWEFIN. +*CMZ :- -26/04/91 11.11.55 by Bryan Webber +*-- Author : Bryan Webber +C----------------------------------------------------------------------- + SUBROUTINE HWEFIN +C----------------------------------------------------------------------- +C TERMINAL CALCULATIONS ON ELEMENTARY PROCESS +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + DOUBLE PRECISION RNWGT,SPWGT,ERWGT + WRITE (6,1) + 1 FORMAT(/10X,'OUTPUT ON ELEMENTARY PROCESS'/) + IF (NWGTS.EQ.0) THEN + WRITE (6,10) + 10 FORMAT(10X,'NO WEIGHTS GENERATED') + ELSE + RNWGT=1./FLOAT(NWGTS) + AVWGT=WGTSUM*RNWGT + SPWGT=SQRT(MAX(WSQSUM*RNWGT-AVWGT**2,ZERO)) + ERWGT=SPWGT*SQRT(RNWGT) + IF (.NOT.NOWGT) WGTMAX=AVWGT + IF (WGTMAX.EQ.ZERO) WGTMAX=ONE + WRITE (6,11) NEVHEP,NWGTS,AVWGT,SPWGT,WBIGST,WGTMAX,IPROC, + & 1000.*AVWGT,1000.*ERWGT,100.*AVWGT/WGTMAX + 11 FORMAT(1P, + & 10X,'NUMBER OF EVENTS = ',I11/ + & 10X,'NUMBER OF WEIGHTS = ',I11/ + & 10X,'MEAN VALUE OF WGT =',E12.4/ + & 10X,'RMS SPREAD IN WGT =',E12.4/ + & 10X,'ACTUAL MAX WEIGHT =',E12.4/ + & 10X,'ASSUMED MAX WEIGHT =',E12.4// + & 10X,'PROCESS CODE IPROC = ',I11/ + & 10X,'CROSS SECTION (PB) =',G12.4/ + & 10X,'ERROR IN C-S (PB) =',G12.4/ + & 10X,'EFFICIENCY PERCENT =',G12.4) + ENDIF + END +CDECK ID>, HWEGAM. +*CMZ :- -26/04/91 11.11.55 by Bryan Webber +*-- Author : Bryan Webber & Luca Stanco +C----------------------------------------------------------------------- + SUBROUTINE HWEGAM(IHEP,ZMI,ZMA,WWA) +C----------------------------------------------------------------------- +C GENERATES A PHOTON IN WEIZSACKER-WILLIAMS (WWA=.TRUE.) OR +C ELSE EQUIVALENT PHOTON APPROX FROM INCOMING E+, E-, MU+ OR MU- +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + DOUBLE PRECISION HWR,HWRUNI,EGMIN,ZMIN,ZMAX,ZGAM,SS,ZMI,ZMA, + & PPL,PMI,QT2,Q2,QQMIN,QQMAX,S0,A,RPM(2) + INTEGER IHEP,IHADIS,HQ,I + LOGICAL WWA + EXTERNAL HWR,HWRUNI + DATA EGMIN/5.D0/ + IF (IERROR.NE.0) RETURN + IF (IHEP.LT.1.OR.IHEP.GT.2) CALL HWWARN('HWEGAM',500,*999) + SS=PHEP(5,3) + IF (IHEP.EQ.1) THEN + IHADIS=2 + ELSE + IHADIS=1 + IF (JDAHEP(1,IHADIS).NE.0) IHADIS=JDAHEP(1,IHADIS) + ENDIF +C---DEFINE LIMITS FOR GAMMA MOMENTUM FRACTION + IF (ZMI.LE.ZERO .OR. ZMA.GT.ONE) THEN + IF (IPRO.EQ.13.OR.IPRO.EQ.14) THEN + S0 = EMMIN**2 + ELSEIF(IPRO.EQ.15.OR.IPRO.EQ.18.OR.IPRO.EQ.22.OR.IPRO.EQ.24.OR. + & IPRO.EQ.50.OR.IPRO.EQ.53.OR.IPRO.EQ.55)THEN + S0 = 4.D0*PTMIN**2 + ELSEIF (IPRO.EQ.17.OR.IPRO.EQ.51) THEN + HQ = MOD(IPROC,100) + S0 = 4.D0*(PTMIN**2+RMASS(HQ)**2) + ELSEIF (IPRO.EQ.16.OR.IPRO.EQ.19.OR.IPRO.EQ.95) THEN + S0 = MAX(2*RMASS(1),RMASS(201)-GAMMAX*GAMH)**2 + ELSEIF (IPRO.EQ.23) THEN + S0 = MAX(2*RMASS(1),RMASS(201)-GAMMAX*GAMH)**2 + S0 = (PTMIN+SQRT(PTMIN**2+S0))**2 + ELSEIF (IPRO.EQ.20) THEN + S0 = RMASS(201)**2 + ELSEIF (IPRO.EQ.21) THEN + S0 = (PTMIN+SQRT(PTMIN**2+RMASS(198)**2))**2 +C--PR MOD 7/7/99 + ELSEIF(IPRO.EQ.30) THEN + S0 = 4.0D0*(PTMIN**2+RMMNSS**2) + ELSEIF(IPRO.EQ.40.OR.IPRO.EQ.41) THEN + HQ = IPROC-100*IPRO + RPM(1) = RMMNSS + RPM(2) = ZERO + IF(HQ.GE.10.AND.HQ.LT.20) THEN + RPM(1) = ABS(RMASS(450)) + IF(HQ.GT.10) RPM(1) = ABS(RMASS(449+MOD(HQ,10))) + ELSEIF(HQ.GE.20.AND.HQ.LT.30) THEN + RPM(1) = ABS(RMASS(454)) + IF(HQ.GT.20) RPM(1) = ABS(RMASS(453+MOD(HQ,20))) + ELSEIF(HQ.EQ.30) THEN + RPM(1) = RMASS(449) + ELSEIF(HQ.EQ.40) THEN + IF(IPRO.EQ.40) THEN + RPM(1) = RMASS(425) + DO I=1,5 + RPM(1) = MIN(RPM(1),RMASS(425+I)) + ENDDO + ELSE + RPM(1) = MIN(RMASS(405),RMASS(406)) + ENDIF + RPM(2) = RMASS(198) + ELSEIF(HQ.EQ.50) THEN + IF(IPRO.EQ.40) THEN + RPM(1) = RMASS(425) + DO I=1,5 + RPM(1) = MIN(RPM(1),RMASS(425+I)) + ENDDO + DO I=1,3 + RPM(2) = MIN(RPM(1),RMASS(433+2*I)) + ENDDO + RPM(1) = MIN(RPM(1),RPM(2)) + RPM(2) = RMASS(203) + DO I=1,2 + RPM(2) = MIN(RPM(2),RMASS(204+I)) + ENDDO + ELSE + RPM(1) = RMASS(401) + RPM(2) = RMASS(413) + DO I=1,5 + RPM(1) = MIN(RPM(1),RMASS(401+I)) + RPM(2) = MIN(RPM(2),RMASS(413+I)) + ENDDO + RPM(1) = MIN(RPM(1),RPM(2)) + RPM(2) = RMASS(203) + DO I=1,2 + RPM(2) = MIN(RPM(2),RMASS(204+I)) + ENDDO + ENDIF + RPM(2) = RMASS(203) + DO I=1,2 + RPM(2) = MIN(RPM(2),RMASS(204+I)) + ENDDO + ELSEIF(HQ.GE.60) THEN + RPM(1) = ZERO + ENDIF + RPM(1) = RPM(1)**2 + RPM(2) = RPM(2)**2 + S0 = RPM(1)+RPM(2)+TWO*(PTMIN**2+ + & SQRT(RPM(1)*RPM(2)+PTMIN**2*(RPM(1)+RPM(2)+PTMIN**2))) +C--end of mod + ELSEIF (IPRO.EQ.52) THEN + HQ = MOD(IPROC,100) + S0 = (PTMIN+SQRT(PTMIN**2+RMASS(HQ)**2))**2 + ELSEIF (IPRO.EQ.60) THEN + HQ = MOD(IPROC,100) + IF (HQ.EQ.0) THEN + S0 = 4.D0*PTMIN**2 + ELSE + IF (HQ.GT.6) HQ=2*HQ+107 + IF (HQ.EQ.127) HQ=198 + S0 = 4.D0*(PTMIN**2+RMASS(HQ)**2) + ENDIF + ELSEIF (IPRO.EQ.80) THEN + S0 = WHMIN**2 + ELSEIF (IPRO.EQ.90) THEN + S0 = Q2MIN + ELSEIF (IPRO.EQ.91.OR.IPRO.EQ.92) THEN + S0 = Q2MIN+4.D0*PTMIN**2 + HQ = MOD(IPROC,100) + IF (HQ.GT.0) S0 = S0+4.D0*RMASS(HQ)**2 + IF (IPRO.EQ.91) S0 = MAX(S0,EMMIN**2) + ELSE + S0 = 0 + ENDIF + IF (S0.GT.ZERO) THEN + S0 = (SQRT(S0)+ABS(PHEP(5,IHADIS)))**2-PHEP(5,IHADIS)**2 + S0 = MAX(S0,WHMIN**2) + ZMIN = S0 / (SS**2 - PHEP(5,IHEP)**2 - PHEP(5,IHADIS)**2) + ZMAX = ONE + ELSE +C---UNKNOWN PROCESS: USE ENERGY CUTOFF, AND WARN USER + IF (FSTWGT) CALL HWWARN('HWEGAM',1,*999) + ZMIN = EGMIN / PHEP(4,IHEP) + ZMAX = ONE + ENDIF + ELSE + ZMIN=ZMI + ZMAX=ZMA + ENDIF +C---APPLY USER DEFINED CUTS YWWMIN,YWWMAX AND INDIRECT LIMITS ON Z + IF (.NOT.WWA) THEN + ZMIN=MAX(ZMIN,YWWMIN,SQRT(Q2WWMN)/ABS(PHEP(3,IHEP))) + ZMAX=MIN(ZMAX,YWWMAX) + IF (ZMIN.GT.ZMAX) THEN + GAMWT=ZERO + RETURN + ENDIF + ENDIF +C---GENERATE GAMMA MOMENTUM FRACTION + A=HALF + 10 IF (HWR().LT.A) THEN + ZGAM=(ZMIN/ZMAX)**HWR()*ZMAX + ELSE + ZGAM=(ZMAX-ZMIN)*HWR()+ZMIN + ENDIF + GAMWT = GAMWT * .5*ALPHEM/PIFAC * + + (1+(1-ZGAM)**2)/(A/LOG(ZMAX/ZMIN)+(1-A)/(ZMAX-ZMIN)*ZGAM) + IF (WWA) THEN + GAMWT = GAMWT * LOG((ONE-ZGAM)/ZGAM*(SS/PHEP(5,IHEP))**2) + ELSE +C---Q2WWMN AND Q2WWMX ARE USER-DEFINED LIMITS IN THE Q**2 INTEGRATION + QQMAX=MIN(Q2WWMX,(ZGAM*PHEP(3,IHEP))**2) + QQMIN=MAX(Q2WWMN,(PHEP(5,IHEP)*ZGAM)**2/(1.-ZGAM)) + IF (QQMIN.GT.QQMAX) CALL HWWARN('HWEGAM',50,*10) + Q2=EXP(HWRUNI(0,LOG(QQMIN),LOG(QQMAX))) + GAMWT = GAMWT * LOG(QQMAX/QQMIN) + ENDIF + IF (GAMWT.LT.ZERO) GAMWT=ZERO +C---FILL PHOTON + NHEP=NHEP+1 + IDHW(NHEP)=59 + ISTHEP(NHEP)=3 + IDHEP(NHEP)=22 + JMOHEP(1,NHEP)=IHEP + JMOHEP(2,NHEP)=0 + JDAHEP(1,NHEP)=0 + JDAHEP(2,NHEP)=0 + JDAHEP(1,IHEP)=NHEP + IF (WWA) THEN +C---FOR COLLINEAR KINEMATICS, ZGAM IS THE ENERGY FRACTION + PHEP(4,NHEP)=PHEP(4,IHEP)*ZGAM + PHEP(3,NHEP)=PHEP(3,IHEP)-SIGN(SQRT( + & (PHEP(4,IHEP)-PHEP(4,NHEP))**2-PHEP(5,IHEP)**2),PHEP(3,IHEP)) + PHEP(2,NHEP)=0 + PHEP(1,NHEP)=0 + CALL HWUMAS(PHEP(1,NHEP)) + ELSE +C---FOR EXACT KINEMATICS, ZGAM IS TAKEN TO BE FRACTION OF (E+PZ) + PPL=ZGAM*(ABS(PHEP(3,IHEP))+PHEP(4,IHEP)) + QT2=(ONE-ZGAM)*Q2-(ZGAM*PHEP(5,IHEP))**2 + PMI=(QT2-Q2)/PPL + PHEP(5,NHEP)=-SQRT(Q2) + PHEP(4,NHEP)=(PPL+PMI)/TWO + PHEP(3,NHEP)=SIGN((PPL-PMI)/TWO,PHEP(3,IHEP)) + CALL HWRAZM(SQRT(QT2),PHEP(1,NHEP),PHEP(2,NHEP)) + ENDIF +C---UPDATE OVERALL CM FRAME + JMOHEP(IHEP,3)=NHEP + CALL HWVDIF(4,PHEP(1,3),PHEP(1,IHEP),PHEP(1,3)) + CALL HWVSUM(4,PHEP(1,NHEP),PHEP(1,3),PHEP(1,3)) + CALL HWUMAS(PHEP(1,3)) +C---FILL OUTGOING LEPTON + NHEP=NHEP+1 + IDHW(NHEP)=IDHW(IHEP) + ISTHEP(NHEP)=1 + IDHEP(NHEP)=IDHEP(IHEP) + JMOHEP(1,NHEP)=IHEP + JMOHEP(2,NHEP)=0 + JDAHEP(1,NHEP)=0 + JDAHEP(2,NHEP)=0 + JDAHEP(2,IHEP)=NHEP + CALL HWVDIF(4,PHEP(1,IHEP),PHEP(1,NHEP-1),PHEP(1,NHEP)) + PHEP(5,NHEP)=PHEP(5,IHEP) + 999 END +CDECK ID>, HWEINI. +*CMZ :- -26/04/91 12.42.30 by Federico Carminati +*-- Author : Bryan Webber +C----------------------------------------------------------------------- + SUBROUTINE HWEINI +C----------------------------------------------------------------------- +C INITIALISES ELEMENTARY PROCESS +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + DOUBLE PRECISION HWRSET,DUMMY,SAFETY + EXTERNAL HWRSET + PARAMETER (SAFETY=1.001) + INTEGER NBSH,I +C---NO OF WEIGHT GENERATED + NWGTS=0 +C---ACCUMULATED WEIGHTS + WGTSUM=0. +C---ACCUMULATED WEIGHT-SQUARED + WSQSUM=0. +C---CURRENT MAX WEIGHT + WBIGST=0. +C---LAST VALUE OF SCALE + EMLST=0. +C---NUMBER OF ERRORS REPORTED + NUMER=0 +C---NUMBER OF ERRORS UNREPORTED + NUMERU=0 +C---FIND MAXIMUM EVENT WEIGHT IN CASES WHERE THIS IS REQUIRED + IF (NOWGT) THEN + IF (WGTMAX.EQ.ZERO) THEN + NBSH=IBSH + DUMMY = HWRSET(IBRN) + WRITE(6,10) IPROC,IBRN,NBSH + 10 FORMAT(/10X,'INITIAL SEARCH FOR MAX WEIGHT'// + & 10X,'PROCESS CODE IPROC = ',I11/ + & 10X,'RANDOM NO. SEED 1 = ',I11/ + & 10X,' SEED 2 = ',I11/ + & 10X,'NUMBER OF SHOTS = ',I11) + NEVHEP=0 + DO 11 I=1,NBSH + CALL HWEPRO + 11 CONTINUE + WRITE(6,20) + 20 FORMAT(/10X,'INITIAL SEARCH FINISHED') + IF (WBIGST*NWGTS.LT.SAFETY*WGTSUM) + & WGTMAX=SAFETY*WBIGST + CALL HWEFIN + NWGTS=0 + WGTSUM=0. + WSQSUM=0. + WBIGST=0. + ELSE + WRITE(6,21) AVWGT,WGTMAX + 21 FORMAT(/1P,10X,'INPUT EVT WEIGHT =',E12.4/ + & 10X,'INPUT MAX WEIGHT =',E12.4) + ENDIF + ENDIF +C---RESET RANDOM NUMBER + DUMMY = HWRSET(NRN) + ISTAT=5 + 999 END +CDECK ID>, HWEISR. +*CMZ :- -01/04/99 19.55.17 by Mike Seymour +*-- Author : Mike Seymour +C----------------------------------------------------------------------- + SUBROUTINE HWEISR(IHEP) +C----------------------------------------------------------------------- +C GENERATES AN ISR PHOTON FROM INCOMING E+, E-, MU+ OR MU- +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + DOUBLE PRECISION HWR,QSQMAX,QSQMIN,A,B,B1,B2,B3,B4,B5,B6,B7,B8, + $ R,AA,T0,T1,C1,C2,T,Z(2),QSQ(2),PHI(2),C + INTEGER IHEP,I,J + EXTERNAL HWR + SAVE Z,QSQ,PHI +C---IF ZMXISR IS ZERO, THERE CAN BE NO ISR + IF (ZMXISR.EQ.ZERO .OR. (IPRO.GT.3.AND.IPRO.NE.6)) RETURN +C---CHECK CONSISTENCY OF TMNISR AND ZMXISR + IF (ZMXISR**2.LT.TMNISR) CALL HWWARN('HWEISR',200,*999) +C---CALCULATE VIRTUALITY LIMITS + QSQMAX=4*PHEP(4,IHEP)**2 + QSQMIN=PHEP(5,IHEP)**2 +C---AND THEREFORE THE Z DEPENDENCE + A=ALPHEM/PIFAC + B=A*(LOG(QSQMAX/QSQMIN)-1) +C---DECIDE HOW MUCH WEIGHT TO GIVE THE Z RESONANCE + IF (IHEP.EQ.1) THEN + IF (IPRO.EQ.1.OR.IPRO.EQ.6) THEN + AA=10 + ELSEIF (IPRO.EQ.2) THEN + AA=0 + ELSEIF (IPRO.EQ.3) THEN + AA=1 + ELSE + RETURN + ENDIF + T0=RMASS(200)**2/QSQMAX + T1=GAMZ*RMASS(200)/QSQMAX + IF (T0.GT.ONE) THEN + T0=0 + AA=0 + ENDIF + AA=AA*(1-T0) +C---GENERATE A T VALUE BETWEEN TMNISR AND 1 ACCORDING TO: +C ( b**2*log(zmxisr**2/t)/t + 2*b*(1-(1-zmxisr)**b)*((1-t)**(2*b-1)+1/t +C +(1-t0)**(2b-1)*aa*t1/((t-t0)**2+t1**2)) ) *theta(zmxisr**2-t) +C +( 2*b*(1-zmxisr)**b*((1-t)**(b-1)+1/t +C +(1-t0)**(b-1)*aa*t1/((t-t0)**2+t1**2)) ) *theta(zmxisr-t) +C +( (1-zmxisr)**(2*b) ) *delta(1-t) + B1=(1-ZMXISR)**(2*B) + B2=B1+2*(1-ZMXISR)**B*((1-TMNISR)**B-(1-ZMXISR)**B) + B3=B2+2*B*(1-ZMXISR)**B*LOG(ZMXISR/TMNISR) + B4=B3+2*B*(1-ZMXISR)**B*AA*(1-T0)**(B-1) + $ *(ATAN((ZMXISR-T0)/T1)-ATAN((TMNISR-T0)/T1)) + B5=B4+(1-(1-ZMXISR)**B)*((1-TMNISR)**(2*B)-(1-ZMXISR**2)**(2*B)) + B6=B5+2*B*(1-(1-ZMXISR)**B)*LOG(ZMXISR**2/TMNISR) + B7=B6+B**2*LOG(ZMXISR**2/TMNISR)**2/2 + B8=B7+2*B*(1-(1-ZMXISR)**B)*AA*(1-T0)**(2*B-1) + $ *(ATAN((ZMXISR**2-T0)/T1)-ATAN((TMNISR-T0)/T1)) + R=B8*HWR() + IF (R.LE.B1) THEN +C---NEITHER EMITS + T=1 + GAMWT=GAMWT*B8/B1 + Z(1)=1 + ELSEIF (R.LE.B4) THEN +C---ONE EMITS + IF (R.LE.B2) THEN + R=(R-B1)/(B2-B1) + T=1-(1-TMNISR)*(1-R*(1-((1-ZMXISR)/(1-TMNISR))**B))**(1/B) + ELSEIF (R.LE.B3) THEN + R=(R-B2)/(B3-B2) + T=(TMNISR/ZMXISR)**R*ZMXISR + ELSE + R=(R-B3)/(B4-B3) + T=T0+T1*TAN( + $ ATAN((ZMXISR-T0)/T1)*R+ATAN((TMNISR-T0)/T1)*(1-R)) + ENDIF + GAMWT=GAMWT*B8/(2*B*(1-ZMXISR)**B*((1-T)**(B-1)+1/T+ + $ (1-T0)**(B-1)*AA*T1/((T-T0)**2+T1**2))) + Z(1)=1 + IF (HWR().GT.HALF) Z(1)=T + GAMWT=GAMWT*2 + ELSE +C---BOTH EMIT + IF (R.LE.B5) THEN + R=(R-B4)/(B5-B4) + T=1-(1-TMNISR)* + $ (1-R*(1-((1-ZMXISR**2)/(1-TMNISR))**(2*B)))**(.5/B) + ELSEIF (R.LE.B6) THEN + R=(R-B5)/(B6-B5) + T=(TMNISR/ZMXISR**2)**R*ZMXISR**2 + ELSEIF (R.LE.B7) THEN + R=(R-B6)/(B7-B6) + T=(TMNISR/ZMXISR**2)**SQRT(R)*ZMXISR**2 + ELSE + R=(R-B7)/(B8-B7) + T=T0+T1*TAN( + $ ATAN((ZMXISR**2-T0)/T1)*R+ATAN((TMNISR-T0)/T1)*(1-R)) + ENDIF + GAMWT=GAMWT*B8/(B**2*LOG(ZMXISR**2/T)/T + $ + 2*B*(1-(1-ZMXISR)**B)*((1-T)**(2*B-1)+1/T+ + $ (1-T0)**(B-1)*AA*T1/((T-T0)**2+T1**2))) +C---GENERATE A Z VALUE BETWEEN T/ZMXISR AND ZMXISR ACCORDING TO: +C 1/z+(1-z)**(b-1)+t/z**2*(1-t/z)**(b-1) + C1=LOG(ZMXISR**2/T) + C2=C1+2/B*((1-T/ZMXISR)**B-(1-ZMXISR)**B) + IF (C2.GT.ZERO) THEN + R=C2*HWR() + IF (R.LE.C1) THEN + Z(1)=(T/ZMXISR**2)**HWR()*ZMXISR + ELSE + Z(1)=1-(1-T/ZMXISR)* + $ (1-HWR()*(1-((1-ZMXISR)/(1-T/ZMXISR))**B))**(1/B) + IF (2*R.LE.C2+C1) Z(1)=T/Z(1) + ENDIF + ELSE + Z(1)=SQRT(T) + ENDIF + GAMWT=GAMWT*C2/Z(1) + $ /(1/Z(1)+(1-Z(1))**(B-1)+T/Z(1)**2*(1-T/Z(1))**(B-1)) + ENDIF +C---INCLUDE DISTRIBUTION FUNCTIONS + Z(2)=T/Z(1) + DO 10 I=1,2 + IF (Z(I).GT.ZMXISR) THEN + Z(I)=1 + GAMWT=GAMWT*(1-ZMXISR)**B*EXP(3*B/4)*(1-B**2*PIFAC**2/12) + ELSE + GAMWT=GAMWT*(B*(1-Z(I))**(B-1)*(1+Z(I)**2)/2 + $ *EXP(B*Z(I)/2*(1+Z(I)/2))*(1-B**2*PIFAC**2/12) + $ +B**2/8*((1+Z(I))*((1+Z(I))**2+3*LOG(Z(I))) + $ -4*LOG(Z(I))/(1-Z(I)))) + ENDIF + 10 CONTINUE +C---CHOOSE BOTH QSQ VALUES + DO 30 I=1,2 + IF (Z(I).GT.ZMXISR .OR. COLISR) THEN + QSQ(I)=0 + ELSE + J=3-I +C---ACCORDING TO 1/(QSQ+QSQMIN) FROM 0 TO (1-Z)*(T/(Z+T))*QSQMAX + 20 QSQ(I)=(((1-Z(I))*(T/(Z(I)+T)) + $ *QSQMAX/QSQMIN+1)**HWR()-1)*QSQMIN +C---AND REJECT TO QSQ/(QSQ+QSQMIN)**2 + IF (HWR()*(QSQ(I)+QSQMIN).GT.QSQ(I)) GOTO 20 + ENDIF + 30 CONTINUE +C---CHOOSE BOTH AZIMUTHS + PHI(1)=HWR()*2*PIFAC + PHI(2)=HWR()*2*PIFAC +C---USE S-HAT PRESCRIPTION TO MODIFY Z VALUES + I=0 + IF ((1-Z(1))*QSQ(1).GT.(1-Z(2))*QSQ(2)) I=1 + IF ((1-Z(2))*QSQ(2).GT.(1-Z(1))*QSQ(1)) I=2 + IF (I.GT.0) THEN + J=3-I + Z(I)=Z(I)+QSQ(I)/QSQMAX + IF (QSQ(J).GT.ZERO) THEN + Z(J)=((QSQ(I)*QSQMAX+QSQ(J)*QSQMAX + $ -QSQ(I)*QSQ(J))/QSQMAX**2+T)/Z(I) + C=COS(PHI(1)-PHI(2))*SQRT(QSQ(1)*QSQ(2))/QSQMAX + Z(J)=Z(J)+(-2*C**2*(1-Z(I))+2*C*SQRT((1-Z(I)) + $ *(C**2*(1-Z(I))+Z(I)**2*(1-Z(J)))))/Z(I)**2 + ENDIF + ENDIF + ELSEIF (IHEP.EQ.2) THEN +C---EVERYTHING WAS GENERATED LAST TIME + ELSE +C---ROUTINE CALLED UNEXPECTEDLY + CALL HWWARN('HWEISR',201,*999) + ENDIF +C---IF Z IS TOO LARGE THERE IS NO EMISSION + IF (Z(IHEP).GT.ZMXISR) RETURN +C---PUT NEW LEPTON IN EVENT RECORD + NHEP=NHEP+1 + IDHW(NHEP)=IDHW(IHEP) + IDHEP(NHEP)=IDHEP(IHEP) + ISTHEP(NHEP)=3 + JMOHEP(1,NHEP)=IHEP + JMOHEP(2,NHEP)=0 + JDAHEP(1,NHEP)=0 + JDAHEP(2,NHEP)=0 + JDAHEP(1,IHEP)=NHEP +C---AND OUTGOING PHOTON + NHEP=NHEP+1 + IDHW(NHEP)=59 + IDHEP(NHEP)=22 + ISTHEP(NHEP)=1 + JMOHEP(1,NHEP)=IHEP + JMOHEP(2,NHEP)=0 + JDAHEP(1,NHEP)=0 + JDAHEP(2,NHEP)=0 + JDAHEP(2,IHEP)=NHEP +C---RECONSTRUCT PHOTON KINEMATICS (Z IS LIGHT-CONE MOMENTUM FRACTION) + PHEP(1,NHEP)=SQRT(QSQ(IHEP)*(1-Z(IHEP)))*COS(PHI(IHEP)) + PHEP(2,NHEP)=SQRT(QSQ(IHEP)*(1-Z(IHEP)))*SIN(PHI(IHEP)) + PHEP(3,NHEP)=(1-Z(IHEP))*PHEP(4,IHEP)-QSQ(IHEP)/(4*PHEP(4,IHEP)) + IF (IHEP.EQ.2) PHEP(3,NHEP)=-PHEP(3,NHEP) + PHEP(4,NHEP)=(1-Z(IHEP))*PHEP(4,IHEP)+QSQ(IHEP)/(4*PHEP(4,IHEP)) + PHEP(5,NHEP)=0 +C---AND LEPTON + CALL HWVDIF(4,PHEP(1,IHEP),PHEP(1,NHEP),PHEP(1,NHEP-1)) + CALL HWUMAS(PHEP(1,NHEP-1)) +C---UPDATE OVERALL CM FRAME + JMOHEP(IHEP,3)=NHEP-1 + CALL HWVDIF(4,PHEP(1,3),PHEP(1,IHEP),PHEP(1,3)) + CALL HWVSUM(4,PHEP(1,NHEP-1),PHEP(1,3),PHEP(1,3)) + CALL HWUMAS(PHEP(1,3)) + 999 END +CDECK ID>, HWEONE. +*CMZ :- -26/04/91 11.11.55 by Bryan Webber +*-- Author : Bryan Webber +C----------------------------------------------------------------------- + SUBROUTINE HWEONE +C----------------------------------------------------------------------- +C SETS UP 2->1 (COLOUR SINGLET) HARD SUBPROCESS +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + DOUBLE PRECISION PA + INTEGER ICMF,I,IBM,IHEP +C---INCOMING LINES + ICMF=NHEP+3 + DO 15 I=1,2 + IBM=I +C---FIND BEAM AND TARGET + IF (JDAHEP(1,I).NE.0) IBM=JDAHEP(1,I) + IHEP=NHEP+I + IDHW(IHEP)=IDN(I) + IDHEP(IHEP)=IDPDG(IDN(I)) + ISTHEP(IHEP)=110+I + JMOHEP(1,IHEP)=ICMF + JMOHEP(I,ICMF)=IHEP + JDAHEP(1,IHEP)=ICMF +C---SPECIAL - IF INCOMING PARTON IS INCOMING BEAM THEN COPY IT + IF (XX(I).EQ.ONE.AND.IDHW(IBM).EQ.IDN(I)) THEN + CALL HWVEQU(5,PHEP(1,IBM),PHEP(1,IHEP)) + IF (I.EQ.2) PHEP(3,IHEP)=-PHEP(3,IHEP) + ELSE + PHEP(1,IHEP)=0. + PHEP(2,IHEP)=0. + PHEP(5,IHEP)=RMASS(IDN(I)) + PA=XX(I)*(PHEP(4,IBM)+ABS(PHEP(3,IBM))) + PHEP(4,IHEP)=0.5*(PA+PHEP(5,IHEP)**2/PA) + PHEP(3,IHEP)=PA-PHEP(4,IHEP) + ENDIF + 15 CONTINUE + PHEP(3,NHEP+2)=-PHEP(3,NHEP+2) +C---HARD CENTRE OF MASS + IDHW(ICMF)=IDCMF + IDHEP(ICMF)=IDPDG(IDCMF) + ISTHEP(ICMF)=110 + CALL HWVSUM(4,PHEP(1,NHEP+1),PHEP(1,NHEP+2),PHEP(1,ICMF)) + CALL HWUMAS(PHEP(1,ICMF)) +C---SET UP COLOUR STRUCTURE LABELS + JMOHEP(2,NHEP+1)=NHEP+2 + JDAHEP(2,NHEP+1)=NHEP+2 + JMOHEP(2,NHEP+2)=NHEP+1 + JDAHEP(2,NHEP+2)=NHEP+1 + JDAHEP(1,NHEP+3)=NHEP+3 + JDAHEP(2,NHEP+3)=NHEP+3 + NHEP=NHEP+3 + 999 END +CDECK ID>, HWEPRO. +*CMZ :- -01/04/99 19.41.18 by Mike Seymour +*-- Author : Bryan Webber +C----------------------------------------------------------------------- + SUBROUTINE HWEPRO +C----------------------------------------------------------------------- +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 'HERWIG61.INC' + DOUBLE PRECISION HWR + EXTERNAL HWR + IF (IERROR.NE.0) RETURN +C---ROUTINE LOOPS BACK TO HERE IF GENERATED WEIGHT WAS NOT ACCEPTED + 10 GENEV=.FALSE. +C---FSTWGT IS .TRUE. DURING FIRST CALL TO HARD PROCESS ROUTINE + FSTWGT=NWGTS.EQ.0 +C---FSTEVT IS .TRUE. THROUGHOUT THE FIRST EVENT + FSTEVT=NEVHEP.EQ.1 +C---SET COLOUR CORRECTION TO FALSE + COLUPD = .FALSE. + HRDCOL(1,1)=0 + HRDCOL(1,3)=0 +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 Select a primary interaction point + IF (PIPSMR) THEN + CALL HWRPIP + ELSE + CALL HWVZRO(4,VTXPIP) + ENDIF + CALL HWVEQU(3,VTXPIP,VHEP(1,NHEP)) + VHEP(4,NHEP)=0.0 +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,ZERO, ONE,.FALSE.) + IF (ABS(IDHEP(2)).EQ.11.OR.ABS(IDHEP(2)).EQ.13) + & CALL HWEGAM(2,ZERO, ONE,.FALSE.) + ELSEIF (IPRO.GE.90) THEN + IF (ABS(IDHEP(2)).EQ.11.OR.ABS(IDHEP(2)).EQ.13) + & CALL HWEGAM(2,ZERO, ONE,.FALSE.) + ENDIF +C---GENERATE ISR PHOTONS FOR LEPTONIC PROCESSES + IF (IPRO.LT.10) THEN + CALL HWEISR(1) + CALL HWEISR(2) + 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.ZERO .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.6) THEN +C---EE -> FOUR JETS + CALL HWH4JT + 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---VECTOR BOSON + JET PRODUCTION + CALL HWHV1J + 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.24) THEN +C---COLOUR-SINGLET EXCHANGE + CALL HWHSNG + ELSEIF (IPRO.EQ.30) THEN +C---HADRON-HADRON SUSY PROCESSES + CALL HWHSSP + ELSEIF(IPRO.EQ.40.OR.IPRO.EQ.41) THEN +C---HADRON-HADRON R-PARITY VIOLATING SUSY PROCESSES + CALL HWHRSP + 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.53) THEN +C Compton scattering of point-like photon and (anti)quark + CALL HWHPQS + ELSEIF (IPRO.EQ.55) THEN +C Point-like photon/higher twist meson production + CALL HWHPPM + ELSEIF (IPRO.EQ.60) THEN +C---QPM GAMMA-GAMMA-->QQBAR + CALL HWHQPM + 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.ZERO) 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 WARN AT 10*EFFMIN, STOP AT EFFMIN + IF (10*EFFMIN*NWGTS.GT.NEVHEP) THEN + IF (EFFMIN*NWGTS.GT.NEVHEP) CALL HWWARN('HWEPRO',200,*999) + IF (EFFMIN.GT.ZERO) THEN + IF (MOD(NWGTS,INT(10/EFFMIN)).EQ.0) THEN + CALL HWWARN('HWEPRO',2,*999) + WRITE (6,98) WGTMAX + ENDIF + ENDIF + ENDIF + IF (NOWGT) THEN + GENEV=EVWGT.GT.WGTMAX*HWR() + ELSE + GENEV=EVWGT.NE.ZERO + ENDIF + IF (GENEV) GOTO 20 + GOTO 10 + ENDIF + ENDIF + 98 FORMAT(10X,' MAXIMUM WEIGHT =',1PG24.16) + 99 FORMAT(10X,'NEW MAXIMUM WEIGHT =',1PG24.16) + 999 END +CDECK ID>, HWETWO. +*CMZ :- -26/04/91 11.11.55 by Bryan Webber +*-- Author : Bryan Webber +C----------------------------------------------------------------------- + SUBROUTINE HWETWO +C----------------------------------------------------------------------- +C SETS UP 2->2 HARD SUBPROCESS +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + DOUBLE PRECISION HWUMBW,HWUPCM,PA,PCM + INTEGER ICMF,IBM,I,J,K,IHEP,NTRY + EXTERNAL HWUPCM +C---INCOMING LINES + ICMF=NHEP+3 + DO 15 I=1,2 + IBM=I +C---FIND BEAM AND TARGET + IF (JDAHEP(1,I).NE.0) IBM=JDAHEP(1,I) + IHEP=NHEP+I + IDHW(IHEP)=IDN(I) + IDHEP(IHEP)=IDPDG(IDN(I)) + ISTHEP(IHEP)=110+I + JMOHEP(1,IHEP)=ICMF + JMOHEP(I,ICMF)=IHEP + JDAHEP(1,IHEP)=ICMF +C---SPECIAL - IF INCOMING PARTON IS INCOMING BEAM THEN COPY IT + IF (XX(I).EQ.ONE.AND.IDHW(IBM).EQ.IDN(I)) THEN + CALL HWVEQU(5,PHEP(1,IBM),PHEP(1,IHEP)) + IF (I.EQ.2) PHEP(3,IHEP)=-PHEP(3,IHEP) + ELSE + PHEP(1,IHEP)=0. + PHEP(2,IHEP)=0. + PHEP(5,IHEP)=RMASS(IDN(I)) + PA=XX(I)*(PHEP(4,IBM)+ABS(PHEP(3,IBM))) + PHEP(4,IHEP)=0.5*(PA+PHEP(5,IHEP)**2/PA) + PHEP(3,IHEP)=PA-PHEP(4,IHEP) + ENDIF + 15 CONTINUE + PHEP(3,NHEP+2)=-PHEP(3,NHEP+2) +C---HARD CENTRE OF MASS + IDHW(ICMF)=IDCMF + IDHEP(ICMF)=IDPDG(IDCMF) + ISTHEP(ICMF)=110 + CALL HWVSUM(4,PHEP(1,NHEP+1),PHEP(1,NHEP+2),PHEP(1,ICMF)) + CALL HWUMAS(PHEP(1,ICMF)) +C---OUTGOING LINES + NTRY=0 + 19 CONTINUE + DO 20 I=3,4 + IHEP=NHEP+I+1 + IDHW(IHEP)=IDN(I) + IDHEP(IHEP)=IDPDG(IDN(I)) + ISTHEP(IHEP)=110+I + JMOHEP(1,IHEP)=ICMF + JDAHEP(I-2,ICMF)=IHEP + 20 PHEP(5,IHEP)=HWUMBW(IDN(I)) + PCM=HWUPCM(PHEP(5,NHEP+3),PHEP(5,NHEP+4),PHEP(5,NHEP+5)) + IF (PCM.LT.ZERO) THEN + NTRY=NTRY+1 + IF (NTRY.LE.NETRY) GO TO 19 + CALL HWWARN('HWETWO',103,*999) + ENDIF + IHEP=NHEP+4 + PHEP(4,IHEP)=SQRT(PCM**2+PHEP(5,IHEP)**2) + PHEP(3,IHEP)=PCM*COSTH + PHEP(1,IHEP)=SQRT((PCM+PHEP(3,IHEP))*(PCM-PHEP(3,IHEP))) + CALL HWRAZM(PHEP(1,IHEP),PHEP(1,IHEP),PHEP(2,IHEP)) + CALL HWULOB(PHEP(1,NHEP+3),PHEP(1,IHEP),PHEP(1,IHEP)) + CALL HWVDIF(4,PHEP(1,NHEP+3),PHEP(1,IHEP),PHEP(1,NHEP+5)) +C---SET UP COLOUR STRUCTURE LABELS + DO 30 I=1,4 + J=I + IF (J.GT.2) J=J+1 + K=ICO(I) + IF (K.GT.2) K=K+1 + JMOHEP(2,NHEP+J)=NHEP+K + 30 JDAHEP(2,NHEP+K)=NHEP+J + NHEP=NHEP+5 + 999 END +CDECK ID>, HWH4JT. +*CMZ :- -01/04/99 19.47.55 by Mike Seymour +*-- Author : Ian Knowles +C----------------------------------------------------------------------- + SUBROUTINE HWH4JT +C----------------------------------------------------------------------- +C Four jet production in e^+e^- annihilation: qqbar+gg & qqbar+qqbar +C IOP4JT controls the treatment of the colour flow interference term +C qqbar-gg case: +C IOP4JT(1)=0 neglect, =1 extreme 2341; =2 extreme 3421 +C qqbar-qqbar (identical quark flavour) case: +C IOP4JT(2)=0 neglect, =1 extreme 4123; =2 extreme 2143 +C +C Matrix elements based on Ellis Ross & Terrano and Catani & Seymour +C +C WARNING: Phase space factor inaccurate for JADE y_cut > 0.14. +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + INTEGER LM,LP,IQK,I,J,IDMN,IDMX,ID1,ID2,IST(4) + DOUBLE PRECISION HWR,HWUALF,HWUAEM,HWULDO,HWH4J1,HWH4J2, + & HWH4J4,HWH4J5,HWH4J6,HWH4J7,QNOW,Q2NOW,QLST,SCUT,PSFAC,FACT,X, + & COLA,COLB,COLC,CLF(7,6),P12,P13,P14,P23,P24,P34,FACTR,EP1,EP2, + & EP3,EP4,GG1,GG2,GG12,GG3,GG13,GG23,GGINT,WTGG,QQ,QP,QQINT,QQ1, + & QQ2,WTQQ,WTQP,HCS,WTAB,WTBA,WTOT,RCS + $ ,EF,QF,E(4) + LOGICAL INCLQG(6),INCLQQ(6,6),ORIENT + EXTERNAL HWR,HWUALF,HWUAEM,HWULDO,HWH4J1,HWH4J2,HWH4J4, + & HWH4J5,HWH4J6,HWH4J7 + SAVE HCS,QLST,WTQP,WTQQ,WTGG,FACTR,COLA,COLB,COLC,IDMN,IDMX, + & CLF,GG1,GG2,GGINT,INCLQG,INCLQQ,LM,LP,QQ1,QQ2,QQINT,FACT,ORIENT, + & Q2NOW,SCUT + DATA QLST,IST/-1.,113,114,114,114/ +C + IF (GENEV) THEN + RCS=HCS*HWR() + ELSE + IF (NHEP+5.GT.NMXHEP) CALL HWWARN('HWH4JT',100,*999) + QNOW=PHEP(5,3) + IF (QNOW.NE.QLST) THEN + QLST=QNOW + Q2NOW=QNOW**2 + SCUT=Y4JT*Q2NOW +C Calculate allowed fraction of Phase Space using parameterization + IF (DURHAM) THEN + PSFAC=(1.-6.*Y4JT)**5.50*(1.-173.3*Y4JT*(1.-247.3*Y4JT + & *(1.+148.3*Y4JT*(1.+3.913*Y4JT)))) + & /(1.-8.352*Y4JT*(1.-1102.*Y4JT + & *(1.+1603.*Y4JT*(1.+22.99*Y4JT)))) + ELSE + PSFAC=(1.-6.*Y4JT)**4.62*(1.-44.72*Y4JT*(1.-176.0*Y4JT + & *(1.+102.9*Y4JT*(1.-6.579*Y4JT)))) + & /(1.-3.392*Y4JT*(1.-946.5*Y4JT + & *(1.+423.4*Y4JT*(1.-3.971*Y4JT)))) + ENDIF + FACT=GEV2NB*HWUAEM(Q2NOW)**2*CFFAC*FLOAT(NCOLO)*PSFAC + & /(THREE*16*PIFAC) + COLA=CFFAC + COLB=CFFAC-HALF*CAFAC + COLC=HALF + LM=1 + IF (JDAHEP(1,LM).NE.0) LM=JDAHEP(1,LM) + LP=2 + IF (JDAHEP(1,LP).NE.0) LP=JDAHEP(1,LP) + IQK=MOD(IPROC,10) + IF (IQK.NE.0) THEN + IDMN=IQK + IDMX=IQK + ELSE + IDMN=1 + IDMX=6 + ENDIF + DO 10 I=1,6 + CALL HWUCFF(11,I,Q2NOW,CLF(1,I)) + IF (QNOW.GT.TWO*(RMASS(I)+RMASS(13))) THEN + INCLQG(I)=.TRUE. + ELSE + INCLQG(I)=.FALSE. + ENDIF + DO 10 J=I,6 + IF (QNOW.GT.TWO*(RMASS(I)+RMASS(J ))) THEN + INCLQQ(I,J)=.TRUE. + INCLQQ(J,I)=.TRUE. + ELSE + INCLQQ(I,J)=.FALSE. + INCLQQ(J,I)=.FALSE. + ENDIF + 10 CONTINUE + IF (MOD(IPROC/10,10).EQ.5) THEN + ORIENT=.FALSE. + ELSE + ORIENT=.TRUE. + ENDIF + ENDIF +C Generate phase space point and check it passes cuts + CALL HWVEQU(5,PHEP(1,3),PHEP(1,NHEP+1)) + DO 20 I=2,5 + 20 PHEP(5,NHEP+I)=0. + 30 CALL HWDFOR(PHEP(1,NHEP+1),PHEP(1,NHEP+2),PHEP(1,NHEP+3), + & PHEP(1,NHEP+4),PHEP(1,NHEP+5)) + IF (DURHAM) THEN + P12=2*HWULDO(PHEP(1,NHEP+2),PHEP(1,NHEP+3)) + X=MIN(PHEP(4,NHEP+2)/PHEP(4,NHEP+3), + & PHEP(4,NHEP+3)/PHEP(4,NHEP+2))*P12 + IF (X.GT.SCUT) THEN + P13=2*HWULDO(PHEP(1,NHEP+2),PHEP(1,NHEP+4)) + X=MIN(PHEP(4,NHEP+2)/PHEP(4,NHEP+4), + & PHEP(4,NHEP+4)/PHEP(4,NHEP+2))*P13 + IF (X.GT.SCUT) THEN + P14=2*HWULDO(PHEP(1,NHEP+2),PHEP(1,NHEP+5)) + X=MIN(PHEP(4,NHEP+2)/PHEP(4,NHEP+5), + & PHEP(4,NHEP+5)/PHEP(4,NHEP+2))*P14 + IF (X.GT.SCUT) THEN + P23=2*HWULDO(PHEP(1,NHEP+3),PHEP(1,NHEP+4)) + X=MIN(PHEP(4,NHEP+3)/PHEP(4,NHEP+4), + & PHEP(4,NHEP+4)/PHEP(4,NHEP+3))*P23 + IF (X.GT.SCUT) THEN + P24=2*HWULDO(PHEP(1,NHEP+3),PHEP(1,NHEP+5)) + X=MIN(PHEP(4,NHEP+3)/PHEP(4,NHEP+5), + & PHEP(4,NHEP+5)/PHEP(4,NHEP+3))*P24 + IF (X.GT.SCUT) THEN + P34=2*HWULDO(PHEP(1,NHEP+4),PHEP(1,NHEP+5)) + X=MIN(PHEP(4,NHEP+4)/PHEP(4,NHEP+5), + & PHEP(4,NHEP+5)/PHEP(4,NHEP+4))*P34 + IF (X.GT.SCUT) GOTO 40 + ENDIF + ENDIF + ENDIF + ENDIF + ENDIF + ELSE + P12=2*HWULDO(PHEP(1,NHEP+2),PHEP(1,NHEP+3)) + IF (P12.GT.SCUT) THEN + P13=2*HWULDO(PHEP(1,NHEP+2),PHEP(1,NHEP+4)) + IF (P13.GT.SCUT) THEN + P14=2*HWULDO(PHEP(1,NHEP+2),PHEP(1,NHEP+5)) + IF (P14.GT.SCUT) THEN + P23=2*HWULDO(PHEP(1,NHEP+3),PHEP(1,NHEP+4)) + IF (P23.GT.SCUT) THEN + P24=2*HWULDO(PHEP(1,NHEP+3),PHEP(1,NHEP+5)) + IF (P24.GT.SCUT) THEN + P34=2*HWULDO(PHEP(1,NHEP+4),PHEP(1,NHEP+5)) + IF (P34.GT.SCUT) GOTO 40 + ENDIF + ENDIF + ENDIF + ENDIF + ENDIF + ENDIF +C Failed cuts retry + GOTO 30 +C Passed cuts: calculate contributions to Matrix Elements + 40 EMSCA=SQRT(MIN(P12,P13,P14,P23,P24,P34)) + FACTR=FACT*HWUALF(1,EMSCA)**2 + IF (ORIENT) THEN + QF=HWULDO(PHEP(1,LP),PHEP(1,3)) + EF=Q2NOW/(2*SQRT(QF**2-HWULDO(PHEP(1,LP),PHEP(1,LP))*Q2NOW)) + QF=HALF-EF*QF/Q2NOW + DO I=1,4 + E(I)=EF*PHEP(I,LP)+QF*PHEP(I,3) + ENDDO + EP1=HWULDO(E,PHEP(1,NHEP+2)) + EP2=HWULDO(E,PHEP(1,NHEP+3)) + EP3=HWULDO(E,PHEP(1,NHEP+4)) + EP4=HWULDO(E,PHEP(1,NHEP+5)) + ENDIF +C q-qbar-g-g + GG1=HWH4J1(P12,P13,P14,P23,P24,P34,EP1,EP2,EP3,EP4,ORIENT) + & +HWH4J1(P12,P24,P23,P14,P13,P34,EP2,EP1,EP4,EP3,ORIENT) + GG2=HWH4J1(P12,P23,P24,P13,P14,P34,EP2,EP1,EP3,EP4,ORIENT) + & +HWH4J1(P12,P14,P13,P24,P23,P34,EP1,EP2,EP4,EP3,ORIENT) + GG12=HWH4J2(P12,P13,P14,P23,P24,P34,EP1,EP2,EP3,EP4,ORIENT) + & +HWH4J2(P12,P14,P13,P24,P23,P34,EP1,EP2,EP4,EP3,ORIENT) + & +HWH4J2(P12,P23,P24,P13,P14,P34,EP2,EP1,EP3,EP4,ORIENT) + & +HWH4J2(P12,P24,P23,P14,P13,P34,EP2,EP1,EP4,EP3,ORIENT) + GG3=HWH4J4(P12,P13,P14,P23,P24,P34,EP1,EP2,EP3,EP4,ORIENT) + & +HWH4J4(P12,P24,P23,P14,P13,P34,EP2,EP1,EP4,EP3,ORIENT) + GG13=GG3+HWH4J5(P12,P13,P14,P23,P24,P34,EP1,EP2,EP3,EP4,ORIENT) + & +HWH4J5(P12,P24,P23,P14,P13,P34,EP2,EP1,EP4,EP3,ORIENT) + GG23=GG3+HWH4J5(P12,P14,P13,P24,P23,P34,EP1,EP2,EP4,EP3,ORIENT) + & +HWH4J5(P12,P23,P24,P13,P14,P34,EP2,EP1,EP3,EP4,ORIENT) +C Add up weights + GG1 =COLA*(GG1 +GG13) + GG2 =COLA*(GG2 +GG23) + GGINT=COLB*(GG12-GG13-GG23) + WTGG=FACTR*(GG1+GG2+GGINT) +C q-qbar-q-qbar + QP=HWH4J6(P13,P12,P14,P23,P34,P24,EP1,EP3,EP2,EP4,ORIENT) + & +HWH4J6(P24,P12,P23,P14,P34,P13,EP2,EP4,EP1,EP3,ORIENT) + & +HWH4J6(P13,P34,P23,P14,P12,P24,EP3,EP1,EP4,EP2,ORIENT) + & +HWH4J6(P24,P34,P14,P23,P12,P13,EP4,EP2,EP3,EP1,ORIENT) + QQ=HWH4J6(P13,P23,P34,P12,P14,P24,EP3,EP1,EP2,EP4,ORIENT) + & +HWH4J6(P24,P23,P12,P34,P14,P13,EP2,EP4,EP3,EP1,ORIENT) + & +HWH4J6(P13,P14,P12,P34,P23,P24,EP1,EP3,EP4,EP2,ORIENT) + & +HWH4J6(P24,P14,P34,P12,P23,P13,EP4,EP2,EP1,EP3,ORIENT) + QQINT=HWH4J7(P13,P12,P14,P23,P34,P24,EP1,EP3,EP2,EP4,ORIENT) + & +HWH4J7(P24,P12,P23,P14,P34,P13,EP2,EP4,EP1,EP3,ORIENT) + & +HWH4J7(P13,P23,P34,P12,P14,P24,EP3,EP1,EP2,EP4,ORIENT) + & +HWH4J7(P24,P23,P12,P34,P14,P13,EP2,EP4,EP3,EP1,ORIENT) + & +HWH4J7(P13,P14,P12,P34,P23,P24,EP1,EP3,EP4,EP2,ORIENT) + & +HWH4J7(P24,P14,P34,P12,P23,P13,EP4,EP2,EP1,EP3,ORIENT) + & +HWH4J7(P13,P34,P23,P14,P12,P24,EP3,EP1,EP4,EP2,ORIENT) + & +HWH4J7(P24,P34,P14,P23,P12,P13,EP4,EP2,EP3,EP1,ORIENT) +C Add up weights + WTQP=FACTR*COLC*QP/TWO + QQ1 =COLC*QP + QQ2 =COLC*QQ + QQINT=COLB*QQINT + WTQQ=FACTR*(QQ1+QQ2+QQINT)/2 + ENDIF +C + HCS=0. + DO 60 ID1=IDMN,IDMX + IF (INCLQG(ID1)) THEN +C Gluon channel + HCS=HCS+CLF(1,ID1)*WTGG + IF (GENEV.AND.HCS.GT.RCS) THEN +C Select colour flow + WTAB=GG1 + WTBA=GG2 + IF (IOP4JT(1).EQ.1) THEN + IF (GGINT.GE.ZERO) THEN + WTAB=WTAB+GGINT + ELSE + WTBA=MAX(WTBA,WTBA+GGINT) + ENDIF + ELSEIF (IOP4JT(1).EQ.2) THEN + IF (GGINT.GE.ZERO) THEN + WTBA=WTBA+GGINT + ELSE + WTAB=MAX(WTAB,WTAB+GGINT) + ENDIF + ELSEIF (IOP4JT(1).NE.0) THEN + CALL HWWARN('HWH4JT',101,*999) + ENDIF + WTOT=WTAB+WTBA + IF (WTAB.GT.HWR()*WTOT) THEN + CALL HWHQCP( 13, 13,3142,91,*99) + ELSE + CALL HWHQCP( 13, 13,4123,92,*99) + ENDIF + ENDIF + ENDIF +C Quark channels + DO 50 ID2=1,6 +C Identical quark pairs + IF (ID1.EQ.ID2.AND.INCLQQ(ID1,ID1)) THEN + HCS=HCS+CLF(1,ID1)*WTQQ + IF (GENEV.AND.HCS.GT.RCS) THEN +C Select colour flow + WTAB=QQ1 + WTBA=QQ2 + IF (IOP4JT(2).EQ.1) THEN + IF (QQINT.GE.ZERO) THEN + WTAB=WTAB+QQINT + ELSE + WTBA=MAX(WTBA,WTBA+QQINT) + ENDIF + ELSEIF (IOP4JT(2).EQ.2) THEN + IF (QQINT.GE.ZERO) THEN + WTBA=WTBA+QQINT + ELSE + WTAB=MAX(WTAB,WTAB+QQINT) + ENDIF + ELSEIF (IOP4JT(2).NE.0) THEN + CALL HWWARN('HWH4JT',102,*999) + ENDIF + WTOT=WTAB+WTBA + IF (WTAB.GT.HWR()*WTOT) THEN + CALL HWHQCP(ID1,ID1+6,4123,93,*99) + ELSE + CALL HWHQCP(ID1,ID1+6,2143,94,*99) + ENDIF + ENDIF +C Unlike quark pairs + ELSEIF (INCLQQ(ID1,ID2)) THEN + HCS=HCS+(CLF(1,ID1)+CLF(1,ID2))*WTQP + IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID2,ID2+6,4123,95,*99) + ENDIF + 50 CONTINUE + 60 CONTINUE + EVWGT=HCS + RETURN +C Set up labels for selected final state + 99 IDN(1)=ID1 + IDN(2)=ID1+6 + J=NHEP+1 + IDHW(J)=200 + IDHEP(J)=23 + ISTHEP(J)=110 + JMOHEP(1,J)=LM + JMOHEP(2,J)=LP + JDAHEP(1,J)=NHEP+2 + JDAHEP(2,J)=NHEP+5 + DO 100 I=1,4 + J=NHEP+1+I + IDHW(J)=IDN(I) + IDHEP(J)=IDPDG(IDN(I)) + ISTHEP(J)=IST(I) + JMOHEP(1,J)=NHEP+1 + 100 JDAHEP(1,J)=0 +C And colour structure pointers + DO 110 I=1,4 + J=ICO(I) + JMOHEP(2,NHEP+1+I)=NHEP+1+J + 110 JDAHEP(2,NHEP+1+J)=NHEP+1+I + NHEP=NHEP+5 + 999 END +CDECK ID>, HWH4J1. +*CMZ :- -01/04/99 19.47.55 by Mike Seymour +*-- Author : Ian Knowles +C----------------------------------------------------------------------- + FUNCTION HWH4J1(S12,S13,S14,S23,S24,S34,EP1,EP2,EP3,EP4,ORIENT) +C----------------------------------------------------------------------- +C Evaluate `ERT' functions A, B, C, D, E; S12=(p1+p2)^2 etc. +C----------------------------------------------------------------------- + IMPLICIT NONE + DOUBLE PRECISION HWH4J1,HWH4J2,HWH4J4,HWH4J5,HWH4J6,HWH4J7, + & S12,S13,S14,S23,S24,S34,S123,S124,S134,S234,S,EP1,EP2,EP3,EP4, + & SUM + LOGICAL ORIENT + S123=S12+S13+S23 + S124=S12+S14+S24 + S134=S13+S14+S34 + S234=S23+S24+S34 + S=S12+S13+S14+S23+S24+S34 + HWH4J1=(S12*((S12+S14+S23+S34)**2+S13*(S12+S14-S24)+S24*(S12+S23)) + & +(S14*S23-S12*S34-S13*S24)*(S14+S23+S34)/2) + & /(S13*S24*S134*S234) + & +((S12+S24)*(S13+S34)-S14*S23)/(S13*S134**2) + & +2*S23*(S-S13)/(S13*S134*S24) + S34/(2*S13*S24) + IF (ORIENT) THEN + HWH4J1=HWH4J1 + & +4*((EP1*EP1*((S-S13)*(S23+S24)-S24*S34) + & -EP1*EP2*(S12*(S123+S124)+(S+S12)*(S14+S23)+2*S14*S23 + & +S24*S134+S234*(S13+2*S234)) + & +EP1*EP3*(S*(S24-S12)+S12*S13+(S14+2*S234-S34)*S24) + & -EP1*EP4*(S12*S124+S23*(S+S12+S14)) + & +EP2*EP2*((S-S24)*(S13+S14)+2*(S13+S34)*S234-S13*S34) + & -EP2*EP3*((S+S23)*(S12+S14)+(S12+2*(S23+S234))*S234) + & +EP2*EP4*(S12*(S24-S)+S13*(S+S23-S34)+2*(S13+S34-S234)*S234) + & +EP3*EP3*(S14+2*S234)*S24 + & +EP3*EP4*(-S234*(2*(S12+S23)+S134)+S12*S34-S13*S24-S14*S23) + & +EP4*EP4*S13*S23)*S134 + & +EP2*(EP1+EP3+EP4)*2*S14*S24*S234)/(S*S13*S24*S134**2*S234) + ELSE + HWH4J1=2*HWH4J1/3 + ENDIF + RETURN +C----------------------------------------------------------------------- + ENTRY HWH4J2(S12,S13,S14,S23,S24,S34,EP1,EP2,EP3,EP4,ORIENT) +C----------------------------------------------------------------------- + S123=S12+S13+S23 + S124=S12+S14+S24 + S134=S13+S14+S34 + S234=S23+S24+S34 + S=S12+S13+S14+S23+S24+S34 + HWH4J2=(S12*S14*(S24+S34)+S24*(S12*(S14+S34)+S13*(S14-S24))) + & /(S14*S23*S13*S134) + & +S12*(S+S34)*S124/(S24*S234*S14*S134) + & -(S13*(2*(S12+S24)+S23)+S14**2)/(S134*S13*S14) + & +S12*S123*S124/(2*S13*S24*S14*S23) + IF (ORIENT) THEN + HWH4J2=HWH4J2 + & +4*((EP1*EP1*(S12*S134*S234-4*S23*S24*S34) + & +EP1*EP2*(2*(2*S13*S234+S14*S123)*S24-S12*S134*(S+S12+S34)) + & +EP1*EP3*(S12*(4*S24*S34-S134*(S12+S14-S24)) + & -4*(S13*S24-S14*S23)*S24) + & +EP1*EP4*(4*(S13+S14)*S23*S24-S12*S134*(S12+S13-S23)) + & +EP2*EP2*(S12*S134-4*S13*S24)*S134 + & +EP2*EP3*(4*S13*(S12+S23+S24)*S24-S12*S134*(S12-S14+S24)) + & -EP2*EP4*(4*(S12*(S14+S134)+S13*(S134-S234))*S24 + & +S12*(S12-S13+S23)*S134) + & -EP3*EP3*4*S12*S14*S24 + & -EP3*EP4*2*S12*(2*S14*S24+S12*S134))*S234 + & +(EP1*(EP1*(S23+S24)+EP2*(S134-2*S)) + & -(EP1+EP2)*(EP3+EP4)*S12+EP2*EP2*(S13+S14))*2*S14*S24*S123) + & /(2*S*S13*S14*S234*S23*S24*S134) + ELSE + HWH4J2=2*HWH4J2/3 + ENDIF + RETURN +C----------------------------------------------------------------------- + ENTRY HWH4J4(S12,S13,S14,S23,S24,S34,EP1,EP2,EP3,EP4,ORIENT) +C----------------------------------------------------------------------- + S134=S13+S14+S34 + S234=S23+S24+S34 + S=S12+S13+S14+S23+S24+S34 + HWH4J4=-(S12*(S34*(3*(S+S34)+S12)-S134*S234-2*(S13*S24+S14*S23)) + & +(S14*S23-S13*S24)*(S13-S14+S24-S23))/(2*S134*S234*S34**2) + & -(S12*(S134**2/2+2*S13*S14+S34*(S13+S14-S34)) + & +S34*((S13+S14)*(S23+S24)+S14*S24+S13*S23) + & +(S13*S24-S14*S23)*(S14-S13))/(S34*S134)**2 + IF (ORIENT) THEN + HWH4J4=HWH4J4 + & +4*((-EP1*EP1*2*(S23+S24)*S34 + & -EP1*EP2*(S13*(S23+3*S24)+S14*(3*S23+S24)-(4*S12-S34)*S34) + & +EP1*EP3*((2*S12-S24)*S34-(S13-S14)*S24) + & +EP1*EP4*((2*S12-S23)*S34+(S13-S14)*S23) + & -EP2*EP2*2*(S13+S14)*S34 + & +EP2*EP3*(2*S12*S34-S14*(S23-S24+S34)) + & +EP2*EP4*(2*S12*S34+S13*(S23-S24-S34)) + & +EP3*EP3*2*S14*S24 + & +EP3*EP4*2*(S12*S34-S13*S24-S14*S23) + & +EP4*EP4*2*S13*S23)/(S*S134*S234*S34**2) + & +(EP1*EP2*(S134*(S134+2*S34)+4*(S13*S14-S34**2)) + & +EP2*EP3*2*(2*S13*S34+S14*(S13-S14+S34)) + & +EP2*EP4*2*(2*S14*S34-S13*(S13-S14-S34))) + & /(S*(S134*S34)**2)) + ELSE + HWH4J4=2*HWH4J4/3 + ENDIF + RETURN +C----------------------------------------------------------------------- + ENTRY HWH4J5(S12,S13,S14,S23,S24,S34,EP1,EP2,EP3,EP4,ORIENT) +C----------------------------------------------------------------------- + S123=S12+S13+S23 + S124=S12+S14+S24 + S134=S13+S14+S34 + S234=S23+S24+S34 + S=S12+S13+S14+S23+S24+S34 + HWH4J5=(3*S12*S34**2-3*S13*S24*S34+3*S12*S24*S34+3*S14*S23*S34- + $ S13*S24**2-S12*S23*S34+6*S12*S14*S34+2*S12*S13*S34- + $ 2*S12**2*S34+S14*S23*S24-3*S13*S23*S24-2*S13*S14*S24+ + $ 4*S12*S14*S24+2*S12*S13*S24+3*S14*S23**2+2*S14**2*S23+ + $ 2*S14**2*S12+2*S12**2*S14+6*S12*S14*S23-2*S12*S13**2- + $ 2*S12**2*S13)/(2*S13*S134*S234*S34)+ + $ (2*S12*S34**2-2*S13*S24*S34+S12*S24*S34+4*S13*S23*S34+ + $ 4*S12*S14*S34+2*S12*S13*S34+2*S12**2*S34-S13*S24**2+ + $ 3*S14*S23*S24+4*S13*S23*S24-2*S13*S14*S24+4*S12*S14*S24+ + $ 2*S12*S13*S24+2*S14*S23**2+4*S13*S23**2+2*S13*S14*S23+ + $ 2*S12*S14*S23+4*S12*S13*S23+2*S12*S14**2+4*S12**2*S13+ + $ 4*S12*S13*S14+2*S12**2*S14)/(2*S13*S134*S24*S34)- + $ (S12*S34**2-2*S14*S24*S34-2*S13*S24*S34-S14*S23*S34+ + $ S13*S23*S34+S12*S14*S34+2*S12*S13*S34-2*S14**2*S24- + $ 4*S13*S14*S24-4*S13**2*S24-S14**2*S23-S13**2*S23+ + $ S12*S13*S14-S12*S13**2)/(S13*S34*S134**2) + IF (ORIENT) THEN + SUM= + & +EP1*EP1*((S13-S14+S23-3*S24)*S34+(S134+S14+2*S34)*S234) + & *S24*S134 + & +EP1*EP2*((2*(S12-S24)+S34)*S134-S14*(4*S12+S14+3*S23) + & +S13*(S13+S23)+S24*S34 )*S24*S134 + & -EP1*EP2*(((2*S12*S134+S13*(2*(S12+S14+S23)-S24+S34) + & +S14*(S14-S23)+(2*S14-S34)*S234)*S234)*S134 + & + 4*S13**2*S24*S234) + & +EP1*EP3*(S12*(2*S13-S134)+S13*(S24+2*S234)+S14*(3*S24-S234) + & +S34*(S234-3*S24))*S24*S134 + & +EP1*EP4*((S12*(S13-S14+3*S34)-S23*(S13+3*S14-S34))*S24 + & -(S12*(S13+S134+2*S34)+2*S13*S24 + & +(S13-2*S14)*S23)*S234)*S134 + & +EP2*EP2*(S13*((2*S13+S34)*S234+S24*(S134-2*S34)) + & +2*S14*S134*(S24+S234))*S134 + SUM=SUM + & -EP2*EP3*(((S12*(S13+2*S14-S34)+S14*(S+2*S23-S34))*S24 + & +(S12*(S13+S134)+(S13+S24+2*S234)*S14 + & +2*S13*(2*S23+S34))*S234)*S134 + & +4*S13**2*S24*S234) + & +EP2*EP4*(((S12*(S13-2*S134)+S13*(S+2*S23-3*S34))*S24 + & -((S-3*S13+S23+2*S24)*S13+2*S12*S14 + & +2*S14*(S23+2*S24))*S234)*S134-4*S13**2*S24*S234) + & +EP3*EP3*2*(S13*S234+S14*S24)*S24*S134 + & +EP3*EP4*(2*(S12*S34-S13*S24-S14*S23)*S24 + & -(S12*S134+2*S13*S23)*S234)*S134 + & +EP4*EP4*2*(S12*S234+S23*S24)*S13*S134 + HWH4J5=HWH4J5+4*SUM/(S*S234*S134**2*S13*S34*S24) + ELSE + HWH4J5=2*HWH4J5/3 + ENDIF + RETURN +C----------------------------------------------------------------------- + ENTRY HWH4J6(S12,S13,S14,S23,S24,S34,EP1,EP2,EP3,EP4,ORIENT) +C----------------------------------------------------------------------- + S123=S12+S13+S23 + S124=S12+S14+S24 + S134=S13+S14+S34 + S234=S23+S24+S34 + S=S12+S13+S14+S23+S24+S34 + HWH4J6=(S23*(S123*S234-S*S23)+S12*(S123*S124-S*S12))/(S13*S123)**2 + & -(S12*S34*(S234-2*S23)+S14*S23*(S234-2*S34) + & -S13*S24*(S234+S13))/(S13**2*S123*S134) + IF (ORIENT) THEN + HWH4J6=HWH4J6 + & +4*(-EP1*EP1*2*S23*S34 + & +EP1*EP2*((S12-S23)*S34-S13*(S24-S34)) + & +(EP1*EP3+EP2*EP4)*2*(S12*S34-S13*S24+S14*S23) + & -EP1*EP4*(S13*S24-(3*(S13+S14)+S34)*S23) + & -(EP1+EP2+EP3)*EP4*2 + & *(S12*(S13+S23)+(S12+S13)*S23)*S134/S123 + & +EP2*EP2*S13*(S14+S34) + & +EP2*EP3*(S13*(S14-S24)-(S12-S23)*S14) + & -EP3*EP3*2*S12*S14 + & -EP3*EP4*(S13*S24-(3*(S13+S34)+S14)*S12) + & +EP4*EP4*(S12+S23)*S13)/(S*S134*S123*S13**2) + ELSE + HWH4J6=2*HWH4J6/3 + ENDIF + RETURN +C----------------------------------------------------------------------- + ENTRY HWH4J7(S12,S13,S14,S23,S24,S34,EP1,EP2,EP3,EP4,ORIENT) +C----------------------------------------------------------------------- + S123=S12+S13+S23 + S124=S12+S14+S24 + S134=S13+S14+S34 + S234=S23+S24+S34 + S=S12+S13+S14+S23+S24+S34 + HWH4J7=((S12*S34+S13*S24-S14*S23)*(S13+S14+S23+S24)-2*S12*S24*S34) + & /(S13*S134*S23*S123) + & -S12*(S12*S-S123*S124)/(S123**2*S13*S23) + & -(S13+S14)*(S23+S24)*S34/(S13*S134*S23*S234) + IF (ORIENT) THEN + HWH4J7=HWH4J7 + & +4*(+2*(EP1+EP2)*(S23*EP1-S13*EP2)*S34*S134 + & -EP1*EP2*2*S34**2*S123 + & +EP1*EP3*(S123*(S23+S24)*S34+2*S134*(S13*S24-S14*S23)) + & +EP1*EP4*(S123*(S23+S24)*S34+2*S12**2*S134*S234/S123 + & +2*S134*(S24*(S13-S12)-S23*(S12+S14))) + & +EP2*EP3*(2*(S12*S34+S13*S24-S14*S23)*S134 + & +S123*(S13+S14)*S34) + & +EP2*EP4*(S123*(S13+S14)*S34+2*S12**2*S234*S134/S123 + & -2*S134*(S12*S234-S13*S24+S14*S23)) + & -EP3*EP3*S12*(2*S24*S134+S123*S34) + & +EP3*EP4*2*S12*(S134*(S23-S24)-S34*S123+S12*S134*S234/S123) + & +EP4*EP4*S12*(2*S23*S134-S123*S34)) + & /(S*S13*S23*S123*S134*S234) + ELSE + HWH4J7=2*HWH4J7/3 + ENDIF + RETURN + END +CDECK ID>, HWHBGF. +*CMZ :- -26/04/91 11.11.55 by Bryan Webber +*-- Author : Giovanni Abbiendi & Luca Stanco +C----------------------------------------------------------------------- + SUBROUTINE HWHBGF +C----------------------------------------------------------------------- +C Order Alpha_s processes in charged lepton-hadron collisions +C +C Process code IPROC has to be set in the Main Program +C the following codes IPROC may be selected +C +C 9100 : NC BOSON-GLUON FUSION +C 9100+IQK (IQK=1,...,6) : produced flavour is IQK +C 9107 : produced J/psi + gluon +C +C 9110 : NC QCD COMPTON +C 9110+IQK (IQK=1,...,12) : struck parton is IQK +C +C 9130 : NC order alpha_s processes (9100+9110) +C +C Select maximum and minimum generated flavour when IQK=0 +C setting IFLMIN and IFLMAX in the Main Program +C (allowed values from 1 to 6), default are 1 and 5 +C allowing d,u,s,c,b,dbar,ubar,sbar,cbar,bbar +C +C CHARGED CURRENT Boson-Gluon Fusion processes +C 9141 : CC s cbar (c sbar) +C 9142 : CC b cbar (c bbar) +C 9143 : CC s tbar (t cbar) +C 9144 : CC b tbar (t bbar) +C +C other inputs : Q2MIN,Q2MAX,YBMIN,YBMAX,PTMIN,EMMIN,EMMAX +C when IPROC=(1)9107 : as above but Q2WWMN, Q2WWMX substitute +C Q2MIN and Q2MAX (EPA is used); ZJMAX cut +C +C Add 10000 to suppress soft remnant fragmentation +C +C Mean EVWGT = cross section in nanoBarn +C +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + DOUBLE PRECISION HWR,LEP,Y,Q2,SHAT,Z,PHI,AJACOB,DSIGMA,ME,MP, + & ML,MREMIF(18),MFIN1(18),MFIN2(18),RS,SMA,W2,RSHAT,FSIGMA(18), + & SIGSUM,PROB,PRAN,PVRT(4),X + INTEGER IQK,IFLAVU,IFLAVD,IMIN,IMAX,IFL,IPROO,LEPFIN,ID1,ID2,I,IDD + LOGICAL CHARGD,INCLUD(18),INSIDE(18) + EXTERNAL HWR + SAVE LEPFIN,ID1,ID2,FSIGMA,SIGSUM + COMMON /HWAREA/ LEP,Y,Q2,SHAT,Z,PHI,AJACOB,DSIGMA,ME,MP,ML,MREMIF, + & MFIN1,MFIN2,RS,SMA,W2,RSHAT,IQK,IFLAVU,IFLAVD,IMIN,IMAX,IFL, + & IPROO,CHARGD,INCLUD,INSIDE +C---Initialization + IF (FSTWGT) THEN +C---LEP = 1 FOR LEPTONS, -1 FOR ANTILEPTONS + LEP=ZERO + IF (IDHW(1).GE.121.AND.IDHW(1).LE.126) THEN + LEP=ONE + ELSEIF (IDHW(1).GE.127.AND.IDHW(1).LE.132) THEN + LEP=-ONE + ENDIF + IF (LEP.EQ.ZERO) CALL HWWARN('HWHBGF',500,*999) + IPROO=MOD(IPROC,100)/10 + IF (IPROO.EQ.0.OR.IPROO.EQ.4) THEN + IQK=MOD(IPROC,10) + IFL=IQK + IF (IQK.EQ.7) IFL=164 + CHARGD=IPROO.EQ.4 + ELSEIF (IPROO.EQ.1.OR.IPROO.EQ.2) THEN + IQK=MOD(IPROC,100)-10 + IFL=IQK+6 + CHARGD=.FALSE. + ELSEIF (IPROO.EQ.3) THEN + IQK=0 + IFL=0 + CHARGD=.FALSE. + ELSE + CALL HWWARN('HWHBGF',501,*999) + ENDIF +C + LEPFIN = IDHW(1) + IF(CHARGD) THEN + LEPFIN = IDHW(1)+1 + IF (IQK.EQ.1) THEN + IFLAVU=4 + IFLAVD=3 + ID1 = 3 + ID2 = 10 + ELSEIF (IQK.EQ.2) THEN + IFLAVU=4 + IFLAVD=5 + ID1 = 5 + ID2 = 10 + ELSEIF (IQK.EQ.3) THEN + IFLAVU=6 + IFLAVD=3 + ID1 = 3 + ID2 =12 + ELSE + IFLAVU=6 + IFLAVD=5 + ID1 = 5 + ID2 =12 + ENDIF + IF (LEP.EQ.-1.) THEN + IDD=ID1 + ID1=ID2-6 + ID2=IDD+6 + ENDIF + ENDIF +C + IF (IQK.EQ.0) THEN + DO I=1,18 + INCLUD(I)=.TRUE. + ENDDO + IMIN=1 + IMAX=18 + DO I=1,6 + IF (I.LT.IFLMIN.OR.I.GT.IFLMAX) INCLUD(I)=.FALSE. + ENDDO + DO I=7,18 + IF (I.LE.12) THEN + IF (I-6.LT.IFLMIN.OR.I-6.GT.IFLMAX) INCLUD(I)=.FALSE. + ELSE + IF (I-12.LT.IFLMIN.OR.I-12.GT.IFLMAX) INCLUD(I)=.FALSE. + ENDIF + ENDDO + IF (IPROO.EQ.0) THEN + DO I=7,18 + INCLUD(I)=.FALSE. + ENDDO + IMIN=IFLMIN + IMAX=IFLMAX + ELSEIF (IPROO.EQ.1.OR.IPROO.EQ.2) THEN + DO I=1,6 + INCLUD(I)=.FALSE. + ENDDO + IMIN=IFLMIN+6 + IMAX=IFLMAX+12 + ELSEIF (IPROO.EQ.3) THEN + IMIN=IFLMIN + IMAX=IFLMAX+12 + ENDIF + ELSEIF (IQK.NE.0 .AND. (.NOT.CHARGD)) THEN + DO I=1,18 + INCLUD(I)=.FALSE. + ENDDO + IF (IFL.LE.18) THEN + INCLUD(IFL)=.TRUE. + IMIN=IFL + IMAX=IFL + ELSEIF (IFL.EQ.164) THEN + INCLUD(7)=.TRUE. + IMIN=7 + IMAX=7 + ENDIF + ENDIF + ENDIF +C---End of initialization + IF(GENEV) THEN + IF (.NOT.CHARGD) THEN + IF (IQK.EQ.0) THEN + PRAN= SIGSUM * HWR() + PROB=ZERO + DO 10 IFL=IMIN,IMAX + IF (.NOT.INSIDE(IFL)) GOTO 10 + PROB=PROB+FSIGMA(IFL) + IF (PROB.GE.PRAN) GOTO 20 + 10 CONTINUE + ENDIF +C---at this point the subprocess has been selected (IFL) + 20 CONTINUE + IF (IFL.LE.6) THEN +C---Boson-Gluon Fusion event + IDHW(NHEP+1)=IDHW(1) + IDHW(NHEP+2)=13 + IDHW(NHEP+3)=15 + IDHW(NHEP+4)=LEPFIN + IDHW(NHEP+5)=IFL + IDHW(NHEP+6)=IFL+6 + ELSEIF (IFL.GE.7.AND.IFL.LE.18) THEN +C---QCD_Compton event + IDHW(NHEP+1)=IDHW(1) + IDHW(NHEP+2)=IFL-6 + IDHW(NHEP+3)=15 + IDHW(NHEP+4)=LEPFIN + IDHW(NHEP+5)=IFL-6 + IDHW(NHEP+6)=13 + ELSEIF (IFL.EQ.164) THEN +C---gamma+gluon-->J/Psi+gluon + IDHW(NHEP+1)=IDHW(1) + IDHW(NHEP+2)=13 + IDHW(NHEP+3)=15 + IDHW(NHEP+4)=LEPFIN + IDHW(NHEP+5)=164 + IDHW(NHEP+6)=13 + ELSE + CALL HWWARN('HWHBGF',503,*999) + ENDIF + ELSE +C---Charged current event of specified flavours + IDHW(NHEP+1)=IDHW(1) + IDHW(NHEP+2)=13 + IDHW(NHEP+3)=15 + IDHW(NHEP+4)=LEPFIN + IDHW(NHEP+5)=ID1 + IDHW(NHEP+6)=ID2 + ENDIF +C + DO 1 I=NHEP+1,NHEP+6 + 1 IDHEP(I)=IDPDG(IDHW(I)) +C +C---Codes common for all processes + ISTHEP(NHEP+1)=111 + ISTHEP(NHEP+2)=112 + ISTHEP(NHEP+3)=110 + ISTHEP(NHEP+4)=113 + ISTHEP(NHEP+5)=114 + ISTHEP(NHEP+6)=114 +C + DO I=NHEP+1,NHEP+6 + JMOHEP(1,I)=NHEP+3 + JDAHEP(1,I)=0 + ENDDO +C---Incoming lepton + JMOHEP(2,NHEP+1)=NHEP+4 + JDAHEP(2,NHEP+1)=NHEP+4 +C---Hard Process C.M. + JMOHEP(1,NHEP+3)=NHEP+1 + JMOHEP(2,NHEP+3)=NHEP+2 + JDAHEP(1,NHEP+3)=NHEP+4 + JDAHEP(2,NHEP+3)=NHEP+6 +C---Outgoing lepton + JMOHEP(2,NHEP+4)=NHEP+1 + JDAHEP(2,NHEP+4)=NHEP+1 +C + IF (IFL.LE.6 .OR. CHARGD) THEN +C---Codes for boson-gluon fusion processes +C--- Incoming gluon + JMOHEP(2,NHEP+2)=NHEP+6 + JDAHEP(2,NHEP+2)=NHEP+5 +C--- Outgoing quark + JMOHEP(2,NHEP+5)=NHEP+2 + JDAHEP(2,NHEP+5)=NHEP+6 +C--- Outgoing antiquark + JMOHEP(2,NHEP+6)=NHEP+5 + JDAHEP(2,NHEP+6)=NHEP+2 + ELSEIF (IFL.GE.7 .AND. IFL.LE.12) THEN +C---Codes for V+q --> q+g +C--- Incoming quark + JMOHEP(2,NHEP+2)=NHEP+5 + JDAHEP(2,NHEP+2)=NHEP+6 +C--- Outgoing quark + JMOHEP(2,NHEP+5)=NHEP+6 + JDAHEP(2,NHEP+5)=NHEP+2 +C--- Outgoing gluon + JMOHEP(2,NHEP+6)=NHEP+2 + JDAHEP(2,NHEP+6)=NHEP+5 + ELSEIF (IFL.GE.13 .AND. IFL.LE.18) THEN +C---Codes for V+qbar --> qbar+g +C--- Incoming antiquark + JMOHEP(2,NHEP+2)=NHEP+6 + JDAHEP(2,NHEP+2)=NHEP+5 +C--- Outgoing antiquark + JMOHEP(2,NHEP+5)=NHEP+2 + JDAHEP(2,NHEP+5)=NHEP+6 +C--- Outgoing gluon + JMOHEP(2,NHEP+6)=NHEP+5 + JDAHEP(2,NHEP+6)=NHEP+2 + ELSEIF (IFL.EQ.164) THEN +C---Codes for Gamma+gluon --> J/Psi+gluon +C--- Incoming gluon + JMOHEP(2,NHEP+2)=NHEP+6 + JDAHEP(2,NHEP+2)=NHEP+6 +C--- Outgoing J/Psi + JMOHEP(2,NHEP+5)=NHEP+1 + JDAHEP(2,NHEP+5)=NHEP+1 +C--- Outgoing gluon + JMOHEP(2,NHEP+6)=NHEP+2 + JDAHEP(2,NHEP+6)=NHEP+2 + ENDIF +C---Computation of momenta in Laboratory frame of reference + CALL HWHBKI + NHEP=NHEP+6 +C Decide which quark radiated and assign production vertices + IF (IFL.LE.6) THEN +C Boson-Gluon fusion case + IF (1-Z.LT.HWR()) THEN +C Gluon splitting to quark + CALL HWVZRO(4,VHEP(1,NHEP-1)) + CALL HWVDIF(4,PHEP(1,NHEP-4),PHEP(1,NHEP),PVRT) + CALL HWUDKL(IFL,PVRT,VHEP(1,NHEP)) + CALL HWVEQU(4,VHEP(1,NHEP),VHEP(1,NHEP-4)) + ELSE +C Gluon splitting to antiquark + CALL HWVZRO(4,VHEP(1,NHEP)) + CALL HWVDIF(4,PHEP(1,NHEP-4),PHEP(1,NHEP-1),PVRT) + CALL HWUDKL(IFL,PVRT,VHEP(1,NHEP-1)) + CALL HWVEQU(4,VHEP(1,NHEP-1),VHEP(1,NHEP-4)) + ENDIF + ELSEIF (IFL.GE.7.AND.IFL.LE.18) THEN +C QCD Compton case + X=1/(1+SHAT/Q2) + IF (1.LT.HWR()*(1+(1-X-Z)**2+6*X*(1-X)*Z*(1-Z))) THEN +C Incoming quark radiated the gluon + CALL HWVZRO(4,VHEP(1,NHEP-1)) + CALL HWVDIF(4,PHEP(1,NHEP-4),PHEP(1,NHEP),PVRT) + CALL HWUDKL(IFL-6,PVRT,VHEP(1,NHEP)) + CALL HWVEQU(4,VHEP(1,NHEP),VHEP(1,NHEP-4)) + ELSE +C Outgoing quark radiated the gluon + CALL HWVZRO(4,VHEP(1,NHEP-4)) + CALL HWVSUM(4,PHEP(1,NHEP-1),PHEP(1,NHEP),PVRT) + CALL HWUDKL(IFL-6,PVRT,VHEP(1,NHEP)) + CALL HWVEQU(4,VHEP(1,NHEP),VHEP(1,NHEP-1)) + ENDIF + ENDIF +C---HERWIG gets confused if lepton momentum is different from beam +C momentum, which it can be if incoming hadron has negative virtuality +C As a temporary fix, simply copy the momentum. +C Momentum conservation somehow gets taken care of HWBGEN! + call hwvequ(5,phep(1,1),phep(1,nhep-5)) + ELSE + EVWGT=ZERO +C---generation of the 5 variables Y,Q2,SHAT,Z,PHI and Jacobian computation +C---in the largest phase space avalaible for selected processes and +C---filling of logical vector INSIDE to tag contributing ones + CALL HWHBRN (*999) +C---calculate differential cross section corresponding to the chosen +C---variables and the weight for MC generation + IF (IQK.EQ.0) THEN +C---many subprocesses included + DO I=1,18 + FSIGMA(I)=ZERO + ENDDO + SIGSUM=ZERO + DO I=IMIN,IMAX + IF (INSIDE(I)) THEN + IFL=I + DSIGMA=ZERO + CALL HWHBSG + FSIGMA(I)=DSIGMA + SIGSUM=SIGSUM+DSIGMA + ENDIF + ENDDO + EVWGT=SIGSUM * AJACOB + ELSE +C---only one subprocess included + CALL HWHBSG + EVWGT= DSIGMA * AJACOB + ENDIF + IF (EVWGT.LT.ZERO) EVWGT=ZERO + ENDIF + 999 END +CDECK ID>, HWHBKI. +*CMZ :- -26/04/91 13.19.32 by Federico Carminati +*-- Author : Giovanni Abbiendi & Luca Stanco +C---------------------------------------------------------------------- + SUBROUTINE HWHBKI +C---------------------------------------------------------------------- +C gives the fourmomenta in the laboratory system for the particles +C of the hard 2-->3 subprocess, to match with HERWIG routines of +C jet evolution. +C---------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + DOUBLE PRECISION HWUECM,HWUPCM,HWUSQR,LEP,Y,Q2,SHAT,Z,PHI,AJACOB, + & DSIGMA,ME,MP,ML,MREMIF(18),MFIN1(18),MFIN2(18),RS,SMA,W2,RSHAT, + & PGAMMA(5),SG,MF1,MF2,EP,PP,EL,PL,E1,E2,Q1,COSBET,SINBET,COSTHE, + & SINTHE,SINAZI,COSAZI,ROTAZI(3,3),EGAM,A,PPROT,MREMIN,PGAM,PEP(5), + & COSPHI,SINPHI,ROT(3,3),EPROT,PROTON(5),MPART + INTEGER IQK,IFLAVU,IFLAVD,IMIN,IMAX,IFL,IPROO,I,IHAD,J,IS,ICMF + LOGICAL CHARGD,INCLUD(18),INSIDE(18) + EXTERNAL HWUECM,HWUPCM,HWUSQR + COMMON /HWAREA/ LEP,Y,Q2,SHAT,Z,PHI,AJACOB,DSIGMA,ME,MP,ML,MREMIF, + & MFIN1,MFIN2,RS,SMA,W2,RSHAT,IQK,IFLAVU,IFLAVD,IMIN,IMAX,IFL, + & IPROO,CHARGD,INCLUD,INSIDE +C + IHAD=2 + IF (JDAHEP(1,IHAD).NE.0) IHAD=JDAHEP(1,IHAD) +C---Set masses + IF (CHARGD) THEN + MPART=ZERO + MF1=RMASS(IDHW(NHEP+5)) + MF2=RMASS(IDHW(NHEP+6)) + MREMIN=MP + ELSE + IS = IFL + IF (IFL.EQ.164) IS=IQK + MPART=ZERO + IF (IFL.GE.7.AND.IFL.LE.18) MPART=RMASS(IFL-6) + MF1=MFIN1(IS) + MF2=MFIN2(IS) + MREMIN = MREMIF(IS) + ENDIF +C---Calculation of kinematical variables for the generated event +C in the center of mass frame of the incoming boson and parton +C with parton along +z + EGAM = HWUECM (SHAT, -Q2, MPART**2) + PGAM = SQRT( EGAM**2 + Q2 ) + EP = RSHAT-EGAM + PP = PGAM + A = (W2+Q2-MP**2)/TWO + PPROT = (A*PGAM-EGAM*SQRT(A**2+MP**2*Q2))/Q2 + IF (PPROT.LT.ZERO) CALL HWWARN('HWHBKI',101,*999) + EPROT = SQRT(PPROT**2+MP**2) + IF ((EPROT+PPROT).LT.(EP+PP)) CALL HWWARN('HWHBKI',102,*999) + EL = ( PGAM / PPROT * SMA - Q2 ) / TWO + + / (EGAM + PGAM / PPROT * EPROT) + IF (EL.GT.ME) THEN + PL = SQRT ( EL**2 - ME**2 ) + ELSE + CALL HWWARN ('HWHBKI',103,*999) + ENDIF + COSBET = (TWO * EPROT * EL - SMA) / (TWO * PPROT * PL) + IF ( ABS(COSBET) .GE. ONE ) THEN + COSBET = SIGN (ONE,COSBET) + SINBET = ZERO + ELSE + SINBET = SQRT (ONE - COSBET**2) + ENDIF + SG = ME**2 + MPART**2 + Q2 + TWO * RSHAT * EL + IF (SG.LE.(RSHAT+ML)**2 .OR. SG.GE.(RS-MREMIN)**2) + + CALL HWWARN ('HWHBKI',104,*999) + Q1 = HWUPCM( RSHAT, MF1, MF2) + E1 = SQRT(Q1**2+MF1**2) + E2 = SQRT(Q1**2+MF2**2) + IF (Q1 .GT. ZERO) THEN + COSTHE=(TWO*EP*E1 - Z*(SHAT+Q2))/(TWO*PP*Q1) + IF (ABS(COSTHE) .GT. ONE) THEN + COSTHE=SIGN(ONE,COSTHE) + SINTHE=ZERO + ELSE + SINTHE=SQRT(ONE-COSTHE**2) + ENDIF + ELSE + COSTHE=ZERO + SINTHE=ONE + ENDIF +C---Initial lepton + PHEP(1,NHEP+1)=PL*SINBET + PHEP(2,NHEP+1)=ZERO + PHEP(3,NHEP+1)=PL*COSBET + PHEP(4,NHEP+1)=EL + PHEP(5,NHEP+1)=RMASS(IDHW(1)) +C---Initial Hadron + PROTON(1)=ZERO + PROTON(2)=ZERO + PROTON(3)=PPROT + PROTON(4)=EPROT + CALL HWUMAS (PROTON) +C---Initial parton + PHEP(1,NHEP+2)=ZERO + PHEP(2,NHEP+2)=ZERO + PHEP(3,NHEP+2)=PP + PHEP(4,NHEP+2)=EP + PHEP(5,NHEP+2)=MPART +C---HARD SUBPROCESS 2-->3 CENTRE OF MASS + PHEP(1,NHEP+3)=PHEP(1,NHEP+1)+PHEP(1,NHEP+2) + PHEP(2,NHEP+3)=PHEP(2,NHEP+1)+PHEP(2,NHEP+2) + PHEP(3,NHEP+3)=PHEP(3,NHEP+1)+PHEP(3,NHEP+2) + PHEP(4,NHEP+3)=PHEP(4,NHEP+1)+PHEP(4,NHEP+2) + CALL HWUMAS ( PHEP(1,NHEP+3) ) +C---Virtual boson + PGAMMA(1)=ZERO + PGAMMA(2)=ZERO + PGAMMA(3)=-PGAM + PGAMMA(4)=EGAM + PGAMMA(5)=HWUSQR(Q2) +C---Scattered lepton + PHEP(1,NHEP+4)=PHEP(1,NHEP+1)-PGAMMA(1) + PHEP(2,NHEP+4)=PHEP(2,NHEP+1)-PGAMMA(2) + PHEP(3,NHEP+4)=PHEP(3,NHEP+1)-PGAMMA(3) + PHEP(4,NHEP+4)=PHEP(4,NHEP+1)-PGAMMA(4) + PHEP(5,NHEP+4)=RMASS(IDHW(1)) + IF (CHARGD) PHEP(5,NHEP+4)=ZERO +C---First Final parton: quark (or J/psi) in Boson-Gluon Fusion +C--- quark or antiquark in QCD Compton + PHEP(1,NHEP+5)=Q1*SINTHE*COS(PHI) + PHEP(2,NHEP+5)=Q1*SINTHE*SIN(PHI) + PHEP(3,NHEP+5)=Q1*COSTHE + PHEP(4,NHEP+5)=E1 + PHEP(5,NHEP+5)=MF1 +C---Second Final parton: antiquark in Boson-Gluon Fusion +C--- gluon in QCD Compton + PHEP(1,NHEP+6)=-PHEP(1,NHEP+5) + PHEP(2,NHEP+6)=-PHEP(2,NHEP+5) + PHEP(3,NHEP+6)=-PHEP(3,NHEP+5) + PHEP(4,NHEP+6)=E2 + PHEP(5,NHEP+6)=MF2 +C---Boost to lepton-hadron CM frame + PEP(1) = PHEP(1,NHEP+1) + PEP(2) = PHEP(2,NHEP+1) + PEP(3) = PHEP(3,NHEP+1) + PPROT + PEP(4) = PHEP(4,NHEP+1) + EPROT + CALL HWUMAS (PEP) + DO I=1,6 + CALL HWULOF (PEP,PHEP(1,NHEP+I),PHEP(1,NHEP+I)) + ENDDO + CALL HWULOF (PEP,PROTON,PROTON) + CALL HWULOF (PEP,PGAMMA,PGAMMA) +C---Rotation around y-axis to align lepton beam with z-axis + COSPHI = PHEP(3,NHEP+1) / + & SQRT( PHEP(1,NHEP+1)**2 + PHEP(3,NHEP+1)**2 ) + SINPHI = PHEP(1,NHEP+1) / + & SQRT( PHEP(1,NHEP+1)**2 + PHEP(3,NHEP+1)**2 ) + DO I=1,3 + DO J=1,3 + ROT(I,J)=ZERO + ENDDO + ENDDO + ROT(1,1) = COSPHI + ROT(1,3) = -SINPHI + ROT(2,2) = ONE + ROT(3,1) = SINPHI + ROT(3,3) = COSPHI + DO I=1,6 + CALL HWUROF (ROT,PHEP(1,NHEP+I),PHEP(1,NHEP+I)) + ENDDO + CALL HWUROF (ROT,PROTON,PROTON) + CALL HWUROF (ROT,PGAMMA,PGAMMA) +C---Boost to the LAB frame + ICMF=3 + DO I=1,6 + CALL HWULOB (PHEP(1,ICMF),PHEP(1,NHEP+I),PHEP(1,NHEP+I)) + ENDDO + CALL HWULOB (PHEP(1,ICMF),PROTON,PROTON) + CALL HWULOB (PHEP(1,ICMF),PGAMMA,PGAMMA) +C---Random azimuthal rotation + CALL HWRAZM (ONE,COSAZI,SINAZI) + DO I=1,3 + DO J=1,3 + ROTAZI(I,J)=ZERO + ENDDO + ENDDO + ROTAZI(1,1) = COSAZI + ROTAZI(1,2) = SINAZI + ROTAZI(2,1) = -SINAZI + ROTAZI(2,2) = COSAZI + ROTAZI(3,3) = ONE + DO I=1,6 + CALL HWUROF (ROTAZI,PHEP(1,NHEP+I),PHEP(1,NHEP+I)) + ENDDO + CALL HWUROF (ROTAZI,PROTON,PROTON) + CALL HWUROF (ROTAZI,PGAMMA,PGAMMA) + 999 END +CDECK ID>, HWHBRN. +*CMZ :- -03/07/95 19.02.12 by Giovanni Abbiendi +*-- Author : Giovanni Abbiendi & Luca Stanco +C----------------------------------------------------------------------- + SUBROUTINE HWHBRN (*) +C---------------------------------------------------------------------- +C Returns a point in the phase space (Y,Q2,SHAT,Z,PHI) and the +C corresponding Jacobian factor AJACOB +C Fill the logical vector INSIDE to tag contributing subprocesses +C to the cross-section +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + DOUBLE PRECISION HWRUNI,HWR,HWUPCM,LEP,Y,Q2,SHAT,Z,PHI,AJACOB, + & DSIGMA,ME,MP,ML,MREMIF(18),MFIN1(18),MFIN2(18),RS,SMA,W2,RSHAT, + & MF1,MF2,YMIN,YMAX,YJAC,Q2INF,Q2SUP,Q2JAC,EMW2,ZMIN,ZMAX,ZJAC, + & GAMMA2,LAMBDA,PHIJAC,ZINT,ZLMIN,ZL,EMW,TMIN,TMAX,EMLMIN,EMLMAX, + & SHMIN,EMMIF(18),EMMAF(18),WMIF(18),WMIN,MREMIN,YMIF(18),Q1CM(18), + & Q2MAF(18),EMMAWF(18),ZMIF(18),ZMAF(18),PLMAX,PINC,SHINF,SHSUP, + & SHJAC,CTHLIM,Q1,DETDSH,SRY,SRY0,SRY1 + INTEGER IQK,IFLAVU,IFLAVD,I,IMIN,IMAX,IFL,IPROO,IHAD,NTRY,DEBUG + LOGICAL CHARGD,INCLUD(18),INSIDE(18) + EXTERNAL HWRUNI,HWR,HWUPCM + SAVE EMLMIN,EMLMAX,EMMIF,EMMAF,MREMIN,MF1,MF2,YMIF, + & YMIN,YMAX,WMIN,WMIF + COMMON /HWAREA/ LEP,Y,Q2,SHAT,Z,PHI,AJACOB,DSIGMA,ME,MP,ML,MREMIF, + & MFIN1,MFIN2,RS,SMA,W2,RSHAT,IQK,IFLAVU,IFLAVD,IMIN,IMAX,IFL, + & IPROO,CHARGD,INCLUD,INSIDE + EQUIVALENCE (EMW,RMASS(198)) +C + IHAD=2 + IF (JDAHEP(1,IHAD).NE.0) IHAD=JDAHEP(1,IHAD) +C---Initialization + IF (FSTWGT.OR.IHAD.NE.2) THEN + ME = RMASS(IDHW(1)) + MP = RMASS(IDHW(IHAD)) + RS = PHEP(5,3) + SMA = RS**2-ME**2-MP**2 + PINC = HWUPCM(RS,ME,MP) +C---Charged current + IF (CHARGD) THEN + ML=RMASS(IDHW(1)+1) + YMAX = ONE - TWO*ML*MP / SMA + YMAX = MIN(YMAX,YBMAX) + MREMIN=MP + IF (LEP.EQ.ONE) THEN + MF1=RMASS(IFLAVD) + MF2=RMASS(IFLAVU) + ELSE + MF1=RMASS(IFLAVU) + MF2=RMASS(IFLAVD) + ENDIF + SHMIN = MF1**2+MF2**2 + TWO * PTMIN**2 + + + TWO * SQRT(PTMIN**2+MF1**2) * SQRT(PTMIN**2+MF2**2) + EMLMIN=MAX(EMMIN,SQRT(SHMIN)) + EMLMAX=MIN(EMMAX,RS-ML-MREMIN) + DEBUG=1 + IF (EMLMIN.GT.EMLMAX) GOTO 888 + WMIN=EMLMIN+MREMIN + PLMAX=HWUPCM(RS,ML,WMIN) + YMIN = ONE-TWO*(SQRT(PINC**2+MP**2)*SQRT(PLMAX**2+ML**2)+ + + PINC*PLMAX)/SMA + YMIN = MAX(YMIN,YBMIN) + DEBUG=2 + IF (YMIN.GT.YMAX) GOTO 888 + ELSE +C---Neutral current + ML = ME + YMAX = ONE - TWO*ML*MP / SMA + YMAX = MIN(YMAX,YBMAX) + DO I=1,18 + YMIF(I)=ZERO + EMMIF(I)=ZERO + EMMAF(I)=ZERO + WMIF(I)=ZERO + IF (I.LE.8) THEN +C---Boson-Gluon Fusion (also J/Psi) and QCD Compton with struck u or d + MREMIF(I)=MP + IF (I.LE.6) THEN + MFIN1(I)=RMASS(I) + MFIN2(I)=RMASS(I+6) + ELSE + MFIN1(I)=RMASS(I-6) + MFIN2(I)=ZERO + ENDIF + ELSE +C---QCD Compton with struck non-valence parton + MREMIF(I)=MP+RMASS(I-6) + MFIN1(I)=RMASS(I-6) + MFIN2(I)=ZERO + ENDIF + ENDDO + IF (IFL.EQ.164) THEN +C---J/Psi + MFIN1(7)=RMASS(164) + MFIN2(7)=ZERO + ENDIF +C---y boundaries for different flavours and processes + DO 100 I=IMIN,IMAX + IF (INCLUD(I)) THEN + MF1=MFIN1(I) + MF2=MFIN2(I) + MREMIN=MREMIF(I) + SHMIN = MF1**2+MF2**2 + TWO * PTMIN**2 + + + TWO * SQRT(PTMIN**2+MF1**2) * SQRT(PTMIN**2+MF2**2) + EMMIF(I) = MAX(EMMIN,SQRT(SHMIN)) + EMMAF(I) = MIN(EMMAX,RS-ML-MREMIN) + IF (EMMIF(I).GT.EMMAF(I)) THEN + INCLUD(I)=.FALSE. + CALL HWWARN('HWHBRN',3,*999) + GOTO 100 + ENDIF + WMIF(I) = EMMIF(I)+MREMIF(I) + WMIN = WMIF(I) + PLMAX = HWUPCM(RS,ML,WMIN) + YMIF(I)=ONE-TWO*(SQRT(PINC**2+MP**2)*SQRT(PLMAX**2+ML**2)+ + + PINC*PLMAX)/SMA + IF (YMIF(I).GT.YMAX) THEN + INCLUD(I)=.FALSE. + CALL HWWARN('HWHBRN',4,*999) + GOTO 100 + ENDIF + ENDIF + 100 CONTINUE +C---considering the largest boundaries + EMLMIN=EMMIF(IMIN) + EMLMAX=EMMAF(IMIN) + IF (IPROO.EQ.3) THEN + EMLMIN=MIN(EMMIF(IMIN),EMMIF(IMIN+6)) + EMLMAX=MAX(EMMAF(IMIN),EMMAF(IMIN+6)) + ENDIF + DEBUG=3 + IF (EMLMIN.GT.EMLMAX) GOTO 888 + YMIN=YMIF(IMIN) + IF (IPROO.EQ.3) YMIN=MIN(YMIF(IMIN),YMIF(IMIN+6)) + YMIN = MAX(YMIN,YBMIN) + DEBUG=4 + IF (YMIN.GT.YMAX) GOTO 888 + WMIN = WMIF(IMIN) + MREMIN = MREMIF(IMIN) + MF1=MFIN1(IMIN) + MF2=MFIN2(IMIN) + IF (IPROO.EQ.3) THEN + WMIN = MIN(WMIF(IMIN),WMIF(IMIN+6)) + MREMIN = MIN(MREMIF(IMIN),MREMIF(IMIN+6)) + ENDIF + ENDIF + ENDIF +C---Random generation in largest phase space + Y=ZERO + Q2=ZERO + SHAT=ZERO + Z=ZERO + PHI=ZERO + AJACOB=ZERO +C---y generation + IF (.NOT.CHARGD) THEN + IF (IFL.LE.5.OR.(IFL.GE.7.AND.IFL.LE.18)) THEN + SRY0 = SQRT(YMIN) + SRY1 = SQRT(YMAX) + SRY = HWRUNI(0,SRY0,SRY1) + Y = SRY**2 + YJAC = TWO*SRY*(SRY1-SRY0) + ELSEIF (IFL.EQ.6) THEN + Y = SQRT(HWRUNI(0,YMIN**2,YMAX**2)) + YJAC = HALF * (YMAX**2-YMIN**2) / Y + ELSEIF (IFL.EQ.164) THEN +C---in J/psi photoproduction Y and Q2 are given by the Equivalent Photon +C Approximation + 10 NTRY=0 + 20 NTRY=NTRY+1 + IF (NTRY.GT.NETRY) CALL HWWARN('HWHBRN',50,*10) + Y = (YMIN/YMAX)**HWR()*YMAX + IF (ONE+(ONE-Y)**2.LT.TWO*HWR()) GOTO 20 + YJAC=(TWO*LOG(YMAX/YMIN)-TWO*(YMAX-YMIN) + & +HALF*(YMAX**2-YMIN**2)) + ENDIF + ELSE + IF (IPRO.EQ.5) THEN + Y = EXP(HWRUNI(0,LOG(YMIN),LOG(YMAX))) + YJAC = Y * LOG(YMAX/YMIN) + ELSE + Y = HWRUNI(0,YMIN,YMAX) + YJAC = YMAX - YMIN + ENDIF + ENDIF +C---Q**2 generation + Q2INF = ME**2*Y**2 / (ONE-Y) + Q2SUP = MP**2 + SMA*Y - WMIN**2 + IF (IFL.EQ.164) THEN + Q2INF = MAX(Q2INF,Q2WWMN) + Q2SUP = MIN(Q2SUP,Q2WWMX) + ELSE + Q2INF = MAX(Q2INF,Q2MIN) + Q2SUP = MIN(Q2SUP,Q2MAX) + ENDIF + DEBUG=5 + IF (Q2INF .GT. Q2SUP) GOTO 888 +C + IF (.NOT.CHARGD) THEN + IF (IFL.EQ.164) THEN + Q2 = EXP(HWRUNI(0,LOG(Q2INF),LOG(Q2SUP))) + Q2JAC = LOG(Q2SUP/Q2INF) + ELSEIF (Q2INF.LT.RMASS(4)**2) THEN + Q2 = EXP(HWRUNI(0,LOG(Q2INF),LOG(Q2SUP))) + Q2JAC = Q2 * LOG(Q2SUP/Q2INF) + ELSE + Q2 = Q2INF*Q2SUP/HWRUNI(0,Q2INF,Q2SUP) + Q2JAC = Q2**2 * (Q2SUP-Q2INF)/(Q2SUP*Q2INF) + ENDIF + ELSE + EMW2=EMW**2 + Q2=(Q2INF+EMW2)*(Q2SUP+EMW2)/(HWRUNI(0,Q2INF,Q2SUP)+EMW2)-EMW2 + Q2JAC=(Q2+EMW2)**2*(Q2SUP-Q2INF)/((Q2SUP+EMW2)*(Q2INF+EMW2)) + ENDIF + W2 = MP**2 + SMA*Y - Q2 +C---s_hat generation + SHINF = EMLMIN **2 + SHSUP = (MIN(SQRT(W2)-MREMIN,EMLMAX))**2 + DEBUG=6 + IF (SHINF .GT. SHSUP) GOTO 888 +C + IF (IPRO.EQ.91) THEN + IF (.NOT.CHARGD) THEN + SHAT = SHINF*SHSUP/HWRUNI(0,SHINF,SHSUP) + SHJAC = SHAT**2 * (SHSUP-SHINF)/(SHSUP*SHINF) + ELSE + SHAT = EXP(HWRUNI(0,LOG(SHINF),LOG(SHSUP))) + SHJAC = SHAT*(LOG(SHSUP/SHINF)) + ENDIF + ELSE + EMW2=EMW**2 + IF (SHINF.GT.EMW2+10*GAMW*EMW) THEN + SHAT = SHINF*SHSUP/HWRUNI(0,SHINF,SHSUP) + SHJAC = SHAT**2 * (SHSUP-SHINF)/(SHSUP*SHINF) + ELSEIF (SHSUP.LT.EMW2-10*EMW*GAMW) THEN + SHAT = HWRUNI(0,SHINF,SHSUP) + SHJAC = SHSUP-SHINF + ELSE + TMIN=ATAN((SHINF-EMW2)/(GAMW*EMW)) + TMAX=ATAN((SHSUP-EMW2)/(GAMW*EMW)) + SHAT = GAMW*EMW*TAN(HWRUNI(0,TMIN,TMAX))+EMW2 + SHJAC=((SHAT-EMW2)**2+(GAMW*EMW)**2)/(GAMW*EMW)*(TMAX-TMIN) + ENDIF + ENDIF + DETDSH = ONE/SMA/Y + SHJAC=SHJAC*DETDSH + RSHAT = SQRT (SHAT) +C--- z generation + ZMIN = 10E10 + ZMAX = -ONE + IF (.NOT.CHARGD) THEN + DO I=1,18 + Q1CM(I) = ZERO + ZMIF(I) = ZERO + ZMAF(I) = ZERO + ENDDO + DO 150 I=IMIN,IMAX + IF (INCLUD(I)) THEN + Q1CM(I) = HWUPCM( RSHAT, MFIN1(I), MFIN2(I) ) + IF (Q1CM(I) .LT. PTMIN) THEN + ZMAF(I)=-ONE + GOTO 150 + ENDIF + CTHLIM = SQRT(ONE - (PTMIN / Q1CM(I))**2) + GAMMA2 = SHAT + MFIN1(I)**2 - MFIN2(I)**2 + LAMBDA = (SHAT-MFIN1(I)**2-MFIN2(I)**2)**2 - + + 4.D0*MFIN1(I)**2*MFIN2(I)**2 + ZMIF(I) = (GAMMA2 - SQRT(LAMBDA)*CTHLIM)/TWO/SHAT + ZMIF(I) = MAX(ZMIF(I),ZERO) + ZMAF(I) = (GAMMA2 + SQRT(LAMBDA)*CTHLIM)/TWO/SHAT + ZMAF(I) = MIN(ZMAF(I),ONE) + ZMIN = MIN( ZMIN, ZMIF(I) ) + ZMAX = MAX( ZMAX, ZMAF(I) ) + ENDIF + 150 CONTINUE + IF (IFL.EQ.164) ZMAX=MIN(ZMAX,ZJMAX) + ELSE + Q1 = HWUPCM(RSHAT,MF1,MF2) + DEBUG=7 + IF (Q1.LT.PTMIN) GOTO 888 + CTHLIM = SQRT(ONE-(PTMIN/Q1)**2) + GAMMA2 = SHAT+MF1**2-MF2**2 + LAMBDA = (SHAT-MF1**2-MF2**2)**2-4.D0*MF1**2*MF2**2 + ZMIN = (GAMMA2-SQRT(LAMBDA)*CTHLIM)/TWO/SHAT + ZMIN = MAX(ZMIN,1D-6) + ZMAX = (GAMMA2+SQRT(LAMBDA)*CTHLIM)/TWO/SHAT + ZMAX = MIN(ZMAX,ONE-1D-6) + ENDIF + DEBUG=8 + IF (ZMIN .GT. ZMAX) GOTO 888 + ZLMIN = LOG(ZMIN/(ONE-ZMIN)) + ZINT = LOG(ZMAX/(ONE-ZMAX)) - LOG(ZMIN/(ONE-ZMIN)) + ZL = ZLMIN+HWR()*ZINT + Z = EXP(ZL)/(ONE+EXP(ZL)) + ZJAC = Z*(ONE-Z)*ZINT +C + DEBUG=9 + IF ((Y.LT.YMIN.OR.Y.GT.YMAX).OR.(Q2.LT.Q2INF.OR.Q2.GT.Q2SUP).OR. + + (SHAT.LT.SHINF.OR.SHAT.GT.SHSUP).OR.(Z.LT.ZMIN.OR.Z.GT.ZMAX)) + + GOTO 888 +C---Phi generation + PHI = HWRUNI(0,ZERO,2*PIFAC) + PHIJAC = 2 * PIFAC + IF (IFL.EQ.164) PHIJAC=ONE +C + AJACOB = YJAC * Q2JAC * SHJAC * ZJAC * PHIJAC +C + IF (IQK.NE.0.OR.IPRO.EQ.5) GOTO 999 +C---contributing subprocesses: filling of logical vector INSIDE + DO I=1,18 + INSIDE(I)=.FALSE. + Q2MAF(I)=ZERO + EMMAWF(I)=ZERO + ENDDO + DO 200 I=IMIN,IMAX + IF (INCLUD(I)) THEN + IF ( Y.LT.YMIF(I) ) GOTO 200 +C + Q2MAF(I) = MP**2 + SMA*Y - WMIF(I)**2 + Q2MAF(I) = MIN( Q2MAF(I), Q2MAX) + IF (Q2INF .GT. Q2MAF(I)) GOTO 200 + IF (Q2.LT.Q2INF .OR. Q2.GT.Q2MAF(I)) GOTO 200 +C + EMMAWF(I) = SQRT(W2) - MREMIF(I) + EMMAWF(I) = MIN( EMMAWF(I), EMLMAX ) +C + IF (EMMIF(I) .GT. EMMAWF(I)) GOTO 200 + IF (SHAT.LT.EMMIF(I)**2.OR.SHAT.GT.EMMAWF(I)**2) GOTO 200 +C + IF (ZMIF(I) .GT. ZMAF(I)) GOTO 200 + IF (Z.LT.ZMIF(I) .OR. Z.GT.ZMAF(I)) GOTO 200 + INSIDE(I)=.TRUE. + ENDIF + 200 CONTINUE + 999 RETURN + 888 EVWGT=ZERO +C---UNCOMMENT THIS LINE TO GET A DEBUGGING WARNING FOR NO PHASE-SPACE +C CALL HWWARN('HWHBRN',DEBUG,*777) + 777 RETURN 1 + END +CDECK ID>, HWHBSG. +*CMZ :- -03/07/95 19.02.12 by Giovanni Abbiendi +*-- Author : Giovanni Abbiendi & Luca Stanco +C---------------------------------------------------------------------- + SUBROUTINE HWHBSG +C---------------------------------------------------------------------- +C Returns differential cross section DSIGMA in (Y,Q2,ETA,Z,PHI) +C Scale for structure functions and alpha_s selected by BGSHAT +C---------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + DOUBLE PRECISION HWUALF,HWUAEM,LEP,Y,Q2,SHAT,Z,PHI,AJACOB,DSIGMA, + & ME,MP,ML,MREMIF(18),MFIN1(18),MFIN2(18),RS,SMA,W2,RSHAT, + & SFUN(13),ALPHA,LDSIG,DLQ(7),SG,XG,MF1,MF2,MSUM,MDIF,MPRO,FFUN, + & GFUN,H43,H41,H11,H12,H14,H16,H21,H22,G11,G12,G1A,G1B,G21,G22,G3, + & GC,A11,A12,A44,ALPHAS,PDENS,AFACT,BFACT,CFACT,DFACT,GAMMA,S,T,U, + & MREMIN,POL,CCOL,ETA + INTEGER IQK,IFLAVU,IFLAVD,IMIN,IMAX,IFL,IPROO,IHAD,ILEPT,IQ,IS + LOGICAL CHARGD,INCLUD(18),INSIDE(18) + EXTERNAL HWUALF,HWUAEM + COMMON /HWAREA/ LEP,Y,Q2,SHAT,Z,PHI,AJACOB,DSIGMA,ME,MP,ML,MREMIF, + & MFIN1,MFIN2,RS,SMA,W2,RSHAT,IQK,IFLAVU,IFLAVD,IMIN,IMAX,IFL, + & IPROO,CHARGD,INCLUD,INSIDE +C + IHAD=2 + IF (JDAHEP(1,IHAD).NE.0) IHAD=JDAHEP(1,IHAD) +C---set masses + IF (CHARGD) THEN + MREMIN=MP + IF (LEP.EQ.ONE) THEN + MF1=RMASS(IFLAVD) + MF2=RMASS(IFLAVU) + ELSE + MF1=RMASS(IFLAVU) + MF2=RMASS(IFLAVD) + ENDIF + ELSE + IS=IFL + IF (IFL.EQ.164) IS=IQK + MREMIN = MREMIF(IS) + MF1 = MFIN1(IS) + MF2 = MFIN2(IS) + ENDIF +C---choose subprocess scale + IF (BGSHAT) THEN + EMSCA = RSHAT + ELSE + S=SHAT+Q2 + IF (IFL.GE.7.AND.IFL.LE.18) S=SHAT+Q2-MF1**2 + T=-S*Z + U=-S-T + IF (IFL.GE.7.AND.IFL.LE.18) U=-S-T-2*MF1**2 + EMSCA = SQRT(TWO*S*T*U/(S**2+T**2+U**2)) + IF (IFL.EQ.164) EMSCA=SQRT(-U) + ENDIF + ALPHAS = HWUALF(1,EMSCA) + IF (ALPHAS.GE.ONE.OR.ALPHAS.LE.ZERO) CALL HWWARN('HWHBSG',51,*888) +C---structure functions + ETA = (SHAT+Q2)/SMA/Y + IF (ETA.GT.ONE) ETA=ONE + CALL HWSFUN (ETA,EMSCA,IDHW(IHAD),NSTRU,SFUN,2) + XG = Q2/(SHAT + Q2) + SG = ETA*SMA + IF (SG.LE.(RSHAT+ML)**2.OR.SG.GE.(RS-MREMIN)**2) GOTO 888 +C + IF (IFL.EQ.164) GOTO 200 +C +C---Electroweak couplings + ALPHA=HWUAEM(-Q2) + IF (CHARGD) THEN + POL = PPOLN(3) - EPOLN(3) + DLQ(1)=.0625*VCKM(IFLAVU/2,(IFLAVD+1)/2)/SWEIN**2 * + + Q2**2/((Q2+RMASS(198)**2)**2+(RMASS(198)*GAMW)**2) * + + (ONE + POL) + DLQ(2)=ZERO + DLQ(3)=DLQ(1) + ELSE + IQ=MOD(IFL-1,6)+1 + ILEPT=MOD(IDHW(1)-121,6)+11 + CALL HWUCFF(ILEPT,IQ,-Q2,DLQ(1)) + ENDIF +C + IF (IFL.LE.6) THEN +C---For Boson-Gluon Fusion + PDENS = SFUN(13)/ETA + CCOL = HALF + MSUM = (MF1**2 + MF2**2) / (Y*SG) + MDIF = (MF1**2 - MF2**2) / (Y*SG) + MPRO = MF1*MF2 / (Y*SG) +C + FFUN = (1.D0-XG)*Z*(1.D0-Z) + (MDIF*(2.D0*Z-1.D0)-MSUM)/2.D0 + GFUN = (1.D0-XG)*(1.D0-Z) + XG*Z + MDIF + IF ( FFUN .LT. ZERO ) FFUN = ZERO + H43 = (8.D0*(2.D0*Z**2*XG-Z**2-2.D0*Z*XG+2.D0*Z*MDIF+Z-MDIF + & -MSUM)) / (Z*(1.D0-Z))**2 +C + H41 = (8.D0*(Z**2-Z*XG+Z*MDIF-MDIF-MSUM)) / (Z**2*(1.D0-Z)) +C + H11 = (4.D0*(2.D0*Z**4-4.D0*Z**3+2.D0*Z**2*MSUM*XG + & -2.D0*Z**2*MSUM+2.D0*Z**2*XG**2-2.D0*Z**2*XG+3.D0*Z**2 + & +2.D0*Z*MDIF*MSUM+2.D0*Z*MDIF*XG-2.D0*Z*MSUM*XG + & +2.D0*Z*MSUM-2.D0*Z*XG**2+2.D0*Z*XG-Z-MDIF*MSUM-MDIF*XG + & -MSUM**2-MSUM*XG)) / (Z*(1.D0-Z))**2 +C + H12 = (16.D0*(-Z*MDIF+Z*XG+MDIF+MSUM))/(Z**2*(1.D0-Z)) +C + H14 = (16.D0*(-2.D0*Z**2*XG-2.D0*Z*MDIF+2.D0*Z*XG+MDIF+MSUM)) + & / (Z*(1.D0-Z))**2 +C + H16 = (32.D0*(Z*MDIF-Z*XG-MDIF-MSUM)) / (Z**2*(1.D0-Z)) +C + H21 = (8.D0*MPRO*(-2.D0*Z**2*XG+2.D0*Z**2-2.D0*Z*MDIF+2.D0*Z*XG + + -2.D0*Z+MDIF+MSUM)) / (Z*(1.D0-Z))**2 +C + H22 = (-32.D0*MPRO) / (Z*(1.D0-Z)) +C + G11 = -2.D0*H11 + FFUN*H14 + G12 = 2.D0*XG*FFUN*H14 + H12 + GFUN * ( H16+GFUN*H14 ) + G1A = SQRT( XG*FFUN ) * ( H16 + 2.D0*GFUN*H14 ) + G1B = FFUN*H14 + G21 = -2.D0*H21 + G22 = H22 + G3 = H41 - GFUN*H43 + GC = SQRT( XG*FFUN ) * (-2.D0*XG*H43 ) + ELSE +C---for QCD Compton, massless matrix element + PDENS = SFUN(IFL-6)/ETA + CCOL = CFFAC + FFUN = XG*(ONE-XG)*Z*(ONE-Z) + GFUN = (ONE-XG)*(ONE-Z)+XG*Z + G11 = 8.D0*((Z**2+XG**2)/(ONE-XG)/(ONE-Z)+TWO*(XG*Z+ONE)) + G12 = 64.D0*XG**2*Z+TWO*XG*G11 + G1A = 32.D0*XG*GFUN*SQRT(FFUN)/((ONE-XG)*(ONE-Z)) + G1B = 16.D0*XG*Z + G3 = -16.D0*(ONE-XG)*(ONE-Z)+G11 + GC = -16.D0*XG*SQRT(FFUN)*(ONE-Z-XG)/((ONE-XG)*(ONE-Z)) + G21 = ZERO + G22 = ZERO + ENDIF +C + A11 = XG * Y**2 * G11 + (1.D0-Y) * G12 + & - (2.D0-Y) * SQRT( 1.D0-Y ) * G1A * COS( PHI ) + & + 2.D0 * XG * (1.D0-Y) * G1B * COS( 2.D0*PHI ) +C + A12 = XG * Y**2 * G21 + (1.D0-Y) * G22 +C + A44 = XG * Y * (2.D0-Y) * G3 + & - 2.D0 * Y * SQRT( 1.D0-Y ) * GC * COS( PHI ) +C + IF ( Y*Q2**2 .LT. 1D-38 ) THEN +C---prevent numerical uncertainties in DSIGMA computation + DSIGMA = PDENS*ALPHA**2*ALPHAS*GEV2NB*CCOL/(16.D0*PIFAC) + & *(DLQ(1)*A11 + DLQ(2)*A12 + LEP*DLQ(3)*A44) + IF ( DSIGMA .LE. ZERO ) GOTO 888 + LDSIG = LOG (DSIGMA) - LOG (Y) - 2.D0 * LOG (Q2) + DSIGMA = EXP (LDSIG) + ELSE + DSIGMA = PDENS*ALPHA**2*ALPHAS*GEV2NB*CCOL + & * (DLQ(1)*A11 + DLQ(2)*A12 + LEP*DLQ(3)*A44) + & / (16.D0*PIFAC*Y*Q2**2) + ENDIF + IF (DSIGMA.LT.ZERO) GOTO 888 + RETURN +C + 200 CONTINUE +C--- J/psi production + ALPHA = HWUAEM(-Q2) + GAMMA = 4.8D-6 + PDENS = SFUN(13)/ETA + AFACT = (8.D0*PIFAC*ALPHAS**2*RMASS(164)**3*GAMMA)/(3.D0*ALPHA) + BFACT = ONE/(Y*SG*Z**2*((Z-ONE)*Y*SG-RMASS(164)**2)**2) + CFACT = (RMASS(164)**2-Z*Y*SG)**2/(Y*SG*(ONE-XG)**2* + & ((ONE-XG)*Y*SG-RMASS(164)**2)**2* + & ((Z-ONE)*Y*SG-RMASS(164)**2)**2) + DFACT = ((Z-ONE)*Y*SG)**2/(Y*SG*(ONE-XG)**2* + & ((ONE-XG)*Y*SG-RMASS(164)**2)**2*(Z*Y*SG)**2) + DSIGMA = GEV2NB*ALPHA/(TWO*PIFAC)*AFACT*(BFACT+CFACT+DFACT)*PDENS + IF (DSIGMA.LT.ZERO ) GOTO 888 + RETURN + 888 DSIGMA=ZERO + END +CDECK ID>, HWHDIS. +*CMZ :- -26/04/91 14.55.44 by Federico Carminati +*-- Author : Giovanni Abbiendi & Luca Stanco +C---------------------------------------------------------------------- + SUBROUTINE HWHDIS +C---------------------------------------------------------------------- +C DEEP INELASTIC LEPTON-HADRON SCATTERING: MEAN EVWGT = SIGMA IN NB +C---------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + DOUBLE PRECISION HWR,HWRUNI,HWUPCM,PRAN,PROB,SAMP,SIG,Q2, + & XBJ,Y,W,S,MLEP,MHAD,MLSCAT,LEP,YMIN,YMAX,XXMAX,Q2JAC,XXJAC, + & JACOBI,A1,A2,A3,B1,B2,PCM,PCMEP,PCMLW,PCMEQ,PCMLQ,COSPHI,PA, + & EQ,PZQ,SHAT,PROP,DLEFT,DRGHT,DUP,DWN,FACT,EFACT,OMY2,YPLUS, + & YMNUS,SIGMA,AF(7,12),SMA,Q2SUP,HWUAEM,DCHRG,DNEUT + INTEGER I,IQK,IQKIN,IQKOUT,IDSCAT,IHAD,ILEPT + LOGICAL CHARGD + EXTERNAL HWR,HWRUNI,HWUPCM + SAVE MLEP,MHAD,S,SMA,PCM,MLSCAT,A1,A2,A3,B1,B2,DLEFT,DRGHT,Q2, + & AF,XBJ,Y,YPLUS,YMNUS,OMY2,FACT,EFACT,SIGMA,IDSCAT,CHARGD, + & ILEPT,DCHRG,DNEUT,LEP + IQK=MOD(IPROC,10) + IHAD=2 + IF (JDAHEP(1,IHAD).NE.0) IHAD=JDAHEP(1,IHAD) + IF (FSTWGT.OR.IHAD.NE.2) THEN +C---INITIALISE PROCESS (MUST BE DONE EVERY TIME IF S VARIES) +C---LEPTON AND HADRON MASSES, INVARIANT MASS, MOMENTUM IN C.M. FRAME + MLEP=PHEP(5,1) + MHAD=PHEP(5,IHAD) + S=PHEP(5,3)**2 + SMA=S-MLEP**2-MHAD**2 + PCM=HWUPCM(SQRT(S),MLEP,MHAD) +C---LEP = 1 FOR LEPTONS, -1 FOR ANTILEPTONS + IF (IDHW(1).GE.121.AND.IDHW(1).LE.126) THEN + LEP=+ONE + ELSEIF (IDHW(1).GE.127.AND.IDHW(1).LE.132) THEN + LEP=-ONE + ELSE + CALL HWWARN('HWHDIS',500,*999) + ENDIF + DCHRG=FLOAT(MOD(IDHW(1) ,2)) + DNEUT=FLOAT(MOD(IDHW(1)+1,2)) + ILEPT=MOD(IDHW(1)-121,6)+11 +C---DLEFT,DRIGHT = 1,0 for leptons; = 0,1 for anti-leptons + DLEFT=MAX(+LEP,ZERO) + DRGHT=MAX(-LEP,ZERO) + CHARGD=MOD(IPROC,100)/10.EQ.1 +C---Evaluate constant factor in cross section and +C find and store scattered lepton identity + IF (CHARGD) THEN + IF ((EPOLN(3)-PPOLN(3)).EQ.ONE) THEN + WRITE(6,5) + CALL HWWARN('HWHDIS',501,*999) + 5 FORMAT(1X,'WARNING: Cross-section is zero for the', + & ' specified lepton helicity') + ENDIF + FACT=GEV2NB*(ONE-(EPOLN(3)-PPOLN(3)))*.25D0*PIFAC + & /(SWEIN*RMASS(198)**2)**2 + IDSCAT=IDHW(1)+NINT(DCHRG-DNEUT) + ELSE + FACT=GEV2NB*TWO*PIFAC + IDSCAT=IDHW(1) + ENDIF + MLSCAT=RMASS(IDSCAT) +C---PARAMETERS USED FOR THE WEIGHT GENERATION IN NEUTRAL CURRENT +C PROCESSES. ASSUME D(SIGMA)/D(Q**2) GOES LIKE A1+A2/Q**2+A3/Q**4 +C AND D(SIGMA)/D(X) LIKE B1+B2/X + A1=0.5 + A2=0.5 + A3=1. + B1=0.1 + B2=1. + ENDIF + IF (GENEV) THEN +C---GENERATE EVENT (KINEMATICAL VARIABLES AND STRUCTURE FUNCTION +C ALREADY FOUND) + PRAN=SIGMA*HWR() + IF (CHARGD) THEN +C---CHARGED CURRENT PROCESS + IF (IQK.EQ.0) THEN +C---FIND FLAVOUR OF THE STRUCK QUARK (IF NOT SELECTED BY THE USER) + PROB=ZERO + DO 10 I=1,6 + DUP=MOD(I+1,2) + DWN=MOD(I ,2) + PROB=PROB+EFACT* + & ((DCHRG*(DLEFT*DUP+DRGHT*DWN*OMY2) + & +DNEUT*(DLEFT*DWN+DRGHT*DUP*OMY2))*DISF(I ,1) + & +(DCHRG*(DLEFT*DWN*OMY2+DRGHT*DUP) + & +DNEUT*(DLEFT*DUP*OMY2+DRGHT*DWN))*DISF(I+6,1)) + IF (PROB.GE.PRAN) GOTO 20 + 10 CONTINUE + I=6 + 20 IQK=I + ENDIF + DUP=MOD(IQK+1,2) + DWN=MOD(IQK ,2) + IQKIN=IQK + IF ((LEP.EQ. 1.AND.MOD(IQK+IDHW(1),2).EQ.0) + & .OR.(LEP.EQ.-1.AND.MOD(IQK+IDHW(1),2).EQ.1)) IQKIN=IQK+6 +C---FIND FLAVOUR OF THE OUTGOING QUARK + PRAN=HWR() + PROB=ZERO + IF (DUP.EQ.ONE) THEN + DO 30 I=1,3 + PROB=PROB+VCKM(IQK/2,I) + IF (PROB.GE.PRAN) GOTO 40 + 30 CONTINUE + I=3 + 40 IQKOUT=2*I-1 + IF (IQKIN.GT.6) IQKOUT=IQKOUT+6 + ELSE + DO 50 I=1,3 + PROB=PROB+VCKM(I,(IQK+1)/2) + IF (PROB.GE.PRAN) GOTO 60 + 50 CONTINUE + I=3 + 60 IQKOUT=2*I + IF (IQKIN.GT.6) IQKOUT=IQKOUT+6 + ENDIF + ELSE +C---NEUTRAL CURRENT PROCESS + IF (IQK.NE.0) THEN + IQKIN=IQK + PROB=EFACT*(AF(1,IQK)*YPLUS*DISF(IQK,1)+ + & LEP*AF(3,IQK)*YMNUS*DISF(IQK,1)) + IF (PROB.LT.PRAN) IQKIN=IQK+6 + ELSE +C---FIND FLAVOUR OF THE STRUCK QUARK (IF NOT SELECTED BY THE USER) + PROB=ZERO + SIG=ONE + DO 70 I=1,12 + IF (I.GT.6) SIG=-ONE + PROB=PROB+EFACT*(AF(1,I)*YPLUS*DISF(I,1)+ + & LEP*SIG*AF(3,I)*YMNUS*DISF(I,1)) + IF (PROB.GE.PRAN) GOTO 80 + 70 CONTINUE + I=12 + 80 IQKIN=I + ENDIF + IQKOUT=IQKIN + ENDIF + IDN(1)=IDHW(1) + IDN(2)=IQKIN + IDN(3)=IDSCAT + IDN(4)=IQKOUT + ICO(1)=1 + ICO(2)=4 + ICO(3)=3 + ICO(4)=2 + XX(1)=1. + XX(2)=XBJ +C---CHECK PHASE SPACE WITH THE SELECTED FLAVOUR. IF OUTSIDE THE +C EVENT IS KILLED. + PA=XBJ*(PHEP(4,IHAD)+ABS(PHEP(3,IHAD))) + EQ=HALF*(PA+RMASS(IDN(2))**2/PA) + PZQ=-(PA-EQ) + SHAT=(PHEP(4,1)+EQ)**2-(PHEP(3,1)+PZQ)**2 + PCMEQ=HWUPCM(SQRT(SHAT),MLEP,RMASS(IDN(2))) + PCMLQ=HWUPCM(SQRT(SHAT),MLSCAT,RMASS(IDN(4))) + IF (PCMLQ.LT.ZERO) THEN + CALL HWWARN('HWHDIS',101,*999) + ELSEIF (PCMLQ.EQ.ZERO) THEN + COSTH=ZERO + ELSE + COSTH=(TWO*SQRT(PCMEQ**2+MLEP**2)*SQRT(PCMLQ**2+MLSCAT**2) + & -(Q2+MLEP**2+MLSCAT**2))/(TWO*PCMEQ*PCMLQ) + ENDIF + IF (ABS(COSTH).GT.ONE) CALL HWWARN('HWHDIS',102,*999) + IDCMF=15 + CALL HWETWO + ELSE + EVWGT=ZERO + IF (CHARGD) THEN +C---CHOOSE X,Y (CC PROCESS) + YMIN=MAX(YBMIN,Q2MIN/SMA) + YMAX=MIN(YBMAX,ONE) + IF (YMIN.GT.YMAX) GOTO 999 + Y=HWRUNI(0,YMIN,YMAX) + XXMIN=Q2MIN/S/Y + XXMAX=MIN(Q2MAX/SMA/Y,ONE) + IF (XXMIN.GT.XXMAX) GOTO 999 + XBJ=HWRUNI(0,XXMIN,XXMAX) + Q2=XBJ*Y*(S-MLEP**2-MHAD**2) + JACOBI=(YMAX-YMIN)*(XXMAX-XXMIN)*(S-MLEP**2-MHAD**2)*XBJ + ELSE +C---CHOOSE X,Q**2 (NC PROCESS) + Q2SUP=MIN(Q2MAX,SMA*YBMAX) + IF (Q2MIN.GT.Q2SUP) GOTO 999 + SAMP=(A1+A2+A3)*HWR() + IF (SAMP.LE.A1) THEN + Q2=HWRUNI(0,Q2MIN,Q2SUP) + ELSEIF (SAMP.LE.(A1+A2)) THEN + Q2=EXP(HWRUNI(0,LOG(Q2MIN),LOG(Q2SUP))) + ELSE + Q2=-ONE/HWRUNI(0,-ONE/Q2MIN,-ONE/Q2SUP) + ENDIF + Q2JAC=(A1+A2+A3)/ + & (A1/(Q2SUP-Q2MIN) + & +A2/LOG(Q2SUP/Q2MIN)/Q2 + & +A3*Q2MIN*Q2SUP/(Q2SUP-Q2MIN)/Q2**2) + XXMIN=Q2/SMA/YBMAX + XXMAX=ONE + IF (YBMIN.GT.ZERO) XXMAX=MIN(Q2/SMA/YBMIN,ONE) + IF (XXMIN.GT.XXMAX) GOTO 999 + SAMP=(B1+B2)*HWR() + IF (SAMP.LE.B1) THEN + XBJ=HWRUNI(0,XXMIN,XXMAX) + ELSE + XBJ=EXP(HWRUNI(0,LOG(XXMIN),LOG(XXMAX))) + ENDIF + XXJAC=(B1+B2)/(B1/(XXMAX-XXMIN)+B2/LOG(XXMAX/XXMIN)/XBJ) + Y=Q2/(S-MLEP**2-MHAD**2)/XBJ + JACOBI=Q2JAC*XXJAC + ENDIF +C---CHECK IF THE GENERATED POINT IS INSIDE PHASE SPACE. IF NOT +C RETURN WITH WEIGHT EQUAL TO ZERO. + W=SQRT(MHAD**2+Q2*(ONE-XBJ)/XBJ) + IF (W.LT.WHMIN) RETURN + PCMEP=PCM + PCMLW=HWUPCM(SQRT(S),MLSCAT,W) + IF (PCMLW.LT.ZERO) THEN + EVWGT=ZERO + RETURN + ELSEIF (PCMLW.EQ.ZERO) THEN + COSPHI=ZERO + ELSE + COSPHI= + & (TWO*SQRT(PCMEP**2+MLEP**2)*SQRT(PCMLW**2+MLSCAT**2) + & -(Q2+MLEP**2+MLSCAT**2))/(TWO*PCMEP*PCMLW) + ENDIF + IF (ABS(COSPHI).GT.ONE) THEN + EVWGT=ZERO + RETURN + ENDIF +C---SET SCALE EQUAL Q. EVALUATE STRUCTURE FUNCTIONS. + EMSCA=SQRT(Q2) + CALL HWSFUN(XBJ,EMSCA,IDHW(IHAD),NSTRU,DISF,2) +C---SWITCH OFF ANY FLAVOURS THAT ARE BELOW THRESHOLD + DO 90 I=1,12 + 90 IF (W.LT.2*RMASS(I)) DISF(I,1)=0 +C---EVALUATE DIFFERENTIAL CROSS SECTION + IF (CHARGD) THEN + PROP=RMASS(198)**2/(Q2+RMASS(198)**2) + EFACT=FACT*(HWUAEM(-Q2)*PROP)**2/XBJ + OMY2=(ONE-Y)**2 + SIGMA=ZERO + DO 100 I=1,6 + DUP=MOD(I+1,2) + DWN=MOD(I ,2) + IF (IQK.NE.0.AND.IQK.NE.I) GOTO 100 + SIGMA=SIGMA+EFACT* + & ((DCHRG*(DLEFT*DUP+DRGHT*DWN*OMY2) + & +DNEUT*(DLEFT*DWN+DRGHT*DUP*OMY2))*DISF(I ,1) + & +(DCHRG*(DLEFT*DWN*OMY2+DRGHT*DUP) + & +DNEUT*(DLEFT*DUP*OMY2+DRGHT*DWN))*DISF(I+6,1)) + 100 CONTINUE + ELSE + EFACT=FACT/XBJ*(HWUAEM(-Q2)/Q2)**2 + YPLUS=ONE+(ONE-Y)**2 + YMNUS=ONE-(ONE-Y)**2 + DO 110 I=1,6 + CALL HWUCFF(ILEPT,I,-Q2,AF(1,I)) + AF(1,I+6)=AF(1,I) + AF(3,I+6)=AF(3,I) + 110 CONTINUE + SIGMA=ZERO + DO 200 I=1,6 + IF (IQK.NE.0.AND.IQK.NE.I) GOTO 200 + SIGMA=SIGMA+EFACT*(AF(1,I)*YPLUS*(DISF(I,1)+DISF(I+6,1))+ + & LEP*AF(3,I)*YMNUS*(DISF(I,1)-DISF(I+6,1))) + 200 CONTINUE + ENDIF +C---FIND WEIGHT: DIFFERENTIAL CROSS SECTION TIME THE JACOBIAN FACTOR + EVWGT=SIGMA*JACOBI + IF (EVWGT.LT.ZERO) EVWGT=ZERO + ENDIF + 999 END +CDECK ID>, HWHDYP. +*CMZ :- -18/05/99 12.41.07 by Mike Seymour +*-- Author : Bryan Webber, Ian Knowles and Mike Seymour +C----------------------------------------------------------------------- + SUBROUTINE HWHDYP +C----------------------------------------------------------------------- +C Drell-Yan Production of fermion pairs via photon, Z0 & (if ZPRIME) +C Z' exchange. Lepton universality is assumed for photon and Z, and +C for Z' if no lepton flavour is specified. +C MEAN EVWGT = SIGMA IN NB +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + DOUBLE PRECISION HWR,HWRUNI,HWUAEM,EPS,C1,C2,C3,EMSQZ,EMGMZ, + & EMSQZP,EMGMZP,CQF(7,6,16),QPOW,RPOW,A01,A1,A02,A2,A03,A3,CRAN, + & EMJ1,EMJ2,EMJ3,EMJAC,FACT,QSQ,HCS,FACTR,RCS,EXTRA,PMAX,PTHETA + INTEGER IMODE,JQMN,JQMX,JQ,JLMN,JLMX,JL,IQ,I,IADD(2,2),ID1,ID2, + & ID3,ID4,JF + EXTERNAL HWR,HWRUNI,HWUAEM + SAVE HCS,JQMN,JQMX,JLMN,JLMX,C1,C2,C3,QPOW,RPOW,EMSQZ,EMGMZ, + & A1,A01,A2,A02,A3,A03,EMSQZP,EMGMZP,FACT,CQF + PARAMETER (EPS=1.D-9) + DATA IADD/0,6,6,0/ + IF (GENEV) THEN + RCS=HCS*HWR() + ELSE + IF (FSTWGT) THEN +C Set limits for which particles to include + JLMN=1 + JLMX=0 + JQMN=1 + JQMX=0 + IMODE=MOD(IPROC,100) + IF (IMODE.EQ.0) THEN + JQMN=1 + JQMX=6 + ELSEIF (IMODE.LE.10) THEN + JQMN=IMODE + JQMX=IMODE + ELSEIF (IMODE.EQ.50) THEN + JLMN=11 + JLMX=16 + ELSEIF (IMODE.GE.50.AND.IMODE.LE.60) THEN + JLMN=IMODE-40 + JLMX=IMODE-40 + ELSEIF (IMODE.EQ.99) THEN + JQMN=1 + JQMX=6 + JLMN=11 + JLMX=16 + ELSE + CALL HWWARN('HWHDYP',500,*999) + ENDIF +C Set up parameters for importance sampling: +C sum of power law and two Breit-Wigners (relative weights C1,C2,C3) + C1=ONE + C2=ONE + C3=ZERO + IF (ZPRIME) C3=ONE + IF (EMPOW.EQ.ONE) CALL HWWARN('HWHDYP',501,*999) + IF (C2.EQ.ZERO) CALL HWWARN('HWHDYP',502,*999) + IF (C3.EQ.ZERO.AND.ZPRIME) CALL HWWARN('HWHDYP',503,*999) + QPOW=-EMPOW+1 + RPOW=1/QPOW + EMSQZ=RMASS(200)**2 + EMGMZ=RMASS(200)*GAMZ + A01=EMMIN**QPOW + A1=(EMMAX**QPOW-A01)/C1 + A02=ATAN((EMMIN**2-EMSQZ)/EMGMZ) + A2=(ATAN((EMMAX**2-EMSQZ)/EMGMZ)-A02)/C2 + IF (C3.GT.ZERO) THEN + EMSQZP=RMASS(202)**2 + EMGMZP=RMASS(202)*GAMZP + A03=ATAN((EMMIN**2-EMSQZP)/EMGMZP) + A3=(ATAN((EMMAX**2-EMSQZP)/EMGMZP)-A03)/C3 + ENDIF + ENDIF + EVWGT=0. +C Select a mass for the produced pair + CRAN=(C1+C2+C3)*HWR() + IF (CRAN.LT.C1) THEN +C Use power law + EMSCA=(A01+A1*CRAN)**RPOW + QSQ=EMSCA**2 + ELSEIF (CRAN.LT.C1+C2) THEN +C Use Z Breit-Wigner + CRAN=CRAN-C1 + QSQ=EMSQZ+EMGMZ*TAN(A02+A2*CRAN) + EMSCA=SQRT(QSQ) + ELSE +C Use Z' Breit-Wigner + CRAN=CRAN-C1-C2 + QSQ=EMSQZP+EMGMZP*TAN(A03+A3*CRAN) + EMSCA=SQRT(QSQ) + ENDIF + EMJ1=EMSCA**EMPOW/(1-EMPOW)*A1 + EMJ2=((QSQ-EMSQZ)**2+EMGMZ**2)/(2*EMSCA*EMGMZ)*A2 + IF (C3.GT.ZERO) THEN + EMJ3=((QSQ-EMSQZP)**2+EMGMZP**2)/(2*EMSCA*EMGMZP)*A3 + EMJAC=(C1+C2+C3)/(1/EMJ1+1/EMJ2+1/EMJ3) + ELSE + EMJAC=(C1+C2)/(1/EMJ1+1/EMJ2) + ENDIF +C Select initial momentum fractions + XXMIN=QSQ/PHEP(5,3)**2 + XLMIN=LOG(XXMIN) + CALL HWSGEN(.TRUE.) + FACT=-GEV2NB*HWUAEM(QSQ)**2*PIFAC*8*EMJAC*XLMIN + $ /(3*NCOLO*EMSCA**3) +C Store cross-section coefficients + DO 50 IQ=1,6 + DO 30 JQ=JQMN,JQMX + IF (EMSCA.GT.2.*RMASS(JQ)) THEN + CALL HWUCFF(IQ,JQ,QSQ,CQF(1,IQ,JQ)) + ELSE + CALL HWVZRO(7,CQF(1,IQ,JQ)) + ENDIF + 30 CONTINUE + DO 40 JL=JLMN,JLMX + IF (EMSCA.GT.2.*RMASS(JL)) THEN + CALL HWUCFF(IQ,JL,QSQ,CQF(1,IQ,JL)) + ELSE + CALL HWVZRO(7,CQF(1,IQ,JL)) + ENDIF + 40 CONTINUE + 50 CONTINUE + ENDIF +C + HCS=0. + DO 90 I=1,2 +C I=1 quark first, I=2 anti-quark first + DO 80 IQ=1,6 + ID1=IQ+IADD(1,I) + ID2=IQ+IADD(2,I) + IF (DISF(ID1,1).LT.EPS.OR.DISF(ID2,2).LT.EPS) GOTO 80 + FACTR=FACT*DISF(ID1,1)*DISF(ID2,2) +C Quark final states + DO 60 JQ=JQMN,JQMX + ID3=JQ + ID4=JQ+6 + IF (IQ.EQ.JQ) THEN + HCS=HCS+FACTR*(CQF(1,IQ,JQ)*FLOAT(NCOLO)+3*HALF*QFCH(IQ)**4) + IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID3,ID4,2143,50,*99) + ELSE + HCS=HCS+FACTR*CQF(1,IQ,JQ)*FLOAT(NCOLO) + IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID3,ID4,2143,50,*99) + ENDIF + 60 CONTINUE +C Lepton final states + DO 70 JL=JLMN,JLMX + ID3=110+JL + ID4=ID3+6 + HCS=HCS+FACTR*CQF(1,IQ,JL) + IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID3,ID4,2134,50,*99) + 70 CONTINUE + 80 CONTINUE + 90 CONTINUE + EVWGT=HCS + RETURN +C Generate event + 99 IDN(1)=ID1 + IDN(2)=ID2 + IDCMF=200 + IF (ID3.LE.6) THEN + JF=JQ + ELSE + JF=JL + ENDIF +C Select polar angle from distribution: +C CQF(1,IQ,JF)*(ONE+COSTH**2)+CQF(3,IQ,JF)*COSTH+EXTRA*(ONE+COSTH) + IF (ID1.EQ.ID3.OR.ID2.EQ.ID3) THEN + EXTRA=TWO*QFCH(ID3)**4/NCOLO + ELSE + EXTRA=0 + ENDIF + PMAX=2.*(CQF(1,IQ,JF)+EXTRA)+ABS(CQF(3,IQ,JF)) + 100 COSTH=HWRUNI(0,-ONE,ONE) + PTHETA=CQF(1,IQ,JF)*(ONE+COSTH**2)+CQF(3,IQ,JF)*COSTH + & +EXTRA*(ONE+COSTH) + IF (PTHETA.LT.PMAX*HWR()) GOTO 100 + IF (ID1.GT.ID2) COSTH=-COSTH + IDCMF=200 + CALL HWETWO + 999 END +CDECK ID>, HWHEGG. +*CMZ :- -19/03/92 10.13.56 by Mike Seymour +*-- Author : Mike Seymour +C----------------------------------------------------------------------- + SUBROUTINE HWHEGG +C---------------------------------------------------------------------- +C HARD PROCESS: EE --> EEGAMGAM --> EEFFBAR/WW +C MEAN EVENT WEIGHT = CROSS-SECTION IN NB +C AFTER CUTS ON PT AND MASS OF CENTRE-OF-MASS SYSTEM +C AND COS(THETA) IN CENTRE-OF-MASS SYSTEM +C AND TIMES BRANCHING FRACTION IF WW +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + DOUBLE PRECISION HWR,HWULDO,EMSQ,BETA,S,T,U,TMIN,TMAX,TRAT, + & DSDT,PROB,X,Z(2),ZMIN,ZMAX,PCMIN,PCMAX,PCFAC,PLOGMI,PLOGMA,PTCMF, + & Q,PC,BLOG,EMCMIN,EMCMAX,EMLMIN,EMLMAX,WGT(6),RWGT,CV,CA,BR,QT(2), + & QX(2),QY(2),PX,PY,ROOTS,DOT,A,B,C,SHAT,PCF(2),PCM(2),PCMAC,ZZ(2), + & COLFAC + INTEGER I,IGAM,ID,IDL,ID1,ID2,IHEP,JHEP,NADD,NTRY,NQ,JGAM + LOGICAL HWRLOG + EXTERNAL HWR,HWULDO,HWRLOG + SAVE S,BETA,X,ID,NQ,WGT,EMLMIN,EMLMAX,PCFAC,PLOGMA,PLOGMI,SHAT, + & PCF,PCM,Z,PCMAC,NADD + IF (IERROR.NE.0) RETURN +C---INITIALIZE LOCAL COPIES OF EMMIN,EMMAX + IF (FSTWGT) THEN + EMLMIN=EMMIN + EMLMAX=EMMAX + ENDIF + IF (.NOT.GENEV) THEN +C---CHOOSE Z1,Z2 AND CALCULATE SUB-PROCESS CROSS-SECTION + EVWGT=0 +C-----FIND FINAL STATE PARTICLES + IHPRO=MOD(IPROC,100) + IF (IHPRO.EQ.0) THEN + ID=1 + NQ=6 + COLFAC=FLOAT(NCOLO) + NADD=6 + ELSEIF (IHPRO.LE.6) THEN + ID=IHPRO + NQ=1 + COLFAC=FLOAT(NCOLO) + NADD=6 + Q=QFCH(ID) + ELSEIF (IHPRO.LE.9) THEN + ID=119+2*(IHPRO-6) + NQ=1 + COLFAC=1. + NADD=6 + Q=QFCH(ID-110) + ELSEIF (IHPRO.LE.10) THEN + ID=198 + NQ=1 + NADD=1 + ELSE + CALL HWWARN('HWHEGG',200,*999) + ENDIF +C-----SPLIT ELECTRONS TO PHOTONS + NHEP=3 + GAMWT=1 + S=2*HWULDO(PHEP(1,1),PHEP(1,2)) + ROOTS=SQRT(S) + EMCMIN=MAX(EMLMIN,MAX(2*RMASS(ID),PTMIN)) + EMCMAX=MIN(EMLMAX,ROOTS) + IF (EMCMIN.GT.EMCMAX) RETURN + ZMIN=EMCMIN**2/S + ZMAX=1-PHEP(5,1)/PHEP(4,1) + IF (ZMIN.GT.ZMAX) RETURN + CALL HWEGAM(1,ZMIN,ZMAX,.TRUE.) + Z(1)=PHEP(4,NHEP-1)/PHEP(4,1) + ZMIN=EMCMIN**2/(Z(1)*S) + ZMAX=MIN(EMCMAX**2/(Z(1)*S), ONE-PHEP(5,2)/PHEP(4,2)) + IF (ZMIN.GT.ZMAX) RETURN + CALL HWEGAM(2,ZMIN,ZMAX,.TRUE.) + Z(2)=PHEP(4,NHEP-1)/PHEP(4,2) + EMSCA=PHEP(5,3) + SHAT=EMSCA**2 +C-----REMOVE LOG TERMS FROM WEIGHT, CALCULATE NEW ONES FROM PT LIMITS + GAMWT=GAMWT/(0.5*LOG((1-Z(1))*S/(Z(1)*PHEP(5,1)**2)) + & *0.5*LOG((1-Z(2))*Z(1)*S/(Z(2)*PHEP(5,2)**2))) + PCF(1)=Z(1)*PHEP(5,1) + PCF(2)=Z(2)*PHEP(5,2) + PCFAC=SQRT(PCF(1)*PCF(2)) + PCM(1)=(1-Z(1))*PHEP(4,1) + PCM(2)=(1-Z(2))*PHEP(4,2) + PCMAC=SQRT(PCM(1)*PCM(2)) + PCMIN=MAX(PTMIN,MAX(PCF(1),PCF(2))) + PCMAX=MIN( MIN(PTMAX,PHEP(5,3)) , MIN(PCM(1),PCM(2)) ) + IF (PCMIN.GT.PCMAX) RETURN + PLOGMI=(LOG(PCMIN/PCFAC))**2 + PLOGMA=(LOG(PCMAX/PCFAC))**2 + GAMWT=GAMWT*(PLOGMA-PLOGMI) +C-----CALCULATE CROSS-SECTION + DO 10 IDL=1,NQ + WGT(IDL)=EVWGT + IF (IHPRO.EQ.0) THEN + ID=IDL + Q=QFCH(ID) + ENDIF + EMSQ=RMASS(ID)**2 + X=4*EMSQ/SHAT + IF (X.GT.ONE) GOTO 10 + BETA=SQRT(1-X) + BLOG=LOG((1+BETA*CTMAX)/(1-BETA*CTMAX))/BETA + IF (IHPRO.LE.9) THEN + EVWGT=EVWGT+GEV2NB*4*PIFAC*COLFAC*Q**4*ALPHEM**2*BETA + & /SHAT * GAMWT * ( (1+X-0.5*X**2)*BLOG + & - CTMAX*(1+X**2/(CTMAX**2*(X-1)+1)) ) + WGT(IDL)=EVWGT + ELSE + CALL HWDBOZ(198,ID1,ID2,CV,CA,BR,1) + CALL HWDBOZ(199,ID1,ID2,CV,CA,BR,1) + EVWGT=EVWGT + GEV2NB*6*PIFAC*ALPHEM**2*BETA/SHAT*BR + & * GAMWT * (-( X-0.5*X**2)*BLOG + & + CTMAX*(1+(X**2+16/3.)/(CTMAX**2*(X-1)+1)) ) + ENDIF + 10 CONTINUE +C-----GAMWT MUST BE RESET TO ONE, SINCE IT IS REAPPLIED LATER! + GAMWT=ONE + ELSE +C---GENERATE EVENT +C-----CHOOSE PT OF THE CMF + PTCMF=PCFAC*EXP(SQRT(HWR()*(PLOGMA-PLOGMI)+PLOGMI)) +C-----CHOOSE WHICH PHOTON USUALLY HAS SMALLER PT + NTRY=0 + 20 IGAM=1 + IF (LOG(PCM(1)/PCF(1)).LT.HWR()*2*LOG(PCMAC/PCFAC)) IGAM=2 + JGAM=3-IGAM +C-----CHOOSE ITS PT + 30 NTRY=NTRY+1 + IF (NTRY.GT.NBTRY) CALL HWWARN('HWHEGG',100,*999) + QT(IGAM)=(PCM(IGAM)/PCF(IGAM))**HWR() + PROB=(QT(IGAM)**2/(QT(IGAM)**2+1))**2 + QT(IGAM)=QT(IGAM)*PCF(IGAM) + IF (HWRLOG(1-PROB)) GOTO 30 +C-----CHOOSE ITS DIRECTION + CALL HWRAZM(QT(IGAM),QX(IGAM),QY(IGAM)) +C-----CALCULATE THE OTHER PHOTON'S PT + QX(JGAM)=PTCMF-QX(IGAM) + QY(JGAM)= -QY(IGAM) + QT(JGAM)=SQRT(QX(JGAM)**2+QY(JGAM)**2) + IF (QT(JGAM).LT.PCF(JGAM).OR.QT(JGAM).GT.PCM(JGAM)) GOTO 20 +C-----APPLY A RANDOM ROTATION AROUND THE BEAM AXIS + CALL HWRAZM(ONE,PX,PY) + IF (PX.EQ.ZERO) PX=1D-20 + QX(1)=(QX(1)*PX -QY(1)*PY) + QY(1)=(QY(1) +QX(1)*PY)/PX + QX(2)=(QX(2)*PX -QY(2)*PY) + QY(2)=(QY(2) +QX(2)*PY)/PX +C-----RECONSTRUCT MOMENTA + IF (QT(IGAM).GT.QT(JGAM)) THEN + IGAM=3-IGAM + JGAM=3-JGAM + ENDIF + DOT=-Z(JGAM)*S+SHAT+2*(QX(1)*QX(2)+QY(1)*QY(2)) +C-------SOLVE QUADRATIC IN Z(IGAM) TO FIND ELECTRON ENERGIES + A=S*(S*Z(JGAM)+QT(JGAM)**2) + B=S*DOT*(1+Z(JGAM)) + C=DOT**2+S*QT(IGAM)**2*(1-Z(JGAM))**2-4*QT(IGAM)**2*QT(JGAM)**2 + IF (B**2.LT.4*A*C) GOTO 20 + ZZ(IGAM)=(-B+SQRT(B**2-4*A*C))/(2*A) + IF (ZZ(IGAM).LT.ZERO .OR. ZZ(IGAM).GT.ONE-Z(IGAM)) GOTO 20 + ZZ(JGAM)=1-Z(JGAM) +C-------REJECT AGAINST PHOTON DISTRIBUTION FUNCTION + PROB=((1+ZZ(IGAM)**2)/(1-ZZ(IGAM)))/((1+(1-Z(IGAM))**2)/Z(IGAM)) + & *((1+ZZ(JGAM)**2)/(1-ZZ(JGAM)))/((1+(1-Z(JGAM))**2)/Z(JGAM)) + IF (HWRLOG(1-PROB)) GOTO 20 +C-------RECONSTRUCT ALL OTHER VARIABLES + DO 40 I=1,2 + IGAM=2*I+3 + PHEP(1,IGAM)=QX(I) + PHEP(2,IGAM)=QY(I) + PHEP(4,IGAM)=ZZ(I)*PHEP(4,I) + PHEP(5,IGAM)=RMASS(IDHW(IGAM)) +C---------IF MOMENTUM CANNOT BE CONSERVED TRY AGAIN + IF (PHEP(4,IGAM)**2-PHEP(5,IGAM)**2-QT(I)**2 .LT. 0) GOTO 20 + PHEP(3,IGAM)=SIGN(SQRT(PHEP(4,IGAM)**2-PHEP(5,IGAM)**2- + & QT(I)**2),PHEP(3,IGAM)) + CALL HWVDIF(4,PHEP(1,I),PHEP(1,IGAM),PHEP(1,IGAM-1)) + CALL HWUMAS(PHEP(1,IGAM-1)) + 40 CONTINUE +C-----TIDY UP EVENT RECORD + NHEP=NHEP+1 + IDHW(NHEP)=IDHW(3) + IDHEP(NHEP)=IDHEP(3) + ISTHEP(NHEP)=110 + CALL HWVSUM(4,PHEP(1,4),PHEP(1,6),PHEP(1,NHEP)) + CALL HWVSUM(4,PHEP(1,1),PHEP(1,2),PHEP(1,3)) + CALL HWUMAS(PHEP(1,NHEP)) + CALL HWUMAS(PHEP(1,3)) + JMOHEP(1,NHEP)=4 + JMOHEP(2,NHEP)=6 + JMOHEP(1,3)=0 + JMOHEP(2,3)=0 +C-----CHOOSE FINAL STATE QUARK + IF (IHPRO.EQ.0) THEN + RWGT=HWR()*EVWGT + ID=1 + DO 50 IDL=1,NQ + IF (RWGT.GT.WGT(IDL)) ID=IDL+1 + 50 CONTINUE + EMSQ=RMASS(ID)**2 + X=4*EMSQ/SHAT + BETA=SQRT(1-X) + ENDIF +C-----CHOOSE T (WHERE T = MANDELSTAM_T - EMSQ) + TMIN=-SHAT/2 + TMAX=-SHAT/2*(1-BETA*CTMAX) + TRAT=TMAX/TMIN + NTRY=0 + IF (IHPRO.LE.9) THEN +C-------FOR FFBAR, CHOOSE T ACCORDING TO -SHAT/T + 60 NTRY=NTRY+1 + IF (NTRY.GT.NBTRY) CALL HWWARN('HWHEGG',101,*999) + T=TRAT**HWR()*TMIN + U=-T-SHAT +C-------REWEIGHT TO CORRECT DISTRIBUTION + DSDT=(T*U-2*EMSQ*(T+2*EMSQ))/T**2 + & +( 2*EMSQ*(SHAT-4*EMSQ))/(T*U) + & +(T*U-2*EMSQ*(U+2*EMSQ))/U**2 + PROB=-DSDT*T/SHAT / (1 + 2*X - 2*X**2) + IF (HWRLOG(1-PROB)) GOTO 60 + ELSE +C-------FOR WW, CHOOSE T ACCORDING TO (SHAT/T)**2 + 70 NTRY=NTRY+1 + IF (NTRY.GT.NBTRY) CALL HWWARN('HWHEGG',102,*999) + T=TMAX/(1-(1-TRAT)*HWR()) + U=-T-SHAT +C-------REWEIGHT TO CORRECT DISTRIBUTION + DSDT=( 3*(T*U)**2 - SHAT*T*U*(4*SHAT+6*EMSQ) + & + SHAT**2*(2*SHAT**2+6*EMSQ**2) ) / (T*U)**2 + PROB=DSDT*(T/SHAT)**2 / (4.75 - 1.5*X + 1.5*X**2) + IF (HWRLOG(1-PROB)) GOTO 70 + ENDIF +C-----SYMMETRIZE IN T,U + IF (HWRLOG(HALF)) T=U +C-----FILL EVENT RECORD + COSTH=(1+2*T/SHAT)/BETA + PC=0.5*BETA*PHEP(5,NHEP) + PHEP(5,NHEP+1)=RMASS(ID) + PHEP(5,NHEP+2)=RMASS(ID) + CALL HWDTWO(PHEP(1,NHEP),PHEP(1,NHEP+1),PHEP(1,NHEP+2), + & PC,COSTH,.TRUE.) + DO 80 I=1,2 + IHEP=NHEP+I + JHEP=NHEP+3-I + ISTHEP(IHEP)=190 + IF (IHPRO.LE.6) ISTHEP(IHEP)=112+I + IDHW(IHEP)=ID+NADD*(I-1) + IDHEP(IHEP)=IDPDG(IDHW(IHEP)) + JDAHEP(I,NHEP)=IHEP + JMOHEP(1,IHEP)=NHEP + JMOHEP(2,IHEP)=JHEP + JDAHEP(2,IHEP)=JHEP + IF (IHPRO.EQ.10) THEN + RHOHEP(1,IHEP)=0.3333 + RHOHEP(2,IHEP)=0.3333 + RHOHEP(3,IHEP)=0.3333 + ENDIF + 80 CONTINUE + NHEP=NHEP+2 + ENDIF + 999 END +CDECK ID>, HWHEGW. +*CMZ :- -26/04/91 10.18.56 by Bryan Webber +*-- Author : Mike Seymour +C----------------------------------------------------------------------- + SUBROUTINE HWHEGW +C---------------------------------------------------------------------- +C W + GAMMA --> FF'BAR : MEAN EVWGT = CROSS SECTION IN NANOBARN +C BASED ON BOSON GLUON FUSION OF ABBIENDI AND STANCO +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + DOUBLE PRECISION HWR,GMASS,EV(3),RV,LEP,Y,Q2,SHAT,Z,PHI,AJACOB, + & DSIGMA,ME,MP,ML,MREMIF(18),MFIN1(18),MFIN2(18),RS,SMA,W2,RSHAT + INTEGER LEPFIN,ID1,ID2,I,IQK,IFLAVU,IFLAVD,IMIN,IMAX,IFL,IPROO + LOGICAL CHARGD,INCLUD(18),INSIDE(18) + EXTERNAL HWR + SAVE LEPFIN,ID1,ID2 + COMMON /HWAREA/ LEP,Y,Q2,SHAT,Z,PHI,AJACOB,DSIGMA,ME,MP,ML,MREMIF, + & MFIN1,MFIN2,RS,SMA,W2,RSHAT,IQK,IFLAVU,IFLAVD,IMIN,IMAX,IFL, + & IPROO,CHARGD,INCLUD,INSIDE + IQK=MOD(IPROC,10) + CHARGD=.TRUE. + IF(GENEV) THEN +C + IDHW(4)=IDHW(1) + IDHW(5)=59 + IDHW(6)=15 + IDHW(7)=LEPFIN + IDHW(8)=ID1 + IDHW(9)=ID2 + DO 1 I=4,9 + 1 IDHEP(I)=IDPDG(IDHW(I)) +C + IFLAVD=ID1 + IFLAVU=ID2-6 +C + ISTHEP(4)=111 + ISTHEP(5)=112 + ISTHEP(6)=110 + ISTHEP(7)=113 + ISTHEP(8)=114 + ISTHEP(9)=114 +C + JMOHEP(1,4)=6 + JMOHEP(2,4)=7 + JMOHEP(1,5)=6 + JMOHEP(2,5)=5 + JMOHEP(1,6)=4 + JMOHEP(2,6)=5 + JMOHEP(1,7)=6 + JMOHEP(2,7)=4 + JMOHEP(1,8)=6 + JMOHEP(2,8)=9 + JMOHEP(1,9)=6 + JMOHEP(2,9)=8 + JDAHEP(1,4)=0 + JDAHEP(2,4)=7 + JDAHEP(1,5)=0 + JDAHEP(2,5)=5 + JDAHEP(1,6)=7 + JDAHEP(2,6)=9 + JDAHEP(1,7)=0 + JDAHEP(2,7)=4 + JDAHEP(1,8)=0 + JDAHEP(2,8)=9 + JDAHEP(1,9)=0 + JDAHEP(2,9)=8 +C---COMPUTATION OF MOMENTA IN LABORATORY FRAME OF REFERENCE +C---Persuade HWHBKI that the gluon is actually a photon... + GMASS=RMASS(13) + RMASS(13)=0 + CALL HWHBKI + RMASS(13)=GMASS +C---put the other outgoing lepton in as well + IDHW(10)=IDHW(2) + IDHEP(10)=IDPDG(IDHW(10)) + ISTHEP(10)=1 + JMOHEP(1,10)=2 + JMOHEP(2,10)=0 + JDAHEP(1,10)=0 + JDAHEP(2,10)=0 + JDAHEP(1,2)=5 + JDAHEP(2,2)=10 + CALL HWVDIF(4,PHEP(1,2),PHEP(1,5),PHEP(1,10)) + CALL HWUMAS(PHEP(1,10)) + NHEP=10 +C +C---if antilepton was first, do charge conjugation + IF (LEP.EQ.ONE) THEN + DO 27 I=7,9 + IF (IDHEP(I).NE.0 .AND. ABS(IDHEP(I)).LT.20) THEN + IDHW(I)=IDHW(I) + 6*SIGN(1,IDHEP(I)) + IDHEP(I)=-IDHEP(I) + ENDIF + 27 CONTINUE + ENDIF +C +C---half the time, do charge conjugation and parity flip + IF (HWR().GT.HALF) THEN + DO 2 I=4,10 + IF (IDHEP(I).NE.0 .AND. ABS(IDHEP(I)).LT.20) THEN + IDHW(I)=IDHW(I) + 6*SIGN(1,IDHEP(I)) + IDHEP(I)=-IDHEP(I) + ENDIF + PHEP(1,I)=-PHEP(1,I) + PHEP(2,I)=-PHEP(2,I) + PHEP(3,I)=-PHEP(3,I) + 2 CONTINUE + JMOHEP(1,10)=3-JMOHEP(1,10) + ENDIF +C + ELSE +C + EVWGT=ZERO +C---LEP = 1 IF TRACK 1 IS A LEPTON, -1 FOR ANTILEPTON + LEP=0. + IF (IDHW(1).GE.121.AND.IDHW(1).LE.126) THEN + LEP=1. + ELSEIF (IDHW(1).GE.127.AND.IDHW(1).LE.132) THEN + LEP=-1. + ENDIF + IF (LEP.EQ.ZERO) CALL HWWARN('HWHEGW',500,*999) +C---program only works if beam and target are charge conjugates + IF (INT(LEP)*(IDHW(2)-IDHW(1)).NE.6) + & CALL HWWARN('HWHEGW',501,*999) +C---program only works for equal energy beams colliding + IF (PHEP(3,3).NE.ZERO) CALL HWWARN('HWHEGW',503,*999) +C +C---FINAL STATE IS ALWAYS SET UP AS IF PARTICLE IS BEFORE ANTI-PARTICLE +C AND THEN INVERTED IF NECESSARY + LEPFIN = MIN(IDHW(1),IDHW(2))+1 + IF (IQK.LE.2) THEN + IFLAVU=2 + IFLAVD=1 + ID1 = 1 + ID2 = 8 + ELSEIF (IQK.LE.4) THEN + IFLAVU=4 + IFLAVD=3 + ID1 = 3 + ID2 =10 + ELSEIF (IQK.LE.6) THEN + IFLAVU=6 + IFLAVD=5 + ID1 = 5 + ID2 =12 + ELSEIF (IQK.EQ.7) THEN + IFLAVU=122 + IFLAVD=121 + ID1 = 121 + ID2 = 128 +C---INTERFERENCE TERMS IN EE -> EE NUE NUEB NEGLECTED: SIGMA UNRELIABLE + IF (FSTWGT) CALL HWWARN('HWHEGW',1,*999) + ELSEIF (IQK.EQ.8) THEN + IFLAVU=124 + IFLAVD=123 + ID1 = 123 + ID2 = 130 + ELSEIF (IQK.EQ.9) THEN + IFLAVU=126 + IFLAVD=125 + ID1 = 125 + ID2 = 132 + ELSE + CALL HWWARN('HWHEGW',504,*999) + ENDIF + IF (IQK.GT.0) THEN + IF (IQK.LE.6) IQK=0 + CALL HWHBRN(*999) + CALL HWHEGX + EVWGT = 2 * DSIGMA * AJACOB + IF (EVWGT.LT.ZERO) EVWGT=ZERO + ELSE +C---SUM OVER QUARK FLAVOURS + CALL HWHBRN(*999) + DO 3 I=1,3 + IF (SHAT.GT.(RMASS(IFLAVD)+RMASS(IFLAVU))**2) THEN + CALL HWHEGX + EV(I) = 2 * DSIGMA * AJACOB + IF (EV(I).LT.ZERO) EV(I)=ZERO + ELSE + EV(I)=ZERO + ENDIF + EVWGT=EVWGT+EV(I) + EV(I)=EVWGT + IFLAVU=IFLAVU+2 + IFLAVD=IFLAVD+2 + 3 CONTINUE +C---CHOOSE QUARK FLAVOUR + RV=EV(3)*HWR() + IF (RV.LT.EV(1)) THEN + ID1 = 1 + ID2 = 8 + ELSEIF (RV.LT.EV(2)) THEN + ID1 = 3 + ID2 =10 + ELSE + ID1 = 5 + ID2 =12 + ENDIF + ENDIF + ENDIF + 999 END +CDECK ID>, HWHEGX. +*CMZ :- -17/07/92 16.42.56 by Mike Seymour +*-- Author : Mike Seymour +C----------------------------------------------------------------------- + SUBROUTINE HWHEGX +C----------------------------------------------------------------------- +C COMPUTES DIFFERENTIAL CROSS SECTION DSIGMA IN (Y,Q2,ETA,Z,PHI) +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + DOUBLE PRECISION TMAX,TMIN,A1,A2,B1,B2,I0,I1,I2,I3,I4,I5,MUSQ, + & MDSQ,ETA,Q1,COSTHE,S,G,T,U,C1,C2,D1,D2,F1,F2,COSBET,WPROP,D(4,4), + & C(4,4),QU,QD,QE,QW,PHOTON,EMWSQ,EMSSQ,CFAC,LEP,Y,Q2,SHAT,Z,PHI, + & AJACOB,DSIGMA,ME,MP,ML,MREMIF(18),MFIN1(18),MFIN2(18),RS,SMA,W2, + & RSHAT + INTEGER IQK,IFLAVU,IFLAVD,IMIN,IMAX,IFL,IPROO,I,J + LOGICAL CHARGD,INCLUD(18),INSIDE(18) + COMMON /HWAREA/ LEP,Y,Q2,SHAT,Z,PHI,AJACOB,DSIGMA,ME,MP,ML,MREMIF, + & MFIN1,MFIN2,RS,SMA,W2,RSHAT,IQK,IFLAVU,IFLAVD,IMIN,IMAX,IFL, + & IPROO,CHARGD,INCLUD,INSIDE +C---INPUT VARIABLES + IF (IERROR.NE.0) RETURN + DSIGMA=0 + IF (IFLAVU.LE.12) THEN + QU=QFCH(MOD(IFLAVU-1,6)+1) + QD=QFCH(MOD(IFLAVD-1,6)+1) + CFAC=CAFAC + ELSE + QU=QFCH(MOD(IFLAVU-1,6)+11) + QD=QFCH(MOD(IFLAVD-1,6)+11) + CFAC=1 + ENDIF + QE=QFCH(11) + QW=+1 + EMWSQ=RMASS(198)**2 + EMSCA=PHEP(5,3) + EMSSQ=EMSCA**2 + MUSQ=RMASS(IFLAVU)**2 + MDSQ=RMASS(IFLAVD)**2 + ETA=(SHAT+Q2)/EMSSQ/Y + IF (ETA.GT.ONE) RETURN +C---CALCULATE KINEMATIC TERMS + G=0.5*(ETA*EMSSQ*Y-Q2) -0.5*(MUSQ+MDSQ) + S=0.5*ETA*EMSSQ + T=0.5*ETA*EMSSQ*(1-Y) + U=0.5*Q2 + C1=0.5*ETA*EMSSQ*Y*Z + C2=0.5*ETA*EMSSQ*Y*(1-Z) + COSBET=(-ETA*EMSSQ*Y+Q2*(2-Y))/(Y*(ETA*EMSSQ-Q2)) + IF (SHAT.LE.(RMASS(IFLAVU)+RMASS(IFLAVD))**2) RETURN + Q1=SQRT((SHAT**2+MUSQ**2+MDSQ**2 + & -2*SHAT*MUSQ-2*SHAT*MDSQ-2*MUSQ*MDSQ)/SHAT**2) + COSTHE=(1+(MDSQ-MUSQ)/SHAT-2*Z)/Q1 + IF (ABS(COSTHE).GE.ONE .OR. ABS(COSBET).GE.ONE) RETURN + D1=0.25*(ETA*EMSSQ-Q2)*(1+(MDSQ-MUSQ)/SHAT-Q1* + & (COSTHE*COSBET+SQRT((1-COSTHE**2)*(1-COSBET**2))*COS(PHI))) + D2=S-U-D1 + F1=D1+C1-G -MDSQ + F2=U+T-F1 +C---CALCULATE TRACE TERMS + CALL HWVZRO(16,D) + CALL HWVZRO(16,C) + D(1,1)=2*F1*C2*S + D(2,2)=2*C1*D2*T + D(3,3)=-D1*(2*F2*G-D2*(F1+2*U)) + & -D2*F1*(F2+U-D2+F1) + & +2*F1*F2*U + & -G*(-2*D1*(F1+F2+U)-F1*(D2+2*U)+2*D2*(U-F2)+2*U*(F2-U+G)) + D(4,4)=2*F1*C2*S + D(1,2)=(D1+U-F2)*(D1*F2-F1*D2)-G*(D1*(F2+U)+U*(U-F2-G)+F1*D2) + D(1,3)=D1*F2*(-2*F1+U-F2+D1) + & +F1*(F2*(D2-2*U)+F1*D2) + & +G*(-D1*(2*F1+F2+U)-F1*(D2+2*U)+U*(F2-U+G)) + D(1,4)=-2*F1*(D1+U)*(F2+G) + D(2,3)=D1*(D2*(F1+2*(U-F2))+F2*(F2-U-D1)) + & +F1*D2**2 + & +G*(D1*(F2+U)+D2*(F1-2*(U-F2))+U*(U-F2-G)) + D(2,4)=-D1*F2*(U-F2+D1) + & -F1*D2*(U-D1-G-F2) + & -G*(U*(F2-U+G)-D1*(F2+U)) + D(3,4)=D1*(F1*(D2+2*F2)+F2*(F2-U-D1)) + & +F1*(2*F2*U-D2*(U+F1)) + & +G*(D1*(2*F1+F2+U)+U*(2*F1-F2+U-G)) +C---REGULATE PROPAGATORS + TMAX=EMSSQ-2*G + TMIN=PHEP(5,2)**2 + A1=2*C1+MDSQ*(G+U)/G + A2=2*C2+MUSQ*(G+U)/G + B1=(2*U+MUSQ)/(2*G+2*U) + B2=(2*U+MDSQ)/(2*G+2*U) + I0=LOG(TMAX/TMIN) + I1=1/A1*(I0-LOG((A1+B1*TMAX)/(A1+B1*TMIN))) + I2=1/A2*(I0-LOG((A2+B2*TMAX)/(A2+B2*TMIN))) + I3=(B1*I1-B2*I2)/(B1*A2-B2*A1) + I4=1/A1*(I1+1/(A1+B1*TMAX)-1/(A1+B1*TMIN)) + I5=1/A2*(I2+1/(A2+B2*TMAX)-1/(A2+B2*TMIN)) + WPROP=1/((2*G-EMWSQ)**2+GAMW**2*EMWSQ) +C---CALCULATE COEFFICIENTS + C(1,1)= QU**2/(2*U+EMWSQ)**2 *I5 + C(2,2)= QD**2/(2*U+EMWSQ)**2 *I4 + C(3,3)= QW**2/(2*U+EMWSQ)**2 *WPROP *I0 + C(4,4)= QE**2/(2*S)**2 *WPROP *I0 + C(1,2)= 2*QU*QD/(2*U+EMWSQ)**2 *I3 + C(1,3)= 2*QW*QU/(2*U+EMWSQ)**2 *WPROP*(2*G-EMWSQ) *I2 + C(1,4)= 2*QU*QE/(2*S*(2*U+EMWSQ)) *WPROP*(2*G-EMWSQ) *I2 + C(2,3)= 2*QW*QD/(2*U+EMWSQ)**2 *WPROP*(2*G-EMWSQ) *I1 + C(2,4)= 2*QD*QE/(2*S*(2*U+EMWSQ)) *WPROP*(2*G-EMWSQ) *I1 + C(3,4)= 2*QW*QE/(2*S*(2*U+EMWSQ)) *WPROP *I0 +C---CALCULATE PHOTON STRUCTURE FUNCTION + PHOTON=ALPHEM * (1+(1-ETA)**2) / (2*PIFAC*ETA) +C---SUM ALL TENSOR CONTRIBUTIONS + DO 10 I=1,4 + DO 10 J=1,4 + 10 DSIGMA=DSIGMA + C(I,J)*D(I,J) +C---CALCULATE TOTAL SUMMED AND AVERAGED MATRIX ELEMENT SQUARED + DSIGMA = DSIGMA * 2*CFAC*(4*PIFAC*ALPHEM)**3/SWEIN**2 +C---CALCULATE DIFFERENTIAL CROSS-SECTION + DSIGMA = DSIGMA * GEV2NB*PHOTON/(512*PIFAC**4*ETA*EMSSQ) + 999 END +CDECK ID>, HWHEPA. +*CMZ :- -26/04/91 14.55.44 by Federico Carminati +*-- Author : Bryan Webber and Ian Knowles +C----------------------------------------------------------------------- + SUBROUTINE HWHEPA +C----------------------------------------------------------------------- +C (Initially polarised) e+e- --> ffbar (f=quark, mu or tau) +C If IPROC=107: --> gg, distributed as sum of light quarks. +C If fermion flavour specified mass effects fully included. +C EVWGT=sig(e+e- --> ffbar) in nb +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + DOUBLE PRECISION HWR,HWRUNI,HWUPCM,HWUAEM,Q2NOW,Q2LST,FACTR, + & VF2,VF,CLF(7),PRAN,PQWT,PMAX,PTHETA,SINTH2,CPHI,SPHI,C2PHI,S2PHI, + & PPHI,SINTH,PCM,PP(5),EWGT + INTEGER ID1,ID2,IDF,IQ,IQ1,I + EXTERNAL HWR,HWRUNI,HWUPCM,HWUAEM + SAVE Q2LST,FACTR,ID1,ID2,VF2,VF,CLF,EWGT + DATA Q2LST/0./ + IF (GENEV) THEN + IF (ID2.EQ.0) THEN +C Choose quark flavour + PRAN=TQWT*HWR() + PQWT=0. + DO 10 IQ=1,MAXFL + PQWT=PQWT+CLQ(1,IQ) + IF (PQWT.GT.PRAN) GOTO 11 + 10 CONTINUE + IQ=MAXFL + 11 IQ1=MAPQ(IQ) + DO 20 I=1,7 + 20 CLF(I)=CLQ(I,IQ) + ELSE + IQ1=ID1 + ENDIF +C Label particles, assign outgoing particle masses + IDHW(NHEP+1)=200 + IDHEP(NHEP+1)=23 + ISTHEP(NHEP+1)=110 + IF (ID1.EQ.7) THEN + IDHW(NHEP+2)=13 + IDHW(NHEP+3)=13 + IDHEP(NHEP+2)=21 + IDHEP(NHEP+3)=21 + PHEP(5,NHEP+2)=RMASS(13) + PHEP(5,NHEP+3)=RMASS(13) + ELSE + IDHW(NHEP+2)=IQ1 + IDHW(NHEP+3)=IQ1+6 + IDHEP(NHEP+2)=IDPDG(IQ1) + IDHEP(NHEP+3)=-IDHEP(NHEP+2) + PHEP(5,NHEP+2)=RMASS(IQ1) + PHEP(5,NHEP+3)=RMASS(IQ1) + ENDIF + ISTHEP(NHEP+2)=113 + ISTHEP(NHEP+3)=114 + JMOHEP(1,NHEP+1)=1 + IF (JDAHEP(1,1).NE.0) JMOHEP(1,NHEP+1)=JDAHEP(1,1) + JMOHEP(2,NHEP+1)=2 + IF (JDAHEP(1,2).NE.0) JMOHEP(1,NHEP+1)=JDAHEP(1,2) + JMOHEP(1,NHEP+2)=NHEP+1 + JMOHEP(2,NHEP+2)=NHEP+3 + JMOHEP(1,NHEP+3)=NHEP+1 + JMOHEP(2,NHEP+3)=NHEP+2 + JDAHEP(1,NHEP+1)=NHEP+2 + JDAHEP(2,NHEP+1)=NHEP+3 + JDAHEP(1,NHEP+2)=0 + JDAHEP(2,NHEP+2)=NHEP+3 + JDAHEP(1,NHEP+3)=0 + JDAHEP(2,NHEP+3)=NHEP+2 +C Generate polar and azimuthal angular distributions: +C CLF(1)*(1+(VF*COSTH)**2)+CLF(2)*(1-VF**2)+CLF(3)*2.*VF*COSTH +C +(VF*SINTH)**2*(CLF(4)*COS(2*PHI-PHI1-PHI2) +C +CLF(6)*SIN(2*PHI-PHI1-PHI2)) + PMAX=CLF(1)*(1.+VF2)+CLF(2)*(1.-VF2)+ABS(CLF(3))*2.*VF + 30 COSTH=HWRUNI(0,-ONE, ONE) + PTHETA=CLF(1)*(1.+VF2*COSTH**2)+CLF(2)*(1.-VF2) + & +CLF(3)*2.*VF*COSTH + IF (PTHETA.LT.PMAX*HWR()) GOTO 30 + IF (IDHW(1).GT.IDHW(2)) COSTH=-COSTH + SINTH2=1.-COSTH**2 + IF (TPOL) THEN + PMAX=PTHETA+VF2*SINTH2*SQRT(CLF(4)**2+CLF(6)**2) + 40 CALL HWRAZM(ONE,CPHI,SPHI) + C2PHI=2.*CPHI**2-1. + S2PHI=2.*CPHI*SPHI + PPHI=PTHETA+(CLF(4)*(C2PHI*COSS+S2PHI*SINS) + & +CLF(6)*(S2PHI*COSS-C2PHI*SINS))*VF2*SINTH2 + IF (PPHI.LT.PMAX*HWR()) GOTO 40 + ELSE + CALL HWRAZM(ONE,CPHI,SPHI) + ENDIF +C Construct final state 4-mommenta + CALL HWVEQU(5,PHEP(1,3),PHEP(1,NHEP+1)) + PCM=HWUPCM(PHEP(5,NHEP+1),PHEP(5,NHEP+2),PHEP(5,NHEP+3)) +C PP is momentum of track NHEP+2 in CoM (track NHEP+1) frame + SINTH=SQRT(SINTH2) + PP(5)=PHEP(5,NHEP+2) + PP(1)=PCM*SINTH*CPHI + PP(2)=PCM*SINTH*SPHI + PP(3)=PCM*COSTH + PP(4)=SQRT(PCM**2+PP(5)**2) + CALL HWULOB(PHEP(1,NHEP+1),PP(1),PHEP(1,NHEP+2)) + CALL HWVDIF(4,PHEP(1,NHEP+1),PHEP(1,NHEP+2),PHEP(1,NHEP+3)) +C Set production vertices + CALL HWVZRO(4,VHEP(1,NHEP+2)) + CALL HWVEQU(4,VHEP(1,NHEP+2),VHEP(1,NHEP+3)) + NHEP=NHEP+3 + ELSE + EMSCA=PHEP(5,3) + Q2NOW=EMSCA**2 + IF (Q2NOW.NE.Q2LST) THEN +C Calculate coefficients for cross-section + EMSCA=PHEP(5,3) + Q2LST=Q2NOW + FACTR=PIFAC*GEV2NB*HWUAEM(Q2NOW)**2/Q2NOW + ID1=MOD(IPROC,10) + ID2=MOD(ID1,7) + IF (ID2.EQ.0) THEN + CALL HWUEEC(1) + VF2=1. + VF=1. + EWGT=FACTR*FLOAT(NCOLO)*TQWT*4./3. + ELSE + IF (IPROC.LT.150) THEN + IDF=ID1 + FACTR=FACTR*FLOAT(NCOLO) + ELSE + ID1=2*ID1+119 + IDF=ID1-110 + ENDIF + IF (EMSCA.LE.2.*RMASS(ID1)) then + EWGT=0. + ELSE + CALL HWUCFF(11,IDF,Q2NOW,CLF(1)) + VF2=1.-4.*RMASS(ID1)**2/Q2NOW + VF=SQRT(VF2) + EWGT=FACTR*VF*(CLF(1)*(1.+VF2/3.)+CLF(2)*(1.-VF2)) + ENDIF + ENDIF + ENDIF + EVWGT=EWGT + ENDIF + 999 END +CDECK ID>, HWHEPG. +*CMZ :- -02/05/91 10.57.27 by Federico Carminati +*-- Author : Bryan Webber and Ian Knowles +C----------------------------------------------------------------------- + SUBROUTINE HWHEPG +C----------------------------------------------------------------------- +C (Initially polarised) e-e+ --> qqbar g with parton thrust < THMAX, +C equivalent to: maximum parton energy < THMAX*EMSCA/2; or a JADE E0 +c scheme, y_cut=1.-THMAX. +C If flavour specified mass effects fully included. +C EVWGT=sig(e^-e^+ --> qqbar g) in nb +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + DOUBLE PRECISION HWR,HWUALF,HWUAEM,HWULDO,HWDPWT,Q2NOW,Q2LST, + & PHASP,QGMAX,QGMIN,FACTR,QM2,CLF(7),ORDER,PRAN,PQWT,QQG,QBG,SUM, + & RUT,QQLM,QQLP,QBLM,QBLP,DYN1,DYN2,DYN3,DYN4,DYN5,DYN6,XQ2,X2SUM, + & PVRT(4) + INTEGER ID1,IQ,I,LM,LP,IQ1 + LOGICAL MASS + EXTERNAL HWR,HWUALF,HWUAEM,HWULDO,HWDPWT + SAVE Q2NOW,Q2LST,QGMAX,QGMIN,FACTR,ORDER,ID1,MASS,QM2,CLF,LM,LP, + & IQ1,QQG,QBG,SUM + DATA Q2LST/0./ + IF (GENEV) THEN +C Label produced partons and calculate gluon spin + IDHW(NHEP+1)=200 + IDHW(NHEP+2)=IQ1 + IDHW(NHEP+3)=13 + IDHW(NHEP+4)=IQ1+6 + IDHEP(NHEP+1)=23 + IDHEP(NHEP+2)=IQ1 + IDHEP(NHEP+3)=21 + IDHEP(NHEP+4)=-IQ1 + ISTHEP(NHEP+1)=110 + ISTHEP(NHEP+2)=113 + ISTHEP(NHEP+3)=114 + ISTHEP(NHEP+4)=114 + JMOHEP(1,NHEP+1)=LM + JMOHEP(2,NHEP+1)=LP + JMOHEP(1,NHEP+2)=NHEP+1 + JMOHEP(2,NHEP+2)=NHEP+3 + JMOHEP(1,NHEP+3)=NHEP+1 + JMOHEP(2,NHEP+3)=NHEP+4 + JMOHEP(1,NHEP+4)=NHEP+1 + JMOHEP(2,NHEP+4)=NHEP+2 + JDAHEP(1,NHEP+1)=NHEP+2 + JDAHEP(2,NHEP+1)=NHEP+4 + JDAHEP(1,NHEP+2)=0 + JDAHEP(2,NHEP+2)=NHEP+4 + JDAHEP(1,NHEP+3)=0 + JDAHEP(2,NHEP+3)=NHEP+2 + JDAHEP(1,NHEP+4)=0 + JDAHEP(2,NHEP+4)=NHEP+3 +C Decide which quark radiated and assign production vertices + XQ2=(Q2NOW-2.*QBG)**2 + X2SUM=XQ2+(Q2NOW-2.*QQG)**2 + IF (XQ2.LT.HWR()*X2SUM) THEN +C Quark radiated the gluon + CALL HWVZRO(4,VHEP(1,NHEP+4)) + CALL HWVSUM(4,PHEP(1,NHEP+2),PHEP(1,NHEP+3),PVRT) + CALL HWUDKL(IQ1,PVRT,VHEP(1,NHEP+3)) + CALL HWVEQU(4,VHEP(1,NHEP+3),VHEP(1,NHEP+2)) + ELSE +C Anti-quark radiated the gluon + CALL HWVZRO(4,VHEP(1,NHEP+2)) + CALL HWVSUM(4,PHEP(1,NHEP+4),PHEP(1,NHEP+3),PVRT) + CALL HWUDKL(IQ1,PVRT,VHEP(1,NHEP+3)) + CALL HWVEQU(4,VHEP(1,NHEP+3),VHEP(1,NHEP+4)) + ENDIF + IF (AZSPIN) THEN +C Calculate the transverse polarisation of the gluon +C Correlation with leptons presently neglected + GPOLN=(QQG**2+QBG**2)/((Q2NOW-2.*SUM)*Q2NOW) + GPOLN=2./(2.+GPOLN) + ENDIF + NHEP=NHEP+4 + ELSE + EMSCA=PHEP(5,3) + Q2NOW=EMSCA**2 + IF (Q2NOW.NE.Q2LST) THEN + Q2LST=Q2NOW + PHASP=3.*THMAX-2. + IF (PHASP.LE.ZERO) CALL HWWARN('HWHEPG',400,*999) + QGMAX=.5*Q2NOW*THMAX + QGMIN=.5*Q2NOW*(1.-THMAX) + FACTR=GEV2NB*FLOAT(NCOLO)*CFFAC*HWUALF(1,EMSCA) + & *.5*(HWUAEM(Q2NOW)*PHASP)**2/Q2NOW + LM=1 + IF (JDAHEP(1,LM).NE.0) LM=JDAHEP(1,LM) + LP=2 + IF (JDAHEP(1,LP).NE.0) LP=JDAHEP(1,LP) + ORDER=1. + IF (IDHW(1).GT.IDHW(2)) ORDER=-ORDER + ID1=MOD(IPROC,10) + IF (ID1.NE.0) THEN + MASS=.TRUE. + QM2=RMASS(ID1)**2 + CALL HWUCFF(11,ID1,Q2NOW,CLF(1)) + FACTR=FACTR*CLF(1) + ELSE + MASS=.FALSE. + CALL HWUEEC(1) + FACTR=FACTR*TQWT + ENDIF + ENDIF + IF (ID1.EQ.0) THEN +C Select quark flavour + PRAN=TQWT*HWR() + PQWT=0. + DO 10 IQ=1,MAXFL + PQWT=PQWT+CLQ(1,IQ) + IF (PQWT.GT.PRAN) GOTO 11 + 10 CONTINUE + IQ=MAXFL + 11 IQ1=MAPQ(IQ) + DO 20 I=1,7 + 20 CLF(I)=CLQ(I,IQ) + ELSEIF (Q2NOW.GT.4*QM2/(2*THMAX-1)) THEN + IQ1=ID1 + ELSE + EVWGT=0. + RETURN + ENDIF +C Select final state momentum configuration + CALL HWVEQU(5,PHEP(1,3),PHEP(1,NHEP+1)) + PHEP(5,NHEP+2)=RMASS(IQ1) + PHEP(5,NHEP+3)=RMASS(13) + PHEP(5,NHEP+4)=RMASS(IQ1) + 30 CALL HWDTHR(PHEP(1,NHEP+1),PHEP(1,NHEP+2), + & PHEP(1,NHEP+3),PHEP(1,NHEP+4),HWDPWT) + QQG=HWULDO(PHEP(1,NHEP+2),PHEP(1,NHEP+3)) + IF (QQG.LT.QGMIN) GOTO 30 + QBG=HWULDO(PHEP(1,NHEP+4),PHEP(1,NHEP+3)) + SUM=QQG+QBG + IF (QBG.LT.QGMIN.OR.SUM.GT.QGMAX) GOTO 30 + QQLM=HWULDO(PHEP(1,NHEP+2),PHEP(1,LM)) + QQLP=HWULDO(PHEP(1,NHEP+2),PHEP(1,LP)) + QBLM=HWULDO(PHEP(1,NHEP+4),PHEP(1,LM)) + QBLP=HWULDO(PHEP(1,NHEP+4),PHEP(1,LP)) + DYN1=QQLM**2+QQLP**2+QBLM**2+QBLP**2 + DYN2=0. + DYN3=DYN1-2.*(QQLM**2+QBLP**2) + IF (MASS) THEN + RUT=1./QQG+1./QBG + DYN1=DYN1+8.*QM2*(1.-.25*Q2NOW*RUT + & +QQLM*QQLP/(Q2NOW*QBG)+QBLM*QBLP/(Q2NOW*QQG)) + DYN2=QM2*(Q2NOW-SUM*(2.+QM2*RUT) + & -4.*HWULDO(PHEP(1,NHEP+3),PHEP(1,LM)) + & *HWULDO(PHEP(1,NHEP+3),PHEP(1,LP))/Q2NOW) + DYN3=DYN3+QM2*2.*RUT*(QBG*(QBLP-QBLM)-QQG*(QQLP-QQLM)) + ENDIF + EVWGT=CLF(1)*DYN1+CLF(2)*DYN2+ORDER*CLF(3)*DYN3 + IF (TPOL) THEN +C Include event plane azimuthal angle + DYN4=.5*Q2NOW + DYN5=DYN4 + DYN6=0. + IF (MASS) THEN + DYN4=DYN4-QM2*SUM/QBG + DYN5=DYN5-QM2*SUM/QQG + DYN6=QM2 + ENDIF + EVWGT=EVWGT + & +(CLF(4)*COSS-CLF(6)*SINS) + & *(DYN4*(PHEP(1,NHEP+2)**2-PHEP(2,NHEP+2)**2) + & +DYN5*(PHEP(1,NHEP+4)**2-PHEP(2,NHEP+4)**2)) + & +(CLF(4)*SINS+CLF(6)*COSS)*2. + & *(DYN4*PHEP(1,NHEP+2)*PHEP(2,NHEP+2) + & +DYN5*PHEP(1,NHEP+4)*PHEP(2,NHEP+4)) + & +(CLF(5)*COSS-CLF(7)*SINS)*DYN6 + & *(PHEP(1,NHEP+3)**2-PHEP(2,NHEP+3)**2) + & +(CLF(5)*SINS+CLF(7)*COSS)*DYN6*2. + & *PHEP(1,NHEP+3)*PHEP(2,NHEP+3) + ENDIF +C Assign event weight + EVWGT=EVWGT*FACTR/(QQG*QBG*CLF(1)) + ENDIF + 999 END +CDECK ID>, HWHEW0. +*CMZ :- -26/04/91 11.11.55 by Bryan Webber +*-- Author : Zoltan Kunszt, modified by Bryan Webber & Mike Seymour +C----------------------------------------------------------------------- + SUBROUTINE HWHEW0(IP,ETOT,XM,PR,WEIGHT,CR) +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + DOUBLE PRECISION HWR,ETOT,XM(2),PR(5,2),WEIGHT,CR,XM1,XM2,S, + & D1,PABS,D,CX,C,E,F,SC,G + INTEGER IP,I + EXTERNAL HWR + WEIGHT=ZERO + XM1=XM(1)**2 + XM2=XM(2)**2 + S=ETOT*ETOT + D1=S-XM1-XM2 + PABS=D1*D1-4.*XM1*XM2 + IF (PABS.LE.ZERO) RETURN + PABS=SQRT(PABS) + D=D1/PABS + IF(IP.EQ.2)GOTO3 + CX=CR + C=D-(D+CX)*((D-CR)/(D+CX))**HWR() + GOTO 4 +3 E=((D+ONE)/(D-ONE))*(TWO*HWR()-ONE) + C=D*((E-ONE)/(E+ONE)) +4 F=2D0*PIFAC*HWR() + SC=SQRT(ONE-C*C) + PR(4,1)=(S+XM1-XM2)/(TWO*ETOT) + PR(5,1)=PR(4,1)*PR(4,1)-XM1 + IF (PR(5,1).LE.ZERO) RETURN + PR(5,1)=SQRT(PR(5,1)) + PR(4,2)=ETOT-PR(4,1) + PR(3,1)=PR(5,1)*C + PR(5,2)=PR(5,1) + PR(2,1)=PR(5,1)*SC*COS(F) + PR(1,1)=PR(5,1)*SC*SIN(F) + DO 7 I=1,3 +7 PR(I,2)=-PR(I,1) + G=0. + IF(IP.EQ.1)G=(D-C)*LOG((D+CX)/(D-CR)) + IF(IP.EQ.2)G=(D*D-C*C)/D*LOG((D+ONE)/(D-ONE)) + WEIGHT=PIFAC*G*PR(5,1)/ETOT*HALF + RETURN + END +CDECK ID>, HWHEW1. +*CMZ :- -26/04/91 11.11.55 by Bryan Webber +*-- Author : Zoltan Kunszt, modified by Bryan Webber +C----------------------------------------------------------------------- + SUBROUTINE HWHEW1(NPART) +C----------------------------------------------------------------------- + IMPLICIT NONE + DOUBLE PRECISION P(4,7),XMASS,PLAB,PRW,PCM + INTEGER NPART,I,J,K + COMMON/HWHEWP/ XMASS(10),PLAB(5,10),PRW(5,2),PCM(5,10) + DO 10 I=1,NPART + P(1,I)=PLAB(3,I) + P(2,I)=PLAB(1,I) + P(3,I)=PLAB(2,I) + P(4,I)=PLAB(4,I) + 10 CONTINUE + DO 20 J=1,4 + DO 30 K=1,(NPART-2) + 30 PCM(J,K)=P(J,K+2) + PCM(J,NPART-1)=-P(J,1) + PCM(J,NPART)=-P(J,2) + 20 CONTINUE + END +CDECK ID>, HWHEW2. +*CMZ :- -26/04/91 13.22.25 by Federico Carminati +*-- Author : Zoltan Kunszt, modified by Bryan Webber +C----------------------------------------------------------------------- + SUBROUTINE HWHEW2(NPART,PPCM,H,CH,D) +C----------------------------------------------------------------------- +C PCM SHOULD BE DEFINED SUCH THAT ALL 4-MOMENTA ARE OUTGOING. +C CONVENTION FOR PCM AND P IS THAT DIRECTION 1 =BEAM, COMPONENT +C 4 = ENERGY AND COMPONENT 2 AND 3 ARE TRANSVERSE COMPONENTS. +C THUS INCOMING MOMENTA SHOULD CORRESPOND TO OUTGOING MOMENTA +C OF NEGATIVE ENERGY. +C PCM IS FILLED BY PHASE SPACE MONTE CARLO. +C I1-I7 HERE REFER TO HOW PCM INDEXING IS MAPPED TO OUR STANDARD +C 1-6=GLUON,GLUON,Q,QBAR,QP,QPBAR ORDERING ` +C----------------------------------------------------------------------- + IMPLICIT NONE + COMPLEX PT5,ZT,Z1,ZI,ZP,ZQ,ZD,ZPS,ZQS,ZDPM,ZDMP,H(7,7),CH(7,7), + & D(7,7) + DOUBLE PRECISION ZERO,ONE,PPCM(5,7),P(5,7),WRN(7),EPS,Q1,Q2,QP,QM, + & P1,P2,PP,PM,DMP,DPM,PT,QT,PTI,QTI + INTEGER J,L,IJ,II,JJ,I,NPART,IP1,IPP1 + PARAMETER (ZERO=0.D0,ONE=1.D0) + EPS=0.0000001 + ZI=CMPLX(0.,1.) + Z1=CMPLX(1.,0.) +C FOLLOWING DO LOOP IS TO CONVERT TO OUR STANDARD INDEXING + DO 1 L=1,NPART + DO 1 IJ=1,4 +1 P(IJ,L)=PPCM(IJ,L) + DO 2 II=1,7 + WRN(II)=ONE + IF(P(4,II).LT.ZERO) WRN(II)=-ONE + DO 2 JJ=1,4 + P(JJ,II)=WRN(II)*P(JJ,II) + 2 CONTINUE +C THE ABOVE CHECKS FOR MOMENTA WITH NEGATIVE ENERGY,INNER PRODUCTS +C ARE EXPRESSED DIFFERENTLY FOR DIFFERENT CASES + DO 11 I=1,NPART-1 + IP1=I+1 + DO 11 J=IP1,NPART + Q1=P(4,I)+P(1,I) + QP=0.0 + IF(Q1.GT.EPS)QP=SQRT(Q1) + Q2=P(4,I)-P(1,I) + QM=0.0 + IF(Q2.GT.EPS)QM=SQRT(Q2) + P1=P(4,J)+P(1,J) + PP=0. + IF(P1.GT.EPS)PP=SQRT(P1) + P2=P(4,J)-P(1,J) + PM=0. + IF(P2.GT.EPS)PM=SQRT(P2) + DMP=PM*QP + ZDMP=CMPLX(DMP,ZERO) + DPM=PP*QM + ZDPM=CMPLX(DPM,ZERO) +C NOTE THAT IN OUR INNER PRODUCT NOTATION WE ARE COMPUTING + PT=SQRT(P(2,J)**2+P(3,J)**2) + QT=SQRT(P(2,I)**2+P(3,I)**2) + IF(PT.GT.EPS) GOTO 99 + ZP=Z1 + GOTO 98 + 99 PTI=ONE/PT + ZP=CMPLX(PTI*P(2,J),PTI*P(3,J)) + 98 ZPS=CONJG(ZP) + IF(QT.GT.EPS) GOTO 89 + ZQ=Z1 + GOTO 88 + 89 QTI=ONE/QT + ZQ=CMPLX(QTI*P(2,I),QTI*P(3,I)) + 88 ZQS=CONJG(ZQ) + ZT=Z1 + IF(WRN(I).LT.ZERO) ZT=ZT*ZI + IF(WRN(J).LT.ZERO) ZT=ZT*ZI + H(J,I)=(ZDMP*ZP-ZDPM*ZQ)*ZT + CH(J,I)=(ZDMP*ZPS-ZDPM*ZQS)*ZT + ZD=H(J,I)*CH(J,I) + PT5=CMPLX(.5,0.) + D(J,I)=PT5*ZD + 11 CONTINUE + DO 60 I=1,NPART-1 + IPP1=I+1 + DO 60 J=IPP1,NPART + H(I,J)=-H(J,I) + CH(I,J)=-CH(J,I) + 60 D(I,J)=D(J,I) + RETURN + END +CDECK ID>, HWHEW3. +*CMZ :- -27/03/92 19.48.55 by Mike Seymour +*-- Author : Zoltan Kunszt, modified by Bryan Webber +C----------------------------------------------------------------------- + SUBROUTINE HWHEW3(N1,N2,N3,N4,N5,N6,AMPWW) +C----------------------------------------------------------------------- +C RECALL THAT N1,N3,N5 MUST BE OUTGOING FERMIONS, AND N2,N4,N6 MUST BE +C OUTGOING ANTI-FERMIONS; 3,4 FOR W-, 5,6 FOR W+ +C +C EQ1 AND T31 ARE FOR OUTOING INITIAL QUARK +C CHOOSE APPROPRIATE CASE ACCORDING TO NUPDN +C NUPDN=1 FOR UUBAR COLLISIONS, NUPDN=2 FOR DDBAR COLLISIONS +C NFINAL CHOOSES THE FINAL DECAYS, 1 FOR DOUBLE LEPTON, 2 FOR 1 FLAVOR +C LEPTON+2FAMILIES OF QUARKS, 3 THE SAME, 4 FOR DOUBLE 2FAM3COLOR QUARKS +C +C NOTE: EXTERNAL FACTOR OF COLOR AVERAGE AND SPIN AVERAGE AND +C COUPLING (E**8/4/9) MUST BE INCLUDED AS WELL AS COMPENSATION +C FOR ON POLE APPROXIMATION AS DESIRED. +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + COMPLEX HWHEW4,ZH,ZCH,ZD,ZAMP1,ZAMP2,ZAMP3,DWW,CWW,BWW,AWW,AWWM, + & AWWP,AMPTEM,ZTWO,ZHALF + DOUBLE PRECISION XW,ZMASS,T3,EQ1,RR,RL,ZM2,AMP2,RKW,COLFAC(4), + & AMPWW(4) + INTEGER I,N1,N2,N3,N4,N5,N6 + EXTERNAL HWHEW4 + COMMON/HWHEWQ/ZH(7,7),ZCH(7,7),ZD(7,7) + EQUIVALENCE (XW,SWEIN),(ZMASS,RMASS(200)) + DATA COLFAC/1.D0,3.D0,3.D0,9.D0/ + DATA ZTWO,ZHALF/(2.0,0.0),(0.5,0.0)/ + T3=-1.D0 + EQ1=-1.D0 + RR=-2.D0*EQ1*XW + RL=T3+RR + ZM2=ZMASS*ZMASS + ZAMP1=CMPLX(ZM2)/(ZTWO*ZD(N1,N2)) + & /(ZTWO*ZD(N1,N2)+CMPLX(-ZM2,GAMZ*ZMASS)) + ZAMP2=ZHALF/(ZD(N1,N3)+ZD(N1,N4)+ZD(N3,N4)) + ZAMP3=ZHALF/(ZD(N1,N5)+ZD(N1,N6)+ZD(N5,N6)) + DWW=CMPLX(RL)*ZAMP1+T3/(ZTWO*ZD(N1,N2)) + CWW=CMPLX(RR)*ZAMP1 + AWW=DWW + BWW=DWW-ZAMP3 + AWWM=AWW*HWHEW4(N1,N2,N3,N4,N5,N6)-BWW*HWHEW4(N1,N2,N5,N6,N3,N4) + AWWP=CWW*(HWHEW4(N2,N1,N5,N6,N3,N4)-HWHEW4(N2,N1,N3,N4,N5,N6)) + AMPTEM=AWWM*CONJG(AWWM)+AWWP*CONJG(AWWP) + AMP2=REAL(AMPTEM) +C AMP2 DOES NOT INCLUDE COLOR OR FLAVOR SUMS OR AVERAGES YET +C NOR DOES IT INCLUDE TO THIS POINT KWW**2 +C 1 LEPTON FLAVOR IF APPROPRIATE FOR NFINAL CHOICE + RKW=0.25D0/XW**2 + DO 6 I=1,4 +6 AMPWW(I)=AMP2*COLFAC(I)*RKW*RKW + RETURN + END +CDECK ID>, HWHEW4. +*CMZ :- -26/04/91 10.18.57 by Bryan Webber +*-- Author : Zoltan Kunszt, modified by Bryan Webber +C----------------------------------------------------------------------- + FUNCTION HWHEW4(N1,N2,N3,N4,N5,N6) +C----------------------------------------------------------------------- + IMPLICIT NONE + COMPLEX HWHEW4,ZH,ZCH,ZD + INTEGER N1,N2,N3,N4,N5,N6 + COMMON/HWHEWQ/ZH(7,7),ZCH(7,7),ZD(7,7) + HWHEW4=CMPLX(4.0)*ZH(N1,N3)*ZCH(N2,N6)*(ZH(N1,N5)*ZCH(N1,N4) + X +ZH(N3,N5)*ZCH(N3,N4)) + RETURN + END +CDECK ID>, HWHEW5. +*CMZ : 20/08/91 22.09.33 by Federico Carminati +*-- Author : Zoltan Kunszt, modified by Mike Seymour +C----------------------------------------------------------------------- + SUBROUTINE HWHEW5(N1,N2,N3,N4,N5,N6,HELSUM,HELCTY,ID1,ID2) +C----------------------------------------------------------------------- +C RECALL THAT N1,N3,N5 MUST BE OUTGOING FERMIONS, AND N2,N4,N6 MUST BE +C OUTGOING ANTI-FERMIONS; 3,4 FOR Z0, 5,6 FOR Z0 +C +C EQ1 AND T31 ARE FOR OUTOING INITIAL QUARK +C CHOOSE APPROPRIATE CASE ACCORDING TO NUPDN +C NUPDN=1 FOR UUBAR COLLISIONS, NUPDN=2 FOR DDBAR COLLISIONS +C NFINAL CHOOSES THE FINAL DECAYS, 1 FOR DOUBLE LEPTON, 2 FOR 1 FLAVOR +C LEPTON+2FAMILIES OF QUARKS, 3 THE SAME, 4 FOR DOUBLE 2FAM3COLOR QUARKS +C +C NOTE: EXTERNAL FACTOR OF COLOR AVERAGE AND SPIN AVERAGE AND +C COUPLING (E**8/4/9) MUST BE INCLUDED AS WELL AS COMPENSATION +C FOR ON POLE APPROXIMATION AS DESIRED. +C +C---SLIGHTLY MODIFIED BY MHS, SO THAT HELCTY REFERS TO THE FINAL STATE +C INDICATED BY ID1,ID2 +C----------------------------------------------------------------------- + IMPLICIT NONE + COMPLEX HWHEW4,ZH,ZCH,ZD,ZAMM(8),ZS134,ZS156,ZS234,ZS256,ZTWO + DOUBLE PRECISION CPFAC,CPALL,HELSUM,HELCTY,AMM + INTEGER N1,N2,N3,N4,N5,N6,ID1,ID2,I + EXTERNAL HWHEW4 + COMMON/HWHEWQ/ZH(7,7),ZCH(7,7),ZD(7,7) + COMMON/HWHEWR/CPFAC(12,12,8),CPALL(8) + DATA ZTWO/(2.0,0.0)/ +C THE MATRIX ELEMENT DEPENDS ON + ZS134=(ZD(N1,N3)+ZD(N1,N4)+ZD(N3,N4))*ZTWO + ZS156=(ZD(N1,N5)+ZD(N1,N6)+ZD(N5,N6))*ZTWO + ZS234=(ZD(N2,N3)+ZD(N2,N4)+ZD(N3,N4))*ZTWO + ZS256=(ZD(N2,N5)+ZD(N2,N6)+ZD(N5,N6))*ZTWO + ZAMM(1)=HWHEW4(N1,N2,N3,N4,N5,N6)/ZS134+ + > HWHEW4(N1,N2,N5,N6,N3,N4)/ZS156 + ZAMM(2)=HWHEW4(N1,N2,N4,N3,N5,N6)/ZS134+ + > HWHEW4(N1,N2,N5,N6,N4,N3)/ZS156 + ZAMM(3)=HWHEW4(N1,N2,N3,N4,N6,N5)/ZS134+ + > HWHEW4(N1,N2,N6,N5,N3,N4)/ZS156 + ZAMM(4)=HWHEW4(N1,N2,N4,N3,N6,N5)/ZS134+ + > HWHEW4(N1,N2,N6,N5,N4,N3)/ZS156 + ZAMM(5)=HWHEW4(N2,N1,N3,N4,N5,N6)/ZS234+ + > HWHEW4(N2,N1,N5,N6,N3,N4)/ZS256 + ZAMM(6)=HWHEW4(N2,N1,N4,N3,N5,N6)/ZS234+ + > HWHEW4(N2,N1,N5,N6,N4,N3)/ZS256 + ZAMM(7)=HWHEW4(N2,N1,N3,N4,N6,N5)/ZS234+ + > HWHEW4(N2,N1,N6,N5,N3,N4)/ZS256 + ZAMM(8)=HWHEW4(N2,N1,N4,N3,N6,N5)/ZS234+ + > HWHEW4(N2,N1,N6,N5,N4,N3)/ZS256 + HELSUM=0.0 + HELCTY=0.0 + DO 1 I=1,8 + AMM=REAL(ZAMM(I)*CONJG(ZAMM(I))) + HELSUM=HELSUM+CPALL(I)*AMM + HELCTY=HELCTY+CPFAC(ID1,ID2,I)*AMM + 1 CONTINUE + RETURN + END +CDECK ID>, HWHEWW. +*CMZ :- -02/05/91 10.58.29 by Federico Carminati +*-- Author : Zoltan Kunszt, modified by Bryan Webber +C----------------------------------------------------------------------- + SUBROUTINE HWHEWW +C----------------------------------------------------------------------- +C E+E- -> W+W-/Z0Z0 (BASED ON ZOLTAN KUNSZT'S PROGRAM) +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + COMPLEX ZH,ZCH,ZD + DOUBLE PRECISION HWUAEM,HWR,HWUPCM,ETOT,STOT,FLUXW,GAMM,GIMM, + & WM2,WXMIN,WX1MAX,WX2MAX,FJAC1,FJAC2,WX1,WX2,WMM1,WMM2,XXM,W2BO, + & PST,WEIGHT,TOTSIG,WMASS,WWIDTH,ELST,CV,CA,BR,XMASS,PLAB,PRW,PCM, + & AMPWW(4),CCC,HELSUM,HELCTY,BRZED(12),BRTOT,CPFAC,CPALL,RLL(12), + & RRL(12),DIST(4) + INTEGER IB,IBOS,I,ID1,ID2,NTRY,IDP(10),IDBOS(2),J1,J2,IPRC,ILST, + & IDZOLT(16),MAP(12),NEWHEP + LOGICAL EISBM1,HWRLOG + EXTERNAL HWUAEM,HWR,HWUPCM + SAVE IDP,STOT,FLUXW,GAMM,GIMM,WM2,WXMIN,WX1MAX,FJAC1,ELST,ILST, + & IDBOS,WMASS,WWIDTH + COMMON/HWHEWP/XMASS(10),PLAB(5,10),PRW(5,2),PCM(5,10) + COMMON/HWHEWQ/ZH(7,7),ZCH(7,7),ZD(7,7) + COMMON/HWHEWR/CPFAC(12,12,8),CPALL(8) + DATA ELST,ILST/0.,0/ + DATA IDZOLT/4,3,8,7,12,11,4*0,2,1,6,5,10,9/ + DATA MAP/12,11,2,1,14,13,4,3,16,15,6,5/ + IF (IERROR.NE.0) RETURN + EISBM1=IDHW(1).LT.IDHW(2) + IF (GENEV) THEN + NEWHEP=NHEP + NHEP=NHEP+2 + DO 20 IB=1,2 + IBOS=IB+NEWHEP + CALL HWVEQU(5,PRW(1,IB),PHEP(1,IBOS)) + IF (EISBM1) PHEP(3,IBOS)=-PHEP(3,IBOS) + CALL HWVZRO(4,VHEP(1,IBOS)) + CALL HWUDKL(IDBOS(IB),PHEP(1,IBOS),DIST) + CALL HWVSUM(4,VHEP(1,IBOS),DIST,DIST) + IDHW(IBOS)=IDBOS(IB) + IDHEP(IBOS)=IDPDG(IDBOS(IB)) + JMOHEP(1,IBOS)=1 + JMOHEP(2,IBOS)=2 + ISTHEP(IBOS)=110 + DO 10 I=1,2 + CALL HWVEQU(5,PLAB(1,2*IB+I),PHEP(1,NHEP+I)) + IF (EISBM1) PHEP(3,NHEP+I)=-PHEP(3,NHEP+I) + CALL HWVEQU(4,DIST,VHEP(1,NHEP+I)) +C---STATUS, IDs AND POINTERS + ISTHEP(NHEP+I)=112+I + IDHW(NHEP+I)=IDP(2*IB+I) + IDHEP(NHEP+I)=IDPDG(IDP(2*IB+I)) + JDAHEP(I,IBOS)=NHEP+I + JMOHEP(1,NHEP+I)=IBOS + JMOHEP(2,NHEP+I)=JMOHEP(1,IBOS) + 10 CONTINUE + NHEP=NHEP+2 + JMOHEP(2,NHEP)=NHEP-1 + JDAHEP(2,NHEP)=NHEP-1 + JMOHEP(2,NHEP-1)=NHEP + JDAHEP(2,NHEP-1)=NHEP + 20 CONTINUE + ELSE + EMSCA=PHEP(5,3) + ETOT=EMSCA + IPRC=MOD(IPROC,100) + IF (ETOT.NE.ELST .OR. IPRC.NE.ILST) THEN + STOT=ETOT*ETOT + FLUXW=GEV2NB*.125*(HWUAEM(STOT)/PIFAC)**4/STOT + IF (IPRC.EQ.0) THEN + WMASS=RMASS(198) + WWIDTH=GAMW + IDBOS(1)=198 + IDBOS(2)=199 + ELSEIF (IPRC.EQ.50) THEN + WMASS=RMASS(200) + WWIDTH=GAMZ + IDBOS(1)=200 + IDBOS(2)=200 +C---LOAD FERMION COUPLINGS TO Z + DO 30 I=1,12 + RLL(I)=VFCH(MAP(I),1)+AFCH(MAP(I),1) + RRL(I)=VFCH(MAP(I),1)-AFCH(MAP(I),1) + 30 CONTINUE + RLL(11)=0 + RRL(11)=0 + BRTOT=0 + DO 60 J1=1,12 + BRZED(J1)=0 + DO 50 J2=1,12 + CCC=1 + IF (MOD(J1-1,4).GE.2) CCC=CCC*CAFAC + IF (MOD(J2-1,4).GE.2) CCC=CCC*CAFAC + CPFAC(J1,J2,1)=CCC*(RLL(2)**2*RLL(J1)*RLL(J2))**2 + CPFAC(J1,J2,2)=CCC*(RLL(2)**2*RRL(J1)*RLL(J2))**2 + CPFAC(J1,J2,3)=CCC*(RLL(2)**2*RLL(J1)*RRL(J2))**2 + CPFAC(J1,J2,4)=CCC*(RLL(2)**2*RRL(J1)*RRL(J2))**2 + CPFAC(J1,J2,5)=CCC*(RRL(2)**2*RLL(J1)*RLL(J2))**2 + CPFAC(J1,J2,6)=CCC*(RRL(2)**2*RRL(J1)*RLL(J2))**2 + CPFAC(J1,J2,7)=CCC*(RRL(2)**2*RLL(J1)*RRL(J2))**2 + CPFAC(J1,J2,8)=CCC*(RRL(2)**2*RRL(J1)*RRL(J2))**2 + DO 40 I=1,8 + IF (J1.EQ.1.AND.J2.EQ.1) CPALL(I)=0 + CPALL(I)=CPALL(I)+CPFAC(J1,J2,I) + BRZED(J1)=BRZED(J1)+CPFAC(J1,J2,I) + BRTOT=BRTOT+CPFAC(J1,J2,I) + 40 CONTINUE + 50 CONTINUE + 60 CONTINUE + DO 70 I=1,12 + 70 BRZED(I)=BRZED(I)/BRTOT + ELSE + CALL HWWARN('HWHEWW',500,*999) + ENDIF + GAMM=WMASS*WWIDTH + GIMM=1.D0/GAMM + WM2=WMASS*WMASS + WXMIN=ATAN(-WMASS/WWIDTH) + WX1MAX=ATAN((STOT-WM2)*GIMM) + FJAC1=WX1MAX-WXMIN + ILST=IPRC + ELST=ETOT + ENDIF + EVWGT=0 +C---CHOOSE W MASSES + WX1=WXMIN+FJAC1*HWR() + WMM1=GAMM*TAN(WX1)+WM2 + XMASS(1)=SQRT(WMM1) + WX2MAX=ATAN(((ETOT-XMASS(1))**2-WM2)*GIMM) + FJAC2=WX2MAX-WXMIN + WX2=WXMIN+FJAC2*HWR() + WMM2=GAMM*TAN(WX2)+WM2 + XMASS(2)=SQRT(WMM2) + IF (HWRLOG(HALF))THEN + XXM=XMASS(1) + XMASS(1)=XMASS(2) + XMASS(2)=XXM + ENDIF +C---CTMAX=ANGULAR CUT ON COS W-ANGLE + CALL HWHEW0(1,ETOT,XMASS(1),PRW(1,1),W2BO,CTMAX) + IF (W2BO.EQ.ZERO) RETURN +C---FOR ZZ EVENTS, FORCE BOSE STATISTICS, BY KILLING EVENTS WITH COS1<0 + IF (IPRC.NE.0) THEN + IF (PRW(3,1).LT.ZERO) RETURN +C---AND THEN SYMMETRIZE (THIS PROCEDURE VASTLY IMPROVES EFFICIENCY) + IF (HWRLOG(HALF)) THEN + PRW(3,1)=-PRW(3,1) + PRW(3,2)=-PRW(3,2) + ENDIF + ENDIF + PLAB(3,1)=0.5*ETOT + PLAB(4,1)=PLAB(3,1) + PLAB(3,2)=-PLAB(3,1) + PLAB(4,2)=PLAB(3,1) +C +C---LET THE W BOSONS DECAY + NTRY=0 + 80 NTRY=NTRY+1 + DO 90 IB=1,2 + CALL HWDBOZ(IDBOS(IB),ID1,ID2,CV,CA,BR,1) + PST=HWUPCM(XMASS(IB),RMASS(ID1),RMASS(ID2)) + IF (PST.LT.ZERO) THEN + CALL HWDBOZ(IDBOS(IB),ID1,ID2,CV,CA,BR,2) + IF (NTRY.LE.NBTRY) GOTO 80 +C CALL HWWARN('HWHEWW',1,*999) + RETURN + ENDIF + PRW(5,IB)=XMASS(IB) + IDP(2*IB+1)=ID1 + IDP(2*IB+2)=ID2 + PLAB(5,2*IB+1)=RMASS(ID1) + PLAB(5,2*IB+2)=RMASS(ID2) + CALL HWDTWO(PRW(1,IB),PLAB(1,2*IB+1),PLAB(1,2*IB+2), + & PST,TWO,.TRUE.) + 90 CONTINUE + WEIGHT=FLUXW*W2BO*FJAC1*FJAC2*(0.5D0*PIFAC*GIMM)**2 + CALL HWHEW1(6) + CALL HWHEW2(6,PCM(1,1),ZH,ZCH,ZD) + IF (IPRC.EQ.0) THEN + CALL HWHEW3(5,6,3,4,1,2,AMPWW) + TOTSIG=9.*AMPWW(1)+6.*(AMPWW(2)+AMPWW(3))+4.*AMPWW(4) + EVWGT=TOTSIG*WEIGHT*BR + ELSE + ID1=IDZOLT(IDPDG(IDP(3))) + ID2=IDZOLT(IDPDG(IDP(5))) + CALL HWHEW5(5,6,3,4,1,2,HELSUM,HELCTY,ID1,ID2) + EVWGT=HELCTY*WEIGHT*BR/(BRZED(ID1)*BRZED(ID2)) + ENDIF + ENDIF + 999 END +CDECK ID>, HWHHVY. +*CMZ :- -18/05/99 14.55.44 by Kosuke Odagiri +*-- Author : Bryan Webber +C----------------------------------------------------------------------- + SUBROUTINE HWHHVY +C----------------------------------------------------------------------- +C QCD HEAVY FLAVOUR PRODUCTION: MEAN EVWGT = SIGMA IN NB +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + DOUBLE PRECISION HWR,HWRUNI,HWUALF,EPS,RCS,Z1,Z2,ET,EJ, + & QM2,QPE,FACTR,S,T,U,ST,TU,US,TUS,UST,EN,RN,AF,ASTU, + & AUST,CF,CN,CS,CSTU,CSUT,CTSU,CTUS,HCS,UT,SU,GT,DIST,KK,KK2, + & YJ1INF,YJ1SUP,YJ2INF,YJ2SUP + INTEGER IQ1,IQ2,ID1,ID2 + LOGICAL HQ1,HQ2 + EXTERNAL HWR,HWRUNI,HWUALF + SAVE HCS,ASTU,AUST,CSTU,CSUT,CTSU,CTUS,S,T,TU,U,US + 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((ONE-SQRT(ONE-KK2))/KK) ) + YJ1SUP = MIN( YJMAX, LOG((ONE+SQRT(ONE-KK2))/KK) ) + IF (YJ1INF.GE.YJ1SUP) RETURN + Z1=EXP(HWRUNI(1,YJ1INF,YJ1SUP)) + YJ2INF = MAX( YJMIN, -LOG(TWO/KK-ONE/Z1) ) + YJ2SUP = MIN( YJMAX, LOG(TWO/KK-Z1) ) + IF (YJ2INF.GE.YJ2SUP) RETURN + Z2=EXP(HWRUNI(2,YJ2INF,YJ2SUP)) + XX(1)=HALF*(Z1+Z2)*KK + IF (XX(1).GE.ONE) RETURN + XX(2)=XX(1)/(Z1*Z2) + IF (XX(2).GE.ONE) RETURN + S=XX(1)*XX(2)*PHEP(5,3)**2 + IQ1=MOD(IPROC,100) + QM2=RMASS(IQ1)**2 + QPE=S-4.*QM2 + IF (QPE.LE.ZERO) RETURN + COSTH=HALF*ET*(Z1-Z2)/SQRT(Z1*Z2*QPE) + IF (ABS(COSTH).GT.ONE) RETURN +C---REDEFINE S, T, U AS P1.P2, -P1.P3, -P1.P4 + S=HALF*S + T=-HALF*(1.+Z2/Z1)*(HALF*ET)**2 + U=-S-T +C---SET EMSCA TO HEAVY HARD PROCESS SCALE + EMSCA=SQRT(4.*S*T*U/(S*S+T*T+U*U)) + FACTR = GEV2NB*.125*PIFAC*EJ*ET*(HWUALF(1,EMSCA)/S)**2 + & *(YJ1SUP-YJ1INF)*(YJ2SUP-YJ2INF) + CALL HWSGEN(.FALSE.) +C + ST=S/T + TU=T/U + UT=U/T + US=U/S + SU=S/U + TUS=US/ST + UST=ST/TU +C + EN=CAFAC + RN=CFFAC/EN + AF=FACTR*RN + ASTU=AF*(1.-2.*UST+QM2/T) + AUST=AF*(1.-2.*TUS+QM2/S) + CF=FACTR/(2.*CFFAC) + CN=1./(EN*EN) +C----------------------------------------------------------------------- +C---Heavy flavour colour decomposition modifications below (KO) +C----------------------------------------------------------------------- + CS=(TU+UT-CN/TUS)*(HALF-TUS+QM2/S-QM2**2/U/T/TWO) + CSTU=CF*CS/(ONE+TU**2) + CSUT=CF*CS/(ONE+UT**2) + CS=(SU+US-CN/UST)*(HALF-UST+QM2/T-QM2**2/U/S/TWO) + CTSU=-FACTR*CS/(ONE+SU**2) + CTUS=-FACTR*CS/(ONE+US**2) +C----------------------------------------------------------------------- +C CS=HALF/TU-QM2/T-HALF*(QM2/T)**2 +C CSTU=CF*(CS- US**2-QM2/S - CN*(CS+QM2*QM2/(S*T))) +C CS=HALF*TU-QM2/U-HALF*(QM2/U)**2 +C CSUT=CF*(CS-1./ST**2-QM2/S - CN*(CS+QM2*QM2/(S*U))) +C CS=HALF*US-QM2/S-HALF*(QM2/S)**2 +C CTSU=-FACTR*(CS-1./TU**2-QM2/T - CN*(CS+QM2*QM2/(S*T))) +C CS=HALF/US-QM2/U-HALF*(QM2/U)**2 +C CTUS=-FACTR*(CS- ST**2-QM2/T - CN*(CS+QM2*QM2/(T*U))) +C----------------------------------------------------------------------- + ENDIF +C + HCS=0. + IQ2=IQ1+6 + DO 6 ID1=1,13 + IF (DISF(ID1,1).LT.EPS) GOTO 6 + HQ1=ID1.EQ.IQ1.OR.ID1.EQ.IQ2 + DO 5 ID2=1,13 + IF (DISF(ID2,2).LT.EPS) GOTO 5 + HQ2=ID2.EQ.IQ1.OR.ID2.EQ.IQ2 + DIST=DISF(ID1,1)*DISF(ID2,2) + IF (HQ1.OR.HQ2) THEN +C---PROCESSES INVOLVING HEAVY CONSTITUENT +C N.B. NEGLECT CASE THAT BOTH ARE HEAVY + IF (HQ1.AND.HQ2) GOTO 5 + IF (ID1.LT.7) THEN +C---QUARK FIRST + IF (ID2.LT.7) THEN + HCS=HCS+ASTU*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,ID2,3421, 3,*9) + ELSEIF (ID2.NE.13) THEN + HCS=HCS+ASTU*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,ID2,3142, 9,*9) + ELSE + HCS=HCS+CTSU*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,ID2,3142,10,*9) + HCS=HCS+CTUS*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,ID2,3421,11,*9) + ENDIF + ELSEIF (ID1.NE.13) THEN +C---QBAR FIRST + IF (ID2.LT.7) THEN + HCS=HCS+ASTU*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,ID2,2413,17,*9) + ELSEIF (ID2.NE.13) THEN + HCS=HCS+ASTU*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,ID2,4312,20,*9) + ELSE + HCS=HCS+CTSU*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,ID2,2413,21,*9) + HCS=HCS+CTUS*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,ID2,4312,22,*9) + ENDIF + ELSE +C---GLUON FIRST + IF (ID2.LT.7) THEN + HCS=HCS+CTSU*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,ID2,2413,23,*9) + HCS=HCS+CTUS*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,ID2,3421,24,*9) + ELSEIF (ID2.LT.13) THEN + HCS=HCS+CTSU*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,ID2,3142,25,*9) + HCS=HCS+CTUS*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,ID2,4312,26,*9) + ENDIF + ENDIF + ELSEIF (ID2.NE.13.AND.ID2.EQ.ID1+6) THEN +C---LIGHT Q-QBAR ANNIHILATION + HCS=HCS+AUST*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(IQ1,IQ2,2413, 4,*9) + ELSEIF (ID1.NE.13.AND.ID1.EQ.ID2+6) THEN +C---LIGHT QBAR-Q ANNIHILATION + HCS=HCS+AUST*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(IQ2,IQ1,3142,12,*9) + ELSEIF (ID1.EQ.13.AND.ID2.EQ.13) THEN +C---GLUON FUSION + HCS=HCS+CSTU*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(IQ1,IQ2,2413,27,*9) + HCS=HCS+CSUT*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(IQ1,IQ2,4123,28,*9) + ENDIF + 5 CONTINUE + 6 CONTINUE + EVWGT=HCS + RETURN +C---GENERATE EVENT + 9 IDN(1)=ID1 + IDN(2)=ID2 + IDCMF=15 + CALL HWETWO + IF (AZSPIN) THEN +C Calculate coefficients for constructing spin density matrices + IF (IHPRO.EQ.7 .OR.IHPRO.EQ.8 .OR. + & IHPRO.EQ.15.OR.IHPRO.EQ.16) THEN +C qqbar-->gg or qbarq-->gg + UT=1./TU + GCOEF(1)=UT+TU + GCOEF(2)=-2. + GCOEF(3)=0. + GCOEF(4)=0. + GCOEF(5)=GCOEF(1) + GCOEF(6)=UT-TU + GCOEF(7)=-GCOEF(6) + ELSEIF (IHPRO.EQ.10.OR.IHPRO.EQ.11.OR. + & IHPRO.EQ.21.OR.IHPRO.EQ.22.OR. + & IHPRO.EQ.23.OR.IHPRO.EQ.24.OR. + & IHPRO.EQ.25.OR.IHPRO.EQ.26) THEN +C qg-->qg or qbarg-->qbarg or gq-->gq or gqbar-->gqbar + SU=1./US + GCOEF(1)=-(SU+US) + GCOEF(2)=0. + GCOEF(3)=2. + GCOEF(4)=0. + GCOEF(5)=SU-US + GCOEF(6)=GCOEF(1) + GCOEF(7)=-GCOEF(5) + ELSEIF (IHPRO.EQ.27.OR.IHPRO.EQ.28) THEN +C gg-->qqbar + UT=1./TU + GCOEF(1)=TU+UT + GCOEF(2)=-2. + GCOEF(3)=0. + GCOEF(4)=0. + GCOEF(5)=GCOEF(1) + GCOEF(6)=TU-UT + GCOEF(7)=-GCOEF(6) + ELSEIF (IHPRO.EQ.29.OR.IHPRO.EQ.30.OR. + & IHPRO.EQ.31) THEN +C gg-->gg + GT=S*S+T*T+U*U + GCOEF(2)=2.*U*U*T*T + GCOEF(3)=2.*S*S*U*U + GCOEF(4)=2.*S*S*T*T + GCOEF(1)=GT*GT-GCOEF(2)-GCOEF(3)-GCOEF(4) + GCOEF(5)=GT*(GT-2.*S*S)-GCOEF(2) + GCOEF(6)=GT*(GT-2.*T*T)-GCOEF(3) + GCOEF(7)=GT*(GT-2.*U*U)-GCOEF(4) + ELSE + CALL HWVZRO(7,GCOEF) + ENDIF + ENDIF + 999 END +CDECK ID>, HWHIG1. +*CMZ :- -23/08/94 13.22.29 by Mike Seymour +*-- Author : Ulrich Baur & Nigel Glover, adapted by Ian Knowles +C----------------------------------------------------------------------- + FUNCTION HWHIG1(S,T,U,EH2,EQ2,I,J,K,I1,J1,K1) +C----------------------------------------------------------------------- +C Basic matrix elements for Higgs + jet production; used in HWHIGA +C----------------------------------------------------------------------- + IMPLICIT NONE + DOUBLE COMPLEX HWHIG1,HWHIG2,HWHIG5,BI(4),CI(7),DI(3) + DOUBLE PRECISION S,T,U,EH2,EQ2,S1,T1,U1,ONE,TWO,FOUR,HALF + INTEGER I,J,K,I1,J1,K1 + COMMON/CINTS/BI,CI,DI + PARAMETER (ONE =1.D0, TWO =2.D0, FOUR =4.D0, HALF =0.5D0) +C----------------------------------------------------------------------- +C +++ helicity amplitude for: g+g --> g+H +C----------------------------------------------------------------------- + S1=S-EH2 + T1=T-EH2 + U1=U-EH2 + HWHIG1=EQ2*FOUR*DSQRT(TWO*S*T*U)*( + & -FOUR*(ONE/(U*T)+ONE/(U*U1)+ONE/(T*T1)) + & -FOUR*((TWO*S+T)*BI(K)/U1**2+(TWO*S+U)*BI(J)/T1**2)/S + & -(S-FOUR*EQ2)*(S1*CI(I1)+(U-S)*CI(J1)+(T-S)*CI(K1))/(S*T*U) + & -8.D0*EQ2*(CI(J1)/(T*T1)+CI(K1)/(U*U1)) + & +HALF*(S-FOUR*EQ2)*(S*T*DI(K)+U*S*DI(J)-U*T*DI(I))/(S*T*U) + & +FOUR*EQ2*DI(I)/S + & -TWO*(U*CI(K)+T*CI(J)+U1*CI(K1)+T1*CI(J1)-U*T*DI(I))/S**2 ) + RETURN +C----------------------------------------------------------------------- + ENTRY HWHIG2(S,T,U,EH2,EQ2,I,J,K,I1,J1,K1) +C----------------------------------------------------------------------- +C ++- helicity amplitude for: g+g --> g+H +C----------------------------------------------------------------------- + S1=S-EH2 + T1=T-EH2 + U1=U-EH2 + HWHIG2=EQ2*FOUR*DSQRT(TWO*S*T*U)*(FOUR*EH2 + & +(EH2-FOUR*EQ2)*(S1*CI(4)+T1*CI(5)+U1*CI(6)) + & -HALF*(EH2-FOUR*EQ2)*(S*T*DI(3)+U*S*DI(2)+U*T*DI(1)) )/(S*T*U) + RETURN +C----------------------------------------------------------------------- + ENTRY HWHIG5(S,T,U,EH2,EQ2,I,J,K,I1,J1,K1) +C----------------------------------------------------------------------- +C Amplitude for: q+qbar --> g+H +C----------------------------------------------------------------------- + HWHIG5=DCMPLX(TWO+TWO*S/(S-EH2))*BI(I)+DCMPLX(FOUR*EQ2-U-T)*CI(K) + RETURN + END +CDECK ID>, HWHIGA. +*CMZ :- -23/08/94 13.22.29 by Mike Seymour +*-- Author : Ulrich Baur & Nigel Glover, adapted by Ian Knowles +C----------------------------------------------------------------------- + SUBROUTINE HWHIGA(S,T,U,EMH2,WTQQ,WTQG,WTGQ,WTGG) +C----------------------------------------------------------------------- +C Gives amplitudes squared for q-qbar, q(bar)-g and gg -> Higgs +jet +C IAPHIG (set in HWIGIN)=0: zero mass approximation =1: exact result +C =2: infinite mass limit. +C Only top loop included. A factor (alpha_s**3*alpha_W) is extracted +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + DOUBLE COMPLEX HWHIGB,HWHIGC,HWHIGD,HWHIG5,HWHIG1,HWHIG2,BI(4), + & CI(7),DI(3),EPSI,TAMP(7) + DOUBLE PRECISION S,T,U,EMH2,WTQQ,WTQG,WTGQ,WTGG,EMW2,RNGLU,RNQRK, + & FLUXGG,FLUXGQ,FLUXQQ,EMQ2,TAMPI(7),TAMPR(7) + INTEGER I + LOGICAL NOMASS + EXTERNAL HWHIGB,HWHIGC,HWHIGD,HWHIG5,HWHIG1,HWHIG2 + COMMON/SMALL/EPSI + COMMON/CINTS/BI,CI,DI + EPSI=CMPLX(ZERO,-1.D-10) + EMW2=RMASS(198)**2 +C Spin and colour flux factors plus enhancement factor + RNGLU=1./FLOAT(NCOLO**2-1) + RNQRK=1./FLOAT(NCOLO) + FLUXGG=.25*RNGLU**2*ENHANC(6)**2 + FLUXGQ=.25*RNGLU*RNQRK*ENHANC(6)**2 + FLUXQQ=.25*RNQRK**2*ENHANC(6)**2 + IF (IAPHIG.EQ.2) THEN +C Infinite mass limit in loops + WTGG=2./3.*FLOAT(NCOLO*(NCOLO**2-1)) + & *(EMH2**4+S**4+T**4+U**4)/(S*T*U*EMW2)*FLUXGG + WTQQ= 16./9.*(U**2+T**2)/(S*EMW2)*FLUXQQ + WTQG=-16./9.*(U**2+S**2)/(T*EMW2)*FLUXGQ + WTGQ=-16./9.*(S**2+T**2)/(U*EMW2)*FLUXGQ + RETURN + ELSEIF (IAPHIG.EQ.1) THEN +C Exact result for loops + NOMASS=.FALSE. + ELSEIF (IAPHIG.EQ.0) THEN +C Small mass approximation in loops + NOMASS=.TRUE. + ELSE + CALL HWWARN('HWHIGA',500,*999) + ENDIF +C Include only top quark contribution + EMQ2=RMASS(6)**2 + BI(1)=HWHIGB(NOMASS,S,ZERO,ZERO,EMQ2) + BI(2)=HWHIGB(NOMASS,T,ZERO,ZERO,EMQ2) + BI(3)=HWHIGB(NOMASS,U,ZERO,ZERO,EMQ2) + BI(4)=HWHIGB(NOMASS,EMH2,ZERO,ZERO,EMQ2) + BI(1)=BI(1)-BI(4) + BI(2)=BI(2)-BI(4) + BI(3)=BI(3)-BI(4) + CI(1)=HWHIGC(NOMASS,S,ZERO,ZERO,EMQ2) + CI(2)=HWHIGC(NOMASS,T,ZERO,ZERO,EMQ2) + CI(3)=HWHIGC(NOMASS,U,ZERO,ZERO,EMQ2) + CI(7)=HWHIGC(NOMASS,EMH2,ZERO,ZERO,EMQ2) + CI(4)=(S*CI(1)-EMH2*CI(7))/(S-EMH2) + CI(5)=(T*CI(2)-EMH2*CI(7))/(T-EMH2) + CI(6)=(U*CI(3)-EMH2*CI(7))/(U-EMH2) + DI(1)=HWHIGD(NOMASS,U,T,EMH2,EMQ2) + DI(2)=HWHIGD(NOMASS,S,U,EMH2,EMQ2) + DI(3)=HWHIGD(NOMASS,S,T,EMH2,EMQ2) +C Compute complex amplitudes + TAMP(1)=HWHIG1(S,T,U,EMH2,EMQ2,1,2,3,4,5,6) + TAMP(2)=HWHIG2(S,T,U,EMH2,EMQ2,1,2,3,0,0,0) + TAMP(3)=HWHIG1(T,S,U,EMH2,EMQ2,2,1,3,5,4,6) + TAMP(4)=HWHIG1(U,T,S,EMH2,EMQ2,3,2,1,6,5,4) + TAMP(5)=HWHIG5(S,T,U,EMH2,EMQ2,1,0,4,0,0,0) + TAMP(6)=HWHIG5(T,S,U,EMH2,EMQ2,2,0,5,0,0,0) + TAMP(7)=HWHIG5(U,T,S,EMH2,EMQ2,3,0,6,0,0,0) + DO 20 I=1,7 + TAMPI(I)= DBLE(TAMP(I)) + 20 TAMPR(I)=-IMAG(TAMP(I)) +C Square and add prefactors + WTGG=0.03125*FLOAT(NCOLO*(NCOLO**2-1)) + & *(TAMPR(1)**2+TAMPI(1)**2+TAMPR(2)**2+TAMPI(2)**2 + & +TAMPR(3)**2+TAMPI(3)**2+TAMPR(4)**2+TAMPI(4)**2)*FLUXGG + WTQQ= 16.*(U**2+T**2)/(U+T)**2*EMQ2**2/(S*EMW2) + & *(TAMPR(5)**2+TAMPI(5)**2)*FLUXQQ + WTQG=-16.*(U**2+S**2)/(U+S)**2*EMQ2**2/(T*EMW2) + & *(TAMPR(6)**2+TAMPI(6)**2)*FLUXGQ + WTGQ=-16.*(S**2+T**2)/(S+T)**2*EMQ2**2/(U*EMW2) + & *(TAMPR(7)**2+TAMPI(7)**2)*FLUXGQ + 999 RETURN + END +CDECK ID>, HWHIGB. +*CMZ :- -23/08/94 13.22.29 by Mike Seymour +*-- Author : Ulrich Baur & Nigel Glover, adapted by Ian Knowles +C----------------------------------------------------------------------- + FUNCTION HWHIGB(NOMASS,S,T,EH2,EQ2) +C----------------------------------------------------------------------- +C One loop scalar integrals, used in HWHIGJ. +C If NOMASS=.TRUE. use a small mass approx. for particle in loop. +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + DOUBLE COMPLEX HWHIGB,HWHIGC,HWHIGD,HWUCI2,HWULI2,EPSI,PII,Z1,Z2 + DOUBLE PRECISION S,T,EQ2,EH2,RAT,COSH,DLS,DLT,DLM,RZ12,DL1,DL2, + & ST,ROOT,XP,XM + LOGICAL NOMASS + EXTERNAL HWULI2,HWUCI2 + COMMON/SMALL/EPSI +C----------------------------------------------------------------------- +C B_0(2p1.p2=S;mq,mq) +C----------------------------------------------------------------------- + PII=CMPLX(ZERO,PIFAC) + IF (NOMASS) THEN + RAT=DABS(S/EQ2) + HWHIGB=-DLOG(RAT)+TWO + IF (S.GT.ZERO) HWHIGB=HWHIGB+PII + ELSE + RAT=S/(FOUR*EQ2) + IF (S.LT.ZERO) THEN + HWHIGB=TWO-TWO*DSQRT(ONE-ONE/RAT) + & *DLOG(DSQRT(-RAT)+DSQRT(ONE-RAT)) + ELSEIF (S.GT.ZERO.AND.RAT.LT.ONE) THEN + HWHIGB=TWO-TWO*DSQRT(ONE/RAT-ONE)*DASIN(DSQRT(RAT)) + ELSEIF (RAT.GT.ONE) THEN + HWHIGB=TWO-DSQRT(ONE-ONE/RAT) + & *(TWO*DLOG(DSQRT(RAT)+DSQRT(RAT-ONE))-PII) + ENDIF + ENDIF + RETURN +C----------------------------------------------------------------------- + ENTRY HWHIGC(NOMASS,S,T,EH2,EQ2) +C----------------------------------------------------------------------- +C C_0(p{1,2}^2=0,2p1.p2=S;mq,mq,mq) +C----------------------------------------------------------------------- + PII=CMPLX(ZERO,PIFAC) + IF (NOMASS) THEN + RAT=DABS(S/EQ2) + HWHIGC=HALF*DLOG(RAT)**2 + IF (S.GT.ZERO) HWHIGC=HWHIGC-HALF*PIFAC**2-PII*DLOG(RAT) + HWHIGC=HWHIGC/S + ELSE + RAT=S/(FOUR*EQ2) + IF (S.LT.ZERO) THEN + HWHIGC=TWO*DLOG(DSQRT(-RAT)+DSQRT(ONE-RAT))**2/S + ELSEIF (S.GT.ZERO.AND.RAT.LT.ONE) THEN + HWHIGC=-TWO*(DASIN(DSQRT(RAT)))**2/S + ELSEIF (RAT.GT.ONE) THEN + COSH=DLOG(DSQRT(RAT)+DSQRT(RAT-ONE)) + HWHIGC=TWO*(COSH**2-PIFAC**2/FOUR-PII*COSH)/S + ENDIF + ENDIF + RETURN +C----------------------------------------------------------------------- + ENTRY HWHIGD(NOMASS,S,T,EH2,EQ2) +C----------------------------------------------------------------------- +C D_0(p{1,2,3}^2=0,p4^2=EH2,2p1.p2=S,2p2.p3=T;mq,mq,mq,mq) +C----------------------------------------------------------------------- + PII=CMPLX(ZERO,PIFAC) + IF (NOMASS) THEN + DLS=DLOG(DABS(S/EQ2)) + DLT=DLOG(DABS(T/EQ2)) + DLM=DLOG(DABS(EH2/EQ2)) + IF (S.GE.ZERO.AND.T.LE.ZERO) THEN + DL1=DLOG((EH2-T)/S) + Z1=T/(T-EH2) + Z2=(S-EH2)/S + HWHIGD=DLS**2+DLT**2-DLM**2+DL1**2 + & +TWO*(DLOG(S/(EH2-T))*DLOG(-T/S)+HWULI2(Z1)-HWULI2(Z2) + & +PII*DLOG(EH2/(EH2-T))) + ELSEIF (S.LT.ZERO.AND.T.LT.ZERO) THEN + Z1=(S-EH2)/S + Z2=(T-EH2)/T + RZ12=ONE/(Z1*Z2) + DL1=DLOG((T-EH2)/(S-EH2)) + DL2=DLOG(RZ12) + HWHIGD=DLS**2+DLT**2-DLM**2+TWO*PIFAC**2/THREE + & +TWO*DLOG(S/(T-EH2))*DLOG(ONE/DBLE(Z2)) + & +TWO*DLOG(T/(S-EH2))*DLOG(ONE/DBLE(Z1)) + & -DL1**2-DL2**2-TWO*(HWULI2(Z1)+HWULI2(Z2)) + & +TWO*PII*DLOG(RZ12**2*EH2/EQ2) + ENDIF + HWHIGD=HWHIGD/(S*T) + ELSE + ST=S*T + ROOT=DSQRT(ST**2-FOUR*ST*EQ2*(S+T-EH2)) + XP=HALF*(ST+ROOT)/ST + XM=1-XP + HWHIGD=TWO/ROOT*(-HWUCI2(EQ2,S,XP)-HWUCI2(EQ2,T,XP) + & +HWUCI2(EQ2,EH2,XP)+DLOG(-XM/XP) + & *(LOG(EQ2+EPSI)-LOG(EQ2+EPSI-S*XP*XM) + & +LOG(EQ2+EPSI-EH2*XP*XM)-LOG(EQ2+EPSI-T*XP*XM))) + ENDIF + RETURN + END +CDECK ID>, HWHIGJ. +*CMZ :- -23/08/94 13.22.29 by Mike Seymour +*-- Author : Ian Knowles +C----------------------------------------------------------------------- + SUBROUTINE HWHIGJ +C----------------------------------------------------------------------- +C QCD Higgs plus jet production; mean EVWGT = Sigma in nb*Higgs B.R. +C Adapted from the program of U. Baur and E.W.N. Glover +C See: Nucl. Phys. B339 (1990) 38 +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + DOUBLE PRECISION HWR,HWRUNI,HWUALF,HWUAEM,EPS,RCS,EMH,EMHWT, + & EMHTMP,BR,CV,CA,EMH2,ET,EJ,PT,EMT,EMAX,YMAX,YHINF,YHSUP,EXYH, + & YMIN,YJINF,YJSUP,EXYJ,S,T,U,FACT,AMPQQ,AMPQG,AMPGQ,AMPGG,HCS, + & FACTR + INTEGER I,IDEC,ID1,ID2 + EXTERNAL HWR,HWRUNI,HWUALF,HWUAEM + SAVE HCS,AMPGG,AMPGQ,AMPQG,AMPQQ,EMH,FACT + PARAMETER (EPS=1.D-9) + IF (GENEV) THEN + RCS=HCS*HWR() + ELSE + EVWGT=0. +C Select a Higgs mass + CALL HWHIGM(EMH,EMHWT) + IF (EMH.LE.ZERO .OR. EMH.GE.PHEP(5,3)) RETURN +C Store branching ratio for specified Higgs deacy channel + IDEC=MOD(IPROC,100) + BR=1. + IF (IDEC.EQ.0) THEN + BR=0. + DO 10 I=1,6 + 10 BR=BR+BRHIG(I) + ELSEIF (IDEC.EQ.10) THEN + CALL HWDBOZ(198,ID1,ID2,CV,CA,BR,1) + CALL HWDBOZ(199,ID1,ID2,CV,CA,BR,1) + BR=BR*BRHIG(IDEC) + ELSEIF (IDEC.EQ.11) THEN + CALL HWDBOZ(200,ID1,ID2,CV,CA,BR,1) + CALL HWDBOZ(200,ID1,ID2,CV,CA,BR,1) + BR=BR*BRHIG(IDEC) + ELSEIF (IDEC.LE.12) THEN + BR=BRHIG(IDEC) + ENDIF +C Select subprocess kinematics + EMH2=EMH**2 + CALL HWRPOW(ET,EJ) + PT=.5*ET + EMT=SQRT(PT**2+EMH2) + EMAX=0.5*(PHEP(5,3)+EMH2/PHEP(5,3)) + IF (EMAX.LE.EMT) RETURN + YMAX=LOG((EMAX+SQRT(EMAX**2-EMT**2))/EMT) + YHINF=MAX(YJMIN,-YMAX) + YHSUP=MIN(YJMAX, YMAX) + IF (YHSUP.LE.YHINF) RETURN + EXYH=EXP(HWRUNI(1,YHINF,YHSUP)) + YMIN=LOG(PT/(PHEP(5,3)-EMT/EXYH)) + YMAX=LOG((PHEP(5,3)-EMT*EXYH)/PT) + YJINF=MAX(YJMIN,YMIN) + YJSUP=MIN(YJMAX,YMAX) + IF (YJSUP.LE.YJINF) RETURN + EXYJ=EXP(HWRUNI(2,YJINF,YJSUP)) + XX(1)=(EMT*EXYH+PT*EXYJ)/PHEP(5,3) + XX(2)=(EMT/EXYH+PT/EXYJ)/PHEP(5,3) + S=XX(1)*XX(2)*PHEP(5,3)**2 + T=EMH2-XX(1)*EMT*PHEP(5,3)/EXYH + U=EMH2-S-T + COSTH=(S+2.*T-EMH2)/(S-EMH2) +C Set subprocess scale + EMSCA=EMT + CALL HWSGEN(.FALSE.) + FACT=GEV2NB*PT*EJ*(YHSUP-YHINF)*(YJSUP-YJINF)*BR*EMHWT + & *HWUALF(1,EMSCA)**3*HWUAEM(EMH2)/(SWEIN*16*PIFAC*S**2) + CALL HWHIGA(S,T,U,EMH2,AMPQQ,AMPQG,AMPGQ,AMPGG) + ENDIF + HCS=0. + DO 30 ID1=1,13 + IF (DISF(ID1,1).LT.EPS) GOTO 30 + FACTR=FACT*DISF(ID1,1) + IF (ID1.LT.7) THEN +C Quark first: + ID2=ID1+6 + HCS=HCS+FACTR*DISF(ID2,2)*AMPQQ + IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(13 ,201,2314,81,*99) + ID2=13 + HCS=HCS+FACTR*DISF(ID2,2)*AMPQG + IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,201,3124,82,*99) + ELSEIF (ID1.LT.13) THEN +C Antiquark first: + ID2=ID1-6 + HCS=HCS+FACTR*DISF(ID2,2)*AMPQQ + IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(13 ,201,3124,83,*99) + ID2=13 + HCS=HCS+FACTR*DISF(ID2,2)*AMPQG + IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,201,2314,84,*99) + ELSE +C Gluon first: + DO 20 ID2=1,12 + IF (DISF(ID2,2).LT.EPS) GOTO 20 + IF (ID2.LT.7) THEN + HCS=HCS+FACTR*DISF(ID2,2)*AMPGQ + IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID2,201,2314,85,*99) + ELSE + HCS=HCS+FACTR*DISF(ID2,2)*AMPGQ + IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID2,201,3124,86,*99) + ENDIF + 20 CONTINUE + HCS=HCS+FACTR*DISF(13,2)*AMPGG + IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(13 ,201,2314,87,*99) + ENDIF + 30 CONTINUE + EVWGT=HCS + RETURN +C Generate event + 99 IDN(1)=ID1 + IDN(2)=ID2 + IDCMF=15 +C Trick HWETWO into using off-shell Higgs mass + EMHTMP=RMASS(IDN(4)) + RMASS(IDN(4))=EMH + CALL HWETWO + RMASS(IDN(4))=EMHTMP + 999 END +CDECK ID>, HWHIGM. +*CMZ :- -02/05/91 11.17.14 by Federico Carminati +*-- Author : Mike Seymour +C----------------------------------------------------------------------- + SUBROUTINE HWHIGM(EM,WEIGHT) +C----------------------------------------------------------------------- +C CHOOSE HIGGS MASS: +C IF (IOPHIG.EQ.0.OR.IOPHIG.EQ.2) THEN +C CHOOSE HIGGS MASS ACCORDING TO +C EM**4 / (EM**2-EMH**2)**2 + (GAMH*EMH)**2 +C ELSE +C CHOOSE HIGGS MASS ACCORDING TO +C EMH * GAMH / (EM**2-EMH**2)**2 + (GAMH*EMH)**2 +C ENDIF +C IF (IOPHIG.EQ.0.OR.IOPHIG.EQ.1) THEN +C SUPPLY WEIGHT FACTOR TO YIELD +C EM * GAM(EM)/ (EM**2-EMH**2)**2 + (GAM(EM)*EM)**2 +C ELSE +C SUPPLY WEIGHT FACTOR TO YIELD +C EM*(EMH/EM)**4 * GAM(EM) +C / (EM**2-EMH**2)**2 + (GAM(EM)*EMH**2/EM)**2 +C AS SUGGESTED IN M.H.SEYMOUR, PHYS.LETT.B354(1995)409. +C ENDIF +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + DOUBLE PRECISION HWRUNI,EM,WEIGHT,EMH,DIF,FUN,THETA,T,EMHLST,W0, + & W1,EMM,GAMEM,T0,TMIN,TMAX,THEMIN,THEMAX,ZMIN,ZMAX,Z,F,GAMOFS + INTEGER I + EXTERNAL HWRUNI + SAVE EMHLST,GAMEM,T0,TMIN,TMAX,THEMIN,THEMAX,ZMIN,ZMAX,W0,W1 + EQUIVALENCE (EMH,RMASS(201)) + DATA EMHLST/0D0/ +C---SET UP INTEGRAND AND INDEFINITE INTEGRAL OF DISTRIBUTION +C THETA=ATAN((EM**2-EMH**2)/(GAMH*EMH)); T=TAN(THETA); T0=EMH/GAMH + DIF(T,T0)=(T+T0)**2 + FUN(THETA,T,T0)=T + (T0*T0-1)*THETA + T0*LOG(1+T*T) +C---SET UP CONSTANTS + IF (EMH.NE.EMHLST .OR. FSTWGT) THEN + EMHLST=EMH + GAMEM=GAMH*EMH + T0=EMH/GAMH + TMIN=(MAX(ONE*1E-10,EMH-GAMMAX*GAMH))**2/GAMEM-T0 + TMAX=( EMH+GAMMAX*GAMH )**2/GAMEM-T0 + THEMIN=ATAN(TMIN) + THEMAX=ATAN(TMAX) + ZMIN=FUN(THEMIN,TMIN,T0) + ZMAX=FUN(THEMAX,TMAX,T0) + W0=(ZMAX-ZMIN) / PIFAC * GAMEM + W1=(THEMAX-THEMIN) / PIFAC + ENDIF +C---CHOOSE HIGGS MASS + IF (IOPHIG.EQ.0.OR.IOPHIG.EQ.2) THEN + 1 EM=0 + WEIGHT=0 + Z=HWRUNI(1,ZMIN,ZMAX) +C---SOLVE FUN(THETA,TAN(THETA))=Z BY NEWTON'S METHOD + THETA=MAX(THEMIN, MIN(THEMAX, Z/T0**2 )) + I=1 + F=0 + 10 IF (I.LE.20 .AND. ABS(1-F/Z).GT.1E-4) THEN + I=I+1 + IF (2*ABS(THETA).GT.PIFAC) CALL HWWARN('HWHIGM',51,*999) + T=TAN(THETA) + F=FUN(THETA,T,T0) + THETA=THETA-(F-Z)/DIF(T,T0) + GOTO 10 + ENDIF + IF (I.GT.20) CALL HWWARN('HWHIGM',1,*999) + ELSE + THETA=HWRUNI(0,THEMIN,THEMAX) + ENDIF + EM=SQRT(GAMEM*(T0+TAN(THETA))) +C---NOW CALCULATE WEIGHT FACTOR FOR NON-CONSTANT HIGGS WIDTH + GAMOFS=EM + CALL HWDHIG(GAMOFS) + IF (IOPHIG.EQ.0) THEN + WEIGHT=W0*GAMOFS*EM /EM**4 *((EM**2-EMH**2)**2 + GAMEM**2) + & /((EM**2-EMH**2)**2 +(GAMOFS*EM)**2) + ELSEIF (IOPHIG.EQ.1) THEN + WEIGHT=W1*GAMOFS*EM /GAMEM *((EM**2-EMH**2)**2 + GAMEM**2) + & /((EM**2-EMH**2)**2 +(GAMOFS*EM)**2) + ELSEIF (IOPHIG.EQ.2) THEN + EMM=EM*(EMH/EM)**4 + WEIGHT=W0*GAMOFS*EMM/EM**4 *((EM**2-EMH**2)**2 + GAMEM**2) + & /((EM**2-EMH**2)**2 +(GAMOFS*EMM)**2) + ELSEIF (IOPHIG.EQ.3) THEN + EMM=EM*(EMH/EM)**4 + WEIGHT=W1*GAMOFS*EMM/GAMEM *((EM**2-EMH**2)**2 + GAMEM**2) + & /((EM**2-EMH**2)**2 +(GAMOFS*EMM)**2) + ELSE + CALL HWWARN('HWHIGM',500,*999) + ENDIF + 999 END +CDECK ID>, HWHIGS. +*CMZ :- -26/04/91 11.11.55 by Bryan Webber +*-- Author : Mike Seymour +C----------------------------------------------------------------------- + SUBROUTINE HWHIGS +C----------------------------------------------------------------------- +C HIGGS PRODUCTION VIA GLUON OR QUARK FUSION +C MEAN EVWGT = HIGGS PRODN C-S * BRANCHING FRACTION IN NB +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + DOUBLE PRECISION HWUALF,HWHIGT,HWR,HWUSQR,HWUAEM,BRHIGQ,EMH, + & CSFAC(13),EVSUM(13),EMFAC,CV,CA,BR,RWGT,E1,E2,EMQ,GFACTR + INTEGER IDEC,I,J,ID1,ID2 + EXTERNAL HWUALF,HWHIGT,HWR,HWUSQR,HWUAEM + SAVE CSFAC,BR,EVSUM + IF (GENEV) THEN + RWGT=HWR()*EVSUM(13) + IDN(1)=1 + DO 10 I=1,12 + 10 IF (RWGT.GT.EVSUM(I)) IDN(1)=I+1 + IDN(2)=13 + IF (IDN(1).LE.12) IDN(2)=IDN(1)-6 + IF (IDN(1).LE. 6) IDN(2)=IDN(1)+6 + IDCMF=201 + CALL HWEONE + ELSE + EVWGT=0. + CALL HWHIGM(EMH,EMFAC) + IF (EMH.LE.ZERO .OR. EMH.GE.PHEP(5,3)) RETURN + EMSCA=EMH + IF (EMSCA.NE.EMLST) THEN + EMLST=EMH + XXMIN=(EMH/PHEP(5,3))**2 + XLMIN=LOG(XXMIN) + GFACTR=GEV2NB*HWUAEM(EMH**2)/(288.*SWEIN*RMASS(198)**2) + DO 20 I=1,13 + EMQ=RMASS(I) + IF (I.EQ.13) THEN + CSFAC(I)=-GFACTR*HWHIGT(RMASS(NFLAV)/EMH)*XLMIN + & *HWUALF(1,EMH)**2 *EMFAC*ENHANC(NFLAV)**2 + ELSEIF (I.GT.6) THEN + CSFAC(I)=CSFAC(I-6) + ELSEIF (EMH.GT.2*EMQ) THEN + CSFAC(I)=-GFACTR*96.*PIFAC**2 *(1-(2*EMQ/EMH)**2) + & *(EMQ/EMH)**2 *XLMIN *EMFAC*ENHANC(I)**2 + ELSE + CSFAC(I)=0 + ENDIF + 20 CONTINUE +C INCLUDE BRANCHING RATIO OF HIGGS + IDEC=MOD(IPROC,100) + BR=1 + IF (IDEC.EQ.0) THEN + BRHIGQ=0 + DO 30 I=1,6 + 30 BRHIGQ=BRHIGQ+BRHIG(I) + BR=BRHIGQ + ELSEIF (IDEC.EQ.10) THEN + CALL HWDBOZ(198,ID1,ID2,CV,CA,BR,1) + CALL HWDBOZ(199,ID1,ID2,CV,CA,BR,1) + BR=BR*BRHIG(IDEC) + ELSEIF (IDEC.EQ.11) THEN + CALL HWDBOZ(200,ID1,ID2,CV,CA,BR,1) + CALL HWDBOZ(200,ID1,ID2,CV,CA,BR,1) + BR=BR*BRHIG(IDEC) + ELSEIF (IDEC.LE.12) THEN + BR=BRHIG(IDEC) + ENDIF + ENDIF + CALL HWSGEN(.TRUE.) + EVWGT=0 + E1=PHEP(4,MAX(1,JDAHEP(1,1))) + E2=PHEP(4,MAX(2,JDAHEP(1,2))) + DO 40 I=1,13 + EMQ=RMASS(I) + IF (EMH.GT.2*EMQ) THEN + J=13 + IF (I.LE.12) J=I-6 + IF (I.LE. 6) J=I+6 + IF (XX(1).LT.HALF*(ONE-EMQ/E1+HWUSQR(ONE-TWO*EMQ/E1)) .AND. + & XX(2).LT.HALF*(ONE-EMQ/E2+HWUSQR(ONE-TWO*EMQ/E2))) + & EVWGT=EVWGT+DISF(I,1)*DISF(J,2)*CSFAC(I)*BR + ENDIF + EVSUM(I)=EVWGT + 40 CONTINUE + ENDIF + 999 END +CDECK ID>, HWHIGT. +*CMZ :- -26/04/91 11.11.55 by Bryan Webber +*-- Author : Mike Seymour +C----------------------------------------------------------------------- + FUNCTION HWHIGT(RATIO) +C----------------------------------------------------------------------- +C CALCULATE MOD SQUARED I FOR RATIO = Mtop / Mhiggs +C I DEFINED AS IN BARGER & PHILLIPS p433 +C WARNING: THIS IS A FACTOR OF 3 GREATER THAN EHLQ'S ETA FUNCTION +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + DOUBLE PRECISION HWHIGT,RATIO,RAT2,FREAL,FIMAG,ETALOG,AIREAL, + & AIIMAG + RAT2=RATIO**2 + IF (FOUR*RAT2.GT.ONE) THEN + FREAL=-TWO*ASIN(HALF/RATIO)**2 + FIMAG=ZERO + ELSEIF (FOUR*RAT2.LT.ONE) THEN + ETALOG=LOG((HALF+SQRT(0.25-RAT2)) / (HALF-SQRT(0.25-RAT2)) ) + FREAL=HALF * (ETALOG**2 - PIFAC**2) + FIMAG=PIFAC * ETALOG + ELSE + FREAL=HALF * ( - PIFAC**2) + FIMAG=ZERO + ENDIF + AIREAL=THREE*( TWO*RAT2 + RAT2*(FOUR*RAT2-ONE)*FREAL ) + AIIMAG=THREE*( RAT2*(FOUR*RAT2-ONE)*FIMAG ) + HWHIGT=AIREAL**2 + AIIMAG**2 + END +CDECK ID>, HWHIGW. +*CMZ :- -26/04/91 14.55.44 by Federico Carminati +*-- Author : Mike Seymour +C----------------------------------------------------------------------- + SUBROUTINE HWHIGW +C----------------------------------------------------------------------- +C HIGGS PRODUCTION VIA W BOSON FUSION +C MEAN EVWGT = HIGGS PRODN C-S * BRANCHING FRACTION IN NB +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + DOUBLE PRECISION HWULDO,HWRUNI,HWR,HWUAEM,K1MAX2,K1MIN2,K12, + & K2MAX2,K2MIN2,K22,EMW2,EMW,ROOTS,EMH2,EMH,ROOTS2,P1,PHI1,PHI2, + & COSPHI,COSTH1,SINTH1,COSTH2,SINTH2,P2,WEIGHT,TAU,TAULN,CSFAC, + & PSUM,PROB,Q1(5),Q2(5),H(5),A,B,C,TERM2,BRHIGQ,G1WW,G2WW,G1ZZ(6), + & G2ZZ(6),AWW,AZZ(6),PWW,PZZ(6),EMZ,EMZ2,RSUM,GLUSQ,GRUSQ,GLDSQ, + & GRDSQ,GLESQ,GRESQ,CW,CZ,EMFAC,CV,CA,BR,X2,ETA,P1JAC,FACTR,EH2 + INTEGER HWRINT,IDEC,I,ID1,ID2,IHAD + LOGICAL EE,EP + EXTERNAL HWULDO,HWRUNI,HWR,HWUAEM,HWRINT + SAVE EMW2,EMZ2,EE,GLUSQ,GRUSQ,GLDSQ,GRDSQ,GLESQ,GRESQ,G1ZZ,G2ZZ, + & G1WW,G2WW,CW,CZ,PSUM,AWW,PWW,AZZ,PZZ,ROOTS,Q1,Q2,H,FACTR + EQUIVALENCE (EMW,RMASS(198)),(EMZ,RMASS(200)) + IHAD=2 + IF (JDAHEP(1,IHAD).NE.0) IHAD=JDAHEP(1,IHAD) + IF (FSTWGT) THEN + EMW2=EMW**2 + EMZ2=EMZ**2 + GLUSQ=(VFCH(2,1)+AFCH(2,1))**2 + GRUSQ=(VFCH(2,1)-AFCH(2,1))**2 + GLDSQ=(VFCH(1,1)+AFCH(1,1))**2 + GRDSQ=(VFCH(1,1)-AFCH(1,1))**2 + GLESQ=(VFCH(11,1)+AFCH(11,1))**2 + GRESQ=(VFCH(11,1)-AFCH(11,1))**2 + G1ZZ(1)=GLUSQ*GLUSQ+GRUSQ*GRUSQ + G2ZZ(1)=GLUSQ*GRUSQ+GRUSQ*GLUSQ + G1ZZ(2)=GLUSQ*GLDSQ+GRUSQ*GRDSQ + G2ZZ(2)=GLUSQ*GRDSQ+GRUSQ*GLDSQ + G1ZZ(3)=GLDSQ*GLDSQ+GRDSQ*GRDSQ + G2ZZ(3)=GLDSQ*GRDSQ+GRDSQ*GLDSQ + G1ZZ(4)=GLESQ*GLESQ+GRESQ*GRESQ + G2ZZ(4)=GLESQ*GRESQ+GRESQ*GLESQ + G1ZZ(5)=GLESQ*GLUSQ+GRESQ*GRUSQ + G2ZZ(5)=GLESQ*GRUSQ+GRESQ*GLUSQ + G1ZZ(6)=GLESQ*GLDSQ+GRESQ*GRDSQ + G2ZZ(6)=GLESQ*GRDSQ+GRESQ*GLDSQ + G1WW=0.25 + G2WW=0 + FACTR=GEV2NB/(128.*PIFAC**3) + EH2=RMASS(201)**2 + CW=256*(PIFAC*HWUAEM(EH2)/SWEIN)**3*EMW2 + CZ=256.*(PIFAC*HWUAEM(EH2))**3*EMZ2/(SWEIN*(1.-SWEIN)) + ENDIF + EE=IPRO.LT.10 + EP=IPRO.GE.90 + IF (.NOT.GENEV) THEN +C---CHOOSE PARAMETERS + EVWGT=0. + CALL HWHIGM(EMH,EMFAC) + IF (EMH.LE.ZERO .OR. EMH.GE.PHEP(5,3)) RETURN + EMSCA=EMH + IF (EE) THEN + ROOTS=PHEP(5,3) + ELSE + TAU=(EMH/PHEP(5,3))**2 + TAULN=LOG(TAU) + ROOTS=PHEP(5,3)*SQRT(EXP(HWRUNI(0,-1D-10,TAULN))) + ENDIF + EMH2=EMH**2 + ROOTS2=ROOTS**2 +C---CHOOSE P1 ACCORDING TO (1-ETA)*(ETA-X2)/ETA**2 +C WHERE ETA=1-2P1/ROOTS AND X2=EMH**2/S + X2=EMH2/ROOTS2 + 1 ETA=X2**HWR() + IF (HWR()*(1-EMH/ROOTS)**2*ETA.GT.(1-ETA)*(ETA-X2))GOTO 1 + P1JAC=0.5*ROOTS*ETA**2/((1-ETA)*(ETA-X2)) + & *(-LOG(X2)*(1+X2)-2*(1-X2)) + P1=0.5*ROOTS*(1-ETA) +C---CHOOSE PHI1,2 UNIFORMLY + PHI1=2*PIFAC*HWR() + PHI2=2*PIFAC*HWR() + COSPHI=COS(PHI2-PHI1) +C---CHOOSE K1^2, ON PROPAGATOR FACTOR + K1MAX2=2*P1*ROOTS + K1MIN2=0 + K12=EMW2-(EMW2+K1MAX2)*(EMW2+K1MIN2)/ + & ((K1MAX2-K1MIN2)*HWR()+(EMW2+K1MIN2)) +C---CALCULATE COSTH1 FROM K1^2 + COSTH1=1+K12/(P1*ROOTS) + SINTH1=SQRT(1-COSTH1**2) +C---CHOOSE K2^2 + K2MAX2=ROOTS*(ROOTS2-EMH2-2*ROOTS*P1)*(ROOTS-P1-P1*COSTH1) + & /((ROOTS-P1)**2-(P1*COSTH1)**2-(P1*SINTH1*COSPHI)**2) + K2MIN2=0 + K22=EMW2-(EMW2+K2MAX2)*(EMW2+K2MIN2)/ + & ((K2MAX2-K2MIN2)*HWR()+(EMW2+K2MIN2)) +C---CALCULATE A,B,C FACTORS, AND... + A=-2*K22*P1*COSTH1 - ROOTS*(ROOTS2-EMH2-2*ROOTS*P1) + B=-2*K22*P1*SINTH1*COSPHI + C=+2*K22*P1 - 2*ROOTS*K22 - ROOTS*(ROOTS2-EMH2-2*ROOTS*P1) +C---SOLVE A*COSTH2 + B*SINTH2 + C = 0 FOR COSTH2 + TERM2=B**2 + A**2 - C**2 + IF (TERM2.LT.ZERO) RETURN + TERM2=B*SQRT(TERM2) + IF (A.GE.ZERO) RETURN + COSTH2=(-A*C + TERM2)/(A**2+B**2) + SINTH2=SQRT(1-COSTH2**2) +C---FINALLY, GET P2 + IF (COSTH2.EQ.-ONE) RETURN + P2=-K22/(ROOTS*(1+COSTH2)) +C---LOAD UP CMF MOMENTA + Q1(1)=P1*SINTH1*COS(PHI1) + Q1(2)=P1*SINTH1*SIN(PHI1) + Q1(3)=P1*COSTH1 + Q1(4)=P1 + Q1(5)=0 + Q2(1)=P2*SINTH2*COS(PHI2) + Q2(2)=P2*SINTH2*SIN(PHI2) + Q2(3)=P2*COSTH2 + Q2(4)=P2 + Q2(5)=0 + H(1)=-Q1(1)-Q2(1) + H(2)=-Q1(2)-Q2(2) + H(3)=-Q1(3)-Q2(3) + H(4)=-Q1(4)-Q2(4)+ROOTS + CALL HWUMAS(H) +C---CALCULATE MATRIX ELEMENTS SQUARED + AWW=ENHANC(10)**2 * CW*(ROOTS2/2*HWULDO(Q1,Q2)*G1WW + & +ROOTS2/4*P1*P2*(1+COSTH1)*(1-COSTH2)*G2WW) + DO 10 I=1,6 + AZZ(I)=ENHANC(11)**2 * CZ*(ROOTS2/2*HWULDO(Q1,Q2)*G1ZZ(I) + & +ROOTS2/4*P1*P2*(1+COSTH1)*(1-COSTH2)*G2ZZ(I)) + & *((K12-EMW2)/(K12-EMZ2)*(K22-EMW2)/(K22-EMZ2))**2 + 10 CONTINUE +C---CALCULATE WEIGHT IN INTEGRAL + WEIGHT=FACTR*P2*P1JAC/(ROOTS2**2*HWULDO(H,Q2)) + & *(K1MAX2-K1MIN2)/((K1MAX2+EMW2)*(K1MIN2+EMW2)) + & *(K2MAX2-K2MIN2)/((K2MAX2+EMW2)*(K2MIN2+EMW2)) + & * EMFAC + EMSCA=EMW + XXMIN=(ROOTS/PHEP(5,3))**2 + XLMIN=LOG(XXMIN) +C---INCLUDE BRANCHING RATIO OF HIGGS + IDEC=MOD(IPROC,100) + IF (IDEC.GT.0.AND.IDEC.LE.12) WEIGHT=WEIGHT*BRHIG(IDEC) + IF (IDEC.EQ.0) THEN + BRHIGQ=0 + DO 20 I=1,6 + 20 BRHIGQ=BRHIGQ+BRHIG(I) + WEIGHT=WEIGHT*BRHIGQ + ENDIF + IF (IDEC.EQ.10) THEN + CALL HWDBOZ(198,ID1,ID2,CV,CA,BR,1) + CALL HWDBOZ(199,ID1,ID2,CV,CA,BR,1) + WEIGHT=WEIGHT*BR + ELSEIF (IDEC.EQ.11) THEN + CALL HWDBOZ(200,ID1,ID2,CV,CA,BR,1) + CALL HWDBOZ(200,ID1,ID2,CV,CA,BR,1) + WEIGHT=WEIGHT*BR + ENDIF + IF (EE) THEN + CSFAC=WEIGHT + PSUM=AWW+AZZ(4) + EVWGT=CSFAC*PSUM + ELSEIF (EP) THEN + CSFAC=-WEIGHT*TAULN + XX(1)=ONE + XX(2)=XXMIN + CALL HWSFUN(XX(2),EMSCA,IDHW(IHAD),NSTRU,DISF(1,2),2) + IF (IDHW(1).LE.126) THEN + PWW=(DISF(2,2)+DISF(4,2)+DISF(7,2)+DISF( 9,2))*AWW + ELSE + PWW=(DISF(1,2)+DISF(3,2)+DISF(8,2)+DISF(10,2))*AWW + ENDIF + PZZ(5)=(DISF(2,2)+DISF(4,2)+DISF(8,2)+DISF(10,2))*AZZ(5) + PZZ(6)=(DISF(1,2)+DISF(3,2)+DISF(7,2)+DISF( 9,2))*AZZ(6) + PSUM=PWW+PZZ(5)+PZZ(6) + EVWGT=CSFAC*PSUM + ELSE + CSFAC=WEIGHT*TAULN*XLMIN + CALL HWSGEN(.TRUE.) + PWW=((DISF(2,1)+DISF(4, 1)+DISF(7,1)+DISF(9,1)) + & *(DISF(8,2)+DISF(10,2)+DISF(1,2)+DISF(3,2)) + & +(DISF(8,1)+DISF(10,1)+DISF(1,1)+DISF(3,1)) + & *(DISF(2,2)+DISF(4, 2)+DISF(7,2)+DISF(9,2))) + & *AWW + PZZ(1)=((DISF(2,1)+DISF(4,1)+DISF(8,1)+DISF(10,1)) + & *(DISF(2,2)+DISF(4,2)+DISF(8,2)+DISF(10,2))) + & *AZZ(1) + PZZ(2)=((DISF(2,1)+DISF(4,1)+DISF(8,1)+DISF(10,1)) + & *(DISF(1,2)+DISF(3,2)+DISF(7,2)+DISF(9, 2)) + & +(DISF(1,1)+DISF(3,1)+DISF(7,1)+DISF(9, 1)) + & *(DISF(2,2)+DISF(4,2)+DISF(8,2)+DISF(10,2))) + & *AZZ(2) + PZZ(3)=((DISF(1,1)+DISF(3,1)+DISF(7,1)+DISF(9,1)) + & *(DISF(1,2)+DISF(3,2)+DISF(7,2)+DISF(9,2))) + & *AZZ(3) + PSUM=PWW+PZZ(1)+PZZ(2)+PZZ(3) +C---EVENT WEIGHT IS SUM OVER ALL COMBINATIONS + EVWGT=CSFAC*PSUM + ENDIF + ELSE +C---GENERATE EVENT +C---CHOOSE EVENT TYPE + RSUM=PSUM*HWR() +C---ELECTRON BEAMS? + IF (EE) THEN + IDN(1)=IDHW(1) + IDN(2)=IDHW(2) +C---WW FUSION? + IF (RSUM.LT.AWW) THEN + IDN(3)=IDN(1)+1 + IDN(4)=IDN(2)+1 +C---ZZ FUSION? + ELSE + IDN(3)=IDN(1) + IDN(4)=IDN(2) + ENDIF +C---LEPTON-HADRON COLISION? + ELSEIF (EP) THEN +C---WW FUSION? + IDN(1)=IDHW(1) + IF (RSUM.LT.PWW) THEN + 24 IDN(2)=HWRINT(1,8) + IF (IDN(2).GE.5) IDN(2)=IDN(2)+2 + IF (ICHRG(IDN(1))*ICHRG(IDN(2)).GT.0) GOTO 24 + PROB=DISF(IDN(2),2)*AWW/PWW + IF (HWR().GT.PROB) GOTO 24 + IDN(3)=IDN(1)+1 + IF (HWR().GT.SCABI) THEN + IDN(4)= 4*INT((IDN(2)-1)/2)-IDN(2)+3 + ELSE + IDN(4)=12*INT((IDN(2)-1)/6)-IDN(2)+5 + ENDIF +C---ZZ FUSION FROM U-TYPE QUARK? + ELSEIF (RSUM.LT.PWW+PZZ(5)) THEN + 26 IDN(2)=2*HWRINT(1,4) + IF (IDN(2).GE.5) IDN(2)=IDN(2)+2 + PROB=DISF(IDN(2),2)*AZZ(5)/PZZ(5) + IF (HWR().GT.PROB) GOTO 26 + IDN(3)=IDN(1) + IDN(4)=IDN(2) +C---ZZ FUSION FROM D-TYPE QUARK? + ELSE + 28 IDN(2)=2*HWRINT(1,4)-1 + IF (IDN(2).GE.5) IDN(2)=IDN(2)+2 + PROB=DISF(IDN(2),2)*AZZ(6)/PZZ(6) + IF (HWR().GT.PROB) GOTO 28 + IDN(3)=IDN(1) + IDN(4)=IDN(2) + ENDIF +C---HADRON BEAMS? + ELSE +C---WW FUSION? + IF (RSUM.LT.PWW) THEN + 31 DO 32 I=1,2 + IDN(I)=HWRINT(1,8) + IF (IDN(I).GE.5) IDN(I)=IDN(I)+2 + 32 CONTINUE + IF (ICHRG(IDN(1))*ICHRG(IDN(2)).GT.0) GOTO 31 + PROB=DISF(IDN(1),1)*DISF(IDN(2),2)*AWW/PWW + IF (HWR().GT.PROB) GOTO 31 +C---CHOOSE OUTGOING QUARKS + DO 33 I=1,2 + IF (HWR().GT.SCABI) THEN + IDN(I+2)=4*INT((IDN(I)-1)/2)-IDN(I)+3 + ELSE + IDN(I+2)=12*INT((IDN(I)-1)/6)-IDN(I)+5 + ENDIF + 33 CONTINUE +C---ZZ FUSION FROM U-TYPE QUARKS? + ELSEIF (RSUM.LT.PWW+PZZ(1)) THEN + 41 DO 42 I=1,2 + IDN(I)=2*HWRINT(1,4) + IF (IDN(I).GE.5) IDN(I)=IDN(I)+2 + 42 CONTINUE + PROB=DISF(IDN(1),1)*DISF(IDN(2),2)*AZZ(1)/PZZ(1) + IF (HWR().GT.PROB) GOTO 41 + IDN(3)=IDN(1) + IDN(4)=IDN(2) +C---ZZ FUSION FROM D-TYPE QUARKS? + ELSEIF (RSUM.LT.PWW+PZZ(1)+PZZ(3)) THEN + 51 DO 52 I=1,2 + IDN(I)=2*HWRINT(1,4)-1 + IF (IDN(I).GE.5) IDN(I)=IDN(I)+2 + 52 CONTINUE + PROB=DISF(IDN(1),1)*DISF(IDN(2),2)*AZZ(3)/PZZ(3) + IF (HWR().GT.PROB) GOTO 51 + IDN(3)=IDN(1) + IDN(4)=IDN(2) +C---ZZ FUSION FROM UD-TYPE PAIRS? + ELSE + 61 IF (HWR().GT.HALF) THEN + IDN(1)=2*HWRINT(1,4)-1 + IDN(2)=2*HWRINT(1,4) + ELSE + IDN(1)=2*HWRINT(1,4) + IDN(2)=2*HWRINT(1,4)-1 + ENDIF + DO 62 I=1,2 + 62 IF (IDN(I).GE.5) IDN(I)=IDN(I)+2 + PROB=DISF(IDN(1),1)*DISF(IDN(2),2)*AZZ(2)/PZZ(2) + IF (HWR().GT.PROB) GOTO 61 + IDN(3)=IDN(1) + IDN(4)=IDN(2) + ENDIF + ENDIF +C---NOW BOOST TO LAB, AND SET UP STATUS CODES etc + IDCMF=15 +C---INCOMING + IF (.NOT.EE) CALL HWEONE +C---CMF POINTERS + JDAHEP(1,NHEP)=NHEP+1 + JDAHEP(2,NHEP)=NHEP+3 + JMOHEP(1,NHEP+1)=NHEP + JMOHEP(1,NHEP+2)=NHEP + JMOHEP(1,NHEP+3)=NHEP +C---OUTGOING MOMENTA (GIVE QUARKS MASS NON-COVARIANTLY!) + Q1(5)=RMASS(IDN(1)) + Q1(4)=SQRT(Q1(4)**2+Q1(5)**2) + Q2(5)=RMASS(IDN(2)) + Q2(4)=SQRT(Q2(4)**2+Q2(5)**2) + H(4)=-Q1(4)-Q2(4)+PHEP(5,NHEP) + CALL HWUMAS(H) + CALL HWULOB(PHEP(1,NHEP),Q1,PHEP(1,NHEP+1)) + CALL HWULOB(PHEP(1,NHEP),Q2,PHEP(1,NHEP+2)) + CALL HWULOB(PHEP(1,NHEP),H,PHEP(1,NHEP+3)) +C---STATUS AND IDs + ISTHEP(NHEP+1)=113 + ISTHEP(NHEP+2)=114 + ISTHEP(NHEP+3)=114 + IDHW(NHEP+1)=IDN(3) + IDHEP(NHEP+1)=IDPDG(IDN(3)) + IDHW(NHEP+2)=IDN(4) + IDHEP(NHEP+2)=IDPDG(IDN(4)) + IDHW(NHEP+3)=201 + IDHEP(NHEP+3)=IDPDG(201) +C---COLOUR LABELS + JMOHEP(2,NHEP+1)=NHEP-2 + JMOHEP(2,NHEP+2)=NHEP-1 + JMOHEP(2,NHEP-1)=NHEP+2 + JMOHEP(2,NHEP-2)=NHEP+1 + JMOHEP(2,NHEP+3)=NHEP+3 + JDAHEP(2,NHEP+1)=NHEP-2 + JDAHEP(2,NHEP+2)=NHEP-1 + JDAHEP(2,NHEP-1)=NHEP+2 + JDAHEP(2,NHEP-2)=NHEP+1 + JDAHEP(2,NHEP+3)=NHEP+3 + NHEP=NHEP+3 + ENDIF + 999 END +CDECK ID>, HWHIGY. +*CMZ :- -26/04/91 13.37.37 by Federico Carminati +*-- Author : Mike Seymour +C----------------------------------------------------------------------- + FUNCTION HWHIGY(A,B,XP) +C----------------------------------------------------------------------- +C CALCULATE THE INTEGRAL OF BERENDS AND KLEISS APPENDIX B +C----------------------------------------------------------------------- + IMPLICIT NONE + COMPLEX XQ,Z1,Z2,Z3,Z4,C0,C1,C2,C3,C4,C5,C6,C7,C8,FUN,Z + DOUBLE PRECISION HWHIGY,TWO,A,B,XP,Y + PARAMETER (TWO=2.D0) +C---DECLARE ALL THE STATEMENT-FUNCTION DEFINITIONS + C0(Z,A)=(Z**2-A)**2*((Z**2+A)**2-24*Z*(Z**2+A)+8*Z**2*(A+6))/Z**4 + C1(Z,A)=A**4/(3*Z) + C2(Z,A)=-A**3*(24*Z-A)/(2*Z**2) + C3(Z,A)=A**2*(8*Z**2*(A+6)-24*A*Z+A**2)/Z**3 + C4(Z,A)=-A**2*(24*Z**3+8*Z**2*(A+6)-24*A*Z+A**2)/Z**4 + C5(Z,A)=Z**3-24*Z**2+8*Z*(A+6)+24*A + C6(Z,A)=0.5*Z**2-12*Z+4*(A+6) + C7(Z,A)=Z/3-8 + C8(Z,A)=0.25 + FUN(Z,Y,A)=C0(Z,A)*LOG(Y-Z) + & +C1(Z,A)/Y**3 + & +C2(Z,A)/Y**2 + & +C3(Z,A)/Y + & +C4(Z,A)*LOG(Y) + & +C5(Z,A)*Y + & +C6(Z,A)*Y**2 + & +C7(Z,A)*Y**3 + & +C8(Z,A)*Y**4 +C---NOW EVALUATE THE INTEGRAL + HWHIGY=0 + IF (A.GT.4) RETURN + XQ=CMPLX(XP,B) + Z1=XQ+SQRT(XQ**2-A) + Z2=XQ-SQRT(XQ**2-A) + Z3=FUN(Z1,TWO,A)-FUN(Z1,SQRT(A),A) + Z4=FUN(Z2,TWO,A)-FUN(Z2,SQRT(A),A) + HWHIGY=AIMAG((Z3-Z4)/(Z1-Z2))/(8*B) + END +CDECK ID>, HWHIGZ. +*CMZ :- -02/05/91 11.18.44 by Federico Carminati +*-- Author : Mike Seymour +C----------------------------------------------------------------------- + SUBROUTINE HWHIGZ +C----------------------------------------------------------------------- +C HIGGS PRODUCTION VIA THE BJORKEN PROCESS: E+E- --> Z(*) --> Z(*)H +C WHERE ONE OR BOTH OF THE Zs IS OFF-SHELL +C USES ALGORITHM OF BERENDS AND KLEISS: NUCL.PHYS. B260(1985)32 +C +C MEAN EVWGT = CROSS-SECTION (IN NB) * HIGGS BRANCHING FRACTION +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + DOUBLE PRECISION HWUAEM,HWHIGY,HWRUNI,HWR,HWULDO,EMZ,CVE,CAE, + & POL1,POL2,CE1,CE2,CE3,PMAX,EMZ2,S,B,FACTR,EMH,EMFAC,EMH2,A,XP, + & CV,CA,BRHIGQ,BR,X1,X2,FAC1,FAC2,XPP,XPPSQ,COEF,X,XSQ,PROB,C1,C2, + & CHIGG,PTHETA,SHIGG,C3,PHIMAX,CPHI,SPHI,C2PHI,S2PHI,PCM,ELST + INTEGER IDEC,I,NLOOP,ICMF,IHIG,IZED,IFER,IANT,ID1,ID2,IN1,IN2 + EXTERNAL HWUAEM,HWHIGY,HWRUNI,HWR,HWULDO + SAVE CVE,CAE,CE1,CE2,CE3,PMAX,EMZ2,S,EMH,B,FACTR,A,EMH2 + EQUIVALENCE (EMZ,RMASS(200)) + DATA ELST/0/ +C---SET UP CONSTANTS + IN1=1 + IF (JDAHEP(1,IN1).NE.0) IN1=JDAHEP(1,IN1) + IN2=2 + IF (JDAHEP(1,IN2).NE.0) IN2=JDAHEP(1,IN2) + IF (FSTWGT.OR.ELST.NE.PHEP(5,3)) THEN + ELST=PHEP(5,3) + CVE=VFCH(11,1) + CAE=AFCH(11,1) + POL1=1.-EPOLN(3)*PPOLN(3) + POL2=EPOLN(3)-PPOLN(3) + CE1=(POL1*(CVE**2+CAE**2)+POL2*2.*CVE*CAE) + CE2=(POL1*2.*CVE*CAE+POL2*(CVE**2+CAE**2)) + IF ((IDHW(IN1).GT.IDHW(IN2).AND.PHEP(3,IN1).LT.ZERO).OR. + & (IDHW(IN2).GT.IDHW(IN1).AND.PHEP(3,IN2).LT.ZERO)) CE2=-CE2 + IF (TPOL) CE3=(CVE**2-CAE**2) + PMAX=4 + EMZ2=EMZ**2 + S=PHEP(5,3)**2 + B=EMZ*GAMZ/S + FACTR=GEV2NB*CE1*(HWUAEM(RMASS(201)**2)*ENHANC(11))**2 + & /(12.*S*SWEIN*(1.-SWEIN))*B/((1-EMZ2/S)**2+B**2) + ENDIF + IF (.NOT.GENEV) THEN +C---CHOOSE HIGGS MASS, AND CALCULATE EVENT WEIGHT + EVWGT=0D0 + CALL HWHIGM(EMH,EMFAC) + IF (EMH.LE.ZERO .OR. EMH.GT.PHEP(5,3)) RETURN + EMSCA=EMH + EMH2=EMH**2 + A=4*EMH2/S + XP=1+(EMH2-EMZ2)/S + EVWGT=FACTR*HWHIGY(A,B,XP)*EMFAC +C---INCLUDE BRANCHING RATIO OF HIGGS + IDEC=MOD(IPROC,100) + IF (IDEC.GT.0.AND.IDEC.LE.12) EVWGT=EVWGT*BRHIG(IDEC) + IF (IDEC.EQ.0) THEN + BRHIGQ=0 + DO 10 I=1,6 + 10 BRHIGQ=BRHIGQ+BRHIG(I) + EVWGT=EVWGT*BRHIGQ + ENDIF +C Add Z branching fractions + CALL HWDBOZ(200,ID1,ID2,CV,CA,BR,0) + EVWGT=EVWGT*BR + IF (IDEC.EQ.10) THEN + CALL HWDBOZ(198,ID1,ID2,CV,CA,BR,1) + CALL HWDBOZ(199,ID1,ID2,CV,CA,BR,1) + EVWGT=EVWGT*BR + ELSEIF (IDEC.EQ.11) THEN + CALL HWDBOZ(200,ID1,ID2,CV,CA,BR,1) + CALL HWDBOZ(200,ID1,ID2,CV,CA,BR,1) + EVWGT=EVWGT*BR + ENDIF + ELSE +C---GENERATE EVENT + ICMF=NHEP+1 + IHIG=NHEP+2 + IZED=NHEP+3 + IFER=NHEP+4 + IANT=NHEP+5 + CALL HWVEQU(5,PHEP(1,3),PHEP(1,ICMF)) + NHEP=NHEP+5 +C---CHOOSE ENERGY FRACTION OF HIGGS + X1=SQRT(A) + X2=1+0.25*A + XP=1+(EMH2-EMZ2)/S + FAC1=ATAN((X1-XP)/B) + FAC2=ATAN((X2-XP)/B) + XPP=MIN(X2,MAX(X1+B,XP)) + XPPSQ=XPP**2 + NLOOP=0 + COEF=1./((12+2*A-12*XPP+XPPSQ)*SQRT(XPPSQ-A)) + 20 NLOOP=NLOOP+1 + IF (NLOOP.GT.NBTRY) CALL HWWARN('HWHIGZ',101,*999) + X=XP+B*TAN(HWRUNI(1,FAC1,FAC2)) + XSQ=X**2 + PROB=COEF*((12+2*A-12*X+XSQ)*SQRT(XSQ-A)) + IF (PROB.GT.PMAX) THEN + PMAX=1.1*PROB + CALL HWWARN('HWHIGZ',1,*999) + WRITE (6,21) PMAX + 21 FORMAT(7X,'NEW HWHIGZ MAX WEIGHT =',F8.4) + ENDIF + IF (PROB.LT.PMAX*HWR()) GOTO 20 +C Choose Z decay mode + CALL HWDBOZ(200,IDHW(IFER),IDHW(IANT),CV,CA,BR,0) + C1=CE1*(CV**2+CA**2) + C2=CE2*2.*CV*CA +C---CHOOSE HIGGS DIRECTION +C First polar angle + NLOOP=0 + COEF=(XSQ-A)/(8.*(1.-X)+XSQ+A) + 30 NLOOP=NLOOP+1 + IF (NLOOP.GT.NBTRY) CALL HWWARN('HWHIGZ',102,*999) + CHIGG=HWRUNI(2,-ONE, ONE) + PTHETA=1-COEF*CHIGG**2 + IF (PTHETA.LT.HWR()) GOTO 30 + SHIGG=SQRT(1-CHIGG**2) +C Now azimuthal angle + IF (TPOL) THEN + C3=CE3*(CV*2+CA**2) + COEF=COEF*SHIGG**2*C3/C1 + PHIMAX=PTHETA+ABS(COEF) + 40 CALL HWRAZM(ONE,CPHI,SPHI) + C2PHI=2.*CPHI**2-1. + S2PHI=2.*CPHI*SPHI + PROB=PTHETA-COEF*(C2PHI*COSS+S2PHI*SINS) + IF (PROB.LT.HWR()*PHIMAX) GOTO 40 + ELSE + CALL HWRAZM(ONE,CPHI,SPHI) + ENDIF +C Construct Higgs and Z momenta + PHEP(5,IHIG)=EMH + PHEP(4,IHIG)=X*PHEP(5,ICMF)/2 + PCM=SQRT(PHEP(4,IHIG)**2-EMH2) + PHEP(3,IHIG)=CHIGG*PCM + PHEP(1,IHIG)=SHIGG*PCM*CPHI + PHEP(2,IHIG)=SHIGG*PCM*SPHI + CALL HWVDIF(4,PHEP(1,ICMF),PHEP(1,IHIG),PHEP(1,IZED)) + CALL HWUMAS(PHEP(1,IZED)) +C Choose orientation of Z decay + NLOOP=0 + COEF=2.*(C1+ABS(C2))*HWULDO(PHEP(1,IN1),PHEP(1,IZED)) + & *HWULDO(PHEP(1,IN2),PHEP(1,IZED))/S + IF (TPOL) COEF=COEF*(C1+ABS(C2)+ABS(C3))/(C1+ABS(C2)) + PCM=PHEP(5,IZED)/2 + PHEP(5,IFER)=0 + PHEP(5,IANT)=0 + 50 NLOOP=NLOOP+1 + IF (NLOOP.GT.NBTRY) CALL HWWARN('HWHIGZ',103,*999) + CALL HWDTWO(PHEP(1,IZED),PHEP(1,IFER),PHEP(1,IANT), + & PCM,TWO,.TRUE.) + PROB=C1*(PHEP(4,IFER)*PHEP(4,IANT)-PHEP(3,IFER)*PHEP(3,IANT)) + & +C2*(PHEP(4,IFER)*PHEP(3,IANT)-PHEP(3,IFER)*PHEP(4,IANT)) + IF (TPOL) PROB=PROB+C3* + & (COSS*(PHEP(1,IFER)*PHEP(1,IANT)-PHEP(2,IFER)*PHEP(2,IANT)) + & +SINS*(PHEP(1,IFER)*PHEP(2,IANT)+PHEP(2,IFER)*PHEP(1,IANT))) + IF (PROB.LT.HWR()*COEF) GOTO 50 +C---SET UP STATUS CODES, + ISTHEP(ICMF)=120 + ISTHEP(IHIG)=190 + ISTHEP(IZED)=195 + ISTHEP(IFER)=113 + ISTHEP(IANT)=114 +C---COLOR CONNECTIONS, + JMOHEP(1,ICMF)=1 + JMOHEP(2,ICMF)=2 + JDAHEP(1,ICMF)=IHIG + JDAHEP(2,ICMF)=IZED + JMOHEP(1,IHIG)=ICMF + JMOHEP(1,IZED)=ICMF + JMOHEP(1,IFER)=IZED + JMOHEP(1,IANT)=IZED + JMOHEP(2,IFER)=IANT + JMOHEP(2,IANT)=IFER + JDAHEP(1,IZED)=IFER + JDAHEP(2,IZED)=IANT + JDAHEP(2,IFER)=IANT + JDAHEP(2,IANT)=IFER +C---IDENTITY CODES + IDHW(ICMF)=200 + IDHW(IHIG)=201 + IDHW(IZED)=200 + IDHEP(ICMF)=IDPDG(IDHW(ICMF)) + IDHEP(IHIG)=IDPDG(IDHW(IHIG)) + IDHEP(IZED)=IDPDG(IDHW(IZED)) + IDHEP(IFER)=IDPDG(IDHW(IFER)) + IDHEP(IANT)=IDPDG(IDHW(IANT)) + ENDIF + 999 END +CDECK ID>, HWHPH2. +*CMZ :- -12/01/93 10.12.43 by Bryan Webber +*-- Author : Ian Knowles +C----------------------------------------------------------------------- + SUBROUTINE HWHPH2 +C----------------------------------------------------------------------- +C QQD direct photon pair production: mean EVWGT = sigma in nb +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + DOUBLE PRECISION HWR,HWRUNI,HWUALF,HWHPPB,EPS,RCS,ET,EJ,KK,KK2, + & YJ1INF,YJ1SUP,Z1,YJ2INF,YJ2SUP,Z2,FACT,FACTR,RS,S,T,U,CSTU,TQSQ, + & DSTU,HCS + INTEGER ID,ID1,ID2 + EXTERNAL HWR,HWRUNI,HWUALF,HWHPPB + SAVE HCS,CSTU,DSTU,FACT + 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 + RS=0.5*SQRT(S) + T=-0.5*S*(1.-COSTH) + U=-S-T + EMSCA=SQRT(2.*S*T*U/(S*S+T*T+U*U)) + FACT=GEV2NB*PIFAC*0.5*ET*EJ*(YJ1SUP-YJ1INF)*(YJ2SUP-YJ2INF) + & *(ALPHEM/S)**2 + CALL HWSGEN(.FALSE.) + CSTU=2.*(U/T+T/U)/CAFAC + IF (DISF(13,1).GT.EPS.AND.DISF(13,2).GT.EPS) THEN + TQSQ=0. + DO 10 ID=1,6 + 10 IF (RMASS(ID).LT.RS) TQSQ=TQSQ+QFCH(ID)**2 + DSTU=DISF(13,1)*DISF(13,2)*FACT*HWHPPB(S,T,U) + & /64.*(HWUALF(1,EMSCA)*TQSQ/PIFAC)**2 + ENDIF + ENDIF + HCS=0. + DO 30 ID=1,6 + FACTR=FACT*CSTU*QFCH(ID)**4 +C q+qbar ---> gamma+gamma + ID1=ID + ID2=ID+6 + IF (DISF(ID1,1).LT.EPS.OR.DISF(ID2,2).LT.EPS) GOTO 20 + HCS=HCS+FACTR*DISF(ID1,1)*DISF(ID2,2) + IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(59,59,2134,61,*99) +C qbar+q ---> gamma+gamma + 20 ID1=ID+6 + ID2=ID + IF (DISF(ID1,1).LT.EPS.OR.DISF(ID2,2).LT.EPS) GOTO 30 + HCS=HCS+FACTR*DISF(ID1,1)*DISF(ID2,2) + IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(59,59,2134,62,*99) + 30 CONTINUE +C g+g ---> gamma+gamma + ID1=13 + ID2=13 + HCS=HCS+DSTU + IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(59,59,2134,63,*99) + EVWGT=HCS + RETURN +C Generate event + 99 IDN(1)=ID1 + IDN(2)=ID2 + IDCMF=15 + CALL HWETWO + 999 END +CDECK ID>, HWHPHO. +*CMZ :- -26/04/91 14.55.45 by Federico Carminati +*-- Author : Bryan Webber +C----------------------------------------------------------------------- + SUBROUTINE HWHPHO +C----------------------------------------------------------------------- +C QCD DIRECT PHOTON + JET PRODUCTION: MEAN EVWGT = SIGMA IN NB +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + DOUBLE PRECISION HWR,HWRUNI,HWUALF,HWHPPB,EPS,RCS,ET,EJ,KK,KK2, + & YJ1INF,YJ1SUP,Z1,YJ2INF,YJ2SUP,Z2,FACT,FACTR,FACTF,RS,S,T,U,CF, + & AF,CSTU,CTSU,CUST,DSTU,HCS,TQCH + INTEGER ID,ID1,ID2 + EXTERNAL HWR,HWRUNI,HWUALF,HWHPPB + SAVE HCS + 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 + RS=0.5*SQRT(S) + 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*PIFAC*0.5*ET*EJ*ALPHEM + & *HWUALF(1,EMSCA)*(YJ1SUP-YJ1INF)*(YJ2SUP-YJ2INF)/S**2 + CALL HWSGEN(.FALSE.) +C + CF=2.*CFFAC/CAFAC + AF=-1./CAFAC + CSTU=CF*(U/T+T/U) + CTSU=AF*(U/S+S/U) + CUST=AF*(T/S+S/T) + IF (DISF(13,1).GT.EPS.AND.DISF(13,2).GT.EPS) THEN + TQCH=0. + DO 10 ID=1,6 + 10 IF (RMASS(ID).LT.RS) TQCH=TQCH+QFCH(ID) + DSTU=DISF(13,1)*DISF(13,2)*FACT*HWHPPB(S,T,U) + & *5./768.*(HWUALF(1,EMSCA)*TQCH/PIFAC)**2 + ENDIF + ENDIF +C + HCS=0. + DO 30 ID=1,6 + FACTR=FACT*QFCH(ID)**2 +C---QUARK FIRST + ID1=ID + IF (DISF(ID1,1).LT.EPS) GOTO 20 + ID2=ID1+6 + HCS=HCS+CSTU*FACTR*DISF(ID1,1)*DISF(ID2,2) + IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP( 13, 59,2314,41,*9) + ID2=13 + HCS=HCS+CTSU*FACTR*DISF(ID1,1)*DISF(ID2,2) + IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1, 59,3124,42,*9) +C---QBAR FIRST + 20 ID1=ID+6 + IF (DISF(ID1,1).LT.EPS) GOTO 30 + ID2=ID + HCS=HCS+CSTU*FACTR*DISF(ID1,1)*DISF(ID2,2) + IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP( 13, 59,3124,43,*9) + ID2=13 + HCS=HCS+CTSU*FACTR*DISF(ID1,1)*DISF(ID2,2) + IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1, 59,2314,44,*9) + 30 CONTINUE +C---GLUON FIRST + ID1=13 + FACTF=FACT*CUST*DISF(ID1,1) + DO 50 ID=1,6 + FACTR=FACTF*QFCH(ID)**2 + ID2=ID + IF (DISF(ID2,2).LT.EPS) GOTO 40 + HCS=HCS+FACTR*DISF(ID2,2) + IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID2, 59,2314,45,*9) + 40 ID2=ID+6 + IF (DISF(ID2,2).LT.EPS) GOTO 50 + HCS=HCS+FACTR*DISF(ID2,2) + IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID2, 59,3124,46,*9) + 50 CONTINUE +C g+g ---> g+gamma + ID2=13 + HCS=HCS+DSTU + IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP( 13, 59,2314,47,*9) + EVWGT=HCS + RETURN +C---GENERATE EVENT + 9 IDN(1)=ID1 + IDN(2)=ID2 + IDCMF=15 + CALL HWETWO + 999 END +CDECK ID>, HWHPPB. +*CMZ :- -12/01/93 10.12.43 by Bryan Webber +*-- Author : Ian Knowles +C----------------------------------------------------------------------- + FUNCTION HWHPPB(S,T,U) +C----------------------------------------------------------------------- +C Quark box diagram contribution to photon/gluon scattering +C Internal quark mass neglected: m_q << U,T,S +C----------------------------------------------------------------------- + IMPLICIT NONE + DOUBLE PRECISION HWHPPB,S,T,U,S2,T2,U2,PI2,ALNTU,ALNST,ALNSU + PI2=ACOS(-1.D0)**2 + S2=S**2 + T2=T**2 + U2=U**2 + ALNTU=LOG(T/U) + ALNST=LOG(-S/T) + ALNSU=ALNST+ALNTU + HWHPPB=5.*4. + & +((2.*S2+2.*(U2-T2)*ALNTU+(T2+U2)*(ALNTU**2+PI2))/S2)**2 + & +((2.*U2+2.*(T2-S2)*ALNST+(T2+S2)* ALNST**2 )/U2)**2 + & +((2.*T2+2.*(U2-S2)*ALNSU+(U2+S2)* ALNSU**2 )/T2)**2 + & +4.*PI2*(((T2-S2+(T2+S2)*ALNST)/U2)**2 + & +((U2-S2+(U2+S2)*ALNSU)/T2)**2) + END +CDECK ID>, HWHPPE. +*CMZ :- -12/01/93 10.12.43 by Bryan Webber +*-- Author : Ian Knowles +C----------------------------------------------------------------------- + SUBROUTINE HWHPPE +C----------------------------------------------------------------------- +C point-like photon/QCD heavy flavour single excitation, using exact +C massive lightcone kinematics, mean EVWGT = sigma in nb. +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + DOUBLE PRECISION HWR,HWRUNI,HWUALF,EPS,PP1,PP2,QM2,FACTR, + & PT,PJ,PT2,PTM,EXY,T,CC,EXY2,S,U,C,SIGE,HCS,RCS + INTEGER IQ1,IQ2,ID1,ID2,IHAD1,IHAD2 + EXTERNAL HWR,HWRUNI,HWUALF + SAVE PP1,PP2,IQ1,IQ2,QM2,FACTR,SIGE,HCS + PARAMETER (EPS=1.E-9) + IHAD1=1 + IF (JDAHEP(1,IHAD1).NE.0) IHAD1=JDAHEP(1,IHAD1) + IHAD2=2 + IF (JDAHEP(1,IHAD2).NE.0) IHAD2=JDAHEP(1,IHAD2) + IF (FSTWGT.OR.IHAD1.NE.1.OR.IHAD2.NE.2) THEN + PP1=PHEP(4,IHAD1)+ABS(PHEP(3,IHAD1)) + PP2=PHEP(4,IHAD2)+ABS(PHEP(3,IHAD2)) + XX(1)=1. + IQ1=MOD(IPROC,100) + IQ2=IQ1+6 + QM2=RMASS(IQ1)**2 + FACTR=GEV2NB*(YJMAX-YJMIN)*4.*PIFAC*CFFAC*PP1 + & *ALPHEM*QFCH(IQ1)**2 + ENDIF + IF (GENEV) THEN + RCS=HCS*HWR() + ELSE + EVWGT=0. + CALL HWRPOW(PT,PJ) + PT2=PT**2 + PTM=SQRT(PT2+QM2) + EXY=EXP(HWRUNI(1,YJMIN,YJMAX)) + T=-PP1*PT/EXY + CC=T**2-4.*QM2*(PT2+T) + IF (CC.LT.ZERO) RETURN + EXY2=(2.*PT2+T-SQRT(CC))*PP1/(2.*T*PTM) + IF (EXY2.LT.EXP(YJMIN).OR.EXY2.GT.EXP(YJMAX)) RETURN + XX(2)=(PT/EXY+PTM/EXY2)/PP2 + IF (XX(2).GT.ONE) RETURN +C define: S=Shat-M**2, T=That ,U=Uhat-M**2 (2p.Q, -2p.g, -2p.Q') + S=XX(2)*PP1*PP2 + U=-S-T + COSTH=(1.+QM2/S)*(T-U)/S-QM2/S +C Set hard process scale (Approx ET-jet) + EMSCA=SQRT(2.*S*T*U/(S*S+T*T+U*U)) + C=QM2*T/(U*S) + SIGE=-FACTR*PT*PJ*HWUALF(1,EMSCA)*(S/U+U/S+4.*C*(1.-C)) + & /(S**2*EXY2*PTM*(1-QM2/(XX(2)*PP2*EXY2)**2)) + CALL HWSFUN(XX(2),EMSCA,IDHW(IHAD2),NSTRU,DISF(1,2),2) + ENDIF + HCS=0. + ID1=59 +C photon+Q ---> g+Q + ID2=IQ1 + IF (DISF(ID2,2).LT.EPS) GOTO 10 + HCS=HCS+SIGE*DISF(ID2,2) + IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(13,ID2,1423,51,*99) +C photon+Qbar ---> g+Qbar + 10 ID2=IQ2 + IF (DISF(ID2,2).LT.EPS) GOTO 20 + HCS=HCS+SIGE*DISF(ID2,2) + IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(13,ID2,1342,52,*99) + 20 EVWGT=HCS + RETURN +C Generate event + 99 IDN(1)=ID1 + IDN(2)=ID2 + IDCMF=15 + CALL HWETWO + 999 END +CDECK ID>, HWHPPH. +*CMZ :- -12/01/93 10.12.43 by Bryan Webber +*-- Author : Ian Knowles +C----------------------------------------------------------------------- + SUBROUTINE HWHPPH +C----------------------------------------------------------------------- +C Point-like photon/gluon heavy flavour pair production, with +C exact lightcone massive kinematics, mean EVWGT = sigma in nb. +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + DOUBLE PRECISION HWRUNI,HWUALF,EPS,PP1,PP2,QM2,FACTR,ET,EJ,ET2, + & EXY,EXY2,S,T,U,C + INTEGER IQ1,IHAD1,IHAD2 + EXTERNAL HWRUNI,HWUALF + SAVE PP1,PP2,IQ1,QM2,FACTR + PARAMETER (EPS=1.E-9) + IHAD1=1 + IF (JDAHEP(1,IHAD1).NE.0) IHAD1=JDAHEP(1,IHAD1) + IHAD2=2 + IF (JDAHEP(1,IHAD2).NE.0) IHAD2=JDAHEP(1,IHAD2) + IF (FSTWGT.OR.IHAD1.NE.1.OR.IHAD2.NE.2) THEN + PP1=PHEP(4,IHAD1)+ABS(PHEP(3,IHAD1)) + PP2=PHEP(4,IHAD2)+ABS(PHEP(3,IHAD2)) + XX(1)=1. + IQ1=MOD(IPROC,100) + QM2=RMASS(IQ1)**2 + IHPRO=53 + FACTR=-GEV2NB*(YJMAX-YJMIN)*.5*PIFAC*ALPHEM*QFCH(IQ1)**2 + ENDIF + IF (GENEV) THEN +C Generate event + IDN(1)=59 + IDN(2)=13 + IDN(3)=IQ1 + IDN(4)=IQ1+6 + ICO(1)=1 + ICO(2)=4 + ICO(3)=2 + ICO(4)=3 + IDCMF=15 + CALL HWETWO + ELSE +C Select kinematics + EVWGT=0. + CALL HWRPOW(ET,EJ) + ET2=ET**2 + EXY=EXP(HWRUNI(1,YJMIN,YJMAX)) + EXY2=2.*PP1/ET-EXY + IF (EXY2.LT.EXP(YJMIN).OR.EXY2.GT.EXP(YJMAX)) RETURN + XX(2)=.5*ET*(1./EXY+1./EXY2)/PP2 + IF (XX(2).LT.ZERO.OR.XX(2).GT.ONE) RETURN + S=XX(2)*PP1*PP2 + IF (S.LT.ET2) RETURN +C define: S=Shat, T=That-M**2, U=Uhat-M**2 (2p.g, -2p.Q, -2p.QBar) + T=-.5*PP1*ET/EXY + U=-S-T + COSTH=(T-U)/(S*SQRT(1.-4.*QM2/S)) + EMSCA=SQRT(2.*S*T*U/(S*S+T*T+U*U)) + CALL HWSFUN(XX(2),EMSCA,IDHW(IHAD2),NSTRU,DISF(1,2),2) +C photon+g ---> Q+Qbar + IF (DISF(13,2).LT.EPS) THEN + EVWGT=0. + ELSE + C=QM2*S/(U*T) + EVWGT=FACTR*EJ*ET*HWUALF(1,EMSCA) + & *DISF(13,2)*(T/U+U/T+4.*C*(1.-C))/(S*T) + ENDIF + ENDIF + 999 END +CDECK ID>, HWHPPM. +*CMZ :- -09/12/93 15.50.26 by Mike Seymour +*-- Author : Ian Knowles & Mike Seymour +C----------------------------------------------------------------------- + SUBROUTINE HWHPPM +C----------------------------------------------------------------------- +C Point-like photon/QCD direct meson production +C See M. Benayoun, et al., Nucl. Phys. B282 (1987) 653 for details. +C mean EVWGT = sigma in nb +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + DOUBLE PRECISION HWR,HWRUNI,HWUALF,EPS,PP1,PP2,ET,EJ,EXY,EXY2, + & FACT,FACTR,S,T,U,REDS,DELT(3,3),C1STU,C3STU,HCS,RCS,CMIX,SMIX, + & C1WVFN,FPI,FETA8,FETA1,FRHO,FPHI8,FPHI1,FPI2,FETA2(3),FETAP2(3), + 7 FRHO2,FPHI2(3),FOMEG2(3) + INTEGER MNAME(3,3,2),N4(3),I,J,ID2,ID4,I2,I4,M1,M2,IHAD1,IHAD2 + LOGICAL SPIN0,SPIN1 + EXTERNAL HWR,HWRUNI,HWUALF + SAVE FPI2,FETA2,FETAP2,FRHO2,FPHI2,FOMEG2,HCS,REDS,FACT,DELT, + & C1STU,C3STU + PARAMETER (EPS=1.D-20) + DATA MNAME/21,38,42,30,21,34,50,46,0,23,39,43,31,23,35,51,47,0/ + DATA N4,SPIN0,SPIN1/3,3,2,.TRUE.,.TRUE./ + DATA C1WVFN,FPI,FETA8,FETA1,FRHO,FPHI8,FPHI1/1.,3*0.093,3*0.107/ + IF (FSTWGT) THEN + FPI2=FPI**2 + CMIX=COS(ETAMIX*PIFAC/180.D0) + SMIX=SIN(ETAMIX*PIFAC/180.D0) + FETA2(1) =(+CMIX*FETA8/SQRT(TWO)-SMIX*FETA1)**2/THREE + FETA2(2) =FETA2(1) + FETA2(3) =(-CMIX*FETA8*SQRT(TWO)-SMIX*FETA1)**2/THREE + FETAP2(1)=(+SMIX*FETA8/SQRT(TWO)+CMIX*FETA1)**2/THREE + FETAP2(2)=FETAP2(1) + FETAP2(3)=(-SMIX*FETA8*SQRT(TWO)+CMIX*FETA1)**2/THREE + FRHO2=FRHO**2 + CMIX=COS(PHIMIX*PIFAC/180.D0) + SMIX=SIN(PHIMIX*PIFAC/180.D0) + FPHI2(1) =(+CMIX*FPHI8/SQRT(TWO)-SMIX*FPHI1)**2/THREE + FPHI2(2) =FPHI2(1) + FPHI2(3) =(-CMIX*FPHI8*SQRT(TWO)-SMIX*FPHI1)**2/THREE + FOMEG2(1)=(+SMIX*FPHI8/SQRT(TWO)+CMIX*FPHI1)**2/THREE + FOMEG2(2)=FOMEG2(1) + FOMEG2(3)=(-SMIX*FPHI8*SQRT(TWO)+CMIX*FPHI1)**2/THREE + ENDIF + SPIN0=.NOT.(MOD(IPROC/10,10).EQ.2) + SPIN1=.NOT.(MOD(IPROC/10,10).EQ.1) + IF (GENEV) THEN + RCS=HCS*HWR() + ELSE + EVWGT=ZERO + IHAD1=1 + IF (JDAHEP(1,IHAD1).NE.0) IHAD1=JDAHEP(1,IHAD1) + IHAD2=2 + IF (JDAHEP(1,IHAD2).NE.0) IHAD2=JDAHEP(1,IHAD2) + PP1=PHEP(4,IHAD1)+ABS(PHEP(3,IHAD1)) + PP2=PHEP(4,IHAD2)+ABS(PHEP(3,IHAD2)) + XX(1)=ONE + CALL HWRPOW(ET,EJ) + EXY=EXP(HWRUNI(1,YJMIN,YJMAX)) + EXY2=TWO*PP1/ET-EXY + IF (EXY2.LE.EXP(YJMIN).OR.EXY2.GE.EXP(YJMAX)) RETURN + XX(2)=PP1/(PP2*EXY*EXY2) + IF (XX(2).LE.ZERO.OR.XX(2).GE.ONE) RETURN + S=XX(2)*PP1*PP2 + REDS=SQRT(S-ET*SQRT(S)) + T=-HALF*PP1*ET/EXY + U=-S-T + COSTH=(T-U)/S +C Set EMSCA to hard process scale (Approx ET-jet) + EMSCA=SQRT(TWO*S*T*U/(S*S+T*T+U*U)) + FACT=-GEV2NB*ET*EJ*(YJMAX-YJMIN)*ALPHEM*CFFAC + & *(HWUALF(1,EMSCA)*PIFAC*C1WVFN)**2*32.D0/(THREE*S*T) + CALL HWSFUN(XX(2),EMSCA,IDHW(IHAD2),NSTRU,DISF(1,2),2) + DO 10 I=1,3 + DO 10 J=1,3 + 10 DELT(I,J)=(QFCH(I)*U+QFCH(J)*S)**2 + C1STU=-(S**2+U**2)/(T*S**2*U**2) + C3STU=-8.D0*T/(S**2*U**2) + ENDIF + HCS=ZERO + DO 50 I2=1,3 +C Quark initiated processes + ID2=I2 + IF (DISF(ID2,2).LT.EPS) GOTO 30 + DO 20 ID4=1,N4(I2) + M1=MNAME(ID2,ID4,1) + FACTR=FACT*DELT(ID2,ID4)*DISF(ID2,2) + IF (ID2.EQ.ID4) FACTR=HALF*FACTR + IF (SPIN0.AND.REDS.GT.RMASS(M1)) THEN +C photon+q --> meson_0+q' + HCS=HCS+HALF*FACTR*C1STU*FPI2 + IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(M1,ID4,1432,71,*99) + ENDIF + M2=MNAME(ID2,ID4,2) + IF (SPIN1.AND.REDS.GT.RMASS(M2)) THEN +C photon+q --> meson_L+q' + HCS=HCS+FACTR*C1STU*FRHO2 + IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(M2,ID4,1432,72,*99) +C photon+q --> meson_T+q' + HCS=HCS+FACTR*C3STU*FRHO2 + IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(M2,ID4,1432,73,*99) + ENDIF + 20 CONTINUE + FACTR=FACT*DELT(I2,I2)*DISF(ID2,2) + IF (SPIN0.AND.REDS.GT.RMASS(22)) THEN +C photon+q -->eta+q + HCS=HCS+HALF*FACTR*C1STU*FETA2(I2) + IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(22,ID2,1432,71,*99) + ENDIF + IF (SPIN0.AND.REDS.GT.RMASS(25)) THEN +C photon+q -->eta'+q + HCS=HCS+HALF*FACTR*C1STU*FETAP2(I2) + IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(25,ID2,1432,71,*99) + ENDIF + IF (SPIN1.AND.REDS.GT.RMASS(56)) THEN +C photon+q -->phi_L+q + HCS=HCS+FACTR*C1STU*FPHI2(I2) + IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(56,ID2,1432,72,*99) +C photon+q -->phi_T+q + HCS=HCS+FACTR*C3STU*FPHI2(I2) + IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(56,ID2,1432,73,*99) + ENDIF + IF (SPIN1.AND.REDS.GT.RMASS(24)) THEN +C photon+q -->omega_L+q + HCS=HCS+FACTR*C1STU*FOMEG2(I2) + IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(24,ID2,1432,72,*99) +C photon+q -->omega_T+q + HCS=HCS+FACTR*C3STU*FOMEG2(I2) + IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(24,ID2,1432,73,*99) + ENDIF +C Anti-quark initiated processes + 30 ID2=I2+6 + IF (DISF(ID2,2).LT.EPS) GOTO 50 + DO 40 I4=1,N4(I2) + ID4=I4+6 + FACTR=FACT*DELT(I2,I4)*DISF(ID2,2) + IF (ID2.EQ.ID4) FACTR=HALF*FACTR + M1=MNAME(I4,I2,1) + IF (SPIN0.AND.REDS.GT.RMASS(M1)) THEN +C photon+qbar --> meson_0+qbar' + HCS=HCS+HALF*FACTR*C1STU*FPI2 + IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(M1,ID4,1432,74,*99) + ENDIF + M2=MNAME(I4,I2,2) + IF (SPIN1.AND.REDS.GT.RMASS(M2)) THEN +C photon+qbar --> meson_L+qbar' + HCS=HCS+FACTR*C1STU*FRHO2 + IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(M2,ID4,1432,75,*99) +C photon+qbar --> meson_T+qbar' + HCS=HCS+FACTR*C3STU*FRHO2 + IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(M2,ID4,1432,76,*99) + ENDIF + 40 CONTINUE + FACTR=FACT*DELT(I2,I2)*DISF(ID2,2) + IF (SPIN0.AND.REDS.GT.RMASS(22)) THEN +C photon+qbar -->eta+qbar + HCS=HCS+HALF*FACTR*C1STU*FETA2(I2) + IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(22,ID2,1432,74,*99) + ENDIF + IF (SPIN0.AND.REDS.GT.RMASS(25)) THEN +C photon+qbar -->eta'+qbar + HCS=HCS+HALF*FACTR*C1STU*FETAP2(I2) + IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(25,ID2,1432,74,*99) + ENDIF + IF (SPIN1.AND.REDS.GT.RMASS(56)) THEN +C photon+qbar -->phi_L+qbar + HCS=HCS+FACTR*C1STU*FPHI2(I2) + IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(56,ID2,1432,75,*99) +C photon+qbar -->phi_T+qbar + HCS=HCS+FACTR*C3STU*FPHI2(I2) + IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(56,ID2,1432,76,*99) + ENDIF + IF (SPIN1.AND.REDS.GT.RMASS(24)) THEN +C photon+qbar -->omega_L+qbar + HCS=HCS+FACTR*C1STU*FOMEG2(I2) + IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(24,ID2,1432,75,*99) +C photon+qbar -->omega_T+qbar + HCS=HCS+FACTR*C3STU*FOMEG2(I2) + IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(24,ID2,1432,76,*99) + ENDIF + 50 CONTINUE + EVWGT=HCS + RETURN +C Generate event + 99 IDN(1)=59 + IDN(2)=ID2 + IDCMF=15 + CALL HWETWO +C Set polarization vector + IF (IHPRO.EQ.72.OR.IHPRO.EQ.75) THEN + RHOHEP(2,NHEP-1)=ONE + ELSEIF (IHPRO.EQ.73.OR.IHPRO.EQ.76) THEN + RHOHEP(1,NHEP-1)=HALF + RHOHEP(3,NHEP-1)=HALF + ENDIF + 999 END +CDECK ID>, HWHPPT. +*CMZ :- -12/01/93 10.12.43 by Bryan Webber +*-- Author : Ian Knowles +C----------------------------------------------------------------------- + SUBROUTINE HWHPPT +C----------------------------------------------------------------------- +C point-like photon/QCD di-jet production: mean EVWGT = sigma in nb +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + DOUBLE PRECISION HWR,HWRUNI,HWUALF,EPS,RCS,PP1,PP2,ET,EJ, + & EXY,EXY2,FACTR,RS,S,T,U,CSTU,CTSU,HCS + INTEGER ID1,ID2,ID3,ID4,IHAD1,IHAD2 + EXTERNAL HWR,HWRUNI,HWUALF + SAVE CSTU,CTSU,HCS,FACTR,RS + PARAMETER (EPS=1.E-9) + IHAD1=1 + IF (JDAHEP(1,IHAD1).NE.0) IHAD1=JDAHEP(1,IHAD1) + IHAD2=2 + IF (JDAHEP(1,IHAD2).NE.0) IHAD2=JDAHEP(1,IHAD2) + IF (GENEV) THEN + RCS=HCS*HWR() + ELSE + EVWGT=0. + PP1=PHEP(4,IHAD1)+ABS(PHEP(3,IHAD1)) + PP2=PHEP(4,IHAD2)+ABS(PHEP(3,IHAD2)) + XX(1)=1. + CALL HWRPOW(ET,EJ) + EXY=EXP(HWRUNI(1,YJMIN,YJMAX)) + EXY2=2.*PP1/ET-EXY + IF (EXY2.LE.EXP(YJMIN).OR.EXY2.GE.EXP(YJMAX)) RETURN + XX(2)=PP1/(PP2*EXY*EXY2) + IF (XX(2).LE.ZERO.OR.XX(2).GE.ONE) RETURN + S=XX(2)*PP1*PP2 + RS=.5*SQRT(S) + T=-PP1*0.5*ET/EXY + U=-S-T + COSTH=(T-U)/S +C Set EMSCA to hard process scale (Approx ET-jet) + EMSCA=SQRT(2.*S*T*U/(S*S+T*T+U*U)) + FACTR=-GEV2NB*0.5*EJ*(YJMAX-YJMIN)*ET*PIFAC*ALPHEM + & *HWUALF(1,EMSCA)/(S*T) + CALL HWSFUN(XX(2),EMSCA,IDHW(IHAD2),NSTRU,DISF(1,2),2) + CSTU=U/T+T/U + CTSU=-2.*CFFAC*(U/S+S/U) + ENDIF + HCS=0. + ID1=59 + DO 20 ID2=1,13 + IF (DISF(ID2,2).LT.EPS) GOTO 20 + IF (ID2.LT.7) THEN +C photon+q ---> g+q + HCS=HCS+CTSU*DISF(ID2,2)*QFCH(ID2)**2 + IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP( 13,ID2,1423,51,*99) + ELSEIF (ID2.LT.13) THEN +C photon+qbar ---> g+qbar + HCS=HCS+CTSU*DISF(ID2,2)*QFCH(ID2-6)**2 + IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP( 13,ID2,1342,52,*99) + ELSE +C photon+g ---> q+qbar + DO 10 ID3=1,6 + IF (RS.GT.RMASS(ID3)) THEN + ID4=ID3+6 + HCS=HCS+CSTU*DISF(ID2,2)*QFCH(ID3)**2 + IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID3,ID4,1423,53,*99) + ENDIF + 10 CONTINUE + ENDIF + 20 CONTINUE + EVWGT=FACTR*HCS + RETURN +C Generate event + 99 IDN(1)=ID1 + IDN(2)=ID2 + IDCMF=15 + CALL HWETWO + 999 END +CDECK ID>, HWHPQS. +*CMZ :- -27/03/95 13.27.22 by Mike Seymour +*-- Author : Ian Knowles +C----------------------------------------------------------------------- + SUBROUTINE HWHPQS +C----------------------------------------------------------------------- +C Compton scattering of point-like photon and (anti)quark +C mean EVWGT = sigma in nb +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + DOUBLE PRECISION HWR,HWRUNI,EPS,RCS,PP1,PP2,ET,EJ,EXY,EXY2, + & FACTR,S,T,U,CTSU,HCS + INTEGER ID1,ID2,IHAD1,IHAD2 + EXTERNAL HWR,HWRUNI + SAVE CTSU,HCS,FACTR + PARAMETER (EPS=1.E-9) + IHAD1=1 + IF (JDAHEP(1,IHAD1).NE.0) IHAD1=JDAHEP(1,IHAD1) + IHAD2=2 + IF (JDAHEP(1,IHAD2).NE.0) IHAD2=JDAHEP(1,IHAD2) + IF (GENEV) THEN + RCS=HCS*HWR() + ELSE + EVWGT=0. + PP1=PHEP(4,IHAD1)+ABS(PHEP(3,IHAD1)) + PP2=PHEP(4,IHAD2)+ABS(PHEP(3,IHAD2)) + XX(1)=1. + CALL HWRPOW(ET,EJ) + EXY=EXP(HWRUNI(1,YJMIN,YJMAX)) + EXY2=2.*PP1/ET-EXY + IF (EXY2.LE.EXP(YJMIN).OR.EXY2.GE.EXP(YJMAX)) RETURN + XX(2)=PP1/(PP2*EXY*EXY2) + IF (XX(2).LE.ZERO.OR.XX(2).GE.ONE) RETURN + S=XX(2)*PP1*PP2 + T=-PP1*0.5*ET/EXY + U=-S-T + COSTH=(T-U)/S +C Set EMSCA to hard process scale (Approx ET-jet) + EMSCA=SQRT(2.*S*T*U/(S*S+T*T+U*U)) + FACTR=-GEV2NB*0.5*EJ*(YJMAX-YJMIN)*ET*PIFAC*ALPHEM**2/(S*T) + CALL HWSFUN(XX(2),EMSCA,IDHW(IHAD2),NSTRU,DISF(1,2),2) + CTSU=-2.*(U/S+S/U) + ENDIF + HCS=0. + ID1=59 + DO 20 ID2=1,12 + IF (DISF(ID2,2).LT.EPS) GOTO 20 + IF (ID2.LT.7) THEN +C photon+q ---> photon+q + HCS=HCS+CTSU*DISF(ID2,2)*QFCH(ID2)**4 + IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP( 59,ID2,1432,66,*99) + ELSE +C photon+qbar ---> photon+qbar + HCS=HCS+CTSU*DISF(ID2,2)*QFCH(ID2-6)**4 + IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP( 59,ID2,1432,67,*99) + ENDIF + 20 CONTINUE + EVWGT=FACTR*HCS + RETURN +C Generate event + 99 IDN(1)=ID1 + IDN(2)=ID2 + IDCMF=15 + CALL HWETWO + 999 END +CDECK ID>, HWHQCD. +*CMZ :- -20/05/99 12.39.45 by Kosuke Odagiri +*-- Author : Bryan Webber +C----------------------------------------------------------------------- + SUBROUTINE HWHQCD +C----------------------------------------------------------------------- +C QCD HARD 2->2 PROCESSES: MEAN EVWGT = SIGMA IN NB +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + DOUBLE PRECISION HWR,HWRUNI,HWUALF,RS,EPS,HF,RCS,Z1,Z2,ET,EJ, + & FACTR,S,T,U,ST,TU,US,STU,TUS,UST,EN,RN,GFLA,AF,ASTU,ASUT,AUST, + & BF,BSTU,BSUT,BUST,BUTS,CF,CSTU,CSUT,CTSU,CTUS,DF,DSTU,DTSU,DUTS, + & DIST,HCS,UT,SU,GT,KK,KK2,YJ1INF,YJ1SUP,YJ2INF,YJ2SUP + INTEGER ID1,ID2,I + EXTERNAL HWR,HWRUNI,HWUALF + SAVE HCS,ASTU,AUST,BSTU,BSUT,BUST,BUTS,CSTU,CSUT,CTSU,CTUS, + & DSTU,DTSU,DUTS,GFLA,RCS,S,T,TU,U,US + PARAMETER (EPS=1.E-9,HF=0.5) + 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((ONE-SQRT(ONE-KK2))/KK) ) + YJ1SUP = MIN( YJMAX, LOG((ONE+SQRT(ONE-KK2))/KK) ) + IF (YJ1INF.GE.YJ1SUP) RETURN + Z1=EXP(HWRUNI(1,YJ1INF,YJ1SUP)) + YJ2INF = MAX( YJMIN, -LOG(TWO/KK-ONE/Z1) ) + YJ2SUP = MIN( YJMAX, LOG(TWO/KK-Z1) ) + IF (YJ2INF.GE.YJ2SUP) RETURN + Z2=EXP(HWRUNI(2,YJ2INF,YJ2SUP)) + XX(1)=.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 + RS=HF*SQRT(S) + DO 3 I=1,NFLAV + IF (RS.LT.RMASS(I)) GOTO 4 + 3 CONTINUE + I=NFLAV+1 + 4 MAXFL=I-1 + IF (MAXFL.EQ.0) CALL HWWARN('HWHQCD',100,*999) +C + T=-HF*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)) + FACTR = GEV2NB*.5*PIFAC*EJ*ET*(HWUALF(1,EMSCA)/S)**2 + & * (YJ1SUP-YJ1INF)*(YJ2SUP-YJ2INF) + CALL HWSGEN(.FALSE.) +C + ST=S/T + TU=T/U + US=U/S + STU=TU/US + TUS=US/ST + UST=ST/TU +C + EN=CAFAC + RN=CFFAC/EN + GFLA=HF*FLOAT(MAXFL)/(EN*RN)**2 + AF=FACTR*RN + ASTU=AF*(1.-2.*UST) + ASUT=AF*(1.-2.*STU) + AUST=AF*(1.-2.*TUS) +C----------------------------------------------------------------------- +C---Colour decomposition modifications below (KO) +C----------------------------------------------------------------------- + BF=HF-AF/EN/TUS/(ASTU+ASUT) + BSTU=BF*ASTU + BSUT=BF*ASUT + BF=ONE-TWO*AF/EN/STU/(AUST+ASTU) + BUST=BF*AUST + BUTS=BF*ASTU +C----------------------------------------------------------------------- +C BF=2.*AF/EN +C BSTU=HF*(ASTU+BF*ST) +C BSUT=HF*(ASUT+BF/US) +C BUST=AUST+BF*US +C BUTS=ASTU+BF/TU +C----------------------------------------------------------------------- + CF=AF*EN + CSTU=(CF*(RN-TUS))/TU + CSUT=(CF*(RN-TUS))*TU + CTSU=(FACTR*(UST-RN))*US + CTUS=(FACTR*(UST-RN))/US + DF=HF*FACTR/RN + DSTU=DF*(1.+1./TUS-STU-UST) + DTSU=DF*(1.+1./UST-STU-TUS) + DUTS=DF*(1.+1./STU-UST-TUS) + ENDIF +C + HCS=0. + DO 6 ID1=1,13 + IF (DISF(ID1,1).LT.EPS) GOTO 6 + DO 5 ID2=1,13 + IF (DISF(ID2,2).LT.EPS) GOTO 5 + DIST=DISF(ID1,1)*DISF(ID2,2) + IF (ID1.LT.7) THEN +C---QUARK FIRST + IF (ID2.LT.7) THEN + IF (ID1.NE.ID2) THEN + HCS=HCS+ASTU*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,ID2,3421, 3,*9) + ELSE + HCS=HCS+BSTU*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,ID2,3421, 1,*9) + HCS=HCS+BSUT*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,ID2,4312, 2,*9) + ENDIF + ELSEIF (ID2.NE.13) THEN + IF (ID2.NE.ID1+6) THEN + HCS=HCS+ASTU*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,ID2,3142, 9,*9) + ELSE + HCS=HCS+FLOAT(MAXFL-1)*AUST*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(-ID1, 0,2413, 4,*9) + HCS=HCS+BUTS*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,ID2,3142, 5,*9) + HCS=HCS+BUST*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,ID2,2413, 6,*9) + HCS=HCS+CSTU*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP( 13, 13,2413, 7,*9) + HCS=HCS+CSUT*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP( 13, 13,2341, 8,*9) + ENDIF + ELSE + HCS=HCS+CTSU*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,ID2,3142,10,*9) + HCS=HCS+CTUS*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,ID2,3421,11,*9) + ENDIF + ELSEIF (ID1.NE.13) THEN +C---QBAR FIRST + IF (ID2.LT.7) THEN + IF (ID1.NE.ID2+6) THEN + HCS=HCS+ASTU*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,ID2,2413,17,*9) + ELSE + HCS=HCS+FLOAT(MAXFL-1)*AUST*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(-ID1, 0,3142,12,*9) + HCS=HCS+BUTS*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,ID2,2413,13,*9) + HCS=HCS+BUST*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,ID2,3142,14,*9) + HCS=HCS+CSTU*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP( 13, 13,3142,15,*9) + HCS=HCS+CSUT*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP( 13, 13,4123,16,*9) + ENDIF + ELSEIF (ID2.NE.13) THEN + IF (ID1.NE.ID2) THEN + HCS=HCS+ASTU*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,ID2,4312,20,*9) + ELSE + HCS=HCS+BSTU*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,ID2,4312,18,*9) + HCS=HCS+BSUT*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,ID2,3421,19,*9) + ENDIF + ELSE + HCS=HCS+CTSU*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,ID2,2413,21,*9) + HCS=HCS+CTUS*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,ID2,4312,22,*9) + ENDIF + ELSE +C---GLUON FIRST + IF (ID2.LT.7) THEN + HCS=HCS+CTSU*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,ID2,2413,23,*9) + HCS=HCS+CTUS*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,ID2,3421,24,*9) + ELSEIF (ID2.LT.13) THEN + HCS=HCS+CTSU*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,ID2,3142,25,*9) + HCS=HCS+CTUS*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,ID2,4312,26,*9) + ELSE + HCS=HCS+GFLA*CSTU*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP( 0, 0,2413,27,*9) + HCS=HCS+GFLA*CSUT*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP( 0, 0,4123,28,*9) + HCS=HCS+DTSU*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,ID2,2341,29,*9) + HCS=HCS+DSTU*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,ID2,3421,30,*9) + HCS=HCS+DUTS*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,ID2,2413,31,*9) + ENDIF + ENDIF + 5 CONTINUE + 6 CONTINUE + EVWGT=HCS + RETURN +C---GENERATE EVENT + 9 IDN(1)=ID1 + IDN(2)=ID2 + IDCMF=15 + CALL HWETWO + IF (AZSPIN) THEN +C Calculate coefficients for constructing spin density matrices + IF (IHPRO.EQ.7 .OR.IHPRO.EQ.8 .OR. + & IHPRO.EQ.15.OR.IHPRO.EQ.16) THEN +C qqbar-->gg or qbarq-->gg + UT=1./TU + GCOEF(1)=UT+TU + GCOEF(2)=-2. + GCOEF(3)=0. + GCOEF(4)=0. + GCOEF(5)=GCOEF(1) + GCOEF(6)=UT-TU + GCOEF(7)=-GCOEF(6) + ELSEIF (IHPRO.EQ.10.OR.IHPRO.EQ.11.OR. + & IHPRO.EQ.21.OR.IHPRO.EQ.22.OR. + & IHPRO.EQ.23.OR.IHPRO.EQ.24.OR. + & IHPRO.EQ.25.OR.IHPRO.EQ.26) THEN +C qg-->qg or qbarg-->qbarg or gq-->gq or gqbar-->gqbar + SU=1./US + GCOEF(1)=-(SU+US) + GCOEF(2)=0. + GCOEF(3)=2. + GCOEF(4)=0. + GCOEF(5)=SU-US + GCOEF(6)=GCOEF(1) + GCOEF(7)=-GCOEF(5) + ELSEIF (IHPRO.EQ.27.OR.IHPRO.EQ.28) THEN +C gg-->qqbar + UT=1./TU + GCOEF(1)=TU+UT + GCOEF(2)=-2. + GCOEF(3)=0. + GCOEF(4)=0. + GCOEF(5)=GCOEF(1) + GCOEF(6)=TU-UT + GCOEF(7)=-GCOEF(6) + ELSEIF (IHPRO.EQ.29.OR.IHPRO.EQ.30.OR. + & IHPRO.EQ.31) THEN +C gg-->gg + GT=S*S+T*T+U*U + GCOEF(2)=2.*U*U*T*T + GCOEF(3)=2.*S*S*U*U + GCOEF(4)=2.*S*S*T*T + GCOEF(1)=GT*GT-GCOEF(2)-GCOEF(3)-GCOEF(4) + GCOEF(5)=GT*(GT-2.*S*S)-GCOEF(2) + GCOEF(6)=GT*(GT-2.*T*T)-GCOEF(3) + GCOEF(7)=GT*(GT-2.*U*U)-GCOEF(4) + ELSE + CALL HWVZRO(7,GCOEF) + ENDIF + ENDIF + 999 END +CDECK ID>, HWHQCP. +*CMZ :- -26/04/91 10.18.57 by Bryan Webber +*-- Author : Bryan Webber +C----------------------------------------------------------------------- + SUBROUTINE HWHQCP(ID3,ID4,IPERM,IHPR,*) +C----------------------------------------------------------------------- +C IDENTIFIES HARD SUBPROCESS +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + INTEGER HWRINT,ID3,ID4,IPERM,IHPR,ND3 + EXTERNAL HWRINT + IHPRO=IHPR + IF (ID3.GT.0) THEN + IDN(3)=ID3 + IDN(4)=ID4 + ELSE + ND3=-ID3 + IF (ID3.GT.-7) THEN + 1 IDN(3)=HWRINT(1,MAXFL) + IF (IDN(3).EQ.ND3) GOTO 1 + IDN(4)=IDN(3)+6 + ELSE + 2 IDN(3)=HWRINT(1,MAXFL)+6 + IF (IDN(3).EQ.ND3) GOTO 2 + IDN(4)=IDN(3)-6 + ENDIF + ENDIF + ICO(1)=IPERM/1000 + ICO(2)=IPERM/100-10*ICO(1) + ICO(3)=IPERM/10 -10*(IPERM/100) + ICO(4)=IPERM -10*(IPERM/10) + RETURN 1 + END +CDECK ID>, HWHQPM. +*CMZ :- -27/07/95 14.13.56 by Mike Seymour +*-- Author : Mike Seymour +C----------------------------------------------------------------------- + SUBROUTINE HWHQPM +C HARD PROCESS: GAMGAM --> QQBAR/LLBAR/W+W- +C MEAN EVENT WEIGHT = CROSS-SECTION IN NB AFTER CUTS ON PT +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + DOUBLE PRECISION RCS,HCS,RS,S,EMSQ,BE,TMIN,TMAX,T,U,FACTR,Q,CFAC, + $ HWR + INTEGER IHAD1,IHAD2,HQ,ID3,ID4,I1,I2 + SAVE HCS,FACTR,HQ,RS + IHAD1=1 + IF (JDAHEP(1,IHAD1).NE.0) IHAD1=JDAHEP(1,IHAD1) + IHAD2=2 + IF (JDAHEP(1,IHAD2).NE.0) IHAD2=JDAHEP(1,IHAD2) + IF (GENEV) THEN + RCS=HCS*HWR() + ELSE + EVWGT=0. + RS=PHEP(5,3) + S=RS**2 + HQ=MOD(IPROC,100) + IF (HQ.EQ.0) THEN + EMSQ=0 + BE=1 + CFAC=3 + ELSE + IF (HQ.GT.6) HQ=2*HQ+107 + IF (HQ.EQ.127) HQ=198 + EMSQ=RMASS(HQ)**2 + BE=1-4*EMSQ/S + IF (BE.LT.ZERO) RETURN + BE=SQRT(BE) + CFAC=1 + IF (HQ.LE.6) CFAC=3 + ENDIF + TMIN=S/2*(1-SQRT(MAX(1-4*(EMSQ+PTMIN**2)/S,ZERO))) + TMAX=S/2*(1-SQRT(MAX(1-4*(EMSQ+PTMAX**2)/S,ZERO))) + IF (TMIN.GE.TMAX) RETURN + T=-(TMAX/TMIN)**HWR()*TMIN + IF (HWR().GT.HALF) T=-S-T + U=-S-T + COSTH=(T-U)/(BE*S) + EMSCA=SQRT(2.*S*T*U/(S*S+T*T+U*U)) + IF (HQ.NE.198) THEN + FACTR=-GEV2NB*2*LOG(TMAX/TMIN)*MAX(T,U) + $ *2*PIFAC*CFAC*ALPHEM**2/S**2 + $ *((U-4*EMSQ)/T+(T-4*EMSQ)/U-4*(EMSQ/T+EMSQ/U)**2) + ELSE + FACTR=-GEV2NB*2*LOG(TMAX/TMIN)*MAX(T,U) + $ *6*PIFAC*CFAC*ALPHEM**2/S**2 + $ *(1-S/(T*U)*(4D0/3*S+2*EMSQ) + $ +(S/(T*U))**2*(2D0/3*S**2+2*EMSQ**2)) + ENDIF + ENDIF + HCS=0. + XX(1)=1. + XX(2)=1. + IF (HQ.EQ.0) THEN + I1=1 + I2=6 + ELSE + I1=HQ + I2=HQ + ENDIF + DO 10 ID3=I1,I2 + IF (RS.GT.2*RMASS(ID3)) THEN + Q=ICHRG(ID3) + IF (HQ.LE.6) Q=Q/THREE + ID4=ID3+6 + IF (HQ.EQ.198) ID4=199 + HCS=HCS+Q**4 + IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID3,ID4,1243,61,*99) + ENDIF + 10 CONTINUE + EVWGT=FACTR*HCS + RETURN + 99 IDN(1)=59 + IDN(2)=59 + IDCMF=15 + CALL HWETWO + END +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 +CDECK ID>, HWHSS1. +*CMZ :- -18/05/99 20.33.45 by Kosuke Odagiri +*-- Author : Kosuke Odagiri +C----------------------------------------------------------------------- + FUNCTION HWHSS1(S, T, U, M3, M4, SGN, CLL, CLR, CRL, CRR) +C----------------------------------------------------------------------- +C QQ(BAR) -> GAUGINOS +C----------------------------------------------------------------------- + IMPLICIT NONE + DOUBLE PRECISION HWHSS1, S, T, U, M3, M4, SGN + DOUBLE COMPLEX CLL, CLR, CRL, CRR + HWHSS1 = DBLE( + & (CONJG(CLL)*CLL+CONJG(CRR)*CRR)*(U-M3*M3)*(U-M4*M4)+ + & (CONJG(CLR)*CLR+CONJG(CRL)*CRL)*(T-M3*M3)*(T-M4*M4)+ + & (CONJG(CLL)*CLR+CONJG(CRL)*CRR)*2.*SGN*M3*M4*S ) + RETURN + END +CDECK ID>, HWHSSG. +*CMZ :- -18/05/99 20.33.45 by Kosuke Odagiri +*-- Author : Kosuke Odagiri +C----------------------------------------------------------------------- + SUBROUTINE HWHSSG +C----------------------------------------------------------------------- +C SUSY 2 PARTON -> 2 GAUGINOS PROCESSES (1 - 3) +C -> GAUGINO + SPARTON PROCESSES (4 - 7) +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + DOUBLE PRECISION HWR, HWUALF, HWUAEM, EPS, HCS, RCS, DIST, + & ML(6), ML2(6), MR(6), MR2(6), MCH(2), MCH2(2), MNU(4), MNU2(4), + & MSQK, MG, MG2, SM, DM, DAB, QPE, SGN, PF, SQPE, EMSC2, + & FAC0, FACA, FACB, FACC, S, T, T3, U, U4, SN2TH + DOUBLE PRECISION M1(2,2,6), M2(4,4,6), M3(2,4,6,6), + & M4(4,6), M5(2,6,6), M6L(4,6), M6R(4,6), M7(2,2,6,6), + & XA(4), XB(4), XC(4), XD(4), MZ, MW, XW, SQXW, S2W, S22W + INTEGER I, IQ, IQ1, IQ2, IQ3, IQ4, IG1, IG2, IG3, IG4, + & ID1, ID2, IGL, SSL, SSR, GLU, SSNU, SSCH, INU, ICH, IWD(6), IPB + DOUBLE PRECISION DQD(6), DQU(6), HWHSS1 + EXTERNAL HWR, HWUALF, HWUAEM, HWHSS1 + SAVE HCS, M1, M2, M3, M4, M5, M6L, M6R, M7 + PARAMETER (EPS = 1.D-9, IGL = 49, SSL = 400, SSR = 412, GLU = 449) + PARAMETER (SSNU = 449, SSCH = 453, INU = 49, ICH = 53) + DOUBLE COMPLEX Z, Z0, C1, C2, C3, GZ, GW, CLL, CLR, CRL, CRR + PARAMETER (Z = (0.D0,1.D0), Z0 = (0.D0,0.D0)) + EQUIVALENCE (MZ, RMASS(200)), (MW, RMASS(198)), (MG, RMASS(GLU)) + EQUIVALENCE (XA(1), ZMIXSS(1,1)), (XA(2), ZMIXSS(2,1)) + EQUIVALENCE (XA(3), ZMIXSS(3,1)), (XA(4), ZMIXSS(4,1)) + EQUIVALENCE (XB(1), ZMIXSS(1,2)), (XB(2), ZMIXSS(2,2)) + EQUIVALENCE (XB(3), ZMIXSS(3,2)), (XB(4), ZMIXSS(4,2)) + EQUIVALENCE (XC(1), ZMIXSS(1,3)), (XC(2), ZMIXSS(2,3)) + EQUIVALENCE (XC(3), ZMIXSS(3,3)), (XC(4), ZMIXSS(4,3)) + EQUIVALENCE (XD(1), ZMIXSS(1,4)), (XD(2), ZMIXSS(2,4)) + EQUIVALENCE (XD(3), ZMIXSS(3,4)), (XD(4), ZMIXSS(4,4)) + DATA IWD/2,1,4,3,6,5/ + DATA DQD/ONE,ZERO,ONE,ZERO,ONE,ZERO/ + DATA DQU/ZERO,ONE,ZERO,ONE,ZERO,ONE/ +C + CALL HWSGEN(.FALSE.) + IF (GENEV) THEN + RCS = HCS*HWR() + ELSE + SN2TH = 0.25D0 - 0.25D0*COSTH**2 + S=XX(1)*XX(2)*PHEP(5,3)**2 + EMSC2 = EMSCA**2 + FAC0 = FACTSS*HWUAEM(EMSC2) +c prefactor for pair production, includes 1/Nc colour factor + FACA = FAC0*HWUAEM(EMSC2) / CAFAC +c prefactor for qq -> gaugino + gluino, includes CF/Nc colour factor + FACB = FAC0*HWUALF(1,EMSCA) * CFFAC / CAFAC +c prefactor for qg -> gaugino + squark, includes 1/2Nc colour factor + FACC = FACB / CFFAC / TWO + MG2 = MG**2 + GZ = S-MZ**2+Z*S/MZ*GAMZ + GW = S-MW**2+Z*S/MW*GAMW + DO IQ = 1,6 + IQ1 = SSL + IQ + IQ2 = SSR + IQ + ML(IQ) = RMASS(IQ1) + ML2(IQ) = ML(IQ)**2 + MR(IQ) = RMASS(IQ2) + MR2(IQ) = MR(IQ)**2 + END DO + XW = TWO * SWEIN + SQXW = SQRT(XW) + S22W = XW * (TWO - XW) + S2W = SQRT(S22W) + DO IG1 = 1,4 + MNU(IG1) = RMASS(IG1+SSNU) + MNU2(IG1) = MNU(IG1)**2 + END DO + DO IG1 = 1,2 + MCH(IG1) = RMASS(IG1+SSCH) + MCH2(IG1) = MCH(IG1)**2 + END DO +c _ ~+ ~- +c (1) q q -> X X +c a b + DO IG1 = 1,2 + DO IG2 = 1,2 + SM = MCH(IG1) + MCH(IG2) + QPE = S - SM**2 + IF (QPE.GE.ZERO) THEN + DM = MCH(IG1) - MCH(IG2) + SQPE = SQRT(QPE*(S-DM**2)) + PF = SQPE/S + T = (SQPE*COSTH - S + MCH2(IG1) + MCH2(IG2)) / TWO + U = - T - S + MCH2(IG1) + MCH2(IG2) + DAB = ABS(FLOAT(IG1+IG2-3)) + C1 = (-WMXVSS(IG1,2)*WMXVSS(IG2,2)+DAB*S22W/XW)/S2W/GZ + C2 = (-WMXUSS(IG1,2)*WMXUSS(IG2,2)+DAB*S22W/XW)/S2W/GZ + SGN = WSGNSS(IG1)*WSGNSS(IG2) + DO IQ = 1,6 + C3 = -DAB*QFCH(IQ)/S + CLL = C3 - LFCH(IQ)*C1 + + & DQD(IQ)*WMXUSS(IG1,1)*WMXUSS(IG2,1)/(U-ML2(IWD(IQ))) + CLR = C3 - LFCH(IQ)*C2 - + & DQU(IQ)*WMXVSS(IG1,1)*WMXVSS(IG2,1)/(T-ML2(IWD(IQ))) + CRL = C3 - RFCH(IQ)*C1 + CRR = C3 - RFCH(IQ)*C2 + M1(IG1,IG2,IQ)=FACA*PF* + & HWHSS1(S,T,U,MCH(IG1),MCH(IG2),SGN,CLL,CLR,CRL,CRR) + END DO + ELSE + DO IQ = 1,6 + M1(IG1,IG2,IQ) = ZERO + END DO + END IF + END DO + END DO +c _ ~o ~o +c (2) q q -> X X +c i j + DO IG1 = 1,4 + DO IG2 = 1,4 + SM = MNU(IG1) + MNU(IG2) + QPE = S - SM**2 + IF (QPE.GE.ZERO) THEN + DM = MNU(IG1) - MNU(IG2) + SQPE = SQRT(QPE*(S-DM**2)) + PF = SQPE/S + T = (SQPE*COSTH - S + MNU2(IG1) + MNU2(IG2)) / TWO + U = - T - S + MNU2(IG1) + MNU2(IG2) + C1 = (XD(IG1)*XD(IG2)-XC(IG1)*XC(IG2))/S2W/GZ + C2 = - C1 + SGN = ZSGNSS(IG1)*ZSGNSS(IG2) + DO IQ = 1,6 + CLL =LFCH(IQ)*C1+SLFCH(IQ,IG1)*SLFCH(IQ,IG2)/(U-ML2(IQ)) + CLR =LFCH(IQ)*C2-SLFCH(IQ,IG1)*SLFCH(IQ,IG2)/(T-ML2(IQ)) + CRL =RFCH(IQ)*C1-SRFCH(IQ,IG1)*SRFCH(IQ,IG2)/(T-MR2(IQ)) + CRR =RFCH(IQ)*C2+SRFCH(IQ,IG1)*SRFCH(IQ,IG2)/(U-MR2(IQ)) + M2(IG1,IG2,IQ) = FACA*PF*HALF* + & HWHSS1(S,T,U,MNU(IG1),MNU(IG2),SGN,CLL,CLR,CRL,CRR) + END DO + ELSE + DO IQ = 1,6 + M2(IG1,IG2,IQ) = ZERO + END DO + END IF + END DO + END DO +c _ ~+ ~o +c (3) U D -> X X +c a i + DO IG1 = 1,2 + DO IG2 = 1,4 + SM = MCH(IG1) + MNU(IG2) + QPE = S - SM**2 + IF (QPE.GE.ZERO) THEN + DM = MCH(IG1) - MNU(IG2) + SQPE = SQRT(QPE*(S-DM**2)) + PF = SQPE/S + T = (SQPE*COSTH - S + MCH2(IG1) + MNU2(IG2)) / TWO + U = - T - S + MCH2(IG1) + MNU2(IG2) + C1 = XA(IG2)+S2W/XW*XB(IG2) +c note the new s-channel signs below. + C2 = ( XC(IG2)*WMXUSS(IG1,2)/SQXW+C1*WMXUSS(IG1,1))/GW + C3 = (-XD(IG2)*WMXVSS(IG1,2)/SQXW+C1*WMXVSS(IG1,1))/GW + SGN = WSGNSS(IG1)*ZSGNSS(IG2) + DO IQ1 = 1,3 + IQ3 = IQ1*2 + DO IQ2 = 1,3 + IQ4 = IQ2*2-1 + CLL = C2+WMXVSS(IG1,1)*SLFCH(IQ3,IG2)/(U-ML2(IQ3)) + CLR = C3-WMXUSS(IG1,1)*SLFCH(IQ4,IG2)/(T-ML2(IQ4)) + M3(IG1,IG2,IQ1,IQ2) = FACA*PF*VCKM(IQ1,IQ2)/XW* + & HWHSS1(S,T,U,MCH(IG1),MNU(IG2),SGN,CLL,CLR,Z0,Z0) + END DO + END DO + ELSE + DO IQ1 = 1,3 + DO IQ2 = 1,3 + M3(IG1,IG2,IQ1,IQ2) = ZERO + END DO + END DO + END IF + END DO + END DO +c _ ~o ~ +c (4) q q -> X g +c i + DO IG1 = 1,4 + SM = MNU(IG1) + MG + QPE = S - SM**2 + IF (QPE.GE.ZERO) THEN + DM = MNU(IG1) - MG + SQPE = SQRT(QPE*(S-DM**2)) + PF = SQPE/S + T = (SQPE*COSTH - S + MG2 + MNU2(IG1)) / TWO + U = - T - S + MG2 + MNU2(IG1) + DO IQ = 1,6 + CLL = SLFCH(IQ,IG1)/(U-ML2(IQ)) + CLR = - SLFCH(IQ,IG1)/(T-ML2(IQ)) + CRL = - SRFCH(IQ,IG1)/(T-MR2(IQ)) + CRR = SRFCH(IQ,IG1)/(U-MR2(IQ)) + M4(IG1,IQ) = FACB*PF* + & HWHSS1(S,T,U,MNU(IG1),MG,ZSGNSS(IG1),CLL,CLR,CRL,CRR) + END DO + ELSE + DO IQ = 1,6 + M4(IG1,IQ) = ZERO + END DO + END IF + END DO +c _ ~+ ~ +c (5) U D -> X g +c a + DO IG1 = 1,2 + SM = MCH(IG1) + MG + QPE = S - SM**2 + IF (QPE.GE.ZERO) THEN + DM = MCH(IG1) - MG + SQPE = SQRT(QPE*(S-DM**2)) + PF = SQPE/S + T = (SQPE*COSTH - S + MCH2(IG1) + MG2) / TWO + U = - T - S + MCH2(IG1) + MG2 + DO IQ1 = 1,3 + IQ3 = IQ1*2 + DO IQ2 = 1,3 + IQ4 = IQ2*2-1 + CLL = WMXVSS(IG1,1)/(U-ML2(IQ3)) + CLR = - WMXUSS(IG1,1)/(T-ML2(IQ4)) + M5(IG1,IQ1,IQ2) = FACB*PF*VCKM(IQ1,IQ2)/XW* + & HWHSS1(S,T,U,MCH(IG1),MG,WSGNSS(IG1),CLL,CLR,Z0,Z0) + END DO + END DO + ELSE + DO IQ1 = 1,3 + DO IQ2 = 1,3 + M5(IG1,IQ1,IQ2) = ZERO + END DO + END DO + END IF + END DO +c ~o ~ +c (6) g q -> X q +c i LR + DO IG1 = 1,4 + DO IQ = 1,6 +c left squarks + SM = MNU(IG1)+ML(IQ) + QPE = S - SM**2 + IF (QPE.GE.ZERO) THEN + DM = MNU(IG1)-ML(IQ) + SQPE = SQRT(QPE*(S-DM**2)) + PF = SQPE/S + T3 = (SQPE*COSTH - S - SM*DM) / TWO + U4 = - T3 - S + M6L(IG1,IQ) = FACC*PF * ( + & QMIXSS(IQ,1,1)*SLFCH(IQ,IG1)+QMIXSS(IQ,2,1)*SRFCH(IQ,IG1) + & )**2 * T3/S/U4*(-U4+TWO*SM*DM/T3/U4*SQPE*SQPE*SN2TH) + ELSE + M6L(IG1,IQ) = ZERO + END IF +c right squarks + SM = MNU(IG1)+MR(IQ) + QPE = S - SM**2 + IF (QPE.GE.ZERO) THEN + DM = MNU(IG1)-MR(IQ) + SQPE = SQRT(QPE*(S-DM**2)) + PF = SQPE/S + T3 = (SQPE*COSTH - S - SM*DM) / TWO + U4 = - T3 - S + M6R(IG1,IQ) = FACC*PF * ( + & QMIXSS(IQ,1,2)*SLFCH(IQ,IG1)+QMIXSS(IQ,2,2)*SRFCH(IQ,IG1) + & )**2 * T3/S/U4*(-U4+TWO*SM*DM/T3/U4*SQPE*SQPE*SN2TH) + ELSE + M6R(IG1,IQ) = ZERO + END IF + END DO + END DO +c ~+-~ +c (7) g q -> X q' +c a L + DO IG1 = 1,2 + DO IQ1 = 1,3 + IQ3 = IQ1*2 + DO IQ2 = 1,3 + IQ4 = IQ2*2-1 + DO I = 1,2 +c U initiated processes + IF (I.EQ.1) THEN + MSQK = ML(IQ4) + ELSE + MSQK = MR(IQ4) + END IF + SM = MCH(IG1) + MSQK + QPE = S - SM**2 + IF (((I.EQ.1).OR.(IQ2.EQ.3)).AND.(QPE.GE.ZERO)) THEN + DM = MCH(IG1) - MSQK + SQPE = SQRT(QPE*(S-DM**2)) + PF = SQPE/S + T3 = (SQPE*COSTH - S - SM*DM) / TWO + U4 = - T3 - S + M7(I,IG1,IQ3,IQ4)=FACC*PF*WMXUSS(IG1,1)**2*VCKM(IQ1,IQ2) + & /XW*T3/S/U4*(-U4+TWO*SM*DM/T3/U4*SQPE*SQPE*SN2TH)* + & QMIXSS(IQ4,1,I)**2 + ELSE + M7(I,IG1,IQ3,IQ4) = ZERO + END IF +c D initiated processes + IF (I.EQ.1) THEN + MSQK = ML(IQ3) + ELSE + MSQK = MR(IQ3) + END IF + SM = MCH(IG1) + MSQK + QPE = S - SM**2 + IF (((I.EQ.1).OR.(IQ1.EQ.3)).AND.(QPE.GE.ZERO)) THEN + DM = MCH(IG1) - MSQK + SQPE = SQRT(QPE*(S-DM**2)) + PF = SQPE/S + T3 = (SQPE*COSTH - S - SM*DM) / TWO + U4 = - T3 - S + M7(I,IG1,IQ4,IQ3)=FACC*PF*WMXVSS(IG1,1)**2*VCKM(IQ1,IQ2) + & /XW*T3/S/U4*(-U4+TWO*SM*DM/T3/U4*SQPE*SQPE*SN2TH)* + & QMIXSS(IQ3,1,I)**2 + ELSE + M7(I,IG1,IQ4,IQ3) = ZERO + END IF + END DO + END DO + END DO + END DO + END IF + HCS = 0. +c _ _ ~+ ~- ~o ~o ~o ~ +c q q , q q -> X X , X X , X g +c a b i j i + DO 1 ID1 = 1,12 + IF (DISF(ID1,1).LT.EPS) GOTO 1 + IF (ID1.GT.6) THEN + ID2 = ID1 - 6 + IQ = ID2 + IPB = 4132 + ELSE + ID2 = ID1 + 6 + IQ = ID1 + IPB = 2431 + END IF + IF (DISF(ID2,2).LT.EPS) GOTO 1 + DIST = DISF(ID1,1)*DISF(ID2,2) + DO IG1 = 1,2 + IG3 = ICH+IG1 + DO IG2 = 1,2 + IG4 = ICH+IG2+2 + HCS = HCS + DIST*M1(IG1,IG2,IQ) + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IG3,0,IG4,0,2134,21,*9) + END DO + END DO + DO IG1 = 1,4 + IG3 = INU+IG1 + DO IG2 = 1,4 + IG4 = INU+IG2 + IF (IG2.GE.IG1) HCS = HCS + DIST*M2(IG1,IG2,IQ) + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IG3,0,IG4,0,2134,22,*9) + END DO + HCS = HCS + DIST*M4(IG1,IQ) + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IG3,0,IGL,0, IPB,24,*9) + END DO + 1 CONTINUE +c _ _ ~+-~o ~+-~ +c q q', q q' -> X X , X g +c a i a +c +c _ _ _ _ +c ud(+), ud(-), du(-), du(+) + DO 2 IQ1 = 1, 3 + DO IQ2 = 1, 3 + IF(VCKM(IQ1,IQ2).GT.EPS) THEN +c _ +c ud (+) + ID1 = IQ1 * 2 + ID2 = IQ2 * 2 + 5 + IF ((DISF(ID1,1).GT.EPS).AND.(DISF(ID2,2).GT.EPS)) THEN + DIST = DISF(ID1,1)*DISF(ID2,2) + DO IG1 = 1,2 + IG3 = ICH+IG1 + DO IG2 = 1,4 + IG4 = INU+IG2 + HCS = HCS + DIST*M3(IG1,IG2,IQ1,IQ2) + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IG3,0,IG4,0,2134,23,*9) + END DO + HCS = HCS + DIST*M5(IG1,IQ1,IQ2) + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IG3,0,IGL,0,2431,25,*9) + END DO + END IF +c _ +c du (+) + ID1 = IQ2 * 2 + 5 + ID2 = IQ1 * 2 + IF ((DISF(ID1,1).GT.EPS).AND.(DISF(ID2,2).GT.EPS)) THEN + DIST = DISF(ID1,1)*DISF(ID2,2) + DO IG1 = 1,2 + IG3 = ICH+IG1 + DO IG2 = 1,4 + IG4 = INU+IG2 + HCS = HCS + DIST*M3(IG1,IG2,IQ1,IQ2) + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IG4,0,IG3,0,2134,23,*9) + END DO + HCS = HCS + DIST*M5(IG1,IQ1,IQ2) + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IGL,0,IG3,0,3124,25,*9) + END DO + END IF +c _ +c du (-) + ID1 = IQ2 * 2 - 1 + ID2 = IQ1 * 2 + 6 + IF ((DISF(ID1,1).GT.EPS).AND.(DISF(ID2,2).GT.EPS)) THEN + DIST = DISF(ID1,1)*DISF(ID2,2) + DO IG1 = 1,2 + IG3 = ICH+IG1+2 + DO IG2 = 1,4 + IG4 = INU+IG2 + HCS = HCS + DIST*M3(IG1,IG2,IQ1,IQ2) + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IG4,0,IG3,0,2134,23,*9) + END DO + HCS = HCS + DIST*M5(IG1,IQ1,IQ2) + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IGL,0,IG3,0,2314,25,*9) + END DO + END IF +c _ +c ud (-) + ID1 = IQ1 * 2 + 6 + ID2 = IQ2 * 2 - 1 + IF ((DISF(ID1,1).GT.EPS).AND.(DISF(ID2,2).GT.EPS)) THEN + DIST = DISF(ID1,1)*DISF(ID2,2) + DO IG1 = 1,2 + IG3 = ICH+IG1+2 + DO IG2 = 1,4 + IG4 = INU+IG2 + HCS = HCS + DIST*M3(IG1,IG2,IQ1,IQ2) + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IG3,0,IG4,0,2134,23,*9) + END DO + HCS = HCS + DIST*M5(IG1,IQ1,IQ2) + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IG3,0,IGL,0,4132,25,*9) + END DO + END IF + END IF + END DO + 2 CONTINUE +c _ _ ~o ~ ~+-~ +c g q , g q , q g , q g -> X q , X q' +c i LR a L +c neutralino + DO IQ1 = 1,6 +c +c gq + ID1 = 13 + ID2 = IQ1 + IF ((DISF(ID1,1).GT.EPS).AND.(DISF(ID2,2).GT.EPS)) THEN + DIST = DISF(ID1,1)*DISF(ID2,2) + DO IG1 = 1,4 + IG3 = INU+IG1 + HCS = HCS + DIST*M6L(IG1,IQ1) + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IG3,0,ID2,0,2431,26,*9) + HCS = HCS + DIST*M6R(IG1,IQ1) + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IG3,0,ID2,2,2431,26,*9) + END DO + END IF +c _ +c gq + ID1 = 13 + ID2 = IQ1 + 6 + IF ((DISF(ID1,1).GT.EPS).AND.(DISF(ID2,2).GT.EPS)) THEN + DIST = DISF(ID1,1)*DISF(ID2,2) + DO IG1 = 1,4 + IG3 = INU+IG1 + HCS = HCS + DIST*M6L(IG1,IQ1) + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IG3,0,ID2,0,4132,26,*9) + HCS = HCS + DIST*M6R(IG1,IQ1) + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IG3,0,ID2,2,4132,26,*9) + END DO + END IF +c +c qg + ID1 = IQ1 + ID2 = 13 + IF ((DISF(ID1,1).GT.EPS).AND.(DISF(ID2,2).GT.EPS)) THEN + DIST = DISF(ID1,1)*DISF(ID2,2) + DO IG1 = 1,4 + IG3 = INU+IG1 + HCS = HCS + DIST*M6L(IG1,IQ1) + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(ID1,0,IG3,0,3124,26,*9) + HCS = HCS + DIST*M6R(IG1,IQ1) + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(ID1,2,IG3,0,3124,26,*9) + END DO + END IF +c _ +c qg + ID1 = IQ1 + 6 + ID2 = 13 + IF ((DISF(ID1,1).GT.EPS).AND.(DISF(ID2,2).GT.EPS)) THEN + DIST = DISF(ID1,1)*DISF(ID2,2) + DO IG1 = 1,4 + IG3 = INU+IG1 + HCS = HCS + DIST*M6L(IG1,IQ1) + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(ID1,0,IG3,0,2314,26,*9) + HCS = HCS + DIST*M6R(IG1,IQ1) + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(ID1,2,IG3,0,2314,26,*9) + END DO + END IF + END DO +c chargino + DO IQ1 = 1,3 + IQ3 = IQ1*2 + DO 3 IQ2 = 1,3 + IF (VCKM(IQ1,IQ2).LT.EPS) GOTO 3 + IQ4 = IQ2*2-1 + DO IG1 = 1,2 + IG3 = ICH+IG1 + IG4 = ICH+IG1+2 +c +c gq & qg + ID1 = 13 + ID2 = IQ3 + HCS = HCS + DISF(ID1,1)*DISF(ID2,2)*M7(1,IG1,IQ3,IQ4) + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IG3,0,IQ4,0,2431,27,*9) + HCS = HCS + DISF(ID1,1)*DISF(ID2,2)*M7(2,IG1,IQ3,IQ4) + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IG3,0,IQ4,2,2431,27,*9) + ID2 = IQ4 + HCS = HCS + DISF(ID1,1)*DISF(ID2,2)*M7(1,IG1,IQ4,IQ3) + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IG4,0,IQ3,0,2431,27,*9) + HCS = HCS + DISF(ID1,1)*DISF(ID2,2)*M7(2,IG1,IQ4,IQ3) + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IG4,0,IQ3,2,2431,27,*9) + ID1 = IQ3 + ID2 = 13 + HCS = HCS + DISF(ID1,1)*DISF(ID2,2)*M7(1,IG1,IQ3,IQ4) + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ4,0,IG3,0,3124,27,*9) + HCS = HCS + DISF(ID1,1)*DISF(ID2,2)*M7(2,IG1,IQ3,IQ4) + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ4,2,IG3,0,3124,27,*9) + ID1 = IQ4 + HCS = HCS + DISF(ID1,1)*DISF(ID2,2)*M7(1,IG1,IQ4,IQ3) + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ3,0,IG4,0,3124,27,*9) + HCS = HCS + DISF(ID1,1)*DISF(ID2,2)*M7(2,IG1,IQ4,IQ3) + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ3,2,IG4,0,3124,27,*9) +c _ _ +c gq & qg + ID1 = 13 + ID2 = IQ3 + 6 + HCS = HCS + DISF(ID1,1)*DISF(ID2,2)*M7(1,IG1,IQ3,IQ4) + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IG4,0,IQ4,1,4132,27,*9) + HCS = HCS + DISF(ID1,1)*DISF(ID2,2)*M7(2,IG1,IQ3,IQ4) + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IG4,0,IQ4,3,4132,27,*9) + ID2 = IQ4 + 6 + HCS = HCS + DISF(ID1,1)*DISF(ID2,2)*M7(1,IG1,IQ4,IQ3) + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IG3,0,IQ3,1,4132,27,*9) + HCS = HCS + DISF(ID1,1)*DISF(ID2,2)*M7(2,IG1,IQ4,IQ3) + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IG3,0,IQ3,3,4132,27,*9) + ID1 = IQ3 + 6 + ID2 = 13 + HCS = HCS + DISF(ID1,1)*DISF(ID2,2)*M7(1,IG1,IQ3,IQ4) + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ4,1,IG4,0,2314,27,*9) + HCS = HCS + DISF(ID1,1)*DISF(ID2,2)*M7(2,IG1,IQ3,IQ4) + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ4,3,IG4,0,2314,27,*9) + ID1 = IQ4 + 6 + HCS = HCS + DISF(ID1,1)*DISF(ID2,2)*M7(1,IG1,IQ4,IQ3) + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ3,1,IG3,0,2314,27,*9) + HCS = HCS + DISF(ID1,1)*DISF(ID2,2)*M7(2,IG1,IQ4,IQ3) + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ3,3,IG3,0,2314,27,*9) + END DO + 3 CONTINUE + END DO + EVWGT = HCS + RETURN +C---GENERATE EVENT + 9 IDN(1)=ID1 + IDN(2)=ID2 + IDCMF=15 + CALL HWETWO + IF (AZSPIN) THEN +C Calculate coefficients for constructing spin density matrices +C Set to zero for now + CALL HWVZRO(7,GCOEF) + END IF + 888 END +CDECK ID>, HWHSSL. +*CMZ :- -18/05/99 20.33.45 by Kosuke Odagiri +*-- Author : Kosuke Odagiri +C----------------------------------------------------------------------- + SUBROUTINE HWHSSL +C----------------------------------------------------------------------- +C SUSY 2 PARTON -> 2 SLEPTON PROCESSES +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + DOUBLE PRECISION HWR, HWUAEM, EPS, HCS, RCS, DIST, S, PF, QPE, + & FACTR, SN2TH, MZ, MW, ME2(2,2,6,2), ME2W(2,3), EMSC2, GW2 + INTEGER IQ, IQ1, IQ2, ID1, ID2, IL, IL1, IL2, I, J + EXTERNAL HWR, HWUAEM + SAVE HCS, ME2, ME2W + PARAMETER (EPS = 1.D-9) + DOUBLE COMPLEX Z, GZ, A, BL, BR, CL, CR, D, E + PARAMETER (Z = (0.D0,1.D0)) + EQUIVALENCE (MZ, RMASS(200)), (MW, RMASS(198)) +C + S = XX(1)*XX(2)*PHEP(5,3)**2 + EMSC2 = S + EMSCA = SQRT(EMSC2) + CALL HWSGEN(.FALSE.) + IF (GENEV) THEN + RCS = HCS*HWR() + ELSE + SN2TH = 0.25D0 - 0.25D0*COSTH**2 + FACTR = FACTSS*HWUAEM(EMSC2)**2/CAFAC*SN2TH + GZ = (S-MZ**2+Z*S*GAMZ/MZ)/S + GW2 = ((ONE-MW**2/S)**2+(GAMW/MW)**2)*(TWO*SWEIN)**2 +c _ ~ ~* +c q q -> l l +c + DO IL = 1,6 + DO I = 1,2 + DO J = 1,2 + IF (((I.NE.J).AND.(IL.NE.5)).OR. + & ((I.EQ.2).AND.(((IL/2)*2).EQ.IL))) THEN + QPE = -1. + ELSE + ID1 = 412 + I*12 + IL + ID2 = 412 + J*12 + IL + IL1 = IL + 10 + QPE = S-(RMASS(ID1)+RMASS(ID2))**2 + END IF + IF (QPE.GT.ZERO) THEN + PF = SQRT(QPE*(S-(RMASS(ID1)-RMASS(ID2))**2))/S + DO IQ = 1,2 + A = QFCH(IL1)*QFCH(IQ) + BL = LFCH(IL1)/GZ + BR = RFCH(IL1)/GZ + CL = LMIXSS(IL,1,I)*LMIXSS(IL,1,J) + CR = LMIXSS(IL,2,I)*LMIXSS(IL,2,J) + D = (A+BL*LFCH(IQ))*CL+(A+BR*LFCH(IQ))*CR + E = (A+BL*RFCH(IQ))*CL+(A+BR*RFCH(IQ))*CR + ME2(I,J,IL,IQ)=FACTR*PF**3*DBLE(CONJG(D)*D+CONJG(E)*E) + END DO + ELSE + ME2(I,J,IL,1)=ZERO + ME2(I,J,IL,2)=ZERO + END IF + END DO + END DO + END DO +c _ ~ ~* +c q q' -> l v +c + DO IL = 1,3 + DO I = 1,2 + IF ((IL.NE.3).AND.(I.EQ.2)) THEN + QPE = -1. + ELSE + ID1 = 411 + IL*2 + I*12 + ID2 = 424 + IL*2 + QPE = S-(RMASS(ID1)+RMASS(ID2))**2 + END IF + IF (QPE.GT.ZERO) THEN + PF = SQRT(QPE*(S-(RMASS(ID1)-RMASS(ID2))**2))/S + ME2W(I,IL)=FACTR*PF**3/GW2 + IF (IL.EQ.3) ME2W(I,3)=ME2W(I,3)*LMIXSS(5,1,I)**2 + ELSE + ME2W(I,IL)=ZERO + END IF + END DO + END DO + + END IF + HCS = 0. +C + DO 1 ID1 = 1, 12 + IF (DISF(ID1,1).LT.EPS) GOTO 1 + IF (ID1.GT.6) THEN + ID2 = ID1 - 6 + ELSE + ID2 = ID1 + 6 + END IF + IQ = ID1 - ((ID1-1)/2)*2 + IF (DISF(ID2,2).LT.EPS) GOTO 1 + DIST = DISF(ID1,1)*DISF(ID2,2) + DO IL = 1,6 + DO I = 1,2 + DO J = 1,2 + IL1 = IL+I*12 + IL2 = IL+J*12 + HCS = HCS + DIST*ME2(I,J,IL,IQ) + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IL1,2,IL2,3,2134,30,*9) + END DO + END DO + END DO + 1 CONTINUE +c _ _ _ _ +c ud(+), ud(-), du(-), du(+) + DO 2 IQ1 = 1, 3 + DO IQ2 = 1, 3 + IF(VCKM(IQ1,IQ2).GT.EPS) THEN +c _ +c ud (+) + ID1 = IQ1 * 2 + ID2 = IQ2 * 2 + 5 + IF ((DISF(ID1,1).GT.EPS).AND.(DISF(ID2,2).GT.EPS)) THEN + DIST = VCKM(IQ1,IQ2)*DISF(ID1,1)*DISF(ID2,2) + DO IL = 1,3 + IL1 = IL*2-1 + IL2 = IL1+1 + HCS = HCS + DIST*ME2W(1,IL) + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IL1,5,IL2,4,2134,30,*9) + END DO + HCS = HCS + DIST*ME2W(2,3) + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(5,7,6,4,2134,30,*9) + END IF +c _ +c du (+) + ID1 = IQ2 * 2 + 5 + ID2 = IQ1 * 2 + IF ((DISF(ID1,1).GT.EPS).AND.(DISF(ID2,2).GT.EPS)) THEN + DIST = VCKM(IQ1,IQ2)*DISF(ID1,1)*DISF(ID2,2) + DO IL = 1,3 + IL1 = IL*2-1 + IL2 = IL1+1 + HCS = HCS + DIST*ME2W(1,IL) + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IL1,5,IL2,4,2134,30,*9) + END DO + HCS = HCS + DIST*ME2W(2,3) + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(5,7,6,4,2134,30,*9) + END IF +c _ +c du (-) + ID1 = IQ2 * 2 - 1 + ID2 = IQ1 * 2 + 6 + IF ((DISF(ID1,1).GT.EPS).AND.(DISF(ID2,2).GT.EPS)) THEN + DIST = VCKM(IQ1,IQ2)*DISF(ID1,1)*DISF(ID2,2) + DO IL = 1,3 + IL1 = IL*2-1 + IL2 = IL1+1 + HCS = HCS + DIST*ME2W(1,IL) + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IL1,4,IL2,5,2134,30,*9) + END DO + HCS = HCS + DIST*ME2W(2,3) + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(5,6,6,5,2134,30,*9) + END IF +c _ +c ud (-) + ID1 = IQ1 * 2 + 6 + ID2 = IQ2 * 2 - 1 + IF ((DISF(ID1,1).GT.EPS).AND.(DISF(ID2,2).GT.EPS)) THEN + DIST = VCKM(IQ1,IQ2)*DISF(ID1,1)*DISF(ID2,2) + DO IL = 1,3 + IL1 = IL*2-1 + IL2 = IL1+1 + HCS = HCS + DIST*ME2W(1,IL) + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IL1,4,IL2,5,2134,30,*9) + END DO + HCS = HCS + DIST*ME2W(2,3) + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(5,6,6,5,2134,30,*9) + END IF + END IF + END DO + 2 CONTINUE + + EVWGT = HCS + RETURN +C---GENERATE EVENT + 9 IDN(1)=ID1 + IDN(2)=ID2 + IDCMF=15 + CALL HWETWO + IF (AZSPIN) THEN +C Calculate coefficients for constructing spin density matrices +C Set to zero for now + CALL HWVZRO(7,GCOEF) + END IF + END +CDECK ID>, HWHSSQ. +*CMZ :- -18/05/99 20.33.45 by Kosuke Odagiri +*-- Author : Kosuke Odagiri +C----------------------------------------------------------------------- + SUBROUTINE HWHSSQ +C----------------------------------------------------------------------- +C SUSY HARD 2 PARTON -> 2 SPARTON PROCESSES +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + DOUBLE PRECISION HWR, HWUALF, EPS, HCS, RCS, DIST, NC, NC2, + & NC2C, ML2(6), ML4(6), MR2(6), MR4(6), MG2, SM, DM, QPE, + & SQPE, FACTR, AFAC, AF, BONE, CFAC, CFC2, CFC3, CONE, + & CONN, CONT, CONU, CONL, CONR, DFAC, DONE, PF, S, + & S2, TT, TT2, TMG, TMG2, UU, UU2, UMG, UMG2, + & L, L2, TTML, UUML, R, R2, TTMR, UUMR, SN2TH + DOUBLE PRECISION + & AUSTLL(6), AUSTRR(6), + & ASTULL(6,6), ASTURR(6,6), ASTULR(6,6), ASTURL(6,6), + & AUTSLL(6,6), AUTSRR(6,6), AUTSLR(6,6), AUTSRL(6,6), + & BSTULL(6), BSTURR(6), BSTULR(6), BSTURL(6), + & BSUTLL(6), BSUTRR(6), BSUTLR(6), BSUTRL(6), + & BUTSLL(6), BUTSRR(6), BUTSLR(6), BUTSRL(6), + & BUSTLL(6), BUSTRR(6), BUSTLR(6), BUSTRL(6), + & CSTU(6), CSUT(6), CSTUL(6), CSTUR(6), CSUTL(6), CSUTR(6), + & CTSUL(6), CTSUR(6), CTUSL(6), CTUSR(6), DUTS, DTSU, DSTU + INTEGER IQ, IQ1, IQ2, ID1, ID2, ID2MIN, IGL, SSL, SSR, GLU + EXTERNAL HWR, HWUALF + SAVE HCS, AUSTLL, AUSTRR, ASTULL, ASTURR, ASTULR, ASTURL, + & AUTSLL, AUTSRR, AUTSLR, AUTSRL, BSTULL, BSTURR, BSTULR, + & BSTURL, BSUTLL, BSUTRR, BSUTLR, BSUTRL, BUTSLL, BUTSRR, BUTSLR, + & BUTSRL, BUSTLL, BUSTRR, BUSTLR, BUSTRL, CSTU, CSUT, CSTUL, CSTUR, + & CSUTL, CSUTR, CTSUL, CTSUR, CTUSL, CTUSR, DUTS, DTSU, DSTU + PARAMETER (EPS = 1.D-9, IGL = 49, SSL = 400, SSR = 412, GLU = 449) + CALL HWSGEN(.FALSE.) + IF (GENEV) THEN + RCS = HCS*HWR() + ELSE + SN2TH = 0.25D0 - 0.25D0*COSTH**2 + S = XX(1)*XX(2)*PHEP(5,3)**2 + FACTR = FACTSS*HWUALF(1,EMSCA)**2 + NC = CAFAC + NC2 = NC**2 + NC2C = ONE - ONE/NC2 + AFAC = FACTR*NC2C/FOUR + CFAC = FACTR*CFFAC/FOUR + CFC2 = FACTR/CFFAC/FOUR + CFC3 = FACTR/FOUR + DFAC = FACTR/NC2C + S2 = S**2 + MG2 = RMASS(GLU)**2 + DO 10 IQ = 1, 6 + IQ1 = SSL + IQ + IQ2 = SSR + IQ + ML2(IQ) = RMASS(IQ1)**2 + ML4(IQ) = ML2(IQ)**2 + MR2(IQ) = RMASS(IQ2)**2 + MR4(IQ) = MR2(IQ)**2 + 10 CONTINUE +c gluino pair production + QPE = S - FOUR*MG2 + IF (QPE.GE.ZERO) THEN + SQPE = SQRT(S*QPE) + PF = SQPE/S + TT = (SQPE*COSTH - S) / TWO + TT2 = TT**2 + UU = - S - TT + UU2 = UU**2 +c ~ ~ +c g g -> g g +c + DONE = + & DFAC*PF/TWO*(UU2+TT2+FOUR*MG2*S*SQPE**2*SN2TH/TT/UU)/S2/TT/UU + DUTS = DONE*UU2 + DTSU = DONE*TT2 + DSTU = DONE*S2 +c _ ~ ~ +c q q -> g g +c + DO 21 IQ = 1, 6 + L = ML2(IQ)-MG2 + L2 = L**2 + TTML = TT-L + UUML = UU-L + R = MR2(IQ)-MG2 + R2 = R**2 + TTMR = TT-R + UUMR = UU-R + CONE = TWO*PF**2*SN2TH + CONL = CONE/UUML/TTML + CONR = CONE/UUMR/TTMR + CONT = (UU2-L2)*CONL+(UU2-R2)*CONR+L2/TTML**2+R2/TTMR**2 + CONU = (TT2-L2)*CONL+(TT2-R2)*CONR+L2/UUML**2+R2/UUMR**2 + CONN = CFAC*(PF-PF/NC2/(CONT+CONU)*( S2*(CONL+CONR)+ + & L2*((TT-UU)*CONL/CONE)**2+R2*((TT-UU)*CONR/CONE)**2 )) + CSTU(IQ) = CONT*CONN + CSUT(IQ) = CONU*CONN + 21 CONTINUE + ELSE + DUTS = ZERO + DTSU = ZERO + DSTU = ZERO + DO 23 IQ = 1, 6 + CSTU(IQ) = ZERO + CSUT(IQ) = ZERO + 23 CONTINUE + END IF +c left handed squark (identical flavour) pair production + DO 22 IQ = 1, 6 + QPE = S - FOUR*ML2(IQ) + IF (QPE.GE.ZERO) THEN + SQPE = SQRT(S*QPE) + PF = SQPE/S + TT = (SQPE*COSTH - S) / TWO + TT2 = TT**2 + UU = - S - TT + UU2 = UU**2 +c ~ ~* +c g g -> q q +c L L + CONE = CFC2*PF*((SQPE*PF*SN2TH)**2+ML4(IQ))/TT2/UU2 + CONN = CONE-CONE*S2/(TT2+UU2)/NC2 + CSTUL(IQ) = CONN*UU2 + CSUTL(IQ) = CONN*TT2 +c ~ ~ +c q q -> q q +c L L + TMG = TT+ML2(IQ)-MG2 + TMG2 = TMG**2 + UMG = UU+ML2(IQ)-MG2 + UMG2 = UMG**2 + BONE = AFAC*PF*MG2*S*(HALF-TMG*UMG/(TMG2+UMG2)/NC) + BSTULL(IQ) = BONE/TMG2 + BSUTLL(IQ) = BONE/UMG2 +c _ ~ ~* +c q q -> q q +c L L + AF = AFAC*PF*PF**2*SN2TH + BONE = AF/TMG2-AF*S/(HALF*S2+TMG2)/TMG/NC + BUTSLL(IQ) = BONE*S2 + BUSTLL(IQ) = BONE*TWO*TMG2 +c _ ~ ~* +c q q -> q'q' q =/= q' +c L L + AUSTLL(IQ) = TWO*AF + ELSE + CSTUL(IQ) = ZERO + CSUTL(IQ) = ZERO + BSTULL(IQ) = ZERO + BSUTLL(IQ) = ZERO + BUTSLL(IQ) = ZERO + BUSTLL(IQ) = ZERO + AUSTLL(IQ) = ZERO + END IF +c right handed squark (identical flavour) pair production + QPE = S - FOUR*MR2(IQ) + IF (QPE.GE.ZERO) THEN + SQPE = SQRT(S*QPE) + PF = SQPE/S + TT = (SQPE*COSTH - S) / TWO + TT2 = TT**2 + UU = - S - TT + UU2 = UU**2 +c ~ ~* +c g g -> q q +c R R + CONE = CFC2*PF*((SQPE*PF*SN2TH)**2+MR4(IQ))/TT2/UU2 + CONN = CONE-CONE*S2/(TT2+UU2)/NC2 + CSTUR(IQ) = CONN*UU2 + CSUTR(IQ) = CONN*TT2 +c ~ ~ +c q q -> q q +c R R + TMG = TT+MR2(IQ)-MG2 + TMG2 = TMG**2 + UMG = UU+MR2(IQ)-MG2 + UMG2 = UMG**2 + BONE = AFAC*PF*MG2*S*(HALF-TMG*UMG/(TMG2+UMG2)/NC) + BSTURR(IQ) = BONE/TMG2 + BSUTRR(IQ) = BONE/UMG2 +c _ ~ ~* +c q q -> q q +c R R + AF = AFAC*PF*PF**2*SN2TH + BONE = AF/TMG2-AF*S/(HALF*S2+TMG2)/TMG/NC + BUTSRR(IQ) = BONE*S2 + BUSTRR(IQ) = BONE*TWO*TMG2 +c _ ~ ~* +c q q -> q'q' q =/= q' +c R R + AUSTRR(IQ) = TWO*AF + ELSE + CSTUR(IQ) = ZERO + CSUTR(IQ) = ZERO + BSTURR(IQ) = ZERO + BSUTRR(IQ) = ZERO + BUTSRR(IQ) = ZERO + BUSTRR(IQ) = ZERO + AUSTRR(IQ) = ZERO + END IF +c left and right handed squark (identical flavour) pair production + IQ1 = SSL + IQ + IQ2 = SSR + IQ + SM = RMASS(IQ1)+RMASS(IQ2) + QPE = S - SM**2 + IF (QPE.GE.ZERO) THEN + DM = RMASS(IQ1)-RMASS(IQ2) + SQPE = SQRT( QPE*(S-DM**2) ) + PF = SQPE/S + AF = AFAC*PF + TT = (SQPE*COSTH - S - SM*DM) / TWO + UU = - S - TT + TMG = TT + ML2(IQ) - MG2 + TMG2 = TMG**2 + UMG = UU + MR2(IQ) - MG2 + UMG2 = UMG**2 +c ~ ~ +c q q -> q q +c L R + BONE = AFAC*PF*SQPE**2*SN2TH + BSTULR(IQ) = BONE/TMG2 + BSUTLR(IQ) = BONE/UMG2 +c _ ~ ~* +c q q -> q q +c L R + BUTSLR(IQ) = AFAC*PF*MG2*S/TMG2 + BUSTLR(IQ) = ZERO + TT = (SQPE*COSTH - S + SM*DM) / TWO + UU = - S - TT + TMG = TT + MR2(IQ) - MG2 + TMG2 = TMG**2 + UMG = UU + ML2(IQ) - MG2 + UMG2 = UMG**2 +c ~ ~ +c q q -> q q +c R L +c BONE = AFAC*PF*SQPE**2*SN2TH +c BSTURL(IQ) = BONE/TMG2 +c BSUTRL(IQ) = BONE/UMG2 + BSTURL(IQ) = ZERO + BSUTRL(IQ) = ZERO +c _ ~ ~* +c q q -> q q +c R L + BUTSRL(IQ) = AFAC*PF*MG2*S/TMG2 + BUSTRL(IQ) = ZERO + ELSE + BSTULR(IQ) = ZERO + BSUTLR(IQ) = ZERO + BUTSLR(IQ) = ZERO + BUSTLR(IQ) = ZERO + BSTURL(IQ) = ZERO + BSUTRL(IQ) = ZERO + BUTSRL(IQ) = ZERO + BUSTRL(IQ) = ZERO + END IF + 22 CONTINUE +c distinct flavours - gq, qq' + DO 11 ID1 = 1, 6 + IQ1 = SSL + ID1 + SM = RMASS(GLU)+RMASS(IQ1) + QPE = S - SM**2 + IF (QPE.GE.ZERO) THEN + DM = RMASS(GLU)-RMASS(IQ1) + SQPE = SQRT( QPE*(S-DM**2) ) + PF = SQPE/S + TT = (SQPE*COSTH - S - SM*DM) / TWO + TT2 = TT**2 + UU = - S - TT + UU2 = UU**2 +c ~ ~ +c g q -> g q +c L + CONE = (-UU+TWO*SM*DM*(ONE+MG2/TT+ML2(ID1)/UU))/S/TT/UU + CONN = CFC3*PF*CONE*(ONE-TT2/(UU2+S2)/NC2) + CTSUL(ID1) = CONN*UU2 + CTUSL(ID1) = CONN*S2 + ELSE + CTSUL(ID1) = ZERO + CTUSL(ID1) = ZERO + END IF + IQ2 = SSR + ID1 + SM = RMASS(GLU)+RMASS(IQ2) + QPE = S - SM**2 + IF (QPE.GE.ZERO) THEN + DM = RMASS(GLU)-RMASS(IQ2) + SQPE = SQRT( QPE*(S-DM**2) ) + PF = SQPE/S + TT = (SQPE*COSTH - S - SM*DM) / TWO + TT2 = TT**2 + UU = - S - TT + UU2 = UU**2 +c ~ ~ +c g q -> g q +c R + CONE = (-UU+TWO*SM*DM*(ONE+MG2/TT+MR2(ID1)/UU))/S/TT/UU + CONN = CFC3*PF*CONE*(ONE-TT2/(UU2+S2)/NC2) + CTSUR(ID1) = CONN*UU2 + CTUSR(ID1) = CONN*S2 + ELSE + CTSUR(ID1) = ZERO + CTUSR(ID1) = ZERO + END IF + IF(ID1.EQ.6) GOTO 11 + ID2MIN = ID1+1 + DO 12 ID2 = ID2MIN, 6 + IQ1 = SSL + ID1 + IQ2 = SSL + ID2 + SM = RMASS(IQ1)+RMASS(IQ2) + QPE = S - SM**2 + IF (QPE.GE.ZERO) THEN + DM = RMASS(IQ1)-RMASS(IQ2) + SQPE = SQRT( QPE*(S-DM**2) ) + PF = SQPE/S + TT = (SQPE*COSTH - S - SM*DM) / TWO + UU = - S - TT + TMG = TT+ML2(ID1)-MG2 + AF = AFAC*PF/TMG/TMG +c ~ ~ +c q q' -> q q' +c L L + ASTULL(ID1,ID2) = AF*MG2*S + ASTULL(ID2,ID1) = ASTULL(ID1,ID2) +c _ ~ ~* +c q q' -> q q' +c L L + AUTSLL(ID1,ID2) = AF*SQPE**2*SN2TH + AUTSLL(ID2,ID1) = AUTSLL(ID1,ID2) + ELSE + ASTULL(ID1,ID2) = ZERO + ASTULL(ID2,ID1) = ZERO + AUTSLL(ID1,ID2) = ZERO + AUTSLL(ID2,ID1) = ZERO + END IF + IQ1 = SSR + ID1 + IQ2 = SSR + ID2 + SM = RMASS(IQ1)+RMASS(IQ2) + QPE = S - SM**2 + IF (QPE.GE.ZERO) THEN + DM = RMASS(IQ1)-RMASS(IQ2) + SQPE = SQRT( QPE*(S-DM**2) ) + PF = SQPE/S + TT = (SQPE*COSTH - S - SM*DM) / TWO + UU = - S - TT + TMG = TT+MR2(ID1)-MG2 + AF = AFAC*PF/TMG/TMG +c ~ ~ +c q q' -> q q' +c R R + ASTURR(ID1,ID2) = AF*MG2*S + ASTURR(ID2,ID1) = ASTURR(ID1,ID2) +c _ ~ ~* +c q q' -> q q' +c R R + AUTSRR(ID1,ID2) = AF*SQPE**2*SN2TH + AUTSRR(ID2,ID1) = AUTSRR(ID1,ID2) + ELSE + ASTURR(ID1,ID2) = ZERO + ASTURR(ID2,ID1) = ZERO + AUTSRR(ID1,ID2) = ZERO + AUTSRR(ID2,ID1) = ZERO + END IF + IQ1 = SSL + ID1 + IQ2 = SSR + ID2 + SM = RMASS(IQ1)+RMASS(IQ2) + QPE = S - SM**2 + IF (QPE.GE.ZERO) THEN + DM = RMASS(IQ1)-RMASS(IQ2) + SQPE = SQRT( QPE*(S-DM**2) ) + PF = SQPE/S + TT = (SQPE*COSTH - S - SM*DM) / TWO + UU = - S - TT + TMG = TT+ML2(ID1)-MG2 + AF = AFAC*PF/TMG/TMG +c ~ ~ +c q q' -> q q' +c L R + ASTULR(ID1,ID2) = AF*SQPE**2*SN2TH + ASTULR(ID2,ID1) = ASTULR(ID1,ID2) +c _ ~ ~* +c q q' -> q q' +c L R + AUTSLR(ID1,ID2) = AF*MG2*S + AUTSLR(ID2,ID1) = AUTSLR(ID1,ID2) + TT = (SQPE*COSTH - S + SM*DM) / TWO + UU = - S - TT + TMG = TT+MR2(ID1)-MG2 + AF = AFAC*PF/TMG/TMG +c ~ ~ +c q q' -> q q' +c R L + ASTURL(ID1,ID2) = AF*SQPE**2*SN2TH + ASTURL(ID2,ID1) = ASTULR(ID1,ID2) +c _ ~ ~* +c q q' -> q q' +c R L + AUTSRL(ID1,ID2) = AF*MG2*S + AUTSRL(ID2,ID1) = AUTSLR(ID1,ID2) + ELSE + ASTULR(ID1,ID2) = ZERO + ASTULR(ID2,ID1) = ZERO + AUTSLR(ID1,ID2) = ZERO + AUTSLR(ID2,ID1) = ZERO + ASTURL(ID1,ID2) = ZERO + ASTURL(ID2,ID1) = ZERO + AUTSRL(ID1,ID2) = ZERO + AUTSRL(ID2,ID1) = ZERO + END IF + 12 CONTINUE + 11 CONTINUE + END IF + HCS = ZERO + DO 6 ID1 = 1, 13 + IF (DISF(ID1,1).LT.EPS) GOTO 6 + DO 5 ID2 = 1, 13 + IF (DISF(ID2,2).LT.EPS) GOTO 5 + DIST = DISF(ID1,1)*DISF(ID2,2) + + IF (ID1.LT.7) THEN + IQ1 = ID1 + IF (ID2.LT.7) THEN + IQ2 = ID2 + IF (IQ1.NE.IQ2) THEN +c ~ ~ +c qq' -> q q' + HCS = HCS + ASTULL(IQ1,IQ2)*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,0,IQ2,0,3421,10,*9) + HCS = HCS + ASTURR(IQ1,IQ2)*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,2,IQ2,2,3421,10,*9) + HCS = HCS + ASTULR(IQ1,IQ2)*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,0,IQ2,2,3421,10,*9) + HCS = HCS + ASTURL(IQ1,IQ2)*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,2,IQ2,0,3421,10,*9) + ELSE +c ~ ~ +c qq -> q q + HCS = HCS + BSTULL(IQ1)*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,0,IQ2,0,3421,10,*9) + HCS = HCS + BSTURR(IQ1)*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,2,IQ2,2,3421,10,*9) + HCS = HCS + BSTULR(IQ1)*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,0,IQ2,2,3421,10,*9) + HCS = HCS + BSTURL(IQ1)*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,2,IQ2,0,3421,10,*9) + HCS = HCS + BSUTLL(IQ1)*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,0,IQ2,0,4312,10,*9) + HCS = HCS + BSUTRR(IQ1)*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,2,IQ2,2,4312,10,*9) + HCS = HCS + BSUTLR(IQ1)*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,0,IQ2,2,4312,10,*9) + HCS = HCS + BSUTRL(IQ1)*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,2,IQ2,0,4312,10,*9) + END IF + ELSEIF (ID2.NE.13) THEN + IQ2 = ID2-6 + IF (IQ1.NE.IQ2) THEN +c _ ~ ~* +c qq' -> q q' + HCS = HCS + AUTSLL(IQ1,IQ2)*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,0,IQ2,1,3142,10,*9) + HCS = HCS + AUTSRR(IQ1,IQ2)*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,2,IQ2,3,3142,10,*9) + HCS = HCS + AUTSLR(IQ1,IQ2)*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,0,IQ2,3,3142,10,*9) + HCS = HCS + AUTSRL(IQ1,IQ2)*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,2,IQ2,1,3142,10,*9) + ELSE +c _ ~ ~* +c qq -> q'q' (q =/= q') + DO 30 IQ = 1, 6 + IF (IQ .EQ.IQ1) GOTO 30 + HCS = HCS + AUSTLL(IQ )*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ ,0,IQ ,1,2413,10,*9) + HCS = HCS + AUSTRR(IQ )*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ ,2,IQ ,3,2413,10,*9) + 30 CONTINUE +c _ ~ ~* +c qq -> q q + HCS = HCS + BUTSLL(IQ1)*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,0,IQ2,1,3142,10,*9) + HCS = HCS + BUTSRR(IQ1)*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,2,IQ2,3,3142,10,*9) + HCS = HCS + BUTSLR(IQ1)*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,0,IQ2,3,3142,10,*9) + HCS = HCS + BUTSRL(IQ1)*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,2,IQ2,1,3142,10,*9) + HCS = HCS + BUSTLL(IQ1)*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,0,IQ2,1,2413,10,*9) + HCS = HCS + BUSTRR(IQ1)*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,2,IQ2,3,2413,10,*9) + HCS = HCS + BUSTLR(IQ1)*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,0,IQ2,3,2413,10,*9) + HCS = HCS + BUSTRL(IQ1)*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,2,IQ2,1,2413,10,*9) + IQ = IGL +c _ ~ ~ +c qq -> g g + HCS = HCS + CSTU(IQ1)*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ ,0,IQ ,0,2413,10,*9) + HCS = HCS + CSUT(IQ1)*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ ,0,IQ ,0,2341,10,*9) + END IF + ELSE + IQ2 = IGL +c ~ ~ +c qg -> q g + HCS = HCS + CTSUL(IQ1)*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,0,IQ2,0,3142,10,*9) + HCS = HCS + CTSUR(IQ1)*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,2,IQ2,0,3142,10,*9) + HCS = HCS + CTUSL(IQ1)*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,0,IQ2,0,3421,10,*9) + HCS = HCS + CTUSR(IQ1)*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,2,IQ2,0,3421,10,*9) + END IF + ELSEIF (ID1.NE.13) THEN + IQ1 = ID1 - 6 + IF (ID2.LT.7) THEN + IQ2 = ID2 + IF (IQ1.NE.IQ2) THEN +c _ ~*~ +c qq' -> q q' + HCS = HCS + AUTSLL(IQ1,IQ2)*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,1,IQ2,0,2413,10,*9) + HCS = HCS + AUTSRR(IQ1,IQ2)*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,3,IQ2,2,2413,10,*9) + HCS = HCS + AUTSLR(IQ1,IQ2)*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,1,IQ2,2,2413,10,*9) + HCS = HCS + AUTSRL(IQ1,IQ2)*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,3,IQ2,0,2413,10,*9) + ELSE +c _ ~*~ +c qq -> q'q' (q =/= q') + DO 31 IQ = 1, 6 + IF (IQ .EQ.IQ1) GOTO 31 + HCS = HCS + AUSTLL(IQ)*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ ,1,IQ ,0,3142,10,*9) + HCS = HCS + AUSTRR(IQ)*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ ,3,IQ ,2,3142,10,*9) + 31 CONTINUE +c _ ~*~ +c qq -> q q + HCS = HCS + BUTSLL(IQ1)*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,1,IQ2,0,2413,10,*9) + HCS = HCS + BUTSRR(IQ1)*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,3,IQ2,2,2413,10,*9) + HCS = HCS + BUTSLR(IQ1)*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,1,IQ2,2,2413,10,*9) + HCS = HCS + BUTSRL(IQ1)*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,3,IQ2,0,2413,10,*9) + HCS = HCS + BUSTLL(IQ1)*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,1,IQ2,0,3142,10,*9) + HCS = HCS + BUSTRR(IQ1)*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,3,IQ2,2,3142,10,*9) + HCS = HCS + BUSTLR(IQ1)*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,1,IQ2,2,3142,10,*9) + HCS = HCS + BUSTRL(IQ1)*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,3,IQ2,0,3142,10,*9) +c _ ~ ~ +c qq -> g g + HCS = HCS + CSTU(IQ1)*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IGL,0,IGL,0,3142,10,*9) + HCS = HCS + CSUT(IQ1)*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IGL,0,IGL,0,4123,10,*9) + END IF + ELSEIF (ID2.NE.13) THEN + IQ2 = ID2 - 6 + IF (IQ1.NE.IQ2) THEN +c __ ~*~* +c qq' -> q q' + HCS = HCS + ASTULL(IQ1,IQ2)*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,1,IQ2,1,4312,10,*9) + HCS = HCS + ASTURR(IQ1,IQ2)*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,3,IQ2,3,4312,10,*9) + HCS = HCS + ASTULR(IQ1,IQ2)*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,1,IQ2,3,4312,10,*9) + HCS = HCS + ASTURL(IQ1,IQ2)*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,3,IQ2,1,4312,10,*9) + ELSE +c __ ~*~* +c qq -> q q + HCS = HCS + BSTULL(IQ1)*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,1,IQ2,1,4312,10,*9) + HCS = HCS + BSTURR(IQ1)*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,3,IQ2,3,4312,10,*9) + HCS = HCS + BSTULR(IQ1)*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,1,IQ2,3,4312,10,*9) + HCS = HCS + BSTURL(IQ1)*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,3,IQ2,1,4312,10,*9) + HCS = HCS + BSUTLL(IQ1)*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,1,IQ2,1,3421,10,*9) + HCS = HCS + BSUTRR(IQ1)*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,3,IQ2,3,3421,10,*9) + HCS = HCS + BSUTLR(IQ1)*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,1,IQ2,3,3421,10,*9) + HCS = HCS + BSUTRL(IQ1)*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,3,IQ2,1,3421,10,*9) + END IF + ELSE + IQ2 = IGL +c _ ~*~ +c qg -> q g + HCS = HCS + CTSUL(IQ1)*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,1,IQ2,0,2413,10,*9) + HCS = HCS + CTSUR(IQ1)*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,3,IQ2,0,2413,10,*9) + HCS = HCS + CTUSL(IQ1)*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,1,IQ2,0,4312,10,*9) + HCS = HCS + CTUSR(IQ1)*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,3,IQ2,0,4312,10,*9) + END IF + ELSE + IQ1 = IGL + IF (ID2.LT.7) THEN + IQ2 = ID2 +c ~ ~ +c gq -> g q + HCS = HCS + CTSUL(IQ2)*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,0,IQ2,0,2413,10,*9) + HCS = HCS + CTSUR(IQ2)*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,0,IQ2,2,2413,10,*9) + HCS = HCS + CTUSL(IQ2)*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,0,IQ2,0,3421,10,*9) + HCS = HCS + CTUSR(IQ2)*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,0,IQ2,2,3421,10,*9) + ELSEIF (ID2.LT.13) THEN + IQ2 = ID2 - 6 +c _ ~ ~* +c gq -> g q + HCS = HCS + CTSUL(IQ2)*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,0,IQ2,1,3142,10,*9) + HCS = HCS + CTSUR(IQ2)*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,0,IQ2,3,3142,10,*9) + HCS = HCS + CTUSL(IQ2)*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,0,IQ2,1,4312,10,*9) + HCS = HCS + CTUSR(IQ2)*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,0,IQ2,3,4312,10,*9) + ELSE + IQ2 = IGL +c ~ ~* +c gg -> q q + DO 32 IQ = 1, 6 + HCS = HCS + CSTUL(IQ)*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ ,0,IQ ,1,2413,10,*9) + HCS = HCS + CSTUR(IQ)*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ ,2,IQ ,3,2413,10,*9) + HCS = HCS + CSUTL(IQ)*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ ,0,IQ ,1,4123,10,*9) + HCS = HCS + CSUTR(IQ)*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ ,2,IQ ,3,4123,10,*9) + 32 CONTINUE +c ~ ~ +c gg -> g g + HCS = HCS + DTSU*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,0,IQ2,0,2341,10,*9) + HCS = HCS + DSTU*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,0,IQ2,0,3421,10,*9) + HCS = HCS + DUTS*DIST + IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,0,IQ2,0,2413,10,*9) + END IF + END IF + 5 CONTINUE + 6 CONTINUE + EVWGT = HCS + RETURN +C---GENERATE EVENT + 9 IDN(1)=ID1 + IDN(2)=ID2 + IDCMF=15 + CALL HWETWO + IF (AZSPIN) THEN +C Calculate coefficients for constructing spin density matrices +C Set to zero for now + CALL HWVZRO(7,GCOEF) + END IF + 999 END +CDECK ID>, HWHSSP. +*CMZ :- -25/06/99 20.33.45 by Kosuke Odagiri +*-- Author : Kosuke Odagiri & Bryan Webber +C----------------------------------------------------------------------- + SUBROUTINE HWHSSP +C----------------------------------------------------------------------- +C SUSY HARD 2 PARTON -> 2 SPARTON/GAUGINO/SLEPTON PROCESSES +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + DOUBLE PRECISION SAVWT(3),RANWT,HWR,HWRUNI,Z1,Z2,ET,EJ, + & QPE,S,T,U,KK,KK2,YJ1INF,YJ1SUP,YJ2INF,YJ2SUP,SVEMSC + INTEGER ISP + EXTERNAL HWR,HWRUNI + SAVE SAVWT,SVEMSC + IF (.NOT.GENEV) THEN + EVWGT=ZERO + CALL HWRPOW(ET,EJ) + KK = ET/PHEP(5,3) + KK2=KK**2 + IF (KK.GE.ONE) RETURN + YJ1INF = MAX( YJMIN, LOG((ONE-SQRT(ONE-KK2))/KK) ) + YJ1SUP = MIN( YJMAX, LOG((ONE+SQRT(ONE-KK2))/KK) ) + IF (YJ1INF.GE.YJ1SUP) RETURN + Z1=EXP(HWRUNI(1,YJ1INF,YJ1SUP)) + YJ2INF = MAX( YJMIN, -LOG(TWO/KK-ONE/Z1) ) + YJ2SUP = MIN( YJMAX, LOG(TWO/KK-Z1) ) + IF (YJ2INF.GE.YJ2SUP) RETURN + Z2=EXP(HWRUNI(2,YJ2INF,YJ2SUP)) + XX(1)=HALF*(Z1+Z2)*KK + IF (XX(1).GE.ONE) RETURN + XX(2)=XX(1)/(Z1*Z2) + IF (XX(2).GE.ONE) RETURN + S=XX(1)*XX(2)*PHEP(5,3)**2 + QPE=S-(TWO*RMMNSS)**2 + IF (QPE.LE.ZERO) RETURN + COSTH=HALF*ET*(Z1-Z2)/SQRT(Z1*Z2*QPE) + IF (ABS(COSTH).GT.ONE) RETURN + T=-(ONE+Z2/Z1)*(HALF*ET)**2 + U=-S-T +C---SET EMSCA TO HEAVY HARD PROCESS SCALE + SVEMSC = SQRT(TWO*S*T*U/(S*S+T*T+U*U)) + FACTSS = GEV2NB*HALF*PIFAC*EJ*ET/S**2 + & * (YJ1SUP-YJ1INF)*(YJ2SUP-YJ2INF) + & * SQRT(S/QPE) + ENDIF + EMSCA=SVEMSC + ISP=MOD(IPROC,100) + IF (ISP.EQ.0) THEN + IF (GENEV) THEN + RANWT=SAVWT(3)*HWR() + IF (RANWT.LT.SAVWT(1)) THEN + CALL HWHSSQ + ELSEIF (RANWT.LT.SAVWT(2)) THEN + CALL HWHSSG + ELSE + CALL HWHSSL + ENDIF + ELSE + CALL HWHSSQ + SAVWT(1)=EVWGT + CALL HWHSSG + SAVWT(2)=SAVWT(1)+EVWGT + CALL HWHSSL + SAVWT(3)=SAVWT(2)+EVWGT + EVWGT=SAVWT(3) + ENDIF + ELSEIF (ISP.EQ.10) THEN + CALL HWHSSQ + ELSEIF (ISP.EQ.20) THEN + CALL HWHSSG + ELSEIF (ISP.EQ.30) THEN + CALL HWHSSL + ELSE +C---UNRECOGNIZED PROCESS + CALL HWWARN('HWHSSP',500,*999) + ENDIF + 999 END +CDECK ID>, HWHSSS. +*CMZ :- -18/05/99 20.33.45 by Kosuke Odagiri +*-- Author : Kosuke Odagiri +C----------------------------------------------------------------------- + SUBROUTINE HWHSSS(ID3,R3,ID4,R4,IPERM,IHPR,*) +C----------------------------------------------------------------------- +C IDENTIFIES HARD SUSY SUBPROCESS +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + INTEGER ID3, R3, ID4, R4, IPERM, IHPR, SSL + PARAMETER (SSL = 400) + IHPRO = 3000 + IHPR + IDN(3) = SSL + ID3 + R3*6 + IDN(4) = SSL + ID4 + R4*6 + ICO(1) = IPERM/1000 + ICO(2) = IPERM/100 - 10*ICO(1) + ICO(3) = IPERM/10 - 10*(IPERM/100) + ICO(4) = IPERM - 10*(IPERM/10) + RETURN 1 + END +CDECK ID>, HWHV1J. +*CMZ :- -18/05/99 14.37.45 by Mike Seymour +*-- Author : Mike Seymour +C----------------------------------------------------------------------- + SUBROUTINE HWHV1J +C----------------------------------------------------------------------- +C V + 1 JET PRODUCTION, WHERE V=W (IHPRO.LT.5) OR Z (IHPRO.GE.5). +C USES CROSS-SECTIONS OF EHLQ FOR ANNIHILATION AND COMPTON SCATTERING +C IHPRO=0 FOR BOTH, 1 FOR ANNIHILATION, AND 2 FOR COMPTON. +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + DOUBLE PRECISION HWR,HWRUNI,DISFAC(2,12,2),EMV2,DISMAX,S,T,U, + & SHAT,THAT,UHAT,Z,HWUALF,PT,EMT,GFACTR,SIGANN,SIGCOM(2),CSFAC,ET, + & EJ,YMIN,YMAX,VYMIN,VYMAX,EMAX,CV,CA,BR,EMV,GAMV + INTEGER HWRINT,IDINIT(2,12,2),ICOFLO(4,2),I,J,K,L,M,ID1,ID2, + $ IDV,IDI,IDM + EXTERNAL HWRINT + SAVE DISFAC,SHAT,THAT,EMV,EMV2,IDV,IDI +C---IDINIT HOLDS THE INITIAL STATES FOR ANNIHILATION PROCESSES + DATA IDINIT/1,8,2,7,3,10,4,9,5,12,6,11,1,10,2,9,3,8,4,7,5,12,6,11, + $ 1,7,2,8,3,9,4,10,5,11,6,12,1,7,2,8,3,9,4,10,5,11,6,12/ +C---ICOFLO HOLDS THE COLOR FLOW FOR EACH PROCESS +C---DISFAC HOLDS THE DISTRIBUTION FUNCTION*CROSS-SECTION FOR EACH +C POSSIBLE SUB-PROCESS. +C INDEX1=INITIAL STATE PERMUTATION (1=AS IDINIT/QG;2=OPPOSITE/GQ), +C 2=QUARK (FOR ANNIHILATION, >6 IMPLIES CABIBBO ROTATED PAIR), +C 3=PROCESS (1=ANNIHILATION, 2=COMPTON) + DATA ICOFLO,DISFAC/2,4,3,1,4,1,3,2,48*0./ + IF (GENEV) THEN + DISMAX=0 + DO 110 I=1,2 + DO 110 J=1,12 + DO 110 K=1,2 + 110 DISMAX=MAX(DISFAC(K,J,I),DISMAX) + 120 I=HWRINT(1,2) + J=HWRINT(1,12) + K=HWRINT(1,2) + IF (HWR()*DISMAX.GT.DISFAC(K,J,I)) GOTO 120 + IF (I.EQ.1) THEN +C---ANNIHILATION + IDN(1)=IDINIT(K,J,IDI) + IDN(2)=IDINIT(3-K,J,IDI) + IDN(4)=13 + ELSE +C---COMPTON SCATTERING + IDN(1)=J + IDN(2)=13 + IF (IDV.EQ.200) THEN + IDN(4)=J + ELSE + IF (J.EQ.5.OR.J.EQ.6.OR.J.GE.11.OR.HWR().GT.SCABI) THEN +C---CHANGE QUARKS (1->2,2->1,3->4,4->3,...) + IDN(4)=4*INT((J-1)/2)-J+3 + ELSE +C---CHANGE AND CABIBBO ROTATE QUARKS (1->4,2->3,3->2,...) + IDN(4)=12*INT((J-1)/6)-J+5 + ENDIF + ENDIF + IF ((SQRT(EMV2)+RMASS(IDN(4)))**2.GT.SHAT) GOTO 120 + IF (K.EQ.2) THEN +C---SWAP INITIAL STATES + IDN(3)=IDN(1) + IDN(1)=IDN(2) + IDN(2)=IDN(3) + ENDIF + ENDIF + IF (IDV.EQ.200) THEN + IDN(3)=200 + ELSE +C---W+ OR W-? USE CHARGE CONSERVATION TO WORK OUT + IDN(3)=NINT(198.5-.1667*FLOAT(ICHRG(IDN(1))+ICHRG(IDN(2)))) + ENDIF + M=K + IF (I.EQ.2.AND.J.LE.6) M=3-K + DO 130 L=1,4 + 130 ICO(L)=ICOFLO(L,M) + IDCMF=15 + COSTH=(SHAT+2*THAT-EMV2)/(SHAT-EMV2) +C---TRICK HWETWO INTO USING THE OFF-SHELL V MASS + RMASS(IDN(3))=SQRT(EMV2) + CALL HWETWO + RMASS(IDN(3))=EMV + RHOHEP(1,NHEP-1)=0.5 + RHOHEP(2,NHEP-1)=0.0 + RHOHEP(3,NHEP-1)=0.5 + ELSE + EVWGT=0. + IHPRO=MOD(IPROC,100)/10 + IF (IHPRO.LT.5) THEN + IDV=198 + IDI=1 + IDM=10 + GAMV=GAMW + ELSE + IDV=200 + IDI=2 + IDM=6 + GAMV=GAMZ + IHPRO=IHPRO-5 + ENDIF + EMV=RMASS(IDV) + EMV2=EMV*(EMV+GAMV*TAN(HWRUNI(0,-ONE-HALF,ONE+HALF))) + IF (EMV2.LE.ZERO) RETURN + CALL HWRPOW(ET,EJ) + PT=0.5*ET + EMT=SQRT(PT**2+EMV2) + EMAX=0.5*(PHEP(5,3)+EMV2/PHEP(5,3)) + IF (EMAX.LE.EMT) RETURN + VYMAX=0.5*LOG((EMAX+SQRT(EMAX**2-EMT**2)) + & /(EMAX-SQRT(EMAX**2-EMT**2))) + VYMIN=-VYMAX + IF (VYMAX.LE.VYMIN) RETURN + Z=EXP(HWRUNI(0,VYMIN,VYMAX)) + S= PHEP(5,3)**2 + T=-PHEP(5,3)*EMT/Z+EMV2 + U=-PHEP(5,3)*EMT*Z+EMV2 + XXMIN=-U/(S+T-EMV2) + IF (XXMIN.LT.ZERO.OR.XXMIN.GT.ONE) RETURN + YMIN=MAX(LOG((XXMIN*PHEP(5,3)-EMT*Z)/PT),YJMIN) + YMAX=MIN(LOG((PHEP(5,3)-EMT*Z)/PT),YJMAX) + IF (YMAX.LE.YMIN) RETURN + XX(1)=(Z*EMT+EXP(HWRUNI(2,YMIN,YMAX))*PT)/PHEP(5,3) + IF (XX(1).LE.ZERO.OR.XX(1).GT.ONE) RETURN + THAT =XX(1)*T+(1.-XX(1))*EMV2 + XX(2)=-THAT / (XX(1)*S+U-EMV2) + IF (XX(2).LT.ZERO.OR.XX(2).GT.ONE) RETURN + UHAT =XX(2)*U+(1.-XX(2))*EMV2 + SHAT =XX(1)*XX(2)*S + EMSCA=EMT + CALL HWSGEN(.FALSE.) + GFACTR=GEV2NB*2.*PIFAC*ALPHEM*HWUALF(1,EMSCA)/(9.*SWEIN) + SIGANN=GFACTR*((THAT-EMV2)**2+(UHAT-EMV2)**2) + & /(SHAT**2*THAT*UHAT) + SIGCOM(2)=.375*GFACTR*(SHAT**2+UHAT**2+2*EMV2*THAT) + & /(-UHAT*SHAT**3) + SIGCOM(1)=.375*GFACTR*(SHAT**2+THAT**2+2*EMV2*UHAT) + & /(-THAT*SHAT**3) +C---IF USER SPECIFIED A SUB-PROCESS, ZERO THE OTHER + IF (IHPRO.EQ.1) THEN + SIGCOM(1)=0. + SIGCOM(2)=0. + ENDIF + IF (IHPRO.EQ.2) SIGANN=0. + DO 210 I=1,IDM + IF (IDV.EQ.200) THEN + J=I + IF(I.GT.6) J=I-6 + DISFAC(1,I,1)=4*SWEIN*(VFCH(J,1)**2+AFCH(J,1)**2) + ELSE + IF (I.LE.4) THEN + DISFAC(1,I,1)=1-SCABI + ELSEIF (I.GE.7) THEN + DISFAC(1,I,1)=SCABI + ELSE + DISFAC(1,I,1)=1. + ENDIF + ENDIF + DISFAC(2,I,1)=DISFAC(1,I,1) * + & SIGANN*DISF(IDINIT(1,I,IDI),2)*DISF(IDINIT(2,I,IDI),1) + DISFAC(1,I,1)=DISFAC(1,I,1) * + & SIGANN*DISF(IDINIT(1,I,IDI),1)*DISF(IDINIT(2,I,IDI),2) + 210 CONTINUE + DO 211 I=IDM+1,12 + DISFAC(1,I,1)=0 + DISFAC(2,I,1)=0 + 211 CONTINUE + DO 220 I=1,12 + IF (IDV.EQ.200) THEN + J=I + IF(I.GT.6) J=I-6 + DISFAC(1,I,2)=4*SWEIN*(VFCH(J,1)**2+AFCH(J,1)**2) + ELSE + DISFAC(1,I,2)=1. + ENDIF + DISFAC(2,I,2)=DISFAC(1,I,2)*SIGCOM(2)*DISF(I,2)*DISF(13,1) + DISFAC(1,I,2)=DISFAC(1,I,2)*SIGCOM(1)*DISF(I,1)*DISF(13,2) + 220 CONTINUE + DO 230 I=1,2 + DO 230 J=1,12 + DO 230 K=1,2 + 230 EVWGT=EVWGT+DISFAC(K,J,I) + CSFAC=PT*EJ*(YMAX-YMIN)*(VYMAX-VYMIN)*THREE/PIFAC +C---INCLUDE BRANCHING RATIO OF V + CALL HWDBOZ(IDV,ID1,ID2,CV,CA,BR,0) + EVWGT=EVWGT*CSFAC*BR + ENDIF + 999 END +CDECK ID>, HWHWEX. +*CMZ :- -26/04/91 14.55.45 by Federico Carminati +*-- Author : Mike Seymour +C----------------------------------------------------------------------- + SUBROUTINE HWHWEX +C----------------------------------------------------------------------- +C TOP QUARK PRODUCTION VIA W EXCHANGE: MEAN EVWGT=TOP PROD C-S IN NB +C C-S IS SUM OF: +C UbarBbar, DBbar, DbarB, UB, CbarBbar, SBbar, SbarB, AND CB +C UNLESS USER SPECIFIES OTHERWISE BY MOD(IPROC,100)=1-8 RESPECTIVELY +C---DSDCOS HOLDS THE CROSS-SECTIONS FOR THE PROCESSES LISTED ABOVE +C (1-8) ARE WITH B FROM BEAM 1, (9-16) ARE WITH B FROM BEAM 2. +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + DOUBLE PRECISION HWR,HWRUNI,DSDCOS(16),EMT2,EMT,EMW2,EMW, + & CMFMIN,TAUMIN,TAUMLN,S,T,U,ROOTS,DSMAX + INTEGER HWRINT,IDHWEX(2,16),I + EXTERNAL HWR,HWRUNI,HWRINT + SAVE DSDCOS,DSMAX + EQUIVALENCE (EMW,RMASS(198)),(EMT,RMASS(6)) +C---IDHWEX HOLDS THE IDs OF THE INCOMING PARTICLES FOR EACH SUB-PROCESS + DATA IDHWEX/11,8,11,1,5,7,5,2,11,10,11,3,5,9,5,4, + & 8,11,1,11,7,5,2,5,10,11,3,11,9,5,4,5/ + EMT2=EMT**2 + EMW2=EMW**2 + IF (GENEV) THEN + 300 IHPRO=HWRINT(1,16) + IF (HWR().GT.DSDCOS(IHPRO)/DSMAX) GOTO 300 + DO 10 I=1,2 + IDN(I)=IDHWEX(I,IHPRO) + IF (IDN(I).EQ.5 .OR. IDN(I).EQ.11) THEN +C---CHANGE B QUARK INTO T QUARK + IDN(I+2)=IDN(I)+1 + ELSEIF (HWR().GT.SCABI) THEN +C---CHANGE QUARKS (1->2,2->1,3->4,4->3,7->8,8->7,...) + IDN(I+2)=4*INT((IDN(I)-1)/2)-IDN(I)+3 + ELSE +C---CHANGE AND CABIBBO ROTATE QUARKS (1->4,2->3,3->2,4->1,7->10,...) + IDN(I+2)=12*INT((IDN(I)-1)/6)-IDN(I)+5 + ENDIF + ICO(I)=I+2 + ICO(I+2)=I + 10 CONTINUE + IDCMF=15 + CALL HWETWO + ELSE + EVWGT=0. + CMFMIN=EMT + TAUMIN=(CMFMIN/PHEP(5,3))**2 + TAUMLN=LOG(TAUMIN) + ROOTS=PHEP(5,3)*SQRT(EXP(HWRUNI(0,ZERO,TAUMLN))) + XXMIN=(ROOTS/PHEP(5,3))**2 + XLMIN=LOG(XXMIN) + COSTH=HWRUNI(0,-ONE, ONE) + S=ROOTS**2 + T=-0.5*S*(1-COSTH) + U=-0.5*S*(1+COSTH) + EMSCA=SQRT(2*S*T*U/(S*S+T*T+U*U)) + DSDCOS(1)=GEV2NB*PIFAC*.125*(ALPHEM/SWEIN)**2 + & *(S-EMT2)**2 / S / (EMW2 + 0.5*(S-EMT2)*(1-COSTH))**2 + DSDCOS(2)=DSDCOS(1) / 4 + & * (1 + EMT2/S + 2*COSTH + (1-EMT2/S)*COSTH**2) + DSDCOS(3)=DSDCOS(2) + DSDCOS(4)=DSDCOS(1) +C---IF USER SPECIFIED SUB-PROCESS THEN ZERO ALL THE OTHERS + IHPRO=MOD(IPROC,100) + IF (IHPRO.GT.8) THEN + CALL HWWARN('HWHWEX',1,*999) + IHPRO=0 + ENDIF + DO 100 I=1,8 + IF (I.LE.4) DSDCOS(I+4)=DSDCOS(I) + IF (IHPRO.NE.0 .AND. IHPRO.NE.I) DSDCOS(I)=0 + DSDCOS(I+8)=DSDCOS(I) + 100 CONTINUE + CALL HWSGEN(.TRUE.) + DSMAX=0 + DO 200 I=1,16 + DSDCOS(I)=DSDCOS(I)*DISF(IDHWEX(1,I),1)*DISF(IDHWEX(2,I),2) + EVWGT=EVWGT + 2*TAUMLN*XLMIN*DSDCOS(I) + IF (DSDCOS(I).GT.DSMAX) DSMAX=DSDCOS(I) + 200 CONTINUE + ENDIF + 999 END +CDECK ID>, HWHWPR. +*CMZ :- -18/05/99 14.22.13 by Mike Seymour +*-- Author : Bryan Webber +C----------------------------------------------------------------------- + SUBROUTINE HWHWPR +C----------------------------------------------------------------------- +C W+/- PRODUCTION AND DECAY VIA DRELL-YAN PROCESS +C MEAN EVWGT IS SIG(W+/-)*(BRANCHING FRACTION) IN NB +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + DOUBLE PRECISION HWR,HWRUNI,HWUPCM,PRAN,PROB,COEF,CSFAC,EMW, + & FTQK,PTOP,ETOP,EBOT,PMAX,FHAD,FTOT,BRAF,FLEP,TMIN,HWUAEM + INTEGER HWRINT,ICH,IC,IL,ID,IDEC,JDEC,IWP(2,16) + LOGICAL HWRLOG + EXTERNAL HWR,HWRUNI,HWUPCM,HWRINT,HWRLOG + SAVE CSFAC,IDEC,FLEP,FTQK,ETOP,PTOP,EBOT,PMAX,PROB + DATA IWP/2,7,1,8,7,2,8,1,4,9,3,10,9,4,10,3, + & 2,9,3,8,9,2,8,3,4,7,1,10,7,4,10,1/ + IF (GENEV) THEN +C---GENERATE EVENT (X'S AND STRUCTURE FUNCTIONS ALREADY FOUND) + PRAN=PROB*HWR() +C---LOOP OVER PARTON FLAVOURS + PROB=0. + COEF=1.-SCABI + DO 10 IC=1,16 + IF (IC.EQ.9) COEF=SCABI + PROB=PROB+DISF(IWP(1,IC),1)*DISF(IWP(2,IC),2)*COEF + IF (PROB.GE.PRAN) GOTO 20 + 10 CONTINUE +C---STORE INCOMING PARTONS + 20 IDN(1)=IWP(1,IC) + IDN(2)=IWP(2,IC) + ICO(1)=2 + ICO(2)=1 +C---ICH=1/2 FOR W+/- + ICH=2-MOD(IC,2) + IF ((IDEC.GT.49.AND.IDEC.LT.54).OR. + & (IDEC.EQ.99.AND.HWRLOG(FLEP))) THEN +C---LEPTONIC DECAY + IL=IDEC-50 + IF (IL.EQ.0.OR.IL.GT.3) IL=HWRINT(1,3) + IDN(3)=2*IL+121-ICH + IDN(4)=2*IL+124+ICH +C---W DECAY ANGLE (1+COSTH)**2 + COSTH=2.*HWR()**0.3333-1. + ELSEIF (IDEC.EQ.5.OR.IDEC.EQ.6.OR. + & ((IDEC.EQ.0.OR.IDEC.EQ.99).AND.HWRLOG(FTQK))) THEN +C---W -> TOP + BOTTOM DECAY + IDN(3)=7-ICH + IDN(4)=10+ICH + 21 COSTH=HWRUNI(1,-ONE, ONE) + IF ((ETOP+(PTOP*COSTH))*(EBOT+(PTOP*COSTH)).LT. + & PMAX*HWR()) GOTO 21 + ELSE +C---OTHER HADRONIC DECAY + 25 PROB=0. + PRAN=2.*HWR() + COEF=1.-SCABI + DO 30 ID=ICH,16,4 + IF (ID.GT.8) COEF=SCABI + PROB=PROB+COEF + IF (PROB.GE.PRAN) THEN + IDN(3)=IWP(1,ID) + IDN(4)=IWP(2,ID) + GOTO 40 + ENDIF + 30 CONTINUE + 40 CONTINUE + IF (IDEC.GT.0.AND.IDEC.LT.5) THEN + JDEC=IDEC+6 + IF (IDN(3).NE.IDEC.AND.IDN(4).NE.IDEC + & .AND.IDN(3).NE.JDEC.AND.IDN(4).NE.JDEC) GOTO 25 + ENDIF + COSTH=2.*HWR()**0.3333-1. + ENDIF + IDCMF=197+ICH + IF (IDN(1).GT.6) COSTH=-COSTH + ICO(3)=4 + ICO(4)=3 + CALL HWETWO + ELSE + IDEC=MOD(IPROC,100) + IF (IDEC.EQ.5.OR.IDEC.EQ.6) THEN + TMIN=ATAN((RMASS(6)**2-RMASS(199)**2)/(GAMW*RMASS(199))) + ELSE + TMIN=-ATAN(RMASS(199)/GAMW) + ENDIF + EVWGT=0. + EMW=GAMW*TAN(HWRUNI(0,TMIN,PIFAC/2.))+RMASS(199) + IF (EMW.LE.ZERO) RETURN + EMW=SQRT(EMW*RMASS(199)) + IF (EMW.LE.QSPAC.OR.EMW.GE.PHEP(5,3)) RETURN + EMSCA=EMW + IF (EMLST.NE.EMW) THEN + EMLST=EMW + XXMIN=(EMW/PHEP(5,3))**2 + XLMIN=LOG(XXMIN) + CSFAC=-GEV2NB*PIFAC**2*HWUAEM(EMSCA**2) + & /(3.*SWEIN*RMASS(199)**2)*XLMIN +C---COMPUTE TOP AND LEPTONIC FRACTIONS + FTQK=0. + IF (NFLAV.GT.5) THEN + PTOP=HWUPCM(EMW,RMASS(5),RMASS(6)) + IF (PTOP.GT.ZERO) THEN + ETOP=SQRT(PTOP**2+RMASS(6)**2) + EBOT=EMW-ETOP + FTQK=2.*PTOP*(3.*ETOP*EBOT+PTOP**2)/EMW**3 + PMAX=(ETOP+PTOP)*(EBOT+PTOP) + ENDIF + ENDIF + FHAD=FTQK+2. + FTOT=FTQK+3. +C---MULTIPLY WEIGHT BY BRANCHING FRACTION + IF (IDEC.EQ.0) THEN + BRAF=FHAD + ELSEIF (IDEC.LT.5.OR.IDEC.EQ.50) THEN + BRAF=1. + ELSEIF (IDEC.LT.7) THEN + BRAF=FTQK + ELSEIF (IDEC.EQ.99) THEN + BRAF=FTOT + ELSE + BRAF=1/THREE + ENDIF + CSFAC=CSFAC*BRAF/FTOT*(0.5-TMIN/PIFAC) + FTQK=FTQK/FHAD + FLEP=1./FTOT + ENDIF + CALL HWSGEN(.TRUE.) +C---LOOP OVER PARTON FLAVOURS + PROB=0. + COEF=1.-SCABI + DO 100 IC=1,16 + IF (IC.EQ.9) COEF=SCABI + PROB=PROB+DISF(IWP(1,IC),1)*DISF(IWP(2,IC),2)*COEF + 100 CONTINUE + EVWGT=PROB*CSFAC + ENDIF + 999 END +CDECK ID>, HWIGIN. +*CMZ :- -01/04/99 19.44.55 by Mike Seymour +*-- Author : Bryan Webber +C---------------------------------------------------------------------- + SUBROUTINE HWIGIN +C----------------------------------------------------------------------- +C SETS INPUT PARAMETERS +C---------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + DOUBLE PRECISION FAC,ANGLE + INTEGER I,J,N,L + CHARACTER*28 TITLE + DATA TITLE/'HERWIG 6.100 December 1999'/ + WRITE (6,10) TITLE + 10 FORMAT(//10X,A28//, + & 10X,'Please reference: G. Marchesini, B.R. Webber,',/, + & 10X,'G.Abbiendi, I.G.Knowles, M.H.Seymour & L.Stanco',/, + & 10X,'Computer Physics Communications 67 (1992) 465') +C---PRINT OPTIONS: +C IPRINT=0 NO PRINTOUT +C 1 PRINT SELECTED INPUT PARAMETERS +C 2 1 + TABLE OF PARTICLE CODES AND PROPERTIES +C 3 2 + TABLES OF SUDAKOV FORM FACTORS + IPRINT=1 +C Format for track numbers in event listing +C PRNDEC=.TRUE. use decimal +C .FALSE. use hexadecimal + PRNDEC=(NMXHEP.LE.9999) +C Number of significant figures to print out in event listing +C NPRFMT (< 2) compact 80 character stout and A4-long tex output, +C (= 2) 2 decimal places in stout, (> 2) - 5 decimal places in stout + NPRFMT=1 +C Print out vertex information + PRVTX=.TRUE. +C Print out particle properties/event record to stout, tex or web + PRNDEF=.TRUE. + PRNTEX=.FALSE. + PRNWEB=.FALSE. +C---MAX NO OF EVENTS TO PRINT + MAXPR=0 +C---UNIT FOR READING SUDAKOV FORM FACTORS (IF ZERO THEN COMPUTE THEM) + LRSUD=0 +C---UNIT FOR WRITING SUDAKOV FORM FACTORS (IF ZERO THEN NOT WRITTEN) + LWSUD=77 +C---UNIT FOR WRITING EVENT DATA IN HWANAL (IF ZERO THEN NOT WRITTEN) + LWEVT=0 +C---SEEDS FOR RANDOM NUMBER GENERATOR (CALLED HWR) + NRN(1)= 17673 + NRN(2)= 63565 +C---AZIMUTHAL CORRELATIONS? +C THESE INCLUDE SOFT GLUON (INSIDE CONE) + AZSOFT=.TRUE. +C AND NEAREST-NEIGHBOUR SPIN CORRELATIONS + AZSPIN=.TRUE. +C---MATRIX-ELEMENT MATCHING FOR E+E-, DIS, DRELL-YAN AND TOP DECAY +C---HARD EMISSION + HARDME=.TRUE. +C---SOFT EMISSION + SOFTME=.TRUE. +C---GLUON ENERGY CUT FOR TOP DECAY CASE + GCUTME=2 +C Electromagnetic fine structure constant: Thomson limit + ALPHEM=.0072993 +C---QCD LAMBDA: CORRESPONDS TO 5-FLAVOUR LAMBDA-MS-BAR AT LARGE X ONLY + QCDLAM=0.18 +C---NUMBER OF COLOURS + NCOLO=3 +C---NUMBER OF FLAVOURS + NFLAV=6 +C---QUARK, GLUON AND PHOTON VIRTUAL MASS CUTOFFS IN +C PARTON SHOWER (ADDED TO MASSES GIVEN BELOW) + VQCUT=0.48 + VGCUT=0.10 + VPCUT=0.40 + ALPFAC=1 +C---D,U,S,C,B,T QUARK AND GLUON MASSES (IN THAT ORDER) + RMASS(1)=0.32 + RMASS(2)=0.32 + RMASS(3)=0.5 + RMASS(4)=1.55 + RMASS(5)=4.95 + RMASS(6)=175. + RMASS(13)=0.75 +C---W+/- AND Z0 MASSES + RMASS(198)=80.4 + RMASS(199)=80.4 + RMASS(200)=91.2 +C---HIGGS BOSON MASS + RMASS(201)=150. +C---WIDTHS OF W, Z, HIGGS + GAMW=2.0 + GAMZ=2.5 + GAMH=0.02 +C Include additional neutral, massive vector boson (Z') + ZPRIME=.FALSE. +C Z' mass and width + RMASS(202)=500. + GAMZP=5. +C Lepton (EPOLN) and anti-lepton (PPOLN) beam polarisations used in: +C e+e- --> ffbar/qqbar g; and l/lbar N DIS. +C Cpts. 1,2 Transverse polarisation; cpt. 3 longitudinal polarisation. +C Note require POLN(1)**2+POLN(2)**2+POLN(3)**2 < 1. + DO 20 I=1,3 + EPOLN(I)=0. + 20 PPOLN(I)=0. +C----------------------------------------------------------------------- +C Specify couplings of weak vector bosons to fermions: +C +C electric current: QFCH(I)*e*G_mu (electric charge, e>0) +C weak neutral current: [VFCH(I,J).1+AFCH(I,J).G_5]*e*G_mu +C weak charged current: SQRT(VCKM(K,L)/2.)*g*(1+G_5)*G_mu +C +C I= 1- 6: d,u,s,c,b,t (quarks) +C =11-16: e,nu_e,mu,nu_mu,tau,nu_tau (leptons) (`I=IDHW-110') +C J=1 for minimal SM: +C =2 for Z' couplings (ZPRIME=.TRUE.) +C K=1,2,3 for u,c,t; L=1,2,3 for d,s,b +C----------------------------------------------------------------------- +C Minimal standard model neutral vector boson couplings +C VFCH(I,1)=(T3/2-Q*S^2_W)/(C_W*S_W); AFCH(I,1)=T3/(2*C_W*S_W) +C sin**2 Weinberg angle (PDG '94) + SWEIN=.2319 + FAC=1./SQRT(SWEIN*(1.-SWEIN)) + DO 30 I=1,3 +C Down-type quarks + J=2*I-1 + QFCH(J)=-1./3. + VFCH(J,1)=(-0.25+SWEIN/3.)*FAC + AFCH(J,1)= -0.25*FAC +C Up-type quarks + J=2*I + QFCH(J)=+2./3. + VFCH(J,1)=(+0.25-2.*SWEIN/3.)*FAC + AFCH(J,1)= +0.25*FAC +C Charged leptons + J=2*I+9 + QFCH(J)=-1. + VFCH(J,1)=(-0.25+SWEIN)*FAC + AFCH(J,1)= -0.25*FAC +C Neutrinos + J=2*I+10 + QFCH(J)=0. + VFCH(J,1)=+0.25*FAC + AFCH(J,1)=+0.25*FAC + 30 CONTINUE +C Additional Z' couplings (To be set by the user) + IF (.NOT.ZPRIME) THEN + DO 40 I=1,6 + AFCH(I,2)=0. + AFCH(10+I,2)=0. + VFCH(I,2)=0. + VFCH(10+I,2)=0. + 40 CONTINUE + ENDIF +C Cabibbo-Kobayashi-Maskawa matrix elements squared (PDG '92): +C sin**2 of Cabibbo angle + SCABI=.0488 +C u ---> d,s,b + VCKM(1,1)=1.-SCABI + VCKM(1,2)=SCABI + VCKM(1,3)=0.0 +C c ---> d,s,b + VCKM(2,1)=SCABI + VCKM(2,2)=1.-SCABI-.002 + VCKM(2,3)=0.002 +C t ---> d,b,s + VCKM(3,1)=0.0 + VCKM(3,2)=0.002 + VCKM(3,3)=0.998 +C---GAUGE BOSON DECAYS + DO 50 I=1,12 + BRHIG(I)=1.D0/12 + ENHANC(I)=1.D0 + 50 IF (I.LE.MODMAX) MODBOS(I)=0 +C +C THE iTH GAUGE BOSON DECAY PER EVENT IS CONTROLLED BY MODBOS AS FOLLOWS +C MODBOS(i) W DECAY Z DECAY +C 0 all all +C 1 qqbar qqbar +C 2 enu e+e- +C 3 munu mu+mu- +C 4 taunu tau+tau- +C 5 enu & munu ee & mumu +C 6 all nunu +C 7 all bbbar +C >7 all all +C BOSON PAIRS (eg FROM HIGGS DECAY) ARE CHOSEN FROM MODBOS(i),MODBOS(i+1 +C +C---CONTROL OF LARGE EMH BEHAVIOUR (SEE HWHIGM FOR DETAILS) + IOPHIG=3 + GAMMAX=10. +C Specicify approximation used in HWHIGA + IAPHIG=1 +C---MASSES OF HYPOTHETICAL NEW QUARKS GO +C INTO 209-214 (ANTIQUARKS IN 215-220) +C ID = 209,210 ARE B',T' WITH DECAYS T'->B'->C +C 211,212 ARE B',T' WITH DECAYS T'->B'->T +C 215-218 ARE THEIR ANTIQUARKS + RMASS(209)=200. + RMASS(215)=200. +C---MAXIMUM CLUSTER MASS PARAMETERS +C N.B. LIMIT FOR Q1-Q2BAR CLUSTER MASS +C IS (CLMAX**CLPOW + (QM1+QM2)**CLPOW)**(1/CLPOW) + CLMAX=3.35 + CLPOW=2.0 +C For PSPLT(I), CLDIR(I) & CLSMR(I): I=1 light u,d,s,c cluster +C =2 heavy b cluster +C---MASS SPECTRUM OF PRODUCTS IN CLUSTER +C SPLITTING ABOVE CLMAX - FLAT IN M**PSPLT(*) + PSPLT(1)=1.0 + PSPLT(2)=PSPLT(1) +C---KINEMATIC TREATMENT OF CLUSTER DECAY +C 0=ISOTROPIC, 1=REMEMBER DIRECTION OF PERTURBATIVELY PRODUCED QUARKS + CLDIR(1)=1 + CLDIR(2)=CLDIR(1) +C IF CLDIR(*)=1, DO GAUSSIAN SMEARING OF DIRECTION: +C ACTUALLY EXPONENTIAL IN 1-COS(THETA) WITH MEAN CLSMR(*) + CLSMR(1)=0.0 + CLSMR(2)=CLSMR(1) +C---OPTION FOR TREATMENT OF REMNANT CLUSTERS: +C 0=BOTH CHILDREN ARE SOFT, (EQUIVALENT TO PREVIOUS VERSIONS) +C 1=REMNANT CHILD IS SOFT, BUT PERTURBATIVE CHILD IS NORMAL + IOPREM=1 +C---TREATMENT OF LOWER LIMIT FOR SPACELIKE EVOLUTION +C 0=EVOLUTION STOPS AT QSPAC, BUT STRUCT FUNS CAN GET CALLED AT +C SMALLER SCALES IN FORCED EMISSION (EQUIVALENT TO V5.7 AND EARLIER) +C 1=EVOLUTION STOPS AT QSPAC, STRUCTURE FUNCTIONS FREEZE AT QSPAC +C 2=EVOLUTION CONTINUES TO INFRARED CUT, BUT S.F.S FREEZE AT QSPAC + ISPAC=0 +C---LOWER LIMIT FOR SPACELIKE EVOLUTION + QSPAC=2.5 +C---SWITCH OFF SPACE-LIKE SHOWERS + NOSPAC=.FALSE. +C---INTRINSIC PT OF SPACELIKE PARTONS (RMS) + PTRMS=0.0 +C---MASS PARAMETER IN REMNANT FRAGMENTATION + BTCLM=1.0 +C---STRUCTURE FUNCTION SET: +C SET MODPDF(I)=MODE AND AUTPDF='AUTHOR GROUP' TO USE CERN LIBRARY +C PDFLIB PACKAGE FOR STRUCTURE FUNCTIONS IN BEAM I + MODPDF(1)=-1 + MODPDF(2)=-1 + AUTPDF(1)='MRS' + AUTPDF(2)='MRS' +C OR SET MODPDF(I)=-1 TO USE BUILT-IN STRUCTURE FUNCTION SET: +C 1,2 FOR DUKE+OWENS SETS 1,2 (SOFT/HARD GLUE) +C 3,4 FOR EICHTEN+AL SETS 1,2 (NUCLEONS ONLY) +C 5 FOR OWENS SET 1.1 (SOFT GLUE ONLY) + NSTRU=5 +C PARAMETER FOR B CLUSTER DECAY TO 1 HADRON. IF MCL IS CLUSTER MASS +C AND MTH IS THRESHOLD FOR 2-HADRON DECAY, THEN PROBABILITY IS +C 1 IF MCL(1+B1LIM)*MTH, WITH LINEAR INTERPOLATION, + B1LIM=0.0 +C---B DECAY PACKAGE ('HERW'=>HERWIG, 'EURO'=>EURODEC, 'CLEO'=>CLEO) + BDECAY='HERW' +C---HARD SUBPROCESS SCALE TO BE USED IN BOSON-GLUON FUSION +C IF (BGSHAT) THEN SCALE=SHAT +C ELSE SCALE=2.*SHAT*THAT*UHAT/(SHAT**2+THAT**2+UHAT**2) + BGSHAT=.FALSE. +C---RECONSTRUCT DIS EVENTS IN BREIT FRAME + BREIT=.TRUE. +C---TREAT ALL EVENTS IN THEIR CMF (ELSE USE LAB FRAME) + USECMF=.TRUE. +C---PROBABILITY OF UNDERLYING SOFT EVENT: + PRSOF=1. +C---SOFT UNDERLYING OR MIN BIAS EVENT PARAMETERS +C DEFAULT VALUES ARE FROM UA5 COLLAB, NPB291(1987)445 +C NCH_PPBAR(SQRT(S)) = PMBN1*S**PMBN2+PMBN3 + PMBN1= 9.11 + PMBN2= 0.115 + PMBN3=-9.50 +C 1/K (IN NEG BINOMIAL) = PMBK1*LN(S)+PMBK2 + PMBK1= 0.029 + PMBK2=-0.104 +C SOFT CLUSTER MASS SPECTRUM (M-M1-M2-PMBM1)*EXP(-PMBM2*M) + PMBM1= 0.4 + PMBM2= 2.0 +C SOFT CLUSTER PT SPECTRUM PT*EXP(-B*SQRT(PT**2+M**2)) +C B=PMBP1 FOR D,U, PMBP2 FOR S,C, PMBP3 FOR DIQUARKS + PMBP1= 5.2 + PMBP2= 3.0 + PMBP3= 5.2 +C---MULTIPLICITY ENHANCEMENT FOR UNDERLYING SOFT EVENT: +C NCH = NCH_PPBAR(ENSOF*SQRT(S)) + ENSOF=1. +C PARAMETERS FOR MUELLER TANG FORMUA: IPROC=2400 +C---THE VALUE TO USE FOR FIXED ALPHA_S IN DENOMINATOR + ASFIXD=0.25 +C---OMEGA0=12*LOG(2)*ALPHA_S/PI, BUT NOT NECESSARILY THE SAME ALPHA_S + OMEGA0=0.3 +C---MIN AND MAX JET RAPIDITIES IN QCD 2->2, +C HEAVY FLAVOUR, SUSY AND DIRECT PHOTON PROCESSES + YJMAX=8. + YJMIN=-YJMAX +C---MIN AND MAX PARTON TRANSVERSE MOMENTUM +C IN ELEMENTARY 2 -> 2 SUBPROCESSES + PTMIN=1D1 + PTMAX=1D8 +C---UPPER LIMIT ON HARD PROCESS SCALE + QLIM=1D8 +C---MAX PARTON THRUST IN 2->3 HARD PROCESSES + THMAX=0.9 +C Set parameters for 2->4 hard process +C Choose inter-jet metric (else JADE) and minimum y-cut + DURHAM=.TRUE. + Y4JT=0.01 +C---TREATMENT OF COLOUR INTERFERENCE IN E+E- -> 4 JETS: +C qqbar-gg case: +C IOP4JT(1)=0 neglect, =1 extreme 2341; =2 extreme 3421 +C qqbar-qqbar (identical quark flavour) case: +C IOP4JT(2)=0 neglect, =1 extreme 4123; =2 extreme 2143 + IOP4JT(1)=0 + IOP4JT(2)=0 +C---MIN AND MAX DILEPTON INVARIANT MASS IN DRELL-YAN PROCESS + EMMIN=0D0 + EMMAX=1D8 +C---MIN AND MAX ABS(Q**2) IN DEEP INELASTIC LEPTON SCATTERING + Q2MIN=0D0 + Q2MAX=1D10 +C---MIN AND MAX ABS(Q**2) IN WEISZACKER-WILLIAMS APPROXIMATION + Q2WWMN=0. + Q2WWMX=4. +C---MIN AND MAX ENERGY FRACTION IN WEISZACKER-WILLIAMS APPROXIMATION + YWWMIN=0. + YWWMAX=1. +C---MINIMUM HADRONIC MASS FOR PHOTON-INDUCED PROCESSES (INCLUDING DIS) + WHMIN=0. +C---IF PHOMAS IS NON-ZERO, PARTON DISTRIBUTION FUNCTIONS FOR OFF-SHELL +C PHOTONS IS DAMPED, WITH MASS PARAMETER = PHOMAS + PHOMAS=0. +C---MIN AND MAX FLAVOURS GENERATED BY IPROC=9100,9110,9130 + IFLMIN=1 + IFLMAX=5 +C---MAX Z IN J/PSI PHOTO- AND ELECTRO- PRODUCTION + ZJMAX=0.9 +C---MIN AND MAX BJORKEN-Y + YBMIN=0. + YBMAX=1. +C---MAX COS(THETA) FOR W'S IN E+E- -> W+W- + CTMAX=0.9999 +C Minimum virtuality^2 of partons to use in calculating distances + VMIN2=0.1 +C Exageration factor for lifetimes of weakly decaying heavy particles + EXAG=1. +C Include colour rearrangement in cluster formation + CLRECO=.FALSE. +C Probability for colour rearrangement to occur + PRECO=1./9. +C Minimum lifetime for particle to be considered stable + PLTCUT=1.D-8 +C Incude neutral B-meson mixing + MIXING=.TRUE. +C Set B_s and B_d mixing parameters: X=Delta m/Gamma + XMIX(1)=10.0 + XMIX(2)=0.70 +C Y=Delta Gamma/2*Gamma + YMIX(1)=0.2 + YMIX(2)=0.0 +C Include a cut on particle decay lengths + MAXDKL=.FALSE. +C Set option for decay length cut (see HWDXLM) + IOPDKL=1 +C Smear the primary interaction vertex: see HWRPIP for details + PIPSMR=.TRUE. + DO 60 I=0,NMXRES +C Veto cluster decays into particle type I + VTOCDK(I)=.FALSE. +C Veto unstable particle decays into modes involving particle type I + 60 VTORDK(I)=.FALSE. +C Veto f_0(980) and a_0(980) production in cluster decays + VTOCDK(290)=.TRUE. + VTOCDK(291)=.TRUE. + VTOCDK(292)=.TRUE. + VTOCDK(293)=.TRUE. +C---MINIMUM AND MAXIMUM S-HAT/S RANGE FOR PHOTON ISR + TMNISR=1D-4 + ZMXISR=1-1D-6 +C---COLISR IS .TRUE. TO MAKE ISR PHOTONS COLLINEAR WITH BEAMS + COLISR=.FALSE. +C A Priori weights for mesons w.r.t. pionic n=1, 0-(+) states: +C old VECWT=REPWT(0,1,0) & TENWT=REPWT(0,2,0) + DO 70 N=0,4 + DO 70 J=0,4 + DO 70 L=0,3 + 70 REPWT(L,J,N)=1. +C and singlet (Lambda-like) and decuplet barons + SNGWT=1. + DECWT=1. +C---A PRIORI WEIGHTS FOR D,U,S,C,B,T QUARKS AND DIQUARKS (IN THAT ORDER) + PWT(1)=1. + PWT(2)=1. + PWT(3)=1. + PWT(4)=1. + PWT(5)=1. + PWT(6)=1. + PWT(7)=1. +C Octet-Singlet isoscalar mixing angles in degrees +C (use ANGLE for ideal mixing, recommended for F0MIX & OMHMIX) + ANGLE=ATAN(ONE/SQRT(TWO))*180./ACOS(-ONE) +C eta - eta' + ETAMIX=-23. +C phi - omega + PHIMIX=+36. +C h_1(1380) - h_1(1170) + H1MIX=ANGLE +C MISSING - f_0(1370) + F0MIX=ANGLE +C f_1(1420) - f_1(1285) + F1MIX=ANGLE +C f'_2 - f_2 + F2MIX=+26. +C MISSING - omega(1600) + OMHMIX=ANGLE +C eta_2(1645) - eta_2(1870) + ET2MIX=ANGLE +C phi_3 - omega_3 + PH3MIX=+28. +C---PARAMETERS FOR NON-PERTURBATIVE SPLITTING OF GLUONS INTO +C DIQUARK-ANTIDIQUARK PAIRS: +C SCALE AT WHICH GLUONS CAN BE SPLIT INTO DIQUARKS +C (0.0 FOR NO SPLITTING) + QDIQK=0.0 +C PROBABILITY (PER UNIT LOG SCALE) OF DIQUARK SPLITTING + PDIQK=5.0 +C---PARAMETERS FOR IMPORTANCE SAMPLING +C ASSUME QCD 2->2 DSIG/DET FALLS LIKE ET**(-PTPOW) +C WHERE ET=SQRT(MQ**2+PT**2) FOR HEAVY FLAVOURS + PTPOW=4. +C DEFAULT PTPOW=2 FOR SUSY PROCESSES + IF (MOD(IPROC/100,100).EQ.30) PTPOW=2. +C ASSUME DRELL-YAN DSIG/DEM FALLS LIKE EM**(-EMPOW) + EMPOW=4. +C ASSUME DEEP INELASTIC DSIG/DQ**2 FALLS LIKE (Q**2)**(-Q2POW) + Q2POW=2.5 +C---GENERATE UNWEIGHTED EVENTS (EVWGT=AVWGT)? + NOWGT=.TRUE. +C---DEFAULT MEAN EVENT WEIGHT + AVWGT=1. +C---ASSUMED MAXIMUM WEIGHT (ZERO TO RECOMPUTE) + WGTMAX=0. +C---MINIMUM ACCEPTABLE EVENT GENERATION EFFICIENCY + EFFMIN=1E-3 +C---MAX NO OF (CODE.GE.100) ERRORS + MAXER=10 +C---TIME (SEC) NEEDED TO TERMINATE GRACEFULLY + TLOUT=5. +C---CURRENT NO OF EVENTS + NEVHEP=0 +C---CURRENT NO OF ENTRIES IN /HEPEVT/ + NHEP=0 +C---ISTAT IS STATUS OF EVENT (I.E. STAGE IN PROCESSING) + ISTAT=0 +C---IERROR IS ERROR CODE + IERROR=0 +C---MORE TECHNICAL PARAMETERS - SHOULDN'T NEED ADJUSTMENT +C---PI + PIFAC=ACOS(-1.D0) +C Speed of light (mm/s) + CSPEED=2.99792D11 +C Cross-section conversion factor (hbar.c/e)**2 + GEV2NB=389380 +C---NUMBER OF SHOTS FOR INITIAL MAX WEIGHT SEARCH + IBSH=10000 +C---RANDOM NO. SEEDS FOR INITIAL MAX WEIGHT SEARCH + IBRN(1)=1246579 + IBRN(2)=8447766 +C---NUMBER OF ENTRIES IN LOOKUP TABLES OF SUDAKOV FORM FACTORS + NQEV=1024 +C---MAXIMUM BIN SIZE IN Z FOR SPACELIKE BRANCHING + ZBINM=0.05 +C---MAXIMUM NUMBER OF Z BINS FOR SPACELIKE BRANCHING + NZBIN=100 +C---MAXIMUM NUMBER OF BRANCH REJECTIONS (TO AVOID INFINITE LOOPS) + NBTRY=200 +C---MAXIMUM NUMBER OF TRIES TO GENERATE CLUSTER DECAY + NCTRY=200 +C---MAXIMUM NUMBER OF TRIES TO GENERATE MASS REQUESTED + NETRY=200 +C---MAXIMUM NUMBER OF TRIES TO GENERATE SOFT SUBPROCESS + NSTRY=200 +C---PRECISION FOR GAUSSIAN INTEGRATION + ACCUR=1.D-6 +C---ORDER OF INTERPOLATION IN SUDAKOV TABLES + INTER=3 +C---ORDER TO USE FOR ALPHAS IN SUDAKOV TABLES + SUDORD=1 +C--CONSERVATION OF RPARITY + RPARTY = .TRUE. +C--CHECK WHETHER SUSY DATA INPUTTED + SUSYIN=.FALSE. + 999 END +CDECK ID>, HWIODK. +*CMZ :- -27/07/99 13.33.03 by Mike Seymour +*-- Author : Ian Knowles +C----------------------------------------------------------------------- + SUBROUTINE HWIODK(IUNIT,IOPT,IME) +C----------------------------------------------------------------------- +C If IUNIT > 0 writes out present HERWIG decay tables to unit IUNIT +C < 0 reads in decay tables from unit IUNIT +C The format used during the read/write is specified by IOPT +C =1 PDG; =2 HERWIG numeric; =3 HERWIG character name. +C When reading in if IME =1 matrix element codes >= 100 are accepted +C 0 are set zero. +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + INTEGER IUNIT,IOPT,IME,JUNIT,I,J,K,L,IDKY,ITMP(5),IDUM + CHARACTER*8 CDK(NMXDKS),CDKPRD(5,NMXDKS),CDUM + JUNIT=ABS(IUNIT) + OPEN(UNIT=JUNIT,FORM='FORMATTED',STATUS='UNKNOWN') + IF (IUNIT.GT.0) THEN +C Write out the decay table + WRITE(JUNIT,100) NDKYS + IF (IOPT.EQ.1) THEN + DO 20 I=1,NRES + IF (NMODES(I).EQ.0) GOTO 20 + K=LSTRT(I) + DO 10 J=1,NMODES(I) + WRITE(JUNIT,110) IDPDG(I),BRFRAC(K),NME(K), + & (IDPDG(IDKPRD(L,K)),L=1,5) + 10 K=LNEXT(K) + 20 CONTINUE + ELSEIF (IOPT.EQ.2) THEN + DO 40 I=1,NRES + IF (NMODES(I).EQ.0) GOTO 40 + K=LSTRT(I) + DO 30 J=1,NMODES(I) + WRITE(JUNIT,120) I,BRFRAC(K),NME(K),(IDKPRD(L,K),L=1,5) + 30 K=LNEXT(K) + 40 CONTINUE + ELSEIF (IOPT.EQ.3) THEN + DO 60 I=1,NRES + IF (NMODES(I).EQ.0) GOTO 60 + K=LSTRT(I) + DO 50 J=1,NMODES(I) + WRITE(JUNIT,130) RNAME(I),BRFRAC(K),NME(K), + & (RNAME(IDKPRD(L,K)),L=1,5) + 50 K=LNEXT(K) + 60 CONTINUE + ENDIF + ELSEIF (IUNIT.LT.0) THEN +C Read in the decay table and convert to HERWIG numeric format + READ(JUNIT,100) NDKYS + IF (NDKYS.GT.NMXDKS) CALL HWWARN('HWIODK',100,*999) + IF (IOPT.EQ.1) THEN + DO 70 I=1,NDKYS + READ(JUNIT,110) IDKY,BRFRAC(I),NME(I),ITMP + IF (IME.EQ.0.AND.NME(I).GE.100) NME(I)=0 + CALL HWUIDT(1,IDKY,IDK(I),CDUM) + DO 70 J=1,5 + 70 CALL HWUIDT(1,ITMP(J),IDKPRD(J,I),CDUM) + ELSEIF (IOPT.EQ.2) THEN + DO 80 I=1,NDKYS + READ(JUNIT,120) IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5) + IF (IDK(I).LT.0.OR.IDK(I).GT.NRES) IDK(I)=20 + 80 IF (IME.EQ.0.AND.NME(I).GE.100) NME(I)=0 + ELSEIF (IOPT.EQ.3) THEN + DO 90 I=1,NDKYS + READ(JUNIT,130) CDK(I),BRFRAC(I),NME(I),(CDKPRD(J,I),J=1,5) + IF (IME.EQ.0.AND.NME(I).GE.100) NME(I)=0 + CALL HWUIDT(3,IDUM,IDK(I),CDK(I)) + DO 90 J=1,5 + 90 CALL HWUIDT(3,IDUM,IDKPRD(J,I),CDKPRD(J,I)) + ELSE + CALL HWWARN('HWIODK',101,*999) + ENDIF + ENDIF + CLOSE(UNIT=JUNIT) + 100 FORMAT(1X,I4) + 110 FORMAT(1X,I7,1X,F7.5,1X,I3,5(1X,I7)) + 120 FORMAT(1X,I3,1X,F7.5,6(1X,I3)) + 130 FORMAT(1X,A8,1X,F7.5,1X,I3,5(1X,A8)) + 999 RETURN + END +CDECK ID>, HWISSP. +*CMZ :- -20/10/99 09:46:43 by Peter Richardson +*-- Author : Bryan Webber, modified by Kosuke Odagiri +C----------------------------------------------------------------------- + SUBROUTINE HWISSP(LRSUSY) +C----------------------------------------------------------------------- +C Reads in SUSY particle properties and decays, +C in format generated by ISAWIG +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + INTEGER I,J,K,IH,IHW,NSSP,NDEC,MDKYS,LRSUSY + DOUBLE PRECISION BETAH, WEINCOS,WEINSIN, MW,MZ, RMMAX + DOUBLE PRECISION FTM,FTMUU(4),FTMDD(4),FTMTT(4),FTMBB(4),FTMU,FTMD + DOUBLE PRECISION YTM,YTM1,DTERM(4), SQHF,SNBCSB,MZSW2 + LOGICAL FIRST + EQUIVALENCE (MW,RMASS(198)), (MZ,RMASS(200)) + DATA FIRST/.TRUE./ + SAVE MDKYS + IF (FIRST) THEN + MDKYS=NDKYS + FIRST=.FALSE. + ELSE + NDKYS=MDKYS + ENDIF +C--reset susy input flag + IF (LRSUSY.LT.0) CALL HWWARN('HWISSP',500,*999) + SUSYIN = .TRUE. +C +C Input SUSY particle + top quark table +C + WRITE (6,10) LRSUSY + 10 FORMAT (10X,'Reading in SUSY data from unit',I3) + READ (LRSUSY,'(I4)') NSSP + IF (NSSP.LE.0) RETURN + RMMAX=SQRT(HALF*(EBEAM1*EBEAM2+PBEAM1*PBEAM2)) + RMMNSS=RMMAX + DO I=1,NSSP + READ (LRSUSY,1) IHW,RMASS(IHW),RLTIM(IHW) +C Negative gaugino mass means physical field is gamma_5*psi +C Store the signs + IF ((IHW.GE.450).AND.(IHW.LE.457)) THEN + IF (IHW.LE.453) THEN + J=IHW-449 + ZSGNSS(J)=RMASS(IHW)/ABS(RMASS(IHW)) + ELSEIF (IHW.LE.455) THEN + J=IHW-453 + WSGNSS(J)=RMASS(IHW)/ABS(RMASS(IHW)) + ENDIF + RMASS(IHW)=ABS(RMASS(IHW)) + ENDIF + IF (ABS(IDPDG(IHW)).GT.1000000.AND.(RMASS(IHW).NE.ZERO)) + & RMMNSS=MIN(RMMNSS,RMASS(IHW)) + IF (IHW.GT.NRES) THEN + IF (IHW.GT.NMXRES) CALL HWWARN('HWISSP',501,*999) + NRES=IHW + ENDIF + ENDDO + XLMNSS=TWO*LOG(RMMNSS/RMMAX) + 1 FORMAT(I5,F12.4,E15.5) +C +C Input decay modes +C + DO I=1,NSSP + READ (LRSUSY,'(I4)') NDEC + IF (NDEC.GT.0) THEN + DO J=1,NDEC + NDKYS=NDKYS+1 + IF (NDKYS.GT.NMXDKS) CALL HWWARN('HWISSP',100,*999) + READ (LRSUSY,11) IDK(NDKYS),BRFRAC(NDKYS),NME(NDKYS), + & (IDKPRD(K,NDKYS),K=1,5) + 11 FORMAT(I6,F16.8,6I6) + ENDDO + ENDIF + ENDDO +C +C Mixings and other SUSY parameters +C + READ (LRSUSY,'(2F16.8)') TANB,ALPHAH + DO I=1,4 + READ (LRSUSY,13) ZMXNSS(I,1),ZMXNSS(I,2),ZMXNSS(I,3),ZMXNSS(I,4) + END DO + WEINSIN = SQRT(SWEIN) + WEINCOS = SQRT(1.-SWEIN) + DO I=1,4 + ZMIXSS(I,1) = WEINCOS*ZMXNSS(I,1)+WEINSIN*ZMXNSS(I,2) + ZMIXSS(I,2) = -WEINSIN*ZMXNSS(I,1)+WEINCOS*ZMXNSS(I,2) + ZMIXSS(I,3) = ZMXNSS(I,3) + ZMIXSS(I,4) = ZMXNSS(I,4) + END DO + DO J=1,16 + IF ((J.LE.6).OR.(J.GE.11)) THEN + LFCH(J)=VFCH(J,1)+AFCH(J,1) + RFCH(J)=VFCH(J,1)-AFCH(J,1) + DO I=1,4 + SLFCH(J,I)= ZMIXSS(I,1)*QFCH(J)+ZMIXSS(I,2)*LFCH(J) + SRFCH(J,I)=-ZMIXSS(I,1)*QFCH(J)-ZMIXSS(I,2)*RFCH(J) + END DO + ENDIF + END DO + READ (LRSUSY,13) WMXVSS(1,1),WMXVSS(1,2), WMXVSS(2,1),WMXVSS(2,2) + READ (LRSUSY,13) WMXUSS(1,1),WMXUSS(1,2), WMXUSS(2,1),WMXUSS(2,2) + READ (LRSUSY,'(3F16.8)') THETAT,THETAB,THETAL + READ (LRSUSY,'(3F16.8)') ATSS,ABSS,ALSS + READ (LRSUSY,'( F16.8)') MUSS + DO I=1,6 + QMIXSS(I,1,1)=1. + QMIXSS(I,1,2)=0. + QMIXSS(I,2,1)=0. + QMIXSS(I,2,2)=1. + LMIXSS(I,1,1)=1. + LMIXSS(I,1,2)=0. + LMIXSS(I,2,1)=0. + LMIXSS(I,2,2)=1. + END DO + QMIXSS(6,1,1)= COS(THETAT) + QMIXSS(6,1,2)= SIN(THETAT) + QMIXSS(6,2,1)=-QMIXSS(6,1,2) + QMIXSS(6,2,2)= QMIXSS(6,1,1) + QMIXSS(5,1,1)= COS(THETAB) + QMIXSS(5,1,2)= SIN(THETAB) + QMIXSS(5,2,1)=-QMIXSS(5,1,2) + QMIXSS(5,2,2)= QMIXSS(5,1,1) + LMIXSS(5,1,1)= COS(THETAL) + LMIXSS(5,1,2)= SIN(THETAL) + LMIXSS(5,2,1)=-LMIXSS(5,1,2) + LMIXSS(5,2,2)= LMIXSS(5,1,1) +C--Evaluating Higgs parameters and couplings + BETAH=ATAN(TANB) + COTB=ONE/TANB + COSBPA=COS(BETAH+ALPHAH) + SINBPA=SIN(BETAH+ALPHAH) + COSBMA=COS(BETAH-ALPHAH) + SINBMA=SIN(BETAH-ALPHAH) + COSA=COS(ALPHAH) + SINA=SIN(ALPHAH) + COSB=COS(BETAH) + SINB=SIN(BETAH) + GHWWSS(1)=SINBMA + GHWWSS(2)=COSBMA + GHWWSS(3)=ZERO + DO 30 I=1,3 + GHZZSS(I)=GHWWSS(I) + 30 CONTINUE + GHDDSS(1)=-SINA/COSB + GHDDSS(2)= COSA/COSB + GHDDSS(3)= TANB + GHUUSS(1)= COSA/SINB + GHUUSS(2)= SINA/SINB + GHUUSS(3)= COTB + GHWHSS(1)= COSBMA + GHWHSS(2)= SINBMA + GHWHSS(3)= ONE + MZSW2 = MZ**2 * SQRT(SWEIN*(ONE-SWEIN)) + DTERM(1) =-SINBPA*MZSW2 + DTERM(2) = COSBPA*MZSW2 + DTERM(3) = ZERO + FTMUU(1) =-MUSS*SINA/SINB + FTMUU(2) = MUSS*COSA/SINB + FTMUU(3) = MUSS + FTMUU(4) = MUSS + FTMTT(1) =-ATSS*COSA/SINB + FTMTT(2) =-ATSS*SINA/SINB + FTMTT(3) = ATSS*COTB + FTMTT(4) = ATSS*COTB + FTMDD(1) = MUSS*COSA/COSB + FTMDD(2) = MUSS*SINA/COSB + FTMDD(3) = MUSS + FTMDD(4) = MUSS + FTMBB(1) = ABSS*SINA/COSB + FTMBB(2) =-ABSS*COSA/COSB + FTMBB(3) = ABSS*TANB + FTMBB(4) = ABSS*TANB + DO 40 IH=1,4 + FTMU=FTMUU(IH) + FTMD=FTMDD(IH) + DO 50 I=1,6 + IF (I.EQ.5) FTMU=FTMU+FTMTT(IH) + IF (I.EQ.5) FTMD=FTMD+FTMBB(IH) + IF (MOD(I,2).EQ.0) THEN + YTM = GHUUSS(IH) + FTM = FTMU + ELSE + YTM = GHDDSS(IH) + FTM = FTMD + END IF + IF (IH.EQ.3) THEN + GHSQSS(IH,I,1,1) = ZERO + GHSQSS(IH,I,2,2) = ZERO + GHSQSS(IH,I,1,2) = FTM*HALF*RMASS(I)/MW + GHSQSS(IH,I,2,1) = - GHSQSS(IH,I,1,2) + GOTO 50 + ELSEIF (IH.EQ.4) THEN + SQHF=SQRT(HALF) + SNBCSB=SINB*COSB + DO 60 J=1,2 + DO 70 K=1,2 + IF (MOD(I,2).EQ.1) THEN + GHSQSS(IH,I,J,K)=SQHF*( + & RMASS(I )*FTMD*QMIXSS(I,2,J)*QMIXSS(I+1,1,K) + & +RMASS(I+1)*FTMU*QMIXSS(I,1,J)*QMIXSS(I+1,2,K) + & +( MW**2*TWO*SNBCSB-RMASS(I+1)**2*COTB + & -RMASS(I )**2*TANB )*QMIXSS(I,1,J)*QMIXSS(I+1,1,K) + & -RMASS(I)*RMASS(I+1)/SNBCSB + & *QMIXSS(I,2,J)*QMIXSS(I+1,2,K) ) / MW + ELSE + GHSQSS(IH,I,J,K)=GHSQSS(IH,I-1,K,J) + END IF + 70 END DO + 60 END DO + ELSE + DO 80 J=1,2 + DO 90 K=1,2 + YTM1=ZERO + IF (J.EQ.K) YTM1=YTM*RMASS(I)**2 + GHSQSS(IH,I,J,K)=( YTM1 + & +( LFCH(I)*QMIXSS(I,1,J)*QMIXSS(I,1,K) + & -RFCH(I)*QMIXSS(I,2,J)*QMIXSS(I,2,K) )*DTERM(IH) + & +FTM*HALF*RMASS(I)*(QMIXSS(I,1,J)*QMIXSS(I,2,K) + & +QMIXSS(I,2,J)*QMIXSS(I,1,K)) ) / MW + 90 CONTINUE + 80 CONTINUE + END IF + 50 CONTINUE + 40 CONTINUE +C--Rparity violation + READ (LRSUSY,'(L5)') RPARTY + IF(.NOT.RPARTY) THEN + READ(LRSUSY,20) (((LAMDA1(I,J,K),K=1,3),J=1,3),I=1,3) + READ(LRSUSY,20) (((LAMDA2(I,J,K),K=1,3),J=1,3),I=1,3) + READ(LRSUSY,20) (((LAMDA3(I,J,K),K=1,3),J=1,3),I=1,3) + ENDIF + 13 FORMAT(4F16.8) + 20 FORMAT(27E16.8) + CLOSE(LRSUSY) + 999 END +CDECK ID>, HWMEVT. +*CMZ :- -04/05/99 14.28.59 by Bryan Webber +*-- Author : Bryan Webber +C----------------------------------------------------------------------- + SUBROUTINE HWMEVT +C----------------------------------------------------------------------- +C IPROC = 1000,... ADDS SOFT UNDERLYING EVENT +C = 8000: CREATES MINIMUM-BIAS EVENT +C SUPPRESSED BY ADDING 10000 TO IPROC +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + DOUBLE PRECISION HWREXP,ENFAC,TECM,SECM,SUMM,EMCL,BMP(5),BMR(3,3) + INTEGER HWRINT,NETC,IBT,IDBT,ID1,ID2,ID3,KHEP,LHEP,NTRY,ICMS, + & NPPBAR,MCHT,JCL,JD1,JD2,JD3,ICH,MODC,NCHT,INHEP(2), + & INID(2,2),JBT + EXTERNAL HWREXP,HWRINT + IF (IERROR.NE.0) RETURN + IF (.NOT.GENSOF) GOTO 990 + IF (IPROC.EQ.8000) THEN +C---SET UP BEAM AND TARGET CLUSTERS + 5 NETC=0 + DO 10 IBT=1,2 + JBT=IBT + IF (JDAHEP(1,IBT).NE.0) JBT=JDAHEP(1,IBT) + IDBT=IDHW(JBT) + IF (IDBT.EQ.73.OR.IDBT.EQ.75) THEN + INID(1,IBT)=HWRINT(1,2) + INID(2,IBT)=110 + ELSEIF (IDBT.EQ.91.OR.IDBT.EQ.93) THEN + INID(1,IBT)=116 + INID(2,IBT)=HWRINT(7,8) + ELSEIF (IDBT.EQ.30) THEN + INID(1,IBT)=HWRINT(1,2) + INID(2,IBT)=8 + ELSEIF (IDBT.EQ.38) THEN + INID(1,IBT)=2 + INID(2,IBT)=HWRINT(7,8) + ELSEIF (IDBT.EQ.34) THEN + INID(1,IBT)=3 + INID(2,IBT)=HWRINT(7,8) + ELSEIF (IDBT.EQ.46) THEN + INID(1,IBT)=HWRINT(1,2) + INID(2,IBT)=9 + ELSEIF (IDBT.EQ.59) THEN + INID(1,IBT)=HWRINT(1,2) + INID(2,IBT)=HWRINT(7,8) + ELSE + CALL HWWARN('HWMEVT',100,*999) + ENDIF + NETC=NETC+ICHRG(IDBT) + & -(ICHRG(INID(1,IBT))+ICHRG(INID(2,IBT)))/3 + ENFAC=1. + IDHW(NHEP+IBT)=19 + IDHEP(NHEP+IBT)=91 + ISTHEP(NHEP+IBT)=163+IBT + JMOHEP(1,NHEP+IBT)=JBT + 10 CONTINUE + IF (NETC.EQ.0) THEN + ID3=HWRINT(1,2) + ELSEIF (NETC.EQ.-1) THEN + ID3=1 + ELSEIF (NETC.EQ.1) THEN + ID3=2 + ELSE + GOTO 5 + ENDIF + DO 12 IBT=1,2 + NHEP=NHEP+1 + JBT=IBT + IF (JDAHEP(1,IBT).NE.0) JBT=JDAHEP(1,IBT) + CALL HWVEQU(5,PHEP(1,JBT),PHEP(1,NHEP)) + 12 INHEP(IBT)=NHEP + ELSE +C---FIND BEAM AND TARGET CLUSTERS + DO 20 IBT=1,2 + DO 15 KHEP=1,NHEP + IF (ISTHEP(KHEP).EQ.163+IBT) THEN + INHEP(IBT)=KHEP + INID(1,IBT)=IDHW(JMOHEP(1,KHEP)) + INID(2,IBT)=IDHW(JMOHEP(2,KHEP)) + GOTO 20 + ENDIF + 15 CONTINUE +C---COULDN'T FIND ONE + INHEP(IBT)=0 + 20 CONTINUE + JCL=-1 +C---TEST FOR BOTH FOUND + IF (INHEP(1).EQ.0) JCL=INHEP(2) + IF (INHEP(2).EQ.0) JCL=INHEP(1) + IF (JCL.EQ.0) CALL HWWARN('HWMEVT',101,*999) + IF (JCL.GT.0) THEN + ISTHEP(JCL)=163 + CALL HWCFOR + CALL HWCDEC + CALL HWDHAD + CALL HWDHVY + GOTO 90 + ENDIF + ID3=HWRINT(1,2) + ENFAC=ENSOF + NETC=0 + ENDIF +C---FIND SOFT CM MOMENTUM AND MULTIPLICITY + NTRY=0 + NHEP=NHEP+1 + IF (NHEP.GT.NMXHEP) CALL HWWARN('HWMEVT',102,*999) + ICMS=NHEP + IDHW(NHEP)=16 + IDHEP(NHEP)=0 + ISTHEP(NHEP)=170 + CALL HWVSUM(4,PHEP(1,INHEP(1)),PHEP(1,INHEP(2)),PHEP(1,NHEP)) + CALL HWUMAS(PHEP(1,NHEP)) + TECM=PHEP(5,NHEP) + IF (IPROC/1000.EQ.9.OR.IPROC/1000.EQ.5) THEN + SECM=TECM*ENFAC + ELSE + SECM=PHEP(5,3)*ENFAC + ENDIF +C---CHOOSE MULTIPLICITY + 25 CALL HWMULT(SECM,NPPBAR) + 30 NCL=0 + MCHT=0 + IERROR=0 + NHEP =ICMS + SUMM=0. + NTRY=NTRY+1 +C---CREATE CLUSTERS + 35 NCL=NCL+1 + NHEP=NHEP+1 + IF (NHEP.GT.NMXHEP) CALL HWWARN('HWMEVT',103,*999) + JCL=NHEP + IDHW(JCL)=19 + IDHEP(JCL)=91 + IF (NCL.LT.3) THEN + ISTHEP(JCL)=170+NCL + ID1=INID(1,NCL) + ID2=INID(2,NCL) + ELSE + ID1=ID2-6 + IF (NCL.EQ.3) ID1=ID3 + ID2=HWRINT(7,8) + ISTHEP(JCL)=173 + ENDIF + JMOHEP(1,JCL)=ICMS + JMOHEP(2,JCL)=0 + CALL HWVZRO(3,PHEP(1,JCL)) + PHEP(4,JCL)=RMASS(ID1)+RMASS(ID2)+PMBM1+HWREXP(TWO/PMBM2) + PHEP(5,JCL)=PHEP(4,JCL) +C---HADRONIZE AND DECAY CLUSTERS + CALL HWCFLA(ID1,ID2,JD1,JD2) + CALL HWCHAD(JCL,JD1,JD2,JD3) + IF (IERROR.NE.0) RETURN + IF (JD3.EQ.0) THEN + EMCL=RMASS(IDHW(NHEP)) + IF (PHEP(4,JCL).NE.EMCL) THEN + PHEP(4,JCL)=EMCL + PHEP(5,JCL)=EMCL + PHEP(4,NHEP)=EMCL + PHEP(5,NHEP)=EMCL + ENDIF + ELSE + EMCL=PHEP(5,JCL) + ENDIF + IDCL(NCL)=JD3 + PPCL(5,NCL)=EMCL + SUMM=SUMM +EMCL + CALL HWDHAD + CALL HWDHVY + IF (IERROR.NE.0) RETURN +C---CHECK CHARGED MULTIPLICITY + MODC=0 + DO 50 KHEP=JCL,NHEP + IF (ISTHEP(KHEP).EQ.1) THEN + ICH=ICHRG(IDHW(KHEP)) + IF (ICH.NE.0) THEN + MCHT=MCHT+ABS(ICH) + MODC=MODC+ICH + ENDIF + ENDIF + 50 CONTINUE + IF (NCL.EQ.1) THEN + NCHT=NPPBAR+NETC+ABS(MODC) + GOTO 35 + ELSEIF (NCL.EQ.2) THEN + NCHT=NCHT+ABS(MODC) + IF (NCHT.LT.0) NCHT=NCHT+2 + ENDIF + IF (MCHT.LT.NCHT) THEN + GOTO 35 + ELSEIF (MCHT.GT.NCHT) THEN + IF (MOD(NTRY,50).EQ.0) GOTO 25 + IF (NTRY.LT.NSTRY) GOTO 30 +C---NO PHASE SPACE FOR SOFT EVENT + NHEP=ICMS-1 + IF (IPROC.EQ.8000) THEN +C---MINIMUM BIAS: RELABEL BEAM AND TARGET CLUSTERS + DO 60 IBT=1,2 + KHEP=INHEP(IBT) + LHEP=JMOHEP(1,KHEP) + ISTHEP(KHEP)=1 + IDHEP(KHEP)=IDHEP(LHEP) + IDHW(KHEP)=IDHW(LHEP) + 60 CONTINUE + ELSE +C---UNDERLYING EVENT: DECAY THEM + ISTHEP(INHEP(1))=163 + ISTHEP(INHEP(2))=163 + CALL HWCFOR + CALL HWCDEC + CALL HWDHAD + CALL HWDHVY + ENDIF + GOTO 90 + ENDIF +C---GENERATE CLUSTER MOMENTA IN CLUSTER CM +C FRAME. N.B. SECOND CLUSTER IS TARGET + IF (SUMM.GT.TECM) GOTO 25 + CALL HWMLPS(TECM) + IF (NCL.EQ.0) GOTO 25 + JCL=0 +C---ROTATE & BOOST CLUSTERS & DECAY PRODUCTS + CALL HWULOF(PHEP(1,ICMS),PHEP(1,INHEP(1)),BMP) + CALL HWUROT(BMP, ONE,ZERO,BMR) +C---BMR PUTS BEAM ALONG Z AXIS (WE WANT INVERSE) + DO 70 KHEP=ICMS+1,NHEP + IF (ISTHEP(KHEP).GT.180.AND.ISTHEP(KHEP).LT.190 + $ .AND.JMOHEP(1,KHEP).EQ.ICMS) THEN + ISTHEP(KHEP)=ISTHEP(KHEP)+3 + LHEP=KHEP + JCL=JCL+1 + CALL HWUROB(BMR,PPCL(1,JCL),PPCL(1,JCL)) + CALL HWULOB(PHEP(1,ICMS),PPCL(1,JCL),PPCL(1,JCL)) +C---NOW PPCL(*,JCL) IS LAB MOMENTUM OF JTH CLUSTER + ENDIF + CALL HWULOB(PPCL(1,JCL),PHEP(1,KHEP),PHEP(1,KHEP)) + 70 CONTINUE + ISTHEP(INHEP(1))=167 + ISTHEP(INHEP(2))=168 + JMOHEP(1,ICMS)=INHEP(1) + JMOHEP(2,ICMS)=INHEP(2) + JDAHEP(1,INHEP(1))=ICMS + JDAHEP(2,INHEP(1))=0 + JDAHEP(1,INHEP(2))=ICMS + JDAHEP(2,INHEP(2))=0 + JDAHEP(1,ICMS)=ICMS+1 + JDAHEP(2,ICMS)=LHEP + 90 CONTINUE + 990 ISTAT=100 + 999 END +CDECK ID>, HWMLPS. +*CMZ :- -04/05/99 14.17.04 by Bryan Webber +*-- Author : David Ward, modified by Bryan Webber +C----------------------------------------------------------------------- + SUBROUTINE HWMLPS(TECM) +C----------------------------------------------------------------------- +C GENERATES CYLINDRICAL PHASE SPACE USING THE METHOD OF JADACH +C RETURNS WITH NCL=0 IF UNSUCCESSFUL +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + DOUBLE PRECISION HWREXT,HWRUNG,HWUSQR,TECM,ESS,ALOGS,EPS,SUMX, + & SUMY,PT,PX,PY,PT2,SUMPT2,SUMTM,XIMIN,XIMAX,YY,SUM1,SUM2,SUM3, + & SUM4,EX,FY,DD,DYY,ZZ,E1,TM,SLOP,XI(NMXCL) + INTEGER NTRY,I,NIT,IY(NMXCL),IDP + EXTERNAL HWREXT,HWRUNG,HWUSQR + IF (NCL.GT.NMXCL) THEN + CALL HWWARN('HWMLPS',1,*999) + NCL=NMXCL + ENDIF + ESS=TECM**2 + ALOGS=LOG(ESS) + EPS=1D-10/NCL + NTRY=0 + 11 NTRY=NTRY+1 + IF (NTRY.GT.NSTRY) THEN + NCL=0 + RETURN + ENDIF + SUMX=0. + SUMY=0. + DO 12 I=1,NCL +C---Pt distribution of form exp(-b*Mt) +C---Factors for pt slopes to fit data. IDCL contains the type of +C q-qbar pair produced in this cluster (0 if 1-particle cluster). + IDP=IDCL(I) + IF (IDP.LE.2) THEN + SLOP=PMBP1 + ELSEIF(IDP.EQ.3.OR.IDP.EQ.10) THEN + SLOP=PMBP2 + ELSEIF(IDP.GT.3.AND.IDP.LE.9) THEN + SLOP=PMBP3 + ELSE + CALL HWWARN('HWMLPS',200,*999) + ENDIF + PT=HWREXT(PPCL(5,I),SLOP) + PT=HWUSQR(PT**2-PPCL(5,I)**2) + CALL HWRAZM(PT,PX,PY) + PPCL(1,I)=PX + PPCL(2,I)=PY + SUMX=SUMX+PPCL(1,I) + 12 SUMY=SUMY+PPCL(2,I) + SUMX=SUMX/NCL + SUMY=SUMY/NCL + SUMPT2=0. + SUMTM=0. + DO 13 I=1,NCL + PPCL(1,I)=PPCL(1,I)-SUMX + PPCL(2,I)=PPCL(2,I)-SUMY + PT2=PPCL(1,I)**2+PPCL(2,I)**2 + SUMPT2=SUMPT2+PT2 +C---STORE TRANSVERSE MASS IN PPCL(3,I) TEMPORARILY + PPCL(3,I)=SQRT(PT2+PPCL(5,I)**2) + 13 SUMTM=SUMTM+PPCL(3,I) + IF (SUMTM.GT.TECM) GOTO 11 + DO 14 I=1,NCL +C---Form of "reduced rapidity" distribution + XI(I)=HWRUNG(0.6*ONE,ONE) + 14 CONTINUE + CALL HWUSOR(XI,NCL,IY,1) + XIMIN=XI(1) + XIMAX=XI(NCL)-XI(1) +C---N.B. TARGET CLUSTER IS SECOND + XI(1)=0. + DO 16 I=NCL-1,2,-1 + XI(I+1)=(XI(I)-XIMIN)/XIMAX + 16 CONTINUE + XI(2)=1. + YY=LOG(ESS/(PPCL(3,1)*PPCL(3,2))) + DO 18 NIT=1,10 + SUM1=0. + SUM2=0. + SUM3=0. + SUM4=0. + DO 19 I=1,NCL + TM=PPCL(3,I) + EX=EXP(YY*XI(I)) + SUM1=SUM1+(TM*EX) + SUM2=SUM2+(TM/EX) + SUM3=SUM3+(TM*EX)*XI(I) + 19 SUM4=SUM4+(TM/EX)*XI(I) + FY=ALOGS-LOG(SUM1*SUM2) + DD=(SUM3*SUM2-SUM1*SUM4)/(SUM1*SUM2) + DYY=FY/DD + IF(ABS(DYY/YY).LT.EPS) GOTO 20 + 18 YY=YY+DYY +C---Y ITERATIONS EXCEEDED - TRY AGAIN + IF (NTRY.LT.100) GOTO 11 + EPS=10.*EPS + IF (EPS.GT.ONE) CALL HWWARN('HWMLPS',100,*999) + CALL HWWARN('HWMLPS',50,*11) + 20 YY=YY+DYY + ZZ=LOG(TECM/SUM1) + DO 22 I=1,NCL + TM=PPCL(3,I) + E1=EXP(ZZ+YY*XI(I)) + PPCL(3,I)=(0.5*TM)*((1./E1)-E1) + PPCL(4,I)=(0.5*TM)*((1./E1)+E1) + 22 CONTINUE + 999 END +CDECK ID>, HWMNBI. +*CMZ :- -26/04/91 11.11.55 by Bryan Webber +*-- Author : David Ward, modified by Bryan Webber +C----------------------------------------------------------------------- + FUNCTION HWMNBI(N,AVNCH,EK) +C----------------------------------------------------------------------- +C---Computes negative binomial probability +C----------------------------------------------------------------------- + DOUBLE PRECISION HWMNBI,AVNCH,EK,R + INTEGER N,I + IF(N.LE.0) THEN + HWMNBI=0 + ELSE + R=AVNCH/EK + HWMNBI=(1.+R)**(-EK) + R=R/(1.+R) + DO 1 I=1,N + HWMNBI=HWMNBI*R*(EK+I-1)/I + 1 CONTINUE + ENDIF + END +CDECK ID>, HWMODK. +*CMZ :- -27/07/99 13.33.03 by Mike Seymour +*-- Author : Ian Knowles +C----------------------------------------------------------------------- + SUBROUTINE HWMODK(IDKTMP,BRTMP,IMETMP, + & IATMP,IBTMP,ICTMP,IDTMP,IETMP) +C----------------------------------------------------------------------- +C Takes the decay, IDKTMP -> I-(A+B+C+D+E)-TMP, and simply stores it +C if internal pointers not set up (.NOT.DKPSET) else if pre-existing +C mode updates branching ratio BRTMP and matrix element code IMETMP, +C if -ve leaves as is. If a new mode adds to table and if consistent +C adjusts pointers, sets CMMOM (for two-body mode) and resets RSTAB +C if necessary. The branching ratios of any other IDKTMP decays are +C scaled by (1.-BRTMP)/(1.-BR_OLD) +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + DOUBLE PRECISION HWUPCM,BRTMP,SCALE,EPS + INTEGER IDKTMP,IMETMP,IATMP,IBTMP,ICTMP,IDTMP,IETMP,IDKY,ITMP(5), + & L,I,J,K,JPREV + LOGICAL MATCH(5) + CHARACTER*8 CDUM + EXTERNAL HWUPCM + PARAMETER (EPS=1.D-6) +C Convert to internal format + CALL HWUIDT(1,IDKTMP,IDKY,CDUM) + IF (IDKY.EQ.20) THEN + WRITE(6,10) IDKTMP + 10 FORMAT(1X,'Particle decaying,',I7,', is not recognised') + RETURN + ENDIF + CALL HWUIDT(1,IATMP,ITMP(1),CDUM) + CALL HWUIDT(1,IBTMP,ITMP(2),CDUM) + CALL HWUIDT(1,ICTMP,ITMP(3),CDUM) + CALL HWUIDT(1,IDTMP,ITMP(4),CDUM) + CALL HWUIDT(1,IETMP,ITMP(5),CDUM) +C If internal pointers not yet set up simply store decay + IF (.NOT.DKPSET) THEN + NDKYS=NDKYS+1 + IF (NDKYS.GT.NMXDKS) CALL HWWARN('HWMODK',100,*999) + IDK(NDKYS)=IDKY + BRFRAC(NDKYS)=BRTMP + NME(NDKYS)=IMETMP + DO 20 I=1,5 + 20 IDKPRD(I,NDKYS)=ITMP(I) + ELSE + IF (NMODES(IDKY).GT.0) THEN +C First search to see if mode pre-exists + IF ((ITMP(2).GE.1.AND.ITMP(2).LE.13).OR. + & (ITMP(3).GE.1.AND.ITMP(3).LE.13)) THEN +C Partonic respect order + L=LSTRT(IDKY) + DO 30 K=1,NMODES(IDKY) + IF (ITMP(1).EQ.IDKPRD(1,L).AND. + & ITMP(2).EQ.IDKPRD(2,L).AND. + & ITMP(3).EQ.IDKPRD(3,L).AND. + & ITMP(4).EQ.IDKPRD(4,L).AND. + & ITMP(5).EQ.IDKPRD(5,L)) GOTO 90 + 30 L=LNEXT(L) + ELSE +C Allow for different order in matching + L=LSTRT(IDKY) + DO 70 I=1,NMODES(IDKY) + DO 40 J=1,5 + 40 MATCH(J)=.FALSE. + DO 60 J=1,5 + DO 50 K=1,5 + IF (.NOT.MATCH(K).AND.ITMP(K).EQ.IDKPRD(J,L)) THEN + MATCH(K)=.TRUE. + GOTO 60 + ENDIF + 50 CONTINUE + 60 CONTINUE + IF (MATCH(1).AND.MATCH(2).AND.MATCH(3).AND. + & MATCH(4).AND.MATCH(5)) GOTO 90 + 70 L=LNEXT(L) + ENDIF + ENDIF +C A new mode put decay products in table + NDKYS=NDKYS+1 + IF (NDKYS.GT.NMXDKS) CALL HWWARN('HWMODK',101,*999) + DO 80 I=1,5 + 80 IDKPRD(I,NDKYS)=ITMP(I) +C If decay consistent set up new pointers + CALL HWDCHK(IDKY,NDKYS,*980) + IF (NMODES(IDKY).EQ.0) THEN + LSTRT(IDKY)=NDKYS + IF (RLTIM(IDKY).LT.PLTCUT.AND.RMASS(IDKY).NE.ZERO) THEN + RSTAB(IDKY)=.FALSE. + DKLTM(IDKY)=RLTIM(IDKY)*RMASS(IDKY)/HBAR + ELSE + RSTAB(IDKY)=.TRUE. + ENDIF + ELSE + LNEXT(L)=NDKYS + ENDIF + NMODES(IDKY)=NMODES(IDKY)+1 + LNEXT(NDKYS)=NDKYS + L=NDKYS +C Set CMMOM if two body decay + IF (NPRODS(L).EQ.2) CMMOM(L)= + & HWUPCM(RMASS(IDKY),RMASS(IDKPRD(1,L)),RMASS(IDKPRD(2,L))) +C A Pre-existing mode, line L, add/update ME code and BR, scaling all +C other branching fractions + 90 IF (IMETMP.GT.0) NME(L)=IMETMP + IF (ABS(BRTMP-1.).LT.EPS) THEN +C This modes dominant: eliminate others + NMODES(IDKY)=1 + LSTRT(IDKY)=L + BRFRAC(L)=ONE + LNEXT(L)=L + ELSEIF (ABS(BRTMP).LT.EPS) THEN +C This mode insignificant: eliminate it + IF (NMODES(IDKY).EQ.1) THEN + RSTAB(IDKY)=.TRUE. + ELSE + J=LSTRT(IDKY) + IF (J.EQ.L) THEN + LSTRT(IDKY)=LNEXT(J) + ELSE + JPREV=J + DO 100 I=2,NMODES(IDKY) + J=LNEXT(J) + IF (J.EQ.L) LNEXT(JPREV)=LNEXT(J) + 100 JPREV=J + ENDIF +C Rescale other modes + SCALE=ONE/(ONE-BRFRAC(L)) + J=LSTRT(IDKY) + DO 110 I=1,NMODES(IDKY)-1 + BRFRAC(J)=SCALE*BRFRAC(J) + 110 J=LNEXT(J) + ENDIF + NMODES(IDKY)=NMODES(IDKY)-1 + ELSE +C Rescale all other modes + IF (NMODES(IDKY).EQ.1) THEN + BRFRAC(L)=ONE + ELSE + IF (L.EQ.NDKYS) THEN + SCALE=ONE-BRTMP + ELSE + SCALE=(ONE-BRTMP)/(ONE-BRFRAC(L)) + ENDIF + J=LSTRT(IDKY) + DO 120 I=1,NMODES(IDKY) + IF (J.NE.L) BRFRAC(J)=SCALE*BRFRAC(J) + 120 J=LNEXT(J) + BRFRAC(L)=BRTMP + ENDIF + ENDIF + ENDIF + GOTO 999 + 980 WRITE(6,990) + 990 FORMAT(1X,'Decay mode inconsistent, no modifications made') + 999 RETURN + END +CDECK ID>, HWMULT. +*CMZ :- -04/05/99 11.11.55 by Bryan Webber +*-- Author : David Ward, modified by Bryan Webber +C----------------------------------------------------------------------- + SUBROUTINE HWMULT(EPPBAR,NCHT) +C----------------------------------------------------------------------- +C Chooses charged multiplicity NCHT at the p-pbar c.m. energy EPPBAR +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + DOUBLE PRECISION HWMNBI,HWR,EPPBAR,E0,ALOGS,RK,EK,AVN,SUM,R, + & CUM(500) + INTEGER NCHT,IMAX,I,N + SAVE IMAX,CUM + EXTERNAL HWMNBI,HWR + DATA E0/0/ + IF (EPPBAR.NE.E0) THEN + E0=EPPBAR +C---Initialize + ALOGS=2.*LOG(EPPBAR) + RK=PMBK1*ALOGS+PMBK2 + IF (ABS(RK).GT.1000.) RK=1000. + EK=1./RK + AVN=PMBN1*EXP(PMBN2*ALOGS)+PMBN3 + IF (AVN.LT.ONE) AVN=1. + SUM=0. + IMAX=1 + DO 10 I=1,500 + N=2*I + CUM(I)=HWMNBI(N,AVN,EK) + IF (CUM(I).LT.1D-7*SUM) GOTO 11 + IMAX=I + SUM=SUM+CUM(I) + CUM(I)=SUM + 10 CONTINUE + 11 CONTINUE + IF (IMAX.LE.1) THEN + IMAX=1 + CUM(1)=1 + ELSEIF (IMAX.EQ.500) THEN + CALL HWWARN('HWMULT',200,*999) + ELSE + DO 12 I=1,IMAX + 12 CUM(I)=CUM(I)/SUM + ENDIF + ENDIF +C --- Select NCHT + R=HWR() + DO 20 I=1,IMAX + IF(R.GT.CUM(I)) GOTO 20 + NCHT=2*I + RETURN + 20 CONTINUE + CALL HWWARN('HWMULT',100,*999) + 999 END +CDECK ID>, HWMWGT. +*CMZ :- -02/11/93 11.11.55 by Bryan Webber +*-- Author : Bryan Webber +C----------------------------------------------------------------------- + SUBROUTINE HWMWGT +C----------------------------------------------------------------------- +C COMPUTES WEIGHT FOR MINIMUM-BIAS EVENT +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + DOUBLE PRECISION S,X,Y + INTEGER IDB,IDT,IDBT + IF (IERROR.NE.0) RETURN + IDB=IDHW(1) + IF (JDAHEP(1,1).NE.0) IDB=IDHW(JDAHEP(1,1)) + IDT=IDHW(2) + IF (JDAHEP(1,2).NE.0) IDT=IDHW(JDAHEP(1,2)) + IDBT=100*IDB+IDT + IF (IDT.GT.IDB) IDBT=100*IDT+IDB +C---USE TOTAL CROSS SECTION FITS OF DONNACHIE & LANDSHOFF +C CERN-TH.6635/92 + IF (IDBT.EQ.9173) THEN + X=21.70 + Y=98.39 + ELSEIF (IDBT.EQ.7373) THEN + X=21.70 + Y=56.08 + ELSEIF (IDBT.EQ.7330) THEN + X=13.63 + Y=36.02 + ELSEIF (IDBT.EQ.7338) THEN + X=13.63 + Y=27.56 + ELSEIF (IDBT.EQ.7334) THEN + X=11.82 + Y=26.36 + ELSEIF (IDBT.EQ.7346) THEN + X=11.82 + Y= 8.15 + ELSEIF (IDBT.EQ.7359) THEN + X=.0677 + Y=.1290 + ELSEIF (IDBT.EQ.9175) THEN + X=21.70 + Y=92.71 + ELSEIF (IDBT.EQ.7573) THEN + X=21.70 + Y=54.77 + ELSEIF (IDBT.EQ.5959) THEN +C---FOR GAMMA-GAMMA ASSUME X AND Y FACTORIZE + X=2.1E-4 + Y=3.0E-4 + ELSE + PRINT *,' IDBT=',IDBT + CALL HWWARN('HWMWGT',100,*999) + ENDIF + S=PHEP(5,3)**2 +C---EVWGT IS NON-DIFFRACTIVE CROSS SECTION IN NANOBARNS +C ASSUMING NON-DIFFRACTIVE = TOTAL*0.7 + EVWGT=.7E6*(X*S**.0808 + Y*S**(-.4525)) + 999 END +CDECK ID>, HWRAZM. +*CMZ :- -26/04/91 11.11.55 by Bryan Webber +*-- Author : Bryan Webber +C----------------------------------------------------------------------- + SUBROUTINE HWRAZM(PT,PX,PY) +C----------------------------------------------------------------------- +C RANDOMLY ROTATED 2-VECTOR (PX,PY) OF LENGTH PT +C----------------------------------------------------------------------- + DOUBLE PRECISION HWR,PT,PX,PY,C,S,CS,QT,ONE,ZERO + PARAMETER(ONE=1.0D0, ZERO=0.0D0) + EXTERNAL HWR + 10 C=2.*HWR()-1. + S=2.*HWR()-1. + CS=C*C+S*S + IF (CS.GT.ONE .OR. CS.EQ.ZERO) GOTO 10 + QT=PT/CS + PX=(C*C-S*S)*QT + PY=2.*C*S*QT + END +CDECK ID>, HWREXP. +*CMZ :- -26/04/91 11.11.55 by Bryan Webber +*-- Author : David Ward, modified by Bryan Webber +C----------------------------------------------------------------------- + FUNCTION HWREXP(AV) +C----------------------------------------------------------------------- +C Random number from dN/d(x**2)=exp(-b*x) with mean AV +C----------------------------------------------------------------------- + DOUBLE PRECISION HWREXP,HWR,AV,B,R1,R2 + EXTERNAL HWR + B=2./AV + R1=HWR() + R2=HWR() + HWREXP=-LOG(R1*R2)/B + END +CDECK ID>, HWREXQ. +*CMZ :- -02/06/94 11.02.47 by Mike Seymour +*-- Author : David Ward, modified by Bryan Webber and Mike Seymour +C----------------------------------------------------------------------- + FUNCTION HWREXQ(AV,XMAX) +C----------------------------------------------------------------------- +C Random number from dN/d(x**2)=EXQ(-b*x) with mean AV, +C But truncated at XMAX +C----------------------------------------------------------------------- + DOUBLE PRECISION HWREXQ,HWR,AV,B,BXMAX,R1,R2,XMAX,R,RMIN + EXTERNAL HWR + B=2./AV + BXMAX=B*XMAX + IF (BXMAX.LT.50) THEN + RMIN=EXP(-BXMAX) + ELSE + RMIN=0 + ENDIF + 10 R1=HWR()*(1-RMIN)+RMIN + R2=HWR()*(1-RMIN)+RMIN + R=R1*R2 + IF (R.LT.RMIN) GOTO 10 + HWREXQ=-LOG(R)/B + END +CDECK ID>, HWREXT. +*CMZ :- -26/04/91 11.11.55 by Bryan Webber +*-- Author : David Ward, modified by Bryan Webber +C----------------------------------------------------------------------- + FUNCTION HWREXT(AM0,B) +C----------------------------------------------------------------------- +C Random number from dN/d(x**2)=exp(-B*TM) distribution, where +C TM = SQRT(X**2+AM0**2). Uses Newton's method to solve F-R=0 +C----------------------------------------------------------------------- + DOUBLE PRECISION HWREXT,HWR,AM0,B,R,A,F,DF,DAM,AM + INTEGER NIT + EXTERNAL HWR + R=HWR() +C --- Starting value + AM=AM0-LOG(R)/B + DO 1 NIT=1,20 + A=EXP(-B*(AM-AM0))/(1.+B*AM0) + F=(1.+B*AM)*A-R + DF=-B**2*AM*A + DAM=-F/DF + AM=AM+DAM + IF(AM.LT.AM0) AM=AM0+.001 + IF(ABS(DAM).LT..001) GOTO 2 + 1 CONTINUE + CALL HWWARN('HWREXT',1,*2) + 2 HWREXT=AM + END +CDECK ID>, HWRGAU. +*CMZ :- -19/05/99 11.11.56 by Mike Seymour +*-- Author : Mike Seymour +C----------------------------------------------------------------------- + FUNCTION HWRGAU(J,A,B) +C----------------------------------------------------------------------- +C Gaussian random number, mean A, standard deviation B. +C Generates uncorrelated pairs and throws one of them away. +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + DOUBLE PRECISION HWRGAU,HWR,A,B,X,TRASH + INTEGER J + EXTERNAL HWR + 10 X=HWR() + IF (X.LE.ZERO.OR.X.GT.ONE) GOTO 10 + X=SQRT(-TWO*LOG(X)) + CALL HWRAZM(X,X,TRASH) + HWRGAU=A+B*X + END +CDECK ID>, HWR. +*CMZ :- -26/04/91 12.42.30 by Federico Carminati +*-- Author : F. James, modified by Mike Seymour +C----------------------------------------------------------------------- + FUNCTION HWRGEN(I) +C----------------------------------------------------------------------- +C MAIN RANDOM NUMBER GENERATOR +C USES METHOD OF l'Ecuyer, (VIA F.JAMES, COMP PHYS COMM 60(1990)329) +C----------------------------------------------------------------------- + IMPLICIT NONE + DOUBLE PRECISION HWRGEN,HWRSET,HWRGET + INTEGER I,ISEED(2),K,IZ,JSEED(2) + SAVE ISEED + DATA ISEED/12345,67890/ + K=ISEED(1)/53668 + ISEED(1)=40014*(ISEED(1)-K*53668)-K*12211 + IF (ISEED(1).LT.0) ISEED(1)=ISEED(1)+2147483563 + K=ISEED(2)/52774 + ISEED(2)=40692*(ISEED(2)-K*52774)-K*3791 + IF (ISEED(2).LT.0) ISEED(2)=ISEED(2)+2147483399 + IZ=ISEED(1)-ISEED(2) + IF (IZ.LT.1) IZ=IZ+2147483562 + HWRGEN=DBLE(IZ)*4.656613001013252D-10 +C---> (4.656613001013252D-10 = 1.D0/2147483589) + RETURN +C----------------------------------------------------------------------- + ENTRY HWRSET(JSEED) +C----------------------------------------------------------------------- + IF (JSEED(1).EQ.0.OR.JSEED(2).EQ.0) CALL HWWARN('HWRSET',99,*999) + ISEED(1)=JSEED(1) + ISEED(2)=JSEED(2) + HWRSET=0.0D0 + 999 RETURN +C----------------------------------------------------------------------- + ENTRY HWRGET(JSEED) +C----------------------------------------------------------------------- + JSEED(1)=ISEED(1) + JSEED(2)=ISEED(2) + HWRGET=0.0D0 + RETURN + END +CDECK ID>, HWRINT. +*CMZ :- -26/04/91 11.11.56 by Bryan Webber +*-- Author : Bryan Webber +C----------------------------------------------------------------------- + FUNCTION HWRINT(IMIN,IMAX) +C----------------------------------------------------------------------- +C RANDOM INTEGER IN [IMIN,IMAX]. N.B. ASSUMES IMAX.GE.IMIN +C----------------------------------------------------------------------- + DOUBLE PRECISION HWR,RN,ONE + INTEGER HWRINT,IMIN,IMAX + EXTERNAL HWR + PARAMETER (ONE=1.0D0) + 1 RN=HWR() + IF (RN.EQ.ONE) GOTO 1 + RN=RN*(IMAX-IMIN+1) + HWRINT=IMIN+INT(RN) + END +CDECK ID>, HWRLOG. +*CMZ :- -26/04/91 14.15.56 by Federico Carminati +*-- Author : Bryan Webber +C----------------------------------------------------------------------- + FUNCTION HWRLOG(A) +C----------------------------------------------------------------------- +C Returns .TRUE. with probability A +C----------------------------------------------------------------------- + DOUBLE PRECISION HWR,A,R + LOGICAL HWRLOG + EXTERNAL HWR + HWRLOG=.TRUE. + R=HWR() + IF(R.GT.A) HWRLOG=.FALSE. + END +CDECK ID>, HWRPIP. +*CMZ :- -27/07/99 13.33.03 by Mike Seymour +*-- Author : Ian Knowles +C----------------------------------------------------------------------- + SUBROUTINE HWRPIP +C----------------------------------------------------------------------- +C Generates a random primary IP using a triple Gaussian distribution +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + DOUBLE PRECISION HWRGAU,VIP(3),VIPWID(3) + INTEGER I + EXTERNAL HWRGAU + DATA VIP,VIPWID/3*0.0,.25,.015,1.8/ + DO 10 I=1,3 + 10 VTXPIP(I)=HWRGAU(I,VIP(I),VIPWID(I)) + VTXPIP(4)=0. + END +CDECK ID>, HWRPOW. +*CMZ :- -26/04/91 11.11.56 by Bryan Webber +*-- Author : Bryan Webber +C----------------------------------------------------------------------- + SUBROUTINE HWRPOW(XVAL,XJAC) +C----------------------------------------------------------------------- +C RETURNS XVAL DISTRIBUTED ON (XMIN,XMAX) LIKE XVAL**XPOW +C AND CORRESPONDING JACOBIAN FACTOR XJAC +C SET FIRST=.TRUE. IF NEW XMIN,XMAX OR XPOW +C----------------------------------------------------------------------- + DOUBLE PRECISION HWR,XVAL,XJAC,XMIN,XMAX,XPOW,P,Q,A,B,C,Z,ZERO + LOGICAL FIRST + PARAMETER(ZERO=0.0D0) + EXTERNAL HWR + SAVE Q,A,B,C + COMMON/HWRPIN/XMIN,XMAX,XPOW,FIRST + IF (FIRST) THEN + P=XPOW+1. + IF (P.EQ.ZERO) CALL HWWARN('HWRPOW',500,*999) + Q=1./P + A=XMIN**P + B=XMAX**P-A + C=B*Q + FIRST=.FALSE. + ENDIF + Z=A+B*HWR() + XVAL=Z**Q + XJAC=XVAL*C/Z + 999 END +CDECK ID>, HWRUNG. +*CMZ :- -26/04/91 14.55.45 by Federico Carminati +*-- Author : David Ward, modified by Bryan Webber +C----------------------------------------------------------------------- + FUNCTION HWRUNG(A,B) +C----------------------------------------------------------------------- +C Random number from distribution having flat top [-A,A] & gaussian +C tail of s.d. B +C----------------------------------------------------------------------- + DOUBLE PRECISION HWRUNG,HWRGAU,HWRUNI,A,B,PRUN,ZERO + LOGICAL HWRLOG + EXTERNAL HWRGAU,HWRUNI,HWRLOG + PARAMETER (ZERO=0.D0) + IF (A.EQ.ZERO) THEN + PRUN=0 + ELSE + PRUN=1./(1.+B*1.2533/A) + ENDIF + IF(HWRLOG(PRUN)) THEN + HWRUNG=HWRUNI(0,-A,A) + ELSE + HWRUNG=HWRGAU(0,ZERO,B) + HWRUNG=HWRUNG+SIGN(A,HWRUNG) + ENDIF + END +CDECK ID>, HWRUNI. +*CMZ :- -26/04/91 14.55.45 by Federico Carminati +*-- Author : Bryan Webber +C----------------------------------------------------------------------- + FUNCTION HWRUNI(I,A,B) +C----------------------------------------------------------------------- +C Uniform random random number in range [A,B] +C----------------------------------------------------------------------- + DOUBLE PRECISION HWRUNI,HWR,A,B,RN + INTEGER I + EXTERNAL HWR + RN=HWR() + HWRUNI=A+RN*(B-A) + END +CDECK ID>, HWSBRN. +*CMZ :- -18/10/99 19.08.45 by Mike Seymour +*-- Author : Bryan Webber +C----------------------------------------------------------------------- + SUBROUTINE HWSBRN(KPAR) +C----------------------------------------------------------------------- +C DOES BRANCHING OF SPACELIKE PARTON KPAR +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + DOUBLE PRECISION HWBVMC,HWR,HWRUNI,HWSTAB,HWUALF,HWUTAB,HWSGQQ, + & HWSSUD,XLAST,QNOW,QLST,QP,QMIN,QLAM,QSAV,SMAX,SLST,SNOW,RN,SUDA, + & SUDB,ZZ,ENOW,XI,PMOM,DIST(13),DMIN,X1,X2,REJFAC,OTHXI,OTHZ,QTMP, + & PTMP(2),JAC,OTHJAC,S,T,U + INTEGER N0,IS,ID,ID1,ID2,IDHAD,N1,I,MQ,NTRY,NDEL,NA,NB,IW1,IW2, + & KPAR,LPAR,MPAR,ISUD(13),IREJ,NREJ + LOGICAL HWSVAL,FORCE,VALPAR,FTMP + EXTERNAL HWBVMC,HWR,HWRUNI,HWSTAB,HWUALF,HWUTAB,HWSGQQ,HWSSUD, + & HWSVAL + COMMON/HWTABC/XLAST,N0,IS,ID + DATA ISUD,DMIN/2,2,3,4,5,6,2,2,3,4,5,6,1,1.D-15/ + IF (IERROR.NE.0) RETURN + ID=IDPAR(KPAR) +C--TEST FOR PARTON TYPE + IF (ID.LE.13) THEN + IS=ISUD(ID) + ELSEIF (ID.GE.208) THEN + IS=7 + ELSE + IS=0 + END IF + QNOW=-1. + IF (IS.NE.0) THEN +C--SPACELIKE PARTON BRANCHING + QLST=PPAR(1,KPAR) + IDHAD=IDHW(INHAD) + VALPAR=HWSVAL(ID) + QP=HWBVMC(ID) + XLAST=XFACT*PPAR(4,KPAR) + IF (XLAST.GE.ONE) CALL HWWARN('HWSBRN',107,*999) +C--SET UP Q BOUNDARY + IF (VALPAR) THEN + QMIN=QG/(1.-XLAST) + ELSEIF (ID.EQ.13) THEN + QMIN=QV/(1.-XLAST) + ELSE + QMIN=.5*(QP+QV+SQRT((QP-QV)**2+4.*QP*QV*XLAST))/(1.-XLAST) + ENDIF + QSAV=QMIN + IF (QMIN.LE.QSPAC.AND.ISPAC.LT.2) THEN + QMIN=QSPAC + N1=NSPAC(IS) + ELSEIF (QMIN.LE.QEV(1,IS)) THEN + QMIN=QEV(1,IS) + N1=1 + ELSE + DO 110 I=2,NQEV + IF (QEV(I,IS).GT.QMIN) GOTO 120 + 110 CONTINUE + 120 N1=I-1 + ENDIF + N0=N1-1 + MQ=NQEV-N0 + NTRY=0 + 125 NTRY=NTRY+1 + NREJ=1 + IF (QLST.GT.QMIN.AND..NOT.NOSPAC.OR..NOT.VALPAR) THEN + IF (QLST.LE.QMIN) THEN +C--CHECK PHASE SPACE FOR FORCED SPLITTING OF NON-VALENCE PARTON + IF (QLST.LT.QSAV) CALL HWWARN('HWSBRN',ISLENT*105,*999) + FORCE=.TRUE. + QNOW=(QLST/QSAV)**HWR()*QSAV + ELSE +C--ENHANCE EMISSION BY A FACTOR OF TWO IF THIS BRANCH +C IS CAPABLE OF BEING THE HARDEST SO FAR + IF (QLST.GT.HARDST) NREJ=2 + QTMP=-1 + DO 300 IREJ=1,NREJ +C--FIND NEW VALUE OF SUD/DIST + CALL HWSFUN(XLAST,QMIN,IDHAD,NSTRU,DIST,JNHAD) + IF (ID.EQ.13) DIST(ID)=DIST(ID)*HWSGQQ(QMIN) + IF (DIST(ID).LT.DMIN) DIST(ID)=DMIN + SMAX=HWUTAB(SUD(N1,IS),QEV(N1,IS),MQ,QMIN,INTER)/DIST(ID) + CALL HWSFUN(XLAST,QLST,IDHAD,NSTRU,DIST,JNHAD) + IF (ID.EQ.13) DIST(ID)=DIST(ID)*HWSGQQ(QLST) + IF (DIST(ID).LT.DMIN) DIST(ID)=DMIN + SLST=HWUTAB(SUD(N1,IS),QEV(N1,IS),MQ,QLST,INTER)/DIST(ID) + RN=HWR() + IF (RN.EQ.ZERO) THEN + SNOW=SLST*2. + ELSE + SNOW=SLST/RN + ENDIF + IF (VALPAR.AND.SNOW.GE.SMAX) GOTO 200 + IF (SNOW.LT.SMAX.AND..NOT.NOSPAC) THEN + FORCE=.FALSE. + ELSE +C--FORCE SPLITTING OF NON-VALENCE PARTON + FORCE=.TRUE. + QNOW=(MIN(QLST,1.1*QMIN)/QSAV)**HWR()*QSAV + ENDIF + IF (QNOW.LT.ZERO) THEN +C--BRANCHING OCCURS. FIRST CHECK FOR MONOTONIC FORM FACTOR + SUDA=SMAX + NDEL=32 + NA=N1 + 130 NB=NA+NDEL + IF (NB.GT.NQEV) CALL HWWARN('HWSBRN',103,*999) + CALL HWSFUN(XLAST,QEV(NB,IS),IDHAD,NSTRU,DIST,JNHAD) + IF (ID.EQ.13) DIST(ID)=DIST(ID)*HWSGQQ(QEV(NB,IS)) + IF (DIST(ID).LT.DMIN) DIST(ID)=DMIN + SUDB=SUD(NB,IS)/DIST(ID) + IF (SUDB.GT.SUDA) THEN + SUDA=SUDB + NA=NB + GOTO 130 + ELSEIF (NA.NE.N1) THEN + IF (SUDB.LT.SNOW) THEN + NDEL=NDEL/2 + IF (NDEL.EQ.0) CALL HWWARN('HWSBRN',100,*999) + GOTO 130 + ENDIF + N1=NB + N0=N1-1 + MQ=NQEV-N0 + ENDIF +C--NOW FIND NEW Q + QNOW=HWSTAB(QEV(N1,IS),HWSSUD,MQ,SNOW,INTER) + IF (QNOW.LE.QMIN.OR.QNOW.GT.QLST) THEN +C--INTERPOLATION PROBLEM: USE LINEAR INSTEAD +C CALL HWWARN('HWSBRN',1,*999) + QNOW=HWRUNI(0,QMIN,QLST) + ENDIF + ENDIF + 200 CONTINUE + IF (QNOW.GT.QTMP) THEN + QTMP=QNOW + FTMP=FORCE + ENDIF + QNOW=-1 + 300 CONTINUE + QNOW=QTMP + FORCE=FTMP + ENDIF + IF (QNOW.LT.ZERO) GOTO 210 +C--NOW FIND NEW X + CALL HWSFBR(XLAST,QNOW,FORCE,ID,1,ID1,ID2,IW1,IW2,ZZ) + IF (ID1.LT.0) THEN +C--NO PHASE SPACE FOR BRANCHING + FROST=.TRUE. + RETURN + ELSEIF (ID1.EQ.0) THEN +C--BRANCHING REJECTED: REDUCE Q AND REPEAT + IF (NTRY.GT.NBTRY.OR.IERROR.NE.0) + $ CALL HWWARN('HWSBRN',102,*999) + QLST=QNOW + QNOW=-1. + GOTO 125 + ELSEIF (ID1.EQ.59) THEN +C--ANOMALOUS PHOTON SPLITTING: ADD PT TO INTRINSIC PT AND STOP BRANCHING + IF (IDHAD.NE.59) CALL HWWARN('HWSBRN',109,*999) + ENOW=PPAR(4,KPAR)/XLAST + XI=(QNOW/ENOW)**2 + QLAM=QNOW*(1.-XLAST) + IF ((2.-XI)*QLAM**2.GT.EMSCA**2) THEN +C--BRANCHING REJECTED: REDUCE Q AND REPEAT + IF (NTRY.GT.NBTRY) CALL HWWARN('HWSBRN',110,*999) + QLST=QNOW + QNOW=-1. + GOTO 125 + ENDIF + CALL HWRAZM(QNOW*(1.-XLAST),PTMP(1),PTMP(2)) + CALL HWVSUM(2,PTMP,PTINT(1,JNHAD),PTINT(1,JNHAD)) + PTINT(3,JNHAD)=PTINT(1,JNHAD)**2+PTINT(2,JNHAD)**2 + ANOMSC(1,JNHAD)=QNOW + ANOMSC(2,JNHAD)=QNOW*(1.-XLAST) + QNOW=-1. + QLST=QNOW + GOTO 125 + ELSEIF (FORCE.AND..NOT.HWSVAL(ID1).AND.ID1.NE.13) THEN +C--FORCED BRANCHING PRODUCED A NON-VALENCE PARTON: TRY AGAIN + IF (NTRY.GT.NBTRY) CALL HWWARN('HWSBRN',108,*999) + QLST=QNOW + QNOW=-1. + GOTO 125 + ENDIF + ENDIF + 210 CONTINUE + IF (QNOW.GT.ZERO) THEN +C--BRANCHING HAS OCCURRED + ENOW=PPAR(4,KPAR)/ZZ + XI=(QNOW/ENOW)**2 + QLAM=QNOW*(1.-ZZ) + IF (SUDORD.EQ.1.AND.HWUALF(2,QLAM).LT.HWR() .OR. + & (2.-XI)*QLAM**2.GT.EMSCA**2.AND..NOT.FORCE) THEN +C--BRANCHING REJECTED: REDUCE Q AND REPEAT + IF (NTRY.GT.NBTRY) CALL HWWARN('HWSBRN',104,*999) + QLST=QNOW + QNOW=-1. + GOTO 125 + ENDIF +C--IF THIS IS HARDEST EMISSION SO FAR, APPLY MATRIX-ELEMENT CORRECTION + IF (.NOT.FORCE) THEN + REJFAC=1 + IF (QLAM.GT.HARDST .AND. ID.NE.13) THEN + IF (MOD(ISTHEP(JCOPAR(1,1)),10).GE.3) THEN +C---COLOUR PARTNER IS OUTGOING (X1=XP, X2=ZP) + X2=SQRT((ZZ**2-(1-ZZ)*XI)**2+2*(ZZ*(1-ZZ))**2*XI*(2-XI)) + X1=(ZZ**2+(1-ZZ)*XI-X2)/(2*(1-ZZ)*XI) + X2=(ZZ**2-(1-ZZ)*XI+X2)/(2*ZZ**2) + IF (ID2.EQ.13) THEN +C---GLUON EMISSION + REJFAC=ZZ**3*(1-X1-X2+2*X1*X2) + $ /(X1**2*(1-ZZ)*(ZZ+XI*(1-ZZ))) + $ *(1+ZZ**2)/((1-ZZ)*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=2*(1-X1)/(1-X1+2*(3*X1-2)*X2*(1-X2)) + IF (OTHXI.LT.ONE) THEN + OTHZ=(1-(2*X2-1)*SQRT((3*X1-2)/X1))/2 + REJFAC=REJFAC+SQRT(3-2/X1)/(X1**2*OTHZ*(1-OTHZ)) + $ *(1+(1-OTHZ)**2)/(OTHZ*OTHXI) + $ *(1-X1)*(1-X2)/ + $ (1+(1-X1-X2+2*X1*X2)**2+2*(1-X1)*(1-X2)*X1*X2) + ENDIF + ELSEIF (ID1.EQ.13) THEN +C---GLUON SPLITTING + REJFAC=ZZ**3*(1-X1-X2+2*X1*X2) + $ /(X1**2*(1-ZZ)*(ZZ+XI*(1-ZZ))) + $ *(ZZ**2+(1-ZZ)**2)/XI + $ *(1-X2)/ + $ (( X1+X2-2*X1*X2)**2+2*(1-X1)*(1-X2)*X1*X2 + $ +(1-X1-X2+2*X1*X2)**2+2*(1-X1)*(1-X2)*X1*X2) + ENDIF + ELSE +C---COLOUR PARTNER IS ALSO INCOMING + T=-(1-ZZ)*XI/ZZ**2 + S=2*(ZZ**2+(1-ZZ)*XI)/(ZZ**2*(2*ZZ+XI*(1-ZZ))) + U=1-S-T + JAC=-T*(1-T)/S**2*ZZ**5/(XI*(1-ZZ)**2*(ZZ+XI*(1-ZZ))) + IF (ID2.EQ.13) THEN +C---GLUON EMISSION + REJFAC=(1+ZZ**2)/((1-ZZ)*ZZ*XI) + & *JAC*S**2*T*U/((1-U)**2+(1-T)**2) +C---CHECK WHETHER IT IS IN THE OVERLAPPING REGION + OTHZ=(1+SQRT(1-2*U*(1-U)/S))/U + OTHXI=2*(1-OTHZ+T/S)/(1-OTHZ) + IF (OTHXI.LT.OTHZ**2) THEN + OTHJAC=-U*(1-U)/S**2*OTHZ**5/(OTHXI* + & (1-OTHZ)**2*(OTHZ+OTHXI*(1-OTHZ))) + REJFAC=REJFAC+(1+OTHZ**2)/((1-OTHZ)*OTHZ*OTHXI) + & *OTHJAC*S**2*T*U/((1-U)**2+(1-T)**2) + ENDIF + ELSEIF (ID1.EQ.13) THEN +C---GLUON SPLITTING + REJFAC=-((1-ZZ)**2+ZZ**2)/(ZZ*XI) + & *JAC*S**3*T/((1-S)**2+(1-T)**2) + ENDIF + ENDIF + ENDIF + IF (NREJ*REJFAC*HWR().GT.ONE) THEN + QLST=QNOW + QNOW=-1. + GOTO 125 + ENDIF + IF (QLAM.GT.HARDST) HARDST=QLAM + ENDIF + IF (IW2.GT.IW1) THEN + LPAR=NPAR+1 + MPAR=NPAR+2 +C---NEW MOTHER-DAUGHTER RELATIONS +C N.B. DEFINED MOVING AWAY FROM HARD PROCESS + JDAPAR(1,KPAR)=LPAR + JDAPAR(2,KPAR)=MPAR +C---NEW COLOUR CONNECTIONS + JCOPAR(3,KPAR)=MPAR + JCOPAR(4,KPAR)=LPAR + JCOPAR(1,MPAR)=KPAR + JCOPAR(2,MPAR)=LPAR + JCOPAR(1,LPAR)=MPAR + JCOPAR(2,LPAR)=KPAR + ELSE + MPAR=NPAR+1 + LPAR=NPAR+2 + JDAPAR(1,KPAR)=MPAR + JDAPAR(2,KPAR)=LPAR + JCOPAR(3,KPAR)=LPAR + JCOPAR(4,KPAR)=MPAR + JCOPAR(1,MPAR)=LPAR + JCOPAR(2,MPAR)=KPAR + JCOPAR(1,LPAR)=KPAR + JCOPAR(2,LPAR)=MPAR + ENDIF + JMOPAR(1,LPAR)=KPAR + JMOPAR(1,MPAR)=KPAR + IDPAR(LPAR)=ID1 + IDPAR(MPAR)=ID2 + TMPAR(LPAR)=.FALSE. + TMPAR(MPAR)=.TRUE. + PPAR(1,LPAR)=QNOW + PPAR(2,LPAR)=XI + PPAR(4,LPAR)=ENOW + PPAR(1,MPAR)=QNOW*(1.-ZZ) + PPAR(2,MPAR)=XI + PPAR(4,MPAR)=ENOW*(1.-ZZ) + NPAR=NPAR+2 + ENDIF + ENDIF + IF (QNOW.LT.ZERO) THEN +C--BRANCHING STOPS + JDAPAR(1,KPAR)=0 + JDAPAR(2,KPAR)=0 + JCOPAR(3,KPAR)=0 + JCOPAR(4,KPAR)=0 + IF (ID.LE.13) THEN +C---PUT SPECTATOR (APPROXIMATELY) ON-SHELL + XLAST=XFACT*PPAR(4,KPAR) + IF ((1-XLAST)**2.LT.(RMASS(ID)**2+PTINT(3,JNHAD))*XFACT**2) + & THEN + FROST=.TRUE. + RETURN + ENDIF + PPAR(5,KPAR)=-(RMASS(ID)**2*XLAST+PTINT(3,JNHAD))/(1.-XLAST) + & +XLAST*SIGN(PHEP(5,INHAD)**2,PHEP(5,INHAD)) + ELSEIF (ID.EQ.IDHW(INHAD)) THEN +C---IF INCOMING PARTON IS INCOMING BEAM, ALLOW IT TO BE OFF-SHELL + PPAR(5,KPAR)=SIGN(PHEP(5,INHAD)**2,PHEP(5,INHAD)) + ELSE + PPAR(5,KPAR)=RMASS(ID)**2 + ENDIF + PMOM=PPAR(4,KPAR)**2-PPAR(5,KPAR) + IF (PMOM.LT.ZERO) THEN + FROST=.TRUE. + RETURN + ENDIF + PPAR(3,KPAR)=SQRT(PMOM) + ENDIF + 999 END +CDECK ID>, HWSDGG. +*CMZ := =26/04/91 12.47.48 by Federico Carminati +*-- Author : Drees, Grassie, Charchula, modified by Bryan Webber +C =============================================================== +C DREES & GRASSIE PARAMETRIZATION OF PHOTON STRUCTURE FUNCTION +C +C HWSDGQ(X,Q2,NFL,NCH) - X*QUARK_IN_PHOTON/ALPHA (!) +C HWSDGG(X,Q2,NFL) - X*GLUON_IN_PHOTON/ALPHA (!) +C WHERE: +C (INTEGER) NCH - QUARK CHARGE: 1 FOR 1/3 +C 2 FOR 2/3 +C (INTEGER) NFL - NUMBER OF QUARK FLAVOURS /3 OR 4/ +C Q2 - SQUARE OF MOMENTUM Q /IN GEV2/ +C X - LONGITUDINAL FRACTION +C LAMBDA=0.4 GEV +C +C NFL=3: 1 < Q2 < 50 GEV^2 +C NFL=4: 20 < Q2 < 500 GEV^2 +C NFL=5: 200 < Q2 < 10^4 GEV^2 +C +C +C KRZYSZTOF CHARCHULA /14.02.1989/ +C================================================================ +C +C PS. Note that for the case of three flavors, one has to add +C the QPM charm contribution for getting F2. +C +C================================================================ +C MODIFIED FOR HERWIG BY BRW 19/4/91 +C--- ----------------------------------------------- +C GLUON PART OF THE PHOTON SF +C--- ----------------------------------------------- + FUNCTION HWSDGG(X,Q2,NFL) + IMPLICIT REAL (A-H,P-Z) + INTEGER NFL + DIMENSION A(3,4,3),AT(3) + ALAM2=0.160 + T=LOG(Q2/ALAM2) +C- --- CHECK WHETHER NFL HAVE RIGHT VALUES ----- + IF (.NOT.((NFL.EQ.3).OR.(NFL.EQ.4).OR.(NFL.EQ.5)))THEN + 130 WRITE(6,131) + 131 FORMAT(' NUMBER OF FLAVOURS(NFL) HAS NOT BEEN SET TO: 3,4 OR 5;'/ + *' NFL=3 IS ASSUMED') + NFL=3 + ELSEIF (T.LE.0) THEN + WRITE(6,132) + 132 FORMAT(' HWSDGG CALLED WITH SCALE < LAMBDA. RETURNING ZERO.') + HWSDGG=0 + RETURN + ENDIF +C ------ INITIALIZATION OF PARAMETERS ARRAY ----- + DATA(((A(I,J,K),I=1,3),J=1,4),K=1,3)/ + + -0.20700,-0.19870, 5.11900, + + 0.61580, 0.62570,-0.27520, + + 1.07400, 8.35200,-6.99300, + + 0.00000, 5.02400, 2.29800, + + 0.8926E-2, 0.05090,-0.23130, + + 0.659400, 0.27740, 0.13820, + + 0.476600,-0.39060, 6.54200, + + 0.019750,-0.32120, 0.51620, + + 0.031970, -0.618E-2, -0.1216, + + 1.0180, 0.94760, 0.90470, + + 0.24610, -0.60940, 2.6530, + + 0.027070, -0.010670, 0.2003E-2/ +C ------ Q2 DEPENDENCE ----------- + LF=NFL-2 + DO 20 I=1,3 + AT(I)=A(I,1,LF)*T**A(I,2,LF)+A(I,3,LF)*T**(-A(I,4,LF)) + 20 CONTINUE +C ------ GLUON DISTRIBUTION ------------- + HWSDGG=AT(1)*X**AT(2)*(1.0-X)**AT(3)/137. + RETURN + END +CDECK ID>, HWSDGQ. +*CMZ :- -26/04/91 13.04.45 by Federico Carminati +*-- Author : Drees, Grassie, Charchula, modified by Bryan Webber +C -------------------------------------- +C QUARK PART OF THE PHOTON SF +C -------------------------------------- + FUNCTION HWSDGQ(X,Q2,NFL,NCH) + IMPLICIT REAL (A-H,P-Z) + INTEGER NFL,NCH + DIMENSION A(5,4,2,3),AT(5,2),XQPOM(2),E(2) + COMMON/DG/F2 +C SQUARE OF LAMBDA=0.4 GEV + ALAM2=0.160 + T=LOG(Q2/ALAM2) +C +C CHECK WHETHER NFL AND NCH HAVE RIGHT VALUES +C + IF(.NOT.((NFL.EQ.3).OR.(NFL.EQ.4).OR.(NFL.EQ.5))) THEN + 110 WRITE(6,111) + 111 FORMAT('NUMBER OF FLAVOURS (NFL) HAS NOT BEEN SET TO: 3,4 OR 5'/ + *' NFL=3 IS ASSUMED') + NFL=3 + ELSEIF (T.LE.0) THEN + WRITE(6,132) + 132 FORMAT(' HWSDGQ CALLED WITH SCALE < LAMBDA. RETURNING ZERO.') + HWSDGQ=0 + RETURN + ENDIF + IF (.NOT.((NCH.EQ.1).OR.(NCH.EQ.2))) THEN + 120 WRITE(6,121) + 121 FORMAT(' QUARK CHARGE NUMBER (NCH) HAS NOT BEEN SET', + *' TO 1 OR 2;'/ + *' NCH=1 IS ASSUMED') + NCH=1 + ENDIF +C ------ INITIALIZATION ------ + DATA(((A(I,J,K,1),I=1,5),J=1,4),K=1,2)/ + + 2.28500, 6.07300, -0.42020,-0.08080, 0.05530, + +-0.01530, -0.81320, 0.01780, 0.63460, 1.13600, + + 1.3300E3,-41.3100, 0.92160, 1.20800, 0.95120, + + 4.21900, 3.16500, 0.18000, 0.20300, 0.01160, + +16.6900, 0.17600, -0.02080,-0.01680,-0.19860, + +-0.79160, 0.04790, 0.3386E-2,1.35300, 1.10000, + + 1.0990E3, 1.04700, 4.85300, 1.42600, 1.13600, + + 4.42800, 0.02500, 0.84040, 1.23900,-0.27790/ + DATA(((A(I,J,K,2),I=1,5),J=1,4),K=1,2)/ + +-0.37110,-0.17170, 0.087660,-0.89150,-0.18160, + + 1.06100, 0.78150, 0.021970, 0.28570, 0.58660, + + 4.75800, 1.53500, 0.109600, 2.97300, 2.42100, + +-0.01500, 0.7067E-2,0.204000, 0.11850, 0.40590, + +-0.12070,25.00000,-0.012300,-0.09190, 0.020150, + + 1.07100,-1.64800, 1.162000, 0.79120, 0.98690, + + 1.97700,-0.015630,0.482400, 0.63970,-0.070360, + +-0.8625E-2,6.43800,-0.011000, 2.32700, 0.016940/ + DATA(((A(I,J,K,3),I=1,5),J=1,4),K=1,2)/ + +15.80, 2.7420, 0.029170,-0.03420, -0.023020, + +-0.94640, -0.73320, 0.046570, 0.71960, 0.92290, + +-0.50, 0.71480, 0.17850, 0.73380, 0.58730, + +-0.21180, 3.2870, 0.048110, 0.081390,-0.79E-4, + + 6.7340, 59.880, -0.3226E-2,-0.03321, 0.10590, + +-1.0080, -2.9830, 0.84320, 0.94750, 0.69540, + +-0.085940, 4.480, 0.36160, -0.31980, -0.66630, + + 0.076250, 0.96860, 0.1383E-2, 0.021320, 0.36830/ + CF=10.0 +C ------- EVALUATION OF PARAMETERS IN Q2 --------- + E(1)=1.0 + IF (NFL.EQ.3) THEN + E(2)=9.0 + LF=1 + ELSEIF (NFL.EQ.4) THEN + E(2)=10.0 + LF=2 + ELSEIF (NFL.EQ.5) THEN + E(2)=55.0/6.0 + LF=3 + ENDIF + DO 10 J=1,2 + DO 20 I=1,5 + ATP=A(I,1,J,LF)*T**A(I,2,J,LF) + AT(I,J)=ATP+A(I,3,J,LF)*T**(-A(I,4,J,LF)) + 20 CONTINUE + 10 CONTINUE + DO 30 J=1,2 + POM1=X*(X*X+(1.0-X)**2)/(AT(1,J)-AT(2,J)*ALOG(1.0-X)) + POM2=AT(3,J)*X**AT(4,J)*(1.0-X)**AT(5,J) + XQPOM(J)=E(J)*POM1+POM2 + 30 CONTINUE +C ------- QUARK DISTRIBUTIONS ---------- + IF (NFL.EQ.3) THEN + IF (NCH.EQ.2) THEN + HWSDGQ=1.0/6.0*(XQPOM(2)+9.0*XQPOM(1)) + ELSEIF(NCH.EQ.1) THEN + HWSDGQ=1.0/6.0*(XQPOM(2)-9.0/2.0*XQPOM(1)) + ENDIF + F2=2.0/9.0*XQPOM(2)+XQPOM(1) + ELSEIF (NFL.EQ.4) THEN + IF (NCH.EQ.2) THEN + HWSDGQ=1.0/8.0*(XQPOM(2)+6.0*XQPOM(1)) + ELSEIF(NCH.EQ.1) THEN + HWSDGQ=1.0/8.0*(XQPOM(2)-6.0*XQPOM(1)) + ENDIF + F2=5.0/18.0*XQPOM(2)+XQPOM(1) + ELSEIF (NFL.EQ.5) THEN + IF (NCH.EQ.2) THEN + HWSDGQ=1.0/10.0*(XQPOM(2)+15.0/2.0*XQPOM(1)) + ELSEIF(NCH.EQ.1) THEN + HWSDGQ=1.0/10.0*(XQPOM(2)-5.0*XQPOM(1)) + ENDIF + F2=11.0/45.0*XQPOM(2)+XQPOM(1) + ENDIF + HWSDGQ=HWSDGQ/137. + RETURN + END +CDECK ID>, HWSFBR. +*CMZ :- -15/07/92 14.08.45 by Mike Seymour +*-- Author : Bryan Webber +C----------------------------------------------------------------------- + SUBROUTINE HWSFBR(X,QQ,FORCED,ID,IW,ID1,ID2,IW1,IW2,Z) +C----------------------------------------------------------------------- +C FINDS BRANCHING (ID1->ID+ID2) AND Z=X/X1 IN BACKWARD +C EVOLUTION AT ENERGY FRACTION X AND SCALE QQ +C +C FORCED=.TRUE. FORCES SPLITTING OF NON-VALENCE PARTON +C +C IW,IW1,IW2 ARE COLOUR CONNECTION WORDS +C +C ID1.LT.0 ON RETURN MEANS NO PHASE SPACE +C ID1.EQ.0 ON RETURN FLAGS REJECTED BRANCHINGS +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + DOUBLE PRECISION HWBVMC,HWR,HWUALF,HWUAEM,QP,X,QQ,Z,WQG,WQV, + & WQP,XQV,ZMIN,ZMAX,YMIN,YMAX,DELY,YY,PSUM,EZ,WQN,WR,ZR,WZ,ZZ,AZ, + & PVAL,EY,DIST(13),PROB(13,100),PPHO + INTEGER ID,IW,ID1,ID2,IW1,IW2,NZ,IDHAD,IP,IZ + LOGICAL HWRLOG,HWSVAL,FORCED,NONF,NONV,PHOTPR + EXTERNAL HWBVMC,HWR,HWUALF,HWUAEM,HWRLOG,HWSVAL + ID1=-1 + QP=HWBVMC(ID) + WQG=1.-QG/QQ + WQV=1.-QV/QQ + WQP=1.-QP/QQ + XQV=X/WQV + NONV=.NOT.HWSVAL(ID) + NONF=.NOT.FORCED + 5 IF (ID.EQ.13) THEN + ZMIN=X + IF (NONF) THEN + ZMAX=WQG + ELSE + ZMAX=WQV + ENDIF + ELSE + IF (NONV) THEN + ZMIN=XQV + IF (NONF) THEN + ZMAX=WQG + ELSE + ZMAX=WQP + ENDIF + ELSE + ZMIN=X + ZMAX=MAX(WQG,WQP) + ENDIF + ENDIF + IF (ZMIN.GE.ZMAX) RETURN + ID1=0 +C---INTERPOLATION VARIABLE IS Y=LN(Z/(1-Z)) + YMIN=LOG(ZMIN/(1.-ZMIN)) + YMAX=LOG(ZMAX/(1.-ZMAX)) + DELY=YMAX-YMIN + NZ=MIN(INT(ZBINM*DELY)+1,NZBIN) + DELY=(YMAX-YMIN)/FLOAT(NZ) + YY=YMIN+0.5*DELY + PSUM=0. + IDHAD=IDHW(INHAD) +C---SET UP TABLES FOR CHOOSING BRANCHING + DO 40 IZ=1,NZ + EZ=EXP(YY) + WR=1.+EZ + ZR=WR/EZ + WZ=1./WR + ZZ=WZ*EZ + AZ=WZ*ZZ*HWUALF(5-2*SUDORD,MAX(WZ*QQ,QG)) + CALL HWSFUN(X*ZR,QQ,IDHAD,NSTRU,DIST,JNHAD) + IF (ID.NE.13) THEN +C---SPLITTING INTO QUARK + DO 10 IP=1,ID-1 + 10 PROB(IP,IZ)=PSUM + IF (NONF) PSUM=PSUM+DIST(ID)*AZ*CFFAC*(1.+ZZ*ZZ)*WR + DO 20 IP=ID,12 + 20 PROB(IP,IZ)=PSUM + PSUM=PSUM+DIST(13)*AZ*0.5*(ZZ*ZZ+WZ*WZ) + PROB(13,IZ)=PSUM + ELSE +C---SPLITTING INTO GLUON + DO 30 IP=1,12 + PSUM=PSUM+DIST(IP)*AZ*CFFAC*(1.+WZ*WZ)*ZR + 30 PROB(IP,IZ)=PSUM + IF (NONF) PSUM=PSUM+DIST(13)*AZ*2.*CAFAC*(WZ*ZR+ZZ*WR+WZ*ZZ) + PROB(13,IZ)=PSUM + ENDIF + 40 YY=YY+DELY + 50 PHOTPR=IDHAD.EQ.59.AND.ID.NE.13 + IF (PHOTPR) THEN +C---ALLOW ANOMALOUS PHOTON SPLITTING + PPHO=HWUAEM(-QQ*QQ)*CAFAC*(ZMIN**2+(1.-ZMIN)**2) + & *ICHRG(ID)**2/(18.*PIFAC) + IF (PPHO.GT.(PPHO+PSUM*DELY)*HWR()) THEN +C---ANOMALOUS PHOTON SPLITTING OCCURRED + ID1=59 + RETURN + ENDIF + ENDIF + IF (PSUM.LE.ZERO) RETURN +C---CHOOSE Z + PVAL=PSUM*HWR() + DO 60 IZ=1,NZ + IF (PROB(13,IZ).GT.PVAL) GOTO 70 + 60 CONTINUE + IZ=NZ + 70 EY=EXP(YMIN+DELY*(FLOAT(IZ)-HWR())) + ZZ=EY/(1.+EY) +C---CHOOSE BRANCHING + DO 80 IP=1,13 + IF (PROB(IP,IZ).GT.PVAL) GOTO 90 + 80 CONTINUE + IP=13 +C---CHECK THAT Z IS INSIDE PHASE SPACE (RETURN IF NOT) + 90 CONTINUE + IF (ID.NE.13) THEN + IF (IP.EQ.ID) THEN + IF ((NONV.AND.ZZ*WQP.LT.XQV).OR.ZZ.GT.WQG) THEN + IF (PHOTPR) GOTO 50 + RETURN + ENDIF + ELSE + IF (ZZ.LT.XQV.OR.ZZ.GT.WQP) THEN + IF (PHOTPR) GOTO 50 + RETURN + ENDIF + ENDIF + ELSE + IF (IP.EQ.ID) THEN + IF (ZZ.LT.XQV.OR.ZZ.GT.WQG) RETURN + ELSEIF (.NOT.HWSVAL(IP)) THEN + WQN=1.-HWBVMC(IP)/QQ + IF (ZZ*WQN.LT.XQV.OR.ZZ.GT.WQN) RETURN + ENDIF + ENDIF +C---EVERYTHING OK: LABEL NEW BRANCHES + Z=ZZ + ID1=IP + IW1=IW*2 + IW2=IW1+1 + IF (ID.LE.6) THEN + IF (ID1.EQ.13) THEN + ID2=ID+6 + ELSE + ID2=13 + IW2=IW1 + ENDIF + ELSE IF (ID.NE.13) THEN + IF (ID1.EQ.13) THEN + ID2=ID-6 + IW2=IW1 + ELSE + ID2=13 + ENDIF + ELSE + ID2=ID1 + IF (ID1.EQ.13) THEN + IF (HWRLOG(HALF)) IW2=IW1 + ELSE IF (ID1.GT.6) THEN + IW2=IW1 + END IF + END IF + IF (IW2.EQ.IW1) IW1=IW1+1 + 999 END +CDECK ID>, HWSFUN. +*CMZ :- -02/05/91 11.30.51 by Federico Carminati +*-- Author : Miscellaneous, combined by Bryan Webber +C----------------------------------------------------------------------- + SUBROUTINE HWSFUN(X,SCALE,IDHAD,NSET,DIST,IBEAM) +C----------------------------------------------------------------------- +C NUCLEON AND PION STRUCTURE FUNCTIONS DIST=X*QRK(X,Q=SCALE) +C +C IDHAD = TYPE OF HADRON: +C 73=P 91=PBAR 75=N 93=NBAR 38=PI+ 30=PI- 59=PHOTON +C +C NEW SPECIAL CODES: +C 71=`REMNANT PHOTON' 72=`REMNANT NUCLEON' +C +C NSET = STRUCTURE FUNCTION SET +C = 1,2 FOR DUKE+OWENS SETS 1,2 (SOFT/HARD GLUE) +C = 3,4 FOR EICHTEN ET AL SETS 1,2 (NUCLEON ONLY) +C = 5 FOR OWENS SET 1.1 (PREPRINT FSU-HEP-910606) +C +C FOR PHOTON DREES+GRASSIE IS USED +C +C N.B. IF IBEAM.GT.0.AND.MODPDF(IBEAM).GE.0 THEN NSET IS +C IGNORED AND CERN PDFLIB WITH AUTHOR GROUP=AUTPDF(IBEAM) AND +C SET=MODPDF(IBEAM) IS USED. FOR COMPATABILITY WITH VERSIONS 3 +C AND EARLIER, AUTPDF SHOULD BE SET TO 'MODE' +C NOTE THAT NO CONSISTENCY CHECK IS MADE, FOR EXAMPLE THAT THE +C REQUESTED SET FOR A PHOTON IS ACTUALLY A PHOTON SET +C +C IF (ISPAC.GT.0) SCALE IS REPLACED BY MAX(SCALE,QSPAC) +C +C FOR PHOTON, IF (PHOMAS.GT.0) THEN QUARK DISTRIBUTIONS ARE +C SUPPRESSED BY LOG((Q**2+PHOMAS**2)/(P**2+PHOMAS**2)) +C L = -------------------------------------- , +C LOG((Q**2+PHOMAS**2)/( PHOMAS**2)) +C WHILE GLUON DISTRIBUTIONS ARE SUPPRESSED BY L**2, +C WHERE Q=SCALE AND P=VIRTUALITY OF THE PHOTON +C +C DUKE+OWENS = D.W.DUKE AND J.F.OWENS, PHYS. REV. D30 (1984) 49 (P/N) +C + J.F.OWENS, PHYS. REV. D30 (1984) 943 (PI+/-) +C WITH EXTRA SIGNIFICANT FIGURES VIA ED BERGER +C WARNING....MOMENTUM SUM RULE BADLY VIOLATED ABOVE 1 TEV +C DUKE+OWENS SETS 1,2 OBSOLETE. SET 1 UPDATED TO OWENS 1.1 (1991) +C PION NOT RELIABLE ABOVE SCALE = 50 GEV +C +C EICHTEN ET AL = E.EICHTEN,I.HINCHLIFFE,K.LANE AND C.QUIGG, +C REV. MOD. PHYS. 56 (1984) 579 +C REVISED AS IN REV. MOD. PHYS. 58 (1986) 1065 +C RELIABLE RANGE : SQRT(5)GEV < SCALE < 10TEV, 1E-4 < X < 1 +C +C DREES+GRASSIE = M.DREES & K.GRASSIE, ZEIT. PHYS. C28 (1985) 451 +C MODIFIED IN M.DREES & C.S.KIM, DESY 91-039 +C AND C.S.KIM, DTP/91/16 FOR HEAVY QUARKS +C +C FOR CERN PDFLIB DETAILS SEE PDFLIB DOC Q ON CERNVM OR +C CERN_ROOT:[DOC]PDFLIB.TXT ON VXCERN +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + DOUBLE PRECISION HWSGAM,X,SCALE,XOLD,QOLD,XMWN,QSCA,SS,SMIN,S,T, + & TMIN,TMAX,VX,AA,VT,WT,UPV,DNV,SEA,STR,CHM,BTM,TOP,GLU,WX,XQSUM, + & DMIN,TPMIN,TPMAX,DIST(13),G(2),Q0(5),QL(5),F(5),A(6,5), + & B(3,6,5,4),XQ(6),TX(6),TT(6),TB(6),NEHLQ(8,2),CEHLQ(6,6,2,8,2), + & BB(4,6,5),VAL(20),USEA,DSEA,TOTAL,SCALEF,FAC,TBMIN(2),TTMIN(2) + REAL HWSDGG,HWSDGQ,XSP,Q2,P2,W2,EMB2,EMC2,ALAM2,XPGA(-6:6),F2GM, + & XPVMD,XPANL,XPANH,XPBEH,XPDIR + COMMON/SASCOM/XPVMD(-6:6),XPANL(-6:6),XPANH(-6:6),XPBEH(-6:6), + & XPDIR(-6:6) + LOGICAL PDFWRX(2,2),PDFWRQ(2,2) + DOUBLE PRECISION PDFXMN,PDFXMX,PDFQMN,PDFQMX + COMMON /W50513/PDFXMN,PDFXMX,PDFQMN,PDFQMX + INTEGER IDHAD,NSET,IBEAM,IOLD,NOLD,IP,I,J,K,NX,IT,IX,IFL,NFL, + & MPDF,IHAD,ISET,IOP1,IOP2,IP2 + CHARACTER*20 PARM(20) + EXTERNAL HWSGAM,HWSDGG,HWSDGQ + SAVE QOLD,IOLD,NOLD,XOLD,SS,S,T,TMIN,TMAX,G,A,TX,TT,TB,IP,NX + DATA PDFWRX,PDFWRQ/8*.TRUE./ + DATA (((B(I,J,K,1),I=1,3),J=1,6),K=1,5)/ + &3.,0.,0.,.419,.004383,-.007412, + &3.46,.72432,-.065998,4.4,-4.8644,1.3274, + &6*0.,1., + &0.,0.,.763,-.23696,.025836,4.,.62664,-.019163, + &0.,-.42068,.032809,6*0.,1.265,-1.1323,.29268, + &0.,-.37162,-.028977,8.05,1.5877,-.15291, + &0.,6.3059,-.27342,0.,-10.543,-3.1674, + &0.,14.698,9.798,0.,.13479,-.074693, + &-.0355,-.22237,-.057685,6.3494,3.2649,-.90945, + &0.,-3.0331,1.5042,0.,17.431,-11.255, + &0.,-17.861,15.571,1.564,-1.7112,.63751, + &0.,-.94892,.32505,6.,1.4345,-1.0485, + &9.,-7.1858,.25494,0.,-16.457,10.947, + &0.,15.261,-10.085/ + DATA (((B(I,J,K,2),I=1,3),J=1,6),K=1,5)/ + &3.,0.,0.,.3743,.013946,-.00031695, + &3.329,.75343,-.076125,6.032,-6.2153,1.5561, + &6*0.,1.,0., + &0.,.7608,-.2317,.023232,3.83,.62746,-.019155, + &0.,-.41843,.035972,6*0.,1.6714,-1.9168,.58175, + &0.,-.27307,-.16392,9.145,.53045,-.76271, + &0.,15.665,-2.8341,0.,-100.63,44.658, + &0.,223.24,-116.76,0.,.067368,-.030574, + &-.11989,-.23293,-.023273,3.5087,3.6554,-.45313, + &0.,-.47369,.35793,0.,9.5041,-5.4303, + &0.,-16.563,15.524,.8789,-.97093,.43388, + &0.,-1.1612,.4759,4.,1.2271,-.25369, + &9.,-5.6354,-.81747,0.,-7.5438,5.5034, + &0.,-.59649,.12611/ + DATA (((B(I,J,K,3),I=1,3),J=1,6),K=1,5)/ + &1.,0.,0.,0.4,-0.06212,-0.007109,0.7,0.6478,0.01335,27*0., + &0.9,-0.2428,0.1386,0.,-0.2120,0.003671,5.0,0.8673,0.04747, + &0.,1.266,-2.215,0.,2.382,0.3482,3*0., + &0.,0.07928,-0.06134,-0.02212,-0.3785,-0.1088,2.894,9.433, + &-10.852,0.,5.248,-7.187,0.,8.388,-11.61,3*0., + &0.888,-1.802,1.812,0.,-1.576,1.20,3.11,-0.1317,0.5068, + &6.0,2.801,-12.16,0.,-17.28,20.49,3*0./ + DATA (((B(I,J,K,4),I=1,3),J=1,6),K=1,5)/ + &1.,0.,0.,0.4,-0.05909,-0.006524,0.628,0.6436,0.01451,27*0., + &0.90,-0.1417,-0.1740,0.,-0.1697,-0.09623,5.0,-2.474,1.575, + &0.,-2.534,1.378,0.,0.5621,-0.2701,3*0., + &0.,0.06229,-0.04099,-0.0882,-0.2892,-0.1082,1.924,0.2424, + &2.036,0.,-4.463,5.209,0.,-0.8367,-0.04840,3*0., + &0.794,-0.9144,0.5966,0.,-1.237,0.6582,2.89,0.5966,-0.2550, + &6.0,-3.671,-2.304,0.,-8.191,7.758,3*0./ +C---COEFFTS FOR NEW OWENS 1.1 SET + DATA BB/3.,3*0.,.665,-.1097,-.002442,0., + &3.614,.8395,-.02186,0.,.8673,-1.6637,.342,0., + &0.,1.1049,-.2369,5*0.,1.,3*0., + &.8388,-.2092,.02657,0.,4.667,.7951,.1081,0., + &0.,-1.0232,.05799,0.,0.,.8616,.153,5*0., + &.909,-.4023,.006305,0., + &0.,-.3823,.02766,0.,7.278,-.7904,.8108,0., + &0.,-1.6629,.5719,0.,0.,-.01333,.5299,0., + &0.,.1211,-.1739,0.,0.,.09469,-.07066,.01236, + &-.1447,-.402,.1533,-.06479,6.7599,1.6596,.6798,-.8525, + &0.,-4.4559,3.3756,-.9468, + &0.,7.862,-3.6591,.03672,0.,-.2472,-.751,.0487, + &3.017,-4.7347,3.3594,-.9443,0.,-.9342,.5454,-.1668, + &5.304,1.4654,-1.4292,.7569,0.,-3.9141,2.8445,-.8411, + &0.,9.0176,-10.426,4.0983,0.,-5.9602,7.515,-2.7329/ +C...THE FOLLOWING DATA LINES ARE COEFFICIENTS NEEDED IN THE +C...EICHTEN, HINCHLIFFE, LANE, QUIGG PROTON STRUCTURE FUNCTION +C...POWERS OF 1-X IN DIFFERENT CASES + DATA NEHLQ/3,4,7,5,7,7,7,7,3,4,7,6,7,7,7,7/ +C...EXPANSION COEFFICIENTS FOR UP VALENCE QUARK DISTRIBUTION + DATA (((CEHLQ(IX,IT,NX,1,1),IX=1,6),IT=1,6),NX=1,2)/ + 1 7.677E-01,-2.087E-01,-3.303E-01,-2.517E-02,-1.570E-02,-1.000E-04, + 2-5.326E-01,-2.661E-01, 3.201E-01, 1.192E-01, 2.434E-02, 7.620E-03, + 3 2.162E-01, 1.881E-01,-8.375E-02,-6.515E-02,-1.743E-02,-5.040E-03, + 4-9.211E-02,-9.952E-02, 1.373E-02, 2.506E-02, 8.770E-03, 2.550E-03, + 5 3.670E-02, 4.409E-02, 9.600E-04,-7.960E-03,-3.420E-03,-1.050E-03, + 6-1.549E-02,-2.026E-02,-3.060E-03, 2.220E-03, 1.240E-03, 4.100E-04, + 1 2.395E-01, 2.905E-01, 9.778E-02, 2.149E-02, 3.440E-03, 5.000E-04, + 2 1.751E-02,-6.090E-03,-2.687E-02,-1.916E-02,-7.970E-03,-2.750E-03, + 3-5.760E-03,-5.040E-03, 1.080E-03, 2.490E-03, 1.530E-03, 7.500E-04, + 4 1.740E-03, 1.960E-03, 3.000E-04,-3.400E-04,-2.900E-04,-1.800E-04, + 5-5.300E-04,-6.400E-04,-1.700E-04, 4.000E-05, 6.000E-05, 4.000E-05, + 6 1.700E-04, 2.200E-04, 8.000E-05, 1.000E-05,-1.000E-05,-1.000E-05/ + DATA (((CEHLQ(IX,IT,NX,1,2),IX=1,6),IT=1,6),NX=1,2)/ + 1 7.237E-01,-2.189E-01,-2.995E-01,-1.909E-02,-1.477E-02, 2.500E-04, + 2-5.314E-01,-2.425E-01, 3.283E-01, 1.119E-01, 2.223E-02, 7.070E-03, + 3 2.289E-01, 1.890E-01,-9.859E-02,-6.900E-02,-1.747E-02,-5.080E-03, + 4-1.041E-01,-1.084E-01, 2.108E-02, 2.975E-02, 9.830E-03, 2.830E-03, + 5 4.394E-02, 5.116E-02,-1.410E-03,-1.055E-02,-4.230E-03,-1.270E-03, + 6-1.991E-02,-2.539E-02,-2.780E-03, 3.430E-03, 1.720E-03, 5.500E-04, + 1 2.410E-01, 2.884E-01, 9.369E-02, 1.900E-02, 2.530E-03, 2.400E-04, + 2 1.765E-02,-9.220E-03,-3.037E-02,-2.085E-02,-8.440E-03,-2.810E-03, + 3-6.450E-03,-5.260E-03, 1.720E-03, 3.110E-03, 1.830E-03, 8.700E-04, + 4 2.120E-03, 2.320E-03, 2.600E-04,-4.900E-04,-3.900E-04,-2.300E-04, + 5-6.900E-04,-8.200E-04,-2.000E-04, 7.000E-05, 9.000E-05, 6.000E-05, + 6 2.400E-04, 3.100E-04, 1.100E-04, 0.000E+00,-2.000E-05,-2.000E-05/ +C...EXPANSION COEFFICIENTS FOR DOWN VALENCE QUARK DISTRIBUTION + DATA (((CEHLQ(IX,IT,NX,2,1),IX=1,6),IT=1,6),NX=1,2)/ + 1 3.813E-01,-8.090E-02,-1.634E-01,-2.185E-02,-8.430E-03,-6.200E-04, + 2-2.948E-01,-1.435E-01, 1.665E-01, 6.638E-02, 1.473E-02, 4.080E-03, + 3 1.252E-01, 1.042E-01,-4.722E-02,-3.683E-02,-1.038E-02,-2.860E-03, + 4-5.478E-02,-5.678E-02, 8.900E-03, 1.484E-02, 5.340E-03, 1.520E-03, + 5 2.220E-02, 2.567E-02,-3.000E-05,-4.970E-03,-2.160E-03,-6.500E-04, + 6-9.530E-03,-1.204E-02,-1.510E-03, 1.510E-03, 8.300E-04, 2.700E-04, + 1 1.261E-01, 1.354E-01, 3.958E-02, 8.240E-03, 1.660E-03, 4.500E-04, + 2 3.890E-03,-1.159E-02,-1.625E-02,-9.610E-03,-3.710E-03,-1.260E-03, + 3-1.910E-03,-5.600E-04, 1.590E-03, 1.590E-03, 8.400E-04, 3.900E-04, + 4 6.400E-04, 4.900E-04,-1.500E-04,-2.900E-04,-1.800E-04,-1.000E-04, + 5-2.000E-04,-1.900E-04, 0.000E+00, 6.000E-05, 4.000E-05, 3.000E-05, + 6 7.000E-05, 8.000E-05, 2.000E-05,-1.000E-05,-1.000E-05,-1.000E-05/ + DATA (((CEHLQ(IX,IT,NX,2,2),IX=1,6),IT=1,6),NX=1,2)/ + 1 3.578E-01,-8.622E-02,-1.480E-01,-1.840E-02,-7.820E-03,-4.500E-04, + 2-2.925E-01,-1.304E-01, 1.696E-01, 6.243E-02, 1.353E-02, 3.750E-03, + 3 1.318E-01, 1.041E-01,-5.486E-02,-3.872E-02,-1.038E-02,-2.850E-03, + 4-6.162E-02,-6.143E-02, 1.303E-02, 1.740E-02, 5.940E-03, 1.670E-03, + 5 2.643E-02, 2.957E-02,-1.490E-03,-6.450E-03,-2.630E-03,-7.700E-04, + 6-1.218E-02,-1.497E-02,-1.260E-03, 2.240E-03, 1.120E-03, 3.500E-04, + 1 1.263E-01, 1.334E-01, 3.732E-02, 7.070E-03, 1.260E-03, 3.400E-04, + 2 3.660E-03,-1.357E-02,-1.795E-02,-1.031E-02,-3.880E-03,-1.280E-03, + 3-2.100E-03,-3.600E-04, 2.050E-03, 1.920E-03, 9.800E-04, 4.400E-04, + 4 7.700E-04, 5.400E-04,-2.400E-04,-3.900E-04,-2.400E-04,-1.300E-04, + 5-2.600E-04,-2.300E-04, 2.000E-05, 9.000E-05, 6.000E-05, 4.000E-05, + 6 9.000E-05, 1.000E-04, 2.000E-05,-2.000E-05,-2.000E-05,-1.000E-05/ +C...EXPANSION COEFFICIENTS FOR UP AND DOWN SEA QUARK DISTRIBUTIONS + DATA (((CEHLQ(IX,IT,NX,3,1),IX=1,6),IT=1,6),NX=1,2)/ + 1 6.870E-02,-6.861E-02, 2.973E-02,-5.400E-03, 3.780E-03,-9.700E-04, + 2-1.802E-02, 1.400E-04, 6.490E-03,-8.540E-03, 1.220E-03,-1.750E-03, + 3-4.650E-03, 1.480E-03,-5.930E-03, 6.000E-04,-1.030E-03,-8.000E-05, + 4 6.440E-03, 2.570E-03, 2.830E-03, 1.150E-03, 7.100E-04, 3.300E-04, + 5-3.930E-03,-2.540E-03,-1.160E-03,-7.700E-04,-3.600E-04,-1.900E-04, + 6 2.340E-03, 1.930E-03, 5.300E-04, 3.700E-04, 1.600E-04, 9.000E-05, + 1 1.014E+00,-1.106E+00, 3.374E-01,-7.444E-02, 8.850E-03,-8.700E-04, + 2 9.233E-01,-1.285E+00, 4.475E-01,-9.786E-02, 1.419E-02,-1.120E-03, + 3 4.888E-02,-1.271E-01, 8.606E-02,-2.608E-02, 4.780E-03,-6.000E-04, + 4-2.691E-02, 4.887E-02,-1.771E-02, 1.620E-03, 2.500E-04,-6.000E-05, + 5 7.040E-03,-1.113E-02, 1.590E-03, 7.000E-04,-2.000E-04, 0.000E+00, + 6-1.710E-03, 2.290E-03, 3.800E-04,-3.500E-04, 4.000E-05, 1.000E-05/ + DATA (((CEHLQ(IX,IT,NX,3,2),IX=1,6),IT=1,6),NX=1,2)/ + 1 1.008E-01,-7.100E-02, 1.973E-02,-5.710E-03, 2.930E-03,-9.900E-04, + 2-5.271E-02,-1.823E-02, 1.792E-02,-6.580E-03, 1.750E-03,-1.550E-03, + 3 1.220E-02, 1.763E-02,-8.690E-03,-8.800E-04,-1.160E-03,-2.100E-04, + 4-1.190E-03,-7.180E-03, 2.360E-03, 1.890E-03, 7.700E-04, 4.100E-04, + 5-9.100E-04, 2.040E-03,-3.100E-04,-1.050E-03,-4.000E-04,-2.400E-04, + 6 1.190E-03,-1.700E-04,-2.000E-04, 4.200E-04, 1.700E-04, 1.000E-04, + 1 1.081E+00,-1.189E+00, 3.868E-01,-8.617E-02, 1.115E-02,-1.180E-03, + 2 9.917E-01,-1.396E+00, 4.998E-01,-1.159E-01, 1.674E-02,-1.720E-03, + 3 5.099E-02,-1.338E-01, 9.173E-02,-2.885E-02, 5.890E-03,-6.500E-04, + 4-3.178E-02, 5.703E-02,-2.070E-02, 2.440E-03, 1.100E-04,-9.000E-05, + 5 8.970E-03,-1.392E-02, 2.050E-03, 6.500E-04,-2.300E-04, 2.000E-05, + 6-2.340E-03, 3.010E-03, 5.000E-04,-3.900E-04, 6.000E-05, 1.000E-05/ +C...EXPANSION COEFFICIENTS FOR GLUON DISTRIBUTION + DATA (((CEHLQ(IX,IT,NX,4,1),IX=1,6),IT=1,6),NX=1,2)/ + 1 9.482E-01,-9.578E-01, 1.009E-01,-1.051E-01, 3.456E-02,-3.054E-02, + 2-9.627E-01, 5.379E-01, 3.368E-01,-9.525E-02, 1.488E-02,-2.051E-02, + 3 4.300E-01,-8.306E-02,-3.372E-01, 4.902E-02,-9.160E-03, 1.041E-02, + 4-1.925E-01,-1.790E-02, 2.183E-01, 7.490E-03, 4.140E-03,-1.860E-03, + 5 8.183E-02, 1.926E-02,-1.072E-01,-1.944E-02,-2.770E-03,-5.200E-04, + 6-3.884E-02,-1.234E-02, 5.410E-02, 1.879E-02, 3.350E-03, 1.040E-03, + 1 2.948E+01,-3.902E+01, 1.464E+01,-3.335E+00, 5.054E-01,-5.915E-02, + 2 2.559E+01,-3.955E+01, 1.661E+01,-4.299E+00, 6.904E-01,-8.243E-02, + 3-1.663E+00, 1.176E+00, 1.118E+00,-7.099E-01, 1.948E-01,-2.404E-02, + 4-2.168E-01, 8.170E-01,-7.169E-01, 1.851E-01,-1.924E-02,-3.250E-03, + 5 2.088E-01,-4.355E-01, 2.239E-01,-2.446E-02,-3.620E-03, 1.910E-03, + 6-9.097E-02, 1.601E-01,-5.681E-02,-2.500E-03, 2.580E-03,-4.700E-04/ + DATA (((CEHLQ(IX,IT,NX,4,2),IX=1,6),IT=1,6),NX=1,2)/ + 1 2.367E+00, 4.453E-01, 3.660E-01, 9.467E-02, 1.341E-01, 1.661E-02, + 2-3.170E+00,-1.795E+00, 3.313E-02,-2.874E-01,-9.827E-02,-7.119E-02, + 3 1.823E+00, 1.457E+00,-2.465E-01, 3.739E-02, 6.090E-03, 1.814E-02, + 4-1.033E+00,-9.827E-01, 2.136E-01, 1.169E-01, 5.001E-02, 1.684E-02, + 5 5.133E-01, 5.259E-01,-1.173E-01,-1.139E-01,-4.988E-02,-2.021E-02, + 6-2.881E-01,-3.145E-01, 5.667E-02, 9.161E-02, 4.568E-02, 1.951E-02, + 1 3.036E+01,-4.062E+01, 1.578E+01,-3.699E+00, 6.020E-01,-7.031E-02, + 2 2.700E+01,-4.167E+01, 1.770E+01,-4.804E+00, 7.862E-01,-1.060E-01, + 3-1.909E+00, 1.357E+00, 1.127E+00,-7.181E-01, 2.232E-01,-2.481E-02, + 4-2.488E-01, 9.781E-01,-8.127E-01, 2.094E-01,-2.997E-02,-4.710E-03, + 5 2.506E-01,-5.427E-01, 2.672E-01,-3.103E-02,-1.800E-03, 2.870E-03, + 6-1.128E-01, 2.087E-01,-6.972E-02,-2.480E-03, 2.630E-03,-8.400E-04/ +C...EXPANSION COEFFICIENTS FOR STRANGE SEA QUARK DISTRIBUTION + DATA (((CEHLQ(IX,IT,NX,5,1),IX=1,6),IT=1,6),NX=1,2)/ + 1 4.968E-02,-4.173E-02, 2.102E-02,-3.270E-03, 3.240E-03,-6.700E-04, + 2-6.150E-03,-1.294E-02, 6.740E-03,-6.890E-03, 9.000E-04,-1.510E-03, + 3-8.580E-03, 5.050E-03,-4.900E-03,-1.600E-04,-9.400E-04,-1.500E-04, + 4 7.840E-03, 1.510E-03, 2.220E-03, 1.400E-03, 7.000E-04, 3.500E-04, + 5-4.410E-03,-2.220E-03,-8.900E-04,-8.500E-04,-3.600E-04,-2.000E-04, + 6 2.520E-03, 1.840E-03, 4.100E-04, 3.900E-04, 1.600E-04, 9.000E-05, + 1 9.235E-01,-1.085E+00, 3.464E-01,-7.210E-02, 9.140E-03,-9.100E-04, + 2 9.315E-01,-1.274E+00, 4.512E-01,-9.775E-02, 1.380E-02,-1.310E-03, + 3 4.739E-02,-1.296E-01, 8.482E-02,-2.642E-02, 4.760E-03,-5.700E-04, + 4-2.653E-02, 4.953E-02,-1.735E-02, 1.750E-03, 2.800E-04,-6.000E-05, + 5 6.940E-03,-1.132E-02, 1.480E-03, 6.500E-04,-2.100E-04, 0.000E+00, + 6-1.680E-03, 2.340E-03, 4.200E-04,-3.400E-04, 5.000E-05, 1.000E-05/ + DATA (((CEHLQ(IX,IT,NX,5,2),IX=1,6),IT=1,6),NX=1,2)/ + 1 6.478E-02,-4.537E-02, 1.643E-02,-3.490E-03, 2.710E-03,-6.700E-04, + 2-2.223E-02,-2.126E-02, 1.247E-02,-6.290E-03, 1.120E-03,-1.440E-03, + 3-1.340E-03, 1.362E-02,-6.130E-03,-7.900E-04,-9.000E-04,-2.000E-04, + 4 5.080E-03,-3.610E-03, 1.700E-03, 1.830E-03, 6.800E-04, 4.000E-04, + 5-3.580E-03, 6.000E-05,-2.600E-04,-1.050E-03,-3.800E-04,-2.300E-04, + 6 2.420E-03, 9.300E-04,-1.000E-04, 4.500E-04, 1.700E-04, 1.100E-04, + 1 9.868E-01,-1.171E+00, 3.940E-01,-8.459E-02, 1.124E-02,-1.250E-03, + 2 1.001E+00,-1.383E+00, 5.044E-01,-1.152E-01, 1.658E-02,-1.830E-03, + 3 4.928E-02,-1.368E-01, 9.021E-02,-2.935E-02, 5.800E-03,-6.600E-04, + 4-3.133E-02, 5.785E-02,-2.023E-02, 2.630E-03, 1.600E-04,-8.000E-05, + 5 8.840E-03,-1.416E-02, 1.900E-03, 5.800E-04,-2.500E-04, 1.000E-05, + 6-2.300E-03, 3.080E-03, 5.500E-04,-3.700E-04, 7.000E-05, 1.000E-05/ +C...EXPANSION COEFFICIENTS FOR CHARM SEA QUARK DISTRIBUTION + DATA (((CEHLQ(IX,IT,NX,6,1),IX=1,6),IT=1,6),NX=1,2)/ + 1 9.270E-03,-1.817E-02, 9.590E-03,-6.390E-03, 1.690E-03,-1.540E-03, + 2 5.710E-03,-1.188E-02, 6.090E-03,-4.650E-03, 1.240E-03,-1.310E-03, + 3-3.960E-03, 7.100E-03,-3.590E-03, 1.840E-03,-3.900E-04, 3.400E-04, + 4 1.120E-03,-1.960E-03, 1.120E-03,-4.800E-04, 1.000E-04,-4.000E-05, + 5 4.000E-05,-3.000E-05,-1.800E-04, 9.000E-05,-5.000E-05,-2.000E-05, + 6-4.200E-04, 7.300E-04,-1.600E-04, 5.000E-05, 5.000E-05, 5.000E-05, + 1 8.098E-01,-1.042E+00, 3.398E-01,-6.824E-02, 8.760E-03,-9.000E-04, + 2 8.961E-01,-1.217E+00, 4.339E-01,-9.287E-02, 1.304E-02,-1.290E-03, + 3 3.058E-02,-1.040E-01, 7.604E-02,-2.415E-02, 4.600E-03,-5.000E-04, + 4-2.451E-02, 4.432E-02,-1.651E-02, 1.430E-03, 1.200E-04,-1.000E-04, + 5 1.122E-02,-1.457E-02, 2.680E-03, 5.800E-04,-1.200E-04, 3.000E-05, + 6-7.730E-03, 7.330E-03,-7.600E-04,-2.400E-04, 1.000E-05, 0.000E+00/ + DATA (((CEHLQ(IX,IT,NX,6,2),IX=1,6),IT=1,6),NX=1,2)/ + 1 9.980E-03,-1.945E-02, 1.055E-02,-6.870E-03, 1.860E-03,-1.560E-03, + 2 5.700E-03,-1.203E-02, 6.250E-03,-4.860E-03, 1.310E-03,-1.370E-03, + 3-4.490E-03, 7.990E-03,-4.170E-03, 2.050E-03,-4.400E-04, 3.300E-04, + 4 1.470E-03,-2.480E-03, 1.460E-03,-5.700E-04, 1.200E-04,-1.000E-05, + 5-9.000E-05, 1.500E-04,-3.200E-04, 1.200E-04,-6.000E-05,-4.000E-05, + 6-4.200E-04, 7.600E-04,-1.400E-04, 4.000E-05, 7.000E-05, 5.000E-05, + 1 8.698E-01,-1.131E+00, 3.836E-01,-8.111E-02, 1.048E-02,-1.300E-03, + 2 9.626E-01,-1.321E+00, 4.854E-01,-1.091E-01, 1.583E-02,-1.700E-03, + 3 3.057E-02,-1.088E-01, 8.022E-02,-2.676E-02, 5.590E-03,-5.600E-04, + 4-2.845E-02, 5.164E-02,-1.918E-02, 2.210E-03,-4.000E-05,-1.500E-04, + 5 1.311E-02,-1.751E-02, 3.310E-03, 5.100E-04,-1.200E-04, 5.000E-05, + 6-8.590E-03, 8.380E-03,-9.200E-04,-2.600E-04, 1.000E-05,-1.000E-05/ +C...EXPANSION COEFFICIENTS FOR BOTTOM SEA QUARK DISTRIBUTION + DATA (((CEHLQ(IX,IT,NX,7,1),IX=1,6),IT=1,6),NX=1,2)/ + 1 9.010E-03,-1.401E-02, 7.150E-03,-4.130E-03, 1.260E-03,-1.040E-03, + 2 6.280E-03,-9.320E-03, 4.780E-03,-2.890E-03, 9.100E-04,-8.200E-04, + 3-2.930E-03, 4.090E-03,-1.890E-03, 7.600E-04,-2.300E-04, 1.400E-04, + 4 3.900E-04,-1.200E-03, 4.400E-04,-2.500E-04, 2.000E-05,-2.000E-05, + 5 2.600E-04, 1.400E-04,-8.000E-05, 1.000E-04, 1.000E-05, 1.000E-05, + 6-2.600E-04, 3.200E-04, 1.000E-05,-1.000E-05, 1.000E-05,-1.000E-05, + 1 8.029E-01,-1.075E+00, 3.792E-01,-7.843E-02, 1.007E-02,-1.090E-03, + 2 7.903E-01,-1.099E+00, 4.153E-01,-9.301E-02, 1.317E-02,-1.410E-03, + 3-1.704E-02,-1.130E-02, 2.882E-02,-1.341E-02, 3.040E-03,-3.600E-04, + 4-7.200E-04, 7.230E-03,-5.160E-03, 1.080E-03,-5.000E-05,-4.000E-05, + 5 3.050E-03,-4.610E-03, 1.660E-03,-1.300E-04,-1.000E-05, 1.000E-05, + 6-4.360E-03, 5.230E-03,-1.610E-03, 2.000E-04,-2.000E-05, 0.000E+00/ + DATA (((CEHLQ(IX,IT,NX,7,2),IX=1,6),IT=1,6),NX=1,2)/ + 1 8.980E-03,-1.459E-02, 7.510E-03,-4.410E-03, 1.310E-03,-1.070E-03, + 2 5.970E-03,-9.440E-03, 4.800E-03,-3.020E-03, 9.100E-04,-8.500E-04, + 3-3.050E-03, 4.440E-03,-2.100E-03, 8.500E-04,-2.400E-04, 1.400E-04, + 4 5.300E-04,-1.300E-03, 5.600E-04,-2.700E-04, 3.000E-05,-2.000E-05, + 5 2.000E-04, 1.400E-04,-1.100E-04, 1.000E-04, 0.000E+00, 0.000E+00, + 6-2.600E-04, 3.200E-04, 0.000E+00,-3.000E-05, 1.000E-05,-1.000E-05, + 1 8.672E-01,-1.174E+00, 4.265E-01,-9.252E-02, 1.244E-02,-1.460E-03, + 2 8.500E-01,-1.194E+00, 4.630E-01,-1.083E-01, 1.614E-02,-1.830E-03, + 3-2.241E-02,-5.630E-03, 2.815E-02,-1.425E-02, 3.520E-03,-4.300E-04, + 4-7.300E-04, 8.030E-03,-5.780E-03, 1.380E-03,-1.300E-04,-4.000E-05, + 5 3.460E-03,-5.380E-03, 1.960E-03,-2.100E-04, 1.000E-05, 1.000E-05, + 6-4.850E-03, 5.950E-03,-1.890E-03, 2.600E-04,-3.000E-05, 0.000E+00/ +C...EXPANSION COEFFICIENTS FOR TOP SEA QUARK DISTRIBUTION + DATA (((CEHLQ(IX,IT,NX,8,1),IX=1,6),IT=1,6),NX=1,2)/ + 1 4.410E-03,-7.480E-03, 3.770E-03,-2.580E-03, 7.300E-04,-7.100E-04, + 2 3.840E-03,-6.050E-03, 3.030E-03,-2.030E-03, 5.800E-04,-5.900E-04, + 3-8.800E-04, 1.660E-03,-7.500E-04, 4.700E-04,-1.000E-04, 1.000E-04, + 4-8.000E-05,-1.500E-04, 1.200E-04,-9.000E-05, 3.000E-05, 0.000E+00, + 5 1.300E-04,-2.200E-04,-2.000E-05,-2.000E-05,-2.000E-05,-2.000E-05, + 6-7.000E-05, 1.900E-04,-4.000E-05, 2.000E-05, 0.000E+00, 0.000E+00, + 1 6.623E-01,-9.248E-01, 3.519E-01,-7.930E-02, 1.110E-02,-1.180E-03, + 2 6.380E-01,-9.062E-01, 3.582E-01,-8.479E-02, 1.265E-02,-1.390E-03, + 3-2.581E-02, 2.125E-02, 4.190E-03,-4.980E-03, 1.490E-03,-2.100E-04, + 4 7.100E-04, 5.300E-04,-1.270E-03, 3.900E-04,-5.000E-05,-1.000E-05, + 5 3.850E-03,-5.060E-03, 1.860E-03,-3.500E-04, 4.000E-05, 0.000E+00, + 6-3.530E-03, 4.460E-03,-1.500E-03, 2.700E-04,-3.000E-05, 0.000E+00/ + DATA (((CEHLQ(IX,IT,NX,8,2),IX=1,6),IT=1,6),NX=1,2)/ + 1 4.260E-03,-7.530E-03, 3.830E-03,-2.680E-03, 7.600E-04,-7.300E-04, + 2 3.640E-03,-6.050E-03, 3.030E-03,-2.090E-03, 5.900E-04,-6.000E-04, + 3-9.200E-04, 1.710E-03,-8.200E-04, 5.000E-04,-1.200E-04, 1.000E-04, + 4-5.000E-05,-1.600E-04, 1.300E-04,-9.000E-05, 3.000E-05, 0.000E+00, + 5 1.300E-04,-2.100E-04,-1.000E-05,-2.000E-05,-2.000E-05,-1.000E-05, + 6-8.000E-05, 1.800E-04,-5.000E-05, 2.000E-05, 0.000E+00, 0.000E+00, + 1 7.146E-01,-1.007E+00, 3.932E-01,-9.246E-02, 1.366E-02,-1.540E-03, + 2 6.856E-01,-9.828E-01, 3.977E-01,-9.795E-02, 1.540E-02,-1.790E-03, + 3-3.053E-02, 2.758E-02, 2.150E-03,-4.880E-03, 1.640E-03,-2.500E-04, + 4 9.200E-04, 4.200E-04,-1.340E-03, 4.600E-04,-8.000E-05,-1.000E-05, + 5 4.230E-03,-5.660E-03, 2.140E-03,-4.300E-04, 6.000E-05, 0.000E+00, + 6-3.890E-03, 5.000E-03,-1.740E-03, 3.300E-04,-4.000E-05, 0.000E+00/ + DATA TBMIN,TTMIN/8.1905,7.4474,11.5528,10.8097/ + DATA XOLD,QOLD,IOLD,NOLD/-1.,0.,0,0/ + DATA DMIN,Q0,QL/0.,2*2.,2*2.236,2.,.2,.4,.2,.29,.177/ + IF (X.LE.ZERO) CALL HWWARN('HWSFUN',100,*999) + XMWN=ONE-X + IF (XMWN.LE.ZERO) THEN + DO 1 I=1,13 + DIST(I)=0 + 1 CONTINUE + RETURN + ENDIF +C---FREEZE THE SCALE IF REQUIRED + SCALEF=SCALE + IF (ISPAC.GT.0) SCALEF=MAX(SCALEF,QSPAC) +C---CHECK IF PDFLIB REQUESTED + IF (IBEAM.EQ.1.OR.IBEAM.EQ.2) THEN + MPDF=MODPDF(IBEAM) + ELSE + MPDF=-1 + ENDIF + QSCA=ABS(SCALEF) + IF (IDHAD.EQ.59.OR.IDHAD.EQ.71) THEN + IF (MPDF.GE.0) THEN +C---USE PDFLIB PHOTON STRUCTURE FUNCTIONS + PARM(1)=AUTPDF(IBEAM) + VAL(1)=FLOAT(MPDF) +C---FIX TO CALL SCHULER-SJOSTRAND CODE + IF (AUTPDF(IBEAM).EQ.'SaSph') THEN + XSP=X + IF ( XSP.LE.ZERO) CALL HWWARN('HWSFUN',102,*999) + IF (ONE-XSP.LE.ZERO) CALL HWWARN('HWSFUN',103,*999) + Q2=QSCA**2 + ISET=MOD(MODPDF(IBEAM),10) + IOP1=MOD(MODPDF(IBEAM)/10,2) + IOP2=MOD(MODPDF(IBEAM)/20,2) + IP2=MODPDF(IBEAM)/100 + IF (IOP2.EQ.0) THEN + P2=0. + ELSE + IHAD=IBEAM + IF (JDAHEP(1,IHAD).NE.0) IHAD=JDAHEP(1,IHAD) + P2=PHEP(5,IHAD)**2 + ENDIF + CALL SASGAM(ISET,XSP,Q2,P2,IP2,F2GM,XPGA) + IF (IOP1.EQ.1 .AND. ISTAT.LT.10) THEN + DO 5 I=-6,6 + 5 XPGA(I)=XPVMD(I)+XPANL(I)+XPBEH(I)+XPDIR(I) + ENDIF + UPV=XPGA(2) + DNV=XPGA(1) + USEA=XPGA(2) + DSEA=XPGA(1) + STR=XPGA(3) + CHM=XPGA(4) + BTM=XPGA(5) + TOP=XPGA(6) + GLU=XPGA(0) + ELSE + CALL PDFSET(PARM,VAL) + IF (X.LT.PDFXMN.AND.PDFWRX(IBEAM,1) .OR. + & X.GT.PDFXMX.AND.PDFWRX(IBEAM,2)) THEN + CALL HWWARN('HWSFUN',2,*999) + WRITE (6,'(2A)') ' WARNING: PDFLIB CALLED WITH X', + & ' OUTSIDE ALLOWED RANGE!' + WRITE (6,'(1P,3(A,E9.3))') ' X VALUE=',X, + & ', MINIMUM=',PDFXMN,', MAXIMUM=',PDFXMX + WRITE (6,'(A)') ' NO FURTHER WARNINGS WILL BE ISSUED' + IF (X.LT.PDFXMN) PDFWRX(IBEAM,1)=.FALSE. + IF (X.GT.PDFXMX) PDFWRX(IBEAM,2)=.FALSE. + ENDIF + IF (QSCA**2.LT.PDFQMN.AND.PDFWRQ(IBEAM,1) .OR. + & QSCA**2.GT.PDFQMX.AND.PDFWRQ(IBEAM,2)) THEN + CALL HWWARN('HWSFUN',3,*999) + WRITE (6,'(2A)') ' WARNING: PDFLIB CALLED WITH Q', + & ' OUTSIDE ALLOWED RANGE!' + WRITE (6,'(1P,3(A,E9.3))') ' Q VALUE=',QSCA, + & ', MINIMUM=',SQRT(PDFQMN),', MAXIMUM=',SQRT(PDFQMX) + WRITE (6,'(A)') ' NO FURTHER WARNINGS WILL BE ISSUED' + IF (QSCA**2.LT.PDFQMN) PDFWRQ(IBEAM,1)=.FALSE. + IF (QSCA**2.GT.PDFQMN) PDFWRQ(IBEAM,2)=.FALSE. + ENDIF + CALL STRUCTM(X,QSCA,UPV,DNV,USEA,DSEA,STR,CHM,BTM,TOP,GLU) + ENDIF + DIST(1)=DSEA + DIST(2)=USEA + DIST(7)=DSEA + DIST(8)=USEA + ELSE + XSP=X + IF ( XSP.LE.ZERO) CALL HWWARN('HWSFUN',102,*999) + IF (ONE-XSP.LE.ZERO) CALL HWWARN('HWSFUN',103,*999) + Q2=SCALEF**2 + W2=Q2*(1-X)/X + EMC2=4*RMASS(4)**2 + EMB2=4*RMASS(5)**2 + ALAM2=0.160 + NFL=3 + IF (Q2.GT.50.) NFL=4 + IF (Q2.GT.500.) NFL=5 + STR=HWSDGQ(XSP,Q2,NFL,1) + CHM=HWSDGQ(XSP,Q2,NFL,2) + GLU=HWSDGG(XSP,Q2,NFL) + DIST(1)=STR + DIST(2)=CHM + DIST(7)=STR + DIST(8)=CHM + IF (W2.GT.EMB2) THEN + BTM=STR + IF (W2*ALAM2.LT.Q2*EMB2) + & BTM=BTM*LOG(W2/EMB2)/LOG(Q2/ALAM2) + ELSE + BTM=0. + ENDIF + IF (W2.GT.EMC2) THEN + IF (W2*ALAM2.LT.Q2*EMC2) + & CHM=CHM*LOG(W2/EMC2)/LOG(Q2/ALAM2) + ELSE + CHM=0. + ENDIF + TOP=0. + ENDIF +C---INCLUDE SUPPRESSION FROM PHOTON VIRTUALITY IF NECESSARY + IF (PHOMAS.GT.ZERO.AND.(IBEAM.EQ.1.OR.IBEAM.EQ.2)) THEN + IHAD=IBEAM + IF (JDAHEP(1,IHAD).NE.0) IHAD=JDAHEP(1,IHAD) + IF (IDHW(IHAD).EQ.59) THEN + FAC=LOG((QSCA**2+PHOMAS**2)/(PHEP(5,IHAD)**2+PHOMAS**2))/ + $ LOG((QSCA**2+PHOMAS**2)/( PHOMAS**2)) + IF (FAC.LT.ZERO) FAC=ZERO + DIST(1)=DIST(1)*FAC + DIST(2)=DIST(2)*FAC + DIST(7)=DIST(7)*FAC + DIST(8)=DIST(8)*FAC + STR=STR*FAC + CHM=CHM*FAC + BTM=BTM*FAC + TOP=TOP*FAC + GLU=GLU*FAC**2 + ELSE + CALL HWWARN('HWSFUN',1,*999) + ENDIF + ENDIF + GOTO 900 + ENDIF + IF (MPDF.GE.0) THEN +C---USE PDFLIB NUCLEON STRUCTURE FUNCTIONS + PARM(1)=AUTPDF(IBEAM) + VAL(1)=FLOAT(MPDF) + CALL PDFSET(PARM,VAL) + IF (X.LT.PDFXMN.AND.PDFWRX(IBEAM,1) .OR. + & X.GT.PDFXMX.AND.PDFWRX(IBEAM,2)) THEN + CALL HWWARN('HWSFUN',4,*999) + WRITE (6,'(2A)') ' WARNING: PDFLIB CALLED WITH X', + & ' OUTSIDE ALLOWED RANGE!' + WRITE (6,'(1P,3(A,E9.3))') ' X VALUE=',X, + & ', MINIMUM=',PDFXMN,', MAXIMUM=',PDFXMX + WRITE (6,'(A)') ' NO FURTHER WARNINGS WILL BE ISSUED' + IF (X.LT.PDFXMN) PDFWRX(IBEAM,1)=.FALSE. + IF (X.GT.PDFXMX) PDFWRX(IBEAM,2)=.FALSE. + ENDIF + IF (QSCA**2.LT.PDFQMN.AND.PDFWRQ(IBEAM,1) .OR. + & QSCA**2.GT.PDFQMX.AND.PDFWRQ(IBEAM,2)) THEN + CALL HWWARN('HWSFUN',5,*999) + WRITE (6,'(2A)') ' WARNING: PDFLIB CALLED WITH Q', + & ' OUTSIDE ALLOWED RANGE!' + WRITE (6,'(1P,3(A,E9.3))') ' Q VALUE=',QSCA, + & ', MINIMUM=',SQRT(PDFQMN),', MAXIMUM=',SQRT(PDFQMX) + WRITE (6,'(A)') ' NO FURTHER WARNINGS WILL BE ISSUED' + IF (QSCA**2.LT.PDFQMN) PDFWRQ(IBEAM,1)=.FALSE. + IF (QSCA**2.GT.PDFQMN) PDFWRQ(IBEAM,2)=.FALSE. + ENDIF + CALL STRUCTM(X,QSCA,UPV,DNV,USEA,DSEA,STR,CHM,BTM,TOP,GLU) + ELSE + IF (QSCA.LT.Q0(NSET)) QSCA=Q0(NSET) + IF (QSCA.NE.QOLD.OR.IDHAD.NE.IOLD.OR.NSET.NE.NOLD) THEN +C---INITIALIZE + IF (NSET.LT.1.OR.NSET.GT.5) CALL HWWARN('HWSFUN',400,*999) + QOLD=QSCA + IOLD=IDHAD + NOLD=NSET + SS=LOG(QSCA/QL(NSET)) + SMIN=LOG(Q0(NSET)/QL(NSET)) + IF (NSET.LT.3.OR.NSET.EQ.5) THEN + S=LOG(SS/SMIN) + ELSE + T=2.*SS + TMIN=2.*SMIN + TMAX=2.*LOG(1.E4/QL(NSET)) + ENDIF + IF (IDHAD.GE.72) THEN + IF (NSET.LT.3) THEN + IP=NSET + DO 10 I=1,5 + DO 10 J=1,6 + 10 A(J,I)=B(1,J,I,IP)+S*(B(2,J,I,IP)+S*B(3,J,I,IP)) + DO 20 K=1,2 + AA=ONE+A(2,K)+A(3,K) + 20 G(K)=HWSGAM(AA)/((ONE+A(2,K)*A(4,K)/AA)*HWSGAM(A(2,K)) + & *HWSGAM(ONE+A(3,K))) + ELSEIF (NSET.EQ.5) THEN + DO 21 I=1,5 + DO 21 J=1,6 + 21 A(J,I)=BB(1,J,I)+S*(BB(2,J,I)+S*(BB(3,J,I)+S*BB(4,J,I))) + DO 22 K=1,2 + AA=ONE+A(2,K)+A(3,K) + 22 G(K)=HWSGAM(AA)/((ONE+A(2,K)/AA*(A(4,K)+ + & (ONE+A(2,K))/(ONE+AA)*A(5,K)))*HWSGAM(A(2,K)) + & *HWSGAM(ONE+A(3,K))) + ELSE + IP=NSET-2 + VT=MAX(-ONE,MIN(ONE,(2.*T-TMAX-TMIN)/(TMAX-TMIN))) + WT=VT*VT +C...CHEBYSHEV POLYNOMIALS FOR T EXPANSION + TT(1)=1. + TT(2)=VT + TT(3)= 2.*WT- 1. + TT(4)= (4.*WT- 3.)*VT + TT(5)= (8.*WT- 8.)*WT+1. + TT(6)=((16.*WT-20.)*WT+5.)*VT + ENDIF + ELSEIF (NSET.LT.3) THEN + IP=NSET+2 + DO 30 I=1,5 + DO 30 J=1,6 + 30 A(J,I)=B(1,J,I,IP)+S*(B(2,J,I,IP)+S*B(3,J,I,IP)) + AA=ONE+A(2,1)+A(3,1) + G(1)=HWSGAM(AA)/(HWSGAM(A(2,1))*HWSGAM(ONE+A(3,1))) + G(2)=0. + ENDIF + ENDIF +C + IF (NSET.LT.3.OR.NSET.EQ.5) THEN + DO 50 I=1,5 + 50 F(I)=A(1,I)*X**A(2,I)*XMWN**A(3,I)*(ONE+X* + & (A(4,I)+X*(A(5,I) + X*A(6,I)))) + F(1)=F(1)*G(1) + F(2)=F(2)*G(2) + UPV=F(1)-F(2) + DNV=F(2) + SEA=F(3)/6. + STR=SEA + CHM=F(4) + BTM=0. + TOP=0. + GLU=F(5) + ELSE + IF (X.NE.XOLD) THEN + XOLD=X + IF (X.GT.0.1) THEN + NX=1 + VX=(2.*X-1.1)/0.9 + ELSE + NX=2 + VX=MAX(-ONE,(2.*LOG(X)+11.51293)/6.90776) + ENDIF + WX=VX*VX + TX(1)=1. + TX(2)=VX + TX(3)= 2.*WX- 1. + TX(4)= (4.*WX- 3.)*VX + TX(5)= (8.*WX- 8.)*WX+1. + TX(6)=((16.*WX-20.)*WX+5.)*VX + ENDIF +C...CALCULATE STRUCTURE FUNCTIONS + DO 120 IFL=1,6 + XQSUM=0. + DO 110 IT=1,6 + DO 110 IX=1,6 + 110 XQSUM=XQSUM+CEHLQ(IX,IT,NX,IFL,IP)*TX(IX)*TT(IT) + 120 XQ(IFL)=XQSUM*XMWN**NEHLQ(IFL,IP) + UPV=XQ(1) + DNV=XQ(2) + STR=XQ(5) + CHM=XQ(6) + SEA=XQ(3) + GLU=XQ(4) +C...SPECIAL EXPANSION FOR BOTTOM (THRESHOLD EFFECTS) + IF (NFLAV.LT.5.OR.T.LE.TBMIN(IP)) THEN + BTM=0. + ELSE + VT=MAX(-ONE,MIN(ONE,(2.*T-TMAX-TBMIN(IP))/(TMAX-TBMIN(IP)))) + WT=VT*VT + TB(1)=1. + TB(2)=VT + TB(3)= 2.*WT- 1. + TB(4)= (4.*WT- 3.)*VT + TB(5)= (8.*WT- 8.)*WT+1. + TB(6)=((16.*WT-20.)*WT+5.)*VT + XQSUM=0. + DO 130 IT=1,6 + DO 130 IX=1,6 + 130 XQSUM=XQSUM+CEHLQ(IX,IT,NX,7,IP)*TX(IX)*TB(IT) + BTM=XQSUM*XMWN**NEHLQ(7,IP) + ENDIF +C...SPECIAL EXPANSION FOR TOP (THRESHOLD EFFECTS) + TPMIN=TTMIN(IP)+TMTOP +C---TMTOP=2.*LOG(TOPMAS/30.) + TPMAX=TMAX+TMTOP + IF (NFLAV.LT.6.OR.T.LE.TPMIN) THEN + TOP=0. + ELSE + VT=MAX(-ONE,MIN(ONE,(2.*T-TPMAX-TPMIN)/(TPMAX-TPMIN))) + WT=VT*VT + TB(1)=1. + TB(2)=VT + TB(3)= 2.*WT- 1. + TB(4)= (4.*WT- 3.)*VT + TB(5)= (8.*WT- 8.)*WT+1. + TB(6)=((16.*WT-20.)*WT+5.)*VT + XQSUM=0. + DO 150 IT=1,6 + DO 150 IX=1,6 + 150 XQSUM=XQSUM+CEHLQ(IX,IT,NX,8,IP)*TX(IX)*TB(IT) + TOP=XQSUM*XMWN**NEHLQ(8,IP) + ENDIF + ENDIF + ENDIF + IF (MPDF.LT.0) THEN + USEA=SEA + DSEA=USEA + ENDIF + IF (IDHAD.EQ.73.OR.IDHAD.EQ.72) THEN + DIST(1)=DSEA+DNV + DIST(2)=USEA+UPV + DIST(7)=DSEA + DIST(8)=USEA + ELSEIF (IDHAD.EQ.91) THEN + DIST(1)=DSEA + DIST(2)=USEA + DIST(7)=DSEA+DNV + DIST(8)=USEA+UPV + ELSEIF (IDHAD.EQ.75) THEN + DIST(1)=USEA+UPV + DIST(2)=DSEA+DNV + DIST(7)=USEA + DIST(8)=DSEA + ELSEIF (IDHAD.EQ.93) THEN + DIST(1)=USEA + DIST(2)=DSEA + DIST(7)=USEA+UPV + DIST(8)=DSEA+DNV + ELSEIF (IDHAD.EQ.38) THEN + DIST(1)=USEA + DIST(2)=USEA+UPV + DIST(7)=USEA+UPV + DIST(8)=USEA + ELSEIF (IDHAD.EQ.30) THEN + DIST(1)=USEA+UPV + DIST(2)=USEA + DIST(7)=USEA + DIST(8)=USEA+UPV + ELSE + PRINT *,' CALLED HWSFUN FOR IDHAD =',IDHAD + CALL HWWARN('HWSFUN',400,*999) + ENDIF + 900 DIST(3)=STR + DIST(4)=CHM + DIST(5)=BTM + DIST(6)=TOP + DIST(9)=STR + DIST(10)=CHM + DIST(11)=BTM + DIST(12)=TOP + DIST(13)=GLU + DO 901 I=1,13 + IF (DIST(I).LT.DMIN) DIST(I)=DMIN + 901 CONTINUE +C---FOR REMNANT NUCLEONS SWITCH OFF VALENCE QUARKS, +C WHILE MAINTAINING MOMENTUM SUM RULE + IF (IDHAD.EQ.72) THEN + TOTAL=0 + DO 910 I=1,13 + TOTAL=TOTAL+DIST(I) + 910 CONTINUE + DIST(1)=DIST(1)-DNV + DIST(2)=DIST(2)-UPV + IF (TOTAL.GT.DNV+UPV) THEN + DO 920 I=1,13 + DIST(I)=DIST(I)*TOTAL/(TOTAL-DNV-UPV) + 920 CONTINUE + ENDIF + ENDIF + 999 END +CDECK ID>, HWSGAM. +*CMZ :- -26/04/91 11.11.56 by Bryan Webber +*-- Author : Adapted by Bryan Webber +C----------------------------------------------------------------------- + FUNCTION HWSGAM(ZINPUT) +C----------------------------------------------------------------------- +C Gamma function computed by eq. 6.1.40, Abramowitz. +C B(M) = B2m/(2m *(2m-1)) where B2m is the 2m'th Bernoulli number. +C HLNTPI = .5*LOG(2.*PI) +C----------------------------------------------------------------------- + DOUBLE PRECISION HWSGAM,ZINPUT,B(10),HLNTPI,Z,SHIFT,G,T,RECZSQ + INTEGER I + DATA B/ + 1 0.83333333333333333333D-01, -0.27777777777777777778D-02, + 1 0.79365079365079365079D-03, -0.59523809523809523810D-03, + 1 0.84175084175084175084D-03, -0.19175269175269175269D-02, + 1 0.64102564102564102564D-02, -0.29550653594771241830D-01, + 1 0.17964437236883057316D0 , -1.3924322169059011164D0 / + DATA HLNTPI/0.91893853320467274178D0/ +C +C Shift argument to large value ( > 20 ) +C + Z=ZINPUT + SHIFT=1. + 10 IF (Z.LT.20.D0) THEN + SHIFT = SHIFT*Z + Z = Z + 1.D0 + GOTO 10 + ENDIF +C +C Compute asymptotic formula +C + G = (Z-.5D0)*LOG(Z) - Z + HLNTPI + T = 1.D0/Z + RECZSQ = T**2 + DO 20 I = 1,10 + G = G + B(I)*T + T = T*RECZSQ + 20 CONTINUE + HWSGAM = EXP(G)/SHIFT + END +CDECK ID>, HWSGEN. +*CMZ :- -26/04/91 14.55.45 by Federico Carminati +*-- Author : Bryan Webber +C----------------------------------------------------------------------- + SUBROUTINE HWSGEN(GENEX) +C----------------------------------------------------------------------- +C GENERATES X VALUES (IF GENEX) +C EVALUATES STRUCTURE FUNCTIONS AND ENFORCES CUTOFFS ON X +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + DOUBLE PRECISION HWBVMC,HWRUNI,X,QL + INTEGER I,J + LOGICAL GENEX + EXTERNAL HWBVMC,HWRUNI + IF (GENEX) THEN + XX(1)=EXP(HWRUNI(0,ZERO,XLMIN)) + XX(2)=XXMIN/XX(1) + ENDIF + DO 10 I=1,2 + J=I + IF (JDAHEP(1,I).NE.0) J=JDAHEP(1,I) + X=XX(I) + QL=(1.-X)*EMSCA + CALL HWSFUN(X,EMSCA,IDHW(J),NSTRU,DISF(1,I),I) + DO 10 J=1,13 + IF (QL.LT.HWBVMC(J)) DISF(J,I)=0. + 10 CONTINUE + END +CDECK ID>, HWSGQQ. +*CMZ :- -26/04/91 11.11.56 by Bryan Webber +*-- Author : Bryan Webber +C----------------------------------------------------------------------- + FUNCTION HWSGQQ(QSCA) +C----------------------------------------------------------------------- +C CORRECTION TO GLUON STRUCTURE FUNCTION FOR BACKWARD EVOLUTION: +C G->Q-QBAR PART OF FORM FACTOR +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + DOUBLE PRECISION HWSGQQ,HWUALF,QSCA,GG + EXTERNAL HWUALF + GG=HWUALF(1,QSCA)**(-ONE/BETAF) + IF (GG.LT.ONE) GG=ONE + IF (QSCA.GT.RMASS(6)) THEN + HWSGQQ=GG**6 + ELSEIF (QSCA.GT.RMASS(5)) THEN + HWSGQQ=GG**5 + ELSEIF (QSCA.GT.RMASS(4)) THEN + HWSGQQ=GG**4 + ELSE + HWSGQQ=GG**3 + ENDIF + END +CDECK ID>, HWSSPC. +*CMZ :- -26/04/91 11.11.56 by Bryan Webber +*-- Author : Bryan Webber +C----------------------------------------------------------------------- + SUBROUTINE HWSSPC +C----------------------------------------------------------------------- +C REPLACES SPACELIKE PARTONS BY SPECTATORS +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + DOUBLE PRECISION HWUSQR,EMSQ,EMTR,EPAR,XPAR,QSQ,PCL(5) + INTEGER KHEP,IP,JP,IDH,IDP,ISP,IDSPC,JHEP + EXTERNAL HWUSQR + IF (IERROR.NE.0) RETURN + DO 50 KHEP=1,NHEP + IF (ISTHEP(KHEP).EQ.145.OR.ISTHEP(KHEP).EQ.146) THEN + IP=ISTHEP(KHEP)-144 + JP=IP + IF (JDAHEP(1,IP).NE.0) JP=JDAHEP(1,IP) + IDH=IDHW(JP) + IDP=IDHW(KHEP) + IF (IDH.NE.IDP) THEN + IF (IDH.EQ.59) THEN +C---PHOTON CASE + IF (IDP.LT.7) THEN + IDSPC=IDP+6 + ELSEIF (IDP.LT.13) THEN + IDSPC=IDP-6 + ELSE + CALL HWWARN('HWSSPC',100,*999) + ENDIF +C---IDENTIFY SPECTATOR +C (1) QUARK CASE + ELSEIF (IDP.LE.3) THEN + DO 10 ISP=1,12 + 10 IF (IDH.EQ.NCLDK(LOCN(IDP,ISP))) GOTO 20 + CALL HWWARN('HWSSPC',101,*999) + 20 IF (ISP.LE.3) THEN + IDSPC=ISP+6 + ELSEIF (ISP.LE.9) THEN + IDSPC=ISP+105 + ELSE + IDSPC=ISP + ENDIF +C---(2) ANTIQUARK CASE + ELSEIF (IDP.GT.6.AND.IDP.LE.9) THEN + IDP=IDP-6 + DO 30 ISP=1,12 + 30 IF (IDH.EQ.NCLDK(LOCN(ISP,IDP))) GOTO 40 + CALL HWWARN('HWSSPC',103,*999) + RETURN + 40 IF (ISP.LE.3) THEN + IDSPC=ISP + ELSEIF (ISP.LE.9) THEN + IDSPC=ISP+111 + ELSE + IDSPC=ISP-6 + ENDIF +C---SPECIAL CASE FOR REMNANT HADRON + ELSEIF (IDH.EQ.71.OR.IDH.EQ.72) THEN + IF (IDP.EQ.13) THEN + IDSPC=IDP + ELSE + CALL HWWARN('HWSSPC',106,*999) + ENDIF + ELSE + CALL HWWARN('HWSSPC',105,*999) + ENDIF +C---REPLACE PARTON BY SPECTATOR + IDHW(KHEP)=IDSPC + IDHEP(KHEP)=IDPDG(IDSPC) + ISTHEP(KHEP)=146+IP + EMSQ=SIGN(PHEP(5,KHEP)**2,PHEP(5,KHEP)) + EMTR=EMSQ+PHEP(1,KHEP)**2+PHEP(2,KHEP)**2 + EPAR=PHEP(4,KHEP) + CALL HWVDIF(4,PHEP(1,JP),PHEP(1,KHEP),PHEP(1,KHEP)) + IF (EPAR**2.LT.10000.*ABS(EMTR)) THEN + CALL HWUMAS(PHEP(1,KHEP)) + ELSE +C---COMPUTE SPECTATOR MASS ELIMINATING ROUNDING ERRORS + XPAR=EPAR/PHEP(4,JP) + QSQ=SIGN(PHEP(5,JP)**2,PHEP(5,JP)) + PHEP(5,KHEP)=HWUSQR((1.-XPAR)*QSQ+EMSQ-EMTR/XPAR + & -((QSQ*XPAR**2-EMTR)/(2*EPAR*XPAR**2))**2*XPAR) + ENDIF +C---CHECK FOR UNPHYSICAL SPECTATOR + IF (PHEP(4,KHEP).LT.ZERO) FROST=.TRUE. +C---FIND MASS OF CORRESPONDING CLUSTER, IF PARTNER IS IN THE SAME JET + IF (QORQQB(IDHW(KHEP))) THEN + JHEP=JMOHEP(2,KHEP) + ELSEIF (QBORQQ(IDHW(KHEP))) THEN + JHEP=JDAHEP(2,KHEP) + ELSE + JHEP=0 + ENDIF + IF (JHEP.GT.0) THEN + CALL HWVSUM(4,PHEP(1,KHEP),PHEP(1,JHEP),PCL) + CALL HWUMAS(PCL) +C---IF IT IS NEGATIVE, REJECT + IF (PCL(5).LT.ZERO) FROST=.TRUE. + ENDIF + ENDIF + ENDIF + 50 CONTINUE + 999 END +CDECK ID>, HWSSUD. +*CMZ :- -26/04/91 11.11.56 by Bryan Webber +*-- Author : Bryan Webber +C----------------------------------------------------------------------- + FUNCTION HWSSUD(I) +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + DOUBLE PRECISION HWSSUD,HWSGQQ,DMIN,QSCA,XLAST,DIST(13) + INTEGER I,N0,IS,ID + EXTERNAL HWSGQQ + COMMON/HWTABC/XLAST,N0,IS,ID + DATA DMIN/1.D-15/ + QSCA=QEV(N0+I,IS) + CALL HWSFUN(XLAST,QSCA,IDHW(INHAD),NSTRU,DIST,JNHAD) + IF (ID.EQ.13) DIST(ID)=DIST(ID)*HWSGQQ(QSCA) + IF (DIST(ID).LT.DMIN) DIST(ID)=DMIN + HWSSUD=SUD(N0+I,IS)/DIST(ID) + END +CDECK ID>, HWSTAB. +*CMZ :- -26/04/91 11.11.56 by Bryan Webber +*-- Author : Adapted by Bryan Webber +C----------------------------------------------------------------------- + FUNCTION HWSTAB(F,AFUN,NN,X,MM) +C----------------------------------------------------------------------- +C MODIFIED CERN INTERPOLATION ROUTINE DIVDIF +C LIKE HWUTAB BUT USES FUNCTION AFUN IN PLACE OF ARRAY A +C----------------------------------------------------------------------- + IMPLICIT NONE + INTEGER NN,MM,MMAX,N,M,MPLUS,IX,IY,MID,NPTS,IP,I,J,L,ISUB + DOUBLE PRECISION HWSTAB,AFUN,SUM,X,F(NN),T(20),D(20) + LOGICAL EXTRA + EXTERNAL AFUN + DATA MMAX/10/ + N=NN + M=MIN(MM,MMAX,N-1) + MPLUS=M+1 + IX=0 + IY=N+1 + IF (AFUN(1).GT.AFUN(N)) GOTO 94 + 91 MID=(IX+IY)/2 + IF (X.GE.AFUN(MID)) GOTO 92 + IY=MID + GOTO 93 + 92 IX=MID + 93 IF (IY-IX.GT.1) GOTO 91 + GOTO 97 + 94 MID=(IX+IY)/2 + IF (X.LE.AFUN(MID)) GOTO 95 + IY=MID + GOTO 96 + 95 IX=MID + 96 IF (IY-IX.GT.1) GOTO 94 + 97 NPTS=M+2-MOD(M,2) + IP=0 + L=0 + GOTO 99 + 98 L=-L + IF (L.GE.0) L=L+1 + 99 ISUB=IX+L + IF ((1.LE.ISUB).AND.(ISUB.LE.N)) GOTO 100 + NPTS=MPLUS + GOTO 101 + 100 IP=IP+1 + T(IP)=AFUN(ISUB) + D(IP)=F(ISUB) + 101 IF (IP.LT.NPTS) GOTO 98 + EXTRA=NPTS.NE.MPLUS + DO 14 L=1,M + IF (.NOT.EXTRA) GOTO 12 + ISUB=MPLUS-L + D(M+2)=(D(M+2)-D(M))/(T(M+2)-T(ISUB)) + 12 I=MPLUS + DO 13 J=L,M + ISUB=I-L + D(I)=(D(I)-D(I-1))/(T(I)-T(ISUB)) + I=I-1 + 13 CONTINUE + 14 CONTINUE + SUM=D(MPLUS) + IF (EXTRA) SUM=0.5*(SUM+D(M+2)) + J=M + DO 15 L=1,M + SUM=D(J)+(X-T(J))*SUM + J=J-1 + 15 CONTINUE + HWSTAB=SUM + END +CDECK ID>, HWSVAL. +*CMZ :- -26/04/91 10.18.58 by Bryan Webber +*-- Author : Bryan Webber +C----------------------------------------------------------------------- + FUNCTION HWSVAL(ID) +C----------------------------------------------------------------------- +C TRUE FOR VALENCE PARTON ID IN INCOMING HADRON INHAD +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + INTEGER ID,IDHAD + LOGICAL HWSVAL + HWSVAL=.FALSE. + IDHAD=IDHW(INHAD) + IF (IDHAD.EQ.73.OR.IDHAD.EQ.75) THEN + IF (ID.EQ.1.OR.ID.EQ.2) HWSVAL=.TRUE. + ELSEIF (IDHAD.EQ.91.OR.IDHAD.EQ.93) THEN + IF (ID.EQ.7.OR.ID.EQ.8) HWSVAL=.TRUE. + ELSEIF (IDHAD.EQ.30) THEN + IF (ID.EQ.1.OR.ID.EQ.8) HWSVAL=.TRUE. + ELSEIF (IDHAD.EQ.38) THEN + IF (ID.EQ.2.OR.ID.EQ.7) HWSVAL=.TRUE. + ELSEIF (IDHAD.EQ.59) THEN + IF (ID.LT.6.OR.(ID.GT.6.AND.ID.LT.12)) HWSVAL=.TRUE. + ELSEIF (IDHAD.EQ.71.OR.IDHAD.EQ.72) THEN + IF (ID.EQ.13) HWSVAL=.TRUE. + ELSE + CALL HWWARN('HWSVAL',100,*999) + ENDIF + 999 END +CDECK ID>, HWUAEM. +*CMZ :- -23/08/94 13.22.29 by Mike Seymour +*-- Author : Ian Knowles +C----------------------------------------------------------------------- + FUNCTION HWUAEM(Q2) +C----------------------------------------------------------------------- +C Running electromagnetic coupling constant. +C See R. Kleiss et al.: CERN yellow report 89-08, vol.3 p.129 +C Hadronic component from: H. Burkhardt et al.: Z. Phys C43 (89) 497 +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + DOUBLE PRECISION HWUAEM,HWUAER,Q2,EPS,A1,B1,C1,A2,B2,C2,A3,B3,C3, + & A4,B4,C4,AEMPI,EEL2,EMU2,ETAU2,ETOP2,REPIGG,X + LOGICAL FIRST + EXTERNAL HWUAER + SAVE FIRST,AEMPI,EEL2,EMU2,ETAU2,ETOP2 + PARAMETER (EPS=1.D-6) + DATA A1,B1,C1/0.0 ,0.00835,1.000/ + DATA A2,B2,C2/0.0 ,0.00238,3.927/ + DATA A3,B3,C3/0.00165,0.00299,1.000/ + DATA A4,B4,C4/0.00221,0.00293,1.000/ + DATA FIRST/.TRUE./ + IF (FIRST) THEN + AEMPI=ALPHEM/(THREE*PIFAC) + EEL2 =RMASS(121)**2 + EMU2 =RMASS(123)**2 + ETAU2=RMASS(125)**2 + ETOP2=RMASS(6)**2 + FIRST=.FALSE. + ENDIF + IF (ABS(Q2).LT.EPS) THEN + HWUAEM=ALPHEM + RETURN + ENDIF +C Leptonic component + REPIGG=AEMPI*(HWUAER(EEL2/Q2)+HWUAER(EMU2/Q2)+HWUAER(ETAU2/Q2)) +C Hadronic component from light quarks + X=ABS(Q2) + IF (X.LT.9.D-2) THEN + REPIGG=REPIGG+A1+B1*LOG(ONE+C1*X) + ELSEIF (X.LT.9.D0) THEN + REPIGG=REPIGG+A2+B2*LOG(ONE+C2*X) + ELSEIF (X.LT.1.D4) THEN + REPIGG=REPIGG+A3+B3*LOG(ONE+C3*X) + ELSE + REPIGG=REPIGG+A4+B4*LOG(ONE+C4*X) + ENDIF +C Top Contribution + REPIGG=REPIGG+AEMPI*HWUAER(ETOP2/Q2) + HWUAEM=ALPHEM/(ONE-REPIGG) + RETURN + END +CDECK ID>, HWUAER. +*CMZ :- -23/08/94 13.22.29 by Mike Seymour +*-- Author : Ian Knowles +C----------------------------------------------------------------------- + FUNCTION HWUAER(R) +C----------------------------------------------------------------------- +C Real part of photon self-energy: Pi_{gg}(R=M^2/Q^2) +C----------------------------------------------------------------------- + DOUBLE PRECISION HWUAER,R,ZERO,ONE,TWO,FOUR,FVTHR,THIRD,RMAX,BETA + PARAMETER (ZERO=0.D0, ONE=1.D0, TWO=2.D0, FOUR=4.D0, + & FVTHR=1.666666666666667D0, THIRD=.3333333333333333D0) + PARAMETER (RMAX=1.D6) + IF (ABS(R).LT.1.D-3) THEN +C Use assymptotic formula + HWUAER=-FVTHR-LOG(ABS(R)) + ELSEIF (ABS(R).GT.RMAX) THEN + HWUAER=ZERO + ELSEIF (FOUR*R.GT.ONE) THEN + BETA=SQRT(FOUR*R-ONE) + HWUAER=THIRD + & -(ONE+TWO*R)*(TWO-BETA*ACOS(ONE-ONE/(TWO*R))) + ELSE + BETA=SQRT(ONE-FOUR*R) + HWUAER=THIRD + & -(ONE+TWO*R)*(TWO+BETA*LOG(ABS((BETA-ONE)/(BETA+ONE)))) + ENDIF + RETURN + END +CDECK ID>, HWUALF. +*CMZ :- -15/07/92 14.08.45 by Mike Seymour +*-- Author : Bryan Webber +C----------------------------------------------------------------------- + FUNCTION HWUALF(IOPT,SCALE) +C----------------------------------------------------------------------- +C STRONG COUPLING CONSTANT +C IOPT.EQ.0 INITIALIZES +C .EQ.1 TWO-LOOP, FLAVOUR THRESHOLDS +C .EQ.2 RATIO OF ABOVE TO ONE-LOOP +C WITH 5-FLAVOUR BETA, LAMBDA=QCDL3 +C .EQ.3 ONE-LOOP WITH 5-FLAVOUR BETA, LAMBDA=QCDL3 +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + DOUBLE PRECISION HWUALF,SCALE,KAFAC,B3,B4,B5,B6,C3,C4,C5,C6,C35, + & C45,C65,D35,RHO,RAT,RLF,DRH,EPS + INTEGER IOPT,ITN + SAVE B3,B4,B5,B6,C3,C4,C5,C6,C35,C45,C65,D35 + DATA EPS/1.D-6/ + IF (IOPT.EQ.0) THEN +C---INITIALIZE CONSTANTS + CAFAC=FLOAT(NCOLO) + CFFAC=FLOAT(NCOLO**2-1)/(2.*CAFAC) + B3=((11.*CAFAC)- 6.)/(12.*PIFAC) + B4=((11.*CAFAC)- 8.)/(12.*PIFAC) + B5=((11.*CAFAC)-10.)/(12.*PIFAC) + B6=((11.*CAFAC)-12.)/(12.*PIFAC) + BETAF=6.*PIFAC*B5 + C3=((17.*CAFAC**2)-(5.*CAFAC+3.*CFFAC)*3.)/(24.*PIFAC**2)/B3**2 + C4=((17.*CAFAC**2)-(5.*CAFAC+3.*CFFAC)*4.)/(24.*PIFAC**2)/B4**2 + C5=((17.*CAFAC**2)-(5.*CAFAC+3.*CFFAC)*5.)/(24.*PIFAC**2)/B5**2 + C6=((17.*CAFAC**2)-(5.*CAFAC+3.*CFFAC)*6.)/(24.*PIFAC**2)/B6**2 + KAFAC=CAFAC*(67./18.-PIFAC**2/6.)-25./9. +C---QCDLAM IS 5-FLAVOUR LAMBDA-MS-BAR AT LARGE X OR Z +C---QCDL5 IS 5-FLAVOUR LAMBDA-MC + QCDL5=QCDLAM*EXP(KAFAC/(4.*PIFAC*B5))/SQRT(2.D0) +C---COMPUTE THRESHOLD MATCHING + RHO=2.*LOG(RMASS(6)/QCDL5) + RAT=LOG(RHO)/RHO + C65=(B5/(1.-C5*RAT)-B6/(1.-C6*RAT))*RHO + RHO=2.*LOG(RMASS(5)/QCDL5) + RAT=LOG(RHO)/RHO + C45=(B5/(1.-C5*RAT)-B4/(1.-C4*RAT))*RHO + RHO=2.*LOG(RMASS(4)/QCDL5) + RAT=LOG(RHO)/RHO + C35=(B4/(1.-C4*RAT)-B3/(1.-C3*RAT))*RHO+C45 +C---FIND QCDL3 + D35=-1./(B3*C35) + DO 10 ITN=1,100 + RAT=LOG(D35)/D35 + RLF=B3*D35/(1.-C3*RAT) + DRH=B3*(RLF+C35)*D35**2/((1.-2.*C3*RAT+C3/D35)*RLF**2) + D35=D35-DRH + IF (ABS(DRH).LT.EPS*D35) GOTO 20 + 10 CONTINUE + 20 QCDL3=QCDL5*EXP(0.5*D35) + ENDIF + IF (SCALE.LE.QCDL5) CALL HWWARN('HWUALF',51,*999) + RHO=2.*LOG(SCALE/QCDL5) + IF (IOPT.EQ.3) THEN + IF (RHO.LE.D35) CALL HWWARN('HWUALF',52,*999) + HWUALF=1./(B5*(RHO-D35)) + RETURN + ENDIF + RAT=LOG(RHO)/RHO + IF (SCALE.GT.RMASS(6)) THEN + RLF=B6*RHO/(1.-C6*RAT)+C65 + ELSEIF (SCALE.GT.RMASS(5)) THEN + RLF=B5*RHO/(1.-C5*RAT) + ELSEIF (SCALE.GT.RMASS(4)) THEN + RLF=B4*RHO/(1.-C4*RAT)+C45 + ELSE + RLF=B3*RHO/(1.-C3*RAT)+C35 + ENDIF + IF (RLF.LE.ZERO) CALL HWWARN('HWUALF',53,*999) + IF (IOPT.EQ.1) THEN + HWUALF=1./RLF + ELSE + HWUALF=B5*(RHO-D35)/RLF + IF (HWUALF.GT.ONE) CALL HWWARN('HWUALF',54,*999) + ENDIF + RETURN + 999 HWUALF=ZERO + END +CDECK ID>, HWUANT. +*CMZ :- -27/07/99 13.33.03 by Mike Seymour +*-- Author : Ian Knowles +C----------------------------------------------------------------------- + FUNCTION HWUANT(IPART) +C----------------------------------------------------------------------- +C Returns the antiparticle of IPART; uses HERWIG numbering +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + INTEGER HWUANT,IPART,IPDG,IANTI,OLDERR + CHARACTER*8 CDUM + OLDERR=IERROR + IPDG=IDPDG(IPART) + IF (IPDG.EQ. 9.OR.IPDG.EQ.21.OR.IPDG.EQ.22.OR.IPDG.EQ.23.OR. + & IPDG.EQ.25.OR.IPDG.EQ.26.OR.IPDG.EQ.32.OR.IPDG.EQ.35.OR. + & IPDG.EQ.36.OR.IPDG.EQ.91.OR.IPDG.EQ.98.OR.IPDG.EQ.99.OR. + & IPDG.EQ.130.OR.IPDG.EQ.310.OR. + & IPDG.EQ.1000021.OR.IPDG.EQ.1000022.OR.IPDG.EQ.1000023.OR. + & IPDG.EQ.1000025.OR.IPDG.EQ.1000035.OR.IPDG.EQ.1000039.OR. + & (FLOAT(INT(RSPIN(IPART))).EQ.RSPIN(IPART).AND. + & MOD(IPDG/100,10).EQ.MOD(IPDG/10,10).AND. + & MOD(IPDG/10,10).NE.0)) THEN +C Self-conjugate boson + IANTI=IPART + ELSEIF(IPART.EQ.211.OR.IPART.EQ.212) THEN +C Fourth generation (anti-)quarks + IANTI=IPART+6 + ELSEIF(IPART.EQ.217.OR.IPART.EQ.218) THEN + IANTI=IPART-6 + ELSE +C Non-zero charge particle + CALL HWUIDT(1,-IPDG,IANTI,CDUM) + ENDIF + IF (IANTI.EQ.20) WRITE(6,10) RNAME(IPART) + 10 FORMAT(1X,A8,' has no antiparticle'/) + HWUANT=IANTI + IERROR=OLDERR + END +CDECK ID>, HWUATS. +*CMZ :- -07/07/99 17.42.00 by Kosuke Odagiri +*-- Author : Kosuke Odagiri +C----------------------------------------------------------------------- + SUBROUTINE HWUATS +C----------------------------------------------------------------------- +C Replaces all &'s in TXNAME by \'s +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + INTEGER I,J,L + CHARACTER*1 Z + Z=CHAR(92) + L=LEN(TXNAME(1,1)) + DO 1 I=0,NMXRES + DO 2 J=1,L + IF (TXNAME(1,I)(J:J).EQ.'&') TXNAME(1,I)(J:J)=Z + 2 CONTINUE + 1 CONTINUE + END +CDECK ID>, HWUBPR. +*CMZ :- -26/04/91 10.18.58 by Bryan Webber +*-- Author : Bryan Webber +C----------------------------------------------------------------------- + SUBROUTINE HWUBPR +C----------------------------------------------------------------------- +C PRINTS OUT DATA ON PARTON SHOWER +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + INTEGER I,J + IF (PRVTX) THEN + WRITE(6,10) INHAD,XFACT + 10 FORMAT(///10X,'DATA ON LAST PARTON SHOWER: INHAD =',I3, + & ' XFACT =',E11.3//' IPAR ID TM DA1 CMO AMO CDA', + & ' ADA P-X P-Y P-Z ENERGY MASS', + & ' V-X V-Y V-Z V-C*T') + DO 20 J=1,NPAR + 20 WRITE(6,30) J,RNAME(ABS(IDPAR(J))),TMPAR(J),JDAPAR(1,J), + & (JCOPAR(I,J),I=1,4),(PPAR(I,J),I=1,5),(VPAR(I,J),I=1,4) + 30 FORMAT(I5,1X,A8,L2,5I4,F7.2,4F8.2,4E11.4) + ELSE + WRITE(6,40) INHAD,XFACT + 40 FORMAT(///10X,'DATA ON LAST PARTON SHOWER: INHAD =',I3, + & ' XFACT =',E11.3//' IPAR ID TM DA1 CMO AMO CDA', + & ' ADA P-X P-Y P-Z ENERGY MASS') + DO 50 J=1,NPAR + 50 WRITE(6,60) J,RNAME(ABS(IDPAR(J))),TMPAR(J),JDAPAR(1,J), + & (JCOPAR(I,J),I=1,4),(PPAR(I,J),I=1,5) + 60 FORMAT(I5,1X,A8,L2,5I4,F7.2,4F8.2) + ENDIF + END +CDECK ID>, HWUBST. +*CMZ :- -18/10/93 10.21.56 by Mike Seymour +*-- Author : Mike Seymour +C----------------------------------------------------------------------- + SUBROUTINE HWUBST(IOPT) +C----------------------------------------------------------------------- +C BOOST THE ENTIRE EVENT RECORD TO (IOPT=1) OR FROM (IOPT=0) ITS +C CENTRE-OF-MASS FRAME, WITH INCOMING HADRONS ON Z-AXIS +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + DOUBLE PRECISION PBOOST(5),RBOOST(3,3) + INTEGER IOPT,IHEP,BOOSTD,IHAD + SAVE BOOSTD,PBOOST,RBOOST + DATA BOOSTD/-1/ + IF (IERROR.NE.0) RETURN + IF (IOPT.EQ.1) THEN +C---FIND FIRST INCOMING HADRON + IHAD=1 + IF (JDAHEP(1,IHAD).NE.0) IHAD=JDAHEP(1,IHAD) +C---IF WE'RE ALREADY IN THE RIGHT FRAME, DON'T DO ANYTHING + IF (PHEP(1,3)**2+PHEP(2,3)**2+PHEP(3,3)**2.EQ.ZERO .AND. + & PHEP(1,IHAD)**2+PHEP(2,IHAD)**2.EQ.ZERO) RETURN +C---FIND AND APPLY BOOST + CALL HWVEQU(5,PHEP(1,3),PBOOST) + DO 100 IHEP=1,NHEP + CALL HWULOF(PBOOST,PHEP(1,IHEP),PHEP(1,IHEP)) + CALL HWULOF(PBOOST,VHEP(1,IHEP),VHEP(1,IHEP)) + 100 CONTINUE + CALL HWULOF(PBOOST,VTXPIP,VTXPIP) +C---FIND AND APPLY ROTATION TO PUT IT ON Z-AXIS + CALL HWUROT(PHEP(1,IHAD),ONE,ZERO,RBOOST) + DO 110 IHEP=1,NHEP + CALL HWUROF(RBOOST,PHEP(1,IHEP),PHEP(1,IHEP)) + CALL HWUROF(RBOOST,VHEP(1,IHEP),VHEP(1,IHEP)) + 110 CONTINUE + CALL HWUROF(RBOOST,VTXPIP,VTXPIP) +C---ENSURE THAT WE ONLY EVER UNBOOST THE SAME EVENT THAT WE BOOSTED +C (BEARING IN MIND THAT NWGTS IS UPDATED AFTER GENERATING THE WEIGHT) + BOOSTD=NWGTS+1 + ELSEIF (IOPT.EQ.0) THEN + IF (BOOSTD.NE.NWGTS) RETURN +C---UNDO ROTATION AND BOOST + DO 200 IHEP=1,NHEP + CALL HWUROB(RBOOST,PHEP(1,IHEP),PHEP(1,IHEP)) + CALL HWULOB(PBOOST,PHEP(1,IHEP),PHEP(1,IHEP)) + CALL HWUROB(RBOOST,VHEP(1,IHEP),VHEP(1,IHEP)) + CALL HWULB4(PBOOST,VHEP(1,IHEP),VHEP(1,IHEP)) + 200 CONTINUE + ENDIF + END +CDECK ID>, HWUCFF. +*CMZ :- -23/08/94 13.22.29 by Mike Seymour +*-- Author : Bryan Webber and Ian Knowles +C----------------------------------------------------------------------- + SUBROUTINE HWUCFF(I,J,QSQ,CLF) +C----------------------------------------------------------------------- +C Calculates basic coefficients in cross-section formula for +C ffbar --> f'fbar', at virtuality QSQ, I labels initial, J +C labels final fermion; type given as: +C I,J= 1- 6: d,u,s,c,b,t +C =11-16: e,nu_e,mu,nu_mu,tau,nu_tau +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + DOUBLE PRECISION QSQ,CLF(7),POL1,POL2,QIF,VI,AI,VF,AF,PG,DQM,PMW, + & DEN,XRE,XIM,XSQ,VI2,AI2,VF2,AF2,PG2,PG12,DQM2,PMW2,DEN2,XRE2, + & XIM2,XSQ2,XRE12,XIM12 + INTEGER I,J +C Longitudinal Polarisation factors + POL1=1.-EPOLN(3)*PPOLN(3) + POL2=PPOLN(3)-EPOLN(3) +C Standard model couplings + QIF=QFCH(I)*QFCH(J) + VI=VFCH(I,1) + AI=AFCH(I,1) + VF=VFCH(J,1) + AF=AFCH(J,1) + PG=POL1*(VI**2+AI**2)+POL2*2.*VI*AI +C Z propagator factors + DQM=QSQ-RMASS(200)**2 + PMW=GAMZ*RMASS(200) + DEN=QSQ/(DQM**2+PMW**2) + XRE=DEN*DQM + XIM=DEN*PMW + XSQ=DEN*QSQ +C Calculate cross-section coefficients + CLF(1)=POL1*QIF**2+XRE*2.*QIF*(POL1*VI+POL2*AI)*VF + & +XSQ*PG*(VF**2+AF**2) + CLF(2)=CLF(1)-2.*XSQ*PG*AF**2 + CLF(3)=2.*(XRE*QIF*(POL1*AI+POL2*VI)*AF + & +XSQ*(POL1*2.*VI*AI+POL2*(VI**2+AI**2))*VF*AF) + IF (TPOL) THEN + CLF(4)=QIF**2+XRE*2.*QIF*VI*VF+XSQ*(VI**2-AI**2)*(VF**2+AF**2) + CLF(5)=CLF(4)-2.*XSQ*(VI**2-AI**2)*AF**2 + CLF(6)=XIM*2.*QIF*AI*VF + CLF(7)=CLF(6) + ENDIF + IF (ZPRIME) THEN +C Z' couplings: + VI2=VFCH(I,2) + AI2=AFCH(I,2) + VF2=VFCH(J,2) + AF2=AFCH(J,2) + PG2=POL1*(VI2**2+AI2**2)+POL2*2.*VI2*AI2 + PG12=POL1*(VI*VI2+AI*AI2)+POL2*(VI*AI2+AI+VI2) +C Z' propagator factors + DQM2=QSQ-RMASS(202)**2 + PMW2=RMASS(202)*GAMZP + DEN2=QSQ/(DQM2**2+PMW2**2) + XRE2=DEN2*DQM2 + XIM2=DEN2*PMW2 + XSQ2=DEN2*QSQ + XRE12=DEN*DEN2*(DQM*DQM2+PMW*PMW2) + XIM12=DEN*DEN2*(DQM*PMW2-DQM2*PMW) +C Additional contributions to cross-section coefficients + CLF(1)=CLF(1)+XRE2*2.*QIF*(POL1*VI2+POL2*AI2)*VF2 + & +XSQ2*PG2*(VF2**2+AF2**2)+XRE12*2.*PG12*(VF*VF2+AF*AF2) + CLF(2)=CLF(1)-2.*(XSQ2*PG2*AF2**2+XRE12*2.*PG12*AF*AF2) + CLF(3)=CLF(3)+2.*(XRE2*QIF*(POL1*AI2+POL2*VI2)*AF2 + & +XSQ2*(POL1*2.*VI2*AI2+POL2*(VI2**2+AI2**2))*VF2*AF2 + & +XRE12*(POL1*(VI*AI2+AI*VI2)+POL1*(VI*VI2+AI*AI2)) + & *(VF*VF2+AF*AF2)) + IF (TPOL) THEN + CLF(4)=CLF(4)+XRE2*2.*QIF*VI2*VF2 + & +XSQ2*(VI2**2-AI2**2)*(VF2**2+AF2**2) + & +XRE12*2.*(VI*VI2-AI*AI2)*(VF*VF2+AF*AF2) + CLF(5)=CLF(4)-2*(XSQ2*(VI2**2-AI2**2)*AF2**2 + & +XRE12*2.*(VI*VI2-AI*AI2)*AF*AF2) + CLF(6)=CLF(6)+2.*(XIM2*QIF*AI2*VF2 + & -XIM12*(VI*AI2-AI*VI2)*(VF*VF2+AF*AF2)) + CLF(7)=CLF(6)+4.*XIM12*(VI*AI2-AI*AI2)*AF*AF2 + ENDIF + ENDIF + RETURN + END +CDECK ID>, HWUCI2. +*CMZ :- -23/08/94 13.22.29 by Mike Seymour +*-- Author : Ulrich Baur & Nigel Glover, adapted by Ian Knowles +C----------------------------------------------------------------------- + FUNCTION HWUCI2(A,B,Y0) +C----------------------------------------------------------------------- +C Integral LOG(A-EPSI-BY(1-Y))/(Y-Y0) +C----------------------------------------------------------------------- + IMPLICIT NONE + DOUBLE COMPLEX HWUCI2,HWULI2,EPSI,Y1,Y2,Z1,Z2,Z3,Z4 + DOUBLE PRECISION A,B,Y0,ZERO,ONE,FOUR,HALF + EXTERNAL HWULI2 + COMMON/SMALL/EPSI + PARAMETER (ZERO=0.D0, ONE =1.D0, FOUR= 4.D0, HALF=0.5D0) + IF(B.EQ.ZERO)THEN + HWUCI2=CMPLX(ZERO,ZERO) + ELSE + Y1=HALF*(ONE+SQRT(ONE-FOUR*(A+EPSI)/B)) + Y2=ONE-Y1 + Z1=Y0/(Y0-Y1) + Z2=(Y0-ONE)/(Y0-Y1) + Z3=Y0/(Y0-Y2) + Z4=(Y0-ONE)/(Y0-Y2) + HWUCI2=HWULI2(Z1)-HWULI2(Z2)+HWULI2(Z3)-HWULI2(Z4) + ENDIF + RETURN + END +CDECK ID>, HWUDAT. +*CMZ :- -26/04/91 10.18.58 by Bryan Webber +*-- Author : Ian Knowles & Bryan Webber +C----------------------------------------------------------------------- + BLOCK DATA HWUDAT +C----------------------------------------------------------------------- +C Loads common blocks with particle properties data; for particle I: +C RNAME(I) = Name +C IDPDG(I) = PDG code +C IFLAV(I) = HERWIG flavour code +C ICHRG(I) = Electric charge (|e-|) (*3 for (di-)quarks) +C RMASS(I) = Mass (GeV/c^2) +C RLTIM(I) = Proper life time (s) +C RSPIN(I) = Spin +C QORQQB(I) = .TRUE. if it is a quark or an antidiquark +C QBORQQ(I) = .TRUE. if it is an antiquark or a diquark +C And stores the particle decay tables: call HWUDPR to print them +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + INTEGER NLAST,NNEXT,NLEFT,NREST,I,J,MMWIDE,MMLONG,MMHOFF,MMVOFF + COMMON/PAPER/MMWIDE,MMLONG,MMHOFF,MMVOFF + PARAMETER (NLAST=458,NNEXT=458+1,NLEFT=NMXRES-458) + PARAMETER (NREST=NMXRES-120) + DATA NRES/458/ +C Don't forget to change the three occurances above as well + DATA MMWIDE,MMLONG,MMHOFF,MMVOFF/190,280,-39,-35/ + DATA (RNAME(I),IDPDG(I),IFLAV(I),ICHRG(I),RMASS(I),RLTIM(I), + & RSPIN(I),I=0,16)/ + & ' ', 0, 0, 0,0.0000,0.000D+00,0.0, + & 'DQRK ', 1, 0,-1,0.3200,0.000D+00,0.5, + & 'UQRK ', 2, 0,+2,0.3200,0.000D+00,0.5, + & 'SQRK ', 3, 0,-1,0.5000,0.000D+00,0.5, + & 'CQRK ', 4, 0,+2,1.5500,0.000D+00,0.5, + & 'BQRK ', 5, 0,-1,4.9500,0.000D+00,0.5, + & 'TQRK ', 6, 0,+2,170.00,0.000D+00,0.5, + & 'DBAR ', -1, 0,+1,0.3200,0.000D+00,0.5, + & 'UBAR ', -2, 0,-2,0.3200,0.000D+00,0.5, + & 'SBAR ', -3, 0,+1,0.5000,0.000D+00,0.5, + & 'CBAR ', -4, 0,-2,1.5500,0.000D+00,0.5, + & 'BBAR ', -5, 0,+1,4.9500,0.000D+00,0.5, + & 'TBAR ', -6, 0,-2,170.00,0.000D+00,0.5, + & 'GLUON ', 21, 0, 0,0.7500,0.000D+00,1.0, + & 'CMF ', 0, 0, 0,0.0000,0.000D+00,0.0, + & 'HARD ', 0, 0, 0,0.0000,0.000D+00,0.0, + & 'SOFT ', 0, 0, 0,0.0000,0.000D+00,0.0/ + DATA (RNAME(I),IDPDG(I),IFLAV(I),ICHRG(I),RMASS(I),RLTIM(I), + & RSPIN(I),I=17,32)/ + & 'CONE ', 0, 0, 0,0.0000,0.000D+00,0.0, + & 'HEAVY ', 0, 0, 0,0.0000,0.000D+00,0.0, + & 'CLUS ', 91, 0, 0,0.0000,0.000D+00,0.0, + & '**** ', 0, 0, 0,0.0000,0.000D+00,0.0, + & 'PI0 ', 111, 11, 0,.13498,8.400D-17,0.0, + & 'ETA ', 221, 33, 0,.54730,0.000D+00,0.0, + & 'RHO0 ', 113, 11, 0,.77000,0.000D+00,1.0, + & 'OMEGA ', 223, 33, 0,.78194,0.000D+00,1.0, + & 'ETAP ', 331, 33, 0,.95778,0.000D+00,0.0, + & 'F_2 ', 225, 33, 0,1.2750,0.000D+00,2.0, + & 'A_10 ', 20113, 11, 0,1.2300,0.000D+00,1.0, + & 'FL_1 ', 20223, 33, 0,1.2819,0.000D+00,1.0, + & 'A_20 ', 115, 11, 0,1.3181,0.000D+00,2.0, + & 'PI- ', -211, 12,-1,.13957,2.603D-08,0.0, + & 'RHO- ', -213, 12,-1,.77000,0.000D+00,1.0, + & 'A_1- ', -20213, 12,-1,1.2300,0.000D+00,1.0/ + DATA (RNAME(I),IDPDG(I),IFLAV(I),ICHRG(I),RMASS(I),RLTIM(I), + & RSPIN(I),I=33,48)/ + & 'A_2- ', -215, 12,-1,1.3181,0.000D+00,2.0, + & 'K- ', -321, 32,-1,.49368,1.237D-08,0.0, + & 'K*- ', -323, 32,-1,.89166,0.000D+00,1.0, + & 'KH_1- ', -20323, 32,-1,1.8500,0.000D+00,1.0, + & 'K*_2- ', -325, 32,-1,1.4256,0.000D+00,2.0, + & 'PI+ ', 211, 21,+1,.13957,2.603D-08,0.0, + & 'RHO+ ', 213, 21,+1,.77000,0.000D+00,1.0, + & 'A_1+ ', 20213, 21,+1,1.2300,0.000D+00,1.0, + & 'A_2+ ', 215, 21,+1,1.3181,0.000D+00,2.0, + & 'KBAR0 ', -311, 31, 0,.49767,0.000D+00,0.0, + & 'K*BAR0 ', -313, 31, 0,.89610,0.000D+00,1.0, + & 'KH_1BAR0', -20313, 31, 0,1.8500,0.000D+00,1.0, + & 'K*_2BAR0', -315, 31, 0,1.4324,0.000D+00,2.0, + & 'K+ ', 321, 23,+1,.49368,1.237D-08,0.0, + & 'K*+ ', 323, 23,+1,.89166,0.000D+00,1.0, + & 'KH_1+ ', 20323, 23,+1,1.8500,0.000D+00,1.0/ + DATA (RNAME(I),IDPDG(I),IFLAV(I),ICHRG(I),RMASS(I),RLTIM(I), + & RSPIN(I),I=49,64)/ + & 'K*_2+ ', 325, 23,+1,1.4256,0.000D+00,2.0, + & 'K0 ', 311, 13, 0,.49767,0.000D+00,0.0, + & 'K*0 ', 313, 13, 0,.89610,0.000D+00,1.0, + & 'KH_10 ', 20313, 13, 0,1.8500,0.000D+00,1.0, + & 'K*_20 ', 315, 13, 0,1.4324,0.000D+00,2.0, + & ' ', 0, 0, 0,0.0000,0.000D+00,0.0, + & ' ', 0, 0, 0,0.0000,0.000D+00,0.0, + & 'PHI ', 333, 33, 0,1.0194,0.000D+00,1.0, + & 'FH_1 ', 20333, 33, 0,1.4262,0.000D+00,1.0, + & 'FP_2 ', 335, 33, 0,1.5250,0.000D+00,2.0, + & 'GAMMA ', 22, 0, 0,0.0000,1.000D+30,1.0, + & 'K_S0 ', 310, 0, 0,.49767,8.926D-11,0.0, + & 'K_L0 ', 130, 0, 0,.49767,5.170D-08,0.0, + & 'A_0(H)0 ', 10111, 11, 0,1.4740,0.000D+00,0.0, + & 'A_0(H)+ ', 10211, 21,+1,1.4740,0.000D+00,0.0, + & 'A_0(H)- ', -10211, 12,-1,1.4740,0.000D+00,0.0/ + DATA (RNAME(I),IDPDG(I),IFLAV(I),ICHRG(I),RMASS(I),RLTIM(I), + & RSPIN(I),I=65,80)/ + & ' ', 0, 0, 0,0.0000,0.000D+00,0.0, + & ' ', 0, 0, 0,0.0000,0.000D+00,0.0, + & ' ', 0, 0, 0,0.0000,0.000D+00,0.0, + & ' ', 0, 0, 0,0.0000,0.000D+00,0.0, + & ' ', 0, 0, 0,0.0000,0.000D+00,0.0, + & ' ', 0, 0, 0,0.0000,0.000D+00,0.0, + & 'REMG ', 98, 0, 0,0.0000,0.000D+00,0.0, + & 'REMN ', 99, 0, 0,0.0000,0.000D+00,0.0, + & 'P ', 2212, 122,+1,.93827,1.000D+30,0.5, + & 'DELTA+ ', 2214, 122,+1,1.2320,0.000D+00,1.5, + & 'N ', 2112, 112, 0,.93957,8.870D+02,0.5, + & 'DELTA0 ', 2114, 112, 0,1.2320,0.000D+00,1.5, + & 'DELTA- ', 1114, 111,-1,1.2320,0.000D+00,1.5, + & 'LAMBDA ', 3122, 123, 0,1.1157,2.632D-10,0.5, + & 'SIGMA0 ', 3212, 123, 0,1.1926,7.400D-20,0.5, + & 'SIGMA*0 ', 3214, 123, 0,1.3837,0.000D+00,1.5/ + DATA (RNAME(I),IDPDG(I),IFLAV(I),ICHRG(I),RMASS(I),RLTIM(I), + & RSPIN(I),I=81,96)/ + & 'SIGMA- ', 3112, 113,-1,1.1974,1.479D-10,0.5, + & 'SIGMA*- ', 3114, 113,-1,1.3872,0.000D+00,1.5, + & 'XI- ', 3312, 133,-1,1.3213,1.639D-10,0.5, + & 'XI*- ', 3314, 133,-1,1.5350,0.000D+00,1.5, + & 'DELTA++ ', 2224, 222,+2,1.2320,0.000D+00,1.5, + & 'SIGMA+ ', 3222, 223,+1,1.1894,7.990D-11,0.5, + & 'SIGMA*+ ', 3224, 223,+1,1.3828,0.000D+00,1.5, + & 'XI0 ', 3322, 233, 0,1.3149,2.900D-10,0.5, + & 'XI*0 ', 3324, 233, 0,1.5318,0.000D+00,1.5, + & 'OMEGA- ', 3334, 333,-1,1.6725,8.220D-11,1.5, + & 'PBAR ', -2212,-122,-1,.93827,1.000D+30,0.5, + & 'DELTABR-', -2214,-122,-1,1.2320,0.000D+00,1.5, + & 'NBAR ', -2112,-112, 0,.93957,8.870D+02,0.5, + & 'DELTABR0', -2114,-112, 0,1.2320,0.000D+00,1.5, + & 'DELTABR+', -1114,-111,+1,1.2320,0.000D+00,1.5, + & 'LAMBDABR', -3122,-123, 0,1.1157,2.632D-10,0.5/ + DATA (RNAME(I),IDPDG(I),IFLAV(I),ICHRG(I),RMASS(I),RLTIM(I), + & RSPIN(I),I=97,112)/ + & 'SIGMABR0', -3212,-123, 0,1.1926,7.400D-20,0.5, + & 'SGMA*BR0', -3214,-123, 0,1.3837,0.000D+00,1.5, + & 'SIGMABR+', -3112,-113,+1,1.1974,1.479D-10,0.5, + & 'SGMA*BR+', -3114,-113,+1,1.3872,0.000D+00,1.5, + & 'XIBAR+ ', -3312,-133,+1,1.3213,1.639D-10,0.5, + & 'XI*BAR+ ', -3314,-133,+1,1.5350,0.000D+00,1.5, + & 'DLTABR--', -2224,-222,-2,1.2320,0.000D+00,1.5, + & 'SIGMABR-', -3222,-223,-1,1.1894,7.990D-11,0.5, + & 'SGMA*BR-', -3224,-223,-1,1.3828,0.000D+00,1.5, + & 'XIBAR0 ', -3322,-233, 0,1.3149,2.900D-10,0.5, + & 'XI*BAR ', -3324,-233, 0,1.5318,0.000D+00,1.5, + & 'OMEGABR+', -3334,-333,+1,1.6725,8.220D-11,1.5, + & 'UU ', 2203, 0,+4,0.6400,0.000D+00,0.0, + & 'UD ', 2101, 0,+1,0.6400,0.000D+00,0.0, + & 'DD ', 1103, 0,-2,0.6400,0.000D+00,0.0, + & 'US ', 3201, 0,+1,0.8200,0.000D+00,0.0/ + DATA (RNAME(I),IDPDG(I),IFLAV(I),ICHRG(I),RMASS(I),RLTIM(I), + & RSPIN(I),I=113,128)/ + & 'DS ', 3101, 0,-2,0.8200,0.000D+00,0.0, + & 'SS ', 3303, 0,-2,1.0000,0.000D+00,0.0, + & 'UBARUBAR', -2203, 0,-4,0.6400,0.000D+00,0.0, + & 'UBARDBAR', -2101, 0,-1,0.6400,0.000D+00,0.0, + & 'DBARDBAR', -1103, 0,+2,0.6400,0.000D+00,0.0, + & 'UBARSBAR', -3201, 0,-1,0.8200,0.000D+00,0.0, + & 'DBARSBAR', -3101, 0,+2,0.8200,0.000D+00,0.0, + & 'SBARSBAR', -3303, 0,+2,1.0000,0.000D+00,0.0, + & 'E- ', 11, 0,-1,5.11D-4,1.00D+30,0.5, + & 'NU_E ', 12, 0, 0,0.0000,1.000D+30,0.5, + & 'MU- ', 13, 0,-1,.10566,2.197D-06,0.5, + & 'NU_MU ', 14, 0, 0,0.0000,1.000D+30,0.5, + & 'TAU- ', 15, 0,-1,1.7771,2.916D-13,0.5, + & 'NU_TAU ', 16, 0, 0,0.0000,1.000D+30,0.5, + & 'E+ ', -11, 0,+1,5.11D-4,1.00D+30,0.5, + & 'NU_EBAR ', -12, 0, 0,0.0000,1.000D+30,0.5/ + DATA (RNAME(I),IDPDG(I),IFLAV(I),ICHRG(I),RMASS(I),RLTIM(I), + & RSPIN(I),I=129,144)/ + & 'MU+ ', -13, 0,+1,.10566,2.197D-06,0.5, + & 'NU_MUBAR', -14, 0, 0,0.0000,1.000D+30,0.5, + & 'TAU+ ', -15, 0,+1,1.7771,2.916D-13,0.5, + & 'NU_TAUBR', -16, 0, 0,0.0000,1.000D+30,0.5, + & ' ', 0, 0, 0,0.0000,0.000D+00,0.0, + & ' ', 0, 0, 0,0.0000,0.000D+00,0.0, + & ' ', 0, 0, 0,0.0000,0.000D+00,0.0, + & 'D+ ', 411, 41,+1,1.8693,1.057D-12,0.0, + & 'D*+ ', 413, 41,+1,2.0100,0.000D+00,1.0, + & 'DH_1+ ', 20413, 41,+1,2.4270,0.000D+00,1.0, + & 'D*_2+ ', 415, 41,+1,2.4590,0.000D+00,2.0, + & 'D0 ', 421, 42, 0,1.8646,4.150D-13,0.0, + & 'D*0 ', 423, 42, 0,2.0067,0.000D+00,1.0, + & 'DH_10 ', 20423, 42, 0,2.4222,0.000D+00,1.0, + & 'D*_20 ', 425, 42, 0,2.4589,0.000D+00,2.0, + & 'D_S+ ', 431, 43,+1,1.9685,4.670D-13,0.0/ + DATA (RNAME(I),IDPDG(I),IFLAV(I),ICHRG(I),RMASS(I),RLTIM(I), + & RSPIN(I),I=145,160)/ + & 'D*_S+ ', 433, 43,+1,2.1124,0.000D+00,1.0, + & 'DH_S1+ ', 20433, 43,+1,2.5354,0.000D+00,1.0, + & 'D*_S2+ ', 435, 43,+1,2.5735,0.000D+00,2.0, + & 'SGMA_C++', 4222, 224,+2,2.4528,0.000D+00,0.5, + & 'SGM*_C++', 4224, 224,+2,2.5194,0.000D+00,1.5, + & 'LMBDA_C+', 4122, 124,+1,2.2849,2.060D-13,0.5, + & 'SIGMA_C+', 4212, 124,+1,2.4536,0.000D+00,0.5, + & 'SGMA*_C+', 4214, 124,+1,2.5185,0.000D+00,1.5, + & 'SIGMA_C0', 4112, 114, 0,2.4522,0.000D+00,0.5, + & 'SGMA*_C0', 4114, 114, 0,2.5175,0.000D+00,1.5, + & 'XI_C+ ', 4232, 234,+1,2.4656,3.500D-13,0.5, + & 'XIP_C+ ', 4322, 234,+1,2.5750,0.000D+00,0.5, + & 'XI*_C+ ', 4324, 234,+1,2.6446,0.000D+00,1.5, + & 'XI_C0 ', 4132, 134, 0,2.4703,9.800D-14,0.5, + & 'XIP_C0 ', 4312, 134, 0,2.5800,0.000D+00,0.5, + & 'XI*_C0 ', 4314, 134, 0,2.6438,0.000D+00,1.5/ + DATA (RNAME(I),IDPDG(I),IFLAV(I),ICHRG(I),RMASS(I),RLTIM(I), + & RSPIN(I),I=161,176)/ + & 'OMEGA_C0', 4332, 334, 0,2.7040,6.400D-14,0.5, + & 'OMGA*_C0', 4334, 334, 0,2.7300,0.000D+00,1.5, + & 'ETA_C ', 441, 44, 0,2.9798,0.000D+00,0.0, + & 'JPSI ', 443, 44, 0,3.0969,0.000D+00,1.0, + & 'CHI_C1 ', 10441, 44, 0,3.4173,0.000D+00,0.0, + & 'PSI2S ', 100443, 44, 0,3.6860,0.000D+00,1.0, + & 'PSID ', 30443, 44, 0,3.7699,0.000D+00,1.0, + & ' ', 0, 0, 0,0.0000,0.000D+00,0.0, + & ' ', 0, 0, 0,0.0000,0.000D+00,0.0, + & ' ', 0, 0, 0,0.0000,0.000D+00,0.0, + & 'D- ', -411, 14,-1,1.8693,1.057D-12,0.0, + & 'D*- ', -413, 14,-1,2.0100,0.000D+00,1.0, + & 'DH_1- ', -20413, 14,-1,2.4270,0.000D+00,1.0, + & 'D*_2- ', -415, 14,-1,2.4590,0.000D+00,2.0, + & 'DBAR0 ', -421, 24, 0,1.8646,4.140D-13,0.0, + & 'D*BAR0 ', -423, 24, 0,2.0067,0.000D+00,1.0/ + DATA (RNAME(I),IDPDG(I),IFLAV(I),ICHRG(I),RMASS(I),RLTIM(I), + & RSPIN(I),I=177,192)/ + & 'DH_1BAR0', -20423, 24, 0,2.4222,0.000D+00,1.0, + & 'D*_2BAR0', -425, 24, 0,2.4589,0.000D+00,2.0, + & 'D_S- ', -431, 34,-1,1.9685,4.670D-13,0.0, + & 'D*_S- ', -433, 34,-1,2.1124,0.000D+00,1.0, + & 'DH_S1- ', -20433, 34,-1,2.5354,0.000D+00,1.0, + & 'D*_S2- ', -435, 34,-1,2.5735,0.000D+00,2.0, + & 'SGMA_C--', -4222,-224,-2,2.4528,0.000D+00,0.5, + & 'SGM*_C--', -4224,-224,-2,2.5194,0.000D+00,1.5, + & 'LMBDA_C-', -4122,-124,-1,2.2849,2.060D-13,0.5, + & 'SIGMA_C-', -4212,-124,-1,2.4536,0.000D+00,0.5, + & 'SGMA*_C-', -4214,-124,-1,2.5185,0.000D+00,1.5, + & 'SGM_CBR0', -4112,-114, 0,2.4522,0.000D+00,0.5, + & 'SG*_CBR0', -4114,-114, 0,2.5175,0.000D+00,1.5, + & 'XI_C- ', -4232,-234,-1,2.4656,3.500D-13,0.5, + & 'XIP_C- ', -4322,-234,-1,2.5750,0.000D+00,0.5, + & 'XI*_C- ', -4324,-234,-1,2.6446,0.000D+00,1.5/ + DATA (RNAME(I),IDPDG(I),IFLAV(I),ICHRG(I),RMASS(I),RLTIM(I), + & RSPIN(I),I=193,208)/ + & 'XI_CBAR0', -4132,-134, 0,2.4703,9.800D-14,0.5, + & 'XIP_CBR0', -4312,-134, 0,2.5800,0.000D+00,0.5, + & 'XI*_CBR0', -4314,-134, 0,2.6438,0.000D+00,1.5, + & 'OMG_CBR0', -4332,-334, 0,2.7040,6.400D-14,0.5, + & 'OM*_CBR0', -4334,-334, 0,2.7300,0.000D+00,1.5, + & 'W+ ', 24, 0,+1,80.360,0.000D+00,1.0, + & 'W- ', -24, 0,-1,80.360,0.000D+00,1.0, + & 'Z0/GAMA*', 23, 0, 0,91.187,0.000D+00,1.0, + & 'HIGGS ', 25, 0, 0,150.00,0.000D+00,0.0, + & 'Z0P ', 32, 0, 0,500.00,0.000D+00,1.0, + & 'HIGGSL0 ', 26, 0, 0,0.0000,1.000D+30,0.0, + & 'HIGGSH0 ', 35, 0, 0,0.0000,1.000D+30,0.0, + & 'HIGGSA0 ', 36, 0, 0,0.0000,1.000D+30,0.0, + & 'HIGGS+ ', 37, 0,+1,0.0000,1.000D+30,0.0, + & 'HIGGS- ', -37, 0,-1,0.0000,1.000D+30,0.0, + & ' ', 0, 0, 0,0.0 ,0.0D+00 ,0.0/ + DATA (RNAME(I),IDPDG(I),IFLAV(I),ICHRG(I),RMASS(I),RLTIM(I), + & RSPIN(I),I=209,224)/ + & 'VQRK ', 7, 0,-1,200.00,0.000D+00,0.5, + & 'AQRK ', 8, 0,+2,400.00,0.000D+00,0.5, + & 'HQRK ', 7, 0,-1,400.00,0.000D+00,0.5, + & 'HPQK ', 8, 0,+2,600.00,0.000D+00,0.5, + & ' ', 0, 0, 0,0.0000,0.000D+00,0.0, + & ' ', 0, 0, 0,0.0000,0.000D+00,0.0, + & 'VBAR ', -7, 0,+1,200.00,0.000D+00,0.5, + & 'ABAR ', -8, 0,-2,400.00,0.000D+00,0.5, + & 'HBAR ', -7, 0,+1,400.00,0.000D+00,0.5, + & 'HPBR ', -8, 0,-2,600.00,0.000D+00,0.5, + & ' ', 0, 0, 0,0.0000,0.000D+00,0.0, + & ' ', 0, 0, 0,0.0000,0.000D+00,0.0, + & 'B_DBAR0 ', -511, 51, 0,5.2792,1.614D-12,0.0, + & 'B- ', -521, 52,-1,5.2789,1.652D-12,0.0, + & 'B_SBAR0 ', -531, 53, 0,5.3693,1.540D-12,0.0, + & 'SIGMA_B+', 5222, 225,+1,5.8200,1.070D-12,0.5/ + DATA (RNAME(I),IDPDG(I),IFLAV(I),ICHRG(I),RMASS(I),RLTIM(I), + & RSPIN(I),I=225,240)/ + & 'LMBDA_B0', 5122, 125, 0,5.6240,1.070D-12,0.5, + & 'SIGMA_B-', 5112, 115,-1,5.8200,1.070D-12,0.5, + & 'XI_B0 ', 5232, 235, 0,5.8000,1.070D-12,0.5, + & 'XI_B- ', 5132, 135,-1,5.8000,1.070D-12,0.5, + & 'OMEGA_B-', 5332, 335,-1,6.0400,1.070D-12,0.5, + & 'B_C- ', -541, 54,-1,6.2500,1.000D-12,0.5, + & 'UPSLON1S', 553, 55, 0,9.4604,0.000D+00,1.0, + & 'T_B- ', -651, 56,-1,0.0000,0.000D+00,0.0, + & 'T+ ', 611, 61,+1,0.0000,0.000D+00,0.0, + & 'T0 ', 621, 62, 0,0.0000,0.000D+00,0.0, + & 'T_S+ ', 631, 63,+1,0.0000,0.000D+00,0.0, + & 'SGMA_T++', 6222, 226,+2,0.0000,0.000D+00,0.5, + & 'LMBDA_T0', 6122, 126,+1,0.0000,0.000D+00,0.5, + & 'SIGMA_T0', 6112, 116, 0,0.0000,0.000D+00,0.5, + & 'XI_T+ ', 6232, 236,+1,0.0000,0.000D+00,0.5, + & 'XI_T0 ', 6132, 136, 0,0.0000,0.000D+00,0.5/ + DATA (RNAME(I),IDPDG(I),IFLAV(I),ICHRG(I),RMASS(I),RLTIM(I), + & RSPIN(I),I=241,256)/ + & 'OMEGA_T0', 6332, 336, 0,0.0000,0.000D+00,0.5, + & 'T_C0 ', 641, 64, 0,0.0000,0.000D+00,0.0, + & 'T_B+ ', 651, 65,+1,0.0000,0.000D+00,0.0, + & 'TOPONIUM', 663, 66, 0,0.0000,0.000D+00,1.0, + & 'B_D0 ', 511, 15, 0,5.2792,1.614D-12,0.0, + & 'B+ ', 521, 25,+1,5.2789,1.652D-12,0.0, + & 'B_S0 ', 531, 35, 0,5.3693,1.540D-12,0.0, + & 'SGM_BBR-', -5222,-225,-1,5.8200,1.070D-12,0.5, + & 'LMD_BBR0', -5122,-125, 0,5.6240,1.070D-12,0.5, + & 'SGM_BBR+', -5112,-115,+1,5.8200,1.070D-12,0.5, + & 'XI_BBAR0', -5232,-235, 0,5.8000,1.070D-12,0.5, + & 'XI_B+ ', -5132,-135,+1,5.8000,1.070D-12,0.5, + & 'OMG_BBR+', -5332,-335,+1,6.0400,1.070D-12,0.5, + & 'B_C+ ', 541, 45,+1,6.2500,1.000D-12,0.5, + & 'T- ', -611, 16,-1,0.0000,0.000D+00,0.0, + & 'TBAR0 ', -621, 26, 0,0.0000,0.000D+00,0.0/ + DATA (RNAME(I),IDPDG(I),IFLAV(I),ICHRG(I),RMASS(I),RLTIM(I), + & RSPIN(I),I=257,272)/ + & 'T_S- ', -631, 36,-1,0.0000,0.000D+00,0.0, + & 'SGMA_T--', -6222,-226,-2,0.0000,0.000D+00,0.5, + & 'LAMDA_T-', -6122,-126,-1,0.0000,0.000D+00,0.5, + & 'SGM_TBR0', -6112,-116, 0,0.0000,0.000D+00,0.5, + & 'XI_T- ', -6232,-236,-1,0.0000,0.000D+00,0.5, + & 'XI_TBAR0', -6132,-136, 0,0.0000,0.000D+00,0.5, + & 'OMG_TBR0', -6332,-336, 0,0.0000,0.000D+00,0.5, + & 'T_CBAR0 ', -641, 46, 0,0.0000,0.000D+00,0.0, + & 'B*BAR0 ', -513, 51, 0,5.3249,0.000D+00,1.0, + & 'B*- ', -523, 52,-1,5.3249,0.000D+00,1.0, + & 'B*_SBAR0', -533, 53, 0,5.4163,0.000D+00,1.0, + & 'BH_1BAR0', -20513, 51, 0,5.7600,0.000D+00,1.0, + & 'BH_1- ', -20523, 52,-1,5.7600,0.000D+00,1.0, + & 'BH_S1BR0', -20533, 53, 0,5.8550,0.000D+00,1.0, + & 'B*_2BAR0', -515, 51, 0,5.7700,0.000D+00,2.0, + & 'B*_2- ', -525, 52,-1,5.7700,0.000D+00,2.0/ + DATA (RNAME(I),IDPDG(I),IFLAV(I),ICHRG(I),RMASS(I),RLTIM(I), + & RSPIN(I),I=273,288)/ + & 'B*_S2BR0', -535, 53, 0,5.8650,0.000D+00,2.0, + & 'B*0 ', 513, 15, 0,5.3249,0.000D+00,1.0, + & 'B*+ ', 523, 25,+1,5.3249,0.000D+00,1.0, + & 'B*_S0 ', 533, 35, 0,5.4163,0.000D+00,1.0, + & 'BH_10 ', 20513, 15, 0,5.7600,0.000D+00,1.0, + & 'BH_1+ ', 20523, 25,+1,5.7600,0.000D+00,1.0, + & 'BH_S10 ', 20533, 35, 0,5.8550,0.000D+00,1.0, + & 'B*_20 ', 515, 15, 0,5.7700,0.000D+00,2.0, + & 'B*_2+ ', 525, 25,+1,5.7700,0.000D+00,2.0, + & 'B*_S20 ', 535, 35, 0,5.8650,0.000D+00,2.0, + & ' ', 0, 0, 0,0.0000,0.000D+00, 0, + & ' ', 0, 0, 0,0.0000,0.000D+00, 0, + & 'B_10 ', 10113, 11, 0,1.2295,0.000D+00,1.0, + & 'B_1+ ', 10213, 21,+1,1.2295,0.000D+00,1.0, + & 'B_1- ', -10213, 12,-1,1.2295,0.000D+00,1.0, + & 'HL_10 ', 10223, 33, 0,1.1700,0.000D+00,1.0/ + DATA (RNAME(I),IDPDG(I),IFLAV(I),ICHRG(I),RMASS(I),RLTIM(I), + & RSPIN(I),I=289,304)/ + & 'HH_10 ', 10333, 33, 0,1.3950,0.000D+00,1.0, + & 'A_00 ', 9000111, 11, 0,.99600,0.000D+00,0.0, + & 'A_0+ ', 9000211, 21,+1,.99600,0.000D+00,0.0, + & 'A_0- ',-9000211, 12,-1,.99600,0.000D+00,0.0, + & 'F0P0 ', 9010221, 33, 0,.99600,0.000D+00,0.0, + & 'FH_00 ', 10221, 33, 0,1.3500,0.000D+00,0.0, + & 'B*_C+ ', 543, 45,+1,6.2950,0.000D+00,1.0, + & 'B*_C- ', -543, 54,-1,6.2950,0.000D+00,1.0, + & 'BH_C1+ ', 20543, 45,+1,6.7300,0.000D+00,1.0, + & 'BH_C1- ', -20543, 54,-1,6.7300,0.000D+00,1.0, + & 'B*_C2+ ', 545, 45,+1,6.7400,0.000D+00,2.0, + & 'B*_C2- ', -545, 54,-1,6.7400,0.000D+00,2.0, + & 'H_C ', 10443, 44, 0,3.5261,0.000D+00,1.0, + & 'CHI_C0 ', 20443, 44, 0,3.5105,0.000D+00,0.0, + & 'CHI_C2 ', 445, 44, 0,3.5562,0.000D+00,2.0, + & 'ETA_B ', 551, 55, 0,9.0000,0.000D+00,0.0/ + DATA (RNAME(I),IDPDG(I),IFLAV(I),ICHRG(I),RMASS(I),RLTIM(I), + & RSPIN(I),I=305,320)/ + & 'H_B ', 10553, 55, 0,9.8880,0.000D+00,1.0, + & 'CHI_B0 ', 10551, 55, 0,9.8598,0.000D+00,0.0, + & 'CHI_B1 ', 20553, 55, 0,9.8919,0.000D+00,1.0, + & 'CHI_B2 ', 555, 55, 0,9.9132,0.000D+00,2.0, + & 'KL_10 ', 10313, 13, 0,1.5700,0.000D+00,1.0, + & 'KL_1+ ', 10323, 23,+1,1.5700,0.000D+00,1.0, + & 'KL_1BAR0', -10313, 31, 0,1.5700,0.000D+00,1.0, + & 'KL_1- ', -10323, 32,-1,1.5700,0.000D+00,1.0, + & 'DL_1+ ', 10413, 41,+1,2.4270,0.000D+00,1.0, + & 'DL_10 ', 10423, 42, 0,2.4222,0.000D+00,1.0, + & 'DL_S1+ ', 10433, 43,+1,2.5354,0.000D+00,1.0, + & 'DL_1- ', -10413, 14,-1,2.4270,0.000D+00,1.0, + & 'DL_1BAR0', -10423, 24, 0,2.4222,0.000D+00,1.0, + & 'DL_S1- ', -10433, 34,-1,2.5354,0.000D+00,1.0, + & 'BL_10 ', 10513, 15, 0,5.7600,0.000D+00,1.0, + & 'BL_1+ ', 10523, 25,+1,5.7600,0.000D+00,1.0/ + DATA (RNAME(I),IDPDG(I),IFLAV(I),ICHRG(I),RMASS(I),RLTIM(I), + & RSPIN(I),I=321,336)/ + & 'BL_S10 ', 10533, 35, 0,5.8530,0.000D+00,1.0, + & 'BL_C1+ ', 10543, 45,+1,6.7300,0.000D+00,1.0, + & 'BL_1BAR0', -10513, 51, 0,5.7600,0.000D+00,1.0, + & 'BL_1- ', -10523, 52,-1,5.7600,0.000D+00,1.0, + & 'BL_S1BR0', -10533, 53, 0,5.8530,0.000D+00,1.0, + & 'BL_C1- ', -10543, 54,-1,6.7300,0.000D+00,1.0, + & 'K*_0+ ', 10321, 23,+1,1.4290,0.000D+00,0.0, + & 'K*_00 ', 10311, 13, 0,1.4290,0.000D+00,0.0, + & 'K*_0BAR0', -10311, 31, 0,1.4290,0.000D+00,0.0, + & 'K*_0- ', -10321, 32,-1,1.4290,0.000D+00,0.0, + & 'D*_0+ ', 10411, 41,+1,2.4230,0.000D+00,0.0, + & 'D*_00 ', 10421, 42, 0,2.4230,0.000D+00,0.0, + & 'D*_S0+ ', 10431, 43,+1,2.5250,0.000D+00,0.0, + & 'D*_0- ', -10411, 14,-1,2.4230,0.000D+00,0.0, + & 'D*_0BAR0', -10421, 24, 0,2.4230,0.000D+00,0.0, + & 'D*_S0- ', -10431, 34,-1,2.5250,0.000D+00,0.0/ + DATA (RNAME(I),IDPDG(I),IFLAV(I),ICHRG(I),RMASS(I),RLTIM(I), + & RSPIN(I),I=337,352)/ + & 'B*_00 ', 10511, 15, 0,5.7600,0.000D+00,0.0, + & 'B*_0+ ', 10521, 25,+1,5.7600,0.000D+00,0.0, + & 'B*_S00 ', 10531, 35, 0,5.8550,0.000D+00,0.0, + & 'B*_C0+ ', 10541, 45,+1,6.7300,0.000D+00,0.0, + & 'B*_0BAR0', -10511, 51, 0,5.7600,0.000D+00,0.0, + & 'B*_0- ', -10521, 52,-1,5.7600,0.000D+00,0.0, + & 'B*_S0BR0', -10531, 53, 0,5.8550,0.000D+00,0.0, + & 'B*_C0- ', -10541, 54,-1,6.7300,0.000D+00,0.0, + & 'SGMA*_B-', 5114, 115,-1,5.8400,0.000D+00,1.5, + & 'SIGMA_B0', 5212, 125, 0,5.8200,0.000D+00,0.5, + & 'SGMA*_B0', 5214, 125, 0,5.8400,0.000D+00,1.5, + & 'SGMA*_B+', 5224, 225,+1,5.8400,0.000D+00,1.5, + & 'XIP_B0 ', 5322, 235, 0,5.9450,0.000D+00,0.5, + & 'XI*_B0 ', 5324, 235, 0,5.9450,0.000D+00,1.5, + & 'XIP_B- ', 5312, 135,-1,5.9450,0.000D+00,0.5, + & 'XI*_B- ', 5314, 135,-1,5.9450,0.000D+00,1.5/ + DATA (RNAME(I),IDPDG(I),IFLAV(I),ICHRG(I),RMASS(I),RLTIM(I), + & RSPIN(I),I=353,368)/ + & '0MGA*_B-', 5334, 335,-1,6.0600,0.000D+00,1.5, + & 'SG*_BBR+', -5114,-115,+1,5.8400,0.000D+00,1.5, + & 'SGM_BBR0', -5212,-125, 0,5.8200,0.000D+00,0.5, + & 'SG*_BBR0', -5214,-125, 0,5.8400,0.000D+00,1.5, + & 'SG*_BBR-', -5224,-225,-1,5.8400,0.000D+00,1.5, + & 'XIP_BBR0', -5322,-235, 0,5.9450,0.000D+00,0.5, + & 'XI*_BBR0', -5324,-235, 0,5.9450,0.000D+00,1.5, + & 'XIP_B+ ', -5312,-135,+1,5.9450,0.000D+00,0.5, + & 'XI*_B+ ', -5314,-135,+1,5.9450,0.000D+00,1.5, + & '0MGA*_B+', -5334,-335,+1,6.0600,0.000D+00,1.5, + & 'KDL_2+ ', 10325, 23,+1,1.7730,0.000D+00,2.0, + & 'KDL_20 ', 10315, 13, 0,1.7730,0.000D+00,2.0, + & 'KDL_2BR0', -10315, 31, 0,1.7730,0.000D+00,2.0, + & 'KDL_2- ', -10325, 32,-1,1.7730,0.000D+00,2.0, + & 'KD*+ ', 30323, 23,+1,1.717,0.000D+00,1.0, + & 'KD*0 ', 30313, 13, 0,1.717,0.000D+00,1.0/ + DATA (RNAME(I),IDPDG(I),IFLAV(I),ICHRG(I),RMASS(I),RLTIM(I), + & RSPIN(I),I=369,384)/ + & 'KD*BAR0 ', -30313, 31, 0,1.717,0.000D+00,1.0, + & 'KD*- ', -30323, 32,-1,1.717,0.000D+00,1.0, + & 'KDH_2+ ', 20325, 23,+1,1.8160,0.000D+00,2.0, + & 'KDH_20 ', 20315, 13, 0,1.8160,0.000D+00,2.0, + & 'KDH_2BR0', -20315, 31, 0,1.8160,0.000D+00,2.0, + & 'KDH_2- ', -20325, 32,-1,1.8160,0.000D+00,2.0, + & 'KD_3+ ', 327, 23,+1,1.7730,0.000D+00,3.0, + & 'KD_30 ', 317, 13, 0,1.7730,0.000D+00,3.0, + & 'KD_3BAR0', -317, 31, 0,1.7730,0.000D+00,3.0, + & 'KD_3- ', -327, 32,-1,1.7730,0.000D+00,3.0, + & 'PI_2+ ', 10215, 21,+1,1.6700,0.000D+00,2.0, + & 'PI_20 ', 10115, 11, 0,1.6700,0.000D+00,2.0, + & 'PI_2- ', -10215, 12,-1,1.6700,0.000D+00,2.0, + & 'RHOD+ ', 30213, 21,+1,1.7000,0.000D+00,1.0, + & 'RHOD0 ', 30113, 11, 0,1.7000,0.000D+00,1.0, + & 'RHOD- ', -30213, 12,-1,1.7000,0.000D+00,1.0/ + DATA (RNAME(I),IDPDG(I),IFLAV(I),ICHRG(I),RMASS(I),RLTIM(I), + & RSPIN(I),I=385,400)/ + & 'RHO_3+ ', 217, 21,+1,1.6910,0.000D+00,3.0, + & 'RHO_30 ', 117, 11, 0,1.6910,0.000D+00,3.0, + & 'RHO_3- ', -217, 12,-1,1.6910,0.000D+00,3.0, + & 'UPSLON2S', 100553, 55, 0,10.023,0.000D+00,1.0, + & 'CHI2P_B0', 110551, 55, 0,10.232,0.000D+00,0.0, + & 'CHI2P_B1', 120553, 55, 0,10.255,0.000D+00,1.0, + & 'CHI2P_B2', 100555, 55, 0,10.269,0.000D+00,2.0, + & 'UPSLON3S', 200553, 55, 0,10.355,0.000D+00,1.0, + & 'UPSLON4S', 300553, 55, 0,10.580,0.000D+00,1.0, + & ' ', 0, 0, 0,0.0 , 0.0D+00, 0, + & 'OMEGA_3 ', 227, 33, 0,1.6670,0.000D+00,3.0, + & 'PHI_3 ', 337, 33, 0,1.8540,0.000D+00,3.0, + & 'ETA_2(L)', 10225, 33, 0,1.6320,0.000D+00,2.0, + & 'ETA_2(H)', 10335, 33, 0,1.8540,0.000D+00,2.0, + & 'OMEGA(H)', 30223, 33, 0,1.6490,0.000D+00,1.0, + & ' ', 0, 0, 0,0.0 ,0.0D+00 , 0/ + DATA (RNAME(I),IDPDG(I),IFLAV(I),ICHRG(I),RMASS(I),RLTIM(I), + & RSPIN(I),I=401,416)/ + & 'SSDL ', 1000001, 0,-1,0.00D0,1.000D+30,0.0, + & 'SSUL ', 1000002, 0,+2,0.00D0,1.000D+30,0.0, + & 'SSSL ', 1000003, 0,-1,0.00D0,1.000D+30,0.0, + & 'SSCL ', 1000004, 0,+2,0.00D0,1.000D+30,0.0, + & 'SSB1 ', 1000005, 0,-1,0.00D0,1.000D+30,0.0, + & 'SST1 ', 1000006, 0,+2,0.00D0,1.000D+30,0.0, + & 'SSDLBR ',-1000001, 0,+1,0.00D0,1.000D+30,0.0, + & 'SSULBR ',-1000002, 0,-2,0.00D0,1.000D+30,0.0, + & 'SSSLBR ',-1000003, 0,+1,0.00D0,1.000D+30,0.0, + & 'SSCLBR ',-1000004, 0,-2,0.00D0,1.000D+30,0.0, + & 'SSB1BR ',-1000005, 0,+1,0.00D0,1.000D+30,0.0, + & 'SST1BR ',-1000006, 0,-2,0.00D0,1.000D+30,0.0, + & 'SSDR ', 2000001, 0,-1,0.00D0,1.000D+30,0.0, + & 'SSUR ', 2000002, 0,+2,0.00D0,1.000D+30,0.0, + & 'SSSR ', 2000003, 0,-1,0.00D0,1.000D+30,0.0, + & 'SSCR ', 2000004, 0,+2,0.00D0,1.000D+30,0.0/ + DATA (RNAME(I),IDPDG(I),IFLAV(I),ICHRG(I),RMASS(I),RLTIM(I), + & RSPIN(I),I=417,432)/ + & 'SSB2 ', 2000005, 0,-1,0.00D0,1.000D+30,0.0, + & 'SST2 ', 2000006, 0,+2,0.00D0,1.000D+30,0.0, + & 'SSDRBR ',-2000001, 0,+1,0.00D0,1.000D+30,0.0, + & 'SSURBR ',-2000002, 0,-2,0.00D0,1.000D+30,0.0, + & 'SSSRBR ',-2000003, 0,+1,0.00D0,1.000D+30,0.0, + & 'SSCRBR ',-2000004, 0,-2,0.00D0,1.000D+30,0.0, + & 'SSB2BR ',-2000005, 0,+1,0.00D0,1.000D+30,0.0, + & 'SST2BR ',-2000006, 0,-2,0.00D0,1.000D+30,0.0, + & 'SSEL- ', 1000011, 0,-1,0.00D0,1.000D+30,0.0, + & 'SSNUEL ', 1000012, 0, 0,0.00D0,1.000D+30,0.0, + & 'SSMUL- ', 1000013, 0,-1,0.00D0,1.000D+30,0.0, + & 'SSNUMUL ', 1000014, 0, 0,0.00D0,1.000D+30,0.0, + & 'SSTAU1- ', 1000015, 0,-1,0.00D0,1.000D+30,0.0, + & 'SSNUTL ', 1000016, 0, 0,0.00D0,1.000D+30,0.0, + & 'SSEL+ ',-1000011, 0,+1,0.00D0,1.000D+30,0.0, + & 'SSNUELBR',-1000012, 0, 0,0.00D0,1.000D+30,0.0/ + DATA (RNAME(I),IDPDG(I),IFLAV(I),ICHRG(I),RMASS(I),RLTIM(I), + & RSPIN(I),I=433,448)/ + & 'SSMUL+ ',-1000013, 0,+1,0.00D0,1.000D+30,0.0, + & 'SSNUMLBR',-1000014, 0, 0,0.00D0,1.000D+30,0.0, + & 'SSTAU1+ ',-1000015, 0,+1,0.00D0,1.000D+30,0.0, + & 'SSNUTLBR',-1000016, 0, 0,0.00D0,1.000D+30,0.0, + & 'SSER- ', 2000011, 0,-1,0.00D0,1.000D+30,0.0, + & 'SSNUER ', 2000012, 0, 0,0.00D0,1.000D+30,0.0, + & 'SSMUR- ', 2000013, 0,-1,0.00D0,1.000D+30,0.0, + & 'SSNUMUR ', 2000014, 0, 0,0.00D0,1.000D+30,0.0, + & 'SSTAU2- ', 2000015, 0,-1,0.00D0,1.000D+30,0.0, + & 'SSNUTR ', 2000016, 0, 0,0.00D0,1.000D+30,0.0, + & 'SSER+ ',-2000011, 0,+1,0.00D0,1.000D+30,0.0, + & 'SSNUERBR',-2000012, 0, 0,0.00D0,1.000D+30,0.0, + & 'SSMUR+ ',-2000013, 0,+1,0.00D0,1.000D+30,0.0, + & 'SSNUMRBR',-2000014, 0, 0,0.00D0,1.000D+30,0.0, + & 'SSTAU2+ ',-2000015, 0,+1,0.00D0,1.000D+30,0.0, + & 'SSNUTRBR',-2000016, 0, 0,0.00D0,1.000D+30,0.0/ + DATA (RNAME(I),IDPDG(I),IFLAV(I),ICHRG(I),RMASS(I),RLTIM(I), + & RSPIN(I),I=449,NLAST)/ + & 'GLUINO ', 1000021, 0, 0,0.00D0,1.000D+30,0.5, + & 'NTLINO1 ', 1000022, 0, 0,0.00D0,1.000D+30,0.5, + & 'NTLINO2 ', 1000023, 0, 0,0.00D0,1.000D+30,0.5, + & 'NTLINO3 ', 1000025, 0, 0,0.00D0,1.000D+30,0.5, + & 'NTLINO4 ', 1000035, 0, 0,0.00D0,1.000D+30,0.5, + & 'CHGINO1+', 1000024, 0,+1,0.00D0,1.000D+30,0.5, + & 'CHGINO2+', 1000037, 0,+1,0.00D0,1.000D+30,0.5, + & 'CHGINO1-',-1000024, 0,-1,0.00D0,1.000D+30,0.5, + & 'CHGINO2-',-1000037, 0,-1,0.00D0,1.000D+30,0.5, + & 'GRAVTINO', 1000039, 0, 0,0.00D0,1.000D+30,1.5/ +C + DATA QORQQB/.FALSE., + & 6*.TRUE.,6*.FALSE.,96*.FALSE.,6*.FALSE.,6*.TRUE.,NREST*.FALSE./ + DATA QBORQQ/.FALSE., + & 6*.FALSE.,6*.TRUE.,96*.FALSE.,6*.TRUE.,6*.FALSE.,NREST*.FALSE./ +C +C In the character strings use an ampersand to represent a backslash +C to avoid compiler problems with the C escape character i.e. & = \ + DATA ((TXNAME(J,I),J=1,2),I=0,8)/ + & ' ', + & ' ', + & ' d', + & ' d', + & ' u', + & ' u', + & ' s', + & ' s', + & ' c', + & ' c', + & ' b', + & ' b', + & ' t', + & ' t', + & ' $&bar{&rm d}$', + & ' -d', + & ' $&bar{&rm u}$', + & ' -u'/ + DATA ((TXNAME(J,I),J=1,2),I=9,16)/ + & ' $&bar{&rm s}$', + & ' -s', + & ' $&bar{&rm c}$', + & ' -c', + & ' $&bar{&rm b}$', + & ' -b', + & ' $&bar{&rm t}$', + & ' -t', + & ' $g$', + & ' g', + & ' CoM', + & ' CoM', + & ' Hard', + & ' Hard', + & ' Soft', + & ' Soft'/ + DATA ((TXNAME(J,I),J=1,2),I=17,24)/ + & ' Cone', + & ' Cone', + & ' Heavy', + & ' Heavy', + & ' Cluster', + & ' Cluster', + & ' $&star&star&star&star$', + & ' ****', + & ' $&pi^0$', + & ' pi0', + & ' $&eta$', + & ' eta', + & ' $&rho^0$', + & ' rho0', + & ' $&omega$', + & ' omega'/ + DATA ((TXNAME(J,I),J=1,2),I=25,32)/ + & ' $&eta^&prime$', + & ' eta''', + & ' $f_2$', + & ' f2', + & ' $a^0_1$', + & ' a10', + & ' $f_1(L)$', + & ' f1(L)', + & ' $a^0_2$', + & ' a20', + & ' $&pi^-$', + & ' pi-', + & ' $&rho^-$', + & ' rho-', + & ' $a^-_1$', + & ' a1-'/ + DATA ((TXNAME(J,I),J=1,2),I=33,40)/ + & ' $a^-_2$', + & ' a2-', + & ' K$^-$', + & ' K-', + & ' K$^{&star-}$', + & ' K*-', + & ' K$_1(H)^-$', + & ' K1(H)-', + & ' K$^{&star-}_2$', + & ' K2*-', + & ' $&pi^+$', + & ' pi+', + & ' $&rho^+$', + & ' rho+', + & ' $a^+_1$', + & ' a1+'/ + DATA ((TXNAME(J,I),J=1,2),I=41,48)/ + & ' $a^+_2$', + & ' a2+', + & ' $&overline{&rm K}^0$', + & ' -K0', + & ' $&overline{&rm K}^{&star0}$', + & ' -K*0', + & ' $&overline{&rm K}_1(H)^0$', + & ' -K1(H)0', + & ' $&overline{&rm K}^{&star0}_2$', + & ' -K2*0', + & ' K$^+$', + & ' K+', + & ' K$^{&star+}$', + & ' K*+', + & ' K$_1(H)^+$', + & ' K1(H)+'/ + DATA ((TXNAME(J,I),J=1,2),I=49,56)/ + & ' K$^{&star+}_2$', + & ' K2(H)*+', + & ' K$^0$', + & ' K0', + & ' K$^{&star0}$', + & ' K*-', + & ' K$_1(H)^0$', + & ' K1(H)0', + & ' K$^{&star0}_2$', + & ' K2*0', + & ' ', + & ' ', + & ' ', + & ' ', + & ' $&phi$', + & ' phi'/ + DATA ((TXNAME(J,I),J=1,2),I=57,64)/ + & ' $f_1(1420)$', + & ' f1(1420)', + & ' $f^&prime_2$', + & ' f''2', + & ' $&gamma$', + & ' gamma', + & ' K$^0_{&rm S}$', + & ' KS0', + & ' K$^0_{&rm L}$', + & ' KL0', + & ' $a_0(1450)^0$', + & ' a0(1450)0', + & ' $a_0(1450)^+$', + & ' a0(1450)+', + & ' $a_0(1450)^-$', + & ' a0(1450)-'/ + DATA ((TXNAME(J,I),J=1,2),I=65,72)/ + & ' ', + & ' ', + & ' ', + & ' ', + & ' ', + & ' ', + & ' ', + & ' ', + & ' ', + & ' ', + & ' ', + & ' ', + & ' $&gamma$-remnant', + & ' gamma-remnant', + & ' $N$-remnant', + & ' N-remnant'/ + DATA ((TXNAME(J,I),J=1,2),I=73,80)/ + & ' p', + & ' p', + & ' $&Delta^+$', + & ' Delta+', + & ' n', + & ' n', + & ' $&Delta^0$', + & ' Delta0', + & ' $&Delta^-$', + & ' Delta-', + & ' $&Lambda$', + & ' Lambda', + & ' $&Sigma^0$', + & ' Sigma0', + & ' $&Sigma^{&star0}$', + & ' Sigma*0'/ + DATA ((TXNAME(J,I),J=1,2),I=81,88)/ + & ' $&Sigma^-$', + & ' Sigma-', + & ' $&Sigma^{&star-}$', + & ' Sigma*-', + & ' $&Xi^-$', + & ' Xi-', + & ' $&Xi^{&star-}$', + & ' Xi*-', + & ' $&Delta^{++}$', + & ' Delta++', + & ' $&Sigma^+$', + & ' Sigma+', + & ' $&Sigma^{&star+}$', + & ' Sigma*+', + & ' $&Xi^0$', + & ' Xi0'/ + DATA ((TXNAME(J,I),J=1,2),I=89,96)/ + & ' $&Xi^{&star0}$', + & ' Xi*0', + & ' $&Omega^-$', + & ' Omega-', + & ' $&bar{&rm p}$', + & ' -p', + & ' $&overline{&Delta}^-$', + & ' -Delta-', + & ' $&bar{&rm n}$', + & ' -n', + & ' $&overline{&Delta}^0$', + & ' -Delta0', + & ' $&overline{&Delta}^+$', + & ' -Delta+', + & ' $&overline{&Lambda}$', + & ' -Lambda'/ + DATA ((TXNAME(J,I),J=1,2),I=97,104)/ + & ' $&overline{&Sigma}^0$', + & ' -Sigma0', + & ' $&overline{&Sigma}^{&star0}$', + & ' -Sigma*0', + & ' $&overline{&Sigma}^+$', + & ' -Sigma+', + & ' $&overline{&Sigma}^{&star+}$', + & ' -Sigma*+', + & ' $&overline{&Xi}^+$', + & ' -Xi+', + & ' $&overline{&Xi}^{&star+}$', + & ' -Xi*+', + & ' $&overline{&Delta}^{--}$', + & ' -Delta--', + & ' $&overline{&Sigma}^-$', + & ' -Sigma-'/ + DATA ((TXNAME(J,I),J=1,2),I=105,112)/ + & ' $&overline{&Sigma}^{&star-}$', + & ' -Sigma*-', + & ' $&overline{&Xi}^0$', + & ' -Xi0', + & ' $&overline&Xi^{&star0}$', + & ' -Xi*0', + & ' $&overline{&Omega}^+$', + & ' -Omega+', + & ' uu', + & ' uu', + & ' ud', + & ' ud', + & ' dd', + & ' dd', + & ' us', + & ' us'/ + DATA ((TXNAME(J,I),J=1,2),I=113,120)/ + & ' ds', + & ' ds', + & ' ss', + & ' ss', + & ' $&bar{&rm u}&bar{&rm u}$', + & ' -uu', + & ' $&bar{&rm u}&bar{&rm d}$', + & ' -ud', + & ' $&bar{&rm d}&bar{&rm d}$', + & ' -dd', + & ' $&bar{&rm u}&bar{&rm s}$', + & ' -us', + & ' $&bar{&rm d}&bar{&rm s}$', + & ' -ds', + & ' $&bar{&rm s}&bar{&rm s}$', + & ' -ss'/ + DATA ((TXNAME(J,I),J=1,2),I=121,128)/ + & ' e$^-$', + & ' e-', + & ' $&nu_{&rm e}$', + & ' nue', + & ' $&mu^-$', + & ' mu-', + & ' $&nu_&mu$', + & ' numu', + & ' $&tau^-$', + & ' tau-', + & ' $&nu_&tau$', + & ' nutau', + & ' e$^+$', + & ' e+', + & ' $&bar{&nu}_{&rm e}$', + & ' -nue'/ + DATA ((TXNAME(J,I),J=1,2),I=129,136)/ + & ' $&mu^+$', + & ' mu+', + & ' $&bar{&nu}_&mu$', + & ' -numu', + & ' $&tau^+$', + & ' tau+', + & ' $&bar{&nu}_&tau$', + & ' -nutau', + & ' ', + & ' ', + & ' ', + & ' ', + & ' ', + & ' ', + & ' D$^+$', + & ' D+'/ + DATA ((TXNAME(J,I),J=1,2),I=137,144)/ + & ' D$^{&star+}$', + & ' D*+', + & ' D$_1(H)^+$', + & ' D1(H)+', + & ' D$_2^{&star+}$', + & ' D2*+', + & ' D$^0$', + & ' D0', + & ' D$^{&star0}$', + & ' D*0', + & ' D$_1(H)^0$', + & ' D1(H)0', + & ' D$_2^{&star0}$', + & ' D2*0', + & ' D$_{&rm s}^+$', + & ' Ds+'/ + DATA ((TXNAME(J,I),J=1,2),I=145,152)/ + & ' D$_{&rm s}^{&star+}$', + & ' Ds*+', + & ' D$_{&rm s1}(H)^+$', + & ' Ds1(H)+', + & ' D$^{&star+}_{&rm s2}$', + & ' Ds1(H)*+', + & ' $&Sigma_{&rm c}^{++}$', + & ' Sigmac++', + & ' $&Sigma_{&rm c}^{&star++}$', + & ' Sigmac*++', + & ' $&Lambda_{&rm c}^+$', + & ' Lambdac+', + & ' $&Sigma_{&rm c}^+$', + & ' Sigmac+', + & ' $&Sigma_{&rm c}^{&star+}$', + & ' Sigmac*+'/ + DATA ((TXNAME(J,I),J=1,2),I=153,160)/ + & ' $&Sigma_{&rm c}^0$', + & ' Sigmac0', + & ' $&Sigma_{&rm c}^{&star0}$', + & ' Sigmac*0', + & ' $&Xi_{&rm c}^+$', + & ' Xic+', + & ' $&Xi_{&rm c}^{&prime+}$', + & ' Xic''+', + & ' $&Xi_{&rm c}^{&star+}$', + & ' Xic*+', + & ' $&Xi_{&rm c}^0$', + & ' Xic0', + & ' $&Xi_{&rm c}^{&prime0}$', + & ' Xic''0', + & ' $&Xi_{&rm c}^{&star0}$', + & ' Xic*0'/ + DATA ((TXNAME(J,I),J=1,2),I=161,168)/ + & ' $&Omega_{&rm c}^0$', + & ' Omegac0', + & ' $&Omega_{&rm c}^{&star0}$', + & ' Omegac*0', + & ' $&eta_{&rm c}(1S)$', + & ' etac(1S)', + & ' J/$&psi$', + & ' J/psi', + & ' $&chi_{&rm c0}(1P)$', + & ' chic0(1P)', + & ' $&psi(2S)$', + & ' psi(2S)', + & ' $&psi(1D)$', + & ' psi(1D)', + & ' ', + & ' '/ + DATA ((TXNAME(J,I),J=1,2),I=169,176)/ + & ' ', + & ' ', + & ' ', + & ' ', + & ' D$^-$', + & ' D-', + & ' D$^{&star-}$', + & ' D*-', + & ' D$_1(H)^-$', + & ' D1(H)-', + & ' D$_2^{&star-}$', + & ' D2*-', + & ' $&overline{&rm D}^0$', + & ' -D0', + & ' $&overline{&rm D}^{&star0}$', + & ' -D*0'/ + DATA ((TXNAME(J,I),J=1,2),I=177,184)/ + & ' $&overline{&rm D}_1(H)^0$', + & ' -D1(H)0', + & ' $&overline{&rm D}_2^{&star0}$', + & ' -D2*0', + & ' D$_{&rm s}^-$', + & ' Ds-', + & ' D$_{&rm s}^{&star-}$', + & ' Ds*-', + & ' D$_{&rm s1}(H)^-$', + & ' Ds1(H)-', + & ' D$_{&rm s2}^{&star-}$', + & ' Ds1(H)*-', + & ' $&overline{&Sigma}_{&rm c}^{--}$', + & ' -Sigmac--', + & '$&overline{&Sigma}_{&rm c}^{&star--}$', + & ' -Sigmac*--'/ + DATA ((TXNAME(J,I),J=1,2),I=185,192)/ + & ' $&overline{&Lambda}_{&rm c}^-$', + & ' -Lambdac-', + & ' $&overline{&Sigma}_{&rm c}^-$', + & ' -Sigmac-', + & ' $&overline{&Sigma}_{&rm c}^{&star-}$', + & ' -Sigmac*-', + & ' $&overline{&Sigma}_{&rm c}^0$', + & ' -Sigmac0', + & ' $&overline{&Sigma}_{&rm c}^{&star0}$', + & ' -Sigmac*0', + & ' $&overline{&Xi}_{&rm c}^-$', + & ' -Xic-', + & ' $&overline{&Xi}_{&rm c}^{&prime-}$', + & ' -Xic''-', + & ' $&overline{&Xi}_{&rm c}^{&star-}$', + & ' -Xic*-'/ + DATA ((TXNAME(J,I),J=1,2),I=193,200)/ + & ' $&overline{&Xi}_{&rm c}^0$', + & ' -Xic0', + & ' $&overline{&Xi}_{&rm c}^{&prime0}$', + & ' -Xic''0', + & ' $&overline{&Xi}_{&rm c}^{&star0}$', + & ' -Xic*0', + & ' $&overline{&Omega}_{&rm c}^0$', + & ' -Omegac0', + & ' $&overline{&Omega}_{&rm c}^{&star0}$', + & ' -Omegac*0', + & ' W$^+$', + & ' W+', + & ' W$^-$', + & ' W-', + & ' Z$^0/&gamma^&star$', + & ' Z0/gamma*'/ + DATA ((TXNAME(J,I),J=1,2),I=201,208)/ + & ' $H^0_{&rm SM}$', + & ' H0SM', + & ' Z$^{&prime0}$', + & ' Z''0', + & ' $h^0$', + & ' h0', + & ' $H^0$', + & ' H0', + & ' $A^0$', + & ' A0', + & ' $H^+$', + & ' H+', + & ' $H^-$', + & ' H-', + & ' ', + & ' '/ + DATA ((TXNAME(J,I),J=1,2),I=209,216)/ + & ' V-quark', + & ' V-quark', + & ' A-quark', + & ' A-quark', + & ' H-quark', + & ' H-quark', + & ' H$^&prime$-quark', + & ' H''-quark', + & ' ', + & ' ', + & ' ', + & ' ', + & ' $&overline{&rm V}$-quark', + & ' -V-quark', + & ' $&overline{&rm A}$-quark', + & ' -A-quark'/ + DATA ((TXNAME(J,I),J=1,2),I=217,224)/ + & ' $&overline{&rm H}$-quark', + & ' -H-quark', + & ' $&overline{&rm H}^&prime$-quark', + & ' -H''-quark', + & ' ', + & ' ', + & ' ', + & ' ', + & ' $&overline{&rm B}_{&rm d}^0$', + & ' -Bd0', + & ' B$^-$', + & ' B-', + & ' $&overline{&rm B}_{&rm s}^0$', + & ' -Bs0', + & ' $&Sigma_{&rm b}^+$', + & ' Sigmab+'/ + DATA ((TXNAME(J,I),J=1,2),I=225,232)/ + & ' $&Lambda_{&rm b}^0$', + & ' Lambdab0', + & ' $&Sigma_{&rm b}^-$', + & ' Sigmab-', + & ' $&Xi_{&rm b}^0$', + & ' Xib0', + & ' $&Xi_{&rm b}^-$', + & ' Xib-', + & ' $&Omega_{&rm b}^-$', + & ' Omegab-', + & ' B$_{&rm c}^-$', + & ' Bc-', + & ' $&Upsilon(1S)$', + & ' Upsilon(1S)', + & ' T$_{&rm b}^-$', + & ' Tb-'/ + DATA ((TXNAME(J,I),J=1,2),I=233,240)/ + & ' T$^+$', + & ' T+', + & ' T$^0$', + & ' T0', + & ' T$_{&rm s}^+$', + & ' Ts+', + & ' $&Sigma_{&rm t}^{++}$', + & ' Sigmat++', + & ' $&Lambda_{&rm t}^0$', + & ' Lambdat0', + & ' $&Sigma_{&rm t}^0$', + & ' Sigmat0', + & ' $&chi_{&rm t}^+$', + & ' Xit+', + & ' $&chi_{&rm t}^0$', + & ' Xit0'/ + DATA ((TXNAME(J,I),J=1,2),I=241,248)/ + & ' $&Omega_{&rm t}^0$', + & ' Omegat0', + & ' T$_{&rm c}^0$', + & ' Tc0', + & ' T$_{&rm b}^+$', + & ' Tb+', + & ' Toponium', + & ' Toponium', + & ' B$_{&rm d}^0$', + & ' Bd0', + & ' B$^+$', + & ' B+', + & ' B$_{&rm s}^0$', + & ' Bs0', + & ' $&overline{&Sigma}_{&rm b}^-$', + & ' -Sigmab-'/ + DATA ((TXNAME(J,I),J=1,2),I=249,256)/ + & ' $&overline{&Lambda}_{&rm b}^-$', + & ' -Lambdab-', + & ' $&overline{&Sigma}_{&rm b}^+$', + & ' -Sigmab+', + & ' $&overline{&Xi}_{&rm b}^0$', + & ' -Xib0', + & ' $&Xi_{&rm b}^+$', + & ' Xib+', + & ' $&overline{&Omega}_{&rm b}^+$', + & ' -Omegab+', + & ' B$_{&rm c}^+$', + & ' Bc+', + & ' T$^-$', + & ' T-', + & ' $&overline{&rm T}^0$', + & ' T0'/ + DATA ((TXNAME(J,I),J=1,2),I=257,264)/ + & ' T$_{&rm s}^-$', + & ' Ts-', + & ' $&overline{&Sigma}_{&rm t}^{--}$', + & ' Sigmat--', + & ' $&overline{&Lambda}_{&rm t}^-$', + & ' -Lambdat-', + & ' $&overline{&Sigma}_{&rm t}^0$', + & ' -Sigmat0', + & ' $&overline{&Xi}_{&rm t}^-$', + & ' -Xit-', + & ' $&overline{&Xi}_{&rm t}^0$', + & ' -Xit0', + & ' $&overline{&Omega}_{&rm t}^0$', + & ' -Omegat0', + & ' $&overline{&rm T}_{&rm c}^0$', + & ' Tc0'/ + DATA ((TXNAME(J,I),J=1,2),I=265,272)/ + & ' $&overline{&rm B}^{&star0}$', + & ' -B*0', + & ' B$^{&star-}$', + & ' B*-', + & ' $&overline{&rm B}_{&rm s}^{&star0}$', + & ' -Bs*0', + & ' $&overline{&rm B}_1(H)^0$', + & ' -B1(H)0', + & ' B$_1(H)^-$', + & ' B1(H)-', + & ' $&overline{&rm B}_{&rm s1}(H)^0$', + & ' -Bs1(H)0', + & ' $&overline{&rm B}_2^{&star0}$', + & ' -B2*0', + & ' B$_2^{&star-}$', + & ' B2*-'/ + DATA ((TXNAME(J,I),J=1,2),I=273,280)/ + & ' B$_{&rm s2}^{&star0}$', + & ' Bs2*0', + & ' B$^{&star0}$', + & ' B*0', + & ' B$^{&star+}$', + & ' B*+', + & ' B$_{&rm s}^{&star0}$', + & ' Bs*0', + & ' B$_1(H)^0$', + & ' B1(H)0', + & ' B$_1(H)^+$', + & ' B1(H)+', + & ' B$_{&rm s1}(H)^0$', + & ' Bs1(H)0', + & ' B$_2^{&star0}$', + & ' B2*0'/ + DATA ((TXNAME(J,I),J=1,2),I=281,288)/ + & ' B$_2^{&star+}$', + & ' B2*+', + & ' B$_{&rm s2}^{&star0}$', + & ' Bs2*0', + & ' ', + & ' ', + & ' ', + & ' ', + & ' b$_1^0$', + & ' b10', + & ' b$_1^+$', + & ' b1+', + & ' b$_1^-$', + & ' b1-', + & ' h$_1(L)^0$', + & ' h1(L)0'/ + DATA ((TXNAME(J,I),J=1,2),I=289,296)/ + & ' h$_1(H)^0$', + & ' h1(H)0', + & ' a$_0(980)^0$', + & ' a0(980)0', + & ' a$_0(980)^+$', + & ' a0(980)+', + & ' a$_0(980)^-$', + & ' a0(980)-', + & ' f$_0(980)$', + & ' f0(980)', + & ' f$_0(1370)$', + & ' f0(1370)', + & ' B$_{&rm c}^{&star+}$', + & ' Bc*+', + & ' B$_{&rm c}^{&star-}$', + & ' Bc*-'/ + DATA ((TXNAME(J,I),J=1,2),I=297,304)/ + & ' B$_{&rm c1}(H)^+$', + & ' Bc1(H)+', + & ' B$_{&rm c1}(H)^-$', + & ' Bc1(H)-', + & ' B$_{&rm c2}^{&star+}$', + & ' Bc2*+', + & ' B$_{&rm c2}^{&star-}$', + & ' Bc2*-', + & ' h$_{&rm c}(1P)$', + & ' hc(1P)', + & ' $&chi_{&rm c0}(1P)$', + & ' chic0(1P)', + & ' $&chi_{&rm c2}(1P)$', + & ' chic2(1P)', + & ' $&eta_{&rm b}(1S)$', + & ' etab(1S)'/ + DATA ((TXNAME(J,I),J=1,2),I=305,312)/ + & ' h$_{&rm b}(1P)$', + & ' hb(1P)', + & ' $&chi_{&rm b0}(1P)$', + & ' chib0(1P)', + & ' $&chi_{&rm b1}(1P)$', + & ' chib1(1P)', + & ' $&chi_{&rm b2}(1P)$', + & ' chib2(1P)', + & ' K$_1(L)^0$', + & ' K1(L)0', + & ' K$_1(L)^+$', + & ' K1(L)+', + & ' $&overline{&rm K}_1(L)^0$', + & ' -K1(L)0', + & ' K$_1(L)^-$', + & ' K1(L)-'/ + DATA ((TXNAME(J,I),J=1,2),I=313,320)/ + & ' D$_1(L)^+$', + & ' D1(L)+', + & ' D$_1(L)^0$', + & ' D1(L)0', + & ' D$_{&rm s1}(L)^+$', + & ' Ds1(L)+', + & ' D$_1(L)^-$', + & ' D1(L)-', + & ' $&overline{&rm D}_1(L)^0$', + & ' D1(L)0', + & ' D$_{&rm s1}(L)^-$', + & ' Ds1(L)-', + & ' B$_1(L)^0$', + & ' B1(L)0', + & ' B$_1(L)^+$', + & ' B1(L)+'/ + DATA ((TXNAME(J,I),J=1,2),I=321,328)/ + & ' B$_{&rm s1}(L)^0$', + & ' Bs1(L)0', + & ' B$_{&rm c1}(L)^+$', + & ' Bc1(L)+', + & ' $&overline{&rm B}_1(L)^0$', + & ' -B1(L)0', + & ' B$_1(L)^-$', + & ' B1(L)-', + & ' $&overline{&rm B}_{&rm s1}(L)^0$', + & ' -Bs1(L)0', + & ' B$_{&rm c1}(L)^-$', + & ' Bc1(L)-', + & ' K$_0^{&star+}$', + & ' K0*+', + & ' K$_0^{&star0}$', + & ' K0*0'/ + DATA ((TXNAME(J,I),J=1,2),I=329,336)/ + & ' $&overline{&rm K}_0^{&star0}$', + & ' -K0*0', + & ' K$_0^{&star-}$', + & ' K0*-', + & ' D$_0^{&star+}$', + & ' D0*+', + & ' D$_0^{&star0}$', + & ' D0*0', + & ' D$_{&rm s0}^{&star+}$', + & ' Ds0*+', + & ' D$_0^{&star-}$', + & ' D0*-', + & ' $&overline{&rm D}_0^{&star0}$', + & ' -D0*0', + & ' D$_{&rm s0}^{&star-}$', + & ' Ds0*-'/ + DATA ((TXNAME(J,I),J=1,2),I=337,344)/ + & ' B$_0^{&star0}$', + & ' B0*0', + & ' B$_0^{&star+}$', + & ' B0*+', + & ' B$_{&rm s0}^{&star0}$', + & ' Bs0*0', + & ' B$_{&rm c0}^{&star+}$', + & ' Bc0*+', + & ' $&overline{&rm B}_0^{&star0}$', + & ' -B0*0', + & ' B$_0^{&star-}$', + & ' B0*-', + & ' $&overline{&rm B}_{&rm s0}^{&star0}$', + & ' -Bs0*0', + & ' B$_{&rm c0}^{&star-}$', + & ' Bc0*-'/ + DATA ((TXNAME(J,I),J=1,2),I=345,352)/ + & ' $&Sigma_{&rm b}^0$', + & ' Sigmab0', + & ' $&Sigma_{&rm b}^{&star-}$', + & ' Sigmab*-', + & ' $&Sigma_{&rm b}^{&star0}$', + & ' Sigmab*0', + & ' $&Sigma_{&rm b}^{&star+}$', + & ' Sigmab*+', + & ' $&Xi_{&rm b}^{&prime0}$', + & ' Xib''0', + & ' $&Xi_{&rm b}^{&star0}$', + & ' Xib*0', + & ' $&Xi_{&rm b}^{&prime-}$', + & ' Xib''-', + & ' $&Xi_{&rm b}^{&star-}$', + & ' Xib*-'/ + DATA ((TXNAME(J,I),J=1,2),I=353,360)/ + & ' $&Omega_{&rm b}^{&star-}$', + & ' -Omegab*-', + & ' $&overline{&Sigma}_{&rm b}^{&star+}$', + & ' Sigmab*+', + & ' $&overline{&Sigma}_{&rm b}^0$', + & ' -Sigmab0', + & ' $&overline{&Sigma}_{&rm b}^{&star0}$', + & ' -Sigmab*0', + & ' $&overline{&Sigma}_{&rm b}^{&star-}$', + & ' -Sigmab*-', + & ' $&overline{&Xi}_{&rm b}^{&prime0}$', + & ' -Xib''0', + & ' $&overline{&Xi}_{&rm b}^{&star0}$', + & ' -Xib*0', + & ' $&overline{&Xi}_{&rm b}^{&prime+}$', + & ' -Xib''+'/ + DATA ((TXNAME(J,I),J=1,2),I=361,368)/ + & ' $&overline{&Xi}_{&rm b}^{&star+}$', + & ' -Xib*+', + & ' $&Omega_{&rm b}^{&star+}$', + & ' Omegab*+', + & ' K$(DL)_2^+$', + & ' K(DL)2+', + & ' K$(DL)_2^0$', + & ' K(DL)20', + & ' $&overline{&rm K}(DL)_2^0$', + & ' -K(DL)20', + & ' K$(DL)_2^-$', + & ' K(DL)2-', + & ' K$(D)^{&star+}$', + & ' K(D)*+', + & ' K$(D)^{&star0}$', + & ' K(D)*0'/ + DATA ((TXNAME(J,I),J=1,2),I=369,376)/ + & ' $&overline{&rm K}(D)^{&star0}$', + & ' -K(D)*0', + & ' K$(D)^{&star-}$', + & ' K(D)*-', + & ' K$(DH)_2^+$', + & ' K(DH)2+', + & ' K$(DH)_2^0$', + & ' K(DH)20', + & ' $&overline{&rm K}(DH)_2^0$', + & ' -K(DH)20', + & ' K$(DH)_2^-$', + & ' K(DH)2-', + & ' K$(D)_3^+$', + & ' K(D)3+', + & ' K$(D)_3^0$', + & ' K(D)30'/ + DATA ((TXNAME(J,I),J=1,2),I=377,384)/ + & ' $&overline{&rm K}(D)_3^0$', + & ' -K(D)30', + & ' K$(D)_3^-$', + & ' K(D)3-', + & ' $&pi_2^+$', + & ' pi2+', + & ' $&pi_2^0$', + & ' pi20', + & ' $&pi_2^-$', + & ' pi2-', + & ' $&rho(D)^+$', + & ' rho(D)+', + & ' $&rho(D)^0$', + & ' rho(D)0', + & ' $&rho(D)^-$', + & ' rho(D)-'/ + DATA ((TXNAME(J,I),J=1,2),I=385,392)/ + & ' $&rho_3^+$', + & ' rho3+', + & ' $&rho_3^0$', + & ' rho30', + & ' $&rho_3^-$', + & ' rho3-', + & ' $&Upsilon(2S)$', + & ' Upsilon(2S)', + & ' $&chi_{&rm b0}(2P)$', + & ' Chib0(2P)', + & ' $&chi_{&rm b1}(2P)$', + & ' Chib1(2P)', + & ' $&chi_{&rm b2}(2P)$', + & ' Chib2(2P)', + & ' $&Upsilon(3S)$', + & ' Upsilon(3S)'/ + DATA ((TXNAME(J,I),J=1,2),I=393,400)/ + & ' $&Upsilon(4S)$', + & ' Upsilon(4S)', + & ' ', + & ' ', + & ' $&omega_3$', + & ' omega3', + & ' $&phi_3$', + & ' phi3', + & ' $&eta_2(L)$', + & ' eta2(L)', + & ' $&eta_2(H)$', + & ' eta2(H)', + & ' $&omega(H)$', + & ' omega(H)', + & ' ', + & ' '/ + DATA ((TXNAME(J,I),J=1,2),I=401,408)/ + & ' $&tilde{&rm d}_{&rm L}$', + & ' ~dL', + & ' $&tilde{&rm u}_{&rm L}$', + & ' ~uL', + & ' $&tilde{&rm s}_{&rm L}$', + & ' ~sL', + & ' $&tilde{&rm c}_{&rm L}$', + & ' ~cL', + & ' $&tilde{&rm b}_1$', + & ' ~b1', + & ' $&tilde{&rm t}_1$', + & ' ~t1', + & ' $&overline{&tilde{&rm d}}_{&rm L}$', + & ' -~dL', + & ' $&overline{&tilde{&rm u}}_{&rm L}$', + & ' -~uL'/ + DATA ((TXNAME(J,I),J=1,2),I=409,416)/ + & ' $&overline{&tilde{&rm s}}_{&rm L}$', + & ' -~sL', + & ' $&overline{&tilde{&rm c}}_{&rm L}$', + & ' -~cL', + & ' $&overline{&tilde{&rm b}}_1$', + & ' -~b1', + & ' $&overline{&tilde{&rm t}}_1$', + & ' -~t1', + & ' $&tilde{&rm d}_{&rm R}$', + & ' ~dR', + & ' $&tilde{&rm u}_{&rm R}$', + & ' ~uR', + & ' $&tilde{&rm s}_{&rm R}$', + & ' ~sR', + & ' $&tilde{&rm c}_{&rm R}$', + & ' ~cR'/ + DATA ((TXNAME(J,I),J=1,2),I=417,424)/ + & ' $&tilde{&rm b}_2$', + & ' ~b2', + & ' $&tilde{&rm t}_2$', + & ' ~t2', + & ' $&overline{&tilde{&rm d}}_{&rm R}$', + & ' -~dR', + & ' $&overline{&tilde{&rm u}}_{&rm R}$', + & ' -~uR', + & ' $&overline{&tilde{&rm s}}_{&rm R}$', + & ' -~sR', + & ' $&overline{&tilde{&rm c}}_{&rm R}$', + & ' -~cR', + & ' $&overline{&tilde{&rm b}}_2$', + & ' -~b2', + & ' $&overline{&tilde{&rm t}}_2$', + & ' -~t2'/ + DATA ((TXNAME(J,I),J=1,2),I=425,432)/ + & ' $&tilde{&rm e}^-_{&rm L}$', + & ' ~e-L', + & ' $&tilde{&nu}_{&rm e}$', + & ' ~nue L', + & ' $&tilde{&mu}^-_{&rm L}$', + & ' ~mu-L', + & ' $&tilde{&nu}_&mu$', + & ' ~numu L', + & ' $&tilde{&tau}^-_1$', + & ' ~tau-1', + & ' $&tilde{&nu}_&tau$', + & ' ~nutau L', + & ' $&tilde{&rm e}^+_{&rm L}$', + & ' ~e+L', + & ' $&overline{&tilde{&nu}}_{&rm eL}$', + & ' -~nueL'/ + DATA ((TXNAME(J,I),J=1,2),I=433,440)/ + & ' $&tilde{&mu}^+_{&rm L}$', + & ' ~mu+L', + & ' $&overline{&tilde{&nu}}_{&rm&mu L}$', + & ' -~numu L', + & ' $&tilde{&tau}^+_1$', + & ' ~tau+1', + & ' $&overline{&tilde{&nu}}_{&rm&tau L}$', + & ' -~nutau L', + & ' $&tilde{&rm e}^-_{&rm R}$', + & ' ~e-R', + & ' $&tilde{&nu}_{&rm eR}$', + & ' ~nue R', + & ' $&tilde{&mu}^-_{&rm R}$', + & ' ~mu-R', + & ' $&tilde{&nu}_{&mu{&rm R}}$', + & ' ~numu R'/ + DATA ((TXNAME(J,I),J=1,2),I=441,448)/ + & ' $&tilde{&tau}^-_2$', + & ' ~tau-2', + & ' $&tilde{&nu}_{&tau{&rm R}}$', + & ' ~nutau R', + & ' $&tilde{&rm e}^+_{&rm R}$', + & ' ~e+R', + & ' $&overline{&tilde{&nu}}_{&rm eR}$', + & ' -~nue R', + & ' $&tilde{&mu}^+_{&rm R}$', + & ' ~mu+R', + & ' $&overline{&tilde{&nu}}_{&rm&mu R}$', + & ' -~numu R', + & ' $&tilde{&tau}^+_2$', + & ' ~tau+2', + & ' $&overline{&tilde{&nu}}_{&rm&tau R}$', + & ' -~nutau R'/ + DATA ((TXNAME(J,I),J=1,2),I=449,456)/ + & ' $&tilde{g}$', + & ' ~g', + & ' $&tilde{&chi}^0_1$', + & ' ~chi01', + & ' $&tilde{&chi}^0_2$', + & ' ~chi02', + & ' $&tilde{&chi}^0_3$', + & ' ~chi03', + & ' $&tilde{&chi}^0_4$', + & ' ~chi04', + & ' $&tilde{&chi}^+_1$', + & ' ~chi+1', + & ' $&tilde{&chi}^+_2$', + & ' ~chi+2', + & ' $&tilde{&chi}^-_1$', + & ' ~chi-1'/ + DATA ((TXNAME(J,I),J=1,2),I=457,NLAST)/ + & ' $&tilde{&chi}^-_2$', + & ' ~chi-2', + & ' $&tilde{G}$', + & ' ~G'/ +C + DATA (RNAME(I),I=NNEXT,NMXRES)/NLEFT*' '/ + DATA (IDPDG(I),I=NNEXT,NMXRES)/NLEFT*0/ + DATA (IFLAV(I),I=NNEXT,NMXRES)/NLEFT*0/ + DATA (RMASS(I),I=NNEXT,NMXRES)/NLEFT*0.0000/ + DATA (RLTIM(I),I=NNEXT,NMXRES)/NLEFT*0.000D+00/ + DATA (RSPIN(I),I=NNEXT,NMXRES)/NLEFT*0.0/ + DATA (TXNAME(1,I),I=NNEXT,NMXRES)/ + & NLEFT*' '/ + DATA (TXNAME(2,I),I=NNEXT,NMXRES)/ + & NLEFT*' '/ +C + DATA (RSTAB(I),I=1,NMXRES)/NMXRES*.FALSE./ + DATA DKPSET/.FALSE./ +C + DATA NDKYS/2263/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 1, 19)/ + & 6,0.334,100, 2, 7, 5, 0, 0, + & 6,0.333,100, 4, 9, 5, 0, 0, + & 6,0.111,100,122,127, 5, 0, 0, + & 6,0.111,100,124,129, 5, 0, 0, + & 6,0.111,100,126,131, 5, 0, 0, + & 12,0.334,100, 8, 1, 11, 0, 0, + & 12,0.333,100, 10, 3, 11, 0, 0, + & 12,0.111,100,128,121, 11, 0, 0, + & 12,0.111,100,130,123, 11, 0, 0, + & 12,0.111,100,132,125, 11, 0, 0, + & 21,0.988, 0, 59, 59, 0, 0, 0, + & 21,0.012, 0,127,121, 59, 0, 0, + & 22,0.388, 0, 59, 59, 0, 0, 0, + & 22,0.319, 0, 21, 21, 21, 0, 0, + & 22,0.001, 0, 21, 59, 59, 0, 0, + & 22,0.236, 0, 38, 30, 21, 0, 0, + & 22,0.049, 0, 38, 30, 59, 0, 0, + & 22,0.005, 0,127,121, 59, 0, 0, + & 22,0.002, 0, 38, 30,127,121, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 20, 38)/ + & 23,0.989, 0, 38, 30, 0, 0, 0, + & 23,0.010, 0, 38, 30, 59, 0, 0, + & 23,0.001, 0, 21, 59, 0, 0, 0, + & 24,0.888, 0, 38, 30, 21, 0, 0, + & 24,0.085, 0, 21, 59, 0, 0, 0, + & 24,0.022, 0, 38, 30, 0, 0, 0, + & 24,0.001, 0, 22, 59, 0, 0, 0, + & 24,0.001, 0, 21,127,121, 0, 0, + & 24,0.003, 0, 38, 30, 21, 21, 0, + & 25,0.437, 0, 38, 30, 22, 0, 0, + & 25,0.302, 0, 23, 59, 0, 0, 0, + & 25,0.208, 0, 21, 21, 22, 0, 0, + & 25,0.030, 0, 24, 59, 0, 0, 0, + & 25,0.021, 0, 59, 59, 0, 0, 0, + & 25,0.002, 0, 21, 21, 21, 0, 0, + & 26,0.566, 0, 38, 30, 0, 0, 0, + & 26,0.283, 0, 21, 21, 0, 0, 0, + & 26,0.069, 0, 38, 30, 21, 21, 0, + & 26,0.023, 0, 46, 34, 0, 0, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 39, 57)/ + & 26,0.023, 0, 50, 42, 0, 0, 0, + & 26,0.028, 0, 38, 38, 30, 30, 0, + & 26,0.005, 0, 22, 22, 0, 0, 0, + & 26,0.003, 0, 21, 21, 21, 21, 0, + & 27,0.499, 0, 39, 30, 0, 0, 0, + & 27,0.499, 0, 31, 38, 0, 0, 0, + & 27,0.002, 0, 21, 59, 59, 0, 0, + & 28,0.148, 0, 21, 21, 38, 30, 0, + & 28,0.148, 0, 23, 38, 30, 0, 0, + & 28,0.147, 0,291, 30, 0, 0, 0, + & 28,0.147, 0,290, 21, 0, 0, 0, + & 28,0.147, 0,292, 38, 0, 0, 0, + & 28,0.067, 0, 22, 38, 30, 0, 0, + & 28,0.033, 0, 22, 21, 21, 0, 0, + & 28,0.032, 0, 46, 42, 30, 0, 0, + & 28,0.016, 0, 46, 34, 21, 0, 0, + & 28,0.016, 0, 50, 42, 21, 0, 0, + & 28,0.032, 0, 50, 34, 38, 0, 0, + & 28,0.066, 0, 59, 23, 0, 0, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 58, 76)/ + & 28,0.001, 0, 56, 59, 0, 0, 0, + & 29,0.349, 0, 39, 30, 0, 0, 0, + & 29,0.349, 0, 31, 38, 0, 0, 0, + & 29,0.144, 0, 22, 21, 0, 0, 0, + & 29,0.104, 0, 24, 38, 30, 0, 0, + & 29,0.024, 0, 46, 34, 0, 0, 0, + & 29,0.024, 0, 50, 42, 0, 0, 0, + & 29,0.006, 0, 25, 21, 0, 0, 0, + & 30,1.000, 0,123,130, 0, 0, 0, + & 31,1.000, 0, 30, 21, 0, 0, 0, + & 32,0.499, 0, 31, 21, 0, 0, 0, + & 32,0.499, 0, 23, 30, 0, 0, 0, + & 32,0.002, 0, 30, 59, 0, 0, 0, + & 33,0.349, 0, 31, 21, 0, 0, 0, + & 33,0.349, 0, 23, 30, 0, 0, 0, + & 33,0.144, 0, 22, 30, 0, 0, 0, + & 33,0.101, 0, 24, 30, 21, 0, 0, + & 33,0.048, 0, 50, 34, 0, 0, 0, + & 33,0.006, 0, 25, 30, 0, 0, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 77, 95)/ + & 33,0.003, 0, 30, 59, 0, 0, 0, + & 34,0.629, 0,123,130, 0, 0, 0, + & 34,0.212, 0, 30, 21, 0, 0, 0, + & 34,0.056, 0, 30, 38, 30, 0, 0, + & 34,0.017, 0, 30, 21, 21, 0, 0, + & 34,0.048,101,121,128, 21, 0, 0, + & 34,0.032,101,123,130, 21, 0, 0, + & 34,0.006, 0,123,130, 59, 0, 0, + & 35,0.666, 0, 42, 30, 0, 0, 0, + & 35,0.333, 0, 34, 21, 0, 0, 0, + & 35,0.001, 0, 34, 59, 0, 0, 0, + & 36,0.627, 0, 43, 30, 0, 0, 0, + & 36,0.313, 0, 35, 21, 0, 0, 0, + & 36,0.020, 0, 42, 31, 0, 0, 0, + & 36,0.010, 0, 34, 23, 0, 0, 0, + & 36,0.020, 0, 34,294, 0, 0, 0, + & 36,0.010, 0, 34, 24, 0, 0, 0, + & 37,0.331, 0, 42, 30, 0, 0, 0, + & 37,0.166, 0, 34, 21, 0, 0, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 96, 114)/ + & 37,0.168, 0, 43, 30, 0, 0, 0, + & 37,0.084, 0, 35, 21, 0, 0, 0, + & 37,0.087, 0, 35, 38, 30, 0, 0, + & 37,0.044, 0, 35, 21, 21, 0, 0, + & 37,0.059, 0, 42, 31, 0, 0, 0, + & 37,0.029, 0, 34, 23, 0, 0, 0, + & 37,0.029, 0, 34, 24, 0, 0, 0, + & 37,0.002, 0, 34, 59, 0, 0, 0, + & 37,0.001, 0, 34, 22, 0, 0, 0, + & 38,1.000, 0,129,124, 0, 0, 0, + & 39,1.000, 0, 38, 21, 0, 0, 0, + & 40,0.499, 0, 39, 21, 0, 0, 0, + & 40,0.499, 0, 23, 38, 0, 0, 0, + & 40,0.002, 0, 38, 59, 0, 0, 0, + & 41,0.349, 0, 39, 21, 0, 0, 0, + & 41,0.349, 0, 23, 38, 0, 0, 0, + & 41,0.144, 0, 22, 38, 0, 0, 0, + & 41,0.101, 0, 24, 38, 21, 0, 0, + & 41,0.048, 0, 46, 42, 0, 0, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 115, 133)/ + & 41,0.006, 0, 25, 38, 0, 0, 0, + & 41,0.003, 0, 38, 59, 0, 0, 0, + & 42,0.500, 0, 60, 0, 0, 0, 0, + & 42,0.500, 0, 61, 0, 0, 0, 0, + & 43,0.665, 0, 34, 38, 0, 0, 0, + & 43,0.333, 0, 42, 21, 0, 0, 0, + & 43,0.002, 0, 42, 59, 0, 0, 0, + & 44,0.627, 0, 35, 38, 0, 0, 0, + & 44,0.313, 0, 43, 21, 0, 0, 0, + & 44,0.020, 0, 34, 39, 0, 0, 0, + & 44,0.010, 0, 42, 23, 0, 0, 0, + & 44,0.020, 0, 42,294, 0, 0, 0, + & 44,0.010, 0, 42, 24, 0, 0, 0, + & 45,0.331, 0, 34, 38, 0, 0, 0, + & 45,0.166, 0, 42, 21, 0, 0, 0, + & 45,0.168, 0, 35, 38, 0, 0, 0, + & 45,0.084, 0, 43, 21, 0, 0, 0, + & 45,0.089, 0, 42, 38, 30, 0, 0, + & 45,0.044, 0, 42, 21, 21, 0, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 134, 152)/ + & 45,0.059, 0, 34, 39, 0, 0, 0, + & 45,0.029, 0, 42, 23, 0, 0, 0, + & 45,0.029, 0, 42, 24, 0, 0, 0, + & 45,0.001, 0, 42, 22, 0, 0, 0, + & 46,0.629, 0,129,124, 0, 0, 0, + & 46,0.212, 0, 38, 21, 0, 0, 0, + & 46,0.056, 0, 38, 38, 30, 0, 0, + & 46,0.017, 0, 38, 21, 21, 0, 0, + & 46,0.032,101,129,124, 21, 0, 0, + & 46,0.048,101,127,122, 21, 0, 0, + & 46,0.006, 0,129,124, 59, 0, 0, + & 47,0.666, 0, 50, 38, 0, 0, 0, + & 47,0.333, 0, 46, 21, 0, 0, 0, + & 47,0.001, 0, 46, 59, 0, 0, 0, + & 48,0.627, 0, 51, 38, 0, 0, 0, + & 48,0.313, 0, 47, 21, 0, 0, 0, + & 48,0.020, 0, 50, 39, 0, 0, 0, + & 48,0.010, 0, 46, 23, 0, 0, 0, + & 48,0.020, 0, 46,294, 0, 0, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 153, 171)/ + & 48,0.010, 0, 46, 24, 0, 0, 0, + & 49,0.331, 0, 50, 38, 0, 0, 0, + & 49,0.166, 0, 46, 21, 0, 0, 0, + & 49,0.168, 0, 51, 38, 0, 0, 0, + & 49,0.084, 0, 47, 21, 0, 0, 0, + & 49,0.087, 0, 47, 38, 30, 0, 0, + & 49,0.044, 0, 47, 21, 21, 0, 0, + & 49,0.059, 0, 50, 39, 0, 0, 0, + & 49,0.029, 0, 46, 23, 0, 0, 0, + & 49,0.029, 0, 46, 24, 0, 0, 0, + & 49,0.002, 0, 46, 59, 0, 0, 0, + & 49,0.001, 0, 46, 22, 0, 0, 0, + & 50,0.500, 0, 60, 0, 0, 0, 0, + & 50,0.500, 0, 61, 0, 0, 0, 0, + & 51,0.665, 0, 46, 30, 0, 0, 0, + & 51,0.333, 0, 50, 21, 0, 0, 0, + & 51,0.002, 0, 50, 59, 0, 0, 0, + & 52,0.627, 0, 47, 30, 0, 0, 0, + & 52,0.313, 0, 51, 21, 0, 0, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 172, 190)/ + & 52,0.020, 0, 46, 31, 0, 0, 0, + & 52,0.010, 0, 50, 23, 0, 0, 0, + & 52,0.020, 0, 50,294, 0, 0, 0, + & 52,0.010, 0, 50, 24, 0, 0, 0, + & 53,0.331, 0, 46, 30, 0, 0, 0, + & 53,0.166, 0, 50, 21, 0, 0, 0, + & 53,0.168, 0, 47, 30, 0, 0, 0, + & 53,0.084, 0, 51, 21, 0, 0, 0, + & 53,0.089, 0, 50, 38, 30, 0, 0, + & 53,0.044, 0, 50, 21, 21, 0, 0, + & 53,0.059, 0, 46, 31, 0, 0, 0, + & 53,0.029, 0, 50, 23, 0, 0, 0, + & 53,0.029, 0, 50, 24, 0, 0, 0, + & 53,0.001, 0, 50, 22, 0, 0, 0, + & 56,0.490, 0, 46, 34, 0, 0, 0, + & 56,0.342, 0, 61, 60, 0, 0, 0, + & 56,0.043, 0, 39, 30, 0, 0, 0, + & 56,0.043, 0, 23, 21, 0, 0, 0, + & 56,0.043, 0, 31, 38, 0, 0, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 191, 209)/ + & 56,0.025, 0, 38, 30, 21, 0, 0, + & 56,0.013, 0, 22, 59, 0, 0, 0, + & 56,0.001, 0, 21, 59, 0, 0, 0, + & 57,0.250, 0, 50, 43, 0, 0, 0, + & 57,0.250, 0, 34, 47, 0, 0, 0, + & 57,0.250, 0, 42, 51, 0, 0, 0, + & 57,0.250, 0, 46, 35, 0, 0, 0, + & 58,0.356, 0, 46, 34, 0, 0, 0, + & 58,0.356, 0, 50, 42, 0, 0, 0, + & 58,0.279, 0, 22, 22, 0, 0, 0, + & 58,0.006, 0, 38, 30, 0, 0, 0, + & 58,0.003, 0, 21, 21, 0, 0, 0, + & 60,0.684, 0, 38, 30, 0, 0, 0, + & 60,0.314, 0, 21, 21, 0, 0, 0, + & 60,0.002, 0, 38, 30, 59, 0, 0, + & 61,0.216, 0, 21, 21, 21, 0, 0, + & 61,0.124, 0, 38, 30, 21, 0, 0, + & 61,0.135,101,123,130, 38, 0, 0, + & 61,0.135,101,124,129, 30, 0, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 210, 228)/ + & 61,0.187,101,121,128, 38, 0, 0, + & 61,0.187,101,122,127, 30, 0, 0, + & 61,0.006, 0,121,128, 38, 59, 0, + & 61,0.006, 0,122,127, 30, 59, 0, + & 61,0.002, 0, 38, 30, 0, 0, 0, + & 61,0.001, 0, 21, 21, 0, 0, 0, + & 61,0.001, 0, 59, 59, 0, 0, 0, + & 74,0.663, 0, 73, 21, 0, 0, 0, + & 74,0.331, 0, 75, 38, 0, 0, 0, + & 74,0.006, 0, 73, 59, 0, 0, 0, + & 75,1.000,101,121,128, 73, 0, 0, + & 76,0.663, 0, 75, 21, 0, 0, 0, + & 76,0.331, 0, 73, 30, 0, 0, 0, + & 76,0.006, 0, 75, 59, 0, 0, 0, + & 77,1.000, 0, 75, 30, 0, 0, 0, + & 78,0.638, 0, 73, 30, 0, 0, 0, + & 78,0.358, 0, 75, 21, 0, 0, 0, + & 78,0.002, 0, 75, 59, 0, 0, 0, + & 78,0.001, 0, 73, 30, 59, 0, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 229, 247)/ + & 78,0.001,101,121,128, 73, 0, 0, + & 79,0.995, 0, 78, 59, 0, 0, 0, + & 79,0.005, 0, 78,127,121, 0, 0, + & 80,0.880, 0, 78, 21, 0, 0, 0, + & 80,0.060, 0, 86, 30, 0, 0, 0, + & 80,0.060, 0, 81, 38, 0, 0, 0, + & 81,0.998, 0, 75, 30, 0, 0, 0, + & 81,0.001, 0, 75, 30, 59, 0, 0, + & 81,0.001,101,121,128, 75, 0, 0, + & 82,0.880, 0, 78, 30, 0, 0, 0, + & 82,0.060, 0, 79, 30, 0, 0, 0, + & 82,0.060, 0, 81, 21, 0, 0, 0, + & 83,0.999, 0, 78, 30, 0, 0, 0, + & 83,0.001,101,121,128, 78, 0, 0, + & 84,0.667, 0, 88, 30, 0, 0, 0, + & 84,0.333, 0, 83, 21, 0, 0, 0, + & 85,1.000, 0, 73, 38, 0, 0, 0, + & 86,0.516, 0, 73, 21, 0, 0, 0, + & 86,0.483, 0, 75, 38, 0, 0, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 248, 266)/ + & 86,0.001, 0, 73, 59, 0, 0, 0, + & 87,0.880, 0, 78, 38, 0, 0, 0, + & 87,0.060, 0, 86, 21, 0, 0, 0, + & 87,0.060, 0, 79, 38, 0, 0, 0, + & 88,0.995, 0, 78, 21, 0, 0, 0, + & 88,0.001, 0, 78, 59, 0, 0, 0, + & 88,0.004, 0, 79, 59, 0, 0, 0, + & 89,0.667, 0, 83, 38, 0, 0, 0, + & 89,0.333, 0, 88, 21, 0, 0, 0, + & 90,0.675, 0, 78, 34, 0, 0, 0, + & 90,0.233, 0, 88, 30, 0, 0, 0, + & 90,0.086, 0, 83, 21, 0, 0, 0, + & 90,0.006,101,121,128, 88, 0, 0, + & 92,0.663, 0, 91, 21, 0, 0, 0, + & 92,0.331, 0, 93, 30, 0, 0, 0, + & 92,0.006, 0, 91, 59, 0, 0, 0, + & 93,1.000,101,127,122, 91, 0, 0, + & 94,0.663, 0, 93, 21, 0, 0, 0, + & 94,0.331, 0, 91, 38, 0, 0, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 267, 285)/ + & 94,0.006, 0, 93, 59, 0, 0, 0, + & 95,1.000, 0, 93, 38, 0, 0, 0, + & 96,0.638, 0, 91, 38, 0, 0, 0, + & 96,0.358, 0, 93, 21, 0, 0, 0, + & 96,0.002, 0, 93, 59, 0, 0, 0, + & 96,0.001, 0, 91, 38, 59, 0, 0, + & 96,0.001,101,127,122, 91, 0, 0, + & 97,0.995, 0, 96, 59, 0, 0, 0, + & 97,0.005, 0, 96,127,121, 0, 0, + & 98,0.880, 0, 96, 21, 0, 0, 0, + & 98,0.060, 0,104, 38, 0, 0, 0, + & 98,0.060, 0, 99, 30, 0, 0, 0, + & 99,0.998, 0, 93, 38, 0, 0, 0, + & 99,0.001, 0, 93, 38, 59, 0, 0, + & 99,0.001,101,127,122, 93, 0, 0, + & 100,0.880, 0, 96, 38, 0, 0, 0, + & 100,0.060, 0, 97, 38, 0, 0, 0, + & 100,0.060, 0, 99, 21, 0, 0, 0, + & 101,0.999, 0, 96, 38, 0, 0, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 286, 304)/ + & 101,0.001,101,127,122, 96, 0, 0, + & 102,0.667, 0,106, 38, 0, 0, 0, + & 102,0.333, 0,101, 21, 0, 0, 0, + & 103,1.000, 0, 91, 30, 0, 0, 0, + & 104,0.516, 0, 91, 21, 0, 0, 0, + & 104,0.483, 0, 93, 30, 0, 0, 0, + & 104,0.001, 0, 91, 59, 0, 0, 0, + & 105,0.880, 0, 96, 30, 0, 0, 0, + & 105,0.060, 0,104, 21, 0, 0, 0, + & 105,0.060, 0, 97, 30, 0, 0, 0, + & 106,0.995, 0, 96, 21, 0, 0, 0, + & 106,0.001, 0, 96, 59, 0, 0, 0, + & 106,0.004, 0, 97, 59, 0, 0, 0, + & 107,0.667, 0,101, 30, 0, 0, 0, + & 107,0.333, 0,106, 21, 0, 0, 0, + & 108,0.675, 0, 96, 46, 0, 0, 0, + & 108,0.233, 0,106, 38, 0, 0, 0, + & 108,0.086, 0,101, 21, 0, 0, 0, + & 108,0.006,101,127,122,106, 0, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 305, 323)/ + & 123,0.986,100,121,128,124, 0, 0, + & 123,0.014, 0,121,128,124, 59, 0, + & 125,0.178,100,121,128,126, 0, 0, + & 125,0.171,100,123,130,126, 0, 0, + & 125,0.002, 0,123,130, 59,126, 0, + & 125,0.111, 0, 30,126, 0, 0, 0, + & 125,0.253, 0, 31,126, 0, 0, 0, + & 125,0.181, 0, 32,126, 0, 0, 0, + & 125,0.002, 0, 30, 22, 21,126, 0, + & 125,0.018, 0, 30, 24,126, 0, 0, + & 125,0.004, 0, 30, 24, 21,126, 0, + & 125,0.015, 0, 31, 23,126, 0, 0, + & 125,0.001, 0, 31, 24, 21,126, 0, + & 125,0.024, 0, 32, 21,126, 0, 0, + & 125,0.002, 0, 32, 38, 30,126, 0, + & 125,0.007, 0, 34,126, 0, 0, 0, + & 125,0.014, 0, 35,126, 0, 0, 0, + & 125,0.003, 0, 35, 21,126, 0, 0, + & 125,0.001, 0, 34, 38, 30,126, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 324, 342)/ + & 125,0.004, 0, 30, 43,126, 0, 0, + & 125,0.003, 0, 34, 50,126, 0, 0, + & 125,0.003, 0, 34, 51,126, 0, 0, + & 125,0.003, 0, 30, 50, 42,126, 0, + & 129,0.986,100,127,122,130, 0, 0, + & 129,0.014, 0,127,122,130, 59, 0, + & 131,0.178,100,127,122,132, 0, 0, + & 131,0.171,100,129,124,132, 0, 0, + & 131,0.002, 0,129,124, 59,132, 0, + & 131,0.111, 0, 38,132, 0, 0, 0, + & 131,0.253, 0, 39,132, 0, 0, 0, + & 131,0.181, 0, 40,132, 0, 0, 0, + & 131,0.002, 0, 38, 22, 21,132, 0, + & 131,0.018, 0, 38, 24,132, 0, 0, + & 131,0.004, 0, 38, 24, 21,132, 0, + & 131,0.015, 0, 39, 23,132, 0, 0, + & 131,0.001, 0, 39, 24, 21,132, 0, + & 131,0.024, 0, 40, 21,132, 0, 0, + & 131,0.002, 0, 40, 38, 30,132, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 343, 361)/ + & 131,0.007, 0, 46,132, 0, 0, 0, + & 131,0.014, 0, 47,132, 0, 0, 0, + & 131,0.003, 0, 47, 21,132, 0, 0, + & 131,0.001, 0, 46, 38, 30,132, 0, + & 131,0.004, 0, 38, 51,132, 0, 0, + & 131,0.003, 0, 46, 42,132, 0, 0, + & 131,0.003, 0, 46, 43,132, 0, 0, + & 131,0.003, 0, 38, 50, 42,132, 0, + & 136,0.067,101,122,127, 42, 0, 0, + & 136,0.067,101,124,129, 42, 0, 0, + & 136,0.048,101,122,127, 43, 0, 0, + & 136,0.048,101,124,129, 43, 0, 0, + & 136,0.003, 0, 34, 38,122,127, 0, + & 136,0.003, 0, 34, 38,124,129, 0, + & 136,0.006,101,122,127, 21, 0, 0, + & 136,0.006,101,124,129, 21, 0, 0, + & 136,0.002,101,122,127, 23, 0, 0, + & 136,0.002,101,124,129, 23, 0, 0, + & 136,0.055, 0, 34, 38, 38, 0, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 362, 380)/ + & 136,0.031, 0, 34, 39, 38, 0, 0, + & 136,0.042, 0, 34, 38, 38, 21, 21, + & 136,0.002, 0, 34, 38, 38, 38, 31, + & 136,0.021, 0, 35, 38, 38, 0, 0, + & 136,0.027, 0, 42, 38, 0, 0, 0, + & 136,0.066, 0, 42, 39, 0, 0, 0, + & 136,0.081, 0, 42, 40, 0, 0, 0, + & 136,0.024, 0, 42, 38, 21, 0, 0, + & 136,0.004, 0, 42, 38, 23, 0, 0, + & 136,0.069, 0, 42, 38, 38, 30, 21, + & 136,0.001, 0, 42, 38, 38, 30, 23, + & 136,0.022, 0, 43, 38, 0, 0, 0, + & 136,0.021, 0, 43, 39, 0, 0, 0, + & 136,0.042, 0, 43, 38, 21, 0, 0, + & 136,0.008, 0, 43, 38, 23, 0, 0, + & 136,0.010, 0, 43, 38, 38, 30, 0, + & 136,0.050, 0,311, 38, 0, 0, 0, + & 136,0.034, 0,329, 38, 0, 0, 0, + & 136,0.010, 0,369, 38, 0, 0, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 381, 399)/ + & 136,0.031, 0, 46, 42, 42, 0, 0, + & 136,0.003, 0, 38, 21, 0, 0, 0, + & 136,0.001, 0, 38, 23, 0, 0, 0, + & 136,0.002, 0, 38, 38, 30, 0, 0, + & 136,0.008, 0, 38, 22, 0, 0, 0, + & 136,0.001, 0, 38, 38, 38, 30, 30, + & 136,0.003, 0, 38, 38, 38, 30, 31, + & 136,0.008, 0, 46, 42, 0, 0, 0, + & 136,0.005, 0, 46, 43, 0, 0, 0, + & 136,0.026, 0, 47, 43, 0, 0, 0, + & 136,0.005, 0, 46, 34, 38, 0, 0, + & 136,0.007, 0, 38, 56, 0, 0, 0, + & 136,0.023, 0, 38, 56, 21, 0, 0, + & 136,0.005, 0, 46, 46, 34, 0, 0, + & 137,0.683, 0,140, 38, 0, 0, 0, + & 137,0.306, 0,136, 21, 0, 0, 0, + & 137,0.011, 0,136, 59, 0, 0, 0, + & 138,0.667, 0,141, 38, 0, 0, 0, + & 138,0.333, 0,137, 21, 0, 0, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 400, 418)/ + & 139,0.220, 0,140, 38, 0, 0, 0, + & 139,0.110, 0,136, 21, 0, 0, 0, + & 139,0.380, 0,141, 38, 0, 0, 0, + & 139,0.190, 0,137, 21, 0, 0, 0, + & 139,0.004, 0,136, 22, 0, 0, 0, + & 139,0.064, 0,141, 38, 21, 0, 0, + & 139,0.032, 0,137, 38, 30, 0, 0, + & 140,0.037,101,122,127, 34, 0, 0, + & 140,0.037,101,124,129, 34, 0, 0, + & 140,0.016,101,122,127, 35, 0, 0, + & 140,0.016,101,124,129, 35, 0, 0, + & 140,0.013, 0, 34, 21,122,127, 0, + & 140,0.013, 0, 34, 21,124,129, 0, + & 140,0.012, 0, 42, 30,122,127, 0, + & 140,0.012, 0, 42, 30,124,129, 0, + & 140,0.003,101,122,127, 30, 0, 0, + & 140,0.003,101,124,129, 30, 0, 0, + & 140,0.039, 0, 34, 38, 0, 0, 0, + & 140,0.091, 0, 34, 39, 0, 0, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 419, 437)/ + & 140,0.067, 0, 34, 40, 0, 0, 0, + & 140,0.004, 0, 34, 38, 21, 0, 0, + & 140,0.100, 0, 34, 38, 21, 21, 0, + & 140,0.058, 0, 34, 38, 23, 0, 0, + & 140,0.020, 0, 34, 38, 24, 0, 0, + & 140,0.006, 0, 34, 38, 25, 0, 0, + & 140,0.043, 0, 35, 38, 0, 0, 0, + & 140,0.035, 0, 35, 39, 0, 0, 0, + & 140,0.007, 0,312, 38, 0, 0, 0, + & 140,0.007, 0,330, 38, 0, 0, 0, + & 140,0.020, 0, 42, 21, 0, 0, 0, + & 140,0.006, 0, 42, 22, 0, 0, 0, + & 140,0.009, 0, 42, 23, 0, 0, 0, + & 140,0.016, 0, 42, 24, 0, 0, 0, + & 140,0.014, 0, 42, 25, 0, 0, 0, + & 140,0.003, 0, 42,293, 0, 0, 0, + & 140,0.007, 0, 42, 56, 0, 0, 0, + & 140,0.003, 0, 42, 26, 0, 0, 0, + & 140,0.004, 0, 42,294, 0, 0, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 438, 456)/ + & 140,0.006, 0, 42, 21, 21, 0, 0, + & 140,0.042, 0, 42, 38, 30, 21, 0, + & 140,0.004, 0, 42, 38, 38, 30, 30, + & 140,0.076, 0, 42, 38, 30, 21, 21, + & 140,0.026, 0, 43, 21, 0, 0, 0, + & 140,0.014, 0, 43, 22, 0, 0, 0, + & 140,0.014, 0, 43, 23, 0, 0, 0, + & 140,0.011, 0, 43, 24, 0, 0, 0, + & 140,0.018, 0, 43, 38, 30, 0, 0, + & 140,0.004, 0, 42, 46, 34, 0, 0, + & 140,0.004, 0, 42, 46, 34, 21, 0, + & 140,0.005, 0, 42, 42, 50, 0, 0, + & 140,0.002, 0, 38, 30, 0, 0, 0, + & 140,0.001, 0, 21, 21, 0, 0, 0, + & 140,0.008, 0, 38, 30, 21, 0, 0, + & 140,0.007, 0, 38, 38, 30, 30, 0, + & 140,0.015, 0, 38, 38, 30, 30, 21, + & 140,0.004, 0, 46, 34, 0, 0, 0, + & 140,0.003, 0, 47, 34, 0, 0, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 457, 475)/ + & 140,0.002, 0, 46, 35, 0, 0, 0, + & 140,0.001, 0, 50, 42, 0, 0, 0, + & 140,0.002, 0, 51, 43, 0, 0, 0, + & 140,0.003, 0, 50, 34, 38, 0, 0, + & 140,0.003, 0, 42, 46, 30, 0, 0, + & 140,0.001, 0, 46, 34, 38, 30, 21, + & 140,0.002, 0, 56, 23, 0, 0, 0, + & 140,0.001, 0, 56, 38, 30, 0, 0, + & 141,0.636, 0,140, 21, 0, 0, 0, + & 141,0.364, 0,140, 59, 0, 0, 0, + & 142,0.667, 0,137, 30, 0, 0, 0, + & 142,0.333, 0,141, 21, 0, 0, 0, + & 143,0.220, 0,136, 30, 0, 0, 0, + & 143,0.110, 0,140, 21, 0, 0, 0, + & 143,0.380, 0,137, 30, 0, 0, 0, + & 143,0.190, 0,141, 21, 0, 0, 0, + & 143,0.004, 0,140, 22, 0, 0, 0, + & 143,0.064, 0,137, 30, 21, 0, 0, + & 143,0.032, 0,141, 38, 30, 0, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 476, 494)/ + & 144,0.009, 0,124,129, 0, 0, 0, + & 144,0.019,101,122,127, 56, 0, 0, + & 144,0.019,101,124,129, 56, 0, 0, + & 144,0.025,101,122,127, 22, 0, 0, + & 144,0.025,101,124,129, 22, 0, 0, + & 144,0.009,101,122,127, 25, 0, 0, + & 144,0.009,101,124,129, 25, 0, 0, + & 144,0.036, 0, 46, 42, 0, 0, 0, + & 144,0.034, 0, 46, 43, 0, 0, 0, + & 144,0.007, 0, 46,329, 0, 0, 0, + & 144,0.043, 0, 47, 42, 0, 0, 0, + & 144,0.058, 0, 47, 43, 0, 0, 0, + & 144,0.011, 0, 46, 34, 38, 0, 0, + & 144,0.055, 0, 46, 34, 38, 21, 0, + & 144,0.003, 0, 46, 34, 38, 38, 30, + & 144,0.014, 0, 46, 42, 38, 30, 0, + & 144,0.017, 0, 50, 34, 38, 38, 0, + & 144,0.036, 0, 56, 38, 0, 0, 0, + & 144,0.067, 0, 56, 39, 0, 0, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 495, 513)/ + & 144,0.023, 0, 56, 38, 21, 0, 0, + & 144,0.018, 0, 56, 38, 38, 30, 0, + & 144,0.020, 0, 22, 38, 0, 0, 0, + & 144,0.001, 0, 23, 38, 0, 0, 0, + & 144,0.009, 0, 24, 38, 0, 0, 0, + & 144,0.049, 0, 25, 38, 0, 0, 0, + & 144,0.011, 0,293, 38, 0, 0, 0, + & 144,0.015, 0, 22, 38, 21, 0, 0, + & 144,0.016, 0, 25, 38, 21, 0, 0, + & 144,0.103, 0, 22, 39, 0, 0, 0, + & 144,0.120, 0, 25, 39, 0, 0, 0, + & 144,0.010, 0, 38, 38, 30, 0, 0, + & 144,0.046, 0, 38, 38, 30, 21, 0, + & 144,0.003, 0, 38, 38, 38, 30, 30, + & 144,0.042, 0, 38, 30, 30, 38, 39, + & 144,0.001, 0, 46, 23, 0, 0, 0, + & 144,0.005, 0, 46, 38, 30, 0, 0, + & 144,0.001, 0, 46, 56, 0, 0, 0, + & 144,0.004, 0, 50, 38, 0, 0, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 514, 532)/ + & 144,0.007, 0, 51, 38, 0, 0, 0, + & 145,0.900, 0,144, 59, 0, 0, 0, + & 145,0.100, 0,144, 21, 0, 0, 0, + & 146,0.500, 0,137, 50, 0, 0, 0, + & 146,0.500, 0,141, 46, 0, 0, 0, + & 147,0.440, 0,136, 50, 0, 0, 0, + & 147,0.440, 0,140, 46, 0, 0, 0, + & 147,0.055, 0,137, 50, 0, 0, 0, + & 147,0.055, 0,141, 46, 0, 0, 0, + & 147,0.010, 0,144, 22, 0, 0, 0, + & 148,1.000, 0,150, 38, 0, 0, 0, + & 149,1.000, 0,150, 38, 0, 0, 0, + & 150,0.028,101,122,127, 78, 0, 0, + & 150,0.010,101,122,127, 80, 0, 0, + & 150,0.028,101,124,129, 78, 0, 0, + & 150,0.010,101,124,129, 80, 0, 0, + & 150,0.026, 0, 73, 42, 0, 0, 0, + & 150,0.030, 0, 73, 42, 21, 0, 0, + & 150,0.029, 0, 73, 42, 38, 30, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 533, 551)/ + & 150,0.014, 0, 73, 42, 22, 0, 0, + & 150,0.020, 0, 73, 43, 0, 0, 0, + & 150,0.029, 0, 73, 34, 38, 0, 0, + & 150,0.039, 0, 73, 34, 38, 21, 0, + & 150,0.002, 0, 73, 34, 38, 38, 30, + & 150,0.010, 0, 73, 34, 38, 21, 21, + & 150,0.014, 0, 73, 35, 38, 0, 0, + & 150,0.010, 0, 74, 42, 0, 0, 0, + & 150,0.020, 0, 74, 43, 0, 0, 0, + & 150,0.010, 0, 74, 43, 21, 0, 0, + & 150,0.007, 0, 85, 34, 0, 0, 0, + & 150,0.014, 0, 85, 35, 0, 0, 0, + & 150,0.004, 0, 73,293, 0, 0, 0, + & 150,0.003, 0, 73, 38, 30, 0, 0, + & 150,0.003, 0, 73, 38, 30, 38, 30, + & 150,0.001, 0, 73, 56, 0, 0, 0, + & 150,0.002, 0, 73, 46, 34, 0, 0, + & 150,0.010, 0, 78, 38, 0, 0, 0, + & 150,0.020, 0, 78, 39, 0, 0, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 552, 570)/ + & 150,0.030, 0, 78, 38, 21, 0, 0, + & 150,0.010, 0, 78, 38, 22, 0, 0, + & 150,0.020, 0, 78, 38, 24, 0, 0, + & 150,0.035, 0, 78, 38, 38, 30, 0, + & 150,0.020, 0, 78, 38, 21, 21, 0, + & 150,0.010, 0, 78, 38, 38, 30, 21, + & 150,0.010, 0, 78, 38, 21, 21, 21, + & 150,0.007, 0, 78, 46, 42, 0, 0, + & 150,0.011, 0, 79, 38, 0, 0, 0, + & 150,0.022, 0, 79, 38, 21, 0, 0, + & 150,0.013, 0, 79, 38, 38, 30, 0, + & 150,0.010, 0, 79, 38, 21, 21, 0, + & 150,0.007, 0, 79, 38, 38, 30, 21, + & 150,0.005, 0, 79, 38, 21, 21, 21, + & 150,0.005, 0, 80, 38, 0, 0, 0, + & 150,0.015, 0, 80, 39, 0, 0, 0, + & 150,0.011, 0, 86, 21, 0, 0, 0, + & 150,0.007, 0, 86, 22, 0, 0, 0, + & 150,0.010, 0, 86, 23, 0, 0, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 571, 589)/ + & 150,0.031, 0, 86, 24, 0, 0, 0, + & 150,0.010, 0, 86, 25, 0, 0, 0, + & 150,0.004, 0, 86, 56, 0, 0, 0, + & 150,0.026, 0, 86, 38, 30, 0, 0, + & 150,0.005, 0, 86, 38, 38, 30, 30, + & 150,0.005, 0, 86, 38, 30, 21, 21, + & 150,0.005, 0, 87, 21, 0, 0, 0, + & 150,0.006, 0, 87, 23, 0, 0, 0, + & 150,0.004, 0, 86, 46, 34, 0, 0, + & 150,0.002, 0, 86, 46, 30, 0, 0, + & 150,0.001, 0, 86, 46, 30, 21, 0, + & 150,0.016, 0, 81, 38, 38, 0, 0, + & 150,0.003, 0, 88, 46, 0, 0, 0, + & 150,0.002, 0, 89, 46, 0, 0, 0, + & 150,0.003, 0, 83, 46, 38, 0, 0, + & 150,0.040, 0, 75, 46, 21, 0, 0, + & 150,0.040, 0, 75, 46, 38, 30, 0, + & 150,0.020, 0, 75, 46, 21, 21, 0, + & 150,0.010, 0, 75, 46, 38, 30, 21/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 590, 608)/ + & 150,0.010, 0, 75, 46, 21, 21, 21, + & 150,0.020, 0, 75, 47, 21, 0, 0, + & 150,0.040, 0, 75, 42, 38, 0, 0, + & 150,0.020, 0, 75, 42, 39, 0, 0, + & 150,0.010, 0, 75, 42, 38, 38, 30, + & 150,0.010, 0, 75, 42, 38, 21, 21, + & 150,0.006, 0, 75, 43, 38, 0, 0, + & 151,1.000, 0,150, 21, 0, 0, 0, + & 152,1.000, 0,150, 21, 0, 0, 0, + & 153,1.000, 0,150, 30, 0, 0, 0, + & 154,1.000, 0,150, 30, 0, 0, 0, + & 155,0.045,101,122,127, 88, 0, 0, + & 155,0.005,101,122,127, 89, 0, 0, + & 155,0.045,101,124,129, 88, 0, 0, + & 155,0.005,101,124,129, 89, 0, 0, + & 155,0.021, 0, 86, 42, 0, 0, 0, + & 155,0.032, 0, 87, 42, 0, 0, 0, + & 155,0.032, 0, 79, 38, 42, 0, 0, + & 155,0.045, 0, 86, 43, 0, 0, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 609, 627)/ + & 155,0.065, 0, 87, 43, 0, 0, 0, + & 155,0.065, 0, 79, 38, 43, 0, 0, + & 155,0.055, 0, 88, 38, 0, 0, 0, + & 155,0.160, 0, 88, 39, 0, 0, 0, + & 155,0.105, 0, 89, 38, 0, 0, 0, + & 155,0.320, 0, 89, 39, 0, 0, 0, + & 156,1.000, 0,155, 59, 0, 0, 0, + & 157,0.667, 0,158, 38, 0, 0, 0, + & 157,0.333, 0,155, 21, 0, 0, 0, + & 158,0.045,101,122,127, 83, 0, 0, + & 158,0.045,101,124,129, 83, 0, 0, + & 158,0.005,101,122,127, 84, 0, 0, + & 158,0.005,101,124,129, 84, 0, 0, + & 158,0.020, 0, 79, 42, 0, 0, 0, + & 158,0.020, 0, 79, 21, 42, 0, 0, + & 158,0.020, 0, 80, 42, 0, 0, 0, + & 158,0.060, 0, 79, 43, 0, 0, 0, + & 158,0.060, 0, 79, 21, 43, 0, 0, + & 158,0.060, 0, 80, 43, 0, 0, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 628, 646)/ + & 158,0.020, 0, 86, 34, 0, 0, 0, + & 158,0.060, 0, 86, 35, 0, 0, 0, + & 158,0.040, 0, 87, 34, 0, 0, 0, + & 158,0.120, 0, 87, 35, 0, 0, 0, + & 158,0.020, 0, 83, 38, 0, 0, 0, + & 158,0.060, 0, 83, 39, 0, 0, 0, + & 158,0.040, 0, 84, 38, 0, 0, 0, + & 158,0.120, 0, 84, 39, 0, 0, 0, + & 158,0.010, 0, 88, 21, 0, 0, 0, + & 158,0.030, 0, 88, 23, 0, 0, 0, + & 158,0.020, 0, 89, 21, 0, 0, 0, + & 158,0.060, 0, 89, 23, 0, 0, 0, + & 158,0.030, 0, 88, 56, 0, 0, 0, + & 158,0.030, 0, 90, 46, 0, 0, 0, + & 159,1.000, 0,158, 59, 0, 0, 0, + & 160,0.670, 0,155, 30, 0, 0, 0, + & 160,0.330, 0,158, 21, 0, 0, 0, + & 161,0.050,101,122,127, 90, 0, 0, + & 161,0.050,101,124,129, 90, 0, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 647, 665)/ + & 161,0.075, 0, 88, 42, 0, 0, 0, + & 161,0.225, 0, 88, 43, 0, 0, 0, + & 161,0.150, 0, 89, 42, 0, 0, 0, + & 161,0.450, 0, 89, 43, 0, 0, 0, + & 162,1.000, 0,161, 59, 0, 0, 0, + & 163,0.028, 0, 25, 38, 30, 0, 0, + & 163,0.014, 0, 25, 21, 21, 0, 0, + & 163,0.018, 0, 39, 31, 0, 0, 0, + & 163,0.009, 0, 23, 23, 0, 0, 0, + & 163,0.010, 0, 51, 34, 38, 0, 0, + & 163,0.010, 0, 43, 47, 30, 0, 0, + & 163,0.004, 0, 51, 43, 0, 0, 0, + & 163,0.004, 0, 47, 35, 0, 0, 0, + & 163,0.007, 0, 56, 56, 0, 0, 0, + & 163,0.022, 0, 46, 42, 30, 0, 0, + & 163,0.011, 0, 46, 34, 21, 0, 0, + & 163,0.011, 0, 50, 42, 21, 0, 0, + & 163,0.022, 0, 50, 34, 38, 0, 0, + & 163,0.032, 0, 22, 38, 30, 0, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 666, 684)/ + & 163,0.016, 0, 22, 21, 21, 0, 0, + & 163,0.020, 0, 38, 30, 46, 34, 0, + & 163,0.012, 0, 38, 30, 38, 30, 0, + & 163,0.001, 0, 73, 91, 0, 0, 0, + & 163,0.001, 0, 59, 59, 0, 0, 0, + & 163,0.748, 0, 13, 13, 0, 0, 0, + & 164,0.060, 0,121,127, 0, 0, 0, + & 164,0.060, 0,123,129, 0, 0, 0, + & 164,0.004, 0, 39, 30, 0, 0, 0, + & 164,0.004, 0, 23, 21, 0, 0, 0, + & 164,0.004, 0, 31, 38, 0, 0, 0, + & 164,0.003, 0, 41, 31, 0, 0, 0, + & 164,0.003, 0, 29, 23, 0, 0, 0, + & 164,0.003, 0, 33, 39, 0, 0, 0, + & 164,0.009, 0, 24, 38, 38, 30, 30, + & 164,0.007, 0, 24, 38, 30, 0, 0, + & 164,0.003, 0, 51, 45, 0, 0, 0, + & 164,0.003, 0, 43, 53, 0, 0, 0, + & 164,0.003, 0, 24, 51, 42, 0, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 685, 703)/ + & 164,0.003, 0, 24, 43, 50, 0, 0, + & 164,0.004, 0, 24, 26, 0, 0, 0, + & 164,0.003, 0, 46, 35, 0, 0, 0, + & 164,0.003, 0, 34, 47, 0, 0, 0, + & 164,0.002, 0, 50, 43, 0, 0, 0, + & 164,0.002, 0, 42, 51, 0, 0, 0, + & 164,0.003, 0, 24, 21, 21, 0, 0, + & 164,0.002, 0,286, 30, 0, 0, 0, + & 164,0.002, 0,287, 38, 0, 0, 0, + & 164,0.003, 0, 24, 46, 42, 30, 0, + & 164,0.003, 0, 24, 34, 50, 38, 0, + & 164,0.002, 0,285, 21, 0, 0, 0, + & 164,0.001, 0, 56, 51, 42, 0, 0, + & 164,0.001, 0, 56, 43, 50, 0, 0, + & 164,0.001, 0, 24, 50, 42, 0, 0, + & 164,0.001, 0, 24, 46, 34, 0, 0, + & 164,0.002, 0, 56, 38, 30, 38, 30, + & 164,0.002, 0, 85, 91, 30, 0, 0, + & 164,0.002, 0,103, 73, 38, 0, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 704, 722)/ + & 164,0.002, 0, 24, 22, 0, 0, 0, + & 164,0.001, 0, 56, 50, 42, 0, 0, + & 164,0.001, 0, 56, 46, 34, 0, 0, + & 164,0.001, 0, 73, 91, 24, 0, 0, + & 164,0.001, 0, 85,103, 0, 0, 0, + & 164,0.001, 0, 82,100, 0, 0, 0, + & 164,0.001, 0, 87,105, 0, 0, 0, + & 164,0.001, 0, 73, 91, 25, 0, 0, + & 164,0.001, 0, 56, 58, 0, 0, 0, + & 164,0.001, 0, 56, 38, 30, 0, 0, + & 164,0.001, 0, 56, 46, 42, 30, 0, + & 164,0.001, 0, 56, 34, 50, 38, 0, + & 164,0.001, 0, 56, 22, 0, 0, 0, + & 164,0.001, 0, 84,102, 0, 0, 0, + & 164,0.001, 0, 73, 34, 98, 0, 0, + & 164,0.001, 0, 91, 46, 80, 0, 0, + & 164,0.034, 0, 38, 38, 30, 30, 21, + & 164,0.029, 0, 23, 23, 23, 21, 0, + & 164,0.015, 0, 38, 30, 21, 0, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 723, 741)/ + & 164,0.012, 0, 38, 30, 21, 34, 46, + & 164,0.009, 0, 23, 23, 23, 24, 0, + & 164,0.007, 0, 38, 30, 34, 46, 0, + & 164,0.002, 0, 46, 42, 30, 0, 0, + & 164,0.001, 0, 46, 34, 21, 0, 0, + & 164,0.001, 0, 50, 42, 21, 0, 0, + & 164,0.002, 0, 50, 34, 38, 0, 0, + & 164,0.006, 0, 73, 91, 38, 30, 0, + & 164,0.004, 0, 38, 30, 38, 30, 0, + & 164,0.004, 0, 38, 30, 38, 30, 23, + & 164,0.004, 0, 75, 93, 38, 30, 0, + & 164,0.001, 0, 86,104, 0, 0, 0, + & 164,0.001, 0, 79, 97, 0, 0, 0, + & 164,0.001, 0, 81, 99, 0, 0, 0, + & 164,0.003, 0, 23, 23, 34, 46, 0, + & 164,0.002, 0, 73, 91, 38, 30, 21, + & 164,0.002, 0, 73, 91, 0, 0, 0, + & 164,0.002, 0, 73, 91, 22, 0, 0, + & 164,0.002, 0, 73, 93, 30, 0, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 742, 760)/ + & 164,0.002, 0, 75, 93, 0, 0, 0, + & 164,0.001, 0, 83,102, 0, 0, 0, + & 164,0.001, 0, 88,106, 0, 0, 0, + & 164,0.001, 0, 78, 96, 0, 0, 0, + & 164,0.001, 0, 73, 91, 21, 0, 0, + & 164,0.001, 0, 78,104, 38, 0, 0, + & 164,0.001, 0, 96, 86, 30, 0, 0, + & 164,0.001, 0, 73, 34, 96, 0, 0, + & 164,0.001, 0, 91, 46, 78, 0, 0, + & 164,0.001, 0, 46, 34, 46, 34, 0, + & 164,0.013, 0, 59,163, 0, 0, 0, + & 164,0.008, 0, 59, 38, 30, 21, 21, + & 164,0.004, 0, 59, 22, 38, 30, 0, + & 164,0.002, 0, 59, 22, 21, 21, 0, + & 164,0.003, 0, 59, 39, 31, 0, 0, + & 164,0.002, 0, 59, 23, 23, 0, 0, + & 164,0.004, 0, 59, 25, 0, 0, 0, + & 164,0.003, 0, 59, 38, 30, 38, 30, + & 164,0.002, 0, 59, 24, 24, 0, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 761, 779)/ + & 164,0.001, 0, 59, 26, 0, 0, 0, + & 164,0.001, 0, 59, 22, 0, 0, 0, + & 164,0.001, 0, 59, 28, 0, 0, 0, + & 164,0.001, 0, 59, 58, 0, 0, 0, + & 164,0.020, 0, 1, 7, 0, 0, 0, + & 164,0.080, 0, 2, 8, 0, 0, 0, + & 164,0.020, 0, 3, 9, 0, 0, 0, + & 164,0.364,130, 13, 13, 13, 0, 0, + & 164,0.091,130, 13, 13, 59, 0, 0, + & 165,0.037, 0, 38, 30, 38, 30, 0, + & 165,0.030, 0, 38, 30, 46, 34, 0, + & 165,0.016, 0, 23, 38, 30, 0, 0, + & 165,0.015, 0, 23, 38, 30, 38, 30, + & 165,0.004, 0, 46, 43, 30, 0, 0, + & 165,0.002, 0, 46, 35, 21, 0, 0, + & 165,0.002, 0, 51, 43, 21, 0, 0, + & 165,0.004, 0, 51, 35, 38, 0, 0, + & 165,0.008, 0, 38, 30, 0, 0, 0, + & 165,0.007, 0, 46, 34, 0, 0, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 780, 798)/ + & 165,0.005, 0, 38, 30, 73, 91, 0, + & 165,0.003, 0, 21, 21, 0, 0, 0, + & 165,0.003, 0, 22, 22, 0, 0, 0, + & 165,0.007, 0, 59,164, 0, 0, 0, + & 165,0.857, 0, 13, 13, 0, 0, 0, + & 166,0.008, 0,121,127, 0, 0, 0, + & 166,0.008, 0,123,129, 0, 0, 0, + & 166,0.001, 0,125,131, 0, 0, 0, + & 166,0.338, 0,164, 38, 30, 0, 0, + & 166,0.169, 0,164, 21, 21, 0, 0, + & 166,0.027, 0,164, 22, 0, 0, 0, + & 166,0.001, 0,164, 21, 0, 0, 0, + & 166,0.004, 0, 23, 23, 23, 21, 0, + & 166,0.003, 0, 23, 23, 21, 0, 0, + & 166,0.002, 0, 38, 30, 46, 34, 0, + & 166,0.001, 0, 38, 30, 73, 91, 0, + & 166,0.093, 0, 59,165, 0, 0, 0, + & 166,0.087, 0, 59,302, 0, 0, 0, + & 166,0.078, 0, 59,303, 0, 0, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 799, 817)/ + & 166,0.003, 0, 59,163, 0, 0, 0, + & 166,0.003, 0, 1, 7, 0, 0, 0, + & 166,0.012, 0, 2, 8, 0, 0, 0, + & 166,0.003, 0, 3, 9, 0, 0, 0, + & 166,0.127,130, 13, 13, 13, 0, 0, + & 166,0.032,130, 13, 13, 59, 0, 0, + & 167,0.500, 0,136,171, 0, 0, 0, + & 167,0.500, 0,140,175, 0, 0, 0, + & 171,0.067,101,128,121, 50, 0, 0, + & 171,0.067,101,130,123, 50, 0, 0, + & 171,0.048,101,128,121, 51, 0, 0, + & 171,0.048,101,130,123, 51, 0, 0, + & 171,0.003, 0,128,121, 46, 30, 0, + & 171,0.003, 0,130,123, 46, 30, 0, + & 171,0.006,101,128,121, 21, 0, 0, + & 171,0.006,101,130,123, 21, 0, 0, + & 171,0.002,101,128,121, 23, 0, 0, + & 171,0.002,101,130,123, 23, 0, 0, + & 171,0.055, 0, 46, 30, 30, 0, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 818, 836)/ + & 171,0.031, 0, 46, 31, 30, 0, 0, + & 171,0.042, 0, 46, 30, 30, 21, 21, + & 171,0.002, 0, 46, 30, 30, 30, 39, + & 171,0.021, 0, 47, 30, 30, 0, 0, + & 171,0.027, 0, 50, 30, 0, 0, 0, + & 171,0.066, 0, 50, 31, 0, 0, 0, + & 171,0.081, 0, 50, 32, 0, 0, 0, + & 171,0.024, 0, 50, 30, 21, 0, 0, + & 171,0.004, 0, 50, 30, 23, 0, 0, + & 171,0.069, 0, 50, 30, 30, 38, 21, + & 171,0.001, 0, 50, 30, 30, 38, 23, + & 171,0.022, 0, 51, 30, 0, 0, 0, + & 171,0.021, 0, 51, 31, 0, 0, 0, + & 171,0.042, 0, 51, 30, 21, 0, 0, + & 171,0.008, 0, 51, 30, 23, 0, 0, + & 171,0.010, 0, 51, 30, 30, 38, 0, + & 171,0.050, 0,309, 30, 0, 0, 0, + & 171,0.034, 0,328, 30, 0, 0, 0, + & 171,0.010, 0,368, 30, 0, 0, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 837, 855)/ + & 171,0.031, 0, 34, 50, 50, 0, 0, + & 171,0.003, 0, 30, 21, 0, 0, 0, + & 171,0.001, 0, 30, 23, 0, 0, 0, + & 171,0.002, 0, 30, 30, 38, 0, 0, + & 171,0.008, 0, 30, 22, 0, 0, 0, + & 171,0.001, 0, 30, 30, 30, 38, 38, + & 171,0.003, 0, 30, 30, 30, 38, 39, + & 171,0.008, 0, 34, 50, 0, 0, 0, + & 171,0.005, 0, 34, 51, 0, 0, 0, + & 171,0.026, 0, 35, 51, 0, 0, 0, + & 171,0.005, 0, 34, 46, 30, 0, 0, + & 171,0.007, 0, 30, 56, 0, 0, 0, + & 171,0.023, 0, 30, 56, 21, 0, 0, + & 171,0.005, 0, 34, 34, 46, 0, 0, + & 172,0.683, 0,175, 30, 0, 0, 0, + & 172,0.306, 0,171, 21, 0, 0, 0, + & 172,0.011, 0,171, 59, 0, 0, 0, + & 173,0.667, 0,176, 30, 0, 0, 0, + & 173,0.333, 0,172, 21, 0, 0, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 856, 874)/ + & 174,0.220, 0,175, 30, 0, 0, 0, + & 174,0.110, 0,171, 21, 0, 0, 0, + & 174,0.380, 0,176, 30, 0, 0, 0, + & 174,0.190, 0,172, 21, 0, 0, 0, + & 174,0.004, 0,171, 22, 0, 0, 0, + & 174,0.064, 0,176, 30, 21, 0, 0, + & 174,0.032, 0,172, 38, 30, 0, 0, + & 175,0.037,101,128,121, 46, 0, 0, + & 175,0.037,101,130,123, 46, 0, 0, + & 175,0.016,101,128,121, 47, 0, 0, + & 175,0.016,101,130,123, 47, 0, 0, + & 175,0.013, 0,128,121, 46, 21, 0, + & 175,0.013, 0,130,123, 46, 21, 0, + & 175,0.012, 0,128,121, 50, 38, 0, + & 175,0.012, 0,130,123, 50, 38, 0, + & 175,0.003,101,128,121, 38, 0, 0, + & 175,0.003,101,130,123, 38, 0, 0, + & 175,0.039, 0, 46, 30, 0, 0, 0, + & 175,0.091, 0, 46, 31, 0, 0, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 875, 893)/ + & 175,0.067, 0, 46, 32, 0, 0, 0, + & 175,0.004, 0, 46, 30, 21, 0, 0, + & 175,0.100, 0, 46, 30, 21, 21, 0, + & 175,0.058, 0, 46, 30, 23, 0, 0, + & 175,0.020, 0, 46, 30, 24, 0, 0, + & 175,0.006, 0, 46, 30, 25, 0, 0, + & 175,0.043, 0, 47, 30, 0, 0, 0, + & 175,0.035, 0, 47, 31, 0, 0, 0, + & 175,0.007, 0,310, 30, 0, 0, 0, + & 175,0.007, 0,327, 30, 0, 0, 0, + & 175,0.020, 0, 50, 21, 0, 0, 0, + & 175,0.006, 0, 50, 22, 0, 0, 0, + & 175,0.009, 0, 50, 23, 0, 0, 0, + & 175,0.016, 0, 50, 24, 0, 0, 0, + & 175,0.014, 0, 50, 25, 0, 0, 0, + & 175,0.003, 0, 50,293, 0, 0, 0, + & 175,0.007, 0, 50, 56, 0, 0, 0, + & 175,0.003, 0, 50, 26, 0, 0, 0, + & 175,0.004, 0, 50,294, 0, 0, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 894, 912)/ + & 175,0.006, 0, 50, 21, 21, 0, 0, + & 175,0.042, 0, 50, 30, 38, 21, 0, + & 175,0.004, 0, 50, 30, 30, 38, 38, + & 175,0.076, 0, 50, 30, 38, 21, 21, + & 175,0.026, 0, 51, 21, 0, 0, 0, + & 175,0.014, 0, 51, 22, 0, 0, 0, + & 175,0.014, 0, 51, 23, 0, 0, 0, + & 175,0.011, 0, 51, 24, 0, 0, 0, + & 175,0.018, 0, 51, 30, 38, 0, 0, + & 175,0.004, 0, 50, 34, 46, 0, 0, + & 175,0.004, 0, 50, 34, 46, 21, 0, + & 175,0.005, 0, 50, 50, 42, 0, 0, + & 175,0.002, 0, 30, 38, 0, 0, 0, + & 175,0.001, 0, 21, 21, 0, 0, 0, + & 175,0.008, 0, 30, 38, 21, 0, 0, + & 175,0.007, 0, 30, 30, 38, 38, 0, + & 175,0.015, 0, 30, 30, 38, 38, 21, + & 175,0.004, 0, 34, 46, 0, 0, 0, + & 175,0.003, 0, 35, 46, 0, 0, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 913, 931)/ + & 175,0.002, 0, 34, 47, 0, 0, 0, + & 175,0.001, 0, 42, 50, 0, 0, 0, + & 175,0.002, 0, 43, 51, 0, 0, 0, + & 175,0.003, 0, 42, 46, 30, 0, 0, + & 175,0.003, 0, 50, 34, 38, 0, 0, + & 175,0.001, 0, 34, 46, 30, 38, 21, + & 175,0.002, 0, 56, 23, 0, 0, 0, + & 175,0.001, 0, 56, 30, 38, 0, 0, + & 176,0.636, 0,175, 21, 0, 0, 0, + & 176,0.364, 0,175, 59, 0, 0, 0, + & 177,0.667, 0,172, 38, 0, 0, 0, + & 177,0.333, 0,176, 21, 0, 0, 0, + & 178,0.220, 0,171, 38, 0, 0, 0, + & 178,0.110, 0,175, 21, 0, 0, 0, + & 178,0.380, 0,172, 38, 0, 0, 0, + & 178,0.190, 0,176, 21, 0, 0, 0, + & 178,0.004, 0,175, 22, 0, 0, 0, + & 178,0.064, 0,172, 38, 21, 0, 0, + & 178,0.032, 0,176, 38, 30, 0, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 932, 950)/ + & 179,0.009, 0,130,123, 0, 0, 0, + & 179,0.019,101,128,121, 56, 0, 0, + & 179,0.019,101,130,123, 56, 0, 0, + & 179,0.025,101,128,121, 22, 0, 0, + & 179,0.025,101,130,123, 22, 0, 0, + & 179,0.009,101,128,121, 25, 0, 0, + & 179,0.009,101,130,123, 25, 0, 0, + & 179,0.036, 0, 34, 50, 0, 0, 0, + & 179,0.034, 0, 34, 51, 0, 0, 0, + & 179,0.007, 0, 34,328, 0, 0, 0, + & 179,0.043, 0, 35, 50, 0, 0, 0, + & 179,0.058, 0, 35, 51, 0, 0, 0, + & 179,0.011, 0, 34, 46, 30, 0, 0, + & 179,0.055, 0, 34, 46, 30, 21, 0, + & 179,0.003, 0, 34, 46, 30, 38, 30, + & 179,0.014, 0, 34, 50, 38, 30, 0, + & 179,0.017, 0, 42, 46, 30, 30, 0, + & 179,0.036, 0, 56, 30, 0, 0, 0, + & 179,0.067, 0, 56, 31, 0, 0, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 951, 969)/ + & 179,0.023, 0, 56, 30, 21, 0, 0, + & 179,0.018, 0, 56, 30, 38, 30, 0, + & 179,0.020, 0, 22, 30, 0, 0, 0, + & 179,0.001, 0, 23, 30, 0, 0, 0, + & 179,0.009, 0, 24, 30, 0, 0, 0, + & 179,0.049, 0, 25, 30, 0, 0, 0, + & 179,0.011, 0,293, 30, 0, 0, 0, + & 179,0.015, 0, 22, 30, 21, 0, 0, + & 179,0.016, 0, 25, 30, 21, 0, 0, + & 179,0.103, 0, 22, 31, 0, 0, 0, + & 179,0.120, 0, 25, 31, 0, 0, 0, + & 179,0.010, 0, 30, 38, 30, 0, 0, + & 179,0.046, 0, 30, 38, 30, 21, 0, + & 179,0.003, 0, 30, 38, 38, 30, 30, + & 179,0.042, 0, 30, 38, 38, 30, 31, + & 179,0.001, 0, 34, 23, 0, 0, 0, + & 179,0.005, 0, 34, 38, 30, 0, 0, + & 179,0.001, 0, 34, 56, 0, 0, 0, + & 179,0.004, 0, 42, 30, 0, 0, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 970, 988)/ + & 179,0.007, 0, 43, 30, 0, 0, 0, + & 180,0.900, 0,179, 59, 0, 0, 0, + & 180,0.100, 0,179, 21, 0, 0, 0, + & 181,0.500, 0,172, 42, 0, 0, 0, + & 181,0.500, 0,176, 34, 0, 0, 0, + & 182,0.440, 0,171, 42, 0, 0, 0, + & 182,0.440, 0,175, 34, 0, 0, 0, + & 182,0.055, 0,172, 42, 0, 0, 0, + & 182,0.055, 0,176, 34, 0, 0, 0, + & 182,0.010, 0,179, 22, 0, 0, 0, + & 183,1.000, 0,185, 30, 0, 0, 0, + & 184,1.000, 0,185, 30, 0, 0, 0, + & 185,0.028,101,128,121, 96, 0, 0, + & 185,0.010,101,128,121, 98, 0, 0, + & 185,0.028,101,130,123, 96, 0, 0, + & 185,0.010,101,130,123, 98, 0, 0, + & 185,0.026, 0, 91, 50, 0, 0, 0, + & 185,0.030, 0, 91, 50, 21, 0, 0, + & 185,0.029, 0, 91, 50, 38, 30, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 989,1007)/ + & 185,0.014, 0, 91, 50, 22, 0, 0, + & 185,0.020, 0, 91, 51, 0, 0, 0, + & 185,0.029, 0, 91, 46, 30, 0, 0, + & 185,0.039, 0, 91, 46, 30, 21, 0, + & 185,0.002, 0, 91, 46, 30, 30, 38, + & 185,0.010, 0, 91, 46, 30, 21, 21, + & 185,0.014, 0, 91, 47, 30, 0, 0, + & 185,0.010, 0, 92, 50, 0, 0, 0, + & 185,0.020, 0, 92, 51, 0, 0, 0, + & 185,0.010, 0, 92, 51, 21, 0, 0, + & 185,0.007, 0,103, 46, 0, 0, 0, + & 185,0.014, 0,103, 47, 0, 0, 0, + & 185,0.004, 0, 91,293, 0, 0, 0, + & 185,0.003, 0, 91, 38, 30, 0, 0, + & 185,0.003, 0, 91, 38, 30, 38, 30, + & 185,0.001, 0, 91, 56, 0, 0, 0, + & 185,0.002, 0, 91, 46, 34, 0, 0, + & 185,0.010, 0, 96, 30, 0, 0, 0, + & 185,0.020, 0, 96, 31, 0, 0, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1008,1026)/ + & 185,0.030, 0, 96, 30, 21, 0, 0, + & 185,0.010, 0, 96, 30, 22, 0, 0, + & 185,0.020, 0, 96, 30, 24, 0, 0, + & 185,0.035, 0, 96, 30, 30, 38, 0, + & 185,0.020, 0, 96, 30, 21, 21, 0, + & 185,0.010, 0, 96, 30, 38, 30, 21, + & 185,0.010, 0, 96, 30, 21, 21, 21, + & 185,0.007, 0, 96, 34, 50, 0, 0, + & 185,0.011, 0, 97, 30, 0, 0, 0, + & 185,0.022, 0, 97, 30, 21, 0, 0, + & 185,0.013, 0, 97, 30, 38, 30, 0, + & 185,0.010, 0, 97, 30, 21, 21, 0, + & 185,0.007, 0, 97, 30, 38, 30, 21, + & 185,0.005, 0, 97, 30, 21, 21, 21, + & 185,0.005, 0, 98, 30, 0, 0, 0, + & 185,0.015, 0, 98, 31, 0, 0, 0, + & 185,0.011, 0,104, 21, 0, 0, 0, + & 185,0.007, 0,104, 22, 0, 0, 0, + & 185,0.010, 0,104, 23, 0, 0, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1027,1045)/ + & 185,0.031, 0,104, 24, 0, 0, 0, + & 185,0.010, 0,104, 25, 0, 0, 0, + & 185,0.004, 0,104, 56, 0, 0, 0, + & 185,0.026, 0,104, 38, 30, 0, 0, + & 185,0.005, 0,104, 38, 38, 30, 30, + & 185,0.005, 0,104, 38, 30, 21, 21, + & 185,0.005, 0,105, 21, 0, 0, 0, + & 185,0.006, 0,105, 23, 0, 0, 0, + & 185,0.004, 0,104, 46, 34, 0, 0, + & 185,0.002, 0,104, 34, 38, 0, 0, + & 185,0.001, 0,104, 34, 38, 21, 0, + & 185,0.016, 0, 99, 30, 30, 0, 0, + & 185,0.003, 0,106, 34, 0, 0, 0, + & 185,0.002, 0,107, 34, 0, 0, 0, + & 185,0.003, 0,101, 34, 30, 0, 0, + & 185,0.040, 0, 93, 34, 21, 0, 0, + & 185,0.040, 0, 93, 34, 38, 30, 0, + & 185,0.020, 0, 93, 34, 21, 21, 0, + & 185,0.010, 0, 93, 34, 38, 30, 21/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1046,1064)/ + & 185,0.010, 0, 93, 34, 21, 21, 21, + & 185,0.020, 0, 93, 35, 21, 0, 0, + & 185,0.040, 0, 93, 50, 30, 0, 0, + & 185,0.020, 0, 93, 50, 31, 0, 0, + & 185,0.010, 0, 93, 50, 30, 38, 30, + & 185,0.010, 0, 93, 50, 30, 21, 21, + & 185,0.006, 0, 93, 51, 30, 0, 0, + & 186,1.000, 0,185, 21, 0, 0, 0, + & 187,1.000, 0,185, 21, 0, 0, 0, + & 188,1.000, 0,185, 38, 0, 0, 0, + & 189,1.000, 0,185, 38, 0, 0, 0, + & 190,0.045,101,128,121,106, 0, 0, + & 190,0.005,101,128,121,107, 0, 0, + & 190,0.045,101,130,123,106, 0, 0, + & 190,0.005,101,130,123,107, 0, 0, + & 190,0.021, 0,104, 50, 0, 0, 0, + & 190,0.032, 0,105, 50, 0, 0, 0, + & 190,0.032, 0, 97, 30, 50, 0, 0, + & 190,0.045, 0,104, 51, 0, 0, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1065,1083)/ + & 190,0.065, 0,105, 51, 0, 0, 0, + & 190,0.065, 0, 97, 30, 51, 0, 0, + & 190,0.055, 0,106, 30, 0, 0, 0, + & 190,0.160, 0,106, 31, 0, 0, 0, + & 190,0.105, 0,107, 30, 0, 0, 0, + & 190,0.320, 0,107, 31, 0, 0, 0, + & 191,1.000, 0,190, 59, 0, 0, 0, + & 192,0.667, 0,193, 30, 0, 0, 0, + & 192,0.333, 0,190, 21, 0, 0, 0, + & 193,0.045,101,128,121,101, 0, 0, + & 193,0.045,101,130,123,101, 0, 0, + & 193,0.005,101,128,121,102, 0, 0, + & 193,0.005,101,130,123,102, 0, 0, + & 193,0.020, 0, 97, 50, 0, 0, 0, + & 193,0.020, 0, 97, 21, 50, 0, 0, + & 193,0.020, 0, 98, 50, 0, 0, 0, + & 193,0.060, 0, 97, 51, 0, 0, 0, + & 193,0.060, 0, 97, 21, 51, 0, 0, + & 193,0.060, 0, 98, 51, 0, 0, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1084,1102)/ + & 193,0.020, 0,104, 46, 0, 0, 0, + & 193,0.060, 0,104, 47, 0, 0, 0, + & 193,0.040, 0,105, 46, 0, 0, 0, + & 193,0.120, 0,105, 47, 0, 0, 0, + & 193,0.020, 0,101, 30, 0, 0, 0, + & 193,0.060, 0,101, 31, 0, 0, 0, + & 193,0.040, 0,102, 30, 0, 0, 0, + & 193,0.120, 0,102, 31, 0, 0, 0, + & 193,0.010, 0,106, 21, 0, 0, 0, + & 193,0.030, 0,106, 23, 0, 0, 0, + & 193,0.020, 0,107, 21, 0, 0, 0, + & 193,0.060, 0,107, 23, 0, 0, 0, + & 193,0.030, 0,106, 56, 0, 0, 0, + & 193,0.030, 0,108, 34, 0, 0, 0, + & 194,1.000, 0,193, 59, 0, 0, 0, + & 195,0.670, 0,190, 38, 0, 0, 0, + & 195,0.330, 0,193, 21, 0, 0, 0, + & 196,0.050,101,128,121,108, 0, 0, + & 196,0.050,101,130,123,108, 0, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1103,1121)/ + & 196,0.075, 0,106, 50, 0, 0, 0, + & 196,0.225, 0,106, 51, 0, 0, 0, + & 196,0.150, 0,107, 50, 0, 0, 0, + & 196,0.450, 0,107, 51, 0, 0, 0, + & 197,1.000, 0,196, 59, 0, 0, 0, + & 209,0.250,100, 1, 8, 4, 0, 0, + & 209,0.250,100, 3, 10, 4, 0, 0, + & 209,0.250,100, 5, 12, 4, 0, 0, + & 209,0.085,100,121,128, 4, 0, 0, + & 209,0.085,100,123,130, 4, 0, 0, + & 209,0.080,100,125,132, 4, 0, 0, + & 210,0.250,100, 2, 7,209, 0, 0, + & 210,0.250,100, 4, 9,209, 0, 0, + & 210,0.250,100, 6, 11,209, 0, 0, + & 210,0.085,100,122,127,209, 0, 0, + & 210,0.085,100,124,129,209, 0, 0, + & 210,0.080,100,126,131,209, 0, 0, + & 211,0.250,100, 1, 8, 6, 0, 0, + & 211,0.250,100, 3, 10, 6, 0, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1122,1140)/ + & 211,0.250,100, 5, 12, 6, 0, 0, + & 211,0.085,100,121,128, 6, 0, 0, + & 211,0.085,100,123,130, 6, 0, 0, + & 211,0.080,100,125,132, 6, 0, 0, + & 212,0.250,100, 2, 7,211, 0, 0, + & 212,0.250,100, 4, 9,211, 0, 0, + & 212,0.250,100, 6, 11,211, 0, 0, + & 212,0.085,100,122,127,211, 0, 0, + & 212,0.085,100,124,129,211, 0, 0, + & 212,0.080,100,126,131,211, 0, 0, + & 215,0.250,100, 7, 2, 10, 0, 0, + & 215,0.250,100, 9, 4, 10, 0, 0, + & 215,0.250,100, 11, 6, 10, 0, 0, + & 215,0.085,100,127,122, 10, 0, 0, + & 215,0.085,100,129,124, 10, 0, 0, + & 215,0.080,100,131,126, 10, 0, 0, + & 216,0.250,100, 8, 1,215, 0, 0, + & 216,0.250,100, 10, 3,215, 0, 0, + & 216,0.250,100, 12, 5,215, 0, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1141,1159)/ + & 216,0.085,100,128,121,215, 0, 0, + & 216,0.085,100,130,123,215, 0, 0, + & 216,0.080,100,132,125,215, 0, 0, + & 217,0.250,100, 7, 2, 12, 0, 0, + & 217,0.250,100, 9, 4, 12, 0, 0, + & 217,0.250,100, 11, 6, 12, 0, 0, + & 217,0.085,100,127,122, 12, 0, 0, + & 217,0.085,100,129,124, 12, 0, 0, + & 217,0.080,100,131,126, 12, 0, 0, + & 218,0.250,100, 8, 1,217, 0, 0, + & 218,0.250,100, 10, 3,217, 0, 0, + & 218,0.250,100, 12, 5,217, 0, 0, + & 218,0.085,100,128,121,217, 0, 0, + & 218,0.085,100,130,123,217, 0, 0, + & 218,0.080,100,132,125,217, 0, 0, + & 221,0.016,101,121,128,136, 0, 0, + & 221,0.016,101,123,130,136, 0, 0, + & 221,0.008,101,125,132,136, 0, 0, + & 221,0.048,101,121,128,137, 0, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1160,1178)/ + & 221,0.048,101,123,130,137, 0, 0, + & 221,0.022,101,125,132,137, 0, 0, + & 221,0.003,101,121,128,331, 0, 0, + & 221,0.003,101,123,130,331, 0, 0, + & 221,0.001,101,125,132,331, 0, 0, + & 221,0.008,101,121,128,138, 0, 0, + & 221,0.008,101,123,130,138, 0, 0, + & 221,0.004,101,125,132,138, 0, 0, + & 221,0.008,101,121,128,313, 0, 0, + & 221,0.008,101,123,130,313, 0, 0, + & 221,0.004,101,125,132,313, 0, 0, + & 221,0.013,101,121,128,139, 0, 0, + & 221,0.013,101,123,130,139, 0, 0, + & 221,0.006,101,125,132,139, 0, 0, + & 221,0.004, 0,136, 30, 0, 0, 0, + & 221,0.010, 0,136, 31, 0, 0, 0, + & 221,0.006, 0,136, 32, 0, 0, 0, + & 221,0.003, 0,137, 30, 0, 0, 0, + & 221,0.009, 0,137, 31, 0, 0, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1179,1197)/ + & 221,0.017, 0,137, 32, 0, 0, 0, + & 221,0.011, 0,136,179, 0, 0, 0, + & 221,0.015, 0,136,180, 0, 0, 0, + & 221,0.011, 0,137,179, 0, 0, 0, + & 221,0.022, 0,137,180, 0, 0, 0, + & 221,0.001, 0,164, 42, 0, 0, 0, + & 221,0.002, 0,164, 43, 0, 0, 0, + & 221,0.001, 0,165, 42, 0, 0, 0, + & 221,0.001, 0,165, 43, 0, 0, 0, + & 221,0.001, 0,166, 42, 0, 0, 0, + & 221,0.001, 0,166, 43, 0, 0, 0, + & 221,0.207,100, 1, 8, 4, 7, 0, + & 221,0.207,100, 3, 10, 4, 7, 0, + & 221,0.024,100, 1, 8, 2, 7, 0, + & 221,0.024,100, 3, 10, 2, 7, 0, + & 221,0.012,100, 3, 8, 4, 7, 0, + & 221,0.012,100, 1, 10, 4, 7, 0, + & 221,0.069,100, 4, 8, 1, 7, 0, + & 221,0.069,100, 4, 10, 3, 7, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1198,1216)/ + & 221,0.008,100, 2, 8, 1, 7, 0, + & 221,0.008,100, 2, 10, 3, 7, 0, + & 221,0.004,100, 4, 8, 3, 7, 0, + & 221,0.004,100, 4, 10, 1, 7, 0, + & 222,0.016,101,121,128,140, 0, 0, + & 222,0.016,101,123,130,140, 0, 0, + & 222,0.008,101,125,132,140, 0, 0, + & 222,0.048,101,121,128,141, 0, 0, + & 222,0.048,101,123,130,141, 0, 0, + & 222,0.022,101,125,132,141, 0, 0, + & 222,0.003,101,121,128,332, 0, 0, + & 222,0.003,101,123,130,332, 0, 0, + & 222,0.001,101,125,132,332, 0, 0, + & 222,0.008,101,121,128,142, 0, 0, + & 222,0.008,101,123,130,142, 0, 0, + & 222,0.004,101,125,132,142, 0, 0, + & 222,0.008,101,121,128,314, 0, 0, + & 222,0.008,101,123,130,314, 0, 0, + & 222,0.004,101,125,132,314, 0, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1217,1235)/ + & 222,0.013,101,121,128,143, 0, 0, + & 222,0.013,101,123,130,143, 0, 0, + & 222,0.006,101,125,132,143, 0, 0, + & 222,0.004, 0,140, 30, 0, 0, 0, + & 222,0.010, 0,140, 31, 0, 0, 0, + & 222,0.006, 0,140, 32, 0, 0, 0, + & 222,0.003, 0,141, 30, 0, 0, 0, + & 222,0.009, 0,141, 31, 0, 0, 0, + & 222,0.017, 0,141, 32, 0, 0, 0, + & 222,0.011, 0,140,179, 0, 0, 0, + & 222,0.015, 0,140,180, 0, 0, 0, + & 222,0.011, 0,141,179, 0, 0, 0, + & 222,0.022, 0,141,180, 0, 0, 0, + & 222,0.001, 0,164, 34, 0, 0, 0, + & 222,0.002, 0,164, 35, 0, 0, 0, + & 222,0.001, 0,165, 34, 0, 0, 0, + & 222,0.001, 0,165, 35, 0, 0, 0, + & 222,0.001, 0,166, 34, 0, 0, 0, + & 222,0.001, 0,166, 35, 0, 0, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1236,1254)/ + & 222,0.207,100, 1, 8, 4, 8, 0, + & 222,0.207,100, 3, 10, 4, 8, 0, + & 222,0.024,100, 1, 8, 2, 8, 0, + & 222,0.024,100, 3, 10, 2, 8, 0, + & 222,0.012,100, 3, 8, 4, 8, 0, + & 222,0.012,100, 1, 10, 4, 8, 0, + & 222,0.069,100, 4, 8, 1, 8, 0, + & 222,0.069,100, 4, 10, 3, 8, 0, + & 222,0.008,100, 2, 8, 1, 8, 0, + & 222,0.008,100, 2, 10, 3, 8, 0, + & 222,0.004,100, 4, 8, 3, 8, 0, + & 222,0.004,100, 4, 10, 1, 8, 0, + & 223,0.016,101,121,128,144, 0, 0, + & 223,0.016,101,123,130,144, 0, 0, + & 223,0.008,101,125,132,144, 0, 0, + & 223,0.048,101,121,128,145, 0, 0, + & 223,0.048,101,123,130,145, 0, 0, + & 223,0.022,101,125,132,145, 0, 0, + & 223,0.003,101,121,128,333, 0, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1255,1273)/ + & 223,0.003,101,123,130,333, 0, 0, + & 223,0.001,101,125,132,333, 0, 0, + & 223,0.008,101,121,128,146, 0, 0, + & 223,0.008,101,123,130,146, 0, 0, + & 223,0.004,101,125,132,146, 0, 0, + & 223,0.008,101,121,128,315, 0, 0, + & 223,0.008,101,123,130,315, 0, 0, + & 223,0.004,101,125,132,315, 0, 0, + & 223,0.013,101,121,128,147, 0, 0, + & 223,0.013,101,123,130,147, 0, 0, + & 223,0.006,101,125,132,147, 0, 0, + & 223,0.004, 0,144, 30, 0, 0, 0, + & 223,0.010, 0,144, 31, 0, 0, 0, + & 223,0.006, 0,144, 32, 0, 0, 0, + & 223,0.003, 0,145, 30, 0, 0, 0, + & 223,0.009, 0,145, 31, 0, 0, 0, + & 223,0.017, 0,145, 32, 0, 0, 0, + & 223,0.011, 0,144,179, 0, 0, 0, + & 223,0.015, 0,144,180, 0, 0, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1274,1292)/ + & 223,0.011, 0,145,179, 0, 0, 0, + & 223,0.022, 0,145,180, 0, 0, 0, + & 223,0.001, 0,164, 25, 0, 0, 0, + & 223,0.002, 0,164, 56, 0, 0, 0, + & 223,0.001, 0,165, 25, 0, 0, 0, + & 223,0.001, 0,165, 56, 0, 0, 0, + & 223,0.001, 0,166, 25, 0, 0, 0, + & 223,0.001, 0,166, 56, 0, 0, 0, + & 223,0.207,100, 1, 8, 4, 9, 0, + & 223,0.207,100, 3, 10, 4, 9, 0, + & 223,0.024,100, 1, 8, 2, 9, 0, + & 223,0.024,100, 3, 10, 2, 9, 0, + & 223,0.012,100, 3, 8, 4, 9, 0, + & 223,0.012,100, 1, 10, 4, 9, 0, + & 223,0.069,100, 4, 8, 1, 9, 0, + & 223,0.069,100, 4, 10, 3, 9, 0, + & 223,0.008,100, 2, 8, 1, 9, 0, + & 223,0.008,100, 2, 10, 3, 9, 0, + & 223,0.004,100, 4, 8, 3, 9, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1293,1311)/ + & 223,0.004,100, 4, 10, 1, 9, 0, + & 224,0.090,100,121,128, 4,109, 0, + & 224,0.090,100,123,130, 4,109, 0, + & 224,0.045,100,125,132, 4,109, 0, + & 224,0.010,100,121,128, 2,109, 0, + & 224,0.010,100,123,130, 2,109, 0, + & 224,0.005,100,125,132, 2,109, 0, + & 224,0.242,100, 1, 8, 4,109, 0, + & 224,0.242,100, 3, 10, 4,109, 0, + & 224,0.027,100, 1, 8, 2,109, 0, + & 224,0.027,100, 3, 10, 2,109, 0, + & 224,0.012,100, 3, 8, 4,109, 0, + & 224,0.012,100, 1, 10, 4,109, 0, + & 224,0.081,100, 4, 8, 1,109, 0, + & 224,0.081,100, 4, 10, 3,109, 0, + & 224,0.009,100, 2, 8, 1,109, 0, + & 224,0.009,100, 2, 10, 3,109, 0, + & 224,0.004,100, 4, 8, 3,109, 0, + & 224,0.004,100, 4, 10, 1,109, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1312,1330)/ + & 225,0.090,100,121,128, 4,110, 0, + & 225,0.090,100,123,130, 4,110, 0, + & 225,0.045,100,125,132, 4,110, 0, + & 225,0.010,100,121,128, 2,110, 0, + & 225,0.010,100,123,130, 2,110, 0, + & 225,0.005,100,125,132, 2,110, 0, + & 225,0.242,100, 1, 8, 4,110, 0, + & 225,0.242,100, 3, 10, 4,110, 0, + & 225,0.027,100, 1, 8, 2,110, 0, + & 225,0.027,100, 3, 10, 2,110, 0, + & 225,0.012,100, 3, 8, 4,110, 0, + & 225,0.012,100, 1, 10, 4,110, 0, + & 225,0.081,100, 4, 8, 1,110, 0, + & 225,0.081,100, 4, 10, 3,110, 0, + & 225,0.009,100, 2, 8, 1,110, 0, + & 225,0.009,100, 2, 10, 3,110, 0, + & 225,0.004,100, 4, 8, 3,110, 0, + & 225,0.004,100, 4, 10, 1,110, 0, + & 226,0.090,100,121,128, 4,111, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1331,1349)/ + & 226,0.090,100,123,130, 4,111, 0, + & 226,0.045,100,125,132, 4,111, 0, + & 226,0.010,100,121,128, 2,111, 0, + & 226,0.010,100,123,130, 2,111, 0, + & 226,0.005,100,125,132, 2,111, 0, + & 226,0.242,100, 1, 8, 4,111, 0, + & 226,0.242,100, 3, 10, 4,111, 0, + & 226,0.027,100, 1, 8, 2,111, 0, + & 226,0.027,100, 3, 10, 2,111, 0, + & 226,0.012,100, 3, 8, 4,111, 0, + & 226,0.012,100, 1, 10, 4,111, 0, + & 226,0.081,100, 4, 8, 1,111, 0, + & 226,0.081,100, 4, 10, 3,111, 0, + & 226,0.009,100, 2, 8, 1,111, 0, + & 226,0.009,100, 2, 10, 3,111, 0, + & 226,0.004,100, 4, 8, 3,111, 0, + & 226,0.004,100, 4, 10, 1,111, 0, + & 227,0.090,100,121,128, 4,112, 0, + & 227,0.090,100,123,130, 4,112, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1350,1368)/ + & 227,0.045,100,125,132, 4,112, 0, + & 227,0.010,100,121,128, 2,112, 0, + & 227,0.010,100,123,130, 2,112, 0, + & 227,0.005,100,125,132, 2,112, 0, + & 227,0.242,100, 1, 8, 4,112, 0, + & 227,0.242,100, 3, 10, 4,112, 0, + & 227,0.027,100, 1, 8, 2,112, 0, + & 227,0.027,100, 3, 10, 2,112, 0, + & 227,0.012,100, 3, 8, 4,112, 0, + & 227,0.012,100, 1, 10, 4,112, 0, + & 227,0.081,100, 4, 8, 1,112, 0, + & 227,0.081,100, 4, 10, 3,112, 0, + & 227,0.009,100, 2, 8, 1,112, 0, + & 227,0.009,100, 2, 10, 3,112, 0, + & 227,0.004,100, 4, 8, 3,112, 0, + & 227,0.004,100, 4, 10, 1,112, 0, + & 228,0.090,100,121,128, 4,113, 0, + & 228,0.090,100,123,130, 4,113, 0, + & 228,0.045,100,125,132, 4,113, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1369,1387)/ + & 228,0.010,100,121,128, 2,113, 0, + & 228,0.010,100,123,130, 2,113, 0, + & 228,0.005,100,125,132, 2,113, 0, + & 228,0.242,100, 1, 8, 4,113, 0, + & 228,0.242,100, 3, 10, 4,113, 0, + & 228,0.027,100, 1, 8, 2,113, 0, + & 228,0.027,100, 3, 10, 2,113, 0, + & 228,0.012,100, 3, 8, 4,113, 0, + & 228,0.012,100, 1, 10, 4,113, 0, + & 228,0.081,100, 4, 8, 1,113, 0, + & 228,0.081,100, 4, 10, 3,113, 0, + & 228,0.009,100, 2, 8, 1,113, 0, + & 228,0.009,100, 2, 10, 3,113, 0, + & 228,0.004,100, 4, 8, 3,113, 0, + & 228,0.004,100, 4, 10, 1,113, 0, + & 229,0.090,100,121,128, 4,114, 0, + & 229,0.090,100,123,130, 4,114, 0, + & 229,0.045,100,125,132, 4,114, 0, + & 229,0.010,100,121,128, 2,114, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1388,1406)/ + & 229,0.010,100,123,130, 2,114, 0, + & 229,0.005,100,125,132, 2,114, 0, + & 229,0.242,100, 1, 8, 4,114, 0, + & 229,0.242,100, 3, 10, 4,114, 0, + & 229,0.027,100, 1, 8, 2,114, 0, + & 229,0.027,100, 3, 10, 2,114, 0, + & 229,0.012,100, 3, 8, 4,114, 0, + & 229,0.012,100, 1, 10, 4,114, 0, + & 229,0.081,100, 4, 8, 1,114, 0, + & 229,0.081,100, 4, 10, 3,114, 0, + & 229,0.009,100, 2, 8, 1,114, 0, + & 229,0.009,100, 2, 10, 3,114, 0, + & 229,0.004,100, 4, 8, 3,114, 0, + & 229,0.004,100, 4, 10, 1,114, 0, + & 230,0.080,100,121,128, 4, 10, 0, + & 230,0.080,100,123,130, 4, 10, 0, + & 230,0.040,100,125,132, 4, 10, 0, + & 230,0.080,100,121,128, 9, 5, 0, + & 230,0.080,100,123,130, 9, 5, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1407,1425)/ + & 230,0.228,100, 1, 8, 4, 10, 0, + & 230,0.228,100, 3, 10, 4, 10, 0, + & 230,0.012,100, 3, 8, 4, 10, 0, + & 230,0.012,100, 1, 10, 4, 10, 0, + & 230,0.076,100, 4, 8, 1, 10, 0, + & 230,0.076,100, 4, 10, 3, 10, 0, + & 230,0.004,100, 4, 8, 3, 10, 0, + & 230,0.004,100, 4, 10, 1, 10, 0, + & 231,0.025, 0,121,127, 0, 0, 0, + & 231,0.025, 0,123,129, 0, 0, 0, + & 231,0.025, 0,125,131, 0, 0, 0, + & 231,0.008, 0, 1, 7, 0, 0, 0, + & 231,0.033, 0, 2, 8, 0, 0, 0, + & 231,0.008, 0, 3, 9, 0, 0, 0, + & 231,0.033, 0, 4, 10, 0, 0, 0, + & 231,0.801,130, 13, 13, 13, 0, 0, + & 231,0.042,130, 13, 13, 59, 0, 0, + & 245,0.016,101,127,122,171, 0, 0, + & 245,0.016,101,129,124,171, 0, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1426,1444)/ + & 245,0.008,101,131,126,171, 0, 0, + & 245,0.048,101,127,122,172, 0, 0, + & 245,0.048,101,129,124,172, 0, 0, + & 245,0.022,101,131,126,172, 0, 0, + & 245,0.003,101,127,122,334, 0, 0, + & 245,0.003,101,129,124,334, 0, 0, + & 245,0.001,101,131,126,334, 0, 0, + & 245,0.008,101,127,122,173, 0, 0, + & 245,0.008,101,129,124,173, 0, 0, + & 245,0.004,101,131,126,173, 0, 0, + & 245,0.008,101,127,122,316, 0, 0, + & 245,0.008,101,129,124,316, 0, 0, + & 245,0.004,101,131,126,316, 0, 0, + & 245,0.013,101,127,122,174, 0, 0, + & 245,0.013,101,129,124,174, 0, 0, + & 245,0.006,101,131,126,174, 0, 0, + & 245,0.004, 0,171, 38, 0, 0, 0, + & 245,0.010, 0,171, 39, 0, 0, 0, + & 245,0.006, 0,171, 40, 0, 0, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1445,1463)/ + & 245,0.003, 0,172, 38, 0, 0, 0, + & 245,0.009, 0,172, 39, 0, 0, 0, + & 245,0.017, 0,172, 40, 0, 0, 0, + & 245,0.011, 0,171,144, 0, 0, 0, + & 245,0.015, 0,171,145, 0, 0, 0, + & 245,0.011, 0,172,144, 0, 0, 0, + & 245,0.022, 0,172,145, 0, 0, 0, + & 245,0.001, 0,164, 50, 0, 0, 0, + & 245,0.002, 0,164, 51, 0, 0, 0, + & 245,0.001, 0,165, 50, 0, 0, 0, + & 245,0.001, 0,165, 51, 0, 0, 0, + & 245,0.001, 0,166, 50, 0, 0, 0, + & 245,0.001, 0,166, 51, 0, 0, 0, + & 245,0.207,100, 7, 2, 10, 1, 0, + & 245,0.207,100, 9, 4, 10, 1, 0, + & 245,0.024,100, 7, 2, 8, 1, 0, + & 245,0.024,100, 9, 4, 8, 1, 0, + & 245,0.012,100, 9, 2, 10, 1, 0, + & 245,0.012,100, 7, 4, 10, 1, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1464,1482)/ + & 245,0.069,100, 10, 2, 7, 1, 0, + & 245,0.069,100, 10, 4, 9, 1, 0, + & 245,0.008,100, 8, 2, 7, 1, 0, + & 245,0.008,100, 8, 4, 9, 1, 0, + & 245,0.004,100, 10, 2, 9, 1, 0, + & 245,0.004,100, 10, 4, 7, 1, 0, + & 246,0.016,101,127,122,175, 0, 0, + & 246,0.016,101,129,124,175, 0, 0, + & 246,0.008,101,131,126,175, 0, 0, + & 246,0.048,101,127,122,176, 0, 0, + & 246,0.048,101,129,124,176, 0, 0, + & 246,0.022,101,131,126,176, 0, 0, + & 246,0.003,101,127,122,335, 0, 0, + & 246,0.003,101,129,124,335, 0, 0, + & 246,0.001,101,131,126,335, 0, 0, + & 246,0.008,101,127,122,177, 0, 0, + & 246,0.008,101,129,124,177, 0, 0, + & 246,0.004,101,131,126,177, 0, 0, + & 246,0.008,101,127,122,317, 0, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1483,1501)/ + & 246,0.008,101,129,124,317, 0, 0, + & 246,0.004,101,131,126,317, 0, 0, + & 246,0.013,101,127,122,178, 0, 0, + & 246,0.013,101,129,124,178, 0, 0, + & 246,0.006,101,131,126,178, 0, 0, + & 246,0.004, 0,175, 38, 0, 0, 0, + & 246,0.010, 0,175, 39, 0, 0, 0, + & 246,0.006, 0,175, 40, 0, 0, 0, + & 246,0.003, 0,176, 38, 0, 0, 0, + & 246,0.009, 0,176, 39, 0, 0, 0, + & 246,0.017, 0,176, 40, 0, 0, 0, + & 246,0.011, 0,175,144, 0, 0, 0, + & 246,0.015, 0,175,145, 0, 0, 0, + & 246,0.011, 0,176,144, 0, 0, 0, + & 246,0.022, 0,176,145, 0, 0, 0, + & 246,0.001, 0,164, 46, 0, 0, 0, + & 246,0.002, 0,164, 47, 0, 0, 0, + & 246,0.001, 0,165, 46, 0, 0, 0, + & 246,0.001, 0,165, 47, 0, 0, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1502,1520)/ + & 246,0.001, 0,166, 46, 0, 0, 0, + & 246,0.001, 0,166, 47, 0, 0, 0, + & 246,0.207,100, 7, 2, 10, 2, 0, + & 246,0.207,100, 9, 4, 10, 2, 0, + & 246,0.024,100, 7, 2, 8, 2, 0, + & 246,0.024,100, 9, 4, 8, 2, 0, + & 246,0.012,100, 9, 2, 10, 2, 0, + & 246,0.012,100, 7, 4, 10, 2, 0, + & 246,0.069,100, 10, 2, 7, 2, 0, + & 246,0.069,100, 10, 4, 9, 2, 0, + & 246,0.008,100, 8, 2, 7, 2, 0, + & 246,0.008,100, 8, 4, 9, 2, 0, + & 246,0.004,100, 10, 2, 9, 2, 0, + & 246,0.004,100, 10, 4, 7, 2, 0, + & 247,0.016,101,127,122,179, 0, 0, + & 247,0.016,101,129,124,179, 0, 0, + & 247,0.008,101,131,126,179, 0, 0, + & 247,0.048,101,127,122,180, 0, 0, + & 247,0.048,101,129,124,180, 0, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1521,1539)/ + & 247,0.022,101,131,126,180, 0, 0, + & 247,0.003,101,127,122,336, 0, 0, + & 247,0.003,101,129,124,336, 0, 0, + & 247,0.001,101,131,126,336, 0, 0, + & 247,0.008,101,127,122,181, 0, 0, + & 247,0.008,101,129,124,181, 0, 0, + & 247,0.004,101,131,126,181, 0, 0, + & 247,0.008,101,127,122,318, 0, 0, + & 247,0.008,101,129,124,318, 0, 0, + & 247,0.004,101,131,126,318, 0, 0, + & 247,0.013,101,127,122,182, 0, 0, + & 247,0.013,101,129,124,182, 0, 0, + & 247,0.006,101,131,126,182, 0, 0, + & 247,0.004, 0,179, 38, 0, 0, 0, + & 247,0.010, 0,179, 39, 0, 0, 0, + & 247,0.006, 0,179, 40, 0, 0, 0, + & 247,0.003, 0,180, 38, 0, 0, 0, + & 247,0.009, 0,180, 39, 0, 0, 0, + & 247,0.017, 0,180, 40, 0, 0, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1540,1558)/ + & 247,0.011, 0,179,144, 0, 0, 0, + & 247,0.015, 0,179,145, 0, 0, 0, + & 247,0.011, 0,180,144, 0, 0, 0, + & 247,0.022, 0,180,145, 0, 0, 0, + & 247,0.001, 0,164, 25, 0, 0, 0, + & 247,0.002, 0,164, 56, 0, 0, 0, + & 247,0.001, 0,165, 25, 0, 0, 0, + & 247,0.001, 0,165, 56, 0, 0, 0, + & 247,0.001, 0,166, 25, 0, 0, 0, + & 247,0.001, 0,166, 56, 0, 0, 0, + & 247,0.207,100, 7, 2, 10, 3, 0, + & 247,0.207,100, 9, 4, 10, 3, 0, + & 247,0.024,100, 7, 2, 8, 3, 0, + & 247,0.024,100, 9, 4, 8, 3, 0, + & 247,0.012,100, 9, 2, 10, 3, 0, + & 247,0.012,100, 7, 4, 10, 3, 0, + & 247,0.069,100, 10, 2, 7, 3, 0, + & 247,0.069,100, 10, 4, 9, 3, 0, + & 247,0.008,100, 8, 2, 7, 3, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1559,1577)/ + & 247,0.008,100, 8, 4, 9, 3, 0, + & 247,0.004,100, 10, 2, 9, 3, 0, + & 247,0.004,100, 10, 4, 7, 3, 0, + & 248,0.090,100,127,122, 10,115, 0, + & 248,0.090,100,129,124, 10,115, 0, + & 248,0.045,100,131,126, 10,115, 0, + & 248,0.010,100,127,122, 8,115, 0, + & 248,0.010,100,129,124, 8,115, 0, + & 248,0.005,100,131,126, 8,115, 0, + & 248,0.242,100, 7, 2, 10,115, 0, + & 248,0.242,100, 9, 4, 10,115, 0, + & 248,0.027,100, 7, 2, 8,115, 0, + & 248,0.027,100, 9, 4, 8,115, 0, + & 248,0.012,100, 9, 2, 10,115, 0, + & 248,0.012,100, 7, 4, 10,115, 0, + & 248,0.081,100, 10, 2, 7,115, 0, + & 248,0.081,100, 10, 4, 9,115, 0, + & 248,0.009,100, 8, 2, 7,115, 0, + & 248,0.009,100, 8, 4, 9,115, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1578,1596)/ + & 248,0.004,100, 10, 2, 9,115, 0, + & 248,0.004,100, 10, 4, 7,115, 0, + & 249,0.090,100,127,122, 10,116, 0, + & 249,0.090,100,129,124, 10,116, 0, + & 249,0.045,100,131,126, 10,116, 0, + & 249,0.010,100,127,122, 8,116, 0, + & 249,0.010,100,129,124, 8,116, 0, + & 249,0.005,100,131,126, 8,116, 0, + & 249,0.242,100, 7, 2, 10,116, 0, + & 249,0.242,100, 9, 4, 10,116, 0, + & 249,0.027,100, 7, 2, 8,116, 0, + & 249,0.027,100, 9, 4, 8,116, 0, + & 249,0.012,100, 9, 2, 10,116, 0, + & 249,0.012,100, 7, 4, 10,116, 0, + & 249,0.081,100, 10, 2, 7,116, 0, + & 249,0.081,100, 10, 4, 9,116, 0, + & 249,0.009,100, 8, 2, 7,116, 0, + & 249,0.009,100, 8, 4, 9,116, 0, + & 249,0.004,100, 10, 2, 9,116, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1597,1615)/ + & 249,0.004,100, 10, 4, 7,116, 0, + & 250,0.090,100,127,122, 10,117, 0, + & 250,0.090,100,129,124, 10,117, 0, + & 250,0.045,100,131,126, 10,117, 0, + & 250,0.010,100,127,122, 8,117, 0, + & 250,0.010,100,129,124, 8,117, 0, + & 250,0.005,100,131,126, 8,117, 0, + & 250,0.242,100, 7, 2, 10,117, 0, + & 250,0.242,100, 9, 4, 10,117, 0, + & 250,0.027,100, 7, 2, 8,117, 0, + & 250,0.027,100, 9, 4, 8,117, 0, + & 250,0.012,100, 9, 2, 10,117, 0, + & 250,0.012,100, 7, 4, 10,117, 0, + & 250,0.081,100, 10, 2, 7,117, 0, + & 250,0.081,100, 10, 4, 9,117, 0, + & 250,0.009,100, 8, 2, 7,117, 0, + & 250,0.009,100, 8, 4, 9,117, 0, + & 250,0.004,100, 10, 2, 9,117, 0, + & 250,0.004,100, 10, 4, 7,117, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1616,1634)/ + & 251,0.090,100,127,122, 10,118, 0, + & 251,0.090,100,129,124, 10,118, 0, + & 251,0.045,100,131,126, 10,118, 0, + & 251,0.010,100,127,122, 8,118, 0, + & 251,0.010,100,129,124, 8,118, 0, + & 251,0.005,100,131,126, 8,118, 0, + & 251,0.242,100, 7, 2, 10,118, 0, + & 251,0.242,100, 9, 4, 10,118, 0, + & 251,0.027,100, 7, 2, 8,118, 0, + & 251,0.027,100, 9, 4, 8,118, 0, + & 251,0.012,100, 9, 2, 10,118, 0, + & 251,0.012,100, 7, 4, 10,118, 0, + & 251,0.081,100, 10, 2, 7,118, 0, + & 251,0.081,100, 10, 4, 9,118, 0, + & 251,0.009,100, 8, 2, 7,118, 0, + & 251,0.009,100, 8, 4, 9,118, 0, + & 251,0.004,100, 10, 2, 9,118, 0, + & 251,0.004,100, 10, 4, 7,118, 0, + & 252,0.090,100,127,122, 10,119, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1635,1653)/ + & 252,0.090,100,129,124, 10,119, 0, + & 252,0.045,100,131,126, 10,119, 0, + & 252,0.010,100,127,122, 8,119, 0, + & 252,0.010,100,129,124, 8,119, 0, + & 252,0.005,100,131,126, 8,119, 0, + & 252,0.242,100, 7, 2, 10,119, 0, + & 252,0.242,100, 9, 4, 10,119, 0, + & 252,0.027,100, 7, 2, 8,119, 0, + & 252,0.027,100, 9, 4, 8,119, 0, + & 252,0.012,100, 9, 2, 10,119, 0, + & 252,0.012,100, 7, 4, 10,119, 0, + & 252,0.081,100, 10, 2, 7,119, 0, + & 252,0.081,100, 10, 4, 9,119, 0, + & 252,0.009,100, 8, 2, 7,119, 0, + & 252,0.009,100, 8, 4, 9,119, 0, + & 252,0.004,100, 10, 2, 9,119, 0, + & 252,0.004,100, 10, 4, 7,119, 0, + & 253,0.090,100,127,122, 10,120, 0, + & 253,0.090,100,129,124, 10,120, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1654,1672)/ + & 253,0.045,100,131,126, 10,120, 0, + & 253,0.010,100,127,122, 8,120, 0, + & 253,0.010,100,129,124, 8,120, 0, + & 253,0.005,100,131,126, 8,120, 0, + & 253,0.242,100, 7, 2, 10,120, 0, + & 253,0.242,100, 9, 4, 10,120, 0, + & 253,0.027,100, 7, 2, 8,120, 0, + & 253,0.027,100, 9, 4, 8,120, 0, + & 253,0.012,100, 9, 2, 10,120, 0, + & 253,0.012,100, 7, 4, 10,120, 0, + & 253,0.081,100, 10, 2, 7,120, 0, + & 253,0.081,100, 10, 4, 9,120, 0, + & 253,0.009,100, 8, 2, 7,120, 0, + & 253,0.009,100, 8, 4, 9,120, 0, + & 253,0.004,100, 10, 2, 9,120, 0, + & 253,0.004,100, 10, 4, 7,120, 0, + & 254,0.080,100,127,122, 10, 4, 0, + & 254,0.080,100,129,124, 10, 4, 0, + & 254,0.040,100,131,126, 10, 4, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1673,1691)/ + & 254,0.080,100,127,122, 3, 11, 0, + & 254,0.080,100,129,124, 3, 11, 0, + & 254,0.228,100, 7, 2, 10, 4, 0, + & 254,0.228,100, 9, 4, 10, 4, 0, + & 254,0.012,100, 9, 2, 10, 4, 0, + & 254,0.012,100, 7, 4, 10, 4, 0, + & 254,0.076,100, 10, 2, 7, 4, 0, + & 254,0.076,100, 10, 4, 9, 4, 0, + & 254,0.004,100, 10, 2, 9, 4, 0, + & 254,0.004,100, 10, 4, 7, 4, 0, + & 265,1.000, 0,221, 59, 0, 0, 0, + & 266,1.000, 0,222, 59, 0, 0, 0, + & 267,1.000, 0,223, 59, 0, 0, 0, + & 268,0.667, 0,266, 38, 0, 0, 0, + & 268,0.333, 0,265, 21, 0, 0, 0, + & 269,0.667, 0,265, 30, 0, 0, 0, + & 269,0.333, 0,266, 21, 0, 0, 0, + & 270,0.500, 0,265, 50, 0, 0, 0, + & 270,0.500, 0,266, 46, 0, 0, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1692,1710)/ + & 271,0.290, 0,266, 38, 0, 0, 0, + & 271,0.150, 0,265, 21, 0, 0, 0, + & 271,0.290, 0,222, 38, 0, 0, 0, + & 271,0.150, 0,221, 21, 0, 0, 0, + & 271,0.060, 0,266, 38, 21, 0, 0, + & 271,0.020, 0,265, 38, 30, 0, 0, + & 271,0.010, 0,265, 21, 21, 0, 0, + & 271,0.020, 0,222, 38, 21, 0, 0, + & 271,0.010, 0,221, 38, 30, 0, 0, + & 272,0.290, 0,265, 30, 0, 0, 0, + & 272,0.150, 0,266, 21, 0, 0, 0, + & 272,0.290, 0,221, 30, 0, 0, 0, + & 272,0.150, 0,222, 21, 0, 0, 0, + & 272,0.060, 0,265, 30, 21, 0, 0, + & 272,0.020, 0,266, 38, 30, 0, 0, + & 272,0.010, 0,266, 21, 21, 0, 0, + & 272,0.020, 0,221, 30, 21, 0, 0, + & 272,0.010, 0,222, 38, 30, 0, 0, + & 273,0.350, 0,221, 50, 0, 0, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1711,1729)/ + & 273,0.350, 0,222, 46, 0, 0, 0, + & 273,0.150, 0,265, 50, 0, 0, 0, + & 273,0.150, 0,266, 46, 0, 0, 0, + & 274,1.000, 0,245, 59, 0, 0, 0, + & 275,1.000, 0,246, 59, 0, 0, 0, + & 276,1.000, 0,247, 59, 0, 0, 0, + & 277,0.667, 0,275, 30, 0, 0, 0, + & 277,0.333, 0,274, 21, 0, 0, 0, + & 278,0.667, 0,274, 38, 0, 0, 0, + & 278,0.333, 0,275, 21, 0, 0, 0, + & 279,0.500, 0,274, 42, 0, 0, 0, + & 279,0.500, 0,275, 34, 0, 0, 0, + & 280,0.290, 0,275, 30, 0, 0, 0, + & 280,0.150, 0,274, 21, 0, 0, 0, + & 280,0.290, 0,246, 30, 0, 0, 0, + & 280,0.150, 0,245, 21, 0, 0, 0, + & 280,0.060, 0,275, 30, 21, 0, 0, + & 280,0.020, 0,274, 38, 30, 0, 0, + & 280,0.010, 0,274, 21, 21, 0, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1730,1748)/ + & 280,0.020, 0,246, 30, 21, 0, 0, + & 280,0.010, 0,245, 38, 30, 0, 0, + & 281,0.290, 0,274, 38, 0, 0, 0, + & 281,0.150, 0,275, 21, 0, 0, 0, + & 281,0.290, 0,245, 38, 0, 0, 0, + & 281,0.150, 0,246, 21, 0, 0, 0, + & 281,0.060, 0,274, 38, 21, 0, 0, + & 281,0.020, 0,275, 38, 30, 0, 0, + & 281,0.010, 0,275, 21, 21, 0, 0, + & 281,0.020, 0,245, 38, 21, 0, 0, + & 281,0.010, 0,246, 38, 30, 0, 0, + & 282,0.350, 0,245, 42, 0, 0, 0, + & 282,0.350, 0,246, 34, 0, 0, 0, + & 282,0.150, 0,274, 42, 0, 0, 0, + & 282,0.150, 0,275, 34, 0, 0, 0, + & 285,1.000, 0, 24, 21, 0, 0, 0, + & 286,0.998, 0, 24, 38, 0, 0, 0, + & 286,0.002, 0, 38, 59, 0, 0, 0, + & 287,0.998, 0, 24, 30, 0, 0, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1749,1767)/ + & 287,0.002, 0, 30, 59, 0, 0, 0, + & 288,0.330, 0, 39, 30, 0, 0, 0, + & 288,0.340, 0, 23, 21, 0, 0, 0, + & 288,0.330, 0, 31, 38, 0, 0, 0, + & 289,0.250, 0, 46, 35, 0, 0, 0, + & 289,0.250, 0, 34, 47, 0, 0, 0, + & 289,0.250, 0, 50, 43, 0, 0, 0, + & 289,0.250, 0, 42, 51, 0, 0, 0, + & 290,0.996, 0, 22, 21, 0, 0, 0, + & 290,0.002, 0, 46, 34, 0, 0, 0, + & 290,0.002, 0, 50, 42, 0, 0, 0, + & 291,0.996, 0, 22, 38, 0, 0, 0, + & 291,0.004, 0, 46, 42, 0, 0, 0, + & 292,0.996, 0, 22, 30, 0, 0, 0, + & 292,0.004, 0, 50, 34, 0, 0, 0, + & 293,0.520, 0, 38, 30, 0, 0, 0, + & 293,0.260, 0, 21, 21, 0, 0, 0, + & 293,0.110, 0, 46, 34, 0, 0, 0, + & 293,0.110, 0, 50, 42, 0, 0, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1768,1786)/ + & 294,0.620, 0, 38, 30, 0, 0, 0, + & 294,0.310, 0, 21, 21, 0, 0, 0, + & 294,0.035, 0, 46, 34, 0, 0, 0, + & 294,0.035, 0, 50, 42, 0, 0, 0, + & 295,1.000, 0,254, 59, 0, 0, 0, + & 296,1.000, 0,230, 59, 0, 0, 0, + & 297,1.000, 0,254, 59, 0, 0, 0, + & 298,1.000, 0,230, 59, 0, 0, 0, + & 299,1.000, 0,254, 59, 0, 0, 0, + & 300,1.000, 0,230, 59, 0, 0, 0, + & 301,0.050, 0,121,127, 0, 0, 0, + & 301,0.050, 0,123,129, 0, 0, 0, + & 301,0.017, 0, 1, 7, 0, 0, 0, + & 301,0.066, 0, 2, 8, 0, 0, 0, + & 301,0.017, 0, 3, 9, 0, 0, 0, + & 301,0.640,130, 13, 13, 13, 0, 0, + & 301,0.160,130, 13, 13, 59, 0, 0, + & 302,0.022, 0, 38, 30, 38, 30, 23, + & 302,0.016, 0, 38, 30, 38, 30, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1787,1805)/ + & 302,0.009, 0, 38, 30, 46, 34, 0, + & 302,0.004, 0, 23, 38, 30, 0, 0, + & 302,0.002, 0, 46, 43, 30, 0, 0, + & 302,0.002, 0, 34, 51, 38, 0, 0, + & 302,0.001, 0, 38, 30, 73, 91, 0, + & 302,0.273, 0, 59,164, 0, 0, 0, + & 302,0.671, 0, 13, 13, 0, 0, 0, + & 303,0.022, 0, 38, 30, 38, 30, 0, + & 303,0.019, 0, 38, 30, 46, 34, 0, + & 303,0.012, 0, 38, 30, 38, 30, 23, + & 303,0.007, 0, 23, 38, 30, 0, 0, + & 303,0.002, 0, 46, 43, 30, 0, 0, + & 303,0.002, 0, 34, 51, 38, 0, 0, + & 303,0.003, 0, 38, 30, 73, 91, 0, + & 303,0.002, 0, 38, 30, 0, 0, 0, + & 303,0.002, 0, 46, 34, 0, 0, 0, + & 303,0.001, 0, 21, 21, 0, 0, 0, + & 303,0.135, 0, 59,164, 0, 0, 0, + & 303,0.793, 0, 13, 13, 0, 0, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1806,1824)/ + & 304,1.000, 0, 13, 13, 0, 0, 0, + & 305,1.000, 0, 13, 13, 0, 0, 0, + & 306,0.050, 0, 59,231, 0, 0, 0, + & 306,0.950, 0, 13, 13, 0, 0, 0, + & 307,0.350, 0, 59,231, 0, 0, 0, + & 307,0.650, 0, 13, 13, 0, 0, 0, + & 308,0.220, 0, 59,231, 0, 0, 0, + & 308,0.780, 0, 13, 13, 0, 0, 0, + & 309,0.280, 0, 46, 31, 0, 0, 0, + & 309,0.140, 0, 50, 23, 0, 0, 0, + & 309,0.187, 0,327, 30, 0, 0, 0, + & 309,0.093, 0,328, 21, 0, 0, 0, + & 309,0.110, 0, 50, 24, 0, 0, 0, + & 309,0.107, 0, 47, 30, 0, 0, 0, + & 309,0.053, 0, 51, 21, 0, 0, 0, + & 309,0.030, 0, 50,293, 0, 0, 0, + & 310,0.280, 0, 50, 39, 0, 0, 0, + & 310,0.140, 0, 46, 23, 0, 0, 0, + & 310,0.187, 0,328, 38, 0, 0, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1825,1843)/ + & 310,0.093, 0,327, 21, 0, 0, 0, + & 310,0.110, 0, 46, 24, 0, 0, 0, + & 310,0.107, 0, 51, 38, 0, 0, 0, + & 310,0.053, 0, 47, 21, 0, 0, 0, + & 310,0.030, 0, 46,293, 0, 0, 0, + & 311,0.280, 0, 34, 39, 0, 0, 0, + & 311,0.140, 0, 42, 23, 0, 0, 0, + & 311,0.187, 0,330, 38, 0, 0, 0, + & 311,0.093, 0,329, 21, 0, 0, 0, + & 311,0.110, 0, 42, 24, 0, 0, 0, + & 311,0.107, 0, 35, 38, 0, 0, 0, + & 311,0.053, 0, 43, 21, 0, 0, 0, + & 311,0.030, 0, 42,293, 0, 0, 0, + & 312,0.280, 0, 42, 31, 0, 0, 0, + & 312,0.140, 0, 34, 23, 0, 0, 0, + & 312,0.187, 0,329, 30, 0, 0, 0, + & 312,0.093, 0,330, 21, 0, 0, 0, + & 312,0.110, 0, 34, 24, 0, 0, 0, + & 312,0.107, 0, 43, 30, 0, 0, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1844,1862)/ + & 312,0.053, 0, 35, 21, 0, 0, 0, + & 312,0.030, 0, 34,293, 0, 0, 0, + & 313,0.430, 0,140, 38, 0, 0, 0, + & 313,0.215, 0,136, 21, 0, 0, 0, + & 313,0.235, 0,140, 38, 21, 0, 0, + & 313,0.120, 0,136, 38, 30, 0, 0, + & 314,0.430, 0,136, 30, 0, 0, 0, + & 314,0.215, 0,140, 21, 0, 0, 0, + & 314,0.235, 0,136, 30, 21, 0, 0, + & 314,0.120, 0,140, 38, 30, 0, 0, + & 315,0.480, 0,136, 50, 0, 0, 0, + & 315,0.480, 0,140, 46, 0, 0, 0, + & 315,0.040, 0,145, 59, 0, 0, 0, + & 316,0.430, 0,175, 30, 0, 0, 0, + & 316,0.215, 0,171, 21, 0, 0, 0, + & 316,0.235, 0,175, 30, 21, 0, 0, + & 316,0.120, 0,171, 38, 30, 0, 0, + & 317,0.430, 0,171, 38, 0, 0, 0, + & 317,0.215, 0,175, 21, 0, 0, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1863,1881)/ + & 317,0.235, 0,171, 38, 21, 0, 0, + & 317,0.120, 0,175, 38, 30, 0, 0, + & 318,0.480, 0,171, 42, 0, 0, 0, + & 318,0.480, 0,175, 34, 0, 0, 0, + & 318,0.040, 0,180, 59, 0, 0, 0, + & 319,0.540, 0,275, 30, 0, 0, 0, + & 319,0.270, 0,274, 21, 0, 0, 0, + & 319,0.030, 0,275, 30, 21, 0, 0, + & 319,0.010, 0,274, 38, 30, 0, 0, + & 319,0.010, 0,274, 21, 21, 0, 0, + & 319,0.090, 0,246, 30, 21, 0, 0, + & 319,0.030, 0,245, 38, 30, 0, 0, + & 319,0.020, 0,245, 21, 21, 0, 0, + & 320,0.540, 0,274, 38, 0, 0, 0, + & 320,0.270, 0,275, 21, 0, 0, 0, + & 320,0.030, 0,274, 38, 21, 0, 0, + & 320,0.010, 0,275, 38, 30, 0, 0, + & 320,0.010, 0,275, 21, 21, 0, 0, + & 320,0.090, 0,245, 38, 21, 0, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1882,1900)/ + & 320,0.030, 0,246, 38, 30, 0, 0, + & 320,0.020, 0,246, 21, 21, 0, 0, + & 321,0.500, 0,266, 46, 0, 0, 0, + & 321,0.500, 0,265, 50, 0, 0, 0, + & 322,1.000, 0,254, 59, 0, 0, 0, + & 323,0.540, 0,266, 38, 0, 0, 0, + & 323,0.270, 0,265, 21, 0, 0, 0, + & 323,0.030, 0,266, 38, 21, 0, 0, + & 323,0.010, 0,265, 38, 30, 0, 0, + & 323,0.010, 0,265, 21, 21, 0, 0, + & 323,0.090, 0,222, 38, 21, 0, 0, + & 323,0.030, 0,221, 38, 30, 0, 0, + & 323,0.020, 0,221, 21, 21, 0, 0, + & 324,0.540, 0,265, 30, 0, 0, 0, + & 324,0.270, 0,266, 21, 0, 0, 0, + & 324,0.030, 0,265, 30, 21, 0, 0, + & 324,0.010, 0,266, 38, 30, 0, 0, + & 324,0.010, 0,266, 21, 21, 0, 0, + & 324,0.090, 0,221, 30, 21, 0, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1901,1919)/ + & 324,0.030, 0,222, 38, 30, 0, 0, + & 324,0.020, 0,222, 21, 21, 0, 0, + & 325,0.500, 0,275, 34, 0, 0, 0, + & 325,0.500, 0,274, 42, 0, 0, 0, + & 326,1.000, 0,230, 59, 0, 0, 0, + & 327,0.667, 0, 50, 38, 0, 0, 0, + & 327,0.333, 0, 46, 21, 0, 0, 0, + & 328,0.667, 0, 46, 30, 0, 0, 0, + & 328,0.333, 0, 50, 21, 0, 0, 0, + & 329,0.667, 0, 34, 38, 0, 0, 0, + & 329,0.333, 0, 42, 21, 0, 0, 0, + & 330,0.667, 0, 42, 30, 0, 0, 0, + & 330,0.333, 0, 34, 21, 0, 0, 0, + & 331,0.667, 0,140, 38, 0, 0, 0, + & 331,0.333, 0,136, 21, 0, 0, 0, + & 332,0.667, 0,136, 30, 0, 0, 0, + & 332,0.333, 0,140, 21, 0, 0, 0, + & 333,0.500, 0,136, 50, 0, 0, 0, + & 333,0.500, 0,140, 46, 0, 0, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1920,1938)/ + & 334,0.667, 0,175, 30, 0, 0, 0, + & 334,0.333, 0,171, 21, 0, 0, 0, + & 335,0.667, 0,171, 38, 0, 0, 0, + & 335,0.333, 0,175, 21, 0, 0, 0, + & 336,0.500, 0,171, 42, 0, 0, 0, + & 336,0.500, 0,175, 34, 0, 0, 0, + & 337,0.667, 0,246, 30, 0, 0, 0, + & 337,0.333, 0,245, 21, 0, 0, 0, + & 338,0.667, 0,245, 38, 0, 0, 0, + & 338,0.333, 0,246, 21, 0, 0, 0, + & 339,0.500, 0,246, 34, 0, 0, 0, + & 339,0.500, 0,245, 42, 0, 0, 0, + & 340,1.000, 0,254, 59, 0, 0, 0, + & 341,0.667, 0,222, 38, 0, 0, 0, + & 341,0.333, 0,221, 21, 0, 0, 0, + & 342,0.667, 0,221, 30, 0, 0, 0, + & 342,0.333, 0,222, 21, 0, 0, 0, + & 343,0.500, 0,222, 46, 0, 0, 0, + & 343,0.500, 0,221, 50, 0, 0, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1939,1957)/ + & 344,1.000, 0,230, 59, 0, 0, 0, + & 345,1.000, 0,225, 30, 0, 0, 0, + & 346,1.000, 0,225, 21, 0, 0, 0, + & 347,1.000, 0,225, 21, 0, 0, 0, + & 348,1.000, 0,225, 38, 0, 0, 0, + & 349,0.600, 0,228, 38, 0, 0, 0, + & 349,0.300, 0,227, 21, 0, 0, 0, + & 349,0.100, 0,227, 59, 0, 0, 0, + & 350,0.600, 0,228, 38, 0, 0, 0, + & 350,0.300, 0,227, 21, 0, 0, 0, + & 350,0.100, 0,227, 59, 0, 0, 0, + & 351,0.600, 0,227, 30, 0, 0, 0, + & 351,0.300, 0,228, 21, 0, 0, 0, + & 351,0.100, 0,228, 59, 0, 0, 0, + & 352,0.600, 0,227, 30, 0, 0, 0, + & 352,0.300, 0,228, 21, 0, 0, 0, + & 352,0.100, 0,228, 59, 0, 0, 0, + & 353,1.000, 0,229, 59, 0, 0, 0, + & 354,1.000, 0,249, 38, 0, 0, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1958,1976)/ + & 355,1.000, 0,249, 21, 0, 0, 0, + & 356,1.000, 0,249, 21, 0, 0, 0, + & 357,1.000, 0,249, 30, 0, 0, 0, + & 358,0.600, 0,252, 30, 0, 0, 0, + & 358,0.300, 0,251, 21, 0, 0, 0, + & 358,0.100, 0,251, 59, 0, 0, 0, + & 359,0.600, 0,252, 30, 0, 0, 0, + & 359,0.300, 0,251, 21, 0, 0, 0, + & 359,0.100, 0,251, 59, 0, 0, 0, + & 360,0.600, 0,251, 38, 0, 0, 0, + & 360,0.300, 0,252, 21, 0, 0, 0, + & 360,0.100, 0,252, 59, 0, 0, 0, + & 361,0.600, 0,251, 38, 0, 0, 0, + & 361,0.300, 0,252, 21, 0, 0, 0, + & 361,0.100, 0,252, 59, 0, 0, 0, + & 362,1.000, 0,253, 59, 0, 0, 0, + & 363,0.400, 0, 53, 38, 0, 0, 0, + & 363,0.200, 0, 49, 21, 0, 0, 0, + & 363,0.100, 0, 51, 38, 0, 0, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1977,1995)/ + & 363,0.050, 0, 47, 21, 0, 0, 0, + & 363,0.150, 0, 46, 26, 0, 0, 0, + & 363,0.050, 0, 46, 56, 0, 0, 0, + & 363,0.050, 0, 46, 24, 0, 0, 0, + & 364,0.400, 0, 49, 30, 0, 0, 0, + & 364,0.200, 0, 53, 21, 0, 0, 0, + & 364,0.100, 0, 47, 30, 0, 0, 0, + & 364,0.050, 0, 51, 21, 0, 0, 0, + & 364,0.150, 0, 50, 26, 0, 0, 0, + & 364,0.050, 0, 50, 56, 0, 0, 0, + & 364,0.050, 0, 50, 24, 0, 0, 0, + & 365,0.400, 0, 37, 38, 0, 0, 0, + & 365,0.200, 0, 45, 21, 0, 0, 0, + & 365,0.100, 0, 35, 38, 0, 0, 0, + & 365,0.050, 0, 43, 21, 0, 0, 0, + & 365,0.150, 0, 42, 26, 0, 0, 0, + & 365,0.050, 0, 42, 56, 0, 0, 0, + & 365,0.050, 0, 42, 24, 0, 0, 0, + & 366,0.400, 0, 45, 30, 0, 0, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1996,2014)/ + & 366,0.200, 0, 37, 21, 0, 0, 0, + & 366,0.100, 0, 43, 30, 0, 0, 0, + & 366,0.050, 0, 35, 21, 0, 0, 0, + & 366,0.150, 0, 34, 26, 0, 0, 0, + & 366,0.050, 0, 34, 56, 0, 0, 0, + & 366,0.050, 0, 34, 24, 0, 0, 0, + & 367,0.258, 0, 50, 38, 0, 0, 0, + & 367,0.129, 0, 46, 21, 0, 0, 0, + & 367,0.209, 0, 50, 39, 0, 0, 0, + & 367,0.105, 0, 46, 23, 0, 0, 0, + & 367,0.199, 0, 51, 38, 0, 0, 0, + & 367,0.100, 0, 47, 21, 0, 0, 0, + & 368,0.258, 0, 46, 30, 0, 0, 0, + & 368,0.129, 0, 50, 21, 0, 0, 0, + & 368,0.209, 0, 46, 31, 0, 0, 0, + & 368,0.105, 0, 50, 23, 0, 0, 0, + & 368,0.199, 0, 47, 30, 0, 0, 0, + & 368,0.100, 0, 51, 21, 0, 0, 0, + & 369,0.258, 0, 34, 38, 0, 0, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=2015,2033)/ + & 369,0.129, 0, 42, 21, 0, 0, 0, + & 369,0.209, 0, 34, 39, 0, 0, 0, + & 369,0.105, 0, 42, 23, 0, 0, 0, + & 369,0.199, 0, 35, 38, 0, 0, 0, + & 369,0.100, 0, 43, 21, 0, 0, 0, + & 370,0.258, 0, 42, 30, 0, 0, 0, + & 370,0.129, 0, 34, 21, 0, 0, 0, + & 370,0.209, 0, 42, 31, 0, 0, 0, + & 370,0.105, 0, 34, 23, 0, 0, 0, + & 370,0.199, 0, 43, 30, 0, 0, 0, + & 370,0.100, 0, 35, 21, 0, 0, 0, + & 371,0.400, 0, 53, 38, 0, 0, 0, + & 371,0.200, 0, 49, 21, 0, 0, 0, + & 371,0.100, 0, 51, 38, 0, 0, 0, + & 371,0.050, 0, 47, 21, 0, 0, 0, + & 371,0.150, 0, 46, 26, 0, 0, 0, + & 371,0.050, 0, 46, 56, 0, 0, 0, + & 371,0.050, 0, 46, 24, 0, 0, 0, + & 372,0.400, 0, 49, 30, 0, 0, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=2034,2052)/ + & 372,0.200, 0, 53, 21, 0, 0, 0, + & 372,0.100, 0, 47, 30, 0, 0, 0, + & 372,0.050, 0, 51, 21, 0, 0, 0, + & 372,0.150, 0, 50, 26, 0, 0, 0, + & 372,0.050, 0, 50, 56, 0, 0, 0, + & 372,0.050, 0, 50, 24, 0, 0, 0, + & 373,0.400, 0, 37, 38, 0, 0, 0, + & 373,0.200, 0, 45, 21, 0, 0, 0, + & 373,0.100, 0, 35, 38, 0, 0, 0, + & 373,0.050, 0, 43, 21, 0, 0, 0, + & 373,0.150, 0, 42, 26, 0, 0, 0, + & 373,0.050, 0, 42, 56, 0, 0, 0, + & 373,0.050, 0, 42, 24, 0, 0, 0, + & 374,0.400, 0, 45, 30, 0, 0, 0, + & 374,0.200, 0, 37, 21, 0, 0, 0, + & 374,0.100, 0, 43, 30, 0, 0, 0, + & 374,0.050, 0, 35, 21, 0, 0, 0, + & 374,0.150, 0, 34, 26, 0, 0, 0, + & 374,0.050, 0, 34, 56, 0, 0, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=2053,2071)/ + & 374,0.050, 0, 34, 24, 0, 0, 0, + & 375,0.208, 0, 50, 39, 0, 0, 0, + & 375,0.104, 0, 46, 23, 0, 0, 0, + & 375,0.134, 0, 51, 38, 0, 0, 0, + & 375,0.067, 0, 47, 21, 0, 0, 0, + & 375,0.124, 0, 50, 38, 0, 0, 0, + & 375,0.062, 0, 46, 21, 0, 0, 0, + & 375,0.301, 0, 46, 22, 0, 0, 0, + & 376,0.208, 0, 46, 31, 0, 0, 0, + & 376,0.104, 0, 50, 23, 0, 0, 0, + & 376,0.134, 0, 47, 30, 0, 0, 0, + & 376,0.067, 0, 51, 21, 0, 0, 0, + & 376,0.124, 0, 46, 30, 0, 0, 0, + & 376,0.062, 0, 50, 21, 0, 0, 0, + & 376,0.301, 0, 50, 22, 0, 0, 0, + & 377,0.208, 0, 34, 39, 0, 0, 0, + & 377,0.104, 0, 42, 23, 0, 0, 0, + & 377,0.134, 0, 35, 38, 0, 0, 0, + & 377,0.067, 0, 43, 21, 0, 0, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=2072,2090)/ + & 377,0.124, 0, 34, 38, 0, 0, 0, + & 377,0.062, 0, 42, 21, 0, 0, 0, + & 377,0.301, 0, 42, 22, 0, 0, 0, + & 378,0.208, 0, 42, 31, 0, 0, 0, + & 378,0.104, 0, 34, 23, 0, 0, 0, + & 378,0.134, 0, 43, 30, 0, 0, 0, + & 378,0.067, 0, 35, 21, 0, 0, 0, + & 378,0.124, 0, 42, 30, 0, 0, 0, + & 378,0.062, 0, 34, 21, 0, 0, 0, + & 378,0.301, 0, 34, 22, 0, 0, 0, + & 379,0.562, 0, 26, 38, 0, 0, 0, + & 379,0.155, 0, 39, 21, 0, 0, 0, + & 379,0.155, 0, 23, 38, 0, 0, 0, + & 379,0.088, 0,293, 38, 0, 0, 0, + & 379,0.020, 0, 46, 43, 0, 0, 0, + & 379,0.020, 0, 42, 47, 0, 0, 0, + & 380,0.562, 0, 26, 21, 0, 0, 0, + & 380,0.155, 0, 39, 30, 0, 0, 0, + & 380,0.155, 0, 31, 38, 0, 0, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=2091,2109)/ + & 380,0.088, 0,293, 21, 0, 0, 0, + & 380,0.010, 0, 46, 35, 0, 0, 0, + & 380,0.010, 0, 50, 43, 0, 0, 0, + & 380,0.010, 0, 34, 47, 0, 0, 0, + & 380,0.010, 0, 42, 51, 0, 0, 0, + & 381,0.562, 0, 26, 30, 0, 0, 0, + & 381,0.155, 0, 31, 21, 0, 0, 0, + & 381,0.155, 0, 23, 30, 0, 0, 0, + & 381,0.088, 0,293, 30, 0, 0, 0, + & 381,0.020, 0, 34, 51, 0, 0, 0, + & 381,0.020, 0, 50, 35, 0, 0, 0, + & 382,0.360, 0, 31, 38, 38, 0, 0, + & 382,0.180, 0, 23, 38, 21, 0, 0, + & 382,0.040, 0, 39, 21, 21, 0, 0, + & 382,0.020, 0, 39, 38, 30, 0, 0, + & 382,0.300, 0, 38, 21, 0, 0, 0, + & 382,0.040, 0, 46, 43, 0, 0, 0, + & 382,0.040, 0, 42, 47, 0, 0, 0, + & 382,0.020, 0, 22, 39, 0, 0, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=2110,2128)/ + & 383,0.180, 0, 39, 30, 21, 0, 0, + & 383,0.180, 0, 31, 38, 21, 0, 0, + & 383,0.160, 0, 23, 21, 21, 0, 0, + & 383,0.080, 0, 23, 38, 30, 0, 0, + & 383,0.300, 0, 38, 30, 0, 0, 0, + & 383,0.020, 0, 46, 35, 0, 0, 0, + & 383,0.020, 0, 50, 43, 0, 0, 0, + & 383,0.020, 0, 34, 47, 0, 0, 0, + & 383,0.020, 0, 42, 51, 0, 0, 0, + & 383,0.020, 0, 22, 23, 0, 0, 0, + & 384,0.360, 0, 39, 30, 30, 0, 0, + & 384,0.180, 0, 23, 30, 21, 0, 0, + & 384,0.040, 0, 31, 21, 21, 0, 0, + & 384,0.020, 0, 31, 30, 38, 0, 0, + & 384,0.300, 0, 30, 21, 0, 0, 0, + & 384,0.040, 0, 34, 51, 0, 0, 0, + & 384,0.040, 0, 50, 35, 0, 0, 0, + & 384,0.020, 0, 22, 31, 0, 0, 0, + & 385,0.184, 0, 41, 21, 0, 0, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=2129,2147)/ + & 385,0.184, 0, 29, 38, 0, 0, 0, + & 385,0.184, 0, 39, 23, 0, 0, 0, + & 385,0.236, 0, 38, 21, 0, 0, 0, + & 385,0.160, 0, 24, 38, 0, 0, 0, + & 385,0.018, 0, 46, 43, 0, 0, 0, + & 385,0.018, 0, 42, 47, 0, 0, 0, + & 385,0.016, 0, 46, 42, 0, 0, 0, + & 386,0.184, 0, 41, 30, 0, 0, 0, + & 386,0.184, 0, 33, 38, 0, 0, 0, + & 386,0.184, 0, 39, 31, 0, 0, 0, + & 386,0.236, 0, 38, 30, 0, 0, 0, + & 386,0.160, 0, 24, 21, 0, 0, 0, + & 386,0.009, 0, 46, 35, 0, 0, 0, + & 386,0.009, 0, 50, 43, 0, 0, 0, + & 386,0.009, 0, 34, 47, 0, 0, 0, + & 386,0.009, 0, 42, 51, 0, 0, 0, + & 386,0.008, 0, 46, 34, 0, 0, 0, + & 386,0.008, 0, 42, 50, 0, 0, 0, + & 387,0.184, 0, 33, 21, 0, 0, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=2148,2166)/ + & 387,0.184, 0, 29, 30, 0, 0, 0, + & 387,0.184, 0, 31, 23, 0, 0, 0, + & 387,0.236, 0, 30, 21, 0, 0, 0, + & 387,0.160, 0, 24, 30, 0, 0, 0, + & 387,0.018, 0, 34, 51, 0, 0, 0, + & 387,0.018, 0, 50, 35, 0, 0, 0, + & 387,0.016, 0, 34, 50, 0, 0, 0, + & 388,0.183, 0,231, 38, 30, 0, 0, + & 388,0.091, 0,231, 21, 21, 0, 0, + & 388,0.067, 0, 59,307, 0, 0, 0, + & 388,0.066, 0, 59,308, 0, 0, 0, + & 388,0.043, 0, 59,309, 0, 0, 0, + & 388,0.446,130, 13, 13, 13, 0, 0, + & 388,0.023,130, 13, 13, 59, 0, 0, + & 388,0.013, 0,121,127, 0, 0, 0, + & 388,0.013, 0,123,129, 0, 0, 0, + & 388,0.013, 0,125,131, 0, 0, 0, + & 388,0.004, 0, 1, 7, 0, 0, 0, + & 388,0.017, 0, 2, 8, 0, 0, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=2167,2185)/ + & 388,0.004, 0, 3, 9, 0, 0, 0, + & 388,0.017, 0, 4, 10, 0, 0, 0, + & 389,0.046, 0, 59,388, 0, 0, 0, + & 389,0.009, 0, 59,231, 0, 0, 0, + & 389,0.755, 0, 13, 13, 0, 0, 0, + & 389,0.030, 0,121,127, 0, 0, 0, + & 389,0.030, 0,123,129, 0, 0, 0, + & 389,0.030, 0,125,131, 0, 0, 0, + & 389,0.010, 0, 1, 7, 0, 0, 0, + & 389,0.040, 0, 2, 8, 0, 0, 0, + & 389,0.010, 0, 3, 9, 0, 0, 0, + & 389,0.040, 0, 4, 10, 0, 0, 0, + & 390,0.210, 0, 59,388, 0, 0, 0, + & 390,0.085, 0, 59,231, 0, 0, 0, + & 390,0.565, 0, 13, 13, 0, 0, 0, + & 390,0.022, 0,121,127, 0, 0, 0, + & 390,0.022, 0,123,129, 0, 0, 0, + & 390,0.022, 0,125,131, 0, 0, 0, + & 390,0.007, 0, 1, 7, 0, 0, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=2186,2204)/ + & 390,0.030, 0, 2, 8, 0, 0, 0, + & 390,0.007, 0, 3, 9, 0, 0, 0, + & 390,0.030, 0, 4, 10, 0, 0, 0, + & 391,0.162, 0, 59,388, 0, 0, 0, + & 391,0.071, 0, 59,231, 0, 0, 0, + & 391,0.615, 0, 13, 13, 0, 0, 0, + & 391,0.024, 0,121,127, 0, 0, 0, + & 391,0.024, 0,123,129, 0, 0, 0, + & 391,0.024, 0,125,131, 0, 0, 0, + & 391,0.008, 0, 1, 7, 0, 0, 0, + & 391,0.032, 0, 2, 8, 0, 0, 0, + & 391,0.008, 0, 3, 9, 0, 0, 0, + & 391,0.032, 0, 4, 10, 0, 0, 0, + & 392,0.034, 0,267, 38, 30, 0, 0, + & 392,0.017, 0,267, 21, 21, 0, 0, + & 392,0.044, 0,231, 38, 30, 0, 0, + & 392,0.022, 0,231, 21, 21, 0, 0, + & 392,0.050, 0,267, 59, 59, 0, 0, + & 392,0.114, 0, 59,389, 0, 0, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=2205,2223)/ + & 392,0.113, 0, 59,390, 0, 0, 0, + & 392,0.054, 0, 59,391, 0, 0, 0, + & 392,0.403,130, 13, 13, 13, 0, 0, + & 392,0.021,130, 13, 13, 59, 0, 0, + & 392,0.020, 0,121,127, 0, 0, 0, + & 392,0.020, 0,123,129, 0, 0, 0, + & 392,0.020, 0,125,131, 0, 0, 0, + & 392,0.007, 0, 1, 7, 0, 0, 0, + & 392,0.027, 0, 2, 8, 0, 0, 0, + & 392,0.007, 0, 3, 9, 0, 0, 0, + & 392,0.027, 0, 4, 10, 0, 0, 0, + & 393,0.250, 0,246,222, 0, 0, 0, + & 393,0.250, 0,245,221, 0, 0, 0, + & 393,0.385,130, 13, 13, 13, 0, 0, + & 393,0.020,130, 13, 13, 59, 0, 0, + & 393,0.015, 0,121,127, 0, 0, 0, + & 393,0.015, 0,123,129, 0, 0, 0, + & 393,0.015, 0,125,131, 0, 0, 0, + & 393,0.005, 0, 1, 7, 0, 0, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=2224,2242)/ + & 393,0.020, 0, 2, 8, 0, 0, 0, + & 393,0.005, 0, 3, 9, 0, 0, 0, + & 393,0.020, 0, 4, 10, 0, 0, 0, + & 395,0.195, 0, 39, 30, 0, 0, 0, + & 395,0.195, 0, 23, 21, 0, 0, 0, + & 395,0.195, 0, 31, 38, 0, 0, 0, + & 395,0.105, 0,286, 30, 0, 0, 0, + & 395,0.105, 0,285, 21, 0, 0, 0, + & 395,0.105, 0,287, 38, 0, 0, 0, + & 395,0.065, 0, 24, 38, 30, 0, 0, + & 395,0.035, 0, 24, 21, 21, 0, 0, + & 396,0.320, 0, 46, 34, 0, 0, 0, + & 396,0.320, 0, 60, 61, 0, 0, 0, + & 396,0.090, 0, 46, 35, 0, 0, 0, + & 396,0.090, 0, 42, 51, 0, 0, 0, + & 396,0.090, 0, 50, 43, 0, 0, 0, + & 396,0.090, 0, 34, 47, 0, 0, 0, + & 397,0.312, 0, 41, 30, 0, 0, 0, + & 397,0.312, 0, 29, 21, 0, 0, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=2243,2261)/ + & 397,0.312, 0, 33, 38, 0, 0, 0, + & 397,0.016, 0, 46, 35, 0, 0, 0, + & 397,0.016, 0, 42, 51, 0, 0, 0, + & 397,0.016, 0, 50, 43, 0, 0, 0, + & 397,0.016, 0, 34, 47, 0, 0, 0, + & 398,0.805, 0, 26, 22, 0, 0, 0, + & 398,0.065, 0, 41, 30, 0, 0, 0, + & 398,0.065, 0, 29, 21, 0, 0, 0, + & 398,0.065, 0, 33, 38, 0, 0, 0, + & 399,0.667, 0, 24, 38, 30, 0, 0, + & 399,0.333, 0, 24, 21, 21, 0, 0, + & 62,0.440, 0, 21, 22, 0, 0, 0, + & 62,0.160, 0, 21, 25, 0, 0, 0, + & 62,0.200, 0, 50, 42, 0, 0, 0, + & 62,0.200, 0, 46, 34, 0, 0, 0, + & 63,0.440, 0, 38, 22, 0, 0, 0, + & 63,0.160, 0, 38, 25, 0, 0, 0, + & 63,0.400, 0, 46, 42, 0, 0, 0, + & 64,0.440, 0, 30, 22, 0, 0, 0/ + DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=2262,2263)/ + & 64,0.160, 0, 30, 25, 0, 0, 0, + & 64,0.400, 0, 50, 34, 0, 0, 0/ + END +CDECK ID>, HWUDKL. +*CMZ :- -27/07/99 13.33.03 by Mike Seymour +*-- Author : Ian Knowles +C----------------------------------------------------------------------- + SUBROUTINE HWUDKL(ID,PMOM,DISP) +C----------------------------------------------------------------------- +C Given a real or virtual particle, flavour ID and 4-momentum PMOM, +C returns DISP its distance travelled in mm. +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + DOUBLE PRECISION HWR,PMOM(4),DISP(4),PMOM2,SCALE + INTEGER ID + EXTERNAL HWR + PMOM2=(PMOM(4)+PMOM(3))*(PMOM(4)-PMOM(3))-PMOM(1)**2-PMOM(2)**2 + SCALE=-GEV2MM*LOG(HWR()) + & /SQRT((PMOM2-RMASS(ID)**2)**2+(PMOM2/DKLTM(ID))**2) + IF (ID.GT.197.AND.ID.LT.203) SCALE=SCALE*EXAG + CALL HWVSCA(4,SCALE,PMOM,DISP) + END +CDECK ID>, HWUDKS. +*CMZ :- -27/07/99 13.33.03 by Mike Seymour +*-- Author : Ian Knowles +C----------------------------------------------------------------------- + SUBROUTINE HWUDKS +C----------------------------------------------------------------------- +C Sets up internal pointers based on the decay table in HWUDAT or as +C supplied via HWIODK. Computes CoM momenta of two-body decay modes. +C Particles with long lifetimes or no allowed decay (excepting light +C b hadrons when CLEO/EURODEC decays requested) are set stable, else +C calculate DKLTM(I) = mass/width ( = mass * lifetime/hbar). +C Gives warnings if: a particle has no decay modes or antiparticle's +C modes are not the charge conjugates of the particles. +C (N.B. CP violation permits this). +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + DOUBLE PRECISION HWUPCM,HWUAEM,HWUALF,BRSUM,EPS,SCALE, + & BRTMP(NMXDKS),FN,X,W,Q,FAC + INTEGER HWUANT,I,IDKY,LAST,LTMP(NMXMOD),J,L,K,M,N,INDX(NMXMOD), + & IRES,IAPDG,IPART,LR,LP,KPRDLR + LOGICAL BPDK,TOPDKS,MATCH(5),PMATCH(NMXMOD) + CHARACTER*7 CVETO(2) + CHARACTER*8 CDUM + EXTERNAL HWUPCM,HWUAEM,HWUALF,HWUANT + PARAMETER(EPS=1.E-6) + FN(X,Q,W)=X**4/(((X*X-Q*Q)**2+W*W*(X*X+Q*Q)-2.*W**4) + & *SQRT(X**4+Q**4+W**4-2.*(X*X*Q*Q+X*X*W*W+Q*Q*W*W))) + WRITE(6,10) + 10 FORMAT(/10X,'Checking consistency of decay tables'/) + DKPSET=.TRUE. +C First zero arrays + DO 20 I=1,NMXRES + LSTRT(I)=0 + 20 NMODES(I)=0 + DO 30 I=1,NMXDKS + NPRODS(I)=0 + LNEXT(I)=0 + 30 CMMOM(I)=0 + BPDK=BDECAY.NE.'HERW' + DO 180 I=1,NDKYS +C Search for next decaying particle type + IDKY=IDK(I) +C Skip if particle is not recognised or already dealt with + IF (IDKY.EQ.0.OR.IDKY.EQ.20) THEN + WRITE(6,40) I + 40 FORMAT(1X,'Line ',I4,': decaying particle not recognised') + GOTO 180 + ENDIF + IF (NMODES(IDKY).GT.0) GOTO 180 +C Check and include first decay mode, storing a copy + CALL HWDCHK(IDKY,I,*180) + LSTRT(IDKY)=I + NMODES(IDKY)=1 + BRSUM=BRFRAC(I) + LTMP(1)=I + BRTMP(1)=-BRFRAC(I) + LAST=I +C Sets CMMOM(IDKY) = CoM momentum for first 2-body decay mode I (else 0) + IF (NPRODS(I).EQ.2) CMMOM(I)= + & HWUPCM(RMASS(IDKY),RMASS(IDKPRD(1,I)),RMASS(IDKPRD(2,I))) +C Include any other decay modes of IDKY + DO 120 J=I+1,NDKYS + IF (IDK(J).EQ.IDKY) THEN +C First see if it is a copy of the same decay channel + IF ((IDKPRD(2,J).GE.1.AND.IDKPRD(2,J).LE.13).OR. + & (IDKPRD(3,J).GE.1.AND.IDKPRD(3,J).LE.13)) THEN +C Partonic respect order + L=LSTRT(IDKY) + DO 50 K=1,NMODES(IDKY) + IF (IDKPRD(1,L).EQ.IDKPRD(1,J).AND. + & IDKPRD(2,L).EQ.IDKPRD(2,J).AND. + & IDKPRD(3,L).EQ.IDKPRD(3,J).AND. + & IDKPRD(4,L).EQ.IDKPRD(4,J).AND. + & IDKPRD(5,L).EQ.IDKPRD(5,J)) GOTO 100 + 50 L=LNEXT(L) + ELSE +C Allow for different order in matching + L=LSTRT(IDKY) + DO 90 K=1,NMODES(IDKY) + DO 60 M=1,5 + 60 MATCH(M)=.FALSE. + DO 80 M=1,5 + DO 70 N=1,5 + IF (.NOT.MATCH(N).AND.IDKPRD(N,L).EQ.IDKPRD(M,J)) THEN + MATCH(N)=.TRUE. + GOTO 80 + ENDIF + 70 CONTINUE + 80 CONTINUE + IF (MATCH(1).AND.MATCH(2).AND.MATCH(3).AND. + & MATCH(4).AND.MATCH(5)) GOTO 100 + 90 L=LNEXT(L) + ENDIF + CALL HWDCHK(IDKY,J,*120) + NMODES(IDKY)=NMODES(IDKY)+1 + IF (NMODES(IDKY).GT.NMXMOD) CALL HWWARN('HWUDKS',100,*999) + LNEXT(LAST)=J + BRSUM=BRSUM+BRFRAC(J) + LTMP(NMODES(IDKY))=J + BRTMP(NMODES(IDKY))=-BRFRAC(J) + LAST=J +C Sets CMMOM(IDKY) = CoM momentum for next 2-body decay mode J (else 0) + IF (NPRODS(J).EQ.2) CMMOM(J)= + & HWUPCM(RMASS(IDKY),RMASS(IDKPRD(1,J)),RMASS(IDKPRD(2,J))) + ENDIF + GOTO 120 + 100 WRITE(6,110) L,J,BRFRAC(J),NME(J) + BRSUM=BRSUM-BRFRAC(L)+BRFRAC(J) + BRFRAC(L)=BRFRAC(J) + BRTMP(L)=-BRFRAC(L) + NME(L)=NME(J) + 110 FORMAT(1X,'Line ',I4,' is the same as line ',I4/ + & 1X,'Take BR ',F5.3,' and ME code ',I3,' from second entry') + 120 CONTINUE +C Set sum of branching ratios to 1. if necessary + IF (ABS(BRSUM-1.).GT.EPS) THEN + WRITE(6,130) RNAME(IDKY),BRSUM + 130 FORMAT(1X,A8,': BR sum =',F8.5) + IF (ABS(BRSUM).LT.EPS) THEN + WRITE(6,140) + 140 FORMAT(1X,'Setting particle stable'/) + NMODES(IDKY)=0 + ELSE + WRITE(6,150) + 150 FORMAT(1X,'Rescaling to 1'/) + SCALE=1./BRSUM + K=LSTRT(IDKY) + DO 160 J=1,NMODES(IDKY) + BRFRAC(K)=SCALE*BRFRAC(K) + 160 K=LNEXT(K) + ENDIF + ENDIF +C Sort branching ratios into descending order and rearrange pointers + CALL HWUSOR(BRTMP,NMODES(IDKY),INDX,2) + LSTRT(IDKY)=LTMP(INDX(1)) + LNEXT(LTMP(INDX(1)))=LTMP(INDX(1)) + DO 170 J=2,NMODES(IDKY) + IF (ABS(BRFRAC(LTMP(INDX(J)))).LT.EPS) THEN + NMODES(IDKY)=J-1 + GOTO 175 + ENDIF + 170 LNEXT(LTMP(INDX(J-1)))=LTMP(INDX(J)) + 175 LNEXT(LTMP(INDX(NMODES(IDKY))))=LTMP(INDX(NMODES(IDKY))) + 180 CONTINUE +C If not a short lived particle with a decay mode then set stable + DO 190 I=1,NRES + IF (.NOT.RSTAB(I).AND.RLTIM(I).LT.PLTCUT.AND. + & (NMODES(I).GT.0.OR. + & (BPDK.AND.((I.GE.221.AND.I.LE.231).OR. + & (I.GE.245.AND.I.LE.254))))) THEN + DKLTM(I)=RLTIM(I)*RMASS(I)/HBAR + ELSE + RSTAB(I)=.TRUE. + ENDIF + 190 CONTINUE +C Set up DKLTM for light quarks + DO 200 I=1,5 + DKLTM(I)=RMASS(I)**2/VMIN2 + 200 DKLTM(I+6)=DKLTM(I) +C gluon + DKLTM(13)=RMASS(13)**2/VMIN2 +C and diquarks + DO 210 I=109,114 + DKLTM(I)=RMASS(I)**2/VMIN2 + 210 DKLTM(I+6)=DKLTM(I) +C Set up DKLTM for weak bosons + DKLTM(198)=RMASS(198)/GAMW + DKLTM(199)=DKLTM(198) + DKLTM(200)=RMASS(200)/GAMZ + DKLTM(201)=RMASS(201)/GAMH + DKLTM(202)=RMASS(202)/GAMZP +C Set up DKTRM for massive quarks (plus check m_Q > M_W + m_q) + FAC=SWEIN*(FOUR*RMASS(198))**2/HWUAEM(RMASS(198)**2) + IF (.NOT.SUSYIN) THEN + IF (RMASS(6).GT.RMASS(5)+RMASS(198)) THEN + DKLTM(6)=FAC*FN(RMASS(6 ),RMASS(5 ),RMASS(198)) + & /(1-HWUALF(1,RMASS(6))*2*(2*PIFAC**2/3-5/2)/(3*PIFAC)) + DKLTM(12)=DKLTM(6) + ELSE + WRITE(6,220) RNAME(6),RNAME(5),RNAME(198) + ENDIF + ENDIF + IF (RMASS(209).GT.RMASS(4)+RMASS(198)) THEN + DKLTM(209)=FAC*FN(RMASS(209),RMASS(4 ),RMASS(198)) + DKLTM(215)=DKLTM(209) + ELSE + WRITE(6,220) RNAME(209),RNAME(4),RNAME(198) + ENDIF + IF (RMASS(210).GT.RMASS(209)+RMASS(198)) THEN + DKLTM(210)=FAC*FN(RMASS(210),RMASS(209),RMASS(198)) + DKLTM(216)=DKLTM(210) + ELSE + WRITE(6,220) RNAME(210),RNAME(209),RNAME(198) + ENDIF + IF (RMASS(211).GT.RMASS(6)+RMASS(198)) THEN + DKLTM(211)=FAC*FN(RMASS(211),RMASS(6 ),RMASS(198)) + DKLTM(217)=DKLTM(211) + ELSE + WRITE(6,220) RNAME(211),RNAME(6),RNAME(198) + ENDIF + IF (RMASS(212).GT.RMASS(211)+RMASS(198)) THEN + DKLTM(212)=FAC*FN(RMASS(212),RMASS(211),RMASS(198)) + DKLTM(218)=DKLTM(212) + ELSE + WRITE(6,220) RNAME(212),RNAME(211),RNAME(198) + ENDIF + 220 FORMAT(1X,'W not real in the decay: ',A8,' --> ',A8,' + ',A8) +C Now carry out diagnostic checks on decay table + CALL HWDTOP(TOPDKS) + DO 310 IRES=1,NRES + IAPDG=ABS(IDPDG(IRES)) +C Do not check (di-)quarks, gauge bosons, higgses or special particles + IF ((IAPDG.GE.1.AND.IAPDG.LE.9).OR. + & (MOD(IAPDG/10,10).EQ.0.AND.MOD(IAPDG/1000,10).NE.0).OR. + & (IAPDG.GE.21.AND.IAPDG.LE.26).OR. + & IAPDG.EQ.32.OR. + & (IAPDG.GE.35.AND.IAPDG.LE.37).OR. + & IAPDG.EQ.91.OR. + & IAPDG.EQ.98.OR.IAPDG.EQ.99) THEN + GOTO 310 +C Ignore top hadrons if top decays + ELSEIF(TOPDKS.AND.((IRES.GE.232.AND.IRES.LE.244).OR. + & (IRES.GE.255.AND.IRES.LE.264))) THEN + GOTO 310 +C Ignore particles not produced in cluster or particle decays + ELSEIF(VTOCDK(IRES).AND.VTORDK(IRES)) THEN + GOTO 310 +C Ignore B's if EURO or CLEO decay package used + ELSEIF(((IRES.GE.221.AND.IRES.LE.223).OR. + & (IRES.GE.245.AND.IRES.LE.247)).AND.BDECAY.NE.'HERW') THEN + WRITE(6,320) BDECAY,RNAME(IRES) +C Check decay modes exist for massive, short lived particles + ELSEIF (NMODES(IRES).EQ.0.AND.RMASS(IRES).NE.ZERO.AND. + & RLTIM(IRES).LT.PLTCUT) THEN + IF (VTOCDK(IRES)) THEN + CVETO(1)='VETOED ' + ELSE + CVETO(1)='ALLOWED' + ENDIF + IF (VTORDK(IRES)) THEN + CVETO(2)='VETOED ' + ELSE + CVETO(2)='ALLOWED' + ENDIF + WRITE(6,330) RNAME(IRES),CVETO(1),CVETO(2) +C ignore particles with no modes if massless or long lived + ELSEIF (NMODES(IRES).EQ.0.AND. + & (RMASS(IRES).EQ.ZERO.OR.RLTIM(IRES).GT.PLTCUT)) THEN + GOTO 310 + ELSEIF (IDPDG(IRES).LT.0) THEN +C Antiparticle: check decays are charge conjugates of particle decays + CALL HWUIDT(1,-IDPDG(IRES),IPART,CDUM) + IF (NMODES(IPART).EQ.0) THEN +C Nothing to compare to + WRITE(6,340) RNAME(IPART),RNAME(IRES) + ELSE +C First initialize particle matching array + DO 230 I=1,NMODES(IPART) + 230 PMATCH(I)=.FALSE. +C Loop through antiparticle decay modes + LR=LSTRT(IRES) + DO 290 I=1,NMODES(IRES) +C Search for conjugate mode allowing for different particle order + LP=LSTRT(IPART) + DO 270 J=1,NMODES(IPART) + IF (PMATCH(J)) GOTO 270 + DO 240 K=1,5 + 240 MATCH(K)=.FALSE. + DO 260 K=1,5 + KPRDLR=HWUANT(IDKPRD(K,LR)) + DO 250 L=1,5 + IF (.NOT.MATCH(L).AND.KPRDLR.EQ.IDKPRD(L,LP) ) THEN + MATCH(L)=.TRUE. + GOTO 260 + ENDIF + 250 CONTINUE + 260 CONTINUE + IF (MATCH(1).AND.MATCH(2).AND.MATCH(3).AND. + & MATCH(4).AND.MATCH(5)) GOTO 280 + 270 LP=LNEXT(LP) +C No match found + WRITE(6,350) LR,RNAME(IRES),(RNAME(IDKPRD(J,LR)),J=1,5) + GOTO 290 +C Match found, check branching ratios and matrix element codes + 280 PMATCH(J)=.TRUE. + IF (BRFRAC(LR).NE.BRFRAC(LP)) + & WRITE(6,360) LR,RNAME(IRES),(RNAME(IDKPRD(J,LR)),J=1,5), + & BRFRAC(LR),BRFRAC(LP) + IF (NME(LR).NE.NME(LP)) + & WRITE(6,370) LR,RNAME(IRES),(RNAME(IDKPRD(J,LR)),J=1,5), + & NME(LR),NME(LP) + 290 LR=LNEXT(LR) +C Check for unmatched modes of particle conjugate to antiparticle + LP=LSTRT(IPART) + DO 300 I=1,NMODES(IPART) + IF (.NOT.PMATCH(I)) + & WRITE(6,350) LP,RNAME(IPART),(RNAME(IDKPRD(J,LP)),J=1,5) + 300 LP=LNEXT(LP) + ENDIF + ENDIF + 310 CONTINUE + 320 FORMAT(1X,A8,' decay package to be used for particle ',A8) + 330 FORMAT(1X,'No decay modes available for particle ',A8/ + & 1X,'Production in cluster decays ',A7,' and particle decays ',A7) + 340 FORMAT(1X,A8,' has no modes conjugate to those of ',A8) + 350 FORMAT(1X,'Line, ',I4,' decay: ',A8,' --> ',4(A8,1X),A8/ + & 1X,'A charge conjugate decay mode does not exist') + 360 FORMAT(1X,'Line, ',I4,' decay: ',A8,' --> ',4(A8,1X),A8/ + & 1X,'BR ',F5.3,' unequal to that of conjugate mode ',F5.3) + 370 FORMAT(1X,'Line, ',I4,' decay: ',A8,' --> ',4(A8,1X),A8/ + & 1X,'ME code ',I3,' unequal to that of conjugate mode ',I3) + 999 RETURN + END +CDECK ID>, HWUDPR. +*CMZ :- -27/07/99 13.33.03 by Mike Seymour +*-- Author : Ian Knowles, Bryan Webber & Kosuke Odagiri +C----------------------------------------------------------------------- + SUBROUTINE HWUDPR +C----------------------------------------------------------------------- +C Prints out particle properies/decay tables in a number of formats: +C If (PRNDEF) ASCII to stout +C If (PRNTEX) LaTeX to the file HW_decays.tex +C Paper size and offsets as set in HWUEPR +C Uses the package longtable.sty +C Designed to be printed as landscape +C If (PRNWEB) HTML to the file HW_decays/index.html +C /PART0000001.html etc. +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + INTEGER MMWIDE,MMLONG,MMHOFF,MMVOFF,IUNITT,IUNTW1,IUNTW2,I,NM,J,K, + & L,M + CHARACTER*1 Z + CHARACTER*2 ZZ,ACHRG + CHARACTER*3 ASPIN(0:10) + CHARACTER*6 BGCOLS(5),TBCOLS(3) + CHARACTER*7 HWUNST,TMPNME + CHARACTER*17 FNAMEP + CHARACTER*33 FNAMEW + COMMON/PAPER/MMWIDE,MMLONG,MMHOFF,MMVOFF + EXTERNAL HWUNST + DATA BGCOLS/'ffffff','0000aa','aa0000','00aa00','aa00ff'/ + DATA TBCOLS/'ccccff','9966ff','ffff00'/ + DATA ASPIN/' 0 ','1/2',' 1 ','3/2',' 2 ','5/2',' 3 ','7/2', + & ' 4 ','9/2',' 5 '/ +C + Z=CHAR(92) + ZZ=Z//Z +C + IUNITT=50 + IUNTW1=51 + IUNTW2=52 +C Open and write out file header information for index file + IF (PRNDEF) THEN + IF (NPRFMT.LE.1) THEN + WRITE (6,10) NRES + ELSE + WRITE (6,20) NRES + END IF + END IF + IF (PRNTEX) THEN + OPEN(IUNITT,STATUS='UNKNOWN',FILE='HW_decays.tex') + IF (NPRFMT.LE.1) THEN + WRITE(IUNITT,30) Z,Z,Z,MMWIDE,Z,MMLONG,Z,MMHOFF,Z,MMVOFF, + & Z,Z,Z,Z,Z,ZZ,Z,Z,Z,Z,Z,Z,NRES,ZZ,Z,Z,ZZ,Z,Z + ELSE + WRITE(IUNITT,40) Z,Z,Z,MMLONG,Z,MMWIDE,Z,MMHOFF,Z,MMVOFF, + & Z,Z,Z,Z,Z,Z,ZZ,Z,Z,Z,Z,Z,Z,NRES,ZZ,Z,Z,Z,ZZ,Z,Z + END IF + ENDIF + IF (PRNWEB) THEN + OPEN(IUNTW1,STATUS='UNKNOWN',FILE='HW_decays/index.html') + WRITE(IUNTW1,50) BGCOLS,TBCOLS,NRES,((TBCOLS(I),I=2,3),J=1,7) + ENDIF + 10 FORMAT(1H1//15X,'TABLE OF PROPERTIES OF',I4,' PARTICLES USED'/) + 20 FORMAT(1H1//30X,'TABLE OF PROPERTIES OF',I4,' PARTICLES USED'// + & 5X,'Name IDPDG Mass Chg Spn Lifetime Modes ', + & ' Branching fractions ME codes and decay products') + 30 FORMAT(A1,'documentclass{article}'/A1,'usepackage{longtable}'/ + & A1,'textwidth ',I4,'mm ',A1,'textheight ',I4,'mm'/ + & A1,'hoffset ',I4,'mm ',A1,'voffset ',I4,'mm'/ + & A1,'pagestyle{empty}'/A1,'begin{document}'/ + & A1,'begin{center}'/A1,'begin{longtable}{|r|c|r|r|r|r|r|r|}'/ + & A1,'hline'/'Id HW & Name & Id PDG & Mass & Charge & Spin ', + & '& Lifetime & Modes ',A2/A1,'hline'/ + & A1,'endhead'/A1,'hline'/A1,'endfoot'/A1,'hline'/ + & A1,'multicolumn{8}{|c|}{HERWIG 6.0: Table of properties', + & ' of the ',I3,' particles used} ',A2/A1,'hline',A1,'hline'/ + & 'Id HW & Name & Id PDG & Mass & Charge & Spin & ', + & 'Lifetime & Modes ',A2/A1,'hline'/A1,'endfirsthead') + 40 FORMAT(A1,'documentclass{article}'/A1,'usepackage{longtable}'/ + & A1,'textwidth ',I4,'mm ',A1,'textheight ',I4,'mm'/ + & A1,'hoffset ',I4,'mm ',A1,'voffset ',I4,'mm'/ + & A1,'pagestyle{empty}'/A1,'begin{document}'/A1,'begin{center}'/ + & A1,'begin{longtable}{|r|c|r|r|r|r|r|r|c|r|ccccc|}'/ + & A1,'hline'/'Id HW & Name & Id PDG & Mass & Charge & Spin ', + & '& Lifetime & Modes & B.R. & M.E. & ' / + & A1,'multicolumn{5}{|c|}{Decay Products} ',A2/A1,'hline'/ + & A1,'endhead'/A1,'hline'/A1,'endfoot'/A1,'hline'/ + & A1,'multicolumn{15}{|c|}{HERWIG 6.0: Table of properties', + & ' of the ',I3,' particles used} ',A2/A1,'hline',A1,'hline'/ + & 'Id HW & Name & Id PDG & Mass & Charge & Spin & ', + & 'Lifetime & Modes & B.R. & M.E. & '/ + & A1,'multicolumn{5}{|c|}{Decay Products} ',A2/A1,'hline'/ + & A1,'endfirsthead') + 50 FORMAT(''/''/''/ + & 'HERWIG 6.0 Particle Properties'/''/ + & ''/'
'/ + & '', + & ''/''/''/''/ + & ''/ + & ''/ + & ''/ + & ''/ + & ''/ + & ''/ + & ''/ + & '') +C Loop through resonances + DO 260 I=1,NRES +C Skip particles that can't be produced or blank lines + IF ((VTOCDK(I).AND.VTORDK(I)).OR. + & (RNAME(I).EQ.' ')) GOTO 260 +C Open and write out header information for particle file + IF (PRNWEB) THEN + TMPNME = HWUNST(I) + WRITE(FNAMEP,'(A5,A7,A5)') 'PART_',TMPNME,'.html' + WRITE(FNAMEW,'(A,A17)') 'HW_decays/',FNAMEP + OPEN(IUNTW2,STATUS='UNKNOWN',FILE=FNAMEW) + WRITE(IUNTW2,60) RNAME(I),BGCOLS + WRITE(IUNTW2,70) TBCOLS,((TBCOLS(L),L=2,3),M=1,6) + ENDIF + 60 FORMAT(''/''/''/ + & 'HERWIG 6.0: ',A8,' properties'/''/ + & ''/'
') + 70 FORMAT('
', + & '', + & 'HERWIG 6.0: Table of properties of', + & ' the ',I3,' particles used
Name', + & 'Id PDGMassChargeSpinLifetimeModes
'/ + & ''/''/ + & ''/ + & ''/ + & ''/ + & ''/ + & ''/ + & ''/ + & ''/ + & '') +C Trick to output charge in fractions for di/s - quarks + IF ((I.GE. 1.AND.I.LE. 12).OR.(I.GE.109.AND.I.LE.120).OR. + & (I.GE.209.AND.I.LE.218).OR.(I.GE.401.AND.I.LE.424)) THEN + ACHRG='/3' + ELSE + ACHRG=' ' + ENDIF +C Write out special particles with no decay modes + IF (NMODES(I).EQ.0) THEN + IF (PRNDEF) THEN + IF (NPRFMT.LE.1) THEN + WRITE(6,80) I,RNAME(I),IDPDG(I),RMASS(I),ICHRG(I), + & ASPIN(INT(TWO*RSPIN(I))),RLTIM(I),0 + ELSE + WRITE(6,90) I,RNAME(I),IDPDG(I),RMASS(I),ICHRG(I), + & ASPIN(INT(TWO*RSPIN(I))),RLTIM(I),0 + ENDIF + ENDIF +C Add particle to LaTeX file + IF (PRNTEX) THEN + IF (NPRFMT.LE.1) THEN + WRITE(IUNITT,100) Z,I,TXNAME(1,I),IDPDG(I),RMASS(I), + & ICHRG(I),ACHRG,ASPIN(INT(TWO*RSPIN(I))),RLTIM(I),0,ZZ + ELSE + WRITE(IUNITT,110) Z,I,TXNAME(1,I),IDPDG(I),RMASS(I), + & ICHRG(I),ACHRG,ASPIN(INT(TWO*RSPIN(I))),RLTIM(I),0,Z,ZZ + ENDIF + ENDIF + IF (PRNWEB) THEN +C Add properties to Web index + WRITE(IUNTW1,120) TBCOLS(2),TBCOLS(3),I,FNAMEP,TXNAME(2,I), + & IDPDG(I),RMASS(I),ICHRG(I),ACHRG, + & ASPIN(INT(TWO*RSPIN(I))),RLTIM(I),0 +C Add properties to Web particle file + WRITE(IUNTW2,130) TBCOLS(2),TBCOLS(3),I,TXNAME(2,I), + & IDPDG(I),RMASS(I),ICHRG(I),ACHRG, + & ASPIN(INT(TWO*RSPIN(I))),RLTIM(I),0 + ENDIF + 80 FORMAT(/1X,I3,1X,A8,' IDPDG=',I8,', M=',F8.3,', Q=',I2,', J=', + & A3,', T=',1P,E9.3,',',I3,' Modes') + 90 FORMAT(/1X,I3,1X,A8,1X,I8,1X,F8.3,1X,I2,1X,A3,1X,1P,E9.3,1X,I3) + 100 FORMAT(A1,'hline',I4,' & ',A37,' & $',I8,'$ & ',F8.3,' & $',I2, + & A2,'$ & ',A3,' & $',1P,E9.3,'$ & ',I3,' ',A2) + 110 FORMAT(A1,'cline{1-8}'/ + & I4,' & ',A37,' & $',I8,'$ & ',F8.3,' & $',I2,A2,'$ & ',A3, + & ' & $',1P,E9.3,'$ & ',I3,' & ',A1,'multicolumn{7}{|c|}{} ',A2) + 120 FORMAT(''/ + & ''/ + & ''/ + & ''/ + & ''/ + & ''/ + & ''/ + & ''/ + & ''/'') + 130 FORMAT(''/ + & ''/ + & ''/ + & ''/ + & ''/ + & ''/ + & ''/ + & ''/ + & ''/''/'
NameId PDGMassChargeSpinLifetimeModes
',I3, + & '',A37,'',I8,'',F8.3,'',I2,A2,'',A3,'',1P,E9.3,'',I3,'
',I3, + & '',A37,'',I8,'',F8.3,'',I2,A2,'',A3,'',1P,E9.3,'',I3,'
'/'

') + ELSE +C Particle with decay modes + IF (RSTAB(I)) THEN + NM=0 + ELSEIF (VTOCDK(I)) THEN + NM=-NMODES(I) + ELSE + NM=NMODES(I) + ENDIF + K=LSTRT(I) +C Write out properties and first decay mode + IF (PRNDEF) THEN + IF (NPRFMT.LE.1) THEN + WRITE(6, 80) I,RNAME(I),IDPDG(I),RMASS(I),ICHRG(I), + & ASPIN(INT(TWO*RSPIN(I))),RLTIM(I),NM + WRITE(6,140) (RNAME(IDKPRD(L,K)),L=1,5),BRFRAC(K),NME(K) + ELSE + WRITE(6,150) I,RNAME(I),IDPDG(I),RMASS(I),ICHRG(I), + & ASPIN(INT(TWO*RSPIN(I))),RLTIM(I),NM,BRFRAC(K),NME(K), + & (RNAME(IDKPRD(L,K)),L=1,5) + ENDIF + ENDIF + IF (PRNTEX) THEN + IF (NPRFMT.LE.1) THEN + WRITE(IUNITT,160) Z,I,TXNAME(1,I),IDPDG(I),RMASS(I), + & ICHRG(I),ACHRG,ASPIN(INT(TWO*RSPIN(I))),RLTIM(I),NM,ZZ,Z + WRITE(IUNITT,170) Z,Z,(TXNAME(1,IDKPRD(L,K)),L=1,5),Z, + & BRFRAC(K),Z,NME(K),ZZ + ELSE + WRITE(IUNITT,180) Z,I,TXNAME(1,I),IDPDG(I),RMASS(I), + & ICHRG(I),ACHRG,ASPIN(INT(TWO*RSPIN(I))),RLTIM(I),NM, + & BRFRAC(K),NME(K),(TXNAME(1,IDKPRD(L,K)),L=1,5),ZZ,Z + ENDIF + END IF + IF (PRNWEB) THEN +C Add properties to index + WRITE(IUNTW1,120) TBCOLS(2),TBCOLS(3),I,FNAMEP,TXNAME(2,I), + & IDPDG(I),RMASS(I),ICHRG(I),ACHRG,ASPIN(INT(TWO*RSPIN(I))), + & RLTIM(I),NM +C Add properties to Web particle file + WRITE(IUNTW2,130) TBCOLS(2),TBCOLS(3),I,TXNAME(2,I),IDPDG(I), + & RMASS(I),ICHRG(I),ACHRG,ASPIN(INT(TWO*RSPIN(I))),RLTIM(I),NM + WRITE(IUNTW2,190) TBCOLS,TXNAME(2,I), + & ((TBCOLS(L),L=2,3),M=1,3) + WRITE(IUNTW2,200) TBCOLS(2),TBCOLS(3),1,BRFRAC(K),NME(K), + & (TXNAME(2,IDKPRD(L,K)),L=1,5) + ENDIF + 140 FORMAT(5X,'BR[ -->',5(1X,A6),']=',F5.3,', ME code',I4) + 150 FORMAT(/1X,I3,1X,A8,1X,I8,1X,F8.3,1X,I2,1X,A3,1X,1P,E9.3,1X,I3, + & 2X,F5.3,1X,I3,5(1X,A8)) + 160 FORMAT(A1,'hline', + & I4,' & ',A37,' & $',I8,'$ & ',F8.3,' & $',I2,A2,'$ & ', + & A3,' & $',1P,E9.3,'$ & ',I3,' ',A2/A1,'cline{2-8}') + 170 FORMAT(' & & ',A1,'multicolumn{2}{l}{$',A1,'longrightarrow$'/ + & 5(A37,' '),'}'/' & ',A1,'multicolumn{2}{l}{BR = ',F5.3,'} & ', + & A1,'multicolumn{2}{l|}{ME code = ',I3,'} ',A2) + 180 FORMAT(A1,'hline'/ + & I4,' & ',A37,' & $',I8,'$ & ',F8.3,' & $',I2,A2,'$ & ', + & A3,' & $',1P,E9.3,'$ & ',I3,' & ',F5.3,' & ',I3, + & 5(' & ',A37), ' ',A2/A1,'cline{2-8}') + 190 FORMAT(''/''/ + & ''/''/''/'', + & ''/ + & ''/ + & ''/'') + 200 FORMAT(''/ + & ''/ + & ''/ + & ''/ + & 5(''/),'') +C Write out additional decay modes + IF (NMODES(I).GE.2) THEN + DO 210 J=2,NMODES(I) + K=LNEXT(K) + IF (PRNDEF) THEN + IF (NPRFMT.LE.1) THEN + WRITE(6,140) (RNAME(IDKPRD(L,K)),L=1,5),BRFRAC(K),NME(K) + ELSE + WRITE(6,220) BRFRAC(K),NME(K),(RNAME(IDKPRD(L,K)),L=1,5) + END IF + END IF + IF (PRNTEX) THEN + IF (NPRFMT.LE.1) THEN + WRITE(IUNITT,170) Z,Z,(TXNAME(1,IDKPRD(L,K)),L=1,5),Z, + & BRFRAC(K),Z,NME(K),ZZ + ELSE + WRITE(IUNITT,230) Z,BRFRAC(K),NME(K), + & (TXNAME(1,IDKPRD(L,K)),L=1,5),ZZ + ENDIF + ENDIF + IF (PRNWEB) WRITE(IUNTW2,200) TBCOLS(2),TBCOLS(3),J, + & BRFRAC(K),NME(K),(TXNAME(2,IDKPRD(L,K)),L=1,5) + 210 CONTINUE + IF (PRNTEX.AND.NPRFMT.EQ.2.AND.NMODES(I+1).EQ.0) + & WRITE(IUNITT,240) Z + 220 FORMAT(54X,F5.3,1X,I3,5(1X,A8)) + 230 FORMAT(' & ',A1,'multicolumn{7}{|c|}{} & ',F5.3,' & ',I3, + & 5(' & ',A37),' ',A2) + 240 FORMAT(A1,'hline') + ENDIF + ENDIF +C Close Web particle file + IF (PRNWEB) THEN + WRITE(IUNTW2,250) + CLOSE(IUNTW2) + ENDIF + 250 FORMAT('
',A37, + & ' Decay Modes
B.R.M.E.', + & 'Decay products
', + & I3,'',F5.3,'',I3,'',A37,'
'/'

'/'

'/ + & 'Main particle index'/ + & ''/'') + 260 CONTINUE +C Close the LaTeX file + IF (PRNTEX) THEN + WRITE(IUNITT,270) Z,Z,Z + CLOSE(IUNITT) + ENDIF +C Close the index file + IF (PRNWEB) THEN + WRITE(IUNTW1,280) + CLOSE(IUNTW1) + ENDIF + 270 FORMAT(A1,'end{longtable}'/A1,'end{center}'/A1,'end{document}') + 280 FORMAT(''/''/''/'') + RETURN + END +CDECK ID>, HWUECM. +*CMZ :- -29/01/93 11.11.55 by Bryan Webber +*-- Author : Giovanni Abbiendi & Luca Stanco +C--------------------------------------------------------------------- + FUNCTION HWUECM (S,M1QUAD,M2QUAD) +C----------------------------------------------------------------------- +C C.M. ENERGY OF A PARTICLE IN 1-->2 BRANCH, MAY BE SPACELIKE +C--------------------------------------------------------------------- + DOUBLE PRECISION HWUECM,S,M1QUAD,M2QUAD + HWUECM = (S+M1QUAD-M2QUAD)/(2.D0*SQRT(S)) + END +CDECK ID>, HWUEDT. +*CMZ :- -09/12/91 12.07.08 by Mike Seymour +*-- Author : Mike Seymour +C----------------------------------------------------------------------- + SUBROUTINE HWUEDT(N,IEDT) +C----------------------------------------------------------------------- +C EDIT THE EVENT RECORD +C IF N>0 DELETE THE N ENTRIES IN IEDT FROM EVENT RECORD +C IF N<0 INSERT LINES AFTER THE -N ENTRIES IN IEDT +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + INTEGER N,IEDT(*),IMAP(0:NMXHEP),IHEP,I,J,I1,I2 + COMMON /HWUMAP/IMAP +C---MOVE ENTRIES AND CALCULATE MAPPING OF POINTERS + IF (N.EQ.0) THEN + RETURN + ELSEIF (N.GT.0) THEN + I=1 + I1=1 + I2=NHEP + ELSE + I=NHEP-N + I1=NHEP + I2=1 + ENDIF + DO 110 IHEP=I1,I2,SIGN(1,I2-I1) + IMAP(IHEP)=I + DO 100 J=1,ABS(N) + IF (IHEP.EQ.IEDT(J)) THEN + IF (N.GT.0) IMAP(IHEP)=0 + I=I-1 + IF (N.LT.0) IMAP(IHEP)=I + ENDIF + 100 CONTINUE + IF (IMAP(IHEP).EQ.I .AND. IHEP.NE.I) THEN + ISTHEP(I)=ISTHEP(IHEP) + IDHW(I)=IDHW(IHEP) + IDHEP(I)=IDHEP(IHEP) + JMOHEP(1,I)=JMOHEP(1,IHEP) + JMOHEP(2,I)=JMOHEP(2,IHEP) + JDAHEP(1,I)=JDAHEP(1,IHEP) + JDAHEP(2,I)=JDAHEP(2,IHEP) + CALL HWVEQU(5,PHEP(1,IHEP),PHEP(1,I)) + CALL HWVEQU(4,VHEP(1,IHEP),VHEP(1,I)) + ISTHEP(IHEP)=0 + IDHW(IHEP)=20 + IDHEP(IHEP)=0 + JMOHEP(1,IHEP)=0 + JMOHEP(2,IHEP)=0 + JDAHEP(1,IHEP)=0 + JDAHEP(2,IHEP)=0 + CALL HWVZRO(5,PHEP(1,IHEP)) + CALL HWVZRO(4,VHEP(1,IHEP)) + ENDIF + I=I+SIGN(1,N) + 110 CONTINUE + NHEP=NHEP-N +C---RELABEL POINTERS, SETTING ANY WHICH WERE TO DELETED ENTRIES TO ZERO + IMAP(0)=0 + DO 200 IHEP=1,NHEP + JMOHEP(1,IHEP)=IMAP(JMOHEP(1,IHEP)) + JMOHEP(2,IHEP)=IMAP(JMOHEP(2,IHEP)) + JDAHEP(1,IHEP)=IMAP(JDAHEP(1,IHEP)) + JDAHEP(2,IHEP)=IMAP(JDAHEP(2,IHEP)) + 200 CONTINUE + END +CDECK ID>, HWUEEC. +*CMZ :- -26/04/91 14.22.30 by Federico Carminati +*-- Author : Bryan Webber and Ian Knowles +C----------------------------------------------------------------------- + SUBROUTINE HWUEEC(IL) +C----------------------------------------------------------------------- +C Loads cross-section coefficients, for kinematically open channels, +C in llbar-->qqbar; lepton label IL=1-6: e,nu_e,mu,nu_mu,tau,nu_tau. +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + DOUBLE PRECISION Q2 + INTEGER IL,JL,IQ + Q2=EMSCA**2 + JL=IL+10 + MAXFL=0 + TQWT=0. + DO 10 IQ=1,NFLAV + IF (EMSCA.GT.2.*RMASS(IQ)) THEN + MAXFL=MAXFL+1 + MAPQ(MAXFL)=IQ + CALL HWUCFF(JL,IQ,Q2,CLQ(1,MAXFL)) + TQWT=TQWT+CLQ(1,MAXFL) + ENDIF + 10 CONTINUE + IF (MAXFL.EQ.0) CALL HWWARN('HWUEEC',100,*999) + 999 END +CDECK ID>, HWUEMV. +*CMZ :- -30/06/94 19.31.08 by Mike Seymour +*-- Author : Mike Seymour +C----------------------------------------------------------------------- + SUBROUTINE HWUEMV(N,IFROM,ITO) +C----------------------------------------------------------------------- +C MOVE A BLOCK OF ENTRIES IN THE EVENT RECORD +C N ENTRIES IN HEPEVT STARTING AT IFROM ARE MOVED TO AFTER ITO +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + INTEGER N,IFROM,ITO,IMAP(0:NMXHEP),LFROM,LTO,I,IEDT(NMXHEP),IHEP, + $ JHEP,KHEP + COMMON /HWUMAP/IMAP + LFROM=IFROM + LTO=ITO + DO 100 I=1,N + 100 IEDT(I)=LTO + CALL HWUEDT(-N,IEDT) + DO 300 I=1,N + IHEP=LTO+I + JHEP=IMAP(LFROM+I-1) + ISTHEP(IHEP)=ISTHEP(JHEP) + IDHW(IHEP)=IDHW(JHEP) + IDHEP(IHEP)=IDHEP(JHEP) + JMOHEP(1,IHEP)=JMOHEP(1,JHEP) + JMOHEP(2,IHEP)=JMOHEP(2,JHEP) + JDAHEP(1,IHEP)=JDAHEP(1,JHEP) + JDAHEP(2,IHEP)=JDAHEP(2,JHEP) + CALL HWVEQU(5,PHEP(1,JHEP),PHEP(1,IHEP)) + CALL HWVEQU(4,VHEP(1,JHEP),VHEP(1,IHEP)) + DO 200 KHEP=1,NHEP + IF (JMOHEP(1,KHEP).EQ.JHEP) JMOHEP(1,KHEP)=IHEP + IF (JMOHEP(2,KHEP).EQ.JHEP) JMOHEP(2,KHEP)=IHEP + IF (JDAHEP(1,KHEP).EQ.JHEP) JDAHEP(1,KHEP)=IHEP + IF (JDAHEP(2,KHEP).EQ.JHEP) JDAHEP(2,KHEP)=IHEP + 200 CONTINUE + IEDT(I)=JHEP + 300 CONTINUE + CALL HWUEDT(N,IEDT) + 999 END +CDECK ID>, HWUEPR. +*CMZ :- -27/07/99 13.33.03 by Mike Seymour +*-- Author : Ian Knowles, Bryan Webber & Kosuke Odagiri +C----------------------------------------------------------------------- + SUBROUTINE HWUEPR +C----------------------------------------------------------------------- +C Prints out event data in a number of possible formats: +C If (PRNDEF) ASCII to stout +C If (PRNTEX) LaTeX to the file HWEV_*******.tex +C Please check paper size and offsets given in mm +C Uses the package longtable.sty +C If (PRVTX>OR.NPRFMT.EQ.2) designed to be printed +C as landscape +C If (PRNWEB) HTML to the file HWEV_*******.html +C Call HWUDPR to create particle property files in +C the subdirectory HW_decays/ +C ******* gives the event number 0000001 etc. +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + INTEGER MMWIDE,MMLONG,MMHOFF,MMVOFF,I,IST,IS,ID,MS,J,K,IUNITW, + & IUNITT + CHARACTER*1 Z + CHARACTER*2 ZZ + CHARACTER*6 BGCOLS(5),TBCOLS(3),THEAD(17,3) + CHARACTER*7 HWUNST,TMPNME + CHARACTER*16 FNAMET + CHARACTER*17 FNAMEW + CHARACTER*27 FNAMEP + CHARACTER*28 TITLE(11),SECTXT + LOGICAL FIRST(11),NEWSEC + COMMON/PAPER/MMWIDE,MMLONG,MMHOFF,MMVOFF + EXTERNAL HWUNST +C + DATA BGCOLS/'ffffff','0000aa','aa0000','00aa00','aa00ff'/ + DATA TBCOLS/'ccccff','9966ff','ffff00'/ + DATA THEAD/ 17*'9966ff',17*'ffff00', + & 'IHEP ',' ID ',' IDPDG',' IST ',' MO1 ',' MO2 ', + & ' DA1 ',' DA2 ',' P-X ',' P-Y ',' P-Z ','ENERGY', + & ' MASS ',' V-X ',' V-Y ',' V-Z ',' V-C*T'/ + DATA TITLE/' ---INITIAL STATE--- ', + & ' ---HARD SUBPROCESS--- ', + & ' ---PARTON SHOWERS--- ', + & ' ---GLUON SPLITTING--- ', + & ' ---CLUSTER FORMATION--- ', + & ' ---CLUSTER DECAYS--- ', + & ' ---STRONG HADRON DECAYS--- ', + & ' ---HEAVY PARTICLE DECAYS---', + & ' ---H/W/Z BOSON DECAYS--- ', + & ' ---SOFT UNDERLYING EVENT---', + & ' ---MULTIPLE SCATTERING--- '/ + Z=CHAR(92) + ZZ=Z//Z +C + IUNITT=50 + IUNITW=51 +C Write out any required file header information + TMPNME=HWUNST(NEVHEP) + IF (PRNTEX) THEN + WRITE(FNAMET,'(A5,A7,A4)') 'HWEV_',TMPNME,'.tex' + OPEN(IUNITT,STATUS='UNKNOWN',FILE=FNAMET) + IF (PRVTX.OR.NPRFMT.EQ.2) THEN + WRITE(IUNITT,10) Z,Z,Z,MMLONG,Z,MMWIDE,Z,MMVOFF,Z,MMHOFF,Z,Z,Z + ELSE + WRITE(IUNITT,10) Z,Z,Z,MMWIDE,Z,MMLONG,Z,MMHOFF,Z,MMVOFF,Z,Z,Z + ENDIF + ENDIF + IF (PRNWEB) THEN + WRITE(FNAMEW,'(A5,A7,A5)') 'HWEV_',TMPNME,'.html' + OPEN(IUNITW,STATUS='UNKNOWN',FILE=FNAMEW) + WRITE(IUNITW,20) BGCOLS + ENDIF + 10 FORMAT(A1,'documentclass{article}'/A1,'usepackage{longtable}'/ + & A1,'textwidth ',I4,'mm ',A1,'textheight ',I4,'mm'/ + & A1,'hoffset ',I4,'mm ',A1,'voffset ',I4,'mm'/ + & A1,'pagestyle{empty}'/A1,'begin{document}'/A1,'begin{center}') + 20 FORMAT(''/''/''/ + & 'HERWIG Event Record'/''/ + & '') +C Write out event header details and set up tables + IF (PRNDEF) THEN + WRITE(6,30) NEVHEP,PBEAM1,PART1,PBEAM2,PART2,IPROC,NRN, + & ISTAT,IERROR,EVWGT + ENDIF + IF (PRNTEX) THEN + WRITE(IUNITT,40) Z,Z,Z,ISTAT,ZZ,Z,IPROC,PBEAM1,PBEAM2,NRN(1), + & IERROR,ZZ,Z,Z,NEVHEP,TXNAME(1,IDHW(1)),TXNAME(1,IDHW(2)), + & NRN(2),EVWGT,ZZ,Z,Z,Z + IF (PRVTX) THEN + WRITE(IUNITT,50) Z,Z,Z,Z,Z + ELSE + WRITE(IUNITT,60) Z,Z,Z,Z,Z + ENDIF + ENDIF + IF (PRNWEB) THEN + WRITE(IUNITW,70) TBCOLS(1),TBCOLS(2),(TBCOLS(2),TBCOLS(3), + & I=1,4),ISTAT,TBCOLS(2),TBCOLS(3),IPROC,PBEAM1,PBEAM2,NRN(1), + & TBCOLS(2),TBCOLS(3),IERROR + WRITE(IUNITW,71) TBCOLS(2),TBCOLS(3),NEVHEP,TXNAME(2,IDHW(1)), + & TXNAME(2,IDHW(2)),NRN(2),TBCOLS(2),TBCOLS(3),EVWGT,TBCOLS(1) + ENDIF + 30 FORMAT(///1X,'EVENT ',I7,':',F8.2,' GEV/C ',A8,' ON ',F8.2, + & ' GEV/C ',A8,' PROCESS:',I6/1X,'SEEDS: ',I11,' & ',I11, + & ' STATUS: ',I4,' ERROR:',I4,' WEIGHT: ',1P,E11.4/) + 40 FORMAT(A1,'begin{tabular}{|l|r|c|c|r|l|c|}'/A1,'hline'/ + & A1,'multicolumn{2}{|c|}{HERWIG 6.0} & Beam 1: & Beam 2: & ', + & 'Seeds: & Status: & ',I4, ' ',A2/A1,'hline'/'Process: & ',I6, + & ' & ',F8.2,'~GeV/c & ',F8.2,'~GeV/c',' & ',I11,' & Error: & ', + & I4,' ',A2/A1,'cline{1-2} ',A1,'cline{6-7}'/'Event: & ',I7,' & ', + & A37,' & ',A37,' & ',I11,' & Weight: & ',1P,E11.4,' ',A2/A1, + & 'hline'/A1,'end{tabular}'/A1,'vskip 5mm') + 50 FORMAT(A1,'begin{longtable}{|r|c|r|r|r|r|r|r|r|r|r|r|r|r|r|r|r|}'/ + & A1,'hline'/A1,'endhead'/A1,'hline'/A1,'endfoot') + 60 FORMAT(A1,'begin{longtable}{|r|c|r|r|r|r|r|r|r|r|r|r|r|}'/ + & A1,'hline'/A1,'endhead'/A1,'hline'/A1,'endfoot') + 70 FORMAT(/'

'/''/ + & ''/''/ + & ''/ + & ''/ + & ''/ + & ''/''/''/ + & ''/ + & ''/''/ + & ''/''/ + & ''/ + & ''/''/'') + 71 FORMAT(''/ + & ''/''/ + & ''/ + & ''/ + & ''/ + & ''/''/''/ + & '
', + & '', + & 'HERWIG 6.0Beam 1:Beam 2:Seeds:Status:',I4,'
Process:',I6,'',F8.2,' GeV/c',F8.2,' GeV/c',I11,'Error:',I4,'
Event:',I7,'',A37,'',A37,'',I11,'Weight:',1P,E11.4,'
'//'

'/ + & '') +C Initialize control flags + DO 80 I=1,11 + 80 FIRST(I)=.TRUE. +C Loop through event record + DO 410 I=1,NHEP + NEWSEC=.FALSE. +C First find start of new sections + IST=ISTHEP(I) + IS=IST/10 + ID=IDHW(I) + IF (IST.EQ.101) THEN + NEWSEC=.TRUE. + SECTXT=TITLE(1) + ELSEIF (FIRST(2).AND.IS.EQ.12) THEN + NEWSEC=.TRUE. + SECTXT=TITLE(2) + FIRST(2)=.FALSE. + ELSEIF (FIRST(3).AND.IS.EQ.14) THEN + NEWSEC=.TRUE. + SECTXT=TITLE(3) + FIRST(3)=.FALSE. + FIRST(8)=.TRUE. + FIRST(9)=.TRUE. + FIRST(11)=.TRUE. + ELSEIF (FIRST(4).AND.IST.GE.158.AND.IST.NE.160 + & .AND.IST.LE.162) THEN + NEWSEC=.TRUE. + SECTXT=TITLE(4) + FIRST(4)=.FALSE. + ELSEIF (FIRST(5).AND.(IS.EQ.16.OR.IS.EQ.18) + & .AND.IST.GT.162) THEN + NEWSEC=.TRUE. + SECTXT=TITLE(5) + FIRST(5)=.FALSE. + ELSEIF (IS.EQ.19.OR.IST.EQ.1.OR.IST.EQ.200) THEN + MS=ISTHEP(JMOHEP(1,I))/10 + IF (MS.EQ.15.OR.MS.EQ.16.OR.MS.EQ.18) THEN + IF (FIRST(6)) THEN + NEWSEC=.TRUE. + SECTXT=TITLE(6) + FIRST(6)=.FALSE. + ENDIF + ELSEIF (FIRST(7).AND.(.NOT.FIRST(6))) THEN + NEWSEC=.TRUE. + SECTXT=TITLE(7) + FIRST(7)=.FALSE. + ENDIF + ELSEIF (FIRST(8).AND.(IST.EQ.125.OR.IST.EQ.155.OR. + & (IST.EQ.123.AND.ISTHEP(JMOHEP(1,I)).EQ.199))) THEN + NEWSEC=.TRUE. + SECTXT=TITLE(8) + FIRST(3)=.TRUE. + FIRST(4)=.TRUE. + FIRST(5)=.TRUE. + FIRST(6)=.TRUE. + FIRST(7)=.TRUE. + FIRST(8)=.FALSE. + ELSEIF (FIRST(9).AND.(IST.EQ.123.OR.IST.EQ.124)) THEN + MS=ABS(IDHEP(JMOHEP(1,I))) + IF (MS.EQ.23.OR.MS.EQ.24.OR.MS.EQ.25) THEN + NEWSEC=.TRUE. + SECTXT=TITLE(9) + FIRST(3)=.TRUE. + FIRST(4)=.TRUE. + FIRST(5)=.TRUE. + FIRST(6)=.TRUE. + FIRST(7)=.TRUE. + FIRST(8)=.TRUE. + FIRST(9)=.FALSE. + ENDIF + ELSEIF (IST.EQ.170) THEN + NEWSEC=.TRUE. + SECTXT=TITLE(10) + ELSEIF (FIRST(11).AND.(ID.EQ.71.OR.ID.EQ.72)) THEN + NEWSEC=.TRUE. + SECTXT=TITLE(11) + FIRST(3)=.TRUE. + FIRST(11)=.FALSE. + ENDIF +C Prit out section heading + IF (NEWSEC) THEN + IF (PRVTX) THEN + IF (PRNDEF) THEN + IF (NPRFMT.EQ.1) THEN + WRITE(6, 90) SECTXT,(THEAD(J,3),J=1,17) + ELSE + WRITE(6,100) SECTXT,(THEAD(J,3),J=1,17) + ENDIF + ENDIF + IF (PRNTEX) WRITE(IUNITT,110) Z,Z,SECTXT,ZZ,Z, + & (Z,THEAD(J,3),J=1,17),ZZ,Z + IF (PRNWEB) WRITE(IUNITW,120) TBCOLS(2),TBCOLS(3), + & SECTXT,((THEAD(K,J),J=1,3),K=1,17) + 90 FORMAT(/46X,A28//1X,A4,2X,A6,3X,A6,5A4,3(2X,A6),A6,3X,A5, + & 4(4X,A6)) + 100 FORMAT(/58X,A28//1X,A4,2X,A6,3X,A6,5A4,3(6X,A6),5X,A6,8X,A5, + & 4X,A6,2(5X,A6),6X,A6) + 110 FORMAT(A1,'hline'/A1,'multicolumn{17}{|c|}{',A28,'} ',A2/A1, + & 'hline'/16(A1,'multicolumn{1}{|c|}{',A6,'} & '), + & A1,'multicolumn{1}{|c|}{',A6,'} ',A2/A1,'hline') + 120 FORMAT(''/ + & '',17(/,1X,''),'') + ELSE + IF (PRNDEF) THEN + IF (NPRFMT.EQ.1) THEN + WRITE(6,130) SECTXT,(THEAD(J,3),J=1,13) + ELSE + WRITE(6,140) SECTXT,(THEAD(J,3),J=1,13) + ENDIF + END IF + IF (PRNTEX) WRITE(IUNITT,150) Z,Z,SECTXT,ZZ,Z, + & (Z,THEAD(J,3),J=1,13),ZZ,Z + IF (PRNWEB) WRITE(IUNITW,160) TBCOLS(2),TBCOLS(3), + & SECTXT,((THEAD(K,J),J=1,3),K=1,13) + 130 FORMAT(/26X,A28//1X,A4,2X,A6,3X,A6,5A4,3(2X,A6),A6,3X,A5) + 140 FORMAT(/36X,A28//1X,A4,2X,A6,3X,A6,5A4,3(6X,A6),5X,A6,8X,A5) + 150 FORMAT(A1,'hline'/A1,'multicolumn{13}{|c|}{',A28,'} ',A2/A1, + & 'hline'/12(A1,'multicolumn{1}{|c|}{',A6,'} & '), + & A1,'multicolumn{1}{|c|}{',A6,'} ',A2/A1,'hline') + 160 FORMAT(''/ + & '',13(/''),'') + ENDIF + ENDIF +C Now print out the data line + IF (PRVTX) THEN +C Include vertex information + IF (PRNDEF) THEN + IF (PRNDEC) THEN + IF (NPRFMT.EQ.1) THEN + WRITE(6,190) I,RNAME(IDHW(I)),IDHEP(I),IST, + & JMOHEP(1,I),JMOHEP(2,I),JDAHEP(1,I),JDAHEP(2,I), + & (PHEP(J,I),J=1,5),(VHEP(J,I),J=1,4) + ELSE + WRITE(6,200) I,RNAME(IDHW(I)),IDHEP(I),IST, + & JMOHEP(1,I),JMOHEP(2,I),JDAHEP(1,I),JDAHEP(2,I), + & (PHEP(J,I),J=1,5),(VHEP(J,I),J=1,4) + ENDIF + ELSE + IF (NPRFMT.EQ.1) THEN + WRITE(6,210) I,RNAME(IDHW(I)),IDHEP(I),IST, + & JMOHEP(1,I),JMOHEP(2,I),JDAHEP(1,I),JDAHEP(2,I), + & (PHEP(J,I),J=1,5),(VHEP(J,I),J=1,4) + ELSE + WRITE(6,220) I,RNAME(IDHW(I)),IDHEP(I),IST, + & JMOHEP(1,I),JMOHEP(2,I),JDAHEP(1,I),JDAHEP(2,I), + & (PHEP(J,I),J=1,5),(VHEP(J,I),J=1,4) + ENDIF + ENDIF + ENDIF + IF (PRNTEX) WRITE(IUNITT,230) I,TXNAME(1,IDHW(I)),IDHEP(I), + & IST,JMOHEP(1,I),JMOHEP(2,I),JDAHEP(1,I),JDAHEP(2,I), + & (PHEP(J,I),J=1,5),(VHEP(J,I),J=1,4),ZZ + IF (PRNWEB) THEN + WRITE(IUNITW,240) TBCOLS(2),TBCOLS(3),I,I + IF (IDHEP(I).EQ.0.OR.IDHEP(I).EQ.91) THEN + WRITE(IUNITW,250) TXNAME(2,IDHW(I)),IDHEP(I),IST + ELSE + TMPNME=HWUNST(IDHW(I)) + WRITE(FNAMEP,'(A15,A7,A5)') + & 'HW_decays/PART_',TMPNME,'.html' + WRITE(IUNITW,260) FNAMEP,TXNAME(2,IDHW(I)),IDHEP(I),IST + ENDIF + DO 170 J=1,2 + IF (JMOHEP(J,I).NE.0) THEN + WRITE(IUNITW,270) JMOHEP(J,I),JMOHEP(J,I) + ELSE + WRITE(IUNITW,280) JMOHEP(J,I) + ENDIF + 170 CONTINUE + DO 180 J=1,2 + IF (JDAHEP(J,I).NE.0) THEN + WRITE(IUNITW,270) JDAHEP(J,I),JDAHEP(J,I) + ELSE + WRITE(IUNITW,280) JDAHEP(J,I) + ENDIF + 180 CONTINUE + IF (NPRFMT.EQ.1) THEN + WRITE(IUNITW,290) (PHEP(J,I),J=1,5),(VHEP(J,I),J=1,4) + ELSE + WRITE(IUNITW,300) (PHEP(J,I),J=1,5),(VHEP(J,I),J=1,4) + ENDIF + ENDIF + 190 FORMAT(1X,I4,1X,A8,I8,5I4, 2F8.2,2F7.1,F8.2,1P,4E10.3) + 200 FORMAT(1X,I4,1X,A8,I8,5I4, 5F12.5,1P,4E11.4) + 210 FORMAT(1X,Z4,1X,A8,I8,I4,4Z4,2F8.2,2F7.1,F8.2,1P,4E10.3) + 220 FORMAT(1X,Z4,1X,A8,I8,I4,4Z4,5F12.5,1P,4E11.4) + 230 FORMAT(I4,' & ',A37,' & $',I8,'$',5(' & ',I4), + & 5(' & $',F8.2,'$'),4(' & $',1P,E11.3,'$'),' ',A2) + 240 FORMAT(''/''/) + 250 FORMAT(''/''/'') + 260 FORMAT(''/ + & ''/ + & '') + 270 FORMAT(/'') + 280 FORMAT(/'') + 290 FORMAT(5(/''),1P, + & 4(/'')/'') + 300 FORMAT(5(/''),1P, + & 4(/'')/'') + ELSE +C Do not include vertex information + IF (PRNDEF) THEN + IF (PRNDEC) THEN + IF (NPRFMT.EQ.1) THEN + WRITE(6,330) I,RNAME(IDHW(I)),IDHEP(I),IST, + & JMOHEP(1,I),JMOHEP(2,I),JDAHEP(1,I),JDAHEP(2,I), + & (PHEP(J,I),J=1,5) + ELSE + WRITE(6,340) I,RNAME(IDHW(I)),IDHEP(I),IST, + & JMOHEP(1,I),JMOHEP(2,I),JDAHEP(1,I),JDAHEP(2,I), + & (PHEP(J,I),J=1,5) + ENDIF + ELSE + IF (NPRFMT.EQ.1) THEN + WRITE(6,350) I,RNAME(IDHW(I)),IDHEP(I),IST, + & JMOHEP(1,I),JMOHEP(2,I),JDAHEP(1,I),JDAHEP(2,I), + & (PHEP(J,I),J=1,5) + ELSE + WRITE(6,360) I,RNAME(IDHW(I)),IDHEP(I),IST, + & JMOHEP(1,I),JMOHEP(2,I),JDAHEP(1,I),JDAHEP(2,I), + & (PHEP(J,I),J=1,5) + ENDIF + ENDIF + ENDIF + IF (PRNTEX) THEN + IF (NPRFMT.EQ.1) THEN + WRITE(IUNITT,370) I,TXNAME(1,IDHW(I)),IDHEP(I), + & IST,JMOHEP(1,I),JMOHEP(2,I),JDAHEP(1,I),JDAHEP(2,I), + & (PHEP(J,I),J=1,5),ZZ + ELSE + WRITE(IUNITT,380) I,TXNAME(1,IDHW(I)),IDHEP(I), + & IST,JMOHEP(1,I),JMOHEP(2,I),JDAHEP(1,I),JDAHEP(2,I), + & (PHEP(J,I),J=1,5),ZZ + ENDIF + ENDIF + IF (PRNWEB) THEN + WRITE(IUNITW,240) TBCOLS(2),TBCOLS(3),I,I + IF (IDHEP(I).EQ.0.OR.IDHEP(I).EQ.91) THEN + WRITE(IUNITW,250) TXNAME(2,IDHW(I)),IDHEP(I),IST + ELSE + TMPNME = HWUNST(IDHW(I)) + WRITE(FNAMEP,'(A15,A7,A5)') + & 'HW_decays/PART_',TMPNME,'.html' + WRITE(IUNITW,260) FNAMEP,TXNAME(2,IDHW(I)),IDHEP(I),IST + ENDIF + DO 310 J=1,2 + IF (JMOHEP(J,I).NE.0) THEN + WRITE(IUNITW,270) JMOHEP(J,I),JMOHEP(J,I) + ELSE + WRITE(IUNITW,280) JMOHEP(J,I) + ENDIF + 310 CONTINUE + DO 320 J=1,2 + IF (JDAHEP(J,I).NE.0) THEN + WRITE(IUNITW,270) JDAHEP(J,I),JDAHEP(J,I) + ELSE + WRITE(IUNITW,280) JDAHEP(J,I) + ENDIF + 320 CONTINUE + IF (NPRFMT.EQ.1) THEN + WRITE(IUNITW,390) (PHEP(J,I),J=1,5) + ELSE + WRITE(IUNITW,400) (PHEP(J,I),J=1,5) + ENDIF + ENDIF + 330 FORMAT(1X,I4,1X,A8,I8,5I4 ,2F8.2,2F7.1,F8.2) + 340 FORMAT(1X,I4,1X,A8,I8,5I4 ,5F12.5) + 350 FORMAT(1X,Z4,1X,A8,I8,I4,4Z4,2F8.2,2F7.1,F8.2) + 360 FORMAT(1X,Z4,1X,A8,I8,I4,4Z4,5F12.5) + 370 FORMAT(I4,' & ',A37,' & $',I8,'$',5(' & ',I4), + & 5(' & $',F8.2,'$'),' ',A2) + 380 FORMAT(I4,' & ',A37,' & $',I8,'$',5(' & ',I4), + & 5(' & $',F12.5,'$'),' ',A2) + 390 FORMAT(5(/'')/'') + 400 FORMAT(5(/'')/'') + ENDIF + 410 CONTINUE +C Close the files + IF (PRNTEX) THEN + WRITE(IUNITT,420) Z,Z,Z + 420 FORMAT(A1,'end{longtable}'/A1,'end{center}'/A1,'end{document}') + CLOSE(IUNITT) + ENDIF + IF (PRNWEB) THEN + WRITE(IUNITW,430) + 430 FORMAT('
', + & '',A28,'
+ & ',A6,'
', + & '',A28,'
', + & '',A6,'
', + & '',I4,'',A37,'', + & I8,'',I4,'',A37,'',I8,'',I4,'',I4,'',I4,'',F8.2,'',E10.3,'
',F12.5,'',E11.4,'
',F8.2,'
',F12.5,'
'/'

'/''/'') + CLOSE(IUNITW) + ENDIF + RETURN + END +CDECK ID>, HWUFNE. +*CMZ :- -16/10/93 12.42.15 by Mike Seymour +*-- Author : Mike Seymour +C----------------------------------------------------------------------- + SUBROUTINE HWUFNE +C----------------------------------------------------------------------- +C FINALISES THE EVENT BY UNDOING THE LORENTZ BOOST IF THERE WAS ONE, +C CHECKING FOR ERRORS, AND PRINTING +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + LOGICAL CALLED + COMMON/HWDBUG/CALLED + CALLED=.TRUE. +C---UNBOOST EVENT RECORD IF NECESSARY + CALL HWUBST(0) +C---CHECK FOR FATAL ERROR + IF (IERROR.NE.0) THEN + IF (IERROR.GT.0) THEN + NUMER=NUMER+1 + ELSE + NUMERU=NUMERU+1 + ENDIF + IF (NUMER.GT.MAXER) CALL HWWARN('HWUFNE',300,*999) + NEVHEP=NEVHEP-1 +C---PRINT FIRST MAXPR EVENTS + ELSEIF (NEVHEP.LE.MAXPR) THEN + CALL HWUEPR + END IF + 999 END +CDECK ID>, HWUGAU. +*CMZ :- -26/04/91 11.11.56 by Bryan Webber +*-- Author : Adapted by Bryan Webber +C----------------------------------------------------------------------- + FUNCTION HWUGAU(F,A,B,EPS) +C----------------------------------------------------------------------- +C ADAPTIVE GAUSSIAN INTEGRATION OF FUNCTION F +C IN INTERVAL (A,B) WITH PRECISION EPS +C (MODIFIED CERN LIBRARY ROUTINE GAUSS) +C----------------------------------------------------------------------- + DOUBLE PRECISION HWUGAU,F,A,B,EPS,CONST,AA,BB,C1,C2,S8,U,S16, + & W(12),X(12),ZERO + INTEGER I + EXTERNAL F + PARAMETER (ZERO=0.0D0) + DATA W/.1012285363D0,.2223810345D0,.3137066459D0, + & .3626837834D0,.0271524594D0,.0622535239D0, + & .0951585117D0,.1246289713D0,.1495959888D0, + & .1691565194D0,.1826034150D0,.1894506105D0/ + DATA X/.9602898565D0,.7966664774D0,.5255324099D0, + & .1834346425D0,.9894009350D0,.9445750231D0, + & .8656312024D0,.7554044084D0,.6178762444D0, + & .4580167777D0,.2816035508D0,.0950125098D0/ + HWUGAU=0. + IF (A.EQ.B) RETURN + CONST=.005/ABS(B-A) + BB=A + 1 AA=BB + BB=B + 2 C1=0.5*(BB+AA) + C2=0.5*(BB-AA) + S8=0. + DO 3 I=1,4 + U=C2*X(I) + S8=S8+W(I)*(F(C1+U)+F(C1-U)) + 3 CONTINUE + S8=C2*S8 + S16=0. + DO 4 I=5,12 + U=C2*X(I) + S16=S16+W(I)*(F(C1+U)+F(C1-U)) + 4 CONTINUE + S16=C2*S16 + IF (ABS(S16-S8).LE.EPS*(1.+ABS(S16))) GOTO 5 + BB=C1 + IF (CONST*ABS(C2).NE.ZERO) GOTO 2 +C---TOO HIGH ACCURACY REQUESTED + CALL HWWARN('HWUGAU',500,*999) + 5 HWUGAU=HWUGAU+S16 + IF (BB.NE.B) GOTO 1 + 999 END +CDECK ID>, HWUIDT. +*CMZ :- -26/04/91 10.18.58 by Bryan Webber +*-- Author : Bryan Webber +C----------------------------------------------------------------------- + SUBROUTINE HWUIDT(IOPT,IPDG,IWIG,NWIG) +C----------------------------------------------------------------------- +C TRANSLATES PARTICLE IDENTIFIERS: +C IPDG = PARTICLE DATA GROUP CODE +C IWIG = HERWIG IDENTITY CODE +C NWIG = HERWIG CHARACTER*8 NAME +C +C IOPT= 1 GIVEN IPDG, RETURNS IWIG AND NWIG +C IOPT= 2 GIVEN IWIG, RETURNS IPDG AND NWIG +C IOPT= 3 GIVEN NWIG, RETURNS IPDG AND IWIG +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + INTEGER IOPT,IPDG,IWIG,I + CHARACTER*8 NWIG + IF (IOPT.EQ.1) THEN + DO 10 I=0,NRES + IF (IDPDG(I).EQ.IPDG) THEN + IWIG=I + NWIG=RNAME(I) + RETURN + ENDIF + 10 CONTINUE + WRITE(6,20) IPDG + 20 FORMAT(1X,'Particle not recognised, PDG code: ',I8) + IWIG=20 + NWIG=RNAME(20) + CALL HWWARN('HWUIDT',101,*999) + ELSEIF (IOPT.EQ.2) THEN + IF (IWIG.LT.0.OR.IWIG.GT.NRES) THEN + WRITE(6,30) IWIG + 30 FORMAT(1X,'Particle not recognised, HERWIG code: ',I3) + IPDG=0 + NWIG=RNAME(20) + CALL HWWARN('HWUIDT',102,*999) + ELSE + IPDG=IDPDG(IWIG) + NWIG=RNAME(IWIG) + RETURN + ENDIF + ELSEIF (IOPT.EQ.3) THEN + DO 40 I=0,NRES + IF (RNAME(I).EQ.NWIG) THEN + IWIG=I + IPDG=IDPDG(I) + RETURN + ENDIF + 40 CONTINUE + WRITE(6,50) NWIG + 50 FORMAT(1X,'Particle not recognised, HERWIG name: ',A8) + IWIG=20 + IPDG=0 + CALL HWWARN('HWUIDT',103,*999) + ELSE + CALL HWWARN('HWUIDT',404,*999) + ENDIF + 999 END +CDECK ID>, HWUINC. +*CMZ :- -26/04/91 11.11.56 by Bryan Webber +*-- Author : Bryan Webber +C----------------------------------------------------------------------- + SUBROUTINE HWUINC +C----------------------------------------------------------------------- +C COMPUTES CONSTANTS AND LOOKUP TABLES +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + DOUBLE PRECISION HWBVMC,HWUALF,HWUPCM,XMIN,XMAX,XPOW,QR,DQKWT, + & UQKWT,SQKWT,DIQWT,QMAX,PMAX,PTLIM,ETLIM,PGS,PTELM,X,QSCA,UPV,DNV, + & USEA,DSEA,STR,CHM,BTM,TOP,GLU,VAL(20),CLMXPW,RCLPOW,TEST,RPM(2) + INTEGER ISTOP,I,J,IQK,IDB,IDT,ISET,IOP1,IOP2,IP2,ID + LOGICAL FIRST,FSTPDF + CHARACTER*20 PARM(20) + EXTERNAL HWBVMC,HWUALF,HWUPCM + COMMON/HWRPIN/XMIN,XMAX,XPOW,FIRST + COMMON/W50516/FSTPDF + IPRO=MOD(IPROC/100,100) + IQK=MOD(IPROC,100) +C---SET UP BEAMS + CALL HWUIDT(3,IDB,IPART1,PART1) + CALL HWUIDT(3,IDT,IPART2,PART2) + EBEAM1=SQRT(PBEAM1**2+RMASS(IPART1)**2) + EBEAM2=SQRT(PBEAM2**2+RMASS(IPART2)**2) +C---PHOTON CUTOFF DEFAULTS TO ROOT S + PTLIM=SQRT(HALF*(EBEAM1*EBEAM2+PBEAM1*PBEAM2)) + ETLIM=TWO*PTLIM + IF (VPCUT.GT.ETLIM) VPCUT=ETLIM + IF (Q2MAX.GT.ETLIM**2) Q2MAX=ETLIM**2 +C---PRINT OUT MOST IMPORTANT INPUT PARAMETERS + IF (IPRINT.EQ.0) GOTO 50 + WRITE (6,10) PART1,PBEAM1,PART2,PBEAM2,IPROC,NFLAV,NSTRU, + & AZSPIN,AZSOFT,QCDLAM,(RMASS(I),I=1,6),RMASS(13) + IF (ISPAC.LE.1) THEN + WRITE (6,20) VQCUT,VGCUT,VPCUT,CLMAX,QSPAC,PTRMS + ELSE + WRITE (6,30) VQCUT,VGCUT,VPCUT,CLMAX,QSPAC,PTRMS + ENDIF + IF (NOSPAC) WRITE (6,40) + 10 FORMAT(/10X,'INPUT CONDITIONS FOR THIS RUN'// + & 10X,'BEAM 1 (',A8,') MOM. =',F10.2/ + & 10X,'BEAM 2 (',A8,') MOM. =',F10.2/ + & 10X,'PROCESS CODE (IPROC) =',I8/ + & 10X,'NUMBER OF FLAVOURS =',I5/ + & 10X,'STRUCTURE FUNCTION SET =',I5/ + & 10X,'AZIM SPIN CORRELATIONS =',L5/ + & 10X,'AZIM SOFT CORRELATIONS =',L5/ + & 10X,'QCD LAMBDA (GEV) =',F10.4/ + & 10X,'DOWN QUARK MASS =',F10.4/ + & 10X,'UP QUARK MASS =',F10.4/ + & 10X,'STRANGE QUARK MASS =',F10.4/ + & 10X,'CHARMED QUARK MASS =',F10.4/ + & 10X,'BOTTOM QUARK MASS =',F10.4/ + & 10X,'TOP QUARK MASS =',F10.4/ + & 10X,'GLUON EFFECTIVE MASS =',F10.4) + 20 FORMAT(10X,'EXTRA SHOWER CUTOFF (Q)=',F10.4/ + & 10X,'EXTRA SHOWER CUTOFF (G)=',F10.4/ + & 10X,'PHOTON SHOWER CUTOFF =',F10.4/ + & 10X,'CLUSTER MASS PARAMETER =',F10.4/ + & 10X,'SPACELIKE EVOLN CUTOFF =',F10.4/ + & 10X,'INTRINSIC P-TRAN (RMS) =',F10.4) + 30 FORMAT(10X,'EXTRA SHOWER CUTOFF (Q)=',F10.4/ + & 10X,'EXTRA SHOWER CUTOFF (G)=',F10.4/ + & 10X,'PHOTON SHOWER CUTOFF =',F10.4/ + & 10X,'CLUSTER MASS PARAMETER =',F10.4/ + & 10X,'PDF FREEZING CUTOFF =',F10.4/ + & 10X,'INTRINSIC P-TRAN (RMS) =',F10.4) + 40 FORMAT(10X,'NO SPACE-LIKE SHOWERS') + 50 ISTOP=0 +C---INITIALIZE ALPHA-STRONG + IF (QLIM.GT.ETLIM) QLIM=ETLIM + QR=HWUALF(0,QLIM) +C---DO SOME SAFETY CHECKS ON INPUT PARAMETERS +C Check beam order for point-like photon/QCD processes + IF (IPRO.GE.50.AND.IPRO.LE.59.AND. + & IDB.NE.22.AND.ABS(IDB).NE.11.AND.ABS(IDB).NE.13) THEN + WRITE(6,60) + 60 FORMAT(1X,'WARNING: require FIRST beam to be a photon/lepton') + ISTOP=ISTOP+1 + ENDIF + QG=HWBVMC(13) + QR=QG/QCDL3 + IF (QR.GE.2.01) GOTO 80 + WRITE (6,70) QG,QCDLAM,QCDL3 + 70 FORMAT(//10X,'SHOWER GLUON VIRTUAL MASS CUTOFF =',F8.5/ + & 10X,'TOO SMALL RELATIVE TO QCD LAMBDA =',F8.5/ + & 10X,'CORRESPONDS TO 3-FLAV MC LAMBDA =',F8.5) + ISTOP=ISTOP+1 + 80 QV=MIN(HWBVMC(1),HWBVMC(2)) + IF (QV.GE.QG/(QR-1.)) GOTO 100 + ISTOP=ISTOP+1 + WRITE (6,90) QV,QCDLAM,QCDL3 + 90 FORMAT(//10X,'SHOWER QUARK VIRTUAL MASS CUTOFF =',F8.5/ + & 10X,'TOO SMALL RELATIVE TO QCD LAMBDA =',F8.5/ + & 10X,'CORRESPONDS TO 3-FLAV MC LAMBDA =',F8.5) + 100 IF (ISTOP.NE.0) THEN + WRITE (6,110) ISTOP + 110 FORMAT(//10X,'EXECUTION PREVENTED BY',I2, + & ' ERRORS IN INPUT PARAMETERS.') + STOP + ENDIF + DO 120 I=1,6 + 120 RMASS(I+6)=RMASS(I) + RMASS(199)=RMASS(198) +C---A PRIORI WEIGHTS FOR QUARK AND DIQUARKS + DQKWT=PWT(1) + UQKWT=PWT(2) + SQKWT=PWT(3) + DIQWT=PWT(7) + PWT(10)=PWT(4) + PWT(11)=PWT(5) + PWT(12)=PWT(6) +C + PWT(4)=UQKWT*UQKWT*DIQWT + PWT(5)=UQKWT*DQKWT*DIQWT*HALF + PWT(6)=DQKWT*DQKWT*DIQWT + PWT(7)=UQKWT*SQKWT*DIQWT*HALF + PWT(8)=DQKWT*SQKWT*DIQWT*HALF + PWT(9)=SQKWT*SQKWT*DIQWT + QMAX=MAX(PWT(1),PWT(2),PWT(3)) + PMAX=MAX(PWT(4),PWT(5),PWT(6),PWT(7),PWT(8),PWT(9), + & PWT(10),PWT(11),PWT(12),QMAX) + PMAX=1./PMAX + QMAX=1./QMAX + DO 130 I=1,3 + 130 QWT(I)=PWT(I)*QMAX + DO 140 I=1,12 + 140 PWT(I)=PWT(I)*PMAX +C MASSES OF DIQUARKS (ASSUME BINDING NEGLIGIBLE) + RMASS(109)=RMASS(2)+RMASS(2) + RMASS(110)=RMASS(1)+RMASS(2) + RMASS(111)=RMASS(1)+RMASS(1) + RMASS(112)=RMASS(2)+RMASS(3) + RMASS(113)=RMASS(1)+RMASS(3) + RMASS(114)=RMASS(3)+RMASS(3) + DO 150 I=109,114 + 150 RMASS(I+6)=RMASS(I) +C MASSES OF TOP HADRONS (ASSUME BINDING NEGLIGIBLE) + RMASS(232)=RMASS(6)+RMASS(5) + RMASS(233)=RMASS(6)+RMASS(1) + RMASS(234)=RMASS(6)+RMASS(2) + RMASS(235)=RMASS(6)+RMASS(3) + RMASS(236)=RMASS(6)+RMASS(2)+RMASS(2) + RMASS(237)=RMASS(6)+RMASS(1)+RMASS(2) + RMASS(238)=RMASS(6)+RMASS(1)+RMASS(1) + RMASS(239)=RMASS(6)+RMASS(2)+RMASS(3) + RMASS(240)=RMASS(6)+RMASS(1)+RMASS(3) + RMASS(241)=RMASS(6)+RMASS(3)+RMASS(3) + RMASS(242)=RMASS(6)+RMASS(4) + RMASS(243)=RMASS(6)+RMASS(5) + RMASS(244)=RMASS(6)+RMASS(6) + RMASS(232)=RMASS(243) + DO 160 I=233,242 + 160 RMASS(I+22)=RMASS(I) +C Set up an array of cluster mass threholds + CLMXPW=CLMAX**CLPOW + RCLPOW=ONE/CLPOW + CALL HWVZRO(144,CTHRPW(1,1)) + DO 170 I=1,6 + DO 170 J=1,6 + CTHRPW(I ,J )=(CLMXPW+(RMASS(I )+RMASS(J+6 ))**CLPOW)**RCLPOW + CTHRPW(I ,J+6)=(CLMXPW+(RMASS(I )+RMASS(J+108))**CLPOW)**RCLPOW + 170 CTHRPW(I+6,J )=(CLMXPW+(RMASS(I+114)+RMASS(J+6 ))**CLPOW)**RCLPOW +C Decay length conversion factor GEV2MM hbar.c/e + GEV2MM=1.D-15*SQRT(GEV2NB/10.) +C Plank's constant/2pi (GeV.s) + HBAR=GEV2MM/CSPEED +C---IMPORTANCE SAMPLING + FIRST=.TRUE. + IF (IPRO.EQ.5) THEN + IF (EMMAX.GT.ETLIM) EMMAX=ETLIM + IF (PTMAX.GT.PTLIM) PTMAX=PTLIM + ELSEIF (IPRO.EQ.13) THEN + IF (EMMIN.EQ.ZERO) EMMIN=10 + IF (EMMAX.GT.ETLIM) EMMAX=ETLIM + IF (IQK.GT.0.AND.IQK.LE.6) EMMIN=MAX(EMMIN,2*RMASS(IQK)) + XMIN=EMMIN + XMAX=EMMAX + XPOW=-EMPOW + ELSEIF (IPRO.EQ.15.OR.IPRO.EQ.17.OR.IPRO.EQ.18.OR.IPRO.EQ.21 + & .OR.IPRO.EQ.22.OR.IPRO.EQ.23.OR.IPRO.EQ.24.OR.IPRO.EQ.50 + & .OR.IPRO.EQ.51.OR.IPRO.EQ.53.OR.IPRO.EQ.55.OR.IPRO.EQ.60) THEN + IF (PTMAX.GT.PTLIM) PTMAX=PTLIM + IF (IQK.NE.0.AND.IQK.LT.7.AND.IPRO.NE.23) THEN + XMIN=2.*SQRT(PTMIN**2+RMASS(IQK)**2) + XMAX=2.*SQRT(PTMAX**2+RMASS(IQK)**2) + IF (XMAX.GT.ETLIM) XMAX=ETLIM + ELSE + XMIN=2.*PTMIN + XMAX=2.*PTMAX + ENDIF + XPOW=-PTPOW + ELSEIF (IPRO.EQ.52) THEN + PTELM=PTLIM-RMASS(IQK)**2/(4.*PTLIM) + IF (PTMAX.GT.PTELM) PTMAX=PTELM + XMIN=PTMIN + XMAX=PTMAX + XPOW=-PTPOW + ELSEIF (IPRO.EQ.30) THEN +C---CHECK THAT SUSY DATA HAVE BEEN INPUT + IF (.NOT.SUSYIN) CALL HWWARN('HWUINC',600,*999) + IF (PTMAX.GT.PTLIM) PTMAX=PTLIM + XMIN=2.*SQRT(PTMIN**2+RMMNSS**2) + XMAX=2.*SQRT(PTMAX**2+RMMNSS**2) + IF (XMAX.GT.ETLIM) XMAX=ETLIM + XPOW=-PTPOW +C--PR MOD 7/7/99 + ELSEIF(IPRO.EQ.40.OR.IPRO.EQ.41) THEN + IF (.NOT.SUSYIN) CALL HWWARN('HWUINC',600,*999) + IF (PTMAX.GT.PTLIM) PTMAX=PTLIM + ID = IPROC-100*IPRO + RPM(1) = RMMNSS + RPM(2) = ZERO + IF(ID.GE.10.AND.ID.LT.20) THEN + RPM(1) = ABS(RMASS(450)) + IF(ID.GT.10) RPM(1) = ABS(RMASS(449+MOD(ID,10))) + ELSEIF(ID.GE.20.AND.ID.LT.30) THEN + RPM(1) = ABS(RMASS(454)) + IF(ID.GT.20) RPM(1) = ABS(RMASS(453+MOD(ID,20))) + ELSEIF(ID.EQ.30) THEN + RPM(1) = RMASS(449) + ELSEIF(ID.EQ.40) THEN + IF(IPRO.EQ.40) THEN + RPM(1) = RMASS(425) + DO I=1,5 + RPM(1) = MIN(RPM(1),RMASS(425+I)) + ENDDO + ELSE + RPM(1) = MIN(RMASS(405),RMASS(406)) + ENDIF + RPM(2) = RMASS(198) + ELSEIF(ID.EQ.50) THEN + IF(IPRO.EQ.40) THEN + RPM(1) = RMASS(425) + DO I=1,5 + RPM(1) = MIN(RPM(1),RMASS(425+I)) + ENDDO + DO I=1,3 + RPM(2) = MIN(RPM(1),RMASS(433+2*I)) + ENDDO + RPM(1) = MIN(RPM(1),RPM(2)) + RPM(2) = RMASS(203) + DO I=1,2 + RPM(2) = MIN(RPM(2),RMASS(204+I)) + ENDDO + ELSE + RPM(1) = RMASS(401) + RPM(2) = RMASS(413) + DO I=1,5 + RPM(1) = MIN(RPM(1),RMASS(401+I)) + RPM(2) = MIN(RPM(2),RMASS(413+I)) + ENDDO + RPM(1) = MIN(RPM(1),RPM(2)) + RPM(2) = RMASS(203) + DO I=1,2 + RPM(2) = MIN(RPM(2),RMASS(204+I)) + ENDDO + ENDIF + RPM(2) = RMASS(203) + DO I=1,2 + RPM(2) = MIN(RPM(2),RMASS(204+I)) + ENDDO + ELSEIF(ID.GE.60) THEN + RPM(1) = ZERO + ENDIF + RPM(1) = RPM(1)**2 + RPM(2) = RPM(2)**2 + XMIN = SQRT(RPM(1)+RPM(2)+TWO*(PTMIN**2+ + & SQRT(RPM(1)*RPM(2)+PTMIN**2*(RPM(1)+RPM(2)+PTMIN**2)))) + XMAX = SQRT(RPM(1)+RPM(2)+TWO*(PTMAX**2+ + & SQRT(RPM(1)*RPM(2)+PTMAX**2*(RPM(1)+RPM(2)+PTMAX**2)))) + IF (XMAX.GT.ETLIM) XMAX=ETLIM +C--end of mod + ELSEIF (IPRO.EQ.90) THEN + XMIN=SQRT(Q2MIN) + XMAX=SQRT(Q2MAX) + XPOW=1.-2.*Q2POW + ELSEIF (IPRO.EQ.91) THEN + IF (EMMAX.GT.ETLIM) EMMAX=ETLIM + ENDIF +C---CALCULATE HIGGS WIDTH + IF (IPRO.EQ. 3.OR.IPRO.EQ. 4.OR.IPRO.EQ.16.OR.IPRO.EQ.19 + &.OR.IPRO.EQ.23.OR.IPRO.EQ.95) THEN + GAMH=RMASS(201) + CALL HWDHIG(GAMH) + ENDIF +C---IF Q**2 CAN BE TOO SMALL, BREIT FRAME MAKES NO SENSE + IF ((IPRO/10.EQ.9.AND.Q2MIN.LE.1.D-2).OR. + & (IPRO.EQ.91.AND.IQK.EQ.7)) BREIT=.FALSE. + IF (IPRINT.NE.0) THEN + IF (PBEAM1.NE.PBEAM2) WRITE (6,180) USECMF + IF (IPRO.EQ.91.OR.IPRO.EQ.92) + & WRITE (6,190) PTMIN + IF (IPRO.EQ.90.OR.(IPRO.EQ.91.AND.IQK.NE.7).OR.IPRO.EQ.92) + & WRITE (6,200) Q2MIN,Q2MAX,BREIT + IF (IPRO.EQ.90.OR.(IPRO.EQ.91.AND.IQK.NE.7).OR.IPRO.EQ.92) + & WRITE (6,210) YBMIN,YBMAX + IF (IPRO.EQ.91.AND.IQK.EQ.7) + & WRITE (6,220) Q2WWMN,Q2WWMX,BREIT,ZJMAX + IF (IPROC/10.EQ.11) WRITE (6,230) THMAX + IF (IPRO.EQ.13) WRITE (6,240) EMMIN,EMMAX + IF (IPRO.EQ.15.OR.IPRO.EQ.17.OR.IPRO.EQ.18.OR.IPRO.EQ.21 + & .OR.IPRO.EQ.22.OR.IPRO.EQ.23.OR.IPRO.EQ.24.OR.IPRO.EQ.50 + & .OR.IPRO.EQ.51.OR.IPRO.EQ.52.OR.IPRO.EQ.53.OR.IPRO.EQ.55 + & .OR.IPRO.EQ.60) + & WRITE (6,250) PTMIN,PTMAX + IF (IPRO.EQ. 3.OR.IPRO.EQ. 4.OR.IPRO.EQ.16.OR.IPRO.EQ.19 + & .OR.IPRO.EQ.23.OR.IPRO.EQ.95) + & WRITE (6,260) RMASS(201),GAMH, + & GAMMAX,RMASS(201)+GAMMAX*GAMH,(BRHIG(I)*100,I=1,12) + IF (IPRO.EQ.91) WRITE (6,270) BGSHAT,EMMIN,EMMAX + IF (IPRO.EQ.5.AND.IQK.LT.50) + & WRITE (6,280) EMMIN,EMMAX,PTMIN,PTMAX,CTMAX + IF (IPRO.EQ.5.AND.IQK.GE.50) + & WRITE (6,290) EMMIN,EMMAX,Q2MIN,Q2MAX,PTMIN + IF (IPRO.GT.10.AND. + & (IPRO.LT.90.AND.(ABS(IDB).EQ.11.OR.ABS(IDB).EQ.13).OR. + & (ABS(IDT).EQ.11.OR.ABS(IDT).EQ.13))) THEN + WRITE (6,300) Q2WWMN,Q2WWMX,YWWMIN,YWWMAX + IF (PHOMAS.GT.ZERO) WRITE (6,310) PHOMAS + ENDIF + IF (IPROC/10.EQ.10.OR.IPRO.EQ.90) + & WRITE (6,320) HARDME,SOFTME +C Check minimum mass threshold if ISR switched on + IF ((IPRO.LE.3.OR.IPRO.EQ.6).AND.ZMXISR.GT.ZERO) THEN + TEST=TWO*RMASS(IPART1)**2+ETLIM**2 + TEST=FOUR*RMASS(2)**2/TEST + IF (TMNISR.LT.TEST) THEN + WRITE(6,175) TMNISR,TEST + 175 FORMAT(10X,'Minimum invariant mass',F10.6,' too low'/ + & 10X,'increasing to TMNISR=',F10.6) + TMNISR=TEST + ENDIF + WRITE (6,330) TMNISR,ONE-ZMXISR + ENDIF + IF (WHMIN.GT.ZERO .AND. IPRO.GT.10.AND.(IPRO.EQ.90.OR. + & (ABS(IDB).EQ.11.OR.ABS(IDB).EQ.13).OR. + & (ABS(IDT).EQ.11.OR.ABS(IDT).EQ.13))) WRITE (6,340) WHMIN + 180 FORMAT(10X,'USE BEAM-TARGET C.M.F. =',L5) + 190 FORMAT(10X,'MIN P-T FOR O(AS) DILS =',F10.4) + 200 FORMAT(10X,'MIN ABS(Q**2) FOR DILS =',E10.4/ + & 10X,'MAX ABS(Q**2) FOR DILS =',E10.4/ + & 10X,'BREIT FRAME SHOWERING =',L5) + 210 FORMAT(10X,'MIN BJORKEN Y FOR DILS =',F10.4/ + & 10X,'MAX BJORKEN Y FOR DILS =',F10.4) + 220 FORMAT(10X,'MIN ABS(Q**2) FOR J/PSI=',E10.4/ + & 10X,'MAX ABS(Q**2) FOR J/PSI=',E10.4/ + & 10X,'BREIT FRAME SHOWERING =',L5/ + & 10X,'MAX Z FOR J/PSI =',F10.4) + 230 FORMAT(10X,'MAX THRUST FOR 2->3 =',F10.4) + 240 FORMAT(10X,'MIN MASS FOR DRELL-YAN =',F10.4/ + & 10X,'MAX MASS FOR DRELL-YAN =',F10.4) + 250 FORMAT(10X,'MIN P-TRAN FOR 2->2 =',F10.4/ + & 10X,'MAX P-TRAN FOR 2->2 =',F10.4) + 260 FORMAT(10X,'HIGGS BOSON MASS =',F10.4/ + & 10X,'HIGGS BOSON WIDTH =',F10.4/ + & 10X,'CUTOFF = EMH +',F4.1,'*GAMH=',F10.4/ + & 10X,'HIGGS D DBAR =',F10.4/ + & 10X,'BRANCHING U UBAR =',F10.4/ + & 10X,'FRACTIONS S SBAR =',F10.4/ + & 10X,'(PER CENT) C CBAR =',F10.4/ + & 10X,' B BBAR =',F10.4/ + & 10X,' T TBAR =',F10.4/ + & 10X,' E+ E- =',F10.4/ + & 10X,' MU+ MU- =',F10.4/ + & 10X,' TAU+ TAU- =',F10.4/ + & 10X,' W W =',F10.4/ + & 10X,' Z Z =',F10.4/ + & 10X,' GAMMA GAMMA =',F10.4) + 270 FORMAT(10X,'SCALE FOR BGF IS S-HAT =',L5/ + & 10X,'MIN MASS FOR BGF =',F10.4/ + & 10X,'MAX MASS FOR BGF =',F10.4) + 280 FORMAT(10X,'MIN MASS FOR 2 PHOTONS =',F10.4/ + & 10X,'MAX MASS FOR 2 PHOTONS =',F10.4/ + & 10X,'MIN PT OF 2 PHOTON CMF =',F10.4/ + & 10X,'MAX PT OF 2 PHOTON CMF =',F10.4/ + & 10X,'MAX COS THETA IN CMF =',F10.4) + 290 FORMAT(10X,'MIN MASS FOR GAMMA + W =',F10.4/ + & 10X,'MAX MASS FOR GAMMA + W =',F10.4/ + & 10X,'MIN ABS(Q**2) =',E10.4/ + & 10X,'MAX ABS(Q**2) =',E10.4/ + & 10X,'MIN PT =',F10.4) + 300 FORMAT(10X,'MIN Q**2 FOR WW PHOTON =',F10.4/ + & 10X,'MAX Q**2 FOR WW PHOTON =',F10.4/ + & 10X,'MIN MOMENTUM FRACTION =',F10.4/ + & 10X,'MAX MOMENTUM FRACTION =',F10.4) + 310 FORMAT(10X,'GAMMA* S.F. MASS PARAM =',F10.4) + 320 FORMAT(10X,'HARD M.E. MATCHING =',L5/ + & 10X,'SOFT M.E. MATCHING =',L5) + 330 FORMAT(10X,'MIN MTM FRAC FOR ISR =',1PE10.4/ + & 10X,'1-MAX MTM FRAC FOR ISR =',1PE10.4) + 340 FORMAT(10X,'MINIMUM HADRONIC MASS =',F10.4) + IF (LWEVT.LE.0) THEN + WRITE (6,350) + ELSE + WRITE (6,360) LWEVT + ENDIF + 350 FORMAT(/10X,'NO EVENTS WILL BE WRITTEN TO DISK') + 360 FORMAT(/10X,'EVENTS WILL BE OUTPUT ON UNIT',I4) + ENDIF +C Verify and print beam polarisations + IF (IPRO.EQ.1.OR.IPRO.EQ.3) THEN +C Set up transverse polarisation parameters for e+e- + IF ((EPOLN(1)**2+EPOLN(2)**2) + & *(PPOLN(1)**2+PPOLN(2)**2).GT.ZERO) THEN + TPOL=.TRUE. + COSS=EPOLN(1)*PPOLN(1)-EPOLN(2)*PPOLN(2) + SINS=EPOLN(2)*PPOLN(1)+EPOLN(1)*PPOLN(2) + ELSE + TPOL=.FALSE. + ENDIF +C print out lepton beam polarisation(s) + IF (IPRINT.NE.0) THEN + IF (IPART1.EQ.121) THEN + WRITE (6,370) PART1,EPOLN,PART2,PPOLN + ELSE + WRITE (6,370) PART1,PPOLN,PART2,EPOLN + ENDIF + 370 FORMAT(/10X,A8,'Beam polarisation=',3F10.4/ + & 10X,A8,'Beam polarisation=',3F10.4) + ENDIF + ELSEIF (IPRO.GE.90.AND.IPRO.LE.99) THEN + IF (IDB.GE.11.AND.IDB.LE.16) THEN + CALL HWVZRO(3,PPOLN) +C Check neutrino polarisations for DIS + IF (IDB.EQ. 12.OR.IDB.EQ. 14.OR.IDB.EQ. 16.AND. + & EPOLN(3).NE.-ONE) EPOLN(3)=-ONE + IF (IPRINT.NE.0) WRITE(6,380) PART1,EPOLN(3) + ELSE + CALL HWVZRO(3,EPOLN) +C Check anti-neutrino polarisations for DIS + IF (IDB.EQ.-12.OR.IDB.EQ.-14.OR.IDB.EQ.-16.AND. + & PPOLN(3).NE.ONE) PPOLN(3)=ONE + IF (IPRINT.NE.0) WRITE(6,380) PART1,PPOLN(3) + ENDIF + 380 FORMAT(/10X,A8,1X,'Longitudinal beam polarisation=',F10.4/) + ENDIF + IF (IPRINT.NE.0) THEN + IF (ZPRIME) THEN + WRITE(6,390) RMASS(200),RMASS(202),GAMZ,GAMZP + WRITE(6,400) (RNAME(I),VFCH(I,1),AFCH(I,1),VFCH(I,2), + & AFCH(I,2),I=1,6) + WRITE(6,400) (RNAME(110+I),VFCH(I,1),AFCH(I,1), + & VFCH(I,2),AFCH(I,2),I=11,16) + 390 FORMAT(/10X,'MASSIVE NEUTRAL VECTOR BOSON PARAMS'/ + & 10X,'Z MASS=',F10.4,7X,'Z-PRIME MASS=',F10.4/ + & 10X,' WIDTH=',F10.4,7X,' WIDTH=',F10.4/ + & 10X,'FERMION COUPLINGS: e.(V.1+A.G_5)G_mu'/ + & 10X,'FERMION: VECTOR AXIAL',6X, + & 'VECTOR AXIAL'/) + 400 FORMAT(10X,A8,2X,F10.4,1X,F10.4,1X,F10.4,1X,F10.4) + ENDIF + IF (MIXING) THEN + WRITE(6,410) XMIX(2),YMIX(2),XMIX(1),YMIX(1) + 410 FORMAT(/10X,'B_d: Delt-M/Gam =',F6.4, + & ' Delt-Gam/2*Gam =',F6.4,/ + & 10X,'B_s: Delt-M/Gam =',F6.2, + & ' Delt-Gam/2*Gam =',F6.4) + ENDIF + IF (CLRECO) WRITE(6,420) PRECO,EXAG + 420 FORMAT(/10X,'Colour rearrangement ALLOWED, probability =',F6.4,/ + & 10x,'Weak boson life-time exaggeration factor =',F10.6) +C---PDF STRUCTURE FUNCTIONS + WRITE (6,'(X)') + DO 450 I=1,2 + IF (MODPDF(I).GE.0) THEN + WRITE (6,430) I,MODPDF(I),AUTPDF(I) + ELSE + WRITE (6,440) I + ENDIF + 430 FORMAT(10X,'PDFLIB USED FOR BEAM',I2,': SET',I3,' OF ',A20) + 440 FORMAT(10X,'PDFLIB NOT USED FOR BEAM',I2) + 450 CONTINUE +C---GET THE UGLY INITIALISATION MESSAGES OVER AND DONE WITH NOW TOO + DO 460 I=1,2 + IF (MODPDF(I).GE.0) THEN + PARM(1)=AUTPDF(I) + VAL(1)=MODPDF(I) + FSTPDF=.TRUE. + X=0.5 + QSCA=10 +C---FIX TO CALL SCHULER-SJOSTRAND CODE + IF (AUTPDF(I).EQ.'SaSph') THEN + ISET=MOD(MODPDF(I),10) + IOP1=MOD(MODPDF(I)/10,2) + IOP2=MOD(MODPDF(I)/20,2) + IP2=MODPDF(I)/100 + IF (ISET.EQ.1) THEN + WRITE (6,'(10X,A)')'SCHULER-SJOSTRAND PHOTON PDF SET 1D' + ELSEIF (ISET.EQ.2) THEN + WRITE (6,'(10X,A)')'SCHULER-SJOSTRAND PHOTON PDF SET 1M' + ELSEIF (ISET.EQ.3) THEN + WRITE (6,'(10X,A)')'SCHULER-SJOSTRAND PHOTON PDF SET 2D' + ELSEIF (ISET.EQ.4) THEN + WRITE (6,'(10X,A)')'SCHULER-SJOSTRAND PHOTON PDF SET 2M' + ELSE + WRITE (6,'(10X,A)')'UNKNOWN SCHULER-SJOSTRAND PDF SET' + CALL HWWARN('HWUINC',500,*999) + ENDIF + IF (IOP1.EQ.1) THEN + WRITE (6,'(10X,A)') 'WITH DIRECT COMPONENT IN DIS' + IF (IPRO.NE.90) WRITE (6,'(10X,A)') + $ 'NOT RECOMMENDED FOR NON-DIS PROCESSES' + ENDIF + IF (IOP2.EQ.1) THEN + WRITE (6,'(10X,A)') 'WITH P**2 DEPENDENCE INCLUDED' + IF (PHOMAS.GT.ZERO) + $ WRITE (6,'(10X,A)') 'NOT RECOMMENDED WITH PHOMAS.GT.0' + IF (IP2.GT.0) + $ WRITE (6,'(10X,A,I2)') 'WITH IP2 OPTION EQUAL TO',IP2 + ENDIF + ELSEIF (AUTPDF(I).EQ.'SSph') THEN + WRITE (6,'(10X,A)') 'THE ACRONYM FOR SCHULER-SJOSTRAND' + WRITE (6,'(10X,A)') 'HAS CHANGED TO SaSph ACCORDING TO' + WRITE (6,'(10X,A)') 'THEIR WISHES. SSph NO LONGER WORKS' + STOP + ELSE + CALL PDFSET(PARM,VAL) + CALL STRUCTM(X,QSCA,UPV,DNV,USEA,DSEA,STR,CHM,BTM,TOP,GLU) + ENDIF + ENDIF + 460 CONTINUE + WRITE (6,'(X)') + ENDIF +C Set up neutral B meson mixing parameters + IF (MIXING.AND..NOT.(RSTAB(223).AND.RSTAB(247))) THEN + XMRCT(1)=XMIX(1)*RMASS(223)/(CSPEED*RLTIM(223)) + YMRCT(1)=YMIX(1)*RMASS(223)/(CSPEED*RLTIM(223)) + ENDIF + IF (MIXING.AND..NOT.(RSTAB(221).AND.RSTAB(245))) THEN + XMRCT(2)=XMIX(2)*RMASS(221)/(CSPEED*RLTIM(221)) + YMRCT(2)=YMIX(2)*RMASS(221)/(CSPEED*RLTIM(221)) + ENDIF +C---B DECAY PACKAGE + IF (BDECAY.EQ.'EURO') THEN + IF (IPRINT.NE.0) WRITE (6,470) 'EURODEC' + ELSEIF (BDECAY.EQ.'CLEO') THEN + IF (IPRINT.NE.0) WRITE (6,470) 'CLEO' + ELSE + BDECAY='HERW' + ENDIF + 470 FORMAT (10X,A,' B DECAY PACKAGE WILL BE USED') +C---COMPUTE PARTICLE PROPERTIES FOR HADRONIZATION + CALL HWURES +C Prepare internal decay tables and do diagnostic checks + CALL HWUDKS +C Convert ampersands to backslahes in particle LaTeX names + CALL HWUATS +C Print particle decay tables here + IF (IPRINT.GE.2) CALL HWUDPR +C---MISCELLANEOUS DERIVED QUANTITIES + TMTOP=2.*LOG(RMASS(6)/30.) + PXRMS=PTRMS/SQRT(2.) + ZBINM=0.25/ZBINM + PSPLT(1)=1./PSPLT(1) + PSPLT(2)=1./PSPLT(2) + NDTRY=2*NCTRY + NGSPL=0 + PGSMX=0. + DO 480 I=1,4 + PGS=HWUPCM(RMASS(13),RMASS(I),RMASS(I)) + IF (PGS.GE.ZERO) NGSPL=I + IF (PGS.GE.PGSMX) PGSMX=PGS + 480 PGSPL(I)=PGS + CALL HWVZRO(6,PTINT) + IF (IPRO.NE.80) THEN +C---SET UP TABLES OF SUDAKOV FORM FACTORS, GIVING +C PROBABILITY DISTRIBUTION IN VARIABLE Q = E*SQRT(XI) + NSUD=NFLAV + CALL HWBSUD +C---SET PARAMETERS FOR SPACELIKE BRANCHING + DO 500 I=1,NSUD + DO 490 J=2,NQEV + IF (QEV(J,I).GT.QSPAC) GOTO 500 + 490 CONTINUE + 500 NSPAC(I)=J-1 + ENDIF + EVWGT=AVWGT + ISTAT=1 + 999 END +CDECK ID>, HWUINE. +*CMZ :- -16/10/93 12.42.15 by Mike Seymour +*-- Author : Bryan Webber +C----------------------------------------------------------------------- + SUBROUTINE HWUINE +C----------------------------------------------------------------------- +C INITIALISES AN EVENT +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + DOUBLE PRECISION HWR,HWRGET,DUMMY + REAL TL + LOGICAL CALLED + EXTERNAL HWR,HWRGET + COMMON/HWDBUG/CALLED +C---CHECK THAT MAIN PROGRAM HAS BEEN MODIFIED CORRECTLY + IF (NEVHEP.GT.0.AND..NOT.CALLED) THEN + WRITE (6,10) + 10 FORMAT (1X,'A call to the subroutine HWUFNE should be added to', + & /,' the main program, immediately after the call to HWMEVT') + CALL HWWARN('HWUINE',500,*999) + ENDIF + CALLED=.FALSE. +C---CHECK TIME LEFT +c-jgc CALL HWUTIM(TL) +c-jgc IF (TL.LT.TLOUT) CALL HWWARN('HWUINE',200,*999) +C---UPDATE RANDOM NUMBER SEED + DUMMY = HWRGET(NRN) + NEVHEP=NEVHEP+1 + NHEP=0 + ISTAT=6 + IERROR=0 + EVWGT=AVWGT + HVFCEN=.FALSE. + ISLENT=1 + NQDK=0 +C---DECIDE WHETHER TO GENERATE SOFT UNDERLYING EVENT + GENSOF=IPROC.GT.1000.AND.IPROC.LT.10000.AND. + & (IPROC.EQ.8000.OR.HWR().LT.PRSOF) +C Zero arrays + CALL HWVZRI(2*NMXHEP,JMOHEP) + CALL HWVZRI(2*NMXHEP,JDAHEP) + CALL HWVZRO(4*NMXHEP,VHEP) + CALL HWVZRO(3*NMXHEP,RHOHEP) + EMSCA=ZERO + 999 END +CDECK ID>, HWULB4. +*CMZ :- -05/11/95 19.33.42 by Mike Seymour +*-- Author : Adapted by Bryan Webber +C----------------------------------------------------------------------- + SUBROUTINE HWULB4(PS,PI,PF) +C----------------------------------------------------------------------- +C TRANSFORMS PI (GIVEN IN REST FRAME OF PS) INTO PF (IN LAB) +C N.B. P(1,2,3,4) = (PX,PY,PZ,E); PS(5)=M +C----------------------------------------------------------------------- + DOUBLE PRECISION PF4,FN,PS(5),PI(4),PF(4) + IF (PS(4).EQ.PS(5)) THEN + PF(1)= PI(1) + PF(2)= PI(2) + PF(3)= PI(3) + PF(4)= PI(4) + ELSE + PF4 = (PI(1)*PS(1)+PI(2)*PS(2) + & +PI(3)*PS(3)+PI(4)*PS(4))/PS(5) + FN = (PF4+PI(4)) / (PS(4)+PS(5)) + PF(1)= PI(1) + FN*PS(1) + PF(2)= PI(2) + FN*PS(2) + PF(3)= PI(3) + FN*PS(3) + PF(4)= PF4 + END IF + END +CDECK ID>, HWULDO. +*CMZ :- -26/04/91 11.11.56 by Bryan Webber +*-- Author : Bryan Webber +C---------------------------------------------------------------------- + FUNCTION HWULDO(P,Q) +C---------------------------------------------------------------------- +C LORENTZ 4-VECTOR DOT PRODUCT +C---------------------------------------------------------------------- + DOUBLE PRECISION HWULDO,P(4),Q(4) + HWULDO=P(4)*Q(4)-(P(1)*Q(1)+P(2)*Q(2)+P(3)*Q(3)) + END +CDECK ID>, HWULF4. +*CMZ :- -05/11/95 19.33.42 by Mike Seymour +*-- Author : Adapted by Bryan Webber +C----------------------------------------------------------------------- + SUBROUTINE HWULF4(PS,PI,PF) +C----------------------------------------------------------------------- +C TRANSFORMS PI (GIVEN IN LAB) INTO PF (IN REST FRAME OF PS) +C N.B. P(1,2,3,4) = (PX,PY,PZ,E); PS(5)=M +C----------------------------------------------------------------------- + DOUBLE PRECISION PF4,FN,PS(5),PI(4),PF(4) + IF (PS(4).EQ.PS(5)) THEN + PF(1)= PI(1) + PF(2)= PI(2) + PF(3)= PI(3) + PF(4)= PI(4) + ELSE + PF4 = (PI(4)*PS(4)-PI(3)*PS(3) + & -PI(2)*PS(2)-PI(1)*PS(1))/PS(5) + FN = (PF4+PI(4)) / (PS(4)+PS(5)) + PF(1)= PI(1) - FN*PS(1) + PF(2)= PI(2) - FN*PS(2) + PF(3)= PI(3) - FN*PS(3) + PF(4)= PF4 + END IF + END +CDECK ID>, HWULI2. +*CMZ :- -23/08/94 13.22.29 by Mike Seymour +*-- Author : Ulrich Baur & Nigel Glover, adapted by Ian Knowles +C----------------------------------------------------------------------- + FUNCTION HWULI2(X) +C----------------------------------------------------------------------- +C Complex dilogarithm function, Li_2 (Spence function) +C----------------------------------------------------------------------- + IMPLICIT NONE + DOUBLE COMPLEX HWULI2,PROD,Y,Y2,X,Z + DOUBLE PRECISION XR,XI,R2,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,ZETA2, + & ZERO,ONE,HALF + PARAMETER (ZERO=0.0D0, ONE=1.0D0, HALF=0.5D0) + DATA A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,ZETA2/ -0.250000000000000D0, + & -0.111111111111111D0,-0.010000000000000D0,-0.017006802721088D0, + & -0.019444444444444D0,-0.020661157024793D0,-0.021417300648069D0, + & -0.021948866377231D0,-0.022349233811171D0,-0.022663689135191D0, + & 1.644934066848226D0/ + PROD(Y,Y2)=Y*(ONE+A1*Y*(ONE+A2*Y*(ONE+A3*Y2*(ONE+A4*Y2*(ONE+A5*Y2* + & (ONE+A6*Y2*(ONE+A7*Y2*(ONE+A8*Y2*(ONE+A9*Y2*(ONE+A10*Y2)))))))))) + XR=DBLE(X) + XI=IMAG(X) + R2=XR*XR+XI*XI + IF (R2.GT.ONE.AND.(XR/R2).GT.HALF) THEN + Z=-LOG(ONE/X) + HWULI2=PROD(Z,Z*Z)+ZETA2-LOG(X)*LOG(ONE-X)+HALF*LOG(X)**2 + ELSEIF (R2.GT.ONE.AND.(XR/R2).LE.HALF) THEN + Z=-LOG(ONE-ONE/X) + HWULI2=-PROD(Z,Z*Z)-ZETA2-HALF*LOG(-X)**2 + ELSEIF (R2.EQ.ONE.AND.XI.EQ.ZERO) THEN + HWULI2=ZETA2 + ELSEIF (R2.LE.ONE.AND.XR.GT.HALF) THEN + Z=-LOG(X) + HWULI2=-PROD(Z,Z*Z)+ZETA2-LOG(X)*LOG(ONE-X) + ELSE + Z=-LOG(ONE-X) + HWULI2=PROD(Z,Z*Z) + ENDIF + END +CDECK ID>, HWULOB. +*CMZ :- -05/11/95 19.33.42 by Mike Seymour +*-- Author : Adapted by Bryan Webber +C----------------------------------------------------------------------- + SUBROUTINE HWULOB(PS,PI,PF) +C----------------------------------------------------------------------- +C TRANSFORMS PI (GIVEN IN REST FRAME OF PS) INTO PF (IN LAB) +C N.B. P(1,2,3,4,5) = (PX,PY,PZ,E,M) +C----------------------------------------------------------------------- + DOUBLE PRECISION PS(5),PI(5),PF(5) + CALL HWULB4(PS,PI,PF) + PF(5)= PI(5) + END +CDECK ID>, HWULOF. +*CMZ :- -05/11/95 19.33.42 by Mike Seymour +*-- Author : Adapted by Bryan Webber +C----------------------------------------------------------------------- + SUBROUTINE HWULOF(PS,PI,PF) +C----------------------------------------------------------------------- +C TRANSFORMS PI (GIVEN IN LAB) INTO PF (IN REST FRAME OF PS) +C N.B. P(1,2,3,4,5) = (PX,PY,PZ,E,M) +C----------------------------------------------------------------------- + DOUBLE PRECISION PS(5),PI(5),PF(5) + CALL HWULF4(PS,PI,PF) + PF(5)= PI(5) + END +CDECK ID>, HWULOR. +*CMZ :- -26/04/91 11.11.56 by Bryan Webber +*-- Author : Giovanni Abbiendi & Luca Stanco +C----------------------------------------------------------------------- + SUBROUTINE HWULOR (TRANSF,PI,PF) +C----------------------------------------------------------------------- +C Makes the HWULOR transformation specified by TRANSF on the +C quadrivector PI(5), giving PF(5). +C----------------------------------------------------------------------- + DOUBLE PRECISION TRANSF(4,4),PI(5),PF(5) + INTEGER I,J + DO 1 I=1,5 + PF(I)=0.D0 + 1 CONTINUE + DO 3 I=1,4 + DO 2 J=1,4 + PF(I) = PF(I) + TRANSF(I,J) * PI(J) + 2 CONTINUE + 3 CONTINUE + PF(5) = PI(5) + RETURN + END +CDECK ID>, HWUMAS. +*CMZ :- -26/04/91 11.11.56 by Bryan Webber +*-- Author : Bryan Webber +C----------------------------------------------------------------------- + SUBROUTINE HWUMAS(P) +C----------------------------------------------------------------------- +C PUTS INVARIANT MASS IN 5TH COMPONENT OF VECTOR +C (NEGATIVE SIGN IF SPACELIKE) +C----------------------------------------------------------------------- + DOUBLE PRECISION HWUSQR,P(5) + EXTERNAL HWUSQR + P(5)=HWUSQR((P(4)+P(3))*(P(4)-P(3))-P(1)**2-P(2)**2) + END +CDECK ID>, HWUMBW. +*CMZ :- -21/02/98 11.11.56 by Bryan Webber +*-- Author : Bryan Webber +C----------------------------------------------------------------------- + FUNCTION HWUMBW(ID) +C----------------------------------------------------------------------- +C CHOOSES MASS ACCORDING TO BREIT-WIGNER DISTRIBUTION +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + DOUBLE PRECISION HWUMBW,HWR,WMX,TAU,T + INTEGER ID +C--WMX IS MAX NUMBER OF WIDTHS FROM NOMINAL MASS + DATA WMX/10D0/ + SAVE WMX + HWUMBW=RMASS(ID) + TAU=RLTIM(ID) + IF (TAU.EQ.ZERO.OR.TAU.GT.1D-18) RETURN + 1 T=HALF*TAN(PIFAC*(HWR()-HALF)) + IF (ABS(T).GT.WMX) GO TO 1 + HWUMBW=HWUMBW+HBAR*T/TAU + IF(HWUMBW.LT.ZERO) GOTO 1 + END +CDECK ID>, HWUNST. +*CMZ :- -27/07/99 13.33.03 by Mike Seymour +*-- Author : Ian Knowles +C----------------------------------------------------------------------- + FUNCTION HWUNST(N) +C----------------------------------------------------------------------- +C Creates a character string of length 7 equivalent to integer N +C----------------------------------------------------------------------- + INTEGER N,I,M,NN(7) + CHARACTER*1 NCHAR(0:9) + CHARACTER*7 HWUNST + DATA NCHAR/'0','1','2','3','4','5','6','7','8','9'/ + M=1 + DO 10 I=7,1,-1 + NN(I)=MOD(N/M,10) + 10 M=M*10 + WRITE(HWUNST,'(7A1)') (NCHAR(NN(I)),I=1,7) + RETURN + END +CDECK ID>, HWUPCM. +*CMZ :- -26/04/91 11.11.56 by Bryan Webber +*-- Author : Bryan Webber +C----------------------------------------------------------------------- + FUNCTION HWUPCM(EM0,EM1,EM2) +C----------------------------------------------------------------------- +C C.M. MOMENTUM FOR DECAY MASSES EM0 -> EM1 + EM2 +C SET TO -1 BELOW THRESHOLD +C----------------------------------------------------------------------- + DOUBLE PRECISION HWUPCM,EM0,EM1,EM2,EMS,EMD + EMS=ABS(EM1+EM2) + EMD=ABS(EM1-EM2) + IF (EM0.LT.EMS.OR.EM0.LT.EMD) THEN + HWUPCM=-1. + ELSEIF (EM0.EQ.EMS.OR.EM0.EQ.EMD) THEN + HWUPCM=0. + ELSE + HWUPCM=SQRT((EM0+EMD)*(EM0-EMD)* + & (EM0+EMS)*(EM0-EMS))*.5/EM0 + ENDIF + END +CDECK ID>, HWURAP. +*CMZ :- -26/04/91 11.11.56 by Bryan Webber +*-- Author : Bryan Webber +C----------------------------------------------------------------------- + FUNCTION HWURAP(P) +C----------------------------------------------------------------------- +C LONGITUDINAL RAPIDITY (SET TO +/-1000 IF TOO LARGE) +C----------------------------------------------------------------------- + DOUBLE PRECISION HWURAP,EMT2,P(5),ZERO + PARAMETER (ZERO=0.D0) + EMT2=P(1)**2+P(2)**2+P(5)**2 + IF (P(3).GT.ZERO) THEN + IF (EMT2.EQ.ZERO) THEN + HWURAP=1000. + ELSE + HWURAP= 0.5*LOG((P(3)+P(4))**2/EMT2) + ENDIF + ELSEIF (P(3).LT.ZERO) THEN + IF (EMT2.EQ.ZERO) THEN + HWURAP=-1000. + ELSE + HWURAP=-0.5*LOG((P(3)-P(4))**2/EMT2) + ENDIF + ELSE + HWURAP=0. + ENDIF + END +CDECK ID>, HWURES. +*CMZ :- -26/04/91 11.11.56 by Bryan Webber +*-- Author : Ian Knowles & Bryan Webber +C----------------------------------------------------------------------- + SUBROUTINE HWURES +C----------------------------------------------------------------------- +C Using properties of particle I supplied in HWUDAT checks particles +C and antiparticles have compatible properties and sets SWTEF(I) = +C ( rep. enhancement factor)^2 - used in cluster decays +C Finds iso-flavour hadrons and creates pointers for cluster decays. +C Sets CLDKWT(K) =(2J+1) spin weight normalizing largest value to 1. +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + INTEGER NMXTMP + PARAMETER (NMXTMP=20) + DOUBLE PRECISION EPS,WTMX,REMMN,RWTMX,WTMP,RESTMP(91),WTMX2, + & REMMN2,WT,CDWTMP(NMXTMP) + INTEGER HWUANT,MAPF(89),MAPC(12,12),I,IANT,IABPDG,J,L,N,K,LTMP, + & NCDKS,IMN,ITMP,LOCTMP(91),NTMP,NCDTMP(NMXTMP),IMN2 + EXTERNAL HWUANT + PARAMETER (EPS=1.D-6) + DATA MAPF/21,31,41,51,61,12,32,42,52,62,13,23,43,53,63,14,24,34, + & 44,54,64,15,25,35,45,55,65,16,26,36,46,56,66,111,112,113,122,123, + & 133,222,223,233,333,-111,-112,-113,-122,-123,-133,-222,-223,-233, + & -333,114,124,134,224,234,334,-114,-124,-134,-224,-234,-334,115, + & 125,135,225,235,335,-115,-125,-135,-225,-235,-335,116,126,136, + & 226,236,336,-116,-126,-136,-226,-236,-336/ + DATA MAPC/90,1,2,47,45,44,48,46,49,3,4,5,6,90,7,50,47,45,51,48,52, + & 8,9,10,11,12,91,51,48,46,52,49,53,13,14,15,37,40,41,6*0,57,69,81, + & 35,37,38,6*0,55,67,79,34,35,36,6*0,54,66,78,38,41,42,6*0,58,70, + & 82,36,38,39,6*0,56,68,80,39,42,43,6*0,59,71,83,16,17,18,63,61,60, + & 64,62,65,19,20,21,22,23,24,75,73,72,76,74,77,25,26,27,28,29,30, + & 87,85,84,88,86,89,31,32,33/ +C Check particle/anti-particle properties are compatible + WRITE(6,10) + 10 FORMAT(/10X,'Checking consistency of particle properties'/) + DO 20 I=10,NRES + IF (IDPDG(I).GT.0) THEN + IANT=HWUANT(I) + IF (IANT.EQ.20) GOTO 20 + IF (MOD(IDPDG(I)/1000,10).EQ.0.AND. + & MOD(IDPDG(I)/100 ,10).NE.0) THEN + IF (MOD(IFLAV(I)/10-IFLAV(IANT),10).NE.0.OR. + & MOD(IFLAV(I)-IFLAV(IANT)/10,10).NE.0) + & WRITE(6,30) RNAME(I),IFLAV(I),IFLAV(IANT) + ELSE + IF (IFLAV(I)+IFLAV(IANT).NE.0) + & WRITE(6,30) RNAME(I),IFLAV(I),IFLAV(IANT) + ENDIF + IF (ICHRG(I)+ICHRG(IANT).NE.0) + & WRITE(6,40) RNAME(I),RNAME(IANT),ICHRG(I),ICHRG(IANT) + IF (ABS(RMASS(I)-RMASS(IANT)).GT.EPS) + & WRITE(6,50) RNAME(I),RMASS(I),RMASS(IANT) + IF (ABS(RLTIM(I)-RLTIM(IANT)).GT.EPS) + & WRITE(6,60) RNAME(I),RLTIM(I),RLTIM(IANT) + IF (ABS(RSPIN(I)-RSPIN(IANT)).GT.EPS) + & WRITE(6,70) RNAME(I),RSPIN(I),RSPIN(IANT) + ENDIF + 20 CONTINUE + 30 FORMAT(10X,A8,' flavour code=',I4,5X,' antiparticle=',I4) + 40 FORMAT(10X,2A8,' charge =',I2,7X,' antiparticle=',I2) + 50 FORMAT(10X,A8,' mass =',F7.3,2X,' antiparticle=',F7.3) + 60 FORMAT(10X,A8,' life time =',E9.3,' antiparticle=',E9.3) + 70 FORMAT(10X,A8,' spin =',F3.1,6X,' antiparticle=',F3.1) +C Compute resonance properties + DO 80 I=21,NRES +C Compute representation weights for hadrons, used in cluster decays + IABPDG=ABS(IDPDG(I)) + J=MOD(IABPDG,10) + IF (J.EQ.2.AND.MOD(IABPDG/100,10).LT.MOD(IABPDG/10,10)) THEN +C Singlet (Lambda-like) baryon + SWTEF(I)=SNGWT**2 + ELSEIF (J.EQ.4) THEN +C Decuplet baryon + SWTEF(I)=DECWT**2 + ELSEIF(2*(J/2).NE.J) THEN +C Mesons: identify by spin, angular momentum & radial excitation + J=(J-1)/2 + L= MOD(IABPDG/10000 ,10) + N= MOD(IABPDG/100000,10) + IF (L.EQ.0.AND.J.EQ.0.AND.N.EQ.0.OR. + & L.GT.3.OR. J.GT.4.OR .N.GT.4) THEN + SWTEF(I)=1. + ELSE + SWTEF(I)=REPWT(L,J,N)**2 + ENDIF + ELSE +C Not recognized + SWTEF(I)=1. + ENDIF + 80 CONTINUE +C Prepare tables for cluster decays, except flavourless light mesons + LTMP=1 + NCDKS=0 + DO 120 I=1,89 +C Store particles, flavour MAPF(I), noting highest spin and lowest mass + WTMX=0. + REMMN=1000. + DO 90 J=21,NRES + IF (VTOCDK(J).OR.IFLAV(J).NE.MAPF(I)) GOTO 90 + NCDKS=NCDKS+1 + IF (NCDKS.GT.NMXCDK) CALL HWWARN('HWURES',101,*999) + NCLDK(NCDKS)=J + CLDKWT(NCDKS)=TWO*RSPIN(J)+ONE + IF (CLDKWT(NCDKS).GT.WTMX) WTMX=CLDKWT(NCDKS) + IF (RMASS(J).LT.REMMN) THEN + REMMN=RMASS(J) + IMN=NCDKS + ENDIF + 90 CONTINUE + IF (NCDKS+1-LTMP.EQ.0) THEN + WRITE(6,100) MAPF(I) + 100 FORMAT(1X,'No particles exist for a cluster with flavour, ',I4, + & ' to decay into') + CALL HWWARN('HWURES',51,*120) + ENDIF +C Set scaled spin weights + RWTMX=1./WTMX + DO 110 J=LTMP,NCDKS + 110 CLDKWT(J)=CLDKWT(J)*RWTMX +C Swap order if lightest hadron of given flavour not first + IF (IMN.NE.LTMP) THEN + ITMP=NCLDK(LTMP) + WTMP=CLDKWT(LTMP) + NCLDK(LTMP)=NCLDK(IMN) + CLDKWT(LTMP)=CLDKWT(IMN) + NCLDK(IMN)=ITMP + CLDKWT(IMN)=WTMP + ENDIF +C Set pointers etc + LOCTMP(I)=LTMP + RESTMP(I)=FLOAT(NCDKS+1-LTMP) + LTMP=NCDKS+1 + 120 CONTINUE +C Now do flavourless light mesons, allowing for mixing in weights + WTMX=0. + REMMN=1000. + WTMX2=0. + REMMN2=1000. + NTMP=0 + DO 140 J=21,NRES + IF (VTOCDK(J)) THEN + GOTO 140 +C Calculate mixing weight for (|uubar>+|ddbar>)/sqrt(2) component + ELSEIF (IFLAV(J).EQ.11) THEN + WT=1. + ELSEIF (IFLAV(J).EQ.33) THEN +C eta - eta' + IF (J.EQ.22 ) THEN + WT=COS(ETAMIX*PIFAC/180.+ATAN(SQRT(TWO)))**2 + ELSEIF (J.EQ.25 ) THEN + WT=SIN(ETAMIX*PIFAC/180.+ATAN(SQRT(TWO)))**2 +C phi - omega + ELSEIF (J.EQ.56 ) THEN + WT=COS(PHIMIX*PIFAC/180.+ATAN(SQRT(TWO)))**2 + ELSEIF (J.EQ.24 ) THEN + WT=SIN(PHIMIX*PIFAC/180.+ATAN(SQRT(TWO)))**2 +C f'_2 - f_2 + ELSEIF (J.EQ.58 ) THEN + WT=COS(F2MIX *PIFAC/180.+ATAN(SQRT(TWO)))**2 + ELSEIF (J.EQ.26 ) THEN + WT=SIN(F2MIX *PIFAC/180.+ATAN(SQRT(TWO)))**2 +C f_1(1420) - f_1(1285) + ELSEIF (J.EQ.57 ) THEN + WT=COS(F1MIX *PIFAC/180.+ATAN(SQRT(TWO)))**2 + ELSEIF (J.EQ.28 ) THEN + WT=SIN(F1MIX *PIFAC/180.+ATAN(SQRT(TWO)))**2 +C h_1(1380) - h_1(1170) + ELSEIF (J.EQ.289) THEN + WT=COS(H1MIX *PIFAC/180.+ATAN(SQRT(TWO)))**2 + ELSEIF (J.EQ.288) THEN + WT=SIN(H1MIX *PIFAC/180.+ATAN(SQRT(TWO)))**2 +C MISSING - f_0(1370) + ELSEIF (J.EQ.294) THEN + WT=SIN(F0MIX *PIFAC/180.+ATAN(SQRT(TWO)))**2 +C phi_3 - omega_3 + ELSEIF (J.EQ.396) THEN + WT=COS(PH3MIX*PIFAC/180.+ATAN(SQRT(TWO)))**2 + ELSEIF (J.EQ.395) THEN + WT=SIN(PH3MIX*PIFAC/180.+ATAN(SQRT(TWO)))**2 +C eta_2(1645) - eta_2(1870) + ELSEIF (J.EQ.397) THEN + WT=COS(ET2MIX*PIFAC/180.+ATAN(SQRT(TWO)))**2 + ELSEIF (J.EQ.398) THEN + WT=SIN(ET2MIX*PIFAC/180.+ATAN(SQRT(TWO)))**2 +C MISSING - omega(1600) + ELSEIF (J.EQ.399) THEN + WT=SIN(OMHMIX*PIFAC/180.+ATAN(SQRT(TWO)))**2 + ELSE + WT=1./3. + WRITE(6,130) J + 130 FORMAT(1X,'Isoscalar particle ',I3,' not recognised,', + & ' no I=0 mixing assumed') + ENDIF + ELSE + GOTO 140 + ENDIF + IF (WT.GT.EPS) THEN + NCDKS=NCDKS+1 + IF (NCDKS.GT.NMXCDK) CALL HWWARN('HWURES',102,*999) + NCLDK(NCDKS)=J + CLDKWT(NCDKS)=WT*(TWO*RSPIN(J)+ONE) + IF (CLDKWT(NCDKS).GT.WTMX) WTMX=CLDKWT(NCDKS) + IF (RMASS(J).LT.REMMN) THEN + REMMN=RMASS(J) + IMN=NCDKS + ENDIF + ENDIF + IF (ONE-WT.GT.EPS) THEN + NTMP=NTMP+1 + IF (NTMP.GT.NMXTMP) CALL HWWARN('HWURES',103,*999) + NCDTMP(NTMP)=J + CDWTMP(NTMP)=(ONE-WT)*(TWO*RSPIN(J)+ONE) + IF (CDWTMP(NTMP).GT.WTMX2) WTMX2=CDWTMP(NTMP) + IF (RMASS(J).LT.REMMN2) THEN + REMMN2=RMASS(J) + IMN2=NTMP + ENDIF + ENDIF + 140 CONTINUE + IF (NCDKS+1-LTMP.EQ.0) THEN + WRITE(6,100) 11 + CALL HWWARN('HWURES',52,*160) + ENDIF +C Normalize scaled spin weights + RWTMX=1./WTMX + DO 150 I=LTMP,NCDKS + 150 CLDKWT(I)=CLDKWT(I)*RWTMX +C Swap order if lightest hadron of flavour 11 not first + IF (IMN.NE.LTMP) THEN + ITMP=NCLDK(LTMP) + WTMP=CLDKWT(LTMP) + NCLDK(LTMP)=NCLDK(IMN) + CLDKWT(LTMP)=CLDKWT(IMN) + NCLDK(IMN)=ITMP + CLDKWT(IMN)=WTMP + ENDIF + 160 IF (NTMP.EQ.0) THEN + WRITE(6,100) 33 + CALL HWWARN('HWURES',53,*180) + ENDIF + IF (NCDKS+NTMP.GT.NMXCDK) CALL HWWARN('HWURES',104,*999) +C Store hadrons for |ssbar> channel and normalize their weights + RWTMX=1./WTMX2 + DO 170 I=1,NTMP + J=NCDKS+I + NCLDK(J)=NCDTMP(I) + 170 CLDKWT(J)=CDWTMP(I)*RWTMX +C Swap order if lightest hadron of flavour 33 not first + IF (IMN2.NE.1) THEN + ITMP=NCLDK(NCDKS+1) + WTMP=CLDKWT(NCDKS+1) + NCLDK(NCDKS+1)=NCLDK(NCDKS+IMN2) + CLDKWT(NCDKS+1)=CLDKWT(NCDKS+IMN2) + NCLDK(NCDKS+IMN2)=ITMP + CLDKWT(NCDKS+IMN2)=WTMP + ENDIF +C Set pointers etc + 180 LOCTMP(90)=LTMP + RESTMP(90)=FLOAT(NCDKS+1-LTMP) + LOCTMP(91)=NCDKS+1 + RESTMP(91)=FLOAT(NTMP) +C Set pointers to hadrons of given flavours for cluster decays + DO 190 I=1,12 + DO 190 J=1,12 + K=MAPC(I,J) + IF (K.EQ.0) THEN + RMIN(I,J)=RMASS(NCLDK(LOCN(I,2)))+RMASS(NCLDK(LOCN(I,2)))+1.D-2 + ELSE + LOCN(I,J)=LOCTMP(K) + RESN(I,J)=RESTMP(K) + RMIN(I,J)=RMASS(NCLDK(LOCN(I,J))) + ENDIF + 190 CONTINUE + 999 END +CDECK ID>, HWUROB. +*CMZ :- -26/04/91 11.11.56 by Bryan Webber +*-- Author : Bryan Webber +C----------------------------------------------------------------------- + SUBROUTINE HWUROB(R,P,Q) +C----------------------------------------------------------------------- +C ROTATES VECTORS BY INVERSE OF ROTATION MATRIX R +C----------------------------------------------------------------------- + DOUBLE PRECISION S1,S2,S3,R(3,3),P(3),Q(3) + S1=P(1)*R(1,1)+P(2)*R(2,1)+P(3)*R(3,1) + S2=P(1)*R(1,2)+P(2)*R(2,2)+P(3)*R(3,2) + S3=P(1)*R(1,3)+P(2)*R(2,3)+P(3)*R(3,3) + Q(1)=S1 + Q(2)=S2 + Q(3)=S3 + END +CDECK ID>, HWUROF. +*CMZ :- -26/04/91 11.11.56 by Bryan Webber +*-- Author : Bryan Webber +C----------------------------------------------------------------------- + SUBROUTINE HWUROF(R,P,Q) +C----------------------------------------------------------------------- +C ROTATES VECTORS BY ROTATION MATRIX R +C----------------------------------------------------------------------- + DOUBLE PRECISION S1,S2,S3,R(3,3),P(3),Q(3) + S1=R(1,1)*P(1)+R(1,2)*P(2)+R(1,3)*P(3) + S2=R(2,1)*P(1)+R(2,2)*P(2)+R(2,3)*P(3) + S3=R(3,1)*P(1)+R(3,2)*P(2)+R(3,3)*P(3) + Q(1)=S1 + Q(2)=S2 + Q(3)=S3 + END +CDECK ID>, HWUROT. +*CMZ :- -26/04/91 11.11.56 by Bryan Webber +*-- Author : Bryan Webber +C----------------------------------------------------------------------- + SUBROUTINE HWUROT(P,CP,SP,R) +C----------------------------------------------------------------------- +C R IS ROTATION MATRIX TO GET FROM VECTOR P TO Z AXIS, FOLLOWED BY +C A ROTATION BY PSI ABOUT Z AXIS, WHERE CP = COS-PSI, SP = SIN-PSI +C----------------------------------------------------------------------- + DOUBLE PRECISION WN,CP,SP,PTCUT,PP,PT,CT,ST,CF,SF,P(3),R(3,3) + DATA WN,PTCUT/1.,1.D-20/ + PT=P(1)**2+P(2)**2 + PP=P(3)**2+PT + IF (PT.LE.PP*PTCUT) THEN + CT=SIGN(WN,P(3)) + ST=0. + CF=1. + SF=0. + ELSE + PP=SQRT(PP) + PT=SQRT(PT) + CT=P(3)/PP + ST=PT/PP + CF=P(1)/PT + SF=P(2)/PT + END IF + R(1,1)= CP*CF*CT+SP*SF + R(1,2)= CP*SF*CT-SP*CF + R(1,3)=-CP*ST + R(2,1)=-CP*SF+SP*CF*CT + R(2,2)= CP*CF+SP*SF*CT + R(2,3)=-SP*ST + R(3,1)= CF*ST + R(3,2)= SF*ST + R(3,3)= CT + END +CDECK ID>, HWUSOR. +*CMZ :- -26/04/91 11.11.56 by Bryan Webber +*-- Author : Adapted by Bryan Webber +C----------------------------------------------------------------------- + SUBROUTINE HWUSOR(A,N,K,IOPT) +C----------------------------------------------------------------------- +C Sort A(N) into ascending order +C IOPT = 1 : return sorted A and index array K +C IOPT = 2 : return index array K only +C----------------------------------------------------------------------- + DOUBLE PRECISION A(N),B(500) + INTEGER N,I,J,IOPT,K(N),IL(500),IR(500) + IF (N.GT.500) CALL HWWARN('HWUSOR',100,*999) + IL(1)=0 + IR(1)=0 + DO 10 I=2,N + IL(I)=0 + IR(I)=0 + J=1 + 2 IF(A(I).GT.A(J)) GOTO 5 + 3 IF(IL(J).EQ.0) GOTO 4 + J=IL(J) + GOTO 2 + 4 IR(I)=-J + IL(J)=I + GOTO 10 + 5 IF(IR(J).LE.0) GOTO 6 + J=IR(J) + GOTO 2 + 6 IR(I)=IR(J) + IR(J)=I + 10 CONTINUE + I=1 + J=1 + GOTO 8 + 20 J=IL(J) + 8 IF(IL(J).GT.0) GOTO 20 + 9 K(I)=J + B(I)=A(J) + I=I+1 + IF(IR(J)) 12,30,13 + 13 J=IR(J) + GOTO 8 + 12 J=-IR(J) + GOTO 9 + 30 IF(IOPT.EQ.2) RETURN + DO 31 I=1,N + 31 A(I)=B(I) + 999 END +CDECK ID>, HWUSQR. +*CMZ :- -26/04/91 11.11.56 by Bryan Webber +*-- Author : Bryan Webber +C----------------------------------------------------------------------- + FUNCTION HWUSQR(X) +C----------------------------------------------------------------------- +C SQUARE ROOT WITH SIGN RETENTION +C----------------------------------------------------------------------- + DOUBLE PRECISION HWUSQR,X + HWUSQR=SIGN(SQRT(ABS(X)),X) + END +CDECK ID>, HWUSTA. +*CMZ :- -26/04/91 10.18.58 by Bryan Webber +*-- Author : Bryan Webber +C----------------------------------------------------------------------- + SUBROUTINE HWUSTA(NAME) +C----------------------------------------------------------------------- +C MAKES PARTICLE TYPE 'NAME' STABLE +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + INTEGER IPDG,IWIG + CHARACTER*8 NAME + CALL HWUIDT(3,IPDG,IWIG,NAME) + IF (IWIG.EQ.20) CALL HWWARN('HWUSTA',500,*999) + RSTAB(IWIG)=.TRUE. + WRITE (6,10) IWIG,NAME + 10 FORMAT(/10X,'PARTICLE TYPE',I4,'=',A8,' SET STABLE') + 999 END +CDECK ID>, HWUTAB. +*CMZ :- -26/04/91 11.11.56 by Bryan Webber +*-- Author : Adapted by Bryan Webber +C----------------------------------------------------------------------- + FUNCTION HWUTAB(F,A,NN,X,MM) +C----------------------------------------------------------------------- +C MODIFIED CERN INTERPOLATION ROUTINE DIVDIF +C----------------------------------------------------------------------- + IMPLICIT NONE + INTEGER NN,MM,MMAX,N,M,MPLUS,IX,IY,MID,NPTS,IP,I,J,L,ISUB + DOUBLE PRECISION HWUTAB,SUM,X,F(NN),A(NN),T(20),D(20) + LOGICAL EXTRA + DATA MMAX/10/ + N=NN + M=MIN(MM,MMAX,N-1) + MPLUS=M+1 + IX=0 + IY=N+1 + IF (A(1).GT.A(N)) GOTO 4 + 1 MID=(IX+IY)/2 + IF (X.GE.A(MID)) GOTO 2 + IY=MID + GOTO 3 + 2 IX=MID + 3 IF (IY-IX.GT.1) GOTO 1 + GOTO 7 + 4 MID=(IX+IY)/2 + IF (X.LE.A(MID)) GOTO 5 + IY=MID + GOTO 6 + 5 IX=MID + 6 IF (IY-IX.GT.1) GOTO 4 + 7 NPTS=M+2-MOD(M,2) + IP=0 + L=0 + GOTO 9 + 8 L=-L + IF (L.GE.0) L=L+1 + 9 ISUB=IX+L + IF ((1.LE.ISUB).AND.(ISUB.LE.N)) GOTO 10 + NPTS=MPLUS + GOTO 11 + 10 IP=IP+1 + T(IP)=A(ISUB) + D(IP)=F(ISUB) + 11 IF (IP.LT.NPTS) GOTO 8 + EXTRA=NPTS.NE.MPLUS + DO 14 L=1,M + IF (.NOT.EXTRA) GOTO 12 + ISUB=MPLUS-L + D(M+2)=(D(M+2)-D(M))/(T(M+2)-T(ISUB)) + 12 I=MPLUS + DO 13 J=L,M + ISUB=I-L + D(I)=(D(I)-D(I-1))/(T(I)-T(ISUB)) + I=I-1 + 13 CONTINUE + 14 CONTINUE + SUM=D(MPLUS) + IF (EXTRA) SUM=0.5*(SUM+D(M+2)) + J=M + DO 15 L=1,M + SUM=D(J)+(X-T(J))*SUM + J=J-1 + 15 CONTINUE + HWUTAB=SUM + END +CDECK ID>, HWUTIM. +*CMZ :- -26/04/91 11.38.43 by Federico Carminati +*-- Author : Federico Carminati +C----------------------------------------------------------------------- +c-jgc SUBROUTINE HWUTIM(TRES) +C----------------------------------------------------------------------- +c-jgc CALL TIMEL(TRES) +c-jgc END +CDECK ID>, HWVDIF. +*CMZ :- -26/04/91 11.11.56 by Bryan Webber +*-- Author : Bryan Webber +C----------------------------------------------------------------------- + SUBROUTINE HWVDIF(N,P,Q,R) +C----------------------------------------------------------------------- +C VECTOR DIFFERENCE +C----------------------------------------------------------------------- + DOUBLE PRECISION P(N),Q(N),R(N) + INTEGER N,I + DO 10 I=1,N + 10 R(I)=P(I)-Q(I) + END +CDECK ID>, HWVDOT. +*CMZ :- -26/04/91 11.11.56 by Bryan Webber +*-- Author : Bryan Webber +C----------------------------------------------------------------------- + FUNCTION HWVDOT(N,P,Q) +C----------------------------------------------------------------------- +C VECTOR DOT PRODUCT +C----------------------------------------------------------------------- + DOUBLE PRECISION HWVDOT,PQ,P(N),Q(N) + INTEGER N,I + PQ=0. + DO 10 I=1,N + 10 PQ=PQ+P(I)*Q(I) + HWVDOT=PQ + END +CDECK ID>, HWVEQU. +*CMZ :- -26/04/91 11.11.56 by Bryan Webber +*-- Author : Bryan Webber +C----------------------------------------------------------------------- + SUBROUTINE HWVEQU(N,P,Q) +C----------------------------------------------------------------------- +C VECTOR EQUALITY +C----------------------------------------------------------------------- + DOUBLE PRECISION P(N),Q(N) + INTEGER N,I + DO 10 I=1,N + 10 Q(I)=P(I) + END +CDECK ID>, HWVSCA. +*CMZ :- -26/04/91 11.11.56 by Bryan Webber +*-- Author : Bryan Webber +C----------------------------------------------------------------------- + SUBROUTINE HWVSCA(N,C,P,Q) +C----------------------------------------------------------------------- +C VECTOR TIMES SCALAR +C----------------------------------------------------------------------- + DOUBLE PRECISION C,P(N),Q(N) + INTEGER N,I + DO 10 I=1,N + 10 Q(I)=C*P(I) + END +CDECK ID>, HWVSUM. +*CMZ :- -26/04/91 11.11.56 by Bryan Webber +*-- Author : Bryan Webber +C----------------------------------------------------------------------- + SUBROUTINE HWVSUM(N,P,Q,R) +C----------------------------------------------------------------------- +C VECTOR SUM +C----------------------------------------------------------------------- + DOUBLE PRECISION P(N),Q(N),R(N) + INTEGER N,I + DO 10 I=1,N + 10 R(I)=P(I)+Q(I) + END +CDECK ID>, HWVZRI. +*CMZ :- -05/02/98 11.11.56 by Bryan Webber +*-- Author : Bryan Webber +C----------------------------------------------------------------------- + SUBROUTINE HWVZRI(N,IP) +C----------------------------------------------------------------------- +C ZERO INTEGER VECTOR +C----------------------------------------------------------------------- + INTEGER N,IP(N),I + DO 10 I=1,N + 10 IP(I)=0 + END +CDECK ID>, HWVZRO. +*CMZ :- -26/04/91 11.11.56 by Bryan Webber +*-- Author : Bryan Webber +C----------------------------------------------------------------------- + SUBROUTINE HWVZRO(N,P) +C----------------------------------------------------------------------- +C ZERO VECTOR +C----------------------------------------------------------------------- + DOUBLE PRECISION P(N) + INTEGER N,I + DO 10 I=1,N + 10 P(I)=0D0 + END +CDECK ID>, HWWARN. +*CMZ :- -26/04/91 10.18.58 by Bryan Webber +*-- Author : Bryan Webber +C----------------------------------------------------------------------- + SUBROUTINE HWWARN(SUBRTN,ICODE,*) +C----------------------------------------------------------------------- +C DEALS WITH ERRORS DURING EXECUTION +C SUBRTN = NAME OF CALLING SUBROUTINE +C ICODE = ERROR CODE: - -1 NONFATAL, KILL EVENT & PRINT NOTHING +C 0- 49 NONFATAL, PRINT WARNING & CONTINUE +C 50- 99 NONFATAL, PRINT WARNING & JUMP +C 100-199 NONFATAL, DUMP & KILL EVENT +C 200-299 FATAL, TERMINATE RUN +C 300-399 FATAL, DUMP EVENT & TERMINATE RUN +C 400-499 FATAL, DUMP EVENT & STOP DEAD +C 500- FATAL, STOP DEAD WITH NO DUMP +C----------------------------------------------------------------------- + INCLUDE 'HERWIG61.INC' + INTEGER ICODE + CHARACTER*6 SUBRTN + IF (ICODE.GE.0) WRITE (6,10) SUBRTN,ICODE + 10 FORMAT(/' HWWARN CALLED FROM SUBPROGRAM ',A6,': CODE =',I4) + IF (ICODE.LT.0) THEN + IERROR=ICODE + RETURN 1 + ELSEIF (ICODE.LT.100) THEN + WRITE (6,20) NEVHEP,NRN,EVWGT + 20 FORMAT(' EVENT',I8,': SEEDS =',I11,' &',I11, + &' WEIGHT =',E11.4/' EVENT SURVIVES. EXECUTION CONTINUES') + IF (ICODE.GT.49) RETURN 1 + ELSEIF (ICODE.LT.200) THEN + WRITE (6,30) NEVHEP,NRN,EVWGT + 30 FORMAT(' EVENT',I8,': SEEDS =',I11,' &',I11, + &' WEIGHT =',E11.4/' EVENT KILLED. EXECUTION CONTINUES') + IERROR=ICODE + RETURN 1 + ELSEIF (ICODE.LT.300) THEN + WRITE (6,40) + 40 FORMAT(' EVENT SURVIVES. RUN ENDS GRACEFULLY') + CALL HWEFIN +c-jgc CALL HWAEND + STOP + ELSEIF (ICODE.LT.400) THEN + WRITE (6,50) + 50 FORMAT(' EVENT KILLED: DUMP FOLLOWS. RUN ENDS GRACEFULLY') + IERROR=ICODE + CALL HWUEPR + CALL HWUBPR + CALL HWEFIN +c-jgc CALL HWAEND + STOP + ELSEIF (ICODE.LT.500) THEN + WRITE (6,60) + 60 FORMAT(' EVENT KILLED: DUMP FOLLOWS. RUN STOPS DEAD') + IERROR=ICODE + CALL HWUEPR + CALL HWUBPR + STOP + ELSE + WRITE (6,70) + 70 FORMAT(' RUN CANNOT CONTINUE') + STOP + ENDIF + END +CDECK ID>, IEUPDG. +*CMZ :- -28/01/92 12.34.44 by Mike Seymour +*-- Author : Luca Stanco +C----------------------------------------------------------------------- + FUNCTION IEUPDG(I) +C----------------------------------------------------------------------- +C DUMMY SUBROUTINE: DELETE AND SET BDECAY='EURO' +C IN MAIN PROGRAM IF YOU USE EURODEC DECAY PACKAGE +C----------------------------------------------------------------------- + INTEGER IEUPDG,I + WRITE (6,10) + 10 FORMAT(/10X,'IEUPDG CALLED BUT NOT LINKED') + IEUPDG=0 + STOP + END +CDECK ID>, IPDGEU. +*CMZ :- -28/01/92 12.34.44 by Mike Seymour +*-- Author : Luca Stanco +C----------------------------------------------------------------------- + FUNCTION IPDGEU(I) +C----------------------------------------------------------------------- +C DUMMY SUBROUTINE: DELETE AND SET BDECAY='EURO' +C IN MAIN PROGRAM IF YOU USE EURODEC DECAY PACKAGE +C----------------------------------------------------------------------- + INTEGER IPDGEU,I + WRITE (6,10) + 10 FORMAT(/10X,'IPDGEU CALLED BUT NOT LINKED') + IPDGEU=0 + STOP + END +CDECK ID>, PDFSET. +*CMZ :- -26/04/91 11.11.54 by Bryan Webber +*-- Author : Bryan Webber +C---------------------------------------------------------------------- +C SUBROUTINE PDFSET(PARM,VAL) +C---------------------------------------------------------------------- +C DUMMY SUBROUTINE: DELETE AND SET MODPDF(I) +C IN MAIN PROGRAM IF YOU USE PDFLIB CERN-LIBRARY +C PACKAGE FOR NUCLEON STRUCTURE FUNCTIONS +C---------------------------------------------------------------------- +C DOUBLE PRECISION VAL(20) +C CHARACTER*20 PARM(20) +C WRITE (6,10) +C 10 FORMAT(/10X,'PDFSET CALLED BUT NOT LINKED') +C STOP +C END +CDECK ID>, QQINIT. +*CMZ :- -28/01/92 12.34.44 by Mike Seymour +*-- Author : Luca Stanco +C----------------------------------------------------------------------- + SUBROUTINE QQINIT(QQLERR) +C----------------------------------------------------------------------- +C DUMMY SUBROUTINE: DELETE AND SET BDECAY='CLEO' +C IN MAIN PROGRAM IF YOU USE CLEO DECAY PACKAGE +C----------------------------------------------------------------------- + LOGICAL QQLERR + WRITE (6,10) + 10 FORMAT(/10X,'QQINIT CALLED BUT NOT LINKED') + STOP + END +CDECK ID>, QQLMAT. +*CMZ :- -28/01/92 12.34.44 by Mike Seymour +*-- Author : Luca Stanco +C----------------------------------------------------------------------- + INTEGER FUNCTION QQLMAT(IDL,NDIR) +C----------------------------------------------------------------------- +C. QQLMAT - Given a particle flavor (KF), converts it to QQ particle number +C. (KF = IDPDG code) +C. +C. Inputs : IDL (input particle code) +C NDIR = 1 LUND --> QQ +C NDIR = 2 QQ --> LUND +C +C. Outputs : QQLMAT (output particle code) +C. +C----------------------------------------------------------------------- + IMPLICIT NONE +C-- Calling variable + INTEGER IDL,NDIR +C-- External declaration +C-- Local variables + INTEGER AKF(321),I + DATA (AKF(I), I=1,151) / + + 0, 0, 0, 0, 0, 0, 0, 21, -6, -5, + + -4, -3, -1, -2, 6, 5, 4, 3, 1, 2, + + 0, + + 22, 23, 24, -24, 90, 0, 11, -11, 12, -12, + + 13, -13, 14, -14, 15, -15, 16, -16,20313,-20313, + + 211, -211, 321, -321, 311, -311, 421, -421, 411, -411, + + 431, -431, -521, 521, -511, 511, -531, 531, -541, 541, + + 621, -621, 611, -611, 631, -631, 641, -641, 651, -651, + + 111, 221, 331, 441,20551, 661, 310, 130,10313,-10313, + + 213, -213, 323, -323, 313, -313, 423, -423, 413, -413, + + 433, -433, -523, 523, -513, 513, -533, 533, -543, 543, + + 623, -623, 613, -613, 633, -633, 643, -643, 653, -653, + + 113, 223, 333, 443, 553, 136, 20553, 30553, 40553, 551, + + 10553, 555, 10551,70553,10555, 0, 20213, 20113, -20213, 10441, + + 10443, 445, 8*0, + + 3122, -3122, 4122, -4122, 4232, -4232, 4132, -4132, 3212, -3212/ + DATA (AKF(I), I=152,321) / + + 4212, -4212, 4322, -4322, 4312, -4312, 2212, -2212, 3222, -3222, + + 4222, -4222, 2112, -2112, 3112, -3112, 4112, -4112, 3322, -3322, + + 3312, -3312, 4332, -4332, 6*0, + + 3214, -3214, 4214, -4214, 4324, -4324, 4314, -4314, 2214, -2214, + + 3224, -3224, 4224, -4224, 2114, -2114, 3114, -3114, 4114, -4114, + + 3324, -3324, 3314, -3314, 4334, -4334, 4*0, + + 0, 0, 2224, -2224, 1114, -1114, 3334, -3334, 0, 0, + + 10323, -10323, 20323, -20323, 6*0, + + 30443, 0, 0, 0, 70443, 50553, 60553, 80553, 20443, 0, + + 10411, 20413, 10413, 415, + + -10411,-20413,-10413,-415, + + 10421, 20423, 10423, 425, + + -10421,-20423,-10423,-425, + + 10431, 20433, 10433, 435, + + -10431,-20433,-10433,-435, 0,0,0,0,0,0, + + 10111, 10211,-10211, 115, 215, -215,10221,10331,20223,20333, + + 225, 335, 10223, 10333, 10113, 10213,-10213, 33*0 / + IF(NDIR.EQ.1) THEN + DO 10 I=1,321 + IF (IDL.EQ.AKF(I)) THEN + QQLMAT=I-21 + RETURN + ENDIF + 10 CONTINUE + WRITE(6,20) IDL + 20 FORMAT(1X,'Lund code particle ',I6,' not recognized') + ELSEIF(NDIR.EQ.2) THEN + QQLMAT = AKF(IDL+21) + ENDIF + RETURN + END +CDECK ID>, STRUCTM. +*CMZ :S E26/04/91 11.11.54 by Bryan Webber +*-- Author : Bryan Webber +C----------------------------------------------------------------------- +C SUBROUTINE STRUCTM(X,QSCA,UPV,DNV,USEA,DSEA,STR,CHM,BOT,TOP,GLU) +C----------------------------------------------------------------------- +C DUMMY SUBROUTINE: DELETE IF YOU USE PDFLIB CERN-LIBRARY +C PACKAGE FOR NUCLEON STRUCTURE FUNCTIONS +C----------------------------------------------------------------------- +C DOUBLE PRECISION X,QSCA,UPV,DNV,USEA,DSEA,STR,CHM,BOT,TOP,GLU +C WRITE (6,10) +C 10 FORMAT(/10X,'STRUCTM CALLED BUT NOT LINKED') +C STOP +C END +C----------------------------------------------------------------------- +C...SaSgam version 2 - parton distributions of the photon +C...by Gerhard A. Schuler and Torbjorn Sjostrand +C...For further information see Z. Phys. C68 (1995) 607 +C...and CERN-TH/96-04 and LU TP 96-2. +C...Program last changed on 18 January 1996. +C +C!!!Note that one further call parameter - IP2 - has been added +C!!!to the SASGAM argument list compared with version 1. +C +C...The user should only need to call the SASGAM routine, +C...which in turn calls the auxiliary routines SASVMD, SASANO, +C...SASBEH and SASDIR. The package is self-contained. +C +C...One particular aspect of these parametrizations is that F2 for +C...the photon is not obtained just as the charge-squared-weighted +C...sum of quark distributions, but differ in the treatment of +C...heavy flavours (in F2 the DIS relation W2 = Q2*(1-x)/x restricts +C...the kinematics range of heavy-flavour production, but the same +C...kinematics is not relevant e.g. for jet production) and, for the +C...'MSbar' fits, in the addition of a Cgamma term related to the +C...separation of direct processes. Schematically: +C...PDF = VMD (rho, omega, phi) + anomalous (d, u, s, c, b). +C...F2 = VMD (rho, omega, phi) + anomalous (d, u, s) + +C... Bethe-Heitler (c, b) (+ Cgamma (d, u, s)). +C...The J/psi and Upsilon states have not been included in the VMD sum, +C...but low c and b masses in the other components should compensate +C...for this in a duality sense. +C +C...The calling sequence is the following: +C CALL SASGAM(ISET,X,Q2,P2,IP2,F2GM,XPDFGM) +C...with the following declaration statement: +C DIMENSION XPDFGM(-6:6) +C...and, optionally, further information in: +C COMMON/SASCOM/XPVMD(-6:6),XPANL(-6:6),XPANH(-6:6),XPBEH(-6:6), +C &XPDIR(-6:6) +C COMMON/SASVAL/VXPVMD(-6:6),VXPANL(-6:6),VXPANH(-6:6),VXPDGM(-6:6) +C...Input: ISET = 1 : SaS set 1D ('DIS', Q0 = 0.6 GeV) +C = 2 : SaS set 1M ('MSbar', Q0 = 0.6 GeV) +C = 3 : SaS set 2D ('DIS', Q0 = 2 GeV) +C = 4 : SaS set 2M ('MSbar', Q0 = 2 GeV) +C X : x value. +C Q2 : Q2 value. +C P2 : P2 value; should be = 0. for an on-shell photon. +C IP2 : scheme used to evaluate off-shell anomalous component. +C = 0 : recommended default, see = 7. +C = 1 : dipole dampening by integration; very time-consuming. +C = 2 : P_0^2 = max( Q_0^2, P^2 ) +C = 3 : P'_0^2 = Q_0^2 + P^2. +C = 4 : P_{eff} that preserves momentum sum. +C = 5 : P_{int} that preserves momentum and average +C evolution range. +C = 6 : P_{eff}, matched to P_0 in P2 -> Q2 limit. +C = 7 : P_{eff}, matched to P_0 in P2 -> Q2 limit. +C...Output: F2GM : F2 value of the photon (including factors of alpha_em). +C XPFDGM : x times parton distribution functions of the photon, +C with elements 0 = g, 1 = d, 2 = u, 3 = s, 4 = c, 5 = b, +C 6 = t (always empty!), - for antiquarks (result is same). +C...The breakdown by component is stored in the commonblock SASCOM, +C with elements as above. +C XPVMD : rho, omega, phi VMD part only of output. +C XPANL : d, u, s anomalous part only of output. +C XPANH : c, b anomalous part only of output. +C XPBEH : c, b Bethe-Heitler part only of output. +C XPDIR : Cgamma (direct contribution) part only of output. +C...The above arrays do not distinguish valence and sea contributions, +C...although this information is available internally. The additional +C...commonblock SASVAL provides the valence part only of the above +C...distributions. Array names VXPVMD, VXPANL and VXPANH correspond +C...to XPVMD, XPANL and XPANH, while XPBEH and XPDIR are valence only +C...and therefore not given doubly. VXPDGM gives the sum of valence +C...parts, and so matches XPDFGM. The difference, i.e. XPVMD-VXPVMD +C...and so on, gives the sea part only. +C + SUBROUTINE SASGAM(ISET,X,Q2,P2,IP2,F2GM,XPDFGM) +C...Purpose: to construct the F2 and parton distributions of the photon +C...by summing homogeneous (VMD) and inhomogeneous (anomalous) terms. +C...For F2, c and b are included by the Bethe-Heitler formula; +C...in the 'MSbar' scheme additionally a Cgamma term is added. + DIMENSION XPDFGM(-6:6) + COMMON/SASCOM/XPVMD(-6:6),XPANL(-6:6),XPANH(-6:6),XPBEH(-6:6), + &XPDIR(-6:6) + COMMON/SASVAL/VXPVMD(-6:6),VXPANL(-6:6),VXPANH(-6:6),VXPDGM(-6:6) + SAVE /SASCOM/,/SASVAL/ +C +C...Temporary array. + DIMENSION XPGA(-6:6), VXPGA(-6:6) +C...Charm and bottom masses (low to compensate for J/psi etc.). + DATA PMC/1.3/, PMB/4.6/ +C...alpha_em and alpha_em/(2*pi). + DATA AEM/0.007297/, AEM2PI/0.0011614/ +C...Lambda value for 4 flavours. + DATA ALAM/0.20/ +C...Mixture u/(u+d), = 0.5 for incoherent and = 0.8 for coherent sum. + DATA FRACU/0.8/ +C...VMD couplings f_V**2/(4*pi). + DATA FRHO/2.20/, FOMEGA/23.6/, FPHI/18.4/ +C...Masses for rho (=omega) and phi. + DATA PMRHO/0.770/, PMPHI/1.020/ +C...Number of points in integration for IP2=1. + DATA NSTEP/100/ +C +C...Reset output. + F2GM=0. + DO 100 KFL=-6,6 + XPDFGM(KFL)=0. + XPVMD(KFL)=0. + XPANL(KFL)=0. + XPANH(KFL)=0. + XPBEH(KFL)=0. + XPDIR(KFL)=0. + VXPVMD(KFL)=0. + VXPANL(KFL)=0. + VXPANH(KFL)=0. + VXPDGM(KFL)=0. + 100 CONTINUE +C +C...Check that input sensible. + IF(ISET.LE.0.OR.ISET.GE.5) THEN + WRITE(*,*) ' FATAL ERROR: SaSgam called for unknown set' + WRITE(*,*) ' ISET = ',ISET + STOP + ENDIF + IF(X.LE.0..OR.X.GT.1.) THEN + WRITE(*,*) ' FATAL ERROR: SaSgam called for unphysical x' + WRITE(*,*) ' X = ',X + STOP + ENDIF +C +C...Set Q0 cut-off parameter as function of set used. + IF(ISET.LE.2) THEN + Q0=0.6 + ELSE + Q0=2. + ENDIF + Q02=Q0**2 +C +C...Scale choice for off-shell photon; common factors. + Q2A=Q2 + FACNOR=1. + IF(IP2.EQ.1) THEN + P2MX=P2+Q02 + Q2A=Q2+P2*Q02/MAX(Q02,Q2) + FACNOR=LOG(Q2/Q02)/NSTEP + ELSEIF(IP2.EQ.2) THEN + P2MX=MAX(P2,Q02) + ELSEIF(IP2.EQ.3) THEN + P2MX=P2+Q02 + Q2A=Q2+P2*Q02/MAX(Q02,Q2) + ELSEIF(IP2.EQ.4) THEN + P2MX=Q2*(Q02+P2)/(Q2+P2)*EXP(P2*(Q2-Q02)/ + & ((Q2+P2)*(Q02+P2))) + ELSEIF(IP2.EQ.5) THEN + P2MXA=Q2*(Q02+P2)/(Q2+P2)*EXP(P2*(Q2-Q02)/ + & ((Q2+P2)*(Q02+P2))) + P2MX=Q0*SQRT(P2MXA) + FACNOR=LOG(Q2/P2MXA)/LOG(Q2/P2MX) + ELSEIF(IP2.EQ.6) THEN + P2MX=Q2*(Q02+P2)/(Q2+P2)*EXP(P2*(Q2-Q02)/ + & ((Q2+P2)*(Q02+P2))) + P2MX=MAX(0.,1.-P2/Q2)*P2MX+MIN(1.,P2/Q2)*MAX(P2,Q02) + ELSE + P2MXA=Q2*(Q02+P2)/(Q2+P2)*EXP(P2*(Q2-Q02)/ + & ((Q2+P2)*(Q02+P2))) + P2MX=Q0*SQRT(P2MXA) + P2MXB=P2MX + P2MX=MAX(0.,1.-P2/Q2)*P2MX+MIN(1.,P2/Q2)*MAX(P2,Q02) + P2MXB=MAX(0.,1.-P2/Q2)*P2MXB+MIN(1.,P2/Q2)*P2MXA + FACNOR=LOG(Q2/P2MXA)/LOG(Q2/P2MXB) + ENDIF +C +C...Call VMD parametrization for d quark and use to give rho, omega, +C...phi. Note dipole dampening for off-shell photon. + CALL SASVMD(ISET,1,X,Q2A,P2MX,ALAM,XPGA,VXPGA) + XFVAL=VXPGA(1) + XPGA(1)=XPGA(2) + XPGA(-1)=XPGA(-2) + FACUD=AEM*(1./FRHO+1./FOMEGA)*(PMRHO**2/(PMRHO**2+P2))**2 + FACS=AEM*(1./FPHI)*(PMPHI**2/(PMPHI**2+P2))**2 + DO 110 KFL=-5,5 + XPVMD(KFL)=(FACUD+FACS)*XPGA(KFL) + 110 CONTINUE + XPVMD(1)=XPVMD(1)+(1.-FRACU)*FACUD*XFVAL + XPVMD(2)=XPVMD(2)+FRACU*FACUD*XFVAL + XPVMD(3)=XPVMD(3)+FACS*XFVAL + XPVMD(-1)=XPVMD(-1)+(1.-FRACU)*FACUD*XFVAL + XPVMD(-2)=XPVMD(-2)+FRACU*FACUD*XFVAL + XPVMD(-3)=XPVMD(-3)+FACS*XFVAL + VXPVMD(1)=(1.-FRACU)*FACUD*XFVAL + VXPVMD(2)=FRACU*FACUD*XFVAL + VXPVMD(3)=FACS*XFVAL + VXPVMD(-1)=(1.-FRACU)*FACUD*XFVAL + VXPVMD(-2)=FRACU*FACUD*XFVAL + VXPVMD(-3)=FACS*XFVAL +C + IF(IP2.NE.1) THEN +C...Anomalous parametrizations for different strategies +C...for off-shell photons; except full integration. +C +C...Call anomalous parametrization for d + u + s. + CALL SASANO(-3,X,Q2A,P2MX,ALAM,XPGA,VXPGA) + DO 120 KFL=-5,5 + XPANL(KFL)=FACNOR*XPGA(KFL) + VXPANL(KFL)=FACNOR*VXPGA(KFL) + 120 CONTINUE +C +C...Call anomalous parametrization for c and b. + CALL SASANO(4,X,Q2A,P2MX,ALAM,XPGA,VXPGA) + DO 130 KFL=-5,5 + XPANH(KFL)=FACNOR*XPGA(KFL) + VXPANH(KFL)=FACNOR*VXPGA(KFL) + 130 CONTINUE + CALL SASANO(5,X,Q2A,P2MX,ALAM,XPGA,VXPGA) + DO 140 KFL=-5,5 + XPANH(KFL)=XPANH(KFL)+FACNOR*XPGA(KFL) + VXPANH(KFL)=VXPANH(KFL)+FACNOR*VXPGA(KFL) + 140 CONTINUE +C + ELSE +C...Special option: loop over flavours and integrate over k2. + DO 170 KF=1,5 + DO 160 ISTEP=1,NSTEP + Q2STEP=Q02*(Q2/Q02)**((ISTEP-0.5)/NSTEP) + IF((KF.EQ.4.AND.Q2STEP.LT.PMC**2).OR. + & (KF.EQ.5.AND.Q2STEP.LT.PMB**2)) GOTO 160 + CALL SASVMD(0,KF,X,Q2,Q2STEP,ALAM,XPGA,VXPGA) + FACQ=AEM2PI*(Q2STEP/(Q2STEP+P2))**2*FACNOR + IF(MOD(KF,2).EQ.0) FACQ=FACQ*(8./9.) + IF(MOD(KF,2).EQ.1) FACQ=FACQ*(2./9.) + DO 150 KFL=-5,5 + IF(KF.LE.3) XPANL(KFL)=XPANL(KFL)+FACQ*XPGA(KFL) + IF(KF.GE.4) XPANH(KFL)=XPANH(KFL)+FACQ*XPGA(KFL) + IF(KF.LE.3) VXPANL(KFL)=VXPANL(KFL)+FACQ*VXPGA(KFL) + IF(KF.GE.4) VXPANH(KFL)=VXPANH(KFL)+FACQ*VXPGA(KFL) + 150 CONTINUE + 160 CONTINUE + 170 CONTINUE + ENDIF +C +C...Call Bethe-Heitler term expression for charm and bottom. + CALL SASBEH(4,X,Q2,P2,PMC**2,XPBH) + XPBEH(4)=XPBH + XPBEH(-4)=XPBH + CALL SASBEH(5,X,Q2,P2,PMB**2,XPBH) + XPBEH(5)=XPBH + XPBEH(-5)=XPBH +C +C...For MSbar subtraction call C^gamma term expression for d, u, s. + IF(ISET.EQ.2.OR.ISET.EQ.4) THEN + CALL SASDIR(X,Q2,P2,Q02,XPGA) + DO 180 KFL=-5,5 + XPDIR(KFL)=XPGA(KFL) + 180 CONTINUE + ENDIF +C +C...Store result in output array. + DO 190 KFL=-5,5 + CHSQ=1./9. + IF(IABS(KFL).EQ.2.OR.IABS(KFL).EQ.4) CHSQ=4./9. + XPF2=XPVMD(KFL)+XPANL(KFL)+XPBEH(KFL)+XPDIR(KFL) + IF(KFL.NE.0) F2GM=F2GM+CHSQ*XPF2 + XPDFGM(KFL)=XPVMD(KFL)+XPANL(KFL)+XPANH(KFL) + VXPDGM(KFL)=VXPVMD(KFL)+VXPANL(KFL)+VXPANH(KFL) + 190 CONTINUE +C + RETURN + END +C +C********************************************************************* +C + SUBROUTINE SASVMD(ISET,KF,X,Q2,P2,ALAM,XPGA,VXPGA) +C...Purpose: to evaluate the VMD parton distributions of a photon, +C...evolved homogeneously from an initial scale P2 to Q2. +C...Does not include dipole suppression factor. +C...ISET is parton distribution set, see above; +C...additionally ISET=0 is used for the evolution of an anomalous photon +C...which branched at a scale P2 and then evolved homogeneously to Q2. +C...ALAM is the 4-flavour Lambda, which is automatically converted +C...to 3- and 5-flavour equivalents as needed. + DIMENSION XPGA(-6:6), VXPGA(-6:6) + DATA PMC/1.3/, PMB/4.6/ +C +C...Reset output. + DO 100 KFL=-6,6 + XPGA(KFL)=0. + VXPGA(KFL)=0. + 100 CONTINUE + KFA=IABS(KF) +C +C...Calculate Lambda; protect against unphysical Q2 and P2 input. + ALAM3=ALAM*(PMC/ALAM)**(2./27.) + ALAM5=ALAM*(ALAM/PMB)**(2./23.) + P2EFF=MAX(P2,1.2*ALAM3**2) + IF(KFA.EQ.4) P2EFF=MAX(P2EFF,PMC**2) + IF(KFA.EQ.5) P2EFF=MAX(P2EFF,PMB**2) + Q2EFF=MAX(Q2,P2EFF) +C +C...Find number of flavours at lower and upper scale. + NFP=4 + IF(P2EFF.LT.PMC**2) NFP=3 + IF(P2EFF.GT.PMB**2) NFP=5 + NFQ=4 + IF(Q2EFF.LT.PMC**2) NFQ=3 + IF(Q2EFF.GT.PMB**2) NFQ=5 +C +C...Find s as sum of 3-, 4- and 5-flavour parts. + S=0. + IF(NFP.EQ.3) THEN + Q2DIV=PMC**2 + IF(NFQ.EQ.3) Q2DIV=Q2EFF + S=S+(6./27.)*LOG(LOG(Q2DIV/ALAM3**2)/LOG(P2EFF/ALAM3**2)) + ENDIF + IF(NFP.LE.4.AND.NFQ.GE.4) THEN + P2DIV=P2EFF + IF(NFP.EQ.3) P2DIV=PMC**2 + Q2DIV=Q2EFF + IF(NFQ.EQ.5) Q2DIV=PMB**2 + S=S+(6./25.)*LOG(LOG(Q2DIV/ALAM**2)/LOG(P2DIV/ALAM**2)) + ENDIF + IF(NFQ.EQ.5) THEN + P2DIV=PMB**2 + IF(NFP.EQ.5) P2DIV=P2EFF + S=S+(6./23.)*LOG(LOG(Q2EFF/ALAM5**2)/LOG(P2DIV/ALAM5**2)) + ENDIF +C +C...Calculate frequent combinations of x and s. + X1=1.-X + XL=-LOG(X) + S2=S**2 + S3=S**3 + S4=S**4 +C +C...Evaluate homogeneous anomalous parton distributions below or +C...above threshold. + IF(ISET.EQ.0) THEN + IF(Q2.LE.P2.OR.(KFA.EQ.4.AND.Q2.LT.PMC**2).OR. + &(KFA.EQ.5.AND.Q2.LT.PMB**2)) THEN + XVAL = X * 1.5 * (X**2+X1**2) + XGLU = 0. + XSEA = 0. + ELSE + XVAL = (1.5/(1.-0.197*S+4.33*S2)*X**2 + (1.5+2.10*S)/ + & (1.+3.29*S)*X1**2 + 5.23*S/(1.+1.17*S+19.9*S3)*X*X1) * + & X**(1./(1.+1.5*S)) * (1.-X**2)**(2.667*S) + XGLU = 4.*S/(1.+4.76*S+15.2*S2+29.3*S4) * + & X**(-2.03*S/(1.+2.44*S)) * (X1*XL)**(1.333*S) * + & ((4.*X**2+7.*X+4.)*X1/3. - 2.*X*(1.+X)*XL) + XSEA = S2/(1.+4.54*S+8.19*S2+8.05*S3) * + & X**(-1.54*S/(1.+1.29*S)) * X1**(2.667*S) * + & ((8.-73.*X+62.*X**2)*X1/9. + (3.-8.*X**2/3.)*X*XL + + & (2.*X-1.)*X*XL**2) + ENDIF +C +C...Evaluate set 1D parton distributions below or above threshold. + ELSEIF(ISET.EQ.1) THEN + IF(Q2.LE.P2.OR.(KFA.EQ.4.AND.Q2.LT.PMC**2).OR. + &(KFA.EQ.5.AND.Q2.LT.PMB**2)) THEN + XVAL = 1.294 * X**0.80 * X1**0.76 + XGLU = 1.273 * X**0.40 * X1**1.76 + XSEA = 0.100 * X1**3.76 + ELSE + XVAL = 1.294/(1.+0.252*S+3.079*S2) * X**(0.80-0.13*S) * + & X1**(0.76+0.667*S) * XL**(2.*S) + XGLU = 7.90*S/(1.+5.50*S) * EXP(-5.16*S) * + & X**(-1.90*S/(1.+3.60*S)) * X1**1.30 * XL**(0.50+3.*S) + + & 1.273 * EXP(-10.*S) * X**0.40 * X1**(1.76+3.*S) + XSEA = (0.1-0.397*S2+1.121*S3)/(1.+5.61*S2+5.26*S3) * + & X**(-7.32*S2/(1.+10.3*S2)) * + & X1**((3.76+15.*S+12.*S2)/(1.+4.*S)) + XSEA0 = 0.100 * X1**3.76 + ENDIF +C +C...Evaluate set 1M parton distributions below or above threshold. + ELSEIF(ISET.EQ.2) THEN + IF(Q2.LE.P2.OR.(KFA.EQ.4.AND.Q2.LT.PMC**2).OR. + &(KFA.EQ.5.AND.Q2.LT.PMB**2)) THEN + XVAL = 0.8477 * X**0.51 * X1**1.37 + XGLU = 3.42 * X**0.255 * X1**2.37 + XSEA = 0. + ELSE + XVAL = 0.8477/(1.+1.37*S+2.18*S2+3.73*S3) * X**(0.51+0.21*S) + & * X1**1.37 * XL**(2.667*S) + XGLU = 24.*S/(1.+9.6*S+0.92*S2+14.34*S3) * EXP(-5.94*S) * + & X**((-0.013-1.80*S)/(1.+3.14*S)) * X1**(2.37+0.4*S) * + & XL**(0.32+3.6*S) + 3.42 * EXP(-12.*S) * X**0.255 * + & X1**(2.37+3.*S) + XSEA = 0.842*S/(1.+21.3*S-33.2*S2+229.*S3) * + & X**((0.13-2.90*S)/(1.+5.44*S)) * X1**(3.45+0.5*S) * + & XL**(2.8*S) + XSEA0 = 0. + ENDIF +C +C...Evaluate set 2D parton distributions below or above threshold. + ELSEIF(ISET.EQ.3) THEN + IF(Q2.LE.P2.OR.(KFA.EQ.4.AND.Q2.LT.PMC**2).OR. + &(KFA.EQ.5.AND.Q2.LT.PMB**2)) THEN + XVAL = X**0.46 * X1**0.64 + 0.76 * X + XGLU = 1.925 * X1**2 + XSEA = 0.242 * X1**4 + ELSE + XVAL = (1.+0.186*S)/(1.-0.209*S+1.495*S2) * X**(0.46+0.25*S) + & * X1**((0.64+0.14*S+5.*S2)/(1.+S)) * XL**(1.9*S) + + & (0.76+0.4*S) * X * X1**(2.667*S) + XGLU = (1.925+5.55*S+147.*S2)/(1.-3.59*S+3.32*S2) * + & EXP(-18.67*S) * X**((-5.81*S-5.34*S2)/(1.+29.*S-4.26*S2)) + & * X1**((2.-5.9*S)/(1.+1.7*S)) * XL**(9.3*S/(1.+1.7*S)) + XSEA = (0.242-0.252*S+1.19*S2)/(1.-0.607*S+21.95*S2) * + & X**(-12.1*S2/(1.+2.62*S+16.7*S2)) * X1**4 * XL**S + XSEA0 = 0.242 * X1**4 + ENDIF +C +C...Evaluate set 2M parton distributions below or above threshold. + ELSEIF(ISET.EQ.4) THEN + IF(Q2.LE.P2.OR.(KFA.EQ.4.AND.Q2.LT.PMC**2).OR. + &(KFA.EQ.5.AND.Q2.LT.PMB**2)) THEN + XVAL = 1.168 * X**0.50 * X1**2.60 + 0.965 * X + XGLU = 1.808 * X1**2 + XSEA = 0.209 * X1**4 + ELSE + XVAL = (1.168+1.771*S+29.35*S2) * EXP(-5.776*S) * + & X**((0.5+0.208*S)/(1.-0.794*S+1.516*S2)) * + & X1**((2.6+7.6*S)/(1.+5.*S)) * XL**(5.15*S/(1.+2.*S)) + + & (0.965+22.35*S)/(1.+18.4*S) * X * X1**(2.667*S) + XGLU = (1.808+29.9*S)/(1.+26.4*S) * EXP(-5.28*S) * + & X**((-5.35*S-10.11*S2)/(1.+31.71*S)) * + & X1**((2.-7.3*S+4.*S2)/(1.+2.5*S)) * + & XL**(10.9*S/(1.+2.5*S)) + XSEA = (0.209+0.644*S2)/(1.+0.319*S+17.6*S2) * + & X**((-0.373*S-7.71*S2)/(1.+0.815*S+11.0*S2)) * + & X1**(4.+S) * XL**(0.45*S) + XSEA0 = 0.209 * X1**4 + ENDIF + ENDIF +C +C...Threshold factors for c and b sea. + SLL=LOG(LOG(Q2EFF/ALAM**2)/LOG(P2EFF/ALAM**2)) + XCHM=0. + IF(Q2.GT.PMC**2.AND.Q2.GT.1.001*P2EFF) THEN + SCH=MAX(0.,LOG(LOG(PMC**2/ALAM**2)/LOG(P2EFF/ALAM**2))) + IF(ISET.EQ.0) THEN + XCHM=XSEA*(1.-(SCH/SLL)**2) + ELSE + XCHM=MAX(0.,XSEA-XSEA0*X1**(2.667*S))*(1.-SCH/SLL) + ENDIF + ENDIF + XBOT=0. + IF(Q2.GT.PMB**2.AND.Q2.GT.1.001*P2EFF) THEN + SBT=MAX(0.,LOG(LOG(PMB**2/ALAM**2)/LOG(P2EFF/ALAM**2))) + IF(ISET.EQ.0) THEN + XBOT=XSEA*(1.-(SBT/SLL)**2) + ELSE + XBOT=MAX(0.,XSEA-XSEA0*X1**(2.667*S))*(1.-SBT/SLL) + ENDIF + ENDIF +C +C...Fill parton distributions. + XPGA(0)=XGLU + XPGA(1)=XSEA + XPGA(2)=XSEA + XPGA(3)=XSEA + XPGA(4)=XCHM + XPGA(5)=XBOT + XPGA(KFA)=XPGA(KFA)+XVAL + DO 110 KFL=1,5 + XPGA(-KFL)=XPGA(KFL) + 110 CONTINUE + VXPGA(KFA)=XVAL + VXPGA(-KFA)=XVAL +C + RETURN + END +C +C********************************************************************* +C + SUBROUTINE SASANO(KF,X,Q2,P2,ALAM,XPGA,VXPGA) +C...Purpose: to evaluate the parton distributions of the anomalous +C...photon, inhomogeneously evolved from a scale P2 (where it vanishes) +C...to Q2. +C...KF=0 gives the sum over (up to) 5 flavours, +C...KF<0 limits to flavours up to abs(KF), +C...KF>0 is for flavour KF only. +C...ALAM is the 4-flavour Lambda, which is automatically converted +C...to 3- and 5-flavour equivalents as needed. + DIMENSION XPGA(-6:6), VXPGA(-6:6), ALAMSQ(3:5) + DATA PMC/1.3/, PMB/4.6/, AEM2PI/0.0011614/ +C +C...Reset output. + DO 100 KFL=-6,6 + XPGA(KFL)=0. + VXPGA(KFL)=0. + 100 CONTINUE + IF(Q2.LE.P2) RETURN + KFA=IABS(KF) +C +C...Calculate Lambda; protect against unphysical Q2 and P2 input. + ALAMSQ(3)=(ALAM*(PMC/ALAM)**(2./27.))**2 + ALAMSQ(4)=ALAM**2 + ALAMSQ(5)=(ALAM*(ALAM/PMB)**(2./23.))**2 + P2EFF=MAX(P2,1.2*ALAMSQ(3)) + IF(KF.EQ.4) P2EFF=MAX(P2EFF,PMC**2) + IF(KF.EQ.5) P2EFF=MAX(P2EFF,PMB**2) + Q2EFF=MAX(Q2,P2EFF) + XL=-LOG(X) +C +C...Find number of flavours at lower and upper scale. + NFP=4 + IF(P2EFF.LT.PMC**2) NFP=3 + IF(P2EFF.GT.PMB**2) NFP=5 + NFQ=4 + IF(Q2EFF.LT.PMC**2) NFQ=3 + IF(Q2EFF.GT.PMB**2) NFQ=5 +C +C...Define range of flavour loop. + IF(KF.EQ.0) THEN + KFLMN=1 + KFLMX=5 + ELSEIF(KF.LT.0) THEN + KFLMN=1 + KFLMX=KFA + ELSE + KFLMN=KFA + KFLMX=KFA + ENDIF +C +C...Loop over flavours the photon can branch into. + DO 110 KFL=KFLMN,KFLMX +C +C...Light flavours: calculate t range and (approximate) s range. + IF(KFL.LE.3.AND.(KFL.EQ.1.OR.KFL.EQ.KF)) THEN + TDIFF=LOG(Q2EFF/P2EFF) + S=(6./(33.-2.*NFQ))*LOG(LOG(Q2EFF/ALAMSQ(NFQ))/ + & LOG(P2EFF/ALAMSQ(NFQ))) + IF(NFQ.GT.NFP) THEN + Q2DIV=PMB**2 + IF(NFQ.EQ.4) Q2DIV=PMC**2 + SNFQ=(6./(33.-2.*NFQ))*LOG(LOG(Q2DIV/ALAMSQ(NFQ))/ + & LOG(P2EFF/ALAMSQ(NFQ))) + SNFP=(6./(33.-2.*(NFQ-1)))*LOG(LOG(Q2DIV/ALAMSQ(NFQ-1))/ + & LOG(P2EFF/ALAMSQ(NFQ-1))) + S=S+(LOG(Q2DIV/P2EFF)/LOG(Q2EFF/P2EFF))*(SNFP-SNFQ) + ENDIF + IF(NFQ.EQ.5.AND.NFP.EQ.3) THEN + Q2DIV=PMC**2 + SNF4=(6./(33.-2.*4))*LOG(LOG(Q2DIV/ALAMSQ(4))/ + & LOG(P2EFF/ALAMSQ(4))) + SNF3=(6./(33.-2.*3))*LOG(LOG(Q2DIV/ALAMSQ(3))/ + & LOG(P2EFF/ALAMSQ(3))) + S=S+(LOG(Q2DIV/P2EFF)/LOG(Q2EFF/P2EFF))*(SNF3-SNF4) + ENDIF +C +C...u and s quark do not need a separate treatment when d has been done. + ELSEIF(KFL.EQ.2.OR.KFL.EQ.3) THEN +C +C...Charm: as above, but only include range above c threshold. + ELSEIF(KFL.EQ.4) THEN + IF(Q2.LE.PMC**2) GOTO 110 + P2EFF=MAX(P2EFF,PMC**2) + Q2EFF=MAX(Q2EFF,P2EFF) + TDIFF=LOG(Q2EFF/P2EFF) + S=(6./(33.-2.*NFQ))*LOG(LOG(Q2EFF/ALAMSQ(NFQ))/ + & LOG(P2EFF/ALAMSQ(NFQ))) + IF(NFQ.EQ.5.AND.NFP.EQ.4) THEN + Q2DIV=PMB**2 + SNFQ=(6./(33.-2.*NFQ))*LOG(LOG(Q2DIV/ALAMSQ(NFQ))/ + & LOG(P2EFF/ALAMSQ(NFQ))) + SNFP=(6./(33.-2.*(NFQ-1)))*LOG(LOG(Q2DIV/ALAMSQ(NFQ-1))/ + & LOG(P2EFF/ALAMSQ(NFQ-1))) + S=S+(LOG(Q2DIV/P2EFF)/LOG(Q2EFF/P2EFF))*(SNFP-SNFQ) + ENDIF +C +C...Bottom: as above, but only include range above b threshold. + ELSEIF(KFL.EQ.5) THEN + IF(Q2.LE.PMB**2) GOTO 110 + P2EFF=MAX(P2EFF,PMB**2) + Q2EFF=MAX(Q2,P2EFF) + TDIFF=LOG(Q2EFF/P2EFF) + S=(6./(33.-2.*NFQ))*LOG(LOG(Q2EFF/ALAMSQ(NFQ))/ + & LOG(P2EFF/ALAMSQ(NFQ))) + ENDIF +C +C...Evaluate flavour-dependent prefactor (charge^2 etc.). + CHSQ=1./9. + IF(KFL.EQ.2.OR.KFL.EQ.4) CHSQ=4./9. + FAC=AEM2PI*2.*CHSQ*TDIFF +C +C...Evaluate parton distributions (normalized to unit momentum sum). + IF(KFL.EQ.1.OR.KFL.EQ.4.OR.KFL.EQ.5.OR.KFL.EQ.KF) THEN + XVAL= ((1.5+2.49*S+26.9*S**2)/(1.+32.3*S**2)*X**2 + + & (1.5-0.49*S+7.83*S**2)/(1.+7.68*S**2)*(1.-X)**2 + + & 1.5*S/(1.-3.2*S+7.*S**2)*X*(1.-X)) * + & X**(1./(1.+0.58*S)) * (1.-X**2)**(2.5*S/(1.+10.*S)) + XGLU= 2.*S/(1.+4.*S+7.*S**2) * + & X**(-1.67*S/(1.+2.*S)) * (1.-X**2)**(1.2*S) * + & ((4.*X**2+7.*X+4.)*(1.-X)/3. - 2.*X*(1.+X)*XL) + XSEA= 0.333*S**2/(1.+4.90*S+4.69*S**2+21.4*S**3) * + & X**(-1.18*S/(1.+1.22*S)) * (1.-X)**(1.2*S) * + & ((8.-73.*X+62.*X**2)*(1.-X)/9. + (3.-8.*X**2/3.)*X*XL + + & (2.*X-1.)*X*XL**2) +C +C...Threshold factors for c and b sea. + SLL=LOG(LOG(Q2EFF/ALAM**2)/LOG(P2EFF/ALAM**2)) + XCHM=0. + IF(Q2.GT.PMC**2.AND.Q2.GT.1.001*P2EFF) THEN + SCH=MAX(0.,LOG(LOG(PMC**2/ALAM**2)/LOG(P2EFF/ALAM**2))) + XCHM=XSEA*(1.-(SCH/SLL)**3) + ENDIF + XBOT=0. + IF(Q2.GT.PMB**2.AND.Q2.GT.1.001*P2EFF) THEN + SBT=MAX(0.,LOG(LOG(PMB**2/ALAM**2)/LOG(P2EFF/ALAM**2))) + XBOT=XSEA*(1.-(SBT/SLL)**3) + ENDIF + ENDIF +C +C...Add contribution of each valence flavour. + XPGA(0)=XPGA(0)+FAC*XGLU + XPGA(1)=XPGA(1)+FAC*XSEA + XPGA(2)=XPGA(2)+FAC*XSEA + XPGA(3)=XPGA(3)+FAC*XSEA + XPGA(4)=XPGA(4)+FAC*XCHM + XPGA(5)=XPGA(5)+FAC*XBOT + XPGA(KFL)=XPGA(KFL)+FAC*XVAL + VXPGA(KFL)=VXPGA(KFL)+FAC*XVAL + 110 CONTINUE + DO 120 KFL=1,5 + XPGA(-KFL)=XPGA(KFL) + VXPGA(-KFL)=VXPGA(KFL) + 120 CONTINUE +C + RETURN + END +C +C********************************************************************* +C + SUBROUTINE SASBEH(KF,X,Q2,P2,PM2,XPBH) +C...Purpose: to evaluate the Bethe-Heitler cross section for +C...heavy flavour production. + DATA AEM2PI/0.0011614/ +C +C...Reset output. + XPBH=0. + SIGBH=0. +C +C...Check kinematics limits. + IF(X.GE.Q2/(4.*PM2+Q2+P2)) RETURN + W2=Q2*(1.-X)/X-P2 + BETA2=1.-4.*PM2/W2 + IF(BETA2.LT.1E-10) RETURN + BETA=SQRT(BETA2) + RMQ=4.*PM2/Q2 +C +C...Simple case: P2 = 0. + IF(P2.LT.1E-4) THEN + IF(BETA.LT.0.99) THEN + XBL=LOG((1.+BETA)/(1.-BETA)) + ELSE + XBL=LOG((1.+BETA)**2*W2/(4.*PM2)) + ENDIF + SIGBH=BETA*(8.*X*(1.-X)-1.-RMQ*X*(1.-X))+ + & XBL*(X**2+(1.-X)**2+RMQ*X*(1.-3.*X)-0.5*RMQ**2*X**2) +C +C...Complicated case: P2 > 0, based on approximation of +C...C.T. Hill and G.G. Ross, Nucl. Phys. B148 (1979) 373 + ELSE + RPQ=1.-4.*X**2*P2/Q2 + IF(RPQ.GT.1E-10) THEN + RPBE=SQRT(RPQ*BETA2) + IF(RPBE.LT.0.99) THEN + XBL=LOG((1.+RPBE)/(1.-RPBE)) + XBI=2.*RPBE/(1.-RPBE**2) + ELSE + RPBESN=4.*PM2/W2+(4.*X**2*P2/Q2)*BETA2 + XBL=LOG((1.+RPBE)**2/RPBESN) + XBI=2.*RPBE/RPBESN + ENDIF + SIGBH=BETA*(6.*X*(1.-X)-1.)+ + & XBL*(X**2+(1.-X)**2+RMQ*X*(1.-3.*X)-0.5*RMQ**2*X**2)+ + & XBI*(2.*X/Q2)*(PM2*X*(2.-RMQ)-P2*X) + ENDIF + ENDIF +C +C...Multiply by charge-squared etc. to get parton distribution. + CHSQ=1./9. + IF(IABS(KF).EQ.2.OR.IABS(KF).EQ.4) CHSQ=4./9. + XPBH=3.*CHSQ*AEM2PI*X*SIGBH +C + RETURN + END +C +C********************************************************************* +C + SUBROUTINE SASDIR(X,Q2,P2,Q02,XPGA) +C...Purpose: to evaluate the direct contribution, i.e. the C^gamma term, +C...as needed in MSbar parametrizations. + DIMENSION XPGA(-6:6) + DATA AEM2PI/0.0011614/ +C +C...Reset output. + DO 100 KFL=-6,6 + XPGA(KFL)=0. + 100 CONTINUE +C +C...Evaluate common x-dependent expression. + XTMP = (X**2+(1.-X)**2) * (-LOG(X)) - 1. + CGAM = 3.*AEM2PI*X * (XTMP*(1.+P2/(P2+Q02)) + 6.*X*(1.-X)) +C +C...d, u, s part by simple charge factor. + XPGA(1)=(1./9.)*CGAM + XPGA(2)=(4./9.)*CGAM + XPGA(3)=(1./9.)*CGAM +C +C...Also fill for antiquarks. + DO 110 KF=1,5 + XPGA(-KF)=XPGA(KF) + 110 CONTINUE +C + RETURN + END +C----------------------------------------------------------------------- diff --git a/HERWIG/Makefile b/HERWIG/Makefile new file mode 100644 index 00000000000..84ab4f19a94 --- /dev/null +++ b/HERWIG/Makefile @@ -0,0 +1,101 @@ +# Makefile to compile Herwig6 as a shared library for +# ROOT. Needs the Herwig6 routines and the F77 to C++ +# interface routines + +# General Definitions for linux compilers + +include $(ALICE_ROOT)/conf/GeneralDef +include $(ALICE_ROOT)/conf/MachineDef.$(ALICE_TARGET) + +PACKAGE = HERWIG + +# C++ sources + +SRCS = + +# C sources + +CSRCS = main.c herwig6_address.c + +# C Objects + +COBJS = $(patsubst %.c,tgt_$(ALICE_TARGET)/%.o,$(CSRCS)) + +##### MACROS ##### + +FSRCS = HERWIG6100.f herwig6_common_block_address.f herwig6_called_from_cc.f + +FOBJS = $(patsubst %.f,tgt_$(ALICE_TARGET)/%.o,$(FSRCS)) + +SRCS = $(FSRCS) $(CSRCS) +OBJS = $(FOBJS) $(COBJS) + +DSRCS = + +DOBJS = $(patsubst %.f,tgt_$(ALICE_TARGET)/%.o,$(DSRCS)) + +# C++ compilation flags + +CXXFLAGS = $(CXXOPTS) $(CLIBCXXOPTS) $(CLIBDEFS) + +# C compilation flags + +CFLAGS = $(COPT) $(CLIBCOPT) $(CLIBDEFS) + +# FORTRAN compilation flags + +FFLAGS = $(FOPT) $(CLIBFOPT) $(CLIBDEFS) + + + +##### TARGETS ##### + +# Target + +SLIBRARY = $(LIBDIR)/libherwig6.$(SL) +ALIBRARY = $(LIBDIR)/libherwig6.a + +default: $(SLIBRARY) + +$(LIBDIR)/libherwig6.$(SL): $(OBJS) + +depend: $(CSRCS) $(DSRCS) + +TOCLEAN = $(OBJS) $(DOBJS) *Cint.cxx *Cint.h + +############################### General Macros ################################ + +include $(ALICE_ROOT)/conf/GeneralMacros + +############################ Dependencies ##################################### + +-include tgt_$(ALICE_TARGET)/Make-depend + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/HERWIG/herwig59.txt b/HERWIG/herwig59.txt new file mode 100644 index 00000000000..3dc797e3859 --- /dev/null +++ b/HERWIG/herwig59.txt @@ -0,0 +1,3510 @@ +CDECK ID>, INFORM. + + H E R W I G + + a Monte Carlo event generator for simulating + +---------------------------------------------------+ + | Hadron Emission Reactions With Interfering Gluons | + +---------------------------------------------------+ + G. Marchesini, Dipartimento di Fisica, Universita di Milano + I.G. Knowles(*), M.H. Seymour(+) and B.R. Webber, + Cavendish Laboratory, Cambridge +------------------------------------------------------------------------ +with Deep Inelastic Scattering and Heavy Flavour Electroproduction by +G.Abbiendi(@) and L.Stanco, Dipartimento di Fisica, Universita di Padova +------------------------------------------------------------------------ + and Jet Photoproduction in Lepton-Hadron Collisions + by J. Chyla, Institute of Physics, Prague +------------------------------------------------------------------------ +(*)present address: Dept. of Physics & Astronomy, University of Glasgow +------------------------------------------------------------------------ +(+)present address: Theory Division, CERN +------------------------------------------------------------------------ +(@)present address: DESY, Hamburg +------------------------------------------------------------------------ + Version 5.9 - 22nd July 1996 +------------------------------------------------------------------------ + Main reference: + G.Marchesini, B.R.Webber, G.Abbiendi, I.G.Knowles, M.H.Seymour, + and L.Stanco, Computer Physics Communications 67 (1992) 465. +------------------------------------------------------------------------ + Please send e-mail about this program to one of the authors at the + following addresses: + Decnet : 19616::webber, vxdesy::abbiendi, 19800::knowles + Internet : webber@hep.phy.cam.ac.uk, knowles@v2.ph.gla.ac.uk, + seymour@surya11.cern.ch, abbiendi@vxdesy.desy.de +------------------------------------------------------------------------ + + ****** CONTENTS ****** + + 1. INTRODUCTION + 2. NEW FEATURES OF THIS VERSION + 3. FEATURES NOT YET INCLUDED + 4. PROGRAM STRUCTURE + 5. BEAMS AND PROCESSES + 6. INPUT PARAMETERS + 7. COMMON BLOCK FILE + 8. FORM FACTOR FILE + 9. EVENT DATA + 10. STATUS CODES + 11. EVENT WEIGHTS + 12. HEAVY FLAVOUR DECAYS + 13. SPACE-TIME STRUCTURE OF EVENTS + 14. COLOUR REARRANGEMENT MODEL + 15. QCD HARD SUBPROCESSES + 16. DIRECT PHOTON SUBPROCESSES + 17. QCD HIGGS PLUS JET SUBPROCESSES + 18. ELECTROWEAK SUBPROCESSES + 19. INCLUDING NEW SUBPROCESSES + 20. ERROR CONDITIONS + 21. SAMPLE OUTPUT + 22. GUIDE TO SAMPLE OUTPUT + +------------------------------------------------------------------------ + + ****** 1. INTRODUCTION ****** + + HERWIG is a general-purpose event generator for high energy hadronic + processes, with particular emphasis on the detailed simulation of + QCD parton showers. The program has the following special features: + + * Simulation of any combination of hard lepton, hadron or photon + scattering and soft hadron-hadron collisions in one package. + + * Colour coherence of partons (initial and final) in hard subprocesses + + * Heavy flavour hadron production and decay with QCD coherence effects + + * QCD jet evolution with soft gluon interference via angular ordering + + * Backward evolution of initial-state partons including interference + + * Azimuthal correlations within and between jets due to interference + + * Azimuthal correlations within jets due to gluon polarization + + * Cluster hadronization of jets via non-perturbative gluon splitting + + * A complete space-time picture from parton showers to hadronic decays + + * A colour rearrangement model based on an events space-time structure + + * A similar cluster model for soft and underlying hadronic events + + Further details may be found in the references cited above and at the + end of this section, and in comments distributed throughout the code. + + The program operates by setting up parameters in common blocks and + then calling a sequence of subroutines to generate an event. Para- + meters not set in the main program HWIGPR are set to default values + in the main initialisation routine HWIGIN. + + To generate events the user must first set up the beam particle names + PART1, PART2 (type CHARACTER*8) in the common block /HWBEAM/, and the + beam momenta PBEAM1, PBEAM2 (in GeV/c), a process code IPROC and the + number of events required MAXEV in /HWPROC/. See section 5 for beams + and processes available. + + All analysis of generated events (histogramming, etc.) should be + performed by the user-provided routines HWABEG (to initialise), + HWANAL (to analyse an event) and HWAEND (to terminate). At present + HWANAL writes event information and stable particle data on unit + LWEVT defined in HWIGIN (or simply returns if LWEVT=0). See HWANAL + for details of event information written. Note that HWANAL should + always begin with the line + IF (IERROR.NE.0) RETURN + to prevent it being executed for incomplete events. + + A detailed event summary is printed out for the first MAXPR events + (default MAXPR=1). Set IPRINT=2 to list the particle identity codes + and (simplified) particle decay schemes used in the program. + + The programming language is standard Fortran 77 as far as possible. + However, the following may require modification for running on + computers other than Vax's: + + * Most common blocks are inserted by INCLUDE 'HERWIG59.INC' Vax + Fortran statements (see below for contents of HERWIG59.INC) + + * Subroutine HWUTIM (returning CPU time left) is machine dependent. + + The principal references are: + + G.Marchesini and B.R.Webber, Nucl. Phys. B310 (1988) 461; I.G. + Knowles, Nucl. Phys. B310 (1988) 571; S.Catani, G.Marchesini and + B.R.Webber, Nucl. Phys. B349 (1991) 635; G.Abbiendi and L.Stanco, + Comp.Phys.Comm. 66 (1991) 16, Zeit. Phys. C51 (1991) 81; + M.H.Seymour, Zeit. Phys. C56 (1992) 161. + + + Some additional relevant references are: + + A.Bassetto, M.Ciafaloni and G.Marchesini, Phys. Rep. 100 (1983) 201; + G. Marchesini and B.R. Webber, Nucl. Phys. B238 (1984) 1; Phys. + Rev. D38 (1988) 3419; B. R. Webber, Nucl. Phys. B238 (1984) 492; + Ann. Rev. Nucl. Part. Sci. 36 (1986) 253; I.G. Knowles, Nucl. Phys. + B304 (1988) 794; Computer Phys. Comm. 58 (1990) 271. +------------------------------------------------------------------------ + + ****** 2. NEW FEATURES OF THIS VERSION ****** + + * The common block file HERWIG59.INC has been significantly rearranged + and tidied up. + + * Many new hadrons have been added. All S & P wave mesons are present + including the 1^P_0 & 3^P_1 states and many new, excited B^**, B_c & + quarkonium states. Also all D wave kaons and some `light' I=3 states + [pi_2, rho(1700) & rho_3]. All the baryons (singlet/octet/decuplet) + containing up to one heavy (c,b) quark are included. + + --- Consequently the default parameters require retuning --- + + * New 8-character particle names have been introduced and the revised + 7 digit PDG numbering scheme, as advocated in the LEP2 report, has + been adopted. + + * The layout of HWUDAT has been altered to make it easier to identify + and modify particle propeties. Three new arrays have been introduced + RLTIM, RSPIN & IFLAV. These are: the particle's lifetime (ps), spin, + and a code which specifies the flavour content of each hadron - used + (in HWURES) to create sets of iso-flavour hadrons for cluster decay. + Using the standard numbering of quark flavours the convention is: + + mesons: n_q n_qbar Eg. pi^+: 21, pi^-: 12 + baryons: +/-n_q1 n_q2 n_q3 Eg. Xi^0: 332, Xi^0bar: -332 etc. + (-ve for antibaryons; digits in decreasing order) + + Light, neutral mesons are identified as: 11 if I=1: pi^0,rho^0,... + 33 if I=0: eta, eta'.. etc. + + Some parts of the program have been automated so that it is possible + for the user to add new particles by specifying their properties via + the arrays in /HWPROP/ & /HWUNAM/ and increasing NRES appropriately: + this should be done before a call to HWUINC. + + As an example following lines add an isoscalar, spin pi state 'STAN' + and a (very light) stable toponium state 'BEER' with the decay mode: + STAN ---> BEER+BEER+BEER. + + NRES=NRES+1 + RNAME(NRES)='STAN ' + IDPDG(NRES)=666 + IFLAV(NRES)=11 + ICHRG(NRES)=0. + RMASS(NRES)=0.5 + RLTIM(NRES)=1.000D-10 + RSPIN(NRES)=3.142 + NRES=NRES+1 + RNAME(NRES)='BEER ' + IDPDG(NRES)=66 + IFLAV(NRES)=66 + ICHRG(NRES)=0. + RMASS(NRES)=0.1 + RLTIM(NRES)=1.000D+30 + RSPIN(NRES)=0.0 + CALL HWMODK(666,1.D0,0,66,66,66,0,0) + + + * The mixing angles of all the light, I=0 mesons can now be set using: + + ETAMIX: eta <-> eta' F0MIX: f_0(1300) <-> f_0(980) + PHIMIX: omega <-> phi, F1MIX: f_1(1285) <-> f_1(1510) + H1MIX: h_1(1170) <-> h_1(1380) F2MIX: f_2 <-> f_2' + + * Using the logical arrays VTOCDK & VTORDK the production of specified + particles can be stopped in both cluster decays and via the decay of + other unstable resonances. + + * A priori weights for the relative production rates in cluster decays + of mesons and baryons differing only via their S & L quantum numbers + can be supplied using SNGWT & DECWT for singlet (i.e. Lambda-like) & + decuplet baryons and REPWT for mesons. The old VECWT now corresponds + to REPWT(0,1,0) and TENWT to REPWT(0,2,0). + + * The default masses of the c and b quarks have been lowered to 1.55 & + 4.95 repectively: this corresponds to the mass of the lightest meson + minus the u/d quark mass. This increases the number of heavy mesons, + and hence total multiplicities, and slightly softens their momentum + spectrum. The rate of photoproduced charm states increases and B-pi + momentum correlations become smoother. + + * The resonance decay tables supplied in the program have been largely + revised. Measured/expected modes with branching fraction at or above + 1 per mille are given, including 4 & 5 body decays. To print the new + tables call HWUDPR. + + * The arrays FBTM, FTOP & FHVY which stored the branching fractions of + the bottom, top & heavier quarks' `partonic' decays are now nolonger + used. Such decays are specified in the same way as all other decay + modes: this permits different decays to be given to individual heavy + hadrons. Partonic decays of charm hadrons and quarkonium states are + also now supported. The products' order in a partonic decay mode is + significant. For example if the decay is: Q --> W+q --> (f+fbar')+q, + occuring inside a Q-sbar hadron the required ordering is: + + Q+sbar --->(f+fbar')+(q+sbar) + or (q+fbar')+(f+sbar) `colour rearranged' + + In both cases the (V-A)^2 ME^2 is proportional to: p_0.p_2 * p_1*p_3 + + * The structure of the program has been altered so that secondary hard + subrocess and subsequent fragmentation associated with each partonic + heavy hadron decay appear separately. Thus pre-hadronization t quark + decays are treated individually as are any subsequent bottom hadron + partonic decays. + + * Additionally decays of heavy hadrons to exclusive non-partonic final + states are supported. No check against double counting from partonic + modes is included. However this isn't expected to be a major problem + for the semi-leptonic and 2-body hadronic modes supplied. + + * An array NME has been introduced to enable a possible matrix element + to be specified for each decay mode. + + NME = 0 Isotropic decay + 100 Free particle (V-A)*(V-A): p_0.p_2 * p_1.p_3 + 101 Bound quark (V-A)*(V-A): p_0.p_2 * p_1*[p_3 - xs*p_0] + xs = m_Q/M_0 - spectator quark momentum fraction + 130 Ore & Powell ortho-positronium ME^2: onium --> gg+g/gamma. + + The list of matrix elements presently supported is modest, users are + urged to contact an author to have other MEs implimentated. + + * The decay tables can be written to/read from a file by using HWIODK, + adopting the format advocated in the LEP2 report. In addition to the + PDG numbering of particles the HERWIG numbers or character names can + be used. This permits easy alteration of the decay tables. In HWUINC + a call is made to HWUDKS which sets up HERWIGs internal pointers and + performs some basic checks of the decay tables. Each decay mode must + conserve charge and be kinematically allowed and not contain vetoed + decay products. The sum of a particles branching ratios is set to 1. + Also a warning is printed if an antiparticle does not have all the + charge conjugate decays modes of the particle. + + * HWMODK enables changes to the decay tables to be made by alterating/ + adding single decay modes including on an event by event basis. This + can be done before HWUINC, in which case when altering the BR and/or + ME code of an existing mode a warning is given of a duplicate second + mode which supercedes the first. BRs set below 10^-6 are eliminated, + whilst if one mode is within 10^-6 of 1 all other modes are removed. + Note that some forethought is required if the BRs of 2 modes of the + same particle are changed since the operation of rescaling to 1 the + BR sum causes a non-commutativity in the order of the calls. + + * Production vertex information is now made available, using VHEP, for + all partons, clusters and final state particles: set PRVTX=.TRUE. to + print them. The vertices of partons and clusters are given wrt local + coordinates associated with their individual hard sub-process. + + * All partonic and resonace rest frame lifetimes are generated with an + exponential distribution: exp(-t/)/. The average lifetime, + , is given in terms of the particles mass, width and virtuality + by: + hbar.sqrt(q^2) + (q^2) = ----------------------------- + \/(q^2-M^2)^2 + (Gamma.q^2/M)^2 + + = hbar/Gamma for an on-shell particle + ~ hbar.q/(q^2-M^2) a highly virtual particle + + For partons an effective width = sqrt(VMIN2), to act as a cut-off on + lifetimes, is introduced. + + * The space-time picture for cluster formation and splitting is partly + ad hoc and partly string inspired - no physics depends upon it. + + * All particles with lifetimes greater than PLTCUT are set stable. + + * If PIPSMR=.TRUE. the primary interaction point's spatial position is + is smeared according to the triple Gaussian in HWRPIP: this position + is assigned to the CMF track. + + * If MAXDKL=.TRUE. then each putative decay is tested in HWDXLM to see + that it occurs within a specified volume (cylinder/sphere for IOPDKL + =1/2): if not it is set stable. + + * If MIXING=.TRUE. then B^0_d,s mesons are allowed to oscillate: XMIX + and YMIX contain Delta-M/Gamma and Delta-gamma/2*Gamma respectively. + A new particle, ISTHEP=200, is introduced giving the flavour of the + neutral B meson at production in addition to the `decaying' track. + + * A multiple intra & inter-jet colour rearrangement model is available + for CLRECO=.TRUE. The q-qbar pairings in two non-adjacent clusters + are interchanged with probability PRECO if the distances between the + production vertices of both q-qbar pairs when added in quadrature is + reduced. EXAG can be used to artificially scale the lifetimes of any + weak bosons. + + * A number of bugs have been corrected: in HWEPRO for weighted events; + in HWSBRN affecting the reconstruction of the photon beam remnant; + and in HWHEPG stopping event generation. Plus minor modifications to + HWBGEN; in the use of HWHIGM by HWHIGJ; and small changes in HWHDIS + & HWHEGG. + + * A significant bug in HWDHQK, affecting top quark decays, was present + in version 5.8 ONLY. The scale of the top decay had been set to the + b-quark mass, stopping gluon radiation from the b and restricting + that from the W decay products to have transverse momentum less than + the b mass. The scales are now correctly set for top decays. + + * Improved efficiency of photon generation in HWEGAM. + + * New hard sub-process have been added: + + - Compton scattering, gamma + q --> gamma + q, IPROC=5300. + + - Two-to-two parton scattering via exchange of a colour singlet + IPROC=2400 Mueller-Tang pomeron: the fixed alpha_s and omega_0 are + given by ASFIXD and OMEGA0 respectively. + IPROC=2450 photon exchange, for like flavour qqbar pairs including + the t-channel component of the interference with q-qbar -> q-qbar. + + - Drell-Yan has been extended to the production of all fermion pairs + IPROC=1399; 1300 gives all quark flavours 1300+IQ a specific quark + flavour, 1350 all leptons (including neutrinos) 1350+IL a specific + lepton flavour. The s-channel component of the interference with + like flavour q-qbar scattering is included here. + + - Z+jet production is included as IPROC=2150 (HWHW1J becomes HWHV1J) + + * Running coupling now used for prompt J/PSI production in DIS. + + * The phase-space limits for the momentum fraction of incoming photons + in the Weizsacker-Williams approximation is now set by the variables + YWWMIN & YWWMAX, allowing different ranges for the tagged and + untagged photons in two-photon DIS. + + * Interfaced to the Schuler-Sjostrand parton distribution functions, + version 2. These appear as PDFLIB sets with author group 'SaSph', + but are actually implemented via a call to their SASGAM code. The + value in MODPDF specifices the set (1-4 for 1D [recommended set],1M, + 2D,2M), whether the Bethe-Heitler process is used for heavy flavours + (add 10), whether the P^2-dependence is included (add 20), and which + of their P^2 models is used (add 100 times their IP2 parameter). + + * New variables ANOMSC(1 or 2,IBEAM) record the evolution scale and Pt + at which an anomalous (gamma* --> q+qbar) splitting was generated in + the backward evolution of beam IBEAM. set 0 if no such splitting was + generated. This is implemented in HWBGEN and HWSBRN. + + * In preparation for multiple interactions, several routines have been + added or modified. New are: HWHREM for identifying and cleaning up + the beam remnants; HWHSCT to administer the extra scatters. Minor + modifications to: HWBGEN & HWSBRN, don't report energy conservation + errors when ISLENT = -1; HWSSPC, improved approximation for remnant + mass at high energies; and HWUPCM, improved safety against negative + square roots. + + * Photon Initial State Radiation in e+e- annihilation events allowed. + TMNISR sets the minimum s-hat/s value, ZMXISR sets the (arbitrary) + separation between unresolved and resolved emission; using ZMXISR=0 + switches off photon ISR. + + * Numerical integral in HWBDED now done analytically removing the need + to reintegrate for each new energy; in principle allowing use in 5- + jet WW events, but this is not yet implemented. + + * New phase-space variable WHMIN added. This sets the minimum allowed + hadronic mass and affects photoproduction reactions (gamma-hadron & + gamma-gamma) and DIS. In lepton-hadron DIS it is largely irrelevant + since there is already a cut on Bjorken y which at fixed s is almost + the same but for lepton-gamma DIS it makes a big difference. + + * A new treatment of running Higgs width and non-resonant diagrams, as + suggested in M.H. Seymour, Phys. Lett. B354 (1995) 409. Selected by + setting IOPHIG=2 or 3 (default); previous options 2 and 3 have been + withdrawn. Note that including the non-resonant diagrams changes the + meaning of what is generated: IOPHIG = 0 or 1, gives the s-channel + diagram, an unphysical choice of part of the amplitude; IOPHIG = 2 + or 3, gives the I=0 & J=0 part of the excess over the cross section + expected for a zero mass Higgs boson, a physical choice of part of + the cross section. The inclusion of non-resonant diagrams causes the + cross section to increase below and decrease above resonance. + + * New treatment of the splitting in two of clusters containing hadron + (or photon) remnants. Previous versions gave the 2 fragments a mass + spectrum typical of soft processes: dn/dm**2 = Gaussian. In the new + version the child containing the remnant is treated as before but + the other cluster, containing a perturbative parton, is treated as a + normal clusters: dn/dm = m**psplt. IOPREM controls this behaviour: 0 + = old version, 1 = new (default). + + * Direct gamma+gamma* -> q+qbar is included in the hard correction for + lepton-gamma DIS; plus minor bug fixed in HWBDIS. + + * The dummy routine IUCOMP has been removed, this avoids errors when + the program is linked to CERNLIB. + + * It has been noticed that differences in the way quark masses are + treated in different processes can cause inconsistencies between + different ways of generating the same process. The most noticeable + example is in direct photoproduction, where one can use process 9130 + or 5000. See the note at the end of Section 5 of the documentation + for more information on the strategies used in different processes. + + Version 5.1 of HERWIG was described in detail in Computer Physics + Communications 67 (1992) 465. For completeness we list here also the + main new features added in versions 5.2 - 5.7. + + In version 5.2: + + * New e+e- processes: + - two photon processes, IPROC = 500+ID where ID=0-10 is the same as + in Higgs processes for qqbar, llbar, and W+W-. The phase space is + controlled by EMMIN,EMMAX for the CMF mass, PTMIN,PTMAX for the + transverse momentum of the CMF in the lab, and CTMAX for the CMF + angle of the outgoing particles. + - photon-W fusion, IPROC = 550+ID where ID=0-9 is the same as in + Higgs processes, except that ID=1 or 2 both give the sum of dubar + and udbar etc. The phase space is controlled by EMMIN,EMMAX only. + The full 2-->3 matrix elements for photon e-->f f'bar nu are used, + so the cross section for real W production is correctly included. + - ZZ pair production, IPROC=250 is treated just like WW production, + and is based on the program kindly supplied by Zoltan Kunszt. + + * New ep processes: + - the phase space for BGF is now controlled by EMMIN,EMMAX as above. + The default values are 0 and RootS respectively, corresponding to + the behaviour of version 5.1 + - J/psi production from BGF, IPROC = 9104 is now available. + - W W fusion to Higgs is now available in ep, IPROC = 9500+ID. + + * IPROC = 1600+ID now gives the sum of gluon fusion and q qbar fusion. + This is especially important in e+e- if tan(beta) is large, when it + is dominated by e+e- --> e+e- gamma gamma --> e+e- b bbar H. + + * Users can now force Z --> b bbar decays, with MODBOS(i)=7 (for a + complete list see section 18). For example, IPROC=250, MODBOS(1)=7, + MODBOS(2)=0 gives ZZ production with one Z decaying to b bbar. + + * All Higgs vertices now include an enhancement factor to account for + non-SM couplings. ENHANC(ID), where ID=1-11 is the same as for Higgs + production, holds the ratio of the AMPLITUDE for the given vertex to + that of the SM. This of course only simulates the chargeless scalars + of any extended model, and not the pseudoscalars or charged Higgses. + + * The heavy quark content of the photon now uses the corrections to + the Drees-Grassie distribution functions for light quarks, recently + calculated by C.S.Kim et al. (see M.Drees & C.S.Kim, DESY 91-039 and + C.S.Kim, Durham preprint DTP/91/16). + + * A new structure function set, Owens1.1, similar to Duke+Owens1, but + fitted to new data (Preprint FSU-HEP-910606) is available via + NSTRU=5, and is now the default structure function set. + + In version 5.3: + + * O(alpha-s) jet production in ep processes has been included (IPROC= + 9200 etc), with Q**2 range controlled by Q2MIN, Q2MAX and minimum + jet transverse momentum (in the hard subprocess c.m. frame) set by + PTMIN. The new subroutines were written by Sebastian Brandis and we + are grateful to him for permission to use his code. + + * Minor bugs have been fixed in the backward evolution of quarks into + photons, hadronic processes in e+e-, remnant hadronization in ep, + and in the generation of weighted events (ie. with NOWGT=.FALSE.). + + In version 5.4: + + * A correction to hard gluon emission in e+e- events has been added + and is now the default process. This uses the O(alpha-s) matrix + element to add events in the `back-to-back' region of phase-space + corresponding to a quark-antiquark pair recoiling from a very hard + gluon. Although this is asymptotically negligible, and cannot be + produced within the shower itself, it has a sizeable effect at LEP + energies. As a result, the default parameters have been retuned, + and show a marked improvement in agreement with OPAL data for event + shapes sensitive to three-jet configurations (J.W. Gary, private + communication). The uncorrected process has been retained for + comparative purposes and is available as IPROC=120+IQ. + + * Photons are now included in time-like parton showering. The infra- + red cutoff is VPCUT, which defaults to SQRT(S) corresponding to no + emission. Agreement with LEP data is satisfactory if used together + with the matrix element correction to produce photons in the back- + to-back region. The results are insensitive to VPCUT variations + in the range 0.1-1.0 GeV. + + * W decay correlations and width are now correctly included in W+jet + production (previous versions used unpolarized, on-shell approx.). + + * An inconsistency in the argument used for alpha_s in the branching + g -> q qbar has been removed. The change is a non-leading correction + but leads to slightly more quarks in gluon jets. + + * A new parameter B1LIM has been introduced for B cluster hadroniz- + ation. If MCL is the B cluster mass and MTH the threshold for its + decay into 2 hadrons, the probability of its decay into a single B + hadron is: 1 if MCL(1+B1LIM)*MTH, with a linear + interpolation i.e. 1-(MCL-MTH)/(B1LIM*MTH) if MTH0 gives a harder B spectrum. + + * B decays can now be performed by the EURODEC or CLEO Monte Carlo + packages. The new variable BDECAY controls which package is used: + 'HERW' for HERWIG; 'EURO' for EURODEC; 'CLEO' for CLEO. The EURODEC + package can be obtained from the CERN library. The CLEO package is + available by kind permission of the CLEO collaboration, and can be + obtained from Luca Stanco at the address given above. + + In version 5.5: + + * The Sudakov form factors can now be calculated using the one-loop or + two-loop alpha_s, according to the variable SUDORD (DEFAULT=1). The + parton showering still incorporates the two-loop alpha_s in either + case but if SUDORD=1 this is done using the veto algorithm, whereas + if SUDORD=2 no vetoes are used in the final-state evolution. This + means that the relative weight of any shower configuration can be + calculated in a closed form, and hence that showers can be `forced'. + For example, a package of routines should be available soon for + forcing jets to contain photons, which will therefore drastically + improve the efficiency of photon FSR studies. + To next-to-leading order the two possibilities SUDORD=1 or 2 should + be identical, but they differ at beyond-NLO, so some results may + change a little. Previous versions were equivalent to SUDORD=1. + + * Alpha_em is now multiplied by the factor ALPFAC (DEFAULT=1) for all + quark-photon vertices in jets, and in the `dead zone' in e+e-. This + is a cheap way of improving the efficiency of photon FSR studies, + which should not be needed once photon forcing is available. Note + that results at small ycut become sensitive to ALPFAC above about 5. + + * A new parameter CLPOW (DEFAULT=2) is available in the cluster hadro- + nization model. A cluster of mass MCL made of quarks of mass M1,M2 + is split into lighter clusters before decaying if + MCL**CLPOW > CLMAX**CLPOW + (M1+M2)**CLPOW + Thus the previous value was CLPOW=2, like the new default. Smaller + values will increase the yield of heavier clusters (and hence of + baryons) for heavy quarks, without affecting light quarks much. For + example, the default value gives no b-baryons (for the default value + of CLMAX) whereas CLPOW=1.0 makes b-baryons/b-hadrons about 1/4. + + * The event record has been modified to retain entries for all partons + before hadronization (with status ISTHEP=2). During hadronization, + the gluons are split into quark-antiquark, while other partons are + copied to a location (indicated by JDAHEP(1,*)) where their momenta + may be shifted slightly, to conserve momentum, during heavy cluster + splitting. Previously the original momenta were shifted, so momentum + appeared not to be conserved at the parton level. + + * Minor improvements have been made to: NLO correction to Higgs decays + to qqbar; pt spectra of outgoing electrons in two-photon processes; + quark-mass effects in gamma-W fusion; WW spectrum below threshold in + e+e-; t-bbar spectrum in W Drell-Yan (IPROC=1406). + + * Bugs preventing the use of Sudakov form factor tables from disk and + gluon-> diquarks splitting option under some circumstances, together + with other minor bugs and machine-dependences, have been fixed. + + In version 5.6: + + * Decays of very heavy quarks (top and higher generations) can occur + either before or after hadronization. At present all top quarks will + decay before/after hadronizing if the top mass is greater/less than + 130 GeV. This can be changed in subroutine HWDTOP. All higher (>3) + generations now decay before hadronization. Note that the new state- + ment CALL HWDHQK must appear in the main program between the calls + to HWBGEN and HWCFOR to carry out any decays before hadronization. + + * Bugs in the subroutine HWHDOA for O(alpha_s) jet production in DIS + have been corrected by J. Chyla, who has also extended this process + into the photoproduction region. If Q2MIN.LT.2D-6 (the new default), + the kinematic lower limit on Q**2 is computed and used. New options + IPROC=9250 to 9277 use various approximations to the neutral-current + matrix element, as specified in the Table below. + + * The photoproduction processes have also been extended from the + original heavy quark production program, to include all quark pair + production (IPROC=9100-9106) and QCD Compton (IPROC=9110-9122), as + well as the sum of the two (IPROC=9130). The possible flavours for + the 9100,9110 and 9130 processes are limited by the input parameters + IFLMIN and IFLMAX (defaults are 1 and 3, i.e. only u,d,s flavours). + The corresponding Charged Current processes are now provided via the + IPROC=9140-9144 codes. + + * All the DIS processes IPROC=9000-9599 are now available in e+e- as + well as lepton-hadron collisions. The program generates a photon + from the second beam (only) in Weizsacker-Williams approximation and + uses Drees-Grassie structure functions for DIS on the photon. + + * Pointlike photon-hadron scattering to produce QCD jets is available + as IPROC=5000. This is suitable for fixed-target photoproduction, + provided events are generated in a frame in which the target has + high momentum, and then boosted back to the lab. IPROC=5000+IQ gen- + erates only those processes involving quark flavour IQ, using exact + kinematics and light-cone momentum fraction. In both cases, after + event generation the hard subprocess code IHPRO is set to 51,52 or + 53 for photon+q->g+q, photon+qbar->g+qbar, or photon+g->q+qbar. + + * The default limits on Q**2 in DIS processes (Q2MIN,Q2MAX) have been + set very small/large (0.0, 1.D10) and are reset to the kinematic + limits unless changed by the user. This means the default Q2MIN is + not suitable for simple NC DIS (IPROC=9000 etc), but is appropriate + for jet and heavy quark photoproduction. + + * A new parameter NMXJET, the maximum number of outgoing partons in + a hard subprocess (default 200) has been introduced in the common + block file HERWIG56.INC. + + * For technical reasons, some HERWIG status codes ISTHEP between 153 + and 165 have changed their meanings. See the Table in sect.10 below. + + * Bugs in the hadronization of diquark-antidiquark clusters have been + fixed. Any such clusters with masses below threshold for decay into + baryon-antibaryon are shifted to the threshold via a transfer of 4- + momentum to a neighbouring cluster. + + * A bug in the default pion structure function (no gluons) is fixed. + + In version 5.7: + +- ELECTRO-WEAK COUPLINGS: New arrays QFCH(16), VFCH(16,2), AFCH(16,2) + and VCKM(3,3) have been set up for couplings and CKM matrix. See the + documentation file or HWIGIN for conventions. Note that universality + is not assumed, so lepton axial couplings may differ for example; this + is primarily to cover Z' possibilities, see below. The variable + SCABI=sin^2 theta_Cabibbo is however also retained for the present. + +- A Z' has been introduced with PDG code 32, HERWIG identifier 202, + default mass 500 GeV, width GAMZP (default 5 GeV) and name 'Z0PR'. + It is invoked by setting ZPRIME=.TRUE. (default .FALSE.). + +- POLARISATION: incoming lepton and antilepton beam polarisations + are now specified by setting two new vectors EPOLN(3) and PPOLN(3): + component 3 is longitudinal and 1,2 transverse. Transverse only occurs + in e+e- routines; recall that two transverse 'measurements' are needed + to see an effect so it should not arise elsewhere. Note that in DIS + processes you have to set either EPOLN if it is a lepton or (exclusive) + PPOLN if an antilepton. + + Polarisation effects are now included in e+e- 2/3 jet production + and Bjorken process, together with DIS processes apart from J/psi + production. + +- NEW SUBPROCESSES: + 2200 QCD direct photon pair production (inc. g+g->gamma+gamma) + 5100+IQ Point-like photon/QCD heavy flavour pair production + 5200+IQ Point-like photon/QCD heavy flavour single excitation + The latter two replace 5000+IQ, while 5000 remains as before (ie + a sum over all processes and flavours with simplified kinematics) + +- The kinematic reconstruction of DIS processes can now take place in + the Breit frame, if BREIT=.TRUE. (the default value). Previous versions + used the lab frame. Although the reconstruction is fully invariant under + Lorentz boosts along the incoming hadron's direction, it is not under + transverse boosts, so there should be some difference between the two + frames. The boost is not performed for very small Q^2 (<10^-4) to avoid + numerical instabilities, but the two frames are in any case equivalent + for such small Q^2. + +- A new parameter PRSOF to produce an underlying event in only a fraction + PRSOF of events (default=1.0). IPROC=19000 etc are thus equivalent to + PRSOF=0. + +- Non-diffractive hadronic minimum bias events (IPROC=8000) can now be + generated for a wider variety of beams (P,PBAR,PI+/-,K+/-,E+/-,MU+/-,GAMA + on target P; also P and PBAR or leptons on target N). The event weight + (previously set to 1.0 for this process) is the estimated cross section + based on the parametrizations of Donnachie and Landshoff, CERN-TH.6635/92. + The non-diffractive cross section is assumed to be 70% of the total. + For lepton beams a photon is first generated using the effective photon + approximation (see below) and then the on-shell photon cross section + is used. + +- A bug has been fixed in HWBRAN and HWSBRN (present in versions 5.1 to + 5.6) that led to too much transverse momentum being developed by the + parton showers in hadron-hadron collisions. All radiation with pt + greater than the hard process scale is now vetoed. In the case of + initial-state radiation, this affects all events, while for final-state + radiation it only affects those in which the two jets have a rapidity + difference of more than about 3.4. + +- When SUDORD=2, no veto is needed for gluon splitting to quarks. This + means that no vetoes are needed for final state showering, except for + the previously-mentioned transverse momentum cut. The removal of + vetoes allows preselection of the flavours that a jet will contain, + giving a huge increase in the efficiency of rare process simulation. A + package is already available to simulate heavy flavour production + inside jets, and the equivalent for photons should soon be available. + +- Parameter BTCLM is now available to users to adjust the mass parameter + in remnant formation. Its default value, 1.0, is identical to previous + versions. + +- There is a new switch CLDIR for cluster decays. CLDIR=0 is the same as + previous versions, while CLDIR=1 (the default) means that a cluster that + contains a `perturbative' quark, ie one coming from the perturbative + stage of the event (the hard process or perturbative gluon splitting) + `remembers' its direction: when the cluster decays, the hadron carrying + its flavour continues in the same direction (in the cluster c.m. frame) + as the quark. This considerably hardens the spectrum of heavy hadrons, + particularly of c- and b-flavoured hadrons. It also introduces a tendency + for baryon-antibaryon pairs preferentially to align themselves with the + event axis (the `TPC/2gamma string effect'). + +- The functionality of the routine HWUINE has now been split between it + and a new routine, HWUFNE. A call to the latter MUST be inserted into + the users main program, between the calls to HWMEVT and HWANAL. A + check is built in to version 5.7 to prevent execution if this change + is not made. See the documentation file for an example main program. + We should also take this opportunity to remind users that the analysis + routine HWANAL should begin with the line + IF (IERROR.NE.0) RETURN + since if an event is cancelled, each of the routines is still called + in turn until reaching the end of the main loop. + +- If the new flag USECMF is .TRUE. (the default), events are boosted to + their centre-of-mass frame before processing if necessary, and boosted + back afterwards. This second boost is performed by the new routine + HWUFNE, so it is essential that this is inserted in the correct place, + as described above. + +- In hadronic processes with lepton beams (eg photoproduction in ep), + the lepton->lepton+photon vertex now uses the full tranverse-momentum- + dependent splitting function, with exact light-cone kinematics (i.e. + the Equivalent Photon instead of the Weizsacker-Williams approximation). + This means that the photon-hadron collision has a transverse momentum + in the lepton-hadron frame, and must be boosted to a frame where it + has no transverse momentum. Thus the cmf boost described above is + always used in these processes, regardless of the value of USECMF. + The correct lower energy cut-off appropriate to the hadronic process + is applied to the photon, rather than the fixed cut of 5 GeV that + was used in previous versions. The Q**2 of the photon is generated + within the kinematically allowed limits, or the user-defined limits + Q2WWMN and Q2WWMX (defaults 0 and 4) whichever is more restrictive. + The momentum fraction is generated within the kinematic limits or + between YBMIN and YBMAX (defaults 0 and 1). + +- Point-like photon processes (IPROC=5***) are now also available with + lepton beams, using the Equivalent Photon Approximation. + +- Several minor improvements have been made to the O(as) processes in + DIS (IPROC=91**): + - A sign error has been corrected that led to the incorrect sign for + the lepton-jet azimuthal correlation in QCD Compton processes. + - An additional cut on the phase-space generation has been provided: + the Bjorken-y variable (=Q^2/xs) is limited to range [YBMIN,YBMAX]. + - BGSHAT=.FALSE. is now the default. + - J/Psi production (IPROC=9107) now uses the EPA instead of the WWA, + with the same phase-space cuts as hadronic processes with lepton + beams, see above. + +- Many bugs have been fixed in the other O(as) process routines, HWHDOA + and HWHDOM, ie for IPROC=92**. However, this process is no longer + supported, and is only retained for comparative purposes. It will be + withdrawn completely at the next version release. + +- An interface is now provided to Mark Gibbs' HERBVI package for baryon- + number violation, and other multi-W production processes, IPROC=7***. + +- Minor bug fixes in HWHDIS, HWHEGW and HWHIGW and minor improvements in + HWHHVY, HWHPHO, HWHQCD and HWHWEX hard process routines. + +- New fictional e+e- processes: e+e- -> gluon+gluon(+gluon), IPROC=107 + & 127, treated just like e+e- -> quark+antiquark, summed over light + quark flavours, for direct comparisons between quark and gluon jets. + +- New logical variable PRNDEC (default=.TRUE. unless NMXHEP>9999) causes + track numbers in event listings to be printed in hexadecimal if.FALSE. + This is necessary for very large events such as those generated by the + HERBVI package (see above). + +- PDFLIB structure functions can now be used for the photon as well as + nucleons. The new variable MODPHO acts just like MODPDF. PDFLIB calls + have also been updated to allow for structure function sets with + flavour-asymmetric sea contributions. + +- A logical inconsistency has been fixed in the decays of clusters to + eta or eta' - previously all mixing was neglected, leading to double- + counting and a significant over-estimate of the number of each. The + new variable ETAMIX gives the eta_8/eta_0 mixing angle in degrees + (default = -20). Rates are not very sensitive to its exact value, as + the eta'/eta suppression is dominated by mass effects in the cluster + model. + +- The maximum weight is now always printed in full precision (needed + to be sure of generating the same events in repeated runs). + +- New constants: GEV2NB=389385 + ALPHEM(1)=1./137(.03599) for Q^2=0. + ALPHEM(2)=1./128 for Q^2~M_W^2 + are introduced in various cross section formulae, and G_Fermi is + eliminated. + +- The default top quark mass was increased to 150 GeV. + + In version 5.8 + + * A hard matrix element correction has been introduced in DIS (IPROC = + 90**). This is switched on and off by the logical variable HARDME + (default = .TRUE.). The method is essentially identical to the e+e- + correction, generating first order matrix-element events in a + phase-space region complementary to that of the parton shower. The + e+e- correction is also now controlled by HARDME for consistency. + + * Soft matrix element corrections have been introduced in DIS and e+e- + processes. These correct the distribution of emissions within the + parton shower phase-space. It is similar to the method used in + JETSET, except that the HARDEST emission is matched to the leading + order matrix element, not the first as in JETSET. This ensures that + the correction enters into the form factor, and not just the real + emission probability. + + * In the backward evolution of initial-state radiation for photons the + anomalous branching q-qbar <-- gamma has been introduced. + + * The treatment of forced branching of gluons and sea (anti-)quarks in + backward evolution has been improved, by allowing it to occur at a + random scale between the space-like cutoff QSPAC and the infrared + cutoff, instead of exactly at QSPAC as before. + A new option ISPAC=2 allows the freezing of structure functions at + the scale QSPAC, while evolution continues to the infrared cutoff. + The default, ISPAC=0 is equivalent to previous versions, in which + perturbative evolution stops at QSPAC. + + * It is now possible to completely switch off initial-state radiation, + by setting NOSPAC =.TRUE. Only the forced splitting of non-valence + partons is generated. The default is (of course) NOSPAC =.FALSE. + + * An option to damp the parton distributions of off mass-shell photons + relative on-shell photons, according to the scheme defined in Drees + and Godbole MAD/PH/819 has been introduced. The adjustable parameter + PHOMAS defines the crossover from the non-suppressed to suppressed + regimes. Recommended values lie in the range QCDLAM to 1 GeV. The + default value PHOMAS=0. corresponds to no suppression as in previous + versions. + + * The interface to PDFLIB version 4 has been slightly changed. Instead + of indicating a PDF set by a unique number, an `author group' string + and set number are required. PDFLIB version 3 can still be used from + HERWIG, simply by setting the author group to 'MODE'. It is also now + possible to independently set the PDF set for each of the two beams. + For example, if you previously used MRS D- for the proton and Gordon + -Storrow set 1 for the photon, by setting + MODPDF=47 + MODPHO=231 + You should now set + AUTPDF(2)='MRS' + MODPDF(2)=28 + AUTPDF(1)='GS' + MODPDF(1)=2 + Alternatively, if you are still using PDFLIB version 3, you can set + AUTPDF(2)='MODE' + MODPDF(2)=47 + AUTPDF(1)='MODE' + MODPDF(1)=231 + + * In the CLDIR=1 option for cluster decays a new parameter CLSMR + (default = 0.) allows a Gaussian smearing of the direction of the + perturbative quark's momentum. The smearing is actually exponential + in 1-cos(theta) with mean CLSMR. Thus increasing CLSMR decorrelates + the cluster decay from the initial quark direction. + + * New subprocess have been added: + + - The direct, higher twist, production of light (u,d,s) L=0 mesons + by point-like photons is now available: IPROC = 5500 all Spin =0,1 + mesons, = 5510 only S=0 mesons; = 5520 only S=1 mesons. The vector + mesons are produced with transverse or longitudinal polarisation + + and decayed accordingly. + + - High transverse momentum, scalar Higgs production, in association + with a jet, is now available as IPROC =2300. Only the top quark is + included in the loops with IAPHIG controlling the approx. used: =0 + zero top mass limit; = 1 exact result; = 2 infinite top mass limit + (default 1). Note the routines: HWHGJ1, HWHGJA, HWHGJB/C/D, HWUCI2 + and HWULI2 use (non-standard FORTRAN-77) DOUBLE COMPLEX variables + which may not be accepted by some compilers. Users can change to + COMPLEX variables, however this involves a risk of rounding errors + spoiling numerical cancellations. + + - DIS with neutrino beams is now available in processes IPROC= 90**. + + * The DIS O(alpha_s) jet production processes, IPROC = 92**, have been + withdrawn and are no longer supported. + + * A running electromagnetic coupling has been introduced, HWUAEM(Q2). + ALPHEM (now a single variable) sets the Thomson limit (Q2=0) value, + default = 0.0072993 (1/137.0). + + * Two new particles have been created: 'REMG', IDHW=71, IDHEP=9998 and + 'REMN', IDHW=72, IDHEP=9999 are remnant photons and nucleons + respectively. They are identical to photons & nucleons, except that + gluons are labelled as valence partons and, for the nucleon, valence + quark distributions are set to zero. They are used internally by the + JIMMY generator for multiple interactions, and are not intended for + general use. + + * An error in setting the scale EMCMF (now called EMSCA) for QCD + decays of colour neutral particles, preventing parton showers, has + been corrected. + + * Minor bugs have been corrected in: phi decays to neutral kaons; the + weights for photo-production processes; the value of EVWGT in di-jet + production by point-like photons. + + * The transverse momentum cutoff for final-state photon emission from + quarks, VPCUT, now defaults to 0.4 GeV. Previous versions defaulted + to SQRT(S), switching off such emission. + + * The default top quark mass has been increased to 170 GeV/c^2 + + +------------------------------------------------------------------------ + + ****** 3. FEATURES NOT YET INCLUDED ****** + + Note that the following features are NOT yet included in the program: + polarization of produced heavy quarks and leptons; treatment of + coherence in the small-x region of incoming jets (see S. Catani, + F. Fiorani and G. Marchesini, Nucl.Phys. B336(1990)18); multiple + parton interactions and parton shadowing; diffractive processes; + W/Z bosons within parton showers. + +------------------------------------------------------------------------ + + ****** 4. PROGRAM STRUCTURE ****** + + The main program HWIGPR has the following form: + + PROGRAM HWIGPR +C---COMMON BLOCKS ARE INCLUDED AS FILE HERWIG59.INC + INCLUDE 'HERWIG59.INC' + INTEGER N +C---MAX NUMBER OF EVENTS THIS RUN + MAXEV=100 +C---BEAM PARTICLES + PART1='PBAR' + PART2='P' +C---BEAM MOMENTA + PBEAM1=900. + PBEAM2=900. +C---PROCESS + IPROC=1500 +C---INITIALISE OTHER COMMON BLOCKS + CALL HWIGIN +C---USER CAN RESET PARAMETERS AT +C THIS POINT, OTHERWISE DEFAULT +C VALUES IN HWIGIN WILL BE USED. + PTMIN=100. +C---COMPUTE PARAMETER-DEPENDENT CONSTANTS + CALL HWUINC +C---CALL HWUSTA TO MAKE ANY PARTICLE STABLE + CALL HWUSTA('PI0 ') +C---USER'S INITIAL CALCULATIONS + CALL HWABEG +C---INITIALISE ELEMENTARY PROCESS + CALL HWEINI +C---LOOP OVER EVENTS + DO 100 N=1,MAXEV +C---INITIALISE EVENT + CALL HWUINE +C---GENERATE HARD SUBPROCESS + CALL HWEPRO +C---GENERATE PARTON CASCADES + CALL HWBGEN +C---DO HEAVY QUARK DECAYS + CALL HWDHQK +C---DO CLUSTER FORMATION + CALL HWCFOR +C---DO CLUSTER DECAYS + CALL HWCDEC +C---DO UNSTABLE PARTICLE DECAYS + CALL HWDHAD +C---DO HEAVY FLAVOUR HADRON DECAYS + CALL HWDHVY +C---ADD SOFT UNDERLYING EVENT IF NEEDED + CALL HWMEVT +C---FINISH EVENT + CALL HWUFNE +C---USER'S EVENT ANALYSIS + CALL HWANAL + 100 CONTINUE +C---TERMINATE ELEMENTARY PROCESS + CALL HWEFIN +C---USER'S TERMINAL CALCULATIONS + CALL HWAEND + STOP + END + + Various phases of the simulation can be suppressed by deleting the + corresponding subroutine calls, or different subroutines may be + substituted. For example, in studies at the parton level everything + from CALL HWDHQK to CALL HWMEVT can be omitted. + + The following is a full list of subroutines and functions, which are + classified according to their initial letters, except when standard- + ization agreements take precedence. + + +--------+---------------------------------------------+ + | Name | Description | + +--------+---------------------------------------------+ + | Main program and initialization | + +--------+---------------------------------------------+ + | HWIGPR | Main program | + | HWIGIN | Default initializations | + +--------+---------------------------------------------+ + | Reading/writing/altering decay modes | + +--------+---------------------------------------------+ + | HWIODK | Inputs/outputs formatted decay tables | + | HWMODK | Modifies or adds an individual decay mode | + +--------+---------------------------------------------+ + | User-provided analysis routines | + +--------+---------------------------------------------+ + | HWABEG | Initializes user's analysis | + | HWAEND | Terminates user's analysis | + | HWANAL | Performs user's analysis on event | + +--------+---------------------------------------------+ + | Parton branching with interfering gluons | + +--------+---------------------------------------------+ + | HWBAZF | Computes azimuthal correlation functions | + | HWBCON | Makes colour connections between jets | + | HWBDED | Correction to the `dead zone' in e+e- | + | HWBDIS | Correction to the `dead zone' in DIS | + | HWBFIN | Transfers external lines of jet to /HEPEVT/ | + | HWBGEN | Finds unevolved partons and generates jets | + | HWBJCO | Combines jets with correct kinematics | + | HWBMAS | Computes masses and trans. momenta in jet | + | HWBRAN | Generates a timelike parton branching | + | HWBSPA | Computes momenta in spacelike jet | + | HWBSPN | Computes spin density/decay matrices | + | HWBSU1 | First term in quark Sudakov form factor | + | HWBSU2 | Second term in quark Sudakov form factor | + | HWBSUD | Computes (or reads) Sudakov form factors | + | HWBSUG | Integrand in gluon Sudakov form factor | + | HWBSUL | Logarithmic part of Sudakov form factor | + | HWBTIM | Computes momenta in timelike jet | + | HWBVMC | Virtual mass cutoff for parton type ID | + +--------+---------------------------------------------+ + | Cluster hadronization model | + +--------+---------------------------------------------+ + | HWCCUT | Cuts a massive cluster in two | + | HWCDEC | Decays clusters into primary hadrons | + | HWCFLA | Sets up flavours for HWCHAD | + | HWCFOR | Forms clusters | + | HWCGSP | Splits gluons | + | HWCHAD | Decays a cluster into one or two hadrons | + +--------+---------------------------------------------+ + | Particle and heavy quark decays | + +--------+---------------------------------------------+ + | HWDBOS | Finds and decays W and Z bosons | + | HWDBOZ | Chooses decay mode of W and Z bosons | + | HWDCLE | Interface to CLEO package for B decays | + | HWDCHK | Checks given decay mode is self-consistent | + | HWDFOR | Generates a four-body decay | + | HWDFIV | Generates a five-body decay | + | HWDEUR | Interface to EURODEC package for B decays | + | HWDHAD | Generates decays of unstable hadrons | + | HWDHGC | Higgs -> gamma gamma decay | + | HWDHGF | Higgs -> W+ W- decay | + | HWDHIG | Finds and decays Higgs bosons | + | HWDHQK | Finds and decays heavy quarks | + | HWDHVY | Finds and decays heavy flavour hadrons | + | HWDIDP | Chooses a parton for HWDHVY | + | HWDPWT | Phase space decay weight | + | HWDTHR | Generates a three-body decay | + | HWDTOP | Decides whether to decay top quark | + | HWDTWO | Generates a two-body decay | + | HWDWWT | Weak (V-A) decay weight | + | HWDXLM | Tests if decay vertex lies in given volume | + +--------+---------------------------------------------+ + | Elementary subprocess generation | + +--------+---------------------------------------------+ + | HWEFIN | Final calculations on elementary subprocess | + | HWEGAM | Generates Weizsacker-Williams photon | + | HWEINI | Initializes elementary subprocess | + | HWEISR | Generates a photon fron initial e or mu | + | HWEONE | Sets up a 2->1 hard subprocess | + | HWEPRO | Generates elementary subprocess | + | HWETWO | Sets up a 2->2 hard subprocess | + +--------+---------------------------------------------+ + | Individual hard subprocesses | + +--------+---------------------------------------------+ + | HWHBGF | Hard subprocess: boson-gluon fusion (BGF) | + | HWHBKI | Computes kinematics for BGF | + | HWHBRN | Returns a phase-space point for BGF | + | HWHBSG | Computes cross section for BGF | + | HWHDIS | Hard subprocess: deep inelastic lepton quark| + | HWHDYP | Hard subprocess: Drell-Yan Z0/photon prodn | + | HWHEGG | Hard subprocess: two-photon processes in ee | + | HWHEGW | Hard subprocess: photon-W processes in e+e- | + | HWHEGX | Calculates cross section for HWHEGW | + | HWHEPA | Hard subprocess: e+e- -> f fbar | + | HWHEPG | Hard subprocess: e+e- -> q qbar gluon | + | HWHEW0 | e+e- -> W W / Z Z subroutine | + | HWHEW1 | e+e- -> W W / Z Z subroutine | + | HWHEW2 | e+e- -> W W / Z Z subroutine | + | HWHEW3 | e+e- -> W W subroutine | + | HWHEW4 | e+e- -> W W / Z Z subroutine | + | HWHEW5 | e+e- -> Z Z subroutine | + | HWHEWW | Hard subprocess: e+e- -> W W / Z Z | + | HWHHVY | Hard subprocess: heavy quark production | + | HWHIG1 | Matrix elements for Higgs + jet production | + | HWHIGA | Amplitudes squared for Higgs + jet | + | HWHIGB | Loop integrals for Higgs + jet | + | HWHIGJ | QCD Higgs + jet production | + | HWHIGM | Choose Higgs mass for production routines | + | HWHIGS | Hard subprocess: gg/qqbar -> Higgs | + | HWHIGT | Computes gg -> Higgs cross section | + | HWHIGW | Hard subprocess: WW / ZZ -> Higgs | + | HWHIGY | Computes ee -> Z -> ZH cross section | + | HWHIGZ | Hard subprocess: ee -> Z -> ZH | + | HWHPH2 | Hard subprocess: direct photon pairs | + | HWHPHO | Hard subprocess: direct photon production | + | HWHPPB | Box contribution to gg->photon photon | + | HWHPPE | Pointlike photon-parton (fixed flavour) | + | HWHPPH | Pointlike photon-parton (fixed pair flavour)| + | HWHPPM | Pointlike photon-parton direct light meson | + | HWHPPT | Pointlike photon-parton (all flavours) | + | HWHQPS | Pointlike photon-quark (Compton) scattering | + | HWHQCD | Hard subprocess: QCD 2->2 | + | HWHQCP | Identifies QCD 2->2 hard subprocess | + | HWHREM | Treats hard scattering remnants | + | HWHSCT | Process extra hard scatterings | + | HWHSNG | Colour singlet parton scattering | + | HWHSNM | Colour singlet parton scattering ME | + | HWHV1J | Hard subprocess W/Z + jet production | + | HWHWEX | Top production by W exchange | + | HWHWPR | Hard subprocess: W production | + +--------+---------------------------------------------+ + | Soft minimum-bias or underlying event | + +--------+---------------------------------------------+ + | HWMEVT | Generates min bias or soft underlying event | + | HWMLPS | Generates longitudinal phase space | + | HWMNBI | Computes negative binomial probability | + | HWMULT | Chooses min bias charged multiplicity | + | HWMWGT | Calculates weight for minimum bias events | + +--------+---------------------------------------------+ + | Random number generators | + +--------+---------------------------------------------+ + | HWRAZM | Randomly rotated azimuth | + | HWREXP | Random number: exponential distribution | + | HWREXQ | Random number: exp. dist. with cutoff | + | HWREXT | Random number: exponential transverse mass | + | HWRGAU | Random number: Gaussian | + | HWRGEN | Random number generator (l'Ecuyer method) | + | HWRINT | Random integer | + | HWRLOG | Random logical | + | HWRPIP | Random primary interaction point | + | HWRPOW | Random number: power distribution | + | HWRUNG | Random number: uniform + Gaussian tails | + | HWRUNI | Random number: uniform | + +--------+---------------------------------------------+ + | Spacelike branching of incoming partons | + +--------+---------------------------------------------+ + | HWSBRN | Generates spacelike parton branching | + | HWSDGG | Drees-Grassie photon str. function (gluon) | + | HWSDGQ | Drees-Grassie photon str. function (quarks) | + | HWSFBR | Chooses a spacelike branching | + | HWSFUN | Hadron structure functions | + | HWSGAM | Gamma function (for structure functions) | + | HWSGEN | Generates x values for spacelike partons | + | HWSGQQ | Inserts g->q qbar part of gluon form factor | + | HWSSPC | Replaces spacelike partons by spectators | + | HWSSUD | Sudakov form factor/structure function | + | HWSTAB | Interpolates in function table (for HWSSUD) | + | HWSVAL | Checks for valence parton | + +--------+---------------------------------------------+ + | Miscellaneous utilities | + +--------+---------------------------------------------+ + | HWUAEM | Running electromagnetic coupling constant | + | HWUAER | Real part of photon self-energy | + | HWUALF | Two-loop QCD running coupling constant | + | HWUANT | Finds a particle's antiparticle | + | HWUBPR | Prints branching data for last parton shower| + | HWUBST | Boost event record to/from hadron-hadron cmf| + | HWUCFF | Coefficients for e+e- and DIS cross sections| + | HWUCI2 | Logarithmic integral Ci_2 | + | HWUDAT | Block data: particle properties | + | HWUDKL | Generates decay vertex of unstable particle | + | HWUDKS | Converts decay modes into internal format | + | HWUDPR | Prints particle properties and decay modes | + | HWUECM | Centre-of-mass energy | + | HWUEDT | Insert or delete entries in the event record| + | HWUEEC | Computes coefficients for e+e- cross section| + | HWUEPR | Prints event data | + | HWUEMV | Moves entries within the event record | + | HWUFNE | Finishes an event | + | HWUGAU | Adaptive Gaussian integration | + | HWUIDT | Translates particle identity codes | + | HWUINC | Initial parameter-dependent calculations | + | HWUINE | Initializes an event | + | HWULB4 | Boost: rest frame -> lab, no masses assumed | + | HWULDO | Lorentz 4-vector dot product | + | HWULF4 | Boost: lab frame -> rest, no masses assumed | + | HWULI2 | Logarithmic integral Li_2 (Spence function) | + | HWULOB | Lorentz transformation: rest frame -> lab | + | HWULOF | Lorentz transformation: lab -> rest frame | + | HWULOR | Multiplies by Lorentz matrix | + | HWUMAS | Puts mass in 5th component of vector | + | HWUPCM | Centre-of-mass momentum | + | HWURAP | Rapidity | + | HWURES | Computes/prints resonance data | + | HWUROB | Rotation by inverse of matrix R | + | HWUROF | Rotation by matrix R | + | HWUROT | Computes rotation R from vector to z-axis | + | HWUSOR | Sorts an array in ascending order | + | HWUSQR | Square root with sign retention | + | HWUSTA | Makes a particle type stable | + | HWUTAB | Interpolates in a table | + | HWUTIM | Checks time remaining (N.B. VAX Fortran) | + +--------+---------------------------------------------+ + | Vector manipulation | + +--------+---------------------------------------------+ + | HWVDIF | Vector difference | + | HWVDOT | Vector dot product | + | HWVEQU | Vector equality | + | HWVSCA | Vector times scalar | + | HWVSUM | Vector sum | + | HWVZRO | Vector zero | + +--------+---------------------------------------------+ + | Warning messages and error handling | + +--------+---------------------------------------------+ + | HWWARN | Issues warnings and deals with errors | + +--------+---------------------------------------------+ + + N.B. Dummy versions of the external routines + + PDFSET STRUCTM + EUDINI FRAGMT IEUPDG IPDGEU + DECADD QQINIT QQLMAT + HVCBVI HVHBVI + + should be deleted if the structure function library, EURODEC B decay + package, CLEO B decay package, or HERBVI (respectively) is linked. +------------------------------------------------------------------------ + + ****** 5. BEAMS AND PROCESSES ****** + + As indicated above, a number of variables must be set in the main + program to specify what is to be simulated: + + + +----------+----------------------------------+-----------+ + | Name | Description | Default | + +----------+----------------------------------+-----------+ + | PART1 | Type of particle in beam 1 | 'PBAR '| + | PART2 | Type of particle in beam 2 | 'P '| + | PBEAM1 | Momentum of beam 1 | 900. | + | PBEAM2 | Momentum of beam 2 | 900. | + | IPROC | Type of process to generate | 1500 | + | MAXEV | Number of events to generate | 100 | + +----------+----------------------------------+-----------+ + + + The beam particle types PART1,PART2 supported at present are: + + + +---------------------------------------------+ + | 'E+ ','E- ','MU+ ','MU- ' | + | 'NUE ','NUEB ','NUMU ','NMUB ' | + | 'NTAU ','NTAB ','GAMA ' | + | 'P ','PBAR ','N ','NBAR ' | + | 'PI+ ','PI- ' | + +---------------------------------------------+ + + In addition, beams 'K+ ' and 'K- ' are supported for + minimum bias non-diffractive soft hadronic events (IPROC=8000) only. + + The currently available processes IPROC are tabulated below. + + +---------+--------------------------------------------------------+ + | IPROC | Process | + +---------+--------------------------------------------------------+ + | 100 | e+ e- -> q qbar (gluon) (all flavours) | + | 100+IQ | e+ e- -> q qbar (gluon) (IQ=1--6 for q=d,u,s,c,b,t) | + | 107 | e+ e- -> gluon gluon (gluon) fictitious process | + | 110 | e+ e- -> q qbar gluon (all flavours) | + | 110+IQ | e+ e- -> q qbar gluon (IQ as above) | + | 120 | e+ e- -> q qbar (all flavours)| without correction to | + | 120+IQ | e+ e- -> q qbar (IQ as above) | hard gluon branching | + | 127 | e+ e- -> gluon gluon | | + | 150+IL | e+ e- -> l lbar (IL=2,3 for l=mu,tau) | + +---------+--------------------------------------------------------+ + | 200 | e+ e- -> W+ W- (see sect. 18 on control of W/Z decays)| + | 250 | e+ e- -> Z0 Z0 (see sect. 18 on control of W/Z decays)| + +---------+--------------------------------------------------------+ + | 300 | e+ e- -> Z H -> Z q qbar (all flavours) | + | 300+IQ | e+ e- -> Z H -> Z q qbar (IQ as above) | + | 306+IL | e+ e- -> Z H -> Z l lbar (IL=1,2,3 for l=e,mu,tau) | + | 310,11 | e+ e- -> Z H -> Z W W, Z Z Z | + | 312 | e+ e- -> Z H -> Z gamma gamma | + | 399 | e+ e- -> Z H -> Z anything | + +---------+--------------------------------------------------------+ + | 400+ID | e+ e- -> nu nu H + e e H (ID as in IPROC=300+ID) | + +---------+--------------------------------------------------------+ + | 500+ID | e+ e- -> gamma gamma -> qqbar/llbar/WW (ID=0-10 as in | + | | IPROC=300+ID) | + | 550+ID | e+ e- -> gamma W -> qq'bar/ll'bar (ID=0-9) | + +---------+--------------------------------------------------------+ + | 1300 | q qbar -> Z0/gamma -> q qbar (all flavours) | + | 1300+IQ | q qbar -> Z0/gamma -> q qbar (IQ as above) | + | 1350 | q qbar -> Z0/gamma -> l lbar (all lepton species) | + | 1350+IL | q qbar -> Z0/gamma -> l lbar (IL=1-6 for e,enu,mu,etc) | + | 1399 | q qbar -> Z0/gamma -> anything | + +---------+--------------------------------------------------------+ + | 1400 | q qbar -> W+/- -> q' qbar'' (all flavours) | + | 1400+IQ | q qbar -> W+/- -> q' qbar'' (q' or q'' as above) | + | 1450 | q qbar -> W+/- -> l nul (all lepton species) | + | 1450+IL | q qbar -> W+/- -> l nul (IL=1-3 as above) | + | 1499 | q qbar -> W+/- -> anything | + +---------+--------------------------------------------------------+ + | 1500 | QCD 2 -> 2 hard parton scattering | + | | After generation, IHPRO is subprocess (see list) | + +---------+--------------------------------------------------------+ + | 1600+ID | q qbar/g g -> Higgs (ID as in IPROC=300+ID) | + +---------+--------------------------------------------------------+ + | 1700+IQ | QCD heavy quark production (IQ as above) | + | | After generation, IHPRO is subprocess (see list) | + +---------+--------------------------------------------------------+ + | 1800 | QCD direct photon + jet production | + | | After generation, IHPRO is subprocess (see list) | + +---------+--------------------------------------------------------+ + | 1900+ID | q qbar -> q' qbar' H (ID as in IPROC=300+ID) | + +---------+--------------------------------------------------------+ + | 2000 | t production via W exchange (sum of 2001-2008) | + | 2001,2 | ubar bbar -> dbar tbar, d bbar -> u tbar | + | 2003,4 | dbar bbar -> ubar tbar, u b -> d t | + | 2005,6 | cbar bbar -> sbar tbar, s bbar -> c tbar | + | 2007,8 | sbar b -> cbar t , c b -> s t | + +---------+--------------------------------------------------------+ + | 2100 | Vector boson + jet production. | + | 2110,20 | Compton only (g q -> V q), annih. only (q qbar -> V g) | + +---------+--------------------------------------------------------+ + | 2200 | QCD direct photon pair production (see list for IHPRO) | + +---------+--------------------------------------------------------+ + | 2300 | QCD Higgs plus jet production (see list for IHPRO) | + +---------+--------------------------------------------------------+ + | 2400 | Mueller-Tang colour singlet exchange | + | 2450 | Quark scattering via photon exchange | + +---------+--------------------------------------------------------+ + | 5000 | Pointlike photon-hadron jet production (all flavours) | + | 5100+IQ | Pointlike photon heavy flavour IQ pair production | + | 5200+IQ | Pointlike photon heavy flavour IQ single excitation | + | | After generation, IHPRO is subprocess (see list) | + | 5300 | Quark photon Compton scattering | + | 5500 | Pointlike photon production of light (u,d,s) L=0 mesons| + | 5510,20 | S=0 mesons only, S=1 mesons only (see list for IHPRO) | + +---------+--------------------------------------------------------+ + | 7000 - | Baryon-number violating and other multi-W processes | + | 7999 | generated by HERBVI package | + +---------+--------------------------------------------------------+ + | 8000 | Minimum bias non-diffractive soft hadron-hadron event | + +---------+--------------------------------------------------------+ + | 9000 | Deep inelastic lepton scattering (all neutral current) | + | 9000+IQ | Deep inelastic lepton scattering (NC on flavour IQ) | + | 9010 | Deep inelastic lepton scattering (all charged current) | + | 9010+IQ | Deep inelastic lepton scattering (CC on flavour IQ) | + +---------+--------------------------------------------------------+ + | 9100 | Boson-gluon fusion in NC DIS, all flavours | + | 9100+IQ | Boson-gluon fusion in NC DIS, IQ=1-6 as above | + | 9107 | J/Psi + gluon production by boson-gluon fusion | + | 9110 | QCD Compton process in NC DIS, all flavours | + | 9110+IP | QCD Compton process in NC DIS, IP=1-12, d-t, dbar-tbar | + | 9130 | All O(alpha-s) NC processes: 9100+9110 | + | 9140+IP | CC proc, IP:1 = s cbar,2 = b cbar,3 = s tbar,4 = b tbar| + +---------+--------------------------------------------------------+ + | 92** | Withdrawn: use 91** instead | + +---------+--------------------------------------------------------+ + | 9500+ID | W W fusion -> Higgs in e p (ID as in IPROC=300+ID) | + +---------+--------------------------------------------------------+ + |10000+IP | as IPROC=IP but with soft underlying event (hadron | + | | remnant fragmentation in lepton-hadron) suppressed | + +---------+--------------------------------------------------------+ + + The extent to which quark mass effects are included in the hard + process cross section is different in different processes. In many + processes, they are always treated as massless: IPROC=1300, 1800, + 1900, 2100, 2300, 2400, 5300, 9000. In two processes they are all + treated as massless except the top quark, for which the mass is + correctly incorporated: 1400, 2000. In the case of massless pair + production, only quark flavours that are kinematically allowed are + produced. In all cases the event kinematics incorporate the quark + mass, even when it is not used to calculate the cross section. + + In two processes, quarks are always treated as massive: 500, 9100. + + Finally, in several processes, the behaviour is different depending + on whether a specific quark flavour is requested, in which case its + mass is included, or not, in which case all quarks are treated as + massless. These are: IPROC=100, 110, 120, QCD 2->2 scattering + (1500 vs 1700+IQ), jets in direct photoproduction (5000 vs 5100+IQ + and 5200+IQ). + + These differences can cause inconsistencies between different ways + of generating the same process. The most noticeable example is in + direct photoproduction, where one can use process 9130, which uses + the exact 2->3 matrix element e+g --> e+q+qbar, or process 5000, + which uses the Weizsacker-Williams spectrum for e --> e+gamma and + the 2->2 matrix element for gamma+g --> q+qbar. For typical HERA + kinematics, the W-W approximation is valid to a few per cent, but + the difference between the two processes is much larger, about 20% + for PTMIN=2 GeV. This is entirely due to the difference in quark + mass treatments, as can be checked by comparing process 9130 with + processes 5100+IQ and 5200+IQ summed over IQ +------------------------------------------------------------------------ + + ****** 6. INPUT PARAMETERS ****** + + The quantities that may be regarded as adjustable parameters are + + +----------+----------------------------------+-------+ + | Name | Description |Default| + +----------+----------------------------------+-------+ + | QCDLAM | QCD Lambda (see below) | 0.18 | + +----------+----------------------------------+-------+ + | RMASS(1) | Down quark mass | 0.32 | + | RMASS(2) | Up quark mass | 0.32 | + | RMASS(3) | Strange quark mass | 0.50 | + | RMASS(4) | Charmed quark mass | 1.55 | + | RMASS(5) | Bottom quark mass | 4.95 | + | RMASS(6) | Top quark mass | 170. | + +----------+----------------------------------+-------+ + | RMASS(13)| Gluon effective mass | 0.75 | + +----------+----------------------------------+-------+ + | VQCUT | Quark virtuality cutoff (added to| 0.48 | + | | quark masses in parton showers) | | + | VGCUT | Gluon virtuality cutoff (added to| 0.10 | + | | effective mass in parton showers)| | + | VPCUT | Photon virtuality cutoff | 0.40 | + +----------+----------------------------------+-------+ + | CLMAX | Maximum cluster mass parameter | 3.35 | + | CLPOW | Power in maximum cluster mass | 2.00 | + | PSPLT | Split cluster spectrum parameter | 1.00 | + +----------+----------------------------------+-------+ + | QDIQK | Maximum scale for gluon->diquarks| 0.00 | + | PDIQK | Gluon->diquarks rate parameter | 5.00 | + +----------+----------------------------------+-------+ + | QSPAC | Cutoff for spacelike evolution | 2.50 | + | PTRMS | Intrinsic pt in incoming hadrons | 0.00 | + +----------+----------------------------------+-------+ + + Notes on parameters: + + * QCDLAM can be identified at high momentum fractions (x or z) with + the fundamental QCD scale Lambda-MSbar (5 flavours). However, this + relation does not necessarily hold in other regions of phase space, + since higher order corrections are not treated precisely enough to + remove renormalization scheme ambiguities. See S. Catani, G. March- + esini and B.R.Webber, Nucl. Phys. B349 (1991) 635. + + * RMASS(1,2,3,13) are effective light quark and gluon masses used in + the hadronization phase of the program. They can be set to zero + provided the parton shower cutoffs VQCUT and VGCUT are large enough + to prevent divergences (see below). + + * For cluster hadronization, it must be possible to split gluons into + q-qbar, i.e. RMASS(13) must be at least twice the lightest quark + mass. Similarly it may be impossible for heavy flavoured clusters + to decay if RMASS(4,5) are too low. + + * VQCUT and VGCUT are needed if the quark and gluon effective masses + become small. The condition to avoid divergences in parton showers + is + 1/Q(i) + 1/Q(j) < 1/QCDL3 for either i or j or both gluons, + where Q(i)=RMASS(i)+VQCUT for quarks, RMASS(13)+VGCUT for gluons, + and QCDL3 is the equivalent 3-flavour Lambda computed from QCDLAM. + In the notation of the above reference by S. Catani et al., QCDL3 + is the 3-flavour equivalent of QCDL5 where + QCDL5 = QCDLAM*exp(K/(4*pi*beta))/sqrt(2)=1.109*QCDLAM + + * VPCUT is the analogous quantity for photon emission. It defaults to + SQRT(S) corresponding to no emission. Results after experimental + cuts are insensitive to its exact value in the range 0.1 to 1.0 GeV + + * CLMAX and CLPOW determine the maximum allowed mass of a cluster + made from quarks i and j as follows + Mass**CLPOW < CLMAX**CLPOW + (RMASS(i)+RMASS(j))**CLPOW + Since the cluster mass spectrum falls rapidly at high mass, results + become insensitive to CLMAX and CLPOW at large values of CLMAX. + Smaller values OF CLPOW will increase the yield of heavier clusters + (and hence of baryons) for heavy quarks, without affecting light + quarks much. For example, the default value gives no b-baryons + whereas CLPOW=1.0 makes b-baryons/b-hadrons about 1/4. + + * PSPLT determines the mass distribution in the cluster splitting + CL1 -> CL2 + CL3 when CL1 is above the maximum allowed mass. The + masses of CL2 and CL3 are generated uniformly in Mass**PSPLT. Since + the number of split clusters is small, dependence on PSPLT is weak. + + * QDIQK greater than twice the lightest diquark mass enables gluons + to split non-perturbatively into diquarks as well as quarks. The + probability of this is PDIQK*dQ/Q for scales Q below QDIQK. The + diquark masses are taken to be the sum of constituent quark masses. + Thus the default value QDIQK=0 suppresses gluon->diquark splitting. + + * QSPAC is the scale below which the structure functions of incoming + hadrons are frozen and non-valence constituent partons are forced + to evolve to valence partons, if ISPAC=0. For ISPAC=2, structure + functions are frozen at scale QSPAC, but evolution continues down + to the infrared cutoff. + + * PTRMS is the width of the (Gaussian) intrinsic transverse momentum + distribution of valence partons in incoming hadrons at scale QSPAC. + (N.B. Neither QSPAC nor PTRMS affect lepton-lepton collisions.) + + In practice, the parameters that have been found most effective in + fitting data are QCDLAM, the gluon effective mass RMASS(13), and the + cluster mass parameter CLMAX. + + The default parameter values have been found to give good agreement + with event shape distributions at LEP (OPAL preprint CERN-EP/90-48). + + A number of further parameters are needed to control the program and + to turn various options on or off: + + +----------+----------------------------------+-------+ + | Name | Description |Default| + +----------+----------------------------------+-------+ + | IPRINT | Printout option | 1 | + | MAXPR | Number of events to print out | 1 | + | PRVTX | Include vertex info in print out | .TRUE.| + | MAXER | Max number of errors | 10 | + | LWEVT | Unit for writing output events | 0 | + | LRSUD | Unit for reading Sudakov table | 0 | + | LWSUD | Unit for writing Sudakov table | 77 | + | SUDORD | Alpha_s order in Sudakov table | 1 | + +----------+----------------------------------+-------+ + | NRN(1) | Random number seed 1 | 17673 | + | NRN(2) | Random number seed 2 | 63565 | + | WGTMAX | Max weight (0 to search for it) | 0. | + | NOWGT | Generate unweighted events | .TRUE.| + +----------+----------------------------------+-------+ + | AZSOFT | Soft gluon azimuthal correlations| .TRUE.| + | AZSPIN | Gluon spin azimuthal correlations| .TRUE.| + +----------+----------------------------------+-------+ + | NCOLO | Number of colours | 3 | + | NFLAV | Number of (producible) flavours | 6 | + +----------+----------------------------------+-------+ + | MODPDF(I)| PDFLIB structure function set and| -1 | + | AUTPDF(I)| author group for beam I(=1,2) | 'MRS' | + | | (if MODPDF()<0 do not use PDFLIB)| | + | NSTRU | Input structure function set | 5 | + | | (1,2=Duke-Owens1,2 3,4=EHLQ1,2 | | + | | 5=Owens1.1) | | + +----------+----------------------------------+-------+ + | ETAMIX | eta/eta' mixing angle in degrees | -20 | + | | F0Mix.. + +----------+----------------------------------+-------+ + | B1LIM | B cluster -> 1 hadron parameter | 0.0 | + +----------+----------------------------------+-------+ + | CLDIR | Decay of perturbative clusters, | 1 | + | | 0=>isotropic, 1=>along quark dirn| | + | CLSMR | Width of Gaussian angle smearing | 0.0 | + +----------+----------------------------------+-------+ + | CLRECO | Include colour rearrangement |.FALSE | + | PRECO | Probability for rearrangement | 1./9. | + | EXAG | Lifetime scaling for weak bosons | 1. | + +----------+----------------------------------+-------+ + | PIPSMR | Smear the primary vertex | .TRUE.| + | MAXDKL | Veto decays outside given volume |.FALSE.| + +----------+----------------------------------+-------+ + | HARDME | Use hard and soft matrix-element | .TRUE.| + | SOFTME | corrections to e+e- and DIS | .TRUE.| + +----------+----------------------------------+-------+ + | BDECAY | Controls which B Decay package is| 'HERW'| + | | used. The allowed values are: | | + | | 'HERW'; 'EURO'; or 'CLEO'. | | + | MIXING | Include neutral B meson mixing | .TRUE.| + | XMIX(2) | Mass difference I=1 B^0_s | 10.0 | + | | average width 2 B^0_d | 0.70 | + | YMIX(2) | Width difference I=1 B^0_s | 0.20 | + | | average width 2 B^0_d | 0.00 | + +----------+----------------------------------+-------+ + | EPOLN(3) | Electron and positron beam | 0.0 | + | | polarizations in DIS and e+e- | 0.0 | + | | annihilation. First two cmpts are| 0.0 | + | PPOLN(3) | transverse and only used in e+e-,| 0.0 | + | | 3rd cmpt is longitudinal, and is | 0.0 | + | | +/-1 for fully rh/lh polarized | 0.0 | + +----------+----------------------------------+-------+ + | BGSHAT | Scale=shat for boson-gluon fusion|.FALSE.| + +----------+----------------------------------+-------+ + | BREIT | Use Breit frame for DIS kinematix| .TRUE.| + +----------+----------------------------------+-------+ + | USECMF | Use hadron-hadron cmf | .TRUE.| + +----------+----------------------------------+-------+ + | NOSPAC | Switch off space-like showers |.FALSE.| + +----------+----------------------------------+-------+ + | ISPAC | Changes meaning of QSPAC, | 0 | + | | see the earlier notes on QSPAC | | + +----------+----------------------------------+-------+ + | TMNISR | Min vaule shat/S for photon ISR | 1D-4 | + | ZMXISR | Max mom fraction for photon ISR | 1-1D-6| + +----------+----------------------------------+-------+ + | PTMIN | Min pt in hadronic jet production| 10. | + | PTMAX | Max pt in hadronic jet production| 1.E8 | + | PTPOW | 1/pt**PTPOW for jet sampling | 4. | + | YJMIN | Min jet rapidity |-8. | + | YJMAX | Max jet rapidity | 8. | + +----------+----------------------------------+-------+ + | EMMIN | Min dilepton mass in Drell-Yan | 10. | + | EMMAX | Max dilepton mass in Drell-Yan | 1.E8 | + | EMPOW | 1/m**EMPOW for Drell-Yan sampling| 4. | + +----------+----------------------------------+-------+ + | Q2MIN | Min Q**2 in deep inelastic | 0.0 | + | Q2MAX | Max Q**2 in deep inelastic | 1.E10 | + | Q2POW | (1/Q**2)**Q2POW for sampling | 2.5 | + +----------+----------------------------------+-------+ + | Q2WWMN | Min Q**2 in Equiv Photon Approx | 0.0 | + | Q2WWMX | Max Q**2 in Equiv Photon Approx | 4.0 | + +----------+----------------------------------+-------+ + | YWWMIN | Min energy of gamma in WW approx | 1.0 | + | YWWMAX | Max energy of gamma in WW approx | 0.0 | + +----------+----------------------------------+-------+ + | PHOMAS | Damp structure functions for off-| 0.0 | + | | shell photons (0 for no damping) | | + +----------+----------------------------------+-------+ + | YBMIN | Min and Max Bjorken-y in DIS and | 0.0 | + | YBMAX | Equivalent Photon Approx | 1.0 | + +----------+----------------------------------+-------+ + | ZJMAX | Max Z in J/psi production | 0.9 | + +----------+----------------------------------+-------+ + | THMAX | Max thrust in 3 parton production| 0.9 | + | | (equal to 1-Y_cut in JADE scheme)| | + +----------+----------------------------------+-------+ + + Printout options are: + + IPRINT = 0 Print program title only + 1 Print selected input parameters + 2 1 + table of particle codes and properties + 3 2 + tables of Sudakov form factors + + PRVTX = .T. To include the production vertex information in + the event print out, requires wide screen format. + + See sect. 8 on form factors for details of LRSUD, LWSUD and SUDORD. + + If BGSHAT is false, the scale used for heavy quark production via + boson-gluon fusion in lepton-hadron collisions will be + 2*shat*that*uhat/(shat**2+that**2+uhat**2) + + If BREIT is true, the kinematic reconstruction of deep inelastic + events takes place in the Breit frame (ie. the frame where the + exchanged boson is purely space-like, and collinear with the + incoming hadron). In fact the reconstruction procedure is + invariant under longitudinal boosts, so any frame in which the + boson and hadron are collinear would be equivalent, and it is only + the transverse part of the boost that has an effect. + The BREIT frame option becomes very inaccurate for very small Q^2. + It is therefore only used if Q**2 > 1E-4 (the lab and Breit frames + are anyway equivalent for such small Q**2). + If BREIT is false, reconstruction takes place in the lab frame. + + If USECMF is true, the entire event record is boost to the hadron- + hadron cmf before event processing, and boosted back afterwards. + This means that fixed-target simulation can be done in the lab + frame, ie with PBEAM2=0. + For hadronic processes with lepton beams, this boosting is always + done, regardless of the value of USECMF. + + The interface to the PDFLIB structure function package is + compatible with PDFLIB versions 3 and 4. For version 4, AUTPDF() + should be set to the author group as listed in the PDFLIB manual, + eg 'MRS', and MODPDF() to the set number in the new convention. + For version 3, AUTPDF() should be set to 'MODE', and MODPDF() to + the set number in the old convention. + + The `hard' matrix-element correction adds e+e- and DIS events in + regions of phase-space that cannot be filled by the usual parton + shower. The `soft' matrix-element correction moves emissions + around within the shower phase-space, essentially by matching + the HARDEST emission (which is not necessarily the first) to the + first-order matrix-element. + + The quantities from PTMIN onwards control the region of phase + space in which events are generated and the importance sampling + inside those regions. See section 11 on event weights for further + details on these quantities and the use of WGTMAX and NOWGT. + + If hadronic processes with lepton beams are requested, the photon + emission vertex includes the full transverse-momentum-dependent + kinematics (the Equivalent Photon Approximation). The variables + Q2WWMN and Q2WWMX set the minimum and maximum virtualities + generated respectively. For normal simulation, Q2WWMN should be 0, + and Q2WWMX should be the largest Q**2 through which the lepton can + be scattered without being detected. The variables YBMIN and + YBMAX control the range of lightcone momentum fraction generated. + + In addition there are options to give different weights to the + various flavours of quarks and diquarks, and to resonances of + different spins. So far, these options have not been used. See + the comments in the initialization routine HWIGIN for details. + +------------------------------------------------------------------------ + + ****** 7. COMMON BLOCK FILE ****** + +C ****COMMON BLOCK FILE FOR HERWIG VERSION 5.9**** +C +C ALTERATIONS: See 5.8 for list of previous revisions +C Layout completely overhauled +C +C The following variables have been removed: +C FBTM,FTOP,FHVY,VECWT,TENWT,SWT,RESWT +C MADDR,MODES,MODEF,IDPRO +C The following COMMON BLOCK has been removed +C /HWUFHV/ - BDECAY moved to /HWPRCH/ +C The following COMMON BLOCKs have been added +C /HWBMCH/ -contains PART1, PART2 from /HWBEAM/ +C /HWPRCH/ -contains AUTPDF from /HWPARM/ & BDECAY +C /HWPROP/ -contains many variables from /HWUPDT/ +C /HWDIST/ -contains variables for mixing and vertices +C /HWQDKS/ -contains heavy flavour decay information +C The following variables have been changed to CHARACTER*8: +C PART1,PART2,RNAME +C The following parameters have been added: +C NMXCDK,NMXDKS,NMXMOD,NMXQDK,NMXRES +C The following variables have been added: +C CSPEED,F0MIX,F1MIX,F2MIX,H1MIX, +C PHIMIX,IOPREM,PRVTX see HWPRAM +C ANOMSC,ISLENT see HWBRCH +C GAMWT see HWEVNT +C ASFIXD,OMEGA0,TMNISR,WHMIN,YWWMAX, +C YWWMIN,ZMXISR,COLISR see HWHARD +C IFLAV,RLTIM,RSPIN,VTOCDK,VTORDK see HWPROP +C DKLTM,IDK,IDKPRD,LNEXT,LSTRT, +C NDKYS,NME,NMODES,NPRODS, +C DKPSET,RSTAB see HWUPDT +C REPWT,SNGWT see HWUWTS +C CLDKWT,CTHRPW,PRECO,NCLDK,CLRECO see HWUCLU +C EXAG,GEV2MM,HBAR,PLTCUT,VMIN2, +C VTXPIP,XMIX,XMRCT,YMIX,YMRCT, +C IOPDKL,MAXDKL,MIXING,PIPSMR see HWDIST +C VTXQDK,IMQDK,LOCQ,NQDK see HWQDKS +C +C + IMPLICIT NONE + DOUBLE PRECISION ZERO,ONE,TWO,THREE,FOUR,HALF + PARAMETER (ZERO =0.D0, ONE =1.D0, TWO =2.D0, + & THREE=3.D0, FOUR=4.D0, HALF=0.5D0) +C + DOUBLE PRECISION + & ACCUR,AFCH,ALPFAC,ALPHEM,ANOMSC,ASFIXD,AVWGT,B1LIM,BETAF,BRFRAC, + & BRHIG,BTCLM,CAFAC,CFFAC,CLDKWT,CLMAX,CLPOW,CLQ,CLSMR,CMMOM,COSS, + & COSTH,CSPEED,CTHRPW,CTMAX,DECPAR,DECWT,DISF,DKLTM,EBEAM1,EBEAM2, + & EMLST,EMMAX,EMMIN,EMPOW,EMSCA,ENHANC,ENSOF,EPOLN,ETAMIX,EVWGT, + & EXAG,F0MIX,F1MIX,F2MIX,GAMH,GAMMAX,GAMW,GAMWT,GAMZ,GAMZP,GCOEF, + & GEV2NB,GEV2MM,GPOLN,H1MIX,HBAR,HARDST,OMEGA0,PBEAM1,PBEAM2,PDIQK, + & PGSMX,PGSPL,PHEP,PHIMIX,PHIPAR,PHOMAS,PIFAC,PLTCUT,PPAR,PPOLN, + & PRECO,PRSOF,PSPLT,PTINT,PTMAX,PTMIN,PTPOW,PTRMS,PXRMS,PWT,Q2MAX, + & Q2MIN,Q2POW,Q2WWMN,Q2WWMX,QCDL3,QCDL5,QCDLAM,QDIQK,QEV,QFCH,QG, + & QLIM,QSPAC,QV,QWT,REPWT,RESN,RHOHEP,RHOPAR,RLTIM,RMASS,RMIN, + & RSPIN,SCABI,SINS,SNGWT,SWEIN,SWTEF,SUD,THMAX,TLOUT,TMTOP,TMNISR, + & TQWT,VCKM,VFCH,VGCUT,VHEP,VMIN2,VPAR,VPCUT,VQCUT,VTXPIP,VTXQDK, + & WBIGST,WGTMAX,WGTSUM,WHMIN,WSQSUM,XFACT,XLMIN,XMIX,XMRCT,XX, + & XXMIN,YBMAX,YBMIN,YJMAX,YJMIN,YMIX,YMRCT,YWWMAX,YWWMIN,ZBINM, + & ZJMAX,ZMXISR +C + INTEGER + & CLDIR,IAPHIG,IBRN,IBSH,ICHRG,ICO,IDCMF,IDHEP,IDHW,IDK,IDKPRD,IDN, + & IDPAR,IDPDG,IERROR,IFLAV,IFLMAX,IFLMIN,IHPRO,IMQDK,INHAD,INTER, + & IOPDKL,IOPHIG,IOPREM,IPART1,IPART2,IPRINT,IPRO,IPROC,ISLENT, + & ISPAC,ISTAT,ISTHEP,ISTPAR,JCOPAR,JDAHEP,JDAPAR,JMOHEP,JMOPAR, + & JNHAD,LNEXT,LOCN,LOCQ,LRSUD,LSTRT,LWEVT,LWSUD,MAPQ,MAXER,MAXEV, + & MAXFL,MAXPR,MODBOS,MODMAX,MODPDF,NBTRY,NCLDK,NCOLO,NCTRY,NDKYS, + & NDTRY,NETRY,NEVHEP,NEVPAR,NFLAV,NGSPL,NHEP,NME,NMODES,NMXCDK, + & NMXDKS,NMXHEP,NMXJET,NMXMOD,NMXPAR,NMXQDK,NMXRES,NMXSUD,NPAR, + & NPRODS,NQDK,NQEV,NRES,NRN,NSPAC,NSTRU,NSTRY,NSUD,NUMER,NUMERU, + & NWGTS,NZBIN,SUDORD +C + LOGICAL + & AZSOFT,AZSPIN,BGSHAT,BREIT,CLRECO,COLISR,DKPSET,FROST,FSTEVT, + & FSTWGT,GENEV,GENSOF,HARDME,HVFCEN,MAXDKL,MIXING,NOSPAC,NOWGT, + & PRNDEC,PIPSMR,PRVTX,RSTAB,SOFTME,TMPAR,TPOL,USECMF,VTOCDK,VTORDK, + & ZPRIME +C + CHARACTER*4 + & BDECAY + CHARACTER*8 + & PART1,PART2,RNAME + CHARACTER*20 + & AUTPDF +C +C New standard event common + PARAMETER (NMXHEP=2000) + COMMON/HEPEVT/NEVHEP,NHEP,ISTHEP(NMXHEP),IDHEP(NMXHEP), + & JMOHEP(2,NMXHEP),JDAHEP(2,NMXHEP),PHEP(5,NMXHEP),VHEP(4,NMXHEP) +C +C Beams, process and number of events + COMMON/HWBEAM/IPART1,IPART2 + COMMON/HWBMCH/PART1,PART2 + COMMON/HWPROC/EBEAM1,EBEAM2,PBEAM1,PBEAM2,IPROC,MAXEV +C +C Basic parameters (and quantities derived from them) + COMMON/HWPRAM/AFCH(16,2),ALPHEM,B1LIM,BETAF,BTCLM,CAFAC,CFFAC, + & CLMAX,CLPOW,CLSMR,CSPEED,ENSOF,ETAMIX,F0MIX,F1MIX,F2MIX,GAMH, + & GAMW,GAMZ,GAMZP,GEV2NB,H1MIX,PDIQK,PGSMX,PGSPL(4),PHIMIX,PIFAC, + & PRSOF,PSPLT,PTRMS,PXRMS,QCDL3,QCDL5,QCDLAM,QDIQK,QFCH(16),QG, + & QSPAC,QV,SCABI,SWEIN,TMTOP,VFCH(16,2),VCKM(3,3),VGCUT,VQCUT, + & VPCUT,ZBINM,IOPREM,IPRINT,ISPAC,LRSUD,LWSUD,MODPDF(2),NBTRY, + & NCOLO,NCTRY,NDTRY,NETRY,NFLAV,NGSPL,NSTRU,NSTRY,NZBIN,AZSOFT, + & AZSPIN,CLDIR,HARDME,NOSPAC,PRNDEC,PRVTX,SOFTME,ZPRIME +C + COMMON/HWPRCH/AUTPDF(2),BDECAY +C +C Parton shower common (same format as /HEPEVT/) + PARAMETER (NMXPAR=500) + COMMON/HWPART/NEVPAR,NPAR,ISTPAR(NMXPAR),IDPAR(NMXPAR), + & JMOPAR(2,NMXPAR),JDAPAR(2,NMXPAR),PPAR(5,NMXPAR),VPAR(4,NMXPAR) +C +C Parton polarization common + COMMON/HWPARP/DECPAR(2,NMXPAR),PHIPAR(2,NMXPAR),RHOPAR(2,NMXPAR), + & TMPAR(NMXPAR) +C +C Electroweak boson common + PARAMETER (MODMAX=5) + COMMON/HWBOSC/ALPFAC,BRHIG(12),ENHANC(12),GAMMAX,RHOHEP(3,NMXHEP), + & IOPHIG,MODBOS(MODMAX) +C +C Parton colour common + COMMON/HWPARC/JCOPAR(4,NMXPAR) +C +C other HERWIG branching, event and hard subprocess common blocks + COMMON/HWBRCH/ANOMSC(2,2),HARDST,PTINT(3,2),XFACT,INHAD,JNHAD, + & NSPAC(7),ISLENT,BREIT,FROST,USECMF +C + COMMON/HWEVNT/AVWGT,EVWGT,GAMWT,TLOUT,WBIGST,WGTMAX,WGTSUM,WSQSUM, + & IDHW(NMXHEP),IERROR,ISTAT,LWEVT,MAXER,MAXPR,NOWGT,NRN(2),NUMER, + & NUMERU,NWGTS,GENSOF +C + COMMON/HWHARD/ASFIXD,CLQ(7,6),COSS,COSTH,CTMAX,DISF(13,2),EMLST, + & EMMAX,EMMIN,EMPOW,EMSCA,EPOLN(3),GCOEF(7),GPOLN,OMEGA0,PHOMAS, + & PPOLN(3),PTMAX,PTMIN,PTPOW,Q2MAX,Q2MIN,Q2POW,Q2WWMN,Q2WWMX,QLIM, + & SINS,THMAX,TMNISR,TQWT,XX(2),XLMIN,XXMIN,YBMAX,YBMIN,YJMAX, + & YJMIN,YWWMAX,YWWMIN,WHMIN,ZJMAX,ZMXISR,IAPHIG,IBRN(2),IBSH, + & ICO(10),IDCMF,IDN(10),IFLMAX,IFLMIN,IHPRO,IPRO,MAPQ(6),MAXFL, + & BGSHAT,COLISR,FSTEVT,FSTWGT,GENEV,HVFCEN,TPOL +C +C Arrays for particle properties (NMXRES = max no of particles defined) + PARAMETER(NMXRES=400) + COMMON/HWPROP/RLTIM(0:NMXRES),RMASS(0:NMXRES),RSPIN(0:NMXRES), + & ICHRG(0:NMXRES),IDPDG(0:NMXRES),IFLAV(0:NMXRES),NRES, + & VTOCDK(0:NMXRES),VTORDK(0:NMXRES) +C + COMMON/HWUNAM/RNAME(0:NMXRES) +C +C Arrays for particle decays (NMXDKS = max total no of decays, +C NMXMOD = max no of modes for a particle) + PARAMETER(NMXDKS=4000,NMXMOD=200) + COMMON/HWUPDT/BRFRAC(NMXDKS),CMMOM(NMXDKS),DKLTM(NMXRES), + & IDK(NMXDKS),IDKPRD(5,NMXDKS),LNEXT(NMXDKS),LSTRT(NMXRES),NDKYS, + & NME(NMXDKS),NMODES(NMXRES),NPRODS(NMXDKS),DKPSET,RSTAB(0:NMXRES) +C +C Weights used in cluster decays + COMMON/HWUWTS/REPWT(0:3,0:4,0:4),SNGWT,DECWT,QWT(3),PWT(12), + & SWTEF(NMXRES) +C +C Parameters for cluster decays (NMXCDK = max total no of cluster +C decay channels) + PARAMETER(NMXCDK=4000) + COMMON/HWUCLU/CLDKWT(NMXCDK),CTHRPW(12,12),PRECO,RESN(12,12), + & RMIN(12,12),LOCN(12,12),NCLDK(NMXCDK),CLRECO +C +C Variables controling mixing and vertex information + COMMON/HWDIST/EXAG,GEV2MM,HBAR,PLTCUT,VMIN2,VTXPIP(4),XMIX(2), + & XMRCT(2),YMIX(2),YMRCT(2),IOPDKL,MAXDKL,MIXING,PIPSMR +C +C Arrays for temporarily storing heavy-b,c-hadrons decaying partonicaly +C (NMXBDK = max no such b-hadron decays in an event) + PARAMETER (NMXQDK=20) + COMMON/HWQDKS/VTXQDK(4,NMXQDK),IMQDK(NMXQDK),LOCQ(NMXQDK),NQDK +C +C Parameters for Sudakov form factors +C (NMXSUD= max no of entries in lookup table) + PARAMETER (NMXSUD=1024) + COMMON/HWUSUD/ACCUR,QEV(NMXSUD,6),SUD(NMXSUD,6),INTER,NQEV,NSUD, + & SUDORD +C + PARAMETER (NMXJET=200) +------------------------------------------------------------------------ + + ****** 8. FORM FACTOR FILE ****** + + HERWIG uses look-up tables of Sudakov form factors for the evolution + of initial- and final-state parton showers. These can be read from + an input file rather than being recomputed each time. The reading, + writing and computing of form factor tables is controlled by integer + parameters LRSUD and LWSUD: + + LRSUD = N>0 Read form factors for this run from unit N + LRSUD = 0 Compute new form factor tables for this run + LRSUD < 0 Form factor tables are already loaded + LWSUD = N>0 Write form factors on unit N for future use + LWSUD = 0 Do not write new form factor tables + + The option LRSUD<0 allows the program to be initialized several times + in the same run (e.g. to generate various event types) without recom- + puting or rereading form factors. + + N.B. The Sudakov form factors depend on the parameters QCDLAM, VQCUT, + VGCUT, NCOLO, NFLAV, NAFLA, RMASS(13) and RMASS(i) for i=1,...,NFLAV. + Consequently form factor tables MUST be recomputed every time any of + these parameters is changed. From version 5.1 onwards, these + parameters are written/read with the form factor tables and checks + are performed to ensure consistency. + + The parton showering algorithm uses the two-loop alpha_s, with + matching at each flavour threshold. However, the Sudakov table can be + computed with either the one-loop or two-loop form, according to the + variable SUDORD (= 1 or 2 respectively, DEFAULT=1). If SUDORD=1 the + two-loop value is recovered using the veto algorithm in the shower, + whereas if SUDORD=2 no vetoes are used in the final-state evolution. + This means that the relative weight of any shower configuration can + be calculated in a closed form, hence that showers can be `forced'. + + To next-to-leading order the two possibilities should be identical, + but they differ at beyond-NLO, so some results may change a little. + The most noticeable difference is that the form factor table takes a + factor of about five times longer to compute with SUDORD=2 than 1. +------------------------------------------------------------------------ + + ****** 9. EVENT DATA ****** + + /HEPEVT/ is the standard common block containing current event data: + + NEVHEP - event number + NHEP - number of entries for this event + ISTHEP(I) - status of entry I (see below) + IDHEP(I) - identity of entry I (revised Particle Data Group code) + JMOHEP(1,I) - pointer to first mother of entry I (see below) + JMOHEP(2,I) - pointer to second mother of entry I (see below) + JDAHEP(1,I) - pointer to first daughter of entry I (see below) + JDAHEP(2,I) - pointer to last daughter of entry I (see below) + PHEP(*,I) - (Px,Py,Pz,E,M) of entry I: M=sign(sqrt(abs(m**2)),m**2) + VHEP(*,I) - (x,y,z,t) of prod'n vertex of entry I (see section 13) + + All momenta are given in the laboratory frame, in which the input + beam momenta are PBEAM1 and PBEAM2 as specified by the user and point + along the +z and -z directions respectively. Final state particles + have ISTHEP(I) = 1. See the next section for a complete list of the + special status codes used by HERWIG. + + The identity codes IDHEP are as those suggested by the LEP II Working + group i.e. the revised Particle Data Group numbers plus the following + + * IDHEP = 91 for clusters, 94 for jets, 0 for others with no PDG code. + + (HERWIG also has its own internal identity codes IDHW(I), stored in + /HWEVNT/. The utility subroutine HWUIDT translates between HERWIG and + PDG identity codes. See section 20 for further details.) + + The mother/daughter pointers are standard, except that JMOHEP(2,I) + and JDAHEP(2,I) for a PARTON are its COLOUR mother and daughter, + i.e., the partons to which its colour and anticolour are connected, + respectively. For this purpose the primary partons from a hard sub- + process are all regarded as outgoing (see examples in sects. 15, 19 + and 21). Since quarks have no anticolour, JDAHEP(2,I) is used to + point to its FLAVOUR partner. Similarly for JMOHEP(2,I) in the case + of an antiquark. + + In addition to entries representing partons, particles, clusters etc, + /HEPEVT/ contains purely informational entries representing the total + c.m. momentum, hard and soft subprocess momenta, etc. See section 10 + for the corresponding status codes. + + Information from all stages of event processing is retained in + /HEPEVT/ so the same particle may appear several times with different + status codes. For example, an outgoing parton from a hard scattering + (entered initially with status 113 or 114) will appear after process- + ing as an on-mass-shell parton before QCD branching (status 123,124), + an off-mass-shell entry representing the flavour and momentum of the + outgoing jet (status 143,144), and a jet constituent (157). It might + also appear again in other contexts, e.g. as a spectator in a heavy + flavour decay (status 154,160). + + Incoming partons (entered with status 111, 112, changed to 121, 122 + after branching) give rise to spacelike jets (status 141,142, m**2<0, + indicated by PHEP(5,IHEP)<0) due to the loss of momentum via initial + state bremsstrahlung. The same applies in principle to incoming + leptons, but QED radiative corrections are not yet included. + + Each parton jet begins with a status 141-144 jet entry giving the + total flavour and momentum of the jet. The first mother pointer of + this entry gives the location of the parent hard parton, while the + second gives that of the subprocess c.m. momentum. If QCD branching + has occurred, this is followed by a lightlike CONE entry, which + fixes the angular extent of the jet and its azimuthal orientation + relative to the parton with which it interferes. The interfering par- + ton is listed as the second mother of the cone. Next come the actual + constituents of the jet. If no branching has occurred, there is no + cone and the single jet constituent is the same as the jet. +------------------------------------------------------------------------ + + ****** 10. STATUS CODES ****** + + A complete list of currently-used HERWIG status codes is given below. + Many are used only in intermediate stages of event processing. The + most important for users are probably 1 (final-state particle), 101-3 + (initial state), 141-4 (jets), and 199 (decayed b- and t-flavoured + hadrons). + + The event status ISTAT in common /HWEVNT/ is roughly ISTHEP-100 where + ISTHEP is the status of entries being processed. However, ISTAT=100 + for completed events. + + +------+-------------------------------------------+ + |ISTHEP| Description | + +------+-------------------------------------------+ + | 1 | final state particle | + | 2 | parton before hadronization | + | 3 | documentation line | + +------+-------------------------------------------+ + | 100 | cone limiting jet evolution | + | 101 | `beam' (beam 1) | + | 102 | `target' (beam 2) | + | 103 | overall centre of mass | + +------+-------------------------------------------+ + | 110 | unprocessed hard process CoM | + | 111 | " beam parton | + | 112 | " target " | + | 113 | " outgoing " 3 | + | 114 | " outgoing " 4 | + | 115 | " spectator " | + +------+-------------------------------------------+ + |120-25| as 110-15, after processing | + +------+-------------------------------------------+ + | 130 | lepton in jet (unboosted) | + |131-34| as 141-44, unboosted to CoM | + | 135 | spacelike parton (beam, unboosted) | + | 136 | " " (target, " ) | + | 137 | spectator (beam, unboosted) | + | 138 | " (target, " ) | + | 139 | parton from branching (unboosted) | + | 140 | " " g splitting ( " ) | + +------+-------------------------------------------+ + |141-44| jet from parton type 111-14 | + |145-50| as 135-40 boosted, unclustered | + +------+-------------------------------------------+ + | 151 | as 159, not yet clustered | + | 152 | as 160, " " " | + | 153 | spectator from beam | + | 154 | " " target | + | 155 | heavy quark before decay | + | 156 | spectator before heavy decay | + | 157 | parton from QCD branching | + | 158 | " after gluon splitting | + | 159 | " from cluster splitting | + | 160 | spectator after heavy decay | + +------+-------------------------------------------+ + | 161 | beam spectator after gluon splitting | + | 162 | target " " " " | + | 163 | other cluster before soft process | + | 164 | beam " " " " | + | 165 | target " " " " | + | 167 | unhadronized beam cluster | + | 168 | unhadronized target cluster | + +------+-------------------------------------------+ + | 170 | soft process centre of mass | + | 171 | soft cluster (beam, unhadronized) | + | 172 | soft cluster (target, " ) | + | 173 | soft cluster (other, " ) | + +------+-------------------------------------------+ + | 181 | beam cluster (no soft process) | + | 182 | target " ( " " " ) | + | 183 | hard process " (hadronized) | + | 184 | soft " (beam, hadronized) | + | 185 | " " (target, " ) | + | 186 | " " (other, " ) | + +------+-------------------------------------------+ + |190-93| as 195-98, before decays | + | 195 | direct unstable non-hadron | + | 196 | " " hadron (1-body cluster) | + | 197 | " " " (2-body cluster) | + | 198 | indirect unstable hadron or lepton | + | 199 | decayed heavy flavour hadron | + +------+-------------------------------------------+ + | 200 | neutral B meson, flavour at production | + +------+-------------------------------------------+ +------------------------------------------------------------------------ + + ****** 11. EVENT WEIGHTS ****** + + The default is to generate unweighted events (EVWGT=AVWGT). Then + event distributions are generated by computing a weight proportional + to the cross section and comparing it with a random number times the + maximum weight. Set WGTMAX to the maximum weight, or to zero for the + program to compute it. If a weight greater than WGTMAX is generated + during execution, a warning is printed and WGTMAX is reset. Similarly + if the efficiency is too low (WGTMAX too large). If these errors + occur too often, output event distributions could be distorted. + + To generate weighted events, set NOWGT=.FALSE. in common /HWEVNT/. + + In QCD hard scattering and heavy flavour and direct photon production + (IPROC = 1500 to 1800) the transverse energy distribution of weighted + events (or the efficiency for unweighted events) can be varied using + the parameters PTMIN, PTMAX and PTPOW. + + Similarly in Drell-Yan processes (IPROC = 13**) the lepton pair mass + distribution is controlled by the parameters EMMIN, EMMAX and EMPOW, + and in deep inelastic scattering the Q**2 distribution is set by + Q2MIN, Q2MAX and Q2POW. + + Data on weights generated are output at the end of the run. The mean + weight is an estimate of the cross section (in nanobarns) integrated + over the region used for event generation. + + N.B. The mean weight is the sum of weights divided by the total + number of WEIGHTS generated, not the total number of EVENTS. +------------------------------------------------------------------------ + + ****** 12. HEAVY FLAVOUR DECAYS ****** + + Heavy quark decays are treated as secondary hard subprocesses. Top + quarks can decay either before or after hadronization, depending on + the value of the logical variable DECAY returned by the subroutine + HWDTOP. At present decay occurs before hadronization (DECAY=.TRUE.) + if the top mass is above 130 GeV (default=170 GeV). Any hypothetical + heavier quarks always decay before hadronization. Top- and bottom- + flavoured hadrons are split into collinear heavy quark and spectator + and the former decays independently. After decay, parton showers may + be generated from coloured decay products, in the usual way. See + Nucl. Phys. B330 (1990) 261 for details of the treatment of colour + coherence in these showers. + + The arrays FBTM, FTOP & FHVY which were used in versions before 5.9 + to store the bottom, top & heavier quarks' partonic decay fractions + are gone. Such decays are specified in the decay tables like other + particles' decay modes: this permits different decays to be given to + individual heavy hadrons. Changes to the decay table entries can be + made on an event by event basis if desired. Partonic decays of charm + hadrons and quarkonium states are also now supported. The products' + order in a partonic decay mode is significant. For example, if the + decay is Q --> W+q --> (f+fbar')+q occurring inside a Q-sbar hadron, + the required ordering is: + + Q+sbar --->(f+fbar')+(q+sbar) + or (q+fbar')+(f+sbar) `colour rearranged' + + In both cases the (V-A)^2 ME^2 is proportional to: p_0.p_2 * p_1*p_3 + + The structure of the program has been altered so that secondary hard + subrocess and subsequent fragmentation associated with each partonic + heavy hadron decay appear separately. Thus pre-hadronization t quark + decays are treated individually as are any subsequent bottom hadron + partonic decays. + + Additionally decays of heavy hadrons to exclusive non-partonic final + states are supported. No check against double counting from partonic + modes is included. However this isn't expected to be a major problem + for the semi-leptonic and 2-body hadronic modes supplied. +------------------------------------------------------------------------ + + ****** 13. SPACE-TIME STRUCTURE OF EVENTS ****** + + The space-time structure of events is now available for all types of + subprocess. The production vertex of each: parton, cluster, unstable + resonance and final state particle is supplied in the VHEP(4,NMXHEP) + array of /HEPEVT/; set PRVTX=.TRUE. to include this information when + printing the event record (120 column format). The units are: x,y,z + in mm and t mm/c. In the case of partons and clusters the production + points are always given in a loacl coordinate system centered on the + their hard sub-process. This helps seperate the fermi scale partonic + showers from millimeter scale distances possible in particle decays, + for example the partonic decays of heavy (c,b) hadrons. The vertices + of hadrons produced in cluster decays are always corrected back into + the laboratory coordinate system. + + It is possible to vary the principal interaction point, assigned to + the CMF (ISTHEP=103) track, by setting PIPSMR=.TRUE. The smearing is + generated by the routine HWRPIP according to a triple Gaussian, see + the code for details. Also, it is possible to veto particle decays + that would occur outside a specified volume by setting MAXDKL=.TRUE. + Each putative decay is tested in HWDXLM and if it would have decayed + outside the chosen volume it is frozen and labelled as final state. + Using IOPDKL = 1,2 selects a cylindrical or spherical allowed region + (about the origin) see the code for details. + + Lepton and hadron lifetimes are supplied in the array RLTIM(NMXRES). + The lifetimes of heavy quarks (TQRK, VQRK, AQRK, HQRK AND HPQK), and + weak bosons (W+, W-, Z0/GAMA*, HIGGS and Z0P) are derived from their + calculated or specified widths as calculated in HWUDKS, whilst light + quarks and gluons are given an effective minimum width, sqrt(VMIN2), + that acts as a lifetime cut-off - see below. Recall that the proper + lifetime = HBAR/Gamma. All particles whose lifetimes are larger than + PLTCUT are set stable. + + The proper (= rest frame) time at which an unstable lepton or hadron + decays is generated according to the exponential decay law with mean + lifetime =RLTIM. The laboratory frame decay time and distance + travelled are obtained by applying a boost: + + Rest Prob (proper time < t) = 1 * exp(-t/) + frame + + Lab. time = gamma * proper time beta = v/c + frame dist = beta * gamma * proper time gamma = 1/sqrt(1-beta^2) + + The production vertices of the daughter particles are calculated by + adding the distance travelled by the mother particle as given above + to its production vertex. A similar prescription is used for parton + showers: proper lifetimes are taken from an exponential distribution + with a virtuality dependent mean lifetime 1/HBAR*sqrt(q^2/(q^2-m^2)) + inspired by the uncertainty relationship: mean lifetimes are limited + by a cut-off on the minimum virtuality VMIN2. The mean lifetimes of + heavy quarks and weak bosons, which can have appreciable widths, are + given by: + + hbar.sqrt(q^2) + (q^2) = ----------------------------- + \/(q^2-M^2)^2 + (Gamma.q^2/M)^2 + + As this formula has the appropriate limits for vanishing virtuality, + q^2=m^2, or width, gamma=0, it is actually also used in the hadronic + and partonic showers: see HWUDKL. + + In the case of cluster the initial production vertex is taken as the + midpoint of a line perpendicular to the cluster's direction and with + pair. If such a cluster undergoes a forced splitting to two clusters + the string picture is adopted. The vertex of the light quark pair is + positioned so that the masses of the two daughter clusters would be + the same as that for two equivalent string fragments. The production + vertices of the daughter clusters are given by the first crossing of + their constituent q-qbar pairs. This part of the space-time picture + is admittedly ad hoc however no physics depends upon it. + + When MIXING=.TRUE. particle - antiparticle mixing for B^0_d,s mesons + is implimented. The probability that a meson is mixed when it decays + is given in terms of its lab-frame decay time by: + + 1 sin(X*m*t/cE) X=Delta-M Y=Delta-Gamma + Prob(mix) = - + ---------------------- ------- ----------- + 2 2 *cosh(Y*m*t/cE) Gamma 2 * Gamma + + The ratios X and Y are stored in XMIX(I) & YMIX(I), I=1,2 for q=s,d. + Whenever a neutral B meson occurs in an event a copy of the original + track is always added to the event record, with ISTHEP=200, it gives + the particle's flavour at the production (cluster decay) time. This + is in addition to the usual decaying particle, ISTHEP=19*, track. +------------------------------------------------------------------------ + + ****** 14. COLOUR REARRANGEMENT MODEL ****** + + HERWIG now contains a colour rearrangement model based on the space- + time structure of an event occuring at the end of the parton shower. + This is illustrated in the simple example shown below where a colour + neutral source results in a q-g-g-qbar shower. In the conventional + hadronization model after a nonperturbative splitting of final state + gluons - Wolfram ansatze - colour singlet clusters are formed from + neighbouring q-qbar pairs: (ij)(pq)(kl). However when CLRECO=.TRUE. + the program first creates colour singlet clusters as normal but then + checks all (non-neighbouring) pairs of clusters to test if a colour + rearrangement lowers the sum of the clusters' spatial sizes added in + quadrature. A cluster's size is defined to be the Lorentz invariant, + space-time distance between the constituent quark's and anitquark's + production points. If an allowed alternative is found, that is: + + (ij)(kl) --> (il)(jk) s.t. (|d_ij|^2+|d_kl|^2) > (|d_il|^2+|d_kl|^2) + + then it is accepted with a probability given by PRECO (default 1/9). + + + ____ i Normal: (ij) (pq) (kl) + / + /____/ j If: + ------ + / \ p |d_ij|^2+|d_kl|^2 > |d_il|^2+|d_kl|^2 + ------| + \______/ q colour rearr.: (il) (pq) (jk) + ----- + \ \ k Not allowed: (iq) (jp) (kl) + \ ^ + ---- l | colour octet + + Note that not all colour rearrangements are allowed, for instance in + the example (ij)(pq) --> (ip)(jq) the cluster (jq) is a colour octet + - it contains both products from a non-perturbative gluon splitting. + + Multiple colour rearrangements are considered by the program, as are + those between clusters in jets arising from a single, colour neutral + source - for example Z0 decay (as shown above) - or due to more than + one source - for example e+e- --> W+W- --> 4 jets. In the later case + a new parameter, EXAG, is available to artificially scale the W - or + other weak boson - lifetimes so that any dependence of rearrangement + effects on source separation can be investigated. The CLRECO option + can be used for all the processes available in HERWIG. + + ** NOTE ** Before using the program with CLRECO=.TRUE. for detailed + physics analyses the default parameters should be retuned to `lower + energy' data with this option switched on. +------------------------------------------------------------------------ + + ****** 15. QCD HARD SUBPROCESSES ****** + + At present only 2->2 subprocesses are implemented. They are class- + ified as shown below. + + +-----+------------------------------+---------+ + |IHPRO| Process 1 + 2 -> 3 + 4 |Col/F.Con| + +-----+------------------------------+---------+ + | 1 | q + q -> q + q | 3 4 2 1 | + | 2 | q + q -> q + q | 4 3 1 2 | + | 3 | q + q' -> q + q' | 3 4 2 1 | + | 4 | q + qbar -> q'+ qbar' | 2 4 1 3 | + | 5 | q + qbar -> q + qbar | 3 1 4 2 | + | 6 | q + qbar -> q + qbar | 2 4 1 3 | + | 7 | q + qbar -> g + g | 2 4 1 3 | + | 8 | q + qbar -> g + g | 2 3 4 1 | + | 9 | q + qbar' -> q + qbar' | 3 1 4 2 | + | 10 | q + g -> q + g | 3 1 4 2 | + | 11 | q + g -> q + g | 3 4 2 1 | + | 12 | qbar + q -> qbar' +q' | 3 1 4 2 | + | 13 | qbar + q -> qbar + q | 2 4 1 3 | + | 14 | qbar + q -> qbar + q | 3 1 4 2 | + | 15 | qbar + q -> g + g | 3 1 4 2 | + | 16 | qbar + q -> g + g | 4 1 2 3 | + | 17 | qbar + q' -> qbar + q' | 2 4 1 3 | + | 18 | qbar + qbar -> qbar + qbar | 4 3 1 2 | + | 19 | qbar + qbar -> qbar + qbar | 3 4 2 1 | + | 20 | qbar + qbar' -> qbar + qbar' | 4 3 1 2 | + | 21 | qbar + g -> qbar + g | 2 4 1 3 | + | 22 | qbar + g -> qbar + g | 4 3 1 2 | + | 23 | g + q -> g + q | 2 4 1 3 | + | 24 | g + q -> g + q | 3 4 2 1 | + | 25 | g + qbar -> g + qbar | 3 1 4 2 | + | 26 | g + qbar -> g + qbar | 4 3 1 2 | + | 27 | g + g -> q + qbar | 2 4 1 3 | + | 28 | g + g -> q + qbar | 4 1 2 3 | + | 29 | g + g -> g + g | 4 1 2 3 | + | 30 | g + g -> g + g | 4 3 1 2 | + | 31 | g + g -> g + g | 2 4 1 3 | + +-----+------------------------------+---------+ + + `Col/F.Con' refers to the colour/flavour connections between the + partons:`I J K L' means that the colour of parton 1 comes from parton + I, that of 2 from J, etc. For antiquarks, which have no colour (only + anticolour), the label shows instead to which parton the flavour is + connected. For this colour/flavour labelling all partons are defined + as outgoing. Thus, for example, process 10 has colour connections + 3 1 4 2, corresponding to the colour flow diagram: + + 1 -->--+ +-->-- 3 + | | + | | + --<--+ +--<-- + 2 -->------->-- 4 + + When different colour flows are possible, they are listed as separate + subprocesses. This separation is not exact but is normally a good + approximation. The sum of the colour flows is the exact lowest-order + cross section. +------------------------------------------------------------------------ + + ****** 16. QCD DIRECT PHOTON SUBPROCESSES ****** + + +-----+------------------------------+---------+ + |IHPRO| Process 1 + 2 -> 3 + 4 |Col/F.Con| + +-----+------------------------------+---------+ + | 41 | q + qbar -> g + photon | 2 3 1 4 | + | 42 | q + gluon -> q + photon | 3 1 2 4 | + | 43 | qbar + q -> g + photon | 3 1 2 4 | + | 44 | qbar + gluon -> qbar + photon| 2 3 1 4 | + | 45 | gluon + q -> q + photon| 2 3 1 4 | + | 46 | gluon + qbar -> qbar + photon| 3 1 2 4 | + | 47 | gluon + gluon-> gluon+ photon| 2 3 1 4 | + +-----+------------------------------+---------+ + | 51 | photon+ q -> gluon+ q | 1 4 2 3 | + | 52 | photon+ qbar -> gluon+ qbar | 1 3 4 2 | + | 53 | photon+ gluon-> q + qbar | 1 4 2 3 | + +-----+------------------------------+---------+ + | 61 | q + qbar -> photon+photon| 2 1 3 4 | + | 62 | qbar + q -> photon+photon| 2 1 3 4 | + | 63 | gluon + gluon-> photon+photon| 2 1 3 4 | + +-----+------------------------------+---------+ + | 71 | photon+ q -> M(S=0) +q' | 1 4 3 2 | + | 72 | photon+ q -> M(S=1)L+q' | 1 4 3 2 | + | 73 | photon+ q -> M(S=1)T+q' | 1 4 3 2 | + | 74 | photon+ qbar -> M(S=0) +qbar'| 1 4 3 2 | + | 75 | photon+ qbar -> M(S=1)L+qbar'| 1 4 3 2 | + | 76 | photon+ qbar -> M(S=1)T+qbar'| 1 4 3 2 | + +-----+------------------------------+---------+ + + N.B. The photon is connected to itself. +------------------------------------------------------------------------ + + ****** 17. QCD HIGGS PLUS JET SUBPROCESSES ****** + + +-----+------------------------------+---------+ + |IHPRO| Process 1 + 2 -> 3 + 4 |Col/F.Con| + +-----+------------------------------+---------+ + | 81 | q + qbar -> g + H | 2 3 1 4 | + | 82 | q + g -> q + H | 3 1 2 4 | + | 83 | qbar + q -> g + H | 3 1 2 4 | + | 84 | qbar + g -> qbar + H | 2 3 1 4 | + | 85 | g + q -> q + H | 2 3 1 4 | + | 86 | g + qbar -> qbar + H | 3 1 2 4 | + | 87 | g + g -> g + H | 2 3 1 4 | + +-----+------------------------------+---------+ + + N.B. The Higgs is connected to itself. +------------------------------------------------------------------------ + + ****** 18. ELECTROWEAK SUBPROCESSES ****** + + HERWIG generates Higgs bosons through gluon-gluon/quark-antiquark + fusion, and W fusion in hadron-hadron collisions (IPROC=1600+ID and + 1900+ID), in lepton-lepton collisions through the Bjorken process + (that is, Z(*)->Z(*)H with one or both Zs off-shell) and W fusion + (IPROC=300+ID and 400+ID), and in lepton-hadron collisions through W + fusion (IPROC=9500+ID). Each process is generated according to the + exact leading order matrix element in the s-channel approximation. + This results in unitarity violation for Mh >> Mw, s >~ a few Mh^2, + (where s=qh^2), so to regularize this, the Mh*GAMH in the propagator + can be replaced by SQRT(s)*GAMH(s). The variable IOPHIG controls this + procedure: + + +------+------------------------------+-----------+ + |IOPHIG| Choose s according to | Reweight? | + +------+------------------------------+-----------+ + | 0 | s^2 / ((s-Mh^2)^2 + Mh*GAMH) | YES | + | 1 | 1 / ((s-Mh^2)^2 + Mh*GAMH) | YES | + | 2 | s^2 / ((s-Mh^2)^2 + Mh*GAMH) | NO | + | 3 | 1 / ((s-Mh^2)^2 + Mh*GAMH) | NO | + +------+------------------------------+-----------+ + + Where reweighting means weighting the distribution back to + + SQRT(s) * GAMH(s) + ---------------------------- + (s-Mh^2)^2 + SQRT(s)*GAMH(s) + + The default is IOPHIG=1. The difference between options 0 and 1 is + purely in the weight distribution produced. Options 2 and 3 are + intended primarily for users who wish to supply their own unitarity + conserving reweighting function at the point indicated in routine + HWHIGM. In all cases, the distribution is restricted to the range + [Mh-GAMMAX*GAMH , Mh+GAMMAX*GAMH]. GAMMAX defaults to 10, but in the + (probably unphysical) region Mh >~ 1TeV should be reduced to protect + against poor weight distributions. These considerations do not affect + the distribution noticably for Mh <~ 500 GeV, and GAMMAX can safely + be increased if necessary. + + For each process, ID controls the Higgs decay: ID=1-6 for quarks, 7-9 + for leptons, 10/11 for WW/ZZ pairs, and 12 for photons. In addition + ID=0 gives quarks of all flavours, and ID=99 gives all decays. For + each process, the average event weight is the cross section in nb + times the branching fraction to the requested decay. The branching + ratios to quarks use the next-to-leading logarithm corrections, those + to WW/ZZ pairs allow for one or both bosons off-shell. The amplitudes + for all Higgs vertices are multiplied by the factor ENHANC(ID) where + ID is the same as in IPROC=300+ID except the gammagammaHiggs `vertex' + which is calculated from ENHANC(6) and ENHANC(10) for the top and W + loops. This allows the simulation of any chargeless scalar Higgs. + Note however that pseudoscalar and charged Higgses, and processes + involving more than one Higgs (eg the decay H-->hZ) are not included. + + Gauge bosons are generated through the processes of W + 1 parton + production in hadron-hadron collisions, and WW pair production in + lepton-lepton collisions, as well as in the Higgs processes mentioned + above. In all cases their decay is controlled by the variable + MODBOS(i). This controls the decay of the ith gauge boson per event: + + +---------+-----------------+-----------------+ + |MODBOS(i)| W Decay | Z Decay | + +---------+-----------------+-----------------+ + | 0 | all | all | + | 1 | qqbar | qqbar | + | 2 | enu | e+e- | + | 3 | munu | mu+mu- | + | 4 | taunu | tau+tau- | + | 5 | enu & munu | ee & mumu | + | 6 | all | nunu | + | 7 | all | bbbar | + | >7 | all | all | + +---------+-----------------+-----------------+ + + All entries of MODBOS default to 0. Bosons which are produced in + pairs (ie. from WW pair production, or Higgs decay) are symmetrized + in MODBOS(i) and MODBOS(i+1). For processes which directly produce + gauge bosons, the event weight includes the branching fraction to the + requested decay, but this is only true for Higgs production if decay + to WW/ZZ is forced (ID=10/11) and not if ID=99. The spin-correlations + in the decays are handled in one of two ways: + (a) the diagonal members of the spin density matrix are stored in + RHOHEP(i,IHEP), where i=1,2,3 for helicity=i-2 in the centre-of- + mass frame of their production, for processes where this matrix + is diagonal (ie. there is no interference between spin states). + (b) the correlations in the decay are handled directly by the + production routine where (a) is not possible. + In the case of gamma gamma --> W W the decay correlations are not + correctly included: they currently decay isotropically. + + The electroweak vector boson--fermion coupling constants are stored + in the arrays QFCH(I), VFCH(I,J) and AFCH(I,J) for the charge, vector + and axial vector couplings to the neutral current respectively. These + are given in the convention + V_f=(T_3/2-Qsin^2_W)/(cos_W sin_W); A_f=T_3/(2 cos_W sin_W). + In each case, + I= 1- 6: d,u,s,c,b,t (quarks) + =11-16: e,nu_e,mu,nu_mu,tau,nu_tau (leptons) (`I=IDHW-110') + J=1 for minimal SM: + =2 for Z' couplings (only included if ZPRIME=.TRUE.) + Note that no universality is assumed -- couplings can be arbitrarily + set for each fermion species separately. + The quark mixing matrix is stored in VCKM(K,L), K=1,2,3 for u,c,t, + L=1,2,3 for d,s,b. + + A running electromagnetic coupling constant is provided, HWUAEM(Q2). + ALPHEM =1/137 provides the normalisation at the Thomson (Q2=0) limit + and is used for all processes involving real photons. + The electroweak coupling is calculated as, + g^2 = 4 PIFAC ALPHEM(Q2) / SWEIN, + where Q2 is appropriate for the given process. + Photon emission in parton showers, and in the `dead-zone' in e+e- + is enhanced by a factor of ALPFAC (default=1.). +------------------------------------------------------------------------ + + ****** 19. INCLUDING NEW SUBPROCESSES ****** + + It should not be difficult for users to include further subprocesses + in this version of the program if required. The parton and hard sub- + process 4-momenta, masses and identity codes need to be entered in + COMMON/HEPEVT/ with the appropriate status codes ISTHEP(I)=110-114 to + tell the program which is which (see table in sect. 10). The colour/ + flavour structure should be specified by the second mother and daugh- + ter pointers as explained in section 9 (see also the sample output + and guide, sections. 20 and 21). + + Apart from the status codes ISTHEP, the HERWIG identity codes IDHW(I) + in COMMON/HWEVNT/ also need to be set correctly. The IDHW codes can + be listed in a run with IPRINT=2: the most important are the quarks + 1-6 (as IDHEP), antiquarks 7-12, gluon 13, overall c.m. 14, hard c.m. + 15, soft c.m. 16, photon 59, leptons 121-126, antileptons 127-132. + + The utility subroutine HWUIDT(IOPT,IPDG,IHWG,NAME) is provided to + translate between Particle Data Group code IPDG, HERWIG code IHWG, + and HERWIG character*8 NAME, with IOPT=1,2,3 depending on which of + IPDG, IHWG and NAME is the input argument. + + Consider for example the process of virtual photon-gluon fusion to + make b+bbar in e p collisions. + + **** N.B. This process is now included as IPROC = 9102 **** + + We assume the user provides a subroutine to generate the momenta PHEP + for the hard subprocess e+g -> e+b+bbar. The colour structure is + + (e)4 ........... 7(e) + : + : + +-->-- 8(b) + | + -->--+ + (g)5 --<-----<-- 9(bbar) + + Thus the momenta generated, together with those of the initial beams + and the overall centre of mass, could be entered in the following + sequence: + + +----+--------+------+-----+------+------+----+ + |IHEP| Entry |ISTHEP|IDHEP|JMOHEP|JDAHEP|IDHW| + +----+--------+------+-----+------+------+----+ + | 1 | e beam | 101 | 11| 0 0| 0 0| 121| + | 2 | p beam | 102 | 2212| 0 0| 0 0| 73| + | 3 | ep c.m.| 103 | 0| 0 0| 0 0| 14| + +----+--------+------+-----+------+------+----+ + | 4 | e in | 111 | 11| 6 7| 0 7| 121| + | 5 | gluon | 112 | 21| 6 9| 0 8| 13| + | 6 | hard cm| 110 | 0| 4 5| 7 9| 15| + | 7 | e out | 113 | 11| 6 4| 0 4| 121| + | 8 | b | 114 | 5| 6 5| 0 9| 5| + | 9 | bbar | 114 | -5| 6 8| 0 5| 11| + +----+--------+------+-----+------+------+----+ + + Note that if there are more than two outgoing partons, the first has + status 113 and all the others 114. Each parton has JMOHEP(1,I)=6 to + indicate the location of the hard c.m. for this subprocess, while + JMOHEP(2,I) gives the location of the colour mother (treating the in- + coming gluon as outgoing) or the connected electron. JDAHEP(1,I) will + be set by the jet generator HWBGEN, while JDAHEP(2,I) points to the + anticolour mother (or connected electron). Finally the HERWIG identi- + fiers IDHW(I) could be set to the indicated values by means of the + translation subroutine HWUIDT as follows: + + CHARACTER*8 NAME + ..... + NHEP=9 + IDHEP(1)=11 + IDHEP(2)=2212 + ..... + IDHEP(9)=-5 + DO 10 I=1,NHEP + 10 CALL HWUIDT(1,IDHEP(I),IDHW(I),NAME) + IDHW(6)=15 + + The last statement is needed because IDPDG(I)=0 returns IDHW(I)=14. + If subroutine HWBGEN is now called, it will find the coloured partons + and generate QCD jets from them. Subsequent calls to HWCFOR etc can + then be used to form clusters and hadronize them. + + If the hard subprocess routine is called from HWEPRO, like those + already provided, it should have two options controlled by the logic- + al variable GENEV in COMMON/HWHARD/. For GENEV=.FALSE., an event + weight (normally the cross section in nanobarns) is generated and + stored as EVWGT in COMMON/HWEVNT/. If this weight is accepted by + HWEPRO, the subroutine is called a second time with GENEV=.TRUE. and + the corresponding event data should then be generated and stored as + explained above. +------------------------------------------------------------------------ + + ****** 20. ERROR CONDITIONS ****** + + Certain combinations of input parameters may lead to problems in exe- + cution. HERWIG tries to detect these and print a warning. Errors + during execution are dealt with by HWWARN which prints the calling + subprogram and a code and takes appropriate action. In general, the + larger the code the more serious the problem. Refer to the source + code to find out why HWWARN was called. Events can be rerun by + setting the random number seeds NRN to the values given in the error + message or event dump, and MAXWGT to the maximum weight encountered + in the run. Contents of /HEPEVT/ can by printed by calling HWUEPR, + those of /HWPART/ (last parton shower) by HWUBPR. + + If WGTMAX is increased during event generation, so that this message + is printed: + HWWARN CALLED FROM SUBPROGRAM HWEPRO: CODE = 1 + EVENT 21: SEEDS = 836291635 & 1823648329 WEIGHT = 0.3893E-08 + EVENT SURVIVES. EXECUTION CONTINUES + NEW MAXIMUM WEIGHT = 0.428217360829367E-08 + then to regenerate any later events, WGTMAX must be set to the printed + value, as well as setting NRN to the appropriate seeds. + + Examples of error messages: + + HWWARN CALLED FROM SUBPROGRAM HWSBRN: CODE = 101 + EVENT 31: SEEDS = 422399901 & 771980111 WEIGHT = 0.3893E-08 + EVENT KILLED. EXECUTION CONTINUES + + Spacelike (initial-state) parton branching had no phase space. This + can happen due to cutoffs which are slightly different in the hard + subprocess and the parton shower. + Action taken: program throws away this event and starts a new one. + + HWWARN CALLED FROM SUBPROGRAM HWCHAD: CODE = 102 + EVENT 51: SEEDS = 1033784787 & 1428957533 WEIGHT = 0.3893E-08 + EVENT KILLED. EXECUTION CONTINUES + + A cluster has been formed with too low a mass to represent any hadron + of the correct flavour, and there is no colour-connected cluster from + which the necessary additional mass could be transferred. + Action taken: program throws away this event and starts a new one. + + HWWARN CALLED FROM SUBPROGRAM HWUINE: CODE= 200 + EVENT SURVIVES. RUN ENDS GRACEFULLY + + CPU time limit liable to be reached before generating MAXEV events. + Action taken: skips to terminal calculations using existing events. + + HWWARN CALLED FROM SUBPROGRAM HWBSUD: CODE= 500 + RUN CANNOT CONTINUE + + The table of Sudakov form factors read on unit LRSUD does not extend + to the maximum momentum scale (QLIM) specified for this run. + Action taken: run aborted. The user must either reduce QLIM or set + LRSUD=0 to make a bigger table (set LWSUD nonzero to write it). + + HWWARN CALLED FROM SUBPROGRAM HWBSUD: CODE= 515 + RUN CANNOT CONTINUE + + The table of Sudakov form factors read on unit LRSUD is for a diff- + erent value of a relevant parameter (in this case the b quark mass). + Action taken: run aborted. The user must make a new table (set LWSUD + nonzero to write it). +------------------------------------------------------------------------ + ****** 21. SAMPLE OUTPUT ****** + + Below we give a complete listing of output from version 5.9 of the + program, set up for t quark production in pbar-p collisions at a + c.m. energy of 1.8 TeV. To shorten the event record, the underlying + event has been turned off (IPROC = 11706) and production vertices are + not printed (PRVTX=.FALSE.). The main features of the output are + discussed in section 22. + + + HERWIG 5.9 22nd July 1996 + + Please reference: G. Marchesini, B.R. Webber, + G.Abbiendi, I.G.Knowles, M.H.Seymour & L.Stanco + Computer Physics Communications 67 (1992) 465 + + INPUT CONDITIONS FOR THIS RUN + + BEAM 1 (PBAR ) MOM. = 900.00 + BEAM 2 (P ) MOM. = 900.00 + PROCESS CODE (IPROC) = 11706 + NUMBER OF FLAVOURS = 6 + STRUCTURE FUNCTION SET = 5 + AZIM SPIN CORRELATIONS = T + AZIM SOFT CORRELATIONS = T + QCD LAMBDA (GEV) = 0.1800 + DOWN QUARK MASS = 0.3200 + UP QUARK MASS = 0.3200 + STRANGE QUARK MASS = 0.5000 + CHARMED QUARK MASS = 1.5500 + BOTTOM QUARK MASS = 4.9500 + TOP QUARK MASS = 170.0000 + GLUON EFFECTIVE MASS = 0.7500 + EXTRA SHOWER CUTOFF (Q)= 0.4800 + EXTRA SHOWER CUTOFF (G)= 0.1000 + PHOTON SHOWER CUTOFF = 0.4000 + CLUSTER MASS PARAMETER = 3.3500 + SPACELIKE EVOLN CUTOFF = 2.5000 + INTRINSIC P-TRAN (RMS) = 0.0000 + MIN P-TRAN FOR 2->2 = 10.0000 + MAX P-TRAN FOR 2->2 = 900.0002 + + NO EVENTS WILL BE WRITTEN TO DISK + + B_d: Delt-M/Gam =0.7000 Delt-Gam/2*Gam =0.0000 + B_s: Delt-M/Gam = 10.00 Delt-Gam/2*Gam =0.2000 + + PDFLIB NOT USED FOR BEAM 1 + PDFLIB NOT USED FOR BEAM 2 + + + Checking consistency of particle properties + + + Checking consistency of decay tables + +Line, 565 decay: LMBDA_C+ --> XI*0 K*+ +is kinematically not allowed, Min-Mout= -0.139 +LMBDA_C+: BR sum = 0.97800 +Rescaling to 1 + +Line, 990 decay: LMBDA_C- --> XI*BAR K*- +is kinematically not allowed, Min-Mout= -0.139 +LMBDA_C-: BR sum = 0.97800 +Rescaling to 1 + + + PARTICLE TYPE 21=PI0 SET STABLE + + INITIAL SEARCH FOR MAX WEIGHT + + PROCESS CODE IPROC = 11706 + RANDOM NO. SEED 1 = 1246579 + SEED 2 = 8447766 + NUMBER OF SHOTS = 2000 + NEW MAXIMUM WEIGHT = 1.1503371195500599E-03 + NEW MAXIMUM WEIGHT = 3.2720875047931022E-03 + NEW MAXIMUM WEIGHT = 3.4397725453424351E-02 + NEW MAXIMUM WEIGHT = 6.0381232770162795E-02 + NEW MAXIMUM WEIGHT = 6.6570674949068473E-02 + + INITIAL SEARCH FINISHED + + OUTPUT ON ELEMENTARY PROCESS + + NUMBER OF EVENTS = 0 + NUMBER OF WEIGHTS = 2000 + MEAN VALUE OF WGT = 4.5373E-03 + RMS SPREAD IN WGT = 9.3312E-03 + ACTUAL MAX WEIGHT = 6.0519E-02 + ASSUMED MAX WEIGHT = 6.6571E-02 + + PROCESS CODE IPROC = 11706 + CROSS SECTION (PB) = 4.537 + ERROR IN C-S (PB) = 0.2087 + EFFICIENCY PERCENT = 6.816 + + + + EVENT 39: 900.00 GEV/C PBAR ON 900.00 GEV/C P PROCESS: 11706 + + SEEDS: 875163092 & 655954870 STATUS: 100 ERROR: 0 WEIGHT: 0.4537E-02 + + ---INITIAL STATE--- + + IHEP ID IDPDG IST MO1 MO2 DA1 DA2 P-X P-Y P-Z ENERGY MASS + 1 PBAR -2212 101 0 0 0 0 0.00 0.00 900.00 900.00 0.94 + 2 P 2212 102 0 0 0 0 0.00 0.00 -900.00 900.00 0.94 + 3 CMF 0 103 1 2 0 0 0.00 0.00 0.00 1800.00 1800.00 + + ---HARD SUBPROCESS--- + + IHEP ID IDPDG IST MO1 MO2 DA1 DA2 P-X P-Y P-Z ENERGY MASS + 4 UBAR -2 121 6 7 9 5 0.00 0.00 312.09 312.09 0.32 + 5 UQRK 2 122 6 4 17 8 0.00 0.00 -169.95 169.95 0.32 + 6 HARD 0 120 4 5 7 8 -16.42 -3.93 142.14 482.34 460.61 + 7 TBAR -6 123 6 8 22 4 116.29 -61.69 157.43 266.49 170.00 + 8 TQRK 6 124 6 5 24 7 -116.29 61.69 -15.29 215.55 170.00 + + ---PARTON SHOWERS--- + + IHEP ID IDPDG IST MO1 MO2 DA1 DA2 P-X P-Y P-Z ENERGY MASS + 9 UBAR 94 141 4 6 11 16 -19.27 -6.00 314.16 310.83 -49.90 + 10 CONE 0 100 4 7 0 0 0.88 -0.47 0.53 1.13 0.00 + 11 UBARDBAR -2101 2 9 12 45 21 0.00 0.00 408.95 408.95 0.70 + 12 GLUON 21 2 9 13 46 47 8.42 0.19 140.64 140.89 0.75 + 13 GLUON 21 2 9 14 48 49 2.07 -1.20 14.47 14.68 0.75 + 14 DBAR -1 2 9 15 50 49 3.78 3.25 8.85 10.16 0.32 + 15 DQRK 1 2 9 16 51 50 3.65 2.24 9.47 10.40 0.32 + 16 GLUON 21 2 9 26 52 53 1.36 1.52 3.46 4.09 0.75 + 17 UQRK 94 142 5 6 19 21 2.85 2.07 -172.02 171.51 -13.73 + 18 CONE 0 100 5 8 0 0 -0.88 0.47 0.07 1.00 0.00 + 19 GLUON 21 2 17 20 54 55 -0.95 -0.97 -3.31 3.66 0.75 + 20 GLUON 21 2 17 21 56 57 -1.90 -1.10 -16.01 16.17 0.75 + 21 UD 2101 2 17 45 58 57 0.00 0.00 -708.66 708.66 1.04 + 22 TBAR 94 143 7 6 23 23 107.70 -63.75 156.89 263.01 170.00 + 23 TBAR -6 3 22 22 26 26 107.70 -63.75 156.89 263.01 170.00 + 24 TQRK 94 144 8 6 25 25 -124.12 59.82 -14.74 219.32 170.00 + 25 TQRK 6 3 24 24 37 37 -124.12 59.82 -14.74 219.32 170.00 + + ---HEAVY FLAVOUR DECAYS--- + + IHEP ID IDPDG IST MO1 MO2 DA1 DA2 P-X P-Y P-Z ENERGY MASS + 26 TBAR -6 155 22 37 27 29 107.70 -63.75 156.89 263.01 170.00 + 27 MU- 13 123 26 28 30 28 18.31 32.76 65.37 75.38 0.11 + 28 NU_MUBAR -14 124 26 27 31 27 80.30 -57.83 106.04 145.04 0.00 + 29 BBAR -5 124 26 26 32 26 9.09 -38.68 -14.52 42.60 4.95 + 30 MU- 13 1 27 26 0 0 17.82 31.88 63.62 73.36 0.11 + 31 NU_MUBAR -14 1 28 26 0 0 78.14 -56.28 103.19 141.14 0.00 + + ---PARTON SHOWERS--- + + IHEP ID IDPDG IST MO1 MO2 DA1 DA2 P-X P-Y P-Z ENERGY MASS + 32 BBAR 94 144 29 26 34 36 11.74 -39.36 -9.92 48.52 23.85 + 33 CONE 0 100 29 26 0 0 0.24 0.72 1.07 1.32 0.00 + 34 GLUON 21 2 32 35 59 60 -2.95 -0.95 -3.35 4.62 0.75 + 35 GLUON 21 2 32 36 61 62 -1.72 -1.41 -1.55 2.81 0.75 + 36 BBAR -5 2 32 44 63 62 16.41 -37.00 -5.02 41.08 4.95 + + ---HEAVY FLAVOUR DECAYS--- + + IHEP ID IDPDG IST MO1 MO2 DA1 DA2 P-X P-Y P-Z ENERGY MASS + 37 TQRK 6 155 24 19 38 40 -124.12 59.82 -14.74 219.32 170.00 + 38 NU_E 12 123 37 39 41 39 -96.15 66.72 23.37 119.34 0.00 + 39 E+ -11 124 37 38 42 38 6.38 13.33 -54.59 56.56 0.00 + 40 BQRK 5 124 37 37 43 37 -34.36 -20.23 16.48 43.43 4.95 + 41 NU_E 12 1 38 37 0 0 -96.15 66.72 23.37 119.34 0.00 + 42 E+ -11 1 39 37 0 0 6.38 13.33 -54.59 56.56 0.00 + + ---PARTON SHOWERS--- + + IHEP ID IDPDG IST MO1 MO2 DA1 DA2 P-X P-Y P-Z ENERGY MASS + 43 BQRK 94 144 40 37 44 44 -34.36 -20.23 16.48 43.43 4.95 + 44 BQRK 5 2 43 54 64 63 -34.36 -20.23 16.48 43.43 4.95 + + ---GLUON SPLITTING--- + + IHEP ID IDPDG IST MO1 MO2 DA1 DA2 P-X P-Y P-Z ENERGY MASS + 45 UBARDBAR -2101 161 9 65 85 58 0.01 0.00 279.95 279.95 0.64 + 46 UBAR -2 158 9 47 104 84 1.90 0.01 33.44 33.50 0.32 + 47 UQRK 2 158 9 69 86 46 3.96 0.11 64.98 65.11 0.32 + 48 DBAR -1 158 9 49 97 70 0.95 -0.68 7.08 7.18 0.32 + 49 DQRK 1 158 9 71 87 48 0.40 -0.05 2.32 2.38 0.32 + 50 DBAR -1 158 9 51 98 72 3.00 2.57 7.04 8.08 0.32 + 51 DQRK 1 158 9 52 88 50 3.65 2.24 9.47 10.40 0.32 + 52 DBAR -1 158 9 53 88 51 0.49 0.47 0.95 1.21 0.32 + 53 DQRK 1 158 9 73 89 52 0.79 0.96 2.29 2.62 0.32 + 54 DBAR -1 158 17 55 102 80 -0.23 -0.13 -0.54 0.68 0.32 + 55 DQRK 1 158 17 56 90 54 -0.62 -0.80 -2.35 2.58 0.32 + 56 DBAR -1 158 17 57 90 55 -1.18 -0.54 -8.28 8.38 0.32 + 57 DQRK 1 158 17 75 91 56 -0.34 -0.26 -5.03 5.06 0.32 + 58 UD 2101 162 17 45 96 68 0.00 0.00 -552.77 552.77 0.64 + 59 DBAR -1 158 32 60 99 74 -0.85 -0.40 -0.95 1.37 0.32 + 60 DQRK 1 158 32 61 92 59 -1.65 -0.34 -1.90 2.56 0.32 + 61 DBAR -1 158 32 62 92 60 -0.66 -0.74 -0.83 1.33 0.32 + 62 DQRK 1 158 32 77 93 61 -0.91 -0.59 -0.62 1.29 0.32 + 63 BBAR -5 158 32 64 101 78 14.03 -31.87 -4.37 35.44 4.95 + 64 BQRK 5 158 43 81 94 63 -24.17 -14.23 11.39 30.68 4.95 + 65 DBAR -1 159 9 66 85 45 0.06 0.00 30.61 30.61 0.32 + 66 DQRK 1 159 9 83 95 65 0.02 0.00 65.93 65.93 0.32 + 67 UBAR -2 159 17 68 100 76 0.00 0.00 -108.31 108.31 0.32 + 68 UQRK 2 159 17 58 96 67 -0.02 -0.02 -26.64 26.65 0.32 + 69 DBAR -1 159 9 70 86 47 0.44 -0.20 4.71 4.75 0.32 + 70 DQRK 1 159 9 48 97 69 2.01 0.04 32.91 32.97 0.32 + 71 SBAR -3 159 9 72 87 49 0.67 0.43 2.09 2.29 0.50 + 72 SQRK 3 159 9 50 98 71 0.55 0.00 2.95 3.04 0.50 + 73 UBAR -2 159 32 74 89 53 -0.35 -0.15 -0.36 0.61 0.32 + 74 UQRK 2 159 9 59 99 73 -0.02 0.04 0.09 0.33 0.32 + 75 SBAR -3 159 17 76 91 57 -0.10 -0.08 -15.37 15.37 0.50 + 76 SQRK 3 159 17 67 100 75 -0.26 -0.20 -8.28 8.30 0.50 + 77 SBAR -3 159 32 78 93 62 1.73 -3.90 -0.53 4.33 0.50 + 78 SQRK 3 159 32 63 101 77 0.49 -1.31 -0.22 1.50 0.50 + 79 DBAR -1 159 17 80 103 82 -0.22 -0.12 -0.18 0.45 0.32 + 80 DQRK 1 159 43 54 102 79 -3.20 -1.89 1.55 4.04 0.32 + 81 UBAR -2 159 17 82 94 64 -1.26 -0.74 0.58 1.61 0.32 + 82 UQRK 2 159 43 79 103 81 -5.60 -3.30 2.72 7.05 0.32 + 83 DBAR -1 159 9 84 95 66 0.07 0.00 27.33 27.33 0.32 + 84 DQRK 1 159 9 46 104 83 0.23 0.00 11.57 11.58 0.32 + + ---CLUSTER FORMATION--- + + IHEP ID IDPDG IST MO1 MO2 DA1 DA2 P-X P-Y P-Z ENERGY MASS + 85 CLUS 91 184 45 65 105 106 0.07 0.00 310.56 310.56 1.23 + 86 CLUS 91 183 47 69 107 108 4.40 -0.09 69.69 69.85 1.59 + 87 CLUS 91 183 49 71 109 110 1.07 0.38 4.41 4.67 1.03 + 88 CLUS 91 183 51 52 111 112 4.14 2.70 10.42 11.61 1.31 + 89 CLUS 91 183 53 73 113 114 0.44 0.80 1.92 3.24 2.44 + 90 CLUS 91 183 55 56 115 116 -1.80 -1.34 -10.63 10.96 1.48 + 91 CLUS 91 183 57 75 117 118 -0.44 -0.34 -20.39 20.43 1.09 + 92 CLUS 91 183 60 61 119 120 -2.31 -1.08 -2.73 3.89 1.09 + 93 CLUS 91 183 62 77 121 122 0.82 -4.49 -1.15 5.62 3.07 + 94 CLUS 91 183 64 81 123 123 -25.44 -14.98 11.97 32.29 5.28 + 95 CLUS 91 183 66 83 124 125 0.09 0.00 93.26 93.26 0.71 + 96 CLUS 91 185 68 58 126 127 -0.02 -0.02 -579.41 579.41 1.64 + 97 CLUS 91 183 70 48 128 129 2.97 -0.64 39.98 40.15 2.04 + 98 CLUS 91 183 72 50 130 131 3.54 2.57 9.99 11.12 2.17 + 99 CLUS 91 183 74 59 132 133 -0.87 -0.36 -0.86 1.71 1.13 + 100 CLUS 91 183 76 67 134 135 -0.26 -0.20 -116.59 116.61 2.24 + 101 CLUS 91 183 78 63 136 136 14.56 -33.17 -4.60 36.91 5.38 + 102 CLUS 91 183 80 54 137 138 -3.47 -2.02 1.02 4.76 2.34 + 103 CLUS 91 183 82 79 139 140 -5.81 -3.42 2.54 7.49 2.06 + 104 CLUS 91 183 84 46 141 142 2.13 0.01 45.01 45.08 1.04 + + ---CLUSTER DECAYS--- + + IHEP ID IDPDG IST MO1 MO2 DA1 DA2 P-X P-Y P-Z ENERGY MASS + 105 PBAR -2212 1 85 9 0 0 -0.13 0.09 215.09 215.09 0.94 + 106 PI+ 211 1 85 9 0 0 0.20 -0.09 95.47 95.47 0.14 + 107 OMEGA 223 197 86 9 143 145 2.33 -0.03 34.12 34.20 0.78 + 108 RHO+ 213 197 86 9 146 147 2.07 -0.06 35.58 35.65 0.77 + 109 PI0 111 1 87 9 0 0 0.14 0.05 0.57 0.60 0.14 + 110 K*0 313 197 87 9 148 149 0.93 0.34 3.84 4.07 0.90 + 111 PI0 111 1 88 9 0 0 2.48 1.51 6.44 7.07 0.14 + 112 OMEGA 223 197 88 9 150 151 1.66 1.19 3.98 4.54 0.78 + 113 P 2212 1 89 9 0 0 -0.35 0.36 0.89 1.39 0.94 + 114 DLTABR-- -2224 197 89 9 152 153 0.80 0.45 1.03 1.85 1.23 + 115 A_10 20113 197 90 17 154 155 -1.73 -1.30 -10.33 10.63 1.23 + 116 PI0 111 1 90 17 0 0 -0.06 -0.04 -0.30 0.33 0.14 + 117 PI- -211 1 91 17 0 0 -0.08 0.11 -12.23 12.23 0.14 + 118 K+ 321 1 91 17 0 0 -0.36 -0.44 -8.16 8.20 0.49 + 119 RHO- -213 197 92 32 156 157 -1.94 -1.07 -2.51 3.44 0.77 + 120 PI+ 211 1 92 32 0 0 -0.37 0.00 -0.22 0.45 0.14 + 121 KL_10 10313 197 93 32 158 159 1.17 -2.31 -1.07 3.22 1.57 + 122 ETAP 331 197 93 32 160 162 -0.35 -2.18 -0.08 2.41 0.96 + 123 B- -521 196 94 43 163 165 -25.44 -14.98 11.97 32.29 5.28 + 124 PI0 111 1 95 9 0 0 0.30 -0.06 25.24 25.24 0.14 + 125 PI0 111 1 95 9 0 0 -0.21 0.06 68.02 68.02 0.14 + 126 PI+ 211 1 96 17 0 0 0.04 0.14 -231.52 231.52 0.14 + 127 DELTA0 2114 197 96 17 166 167 -0.06 -0.15 -347.89 347.89 1.23 + 128 P 2212 1 97 9 0 0 0.84 -0.11 14.92 14.97 0.94 + 129 PBAR -2212 1 97 9 0 0 2.13 -0.53 25.06 25.17 0.94 + 130 ETA 221 197 98 9 168 170 0.59 0.27 2.25 2.40 0.55 + 131 K*_2BAR0 -315 197 98 9 171 172 2.95 2.30 7.74 8.72 1.43 + 132 PI0 111 1 99 9 0 0 -0.35 0.05 -0.95 1.02 0.14 + 133 PI+ 211 1 99 9 0 0 -0.52 -0.41 0.09 0.68 0.14 + 134 KBAR0 -311 197 100 17 173 173 0.04 -0.01 -17.14 17.15 0.50 + 135 PI_2- -10215 197 100 17 174 175 -0.30 -0.19 -99.44 99.46 1.67 + 136 B_S0 531 200 101 32 176 176 14.56 -33.17 -4.60 36.91 5.38 + 137 HL_10 10223 197 102 43 177 178 -3.20 -1.92 1.24 4.10 1.17 + 138 ETA 221 197 102 43 179 181 -0.28 -0.10 -0.22 0.66 0.55 + 139 A_20 115 197 103 43 182 184 -2.96 -1.35 1.04 3.66 1.32 + 140 PI+ 211 1 103 43 0 0 -2.85 -2.07 1.50 3.84 0.14 + 141 PI0 111 1 104 9 0 0 0.66 0.06 16.64 16.65 0.14 + 142 RHO- -213 197 104 9 185 186 1.47 -0.05 28.37 28.42 0.77 + + ---STRONG HADRON DECAYS--- + + IHEP ID IDPDG IST MO1 MO2 DA1 DA2 P-X P-Y P-Z ENERGY MASS + 143 PI+ 211 1 107 9 0 0 1.90 -0.02 24.27 24.35 0.14 + 144 PI- -211 1 107 9 0 0 0.32 0.00 6.77 6.78 0.14 + 145 PI0 111 1 107 9 0 0 0.11 -0.02 3.07 3.08 0.14 + 146 PI+ 211 1 108 9 0 0 1.80 0.19 29.01 29.07 0.14 + 147 PI0 111 1 108 9 0 0 0.27 -0.25 6.57 6.58 0.14 + 148 K0 311 198 110 9 187 187 0.65 0.06 3.19 3.29 0.50 + 149 PI0 111 1 110 9 0 0 0.28 0.27 0.65 0.77 0.14 + 150 PI0 111 1 112 9 0 0 1.33 1.12 3.73 4.12 0.14 + 151 GAMMA 22 1 112 9 0 0 0.34 0.07 0.25 0.42 0.00 + 152 PBAR -2212 1 114 9 0 0 0.75 0.24 1.02 1.59 0.94 + 153 PI- -211 1 114 9 0 0 0.05 0.21 0.01 0.25 0.14 + 154 RHO+ 213 198 115 17 188 189 -1.57 -0.83 -8.84 9.05 0.77 + 155 PI- -211 1 115 17 0 0 -0.16 -0.47 -1.49 1.58 0.14 + 156 PI- -211 1 119 32 0 0 -0.65 -0.64 -1.38 1.66 0.14 + 157 PI0 111 1 119 32 0 0 -1.29 -0.43 -1.12 1.77 0.14 + 158 K+ 321 1 121 32 0 0 0.56 -0.88 0.04 1.15 0.49 + 159 RHO- -213 198 121 32 190 191 0.61 -1.43 -1.11 2.06 0.77 + 160 PI+ 211 1 122 32 0 0 -0.15 -0.86 0.05 0.89 0.14 + 161 PI- -211 1 122 32 0 0 -0.07 -0.48 -0.08 0.51 0.14 + 162 ETA 221 198 122 32 192 193 -0.13 -0.84 -0.05 1.01 0.55 + 163 RHO0 113 198 123 43 194 195 -18.44 -9.34 6.79 21.77 0.77 + 164 E- 11 1 123 43 0 0 -6.49 -5.26 5.27 9.88 0.00 + 165 NU_EBAR -12 1 123 43 0 0 -0.50 -0.38 -0.09 0.63 0.00 + 166 P 2212 1 127 17 0 0 0.09 -0.11 -219.33 219.33 0.94 + 167 PI- -211 1 127 17 0 0 -0.15 -0.05 -128.56 128.56 0.14 + 168 PI0 111 1 130 9 0 0 0.07 0.07 0.80 0.82 0.14 + 169 PI0 111 1 130 9 0 0 0.21 0.13 0.47 0.55 0.14 + 170 PI0 111 1 130 9 0 0 0.31 0.07 0.98 1.04 0.14 + 171 K- -321 1 131 9 0 0 2.36 1.08 5.22 5.85 0.49 + 172 PI+ 211 1 131 9 0 0 0.59 1.22 2.53 2.87 0.14 + 173 K_S0 310 198 134 17 196 197 0.04 -0.01 -17.14 17.15 0.50 + 174 F_2 225 198 135 17 198 199 -0.33 -0.32 -95.89 95.90 1.27 + 175 PI- -211 1 135 17 0 0 0.03 0.12 -3.56 3.56 0.14 + 176 B_SBAR0 -531 199 136 32 207 208 14.56 -33.17 -4.60 36.91 5.38 + 177 RHO+ 213 198 137 43 200 201 -2.29 -1.73 0.99 3.13 0.77 + 178 PI- -211 1 137 43 0 0 -0.90 -0.19 0.24 0.96 0.14 + 179 PI0 111 1 138 43 0 0 0.01 0.05 0.02 0.15 0.14 + 180 PI0 111 1 138 43 0 0 -0.07 -0.10 -0.06 0.19 0.14 + 181 PI0 111 1 138 43 0 0 -0.22 -0.05 -0.18 0.32 0.14 + 182 OMEGA 223 198 139 43 202 204 -1.92 -0.63 0.73 2.28 0.78 + 183 PI+ 211 1 139 43 0 0 -0.66 -0.32 0.05 0.75 0.14 + 184 PI- -211 1 139 43 0 0 -0.38 -0.40 0.26 0.63 0.14 + 185 PI- -211 1 142 9 0 0 0.68 -0.38 13.27 13.29 0.14 + 186 PI0 111 1 142 9 0 0 0.79 0.33 15.11 15.13 0.14 + 187 K_S0 310 198 148 9 205 206 0.65 0.06 3.19 3.29 0.50 + 188 PI+ 211 1 154 17 0 0 -1.45 -0.73 -8.47 8.62 0.14 + 189 PI0 111 1 154 17 0 0 -0.13 -0.10 -0.37 0.43 0.14 + 190 PI- -211 1 159 32 0 0 0.68 -1.24 -1.13 1.82 0.14 + 191 PI0 111 1 159 32 0 0 -0.06 -0.19 0.02 0.24 0.14 + 192 GAMMA 22 1 162 32 0 0 -0.31 -0.62 -0.15 0.71 0.00 + 193 GAMMA 22 1 162 32 0 0 0.18 -0.22 0.10 0.30 0.00 + 194 PI+ 211 1 163 43 0 0 -16.47 -8.12 6.03 19.32 0.14 + 195 PI- -211 1 163 43 0 0 -1.98 -1.22 0.76 2.45 0.14 + 196 PI0 111 1 173 17 0 0 0.14 0.16 -6.36 6.37 0.14 + 197 PI0 111 1 173 17 0 0 -0.10 -0.16 -10.78 10.78 0.14 + 198 PI0 111 1 174 17 0 0 -0.61 -0.52 -38.85 38.86 0.14 + 199 PI0 111 1 174 17 0 0 0.27 0.20 -57.03 57.04 0.14 + 200 PI+ 211 1 177 43 0 0 -1.01 -0.34 0.30 1.11 0.14 + 201 PI0 111 1 177 43 0 0 -1.29 -1.39 0.70 2.02 0.14 + 202 PI+ 211 1 182 43 0 0 -0.30 -0.02 0.08 0.34 0.14 + 203 PI- -211 1 182 43 0 0 -0.30 -0.13 0.36 0.50 0.14 + 204 PI0 111 1 182 43 0 0 -1.32 -0.48 0.29 1.44 0.14 + 205 PI0 111 1 187 9 0 0 0.51 -0.06 1.56 1.65 0.14 + 206 PI0 111 1 187 9 0 0 0.14 0.12 1.63 1.64 0.14 + + ---HEAVY FLAVOUR DECAYS--- + + IHEP ID IDPDG IST MO1 MO2 DA1 DA2 P-X P-Y P-Z ENERGY MASS + 207 BQRK 5 155 176 208 209 211 13.20 -30.08 -4.17 33.47 4.88 + 208 SBAR -3 125 176 211 212 211 1.35 -3.09 -0.43 3.43 0.50 + 209 CQRK 4 123 207 210 213 210 2.30 -5.94 -0.61 6.59 1.55 + 210 CBAR -4 124 207 209 215 209 3.58 -8.37 -1.74 9.40 1.55 + 211 SQRK 3 124 207 207 217 207 7.33 -15.77 -1.82 17.49 0.50 + 212 SBAR -3 160 208 221 223 221 1.35 -3.09 -0.43 3.43 0.50 + + ---PARTON SHOWERS--- + + IHEP ID IDPDG IST MO1 MO2 DA1 DA2 P-X P-Y P-Z ENERGY MASS + 213 CQRK 94 143 209 207 214 214 2.30 -5.94 -0.61 6.59 1.55 + 214 CQRK 4 2 213 216 219 216 2.30 -5.94 -0.61 6.59 1.55 + 215 CBAR 94 144 210 207 216 216 3.58 -8.37 -1.74 9.40 1.55 + 216 CBAR -4 2 215 219 220 219 3.58 -8.37 -1.74 9.40 1.55 + 217 SQRK 94 144 211 207 218 218 7.33 -15.77 -1.82 17.49 0.50 + 218 SQRK 3 2 217 212 221 212 7.33 -15.77 -1.82 17.49 0.50 + + ---GLUON SPLITTING--- + + IHEP ID IDPDG IST MO1 MO2 DA1 DA2 P-X P-Y P-Z ENERGY MASS + 219 CQRK 4 158 213 220 222 220 2.30 -5.94 -0.61 6.59 1.55 + 220 CBAR -4 158 215 219 222 219 3.58 -8.37 -1.74 9.40 1.55 + 221 SQRK 3 158 217 212 223 212 7.33 -15.77 -1.82 17.49 0.50 + + ---CLUSTER FORMATION--- + + IHEP ID IDPDG IST MO1 MO2 DA1 DA2 P-X P-Y P-Z ENERGY MASS + 222 CLUS 91 183 219 220 224 224 4.87 -12.18 -2.12 13.62 2.98 + 223 CLUS 91 183 221 212 225 226 9.69 -20.99 -2.48 23.29 1.37 + + ---CLUSTER DECAYS--- + + IHEP ID IDPDG IST MO1 MO2 DA1 DA2 P-X P-Y P-Z ENERGY MASS + 224 ETA_C 441 199 222 213 227 229 4.87 -12.18 -2.12 13.62 2.98 + 225 K- -321 1 223 217 0 0 8.22 -17.67 -2.03 19.60 0.49 + 226 K+ 321 1 223 217 0 0 1.47 -3.31 -0.45 3.69 0.49 + + ---HEAVY FLAVOUR DECAYS--- + + IHEP ID IDPDG IST MO1 MO2 DA1 DA2 P-X P-Y P-Z ENERGY MASS + 227 GLUON 21 123 224 229 230 228 2.59 -4.45 -1.11 5.32 0.75 + 228 GLUON 21 124 224 227 232 229 0.84 -4.20 -0.51 4.38 0.75 + 229 GLUON 21 124 224 228 234 227 1.44 -3.53 -0.50 3.92 0.75 + + ---PARTON SHOWERS--- + + IHEP ID IDPDG IST MO1 MO2 DA1 DA2 P-X P-Y P-Z ENERGY MASS + 230 GLUON 94 143 227 224 231 231 2.59 -4.45 -1.11 5.32 0.75 + 231 GLUON 21 2 230 235 236 237 2.59 -4.45 -1.11 5.32 0.75 + 232 GLUON 94 144 228 224 233 233 0.84 -4.20 -0.51 4.38 0.75 + 233 GLUON 21 2 232 236 238 239 0.84 -4.20 -0.51 4.38 0.75 + 234 GLUON 94 144 229 224 235 235 1.44 -3.53 -0.50 3.92 0.75 + 235 GLUON 21 2 234 238 240 241 1.44 -3.53 -0.50 3.92 0.75 + + ---GLUON SPLITTING--- + + IHEP ID IDPDG IST MO1 MO2 DA1 DA2 P-X P-Y P-Z ENERGY MASS + 236 DBAR -1 158 230 237 243 239 1.65 -2.62 -0.82 3.22 0.32 + 237 DQRK 1 158 230 240 242 236 0.95 -1.83 -0.29 2.10 0.32 + 238 DBAR -1 158 232 239 244 241 0.66 -3.17 -0.34 3.27 0.32 + 239 DQRK 1 158 232 236 243 238 0.18 -1.03 -0.17 1.11 0.32 + 240 UBAR -2 158 234 241 242 237 0.65 -2.08 -0.24 2.22 0.32 + 241 UQRK 2 158 234 238 244 240 0.79 -1.45 -0.26 1.70 0.32 + + ---CLUSTER FORMATION--- + + IHEP ID IDPDG IST MO1 MO2 DA1 DA2 P-X P-Y P-Z ENERGY MASS + 242 CLUS 91 183 237 240 245 246 1.60 -3.90 -0.53 4.32 0.74 + 243 CLUS 91 183 239 236 247 248 1.82 -3.65 -0.98 4.33 1.03 + 244 CLUS 91 183 241 238 249 250 1.45 -4.62 -0.60 4.98 0.96 + + ---CLUSTER DECAYS--- + + IHEP ID IDPDG IST MO1 MO2 DA1 DA2 P-X P-Y P-Z ENERGY MASS + 245 PI- -211 1 242 230 0 0 1.53 -3.79 -0.46 4.11 0.14 + 246 PI0 111 1 242 230 0 0 0.06 -0.12 -0.07 0.20 0.14 + 247 PI0 111 1 243 232 0 0 0.52 -0.39 0.03 0.66 0.14 + 248 PI0 111 1 243 232 0 0 1.30 -3.27 -1.01 3.66 0.14 + 249 PI0 111 1 244 234 0 0 1.02 -3.98 -0.74 4.18 0.14 + 250 PI+ 211 1 244 234 0 0 0.43 -0.64 0.14 0.80 0.14 + + OUTPUT ON ELEMENTARY PROCESS + + NUMBER OF EVENTS = 1000 + NUMBER OF WEIGHTS = 14518 + MEAN VALUE OF WGT = 4.4894E-03 + RMS SPREAD IN WGT = 9.2221E-03 + ACTUAL MAX WEIGHT = 6.1048E-02 + ASSUMED MAX WEIGHT = 6.6571E-02 + + PROCESS CODE IPROC = 11706 + CROSS SECTION (PB) = 4.489 + ERROR IN C-S (PB) = 7.6538E-02 + EFFICIENCY PERCENT = 6.744 + +----------------------------------------------------------------------- + + ****** 22. GUIDE TO SAMPLE OUTPUT ****** + + + After listing the more important input parameter values, the program + prints the message + + NO EVENTS WILL BE WRITTEN TO DISK + + to remind the user that LWEVT=0 for this run. Since BBbar oscillation + is enabled (MIXING=.TRUE.), the relevant parameters are printed: + + B_d: Delt-M/Gam =0.7000 Delt-Gam/2*Gam =0.0000 + B_s: Delt-M/Gam = 10.00 Delt-Gam/2*Gam =0.2000 + + The messages + + PDFLIB NOT USED FOR BEAM 1 + PDFLIB NOT USED FOR BEAM 2 + + indicating that the CERN PDFLIB structure function library will not + be used (MODPDF<0). Next the particle property and decay tables are + checked for consistency. The messages + +Line, 565 decay: LMBDA_C+ --> XI*0 K*+ +is kinematically not allowed, Min-Mout= -0.139 +LMBDA_C+: BR sum = 0.97800 +Rescaling to 1 + +Line, 990 decay: LMBDA_C- --> XI*BAR K*- +is kinematically not allowed, Min-Mout= -0.139 +LMBDA_C-: BR sum = 0.97800 +Rescaling to 1 + + indicate that some user-modified decay modes are impossible and will + be ignored. The default particle data table was modified by calling + HWUSTA('PI0 ') to suppress pi0 decays, so we get the message + + PARTICLE TYPE 21=PI0 SET STABLE + + Next the program searches for the maximum weight, i.e. the maximum + cross section in the available phase space, as implied by the default + value WGTMAX=0. The parameters + + MIN P-TRAN FOR 2->2 = 10.0000 + MAX P-TRAN FOR 2->2 = 900.0002 + with + PROCESS CODE = 11706 + + mean that the transverse momentum of the t quark in the QCD 2->2 hard + subprocesses is required to be greater than 10 GeV/c. After this + search, the estimated total cross section of relevant subprocesses in + this region of phase space is printed, together with the anticipated + efficiency of subprocess generation (i.e. average/maximum weight): + + CROSS SECTION (PB) = 4.537 + ERROR IN C-S (PB) = 0.2087 + EFFICIENCY PERCENT = 6.816 + + Since the print parameter was MAXPR=0, no events were printed by + default, but the user analysis routine HWANAL called HWUEPR to print + the first "interesting" event. The event heading + +EVENT 39: 900.00 GEV/C PBAR ON 900.00 GEV/C P PROCESS: 11706 + +SEEDS: 875163092 & 655954870 STATUS: 100 ERROR: 0 WEIGHT: 0.4537E-02 + + + tells us the beam and target, the random number seeds at the start of + the event and the process code IPROC. The status 100 means a complete + event was generated and the zero error code means no problems were + encountered. Since NOWGT=.TRUE. (unweighted event generation), each + event has the mean weight computed earlier. + + Next come the contents of COMMON/HEPEVT/ and related quantities. The + print parameter for vertex information has been set PRVTX=.FALSE. and + so no space-time information is printed. The various parts of this + particular event are located as follows: + + +---------+--------------------------------------+ + | Entry | Description | + +---------+--------------------------------------+ + | 1- 3 | Initial state | + | 4- 8 | Hard subprocess: u+ubar -> t+tbar | + | 9- 25 | Parton showers | + | 26- 44 | Top decays and subsequent showers | + | 45- 84 | Gluon splitting | + | 85-104 | Cluster formation | + | 105-206 | Cluster and hadron decays | + | 207-218 | Weak decay of B_sbar and showers | + | 219-226 | Hadronization of B_sbar products | + | 227-235 | 3-gluon decay of eta_c | + | 236-250 | Hadronization of eta_c products | + +---------+--------------------------------------+ + + We discuss each part in turn. + + ---INITIAL STATE--- + + IHEP ID IDPDG IST MO1 MO2 DA1 DA2 P-X P-Y P-Z ENERGY MASS + 1 PBAR -2212 101 0 0 0 0 0.00 0.00 900.00 900.00 0.94 + 2 P 2212 102 0 0 0 0 0.00 0.00 -900.00 900.00 0.94 + 3 CMF 0 103 1 2 0 0 0.00 0.00 0.00 1800.00 1800.00 + + CMF represents the overall centre of mass of the initial state. The + 'mother' MOi=JMOHEP(i,IHEP) & 'daughter' DAi=JDAHEP(i,IHEP) pointers + are set to zero for these entries. + + ---HARD SUBPROCESS--- + + IHEP ID IDPDG IST MO1 MO2 DA1 DA2 P-X P-Y P-Z ENERGY MASS + 4 UBAR -2 121 6 7 9 5 0.00 0.00 312.09 312.09 0.32 + 5 UQRK 2 122 6 4 17 8 0.00 0.00 -169.95 169.95 0.32 + 6 HARD 0 120 4 5 7 8 -16.42 -3.93 142.14 482.34 460.61 + 7 TBAR -6 123 6 8 22 4 116.29 -61.69 157.43 266.49 170.00 + 8 TQRK 6 124 6 5 24 7 -116.29 61.69 -15.29 215.55 170.00 + + HARD is the hard subprocess centre of mass. Its mother and daughter + pointers give the locations of the incoming and outgoing partons. The + status codes 121-124 correspond to the hard subprocess partons 1-4. + The first mother pointers show the location of the hard c.m., and the + second mother of each parton is the 'colour mother', as explained + above. Thus the colours of partons 1234 are connected to 3142 respt., + corresponding to process IHPRO=12. Likewise,the first daughter points + to the associated jet but the second daughter is the colour daughter, + i.e. the parton to which this one's anticolour is connected. Thus the + anticolour connections of 1234 in this case are to 2413. The colour + diagram is + + (ubar)1 --<--+ +--<-- 3(tbar) + \___/ + ___ + / \ + (u)2 -->--+ +-->-- 4(t) + + Note that in specifying the colour connections all lines are regarded + as outgoing, and that since antiquarks carry no colour MO2 is in that + case used for the flavour connection (similarly with DA2 for quarks). + Gluon radiation from the initial ubar will be limited by interference + with the tbar and vice-versa, that from the incoming u by the t and + vice-versa. At this stage, the momenta and masses of the partons are + the raw on-shell values generated before QCD radiative corrections, + but HARD has been updated to give the true hard subprocess momentum + after initial- and final-state parton branching. + + ---PARTON SHOWERS--- + + The QCD cascade from each hard parton is generated in sequence. First + there is a jet entry (IDHEP=94) giving the total jet momentum, mass + and flavour. For initial-state jets the mass represents -|q**2|**1/2 + for the virtual parton entering the hard subprocess. MO1 gives the + parent hard parton and MO2 the hard centre-of-mass. DO1 and DO2 point + to the first and last parton in the jet after perturbative branching. + If branching occurs, the next entry (CONE) is a lightlike 4-vector + defining the radiation cone and the orientation of the radiation + pattern. + + The partons in the jet (with ISTHEP set to 2 by gluon splitting sub- + routine HWCGSP) have their colour and anticolour connections given + by MO2 and DA2 respectively, as described for the hard subprocess. + For an incoming jet, the remnants of the incoming hadrons (IHEP=11,21 + here) also have ISTHEP=2. The ubar jet is: + + IHEP ID IDPDG IST MO1 MO2 DA1 DA2 P-X P-Y P-Z ENERGY MASS + 9 UBAR 94 141 4 6 11 16 -19.27 -6.00 314.16 310.83 -49.90 + 10 CONE 0 100 4 7 0 0 0.88 -0.47 0.53 1.13 0.00 + 11 UBARDBAR -2101 2 9 12 45 21 0.00 0.00 408.95 408.95 0.70 + 12 GLUON 21 2 9 13 46 47 8.42 0.19 140.64 140.89 0.75 + 13 GLUON 21 2 9 14 48 49 2.07 -1.20 14.47 14.68 0.75 + 14 DBAR -1 2 9 15 50 49 3.78 3.25 8.85 10.16 0.32 + 15 DQRK 1 2 9 16 51 50 3.65 2.24 9.47 10.40 0.32 + 16 GLUON 21 2 9 26 52 53 1.36 1.52 3.46 4.09 0.75 + + and similarly for the u jet (IHEP=17-21). The produced t and tbar are + so slow in the subprocess c.o.m. frame that they do not radiate any + resolvable gluons. After any showering, they're given status ISTHEP=3 + and copied with ISTHEP=155 retaining the colour connection labels for + the decay processes. In this event both top decays are leptonic: + + ---HEAVY FLAVOUR DECAYS--- + + IHEP ID IDPDG IST MO1 MO2 DA1 DA2 P-X P-Y P-Z ENERGY MASS + 26 TBAR -6 155 22 37 27 29 107.70 -63.75 156.89 263.01 170.00 + 27 MU- 13 123 26 28 30 28 18.31 32.76 65.37 75.38 0.11 + 28 NU_MUBAR -14 124 26 27 31 27 80.30 -57.83 106.04 145.04 0.00 + 29 BBAR -5 124 26 26 32 26 9.09 -38.68 -14.52 42.60 4.95 + 30 MU- 13 1 27 26 0 0 17.82 31.88 63.62 73.36 0.11 + 31 NU_MUBAR -14 1 28 26 0 0 78.14 -56.28 103.19 141.14 0.00 + + 37 TQRK 6 155 24 19 38 40 -124.12 59.82 -14.74 219.32 170.00 + 38 NU_E 12 123 37 39 41 39 -96.15 66.72 23.37 119.34 0.00 + 39 E+ -11 124 37 38 42 38 6.38 13.33 -54.59 56.56 0.00 + 40 BQRK 5 124 37 37 43 37 -34.36 -20.23 16.48 43.43 4.95 + 41 NU_E 12 1 38 37 0 0 -96.15 66.72 23.37 119.34 0.00 + 42 E+ -11 1 39 37 0 0 6.38 13.33 -54.59 56.56 0.00 + + ---PARTON SHOWERS--- + + After the tbar decay, the resulting bbar radiates 2 gluons: + + IHEP ID IDPDG IST MO1 MO2 DA1 DA2 P-X P-Y P-Z ENERGY MASS + 32 BBAR 94 144 29 26 34 36 11.74 -39.36 -9.92 48.52 23.85 + 33 CONE 0 100 29 26 0 0 0.24 0.72 1.07 1.32 0.00 + 34 GLUON 21 2 32 35 59 60 -2.95 -0.95 -3.35 4.62 0.75 + 35 GLUON 21 2 32 36 61 62 -1.72 -1.41 -1.55 2.81 0.75 + 36 BBAR -5 2 32 44 63 62 16.41 -37.00 -5.02 41.08 4.95 + + but the b quark from the t decay does not radiate. If the decays had + been hadronic, the quarks from the virtual W decay would also radiate + in general. + + ---GLUON SPLITTING--- + + As the first step in the cluster hadronization model, any gluons in + the jets are split into light quark-antiquark pairs. The flavours of + the pairs are chosen at random amongst those allowed by kinematics. + The colour connections are remade accordingly. + + IHEP ID IDPDG IST MO1 MO2 DA1 DA2 P-X P-Y P-Z ENERGY MASS + 45 UBARDBAR -2101 161 9 65 85 58 0.01 0.00 279.95 279.95 0.64 + 46 UBAR -2 158 9 47 104 84 1.90 0.01 33.44 33.50 0.32 + 47 UQRK 2 158 9 69 86 46 3.96 0.11 64.98 65.11 0.32 + 48 DBAR -1 158 9 49 97 70 0.95 -0.68 7.08 7.18 0.32 + 49 DQRK 1 158 9 71 87 48 0.40 -0.05 2.32 2.38 0.32 +....... + 63 BBAR -5 158 32 64 101 78 14.03 -31.87 -4.37 35.44 4.95 + 64 BQRK 5 158 43 81 94 63 -24.17 -14.23 11.39 30.68 4.95 + + Each quark (or antidiquark) is combined with its colour mother anti- + quark (or diquark) to make a cluster with the sum of their 4-momenta. + All non-beam clusters with masses above the maximum are split by + creating new quark-antiquark pairs with ISTHEP=159 (10 such pairs in + this event). + + 65 DBAR -1 159 9 66 85 45 0.06 0.00 30.61 30.61 0.32 + 66 DQRK 1 159 9 83 95 65 0.02 0.00 65.93 65.93 0.32 +....... + 83 DBAR -1 159 9 84 95 66 0.07 0.00 27.33 27.33 0.32 + 84 DQRK 1 159 9 46 104 83 0.23 0.00 11.57 11.58 0.32 + + ---CLUSTER FORMATION--- + + Next the clusters themselves are listed. The mothers of a cluster are + the partons from which it is made, and the daughters are the primary + hadrons into which it decays. + + IHEP ID IDPDG IST MO1 MO2 DA1 DA2 P-X P-Y P-Z ENERGY MASS + 85 CLUS 91 184 45 65 105 106 0.07 0.00 310.56 310.56 1.23 + 86 CLUS 91 183 47 69 107 108 4.40 -0.09 69.69 69.85 1.59 +....... + 103 CLUS 91 183 82 79 139 140 -5.81 -3.42 2.54 7.49 2.06 + 104 CLUS 91 183 84 46 141 142 2.13 0.01 45.01 45.08 1.04 + + ---CLUSTER DECAYS--- + + The clusters, including the b-flavoured clusters 94 and 101, now + decay, usually into pairs of hadrons chosen according to the density + of states. Sometimes single-hadron decays occur, with transfer of + momentum to a neighbouring cluster, if there is insufficient phase + space for two-body decay. Note that cluster 94 actually did a 1-body + decay into a B- (IHEP=123, ISTHEP=196). Hadrons with ISTHEP=1 are + stable. ISTHEP=200 indicates a neutral B meson which may undergo + flavour oscillation. + + IHEP ID IDPDG IST MO1 MO2 DA1 DA2 P-X P-Y P-Z ENERGY MASS + 105 PBAR -2212 1 85 9 0 0 -0.13 0.09 215.09 215.09 0.94 + 106 PI+ 211 1 85 9 0 0 0.20 -0.09 95.47 95.47 0.14 + 107 OMEGA 223 197 86 9 143 145 2.33 -0.03 34.12 34.20 0.78 + 108 RHO+ 213 197 86 9 146 147 2.07 -0.06 35.58 35.65 0.77 +....... + 123 B- -521 196 94 43 163 165 -25.44 -14.98 11.97 32.29 5.28 + ....... + 136 B_S0 531 200 101 32 176 176 14.56 -33.17 -4.60 36.91 5.38 +....... + 141 PI0 111 1 104 9 0 0 0.66 0.06 16.64 16.65 0.14 + 142 RHO- -213 197 104 9 185 186 1.47 -0.05 28.37 28.42 0.77 + + ---STRONG HADRON DECAYS--- + + The unstable hadrons decay according to decay tables. Remember that + the pi0 was set stable in the initialization phase. For heavy (b,c) + quarks, partonic or direct hadronic decays may occur. In this event + the B- does a b -> u directly to rho0 e- nu_ebar. The B_s oscillates + into a B_sbar which decays partonically to c cbar s sbar. + + IHEP ID IDPDG IST MO1 MO2 DA1 DA2 P-X P-Y P-Z ENERGY MASS + 143 PI+ 211 1 107 9 0 0 1.90 -0.02 24.27 24.35 0.14 + 144 PI- -211 1 107 9 0 0 0.32 0.00 6.77 6.78 0.14 + 145 PI0 111 1 107 9 0 0 0.11 -0.02 3.07 3.08 0.14 + 146 PI+ 211 1 108 9 0 0 1.80 0.19 29.01 29.07 0.14 + 147 PI0 111 1 108 9 0 0 0.27 -0.25 6.57 6.58 0.14 +....... + 163 RHO0 113 198 123 43 194 195 -18.44 -9.34 6.79 21.77 0.77 + 164 E- 11 1 123 43 0 0 -6.49 -5.26 5.27 9.88 0.00 + 165 NU_EBAR -12 1 123 43 0 0 -0.50 -0.38 -0.09 0.63 0.00 +....... + 176 B_SBAR0 -531 199 136 32 207 208 14.56 -33.17 -4.60 36.91 5.38 + 205 PI0 111 1 187 9 0 0 0.51 -0.06 1.56 1.65 0.14 + 206 PI0 111 1 187 9 0 0 0.14 0.12 1.63 1.64 0.14 + + ---HEAVY FLAVOUR DECAYS--- + + IHEP ID IDPDG IST MO1 MO2 DA1 DA2 P-X P-Y P-Z ENERGY MASS + 207 BQRK 5 155 176 208 209 211 13.20 -30.08 -4.17 33.47 4.88 + 208 SBAR -3 125 176 211 212 211 1.35 -3.09 -0.43 3.43 0.50 + 209 CQRK 4 123 207 210 213 210 2.30 -5.94 -0.61 6.59 1.55 + 210 CBAR -4 124 207 209 215 209 3.58 -8.37 -1.74 9.40 1.55 + 211 SQRK 3 124 207 207 217 207 7.33 -15.77 -1.82 17.49 0.50 + 212 SBAR -3 160 208 221 223 221 1.35 -3.09 -0.43 3.43 0.50 + + The B_sbar decay products hadronize to eta_c K+ K-: + + ---CLUSTER DECAYS--- + + IHEP ID IDPDG IST MO1 MO2 DA1 DA2 P-X P-Y P-Z ENERGY MASS + 224 ETA_C 441 199 222 213 227 229 4.87 -12.18 -2.12 13.62 2.98 + 225 K- -321 1 223 217 0 0 8.22 -17.67 -2.03 19.60 0.49 + 226 K+ 321 1 223 217 0 0 1.47 -3.31 -0.45 3.69 0.49 + + The eta_c decays partonically to 3 gluons: + + ---HEAVY FLAVOUR DECAYS--- + + IHEP ID IDPDG IST MO1 MO2 DA1 DA2 P-X P-Y P-Z ENERGY MASS + 227 GLUON 21 123 224 229 230 228 2.59 -4.45 -1.11 5.32 0.75 + 228 GLUON 21 124 224 227 232 229 0.84 -4.20 -0.51 4.38 0.75 + 229 GLUON 21 124 224 228 234 227 1.44 -3.53 -0.50 3.92 0.75 + + Finally the 3 gluons hadronize to pi+ pi- 4 pi0: + + ---CLUSTER DECAYS--- + + IHEP ID IDPDG IST MO1 MO2 DA1 DA2 P-X P-Y P-Z ENERGY MASS + 245 PI- -211 1 242 230 0 0 1.53 -3.79 -0.46 4.11 0.14 + 246 PI0 111 1 242 230 0 0 0.06 -0.12 -0.07 0.20 0.14 + 247 PI0 111 1 243 232 0 0 0.52 -0.39 0.03 0.66 0.14 + 248 PI0 111 1 243 232 0 0 1.30 -3.27 -1.01 3.66 0.14 + 249 PI0 111 1 244 234 0 0 1.02 -3.98 -0.74 4.18 0.14 + 250 PI+ 211 1 244 234 0 0 0.43 -0.64 0.14 0.80 0.14 + + After the 1000 events requested have been generated, an analysis of + the associated weight distribution and cross section is printed. diff --git a/HERWIG/herwig61.txt b/HERWIG/herwig61.txt new file mode 100644 index 00000000000..3b1a3e7789d --- /dev/null +++ b/HERWIG/herwig61.txt @@ -0,0 +1,632 @@ + + A new version of the Monte Carlo program HERWIG (version 6.1) is now + available, and can be obtained from the following web site: + + http://hepwww.rl.ac.uk/theory/seymour/herwig/ + + This will temporarily be mirrored at CERN for the next few weeks: + + http://home.cern.ch/~seymour/herwig/ + + More complete information on HERWIG can be found in the publication + G. Marchesini, B.R. Webber, G. Abbiendi, I.G. Knowles, M.H. Seymour + and L. Stanco, Computer Phys. Commun. 67 (1992) 465 and also in the + documentation for the previous version (5.9), which are available at + the same site, together with other useful files and information. + Here we merely give the new features relative to 5.9. + + If you use HERWIG, please refer to it something along the lines of: + + HERWIG 6.1, hep-ph/9912396; G. Marchesini, B.R. Webber, G. Abbiendi, + I.G. Knowles, M.H. Seymour and L. Stanco, + Computer Phys. Commun. 67 (1992) 465. + + + *** NEW FEATURES OF THIS VERSION *** + + *---------------------------------------------------------------* + | The main new features are: supersymmetric processes (both | + | R-parity conserving & violating) in hadron-hadron collisions; | + | new e+e- to four jets process; matrix element corrections to | + | top decay and Drell-Yan processes; new soft underlying event | + | options; updates to default particle data tables; new LaTeX & | + | html printout options. | + *---------------------------------------------------------------* + + * [N.B. Default values for input variables shown in square brackets.] + + * All R-parity conserving SUSY two-to-two processes in hadron-hadron + collisions have been added. Their process numbers are: + + +-------+----------------------------------------------------------+ + | IPROC | Process | + +-------+----------------------------------------------------------+ + | 3000 | 2 parton to 2 sparticles: the sum of 3010,3020 and 3030 | + | 3010 | 2 parton to 2 spartons | + | 3020 | 2 parton to 2 gauginos | + | 3030 | 2 parton to 2 sleptons | + +-------+----------------------------------------------------------+ + + Further details of the inclusion of superpartners and their decays + are given below. + + Additional processes for the SUSY two Higgs doublet model are + currently under test and will be released shortly. + + * All R-parity violating SUSY two-to-two processes via resonant + sleptons and squarks in hadron collisions have been added. Their + process numbers are: + + +-------+----------------------------------------------------------+ + | IPROC | Processes derived from the LQD term in the superpotential| + +-------+----------------------------------------------------------+ + | 4000 | The sum of 4010,4020,4040 and 4050 | + | 4010 | Neutralino lepton production (all neutralinos) | + | 401i | As 4010 but only the ith neutralino | + | 4020 | Chargino lepton production (all charginos) | + | 402i | As 4020 but only the ith chargino | + | 4040 | Slepton W/Z production | + | 4050 | Slepton Higgs production | + +-------+----------------------------------------------------------+ + | 4060 | Sum of 4070 and 4080 | + | 4070 | quark-antiquark production via LQD | + | 4080 | lepton production via LLE and LQD | + +=======+==========================================================+ + | IPROC | Processes derived from the UDD term in the superpotential| + +-------+----------------------------------------------------------+ + | 4100 | The sum of 4110, 4120, 4130, 4140 and 4150 | + | 4110 | Neutralino quark production (all neutralinos) | + | 411i | As 4110 but only the ith neutralino | + | 4120 | Chargino quark production (all charginos) | + | 412i | As 4120 but only the ith chargino | + | 4130 | Gluino quark production | + | 4140 | Squark W/Z production | + | 4150 | Squark Higgs production | + +-------+----------------------------------------------------------+ + | 4160 | quark-quark production | + +-------+----------------------------------------------------------+ + + In addition the R-parity violating decays of all superpartners is + included. + + * A new process describing electron-positron annihilation to four jets + has been added. This has IPROC=600+IQ, where a non-zero value for IQ + guarantees production of quark flavour IQ whilst IQ=0 corresponds to + the natural flavour mix. IPROC=650+IQ is as above but without those + terms in the matrix element which orient the event w.r.t. the lepton + beam direction. The matrix elements are based on those of Ellis Ross + & Terrano with orientation terms from Catani & Seymour. The soft and + collinear divergences are avoided by imposing a minimum y-cut, Y4JT + [.01], on the initial 4 partons. The interjet distance is calculated + using either the Durham or JADE metrics. This choice is governed by + the logical variable DURHAM [.TRUE.]. Note that parameterizations of + the volume of four-body phase space are used: these are accurate up + to a few percent for y-cut values less than 0.14. Note, also that + the phase space is for massless partons, as are the matrix elements, + though a mass threshold cut is applied. Finally, the matrix elements + for the q-qbar-g-g & q-qbar-q-qbar (same flavour quark) final states + receive contributions from 2 colour flows each, the treatment of the + interference terms being controlled by the array IOP4JT: + + q-qbar-g-g case: + IOP4JT(1)=0 neglect, =1 extreme 2341; =2 extreme 3421 [0] + + q-qbar-q-qbar (identical quark flavour) case: + IOP4JT(2)=0 neglect, =1 extreme 4123; =2 extreme 2143 [0] + + The scale EMSCA for the parton showers is set equal to SQRT(s*ymin) + where ymin is the least distance, according to the selected metric, + between any two partons. + + * Matrix element corrections to the simulation of top quark decays and + Drell-Yan processes are now available using the same general method + as already implemented for e+e- annihilation and DIS. If HARDME + [.TRUE.] then fill the missing phase-space (`dead zone') using the + exact 1st-order M.E. result (`hard corrections'). If SOFTME + [.TRUE.] then correct emissions in the already-populated region of + phase space using the exact amplitude for every emission that is + capable of being the hardest so far (`soft corrections'). + + - For t -> bW decays the routine HWBTOP implements hard corrections. + HWBRAN has been modified to implement the soft corrections to top + decays. Since the dead zone includes part of the soft singularity + a cutoff is required: only gluons with energy above GCUTME [2 GeV] + (in the top rest frame) are corrected. Physical quantities are not + strongly dependent on GCUTME in the range 1 to 5 GeV. For details + see: + + G. Corcella and M.H. Seymour, Phys. Lett. B442 (1998) 417. + + - For the Drell-Yan process the routine HWBDYP implements the hard + corrections whilst HWSBRN has been modified to implement the soft + corrections to the initial state radiation. For details see: + + G. Corcella and M.H. Seymour, hep-ph/9908338. + + * The parameters of the model used for soft interactions are now + available to the user for modification. The model is based on the + minimum-bias event generator of the UA5 Collaboration, which starts + from a parametrization of the pbar p inelastic charged multiplicity + distribution as a negative binomial. The parameters are as follows + (default parameter values are the UA5 ones used in previous + versions): + + +-------+---------------------------+---------+ + | Name | Description | Default | + +-------+---------------------------+---------+ + | PMBN1 | a in = a*S^b+c | 9.11 | + | PMBN2 | b in = a*S^b+c | 0.115 | + | PMBN3 | c in = a*S^b+c | -9.50 | + | | | | + | PMBK1 | a in 1/k = a*log_e(S)+b | 0.029 | + | PMBK2 | b in 1/k = a*log_e(S)+b | -0.104 | + | | | | + | PMBM1 | a in (M-m_1-m_2-a)e^{-bM} | 0.4 | + | PMBM2 | b in (M-m_1-m_2-a)e^{-bM} | 2.0 | + | | | | + | PMBP1 | p_t slope for d,u | 5.2 | + | PMBP2 | p_t slope for s,c | 3.0 | + | PMBP3 | p_t slope for qq | 5.2 | + +-------+---------------------------+---------+ + + The first three parametrize the mean charged multiplicity at + c.m. energy \sqrt{s} as indicated. The next two specify the + parameter k in the negative binomial charged multiplicity + distribution. The parameters PMBM1 and PMBM2 describe the + distribution of cluster masses M in the soft collision. These soft + clusters are generated with a flat rapidity distribution with + gaussian shoulders. The transverse momentum distribution of soft + clusters has the form + + P(p_t)\propto p_t\exp(-b\sqrt{p_t^2+M^2}) + + where the slope parameter b depends as indicated on the flavour of + the quark or diquark pair created when the cluster was produced. + + As an option, for underlying events the value of \sqrt{s} used to + choose the multiplicity n may be enhanced by a parameter ENSOF to + allow for an enhanced underlying activity in hard events. The actual + charged multiplicity is then taken to be n plus the sum of the + moduli of the charges of the colliding hadrons or clusters. + + * There have been a number of additions/changes to the default hadrons + included via HWUDAT. Here the identification of hadrons follows the + PDG ('98 edition) table 13.2 with numbering according to section 31. + + New isoscalars states have been added to try to complete the 1^3D_3, + 1^1D_2 and 1^3D_1 multiplets: + + IDHW RNAME IDPDG IDHW RNAME IDPDG + ---- ----- ----- ---- ----- ----- + 395 OMEGA_3 227 396 PHI_3 337 + 397 ETA_2(L) 10225 398 ETA_2(H) 10335 + 399 OMEGA(H) 30223 + + Also the following states have been re-identified/replaced: + + IDHW RNAME IDPDG IDHW RNAME IDPDG + ---- ----- ----- ---- ----- ----- + 57 FH_1 20333 + 293 F0P0 9010221 294 FH_00 10221 + 62 A_0(H)0 10111 290 A_00 9000111 + 63 A_0(H)+ 10211 291 A_0+ 9000211 + 64 A_0(H)- -10211 292 A_0- -9000211 + + The f_1(1420) state completely replaces the f_1(1520) in the 1^3P_0 + multiplet, taking over 57. The f_0(1370) (294) replaces the f_0(980) + (293) in the 1^3P_0 multiplet; the latter is retained as it appears + in the decays of several other states. The new a_0(1450) states (62 + -64) replace the three old a_0(980) states (290 - 292) in the 1^3P_0 + multiplet; the latter are kept, as they appear in f_1(1285) decays. + + By default production of the f_0(980) and a_0(980) states in cluster + decays is vetoed. + + Also, the PDG numbers for the remnant particles have been changed to + 98 for REMG and 99 for REMN. + + * Since version 6.1 contains a large number of supersymmetry processes + several new particles have been added. + + Extra scalar bosons for the two Higgs Doublet (SUSY) scenario: + + IDHW RNAME IDPDG IDHW RNAME IDPDG + ---- ----- ----- ---- ----- ----- + 203 HIGGSL0 26 206 HIGGS+ 37 + 204 HIGGSH0 35 207 HIGGS- -37 + 205 HIGGSA0 36 + + Note that the lighter neutral scalar (203) is given the non-standard + PDG number 26, in order to distinguish it from the minimal SM Higgs, + PDG number 25. + + Extra sfermions and gauginos for SUSY scenarios: + + IDHW RNAME IDPDG IDHW RNAME IDPDG + ---- ----- ----- ---- ----- ----- + 401 SSDL 1000001 413 SSDR 2000001 + | | | | | | + 406 SST1 1000006 418 SST2 2000006 + 407 SSDLBR -1000001 419 SSDRBR -2000001 + | | | | | | + 412 SST1BR -1000006 424 SST2BR -2000006 + + 425 SSEL- 1000011 437 SSER- 2000011 + | | | | | | + 430 SSNUTL 1000016 442 SSNUTR 2000016 + 431 SSEL+ -1000011 443 SSER+ -2000011 + | | | | | | + 436 SSNUTLBR -1000016 448 SSNUTRBR -2000016 + + 449 GLUINO 1000021 454 CHGINO1+ 1000024 + 450 NTLINO1 1000022 455 CHGINO2+ 1000037 + 451 NTLINO2 1000023 456 CHGINO1 -1000024 + 452 NTLINO3 1000025 457 CHGINO2 -1000037 + 453 NTLINO4 1000035 458 GRAVTINO 1000039 + + The implementation of SUSY is discussed more fully below. Note that + the default masses of the SUSY particles are zero and that they have + no decay modes. Before a SUSY process can be simulated you must load + the appropriate masses and decay modes generated using ISAWIG (see + below) or an equivalent program. + + These new states don't interfere with the user's ability to add new + particles as previously described. + + * It is now possible to create particle property and event listings in + any combination of 3 formats - standard ASCII, LaTeX or html. These + options are controlled by the new, logical variables PRNDEF [.TRUE.] + PRNTEX [.FALSE.] and PRNWEB [.FALSE.]. The ASCII output is directed + to stout (screen / log file) as in previous versions. When a listing + of particle properties is requested (IPRINT.GE.2 or HWUDPR is called + explicitly) then the following files are produced: + + If (PRNTEX): HW_decays.tex + If (PRNWEB): HW_decays/index.html + /PART0000001.html etc. + + The HW_decays.tex file is written to the working directory whilst + the many **.html files appear in the sub-directory HW_decays/ which + must have been created previously. Paper sizes and offsets for the + LaTeX output are stored at the top of the block data file HWUDAT: + they may need modifying to suit a particular printer. When event + listings are requested (NEVHEP.LE.MAXPR.NE.0 or HWUEPR is called + explicitly) the following files are created in the current working + directory: + + If (PRNTEX): HWEV_*******.tex where *******=0000001 etc. + If (PRNWEB): HWEV_*******.html is the event number + + Note the .html file automatically makes links to the index.html file + of particle properties assumed to be in the HW_decays sub-directory. + + A new integer variable NPRFMT [1] has been introduced to control how + many significant figures are shown in each of the 3 event outputs. + Basically NPRFMT=1 gives short compact outputs whilst NPRFMT=2 gives + long formats. + + Note that all the LaTeX files use the package longtable.sty to + format the tables. Also if NPRFMT=2 or PRVTX=.TRUE. then the LaTeX + files are designed to be printed in landscape mode. + + * There were previously some inconsistencies and ambiguities in our + conventions for the mixing of flavour `octet' and `singlet' mesons. + They are now: + + Multiplet Octet Singlet Mixing Angle + --------- ----- ------- ------------ + 1^1S_0 eta eta' ETAMIX=-23. + 1^3S_1 phi omega PHIMIX=+36. + 1^1P_1 h_1(1380) h_1(1170) H1MIX =ANGLE + 1^3P_0 MISSING f_0(1370) F0MIX =ANGLE + 1^3P_1 f_1(1420) f_1(1285) F1MIX =ANGLE + 1^3P_2 f'_2 f_2 F2MIX =+26. + 1^1D_2 eta_2(1645) eta_2(1870) ET2MIX=ANGLE + 1^3D_1 MISSING omega(1600) OMHMIX=ANGLE + 1^3D_3 phi_3 omega_3 PH3MIX=+28. + + After mixing the quark content of the physical states is given, in + terms of the mixing angle, theta, by: + + (ddbar+uubar)/sqrt(2) ssbar + --------------------- ----- + Octet: cos(theta+theta_0) -sin(theta+theta_0) + Singlet: sin(theta+theta_0) cos(theta+theta_0) + + where theta_0=ATAN(SQRT(2)). Hence, using the default value of + ANGLE=ATAN(1/SQRT(2))*180/ACOS(-ONE) for theta gives ideal mixing, + that is, the `octet' state = ssbar and the `singlet' = + (ddbar+uubar)/sqrt(2). This choice is important to avoid large + isospin violations in the 1^3P_0 and 1^3D_1 multiplets in which the + octet member is unknown. + + * A new treatment of the colour interference terms in matrix elements + has been introduced in this version. A non-planar, interference term + is now shared between the planar terms corresponding to well defined + colour flows in proportion to the size of the planar terms. Existing + two-to-two QCD processes which have been affected are: + + Light Quarks Heavy Quarks + ============ ============ + Process IHPRO Process IHPRO + ------- ----- ------- ----- + q +q --> q +q 1,2 Q +g --> Q +g 10,11 + q +qbar --> q +qbar 5,6 Qbar+g --> Qbar+g 21,22 + qbar+q --> qbar+q 13,14 g +Q --> g +Q 23,24 + qbar+qbar --> qbar+qbar 18,19 g +Qbar --> g +Qbar 25,26 + g +g --> Q +Qbar 27,28 + + The present and previous treatments of the interference term are the + same for the other two-to-two QCD processes which remain unaffected. + + This new procedure has been adopted for all the SUSY QCD processes. + + For details see: K. Odagiri, JHEP 10 (1998) 006 + + * A new process, direct gamma-gamma to charged particle pairs has been + added. This has IPROC=16000+IQ: if IQ=1-6 then only quark flavour IQ + is produced, if IQ=7,8 or 9 then only lepton flavour e, mu or tau is + produced and if IQ=10 then only W pairs are produced: in these cases + particle masses effects are included. Whilst if IQ=0 the natural mix + of quark pairs are produced using massless MEs but including a mass + threshold cut. The range of allowed transverse momenta is controlled + by PTMIN & PTMAX as usual. + + * A new package ISAWIG has been created to work with ISAJET to produce + a file of the SUSY particle masses, lifetimes and decay modes which + can be read in by HERWIG. + + This package takes the outputs of the ISAJET SUGRA or general MSSM + programs and produces a data file in a format that can be read in by + the HWISSP subroutine described below. + + In addition to the decay modes included in the ISAJET package ISAWIG + allows for the possibility of violating R-parity and includes the + calculation of all 2-body squark and slepton, and 3-body gaugino and + gluino R-parity violating decay modes. + + * A new subroutine HWISSP has been added to read the file of particle + properties produced by the ISAWIG program. In principle the user can + produce a similar file provided that the correct format is used. The + format should be as follows. + + First the SUSY particle and top quark masses and lifetimes are given + as, for example: + + 65 + 401 927.3980 0.74510E-13 + 402 925.3307 0.74009E-13 + ....etc. + + That is, + + NSUSY=Number of SUSY+top particles + IDHW, RMASS(IDHW) & RLTIM(IDHW) + repeated NSUSY times. + + Next each particle's decay modes together with their branching + ratios and matrix element codes are given as, for example: + + 6 + 401 0.18842796E-01 0 450 1 0 0 0 + | | | | | | | | + 401 0.32755006E-02 0 457 2 0 0 0 + 6 + 402 0.94147678E-02 0 450 2 0 0 0 + ....etc. + + That is, + + Number of decay modes for a given particle (IDK) + IDK(*), BRFRAC(*), NME(*) & IDKPRD(1-5,*) + repeated for each mode. + + Repeated for each particle (NSUSY times). + + The order in which the decay products appear is significant: this is + important inorder to obtain appropriate showering and hadronization. + The correct ordering for each decay mode is indicated below. + + +----------+------------------------+------------------------------+ + | Decaying | Type of Mode | Order of Decay Products: | + | Particle | | 1st | 2nd | 3rd | + +----------+------------------------+---------+---------+----------+ + | Top | 2 body to Higgs | Higgs | Bottom | | + | +------------------------+---------+---------+----------+ + | | 3 body via Higgs/W | quarks or leptons | Bottom | + | | | from W/Higgs | | + +----------+------------------------+---------+---------+----------+ + | Gluino | 2 body modes: | | | | + | | without gluon | any order | | + | | with gluon | gluon | colour | | + | | | | neutral | | + | +------------------------+---------+---------+----------+ + | | 3 body modes: | colour | q or qbar | + | | R-parity conserved | neutral | | + +----------+------------------------+---------+---------+----------+ + | Squark/ | 2 body modes: | | | | + | Slepton | Gaugino/Gluino | Gaugino | quark | | + | | Quark/Lepton | Gluino | lepton | | + | +------------------------+---------+---------+----------+ + | | 3 body modes: |sparticle| particles from | + | | Weak | | W decay | + +----------+------------------------+---------+---------+----------+ + | Squark | 2 body modes: | | | | + | | Lepton Number Violated | quark | lepton | | + | | Baryon Number Violated | quark | quark | | + +----------+------------------------+---------+---------+----------+ + | Slepton | 2 body modes: | q or qbar | | + | | Lepton Number Violated | | | | + +----------+------------------------+---------+---------+----------+ + | Higgs | 2 body modes: | | | | + | | (s)quark-(s)qbar | (s)q or (s)qbar | | + | | (s)lepton-(s)lepton | (s)l or (s)lbar | | + | +------------------------+---------+---------+----------+ + | | 3 body modes: | colour | q or qbar | + | | | neutral | l or lbar | + +----------+------------------------+---------+---------+----------+ + | Gaugino | 2 body modes: | | | | + | | squark-quark | q or sq | | + | | slepton-lepton | l or sl | | + | +------------------------+---------+---------+----------+ + | | 3 body modes: | colour | q or qbar | + | | R-parity conserved | neutral | l or lbar | + +----------+------------------------+---------+---------+----------+ + | Gaugino/ | 3 body modes: | particles in the order i,j,k | + | Gluino | R-parity violating | | + +----------+------------------------+---------+---------+----------+ + + A new matrix element code has been added for these decays: + + NME = 300 3 body R-parity violating gaugino and gluino decays + + in addition, an extra matrix element code has been reserved for use + in a forthcoming version: + + NME = 200 3 body top quark via charged Higgs + + The indices i,j,k in R-parity violating gaugino/gluino decays refer + to the ordering of the indices in the R-parity violating couplings + in the superpotential. The convention is as in: + + H.Dreiner, P.Richardson and M.H.Seymour, hep-ph/9912407. + + Next a number of parameters derived from the SUSY Lagrangian must be + given. These are: the ratio of Higgs VEVs, tan(beta), and the scalar + Higgs mixing angle, alpha; the mixing parameters for the Higgses, + gauginos and the sleptons; the trilinear couplings; and the Higgsino + mass parameter mu. + + Finally the logical variable RPARTY should be set: if FALSE then + R-parity is violated, and the R-parity violating couplings must also + be supplied, otherwise not. + + Details of the FORMAT statements employed can be found by examining + the subroutine HWISSP. + + The integer argument in the call to HWISSP(N) gives the unit number + to be read from. If the data is stored in a `fort.N' file no further + action is required but if the data is to be read from a file named + `fname.dat' then appropriate OPEN and CLOSE statements must be added + by hand: + + OPEN(UNIT=N,FORM='FORMATTED',STATUS='UNKNOWN',FILE='fname.dat') + CALL HWISSP(N) + CLOSE(UNIT=N) + + A number of sets of SUSY parameter files, produced using ISAWIG, for + the standard LHC SUGRA and GMSB points are available from the HERWIG + home page: http://hepwww.rl.ac.uk/theory/seymour/herwig/ + + * A large number of changes have been made to enable SUSY processes to + be included in hadron-hadron collisions. The main changes are: + + - The subroutine HWDHQK has been replaced by HWDHOB which does both + heavy quark and SUSY particle decays. + + - The subroutines HWBCON HWCGSP & HWCFOR have been adapted to handle + the colour connections found in normal SUSY decays. + + - The subroutine HWBRCN has been included to deal with the inter-jet + colour connections arising in R-parity violating SUSY. Also HWCBVI + HWCBVT and HWCBCT have been added to handle the hadronization of + baryon number violating SUSY decays and processes. If the variable + RPARTY=.TRUE. [default] then the old HWBCON colour connection code + is used else the new HWBRCN + + * The option of separate treatments for `light' and b-quark containing + clusters are now available. The 3 variables, PSPLT (which controls + the mass spectrum of the fragments in heavy cluster splitting) CLDIR + (which controls whether perturbatively produced (anti-)quarks retain + some knowledge of their direction in cluster decays to hadrons) and + CLSMR (which defines to what extent the hadron and constituent quark + directions are aligned), have been made two dimensional. + + ARRAY(1) controls clusters that do NOT contain a b quark + ARRAY(2) controls clusters that do contain a b quark + + [ Default ARRAY(1)=ARRAY(2) equivalent to earlier versions. ] + + * A new variable EFFMIN [1E-3] has been introduced, it allows the user + to set the minimum acceptable efficiency for event generation. + + * All hadron & lepton masses are now given to five significant figures + whenever possible. + + * The treatment of the perturbative g --> qqbar vertex in the partonic + showers has been improved. The total rate is unchanged, but the + angular distribution now covers the full range, rather than being + confined to the angular-ordered region as before. + + * The treatment of the intrinsic transverse momentum of partons in an + incoming hadron has been improved. It is now chosen before the + initial state cascade is performed, and is held fixed even if the + generated cascade is rejected. This removes a correlation between + the amount of perturbative and non-perturbative transverse momentum + generated that existed before. + + * Space-time positioning of clusters is now smeared according to a + Gaussian distribution of width 1/(cluster mass). + + * For e+e- processes with ISR a check was added requiring TMNISR to be + greater than the light quark threshold. + + * The treatment of the W resonance in top decays has been improved. + + * The common block file HERWIG61.INC has had many new variables added, + these are listed at the top of the file. + + * Corrections for bugs have been made affecting the following: + + - eta-eta' mixing: the parameterization was nonstandard (see above). + + - 4/5 body phase space generation: was not flat - affected resonance + decays only. + + - Drell-Yan: the overall normalization was too small by a factor 2/3 + also the t-channel contribution to q-qbar-> q-qbar was incorrectly + normalized. + + - HWHV1J: the normalization of Z+jet production rate was a factor 4 + too small; there was an incorrect correlation between the (signed) + W and jet rapidities; the treatment of the W/Z Breit-Wigner lead a + normalization error by a factor 3/pi. + + - HWHWPR: there was an overall normalization error of (M_ff'/M_w)^2, + this only affected the line shape and normalization for the t-bbar + final state for which M_ff' is large. + + - B_d/_s mixing: an incorrect formula was used. + + - VMIN2: the effective cut-off on the space-time distances travelled + by light partons in a shower was incorrectly implemented. Also its + default value has been increased to [0.1], which affects the + colour reconnection probability. + + - A number of fixes to improve safety against overflowing the HEPEVT + common block. + + - Fix to the underlying event to prevent errors with heavy quarks. + + - HWMODK/HWIODK: a number of corrections were made and the code made + more robust. + + - HWURES: the minimum threshold for the decay of diquark-antidiquark + clusters was incorrectly set. + + - The calculation of the top lifetime has been corrected and the QCD + corrections included - this only affects the treatment of colour + reconnection. + + - The space-time positioning of clusters sometimes led to them being + produced outside the forward lightcone. This has been rectified. + + As usual, if you wish to be removed from the HERWIG mailing list, or + if you know someone who wants to be added, please let one of us + know. + + Mike Seymour, Bryan Webber, Ian Knowles, Peter Richardson, Kosuke + Odagiri, Stefano Moretti, Gennaro Corcella, Pino Marchesini + + CERN, Edinburgh, Oxford, RAL, Rochester, Milano, etc, + 16th December 1999. diff --git a/HERWIG/herwig6_address.c b/HERWIG/herwig6_address.c new file mode 100644 index 00000000000..beb5bcd3691 --- /dev/null +++ b/HERWIG/herwig6_address.c @@ -0,0 +1,23 @@ +# define herwig6_addressc herwig6_addressc_ +# define herwig6_addressf herwig6_addressf_ +# define herwig6_addressi herwig6_addressi_ +# define herwig6_addressd herwig6_addressd_ +# define type_of_call + + +char* type_of_call herwig6_addressc(char *arg) +{ + return arg; +} +int* type_of_call herwig6_addressi(int *arg) +{ + return arg; +} +float* type_of_call herwig6_addressf(float *arg) +{ + return arg; +} +double* type_of_call herwig6_addressd(double *arg) +{ + return arg; +} diff --git a/HERWIG/herwig6_called_from_cc.f b/HERWIG/herwig6_called_from_cc.f new file mode 100644 index 00000000000..02302229e86 --- /dev/null +++ b/HERWIG/herwig6_called_from_cc.f @@ -0,0 +1,18 @@ + + subroutine herwig6_open_fortran_file(lun, name) + implicit none + integer lun + character*(*) name + + open (lun, file=name) + return + end + + subroutine herwig6_close_fortran_file(lun) + implicit none + integer lun + close (lun) + return + end + + diff --git a/HERWIG/herwig6_common_block_address.f b/HERWIG/herwig6_common_block_address.f new file mode 100644 index 00000000000..f9ed2582264 --- /dev/null +++ b/HERWIG/herwig6_common_block_address.f @@ -0,0 +1,69 @@ + integer function herwig6_common_block_address(common_block_name) +c----------------------------------------------------------------------- + include "HERWIG61.INC" + + character*(*) common_block_name + external HWUDAT +c----------------------------------------------------------------------- + integer herwig6_addressc, herwig6_addressi + integer herwig6_addressd, herwig6_addressf + external herwig6_addressc, herwig6_addressi + external herwig6_addressd, herwig6_addressf + integer common_block_address +c----------------------------------------------------------------------- + common_block_address = 0 +c----------------------------------------------------------------------- + if (common_block_name.eq."HEPEVT") then + common_block_address = herwig6_addressi(NEVHEP) + elseif (common_block_name.eq."HWBEAM") then + common_block_address = herwig6_addressi(IPART1) + elseif (common_block_name.eq."HWBMCH") then + common_block_address = herwig6_addressc(PART1) + elseif (common_block_name.eq."HWPROC") then + common_block_address = herwig6_addressd(EBEAM1) + elseif (common_block_name.eq."HWPRAM") then + common_block_address = herwig6_addressd(AFCH) + elseif (common_block_name.eq."HWPRCH") then + common_block_address = herwig6_addressc(AUTPDF) + elseif (common_block_name.eq."HWPART") then + common_block_address = herwig6_addressi(NEVPAR) + elseif (common_block_name.eq."HWPARP") then + common_block_address = herwig6_addressd(DECPAR) + elseif (common_block_name.eq."HWBOSC") then + common_block_address = herwig6_addressd(ALPFAC) + elseif (common_block_name.eq."HWPARC") then + common_block_address = herwig6_addressi(JCOPAR) + elseif (common_block_name.eq."HWBRCH") then + common_block_address = herwig6_addressd(ANOMSC) + elseif (common_block_name.eq."HWEVNT") then + common_block_address = herwig6_addressd(AVWGT) + elseif (common_block_name.eq."HWHARD") then + common_block_address = herwig6_addressd(ASFIXD) + elseif (common_block_name.eq."HWPROP") then + common_block_address = herwig6_addressd(RLTIM) + elseif (common_block_name.eq."HWUNAM") then + common_block_address = herwig6_addressc(RNAME) + elseif (common_block_name.eq."HWUPDT") then + common_block_address = herwig6_addressd(BRFRAC) + elseif (common_block_name.eq."HWUWTS") then + common_block_address = herwig6_addressd(REPWT) + elseif (common_block_name.eq."HWUCLU") then + common_block_address = herwig6_addressd(CLDKWT) + elseif (common_block_name.eq."HWDIST") then + common_block_address = herwig6_addressd(EXAG) + elseif (common_block_name.eq."HWQDKS") then + common_block_address = herwig6_addressd(VTXQDK) + elseif (common_block_name.eq."HWUSUD") then + common_block_address = herwig6_addressd(ACCUR) + elseif (common_block_name.eq."HWSUSY") then + common_block_address = herwig6_addressd(TANB) + elseif (common_block_name.eq."HWRPAR") then + common_block_address = herwig6_addressd(LAMDA1) + elseif (common_block_name.eq."HWMINB") then + common_block_address = herwig6_addressd(PMBN1) + elseif (common_block_name.eq."HWCLUS") then + common_block_address = herwig6_addressd(PPCL) + endif +c----------------------------------------------------------------------- + herwig6_common_block_address = common_block_address + end diff --git a/HERWIG/libherwig.pkg b/HERWIG/libherwig.pkg new file mode 100644 index 00000000000..79f443dcbf7 --- /dev/null +++ b/HERWIG/libherwig.pkg @@ -0,0 +1,9 @@ +CSRCS:= \ +main.c herwig6_address.c + +FSRCS:= \ +HERWIG6100.f \ +herwig6_called_from_cc.f \ +herwig6_common_block_address.f + +PACKFFLAGS:= -fno-second-underscore diff --git a/HERWIG/main.c b/HERWIG/main.c new file mode 100644 index 00000000000..2fcfee9112e --- /dev/null +++ b/HERWIG/main.c @@ -0,0 +1 @@ +void MAIN__() {}